-h- BAS.H Tue Jun 22 10:57:37 1982 _DRA0:BAS.H;1 # /* * * * The information in this document is subject to change * without notice and should not be construed as a commitment * by Digital Equipment Corporation or by DECUS. * * Neither Digital Equipment Corporation, DECUS, nor the authors * assume any responsibility for the use or reliability of this * document or the described software. * * Copyright (C) 1980, DECUS * * * General permission to copy or modify, but not for profit, is * hereby granted, provided that the above copyright notice is * included and reference made to the fact that reproduction * privileges were granted by DECUS. * */ /* * bas.h */ #define NCB 128 /* Length of command buffer */ #define NFILE 32 /* Length of file name */ #define NGOSUB 10 /* Max. nested routines */ #define MAXLNO 9999 /* Highest line number */ #define MINLNO 1 /* Lowest line number */ /* * Text. * Threaded list begins at * cell `text'. */ struct text { struct text *t_fp; /* Link */ int t_lno; /* Line number */ char t_text[]; /* Text */ }; /* * Variables. */ extern int col; extern int eflag; extern int qflag; extern int cflag; extern int tflag; extern char cb[]; extern char fb[]; extern struct text *lp; extern struct text *text; extern char *cp; extern FILE *slfp; -h- BAS1.C Tue Jun 22 10:57:37 1982 _DRA0:BAS1.C;1 /* * bas1.c */ #include #include "bas.h" #define AUTO 0 #define LIST 1 #define LOAD 2 #define NAME 3 #define NEW 4 #define PACK 5 #define RESEQ 6 #define RUN 7 #define SAVE 8 #define PRINT 9 #define LET 10 static char *ctab[] = { "auto", "list", "load", "name", "new", "pack", "reseq", "run", "save", "print", "let", NULL }; static auton = 100; static autoi = 10; char cb[NCB]; char fb[NFILE]; struct text *lp; struct text *text; char *cp; FILE *slfp; main(argc, argv) char *argv[]; { register struct text *tp; register c; int h, l; if (argc > 1) { qflag = 1; load(argv[1]); run(); exit(0); } do { eflag = 0; lp = NULL; setexit(); } while (eflag); while (getline()) { if ((c=get()) == 0) continue; if (isdigit(c)) { insert(getln(c)); continue; } --cp; switch(match(ctab)) { case AUTO: if (isdigit(c=get())) { auton = getln(c); if ((c=get()) == ',') { autoi = getn(-1); c = get(); } } if (c != 0) what(); for (;;) { chlno(auton); tp = text; while (tp!=NULL && tp->t_lnot_fp; if (tp!=NULL && tp->t_lno==auton) err("Auto hit"); printf("%04d ", auton); if (getline()==0 || get()==0) break; --cp; insert(auton); auton += autoi; } break; case LIST: l = MINLNO-1; h = MAXLNO+1; if (isdigit(c=get())) { l = h = getln(c); if ((c=get()) == ',') { h = getln(-1); c = get(); } } if (c!=0 || l>h) what(); tp = text; while (tp!=NULL && tp->t_lnot_fp; while (tp!=NULL && tp->t_lno<=h) { if (cflag) { cflag = 0; break; } outext(tp, stdout); tp = tp->t_fp; } break; case LOAD: filename(); load(fb); break; case NAME: if (fb[0] != 0) printf("%s\n", fb); break; case NEW: new(); break; case RUN: run(); break; case SAVE: filename(); if ((slfp=fopen(fb, "w")) == NULL) err("Cannot create file"); tp = text; while (tp != NULL) { outext(tp, slfp); tp = tp->t_fp; } fclose(slfp); break; case PRINT: print(); break; case LET: let(); break; default: what(); } } } insert(n) { register struct text *p1, *p2, *p3; p1 = NULL; p2 = text; while (p2!=NULL && p2->t_lnot_fp; } if (p2->t_lno == n) { p3 = p2; p2 = p2->t_fp; free(p3); if (p1 == NULL) text = p2; else p1->t_fp = p2; } if (get() != 0) { --cp; p3 = alloc(sizeof(*p3) + strlen(cp) + 1); if (p3 == -1) err("No core"); if (p1 == NULL) text = p3; else p1->t_fp = p3; p3->t_fp = p2; p3->t_lno = n; concat(p3->t_text, cp, NULL); } } what() { err("What"); } new() { register struct text *fp, *tp; tp = text; while (tp != NULL) { fp = tp->t_fp; free(tp); tp = fp; } text = NULL; /* clrsym(); */ } load(f) char *f; { register c, n; new(); if ((slfp=fopen(f, "r")) == NULL) err("Not found"); while (fgets(cb, slfp) != NULL) { cp = cb; if (!isdigit(c=get())) err("Not numbered"); insert(getln(c)); } fclose(slfp); } filename() { register char *p; register c; if ((c=get()) == 0) { if (fb[0] == 0) err("No file"); return; } p = fb; do { if (p < &fb[NFILE-1]) *p++ = c; } while (c = *cp++); *p = 0; } outext(tp, fp) register struct text *tp; FILE *fp; { fprintf(fp, "%04d %s\n", tp->t_lno, tp->t_text); } getline() { register char *p; register c; p = cb; while ((c=getchar())!=EOF && c!='\n') if (p < &cb[NCB-1]) *p++ = c; if (c == EOF) return (0); *p = 0; cp = cb; return (1); } -h- BAS2.C Tue Jun 22 10:57:37 1982 _DRA0:BAS2.C;1 /* * bas2.c */ #include #include "bas.h" #define STOP 0 #define END 1 #define GOTO 2 #define GOSUB 3 #define RETURN 4 #define PRINT 5 #define TRACE 6 #define REM 7 #define LET 8 #define OFF 0 #define ON 1 static char *stab[] = { "stop", "end", "goto", "gosub", "return", "print", "trace", "rem", "let", NULL }; static char *otab[] = { "off", "on", NULL }; struct gosub { struct text *g_lp; char *g_cp; }; struct gosub *gsp; struct gosub gosub[NGOSUB]; int cflag; int tflag; run() { register struct text *tp; register c, t; int n; gsp = gosub; cflag = 0; tflag = 0; tp = text; while (tp != NULL) { again: if (tflag) { putn(tp->t_lno); puts(": trace.\n"); } lp = tp; cp = tp->t_text; do { if (cflag) { cflag = 0; err("Control C"); } switch (t = match(stab)) { case STOP: case END: end(); if (t == STOP) err("Stop"); lp = NULL; return; case GOTO: case GOSUB: n = getln(-1); end(); tp = text; while (tp!=NULL && tp->t_lnot_fp; if (tp==NULL || tp->t_lno!=n) err("Line not found"); if (t == GOSUB) { if (gsp >= &gosub[NGOSUB]) err("Too many gosubs"); gsp->g_lp = lp; gsp->g_cp = cp; ++gsp; } goto again; case RETURN: end(); if (gsp <= &gosub[0]) err("Too many returns"); --gsp; lp = gsp->g_lp; cp = gsp->g_cp; break; case PRINT: print(); break; case TRACE: tflag = offon(); break; case REM: goto skip; case LET: default: let(); } } while ((c=get()) == ':'); if (c != 0) err("Bad ending"); skip: tp = lp->t_fp; } lp = NULL; } print() { register c, f; c = get(); f = 0; while (c!=0 && c!=':') { if (c == '"') { while ((c=*cp++) && c!='"') put(c); if (c == 0) err("Bad string"); } else err("No expr yet"); f = 0; if ((c=get())==',' || c==';') { if (c == ',') { if (col >= 72) put('\n'); else do { put(' '); } while ((col&017) != 0); } c = get(); f = 1; } } if (f == 0) put('\n'); --cp; } let() { err("No let yet"); } offon() { register t; if ((t=match(otab)) > ON) err("Bad off or on"); return (t); } end() { register c; if ((c=get())!=0 && c!=':') err("Bad ending"); --cp; } -h- BAS3.C Tue Jun 22 10:57:37 1982 _DRA0:BAS3.C;1 /* * bas3.c */ #include #include "bas.h" #define AND 0 #define OR 1 #define XOR 2 #define LSHIFT 3 #define RSHIFT 4 #define MOD 5 #define ADD 6 #define SUB 7 #define MUL 8 #define DIV 9 #define POWER 10 #define EQ 11 #define NE 12 #define LT 13 #define LE 14 #define GE 15 #define GT 16 static char *otab[] = { "&", "|", "#", "<<". ">>", "%", "+", "-", "*", "/", "^", "<=", "<>", "<", ">=", ">", "=", NULL }; #define LEN 0 #define UCASE 1 #define LCASE 2 static char *ftab[] = { "len(", "ucase$", "lcase$", NULL }; expr(ep) struct expr *ep; { register n; if ((n=expr1(ep, 0)) != OK) err(ecode[n-1]); } expr1(ep, p) register struct expr *ep; { register n, op; struct expr e; if ((n=expr2(ep)) == OK) { while ((op=getop(p)) >= 0) { if ((n=expr1(&e, prio[op])) != OK) { scrap(ep); break; } if ((n=evaluate(op, ep, &e)) != OK) { scrap(ep); scrap(&e); break; } } } return (n); } expr2(ep) register struct expr *ep; { c = get(); if (c == '(') { n = expr1(ep, 0); if (n != OK) return (n); if (get() != ')') { scrap(ep); return (MRPAR); } return (OK); } if (c == '+' || c == '-') { n = expr1(ep, HUGE); if (n == OK && c == '-') { if (ep->e_type > FLT) { scrap(ep); n = BSOP; } else if (ep->e_type == FLT) ep->e_flt = -ep->e_flt; else ep->e_int = -ep->e_int; } return (n); } if (c == '"') { ep->e_type = REF; ep->e_refp = cp; while ((c=*cp++) && c!='"') ; if (c == 0) return (BADSTR); ep->e_refl = cp - ep->e_refp - 1; return (OK); } if (c == '.' || isdigit(c)) return (number(c)); --cp; if ((c=match(ftab)) < ???) { expr3(ep, c); /* ... */ } /* Get variable */ } evaluate(op, lp, rp) { lt = lp->e_type; rt = rp->e_type; if (lt > FLT || rt > FLT) return(BSOP); if (op == POWER || lt != rt) { makefloat(lp); makefloat(rp); } if (lp->e_type == FLT) return (fevaluate(op, lp, rp)); lv = lp->e_int; rv = rp->e_int; switch (op) { case ADD: lv += rv; break; case SUB: lv -= rv; break; case MUL: lv *= rv; break; case DIV: if (rv == 0) return(DIV0); lv /= rv; break; case AND: lv &= rv; break; case OR: lv |= rv; break; /* Relationals */ } lp->e_int = lv; return (OK); } getop(p) { register char *sp; register t; sp = cp; if ((t=match(otab))<=MOD && prio[t]>p) return (t); cp = sp; return (-1); } scrap(ep) register struct expr *ep; { if (ep->e_type == STR) free(ep->e_strp); } getv(ep) register struct expr *ep; { if (!isalpha(c = get())) return (NOVAR); id[0] = c; id[1] = 0; if (isdigit(c = *cp++)) { id[1] = c; c = *cp++; } t = FLT; if (c == '%') { t = INT; c = *cp++; } else if (c == '$') { t = STR; c = *cp++; } n = 0; if (c == '(') { do { if (n >= NDIMS) return (TMDIMS); if (s = expr1(ep, 0) { /* ... */ } if (ep->e_type > FLT) /* .... */ makeint(ep); d[n++] = ep->e_int; } while ((c = get()) == ','); if (c != ')') ...... } else --cp; sp = search(id, t, n, d); ep->e_type = sp->s_type; o = 0; for (i=0; i sp->s_dims[i]) /* out of range */ if (i != 0) o *= sp->s_dims[i-1]; o += d[i]; } switch (sp->s_type) { case INT: ep->e_type = INT; ep->e_intp = &sp->s_dims[n] + o*sizeof(*ep->e_intp); break; case FLT: ep->e_type = FLT; ep->e_fltp = &sp->s_dims[n] + o*sizeof(*ep->e_fltp); break; case STR: ep->e_type = STR; ep->e_strp = &sp->s_dims[n] + o*sizeif(*ep->e_strp); break; } return (OK); } -h- BAS4.C Tue Jun 22 10:57:37 1982 _DRA0:BAS4.C;1 /* * bas4.c */ #include #include "bas.h" int col; int eflag; int qflag; match(mtp) char **mtp; { register char *p1, *p2; int c1, c2, n; n = 0; while(p1 = *mtp++) { p2 = cp; while (c1 = *p1++) { while ((c2 = *p2++)==' ' || c2=='\t') ; if (c1 != c2) break; } if (c1 == 0) { cp = p2; break; } ++n; } return (n); } chlno(n) register n; { if (n < MINLNO || n > MAXLNO) err("Illegal line number"); } getln(c) { register n; n = getn(c); chlno(n); return (n); } getn(c) register c; { register n; if (c < 0) c = get(); n = 0; while (isdigit(c)) { n = 10*n + c - '0'; c = *cp++; } --cp; return (n); } err(s) char *s; { if (slfp != NULL) fclose(slfp); if (col != 0) put('\n'); if (lp != NULL) printf("%d: ", lp->t_lno); printf("%s!\n", s); if (qflag) exit(1); ++eflag; reset(); } get() { register c; while ((c = *cp++)==' ' || c=='\t') ; return (c); } put(c) register c; { putchar(c); if (c == '\b') { if (col != 0) --col; } else if (c == '\n') col = 0; else ++col; } puts(s) register char *s; { register c; while (c = *s++) put(c); } putn(n) register n; { register q; if (n < 0) { put('-'); n = -n; } if (q = n/10) putn(q); put(n%10 + '0'); }