enc-ebcdic.lisp - clic - Clic is an command line interactive client for gopher … | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
enc-ebcdic.lisp (3408B) | |
--- | |
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- | |
2 ;;; | |
3 ;;; enc-ebcdic.lisp --- EBCDIC encodings. | |
4 ;;; | |
5 ;;; Copyright (C) 2007, Luis Oliveira <[email protected]> | |
6 ;;; | |
7 ;;; Permission is hereby granted, free of charge, to any person | |
8 ;;; obtaining a copy of this software and associated documentation | |
9 ;;; files (the "Software"), to deal in the Software without | |
10 ;;; restriction, including without limitation the rights to use, copy, | |
11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies | |
12 ;;; of the Software, and to permit persons to whom the Software is | |
13 ;;; furnished to do so, subject to the following conditions: | |
14 ;;; | |
15 ;;; The above copyright notice and this permission notice shall be | |
16 ;;; included in all copies or substantial portions of the Software. | |
17 ;;; | |
18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, | |
19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF | |
20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND | |
21 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT | |
22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, | |
23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, | |
24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
25 ;;; DEALINGS IN THE SOFTWARE. | |
26 | |
27 (in-package #:babel-encodings) | |
28 | |
29 (define-character-encoding :ebcdic-us | |
30 "An alleged character set used on IBM dinosaurs." | |
31 :aliases '(:ibm-037)) | |
32 | |
33 (define-constant +ebcdic-decode-table+ | |
34 (make-array | |
35 256 :element-type 'ub8 :initial-contents | |
36 '(#x00 #x01 #x02 #x03 #x9c #x09 #x86 #x7f #x97 #x8d #x8e #x0b #x0c #x… | |
37 #x0e #x0f #x10 #x11 #x12 #x13 #x9d #x85 #x08 #x87 #x18 #x19 #x92 #x… | |
38 #x1c #x1d #x1e #x1f #x80 #x81 #x82 #x83 #x84 #x0a #x17 #x1b #x88 #x… | |
39 #x8a #x8b #x8c #x05 #x06 #x07 #x90 #x91 #x16 #x93 #x94 #x95 #x96 #x… | |
40 #x98 #x99 #x9a #x9b #x14 #x15 #x9e #x1a #x20 #xa0 #xe2 #xe4 #xe0 #x… | |
41 #xe3 #xe5 #xe7 #xf1 #xa2 #x2e #x3c #x28 #x2b #x7c #x26 #xe9 #xea #x… | |
42 #xe8 #xed #xee #xef #xec #xdf #x21 #x24 #x2a #x29 #x3b #xac #x2d #x… | |
43 #xc2 #xc4 #xc0 #xc1 #xc3 #xc5 #xc7 #xd1 #xa6 #x2c #x25 #x5f #x3e #x… | |
44 #xf8 #xc9 #xca #xcb #xc8 #xcd #xce #xcf #xcc #x60 #x3a #x23 #x40 #x… | |
45 #x3d #x22 #xd8 #x61 #x62 #x63 #x64 #x65 #x66 #x67 #x68 #x69 #xab #x… | |
46 #xf0 #xfd #xfe #xb1 #xb0 #x6a #x6b #x6c #x6d #x6e #x6f #x70 #x71 #x… | |
47 #xaa #xba #xe6 #xb8 #xc6 #xa4 #xb5 #x7e #x73 #x74 #x75 #x76 #x77 #x… | |
48 #x79 #x7a #xa1 #xbf #xd0 #xdd #xde #xae #x5e #xa3 #xa5 #xb7 #xa9 #x… | |
49 #xb6 #xbc #xbd #xbe #x5b #x5d #xaf #xa8 #xb4 #xd7 #x7b #x41 #x42 #x… | |
50 #x44 #x45 #x46 #x47 #x48 #x49 #xad #xf4 #xf6 #xf2 #xf3 #xf5 #x7d #x… | |
51 #x4b #x4c #x4d #x4e #x4f #x50 #x51 #x52 #xb9 #xfb #xfc #xf9 #xfa #x… | |
52 #x5c #xf7 #x53 #x54 #x55 #x56 #x57 #x58 #x59 #x5a #xb2 #xd4 #xd6 #x… | |
53 #xd3 #xd5 #x30 #x31 #x32 #x33 #x34 #x35 #x36 #x37 #x38 #x39 #xb3 #x… | |
54 #xdc #xd9 #xda #x9f)) | |
55 :test #'equalp) | |
56 | |
57 (define-constant +ebcdic-encode-table+ | |
58 (loop with rt = (make-array 256 :element-type 'ub8 :initial-element 0) | |
59 for code across +ebcdic-decode-table+ for i from 0 do | |
60 (assert (= 0 (aref rt code))) | |
61 (setf (aref rt code) i) | |
62 finally (return rt)) | |
63 :test #'equalp) | |
64 | |
65 (define-unibyte-encoder :ebcdic-us (code) | |
66 (if (>= code 256) | |
67 (handle-error) | |
68 (aref +ebcdic-encode-table+ code))) | |
69 | |
70 (define-unibyte-decoder :ebcdic-us (octet) | |
71 (aref +ebcdic-decode-table+ octet)) |