projects / unix-history / blame
| Commit | Line | Data |
|---|---|---|
| 20a575cc KT |
1 | #include "apl.h" |
| 2 | ||
| 3 | asciich() { | |
| 4 | extern unsigned char *iline; | |
| 5 | extern struct asoperbox charconv[OPERBOXSIZE]; | |
| 6 | register D,E,F,I; | |
| 7 | ||
| 8 | F = *iline++; | |
| 9 | if ( ( F == '.') && ( digit(*iline) == 0 ) ) { | |
| 10 | D = (int)*iline++; | |
| 11 | E = (int)*iline++; | |
| 12 | for (I = 0; I <= OPERBOXSIZE;I++) { | |
| 13 | if (( D== (charconv[I].letters[0]) ) && | |
| 14 | ( E== (charconv[I].letters[1]) ) ) { | |
| 15 | F = charconv[I].returnchar; | |
| 16 | goto out; | |
| 17 | } | |
| 18 | } | |
| 19 | --iline;--iline; | |
| 20 | } | |
| 21 | out: return(F); | |
| 22 | }; | |
| 23 | ||
| 24 | /* eventually this should be replaces with arrays that hae a better */ | |
| 25 | /* method of selecting and returning the lexical value, but */ | |
| 26 | /* for now, this is a quick implementation */ | |
| 27 | /* */ | |
| 28 | /* use char as subscript from ascii - get apl character hopefully */ | |
| 29 | /* for character conversion from ascii to apl char set --- */ | |
| 30 | /* see files write2.c and write3.c for more recent version */ | |
| 31 | ||
| 32 | struct asoperbox charconv[OPERBOXSIZE] = { | |
| 33 | /* ascii mnemonic ( from HP APL ascii char mnemonics and */ | |
| 34 | /* equivalent apl character value. */ | |
| 35 | /* all are two lowercase letters preceeded by a dot. */ | |
| 36 | /* letters for identifiers are lowercase or uppercase */ | |
| 37 | /* lowercase corresponding to apl uppercase and */ | |
| 38 | /* uppercase corresponding to apl underscored letters. */ | |
| 39 | ||
| 40 | "le", /* less than or equal */ '$', | |
| 41 | "ge", /* greater than or equal*/ '^', | |
| 42 | "ne", /* not equal */ '*', | |
| 43 | "om", /* omega ( not used ) */ 'W', | |
| 44 | "ep", /* epsilon */ 'E', | |
| 45 | "rh", /* shape (rho) */ 'R', | |
| 46 | "nt", /* not ( also '~' ) */ 'T', | |
| 47 | "tk", /* take ( also '^' ) */ 'Y', | |
| 48 | "dr", /* drop */ 'U', | |
| 49 | "it", /* iota */ 'I', | |
| 50 | "ci", /* circular function */ 'O', | |
| 51 | "al", /* alpha ( not used ) */ 'A', | |
| 52 | "cl", /* maximum ( ceiling ) */ 'S', | |
| 53 | "fl", /* minimum ( floor ) */ 'D', | |
| 54 | "dl", /* del ( not used ) */ 'G', | |
| 55 | "de", /* upside down del */ 'H', | |
| 56 | "jt", /* small circle ( null )*/ 'J', | |
| 57 | "qd", /* quad */ 'L', | |
| 58 | "ss", /* right U ( not used ) */ 'Z', | |
| 59 | "sc", /* left U ( not used ) */ 'X', | |
| 60 | "si", /* Down U */ 'C', | |
| 61 | "su", /* U ( not used ) */ 'V', | |
| 62 | "[^", /* upside-down del */ 'H', | |
| 63 | "bv", /* decode ( base ) */ 'B', | |
| 64 | "rp", /* encode ( rep ) */ 'N', | |
| 65 | "br", /* residue ( mod ) */ 'M', | |
| 66 | "sp", /* assignment */ '[', | |
| 67 | "go", /* goto */ ']', | |
| 68 | "or", /* or */ '(', | |
| 69 | "nn", /* nand */ 0205, | |
| 70 | "nr", /* nor */ 0206, | |
| 71 | "lg", /* log */ 0207, | |
| 72 | "rv", /* reversal */ 0217, | |
| 73 | "tr", /* transpose */ 0212, | |
| 74 | "rb", /* reverse bar */ 0214, | |
| 75 | "cb", /* comma bar ( not used)*/ 0, | |
| 76 | "sb", /* slash bar */ 0200, | |
| 77 | "bb", /* blackslash bar */ 0201, | |
| 78 | "gu", /* grade up */ 0215, | |
| 79 | "gd", /* grade down */ 0216, | |
| 80 | "qq", /* quote quad */ 0202, | |
| 81 | "dm", /* domino */ 0214, | |
| 82 | "lm", /* lamp */ 0204, | |
| 83 | "ib", /* i - beam */ 0213, | |
| 84 | "ex", /* execute ( not used ) */ 0, | |
| 85 | "fr", /* format( not used ) */ 0, | |
| 86 | "di", /* diamond ( not used ) */ 0, | |
| 87 | "ot", /* out ( not used ) */ 0, | |
| 88 | "ld", /* locked del (not used)*/ 0, | |
| 89 | "[a", /* alias for 'A' */ 0220, | |
| 90 | "[b", /* alias for 'B' */ 0221, | |
| 91 | "[c", /* alias for 'C' */ 0222, | |
| 92 | "[d", /* alias for 'D' */ 0223, | |
| 93 | "[e", /* alias for 'E' */ 0224, | |
| 94 | "[f", /* alias for 'F' */ 0225, | |
| 95 | "[g", /* alias for 'G' */ 0226, | |
| 96 | "[h", /* alias for 'H' */ 0227, | |
| 97 | "[i", /* alias for 'I' */ 0230, | |
| 98 | "[j", /* alias for 'J' */ 0231, | |
| 99 | "[k", /* alias for 'K' */ 0232, | |
| 100 | "[l", /* alias for 'L' */ 0233, | |
| 101 | "[m", /* alias for 'M' */ 0234, | |
| 102 | "[n", /* alias for 'N' */ 0235, | |
| 103 | "[o", /* alias for 'O' */ 0236, | |
| 104 | "[p", /* alias for 'P' */ 0237, | |
| 105 | "[q", /* alias for 'Q' */ 0240, | |
| 106 | "[r", /* alias for 'R' */ 0241, | |
| 107 | "[s", /* alias for 'S' */ 0242, | |
| 108 | "[t", /* alias for 'T' */ 0243, | |
| 109 | "[u", /* alias for 'U' */ 0244, | |
| 110 | "[v", /* alias for 'V' */ 0245, | |
| 111 | "[w", /* alias for 'W' */ 0246, | |
| 112 | "[x", /* alias for 'X' */ 0247, | |
| 113 | "[y", /* alias for 'Y' */ 0250, | |
| 114 | "[z", /* alias for 'Z' */ 0251 | |
| 115 | }; |