/* * APL system. * * There are four kinds of scalars: * - Booleans (0 or 1) * - Character (see below) * - Integer (long long int) * - Float (double) * Scalars are handled 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 two 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 memory, being operated on, are represented as ECHARs. * An ECHAR is a 12-byte data structure. It contains one octet which * is a type number, 1 through 12; if this number is 1 through 11, * then there are that many of the other 11 octets containing the * overstruck characters, with the extra octets, if any, undefined and * unused; if the type number is 12, then the other 11 octets hold a * bitmap, as described for serialization, above, without the leading * 0xfe octet. In a few places, where a representation for C's \0 * terminator as an ECHAR is convenient, it is represented with a type * octet of 0, with all 11 of the other octets undefined and unused. */ #include #include #include #include #include #include #include #include #include #include #include #include extern const char *__progname; #define MAXRANK 31 typedef unsigned long long int ULLI; typedef long long int LLI; typedef LLI APLINT; #define APLINT_MAX ((LLI)((~(ULLI)0)>>1)) typedef double APLFLOAT; #define APLFLOAT_MAX DBL_MAX typedef enum { AT_BOOL = 1, AT_INT, AT_FLOAT, AT_CHAR, } ATYPE; // Character values with special significance #define CH_SPACE 0x20 #define CH_RPAREN 0x22 #define CH_RBRACK 0x27 #define CH_AND 0x29 #define CH_DOT 0x2e #define CH_LPAREN 0x3a #define CH_DIGIT_0 0x30 #define CH_DIGIT_1 0x31 #define CH_DIGIT_2 0x32 #define CH_DIGIT_3 0x33 #define CH_DIGIT_4 0x34 #define CH_DIGIT_5 0x35 #define CH_DIGIT_6 0x36 #define CH_DIGIT_7 0x37 #define CH_DIGIT_8 0x38 #define CH_DIGIT_9 0x39 #define CH_NEGNUM 0x40 #define CH_UNDER 0x46 #define CH_DELTA 0x48 #define CH_JOT 0x4a #define CH_QUOTE 0x4b #define CH_QUAD 0x4c #define CH_ASSIGN 0x5b #define CH_LETTER_A 0x61 #define CH_LETTER_B 0x62 #define CH_LETTER_C 0x63 #define CH_LETTER_D 0x64 #define CH_LETTER_E 0x65 #define CH_LETTER_F 0x66 #define CH_LETTER_G 0x67 #define CH_LETTER_H 0x68 #define CH_LETTER_I 0x69 #define CH_LETTER_J 0x6a #define CH_LETTER_K 0x6b #define CH_LETTER_L 0x6c #define CH_LETTER_M 0x6d #define CH_LETTER_N 0x6e #define CH_LETTER_O 0x6f #define CH_LETTER_P 0x70 #define CH_LETTER_Q 0x71 #define CH_LETTER_R 0x72 #define CH_LETTER_S 0x73 #define CH_LETTER_T 0x74 #define CH_LETTER_U 0x75 #define CH_LETTER_V 0x76 #define CH_LETTER_W 0x77 #define CH_LETTER_X 0x78 #define CH_LETTER_Y 0x79 #define CH_LETTER_Z 0x7a #define TT_NULL 1 #define TT_IDENT 2 #define TT_CHAR 3 #define TT_NUM 4 #define TT_STRING 5 #define TT_NONE 6 #define TT_END 7 typedef enum { SK_VAR = 1, SK_FN, SK_LBL, } SYMKIND; typedef struct array ARRAY; typedef struct echar ECHAR; typedef struct ilstate ILSTATE; typedef struct sym SYM; typedef struct xstack XSTACK; struct echar { unsigned char type; unsigned char data[11]; } ; struct xstack { XSTACK *link; ARRAY *rhs; ECHAR *op; ECHAR closer; } ; struct sym { ECHAR *name; unsigned int namelen; SYMKIND kind; union { ARRAY *var; // fn not yet implemented // lbl not yet implemented } u; } ; struct array { ATYPE type; int rank; int *dims; int els; int refs; union { unsigned char *b; APLINT *i; APLFLOAT *f; ECHAR *c; } d; } ; 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 void (*err_throw)(void); 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 }; /* * Annoying. C99 specifies that later initializers override earlier, * but apparently that postdates 1.4T's compiler. And I haven't come * up with any way to do this mechanically without depending on that. * So, instead, we give up on consting this and build it at startup * time. */ static unsigned char bitmap_ivec[256]; static FILE *il_dbg; static unsigned char digits_map[11]; static unsigned char letters_map[11]; static unsigned char letters_digits_map[11]; static unsigned char digits_ch[10] = { CH_DIGIT_0, CH_DIGIT_1, CH_DIGIT_2, CH_DIGIT_3, CH_DIGIT_4, CH_DIGIT_5, CH_DIGIT_6, CH_DIGIT_7, CH_DIGIT_8, CH_DIGIT_9 }; static void get_wsz(void) { if (ioctl(1,TIOCGWINSZ,&wsz) < 0) { fprintf(stderr,"%s: can't TIOCGWINSZ: %s\n",__progname,strerror(errno)); } } static unsigned int bitvec_bytes(unsigned int bits) { return((bits+7)>>3); } static void bitvec_set(unsigned char *vec, unsigned int inx) { vec[inx>>3] |= 1 << (inx & 7); } static void bitvec_clr(unsigned char *vec, unsigned int inx) { vec[inx>>3] &= ~(1 << (inx & 7)); } static int bitvec_isset(const unsigned char *vec, unsigned int inx) { return((vec[inx>>3]>>(inx&7))&1); } 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 int ec_equal_single(const ECHAR *ec, unsigned char ch) { if (ec->type != 1) return(0); return(ec->data[0]==ch); } static int ec_map_single(const ECHAR *ec, unsigned char *map) { int b; if (ec->type != 1) return(0); b = bitmap_ivec[ec->data[0]]; if (b == 0xff) return(0); return(bitvec_isset(map,b)); } static int ec_equal_double(const ECHAR *ec, unsigned char ch1, unsigned char ch2) { if (ec->type != 2) return(0); return( ((ec->data[0] == ch1) && (ec->data[1] == ch2)) || ((ec->data[0] == ch2) && (ec->data[1] == ch1)) ); } static int ec_map_double(const ECHAR *ec, unsigned char ch, unsigned char *map) { int b; if (ec->type != 2) return(0); if (ec->data[0] == ch) { ch = ec->data[1]; } else if (ec->data[1] == ch) { ch = ec->data[0]; } else { return(0); } b = bitmap_ivec[ch]; if (b == 0xff) return(0); return(bitvec_isset(map,b)); } 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 (bitvec_isset(e->data,i)) 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 < 1) || (s->type > 12)) abort(); if (s->type == 12) { any = 0; for (i=88-1;i>=0;i--) { if (bitvec_isset(&s->data[0],i)) { if (any) { if (il_dbg) fprintf(il_dbg," \\b"); putchar(0x08); } if (il_dbg) fprintf(il_dbg," %02x",bitmap_vec[i]); putchar(bitmap_vec[i]); any = 1; } } } else { 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," \\b"); putchar(0x08); } } } } 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) { bitvec_set(e->data,b); } 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); bitvec_set(t.data,b); for (i=11-1;i>=0;i--) { b = bitmap_ivec[e->data[i]]; if (b == 0xff) abort(); bitvec_set(t.data,b); } *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 cells; if ((rank < 0) || (rank > MAXRANK)) abort(); va_start(ap,rank); cells = 1; if (rank) { for (x=0;xtype = at; a->rank = rank; if (rank) { a->dims = malloc(rank*sizeof(int)); bcopy(&dims[0],a->dims,rank*sizeof(int)); } else { a->dims = 0; } a->els = cells; a->refs = 1; switch (at) { case AT_BOOL: a->d.b = malloc(bitvec_bytes(cells)); break; case AT_INT: a->d.i = malloc(cells*sizeof(APLINT)); break; case AT_FLOAT: a->d.f = malloc(cells*sizeof(APLFLOAT)); break; case AT_CHAR: a->d.c = malloc(cells*sizeof(ECHAR)); break; default: abort(); break; } return(a); } static ARRAY *new_array_v(ATYPE at, int rank, const int *dims) { ARRAY *a; int x; int cells; if ((rank < 0) || (rank > MAXRANK)) abort(); cells = 1; if (rank) { for (x=0;xtype = at; a->rank = rank; a->dims = malloc(rank*sizeof(int)); bcopy(dims,a->dims,rank*sizeof(int)); a->els = cells; a->refs = 1; switch (at) { case AT_BOOL: a->d.b = malloc(bitvec_bytes(cells)); break; case AT_INT: a->d.i = malloc(cells*sizeof(APLINT)); break; case AT_FLOAT: a->d.f = malloc(cells*sizeof(APLFLOAT)); break; case AT_CHAR: a->d.c = malloc(cells*sizeof(ECHAR)); break; default: abort(); break; } return(a); } static void array_drop(ARRAY *a) { a->refs --; if (a->refs > 0) return; if (a->refs < 0) abort(); free(a->dims); switch (a->type) { case AT_BOOL: free(a->d.b); break; case AT_INT: free(a->d.i); break; case AT_FLOAT: free(a->d.f); break; case AT_CHAR: free(a->d.c); break; default: abort(); break; } 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; int b; if (c == ' ') { b = -1; } else { b = bitmap_ivec[c]; if (b == 0xff) abort(); } 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 exec_err(const ECHAR *, int, int, int, const char *, ...) __attribute__((__format__(__printf__,5,6),__noreturn__)); static void exec_err(const ECHAR *line, int ll, int at, int n, const char *fmt, ...) { char *s; int l; va_list ap; int ec; int i; va_start(ap,fmt); l = vasprintf(&s,fmt,ap); va_end(ap); for (i=0;i0;i--) putchar(CH_SPACE); for (i=n;i>0;i--) putchar(CH_AND); printf("\n"); } (*err_throw)(); abort(); } static ARRAY *promote_array(ARRAY *a, ATYPE t) { ARRAY *n; int i; switch (a->type) { case AT_BOOL: switch (t) { case AT_BOOL: return(a); break; case AT_INT: n = new_array_v(AT_INT,a->rank,a->dims); for (i=a->els-1;i>=0;i--) n->d.i[i] = bitvec_isset(a->d.b,i) ? 1 : 0; break; case AT_FLOAT: n = new_array_v(AT_FLOAT,a->rank,a->dims); for (i=a->els-1;i>=0;i--) n->d.f[i] = bitvec_isset(a->d.b,i) ? 1 : 0; break; case AT_CHAR: return(0); break; default: abort(); break; } break; case AT_INT: switch (t) { case AT_BOOL: case AT_INT: return(a); break; case AT_FLOAT: n = new_array_v(AT_FLOAT,a->rank,a->dims); for (i=a->els-1;i>=0;i--) n->d.f[i] = a->d.i[i]; return(n); break; case AT_CHAR: return(0); break; default: abort(); break; } break; case AT_FLOAT: switch (t) { case AT_BOOL: case AT_INT: case AT_FLOAT: return(a); break; case AT_CHAR: return(0); break; default: abort(); break; } break; case AT_CHAR: switch (t) { case AT_CHAR: return(a); break; case AT_BOOL: case AT_INT: case AT_FLOAT: return(0); break; default: abort(); break; } break; default: abort(); break; } array_drop(a); return(n); } static ARRAY *grow_vector(ARRAY *a, int newsize) { int nb; if (a->rank != 1) abort(); if (newsize <= a->dims[0]) return(a); switch (a->type) { case AT_BOOL: nb = bitvec_bytes(newsize); if (nb == bitvec_bytes(a->dims[0])) return(a); a->d.b = realloc(a->d.b,nb); a->dims[0] = newsize; break; case AT_INT: a->d.i = realloc(a->d.i,newsize*sizeof(APLINT)); a->dims[0] = newsize; break; case AT_FLOAT: a->d.i = realloc(a->d.i,newsize*sizeof(APLFLOAT)); a->dims[0] = newsize; break; case AT_CHAR: a->d.i = realloc(a->d.i,newsize*sizeof(ECHAR)); a->dims[0] = newsize; break; default: abort(); break; } return(a); } static ARRAY *perform_op(ARRAY *lhs, ECHAR *op, ARRAY *rhs) { (void)lhs; (void)op; (void)rhs; exec_err(0,0,0,0,"EXECUTE: OPERATIONS NOT IMPLEMENTED"); } static void reverse_vector(ARRAY *a) { int i; int j; if (a->rank != 1) abort(); for (i=a->dims[0]-1,j=0;i>j;i--,j++) { switch (a->type) { case AT_BOOL: if (bitvec_isset(a->d.b,i)) { if (! bitvec_isset(a->d.b,j)) { bitvec_clr(a->d.b,i); bitvec_set(a->d.b,j); } } else { if (bitvec_isset(a->d.b,j)) { bitvec_set(a->d.b,i); bitvec_clr(a->d.b,j); } } break; case AT_INT: { APLINT t; t = a->d.i[i]; a->d.i[i] = a->d.i[j]; a->d.i[j] = t; } break; case AT_FLOAT: { APLFLOAT t; t = a->d.f[i]; a->d.f[i] = a->d.f[j]; a->d.f[j] = t; } break; case AT_CHAR: { ECHAR t; t = a->d.c[i]; a->d.c[i] = a->d.c[j]; a->d.c[j] = t; } break; } } } static ARRAY *execute_tokenized(ECHAR *line, unsigned char *tok, int len) { __label__ errto; void (*save_throw)(void); int t1; int t0; ARRAY *rhs; ECHAR *op; ECHAR *lastop; unsigned char digits[64]; int digits_n; unsigned char edigits[8]; int edigits_n; int dot; int neg_n; int neg_e; int i; ARRAY *val; int vt; int vs; APLINT v_i; APLFLOAT v_f; XSTACK *stack; int tt; int moreval; void throw(void) { goto errto; } save_throw = err_throw; err_throw = &throw; if (0) { errto:; if (val) array_drop(val); if (rhs) array_drop(rhs); while (stack) { XSTACK *t; t = stack; stack = t->link; array_drop(t->rhs); free(t); } err_throw = save_throw; (*err_throw)(); abort(); } rhs = 0; op = 0; lastop = 0; val = 0; stack = 0; t0 = len; while (1) { if (t0 > 0) { t1 = --t0; for (;(t0>=0)&&(tok[t0]==tok[t1]);t0--) ; t0 ++; t1 ++; if (t1 == t0) abort(); tt = tok[t0] >> 1; } else if (t0 == 0) { t0 --; tt = TT_END; } else { break; } if (tt == TT_NULL) continue; if (val && (tt != moreval)) { if (val->rank != 1) abort(); if (vs == 1) { free(val->dims); val->dims = 0; val->rank = 0; } else { val->dims[0] = vs; reverse_vector(val); } if (rhs) { if (op) { rhs = perform_op(val,op,rhs); lastop = op; op = 0; } else { exec_err(line,len,t0,1,"EXECUTE: CONSECUTIVE VALUES"); } } else { rhs = val; val = 0; } } moreval = TT_NONE; switch (tok[t0] >> 1) { case TT_IDENT: if ( (t0 > 0) && ((tok[t0-1] >> 1) == TT_CHAR) && ec_equal_single(line+t0-1,CH_QUAD) ) { exec_err(line,len,t0-1,t1-t0,"EXECUTE: SYSTEM FUNCTIONS NOT IMPLEMENTED"); } exec_err(line,len,t0,t1-t0,"EXECUTE: IDENTIFIERS NOT IMPLEMENTED"); break; case TT_CHAR: if (ec_equal_single(line+t0,CH_RPAREN)) { exec_err(line,len,t0,1,"EXECUTE: ( ) NOT IMPLEMENTED"); } else if (ec_equal_single(line+t0,CH_RBRACK)) { exec_err(line,len,t0,1,"EXECUTE: [ ] NOT IMPLEMENTED"); } else { if (rhs) { if (op) { rhs = perform_op(0,op,rhs); lastop = 0; } op = line + t0; } else { exec_err(line,len,t0,1,"EXECUTE: MISSING OPERAND"); } } break; case TT_NUM: digits_n = 0; edigits_n = -1; dot = -1; neg_n = 0; neg_e = 0; // Syntax checking done at token-splitting time, not here. for (i=t0;i { for (dv=10-1;dv>=0;dv--) { if (ec_equal_single(line+i,digits_ch[dv])) break <"found">; } abort(); } while (0); if (edigits_n < 0) { digvec = &digits[0]; np = &digits_n; max = sizeof(digits); } else { digvec = &edigits[0]; np = &edigits_n; max = sizeof(edigits); } if ((np[0] == 1) && (digvec[0] == 0) && (dv == 0)) { // nothing } else if (np[0] < max) { digvec[np[0]++] = dv; } else if (edigits_n < 0) { np[0] ++; } else { exec_err(line,len,t0,t1-t0,"EXECUTE: NUMERIC EXPONENT OUT OF RANGE"); } } } if ((dot < 0) && (edigits_n < 0)) { // Integer if it's within range, float if not. int digv; int usefloat; v_i = 0; usefloat = 0; for (i=0;i APLFLOAT_MAX/10) { exec_err(line,len,t0,t1-t0,"EXECUTE: FLOATING MANTISSA OVERFLOW"); } v_f = (v_f * 10) + digv; } else { if ( (v_i > APLINT_MAX/10) || ( (v_i == APLINT_MAX/10) && (digv > APLINT_MAX%10) ) ) { v_f = v_i; usefloat = 1; i --; continue; } v_i = (v_i * 10) + digv; } } if (neg_n) { if (usefloat) v_f = - v_f; else v_i = - v_i; } if (usefloat) { vt = AT_FLOAT; } else if ((v_i < 0) || (v_i > 1)) { vt = AT_INT; } else { vt = AT_BOOL; } } else { int e; int digv; v_f = 0; for (i=0;i DBL_MAX/10) { exec_err(line,len,t0,t1-t0,"EXECUTE: FLOATING MANTISSA OVERFLOW"); } v_f = (v_f * 10) + digv; } e = 0; for (i=0;i= 0) e -= digits_n - dot; if (neg_n) v_f = - v_f; v_f *= pow(10,e); vt = AT_FLOAT; } if (! val) { vs = 0; val = new_array_l(vt,1,8); } else { val = promote_array(val,vt); } if (vs >= val->dims[0]) { val = grow_vector(val,vs+8); } switch (val->type) { case AT_FLOAT: val->d.f[vs++] = (vt != AT_FLOAT) ? v_i : v_f; break; case AT_INT: val->d.i[vs++] = v_i; break; case AT_BOOL: if (v_i) bitvec_set(val->d.b,vs); else bitvec_clr(val->d.b,vs); vs ++; break; default: abort(); break; } moreval = TT_NUM; break; case TT_STRING: exec_err(line,len,t0,t1-t0,"EXECUTE: STRINGS NOT IMPLEMENTED"); break; case TT_END: break; } } err_throw = save_throw; if (rhs && (!lastop || ec_equal_single(lastop,CH_ASSIGN))) return(rhs); if (rhs) array_drop(rhs); return(0); } static void syscommand(ECHAR *body, int len) { exec_err(body,len,0,1,"EXECUTE: SYSTEM COMMANDS NOT IMPLEMENTED"); } static void dump_tokenization(const ECHAR *text, const unsigned char *tok, int len) { int i; ec_print(text,len); putchar('\n'); for (i=0;i> 1) { case TT_NULL: putchar(CH_JOT); break; case TT_IDENT: putchar(CH_LETTER_I); break; case TT_CHAR: putchar(CH_LETTER_C); break; case TT_NUM: putchar(CH_LETTER_N); break; case TT_STRING: putchar(CH_LETTER_S); break; default: putchar(0x51); break; } if (tok[i] & 1) { putchar(0x08); putchar(CH_UNDER); } } putchar('\n'); } static unsigned char num_map(char c) { switch (c) { case '-': return(CH_NEGNUM); break; case '.': return(CH_DOT); break; case 'e': return(CH_LETTER_E); break; case '0': return(CH_DIGIT_0); break; case '1': return(CH_DIGIT_1); break; case '2': return(CH_DIGIT_2); break; case '3': return(CH_DIGIT_3); break; case '4': return(CH_DIGIT_4); break; case '5': return(CH_DIGIT_5); break; case '6': return(CH_DIGIT_6); break; case '7': return(CH_DIGIT_7); break; case '8': return(CH_DIGIT_8); break; case '9': return(CH_DIGIT_9); break; default: abort(); break; } } static void print_num_map(const char *s, int n) { int i; for (i=0;i 2.3e45. if ((s[i] == '+') && (i > 0) && (s[i-1] == 'e')) continue; putchar(num_map(s[i])); } } static int print_recursive(void (*printone)(const void *, int), const void *d, int x, const int *dims, int dx) { int i; int n; int adv; int a; int j; if (dx < 0) { (*printone)(d,x); return(1); } adv = 0; n = dims[dx]; for (i=0;i0;j--) putchar('\n'); } else { (*printone)(0,0); } } a = print_recursive(printone,d,x,dims,dx-1); adv += a; x += a; } return(adv); } static void print_value_bool(const void *d, int x) { if (! d) { putchar(CH_SPACE); return; } putchar(bitvec_isset(d,x)?CH_DIGIT_1:CH_DIGIT_0); } static void print_value_int(const void *d, int x) { char sv[64]; int l; if (! d) { putchar(CH_SPACE); return; } l = snprintf(&sv[0],sizeof(sv),"%lld",(LLI)((const APLINT *)d)[x]); print_num_map(&sv[0],l); } static void print_value_float(const void *d, int x) { char sv[64]; int l; if (! d) { putchar(CH_SPACE); return; } l = snprintf(&sv[0],sizeof(sv),"%g",(double)((const APLFLOAT *)d)[x]); print_num_map(&sv[0],l); } static void print_value_char(const void *d, int x) { if (! d) return; ec_print(((const ECHAR *)d)+x,1); } static void print_value(ARRAY *v) { if (v->els < 1) return; switch (v->type) { case AT_BOOL: print_recursive(&print_value_bool,v->d.b,0,v->dims,v->rank-1); break; case AT_INT: print_recursive(&print_value_int,v->d.i,0,v->dims,v->rank-1); break; case AT_FLOAT: print_recursive(&print_value_float,v->d.f,0,v->dims,v->rank-1); break; case AT_CHAR: print_recursive(&print_value_char,v->d.c,0,v->dims,v->rank-1); break; default: abort(); break; } putchar('\n'); } static void execute_line(ECHAR *line, int len) { __label__ errto; unsigned char *tok; int tflip; unsigned int *indir; int i; void throw(void) { goto errto; } tok = 0; err_throw = &throw; if ((len > 0) && ec_equal_single(line,CH_RPAREN)) { syscommand(line,len); err_throw = 0; return; } tok = malloc(len); indir = malloc(len*sizeof(*indir)); tflip = 0; i = 0; while (i < len) { do <"token"> { if ( ec_equal_single(line+i,CH_NEGNUM) || ec_map_single(line+i,&digits_map[0]) || ( ec_equal_single(line+i,CH_DOT) && (i+1 < len) && ec_map_single(line+i+1,&digits_map[0]) ) ) { int ndig; int dot; int inexp; int neg; int negexp; int expdig; int j; j = i; if (ec_equal_single(line+i,CH_NEGNUM)) { neg = 1; j ++; } else { neg = 0; } ndig = 0; dot = -1; inexp = 0; while (1) { if (j >= len) break; if (ec_equal_single(line+j,CH_NEGNUM)) { if (inexp ? (negexp || (expdig > 0)) : (neg || ndig || (dot >= 0))) exec_err(line,len,j,1,"EXECUTE: INVALID NEGATION"); if (inexp) negexp = 1; else neg = 1; } else if (ec_equal_single(line+j,CH_DOT)) { if ((dot >= 0) || inexp) break; dot = ndig; } else if (ec_equal_single(line+j,CH_LETTER_E)) { if (inexp) break; inexp = 1; negexp = 0; expdig = 0; } else if (ec_map_single(line+j,&digits_map[0])) { if (inexp) { expdig ++; } else { ndig ++; } } else { break; } j ++; } if ((ndig < 1) || (inexp && (expdig < 1))) exec_err(line,len,i,j-i,"EXECUTE: INVALID NUMBER"); memset(tok+i,(TT_NUM*2)+tflip,j-i); i = j; break <"token">; } if ( ec_equal_single(line+i,CH_DELTA) || ec_map_single(line+i,&letters_map[0]) || ec_equal_double(line+i,CH_DELTA,CH_UNDER) || ec_map_double(line+i,CH_UNDER,&letters_map[0]) ) { int j; j = i + 1; while ( (j < len) && ( ec_equal_single(line+j,CH_DELTA) || ec_map_single(line+j,&letters_digits_map[0]) || ec_equal_double(line+j,CH_DELTA,CH_UNDER) || ec_map_double(line+j,CH_UNDER,&letters_map[0]) ) ) j ++; memset(tok+i,(TT_IDENT*2)+tflip,j-i); i = j; break <"token">; } else if (ec_equal_single(line+i,CH_QUOTE)) { int j; j = i + 1; while (1) { if (j >= len) exec_err(line,len,i,1,"EXECUTE: UNCLOSED '"); if (ec_equal_single(line+j,CH_QUOTE)) { if ((j+1 < len) && ec_equal_single(line+j+1,CH_QUOTE)) { j += 2; } else { break; } } j ++; } j ++; memset(tok+i,(TT_STRING*2)+tflip,j-i); i = j; break <"token">; } else if (ec_equal_single(line+i,CH_SPACE)) { tok[i++] = (TT_NULL * 2) + tflip; break <"token">; } else { tok[i++] = (TT_CHAR*2) + tflip; break <"token">; } } while (0); tflip = ! tflip; } dump_tokenization(line,tok,len); print_value(execute_tokenized(line,tok,len)); exec_err(0,0,0,0,"DONE"); errto:; free(tok); free(indir); err_throw = 0; } static void il_finish_line(void) { il_end_next(); if (il.l > 0) execute_line(il.eb,il.l); 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= 256)) abort(); c = bitmap_ivec[c]; if (c == 0xff) abort(); bitvec_set(map,c); } va_end(ap); } static void or_charmap(unsigned char *dst, const unsigned char *src1, const unsigned char *src2) { int i; for (i=11-1;i>=0;i--) dst[i] = src1[i] | src2[i]; } static void setup_data(void) { int i; // See the comment on bitmap_ivec. :- memset(&bitmap_ivec[0],0xff,256); for (i=88-1;i>=0;i--) bitmap_ivec[bitmap_vec[i]] = i; // Now that bitmap_ivec is set up, set up the maps. setup_charmap(&digits_map[0], CH_DIGIT_0,CH_DIGIT_1,CH_DIGIT_2,CH_DIGIT_3,CH_DIGIT_4, CH_DIGIT_5,CH_DIGIT_6,CH_DIGIT_7,CH_DIGIT_8,CH_DIGIT_9,0); setup_charmap(&letters_map[0], CH_LETTER_A,CH_LETTER_B,CH_LETTER_C,CH_LETTER_D,CH_LETTER_E, CH_LETTER_F,CH_LETTER_G,CH_LETTER_H,CH_LETTER_I,CH_LETTER_J, CH_LETTER_K,CH_LETTER_L,CH_LETTER_M,CH_LETTER_N,CH_LETTER_O, CH_LETTER_P,CH_LETTER_Q,CH_LETTER_R,CH_LETTER_S,CH_LETTER_T, CH_LETTER_U,CH_LETTER_V,CH_LETTER_W,CH_LETTER_X,CH_LETTER_Y, CH_LETTER_Z,CH_DELTA,0); or_charmap(&letters_digits_map[0],&letters_map[0],&digits_map[0]); } int main(void); int main(void) { printf("\r\n"); setup_data(); il_init(); il_set_prefix(c_to_ec_tmp(" ")); while (1) { il_update(); il_input(); } return(0); }