├── AUTHORS ├── LICENSE ├── README ├── READ_ME_SOLARIS ├── evaluator ├── (null).uc ├── bug.c ├── dump.c ├── dynamic.c ├── f_alg.c ├── f_decls.c ├── f_flucid.c ├── f_lucid.c ├── f_vars.c ├── iglobals.h ├── imanifs.h ├── input.c ├── list.c ├── main.c ├── makefile ├── memory.c ├── old_flucid.c ├── real.c ├── rupture.c ├── string.c ├── test ├── test.i └── util.c ├── lucid ├── makefile ├── manual ├── READ_ME ├── abstract.B ├── benson ├── contents.C ├── datatypes.G ├── expressions.E ├── frontpage ├── grammar.L ├── introduction.D ├── lucid.1 ├── prec.K ├── scope.H ├── tabsandrules.J ├── udf.F └── unix.I ├── p1 ├── cglobals.h ├── cmanifs.h ├── expr.c ├── flucid.y ├── main.c ├── main.c.orig ├── makefile └── yylex.c ├── p2 ├── cglobals.h ├── cmanifs.h ├── expr.c ├── main.c ├── makefile ├── pass2 ├── tree.y └── yylex.c ├── p3 ├── cglobals.h ├── cmanifs.h ├── expr.c ├── main.c ├── makefile ├── tree.y └── yylex.c ├── p4 ├── cglobals.h ├── cmanifs.h ├── expr.c ├── main.c ├── makefile ├── tree.y ├── walk.c └── yylex.c ├── p5 ├── cglobals.h ├── cmanifs.h ├── expr.c ├── ftable.h ├── ident.c ├── main.c ├── makefile ├── tree.y └── yylex.c ├── progs ├── ack ├── eg10.l ├── eg10.l.i ├── eg10.l.i.uc ├── eg11.l ├── eg12.l ├── eg13.l ├── eg14.l ├── eg15.l ├── eg16.l ├── eg17.l ├── eg19.l ├── eg20.l ├── eg22.l ├── eg4.l ├── eg4.l.i ├── eg4.l.i.uc ├── eg5.l ├── eg6.l ├── eg7.l ├── eg8.l ├── eg9.l ├── gcd ├── qsort ├── r100 ├── recp ├── recprime ├── rms ├── roote ├── set ├── sieve ├── sort ├── square ├── square.i ├── sum ├── t ├── t.l ├── try └── words └── shell_scripts ├── READ_ME ├── lucid └── lucomp /AUTHORS: -------------------------------------------------------------------------------- 1 | This is the code for the original interpreter as made available by 2 | Prof: Bill Wadge it was written by Dr. Tony Faustini. 3 | 4 | Made to work at least a little on 32 bit OS X by Marcel Weiher. 5 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | If you have Berkely 4.2 or System 5 or SUN O/S Version 4 2 | you should have little trouble with installating 3 | this on a 32 bit machine (see READ_ME in the evaluator directory). 4 | 5 | If you are not running on UNIX or a UNIX-like system you will have 6 | to do a little work to get your Lucid interpreter working. In particular 7 | the directories p1 to p5 each produce a pass or filter each sucessive 8 | piping (in the UNIX sense) its input to the next. The code within 9 | each pass is reasonably straight forward. If you have a yacc of Your 10 | own you may want to 11 | remove the y.tab.c and y.tab.h directories and use your 12 | own yacc to generate these. If you do not have yacc you can use the 13 | y.tab.c and y.tab.h provided. 14 | 15 | There are 9 subdirectories: 16 | p1 :Source for filter1 (lucid -> lucid parse tree(pt)) 17 | i.e. checks for syntax errors. 18 | p2 :Source for filter2 (lucid pt -> lucid pt) 19 | checks for nameclashes 20 | p3 :Source for filter3 (lucid pt -> lucid pt) 21 | expands upon and whenever. 22 | p4 :Source for filter4(lucid pt->structured lucid pt) 23 | p5 :Source for filter5 (s-lucid pt -> lucid i-code) 24 | evaluator :Source for the lucid evaluator 25 | manual :lucid programming manual/UNIX manual entry 26 | progs :Example lucid programs 27 | shell_scripts :Scripts for compiling and/or running 28 | lucid programs 29 | 30 | 31 | Installing lucid 32 | ================ 33 | 34 | In directory p1 change the third line of file main.c to some 35 | appropriate directory. It is currently 36 | 37 | STRING incdir = "/usr/local/lib/plucid"; 38 | 39 | If you are running Berkley UNIX 4.2bsd or have the 40 | make facility then all you then 41 | do is to type 42 | 43 | make all "DESTDIR=/the/directory/where/you/want/your/binary/progs" 44 | 45 | the makefile in this directory will do the rest. 46 | 47 | E.g. at ASU we would enter 48 | 49 | make all "DESTDIR=/usr/local/bin" 50 | 51 | 52 | -------------------------------------------------------------------------------- /READ_ME_SOLARIS: -------------------------------------------------------------------------------- 1 | Notes on the changes made to make this compile under Solaris 2 | ------------------------------------------------------------ 3 | 4 | 1) Variable name "const" systematically changed to "cconst" 5 | in the following files: 6 | p2/cglobals.h 7 | p2/main.c 8 | p2/yylex.c 9 | p3/cglobals.h 10 | p3/main.c 11 | p3/yylex.c 12 | p4/cglobals.h 13 | p4/main.c 14 | p4/yylex.c 15 | p5/cglobals.h 16 | p5/main.c 17 | p5/yylex.c 18 | 19 | 2) Function name "remove" systematically changed to "rremove" 20 | in the following file: 21 | p4/walk.c 22 | 23 | 3) "hashtable" array size increased by one to avoid range errors 24 | (in p5/cglobals.h): 25 | 28c28 26 | < SYMPTR hashtable[HASHSIZE]; 27 | --- 28 | > SYMPTR hashtable[HASHSIZE+1]; 29 | 30 | 4) malloc added to avoid writing past end of "fname" string 31 | (in p5/main.c): 32 | 60c60,62 33 | < sprintf(fname,"%s.i",fname); 34 | --- 35 | > /* sprintf(fname,"%s.i",fname); */ 36 | > fname = malloc(strlen(fname+3)); 37 | > sprintf(fname,"%s.i",argv[1]); 38 | 39 | 5) FILE * added to "fprintf", to avoid stupidity 40 | (in evaluator/f_alg.c): 41 | 786c786 42 | < default: fprintf("unknown type\n"); 43 | --- 44 | > default: fprintf(stderr,"unknown type\n"); 45 | -------------------------------------------------------------------------------- /evaluator/(null).uc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mpw/pLucid-osx/59970fabba8008d6c63589e501a56d7c6bf2f7b0/evaluator/(null).uc -------------------------------------------------------------------------------- /evaluator/bug.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mpw/pLucid-osx/59970fabba8008d6c63589e501a56d7c6bf2f7b0/evaluator/bug.c -------------------------------------------------------------------------------- /evaluator/f_decls.c: -------------------------------------------------------------------------------- 1 | #include "imanifs.h" 2 | #include "iglobals.h" 3 | int f_all(); 4 | int f_elt(); 5 | int f_first(); 6 | int f_next(); 7 | int f_pred(); 8 | int f_prev(); 9 | int f_fby(); 10 | int f_before(); 11 | int f_asa(); 12 | int f_now(); 13 | int f_attime(); 14 | int f_initial(); 15 | int f_succ(); 16 | int f_cby(); 17 | int f_sby(); 18 | int f_whr(); 19 | int f_here(); 20 | int f_atspace(); 21 | int f_noriginal(); 22 | int f_nrest(); 23 | int f_original(); 24 | int f_rest(); 25 | int f_aby(); 26 | int f_swap(); 27 | int f_lshift(); 28 | int f_rshift(); 29 | 30 | int f_chr(); 31 | int f_isatom(); 32 | int f_ord(); 33 | int f_hd(); 34 | int f_tl(); 35 | int f_cons(); 36 | int f_nil(); 37 | int f_islist(); 38 | int f_isnil(); 39 | int f_exp(); 40 | int f_arg(); 41 | int f_filter(); 42 | int f_log10(); 43 | int f_abs(); 44 | int f_tan(); 45 | int f_sqrt(); 46 | int f_cxfile(); 47 | int f_index(); 48 | int f_mknumber(); 49 | int f_length(); 50 | int f_iserror(); 51 | int f_error(); 52 | int f_input(); 53 | int f_isnumber(); 54 | int f_uminus(); 55 | int f_not(); 56 | int f_and(); 57 | int f_or(); 58 | int f_num2(); 59 | int f_log2(); 60 | int f_eq(); 61 | int f_ne(); 62 | int f_const(); 63 | int f_word(); 64 | int f_swchar(); 65 | int f_if(); 66 | int f_var(); 67 | int f_local(); 68 | int f_fcall(); 69 | int f_eres(); 70 | int f_cos(); 71 | int f_sin(); 72 | int f_log(); 73 | int f_iseod(); 74 | int f_scons(); 75 | int f_isstring(); 76 | int f_isword(); 77 | int f_strconc(); 78 | int f_substr(); 79 | int f_append(); 80 | int f_eod(); 81 | int f_mkword(); 82 | int f_mkstring(); 83 | int f_real(); 84 | int f_imag(); 85 | int f_complex(); 86 | 87 | FITEM ftable[] = { 88 | {"eres", 1, f_eres, TERMINAL}, 89 | {"var", 3, f_var, TERMINAL}, 90 | {"input", 1, f_input, TERMINAL}, 91 | {"local", 1, f_local, TERMINAL}, 92 | {"word", 1, f_word, TERMINAL}, 93 | {"fcall", 4, f_fcall, TERMINAL}, 94 | {"swchar", 1, f_swchar, TERMINAL}, 95 | {"const", 1, f_const, TERMINAL}, 96 | {"nil", 1, f_nil, TERMINAL}, 97 | {"cxfile", 4, f_cxfile, TERMINAL}, 98 | {"scons", 3, f_scons, INTERIOR}, 99 | {"wrd", 1, f_error, TERMINAL}, 100 | {"valof", 1, f_error, TERMINAL}, 101 | {"decl", 1, f_error, TERMINAL}, 102 | {"defn", 1, f_error, TERMINAL}, 103 | {"strg", 1, f_error, TERMINAL}, 104 | {"numb", 1, f_error, TERMINAL}, 105 | {"nullry", 1, f_error, TERMINAL}, 106 | {"nonnullry", 1, f_error, TERMINAL}, 107 | {"constant", 1, f_error, TERMINAL}, 108 | {"eglobal", 1, f_error, TERMINAL}, 109 | {"nglobal", 1, f_error, TERMINAL}, 110 | {"frmls", 1, f_error, TERMINAL}, 111 | {"op", 1, f_error, TERMINAL}, 112 | {"first", 2, f_first, INTERIOR}, 113 | {"next", 2, f_next, INTERIOR}, 114 | {"pred", 2, f_pred, INTERIOR}, 115 | {"prev", 2, f_prev, INTERIOR}, 116 | {"fby", 3, f_fby, INTERIOR}, 117 | {"before", 3, f_before, INTERIOR}, 118 | {"asa", 3, f_asa, INTERIOR}, 119 | {"now", 1, f_now, INTERIOR}, 120 | {"@t", 3, f_attime, INTERIOR}, 121 | {"initial", 2, f_initial, INTERIOR}, 122 | {"succ", 2, f_succ, INTERIOR}, 123 | {"sby", 3, f_sby, INTERIOR}, 124 | {"whr", 3, f_whr, INTERIOR}, 125 | {"here", 1, f_here, INTERIOR}, 126 | {"@s", 3, f_atspace, INTERIOR}, 127 | {"original", 2, f_original, INTERIOR}, 128 | {"noriginal", 2, f_noriginal, INTERIOR}, 129 | {"nrest", 2, f_nrest, INTERIOR}, 130 | {"rest", 2, f_rest, INTERIOR}, 131 | {"aby", 3, f_aby, INTERIOR}, 132 | {"cby", 3, f_cby, INTERIOR}, 133 | {"swap", 3, f_swap, INTERIOR}, 134 | {"rshift", 2, f_rshift, INTERIOR}, 135 | {"lshift", 2, f_lshift, INTERIOR}, 136 | {"all", 2, f_all, INTERIOR}, 137 | {"elt", 2, f_elt, INTERIOR}, 138 | {"isnumber", 2, f_isnumber, INTERIOR}, 139 | {"div", 3, f_num2, INTERIOR}, 140 | {"mod", 3, f_num2, INTERIOR}, 141 | {"and", 3, f_and, INTERIOR}, 142 | {"not", 2, f_not, INTERIOR}, 143 | {"or", 3, f_or, INTERIOR}, 144 | {"eq", 3, f_eq, INTERIOR}, 145 | {"ne", 3, f_ne, INTERIOR}, 146 | {"gt", 3, f_log2, INTERIOR}, 147 | {"ge", 3, f_log2, INTERIOR}, 148 | {"le", 3, f_log2, INTERIOR}, 149 | {"lt", 3, f_log2, INTERIOR}, 150 | {"sin", 2, f_sin, INTERIOR}, 151 | {"cos", 2, f_sin, INTERIOR}, 152 | {"log", 2, f_log, INTERIOR}, 153 | {"iseod", 2, f_iseod, INTERIOR}, 154 | {"isstring", 2, f_isstring, INTERIOR}, 155 | {"isword", 2, f_isword, INTERIOR}, 156 | {"substr", 4, f_substr, INTERIOR}, 157 | {"eod", 1, f_eod, TERMINAL}, 158 | {"arg", 2, f_arg, INTERIOR}, 159 | {"mkword", 2, f_mkword, INTERIOR}, 160 | {"mkstring", 2, f_mkstring, INTERIOR}, 161 | {"error", 1, f_error, TERMINAL}, 162 | {"iserror", 2, f_iserror, INTERIOR}, 163 | {"length", 2, f_length, INTERIOR}, 164 | {"mknumber", 2, f_mknumber, INTERIOR}, 165 | {"tan", 2, f_tan, INTERIOR}, 166 | {"log10", 2, f_log10, INTERIOR}, 167 | {"abs", 2, f_abs, INTERIOR}, 168 | {"sqrt", 2, f_sqrt, INTERIOR}, 169 | {"filter", 4, f_filter, INTERIOR}, 170 | {"cons", 3, f_cons, INTERIOR}, 171 | {"islist", 2, f_islist, INTERIOR}, 172 | {"isatom", 2, f_isatom, INTERIOR}, 173 | {"hd", 2, f_hd, INTERIOR}, 174 | {"tl", 2, f_tl, INTERIOR}, 175 | {"ord", 2, f_ord, INTERIOR}, 176 | {"chr", 2, f_chr, INTERIOR}, 177 | {"isnil", 2, f_isnil, INTERIOR}, 178 | {"complex", 2, f_complex, INTERIOR}, 179 | {"real", 2, f_real, INTERIOR}, 180 | {"imag", 2, f_imag, INTERIOR}, 181 | {"uminus", 2, f_uminus, INTERIOR}, 182 | {"plus", 3, f_num2, INTERIOR}, 183 | {"minus", 3, f_num2, INTERIOR}, 184 | {"times", 3, f_num2, INTERIOR}, 185 | {"if", 4, f_if, INTERIOR}, 186 | {"fdiv", 3, f_num2, INTERIOR}, 187 | {"strconc", 3, f_strconc, INTERIOR}, 188 | {"append", 3, f_append, INTERIOR}, 189 | {"arg", 2, f_arg, INTERIOR}, 190 | {"exp", 3, f_exp, INTERIOR}, 191 | }; 192 | -------------------------------------------------------------------------------- /evaluator/iglobals.h: -------------------------------------------------------------------------------- 1 | 2 | int false, true; 3 | #define MAXFUNCS 105 4 | #define copy(x,y) x = y 5 | 6 | FITEM ftable[MAXFUNCS]; 7 | 8 | 9 | /* 10 | * io stuff, and trace flags 11 | */ 12 | #define MAXWORDS 400 13 | #define MAXSTRINGS 400 14 | #define MAXOPENFILES 20 15 | #define MAXVARS 1000 16 | #define AVGWRDLEN 100 17 | #define MAXFILTERSPACE 400 18 | char *infilename; 19 | FILE *infile,*current_out,*current_in; 20 | #define TRACEQUAN 100 21 | int s_count,b_count,filterlevel,active_filters; 22 | int dc1,dc2,dc3,c1,c2,c3; 23 | int brecycle,srecycle,varcount,stpcount,memcount; 24 | int eodch,current_var; 25 | char evalerr,newout; 26 | char fnl,sflag,cflag,iflag,fflag,nflag,dflag,pflag, tflags[TRACEQUAN]; 27 | char filterp[30]; 28 | int errcount,notfoundcount; 29 | int open_file,file_var,current_strg,u_countvec[MAXVARS],retvec[MAXVARS]; 30 | int b_recquan,s_recquan,ddepth,current_inx,current_outx; 31 | int curr_in_mode,curr_out_mode,curr_point,curr_ign,conc; 32 | IOPTR io_info[MAXVARS],current_io; 33 | EXPRPTR filter_e[100]; 34 | #define STPHASHSIZE 1113 35 | #define PHASHSIZE 1113 36 | #define THASHSIZE 1113 37 | #define NHASHSIZE 1113 38 | #define SHASHSIZE 1113 39 | STPPTR phashtab[PHASHSIZE]; 40 | STPPTR thashtab[THASHSIZE]; 41 | STPPTR shashtab[SHASHSIZE]; 42 | MEMPTR nhashtab[NHASHSIZE]; 43 | int memargc; 44 | char **memargv; 45 | STPPTR outside; /* the time in the outside environment */ 46 | 47 | 48 | /* 49 | * run time stacks: 50 | * v_stack: value stack 51 | * d_stack: display stack 52 | * stp_stack: space-time-place stack 53 | */ 54 | 55 | #define VSIZE 500 56 | #define VStop v_top 57 | #define VSpush {if(v_top+1>= &v_stack[0]+2*VSIZE){printf("v_stack overflow\n"); exit(1); } v_top++; } 58 | #define VSpop v_top-- 59 | #define VStype v_top->v_type 60 | #define VSvalue v_top->v_value 61 | VALUE v_stack[VSIZE]; 62 | VALUEPTR v_top; 63 | 64 | #define DSIZE 2000 65 | DISPLAYITEM d_stack[DSIZE]; 66 | DISPLAYPTR d_top; 67 | 68 | #define STPSIZE 6000 69 | #define STPStop stp_top 70 | #define STPSpush { if(stp_top+1>&stp_stack[0]+2*STPSIZE) { printf("stp_stack overflow\n"); my_exit(1); } stp_top++; } 71 | #define STPSpop stp_top-- 72 | #define STPSt stp_top->stp_t 73 | #define STPSp stp_top->stp_p 74 | #define STPSs stp_top->stp_s 75 | #define STPSpushval(s,t,p) {STPSpush; STPSs = (s); STPSt = (t); STPSp = (p);} 76 | STPPAIR stp_stack[STPSIZE], *stp_top; 77 | 78 | unsigned filequan,exprquan,wordquan; 79 | STRING *nametable,*wordtable; 80 | EXPRPTR *filetable,*exprtable; 81 | char *ngc_allocbuf,*ngc_allocp; 82 | int ngc_allocsize; 83 | /* STPPTR safe; safe is used to hold a time in case */ 84 | int dynasizes[2]; 85 | int pid; 86 | int ch ; 87 | -------------------------------------------------------------------------------- /evaluator/imanifs.h: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | #define POP 999 7 | #define UNIX 1000 8 | #define CHILD 0 9 | #define SYSERR -1 10 | #define READ_END 0 11 | #define WRITE_END 1 12 | #define CHILD_IN 0 13 | #define CHILD_OUT 1 14 | #define IO_RECORD 11 15 | #define IOFILTER 100 16 | #define IFILE 101 17 | #define INPUT 102 18 | #define CLOSEDSTREAM -20 19 | #define F_FILE 9 20 | #define F_CONST 7 21 | #define F_FILTER 81 22 | #define F_INPUT 2 23 | #define F_PLUS 94 24 | #define F_MINUS 95 25 | #define F_TIMES 96 26 | #define F_DIV 51 27 | #define F_MOD 52 28 | #define F_RDIV 98 29 | #define F_LE 60 30 | #define F_GT 58 31 | #define F_LT 61 32 | #define F_GE 59 33 | #define rEXPRPTR register EXPRPTR 34 | #define swap_t0s0 0 35 | #define swap_t0s1 1 36 | #define swap_t0s2 2 37 | #define swap_t1s1 3 38 | #define swap_t2s3 4 39 | #define swap_t0t1 5 40 | #define swap_t0t2 6 41 | #define swap_t0t3 7 42 | #define swap_t1t2 8 43 | #define swap_t1t3 9 44 | #define swap_t2t3 10 45 | #define swap_s0s1 11 46 | #define swap_s0s2 12 47 | #define swap_s0s3 13 48 | #define swap_s1s2 14 49 | #define swap_s1s3 15 50 | #define swap_s2s3 16 51 | 52 | typedef char FUNCTION; 53 | typedef struct EXPR EXPR, *EXPRPTR; 54 | typedef struct IOTYPE IO, *IOPTR; 55 | typedef struct COMPLEX { 56 | float r; 57 | float i; 58 | } 59 | COMPLEX; 60 | 61 | typedef union X_OR_I { 62 | int i; 63 | COMPLEX c; 64 | EXPRPTR x; 65 | } 66 | X_OR_I; 67 | 68 | typedef struct U_EXPR { 69 | FUNCTION f; 70 | int dim; 71 | X_OR_I arg1; 72 | } 73 | U_EXPR; 74 | 75 | 76 | typedef struct B_EXPR { 77 | FUNCTION f; 78 | int dim; 79 | X_OR_I arg1, arg2; 80 | } 81 | B_EXPR; 82 | 83 | typedef struct T_EXPR { 84 | FUNCTION f; 85 | int dim; 86 | X_OR_I arg1, arg2, arg3; 87 | } 88 | T_EXPR; 89 | 90 | typedef struct Q_EXPR { 91 | FUNCTION f; 92 | int dim; 93 | X_OR_I arg1, arg2, arg3, arg4; 94 | } 95 | Q_EXPR; 96 | 97 | typedef struct QU_EXPR { 98 | FUNCTION f; 99 | int dim; 100 | X_OR_I arg1, arg2, arg3, arg4, arg5; 101 | } 102 | QU_EXPR; 103 | 104 | struct EXPR { 105 | FUNCTION f; 106 | int dim; 107 | X_OR_I arg1, arg2, arg3, arg4, arg5; 108 | } 109 | ; 110 | 111 | typedef char *STRING; 112 | 113 | typedef struct { 114 | STRING name; 115 | char nargs; 116 | int (*apply)(); 117 | char type; 118 | } 119 | *FPTR, FITEM; 120 | 121 | #define INTERIOR 0 122 | #define TERMINAL 1 123 | #define D(x) if(tflags[x]) 124 | #define E(x) if(!tflags[x]) 125 | #define eval(x) (*ftable[ (long) e->x->f].apply) (e->x) 126 | 127 | 128 | 129 | /* 130 | * possible values 131 | */ 132 | 133 | #define UNDEFINED 0 134 | #define DOTTED_PAIR 1 135 | #define WORD 2 136 | #define SWCHAR 2 137 | #define NUMERIC 3 138 | #define QSTRING 4 139 | #define EOD 5 140 | #define NIL 6 141 | #define ERROR 7 /* now not necc. error is type WORD */ 142 | #define WORDSIZE sizeof(WORDCELL); 143 | #define SMALL_RECORD 0 144 | #define STRING_RECORD 2 145 | #define rVALUE register VALUE 146 | #define rSTPPTR register STPPTR 147 | #define rMEMPTR register MEMPTR 148 | #define OTHER_RECORD 1 149 | #define BIG_RECORD OTHER_RECORD 150 | #define rSTPLISTPTR register STPLISTPTR 151 | #define MAXERRORS 20 152 | #define BYTESPERWORD 4 153 | 154 | typedef union CELLUNIONTYPE CELLUNION, WORDCELL; 155 | typedef union BITSTYPE BITS; 156 | typedef union SPACETYPE SPACEITEM; 157 | typedef struct NONAME NAMELESS; 158 | typedef struct CELLTYPE CELL, *CELLPTR; 159 | typedef struct VALUETYPE VALUE, *VALUEPTR; 160 | typedef struct STPSTACKTYPE STPSTACK, *STPPTR; 161 | typedef struct MEMITEMTYPE MEMITEM, *MEMPTR; 162 | typedef struct STPLISTTYPE STPLIST, *STPLISTPTR; 163 | typedef struct DISPLAYITEMTYPE DISPLAYITEM, *DISPLAYPTR; 164 | typedef struct COORDTYPE COORDS; 165 | typedef struct D_TAGSTYPE D_TAGS; 166 | typedef struct STPPAIRTYPE STPPAIR; 167 | typedef long LU_WORD; 168 | typedef long LU_EOD; 169 | typedef long LU_ERROR; 170 | typedef long LU_NIL; 171 | 172 | struct D_TAGSTYPE 173 | { 174 | char u_count; 175 | char g_mark; 176 | short n; 177 | char d_hd; 178 | char d_tl; 179 | char d_size; 180 | char d_mark; 181 | }; 182 | 183 | struct COORDTYPE 184 | { 185 | short d1; 186 | short d2; 187 | short d3; 188 | }; 189 | 190 | union BITSTYPE 191 | { 192 | COORDS xyz; 193 | long word; 194 | D_TAGS bits; 195 | }; 196 | 197 | struct NONAME 198 | { 199 | BITS data; 200 | char *f_next; 201 | }; 202 | 203 | union SPACETYPE 204 | { 205 | char *sp; 206 | struct NONAME *no; 207 | }; 208 | 209 | union CELLUNIONTYPE 210 | { 211 | char swch; /* word & strings */ 212 | COMPLEX na; /* numeric atom */ 213 | LU_WORD wrd; /* word atom */ 214 | CELLPTR strg; /* string atom */ 215 | LU_EOD eod; /* end of data marker */ 216 | LU_ERROR err; /* type error */ 217 | LU_NIL nil; /* the empty list */ 218 | CELLPTR dp; 219 | }; 220 | 221 | struct CELLTYPE 222 | { 223 | BITS data; 224 | CELLUNION hd, tl; 225 | }; 226 | 227 | struct VALUETYPE 228 | { 229 | long v_type; 230 | WORDCELL v_value; 231 | }; 232 | 233 | struct STPSTACKTYPE 234 | { 235 | BITS stphd; 236 | STPSTACK *stptl; 237 | STPSTACK *stplink; 238 | }; 239 | 240 | struct MEMITEMTYPE 241 | { 242 | BITS data; 243 | STPPTR s; 244 | STPPTR t; 245 | STPPTR p; 246 | VALUE v; 247 | MEMITEM *m_next; 248 | }; 249 | 250 | struct STPLISTTYPE 251 | { 252 | BITS data; 253 | STPPTR hd; 254 | STPLIST *tl; 255 | }; 256 | 257 | struct DISPLAYITEMTYPE 258 | { 259 | DISPLAYITEM *d_envg, *d_envf; 260 | STPPTR d_sg, d_sf; 261 | STPPTR d_tg, d_tf; 262 | STPPTR d_pg, d_pf; 263 | long d_frozen; 264 | }; 265 | 266 | struct STPPAIRTYPE 267 | { 268 | STPPTR stp_s; 269 | STPPTR stp_t; 270 | STPPTR stp_p; 271 | }; 272 | 273 | struct IOTYPE 274 | { 275 | long type; 276 | EXPRPTR expr; 277 | STPPTR s; 278 | STPPTR t; 279 | STPPTR p; 280 | FILE *in; 281 | FILE *out; 282 | long chin; 283 | long chout; 284 | long inx; 285 | long outx; 286 | int inmode; 287 | int outmode; 288 | int ptwize; 289 | int ignore; 290 | IOPTR next; 291 | }; 292 | -------------------------------------------------------------------------------- /evaluator/list.c: -------------------------------------------------------------------------------- 1 | 2 | #include "imanifs.h" 3 | #include "iglobals.h" 4 | #include 5 | 6 | #define ERRCASE VStype = ERROR; return; 7 | 8 | 9 | #define EODCASE VStype = EOD; return 10 | 11 | void f_append(e) 12 | rEXPRPTR e; 13 | { 14 | char t1_type,t2_type; 15 | CELLUNION t1_val,t2_val; 16 | CELLPTR temp,t1,t2,cns(),app(); 17 | /* printf("ENtering append\n"); */ 18 | eval(arg1.x); 19 | /* return 0; */ 20 | t1_type = VStype; 21 | t1_val = VSvalue; 22 | switch(VStype){ 23 | case EOD: 24 | return; 25 | case NIL: 26 | case DOTTED_PAIR: 27 | break; 28 | default: 29 | error("1st arg of <> is ",e->arg3.x,VStype,VSvalue); 30 | VStype = ERROR; 31 | return; 32 | } 33 | eval(arg2.x); 34 | t2_type = VStype; 35 | t2_val = VSvalue; 36 | switch(VStype){ 37 | case EOD: 38 | VSpop; 39 | VStype=EOD; 40 | return; 41 | case NIL: 42 | VSpop; 43 | return; 44 | case DOTTED_PAIR: 45 | if (t1_type==NIL) { 46 | VSpop; 47 | VStype=t2_type; 48 | VSvalue = t2_val; 49 | return; 50 | } 51 | break; 52 | default: 53 | error("2nd arg of <> is ",e->arg3.x,VStype,VSvalue); 54 | VSpop; 55 | VStype = ERROR; 56 | return; 57 | } 58 | temp = app(t1_type,t1_val.dp,t2_type,t2_val.dp); 59 | VSpop; 60 | VStype = DOTTED_PAIR; 61 | VSvalue.dp = temp; 62 | } 63 | 64 | CELLPTR 65 | app(a_type,a,b_type,b) 66 | char a_type,b_type; 67 | CELLPTR a,b; 68 | { 69 | CELLPTR cns(),temp; 70 | char *alloc(); 71 | if ( a->data.bits.d_tl == NIL) 72 | return((CELLPTR) cns(a->data.bits.d_hd,a->hd,b_type,b)); 73 | temp = (CELLPTR) alloc(SMALL_RECORD); 74 | temp->data.bits.d_mark = 0; 75 | temp->data.bits.d_hd = a->data.bits.d_hd; 76 | temp->hd.dp = a->hd.dp; 77 | temp->data.bits.d_tl = NIL; 78 | VSpush; 79 | VStype = DOTTED_PAIR; 80 | VSvalue.dp = temp; 81 | printf("Recursing...\n"); 82 | temp->tl.dp = app(a->data.bits.d_tl,a->tl.dp,b_type,b); 83 | temp->data.bits.d_tl = DOTTED_PAIR; 84 | VSpop; 85 | return((CELLPTR)temp); 86 | } 87 | 88 | listlen(type,val) 89 | int type; 90 | WORDCELL val; 91 | { 92 | CELLPTR a,b; 93 | if (type == NIL) return(0); 94 | if (val.dp->data.bits.d_tl == NIL) return(1); 95 | return(1+listlen(val.dp->data.bits.d_tl,val.dp->tl)); 96 | } 97 | 98 | 99 | void f_cons(e) 100 | rEXPRPTR e; 101 | { 102 | int a_type,b_type; 103 | CELLPTR cns(),temp; 104 | WORDCELL a,b; 105 | eval(arg1.x); 106 | a_type = VStype; 107 | a = VSvalue; 108 | switch(VStype) { 109 | case EOD: 110 | return; 111 | case ERROR: 112 | error("1st arg of :: or arg of list is " 113 | ,e->arg3.x,VStype,VSvalue); 114 | return; 115 | default: 116 | break; 117 | } 118 | eval(arg2.x); 119 | b_type = VStype; 120 | b = VSvalue; 121 | switch(VStype) { 122 | case EOD: 123 | VSpop; 124 | VStype=EOD; 125 | return; 126 | case ERROR: 127 | error("2nd arg of :: or arg of list is ", 128 | e->arg3.x,VStype,VSvalue); 129 | VSpop; 130 | VStype=ERROR; 131 | return; 132 | case DOTTED_PAIR: 133 | case NIL: 134 | break; 135 | default: 136 | error("2nd arg of :: or arg of list is ", 137 | e->arg3.x,VStype,VSvalue); 138 | VSpop; 139 | VStype=ERROR; 140 | return; 141 | } 142 | temp = cns(a_type,a,b_type,b); 143 | VSpop; 144 | VStype = DOTTED_PAIR; 145 | VSvalue.dp = temp; 146 | } 147 | 148 | CELLPTR 149 | cns(a_type,a,b_type,b) 150 | char a_type,b_type; 151 | WORDCELL a,b; 152 | { 153 | char *alloc(); 154 | CELLPTR temp; 155 | temp = (CELLPTR) alloc(SMALL_RECORD); 156 | temp->data.bits.d_tl = b_type; 157 | temp->tl = b ; 158 | temp->data.bits.d_hd = a_type; 159 | temp->hd = a; 160 | return((CELLPTR)temp); 161 | } 162 | 163 | void f_hd(e) 164 | rEXPRPTR e; 165 | { 166 | eval(arg1.x); 167 | switch(VStype) 168 | { 169 | case DOTTED_PAIR: 170 | VStype = VSvalue.dp->data.bits.d_hd; 171 | VSvalue = VSvalue.dp->hd; 172 | break; 173 | case EOD: 174 | VSvalue.eod = EOD; 175 | break; 176 | case NIL: 177 | error("arg of hd is ",e->arg2.x,VStype,VSvalue); 178 | VStype = ERROR; 179 | return; 180 | case ERROR: 181 | error("arg of hd is ",e->arg2.x,VStype,VSvalue); 182 | return; 183 | default: 184 | error("arg of hd must be a list, not ",e->arg2.x, 185 | VStype,VSvalue); 186 | VStype = ERROR; 187 | break; 188 | } 189 | } 190 | 191 | void f_tl(e) 192 | rEXPRPTR e; 193 | { 194 | eval(arg1.x); 195 | switch(VStype) 196 | { 197 | case DOTTED_PAIR: 198 | VStype = VSvalue.dp->data.bits.d_tl; 199 | VSvalue = VSvalue.dp->tl; 200 | break; 201 | case EOD: 202 | VSvalue.eod = EOD; 203 | break; 204 | case ERROR: 205 | error("arg of tl is ",e->arg2.x,VStype,VSvalue); 206 | return; 207 | case NIL: 208 | error("arg of tl is ",e->arg2.x,VStype,VSvalue); 209 | VStype = ERROR; 210 | return; 211 | default: 212 | error("arg of tl must be a list, not ",e->arg2.x, 213 | VStype,VSvalue); 214 | VStype = ERROR; 215 | break; 216 | } 217 | } 218 | 219 | void f_islist(e) 220 | rEXPRPTR e; 221 | { 222 | eval(arg1.x); 223 | switch(VStype) 224 | { 225 | case NIL: 226 | case DOTTED_PAIR: 227 | VStype = WORD; 228 | VSvalue.wrd = true; 229 | return; 230 | case EOD: 231 | return; 232 | case ERROR: 233 | return; 234 | default: 235 | VStype = WORD; 236 | VSvalue.wrd = false; 237 | return; 238 | } 239 | } 240 | 241 | void f_mknumber(e) 242 | rEXPRPTR e; 243 | { 244 | char s[30]; 245 | eval(arg1.x); 246 | switch(VStype) 247 | { 248 | case QSTRING: 249 | formstring(&s[0],VSvalue.strg); 250 | VStype = NUMERIC; 251 | VSvalue.na.r = atof(s); 252 | if (abs(VSvalue.na.r) >= 10000000.0) { 253 | error("numeric value return by mknumber is out of the numeric range.\ni.e it should be between +100000000 and -1000000000\n" 254 | ,e->arg2.x, 255 | VStype,VSvalue); 256 | ERRCASE; 257 | } 258 | break; 259 | case EOD: 260 | EODCASE; 261 | default: 262 | error("arg of mknumber should a string, not ",e->arg2.x, 263 | VStype,VSvalue); 264 | ERRCASE; 265 | } 266 | } 267 | 268 | void f_mkstring(e) 269 | rEXPRPTR e; 270 | { 271 | CELLPTR findstring(); 272 | eval(arg1.x); 273 | switch(VStype) 274 | { 275 | case WORD: 276 | VSvalue.strg = findstring(wordtable[VSvalue.wrd]); 277 | VStype = QSTRING; 278 | break; 279 | case EOD: 280 | EODCASE; 281 | default: 282 | error("arg of mkstring should be a word, not " 283 | ,e->arg2.x, 284 | VStype,VSvalue); 285 | ERRCASE; 286 | } 287 | } 288 | 289 | f_mkword(e) 290 | rEXPRPTR e; 291 | { 292 | CELLUNION val; 293 | char s[100]; 294 | eval(arg1.x); 295 | val = VSvalue; 296 | switch(VStype) 297 | { 298 | case QSTRING: 299 | VStype = WORD; 300 | formstring(&s[0],VSvalue.strg); 301 | VSvalue.wrd=findword(s); 302 | if (VSvalue.wrd >= 0 ) { 303 | break; 304 | } 305 | else 306 | { 307 | error("cannot convert this string into a word : ", 308 | e->arg2.x,QSTRING,val); 309 | break; 310 | } 311 | default: 312 | error("arg of mkword should be a string, not " 313 | ,e->arg2.x, 314 | VStype,VSvalue); 315 | VStype = ERROR; 316 | break; 317 | case EOD: 318 | VSvalue.eod = EOD; 319 | break; 320 | } 321 | } 322 | -------------------------------------------------------------------------------- /evaluator/makefile: -------------------------------------------------------------------------------- 1 | R= 2 | DESTDIR=/usr/local/bin 3 | CFLAGS=-O -DYYMAXDEPTH=900 -g -Wno-return-type -arch i386 4 | 5 | LINT= lint -p 6 | TAR= tar -cv 7 | mac = imanifs.h iglobals.h 8 | 9 | luval: main.o f_flucid.o input.o dynamic.o util.o \ 10 | dump.o rupture.o memory.o f_decls.o \ 11 | f_alg.o f_lucid.o f_vars.o string.o list.o real.o 12 | cc -arch i386 $(CFLAGS) main.o f_flucid.o memory.o input.o dynamic.o \ 13 | util.o dump.o rupture.o f_decls.o f_alg.o \ 14 | f_lucid.o f_vars.o string.o real.o list.o -lm \ 15 | -o luval 16 | 17 | cp install: luval 18 | cp luval $R$(DESTDIR)/luval 19 | rm luval *.o 20 | 21 | clean: 22 | rm -f *.o luval 23 | 24 | lint: main.c input.c dynamic.c util.c f_flucid.c \ 25 | dump.c rupture.c memory.c f_decls.c \ 26 | f_alg.c f_lucid.c f_vars.c string.c list.c real.c 27 | $(LINT) main.c input.c dynamic.c util.c f_flucid.c\ 28 | dump.c rupture.c memory.c f_decls.c \ 29 | f_alg.c f_lucid.c f_vars.c string.c list.c real.c 30 | 31 | tape: 32 | $(TAR) imanifs.h iglobals.h main.c input.c dynamic.c util.c \ 33 | dump.c rupture.c memory.c f_decls.c f_flucid.c\ 34 | f_alg.c f_lucid.c f_vars.c string.c list.c real.c 35 | 36 | print: 37 | for i in *.[ch] do 1page $i done | lpr 38 | 39 | all: main.o input.o dynamic.o util.o f_flucid.o\ 40 | dump.o rupture.o memory.o f_decls.o \ 41 | f_alg.o f_lucid.o f_vars.o string.o list.o real.o 42 | cc -arch i386 $(CFLAGS) main.o memory.o input.o dynamic.o \ 43 | util.o dump.o rupture.o f_decls.o f_alg.o \ 44 | f_lucid.o f_vars.o string.o f_flucid.o list.o real.o -lm \ 45 | -o luval 46 | cp luval $R$(DESTDIR)/luval 47 | rm -f *.o luval 48 | 49 | main.o: $(mac) main.c 50 | input.o: $(mac) input.c 51 | dynamic.o: $(mac) dynamic.c 52 | util.o: $(mac) util.c 53 | dump.o: $(mac) dump.c 54 | rupture.o: $(mac) rupture.c 55 | memory.o: $(mac) memory.c 56 | f_decls.o: $(mac) f_decls.c 57 | f_alg.o: $(mac) f_alg.c 58 | f_lucid.o: $(mac) f_lucid.c 59 | f_flucid.o: $(mac) f_flucid.c 60 | f_vars.o: $(mac) f_vars.c 61 | string.o: $(mac) string.c 62 | list.o: $(mac) list.c 63 | real.o: $(mac) real.c 64 | -------------------------------------------------------------------------------- /evaluator/memory.c: -------------------------------------------------------------------------------- 1 | #include "imanifs.h" 2 | #include "iglobals.h" 3 | int countlen; 4 | int comps=0; 5 | 6 | char 7 | memsearch(place,n,s,t,p) 8 | MEMPTR *place; 9 | int n; 10 | register STPPTR s,t,p; 11 | { 12 | register int i; 13 | char * alloc(); 14 | register char found; 15 | register MEMPTR m; 16 | D(30) { 17 | bar(ddepth); 18 | ddepth++; 19 | fprintf(stderr,"?%s",nametable[n]); 20 | dumps(s); 21 | dumpstp(t); 22 | dumpstp(p); 23 | fprintf(stderr,"\n"); 24 | } 25 | 26 | D(20) { 27 | fprintf(stderr,"t=%d p=%d\n",(int)t,(int)p); 28 | } 29 | 30 | 31 | i = ((59*(int)s)+(39*(int)t)+(7*(int)p)+(n)) % NHASHSIZE; 32 | if (i<0) i = -i; 33 | found=0; 34 | D(19) { 35 | fprintf(stderr,"hashval = %d\n",i); 36 | } 37 | countlen=0; 38 | for(m=nhashtab[i]; m!=NULL; m=m->m_next){ 39 | if(n==m->data.bits.n && s==m->s && t==m->t && p==m->p){ 40 | found = 1; 41 | D(30) { 42 | ddepth--; 43 | bar(ddepth); 44 | fprintf(stderr,"*%s",nametable[n]); 45 | dumps(s); 46 | dumpstp(t); 47 | dumpstp(p); 48 | fprintf(stderr," "); 49 | dumpval2(stderr,m->v); 50 | fprintf(stderr,"\n"); 51 | } 52 | 53 | if (m->data.bits.g_mark>=retvec[n]) { 54 | retvec[n]++; 55 | } 56 | break; 57 | } 58 | countlen++; 59 | } 60 | 61 | comps=comps+countlen; 62 | D(21) { 63 | fprintf(stderr,"total comps =%d\n",comps); 64 | } 65 | D(18) { 66 | fprintf(stderr,"chain length = %d\n",countlen); 67 | } 68 | if(!found){ 69 | memcount++; 70 | m = (MEMPTR) alloc(BIG_RECORD); 71 | m->data.bits.u_count=0; 72 | m->data.bits.d_hd = 0; 73 | m->data.bits.d_tl = 0; 74 | m->data.bits.d_size = BIG_RECORD; 75 | m->data.bits.d_mark=0; 76 | m->data.bits.n = n; 77 | m->s = s; 78 | m->t = t; 79 | m->p = p; 80 | m->v.v_type = UNDEFINED; 81 | m->v.v_value.na.r = 0; 82 | m->v.v_value.na.i = 0; 83 | m->m_next = nhashtab[i]; 84 | nhashtab[i] = m; 85 | 86 | } 87 | else 88 | { 89 | if (m->v.v_type == UNDEFINED ) { 90 | if ( exprtable[n]-> f != F_INPUT && exprtable[n]->f != F_FILE && exprtable[n]->f != F_FILTER ) 91 | { 92 | fprintf(stderr,"Self-reference ERROR\n"); 93 | fprintf(stderr,"Variable '%s' is defined in terms of its own current or future value \n( the equivalent of writing x=x )\n",nametable[n]); 94 | fprintf(stderr,"Evaluation aborted\n"); 95 | exit(1); 96 | } 97 | } 98 | } 99 | m->data.bits.u_count++; 100 | m->data.bits.g_mark =0; 101 | *place = m; 102 | return(found); 103 | } 104 | 105 | /* 106 | */ 107 | STPPTR 108 | ssearch(hd) 109 | COORDS hd; 110 | { 111 | int found; 112 | char *alloc(); 113 | int i; 114 | STPPTR s; 115 | 116 | found = 0; 117 | i = (39*hd.d1+19*hd.d2+hd.d3) % SHASHSIZE; 118 | if (i<0) i = -i; 119 | for(s=shashtab[i]; s!=NULL; s=s->stplink){ 120 | /* 121 | */ 122 | if(s->stphd.xyz.d1==hd.d1 && 123 | s->stphd.xyz.d2==hd.d2 && 124 | s->stphd.xyz.d3==hd.d3) 125 | { 126 | found = 1; 127 | break; 128 | } 129 | } 130 | if(!found){ 131 | stpcount++; 132 | s = (STPPTR) alloc(SMALL_RECORD); 133 | s->stplink = shashtab[i]; 134 | shashtab[i] = s; 135 | s->stphd.xyz.d1= hd.d1; 136 | s->stphd.xyz.d2= hd.d2; 137 | s->stphd.xyz.d3= hd.d3; 138 | s->stptl = NULL; 139 | } 140 | return(s); 141 | } 142 | STPPTR 143 | stpsearch(hd,tl,table) 144 | long hd; 145 | STPPTR tl; 146 | STPPTR table[]; 147 | { 148 | int found; 149 | char *alloc(); 150 | int i; 151 | STPPTR s; 152 | 153 | found = 0; 154 | i = (hd) % THASHSIZE; 155 | if (i<0) i = -i; 156 | for(s=table[i]; s!=NULL; s=s->stplink){ 157 | /* 158 | */ 159 | if(s->stphd.word==hd && s->stptl==tl){ 160 | found = 1; 161 | break; 162 | } 163 | } 164 | if(!found){ 165 | stpcount++; 166 | s = (STPPTR) alloc(SMALL_RECORD); 167 | s->stplink = table[i]; 168 | table[i] = s; 169 | s->stphd.word = hd; 170 | s->stptl = tl; 171 | } 172 | return(s); 173 | } 174 | 175 | -------------------------------------------------------------------------------- /evaluator/real.c: -------------------------------------------------------------------------------- 1 | 2 | #include "imanifs.h" 3 | #include "iglobals.h" 4 | #include 5 | 6 | #define EODCASE VStype = EOD; return 7 | 8 | void f_real(e) 9 | rEXPRPTR e; 10 | { 11 | double cos(); 12 | eval(arg1.x); 13 | switch(VStype) 14 | { 15 | case NUMERIC: 16 | VSvalue.na.r = VSvalue.na.r; 17 | break; 18 | case EOD: 19 | VSvalue.eod = EOD; 20 | break; 21 | case ERROR: 22 | error("arg of real is ",e->arg2.x,VStype,VSvalue); 23 | return; 24 | default: 25 | error("arg of real must be numeric, not ",e->arg2.x, 26 | VStype,VSvalue); 27 | VStype = ERROR; 28 | break; 29 | } 30 | } 31 | 32 | void f_imag(e) 33 | rEXPRPTR e; 34 | { 35 | double cos(); 36 | eval(arg1.x); 37 | switch(VStype) 38 | { 39 | case NUMERIC: 40 | VSvalue.na.r = VSvalue.na.i; 41 | break; 42 | case EOD: 43 | VSvalue.eod = EOD; 44 | break; 45 | case ERROR: 46 | error("arg of imag is ",e->arg2.x,VStype,VSvalue); 47 | return; 48 | default: 49 | error("arg of imag must be numeric, not ",e->arg2.x, 50 | VStype,VSvalue); 51 | VStype = ERROR; 52 | break; 53 | } 54 | 55 | } 56 | 57 | void f_cos(e) 58 | rEXPRPTR e; 59 | { 60 | double cos(); 61 | eval(arg1.x); 62 | switch(VStype) 63 | { 64 | case NUMERIC: 65 | VSvalue.na.r = cos(VSvalue.na.r); 66 | break; 67 | case EOD: 68 | VSvalue.eod = EOD; 69 | break; 70 | case ERROR: 71 | error("arg of cos is ",e->arg2.x,VStype,VSvalue); 72 | return; 73 | default: 74 | error("arg of cos must be numeric, not ",e->arg2.x, 75 | VStype,VSvalue); 76 | VStype = ERROR; 77 | break; 78 | } 79 | 80 | } 81 | 82 | void f_sin(e) 83 | rEXPRPTR e; 84 | { 85 | double sin(); 86 | eval(arg1.x); 87 | switch(VStype) 88 | { 89 | case NUMERIC: 90 | VSvalue.na.r = sin(VSvalue.na.r); 91 | break; 92 | case EOD: 93 | VSvalue.eod = EOD; 94 | break; 95 | case ERROR: 96 | error("arg of sin is ",e->arg2.x,VStype,VSvalue); 97 | return; 98 | default: 99 | error("arg of sin must be numeric, not ",e->arg2.x, 100 | VStype,VSvalue); 101 | VStype = ERROR; 102 | break; 103 | } 104 | 105 | } 106 | 107 | void f_log(e) 108 | rEXPRPTR e; 109 | { 110 | double log(); 111 | eval(arg1.x); 112 | switch(VStype) 113 | { 114 | case NUMERIC: 115 | VSvalue.na.r = log(VSvalue.na.r); 116 | if (fabs(VSvalue.na.r) >= 10000000.0) { 117 | error("numeric value return by log is out of the numeric range.\ni.e it should be between +10000000 and -10000000, not " 118 | ,e->arg2.x, 119 | VStype,VSvalue); 120 | VStype = ERROR; 121 | } 122 | break; 123 | case EOD: 124 | VSvalue.eod = EOD; 125 | break; 126 | case ERROR: 127 | error("arg of log is",e->arg2.x,VStype,VSvalue); 128 | return; 129 | default: 130 | error("arg of log must be numeric, not ",e->arg2.x, 131 | VStype,VSvalue); 132 | VStype = ERROR; 133 | break; 134 | } 135 | 136 | } 137 | 138 | void f_complex(e) 139 | rEXPRPTR e; 140 | { 141 | double pow(); 142 | CELLUNION val; 143 | int type; 144 | eval(arg1.x); 145 | val = VSvalue; 146 | type = VStype; 147 | switch(VStype) 148 | { 149 | case NUMERIC: 150 | VSpop; 151 | eval(arg2.x); 152 | switch(VStype) 153 | { 154 | case NUMERIC: 155 | VSvalue.na.i = VSvalue.na.r; 156 | VSvalue.na.r = val.na.r; 157 | if (fabs(VSvalue.na.r) >= 10000000.0 || 158 | fabs(VSvalue.na.i) >= 10000000.0) { 159 | error("numeric value return by complex is out of the numeric range.\ni.e it should be between +10000000 and -10000000 not " 160 | ,e->arg3.x, 161 | VStype,VSvalue); 162 | VStype = ERROR; 163 | } 164 | break; 165 | case ERROR: 166 | error("2nd arg of complex is ",e->arg3.x, 167 | VStype,VSvalue); 168 | break; 169 | case EOD: 170 | break; 171 | default: 172 | error("2nd arg of complex should be numeric, not", 173 | e->arg3.i,ERROR,VSvalue); 174 | VStype = ERROR; 175 | } 176 | break; 177 | case EOD: 178 | VSvalue.eod = EOD; 179 | break; 180 | case ERROR: 181 | error("1st arg of complex is",e->arg3.x,VStype,VSvalue); 182 | return; 183 | default: 184 | error("1st arg of complex must be numeric, not ",e->arg3.x, 185 | VStype,VSvalue); 186 | VStype = ERROR; 187 | break; 188 | } 189 | 190 | } 191 | 192 | 193 | 194 | void f_exp(e) 195 | rEXPRPTR e; 196 | { 197 | double pow(); 198 | CELLUNION val; 199 | int type; 200 | eval(arg1.x); 201 | val = VSvalue; 202 | type = VStype; 203 | switch(VStype) 204 | { 205 | case NUMERIC: 206 | VSpop; 207 | eval(arg2.x); 208 | switch(VStype) 209 | { 210 | case NUMERIC: 211 | VSvalue.na.r = pow(val.na.r,VSvalue.na.r); 212 | if (fabs(VSvalue.na.r) >= 10000000.0) { 213 | error("numeric value return by ** is out of the numeric range.\ni.e it should be between +10000000 and -10000000 not " 214 | ,e->arg3.x, 215 | VStype,VSvalue); 216 | VStype = ERROR; 217 | } 218 | break; 219 | case ERROR: 220 | error("2nd arg of ** is ",e->arg3.x, 221 | VStype,VSvalue); 222 | break; 223 | case EOD: 224 | break; 225 | default: 226 | error("2nd arg of ** should be numeric, not", 227 | e->arg3.i,ERROR,VSvalue); 228 | VStype = ERROR; 229 | } 230 | break; 231 | case EOD: 232 | VSvalue.eod = EOD; 233 | break; 234 | case ERROR: 235 | error("1st arg of ** is",e->arg3.x,VStype,VSvalue); 236 | return; 237 | default: 238 | error("1st arg of ** must be numeric, not ",e->arg3.x, 239 | VStype,VSvalue); 240 | VStype = ERROR; 241 | break; 242 | } 243 | 244 | } 245 | 246 | void f_sqrt(e) 247 | rEXPRPTR e; 248 | { 249 | double sqrt(); 250 | eval(arg1.x); 251 | switch(VStype) 252 | { 253 | case NUMERIC: 254 | VSvalue.na.r = sqrt(VSvalue.na.r); 255 | if (fabs(VSvalue.na.r) >= 10000000.0) { 256 | error("numeric value return by mknumber is out of the numeric range.\ni.e it should be between +100000000 and -1000000000 not " 257 | ,e->arg2.x, 258 | VStype,VSvalue); 259 | VStype = ERROR; 260 | } 261 | break; 262 | case EOD: 263 | VSvalue.eod = EOD; 264 | break; 265 | case ERROR: 266 | error("arg of sqrt is ",e->arg2.x,VStype,VSvalue); 267 | return; 268 | default: 269 | error("arg of sqrt must be numeric, not ",e->arg2.x, 270 | VStype,VSvalue); 271 | VStype = ERROR; 272 | break; 273 | } 274 | 275 | } 276 | 277 | void f_tan(e) 278 | rEXPRPTR e; 279 | { 280 | double tan(); 281 | eval(arg1.x); 282 | switch(VStype) 283 | { 284 | case NUMERIC: 285 | VSvalue.na.r = tan(VSvalue.na.r); 286 | break; 287 | case EOD: 288 | VSvalue.eod = EOD; 289 | break; 290 | case ERROR: 291 | error("arg of tan is ",e->arg2.x,VStype,VSvalue); 292 | return; 293 | default: 294 | error("arg of tan must be numeric, not ",e->arg2.x, 295 | VStype,VSvalue); 296 | VStype = ERROR; 297 | break; 298 | } 299 | } 300 | 301 | 302 | 303 | void f_log10(e) 304 | rEXPRPTR e; 305 | { 306 | double log10(); 307 | eval(arg1.x); 308 | switch(VStype) 309 | { 310 | case NUMERIC: 311 | VSvalue.na.r = log10(VSvalue.na.r); 312 | if (fabs(VSvalue.na.r) >= 10000000.0) { 313 | error("numeric value return by log10 is out of the numeric range.\ni.e it should be between +100000000 and -1000000000 not " 314 | ,e->arg2.x, 315 | VStype,VSvalue); 316 | VStype = ERROR; 317 | } 318 | break; 319 | case EOD: 320 | VSvalue.eod = EOD; 321 | break; 322 | case ERROR: 323 | error("arg of log10 is ",e->arg2.x,VStype,VSvalue); 324 | return; 325 | default: 326 | error("arg of log10 must be numeric, not ",e->arg2.x, 327 | VStype,VSvalue); 328 | VStype = ERROR; 329 | break; 330 | } 331 | 332 | } 333 | 334 | void f_abs(e) 335 | rEXPRPTR e; 336 | { 337 | double fabs(); 338 | eval(arg1.x); 339 | switch(VStype) 340 | { 341 | case NUMERIC: 342 | VSvalue.na.r = fabs(VSvalue.na.r); 343 | break; 344 | case EOD: 345 | VSvalue.eod = EOD; 346 | break; 347 | case ERROR: 348 | error("arg of abs is ",e->arg2.x,VStype,VSvalue); 349 | return; 350 | default: 351 | error("arg of abs must be numeric, not ",e->arg2.x, 352 | VStype,VSvalue); 353 | VStype = ERROR; 354 | break; 355 | } 356 | 357 | } 358 | -------------------------------------------------------------------------------- /evaluator/rupture.c: -------------------------------------------------------------------------------- 1 | #include "imanifs.h" 2 | #include "iglobals.h" 3 | int lu_time; 4 | int rupturelevel = 0; 5 | char rp_ch; 6 | void rupture() 7 | { 8 | int num; 9 | char *gets(), input[80],ch; 10 | FILE *term; 11 | int i; 12 | float readnumber(); 13 | extern hiaton(); 14 | rupturelevel++; 15 | signal(SIGINT,rupture); 16 | signal(SIGALRM,hiaton); 17 | fprintf(stderr,"\nTyping Control-C interrupts the evaluation.\n"); 18 | fprintf(stderr,"Do you require help ? Type h for help.\n"); 19 | if ( rupturelevel == 1 ) { 20 | while(1){ 21 | term = fopen("/dev/tty","r"); 22 | while (fgets(input,200,term)==NULL); 23 | fclose(term); 24 | switch(input[0]){ 25 | case '@': 26 | exit(1); 27 | case 'o': 28 | trace_ops(); 29 | break; 30 | case 'z': 31 | for (i=0; i< exprquan; i++) retvec[i] =1000; 32 | break; 33 | case 'h': 34 | explain(); 35 | break; 36 | case 'y': 37 | stats(); 38 | break; 39 | case 'x': 40 | fprintf(stderr,"height of stp_stack %d\n", 41 | stp_top - &stp_stack[0]); 42 | fprintf(stderr,"max height of stp_stack %d\n", 43 | STPSIZE); 44 | fprintf(stderr,"height of d_stack %d\n", 45 | d_top - &d_stack[0]); 46 | fprintf(stderr,"max height of d_stack %d\n", 47 | DSIZE); 48 | fprintf(stderr,"height of v_stack %d\n", 49 | v_top - &v_stack[0]); 50 | fprintf(stderr,"max height of v_stack %d\n", 51 | VSIZE); 52 | break; 53 | case 'a': 54 | /* printout retirement ages */ 55 | fprintf(stderr, 56 | "The retirement age for each varible is as follows:\n"); 57 | for (i=0; i 5 | 6 | #define EODCASE VStype = EOD; return 7 | 8 | 9 | formstring(s,sl) 10 | char *s; 11 | CELLPTR sl; 12 | { 13 | CELLPTR temp; 14 | int i; 15 | i = 0; 16 | temp = sl; 17 | while ( temp->hd.swch !='\0' ) 18 | { 19 | s[i] = temp->hd.swch; 20 | i++; 21 | temp = temp->tl.strg; 22 | } 23 | s[i] = '\0'; 24 | } 25 | 26 | CELLPTR 27 | findstring(s) 28 | char *s; 29 | { 30 | CELLPTR temp,cns(); 31 | char *alloc(),ch; 32 | temp = (CELLPTR) alloc(SMALL_RECORD); 33 | ch = s[0]; 34 | temp->data.bits.d_hd = SWCHAR; 35 | temp->hd.swch = ch; 36 | temp->data.bits.d_tl = NIL; 37 | VSpush; 38 | VStype = QSTRING; 39 | VSvalue.strg = temp; 40 | if (s[0] != '\0') { 41 | temp->tl.strg = findstring(&s[1]); 42 | temp->data.bits.d_tl = QSTRING; 43 | } 44 | VSpop; 45 | return(temp); 46 | } 47 | 48 | 49 | void f_substr(e) 50 | rEXPRPTR e; 51 | { 52 | int i,type1,type2,strlen(); 53 | char *p,*temps,s[200],buff[200]; 54 | CELLPTR temp,findstring(); 55 | CELLUNION val1,val2; 56 | eval(arg1.x); 57 | type1 = VStype; 58 | val1 = VSvalue; 59 | switch(VStype) 60 | { 61 | case QSTRING: 62 | break; 63 | case ERROR: 64 | error("1st arg of substrg is " ,e->arg4.x,ERROR,val1); 65 | return; 66 | case EOD: 67 | return; 68 | default: 69 | error("1st arg of substrg is " ,e->arg4.x,VStype,VSvalue); 70 | VStype=ERROR; 71 | return; 72 | } 73 | eval(arg2.x); 74 | type1 = VStype; 75 | val2 = VSvalue; 76 | switch(VStype){ 77 | case EOD: 78 | VSpop; 79 | VStype=EOD; 80 | return; 81 | case ERROR: 82 | error("2nd arg of substrg is " ,e->arg4.x,ERROR,val2); 83 | VSpop; 84 | VStype = ERROR; 85 | return; 86 | case NUMERIC: 87 | break; 88 | default: 89 | error("2nd arg of substrg is " ,e->arg4.x,VStype,val2); 90 | VSpop; 91 | VStype = ERROR; 92 | return; 93 | } 94 | eval(arg3.x); 95 | switch(VStype){ 96 | case EOD: 97 | VSpop; 98 | VSpop; 99 | VStype=EOD; 100 | return; 101 | case ERROR: 102 | error("3rd arg of substrg is " ,e->arg4.x,ERROR,val2); 103 | VSpop; 104 | VSpop; 105 | VStype = ERROR; 106 | return; 107 | case NUMERIC: 108 | break; 109 | default: 110 | error("3rd arg of substrg is " ,e->arg4.x,VStype,val2); 111 | VSpop; 112 | VSpop; 113 | VStype = ERROR; 114 | return; 115 | } 116 | 117 | formstring(s, val1.strg); 118 | temps = s; 119 | if (val2.na.r <= 0 ) 120 | { 121 | VSpop; 122 | VSpop; 123 | VStype = ERROR; 124 | error("incorrect range for substrg range1 is " 125 | ,e->arg4.x,NUMERIC,val2); 126 | return; 127 | } 128 | if (VSvalue.na.r > strlen(s)) 129 | { 130 | VSpop; 131 | VSpop; 132 | VStype = ERROR; 133 | error("incorrect ranges in substr range2 is " 134 | ,e->arg4.x,NUMERIC,VSvalue); 135 | return; 136 | } 137 | p = buff; 138 | for (i=1;i<=(VSvalue.na.r-val2.na.r)+1;i++) 139 | *p++ = temps[((int)val2.na.r)+i-2]; 140 | *p = '\0'; 141 | temp = findstring(buff); 142 | VSpop; 143 | VSpop; 144 | VSvalue.strg= temp; 145 | VStype = QSTRING; 146 | return; 147 | } 148 | 149 | strglen(type,val) 150 | int type; 151 | WORDCELL val; 152 | { 153 | CELLPTR a,b; 154 | if (val.strg->data.bits.d_tl == NIL) return(0); 155 | return(1+strglen(val.strg->data.bits.d_tl,val.strg->tl)); 156 | } 157 | 158 | void f_scons(e) 159 | rEXPRPTR e; 160 | { 161 | int a_type,b_type; 162 | CELLPTR cns(),temp; 163 | WORDCELL a,b; 164 | eval(arg1.x); 165 | a_type = VStype; 166 | a = VSvalue; 167 | switch(VStype){ 168 | case EOD: 169 | return; 170 | case SWCHAR: 171 | break; 172 | default: 173 | error("in string ",e->arg3.x,VStype,VSvalue); 174 | VStype = ERROR; 175 | return; 176 | } 177 | eval(arg2.x); 178 | b_type = VStype; 179 | b = VSvalue; 180 | switch(VStype) { 181 | case EOD: 182 | VSpop; 183 | VStype=EOD; 184 | return; 185 | case QSTRING: 186 | break; 187 | case NIL: 188 | break; 189 | default: 190 | error("in string ",e->arg3.x,VStype,VSvalue); 191 | VSpop; 192 | VStype = ERROR; 193 | return; 194 | } 195 | temp = cns(a_type,a,b_type,b); 196 | VSpop; 197 | VStype = QSTRING; 198 | VSvalue.strg = temp; 199 | } 200 | 201 | void f_strconc(e) 202 | rEXPRPTR e; 203 | { 204 | int t1_type,t2_type; 205 | CELLUNION t1_val,t2_val; 206 | CELLPTR temp,strgapp(); 207 | eval(arg1.x); 208 | t1_type = VStype; 209 | t1_val = VSvalue; 210 | switch(VStype){ 211 | case EOD: 212 | return; 213 | case ERROR: 214 | error("left arg of ^ is ", e->arg3.x,ERROR,VSvalue); 215 | return; 216 | case QSTRING: 217 | break; 218 | default: 219 | error("left arg of ^ is ", e->arg3.x,VStype,VSvalue); 220 | VStype = ERROR; 221 | return; 222 | } 223 | eval(arg2.x); 224 | t2_type = VStype; 225 | t2_val = VSvalue; 226 | switch(VStype){ 227 | case EOD: 228 | VSpop; 229 | VStype=EOD; 230 | return; 231 | case ERROR: 232 | error("right arg of ^ is ", e->arg3.x,ERROR,VSvalue); 233 | VSpop; 234 | VStype = ERROR; 235 | return; 236 | case QSTRING: 237 | break; 238 | default: 239 | error("right arg of ^ is ", e->arg3.x,VStype,VSvalue); 240 | VSpop; 241 | VStype = ERROR; 242 | return; 243 | } 244 | temp = strgapp(t1_type,t1_val.dp,t2_type,t2_val.dp); 245 | VSpop; 246 | VStype = QSTRING; 247 | VSvalue.strg = temp; 248 | } 249 | 250 | CELLPTR 251 | strgapp(a_type,a,b_type,b) 252 | int a_type,b_type; 253 | CELLPTR a,b; 254 | { 255 | CELLPTR temp; 256 | char *alloc(); 257 | if ( a->data.bits.d_tl==QSTRING) { 258 | temp = (CELLPTR) alloc(SMALL_RECORD); 259 | temp->data.bits.d_hd = SWCHAR; 260 | temp->hd.swch = a->hd.swch; 261 | temp->data.bits.d_tl = NIL; 262 | if(v_top+2>=&v_stack[0]+100) { 263 | printf("vstack overflow\n"); 264 | exit(1); 265 | } 266 | VSpush; 267 | VStype = QSTRING; 268 | VSvalue.strg = temp; 269 | temp->tl.strg = strgapp(a->data.bits.d_tl,a->tl.strg,b_type,b); 270 | temp->data.bits.d_tl = QSTRING; 271 | VSpop; 272 | return(temp); 273 | } 274 | return(b); 275 | } 276 | 277 | void f_isstring(e) 278 | rEXPRPTR e; 279 | { 280 | eval(arg1.x); 281 | switch(VStype) 282 | { 283 | case QSTRING: 284 | VSvalue.wrd = true; 285 | VStype = WORD; 286 | break; 287 | case EOD: 288 | break; 289 | case ERROR: 290 | error("arg of isstring is ",e->arg2.x,VStype,VSvalue); 291 | return; 292 | default: 293 | VSvalue.wrd = false; 294 | VStype = WORD; 295 | break; 296 | } 297 | } 298 | 299 | void f_chr(e) 300 | rEXPRPTR e; 301 | { 302 | char s[2]; 303 | eval(arg1.x); 304 | switch(VStype) 305 | { 306 | case NUMERIC: 307 | if (VSvalue.na.r < 0 || 308 | VSvalue.na.r > 128) 309 | { 310 | error("integer arg of chr non-ascii ", 311 | e->arg2.x,VStype,VSvalue); 312 | VStype = ERROR; 313 | break; 314 | } 315 | s[0] = VSvalue.na.r; 316 | s[1] = '\0'; 317 | VSvalue.strg = findstring(s); 318 | VStype = QSTRING; 319 | break; 320 | case EOD: 321 | break; 322 | case ERROR: 323 | error("arg of chr is ? ",e->arg2.x,VStype,VSvalue); 324 | return; 325 | default: 326 | error("arg of chr must be of type integer, not ", 327 | e->arg2.x,VStype,VSvalue); 328 | VStype = ERROR; 329 | } 330 | } 331 | 332 | void f_ord(e) 333 | rEXPRPTR e; 334 | { 335 | eval(arg1.x); 336 | switch(VStype) 337 | { 338 | case QSTRING: 339 | if (VSvalue.strg->hd.swch < 0 || 340 | VSvalue.strg->hd.swch > 127) 341 | { 342 | error("invalid char in ord", e->arg2.x,VStype, 343 | VSvalue); 344 | VStype = ERROR; 345 | return; 346 | } 347 | VSvalue.na.r = VSvalue.strg->hd.swch; 348 | VStype = NUMERIC; 349 | break; 350 | 351 | case EOD: 352 | break; 353 | case ERROR: 354 | error("arg of ord is ?",e->arg2.x,VStype,VSvalue); 355 | return; 356 | default: 357 | error("arg of ord must be of type string, not ", 358 | e->arg2.x,VStype,VSvalue); 359 | VStype = ERROR; 360 | } 361 | } 362 | 363 | -------------------------------------------------------------------------------- /evaluator/test: -------------------------------------------------------------------------------- 1 | i*j 2 | where 3 | i = 1 fby i+1; 4 | j = 1 sby j+1; 5 | end 6 | -------------------------------------------------------------------------------- /evaluator/test.i: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mpw/pLucid-osx/59970fabba8008d6c63589e501a56d7c6bf2f7b0/evaluator/test.i -------------------------------------------------------------------------------- /evaluator/util.c: -------------------------------------------------------------------------------- 1 | #include "imanifs.h" 2 | #include "iglobals.h" 3 | error(x,y,type,val) 4 | int type; 5 | CELLUNION val; 6 | STRING x; 7 | EXPRPTR y; 8 | 9 | { 10 | int i; 11 | if (!tflags[9]) { 12 | evalerr = true; 13 | if (newout) { 14 | for (i=0; i<80; i++) fprintf(stderr,"-"); 15 | newout = false; 16 | } 17 | dumpfile(x,y); 18 | dumpmemry(type,val); 19 | } 20 | errcount++; 21 | if (errcount > 2) { my_exit(1); } 22 | } 23 | -------------------------------------------------------------------------------- /lucid: -------------------------------------------------------------------------------- 1 | if test -f $1.i 2 | then rm $1.i 3 | fi 4 | pass1 $1 | pass2 | pass3 | pass4 | pass5 $1 5 | if test -f $1.i 6 | then luval $1.i 7 | fi 8 | -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | DESTDIR=/lucy/a/wwadge/nulu/bin 2 | FILE= 3 | megamake: 4 | cd p1; make 5 | cd p2; make 6 | cd p3; make 7 | cd p4; make 8 | cd p5; make 9 | cd evaluator; make 10 | 11 | cp install: 12 | cp shell_scripts/lucomp $(DESTDIR)/lucomp 13 | cp shell_scripts/lucid $(DESTDIR)/lucid 14 | cd p1; make install "DESTDIR=$(DESTDIR)" 15 | cd p2; make install "DESTDIR=$(DESTDIR)" 16 | cd p3; make install "DESTDIR=$(DESTDIR)" 17 | cd p4; make install "DESTDIR=$(DESTDIR)" 18 | cd p5; make install "DESTDIR=$(DESTDIR)" 19 | cd evaluator; make install "DESTDIR=$(DESTDIR)" 20 | 21 | clean: 22 | cd p1; make clean 23 | cd p2; make clean 24 | cd p3; make clean 25 | cd p4; make clean 26 | cd p5; make clean 27 | cd evaluator; make clean 28 | 29 | print: 30 | cd p1; make print 31 | cd p2; make print 32 | cd p3; make print 33 | cd p4; make print 34 | cd p5; make print 35 | cd evaluator; make print 36 | 37 | tape: 38 | cd p1; make tape 39 | cd p2; make tape 40 | cd p3; make tape 41 | cd p4; make tape 42 | cd p5; make tape 43 | cd evaluator; make tape 44 | 45 | lint: 46 | cd p1; make lint 47 | cd p2; make lint 48 | cd p3; make lint 49 | cd p4; make lint 50 | cd p5; make lint 51 | cd evaluator; make lint 52 | 53 | all: 54 | cp shell_scripts/lucomp $(DESTDIR)/lucomp 55 | cp shell_scripts/lucid $(DESTDIR)/lucid 56 | cd p1; make all "DESTDIR=$(DESTDIR)" 57 | cd p2; make all "DESTDIR=$(DESTDIR)" 58 | cd p3; make all "DESTDIR=$(DESTDIR)" 59 | cd p4; make all "DESTDIR=$(DESTDIR)" 60 | cd p5; make all "DESTDIR=$(DESTDIR)" 61 | cd evaluator; make all "DESTDIR=$(DESTDIR)" 62 | -------------------------------------------------------------------------------- /manual/READ_ME: -------------------------------------------------------------------------------- 1 | This directory contains the pLucid manual in nroff 2 | format in the files 3 | frontpage.A 4 | abstract.B 5 | contents.C 6 | introduction.D 7 | expressions.E 8 | udf.F 9 | datatypes.G 10 | scope.H 11 | unix.I 12 | lucid.1 /* This is for the online manual entry */ 13 | tabsandrules.J 14 | grammar.K 15 | 16 | The command benson can be used to produce a copy of each of the above files 17 | on a benson or Varian electrostatic printer. Note this is in troff format. 18 | -------------------------------------------------------------------------------- /manual/abstract.B: -------------------------------------------------------------------------------- 1 | .PP 2 | .nh 3 | .TL 4 | The pLucid Programmer's manual 5 | .AU 6 | A.A. Faustini 7 | S G Matthews (*) 8 | A AG Yaghi (**) 9 | .AI 10 | Department of Computer Science 11 | Arizona State University 12 | Tempe 85287 13 | Arizona 14 | USA 15 | .FS 16 | (*) Department of Computer Science, University of Victoria, 17 | P.O. Box 1700, Victoria BC, Canada V8W 2Y2. 18 | (**) Department of Computer Science, University of Warwick, 19 | Coventry CV4 7AL, England. 20 | .FE 21 | .AB 22 | !pLucid (pronounced "pellucid") is a member of the Lucid family of 23 | functional dataflow programming languages. A program in !pLucid defines 24 | a network of continuously operating autonomous processing stations (or filters). 25 | Computation in this network is controlled by the flow of data along arcs that 26 | interconnect the nodes, thus a !pLucid program defines a dataflow net. At the outermost level a !pLucid program is an expression that defines a functional relationship between the sequence of data values that correspond to the program's 27 | entire input activity and the sequennce of values that corresponds to the program's entire output activity. Statements in !pLucid are equations, the left hand side of each equation defining the output of the functional filter defined by the expression on the right hand side of the equation. Thus the !pLucid programmer 28 | writes programs in terms of filters and streams. The data values that make up streams are similar to those of Pop2, namely finite lists, strings, words, reals and integers. 29 | 30 | The current implementation of !pLucid runs under Berkley 31 | .UX 32 | 4.1bsd on a VAX 11/780. The !plucid evaluator simulates a Lucid dataflow 33 | machine and consequently !pLucid programs do not run as efficiently on 34 | the Vax as those written in more conventional von Neumann languages. 35 | On the other hand pLucid programs can be developed and debugged quickly 36 | and are much easier to maintain 37 | than programs written in conventional languages. 38 | -------------------------------------------------------------------------------- /manual/benson: -------------------------------------------------------------------------------- 1 | : 'print $2 pages of file $1 on the benson' 2 | expfonts <$1 > aaf 3 | cat trmacs veqnchar aaf | eqn | 4 | vtroff -o$2 -ms -3 nonie.b 5 | -------------------------------------------------------------------------------- /manual/contents.C: -------------------------------------------------------------------------------- 1 | .SP 1 2 | .DS 3 | CONTENTS 4 | 5 | 6 | Abstract 7 | 8 | Contents 9 | 10 | 1 Introduction 11 | 12 | 2 Lucid Expressions 13 | 14 | 2.1 The @where clause 15 | 16 | 2.2 The operators @next, @fby and @first 17 | 18 | 2.3 User Defined Functions 19 | 20 | 2.4 The operators @asa, @whenever and @upon 21 | 22 | 2.5 The @@is current& declaration 23 | 24 | 3 p-Lucid Data Types 25 | 26 | 3.1 Numeric Expressions 27 | 28 | 3.2 Non-Numeric Data Processing 29 | 30 | 3.2.1 Word Processing 31 | 32 | 3.2.2 Boolean Expressions and Predefined Variables 33 | 34 | 3.2.3 String Processing 35 | 36 | 3.2.4 List Processing 37 | 38 | 3.3 The objects @eod and @error 39 | 40 | 3.4 pLucid Conditional Expressions 41 | 42 | 43 | 4 Scope Rules 44 | 45 | 5 Running pLucid under UNIX 46 | 47 | 5.1 The Basics 48 | 49 | 5.2 The @filter and @arg operators 50 | 51 | 5.3 Runtime errors 52 | 53 | 5.4 The @include facility 54 | 55 | 5.5 A UNIX manual entry for pLucid 56 | 57 | 6 Tables and Rules 58 | 59 | 6.1 Tables of Operators 60 | 61 | 6.2 Associativity and Precedence Rules 62 | 63 | 6.3 Reserved Words 64 | 65 | 7 Miscellaneous 66 | 67 | 7.1 pLucid Grammar 68 | 69 | 7.2 Syntax Diagrams 70 | 71 | 7.3 Programming examples 72 | 73 | .DE 74 | -------------------------------------------------------------------------------- /manual/expressions.E: -------------------------------------------------------------------------------- 1 | .SP 5 2 | .SH 3 | 2 LUCID EXPRESSIONS 4 | .SH 5 | 2.1 THE where CLAUSE 6 | .PP 7 | The @where clause is pLucid's means of structuring programs, 8 | just as the !block is the means in Algol and Pascal. 9 | As mentioned earlier a pLucid program is an expression, 10 | and is thus a composition of subexpressions. 11 | To avoid horrendously long and complicated expressions 12 | we use the @where clause to replace subexpressions by 13 | variables. 14 | For example, the following three programs are all equivalent. 15 | .DS 16 | i. @@(x ** y) / (x**y div z)& 17 | 18 | ii. @@temp / (temp div z) where temp = x ** y; end& 19 | 20 | iii. @@temp1 / temp2 21 | @@where 22 | @@temp1 = x ** y; 23 | @@temp2 = temp1 div z; 24 | @@end 25 | .DE 26 | Moreover, @where clauses may be nested to arbitrary 27 | depths. For example the following 28 | two programs are equivalent: 29 | .DS 30 | i. @@(x-2)*(x+3)+y+z& 31 | 32 | ii. @@a+b 33 | @@where 34 | @@a = w1*w2 35 | @@where 36 | @@w1 = x-2; 37 | @@w2 = x+3; 38 | @@end; 39 | @@b = y+z; 40 | @@end& 41 | .DE 42 | In this last program, the expression @a+b is called 43 | the !!subject part& of the (outermost) @where clause. 44 | The !body of this @where clause consists of two !!definitions&, 45 | the first defining @@a&, and the second defining @@b&. 46 | The subject part of the innermost @where clause 47 | is @@w1*w2&, and its body consists of two definitions, 48 | namely those of @w1 and @@w2&. 49 | 50 | .SH 51 | 2.2 THE OPERATORS next, fby and first 52 | .PP 53 | Variables in pLucid are similar to variables 54 | in most conventional programming languages. 55 | They are dynamic objects in the sense that 56 | their values change as the program execution proceeds. 57 | Often, in the execution of a particular @where clause, it is possible 58 | to think of an execution as a 59 | sequence of steps in which the 60 | values of the local variables of the @where are updated 61 | simultaneously. 62 | For example, suppose we wish to write a program 63 | to read in a stream of numbers and output the 64 | partial sums i.e. after each number is read 65 | the sum of the numbers read so far is output. 66 | For this we can use two variables, one called @@i&, 67 | which at any step holds the last number read in, 68 | and another called @@s&, 69 | which at any step holds the sum of the numbers 70 | read so far. 71 | At each step in the program execution the variables @i and @s 72 | are updated. 73 | At any step the next value of @i is the next 74 | value to be read, while the next value 75 | of @s is the present value of @s plus the next value 76 | of @@i&. 77 | In pLucid @s is defined as 78 | follows: 79 | .PH 80 | s = i fby s+next i 81 | .PE 82 | This definition is read: 83 | The first value of @s is the first value of @@i&, 84 | while at any step in the program execution, the next value of @s 85 | is the present value of @s plus the next value of @@i&. 86 | The complete pLucid program to generate the 87 | stream @s of partial sums is: 88 | .PR 89 | s where 90 | s = i fby s+next i; 91 | end 92 | .PE 93 | This program uses the two pLucid operators @next 94 | and @fby (pronounced "followed by") which we will now introduce. 95 | @next is a prefix operator which, when applied to a variable 96 | at any step in the execution, returns the value which 97 | that variable has after the next step of the execution. 98 | Of course in a conventional language 99 | we do not know what the next value of a variable 100 | will be; however in pLucid this value can be computed from the 101 | definition. 102 | For example, suppose that a variable @x is defined in terms of 103 | a variable @y by the pLucid definition, 104 | .PH 105 | x = next y 106 | .PE 107 | then at any step in the program execution 108 | the value of @x will be the next 109 | value of @y i.e. the value of @y after the next execution step. 110 | Hence if, as we go through the execution steps, 111 | @y takes on successive values from the 112 | stream 2,4,6,8,10,..., then @x takes on the successive values 113 | from the stream 4,6,8,10,... 114 | Thus, @x is 4 when @y is 2, @x is 6 when @y is 4, and so on. 115 | .PP 116 | As well as being able to talk about the next value 117 | of a variable we can also talk about the next value of 118 | an expression. 119 | For example, suppose @x and @y are as above, then at 120 | any step the next value of @@x+y& will be the sum of 121 | the next values of @x and @@y&. 122 | So, if @z is a variable such that 123 | at any step @z is the 124 | next value of @@x+y&, then in pLucid @z is defined by: 125 | .PH 126 | z = next(x+y) 127 | .PE 128 | .PP 129 | Let us now turn our attention to 130 | the infix operator @@fby&. 131 | As described earlier, in pLucid we regard variables 132 | as dynamic objects, dynamic in the sense that 133 | their values change as the program execution proceeds. 134 | In the programs we have introduced so far, the 135 | values of all the variables 136 | are simultaneously updated at each computation step. 137 | In fact, for each variable we can talk about the 138 | "stream of values" it assumes during the course of a program 139 | execution. 140 | For example, we can interpret statements such as, "the variable 141 | @x takes the values 2 followed by 4, followed by 6 etc.", 142 | to mean that after the first execution step @x is 2, 143 | after the second step @x is 4, after the third step 144 | @x is 6, and so on. 145 | .PP 146 | In general the infix operator @fby may have the following form: 147 | .IB 148 | x = fby 149 | .IE 150 | This can be read as follows : 151 | The stream of values of @x is the initial value 152 | of the followed by each of the successive values of 153 | the . 154 | An alternative reading is: 155 | The initial value of @x is the initial value of the 156 | , 157 | and at any step in the program execution, the next 158 | value of @x is the present value of . 159 | .PP 160 | The final operator to be introduced in this section is the 161 | prefix operator called @@first&. 162 | For any expression , if the variable @x is defined by 163 | .DS 164 | @x @= @first 165 | .DE 166 | then at any step in the program execution, the value 167 | of @x is the first (i.e. initial) value of . 168 | For example, suppose @int is a variable having the values 169 | 0 followed by 1, followed by 2, 170 | followed by 3, etc. 171 | Then the expression, @@first int&, 172 | takes the values, 0 followed 0, followed by 0 ,etc. 173 | in other words, @@first int& is equivalent to the constant @@0&. 174 | .PP 175 | Now that @@next&, @fby and @first have been 176 | introduced we consider examples of their use. 177 | The first example 178 | is a filter that produces as output 179 | the stream of integers 0,1,2,..etc. 180 | .PR 181 | int where 182 | int = 0 fby 1+int; 183 | end 184 | .PE 185 | The program execution begins by producing 186 | the initial value of @@int&, i.e. 0. 187 | From then on, the execution repeatedly 188 | adds 1 to @int and outputs the result. 189 | The filter just described is so useful that the current 190 | Unix implementation includes a predefined variable called 191 | @index that produces the same values as the above filter. Thus 192 | the following program: 193 | .PR 194 | index 195 | .PE 196 | is equivalent to the one above. Moreover each @where clause 197 | has its own private @index variable. 198 | .PP 199 | The 200 | next example is a filter that produces as output 201 | the stream of squares 0,1,4,9,16,...etc. 202 | .PR 203 | sq where 204 | int = 0 fby 1+int; 205 | sq = 0 fby sq+2*int+1; 206 | end 207 | .PE 208 | As in the previous program the variable 209 | @int takes on the successive values 0,1,2,3,... 210 | The first value of @sq (i.e. the square of 0) 211 | is 0, while at any step the next value 212 | of @sq is the present value of @sq plus 213 | two times the present value of @int plus 1. 214 | Note that we have used the fact that for any n 215 | 216 | .IB 217 | (n+1)*(n+1) = n*n+2*n+1 218 | .IE 219 | .PP 220 | The next example is a filter that 221 | uses Newton's algorithm to 222 | output a stream of approximations to 223 | the square root of the input. 224 | Roughly speaking the algorithm goes as follows, to 225 | calculate the square root of a number n, take the first 226 | approximation to be 1, and thereafter take each successive approximation 227 | to be @@(x + n/x)/2&. In pLucid we might code this up as follows: 228 | .PR 229 | approx 230 | where 231 | approx = 1 fby (approx+first n/approx)/2; 232 | end 233 | .PE 234 | (For improvements on this example see sections 2.4 & 2.5) 235 | -------------------------------------------------------------------------------- /manual/frontpage: -------------------------------------------------------------------------------- 1 | .sp 2i 2 | .ps 36 3 | .ft 3 4 | .ce 5 | The 6 | .sp 0.5i 7 | .ce 8 | pLucid 9 | .sp 0.5i 10 | .ce 11 | Programming 12 | .sp 0.5i 13 | .ce 14 | Manual 15 | .sp 0.5i 16 | .ps 24 17 | .ce 18 | By 19 | .sp 0.5i 20 | .ce 21 | A.A.Faustini 22 | .sp 0.5i 23 | .ce 24 | S.G. Matthews 25 | .sp 0.5i 26 | .ce 27 | A.AG. Yaghi 28 | .sp 1i 29 | .ps 36 30 | .ce 31 | SEPTEMBER 1984 32 | .sp 1i 33 | .ps 12 34 | Copies of this manual and a pLucid distribution tape are 35 | available from A. Faustini, Department of Computer Science, Arizona 36 | State University, Tempe 85287, Arizona, USA (Please send a tape with 37 | any request) 38 | 39 | .ft 1 40 | \(co A. Faustini 1983 41 | -------------------------------------------------------------------------------- /manual/lucid.1: -------------------------------------------------------------------------------- 1 | .TH plucid 1 ARIZONA STATE UNIVERSITY 2 | .SH NAME 3 | lucomp, luval \- plucid compiler and evaluator 4 | .SH SYNOPSIS 5 | .B lucid 6 | filename 7 | .B lucomp 8 | filename 9 | .PP 10 | .B luval 11 | [ option ] ... filename 12 | .SH DESCRIPTION 13 | plucid is a Warwick implementation of the language plucid 14 | which runs on the Berkley 4.1 UNIX. To run a plucid program 15 | it must first be compiled using 16 | .I lucomp 17 | 18 | .I lucomp 19 | compiles plucid programs into intermediate expression code. 20 | If the input argument is the file name "file" then 21 | the intermediate expression code will be output to a file named "file.i", 22 | which is then used as an argument to 23 | .I luval. 24 | 25 | .PP 26 | .I luval 27 | evaluates the intermediate code in a file whose name must end with ".i". 28 | The following options are understood by 29 | .I luval: 30 | .IP "-d" 8 31 | Produce a dump of the intermediate expression file onto the 32 | standard error (usually the terminal). 33 | .IP "-c" 8 34 | Forces the evaluator into character input mode. In this mode 35 | all objects that travel 36 | along the input streams associated with the standard input are 37 | assumed to be of type character. 38 | Thus each character input (including newline) 39 | is treated by the evaluator as a string of length one (i.e. 40 | character is not a type in plucid). Note if the -c option is 41 | not used then the inputs are assumed to be a stream of Pop2 42 | data types separated by white space (i.e newline, tab, etc.) 43 | .IP "-s" 8 44 | Forces the evaluator into string output mode. In this mode 45 | all objects that travel along the output stream associated with 46 | the standard output are output as normal except for the 47 | following. 48 | When strings 49 | are output they are stripped of their quotes and 50 | escaped charaters (i.e. \\n for newline, \\33 for the character 51 | escape,...) 52 | are output as the 53 | characters themselves. In addition no white space separates 54 | succesive outputs as the would when the -s option is not used. 55 | .IP "-p" 8 56 | Used to inhibit prompting of input and outputs i.e. the 57 | evaluator does not print output(10): before producing the 58 | 11th output. Similarly it does not input x(7): when asking for 59 | the 8th input for x. 60 | .IP "-t0" 8 61 | Print a message every time a request is made for a variable during 62 | execution of the program. 63 | .IP "-t1" 8 64 | Print a brief message about garabage collection each time that it occurs 65 | during execution of the program. 66 | .IP "-t2" 8 67 | Print more information about garbage collection each time it occurs. 68 | .IP "-t5" 8 69 | Print information about action on the display as it occurs. 70 | .IP "-t6" 8 71 | Print information each time a variable is defined by the evaluator. 72 | .IP "-t9" 8 73 | In its usual mode the interpreter reports all non-fatal 74 | runtime error on the standard error. 75 | When trace 9 is set these run time errors are 76 | discarded 77 | .IP "-t30" 8 78 | Prints a demand trace for variables. This is usually run to the 79 | exclusion of all other trace options. A record can be made of 80 | the trace by piping the standard error to a file. 81 | .IP "-t*" 8 82 | New traces ( and options) may be added to the system. To find out 83 | what they are interrupt the evaluator by using control-C and 84 | type h for help. 85 | .PP 86 | The evaluator can also be interrupted during execution to set or 87 | reset any of the traces, and to inquire as to how much memory is used 88 | up so far, and in what fashion. 89 | Regular UNIX commands can also be run, and then the program resumed. 90 | To interrupt the program, hit the interrupt key. Then the following commands 91 | are available to you: 92 | .IP "q" 8 93 | Quit the evaluator. 94 | .IP "c" 8 95 | Continue interpreting. 96 | .IP "sN" 8 97 | Set trace option number N. 98 | .IP "rN" 8 99 | Reset trace option number N. 100 | .IP "m" 8 101 | Request information about memory usage. 102 | .IP "!xxx" 8 103 | Execute xxx as a UNIX command. 104 | .IP "a" 8 105 | Print out the retirement age of variables. ( the garbage 106 | collector uses a retirement scheme to collect 'old' variables ) 107 | .IP "d" 8 108 | dump the intermediate code. 109 | .IP "t" 8 110 | Print out a list of all the strings used in the program 111 | (including those entered dynamically ). 112 | .IP "h" 8 113 | Print out the current height and limits of the evaluators 114 | run time stacks. 115 | .PP 116 | For more information see the plucid programmers manual. 117 | .I lucid 118 | is a macro file that compiles and runs pLucid programs. 119 | 120 | .SH "SEE ALSO" 121 | A.Faustini, S.Matthews and A. Yaghi. 122 | 123 | .I 124 | Arizona State University 125 | Technical Report 126 | Distributed Computing Group 127 | The pLucid programmers manual 128 | TR-83-004 129 | .SH BUGS 130 | .PP 131 | Written in 1980-3 ! 132 | When too many UNIX filters are spawned by the filter function 133 | then there may be problems because of the limit on processes 134 | and pipes imposed by the UNIX operating system. 135 | .PP 136 | It is possible that when using filter there may be problems 137 | with the number of inputs needed by the child process to 138 | respond to the parent. The evaluator is demand driven, UNIX is 139 | data driven, therefore a UNIX process may require additional 140 | inputs (i.e it is data driven) to produce the required output. 141 | .PP 142 | 143 | Please report all bugs (however insignificant) to A. Faustini 144 | (i.e. mail faustini@vindalu.asu.edu) 145 | -------------------------------------------------------------------------------- /manual/prec.K: -------------------------------------------------------------------------------- 1 | .SP 43 2 | .SH 3 | 6 Tables and Rules 4 | .SH 5 | 6.1 Tables of Operators 6 | .SH 7 | Numeric operators : 8 | .IB 9 | operation syntax type of operands type of result 10 | 11 | addition + numeric numeric 12 | 13 | subtraction - numeric numeric 14 | 15 | multiplication * numeric numeric 16 | 17 | integer division div integer integer 18 | 19 | real division / numeric numeric 20 | 21 | exponentiation ** numeric numeric 22 | 23 | modulus mod integer integer 24 | 25 | numeric isnumber anything boolean 26 | 27 | less than < numeric boolean 28 | 29 | greater than > numeric boolean 30 | 31 | equal eq numeric boolean 32 | 33 | less than 34 | or equal <= numeric boolean 35 | 36 | greater than 37 | or equal >= numeric boolean 38 | 39 | not equal ne numeric boolean 40 | 41 | sin sin numeric numeric 42 | 43 | cos cos numeric numeric 44 | 45 | log log numeric numeric 46 | 47 | tan tan numeric numeric 48 | 49 | sqrt sqrt numeric numeric 50 | 51 | abs abs numeric numeric 52 | 53 | log10 log10 numeric numeric 54 | .IE 55 | .SH 56 | Word Operators: 57 | .IB 58 | operation syntax operand type type of result 59 | 60 | make a word out 61 | of a string mkword string word 62 | 63 | recognize a word isword anything boolean 64 | .IE 65 | .SH 66 | Boolean operators : 67 | .IB 68 | operation syntax type of operands 69 | 70 | conjunction and boolean 71 | 72 | disjunction or boolean 73 | 74 | negation not boolean 75 | .IE 76 | 77 | .SH 78 | String Operators: 79 | .IB 80 | operation syntax type of operands type of result 81 | 82 | make a string 83 | out of a word mkstring word string 84 | 85 | string 86 | recognition isstring anything boolean 87 | 88 | string 89 | concatination ^ string string 90 | 91 | form a string, integer, 92 | substring substr (string,integer string 93 | .IE 94 | .SH 95 | List operators : 96 | .IB 97 | operation syntax operand1 operand2 result 98 | 99 | the head of 100 | a list hd list -- anything 101 | 102 | the tail of 103 | a list tl list -- list 104 | 105 | appending two 106 | lists <> list list list 107 | 108 | construction 109 | operator :: anything list list 110 | 111 | is the list 112 | empty ? isnull list -- boolean 113 | 114 | is it an atom 115 | (not a list) isatom anything -- boolean 116 | .IE 117 | .SH 118 | Conditional expressions : 119 | .SH 120 | if expression : 121 | .IB 122 | if 123 | boolean expression 124 | then 125 | expression 126 | else 127 | expression 128 | fi 129 | .IE 130 | .SH 131 | nested if expression: 132 | .IB 133 | if 134 | boolean expression 135 | then 136 | expression 137 | elseif 138 | boolean expression 139 | then 140 | expression 141 | else ... fi 142 | .IE 143 | .SH 144 | case expression : 145 | .IB 146 | case 147 | expression 148 | of 149 | case 1 : expression 1 ; 150 | case 2 : expression 2 ; 151 | .... 152 | case n : expression n ; 153 | default : expression ; 154 | end 155 | .IE 156 | .SH 157 | Lucid operators : 158 | .IB 159 | operator syntax operand 1 operand 2 result 160 | 161 | first first anything --- anything 162 | 163 | next next anything --- anything 164 | 165 | followed by fby " anything " 166 | 167 | whenever whenever " boolean " 168 | 169 | as soon as asa " boolean " 170 | 171 | upon upon " boolean " 172 | 173 | .IE 174 | .SH 175 | current declaration : 176 | .IB 177 | identifier is current expression 178 | .IE 179 | 180 | 6.2 181 | .ul 182 | Associativity and Precedence Rules 183 | 184 | .ul 185 | Associativity of Operators: 186 | .PP 187 | An infix operator is said to be 'right associative', 188 | e.g fby, if for any expressions E1, E2, and E3, the 189 | expression 190 | 191 | X fby Y fby Z 192 | 193 | is always interpreted as 194 | 195 | X fby ( Y fby Z ) . 196 | 197 | Similarly, an infix operator is said to be 'left associative', 198 | e.g asa, if for the expressions E1, E2, and E3, the 199 | expression 200 | 201 | E1 asa E2 asa E3 202 | 203 | is always interpreted as 204 | 205 | ( E1 asa E2 ) asa E3 206 | 207 | The following table gives the associativity 208 | of infix operators in pLucid: 209 | 210 | .ul 211 | Associativity Operators 212 | 213 | left + , - , * , / , div , mod , or , and , 214 | asa , whenever , wvr, upon , if then else, 215 | case 216 | 217 | right :: , <> , fby , ^ 218 | 219 | 220 | .ul 221 | Precedence Rules : 222 | .PP 223 | These are rules to avoid clogging up programs with 224 | unnecessary brackets. 225 | 226 | e.g: 227 | If we say that '* has higher precedence than +' 228 | then an expression like '2 + 4 * 5' 229 | is always interpreted as '2 + ( 4 * 5 )'. 230 | 231 | We list here the hierarchy of precedences amongst 232 | pLucid operators. Operators with lowest precedences 233 | are at the top of the list, and ones with highest 234 | precedences are at the bottom. 235 | 236 | fby 237 | asa , upon , whenever, wvr 238 | if then else fi, case 239 | or 240 | and 241 | not 242 | eq, ne, lt, le, gt, ge, < , <= , > , >= 243 | + , - 244 | * , div , / , mod 245 | :: , <> 246 | first, next, sin, cos, log, hd, tl, isnull, isnumber, 247 | isatom, isword, isstring, mkword, mkstring, 248 | substr, iserror,iseod, 249 | ^ 250 | 251 | 252 | The 253 | .ul 254 | where-clause 255 | has the lowest precedence amongst other constructs in pLucid, 256 | so if E1, E2, and E3 are expressions, then for any operators 257 | in pLucid, say fby and next, the expression 258 | 259 | E1 fby E2 fby next E3 where 260 | ... 261 | ... 262 | ... 263 | end 264 | 265 | is always interpreted as 266 | 267 | (E1 fby E2 fby next E3) where 268 | ... 269 | ... 270 | ... 271 | end 272 | 273 | 6.3 274 | .ul 275 | Reserved Words: 276 | .PP 277 | These identifiers are reserved as keywords 278 | 279 | .DS 0 280 | if hd true 281 | then tl false 282 | else isatom sin 283 | elseif isnumber cos 284 | fi isnull log 285 | case nil is 286 | of div current 287 | default mod eod 288 | where and error 289 | end not isword 290 | first or isstring 291 | next eq iserror 292 | fby ne iseod 293 | asa lt substr 294 | whenever le mkstring 295 | wvr gt mkword 296 | upon ge arg 297 | attime log10 tan 298 | length abs sqrt 299 | 300 | .DE -0 301 | -------------------------------------------------------------------------------- /manual/scope.H: -------------------------------------------------------------------------------- 1 | .SP 29 2 | .SH 3 | 4 Scope Rules 4 | .PP 5 | The scope of an occurrence of a variable, in a pLucid 6 | @where clause, is either !local or !!global&. It is local 7 | if it is either defined or declared in that clause. 8 | The only declaration 9 | we have in pLucid is the @@is current& declaration. 10 | The variable occurring to the left of the declaration 11 | is local to that clause, while any variable occurring in the 12 | expression to the right is global. Moreover, if the variable 13 | is neither declared nor defined in the clause then its 14 | occurrence is global. 15 | .PP 16 | If an occurrence is global to a clause 17 | its value is expected to come from an outer 18 | clause, the first outer clause in which that variable is local. 19 | This also applies on the outermost clause. If 20 | a variable is left global in that clause, its 21 | value is supposed to come from an outer clause, 22 | which is the user environment. Consequently, the 23 | machine asks for that value as an input. For example: 24 | .PR 25 | X + y + z where 26 | X is current x + y ; 27 | y = 12 + z ; 28 | end 29 | .PE 30 | The occurrences of @X and @y in @@X + Y + Z& are local to the 31 | @where clause 32 | as is the first occurrence of @X in @@X is current x + y&. 33 | Also @y in @@Y = 12 + z& is local. 34 | The occurrence of @y and the second occurrence of @x in 35 | @@X is current x + y& are both global to the clause, 36 | as is @z in @@y = 12 + z&. Note pLucid binds variables dynamically. 37 | -------------------------------------------------------------------------------- /p1/cglobals.h: -------------------------------------------------------------------------------- 1 | 2 | STRING incdir; 3 | 4 | EXPRPTR expval[NESTINGDEPTH]; 5 | int expvalcnt; 6 | /* Used to keep track of the current expression part 7 | of a case statement i.e. case of ... end */ 8 | 9 | int exprlevel,exprlistcount[NESTINGDEPTH]; 10 | /* Used to keep count of the number of arguments applied 11 | to a function */ 12 | 13 | int c,peekc; 14 | /* c - used to hold current character 15 | peekc - used by input routine to allow a one character 16 | lookahead in yylex.c */ 17 | 18 | int newline; 19 | 20 | int startoflex,curr_index,curr_length,in_index; 21 | /* Used to store information about the current line and 22 | cursor postion. Used to give pLucid runtime error 23 | messages */ 24 | 25 | int const_list; 26 | /* used throughout yylex.c to indicate where or not a list 27 | constant is being read or not */ 28 | 29 | int errcount,false,true; 30 | 31 | int l; 32 | /* */ 33 | 34 | int idcount; 35 | /* Keeps count of the number of parameters a function is defined 36 | to have. */ 37 | 38 | int linebuf[BUFFERLENGTH]; 39 | /* Used to buffer the current line of characters being 40 | lexically analysed, from current input file. */ 41 | 42 | FILE *lexin; 43 | /* used to hold the value of the current input file */ 44 | 45 | YYSTYPE yylval; 46 | 47 | struct { FILE *in_fdes; 48 | STRING in_name; 49 | int in_line; 50 | } in_files[NOOFFILES]; 51 | 52 | STRING s,t; 53 | 54 | int buffer[500]; 55 | -------------------------------------------------------------------------------- /p1/cmanifs.h: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #define YYSTYPE union stacktype 5 | 6 | #include "y.tab.h" 7 | 8 | #define NKEYWORDS 162 9 | #define BUFFERLENGTH 200 10 | #define NESTINGDEPTH 50 11 | #define NOOFFILES 12 12 | #define F_CONST 1 13 | #define F_VAR 2 14 | #define F_OP 3 15 | #define F_WHERE 4 16 | #define F_DEFN 5 17 | #define F_DECL 6 18 | #define F_IDENTLISTNODE 7 19 | #define F_EXPRLISTNODE 8 20 | #define F_LISTNODE 9 21 | #define F_BODY 10 22 | #define F_FILE 11 23 | 24 | 25 | typedef struct RES RES, *RESPTR; 26 | typedef struct EXPR EXPR, *EXPRPTR; 27 | typedef char *STRING; 28 | 29 | typedef union X_OR_I { 30 | long i; 31 | double r; 32 | char *s; 33 | EXPRPTR x; 34 | } X_OR_I; 35 | 36 | typedef struct EXPR2 { 37 | int f; 38 | X_OR_I arg1, arg2; 39 | } EXPR2; 40 | 41 | typedef struct EXPR3 { 42 | int f; 43 | X_OR_I arg1,arg2,arg3; 44 | } EXPR3; 45 | 46 | typedef struct EXPR4 { 47 | int f; 48 | X_OR_I arg1,arg2,arg3,arg4; 49 | } EXPR4; 50 | 51 | typedef struct EXPR5 { 52 | int f; 53 | X_OR_I arg1,arg2,arg3,arg4,arg5; 54 | } EXPR5; 55 | 56 | struct EXPR { 57 | int f; 58 | X_OR_I arg1, arg2, arg3, arg4,arg5; 59 | }; 60 | 61 | 62 | struct RES { 63 | int len; 64 | int line; 65 | char *strg; 66 | }; 67 | 68 | union stacktype { 69 | 70 | /* for numbers returned by yylex */ 71 | float numb; 72 | 73 | /* for symbol table entries returned by yylex */ 74 | RESPTR resptr; 75 | 76 | /* for expressions pointers returned by yacc actions */ 77 | EXPRPTR eptr; 78 | }; 79 | -------------------------------------------------------------------------------- /p1/expr.c: -------------------------------------------------------------------------------- 1 | #include "cmanifs.h" 2 | #include "cglobals.h" 3 | 4 | void pass1(EXPRPTR e) 5 | { 6 | output(e); 7 | } 8 | 9 | stripstring(char *s) 10 | { 11 | int n; 12 | STRING strsave(); 13 | EXPRPTR connode(); 14 | for (n=0; (isalpha(*s)|| *s == '@'); s++) { n++; } 15 | s++; 16 | return(connode(strsave("string"),s)); 17 | } 18 | 19 | float 20 | stripcode(s) 21 | char s[]; 22 | { 23 | if (strcmp(s,"swap_t0s0")) return(1.0); 24 | if (strcmp(s,"swap_t0s1")) return(2.0); 25 | if (strcmp(s,"swap_t0s2")) return(3.0); 26 | if (strcmp(s,"swap_t1s1")) return(4.0); 27 | if (strcmp(s,"swap_t1s2")) return(5.0); 28 | if (strcmp(s,"swap_t2s3")) return(6.0); 29 | if (strcmp(s,"swap_t0t1")) return(7.0); 30 | if (strcmp(s,"swap_t0t2")) return(8.0); 31 | if (strcmp(s,"swap_t0t3")) return(9.0); 32 | if (strcmp(s,"swap_t1t2")) return(10.0); 33 | if (strcmp(s,"swap_t1t3")) return(11.0); 34 | if (strcmp(s,"swap_t2t3")) return(12.0); 35 | if (strcmp(s,"swap_s0s1")) return(13.0); 36 | if (strcmp(s,"swap_s0s2")) return(14.0); 37 | if (strcmp(s,"swap_s0s3")) return(15.0); 38 | if (strcmp(s,"swap_s1s2")) return(16.0); 39 | if (strcmp(s,"swap_s1s3")) return(17.0); 40 | if (strcmp(s,"swap_s2s3")) return(18.0); 41 | return(999.0); 42 | } 43 | 44 | float 45 | stripn(s) 46 | char s[]; 47 | { 48 | int n; 49 | float mknumber(); 50 | EXPRPTR f_connode(); 51 | for (n=0; (isalpha(*s)|| *s == '@'); s++) { n++; } 52 | return(mknumber(s)); 53 | } 54 | 55 | EXPRPTR 56 | stripnumb(s) 57 | char s[]; 58 | { 59 | int n; 60 | float mknumber(); 61 | EXPRPTR f_connode(); 62 | for (n=0; (isalpha(*s)|| *s == '@'); s++) { n++; } 63 | return(f_connode(mknumber(s))); 64 | } 65 | 66 | float 67 | mknumber(s) 68 | char s[]; 69 | { int i; 70 | float n; 71 | n = 0; 72 | for (i=0; s[i] >= '0' && s[i] <='9'; i++) 73 | n = 10 * n + s[i] -'0'; 74 | return(n); 75 | } 76 | 77 | STRING 78 | stripname(s) 79 | char s[]; 80 | { 81 | STRING strsave(); 82 | char buff[20]; 83 | int n; 84 | for (n=0; (isalpha(*s)|| *s == '@'); s++) { buff[n]= *s; n++; } 85 | buff[n]='\0'; 86 | return(strsave(buff)); 87 | } 88 | 89 | EXPRPTR 90 | filenode(first_line,cursor_position) 91 | int first_line,cursor_position; 92 | { 93 | EXPRPTR p; 94 | p = (EXPRPTR) calloc(1, sizeof(EXPR4)); 95 | p->f = F_FILE; 96 | p->arg1.s = in_files[in_index].in_name; 97 | p->arg2.i = first_line; 98 | p->arg3.i = in_files[in_index].in_line; 99 | p->arg4.i = cursor_position; 100 | return(p); 101 | } 102 | 103 | EXPRPTR 104 | connode(s1,s2) 105 | char *s1, *s2; 106 | { 107 | EXPRPTR p; 108 | p = (EXPRPTR) calloc(1, sizeof(EXPR2)); 109 | p->f = F_CONST; 110 | p->arg1.s = s1; 111 | p->arg2.s = s2; 112 | return(p); 113 | } 114 | 115 | EXPRPTR 116 | lu_connode(s1,n) 117 | STRING s1; 118 | float n; 119 | { 120 | EXPRPTR p; 121 | p = (EXPRPTR) calloc(1, sizeof(EXPR2)); 122 | p->f = F_CONST; 123 | p->arg1.s = s1; 124 | p->arg2.r = (float) n; 125 | return(p); 126 | } 127 | 128 | EXPRPTR 129 | f_connode(n) 130 | float n; 131 | { 132 | EXPRPTR p; 133 | p = (EXPRPTR) calloc(1, sizeof(EXPR2)); 134 | p->f = F_CONST; 135 | p->arg1.s = "numb"; 136 | p->arg2.r = (float) n; 137 | return(p); 138 | } 139 | 140 | EXPRPTR 141 | varnode(name,argcount,exprlist,file) 142 | char *name; 143 | int argcount; 144 | EXPRPTR exprlist,file; 145 | { 146 | EXPRPTR p; 147 | p = (EXPRPTR) calloc(1,sizeof(EXPR4)); 148 | p->f = F_VAR; 149 | p->arg1.s = name; 150 | p->arg2.i = argcount; 151 | p->arg3.x = exprlist; 152 | p->arg4.x = file; 153 | return(p); 154 | } 155 | 156 | EXPRPTR 157 | opnode(name,argcount,exprlist,file) 158 | char *name; 159 | int argcount; 160 | EXPRPTR exprlist,file; 161 | { 162 | EXPRPTR p; 163 | p = (EXPRPTR) calloc(1,sizeof(EXPR4)); 164 | p->f = F_OP; 165 | p->arg1.s = name; 166 | p->arg2.i = argcount; 167 | p->arg3.x = exprlist; 168 | p->arg4.x = file; 169 | return(p); 170 | } 171 | 172 | EXPRPTR 173 | wherenode(expr,exprlist,file) 174 | EXPRPTR expr; 175 | EXPRPTR exprlist,file; 176 | { 177 | EXPRPTR p; 178 | p = (EXPRPTR) calloc(1,sizeof(EXPR3)); 179 | p->f = F_WHERE; 180 | p->arg1.x = expr; 181 | p->arg2.x = exprlist; 182 | p->arg3.x = file; 183 | return(p); 184 | } 185 | 186 | EXPRPTR 187 | defnode(name,argcount,argnames,expr,file) 188 | char *name; 189 | int argcount; 190 | EXPRPTR argnames,expr,file; 191 | { 192 | EXPRPTR p; 193 | p = (EXPRPTR) calloc(1,sizeof(EXPR5)); 194 | p->f = F_DEFN; 195 | p->arg1.s = name; 196 | p->arg2.i = argcount; 197 | p->arg3.x = argnames; 198 | p->arg4.x = expr; 199 | p->arg5.x = file; 200 | return(p); 201 | } 202 | 203 | EXPRPTR 204 | declnode(name,expr,file) 205 | char *name; 206 | EXPRPTR expr,file; 207 | { 208 | EXPRPTR p; 209 | p = (EXPRPTR) calloc(1,sizeof(EXPR3)); 210 | p->f = F_DECL; 211 | p->arg1.s = name; 212 | p->arg2.x = expr; 213 | p->arg3.x = file; 214 | return(p); 215 | } 216 | 217 | 218 | EXPRPTR 219 | identlistnode(tail,name) 220 | EXPRPTR tail; 221 | char *name; 222 | { 223 | EXPRPTR p; 224 | p = (EXPRPTR) calloc(1,sizeof(EXPR2)); 225 | p->f = F_IDENTLISTNODE; 226 | p->arg1.x = tail; 227 | p->arg2.s = name; 228 | return(p); 229 | } 230 | 231 | EXPRPTR 232 | listnode(tail,expr) 233 | EXPRPTR expr,tail; 234 | { 235 | EXPRPTR p; 236 | p = (EXPRPTR) calloc(1,sizeof(EXPR2)); 237 | p->f = F_LISTNODE; 238 | p->arg1.x = tail; 239 | p->arg2.x = expr; 240 | return(p); 241 | } 242 | 243 | EXPRPTR 244 | bodynode(expr,tail) 245 | EXPRPTR expr,tail; 246 | { 247 | EXPRPTR p; 248 | p = (EXPRPTR) calloc(1,sizeof(EXPR2)); 249 | p->f = F_BODY; 250 | p->arg1.x = expr; 251 | p->arg2.x = tail; 252 | return(p); 253 | } 254 | 255 | EXPRPTR 256 | exprlist2(expr1,expr2) 257 | EXPRPTR expr1,expr2; 258 | { 259 | EXPRPTR p1,p2; 260 | p1 = (EXPRPTR) calloc(1,sizeof(EXPR2)); 261 | p2 = (EXPRPTR) calloc(1,sizeof(EXPR2)); 262 | p1->f = F_LISTNODE; 263 | p2->f = F_LISTNODE; 264 | p1->arg1.x = NULL; 265 | p2->arg1.x = p1; 266 | p1->arg2.x = expr1; 267 | p2->arg2.x = expr2; 268 | return(p2); 269 | } 270 | 271 | EXPRPTR 272 | exprlist3(expr1,expr2,expr3) 273 | EXPRPTR expr1,expr2,expr3; 274 | { 275 | EXPRPTR p1,p2,p3; 276 | p1 = (EXPRPTR) calloc(1,sizeof(EXPR2)); 277 | p2 = (EXPRPTR) calloc(1,sizeof(EXPR2)); 278 | p3 = (EXPRPTR) calloc(1,sizeof(EXPR2)); 279 | p1->f = F_LISTNODE; 280 | p2->f = F_LISTNODE; 281 | p3->f = F_LISTNODE; 282 | p1->arg1.x = NULL; 283 | p2->arg1.x = p1; 284 | p3->arg1.x = p2; 285 | p1->arg2.x = expr1; 286 | p2->arg2.x = expr2; 287 | p3->arg2.x = expr3; 288 | return(p3); 289 | } 290 | 291 | 292 | yyerror(a) 293 | STRING a; 294 | { fprintf(stderr,"%s\n",a); } 295 | 296 | my_yyerror(a,b) 297 | STRING a,b; 298 | 299 | { int i; 300 | fprintf(stderr,"on line %d of file %s\n", 301 | in_files[in_index].in_line,in_files[in_index].in_name); 302 | for(i=0; i<=curr_length; i++){ 303 | fprintf(stderr,"%c",linebuf[i]); } 304 | for(i=0; i1){ 80 | fname = argv[1]; 81 | in_index = 0; 82 | for(j=0; fname[j]; j++); 83 | if( (lexin=fopen(fname,"r")) == NULL ){ 84 | fprintf(stderr,"cannot open %s\n",fname); 85 | my_exit(1); 86 | } 87 | in_files[in_index].in_name = strsave(fname); 88 | sprintf(fname,"%s",argv[1]); 89 | }else{ 90 | in_files[in_index].in_name = "stdin"; 91 | fname = "?.1"; 92 | lexin = stdin; 93 | } 94 | in_files[in_index].in_line = 1; 95 | in_files[in_index].in_fdes = lexin; 96 | 97 | } 98 | 99 | void output(EXPRPTR p) 100 | { 101 | EXPRPTR tmp; 102 | switch(p->f){ 103 | case F_CONST: if (eqstring(p->arg1.s,"string")) { 104 | fprintf(stdout," [ const [ string `%s' ] ", 105 | p->arg2.s); 106 | fprintf(stdout," ] "); 107 | return; } 108 | if (eqstring(p->arg1.s,"word")) { 109 | fprintf(stdout," [ const [ word `%s' ] ", 110 | p->arg2.s); 111 | fprintf(stdout," ] "); 112 | return; } 113 | if (eqstring(p->arg1.s,"numb")) { 114 | if (p->arg2.r<0) { 115 | fprintf(stdout," [ const [ numb ~%-10.5f ] ", 116 | -p->arg2.r); } else 117 | fprintf(stdout," [ const [ numb %-10.5f ] ", 118 | p->arg2.r); 119 | fprintf(stdout," ] "); 120 | return; } 121 | fprintf(stdout," [ const [ special `%s' ] ", 122 | p->arg2.s); 123 | fprintf(stdout," ] "); 124 | return; 125 | case F_VAR: fprintf(stdout," [ var %s %d ",p->arg1.s,p->arg2.i); 126 | if (p->arg3.x!=NULL) output(p->arg3.x); 127 | output(p->arg4.x); 128 | fprintf(stdout," ] "); return; 129 | case F_OP: fprintf(stdout,"[ op %s %d ",p->arg1.s,p->arg2.i); 130 | if (p->arg3.x!=NULL) output(p->arg3.x); 131 | output(p->arg4.x); 132 | fprintf(stdout," ] "); return; 133 | case F_WHERE: fprintf(stdout," [ where "); 134 | output(p->arg1.x); 135 | output(p->arg2.x); 136 | output(p->arg3.x); 137 | fprintf(stdout," ] "); 138 | return; 139 | case F_DEFN: fprintf(stdout," [ defn %s %d ",p->arg1.s,p->arg2.i); 140 | if (p->arg2.i >0 ) output(p->arg3.x); 141 | output(p->arg4.x); 142 | output(p->arg5.x); fprintf(stdout," ] "); 143 | return; 144 | case F_DECL: fprintf(stdout," [ decl %s ",p->arg1.s); 145 | output(p->arg2.x); 146 | output(p->arg3.x); fprintf(stdout," ] "); 147 | return; 148 | case F_IDENTLISTNODE: if (p->arg1.x==NULL) { 149 | fprintf(stdout," %s ",p->arg2.s); 150 | return; } 151 | output(p->arg1.x); 152 | fprintf(stdout," %s ",p->arg2.s); 153 | return; 154 | case F_LISTNODE: if (p->arg1.x==NULL) { output(p->arg2.x); 155 | return; 156 | } 157 | output(p->arg1.x); 158 | output(p->arg2.x); 159 | return; 160 | case F_BODY: if (p->arg1.x==NULL) { output(p->arg2.x); 161 | return; 162 | } 163 | output(p->arg1.x); 164 | output(p->arg2.x); 165 | return; 166 | case F_FILE: fprintf(stdout," [ file `%s' %d %d %d ] ",p->arg1.s, 167 | p->arg2.i,p->arg3.i,p->arg4.i); 168 | return; 169 | default: fprintf(stderr,"UNKNOWN NODE IN PARSE TREE\n"); return; 170 | } 171 | } 172 | 173 | STRING 174 | strsave(s) 175 | char *s; 176 | { char *p; 177 | STRING calloc(); 178 | if ( ( p = calloc(1,strlen(s)+1))==NULL) 179 | fprintf(stderr,"ran out of space\n"); 180 | else strcpy(p,s); 181 | return(p); 182 | 183 | } 184 | 185 | eqstring(a,b) 186 | STRING a,b; 187 | { 188 | while( *a++ == *b++ ){ 189 | if ( *a == '\0' && *b == '\0' ) { 190 | return(1); 191 | } else if (*a == '\0' || *b == '\0') break; 192 | } 193 | return(0); 194 | } 195 | 196 | my_exit(n) 197 | int n; 198 | { 199 | fprintf(stdout,"%c\n",'\032'); 200 | exit(n); 201 | } 202 | -------------------------------------------------------------------------------- /p1/main.c.orig: -------------------------------------------------------------------------------- 1 | 2 | #include "cmanifs.h" 3 | #include "cglobals.h" 4 | 5 | STRING fname; 6 | 7 | main(argc,argv) 8 | int argc; 9 | char ** argv ; 10 | { int i,temp; 11 | initialise(); 12 | connect_file(argc,argv); 13 | fprintf(stderr,"Compilation begins ......\n"); 14 | i = 0; 15 | c = getc(lexin); 16 | while ( c !='\n' && c != EOF){ 17 | linebuf[i]=c; 18 | c = getc(lexin); 19 | i++; 20 | } 21 | linebuf[i] = c; 22 | curr_index = 0; 23 | curr_length = i; 24 | temp=yyparse(); 25 | if ( temp || errcount ) 26 | { 27 | fprintf(stderr,"Fatal errors: no expression file written.\n"); 28 | my_exit(1); 29 | } 30 | } 31 | 32 | accept() 33 | { 34 | if (fopen(fname,"w") == NULL) { 35 | fprintf(stderr,"cannot create %s\n",fname); 36 | my_exit(1); 37 | } 38 | } 39 | 40 | initialise() 41 | { 42 | int i; 43 | 44 | /* name the directory containing the pLucid library */ 45 | 46 | incdir = "/lucy/a/wwadge/nulu/lib"; 47 | 48 | /* initialise the simple variables */ 49 | 50 | const_list = 0; 51 | errcount = 0; 52 | peekc = 0; 53 | expvalcnt=0; 54 | startoflex =0; 55 | 56 | for (i=0; i1){ 80 | fname = argv[1]; 81 | in_index = 0; 82 | for(j=0; fname[j]; j++); 83 | if( (lexin=fopen(fname,"r")) == NULL ){ 84 | fprintf(stderr,"cannot open %s\n",fname); 85 | my_exit(1); 86 | } 87 | in_files[in_index].in_name = strsave(fname); 88 | sprintf(fname,"%s",argv[1]); 89 | }else{ 90 | in_files[in_index].in_name = "stdin"; 91 | fname = "?.1"; 92 | lexin = stdin; 93 | } 94 | in_files[in_index].in_line = 1; 95 | in_files[in_index].in_fdes = lexin; 96 | 97 | } 98 | 99 | output(p) 100 | EXPRPTR p; 101 | { 102 | EXPRPTR tmp; 103 | switch(p->f){ 104 | case F_CONST: if (eqstring(p->arg1.s,"string")) { 105 | fprintf(stdout," [ const [ string `%s' ] ", 106 | p->arg2.s); 107 | fprintf(stdout," ] "); 108 | return; } 109 | if (eqstring(p->arg1.s,"word")) { 110 | fprintf(stdout," [ const [ word `%s' ] ", 111 | p->arg2.s); 112 | fprintf(stdout," ] "); 113 | return; } 114 | if (eqstring(p->arg1.s,"numb")) { 115 | if (p->arg2.r<0) { 116 | fprintf(stdout," [ const [ numb ~%-10.5f ] ", 117 | -p->arg2.r); } else 118 | fprintf(stdout," [ const [ numb %-10.5f ] ", 119 | p->arg2.r); 120 | fprintf(stdout," ] "); 121 | return; } 122 | fprintf(stdout," [ const [ special `%s' ] ", 123 | p->arg2.s); 124 | fprintf(stdout," ] "); 125 | return; 126 | case F_VAR: fprintf(stdout," [ var %s %d ",p->arg1.s,p->arg2.i); 127 | if (p->arg3.x!=NULL) output(p->arg3.x); 128 | output(p->arg4.x); 129 | fprintf(stdout," ] "); return; 130 | case F_OP: fprintf(stdout,"[ op %s %d ",p->arg1.s,p->arg2.i); 131 | if (p->arg3.x!=NULL) output(p->arg3.x); 132 | output(p->arg4.x); 133 | fprintf(stdout," ] "); return; 134 | case F_WHERE: fprintf(stdout," [ where "); 135 | output(p->arg1.x); 136 | output(p->arg2.x); 137 | output(p->arg3.x); 138 | fprintf(stdout," ] "); 139 | return; 140 | case F_DEFN: fprintf(stdout," [ defn %s %d ",p->arg1.s,p->arg2.i); 141 | if (p->arg2.i >0 ) output(p->arg3.x); 142 | output(p->arg4.x); 143 | output(p->arg5.x); fprintf(stdout," ] "); 144 | return; 145 | case F_DECL: fprintf(stdout," [ decl %s ",p->arg1.s); 146 | output(p->arg2.x); 147 | output(p->arg3.x); fprintf(stdout," ] "); 148 | return; 149 | case F_IDENTLISTNODE: if (p->arg1.x==NULL) { 150 | fprintf(stdout," %s ",p->arg2.s); 151 | return; } 152 | output(p->arg1.x); 153 | fprintf(stdout," %s ",p->arg2.s); 154 | return; 155 | case F_LISTNODE: if (p->arg1.x==NULL) { output(p->arg2.x); 156 | return; 157 | } 158 | output(p->arg1.x); 159 | output(p->arg2.x); 160 | return; 161 | case F_BODY: if (p->arg1.x==NULL) { output(p->arg2.x); 162 | return; 163 | } 164 | output(p->arg1.x); 165 | output(p->arg2.x); 166 | return; 167 | case F_FILE: fprintf(stdout," [ file `%s' %d %d %d ] ",p->arg1.s, 168 | p->arg2.i,p->arg3.i,p->arg4.i); 169 | return; 170 | default: fprintf(stderr,"UNKNOWN NODE IN PARSE TREE\n"); return; 171 | } 172 | } 173 | 174 | STRING 175 | strsave(s) 176 | char *s; 177 | { char *p; 178 | STRING calloc(); 179 | if ( ( p = calloc(1,strlen(s)+1))==NULL) 180 | fprintf(stderr,"ran out of space\n"); 181 | else strcpy(p,s); 182 | return(p); 183 | 184 | } 185 | 186 | eqstring(a,b) 187 | STRING a,b; 188 | { 189 | while( *a++ == *b++ ){ 190 | if ( *a == '\0' && *b == '\0' ) { 191 | return(1); 192 | } else if (*a == '\0' || *b == '\0') break; 193 | } 194 | return(0); 195 | } 196 | 197 | my_exit(n) 198 | int n; 199 | { 200 | fprintf(stdout,"%c\n",'\032'); 201 | exit(n); 202 | } 203 | -------------------------------------------------------------------------------- /p1/makefile: -------------------------------------------------------------------------------- 1 | DESTDIR= /lucy/a/wwadge/nulu 2 | CFLAGS=-O -DYYMAXDEPTH=900 -g -Wno-return-type -arch i386 3 | LINT= lint -p 4 | TAR= tar -cv 5 | inc = cmanifs.h cglobals.h 6 | 7 | pass1: main.o y.tab.o yylex.o expr.o ; 8 | cc -arch i386 -g -DYYMAXDEPTH=900 main.o expr.o y.tab.o yylex.o -o pass1 9 | 10 | cp install: 11 | cp pass1 $R$(DESTDIR)/pass1 12 | rm -f *.o y.tab.h y.tab.c pass1 13 | 14 | clean: 15 | rm -f *.o y.tab.h y.tab.c pass1 16 | 17 | print: 18 | 19 | lint: main.c yylex.c expr.c 20 | $(LINT) main.c yylex.c expr.c 21 | 22 | tape: 23 | $(TAR) main.c yylex.c expr.c cmanifs.h cglobals.h flucid.y 24 | 25 | all: main.o y.tab.o yylex.o expr.o ; 26 | cc -arch i386 -s -DYYMAXDEPTH=900 main.o expr.o y.tab.o yylex.o -o pass1 27 | cp pass1 $R$(DESTDIR)/pass1 28 | rm -f *.o y.tab.h y.tab.c pass1 29 | 30 | main.o: $(inc) main.c 31 | cmanifs.h: y.tab.h 32 | y.tab.c y.tab.h: flucid.y 33 | yacc -d flucid.y 34 | y.tab.o: $(inc) y.tab.h y.tab.c 35 | yylex.o: $(inc) yylex.c 36 | expr.o: $(inc) expr.c 37 | -------------------------------------------------------------------------------- /p2/cglobals.h: -------------------------------------------------------------------------------- 1 | #define copy(x,y) x = y 2 | 3 | int l,c,peekc,errcount,in_index,true,false; 4 | 5 | char noclashes,cconst,linebuf[200],buffer[500]; 6 | 7 | FILE *lexin, *outfile,*savelex; 8 | 9 | YYSTYPE yylval; 10 | 11 | struct { 12 | FILE *in_fdes; 13 | STRING in_name; 14 | int in_line; 15 | } in_files[12]; 16 | 17 | STRING s,t; 18 | -------------------------------------------------------------------------------- /p2/cmanifs.h: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #define YYSTYPE union stacktype 4 | #include "y.tab.h" 5 | 6 | #define cycle for(;;) 7 | #define NL '\n' 8 | #define setodd 1| 9 | #define EMPTYSTRING '\0' 10 | #define YYVCOPY(x,y) copy( y , sizeof(union stacktype) , 1 , x ) 11 | 12 | #define F_CONST 1 13 | #define F_VAR 2 14 | #define F_OP 3 15 | #define F_WHERE 4 16 | #define F_DEFN 5 17 | #define F_DECL 6 18 | #define F_IDENTLISTNODE 7 19 | #define F_FILE 8 20 | #define F_LISTNODE 9 21 | 22 | typedef struct EXPR EXPR, *EXPRPTR; 23 | 24 | typedef union X_OR_I { 25 | int i; 26 | float r; 27 | char *s; 28 | EXPRPTR x; 29 | } X_OR_I; 30 | typedef struct EXPR2 { 31 | int f; 32 | X_OR_I arg1, arg2; 33 | } EXPR2; 34 | 35 | typedef struct EXPR3 { 36 | int f; 37 | X_OR_I arg1,arg2,arg3; 38 | } EXPR3; 39 | 40 | typedef struct EXPR4 { 41 | int f; 42 | X_OR_I arg1,arg2,arg3,arg4; 43 | } EXPR4; 44 | 45 | typedef struct EXPR5 { 46 | int f; 47 | X_OR_I arg1,arg2,arg3,arg4,arg5; 48 | } EXPR5; 49 | 50 | struct EXPR { 51 | int f; 52 | X_OR_I arg1, arg2, arg3, arg4, arg5; 53 | } ; 54 | 55 | typedef char *STRING; 56 | 57 | union stacktype{ 58 | 59 | /* for numbers returned by yylex */ 60 | float numb; 61 | 62 | /* for symbol table entries returned by yylex */ 63 | char *strg; 64 | 65 | /* for expressions pointers returned by yacc actions */ 66 | EXPRPTR eptr; 67 | }; 68 | -------------------------------------------------------------------------------- /p2/expr.c: -------------------------------------------------------------------------------- 1 | #include "cmanifs.h" 2 | #include "cglobals.h" 3 | 4 | void nameclashes(EXPRPTR arg); 5 | 6 | EXPRPTR 7 | pass2(e) 8 | EXPRPTR e; 9 | { noclashes = true; 10 | nameclashes(e); 11 | if (noclashes) output(e); } 12 | 13 | void nameclashes(arg) 14 | EXPRPTR arg; 15 | { return; } 16 | /*EXPRPTR file; 17 | switch(arg->f){ 18 | case F_OP: nameclashes(arg->arg3.x); 19 | return; 20 | case F_VAR: add_used(arg->arg1.s,arg->arg4.x,0); 21 | if (arg->arg2.i>0) nameclashes(arg->arg3.x); 22 | return; 23 | case F_DEFN: add_defined(arg->arg1.s,arg->arg5.x); 24 | if (arg->arg2.i>0) { 25 | add_formals(arg->arg3.x,arg->arg5.x); } 26 | nameclashes(arg->arg4.x); 27 | if (arg->arg2.i>0) { remove_formals(); 28 | } 29 | return; 30 | case F_DECL: add_defined(arg->arg1.s,arg->arg3.x); 31 | nameclashes(arg->arg2.x); 32 | return; 33 | case F_LISTNODE: if (arg->arg1.x==NULL) { nameclashes(arg->arg2.x); 34 | return; } 35 | nameclashes(arg->arg1.x); 36 | nameclashes(arg->arg2.x); 37 | return; 38 | case F_CONST: return; 39 | case F_WHERE: 40 | formals_list[valoflevel]=NULL; 41 | used_list[valoflevel]=NULL; 42 | nameclashes(arg->arg1.x); 43 | valoflevel--; 44 | return; 45 | default: fprintf(stderr,"unknown parsetree node in nameclashes()\n"); 46 | return; 47 | } 48 | } 49 | 50 | nameclash_valof(type,e) 51 | int type; 52 | EXPRPTR e; 53 | { if (valoflevel==1) return; 54 | tmp = used_list[valoflevel]; 55 | new_decls[valoflevel]=NULL; 56 | if (tmp!=NULL) { 57 | if (!is_defined(tmp->arg2.s)) 58 | new_decls[valoflevel]=identlistnode(new_decls[valoflevel],tmp->arg2.s); 59 | while(tmp->arg1.x!=NULL) { 60 | tmp=tmp->arg1.x; 61 | if (!is_defined(tmp->arg2.s)) 62 | new_decls[valoflevel]=identlistnode(new_decls[valoflevel],tmp->arg2.s); 63 | } 64 | } 65 | if (new_decls[valoflevel]!=NULL) 66 | { tmp = append(listnode(NULL,nglobnode(new_decls[valoflevel])),e);} else tmp=e; 67 | if (new_decls[valoflevel]!=NULL) export_nglobals(); 68 | new_decls[valoflevel]=NULL; 69 | if (type == F_EVALOF) 70 | return(evalofnode(tmp)); 71 | return(valofnode(tmp)); 72 | } 73 | 74 | export_nglobals() 75 | { valoflevel--; 76 | add_used_list(new_decls[valoflevel+1]); 77 | valoflevel++; 78 | } 79 | 80 | add_used_list(e) 81 | EXPRPTR e; 82 | { EXPRPTR tmp; 83 | tmp = e; 84 | if ( tmp==NULL) return; 85 | add_used(tmp->arg2.s); 86 | while (tmp->arg1.x!=NULL){ 87 | tmp=tmp->arg1.x; 88 | add_used(tmp->arg2.s); 89 | } 90 | } 91 | 92 | char 93 | is_defined(s) 94 | char *s; 95 | { EXPRPTR tmp; 96 | tmp = defined_list[valoflevel]; 97 | if (tmp==NULL) return(false); 98 | if (eqstring(s,tmp->arg2.s)) return(true); 99 | while ( tmp->arg1.x!=NULL ) { 100 | tmp = tmp -> arg1.x; 101 | if (eqstring(s,tmp->arg2.s)) return(true); 102 | } 103 | return(false); 104 | } 105 | 106 | add_defined_list(e,file) 107 | EXPRPTR e,file; 108 | { EXPRPTR tmp; 109 | tmp = e; 110 | if ( tmp==NULL) return; 111 | add_defined(tmp->arg2.s); 112 | while (tmp->arg1.x!=NULL){ 113 | tmp=tmp->arg1.x; 114 | add_defined(tmp->arg2.s); 115 | } 116 | } 117 | 118 | remove_formals() 119 | { formals_list[valoflevel]=NULL ; } 120 | 121 | add_formals(e,file) 122 | EXPRPTR e,file; 123 | { 124 | formals_list[valoflevel]=e; } 125 | 126 | 127 | add_used(s,file) 128 | char *s; 129 | { EXPRPTR tmp,identlistnode(); 130 | tmp = formals_list[valoflevel]; 131 | if ( tmp!=NULL) { 132 | if (eqstring(s,tmp->arg2.s)) return; 133 | while (tmp->arg1.x!=NULL) { 134 | tmp = tmp->arg1.x; 135 | if (eqstring(s,tmp->arg2.s)) return; 136 | } 137 | } 138 | tmp = used_list[valoflevel]; 139 | if (tmp==NULL) { used_list[valoflevel]=identlistnode(NULL,s); 140 | return; } 141 | if (eqstring(s,tmp->arg2.s)) return; 142 | while (tmp->arg1.x!=NULL) { 143 | tmp = tmp->arg1.x; 144 | if (eqstring(s,tmp->arg2.s)) return; 145 | } 146 | used_list[valoflevel]=identlistnode(used_list[valoflevel],s); 147 | } 148 | 149 | add_defined(s) 150 | char *s; 151 | { EXPRPTR tmp,identlistnode(); 152 | tmp = defined_list[valoflevel]; 153 | if (tmp==NULL) { defined_list[valoflevel]=identlistnode(NULL,s); 154 | return;} 155 | if (eqstring(s,tmp->arg2.s)) return; 156 | while (tmp->arg1.x!=NULL) { 157 | tmp = tmp->arg1.x; 158 | if (eqstring(s,tmp->arg2.s)) return; 159 | } 160 | defined_list[valoflevel]=identlistnode(defined_list[valoflevel],s); 161 | } */ 162 | 163 | EXPRPTR 164 | filenode(filename,first_line,last_line,cursor_position) 165 | char *filename; 166 | int first_line,last_line,cursor_position; 167 | { 168 | STRING calloc(); 169 | EXPRPTR p; 170 | p = (EXPRPTR) calloc(1, sizeof(EXPR4)); 171 | p->f = F_FILE; 172 | p->arg1.s = filename; 173 | p->arg2.i = first_line; 174 | p->arg3.i = last_line; 175 | p->arg4.i = cursor_position; 176 | return(p); 177 | } 178 | 179 | EXPRPTR 180 | connode(s1,s2) 181 | char *s1, *s2; 182 | { 183 | STRING calloc(); 184 | EXPRPTR p; 185 | p = (EXPRPTR) calloc(1, sizeof(EXPR2)); 186 | p->f = F_CONST; 187 | p->arg1.s = s1; 188 | p->arg2.s = s2; 189 | return(p); 190 | } 191 | 192 | EXPRPTR 193 | f_connode(n) 194 | float n; 195 | { 196 | STRING calloc(); 197 | EXPRPTR p; 198 | p = (EXPRPTR) calloc(1, sizeof(EXPR2)); 199 | p->f = F_CONST; 200 | p->arg1.s = "numb"; 201 | p->arg2.r = (float) n; 202 | return(p); 203 | } 204 | 205 | EXPRPTR 206 | varnode(name,argcount,exprlist,file) 207 | char *name; 208 | int argcount; 209 | EXPRPTR exprlist,file; 210 | { 211 | STRING calloc(); 212 | EXPRPTR p; 213 | p = (EXPRPTR) calloc(1,sizeof(EXPR4)); 214 | p->f = F_VAR; 215 | p->arg1.s = name; 216 | p->arg2.i = argcount; 217 | p->arg3.x = exprlist; 218 | p->arg4.x = file; 219 | return(p); 220 | } 221 | 222 | EXPRPTR 223 | opnode(name,argcount,exprlist,file) 224 | char *name; 225 | int argcount; 226 | EXPRPTR exprlist,file; 227 | { 228 | STRING calloc(); 229 | EXPRPTR p; 230 | p = (EXPRPTR) calloc(1,sizeof(EXPR4)); 231 | p->f = F_OP; 232 | p->arg1.s = name; 233 | p->arg2.i = argcount; 234 | p->arg3.x = exprlist; 235 | p->arg4.x = file; 236 | return(p); 237 | } 238 | 239 | EXPRPTR 240 | wherenode(expr,exprlist,file) 241 | EXPRPTR expr; 242 | EXPRPTR exprlist,file; 243 | { 244 | STRING calloc(); 245 | EXPRPTR p; 246 | p = (EXPRPTR) calloc(1,sizeof(EXPR3)); 247 | p->f = F_WHERE; 248 | p->arg1.x = expr; 249 | p->arg2.x = exprlist; 250 | p->arg3.x = file; 251 | return(p); 252 | } 253 | 254 | EXPRPTR 255 | defnode(name,argcount,argnames,expr,file) 256 | char *name; 257 | int argcount; 258 | EXPRPTR argnames,expr,file; 259 | { 260 | STRING calloc(); 261 | EXPRPTR p; 262 | p = (EXPRPTR) calloc(1,sizeof(EXPR5)); 263 | p->f = F_DEFN; 264 | p->arg1.s = name; 265 | p->arg2.i = argcount; 266 | p->arg3.x = argnames; 267 | p->arg4.x = expr; 268 | p->arg5.x = file; 269 | return(p); 270 | } 271 | 272 | EXPRPTR 273 | declnode(name,expr,file) 274 | char *name; 275 | EXPRPTR expr,file; 276 | { 277 | STRING calloc(); 278 | EXPRPTR p; 279 | p = (EXPRPTR) calloc(1,sizeof(EXPR3)); 280 | p->f = F_DECL; 281 | p->arg1.s = name; 282 | p->arg2.x = expr; 283 | p->arg3.x = file; 284 | return(p); 285 | } 286 | 287 | 288 | EXPRPTR 289 | identlistnode(tail,name) 290 | EXPRPTR tail; 291 | char *name; 292 | { 293 | STRING calloc(); 294 | EXPRPTR p; 295 | p = (EXPRPTR) calloc(1,sizeof(EXPR2)); 296 | p->f = F_IDENTLISTNODE; 297 | p->arg1.x = tail; 298 | p->arg2.s = name; 299 | return(p); 300 | } 301 | 302 | EXPRPTR 303 | listnode(tail,expr) 304 | EXPRPTR expr,tail; 305 | { 306 | STRING calloc(); 307 | EXPRPTR p; 308 | p = (EXPRPTR) calloc(1,sizeof(EXPR2)); 309 | p->f = F_LISTNODE; 310 | p->arg1.x = tail; 311 | p->arg2.x = expr; 312 | return(p); 313 | } 314 | 315 | EXPRPTR 316 | exprlist2(expr1,expr2) 317 | EXPRPTR expr1,expr2; 318 | { 319 | STRING calloc(); 320 | EXPRPTR p1,p2; 321 | p1 = (EXPRPTR) calloc(1,sizeof(EXPR2)); 322 | p2 = (EXPRPTR) calloc(1,sizeof(EXPR2)); 323 | p1->f = F_LISTNODE; 324 | p2->f = F_LISTNODE; 325 | p1->arg1.x = expr1; 326 | p2->arg1.x = p1; 327 | p1->arg2.x = p2; 328 | p1->arg2.x = NULL; 329 | p2->arg2.x = expr2; 330 | return(p2); 331 | } 332 | 333 | yyerror(a) 334 | STRING a; 335 | { fprintf(stderr,"%s\n",a); } 336 | -------------------------------------------------------------------------------- /p2/main.c: -------------------------------------------------------------------------------- 1 | 2 | #include "cmanifs.h" 3 | #include "cglobals.h" 4 | STRING fname; 5 | main(argc,argv) 6 | int argc; 7 | char ** argv ; 8 | { int i,temp; 9 | initialise(); 10 | connect_file(argc,argv); 11 | temp=yyparse(); 12 | if ( temp || errcount ) 13 | { 14 | fprintf(stderr,"Fatal errors: no expression file written.\n"); 15 | my_exit(1); 16 | } 17 | } 18 | 19 | accept() 20 | { 21 | } 22 | 23 | initialise() 24 | { 25 | int i; 26 | 27 | /* initialise the simple variables */ 28 | 29 | errcount = 0; 30 | peekc = 0; 31 | cconst = false; 32 | false = 0; 33 | true = 1; 34 | } 35 | 36 | connect_file(argc,argv) 37 | int argc; 38 | char **argv; 39 | { 40 | STRING calloc(); 41 | STRING strsave(); 42 | int i,j; 43 | extern FILE *lexin; 44 | 45 | /* connect to source file */ 46 | if(argc>1){ 47 | fname = argv[1]; 48 | in_index = 0; 49 | for(j=0; fname[j]; j++); 50 | if(j<2 || fname[j-1]!='e' || fname[j-2]!='.'){ 51 | fprintf(stderr,"%s: not a legal luthid source file\n", 52 | fname); 53 | my_exit(1); 54 | } 55 | if( (lexin=fopen(fname,"r")) == NULL ){ 56 | fprintf(stderr,"cannot open %s\n",fname); 57 | my_exit(1); 58 | } 59 | in_files[in_index].in_name = strsave(fname); 60 | fname[j-1] = 'f'; 61 | }else{ 62 | in_files[in_index].in_name = "stdin"; 63 | fname = "?.f"; 64 | lexin = stdin; 65 | } 66 | savelex=lexin; 67 | in_files[in_index].in_line = 0; 68 | in_files[in_index].in_fdes = lexin; 69 | 70 | } 71 | 72 | void output(p) 73 | EXPRPTR p; 74 | { 75 | EXPRPTR tmp; 76 | switch(p->f){ 77 | case F_CONST: if (eqstring(p->arg1.s,"string")) { 78 | fprintf(stdout," [ const [ string '%s` ] ", 79 | p->arg2.s); 80 | fprintf(stdout," ] "); 81 | return; } 82 | if (eqstring(p->arg1.s,"word")) { 83 | fprintf(stdout," [ const [ word '%s` ] ", 84 | p->arg2.s); 85 | fprintf(stdout," ] "); 86 | return; } 87 | if (eqstring(p->arg1.s,"numb")) { 88 | if (p->arg2.r<0) { 89 | fprintf(stdout," [ const [ numb ~%-10.5f ] ", 90 | -p->arg2.r); } else 91 | fprintf(stdout," [ const [ numb %-10.5f ] ", 92 | p->arg2.r); 93 | fprintf(stdout," ] "); 94 | return; } 95 | fprintf(stdout," [ const [ special %s ] ", 96 | p->arg2.s); 97 | fprintf(stdout," ] "); 98 | return; 99 | case F_VAR: fprintf(stdout," [ var %s %d ",p->arg1.s,p->arg2.i); 100 | if (p->arg3.x!=NULL) output(p->arg3.x); 101 | fprintf(stdout," ] "); return; 102 | case F_OP: fprintf(stdout,"[ op %s %d ",p->arg1.s,p->arg2.i); 103 | if (p->arg3.x!=NULL) output(p->arg3.x); 104 | output(p->arg4.x); 105 | fprintf(stdout," ] "); return; 106 | case F_WHERE: fprintf(stdout," [ where "); 107 | output(p->arg1.x); 108 | output(p->arg2.x); 109 | fprintf(stdout," ] "); 110 | return; 111 | case F_DEFN: fprintf(stdout," [ defn %s %d ",p->arg1.s,p->arg2.i); 112 | if (p->arg2.i >0 ) output(p->arg3.x); 113 | output(p->arg4.x); 114 | fprintf(stdout," ] "); 115 | return; 116 | case F_DECL: fprintf(stdout," [ decl %s ",p->arg1.s); 117 | output(p->arg2.x); 118 | fprintf(stdout," ] "); 119 | return; 120 | case F_IDENTLISTNODE: if (p->arg1.x==NULL) { 121 | fprintf(stdout," %s ",p->arg2.s); 122 | return; } 123 | output(p->arg1.x); 124 | fprintf(stdout," %s ",p->arg2.s); 125 | return; 126 | case F_LISTNODE: if (p->arg1.x==NULL) { output(p->arg2.x); 127 | return; 128 | } 129 | output(p->arg1.x); 130 | output(p->arg2.x); 131 | return; 132 | case F_FILE: fprintf(stdout," [ file '%s` %d %d %d ] ",p->arg1.s, 133 | p->arg2.i,p->arg3.i,p->arg4.i); 134 | return; 135 | default: fprintf(stderr,"UNKNOWN NODE IN PARSE TREE\n"); return; 136 | } 137 | } 138 | 139 | STRING 140 | strsave(s) 141 | char *s; 142 | { char *p; 143 | STRING calloc(); 144 | if ( ( p = calloc(1,strlen(s)+1))==NULL) 145 | fprintf(stderr,"ran out of space\n"); 146 | else strcpy(p,s); 147 | return(p); 148 | 149 | } 150 | 151 | eqstring(a,b) 152 | STRING a,b; 153 | { 154 | while( *a++ == *b++ ){ 155 | if ( *a == '\0' && *b == '\0' ) { 156 | return(1); 157 | } else if (*a == '\0' || *b == '\0') break; 158 | } 159 | return(0); 160 | } 161 | 162 | my_exit(n) 163 | int n; 164 | { 165 | fprintf(stdout,"%c\n",'\032'); 166 | exit(n); 167 | } 168 | -------------------------------------------------------------------------------- /p2/makefile: -------------------------------------------------------------------------------- 1 | DESTDIR=/usr/local/bin 2 | CFLAGS=-O -DYYMAXDEPTH=900 -g -Wno-return-type -arch i386 3 | inc = cmanifs.h cglobals.h 4 | 5 | pass2: main.o y.tab.o yylex.o expr.o ; 6 | cc -arch i386 -s main.o expr.o y.tab.o yylex.o -o pass2 7 | 8 | all: main.o y.tab.o yylex.o expr.o ; 9 | cc -arch i386 -s main.o expr.o y.tab.o yylex.o -o pass2 10 | cp pass2 $R$(DESTDIR)/pass2 11 | rm -f *.o y.tab.h y.tab.c pass2 12 | 13 | clean: 14 | rm -f *.o y.tab.h y.tab.c pass1 15 | 16 | cglobals.h: 17 | cmanifs.h: y.tab.h 18 | y.tab.c y.tab.h: tree.y 19 | yacc -d tree.y 20 | tree.y: 21 | main.c: 22 | yylex.c: 23 | expr.c: 24 | y.tab.o: $(inc) y.tab.h y.tab.c 25 | main.o: $(inc) main.c 26 | yylex.o: $(inc) yylex.c 27 | expr.o: $(inc) expr.c 28 | -------------------------------------------------------------------------------- /p2/pass2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mpw/pLucid-osx/59970fabba8008d6c63589e501a56d7c6bf2f7b0/p2/pass2 -------------------------------------------------------------------------------- /p2/tree.y: -------------------------------------------------------------------------------- 1 | 2 | 3 | %term 4 | WHERE WORD STRING_QUOTED 5 | NUMB VAR OP DEFN DECL CONST ERRFILE 6 | F_NUMB F_WORD F_STRING F_SPECIAL 7 | EXPRL STATL IDENTL BODY 8 | %{ 9 | #include "cmanifs.h" 10 | #include "cglobals.h" 11 | EXPRPTR opnode(),wherenode(),defnode(),declnode(),varnode(); 12 | EXPRPTR connode(),f_connode(),filenode(); 13 | EXPRPTR identlistnode(),listnode(),exprlist2(); 14 | %} 15 | %% 16 | 17 | accept: 18 | expr 19 | { $$.eptr = $1.eptr; 20 | pass2($1.eptr); 21 | } 22 | ; 23 | 24 | constant: '[' CONST '[' F_STRING STRING_QUOTED ']' ']' 25 | { $$.eptr = connode("string",$5.strg); } 26 | | '[' CONST '[' F_NUMB NUMB ']' ']' 27 | { $$.eptr = f_connode($5.numb); } 28 | | '[' CONST '[' F_WORD STRING_QUOTED ']' ']' 29 | { $$.eptr = connode("word",$5.strg); } 30 | | '[' CONST '[' F_SPECIAL STRING_QUOTED ']' ']' 31 | { $$.eptr = connode("special",$5.strg); } 32 | ; 33 | 34 | file: '[' ERRFILE STRING_QUOTED NUMB NUMB NUMB ']' 35 | { $$.eptr =filenode($3.strg,(int)$4.numb,(int)$5.numb,(int)$6.numb); } 36 | ; 37 | 38 | variable: '[' VAR WORD NUMB exprlist file ']' 39 | { $$.eptr = varnode($3.strg,(int)$4.numb,$5.eptr,$6.eptr); } 40 | | '[' VAR WORD NUMB file ']' 41 | { $$.eptr = varnode($3.strg,(int)$4.numb,NULL,$5.eptr); } 42 | ; 43 | 44 | operator: '[' OP WORD NUMB exprlist file ']' 45 | { $$.eptr = opnode($3.strg,(int)$4.numb,$5.eptr,$6.eptr); } 46 | ; 47 | 48 | where: '[' WHERE expr wherebody file ']' 49 | { $$.eptr = wherenode($3.eptr,$4.eptr,$5.eptr); } 50 | ; 51 | 52 | wherebody: 53 | statement 54 | { $$.eptr = listnode(NULL,$1.eptr); } 55 | | wherebody statement 56 | { $$.eptr = listnode($1.eptr,$2.eptr); } 57 | ; 58 | 59 | statement: '[' DEFN WORD NUMB argnames expr file ']' 60 | { $$.eptr = 61 | defnode($3.strg,(int)$4.numb,$5.eptr,$6.eptr,$7.eptr); } 62 | | '[' DEFN WORD NUMB expr file ']' 63 | { $$.eptr = defnode($3.strg,(int)$4.numb,NULL,$5.eptr,$6.eptr); } 64 | | '[' DECL WORD expr file ']' 65 | { $$.eptr = declnode($3.strg,$4.eptr,$5.eptr); } 66 | ; 67 | 68 | argnames: WORD 69 | { $$.eptr = identlistnode(NULL,$1.strg); } 70 | | argnames WORD 71 | { $$.eptr = identlistnode($1.eptr,$2.strg); } 72 | ; 73 | 74 | expr: where { $$.eptr = $1.eptr; } 75 | | constant { $$.eptr = $1.eptr; } 76 | | variable { $$.eptr = $1.eptr; } 77 | | operator { $$.eptr = $1.eptr; } 78 | ; 79 | 80 | exprlist: expr 81 | { $$.eptr = listnode(NULL,$1.eptr); } 82 | | exprlist expr 83 | { $$.eptr = listnode($1.eptr,$2.eptr); } 84 | ; 85 | -------------------------------------------------------------------------------- /p2/yylex.c: -------------------------------------------------------------------------------- 1 | 2 | 3 | #include "cmanifs.h" 4 | #include "cglobals.h" 5 | 6 | 7 | #define NKEYWORDS 15 8 | struct { 9 | STRING keyname; 10 | int keyret; 11 | } keywords[NKEYWORDS] = 12 | { 13 | {"var", VAR}, 14 | {"const", CONST}, 15 | {"op", OP}, 16 | {"where", WHERE}, 17 | {"decl", DECL}, 18 | {"defn", DEFN}, 19 | {"string", F_STRING}, 20 | {"word", F_WORD}, 21 | {"numb", F_NUMB}, 22 | {"special", F_SPECIAL}, 23 | {"file", ERRFILE}, 24 | {"ident", IDENTL}, 25 | {"expr", EXPRL}, 26 | {"stat", STATL}, 27 | {"body", BODY}, 28 | }; 29 | 30 | yylex() 31 | { 32 | int k; 33 | STRING strsave(); 34 | STRING getstring(),getword(); 35 | float getnum(); 36 | 37 | while(iswhite(c=lexgetc())); 38 | if ( (isalpha(c)||c=='@') && c!=EOF ) { s = getword(c); 39 | if ((k=keyfind(s))!=NKEYWORDS && cconst) 40 | { yylval.strg = keywords[k].keyname; 41 | cconst=false; 42 | return(keywords[k].keyret); } 43 | yylval.strg = s; 44 | return(WORD); } 45 | 46 | if ( isdigit(c)||c=='~' ){ yylval.numb=(float)getnum(c); 47 | return(NUMB);} 48 | if ( c=='`') { c = lexgetc(); 49 | yylval.strg=getstring(c); 50 | return(STRING_QUOTED); } 51 | if ( c == '[' ) cconst=true; 52 | return(c); 53 | } 54 | 55 | lexgetc() 56 | { 57 | int c; 58 | if(peekc!=0){ 59 | c = peekc; 60 | peekc = 0; 61 | return(c); 62 | }else if (( c = getc(lexin))==EOF){ 63 | if(in_index!=0){ 64 | in_index--; 65 | lexin = in_files[in_index].in_fdes; 66 | c = getc(lexin); 67 | } 68 | } 69 | if (c=='\n') { in_files[in_index].in_line++; 70 | } 71 | if ( c=='\032' ) my_exit(1); 72 | return(c); 73 | } 74 | 75 | STRING 76 | getword(c) 77 | char c; 78 | { int l; 79 | STRING p; 80 | char is_sign(); 81 | p = buffer; 82 | switch(c) { 83 | case ';': 84 | case ',': 85 | case '.': 86 | case ')': 87 | case '"': *p++ = c; l++; c=lexgetc(); 88 | break; 89 | case '%': *p++ = c; l++; c = lexgetc(); if(c==']' || c==')') { 90 | *p++ = c; l++; 91 | c = lexgetc(); break; } 92 | fprintf(stderr,"ERROR1"); 93 | my_exit(1); 94 | case '(': *p++ = c; l++; c = lexgetc(); if (c == '%') { *p++ = c; 95 | l++; c = lexgetc(); } 96 | peekc = c; 97 | break; 98 | case '[': *p++ = c; l++; c = lexgetc(); if (c == '%') { *p++ = c; 99 | l++; c = lexgetc(); 100 | break; } 101 | fprintf(stderr,"ERROR2"); 102 | my_exit(1); 103 | case '+': 104 | case '-': 105 | case '/': 106 | case '<': 107 | case '=': 108 | case '>': 109 | case '*': 110 | case '$': 111 | case '&': 112 | case ':': 113 | case '^': 114 | case '#': *p++ = c; l++; while (is_sign(c=lexgetc())) {*p++ = c; l++;} 115 | break; 116 | default: 117 | if ( isalpha(c)||c=='@') { *p++ = c;l++; c = lexgetc(); 118 | while ( isalpha(c) || isdigit(c) || c=='_') { *p++ = c; l++; 119 | c = lexgetc(); 120 | } 121 | } else { 122 | fprintf(stderr,"ERROR3"); 123 | my_exit(1); } 124 | break; 125 | } 126 | /* now at end of word */ 127 | peekc = c; 128 | *p = '\0'; 129 | return((STRING) strsave(buffer)); 130 | } 131 | 132 | 133 | 134 | char 135 | is_sign(c) 136 | char c; 137 | { switch(c) { 138 | case ':': 139 | case '^': 140 | case '+': 141 | case '-': 142 | case '/': 143 | case '<': 144 | case '=': 145 | case '>': 146 | case '*': 147 | case '$': 148 | case '&': 149 | case '#': return(true); 150 | default: return(false); 151 | } 152 | } 153 | 154 | STRING 155 | getstring(c) 156 | char c; 157 | { 158 | STRING p; 159 | char strstrg[200]; 160 | int i,sptr,tlen; 161 | p = buffer; 162 | l = 0; 163 | while ( c !='\'' ) { 164 | if (c == '\\') { c = lexgetc(); 165 | if (c==EOF) { 166 | yyerror("EOF reached with no closing quote for string"," "); 167 | my_exit(1); } 168 | switch (c) { 169 | default: 170 | *p++ = '\\'; 171 | l++; 172 | case '\\': 173 | case '`': 174 | break; 175 | } 176 | } 177 | switch(c){ 178 | case '\t': *p++ = '\\'; l++; 179 | *p++ = 't'; l++; 180 | break; 181 | case '\f': *p++ = '\\'; l++; 182 | *p++ = 'f'; l++; 183 | break; 184 | case '\b': *p++ = '\\'; l++; 185 | *p++ = 'b'; l++; 186 | break; 187 | default : *p++ = c; 188 | l++; 189 | } 190 | if (l == 255) { 191 | fprintf(stderr,"WARNING long string\n"); 192 | 193 | } 194 | 195 | c = lexgetc(); 196 | if (c==EOF) { 197 | yyerror("EOF reached with no closing quote for string", " "); my_exit(1); } 198 | } 199 | /* we are now at the end of the string */ 200 | *p = '\0'; 201 | return((STRING) strsave(buffer)); 202 | } 203 | 204 | float getnum(c) 205 | char c; 206 | { 207 | int sign,mansum; 208 | float expsum,expcount; 209 | if ( c=='~' ) { sign = -1; 210 | c = lexgetc(); 211 | if ( !isdigit(c) ) { 212 | yyerror("~ must be followed by a digit", 213 | " "); } 214 | } else sign = 1; 215 | mansum = c - '0'; 216 | expsum = 0; 217 | expcount = 1; 218 | for(c=lexgetc(); isdigit(c); c=lexgetc()){ 219 | mansum = mansum * 10 + (c-'0'); 220 | } 221 | if (c== '.') { 222 | for (c=lexgetc(); isdigit(c); c=lexgetc()) { 223 | expsum=expsum *10 + (c-'0'); 224 | expcount = expcount*10; 225 | } 226 | } 227 | peekc = c; 228 | return(sign*(mansum+expsum/expcount)); 229 | } 230 | int 231 | keyfind(s) 232 | STRING s; 233 | { 234 | register int i; 235 | for(i=0; i 2 | #include 3 | #define YYSTYPE union stacktype 4 | #include "y.tab.h" 5 | 6 | #define cycle for(;;) 7 | #define NL '\n' 8 | #define setodd 1| 9 | #define EMPTYSTRING '\0' 10 | #define YYVCOPY(x,y) copy( y , sizeof(union stacktype) , 1 , x ) 11 | 12 | #define F_CONST 1 13 | #define F_VAR 2 14 | #define F_OP 3 15 | #define F_WHERE 4 16 | #define F_DEFN 5 17 | #define F_DECL 6 18 | #define F_IDENTLISTNODE 7 19 | #define F_LISTNODE 8 20 | #define F_FILE 9 21 | 22 | typedef struct EXPR EXPR, *EXPRPTR; 23 | 24 | typedef union X_OR_I { 25 | int i; 26 | float r; 27 | char *s; 28 | EXPRPTR x; 29 | } X_OR_I; 30 | typedef struct EXPR2 { 31 | int f; 32 | X_OR_I arg1, arg2; 33 | } EXPR2; 34 | 35 | typedef struct EXPR3 { 36 | int f; 37 | X_OR_I arg1,arg2,arg3; 38 | } EXPR3; 39 | 40 | typedef struct EXPR4 { 41 | int f; 42 | X_OR_I arg1,arg2,arg3,arg4; 43 | } EXPR4; 44 | 45 | typedef struct EXPR5 { 46 | int f; 47 | X_OR_I arg1,arg2,arg3,arg4,arg5; 48 | } EXPR5; 49 | 50 | struct EXPR { 51 | int f; 52 | X_OR_I arg1, arg2, arg3, arg4, arg5; 53 | } ; 54 | 55 | typedef char *STRING; 56 | 57 | union stacktype{ 58 | 59 | /* for numbers returned by yylex */ 60 | float numb; 61 | 62 | /* for symbol table entries returned by yylex */ 63 | char *strg; 64 | 65 | /* for expressions pointers returned by yacc actions */ 66 | EXPRPTR eptr; 67 | }; 68 | -------------------------------------------------------------------------------- /p3/main.c: -------------------------------------------------------------------------------- 1 | 2 | #include "cmanifs.h" 3 | #include "cglobals.h" 4 | 5 | STRING fname,oldname; 6 | 7 | printfilter(newname) 8 | STRING newname; 9 | { int i; 10 | /* for (i = 0; i<21; i++) fprintf(stderr," "); 11 | for (i = 0; i<32; i++) fprintf(stderr,"-"); 12 | fprintf(stderr,"\n"); 13 | for (i = 0; i<20; i++) fprintf(stderr," "); 14 | fprintf(stderr,"|"); 15 | for (i = 0; i<32; i++) fprintf(stderr," "); 16 | fprintf(stderr,"|\n"); 17 | fprintf(stderr," Filter 3"); 18 | for (i=0; i<6; i++) fprintf(stderr," "); 19 | fprintf(stderr,"|"); 20 | fprintf(stderr," Expand upon and whenever |\n"); 21 | for (i = 0; i<20; i++) fprintf(stderr," "); 22 | fprintf(stderr,"|"); 23 | for (i = 0; i<32; i++) fprintf(stderr," "); 24 | fprintf(stderr,"|\n"); 25 | for (i = 0; i<21; i++) fprintf(stderr," "); 26 | for (i = 0; i<32; i++) fprintf(stderr,"-"); 27 | fprintf(stderr,"\n"); 28 | for (i=0; i<35; i++) fprintf(stderr," "); 29 | fprintf(stderr,"||\n"); 30 | for (i=0; i<35; i++) fprintf(stderr," "); 31 | fprintf(stderr,"|| %s\n",newname); 32 | for (i=0; i<35; i++) fprintf(stderr," "); 33 | fprintf(stderr,"||\n"); 34 | for (i=0; i<35; i++) fprintf(stderr," "); 35 | fprintf(stderr,"\\/\n"); */ 36 | } 37 | 38 | main(argc,argv) 39 | int argc; 40 | char ** argv ; 41 | { int i,temp; 42 | initialise(); 43 | connect_file(argc,argv); 44 | /*if ((outfile=fopen(fname,"w")) == NULL) { 45 | fprintf(stderr,"cannot create %s\n",fname); 46 | my_exit(1); } */ 47 | printfilter(fname); 48 | temp=yyparse(); 49 | if ( temp || errcount ) 50 | { 51 | fprintf(stderr,"Fatal errors: no expression file written.\n"); 52 | my_exit(1); 53 | } 54 | } 55 | 56 | accept() 57 | { 58 | /*if ((outfile=fopen(fname,"w")) == NULL) { 59 | fprintf(stderr,"cannot create %s\n",fname); 60 | my_exit(1); } */ 61 | } 62 | 63 | initialise() 64 | { 65 | int i; 66 | 67 | /* initialise the simple variables */ 68 | 69 | wvr_upon_count=0; 70 | errcount = 0; 71 | peekc = 0; 72 | cconst = false; 73 | false = 0; 74 | true = 1; 75 | largest = '\0'; 76 | } 77 | 78 | connect_file(argc,argv) 79 | int argc; 80 | char **argv; 81 | { 82 | STRING calloc(); 83 | STRING strsave(); 84 | int i,j; 85 | extern FILE *lexin; 86 | 87 | /* connect to source file */ 88 | if(argc>1){ 89 | fname = argv[1]; 90 | oldname = strsave(fname); 91 | in_index = 0; 92 | for(j=0; fname[j]; j++); 93 | if(j<2 || fname[j-1]!='f' || fname[j-2]!='.'){ 94 | fprintf(stderr,"%s:filename ending in .f expected\n", 95 | fname); 96 | my_exit(1); 97 | } 98 | if( (lexin=fopen(fname,"r")) == NULL ){ 99 | fprintf(stderr,"cannot open %s\n",fname); 100 | my_exit(1); 101 | } 102 | in_files[in_index].in_name = strsave(fname); 103 | fname[j-1] = 'g'; 104 | }else{ 105 | in_files[in_index].in_name = "stdin"; 106 | fname = "?.g"; 107 | lexin = stdin; 108 | } 109 | savelex=lexin; 110 | in_files[in_index].in_line = 0; 111 | in_files[in_index].in_fdes = lexin; 112 | 113 | } 114 | 115 | void output(p) 116 | EXPRPTR p; 117 | { 118 | EXPRPTR tmp; 119 | switch(p->f){ 120 | case F_CONST: if (eqstring(p->arg1.s,"string")) { 121 | fprintf(stdout," [ const [ string '%s` ] ", 122 | p->arg2.s); 123 | fprintf(stdout," ] "); 124 | return; } 125 | if (eqstring(p->arg1.s,"word")) { 126 | fprintf(stdout," [ const [ word '%s` ] ", 127 | p->arg2.s); 128 | fprintf(stdout," ] "); 129 | return; } 130 | if (eqstring(p->arg1.s,"numb")) { 131 | if (p->arg2.r<0) { 132 | fprintf(stdout," [ const [ numb ~%-10.5f ] ", 133 | -p->arg2.r); } else 134 | fprintf(stdout," [ const [ numb %-10.5f ] ", 135 | p->arg2.r); 136 | fprintf(stdout," ] "); 137 | return; } 138 | fprintf(stdout," [ const [ special %s ] ", 139 | p->arg2.s); 140 | fprintf(stdout," ] "); 141 | return; 142 | case F_VAR: fprintf(stdout," [ var %s %d ",p->arg1.s,p->arg2.i); 143 | if (p->arg3.x!=NULL) output(p->arg3.x); 144 | fprintf(stdout," ] "); return; 145 | case F_OP: fprintf(stdout,"[ op %s %d ",p->arg1.s,p->arg2.i); 146 | if (p->arg3.x!=NULL) output(p->arg3.x); 147 | output(p->arg4.x); 148 | fprintf(stdout," ] "); return; 149 | case F_WHERE: fprintf(stdout," [ where "); 150 | output(p->arg1.x); 151 | output(p->arg2.x); 152 | fprintf(stdout," ] "); 153 | return; 154 | case F_DEFN: fprintf(stdout," [ defn %s %d ",p->arg1.s,p->arg2.i); 155 | if (p->arg2.i >0 ) output(p->arg3.x); 156 | output(p->arg4.x); 157 | fprintf(stdout," ] "); 158 | return; 159 | case F_DECL: fprintf(stdout," [ decl %s ",p->arg1.s); 160 | output(p->arg2.x); 161 | fprintf(stdout," ] "); 162 | return; 163 | case F_IDENTLISTNODE: if (p->arg1.x==NULL) { 164 | fprintf(stdout," %s ",p->arg2.s); 165 | return; } 166 | output(p->arg1.x); 167 | fprintf(stdout," %s ",p->arg2.s); 168 | return; 169 | case F_LISTNODE: if (p->arg1.x==NULL) { output(p->arg2.x); 170 | return; 171 | } 172 | output(p->arg1.x); 173 | output(p->arg2.x); 174 | return; 175 | case F_FILE: fprintf(stdout," [ file '%s` %d %d %d ] ",p->arg1.s, 176 | p->arg2.i,p->arg3.i,p->arg4.i); 177 | return; 178 | default: fprintf(stderr,"UNKNOWN NODE IN PARSE TREE\n"); return; 179 | } 180 | } 181 | 182 | STRING 183 | strsave(s) 184 | char *s; 185 | { char *p; 186 | STRING calloc(); 187 | if ( ( p = calloc(1,strlen(s)+1))==NULL) 188 | fprintf(stderr,"ran out of space\n"); 189 | else strcpy(p,s); 190 | return(p); 191 | 192 | } 193 | 194 | eqstring(a,b) 195 | STRING a,b; 196 | { 197 | while( *a++ == *b++ ){ 198 | if ( *a == '\0' && *b == '\0' ) { 199 | return(1); 200 | } else if (*a == '\0' || *b == '\0') break; 201 | } 202 | return(0); 203 | } 204 | 205 | my_exit(n) 206 | int n; 207 | { 208 | fprintf(stdout,"%c\n",'\032'); 209 | exit(n); 210 | } 211 | -------------------------------------------------------------------------------- /p3/makefile: -------------------------------------------------------------------------------- 1 | R= 2 | DESTDIR=/usr/local/bin 3 | CFLAGS=-O -DYYMAXDEPTH=900 -g -Wno-return-type -arch i386 4 | LINT= lint -p 5 | TAR= tar -cv 6 | PRINT= pr -t $1 | cat -n 7 | inc = cmanifs.h cglobals.h 8 | 9 | pass3: main.o y.tab.o yylex.o expr.o ; 10 | cc -arch i386 -s main.o expr.o y.tab.o yylex.o -o pass3 11 | 12 | cp install: 13 | cp pass3 $R$(DESTDIR)/pass3 14 | rm -f *.o y.tab.h y.tab.c pass3 15 | 16 | clean: 17 | rm -f *.o y.tab.h y.tab.c pass3 18 | 19 | lint: main.c expr.c yylex.c 20 | $(LINT) main.c expr.c yylex.c 21 | 22 | tape: 23 | $(TAR) main.c expr.c yylex.c cmanifs.h cglobals.h tree.y 24 | 25 | print: 26 | $(PRINT) main.c expr.c yylex.c cmanifs.h cglobals.h tree.y 27 | 28 | 29 | all: main.o y.tab.o yylex.o expr.o ; 30 | cc -arch i386 -s main.o expr.o y.tab.o yylex.o -o pass3 31 | cp pass3 $R$(DESTDIR)/pass3 32 | rm -f *.o y.tab.h y.tab.c pass3 33 | 34 | main.o: $(inc) main.c 35 | cmanifs.h: y.tab.h 36 | y.tab.c y.tab.h: tree.y 37 | yacc -d tree.y 38 | y.tab.o: $(inc) y.tab.h y.tab.c 39 | yylex.o: $(inc) yylex.c 40 | expr.o: $(inc) expr.c 41 | -------------------------------------------------------------------------------- /p3/tree.y: -------------------------------------------------------------------------------- 1 | 2 | 3 | %term 4 | WHERE WORD STRING_QUOTED 5 | NUMB VAR OP DEFN DECL CONST ERRFILE 6 | F_NUMB F_WORD F_STRING F_SPECIAL 7 | EXPRL STATL IDENTL BODY 8 | %{ 9 | #include "cmanifs.h" 10 | #include "cglobals.h" 11 | EXPRPTR opnode(),wherenode(),defnode(),declnode(),varnode(); 12 | EXPRPTR connode(),f_connode(),filenode(); 13 | EXPRPTR identlistnode(),listnode(),exprlist2(); 14 | EXPRPTR expand_wvr_upon(); 15 | %} 16 | %% 17 | 18 | accept: 19 | expr 20 | { $$.eptr = $1.eptr; 21 | output(expand_wvr_upon($1.eptr)); 22 | } 23 | ; 24 | 25 | constant: '[' CONST '[' F_STRING STRING_QUOTED ']' ']' 26 | { $$.eptr = connode("string",$5.strg); } 27 | | '[' CONST '[' F_NUMB NUMB ']' ']' 28 | { $$.eptr = f_connode($5.numb); } 29 | | '[' CONST '[' F_WORD STRING_QUOTED ']' ']' 30 | { $$.eptr = connode("word",$5.strg); } 31 | | '[' CONST '[' F_SPECIAL WORD ']' ']' 32 | { $$.eptr = connode("special",$5.strg); } 33 | ; 34 | 35 | file: '[' ERRFILE STRING_QUOTED NUMB NUMB NUMB ']' 36 | { $$.eptr =filenode($3.strg,(int)$4.numb,(int)$5.numb,(int)$6.numb); } 37 | ; 38 | 39 | variable: '[' VAR WORD NUMB exprlist ']' 40 | { $$.eptr = varnode($3.strg,(int)$4.numb,$5.eptr); } 41 | | '[' VAR WORD NUMB ']' 42 | { $$.eptr = varnode($3.strg,(int)$4.numb,NULL); } 43 | ; 44 | 45 | operator: '[' OP WORD NUMB exprlist file ']' 46 | { $$.eptr = opnode($3.strg,(int)$4.numb,$5.eptr,$6.eptr); } 47 | ; 48 | 49 | where: '[' WHERE expr wherebody ']' 50 | { $$.eptr = wherenode($3.eptr,$4.eptr); } 51 | ; 52 | 53 | wherebody: 54 | statement 55 | { $$.eptr = listnode(NULL,$1.eptr); } 56 | | wherebody statement 57 | { $$.eptr = listnode($1.eptr,$2.eptr); } 58 | ; 59 | 60 | statement: '[' DEFN WORD NUMB argnames expr ']' 61 | { $$.eptr = 62 | defnode($3.strg,(int)$4.numb,$5.eptr,$6.eptr); } 63 | | '[' DEFN WORD NUMB expr ']' 64 | { $$.eptr = defnode($3.strg,(int)$4.numb,NULL,$5.eptr); } 65 | | '[' DECL WORD expr ']' 66 | { $$.eptr = declnode($3.strg,$4.eptr); } 67 | ; 68 | 69 | argnames: WORD 70 | { $$.eptr = identlistnode(NULL,$1.strg); } 71 | | argnames WORD 72 | { $$.eptr = identlistnode($1.eptr,$2.strg); } 73 | ; 74 | 75 | expr: where { $$.eptr = $1.eptr; } 76 | | constant { $$.eptr = $1.eptr; } 77 | | variable { $$.eptr = $1.eptr; } 78 | | operator { $$.eptr = $1.eptr; } 79 | ; 80 | 81 | exprlist: expr 82 | { $$.eptr = listnode(NULL,$1.eptr); } 83 | | exprlist expr 84 | { $$.eptr = listnode($1.eptr,$2.eptr); } 85 | ; 86 | -------------------------------------------------------------------------------- /p3/yylex.c: -------------------------------------------------------------------------------- 1 | 2 | 3 | #include "cmanifs.h" 4 | #include "cglobals.h" 5 | 6 | 7 | #define NKEYWORDS 11 8 | struct { 9 | STRING keyname; 10 | int keyret; 11 | } keywords[NKEYWORDS] = 12 | { 13 | {"var", VAR}, 14 | {"const", CONST}, 15 | {"op", OP}, 16 | {"where", WHERE}, 17 | {"decl", DECL}, 18 | {"defn", DEFN}, 19 | {"string", F_STRING}, 20 | {"word", F_WORD}, 21 | {"numb", F_NUMB}, 22 | {"special", F_SPECIAL}, 23 | {"file", ERRFILE}, 24 | }; 25 | 26 | yylex() 27 | { 28 | int k; 29 | STRING strsave(); 30 | STRING getstring(),getword(); 31 | float getnum(); 32 | 33 | while(iswhite(c=lexgetc())); 34 | if ( (isalpha(c)||c=='@') && c!=EOF ) { s = getword(c); 35 | if ((k=keyfind(s))!=NKEYWORDS&&cconst){ 36 | yylval.strg = keywords[k].keyname; 37 | cconst=false; 38 | return(keywords[k].keyret); } 39 | yylval.strg = s; 40 | return(WORD); } 41 | 42 | if ( isdigit(c)||c=='~' ){ yylval.numb=(float)getnum(c); 43 | return(NUMB);} 44 | if ( c=='\'') { c = lexgetc(); 45 | yylval.strg=getstring(c); 46 | return(STRING_QUOTED); } 47 | if (c=='[') cconst=true; 48 | return(c); 49 | } 50 | 51 | lexgetc() 52 | { 53 | int c; 54 | if(peekc!=0){ 55 | c = peekc; 56 | peekc = 0; 57 | return(c); 58 | }else if (( c = getc(lexin))==EOF){ 59 | if(in_index!=0){ 60 | in_index--; 61 | lexin = in_files[in_index].in_fdes; 62 | c = getc(lexin); 63 | } 64 | } 65 | if (c=='\n') { in_files[in_index].in_line++; 66 | } 67 | if ( c=='\032') my_exit(1); 68 | return(c); 69 | } 70 | 71 | STRING 72 | getword(c) 73 | char c; 74 | { int l; 75 | STRING p; 76 | char is_sign(); 77 | p = buffer; 78 | switch(c) { 79 | case ';': 80 | case ',': 81 | case '.': 82 | case ')': 83 | case '"': *p++ = c; l++; c=lexgetc(); 84 | break; 85 | case '%': *p++ = c; l++; c = lexgetc(); if(c==']' || c==')') { 86 | *p++ = c; l++; 87 | c = lexgetc(); break; } 88 | fprintf(stderr,"ERROR1"); 89 | my_exit(1); 90 | case '(': *p++ = c; l++; c = lexgetc(); if (c == '%') { *p++ = c; 91 | l++; c = lexgetc(); } 92 | peekc = c; 93 | break; 94 | case '[': *p++ = c; l++; c = lexgetc(); if (c == '%') { *p++ = c; 95 | l++; c = lexgetc(); 96 | break; } 97 | fprintf(stderr,"ERROR2"); 98 | my_exit(1); 99 | case '+': 100 | case '-': 101 | case '/': 102 | case '<': 103 | case '=': 104 | case '>': 105 | case '*': 106 | case '$': 107 | case '&': 108 | case ':': 109 | case '^': 110 | case '#': *p++ = c; l++; while (is_sign(c=lexgetc())) {*p++ = c; l++;} 111 | break; 112 | default: 113 | if ( isalpha(c)||c=='@') { *p++ = c;l++; c = lexgetc(); 114 | while ( isalpha(c) || isdigit(c) || c=='_') { *p++ = c; l++; 115 | c = lexgetc(); 116 | } 117 | } else { 118 | fprintf(stderr,"ERROR3"); 119 | my_exit(1); } 120 | *p = '\0'; 121 | /* 122 | if (strlen(buffer)>strlen(largest)) largest = strsave(buffer); 123 | */ 124 | break; 125 | } 126 | /* now at end of word */ 127 | peekc = c; 128 | *p = '\0'; 129 | return((STRING) strsave(buffer)); 130 | } 131 | 132 | 133 | 134 | char 135 | is_sign(c) 136 | char c; 137 | { switch(c) { 138 | case ':': 139 | case '^': 140 | case '+': 141 | case '-': 142 | case '/': 143 | case '<': 144 | case '=': 145 | case '>': 146 | case '*': 147 | case '$': 148 | case '&': 149 | case '#': return(true); 150 | default: return(false); 151 | } 152 | } 153 | 154 | STRING 155 | getstring(c) 156 | char c; 157 | { 158 | STRING p; 159 | char strstrg[200]; 160 | int i,sptr,tlen; 161 | p = buffer; 162 | l = 0; 163 | while ( c !='`' ) { 164 | if (c == '\\') { c = lexgetc(); 165 | if (c==EOF) { 166 | yyerror("EOF reached with no closing quote for string"," "); 167 | my_exit(1); } 168 | switch (c) { 169 | default: 170 | *p++ = '\\'; 171 | l++; 172 | case '\\': 173 | case '`': 174 | break; 175 | } 176 | } 177 | switch(c){ 178 | case '\t': *p++ = '\\'; l++; 179 | *p++ = 't'; l++; 180 | break; 181 | case '\f': *p++ = '\\'; l++; 182 | *p++ = 'f'; l++; 183 | break; 184 | case '\b': *p++ = '\\'; l++; 185 | *p++ = 'b'; l++; 186 | break; 187 | default : *p++ = c; 188 | l++; 189 | } 190 | if (l == 255) { 191 | fprintf(stderr,"WARNING long string\n"); 192 | 193 | } 194 | 195 | c = lexgetc(); 196 | if (c==EOF) { 197 | yyerror("EOF reached with no closing quote for string", " "); my_exit(1); } 198 | } 199 | /* we are now at the end of the string */ 200 | *p = '\0'; 201 | return((STRING) strsave(buffer)); 202 | } 203 | 204 | float getnum(c) 205 | char c; 206 | { 207 | int sign,mansum; 208 | float expsum,expcount; 209 | if ( c=='~' ) { sign = -1; 210 | c = lexgetc(); 211 | if ( !isdigit(c) ) { 212 | yyerror("~ must be followed by a digit", 213 | " "); } 214 | } else sign = 1; 215 | mansum = c - '0'; 216 | expsum = 0; 217 | expcount = 1; 218 | for(c=lexgetc(); isdigit(c); c=lexgetc()){ 219 | mansum = mansum * 10 + (c-'0'); 220 | } 221 | if (c== '.') { 222 | for (c=lexgetc(); isdigit(c); c=lexgetc()) { 223 | expsum=expsum *10 + (c-'0'); 224 | expcount = expcount*10; 225 | } 226 | } 227 | peekc = c; 228 | return(sign*(mansum+expsum/expcount)); 229 | } 230 | int 231 | keyfind(s) 232 | STRING s; 233 | { 234 | register int i; 235 | for(i=0; i 2 | #include 3 | #define YYSTYPE union stacktype 4 | #include "y.tab.h" 5 | 6 | #define cycle for(;;) 7 | #define NL '\n' 8 | #define setodd 1| 9 | #define EMPTYSTRING '\0' 10 | #define YYVCOPY(x,y) copy( y , sizeof(union stacktype) , 1 , x ) 11 | 12 | #define F_CONST 1 13 | #define F_VAR 2 14 | #define F_OP 3 15 | #define F_WHERE 4 16 | #define F_DEFN 5 17 | #define F_DECL 6 18 | #define F_IDENTLISTNODE 7 19 | #define F_LISTNODE 8 20 | #define F_FILE 9 21 | #define F_VALOF 10 22 | #define F_EGLOBALS 11 23 | #define F_NGLOBALS 12 24 | #define F_EVALOF 13 25 | 26 | typedef struct EXPR EXPR, *EXPRPTR; 27 | 28 | typedef union X_OR_I { 29 | int i; 30 | float r; 31 | char *s; 32 | EXPRPTR x; 33 | } X_OR_I; 34 | typedef struct EXPR2 { 35 | int f; 36 | X_OR_I arg1, arg2; 37 | } EXPR2; 38 | 39 | typedef struct EXPR3 { 40 | int f; 41 | X_OR_I arg1,arg2,arg3; 42 | } EXPR3; 43 | 44 | typedef struct EXPR4 { 45 | int f; 46 | X_OR_I arg1,arg2,arg3,arg4; 47 | } EXPR4; 48 | 49 | typedef struct EXPR5 { 50 | int f; 51 | X_OR_I arg1,arg2,arg3,arg4,arg5; 52 | } EXPR5; 53 | 54 | struct EXPR { 55 | int f; 56 | X_OR_I arg1, arg2, arg3, arg4, arg5; 57 | } ; 58 | 59 | typedef char *STRING; 60 | typedef struct FFTYPE FFITEM, *FFPTR; 61 | 62 | struct FFTYPE { 63 | STRING name; 64 | EXPRPTR rhs; 65 | FFPTR next_d; 66 | }; 67 | 68 | 69 | union stacktype{ 70 | 71 | /* for numbers returned by yylex */ 72 | float numb; 73 | 74 | /* for symbol table entries returned by yylex */ 75 | char *strg; 76 | 77 | /* for expressions pointers returned by yacc actions */ 78 | EXPRPTR eptr; 79 | }; 80 | -------------------------------------------------------------------------------- /p4/expr.c: -------------------------------------------------------------------------------- 1 | #include "cmanifs.h" 2 | #include "cglobals.h" 3 | 4 | 5 | EXPRPTR 6 | filenode(filename,first_line,last_line,cursor_position) 7 | char *filename; 8 | int first_line,last_line,cursor_position; 9 | { 10 | STRING calloc(),strsave(); 11 | EXPRPTR p; 12 | p = (EXPRPTR) calloc(1, sizeof(EXPR4)); 13 | p->f = F_FILE; 14 | p->arg1.s = strsave(filename); 15 | p->arg2.i = first_line; 16 | p->arg3.i = last_line; 17 | p->arg4.i = cursor_position; 18 | return(p); 19 | } 20 | 21 | EXPRPTR 22 | connode(s1,s2) 23 | char *s1, *s2; 24 | { 25 | STRING calloc(),strsave(); 26 | EXPRPTR p; 27 | p = (EXPRPTR) calloc(1, sizeof(EXPR2)); 28 | p->f = F_CONST; 29 | p->arg1.s = strsave(s1); 30 | p->arg2.s = strsave(s2); 31 | return(p); 32 | } 33 | 34 | EXPRPTR 35 | f_connode(n) 36 | float n; 37 | { 38 | STRING calloc(),strsave(); 39 | EXPRPTR p; 40 | p = (EXPRPTR) calloc(1, sizeof(EXPR2)); 41 | p->f = F_CONST; 42 | p->arg1.s = strsave("numb"); 43 | p->arg2.r = (float) n; 44 | return(p); 45 | } 46 | 47 | EXPRPTR 48 | varnode(name,argcount,exprlist) 49 | char *name; 50 | int argcount; 51 | EXPRPTR exprlist; 52 | { 53 | STRING calloc(),strsave(); 54 | EXPRPTR p; 55 | p = (EXPRPTR) calloc(1,sizeof(EXPR3)); 56 | p->f = F_VAR; 57 | p->arg1.s = strsave(name); 58 | p->arg2.i = argcount; 59 | p->arg3.x = exprlist; 60 | return(p); 61 | } 62 | 63 | EXPRPTR 64 | opnode(name,argcount,exprlist,file) 65 | char *name; 66 | int argcount; 67 | EXPRPTR exprlist,file; 68 | { 69 | STRING calloc(),strsave(); 70 | EXPRPTR p; 71 | p = (EXPRPTR) calloc(1,sizeof(EXPR4)); 72 | p->f = F_OP; 73 | p->arg1.s = strsave(name); 74 | p->arg2.i = argcount; 75 | p->arg3.x = exprlist; 76 | p->arg4.x = file; 77 | return(p); 78 | } 79 | 80 | EXPRPTR 81 | eglobnode(namelist) 82 | EXPRPTR namelist; 83 | { 84 | STRING calloc(); 85 | EXPRPTR p; 86 | p = (EXPRPTR) calloc(1,sizeof(EXPR)); 87 | p->f = F_EGLOBALS; 88 | p->arg1.x = namelist; 89 | return(p); 90 | } 91 | 92 | EXPRPTR 93 | nglobnode(namelist) 94 | EXPRPTR namelist; 95 | { 96 | STRING calloc(); 97 | EXPRPTR p; 98 | p = (EXPRPTR) calloc(1,sizeof(EXPR)); 99 | p->f = F_NGLOBALS; 100 | p->arg1.x = namelist; 101 | return(p); 102 | } 103 | 104 | EXPRPTR 105 | valofnode(exprlist) 106 | EXPRPTR exprlist; 107 | { 108 | STRING calloc(); 109 | EXPRPTR p,listnode(); 110 | p = (EXPRPTR) calloc(1,sizeof(EXPR)); 111 | p->f = F_VALOF; 112 | p->arg1.x = exprlist; 113 | return(p); 114 | } 115 | 116 | EXPRPTR 117 | evalofnode(exprlist) 118 | EXPRPTR exprlist; 119 | { 120 | STRING calloc(); 121 | EXPRPTR p,listnode(); 122 | p = (EXPRPTR) calloc(1,sizeof(EXPR)); 123 | p->f = F_EVALOF; 124 | p->arg1.x = exprlist; 125 | return(p); 126 | } 127 | 128 | EXPRPTR 129 | wherenode(expr,exprlist) 130 | EXPRPTR expr; 131 | EXPRPTR exprlist; 132 | { 133 | STRING calloc(); 134 | EXPRPTR p; 135 | p = (EXPRPTR) calloc(1,sizeof(EXPR2)); 136 | p->f = F_WHERE; 137 | p->arg1.x = expr; 138 | p->arg2.x = exprlist; 139 | return(p); 140 | } 141 | 142 | EXPRPTR 143 | defnode(name,argcount,argnames,expr) 144 | char *name; 145 | int argcount; 146 | EXPRPTR argnames,expr; 147 | { 148 | STRING calloc(),strsave(); 149 | EXPRPTR p; 150 | p = (EXPRPTR) calloc(1,sizeof(EXPR4)); 151 | p->f = F_DEFN; 152 | p->arg1.s = strsave(name); 153 | p->arg2.i = argcount; 154 | p->arg3.x = argnames; 155 | p->arg4.x = expr; 156 | return(p); 157 | } 158 | 159 | EXPRPTR 160 | declnode(name,expr) 161 | char *name; 162 | EXPRPTR expr; 163 | { 164 | STRING calloc(),strsave(); 165 | EXPRPTR p; 166 | p = (EXPRPTR) calloc(1,sizeof(EXPR2)); 167 | p->f = F_DECL; 168 | p->arg1.s = strsave(name); 169 | p->arg2.x = expr; 170 | return(p); 171 | } 172 | 173 | 174 | EXPRPTR 175 | identlistnode(tail,name) 176 | EXPRPTR tail; 177 | char *name; 178 | { 179 | STRING calloc(),strsave(); 180 | EXPRPTR p; 181 | p = (EXPRPTR) calloc(1,sizeof(EXPR2)); 182 | p->f = F_IDENTLISTNODE; 183 | p->arg1.x = tail; 184 | p->arg2.s = name; 185 | return(p); 186 | } 187 | 188 | EXPRPTR 189 | listnode(tail,expr) 190 | EXPRPTR expr,tail; 191 | { 192 | STRING calloc(); 193 | EXPRPTR p; 194 | p = (EXPRPTR) calloc(1,sizeof(EXPR2)); 195 | p->f = F_LISTNODE; 196 | p->arg1.x = tail; 197 | p->arg2.x = expr; 198 | return(p); 199 | } 200 | 201 | EXPRPTR 202 | exprlist2(expr1,expr2) 203 | EXPRPTR expr1,expr2; 204 | { 205 | STRING calloc(); 206 | EXPRPTR p1,p2; 207 | p1 = (EXPRPTR) calloc(1,sizeof(EXPR2)); 208 | p2 = (EXPRPTR) calloc(1,sizeof(EXPR2)); 209 | p1->f = F_LISTNODE; 210 | p2->f = F_LISTNODE; 211 | p1->arg1.x = NULL; 212 | p2->arg1.x = p1; 213 | p1->arg2.x = expr1; 214 | p2->arg2.x = expr2; 215 | return(p2); 216 | } 217 | 218 | yyerror(a) 219 | STRING a; 220 | { fprintf(stderr,"%s\n",a); } 221 | -------------------------------------------------------------------------------- /p4/main.c: -------------------------------------------------------------------------------- 1 | 2 | #include "cmanifs.h" 3 | #include "cglobals.h" 4 | 5 | STRING fname,oldname; 6 | 7 | printfilter(newname) 8 | STRING newname; 9 | { int i; 10 | } 11 | 12 | main(argc,argv) 13 | int argc; 14 | char ** argv ; 15 | { int i,temp; 16 | initialise(); 17 | connect_file(argc,argv); 18 | /*if ((outfile=fopen(fname,"w")) == NULL) { 19 | fprintf(stderr,"cannot create %s\n",fname); 20 | my_exit(1); } */ 21 | printfilter(fname); 22 | temp=yyparse(); 23 | if ( temp || errcount ) 24 | { 25 | fprintf(stderr,"Fatal errors: no expression file written.\n"); 26 | my_exit(1); 27 | } 28 | } 29 | 30 | accept() 31 | { 32 | /*if ((outfile=fopen(fname,"w")) == NULL) { 33 | fprintf(stderr,"cannot create %s\n",fname); 34 | my_exit(1); } */ 35 | } 36 | 37 | initialise() 38 | { 39 | int i; 40 | 41 | /* initialise the simple variables */ 42 | currentlevel=0; 43 | funclevel=0; 44 | valoflevel=0; 45 | fflevel=0; 46 | ffcount=0; 47 | errcount = 0; 48 | peekc = 0; 49 | cconst = false; 50 | false = 0; 51 | true = 1; 52 | 53 | largest = '\0'; 54 | 55 | for(i=0; i<100; i++){ new_decls[i]=NULL; 56 | new_defs[i] =NULL; 57 | defined_list[i]=NULL; 58 | used_list[i]=NULL; 59 | formals_list[i]=NULL; 60 | f_level[i]=0; 61 | new_def[i]=NULL; 62 | } 63 | } 64 | 65 | connect_file(argc,argv) 66 | int argc; 67 | char **argv; 68 | { 69 | STRING calloc(); 70 | STRING strsave(); 71 | int i,j; 72 | extern FILE *lexin; 73 | 74 | /* connect to source file */ 75 | if(argc>1){ 76 | fname = argv[1]; 77 | oldname = strsave(fname); 78 | in_index = 0; 79 | for(j=0; fname[j]; j++); 80 | if(j<2 || fname[j-1]!='g' || fname[j-2]!='.'){ 81 | fprintf(stderr,"%s:filename ending in .g expected\n", 82 | fname); 83 | my_exit(1); 84 | } 85 | if( (lexin=fopen(fname,"r")) == NULL ){ 86 | fprintf(stderr,"cannot open %s\n",fname); 87 | my_exit(1); 88 | } 89 | in_files[in_index].in_name = strsave(fname); 90 | fname[j-1] = 'h'; 91 | }else{ 92 | in_files[in_index].in_name = "stdin"; 93 | fname = "?.h"; 94 | lexin = stdin; 95 | } 96 | savelex=lexin; 97 | in_files[in_index].in_line = 0; 98 | in_files[in_index].in_fdes = lexin; 99 | 100 | } 101 | 102 | void output(p) 103 | EXPRPTR p; 104 | { 105 | EXPRPTR tmp; 106 | switch(p->f){ 107 | case F_CONST: if (eqstring(p->arg1.s,"string")) { 108 | fprintf(stdout," [ const [ strg `%s' ] ", 109 | p->arg2.s); 110 | fprintf(stdout," ] "); 111 | return; } 112 | if (eqstring(p->arg1.s,"word")) { 113 | fprintf(stdout," [ const [ wrd `%s' ] ", 114 | p->arg2.s); 115 | fprintf(stdout," ] "); 116 | return; } 117 | if (eqstring(p->arg1.s,"numb")) { 118 | if (p->arg2.r<0) { 119 | fprintf(stdout," [ const [ numb ~%-10.5f ] ", 120 | -p->arg2.r); } else 121 | fprintf(stdout," [ const [ numb %-10.5f ] ", 122 | p->arg2.r); 123 | fprintf(stdout," ] "); 124 | return; } 125 | fprintf(stdout," [ const [ %s ] ", 126 | p->arg2.s); 127 | fprintf(stdout," ] "); 128 | return; 129 | case F_VAR: if (p->arg2.i==0) { 130 | fprintf(stdout," [ nullry %s %d ",p->arg1.s,p->arg2.i); 131 | if (p->arg3.x!=NULL) output(p->arg3.x); 132 | fprintf(stdout," ] "); return; } 133 | fprintf(stdout," [ nonnullry %s %d ",p->arg1.s,p->arg2.i); 134 | if (p->arg3.x!=NULL) output(p->arg3.x); 135 | fprintf(stdout," ] "); return; 136 | case F_OP: fprintf(stdout,"[ op [ %s %d ",p->arg1.s,p->arg2.i); 137 | if (p->arg3.x!=NULL) output(p->arg3.x); 138 | fprintf(stdout," ] "); 139 | output(p->arg4.x); 140 | fprintf(stdout," ] "); return; 141 | case F_EVALOF: fprintf(stdout," [ evalof "); 142 | output(p->arg1.x); 143 | fprintf(stdout," ] "); 144 | return; 145 | case F_VALOF: fprintf(stdout," [ valof "); 146 | output(p->arg1.x); 147 | fprintf(stdout," ] "); 148 | return; 149 | case F_DEFN: fprintf(stdout," [ defn %s %d ",p->arg1.s,p->arg2.i); 150 | if (p->arg2.i >0 ) { fprintf(stdout," [ frmls "); 151 | output(p->arg3.x); 152 | fprintf(stdout," ] "); } 153 | output(p->arg4.x); 154 | fprintf(stdout," ] "); 155 | return; 156 | case F_DECL: fprintf(stdout," [ decl %s ",p->arg1.s); 157 | output(p->arg2.x); 158 | fprintf(stdout," ] "); 159 | return; 160 | case F_EGLOBALS: fprintf(stdout," [ eglobal "); 161 | output(p->arg1.x); fprintf(stdout," ] "); 162 | return; 163 | case F_NGLOBALS: fprintf(stdout," [ nglobal "); 164 | output(p->arg1.x); fprintf(stdout," ] "); 165 | return; 166 | case F_IDENTLISTNODE: if (p->arg1.x==NULL) { 167 | fprintf(stdout," %s ",p->arg2.s); 168 | return; } 169 | output(p->arg1.x); 170 | fprintf(stdout," %s ",p->arg2.s); 171 | return; 172 | case F_LISTNODE: if (p->arg1.x==NULL) { output(p->arg2.x); 173 | return; 174 | } 175 | output(p->arg1.x); 176 | output(p->arg2.x); 177 | return; 178 | case F_FILE: fprintf(stdout," [ cxfile `%s' %d %d %d ] ",p->arg1.s, 179 | p->arg2.i,p->arg3.i,p->arg4.i); 180 | return; 181 | default: fprintf(stderr,"UNKNOWN NODE IN PARSE TREE#%d#\n",p->f); 182 | return; 183 | } 184 | } 185 | 186 | STRING 187 | strsave(s) 188 | char *s; 189 | { char *p; 190 | STRING calloc(); 191 | if ( ( p = calloc(1,strlen(s)+1))==NULL) 192 | fprintf(stderr,"ran out of space\n"); 193 | else strcpy(p,s); 194 | return(p); 195 | 196 | } 197 | 198 | eqstring(a,b) 199 | STRING a,b; 200 | { 201 | while( *a++ == *b++ ){ 202 | if ( *a == '\0' && *b == '\0' ) { 203 | return(1); 204 | } else if (*a == '\0' || *b == '\0') break; 205 | } 206 | return(0); 207 | } 208 | 209 | my_exit(n) 210 | int n; 211 | { 212 | fprintf(stdout,"%c\n",'\032'); 213 | exit(n); 214 | } 215 | -------------------------------------------------------------------------------- /p4/makefile: -------------------------------------------------------------------------------- 1 | DESTDIR=/usr/local/bin 2 | CFLAGS=-O -DYYMAXDEPTH=900 -g -Wno-return-type -arch i386 3 | LINT= lint -p 4 | TAR= tar -cv 5 | PRINT= pr -t $1 | cat -n 6 | inc = cmanifs.h cglobals.h 7 | 8 | pass4: main.o y.tab.o yylex.o expr.o walk.o; 9 | cc -arch i386 -g main.o expr.o y.tab.o yylex.o walk.o -o pass4 10 | 11 | cp install: 12 | cp pass4 $R$(DESTDIR)/pass4 13 | rm -f *.o y.tab.h y.tab.c pass4 14 | 15 | clean: 16 | rm -f *.o y.tab.h y.tab.c pass4 17 | 18 | lint: main.c expr.c yylex.c walk.c 19 | $(LINT) main.c expr.c yylex.c walk.c 20 | 21 | tape: 22 | $(TAR) main.c expr.c yylex.c walk.c cmanifs.h cglobals.h tree.y 23 | 24 | print: 25 | $(PRINT) main.c expr.c yylex.c walk.c cmanifs.h cglobals.h tree.y 26 | 27 | 28 | all: main.o y.tab.o yylex.o expr.o walk.o ; 29 | cc -arch i386 -g main.o expr.o y.tab.o yylex.o walk.o -o pass4 30 | cp pass4 $R$(DESTDIR)/pass4 31 | rm -f *.o y.tab.h y.tab.c pass4 32 | 33 | main.o: $(inc) main.c 34 | cmanifs.h: y.tab.h 35 | y.tab.c y.tab.h: tree.y 36 | yacc -d tree.y 37 | y.tab.o: $(inc) y.tab.h y.tab.c 38 | yylex.o: $(inc) yylex.c 39 | expr.o: $(inc) expr.c 40 | walk.o: $(inc) walk.c 41 | -------------------------------------------------------------------------------- /p4/tree.y: -------------------------------------------------------------------------------- 1 | 2 | 3 | %term 4 | WHERE WORD STRING_QUOTED 5 | NUMB VAR OP DEFN DECL CONST ERRFILE 6 | F_NUMB F_WORD F_STRING F_SPECIAL 7 | EXPRL STATL IDENTL BODY 8 | %{ 9 | #include "cmanifs.h" 10 | #include "cglobals.h" 11 | EXPRPTR opnode(),wherenode(),defnode(),declnode(),varnode(); 12 | EXPRPTR connode(),f_connode(),filenode(); 13 | EXPRPTR identlistnode(),listnode(); 14 | %} 15 | %% 16 | 17 | accept: 18 | expr 19 | { $$.eptr = $1.eptr; 20 | pass4($1.eptr); 21 | } 22 | ; 23 | 24 | constant: '[' CONST '[' F_STRING STRING_QUOTED ']' ']' 25 | { $$.eptr = connode("string",$5.strg); } 26 | | '[' CONST '[' F_NUMB NUMB ']' ']' 27 | { $$.eptr = f_connode($5.numb); } 28 | | '[' CONST '[' F_WORD STRING_QUOTED ']' ']' 29 | { $$.eptr = connode("word",$5.strg); } 30 | | '[' CONST '[' F_SPECIAL WORD ']' ']' 31 | { $$.eptr = connode("special",$5.strg); } 32 | ; 33 | 34 | file: '[' ERRFILE STRING_QUOTED NUMB NUMB NUMB ']' 35 | { $$.eptr =filenode($3.strg,(int)$4.numb,(int)$5.numb,(int)$6.numb); } 36 | ; 37 | 38 | variable: '[' VAR WORD NUMB exprlist ']' 39 | { $$.eptr = varnode($3.strg,(int)$4.numb,$5.eptr); } 40 | | '[' VAR WORD NUMB ']' 41 | { $$.eptr = varnode($3.strg,(int)$4.numb,NULL); } 42 | ; 43 | 44 | operator: '[' OP WORD NUMB exprlist file ']' 45 | { $$.eptr = opnode($3.strg,(int)$4.numb,$5.eptr,$6.eptr); } 46 | ; 47 | 48 | where: '[' WHERE expr wherebody ']' 49 | { $$.eptr = wherenode($3.eptr,$4.eptr); } 50 | ; 51 | 52 | wherebody: 53 | statement 54 | { $$.eptr = listnode(NULL,$1.eptr); } 55 | | wherebody statement 56 | { $$.eptr = listnode($1.eptr,$2.eptr); } 57 | ; 58 | 59 | statement: '[' DEFN WORD NUMB argnames expr ']' 60 | { $$.eptr = 61 | defnode($3.strg,(int)$4.numb,$5.eptr,$6.eptr); } 62 | | '[' DEFN WORD NUMB expr ']' 63 | { $$.eptr = defnode($3.strg,(int)$4.numb,NULL,$5.eptr); } 64 | | '[' DECL WORD expr ']' 65 | { $$.eptr = declnode($3.strg,$4.eptr); } 66 | ; 67 | 68 | argnames: WORD 69 | { $$.eptr = identlistnode(NULL,$1.strg); } 70 | | argnames WORD 71 | { $$.eptr = identlistnode($1.eptr,$2.strg); } 72 | ; 73 | 74 | expr: where { $$.eptr = $1.eptr; } 75 | | constant { $$.eptr = $1.eptr; } 76 | | variable { $$.eptr = $1.eptr; } 77 | | operator { $$.eptr = $1.eptr; } 78 | ; 79 | 80 | exprlist: expr 81 | { $$.eptr = listnode(NULL,$1.eptr); } 82 | | exprlist expr 83 | { $$.eptr = listnode($1.eptr,$2.eptr); } 84 | ; 85 | -------------------------------------------------------------------------------- /p4/yylex.c: -------------------------------------------------------------------------------- 1 | 2 | 3 | #include "cmanifs.h" 4 | #include "cglobals.h" 5 | 6 | 7 | #define NKEYWORDS 11 8 | struct { 9 | STRING keyname; 10 | int keyret; 11 | } keywords[NKEYWORDS] = 12 | { 13 | {"var", VAR}, 14 | {"const", CONST}, 15 | {"op", OP}, 16 | {"where", WHERE}, 17 | {"decl", DECL}, 18 | {"defn", DEFN}, 19 | {"string", F_STRING}, 20 | {"word", F_WORD}, 21 | {"numb", F_NUMB}, 22 | {"special", F_SPECIAL}, 23 | {"file", ERRFILE}, 24 | }; 25 | 26 | yylex() 27 | { 28 | int k; 29 | STRING strsave(); 30 | STRING getstring(),getword(); 31 | float getnum(); 32 | 33 | while(iswhite(c=lexgetc())); 34 | if ( (isalpha(c)||c=='@'||c=='_') && c!=EOF ) { s = getword(c); 35 | if ((k=keyfind(s))!=NKEYWORDS&&cconst){ 36 | yylval.strg = keywords[k].keyname; 37 | cconst=false; 38 | return(keywords[k].keyret); } 39 | yylval.strg = s; 40 | return(WORD); } 41 | if ( isdigit(c)||c=='~' ){ yylval.numb=(float)getnum(c); 42 | return(NUMB);} 43 | if ( c=='\'') { c = lexgetc(); 44 | yylval.strg=getstring(c); 45 | return(STRING_QUOTED); } 46 | if (c=='[') { cconst=true; } 47 | return(c); 48 | } 49 | 50 | lexgetc() 51 | { 52 | int c; 53 | if(peekc!=0){ 54 | c = peekc; 55 | peekc = 0; 56 | return(c); 57 | }else if (( c = getc(lexin))==EOF){ 58 | if(in_index!=0){ 59 | in_index--; 60 | lexin = in_files[in_index].in_fdes; 61 | c = getc(lexin); 62 | } 63 | } 64 | if (c=='\n') { in_files[in_index].in_line++; 65 | } 66 | if (c == '\032') my_exit(1); 67 | return(c); 68 | } 69 | 70 | STRING 71 | getword(c) 72 | char c; 73 | { int l; 74 | STRING p; 75 | char is_sign(); 76 | p = buffer; 77 | switch(c) { 78 | case ';': 79 | case ',': 80 | case '.': 81 | case ')': 82 | case '"': *p++ = c; l++; c=lexgetc(); 83 | break; 84 | case '%': *p++ = c; l++; c = lexgetc(); if(c==']' || c==')') { 85 | *p++ = c; l++; 86 | c = lexgetc(); break; } 87 | fprintf(stderr,"ERROR1"); 88 | my_exit(1); 89 | case '(': *p++ = c; l++; c = lexgetc(); if (c == '%') { *p++ = c; 90 | l++; c = lexgetc(); } 91 | peekc = c; 92 | break; 93 | case '[': *p++ = c; l++; c = lexgetc(); if (c == '%') { *p++ = c; 94 | l++; c = lexgetc(); 95 | break; } 96 | fprintf(stderr,"ERROR2"); 97 | my_exit(1); 98 | case '+': 99 | case '-': 100 | case '/': 101 | case '<': 102 | case '=': 103 | case '>': 104 | case '*': 105 | case '$': 106 | case '&': 107 | case ':': 108 | case '^': 109 | case '#': *p++ = c; l++; while (is_sign(c=lexgetc())) {*p++ = c; l++;} 110 | break; 111 | default: 112 | if ( isalpha(c)||c=='@'||c=='_') { *p++ = c;l++; c = lexgetc(); 113 | while ( isalpha(c) || isdigit(c) || c =='_' ) { *p++ = c; l++; 114 | c = lexgetc(); 115 | } 116 | } else { 117 | fprintf(stderr,"ERROR3"); 118 | my_exit(1); } 119 | *p = '\0' ; 120 | /* 121 | if (strlen(buffer) > strlen(largest)) largest = strsave(buffer); 122 | */ 123 | break; 124 | } 125 | /* now at end of word */ 126 | peekc = c; 127 | *p = '\0'; 128 | return((STRING) strsave(buffer)); 129 | } 130 | 131 | 132 | 133 | char 134 | is_sign(c) 135 | char c; 136 | { switch(c) { 137 | case ':': 138 | case '^': 139 | case '+': 140 | case '-': 141 | case '/': 142 | case '<': 143 | case '=': 144 | case '>': 145 | case '*': 146 | case '$': 147 | case '&': 148 | case '#': return(true); 149 | default: return(false); 150 | } 151 | } 152 | 153 | STRING 154 | getstring(c) 155 | char c; 156 | { 157 | STRING p; 158 | char strstrg[200]; 159 | int i,sptr,tlen; 160 | p = buffer; 161 | l = 0; 162 | while ( c !='`' ) { 163 | if (c == '\\') { c = lexgetc(); 164 | if (c==EOF) { 165 | yyerror("EOF reached with no closing quote for string"," "); 166 | my_exit(1); } 167 | switch (c) { 168 | default: 169 | *p++ = '\\'; 170 | l++; 171 | case '\\': 172 | case '`': 173 | break; 174 | } 175 | } 176 | switch(c){ 177 | case '\t': *p++ = '\\'; l++; 178 | *p++ = 't'; l++; 179 | break; 180 | case '\f': *p++ = '\\'; l++; 181 | *p++ = 'f'; l++; 182 | break; 183 | case '\b': *p++ = '\\'; l++; 184 | *p++ = 'b'; l++; 185 | break; 186 | default : *p++ = c; 187 | l++; 188 | } 189 | if (l == 255) { 190 | fprintf(stderr,"WARNING long string\n"); 191 | 192 | } 193 | 194 | c = lexgetc(); 195 | if (c==EOF) { 196 | yyerror("EOF reached with no closing quote for string", " "); my_exit(1); } 197 | } 198 | /* we are now at the end of the string */ 199 | *p = '\0'; 200 | return((STRING) strsave(buffer)); 201 | } 202 | 203 | float getnum(c) 204 | char c; 205 | { 206 | int sign,mansum; 207 | float expsum,expcount; 208 | if ( c=='~' ) { sign = -1; 209 | c = lexgetc(); 210 | if ( !isdigit(c) ) { 211 | yyerror("~ must be followed by a digit", 212 | " "); } 213 | } else sign = 1; 214 | mansum = c - '0'; 215 | expsum = 0; 216 | expcount = 1; 217 | for(c=lexgetc(); isdigit(c); c=lexgetc()){ 218 | mansum = mansum * 10 + (c-'0'); 219 | } 220 | if (c== '.') { 221 | for (c=lexgetc(); isdigit(c); c=lexgetc()) { 222 | expsum=expsum *10 + (c-'0'); 223 | expcount = expcount*10; 224 | } 225 | } 226 | peekc = c; 227 | return(sign*(mansum+expsum/expcount)); 228 | } 229 | int 230 | keyfind(s) 231 | STRING s; 232 | { 233 | register int i; 234 | for(i=0; i 3 | #include 4 | #define YYSTYPE union stacktype 5 | #include "y.tab.h" 6 | 7 | #define cycle for(;;) 8 | #define NL '\n' 9 | #define setodd 1| 10 | #define YYVCOPY(x,y) copy( y , sizeof(union stacktype) , 1 , x ) 11 | 12 | #define F_ERES 0 13 | #define F_VAR 1 14 | #define F_INPUT 2 15 | #define F_LOCAL 3 16 | #define F_WORD 4 17 | #define F_FCALL 5 18 | #define F_SWCHAR 6 19 | #define F_CONST 7 20 | #define F_NIL 8 21 | #define F_CXFILE 9 22 | #define F_SCONS 10 23 | 24 | typedef int FUNCTION; 25 | 26 | #define rEXPRPTR register EXPRPTR 27 | 28 | typedef struct EXPR EXPR, *EXPRPTR; 29 | 30 | typedef union X_OR_I { 31 | int i; 32 | float r; 33 | EXPRPTR x; 34 | } X_OR_I; 35 | 36 | typedef struct U_EXPR { 37 | FUNCTION f; 38 | int dim; 39 | X_OR_I arg1; 40 | } U_EXPR; 41 | 42 | 43 | typedef struct B_EXPR { 44 | FUNCTION f; 45 | int dim; 46 | X_OR_I arg1, arg2; 47 | } B_EXPR; 48 | 49 | typedef struct T_EXPR { 50 | FUNCTION f; 51 | int dim; 52 | X_OR_I arg1, arg2, arg3; 53 | } T_EXPR; 54 | 55 | typedef struct Q_EXPR { 56 | FUNCTION f; 57 | int dim; 58 | X_OR_I arg1, arg2, arg3, arg4; 59 | } Q_EXPR; 60 | 61 | typedef struct QU_EXPR { 62 | FUNCTION f; 63 | int dim; 64 | X_OR_I arg1, arg2, arg3, arg4, arg5; 65 | } QU_EXPR; 66 | 67 | struct EXPR { 68 | FUNCTION f; 69 | int dim; 70 | X_OR_I arg1, arg2, arg3, arg4, arg5; 71 | } ; 72 | 73 | typedef char *STRING; 74 | 75 | typedef struct { 76 | STRING name; 77 | int nargs; 78 | int type; 79 | } *FPTR, FITEM; 80 | 81 | 82 | #define assert(x,y) if(!(x)) { fprintf(stderr,y); abort(); } 83 | #define DEBUGGING 0 84 | #define DEFTRACE 0 85 | #define U_EGLOBAL 0 86 | #define u_NGLOBAL 1 87 | #define U_NGLOBAL 1 88 | #define U_FORMAL 2 89 | #define U_NORMAL 3 90 | #define NULLARY 0 91 | #define NONNULLARY 1 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | /* 108 | * various bits of information are stored in the symbol table 109 | * entries for variable names. these are all stored in the word 110 | * attr, and this is what they mean: 111 | * 112 | * ELEM_A - variable is inherited as an elementary variable 113 | * in the present scope. 114 | * FORM_A - variable is ultimately defined as a formal 115 | * parameter. (even though it may be inherited into 116 | * the present scope as a global) 117 | * GLOB_A - variable has been inherited into this scope 118 | * as a global variable. 119 | * a global can be an ordinary global (NGLOBAL) 120 | * or an elemntary global (EGLOBAL) in which case, 121 | * the ELEM_A flag is also set. 122 | * LOC_A - variable is ultimately defined as a local. note that 123 | * GLOB_A may still be on, if it is inherited as a global 124 | * in this scope. thus, to see if a variable is locally 125 | * defined in the present scope, one must see that GLOB_A 126 | * and FORM_A are not set. checking for LOC_A is not correct. 127 | */ 128 | #define NONE_A 0000 129 | #define ELEM_A 0001 130 | #define FORM_A 0002 131 | #define GLOB_A 0010 132 | #define LOC_A 0020 133 | #define DEF_A 0040 134 | #define USED_A 0100 135 | #define UELEM_A 0200 136 | 137 | /* 138 | * various information getters about symbols. 139 | * note that IS_LOCAL tests to see if x is declared as a LOCAL 140 | * in the present state, NOT to see if it is local anywhere else. 141 | */ 142 | #define IS_USED(x) (x->attr&USED_A) 143 | #define IS_FORM(x) (x->attr&FORM_A) 144 | #define IS_GLOB(x) (x->attr&GLOB_A) 145 | #define IS_LOCAL(x) (!IS_FORM(x)) && (!IS_GLOB(x)) 146 | #define IS_ELEM(x) (x->attr&ELEM_A) 147 | #define IS_DEF(x) (x->attr&DEF_A) 148 | #define ZERO_GLOB(x) (x->attr&~GLOB_A) 149 | 150 | typedef struct SYMBOL SYMBOL, *SYMPTR; 151 | union stacktype{ 152 | 153 | /* for constants returned by yylex */ 154 | int value; 155 | 156 | float numb; 157 | 158 | /* for symbol table entries returned by yylex */ 159 | SYMPTR ident; 160 | 161 | /* for expressions pointers returned by yacc actions */ 162 | EXPRPTR eptr; 163 | }; 164 | 165 | #define YYSTYPE union stacktype 166 | #define YYVCOPY(x,y) copy( y , sizeof(union stacktype) , 1 , x ) 167 | 168 | 169 | struct SYMBOL { 170 | STRING name; 171 | int lexlevel; 172 | int fldef; 173 | int elemdef; 174 | int idno; /* idno name for variable */ 175 | char attr; /* various information about variable usage */ 176 | SYMPTR next; /*the next symbol in hash chain */ 177 | }; 178 | 179 | 180 | typedef struct F_STACK F_STACK, *F_STACKPTR; 181 | typedef struct P_STACK P_STACK, *P_STACKPTR; 182 | typedef struct E_STACK E_STACK, *E_STACKPTR; 183 | typedef struct E_LIST E_LIST, *E_LISTPTR; 184 | struct F_STACK { 185 | int f_ll; 186 | int f_el; 187 | struct F_STACK *f_tl; 188 | }; 189 | struct P_STACK { 190 | int p_idno; 191 | int p_iselem; 192 | struct P_STACK *p_tl; 193 | }; 194 | struct E_STACK { 195 | struct E_LIST *es_list; 196 | struct E_STACK *es_tl; 197 | }; 198 | struct E_LIST { 199 | EXPRPTR el_expr; 200 | struct E_LIST *el_tl; 201 | }; 202 | -------------------------------------------------------------------------------- /p5/expr.c: -------------------------------------------------------------------------------- 1 | #include "cmanifs.h" 2 | #include "cglobals.h" 3 | 4 | findfile(e) 5 | EXPRPTR e; 6 | { 7 | if (filecount >= MAXFILES) 8 | { fprintf(stderr,"too many cxfiles\n"); my_exit(1); } 9 | filetable[filecount] = e; 10 | filecount++; 11 | return(filecount-1); 12 | } 13 | 14 | EXPRPTR 15 | filenode(filename,first_line,last_line,cursor_position) 16 | int filename; 17 | int first_line,last_line,cursor_position; 18 | { 19 | STRING calloc(),strsave(); 20 | EXPRPTR p; 21 | p = (EXPRPTR) calloc(1, sizeof(Q_EXPR)); 22 | p->dim = 0; 23 | p->f = (FUNCTION) F_CXFILE; 24 | p->arg1.i = filename; 25 | p->arg2.i = first_line; 26 | p->arg3.i = last_line; 27 | p->arg4.i = cursor_position; 28 | return(p); 29 | } 30 | 31 | EXPRPTR 32 | sconsnode(s,file) 33 | EXPRPTR file; 34 | char *s; 35 | { EXPRPTR unode(),binnode(),connode(); 36 | if(s[0] == '\0') return(binnode(F_SCONS,0,connode(F_SWCHAR,s[0]),unode(F_NIL,0,NULL),file)); 37 | return(binnode(F_SCONS,0,connode(F_SWCHAR,s[0]), 38 | sconsnode((char *)&s[1],file),file)); 39 | } 40 | 41 | EXPRPTR 42 | connode(f,n) 43 | int f,n; 44 | { 45 | STRING calloc(); 46 | EXPRPTR p; 47 | p = (EXPRPTR) calloc(1, sizeof(U_EXPR)); 48 | p->dim = 0; 49 | p->f = (FUNCTION) f; 50 | p->arg1.i = (int) n; 51 | return(p); 52 | } 53 | 54 | EXPRPTR 55 | f_connode(n) 56 | float n; 57 | { 58 | STRING calloc(); 59 | EXPRPTR p; 60 | p = (EXPRPTR) calloc(1, sizeof(U_EXPR)); 61 | p->dim = 0; 62 | p->f = (FUNCTION) F_CONST; 63 | p->arg1.r = (float) n; 64 | return(p); 65 | } 66 | 67 | EXPRPTR 68 | varnode(type,v) 69 | int type; 70 | SYMPTR v; 71 | { 72 | STRING calloc(); 73 | EXPRPTR p; 74 | F_STACKPTR f_env; 75 | int i, placepop, timepop; 76 | 77 | placepop = funclevel - v->fldef; 78 | /* 79 | * getting the amount of time we have to pop 80 | * is trickier if we have inherited the variable 81 | * through a function definition. this is because 82 | * we dont pop off the time that we added to the 83 | * the time stack as we called functions. 84 | */ 85 | if(placepop>0){ 86 | f_env = f_stack; 87 | for(i=1; i< (funclevel-v->fldef); i++){ 88 | f_env = f_env->f_tl; 89 | } 90 | /* 91 | * f_env->f_el is the elemlevel where the last containing 92 | * function was declared. 93 | */ 94 | timepop = f_env->f_el - v->elemdef; 95 | }else{ 96 | timepop = elemlevel - v->elemdef; 97 | } 98 | 99 | if( type==NULLARY && timepop==0 && placepop==0 ){ 100 | /* 101 | * a local nullary variable requires no stack 102 | * changes during interpretation, so 103 | * compile it separately 104 | */ 105 | p = (EXPRPTR) calloc(1, sizeof(U_EXPR)); 106 | p->dim = 0; 107 | p->f = F_LOCAL; 108 | p->arg1.i = v->idno; 109 | }else if( type==NONNULLARY ){ 110 | /* 111 | * a function call 112 | */ 113 | p = (EXPRPTR) calloc(1, sizeof(Q_EXPR)); 114 | p->dim = 0; 115 | p->f = F_FCALL; 116 | p->arg1.i = v->idno; /* function name */ 117 | p->arg2.i = IS_ELEM(v) ?(timepop+1) : -(timepop+1); 118 | p->arg3.i = placepop; 119 | p->arg4.i = identcount; 120 | defineparms(); 121 | }else{ 122 | /* 123 | * nullary local variable 124 | */ 125 | p = (EXPRPTR) calloc(1, sizeof(T_EXPR)); 126 | p->f = F_VAR; 127 | p->dim = 0; 128 | p->arg1.i = IS_FORM(v) ?-v->idno-1 :v->idno; 129 | p->arg2.i = IS_ELEM(v) ?(timepop+1) :-(timepop+1); 130 | p->arg3.i = placepop; 131 | } 132 | return(p); 133 | } 134 | 135 | pushexpr() 136 | { 137 | STRING calloc(); 138 | E_STACKPTR temp; 139 | /* push the location of the new expression list onto parm_stack */ 140 | temp = (E_STACKPTR) calloc(1, sizeof(E_STACK)); 141 | temp->es_list = parm_list; 142 | temp->es_tl = parm_stack; 143 | parm_stack = temp; 144 | } 145 | 146 | appeexpr(e) 147 | EXPRPTR e; 148 | { 149 | STRING calloc(); 150 | E_LISTPTR new; 151 | new = (E_LISTPTR) calloc(1,sizeof(E_LIST)); 152 | new->el_expr = e; 153 | new->el_tl = NULL; 154 | parm_list->el_tl = new; 155 | parm_list = new; 156 | } 157 | 158 | defineparms() 159 | { 160 | STRING calloc(); 161 | E_LISTPTR scan, temp; 162 | int flag; 163 | 164 | /* now put the expressions in the expression table */ 165 | /* deleting them from the list as we go */ 166 | /* at first, temp points to the element in parm_list that is 167 | /* the last one we wish to keep. we have to set up parm_stack 168 | /* like this so that we can set the last pointer in 169 | /* parm_list to NULL 170 | */ 171 | flag=1; 172 | temp = parm_stack->es_list; 173 | scan = temp->el_tl; 174 | temp->el_tl = NULL; 175 | while(scan){ 176 | temp = scan; 177 | exprtable[identcount] = scan->el_expr; 178 | nametable[identcount] = "actual"; 179 | if ( flag == 0 ) { 180 | fprintf(stderr,"defining actual, %d as:",identcount); 181 | echoexpr(scan->el_expr); 182 | fprintf(stderr,"\n"); 183 | } 184 | scan = scan->el_tl; 185 | free(temp); 186 | identcount++; 187 | } 188 | /* pop the top entry from the stack */ 189 | /* dont forget that parm_list must point to the end 190 | /* of the new, truncated, list 191 | */ 192 | parm_list = parm_stack->es_list; 193 | temp = (E_LISTPTR) parm_stack; 194 | parm_stack = parm_stack->es_tl; 195 | free(temp); 196 | } 197 | 198 | EXPRPTR unode(f,n,a,file) 199 | int f,n; 200 | EXPRPTR a; 201 | EXPRPTR file; 202 | { 203 | STRING calloc(); 204 | EXPRPTR p; 205 | p = (EXPRPTR) calloc(1, sizeof(B_EXPR)); 206 | p->f = (FUNCTION) f; 207 | p->dim = n; 208 | p->arg1.x = a; 209 | p->arg2.x = file; 210 | return(p); 211 | } 212 | 213 | EXPRPTR 214 | binnode(f,n,a,b,file) 215 | int f,n; 216 | EXPRPTR a, b; 217 | EXPRPTR file; 218 | { 219 | STRING calloc(); 220 | EXPRPTR p; 221 | p = (EXPRPTR) calloc(1,sizeof(T_EXPR)); 222 | p->f = (FUNCTION) f; 223 | p->dim = n; 224 | p->arg1.x = a; 225 | p->arg1.x = a; 226 | p->arg2.x = b; 227 | p->arg3.x = file; 228 | return(p); 229 | } 230 | 231 | EXPRPTR 232 | ternode(f,n,b,c,d,file) 233 | int f,n; 234 | EXPRPTR b,c,d; 235 | EXPRPTR file; 236 | { 237 | STRING calloc(); 238 | EXPRPTR p; 239 | p = (EXPRPTR) calloc(1,sizeof(Q_EXPR)); 240 | p->f = (FUNCTION) f; 241 | p->dim = n; 242 | p->arg1.x = b; 243 | p->arg2.x = c; 244 | p->arg3.x = d; 245 | p->arg4.x = file; 246 | return(p); 247 | } 248 | 249 | define(s,e) 250 | SYMPTR s; 251 | EXPRPTR e; 252 | { 253 | STRING calloc(); 254 | STRING strsave(); 255 | int flag; 256 | flag=1; 257 | if(s->attr&DEF_A){ 258 | yyerror(s->name,"is already defined"); 259 | }else if(s->attr&GLOB_A){ 260 | /* 261 | * inheriting and trying to redefine it 262 | */ 263 | yyerror(s->name," cannot be defined here"); 264 | }else{ 265 | exprtable[s->idno] = e; 266 | nametable[s->idno] = strsave(s->name); 267 | s->attr = s->attr|DEF_A; 268 | if ( flag == 0 ) { 269 | fprintf(stderr,"defining %s, level %d idno %d as:",s->name, s->lexlevel, s->idno); 270 | echoexpr(exprtable[s->idno]); 271 | fprintf(stderr,"\n"); 272 | } 273 | } 274 | } 275 | 276 | yyerror(a,b) 277 | STRING a,b; 278 | { fprintf(stderr,"%s%s\n",a,b); } 279 | -------------------------------------------------------------------------------- /p5/ftable.h: -------------------------------------------------------------------------------- 1 | FITEM ftable[] = { 2 | {"eres", 1,TERMINAL}, 3 | {"var", 3,TERMINAL}, 4 | {"input", 1,TERMINAL}, 5 | {"local", 1,TERMINAL}, 6 | {"word", 1,TERMINAL}, 7 | {"fcall", 4,TERMINAL}, 8 | {"swchar", 1,TERMINAL}, 9 | {"const", 1,CONST}, 10 | {"nil", 1,SPL}, 11 | {"cxfile", 4,CXFILE}, 12 | {"scons", 3, INTERIOR}, 13 | {"wrd", 0,WRD}, 14 | {"valof", 0,VALOF}, 15 | {"decl", 0,DECL}, 16 | {"defn", 0,DEFN}, 17 | {"strg", 0,STRG}, 18 | {"numb", 0,NMB}, 19 | {"nullry", 0,NULLRY}, 20 | {"nonnullry", 0,NONNULLRY}, 21 | {"constant", 0,CONST}, 22 | {"eglobal", 0,EGLOB}, 23 | {"nglobal", 0,NGLOB}, 24 | {"frmls", 0,FRMLS}, 25 | {"op", 0,OP}, 26 | {"first", 2,INTERIOR}, 27 | {"next", 2,INTERIOR}, 28 | {"pred", 2,INTERIOR}, 29 | {"prev", 2,INTERIOR}, 30 | {"fby", 3,INTERIOR}, 31 | {"before", 3,INTERIOR}, 32 | {"asa", 3,INTERIOR}, 33 | {"now", 1, INTERIOR}, 34 | {"@t", 3, INTERIOR}, 35 | {"initial", 2, INTERIOR}, 36 | {"succ", 2, INTERIOR}, 37 | {"sby", 3, INTERIOR}, 38 | {"whr", 3, INTERIOR}, 39 | {"here", 1, INTERIOR}, 40 | {"@s", 3, INTERIOR}, 41 | {"original", 2, INTERIOR}, 42 | {"noriginal", 2, INTERIOR}, 43 | {"nrest", 2, INTERIOR}, 44 | {"rest", 2, INTERIOR}, 45 | {"aby", 3, INTERIOR}, 46 | {"cby", 3, INTERIOR}, 47 | {"swap", 3, INTERIOR}, 48 | {"rshift", 2, INTERIOR}, 49 | {"lshift", 2, INTERIOR}, 50 | {"all", 2, INTERIOR}, 51 | {"elt", 2, INTERIOR}, 52 | {"isnumber", 2, INTERIOR}, 53 | {"div", 3, INTERIOR}, 54 | {"mod", 3, INTERIOR}, 55 | {"and", 3, INTERIOR}, 56 | {"not", 2, INTERIOR}, 57 | {"or", 3, INTERIOR}, 58 | {"eq", 3, INTERIOR}, 59 | {"ne", 3, INTERIOR}, 60 | {"gt", 3, INTERIOR}, 61 | {"ge", 3, INTERIOR}, 62 | {"le", 3, INTERIOR}, 63 | {"lt", 3, INTERIOR}, 64 | {"sin", 2, INTERIOR}, 65 | {"cos", 2, INTERIOR}, 66 | {"log", 2, INTERIOR}, 67 | {"iseod", 2, INTERIOR}, 68 | {"isstring", 2, INTERIOR}, 69 | {"isword", 2, INTERIOR}, 70 | {"substr", 4, INTERIOR}, 71 | {"eod", 1, SPL}, 72 | {"arg", 2, INTERIOR}, 73 | {"mkword", 2, INTERIOR}, 74 | {"mkstring", 2, INTERIOR}, 75 | {"error", 1, SPL}, 76 | {"iserror", 2, INTERIOR}, 77 | {"length", 2, INTERIOR}, 78 | {"mknumber", 2, INTERIOR}, 79 | {"tan", 2, INTERIOR}, 80 | {"log10", 2, INTERIOR}, 81 | {"abs", 2, INTERIOR}, 82 | {"sqrt", 2, INTERIOR}, 83 | {"filter", 4, INTERIOR}, 84 | {"cons", 3, INTERIOR}, 85 | {"islist", 2, INTERIOR}, 86 | {"isatom", 2, INTERIOR}, 87 | {"hd", 2, INTERIOR}, 88 | {"tl", 2, INTERIOR}, 89 | {"ord", 2, INTERIOR}, 90 | {"chr", 2, INTERIOR}, 91 | {"isnil", 2, INTERIOR}, 92 | {"complex", 2, INTERIOR}, 93 | {"real", 2, INTERIOR}, 94 | {"imag", 2, INTERIOR}, 95 | {"uminus", 2, INTERIOR}, 96 | {"plus", 3, INTERIOR}, 97 | {"minus", 3, INTERIOR}, 98 | {"times", 3, INTERIOR}, 99 | {"if", 4, INTERIOR}, 100 | {"fdiv", 3, INTERIOR}, 101 | {"strconc", 3, INTERIOR}, 102 | {"append", 3, INTERIOR}, 103 | {"arg", 2, INTERIOR}, 104 | {"exp", 3, INTERIOR}, 105 | {"spl", 0, INTERIOR}, 106 | }; 107 | -------------------------------------------------------------------------------- /p5/main.c: -------------------------------------------------------------------------------- 1 | #include "cmanifs.h" 2 | #include "cglobals.h" 3 | #include "ftable.h" 4 | 5 | STRING fname; 6 | 7 | void echoexpr(EXPRPTR p); 8 | void writeexpr(EXPRPTR p); 9 | 10 | STRING 11 | strsave(s) 12 | char *s; 13 | { int n; 14 | STRING p, calloc(); 15 | n=strlen(s); 16 | if ( ( p= calloc(1,n+1))==NULL) 17 | fprintf(stderr,"ran out of space\n"); 18 | else 19 | { 20 | strcpy(p,s); 21 | } 22 | return(p); 23 | 24 | } 25 | 26 | 27 | 28 | main(argc,argv) 29 | int argc; 30 | char ** argv; 31 | { 32 | int temp; 33 | initialise(argc,argv); 34 | temp=yyparse(); 35 | if(temp||errcount){ 36 | fprintf(stderr,"Fatal errors: no expression file written.\n"); 37 | my_exit(1); 38 | }else{ 39 | accept(); 40 | } 41 | } 42 | 43 | initialise(argc,argv) 44 | int argc; 45 | char **argv; 46 | { 47 | STRING calloc(); 48 | STRING strsave(); 49 | int i, j; 50 | extern FILE *lexin; 51 | char *temp; 52 | 53 | /* connect to source file */ 54 | if(argc>1){ 55 | fname = argv[1]; 56 | in_index = 0; 57 | for(j=0; fname[j]; j++); 58 | /*if(j<2 || fname[j-1]!='h' || fname[j-2]!='.'){ 59 | fprintf(stderr,"%s: not a legal luthid source file\n", 60 | fname); 61 | my_exit(1); 62 | } */ 63 | /* sprintf(fname,"%s.i",fname); */ 64 | fname = malloc(strlen(fname)+3); 65 | sprintf(fname,"%s.i",argv[1]); 66 | /*if( (lexin=fopen(fname,"r")) == NULL ){ 67 | fprintf(stderr,"cannot open %s\n",fname); 68 | my_exit(1); 69 | } */ 70 | lexin = stdin; 71 | in_files[in_index].in_name = strsave(fname); 72 | /*fname[j-1] = 'i'; */ 73 | }else{ 74 | in_files[in_index].in_name = "stdin"; 75 | fname = "stdin.i"; 76 | lexin = stdin; 77 | } 78 | savelex=lexin; 79 | in_files[in_index].in_line = 0; 80 | in_files[in_index].in_fdes = lexin; 81 | 82 | /* hashtable is all NULLS */ 83 | for(i=0;ip_idno = -1; 107 | p_stack->p_iselem = 0; 108 | p_stack->p_tl = NULL; 109 | 110 | parm_stack = (E_STACKPTR) calloc(1,sizeof(E_STACK)); 111 | parm_stack->es_list = NULL; 112 | parm_stack->es_tl = NULL; 113 | 114 | f_stack = (F_STACKPTR) calloc(1,sizeof(F_STACK)); 115 | f_stack->f_ll = -1; 116 | f_stack->f_el = -1; 117 | f_stack->f_tl = NULL; 118 | 119 | parm_list = (E_LISTPTR) calloc(1,sizeof(E_LIST)); 120 | parm_list->el_expr = NULL; 121 | parm_list->el_tl = NULL; 122 | 123 | } 124 | 125 | 126 | accept() 127 | { 128 | int i; 129 | char flag; 130 | flag = false; 131 | if((outfile=fopen(fname,"w"))==NULL){ 132 | fprintf(stderr,"cannot create %s\n",fname); 133 | my_exit(1); 134 | } 135 | putw(identcount,outfile); 136 | if (flag) 137 | fprintf(stderr,"number of expressions is %d\n",identcount); 138 | for(i=0; if,outfile); 176 | q = &ftable[p->f]; 177 | n = q->nargs; 178 | switch(q->type){ 179 | case INTERIOR: 180 | dim = p->dim; 181 | putw(dim,outfile); 182 | writeexpr(p->arg1.x); 183 | if(n>1) writeexpr(p->arg2.x); 184 | if(n>2) writeexpr(p->arg3.x); 185 | if(n>3) writeexpr(p->arg4.x); 186 | if(n>4) writeexpr(p->arg5.x); 187 | break; 188 | default: 189 | putw(p->arg1.i,outfile); 190 | if(n>1) putw(p->arg2.i,outfile); 191 | if(n>2) putw(p->arg3.i,outfile); 192 | if(n>3) putw(p->arg4.i,outfile); 193 | if(n>4) putw(p->arg5.i,outfile); 194 | } 195 | } 196 | 197 | void echoexpr(p) 198 | EXPRPTR p; 199 | { 200 | FPTR q; 201 | int n,dim; 202 | if (p==NULL) return; 203 | q = &ftable[p->f]; 204 | n = q->nargs; 205 | switch(q->type){ 206 | case INTERIOR: 207 | dim = p->dim; 208 | if (dim==0) 209 | fprintf(stderr,"%s(",q->name); 210 | else 211 | fprintf(stderr,"%s%d(,",q->name,dim); 212 | echoexpr(p->arg1.x); 213 | if(n>1){ 214 | fprintf(stderr,", "); 215 | echoexpr(p->arg2.x); 216 | } 217 | if(n>2){ 218 | fprintf(stderr,", "); 219 | echoexpr(p->arg3.x); 220 | } 221 | if(n>3){ 222 | fprintf(stderr,", "); 223 | echoexpr(p->arg4.x); 224 | } 225 | if(n>4){ 226 | fprintf(stderr,", "); 227 | echoexpr(p->arg5.x); 228 | } 229 | fprintf(stderr,")"); 230 | break; 231 | default: 232 | fprintf(stderr,"%s( ",q->name); 233 | if ( p->f==F_CONST) { 234 | fprintf(stderr,"%f ",p->arg1.r); } else 235 | fprintf(stderr,"%d ",p->arg1.i); 236 | if(n>1) fprintf(stderr,", %d",p->arg2.i); 237 | if(n>2) fprintf(stderr,", %d",p->arg3.i); 238 | if(n>3) fprintf(stderr,", %d",p->arg4.i); 239 | if(n>4) fprintf(stderr,", %d",p->arg5.i); 240 | fprintf(stderr,")"); 241 | } 242 | } 243 | 244 | my_exit(n) 245 | int n; 246 | { 247 | exit(n); 248 | } 249 | -------------------------------------------------------------------------------- /p5/makefile: -------------------------------------------------------------------------------- 1 | R= 2 | DESTDIR=/usr/local/bin 3 | CFLAGS=-O -DYYMAXDEPTH=900 -g -Wno-return-type -arch i386 4 | 5 | LINT= lint -p 6 | TAR= tar -cv 7 | PRINT= pr -t $1 | cat -n 8 | inc = cmanifs.h cglobals.h 9 | 10 | pass5: main.o y.tab.o yylex.o expr.o ident.o; 11 | cc -arch i386 -g main.o expr.o y.tab.o yylex.o ident.o -o pass5 12 | 13 | cp install: 14 | cp pass5 $R$(DESTDIR)/pass5 15 | rm -f *.o y.tab.h y.tab.c pass5 16 | 17 | clean: 18 | rm -f *.o y.tab.h y.tab.c pass5 19 | 20 | lint: main.c expr.c yylex.c ident.c 21 | $(LINT) main.c expr.c yylex.c ident.c 22 | 23 | tape: 24 | $(TAR) main.c expr.c yylex.c ident.c cmanifs.h cglobals.h tree.y 25 | 26 | print: 27 | $(PRINT) main.c expr.c yylex.c ident.c cmanifs.h cglobals.h tree.y 28 | 29 | 30 | all: main.o y.tab.o yylex.o expr.o ident.o ; 31 | cc -g -arch i386 main.o expr.o y.tab.o yylex.o ident.o -o pass5 32 | cp pass5 $R$(DESTDIR)/pass5 33 | rm -f *.o y.tab.h y.tab.c pass5 34 | 35 | .c.o: 36 | cc $(CFLAGS) -c -g $< 37 | 38 | main.o: $(inc) main.c 39 | cmanifs.h: y.tab.h 40 | y.tab.c y.tab.h: tree.y 41 | yacc -d tree.y 42 | y.tab.o: $(inc) y.tab.h y.tab.c 43 | yylex.o: $(inc) yylex.c 44 | expr.o: $(inc) expr.c 45 | ident.o: $(inc) ident.c 46 | -------------------------------------------------------------------------------- /p5/tree.y: -------------------------------------------------------------------------------- 1 | 2 | 3 | %term CONST WRD STRG SWCHAR 4 | WHERE IDENT STRING_QUOTED 5 | NUMB NULLRY NONNULLRY OP DEFN DECL CXFILE 6 | NMB SPL FRMLS 7 | VALOF NGLOB EGLOB OPNAME 8 | INTERIOR TERMINAL 9 | %{ 10 | #include "cmanifs.h" 11 | #include "cglobals.h" 12 | EXPRPTR varnode(); 13 | EXPRPTR sconsnode(),connode(),f_connode(),filenode(); 14 | EXPRPTR binnode(),unode(),ternode(); 15 | EXPRPTR exit_phrase(); 16 | %} 17 | %% 18 | 19 | accept: 20 | expr 21 | { $$.eptr = $1.eptr; } 22 | ; 23 | 24 | constant: '[' CONST '[' STRG STRING_QUOTED ']' ']' 25 | { $$.eptr = 26 | sconsnode(wordtable[$5.value],filenode(findword("error"),1,1,1)); } 27 | | '[' CONST '[' NMB NUMB ']' ']' 28 | { $$.eptr = f_connode($5.numb); } 29 | | '[' CONST '[' WRD STRING_QUOTED ']' ']' 30 | { $$.eptr = connode(F_WORD,$5.value); } 31 | | '[' CONST '[' SPL ']' ']' 32 | { $$.eptr = unode($4.value,0,NULL); } 33 | ; 34 | 35 | file: '[' CXFILE STRING_QUOTED NUMB NUMB NUMB ']' 36 | { $$.eptr 37 | =filenode($3.value,(int)$4.numb,(int)$5.numb,(int)$6.numb); } 38 | ; 39 | 40 | variable: '[' NONNULLRY IDENT NUMB { pushexpr(); } exprlist ']' 41 | { $$.eptr = varnode(NONNULLARY,$3.ident); } 42 | | '[' NULLRY IDENT NUMB ']' 43 | { $$.eptr = varnode(NULLARY,$3.ident); } 44 | ; 45 | 46 | operator: '[' OP '[' INTERIOR NUMB expr ']' file ']' 47 | { $$.eptr=unode($4.value,(int)$5.numb,$6.eptr,$8.eptr); } 48 | | '[' OP '[' INTERIOR NUMB expr expr ']' file ']' 49 | { $$.eptr=binnode($4.value,(int)$5.numb,$6.eptr,$7.eptr,$9.eptr);} 50 | | '[' OP '[' INTERIOR NUMB expr expr expr ']' file ']' 51 | { $$.eptr=ternode($4.value,(int)$5.numb,$6.eptr, 52 | $7.eptr,$8.eptr,$10.eptr); } 53 | ; 54 | 55 | valof: '[' VALOF { enter_phrase(); } valofbody ']' 56 | { $$.eptr = exit_phrase(); } 57 | ; 58 | 59 | valofbody: 60 | statement 61 | | valofbody statement 62 | ; 63 | 64 | formals: '[' FRMLS { enter_function(); } argnames 65 | { idusage = (int) U_NORMAL; } ']' 66 | ; 67 | 68 | statement: '[' DEFN IDENT NUMB formals expr ']' 69 | { define($3.ident,$6.eptr); 70 | exit_function(); 71 | } 72 | | '[' DEFN IDENT NUMB expr ']' 73 | { define($3.ident,$5.eptr); } 74 | | '[' { idusage = (int) U_NGLOBAL; } 75 | NGLOB argnames ']' 76 | { idusage = (int) U_NORMAL; } 77 | | '[' { idusage = (int) U_EGLOBAL; 78 | if (p_stack->p_iselem==0){ 79 | p_stack->p_iselem=1; 80 | elemlevel++; } 81 | } 82 | EGLOB argnames ']' 83 | { idusage = (int) U_NORMAL; } 84 | ; 85 | 86 | argnames: IDENT 87 | | argnames IDENT 88 | ; 89 | 90 | expr: valof { $$.eptr = $1.eptr; } 91 | | constant { $$.eptr = $1.eptr; } 92 | | variable { $$.eptr = $1.eptr; } 93 | | operator { $$.eptr = $1.eptr; } 94 | ; 95 | 96 | exprlist: expr 97 | { appeexpr($1.eptr); } 98 | | exprlist expr 99 | { appeexpr($2.eptr); } 100 | ; 101 | -------------------------------------------------------------------------------- /p5/yylex.c: -------------------------------------------------------------------------------- 1 | 2 | /******************************************************* 3 | 4 | Flucid Interpreter 5 | 6 | Copyright 1986 7 | All Rights Reserved 8 | 9 | Dr. Antony Faustini 10 | Arizona State University 11 | 12 | 13 | ********************************************************/ 14 | 15 | 16 | #include "cmanifs.h" 17 | #include "cglobals.h" 18 | 19 | yylex() 20 | { 21 | int k; 22 | STRING strsave(); 23 | STRING getstring(),getword(); 24 | SYMPTR handle_ident(); 25 | float getnum(); 26 | while(iswhite(c=lexgetc())); 27 | if ((c=='@'||c== '_'||isalpha(c))&&c!=EOF) 28 | { s = getword(c); 29 | if ((k=keyfind(s))!=MAXFUNCS&&cconst) 30 | { 31 | cconst=false; 32 | if (ftable[k].type==WRD) wordval=true; 33 | if (ftable[k].nargs==0) 34 | { 35 | yylval.value=ftable[k].type; 36 | } else 37 | yylval.value=k; 38 | return(ftable[k].type); 39 | } 40 | yylval.ident = handle_ident(s,l); 41 | return(IDENT); 42 | } 43 | if ( isdigit(c)||c=='~' ) 44 | { yylval.numb=(float)getnum(c); 45 | return(NUMB); 46 | } 47 | if ( c=='`') 48 | { c = lexgetc(); 49 | if (wordval) 50 | { 51 | yylval.value=findword(getstring(c)); 52 | wordval=false; 53 | } else 54 | yylval.value=findword(getstring(c)); 55 | return(STRING_QUOTED); 56 | } 57 | if (c=='[') cconst=true; 58 | return(c); 59 | } 60 | 61 | lexgetc() 62 | { 63 | int c; 64 | if(peekc!=0){ 65 | c = peekc; 66 | peekc = 0; 67 | return(c); 68 | }else if ((c = getc(lexin))==EOF){ 69 | if(in_index!=0){ 70 | in_index--; 71 | lexin = in_files[in_index].in_fdes; 72 | c = getc(lexin); 73 | } 74 | } 75 | if (c=='\n') { in_files[in_index].in_line++; 76 | } 77 | if ( c == '\032') my_exit(1); 78 | return(c); 79 | } 80 | 81 | 82 | findstring(s) 83 | STRING s; 84 | { 85 | int i; 86 | STRING strsave(); 87 | for(i=0; i': 153 | case '*': 154 | case '$': 155 | case '&': 156 | case ':': 157 | case '^': 158 | case '#': *p++ = c; l++; while (is_sign(c=lexgetc())) {*p++ = c; l++;} 159 | break; 160 | default: 161 | if ( isalpha(c) || c=='_'||c=='@') { *p++ = c;l++; c = lexgetc(); 162 | while ( isalpha(c) || isdigit(c) || c=='_') { *p++ = c; l++; 163 | c = lexgetc(); 164 | } 165 | } else { 166 | fprintf(stderr,"ERROR3"); 167 | my_exit(1); } 168 | } 169 | /* now at end of word */ 170 | peekc = c; 171 | *p = '\0'; 172 | return((STRING) buffer); 173 | } 174 | 175 | 176 | 177 | char 178 | is_sign(c) 179 | char c; 180 | { switch(c) { 181 | case ':': 182 | case '^': 183 | case '+': 184 | case '-': 185 | case '/': 186 | case '<': 187 | case '=': 188 | case '>': 189 | case '*': 190 | case '$': 191 | case '&': 192 | case '#': return(true); 193 | default: return(false); 194 | } 195 | } 196 | 197 | STRING 198 | code_to_char(s) 199 | STRING s; 200 | { char c,newstring[200]; 201 | int j,i,l,sum; 202 | i = 0; 203 | l = 0; 204 | c = s[i]; 205 | while (c != '\0') 206 | { if (c == '\\') 207 | { i++; c = s[i]; 208 | switch(c){ 209 | case 'n': newstring[l]='\n'; l++; 210 | break; 211 | case 't': newstring[l]='\t'; l++; 212 | break; 213 | case 'f': newstring[l]='\f'; l++; 214 | break; 215 | case 'b': newstring[l]='\b'; l++; 216 | break; 217 | case 'r': newstring[l]='\r'; l++; 218 | break; 219 | case '\\': newstring[l]='\\'; l++; 220 | break; 221 | case '\'': newstring[l]='\''; l++; 222 | break; 223 | default: if ( c >= '0' && c <= '7' ) 224 | { sum =0; 225 | for(j=1; j<=3 && c<='7'&& c>='0' ; j++) 226 | { i++; 227 | sum = sum*8+ c-'0'; 228 | c = s[i]; 229 | } 230 | newstring[l]=sum; l++; 231 | } 232 | 233 | newstring[l]=c; l++; 234 | 235 | } 236 | } else { newstring[l]=c; l++; } 237 | i++; 238 | c = s[i]; 239 | } 240 | newstring[l] = '\0'; 241 | strcpy(s,newstring); 242 | return(s); 243 | } 244 | 245 | STRING 246 | getstring(c) 247 | char c; 248 | { 249 | STRING p; 250 | char strstrg[200]; 251 | int i,sptr,tlen; 252 | p = buffer; 253 | l = 0; 254 | while ( c !='\'' ) { 255 | if (c == '\\') { c = lexgetc(); 256 | if (c==EOF) { 257 | yyerror("EOF reached with no closing quote for string"," "); 258 | my_exit(1); } 259 | switch (c) { 260 | default: 261 | *p++ = '\\'; 262 | l++; 263 | case '\\': 264 | case '`': 265 | break; 266 | } 267 | } 268 | switch(c){ 269 | case '\t': *p++ = '\\'; l++; 270 | *p++ = 't'; l++; 271 | break; 272 | case '\f': *p++ = '\\'; l++; 273 | *p++ = 'f'; l++; 274 | break; 275 | case '\b': *p++ = '\\'; l++; 276 | *p++ = 'b'; l++; 277 | break; 278 | default : *p++ = c; 279 | l++; 280 | } 281 | if (l == 255) { 282 | fprintf(stderr,"WARNING long string\n"); 283 | 284 | } 285 | 286 | c = lexgetc(); 287 | if (c==EOF) { 288 | yyerror("EOF reached with no closing quote for string", " "); my_exit(1); } 289 | } 290 | /* we are now at the end of the string */ 291 | *p = '\0'; 292 | return((STRING) strsave(code_to_char(buffer))); 293 | } 294 | 295 | float getnum(c) 296 | char c; 297 | { 298 | int sign,mansum; 299 | float expsum,expcount; 300 | if ( c=='~' ) { sign = -1; 301 | c = lexgetc(); 302 | if ( !isdigit(c) ) { 303 | yyerror("~ must be followed by a digit", 304 | " "); } 305 | } else sign = 1; 306 | mansum = c - '0'; 307 | expsum = 0; 308 | expcount = 1; 309 | for(c=lexgetc(); isdigit(c); c=lexgetc()){ 310 | mansum = mansum * 10 + (c-'0'); 311 | } 312 | if (c== '.') { 313 | for (c=lexgetc(); isdigit(c); c=lexgetc()) { 314 | expsum=expsum *10 + (c-'0'); 315 | expcount = expcount*10; 316 | } 317 | } 318 | peekc = c; 319 | return(sign*(mansum+expsum/expcount)); 320 | } 321 | int 322 | keyfind(s) 323 | STRING s; 324 | { 325 | int i; 326 | for(i=0; i 0 then S + X else 0 fi; 5 | end; 6 | -------------------------------------------------------------------------------- /progs/eg14.l: -------------------------------------------------------------------------------- 1 | diff(diff(X) ) 2 | where 3 | diff(A) = next A - A ; 4 | end 5 | -------------------------------------------------------------------------------- /progs/eg15.l: -------------------------------------------------------------------------------- 1 | secondnext(A) - 2 * next A + A 2 | where 3 | secondnext(A) = next next A; 4 | end 5 | -------------------------------------------------------------------------------- /progs/eg16.l: -------------------------------------------------------------------------------- 1 | find(2,X) - 2 * find(1,X) + find(0,X) 2 | where 3 | find(I,A) = if I eq 0 then A else find(I-1,next A) fi; 4 | end 5 | -------------------------------------------------------------------------------- /progs/eg17.l: -------------------------------------------------------------------------------- 1 | df(2,X) 2 | where 3 | df(I,A) = if I eq 0 then A else df(I-1,next A- A) fi; 4 | end 5 | -------------------------------------------------------------------------------- /progs/eg19.l: -------------------------------------------------------------------------------- 1 | tot(input) where 2 | tot(X) = S 3 | where 4 | S = 0 fby S + X; 5 | end; 6 | end 7 | -------------------------------------------------------------------------------- /progs/eg20.l: -------------------------------------------------------------------------------- 1 | if p then A else tot(N2) + tot(N3) fi 2 | where 3 | tot(B) = S 4 | where 5 | S = 0 fby S + B; 6 | end; 7 | N = 1 fby N + 1; 8 | end 9 | -------------------------------------------------------------------------------- /progs/eg22.l: -------------------------------------------------------------------------------- 1 | myfirst(input) where 2 | myfirst(X) = Y 3 | where 4 | Y = X fby Y; 5 | end; 6 | end 7 | -------------------------------------------------------------------------------- /progs/eg4.l: -------------------------------------------------------------------------------- 1 | next s/n where 2 | s = 0 fby s + x; 3 | n = 0 fby n + 1; 4 | end 5 | -------------------------------------------------------------------------------- /progs/eg4.l.i: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mpw/pLucid-osx/59970fabba8008d6c63589e501a56d7c6bf2f7b0/progs/eg4.l.i -------------------------------------------------------------------------------- /progs/eg4.l.i.uc: -------------------------------------------------------------------------------- 1 | 0 2 | 0 3 | 0 4 | 0 5 | -------------------------------------------------------------------------------- /progs/eg5.l: -------------------------------------------------------------------------------- 1 | F 2 | where 3 | F = 1 fby F+G; 4 | G = 0 fby F; 5 | end 6 | -------------------------------------------------------------------------------- /progs/eg6.l: -------------------------------------------------------------------------------- 1 | V 2 | where 3 | V = 1 fby (V+W)/2; 4 | W = 100/V; 5 | end 6 | -------------------------------------------------------------------------------- /progs/eg7.l: -------------------------------------------------------------------------------- 1 | S where 2 | I = 1 fby I+1; 3 | F = 1 fby F*(I+1) ; 4 | S = 1 fby S+F*(I+1); 5 | end 6 | -------------------------------------------------------------------------------- /progs/eg8.l: -------------------------------------------------------------------------------- 1 | howfar 2 | where 3 | howfar = if X eq 0 then 0 else 1 + next howfar fi ; 4 | end 5 | -------------------------------------------------------------------------------- /progs/eg9.l: -------------------------------------------------------------------------------- 1 | F where 2 | F = 1 fby F + (0 fby F); 3 | end 4 | -------------------------------------------------------------------------------- /progs/gcd: -------------------------------------------------------------------------------- 1 | gcd(n,m) 2 | where 3 | z = [% n, m %] fby if x > y then [% x mod y, y %] else [% x, y mod x%] fi; 4 | x = hd(z); 5 | y = hd(tl(z)); 6 | gcd(n, m) = (x + y asa x*y eq 0) fby eod; 7 | end 8 | 9 | -------------------------------------------------------------------------------- /progs/qsort: -------------------------------------------------------------------------------- 1 | qsort(input) 2 | where 3 | qsort(x) = if iseod first next x then x else 4 | follow(qsort(low), first x fby qsort(hi)) fi 5 | where 6 | low = next x wvr next x < first x; 7 | hi = next x wvr first x <= next x; 8 | follow(a,b) = if not iseod a then a else b upon iseod a fi; 9 | end; 10 | end 11 | -------------------------------------------------------------------------------- /progs/r100: -------------------------------------------------------------------------------- 1 | 1 fby "." fby decimalise(1) 2 | where 3 | base = next index * 100; 4 | decimalise(expansion) = carry fby decimalise(newexp) 5 | where 6 | carry = if ( expansion*10 + 9) mod base >= 9 then 7 | expansion*10 div base 8 | else (expansion*10 + next carry) div base fi; 9 | newexp = (expansion*10 + next carry) mod base; 10 | end; 11 | end 12 | -------------------------------------------------------------------------------- /progs/recp: -------------------------------------------------------------------------------- 1 | 2 | p where 3 | p = 2 fby nxprime(p); 4 | 5 | nxprime(q) = m asa isprime(m) 6 | where 7 | m=n; 8 | n = (q fby n)+1; 9 | end fby nxprime(next q); 10 | 11 | isprime(n) = (p*p gt k asa (p*p ge k) or ( k mod p eq 0)) 12 | where 13 | k = first n; 14 | end fby isprime(next n); 15 | end 16 | -------------------------------------------------------------------------------- /progs/recprime: -------------------------------------------------------------------------------- 1 | 2 | p where 3 | p = 2 fby nxprime(p); 4 | 5 | nxprime(q) = m asa isprime(m) 6 | where 7 | m = (q+1) fby m+1; 8 | end fby nxprime(next q); 9 | 10 | isprime(n) = (p*p gt k asa (p*p ge k) or ( k mod p eq 0)) 11 | where 12 | k is current n ; 13 | end ; 14 | end 15 | -------------------------------------------------------------------------------- /progs/rms: -------------------------------------------------------------------------------- 1 | sqroot(avg(square(A))) 2 | where square(X) = X*X; 3 | avg(Y) = mean where 4 | N = 1 fby N+1; 5 | mean = first Y fby mean + D; 6 | D = (next Y - mean) / (N+1); 7 | end; 8 | sqroot(Z) = Approx asa Acc < 0.001 where 9 | z is current Z; 10 | Approx = z/2 fby ( Approx + z/Approx)/2; 11 | Acc = abs(square(Approx)-z); 12 | end; 13 | end 14 | -------------------------------------------------------------------------------- /progs/roote: -------------------------------------------------------------------------------- 1 | result where 2 | result = 2 fby "point" fby decimalise(1); 3 | x = first n; 4 | decimalise(expansion)= carry fby decimalise(newexp) 5 | where 6 | posint=1 fby posint +1; 7 | base= posint*x; 8 | carry= if(expansion*10+9)mod base >= 9 then 9 | expansion*10 div base 10 | else (expansion*10+next carry) div base fi; 11 | newexp = (expansion*10 + next carry) mod base; 12 | end; 13 | end 14 | -------------------------------------------------------------------------------- /progs/set: -------------------------------------------------------------------------------- 1 | case hd a of 2 | "inter": intersection(b,c) ; 3 | "union": union(b,c); 4 | "member": member(b,c); 5 | default:`illegal request'; 6 | end 7 | where 8 | union(x,y) = c asa isnull xlist where 9 | x is current x; 10 | y is current y; 11 | xlist = x fby tl xlist; 12 | xitem = hd xlist; 13 | c = y fby 14 | if not member(xitem,y) then 15 | xitem::c 16 | else 17 | c 18 | fi; 19 | end; 20 | 21 | intersection(x,y) = c asa isnull xlist where 22 | x is current x; 23 | y is current y; 24 | c = nil fby 25 | if member(xitem,y) then 26 | xitem::c 27 | else 28 | c 29 | fi; 30 | xitem = hd xlist; 31 | xlist = x fby tl xlist; 32 | end; 33 | 34 | member(x,y) = not isnull ylist asa done where 35 | x is current x; 36 | y is current y; 37 | done = isnull ylist or if isatom yitem then 38 | yitem eq x 39 | else 40 | member(x,yitem) 41 | fi; 42 | yitem = hd ylist; 43 | ylist = y fby tl ylist; 44 | end; 45 | 46 | eqlist(x,y) = 47 | if isnull x then 48 | isnull y 49 | elseif isatom x then 50 | isatom y and x eq y 51 | else 52 | eqlist(hd x, hd y) and eqlist(tl x, tl y) 53 | fi; 54 | 55 | b = hd tl a; 56 | c = hd tl tl a; 57 | 58 | 59 | end 60 | -------------------------------------------------------------------------------- /progs/sieve: -------------------------------------------------------------------------------- 1 | // to calculate the prime numbers using 2 | // the "sieve of Eratosthenes" method 3 | // 4 | sieve( N ) 5 | where 6 | N = 2 fby N + 1; 7 | sieve( i ) = 8 | i fby sieve ( i whenever i mod first i ne 0 ) ; 9 | end 10 | -------------------------------------------------------------------------------- /progs/sort: -------------------------------------------------------------------------------- 1 | // sort (shuttle sort or bubble sort, hard to say) by P.Th. Pilgram 2 | // sorts input in growing order. 3 | 4 | yield ("error", in, 0) 5 | 6 | where 7 | 8 | yield (hist, insertion, t) = 9 | ( if c 10 | then yield (k, next insertion, t+1) upon c 11 | else k 12 | fi ) 13 | where 14 | c = t < ind ; 15 | ind = 0 fby ind+1; 16 | k = new (hist, insertion, t); 17 | end ; 18 | 19 | new (old, insertion, t) = 20 | // "new" = first of "insertion" inserted into "old" 21 | // old is defined in the segment 0...t-1. 22 | if first ( (t ne 0) and (old < insertion) ) // better: andalso 23 | then old fby new (next old, insertion, t-1) 24 | else insertion fby old 25 | fi ; 26 | end 27 | -------------------------------------------------------------------------------- /progs/square: -------------------------------------------------------------------------------- 1 | square where 2 | 3 | square = 0 fby ( square + 2*ind + 1 ) ; 4 | 5 | ind = 0 fby ind+1; 6 | 7 | end 8 | -------------------------------------------------------------------------------- /progs/square.i: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mpw/pLucid-osx/59970fabba8008d6c63589e501a56d7c6bf2f7b0/progs/square.i -------------------------------------------------------------------------------- /progs/sum: -------------------------------------------------------------------------------- 1 | sum( x , n ) where 2 | sum( xt , n ) = ss fby sum( xx , next n ) 3 | where 4 | ss = s asa first n eq int ; 5 | s = xt fby s + next xt ; 6 | xx = xt wvr first n < int ; 7 | int = 1 fby int + 1 ; 8 | end ; 9 | end 10 | -------------------------------------------------------------------------------- /progs/t: -------------------------------------------------------------------------------- 1 | x + z where z = q where n= x where x=p; end; 2 | q = n; 3 | end; 4 | x = n where n = p; 5 | p = 1; 6 | end; 7 | end 8 | -------------------------------------------------------------------------------- /progs/t.l: -------------------------------------------------------------------------------- 1 | 2 | S where 3 | I = 1 fby I+1; 4 | F = 1 fby F*(I+1) ; 5 | S = 1 fby S+F*(I+1); 6 | end 7 | -------------------------------------------------------------------------------- /progs/try: -------------------------------------------------------------------------------- 1 | isnull t 2 | -------------------------------------------------------------------------------- /progs/words: -------------------------------------------------------------------------------- 1 | 2 | substr(W3,1,3) ^ `s' ^ substr(W3,3,3) 3 | where 4 | W =`' fby letter ^ (W upon letter eq `z'); 5 | letter = alpha( index mod 26); 6 | alpha(n) = substr(`abcdefghijklmnopqrstuvwxyz',n+1,n+1); 7 | W3 = W whenever length(W) eq 3; 8 | end 9 | -------------------------------------------------------------------------------- /shell_scripts/READ_ME: -------------------------------------------------------------------------------- 1 | This directory contains two shell scripts. You will have to 2 | decide on where you want to put these in your system. This may 3 | involve small changes to these shell_scripts and to the 4 | makefile in ../lu/p1 to ../lu/p6. Note lucomp and luval are the 5 | names used in the UNIX manual entry. (see ../lu/doc/lucid.1 ) 6 | 7 | I) lucid used to compile and run lucid 8 | programmes. 9 | 10 | II) lucomp (filename> used to compile lucid programmes. 11 | 12 | 13 | Note luval is not a shell script it is simple the a.out file 14 | associated with pass6. (see makefile in ../lu/p6 ) 15 | -------------------------------------------------------------------------------- /shell_scripts/lucid: -------------------------------------------------------------------------------- 1 | export PATH=/usr/local/lib/plucid/:$PATH 2 | if test -f $1.i 3 | then rm $1.i 4 | fi 5 | pass1 $1 | pass2 | pass3 | pass4 | pass5 $1 6 | if test -f $1.i 7 | then luval $1.i 8 | fi 9 | -------------------------------------------------------------------------------- /shell_scripts/lucomp: -------------------------------------------------------------------------------- 1 | export PATH=/usr/local/lib/plucid/:$PATH 2 | if test -f $1.i 3 | then rm $1.i 4 | fi 5 | pass1 $1 | pass2 | pass3 | pass4 | pass5 $1 6 | --------------------------------------------------------------------------------