Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume18 / spin / part01 next >

Wrap

Internet Message Format | 1989-03-08 | 58.6 KB

Subject: v18i009: Simple programmable interface kit, Part01/02 Newsgroups: comp.sources.unix Sender: sources Approved: rsalz@uunet.UU.NET Submitted-by: Jim McBeath <voder!sci!gumby!jimmc> Posting-number: Volume 18, Issue 9 Archive-name: spin/part01 [ This posting is hard to describe. It's sort of like an extensible command-language interpreter library. --r$ ] Spin is a simple interpreter intended for use as a program development tool and modest programmable interface. It contains a parser and execution engine, with the ability to easily extend the basic engine with additional features such as control constructs or new operations. The spin interpreter has been set up to be usable in a bare-bones configuration, in which there are almost no capabilities or functions available other than application-specific ones. There are also a set of various simple extensions available which raise the application-independent capabilities of spin up to a level where it is almost usable by itself. The intent is for the application to add whatever application-specific functions it needs and to select the level of application-independent support needed. The spin library was designed to be modular enough that the application program could pick and choose among almost all of the aspects of the interpreter. If there is a capability which is not needed, it does not need to be loaded. If there is a capability which the programmer feels he can implement better, it is typically a fairly simple job for him to rewrite that capability without worrying about other parts of the system. In addition to the generic extensions, an application program can add whatever application-specific functions are desired. Each function requires a one-line call to one of the spin primitives, to be executed during program startup time. Once this has been done, the function is available to the user of the application. There are a small number of data types known to spin (e.g. int, float, string), which can be specified as the argument and return types for functions. The spin interpreter will do type checking on all arguments passed to functions. #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 1 (of 2)." # Contents: MANIFEST Makefile README TODO cont.sp contsubs.c exec.h # filesubs.c goto.c goto.h initsubs.c lex.l listsubs.c main.c # mathsubs.c parse.c spin.3 spin.h spinparse.h varsubs.c xalloc.c # xalloc.h # Wrapped by rsalz@fig.bbn.com on Thu Mar 9 15:55:19 1989 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'MANIFEST' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'MANIFEST'\" else echo shar: Extracting \"'MANIFEST'\" $809 characters$ sed "s/^X//" >'MANIFEST' <<'END_OF_FILE' X File Name Archive # Description X----------------------------------------------------------- X MANIFEST 1 X Makefile 1 X README 1 X TODO 1 X cont.sp 1 X contsubs.c 1 X exec.c 2 X exec.h 1 X filesubs.c 1 X goto.c 1 X goto.h 1 X initsubs.c 1 X lex.l 1 X listsubs.c 1 X main.c 1 X mathsubs.c 1 X parse.c 1 X spin.3 1 X spin.h 1 X spinparse.h 1 X varsubs.c 1 X xalloc.c 1 X xalloc.h 1 END_OF_FILE if test 809 -ne `wc -c <'MANIFEST'`; then echo shar: \"'MANIFEST'\" unpacked with wrong size! fi # end of 'MANIFEST' fi if test -f 'Makefile' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'Makefile'\" else echo shar: Extracting \"'Makefile'\" $3439 characters$ sed "s/^X//" >'Makefile' <<'END_OF_FILE' X#Makefile for spin X# 28.Jul.87 jimmc Initial definition X# 2.Aug.87 jimmc Add backup tag X# 30.Nov.87 jimmc Add LINTSRCS macro, SHAR stuff X# 11.Jan.88 jimmc Remove main.o from object list for library X# 1.Mar.87 jimmc Add man tag X XROOTNAME = spin XLIBRARY = $(ROOTNAME).a XLINTLIB = llib-$(LIBRARY).ln XPROGRAM = $(ROOTNAME) XDEST = . X XMKMF = mkmf X XCLASH = clash X XSHAR = shar XSHARFILE = $(ROOTNAME).shar X XMAKE = make $(MFLAGS) XMAKEFILE = Makefile X XBKPMACH = wheel XBKPDIR = src/$(ROOTNAME).bak X X# careful with this variable. it is really set down in target "depend:" XCFLAGS = $(CCOPTS) X XINCLUDE = XCCOPTS = -g X XLINKER = cc X XLINTFLAGS = $(INCLUDE) $(LINTOPTS) XLINTOPTS = -bauz X XSRCS = contsubs.c \ X exec.c \ X filesubs.c \ X goto.c \ X initsubs.c \ X lex.l \ X listsubs.c \ X main.c \ X mathsubs.c \ X parse.c \ X varsubs.c \ X xalloc.c X XLINTSRCS = `echo $(SRCS) | sed -e 's/lex.l//' -e 's/main.c//' ` X XLIBOBJS = `echo $(OBJS) | sed -e 's/main.o//' ` X XOBJS = contsubs.o \ X exec.o \ X filesubs.o \ X goto.o \ X initsubs.o \ X lex.o \ X listsubs.o \ X main.o \ X mathsubs.o \ X parse.o \ X varsubs.o \ X xalloc.o X XHDRS = exec.h \ X goto.h \ X spin.h \ X spinparse.h \ X xalloc.h X XSHARETC = Post.note README $(ROOTNAME).3 TODO cont.sp X XSHARSRCS = $(SHARETC) $(SRCS) $(HDRS) $(MAKEFILE) X XEXTHDRS = /usr/include/ctype.h \ X /usr/include/setjmp.h \ X /usr/include/stdio.h X XLIBS = X XXLINTLIBS = X Xdefault: $(PROGRAM) X Xlib: $(LIBRARY) X Xlibrary: $(LIBRARY) X Xlintlib: $(LINTLIB) X Xshar: $(SHARFILE) X Xclash:; $(CLASH) $(HDRS) $(LINTSRCS) X Xall: $(PROGRAM) $(LINTLIB) X X$(PROGRAM): main.o $(LIBRARY) X @echo -n "Loading $(PROGRAM) ... " X @rm -f $(PROGRAM) X @$(LINKER) $(CFLAGS) main.o $(LIBRARY) -o $(PROGRAM).new X @mv -f $(PROGRAM).new $(PROGRAM) X @echo "done" X X$(LIBRARY): $(OBJS) X @echo -n "Loading $(LIBRARY) ... " X @ar cru $(LIBRARY) $(LIBOBJS) X @ranlib $(LIBRARY) X @echo "done" X X$(LINTLIB): $(SRCS) X lint -C$(LIBRARY) $(LINTFLAGS) $(LINTSRCS) X Xman: $(ROOTNAME).3 X nroff -man $(ROOTNAME).3 > $(ROOTNAME).man.new X mv $(ROOTNAME).man.new $(ROOTNAME).man X X$(SHARFILE): $(SHARSRCS) X $(SHAR) $(SHARSRCS) > $(SHARFILE) X Xinstall: $(PROGRAM) X @echo Installing $(PROGRAM) in $(DEST) X @install -m 770 -c $(PROGRAM) $(DEST) X Xdepend: $(XDEP) X @echo Updating $(MAKEFILE) ... X @$(MKMF) -f $(MAKEFILE) \ X CFLAGS='$$(CCOPTS) $(INCLUDE)' X# PROGRAM makes mkmf use p.Makefile template X# PROGRAM=$(PROGRAM) X Xlint:; lint $(LINTFLAGS) $(LINTSRCS) $(LINTLIBS) X Xtidy:; @rm -f $(OBJS) X Xclean: tidy X @rm -f $(PROGRAM) $(LIBRARY) X Xprint:; @pr $(SRCS) $(HDRS) X Xtags: $(HDRS) $(SRCS); @ctags $(HDRS) $(SRCS) X Xbackup:; tar cf - $(HDRS) $(SRCS) $(MAKEFILE) | \ X rsh $(BKPMACH) 'cd $(BKPDIR); tar xBf -' X Xlex.o: spin.h spinparse.h xalloc.h X X### Xcontsubs.o: /usr/include/stdio.h xalloc.h spin.h exec.h Xexec.o: /usr/include/stdio.h /usr/include/ctype.h goto.h \ X /usr/include/setjmp.h xalloc.h spin.h spinparse.h exec.h Xfilesubs.o: /usr/include/stdio.h goto.h /usr/include/setjmp.h spin.h \ X xalloc.h Xgoto.o: goto.h /usr/include/setjmp.h xalloc.h Xinitsubs.o: spin.h Xlistsubs.o: xalloc.h spin.h Xmain.o: /usr/include/stdio.h xalloc.h Xmathsubs.o: spin.h Xparse.o: /usr/include/stdio.h /usr/include/ctype.h goto.h \ X /usr/include/setjmp.h xalloc.h spin.h spinparse.h Xvarsubs.o: xalloc.h spin.h Xxalloc.o: /usr/include/stdio.h END_OF_FILE if test 3439 -ne `wc -c <'Makefile'`; then echo shar: \"'Makefile'\" unpacked with wrong size! fi # end of 'Makefile' fi if test -f 'README' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'README'\" else echo shar: Extracting \"'README'\" $1289 characters$ sed "s/^X//" >'README' <<'END_OF_FILE' XThe SPIN Library 1.Mar.88 XWritten by Jim McBeath (jimmc) at SCI X XThis is version 1.0 of SPIN, a Simple Programmable INterface. XIt is intended to make life easier when developing programs; Xit is not commercial quality, but should be modular enough that Xany competent programmer can incrementally improve those parts Xof it which suit his needs. X XFiles of interest: X *.[ch] The source files for spin. X Makefile Exactly that. X README What you are looking at right now. X spin.3 Source for man page. Describes (briefly) what X spin is all about. X Use "make man" to create spin man file (spin.man). X cont.sp A sample spin file. X XWhat to do (after unpacking): X1. Use "make man" to create spin.man from spin.3. Read it. X2. Make the library and program by doing a simple "make". X3. Test the program (spin) by running it and issuing the following commands X (you type in the stuff on the lines after the ">" prompt): X >SPversion X STRING spin v1.0 1.Mar.88 X >plus 1 2 X add 1 2 X INT 3 X >strcat foo ".bar" X STRING foo.bar X >quit X4. Make the lint library (for other programs) by doing "make lintlib". X You are now ready to link other programs with spin. X5. Send me your comments, wishes, and improvements. X X -Jim McBeath {decwrl|oliveb|weitek|auspyr}!sci!jimmc X 1.Mar.1988 X END_OF_FILE if test 1289 -ne `wc -c <'README'`; then echo shar: \"'README'\" unpacked with wrong size! fi # end of 'README' fi if test -f 'TODO' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'TODO'\" else echo shar: Extracting \"'TODO'\" $345 characters$ sed "s/^X//" >'TODO' <<'END_OF_FILE' X 1.Mar.88 X X- Make SPescape truly varargs X- Write a routine to scan command line switches and remove recognized ones? X- Decide how lists are allocated X- reexamine arg and return code characters and meanings X- clean up memory management; there are many memory leaks. X how about garbage collection for tokens and strings? X- improve documentation END_OF_FILE if test 345 -ne `wc -c <'TODO'`; then echo shar: \"'TODO'\" unpacked with wrong size! fi # end of 'TODO' fi if test -f 'cont.sp' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'cont.sp'\" else echo shar: Extracting \"'cont.sp'\" $1326 characters$ sed "s/^X//" >'cont.sp' <<'END_OF_FILE' X/* Some control structures to test spin */ X Xdefine while (\ X (fset c (argquote 1))\ X (fset e (argquote 2))\ X(label begin)\ X (if (eval (get c))\ X (goto ok))\ X (goto end)\ X(label ok)\ X (eval (get e))\ X (goto begin)\ X(label end)\ X) X Xdefine until (\ X (fset c (argquote 1))\ X (fset e (argquote 2))\ X(label begin)\ X (if (eval (get c))\ X (goto end))\ X (eval (get e))\ X (goto begin)\ X(label end)\ X) X Xdefine do (\ X (fset e (argquote 1))\ X (fset k (argquote 2))\ X (fset c (argquote 3))\ X(label begin)\ X (eval (get e))\ X (if (streq "while" (get k)) (goto dowhile))\ X/* dountil */\ X (if (eval (get c)) (goto done))\ X (goto begin)\ X(label dowhile)\ X (if (eval (get c)) (goto begin))\ X(label done)\ X) X Xdefine testwhile (\ X (fset a (argeval 1))\ X (fset b (argeval 2))\ X (while (igr (get b) (get a)) (\ X (print (get a))\ X (set a (plus 1 (get a)))\ X ))\ X) X Xdefine testuntil (\ X (fset a (argeval 1))\ X (fset b (argeval 2))\ X (until (igr (get a) (get b)) (\ X (print (get a))\ X (set a (plus 1 (get a)))\ X ))\ X) X Xdefine testdountil (\ X (fset a (argeval 1))\ X (fset b (argeval 2))\ X (do (\ X (print (get a))\ X (set a (plus 1 (get a)))\ X ) until (igr (get a) (get b)))\ X) X Xdefine testdowhile (\ X (fset a (argeval 1))\ X (fset b (argeval 2))\ X (do (\ X (print (get a))\ X (set a (plus 1 (get a)))\ X ) while (igr (get b) (get a)))\ X) X X/* end */ END_OF_FILE if test 1326 -ne `wc -c <'cont.sp'`; then echo shar: \"'cont.sp'\" unpacked with wrong size! fi # end of 'cont.sp' fi if test -f 'contsubs.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'contsubs.c'\" else echo shar: Extracting \"'contsubs.c'\" $3543 characters$ sed "s/^X//" >'contsubs.c' <<'END_OF_FILE' X/* contsubs.c - control structure subroutines for spin X * X * 16.Oct.87 jimmc Initial definition X * 21.Oct.87 jimmc Add func and args stuff X * 30.Nov.87 jimmc Lint cleanup X */ X/* LINTLIBRARY */ X X#include <stdio.h> X#include "xalloc.h" X#include "spin.h" X#include "exec.h" X Xstruct funcargs { X struct funcargs *up; X int num; /* number of args */ X SPtoken **val; /* the args (pointer to array of pointers) */ X SPtoken *vallist; X}; Xstruct funcargs *curargs; X Xextern SPtoken *SPexec(); X XSPtoken * Xsp_if(test,truecode,falsecode) Xint test; /* the value to test */ XSPtoken *truecode; /* execute this if true */ XSPtoken *falsecode; /* execute this is false */ X{ X if (test) { X return SPexec(truecode); X } X else { X return SPexec(falsecode); X } X} X Xvoid Xsp_exit(code) Xint code; X{ X/*** should allow programs to set up exit routines which are called X * before the exit is actually done, or which may abort the exit. X */ X exit(code); X} X Xchar * Xsp_priminfo(name) Xchar *name; X{ XSPfuncinfo *finfo, *SPfindfunc(); X X finfo = SPfindfunc(name); X if (!finfo) return NIL; X return finfo->args; X} X Xvoid Xsp_define(name,list) Xchar *name; XSPtoken *list; X{ Xextern SPtoken *sp_fset(); X X (void)sp_fset(name,list); X} X Xint /* 1 if we found and executed the function */ Xsp_xexec(name,args,rval) Xchar *name; /* name of the function to execute */ XSPtoken *args; /* the args to that function */ XSPtoken *rval; /* the token in which to return the value of the func */ X{ XSPtoken *fval, *sp_fget(), *rrval, *SPexec(); Xstruct funcargs fargs; Xint n; XSPtoken* tk; X X fval = sp_fget(name); /* see if we have it */ X if (!fval) return 0; /* not found */ X for (n=0,tk=args; tk; tk=tk->next) n++; /* count args */ X fargs.num = n; X if (n>0) fargs.val = XALLOC(SPtoken *,n); X for (n=0,tk=args; tk; tk=tk->next) fargs.val[n++]=tk; X fargs.vallist = NIL; X fargs.up = curargs; X curargs = &fargs; X rrval = SPexec(fval); /* execute the function (just a list!) */ X /*** not much argument checking here! */ X if (rrval) *rval = *rrval; X else rval->type = SPTokNil; X if (n>0) XFREE(fargs.val); X curargs = fargs.up; X return 1; /* we got it OK */ X} X XSPtoken * Xsp_argquote(argnum) Xint argnum; X{ X if (!curargs || argnum<1 || argnum>curargs->num) return NIL; X return curargs->val[argnum-1]; X} X XSPtoken * Xsp_argeval(argnum) Xint argnum; X{ X if (!curargs || argnum<1 || argnum>curargs->num) return NIL; X return SPexec(curargs->val[argnum-1]); X} X Xstatic Xsp_makevallist() X{ X ALLOCTOKEN(curargs->vallist) X curargs->vallist->type = SPTokList; X curargs->vallist->value.l = curargs->val[0]; X curargs->vallist->next = NIL; X} X XSPtoken * Xsp_arglistquote() X{ X if (!curargs) return NIL; X if (!curargs->vallist) sp_makevallist(); X return curargs->vallist; X} X XSPtoken * Xsp_arglisteval() X{ XSPtoken *list, *tk, *newtk, **prevtkp, *SPnewnil(); X X if (!curargs) return NIL; X if (!curargs->vallist) sp_makevallist(); X ALLOCTOKEN(list) X list->type = SPTokList; X list->next = NIL; X prevtkp = &list->value.l; X for (tk=curargs->vallist->value.l; tk; tk=tk->next) { X newtk = SPexec(tk); X if (!newtk) newtk = SPnewnil(); X *prevtkp = newtk; X prevtkp = &newtk->next; X } X *prevtkp = NIL; X return list; X} X XSPinitcont() X{ X SPdeffunc("if","lbLL",sp_if); X SPdeffunc("exit","vI0",sp_exit); X SPdeffunc("quit","vI0",sp_exit); /* synonym for exit */ X SPdeffunc("define","vnL",sp_define); X SPdeffunc("argquote","li",sp_argquote); X SPdeffunc("argeval","Li",sp_argeval); X SPdeffunc("arglistquote","l",sp_arglistquote); X SPdeffunc("arglisteval","L",sp_arglisteval); X SPdeffunc("priminfo","sn",sp_priminfo); X SPsetxexecp(sp_xexec); X} X X/* end */ END_OF_FILE if test 3543 -ne `wc -c <'contsubs.c'`; then echo shar: \"'contsubs.c'\" unpacked with wrong size! fi # end of 'contsubs.c' fi if test -f 'exec.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'exec.h'\" else echo shar: Extracting \"'exec.h'\" $256 characters$ sed "s/^X//" >'exec.h' <<'END_OF_FILE' X/* exec.h - stuff for spin execution X * X */ X Xtypedef struct _SPfuncinfo { X char *name; /* name of the function */ X char *args; /* return ard arg types */ X void (*funcp)(); /* pointer to the function */ X struct _SPfuncinfo *next; X} SPfuncinfo; X X/* end */ END_OF_FILE if test 256 -ne `wc -c <'exec.h'`; then echo shar: \"'exec.h'\" unpacked with wrong size! fi # end of 'exec.h' fi if test -f 'filesubs.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'filesubs.c'\" else echo shar: Extracting \"'filesubs.c'\" $1271 characters$ sed "s/^X//" >'filesubs.c' <<'END_OF_FILE' X/* filesubs.c - file subroutines for spin X * X * 20.Oct.87 jimmc Initial definition X * 4.Nov.87 jimmc Add print X * 5.Nov.87 jimmc Add setjmp stuff in sourcefile X * 30.Nov.87 jimmc Lint cleanup X */ X/* LINTLIBRARY */ X X#include <stdio.h> X#include "goto.h" X#include "spin.h" X#include "xalloc.h" X Xint /* 0 if no errors */ Xsp_sourcefile(filename) Xchar *filename; X{ XSPtoken *rval, *SPparsefile(); XFILE *fp; Xjmp_buf jbuf; Xjmp_bufp oldbufp; X X fp = fopen(filename,"r"); X if (!fp) { X SPescape("CantOpenFile","can't open file %s",filename); X /* NOTREACHED */ X } X oldbufp = SPjbufp; X SPjbufp = jmpbuf_addr(jbuf); X if (setjmp(jbuf)) { /* got an error while processing */ X fclose(fp); /* close the file */ X SPjbufp = oldbufp; X longjmp(jmpbuf_ref(SPjbufp),1); /* continue up */ X /* NOTREACHED */ X } X rval = SPparsefile(fp); X fclose(fp); X FREETOKENLIST(rval) X SPjbufp = oldbufp; X return 0; X} X Xint /* 0 if no errors */ Xsp_sourcestring(string) Xchar *string; X{ XSPtoken *rval, *SPparsestring(); X X rval = SPparsestring(string); X FREETOKENLIST(rval) X return 0; X} X Xsp_print(v) XSPtoken *v; X{ X SPprintval(stdout,v,0); X} X XSPinitfile() X{ X SPdeffunc("sourcefile","is",sp_sourcefile); X SPdeffunc("sourcestring","is",sp_sourcestring); X SPdeffunc("print","vV",sp_print); X} X X/* end */ END_OF_FILE if test 1271 -ne `wc -c <'filesubs.c'`; then echo shar: \"'filesubs.c'\" unpacked with wrong size! fi # end of 'filesubs.c' fi if test -f 'goto.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'goto.c'\" else echo shar: Extracting \"'goto.c'\" $1742 characters$ sed "s/^X//" >'goto.c' <<'END_OF_FILE' X/* goto.c - subroutines used in goto (also for error goto) X * X * 4.Nov.87 jimmc Initial definition X * 30.Nov.87 jimmc Lint cleanup X */ X/* LINTLIBRARY */ X X#include <strings.h> X#include "goto.h" X#include "xalloc.h" X Xextern char *sprintf(); /* make lint happy */ X Xjmp_bufp SPjbufp; Xchar *SPgotolabel; Xchar *SPerrorstr; X XSPgoto(label) Xchar *label; X{ X if (SPgotolabel) XFREE(SPgotolabel); X SPgotolabel = XALLOC(char,strlen(label)+1); X strcpy(SPgotolabel,label); X longjmp(jmpbuf_ref(SPjbufp),1); X /* NOTREACHED */ X} X X/* ARGSUSED */ Xvoid XSPlabel(label) /* labels are actually handled in SPexeclist */ Xchar *label; X{ X ; /* no value for a label statement */ X} X Xchar * XSPerrorinfo(info) Xchar *info; X{ Xint l; Xchar *newerrorstr; X X if (!info) return SPerrorstr; X if (info[0]=='+') { X if (SPerrorstr) l = strlen(SPerrorstr)+strlen(info+1)+1; X else l = strlen(info+1)+1; X newerrorstr = XALLOC(char,l); X if (SPerrorstr) strcpy(newerrorstr,SPerrorstr); X else newerrorstr[0]=0; X strcat(newerrorstr,info+1); X } X else { X l = strlen(info)+1; X newerrorstr = XALLOC(char,l); X strcpy(newerrorstr,info); X } X if (SPerrorstr) XFREE(SPerrorstr); X SPerrorstr = newerrorstr; X return SPerrorstr; X} X X/* SPescape is an internal function used to deal with errors */ X/* VARARGS2 */ XSPescape(label,fmt,arg1,arg2) Xchar *label; /* label to go to */ Xchar *fmt; /* printf-style format for error info */ Xchar *arg1,*arg2; /* first of printf-style args */ X{ Xchar buf[2000]; X X/*** this needs to be fixed up to be truly variable number of args */ X sprintf(buf,fmt,arg1,arg2); X SPerrorinfo(buf); X SPgoto(label); X /* NOTREACHED */ X} X XSPinitgoto() X{ X SPdeffunc("goto","vs",SPgoto); X SPdeffunc("label","vs",SPlabel); X SPdeffunc("errorinfo","sSN",SPerrorinfo); X} X X/* end */ END_OF_FILE if test 1742 -ne `wc -c <'goto.c'`; then echo shar: \"'goto.c'\" unpacked with wrong size! fi # end of 'goto.c' fi if test -f 'goto.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'goto.h'\" else echo shar: Extracting \"'goto.h'\" $481 characters$ sed "s/^X//" >'goto.h' <<'END_OF_FILE' X/* goto.h - things required to use the setjmp stuff in SP X * X * 4.Nov.87 jimmc Initial definition X */ X X#include <setjmp.h> X X/* The fact that jmp_buf is so hazily defined makes it difficult to X * deal with pointers to jmp_bufs, etc. The following code assumes X * that a jmp_buf is an array of ints, so it may be machine dependent. X */ X Xtypedef int *jmp_bufp; X Xextern jmp_bufp SPjbufp; Xextern char *SPgotolabel; X X#define jmpbuf_addr(jb) jb X#define jmpbuf_ref(jbp) jbp X X/* end */ END_OF_FILE if test 481 -ne `wc -c <'goto.h'`; then echo shar: \"'goto.h'\" unpacked with wrong size! fi # end of 'goto.h' fi if test -f 'initsubs.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'initsubs.c'\" else echo shar: Extracting \"'initsubs.c'\" $759 characters$ sed "s/^X//" >'initsubs.c' <<'END_OF_FILE' X/* initsubs.c - this routine pulls in all of the standard spin subroutine X * packages which are available. X * X * 16.Oct.87 jimmc Initial definition X * 4.Nov.87 jimmc Add call to SPinitgoto X * 5.Nov.87 jimmc Add call to SPinitmath X * 30.Nov.87 jimmc Lint cleanup X * 1.Mar.88 jimmc Add SPversion X */ X/* LINTLIBRARY */ X Xstatic char *SPversion_string = "spin v1.0 1.Mar.88"; X X#include "spin.h" X Xchar * XSPversion() X{ X return SPversion_string; X} X XSPinitsubs() X{ X SPdeffunc("SPversion","s",SPversion); X X SPinitgoto(); /* labels and goto */ X SPinitmath(); /* math operators */ X SPinitcont(); /* control flow */ X SPinitvars(); /* variables and function definitions */ X SPinitlist(); /* list operations */ X SPinitfile(); /* file operations */ X} X X/* end */ END_OF_FILE if test 759 -ne `wc -c <'initsubs.c'`; then echo shar: \"'initsubs.c'\" unpacked with wrong size! fi # end of 'initsubs.c' fi if test -f 'lex.l' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'lex.l'\" else echo shar: Extracting \"'lex.l'\" $4639 characters$ sed "s/^X//" >'lex.l' <<'END_OF_FILE' X /* lex - lex routines for spin X * X * 16.Oct.87 jimmc Initial definition (taken from ilet) X * 21.Oct.87 jimmc Add NIL token X */ X X /* definitions */ X XD [0-9] XE [Ee][+-]?{D}+ XO [0-7] XH [0-9A-Fa-f] XS [A-Za-z] Xs [A-Za-z0-9_] XW [ \t\n\f] Xw [ \t\f] Xx [Xx] X X%{ X#include <ctype.h> X#include <stdio.h> X#include "spin.h" X#include "spinparse.h" X#include "xalloc.h" X X#undef input X#undef output X#undef unput X X/* a macro to aid debugging */ X/* #define RETURN(c) {printf("token %s\n","c");return(c);} */ X#define RETURN(c) return(c) X X#define malform() {SPwerror("bad character formation"); \ X SPtokenpval = ""; RETURN(SPTokStr); } X#define collect() {while(c != '\'' && c != '\n' && c != ';') c = input(); \ X unput('\n');} X Xchar *SPtokenpval; Xint SPtokenival; Xfloat SPtokenfval; X X%} X /* rules follow the next %% */ X%% X X"/*" { for (;;) { /* slash-star starts comments */ X int c; X if ((c=input())==0) break; /* EOF */ X if (c=='*') { X if ((c=input())=='/') break; X /* end of comment */ X else unput(c); X } X /* continue eating comment */ X } X /* now the comment has been eaten */ X yyleng = 0; yymore(); } X\" { /* character string */ /* taken from LISCH1 */ X register int c ; X X for(yyleng = 0; c = input(); ++yyleng) { X switch(c) { X case '\\': X if ((c = input()) == '\n') X --yyleng ; X else { X unput(c) ; X yytext[yyleng] = backslash() ; X } X break ; X case '\n': X SPwerror("bad string format"); X unput('\n') ; X /* fall through */ X case '"': X yytext[yyleng] = '\0' ; X goto break2 ; X default: X if (isprint(c)) X yytext[yyleng] = c; X else X SPwerror("bad char in string (%3o)",c); X break ; X } X } X break2: X SPtokenpval = yytext; X RETURN(SPTokStr); X } X"0"{x}{H}+ { sscanf( yytext+2, "%x", &SPtokenival); RETURN(SPTokInt);} X"0"([oO])?{O}+ { sscanf( yytext, "%o", &SPtokenival); RETURN(SPTokInt); } X"0"[oO]{D}+ { SPwerror("bad octal integer"); X SPtokenival = 0; RETURN(SPTokInt); } X{D}+ { sscanf( yytext, "%d", &SPtokenival); RETURN(SPTokInt); } X{D}+"."{D}*({E})? | X{D}*"."{D}+({E})? | X{D}+{E} { sscanf( yytext, "%f", &SPtokenfval); RETURN(SPTokFloat); } X{W}+ { /* ignore white space */ } X"NIL" { RETURN(SPTokNil); } X{S}{s}* { SPtokenpval = yytext; RETURN(SPTokName); } X"(" { RETURN(SPTokLP); } X")" { RETURN(SPTokRP); } X";" { RETURN(SPTokSM); } X"."|[^.] { illchar("in input"); } X X%% X X/* user subroutines */ X/* we are supplying our own input routines */ X Xchar cstack[256]; /* the unput buffer */ Xint ccount; /* number of chars in the unput buffer */ Xint cindex; /* index into input line buffer array */ Xchar *cinline; /* the input line buffer */ X XSPlexinit(info) XSPstreaminfo *info; X{ X cindex=0; X cinline = info->SPlinebuf; X ccount = 0; X} X Xstatic Xinput() X{ X int c; X X if (ccount>0) { X c = cstack[--ccount]; X /* these are chars pushed back with unput */ X } X else { /* no lookahead, get a new char */ X c = cinline[cindex++]; X if (c==0) cindex--; X } X return c; X} X X/*..........*/ X Xunput(c) Xchar c; X{ X X if ((cindex>0)&&(c==cinline[cindex-1])) { X /* see if he is putting back the most recent char */ X cindex--; /* just back up the pointer and counter */ X } X else /*** should check for overflow */ X cstack[ccount++] = c; /* stack up the char */ X} X X/*..........*/ X Xoutput(c) X{ X /* this should never be called */ X SPwerror("compiler error: 'output' called with arg %3o",c); X} X X/*..........*/ X Xillchar(s) Xchar *s; X{ X char c; X X c = yytext[yyleng-1]; X if (isprint(c)) SPwerror("illegal char '%c' %s", c, s); X /* printable chars */ X else SPwerror("illegal char %03o %s", c, s); X /* non-printing chars */ X} X Xyywrap() { X return 1; X} X Xbackslash() /* taken from LISCH1 */ X{ X register int c ; X X switch(c = input()) { X case '\\': X return('\\') ; X case 'b': X return('\b') ; X case 'e': X return('\033') ; /* escape */ X case 'f': X return('\f') ; X case 'n': X return('\n') ; X case 'r': X return('\r') ; X case 't': X return('\t') ; X case 'v': X return('\013') ; /* vertical tab */ X case '"': X return('"') ; X case '\'': X return('\'') ; X case '^': X c = input() ; X if (isprint(c)) X return(c & ~0140) ; X /* convert to control char range */ X else { X unput(c) ; X return('^') ; X } X default: X if (! isdigit(c)) X return(c) ; X else { X int i, n ; X char buf[4] ; X X buf[0] = c ; X for (i = 1; i < 3; i++) X if (! isdigit(buf[i] = input())) { X unput(buf[i]) ; X break ; X } X buf[i] = '\0' ; X sscanf(buf, "%o", &n) ; X return(n) ; X } X } X} X X/* end */ END_OF_FILE if test 4639 -ne `wc -c <'lex.l'`; then echo shar: \"'lex.l'\" unpacked with wrong size! fi # end of 'lex.l' fi if test -f 'listsubs.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'listsubs.c'\" else echo shar: Extracting \"'listsubs.c'\" $1600 characters$ sed "s/^X//" >'listsubs.c' <<'END_OF_FILE' X/* listsubs.c - routines which deal with lists for spin X * X * 16.Oct.87 jimmc Initial definition X * 21.Oct.87 jimmc Add eval function X * 30.Nov.87 jimmc Lint cleanup X */ X/* LINTLIBRARY */ X X#include "xalloc.h" X#include "spin.h" X Xextern SPtoken *SPcopytoken(), *SPexec(); X XSPtoken * Xsp_quote(list) XSPtoken *list; X{ X return SPcopytoken(list); X} X XSPtoken * Xsp_eval(list) XSPtoken *list; X{ X return SPexec(list); X} X XSPinitlist() X{ X SPdeffunc("quote","LL",sp_quote); X SPdeffunc("eval","LV",sp_eval); X} X X X/* convert an integer array into a list X */ XSPtoken * XSPiarrtolist(ac,av) Xint ac; /* size of integer array */ Xint *av; /* array of integers to convert to a list */ X{ X SPtoken *ap, *next, **app; X int i; X X ALLOCTOKEN(ap) X ap->type = SPTokList; X ap->next = NIL; X app = &(ap->value.l); X for (i=0; i<ac; i++) { X ALLOCTOKEN(next) X next->type = SPTokInt; X next->value.n = av[i]; X *app = next; X app = &(next->next); X } X *app = NIL; X return ap; X} X X/* converts a list to an array of ints; mallocs the array and returns X * a pointer to it. The list must contain only ints. X * On error, returns -1. X */ Xint /* returns size of array as value */ XSPlisttoiarr(ap,ipp) XSPtoken *ap; Xint **ipp; /* pointer to array pointer for return value */ X{ X int i,n; X int *ip; X SPtoken *np; X X if (ap->type != SPTokList) return -1; X n = 0; /* count the number of ints */ X for (np=ap->value.l; np; np=np->next) { X if (np->type != SPTokInt) return -1; /* must be all ints */ X n++; X } X ip = XALLOC(int,n); X for (i=0, np=ap->value.l; i<n; i++, np=np->next) { X ip[i] = np->value.n; X } X *ipp = ip; X return n; X} X X/* end */ END_OF_FILE if test 1600 -ne `wc -c <'listsubs.c'`; then echo shar: \"'listsubs.c'\" unpacked with wrong size! fi # end of 'listsubs.c' fi if test -f 'main.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'main.c'\" else echo shar: Extracting \"'main.c'\" $1584 characters$ sed "s/^X//" >'main.c' <<'END_OF_FILE' X/* main.c - test module and sample main program for spin X * X * 17.Oct.87 jimmc Initial definition X * 4.Nov.87 jimmc Add ieq, igr, streq X */ X X#include <stdio.h> X#include <strings.h> X#include "xalloc.h" X X/* #define MINSPIN */ X/* define MINSPIN to get just the stripped down interpreter (in case X * you are curious as to just how big it is). X */ X Xchar *Progname, *rindex(); X Xmain(argc,argv) Xint argc; Xchar *argv[]; X{ Xint i,j; Xchar *execval; X X Progname=rindex(argv[0],'/'); X if (Progname) Progname++; else Progname=argv[0]; X X m_init(); X#ifndef MINSPIN X SPinitsubs(); X#endif X for (i=1; i<argc; i++) { X if (argv[i][0]=='-') for (j=1; j>0&&argv[i][j]; j++) { X switch (argv[i][j]) { X case 'e': X execval = argv[++i]; X j = -1; X break; X default: break; /* just ignore it */ X } X } X /* ignore other stuff */ X } X if (execval) { SPmainstring(execval); } X SPmainfile(stdin); X exit(0); X} X Xint Xm_plus(a,b) Xint a,b; X{ Xprintf("add %d %d\n", a, b); X return (a+b); X} X Xint Xm_strlen(s) Xchar *s; X{ X if (!s) return NULL; X return strlen(s); X} X Xchar * Xm_strcat(a,b) Xchar *a, *b; X{ Xchar *r; X X r = XALLOC(char,strlen(a)+strlen(b)+1); X strcpy(r,a); X strcat(r,b); X return r; X} X Xint Xm_streq(a,b) Xchar *a,*b; X{ X return (strcmp(a,b)==0); X} X Xint Xm_ieq(a,b) Xint a,b; X{ X return (a==b); X} X Xint Xm_igr(a,b) Xint a,b; X{ X return (a>b); X} X Xm_init() X{ X SPdeffunc("plus","iii;summand addend addend",m_plus); X SPdeffunc("strlen","iSN",m_strlen); X SPdeffunc("strcat","sS\"foo\"S\"bar\"",m_strcat); X SPdeffunc("streq","iss",m_streq); X SPdeffunc("ieq","iii",m_ieq); X SPdeffunc("igr","iii",m_igr); X} X X/* end */ END_OF_FILE if test 1584 -ne `wc -c <'main.c'`; then echo shar: \"'main.c'\" unpacked with wrong size! fi # end of 'main.c' fi if test -f 'mathsubs.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'mathsubs.c'\" else echo shar: Extracting \"'mathsubs.c'\" $919 characters$ sed "s/^X//" >'mathsubs.c' <<'END_OF_FILE' X/* mathsubs.c - math operators for spin X * X * 5.Nov.87 jimmc Initial definition X * 30.Nov.87 jimmc Lint cleanup X */ X/* LINTLIBRARY */ X X#include "spin.h" X Xstatic XSPbadbool(op) Xchar *op; X{ X/* this routine is to catch and error which "should never happen" */ X SPescape("BadTokenType","non-list arg to %s",op); X /* NOTREACHED */ X} X Xint Xsp_not(b) Xint b; X{ X return (!b); X} X Xint Xsp_and(l) XSPtoken *l; X{ X if (!l || l->type!=SPTokList) { X SPbadbool("and"); X /* NOTREACHED */ X } X for (l=l->value.l; l; l=l->next) X if (SPbooleval(l)==0) X return 0; X return 1; X} X Xint Xsp_or(l) XSPtoken *l; X{ X if (!l || l->type!=SPTokList) { X SPbadbool("or"); X /* NOTREACHED */ X } X for (l=l->value.l; l; l=l->next) X if (SPbooleval(l)==1) X return 1; X return 0; X} X XSPinitmath() X{ Xextern int SPbool(); X SPdeffunc("bool","iV",SPbool); X SPdeffunc("not","ib",sp_not); X SPdeffunc("and","iR",sp_and); X SPdeffunc("or","iR",sp_or); X} X X/* end */ END_OF_FILE if test 919 -ne `wc -c <'mathsubs.c'`; then echo shar: \"'mathsubs.c'\" unpacked with wrong size! fi # end of 'mathsubs.c' fi if test -f 'parse.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'parse.c'\" else echo shar: Extracting \"'parse.c'\" $7791 characters$ sed "s/^X//" >'parse.c' <<'END_OF_FILE' X/* parse.c - parsing routines X * X * 29.Sep.87 jimmc Code start X * 4.Nov.87 jimmc Add setjmp stuff X * 30.Nov.87 jimmc Lint cleanup X */ X/* LINTLIBRARY */ X X#include <stdio.h> X#include <ctype.h> X#include <strings.h> X#include "goto.h" X#include "xalloc.h" X#include "spin.h" X#include "spinparse.h" X Xextern char *sprintf(); /* make lint happy */ X XSPtoken *__tmptoken; X Xextern int SPtokenival; Xextern float SPtokenfval; Xextern char *SPtokenpval; X Xextern char *SPerrorstr; X Xchar *SPprompt1 = ">"; Xchar *SPprompt2 = ">>"; X Xstatic char *parseerr="ParsingError"; X XSPfgets(info,t) XSPstreaminfo *info; /* what to read from */ Xint t; /* offset into linebuf */ X{ Xchar *dst, *src; Xint i; X X switch (info->type) { X case 'f': /* file */ X fgets(info->SPlinebuf+t,info->SPlinebufsize-t,info->stream); X if (feof(info->stream)) info->eofflag=1; X break; X case 's': /* string */ X dst = info->SPlinebuf+t; X src = info->stringget; X if (! *src) { X info->eofflag=1; X *dst = 0; X break; X } X for (i=0; i<info->SPlinebufsize-t; i++) { X *dst++ = *src++; X if (dst[-1]==0) { X info->eofflag=1; X break; X } X if (dst[-1]=='\n') { X *dst = 0; X break; X } X } X if (i>=info->SPlinebufsize-t) *dst=0; X info->stringget = src; X break; X default: /* error */ X SPescape("BadStreamType","bad type %c in SPfgets", info->type); X /* NOTREACHED */ X } X} X Xvoid /* reads data info SPlinebuf in info structure */ XSPgetline(info) /* read an arbitrarily long line from the stream */ XSPstreaminfo *info; /* what to read from */ X{ X int t, l; X static char *mmsg="SP line buffer"; X X if (info->SPlinebufsize==0) { X info->SPlinebufsize = 120; /* a starting point */ X info->SPlinebuf = XALLOCM(char,info->SPlinebufsize,mmsg); X } X info->SPlinebuf[info->SPlinebufsize-1]=0; X /* set to null so we can check it */ X info->SPlinebuf[info->SPlinebufsize-2]=0; X info->SPlinebuf[0]=0; X t = 0; /* first read goes into start of buffer */ X if (info->stream==stdin) { X fputs(SPprompt1,stdout); X } X while (1) { /* exit from the loop with a break statement */ X SPfgets(info,t); X l = strlen(info->SPlinebuf+t)+t; /* len of string */ X if (l<info->SPlinebufsize-1) { /* buffer not full */ X /* info->SPlinebuf[l] is null char */ X if (info->SPlinebuf[l-1]=='\n' X && info->SPlinebuf[l-2]=='\\') { X /* continuation line */ X t = l-2; /* new chars overwrite backslash */ X info->SPlineno++; X if (info->stream==stdin) { X fputs(SPprompt2,stdout); X } X goto readmore; X } X else break; /* done reading */ X } X else if (info->SPlinebuf[l-1]=='\n') break; X /* buffer full, but ends with newline, so we're done */ X X /* buffer is full; expand buffer and read more */ X t = l; /* this is where new piece should start */ X info->SPlinebufsize *=2; /* try twice the size */ X info->SPlinebuf = XREALLOCM(char, X info->SPlinebuf,info->SPlinebufsize,mmsg); Xreadmore: X info->SPlinebuf[t]=0; X info->SPlinebuf[info->SPlinebufsize-1]=0; X info->SPlinebuf[info->SPlinebufsize-2]=0; X } X/* We now have the complete line in info->SPlinebuf, X * no matter how long it was! X */ X info->SPlineno++; X} X Xvoid XSPparseline(info) /* parse and execute the line in info->SPlinebuf */ XSPstreaminfo *info; X{ X X SPtokenize(info); /* break the line into tokens */ X SPlistize(info); /* convert parens into nested lists */ X} X Xvoid XSPtokenize(info) XSPstreaminfo *info; X{ Xint t; XSPtoken *tk, *lasttk; X X SPlexinit(info); /* init the lex parser */ X info->tokenlist = NIL; X lasttk = NIL; X while ((t=yylex())) { X ALLOCTOKEN(tk) X if (!info->tokenlist) { X info->tokenlist = tk; X } X if (lasttk) X lasttk->next = tk; X tk->next = NIL; /* put on end of token list */ X lasttk = tk; X tk->type = t; X switch (t) { X case SPTokStr: X case SPTokName: X tk->value.s = XALLOCM(char,strlen(SPtokenpval)+1, X "token string"); X strcpy(tk->value.s,SPtokenpval); X break; X case SPTokInt: X tk->value.n = SPtokenival; X break; X case SPTokFloat: X tk->value.f = SPtokenfval; X break; X default: break; X } X } X} X XSPtoken * XSPmklist(tklist) /* makes a balanced list, returns excess at end */ XSPtoken *tklist; X{ XSPtoken *prevtk, *newtk; X X prevtk = NIL; X while (tklist) { X switch (tklist->type) { X case SPTokRP: /* right paren */ X case SPTokSM: /* semicolon */ X if (prevtk) prevtk->next = NIL; X return tklist; X case SPTokLP: /* left paren - nested list */ X tklist->type = SPTokList; /* convert type to list */ X tklist->value.l = tklist->next; X if (!tklist->next) { /* error */ X SPescape(parseerr, X "open paren at end of input"); X /* NOTREACHED */ X } X newtk = SPmklist(tklist->next); X if (tklist->value.l == newtk) { X tklist->value.l = NIL; X } X if (newtk) { X if (newtk->type==SPTokSM) { X tklist->next = newtk; X newtk->type = SPTokLP; X } X else { X tklist->next = newtk->next; X FREETOKEN(newtk) /* release the CP */ X } X } X else { X tklist->next = NIL; X } X break; X default: X break; X } X prevtk = tklist; X tklist = tklist->next; X } X return NIL; X} X Xvoid XSPlistize(info) /* convert paren and semi tokens into lists */ XSPstreaminfo *info; X{ XSPtoken *tklist, *newtk; X X tklist = info->tokenlist; X newtk = SPmklist(tklist); /* make a balanced list */ X while (newtk && newtk->type == SPTokSM) { X tklist->next = newtk->next; X tklist = tklist->next; X newtk = SPmklist(tklist); X } X if (newtk) { X SPescape(parseerr,"unbalanced close parenthesis"); X /* NOTREACHED */ X } X/* make a list out of the top level */ X ALLOCTOKEN(newtk) X newtk->type = SPTokList; X newtk->next = NIL; X newtk->value.l = info->tokenlist; X info->tokenlist = newtk; X} X XSPtoken * XSPparseinfo(info) XSPstreaminfo *info; X{ XSPtoken *rval, *SPexeclist(); X X rval = NIL; X info->eofflag = 0; X while (!info->eofflag) { X SPgetline(info); /* read in a line */ X if (!info->SPlinebuf[0]) break; /* EOF */ X SPparseline(info); /* parse one line */ X if (rval) FREETOKEN(rval) X rval = SPexeclist(info->tokenlist); /* execute it */ X if (info->stream==stdin) { X if (rval && rval->type!=SPTokNil) X SPprintval(stdout,rval,0); X } X } X if (info->SPlinebuf) XFREE(info->SPlinebuf); X XFREE(info); X return rval; X} X XSPtoken * /* returns a token which is the top value from X * the value stack for this level. */ XSPparsefile(stream) XFILE *stream; /* where to read input from */ X{ XSPstreaminfo *info; X X info = XCALLOCM(SPstreaminfo,1,"stream info structure"); X info->stream = stream; X info->type = 'f'; X return SPparseinfo(info); /* frees info when done */ X} X XSPtoken * /* same as SPparsestream */ XSPparsestring(str) Xchar *str; X{ XSPstreaminfo *info; X X info = XCALLOCM(SPstreaminfo,1,"stream info structure"); X info->string = info->stringget = str; X info->type = 's'; X return SPparseinfo(info); /* frees info when done */ X} X Xint /* returns 0 if no errors, 1 if error */ XSPmainfile(stream) XFILE *stream; X{ Xjmp_buf jbuf; XSPtoken *rval; X X SPjbufp = jmpbuf_addr(jbuf); X while (1) { X if (setjmp(jbuf)) { /* uncaught goto */ X fprintf(stderr,"Uncaught goto: %s\n", SPgotolabel); X if (SPerrorstr) fprintf(stderr,"%s\n", SPerrorstr); X XFREE(SPgotolabel); X if (feof(stream)) return 1; X } X else { /* normal execution */ X rval = SPparsefile(stream); X if (rval) FREETOKEN(rval); X if (feof(stream)) return 0; X } X } X} X Xint /* returns 0 if no errors, 1 if error */ XSPmainstring(str) Xchar *str; X{ Xjmp_buf jbuf; XSPtoken *rval; X X SPjbufp = jmpbuf_addr(jbuf); X if (setjmp(jbuf)) { /* uncaught goto */ X fprintf(stderr,"Uncaught goto: %s\n", SPgotolabel); X if (SPerrorstr) fprintf(stderr,"%s\n", SPerrorstr); X XFREE(SPgotolabel); X return 1; /* error executing string */ X } X rval = SPparsestring(str); X if (rval) FREETOKEN(rval); X return 0; X} X X/* VARARGS1 */ XSPwerror(fmt,a0,a1,a2) Xchar *fmt; Xchar *a0,*a1,*a2; X{ Xchar buf[1000]; X X sprintf(buf,fmt,a0,a1,a2); X fprintf(stderr,"Warning: %s\n",buf); X} X X/* end */ END_OF_FILE if test 7791 -ne `wc -c <'parse.c'`; then echo shar: \"'parse.c'\" unpacked with wrong size! fi # end of 'parse.c' fi if test -f 'spin.3' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'spin.3'\" else echo shar: Extracting \"'spin.3'\" $7690 characters$ sed "s/^X//" >'spin.3' <<'END_OF_FILE' X.\" spin.3 X.TH SPIN 3 " 1 March 1988" X.SH NAME Xspin \- simple programmable interface library X.SH SYNOPSIS X.br X#include "spin.h" X.sp 1 X% ld <your program etc.> spin.a X.br X.SH DESCRIPTION X.I Spin Xis a simple interpreter intended for use as a program development Xtool and modest programmable interface. XIt contains a parser and execution engine, with the ability to Xeasily extend the basic engine with additional features such Xas control constructs or new operations. X.LP XThe spin interpreter has been set up to be usable in a bare-bones Xconfiguration, in which there are almost no capabilities or functions Xavailable other than application-specific ones. XThere are also a set of various simple extensions available Xwhich raise the application-independent capabilities of spin up Xto a level where it is almost usable by itself. XThe intent is for the application to add whatever application-specific Xfunctions it needs and to select the level of application-independent Xsupport needed. XThe spin library was designed to be modular enough that the application Xprogram could pick and choose among almost all of the aspects of the Xinterpreter. XIf there is a capability which is not needed, it does not need to Xbe loaded. XIf there is a capability which the programmer feels he can implement Xbetter, it is typically a fairly simple job for him to rewrite that Xcapability without worrying about other parts of the system. X.LP XIn addition to the generic extensions, an application program can Xadd whatever application-specific functions are desired. XEach function requires a one-line call to one of the spin Xprimitives, to be executed during program startup time. XOnce this has been done, the function is available to the user Xof the application. X.LP XThere are a small number of data types known to spin (e.g. int, Xfloat, string), which can be specified as the argument and return Xtypes for functions. XThe spin interpreter will do type checking on all arguments Xpassed to functions. X.LP XTo use spin, a program need only link with the spin library and Xcall the appropriate initialization routines during startup. X.SH BASIC FUNCTIONS X.LP XThe minimal program requires a call to one of two functions: XSPmainfile or SPmainstring. XThese routines will parse and execute a stream (FILE *) or string X(respectively) until EOF or EOS. XHowever, if the main program never invokes any other spin primitive, Xthere will not be any legal functions available for the parsed code Xto call! XThere are two ways to initialize functions: Xby calling the initialization routines for one of the Xapplication-independent packages, or by adding Xapplication-specific functions by calling SPdeffunc. XThe complete set of application-independent packages can be loaded Xby calling SPinitsubs. XTypically an application will call SPdeffunc a number of times X(once for each of its functions), and will call either SPinitsubs Xor a subset of the functions SPinitsubs calls. X.SH DATA TYPES X.LP XThe spin interpreter understands the following data types: Xnil, integer, float, string, and list. XBecause there are no built-in operations, there are also no Xbuilt-in conversions (nor for that matter any built-in explicit Xcasting mechanism!). XNote in particular that there is no automatic conversion between Xint and float: if a program is expecting an int, passing a float Xto it will cause an error. XThe one exception to this is that all types have an interpretation Xas a boolean, so that any variable can be directly used as a boolean Xto a function which is expecting a boolean. X.SH ARGUMENT AND RETURN TYPES AND DEFAULTS X.LP XIn the SPdeffunc call, the second argument is a string which encodes Xthe types of the return value and arguments of a function. XThe first character specifies the return type of the function, the Xremainder specify the types of each consecutive argument. XThe list is terminated by a null (EOS) or by a semicolon. X(In the future, spin will probably accept some descriptive text Xafter a semicolon which gives names for each of the arguments.) XTypically, the type of an argument is represented by a single Xcharacter. XIn some cases, a default can also be included, in which case it Xappears immediately after the type character. X.LP XThe valid argument type code characters are: X.TP Xb - boolean XAny type can be passed to a function expecting a boolean; the value Xwill be cast to a boolean, and the function will receive an integer Xzero or one. X.TP Xi - integer X.TP XI - optional integer XThe default value immediately follows the I, such as "I0" or "I-99". X.TP Xf - float X.TP Xn - name XA name is a subset of string; it can not contain any characters other Xthan alphanumerics (with leading alpha) or underscore, and it may be Xspecified within quotes or with no quotes. X.TP Xs - string X.TP XS - optional string XThe default value immediately follows the S, X.I "in double quotes" X(remember to escape the quotes with backslashes). XFor example, "S\"foo\"". X.TP XV - untyped variable XA single evaluated variable of any type (passed to the application Xfunction as a spin token). X.TP XL - a list variable XA single unevaluated token. XThis if useful for building such things as the "if" construct, in Xwhich only one of the clauses should be executed. X.TP XR - remainder XThe remainder of the arguments as a list, unevaluated. X.LP XThe valid return type code characters are: X.TP Xi - integer X.TP Xv - void XThis is used when the function returns no value. XAny value returned by the function is ignored. X.TP Xf - float X.TP Xn - name X.TP Xs - static string XSpin will make an allocated copy of a static string, so functions Xmay return pointers to internal buffers which are overwritten on Xthe next call. X.TP XS - allocated string XThis code is used when the function allocates the string using malloc Xand returns it. XSpin will not make a copy of the string, but will assume that it owns Xit from then on. X.TP XV - allocated variable XThe function allocates a spin token and returns it as the value of Xthe function. XSpin will assume that it owns the token from then on. XA function can use this type to return a value of arbitrary type. X.TP Xl - static list of variables XSpin will make a copy of the list, as with the "s" type. X.TP XL - allocated list of variables XSpin assumes the entire list belongs to it from then on, as with the "S" type. X.SH ERRORS AND GOTO XThe spin routines handle exceptions by executing a "goto" to a label Xwhich is different depending on what the exception is. XIf this label is defined, execution continues at that point; if not, Xexecution terminates, and the label is printed along with an error Xmessage. XNote that this mechanism involves the function execution extension Xto the core, so any programmer implementing his own function execution Xshould be sure to include this aspect. X.SH BUGS X.LP XThe documentation is too skimpy. X.LP XThe data types are not one of the easily-changed aspects of spin; Xthey are pretty firmly wired into the core interpreter. X.LP XThe argument and return type codes are not particularly consistent Xor complete. X.LP XThe implementations of variables and functions should be considered Xonly as an example of how this kind of extension could be added to Xthe basic interpreter. XThese implementations are decidedly inferior in both performance and Xfunctionality, but they do show how such a thing could be done. X.LP XThere are lots of memory leaks; garbage collection is probably Xthe way to go. X.LP XThe parser is line-oriented, so has problems with things like Xmulti-line comments. This definitely needs to be improved. X.LP XThe syntax should be that of some previously defined language. X.LP XThis whole package could be replaced by a simple Lisp package that Xcould be linked with an application, but I don't have one handy. END_OF_FILE if test 7690 -ne `wc -c <'spin.3'`; then echo shar: \"'spin.3'\" unpacked with wrong size! fi # end of 'spin.3' fi if test -f 'spin.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'spin.h'\" else echo shar: Extracting \"'spin.h'\" $1086 characters$ sed "s/^X//" >'spin.h' <<'END_OF_FILE' X/* spin.h - application programs using spin should include this file. X * X * 16.Oct.87 jimmc Initial definition X */ X X/* xalloc.h must also be included in order to use the ALLOC/FREE macros */ X X#define NIL 0 X#define void int X /* void is broken */ X Xtypedef struct _SPtoken { /* one token */ X int type; /* token type */ X#define SPTokNil 'N' /* the NIL type */ X#define SPTokInt 'i' X#define SPTokFloat 'f' X#define SPTokStr 's' X#define SPTokName 'n' X#define SPTokList 'l' X#define SPTokLP '(' X#define SPTokRP ')' X#define SPTokSM ';' X union { X int n; /* integer values */ X float f; /* float values */ X char *s; /* string and name values */ X struct _SPtoken *l; /* list values */ X } value; X struct _SPtoken *next; /* for tokens in a list */ X} SPtoken; X Xextern SPtoken *__tmptoken; /* for ALLOC and FREE macros */ X X#define ALLOCTOKEN(_tk_) { \ X _tk_ = XALLOC(SPtoken,1); \ X} X X#define FREETOKEN(_tk_) { \ X XFREE(_tk_); \ X _tk_ = NIL; \ X} X X#define FREETOKENLIST(_tk_) { \ X while (_tk_) { \ X __tmptoken = _tk_->next; \ X XFREE(_tk_); \ X _tk_ = __tmptoken; \ X } \ X _tk_ = NIL; \ X} X X/* end */ END_OF_FILE if test 1086 -ne `wc -c <'spin.h'`; then echo shar: \"'spin.h'\" unpacked with wrong size! fi # end of 'spin.h' fi if test -f 'spinparse.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'spinparse.h'\" else echo shar: Extracting \"'spinparse.h'\" $558 characters$ sed "s/^X//" >'spinparse.h' <<'END_OF_FILE' X/* spinparse.h - internal include file for spin parser X * X * 20.Oct.87 jimmc Add string stuff X */ X Xtypedef struct _SPstreaminfo { X int type; /* 's' for string, 'f' for stream (file) */ X int eofflag; /* set when no more chars in input */ X FILE *stream; X char *string; X char *stringget; /* points into string */ X char *SPlinebuf; X int SPlinebufsize; X int SPlineno; X SPtoken *tokenlist; /* the line parsed into tokens */ X SPtoken *execlist; /* list of tokens being executed */ X SPtoken *valuelist; /* list of values in the stack */ X} SPstreaminfo; X X/* end */ END_OF_FILE if test 558 -ne `wc -c <'spinparse.h'`; then echo shar: \"'spinparse.h'\" unpacked with wrong size! fi # end of 'spinparse.h' fi if test -f 'varsubs.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'varsubs.c'\" else echo shar: Extracting \"'varsubs.c'\" $2638 characters$ sed "s/^X//" >'varsubs.c' <<'END_OF_FILE' X/* varsubs.c - set/get variable values for spin X * X * 16.Oct.87 jimmc Initial definition X * 21.Oct.87 jimmc Add fset, fdeclare, fget X * 5.Nov.87 jimmc Use SPescape instead of SPwerror X * 30.Nov.87 jimmc Lint cleanup X */ X/* LINTLIBRARY */ X X#include <strings.h> X#include "xalloc.h" X#include "spin.h" X Xextern SPtoken *SPexec(); X Xtypedef struct _SPvarinfo { X char *name; /* name of the variable */ X SPtoken *val; /* value as a token */ X struct _SPvarinfo *next; X} SPvarinfo; X XSPvarinfo *SPvarbase; X Xstatic char *badvaruse="BadVarUse"; Xstatic char *badvardecl="BadVarDecl"; Xstatic char *badvarref="BadVarRef"; X XSPvarinfo * Xsp_iget(name) Xchar *name; X{ XSPvarinfo *vinfo; X X for (vinfo=SPvarbase;vinfo;vinfo=vinfo->next) X if (strcmp(vinfo->name,name)==0) return vinfo; X return NIL; X} X Xstatic Xsp_dodeclare(name) Xchar *name; X{ XSPvarinfo *vinfo; X X vinfo = XALLOCM(SPvarinfo,1,"sp_declare"); X vinfo->next = SPvarbase; X SPvarbase = vinfo; X vinfo->name = XALLOCM(char,strlen(name)+1,"declare name"); X strcpy(vinfo->name,name); X vinfo->val = NIL; X} X Xint Xsp_declare(name) Xchar *name; X{ XSPvarinfo *vinfo; X X vinfo = sp_iget(name); X if (vinfo) { X SPescape(badvardecl,"%s already declared",name); X /* NOTREACHED */ X } X sp_dodeclare(name); X return 1; X} X Xint Xsp_fdeclare(name) Xchar *name; X{ X X if (!sp_iget(name)) sp_dodeclare(name); X return 1; X} X XSPtoken * Xsp_set(name,value) Xchar *name; XSPtoken *value; X{ XSPvarinfo *vinfo; X X vinfo = sp_iget(name); X if (!vinfo) { X/* for auto-declaration, simply call sp_declare(name) here instead X * of delivering the error message */ X SPescape(badvaruse,"variable %s set but not declared",name); X /* NOTREACHED */ X } X FREETOKEN(vinfo->val) X vinfo->val = value; X return value; X} X XSPtoken * Xsp_fset(name,value) Xchar *name; XSPtoken *value; X{ XSPvarinfo *vinfo; X X (void)sp_fdeclare(name); X vinfo = sp_iget(name); X if (!vinfo) { X/* should never happen, since we called sp_fdeclare first */ X SPescape(badvaruse,"variable %s set but not declared",name); X /* NOTREACHED */ X } X FREETOKEN(vinfo->val) X vinfo->val = value; X return value; X} X XSPtoken * Xsp_get(name) Xchar *name; X{ XSPvarinfo *vinfo; X X vinfo = sp_iget(name); X if (!vinfo) { X SPescape(badvarref, X "variable %s referenced but not declared",name); X /* NOTREACHED */ X } X return vinfo->val; X} X XSPtoken * Xsp_fget(name) Xchar *name; X{ XSPvarinfo *vinfo; X X vinfo = sp_iget(name); X if (!vinfo) return NIL; X return vinfo->val; X} X XSPinitvars() X{ X SPdeffunc("declare","in",sp_declare); X SPdeffunc("fdeclare","in",sp_fdeclare); X SPdeffunc("set","lnV",sp_set); X SPdeffunc("fset","lnV",sp_fset); X SPdeffunc("get","ln",sp_get); X SPdeffunc("fget","ln",sp_fget); X} X X/* end */ END_OF_FILE if test 2638 -ne `wc -c <'varsubs.c'`; then echo shar: \"'varsubs.c'\" unpacked with wrong size! fi # end of 'varsubs.c' fi if test -f 'xalloc.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'xalloc.c'\" else echo shar: Extracting \"'xalloc.c'\" $2363 characters$ sed "s/^X//" >'xalloc.c' <<'END_OF_FILE' X/* xalloc - allocate memory, give error message and die if no more X * Written by Jim McBeath (jimmc) at SCI X * X * 3.Jun.86 jimmc X * 18.Sep.87 jimmc Add xcalloc X * 22.Sep.87 jimmc Allow null msg strings X * 5.Nov.87 jimmc Change xalloc to xallocm etc.; X * add new xalloc, xcalloc, xrealloc X * 30.Nov.87 jimmc Lint cleanup X */ X/* LINTLIBRARY */ X X#include <stdio.h> X X#define ERROR_EXIT 1 X#define NULLCP (char *)NULL X Xextern char *malloc(), *calloc(), *realloc(); X Xextern char *Progname; X Xstatic int totalused=0; /* only true if no frees performed */ X Xchar * Xxalloc( size ) Xint size; /* number of bytes to allocate */ X{ Xchar *x; X X x = malloc( (unsigned)size ); X if (x==0) xnomem(NULLCP,size); X totalused += size; X return x; X} X Xchar * Xxallocm( size, msg ) Xint size; /* number of bytes to allocate */ Xchar *msg; /* error string */ X{ Xchar *x; X X x = malloc( (unsigned)size ); X if (x==0) xnomem(msg,size); X totalused += size; X return x; X} X Xchar * Xxcalloc( size ) /* NOTE ARGS NOT SAME AS calloc()! */ Xint size; /* number of bytes to allocate */ X{ Xchar *x; X X x = calloc( (unsigned)size, 1 ); X if (x==0) xnomem(NULLCP,size); X totalused += size; X return x; X} X Xchar * Xxcallocm( size, msg ) /* NOTE ARGS NOT SAME AS calloc()! */ Xint size; /* number of bytes to allocate */ Xchar *msg; /* error string */ X{ Xchar *x; X X x = calloc( (unsigned)size, 1 ); X if (x==0) xnomem(msg,size); X totalused += size; X return x; X} X Xchar * Xxrealloc( ptr, size ) Xchar *ptr; /* old pointer */ Xint size; /* number of bytes to allocate */ X{ Xchar *x; X X x = realloc( ptr, (unsigned)size ); X if (x==0) xnomem(NULLCP,size); X totalused += size; /*** not quite accurate! */ X return x; X} X Xchar * Xxreallocm( ptr, size, msg ) Xchar *ptr; /* old pointer */ Xint size; /* number of bytes to allocate */ Xchar *msg; /* error string */ X{ Xchar *x; X X x = realloc( ptr, (unsigned)size ); X if (x==0) xnomem(msg,size); X totalused += size; /*** not quite accurate! */ X return x; X} X Xstatic Xxnomem(msg,size) Xchar *msg; Xint size; X{ Xchar *nomemmsg="No more memory"; X X if (msg) X fprintf(stderr,"\n%s: %s (%s)\n", Progname, nomemmsg, msg); X else X fprintf(stderr,"\n%s: %s\n", Progname, nomemmsg); X X#if 0 /* not accurate! */ X fprintf(stderr,"Previously used: %d; this request: %d\n", X totalused, size); X#else X fprintf(stderr,"Requested memory size: %d\n", size); X#endif X exit(ERROR_EXIT); X} X X/* end */ END_OF_FILE if test 2363 -ne `wc -c <'xalloc.c'`; then echo shar: \"'xalloc.c'\" unpacked with wrong size! fi # end of 'xalloc.c' fi if test -f 'xalloc.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'xalloc.h'\" else echo shar: Extracting \"'xalloc.h'\" $959 characters$ sed "s/^X//" >'xalloc.h' <<'END_OF_FILE' X/* xalloc.h - defines for use with xalloc.c X * X * 18.Sep.87 jimmc Collected into xalloc.h X * 22.Sep.87 jimmc Add XFREE, XALLOCD etc. X * 21.Oct.87 jimmc Change XALLOC to XALLOCM, XALLOCD to XALLOC etc. X * 6.Nov.87 jimmc call xallocm instead of xalloc, etc. X */ X X#ifndef XALLOCINCLUDED X#define XALLOCINCLUDED X Xextern char *xalloc(), *xcalloc(), *xrealloc(); Xextern char *xallocm(), *xcallocm(), *xreallocm(); X X#define XALLOC(item, count ) (item *)xalloc(sizeof(item)*(count)) X#define XCALLOC(item, count ) (item *)xcalloc(sizeof(item)*(count)) X#define XREALLOC(item, old, count ) \ X (item *)xrealloc((char *)(old),sizeof(item)*(count)) X X#define XFREE(old) free((char *)(old)); X X#define XALLOCM(item, count, msg) (item *)xallocm(sizeof(item)*(count),msg) X#define XCALLOCM(item, count, msg) (item *)xcallocm(sizeof(item)*(count),msg) X#define XREALLOCM(item, old, count, msg) \ X (item *)xreallocm((char *)(old),sizeof(item)*(count),msg) X#endif X X/* end */ END_OF_FILE if test 959 -ne `wc -c <'xalloc.h'`; then echo shar: \"'xalloc.h'\" unpacked with wrong size! fi # end of 'xalloc.h' fi echo shar: End of archive 1 $of 2$. cp /dev/null ark1isdone MISSING="" for I in 1 2 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked both archives. rm -f ark[1-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0