ttork@ewu.UUCP (Terry Torkelson) (11/15/90)
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 <stdio.h> #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 <stdio.h> #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 <stdio.h> #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 <stdio.h> /* 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 <stdio.h> #include <ctype.h> #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<<a)) extern commute; extern naddr; extern char *Inst(); extern (*func)(); extern MaxTemp; extern counting; /* 1 if commands counting is turned on */ #ifdef vax int stack_reserve = 1; #else int stack_reserve = 0; #endif addr NullAddr = { 0, 0, AD_REGISTER, -1 }; Buffer DataBuf, /* for data segment */ RO_DataBuf; /* for read-only data, declared 'text' but : doesn't mingle with the code. */ Buffer MainText; /* for separate compilation */ int NoMain; /* " */ addr TimeCounter = { AF_REG, 0, DP, -TIME_COUNTER }; static addr GlobalCounter = { 0, 0, AD_GLOBAL, (int)"CommandsTime"}; static InData; extern char *sprintf(); InitCode() { /* : Start buffers and generate buffer headers (text, data, etc.). : Order of initialization is important; Buffers will be flushed in : that order. */ DataBuf = NewBuf(); pcode("\t.align\t1\n"); /* pcode("\t.data\n"); pcode("\t.globl\t__localclock\n"); */ RO_DataBuf = NewBuf(); pcode("\t.text\n"); pcode("\t.align\t1\n"); MainText = NewBuf(); pcode("\t.text\n"); pcode("\t.align\t1\n"); pcode("\t.globl\t_oc_main\n"); pcode("_oc_main:\n"); InData = 0; } EndCode() { CountFlush(); #ifdef vax pcode("\tcalls\t$0,_endproc\n"); #else tahoe pcode("\tcallf\t$4,_endproc\n"); #endif } /* : gaddr: : Resolve indirect addresses. : Returns the address of an intermidiate which contains the computed address. */ addr gaddr(a, canbebyte) addr a; { addr ra; register i; if(a.d_disp <= AD_GLOBAL :: a.d_disp >= 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<<i)) c++; pcode("\ pushl $0\n\ storer $0x%x,(sp)\n\ moval (sp),r0\n\ subl2 $%d,r0\n\ movl r0,sp\n", mask, (c-1)*4); #endif } addr GenSave(a) addr a; { addr na; if(a.d_disp != AD_IMMED && a.d_disp != AD_REGISTER) return a; na.d_disp = DispLevel; na.d_offset = AllocStack(INT_SIZE); na.d_flags = AF_FP; pcode("\tmovl\t"); paddrs(2, a, na); return na; } GenPop(n) { if(n) { Sp -= INT_SIZE*n; pcode("\taddl2\t$%d,sp\n", n*INT_SIZE); } } addr Register(rn) { addr a; a = NullAddr; a.d_disp = AD_REGISTER; a.d_offset = rn; return a; } addr Immediate(v) { addr a; a = NullAddr; a.d_disp = AD_IMMED; a.d_offset = v; return a; } addr RegAddr(a, r) addr a, r; { /* Add to 'a' the register subscript in 'r'. */ if(r.d_disp != AD_REGISTER) panic("RegAddr should be given a register"); a.d_reg = r.d_offset; a.d_flags := AF_SUB; return a; } GenPushLabel(l) Label l; { pcode("\tpushl\t$L%d\n", l); } GenInc(a) addr a; { pcode("\tincl\t"); paddr(a); pcode("\n"); } GenGoto(a) addr a; { CountFlush(); a = gaddr(a, 0); pcode("\tjmp\t"); if(a.d_disp == AD_REGISTER) pcode("*(r%d)", a.d_offset); else paddr(a); pcode("\n"); } GenIndex(base, sub, res) addr base, sub, res; { register i = newreg(); addr tmp; tmp.d_disp = AD_REGISTER; tmp.d_offset = i; tmp.d_flags = 0; /* : ugh! This is ugly. : We want to use a compiler-register for the next TWO instructions. : We therefore resolve 'res' first, and so - even though compiler-registers : are freed after each instruction, it will NOT be used. */ res = gaddr(res, 1); Gen(DontFree(MOVL), sub, NullAddr, tmp); tmp = RegAddr(base, tmp); if(IsByte(res)) tmp.d_flags := AF_BYTE; Gen(MOVL, tmp, NullAddr, res); /* this moves already : the indexed : address. */ } addr GenIntSubscript(base, sub) addr base, sub; { addr res; if(sub.d_disp == AD_IMMED && (base.d_flags & AF_PTR) == 0) { res = base; if(res.d_disp != AD_GLOBAL) { res.d_offset -= sub.d_offset*INT_SIZE; /* printf("res.d_offset = %d sub.d_offset=%d\n",res.d_offset, sub.d_offset); * / } else { char buf[64]; sprintf(buf, "%s+%d", res.d_offset, sub.d_offset*INT_SIZE); res.d_offset = (int) strsave(buf); } return res; } if(sub.d_disp == AD_REGISTER) res = RegAddr(base, sub); else { res = NewTemp(); if(res.d_disp == AD_REGISTER) { Gen(DontFree(MOVL), sub, NullAddr, res); res = RegAddr(base, res); } else GenIndex(base, sub, res); } return res; } addr GenByteSubscript(base, sub) addr base, sub; { addr res; if(sub.d_disp == AD_IMMED && (base.d_flags & AF_PTR) == 0) { res = base; if(res.d_disp != AD_GLOBAL) res.d_offset -= sub.d_offset; else { char buf[64]; sprintf(buf, "%s+%d", res.d_offset, sub.d_offset); res.d_offset = (int) strsave(buf); } res.d_flags := AF_BYTE; return res; } if(sub.d_disp == AD_REGISTER) res = RegAddr(base, sub); else { res = NewTemp(); if(res.d_disp == AD_REGISTER) { Gen(DontFree(MOVL), sub, NullAddr, res); res = RegAddr(base, res); } else GenIndex(base, sub, res); } res.d_flags := AF_BYTE; return res; } addr GenSliceAddr(base, off, isbyte) addr base, off; { if(isbyte) return GenByteSubscript(base, off); return GenIntSubscript(base, off); } GenDef(name) addr_t name; { Buffer obuf = ToBuf(RO_DataBuf); pcode("_%s:\n", name); ToBuf(obuf); } char * GenDefLabel(l) Label l; { static char lbuf[10]; Buffer obuf = ToBuf(RO_DataBuf); sprintf(lbuf, "L%d", l); pcode("L%d:\n", l); ToBuf(obuf); return lbuf; } GenDefEl(i, isbyte) { Buffer obuf = ToBuf(RO_DataBuf); if (isbyte) pcode("\t.byte\t%d\n", i); else pcode("\t.long\t%d\n", i); ToBuf(obuf); } GenDefStr(s) char *s; /* this is an occam string, i.e. first byte saves : the length */ { Buffer obuf = ToBuf(RO_DataBuf); pcode("\t.asciz\t\""); if (s[0] != strlen(s) && Isprint(s[0])) pcode("%c", s[0]); else pcode("\\%03o", s[0]); for (s++; *s != '\0'; s++) if (Isprint(*s)) pcode("%c", *s); else pcode("\\%03o", *s); pcode("\"\n"); ToBuf(obuf); } GenAob(from, to, label) addr from, to; Label label; { /* : Add one to 'from', compare to 'to', if greater than or equal jump to label */ Label l; l = NewLabel(); from = gaddr(from, 0); to = gaddr(to, 0); pcode("\taoblss\t"); paddr(to); pcode(", "); paddr(from); pcode(", L%d\n", l); GenJmp(JMP, label); GenLabel(l); } char * GenLabelName(l) Label l; { static char lbuf[10]; return sprintf(lbuf, "L%d", l); } GenBcopy(from, to, count) addr from, to, count; { long sm; extern RegistersUsed; from = gaddr(from, 1); to = gaddr(to, 1); count = gaddr(count, 0); #ifdef vax endaddr(); sm = RegistersUsed&(reg(2):reg(3):reg(4):reg(5)); if(sm) pcode("\tpushr\t$0x%x\n", sm); pcode("\tmovc3\t"); paddrs(3, count, from, to); if(sm) pcode("\tpopr\t$0x%x\n", sm); #else tahoe sm = RegistersUsed & reg(2); if(sm) pcode("\tpushl\tr2\n"); #define MOV(instr, f, rx) pcode(" instr "), paddr(f), pcode(",r%d\n", rx) MOV(moval, from, 0); MOV(moval, to, 1); MOV(movl, count, 2); #undef MOV pcode("\tmovblk\n"); if(sm) pcode("\tmovl\t(sp)+,r2\n"); #endif } Isprint(c) { return isprint(c) && c != '\"'; } static Counter, CounterResolution = 100; /* Increment program time counter */ Count() { if(!counting) return; if(++Counter >= 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 <stdio.h> #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 <stdio.h> #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 <stdio.h> #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 <stdio.h> #include <ctype.h> #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 <stdio.h> #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 <stdio.h> /* 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 = "<stdin>"; char *outf = "<stdout>"; 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 <stdio.h> #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 <ctype.h> #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 <stdio.h> #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 <stdio.h> #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 <Op> 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 <Expr> oexpression expression expr element const_el variable cexpression input output %type <Lval> INTEGER TRUE FALSE ID_TOK CHARACTER STRING %type <Args> opt_params params %type <Quadl> conditional parallel_process guard_process guard_process_list alt_construct %type <Cond> cond_list %type <Guard> guard %type <Hv> id_tok decl_list table_init table proc_call_w_params %type <Repl> replicator %type <DType> param %% prog : { $<Hv>$ = ++ProcCount[DispLevel]; } main_process { FreeProc($<Hv>1); } ; main_process : decl_list { NoMain = 1; } : decl_list statement ; process : { $<Hv>$ = ++ProcCount[DispLevel]; } decl_list statement { FreeProc($<Hv>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 { $<Cond>$.c_out = NewLabel(); GenLabel($<Cond>$.c_out); Count(); } expression { $<Expr>$ = CondExpr($3); FreeExp($3); } NEWLINE shifted_process { GenJmp(JMP, $<Cond>2.c_out); BackPatch($<Expr>4.e_false); } : PAR NEWLINE RIGHT_TOK { $<Label>$ = NewLabel(); GenJmp(JMP, $<Label>$); } parallel_process LEFT_TOK { Par($<Label>4, $5); } : PAR replicator NEWLINE RIGHT_TOK { /* Count(); */ $<Label>$ = ReplProc($2); } process LEFT_TOK { EndReplProc($<Label>5, $2); FreeRepl($2); } : { StartAltCmd(); Count(); } alt_construct { BackPatch($2); EndAltCmd(); } ; alt_construct : ALT NEWLINE RIGHT_TOK guard_process_list LEFT_TOK { $$ = $4; } : ALT replicator NEWLINE { StartAlt($2.r_var); } RIGHT_TOK guard_process LEFT_TOK { EndReplAlt($6, $2); $$ = MakeList($2.r_out); } ; replicator : id_tok EQ_TOK LBR_TOK expression FOR expression RBR_TOK { $$ = NewRepl($1); $$ = Loop($$, $4, $6); FreeExp($4); FreeExp($6); } ; guard_process_list: guard_process { $$ = $1; } : guard_process_list { BackPatch($1); } guard_process { $$ = $3; } ; guard_process : { Label tmpl; tmpl = NewLabel(); StartAltIo(tmpl); $<Label>$ = tmpl; } guard NEWLINE { EndAltIo($2.gu_chan); StartGuardP($<Label>1); } shifted_process { EndGuardP(); $$ = $2.gu_next; } : alt_construct { $$ = $1; } ; guard : input { $$.gu_chan = $1; $$.gu_next = NullQuadl; } : expr COND_TOK input { $$.gu_chan = $3; $$.gu_next = $1.e_false; FreeExp($1); } ; input : variable INP_TOK { StartPushArgs(); } input_list { EndPushArgs(0); $$ = $1; } : variable INP_TOK { StartPushArgs(); } AFTER expression { Wait($5); EndPushArgs(1); $$ = $1; } : WAIT NOW AFTER { StartPushArgs(); } expression { Wait($5); EndPushArgs(1); $$ = TimeChan(); } ; output : variable FCHAN_TOK { StartPushArgs(); } output_list { EndPushArgs(0); $$ = $1; } ; parallel_process: { $<Quadl>$ = NewProcess(NullQuadl); } process { EndProcess(); $$ = $<Quadl>1; } : parallel_process { $<Quadl>$ = NewProcess($1); } process { EndProcess(); $$ = $<Quadl>2; } ; /* **** declarations: proc **** */ decl_list : /* empty */ { $$ = EMPTY; } : decl_list1 { $$ = NONEMPTY; } ; decl_list1 : declaration : decl_list1 declaration ; declaration : sdeclaration NEWLINE : pdeclaration LEFT_TOK ; pdeclaration : PROC id_tok { $<Decl>$ = ForwardDeclProc($2); } opt_params EQ_TOK { DeclProc($<Decl>3, $4); } NEWLINE RIGHT_TOK process { EndProc($2); } ; sdeclaration : VAR var_list : DEF def_list : CHAN chan_list : QUE que_list : EXTERN { set_extern(); } VAR var_list { unset_extern(); } : EXTERN { set_extern(); } CHAN chan_list { unset_extern(); } : EXTERN { set_extern(); } QUE que_list { unset_extern(); } : EXTERN PROC id_tok { $<Decl>$ = DeclExternProc($3); } opt_params { DeclProc($<Decl>4, $5); FreeProc(ProcCount[DispLevel]); Pop(); } ; opt_params : /* empty */ { $$ = NoArgs; } /* NoArgs - epty struct args */ : LP_TOK params RP_TOK { $$ = $2; EndParams(); } ; params : param { $$ = MakeArg($1); } : params COMA_TOK param { $$ = AddArg($1, $3); } ; param : VAR id_tok { $$ = DeclParam($1, $2); } : VAR id_tok LBR_TOK RBR_TOK { $$ = DeclParamTab($1, $2); } : CHAN id_tok { $$ = DeclParam($1, $2); } : CHAN id_tok LBR_TOK RBR_TOK { $$ = DeclParamTab($1, $2); } : VALUE id_tok { $$ = DeclParam($1, $2); } : VALUE id_tok LBR_TOK RBR_TOK { $$ = DeclParamTab($1, $2); } : id_tok { $$ = DeclParam(-1, $1); } : id_tok LBR_TOK RBR_TOK { $$ = DeclParamTab(-1, $1); } ; /* **** declaration: simple **** */ var_list : single_var : var_list COMA_TOK single_var ; single_var : id_tok { DeclVar($1); } : id_tok LBR_TOK expression RBR_TOK { DeclVarTab($1, $3); FreeExp($3); } : id_tok LBR_TOK BYTE expression RBR_TOK { DeclVarByteTab($1, $4); FreeExp($4); } : id_tok LBR_TOK RBR_TOK { DeclVarTab($1, EmptyExpr()); } ; chan_list : single_chan : chan_list COMA_TOK single_chan ; single_chan : id_tok { DeclChan($1, Zero()); } : id_tok LBR_TOK expression RBR_TOK { DeclChanTab($1, $3, Zero()); FreeExp($3); } : id_tok LBR_TOK RBR_TOK { DeclChanTab($1, EmptyExpr(), EmptyExpr()); } : id_tok AT expression { DeclChanAt($1, $3); } ; que_list : single_que : que_list COMA_TOK single_que ; single_que : id_tok LP_TOK expression RP_TOK { #ifdef BUFF_CHANS DeclChan($1, $3); #else Error(ERROR, BUFF_CHANS_UNSUPPORTED); #endif FreeExp($3); } : id_tok LP_TOK expression RP_TOK LBR_TOK expression RBR_TOK { #ifdef BUFF_CHANS DeclChanTab($1, $6, $3); #else Error(ERROR, BUFF_CHANS_UNSUPPORTED); #endif FreeExp($3); FreeExp($6); } : id_tok LP_TOK RP_TOK LBR_TOK RBR_TOK { #ifdef BUFF_CHANS DeclChanTab($1, EmptyExpr()); #else Error(ERROR, BUFF_CHANS_UNSUPPORTED); #endif } ; def_list : single_def : def_list COMA_TOK single_def ; single_def : id_tok EQ_TOK expression { DeclDef($1, $3); FreeExp($3); } : id_tok EQ_TOK { $<Decl>$ = DeclDefTab($1); } table { $<Decl>3 ->d_nel = $4; } : id_tok EQ_TOK STRING { DeclDefStr($1, $3.lv_strval); } ; table : TABLE LBR_TOK table_init RBR_TOK { $$ = $3; } : TABLE LBR_TOK BYTE { SetByte(); } table_init RBR_TOK { $$ = $5; UnsetByte(); } ; table_init : expression { DeclDefEl($1); $$ = 1; } : table_init COMA_TOK expression { DeclDefEl($3); $$ = $1 + 1; } ; /* **** if **** */ cond_list : { Count(); } conditional { $$.c_next = $2; $$.c_out = NewLabel(); } : cond_list { GenJmp(JMP, $1.c_out); BackPatch($1.c_next); Count(); } conditional { $$.c_out = $1.c_out; $$.c_next = $3; } ; conditional : expr NEWLINE { $<Expr>$ = CondExpr($1); FreeExp($1); } shifted_process { $$ = $<Expr>3.e_false; } : IF NEWLINE RIGHT_TOK cond_list LEFT_TOK { GenLabel($4.c_out); $$ = $4.c_next; } : IF replicator NEWLINE RIGHT_TOK conditional LEFT_TOK { Label tmpl; /* success label */ tmpl = NewLabel(); GenJmp(JMP, tmpl); BackPatch($5); Count(); GenJmp(JMP, $2.r_loop); GenLabel(tmpl); $$ = MakeList($2.r_out); } ; /* **** statements: assignment **** */ assignment : variable ASSIGN_TOK expression { Assign($1, $3); FreeExp($3); } ; /* **** expr **** */ expression : expr %prec SEMICOLON_TOK { $$ = EvalBool($1); } ; expr : element { $$ = $1; } : expr MULT_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = ArithOp($2, $<Expr>3, $4); } : expr DIV_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = ArithOp($2, $4, $<Expr>3); } : expr MOD_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = ArithOp($2, $4, $<Expr>3); } : expr PLUS_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = ArithOp($2, $<Expr>3, $4); } : expr MINUS_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = ArithOp($2, $4, $<Expr>3); } : expr LSHIFT_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = ArithOp($2, $<Expr>3, $4); } : expr RSHIFT_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = ArithOp($2, $<Expr>3, $4); } : expr AND_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = ArithOp($2, $<Expr>3, $4); } : expr OR_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = ArithOp($2, $<Expr>3, $4); } : expr XOR_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = ArithOp($2, $<Expr>3, $4); } : expr EQ_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = CmpOp($2, $<Expr>3, $4); } : expr GT_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = CmpOp($2, $<Expr>3, $4); } : expr GE_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = CmpOp($2, $<Expr>3, $4); } : expr LT_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = CmpOp($2, $<Expr>3, $4); } : expr LE_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = CmpOp($2, $<Expr>3, $4); } : expr NEQ_TOK { $<Expr>$ = EvalBool($1); } expr { $$ = CmpOp($2, $<Expr>3, $4); } : expr AND { $<Label>$ = Land($1); } expr { $$ = Rand($1, $<Label>3, $4); } : expr OR { $<Label>$ = Lor($1); } expr { $$ = Ror($1, $<Label>3, $4); } : NOT element { $$ = MonOp($1, $2); } : MINUS_TOK element { $$ = MonOp($1, $2); } : expr AFTER { $<Expr>$ = EvalBool($1); } expr { $$ = CmpOp($2, $<Expr>3, $4); } ; element : const_el : variable ; io : input { Io($1, 0); } : output { Io($1, 1); } ; ivar : variable { PushInputArg($1); FreeExp($1); } ; input_list : ivar : input_list SEMICOLON_TOK { Sbuf(); } ivar ; output_list : oexpression { PushOutputArg($1); FreeExp($1); } : output_list SEMICOLON_TOK { Sbuf(); } oexpression { PushOutputArg($4); FreeExp($4); } ; oexpression : expression { $$ = $1; } : STRING { $$ = StrToSlice($1); } ; const_el : INTEGER { $$ = IntVal($1); } : TRUE { $$ = Bool(C_TRUE); } : FALSE { $$ = Bool(C_FALSE); } : NOW { $$ = LocalClock(); } : CHARACTER { $$ = CharVal($1); } : LP_TOK expr RP_TOK { $$ = $2; } ; variable : id_tok { $$ = Identifier($1); } : id_tok LBR_TOK expression RBR_TOK { $$ = IndexedVar($1, $3); } : id_tok LBR_TOK BYTE expression RBR_TOK { $$ = ByteIndexedVar($1, $4); } : id_tok LBR_TOK expression FOR expression RBR_TOK { $$ = IntSlice($1, $3, $5); } : id_tok LBR_TOK BYTE expression FOR expression RBR_TOK { $$ = ByteSlice($1, $4, $6); } ; id_tok : ID_TOK { $$ = $1.lv_hashval; } ; %% SHAR_EOF fi # end of overwriting check if test -f 'proc.c' then echo shar: will not over-write existing file "'proc.c'" else cat << \SHAR_EOF > 'proc.c' static char rcsid[] = "$Header: proc.c,v 2.1 86/10/30 16:07:47 gil Exp $"; /* * $Log: proc.c,v $ * Revision 2.1 86/10/30 16:07:47 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:47 gil * Initial revision * */ #include <stdio.h> #include "all.h" DType ParamTypeConv(type) { switch (type) { case CHAN: return DCHAN; case VAR: return ByRef(DINT); case VALUE: return DINT; default: panic("Bad argument type"); } } Args MakeArg(dtype) DType dtype; { Args a; a.a_nargs = 1; a.a_argt = (DType *)calloc(1, sizeof(DType)); a.a_argt[0] = dtype; return a; } Args AddArg(a, dtype) Args a; DType dtype; { Args na; register n; na.a_nargs = n = a.a_nargs + 1; na.a_argt = (DType *)realloc(a.a_argt, n * sizeof(DType)); na.a_argt[n-1] = dtype; return na; } static int Nargs = 0; /* no. of arguments 'the' procedure was called with */ static int dontcheck = 0; /* external/undef procedure - don't check : no & type of arguments */ static int SavedBuf; ProcCall(hv) { register Decl dp; if (Nargs > 0) RevBuf(Nargs, SavedBuf); dp = Hash[hv].h_decl; if (dp == NULL) GenFuncCall(Immediate(Nargs), Hash[hv].h_name, 1, NullAddr); else GenFuncCall(Immediate(Nargs), (char *)dp->d_addr.d_offset, !IsExtern(dp->d_type) ? dp->d_addr.d_disp : 1, NullAddr); Nargs = 0; dontcheck = 0; } StartProcCall(hv, wp) { struct decl *dp; if (wp) { SavedBuf = CurBuf; Sbuf(); } dp = Hash[hv].h_decl; if(dp == NULL) { Error(WARNING, UNDEF_PROC, Hash[hv].h_name); dontcheck = 1; return; } if(Type(dp->d_type) != DPROC) { Error(ERROR, PROC_REQUIRED); return; } } AddProcCall(hv, arg) Expr arg; { PushParam(Hash[hv].h_decl, arg); Nargs++; } CheckNargs(hv) { Args a; if (!dontcheck) { a = Hash[hv].h_decl->d_args; if (a.a_nargs != Nargs) Error(ERROR, ILL_NUM_OF_ARGS); } } PushParam(dp, arg) Decl dp; Expr arg; { Args a; DType t; if (dontcheck) goto push; a = dp->d_args; if (Nargs > a.a_nargs) { dontcheck = 1; goto push; } t = a.a_argt[Nargs]; if(Type(t) != Etype(arg)) { Error(ERROR, TYPE_MISMATCH); return; } if(IsByRef(t) && (IsConst(arg) :: IsTemp(arg))) { Error(ERROR, LVAL_REQ); return; } push: if((!dontcheck && (IsByRef(t) :: IsTab(t))) :: IsTab(Etype(arg))) GenPush(1, Addr(arg)); /* push ADDRESS */ else GenPush(0, Addr(arg)); } SHAR_EOF fi # end of overwriting check if test -f 'repl.c' then echo shar: will not over-write existing file "'repl.c'" else cat << \SHAR_EOF > 'repl.c' static char rcsid[] = "$Header: repl.c,v 2.1 86/10/30 16:07:48 gil Exp $"; /* * $Log: repl.c,v $ * Revision 2.1 86/10/30 16:07:48 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:50 gil * Initial revision * */ #include <stdio.h> #include "all.h" Repl Loop(r, base, count) Repl r; Expr base, count; { Label l; if(IsConst(base)) GenAssignConst(base.e_cval - 1, r.r_var); else Gen(MINUS_TOK, Immediate(1), base.e_place, r.r_var); if(IsConst(base) && IsConst(count)) r.r_to = Eval(PLUS_TOK, base.e_place, count.e_place); else { r.r_to = GetAddr(); Gen(PLUS_TOK, Addr(base), Addr(count), r.r_to); } GenLabel(r.r_loop); GenAob( r.r_var, r.r_to, r.r_out); return r; } Label ReplProc(r) Repl r; { /* : documentation. */ Label ParL, /* label for start of parallel process */ ProcL, /* label for faked process (for 'calls') */ MaskL; /* label for masks at beginning of process */ if (r.r_var.d_disp != AD_REGISTER) panic("using non register for replicator variable"); ParL = NewLabel(); GenPushLabel(ParL); GenFuncCall(Immediate(1), "newproc", 1, NullAddr); GenJmp(JMP, r.r_loop); GenLabel(ParL); ProcL = NewLabel(); GenLabelCall(ProcL); GenFuncCall(Immediate(0), "endproc", 1, NullAddr); GenLabel(ProcL); MaskL = NewLabel(); Push(); GenStartProc(MaskL); return MaskL; } EndReplProc(MaskL, r) Label MaskL; Repl r; { GenEndProc(MaskL); Pop(); GenLabel(r.r_out); GenFuncCall(Immediate(0), "waitall", 1, NullAddr); } FreeRepl(r) Repl r; { FreeAddr(r.r_var); FreeAddr(r.r_to); } SHAR_EOF fi # end of overwriting check if test -f 'reserved_words.c' then echo shar: will not over-write existing file "'reserved_words.c'" else cat << \SHAR_EOF > 'reserved_words.c' #include <stdio.h> #include "all.h" struct reswords ReservedWords[] = { "AFTER" ,AFTER ,operator, "ALT" ,ALT ,reserved, "AND" ,AND ,operator, "AT" ,AT ,operator, "BYTE" ,BYTE ,operator, "CHAN" ,CHAN ,reserved, "DEF" ,DEF ,reserved, "EXTERN" ,EXTERN ,reserved, "FALSE" ,FALSE ,reserved, "FOR" ,FOR ,reserved, "IF" ,IF ,reserved, "NOT" ,NOT ,operator, "NOW" ,NOW ,reserved, "OR" ,OR ,operator, "PAR" ,PAR ,reserved, "PROC" ,PROC ,reserved, "QUE" ,QUE ,reserved, "SEQ" ,SEQ ,reserved, "SKIP" ,SKIP ,reserved, "TABLE" ,TABLE ,operator, "TRUE" ,TRUE ,reserved, "VALUE" ,VALUE ,reserved, "VAR" ,VAR ,reserved, "WAIT" ,WAIT ,reserved, "WHILE" ,WHILE ,reserved, "after" ,AFTER ,operator, "alt" ,ALT ,reserved, "and" ,AND ,operator, "at" ,AT ,operator, "byte" ,BYTE ,operator, "chan" ,CHAN ,reserved, "def" ,DEF ,reserved, "extern" ,EXTERN ,reserved, "false" ,FALSE ,reserved, "for" ,FOR ,reserved, "if" ,IF ,reserved, "not" ,NOT ,operator, "now" ,NOW ,reserved, "or" ,OR ,operator, "par" ,PAR ,reserved, "proc" ,PROC ,reserved, "que" ,QUE ,reserved, "seq" ,SEQ ,reserved, "skip" ,SKIP ,reserved, "table" ,TABLE ,operator, "true" ,TRUE ,reserved, "value" ,VALUE ,reserved, "var" ,VAR ,reserved, "wait" ,WAIT ,reserved, "while" ,WHILE ,reserved, }; int nreserved = sizeof(ReservedWords)/sizeof(struct reswords); SHAR_EOF fi # end of overwriting check if test -f 'Makefile.dist' then echo shar: will not over-write existing file "'Makefile.dist'" else cat << \SHAR_EOF > 'Makefile.dist' # configurable parameteres ################################################################################ CC=cc YACC=/usr/bin/yacc LEX=lex CFLAGS=-Ih -DYYDEBUG 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 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 'slice.c' then echo shar: will not over-write existing file "'slice.c'" else cat << \SHAR_EOF > 'slice.c' static char rcsid[] = "$Header: slice.c,v 2.1 86/10/30 16:07:52 gil Exp $"; /* * $Log: slice.c,v $ * Revision 2.1 86/10/30 16:07:52 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.2 86/03/19 16:39:00 gil * print varibale name in error messages. * * Revision 1.1 86/01/04 14:20:52 gil * Initial revision * */ #include <stdio.h> #include "all.h" #define Null_tf(e) (e).e_false = NullQuadl; addr MultByFour(count) Expr count; { addr r; if(IsConst(count)) r = Eval(MULT_TOK, Immediate(4), count.e_place); else { r = GetAddr(); Gen(MULT_TOK, Immediate(4), Addr(count), r); } return r; } Expr Slice(hv, base, count, isbyte) Expr base, count; { Decl d; Expr ne; d = Hash[hv].h_decl; if (d == NULL) { Error(ERROR, UNDEF_VAR, Hash[hv].h_name); return ne; } Null_tf(ne); if(Type(d->d_type) != DINT_TAB) { Error(ERROR, TABLE_REQUIRED); return ne; } ne.e_flags = ET_SLICE; if(!isbyte) ne.e_slen = MultByFour(count); else ne.e_slen = Addr(count); ne.e_place = GenSliceAddr(d->d_addr, Addr(base), isbyte); return ne; } Expr IntSlice(hv, base, count) Expr base, count; { return Slice(hv, base, count, 0); } Expr ByteSlice(hv, base, count) Expr base, count; { return Slice(hv, base, count, 1); } Expr StrToSlice(s) char *s; { Expr e; e.e_flags = ET_SLICE:EK_CONST; e.e_place = NullAddr; e.e_place.d_flags = AF_LABEL; e.e_place.d_offset = (addr_t)strsave(GenDefLabel(NewLabel())); e.e_place.d_disp = 1; e.e_slen = Immediate(s[0]); Null_tf(e); GenDefStr(s+1); return e; } SHAR_EOF fi # end of overwriting check if test -f 'tab.c' then echo shar: will not over-write existing file "'tab.c'" else cat << \SHAR_EOF > 'tab.c' static char rcsid[] = "$Header: tab.c,v 2.1 86/10/30 16:07:54 gil Exp $"; /* * $Log: tab.c,v $ * Revision 2.1 86/10/30 16:07:54 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:53 gil * Initial revision * */ #include <stdio.h> #include "all.h" extern addr gaddr(); static addr get_temp() { addr t; t = NullAddr; t.d_disp = AD_REGISTER; t.d_offset = newreg(); return t; } mach_and(op, a1, a2, res) addr *a1, *a2, *res; { addr t; t = get_temp(); *a1 = gaddr(*a1, 0); pcode("\tmcoml\t"); paddr(*a1); pcode(","); paddr(t); pcode("\n"); *a1 = t; return 0; } mach_mod(op, a1, a2, res) addr *a1, *a2, *res; { addr t; t = get_temp(); pcode("\tdivl3\t"); *a1 = gaddr(*a1, 0); *a2 = gaddr(*a2, 0); paddr(*a1); pcode(","); paddr(*a2); pcode(","); paddr(t); pcode("\n\tmull2\t"); paddr(*a1); pcode(","); paddr(t); pcode("\n"); *a1 = t; return 0; } #ifdef vax mach_ash(op, a1, a2, res) addr *a1, *a2, *res; { addr t; if(op == RSHIFT_TOK) { t = get_temp(); if(a2->d_disp == AD_IMMED) { a2->d_offset = -a2->d_offset; t = *a2; } else { t = get_temp(); *a2 = gaddr(*a2); pcode("\tmnegl\t"); paddr(*a2); pcode(","); paddr(t); pcode("\n"); } } else t = gaddr(*a2); *a1 = gaddr(*a1); pcode("\tashl\t"); paddr(t); pcode(","); paddr(*a1); pcode(","); paddr(*res); pcode("\n"); endaddr(); return 1; } #endif #ifdef tahoe mach_shift(op, a1, a2, res) addr *a1, *a2, *res; { *a1 = gaddr(*a1); *a2 = gaddr(*a2); *res = gaddr(*res); if(!IsReg(*a2)) { pcode("\tmovl\t"); paddr(*a2); *a2 = get_temp(); pcode(", "); paddr(*a2); pcode("\n"); } pcode("\tsh%cl\t", op == RSHIFT_TOK ? 'r' : 'l'); paddrs(3, *a2, *a1, *res); endaddr(); } #endif int naddr, commute; int (*func)(); #define NonCommute(a) (commute &= ~(1<<(a))) char * Inst(op) { switch (op) { case MULT_TOK: return "mul"; case PLUS_TOK: return "add"; case MINUS_TOK: NonCommute(1); return "sub"; case DIV_TOK: NonCommute(1); return "div"; case OR_TOK: #ifdef vax return "bis"; #else tahoe return "or"; #endif case AND_TOK: #ifdef vax func = mach_and; return "bic"; #else tahoe return "and"; #endif case XOR_TOK: return "xor"; case LSHIFT_TOK: #ifdef vax func = mach_ash; return "ash"; #else tahoe func = mach_shift; return NULL; #endif case RSHIFT_TOK: #ifdef vax func = mach_ash; return "rsh"; #else tahoe func = mach_shift; return NULL; #endif case MOD_TOK: func = mach_mod; return "sub"; /* for all compraison operation we creat a branch to the opposite : relation holds. */ case EQ_TOK: return "jneq"; case GT_TOK: return "jleq"; case LT_TOK: return "jgeq"; case LE_TOK: return "jgtr"; case NEQ_TOK: return "jeql"; case GE_TOK: return "jlss"; case AFTER: return "jlssu"; case MON(MINUS_TOK): naddr = 2; return "mneg"; case MON(NOT): naddr = 2; return "mcom"; case MOVREF: case MOVL: naddr = 2; return "mov"; case CMP: naddr = 2; return "cmp"; case JMP: naddr = 1; return "jbr"; case TST: naddr = 1; return "tst"; case JUMP: naddr = 1; return "jmp"; default: panic("Unknown op\n"); } /*NOTREACHED*/ } SHAR_EOF fi # end of overwriting check if test -f 'temp.c' then echo shar: will not over-write existing file "'temp.c'" else cat << \SHAR_EOF > 'temp.c' static char rcsid[] = "$Header: temp.c,v 2.1 86/10/30 16:07:55 gil Exp $"; /* * $Log: temp.c,v $ * Revision 2.1 86/10/30 16:07:55 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:54 gil * Initial revision * */ #include "addr.h" #include "machine.h" #if NBBY*NBPL > NREG long RegistersUsed; long MaxTemp; static long DontFree; #define bit(i) (1 << (i)) addr GetTemp(mask, reuse) long mask; { addr a; register i; a = NullAddr; i = ffc(RegistersUsed:mask); a.d_flags = 0; if(i < 0 :: i >= NREG) { a.d_disp = DispLevel; a.d_offset = AllocStack(INT_SIZE); if(DispLevel == AD_GLOBAL) /* hack - * should prevent using offset * as a name for oc_main stack * temporary allocation, and * here fp == sp */ a.d_flags = AF_FP; return a; } a.d_disp = AD_REGISTER; a.d_offset = i; RegistersUsed := bit(i); if(ShouldBeMasked(i)) MaxTemp := bit(i); if(reuse) DontFree := bit(i); return a; } FreeTmp(a) addr a; { register long mask; register i; if(a.d_flags & AF_SUB) i = a.d_reg; else if(a.d_disp != AD_REGISTER) /* panic("FreeTmp: Not a register"); */ return; else i = a.d_offset; mask = bit(i); if(DontFree & mask) return; if(i >= NREG :: i < 0) panic("Illegal register number"); if((RegistersUsed & mask) == 0) panic("Freeing free register"); RegistersUsed &= ~mask; } addr NewTemp() { addr a; a = GetTemp(TEMPMASK, 0); return a; } addr GetAddr() { addr a; a = GetTemp(ADDRMASK, 1); return a; } FreeAddr(a) addr a; { if(a.d_disp == AD_REGISTER) DontFree &= ~bit(a.d_offset); FreeTmp(a); } ResetTmp() { RegistersUsed = DontUse:OtherRegs:DontFree; MaxTemp = OtherRegs; } ffc(l) long l; { return (ffs(~l) - 1); } #else !! #endif addr_t AllocStack(nbytes) { Sp += roundup(nbytes); return Sp; } static Label; NewLabel() { return ++Label; } SHAR_EOF fi # end of overwriting check if test -f 'reserved.c' then echo shar: will not over-write existing file "'reserved.c'" else cat << \SHAR_EOF > 'reserved.c' static char rcsid[] = "$Header: reserved.c,v 2.1 86/10/30 16:07:50 gil Exp $"; /* * $Log: reserved.c,v $ * Revision 2.1 86/10/30 16:07:50 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:51 gil * Initial revision * */ #include <stdio.h> #include "all.h" Reserved(s, type) char *s; int *type; { /* Perform a binary search for the name 's' in the 'ReservedWords' table : and return its token number and type. return 0 if not found. */ register high = nreserved, low = -1, mid, m; do { mid = (high + low)/2; if((m = strcmp(ReservedWords[mid].rs_word, s)) == 0) { *type = ReservedWords[mid].rs_type; return ReservedWords[mid].rs_token; } else if(m > 0) high = mid; else low = mid; } while(low+1 != high); return 0; } /* main() { char s[100]; while(gets(s) != NULL) printf("%s: %d\n", s, Reserved(s)); } */ SHAR_EOF fi # end of overwriting check if test -f 'err_types' then echo shar: will not over-write existing file "'err_types'" else cat << \SHAR_EOF > 'err_types' RECOVER :INTEGER_OVERFLOW :Integer overflow RECOVER :NEWLINE_IN_CHAR_CONST :Newline in character constant RECOVER :CHAR_CONST_TOO_LONG :Character constant too long WARNING :EMPTY_CHAR_CONST :Empty character constant WARNING :ESCAPE_CHAR :'*' is escape character WARNING :NO_SPECIAL_MEANING :Escape has no special meaning RECOVER :UNFINISHED_STR :Unfinished string COMPILER_ERROR :HASH_FULL :Hash table is full WARNING :ODD_NO_OF_BLANKS :Odd number of blanks ERROR :ILLEGAL_CHAR :Illegal character COMPILER_ERROR :LEX_INTERNAL_ERROR :Lexical error: internal error ERROR :EXPECTED_EOF :Eof Expected - Quit ERROR :UNEXPECTED_EOF :Unexpected Eof RECOVER :EXPECTED_CONST :Expected constant expression ERROR :TYPE_MISMATCH :Type mismatch RECOVER :DIV_BY_ZERO :Division by zero RECOVER :OP_MISMATCH :Illegal operand RECOVER :UNDEF_VAR :Undefined variable \"%s\" ERROR :MULTIPLY_DECLARED_VAR :Multiply declared var RECOVER :LVAL_REQ :Lvalue requierd ERROR :CHANNEL_REQ :Channel required ERROR :PROC_REQUIRED :Process required WARNING :UNDEF_PROC :Undefined proc \"%s\", assumed external ERROR :ILL_NUM_OF_ARGS :Wrong number of arguments ERROR :EXTERN_EXISTS :External definition cannot be overlapped ERROR :TABLE_REQUIRED :Table required WARNING :VALUE_PARAM_ASSIGN :Assigment to Read Only variable ERROR :SLICE_REQUIRED :Slice required ERROR :DIFF_SLICES :Slices should be of the same type COMPILER_ERROR :TOO_MANY_ERRORS :Too many errors ERROR :MISSING_PARAM_TYPE :missing parameters' type (var, value or chan) WARNING :EXTRA_INDENT :Extra indentation, taken as one indent RECOVER :EXPECT_SHIFTED_PROC :Expected shifted process near token %s ERROR :SYNT_ERR_NEAR :Syntax Error near token %s WARNING :EXTERN_NAME_OVERLOAD :External %s is already declared global ERROR :IDENT_REQUIRED :Bad identifier type - \"%s\" ERROR :VMS_UNSUPPORTED :VMS (placed) channels are not supported SHAR_EOF fi # end of overwriting check if test -f 'back.c' then echo shar: will not over-write existing file "'back.c'" else cat << \SHAR_EOF > 'back.c' static char rcsid[] = "$Header: back.c,v 2.1 86/10/30 16:05:57 gil Exp $"; /* * $Log: back.c,v $ * Revision 2.1 86/10/30 16:05:57 gil * This version was submitted for the project. It is free of all major bugs. * * Revision 1.1 86/01/04 14:20:29 gil * Initial revision * */ #include <stdio.h> #include "all.h" Quadl NullQuadl = { 0, (Label *)0 }; Quadl MakeList(quad) Label quad; { Quadl q; q.q_nquads = 1; q.q_quads = (Label *) calloc(1, sizeof(Label)); q.q_quads[0] = quad; return q; } Quadl Merge(q1, q2) Quadl q1, q2; { Quadl q; register Label *p, *np; register i; q.q_nquads = q1.q_nquads + q2.q_nquads; if (q.q_nquads > 0) np = q.q_quads = (Label *)calloc(q.q_nquads, sizeof(Label)); for(i = q1.q_nquads, p = q1.q_quads; i > 0; i--) *np++ = *p++; for(i = q2.q_nquads, p = q2.q_quads; i > 0; i--) *np++ = *p++; return q; } Quadl AddList(ql, l) Quadl ql; Label l; { Quadl q; register Label *p, *np; register i; if (NullQ(ql)) return(MakeList(l)); q.q_nquads = ql.q_nquads + 1; np = q.q_quads = (Label *)calloc(q.q_nquads, sizeof(Label)); for(i = ql.q_nquads, p = ql.q_quads; i > 0; i--) *np++ = *p++; *np++ = l; return q; } BackPatch(ql) Quadl ql; { register int i; register Label *j; for(j = ql.q_quads, i = ql.q_nquads; i-- > 0; j++) GenLabel(*j); } SHAR_EOF fi # end of overwriting check if test -f 'reserved_words' then echo shar: will not over-write existing file "'reserved_words'" else cat << \SHAR_EOF > 'reserved_words' "after" AFTER operator "AFTER" AFTER operator "alt" ALT "ALT" ALT "and" AND operator "AND" AND operator "at" AT operator "AT" AT operator "byte" BYTE operator "BYTE" BYTE operator "chan" CHAN "CHAN" CHAN "def" DEF "DEF" DEF "extern" EXTERN "EXTERN" EXTERN "false" FALSE "FALSE" FALSE "for" FOR "FOR" FOR "if" IF "IF" IF "not" NOT operator "NOT" NOT operator "now" NOW "NOW" NOW "or" OR operator "OR" OR operator "par" PAR "PAR" PAR "proc" PROC "PROC" PROC "que" QUE "QUE" QUE "seq" SEQ "SEQ" SEQ "skip" SKIP "SKIP" SKIP "table" TABLE operator "TABLE" TABLE operator "true" TRUE "TRUE" TRUE "value" VALUE "VALUE" VALUE "var" VAR "VAR" VAR "wait" WAIT "WAIT" WAIT "while" WHILE "WHILE" WHILE SHAR_EOF fi # end of overwriting check cd .. # End of shell archive exit 0 ----------end of comp.shar----------
ttork@ewu.UUCP (Terry Torkelson) (11/15/90)
----------sim.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:
# sim
# This archive created: Thu Apr 19 16:54:29 1990
export PATH; PATH=/bin:$PATH
if test ! -d 'sim'
then
mkdir 'sim'
fi
cd 'sim'
if test ! -d 'h'
then
mkdir 'h'
fi
cd 'h'
if test -f 'trace.h'
then
echo shar: will not over-write existing file "'trace.h'"
else
cat << \SHAR_EOF > 'trace.h'
/*
* Occam kernel tracer definitions.
*/
extern int tracer; /* tracing flags */
extern char *BlockStat(), *Pinfo();
/* tracing options: */
#define TRACE_CSW 0x1 /* trace context switches */
#define TRACE_FORK 0x2 /* trace forks */
#define TRACE_BLOCK 0x4 /* trace blocks/unblocks */
#define TRACE_IO 0x10 /* trace i/o events. */
#define TRACE_MOREIO 0x20 /* trace more i/o events */
#define TRACE_ALLIO (TRACE_IO:TRACE_MOREIO) /* trace all i/o
: operations */
#define TRACE_ALL (0xffff)
FILE *tracef;
/*
: TRACE(flags, (fmt, args...)):
: flags - trace flags for which this trace message is applied.
: fmt, args - tracing message. passed to printf.
*/
#define TRACE(flg, args) if(tracer&(flg)) pflg(flg), ptrace args
#define NTRACE(flg, args) if(tracer&(flg)) sflg(flg), ptrace args
SHAR_EOF
fi # end of overwriting check
if test -f 'vmsio.h'
then
echo shar: will not over-write existing file "'vmsio.h'"
else
cat << \SHAR_EOF > 'vmsio.h'
/*
: $Header: vmsio.h,v 3.1 86/11/01 15:45:09 gil Exp $
: VMS-Occam Compatible Channel definitions.
*/
#define _InF(v) (v+3)
#define _OutF(v) (v+11)
/* Channel Numbers: */
#define C_Parameters 0
#define C_Screen 1
#define C_Keyboard 2
#define C_Filein0 _InF(0)
#define C_Filein1 _InF(1)
#define C_Filein2 _InF(2)
#define C_Filein3 _InF(3)
#define C_Filein4 _InF(4)
#define C_Filein5 _InF(5)
#define C_Filein6 _InF(6)
#define C_Filein7 _InF(7)
#define C_Fileout0 _OutF(0)
#define C_Fileout1 _OutF(1)
#define C_Fileout2 _OutF(2)
#define C_Fileout3 _OutF(3)
#define C_Fileout4 _OutF(4)
#define C_Fileout5 _OutF(5)
#define C_Fileout6 _OutF(6)
#define C_Fileout7 _OutF(7)
#define V_NFILES 8
#define WORDSIZE 4
#define IsInf(f) ((f) < _OutF(0) && (f) >= _InF(0))
#define IsOutf(f) ((f) >= _OutF(0))
#define VFile(f) (((f) < C_Filein0) ? &StdFile[f] : \
&VmsFile[IsInf(f) ? ((f) - C_Filein0) : ((f) - C_Fileout0)])
struct vms_file {
int vms_message;
enum vstat { NORMAL, FILENAME, ARGSTR } vms_stat;
FILE *vms_fp;
char *vms_name;
} VmsFile[V_NFILES], StdFile[3];
typedef struct vms_file VmsChan;
/* Control Values */
#define V_ClosedOK -1
#define V_CloseFile -2
#define V_EndBuffer -3
#define V_EndFile -4
#define V_EndName -5
#define V_EndParameterString -6
#define V_EndRecord -7
#define V_NextRecord -9
#define V_OpenedOK -10
#define V_OpenForRead -11
#define V_OpenForWrite -12
/* Error Values */
#define E_FileNameTooLong 0x80000000
#define E_InputFileNotOpened 0x80000001
#define E_OutputFileNotCreated 0x80000002
#define E_InputRecordTooLong 0x80000004
#define E_ReadFailed 0x80000008
#define E_OutputRecordTooLong 0x80000010
#define E_WriteFailed 0x80000020
#define E_CloseFailed 0x80000040
SHAR_EOF
fi # end of overwriting check
if test -f 'chan.h'
then
echo shar: will not over-write existing file "'chan.h'"
else
cat << \SHAR_EOF > 'chan.h'
#define min(a, b) ((a) > (b) ? (b) : (a))
#define max(a, b) ((a) > (b) ? (a) : (b))
typedef struct {
int io_len;
char *io_data;
} IoVec;
typedef struct ioblock {
IoVec *b_data;
int b_ndata;
int b_dind; /* index of data array; used also for flags */
#define BD_FAFTER -1 /* if 'after' operation on the time channel */
Process *b_proc;
int b_id;
struct ioblock *b_next;
} IoBlock;
typedef struct channel {
int ch_flags;
int ch_siz; /* for buffered channels: sizeof buffer */
IoBlock ch_read; /* read-requests' queue */
IoBlock ch_write; /* write-requests' queue */
#if (defined(S_SYS) :: defined(S_VMS))
int ch_fd; /* file descriptor for special channels */
#endif /* S_SYS :: S_VMS */
struct channel *ch_nxt;
} Channel;
#ifdef S_SYS
# define CH_SYS 01
# define CH_DEV 04
# define IsSpecial(ch) ((ch)->ch_flags & CH_SYS)
# define IsSpecialDevice(ch) ((ch)->ch_flags & CH_DEV)
#endif S_SYS
#ifdef S_VMS
# define CH_VMS 02
# define IsVms(ch) ((ch)->ch_flags & CH_VMS)
#endif S_VMS
#define CH_TIME 08
#define IsTime(ch) ((ch)->ch_flags & CH_TIME)
#define chanof(id) (&chans[id])
#define chidof(ch) (ch - chans)
#define MAX_CHANS 512
extern Channel chans[];
extern Channel *free_chans;
#define F_AFTER 1
extern int time_ch;
#define new(type) (struct type *)calloc(1, sizeof(struct type))
SHAR_EOF
fi # end of overwriting check
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 3.3 86/11/04 09:56:28 gil Exp $ */
/*
* This is a configuration file for the OCCAM runtime library.
* It contains a few parameters that determine if certain options will be
* supported by the library.
* See the user manual for detailed description of these options.
* When noted, the compiler should be configured to support the option in the
* language syntax. This is done by setting the options in the compiler's
* configuration file, ../h/conf.h
*
* The options are:
*/
/* S_SYS: include the code for special system channels. With this option
* set the system will support actions on UNIX files through special channels.
*/
#define S_SYS
/* S_VMS: include the code for special VMS channels - these are special system
* channels that conform to the system channels protocol of the INMOS VAX/VMS
* version of OCCAM.
* NOTE: Should be set in the compiler as well.
*/
/* #define S_VMS */
/* BUFF_CHAN: include the code for buffered channels.
* If you don't intend to use buffered channels switch it off for better
* performance.
* NOTE: Should be set in the compiler as well.
*/
#define BUFF_CHANS
SHAR_EOF
fi # end of overwriting check
if test -f 'process.h.bak'
then
echo shar: will not over-write existing file "'process.h.bak'"
else
cat << \SHAR_EOF > 'process.h.bak'
#include <sys/types.h>
#ifdef vax
typedef struct {
int r2, r3, r4, r5, r6, r7, r8, r9, r10;
/* general purpose registers */
caddr_t st_dp; /* display pointer (occam ext. r11) */
caddr_t st_ap; /* argument pointer */
caddr_t st_fp; /* frame pointer */
caddr_t st_sp; /* stack pointer */
caddr_t st_pc; /* program counter */
} SavedData;
#else tahoe
typedef struct {
int r2, r3, r4, r5, r6, r7, r8, r9, r10, r11;
caddr_t st_dp; /* display pointer (r12) */
caddr_t st_fp;
caddr_t st_sp;
caddr_t st_pc;
} SavedData;
#endif
typedef struct {
int s_size;
caddr_t s_bottom;
} Stack;
#ifdef vax
#define DISPSIZE (8*2*4) /* Display contains now 8 levels */
#else tahoe
#define DISPSIZE (8*4) /* Display contains now 8 levels */
#endif
#define COUNTSIZE 4 /* commands counter */
#define topof(s) ((s).s_bottom + (s).s_size - (DISPSIZE + COUNTSIZE))
#define dispof(s) ((s).s_bottom + (s).s_size - COUNTSIZE)
#define bdispof(s) ((s).s_bottom + (s).s_size - (DISPSIZE + COUNTSIZE))
#define timeof(s) ((s).s_bottom + (s).s_size - COUNTSIZE)
#define realtop(s) ((s).s_bottom + (s).s_size)
typedef struct {
int pi_sontime; /* maximum sons' parallel time */
int pi_time;
} Sinfo;
typedef struct process {
int p_pid;
int p_ppid;
struct process *p_parent;
int p_nsons;
int p_nzomb;
Sinfo p_info;
#define p_time p_info.pi_time
#define p_sontime p_info.pi_sontime
int p_flags;
int p_eventid; /* unique id for io events */
int p_chid; /* for select: channel on which io is done */
enum pstat { BLOCK_CHILD, BLOCK_IO, RUNNING } p_stat;
struct process *p_nxt,
*p_prv;
SavedData p_save;
int p_kmode; /* should be in saved data */
Stack p_stack;
Stack p_curstack;
} Process;
#define PF_ZOMB 1
#define NPROC 256
/* definitions for random pickings. recommended that R == NPROC */
#define R 256.0
#define MASKR 0xff
#define STACK_SIZE (8*1024) /* Default stack size = 8k */
#define nproc NPROC
Process *runq, *waitq, *freeq, proctable[NPROC];
extern Process *proc;
extern int kmode;
#define Kmode_On kmode++
#define Kmode_Off kmode--
extern int time_ch;
extern int CommandsTime;
extern int IdleTime;
#include "trace.h"
SHAR_EOF
fi # end of overwriting check
if test -f 'process.h'
then
echo shar: will not over-write existing file "'process.h'"
else
cat << \SHAR_EOF > 'process.h'
#include <sys/types.h>
#ifdef vax
typedef struct {
int r2, r3, r4, r5, r6, r7, r8, r9, r10;
/* general purpose registers */
caddr_t st_dp; /* display pointer (occam ext. r11) */
caddr_t st_ap; /* argument pointer */
caddr_t st_fp; /* frame pointer */
caddr_t st_sp; /* stack pointer */
caddr_t st_pc; /* program counter */
} SavedData;
#else tahoe
typedef struct {
int r2, r3, r4, r5, r6, r7, r8, r9, r10, r11;
caddr_t st_dp; /* display pointer (r12) */
caddr_t st_fp;
caddr_t st_sp;
caddr_t st_pc;
} SavedData;
#endif
typedef struct {
int s_size;
caddr_t s_bottom;
} Stack;
#define SMASK (char)0xbc
#define StackMask(p) ((p) == &proctable[0] :: \
(p)->p_stack.s_bottom[0] == SMASK)
#ifdef vax
#define DISPSIZE (8*2*4) /* Display contains now 8 levels */
#else tahoe
#define DISPSIZE (8*4) /* Display contains now 8 levels */
#endif
#define COUNTSIZE 4 /* commands counter */
#define topof(s) ((s).s_bottom + (s).s_size - (DISPSIZE + COUNTSIZE))
#define dispof(s) ((s).s_bottom + (s).s_size - COUNTSIZE)
#define bdispof(s) ((s).s_bottom + (s).s_size - (DISPSIZE + COUNTSIZE))
#define timeof(s) ((s).s_bottom + (s).s_size - COUNTSIZE)
#define realtop(s) ((s).s_bottom + (s).s_size)
typedef struct {
int pi_sontime; /* maximum sons' parallel time */
int pi_time;
} Sinfo;
typedef struct process {
int p_pid;
int p_ppid;
struct process *p_parent;
int p_nsons;
int p_nzomb;
Sinfo p_info;
#define p_time p_info.pi_time
#define p_sontime p_info.pi_sontime
int p_flags;
int p_eventid; /* unique id for io events */
int p_chid; /* for select: channel on which io is done */
enum pstat { BLOCK_CHILD, BLOCK_IO, RUNNING } p_stat;
struct process *p_nxt,
*p_prv;
SavedData p_save;
int p_kmode; /* should be in saved data */
Stack p_stack;
Stack p_curstack;
} Process;
#define PF_ZOMB 1
#define NPROC 256
/* definitions for random pickings. recommended that R == NPROC */
#define R 256.0
#define MASKR 0xff
#define STACK_SIZE (8*1024) /* Default stack size = 8k */
#define nproc NPROC
Process *runq, *waitq, *freeq, proctable[NPROC];
extern Process *proc;
extern int kmode;
#define Kmode_On kmode++
#define Kmode_Off kmode--
extern int time_ch;
extern int CommandsTime;
extern int IdleTime;
#include "trace.h"
SHAR_EOF
fi # end of overwriting check
cd ..
if test -f 'ext.c'
then
echo shar: will not over-write existing file "'ext.c'"
else
cat << \SHAR_EOF > 'ext.c'
static char rcsid[] = "$Header: ext.c,v 3.3 86/11/03 12:34:59 gil Exp $";
/*
* $Log: ext.c,v $
* Revision 3.3 86/11/03 12:34:59 gil
* buffered channels and special channels are wrapped within 'ifdefs' for
* flexible configuration.
*
* Revision 3.2 86/11/02 09:09:27 gil
* somehow the buffered-cahnnels version got in the way as revision 3.1, BEWARE.
*
* Revision 2.1 86/10/30 18:14:52 gil
* This version was submitted for the project. It is free of all major bugs.
*
* Revision 1.1 86/01/04 14:48:59 gil
* Initial revision
*
*/
#include <stdio.h>
#include "trace.h"
chtabopen(tab, siz, nel)
register int *tab;
{
TRACE(TRACE_IO, ("open channel table at 0x%x - %d", tab, nel));
while (nel--)
*tab++ = chopen(siz);
}
chtabclose(tab, nel)
register int *tab;
{
TRACE(TRACE_IO, ("close channel table at 0x%x - %d", tab, nel));
while(nel--)
chclose(*tab++);
}
int dflag;
#define debugfp stderr
/*VARARGS1*/
debug(fmt, a1, a2, a3, a4, a5, a6)
char *fmt;
{
if(dflag)
fprintf(debugfp, fmt, a1, a2, a3, a4, a5, a6);
}
bcopy(from, to, len)
register int *from, *to;
register len;
{
len >>= 2;
while(len--)
*to++ = *from++;
}
SHAR_EOF
fi # end of overwriting check
if test -f 'machdep.s'
then
echo shar: will not over-write existing file "'machdep.s'"
else
cat << \SHAR_EOF > 'machdep.s'
.globl _SetJmp # the _Setjmp subroutine in VAX
# became _setjmp procedure for TAHOE
_SetJmp:
.word 0x0
movl 4(fp),r1
storer $0x1ffc,(r1)
addl2 $44,r1
movl (fp),(r1)
addl2 $4,r1
movab 8(fp),(r1)
addl2 $4,r1
movl -8(fp),(r1)
clrl r0
ret
.globl _LongJmp # the _Longjmp subroutine in VAX
# became _longjmp procedure for TAHOE
_LongJmp:
.word 0x0000
movl 4(fp),r1
loadr $0x3ffc,(r1)
addl2 $48,r1
# movl (r2),r1
movl (r1),r0
addl2 $4,r1
# movab (sp),r0
# cmpl r1,r0 # must be a pop
# bgequ lj2
# pushab lj1
# callf $8,_panic
lj2:
movl r0,sp
movl $1,r0
jmp *(r1)
lj1: .asciz "longjmp"
SHAR_EOF
fi # end of overwriting check
if test -f 'chq.c'
then
echo shar: will not over-write existing file "'chq.c'"
else
cat << \SHAR_EOF > 'chq.c'
/* $Header: chq..c,v 3.3 86/11/03 12:34:56 gil Exp $ */
/*
* $Log: chq.c,v $
* Revision 3.3 86/11/03 12:34:56 gil
* buffered channels and special channels are wrapped within 'ifdefs' for
* flexible configuration.
*
* Revision 3.2 86/11/03 11:08:21 gil
* this version supports buffered channel.
*
* Revision 3.1 86/11/01 15:42:53 gil
* *** empty log message ***
*
*/
#include <stdio.h>
#include "conf.h"
#include "process.h"
#include "chan.h"
IO(ch, tm)
Channel *ch;
int tm;
{
if (IsTime(ch)) {
debug("[%d] read time\n",
ch->ch_read.b_next->b_proc - proctable);
tread(ch, tm);
#ifdef S_VMS
} else if (IsVms(ch)) {
debug("(%d) i/o in vms channel\n", chidof(ch));
VmsIO(ch, tm);
#endif S_VMS
#ifdef S_SYS
} else if (IsSpecial(ch)) { /* this is s UNIX channel */
debug("(%d) i/o in sys channel\n", chidof(ch));
SysIO(ch, tm);
#endif S_SYS
} else
IoMove(ch, tm);
}
IoMove(ch, tm)
Channel *ch;
int tm;
{
IoBlock *rblk, *wblk;
register ri, wi;
register i, n;
int len;
rblk = ch->ch_read.b_next;
wblk = ch->ch_write.b_next;
if (rblk->b_ndata != wblk->b_ndata)
panic("noncompatible receive-send request on channel\n");
n = rblk->b_ndata;
for (i = 0; i < n; i++, ri++, wi++) {
if (rblk->b_data[i].io_len != wblk->b_data[i].io_len)
panic("noncompatible sizes in receive-send\n");
len = rblk->b_data[i].io_len;
NTRACE(TRACE_IO,
("[%d] sent %d bytes from %s to %s", chidof(ch), len,
Pinfo(wblk->b_proc), Pinfo(rblk->b_proc)));
bcopy(wblk->b_data[i].io_data,rblk->b_data[i].io_data, len);
}
ReadDone(ch, tm);
WriteDone(ch, tm);
}
#ifdef S_SYS
SysIO(ch, tm)
Channel *ch;
{
IoBlock *rblk, *wblk;
rblk = ch->ch_read.b_next;
wblk = ch->ch_write.b_next;
if (!rblk)
SysWrite(ch, tm);
else if (!wblk)
SysRead(ch, tm);
else if (rblk->b_proc->p_time < wblk->b_proc->p_time)
SysRead(ch, tm);
else
SysWrite(ch, tm);
}
#endif S_SYS
#ifdef S_VMS
VmsIO(ch, tm)
Channel *ch;
{
IoBlock *rblk, *wblk;
rblk = ch->ch_read.b_next;
wblk = ch->ch_write.b_next;
if (!rblk)
VmsWrite(ch, tm);
else if (!wblk)
VmsRead(ch, tm);
else if (rblk->b_proc->p_time < wblk->b_proc->p_time)
VmsRead(ch, tm);
else
VmsWrite(ch, tm);
}
#endif S_VMS
/* EnterRequest:
* Enter the read/write request into the channel's read/write queue,
*/
EnterRequest(io_list, flags, len, arg_iov, id)
IoBlock *io_list;
IoVec *arg_iov;
{
register IoBlock *blk;
register IoBlock *iob;
register IoBlock *ip;
register i;
blk = new(ioblock);
for (iob = io_list; iob->b_next; iob = iob->b_next)
;
blk->b_next = iob->b_next;
iob->b_next = blk;
blk->b_ndata = len;
blk->b_proc = proc;
blk->b_id = id;
blk->b_data = (IoVec *)calloc(len, sizeof(IoVec));
for(i = 0; i < len; i++)
blk->b_data[i] = *arg_iov++;
/* notice: this means that iov.io_data is passed
: by REFERENCE */
}
ReadDone(ch, time)
Channel *ch;
{
register IoBlock *ip;
ip = ch->ch_read.b_next;
ip->b_proc->p_time = time;
ip->b_proc->p_chid = chidof(ch);
ip->b_proc->p_eventid = 0;
unblock(ip->b_proc, BLOCK_IO);
free(ip->b_data);
ch->ch_read.b_next = ip->b_next;
free(ip);
}
WriteDone(ch, time)
Channel *ch;
{
register IoBlock *ip;
register n;
#ifdef BUFF_CHANS
/* notice: we walk n steps (and not n-1) because the current IO is
* not freed yet. */
for (ip = ch->ch_write.b_next, n = ch->ch_siz;
ip && n > 0;
ip = ip->b_next, n--)
;
if (ip) {
ip->b_proc->p_time = time;
unblock(ip->b_proc, BLOCK_IO);
}
ip = ch->ch_write.b_next;
#else BUFF_CHANS
ip = ch->ch_write.b_next;
ip->b_proc->p_time = time;
unblock(ip->b_proc, BLOCK_IO);
#endif BUFF_CHANS
free(ip->b_data);
ch->ch_write.b_next = ip->b_next;
free(ip);
}
TimeOf(ch)
Channel *ch;
{
/* return -1 if no I/O ready on 'ch', otherwise return the time of the I/O
* operation
*/
register IoBlock *rfirst, *wfirst, *temp;
IoVec *iov;
Expire(ch);
rfirst = ch->ch_read.b_next;
wfirst = ch->ch_write.b_next;
if (IsTime(ch)) {
if (rfirst == NULL)
return -1;
return(rfirst->b_proc->p_time);
}
#ifdef S_SYS
if (IsSpecial(ch)) {
if (rfirst && wfirst)
return (
min(rfirst->b_proc->p_time,wfirst->b_proc->p_time)
);
if (rfirst)
return(rfirst->b_proc->p_time);
if (wfirst)
return(wfirst->b_proc->p_time);
return -1;
}
#endif S_SYS
if (!rfirst :: !wfirst) {
return -1;
}
debug("channel %d is ready for I/O\n", chidof(ch));
return (max(wfirst->b_proc->p_time, rfirst->b_proc->p_time));
}
Expire(ch)
Channel *ch;
{
register IoBlock *rfirst;
register IoBlock *Iob;
rfirst = &ch->ch_read;
while (rfirst->b_next &&
rfirst->b_next->b_next->b_id &&
rfirst->b_next->b_proc->p_eventid != rfirst->b_next->b_id)
{
Iob = rfirst->b_next;
rfirst->b_next = Iob->b_next;
free(Iob->b_data);
free(Iob);
}
}
Size(Ioq)
register IoBlock *Ioq;
{
register i;
for (i = 0; Ioq; Ioq = Ioq->b_next, i++)
;
return i;
}
SHAR_EOF
fi # end of overwriting check
if test -f 'stck.c'
then
echo shar: will not over-write existing file "'stck.c'"
else
cat << \SHAR_EOF > 'stck.c'
static char rcsid[] = "$Header: stck.c,v 3.2 86/11/03 12:35:11 gil Exp $";
/*
* $Log: stck.c,v $
* Revision 3.2 86/11/03 12:35:11 gil
* buffered channels and special channels are wrapped within 'ifdefs' for
* flexible configuration.
*
* Revision 3.1 86/11/01 15:45:04 gil
* A cleaner version, with timeout forced before each synchronization event.
*
* Revision 2.1 86/10/30 18:15:02 gil
* This version was submitted for the project. It is free of all major bugs.
*
* Revision 1.1 86/01/04 14:49:05 gil
* Initial revision
*
*/
#include <stdio.h>
#include "conf.h"
#include "process.h"
caddr_t StackBase;
int StackReserve = 128;
Stack NextStack;
extern kmode;
#ifdef vax
StackExpand(addr, sz, ap)
caddr_t addr, ap;
{
register caddr_t r11, r10, r9;
int i;
Stack s, NewStack();
Kmode_On;
s = proc->p_curstack;
proc->p_curstack = NextStack;
r10 = realtop(proc->p_curstack);
/* printf("stack expand addr: %x sz %d ap %x\n", addr, sz, ap); */
write(1, "#", 1);
asm("movl r10,sp")
/* call to functions will be executed on the new stack from this point */
if(proc->p_curstack.s_size < (i = sz + StackReserve * 2)) {
proc->p_curstack = NewStack(i);
r10 = realtop(proc->p_curstack);
asm("movl r10,sp")
} else
NextStack = NewStack(0);
SetStack(&(proc->p_curstack));
Kmode_Off;
r10 = ap;
r9 = addr;
asm("callg (r10),(r9)")
Kmode_On;
FreeStack(proc->p_curstack);
proc->p_curstack = s;
SetStack(&(proc->p_curstack));
Kmode_Off;
}
#else
StackExpand() {}
#endif
SetStack(s)
register Stack *s;
{
StackBase = s->s_bottom;
}
#ifdef notdef
stacktrace() {
register r12, r11;
r12 = 0;
#ifdef tahoe
asm("moval (sp),r12")
asm("movl fp,r11")
#else vax
asm("movl sp, r11")
asm("movl fp, r10")
#endif
fprintf(stderr, "proc: %d base: %x top: 0x%x sp: 0x%x fp: 0x%x used: %d\n",
proc->p_pid, proc->p_stack.s_bottom,
realtop(proc->p_stack), r12, r11, realtop(proc->p_stack)-r12);
}
#endif
SHAR_EOF
fi # end of overwriting check
if test -f 'test.c'
then
echo shar: will not over-write existing file "'test.c'"
else
cat << \SHAR_EOF > 'test.c'
static char rcsid[] = "$Header: test.c,v 3.1 86/11/01 15:45:06 gil Exp $";
/*
* $Log: test.c,v $
* Revision 3.1 86/11/01 15:45:06 gil
* A cleaner version, with timeout forced before each synchronization event.
*
* Revision 2.1 86/10/30 18:15:05 gil
* This version was submitted for the project. It is free of all major bugs.
*
* Revision 1.1 86/01/04 14:49:07 gil
* Initial revision
*
*/
test(){}
SHAR_EOF
fi # end of overwriting check
if test -f 'vmschan.c'
then
echo shar: will not over-write existing file "'vmschan.c'"
else
cat << \SHAR_EOF > 'vmschan.c'
static char *rcsid = "$Header: vmschan.c,v 3.2 86/11/03 12:35:16 gil Exp $";
#include <stdio.h>
#include "conf.h"
#include "process.h"
#include "chan.h"
#include <sys/ioctl.h>
#include "vmsio.h"
#define IsAtty isatty
extern char *calloc();
#ifdef S_VMS
chat(chid, vmsfd)
{
Channel *ch;
ch = chanof(chid);
ch->ch_flags = CH_VMS;
ch->ch_fd = vmsfd;
}
VmsInit(av)
char **av;
{
static char vmsbuf[256];
while(*av) {
strcat(vmsbuf, *av);
if(*++av == NULL)
break;
strcat(vmsbuf, " ");
}
StdFile[C_Parameters].vms_stat = ARGSTR;
StdFile[C_Parameters].vms_name = vmsbuf;
StdFile[C_Keyboard].vms_stat = NORMAL;
StdFile[C_Keyboard].vms_fp = stdin;
StdFile[C_Screen].vms_stat = NORMAL;
StdFile[C_Screen].vms_fp = stdout;
}
VmsWrite(ch, tm)
Channel *ch;
{
IoBlock *wblk;
IoVec *vv;
register i;
int len;
VmsChan *vc;
vc = VFile(ch->ch_fd);
wblk = ch->ch_write.b_next;
vv = wblk->b_data;
len = wblk->b_ndata;
for(i = 0; i < len; i++, vv++) {
if(vv->io_len != WORDSIZE)
panic("non word messages are not alloud in Vms\n");
Vwrite(vc, *vv->io_data);
}
WriteDone(ch, tm);
}
VmsRead(ch, tm)
Channel *ch;
{
IoBlock *rblk;
IoVec *vv;
int len;
register i;
VmsChan *vc;
vc = VFile(ch->ch_fd);
rblk = ch->ch_read.b_next;
vv = rblk->b_data;
len = rblk->b_ndata;
for(i = 0; i < len; i++, vv++) {
if(vv->io_len != WORDSIZE)
panic("non word messages are not alloud in Vms\n");
Vread(vc, vv->io_data);
}
ReadDone(ch, tm);
}
VmsSelect() {
panic("vms select not implemented yet");
return 0;
}
Vread(vc, c)
VmsChan *vc;
int *c;
{
int cnt;
if(vc->vms_message) {
*c = vc->vms_message;
vc->vms_message = 0;
return;
}
if(vc->vms_stat == ARGSTR) {
if((*c = *(vc->vms_name)) == '\0')
*c = V_EndParameterString;
else
vc->vms_name++;
return;
}
if(vc->vms_fp == NULL)
panic("vms: can't read from closed file\n");
if((vc->vms_fp->_flag & _IOREAD) == 0)
panic("vms: file not open for reading\n");
again:
if(vc->vms_fp->_cnt > 0) {
*c = Getc(vc->vms_fp);
return;
}
if(feof(vc->vms_fp)) {
*c = V_EndFile;
return;
}
if(IsAtty(vc->vms_fp)) {
do
ioctl(fileno(vc->vms_fp), FIONREAD, &cnt);
while(cnt == 0 && vc->vms_fp->_cnt == 0 && Swtch());
goto again;
} else
*c = Getc(vc->vms_fp);
}
Swtch() {
swtch();
return 1;
}
Getc(fp)
FILE *fp;
{
int c;
if((c = getc(fp)) == EOF) {
if(ferror(fp))
c = E_ReadFailed;
else
c = V_EndFile;
}
else if(c == '\n')
c = V_EndRecord;
return c;
}
Flush(vc)
VmsChan *vc;
{
fflush(vc->vms_fp);
if(ferror(vc->vms_fp))
vc->vms_message = E_WriteFailed;
else
vc->vms_message = V_NextRecord;
}
Vwrite(vc, c)
VmsChan *vc;
{
if(c < 0)
goto control;
write:
if(vc->vms_stat == NORMAL) {
if(vc->vms_fp == NULL)
panic("try to write on a closed file\n");
putc(c, vc->vms_fp);
if(c == '\n')
Flush(vc);
} else
if(vc->vms_stat == FILENAME)
AddC(vc, c);
return;
control:
switch (c) {
case V_EndRecord:
c = '\n';
goto write;
case V_NextRecord:
break;
case V_EndBuffer:
if(vc->vms_fp == NULL)
panic("flushing a closed file\n");
Flush(vc);
break;
case V_OpenForRead:
vc->vms_message = V_OpenForRead;
vc->vms_stat = FILENAME;
vc->vms_name = calloc(256, 1); /* XXX */
break;
case V_OpenForWrite:
vc->vms_message = V_OpenForWrite;
vc->vms_stat = FILENAME;
vc->vms_name = calloc(256, 1); /* XXX */
break;
case V_EndName:
OpenFile(vc);
break;
case V_CloseFile:
CloseFile(vc);
break;
case V_EndFile:
Flush(vc);
break;
default:
panic("bad request\n");
}
}
OpenFile(vc)
VmsChan *vc;
{
char *ms;
if(vc->vms_message == V_OpenForRead)
ms = "r";
else
ms = "w";
vc->vms_fp = fopen(vc->vms_name+1, ms);
if(vc->vms_fp == NULL)
vc->vms_message = (vc->vms_message == V_OpenForRead) ?
E_InputFileNotOpened :
E_OutputFileNotCreated;
else
vc->vms_message = V_OpenedOK;
vc->vms_stat = NORMAL;
free(vc->vms_name);
}
AddC(vc, c)
VmsChan *vc;
{
vc->vms_name[++(vc->vms_name[0])] = c;
}
CloseFile(vc)
VmsChan *vc;
{
if(vc->vms_fp == NULL)
panic("trying to close a closed file\n");
fclose(vc->vms_fp);
vc->vms_message = V_ClosedOK;
vc->vms_fp = NULL;
}
#endif S_VMS
SHAR_EOF
fi # end of overwriting check
if test -f 'chan.c'
then
echo shar: will not over-write existing file "'chan.c'"
else
cat << \SHAR_EOF > 'chan.c'
static char rcsid[] = "$Header: chan.c,v 3.4 86/11/03 12:34:21 gil Exp $";
/*
: $Header: chan.c,v 3.4 86/11/03 12:34:21 gil Exp $
*/
/* $Log: chan.c,v $
* Revision 3.4 86/11/03 12:34:21 gil
* buffered channels and special channels are wrapped within 'ifdefs' for
* flexible configuration.
*
* Revision 3.3 86/11/03 11:08:08 gil
* this version supports buffered channel.
*
* Revision 3.2 86/11/02 09:37:03 gil
* fixed the race (Kmode_On should be BEFORE resched).
*
* Revision 3.1 86/11/01 15:48:04 gil
* A cleaner version, with timeout forced before each synchronization event.
*
* Revision 2.1 86/10/30 18:14:49 gil
* This version was submitted for the project. It is free of all major bugs.
*
* Revision 1.4 86/08/04 17:24:35 gil
* 1. fixed few bugs
* 2. change format of tracing messages
*
* Revision 1.3 86/05/29 10:28:49 gil
* this version fits the new ready-requests-queue mechanism.
*
*/
#include <stdio.h>
#include "conf.h"
#include "process.h"
#include "chan.h"
Channel chans[MAX_CHANS];
Channel *free_chans;
extern char *calloc();
int Eventid = 1;
int time_ch; /* keep the special time channel */
InitChans() {
register i, j;
for(i = 0, j = MAX_CHANS - 1; i < j; i++)
chans[i].ch_nxt = &chans[i+1];
chans[j].ch_nxt = NULL;
free_chans = chans;
}
chopen(siz)
{
register Channel *ch;
Kmode_On;
if (free_chans == NULL) {
panic("no more channels\n");
/*NOTREACHED*/
}
ch = free_chans;
free_chans = free_chans->ch_nxt;
Kmode_Off;
TRACE(TRACE_IO, ("opened %d(%d)", ch-chans, siz));
ch->ch_siz = siz;
ch->ch_read.b_next = NULL;
ch->ch_write.b_next = NULL;
return (ch - chans);
}
chclose(chid) {
register Channel *ch;
Kmode_On;
if (chid < 0 :: chid >= MAX_CHANS)
panic("bad channel\n");
ch = &chans[chid];
ch->ch_nxt = free_chans;
free_chans = ch;
ch->ch_read.b_next = 0;
ch->ch_write.b_next = 0;
TRACE(TRACE_IO, ("closed %d", chid));
Kmode_Off;
}
chread(chid, flags, len, iov)
IoVec iov;
{
register Channel *ch;
register tm;
ch = chanof(chid);
timesync(proc);
TRACE(TRACE_IO, ("read on %d", chid));
if (IsTime(ch) && (flags & BD_FAFTER)) {
proc->p_time =
max(proc->p_time, *((int *)(iov.io_data)));
timewrite(proc);
return;
}
Kmode_On;
resched(0);
EnterRequest(&(ch->ch_read), flags, len, &iov, 0);
if ((tm = TimeOf(ch)) >= 0)
IO(ch, tm);
else
block(proc, BLOCK_IO);
Kmode_Off;
}
chwrite(chid, flags, len, iov)
IoVec iov;
{
register Channel *ch;
register tm;
ch = chanof(chid);
timesync(proc);
TRACE(TRACE_IO, ("write on %d", chid));
Kmode_On;
resched(0);
EnterRequest(&(ch->ch_write), flags, len, &iov, 0);
if ((tm = TimeOf(ch)) >= 0)
IO(ch, tm);
#ifdef BUFF_CHANS
else if (!ch->ch_siz :: Size(ch->ch_write.b_next) > ch->ch_siz)
#else
else
#endif
block(proc, BLOCK_IO);
Kmode_Off;
}
char *
chselect(nargs, arg1)
{
struct IoReq {
int chid;
int nret; /* saved data buf length */
int flags;
int len;
IoVec iov;
/* Saved data [nret*4] */
} *ap = (struct IoReq *)&arg1, *cp = ap;
Channel *ch;
/*
: This requires explanation:
: We push quintets of < chid, nret, flags, len, iov > as accepted
: by 'chread'/'chwrite'. the problem is the 'iov' is actually a vector
: of struct IoVec, and its length is given by 'len', and at the end of
: each quintet is a data-buffer of length 'nret' * intsize.
: So, when we advance to next quintet, the increment is of dynamic size,
: which is:
: sizeof (chid)
: + sizeof (flags)
: + sizeof (len)
: + sizeof (nret)
: + len * sizeof (iov)
: + nret * sizeof (int)
*/
register i, n;
int ret;
char *p;
char b[5];
static char buf[512];
Channel *chose = NULL;
Kmode_On;
Eventid++;
sprintf(buf, "select on:");
proc->p_eventid = Eventid;
timesync(proc);
resched(1); /* let all the write-requests to get ready */
resched(1); /* let all the write-requests be acutally delivered */
for(n = 1, i = nargs; i > 0; i--) {
sprintf(b, " %d", cp->chid);
strcat(buf, b);
ch = chanof(cp->chid);
EnterRequest(&(ch->ch_read), cp->flags, cp->len,
&(cp->iov), Eventid);
if (TimeOf(ch) >= 0) {
if ((random() & MASKR) < (R / (float)n))
/* first one alwaysgets chosen */
chose = ch;
n++;
}
cp = (struct IoReq *) ((char *)cp +
sizeof(IoVec) * (cp->len-1) +
cp->nret * sizeof(int));
cp++;
}
TRACE(TRACE_IO, (buf));
if (chose != NULL)
IO(chose, TimeOf(chose));
else
block(proc, BLOCK_IO);
for(cp = ap, i = nargs; i > 0; i--) {
if(cp->chid == proc->p_chid) {
p = (char *)(cp+1) + (cp->len - 1)* sizeof(IoVec);
debug("chselect: 1st reg is %d\treg mask %x\n",
((int *)p)[1], *((int *)p));
debug("chselect: len = %d\n", cp->len);
TRACE(TRACE_IO,
("channel %d selected", cp->chid));
Kmode_Off;
return p;
}
cp = (struct IoReq *) ((char *)cp +
sizeof(IoVec) * (cp->len-1) +
cp->nret * sizeof(int));
cp++;
}
panic("select channel disappeared");
Kmode_Off;
}
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 parameters.
################################################################################
DESTDIR=/m/usr/gil
CC=cc
AS=as
CFLAGS=-Ih -g
################################################################################
LIB=lsim.a
OBJS= chan.o\
chq.o\
ext.o\
machdep.o\
proto.o\
sched.o\
stck.o\
sysio.o\
test.o\
vmschan.o\
${EMPTY}
$(LIB): $(OBJS)
ar cr $(LIB) $(OBJS)
ranlib $(LIB)
install: $(LIB)
mv $(LIB) $(DESTDIR)/lib/lsim.a
ranlib $(DESTDIR)/lib/lsim.a
# dependencies on header files
################################################################################
chan.c: h/conf.h
chan.c: h/process.h
chan.c: h/chan.h
chq.c: h/conf.h
chq.c: h/process.h
chq.c: h/chan.h
ext.c: h/trace.h
sched.c: h/conf.h
sched.c: h/process.h
stck.c: h/conf.h
stck.c: h/process.h
sysio.c: h/conf.h
sysio.c: h/process.h
sysio.c: h/chan.h
vmschan.c: h/conf.h
vmschan.c: h/process.h
vmschan.c: h/chan.h
vmschan.c: h/vmsio.h
SHAR_EOF
fi # end of overwriting check
if test -f 'machdep.s.vax'
then
echo shar: will not over-write existing file "'machdep.s.vax'"
else
cat << \SHAR_EOF > 'machdep.s.vax'
# set/long jmp, no documatation since the source got lost, this is a
# disassembly.
.globl _SetJmp
_SetJmp: .word 0x0
movl 4(ap),r1
movq r2,(r1)+
movq r4,(r1)+
movq r6,(r1)+
movq r8,(r1)+
movq r10,(r1)+
movq 8(fp),(r1)+
moval 4(ap),(r1)+
movl 16(fp),(r1)+
movl $0,r0
ret
.globl _LongJmp
_LongJmp: .word 0x0
movl 4(ap),r1
movq (r1)+,r2
movq (r1)+,r4
movq (r1)+,r6
movq (r1)+,r8
movq (r1)+,r10
movq (r1)+,ap
movl (r1)+,sp
movl $1,r0
jmp *(r1)
SHAR_EOF
fi # end of overwriting check
if test -f 'sched.c'
then
echo shar: will not over-write existing file "'sched.c'"
else
cat << \SHAR_EOF > 'sched.c'
static char rcsid[] = "$Header: sched.c,v 3.3 87/02/17 10:55:41 gil Exp $";
/*
* $Log: sched.c,v $
* Revision 3.3 87/02/17 10:55:41 gil
* Eventid removed.
*
* Revision 3.2 86/11/03 12:35:07 gil
* buffered channels and special channels are wrapped within 'ifdefs' for
* flexible configuration.
*
* Revision 3.1 86/11/01 15:42:58 gil
* *** empty log message ***
*
* Revision 2.1 86/10/30 18:14:59 gil
* This version was submitted for the project. It is free of all major bugs.
*
* Revision 1.6 86/07/07 17:08:34 gil
* Cleaner version.
* Removed cpu clock, sched and unused variables.
*
* Revision 1.5 86/07/07 16:47:12 gil
* Working version.
*
* Revision 1.3 86/03/24 14:55:52 gil
* added time synchronization for waiting processes.
*
* Revision 1.2 86/03/17 13:50:58 gil
* *** empty log message ***
*
*/
#include <stdio.h>
#include <sys/time.h>
#include "conf.h"
#include "process.h"
#define max(a, b) ((a) > (b) ? (a) : (b))
Process *proc;
/* dummy-firsts for: */
Process wdummy, /* wait-queue */
rdummy, /* run-queue */
fdummy; /* free-queue */
int kmode;
extern char *malloc();
#ifdef vax
#define savefp() asm(" movl 12(fp), r11")
#define saveap() asm(" movl 8(fp), r11")
#else tahoe
#define savefp() asm(" movl (fp), r12")
#endif
Process *
nextrun()
{
Process *run;
run = runq->p_nxt;
if (run == NULL)
Deadlock();
return run;
}
swtch() {
register caddr_t fp; /* must be r11(vax) r12(tahoe) */
register Process *p;
int savedkmode = 0;
p = nextrun();
savefp();
if(proc && !StackMask(proc))
panic("Process Stack Underflow");
if(p == proc) /* no context switching is done - return */
return;
if(proc != NULL)
if(save(proc)) { /* save status */
debug("start %d with kmode %d\n",
proc-proctable, savedkmode);
return;
}
if(!StackMask(p))
panic("Process %s Stack Damaged", Pinfo(p));
TRACE(TRACE_CSW, ("switching to %s", Pinfo(p)));
resume(p); /* transfer control to p - return on previous
: line... */
}
save(p)
Process *p;
{
p->p_kmode = kmode;
return SetJmp(&(p->p_save));
}
resume(p)
Process *p;
{
debug("resuming %d pc %x\n", (p - proctable), p->p_save.st_pc);
proc = p;
SetStack(&(proc->p_curstack));
kmode = p->p_kmode;
sigsetmask(0);
LongJmp(&(p->p_save));
/*NOTREACHED*/
}
/* tick - interupt routine, called on each clock tick. */
tick() {
if (kmode) {
sigsetmask(0);
return;
}
Kmode_On;
resched(0);
debug("kmode: %d\n", kmode);
Kmode_Off;
return;
}
resched(pri)
{
if (proc != NULL) {
timesync(proc);
FreeMe(proc);
if (pri)
PriEnterMe(proc, runq);
else
EnterMe(proc, runq);
}
swtch();
}
int DefaultStackSize = STACK_SIZE;
Stack
NewStack(sz)
{
Stack s;
if(sz == 0)
sz = DefaultStackSize;
s.s_bottom = malloc(sz);
if(s.s_bottom == NULL)
panic("alloc stack failed\n");
s.s_bottom[0] = SMASK;
s.s_size = sz;
return s;
}
FreeStack(s)
Stack s;
{
free(s.s_bottom);
}
Process *
freeslot() {
register Process *p;
p = freeq->p_nxt;
if(p == NULL)
panic("no more process\n");
freeq->p_nxt = p->p_nxt;
p->p_nxt = NULL;
p->p_prv = NULL;
return p;
}
newproc(addr)
caddr_t addr;
{
register caddr_t save; /* Must be in r11 (r12 on tahoe) */
/**** Don't use any other register for local storage ****/
Process *p, *q;
Kmode_On;
p = proc;
p->p_nsons++;
q = freeslot();
q->p_pid = genpid();
q->p_ppid = p->p_pid;
q->p_parent = p;
q->p_nzomb = q->p_nsons = q->p_sontime = 0;
timesync(p);
q->p_time = p->p_time; /* start with father's time */
q->p_flags = 0;
q->p_stack = NewStack(0);
q->p_curstack = q->p_stack;
SetJmp(&(q->p_save));
q->p_save.st_dp = dispof(q->p_stack);
#ifdef vax
saveap();
q->p_save.st_ap = save;
#endif
savefp();
q->p_save.st_fp = save;
q->p_save.st_sp = topof(q->p_stack);
q->p_save.st_pc = addr;
q->p_kmode = 0;
/* Initialize the display */
bcopy(bdispof(p->p_stack), bdispof(q->p_stack), DISPSIZE);
timewrite(q);
TRACE(TRACE_FORK, ("create %d at 0x%x", q->p_pid, addr));
setrun(q);
Kmode_Off;
return;
}
endproc() {
Kmode_On;
timesync(proc);
TRACE(TRACE_FORK, ("ended"));
debug("endproc %d\n", proc - proctable);
FreeMe(proc);
if(proc->p_parent) {
proc->p_parent->p_nsons--;
WakePapa(proc->p_parent);
/* Dalia was slightly drunk when she wrote this.
: please don't change */
}
if (proc->p_nsons > 0 :: proc->p_nzomb > 0) {
proc->p_flags := PF_ZOMB;
if(proc->p_parent)
proc->p_parent->p_nzomb++;
while(proc->p_nsons > 0 :: proc->p_nzomb > 0)
block(proc, BLOCK_CHILD);
if(proc->p_parent)
proc->p_parent->p_nzomb--;
WakePapa(proc->p_parent);
}
EnterMe(proc, freeq);
FreeStack(proc->p_stack);
proc = NULL;
swtch();
/*NOTREACHED*/
}
setrun(p)
Process *p;
{
debug("setrun: %d\n", p-proctable);
p->p_stat = RUNNING;
EnterMe(p, runq);
}
WakePapa(papa)
Process *papa;
{
if(papa) {
papa->p_sontime = max(papa->p_sontime, proc->p_time);
if(papa->p_nsons == 0)
unblock(papa, BLOCK_CHILD);
}
}
waitall() {
Kmode_On;
timesync(proc);
while (proc->p_nsons > 0)
block(proc, BLOCK_CHILD);
proc->p_time = proc->p_sontime;
proc->p_sontime = 0;
timewrite(proc);
Kmode_Off;
}
genpid() {
static pid = 1;
return pid++;
}
extern Stack NextStack;
initproc() {
register j, i;
Kmode_On;
NextStack = NewStack(0);
for(i = 1, j = nproc - 1; i < j; i++) {
proctable[i].p_nxt = &proctable[i+1];
proctable[i+1].p_prv = &proctable[i];
}
proctable[j].p_nxt = NULL;
freeq = &fdummy;
fdummy.p_nxt = &proctable[1];
proctable[1].p_prv = freeq;
wdummy.p_nxt = wdummy.p_prv = NULL;
waitq = &wdummy;
proc = &proctable[0];
runq = &rdummy;
rdummy.p_nxt = proc;
rdummy.p_prv = NULL;
proc->p_prv = runq;
Kmode_Off;
}
block(p, block_stat)
Process *p;
enum pstat block_stat;
{
TRACE(TRACE_BLOCK, ("blocked, on %s", BlockStat(block_stat)));
debug("block %d\n", p - proctable);
p->p_stat = block_stat;
FreeMe(p);
EnterMe(p, waitq);
if (proc == p)
swtch();
}
unblock(p, block_stat)
Process *p;
enum pstat block_stat;
{
debug("unblock %d\n", p - proctable);
TRACE(TRACE_BLOCK,
("unblock %s, on %s", Pinfo(p), BlockStat(block_stat)));
if (p->p_stat == block_stat) {
timewrite(p);
FreeMe(p);
setrun(p);
}
}
EnterMe(pp, queue)
Process *pp, *queue;
{
register n;
register Process *q, *chose;
for (q = queue;
q->p_nxt && q->p_nxt->p_time < pp->p_time;
q = q->p_nxt)
;
for (chose = q, n = 2;
q->p_nxt && q->p_nxt->p_time == pp->p_time;
q = q->p_nxt, n++)
if ((random() & MASKR) < (R / (float)n))
chose = q->p_nxt;
pp->p_nxt = chose->p_nxt;
pp->p_prv = chose;
if (chose->p_nxt)
chose->p_nxt->p_prv = pp;
chose->p_nxt = pp;
}
PriEnterMe(pp, queue)
Process *pp, *queue;
{
register Process *q;
for (q = queue;
q->p_nxt && q->p_nxt->p_time <= pp->p_time;
q = q->p_nxt)
;
pp->p_nxt = q->p_nxt;
pp->p_prv = q;
if (q->p_nxt)
q->p_nxt->p_prv = pp;
q->p_nxt = pp;
}
FreeMe(p)
Process *p;
{
register Process *q;
q = p->p_nxt;
if(p->p_prv != NULL)
p->p_prv->p_nxt = q;
if(q != NULL)
q->p_prv = p->p_prv;
}
Deadlock() {
if (waitq->p_nxt != NULL)
panic("deadlock\n");
printf("process terminated successfully\n");
exit(0);
}
timesync(p)
Process *p;
{
p->p_time = *(int *)timeof(p->p_stack);
debug("[%d] time %d\n", proc-proctable, p->p_time);
}
timewrite(p)
Process *p;
{
*(int *) timeof(p->p_stack) = p->p_time;
}
SHAR_EOF
fi # end of overwriting check
if test -f 'proto.c'
then
echo shar: will not over-write existing file "'proto.c'"
else
cat << \SHAR_EOF > 'proto.c'
static char rcsid[] = "$Header: proto.c,v 3.2 86/11/03 12:35:04 gil Exp $";
/*
* $Log: proto.c,v $
* Revision 3.2 86/11/03 12:35:04 gil
* buffered channels and special channels are wrapped within 'ifdefs' for
* flexible configuration.
*
* Revision 3.1 86/11/01 15:48:08 gil
* A cleaner version, with timeout forced before each synchronization event.
*
* Revision 2.1 86/10/30 18:14:57 gil
* This version was submitted for the project. It is free of all major bugs.
*
* Revision 1.1 86/01/04 14:49:02 gil
* Initial revision
*
*/
#include <stdio.h>
#include <signal.h>
#include <sys/time.h>
#include "conf.h"
#include "process.h"
extern tick();
#define ALOT (512*1024)
static char display[DISPSIZE+COUNTSIZE];
extern dflag;
int qflag;
extern DefaultStackSize, StackReserve;
char *progname;
int CommandsTime;
main(ac, av)
char **av;
{
register char *r11, i = 25;
int oc_main();
progname = av[0];
tracef = stderr;
setlinebuf(stderr);
while(**++av == '-')
switch(*++*av) {
case 'd':
dflag++;
break;
case 's':
{
int s = atoi(++*av);
if(s < DISPSIZE+64) {
fprintf(stderr, "%d: Stack too small\n", s);
break;
}
debug("StackSize: %d\n", s);
DefaultStackSize = s;
break;
}
case 'r':
{
int s = atoi(++*av);
if(s < 0) {
fprintf(stderr, "Cannot UnReserve stack\n");
break;
}
debug("ReserveStack: %d\n", s);
StackReserve = s;
break;
}
case 'i':
i = atoi(++*av);
if(i < 1) {
fprintf(stderr, "%d: Bad interval\n",
i);
i = 25;
}
debug("Will interupt %d times/sec\n", i);
break;
case 't':
if(*++*av == '\0')
tracer := TRACE_ALL;
else
tracer := tflag(*av);
break;
case 'q':
qflag++;
break;
case 'f':
if(*++*av == '\0')
tracef = stdout;
else {
if((tracef = fopen(*av, "w")) == NULL) {
fprintf(stderr,
"Cannot open trace file ");
fflush(stderr);
perror(*av);
exit(1);
}
}
break;
default:
fprintf (stderr, "%c: Unknown option\n", **av);
break;
}
srandom((int)time(0));
initproc();
InitChans();
#ifdef S_VMS
VmsInit(av);
#endif S_VMS
signal(SIGVTALRM, tick);
inton(i);
r11 = &display[DISPSIZE+COUNTSIZE];
proc->p_stack.s_bottom = r11 - ALOT;
proc->p_stack.s_size = ALOT;
newproc(oc_main);
test();
waitall();
if(!qflag)
fprintf(stderr,
"Executed %d instructions in %d time\n",
CommandsTime, proctable[0].p_time);
exit(0);
}
intoff() {
struct itimerval it;
it.it_interval.tv_sec = it.it_value.tv_usec = 0;
it.it_value = it.it_interval;
setitimer(ITIMER_VIRTUAL, &it, 0);
}
int Ival; /* IPS */
inton(t) {
struct itimerval it;
Ival = t;
it.it_interval.tv_usec = 1000000/t;
it.it_interval.tv_sec = 0;
it.it_value = it.it_interval;
setitimer(ITIMER_VIRTUAL, &it, 0);
}
panic(s, a1, a2, a3, a4) {
fprintf(stderr, "Panic: %s: ", Pinfo(proc));
fprintf(stderr, s, a1, a2, a3, a4);
putc('\n', stderr);
exit(1);
}
tflag(s)
char *s;
{
int f = 0;
while(*s) {
switch (*s) {
case 'c':
f := TRACE_CSW;
break;
case 'f':
case 's':
f := TRACE_FORK;
break;
case 'b':
f := TRACE_BLOCK;
break;
case 'a':
f := TRACE_ALLIO;
break;
case 'i':
f := TRACE_IO;
break;
default:
fprintf(stderr, "%c: unknown trace flag\n",
*s);
break;
}
s++;
}
return f;
}
int tracer;
char *tstr = "\1CSW\0\2FORK\0\4BLOCK\0\010TIME\0\020IO\0\040MOREIO\0\100CPUT";
pflg(flg)
{
fprintf(tracef, "%s", Pinfo(proc));
nflg(flg);
}
sflg(flg)
{
fprintf(tracef, "[ Sys ]");
nflg(flg);
}
char *
Pinfo(p)
Process *p;
{
static char buf[3][128];
static use;
register char *s;
s = buf[use++%3];
if(p)
sprintf(s, "[%-3d,%2d]", p->p_pid, p->p_time);
else
sprintf(s, "[ Nop ]");
}
char *
BlockStat(b)
enum pstat b;
{
switch (b) {
case BLOCK_CHILD:
return "child event";
case BLOCK_IO:
return "I/O event";
case RUNNING:
return "Running???!!!";
default:
return "Unknown Status";
}
}
nflg(flg)
{
register char *s;
register once = 0, c;
putc('<', tracef);
for(s = tstr; *s; s++) {
c = *s;
if(c & flg) {
if(once)
putc(',', tracef);
once = 1;
while(*++s)
putc(*s, tracef);
} else
while(*++s)
;
}
putc('>', tracef);
putc(' ', tracef);
}
/*VARARGS*/
ptrace(fmt, a1, a2, a3, a4, a5, a6)
char *fmt;
{
fprintf(tracef, fmt, a1, a2, a3, a4, a5, a6);
putc('\n', tracef);
}
SHAR_EOF
fi # end of overwriting check
if test -f 'sched.s'
then
echo shar: will not over-write existing file "'sched.s'"
else
cat << \SHAR_EOF > 'sched.s'
.data
.data
_rcsid:.long 0x61654824
.long 0x3a726564
.long 0x68637320
.long 0x632e6465
.long 0x3320762c
.long 0x3820322e
.long 0x31312f36
.long 0x2033302f
.long 0x333a3231
.long 0x37303a35
.long 0x6c696720
.long 0x70784520
.long 0x2420
.comm _runq,4
.comm _waitq,4
.comm _freeq,4
.comm _proctable,32768
.comm _tracef,4
.comm _proc,4
.comm _wdummy,128
.comm _rdummy,128
.comm _fdummy,128
.comm _kmode,4
.text
LL0:.align 1
.globl _nextrun
.set L41,0x0
.data
.text
_nextrun:.word L41
subl2 $4,sp
movl _runq,r0
movl 44(r0),-4(fp)
jneq L45
calls $0,_Deadlock
L45:movl -4(fp),r0
ret
.align 1
.globl _swtch
.data 1
L57:.ascii "start %d with kmode %d\12\0"
.text
.data 1
L61:.ascii "switching to %s\0"
.text
.set L48,0x800
.data
.text
_swtch:.word L48
subl2 $4,sp
clrl -4(fp)
calls $0,_nextrun
movl r0,r11
cmpl r11,_proc
jneq L52
ret
L52:tstl _proc
jeql L53
pushl _proc
calls $1,_save
tstl r0
jeql L53
pushl -4(fp)
subl3 $_proctable,_proc,r0
divl3 $128,r0,-(sp)
pushal L57
calls $3,_debug
ret
L53:jlbc _tracer,L58
pushl $1
calls $1,_pflg
pushl r11
calls $1,_Pinfo
pushl r0
pushal L61
calls $2,_ptrace
L58:pushl r11
calls $1,_resume
ret
.align 1
.globl _save
.set L63,0x0
.data
.text
_save:.word L63
movl 4(ap),r0
movl _kmode,108(r0)
addl3 $52,4(ap),-(sp)
calls $1,_SetJmp
ret
.align 1
.globl _resume
.data 1
L72:.ascii "resuming %d pc %x\12\0"
.text
.set L68,0x0
.data
.text
_resume:.word L68
movl 4(ap),r0
pushl 104(r0)
subl3 $_proctable,r0,r0
divl3 $128,r0,-(sp)
pushal L72
calls $3,_debug
movl 4(ap),_proc
addl3 $120,_proc,-(sp)
calls $1,_SetStack
movl 4(ap),r0
movl 108(r0),_kmode
pushl $0
calls $1,_sigsetmask
addl3 $52,4(ap),-(sp)
calls $1,_LongJmp
ret
.align 1
.globl _tick
.data 1
L83:.ascii "kmode\72 %d\12\0"
.text
.set L77,0x0
.data
.text
_tick:.word L77
tstl _kmode
jeql L81
pushl $0
calls $1,_sigsetmask
ret
L81:incl _kmode
pushl $0
calls $1,_resched
pushl _kmode
pushal L83
calls $2,_debug
decl _kmode
ret
.align 1
.globl _resched
.set L84,0x0
.data
.align 2
.globl _DefaultStackSize
_DefaultStackSize:.long 8192
.text
_resched:.word L84
tstl _proc
jeql L88
pushl _proc
calls $1,_timesync
pushl _proc
calls $1,_FreeMe
tstl 4(ap)
jeql L91
pushl _runq
pushl _proc
calls $2,_PriEnterMe
jbr L88
L91:pushl _runq
pushl _proc
calls $2,_EnterMe
L88:calls $0,_swtch
ret
.align 1
.globl _NewStack
.data 1
L104:.ascii "alloc stack failed\12\0"
.text
.lcomm L105,8
.set L97,0x0
.data
.text
_NewStack:.word L97
subl2 $8,sp
tstl 4(ap)
jneq L101
movl _DefaultStackSize,4(ap)
L101:pushl 4(ap)
calls $1,_malloc
movl r0,-4(fp)
tstl r0
jneq L102
pushal L104
calls $1,_panic
L102:movl 4(ap),-8(fp)
moval -8(fp),r0
movab L105,r1
movq (r0),(r1)
movab L105,r0
ret
.align 1
.globl _FreeStack
.set L107,0x0
.data
.text
_FreeStack:.word L107
pushl 8(ap)
calls $1,_free
ret
.align 1
.globl _freeslot
.data 1
L118:.ascii "no more process\12\0"
.text
.set L113,0x800
.data
.text
_freeslot:.word L113
movl _freeq,r0
movl 44(r0),r11
jneq L117
pushal L118
calls $1,_panic
L117:movl _freeq,r0
movl 44(r11),44(r0)
clrl 44(r11)
clrl 48(r11)
movl r11,r0
ret
.align 1
.globl _newproc
.data 1
L128:.ascii "create %d at 0x%x\0"
.text
.set L120,0x800
.data
.text
_newproc:.word L120
subl2 $8,sp
incl _kmode
movl _proc,-4(fp)
movl -4(fp),r0
incl 12(r0)
calls $0,_freeslot
movl r0,-8(fp)
calls $0,_genpid
movl r0,*-8(fp)
movl -8(fp),r0
movl *-4(fp),4(r0)
movl -8(fp),r0
movl -4(fp),8(r0)
movl -8(fp),r0
clrl 20(r0)
movl -8(fp),r1
movl 20(r0),12(r1)
movl -8(fp),r0
movl 12(r1),16(r0)
pushl -4(fp)
calls $1,_timesync
movl -4(fp),r0
movl -8(fp),r1
movl 24(r0),24(r1)
movl -8(fp),r0
clrl 28(r0)
pushl $0
calls $1,_NewStack
addl3 $112,-8(fp),r1
movq (r0),(r1)
addl3 $112,-8(fp),r0
addl3 $120,-8(fp),r1
movq (r0),(r1)
addl3 $52,-8(fp),-(sp)
calls $1,_SetJmp
movl -8(fp),r0
movl r0,r1
addl3 112(r1),116(r0),r0
subl2 $4,r0
movl r0,88(r1)
movl 8(fp), r11
movl -8(fp),r0
movl r11,92(r0)
movl 12(fp), r11
movl -8(fp),r0
movl r11,96(r0)
movl -8(fp),r0
movl r0,r1
addl3 112(r1),116(r0),r0
subl2 $68,r0
movl r0,100(r1)
movl -8(fp),r0
movl 4(ap),104(r0)
movl -8(fp),r0
clrl 108(r0)
pushl $64
movl -8(fp),r0
movl r0,r1
addl3 112(r1),116(r0),r0
subl3 $68,r0,-(sp)
movl -4(fp),r0
movl r0,r1
addl3 112(r1),116(r0),r0
subl3 $68,r0,-(sp)
calls $3,_bcopy
pushl -8(fp)
calls $1,_timewrite
jbc $1,_tracer,L127
pushl $2
calls $1,_pflg
pushl 4(ap)
pushl *-8(fp)
pushal L128
calls $3,_ptrace
L127:pushl -8(fp)
calls $1,_setrun
decl _kmode
ret
.align 1
.globl _endproc
.data 1
L136:.ascii "ended\0"
.text
.data 1
L137:.ascii "endproc %d\12\0"
.text
.set L131,0x0
.data
.text
_endproc:.word L131
incl _kmode
pushl _proc
calls $1,_timesync
jbc $1,_tracer,L135
pushl $2
calls $1,_pflg
pushal L136
calls $1,_ptrace
L135:subl3 $_proctable,_proc,r0
divl3 $128,r0,-(sp)
pushal L137
calls $2,_debug
pushl _proc
calls $1,_FreeMe
movl _proc,r0
tstl 8(r0)
jeql L138
movl 8(r0),r0
decl 12(r0)
movl _proc,r0
pushl 8(r0)
calls $1,_WakePapa
L138:movl _proc,r0
tstl 12(r0)
jgtr L9999
tstl 16(r0)
jleq L140
L9999:movl _proc,r0
bisl2 $1,28(r0)
movl _proc,r0
tstl 8(r0)
jeql L142
movl 8(r0),r0
incl 16(r0)
jbr L142
L9998:pushl $0
pushl _proc
calls $2,_block
L142:movl _proc,r0
tstl 12(r0)
jgtr L9998
tstl 16(r0)
jgtr L9998
tstl 8(r0)
jeql L145
movl 8(r0),r0
decl 16(r0)
L145:movl _proc,r0
pushl 8(r0)
calls $1,_WakePapa
L140:pushl _freeq
pushl _proc
calls $2,_EnterMe
movl _proc,r0
subl2 $8,sp
movq 112(r0),(sp)
calls $2,_FreeStack
clrl _proc
calls $0,_swtch
ret
.align 1
.globl _setrun
.data 1
L150:.ascii "setrun\72 %d\12\0"
.text
.set L146,0x0
.data
.text
_setrun:.word L146
subl3 $_proctable,4(ap),r0
divl3 $128,r0,-(sp)
pushal L150
calls $2,_debug
movl 4(ap),r0
movl $2,40(r0)
pushl _runq
pushl 4(ap)
calls $2,_EnterMe
ret
.align 1
.globl _WakePapa
.set L151,0x0
.data
.text
_WakePapa:.word L151
tstl 4(ap)
jeql L155
movl 4(ap),r0
movl _proc,r1
cmpl 20(r0),24(r1)
jleq L9997
movl 20(r0),r0
jbr L9996
L9997:movl _proc,r0
movl 24(r0),r0
L9996:movl 4(ap),r1
movl r0,20(r1)
movl 4(ap),r0
tstl 12(r0)
jneq L155
pushl $0
pushl r0
calls $2,_unblock
L155:ret
.align 1
.globl _waitall
.set L159,0x0
.data
.text
_waitall:.word L159
incl _kmode
pushl _proc
calls $1,_timesync
jbr L163
L2000002:pushl $0
pushl _proc
calls $2,_block
L163:movl _proc,r0
tstl 12(r0)
jgtr L2000002
movl r0,r1
movl 20(r0),24(r1)
movl _proc,r0
clrl 20(r0)
pushl _proc
calls $1,_timewrite
decl _kmode
ret
.align 1
.globl _genpid
.data
.align 2
L169:.long 1
.text
.set L165,0x0
.data
.text
_genpid:.word L165
movl L169,r0
incl L169
ret
.align 1
.globl _initproc
.set L172,0xc00
.data
.text
_initproc:.word L172
incl _kmode
pushl $0
calls $1,_NewStack
movq (r0),_NextStack
movl $1,r10
movzbl $255,r11
jbr L178
L2000004:addl3 $1,r10,r0
ashl $7,r0,r0
addl2 $_proctable,r0
ashl $7,r10,r1
movl r0,_proctable+44(r1)
ashl $7,r10,r0
addl2 $_proctable,r0
addl3 $1,r10,r1
ashl $7,r1,r1
movl r0,_proctable+48(r1)
incl r10
L178:cmpl r10,r11
jlss L2000004
ashl $7,r11,r0
clrl _proctable+44(r0)
moval _fdummy,_freeq
moval _proctable+128,_fdummy+44
movl _freeq,_proctable+176
clrl _wdummy+48
movl _wdummy+48,_wdummy+44
moval _wdummy,_waitq
moval _proctable,_proc
moval _rdummy,_runq
movl _proc,_rdummy+44
clrl _rdummy+48
movl _proc,r0
movl _runq,48(r0)
decl _kmode
ret
.align 1
.globl _block
.data 1
L184:.ascii "blocked, on %s\0"
.text
.data 1
L185:.ascii "block %d\12\0"
.text
.set L179,0x0
.data
.text
_block:.word L179
jbc $2,_tracer,L183
pushl $4
calls $1,_pflg
pushl 8(ap)
calls $1,_BlockStat
pushl r0
pushal L184
calls $2,_ptrace
L183:subl3 $_proctable,4(ap),r0
divl3 $128,r0,-(sp)
pushal L185
calls $2,_debug
movl 4(ap),r0
movl 8(ap),40(r0)
pushl 4(ap)
calls $1,_FreeMe
pushl _waitq
pushl 4(ap)
calls $2,_EnterMe
cmpl _proc,4(ap)
jneq L186
calls $0,_swtch
L186:ret
.align 1
.globl _unblock
.data 1
L191:.ascii "unblock %d\12\0"
.text
.data 1
L193:.ascii "unblock %s, on %s\0"
.text
.set L187,0x0
.data
.text
_unblock:.word L187
subl3 $_proctable,4(ap),r0
divl3 $128,r0,-(sp)
pushal L191
calls $2,_debug
jbc $2,_tracer,L192
pushl $4
calls $1,_pflg
pushl 8(ap)
calls $1,_BlockStat
pushl r0
pushl 4(ap)
calls $1,_Pinfo
pushl r0
pushal L193
calls $3,_ptrace
L192:movl 4(ap),r0
cmpl 40(r0),8(ap)
jneq L194
pushl r0
calls $1,_timewrite
pushl 4(ap)
calls $1,_FreeMe
pushl 4(ap)
calls $1,_setrun
L194:ret
.align 1
.globl _EnterMe
.data
.align 2
L207:.double 0d2.56000000000000000000e+02
.text
.set L195,0xe00
.data
.text
_EnterMe:.word L195
subl2 $8,sp
movl 8(ap),r10
jbr L201
L2000006:movl 44(r10),r0
movl 4(ap),r1
cmpl 24(r0),24(r1)
jgeq L200
movl 44(r10),r10
L201:tstl 44(r10)
jneq L2000006
L200:movl r10,r9
movl $2,r11
jbr L204
L2000008:movl 44(r10),r0
movl 4(ap),r1
cmpl 24(r0),24(r1)
jneq L203
calls $0,_random
movzbl r0,r0
cvtld r0,-8(fp)
cvtld r11,r0
divd3 r0,L207,r2
cmpd -8(fp),r2
jgeq L202
movl 44(r10),r9
L202:movl 44(r10),r10
incl r11
L204:tstl 44(r10)
jneq L2000008
L203:movl 4(ap),r0
movl 44(r9),44(r0)
movl 4(ap),r0
movl r9,48(r0)
tstl 44(r9)
jeql L208
movl 44(r9),r0
movl 4(ap),48(r0)
L208:movl 4(ap),44(r9)
ret
.align 1
.globl _PriEnterMe
.set L209,0x800
.data
.text
_PriEnterMe:.word L209
movl 8(ap),r11
jbr L215
L2000010:movl 44(r11),r0
movl 4(ap),r1
cmpl 24(r0),24(r1)
jgtr L214
movl 44(r11),r11
L215:tstl 44(r11)
jneq L2000010
L214:movl 4(ap),r0
movl 44(r11),44(r0)
movl 4(ap),r0
movl r11,48(r0)
tstl 44(r11)
jeql L216
movl 44(r11),r0
movl 4(ap),48(r0)
L216:movl 4(ap),44(r11)
ret
.align 1
.globl _FreeMe
.set L217,0x800
.data
.text
_FreeMe:.word L217
movl 4(ap),r0
movl 44(r0),r11
tstl 48(r0)
jeql L221
movl 48(r0),r0
movl r11,44(r0)
L221:tstl r11
jeql L222
movl 4(ap),r0
movl 48(r0),48(r11)
L222:ret
.align 1
.globl _Deadlock
.data 1
L228:.ascii "deadlock\12\0"
.text
.data 1
L230:.ascii "process terminated successfully\12\0"
.text
.set L223,0x0
.data
.text
_Deadlock:.word L223
movl _waitq,r0
tstl 44(r0)
jeql L227
pushal L228
calls $1,_panic
L227:pushal L230
calls $1,_printf
pushl $0
calls $1,_exit
ret
.align 1
.globl _timesync
.data 1
L236:.ascii "[%d] time %d\12\0"
.text
.set L232,0x0
.data
.text
_timesync:.word L232
movl 4(ap),r0
movl r0,r1
addl3 112(r1),116(r0),r0
movl -4(r0),24(r1)
movl 4(ap),r0
pushl 24(r0)
subl3 $_proctable,_proc,r0
divl3 $128,r0,-(sp)
pushal L236
calls $3,_debug
ret
.align 1
.globl _timewrite
.set L237,0x0
.data
.text
_timewrite:.word L237
movl 4(ap),r0
movl r0,r1
movl r1,r2
addl3 112(r2),116(r1),r1
movl 24(r0),-4(r1)
ret
SHAR_EOF
fi # end of overwriting check
if test -f 'sysio.c'
then
echo shar: will not over-write existing file "'sysio.c'"
else
cat << \SHAR_EOF > 'sysio.c'
static char *rcsid = "$Header: sysio.c,v 3.3 86/11/03 12:35:14 gil Exp $";
#include <stdio.h>
#include "conf.h"
#include "process.h"
#include "chan.h"
#include <sys/uio.h>
#include <sys/ioctl.h>
#include <sys/file.h>
chtime(chid) {
Channel *ch;
ch = chanof(chid);
ch->ch_flags = CH_TIME;
time_ch = chid;
}
tread(ch, time)
Channel *ch;
int time;
{
register IoVec *iov;
IoBlock *blk;
blk = ch->ch_read.b_next;
for (iov = blk->b_data;
iov < &blk->b_data[blk->b_ndata];
iov++) {
if (iov->io_len != sizeof(blk->b_proc->p_time))
debug("time request is longword length\n");
*(int *)iov->io_data = time;
iov++;
}
ReadDone(ch, time);
return 1;
}
#ifdef S_SYS
/* allocate special time channel */
chassign(chid, fd, mode)
{
Channel *ch;
ch = chanof(chid);
ch->ch_flags = CH_SYS;
ch->ch_fd = fd;
if(isatty(fd))
ch->ch_flags := CH_DEV;
}
SysWrite(ch, time)
Channel *ch;
{
IoBlock *wblk;
IoVec *vv;
int l;
register i = 0, m;
int len;
wblk = ch->ch_write.b_next;
vv = wblk->b_data;
len = wblk->b_ndata;
for(i = 0; i < len; i++, vv++) {
m = vv->io_len;
vv->io_len = (int) vv->io_data;
vv->io_data = (char *) m;
}
if(writev(ch->ch_fd, wblk->b_data, len) < 0)
perror("writev");
NTRACE(TRACE_IO,
("[%d] write %d blocks, from %s (UNIX fd=%d)", chidof(ch),
len, Pinfo(wblk->b_proc), ch->ch_fd));
WriteDone(ch, time);
}
SysRead(ch, time)
Channel *ch;
{
IoBlock *rblk;
IoVec *vv;
int l;
register i = 0, m;
int len;
rblk = ch->ch_read.b_next;
vv = rblk->b_data;
len = rblk->b_ndata;
if(IsSpecialDevice(ch)) {
l = 0;
while(vv->io_len > 0 && l <= 0) {
ioctl(ch->ch_fd, FIONREAD, &l);
if(l <= 0)
swtch();
while(l > 0) {
m = min(l, vv->io_len);
read(ch->ch_fd, vv->io_data, m);
vv->io_data += m;
vv->io_len -= m;
l -= m;
if(vv->io_len == 0)
if(++i == len)
break;
else
vv++;
}
}
return;
}
for(i = 0; i < len; i++, vv++) {
m = vv->io_len;
vv->io_len = (int) vv->io_data;
vv->io_data = (char *) m;
}
if(readv(ch->ch_fd, rblk->b_data, len) < 0)
perror("readv");
NTRACE(TRACE_IO,
("[%d] read %d blocks, to %s (UNIX fd=%d)", chidof(ch),
len, Pinfo(rblk->b_proc), ch->ch_fd));
ReadDone(ch, time);
}
SpecialSelect() {
debug("Not implemented yet");
return 0;
}
#endif S_SYS
SHAR_EOF
fi # end of overwriting check
cd ..
# End of shell archive
exit 0
----------end of sim.shar----------
--
-
- Terry Torkelson Internet: ttork%ewu@uunet.uu.net
- Eastern Washington University uucp: uunet!isc-br!ewu!ttork
- tellynet: 509-359-6016ttork@ewu.UUCP (Terry Torkelson) (11/15/90)
----------test.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:
# test
# This archive created: Thu Apr 19 16:54:38 1990
export PATH; PATH=/bin:$PATH
if test ! -d 'test'
then
mkdir 'test'
fi
cd 'test'
if test -f 'semaphore.oc'
then
echo shar: will not over-write existing file "'semaphore.oc'"
else
cat << \SHAR_EOF > 'semaphore.oc'
-- counting semaphore handler using buffered-channels in Occam.
extern proc pnum(value n):
def MAXSEM = 5:
def MAXN = 100: -- maximum size of buffer of semaphores
que sempool(MAXN)[MAXSEM]:
var nsem:
var s:
proc setsem(value v, var sn) =
seq
sn := nsem
nsem := nsem + 1
seq j = [0 for v]
sempool[sn] ! ANY :
proc p(value sn) =
sempool[sn] ? ANY :
proc v(value sn) =
sempool[sn] ! ANY :
seq
setsem(3, s)
-- first run without semahpores
par p = [0 for 2]
seq q = [0 for 10]
pnum(p)
-- then run with semaphores
par i = [0 for 2]
seq k = [0 for 10]
seq
p(s)
pnum(i)
v(s)
SHAR_EOF
fi # end of overwriting check
if test -f 'SEM'
then
echo shar: will not over-write existing file "'SEM'"
else
cat << \SHAR_EOF > 'SEM'
Executed 126 instructions in 66 time
1
1
1
1
1
1
1
1
1
1
0
0
0
0
0
0
0
0
0
0
0
1
0
1
1
0
0
1
0
1
1
0
0
1
1
0
0
1
0
1
SHAR_EOF
fi # end of overwriting check
if test -f 'RAND'
then
echo shar: will not over-write existing file "'RAND'"
else
cat << \SHAR_EOF > 'RAND'
Panic: [8 ,101]: deadlock
5
9
6
6
5
3
5
6
8
1
5
6
1
8
7
2
7
5
9
3
8
6
3
8
7
1
3
3
4
4
9
3
8
5
1
9
5
6
3
4
0
9
8
5
1
3
8
8
3
4
SHAR_EOF
fi # end of overwriting check
if test -f 'TRACE'
then
echo shar: will not over-write existing file "'TRACE'"
else
cat << \SHAR_EOF > 'TRACE'
[0 , 0]<FORK> create 1 at 0x48
[1 , 0]<IO> opened 0(0)
[1 , 0]<IO> opened 1(0)
[1 , 0]<IO> opened 2(0)
[1 , 0]<IO> open channel table at 0x4E4C - 5
[1 , 0]<IO> opened 3(0)
[1 , 0]<IO> opened 4(0)
[1 , 0]<IO> opened 5(0)
[1 , 0]<IO> opened 6(0)
[1 , 0]<IO> opened 7(0)
[1 , 0]<IO> opened 8(0)
[1 , 0]<FORK> create 2 at 0xA8
[1 , 0]<FORK> create 3 at 0xBE
[2 , 0]<IO> read on 8
[3 , 0]<FORK> create 4 at 0xD8
[3 , 0]<FORK> create 5 at 0xD8
[3 , 0]<FORK> create 6 at 0xD8
[3 , 0]<FORK> create 7 at 0xD8
[3 , 0]<FORK> create 8 at 0xD8
[6 ,2000]<IO> write on 8
[8 ,4000]<IO> write on 8
[5 ,1000]<IO> write on 8
[4 , 0]<IO> write on 8
[ Sys ]<IO> [8] sent 4 bytes from [4 , 0] to [2 , 0]
[4 , 1]<IO> read on 3
[2 , 1]<IO> read on 8
[7 ,3000]<IO> write on 8
[ Sys ]<IO> [8] sent 4 bytes from [5 ,1000] to [2 , 1]
[5 ,1001]<IO> read on 4
[2 ,1001]<IO> read on 8
[ Sys ]<IO> [8] sent 4 bytes from [6 ,2000] to [2 ,1001]
[6 ,2001]<IO> read on 5
[2 ,2001]<IO> read on 8
[ Sys ]<IO> [8] sent 4 bytes from [7 ,3000] to [2 ,2001]
[7 ,3001]<IO> read on 6
[2 ,3001]<IO> read on 8
[ Sys ]<IO> [8] sent 4 bytes from [8 ,4000] to [2 ,3001]
[8 ,4001]<IO> read on 7
[2 ,4001]<IO> write on 3
[ Sys ]<IO> [3] sent 4 bytes from [2 ,4001] to [4 , 1]
[2 ,4002]<IO> write on 4
[4 ,4002]<IO> write on 8
[ Sys ]<IO> [4] sent 4 bytes from [2 ,4002] to [5 ,1001]
[2 ,4003]<IO> write on 5
[5 ,5003]<IO> write on 8
[ Sys ]<IO> [5] sent 4 bytes from [2 ,4003] to [6 ,2001]
[2 ,4004]<IO> write on 6
[6 ,6004]<IO> write on 8
[ Sys ]<IO> [6] sent 4 bytes from [2 ,4004] to [7 ,3001]
[2 ,4005]<IO> write on 7
[7 ,7005]<IO> write on 8
[ Sys ]<IO> [7] sent 4 bytes from [2 ,4005] to [8 ,4001]
[2 ,4006]<IO> read on 8
[8 ,8006]<IO> write on 8
[ Sys ]<IO> [8] sent 4 bytes from [4 ,4002] to [2 ,4006]
[2 ,4007]<IO> read on 8
[4 ,4007]<IO> read on 3
[ Sys ]<IO> [8] sent 4 bytes from [5 ,5003] to [2 ,4007]
[5 ,5004]<IO> read on 4
[2 ,5004]<IO> read on 8
[ Sys ]<IO> [8] sent 4 bytes from [6 ,6004] to [2 ,5004]
[6 ,6005]<IO> read on 5
[2 ,6005]<IO> read on 8
[ Sys ]<IO> [8] sent 4 bytes from [7 ,7005] to [2 ,6005]
[7 ,7006]<IO> read on 6
[2 ,7006]<IO> read on 8
[2 ,7006]<IO> read on 8
b[ Sys ]<IO> [8] sent 4 bytes from [8 ,8006] to [2 ,7006]
[8 ,8007]<IO> read on 7
[2 ,8007]<IO> write on 3
[ Sys ]<IO> [3] sent 4 bytes from [2 ,8007] to [4 ,4007]
[2 ,8008]<IO> write on 4
[4 ,8009]<FORK> ended
[ Sys ]<IO> [4] sent 4 bytes from [2 ,8008] to [5 ,5004]
[2 ,8009]<IO> write on 5
[5 ,8010]<FORK> ended
[ Sys ]<IO> [5] sent 4 bytes from [2 ,8009] to [6 ,6005]
[2 ,8010]<IO> write on 6
[6 ,8011]<FORK> ended
[ Sys ]<IO> [6] sent 4 bytes from [2 ,8010] to [7 ,7006]
[2 ,8011]<IO> write on 7
[7 ,8012]<FORK> ended
[ Sys ]<IO> [7] sent 4 bytes from [2 ,8011] to [8 ,8007]
[2 ,8013]<FORK> ended
[8 ,8013]<FORK> ended
[3 ,8013]<FORK> ended
[1 ,8013]<IO> closed 8
[1 ,8013]<IO> close channel table at 0x4E4C - 5
[1 ,8013]<IO> closed 3
[1 ,8013]<IO> closed 4
[1 ,8013]<IO> closed 5
[1 ,8013]<IO> closed 6
[1 ,8013]<IO> closed 7
[1 ,8013]<FORK> ended
Executed 20046 instructions in 8013 time
SHAR_EOF
fi # end of overwriting check
if test -f 'RESULTS'
then
echo shar: will not over-write existing file "'RESULTS'"
else
cat << \SHAR_EOF > 'RESULTS'
** compiling simple
** running simple
** compiling pr459
SHAR_EOF
fi # end of overwriting check
if test -f 'itoa.oc'
then
echo shar: will not over-write existing file "'itoa.oc'"
else
cat << \SHAR_EOF > 'itoa.oc'
-- convert (positive) integer to string (decimal representation) and print it.
extern proc chassign(chan c, value fd, mode):
def MAX = 200: -- should be enough..
var str[BYTE MAX]:
var x:
proc convert(value n, var pos) =
var tmp:
var nn:
seq
nn := n
pos := MAX -1
while (nn > 0 and pos > 0)
seq
tmp := nn / 10
tmp := nn - tmp*10
nn := nn / 10
str[BYTE pos] := '0' + tmp
pos := pos - 1 :
seq
chassign(OUTPUT, 1, 1)
convert(1223, x)
OUTPUT ! str[BYTE x for MAX-x]
OUTPUT ! "*n"
SHAR_EOF
fi # end of overwriting check
if test -f 'simple.oc'
then
echo shar: will not over-write existing file "'simple.oc'"
else
cat << \SHAR_EOF > 'simple.oc'
-- some simple OCCAM constructs.
var a:
chan c:
def N = 20:
seq
a := 1
while (a < N)
a := a + 1
par
c ? ANY
c ! N
seq i = [0 for N]
a := a / 2
SHAR_EOF
fi # end of overwriting check
if test -f 'RESULTS.good'
then
echo shar: will not over-write existing file "'RESULTS.good'"
else
cat << \SHAR_EOF > 'RESULTS.good'
** compiling simple
** running simple
Executed 62 instructions in 61 time
** compiling pr459
** running pr459
Executed 1 instructions in 1 time
459
** compiling randgen
** running randgen
** compiling prog
** running prog with tracing
** compiling itoa
** running itoa
seq j = [0 for 1000*n]
skip
sync ! DONE
c ? ANY :
proc manager =
seq h = [0 for N]
seq
seq k = [0 for NPROC]
sync ? ANY
seq l = [0 for NPROC]
chtab[l] ! ACK :
par
manager
par p = [0 for NPROC]
worker(chtab[p], p)
SHAR_EOF
fi # end of overwriting check
if test -f 'randgen.oc'
then
echo shar: will not over-write existing file "'randgen.oc'"
else
cat << \SHAR_EOF > 'randgen.oc'
-- random number generator using 'ALT'. produces a random series of N numbers
-- in the range 0..MAX.
extern proc pnum(value n):
def MAX = 10:
def N = 50:
chan chtab[MAX]:
proc select =
seq i = [0 for N]
alt j = [0 for MAX]
chtab[j] ? ANY
pnum(j) :
proc foreversend(chan c) =
while TRUE
c ! ANY :
par
select
par k = [0 for MAX]
foreversend(chtab[k])
SHAR_EOF
fi # end of overwriting check
if test -f 'pnum.c'
then
echo shar: will not over-write existing file "'pnum.c'"
else
cat << \SHAR_EOF > 'pnum.c'
pnum(n)
{
printf("%d\n", n);
}
SHAR_EOF
fi # end of overwriting check
if test -f 'pr459.oc'
then
echo shar: will not over-write existing file "'pr459.oc'"
else
cat << \SHAR_EOF > 'pr459.oc'
extern proc pnum(value n):
pnum(459)
SHAR_EOF
fi # end of overwriting check
cd ..
# End of shell archive
exit 0
----------end of test.shar----------
--
-
- Terry Torkelson Internet: ttork%ewu@uunet.uu.net
- Eastern Washington University uucp: uunet!isc-br!ewu!ttork
- tellynet: 509-359-6016ttork@ewu.UUCP (Terry Torkelson) (11/15/90)
----------tools.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:
# tools
# This archive created: Thu Apr 19 16:54:45 1990
export PATH; PATH=/bin:$PATH
if test ! -d 'tools'
then
mkdir 'tools'
fi
cd 'tools'
if test -f 'Makefile'
then
echo shar: will not over-write existing file "'Makefile'"
else
cat << \SHAR_EOF > 'Makefile'
# configurable definitions:
################################################################################
CC=/bin/cc
CNAME=cc
AS=/bin/as
ASNAME=as
CPP=/lib/cpp
CPPNAME=cpp
SRCDIR=..
DESTDIR=/m/usr/gil/occam
# OCCDIR and BINDIR should exist
OCCDIR=$(DESTDIR)/lib
BINDIR=$(DESTDIR)/bin
OCP=$(OCCDIR)/ocp
OCPNAME=ocp
LIB=$(OCCDIR)/lsim.a
LIBNAME=lsim.a
OCCNAME=occ
OCC=$(BINDIR)/occ
################################################################################
CFLAGS= \
-DCC=\"$(CC)\" -DCNAME=\"$(CNAME)\" -DAS=\"$(AS)\" \
-DASNAME=\"$(ASNAME)\" -DCPP=\"$(CPP)\" -DCPPNAME=\"$(CPPNAME)\" \
-DOCCDIR=\"$(OCCDIR)\" -DOCP=\"$(OCP)\" -DOCPNAME=\"$(OCPNAME)\" \
-DLIB=\"$(LIB)\" -DLIBNAME=\"$(LIBNAME)\"
$(OCCNAME): occ.c Makefile
$(CC) $(CFLAGS) -o $(OCCNAME) occ.c
# installation of $(OCC), $(OCP), $(LIB).
# $(OCP) and $(LIB) should be prepared in the source directories
# $(SRCDIR)/{comp,sim}
install: $(OCCNAME) $(SRCDIR)/comp/$(OCPNAME) $(SRCDIR)/sim/$(LIBNAME)
@echo installing $(OCCNAME) $(OCPNAME) $(LIBNAME)
-install $(OCCNAME) $(OCC)
-install $(SRCDIR)/comp/$(OCPNAME) $(OCP)
-install $(SRCDIR)/sim/$(LIBNAME) $(LIB)
ranlib $(LIB)
SHAR_EOF
fi # end of overwriting check
if test -f 'ocp.1'
then
echo shar: will not over-write existing file "'ocp.1'"
else
cat << \SHAR_EOF > 'ocp.1'
.TH OCP 1N "15 November 1986"
.UC 4
.SH NAME
ocp \-
.B Occam
language system
.SH SYNOPSIS
.B ocp
[
.I \-S
] [
.I \-L
] [
.I \-C
] [
.I \-T
] [
.I \-c
] [
.B
cc
.I flags
] [
.I files..
]
.sp
.B <prog>
[
.I \-s
<sz>
] [
.I \-i
<n>
] [
.I \-r
<sz>
] [
.I \-d
]
[
.I \-t
[opts]
]
[
.I \-q
]
[
.I \-f
[<file-name>]
]
.SH DESCRIPTION
.PP
Ocp is an
.B OCCAM
compiler.
.B OCCAM
is a computer language which supports parallel execution of
program parts, It is used on the
.I Transputer
parallel computer.
The Ocp system provides a compiler and a runtime library used to run
.B Occam
programs on the UNIX/VAX system.
.PP
The occam compiler accepts a list of arguments, interpreted as follows:
.PP
Arguments whose names end with
.B `.oc'
are taken to be occam source programs.
They are compiled, and an object file with the suffix `.o' substituting `.oc'
is left, for further linking.
.PP
Other file names are taken to be acceptable arguments to
.B cc(1)
and passed unchanged to the C-compiler (see below).
.PP
The following options are interpreted by
.IR ocp :
.TP 3
.B \-L
Produce program listing for the named
.B OCCAM
programs on the corresponding files suffixed '.lst'.
.TP 3
.B -C
Do not generate code for run-time commands counting.
.TP 3
.B -T
By default, the compiler generates code for automatic stack expansion
when the current stack is exhausted. When this option is raised, the above
code is not produced by the compiler. Resulting a more efficient code.
.TP 3
.B \-c
Suppress the loading phase of the compilation, and force
an object file to be produced even if only one program is compiled.
.TP 3
.B \-S
Compile the named
.B OCCAM
programs, and leave the assembler-language
output on corresponding files suffixed `.s'.
This option suppresses the loading phase.
.PP
The loading phase is done by the C-compiler
.IR (cc(1))
including the loading of the runtime library, compilation of other
files (as mentioned above) and interpretation of all other flags.
.SH Language Additions
.PP
In addition to the standard
.B OCCAM
language the
.B Ocp
system provides the following extensions:
.PP
As mentioned above, separate compilation of partial
.B OCCAM
programs is supported by the system. The linking of the produced
object files with any other UNIX object file is done by the standard
loader
.IR ld(1).
The naming convention for global data agrees with that of the C-compiler
(i.e. names are prefixed with '_').
The loading phase includes the loading of the C-library (libc), which includes
interface to system calls and a buffered-io library.
.PP
A cross files (and possibly cross languages) variable-sharing is provided by
an external declaration.
.br
syntax:
.br
.nf
\fIextern\fR <occam-declaration>
.fi
The object declared external via this statement is linked with the original
object (declared normally, in a different file/part),
and may be used normally throughout the program.
.PP
Recursion is allowed in programs. Note should be taken of the stack size
consideration made by the compiler and the runtime library.
The user should use carefully the -T, -s, and -r options in order to tune
his program memory/cpu usage.
.PP
Strings are heavily supported by the compiler:
calls of the form:
.br
.nf
foo("hello world")
.fi
.br
when `foo' is a declared procedure are allowed.
.br
Passing of strings through channels is also supported, as in:
.br
.nf
OUTPUT ! "hello world*n"
.fi
.br
The C-language string convention is supported (using `\\' as
escape character).
.PP
.SH Channel behavior
.PP
Special channels are supported in three forms:
.TP 3
VAX/VMS\-OCCAM compatible special channels.
The VAX/VMS special channels are used to connect
.B OCCAM
programs with UNIX files and special files (terminal, keyboard, etc.),
in a compatible manner with the INMOS VAX/VMS-OCCAM special channels.
.TP 3
Special channels for I/O.
The special I/O channels are used to connect
.B OCCAM
programs to UNIX files.
In this form, the channels are used as one-way data streams (to a
file or from it).
One special function is called to attach a channel to a file:
.br
.nf
\fBchassign\fR(<chname>, <fd>, <mode>)
.fi
.br
.I Chassign
associates the channel named `chname' with the file descriptor `fd' obtained
from
.I open, dup, creat,
or
.IR pipe(2).
The mode `mode' must agree with the mode of the open file:
.br
0 - for read only
.br
1 - for write only
.br
2 - for read & write
.br
Further access to the channel is in the usual way.
.br
Two special channels are automatically declared upon invoking of the
compiler: INPUT & OUTPUT. They can further be assigned to any file-descriptor.
.TP 3
Special VAX/VMS\-OCCAM compatible TIME channel.
The special time channel provides a different, VAX/VMS compatible,
interface for the local clock. Thus, the local clock can be accessed
in two equivalent ways:
.br
`TIME ? <var>' :: `<var> := NOW'.
.br
`TIME ? AFTER <expr>' :: `WAIT NOW AFTER <expr>'.
.PP
Channel messages of different sizes are prohibited by the system.
When read and write requests of different sizes are encountered on a
channel, the systems panics and quits.
.SH Runtime Library
.PP
The runtime library provides a virtual parallel machine interface
which matches the abstract
.B OCCAM
machine to which the compiler is designed.
The library simulates the
.B OCCAM
primitives for parallel processes and channel operations.
It provides a scheduler and timer for parallel processes, and a connected
channeled message passing.
.PP
The parallelism simulation is done by the scheduler;
At a pre-defined interval (user tunable, see below) a context-switching
between running processes is performed, thus sharing the sequential time
(more or less) equally between the processes.
Memory is allocated for each process, separately, for the local data,
and its size is pre-defined (user-tunable, see below).
.br
Stacks are expanded when stack bottom is reached.
When a process' stack is exhausted, an additional stack is allocated for
it. This stack is automatically freed on return from
the routine in which stack overflow has occurred.
If the user program uses a known fixed stack size, it should be run with the
\-T option to gain performance improvement.
.PP
All the runtime routines are loaded in the linking phase.
The execution of any
.B OCCAM
program starts in a proto-type routine that acts as a father process to
all processes.
The `proto' routine accepts the following options:
.TP 3
.B \-s<stacksize>
Determine the local-data size for all processes. Default is 8Kb.
.TP 3
.B \-r<reserve-size>
Determine the reservation stack space, this size is used as a minimal
reservation space when generating code for automatic stack expansion.
see the -T compiler option.
.TP 3
.B \-i<n>
Specify the interval for context-switching. 'n' is the number per
cpu-second switches. Default is 25.
.TP 3
.B \-d
.br
Run in debug mode. In this mode the library routines print out
messages for debugging.
.TP 3
.B \-t[options..]
.br
Turn on trace flags according to `options':
.br
.RS 3
.TP 6
\fB`c'\fR \- trace context switching.
.TP 6
\fB`f'\fR \- trace forks (creation of new processes).
.TP 6
\fB`s'\fR \- same as `f'.
.TP 6
\fB`b'\fR \- trace blocking/unblocking of processes on events.
.TP 6
\fB`i'\fR \- trace i/o events.
.RE
.IP
Empty `options' implies all trace flags.
.TP 3
.B \-f[filename]
.br
By default, tracing messages are sent to \fIstderr\fP.
When this option is given tracing messages are sent to \fIfilename\fP.
If \fIfilename\fP is not given \fIstdout\fP is used.
.TP 3
.B \-q
.br
Quiet mode. Without this flag the program will print out counting of
the parallel and sequential instruction-count
.B (OCCAM
instruction level)
upon termination.
.SH Not Supported
The special
.B OCCAM
configuration directives PRI ALT, PRI PAR, PLACED PAR, ALLOCATE,
are not supported
since they do not have a meaningful semantics in the system.
.SH ERRORS
The system will panic with an error message on the following events:
.sp
.IP "no more channels -"
Channels pool has been exhausted.
.IP "select channel disappeared -"
Internal error. Shouldn't happen.
.IP "noncompatible receive-send request on channel -"
Requests for sending/receiving messages of different sizes on a channel.
.IP "noncompatible sizes in receive-send -"
Requests for sending/receiving operands of different types on channel.
.IP "alloc stack failed -"
Stack memory have been exhausted.
.IP "no more process -"
Processes pool has been exhausted.
.IP "deadlock -"
Deadlock situation.
.IP "non word messages are not allowed in Vms -"
Attempt to send operand of compound type on VMS special channel.
.IP "vms select not implemented yet -"
Attempt to use ALT on VMS channels.
.IP "vms: can't read from closed file -"
Attempt to read from a VMS special channel connected to a closed file.
.IP "vms: file not open for reading -"
attempt to read from a write-only file-connected VMS special channel.
.IP "try to write on a closed file -"
Attempt to write to a VMS special channel connected to a closed file.
.IP "flushing a closed file -"
Attempt to flush a VMX channel connected to a closed file.
.IP "bad request -"
Bad request code on VMS special channel.
.IP "trying to close a closed file -"
Attempt to close a VMS channel connected to a closed file.
.SH FILES
.SH SEE ALSO
"OCCAM programming manual", INMOS Limited, Prentice Hall International.
.br
"Occam programming system, VAX/VMS host manual", INMOS Limited.
.br
"A UNIX Occam system", TR, Hebrew Uni. Jerusalem.
.IR cc(1),
.IR ld(1),
.IR open(2),
.IR creat(2),
.IR dup(2)
.SH BUGS
The stack handling mechanism is very subtle and should be
tuned carefully for each program.
There is no syntax-error handling yet. The compiler will produce
lexical & semantical error messages. In case of syntax error
only the line number will be printed out.
.sp 1
Please report any other bugs via electronic mail to:
.br
.ti 1i
csnet: dalia@huji
.br
.ti 1i
bitnet: dalia@hujics
.br
.ti 1i
uucp: decvax!huji!dalia
.SH AUTHOR
Dalia Malki & Gil Shwed, Hebrew University, Jerusalem.
SHAR_EOF
fi # end of overwriting check
if test -f 'ocp.n'
then
echo shar: will not over-write existing file "'ocp.n'"
else
cat << \SHAR_EOF > 'ocp.n'
OCP(1N) UNIX Programmer's Manual OCP(1N)
NAME
ocp - Occam language system
SYNOPSIS
ocp [ -_S ] [ -_L ] [ -_C ] [ -_T ] [ -_c ] [ cc _f_l_a_g_s ] [
_f_i_l_e_s.. ]
<prog> [ -_s <sz> ] [ -_i <n> ] [ -_r <sz> ] [ -_d ] [ -_t [opts] ] [
-_q ] [
-_f [<file-name>] ]
DESCRIPTION
Ocp is an OCCAM compiler. OCCAM is a computer language which supports
parallel execution of program parts, It is used on the _T_r_a_n_s_p_
u_t_e_r paral-
lel computer. The Ocp system provides a compiler and a runtime library
used to run Occam programs on the UNIX/VAX system.
The occam compiler accepts a list of arguments, interpreted as follows:
Arguments whose names end with `.oc' are taken to be occam source pro-
grams. They are compiled, and an object file with the suffix `.o' sub-
stituting `.oc' is left, for further linking.
Other file names are taken to be acceptable arguments to cc(1) and
passed unchanged to the C-compiler (see below).
The following options are interpreted by _o_c_p:
-L Produce program listing for the named OCCAM programs on the
corresponding files suffixed '.lst'.
-C Do not generate code for run-time commands counting.
-T By default, the compiler generates code for automatic stack expansion
when the current stack is exhausted. When this option is raised, the
above code is not produced by the compiler. Resulting a more effi-
cient code.
-c Suppress the loading phase of the compilation, and force an object
file to be produced even if only one program is compiled.
-S Compile the named OCCAM programs, and leave the assembler-language
output on corresponding files suffixed `.s'. This option suppresses
the loading phase.
The loading phase is done by the C-compiler (_c_c(_1)) including the lo
ad-
ing of the runtime library, compilation of other files (as mentioned
above) and interpretation of all other flags.
Language Additions
In addition to the standard OCCAM language the Ocp system provides the
following extensions:
As mentioned above, separate compilation of partial OCCAM programs is
supported by the system. The linking of the produced object files with
any other UNIX object file is done by the standard loader _l_d(_1). Th
e
naming convention for global data agrees with that of the C-compiler
(i.e. names are prefixed with '_'). The loading phase includes the
loading of the C-library (libc), which includes interface to system
calls and a buffered-io library.
A cross files (and possibly cross languages) variable-sharing is pro-
vided by an external declaration.
syntax:
_e_x_t_e_r_n <occam-declaration>
The object declared external via this statement is linked with the ori-
ginal object (declared normally, in a different file/part), and may be
used normally throughout the program.
Recursion is allowed in programs. Note should be taken of the stack size
consideration made by the compiler and the runtime library. The user
should use carefully the -T, -s, and -r options in order to tune his
program memory/cpu usage.
Printed 11/20/86 15 November 1986 1
OCP(1N) UNIX Programmer's Manual OCP(1N)
Strings are heavily supported by the compiler: calls of the form:
foo("hello world")
when `foo' is a declared procedure are allowed.
Passing of strings through channels is also supported, as in:
OUTPUT ! "hello world*n"
The C-language string convention is supported (using `\' as escape char-
acter).
Channel behavior
Special channels are supported in three forms:
VAX/VMS-OCCAM compatible special channels.
The VAX/VMS special channels are used to connect OCCAM programs with
UNIX files and special files (terminal, keyboard, etc.), in a compa-
tible manner with the INMOS VAX/VMS-OCCAM special channels.
Special channels for I/O.
The special I/O channels are used to connect OCCAM programs to UNIX
files. In this form, the channels are used as one-way data streams
(to a file or from it). One special function is called to attach a
channel to a file:
chassign(<chname>, <fd>, <mode>)
_C_h_a_s_s_i_g_n associates the channel named `chname' with the
file descrip-
tor `fd' obtained from _o_p_e_n, _d_u_p, _c_r_e_a_t, or _p
_i_p_e(_2). The mode `mode'
must agree with the mode of the open file:
0 - for read only
1 - for write only
2 - for read & write
Further access to the channel is in the usual way.
Two special channels are automatically declared upon invoking of the
compiler: INPUT & OUTPUT. They can further be assigned to any file-
descriptor.
Special VAX/VMS-OCCAM compatible TIME channel.
The special time channel provides a different, VAX/VMS compatible,
interface for the local clock. Thus, the local clock can be accessed
in two equivalent ways:
`TIME ? <var>' :: `<var> := NOW'.
`TIME ? AFTER <expr>' :: `WAIT NOW AFTER <expr>'.
Channel messages of different sizes are prohibited by the system. When
read and write requests of different sizes are encountered on a channel,
the systems panics and quits.
Runtime Library
The runtime library provides a virtual parallel machine interface which
matches the abstract OCCAM machine to which the compiler is designed.
The library simulates the OCCAM primitives for parallel processes and
channel operations. It provides a scheduler and timer for parallel
processes, and a connected channeled message passing.
The parallelism simulation is done by the scheduler; At a pre-defined
interval (user tunable, see below) a context-switching between running
processes is performed, thus sharing the sequential time (more or less)
equally between the processes. Memory is allocated for each process,
separately, for the local data, and its size is pre-defined (user-
tunable, see below).
Stacks are expanded when stack bottom is reached. When a process' stack
is exhausted, an additional stack is allocated for it. This stack is
automatically freed on return from the routine in which stack overflow
has occurred. If the user program uses a known fixed stack size, it
should be run with the -T option to gain performance improvement.
All the runtime routines are loaded in the linking phase. The execution
of any OCCAM program starts in a proto-type routine that acts as a
father process to all processes. The `proto' routine accepts the fol-
lowing options:
-s<stacksize>
Determine the local-data size for all processes. Default is 8Kb.
-r<reserve-size>
Printed 11/20/86 15 November 1986 2
OCP(1N) UNIX Programmer's Manual OCP(1N)
Determine the reservation stack space, this size is used as a minimal
reservation space when generating code for automatic stack expansion.
see the -T compiler option.
-i<n>
Specify the interval for context-switching. 'n' is the number per
cpu-second switches. Default is 25.
-d
Run in debug mode. In this mode the library routines print out mes-
sages for debugging.
-t[options..]
Turn on trace flags according to `options':
`c' - trace context switching.
`f' - trace forks (creation of new processes).
`s' - same as `f'.
`b' - trace blocking/unblocking of processes on events.
`i' - trace i/o events.
Empty `options' implies all trace flags.
-f[filename]
By default, tracing messages are sent to _s_t_d_e_r_r. When this
option is
given tracing messages are sent to _f_i_l_e_n_a_m_e. If _f_i
_l_e_n_a_m_e is not
given _s_t_d_o_u_t is used.
-q
Quiet mode. Without this flag the program will print out counting of
the parallel and sequential instruction-count (OCCAM instruction
level) upon termination.
Not Supported
The special OCCAM configuration directives PRI ALT, PRI PAR, PLACED PAR,
ALLOCATE, are not supported since they do not have a meaningful seman-
tics in the system.
ERRORS
The system will panic with an error message on the following events:
no more channels -
Channels pool has been exhausted.
select channel disappeared -
Internal error. Shouldn't happen.
noncompatible receive-send request on channel -
Requests for sending/receiving messages of different sizes on a
channel.
noncompatible sizes in receive-send -
Requests for sending/receiving operands of different types on
channel.
alloc stack failed -
Stack memory have been exhausted.
no more process -
Processes pool has been exhausted.
deadlock -
Deadlock situation.
non word messages are not allowed in Vms -
Attempt to send operand of compound type on VMS special channel.
Printed 11/20/86 15 November 1986 3
OCP(1N) UNIX Programmer's Manual OCP(1N)
vms select not implemented yet -
Attempt to use ALT on VMS channels.
vms: can't read from closed file -
Attempt to read from a VMS special channel connected to a closed
file.
vms: file not open for reading -
attempt to read from a write-only file-connected VMS special chan-
nel.
try to write on a closed file -
Attempt to write to a VMS special channel connected to a closed
file.
flushing a closed file -
Attempt to flush a VMX channel connected to a closed file.
bad request -
Bad request code on VMS special channel.
trying to close a closed file -
Attempt to close a VMS channel connected to a closed file.
FILES
SEE ALSO
"OCCAM programming manual", INMOS Limited, Prentice Hall International.
"Occam programming system, VAX/VMS host manual", INMOS Limited.
"A UNIX Occam system", TR, Hebrew Uni. Jerusalem. _c_c(_1), _l_d(_1
),
_o_p_e_n(_2), _c_r_e_a_t(_2), _d_u_p(_2)
BUGS
The stack handling mechanism is very subtle and should be tuned care-
fully for each program. There is no syntax-error handling yet. The com-
piler will produce lexical & semantical error messages. In case of syn-
tax error only the line number will be printed out.
Please report any other bugs via electronic mail to:
csnet: dalia@huji
bitnet: dalia@hujics
uucp: decvax!huji!dalia
AUTHOR
Dalia Malki & Gil Shwed, Hebrew University, Jerusalem.
Printed 11/20/86 15 November 1986 4
SHAR_EOF
fi # end of overwriting check
if test -f 'reserve'
then
echo shar: will not over-write existing file "'reserve'"
else
cat << \SHAR_EOF > 'reserve'
#! /bin/csh -f
set words = reserved_words
sort $words : \
awk 'BEGIN {\
printf "#include <stdio.h>\n#include \"all.h\"\n\nstruct reswords ReservedWords[
] = {\n"; }\
/^#/ { next }\
{ if(NF == 3) type = $3; else type = "reserved"; \
printf "\t%-16s,%-16s,%s,\n", $1, $2, type }\
END { printf "};\nint nreserved = sizeof(ReservedWords)/sizeof(struct reswords)
;\n" }\
' > reserved_words.c
SHAR_EOF
fi # end of overwriting check
if test -f 'makeerrs'
then
echo shar: will not over-write existing file "'makeerrs'"
else
cat << \SHAR_EOF > 'makeerrs'
#! /bin/sh
awk '
BEGIN {
printf "#define ERR_LIST\n";
printf "#include \"error.h\"\n";
printf "struct error_list Err_list[] = {\n";
printf " WARNING, \"No Error\",\n";
FS=":";
}
{
n++;
printf " %s, \"%s\",\n#define %s %d\n", $1, $3, $2, n;
}
END {
printf"};\n";
}' < ../comp/err_types > ../comp/error_list.c
grep "^#define" < ../comp/error_list.c > ../comp/h/errors.h
SHAR_EOF
fi # end of overwriting check
if test -f 'occ.c'
then
echo shar: will not over-write existing file "'occ.c'"
else
cat << \SHAR_EOF > 'occ.c'
#include <stdio.h>
#define MAXARGS 128
#define load_occam() (!cflag && !Sflag)
char *malloc(), *strcpy(), *rindex();
char *mktemp();
static char *pname;
static char *args[MAXARGS];
static int args_cnt;
static char ocpflags[20], ocpn = 1;
static int Sflag; /* leave assembler files */
static int cflag; /* separate compilation: leave .o files */
static int Lflag; /* listing flag; passed to ocp (ONLY) */
static int Cflag; /* no counter flag; passed to ocp (ONLY) */
static int Tflag; /* don't generate code for automatic stack
: expansion */
int vflg;
char *Occdir;
char *tflags(), *setsuf(), *getenv();
main(ac, av)
char **av;
{
register i;
register char *p;
int ccflag;
int was_error = 0;
if(Occdir == NULL && (Occdir = getenv("OCCDIR")) == NULL)
Occdir = OCCDIR;
pname = av[0];
args[args_cnt++] = CNAME;
for(i = 1; i < ac; i++) {
if (av[i][0] == '-')
av[i] = tflags(&av[i][1]);
}
for(i = 1; i < ac; i++) {
if (occam_suffix(av[i])) {
if (cpp_suffix(av[i]) && pass_cpp(av[i]))
was_error = 1;
else if (occam_comp(av[i]) == 0) {
if (load_occam()) {
args[args_cnt++] = setsuf(av[i],"o");
}
} else
was_error = 1;
} else if (av[i][0])
args[args_cnt++] = av[i];
}
ccflag = 0;
for (i = 1; i < args_cnt; i++)
if (args[args_cnt][0] != '-')
ccflag++;
if (ccflag) {
char buf[128];
sprintf(buf, "%s/%s", Occdir, LIBNAME);
args[args_cnt++] = buf;
args[args_cnt] = (char *)0;
if (execute(CC, args) != 0)
was_error = 1;
}
exit(was_error);
}
execute(prog, argv)
char *prog, **argv;
{
int f;
int s;
char buf[128];
if(prog[0] != '/') {
sprintf(buf, "%s/%s", Occdir, prog);
prog = buf;
}
if(vflg) {
char **av;
printf("exec %s: ", prog);
for(av = argv; *av; av++)
printf("%s ", *av);
printf("\n");
}
fflush(stdout);
if ((f = fork()) > 0) {
wait(&s);
return s;
} else if (f == 0) {
int i;
execv(prog, argv);
Prerror("Cannot execute %s: ", prog);
perror(NULL);
exit(1);
} else
Prerror("cannot fork\n");
}
Prerror(fmt, a, b, c, d, e)
char *fmt;
{
fprintf(stderr, "%s: ", pname);
fprintf(stderr, fmt, a, b, c, d, e);
}
char
*tflags(options)
char *options;
{
register char *p;
char *nopts; /* new option string, stripped from
: the local options */
register char *np;
np = nopts = malloc(strlen(options)+2); /* at most */
*np++ = '-';
for (p = options; *p; p++)
switch(*p) {
case 'S':
if (!Sflag) { /* first time.. */
*np++ = 'S';
}
Sflag = 1;
break;
case 'c':
if (!cflag) {
*np++ = 'c';
}
cflag = 1;
break;
case 'L':
if (!Lflag) {
ocpflags[ocpn++] = 'L';
}
Lflag = 1;
break;
case 'C':
if(!Cflag) {
ocpflags[ocpn++] = 'C';
}
Cflag = 1;
break;
case 'T':
if(!Tflag) {
ocpflags[ocpn++] = 'T';
}
Tflag = 1;
break;
case 'v':
vflg++;
break;
default: /* maybe a c-flag? */
*np++ = *p;
break;
}
if (np-nopts == 1)
nopts[0] = '\0'; /* avoid just '-' */
*np = '\0';
return nopts;
}
occam_suffix(name)
char *name;
{
register l;
l = strlen(name);
if(l < 4)
return 0;
if (strcmp(&name[l-3], ".oc") == 0 :: strcmp(&name[l-4], ".occ") == 0)
return 1;
return 0;
}
cpp_suffix(name)
char *name;
{
register l;
l = strlen(name);
if(l < 4)
return 0;
if (strcmp(&name[l-4], ".occ") == 0)
return 1;
return 0;
}
static char *TMPS = "/tmp/ocsXXXXXX";
static char template[30]; /* big enough to hold /tmp/... */
occam_comp(prog)
char *prog;
{
char *sname;
char *oname;
register i;
char *ocp_args[5];
int s;
/* first - activate the code generator 'ocp' */
if (Sflag)
sname = setsuf(prog, "s");
else {
strcpy(template, TMPS);
sname = mktemp(template);
}
i = 0;
ocp_args[i++] = OCPNAME;
if (ocpn > 1) {
ocpflags[0] = '-';
ocp_args[i++] = ocpflags;
}
ocp_args[i++] = prog;
ocp_args[i++] = sname;
ocp_args[i] = (char *)0;
if ((s = execute(OCP, ocp_args)) != 0 :: Sflag)
goto remove;
/* now - if everytihing is fine, activate the assembler */
oname = setsuf(prog, "o");
i = 0;
ocp_args[i++] = ASNAME;
ocp_args[i++] = "-o";
ocp_args[i++] = oname;
ocp_args[i++] = sname;
ocp_args[i] = '\0';
s = execute(AS, ocp_args);
remove:
if (!Sflag)
unlink(sname);
return s;
}
char
*setsuf(name, suf)
char *name, *suf;
{
char *c, *p;
c = strcpy(malloc(strlen(name)), name);
if ((p = rindex(c, '.')) == NULL) {
Prerror("setsuf - name %s has no suffix");
return NULL;
}
strcpy(p+1, suf);
return c;
}
pass_cpp(s)
char *s;
{
register l = strlen(s);
char buf[128], *args[4];
strcpy(buf, s);
s[l-1] = '\0';
args[0] = CPPNAME;
args[1] = buf;
args[2] = s;
args[3] = NULL;
return execute(CPP, args);
}
SHAR_EOF
fi # end of overwriting check
cd ..
# End of shell archive
exit 0
----------end of tools.shar----------
--
-
- Terry Torkelson Internet: ttork%ewu@uunet.uu.net
- Eastern Washington University uucp: uunet!isc-br!ewu!ttork
- tellynet: 509-359-6016swansonc@AGNES.ACC.STOLAF.EDU (Chris Swanson, St. Olaf College) (12/01/90)
I have had a few people that have downloaded the copy of the
distribution that I made available from our ftp host (nic.stolaf.edu -
130.71.128.8 - anonymous - pub/unix_occam)
I have not had a chance to look at it personally, and won't for
atleast 2 weeks [ finals time here :( ]. If someone wants to fix this
problem in the sources, let me know and I'll replace the code here
with the correct one. If noone want's to, I will do so, but not until
after the new year.
-Chris
--
Chris Swanson, Chem/C-S/Pre-med Undergrad, St. Olaf College, Northfield,MN 55057
INTERNET: swansonc@acc.stolaf.edu UUCP: swansonc@stolaf
AT&T: Work: (507)-645-6845 Home: (507)-663-6424
I would deny this reality, but that wouldn't pay the bills...onders@picasso.ipl.rpi.edu (Timothy E. Onders) (12/07/90)
Does anyone know of a Sun port of this compiler and the associated simultor for either the Sun 3 or Sun 4 systems? This one seems to be very Vax 11 depedent (considering parts are written in Vax asm). Thanks for the help. Tim Onders onders@ipl.rpi.edu