Article View: comp.sys.transputer
Article #1100Unix Occam Compiler
From: Terry Torkelson
Date: Wed, 14 Nov 1990 19:37
Date: Wed, 14 Nov 1990 19:37
6944 lines
143635 bytes
143635 bytes
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----------
Technical Details
Message-ID:
<1337@ewu.UUCP>Path:
arc1-ca.pugleaf.net!utzoo!utgpu!news-server.csri.toronto.edu!rutgers!apple!olivea!oliveb!isc-br!ewu!ttorkShow Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!utzoo!utgpu!news-server.csri.toronto.edu!rutgers!apple!olivea!oliveb!isc-br!ewu!ttork From: ttork@ewu.UUCP (Terry Torkelson) Newsgroups: comp.sys.transputer Subject: Unix Occam Compiler Keywords: Occam Message-ID: <1337@ewu.UUCP> Date: 14 Nov 90 19:37:59 GMT Distribution: usa Organization: Eastern Washington Univ. Cheney WA Lines: 6944