/* fbasic.c * * A very simple BASIC interpreter. Quite compatible with Microsoft * MBASIC (CP/M) and GWBASIC (MS-DOS). * * Requires garbage collecting malloc (no free's are done) * There are three areas where memory can be reclaimed * - random file buffers * - string temporaries * - variables that have been unlinked * Currently uses the Boehm-Demers-Weiser conservative garbage * collector. * * Copyright (c) 2000, 2001, Fridtjof Weigel * All Rights Reserved */ /* Standard headers */ /* Comment this out to build under Solaris */ #define _XOPEN_SOURCE 500 #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include extern char **environ; /* Garbage collecting malloc */ #include "gc.h" /* FBASIC version */ #define VERSION "2.1.3" /* Default editor command */ #define EXT_EDIT "vi -c %n %f" /* Set to 1 if your machine supports unaligned access to doubles */ /* (should be set to 1 for maximum efficiency on Intel, must be set to 0 * on Sparc) */ #ifndef UNALIGNED_DOUBLES #define UNALIGNED_DOUBLES 0 #endif /* Set to 1 to use cr/lf, not just lf */ #ifndef CRLF #define CRLF 0 #endif /* Maximum array dimensions */ #define MAX_DIMS 64 /* Maximum variables to cache */ #define MAX_CACHE 5 /* Convenience defines */ #define FOREVER for(;;) #define YES 1 #define NO 0 /* This program reads and write mis-aligned doubles. All such transfers * are done through the R() and W() macros, to allow correction for * systems that don't support this. */ #if UNALIGNED_DOUBLES /* Unaligned double access permitted */ #define R(x) (*(double *)(x)) #define W(x,v) (*(double *)(x) = (v)) #else /* Read unaligned double */ static double R(unsigned char *x) { double v; /* If the pointer is aligned on 8 byte boundary, access directly */ if ((sizeof(double) == 8) && (((int)x & 0x7) == 0)) return *(double *)x; memcpy(&v, x, sizeof(double)); return v; } /* Write unaligned double */ static void W(unsigned char *x, double v) { /* If the pointer is aligned on 8 byte boundary, access directly */ if ((sizeof(double) == 8) && (((int)x & 0x7) == 0)) *(double *)x = v; else memcpy(x, &v, sizeof(double)); } #endif /* 1K byte */ #define K * 1024 /* Maximum program size */ #define MAX_PROGRAM (256 K) /* Maximum source line length */ #define MAX_SRC 1024 /* Maximum token size */ #define MAX_TKN (MAX_SRC * 9) /* BASIC string (length + body) */ typedef struct { int length; char *storage; int allocated; } basic_string; /* Token */ typedef struct { char *name; unsigned char tval; } token; /* Token values */ #define ABS 1 #define ASC 2 #define ATN 3 #define CHAIN 4 #define MERGE 5 #define ALL 6 #define CHR 7 #define CINT 8 #define CLEAR 9 #define CLOSE 10 #define COMMON 11 #define COS 12 #define CVL 13 #define CVD 14 #define CVI 15 #define CVS 16 #define DATA 17 #define DATE 18 #define DEF 19 #define BIN 20 #define FREEFILE 21 #define FREE 22 #define FIX 23 #define DELETE 24 #define DIM 25 #define END 26 #define ENVIRONS 27 #define ENVIRON 28 #define EOFF 29 #define ERASE 30 #define ERL 31 #define ERROR 32 #define ERRF 33 #define EXP 34 #define FIELD 35 #define AS 36 #define FOR 37 #define TO 38 #define STEP 39 #define GET 40 #define GOSUB 41 #define GOTO 42 #define HEX 43 #define IF 44 #define THEN 45 #define ELSE 46 #define INPUT 47 #define INSTR 48 #define INTF 49 #define KILL 50 #define LEFT 51 #define LEN 52 #define LET 53 #define LINE 54 #define LIST 55 #define LOF 56 #define LOG 57 #define LSET 58 #define MID 59 #define MKD 60 #define MKI 61 #define MKS 62 #define NAME 63 #define NEW 64 #define NEXT 65 #define OCT 66 #define ON 67 #define OPEN 68 #define CURSESF 69 #define LOCATE 70 #define CLS 71 #define BEEP 72 #define SLEEP 73 #define POS 74 #define PRINT 75 #define USING 76 #define PUT 77 #define RANDOMIZE 78 #define READ 79 #define REM 80 #define RESTORE 81 #define RETURN 82 #define RIGHT 83 #define RND 84 #define RSET 85 #define RUN 86 #define SAVE 87 #define SGN 88 #define SIN 89 #define SPACE 90 #define SPC 91 #define SQR 92 #define STOP 93 #define STRF 94 #define STRINGF 95 #define SWAP 96 #define SYSTEM 97 #define TAB 98 #define TAN 99 #define TIME 100 #define TIMER 101 #define TROFF 102 #define TRON 103 #define VAL 104 #define WEND 105 #define WHILE 106 #define WIDTH 107 #define WRITE 108 #define CHDIR 109 #define MKDIR 110 #define RMDIR 111 #define AUTO 112 #define CSNG 113 #define CONT 114 #define SEG 115 #define EDIT 116 #define CSRLIN 117 #define FILES 118 #define INKEY 119 #define INPUTS 120 #define INP 121 #define LLIST 122 #define LPOS 123 #define LPRINT 124 #define NULLF 125 #define OUT 126 #define PEEK 127 #define POKE 128 #define RENUM 129 #define RESUME 130 #define OFF 131 #define VARPTR 132 #define WAIT 133 #define EQUAL 134 #define PLUS 135 #define DASH 136 #define STAR 137 #define SLASH 138 #define HAT 139 #define COLON 140 #define HASH 141 #define COMMA 142 #define OPENP 143 #define CLOSEP 144 #define LOAD 145 #define LOC 146 #define AND 147 #define OR 148 #define NOT 149 #define XOR 150 #define IMP 151 #define EQV 152 #define MOD 153 #define NE 154 #define LE 155 #define GE 156 #define LT 157 #define GT 158 #define IDIV 159 #define SEMI 160 #define MKL 161 #define DEFINT 162 #define DEFSNG 163 #define FN 164 #define CDBL 165 #define DEFDBL 166 #define DBL 167 #define VARS 168 #define COLOR 169 #define LCASE 170 #define UCASE 171 #define LTRIM 172 #define RTRIM 173 #define INTERPRET 174 #define GRAPHIC 175 #define DEFSTR 176 #define DEFLNG 177 #define SEEK 178 #define LOCAL 179 #define ENDLOCAL 180 #define CURSESATTR 181 #define SHL 182 #define SHR 183 /* Maximum token value */ #define TOKEN_MAX 200 /* Token table (name/value) */ static token token_table[] = { { "ABS(", ABS }, { "ASC(", ASC }, { "ATN(", ATN }, { "CHAIN", CHAIN }, { "MERGE", MERGE }, { "ALL", ALL }, { "CHR$(", CHR }, { "CINT(", CINT }, { "CLEAR", CLEAR }, { "CLOSE", CLOSE }, { "COMMON", COMMON }, { "COS(", COS }, { "CVL(", CVL }, { "CVD(", CVD }, { "CVI(", CVI }, { "CVS(", CVS }, { "DATA", DATA }, { "DATE$", DATE }, { "DEF", DEF }, { "BIN$(", BIN }, { "FREEFILE", FREEFILE }, { "FREE", FREE }, { "FIX(", FIX }, { "DELETE", DELETE }, { "DIM", DIM }, { "END", END }, { "ENVIRON$(", ENVIRONS }, { "ENVIRON", ENVIRON }, { "EOF(", EOFF }, { "ERASE", ERASE }, { "ERL", ERL }, { "ERROR", ERROR }, { "ERR", ERRF }, { "EXP(", EXP }, { "FIELD", FIELD }, { "AS", AS }, { "FOR", FOR }, { "TO", TO }, { "STEP", STEP }, { "GET", GET }, { "GOSUB", GOSUB }, { "GOTO", GOTO }, { "HEX$(", HEX }, { "IF", IF }, { "THEN", THEN }, { "ELSE", ELSE }, { "INPUT", INPUT }, { "INSTR(", INSTR }, { "INT(", INTF }, { "KILL", KILL }, { "LEFT$(", LEFT }, { "LEN(", LEN }, { "LET", LET }, { "LINE", LINE }, { "LIST", LIST }, { "LOF(", LOF }, { "LOG(", LOG }, { "LSET", LSET }, { "MID$(", MID }, { "MKD$(", MKD }, { "MKI$(", MKI }, { "MKS$(", MKS }, { "NAME", NAME }, { "NEW", NEW }, { "NEXT", NEXT }, { "OCT$(", OCT }, { "ON", ON }, { "OPEN", OPEN }, { "CURSES", CURSESF }, { "LOCATE", LOCATE }, { "CLS", CLS }, { "BEEP", BEEP }, { "SLEEP", SLEEP }, { "POS(", POS }, { "PRINT", PRINT }, { "?", PRINT }, { "USING", USING }, { "PUT", PUT }, { "RANDOMIZE", RANDOMIZE }, { "READ", READ }, { "REM", REM }, { "\'", REM }, { "RESTORE", RESTORE }, { "RETURN", RETURN }, { "RIGHT$(", RIGHT }, { "RND(", RND }, { "RSET", RSET }, { "RUN", RUN }, { "SAVE", SAVE }, { "SGN(", SGN }, { "SIN(", SIN }, { "SPACE$(", SPACE }, { "SPC(", SPC }, { "SQR(", SQR }, { "STOP", STOP }, { "STR$(", STRF }, { "STRING$(", STRINGF }, { "SWAP", SWAP }, { "SYSTEM", SYSTEM }, { "TAB(", TAB }, { "TAN(", TAN }, { "TIME$", TIME }, { "TIMER", TIMER }, { "TROFF", TROFF }, { "TRON", TRON }, { "VAL(", VAL }, { "WEND", WEND }, { "WHILE", WHILE }, { "WIDTH", WIDTH }, { "WRITE", WRITE }, { "CHDIR", CHDIR }, { "MKDIR", MKDIR }, { "RMDIR", RMDIR }, { "CONT", CONT }, { "SEG", SEG }, { "EDIT", EDIT }, { "CSRLIN", CSRLIN}, { "FILES", FILES }, { "INKEY$", INKEY }, { "INPUT$(", INPUTS }, { "INP(", INP }, { "LLIST", LLIST }, { "LPOS(", LPOS }, { "LPRINT", LPRINT }, { "NULL", NULLF }, { "OUT", OUT }, { "PEEK(", PEEK }, { "POKE", POKE }, { "RENUM", RENUM }, { "RESUME", RESUME }, { "OFF", OFF }, { "VARPTR(", VARPTR }, { "WAIT", WAIT }, { "=", EQUAL }, { "+", PLUS }, { "-", DASH }, { "^", HAT }, { "**", HAT }, { "*", STAR }, { "/", SLASH }, { ":", COLON }, { "#", HASH }, { ",", COMMA }, { "(", OPENP }, { "[", OPENP }, { ")", CLOSEP }, { "]", CLOSEP }, { "LOAD", LOAD }, { "LOC(", LOC }, { "AND", AND }, { "OR", OR }, { "NOT", NOT }, { "XOR", XOR }, { "IMP", IMP }, { "EQV", EQV }, { "MOD", MOD }, { "<>", NE }, { "><", NE }, { "<=", LE }, { "=<", LE }, { ">=", GE }, { "=>", GE }, { "<", LT }, { ">", GT }, { "\\", IDIV }, { ";", SEMI }, { "MKL$(", MKL }, { "FN", FN }, { "VARS", VARS }, { "COLOR", COLOR }, { "COLOUR", COLOR }, { "CSNG(", CSNG }, { "CDBL(", CDBL }, { "AUTO", AUTO }, { "][", COMMA }, { "LCASE$(", LCASE }, { "UCASE$(", UCASE }, { "LTRIM$(", LTRIM }, { "RTRIM$(", RTRIM }, { "INTERPRET", INTERPRET }, { "GRAPHIC(", GRAPHIC }, { "DEFINT", DEFINT }, { "DEFSNG", DEFSNG }, { "DEFDBL", DEFDBL }, { "DEFLNG", DEFLNG }, { "DEFSTR", DEFSTR }, { "SEEK", SEEK }, { "LOCAL", LOCAL }, { "ENDLOCAL", ENDLOCAL }, { "CURSESATTR", CURSESATTR }, { "==", EQUAL }, { "!=", NE }, { "SHL", SHL }, { "SHR", SHR }, { "<<", SHL }, { ">>", SHR }, { "& ", AND }, { "|", OR }, { "!", NOT }, { NULL, 0 } }; /* "High" tokens - variables, literals, end of line, etc. */ #define VARIABLE 255 #define STRING 254 #define START 253 #define LITERAL 252 #define EOL 251 #define EOP 250 #define CONSTANT 249 #define HEX_MODE 248 #define OCTAL_MODE 247 #define BINARY_MODE 246 #define IMPOSSIBLE 245 #define UNARY_MINUS 200 #define UNARY_PLUS 201 #define UNARY_NOT 202 /* Line number ranges (low..high and default) */ #define LOW_LN (0.0) #define HIGH_LN (1.0e38) #define DEFAULT_LN (-1.0) /* Error values */ #define ERROR_SYNTAX 1 /* Syntax error */ #define ERROR_GOSUB 2 /* Gosub stack overflow */ #define ERROR_TYPE 3 /* Incorrect type */ #define ERROR_BREAK 4 /* Break */ #define ERROR_DATA 5 /* Out of data */ #define ERROR_NOLINE 6 /* Line number doesn't exist */ #define ERROR_WHILE 7 /* While stack overflow */ #define ERROR_FOR 8 /* For stack overflow */ #define ERROR_OM 9 /* Out of memory */ #define ERROR_REDIM 10 /* Redimension */ #define ERROR_MATH 11 /* Math error (/0, etc.) */ #define ERROR_DIM 12 /* Dimension */ #define ERROR_NOVAR 13 /* No such variable */ #define ERROR_IO 14 /* I/O error */ #define ERROR_NOEDIT 15 /* Can't edit */ #define ERROR_LOCAL 16 /* Local stack overflow */ #define ERROR_RUN 17 /* Must be running */ #define ERROR_UNIMP 18 /* Not implemented */ /* Maximum nested gosubs, whiles and fors */ #define GOSUB_MAX 128 #define WHILE_MAX 128 #define FOR_MAX 128 #define LOCAL_MAX 128 /* File modes */ #define MODE_FREE 0 #define MODE_INPUT 1 #define MODE_OUTPUT 2 #define MODE_RANDOM 3 #define MODE_BINARY 4 #define MODE_APPEND 5 /* Special files */ #define CONSOLE -1 #define PRINTER -2 #define KEYBOARD -3 /* Maximum open files */ #define MAX_FD 256 /* File buffer descriptor */ struct filedesc { char *buffer; int mode; int reclen; int pos; int width; FILE *f; }; /* Variable header (name, type, pointer to value) */ struct variable { struct variable *next; char *name; int type; int common; void *descriptor; }; /* Array header */ struct array { int ndims; double *dims; int elems; int type; void *values; }; /* Variable types */ #define NAME_ONLY 0 #define SIMPLE_SCALAR 1 #define SIMPLE_STRING 2 #define ARRAY 3 #define STRING_ARRAY 4 typedef void (*sigwf_t)(int sig); /* Global variables */ /* call back existing sigwinch handler */ static sigwf_t sigwf; static int winchanged; /* allow suppression of curses update */ static int curses_update; /* line number hash table -- 80K */ #define MAX_HASH 10000 static unsigned char **line_hash; /* YES if editing not allowed (un-numbered program) */ static int noedit; /* Width of console and line printer (file widths in descriptors) */ static int width, lwidth; static int *pwidth; /* Output has occured -- flush is needed */ static int cout_n; /* For timer */ static time_t current_time; static int ontimerflag; static int secondsleft, ontimevalue; static unsigned char *ontimer; /* For error dispatch */ static double onerror; static int inerror; static unsigned char *current_loc; /* Are we invoked as frun? */ static int frun; /* NULL count for output */ static int nulls; /* Global program arguments */ static int g_ac; static char **g_av; /* Curses */ static WINDOW *sc; static int use_curses; /* Our variables */ static struct variable *variables; /* Current device description */ static int outdev; static FILE *current_file; static FILE *current_infile; static int *ppos; /* File descriptors */ static struct filedesc files[MAX_FD] = {{0}, }; /* Token buffer for tokenizing source code */ static unsigned char tkn_buf[MAX_TKN]; /* Source buffer */ static char src[MAX_SRC]; /* Our tokenized program */ static unsigned char *program; /* Are we tracing line numbers ? */ static int ftrace; /* Error code and error line */ static double erl; static double err; static double current_line; static int running; /* Expression operator stack */ static unsigned char opstack[MAX_SRC]; static int opstack_ptr; /* Expression value stack */ static double valuestack[MAX_SRC / 2]; static int valuestack_ptr; /* Error jump */ static jmp_buf jerror; /* Local break jump (for breaking input) */ static int jbreakflag; static jmp_buf jbreak; /* Output to a string */ static char *coutp; static int coutn; static int coutmax; /* Cache most recently used variables. * The idea is to avoid lengthy searches through the variable list for * variables used in a single segment. * The variable cache must be flushed whenever names can be rebound * (DEF functions). */ static struct variable *variable_cache[MAX_CACHE] = { 0, }; static int vci = 0; /* LOCAL stack */ static unsigned char *localstack[LOCAL_MAX]; static int localstack_ptr; /* GOSUB stack */ static unsigned char *gosubstack[GOSUB_MAX]; static int gosubstack_ptr; /* WHILE stack */ static unsigned char *whilestack[WHILE_MAX]; static int whilestack_ptr; /* flag indicating break (error) has occured */ static int breakflag; /* DATA pointer */ static unsigned char *data; static int pos; /* console position */ static int lpos; /* line printer position */ static int tab; /* tab-to location for print */ static int graphic; /* special graphic char for print */ /* FOR stack */ static unsigned char *forstack[FOR_MAX]; static int forstack_ptr; /* DEF SEG */ static int seg; /* Variable types INT, SNG, STR, DBL, based on first character of name */ static char vtype[256] = { 0, }; /* User defined function pointers (DEF FNA..) */ static unsigned char *fns[256] = { 0, }; /* Numeric character sets */ static const char *b_set = "01"; static const char *o_set = "01234567"; static const char *t_set = "0123456789"; static const char *h_set = "0123456789ABCDEF"; /* Raise error */ static void error(int error) { err = error; erl = current_line; longjmp(jerror, 1); } /* Allocate memory, pointers contained within */ static void *get_memory(int n) { void *p; p = GC_MALLOC(n); if (p == NULL) error(ERROR_OM); return p; } /* Allocate memory, no pointers contained within */ static void *get_memory_atomic(int n) { void *p; p = GC_MALLOC_ATOMIC(n); if (p == NULL) error(ERROR_OM); return p; } /* Reallocate memory */ static void *increase_memory(void *p, int n) { p = GC_realloc(p, n); if (p == NULL) error(ERROR_OM); return p; } /* Free memory */ static void free_memory(void *p) { GC_free(p); } /* Force garbage collection */ static void garbage_collect(void) { GC_gcollect(); } /* Return heap size, don't include program area or line number hash */ static int heap_size(void) { return GC_get_heap_size() - MAX_PROGRAM - (MAX_HASH * sizeof(unsigned char *)); } /* Check filenumber range */ static void check_fn(int filenumber) { if ((filenumber < 0) || (filenumber >= MAX_FD)) error(ERROR_IO); } /* Return free file */ static int freefile(void) { int i; for (i = 1; i < MAX_FD; ++i) if (files[i].mode == MODE_FREE) return i; error(ERROR_IO); return -1; } /* Open a file */ static void open_file(int mode, int filenumber, char *filename, int reclen) { char *m = "r"; check_fn(filenumber); if (files[filenumber].mode != MODE_FREE) error(ERROR_IO); switch (mode) { case MODE_INPUT: m = "r"; break; case MODE_OUTPUT: m = "w"; break; case MODE_APPEND: m = "a+"; break; case MODE_BINARY: m = "r+b"; break; case MODE_RANDOM: files[filenumber].reclen = reclen; files[filenumber].buffer = get_memory_atomic(reclen); m = "r+b"; break; } files[filenumber].f = fopen(filename, m); if (files[filenumber].f == NULL) { if (mode == MODE_RANDOM) { free_memory(files[filenumber].buffer); files[filenumber].buffer = NULL; } error(ERROR_IO); } files[filenumber].mode = mode; files[filenumber].pos = 0; files[filenumber].width = 0; } /* Close a file */ static void close_file(int filenumber) { check_fn(filenumber); if (files[filenumber].mode == MODE_FREE) return; if (files[filenumber].mode == MODE_RANDOM) free_memory(files[filenumber].buffer); files[filenumber].buffer = NULL; files[filenumber].mode = MODE_FREE; fclose(files[filenumber].f); files[filenumber].f = NULL; } /* Return FILE* for file */ static FILE *pfile(int filenumber) { FILE *f; check_fn(filenumber); f = files[filenumber].f; if (f == NULL) error(ERROR_IO); return f; } /* Select file for i/o */ static void select_file(int filenumber) { coutp = NULL; if (outdev == filenumber) return; outdev = filenumber; fflush(current_file); if (filenumber == CONSOLE) { current_file = stdout; current_infile = stdin; ppos = &pos; pwidth = &width; } else if (filenumber == PRINTER) { current_file = stderr; current_infile = stdin; ppos = &lpos; pwidth = &lwidth; } else { current_file = pfile(filenumber); current_infile = current_file; ppos = &(files[filenumber].pos); pwidth = &(files[filenumber].width); } } /* macro to avoid function call */ #define SELECT_CONSOLE if (outdev != CONSOLE) select_file(CONSOLE) /* Refresh for curses */ static void refresh_screen(void) { if (use_curses && curses_update) refresh(); } /* Flush output */ static void flush_out(void) { if (cout_n) { if (use_curses) refresh_screen(); else fflush(stdout); cout_n = 0; } } /* macro to avoid function call */ #define FLUSH_OUT if (cout_n) flush_out() /* Check for BREAK */ static void check_break(void) { if (breakflag) { breakflag = 0; error(ERROR_BREAK); } } /* macro to avoid function call */ #define CHECK_BREAK if (breakflag) check_break() /* Get key for edit */ static int get_key(void) { unsigned char key; flush_out(); if (use_curses) { refresh(); key = getch(); } else { while (read(1, &key, 1) < 0) check_break(); } check_break(); return key; } /* Get line */ static void get_line(char *s, int n) { int x, y; flush_out(); s[0] = '\0'; if (use_curses && (current_infile == stdin)) { if (setjmp(jbreak) == 0) { jbreakflag = YES; nocbreak(); echo(); /* getnstr(s,n) is not available on Solaris */ wgetnstr(sc, s, n); /* Needed for Solaris - if an empty string is accepted * by wgetnstr on Solaris, the cursor position is not * changed. */ } jbreakflag = NO; noecho(); cbreak(); getyx(sc, y, x); move(y, x); refresh(); check_break(); return; } if (fgets(s, n, current_infile) == NULL) { check_break(); error(ERROR_IO); } check_break(); } /* Output character */ static void crlf(void); static void cout(int c) { ++cout_n; if (coutp) { if (coutn >= coutmax) { coutmax += 1024; coutp = increase_memory(coutp, coutmax); } if (c != '\n') coutp[coutn++] = c; return; /* coutn is *ppos! */ } else if (use_curses && (current_file == stdout)) { if (addch(c) == ERR) error(ERROR_IO); } else if (putc(c, current_file) == EOF) error(ERROR_IO); if (c == 8) --*ppos; else if (c == 13) *ppos = 0; else if (c == 10) *ppos = 0; else if (c != 7) ++*ppos; if ((*pwidth > 0) && (*ppos >= *pwidth)) crlf(); } /* String out */ static void sout(char *s) { while (*s) cout(*s++); } /* ANSI sequence to clear screen and home cursor */ static void ansi_cls(void) { sout("\x1b[1;1H\x1b[J"); } /* Output return,newline */ static void crlf(void) { int i; #if CRLF sout("\r\n"); #else cout('\n'); #endif for (i = 0; i < nulls; ++i) cout(0); } /* Output return,newline for edit */ static void ncrlf(void) { if (use_curses) cout('\n'); else sout("\r\n"); } /* Execute program with pty */ static void pty(char *cmd) { int i; char data; int master = 0, slave; pid_t pid_sh; #if 0 /* BSD style pty -- Linux 2.0 needs this */ char mastername[32], slavename[32]; char *s, *t; int found; found = NO; for (s = "pqrs"; !found && *s; ++s) { for (t = "0123456789abcdef"; !found && *t; ++t) { sprintf(mastername, "/dev/pty%c%c", *s, *t); sprintf(slavename, "/dev/tty%c%c", *s, *t); if ((master = open(mastername, O_RDWR|O_NDELAY|O_SYNC)) >= 0) found = YES; } } if (!found) { fprintf(stderr, "all ptys in use\n"); return; } #else /* SVR4 style pty */ char *slavename; if ((master = open("/dev/ptmx", O_RDWR|O_NDELAY|O_SYNC)) < 0) { perror("/dev/ptmx"); return; } if (grantpt(master) < 0) { perror("grantpt"); close(master); return; } if (unlockpt(master) < 0) { perror("unlockpt"); close(master); return; } slavename = ptsname(master); if (slavename == NULL) { perror("ptsname"); close(master); return; } #endif pid_sh = fork(); if (pid_sh < 0) { perror("fork"); return; } if (pid_sh == 0) { setsid(); slave = open(slavename, O_RDWR); dup2(slave, 0); dup2(slave, 1); dup2(slave, 2); /* close(slave); */ /* close all other fds (including slave) */ for (i = 3; i < 256; ++i) close(i); system(cmd); close(0); close(1); close(2); exit(0); } else { /* XXX use select to make this more efficient */ /* XXX sending break to sub-process??? */ nodelay(sc, TRUE); FOREVER { i = read(master, &data, 1); if ((i < 0) && (errno != EAGAIN)) break; if (i == 0) break; /* end of file */ if (i == 1) if (data != '\r') cout(data); i = getch(); data = i; if (i != ERR) { do { i = write(master, &data, 1); if ((i < 0) && (errno != EAGAIN)) break; } while (i != 1); if (i < 0) break; } } close(master); while (wait(NULL) != pid_sh) ; nodelay(sc, FALSE); } } /* Execute program */ static void external_execute(char *prog, char *args) { char *buf; if (args == NULL) args = ""; buf = get_memory_atomic(strlen(prog) + strlen(args) + 1); strcpy(buf, prog); if (*args != '\0') { strcat(buf, " "); strcat(buf, args); } if (use_curses) pty(buf); else system(buf); free_memory(buf); } /* Enter raw keyboard mode */ static void raw_keyboard(void) { if (!use_curses) external_execute("stty", "-echo raw"); } /* Resume normal keyboard mode */ static void cook_keyboard(void) { if (!use_curses) external_execute("stty", "echo cooked"); } /* Is character alpha? */ static int is_alpha(char c) { return ('A' <= c) && (c <= 'Z'); } /* Is character alpha or digit? */ static int is_alphanum(char c) { return ((('A' <= c) && (c <= 'Z')) || (('0' <= c) && (c <= '9'))); } /* Is variable a typed variable? */ static int is_type_variable(unsigned char *p, char t) { char type; if (*p == VARIABLE) { type = (p+2)[p[1]-2]; if (type == t) return YES; if (is_alphanum(type)) { if (vtype[*(p+2)] == t) return YES; } } return NO; } /* Is variable a string variable? */ static int is_string_variable(unsigned char *p) { return is_type_variable(p, '$'); } /* Is variable an integer variable? */ static int is_integer_variable(unsigned char *p) { return is_type_variable(p, '%') || is_type_variable(p, '&'); } /* Return error message */ static char *error_message(void) { switch ((int)err) { case ERROR_SYNTAX: return "syntax"; case ERROR_GOSUB: return "gosub stack"; case ERROR_BREAK: return "break"; case ERROR_DATA: return "out of data"; case ERROR_NOLINE: return "no such line"; case ERROR_WHILE: return "while stack"; case ERROR_FOR: return "for stack"; case ERROR_OM: return "out of memory"; case ERROR_REDIM: return "redimension"; case ERROR_MATH: return "arithmetic"; case ERROR_DIM: return "dimension"; case ERROR_TYPE: return "data type"; case ERROR_NOVAR: return "no such variable"; case ERROR_IO: return "io"; case ERROR_NOEDIT: return "can\'t edit"; case ERROR_LOCAL: return "local stack"; case ERROR_RUN: return "not running"; case ERROR_UNIMP: return "not implemented"; default: return "unknown"; } } /* Signal handler for break */ static void signal_break(int sig) { int olddev = outdev; select_file(CONSOLE); sout("^C"); crlf(); flush_out(); signal(SIGINT, signal_break); select_file(olddev); breakflag = YES; if (jbreakflag) longjmp(jbreak, 1); } /* Peek memory */ static unsigned char peek(size_t n) { unsigned char *p = (unsigned char *)n; return *p; } /* Poke memory */ static void poke(size_t n, unsigned char v) { unsigned char *p = (unsigned char *)n; *p = v; } /* In from port */ static unsigned char inp(int n) { return 0; } /* Out to port */ static void out(int n, unsigned char v) { } /* Wait for port */ static void waitport(int port, int and, int xor) { while (((inp(port) ^ xor) & and) == 0) check_break(); } /* Create a variable */ static void create_variable(char *name, void *descriptor, int t) { struct variable *p; p = get_memory(sizeof(struct variable)); p->name = strdup(name); p->descriptor = descriptor; p->type = t; p->common = NO; p->next = variables; variables = p; } /* Find variable */ static struct variable *find_variable(char *name) { struct variable *p; int n; for (n = 0; n < MAX_CACHE; ++n) { p = variable_cache[n]; if (p && (strcmp(p->name, name) == 0)) return p; } for (p = variables; p; p = p->next) if (strcmp(p->name, name) == 0) { variable_cache[vci] = p; if (++vci >= MAX_CACHE) vci = 0; return p; } return NULL; } /* Flush (empty) the variable cache */ static void flush_variable_cache(void) { int n; for (n = 0; n < MAX_CACHE; ++n) variable_cache[n] = NULL; } /* Destroy variable */ static void destroy_variable(struct variable *v) { struct variable *p; if (v == variables) variables = variables->next; else { for (p = variables; p->next != v; p = p->next) ; p->next = v->next; } flush_variable_cache(); /* XXX Now variable v is ready for freeing */ } /* Kill all non-common variables */ static void only_common_variables(void) { struct variable *p, *q; struct variable *common_variables = NULL; int i; /* Flip the variable list twice, to make it come out in the same * order (for LOCAL/ENDLOCAL) */ for (i = 0; i < 1; ++i) { common_variables = NULL; flush_variable_cache(); for (p = q = variables; q; p = q) { q = p->next; if (p->common) { p->next = common_variables; common_variables = p; } } variables = common_variables; } } /* Return NULL, or pointer to descriptor */ static void *test_type(char *name, int type) { struct variable *pv; pv = find_variable(name); if (pv != NULL) { if (pv->type == NAME_ONLY) { pv->type = type; if (type == SIMPLE_SCALAR) pv->descriptor = get_memory_atomic( sizeof(double)); if (type == SIMPLE_STRING) pv->descriptor = get_memory( sizeof(basic_string)); } if (pv->type != type) error(ERROR_TYPE); return pv->descriptor; } return NULL; } /* Return address of simple scalar */ static double *address_scalar(char *name) { double *ps; ps = test_type(name, SIMPLE_SCALAR); if (ps != NULL) return ps; ps = get_memory_atomic(sizeof(double)); *ps = 0.0; create_variable(name, ps, SIMPLE_SCALAR); return ps; } /* Assign simple scalar variable */ static void set_scalar(char *name, double v) { *address_scalar(name) = v; } /* Retrieve simple scalar variable */ static double get_scalar(char *name) { return *address_scalar(name); } /* Create string variable */ static void create_string(char *name, basic_string v) { basic_string *ps; ps = test_type(name, SIMPLE_STRING); if (ps != NULL) { *ps = v; return; } ps = get_memory(sizeof(basic_string)); *ps = v; create_variable(name, ps, SIMPLE_STRING); } /* Assign simple string variable */ static void set_string(char *name, basic_string v) { char *buf; if (!v.allocated) { buf = get_memory_atomic(v.length + 1); memcpy(buf, v.storage, v.length); v.storage = buf; } create_string(name, v); } /* Address of simple string variable */ static basic_string *address_string(char *name) { basic_string *ps; basic_string s; ps = test_type(name, SIMPLE_STRING); if (ps != NULL) { ps->allocated = NO; return ps; } else { s.length = 0; s.storage = NULL; s.allocated = YES; set_string(name, s); return test_type(name, SIMPLE_STRING); } } /* Retrieve simple string */ static basic_string get_string(char *name) { return *address_string(name); } /* Create an array */ static void create_array(char *name, int t, int dptr, double *dimensions) { struct variable *pv; struct array *a; int i, n; int cmn = NO; pv = find_variable(name); if (pv != NULL) { if (pv->type == NAME_ONLY) cmn = pv->common; if ((pv->type == NAME_ONLY) || (pv->type == SIMPLE_SCALAR) || (pv->type == SIMPLE_STRING)) destroy_variable(pv); else error(ERROR_REDIM); } a = get_memory(sizeof(struct array)); a->ndims = dptr; a->dims = get_memory_atomic(dptr * sizeof(double)); memcpy(a->dims, dimensions, dptr * sizeof(double)); n = 1; for (i = 0; i < dptr; ++i) n *= dimensions[i] + 1; /* add one so we can be zero based */ a->elems = n; a->type = t; if (t == ARRAY) a->values = get_memory_atomic(n * sizeof(double)); else /* t == STRING_ARRAY */ a->values = get_memory(n * sizeof(basic_string)); create_variable(name, a, t); /* ARRAY or STRING_ARRAY */ find_variable(name)->common = cmn; } /* Convert string to numeric. String must have terminal '\0' */ static double cvt_base(char **p, const char *set, int base) { int n; char *s; double value = 0.0; while (**p && (s = strchr(set, **p))) { n = s - set; ++(*p); value = value * base; value = value + n; } return value; } /* Return numeric value of string */ static double val(char **p, int bcerr, int *pbase) { double value, frac; int exp, exp_sign; const char *set; char *savep = *p; *pbase = 10; value = 0.0; if (**p == '&') { ++(*p); if (**p == 'O') { *pbase = 8; set = o_set; } else if (**p == 'H') { *pbase = 16; set = h_set; } else if (**p == 'B') { *pbase = 2; set = b_set; } else if (**p == 'T') { *pbase = 10; set = t_set; } else { if (bcerr) error(ERROR_SYNTAX); else { *p = savep; return 0; } } ++(*p); return cvt_base(p, set, *pbase); } if ((**p == '0') && (((*p)[1] == 'x') || ((*p)[1] == 'X'))) { *pbase = 16; set = h_set; ++(*p); ++(*p); return cvt_base(p, set, *pbase); } set = t_set; if (**p && (strchr(set, **p) || (**p == '.'))) { value = cvt_base(p, set, 10); if (**p == '.') { ++(*p); if (**p && strchr(set, **p)) { /* We should be more accurate - try * a table */ frac = cvt_base(p, set, 10); while (frac >= 1.0) frac /= 10.0; value += frac; } } if ((**p == 'E') || (**p == 'D')) { ++(*p); if ((**p == '-') || (**p == '+') || (('0' <= **p) && (**p <= '9'))) ; else { /* E or D was false alarm */ --(*p); return value; } exp_sign = 1; if (**p == '-') { exp_sign = -1; ++(*p); } else if (**p == '+') { ++(*p); } exp = 0; if (**p && strchr(set, **p)) { exp = cvt_base(p, set, 10); value = value * pow(10.0, exp * exp_sign); } } } return value; } /* Skip over variable */ static unsigned char *skip_variable(unsigned char *p) { p += 2; p += p[-1]; return p; } /* Return variable name */ static char *variable_name(unsigned char *p) { return (char *)p+2; } /* Given pointer to packed line and original line, find original text * (used for REM). */ static char *find_original(char *dst, char *src, char *hit) { char *k = dst; while (*src) { if (dst >= hit) return src; if (*src == '\"') { ++dst; ++src; while (*src && (*src != '\"')) { ++dst; ++src; } if (*src) { ++src; ++dst; } } else if (*src <= ' ') { if ((dst == k) || (dst[-1] == ' ')) ; else ++dst; ++src; } else { ++dst; ++src; } } return src; } /* Pack input line, prior to tokenizing. Copy strings intact ("..."), * remove all spaces outside of strings, and uppercase everything * not in a string. */ static void pack_line(char *dst, char *src) { char *k = dst; while (*src) { if (*src == '\"') { *dst++ = '\"'; ++src; while (*src && (*src != '\"')) *dst++ = *src++; if (*src) { ++src; *dst++ = '\"'; } } else if (*src <= ' ') { if ((dst == k) || (dst[-1] == ' ')) ; else *dst++ = ' '; ++src; } else if (('a' <= *src) && (*src <= 'z')) *dst++ = *src++ - 'a' + 'A'; else *dst++ = *src++; } *dst = '\0'; } /* Find longest token that matches input (return -1 if none) */ static int match_token(char **p) { int m, n, i, l; if (**p == '\0') return -1; l = -1; m = -1; for (i = 0; token_table[i].name; ++i) { n = strlen(token_table[i].name); if (n <= strlen(*p)) { /* If its FN, we allow the match (FNA etc.). * also REM */ if (((token_table[i].tval == FN) || (token_table[i].tval == REM)) && (strncmp(*p, token_table[i].name, n) == 0)) { if (n > m) { m = n; l = i; } } /* We must match the token, and there must a non-alpha * following, except if the token isn't a word. */ if ((strncmp(*p, token_table[i].name, n) == 0) && ( (!is_alpha(**p)) || /* token not alpha */ ((*p)[n-1] == '(') || /* token is func */ (!is_alpha((*p)[n])) /* last char not alpha */ )) { /* also, the last char must not be a valid variable * name character ('.' and '_' cannot be tokens) */ if (!((*p)[n] == '.' || (*p)[n] == '_')) if (n > m) { m = n; l = i; } } } } if (l != -1) { *p += strlen(token_table[l].name); return token_table[l].tval; } return -1; } /* Match variable name in source */ static int match_variable(char **p, char *vn) { if (is_alpha(**p)) { while (is_alphanum(**p) || (**p == '.') || (**p == '_')) { *vn++ = **p; ++(*p); } if ((**p == '$') || (**p == '%') || (**p == '!') || (**p == '#') || (**p == '&')) { *vn++ = **p; ++(*p); } *vn = '\0'; return YES; } return NO; } /* Match constant (string, number). * * A bare '.' comes out as the numeric constant 0. This is probably * not worth fixing. */ static int match_constant(char **p, char *s, int *pbase) { double value; char *oldp = *p; if (**p == '\"') { ++(*p); while (**p && (**p != '\"')) { *s++ = **p; ++(*p); } *s = '\0'; if (**p) ++(*p); return STRING; } value = val(p, 1, pbase); if (*p != oldp) { W((unsigned char *)s, value); return CONSTANT; } return NO; } /* Convert double to long integer */ static long int d_to_li(double x) { long int ix; if (x >= 0x80000000) { ix = x - 0x80000000; ix += 0x80000000; } else ix = x; return ix; } /* List tokenized line -- untokenizes line p to string s */ static void list_line(unsigned char *pt, char *s) { int i; long int n; char c; unsigned int b; unsigned char token, last_token; int base; base = 10; if (*pt == CONSTANT) { /* line number */ ++pt; s += sprintf(s, "%8g", R(pt)); pt += sizeof(double); } else s += sprintf(s, " "); token = 0; while (*pt != EOL) { last_token = token; token = *pt; if (token < TOKEN_MAX) { for (i = 0; token_table[i].name; ++i) if (token == token_table[i].tval) break; n = strlen(token_table[i].name); c = token_table[i].name[n - 1]; if ((c != '(') && is_alpha(token_table[i].name[0]) && (s[-1] != ' ') && (s[-1] != ';') && (s[-1] != ':') && (s[-1] != ',')) s += sprintf(s, " "); /* MID$ is the only function that can start a line */ if ((token == MID) && (last_token == 0)) s += sprintf(s, " "); s += sprintf(s, "%s", token_table[i].name); if (is_alpha(c) && (token != REM) && (token != FN)) s += sprintf(s, " "); ++pt; } else if (token == LITERAL) { s += sprintf(s, "%s", variable_name(pt)); pt = skip_variable(pt); } else if (token == VARIABLE) { if (is_alphanum(s[-1]) && (last_token != FN)) s += sprintf(s, " "); s += sprintf(s, "%s", variable_name(pt)); pt = skip_variable(pt); } else if (token == STRING) { s += sprintf(s, "\"%s\"", variable_name(pt)); pt = skip_variable(pt); } else if (token == BINARY_MODE) { ++pt; base = 2; s += sprintf(s, "&B"); } else if (token == OCTAL_MODE) { ++pt; base = 8; s += sprintf(s, "&O"); } else if (token == HEX_MODE) { ++pt; base = 16; s += sprintf(s, "&H"); } else if (token == CONSTANT) { ++pt; if (base == 10) s += sprintf(s, "%.10G", R(pt)); else { n = d_to_li(R(pt)); if (base == 2) { if (n == 0) s += sprintf(s, "0"); else { b = 0x80000000; while ((b & n) == 0) b >>= 2; while (b != 0) { s += sprintf(s, "%s", (b & n) ? "1" : "0"); b >>= 2; } } } else if (base == 8) s += sprintf(s, "%lo", n); else if (base == 16) s += sprintf(s, "%lX", n); } pt += sizeof(double); base = 10; } } } /* Tokenize source line. The tokenized line is terminated with EOL EOP. * The EOP is added so that if the line is executed, control is returned * to the command loop on line end. */ static void tokenize_line(char *src, unsigned char *pt) { char d[MAX_SRC]; char *p; int n, tkn; char buf[MAX_SRC]; char *remark; int base; pack_line(d, src); p = d; while (*p) { if (*p == ' ') ++p; else if ((tkn = match_token(&p)) != -1) { *pt++ = tkn; if (tkn == REM) { /* remark, followed by LITERAL n comment 0 */ *pt++ = LITERAL; remark = find_original(d, src, p); while (strlen(remark) && (remark[strlen(remark)-1] < ' ')) remark[strlen(remark)-1] = '\0'; n = strlen(remark) + 1; *pt++ = n; strcpy((char *)pt, remark); pt += n; d[0] = '\0'; p = d; } } else if (match_variable(&p, buf)) { /* VARIABLE n name 0 */ *pt++ = VARIABLE; n = strlen(buf) + 1; *pt++ = n; strcpy((char *)pt, buf); pt += n; } else if ((n = match_constant(&p, buf, &base)) != 0) { if (n == STRING) { /* STRING n constant 0 */ *pt++ = STRING; n = strlen(buf) + 1; *pt++ = n; strcpy((char *)pt, buf); pt += n; } else if (n == CONSTANT) { /* CONSTANT double */ if (base == 2) *pt++ = BINARY_MODE; else if (base == 8) *pt++ = OCTAL_MODE; else if (base == 16) *pt++ = HEX_MODE; *pt++ = CONSTANT; W(pt, R((unsigned char *)buf)); pt += sizeof(double); } } else error(ERROR_SYNTAX); } *pt++ = EOL; *pt = EOP; } /* Skip one element */ static unsigned char *skip_one(unsigned char *p) { if (*p < TOKEN_MAX) ++p; else if (*p == CONSTANT) p += sizeof(double) + 1; else if ((*p == EOL) || (*p == HEX_MODE) || (*p == OCTAL_MODE) || (*p == BINARY_MODE)) ++p; else /* LITERAL,VARIABLE,STRING */ p = skip_variable(p); return p; } /* Skip primitive, skip to one of three tokens */ static unsigned char *skip_prim3(unsigned char *p, unsigned char opt, unsigned char opt2, unsigned char opt3) { while ((*p != EOP) && (*p != opt) && (*p != opt2) && (*p != opt3)) p = skip_one(p); return p; } static unsigned char *skip_prim2(unsigned char *p, unsigned char opt, unsigned char opt2) { while ((*p != EOP) && (*p != opt) && (*p != opt2)) p = skip_one(p); return p; } static unsigned char *skip_prim(unsigned char *p, unsigned char opt) { while ((*p != EOP) && (*p != opt)) p = skip_one(p); return p; } /* Skip to new statement */ static unsigned char *skip_statement(unsigned char *p) { return skip_prim2(p, EOL, COLON) + 1; } /* Skip past TO */ static unsigned char *skip_past_to(unsigned char *p) { return skip_prim(p, TO) + 1; } /* Skip past EOL */ static unsigned char *skip(unsigned char *p) { return skip_prim(p, EOL) + 1; } /* Skip past ELSE */ static unsigned char *skip_else(unsigned char *p) { return skip_prim2(p, EOL, ELSE) + 1; } /* Skip to DATA */ static unsigned char *skip_data(unsigned char *p) { return skip_prim(p, DATA); } /* Skip to WHILE/WEND */ static unsigned char *skip_to_while_wend(unsigned char *p) { return skip_prim3(p, EOL, WHILE, WEND); } /* Return start of program */ static unsigned char *sop(void) { return program+1; } /* Find line, or next highest */ static unsigned char *find_line(double n, int early) { unsigned char *p; double t; for (p = sop(); *p != EOP; ) { if (*p == CONSTANT) { ++p; t = R(p); if (t == n) return p - 1; else if (early && (t > n)) return p - 1; p += sizeof(double); } p = skip(p); } return p; /* end of program */ } static void clear_line_hash(void) { int i; for (i = 0; i < MAX_HASH; ++i) line_hash[i] = NULL; } /* Find line, if it doesn't exist, then error */ static unsigned char *find_line_strict(double n) { unsigned char *p; int x; x = fmod(n, MAX_HASH); p = line_hash[x]; if (p != NULL) if (R(p+1) == n) return p; p = find_line(n, NO); if (*p == EOP) error(ERROR_NOLINE); if (R(p+1) != n) error(ERROR_NOLINE); x = fmod(n, MAX_HASH); line_hash[x] = p; return p; } /* Return end of program */ static unsigned char *eop(void) { unsigned char *p = sop(); while (*p != EOP) p = skip(p); ++p; return p; } /* Delete line from program */ static void delete_line(unsigned char *pp) { unsigned char *e = skip(pp); unsigned char *x = eop(); memmove(pp, e, x - e); } /* Insert line into program */ static void insert_line(unsigned char *p, unsigned char *pp) { unsigned char *x = eop(); unsigned char *e = skip(p); int amount; amount = e - p; memmove(pp + amount, pp, x - pp); memmove(pp, p, amount); } /* Clear stacks, leave variables intact */ static void clear_execution_state(void) { curses_update = YES; coutp = NULL; coutn = 0; coutmax = 0; outdev = -99; select_file(CONSOLE); width = 0; lwidth = 0; ppos = &pos; pwidth = &width; cout_n = 0; ontimerflag = NO; ontimer = NULL; onerror = 0; inerror = NO; opstack_ptr = 0; valuestack_ptr = 0; gosubstack_ptr = 0; whilestack_ptr = 0; forstack_ptr = 0; localstack_ptr = 0; breakflag = 0; pos = 0; lpos = 0; tab = 0; graphic = -1; data = sop(); current_loc = NULL; err = 0; flush_variable_cache(); } /* Edit program (delete and/or insert line) */ static void edit_program(unsigned char *p) { double t, o; unsigned char *pp; clear_execution_state(); if (noedit) { insert_line(p, eop()-1); return; } t = R(p + 1); current_line = t; pp = find_line(t, YES); if (*pp == CONSTANT) { o = R(pp + 1); if (t == o) delete_line(pp); } /* line number by itself deletes a line */ if (*(p+sizeof(double)+1) != EOL) insert_line(p, pp); } /* Return true if at end of statement */ static int statement_end(unsigned char *t) { return (*t == EOL) || (*t == COLON); } /* Analyze two line numbers: * * l1 l1- -l2 l1-l2 */ static unsigned char *two_ln(unsigned char *t, double *x1, double *x2) { *x1 = DEFAULT_LN; *x2 = DEFAULT_LN; if (*t == CONSTANT) { *x1 = R(t + 1); if (*x1 == 0) *x1 = current_line; current_line = *x1; t += sizeof(double) + 1; } if (*t == DASH) { if (*x1 == DEFAULT_LN) *x1 = LOW_LN; ++t; if (*t == CONSTANT) { *x2 = R(t + 1); t += sizeof(double) + 1; } else *x2 = HIGH_LN; } else *x2 = DEFAULT_LN; if (!statement_end(t)) error(ERROR_SYNTAX); return t; } /* Beep the speaker */ static void do_beep(void) { if (use_curses) beep(); else cout(7); } /* Simple interactive line editor */ static void internal_edit(unsigned char *p) { char src[MAX_SRC]; char *s, *ep, *t, key; int n, f; raw_keyboard(); list_line(p, src); retype: sout(src); ncrlf(); again: s = src; while (*s == ' ') cout(*s++); while (*s != ' ') cout(*s++); cout(*s++); ep = s; n = 0; FOREVER { key = get_key(); if (n < 0) n = 0; if (key == ' ') { do if (*ep) cout(*ep++); while (--n > 0); } else if ((key == 'a') || (key == 'A')) { ncrlf(); list_line(p, src); goto again; } else if ((key == 'h') || (key == 'H')) { *ep = '\0'; goto insert; } else if (key == 0x1b) { n = 0; } else if (('0' <= key) && (key <= '9')) { n = n * 10 + (key - '0'); } else if ((key == '\r') || (key == 'e') || (key == 'E')) { end_edit: while (*ep) cout(*ep++); ncrlf(); tokenize_line(src, tkn_buf); edit_program(tkn_buf); break; } else if ((key == 3) || (key == 'q') || (key == 'Q')) { ncrlf(); sout("CANCELLED"); ncrlf(); break; } else if (key == 8) { do if (ep != s) { cout('\b'); --ep; } while (--n > 0); } else if (key == 127) { do if (ep != s) { --ep; cout(*ep); } while (--n > 0); } else if ((key == 'i') || (key == 'I')) { insert: FOREVER { key = get_key(); if (key == 0x1b) break; else if (key == '\r') goto end_edit; else if (key >= ' ') { cout(key); t = ep; while (*t) ++t; *(t+1) = '\0'; --t; while (t >= ep) { *(t+1) = *t; --t; } *ep++ = key; } else do_beep(); } } else if ((key == 'd') || (key == 'D')) { if (*ep) { f = YES; cout('\\'); } else f = NO; do if (*ep) { cout(*ep); t = ep; while (*t) { *t = *(t+1); ++t; } } while (--n > 0); if (f) cout('\\'); } else if ((key == 'l') || (key == 'L')) { ncrlf(); goto retype; } else if ((key == 's') || (key == 'S')) { key = get_key(); do { if (*ep) { cout(*ep++); while (*ep && (*ep != key)) cout(*ep++); } --n; } while (n > 0); } else do_beep(); } flush_out(); cook_keyboard(); } /* C string from basic string */ static char *cstring(basic_string s) { s.storage[s.length] = '\0'; return s.storage; } /* Save program (binary form) */ static void save(char *filename) { FILE *f; unsigned char *end; f = fopen(filename, "w"); if (f == NULL) error(ERROR_IO); end = eop(); fwrite(program, 1, end - program, f); fclose(f); } /* Save program in ASCII format */ static int save_ascii(char *filename) { FILE *f; unsigned char *p; int ln, cln = -1; f = fopen(filename, "w"); if (f == NULL) error(ERROR_IO); for (ln = 1, p = sop(); *p != EOP; ++ln, p = skip(p)) { if (*p == CONSTANT) { if (R(p+1) == current_line) cln = ln; } list_line(p, src); fprintf(f, "%s\n", src); } fclose(f); return cln; } /* Merge ascii program */ static void merge(char *filename) { FILE *f; int n; f = fopen(filename, "r"); if (f == NULL) error(ERROR_IO); while (fgets(src, sizeof(src), f) != NULL) { again: n = strlen(src); if (n > 0) { if (src[n - 1] == '\n') { src[n - 1] = '\0'; --n; } } if (n == 0) continue; if (src[n - 1] == '_') { fgets(src + n - 1, sizeof(src) - n, f); goto again; } tokenize_line(src, tkn_buf); if (tkn_buf[0] == CONSTANT) edit_program(tkn_buf); else { noedit = YES; edit_program(tkn_buf); } } fclose(f); } /* Load binary program */ static void load(char *filename) { FILE *f; unsigned char z; program[0] = START; program[1] = EOP; noedit = NO; f = fopen(filename, "r"); if (f == NULL) error(ERROR_IO); fread(&z, 1, 1, f); if (z == START) { fread(sop(), 1, MAX_PROGRAM, f); fclose(f); return; } fclose(f); merge(filename); } /* Return true if op is a unary op */ static int is_unary_op(unsigned char op) { return (op == UNARY_PLUS) || (op == UNARY_MINUS) || (op == UNARY_NOT); } /* Unstack and do unary ops. All unary ops have the same precedence, * which is higher than any binary ops. */ static void do_unary_ops(int lim) { unsigned char op; double x; FOREVER { if (opstack_ptr == lim) return; op = opstack[opstack_ptr - 1]; if (!is_unary_op(op)) return; --opstack_ptr; if (valuestack_ptr == 0) error(ERROR_SYNTAX); x = valuestack[--valuestack_ptr]; if (op == UNARY_PLUS) valuestack[valuestack_ptr++] = x; else if (op == UNARY_MINUS) valuestack[valuestack_ptr++] = -x; else if (op == UNARY_NOT) valuestack[valuestack_ptr++] = ~d_to_li(x); } } /* Return precedence of a binary operator. Note that '(' is queued * as a binary operator, even though its not. '(' must have the * lowest precedence. */ static int precedence(unsigned char op) { switch (op) { case EQUAL: return 1; case PLUS: return 2; case DASH: return 2; case STAR: return 3; case SLASH: return 3; case HAT: return 4; case AND: return 0; case OR: return 0; case XOR: return 0; case IMP: return 0; case EQV: return 0; case MOD: return 3; case NE: return 1; case LE: return 1; case GE: return 1; case LT: return 1; case GT: return 1; case IDIV: return 3; case OPENP: return -1; case SHL: return 0; case SHR: return 0; } error(ERROR_SYNTAX); return -1; } /* Round x to places */ static double round(double x, int places) { double r; r = 0.5; while (places) { r = r / 10; --places; } return x + r; } /* Return integer part of a double */ static double intx(double x) { modf(x, &x); return x; } /* Execute a binary operator */ static void binary_op(int lim) { double x, y; unsigned char op; long int ix, iy; if ((opstack_ptr == lim) || (valuestack_ptr < 2)) error(ERROR_SYNTAX); op = opstack[--opstack_ptr]; y = valuestack[--valuestack_ptr]; x = valuestack[--valuestack_ptr]; ix = d_to_li(x); iy = d_to_li(y); switch (op) { case OPENP: error(ERROR_SYNTAX); case PLUS: x = x + y; break; case DASH: x = x - y; break; case STAR: x = x * y; break; case HAT: x = pow(x, y); break; case AND: x = ix & iy; break; case SHL: x = ix << iy; break; case SHR: x = ix >> iy; break; case OR: x = ix | iy; break; case XOR: x = ix ^ iy; break; case IMP: x = ~ix | (ix & iy); break; case EQV: x = ~(ix ^ iy); break; case EQUAL: x = (x == y) ? -1 : 0; break; case NE: x = (x != y) ? -1 : 0; break; case LE: x = (x <= y) ? -1 : 0; break; case GE: x = (x >= y) ? -1 : 0; break; case LT: x = (x < y) ? -1 : 0; break; case GT: x = (x > y) ? -1 : 0; break; case SLASH: if (y == 0) error(ERROR_MATH); x = x / y; break; case MOD: if (y == 0) error(ERROR_MATH); x = fmod(x, y); break; case IDIV: y = intx(y); if (y == 0) error(ERROR_MATH); x = intx(x / y); break; } valuestack[valuestack_ptr++] = x; } /* Unstack binary operators of higher precedence, and do them */ static void do_binary_ops(unsigned char op, int lim) { unsigned char op2; FOREVER { if (opstack_ptr == lim) return; op2 = opstack[opstack_ptr - 1]; if (precedence(op2) >= precedence(op)) binary_op(lim); else return; } } /* Skip optional token, return true if token was present */ static int token_optional(unsigned char **p, unsigned char token) { if (**p == token) { ++(*p); return YES; } return NO; } /* Token is required */ static void token_needed(unsigned char *p, unsigned char token) { if (*p != token) error(ERROR_SYNTAX); } /* Eat required token */ static void eat_token(unsigned char **p, unsigned char token) { token_needed(*p, token); ++(*p); } /* Close paren required */ static void closep(unsigned char **p) { eat_token(p, CLOSEP); } /* Comma required */ static void comma(unsigned char **p) { eat_token(p, COMMA); } /* Get value of variable */ static int gexpression(unsigned char **p, double *rn, basic_string *rs); static double expression(unsigned char **p); static basic_string sexpression(unsigned char **p); /* Collect dimensions - dptr has number of dimensions (0..63) */ static unsigned char *get_dimensions(unsigned char *p, int *dptr, double *dimensions) { *dptr = 0; if (*p == OPENP) { if (p[1] == CLOSEP) { /* for COMMON A() */ return p+2; } do { ++p; dimensions[*dptr] = expression(&p); if (dimensions[*dptr] < 0) error(ERROR_DIM); ++*dptr; } while (*p == COMMA); closep(&p); } return p; } /* Must have variable */ static struct variable *must_have_variable(unsigned char *p) { struct variable *pv; pv = find_variable((char *)p+2); if (pv == NULL) error(ERROR_NOVAR); return pv; } /* Compute index, returns pointer to element */ typedef basic_string bsarray[1]; static void *array_index(unsigned char *p, int *dptr, double *dimensions) { struct array *pa; struct variable *pv; double index, ld; int i, j; bsarray *pbs; pv = must_have_variable(p); if ((pv->type != ARRAY) && (pv->type != STRING_ARRAY)) error(ERROR_TYPE); pa = pv->descriptor; if (*dptr != pa->ndims) error(ERROR_DIM); index = 0; for (i = 0; i < *dptr; ++i) { if ((dimensions[i] > pa->dims[i]) || (dimensions[i] < 0)) error(ERROR_DIM); ld = 1; for (j = i + 1; j < *dptr; ++j) ld *= pa->dims[j] + 1; index += dimensions[i] * ld; } if (pv->type == ARRAY) return (double *)pa->values + (int)index; else { pbs = (bsarray *)pa->values; return pbs + (int)index; } } /* Return pointer to dimensioned variable element */ static void *dimensioned_variable(unsigned char **t) { void *valuep; double dimensions[MAX_DIMS]; int dptr; unsigned char *p = *t; *t = skip_variable(*t); *t = get_dimensions(*t, &dptr, dimensions); if (dptr != 0) valuep = array_index(p, &dptr, dimensions); else valuep = NULL; return valuep; } /* Get variable value */ static double get_variable(unsigned char **t) { unsigned char *p = *t; double x; char *name; void *valuep; name = variable_name(p); valuep = dimensioned_variable(&p); if (valuep == NULL) x = get_scalar(name); else { x = *(double *)valuep; if (is_integer_variable((unsigned char *)name-2)) x = intx(x); } *t = p; return x; } /* Get value of string variable */ static basic_string get_string_variable(unsigned char **t) { unsigned char *p = *t; basic_string s; char *name; void *valuep; name = variable_name(p); valuep = dimensioned_variable(&p); if (valuep == NULL) s = get_string(name); else s = *(basic_string *)valuep; *t = p; s.allocated = NO; return s; } /* Set a simple variable */ static void set_variable(unsigned char *p, double v) { if (is_integer_variable(p)) v = intx(v); set_scalar((char *)p+2, v); } /* Set a string variable */ static void set_string_variable(unsigned char *p, basic_string s) { set_string((char *)p+2, s); } /* Print basic_string */ static void print_basic_string(basic_string s) { int i; for (i = 0; i < s.length; ++i) cout(s.storage[i]); } /* Leftmost x characters of string */ static void left(basic_string *s, double x) { if (x < s->length) s->length = x; } /* Rightmost x characters of string */ static void right(basic_string *s, double x) { if (x < s->length) { s->storage += s->length - (int)x; s->length = (int)x; } } /* Middle of string */ static void mid(basic_string *s, double p, double l) { if (p >= s->length) s->length = 0; else { s->storage += (int)p - 1; s->length -= (int)p - 1; } if (l >= 0) { if (s->length > l) s->length = l; } } #define NO_TYPE 0 #define STRING_TYPE 1 #define NUMBER_TYPE 2 /* Make a string */ static basic_string make_string(int n) { basic_string s; char *p; s.length = n; p = get_memory_atomic(n + 1); s.storage = p; s.allocated = YES; return s; } /* Single arg math functions */ static double one_arg(unsigned char **p) { double x; ++(*p); x = expression(p); closep(p); return x; } /* Single string arg functions */ static basic_string one_string_arg(unsigned char **p) { basic_string s; ++(*p); s = sexpression(p); closep(p); return s; } /* A basic string term. This can be a string variable, constant, or * a function returning a string. */ static int string_term(unsigned char **p, basic_string *rs) { int tkn; basic_string s, s2; unsigned char *t; double x, x1; time_t now; struct tm *tm; int i, j, k; char c; unsigned long d; int sh, mask, bits, mask1, bits1; char *sp; short int c_s; long int c_i; float c_f; int lead; tkn = **p; switch (tkn) { case VARIABLE: if (!is_string_variable(*p)) return NO_TYPE; s = get_string_variable(p); break; case STRING: /* Build string descriptor that uses program itself * for storage. */ t = *p; ++t; s.length = *t - 1; ++t; s.storage = (char *)t; s.allocated = NO; t += t[-1]; /* XXX */ *p = t; break; case ENVIRONS: ++(*p); i = gexpression(p, &x1, &s); closep(p); if (i == STRING_TYPE) sp = getenv(cstring(s)); else /* numeric 1..n */ { for (j = 0; environ[j]; ++j) { x1 = x1 - 1; if (x1 <= 0) break; } sp = environ[j]; } if (sp == NULL) sp = ""; i = strlen(sp); s = make_string(i); memcpy(s.storage, sp, i); break; case LEFT: ++(*p); s = sexpression(p); comma(p); x = expression(p); closep(p); left(&s, x); break; case RIGHT: ++(*p); s = sexpression(p); comma(p); x = expression(p); closep(p); right(&s, x); break; case MID: ++(*p); s = sexpression(p); comma(p); x = expression(p); if (token_optional(p, COMMA)) x1 = expression(p); else x1 = -1; closep(p); mid(&s, x, x1); break; case CHR: x = one_arg(p); s = make_string(1); s.storage[0] = (char)x; break; case TIME: ++(*p); time(&now); tm = localtime(&now); s = make_string(9); s.length = 8; sprintf(s.storage, "%02d:%02d:%02d", tm->tm_hour, tm->tm_min, tm->tm_sec); break; case DATE: ++(*p); time(&now); tm = localtime(&now); s = make_string(11); s.length = 10; sprintf(s.storage, "%02d-%02d-%04d", tm->tm_mon+1, tm->tm_mday, 1900 + tm->tm_year); break; case SPACE: /* SPACE$( */ c = ' '; x = one_arg(p); fill_c: if (x < 0) x = 0; s = make_string((int)x); for (i = 0; i < (int)x; ++i) s.storage[i] = c; break; case LTRIM: s = one_string_arg(p); while ((s.length > 0) && (s.storage[0] <= ' ')) { --s.length; ++s.storage; } break; case RTRIM: s = one_string_arg(p); while ((s.length > 0) && (s.storage[s.length - 1] <= ' ')) --s.length; break; case LCASE: s2 = one_string_arg(p); s = make_string(s2.length); for (i = 0; i < s2.length; ++i) { c = s2.storage[i]; if (('A' <= c) && (c <= 'Z')) c = c - 'A' + 'a'; s.storage[i] = c; } break; case UCASE: s2 = one_string_arg(p); s = make_string(s2.length); for (i = 0; i < s2.length; ++i) { c = s2.storage[i]; if (('a' <= c) && (c <= 'z')) c = c - 'a' + 'A'; s.storage[i] = c; } break; case STRINGF: ++(*p); x = expression(p); comma(p); i = gexpression(p, &x1, &s); closep(p); if (i == STRING_TYPE) { if (s.length == 0) c = 0; else c = s.storage[0]; } else c = (int)x1; goto fill_c; case HEX: mask = 0xF; bits = 4; mask1 = 0xF; bits1 = 4; cvt_base: x = one_arg(p); d = x; s = make_string(32); sp = s.storage; lead = 0; sh = 32; while (sh) { sh -= bits1; if (lead || ((d >> sh) & mask1)) { *sp++ = h_set[(d >> sh) & mask1]; lead = 1; } bits1 = bits; mask1 = mask; } if (lead == 0) *sp++ = '0'; s.length = sp - s.storage; break; case OCT: mask = 0x7; bits = 3; mask1 = 0x3; bits1 = 2; goto cvt_base; case BIN: mask = 1; bits = 1; mask1 = 1; bits1 = 1; goto cvt_base; case STRF: x = one_arg(p); s = make_string(80); s.length = sprintf(s.storage, "%.10G", x); break; case MKD: x = one_arg(p); s = make_string(sizeof(double)); memcpy(s.storage, &x, sizeof(double)); break; case MKI: x = one_arg(p); c_s = x; s = make_string(sizeof(short int)); memcpy(s.storage, &c_s, sizeof(short int)); break; case MKS: x = one_arg(p); c_f = x; s = make_string(sizeof(float)); memcpy(s.storage, &c_f, sizeof(float)); break; case MKL: x = one_arg(p); c_i = x; s = make_string(sizeof(long int)); memcpy(s.storage, &c_i, sizeof(long int)); break; case INKEY: ++(*p); s = make_string(3); if (use_curses) { nodelay(sc, TRUE); i = getch(); nodelay(sc, FALSE); if (i == ERR) s.length = 0; else { if (i >= 0400) { s.storage[0] = (i >> 8); s.storage[1] = i; s.length = 2; } else { s.storage[0] = i; s.length = 1; } } } else error(ERROR_UNIMP); break; case INPUTS: /* INPUT$(n[,[#]fn) */ ++(*p); x = expression(p); if (token_optional(p, COMMA)) { token_optional(p, HASH); select_file(expression(p)); } s = make_string(x+1); s.length = x; if (outdev < 0) { if (use_curses) { if (s.length == 1) { k = getch(); if (k >= 0400) { s.storage[0] = (k >> 8); s.storage[1] = k; s.length = 2; } else s.storage[0] = k; } else { for (i = 0; i < s.length; ++i) s.storage[i] = getch(); } } else { for (i = 0; i < s.length; ++i) { j = getchar(); if (j == EOF) break; s.storage[i] = j; } s.length = i; } } else { s.length = fread(s.storage, 1, x, pfile(x1)); } select_file(CONSOLE); closep(p); break; default: return NO_TYPE; } *rs = s; return STRING_TYPE; } /* String concatenation. We keep track of parenthesis nesting */ static int string_term2(unsigned char **p, basic_string *rs, int *nparens) { int i; char *ns; basic_string bs; int np = *nparens; while (**p == OPENP) { ++(*p); ++(*nparens); opstack[opstack_ptr++] = OPENP; } i = string_term(p, rs); if (i == NO_TYPE) return NO_TYPE; while ((np != *nparens) && (**p == CLOSEP)) { ++(*p); --(*nparens); if ((opstack_ptr <= 0) || (opstack[--opstack_ptr] != OPENP)) error(ERROR_SYNTAX); if (*nparens < np) error(ERROR_SYNTAX); } while (token_optional(p, PLUS)) { while (**p == OPENP) { ++(*p); ++(*nparens); opstack[opstack_ptr++] = OPENP; } i = string_term(p, &bs); if (i != STRING_TYPE) error(ERROR_TYPE); while ((np != *nparens) && (**p == CLOSEP)) { ++(*p); --(*nparens); if ((opstack_ptr <= 0) || (opstack[--opstack_ptr] != OPENP)) error(ERROR_SYNTAX); if (*nparens < np) error(ERROR_SYNTAX); } i = rs->length + bs.length; ns = get_memory_atomic(i + 1); memcpy(ns, rs->storage, rs->length); memcpy(ns + rs->length, bs.storage, bs.length); bs.length = i; bs.storage = ns; *rs = bs; } return STRING_TYPE; } /* Compare two basic strings */ static int compare_strings(int op, basic_string b1, basic_string b2) { int i, r; r = 0; for (i = 0; i < b1.length; ++i) { if (i > b2.length) break; r = b1.storage[i] - b2.storage[i]; if (r != 0) break; } if ((r == 0) && (i == b1.length) && (i == b2.length)) { /* =, <=, >= */ if ((op == EQUAL) || (op == LE) || (op == GE)) return -1; return 0; } if (op == NE) /* <> */ return -1; if (r <= 0) { /* <=, < */ if ((op == LE) || (op == LT)) return -1; } if (r > 0) { /* >=, > */ if ((op == GE) || (op == GT)) return -1; } return 0; } /* A string expression. This may be a string, contenation of strings, * or a relational operator involving strings. Can return string * or number. */ static int string_expression(unsigned char **p, double *rn, basic_string *rs, int *nparens) { int i, tkn; basic_string s; i = string_term2(p, rs, nparens); if (i == NO_TYPE) return i; tkn = **p; switch (tkn) { case EQUAL: /* = */ case NE: /* <> */ case LE: /* <= */ case GE: /* >= */ case LT: /* < */ case GT: /* > */ ++(*p); i = string_term2(p, &s, nparens); if (i != STRING_TYPE) error(ERROR_TYPE); *rn = compare_strings(tkn, *rs, s); return NUMBER_TYPE; default: return STRING_TYPE; } } /* Evaluate expression * * Expressions begin with: VARIABLE, CONSTANT, +, -, NOT, (, * or a function. */ static int gexpression(unsigned char **p, double *rn, basic_string *rs) { int tkn; int state; double x, x1; int entry_opstack_ptr = opstack_ptr; int entry_valuestack_ptr = valuestack_ptr; int nparens, i, j; time_t now; struct tm *tm; basic_string s, s2; char *sp; float c_f; long int c_i; short int c_s; unsigned char op; int base; nparens = 0; state = 0; /* high speed initial entry for CONSTANT */ if (**p == CONSTANT) goto top2; /* This may be a string expression, so give it a whirl */ i = string_expression(p, &x, rs, &nparens); if (i == NUMBER_TYPE) goto stack_unary; /* string comparision */ else if (i == STRING_TYPE) return STRING_TYPE; /* string expression */ /* else its NO_TYPE, so try it as a numeric expression */ goto top2; top: if (state == 0) { i = string_expression(p, &x, rs, &nparens); if (i == NUMBER_TYPE) goto stack_unary; else if (i == STRING_TYPE) error(ERROR_TYPE); /* Must be numeric result */ /* else NO_TYPE */ } top2: if (state == 0) { tkn = **p; switch (tkn) { case FN: { struct variable *v = variables; double y, *py; basic_string s, *ps; int t; unsigned char *fp; char *name; ++(*p); fp = fns[(*p)[2]]; *p = skip_variable(*p); token_optional(p, OPENP); fp = skip_variable(fp); token_optional(&fp, OPENP); while (**p != CLOSEP) { token_needed(fp, VARIABLE); name = variable_name(fp); fp = skip_variable(fp); t = gexpression(p, &y, &s); if (t == STRING_TYPE) { ps = get_memory( sizeof(basic_string)); *ps = s; create_variable(name, ps, SIMPLE_STRING); } else /* t == NUMBER_TYPE */ { py = get_memory_atomic( sizeof(double)); *py = y; create_variable(name, py, SIMPLE_SCALAR); } if (!token_optional(p, COMMA)) break; eat_token(&fp, COMMA); } token_optional(p, CLOSEP); token_optional(&fp, CLOSEP); eat_token(&fp, EQUAL); flush_variable_cache(); t = gexpression(&fp, &y, &s); x = y; /* restore variables */ variables = v; flush_variable_cache(); goto stack_unary; } case CSNG: case CDBL: x = one_arg(p); goto stack_unary; case FREEFILE: ++(*p); x = freefile(); goto stack_unary; case INSTR: /* INSTR([p,],s$,target$) */ ++(*p); i = gexpression(p, &x, &s); comma(p); if (i == NUMBER_TYPE) j = (int)x; else j = 1; if (i != STRING_TYPE) { s = sexpression(p); comma(p); } s2 = sexpression(p); closep(p); x = 0; for (--j; j < s.length; ++j) { for (i = 0; i < s2.length; ++i) { if ((j + i) >= s.length) goto stack_unary; if (s.storage[j + i] != s2.storage[i]) break; } if (i == s2.length) { x = j + 1; goto stack_unary; } } goto stack_unary; case ABS: x = one_arg(p); if (x < 0) x = -x; goto stack_unary; case ATN: x = one_arg(p); x = atan(x); goto stack_unary; case COS: x = one_arg(p); x = cos(x); goto stack_unary; case EXP: x = one_arg(p); x = exp(x); goto stack_unary; case INTF: x = one_arg(p); if (x < 0) x = x - 0.5; x = intx(x); goto stack_unary; case FIX: x = one_arg(p); x = intx(x); goto stack_unary; case LOG: x = one_arg(p); x = log(x); goto stack_unary; case SGN: x = one_arg(p); if (x < 0) x = -1; if (x > 0) x = 1; goto stack_unary; case SIN: x = one_arg(p); x = sin(x); goto stack_unary; case SQR: x = one_arg(p); x = sqrt(x); goto stack_unary; case TAN: x = one_arg(p); x = tan(x); goto stack_unary; case TAB: x = one_arg(p); tab = x; goto stack_unary; case GRAPHIC: ++(*p); i = gexpression(p, &x, &s); closep(p); if (use_curses) { if (i == NUMBER_TYPE) graphic = acs_map[(int)x]; else { if (s.length > 0) graphic = acs_map[(int)s.storage[0]]; x = graphic; } } goto stack_unary; case SPC: x = one_arg(p); tab = pos + x + 1; goto stack_unary; case ERL: ++(*p); x = erl; goto stack_unary; case ERRF: ++(*p); x = err; if (onerror < 0) err = 0; goto stack_unary; case TIMER: ++(*p); time(&now); tm = localtime(&now); x = ((tm->tm_hour * 60 + tm->tm_min) * 60) + tm->tm_sec; goto stack_unary; case RND: x = one_arg(p); x *= (double)rand() / RAND_MAX; goto stack_unary; case POS: ++(*p); token_optional(p, HASH); x = expression(p); closep(p); if (use_curses) { int sx, sy; getyx(sc, sy, sx); x = sx + 1; } else if (x == 0) x = pos + 1; else x = files[(int)x].pos + 1; goto stack_unary; case LPOS: one_arg(p); x = lpos + 1; goto stack_unary; case CSRLIN: ++(*p); if (use_curses) { int sx, sy; getyx(sc, sy, sx); x = sy + 1; } else error(ERROR_UNIMP); goto stack_unary; case LEN: s = one_string_arg(p); x = s.length; goto stack_unary; case ASC: s = one_string_arg(p); if (s.length == 0) x = 0; else x = s.storage[0] & 0xFF; goto stack_unary; case VAL: s = one_string_arg(p); sp = cstring(s); x = val(&sp, 1, &base); goto stack_unary; case PEEK: x = one_arg(p); x = peek((size_t)x); goto stack_unary; case INP: x = one_arg(p); x = inp((int)x); goto stack_unary; case CINT: x = one_arg(p); if (x > 0) x += 0.5; else if (x < 0) x -= 0.5; x = intx(x); goto stack_unary; case CVD: s = one_string_arg(p); memcpy(&x, s.storage, sizeof(double)); goto stack_unary; case CVI: s = one_string_arg(p); memcpy(&c_s, s.storage, sizeof(short int)); x = c_s; goto stack_unary; case CVS: s = one_string_arg(p); memcpy(&c_f, s.storage, sizeof(float)); x = c_f; goto stack_unary; case CVL: s = one_string_arg(p); memcpy(&c_i, s.storage, sizeof(long int)); x = c_i; goto stack_unary; case EOFF: if (*((*p) + 1) == HASH) ++(*p); x = one_arg(p); if (feof(pfile(x))) { x = -1; goto stack_unary; } i = fgetc(pfile(x)); if (i == EOF) { x = -1; goto stack_unary; } ungetc(i, pfile(x)); x = 0; goto stack_unary; case LOF: { long e, n; if (*((*p) + 1) == HASH) ++(*p); x1 = one_arg(p); n = ftell(pfile(x1)); fseek(pfile(x1), 0, SEEK_END); e = ftell(pfile(x1)); fseek(pfile(x1), n, SEEK_SET); x = e; if (files[(int)x1].mode == MODE_RANDOM) x = x / files[(int)x].reclen; } goto stack_unary; case LOC: if (*((*p) + 1) == HASH) ++(*p); x1 = one_arg(p); x = ftell(pfile(x1)); if (files[(int)x1].mode == MODE_RANDOM) x = x / files[(int)x1].reclen; goto stack_unary; case VARPTR: { /* XXX If only array header is referenced, * return pointer to array header */ void *valuep; char *name; ++(*p); must_have_variable(*p); name = variable_name(*p); if (is_string_variable(*p)) { valuep = dimensioned_variable(p); if (valuep == NULL) valuep = address_string(name); } else { valuep = dimensioned_variable(p); if (valuep == NULL) valuep = address_scalar(name); } closep(p); x = (double)(unsigned long)valuep; goto stack_unary; } case VARIABLE: /* simple scalar, or array */ x = get_variable(p); stack_unary: valuestack[valuestack_ptr++] = x; do_unary_ops(entry_opstack_ptr); state = 1; goto top; case HEX_MODE: case OCTAL_MODE: case BINARY_MODE: ++(*p); /* next must be CONSTANT */ case CONSTANT: ++(*p); x = R(*p); *p += sizeof(double); goto stack_unary; case PLUS: ++(*p); opstack[opstack_ptr++] = UNARY_PLUS; goto top; case DASH: ++(*p); opstack[opstack_ptr++] = UNARY_MINUS; goto top; case NOT: ++(*p); opstack[opstack_ptr++] = UNARY_NOT; goto top; case OPENP: ++nparens; ++(*p); opstack[opstack_ptr++] = OPENP; goto top; default: error(ERROR_SYNTAX); } } else { tkn = **p; switch (tkn) { case CLOSEP: /* ) */ if (nparens == 0) goto ret_x; --nparens; ++(*p); while ((opstack_ptr > entry_opstack_ptr) && (opstack[opstack_ptr-1] != OPENP)) { op = opstack[opstack_ptr - 1]; if (is_unary_op(op)) do_unary_ops(entry_opstack_ptr); else binary_op(entry_opstack_ptr); } if (opstack_ptr == entry_opstack_ptr) error(ERROR_SYNTAX); --opstack_ptr; goto top; case EQUAL: case PLUS: case DASH: case STAR: case SLASH: case HAT: case AND: case OR: case XOR: case IMP: case EQV: case MOD: case NE: case LE: case GE: case LT: case GT: case IDIV: case SHL: case SHR: do_unary_ops(entry_opstack_ptr); do_binary_ops(tkn, entry_opstack_ptr); state = 0; ++(*p); opstack[opstack_ptr++] = tkn; goto top; default: ret_x: while (opstack_ptr > entry_opstack_ptr) { op = opstack[opstack_ptr - 1]; if (is_unary_op(op)) do_unary_ops(entry_opstack_ptr); else binary_op(entry_opstack_ptr); } x = valuestack[--valuestack_ptr]; if ((opstack_ptr != entry_opstack_ptr) || (valuestack_ptr != entry_valuestack_ptr)) error(ERROR_SYNTAX); *rn = x; return NUMBER_TYPE; } } error(ERROR_SYNTAX); return NUMBER_TYPE; } /* Evaluate a numeric expression */ static double expression(unsigned char **p) { double x; basic_string s; if (gexpression(p, &x, &s) != NUMBER_TYPE) error(ERROR_TYPE); return x; } /* Evaluate a string expression */ static basic_string sexpression(unsigned char **p) { double x; basic_string s; if (gexpression(p, &x, &s) != STRING_TYPE) error(ERROR_TYPE); return s; } /* Vars */ static void vars(void) { struct variable *v; char buf[256]; char *s; char *types[] = { "NAME ONLY", "NUMBER", "STRING", "NUMERIC ARRAY", "STRING ARRAY" }; int i; struct array *a; for (v = variables; v; v = v->next) { s = buf; s += sprintf(s, "%s %s", v->name, types[v->type]); if (v->common) s += sprintf(s, " COMMON"); if ((v->type == STRING_ARRAY) || (v->type == ARRAY)) { s += sprintf(s, " ("); a = v->descriptor; for (i = 0; i < a->ndims - 1; ++i) { s += sprintf(s, "%g,", a->dims[i]); } s += sprintf(s, "%g)", a->dims[i]); } else if (v->type == SIMPLE_SCALAR) s += sprintf(s, " = %.10G", *(double *)v->descriptor); /* else its SIMPLE_STRING */ sout(buf); crlf(); } } /* L/Rset string into variable */ static void lr_set_string(unsigned char *v, basic_string s, int to_right) { struct variable *pv; basic_string target; int i, j; pv = must_have_variable(v); if (pv->type != SIMPLE_STRING) error(ERROR_TYPE); target = *(basic_string *)(pv->descriptor); if (to_right == 0) { for (i = 0; i < target.length; ++i) if (i < s.length) target.storage[i] = s.storage[i]; else target.storage[i] = ' '; } else { j = s.length - 1; for (i = target.length - 1; i != -1; --i) if (j != -1) target.storage[i] = s.storage[j--]; else target.storage[i] = ' '; } } /* DIM */ static unsigned char *dim(unsigned char *p) { char *name; int t; int dptr; double dimensions[MAX_DIMS]; do { ++p; token_needed(p, VARIABLE); if (is_string_variable(p)) t = STRING_ARRAY; else t = ARRAY; name = variable_name(p); p = skip_variable(p); token_needed(p, OPENP); p = get_dimensions(p, &dptr, dimensions); create_array(name, t, dptr, dimensions); } while (*p == COMMA); return p; } /* Make a variable COMMON */ static unsigned char *common(unsigned char *p) { struct variable *pv; int dptr; double dimensions[MAX_DIMS]; do { ++p; token_needed(p, VARIABLE); if (find_variable((char *)p+2) == NULL) create_variable((char *)p+2, NULL, NAME_ONLY); pv = must_have_variable(p); p = skip_variable(p); p = get_dimensions(p, &dptr, dimensions); pv->common = YES; } while (*p == COMMA); return p; } /* LOCAL variables */ static unsigned char *local(unsigned char *p) { int dptr; double dimensions[MAX_DIMS]; if (!running) error(ERROR_RUN); if (localstack_ptr >= LOCAL_MAX) error(ERROR_LOCAL); localstack[localstack_ptr++] = p; do { ++p; token_needed(p, VARIABLE); create_variable((char *)p+2, NULL, NAME_ONLY); p = skip_variable(p); p = get_dimensions(p, &dptr, dimensions); } while (*p == COMMA); flush_variable_cache(); return p; } /* End LOCAL variables */ static unsigned char *endlocal(unsigned char *p) { struct variable *pv; int dptr; double dimensions[MAX_DIMS]; unsigned char *t; if (!running) error(ERROR_RUN); if (localstack_ptr == 0) error(ERROR_LOCAL); t = localstack[--localstack_ptr]; do { ++t; token_needed(t, VARIABLE); pv = must_have_variable(t); t = skip_variable(t); t = get_dimensions(t, &dptr, dimensions); destroy_variable(pv); } while (*t == COMMA); return p+1; } /* Erase an array */ static unsigned char *ferase(unsigned char *p) { struct variable *pv; char *name; do { ++p; token_needed(p, VARIABLE); name = variable_name(p); p = skip_variable(p); pv = find_variable(name); if (pv != NULL) destroy_variable(pv); } while (*p == COMMA); return p; } /* Output digits for print_using */ static double digs(double r, int cnt) { while (cnt > 0) { r = r * 10; cout((int)r + '0'); r = r - intx(r); --cnt; } return r; } /* Handle PRINT USING */ static unsigned char *print_using(unsigned char *p) { double x, r; basic_string bs; char *format; char *f; int i, n, hd; int lcnt, rcnt, in_number; int leading_sign, trailing_minus, dollar; int asterisk, comma, exponent; int minus, exp, needed; char buf[20]; double w; bs = sexpression(&p); f = cstring(bs); format = get_memory_atomic(strlen(f) + 1); strcpy(format, f); eat_token(&p, SEMI); f = format; FOREVER { minus = 0; lcnt = 0; rcnt = 0; in_number = 0; leading_sign = 0; trailing_minus = 0; dollar = 0; asterisk = 0; comma = 0; exponent = 0; if (*f == '\0') break; if (*f == '_') { ++f; if (*f) cout(*f); else cout('_'); continue; } if ((*f == '&') || (*f == '\\') || (*f == '!')) { bs = sexpression(&p); token_optional(&p, COMMA); } if (*f == '&') { /* print complete string */ ++f; print_basic_string(bs); continue; } if (*f == '\\') { /* print n char string */ ++f; n = 1; while (*f && (*f != '\\')) { ++f; ++n; } if (*f == '\\') { ++f; ++n; } for (i = 0; i < n; ++i) if (i < bs.length) cout(bs.storage[i]); else cout(' '); continue; } if (*f == '!') { ++f; /* print one char string */ if (bs.length >= 1) cout(bs.storage[0]); continue; } if (*f == '+') { ++f; leading_sign = 1; in_number = 1; } if (*f == '$') { if (f[1] && (f[1] == '$')) dollar = 1; f += 2; ++lcnt; in_number = 1; } else if (*f == '*') { if (f[1] && (f[1] == '*')) asterisk = 1; f += 2; lcnt += 2; in_number = 1; } if ((*f == '#') || (*f == '.')) in_number = 1; if (!in_number) { /* print *f */ cout(*f); ++f; continue; } x = expression(&p); token_optional(&p, COMMA); /* Its a number */ FOREVER { if ((*f == '#') || (*f == ',')) { if (*f == ',') comma = 1; ++f; ++lcnt; } else break; } if (*f == '.') { ++f; while (*f == '#') { ++rcnt; ++f; } } /* Exponent format E+300 -- 5 characters wide */ if ((*f == '^') && f[1] && f[2] && f[3] && f[4] && (f[1] == '^') && (f[2] == '^') && (f[3] == '^') && (f[4] == '^')) { exponent = 1; f += 5; } if (*f == '-') { trailing_minus = 1; ++f; } /* Display number, according to the format */ if (x < 0) { minus = 1; x = -x; } exp = (int)log10(x); if (exp >= 1) ++exp; if (exp == 0) if (x >= 1.0) exp = 1; if (exponent) { r = x / pow(10, exp); if (r >= 1.0) { r = r / 10.0; ++exp; } if (leading_sign || trailing_minus) ; else { if (minus) --lcnt; } if ((lcnt < 0) || ((lcnt + rcnt) == 0)) { cout('%'); lcnt = 1; } if (minus && (trailing_minus == 0)) cout('-'); if ((minus == 0) && leading_sign) cout('+'); r = round(r, lcnt + rcnt); if (lcnt > 0) { exp -= lcnt; r = digs(r, lcnt); } if (rcnt) { cout('.'); digs(r, rcnt); } cout('E'); if (exp < 0) { cout('-'); exp = -exp; } else cout('+'); n = exp; hd = 0; if (exp >= 100) { i = exp / 100; cout(i + '0'); exp -= i * 100; hd = 1; } if (hd || (exp >= 10)) { i = exp / 10; cout(i + '0'); exp -= i * 10; } cout(exp + '0'); if (n < 100) cout(' '); if (n < 10) cout(' '); } else { r = round(x, rcnt); needed = exp; if (comma) needed += (exp/3); if (leading_sign || trailing_minus) ; else { if (minus) ++needed; } if ((needed > lcnt) || (abs(exp) > 10)) { cout('%'); if (minus) cout('-'); sprintf(buf, "%.10G", x); sout(buf); continue; } for (n = lcnt - needed; n > 0; --n) if (asterisk) cout('*'); else cout(' '); if (minus && (trailing_minus == 0)) cout('-'); if ((minus == 0) && leading_sign) cout('+'); if (dollar) cout('$'); /* Now lay down digits, period and commas */ /* Note that we cannot have more than 10 digits * on the left. 9,999,999,999 */ hd = 0; n = 2; for (w = 1000000000; w >= 0.9; w /= 10) { i = r / w; if (i || hd) { if ((n == 1) && comma) cout(','); cout(t_set[i]); hd = 1; } r = r - (w * i); if (--n == 0) n = 3; } if (rcnt) { cout('.'); digs(r, rcnt); } } if (minus && trailing_minus) cout('-'); } free_memory(format); return p; } /* Handle PRINT */ static unsigned char *print(unsigned char *t) { int i; double x; basic_string s; char buf[20]; do { while ((*t == COMMA) || (*t == SEMI)) { /* ',' advances to next print zone - 14 characters */ if (*t == COMMA) { ++t; do cout(' '); while ((*ppos % 14) != 0); } else if (*t == SEMI) ++t; } if (statement_end(t)) break; tab = 0; graphic = -1; i = gexpression(&t, &x, &s); if (graphic >= 0) { cout(graphic); graphic = -1; } else if (tab > 0) { if (use_curses) { int x, y; getyx(sc, y, x); *ppos = x; } --tab; while (*ppos < tab) cout(' '); tab = 0; } else { if (i == STRING_TYPE) print_basic_string(s); else { if (x >= 0) cout(' '); sprintf(buf, "%.10G ", x); sout(buf); } } } while ((*t == COMMA) || (*t == SEMI)); return t; } /* Store number into simple variable, or array */ static void store_number(unsigned char *p, void *valuep, double x) { if (valuep) *(double *)valuep = x; else set_variable(p, x); } /* Store string into simple variable, or array */ static void store_string(unsigned char *p, void *valuep, basic_string s) { void *buf; if (valuep) { if (s.allocated) { *((basic_string *)valuep) = s; } else { buf = get_memory_atomic(s.length + 1); memcpy(buf, s.storage, s.length); ((basic_string *)valuep)->storage = buf; ((basic_string *)valuep)->length = s.length; } } else set_string_variable(p, s); } /* Create default variables */ static void default_variables(void) { double dimensions[1]; int i; struct variable *pv; struct array *pa; bsarray *pbs; basic_string s; /* FBASIC = -1 */ set_scalar("FBASIC", -1); /* Command line arguments: ARGS and ARG$(0..ARGS) */ dimensions[0] = 50; create_array("ARG$", STRING_ARRAY, 1, dimensions); set_scalar("ARGS", (g_ac <= 2) ? 0 : (g_ac - 2)); pv = find_variable("ARG$"); pa = pv->descriptor; pbs = (bsarray *)pa->values; for (i = 1; i < g_ac; ++i) { s.length = strlen(g_av[i]); s.storage = g_av[i]; store_string(NULL, pbs + (i - 1), s); } /* CURSES specific variables */ set_scalar("CURSES.COLS", 0); set_scalar("CURSES.LINES", 0); set_scalar("CURSES.WINCH", 0); /* Make default variables COMMON */ find_variable("FBASIC")->common = YES; find_variable("ARGS")->common = YES; find_variable("ARG$")->common = YES; find_variable("CURSES.COLS")->common = YES; find_variable("CURSES.LINES")->common = YES; find_variable("CURSES.WINCH")->common = YES; } /* CLEAR */ static void fclear(void) { int i; while (variables) destroy_variable(variables); for (i = 0; i < 256; ++i) vtype[i] = 0; default_variables(); } /* String variable required */ static void need_string_variable(unsigned char *t) { token_needed(t, VARIABLE); if (!is_string_variable(t)) error(ERROR_TYPE); } /* Handle LINE INPUT */ static unsigned char *line_input(unsigned char *t) { int suppress_nl = NO; char buf[256]; unsigned char *p; void *valuep; int i; basic_string s; if (outdev < 0) { if (token_optional(&t, SEMI)) { /* suppress newline on Enter */ suppress_nl = YES; } if (*t == STRING) { sout(variable_name(t)); t = skip_variable(t); if (*t == SEMI) ; /* sout("? "); */ else if (*t == COMMA) ; else error(ERROR_SYNTAX); ++t; } else { sout("? "); } } need_string_variable(t); /* XXX We can simplify this -- address_scalar and * address_string will furnish the address of the simple * variable. This means that the entire thing can be wrapped up. */ p = t; valuep = dimensioned_variable(&t); get_line(buf, sizeof(buf)); i = strlen(buf); while ((i >= 0) && ((buf[i] == '\0') || (buf[i] == '\r') || (buf[i] == '\n'))) --i; ++i; s = make_string(i); memcpy(s.storage, buf, i); s.length = i; store_string(p, valuep, s); return t; } /* Handle INPUT */ static unsigned char *input(unsigned char *t) { char *prompt = NULL; int add_ques = NO; int suppress_nl = NO; char buf[256]; char *sp, *sp2; unsigned char *p, *p2; void *valuep; int i, n; basic_string s; double x; int base; if (outdev < 0) { if (token_optional(&t, SEMI)) { /* suppress newline on Enter */ suppress_nl = YES; } if (*t == STRING) { prompt = variable_name(t); t = skip_variable(t); if (*t == SEMI) add_ques = YES; else if (*t == COMMA) add_ques = NO; else error(ERROR_SYNTAX); ++t; } else { prompt = ""; add_ques = YES; } } --t; p2 = t; redo: t = p2; if (outdev < 0) { sout(prompt); if (add_ques) sout("? "); } get_line(buf, sizeof(buf)); sp = buf; do { ++t; token_needed(t, VARIABLE); p = t; valuep = dimensioned_variable(&t); if (*sp == '\0') { redomsg: if (outdev < 0) error(ERROR_IO); sout("REDO FROM START"); crlf(); goto redo; } while (*sp && (*sp <= ' ')) ++sp; if (is_string_variable(p)) { /* Get string */ i = (*sp == '\"'); if (i) ++sp; n = 0; while (*sp) { if (i && (*sp == '\"')) { ++sp; break; } if (!i && (*sp == ',')) { ++sp; break; } buf[n++] = *sp++; } if (!i) while (n && (buf[n-1] <= ' ')) --n; s = make_string(n); memcpy(s.storage, buf, n); s.length = n; store_string(p, valuep, s); } else { /* Get number */ sp2 = sp; x = val(&sp, 0, &base); if (sp == sp2) goto redomsg; store_number(p, valuep, x); } while (*sp && (*sp <= ' ')) ++sp; if (*sp == ',') ++sp; } while (*t == COMMA); return t; } /* WRITE */ static unsigned char *handle_write(unsigned char *t) { int i; double x; basic_string s; char buf[20]; ++t; if (token_optional(&t, HASH)) select_file(expression(&t)); do { while ((*t == COMMA) || (*t == SEMI)) ++t; if (statement_end(t)) break; i = gexpression(&t, &x, &s); if (i == STRING_TYPE) { cout('\"'); print_basic_string(s); cout('\"'); } else { sprintf(buf, "%.10G", x); sout(buf); } if ((*t == COMMA) || (*t == SEMI)) cout(','); } while ((*t == COMMA) || (*t == SEMI)); if (t[-1] != SEMI) crlf(); return t; } /* READ */ static unsigned char *handle_read(unsigned char *t) { unsigned char *p; void *valuep; do { ++t; token_needed(t, VARIABLE); p = t; valuep = dimensioned_variable(&t); if (token_optional(&data, COMMA)) ; else { data = skip_data(data); if (*data == EOP) error(ERROR_DATA); ++data; } if (is_string_variable(p)) store_string(p, valuep, sexpression(&data)); else store_number(p, valuep, expression(&data)); } while (*t == COMMA); return t; } /* Handle DEF type */ static unsigned char *handle_deftype(char type, unsigned char *t) { char cl, ch; do { ++t; ch = 0; token_needed(t, VARIABLE); cl = *variable_name(t); t = skip_variable(t); if (token_optional(&t, DASH)) { token_needed(t, VARIABLE); ch = *variable_name(t); t = skip_variable(t); } vtype[(unsigned char)cl] = type; while (cl <= ch) vtype[(unsigned char)cl++] = type; } while (*t == COMMA); return t; } /* Exit curses */ static void exit_curses() { if (use_curses) { nl(); erase(); move(0, 0); refresh(); endwin(); use_curses = NO; ansi_cls(); } } /* Signal handler for winch */ static void signal_winch(int sig) { if (use_curses) { sigwf(sig); winchanged = YES; signal(SIGWINCH, signal_winch); } } /* Enter curses */ static void enter_curses(void) { int n, f, b; if (use_curses) return; sc = initscr(); start_color(); /* Start color mode */ idlok(sc, TRUE); /* Allow insert/delete lines */ scrollok(sc, TRUE); /* Ok to scroll */ nonl(); /* Disable cr->nl translations */ curs_set(1); /* Enable curses */ typeahead(-1); /* No typeahead checking */ noecho(); /* Don't echo characters */ cbreak(); /* character mode */ nodelay(sc, FALSE); /* Delay for characters */ keypad(sc, TRUE); /* Enable keypad */ meta(sc, TRUE); /* Meta characters (8 bit) */ use_curses = YES; erase(); move(0, 0); for (b = 0; b < 8; ++b) for (f = 0; f < 8; ++f) { n = (b << 3) + f; init_pair(n, f, b); } refresh(); *ppos = 0; sigwf = (sigwf_t)signal(SIGWINCH, signal_winch); set_scalar("CURSES.COLS", COLS); set_scalar("CURSES.LINES", LINES); set_scalar("CURSES.WINCH", -1); } /* Delete a range of lines */ static unsigned char *delete_range(unsigned char *t) { unsigned char *p; double x1, x2, x; t = two_ln(t, &x1, &x2); if (x1 == DEFAULT_LN) error(ERROR_SYNTAX); if (x2 == DEFAULT_LN) x2 = x1; for (p = sop(); *p != EOP; ) { if (*p == CONSTANT) x = R(p + 1); else x = 0; if ((x1 <= x) && (x <= x2)) delete_line(find_line(x, YES)); else p = skip(p); } return t; } /* Renumber program */ static void do_renum(double start, double inc) { unsigned char *p; int nfixups, fixup_limit; unsigned char **fixups; int i; double old; fixup_limit = 0; fixups = NULL; nfixups = 0; for (p = sop(); *p != EOP; p = skip_one(p)) { if ((*p == GOTO) || (*p == GOSUB) || (*p == THEN) || (*p == ELSE) || (*p == RESUME) || (*p == RESTORE)) { while (p[1] == CONSTANT) { if (nfixups >= fixup_limit) { fixup_limit += 1024; fixups = increase_memory( fixups, fixup_limit * sizeof(unsigned char *)); } fixups[nfixups++] = p+2; p += 2 + sizeof(double); if (*p != COMMA) break; } } } for (p = sop(); *p != EOP; p = skip(p)) { if (*p == CONSTANT) { old = R(p+1); W(p+1, start); for (i = 0; i < nfixups; ++i) if (fixups[i] && (R(fixups[i]) == old)) { W(fixups[i], start); fixups[i] = NULL; } } start += inc; } free_memory(fixups); } /* Generate line numbers for program entry */ static void do_auto(double start, double inc) { unsigned char *p; int have_line; if (noedit) error(ERROR_NOEDIT); FOREVER { have_line = NO; p = find_line(start, YES); if (*p == CONSTANT) if (R(p+1) == start) have_line = YES; sprintf(src, "%8g%c", start, have_line ? '*' : ' '); sout(src); flush_out(); sprintf(src, "%8g ", start); get_line(src+9, sizeof(src)-9); /* get_line() returns trailing newline */ if (strlen(src) > 10) { tokenize_line(src, tkn_buf); edit_program(tkn_buf); } start += inc; } } /* CONT */ static unsigned char *handle_cont(void) { unsigned char *t; t = current_loc; if (t == NULL) return NULL; if (*t == STOP) ++t; else if (*t == CONSTANT) { /* line_number STOP */ if (t[1+sizeof(double)] == STOP) t += 2+sizeof(double); } running = YES; return t; } /* LIST, LLIST */ static unsigned char *handle_list(unsigned char *t) { unsigned char *p; double x, x1, x2; ++t; t = two_ln(t, &x1, &x2); if (x1 == DEFAULT_LN) { x1 = LOW_LN; x2 = HIGH_LN; } if (x2 == DEFAULT_LN) x2 = x1; for (p = sop(); *p != EOP; ) { if (*p == CONSTANT) x = R(p + 1); else x = x1; if ((x1 <= x) && (x <= x2)) { list_line(p, src); sout(src); crlf(); } p = skip(p); } return t; } /* DELETE */ static void handle_delete(unsigned char *t) { if (noedit) error(ERROR_NOEDIT); ++t; t = delete_range(t); clear_execution_state(); } /* External EDIT */ static void external_edit(void) { int k = use_curses; char buf[256], *sp, *s; char fn[256]; char ln[15]; int n; exit_curses(); strcpy(fn, tmpnam(NULL)); strcat(fn, ".bas"); n = save_ascii(fn); if (n <= 0) n = 1; sp = getenv("FBASIC_EDIT"); if (sp == NULL) sp = EXT_EDIT; sprintf(ln, "%d", n); s = buf; while (*sp) { if (*sp == '%') { ++sp; if (*sp == 'f') s += sprintf(s, "%s", fn); else if (*sp == 'n') s += sprintf(s, "%s", ln); else *s++ = *sp; ++sp; } else *s++ = *sp++; } *s = '\0'; system(buf); load(fn); unlink(fn); if (k) enter_curses(); clear_execution_state(); } /* EDIT */ static void handle_edit(unsigned char *t) { double x1, x2; unsigned char *p; ++t; t = two_ln(t, &x1, &x2); if (x1 == DEFAULT_LN) { external_edit(); return; } p = find_line_strict(x1); if (noedit) error(ERROR_NOEDIT); if (getenv("FBASIC_NOINTERNALEDIT")) external_edit(); else internal_edit(p); clear_execution_state(); } /* NEW */ static void handle_new(unsigned char *t) { program[0] = START; program[1] = EOP; noedit = NO; clear_execution_state(); } /* FREE */ static unsigned char *handle_free(unsigned char *t) { double x; ++t; x = eop() - program; garbage_collect(); sprintf(src, "Program size %.10G, Free %.10G, Heap size %d", x, MAX_PROGRAM - x, heap_size()); sout(src); crlf(); return t; } /* SAVE */ static void handle_save(unsigned char *t) { basic_string s; /* SAVE "filename" [,A] */ ++t; s = sexpression(&t); clear_execution_state(); if (token_optional(&t, COMMA)) save_ascii(cstring(s)); else save(cstring(s)); } /* LOAD */ static void handle_load(unsigned char *t) { basic_string s; ++t; s = sexpression(&t); clear_execution_state(); load(cstring(s)); } /* MERGE */ static void handle_merge(unsigned char *t) { basic_string s; ++t; s = sexpression(&t); clear_execution_state(); merge(cstring(s)); } /* SYSTEM */ static unsigned char *handle_system(unsigned char *t) { basic_string s; ++t; if (!statement_end(t)) { s = sexpression(&t); external_execute(cstring(s), NULL); } else { exit_curses(); exit(0); } return t; } /* RUN */ static unsigned char *handle_run(unsigned char *t) { double x1, x2; ++t; t = two_ln(t, &x1, &x2); if (x1 == DEFAULT_LN) t = sop(); else t = find_line_strict(x1); clear_execution_state(); running = YES; return t; } /* CURSESATTR */ static unsigned char *handle_cursesattr(unsigned char *t) { basic_string bs; char *s, *p; int f, m; ++t; bs = sexpression(&t); s = cstring(bs); while (*s && (*s <= ' ')) ++s; if (*s == '+') { ++s; f = 1; } else if (*s == '-') { ++s; f = 2; } else f = 3; p = strtok(s, ":;, \t"); m = 0; while (p != NULL) { if (strcasecmp(p, "NORMAL") == 0) m |= A_NORMAL; else if (strcasecmp(p, "STANDOUT") == 0) m |= A_STANDOUT; else if (strcasecmp(p, "UNDERLINE") == 0) m |= A_UNDERLINE; else if (strcasecmp(p, "REVERSE") == 0) m |= A_REVERSE; else if (strcasecmp(p, "BLINK") == 0) m |= A_BLINK; else if (strcasecmp(p, "BOLD") == 0) m |= A_BOLD; else if (strcasecmp(p, "DIM") == 0) m |= A_DIM; else if (strcasecmp(p, "ALTCHARSET") == 0) m |= A_ALTCHARSET; else if (strcasecmp(p, "INVIS") == 0) m |= A_INVIS; else if (strcasecmp(p, "PROTECT") == 0) m |= A_PROTECT; else if (strcasecmp(p, "HORIZONTAL") == 0) m |= A_HORIZONTAL; else if (strcasecmp(p, "LEFT") == 0) m |= A_LEFT; else if (strcasecmp(p, "LOW") == 0) m |= A_LOW; else if (strcasecmp(p, "RIGHT") == 0) m |= A_RIGHT; else if (strcasecmp(p, "TOP") == 0) m |= A_TOP; else if (strcasecmp(p, "VERTICAL") == 0) m |= A_VERTICAL; else if (strcasecmp(p, "RAW") == 0) { f = 4; raw(); } else if (strcasecmp(p, "NORAW") == 0) { f = 4; noraw(); } p = strtok(NULL, ":;, \t"); } if (f == 1) attron(m); else if (f == 2) attroff(m); else if (f == 3) attrset(m); return t; } /* CURSES */ static unsigned char *handle_curses(unsigned char *t) { int f; ++t; if (*t == ON) { ++t; f = 1; } else if (*t == OFF) { ++t; f = 0; } else f = expression(&t); if (f == 2) /* Magic: turn off updating */ curses_update = NO; else if (f == 3) { /* Magic: turn on updating */ curses_update = YES; refresh_screen(); } else if (!use_curses && f) enter_curses(); else if (use_curses && !f) exit_curses(); return t; } /* LOCATE */ static unsigned char *handle_locate(unsigned char *t) { int row = 0, col = 0, crs = 0; int have_row = NO; int have_col = NO; int have_crs = NO; int y, x; /* LOCATE row,col,cursor,start,stop */ if (use_curses) { ++t; if ((*t != COMMA) && !statement_end(t)) { row = expression(&t) - 1; have_row = YES; } token_optional(&t, COMMA); if ((*t != COMMA) && !statement_end(t)) { col = expression(&t) - 1; have_col = YES; } token_optional(&t, COMMA); if ((*t != COMMA) && !statement_end(t)) { crs = expression(&t); have_crs = YES; } token_optional(&t, COMMA); getyx(sc, y, x); if (!have_row) row = y; if (!have_col) col = x; move(row, col); if (have_crs) curs_set(crs); ++cout_n; } t = skip_statement(t) - 1; return t; } /* SLEEP */ static unsigned char *handle_sleep(unsigned char *t) { struct timeval timeout; long n; ++t; #if 0 /* Simple version that sleeps for seconds */ sleep((int)expression(&t)); #endif n = (long)expression(&t); n = n / 100; /* increments of 100ms */ if (n <= 0) n = 1; for (; n; --n) { check_break(); timeout.tv_sec = 0; timeout.tv_usec = 100000; select(0, NULL, NULL, NULL, &timeout); } return t; } /* Execute. We are entered with a pointer to a token buffer, which * we execute until EOP or an editing command. If one of the commands * is GOSUB, GOTO, RUN which transfer control to a numbered line, * we will begin executing from program space. */ static void execute(unsigned char *t) { int tkn; double x, x1, x2; unsigned char *p, *p2; int i, in_if; basic_string s, s2; void *valuep, *valuep2; char *sp; int *pi; clear_line_hash(); in_if = 0; winchanged = YES; FOREVER { if (use_curses && winchanged) { winchanged = NO; refresh(); set_scalar("CURSES.COLS", COLS); set_scalar("CURSES.LINES", LINES); set_scalar("CURSES.WINCH", -1); } CHECK_BREAK; tkn = *t; if (!inerror && running) current_loc = t; if (ontimerflag) { time_t last_time; unsigned char *g; last_time = current_time; time(¤t_time); secondsleft -= (current_time - last_time); if (secondsleft <= 0) { secondsleft = ontimevalue; if (gosubstack_ptr >= GOSUB_MAX) error(ERROR_GOSUB); gosubstack[gosubstack_ptr++] = t; g = ontimer; x = expression(&g); t = find_line_strict(x); continue; } } if (token_optional(&t, CONSTANT)) { current_line = R(t); t += sizeof(double); tkn = *t; if (ftrace) { sprintf(src, "[%.10G]", current_line); sout(src); flush_out(); } } switch (tkn) { /* Simple handlers */ case EOL: case EOP: case COLON: case ELSE: break; case CONT: if ((t = handle_cont()) == NULL) return; continue; case LLIST: select_file(PRINTER); /* drop through to LIST */ case LIST: t = handle_list(t); break; case DELETE: handle_delete(t); return; case EDIT: handle_edit(t); return; case NEW: handle_new(t); return; case FREE: t = handle_free(t); break; case SAVE: handle_save(t); return; case LOAD: handle_load(t); return; case MERGE: handle_merge(t); return; case TROFF: ++t; ftrace = 0; break; case TRON: ++t; ftrace = 1; break; case SYSTEM: t = handle_system(t); break; case DATA: t = skip_statement(t) - 1; break; case REM: t = skip(t) - 1; break; case STOP: erl = current_line; /* Fall through to END */ case END: return; case RUN: t = handle_run(t); in_if = 0; continue; case READ: t = handle_read(t); break; case WRITE: t = handle_write(t); break; case RANDOMIZE: ++t; srand((int)expression(&t)); break; case ERROR: ++t; error((int)expression(&t)); break; case DIM: t = dim(t); break; case COMMON: t = common(t); break; case LOCAL: t = local(t); break; case ENDLOCAL: t = endlocal(t); break; case BEEP: ++t; do_beep(); break; case SLEEP: t = handle_sleep(t); break; case VARS: t = skip_statement(t) - 1; vars(); break; case CLEAR: t = skip_statement(t) - 1; fclear(); break; case NULLF: ++t; nulls = expression(&t); break; case CLS: ++t; if (use_curses) { erase(); move(0, 0); } else ansi_cls(); break; case ERASE: t = ferase(t); break; case CURSESF: t = handle_curses(t); break; case LOCATE: t = handle_locate(t); break; case DEFINT: case DEFLNG: t = handle_deftype('%', t); break; case DEFSNG: case DEFDBL: t = handle_deftype('!', t); break; case DEFSTR: t = handle_deftype('$', t); break; case CURSESATTR: t = handle_cursesattr(t); break; /* More complicated handlers */ case LET: ++t; if (*t == MID) goto assign_mid; /* Fall through to VARIABLE */ case VARIABLE: /* VARIABLE = expression */ p = t; valuep = dimensioned_variable(&t); eat_token(&t, EQUAL); if (is_string_variable(p)) { s = sexpression(&t); store_string(p, valuep, s); } else { x = expression(&t); store_number(p, valuep, x); } break; case GOSUB: if (gosubstack_ptr >= GOSUB_MAX) error(ERROR_GOSUB); gosubstack[gosubstack_ptr++] = skip_statement(t); /* Drop through to GOTO */ case GOTO: ++t; bgoto: x = expression(&t); t = find_line_strict(x); in_if = 0; running = YES; continue; case RETURN: if (gosubstack_ptr == 0) error(ERROR_GOSUB); t = gosubstack[--gosubstack_ptr]; in_if = 0; running = YES; continue; case IF: ++t; x = expression(&t); eat_token(&t, THEN); if (x) { if (*t == CONSTANT) goto bgoto; in_if = 1; continue; } t = skip_else(t); if (*t == CONSTANT) goto bgoto; continue; case WHILE: for (i = 0; i < whilestack_ptr; ++i) if (whilestack[i] == t) { whilestack_ptr = i; break; } if (whilestack_ptr == WHILE_MAX) error(ERROR_WHILE); whilestack[whilestack_ptr++] = t; ++t; if (expression(&t) == 0) { /* Skip to WEND, skipping other * WHILE/WEND's we see */ --whilestack_ptr; for (i = 1; i != 0; ) { t = skip_to_while_wend(t); if (*t == EOL) in_if = 0; else if (*t == WHILE) ++i; else if (*t == WEND) --i; else if (*t == EOP) error(ERROR_WHILE); ++t; } } continue; case WEND: if (whilestack_ptr == 0) error(ERROR_WHILE); t = whilestack[--whilestack_ptr]; continue; case LPRINT: select_file(PRINTER); /* drop through to PRINT */ case PRINT: ++t; p = NULL; valuep = NULL; if (token_optional(&t, HASH)) { if (is_string_variable(t)) { outdev = -99; p = t; valuep = dimensioned_variable(&t); coutmax = 1024; coutp = get_memory_atomic(coutmax); coutn = 0; ppos = &coutn; } else select_file(expression(&t)); token_optional(&t, COMMA); } if (token_optional(&t, USING)) { t = print_using(t); /* Skip any unused expressions */ t = skip_statement(t) - 1; } else t = print(t); if (p) { s = make_string(0); s.storage = coutp; s.length = coutn; store_string(p, valuep, s); coutp = NULL; } else { if (t[-1] != SEMI) crlf(); } break; case FOR: /* FOR I = 1 TO 10 [STEP 1]...NEXT [I] */ for (i = 0; i < forstack_ptr; ++i) if (forstack[i] == t) { forstack_ptr = i; break; } if (forstack_ptr == FOR_MAX) error(ERROR_FOR); forstack[forstack_ptr++] = t; p = ++t; token_needed(t, VARIABLE); t = skip_variable(t); eat_token(&t, EQUAL); set_variable(p, expression(&t)); eat_token(&t, TO); /* ensure that TO present */ t = skip_statement(t) - 1; break; case NEXT: if (forstack_ptr == 0) error(ERROR_FOR); ++t; p = forstack[--forstack_ptr]; if (*t == VARIABLE) { while (forstack_ptr && (strcmp((char *)t+2, (char *)p+3) != 0)) p = forstack[--forstack_ptr]; if (strcmp((char *)t+2, (char *)p+3) != 0) error(ERROR_FOR); t = skip_variable(t); } forstack[forstack_ptr++] = p; p2 = ++p; x = get_variable(&p); p = skip_past_to(p); x1 = expression(&p); if (token_optional(&p, STEP)) x2 = expression(&p); else x2 = 1.0; x = x + x2; set_variable(p2, x); if ((x2 > 0) ? (x <= x1) : (x >= x1)) t = p; else --forstack_ptr; break; case RESTORE: ++t; if (!statement_end(t)) data = find_line_strict(expression(&t)); else data = sop(); break; case POKE: i = 0; poke_out: ++t; x1 = expression(&t); comma(&t); x2 = expression(&t); if (i == 0) poke((size_t)x1, (unsigned char)x2); else out((int)x1, (unsigned char)x2); break; case OUT: i = 1; goto poke_out; case LSET: i = 0; set_lr: ++t; need_string_variable(t); p = t; t = skip_variable(t); eat_token(&t, EQUAL); s = sexpression(&t); lr_set_string(p, s, i); break; case RSET: i = 1; goto set_lr; case SWAP: ++t; p = t; token_needed(t, VARIABLE); i = is_string_variable(t); valuep = dimensioned_variable(&t); if (valuep == NULL) { if (i) valuep = address_string( (char *)p+2); else valuep = address_scalar( (char *)p+2); } comma(&t); token_needed(t, VARIABLE); if (is_string_variable(p)) if (!is_string_variable(t)) error(ERROR_TYPE); if (!is_string_variable(p)) if (is_string_variable(t)) error(ERROR_TYPE); p = t; valuep2 = dimensioned_variable(&t); if (valuep2 == NULL) { if (i) valuep2 = address_string( (char *)p+2); else valuep2 = address_scalar( (char *)p+2); } if (i) { s = *(basic_string *)valuep; *(basic_string *)valuep = *(basic_string *)valuep2; *(basic_string *)valuep2 = s; } else { x = *(double *)valuep; *(double *)valuep = *(double *)valuep2; *(double *)valuep2 = x; } break; case OPEN: /* OPEN "IORAB", #n, fn, rlen */ ++t; { int mode; basic_string filename; int filenumber, reclen; s = sexpression(&t); if (s.length == 0) error(ERROR_SYNTAX); mode = s.storage[0]; if (('a' <= mode) && (mode <= 'z')) mode = mode - 'a' + 'A'; switch (mode) { case 'I': mode = MODE_INPUT; break; case 'O': mode = MODE_OUTPUT; break; case 'R': mode = MODE_RANDOM; break; case 'A': mode = MODE_APPEND; break; case 'B': mode = MODE_BINARY; break; default: error(ERROR_SYNTAX); } comma(&t); token_optional(&t, HASH); filenumber = expression(&t); comma(&t); filename = sexpression(&t); reclen = 128; if (token_optional(&t, COMMA)) reclen = expression(&t); open_file(mode, filenumber, cstring(filename), reclen); } break; case CLOSE: ++t; if (statement_end(t)) { for (i = 0; i < MAX_FD; ++i) close_file(i); } else { --t; do { ++t; token_optional(&t, HASH); x = expression(&t); close_file((int)x); } while (*t == COMMA); } break; case INPUT: ++t; if ((*t == HASH) || (*t == CONSTANT)) { token_optional(&t, HASH); select_file(expression(&t)); comma(&t); } t = input(t); break; case LINE: /* LINE INPUT */ ++t; eat_token(&t, INPUT); if ((*t == HASH) || (*t == CONSTANT)) { token_optional(&t, HASH); select_file(expression(&t)); comma(&t); } t = line_input(t); break; case FIELD: { int fn, n; char *buf; basic_string s; ++t; if (token_optional(&t, ON)) { buf = (char *)(size_t)expression(&t); } else { token_optional(&t, HASH); fn = expression(&t); buf = files[fn].buffer; } comma(&t); FOREVER { if (statement_end(t)) break; n = expression(&t); eat_token(&t, AS); need_string_variable(t); t += 2; s.length = n; s.storage = buf; s.allocated = NO; create_string((char *)t, s); buf += n; t += t[-1]; /* XXX */ token_optional(&t, COMMA); } } break; case SEEK: { int fn; long rec; ++t; token_optional(&t, HASH); fn = expression(&t); comma(&t); rec = expression(&t); fseek(pfile(fn), rec, SEEK_SET); } break; case GET: { int fn; int rec; ++t; token_optional(&t, HASH); fn = expression(&t); comma(&t); rec = expression(&t); if (files[fn].mode == MODE_RANDOM) { fseek(pfile(fn), files[fn].reclen * rec, SEEK_SET); fread(files[fn].buffer, files[fn].reclen, 1, pfile(fn)); } else error(ERROR_IO); } break; case PUT: { int fn; int rec; ++t; token_optional(&t, HASH); fn = expression(&t); comma(&t); rec = expression(&t); if (files[fn].mode == MODE_RANDOM) { fseek(pfile(fn), files[fn].reclen * rec, SEEK_SET); fwrite(files[fn].buffer, files[fn].reclen, 1, pfile(fn)); } else error(ERROR_IO); } break; case DEF: ++t; if (*t == FN) /* FN */ { /* Function definition, record the * start token location */ if (!running) error(ERROR_RUN); ++t; token_needed(t, VARIABLE); fns[t[2]] = t; t = skip_statement(t) - 1; } else if (*t == SEG) { ++t; token_needed(t, EQUAL); seg = expression(&t); } else error(ERROR_SYNTAX); break; case FILES: /* FILES -- pass string to ls command */ ++t; if (!statement_end(t)) { s = sexpression(&t); sp = cstring(s); } else sp = ""; external_execute("ls", sp); break; case KILL: ++t; s = sexpression(&t); sp = cstring(s); if (unlink(sp) == -1) error(ERROR_IO); break; case RESUME: ++t; if (!inerror) error(ERROR_SYNTAX); running = YES; inerror = NO; if (token_optional(&t, NEXT)) t = skip_statement(current_loc); else if (statement_end(t)) t = current_loc; else { x = onerror; onerror = 0; t = find_line_strict(expression(&t)); onerror = x; } continue; case ON: { double idx; int mode; ++t; if (*t == TIMER) /* ON TIMER(x) GOSUB */ { ++t; idx = expression(&t); secondsleft = ontimevalue = (int)idx; eat_token(&t, GOSUB); ontimer = t; t = skip_statement(t) - 1; time(¤t_time); if (ontimevalue <= 0) { ontimer = NULL; ontimerflag = NO; } else ontimerflag = YES; break; /* case */ } else if (*t == 32) /* ON ERROR */ { ++t; if (token_optional(&t, RESUME)) { eat_token(&t, NEXT); /* ON ERROR RESUME NEXT */ onerror = -1; } else { eat_token(&t, GOTO); /* ON ERROR GOTO */ onerror = expression(&t); if (onerror != 0) find_line_strict( onerror); } break; /* case */ } idx = intx(expression(&t)); if (*t == GOSUB) /* ON e GOSUB */ { ++t; mode = 1; } else if (*t == GOTO) /* ON e GOTO */ { ++t; mode = 2; } else error(ERROR_SYNTAX); for (; idx > 1; --idx) { expression(&t); token_optional(&t, COMMA); if (statement_end(t)) break; } if (idx == 1) { if (mode == 1) { if (gosubstack_ptr >= GOSUB_MAX) error(ERROR_GOSUB); gosubstack[gosubstack_ptr++] = skip_statement(t); } goto bgoto; } t = skip_statement(t) - 1; } break; case TIMER: /* TIMER ON, OFF, STOP */ ++t; if (*t == ON) { if (ontimer) ontimerflag = YES; } else if (*t == OFF) { ontimerflag = NO; } else if (*t == STOP) { ontimerflag = NO; ontimer = NULL; } else error(ERROR_SYNTAX); ++t; break; case COLOR: ++t; if (use_curses) { int n, f, b; f = expression(&t); comma(&t); b = expression(&t); n = ((b & 7) << 3) + (f & 7); /* color_set(n, NULL) is not supported * under Solaris */ attrset(COLOR_PAIR(n)); bkgdset(' ' | COLOR_PAIR(n)); } else t = skip_statement(t) - 1; break; case CHAIN: /* CHAIN [MERGE] filename * [,[line exp][,ALL][,DELETE range]] */ { int mergeflag = NO; int allflag = NO; basic_string filename; ++t; x = -1; only_common_variables(); if (*t == MERGE) { if (noedit) error(ERROR_NOEDIT); ++t; mergeflag = YES; } filename = sexpression(&t); while (token_optional(&t, COMMA)) { if (*t == ALL) { ++t; allflag = YES; } else if (*t == DELETE) { if (noedit) error(ERROR_NOEDIT); ++t; t = delete_range(t); } else if (*t == COMMA) ; else x = expression(&t); } if (!allflag) only_common_variables(); if (mergeflag) merge(cstring(filename)); else load(cstring(filename)); if (x <= 0) t = sop(); else t = find_line_strict(x); clear_execution_state(); in_if = 0; running = YES; continue; } case WAIT: /* WAIT port,and[,xor]*/ ++t; x = expression(&t); comma(&t); x1 = expression(&t); if (token_optional(&t, COMMA)) x2 = expression(&t); else x2 = 0; waitport(x, x1, x2); break; case ENVIRON: ++t; s = sexpression(&t); sp = get_memory_atomic(strlen(cstring(s))+1); strcpy(sp, cstring(s)); fprintf(stderr, "\n%s\n", sp); putenv(sp); break; case CHDIR: ++t; s = sexpression(&t); sp = cstring(s); if (chdir(sp) == -1) error(ERROR_IO); break; case MKDIR: ++t; s = sexpression(&t); sp = cstring(s); if (mkdir(sp, 0777) == -1) error(ERROR_IO); break; case RMDIR: ++t; s = sexpression(&t); sp = cstring(s); if (rmdir(sp) == -1) error(ERROR_IO); break; case NAME: ++t; s = sexpression(&t); eat_token(&t, AS); s2 = sexpression(&t); if (rename(cstring(s), cstring(s2)) == -1) error(ERROR_IO); break; case WIDTH: ++t; pi = &width; if (token_optional(&t, LPRINT)) pi = &lwidth; else if (token_optional(&t, HASH)) { pi = &(files[(int)expression(&t)].width); comma(&t); } *pi = expression(&t); break; case RENUM: x = 0; goto ren_aut; case AUTO: x = 1; ren_aut: ++t; x1 = 10; x2 = 10; if (!statement_end(t)) { if (*t != COMMA) x1 = expression(&t); if (token_optional(&t, COMMA)) { if (!statement_end(t)) x2 = expression(&t); } } if (x == 1) do_auto(x1, x2); else do_renum(x1, x2); break; case MID: assign_mid: ++t; /* MID$(V$,P,L)=SEXP$ */ need_string_variable(t); s2 = get_string_variable(&t); eat_token(&t, COMMA); x1 = expression(&t); if (token_optional(&t, COMMA)) x2 = expression(&t); else x2 = 999999; closep(&t); eat_token(&t, EQUAL); s = sexpression(&t); for (i = (int)x1; i < (int)(x1 + x2); ++i) { if (i > s2.length) break; if ((i - (int)x1) >= s.length) break; s2.storage[i-1] = s.storage[i-(int)x1]; } break; case INTERPRET: /* We don't use tkn_buf, because that will be * in use if someone trys INTERPRET from * keyboard directly */ { unsigned char *tb = get_memory_atomic(MAX_TKN); ++t; s = sexpression(&t); tokenize_line(cstring(s), tb); execute(tb); free_memory(tb); } break; default: error(ERROR_SYNTAX); } SELECT_CONSOLE; FLUSH_OUT; /* Since we have just executed a statement, the token * must be end of line, end of program, or ':' */ if (*t == EOP) return; else if (*t == EOL) in_if = 0; else if (*t == ELSE) { if (in_if) { t = skip(t); continue; } else error(ERROR_SYNTAX); } if ((*t != EOL) && (*t != COLON)) error(ERROR_SYNTAX); ++t; } } /* Entry for FBASIC interpreter. * * Allocates a program space, and then enters a read edit/interpret * loop. */ int main(int ac, char **av) { int prompt; int n; g_ac = ac; g_av = av; noedit = NO; nulls = 0; program = get_memory_atomic(MAX_PROGRAM); line_hash = get_memory_atomic(MAX_HASH * (sizeof(unsigned char *))); program[0] = START; program[1] = EOP; variables = NULL; use_curses = NO; jbreakflag = NO; select_file(CONSOLE); signal(SIGINT, signal_break); clear_execution_state(); fclear(); n = strlen(av[0]); frun = NO; current_line = 0; if (n >= 3) { /* if invoked as "frun", or any name ending in "run", * enter frun mode */ if (strcmp(av[0]+n-3, "run") == 0) frun = YES; } if (!frun) { sout("FBASIC " VERSION); crlf(); sout("Copyright (c) 2000, 2001, Fridtjof Weigel"); crlf(); sout("All Rights Reserved"); crlf(); crlf(); } /* main command loop, get a line, tokenize it. If it has a * line number, edit the program, else execute it. */ if (setjmp(jerror) != 0) { if ((!inerror) && (onerror != 0) && (running)) { /* XXX use the same mechanism to spring TIMER? */ if (onerror < 0) /* -1 == RESUME NEXT */ { inerror = NO; execute(skip_statement(current_loc) - 1); } else { inerror = YES; tkn_buf[0] = GOTO; tkn_buf[1] = CONSTANT; W(tkn_buf+2, onerror); tkn_buf[2+sizeof(double)] = EOL; tkn_buf[3+sizeof(double)] = EOP; execute(tkn_buf); } } else { select_file(CONSOLE); crlf(); sprintf(src, "Error: %s (%.10G)", error_message(), err); sout(src); if (running) { running = NO; sprintf(src, " in line %.10G", erl); sout(src); } crlf(); } if (frun) { exit_curses(); exit(1); } else goto cont; } if (frun) { if (ac == 1) { sout("Missing filename"); crlf(); } else { running = NO; load(av[1]); tkn_buf[0] = RUN; tkn_buf[1] = EOL; tkn_buf[2] = EOP; execute(tkn_buf); } exit_curses(); return 0; } if (ac > 1) load(av[1]); cont: prompt = YES; FOREVER { running = NO; curses_update = YES; if (prompt) { sout("Ok"); crlf(); } get_line(src, sizeof(src)); tokenize_line(src, tkn_buf); if (tkn_buf[0] == CONSTANT) { if (noedit) error(ERROR_NOEDIT); edit_program(tkn_buf); prompt = NO; } else { if ((tkn_buf[0] == EOL) || ((tkn_buf[0] == EDIT) && (tkn_buf[1] != EOL))) prompt = NO; else prompt = YES; execute(tkn_buf); } } exit_curses(); return 0; }