/* * APL system. * * There are four kinds of scalars: * - Booleans (0 or 1) * - Character (see below) * - Integer (int) * - Float (double) * Scalars are stored as rank-0 arrays. * * Arrays can have any rank up to MAXRANK. Everything is an array * (including scalars, as remarked above); an array is represented as * a header giving the type, rank, and refcount of the array, with an * indication of where the data is to be found. This can be kept * separately or it can be attached to the header. See the ARRAY * struct definition. * * There are three different representations used for text. * * To serialize text for purposes such as storing it in files, it must * be represented as an octet sequence. Our character set uses octet * values 32 through 122 (though there are two gaps in that range - 92 * and 96 are not used). Non-overstruck characters are represented as * single octets containing the relevant character code. Overstrikes * can be represented two ways. Overstrikes of 11 or fewer characters * are represented as a 0xff octet, followed by the overstruck codes, * in ascending numerical order, each stored in the low 7 bits of an * octet with the 0x80 bit set. Overstrikes of more than 11 * characters are represented as a 0xfe octet, followed by 11 octets * giving a bitmap of which codes are overstruck, with the 0x01 bit of * the first bitmap octet representing code 33, the 0x02 bit code 34, * the 0x01 bit of the second octet code 41, etc, with codes 92 and 96 * skipped, until the 0x80 bit of the last octet represents code 122. * In particular, each possible character or overstrike combination * has exactly one possible representation as an octet string. There * are many octet strings that do not correspond to valid character * sequences (any octet sequence beginning with an octet in the * 0x00-0x1f range, for example). * * Characters in arrays are represented with one of 12 different array * types. The content is much like I/O strings as described above, * except that each array member is stored in the same amount of * space, the leading 0xff or 0xfe octets are never present, and the * 0x80 markers on <=11-character overstrikes are also absent. There * are 12 character array types, one each specifying 1 through 11 * octets per character and a 12th specifying bitmap representation. * When using types 2 through 11, it is possible for some array * elements to need fewer octets than others; unused octets are always * the trailing octets and are filled with 0x00. A two-element array * whose [0] element contains a 97 character and whose [1] element * contains 111 overstruck with 120 would have a header type * specifying two octets per character and content octets containing * 97 0 111 120. * * Finally, characters also need representation in places, such as the * input line editor, where they are copied, inserted, and deleted * frequently, where ease of manipulation is the primary concern. In * places such as these, each character is represented as a 12-octet * blob. This is a single octet containing a value 1-12 followed by * 1-11 octets containing the character data. If fewer than 11 of the * data octets are used, the used octets are always the earliest ones, * with unused octets' values being unspecified and unused. * Overstrikes of 1-11 characters are represented with initial values * 1-11, with the characters' octets in that many of the data octets. * If the first octet contains 12, the 11 data octets hold a bitmap * representation of an overstrike, as outlined above. In a few * places, it is convenient to have a representation of C's \0 string * terminator; when this is so, it is represented as an initial 0 * octet, with none of the following 11 octets used. See the ECHAR * struct definition. */ #include #include #include #include #include #include #include #include #include #include extern const char *__progname; #define MAXRANK 31 typedef enum { AT_BOOL = 1, AT_INT, AT_FLOAT, AT_CHAR1, // CHAR1 through CHAR11 must be consecutive AT_CHAR2, AT_CHAR3, AT_CHAR4, AT_CHAR5, AT_CHAR6, AT_CHAR7, AT_CHAR8, AT_CHAR9, AT_CHAR10, AT_CHAR11, AT_CHARBM, } ATYPE; typedef struct array ARRAY; typedef struct echar ECHAR; typedef struct ilstate ILSTATE; struct echar { unsigned char type; unsigned char data[11]; } ; struct array { ATYPE type; int rank; int *dims; int refs; void *data; } ; struct ilstate { ECHAR *b; ECHAR *eb; int a; int l; int pl; int c; int dl; int dc; int nl; int curcols; ECHAR *curb; int cura; int curdl; int curnl; int curcr; int curcc; } ; // The number of buffers used by (eg) c_to_ec_tmp. #define TEMPBUFS 8 static ILSTATE il; static struct winsize wsz; static const unsigned char bitmap_vec[88] = { 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f, 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x4a, 0x4b, 0x4c, 0x4d, 0x4e, 0x4f, 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5a, 0x5b, 0x5d, 0x5e, 0x5f, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f, 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7a }; static FILE *il_dbg; static void get_wsz(void) { if (ioctl(1,TIOCGWINSZ,&wsz) < 0) { fprintf(stderr,"%s: can't TIOCGWINSZ: %s\n",__progname,strerror(errno)); } } static int c_to_bm(int c) { switch (c) { case 0x21: return(0); break; case 0x22: return(1); break; case 0x23: return(2); break; case 0x24: return(3); break; case 0x25: return(4); break; case 0x26: return(5); break; case 0x27: return(6); break; case 0x28: return(7); break; case 0x29: return(8); break; case 0x2a: return(9); break; case 0x2b: return(10); break; case 0x2c: return(11); break; case 0x2d: return(12); break; case 0x2e: return(13); break; case 0x2f: return(14); break; case 0x30: return(15); break; case 0x31: return(16); break; case 0x32: return(17); break; case 0x33: return(18); break; case 0x34: return(19); break; case 0x35: return(20); break; case 0x36: return(21); break; case 0x37: return(22); break; case 0x38: return(23); break; case 0x39: return(24); break; case 0x3a: return(25); break; case 0x3b: return(26); break; case 0x3c: return(27); break; case 0x3d: return(28); break; case 0x3e: return(29); break; case 0x3f: return(30); break; case 0x40: return(31); break; case 0x41: return(32); break; case 0x42: return(33); break; case 0x43: return(34); break; case 0x44: return(35); break; case 0x45: return(36); break; case 0x46: return(37); break; case 0x47: return(38); break; case 0x48: return(39); break; case 0x49: return(40); break; case 0x4a: return(41); break; case 0x4b: return(42); break; case 0x4c: return(43); break; case 0x4d: return(44); break; case 0x4e: return(45); break; case 0x4f: return(46); break; case 0x50: return(47); break; case 0x51: return(48); break; case 0x52: return(49); break; case 0x53: return(50); break; case 0x54: return(51); break; case 0x55: return(52); break; case 0x56: return(53); break; case 0x57: return(54); break; case 0x58: return(55); break; case 0x59: return(56); break; case 0x5a: return(57); break; case 0x5b: return(58); break; case 0x5d: return(59); break; case 0x5e: return(60); break; case 0x5f: return(61); break; case 0x61: return(62); break; case 0x62: return(63); break; case 0x63: return(64); break; case 0x64: return(65); break; case 0x65: return(66); break; case 0x66: return(67); break; case 0x67: return(68); break; case 0x68: return(69); break; case 0x69: return(70); break; case 0x6a: return(71); break; case 0x6b: return(72); break; case 0x6c: return(73); break; case 0x6d: return(74); break; case 0x6e: return(75); break; case 0x6f: return(76); break; case 0x70: return(77); break; case 0x71: return(78); break; case 0x72: return(79); break; case 0x73: return(80); break; case 0x74: return(81); break; case 0x75: return(82); break; case 0x76: return(83); break; case 0x77: return(84); break; case 0x78: return(85); break; case 0x79: return(86); break; case 0x7a: return(87); break; } abort(); } static int c_to_ec_1(char c) { switch (c) { case ' ': return(0x20); break; case '': return(0x21); break; case ')': return(0x22); break; case '<': return(0x23); break; case '': return(0x24); break; case '=': return(0x25); break; case '>': return(0x26); break; case ']': return(0x27); break; case 'v': return(0x28); break; case '^': return(0x29); break; case '': return(0x2a); break; case '': return(0x2b); break; case ',': return(0x2c); break; case '+': return(0x2d); break; case '.': return(0x2e); break; case '/': return(0x2f); break; case '0': return(0x30); break; case '1': return(0x31); break; case '2': return(0x32); break; case '3': return(0x33); break; case '4': return(0x34); break; case '5': return(0x35); break; case '6': return(0x36); break; case '7': return(0x37); break; case '8': return(0x38); break; case '9': return(0x39); break; case '(': return(0x3a); break; case '[': return(0x3b); break; case ';': return(0x3c); break; case '': return(0x3d); break; case ':': return(0x3e); break; case '\\':return(0x3f); break; // many of 0x40-0x5f have no simple text form case '': return(0x40); break; case '_': return(0x46); break; case '\'':return(0x4b); break; case '*': return(0x50); break; case '?': return(0x51); break; case '~': return(0x54); break; // 0x5c: hole case '': return(0x5e); break; case '-': return(0x5f); break; // 0x60: hole case 'A': return(0x61); break; case 'B': return(0x62); break; case 'C': return(0x63); break; case 'D': return(0x64); break; case 'E': return(0x65); break; case 'F': return(0x66); break; case 'G': return(0x67); break; case 'H': return(0x68); break; case 'I': return(0x69); break; case 'J': return(0x6a); break; case 'K': return(0x6b); break; case 'L': return(0x6c); break; case 'M': return(0x6d); break; case 'N': return(0x6e); break; case 'O': return(0x6f); break; case 'P': return(0x70); break; case 'Q': return(0x71); break; case 'R': return(0x72); break; case 'S': return(0x73); break; case 'T': return(0x74); break; case 'U': return(0x75); break; case 'V': return(0x76); break; case 'W': return(0x77); break; case 'X': return(0x78); break; case 'Y': return(0x79); break; case 'Z': return(0x7a); break; } return(-1); } static ECHAR *c_to_ec_tmp(const char *s) { int l; static ECHAR *bufs[TEMPBUFS] = { 0 }; static int space[TEMPBUFS] = { 0 }; static int hand = 0; ECHAR *p; int i; int c; l = strlen(s) + 1; if (l > space[hand]) { free(bufs[hand]); space[hand] = l; bufs[hand] = malloc(l*sizeof(ECHAR)); } p = bufs[hand]; hand --; if (hand < 0) hand = TEMPBUFS - 1; l --; for (i=0;itype != b->type) return(0); if (a->type == 0) return(1); return(!bcmp(&a->data[0],&b->data[0],(a->type==12)?11:a->type)); } static void ec_copy(const ECHAR *f, ECHAR *t, int n) { bcopy(f,t,n*sizeof(ECHAR)); } static void ec_fill(ECHAR *t, const ECHAR *f, int n) { for (;n>0;n--) *t++ = *f; } static void ec_dump(const ECHAR *e, FILE *f) { const char *pref; int i; switch (e->type) { case 0 ... 11: fprintf(f,"<"); pref = ""; for (i=0;itype;i++) { fprintf(f,"%s%02x",pref,e->data[i]); pref = "+"; } fprintf(f,">"); break; case 12: fprintf(f,"<"); pref = ""; for (i=0;i<88;i++) { if (e->data[i>>3]&(1<<(i&7))) fprintf(f,"%s%02x",pref,bitmap_vec[i]); pref = "+"; } fprintf(f,">"); break; default: fprintf(f,"",e->type); break; } } static void ec_print(const ECHAR *s, int l) { int i; int any; if (il_dbg) fprintf(il_dbg," ec_print sending"); for (;l>0;s++,l--) { if (s->type < 12) { for (i=s->type-1;i>=0;i--) { if (il_dbg) fprintf(il_dbg," %02x",s->data[i]); putchar(s->data[i]); if (i) { if (il_dbg) fprintf(il_dbg," ^H"); putchar(0x08); } } } else if (s->type == 12) { any = 0; for (i=88-1;i>=0;i--) { if (s->data[i>>3] & (1U << (i & 7))) { if (any) { if (il_dbg) fprintf(il_dbg," ^H"); putchar(0x08); } if (il_dbg) fprintf(il_dbg," %02x",bitmap_vec[i]); putchar(bitmap_vec[i]); any = 1; } } } else { abort(); } } if (il_dbg) fprintf(il_dbg," done\n"); } static void ec_overstrike(ECHAR *e, int c, int b) { int i; int j; if ((e->type == 1) && (e->data[0] == 0x20)) { e->data[0] = c; } else if (e->type == 12) { e->data[b>>3] |= 1 << (b & 7); } else { j = e->type; for (i=j-1;i>=0;i--) { if (c == e->data[i]) return; if (c > e->data[i]) j = i; } if (e->type == 11) { ECHAR t; t.type = 12; bzero(&t.data[0],11); t.data[b>>3] = 1 << (b & 7); for (i=11-1;i>=0;i--) { b = c_to_bm(e->data[i]); t.data[b>>3] |= 1 << (b & 7); } *e = t; } else { if (j < e->type) bcopy(&e->data[j],&e->data[j+1],e->type-j); e->type ++; e->data[j] = c; } } } static ARRAY *new_array_l(ATYPE at, int rank, ...) { va_list ap; ARRAY *a; int x; int dims[MAXRANK]; int nb; if ((rank < 0) || (rank > MAXRANK)) abort(); va_start(ap,rank); if (rank) { for (x=0;xtype = at; a->rank = rank; a->dims = malloc(rank*sizeof(int)); bcopy(&dims[0],a->dims,rank*sizeof(int)); a->refs = 1; a->data = malloc(nb); return(a); } static ARRAY *ecv_to_array(const ECHAR *s, int l) { int mt; int i; int nb; int bpc; ARRAY *a; ATYPE at; unsigned char *ap; mt = -1; for (i=l-1;i>=0;i--) { if (s[i].type > mt) mt = s[i].type; } if (mt < 0) { // line must be empty! return(0); } if (mt < 1) { // can this happen? return(0); } if (mt < 12) { bpc = mt; at = AT_CHAR1 + (mt - 1); } else if (mt == 12) { bpc = 11; at = AT_CHARBM; } else { abort(); } nb = l * bpc; a = new_array_l(at,1,l,nb); ap = a->data; if (mt == 12) { for (i=l;i>0;i--,s++,ap+=11) { bcopy(&s->data[0],ap,11); } } else { for (i=l;i>0;i--,s++,ap+=mt) { bcopy(&s->data[0],ap,s->type); if (s->type < mt) bzero(ap+s->type,mt-s->type); } } return(a); } static void array_drop(ARRAY *a) { a->refs --; if (a->refs > 0) return; if (a->refs < 0) abort(); free(a->dims); free(a->data); free(a); } static void il_init(void) { struct termios tio; int fd; wsz.ws_col = 0; get_wsz(); if (wsz.ws_col == 0) { fprintf(stderr,"%s: No window size\n",__progname); exit(1); } if (wsz.ws_col < 10) { fprintf(stderr,"%s: window too narrow\n",__progname); exit(1); } il.b = 0; il.eb = 0; il.a = 0; il.l = 0; il.pl = 0; il.c = 0; il.curcols = wsz.ws_col; il.curb = 0; il.cura = 0; il.curdl = 0; il.curnl = 1; il.curcr = 0; il.curcc = 0; printf("\x1f" "overstrike:1\x0d"); tcgetattr(0,&tio); tio.c_lflag &= ~(ECHOKE|ECHOE|ECHOK|ECHO|ECHONL|ECHOPRT|ECHOCTL|ICANON); tio.c_cc[VMIN] = 1; tio.c_cc[VTIME] = 0; tcsetattr(0,TCSADRAIN|TCSASOFT,&tio); fd = open("apl.il.dbg",O_WRONLY|O_APPEND|O_TRUNC,0); if (fd < 0) { il_dbg = 0; } else { il_dbg = fdopen(fd,"a"); } } static void il_room(int l) { if (il.a < il.pl + l) { il.a = il.pl + l + 8; il.b = realloc(il.b,il.a*sizeof(ECHAR)); il.eb = il.b + il.pl; } } static void il_set_prefix(ECHAR *p) { int i; for (i=0;p[i].type;i++) ; il.pl = i; il_room(0); il.eb = il.b + il.pl; ec_copy(p,il.b,i); } static void il_del_at(int x, int n) { if ((x < 0) || (x+n > il.l)) abort(); if (x+n < il.l) ec_copy(il.eb+x+n,il.eb+x,il.l-(x+n)); il.l -= n; } static void il_transpose(void) { ECHAR t; if (il.c < 2) abort(); t = il.eb[il.c-2]; il.eb[il.c-2] = il.eb[il.c-1]; il.eb[il.c-1] = t; } static void il_printable(unsigned char c) { ECHAR *t; const void *p; int b; if (c == ' ') { b = -1; } else { p = memchr(&bitmap_vec[0],c,88); if (! p) abort(); b = ((const unsigned char *)p) - &bitmap_vec[0]; } if (il.c == il.l) { il_room(il.l+1); t = &il.eb[il.c]; t->type = 1; t->data[0] = c; il.l ++; } else if (b >= 0) { ec_overstrike(&il.eb[il.c],c,b); } il.c ++; } static void il_insert_space(int at, int n) { ECHAR e; if ((at < 0) || (at > il.l)) abort(); il_room(il.l+n); if (at < il.l) ec_copy(il.eb+at,il.eb+at+n,il.l-at); e.type = 1; e.data[0] = 0x20; ec_fill(il.eb+at,&e,n); il.l += n; } static void il_cursto(int r, int c) { if (il_dbg) fprintf(il_dbg," cursto from r=%d c=%d to r=%d c=%d:",il.curcr,il.curcc,r,c); while (il.curcr > r) { if (il_dbg) fprintf(il_dbg," ^X"); putchar(0x18); il.curcr --; } while (il.curcr < r) { if (il_dbg) fprintf(il_dbg," ^N"); putchar(0x0e); il.curcr ++; } if ((c > 4) && (abs(c-il.curcc) > 5)) { if (il_dbg) fprintf(il_dbg," ^F-.%d.",c); putchar(0x06); printf("-.%d.",c); il.curcc = c; } else { if (1+c < il.curcc-c) { if (il_dbg) fprintf(il_dbg," ^M"); putchar(0x0d); il.curcc = 0; } while (il.curcc > c) { if (il_dbg) fprintf(il_dbg," ^H"); putchar(0x08); il.curcc --; } while (il.curcc < c) { if (il_dbg) fprintf(il_dbg," ^S"); putchar(0x13); il.curcc ++; } } if (il_dbg) fprintf(il_dbg," done\n"); } static void il_curstox(int x) { il_cursto(x/wsz.ws_col,x%wsz.ws_col); } static void il_end_next(void) { while (il.curcr < il.curnl-1) { putchar(0x0e); il.curcr ++; } putchar(0x0d); putchar(0x0a); } static void il_update(void) { int i; int j; int x0; int x1; int n; // Sanity check. if ((il.c < 0) || (il.l < 0) || (il.c > il.l)) abort(); // Compute dl and dc, which are l and c with the prefix included. il.dl = il.pl + il.l; il.dc = il.pl + il.c; if (il_dbg) { fprintf(il_dbg,"update\n"); fprintf(il_dbg," dl=%d dc=%d (pl=%d l=%d c=%d) cols=%d\n",il.dl,il.dc,il.pl,il.l,il.c,wsz.ws_col); n = (il.curcr * il.curcols) + il.curcc; fprintf(il_dbg," curdl=%d curc=%d (curcols=%d curcr=%d curcc=%d)\n",il.curdl,n,il.curcols,il.curcr,il.curcc); fprintf(il_dbg," cur data:"); for (i=0;i il.cura) { il.curb = realloc(il.curb,(il.cura=il.dl+16)*sizeof(ECHAR)); if (il_dbg) fprintf(il_dbg," grew curb\n"); } // x0 = 0; while ((x0 < il.dl) && (x0 < il.curdl) && ec_equal(&il.b[x0],&il.curb[x0])) x0 ++; if (il_dbg) fprintf(il_dbg," initial equal up to %d\n",x0); if ((x0 != il.dl) || (il.dl != il.curdl)) { while (1) { x1 = x0; while ((x1 < il.dl) && (x1 < il.curdl) && ec_equal(&il.b[x1],&il.curb[x1])) x1 ++; if (il_dbg) fprintf(il_dbg," end of equal %d\n",x1); if (x1 > x0) x0 = x1; if (x0 == il.dl) { if (il_dbg) fprintf(il_dbg," at end of new\n"); if (x0 < il.curdl) { if (il_dbg) fprintf(il_dbg," clearing extra: %d\n",il.curdl-x0); j = il.curdl / wsz.ws_col; i = x0 / wsz.ws_col; while (j > i) { il_cursto(j,0); putchar(0x03); j --; } if (il_dbg) fprintf(il_dbg," clearing\n"); il_cursto(i,x0%wsz.ws_col); putchar(0x03); } break; } while ((x1 < il.dl) && (x1 < il.curdl) && !ec_equal(&il.b[x1],&il.curb[x1])) x1 ++; if (il_dbg) fprintf(il_dbg," end of difference %d\n",x1); if ((x1 == il.curdl) && (x1 < il.dl)) { x1 = il.dl; if (il_dbg) fprintf(il_dbg," extending into new, end now %d\n",x1); } while (x0 < x1) { i = x0 / wsz.ws_col; j = x0 % wsz.ws_col; il_cursto(i,j); n = wsz.ws_col - j; if (n > x1-x0) n = x1 - x0; if (il_dbg) fprintf(il_dbg," printing %d from %d, sending \"^^",n,x0); putchar(0x1e); if (n != 1) { if (il_dbg) fprintf(il_dbg,"%d",n); printf("%d",n); } putchar(' '); if (il_dbg) fprintf(il_dbg," \"\n"); ec_print(&il.b[x0],n); ec_copy(&il.b[x0],&il.curb[x0],n); il.curcc += n; if (il.curcc >= wsz.ws_col) { il.curcc = 0; il.curcr ++; } x0 += n; } } } il.curdl = il.dl; il_curstox(il.dc); il.curnl = il.curdl / wsz.ws_col; if (il_dbg) fprintf(il_dbg," update done\n"); } static void il_new_line(void) { il.l = 0; il.c = 0; il.curdl = 0; il.curnl = 1; il.curcr = 0; il.curcc = 0; } static void execute_line(ARRAY *a) { (void)a; } static void il_finish_line(void) { ARRAY *a; il_end_next(); if (il.l > 0) { a = ecv_to_array(il.eb,il.l); execute_line(a); array_drop(a); } il_new_line(); } static void il_typein(unsigned char c) { switch (c) { case 0x01: // ^A il.c = 0; break; case 0x02: // ^B if (il.c > 0) il.c --; break; case 0x04: // ^D il_del_at(il.c,1); break; case 0x05: // ^E il.c = il.l; break; case 0x06: // ^F if (il.c < il.l) il.c ++; break; case 0x08: // ^H case 0x7f: // DEL if (il.c > 0) { il.c --; il_del_at(il.c,1); } break; case 0x09: // ^I il_insert_space(il.c,1); break; case 0x0a: // ^J case 0x0d: // ^M il_finish_line(); break; case 0x0b: // ^K il_del_at(il.c,il.l-il.c); break; case 0x0c: // ^L il.curcols = -1; // XXX break; case 0x14: // ^T il_transpose(); break; default: if ((c >= 32) && (c <= 122) && (c != 92) && (c != 96)) { il_printable(c); } else { putchar(0x07); } break; } } static void il_input(void) { unsigned char rbuf[256]; int nr; int i; fflush(0); nr = read(0,&rbuf[0],sizeof(rbuf)); if (nr == 0) exit(0); if (nr < 0) { switch (errno) { case EINTR: return; break; } fprintf(stderr,"%s: input read: %s\n",__progname,strerror(errno)); exit(1); } for (i=0;i