// IMP Runtime Environment // Copyright NB Information Limited 2002 #include #include extern void _impmain(); extern void exit(int code); void _impdummy(); void _impsignal(int extra, int sub, int event) { int firstcperm, lastcperm; int *mybp; int ret, panic; if ((event != 0) || (sub != 0)) // Don't report a normal %stop { // For the main ones we generate, try to be helpful... if (event == 6) { if (sub == 1) fprintf(stderr, "Capacity exceeded\n"); else if (sub == 2) fprintf(stderr, "Array bound fault - Index = %d\n", extra); else if (sub == 3) fprintf(stderr, "No switch label - Index = %d\n", extra); else fprintf(stderr, "Out of range fault - Sub-class = %d, Value = %d\n", sub, extra); } else if (event == 5) { if (sub == 1) fprintf(stderr, "Illegal FOR loop\n"); else if (sub == 2) fprintf(stderr, "Illegal exponent - Exponent = %d\n", extra); else if (sub == 3) fprintf(stderr, "Array inside-out\n"); else fprintf(stderr, "Invalid argument - Sub-class = %d, Value = %d\n", sub, extra); } else fprintf(stderr, "Signal %d, %d, %d called.\n", event, sub, extra); // Now we try to backtrack the stack. The C stack frame is different // to the IMP stack frame, plus we don't want to include PERMs in the // traceback, so we find the limits of this PERM file... firstcperm = (int)(&_impsignal); lastcperm = (int)(&_impdummy); // try to find our own base pointer... __asm mov mybp,bp ret = mybp[1]; // so this is where we were called from // get out of the perms first while ((ret >= firstcperm) && (ret <= lastcperm)) { mybp = (int *)(mybp[0]); // previous stack frame ret = mybp[1]; } // Now ret is a code address in the IMP program. We trace // back the stack until we find outselves back in the PERMS // which must be the initial entry point, _impgo panic = 0; while ((ret < firstcperm) || (ret > lastcperm)) { fprintf(stderr, "Called from 0x%04x\n", ret); mybp = (int *)(mybp[0]); // previous stack frame ret = mybp[2]; if (++panic > 20) { fprintf(stderr, "Possible stack error?\n"); break; } } } exit(1); } void _impstop() { exit(1); } // Array Reference routine. Indices are pushed left to right // so we get them right to left. The last thing pushed (our // first parameter) is a pointer to the Dope Vector. // Dope vectors are :DIM:LB1:UB1:LB2:UB2:etc:LBn:UBn:ObjectSize: // Although we show two indexes, the caller actually pushes // however many they like on the stack. For the first 2 we can // access them directly - after that we need to fiddle with // addresses. // The result is the offset that needs to be added to the // notional A(0,0,0) address to get the variable int _imparef(int *dvp, int i1, int i2) { int dim; int row; int lb, ub; int *indexp, *boundptr; int count, result; dim = *dvp; if (dim == 1) // simple 1-D array { if ((i1 < dvp[1])||(i1 > dvp[2])) _impsignal(i1, 2, 6); return (i1 * dvp[3]); } if (dim == 2) // simple 2-D array { if ((i2 < dvp[1])||(i2 > dvp[2])) _impsignal(i2, 2, 6); if ((i1 < dvp[3])||(i1 > dvp[4])) _impsignal(i1, 2, 6); row = (dvp[2] - dvp[1]) + 1; // number of cells in a row return ((i2 + (i1 * row)) * dvp[5]); } // For 3 dimensions or more, we do this the hard way... indexp = &i1; // point to the rightmost index boundptr = &dvp[(dim * 2) - 1]; // lower bound of rightmost bound pair result = 0; // result so far for (count=0; count < dim; count++) { lb = boundptr[0]; // pick up the bounds ub = boundptr[1]; if ((*indexp < lb)||(*indexp > ub)) _impsignal(*indexp, 2, 6); row = ub + 1 - lb; result = (result * row) + *indexp++; // accumulate this index boundptr -= 2; // step to the next left pair } return result * (*boundptr); } // Given a dope vector calculate the offset (in bytes) of the // highest element, and also the offset from A(0,0) of // the first element - the size of the store to allocate is // therefore the difference. We return the two 16 bit answers // as a 32 bit result => "high" answer is in DX, "low" answer // is in AX. Thus DX contains the top, AX the A(0) offset unsigned long _impadef(int *dvp) { int dim, row, ub, lb, base; unsigned long limit; dim = dvp[0]; // We do special case code for 1 and 2 D arrays // for performance reasons if (dim == 1) { lb = dvp[1]; ub = dvp[2]; if (ub < lb) _impsignal(0, 3, 5); limit = (ub + 1) * dvp[3]; base = lb * dvp[3]; return (limit << 16) | base; } if (dim == 2) { lb = dvp[1]; ub = dvp[2]; if (ub < lb) _impsignal(0, 3, 5); row = ub + 1 - lb; // Number of objects in a row base = lb; // initial offset lb = dvp[3]; ub = dvp[4]; if (ub < lb) _impsignal(0, 3, 5); base += lb * row * dvp[5]; limit = (((ub + 1) * row) + 1) * dvp[5]; // Top of the array return (limit << 16) | base; } fprintf(stderr, "Array Def > 2D (not yet supported)\n"); exit(1); return 0; } // returns x ^ y int _impiexp(int x, int y) { int value; if (y < 0) _impsignal(y, 2, 5); value = 1; while(y > 0) { value = value * x; y = y - 1; } return value; } // Returns floating point x ^ p double _impfexp(double x, int p) { double r; if (p == 0) return 1.0; if (x == 0.0) return 0.0; if (p < 0) { x = 1.0/x; p = -p; } r = 1.0; for(;;) { if (p & 1) r = r * x; p = p >> 1; if (p == 0) return r; x = x * x; } } void _impstrcat(int length, unsigned char *src, unsigned char *dst) { int old, count; old = *dst; // pick up existing length count = *src++; // fetch the source length and skip over it if ((count + old) > length) { fprintf(stderr, "String append overflow\n"); _impsignal(0, 1, 6); } *dst = (unsigned char)(count + old); // set the new length dst = dst + old + 1; // point at the data area while (count--) *dst++ = *src++; } void _impstrjcat(int length, unsigned char *src, unsigned char *dst) { int old, count; old = *dst; count = *src++; // fetch the length and skip over it if ((count + old) > length) count = length - old; *dst = (unsigned char)(count + old); dst = dst + old + 1; // point at the data area while (count--) *dst++ = *src++; } void _impstrcpy(int length, unsigned char *src, unsigned char *dst) { int count; count = *src++; // pick up the count and advance to the chars if (count > length) // check the length { fprintf(stderr, "String copy overflow\n"); _impsignal(0, 1, 6); } // count is now the correct number of characters. We first // copy across the length... *dst++ = (unsigned char)count; while (count--) *dst++ = *src++; } void _impstrjam(int length, unsigned char *src, unsigned char *dst) { int count; count = *src++; // pick up the count and advance to the chars if (count > length) // force the length to fit count = length; // count is now the correct number of characters. We first // copy across the length... *dst++ = (unsigned char)count; while (count--) *dst++ = *src++; } // strcmp returns a number comparable to the state of the // strings (-1 = less than, 0 = equal, 1 = more than) int _impstrcmp(unsigned char *l, unsigned char *r) { int lcount, rcount; lcount = *l++; // pick up the count and advance to the chars rcount = *r++; while ((lcount > 0) && (rcount > 0)) { if (*l > *r) goto left; if (*r > *l) goto right; l++; r++; lcount--; rcount--; } // here we ran out of characters on one or both sides if (lcount > 0) goto left; if (rcount > 0) goto right; // here, the strings are identical return 0; left: return 1; right: return -1; } // IMP resolution - S->A.(B).C; returns 1 for success, 0 for failure int _impstrres(unsigned char *s,unsigned char *a,unsigned char *b,unsigned char *c) { int slen, blen, index, count; unsigned char *source, *pattern; // successively try to fit B into S slen = *s++; // pick up respective lengths blen = *b++; if (blen > slen) return 0; // can't possibly work if (c == 0) // answer must be anchored to the right S->A.(B) index = slen - blen; else index = 0; while (blen + index <= slen) { source = s + index; pattern = b; count = 0; while (count < blen) { if (*source++ != *pattern++) break; count += 1; } if (count == blen) // a match was found, at offset INDEX { // copy the results if (a != 0) { *a++ = index; count = 0; while (count < index) { *a++ = *s++; count += 1; } } s += blen; // skip the matched part if (c != 0) { count = index + blen; *c++ = slen - count; while (count < slen) { *c++ = *s++; count += 1; } } return 1; } // here = no match if (a == 0) // pattern was anchored on the left return 0; // so we can't advance to try again index += 1; } // ran out of space, so it must have failed return 0; } #define MAXSTREAM 4 static FILE *instream[MAXSTREAM]; static FILE *outstream[MAXSTREAM]; static int curinput = 0; static int curoutput = 0; static int upthespout[MAXSTREAM] = {-1, -1, -1, -1}; // used to do NEXTSYMBOL void SELECTINPUT(unsigned int io) { if (io < MAXSTREAM) curinput = io; } void SELECTOUTPUT(unsigned int io) { if (io < MAXSTREAM) curoutput = io; } void CLOSEINPUT() { if (curinput != 0) // can't close terminal input { if (instream[curinput] != NULL) // can't close an already closed file { fclose(instream[curinput]); instream[curinput] = NULL; } } } void CLOSEOUTPUT() { if (curoutput != 0) // can't close terminal input { if (outstream[curoutput] != NULL) // can't close an already closed file { fclose(outstream[curoutput]); outstream[curoutput] = NULL; } } } static char filename[256]; //void OPENINPUT(unsigned int io, int dummy) void OPENINPUT(int dummy) { unsigned char *s; char *p; int len, io; int *index; s = (unsigned char *)(&dummy); // the impstring is actualy at this address :-) index = &dummy; // the index is 256 bytes further up the stack index += 128; // 'cos strings are bytes, and this is a word io = *index; len = *s++; p = filename; while (len > 0) { *p++ = *s++; len -= 1; } *p = 0; instream[io] = fopen(filename, "r"); if (instream[io] == NULL) { perror(filename); exit(1); } } //void OPENOUTPUT(unsigned int io, int dummy) void OPENOUTPUT(int dummy) { unsigned char *s; char *p; int len, io; int *index; s = (unsigned char *)(&dummy); // the impstring is actualy at this address :-) index = &dummy; // the index is 256 bytes further up the stack index += 128; // 'cos strings are bytes, and this is a word io = *index; len = *s++; p = filename; while (len > 0) { *p++ = *s++; len -= 1; } *p = 0; outstream[io] = fopen(filename, "w"); if (outstream[io] == NULL) { perror(filename); exit(1); } } static char prompt[32] = {'-', '>', ' ', 0,}; int ttyneedsaprompt = 1; static void doprompt() { if (curinput == 0) { if (ttyneedsaprompt) { ttyneedsaprompt = 0; fprintf(stderr, prompt); } } } void PROMPT(int dummy) { unsigned char *s; char *p; int len; s = (unsigned char *)(&dummy); // the impstring is actualy at this address :-) len = *s++; if (len > 31) len = 31; p = prompt; while (len > 0) { *p++ = *s++; len -= 1; } *p = 0; } int NEXTSYMBOL() { int ch; if (instream[curinput] == NULL) // file not open return -1; if (upthespout[curinput] < 0) // don't already have one? { doprompt(); ch = getc(instream[curinput]); upthespout[curinput] = ch; if ((curinput == 0) && (ch == '\n')) ttyneedsaprompt = 1; } return upthespout[curinput]; } void READSYMBOL(int *s) { *s = NEXTSYMBOL(); upthespout[curinput] = -1; } void SKIPSYMBOL() { int trash; READSYMBOL(&trash); } void PRINTSYMBOL(int c) { putc(c, outstream[curoutput]); } void READ(int *n) { // ABD Not Implemented! } void usage() { fprintf(stderr, "Usage: [in1[,in2[,in3]]][/][out1[,out2[,out3]]] (no spaces)\n"); exit(1); } void main(int argc, char **argv) { int filecount, i, p; int terminator; char * files[6]; char * remainder; char * filep; int binary[6]; // set up the input and output streams if (argc > 2) usage(); if (argc < 2) // null arguments remainder = ""; else remainder = argv[1]; filecount = 0; while(*remainder) { filep = remainder; while ((*remainder) && (*remainder != ',') && (*remainder != '/')) remainder++; terminator = *remainder; if (terminator != 0) { *remainder = 0; // make it so remainder++; // and point to the rest of the argument } files[filecount] = filep; filecount = filecount + 1; if (terminator == '/') { while (filecount < 3) { files[filecount] = ""; // null filenames for missing args filecount += 1; } } } while (filecount < 6) { files[filecount] = ""; // null filenames for missing args filecount += 1; } // now go through our files looking for trailing :B characters // which we use to indicate that the file is binary for (i=0; i < 6; i++) { binary[i] = 0; // default starting position filep = files[i]; p = strlen(filep); if (p > 2) { if ((filep[p-2] == ':') && ((filep[p-1] == 'b') || (filep[p-1] =='B'))) { binary[i] = 1; // mark this as binary filep[p-2] = 0; // chop off the :b part } } } // now make sure we are not overwriting an input for(filecount = 3; filecount < 6; filecount++) { if (*files[filecount] != 0) // a file name { for(i=0; i < 3; i++) { if (strcmp(files[i], files[filecount]) == 0) // { fprintf(stderr, "Output file %s would overwrite input\n", files[i]); exit(1); } } } } // now convert null filenames to the NUL file for(filecount = 0; filecount < 6; filecount++) { if (*files[filecount] == 0) files[filecount] = "NUL"; } instream[0] = stdin; outstream[0] = stdout; for (i = 1; i < 4; i++) { if (binary[i-1]) instream[i] = fopen(files[i-1], "rb"); else instream[i] = fopen(files[i-1], "r"); if (instream[i] == NULL) { perror(files[i-1]); exit(1); } if (binary[i+2]) outstream[i] = fopen(files[i+2], "wb"); else outstream[i] = fopen(files[i+2], "w"); if (outstream[i] == NULL) { perror(files[i+2]); exit(1); } } _impmain(); exit(0); // If the IMP program exits through %endofprog then report success to the shell } // Never called, this routine marks the end of the C perms // for the benefit of the stack traceback void _impdummy() { }