/* anatest, main code and parser for ana */ #include #include #include #include #include /* LS's includes for termio mods to support history buffer doesn't work on all Unix's unfortunately */ #if NeXT #include #else #include //#include /* added termio and unistd to enable unbuffered */ #include /* input -> history buffer etc. LS 8may92 */ #endif /* for SGI only (?) */ #if __sgi #include #include #endif #include "ana_structures.h" #include "trans.h" #define MAXLINELENGTH 1024 #define SYM_FLAG 163 #define ANA_ZERO_SYM 4 #define scanc(sd,t,mask) \ while ( (sd.n > 0) && (( t[(int) *sd.p] & mask ) == 0)) \ { sd.p++; sd.n--; } #define spanc(sd,t,mask) \ while ( (sd.n > 0) && (( t[(int) *sd.p] & mask ) != 0)) \ { sd.p++; sd.n--; } #define scan_tok \ while ( (tok2.n > 0) && (( ptab[(int) *tok2.p] & 255 ) == 0)) \ { tok2.p++; tok2.n--; } extern struct sym_desc sym[]; extern byte *insert_sym_num(int i,byte *s); extern char *strsav(); extern char *strsavsd(); extern int num_ana_subr; extern int symbol_context; extern int xtloop_running, motif_flag, input_modal_flag; extern short *get_subr_desc(int narg, int body); extern short *user_subr_ptrs[], *user_func_ptrs[], *user_code_ptrs[]; extern size_t mstats(void); char stdin_buf[MAXLINELENGTH], filein_buf[MAXLINELENGTH], *lptr; //byte line[MAXLINELENGTH],line2[MAXLINELENGTH]; byte line2[MAXLINELENGTH]; /*line2 used for several purposes */ char prompt[32]; /* added by LS */ /* LS's history buffer, should upgrade to a double linked structure to save memory */ #define historysize 100 byte history[historysize][MAXLINELENGTH]; int lastline = 0; /* part of LS's code */ byte sq[256]; /*a temporary line buffer */ byte zline[1]={'\0'}; /* our own null line */ size_t memamount; struct sdesc cur_line,tok2,tok3,psym,psym1,psym2,token; /* some scratch storage */ int scrat[NSCRAT]; int *pscrat; /* a pointer to it */ /* global flags and items */ int nsym; /* nsym is the current symbol */ int necho,stopf,nest; /* note MXNEST defined in ana_structures.h */ int nprompt; /* flags */ int edb_context=0; int compile_in_progress = 0; /* used by subr and func to avoid nesting */ int batch_flag = 0, motif_input_flag = 0, compile_file_flag = 0; int motif_echo_flag = 0; /* some declarations */ int nextl(); int parser(); void ana_exit(); void printcs(); void ana_interrupt(), ana_bus_error(), ana_seg_error(), ana_fpe_error(); void ana_reset(); FILE *fopen(),*anain,*indirects[MXNEST]; jmp_buf sjbuf; int rupt_flag, argc_hack; /* LS's additions */ char getch(void); int histline(int, char *, byte *, int), move(int), nexttypedl(), putch(char); void printline( byte *); int single_string_parse_flag, single_string_parse_nest; byte *input_compile_string; /* used for compiling strings */ #if NeXT struct sgttyb new_params, old_params; #else struct termios new_params, old_params; #endif /* end of LS's additions */ char *p = stdin_buf, *ptr = stdin_buf; int size_of_prompt, nchar, nchar_tot, stdin_state; int historyptr, insertflag = -1; /*--------------------------------------------------------------------------*/ /* start main */ main (int argc, char *argv[]) { int i,n; byte *p; #include #include #include struct rlimit rlp; getrlimit(RLIMIT_NOFILE, &rlp); /* printf("original file number limits %d %d\n", rlp.rlim_cur, rlp.rlim_max); */ rlp.rlim_cur = (rlim_t) 256; setrlimit(RLIMIT_NOFILE, &rlp); getrlimit(RLIMIT_NOFILE, &rlp); /* printf("modified file number limits %d %d\n", rlp.rlim_cur, rlp.rlim_max); */ i = sysconf(_SC_OPEN_MAX); printf("OPEN_MAX = %d\n", i); getrlimit(RLIMIT_DATA, &rlp); printf("original data segment limits %d %d\n", rlp.rlim_cur, rlp.rlim_max); rlp.rlim_cur = rlp.rlim_max; setrlimit(RLIMIT_DATA, &rlp); getrlimit(RLIMIT_DATA, &rlp); printf("revised data segment limits %d %d\n", rlp.rlim_cur, rlp.rlim_max); getrlimit(RLIMIT_MEMLOCK, &rlp); printf("original memlock limits %d %d\n", rlp.rlim_cur, rlp.rlim_max); rlp.rlim_cur = rlp.rlim_max; setrlimit(RLIMIT_MEMLOCK, &rlp); getrlimit(RLIMIT_MEMLOCK, &rlp); printf("revised memlock limits %d %d\n", rlp.rlim_cur, rlp.rlim_max); #if NeXT if (ioctl(1, TIOCGETP, &old_params) < 0) {printf("IOCTL get failed, assuming batch mode\n"); batch_flag=1; } else { new_params = old_params; new_params.sg_flags = CBREAK | ANYP | CRMOD; } #else //if (ioctl(1, TCGETA, &old_params) < 0) if (tcgetattr(1, &old_params) < 0) {perror("IOCTL get failed, assuming batch mode"); batch_flag=1; } else { new_params = old_params; new_params.c_cc[VMIN] = 1; new_params.c_cc[VTIME] = 0; new_params.c_lflag &= ~ICANON; /* direct read -> no wait for NL */ new_params.c_lflag &= ~ECHO; /* no direct echo of input */ } /* set the new parameters once, disable the toggling we used to do */ if (tcsetattr(1, TCSAFLUSH, &new_params) < 0) perror("tcsetattr set failed"); #endif /* set up the pointers for stdin */ /*some initializations */ symbol_init(); /*sets up parts of symbol tables */ /* activate for malloc debugging */ #if NeXT i = malloc_debug(16); #endif #if __sgi mallopt( M_DEBUG, 0); /* use 1 for debug mode */ mallopt( M_MXCHK, 100); /* try more searches to avoid excessive memory use */ #endif if (signal(SIGINT, SIG_IGN) != SIG_IGN) signal(SIGINT,ana_interrupt); if (signal(SIGBUS, SIG_IGN) != SIG_IGN) signal(SIGBUS,ana_bus_error); if (signal(SIGSEGV, SIG_IGN) != SIG_IGN) signal(SIGSEGV,ana_seg_error); //#if defined(__alpha) | defined(NeXT) if (signal(SIGFPE, SIG_IGN) != SIG_IGN) signal(SIGFPE,ana_fpe_error); else printf("FPE signal already taken\n"); //#endif setjmp(sjbuf); /*come back here for most errors */ /* put most of the resets in a separate function which can be called during some error recoveries, errors that come back up through execute do not do a longjmp anymore but just call reset and continue */ ana_reset(); printf("ANA startup, version 0.07, 5/9/98\n"); /* command line argument, treat as an indirect (~ L.S.) */ /* printf("argc = %d\n", argc); */ if (--argc >= 1) { /* extra command line arguments */ /* only initialization file supported in this version */ /* since I do this so often, we are going to assume that a leading @ was a mistake and remove it, if a file really starts with @, you could still do @@ I suppose */ p = *++argv; if ( *p == '@') p++; strcpy(stdin_buf, p); /* initialization file */ n = strlen(stdin_buf); stdin_buf[n] = 0; p = stdin_buf + 1; while (*p) if (*p++ == '.') break; if (*p == 0) {strcpy(&stdin_buf[n],".ana"); stdin_buf[n+4]=0;} printf("Initialization file %s\n",stdin_buf); if ( (indirects[++nest-1] = fopen((char *) stdin_buf,"r")) == NULL ) { printf("\007*** can't find your initialization file: %s\n",stdin_buf); anain = stdin; } else anain = indirects[nest-1]; } else anain = stdin; /*set input to standard */ argc_hack = argc; /* to fool the optimizer, we may use argc after a long jump but optimizer thinks we don't use it again */ /* if we got here after an error induced long jump, we might have been in an xtloop, try to recover */ if (xtloop_running) { printf("trying to restart motif, motif_flag = %d\n", motif_flag); ana_xtloop(0); } while (1) MainAnaDoOne(); /* start main loop */ /* note that MainAnaDoOne returns on eof's (as at the end of indirects) but we want to then continue here, the only exits are from within the code, none from here */ } /* end of main */ /*--------------------------------------------------------------------------*/ void ana_reset() { int i; /* some of the following is for error recovery since we come here for a restart after most fatal errors */ if ( nest ) { printf("closing all indirects\n"); for (i=0; i < nest; i++ ) if ( indirects[i] != NULL) fclose( indirects[i]); nest = 0; } cur_line.n = nprompt = edb_context = symbol_context = 0; /* reset the recursive traps */ for (i=0;i"); size_of_prompt = strlen(prompt); ptr = stdin_buf; p = ptr; nchar = nchar_tot = stdin_state = 0; *ptr = '\0'; /* start new line */ return; } /*--------------------------------------------------------------------------*/ int MainAnaDoOne() /* this gets called by main and compile_file (so far) */ { /* parse and execute an ana command, exit possible from parser or execute */ //printf("MainAnaDoOne, clearing pscrat\n"); pscrat=scrat; /* reset scratch pointer for parser stack */ if (cur_line.n <= 0) clear_edb(); nsym=parser(); /* printf("nsym from parser = %d\n", nsym); */ if (nsym < 0) return nsym; if (nsym > 0) if (execute(nsym) <= 0) ana_reset(); return nsym; } /* end of MainAnaDoOne */ /*--------------------------------------------------------------------------*/ void ana_interrupt() /*interrupt service */ { signal(SIGINT,ana_interrupt); /* reset for next one */ if (rupt_flag) { printf("\n soft interrupt already flagged, do you want a hard interrupt?"); printf("\n [y/n] "); if ( tolower(getchar()) == 'y' ) { rupt_flag = 0; longjmp(sjbuf, 0); } } rupt_flag = 1; } /*--------------------------------------------------------------------------*/ void bad_news() { printf( "the current operation is doomed but a restart at top level may work,\n"); printf("want to try? [y/n]\n"); if ( tolower(getchar()) != 'n' ) longjmp(sjbuf, 0); else ana_exit(2); } /*--------------------------------------------------------------------------*/ void ana_bus_error() /*interrupt service for bus segment errors */ { signal(SIGBUS,ana_bus_error); /* reset for next one */ printf( "you have a bus error, most likely an out of range memory location,\n"); bad_news(); } /*--------------------------------------------------------------------------*/ void ana_seg_error() /*interrupt service for segment errors */ { signal(SIGSEGV,ana_seg_error); printf( "you have a segment error, most likely an out of range memory location,\n"); bad_news(); } /*--------------------------------------------------------------------------*/ void ana_fpe_error() /*interrupt service for fpe errors */ { signal(SIGFPE,ana_fpe_error); /* reset for next one */ printf( "you have a SIGFPE (floating point error) that the system wouldn't handle\n"); printf( "actually, an integer divide by 0 can cause this\n"); bad_news(); } /*------------------------------------------------------------------------*/ /* most of LS's code is here */ #define DONE 2 #define DEL_LN 21 /* delete line (ctrl-U) */ #define NEXTW 23 /* next word (ctrl-W) */ #define DELW 4 /* delete word (ctrl-D) */ #define DELEOL 11 /* delete to end of line (ctrl-K) */ #define CONTRL 27 /* control sequence indicator */ #define INSERT 1 /* insert/overwrite (ctrl-A) */ #define DELETE '\010' /* delete char (ctrl-H) */ #define LINEBEG 2 /* beginning of line (ctrl-B) */ #define LINEEND 5 /* end of line (ctrl-E) */ #define FWD 18 /* next char (ctrl-R) */ #define BKW 12 /* previous char (ctrl-L) */ #define PRV 16 /* previous line (ctrl-P) */ #define NXT 14 /* next line (ctrl-N) */ #define QUIT 24 /* quit (ctrl-X) */ #define FIND 6 /* find (ctrl-F) */ #define CSI "\033[" #define LTARROW 'D' #define RTARROW 'C' #define DNARROW 'B' #define UPARROW 'A' #define TOKEN (1+2) #define SEPARATOR (4+8+16+32+64+128) /*--------------------------------------------------------------------------*/ //int nexttypedl(char *prompt, byte *in_ptr, int maxlen) int nexttypedl() /* reads next typed line (of max. chars) into buffer . returns length of line. LS 11may92 */ /* 4/4/98 - intended only for stdin which may also be input from the Xt loop monitor. Therefore changed to have a buffer separate from the file input and checks state of buffer and resets on EOL. The continuation of lines is now done in ana_input_char for stdin. The setting of the prompt is assumed before call to nexttypedl. When this routine is called, we should normally block until the line is entered. The main exception would be a ^X which causes an immediate exit of the program. */ { int n = 0; insertflag = -1; /* can be -1 or 0 */ size_of_prompt = strlen(prompt); //ptr = stdin_buf; *ptr = '\0'; /* start new line */ //p = ptr; printline(ptr); nchar = nchar_tot = stdin_state = 0; /* note that line continuation is now done in ana_input_char which will change the prompt and the pointer as part of the process. When there are additional line(s), the character count for the first line(s) are in nchar_tot. Line continuation still blocks. The total number of characters in a line is still limited to maxlen. Line continuation for file input is supported elsewhere. */ for (;;) { if (ana_input_char(getch())) break; if ( (nchar_tot+nchar) >= MAXLINELENGTH) { printf("input buffer overflow, capacity = %d\n",MAXLINELENGTH); return 0; } } //printf("done, nchar = %d, strlen(ptr) = %d\n", nchar, strlen(ptr)); ptr = stdin_buf; p = ptr; nchar = nchar_tot = stdin_state = 0; return strlen(ptr); } /*------------------------------------------------------------------------- */ void ana_stdin_input() { /* for input while running motif via xtloop */ char c; int n, start_nest; struct sdesc save_cur_line; // just read one at a time and pass the character to ana_input_char if ( (n = read(1, &c, 1)) < 0) printf("EOF\n"); if (ana_input_char(c)) { /* a 1 (true) return means a completed line */ //printf("done, nchar = %d, strlen(ptr) = %d\n", nchar, strlen(ptr)); /* check if something in the parser buffer and save if so */ /* we'll put it back at the end */ if (save_cur_line.n=cur_line.n) save_cur_line.p=(byte *) strsavsd(&cur_line); cur_line.n = 0; input_compile_string = (byte *) stdin_buf; ptr = stdin_buf; p = ptr; nchar = nchar_tot = stdin_state = 0; //printf("stdin_buf = %s\n", stdin_buf); single_string_parse_flag = 1; single_string_parse_nest = nest; /* set to current nest level */ start_nest = nest; do { if (MainAnaDoOne() < 0) return; //printf("nest, start_nest, cur_line.n = %d %d %d\n", nest, start_nest, cur_line.n); } while (nest > start_nest || cur_line.n > 0); //printf("out of ana_stdin_input\n"); clear_edb(); single_string_parse_flag = 0; /* in case there was a partial line at the start, we copy the original line back into line2 (our preprocessed buffer) */ if (cur_line.n = save_cur_line.n) { strncpy((char *) line2, (char *) save_cur_line.p, save_cur_line.n); cur_line.p = line2; free(save_cur_line.p); } *ptr = '\0'; /* start new line */ strcpy(prompt,"ANA>"); size_of_prompt = strlen(prompt); printline(ptr); } else { /* just reading along, check length */ if ( (nchar_tot+nchar) >= MAXLINELENGTH) { printf("input buffer overflow, capacity = %d\n",MAXLINELENGTH); return; } } } /*-------------------------------------------------------------------------*/ void printline(byte *ptr) /* prints line after the prompt. LS 11may92 */ /* prints extra space + backspace for continuous cursor display on xwsh */ { int n = strlen(ptr); putch(13); putstr(prompt); if (n>0) putstr((char *)ptr); putstr(" " CSI "0K\010"); /* clear to end of line (7-bit) */ } /*--------------------------------------------------------------------------*/ char getch(void) /* reads and returns a char from standard input. returns EOF on failure. LS 11may92 */ { char c; if (read(1,&c,1) < 0) return EOF; return c; } /*--------------------------------------------------------------------------*/ int putch(char c) /* writes char to standard output. returns 1 if successful, 0 otherwise. LS 11may92 */ { return write(2,&c,1)?1:0; } /*--------------------------------------------------------------------------*/ int putstr(char *c) /* writes string *c to standard output. returns 1 if successful, 0 otherwise. LS 13may92 */ { return write(2,c,strlen(c))?1:0; } /*--------------------------------------------------------------------------*/ int move(int col) /* moves cursor to column +4 or 4, whichever is largest. LS 11may92 */ { int i=0; col = (col > 0) ? col : 0; putch(13); for (col+=4; col>0; col--) i += (putstr(CSI "C") >= 0 ? 1 : 0); return i; } /*--------------------------------------------------------------------------*/ int cadd(int *x, int delta) /* adds modulus historysize */ { *x += delta; if (*x < 0) *x += historysize; if (*x >= historysize) *x -= historysize; } /*--------------------------------------------------------------------------*/ void ana_history_recall(n) int n; { cadd(&historyptr, n); /* target history line */ strcpy(ptr,history[historyptr]); /* recall from buffer */ printline(ptr); nchar = strlen(ptr); p = ptr + nchar; /* position at end of line */ } /*--------------------------------------------------------------------------*/ int ana_input_char(c) char c; { /* got a character, based on what it is and our state, decide what to do */ /* return 1 when a line is complete, 0 otherwise */ /* we are using a line buffer with pointer ptr, count in nchar, the maximum length (size of buffer) in maxlen */ /* stdin_state is out state which is needed because we are not allowed to solicit input here. Hence multi-character control sequences need to set these state so that subsequent characters are interpreted properly. The starting state is 0. 1 is used when CONTRL is encountered and 2 after a CONTRL [ sequence. */ int iq, n; if (stdin_state == 0) { switch (c) { default: /* ordinary char */ if (insertflag && (p - ptr < nchar)) /* insert */ /* if the insertflag is set and we are not at the end of line, the char gets inserted in the input string on on the command line */ { strcpy(line2,p); strcpy(p+1,line2); /* in line */ /* 8/16/92 the insert command doesn't work on VT100 emulators, it is a VT200 command, so replaced by a more complicated action */ /* changing to insert mode doesn't work for all emulators either so have to do it the hard way */ *p++ = c; putch(c); nchar++; if ( *p != 0 ) { /* avoid work if at end */ putstr((char *) p); /* backspace the cursor using the nD command */ sprintf(sq, "\033[0K\033[%dD", nchar-(p-ptr) ); putstr(sq); } } else /* overwrite or end of line */ /* not all emulators support the switching from insert/overwrite and some seem always stuck in overwrite and others in insert this means that we have to erase to end of line for an overwrite and then write out what is supposed to be there */ { *p++ = c; putch(c); putstr("\033[0K"); /* erase rest of line */ if ( (p - ptr) > nchar) {nchar++; *p = '\0';} /* keep \0-terminated */ if ( *(p) != 0 ) { /* anything in rest of line ? */ /* if not, save some time */ putstr((char *) p); /* re-write last part */ /* backspace the cursor using the nD command */ iq = nchar - (p - ptr); if ( iq > 0 ) sprintf(sq, "\033[%dD", iq ); putstr(sq); } } break; case DELETE: case 127: /* note that there are 2 delete characters here */ if (p > ptr) { strcpy(line2,p); strcpy(p-1,line2); nchar--; p--; putstr("\033[1D\033[0K"); /* backspace, erase rest of line */ if ( *(p) != 0 ) { /* anything in rest of line ? */ /* if not, save some time */ putstr((char *) p); /* re-write last part */ /* backspace the cursor using the nD command */ iq = nchar - (p - ptr); if ( iq > 0 ) sprintf(sq, "\033[%dD", iq ); putstr(sq); } } break; case EOF: printf("EOF\n"); break; /* just in case */ case LINEBEG: p = ptr; move(0); break; case LINEEND: p = ptr + nchar; move(nchar); break; case NEXTW: /* find next word */ if (p - ptr >= nchar) break; /* at end of line */ if (ptab[*p] == 0) /* find next non-white */ for ( ; p - ptr < nchar && ptab[*p] == 0; p++); else if (ptab[*p] & TOKEN) /* ordinary chars */ { for ( ; ptab[*p] & TOKEN; p++) ; if (p - ptr < nchar && ptab[*p] == 0) for ( ; p - ptr < nchar && ptab[*p] == 0; p++); } else /* separator */ { for ( ; ptab[*p] & SEPARATOR; p++) ; if (p - ptr < nchar && ptab[*p] == 0) for ( ; p - ptr < nchar && ptab[*p] == 0; p++); } move(p - ptr); break; case DELW: if (ptab[*p] == 0) /* find end of prev word */ while (p > ptr && ptab[*p] == 0) p--; else for ( ; ptab[*p] & TOKEN; p++) ; p--; /* end of word */ n = p - ptr; while (p > ptr && ptab[*p] & TOKEN) p--; p++; /* beginning of word */ n = n - (p - ptr) + 1; /* #chars to delete */ strcpy(line2,p+n); strcpy(p,line2); nchar -= n; printline(ptr); move(p-ptr); break; #define FIRSTSEARCH 0 #define LEFTMARGIN 1 #define RIGHTMARGIN 2 #define DONESEARCH 4 /* the find facility needs more work before it can be included in the non- solicited scheme because it inputs a search pattern. This could be done via some sort of state change; i.e., when we enter find mode, we start putting the characters into the search string instead. Probably a project for Louis. In the meantime, this section is commented out. */ // case FIND: // n = 0; // if (findtype == FIRSTSEARCH) /* first search on this line */ // /* read the search string (NL-terminated) */ // { while (n != DONE) n = histline(n, "Fnd>", ptr, maxlen); // putstr(CSI "A"); /* cursor up one line -> hide Fnd> */ // cadd(&lastline,-1); // *history[lastline] = '\0'; /* remove search string from buffer */ // ptr[strlen(ptr)-1] = '\0'; /* replace NL with \0 */ // if (*ptr == '{') // { findtype |= LEFTMARGIN; strcpy(line2,ptr+1); // strcpy(ptr,line2); } /* line beginning */ // if (ptr[strlen(ptr)-1] == '}') // { // findtype |= RIGHTMARGIN; ptr[strlen(ptr)-1] = '\0'; /* line end */ // } // n = historyptr; // cadd(&n,-2); } // else // { strcpy(ptr,line2); /* saved from previous */ // n = historyptr; } // /* compare with history lines */ // while (1) // { while ((p = (byte *)strstr(history[n],ptr)) == NULL) // { cadd(&n,-1); // if (n == lastline) { findtype &= ~DONESEARCH; break; } // } // if (p) /* possible match */ // /* now check for special circumstances */ // { if (findtype == FIRSTSEARCH // || findtype == DONESEARCH // || (findtype & LEFTMARGIN && p == history[n]) // || (findtype & RIGHTMARGIN // && p - history[n] == strlen(history[n]) - strlen(ptr) ) ) // /* found a match */ // { strcpy(line2,ptr); /* save in case of more FINDs */ // strcpy(ptr,history[n]); /* recall line from history buffer */ // nchar = strlen(ptr); // printline(ptr); // p = ptr + nchar; // historyptr = n; // cadd(&historyptr,-1); // findtype |= DONESEARCH; // break; } // else /* next history line */ // { cadd(&n,-1); // if (n == lastline) break; } // } else break; /* compared all lines */ // } /* end of loop */ // if (findtype & DONESEARCH) break; /* found a match */ // else findtype = FIRSTSEARCH; /* next search */ /* NOTE: DEL_LN must follow FIND; default action when no match */ case DEL_LN: sprintf(sq, "\015\033[%dC\033[0K", size_of_prompt); putstr(sq); p = ptr; nchar = 0; *p = '\0'; break; case DELEOL: putstr("\033[0K"); *p = '\0'; nchar = p - ptr; break; case 10: case 13: /* end of line unless there is a continuation character */ ptr[nchar] = NULL; c = ptr[nchar-1]; switch (c) { case '-': /* maybe, have to check if this could be in a comment so check line for a ;. This isn't perfect. */ if (index(ptr,';') != 0) break; case '\\': /* an unconditional continuation, we just need to ignore the character */ /* it gets put in history as a distinct line */ if (*ptr != 0) /* only store non-empty lines*/ { strcpy(history[lastline],ptr); cadd(&lastline,1); } historyptr = lastline; strcpy(prompt, " ->"); nchar--; p--; printf("\n"); /* we want to indicate that this is a continuation line for the interactive mode, hence the clumsy stuff with nchar and nchar_tot */ nchar_tot += nchar; nchar = 0; *p = NULL; ptr = p; printline(ptr); return 0; } printf("\n"); if (*ptr != 0) /* only store non-empty lines*/ { strcpy(history[lastline],ptr); cadd(&lastline,1); } ptr[nchar++] = 10; ptr[nchar] = 0; historyptr = lastline; //findtype = FIRSTSEARCH; return DONE; /* done */ case INSERT: insertflag = ~insertflag; if (insertflag) putstr(CSI "4h"); else putstr(CSI "4l"); break; case QUIT: ana_exit(0); case CONTRL: /* escape char; control sequence? */ stdin_state = 1; break; /* note that the up/down arrows now do the history retrieval immediately rather than returning a status as before */ /* the control character support is here and the escape sequence support is below in the state 2 section */ case PRV: ana_history_recall(-1); return 0; case NXT: ana_history_recall(1); return 0; /* the more mundane sideways motions */ case FWD: if (p - ptr < nchar) { p++; putstr(CSI "C"); } /* advance cursor */ break; case BKW: if (p > ptr) { p--; putch(DELETE); } /* backspace */ break; } } else { if (stdin_state == 1) { if (c == '[') stdin_state = 2; else stdin_state = 0; } else if (stdin_state == 2) { stdin_state = 0; switch (c) { case UPARROW: /* request previous line */ ana_history_recall(-1); return 0; case DNARROW: /* request next line */ ana_history_recall(1); return 0; /* the more mundane sideways motions */ case RTARROW: if (p - ptr < nchar) { p++; putstr(CSI "C"); } /* advance cursor */ break; case LTARROW: if (p > ptr) { p--; putch(DELETE); } /* backspace */ break; default: break; /* ignore */ } } } return 0; } /*------------------------------------------------------------------------*/ int nextl() /* reads the next line from file anain, returns line count */ { /*input line read into line[] and then a preprocess pass converts and copies it into line2[] */ /* 2/18/95, modified to also process strings already in memory, uses a pointer lptr locally which is set to a global input_compile_string for this case, for normal input lptr = line */ char *p, *pq, *name; int n,neof,c,noff; extern byte *continue_motif_command(); /* printf("starting nextl, flag, nest = %d %d\n", single_string_parse_flag, single_string_parse_nest); printf("current nest = %d\n", nest); */ //printf("nextl, motif_input_flag = %d\n", motif_input_flag); if (single_string_parse_flag && single_string_parse_nest >= nest) { /* this mode is used for parsing strings for callbacks via ana_execute_symbol and for motif command entries if the string is NULL, we return with a -1 */ /* the single_string_parse_flag is zeroed now unless this is a motif command window */ if (!motif_input_flag) single_string_parse_flag = 0; if ((lptr = input_compile_string) == NULL) { if (motif_input_flag == 0) { printf("parser error: incomplete ANA statement\n"); return -1; } else { lptr = continue_motif_command(); } } input_compile_string = NULL; /* since we will now use it up */ } else { //lptr = line; /* pre-read chores vary depending on terminal or file input */ if ( anain == stdin ) { /* terminal input */ stopf = 0; /* reset stop flag */ lptr = stdin_buf; /* LS copies prompt into prompt array */ if (nprompt == 0) { strcpy(prompt,"ANA>"); } else { strcpy(prompt,"mor>"); } } else { /* file input */ lptr = filein_buf; if ( stopf == 1 ) parser_error(8); /* if (nprompt == 0) clear_all(); */ } /* read the line */ if ( anain == stdin && batch_flag == 0) /* LS */ nexttypedl(); else if ( fgets((char *) lptr, MAXLINELENGTH, anain) == NULL) { /* printf("eof (?) in nextl\n"); */ /* an EOF or some awful error, usually an EOF for an indirect */ /* could be an eof on a batch job, if so, wrap up */ if (batch_flag && (nest <= 0) ) { /* if eof, normal exit, otherwise an error message */ if ( feof(anain) ) ana_exit(0); } /* the following catches both batch and interactive errors in stdin */ if ( anain == stdin ) { printf("fatal error in fgets reading anain\n"); perror("ana"); ana_exit(-1); } /* otherwise we assume it was an indirect that hit the end */ /* printf("nextl about to close assumed indirect, nest = %d\n", nest); */ if (nest <= 0) { printf("no indirect to close? anain was %d\n", anain); anain = stdin; return -101; } fclose( indirects[nest-1] ); nest -= 1; /*printf("new nest level = %d\n", nest);*/ if ( nest ) anain = indirects[nest-1]; else anain = stdin; /* check if this was a compile_file, if so, we want main to return so pass a -102 since a -101 gets converted to 0 in parser */ if (compile_file_flag) return -102; return -101; /* note -101 return here */ } else { /* for the file (or batch using stdin) also check for continuation, this is done in nexttypedl for the interactive input */ /* if (lptr[0] == 4) { printf("control D\n"); ana_exit(0); } */ /* check last character, if a "-" then append next line */ /* unless a ";" preceeds the "-", i.e., a ";" anywhere in line which won't work if there is a ";" in a string however */ n=strlen(lptr); /* printf("strlen in nextl = %d\n", n);*/ if (n > 1) { if (lptr[n-2] == '-') { if (index(lptr,';') == 0) { fgets( (char *) &lptr[n-2],MAXLINELENGTH-n+1,anain); n=strlen(lptr);} } } } } /* end of single_string_parse_flag conditional */ /* note that the line continuation and ^D exit not supported for string input*/ /* now have the line; if a file we may have to echo it */ if ( anain != stdin && necho == 1 ) printf("%s", lptr); /*note - no newline needed above since line has one from fgets */ /* for motif entry, may also want to echo with prompt */ if (motif_input_flag && motif_echo_flag) { if (nprompt == 0) { strcpy(prompt,"ANA>"); } else { strcpy(prompt,"mor>"); } printf("%s %s\n", prompt, lptr); } /* 10/19/95 - strip off leading blanks here, otherwise we have problems later on */ while ( *lptr == ' ' || *lptr == '\t' ) lptr++; /* check the first character for a @ */ if ( lptr[0] == '@' ) { /* an indirect */ /* the rest of the line must be the file name string, kind of fussy */ /* before we try to open the file, check our file count */ if ( ++nest > MXNEST ) parser_error(9); n=strlen(lptr); if ( lptr[n-1] == '\n' ) lptr[n-1] = 0; /* probably need to add a ".ana" to name */ name = (byte *) malloc( strlen(lptr) + 4); strcpy(name, &lptr[1]); /* if no "." in file, then append ".ana" */ p = name; while (*p) if (*p++ == '.') break; if (*p == 0) strcat(name, ".ana"); indirects[nest-1] = fopen(name,"r"); free(name); if ( indirects[nest-1] != NULL) { anain = indirects[nest-1]; return 0; } /*a problem ? */ printf("A problem with your indirect file: %s\n", &lptr[1]); perror("error"); if (single_string_parse_flag) { single_string_parse_flag= 0; return 0; } parser_error(10); return 0; /* note return 0 here */ } /* pass through a conversion table */ return linevert(lptr, line2); } /*------------------------------------------------------------------------- */ int ana_compile_file(narg, ps) int narg, ps[]; { char *s; int nsym; int iq; if ( sym[ ps[0] ].class != 2 ) return execute_error(70); s = (char *) sym[ps[0] ].spec.array.ptr; iq = compile_file(s); if (iq == -1) { printf("COMPILE_FILE, can't find file %s\n", s); return -1; } return 1; } /*------------------------------------------------------------------------- */ int compile_file(s) char *s; { FILE *save_anain; char *p, *name; struct sdesc save_cur_line; int iq, save_single_status, save_context; /* probably need to add a ".ana" to name */ name = (char *) malloc( strlen(s) + 4); strcpy(name, s); /* if no "." in file, then append ".ana" */ p = s; while (*p) if (*p++ == '.') break; if (*p == 0) strcat(name, ".ana"); printf("file name = %s\n",name); /* before we try to open the file, check our file count */ if ( ++nest > MXNEST ) parser_error(9); if ( (indirects[nest-1] = fopen(name,"r")) == NULL) return -1; save_anain = anain; anain = indirects[nest-1]; /* also need to save current line if in the middle of something else */ if (save_cur_line.n=cur_line.n) save_cur_line.p=(byte *) strsavsd(&cur_line); cur_line.n = 0; /* if in a single string mode, need to disable until back from file */ if (save_single_status = single_string_parse_flag) { single_string_parse_flag = 0; } printf("compile_file, start ana_loop\n"); /* set compile_file_flag, this is used to process the EOF in a way to make MainAnaDoOne exit on EOF, assume a negative flag is some sort of screw up */ if (compile_file_flag < 0) compile_file_flag = 0; compile_file_flag++; /* allows nesting (?) */ /* context for symbols needs to be set at top level in case this is run from a subr or func, the code generated will already be top level */ save_context = symbol_context; symbol_context = 0; while (1) { if ((iq = MainAnaDoOne()) < 0) break; } symbol_context = save_context; compile_file_flag--; printf("compile_file, return from ana_loop = %d\n", iq); /* restore the single string mode to whatever it was */ single_string_parse_flag = save_single_status; anain = save_anain; if (cur_line.n = save_cur_line.n) { strncpy(line2, (char *) save_cur_line.p, save_cur_line.n); cur_line.p = line2; free(save_cur_line.p); } free(name); return 1; } /*-------------------------------------------------------------------------*/ int linevert(p, pq) byte *p,*pq; /* runs byte string p through conversions, result in non-overlapping pq */ /* p must be null terminated, pq will not be */ /* sets globals cur_line.p and cur_line.n to result in pq */ /* returns cur_line.n */ { byte *pstr, *p2; char *escapes = "ntbrf\\\'aev"; char *pe; char *escape_results = "\n\t\b\r\f\\\'\007\027\v"; int n; cur_line.p = pq; p2 = pq; while (*p) if ((*pq++ = tab_trans[*p++]) == 0) { /*special treatment chars, check what we got */ pq--; p--; switch (*p) { case '\'': /*start of a string */ /*printf("caught a string\n");*/ pstr = sq; p++; /*start, look for end */ while (*p) { /* two special cases */ if (*p == '\'') { p++; /*got a quote, check next char */ if (*p != '\'') break; /*only a single quote, done! */ else *pstr++ = *p++; } else if (*p == '\\') { p++; /* escape sequence */ pe = strchr(escapes, *p); if (pe) { *pstr++ = *(escape_results + (pe - escapes)); p++;} else p++; /* skip over if unknown */ /* support for \nnn sequences would go here if desired later */ } else *pstr++ = *p++; } /* check if ended on an EOL instead of an ' */ if ( *(p - 1) == '\n' ) pstr--; n = pstr - sq; /* the count */ *pstr = '\0'; /*null terminate */ /*get a symbol # and insert it into line2 */ n = fixed_string(sq,n); /*printf("string symbol # = %d\n", n);*/ pq = insert_sym_num(n, pq); break; case '[': /*concat function, add a ( */ *pq++ = *p++; *pq++ = '('; break; case ';': /* a comment, end the line */ *pq++ = *p = '\0'; break; default: /*a { or a }, insert with blanks */ *pq++ = ' '; *pq++ = *p++; *pq++ = ' '; break; } /*end of switch on special char */ }; cur_line.n = (int) ( pq - p2 ); /* null terminate this part, does not guarantee final result is, this simplifies the blank removal a ways down */ *pq = 0; if (cur_line.n <= 0) { cur_line.n = 0; return cur_line.n; } if ( *(pq - 1) == '\n' ) cur_line.n--; if ( *(pq - 1) == '\0' ) cur_line.n--; /* 10/19/95 - remove leading blanks again, we already did this in nextl but we have now converted some other ASCII things into blanks, so check again */ while (*cur_line.p == ' ') { cur_line.p++; cur_line.n--; } /*now scan the whole thing again to look for certain operator keys */ tok2.p = cur_line.p; tok2.n = cur_line.n; while (tok2.n) { n=scan_sym(&psym); if ( n == 2 ) /*look for a match in the list of two's */ { if (n=two_syms()) { *psym.p++ = (byte) n; *psym.p = ' '; } } else if ( n == 3 ) /*look for a match in the list of threes's */ if (n=three_syms()) {*psym.p++ =(byte) n; *psym.p++ = ' '; *psym.p = ' '; } } /*for (n=0;n 0) { /*something in same parcel */ iq=ptab[(int) *tok2.p]; switch (iq) { /* add operand exception for if and while statements 2/3/93, case 64 */ case 64: /* operand, may be OK to keep */ if ( ((keyed != 2) && (keyed != 3)) ) { parser_error(70); break; } case 32: /* colon, keep */ case 8: /*a ( after a keyword, put back in cur_line */ cur_line.p=tok2.p; cur_line.n=tok2.n+cur_line.n; break; case 16: if (keyed == 14) { /* , OK if RUN statement */ /* 2/10/93 pointer changed below to skip over comma */ cur_line.p=tok2.p+1; cur_line.n=tok2.n+cur_line.n-1; break; } else parser_error(32); break; case 128: parser_error(33); break; case 1: case 2: parser_error(34); break; case 4: parser_error(35); break; } } /*process the keyword */ if (keyed <= 0) return(keyed); /*minus values are end conditions, return */ switch (keyed) { case 1: return e_begin(); case 2: return s_if(); case 3: return s_while(); case 4: return s_repeat(); case 5: return s_for(); case 6: return s_do(); case 7: return s_call(); case 10: return s_retall(); case 11: return s_subr(); case 12: return s_func(); case 13: return s_prog(); case 14: return s_run(); case 15: return s_exitloop(); case 16: return s_case(); case 17: return s_ncase(); } printf("syntax error in keyword statement\n"); return -98; } else { /*not a keyword */ /*.................non-keyword processing..................................*/ scan_tok /*are we alone in this parcel ? */ if (tok2.n <= 0 ) { return s_procs(); } /*alone, must be a proc */ else { /*how we parse it depends on the followup */ iq=ptab[*tok2.p]; if (iq == 4) { return s_replace(iq); } else if (iq==8) { return s_lhp(); } else if (iq==16) { return s_procs(); } else if (iq==32) { return s_label(); } else if (iq==64) { return s_replace(iq); } /* an op= construction */ else if (iq==128) { printf("syntax error, misplaced ')'\n"); return 0;} else { printf("impossible syntax error\n"); return(0); } } } /*end of keyed conditional */ } /* end of parser */ /*---------------------------------------------------------------------------*/ int parcel() /* modeled after span_exp in VMS version, input is cur_line, parcel put in tok2, rest in tok3 and cur_lin, returned value is count in tok2 */ { int n,r6,iq; struct sdesc p; tok2.p=cur_line.p; tok2.n=cur_line.n; cur_line.p=zline; cur_line.n=0; tok3.p=zline; tok3.n=0; /*for returns with nothing left */ if (*tok2.p == '\0') {printf("parcel 1\n"); return 0;} /*nothing in line*/ r6=0; /*a flag*/ /* look for start of a parcel, this means scan for a letter,number, or ( */ /* 2/3/93 modified to find first non-white space */ /*scanc(tok2,ptab,11);*/ /* sets tok2 to start of real parcel */ scanc(tok2,ptab,255); p.p=tok2.p; p.n=tok2.n; if (p.n == 0) return 0; /*nothing in line*/ /*check if a ( or [ */ if ( ptab[ (int) *p.p] == 8 ) r6=1; /* set flag if it was */ for (;;) { spanc(p,ptab,3); /*span over symbol, but not over ( etc*/ if (p.n <= 0) {n=tok2.n; return n;} /*nothing left*/ for (;;) { scanc(p,ptab,255); /*look for anything else besides blanks*/ if (p.n <= 0) return tok2.n; /*nothing left*/ iq=ptab[ (int) *p.p]; if (iq == 128) { r6=0; } else { if ( iq > 3) { r6=1; } else { /*got a symbol, either return or break */ if ( r6 == 1) { r6=0; break; } else { /*done, set up descriptors an return */ tok2.n -=p.n; tok3.p =p.p; tok3.n=p.n; cur_line.p=tok3.p; cur_line.n=tok3.n; return tok2.n; }}} /* continue scanc */ p.p+=1; p.n-=1; } r6=0; /*had a "legal" additional symbol */ /*back to spanc */ } } /* end of parcel */ /*---------------------------------------------------------------------------*/ int parcel_nl() /*gets a new line for parcel if necessary */ { while (cur_line.n ==0 ) (void) need_more(); return parcel(); } /*---------------------------------------------------------------------------*/ int scan_sym(sd) /*finds next symbol in tok2, result in sd tok2 shifted to after symbol, returns length */ struct sdesc *sd; /*pointer to a description */ { scanc( tok2,ptab,1); (*sd).p = tok2.p; (*sd).n = tok2.n; spanc( tok2,ptab,3); (*sd).n -= tok2.n; return( (*sd).n ); } /*end of scan_sym */ /*--------------------------------------------------------------------------*/ int ck_find_sym(sd) /*checks if a variable name matches a function name, if not, finds it or makes an undefined, return sym # or 0 if error */ struct sdesc *sd; { byte *s, *pq; int i; /*copy into a null terminated string sq ( <100 characters long) */ if (sd->n > 98) { printf("symbol name too long:"); printcs(sd);printf("\n"); } s = sq; pq = (*sd).p; for (i=0;i< sd->n;i++) *s++ = *pq++; *s='\0'; s=sq; if ( find_fun(s) != -1 ) { printf("illegal use of function name for variable\n"); return 0; } return find_sym(s); } /*--------------------------------------------------------------------------*/ int push(i) /*push a symbol onto scrat "stack" */ int i; { if (pscrat >= &scrat[NSCRAT]) parser_error(1); *pscrat++ = i; } /*--------------------------------------------------------------------------*/ int pop() /*pop a symbol from scrat "stack" */ /* used only in symbols.c */ { if (pscrat == scrat) parser_error(2); return *--pscrat; } /*------------------------------------------------------------------------- */ int end_decode(narg,ntype) /*complete the EVB symbol */ /*and return symbol # */ int narg,ntype; { if (narg == 0) return 0; if (ntype < 0 ) return 0; return get_evb(narg,ntype); } /*------------------------------------------------------------------------- */ int compile_blk(start_state) /*block compiler, returns when end condition is matched, returns # of symbols and puts list symbols in scrat "stack" compile_blk does not know the ntype */ int start_state; { int narg; /* count of symbols stacked */ int n; /*local copy of symbol passed back */ narg=0; do { while ( (n=parse_it() ) == 0 ) {;}; /* keep going until non-zero */ if ( n > 0 ) { narg++; push(n); } } while ( n >= 0 ); /* a negative n escapes the loop, this means an end condition, does it match? also check for a signaled error, and reset some flags */ if ( n > -98 ) { /* -98 and -99 are errors */ if ( (n == -1) ||( n== -start_state) ) return narg; /* OK, return our count */ /* else a mismatch error */ else { printf("start state was %d. \n", start_state); parser_error(48);} } else { /* an error */ parser_error(49); } } /*------------------------------------------------------------------------- */ int input_args() /*processes arg. list for user defined subr and func */ { /*find and stack argument list, must be symbols seperated by commas */ int n={0},i; byte c, *pq, *s; /*printf("tok2 for input_args:"); printcs(&tok2); printf("\n");*/ /*look for the first , or ( */ if (tok2.n <= 0) return 0; /*no arguments */ while (tok2.n-- > 0 ) if( ( c = *tok2.p++) == ',' || c == '(' ) break; if (tok2.n <= 0) return 0; /*no arguments */ while ( 1 ) { /*have to find a symbol or some kind of syntax error */ scan_tok; if ( ptab[(int) *tok2.p] != 1 ) return -1; scan_sym(&token); /*can't be a global variable type */ c = *token.p; if (c=='$' || c=='!' || c=='#') parser_error(4); /*copy into a null terminated string for search routines */ pq=sq; while (token.n-- > 0 ) *pq++ = *token.p++; *pq = '\0'; /*printf("argument name = %s\n", sq);*/ i = lookfor_sym(sq); /*OK if new or if recycled (class = 0 ) */ if ( i < 0 ) i = find_sym(sq); else if ( sym[i].class != 0 ) { printf("argument name = %s, number = %d, class =%d\n", sq,i,sym[i].class); printf("context = %d\n", symbol_context); parser_error(3); } push(i); n++; /*stack and count it */ /*now a comma is required or the end which can be eol or a ')' */ scan_tok; if ( tok2.n <= 0 || *tok2.p == ')' ) break; if ( *tok2.p++ != ',' ) parser_error(5); tok2.n--; } return n; /*return the number of arguments found */ } /*------------------------------------------------------------------------- */ int getarg(sd) /*put argument in token, rest of line in sn */ struct sdesc *sd; /*pointer to a description*/ { int flag=0; token.p = sd->p; token.n = sd->n; while (1) { scanc((*sd),stab,16); /* find something */ if ( sd->n <= 0 ) { /*end of the line */ if ( flag >= -1 ) return sd->n; else { printf("getarg -- unbalanced parenthesis\n"); return 0;} } if ( *(sd->p) == ',' ) { /* a comma, possible escape */ if ( flag == 0) { token.n -= sd->n; (sd->p)++; (sd->n)--; return sd->n; } } /*end of comma case */ else if ( *(sd->p) == '(' ) flag++; else if ( *(sd->p) == ')' ) if ( --flag < 0 ) { /*check balance */ (sd->p)++; (sd->n)--; printf("getarg, a ), (sd->n) = %d\n", (sd->n) ); printf("token = ");printcs(&token);printf("\n"); if (sd->n <= 0 ) return 0; printf("getarg -- unbalanced parenthesis\n"); return 0; } (sd->p)++; (sd->n)--; } /*end of while loop */ } /*end of getarg */ /*---------------------------------------------------------------------------*/ void printcs(sd) /*prints a string based on the string descriptor sd */ struct sdesc *sd; { byte *p; for (p=sd->p; p < (sd->p + sd->n); p++) putchar(*p); return; } /*end of printcs */ /*-------------------------------------------------------------------------*/ int two_syms() /*keys psym against a list of 2 character keywords used as operands */ /*psym must be 2 characters */ { static struct keylist { char *name; int val; } keywords[]={ /*must be in alphabetical order, upper case */ "EQ",225, "GE",227, "GT",226, "LE",229, "LT",228, "NE",230, "OR",231 }; int low,high,mid,cond,nkeys; char *s,*t; nkeys = sizeof(keywords)/sizeof(struct keylist); low=0; high=nkeys-1; while (low <= high) { mid=(low+high)/2; s = (char *) psym.p; t = keywords[mid].name; if ( (cond=(int)(*s-*t)) == 0 ) { s++; t++; cond=(int)(*s-*t); } if (cond < 0) high=mid-1; else if (cond > 0) low=mid+1; else return(keywords[mid].val); } return 0; /*couldn't find a match */ } /*end of two_syms */ /*-------------------------------------------------------------------------*/ int three_syms() /*keys psym against a list of 3 character keywords used as operands */ /*psym must be 3 characters */ { static struct keylist { char *name; int val; } keywords[]={ /*must be in alphabetical order, upper case */ "AND",232, "MOD",'%', "XOR",233 }; int low,high,mid,cond,nkeys; char *s,*t; nkeys = sizeof(keywords)/sizeof(struct keylist); low=0; high=nkeys-1; while (low <= high) { mid=(low+high)/2; s = (char *) psym.p; t = keywords[mid].name; if ( (cond=(int)(*s-*t)) == 0 ) { s++; t++; cond=(int)(*s-*t); if (cond==0) { s++; t++; cond=(int)(*s-*t); } } if (cond < 0) high=mid-1; else if (cond > 0) low=mid+1; else return(keywords[mid].val); } return 0; /*couldn't find a match */ } /*end of two_syms */ /*-------------------------------------------------------------------------*/ int ana_find_keys() /*checks psym against a list of key words */ { int iq; byte s[16]; byte *pq; static struct keylist { char *name; int val; } keywords[]={ /*must be in alphabetical order, upper case */ "BEGIN",1, "BLOCK",13, "BREAK",15, "CALL",7, "CASE",16, "DO",6, "ELSE",-5, "END",-1, "ENDBLOCK",-13, "ENDCASE",-16, "ENDDO",-6, "ENDFUNC",-12, "ENDIF",-2, "ENDPROG",-13, "ENDREPEAT",-4, "ENDSUBR",-11, "ENDWHILE",-3, "EXITLOOP",15, "FOR",5, "FUNC",12, "FUNCTION",12, "IF",2, "NCASE",17, "PROC",11, "PROGRAM",13, "REPEAT",4, "RETALL",10, "RUN",14, "SUBR",11, "SUBROUTINE",11, "WHILE",3, "{",1, "}",-1 }; static int nkeys={33}; int low,high,mid,cond; /*copy psym into a null terminated string */ iq=(psym.n > 15) ? 15 : psym.n; pq = psym.p; strncpy((char *) s,(char *) pq, iq); s[iq]='\0'; /*binary search cribbed from C manual */ low=0; high=nkeys-1; while (low <= high) { mid=(low+high)/2; if ((cond = strcmp(s,keywords[mid].name)) < 0) high=mid-1; else if (cond > 0) low=mid+1; else return(keywords[mid].val); } return 0; /*couldn't find a match */ } /*end of ana_find_keys */ /*--------------------------------------------------------------------------*/ /*..........BEGIN............*/ int e_begin () /* begin, 1 */ { int narg; narg = compile_blk(1); /* 1 is the start code for begin */ return end_decode(narg,1); } /*.............IF............*/ int s_if () /* if, 6 */ { int n,iq; /*printf("cur_line:"); printcs(&cur_line); printf("\n");*/ parcel_nl(); token.n=tok2.n; token.p=tok2.p; /*printf("tok2.n = %d, cur_line.n = %d\n", tok2.n, cur_line.n);*/ /*printf("tok2 :"); printcs(&tok2); printf("\n");*/ if ( (n=compile_tok()) < 0) parser_error(47); push(n); /*stack the condition */ /*look for a then */ parcel_nl(); psym1.n=tok2.n+cur_line.n; psym1.p=tok2.p; /*save in case we don't find a "then" */ n=scan_sym(&psym); /* note, leaving out a scan_tok here that I don't think we need */ /*if no "then", reset cur_line */ if ( (n !=4) || (strncmp(psym.p,"THEN",4) != 0 )) {cur_line.n=psym1.n; cur_line.p=psym1.p;} if ( (n=parse_it()) <= 0) parser_error(46); push(n); /*stack the then statement */ /* an ELSE ? */ if ((anain != stdin) && ( cur_line.n == 0 )) { /*if from a file we have to try harder to find an else */ do { nextl(); } while (cur_line.n == 0 ); } /* test again */ if ( cur_line.n <= 0 ) /* no ELSE if nothing to check */ push(0); /* so stack a 0 */ else { /*what do we have? */ psym1.n=cur_line.n; psym1.p=cur_line.p; /*save in case we don't find */ if ((parcel() >= 4)&&(scan_sym(&psym)==4)&&(strncmp(psym.p,"ELSE",4)==0)) { if ((n=parse_it()) <= 0) parser_error(45); else push(n); /*OK !, stack it */ } else {cur_line.n=psym1.n; cur_line.p=psym1.p; push(0); } /*reset cur_line */ } /* finish, 3 args */ return end_decode(3,6); } /*...............WHILE.......*/ int s_while () /* while, 8 */ /* should be very similar to if parse, wasn't in VMS version */ { int n,iq; parcel_nl(); token.n=tok2.n; token.p=tok2.p; if ( (n=compile_tok()) < 0) parser_error(50); /*printf("expression sym # %d\n",n);*/ push(n); /*stack the condition */ /*look for a DO (optional) */ /*printf("tok2.n = %d, cur_line.n = %d\n",tok2.n,cur_line.n);*/ parcel_nl(); psym1.n=tok2.n+cur_line.n; psym1.p=tok2.p; /*save in case we don't find a "DO" */ /*printf("tok2.n = %d, cur_line.n = %d\n",tok2.n,cur_line.n);*/ n=scan_sym(&psym); /* note, leaving out a scan_tok here that I don't think we need */ /*if no "do", reset cur_line */ if ( (n !=2) || (strncmp(psym.p,"DO",2) != 0 )) {cur_line.n=psym1.n; cur_line.p=psym1.p;} if ( (n=parse_it()) <= 0) parser_error(51); /*printf("statement sym # %d\n",n);*/ push(n); /*stack the statement */ return end_decode(2,8); } /*.............REPEAT........*/ int s_repeat () /* repeat until, 13 */ { /*get the statement first */ int n; if ( (n=parse_it()) <= 0) parser_error(52); push(n); /*stack the repeat statement */ /*think we just need a parcel_nl here, not identical to vms version */ parcel_nl(); n=scan_sym(&psym); /*must find UNTIL */ if ( (n !=5) || (strncmp(psym.p,"UNTIL",4) != 0 )) parser_error(53); if (tok2.n > 0) { cur_line.p = tok2.p; cur_line.n += tok2.n; } parcel_nl(); token.n=tok2.n; token.p=tok2.p; if ( (n=compile_tok()) < 0) parser_error(54); push(n); /*stack the condition */ return end_decode(2,13); } /*.............FOR...........*/ int s_for () /* FOR, 4 */ { int n,i; if (parcel() <= 0 ) { printf("incomplete FOR statement\n"); return 0; } n=scan_sym(&psym); if ( (i = ck_find_sym(&psym)) == 0 ) parser_error(55); push(i); scan_tok; if ( *tok2.p++ != '=' ) parser_error(56); /*need an = sign */ /*lower limit required */ tok2.n--; if ( tok2.n <= 0 ) parser_error(57); getarg(&tok2); if ( (i = compile_tok()) < 0) parser_error(58); push(i); /*the upper limit, also required */ getarg(&tok2); if ( (i = compile_tok()) < 0) parser_error(59); push(i); /*increment is optional */ getarg(&tok2); if (token.n <= 0 ) i = 1; else { if ( (i = compile_tok()) < 0) parser_error(60); } push(i); /* there may be an optional DO */ parcel_nl(); psym1.n=tok2.n+cur_line.n; psym1.p=tok2.p; /*save in case we don't find a "DO" */ n=scan_sym(&psym); /* note, leaving out a scan_tok here that I don't think we need */ /*if no "do", reset cur_line */ if ( (n !=2) || (strncmp(psym.p,"DO",2) != 0 )) {cur_line.n=psym1.n; cur_line.p=psym1.p;} /*now get the body of the FOR loop */ if ( (i=parse_it()) <= 0) parser_error(61); push(i); /*stack the body */ return end_decode(5,4); } /*..............DO...........*/ int s_do () /* do ... while, 9 */ { /*similar to repeat statement */ /*get the statement first */ int n; if ( (n=parse_it()) <= 0) parser_error(62); push(n); /*stack the repeat statement */ /*think we just need a parcel_nl here, not identical to vms version */ parcel_nl(); n=scan_sym(&psym); /*must find WHILE */ if ( (n !=5) || (strncmp(psym.p,"WHILE",5) != 0 )) parser_error(63); if (tok2.n > 0) { cur_line.p = tok2.p; cur_line.n += tok2.n; } /*printf("DO...WHILE, looking for condition\n");*/ parcel_nl(); token.n=tok2.n; token.p=tok2.p; if ( (n=compile_tok()) < 0) parser_error(64); push(n); /*stack the condition */ return end_decode(2,9); } /*.............CALL..........*/ int s_call () /* verbose way to call a subroutine */ { /* simpler than vms version, needs to be tested */ int n; parcel_nl(); n=scan_sym(&psym); scan_tok; return s_procs(); } /*...........RETALL..........*/ int s_retall () /* RETALL, 9 */ { push( 0x1004); return end_decode(1,10); } /*.............SUBR..........*/ int s_subr () /* SUBR */ { int i,iq,narg,nsubarg,n, save_context; short *ptr; char *s; /* 11/20/95 because a routine can be compiled at run time and eval's are allowed in subr's, the symbol_context could be != 0 here (it would be the value for the subr/func running); hence we use compile_in_progress to avoid nesting now, hope it works */ printf("%s",lptr); /* if (symbol_context) parser_error(65); */ if (compile_in_progress) parser_error(65); compile_in_progress = 1; /*we want the name to be on the same line */ if ( parcel() == 0 ) parser_error(7); n=scan_sym(&psym); s = strsavsd( &psym ); /* save a local copy of name */ if ( (iq = setup_subr(lptr,s)) < 0 ) parser_error(6); /*printf("user subr # = %d\n",iq);*/ save_context = symbol_context; symbol_context = iq + 1; edb_context = symbol_context; if ( (nsubarg = input_args() ) < 0 ) parser_error(5); /*printf("starting compilation of subroutine %s\n",s);*/ narg = compile_blk(11); /* 11 is the start code for subroutine */ if (narg == 0) printf("null subroutine, not compiled or entered\n"); else { i = end_decode(narg,1); ptr = get_subr_desc(nsubarg,i); user_subr_ptrs[iq] = ptr; printf("%s compiled\n",s); } /*printf("free in s_subr, ptr = %d\n",s);*/ free(s); edb_context = 0; symbol_context = save_context; compile_in_progress = 0; return 0; /* the zero return is to avoid immediate execution of the code */ } /*.............FUNC..........*/ int s_func () /* FUNC */ { int i,iq,narg,nsubarg,n, save_context; short *ptr; char *s; printf("%s",lptr); /* if (symbol_context) parser_error(65); */ if (compile_in_progress) parser_error(65); compile_in_progress = 1; /*we want the name to be on the same line */ if ( parcel() == 0 ) parser_error(21); n=scan_sym(&psym); /* save a local copy of name */ s = strsavsd( &psym ); if ( (iq = setup_func(lptr,s)) < 0 ) parser_error(22); save_context = symbol_context; symbol_context = iq + 1 +MAX_USER_SUBRS; edb_context = symbol_context; /*printf("working on user function %s, context = %d\n", s, symbol_context);*/ if ( (nsubarg = input_args()) < 0 ) parser_error(5); /*printf("starting compilation of function %s\n",s);*/ narg = compile_blk(12); /* 12 is the start code for function */ if (narg == 0) printf("null function, not compiled or entered\n"); else { i = end_decode(narg,1); ptr = get_subr_desc(nsubarg,i); user_func_ptrs[iq] = ptr; printf("%s compiled\n",s); } /*printf("free in s_func, ptr = %d\n",s);*/ free(s); edb_context = 0; symbol_context = save_context; compile_in_progress = 0; return 0; /* the zero return is to avoid immediate execution of the code */ } /*....BLOCK or PROG..........*/ int s_prog () /* code block */ { int i,iq,narg,n,save_edb_context; short *ptr; char *s; char *strsave(); printf("%s",lptr); /*we want the name to be on the same line with nothing else */ if ( parcel() == 0 ) parser_error(12); n=scan_sym(&psym); scan_tok; if (tok2.n) { printf("program or block name must be followed by end of line\n"); return -98; } s = strsavsd( &psym ); /* save a local copy of name */ /*printf("starting compilation of program block %s\n",s);*/ if ( (iq = setup_block(lptr,s)) < 0 ) parser_error(13); /*printf("code block # = %d\n",iq);*/ save_edb_context = edb_context; edb_context = iq + 1 + MAX_USER_SUBRS + MAX_USER_FUNCS; /* note that symbol_context is not saved */ narg = compile_blk(13); /* 13 is the start code for block */ if (narg == 0) printf("null program block, not entered in table\n"); else { i = end_decode(narg,1); ptr = get_subr_desc(0,i); user_code_ptrs[iq] = ptr; /*printf("%s compiled\n",s);*/ } /*printf("free in s_prog, ptr = %d\n",s);*/ free(s); edb_context = save_edb_context; return 0; /* the zero return is to avoid immediate execution of the code */ } /*..............RUN..........*/ int s_run () /* RUN, 14 */ { int iq; if ( parcel() == 0) return e_begin(); /*nothing else, treat like begin */ /*else, fake tok2 and handle like a subr without args*/ /*printf("tok2.n = %d, cur_line.n = %d\n", tok2.n, cur_line.n);*/ /*printf("tok2 :"); printcs(&tok2); printf("\n");*/ tok2.n+=1; tok2.p-=1; scan_sym(&psym); /*printf("psym.n = %d\n", psym.n);*/ /*printf("block name :"); printcs(&psym); printf("\n");*/ strncpy(sq,psym.p,psym.n); sq[psym.n] = '\0'; /*null terminate it */ push( iq =find_block(sq) ); /*stack it */ /*printf("code # = %d\n",iq);*/ return end_decode(1,14); } /*.........EXITLOOP..........*/ int s_exitloop () /* BREAK or EXITLOOP, 10 */ { /* like RETALL, but different code */ push( 0x1000); return end_decode(1,10); } /*............CASE...........*/ int s_case () /* CASE, 11 */ { int i,narg,n,pflag; struct sdesc sd; /*each line has an expression followed by a : followed by a statement */ narg=0; while (1) { /* loop over list */ parcel_nl(); tok3.p=tok2.p; tok3.n=tok2.n; cur_line.n=cur_line.n + tok2.n; cur_line.p=tok2.p; /*find the colon, put lhs express in token */ pflag=0; while (tok3.n > 0 ) { /*printf("*tok3.p = %.1s\n", tok3.p);*/ scanc(tok3,ptab,168); if ( *tok3.p == ':' && pflag == 0 ) break; /*printf("*tok3.p = %.1s\n", tok3.p);*/ switch ( *tok3.p ) { case '(': pflag++; break; case ')': pflag--; break; } tok3.n--; tok3.p++; } tok2.n = tok3.p - tok2.p; token.n=tok2.n; token.p=tok2.p; /*tok3 should pt to a :, check it */ if ( tok3.n <= 0 ) break; /*no colon, done or error */ else { /*OK, a colon */ /*printf("must have gotten the colon\n");*/ tok3.n--; tok3.p++; /*skip over colon */ scanc(tok3,ptab,255); /*check if an else: construction */ n=scan_sym(&psym); if ( (i=ana_find_keys()) == -5 ) break; /*treat like the loop escape above*/ if ( (n=compile_tok()) < 0) parser_error(39); push(n); /*stack the condition */ /*now the statement, if any */ cur_line.n -= (tok3.p - cur_line.p); cur_line.p = tok3.p; /*printf("cur_line.n = %d\n", cur_line.n);*/ /*printcs(&cur_line); printf("\n");*/ narg++; while ( (n=parse_it() ) == 0 ) {;}; /* keep going until non-zero */ if ( n > 0 ) push(n); else parser_error(39); } } /*escaped, could be an end or an else or an error */ n=parse_it(); switch ( n ) { default: parser_error(39); case -1: case -16: push(0); break; case -5: /*an else, do the statement */ while ( (n=parse_it() ) == 0 ) {;}; /* keep going until non-zero */ if ( n > 0 ) push(n); else parser_error(43); if ((i=parse_it()) != -1 && i != -16 ) parser_error(41); } return end_decode(narg*2+1,11); } /*............NCASE..........*/ int s_ncase () /* NCASE, 12 */ { int i,narg,n; struct sdesc sd; /*first compile the test statement */ parcel_nl(); token.n=tok2.n; token.p=tok2.p; if ( (i=compile_tok()) < 0) parser_error(37); push(i); /*stack the statement */ narg=2; /*case counter, parse the cases */ do { while ( (n=parse_it() ) == 0 ) {;}; /* keep going until non-zero */ if ( n > 0 ) { narg++; push(n); } } while ( n >= 0 ); /*escaped, could be an end or an else or an error */ switch ( n ) { default: parser_error(38); case -1: case -16: push(0); break; case -5: /*an else */ while ( (n=parse_it() ) == 0 ) {;}; /* keep going until non-zero */ if ( n > 0 ) push(n); else parser_error(36); /* printf("cur_line:"); printcs(&cur_line); printf("\n");*/ i = parse_it(); /* printf("i from parse_it = %d\n",i);*/ if (i != -1 && i != -16 ) parser_error(40); } return end_decode(narg,12); } /*............PROCS..........*/ int s_procs () /* subroutine call, 7 */ { int n,narg,nsub; /*printf("subroutine name :"); printcs(&psym); printf("\n");*/ /*check list and return id */ strncpy(sq,psym.p,psym.n); sq[psym.n] = '\0'; /*null terminate it */ push( nsub=find_subr(sq)); /*stack it */ /*printf("subr # = %d\n",nsub);*/ /*process arguments */ narg=1; tok2.n--; tok2.p++; while (tok2.n > 0 ) { narg++; getarg(&tok2); if (token.n > 0) { if ( (n=compile_tok()) < 0) parser_error(66); push(n); } else push(ANA_ZERO_SYM); /*a null argument */ } /*end of while condition */ /*the type is either a 3 or a 7 for internal or user subroutine resp. */ /*printf("num_ana_subr = %d, nsub = %d\n",num_ana_subr,nsub);*/ if (nsub < num_ana_subr) return end_decode(narg,3); else return end_decode(narg,7); } /*...........REPLACE.........*/ int s_replace (iq) /* replace, 2 */ int iq; /*LHS already in psym and tok2 pts to operand or = */ { int i,n; /*simple = or op= ? */ tok2.n--; tok2.p++; /*bump tok2 */ scan_tok; if (iq == 64 ) { /*op= case*/ if ( *tok2.p != '=' ) parser_error(23); /*construct a RHS using both LHS and RHS with = sign replaced */ *tok2.p = '('; tok2.n = tok2.n + (tok2.p - psym.p); tok2.p = psym.p; /* printf("tok2 for rhs:"); printcs(&tok2); printf("\n");*/ } /*simple = case */ if ( (i = ck_find_sym(&psym)) == 0 ) parser_error(24); /*LHS symbol */ push(i); /*stack the LHS */ token.n=tok2.n; token.p=tok2.p; if ( (n=compile_tok()) < 0) parser_error(25); push(n); /*stack the RHS */ return end_decode(2,2); } /*...........INSERT..........*/ int s_lhp () /* INSERT, 5 */ /*we have a non-keyword symbol followed by a (, should be an insert statement, symbol in psym */ { char s,*pq, *sv=NULL; struct sdesc sd; int i,n,pflag,iq; /*span the parens and verify that we have an = sign */ pflag=1; tok2.p++; tok2.n--; sd.p=tok2.p; while ( tok2.n-- ) { if (*tok2.p == '(' ) pflag++; else if (*tok2.p == ')' ) if (--pflag == 0) break; tok2.p++;} /*set sd to the enclosed part (without the parens.) and tok2 to the rest */ sd.n = tok2.p - sd.p; tok2.p++; /*check out that = sign */ scan_tok; if ( *tok2.p != '=') { /*either op = or error */ if ( iq = ptab[(int) *tok2.p] != 64 ) parser_error(26); tok2.n--; tok2.p++; /*bump tok2 */ scan_tok; if ( *tok2.p != '=' ) parser_error(27); /*still need an = sign */ /*construct a RHS using both LHS and RHS with = sign replaced */ *tok2.p = '('; tok2.n = tok2.n + (tok2.p - psym.p); tok2.p = psym.p; /* now, we really need to make a copy of this or else the lhs part we cleverly copied to the rhs will be modified in compile_tok before we use the rhs */ sv = strsavsd( &tok2 ); /* save a local copy of rhs */ tok2.p = (byte *) sv; /* since we don't use tok2 for the lhs below */ /*printf("tok2 for rhs:"); printcs(&tok2); printf("\n");*/ } else { tok2.p++; tok2.n--; } /*vms code made an exception for the EVAL function but may not have worked right, probably need some more work on this case, not in for now */ if ( (i = ck_find_sym(&psym)) == 0 ) parser_error(28); /*LHS symbol */ push(i); n=2; /*arg counter, process the args. (subscripts) in sd */ while (sd.n > 0 ) { n++; getarg(&sd); if (token.n > 0) if ( (i=compile_tok()) < 0) parser_error(29); else push(i); else push(ANA_ZERO_SYM); /*a null argument */ } /*end of arg processing */ /*printf("tok2 for rhs:"); printcs(&tok2); printf("\n");*/ token.n=tok2.n; token.p=tok2.p; if ( (i=compile_tok()) < 0) parser_error(30); push(i); /*stack the RHS */ if (sv != NULL) free(sv); return end_decode(n,5); } /*...........................*/ int s_label () /* not supported */ { parser_error(67); } /*--------------------------------------------------------------------------*/