A BASIC interpretor (Part 3 of 4)
sources-request at genrad.UUCP
sources-request at genrad.UUCP
Wed Jul 31 20:18:37 AEST 1985
Mod.sources: Volume 2, Issue 25
Submitted by: ukma!david (David Herron)
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# bs2/action.c
# bs2/bsdefs.h
# bs2/bsgram.y
# bs2/bsgram.y.orig
# bs2/bsint.c
# bs2/bslib.c
# bs2/errors.c
# bs2/operat.c
# This archive created: Tue Jul 30 13:03:04 1985
export PATH; PATH=/bin:$PATH
if test ! -d 'bs2'
then
echo shar: creating directory "'bs2'"
mkdir 'bs2'
fi
echo shar: extracting "'bs2/action.c'" '(14073 characters)'
if test -f 'bs2/action.c'
then
echo shar: will not over-write existing file "'bs2/action.c'"
else
sed 's/^X//' << \SHAR_EOF > 'bs2/action.c'
/* action.c -- "action" routines for interpretor. These are the base-level
* routines, pointed to by the code-list.
*/
#include "bsdefs.h"
int status = 0;
/* M_COMPILE:
* x print x --to-- x,_print,x
* M_EXECUTE:
* stack: string,x --to-- x
* output: "string\n"
*/
_print(l,p)
int (*l[])(),p;
{
union value s1;
switch(status&XMODE) {
case M_EXECUTE:
s1 = pop();
printf("%s",s1.sval);
if(s1.sval != 0) free(s1.sval);
case M_FIXUP:
case M_COMPILE: return(p);
default:
STerror("print");
}
}
/* M_COMPILE:
* x rlabel name goto x --to-- x,rlabel,lval,_goto,0,x
* (the 0 is for the benefit of interp())
* M_FIXUP: nothing.
* any other mode:
* stack: lval,x --to-- x
* other: Thisline = lval.lval.codelist;
* Thisp = lval.lval.place;
*/
_goto(l,p) int (*l[])(),p;
{
union value lval;
switch(status&XMODE) {
case M_COMPILE: l[p] = 0;
case M_FIXUP: return(++p);
default:
lval = pop();
if(lval.lval.codelist == 0) ULerror(l,p);
Thisline = lval.lval.codelist;
Thisline--;
Thisp = lval.lval.place;
if(dbg) printf("_goto:EXEC:to:llent:%o:pl:%d:num:%u\n",lval.lval.codelist,
lval.lval.place,lval.lval.codelist->num);
return(p);
}
}
/* M_COMPILE:
* x dlabel name x --to-- x,_dlabel,&vlist entry,x
* M_FIXUP:
* Make vlist entry for "name" point to current place.
*/
_dlabel(l,p) int (*l[])(),p;
{
struct dictnode *vp;
char *s;
switch(status&XMODE) {
case M_COMPILE:
s=gtok();
vp=gvadr(s,T_LBL);
l[p++] = vp;
return(p);
case M_FIXUP:
vp=l[p++];
vp->val.lval.codelist = (int **)gllentry(l);
vp->val.lval.place = p;
return(p);
default: return(++p);
}
}
/* M_COMPILE:
* x rlabel name x --to-- x,rlabel,&vlist entry,x
* any other mode:
* push(vp->val) (i.e. pointer to location of label)
*/
_rlabel(l,p) int (*l[])(),p;
{
struct dictnode *vp;
char *s;
switch(status&XMODE) {
case M_COMPILE:
s=gtok();
vp=gvadr(s,T_LBL);
l[p++] = vp;
return(p);
case M_FIXUP: return(++p);
default:
vp = l[p++];
if(dbg) printf("_rlabel:M_EXECUTE:name:%s:llent:%o:place:%d\n",vp->name,
vp->val.lval.codelist,vp->val.lval.place);
push(vp->val);
return(p);
}
}
/* M_COMPILE:
* x rlabel name goto x --to-- x,_rlabel,lval,_gosub,0,x
*
* M_EXECUTE:
* stack: lval,x --to-- x
* other: saves current place (on stack) and jumps to lval.
*/
_gosub(l,p) int(*l[])(),p;
{
union value here,there;
switch(status&XMODE) {
case M_COMPILE:
case M_FIXUP:
l[p++] = 0;
return(p);
case M_EXECUTE:
there = pop();
here.lval.codelist = gllentry(l);
here.lval.place = p+1;
if(dbg) printf("_gosub:EXEC:here.l:%o:here.pl:%d:there.l:%o:there.pl:%d\n",
here.lval.codelist,here.lval.place,there.lval.codelist,there.lval.place);
push(here);
Thisline = there.lval.codelist;
Thisline--;
Thisp = there.lval.place;
return(p);
default: STerror("gosub");
}
}
_return(l,p) int(*l[])(),p;
{
union value loc;
switch(status&XMODE) {
case M_COMPILE:
case M_FIXUP:
l[p++] = 0;
return(p);
case M_EXECUTE:
loc = pop();
Thisp = loc.lval.place;
Thisline = loc.lval.codelist;
Thisline--;
return(p);
default:
STerror("return");
}
}
/* Routines control entering and leaving of loops.
*
* enter -- makes a mark that we have entered a loop, and also records
* branch points for "continue" and "leave".
* exitlp -- undoes the mark made by enter.
* contin -- branches to "continue" point.
* leave -- branches to "leave" point.
*
* The following stack structure is used to record these loop markers.
*/
struct loopstack {
struct label contlb,leavlb;
};
struct loopstack lpstk[20];
int lpstkp = -1; /* -1 when stack is empty.
* always points to CURRENT loop marker.
*/
/* M_COMPILE:
* x rlabel contlb rlabel leavlb enter x
*--to--
* x,_rlabel,contlb,_rlabel,_leavlb,_enter,x
*
* M_EXECUTE:
* loopstack: x --to-- <contlb,leavlb>,x
*/
_enter(l,p) int (*l[])(),p;
{
union value loc;
if((status&XMODE) == M_EXECUTE) {
lpstkp++;
loc = pop();
if(dbg) printf("_enter:EXEC:lpsp:%d:leav.list:%o:leav.pl:%d",lpstkp,
loc.lval.codelist,loc.lval.place);
lpstk[lpstkp].leavlb.codelist = loc.lval.codelist;
lpstk[lpstkp].leavlb.place = loc.lval.place;
loc = pop();
if(dbg) printf(":cont.list:%o:cont.pl:%d\n",loc.lval.codelist,loc.lval.place);
lpstk[lpstkp].contlb.codelist = loc.lval.codelist;
lpstk[lpstkp].contlb.place = loc.lval.place;
}
return(p);
}
/* M_EXECUTE:
* loopstack: <contlb,leavlb>,x --to-- x
* other: ensures that lpstkp doesnt get less that -1;
*/
_exitlp(l,p) int (*l[])(),p;
{
if((status&XMODE) == M_EXECUTE)
if(lpstkp >= 0)
lpstkp--;
else
lpstkp = -1;
if(dbg) printf("_exitlp:M_%d:lpstkp:%d\n",status,lpstkp);
return(p);
}
/* M_COMPILE:
* x leave x --to-- x,_leave,0,x
* (the 0 is for the benefit of interp())
*
* M_EXECUTE:
* loopstack: <contlb,leavlb>,x --to-- <contlb,leavlb>,x
* other: branches to leavlb. exitlp takes care of cleaning up stack.
*/
_leave(l,p) int(*l[])(),p;
{
switch(status&XMODE) {
case M_COMPILE:
case M_FIXUP: l[p++] = 0; return(p);
case M_EXECUTE:
if(lpstkp == -1) /* not inside a loop, ergo cannot leave a loop */
LVerror(l,p);
Thisline = lpstk[lpstkp].leavlb.codelist;
Thisline--;
Thisp = lpstk[lpstkp].leavlb.place;
return(p);
default: STerror("leave");
}
}
/* M_COMPILE:
* x contin x --to-- x,_contin,0,x
*
* M_EXECUTE:
* loopstack: <contlb,leavlb>,x --to-- <contlb,leavlb>,x
* other: jumps to contlb.
*/
_contin(l,p) int (*l[])(),p;
{
switch(status&XMODE) {
case M_COMPILE:
case M_FIXUP: l[p++] = 0; return(p);
case M_EXECUTE:
if(lpstkp == -1) /* cannot continue a loop we're not in */
CNerror(l,p);
Thisline = lpstk[lpstkp].contlb.codelist;
Thisline--;
Thisp = lpstk[lpstkp].contlb.place;
return(p);
default: STerror("contin");
}
}
/* M_COMPILE:
* x rlabel name if x --to-- x,_rlabel,vp,if,0,x
* (the 0 is for the benefit for interp()).
* M_EXECUTE:
* stack: loc,bool,x --to-- x
* p: if bool, p=p else p=loc->place
*/
_if(l,p)
int (*l[])(),p;
{
union value bv,lv;
switch(status&XMODE) {
case M_EXECUTE:
lv = pop();
bv = pop();
if(dbg) printf("_if:M_EXECUTE:lv.pl:%d:p:%d:bv.iv:%D\n",lv.lval.place,
p,bv.ival);
if(bv.ival == (long)0) { /* jump to else part. */
Thisline = lv.lval.codelist;
Thisline--;
Thisp = lv.lval.place;
}
else p++; /* skip the 0 so we get to the then part */
return(p);
case M_FIXUP:
case M_COMPILE: l[p++] = 0; return(p);
default: STerror("if");
}
}
/* M_COMPILE:
* var name <from>expr <to>expr <step>expr <flag>con 0 dlabel FORx rlabel FORx+1 for
*--to--
* _var,vp,<from>,<to>,<step>,<flag>,0,_dlabel,lblp,_rlabel,lblp2,_for
*
* M_EXECUTE:
* stack: xitpt,vizd,step,to,from,vp,x
* other: if exit conditions are correct, jump to exit point.
* vizd is used to hold the data type for vp. Data types
* are always non-zero so the test for the first visit to
* the loop is to see if vizd is 0.
*/
_for(l,p) int(*l[])(),p;
{
union value xitpt,vizd,from,to,step,place;
switch(status&XMODE) {
case M_COMPILE:
case M_FIXUP: l[p++] = 0; return(p);
case M_EXECUTE:
xitpt = pop(); vizd = pop();
step = pop(); to = pop();
from = pop();
if(dbg) printf("_for:EXEC:xit.l:%o:xit.pl:%d:viz.iv:%D:step.iv:%D:to.iv:%D:from.iv:%D:",
xitpt.lval.codelist,xitpt.lval.place,(long)vizd.ival,(long)step.ival,(long)to.ival,(long)from.ival);
if(vizd.ival == 0) { /* first visit to loop */
place = pop();
if(dbg) printf("first time:var:%s:",place.vpval->name);
vizd.ival = place.vpval->type_of_value&T_TMASK; /* != 0 */
place.plval = getplace(place.vpval);
*(place.plval) = from; /* since first time, set starting val */
if(dbg) printf("var.pl:%o:var.val:%D:",place.plval,(long)place.plval->ival);
if(vizd.ival==T_INT && step.ival==0)
if(to.ival < from.ival)
step.ival = -1;
else
step.ival = 1;
else if(vizd.ival==T_DBL && step.rval==0)
if(to.rval < from.rval)
step.rval = -1;
else
step.rval = 1;
}
else place = pop();
if(dbg) printf("var.place:%o:",place.plval);
/* The stack frame is now correctly popped off.
* Next, we check if the loop is finished.
*/
if(vizd.ival == T_INT)
if(step.ival<0 && place.plval->ival<to.ival) goto loop_done;
else if(step.ival>0 && place.plval->ival>to.ival) goto loop_done;
else /* vizd.ival == T_DBL */
if(step.rval<0 && place.plval->rval<to.rval) goto loop_done;
else if(step.rval>0 && place.plval->rval>to.rval) goto loop_done;
/* Loop is not done yet, push back stack frame. */
if(dbg) printf("loop not done, push everything back\n");
push(place); push(from); push(to);
push(step); push(vizd); push(xitpt);
return(p);
/* Come here when the loop is finished. */
loop_done:
if(dbg) printf("loop done, jump to xitpt\n");
Thisline = xitpt.lval.codelist;
Thisline--;
Thisp = xitpt.lval.place;
return(p);
default: STerror("for");
}
}
/* M_COMPILE:
* var name next rlabel FORx go@ dlabel FORx+1
*--to--
* _var,vp,_next,_rlabel,lblp,_go_at,dlabel,lblp2
*
* M_EXECUTE:
* stack: same as M_EXECUTE in _for.
* other: adds step to (control var)->val.
*/
_next(l,p) int(*l[])(),p;
{
union value vp,xitpt,vizd,step,to,from,place;
switch(status&XMODE) {
case M_COMPILE:
case M_FIXUP: return(p);
case M_EXECUTE:
vp = pop();
if(dbg) printf("_next():EXEC:var:%s",vp.vpval->name);
vp.plval = getplace(vp.vpval);
if(dbg) printf(":vp.pl:%o:",vp.plval);
xitpt = pop(); vizd = pop(); step = pop();
to = pop(); from = pop(); place = pop();
if(dbg) printf("pl.pl:%o:from.iv:%D:to.iv:%D:step.iv:%D:viz.iv:%D:",
place.plval,(long)from.ival,(long)to.ival,(long)step.ival,(long)vizd.ival);
if(dbg) printf("xit.list:%o:xit.pl:%d:xit.num:%u\n",xitpt.lval.codelist,
xitpt.lval.place,xitpt.lval.codelist->num);
if(place.plval != vp.plval) FNerror(l,p);
if(vizd.ival == T_INT)
place.plval->ival += step.ival;
else
place.plval->rval += step.rval;
push(place); push(from); push(to);
push(step); push(vizd); push(xitpt);
return(p);
default: STerror("next");
}
}
/* variables needed for M_READ. */
struct line *dlist[DLSIZ];
int dlp = 0;
int dlindx = 2; /* skips <_data,0> */
int dtype; /* type of last operation. */
/* M_COMPILE:
* x data x --to-- x,_data,0,x (0 is for interp())
* M_FIXUP:
* allocates a spot in dlist, stores pointer to llist entry for
* this line at that spot.
* M_EXECUTE:
* Returns, with p pointing at the zero, making interp() return.
*/
_data(l,p) int(*l[])(),p;
{
switch(status&XMODE) {
case M_COMPILE:
l[p++] = 0;
return(p);
case M_FIXUP:
dlist[dlp++] = gllentry(l);
p++;
case M_EXECUTE: return(p);
default:
STerror("data");
}
}
/* M_COMPILE: x dsep x --to-- x,_dsep,0,x
*/
_dsep(l,p) int(*l[])(),p;
{
switch(status&XMODE) {
case M_COMPILE:
case M_FIXUP:
l[p++] = 0;
case M_READ:
case M_EXECUTE: return(p);
default: STerror("dsep");
}
}
/* routines for changing the interpretors state. */
struct statstk { /* for saving old states */
int stkp;
int stat;
} sstk[30];
int sstktop = 0;
/* M_COMPILE:
* x pushstate <state> x --to-- x,pushstate,<state>,x
* M_FIXUP:
* skip <state>
* any other state:
* save old state and stack pointer.
* set state to <state>.
*/
_pushstate(l,p) int (*l[])(),p;
{
switch(status&XMODE) {
case M_COMPILE:
l[p++] = atoi(int_in());
return(p);
case M_FIXUP: return(++p);
default:
sstk[sstktop].stkp = stackp;
sstk[sstktop].stat = status;
sstktop++;
status = l[p++];
return(p);
}
}
_popstate(l,p) int (*l[])(),p;
{
switch(status&XMODE) {
case M_COMPILE:
case M_FIXUP: return(p);
default:
sstktop--;
stackp = sstk[sstktop].stkp;
status = sstk[sstktop].stat&XMODE;
return(p);
}
}
/* stack maintanence routines.
*/
/* M_COMPILE:
* x spop x --to-- x,_spop,x
* M_EXECUTE:
* stack: string,x --to-- x
* other: frees storage used by string (if any).
*/
_spop(l,p) int(*l[])(),p;
{
union value s;
switch(status&XMODE) {
case M_EXECUTE:
s=pop();
if(s.sval != 0) free(s.sval);
case M_COMPILE: return(p);
case M_FIXUP: return(p);
default:
STerror("spop");
}
}
/* M_COMPILE:
* x pop x --to-- x,_pop,x
* M_EXECUTE:
* stack: int,x --to-- x
*/
_pop(l,p) int(*l[])(),p;
{
switch(status&XMODE) {
case M_FIXUP:
case M_COMPILE: return(p);
case M_EXECUTE: pop(); return(p);
default:
STerror("pop");
}
}
_stop(l,p) int(*l[])(),p;
{
switch(status&XMODE) {
case M_FIXUP:
case M_COMPILE: return(p);
case M_EXECUTE: exit(1);
default:
STerror("stop");
}
}
_end(l,p) int (*l[])(),p; { return(_stop(l,p)); }
/* operator list for the intermediate language. */
struct wlnode wlist[] = {
"itoa",_itoa, "print",_print, "goto",_goto, "if",_if, "rtoa",_rtoa,
"itor",_itor, "rtoi",_rtoi, "gosub",_gosub, "return",_return,
"scon",_scon, "icon",_icon, "i+",_iadd, "-",_isub,
"rcon",_rcon, "r+",_radd, "r-",_rsub,
"i*",_imult, "i/",_idiv, "i%",_imod, ",",_comma,
"r*",_rmult, "r/",_rdiv, ";",_scolon,
"i==",_ieq, "s==",_seq, "r==",_req,
"i<>",_ineq, "r<>",_rneq, "s<>",_sneq,
"i<=",_ileq, "s<=",_sleq, "r<=",_rleq,
"i<",_ilt, "s<",_slt, "r<",_rlt,
"i>=",_igeq, "s>=",_sgeq, "r>=",_rgeq,
"i>",_igt, "s>",_sgt, "r>",_rgt,
"or",_or, "and",_and, "val",_val, "not",_not,
"pop",_pop, "spop",_spop,
"stop",_stop, "end",_end, "var",_var, "store",_store,
"for",_for, "next",_next,
"dlabel",_dlabel, "rlabel",_rlabel,
"contin",_contin, "leave",_leave, "enter",_enter, "exitlp",_exitlp,
"data",_data, "dsep",_dsep,
"pushstate",_pushstate, "popstate",_popstate,
0,0
};
SHAR_EOF
if test 14073 -ne "`wc -c < 'bs2/action.c'`"
then
echo shar: error transmitting "'bs2/action.c'" '(should have been 14073 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'bs2/bsdefs.h'" '(4472 characters)'
if test -f 'bs2/bsdefs.h'
then
echo shar: will not over-write existing file "'bs2/bsdefs.h'"
else
sed 's/^X//' << \SHAR_EOF > 'bs2/bsdefs.h'
/* bsdefs.h -- definition file for bs.
*/
#include <stdio.h>
#include <ctype.h>
/* 'Machine' status */
extern int status;
#define M_COMPILE (1<<0)
#define M_EXECUTE (1<<1)
#define M_INPUT (1<<2)
#define M_FIXUP (1<<3)
#define M_READ (1<<4)
#define XMODE (M_COMPILE|M_EXECUTE|M_INPUT|M_FIXUP|M_READ)
/* line table. */
#define MAXLN ((unsigned)65535)
#define NUMLINES 1000
#define LASTLINE (&llist[NUMLINES-1])
extern int (*_null[])();
struct line {
unsigned num;
int (**code)();
char *text;
};
extern struct line llist[];
extern struct line *lastline;
extern struct line *Thisline;
extern int Thisp;
/* Variable types */
#define Q_NRM 0 /* nice, ordinary variable */
#define Q_ARY 1 /* array */
#define Q_BF 2 /* builtin-function */
#define Q_UFL 3 /* long user function */
#define Q_UFS 4 /* short user function */
/* in type part, a zero value is an undefined type. */
#define T_INT (1<<6)
#define T_CHR (2<<6)
#define T_DBL (3<<6)
#define T_LBL (4<<6)
#define T_QMASK 037 /* lower 5 bits for type qualifier */
#define T_TMASK (T_INT|T_CHR|T_DBL|T_LBL)
/* variable table */
#define VLSIZ 150
struct label {
char *name;
int (**codelist)(); /* what line it is on */
int place; /* where on the line it is. */
};
/* For arrays, storage of them is defined as follows:
*
* 1st item: number of dimensions in array <NDIMS>.
* next <NDIMS> items: size of each dimension.
* rest of items: the actual values.
*
* Until we can support varrying sized arrays this is the setup:
*
* 1,10,x0,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10
*
* for a total size of 13 items.
*/
union value {
long ival; /* T_INT */
double rval; /* T_DBL */
char *sval; /* T_CHR */
struct label lval; /* T_LBL */
union value *arval; /* any+Q_ARY */
struct dictnode *vpval; /* for use when pushing variable pointers */
union value *plval; /* for use when pushing pointers to a value */
};
struct dictnode { /* format of vlist entry */
char *name;
int type_of_value;
union value val;
};
extern struct dictnode vlist[];
/* '_' Function table */
extern
_print(), _goto(), _if(), _else(), _for(),
_next(), _read(), _data(), _dsep(), _spop(),
_pop(), _stop(), _end(), _dlabel(), _rlabel(),
_contin(), _leave(), _enter(), _exitlp(),
_iadd(), _isub(), _imult(), _idiv(), _imod(), _comma(),
_radd(), _rsub(), _rmult(), _rdiv(),
_scolon(), _gosub(), _return(), _not(),
_ieq(), _req(), _seq(),
_ineq(), _rneq(), _sneq(),
_ileq(), _rleq(), _sleq(),
_ilt(), _rlt(), _slt(),
_igeq(), _rgeq(), _sgeq(),
_igt(), _rgt(), _sgt(), _or(), _and(),
_itoa(), _rtoa(), _itor(), _rtoi(),
_pushstate(), _popstate(),
_scon(), _rcon(), _icon(), _val(), _store(), _var();
/* interpretor operator table */
struct wlnode {
char *name;
int (*funct)();
};
extern struct wlnode wlist[];
/* Data table. Array of pointers into llist. Each is a line wich has data. */
#define DLSIZ 100
extern struct line *dlist[]; /* actual table, number of elems. is DLSIZ */
extern int dlp; /* index into dlist for current line of data */
extern int dlindx; /* index into current line for current data item. */
extern int dtype; /* in M_READ, operators set this to the type of
* their operation. When the expression is done
* executing, this variable will indicate its type.
*/
/* error routines */
extern int ULerror();
extern int STerror();
extern int FNerror();
extern int ODerror();
extern int BDerror();
extern int VTerror();
/* unions for storing data types in the code list */
union doni {
double d_in_doni;
int i_in_doni[sizeof(double)/sizeof(int)];
};
union loni {
long l_in_loni;
int i_in_loni[sizeof(long)/sizeof(int)];
};
union voni {
union value v_in_voni;
int i_in_voni[sizeof(union value)/sizeof(int)];
};
/* miscellaneous definitions. */
#define STKSIZ 500
extern union value stack[];
extern int stackp;
extern int push();
extern union value pop();
#define CSTKSIZ 5
#define BFSIZ 200 /* input buffer */
extern char pbbuf[]; /* unput() buffer */
extern char ibuf[];
extern int iptr,pbptr;
extern char input();
extern rdlin(),unput();
extern blcpy();
extern char bslash();
extern char *scon_in();
extern int num_in();
extern char *myalloc();
extern union value *getplace();
extern struct line *gllentry();
extern FILE *bsin;
extern int dbg; /* debugging flag. */
extern long atol();
extern double atof();
SHAR_EOF
if test 4472 -ne "`wc -c < 'bs2/bsdefs.h'`"
then
echo shar: error transmitting "'bs2/bsdefs.h'" '(should have been 4472 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'bs2/bsgram.y'" '(6761 characters)'
if test -f 'bs2/bsgram.y'
then
echo shar: will not over-write existing file "'bs2/bsgram.y'"
else
sed 's/^X//' << \SHAR_EOF > 'bs2/bsgram.y'
/* bsgram.y -- grammer specification for bs.
*/
%{
#include "bsdefs.h"
char *p; /* the generic pointer */
int i; /* the generic counter */
struct stk {
int stack[40];
int stkp;
};
struct stk ifstk,whstk,forstk,repstk,lpstk;
int gomax=0; int ifmax=0; int whmax=0; int formax=0; int repmax=0; int lpmax=0;
extern char *yytext;
extern char *bsyysval;
extern int yyleng;
%}
%term EQUAL NEQ LE LT GE WHILE
%term GT OR AND NOT RET REPEAT
%term IF THEN ELSE GOTO GOSUB UNTIL
%term STOP END INTEGER REAL SCONST ELIHW
%term LET SWORD PRINT INPUT DATA CFOR
%term FOR TO STEP READ WRITE NEXT
%term DEFINE LFUN SFUN FDEF SYMBOL DIM
%term VALUE IWORD RWORD ROFC LOOP EXITIF
%term ITOR RTOI ITOA RTOA LEAVE CONTINUE
%term POOL
%left ',' ';'
%right '='
%nonassoc OR AND
%nonassoc LE LT GE GT EQUAL NEQ
%left '+' '-'
%left '*' '/' '%'
%left UNARY
%left '('
%start lines
%%
lines : /* empty */
| lines line
;
line : lnum stat '\n'
{ printf("\n"); }
| '\n'
;
lnum : INTEGER
{ printf(" line %s ",$1); }
;
stat : LET let_xpr
| let_xpr
| PRINT pe
{ printf(" print "); }
| GOTO INTEGER
{ printf(" rlabel LN%s goto ",$2); }
| GOSUB INTEGER
{ printf(" rlabel LN%s gosub ",$2); }
| LEAVE
{ printf(" leave "); }
| CONTINUE
{ printf(" contin "); }
| RET
{ printf(" return "); }
| IF bexpr
{
lpush(&ifstk,ifmax);
printf(" rlabel IF%d if ",ifmax);
ifmax += 2;
}
THEN stat
{
i = ltop(&ifstk);
printf(" rlabel IF%d goto ",i+1);
}
if_else
| INPUT
{ printf(" pushstate %d ",M_INPUT); }
var_lst
{ printf(" popstate "); }
| STOP
{ printf(" stop "); }
| END
{ printf(" end "); }
| FOR ivar '=' rexpr TO rexpr for_step
{
lpush(&forstk,formax);
printf(" rlabel FOR%d rlabel FOR%d enter",
formax+2,formax+1);
printf(" icon 0 rlabel FOR%d dlabel FOR%d for ",
formax+1,formax);
formax += 3;
}
| NEXT
{
i = ltop(&forstk);
printf(" dlabel FOR%d ",i+2);
}
ivar
{
i = lpop(&forstk);
printf(" next rlabel FOR%d goto dlabel FOR%d ",
i,i+1);
printf("exitlp ");
}
| READ { printf(" pushstate %d ",M_READ); } var_lst
{ printf(" popstate "); }
| DATA { printf(" data "); } data_lst
| LOOP
{
lpush(&lpstk,lpmax);
printf(" rlabel LP%d rlabel LP%d enter",
lpmax+2,lpmax+1);
printf(" dlabel LP%d ",lpmax);
lpmax += 3;
}
| EXITIF bexpr
{
i = ltop(&lpstk);
printf(" not rlabel LP%d if ",i+1);
}
| POOL
{
i = lpop(&lpstk);
printf(" dlabel LP%d rlabel LP%d goto",i+2,i);
printf(" dlabel LP%d exitlp ",i+1);
}
| WHILE
{
lpush(&whstk,whmax);
printf(" rlabel WH%d rlabel WH%d enter",
whmax+2,whmax+1);
printf(" dlabel WH%d ",whmax);
whmax += 3;
}
bexpr
{
i = ltop(&whstk);
printf(" rlabel WH%d if ",i+1);
}
| ELIHW
{
i = lpop(&whstk);
printf(" dlabel WH%d",i+2);
printf(" rlabel WH%d goto dlabel WH%d exitlp ",i,i+1);
}
| REPEAT
{
lpush(&repstk,repmax);
printf(" rlabel REP%d rlabel REP%d enter",
repmax+1,repmax+2);
printf(" dlabel REP%d ",repmax);
repmax += 3;
}
| UNTIL
{
i = ltop(&repstk);
printf(" dlabel REP%d ",i+1);
}
bexpr
{
i = lpop(&repstk);
printf(" not rlabel REP%d if",i);
printf(" dlabel REP%d exitlp ",i+2);
}
;
let_xpr : ivar '=' rexpr
{ printf(" rtoi store %d pop ",T_INT); }
| rvar '=' rexpr
{ printf(" store %d pop ",T_DBL); }
| svar '=' sexpr
{ printf(" store %d spop ",T_CHR); }
;
data_lst : rexpr
{ printf(" dsep "); }
| sexpr
{ printf(" dsep "); }
| data_lst ',' rexpr
{ printf(" dsep "); }
| data_lst ',' sexpr
{ printf(" dsep "); }
;
ind_lst : rexpr
| ind_lst ',' rexpr
;
for_step : /* empty */
{ printf(" icon 0 "); }
| STEP rexpr
;
if_else : /* empty */
{
i = lpop(&ifstk);
printf(" dlabel IF%d dlabel IF%d ",i,i+1);
}
| ELSE { i=ltop(&ifstk); printf(" dlabel IF%d ",i); } stat
{ i=lpop(&ifstk); printf(" dlabel IF%d ",i+1); }
;
pe : sexpr ','
{ printf(" scon \"\" , "); }
| sexpr ';'
| sexpr
{ printf(" scon \"\\n\" ; "); }
| /* empty */
{ printf(" scon \"\\n\" "); }
;
var_lst : ivar
| rvar
| svar
| var_lst ',' var_lst
;
sexpr : SCONST
{ printf(" scon \"%s\" ",$1); }
| svar
{ printf(" val %d ",T_CHR); }
| rexpr
{ printf(" rtoa "); }
| svar '=' sexpr
{ printf(" store %d ",T_CHR); }
| sexpr ';' sexpr
{ printf(" ; "); }
| sexpr '+' sexpr
{ printf(" ; "); }
| sexpr ',' sexpr
{ printf(" , "); }
| '(' sexpr ')'
;
sbe : sexpr EQUAL sexpr
{ printf(" s== "); }
| sexpr NEQ sexpr
{ printf(" s<> "); }
| sexpr LE sexpr
{ printf(" s<= "); }
| sexpr LT sexpr
{ printf(" s< "); }
| sexpr GE sexpr
{ printf(" s>= "); }
| sexpr GT sexpr
{ printf(" s> "); }
;
ivar : IWORD
{ printf(" var %d %s ",T_INT,$1); }
| IWORD '(' {printf(" pushstate %d ",M_EXECUTE); } ind_lst ')'
{ printf(" popstate var %d %s ",T_INT+Q_ARY,$1); }
;
rvar : RWORD
{ printf(" var %d %s ",T_DBL,$1); }
| RWORD '(' { printf(" pushstate %d ",M_EXECUTE); } ind_lst ')'
{ printf(" popstate var %d %s ",T_DBL+Q_ARY,$1); }
;
svar : SWORD
{ printf(" var %d %s ",T_CHR,$1); }
| SWORD '(' { printf(" pushstate %d ",M_EXECUTE); } ind_lst ')'
{ printf(" popstate var %d %s ",T_CHR+Q_ARY,$1); }
;
rexpr : rvar
{ printf(" val %d ",T_DBL); }
| REAL
{ printf(" rcon %s ",$1); }
| INTEGER
{ printf(" rcon %s ",$1); }
| ivar
{ printf(" val %ditor ",T_INT); }
| rvar '=' rexpr
{ printf(" store %d ",T_DBL); }
| '(' rexpr ')'
| rexpr '+' rexpr
{ printf(" r+ "); }
| rexpr '-' rexpr
{ printf(" r- "); }
| rexpr '*' rexpr
{ printf(" r* "); }
| rexpr '/' rexpr
{ printf(" r/ "); }
| '+' rexpr %prec UNARY
| '-' rexpr %prec UNARY
{ printf(" rcon -1 r* "); }
;
rbe : rexpr EQUAL rexpr
{ printf(" r== "); }
| rexpr NEQ rexpr
{ printf(" r<> "); }
| rexpr LE rexpr
{ printf(" r<= "); }
| rexpr LT rexpr
{ printf(" r< "); }
| rexpr GE rexpr
{ printf(" r>= "); }
| rexpr GT rexpr
{ printf(" r> "); }
;
bexpr : sbe
| rbe
| NOT bexpr %prec UNARY
{ printf(" not "); }
| bexpr OR bexpr
{ printf(" or "); }
| bexpr AND bexpr
{ printf(" and "); }
| '(' bexpr ')'
;
%%
main()
{
rdlin(bsin);
return(yyparse());
}
yyerror(s)
char *s;
{
fprintf(stderr,"%s\n",s);
}
lpush(stack,val) struct stk *stack; int val;
{ stack->stack[stack->stkp++] = val; }
int ltop(stack) struct stk *stack;
{ return(stack->stack[stack->stkp-1]); }
int lpop(stack) struct stk *stack;
{ return(stack->stack[--stack->stkp]); }
SHAR_EOF
if test 6761 -ne "`wc -c < 'bs2/bsgram.y'`"
then
echo shar: error transmitting "'bs2/bsgram.y'" '(should have been 6761 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'bs2/bsgram.y.orig'" '(7701 characters)'
if test -f 'bs2/bsgram.y.orig'
then
echo shar: will not over-write existing file "'bs2/bsgram.y.orig'"
else
sed 's/^X//' << \SHAR_EOF > 'bs2/bsgram.y.orig'
/* bsgram.y -- grammer specification for bs.
*/
%{
#include "bsdefs.h"
char *p; /* the generic pointer */
int i; /* the generic counter */
struct stk {
int stack[40];
int stkp;
};
struct stk ifstk,whstk,forstk,repstk,lpstk;
int gomax=0; int ifmax=0; int whmax=0; int formax=0; int repmax=0; int lpmax=0;
extern char *yytext;
extern char *bsyysval;
extern int yyleng;
%}
%term EQUAL NEQ LE LT GE WHILE
%term GT OR AND NOT RET REPEAT
%term IF THEN ELSE GOTO GOSUB UNTIL
%term STOP END INTEGER REAL SCONST ELIHW
%term LET SWORD PRINT INPUT DATA CFOR
%term FOR TO STEP READ WRITE NEXT
%term DEFINE LFUN SFUN FDEF SYMBOL DIM
%term VALUE IWORD RWORD ROFC LOOP EXITIF
%term ITOR RTOI ITOA RTOA LEAVE CONTINUE
%term POOL
%left ',' ';'
%right '='
%nonassoc OR AND
%nonassoc LE LT GE GT EQUAL NEQ
%left '+' '-'
%left '*' '/' '%'
%left UNARY
%left '('
%start lines
%%
lines : /* empty */
| lines line
;
line : lnum stat '\n'
{ printf("\n"); }
| '\n'
;
lnum : INTEGER
{ printf(" line %s ",$1); }
;
stat : LET let_xpr
| let_xpr
| PRINT pe
{ printf(" print "); }
| GOTO INTEGER
{ printf(" rlabel LN%s goto ",$2); }
| GOSUB INTEGER
{ printf(" rlabel LN%s gosub ",$2); }
| LEAVE
{ printf(" leave "); }
| CONTINUE
{ printf(" contin "); }
| RET
{ printf(" return "); }
| IF bexpr
{
lpush(&ifstk,ifmax);
printf(" rlabel IF%d if ",ifmax);
ifmax += 2;
}
THEN stat
{
i = ltop(&ifstk);
printf(" rlabel IF%d goto ",i+1);
}
if_else
| INPUT { printf(" pushstate %d ",M_INPUT); } var_lst
{ printf(" popstate "); }
| STOP
{ printf(" stop "); }
| END
{ printf(" end "); }
| FOR ivar '=' iexpr TO iexpr for_step
{
lpush(&forstk,formax);
printf(" rlabel FOR%d rlabel FOR%d enter",
formax+2,formax+1);
printf(" icon 0 rlabel FOR%d dlabel FOR%d for ",
formax+1,formax);
formax += 3;
}
| NEXT
{
i = ltop(&forstk);
printf(" dlabel FOR%d ",i+2);
}
ivar
{
i = lpop(&forstk);
printf(" next rlabel FOR%d goto dlabel FOR%d ",
i,i+1);
printf("exitlp ");
}
| READ { printf(" pushstate %d ",M_READ); } var_lst
{ printf(" popstate "); }
| DATA { printf(" data "); } data_lst
| LOOP
{
lpush(&lpstk,lpmax);
printf(" rlabel LP%d rlabel LP%d enter",
lpmax+2,lpmax+1);
printf(" dlabel LP%d ",lpmax);
lpmax += 3;
}
| EXITIF bexpr
{
i = ltop(&lpstk);
printf(" not rlabel LP%d if ",i+1);
}
| POOL
{
i = lpop(&lpstk);
printf(" dlabel LP%d rlabel LP%d goto",i+2,i);
printf(" dlabel LP%d exitlp ",i+1);
}
| WHILE
{
lpush(&whstk,whmax);
printf(" rlabel WH%d rlabel WH%d enter",
whmax+2,whmax+1);
printf(" dlabel WH%d ",whmax);
whmax += 3;
}
bexpr
{
i = ltop(&whstk);
printf(" rlabel WH%d if ",i+1);
}
| ELIHW
{
i = lpop(&whstk);
printf(" dlabel WH%d",i+2);
printf(" rlabel WH%d goto dlabel WH%d exitlp ",i,i+1);
}
| REPEAT
{
lpush(&repstk,repmax);
printf(" rlabel REP%d rlabel REP%d enter",
repmax+1,repmax+2);
printf(" dlabel REP%d ",repmax);
repmax += 3;
}
| UNTIL
{
i = ltop(&repstk);
printf(" dlabel REP%d ",i+1);
}
bexpr
{
i = lpop(&repstk);
printf(" not rlabel REP%d if",i);
printf(" dlabel REP%d exitlp ",i+2);
}
;
let_xpr : ivar '=' iexpr
{ printf(" store %d pop ",T_INT); }
| rvar '=' rexpr
{ printf(" store %d pop ",T_DBL); }
| svar '=' sexpr
{ printf(" store %d spop ",T_CHR); }
;
data_lst : iexpr
{ printf(" dsep "); }
| rexpr
{ printf(" dsep "); }
| sexpr
{ printf(" dsep "); }
| data_lst ',' iexpr
{ printf(" dsep "); }
| data_lst ',' rexpr
{ printf(" dsep "); }
| data_lst ',' sexpr
{ printf(" dsep "); }
;
ind_lst : iexpr
| ind_lst ',' iexpr
;
for_step : /* empty */
{ printf(" icon 0 "); }
| STEP iexpr
;
if_else : /* empty */
{
i = lpop(&ifstk);
printf(" dlabel IF%d dlabel IF%d ",i,i+1);
}
| ELSE { i=ltop(&ifstk); printf(" dlabel IF%d ",i); } stat
{ i=lpop(&ifstk); printf(" dlabel IF%d ",i+1); }
;
pe : sexpr ','
{ printf(" scon \"\" , "); }
| sexpr ';'
| sexpr
{ printf(" scon \"\\n\" ; "); }
| /* empty */
{ printf(" scon \"\\n\" "); }
;
var_lst : ivar
| rvar
| svar
| var_lst ',' var_lst
;
sexpr : SCONST
{ printf(" scon \"%s\" ",$1); }
| svar
{ printf(" val %d ",T_CHR); }
| iexpr
{ printf(" itoa "); }
| rexpr
{ printf(" rtoa "); }
| svar '=' sexpr
{ printf(" store %d ",T_CHR); }
| sexpr ';' sexpr
{ printf(" ; "); }
| sexpr '+' sexpr
{ printf(" ; "); }
| sexpr ',' sexpr
{ printf(" , "); }
| '(' sexpr ')'
;
sbe : sexpr EQUAL sexpr
{ printf(" s== "); }
| sexpr NEQ sexpr
{ printf(" s<> "); }
| sexpr LE sexpr
{ printf(" s<= "); }
| sexpr LT sexpr
{ printf(" s< "); }
| sexpr GE sexpr
{ printf(" s>= "); }
| sexpr GT sexpr
{ printf(" s> "); }
;
ivar : IWORD
{ printf(" var %d %s ",T_INT,$1); }
| IWORD '(' {printf(" pushstate %d ",M_EXECUTE); } ind_lst ')'
{ printf(" popstate var %d %s ",T_INT+Q_ARY,$1); }
;
rvar : RWORD
{ printf(" var %d %s ",T_DBL,$1); }
| RWORD '(' { printf(" pushstate %d ",M_EXECUTE); } ind_lst ')'
{ printf(" popstate var %d %s ",T_DBL+Q_ARY,$1); }
;
svar : SWORD
{ printf(" var %d %s ",T_CHR,$1); }
| SWORD '(' { printf(" pushstate %d ",M_EXECUTE); } ind_lst ')'
{ printf(" popstate var %d %s ",T_CHR+Q_ARY,$1); }
;
iexpr : ivar
{ printf(" val %d ",T_INT); }
| INTEGER
{ printf(" icon %s ",$1); }
| REAL
{ printf(" rcon %s rtoi ",$1); }
| ivar '=' iexpr
{ printf(" store %d ",T_INT); }
| RTOI '(' rexpr ')'
{ printf(" rtoi "); }
| '(' iexpr ')'
| iexpr '+' iexpr
{ printf(" i+ "); }
| iexpr '-' iexpr
{ printf(" i- "); }
| iexpr '*' iexpr
{ printf(" i* "); }
| iexpr '/' iexpr
{ printf(" i/ "); }
| iexpr '%' iexpr
{ printf(" i%% "); }
| '+' iexpr %prec UNARY
| '-' iexpr %prec UNARY
{ printf(" icon -1 i* "); }
;
ibe : iexpr EQUAL iexpr
{ printf(" i== "); }
| iexpr NEQ iexpr
{ printf(" i<> "); }
| iexpr LE iexpr
{ printf(" i<= "); }
| iexpr LT iexpr
{ printf(" i< "); }
| iexpr GE iexpr
{ printf(" i>= "); }
| iexpr GT iexpr
{ printf(" i> "); }
;
rexpr : rvar
{ printf(" val %d ",T_DBL); }
| REAL
{ printf(" rcon %s ",$1); }
| INTEGER
{ printf(" rcon %s ",$1); }
| rvar '=' rexpr
{ printf(" store %d ",T_DBL); }
| ITOR '(' iexpr ')'
{ printf(" itor "); }
| '(' rexpr ')'
| rexpr '+' rexpr
{ printf(" r+ "); }
| rexpr '-' rexpr
{ printf(" r- "); }
| rexpr '*' rexpr
{ printf(" r* "); }
| rexpr '/' rexpr
{ printf(" r/ "); }
| '+' rexpr %prec UNARY
| '-' rexpr %prec UNARY
{ printf(" rcon -1 r* "); }
;
rbe : rexpr EQUAL rexpr
{ printf(" r== "); }
| rexpr NEQ rexpr
{ printf(" r<> "); }
| rexpr LE rexpr
{ printf(" r<= "); }
| rexpr LT rexpr
{ printf(" r< "); }
| rexpr GE rexpr
{ printf(" r>= "); }
| rexpr GT rexpr
{ printf(" r> "); }
;
bexpr : sbe
| ibe
| rbe
| NOT bexpr %prec UNARY
{ printf(" not "); }
| bexpr OR bexpr
{ printf(" or "); }
| bexpr AND bexpr
{ printf(" and "); }
| '(' bexpr ')'
;
%%
main()
{
rdlin(bsin);
return(yyparse());
}
yyerror(s)
char *s;
{
fprintf(stderr,"%s\n",s);
}
lpush(stack,val) struct stk *stack; int val;
{ stack->stack[stack->stkp++] = val; }
int ltop(stack) struct stk *stack;
{ return(stack->stack[stack->stkp-1]); }
int lpop(stack) struct stk *stack;
{ return(stack->stack[--stack->stkp]); }
SHAR_EOF
if test 7701 -ne "`wc -c < 'bs2/bsgram.y.orig'`"
then
echo shar: error transmitting "'bs2/bsgram.y.orig'" '(should have been 7701 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'bs2/bsint.c'" '(12093 characters)'
if test -f 'bs2/bsint.c'
then
echo shar: will not over-write existing file "'bs2/bsint.c'"
else
sed 's/^X//' << \SHAR_EOF > 'bs2/bsint.c'
/* bsint.c -- main part of interpretor.
*/
#include "bsdefs.h"
int (*_null[])() = { 0,0 };
struct line llist[NUMLINES] = {
0, _null, "",
MAXLN, _null, ""
};
struct line *lastline = &llist[1];
struct line *Thisline = &llist[0];
int Thisp = 0;
struct dictnode vlist[VLSIZ];
/* bslash() -- have seen '\', use input() to say what is actually wanted.
*/
char bslash()
{
char text[8];
register char *s,c;
int v;
c=input();
if(c == 'n') c='\n';
else if(c == 't') c='\t';
else if(c == 'b') c='\b';
else if(c == 'r') c='\r';
else if(c == 'f') c='\f';
else if(c>='0' && c<='7') { /* octal digit string */
s = &text[0];
*s++ = c;
c=input();
while(c>='0' && c<='7') {
*s++ = c;
c=input();
}
*s++ = '\0';
sscanf(text,"%o",&v);
c = (char) v;
}
else if(c=='\n') rdlin(bsin);
return(c);
}
/* scon_in() -- read in a string constant using input.
* Format of an scon is either a quoted string, or a sequence
* of characters ended with a seperator (' ', '\t' or '\n' or ',').
*
* In either mode, you can get funny characters into the string by
* "quoting" them with a '\'.
*
* scon_in() uses myalloc() to create space to store the string in.
*/
char *scon_in()
{
register char c,*s;
static char text [80];
s = &text[0];
/* beginning state, skip seperators until something interesting comes along */
l1: c=input();
if(c == '"') goto l2;
else if(c=='\n' || c=='\0') {
rdlin(bsin);
goto l1;
}
else if(c==' ' || c=='\t' || c==',') goto l1;
else goto l3;
/* have skipped unwanted material, seen a '"', read in a quoted string */
l2: c=input();
if(c == '\n') {
fprintf(stderr,"scon_in: unterminated string\n");
exit(1);
}
else if(c == '\\') { *s++ = bslash(bsin); goto l2; }
else if(c == '"')
if((c=input()) == '"') {
*s++ = '"';
goto l2;
}
else goto done;
else { *s++ = c; goto l2; }
/* skipped unwanted, seen something interesting, not '"', gather until sep */
l3: *s++ = c;
c=input();
if(c == '\\') { c = bslash(bsin); goto l3; }
else if(c==' ' || c=='\t' || c==',' || c=='\n') goto done;
else goto l3;
/* final state (if machine finished ok.) */
done: unput(c);
*s++ = '\0';
s=myalloc(strlen(text)+1);
strcpy(s,text);
return(s);
}
/* int_in() -- tokenizer routine for inputting a number.
* int_in() returns a pointer to a static data area. This area gets
* overwritten with each call to int_in so use the data before calling
* int_in() again.
*/
char * int_in()
{
register char c,*s;
static char text[20];
s = &text[0];
/* beginning state, skip junk until either '-' or ['0'-'9'] comes along */
l1: c=input();
if(c>='0' && c<='9') goto l3;
else if(c == '-') goto l2;
else {
if(c=='\n' || c=='\0') rdlin(bsin);
goto l1;
}
/* skipped junk, seen '-', gather it and make sure next char is a digit */
l2: *s++ = c;
c=input();
if(c==' ' || c=='\t') goto l2; /* allow white between sign and digit */
else if(c>='0' && c<='9') goto l3;
else { /* seen something not allowed. */
s = &text[0];
printf("\n\007??");
goto l1; /* restart machine */
}
/* skipped junk, seen a digit, gather until a non-digit appears */
l3: *s++ = c;
c=input();
if(c>='0' && c<='9') goto l3;
else {
/* have reached successful conclusion to machine. */
unput(c);
*s++ = '\0';
return(text);
}
}
/* real_in() -- read in a floating point number using input().
*
* real_in() returns a pointer to a static data area. This data area
* gets overwritten with each call to real_in(), so use it quickly.
*/
char *real_in()
{
register char *s,c;
static char bf[30];
s = &bf[0];
/* starting state. loops back until something interesting seen */
state1: c=input();
if(c == '-') goto state3;
else if(c>='0' && c<='9') goto state2;
else if(c == '.') goto state4;
else {
if(c=='\n' || c=='\0') rdlin(bsin);
goto state1;
}
/* seen a digit. gather all digits following. */
state2: *s++ = c;
c=input();
if(c>='0' && c<='9') goto state2;
else if(c == '.') goto state4;
else goto state9; /* done */
/* seen a sign character before start of number. loop back for whitespace. */
state3: *s++ = c;
state3_a: c=input();
if(c==' ' || c=='\t') goto state3_a;
else if(c>='0' && c<='9') goto state2;
else if(c == '.') goto state4;
else goto state10; /* error, had a sign so we have to have digs. */
/* seen digit(s) and a decimal point. looking for more digs or ('e'|'E') */
state4: *s++ = c;
c=input();
if(c>='0' && c<='9') goto state5;
else if(c=='e' || c=='E') goto state6;
else goto state9; /* done */
/* seen (digs '.' dig). look for more digs or ('e'|'E'). */
state5: *s++ = c;
c=input();
if(c=='e' || c=='E') goto state6;
else if(c>='0' && c<='9') goto state5;
else goto state9;
/* seen (digs '.' digs (e|E)). looking for sign or digs, else error. */
state6: *s++ = c;
c=input();
if(c=='+' || c=='-') goto state7;
else if(c>='0' && c<='9') goto state8;
else goto state10; /* error */
/* seen (digs '.' digs (e|E) sign). looking for digs, else error. */
state7: *s++ = c;
c=input();
if(c>='0' && c<='9') goto state8;
else goto state10; /* error */
/* seen (digs '.' digs (e|E) [sign] dig). looking for digs. */
state8: *s++ = c;
c=input();
if(c>='0' && c<='9') goto state8;
else goto state9; /* done */
/* seen a complete number. machine successfully completed. whew! */
state9: unput(c); /* might want that later */
*s++ = '\0';
return(bf);
/* Uh oh. An error. Print an error and restart. */
state10: printf("\n\007??");
goto state1;
}
/* gtok() -- read a token using input(). Tokens are delimited by whitespace.
* When '\n' is found, "\n" is returned.
* For EOF or control characters (not '\n' or '\t') 0 is returned.
*/
char *gtok()
{
static char token[20];
register char *s,c;
s = &token[0];
loop: c=input();
if(c==' ' || c=='\t') goto loop;
else if(c == '\n') return("\n");
else if(c==EOF || iscntrl(c)) return(0);
else {
*s++ = c;
for(c=input(); c>' ' && c<='~'; c=input())
*s++ = c;
unput(c);
*s++ = '\0';
return(token);
}
}
/* insline(num) -- insert num into llist with insertion sort style.
* Replaces old lines if already in list.
*/
struct line *insline(num)
int num;
{
struct line *p,*p2,*p3;
struct dictnode *vp;
struct dictnode *gvadr();
char s[12];
if(lastline == LASTLINE) return(0);
for(p=lastline; p->num > num; p--)
/* null */ ;
if(p->num == num) {
if(p->code != 0) { free(p->code); p->code = 0; }
if(p->text != 0) { free(p->text); p->text = 0; }
}
else { /* p->num < num */
++p;
p2=lastline;
p3= ++lastline;
while(p2 >= p) {
p3->num = p2->num;
p3->code = p2->code;
p3->text = p2->text;
p2--;
p3--;
}
p->num = num;
p->text = p->code = 0;
}
sprintf(s,"LN%d",num);
vp = gvadr(s,T_LBL);
vp->val.lval.codelist = p;
vp->val.lval.place = 0;
return(p);
}
/* gvadr() -- Get variable address from vlist, with type checking.
* This routine allows numerous copies of same name as long as
* all copies have different types. Probably doesnt matter since
* the parser does the type checking.
*/
struct dictnode *gvadr(s,ty)
char *s;
int ty;
{
register int i;
register int qual; /* type qualifier */
for(i=0; vlist[i].name!=0 && i<VLSIZ; i++)
if(vlist[i].type_of_value==ty && strcmp(s,vlist[i].name)==0)
break; /* match found */
if(i >= VLSIZ) {
fprintf(stderr,"gvadr: out of room in variable list for %s\n",s);
exit(1);
}
if(vlist[i].name == 0) { /* not on list, enter it */
vlist[i].name = myalloc(strlen(s)+1);
strcpy(vlist[i].name,s);
vlist[i].val.rval = 0;
vlist[i].type_of_value = ty;
if(ty&T_QMASK == Q_ARY)
vlist[i].val.arval = myalloc(13*sizeof(union value));
}
return(&vlist[i]);
}
/* getplace() -- get a pointer to place of value for vlist entry on top of stack
* For arrays, getplace() expects the indexes to be on the stack as well.
* The parser should properly arrange for this to happen.
*/
union value *getplace(dp)
struct dictnode *dp;
{
int qual;
union value ind,*place;
qual = dp->type_of_value&T_QMASK;
if(qual == Q_ARY) {
ind = pop();
mpop();
place = & dp->val.arval[ind.ival+2];
}
else
place = & dp->val;
return(place);
}
/* gladr() -- get address of llist entry, given the line number.
*/
struct line *gladr(lnum)
unsigned lnum;
{
register struct line *q;
register int num;
num = lnum;
for(q= &llist[0]; q->num!=num && q->num!=MAXLN ; q++)
;
if(q->num == MAXLN) return(0);
/* else */
if(q->code==0 && q->text==0) return(0); /* fake line */
/* else */
return(q); /* found place */
}
/* gllentry() -- Given an address for a code list, return llist entry which
* has matching code list address.
*/
struct line *gllentry(l)
int **l;
{
register int llp;
for(llp=0; llist[llp].num != MAXLN; llp++)
if(llist[llp].code == l)
return(&llist[llp]);
return(0); /* such an entry not found */
}
/* glist() -- read rest of line as a code list, return the corresponding
* code list.
*/
int **glist()
{
register char *s;
int (*codestring[100])();
int lp,(**l)();
register int i;
lp=0;
for(s=gtok(); s!=0 && strcmp(s,"\n")!=0; s=gtok()) {
for(i=0; wlist[i].name!=0; i++)
if(strcmp(wlist[i].name,s)==0)
break;
if(wlist[i].name == 0) {
fprintf(stderr,"unknown name %s\n",s);
exit(1);
}
if(wlist[i].funct == 0) {
fprintf(stderr,"glist: no function for %s at %o\n",s,&wlist[i]);
exit(1);
}
codestring[lp++] = wlist[i].funct;
lp = (*wlist[i].funct)(codestring,lp);
}
codestring[lp++] = 0;
l = myalloc(lp*2+1);
blcpy(l,codestring,lp*2);
return(l);
}
/* rprg -- read in a bunch of lines, put them in program buffer.
*/
rprg()
{
char *s;
int ln;
struct line *pl;
for(s=gtok(); s!=0; s=gtok()) {
if(strcmp(s,"line") == 0) {
s=gtok();
ln=atoi(s);
pl=insline(ln);
if(pl == 0){ fprintf(stderr,"out of room for program\n");exit(1); }
s=myalloc(strlen(ibuf)+1);
strcpy(s,ibuf);
pl->text = s;
pl->code = glist();
}
else { fprintf(stderr,"syntax error, no line number: %s\n",ibuf); exit(1); }
}
}
interp(l,start)
int (*l[])(),start;
{
int lp;
for(lp=start+1; l[lp-1]!=0; lp++)
lp = (*l[lp-1])(l,lp);
return(lp);
}
/* runit() -- run the program in llist. arg- address of place to start at.
*
* to do a goto type action, set Thisline to llist entry PREVIOUS to
* desired place. Set Thisp to desired index. To cause it to happen,
* place a 0 in the code list where interp() will see it at the right
* time.
*
* All this will cause runit() to run correctly, and automatically take
* care of updating the line number pointers (Thisline and Thisp).
*/
runit()
{
int ourthisp;
ourthisp = Thisp;
Thisp = 0;
while(Thisline < lastline) {
interp((Thisline->code),ourthisp);
++Thisline;
ourthisp = Thisp;
Thisp = 0;
}
}
int dbg = 0; /* debugging flag. */
main(argc,argv)
int argc;
char **argv;
{
int i,j;
int (**l)();
if(argc >= 2) {
if((bsin=fopen(argv[1],"r")) == NULL) {
fprintf(stderr,"main: could not open input file %s\n",argv[1]);
exit(1);
}
}
if(argc > 2) dbg = 1; /* "int file <anything>" sets debugging */
/* Read the program (on file bsin) and compile it to the executable code. */
rdlin(bsin);
status = M_COMPILE;
rprg();
if(bsin != stdin) fclose(bsin);
bsin = stdin; /* make sure it is stdin for execution */
iptr = 0;
ibuf[iptr] = 0; /* make the input buffer empty. */
/* Scan through the compiled code, make sure things point to where
* they are supposed be pointing to, etc.
*/
status = M_FIXUP;
Thisline = &llist[0];
while(Thisline < lastline) {
interp((Thisline->code),0);
++Thisline;
}
status = M_EXECUTE;
dlp = 0; /* set it back to beginning of list */
Thisline = &llist[0];
Thisp = 0;
runit();
}
SHAR_EOF
if test 12093 -ne "`wc -c < 'bs2/bsint.c'`"
then
echo shar: error transmitting "'bs2/bsint.c'" '(should have been 12093 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'bs2/bslib.c'" '(1553 characters)'
if test -f 'bs2/bslib.c'
then
echo shar: will not over-write existing file "'bs2/bslib.c'"
else
sed 's/^X//' << \SHAR_EOF > 'bs2/bslib.c'
/* bslib.c -- subroutine library, routines useful anywhere.
*/
#include "bsdefs.h"
XFILE *bsin = stdin;
/* blcpy -- copies a block of memory (l bytes) from s to d.
*/
blcpy(d,s,l)
char *d,*s;
int l;
{
for(; l >= 0; (l--)) *(d++) = *(s++);
}
/* Input routines. These routines buffer input a line at a time into
* ibuf. Unputted input goes to pbbuf, and gets read before things in
* ibuf, if anything in pbbuf.
*/
char pbbuf[CSTKSIZ],ibuf[BFSIZ];
int iptr = -1;
int pbptr = -1;
char input()
{
if(pbptr > -1)
return(pbbuf[pbptr--]);
else {
if(ibuf[iptr] == '\0') rdlin(bsin);
if(ibuf[iptr]!='\0' && !feof(bsin))
return(ibuf[iptr++]);
else
return(0);
}
}
rdlin(f) FILE *f;
{
char c;
iptr = 0;
for(c=fgetc(f); c!='\n' && c!=EOF; c=fgetc(f)) ibuf[iptr++] = c;
ibuf[iptr++] = c;
ibuf[iptr++] = '\0';
iptr = 0;
}
unput(c) char c;
{ pbbuf[++pbptr] = c; }
/* myalloc() -- allocate, checking for out of memory.
*/
char *myalloc(nb)
int nb;
{
char *rval;
rval = malloc(nb);
/*
printf("myalloc:tos:%o,rv:%o,nb:%d,e:%o\n",&rval,rval,nb,sbrk(0));
*/
if(rval == 0) {
fprintf(stderr,"myalloc: out of memory\n");
exit(1);
}
return(rval);
}
/* Stack routines. Very simple. */
union value stack[STKSIZ];
int stackp = -1;
push(i) union value i;
{
stack[++stackp] = i;
}
union value pop()
{
return(stack[stackp--]);
}
/* Mark stack. Also very simple. */
int mstack[5];
int mstkp = -1;
mpush()
{ mstack[++mstkp] = stackp; }
mpop()
{ stackp = mstack[mstkp--]; }
SHAR_EOF
if test 1553 -ne "`wc -c < 'bs2/bslib.c'`"
then
echo shar: error transmitting "'bs2/bslib.c'" '(should have been 1553 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'bs2/errors.c'" '(1583 characters)'
if test -f 'bs2/errors.c'
then
echo shar: will not over-write existing file "'bs2/errors.c'"
else
sed 's/^X//' << \SHAR_EOF > 'bs2/errors.c'
/* errors.c -- error message routines for int.
*/
#include "bsdefs.h"
/* ULerror() -- unknown line (cannot find wanted line)
*/
ULerror(l,p) int(*l[])(),p;
{
fprintf(stderr,"Unknown line %d\n",*(l[p]));
exit(1);
}
/* STerror() -- wrong value for status variable
*/
XSTerror(f) char *f;
{
fprintf(stderr,"%s: illegal status %o\n",f,status);
exit(1);
}
/* FNerror() -- For Next error
*/
XFNerror(l,p)
int (*l[])(),p;
{
struct dictnode *nv;
struct line *ll;
ll = gllentry(l);
nv = l[p-2];
fprintf(stderr,"Next %s, For (something else), at line %u\n",
nv->name,ll->num);
exit(1);
}
ODerror(l,p)
int (*l[])(),p;
{
struct line *ll;
char *s;
ll = gllentry(l);
s = ((struct dictnode *)l[p])->name;
fprintf(stderr,"Out of Data in line %u at var %s\b",ll->num,s);
exit(1);
}
BDerror(l,p)
int (*l[])(),p;
{
struct line *ll;
char *s;
ll = gllentry(l);
s = ((struct dictnode *)l[p])->name;
fprintf(stderr,"Bad Data type in line %u at var %s\n",ll->num,s);
exit(1);
}
VTerror(l,p)
int (*l[])(),p;
{
struct dictnode *vp;
vp = (struct dictnode *)l[p];
fprintf(stderr,"Invalid data type %d for var %s\n",vp->type_of_value,vp->name);
exit(1);
}
LVerror(l,p) int(*l[])(),p;
{
struct line *ll;
ll = gllentry(l);
fprintf(stderr,"Tried to leave while not in a loop, at line %u\n",ll->num);
exit(1);
}
CNerror(l,p) int(*l[])(),p;
{
struct line *ll;
ll = gllentry(l);
fprintf(stderr,"Tried to continue while not in a loop, at line %u\n",ll->num);
exit(1);
}
SHAR_EOF
if test 1583 -ne "`wc -c < 'bs2/errors.c'`"
then
echo shar: error transmitting "'bs2/errors.c'" '(should have been 1583 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'bs2/operat.c'" '(9158 characters)'
if test -f 'bs2/operat.c'
then
echo shar: will not over-write existing file "'bs2/operat.c'"
else
sed 's/^X//' << \SHAR_EOF > 'bs2/operat.c'
/* operat.c -- operations, as opposed to actions. FOR is an action,
* '+' is an operation.
*
* More operators can be found in the machine generated file "operat2.c".
*/
#include "bsdefs.h"
/* BINARY OPERATORS */
/* Common description for the binary ops.
* also applies to all ops in operat2.c
*
* M_COMPILE:
* x op x --to-- x,_op,x
* M_EXECUTE:
* stack: ar2,ar1,x --to-- (ar1 op ar2),x
*/
_comma(l,p) int (*l[])(),p;
{
union value s1,s2,s3;
switch(status&XMODE) {
case M_COMPILE:
case M_FIXUP: return(p);
case M_READ: dtype = T_CHR;
case M_EXECUTE:
s1 = pop();
s2 = pop();
s3.sval = myalloc(strlen(s1.sval)+strlen(s2.sval)+3);
strcpy(s3.sval,s2.sval);
strcat(s3.sval,"\t");
strcat(s3.sval,s1.sval);
if(s1.sval != 0) free(s1.sval);
if(s2.sval != 0) free(s2.sval);
push(s3);
return(p);
default: STerror("comma");
}
}
_scolon(l,p) int(*l[])(),p;
{
union value s1,s2,s3;
switch(status&XMODE) {
case M_COMPILE:
case M_FIXUP: return(p);
case M_READ: dtype = T_CHR;
case M_EXECUTE:
s1 = pop();
s2 = pop();
s3.sval = myalloc(strlen(s1.sval)+strlen(s2.sval)+2);
strcpy(s3.sval,s2.sval);
strcat(s3.sval,s1.sval);
push(s3);
if(s1.sval != 0) free(s1.sval);
if(s2.sval != 0) free(s2.sval);
return(p);
default:
STerror("scolon");
}
}
/* last of binary operators */
/* M_COMPILE:
* x not x --to-- x,_not,x
* M_EXECUTE:
* stack: bool,x --to-- !(bool),x
*/
_not(l,p) int (*l[])(),p;
{
union value val;
if((status&XMODE) == M_EXECUTE) {
val = pop();
val.ival = ! val.ival;
push(val);
}
return(p);
}
/* M_COMPILE:
* x itoa x --to-- x,_itoa,x
* M_EXECUTE:
* stack: int,x --to-- string,x
*/
_itoa(l,p)
int (*l[])(),p;
{
union value val;
char s2[30];
switch(status&XMODE) {
case M_FIXUP:
case M_COMPILE: return(p);
case M_READ:
dtype = T_CHR;
case M_EXECUTE:
val=pop();
sprintf(s2,"%D",val.ival); /* optimize later */
if(dbg) printf("_icon():M_EXECUTE:ival:%D to sval:%s\n",val.ival,s2);
val.sval=myalloc(strlen(s2)+1);
strcpy(val.sval,s2);
push(val);
return(p);
default:
STerror("itoa");
}
}
_rtoa(l,p)
int (*l[])(),p;
{
union value val;
char s2[30];
switch(status&XMODE) {
case M_FIXUP:
case M_COMPILE: return(p);
case M_READ: dtype = T_CHR;
case M_EXECUTE:
val = pop();
sprintf(s2,"%g",val.rval);
if(dbg) printf("_rtoa():M_EXECUTE:rval:%g to sval:%s\n",val.rval,s2);
val.sval = myalloc(strlen(s2)+1);
strcpy(val.sval,s2);
push(val);
return(p);
default: STerror("rtoa");
}
}
_itor(l,p)
int (*l[])(),p;
{
union value v1,v2;
switch(status&XMODE) {
case M_READ: dtype = T_DBL;
case M_EXECUTE:
v1 = pop();
v2.rval = (double)v1.ival;
push(v2);
case M_FIXUP:
case M_COMPILE: return(p);
default: STerror("itor");
}
}
_rtoi(l,p)
int (*l[])(),p;
{
union value v1,v2;
switch(status&XMODE) {
case M_READ: dtype = T_INT;
case M_EXECUTE:
v1 = pop();
v2.ival = (int)v1.rval;
push(v2);
case M_FIXUP:
case M_COMPILE: return(p);
default: STerror("rtoi");
}
}
/* M_COMPILE:
* x scon "quoted string" x --to-- x,_scon,*string,x
* M_EXECUTE:
* stack: x --to-- string,x
* other: pushes a COPY of the string, not the original.
*/
_scon(l,p)
int (*l[])(),p;
{
char *s,c;
union value val;
int i;
switch(status&XMODE) {
case M_COMPILE:
l[p++] = scon_in();
return(p);
case M_READ:
dtype = T_CHR;
case M_EXECUTE:
s = l[p++];
val.sval = myalloc(strlen(s)+1);
strcpy(val.sval,s);
push(val);
if(dbg) printf("_scon():M_EXECUTE:sval:%s\n",val.sval);
return(p);
case M_FIXUP: p++; return(p);
default: STerror("scon");
}
}
/* M_COMPILE:
* x icon int x --to-- x,_icon,int,x
* M_EXECUTE:
* stack: x --to-- int,x
*/
_icon(l,p)
int (*l[])(),p;
{
union value val;
union loni v;
int i;
switch(status&XMODE) {
case M_COMPILE:
v.l_in_loni = atol(int_in());
for(i=0; i<(sizeof(long)/sizeof(int)); i++)
l[p++] = v.i_in_loni[i];
return(p);
case M_READ: dtype = T_INT;
case M_EXECUTE:
for(i=0; i<(sizeof(long)/sizeof(int)); i++)
v.i_in_loni[i] = l[p++];
val.ival = v.l_in_loni;
push(val);
if(dbg) printf("_icon():M_EXECUTE:ival:%D\n",val.ival);
return(p);
case M_FIXUP:
p += (sizeof(long)/sizeof(int));
return(p);
default: STerror("icon");
}
}
_rcon(l,p)
int (*l[])(),p;
{
union doni v;
int i;
union value val;
switch(status&XMODE) {
case M_COMPILE:
v.d_in_doni = atof(real_in());
for(i=0; i<(sizeof(double)/sizeof(int)); i++)
l[p++] = v.i_in_doni[i];
return(p);
case M_FIXUP:
p += (sizeof(double)/sizeof(int));
return(p);
case M_READ: dtype = T_DBL;
case M_EXECUTE:
for(i=0; i<(sizeof(double)/sizeof(int)); i++)
v.i_in_doni[i] = l[p++];
val.rval = v.d_in_doni;
push(val);
return(p);
default: STerror("rcon");
}
}
/* M_COMPILE:
* x val type x --to-- x,_val,type,x
* M_EXECUTE:
* stack: place,x --to-- value,x
* other: for strings, pushes a copy of the string.
*/
_val(l,p) int(*l[])(),p;
{
union value place,val;
int ty;
switch(status&XMODE) {
case M_COMPILE:
l[p++] = atoi(int_in());
return(p);
case M_READ:
dtype = l[p];
case M_EXECUTE:
ty = l[p];
place = pop();
if(dbg) printf("_val():M_EXECUTE:var:%s",place.vpval->name);
place.plval = getplace(place.vpval);
if(ty==T_CHR && place.plval->sval!=0) {
val.sval = myalloc(strlen(place.plval->sval)+1);
strcpy(val.sval,place.plval->sval);
push(val);
}
else push(*place.plval);
if(dbg) printf(":ival:%D:rval:%g:sval:%s\n",ty==T_INT?place.plval->ival:(long)0,
ty==T_DBL?place.plval->rval:(double)0,ty==T_CHR?place.plval->sval:0);
case M_FIXUP: p++; return(p);
default: STerror("val");
}
}
/* M_COMPILE:
* x store typ x --to-- x,_store,type,x
* M_EXECUTE:
* stack: value,location,x --to-- value,x
* (stores value at location).
*/
_store(l,p) int(*l[])(),p;
{
union value place,val;
int ty;
switch(status&XMODE) {
case M_COMPILE:
l[p++] = atoi(int_in());
return(p);
case M_READ:
dtype = l[p];
case M_EXECUTE:
val = pop();
place = pop();
ty = l[p];
if(dbg) printf("_store():M_EXECUTE:var:%s:ival:%D:rval:%g:sval:%s\n",
place.vpval->name,ty==T_INT?val.ival:(long)0,ty==T_DBL?val.rval:(double)0,ty==T_CHR?val.sval:0);
place.plval = getplace(place.vpval);
if(ty==T_CHR && place.plval->sval!=0) free(place.plval->sval);
(*place.plval) = val;
push(val);
case M_FIXUP:
p++;
return(p);
default: STerror("store");
}
}
/* M_COMPILE:
* x var typ name x --to-- x,_var,&vlist entry,x
* M_EXECUTE:
* stack: x --to-- &vlist entry,x
* M_INPUT:
* (&vlist entry)->val is set to input value.
* M_READ:
* Moves the data list pointers to the next data item. If no next
* data item, calls ODerror.
* Does a "gosub" to the data item, to get its value on the stack.
* Does T_INT to T_CHR conversion if necessary.
* Pops value into vp->val.
*/
_var(l,p) int(*l[])(),p; /* same proc for any variable type */
{
char *s;
struct dictnode *vp;
struct line *thislist;
union value place,val;
int ty,qual;
switch(status&XMODE) {
case M_COMPILE:
ty = atoi(int_in());
s = gtok();
l[p++] = gvadr(s,ty);
return(p);
case M_EXECUTE:
val.vpval = l[p++];
if(dbg) printf("_var():M_EXECUTE:var:(%d)%s\n",val.vpval->type_of_value,
val.vpval->name);
push(val);
return(p);
case M_INPUT:
vp = l[p++];
place.plval = getplace(vp);
ty = (vp->type_of_value) & T_TMASK;
if(ty == T_INT)
place.plval->ival = atol(int_in());
else if(ty == T_DBL)
place.plval->rval = atof(real_in());
else
place.plval->sval = scon_in();
if(dbg) printf("_var():M_INPUT:var:(%d)%s:ival:%D:rval:%g:sval:%s\n",
vp->type_of_value,vp->name,ty==T_INT?place.plval->ival:(long)0,
ty==T_DBL?place.plval->rval:(double)0,ty==T_CHR?place.plval->sval:0);
return(p);
case M_READ:
nxdl: if(dlist[dlp] == 0) ODerror(l,p); /* ran off end of dlist */
thislist = dlist[dlp];
if((thislist->code)[dlindx] == 0) {
dlp++;
dlindx = 2; /* skips <_data,0> */
goto nxdl;
}
status = M_EXECUTE;
dlindx = interp(thislist->code,dlindx);
status = M_READ;
val = pop();
vp = l[p];
place.plval = getplace(vp);
qual = vp->type_of_value&T_TMASK;
if(qual == T_INT)
place.plval->ival = val.ival;
else if(qual == T_DBL)
place.plval->rval = val.rval;
else if(qual == T_CHR) {
if(dtype == T_INT) {
push(val); _itoa(l,p); val = pop();
}
else if(dtype == T_DBL) {
push(val); _rtoa(l,p); val = pop();
}
if(place.plval->sval != 0) free(place.plval->sval);
place.plval->sval = myalloc(strlen(val.sval)+1);
strcpy(place.plval->sval,val.sval);
}
else VTerror(l,p);
case M_FIXUP:
p++;
return(p);
default: STerror("var");
}
}
SHAR_EOF
if test 9158 -ne "`wc -c < 'bs2/operat.c'`"
then
echo shar: error transmitting "'bs2/operat.c'" '(should have been 9158 characters)'
fi
fi # end of overwriting check
# End of shell archive
exit 0
More information about the Mod.sources
mailing list