Path: utzoo!utgpu!news-server.csri.toronto.edu!rutgers!apple!olivea!oliveb!isc-br!ewu!ttork From: ttork@ewu.UUCP (Terry Torkelson) Newsgroups: comp.sys.transputer Subject: Unix Occam Compiler Keywords: Occam Message-ID: <1337@ewu.UUCP> Date: 14 Nov 90 19:37:59 GMT Distribution: usa Organization: Eastern Washington Univ. Cheney WA Lines: 6944 Just received this from Mr Shapira: >Hello, > This is the first shar file out of four. Each file creates a directory > named like it (e.g. this file, comp, will create a directory ./comp), > so be carefull to give it another name (e.g. comp.shar). > Also note that I have put a dash-line at the end of the file. So you > can see if you recieved it all. > >Have fun, >--Amos Shapira >amoss@batata.huji.ac.il ----------comp.shar---------- #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # comp # This archive created: Thu Apr 19 16:54:01 1990 export PATH; PATH=/bin:$PATH if test ! -d 'comp' then mkdir 'comp' fi cd 'comp' if test ! -d 'h' then mkdir 'h' fi cd 'h' if test -f 'conf.h' then echo shar: will not over-write existing file "'conf.h'" else cat << \SHAR_EOF > 'conf.h' /* $Header: conf.h,v 1.1 86/11/04 10:06:14 gil Exp $ */ /* * This is the configuration file for the OCCAM compiler. * It contains a few parameters that determine the support of * non-standard options. * See the user manual for detailed description of these options. * When noted, the runtime library should be configured to support * the option. * This is done by setting the options in the library's * configuration file, ../inter/conf.h * * The options are: */ /* S_VMS: support for special system VMS-compatible channels syntax * (mainly the 'AT' declaration). * NOTE: Should be set in the runtime library as well. */ /* #define S_VMS */ /* BUFF_CHANS: support for decalration of buffered channels - * que chname(size): * NOTE: Should be set in the runtime library as well. */ #define BUFF_CHANS SHAR_EOF fi # end of overwriting check if test -f 'error.h' then echo shar: will not over-write existing file "'error.h'" else cat << \SHAR_EOF > 'error.h' #ifndef ERR_LIST #include "errors.h" #endif #ifndef EXT #define EXT extern #endif EXT ErrChar; #define ErrRet() if(InError) return enum err_type { WARNING, ERROR, COMPILER_ERROR, RECOVER }; struct error_list { enum err_type type; char *str; }; extern struct error_list Err_list[]; SHAR_EOF fi # end of overwriting check if test -f 'hash.h' then echo shar: will not over-write existing file "'hash.h'" else cat << \SHAR_EOF > 'hash.h' #define NULL 0 struct hashent { char *h_name; struct decl *h_decl; int h_count; /* number of times this name is * declared global */ }; #define insert(where, what) { Hash[where].h_name = strsave(what);\ Hash[where].h_decl = NULL;\ } #define HASHSZ 1033 struct hashent Hash[HASHSZ]; /* note: HASHSZ SHOULD BE PRIME !!*/ SHAR_EOF fi # end of overwriting check if test -f 'lex.h' then echo shar: will not over-write existing file "'lex.h'" else cat << \SHAR_EOF > 'lex.h' /* $Header: lex.h,v 1.2 85/02/12 15:46:34 gil Exp $ */ /* trick: define EXT where the actual allocation is to be performed. */ #ifndef EXT #define EXT extern #endif EXT int PrevIndent, CurIndent; /* save previous indent level, with : comparison to current indent level. */ EXT int lines; /* lines counter */ char *strsave(); #define TABSZ 8 extern char yytext[]; extern yyleng; extern FILE *yyin; typedef union lval { int lv_intval; char lv_charval; int lv_hashval; char *lv_strval; } Lval; #define v_intval Lval.lv_intval #define v_charval Lval.lv_charval #define v_hashval Lval.lv_hashval #define v_strval Lval.lv_strval #define noval 0 #define INT 1 #define STR 2 #define HASH 3 #define CHAR 4 #define operator 5 #define reserved 6 SHAR_EOF fi # end of overwriting check if test -f 'machine.h' then echo shar: will not over-write existing file "'machine.h'" else cat << \SHAR_EOF > 'machine.h' #define NBBY 8 #define NBPL 4 #define N_OPER 4 #define MAXINT 2147483647 #define STARTCODE 0 #define BYTE_SIZE 1 #define INT_SIZE 4 #define ARG_SIZE 4 #define ARG_START 4 #ifdef vax #define SP_START 8 #else #ifdef tahoe #define SP_START 56 #endif tahoe #endif not vax #ifdef vax #define NREG 10 /* registers 0-10 can allocated as : temporaries */ #else tahoe #define NREG 11 #endif #define reg(i) (1<<(i)) /* bit mask for register i */ #define OtherRegs (0) /* mask for registers which should : not be used */ #define DontUse (0) /* " " */ #define ShouldBeMasked(i) (i > 5) /* register 0-5 should not be in : 'calls' mask */ #define ADDRMASK (reg(0):reg(1):reg(2):reg(3):reg(4):reg(5)) #define TEMPMASK (reg(0):reg(1)) #define CODEMASK (0) /* The following instructions numbers should not conflict with the numbers : generated by yacc in y.tab.h */ #define MOVREF 1 /* movl */ #define MOVL 2 /* "" */ #define CMP 3 /* cmpl */ #define JMP 4 /* jbr */ #define TST 5 /* tstl */ #define JUMP 6 /* jmp */ #define roundup(n) (((n) + (INT_SIZE - 1)) & ~(INT_SIZE - 1)) #define SP 14 /* register no. of the stack-pointer */ #ifdef vax #define DP 11 /* display pointer is r11 */ #else tahoe #define DP 12 /* r12 on tahoe */ #endif #define TIME_COUNTER 0 /* Time counter for each process is at top of : display */ SHAR_EOF fi # end of overwriting check if test -f 'parse.h' then echo shar: will not over-write existing file "'parse.h'" else cat << \SHAR_EOF > 'parse.h' #ifndef EXT #define EXT extern #endif EXT prnt; EXT int balagan, declaration; #define MAXPARLEVEL 128 #define MAXINDENTLEVEL 128 #define MAX_STACK 128 typedef struct expr { int e_flags; addr e_slen; /* slice length */ Quadl e_false; addr e_place; } Expr; /* Some macros to make life easier... */ #define e_cval e_place.d_offset #define E_TYPE 0xff #define ET_INT 0x1 #define ET_CHAR 0x1 #define ET_BOOL 0x1 #define ET_CHAN 0x2 /* channel - used only for parameter : passing */ #define ET_SLICE 0x3 #define ET_CHANTAB 0x4 #define ET_INTTAB 0x8 #define ET_TABMASK 0xc #define E_KIND 0xff00 #define EK_VAR 0x100 #define EK_CONST 0x200 #define EK_EXP 0x400 #define E_OTHER 0xff0000 #define EBYTE_SUBSCRIPT 0x10000 #define IsConst(e) ((e.e_flags&E_KIND) == EK_CONST) #define IsEtab(e) (e.e_flags&ET_TABMASK) #define IsVar(e) ((e.e_flags&E_KIND) == EK_VAR) #define IsSlice(e) ((e.e_flags&E_TYPE) == ET_SLICE) /* Using temporary storage */ #define IsTemp(e) ((e.e_flags&E_KIND) == EK_EXP) #define IsReadOnly(e) (e.e_place.d_flags&AF_RO) #define Addr(e) (e).e_place typedef struct cond_list { Label c_out; Quadl c_next; } Cond; typedef struct guard { Expr gu_chan; Quadl gu_next; } Guard; typedef struct replicator { Label r_loop; Label r_out; addr r_var; addr r_to; } Repl; typedef int Buffer; #define NALT 8 /* number of nested alts (ALT ALT) */ typedef struct alt { addr a_argcnt, /* Number of alt requests */ a_pushcnt; /* Actual number of parameters pushed */ int a_nsave; /* Number of saved replicated alt counters */ addr a_save[NALT]; /* Saved data */ Label a_out; Buffer a_flowbuf, /* buffer for alt's flow code (pushes+call) */ a_textbuf; /* buffer for the alt processes parsed : meanwhile */ } Alt; extern Expr Bool(), CharVal(), IntVal(), IndexedVar(), ByteIndexedVar(), Identifier(), ArithOp(), Rand(), Ror(), EvalBool(), CmpOp(), MonOp(), StrVal(), CondExpr(), ByteSlice(), IntSlice(), StrToSlice(), LocalClock(), TimeChan(), Zero(); extern addr NewCounter(); extern Repl Loop(), NewRepl(); extern DType DeclParam(), DeclParamTab(); extern Buffer CurBuf, NewBuf(), ToBuf(), Sbuf(); extern Buffer MainText; extern int NoMain; #define C_TRUE 0xffffffff #define C_FALSE 0 #define CVAL(v) (v) #define TRUE_VAL(tv) ((tv) ? C_TRUE : C_FALSE) #define MON(op) (op : 0x8000) SHAR_EOF fi # end of overwriting check if test -f 'reserved.h' then echo shar: will not over-write existing file "'reserved.h'" else cat << \SHAR_EOF > 'reserved.h' struct reswords { char *rs_word; int rs_token; int rs_type; }; extern struct reswords ReservedWords[]; extern int nreserved; SHAR_EOF fi # end of overwriting check if test -f 'y.tab.h' then echo shar: will not over-write existing file "'y.tab.h'" else cat << \SHAR_EOF > 'y.tab.h' # define AFTER 257 # define FALSE 258 # define LT_TOK 259 # define RIGHT_TOK 260 # define ALT 261 # define FCHAN_TOK 262 # define MINUS_TOK 263 # define RP_TOK 264 # define AND 265 # define FOR 266 # define MOD_TOK 267 # define RSHIFT_TOK 268 # define AND_TOK 269 # define GE_TOK 270 # define MULT_TOK 271 # define SEMICOLON_TOK 272 # define ASSIGN_TOK 273 # define GT_TOK 274 # define NEQ_TOK 275 # define SEQ 276 # define BYTE 277 # define ID_TOK 278 # define NEWLINE 279 # define SKIP 280 # define CHAN 281 # define IF 282 # define NOT 283 # define STRING 284 # define CHARACTER 285 # define INP_TOK 286 # define NOW 287 # define TABLE 288 # define COMA_TOK 289 # define INTEGER 290 # define OR 291 # define TRUE 292 # define COND_TOK 293 # define LBR_TOK 294 # define OR_TOK 295 # define VALUE 296 # define DEF 297 # define LEFT_TOK 298 # define PAR 299 # define VAR 300 # define DIV_TOK 301 # define LE_TOK 302 # define PLUS_TOK 303 # define WAIT 304 # define EQ_TOK 305 # define LP_TOK 306 # define PROC 307 # define WHILE 308 # define EXTERN 309 # define LSHIFT_TOK 310 # define RBR_TOK 311 # define XOR_TOK 312 # define AT 313 # define QUE 314 typedef union { Expr Expr; Decl Decl; int Hv; Op Op; Lval Lval; Args Args; Quadl Quadl; Label Label; Cond Cond; Guard Guard; Repl Repl; DType DType; } YYSTYPE; extern YYSTYPE yylval; SHAR_EOF fi # end of overwriting check if test -f 'addr.h' then echo shar: will not over-write existing file "'addr.h'" else cat << \SHAR_EOF > 'addr.h' typedef unsigned int u_int; typedef unsigned short u_short; typedef int addr_t; typedef int Op; /* An address is computed by DIS[d_disp]+d_offset : display starts at 1, d_disp = 0 means immediate mode */ typedef struct addr { /* address format */ char d_flags; char d_reg; short d_disp; /* entry # in display */ addr_t d_offset; /* offset */ } addr; /* Address types (special meanings place in the display) */ #define AD_REGISTER (-1) #define AD_IMMED 0 #define AD_GLOBAL 1 #define AF_AP 0x1 #define AF_PTR 0x2 #define AF_REG 0x4 #define AF_FP 0x8 #define AF_SUB 0x10 #define AF_RO 0x20 #define AF_BYTE 0x40 #define AF_LABEL 0x80 #define IsReg(a) ((a).d_disp == AD_REGISTER) #define IsByte(a) ((a).d_flags & AF_BYTE) #define SameAddr(a1, a2) ((a1).d_disp == (a2).d_disp && (a1).d_offset == (a2).d_ offset) #define NullA(a) ((a).d_disp == AD_REGISTER && (a).d_offset == -1) /* The 8'th bit of a parameter type (in d.d_args) is set, if the parameter is : passed by reference */ #define TYPE_REF (1<<8) #define TYPE_EXTRN (1<<9) #define EXT_BITS (0xff00) #define ByRef(t) (DType)((int)(t):TYPE_REF) #define IsByRef(t) ((int)(t)&TYPE_REF) #define Extern(t) (DType)((int)(t):TYPE_EXTRN) #define IsExtern(t) ((int)(t)&TYPE_EXTRN) #define Type(t) (DType)((int)(t)&~EXT_BITS) #define IsTab(t) (Type(t) == DINT_TAB :: Type(t) == DCHAN_TAB) enum type { UNDEF, DPROC, DINT, DCHAN, DINT_TAB, DCHAN_TAB, TAB }; typedef enum type DType; struct args { /* procedure argument list */ int a_nargs; DType *a_argt; }; typedef struct args Args; struct proc_info { int pi_masklabel; Args pi_args; }; typedef struct proc_info Pinfo; typedef struct decl { DType d_type; int d_flags; #define DF_DEF 0x1 #define DF_REF 0x2 int d_level; addr d_addr; /* if d_disp == AD_GLOBAL then put in : d_offset a pointer to the NAME of the : variable */ union dinfo { int di_nel; /* no. of elements in array */ Pinfo di_proc; /* proc info: arguments + mask : labels. */ } d_info; #define d_cval (int)d_addr.d_offset #define d_nel d_info.di_nel #define d_args d_info.di_proc.pi_args #define d_masklabel d_info.di_proc.pi_masklabel struct decl *d_next; struct hashent *d_hnext; } *Decl; #define IsDef(dec) ((dec)->d_flags & DF_DEF) #define IsRef(dec) ((dec)->d_flags & DF_REF) #define IsProc(dec) ((dec)->d_type == DPROC) #define IsIdent(dec) ((dec)->d_type != DPROC && (dec)->d_type != UNDEF) extern addr NullAddr; extern addr_t Sp; extern int DispLevel; /* the display level (incremented for each : proc xxx) */ extern int ProcCount[]; /* : Process ounter. : We need this counter - extra to the display - because we don't need to : creat a new DISPLAY for each (non declared) process (it will never : be INVOKED from any other place in the program). however - the local : variables have only the PROCESS a scope. */ extern struct decl *DeclExternProc(), *ForwardDeclProc(), *DeclDefTab(); extern char *GenDefLabel(), *GenLabelName(); extern addr_t AllocStack(); extern addr NewTemp(), GenSave(), makeaddr(), RegAddr(), GenIntSubscript(), GenByteSubscript(), Lvalue(), Addr(), DeclRepVar(), GetAddr(), GenSliceAddr(), Register(), Immediate(), Eval(); extern Args MakeArg(), AddArg(); extern DType Etype(); extern Args NoArgs; extern char *ProcName[]; #define new(type) (struct type *) calloc(1, sizeof(struct type)) SHAR_EOF fi # end of overwriting check if test -f 'all.h' then echo shar: will not over-write existing file "'all.h'" else cat << \SHAR_EOF > 'all.h' #include "conf.h" #include "machine.h" #include "addr.h" #include "lex.h" #include "hash.h" #include "back.h" #include "parse.h" #include "error.h" #include "reserved.h" #ifndef DEF #include "y.tab.h" #endif SHAR_EOF fi # end of overwriting check if test -f 'back.h' then echo shar: will not over-write existing file "'back.h'" else cat << \SHAR_EOF > 'back.h' typedef int Label; typedef struct quad_list { int q_nquads; Label *q_quads; } Quadl; extern Quadl MakeList(), Merge(), AddList();; extern Quadl NewProcess(); extern Label ReplProc(), Land(), Lor(); extern Quadl NullQuadl; #define NullQ(ql) ((ql).q_nquads == 0) SHAR_EOF fi # end of overwriting check if test -f 'errors.h' then echo shar: will not over-write existing file "'errors.h'" else cat << \SHAR_EOF > 'errors.h' #define ERR_LIST #define INTEGER_OVERFLOW 1 #define NEWLINE_IN_CHAR_CONST 2 #define CHAR_CONST_TOO_LONG 3 #define EMPTY_CHAR_CONST 4 #define ESCAPE_CHAR 5 #define NO_SPECIAL_MEANING 6 #define UNFINISHED_STR 7 #define HASH_FULL 8 #define ODD_NO_OF_BLANKS 9 #define ILLEGAL_CHAR 10 #define LEX_INTERNAL_ERROR 11 #define EXPECTED_EOF 12 #define UNEXPECTED_EOF 13 #define EXPECTED_CONST 14 #define TYPE_MISMATCH 15 #define DIV_BY_ZERO 16 #define OP_MISMATCH 17 #define UNDEF_VAR 18 #define MULTIPLY_DECLARED_VAR 19 #define LVAL_REQ 20 #define CHANNEL_REQ 21 #define PROC_REQUIRED 22 #define UNDEF_PROC 23 #define ILL_NUM_OF_ARGS 24 #define EXTERN_EXISTS 25 #define TABLE_REQUIRED 26 #define VALUE_PARAM_ASSIGN 27 #define SLICE_REQUIRED 28 #define DIFF_SLICES 29 #define TOO_MANY_ERRORS 30 #define MISSING_PARAM_TYPE 31 #define EXTRA_INDENT 32 #define EXPECT_SHIFTED_PROC 33 #define SYNT_ERR_NEAR 34 #define EXTERN_NAME_OVERLOAD 35 #define IDENT_REQUIRED 36 #define VMS_UNSUPPORTED 37 SHAR_EOF fi # end of overwriting check cd .. if test -f 'decl.c' then echo shar: will not over-write existing file "'decl.c'" else cat << \SHAR_EOF > 'decl.c' static char *rcsid = "$Header: decl.c,v 2.3 86/11/03 13:49:50 gil Exp $"; /* * $Log: decl.c,v $ * Revision 2.3 86/11/03 13:49:50 gil * support for VMS and special INPUT/OUTPUT channels are 'ifdef'ed. * * Revision 2.2 86/11/01 12:19:59 gil * added declaration of buffered channels (channels have buffer sizes now). * * Revision 2.1 86/10/30 16:05:59 gil * This version was submitted for the project. It is free of all major bugs. * */ #include #include "all.h" extern CurBuf, RO_DataBuf; extern char *calloc(), *malloc(), *sprintf(); int DispLevel = AD_GLOBAL; addr_t Sp = SP_START; DType ParamTypeConv(); char *ProcName[MAX_STACK]; int ProcCount[MAX_STACK]; Args NoArgs = { 0, NULL }; DType settabtype(), settype(), declparam(); char *UniqueGName(); static struct hashent *LastVar = NULL; static addr_t ArgAddr = ARG_START; static int fextern; /* flag: external declaration */ char * printnum(name, num) char *num; { return(sprintf(malloc(strlen(name)+6), "%s%d", name, num)); } Decl Declare(hv) { Decl d, nd; d = Hash[hv].h_decl; if (d != NULL && d->d_addr.d_disp == DispLevel && d->d_level == ProcCount[DispLevel]) { Error(ERROR, MULTIPLY_DECLARED_VAR); return NULL; } Hash[hv].h_decl = nd = new(decl); nd->d_level = ProcCount[DispLevel]; nd->d_addr = NullAddr; /* chain identifiers of current level (display) for easy freeing */ nd->d_next = d; nd->d_hnext = LastVar; LastVar = &Hash[hv]; return nd; } Decl DeclChanOrVar(hv) { register Decl nd; if ((nd = Declare(hv)) == NULL) return nd; nd->d_addr.d_disp = DispLevel; if (fextern) nd->d_addr.d_offset = (addr_t)UniqueGName(hv); else if (DispLevel == AD_GLOBAL) { nd->d_addr.d_offset = (addr_t)UniqueGName(hv); GenGlobal(nd, INT_SIZE); } else nd->d_addr.d_offset = AllocStack(INT_SIZE); return nd; } DeclVar(hv) { Decl nd; nd = DeclChanOrVar(hv); if(nd != NULL) if (fextern) nd->d_type = Extern(DINT); else nd->d_type = DINT; } Decl DeclTab(hv, e, esize) Expr e; { Decl nd; if(!fextern && !IsConst(e)) { Error(ERROR, EXPECTED_CONST); return NULL; } if ((nd = Declare(hv)) == NULL) return NULL; nd->d_addr.d_disp = DispLevel; if (fextern) nd->d_addr.d_offset = (addr_t)UniqueGName(hv); else if (DispLevel == AD_GLOBAL) { nd->d_addr.d_offset = (addr_t)UniqueGName(hv); GenGlobal(nd, e.e_cval * esize); } else nd->d_addr.d_offset = AllocStack(roundup(e.e_cval * esize)); nd->d_nel = e.e_cval; return nd; } DeclVarTab(hv, e) Expr e; { register Decl nd; nd = DeclTab(hv, e, INT_SIZE); if(nd != NULL) if (fextern) nd->d_type = Extern(DINT_TAB); else nd->d_type = DINT_TAB; } DeclVarByteTab(hv, e) Expr e; { register Decl nd; nd = DeclTab(hv, e, 1); if(nd != NULL) if (fextern) nd->d_type = Extern(DINT_TAB); else nd->d_type = DINT_TAB; } DeclChanTab(hv, e, bufsiz) Expr e, bufsiz; { register Decl nd; if(!fextern && !IsConst(bufsiz)) { Error(ERROR, EXPECTED_CONST); return; } nd = DeclTab(hv, e, INT_SIZE); if(nd != NULL) if (fextern) nd->d_type = Extern(DCHAN_TAB); else { nd->d_type = DCHAN_TAB; AllocChanTable(nd, bufsiz.e_place); } } static int byte_def_tab = 0; SetByte() { byte_def_tab = 1; } UnsetByte() { byte_def_tab = 0; } Decl DeclDefTab(hv) { register Decl nd; if ((nd = Declare(hv)) == NULL) return; nd->d_addr.d_disp = DispLevel; if (DispLevel == AD_GLOBAL) { nd->d_addr.d_offset = (addr_t)UniqueGName(hv); GenDef(nd->d_addr.d_offset); } else { nd->d_addr.d_offset = (addr_t) strsave(GenDefLabel(NewLabel())); nd->d_addr.d_flags := AF_LABEL; } nd->d_flags = DF_DEF; nd->d_type = DINT_TAB; return nd; } DeclDefEl(e) Expr e; { if (!IsConst(e)) { Error(ERROR, EXPECTED_CONST); return; } GenDefEl(e.e_cval, byte_def_tab); } DeclDefStr(hv, s) char *s; { Decl nd; if ((nd = Declare(hv)) == NULL) return; nd->d_addr.d_disp = DispLevel; if (DispLevel == AD_GLOBAL) { nd->d_addr.d_offset = (addr_t)UniqueGName(hv); GenDef(nd->d_addr.d_offset); } else { nd->d_addr.d_offset = (addr_t) strsave(GenDefLabel(NewLabel())); nd->d_addr.d_flags := AF_LABEL; } GenDefStr(s); nd->d_flags = DF_DEF; nd->d_type = DINT_TAB; } DeclDef(hv, e) Expr e; { register Decl nd; if (!IsConst(e)) { Error(ERROR, EXPECTED_CONST); return; } if ((nd = Declare(hv)) == NULL) return; nd->d_type = DINT; nd->d_flags = DF_DEF; nd->d_addr = e.e_place; } DeclChan(hv, bufsiz) Expr bufsiz; { register Decl nd; if(!fextern && !IsConst(bufsiz)) { Error(ERROR, EXPECTED_CONST); return; } nd = DeclChanOrVar(hv); if(nd == NULL) return; if (fextern) nd->d_type = Extern(DCHAN); else { nd->d_type = DCHAN; AllocChan(nd->d_addr, bufsiz.e_place); } } DeclChanAt(hv, e) Expr e; { #ifdef S_VMS DeclChan(hv, Zero()); if (!IsConst(e)) { Error(ERROR, EXPECTED_CONST); return; } if (fextern) return; GenPush(0, e.e_place); GenPush(0, Hash[hv].h_decl->d_addr); GenFuncCall(Immediate(2), "chat", 1, NullAddr); #else S_VMS Error(ERROR, VMS_UNSUPPORTED); #endif S_VMS } DeclTimeChan(hv) { DeclChan(hv, Zero()); GenPush(0, Hash[hv].h_decl->d_addr); GenFuncCall(Immediate(1), "chtime", 1, NullAddr); } Repl NewRepl(hv) { Repl r; Decl d; ProcCount[DispLevel]++; /* incremented for the time of replicator : 'parameter' (loop variable) declaration. */ if((d = Declare(hv)) == NULL) return r; d->d_type = DINT; d->d_addr = GetAddr(); d->d_addr.d_flags := AF_RO; ProcCount[DispLevel]--; /* was incremented for the time of replicator : 'parameter' declaration. */ r.r_var = d->d_addr; r.r_loop = NewLabel(); r.r_out = NewLabel(); return r; } StartProc(hv) { PushBuf(); GenProc(hv); } EndProc(hv) { GenEndProc(Hash[hv].h_decl->d_masklabel); Pop(); PopBuf(); } FreeProc(plevel) { /* Free vars of process; in case of DECLARED proc it frees also the : proc's PARAMETERS. */ FreeVars(plevel); } Decl ForwardDeclProc(hv) { /* : Declare the process without arguments (and possibly other specifications). : Do this BEFORE incrementing display level, and thus the process' scope : will include the former process (contrary to the new process' vars and : parameters. */ register Decl nd; if ((nd = Declare(hv)) == NULL) return; if (ProcCount[DispLevel] != 1) ProcName[DispLevel] = printnum(Hash[hv].h_name, ProcCount[DispLevel]); else ProcName[DispLevel] = Hash[hv].h_name; nd->d_addr.d_offset = (addr_t) ProcName[DispLevel]; nd->d_addr.d_disp = DispLevel; /* The process' declaration needs to be freed one level AFTER its : local vars (and parameters). Therefore - d_disp here is one LESS : than the parameters (since 'DispLevel' is incremented only in : 'StartProc'). */ nd->d_type = DPROC; StartProc(hv); Push(); ProcCount[DispLevel]++; /* incremented for the time of parameters' : declarations. */ return nd; } DeclProc(d, args) Args args; Decl d; { ArgAddr = ARG_START; d->d_args = args; ProcCount[DispLevel]--; /* was incremented for the time of : parameters' declarations */ } Decl DeclExternProc(hv) { register Decl d, nd; d = Hash[hv].h_decl; while(d != NULL) { if (d->d_addr.d_disp == AD_GLOBAL) { Error(ERROR, EXTERN_EXISTS); return; } d = d->d_next; } if ((nd = Declare(hv)) == NULL) return; nd->d_type = Extern(DPROC); nd->d_addr.d_offset = (addr_t) Hash[hv].h_name; nd->d_addr.d_disp = DispLevel; Push(); ProcCount[DispLevel]++; /* incremented for the time of parameters' : declarations. */ return nd; } FreeVars(plevel) { /* : Free Vars of current process: : - Don't free all vars of the current display (use ProcCount). : - Don't free the process declaration itself - it's still in scope for : one more level (this is taken care of in the declaration: the process' : declaration accepts the proc-level of the former process. */ register Decl d; register struct hashent *hp; #ifdef TRACEFREE printf("# Displevel: %d ProcCount[DispLevel]; %d\n", DispLevel, ProcCount[DispL evel]); #endif for(hp = LastVar; hp != NULL;) { d = hp->h_decl; #ifdef TRACEFREE printf("# %s %d %d - ", hp->h_name, d->d_level, d->d_addr.d_disp); #endif if (d->d_level < plevel) break; #ifdef TRACEFREE printf("Freed\n"); #endif hp->h_decl = d->d_next; hp = d->d_hnext; if(!(d->d_addr.d_flags & AF_AP) && !IsExtern(d->d_type)) if(Type(d->d_type) == DCHAN) DisposeChan(d->d_addr); else if(Type(d->d_type) == DCHAN_TAB) DisposeChanTab(d); free(d); } LastVar = hp; #ifdef TRACEFREE printf("Break\n"); #endif } /* declare procedure parameters */ static int last_type = -1; DType DeclParam(type, hv) { return(declparam(type, hv, 0)); } DType DeclParamTab(type, hv) { return(declparam(type, hv, 1)); } DType declparam(type, hv, istab) { register Decl nd; DType t; if((nd = Declare(hv)) == NULL) return; nd->d_addr.d_flags = AF_AP; nd->d_addr.d_disp = DispLevel; nd->d_addr..d_offset = ArgAddr; ArgAddr += ARG_SIZE; /* since we pass table by reference, this is : correct for tabs, too. */ if (type == -1) if (last_type == -1) { Error(ERROR, MISSING_PARAM_TYPE); return; } else type = last_type; t = ParamTypeConv(type); last_type = type; if (istab) return settabtype(nd, type, t); else return settype(nd, t); /*UNREACHED*/ } DType settype(d, dtype) Decl d; DType dtype; { d->d_type = Type(dtype); if(IsByRef(dtype)) d->d_addr.d_flags := AF_PTR; else d->d_addr.d_flags := AF_RO; return dtype; } DType settabtype(d, ptype, dtype) Decl d; DType dtype; { switch (ptype) { case VAR : d->d_type = ByRef(DINT_TAB); break; case VALUE: d->d_type = DINT_TAB; break; case CHAN: d->d_type = DCHAN_TAB; break; default: panic("settabtype: bad type"); break; } if(!IsByRef(dtype)) d->d_addr.d_flags := AF_RO; d->d_addr.d_flags := AF_PTR; return(d->d_type); } EndParams() { last_type = -1; } static struct hashent *VarStack[MAX_STACK]; static addr_t SpStack[MAX_STACK]; static long RegStack[MAX_STACK]; static long MRegStack[MAX_STACK]; static int BufStack[MAX_STACK]; extern long RegistersUsed; extern long MaxTemp; Push() { if (DispLevel >= MAX_STACK) panic("Push: stack overflow"); VarStack[DispLevel] = LastVar; SpStack[DispLevel] = Sp; RegStack[DispLevel] = RegistersUsed; MRegStack[DispLevel] = MaxTemp; DispLevel++; LastVar = NULL; Sp = SP_START; ResetTmp(); } Pop() { if (--DispLevel < 0) panic("Pop from top level"); LastVar = VarStack[DispLevel]; Sp = SpStack[DispLevel]; RegistersUsed = RegStack[DispLevel]; MaxTemp = MRegStack[DispLevel]; } static bufs = 0; PopBuf() { (void) ToBuf(BufStack[--bufs]); } PushBuf() { BufStack[bufs++] = CurBuf; (void) NewBuf(); } set_extern() { fextern = 1; } unset_extern() { fextern = 0; } char * UniqueGName(hv) { register l; register char *cp; int *hc; hc = &(Hash[hv].h_count); cp = Hash[hv].h_name; l = strlen(cp); if (*hc > 0 && fextern) { Error(WARNING, EXTERN_NAME_OVERLOAD, cp); return cp; } if (*hc > 0) cp = sprintf(malloc(l+5), "%s%d$", cp, *hc); (*hc)++; return cp; } SHAR_EOF fi # end of overwriting check if test -f 'err.c' then echo shar: will not over-write existing file "'err.c'" else cat << \SHAR_EOF > 'err.c' static char rcsid[] = "$Header: err.c,v 2.1 86/10/30 16:06:01 gil Exp $"; /* * $Log: err.c,v $ * Revision 2.1 86/10/30 16:06:01 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:32 gil * Initial revision * */ #include #include "all.h" extern yychar; #ifdef NEWYACC extern struct yytoken { char *t_name; int t_val; } yytoks[]; char * tokenname(t) register t; { register struct yytoken *tp; if(t == 0) return "-EOF-"; for(tp = yytoks; tp->t_val > 0; tp++) if(t == tp->t_val) break; return tp->t_name; } #else NEWYACC char * tokenname(t) { return ""; } #endif ProcError() { Error(ERROR, SYNT_ERR_NEAR, tokenname(ErrChar)); /* fprintf(stderr, "Syntax Error on %s\n", tokenname(ErrChar)); */ } yyerror(s) char *s; { if(yychar == 0) LexError(ERROR, UNEXPECTED_EOF); ErrChar = yychar; /* Save the first erroneous token : for error detection by : SyntErr or LHSExpr */ /* fprintf(stderr, "yyerror: Error char %s\n", tokenname(yychar)); */ } ShiftError() { Error(ERROR, EXPECT_SHIFTED_PROC, tokenname(yychar)); /* fprintf(stderr, "Expected shifted process, on %s\n", tokenname(yychar)); */ } SHAR_EOF fi # end of overwriting check if test -f 'error_list.c' then echo shar: will not over-write existing file "'error_list.c'" else cat << \SHAR_EOF > 'error_list.c' #define ERR_LIST #include "error.h" struct error_list Err_list[] = { WARNING, "No Error", RECOVER , "Integer overflow", #define INTEGER_OVERFLOW 1 RECOVER , "Newline in character constant", #define NEWLINE_IN_CHAR_CONST 2 RECOVER , "Character constant too long", #define CHAR_CONST_TOO_LONG 3 WARNING , "Empty character constant", #define EMPTY_CHAR_CONST 4 WARNING , "'*' is escape character", #define ESCAPE_CHAR 5 WARNING , "Escape has no special meaning", #define NO_SPECIAL_MEANING 6 RECOVER , "Unfinished string", #define UNFINISHED_STR 7 COMPILER_ERROR , "Hash table is full", #define HASH_FULL 8 WARNING , "Odd number of blanks", #define ODD_NO_OF_BLANKS 9 ERROR , "Illegal character", #define ILLEGAL_CHAR 10 COMPILER_ERROR , "Lexical error", #define LEX_INTERNAL_ERROR 11 ERROR , "Eof Expected - Quit", #define EXPECTED_EOF 12 ERROR , "Unexpected Eof", #define UNEXPECTED_EOF 13 RECOVER , "Expected constant expression", #define EXPECTED_CONST 14 ERROR , "Type mismatch", #define TYPE_MISMATCH 15 RECOVER , "Division by zero", #define DIV_BY_ZERO 16 RECOVER , "Illegal operand", #define OP_MISMATCH 17 RECOVER , "Undefined variable \"%s\"", #define UNDEF_VAR 18 ERROR , "Multiply declared var", #define MULTIPLY_DECLARED_VAR 19 RECOVER , "Lvalue requierd", #define LVAL_REQ 20 ERROR , "Channel required", #define CHANNEL_REQ 21 ERROR , "Process required", #define PROC_REQUIRED 22 WARNING , "Undefined proc \"%s\", assumed external", #define UNDEF_PROC 23 ERROR , "Wrong number of arguments", #define ILL_NUM_OF_ARGS 24 ERROR , "External definition cannot be overlapped", #define EXTERN_EXISTS 25 ERROR , "Table required", #define TABLE_REQUIRED 26 WARNING , "Assigment to Read Only variable", #define VALUE_PARAM_ASSIGN 27 ERROR , "Slice required", #define SLICE_REQUIRED 28 ERROR , "Slices should be of the same type", #define DIFF_SLICES 29 COMPILER_ERROR , "Too many errors", #define TOO_MANY_ERRORS 30 ERROR , "missing parameters' type (var, value or chan)", #define MISSING_PARAM_TYPE 31 WARNING , "Extra indentation, taken as one indent", #define EXTRA_INDENT 32 RECOVER , "Expected shifted process near token %s", #define EXPECT_SHIFTED_PROC 33 ERROR , "Syntax Error near token %s", #define SYNT_ERR_NEAR 34 WARNING , "External %s is already declared global", #define EXTERN_NAME_OVERLOAD 35 ERROR , "Bad identifier type - \"%s\"", #define IDENT_REQUIRED 36 ERROR , "VMS (placed) channels are not supported", #define VMS_UNSUPPORTED 37 }; SHAR_EOF fi # end of overwriting check if test -f 'Makefile' then echo shar: will not over-write existing file "'Makefile'" else cat << \SHAR_EOF > 'Makefile' # configurable parameteres ################################################################################ CC=cc YACC=/usr/bin/yacc LEX=lex CFLAGS=-Ih -DYYDEBUG -g YFLAGS=-d LFLAGS= # notice: the order of files in OBJS counts. OBJS= error_list.o\ lex.yy.o\ y.tab.o\ back.o\ decl.o\ err.o\ expr.o\ extern.o\ gen.o\ hash.o\ init.o\ io.o\ lex.o\ main.o\ newbuf.o\ par.o\ print.o\ proc.o\ repl.o\ reserved.o\ reserved_words.o\ slice.o\ tab.o\ temp.o\ $(EMPTY) ocp: $(OBJS) $(CC) $(CFLAGS) -o ocp $(OBJS) -ll lex.yy.c: occam.lex $(LEX) $(LFLAGS) occam.lex y.tab.c: parse.y $(YACC) $(YFLAGS) parse.y mv y.tab.h h error_list.o: error_list.c h/errors.h h/error.h error_list.c: err_types sh ../tools/makeerrs reserved_words.c: reserved_words csh -f ../tools/reserve clean: -rm *.o lex.yy.c y.tab.c ocp # dependencies on header files. ################################################################################ back.o: h/conf.h back.o: h/machine.h back.o: h/addr.h back.o: h/lex.h back.o: h/hash.h back.o: h/back.h back.o: h/parse.h back.o: h/error.h back.o: h/reserved.h back.o: h/y.tab.h decl.o: h/conf.h decl.o: h/machine.h decl.o: h/addr.h decl.o: h/lex.h decl.o: h/hash.h decl.o: h/back.h decl.o: h/parse.h decl.o: h/error.h decl.o: h/reserved.h decl.o: h/y.tab.h err.o: h/conf.h err.o: h/machine.h err.o: h/addr.h err.o: h/lex.h err.o: h/hash.h err.o: h/back.h err.o: h/parse.h err.o: h/error.h err.o: h/reserved.h err.o: h/y.tab.h error_list.o: h/error.h expr.o: h/conf.h expr.o: h/machine.h expr.o: h/addr.h expr.o: h/lex.h expr.o: h/hash.h expr.o: h/back.h expr.o: h/parse.h expr.o: h/error.h expr.o: h/reserved.h expr.o: h/y.tab.h extern.o: h/conf.h extern.o: h/machine.h extern.o: h/addr.h extern.o: h/lex.h extern.o: h/hash.h extern.o: h/back.h extern.o: h/parse.h extern.o: h/error.h extern.o: h/reserved.h extern.o: h/y.tab.h hash.o: h/hash.h gen.o: h/conf.h gen.o: h/machine.h gen.o: h/addr.h gen.o: h/lex.h gen.o: h/hash.h gen.o: h/back.h gen.o: h/parse.h gen.o: h/error.h gen.o: h/reserved.h gen.o: h/y.tab.h init.o: h/conf.h init.o: h/machine.h init.o: h/addr.h init.o: h/lex.h init.o: h/hash.h init.o: h/back.h init.o: h/parse.h init.o: h/error.h init.o: h/reserved.h init.o: h/y.tab.h io.o: h/conf.h io.o: h/machine.h io.o: h/addr.h io.o: h/lex.h io.o: h/hash.h io.o: h/back.h io.o: h/parse.h io.o: h/error.h io.o: h/reserved.h io.o: h/y.tab.h lex.o: h/conf.h lex.o: h/machine.h lex.o: h/addr.h lex.o: h/lex.h lex.o: h/hash.h lex.o: h/back.h lex.o: h/parse.h lex.o: h/error.h lex.o: h/reserved.h lex.o: h/y.tab.h lex.yy.o: h/conf.h lex.yy.o: h/machine.h lex.yy.o: h/addr.h lex.yy.o: h/lex.h lex.yy.o: h/hash.h lex.yy.o: h/back.h lex.yy.o: h/parse.h lex.yy.o: h/error.h lex.yy.o: h/reserved.h lex.yy.o: h/y.tab.h main..o: h/conf.h main.o: h/machine.h main.o: h/addr.h main.o: h/lex.h main.o: h/hash.h main.o: h/back.h main.o: h/parse.h main.o: h/error.h main.o: h/reserved.h main.o: h/y.tab.h newbuf.o: h/conf.h newbuf.o: h/machine.h newbuf.o: h/addr.h newbuf.o: h/lex.h newbuf.o: h/hash.h newbuf.o: h/back.h newbuf.o: h/parse.h newbuf.o: h/error.h newbuf.o: h/reserved.h newbuf.o: h/y.tab.h par.o: h/conf.h par.o: h/machine.h par.o: h/addr.h par.o: h/lex.h par.o: h/hash.h par.o: h/back.h par.o: h/parse.h par.o: h/error.h par.o: h/reserved.h par.o: h/y.tab.h print.o: h/error.h proc.o: h/conf.h proc.o: h/machine.h proc.o: h/addr.h proc.o: h/lex.h proc.o: h/hash.h proc.o: h/back.h proc.o: h/parse.h proc.o: h/error.h proc.o: h/reserved.h proc.o: h/y.tab.h repl.o: h/conf.h repl.o: h/machine.h repl.o: h/addr.h repl.o: h/lex.h repl.o: h/hash.h repl.o: h/back.h repl.o: h/parse.h repl.o: h/error.h repl.o: h/reserved.h repl.o: h/y.tab.h reserved.o: h/conf.h reserved.o: h/machine.h reserved.o: h/addr.h reserved.o: h/lex.h reserved.o: h/hash.h reserved.o: h/back.h reserved.o: h/parse.h reserved.o: h/error.h reserved.o: h/reserved.h reserved.o: h/y.tab.h reserved_words.o: h/conf.h reserved_words.o: h/machine.h reserved_words.o: h/addr.h reserved_words.o: h/lex.h reserved_words.o: h/hash.h reserved_words.o: h/back.h reserved_words.o: h/parse.h reserved_words.o: h/error.h reserved_words.o: h/reserved.h reserved_words.o: h/y.tab.h slice.o: h/conf.h slice.o: h/machine.h slice.o: h/addr.h slice.o: h/lex.h slice.o: h/hash.h slice.o: h/back.h slice.o: h/parse.h slice.o: h/error.h slice.o: h/reserved.h slice.o: h/y.tab.h tab.o: h/conf.h tab.o: h/machine.h tab.o: h/addr.h tab.o: h/lex.h tab.o: h/hash.h tab.o: h/back.h tab.o: h/parse.h tab.o: h/error.h tab.o: h/reserved.h tab.o: h/y.tab.h temp.o: h/addr.h temp.o: h/machine.h y.tab.o: h/conf.h y.tab.o: h/machine.h y.tab.o: h/addr.h y.tab.o: h/lex.h y.tab.o: h/hash.h y.tab.o: h/back.h y.tab.o: h/parse.h y.tab.o: h/error.h y.tab.o: h/reserved.h SHAR_EOF fi # end of overwriting check if test -f 'expr.c' then echo shar: will not over-write existing file "'expr.c'" else cat << \SHAR_EOF > 'expr.c' static char rcsid[] = "$Header: expr.c,v 2.2 86/11/01 12:20:30 gil Exp $"; /* * $Log: expr.c,v $ * Revision 2.2 86/11/01 12:20:30 gil * added 'Zero()' for buffered channels of size zero (regular channels). * * Revision 2.1 86/10/30 16:06:04 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.2 86/03/19 15:26:56 gil * report variable name on errors. * * Revision 1.1 86/01/04 14:20:34 gil * Initial revision * */ #include #include "all.h" #define SameType(e1, e2) ((e1.e_flags&E_TYPE) == (e2.e_flags&E_TYPE)) #define ABS(x) ((x) > 0 ? (x) : -(x)) #define Null_tf(e) (e).e_false = NullQuadl; #define LastLabelIn(ql) (ql.q_quads[ql.q_nquads-1]) #define EMPTY_LABEL -1 #define EmptyLabel(l) ((l) == EMPTY_LABEL) static addr AnyAddr = { 0, 0, AD_GLOBAL, (addr_t) "UndefinedVar" }; extern addr NewTemp(); extern addr TimeCounter; Expr EmptyExpr() { Expr e; e.e_flags = EK_CONST:ET_INT; e.e_slen = NullAddr; e.e_false = NullQuadl; e.e_place = NullAddr; return e; } Expr Zero() { Expr e; e.e_flags = EK_CONST:ET_INT; e.e_slen = NullAddr; e.e_false = NullQuadl; e.e_place = Immediate(0); return e; } addr Eval(op, l1, l2) addr l1, l2; { register int v1 = (int)l1.d_offset, v2 = (int)l2.d_offset, v; switch (op) { case PLUS_TOK: #define ADD_OVF(a, b) ((a > 0 && MAXINT-a < b) :: (a < 0 && -MAXINT-a > b)) if(ADD_OVF(v1, v2)) { Error(ERROR, INTEGER_OVERFLOW); v = 0; break; } v = v1 + v2; break; case MINUS_TOK: #define SUB_OVF(a, b) ((a > 0 && MAXINT-a < -b) :: (a < 0 && -MAXINT-a > -b)) if(SUB_OVF(v2, v1)) { Error(ERROR, INTEGER_OVERFLOW); v = 0; break; } v = v2 - v1; break; #define MULT_OVF(a, b) (a != 0 && MAXINT/ABS(a) < ABS(b)) case MULT_TOK: if(MULT_OVF(v1, v2)) { Error(ERROR, INTEGER_OVERFLOW); v = 0; break; } v = v1 * v2; break; #define DIVISION_BY_ZERO(a, b) (b == 0) case DIV_TOK: if(DIVISION_BY_ZERO(v2, v1)) { Error(ERROR, DIV_BY_ZERO); v = 0; break; } v = v2 / v1; break; case OR_TOK: v = v1 : v2; break; case AND_TOK: v = v1 & v2; break; case XOR_TOK: v = v1 ^ v2; break; case LSHIFT_TOK: v = v1 << v2; break; case RSHIFT_TOK: v = v1 >> v2; break; /* Comparison operators */ case EQ_TOK: v = TRUE_VAL(v1 == v2); break; case GT_TOK: v = TRUE_VAL(v1 > v2); break; case GE_TOK: v = TRUE_VAL(v1 >= v2); break; case LT_TOK: v = TRUE_VAL(v1 < v2); break; case LE_TOK: v = TRUE_VAL(v1 <= v2); break; case NEQ_TOK: v = TRUE_VAL(v1 != v2); break; case AFTER: /* unsigned > comparison */ v = TRUE_VAL((unsigned int)v1 > (unsigned int)v2); break; /* Logical operators */ case AND: v = TRUE_VAL(CVAL(v1) && CVAL(v2)); break; case OR: v = TRUE_VAL(CVAL(v1) :: CVAL(v2)); break; default: panic("Bad operator in Eval"); } return Immediate(v); } Expr IntVal(lv) union lval lv; { Expr e; e = EmptyExpr(); e.e_flags = ET_INT:EK_CONST; e.e_place = Immediate(lv.lv_intval); return e; } Expr CharVal(lv) union lval lv; { Expr e; e = EmptyExpr(); e.e_flags = ET_CHAR:EK_CONST; e.e_place = Immediate(lv.lv_charval); return e; } Expr StrVal(s) char *s; { Expr e; e = EmptyExpr(); e.e_flags = ET_INTTAB:EK_CONST; e.e_place = NullAddr; e.e_place.d_flags = AF_LABEL; e.e_place.d_disp = AD_GLOBAL; e.e_place.d_offset = (addr_t)strsave(GenDefLabel(NewLabel())); GenDefStr(s); return e; } Expr Bool(tv) { Expr e; e = EmptyExpr(); e.e_flags = ET_BOOL:EK_CONST; e.e_place = Immediate(tv); return e; } Expr LocalClock() { Expr e; e.e_flags = EK_VAR:ET_INT; e.e_slen = NullAddr; e.e_false = NullQuadl; e.e_place = TimeCounter; return e; } Tconv(dtype) DType dtype; { switch (Type(dtype)) { case DINT: return ET_INT; case DCHAN: return ET_CHAN; case DCHAN_TAB: return ET_CHANTAB; case DINT_TAB: return ET_INTTAB; default: panic("Tconv: bad type"); /*NOTREACHED */ } } DType Etype(e) Expr e; { switch (e.e_flags&E_TYPE) { case ET_INT: return DINT; case ET_CHAN: return DCHAN; case ET_CHANTAB: return DCHAN_TAB; case ET_INTTAB: return DINT_TAB; default: panic("Etype: bad type"); /*NOTREACHED*/ } } Expr MonOp(op, e1) Expr e1; { Expr e; register v; #define MonOpOk(op, e) (((op == NOT && (e.e_flags&E_TYPE) == ET_BOOL)) :: \ (op == MINUS_TOK && (e.e_flags&E_TYPE) == ET_INT)) if(!MonOpOk(op, e1)) { Error(ERROR, OP_MISMATCH); return e1; } e = EmptyExpr(); e.e_flags = e1.e_flags & E_TYPE; if(IsConst(e1)) { switch (op) { case MINUS_TOK: v = -(e1.e_cval); break; case NOT: v = TRUE_VAL( !(CVAL(e1.e_cval)) ); break; default: panic("Bad monop"); /*NOTREACHED*/ } e.e_place = Immediate(v); e.e_flags := EK_CONST; return e; } e = EvalBool(e1); FreeExp(e1); e.e_place = NewTemp(); e.e_flags := EK_EXP; Gen(MON(op), Addr(e1), NullAddr, e.e_place); return e; } Expr Identifier(id) /* return an expression for identifier */ int id; { Expr e; struct decl *d; d = Hash[id].h_decl; e = EmptyExpr(); if (d == NULL) { Error(ERROR, UNDEF_VAR, Hash[id].h_name); e.e_place = AnyAddr; return e; } if (!IsIdent(d)) { Error(ERROR, IDENT_REQUIRED, Hash[id].h_name); e.e_place = AnyAddr; return e; } e.e_flags = Tconv(d->d_type); Null_tf(e); e.e_place = d->d_addr; if (IsDef(d)) e.e_flags := EK_CONST; else e.e_flags := EK_VAR; return e; } FreeExp(e) Expr e; { if (NullA(e.e_place)) return; if(IsTemp(e) :: (IsVar(e) && (e.e_place.d_flags & AF_SUB))) FreeTmp(e.e_place); if((e.e_flags&E_TYPE) == ET_SLICE) FreeTmp(e.e_slen); } #ifdef notdef addr Addr(e) Expr e; { return e.e_place; } #endif Expr EvalBool(e) Expr e; { Label true_l; if(IsConst(e) :: !NullA(e.e_place)) return e; /* if (!NullA(e.e_place)) { BackPatch(e.e_false); ???? return e; } */ e.e_place = NewTemp(); GenAssignConst(C_TRUE, e.e_place); true_l = NewLabel(); GenJmp(JMP, true_l); BackPatch(e.e_false); GenAssignConst(C_FALSE, e.e_place); GenLabel(true_l); Null_tf(e); return e; } Expr BinOp(op, e1, e2, type) Expr e1, e2; { Expr e; e = EmptyExpr(); e2 = EvalBool(e2); /* e1 already evaluated */ if(IsConst(e1) && IsConst(e2)) { e.e_place = Eval(op, e1.e_place, e2.e_place); e.e_flags = type : EK_CONST; return e; } FreeExp(e1); FreeExp(e2); e.e_place = NewTemp(); Gen(op, Addr(e1), Addr(e2), e.e_place); e.e_flags = type : EK_EXP; return e; } #define ArithOk(e1, e2) (((e1.e_flags & E_TYPE) == ET_INT) && \ ((e2.e_flags & E_TYPE) == ET_INT)) #define CmpOk(e1, e2) SameType(e1, e2) #define LLogOk(e) ((e.e_flags & E_TYPE) == ET_BOOL) #define RLogOk(e) LLogOk(e) Expr CmpOp(op, e1, e2) Expr e1, e2; { Expr e; e = EmptyExpr(); if(!CmpOk(e1, e2)) { Error(ERROR, TYPE_MISMATCH); return e1; } if(IsConst(e1) && IsConst(e2)) { e.e_place = Eval(op, e1.e_place, e2.e_place); e.e_flags = ET_BOOL : EK_CONST; return e; } FreeExp(e1); FreeExp(e2); e = EvalBool(e2); e.e_place = NewTemp(); GenCmp(op, Addr(e1), Addr(e2), e.e_place); e.e_flags = ET_BOOL : EK_EXP; return e; } Label Land(e1) Expr e1; { /* intermiediate: left hand side of e1 AND e2. return the 'false' address. */ Label false_l; /* check type for this operation */ if (!LLogOk(e1)) { Error(ERROR, TYPE_MISMATCH); return EMPTY_LABEL; } /* handle lhs constant */ if (IsConst(e1)) return EMPTY_LABEL; /* code generation for testing of lhs. : produce the jump to a 'false' label already here, : for the case lhs=false. */ false_l = NewLabel(); if (!NullA(e1.e_place)) { GenTst(Addr(e1)); FreeExp(e1); GenJmp(NEQ_TOK, false_l); /* now follows the code for 'e2' in 'Rand' */ } return false_l; } Expr Rand(e1, false_l, e2) Expr e1, e2; Label false_l; { /* right hand side of e1 and e2 */ Expr e; /* check types for this operator */ if (!RLogOk(e2)) { Error(ERROR, TYPE_MISMATCH); return e1; } /* handle constants (either both operands, or just one operand) */ if (IsConst(e1)) if (IsConst(e2)) { e2.e_place = Eval(AND, e1.e_place, e2.e_place); return e2; /* flags and all stay the same */ } else { if (!CVAL(e1.e_cval)) /* false AND e2 --> false */ return e1; /* else - true AND e2 --> e2, generate code */ } else if (IsConst(e2)) if (CVAL(e2.e_cval)) { /* e1 AND true --> e1 */ e.e_false = AddList(e1.e_false, false_l); goto ret; } else { /* e1 AND false --> false */ BackPatch(e1.e_false); /* here IS false.. */ GenLabel(false_l); return e2; } /* : Generate code for computing this operation, using flow control. : Assume that lhs of this 'and' is true "here" and false at 'ql'. */ e = EmptyExpr(); e.e_false = Merge(e1.e_false, e2.e_false); if (!EmptyLabel(false_l)) e.e_false = AddList(e.e_false, false_l); if (NullQ(e.e_false)) e.e_false = MakeList(NewLabel()); if (!NullA(e2.e_place)) { GenTst(Addr(e2)); FreeExp(e2); /* if got here, than 'e.e_false' cannot be empty */ GenJmp(NEQ_TOK, LastLabelIn(e.e_false)); /* "now", again, follow the true actions */ } ret: e.e_place = NullAddr; e.e_flags = ET_BOOL : EK_EXP; return e; } Label Lor(e1) Expr e1; { /* intermediate: left hand side of e1 OR e2. return the 'true' address. */ Label true_l; /* check type for this operation */ if (!LLogOk(e1)) { Error(ERROR, TYPE_MISMATCH); return EMPTY_LABEL; } /* handle constant lhs. */ if (IsConst(e1)) return EMPTY_LABEL; /* code generation for testing of lhs. : produce the jump to a 'true' label already here, : for the case lhs=true, and the whole expression is true. */ true_l = NewLabel(); if (!NullA(e1.e_place)) { GenTst(Addr(e1)); FreeExp(e1); GenJmp(EQ_TOK, true_l); } else /* here it is 'true', and the expression is true */ GenJmp(JMP, true_l); BackPatch(e1.e_false); /* now follows the code for 'e2' in 'Ror' */ return true_l; } Expr Ror(e1, true_l, e2) Expr e1, e2; Label true_l; { /* right hand side of e1 and e2 */ Label false_l; Expr e; /* check type for this operation */ if (!RLogOk(e2)) { Error(ERROR, TYPE_MISMATCH); return e1; } /* handle constant (either both, or just one) */ if (IsConst(e1)) if (IsConst(e2)) { e2.e_place = Eval(OR, e1.e_place, e2.e_place); return e2; /* flags and all stay the same */ } else { if (CVAL(e1.e_cval)) /* true OR e2 --> true */ return e1; /* else - false OR e2 --> e2, generate code */ } else if (IsConst(e2)) if (CVAL(e2.e_cval)) { /* e1 OR true --> true */ GenLabel(true_l); return e2; } else { /* e1 OR false --> e1 */ false_l = NewLabel(); e.e_false = AddList(e1.e_false, false_l); GenJmp(JMP, false_l); goto ret; } /* : Generate code for computing this operation, using flow control. : Assume that lhs of this 'or' is false "here" and true at 'true_l'. */ e = EmptyExpr(); e.e_false = e2.e_false; if (!NullA(e2.e_place)) { GenTst(Addr(e2)); FreeExp(e2); false_l = NewLabel(); e.e_false = AddList(e.e_false, false_l); GenJmp(NEQ_TOK, false_l); } ret: GenLabel(true_l); /* now follows the 'true' actions */ e.e_place = NullAddr; e.e_flags = ET_BOOL : EK_EXP; return e; } Expr ArithOp(op, e1, e2) Expr e1, e2; { if(!ArithOk(e1, e2)) { Error(ERROR, TYPE_MISMATCH); return e1; } return BinOp(op, e1, e2, ET_INT); } addr Lvalue(var) Expr var; { if(Etype(var) != DINT :: !IsVar(var)) { Error(ERROR, LVAL_REQ); return NullAddr; } if (IsReadOnly(var)) Error(WARNING, VALUE_PARAM_ASSIGN); return var.e_place; } Assign(lval, e) Expr lval, e; { addr dst; if((lval.e_flags & E_TYPE) == ET_SLICE) return AssignSlice(lval, e); dst = Lvalue(lval); if(NullA(dst)) return; Gen(MOVL, Addr(e), NullAddr, dst); FreeExp(lval, e); } AssignSlice(lval, e) Expr lval, e; { if((e.e_flags & E_TYPE) != ET_SLICE) Error(ERROR, SLICE_REQUIRED); if((e.e_place.d_flags & AF_BYTE) != (lval.e_place.d_flags&AF_BYTE)) Error(ERROR, DIFF_SLICES); GenBcopy(Addr(e), lval.e_place, e.e_slen); FreeExp(lval, e); } Expr CondExpr(e) Expr e; { Label false_l; if (NullA(e.e_place)) return e; GenTst(Addr(e)); false_l = NewLabel(); GenJmp(NEQ_TOK, false_l); e.e_false = MakeList(false_l); return e; } Expr Index(hv, e, isbyte) Expr e; { struct decl *d; Expr ne; d = Hash[hv].h_decl; if (d == NULL) { Error(ERROR, UNDEF_VAR, Hash[hv].h_name); return e; } ne = EmptyExpr(); if(Type(d->d_type) != DINT_TAB && Type(d->d_type) != DCHAN_TAB) { Error(ERROR, TABLE_REQUIRED); return ne; } if(Type(d->d_type) == DINT_TAB) ne.e_flags = ET_INT:EK_VAR; else ne.e_flags = ET_CHAN; if(isbyte) ne.e_place = GenByteSubscript(d->d_addr, Addr(e)); else ne.e_place = GenIntSubscript(d->d_addr, Addr(e)); return ne; } Expr IndexedVar(hv, e) Expr e; { return Index(hv, e, 0); } Expr ByteIndexedVar(hv, e) Expr e; { return Index(hv, e, 1); } SHAR_EOF fi # end of overwriting check if test -f 'extern.c' then echo shar: will not over-write existing file "'extern.c'" else cat << \SHAR_EOF > 'extern.c' static char rcsid[] = "$Header: extern.c,v 2.1 86/10/30 16:06:09 gil Exp $"; /* * $Log: extern.c,v $ * Revision 2.1 86/10/30 16:06:09 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:36 gil * Initial revision * */ #include /* define EXT here for the variables to be allocated main. */ #define EXT #include "all.h" /*#include "yacc_macros.h"*/ SHAR_EOF fi # end of overwriting check if test -f 'gen.c' then echo shar: will not over-write existing file "'gen.c'" else cat << \SHAR_EOF > 'gen.c' static char *rcsid = "$Header: gen.c,v 2.2 87/05/01 11:10:38 gil Exp $"; #include #include #include "all.h" #define codef stdout #ifdef vax #define DCONV(lvl) (((lvl)-(AD_GLOBAL+1))*INT_SIZE*2+INT_SIZE) #else tahoe /* on tahoe there is no ap */ #define DCONV(lvl) (((lvl)-AD_GLOBAL)*INT_SIZE) #endif /* This macro is used to tell Gen not to free temporary storage, since : operation is not yet finished */ #define DONT_FREE (1<<14) #define DontFree(op) ((op):DONT_FREE) #define PBYTE(isbyte) ((isbyte) ? 'b' : 'l') #define ADDR(a) a.d_disp, a.d_offset #define OFFT(a) a.d_offset #define Commute(a) (commute&(1<= DispLevel) { if(!IsByte(a) :: canbebyte :: a.d_disp == AD_REGISTER :: a.d_disp == AD_IMMED) return a; ra = NullAddr; /* resolve byte addresses */ ra.d_disp = AD_REGISTER; ra.d_offset = newreg(); pcode("\tmovzbl\t"); paddr(a); pcode(",r%d\n", ra.d_offset); return ra; } ra = a; ra.d_flags := AF_REG; ra.d_disp = newreg(); #ifdef vax if(a.d_flags & AF_AP) i = DCONV(a.d_disp)+INT_SIZE; else #endif i = DCONV(a.d_disp); #ifdef vax pcode("\tmovl\t-%d(r11),r%d\n", i, ra.d_disp); #else tahoe pcode("\tmovl\t-%d(r12),r%d\n", i, ra.d_disp); #endif if(!canbebyte && IsByte(a)) { pcode("movzbl\t"); paddrs(2, ra, Register(ra.d_disp)); ra = Register(ra.d_disp); } return ra; } /* : Generate a code for one instruction. : accepts quadruple code: [Instruction, Arg1, Arg2, Result]. : Inst(op) returns the instruction name, and puts the number of : of operands for this instruction in 'naddr'. : Further optimization is done when one of the arguments is the same is the : result; In VAX the same instruction could be performed on 2 or 3 arguments. : When addresses are not absolute or fp/ap relative, the should be computed : and the result is the instruction operand. This is done by 'gaddr'. */ Gen(op, a1, a2, res) addr a1, a2, res; { char *s; int byte = 0, free = 1; if(op & DONT_FREE) { free = 0; op &= ~DONT_FREE; } commute = 0xff; naddr = 3; func = NULL; s = Inst(op); if(func != NULL) if((*func)(op, &a1, &a2, &res)) return; if(naddr == 1) { a1 = gaddr(a1, 1); pcode("\t%s%c\t", s, PBYTE(IsByte(a1))); paddr(a1); pcode("\n"); endaddr(); return; } res = gaddr(res, 1); if(naddr == 2) { if(IsByte(a1)) byte = 1; a1 = gaddr(a1, byte); pcode("\t%s%c\t", s, PBYTE(byte)); paddr(a1), pcode(","); } else if(Commute(1) && SameAddr(a1, res)) { if(IsByte(a1)) byte = 1; a2 = gaddr(a2, byte); pcode("\t%s%c2\t", s, PBYTE(byte)); paddr(a2); pcode(","); } else if(Commute(2) && SameAddr(a2, res)) { if(IsByte(a2)) byte = 1; a1 = gaddr(a1, byte); pcode("\t%s%c2\t", s, PBYTE(byte)); paddr(a1); pcode(","); } else { if(IsByte(a1) && IsByte(a2)) byte = 1; a1 = gaddr(a1, byte); a2 = gaddr(a2, byte); pcode("\t%s%c3\t", s, PBYTE(byte)); paddr(a1); pcode(","); paddr(a2); pcode(","); } if((byte && IsByte(res)) :: (!byte && !IsByte(res))) paddr(res); else if(!byte && IsByte(res)) { int r; r = newreg(); pcode("r%d\n", r); pcode("\tcvtlb\tr%d,"); paddr(res); } else if(byte && !IsByte(res)) { int r; r = newreg(); pcode("r%d\n", r); pcode("\tcvtbl\tr%d,"); paddr(res); } pcode("\n"); if(free) endaddr(); } /* : Print an address. : Valid addressing modes: : 1. register relative. [register displacement, register displacement : deffered]. : 2. Absolute. (labels). : 3. Immediate. (constants). : 4. fp or ap relative. Arguments, Local variables, Temporaries. : Other addresses (Local variables/arguments) not of this Display level : should be resolved by gaddr. */ paddr(a) addr a; { if(a.d_flags & AF_REG) { if (a.d_flags & AF_AP) pcode("%s%d(r%d)", (a.d_flags&AF_PTR) ? "*" : "", a.d_offset, a.d_disp); else /* should ask about AF_PTR */ pcode("%d(r%d)", -a.d_offset, a.d_disp); goto indexed; } if(a.d_flags & AF_LABEL) { pcode("%s", (char *)a.d_offset); goto indexed; } if(a.d_disp == AD_GLOBAL && (a.d_flags & AF_FP) == 0) { pcode("_%s", (char *)a.d_offset); goto indexed; } if(a.d_disp == AD_IMMED) { pcode("$%d", a.d_offset); return; } if(a.d_disp == AD_REGISTER) { pcode("r%d", a.d_offset); goto indexed; } if(a.d_disp == DispLevel) { if (a.d_flags & AF_AP) #ifdef vax pcode("%s%d(ap)", #else tahoe pcode("%s%d(fp)", #endif (a.d_flags&AF_PTR) ? "*" : "", a.d_offset); else pcode("-%d(fp)", a.d_offset);/* should ask about : AF_PTR */ goto indexed; } panic("bad address!!"); indexed: if(a.d_flags & AF_SUB) pcode("[r%d]", a.d_reg); } paddrs(ac, av) int ac; addr av; { register addr *ap = &av; while(--ac > 0) { paddr(*ap); pcode(","); ap++; } paddr(*ap); pcode("\n"); } /* : GenGlobal: : Allocate space and declare global the declerand in 'd' of size 'size'. */ GenGlobal(d, size) struct decl *d; { Buffer obuf = ToBuf(DataBuf); pcode("\t.comm\t_%s,%d\n", d->d_addr.d_offset, size); ToBuf(obuf); } /* : GenLabelCall: : Call an internally created procedure, labeled (by the compiler) 'l'. */ GenLabelCall(l) Label l; { CountFlush(); #ifdef vax pcode("\tcalls\t$0,L%d\n", l); #else tahoe pcode("\tcallf\t$4,L%d\n", l); #endif } /* : GenFuncCall: : Generate a function call to 'fname' with 'nargs' arguments, putting : the returned value in 'result' (unless result == NullAddr). : 'DispLevel' is used for nested naming. */ GenFuncCall(nargs, fname, disp_level, result) addr nargs; char *fname; addr result; { register i; CountFlush(); nargs = gaddr(nargs, 0); #ifdef tahoe if(nargs.d_disp == AD_IMMED) { nargs.d_offset *= 4; nargs.d_offset += 4; } else { pcode(" mull2 $4,"); paddr(nargs); pcode("\n"); pcode(" addl2 $4,"); paddr(nargs); pcode("\n"); } if(nargs.d_disp == AD_IMMED) pcode("\tcallf\t"); else #endif pcode("\tcalls\t"); paddr(nargs); pcode(","); for(i = 1; i < disp_level;i++) pcode("_%s", ProcName[i]); pcode("_%s\n", fname); if(!NullA(result)) { pcode("\tmovl\tr0,"); paddr(result); pcode("\n"); } endaddr(); } /* : GenProc: : Declare the process name. : Provide a label for the mask-words (used registers + size of local data). */ GenProc(hv) { register struct hashent *hp = &Hash[hv]; int label, i; char *name; /* if(DispLevel == 1) pcode("\t.globl\t_%s\n", ProcName[1]); */ pcode("\t.globl\t"); for(i = 1; i <= DispLevel; i++) pcode("_%s", ProcName[i]); pcode("\n"); for(i = 1; i <= DispLevel; i++) pcode("_%s", ProcName[i]); pcode(":\n"); name = hp->h_name; hp->h_decl->d_masklabel = label = NewLabel(); GenStartProc(label); } /* : GenStartProc: : Generate the code at beginning of each function: : 1. mask word for used registers. : 2. decrement the stack-pointer by the size of local data. : 3. generate new display, while saving the old one. */ GenStartProc(masklabel) { Label l, l1; pcode("\t.word\tLM%d\n", masklabel); #ifndef NOGROW if(stack_reserve) { pcode("\tsubl3\t_StackBase,sp,r0\n"); pcode("\tsubl2\t_StackReserve,r0\n"); pcode("\tcmpl\tr0,$LF%d\n", masklabel); pcode("\tjgeq\tL%d\n", l = NewLabel()); pcode("\tpushl\tap\n\tpushl\t$LF%d\n\tpushal\tL%d\n", masklabel, l1 = NewLabel()); pcode("\tcalls\t$3,_StackExpand\n\tret\n"); GenLabel(l1); pcode("\t.word\t0x0\n"); GenLabel(l); } #endif #ifdef vax pcode("\tsubl2\t$LF%d,sp\n", masklabel); #else tahoe pcode("\tsubl3\t$LF%d,fp,sp\n", masklabel); #endif SaveDisp(); } /* : GenEndProc: : Generate the code at the end of each function: : 1. give (the now known) value to the mask-word and the local data size : word. : 2. restore the previous display. : 3. generate a 'return from function' instruction. */ GenEndProc(masklabel) { CountFlush(); RestoreDisp(); pcode("\t.set\tLM%d,0x%x\n", masklabel, MaxTemp); pcode("\t.set\tLF%d,%d\n", masklabel, Sp); #ifdef vax pcode("\tret\n"); #else tahoe pcode("\tret#2\n"); #endif } /* GenLabel: Generate the machines label computed from 'l'. */ GenLabel(l) Label l; { CountFlush(); pcode("L%d:\n", l); } /* : GenJmp: : Produce a jump instruction (conditional or not according to 'op'). */ GenJmp(op, l) Label l; { CountFlush(); pcode("\t%s\tL%d\n", Inst(op), l); } GenCmp(op, a1, a2, a) Op op; addr a1, a2, a; { Label false_l, true_l; int byte = 0; /* cmpl a1, a2 */ if(IsByte(a1) && IsByte(a2)) byte = 1; a1 = gaddr(a1, byte); a2 = gaddr(a2, byte); pcode("\tcmp%c\t", PBYTE(byte)); paddr(a1); pcode(","); paddr(a2); pcode("\n"); endaddr(); /* tst & jmp */ false_l = NewLabel(); pcode("\t%s\tL%d\n", Inst(op), false_l); /* true action */ GenAssignConst(1, a); /* skip over false action */ true_l = NewLabel(); GenJmp(JMP, true_l); /* false action */ GenLabel(false_l); GenAssignConst(0, a); GenLabel(true_l); endaddr(); } GenAssignConst(c, a) addr a; { pcode("\tmov%c\t$%d,", PBYTE(IsByte(a)), c); a = gaddr(a, 1); paddr(a); pcode("\n"); endaddr(); } GenTst(a) addr a; { int byte; byte = IsByte(a); a = gaddr(a, byte); pcode("\ttst%c\t", PBYTE(byte)); paddr(a); pcode("\n"); endaddr(); } /* * The display is pointed by r11, each display entry contains the pair (ap, : fp). so the offset for display N's ap is -N*4(r11), (the fp is -N*4+4(r11)) */ SaveDisp() { #ifdef vax register int i = DCONV((DispLevel + 1)) + INT_SIZE; pcode("\tmovq\t-%d(r11),-8(fp)\n", i); /* ap */ /* pcode("\tmovl\t-%d(r11),-8(fp)\n", i); /* fp */ pcode("\tmovq\tap,-%d(r11)\n", i); /* pcode("\tmovl\tfp,-%d(r11)\n", i); */ #else tahoe register int i = DCONV((DispLevel + 1)); pcode("\tmovl\t-%d(r12),-56(fp)\n", i); pcode("\tmovl\tfp,-%d(r12)\n", i); #endif } RestoreDisp() { #ifdef vax register i = DCONV(DispLevel) + INT_SIZE; pcode("\tmovq\t-8(fp),-%d(r11)\n", i); /* ap */ /* pcode("\tmovl\t-12(fp),-%d(r11)\n", i); /* fp */ #else tahoe register i = DCONV(DispLevel); pcode("\tmovl\t-56(fp),-%d(r12)\n", i); #endif } static addr extra; long regs; newreg() { register int i = 0; if(regs & 1) if(regs & 2) { extra = NewTemp(); if(extra.d_disp != AD_REGISTER) panic("can't get register"); i = extra.d_offset; regs := 4; } else i = 1; regs := reg(i); return i; } endaddr() { if(regs & 4) FreeTmp(extra); regs = 0; } /* : Generate stack-push code. : If type == 1 push address, otherwise push value. : When a byte value is pushed, it should be converted to a long. */ GenPush(type, a) addr a; { int byte; a = gaddr(a, type); byte = IsByte(a); pcode("\tpush%s%c\t", (type == 0) ? "" : "a", PBYTE(byte)); paddr(a); pcode("\n"); endaddr(); } /* GenPushr: : Save the registers in 'mask' on the stack. */ GenPushr(mask) { #ifdef vax pcode("\tpushr\t$%d\n", mask); #else tahoe register i, c; for(i = 0, c = 0; i < 16; i++) if(mask&(1<= CounterResolution) CountFlush(); } CountFlush() { if(!counting :: Counter == 0) return; if(Counter == 1) { GenInc(TimeCounter); GenInc(GlobalCounter); } else { Gen(PLUS_TOK, Immediate(Counter), TimeCounter, TimeCounter); Gen(PLUS_TOK, Immediate(Counter), GlobalCounter, GlobalCounter); } Counter = 0; } GenCallSelect(n) addr n; { Label l, loop, lout; GenFuncCall(n, "chselect", 0, NullAddr); #ifdef vax pcode("\tmovl\tsp,r1\n"); /* save sp */ pcode("\tmoval\t4(r0),sp\n"); /* set sp */ pcode("\tpopr\t(r0)\n"); /* pop saved registers */ pcode("\tmovl\t(sp)+,r0\n"); GenLabel(loop = NewLabel()); pcode("\tsobgeq\tr0,L%d\n", l = NewLabel()); pcode("\tjbr\tL%d\n", lout = NewLabel()); GenLabel(l); pcode("\tmovl\t4(sp),*(sp)\n"); /* pop one pair */ pcode("\taddl2\t$8,sp\n"); /* increment sp */ GenJmp(JMP, loop); GenLabel(lout); pcode("\tmovl\t(sp)+,r0\n"); pcode("\tmovl\tr1,sp\n"); pcode("\tjmp\t(r0)\n"); #else tahoe /* pcode(" moval 4(r0),r0\n"); /* get the beginning of the saved data : area (nregister) */ /* pcode(" addl2 $8,r0\n"); */ pcode(" movl (r0),r1\n"); /* skip saved registers area */ pcode(" moval (r0)[r1],r1\n"); pcode(" addl2 $4,r1\n"); pcode(" movl 4(r0),r0\n"); pcode(" loadr r0,(r1)\n"); /* pop registers */ pcode(" addl2 $4,r1\n"); pcode(" movl (r1),r0\n"); /* get count of pairs */ pcode(" addl2 $4, r1\n"); /* skip registers */ GenLabel(loop = NewLabel()); /* address fetching loop */ pcode(" tstl r0\n"); pcode(" beql L%d\n", lout = NewLabel()); pcode(" movl 4(r1),*(r1)\n"); /* pop next pair */ pcode(" addl2 $8,r1\n"); pcode(" decl r0\n"); pcode(" jbr L%d\n", loop); GenLabel(lout); /* pcode(" movl (sp)+,_ANY\n"); /* increment sp by 4 */ pcode(" jmp *(r1)\n"); #endif } SHAR_EOF fi # end of overwriting check if test -f 'hash.c' then echo shar: will not over-write existing file "'hash.c'" else cat << \SHAR_EOF > 'hash.c' static char rcsid[] = "$Header: hash.c,v 2.1 86/10/30 16:07:32 gil Exp $"; /* * $Log: hash.c,v $ * Revision 2.1 86/10/30 16:07:32 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:37 gil * Initial revision * */ /* : Hash functions- : Use two functions : : The first is straight forward. In case of collision, the second function : is used. The second function uses the first function's value as skip-value, : to obtain uniform distribution. */ #include #include "hash.h" #define ALMOST_MAXINT 21474836 char *strsave(); hash(str) char *str; { /* : Sum ascii values (minus '0') of the string characters, multiplied : by 13. the the value modulo HASHSZ. */ register val = 0; register char *s = str; while(*s) { val += (*s++ - '0') * 13; if (val > ALMOST_MAXINT) val >>= 4; } val %= HASHSZ; if(Hash[val].h_name && strcmp(str, Hash[val].h_name) != 0) /* collision */ return hash2(str, val); return val; } hash2(str, oldval) char *str; int oldval; { /* : Calculate a "decimal" value of 'str', and take it modulo 'oldval' : which is known to be < HASHSZ. : in case of collision - start skipping, with 'oldval' skip-size. */ register char *s = str, c; register val = 0; register i; while(c = *s++) { val *= 10; val += c - '0'; if (val > ALMOST_MAXINT) val = oldval; } val %= oldval; i = val; while(Hash[val].h_name && strcmp(Hash[val].h_name, str)) { val += oldval; val %= HASHSZ; if(i == val) /* hash table is full */ return -1; } return val; } SHAR_EOF fi # end of overwriting check if test -f 'init.c' then echo shar: will not over-write existing file "'init.c'" else cat << \SHAR_EOF > 'init.c' static char rcsid[] = "$Header: init.c,v 2.3 86/11/03 13:49:54 gil Exp $"; /* * $Log: init.c,v $ * Revision 2.3 86/11/03 13:49:54 gil * support for VMS and special INPUT/OUTPUT channels are 'ifdef'ed. * * Revision 2.2 86/11/01 12:21:01 gil * * * Revision 2.1 86/10/30 16:07:34 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:38 gil * Initial revision * */ #include #include "all.h" struct Init { char *name; DType type; } InitTab[]= { "TIME", DCHAN, "INPUT", DCHAN, "OUTPUT", DCHAN, "ANY", DINT, NULL, UNDEF }; InitSymb() { register struct Init *ip; register hv; for(ip = InitTab; ip->name != NULL; ip++) { hv = hash(ip->name); insert(hv, ip->name); if (ip == InitTab) { /* first is time channel */ DeclTimeChan(hv); continue; } switch (Type(ip->type)) { case DCHAN: DeclChan(hv, Zero()); break; case DINT: DeclVar(hv); break; default: panic("Bad initializer"); /*NOTREACHED*/ } } } SHAR_EOF fi # end of overwriting check if test -f 'io.c' then echo shar: will not over-write existing file "'io.c'" else cat << \SHAR_EOF > 'io.c' static char *rcsid = "$Header: io.c,v 2.2 86/11/01 12:21:10 gil Exp $"; #include #include "all.h" #define IOVLEN 2 #define bit(i) (1 << (i)) static int IoNaddr = 0; /* no. of i/o requests in list. */ static Buffer SavedBuf; static int IoNsave; /* no. of alt saved data */ Io(chan, rw) Expr chan; { if(Etype(chan) != DCHAN) { Error(ERROR, CHANNEL_REQ); return; } (void) GenPush(0, chan.e_place); GenFuncCall(Immediate((IoNaddr*IOVLEN)+3), rw ? "chwrite" : "chread", 1, NullAddr); } Wait(e) Expr e; { if(!IsVar(e) :: IsReg(e.e_place)) GenPush(1, GenSave(Addr(e))); else GenPush(1, e.e_place); GenPush(0, Immediate(INT_SIZE)); IoNaddr++; } Expr TimeChan(e) Expr e; { int hv; hv = hash("TIME"); return(Identifier(hv)); } /* StartPushArgs: : Start pushing the list of variables in this io-request; : Use "small" reversible buffers for the arguments (same as process : arguments, see proc.c). */ StartPushArgs() { SavedBuf = CurBuf; Sbuf(); IoNaddr = 0; } /* EndPushArgs: : End pushing the arguments for this io request: reverse their order and : push their count, and the flag 'flag'. */ EndPushArgs(flag) { RevBuf(IoNaddr, SavedBuf); (void) GenPush(0, Immediate(IoNaddr)); (void) GenPush(0, Immediate(flag)); } /* PushOutputArg: : Push address of output-argument; save on the stack and push the address : in case of constant. */ PushOutputArg(e) Expr e; { if(IsSlice(e)) { (void) GenPush(1, e.e_place); (void) GenPush(0, e.e_slen); } else { if(!IsVar(e) :: IsReg(e.e_place)) GenPush(1, GenSave(Addr(e))); else GenPush(1, e.e_place); GenPush(0, Immediate(INT_SIZE)); } IoNaddr++; } /* PushInputArg: : Push address of input-argument; 'e' must contain an addressable variable : or a slice. */ PushInputArg(e) Expr e; { if(IsSlice(e)) { GenPush(1, e.e_place); GenPush(0, e.e_slen); } else { GenPush(1, Lvalue(e)); GenPush(0, Immediate(INT_SIZE)); } IoNaddr++; } AllocChan(ad, siz) addr ad; addr siz; { GenPush(0, siz); GenFuncCall(Immediate(1), "chopen", 1, ad); } AllocChanTable(d, siz) struct decl *d; addr siz; { GenPush(0, Immediate(d->d_nel)); GenPush(0, siz); GenPush(1, d->d_addr); GenFuncCall(Immediate(3), "chtabopen", 1, NullAddr); } DisposeChanTab(d) struct decl *d; { GenPush(0, Immediate(d->d_nel)); GenPush(1, d->d_addr); GenFuncCall(Immediate(2), "chtabclose", 1, NullAddr); } DisposeChan(ad) addr ad; { GenPush(0, ad); GenFuncCall(Immediate(1), "chclose", 1, NullAddr); } Alt CurA; struct alt_buf { Alt cur; struct alt_buf *next; } alt_stack; StartAltCmd() { Label l; struct alt_buf *this = (struct alt_buf *) malloc(sizeof (struct alt_buf)); /* - push this alt process (structure) on the alt_stack. */ this->next = alt_stack.next; alt_stack.next = this; /* - allocate new paramters' counters. */ CurA.a_argcnt = NewCounter(); CurA.a_pushcnt = NewCounter(); /* - allocate new buffers for nice flow. flow buf is used hence. */ CurA.a_flowbuf = CurBuf; CurA.a_textbuf = NewBuf(); /* buffer for the processes' code */ ToBuf(CurA.a_flowbuf); /* - allocate a label for end of alt process. */ CurA.a_out = NewLabel(); /* - initialize */ CurA.a_nsave = 0; } EndAltCmd() { struct alt_buf *this; this = alt_stack.next; /* - AltSelect will handle the call and return of the selecting procedure. */ AltSelect(); /* - concatanate the flow & text buffers in their order. */ MergeBufs(CurA.a_flowbuf, CurA.a_textbuf); /* now we after all the pushes */ /* - produce the ending label. */ GenLabel(CurA.a_out); /* - Free the alternate process' data (counters, etc.). */ /* - Pop the alternate process from the stack. */ alt_stack.next = this->next; free(this); } /* StartAlt: : Start a new nested alt; : add the new alt counter 'cnt' to the list of saved data. */ StartAlt(cnt) addr cnt; { CurA.a_save[CurA.a_nsave++] = cnt; } EndAlt() { CurA.a_nsave--; } /* StartAltIo: : Push all the ephemeral data of this process; : The select process will return a pointer to a record, pushed here, : containing: : record length : register mask : saved registers : count of pairs : list of pairs (saved_value, address) : process-label */ StartAltIo(proc_l) Label proc_l; { register i; int mask; int Npair; int nreg; /* - push the alt-process saved data record */ GenPushLabel(proc_l); Npair = 0; IoNsave = 0; for (i = 0; i < CurA.a_nsave; i++) if (!IsReg(CurA.a_save[i])) { GenPush(0, CurA.a_save[i]); /* the current value */ GenPush(1, CurA.a_save[i]); /* the address */ Npair++; } IoNsave = 2 * Npair; GenPush(0, Immediate(Npair)); mask = 0; for(i = 0, nreg = 0; i < CurA.a_nsave; i++) if (IsReg(CurA.a_save[i])) { mask := bit(CurA.a_save[i].d_offset); IoNsave++; nreg++; } if (mask) GenPushr(mask); GenPush(0, Immediate(mask)); #ifdef tahoe GenPush(0, Immediate(nreg)); IoNsave++; #endif IoNsave += 3; /* the mask + the pair count + proc label */ } /* EndAltIo: : End an io request in an alternate process: : the global request and argument counters are incremented. : The last argument are pushed. */ EndAltIo(chan) Expr chan; { register i; int mask; register cnt; /* count of saved data */ /* - increment the counters */ /* IncArgCounter(CurA.a_pushcnt, IoNaddr * 2 + 3 + IoNsave); */ IncArgCounter(CurA.a_pushcnt, IoNaddr * 2 + 4 + IoNsave); GenInc(CurA.a_argcnt); /* - push the the saved data size & the channel id */ GenPush(0, Immediate(IoNsave)); GenPush(0, Addr(chan)); } AltSelect() { addr a; /* - push the last parameters (arg count, etc.) on the stack. */ /* - generate the call to the alternate-process handler ('chselect'). */ GenInc(CurA.a_pushcnt); /* another argument: the request count */ GenPush(0, CurA.a_argcnt); GenCallSelect(CurA.a_pushcnt); /* - 'GenCallSelect' already generates the code for starting the selected * process (restore its saved data and jump to its beginning). */ } EndReplAlt(out, r) Quadl out; Repl r; { EndAlt(); BackPatch(out); GenJmp(JMP, r.r_loop); FreeRepl(r); } /* StartGuardP: : Start a process following a guard; : The process' code will be put on a different buffer 'a_textbuf' for : nice flow. The alt's counters can be freed for the process */ StartGuardP(l) Label l; { (void) ToBuf(CurA.a_textbuf); GenLabel(l); /* - free the alt counters. */ } EndGuardP() { GenJmp(JMP, CurA.a_out); (void) ToBuf(CurA.a_flowbuf); /* - recapture the alt counters. */ } addr NewCounter() { addr cntr; cntr = NewTemp(); GenAssignConst(0, cntr); return cntr; } IncArgCounter(cntr, count) addr cntr; { Gen(PLUS_TOK, cntr, Immediate(count), cntr); } SHAR_EOF fi # end of overwriting check if test -f 'lex.c' then echo shar: will not over-write existing file "'lex.c'" else cat << \SHAR_EOF > 'lex.c' static char rcsid[] = "$Header: lex.c,v 2.1 86/10/30 16:07:38 gil Exp $"; /* * $Log: lex.c,v $ * Revision 2.1 86/10/30 16:07:38 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:40 gil * Initial revision * */ #include #include #include "all.h" char *malloc(); extern int yyleng; stoi(str, val, rad) register char *str; int *val; { /* : Convert string to positive integer, and return the value in '*val'; : Return -1 if overflow occured, 0 else. */ register maxdivrad = MAXINT/rad; /* save in register for efficiency */ register v=0; #define VAL(c) (isdigit(*str) ? *str - '0' : \ (isupper(*str) ? *str - 'A' + 10 : *str - 'a' + 10)) while(*str) { if(v > maxdivrad :: (v == maxdivrad && (MAXINT - maxdivrad*rad) < VAL(*str))) return -1;/* overflow */ v *= rad; v += VAL(*str); str++; } *val = v; return(0); #undef VAL } char * strval(s) char *s; { /* return a pointer to a saved & expanded string representing 's'. : doesn't alter 's'. */ register char *p; int l; l = yyleng - 2; p = malloc(l+2); /* +2 for: 1. null char : 2. first byte saves the length. */ strncpy(p+1, s+1, l); /* don't save the wrapping '"'s. */ l = expand(p+1); /* expand NEVER makes the string longer. */ *p = l; p[l+1] = '\0'; return p; } charval(s) char *s; { /* return the character value of the quoted char in 's'. : doesn't alter 's'. */ char buf[64]; s[yyleng] = '\0'; /* PATCH */ strcpy(buf, s+1); /* first character is 'quote'. */ expand(buf); return(buf[0]); } expand(s) char *s; { register char *p, *q; register i; int j; int sum; for(p = q = s, i = 0; *p; p++, q++, i++) { switch(*p) { case '*': switch(*++p) { case 'c': case 'C': *q = '\r'; break; case 'n': case 'N': *q = '\n'; break; case 't': case 'T': *q = '\t'; break; case 's': case 'S': *q = ' '; break; case '#': /* hexadecimal specification of the char */ #define HEXVAL(c) (isupper(c) ? c - 'A' + 10 : c - 'a' + 10) p++; sum = HEXVAL(*p); if (isxdigit(*++p)) { sum *= 16; sum += HEXVAL(*p); } else p--; *q = sum; break; #undef HEXVAL default: if (*p != '\'' && *p != '"' && *p != '*') LexError(WARNING, NO_SPECIAL_MEANING); *q = *p; } break; case '\\': switch(*++p) { case 'n': *q = '\n'; break; case 'r': *q = '\r'; break; case 't': *q = '\t'; break; case 'f': *q = '\f'; break; case 'v': *q = '\013'; break; case 'b': *q = '\b'; break; default: if (*p >= '0' && *p <= '7') { #define OCTVAL(c) (c - '0') sum = 0; j = 0; do { sum *= 8; sum += OCTVAL(*p); p++; } while(j++ < 3 && *p >= '0' && *p <= '7'); p--; *q = sum; #undef OCTVAL } else *q = *p; break; } break; default: *q = *p; break; } } return i; } SHAR_EOF fi # end of overwriting check if test -f 'print.c' then echo shar: will not over-write existing file "'print.c'" else cat << \SHAR_EOF > 'print.c' static char *rcsid = "$Header: print.c,v 2.1 86/10/30 16:07:45 gil Exp $"; /* * $Log: print.c,v $ * Revision 2.1 86/10/30 16:07:45 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.2 86/02/08 12:14:43 gil * bug-fixed. * * Revision 1.1 86/01/04 14:21:20 gil * Initial revision * * Revision 1.1 85/12/08 10:33:24 dalia * Initial revision * */ #include #define EXT #include "error.h" /* : Printout code-lines + error messages. : All words + error messages of one line are accomulated. : When end-of-line is reached printing is done. : : This also enables the enhanced error-handling routine to inspect the : whole line when error is encountered.(not implemented yet) */ /* routines for printing of the input text. */ #define LINSIZ 512 extern char yytext[]; extern int yyleng; extern int CurIndent; extern int lines; extern listing; extern FILE *lsp; extern char *inf; static char buf[LINSIZ+1]; static int highs = 0; static int slines = 1; blanks(s, n) register char *s; register int n; { while(n-- > 0) *s++ = ' '; } printout() { if (!listing) { outerrs(); return; } if (highs == 0) { /* beginning of line - print indentation */ highs += 2 * CurIndent; blanks(buf, highs); } if (highs + yyleng > LINSIZ) panic("str_alloc: line too long"); strncpy(&buf[highs], yytext, yyleng); highs += yyleng; if (lines > slines) outline(); } outline() { if (!listing) goto out; fprintf(lsp, "%-4d ", slines); if (buf[highs-1] != '\n') buf[highs++] = '\n'; buf[highs] = '\0'; fputs(buf, lsp); slines = lines; highs = 0; out: outerrs(); } /* routines for priting error messages */ #define MAX_ERRORS 16 /* maximum errors per line! */ static struct error { int e_ind; /* index of error in error-messages table */ int e_col; /* for lexical errors: position in line (to : be pointed to). default is zero (no pointer). */ int e_arg[4]; } errs[MAX_ERRORS]; static int nerrs = 0; Error(type, num, a1, a2, a3, a4) { /* syntactical or semantical errors; no pointer. */ err(num, a1, a2, a3, a4); errs[nerrs].e_col = 0; nerrs++; } LexError(type, num, offset) { /* token errors; produce column pointer to 'offset' within current token. */ err(type, num); errs[nerrs].e_col = highs + offset - 1; nerrs++; } err(num, a0, a1, a2, a3) { enum err_type type = Err_list[num].type; if (nerrs >= MAX_ERRORS-2) { errs[MAX_ERRORS-1].e_ind = TOO_MANY_ERRORS; errs[MAX_ERRORS-1].e_col = 0; return; } if (type == COMPILER_ERROR) panic(Err_list[num].str); errs[nerrs].e_ind = num; errs[nerrs].e_arg[0] = a0; errs[nerrs].e_arg[1] = a1; errs[nerrs].e_arg[2] = a2; errs[nerrs].e_arg[3] = a3; } outerrs() { register i, j; char temp[512]; register c; register struct error *ep; if (nerrs == 0) return; c = 0; for (i = 0; i < nerrs; i++) { ep = &errs[i]; fprintf(stderr, "\"%s\", line %d: ", inf, lines-1); switch(Err_list[ep->e_ind].type) { case WARNING: temp[c++] = 'W'; fprintf(stderr, "Warning - "); break; case RECOVER: temp[c++] = 'e'; fprintf(stderr, "error - "); break; case ERROR: temp[c++] = 'E'; fprintf(stderr, "Error - "); break; default: panic("outerrs: unknown error type"); } /* number of minus'es: e_col - column of error : -1 - the 'C' at the beginning : +7 - the '# n ' of the line printout. : i.e: e_col + 6 : --------- */ if (ep->e_col != 0) { for (j = ep->e_col + 6; j > 0; j--) temp[c++] = '-'; temp[c++] = '^'; temp[c++] = '-'; } temp[c++] = '\0'; if (listing) { fprintf(lsp, "%s ", temp); fprintf(lsp, Err_list[ep->e_ind].str, ep->e_arg[0], ep->e_arg[1], ep->e_arg[2], ep->e_arg[3]); putc('\n', lsp); } fprintf(stderr, Err_list[ep->e_ind].str, ep->e_arg[0], ep->e_arg[1], ep->e_arg[2], ep->e_arg[3]); putc('\n', stderr); } nerrs = 0; } panic(s) char *s; { outline(); fprintf(stderr, "\nCompiler error: %s\n", s); _cleanup(); abort(); exit(1); } FlushErrs() { if(nerrs > 0) { lines++; outline(); } } SHAR_EOF fi # end of overwriting check if test -f 'main.c' then echo shar: will not over-write existing file "'main.c'" else cat << \SHAR_EOF > 'main.c' static char rcsid[] = "$Header: main.c,v 2.1 86/10/30 16:07:40 gil Exp $"; /* * $Log: main.c,v $ * Revision 2.1 86/10/30 16:07:40 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:41 gil * Initial revision * */ #include /* define EXT here for the variables to be allocated main. */ #define EXT #include "all.h" #define USAGE fprintf(stderr, "Usage: ocp [-d] [ inf [ outf ] ]\n") extern lines; char *strcpy(); char *inf = ""; char *outf = ""; static FILE *out; int listing = 0, /* produce program listing */ counting = 1; /* generate code for commands counting */ extern stack_reserve; /* if >= 0 generate code for automatic stack : growth */ FILE *lsp; /* listing file file-pointer */ FILE *listfile(); main(ac, av) char **av; { int i; extern yydebug; char *c; av++; ac--; while(**av == '-') { c = *av; while(*++c) switch (*c) { case 'd': yydebug++; break; case 'L': listing++; break; case 'C': counting = 0; break; case 'T': stack_reserve = 0; break; default: USAGE; exit(1); } av++; ac--; } if(ac > 2) { USAGE; exit(1); } if(ac > 0) { inf = *av; if(freopen(inf, "r", stdin) == NULL) { fprintf(stderr, "Cannot read "); perror(inf); exit(1); } ac--; av++; if (listing) lsp = listfile(inf); } else if (listing) lsp = stdout; if(ac > 0) { outf = *av; if(freopen(outf, "w", stdout) == NULL) { fprintf(stderr, "Cannot write "); perror(outf); exit(1); } ac--; av++; } /* : Insert two dummy blanks at the beginning of each line for easy : handling of indentation. : The problem is as follows: : The lexical analyser is supposed to give 'output' (tokens) even when no : input is present; this is the case when a line starting with no blanks is : encountered and 'LEFT_TOK' tokens are to be detected. : The easy way to deal with the above problem is to use two dummy blanks : at the beginning of each line (= one indent token), and to decrement the : indent level of each line by one. Thus, blanks will be encountered at EACH : new line, and the indentation offset can be calculated. : The first two blanks are pushed in main(), before the first call to yylex(). */ yyunput(' '); yyunput(' '); InitCode(); ResetTmp(); InitSymb(); lines = 1; if (i = yyparse()) { putchar('\n'); outline(); fprintf(stderr, "\"%s\", line %d: Parse failed\n", inf, lines); } else { FlushErrs(); EndCode(); FlushAll(); } exit(i); } char * strsave(s) char *s; { /* allocate memory for 's' and save it. return the saved string. */ return strcpy(malloc(strlen(s)+1), s); } get_token() { int i; /* : Get_token : does some pre-processing before the token returned from : 'yylex' is passed on to the parser. : ???? */ i = yylex(); if (i && i != LEFT_TOK && i != RIGHT_TOK) printout(); return i; } FILE * listfile(fname) char *fname; { register char *p; char *rindex(); char lstname[128]; FILE *fp; if ((p = rindex(fname, '.')) == NULL) goto lstdout; strncpy(lstname, fname, p-fname); strcpy(&lstname[p-fname], ".lst"); if ((fp = fopen(lstname, "w")) == NULL) { perror(lstname); goto lstdout; } return fp; lstdout: fprintf(stderr, "%s: listing is done on stdout\n", inf); return stdout; } SHAR_EOF fi # end of overwriting check if test -f 'newbuf.c' then echo shar: will not over-write existing file "'newbuf.c'" else cat << \SHAR_EOF > 'newbuf.c' static char rcsid[] = "$Header: newbuf.c,v 2.1 86/10/30 16:07:42 gil Exp $"; /* * $Log: newbuf.c,v $ * Revision 2.1 86/10/30 16:07:42 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:42 gil * Initial revision * */ #include #include "all.h" #define codefd 1 #define NBUF 256 #define GROW_SIZE 512 Buffer CurBuf; extern char *malloc(), *realloc(); struct buf { int b_size; int b_used; char *b_data; } bufs[NBUF], *cur = bufs; Buffer highb = 0; Buffer ToBuf(i) { int obuf = CurBuf; cur = &bufs[i]; CurBuf = i; return obuf; } Buffer NewBuf() { ToBuf(highb++); cur->b_used = cur->b_size = 0; return highb - 1; } pcode(fmt, a1, a2, a3, a4, a5, a6, a7, a8) char *fmt; { char line[256]; int l; sprintf(line, fmt, a1, a2, a3, a4, a5, a6, a7, a8); l = strlen(line); asize(l); bcopy(line, &((cur->b_data)[cur->b_used]), l); cur->b_used += l; } static asize(l) { #define round(s, to) ((s+to-1)&~(to-1)) if(cur->b_used + l > cur->b_size) { cur->b_size = round(cur->b_used + l, GROW_SIZE); if(cur->b_data) cur->b_data = realloc( cur->b_data, cur->b_size); else cur->b_data = malloc(cur->b_size); } } FlushB(i) Buffer i; { register struct buf *b = &bufs[i]; write(codefd, b->b_data, b->b_used); } FlushAll() { int i; fflush(stdout); for(i = 0; i < highb; i++) if (NoMain && i == MainText) continue; else FlushB(i); } Buffer Sbuf() { return NewBuf(); } RevBuf(n, old) unsigned n; Buffer old; { int i, sz; struct buf *b = cur; if(n == 0) return; if(n > highb) panic("reverse too much"); highb -= n; for(i = 0, sz = 0; i < n; i++, b--) sz += b->b_used; b = cur; cur = &bufs[old]; asize(sz); sz = cur->b_used; for(i = 0; i < n; i++, b--) { bcopy(b->b_data, cur->b_data+sz, b->b_used); sz += b->b_used; free(b->b_data); b->b_data = NULL; b->b_size = b->b_used = 0; } cur->b_used = sz; CurBuf = old; } MergeBufs(b1, b2) Buffer b1, b2; { struct buf *bp1, *bp2; bp1 = &bufs[b1]; bp2 = &bufs[b2]; asize(bp2->b_used); bcopy(bp2->b_data, &((bp1->b_data)[bp1->b_used]), bp2->b_used); bp1->b_used += bp2->b_used; bp2->b_used = 0; } SHAR_EOF fi # end of overwriting check if test -f 'occam.lex' then echo shar: will not over-write existing file "'occam.lex'" else cat << \SHAR_EOF > 'occam.lex' blnks [\ \t] alpha [a-zA-Z] digit [0-9] hexdigit [0-9a-fA-F] newline {blnks}*((#({blnks}.*)?):("--".*))?\n %{ static char *rcsid = "$Header: occam.lex,v 2.1 86/10/30 16:09:08 gil Exp $"; #include #include "all.h" #define ret(token, type) {\ lastop = 0;\ if(type == reserved :: type == noval)\ return (yylval.Op = token);\ else if(type == operator) {\ lastop = 1;\ return (yylval.Op = token);\ }\ else return (token);\ } #define ERRORVAL() { \ yylval.v_intval = -1; \ lastop = 0;\ break;\ } char *strcpy(), *malloc(); static int lastop = 0, newline = 0; %} %% %{ /* : Deal with indentation. : Inserted at the beginning of yylex; this is done to : avoid using states, with is inefficient. */ if (newline) { newline = 0; strcpy(yytext, "\n"); goto newl; } if (CurIndent < PrevIndent) { PrevIndent--; ret (LEFT_TOK, noval); } if (CurIndent > PrevIndent) { PrevIndent++; ret (RIGHT_TOK, noval); } %} %{ /* reserved words - defined first to be prior identifiers */ %} %{ /* operators and special signs */ %} "*" { ret (MULT_TOK, operator); } "/" { ret (DIV_TOK, operator); } "+" { ret (PLUS_TOK, operator); } "-" { ret (MINUS_TOK, operator); } "=" { ret (EQ_TOK, noval); } ">" { ret (GT_TOK, operator); } ">=" { ret (GE_TOK, operator); } "<" { ret (LT_TOK, operator); } "<=" { ret (LE_TOK, operator); } "<>" { ret (NEQ_TOK, operator); } "," { ret (COMA_TOK, operator); } "&" { ret (COND_TOK, operator); } "<<" { ret (LSHIFT_TOK, operator); } ">>" { ret (RSHIFT_TOK, operator); } "><" { ret (XOR_TOK, operator); } "/\\" { ret (AND_TOK, operator); } "\\/" { ret (OR_TOK, operator); } "[" { ret (LBR_TOK, operator); } "]" { ret (RBR_TOK, noval); } "(" { ret (LP_TOK, operator); } ")" { ret (RP_TOK, noval); } "\\" { ret (MOD_TOK, operator); } "!" { ret (FCHAN_TOK, operator); } "?" { ret (INP_TOK, operator); } ";" { ret (SEMICOLON_TOK, operator); } ":=" { ret (ASSIGN_TOK, operator); } ":" { printout(); break; } {digit}+ { /* integer - allowing integer starting with 0 (e.g. 003). */ if (stoi(yytext, &(yylval.v_intval), 10) < 0) { LexError(WARNING, INTEGER_OVERFLOW, 1); yylval.v_intval = 0; } ret (INTEGER, INT); } #{hexdigit}+ { /* integer - allowing integer starting with 0 (e.g. 003). */ if (stoi(yytext, &(yylval.v_intval), 16) < 0) { LexError(WARNING, INTEGER_OVERFLOW, 1); yylval.v_intval = 0; } ret (INTEGER, INT); } '[^'\n]*((\*''):(':\n)) { /* : Character constant; : We define it generally for the error handling. */ if (yytext[yyleng-1] == '\n') { LexError(ERROR, NEWLINE_IN_CHAR_CONST, yyleng); yytext[yyleng-1] = '\''; newline++; } if (yyleng > 4 :: (yyleng == 4 && yytext[1] != '*')) LexError (WARNING, CHAR_CONST_TOO_LONG, 3); if (yyleng <= 2) { LexError (WARNING, EMPTY_CHAR_CONST, 1); yylval.v_charval = '\0'; ret (CHARACTER, CHAR); } if (yyleng == 3 && yytext[1] == '*') LexError(WARNING, ESCAPE_CHAR, 2); yylval.v_charval = charval(yytext); ret (CHARACTER, CHAR); } \"([^"\n]:(\*\"))*(\n:\") { /* : String constant; : Newline included for error handling. */ extern char *strval(); if (yytext[yyleng-1] == '\n') { LexError( WARNING, UNFINISHED_STR, yyleng); yytext[yyleng-1] = '"'; newline++; } yylval.v_strval = strval(yytext); /* including the quotes */ ret (STRING, STR); } {alpha}({alpha}:{digit}:".")* { /* identifiers */ register i; int type; if((i = Reserved(yytext, &type)) > 0) ret(i, type); if((yylval.v_hashval = hash(yytext, 1)) < 0) LexError(COMPILER_ERROR, HASH_FULL, 1); if(Hash[yylval.v_hashval].h_name == NULL) insert(yylval.v_hashval, yytext); ret (ID_TOK, HASH); } ^{newline} { lines++; printout(); yyunput(' '), yyunput(' '); break; } {newline} { /* newline token - includes comemnts and blanks at : end of line. */ newl: lines++; if(lastop) { printout(); break; } yyunput(' '); yyunput(' '); /* again - dummy blanks. */ ret (NEWLINE, noval); } ^{blnks}* { /* : Blanks at beginning of line are operators. : Calculate the indentation offset. */ register i = 0; register char *s = yytext; if(lastop) { lines--; printout(); lines++; lastop = 0; break; } while(*s) { /* Calculate tab's shift */ if(*s == '\t') i = ((i-2) / TABSZ + 1) * TABSZ + 2; else i++; s++; } if(i & 01) { LexError(WARNING, ODD_NO_OF_BLANKS, i); i++;/* round up */ } CurIndent = i/2 - 1; /* indent size is 2 blanks */ if (CurIndent -1 > PrevIndent) { LexError(WARNING, EXTRA_INDENT, 2); PrevIndent = CurIndent - 1; /* shift it all to : the right. */ } return yylex(); } {blnks}+ { printout(); /* ignore blanks within the line */ } . { /* anything else - error !!! */ if (!isalpha(yytext[0]) && !isdigit(yytext[0])) LexError(ERROR, ILLEGAL_CHAR, 1); else LexError(COMPILER_ERROR, LEX_INTERNAL_ERROR, 1); ERRORVAL(); } %% SHAR_EOF fi # end of overwriting check if test -f 'par.c' then echo shar: will not over-write existing file "'par.c'" else cat << \SHAR_EOF > 'par.c' static char rcsid[] = "$Header: par.c,v 2.1 86/10/30 16:07:44 gil Exp $"; /* * $Log: par.c,v $ * Revision 2.1 86/10/30 16:07:44 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:44 gil * Initial revision * */ #include #include "all.h" Quadl NewProcess(ol) Quadl ol; { Label l; l = NewLabel(); GenLabel(l); return AddList(ol, l); } EndProcess() { GenFuncCall(Immediate(0), "endproc", 1, NullAddr); } Par(l, ql) Quadl ql; Label l; { register i = 0; GenLabel(l); for(i = 0; i < ql.q_nquads; i++) { GenPushLabel(ql.q_quads[i]); GenFuncCall(Immediate(1), "newproc", 1, NullAddr); } GenFuncCall(Immediate(0), "waitall", 1, NullAddr); } SHAR_EOF fi # end of overwriting check if test -f 'parse.y' then echo shar: will not over-write existing file "'parse.y'" else cat << \SHAR_EOF > 'parse.y' %token AFTER FALSE LT_TOK RIGHT_TOK ALT FCHAN_TOK MINUS_TOK RP_TOK AND FOR MOD_TOK RSHIFT_TOK AND_TOK GE_TOK MULT_TOK SEMICOLON_TOK ASSIGN_TOK GT_TOK NEQ_TOK SEQ BYTE ID_TOK NEWLINE SKIP CHAN IF NOT STRING CHARACTER INP_TOK NOW TABLE COMA_TOK INTEGER OR TRUE COND_TOK LBR_TOK OR_TOK VALUE DEF LEFT_TOK PAR VAR DIV_TOK LE_TOK PLUS_TOK WAIT EQ_TOK LP_TOK PROC WHILE EXTERN LSHIFT_TOK RBR_TOK XOR_TOK AT QUE /* : Tokens precedence and assoctive list */ %left SEMICOLON_TOK COMA_TOK %left OR %left AND %nonassoc EQ_TOK GT_TOK GE_TOK LT_TOK LE_TOK NEQ_TOK AFTER %left OR_TOK XOR_TOK %left AND_TOK %left LSHIFT_TOK RSHIFT_TOK %left PLUS_TOK MINUS_TOK %left MULT_TOK DIV_TOK MOD_TOK %nonassoc NOT %{ #include #include "all.h" #define yylex get_token #define EMPTY 0 #define NONEMPTY 1 %} %union { Expr Expr; Decl Decl; int Hv; Op Op; Lval Lval; Args Args; Quadl Quadl; Label Label; Cond Cond; Guard Guard; Repl Repl; DType DType; } %type SEMICOLON_TOK COMA_TOK OR AND EQ_TOK GT_TOK GE_TOK LT_TOK LE_TOK NEQ_TOK OR_TOK XOR_TOK AND_TOK LSHIFT_TOK RSHIFT_TOK PLUS_TOK MINUS_TOK MULT_TOK DIV_TOK NOT VAR CHAN VALUE MOD_TOK AFTER %type oexpression expression expr element const_el variable cexpression input output %type INTEGER TRUE FALSE ID_TOK CHARACTER STRING %type opt_params params %type conditional parallel_process guard_process guard_process_list alt_construct %type cond_list %type guard %type id_tok decl_list table_init table proc_call_w_params %type replicator %type param %% prog : { $$ = ++ProcCount[DispLevel]; } main_process { FreeProc($1); } ; main_process : decl_list { NoMain = 1; } : decl_list statement ; process : { $$ = ++ProcCount[DispLevel]; } decl_list statement { FreeProc($1); } ; shifted_process : RIGHT_TOK process LEFT_TOK : { ShiftError(); } process ; statement : assignment NEWLINE { Count(); } : io NEWLINE { Count(); } : construct : proc_call NEWLINE { Count(); } : SKIP NEWLINE { Count(); } : error NEWLINE { ProcError(); yyerrok; } ; /* **** proc-call **** */ proc_call : id_tok { StartProcCall($1, 0); ProcCall($1); } : proc_call_w_params RP_TOK { CheckNargs($1); ProcCall($1); } ; proc_call_w_params: id_tok { StartProcCall($1, 1); } LP_TOK cexpression { $$ = $1; AddProcCall($1, $4); FreeExp($4); } : proc_call_w_params { Sbuf(); } COMA_TOK cexpression { $$ = $1; AddProcCall($1, $4); FreeExp($4); } ; cexpression : expression { $$ = $1; } : STRING { $$ = StrVal($1.lv_strval); } ; proc_list : process : proc_list process ; construct : SEQ NEWLINE RIGHT_TOK proc_list LEFT_TOK : SEQ NEWLINE : SEQ replicator NEWLINE RIGHT_TOK process LEFT_TOK { GenJmp(JMP, $2.r_loop); GenLabel($2.r_out); FreeRepl($2); } : IF NEWLINE RIGHT_TOK cond_list { GenLabel($4.c_out); BackPatch($4.c_next); } LEFT_TOK : IF replicator NEWLINE RIGHT_TOK conditional LEFT_TOK { GenJmp(JMP, $2.r_out); BackPatch($5); GenJmp(JMP, $2.r_loop); GenLabel($2.r_out); } : WHILE { $$.c_out = NewLabel(); GenLabel($$.c_out); Count(); } expression { $$ = CondExpr($3); FreeExp($3); } NEWLINE shifted_process { GenJmp(JMP, $2.c_out); BackPatch($4.e_false); } : PAR NEWLINE RIGHT_TOK { $