Compilers and Compiler Generators P.D.

Terry, 2000

Appendix C
Cocol grammar for the Clang compiler/interpreter This appendix gives the Cocol specification and frame file for constructing a compiler for the Clang language as developed by the end of Chapter 18, along with the source for the tree-building code generator.
clang.atg | cgen.h | cgen.cpp | clang.frm
----- clang.atg --------------------------------------------------$CX COMPILER Clang /* CLANG level 4 grammar - function, procedures, parameters, concurrency Display model. Builds an AST for code generation. P.D. Terry, Rhodes University, 1996 */ #include #include #include #include #include "misc.h" "set.h" "table.h" "report.h" "cgen.h"

typedef Set<7> classset; bool debug; int blocklevel; TABLE_idclasses blockclass; extern TABLE *Table; extern CGEN *CGen; /*--------------------------------------------------------------------------*/ IGNORE CASE IGNORE CHR(9) .. CHR(13) COMMENTS FROM "(*" TO "*)" CHARACTERS cr lf letter digit instring = = = = = CHR(13) . CHR(10) . "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" . "0123456789" . ANY - "" - cr - lf .

TOKENS identifier = letter { letter | digit } . number = digit { digit } . string = "" (instring | "") { instring | "" } "" . PRODUCTIONS Clang = "PROGRAM" Ident<entry.name>

(. TABLE_entries entry; TABLE_index index; .) (. debug = (strcmp(entry.name, "DEBUG") == 0); entry.idclass = TABLE_progs; Table->enter(entry, index); Table->openscope(); .)

WEAK ";" Block<entry.level+1, TABLE_progs, 0> "." . Block<int blklevel, TABLE_idclasses blkclass, int initialframesize> = (. int framesize = initialframesize; CGEN_labels entrypoint; CGen->jump(entrypoint, CGen->undefined); if (blklevel > CGEN_levmax) SemError(213); .) SYNC { ( ConstDeclarations | VarDeclarations<framesize>

| ProcDeclaration ) SYNC }

CompoundStatement

(. /* blockclass, blocklevel global for efficiency */ blockclass = blkclass; blocklevel = blklevel; CGen->backpatch(entrypoint); /* reserve space for variables */ CGen->openstackframe(framesize - initialframesize); .) (. switch (blockclass) { case TABLE_progs : CGen->leaveprogram(); break; case TABLE_procs : CGen->leaveprocedure(blocklevel); break; case TABLE_funcs : CGen->functioncheck(); break; } if (debug) /* demonstration purposes */ Table->printtable(stdout); Table->closescope(); .) .

ConstDeclarations = "CONST" OneConst { OneConst } . OneConst = Ident<entry.name> WEAK "=" Number<entry.c.value> ";" . (. TABLE_entries entry; TABLE_index index; .) (. entry.idclass = TABLE_consts; .) (. Table->enter(entry, index) .)

VarDeclarations<int &framesize> = "VAR" OneVar<framesize> { WEAK "," OneVar<framesize> } ";" . OneVar<int &framesize> = (. TABLE_entries entry; TABLE_index index; entry.idclass = TABLE_vars; entry.v.ref = false; entry.v.size = 1; entry.v.scalar = true; entry.v.offset = framesize + 1; .)

Ident<entry.name> [ UpperBound<entry.v.size> (. entry.v.scalar = false; .) ] (. Table->enter(entry, index); framesize += entry.v.size; .) . UpperBound<int &size> = "[" Number<size> "]" ProcDeclaration = ( "PROCEDURE" | "FUNCTION" ) Ident<entry.name> (. size++; .) . (. (. (. (. TABLE_entries entry; TABLE_index index; .) entry.idclass = TABLE_procs; .) entry.idclass = TABLE_funcs; .) entry.p.params = 0; entry.p.paramsize = 0; entry.p.firstparam = NULL; CGen->storelabel(entry.p.entrypoint); Table->enter(entry, index); Table->openscope() .)

[ FormalParameters<entry> (. Table->update(entry, index) .) ] WEAK ";" Block<entry.level+1, entry.idclass, entry.p.paramsize + CGEN_headersize> ";" . FormalParameters<TABLE_entries &proc> = (. TABLE_index p; .) "(" OneFormal<proc, proc.p.firstparam> { WEAK "," OneFormal<proc, p> } ")" . OneFormal<TABLE_entries &proc, TABLE_index &index> = (. TABLE_entries formal; formal.idclass = TABLE_vars; formal.v.ref = false; formal.v.size = 1; formal.v.scalar = true; formal.v.offset = proc.p.paramsize + CGEN_headersize + 1 .) Ident<formal.name> [ "[" "]" (. formal.v.size = 2; formal.v.scalar = false; formal.v.ref = true; .) ] (. Table->enter(formal, index); proc.p.paramsize += formal.v.size; proc.p.params++; .) . CompoundStatement = "BEGIN" Statement { WEAK ";" Statement } "END" . Statement = SYNC [ CompoundStatement | AssignmentOrCall | ReturnStatement

| | | | ] .

IfStatement | WhileStatement CobeginStatement | SemaphoreStatement ReadStatement | WriteStatement "STACKDUMP" (. CGen->dump(); .)

AssignmentOrCall =

(. TABLE_entries entry; AST des, exp;.) Designator<des, classset(TABLE_vars, TABLE_procs), entry, true> ( /* assignment */ (. if (entry.idclass != TABLE_vars) SemError(210); .) ":=" Expression<exp, true> SYNC (. CGen->assign(des, exp); .) | /* procedure call */ (. if (entry.idclass < TABLE_procs) { SemError(210); return; } CGen->markstack(des, entry.level, entry.p.entrypoint); .) ActualParameters<des, entry> (. CGen->call(des); .) ) .

Designator<AST &D, classset allowed, TABLE_entries &entry, bool entire> = (. TABLE_alfa name; AST index, size; bool found; D = CGen->emptyast(); .) Ident<name> (. Table->search(name, entry, found); if (!found) SemError(202); if (!allowed.memb(entry.idclass)) SemError(206); if (entry.idclass != TABLE_vars) return; CGen->stackaddress(D, entry.level, entry.v.offset, entry.v.ref); .) ( "[" (. if (entry.v.scalar) SemError(204); .) Expression<index, true> (. if (!entry.v.scalar) /* determine size for bounds check */ { if (entry.v.ref) CGen->stackaddress(size, entry.level, entry.v.offset + 1, false); else CGen->stackconstant(size, entry.v.size); CGen->subscript(D, entry.v.ref, entry.level, entry.v.offset, size, index); } .) "]" | (. if (!entry.v.scalar) { if (entire) SemError(205); if (entry.v.ref) CGen->stackaddress(size, entry.level, entry.v.offset + 1, false); else CGen->stackconstant(size, entry.v.size); CGen->stackreference(D, entry.v.ref, entry.level, entry.v.offset, size); } .) ) . ActualParameters<AST &p, TABLE_entries proc> = (. int actual = 0; .) [ "(" (. actual++; .) OneActual<p, (*Table).isrefparam(proc, actual)> { WEAK "," (. actual++; .) OneActual<p, (*Table).isrefparam(proc, actual)> } ")" ] (. if (actual != proc.p.params) SemError(209); .) . OneActual<AST &p, bool byref> = (. AST par; .) Expression<par, !byref> (. if (byref && !CGen->isrefast(par)) SemError(214); CGen->linkparameter(p, par); .) . ReturnStatement = "RETURN" ( Expression<exp, true> | /* empty */ (. CGen->assign(dest, exp); CGen->leavefunction(blocklevel); .) (. switch (blockclass) { case TABLE_procs : CGen->leaveprocedure(blocklevel); break; case TABLE_progs : CGen->leaveprogram(); break; (. AST dest, exp; .) (. if (blockclass != TABLE_funcs) SemError(219); CGen->stackaddress(dest, blocklevel, 1, false); .)

case TABLE_funcs : SemError(220); break; } .) ) . IfStatement = (. CGEN_labels testlabel; AST C; .) "IF" Condition<C> "THEN" (. CGen->jumponfalse(C, testlabel, CGen->undefined) .) Statement (. CGen->backpatch(testlabel); .) . (. CGEN_labels startloop, testlabel, dummylabel; AST C; .) (. CGen->storelabel(startloop) .) (. CGen->jumponfalse(C, testlabel, CGen->undefined) .) (. CGen->jump(dummylabel, startloop); CGen->backpatch(testlabel) .) . (. AST E; CGEN_operators op; .) (. CGen->comparison(op, C, E); .) (. SynError(91) .)

WhileStatement = "WHILE" Condition<C> "DO" Statement Condition<AST &C> = Expression<C, true> ( RelOp<op> Expression<E, true> | /* Missing op */ ) . CobeginStatement = "COBEGIN" ProcessCall { WEAK ";" ProcessCall } "COEND" ProcessCall =

(. int processes = 0; CGEN_labels start; .) (. if (blockclass != TABLE_progs) SemError(215); CGen->cobegin(start); .) (. processes++; .) (. processes++; .) (. CGen->coend(start, processes); .) .

(. TABLE_entries entry; AST P; .) Designator<P, classset(TABLE_procs), entry, true> (. if (entry.idclass < TABLE_procs) return; CGen->markstack(P, entry.level, entry.p.entrypoint); .) ActualParameters<P, entry> (. CGen->forkprocess(P); .) . (. bool wait; AST sem; .) (. wait = true; .) (. wait = false; .) (. if (wait) CGen->waitop(sem); else CGen->signalop(sem); .)

SemaphoreStatement = ( "WAIT" | "SIGNAL"

) "(" Variable<sem> ")" . ReadStatement = "READ" "(" Variable<V> { WEAK "," Variable<V> } ")" .

(. AST V; .) (. CGen->readvalue(V); .) (. CGen->readvalue(V); .)

Variable<AST &V> = (. TABLE_entries entry; .) Designator<V, classset(TABLE_vars), entry, true> . WriteStatement = "WRITE" [ "(" WriteElement { WEAK "," WriteElement } (. CGen->newline(); .) . WriteElement = String<str> | Expression<exp, true> ")" ]

(. AST exp; char str[600]; CGEN_labels startstring; .) (. CGen->stackstring(str, startstring); CGen->writestring(startstring); .) (. CGen->writevalue(exp) .) .

Expression<AST &E, bool entire> = (. AST T; CGEN_operators op; E = CGen->emptyast(); .)

"+" Term<E, true> | "-" Term<E, true> | Term<E, entire>

(. CGen->negateinteger(E); .)

) { AddOp<op> Term<T, true>(. CGen->binaryintegerop(op, E, T); .) } . Term<AST &T, bool entire> = Factor<T, entire> { ( MulOp<op> | /* missing op */ ) Factor<F, true> } . (. AST F; CGEN_operators op; .) (. SynError(92); op = CGEN_opmul; .) (. CGen->binaryintegerop(op, T, F); .)

Factor<AST &F, bool entire> = (. TABLE_entries entry; int value; F = CGen->emptyast(); .) Designator<F, classset(TABLE_consts, TABLE_vars, TABLE_funcs), entry, entire> (. switch (entry.idclass) { case TABLE_consts : CGen->stackconstant(F, entry.c.value); return; case TABLE_procs : case TABLE_funcs : CGen->markstack(F, entry.level, entry.p.entrypoint); break; case TABLE_vars : case TABLE_progs : return; } .) ActualParameters<F, entry> | Number<value> (. CGen->stackconstant(F, value) .) | "(" Expression<F, true> ")" . AddOp<CGEN_operators &op> = "+" | "-" MulOp<CGEN_operators &op> = "*" | "/" RelOp<CGEN_operators &op> = "=" | "<>" | "<" | "<=" | ">" | ">=" Ident<char *name> = identifier String<char *str> = string (. op = CGEN_opadd; .) (. op = CGEN_opsub; .) . (. op = CGEN_opmul; .) (. op = CGEN_opdvd; .) . (. (. (. (. (. (. op op op op op op = = = = = = CGEN_opeql; CGEN_opneq; CGEN_oplss; CGEN_opleq; CGEN_opgtr; CGEN_opgeq; .) .) .) .) .) .) .

(. LexName(name, TABLE_alfalength); .) . (. char local[100]; LexString(local, sizeof(local) - 1); int i = 0; while (local[i]) /* strip quotes */ { local[i] = local[i+1]; i++; } local[i-2] = \0; i = 0; while (local[i]) /* find internal quotes */ { if (local[i] == \) { int j = i; while (local[j]) { local[j] = local[j+1]; j++; } } i++; } strcpy(str, local); .) . (. char str[100]; int i = 0, l, digit, overflow = 0; num = 0; LexString(str, sizeof(str) - 1); l = strlen(str); while (i <= l && isdigit(str[i])) { digit = str[i] - 0; i++; if (num <= (maxint - digit) / 10)

Number <int &num> = number

num = 10 * num + digit; else overflow = 1; } if (overflow) SemError(200); .) . END Clang. ----- cgen.h -----------------------------------------------------// // // // // Code Generation for Clang level 4 compiler/interpreter AST version for stack machine (OOP) Includes procedures, functions, parameters, arrays, concurrency. Display machine. P.D. Terry, Rhodes University, 1996

#ifndef CGEN_H #define CGEN_H #include "misc.h" #include "stkmc.h" #include "report.h" #define CGEN_headersize #define CGEN_levmax STKMC_headersize STKMC_levmax

enum CGEN_operators { CGEN_opadd, CGEN_opsub, CGEN_opmul, CGEN_opdvd, CGEN_opeql, CGEN_opneq, CGEN_oplss, CGEN_opgeq, CGEN_opgtr, CGEN_opleq }; struct NODE; typedef NODE *AST; typedef short CGEN_labels; class CGEN { public: CGEN_labels undefined;

// for forward references

CGEN(REPORT *R); // Initializes code generator AST emptyast(void); // Returns an empty (undefined) AST bool isrefast(AST a); // Returns true if a corresponds to a reference AST void negateinteger(AST &i); // Generates code to negate integer i void binaryintegerop(CGEN_operators op, AST &l, AST &r); // Generates code to perform infix operation op on l, r void comparison(CGEN_operators op, AST &l, AST &r); // Generates code to perform comparison operation op on l, r void readvalue(AST i); // Generates code to read value for i void writevalue(AST i); // Generates code to output value i void newline(void); // Generates code to output line mark void writestring(CGEN_labels location); // Generates code to output string stored at known location void stackstring(char *str, CGEN_labels &location); // Stores str in literal pool in memory and return its location void stackconstant(AST &c, int number); // Creates constant AST for constant c from number void stackaddress(AST &v, int level, int offset, bool byref); // Creates address AST for variable v with known level, offset void dereference(AST &a); // Generates code to replace address a by the value stored there void stackreference(AST &base, bool byref, int level, int offset, AST &size);

// Creates an actual parameter node for a reference parameter corresponding // to an array with given base and size void subscript(AST &base, bool byref, int level, int offset, AST &size, AST &index); // Prepares to apply an index to an array with given base, with checks // that the limit on the bounds is not exceeded void assign(AST dest, AST expr); // Generates code to store value of expr on dest void openstackframe(int size); // Generates code to reserve space for size variables void leaveprogram(void); // Generates code needed to leave a program (halt) void leaveprocedure(int blocklevel); // Generates code needed to leave a regular procedure at a given blocklevel void leavefunction(int blocklevel); // Generates code needed to leave a function at given blockLevel void functioncheck(void); // Generates code to ensure that a function has returned a value void storelabel(CGEN_labels &location); // Stores address of next instruction in location for use in backpatching void jump(CGEN_labels &here, CGEN_labels destination); // Generates unconditional branch from here to destination void jumponfalse(AST condition, CGEN_labels &here, CGEN_labels destination); // Generates branch from here to destination, dependent on condition void backpatch(CGEN_labels location); // Stores the current location counter as the address field of the branch // instruction currently held in an incomplete form at location void markstack(AST &p, int level, int entrypoint); // Generates code to reserve mark stack storage before calling procedure p // with known level and entrypoint void linkparameter(AST &p, AST &par); // Adds par to the actual parameter list for call to procedure p void call(AST &p); // Generates code to enter procedure p void cobegin(CGEN_labels &location); // Generates code to initiate concurrent processing void coend(CGEN_labels location, int number); // Generates code to terminate concurrent processing void forkprocess(AST &p); // Generates code to initiate process p void signalop(AST s); // Generates code for semaphore signalling operation on s void waitop(AST s); // Generates code for semaphore wait operation on s void dump(void); // Generates code to dump the current state of the evaluation stack void getsize(int &codelength, int &initsp); // Returns length of generated code and initial stack pointer int gettop(void); // Returns codetop void emit(int word); // Emits single word private: REPORT *Report; bool generatingcode; STKMC_address codetop, stktop; void binaryop(CGEN_operators op, AST &left, AST &right); };

#endif /*CGEN_H*/ ----- cgen.cpp ---------------------------------------------------// // // // // Code Generation for Clang Level 4 compiler/interpreter AST version for stack machine (OOP) Includes procedures, functions, parameters, arrays, concurrency. Display machine. P.D. Terry, Rhodes University, 1996

#include "misc.h" #include "cgen.h" #include "report.h" extern STKMC *Machine; extern CGEN *CGen; extern REPORT *Report; // ++++++++++++++ AST node classes +++++++++++++++++++++++++++++++++++++++++ struct NODE { int value; // value derived from this node bool defined; // true if value is defined (for constant nodes) bool refnode; // true if node corresponds to a reference NODE() { defined = false; refnode = false; } virtual void emit1(void) = 0; virtual void emit2(void) = 0; virtual void link(AST next) = 0; }; struct BINOPNODE : public NODE { CGEN_operators op; AST left, right; BINOPNODE(CGEN_operators O, AST L, AST R) { op = O; left = L; right = R; } virtual void emit1(void); // load value onto stack virtual void emit2(void) {;} virtual void link(AST next) {;} }; void BINOPNODE::emit1(void) // load value onto stack resulting from binary operation { bool folded = false; if (left && right) { // Some optimizations (others are left as an exercise). // These need improvement so as to perform range checking switch (op) { case CGEN_opadd: if (right->defined && right->value == 0) // x + 0 = x { left->emit1(); folded = true; } else if (left->defined && left->value == 0) // 0 + x = x { right->emit1(); folded = true; } break; case CGEN_opsub: if (right->defined && right->value == 0) // x - 0 = x { left->emit1(); folded = true; } else if (left->defined && left->value == 0) // 0 - x = -x { right->emit1(); CGen->emit(int(STKMC_neg)); folded = true; } break; case CGEN_opmul: if (right->defined && right->value == 1) // x * 1 = x { left->emit1(); folded = true; } else if (left->defined && left->value == 1) // 1 * x = x { right->emit1(); folded = true; } else if (right->defined && right->value == 0) // x * 0 = 0 { right->emit1(); folded = true; } else if (left->defined && left->value == 0) // 0 * x = 0 { left->emit1(); folded = true; } break; case CGEN_opdvd: if (right->defined && right->value == 1) // x / 1 = x { left->emit1(); folded = true; } else if (right->defined && right->value == 0) // x / 0 = error { Report->error(224); folded = true; } break; // no folding attempted here for relational operations } } if (!folded) { if (left) left->emit1(); if (right) right->emit1();

CGen->emit(int(STKMC_add) + int(op)); // careful - ordering used } if (left) delete left; if (right) delete right; } struct MONOPNODE : public NODE { CGEN_operators op; // for expansion - only negation used here AST operand; MONOPNODE(CGEN_operators O, AST E) { op = O; operand = E; } virtual void emit1(void); // load value onto stack virtual void emit2(void) {;} virtual void link(AST next) {;} }; void MONOPNODE::emit1(void) // load value onto stack resulting from unary operation { if (operand) { operand->emit1(); delete operand; } CGen->emit(int(STKMC_neg)); } struct VARNODE : public NODE { bool ref; // direct or indirectly accessed int level; // static level of declaration int offset; // offset of variable assigned by compiler VARNODE() {;} // default VARNODE(bool byref, int L, int O) { ref = byref; level = L; offset = O; } virtual void emit1(void); // load variable value onto stack virtual void emit2(void); // load variable address onto stack virtual void link(AST next) {;} }; void VARNODE::emit1(void) // load variable value onto stack { emit2(); CGen->emit(int(STKMC_val)); } void VARNODE::emit2(void) // load variable address onto stack { CGen->emit(int(STKMC_adr)); CGen->emit(level); CGen->emit(-offset); if (ref) CGen->emit(int(STKMC_val)); } struct INDEXNODE : public VARNODE { AST size; // for range checking AST index; // subscripting expression INDEXNODE(bool byref, int L, int O, AST S, AST I) { ref = byref; level = L; offset = O; size = S; index = I; } virtual void emit2(void); // load array element address and check virtual void link(AST next) {;} }; void INDEXNODE::emit2(void) // load array element address and check in range { CGen->emit(int(STKMC_adr)); CGen->emit(level); CGen->emit(-offset); if (ref) CGen->emit(int(STKMC_val)); if (index) { index->emit1(); delete index; } if (size) { size->emit1(); delete size; } CGen->emit(int(STKMC_ind)); } // void INDEXNODE::emit1(void) is inherited from VARNODE struct REFNODE : public VARNODE { AST size; REFNODE(bool byref, int L, int O, AST S) { ref = byref; level = L; offset = O; size = S; refnode = 1; } virtual void emit1(void); // load array argument address and size virtual void emit2(void) {;} virtual void link(AST next) {;} }; void REFNODE::emit1(void) // load array argument address and size { CGen->emit(int(STKMC_adr)); CGen->emit(level); CGen->emit(-offset); if (ref) CGen->emit(int(STKMC_val)); if (size) { size->emit1(); delete size; } } struct CONSTNODE : public NODE { CONSTNODE(int V) { value = V; defined = true; } virtual void emit1(void); // load constant value onto stack virtual void emit2(void) {;} virtual void link(AST next) {;}

}; void CONSTNODE::emit1(void) // load constant value onto stack { CGen->emit(int(STKMC_lit)); CGen->emit(value); } struct PARAMNODE : public NODE { AST par, next; PARAMNODE(AST P) { par = P; next = NULL; } virtual void emit1(void); // load actual parameter onto stack virtual void emit2(void) {;} virtual void link(AST param) { next = param; } }; void PARAMNODE::emit1(void) // load actual parameter onto stack { if (par) { par->emit1(); delete par; } if (next) { next->emit1(); delete next; } }

// follow link to next parameter

struct PROCNODE : public NODE { int level, entrypoint; // static level and first instruction AST firstparam, lastparam; // pointers to argument list PROCNODE(int L, int ent) { level = L; entrypoint = ent; firstparam = NULL; lastparam = NULL; } virtual void emit1(void); // generate procedure/function call virtual void emit2(void); // generate process call virtual void link(AST next); // link next actual parameter }; void PROCNODE::emit1(void) // generate procedure/function call { CGen->emit(int(STKMC_mst)); if (firstparam) { firstparam->emit1(); delete firstparam; } CGen->emit(int(STKMC_cal)); CGen->emit(level); CGen->emit(entrypoint); } void PROCNODE::emit2(void) // generate process call { CGen->emit(int(STKMC_mst)); if (firstparam) { firstparam->emit1(); delete firstparam; } CGen->emit(int(STKMC_frk)); CGen->emit(entrypoint); } void PROCNODE::link(AST param) // link next actual parameter { if (!firstparam) firstparam = param; else lastparam->link(param); lastparam = param; } // +++++++++++++++ code generator constructor +++++++++++++++++++++++++ CGEN::CGEN(REPORT *R) { undefined = 0; // for forward references (exported) Report = R; generatingcode = true; codetop = 0; stktop = STKMC_memsize - 1; } void CGEN::emit(int word) // Code generator for single word { if (!generatingcode) return; if (codetop >= stktop) { Report->error(212); generatingcode = false; } else { Machine->mem[codetop] = word; codetop++; } } bool CGEN::isrefast(AST a) { return a && a->refnode; } // +++++++++++++++ routines that build the tree +++++++++++++++++++++++++ AST CGEN::emptyast(void) { return NULL; } void CGEN::negateinteger(AST &i) { if (i && i->defined) { i->value = -i->value; return; } i = new MONOPNODE(CGEN_opsub, i); } // simple folding

void CGEN::binaryop(CGEN_operators op, AST &left, AST &right) { if (left && right && left->defined && right->defined) { // simple constant folding - better range checking needed switch (op) { case CGEN_opadd: left->value += right->value; break; case CGEN_opsub: left->value -= right->value; break; case CGEN_opmul: left->value *= right->value; break; case CGEN_opdvd: if (right->value == 0) Report->error(224); else left->value /= right->value; break; case CGEN_oplss: left->value = (left->value < right->value); break; case CGEN_opgtr: left->value = (left->value > right->value); break; case CGEN_opleq: left->value = (left->value <= right->value); break; case CGEN_opgeq: left->value = (left->value >= right->value); break; case CGEN_opeql: left->value = (left->value == right->value); break; case CGEN_opneq: left->value = (left->value != right->value); break; } delete right; return; } left = new BINOPNODE(op, left, right); } void CGEN::binaryintegerop(CGEN_operators op, AST &l, AST &r) { binaryop(op, l, r); } void CGEN::comparison(CGEN_operators op, AST &l, AST &r) { binaryop(op, l, r); } void CGEN::stackconstant(AST &c, int number) { c = new CONSTNODE(number); } void CGEN::stackaddress(AST &v, int level, int offset, bool byref) { v = new VARNODE(byref, level, offset); } void CGEN::linkparameter(AST &p, AST &par) { AST param = new PARAMNODE(par); p->link(param); } void CGEN::stackreference(AST &base, bool byref, int level, int offset, AST &size) { if (base) delete base; base = new REFNODE(byref, level, offset, size); } void CGEN::subscript(AST &base, bool byref, int level, int offset, AST &size, AST &index) // Note the folding of constant indexing of arrays, and compile time // range checking { if (!index || !index->defined || !size || !size->defined) { if (base) delete base; base = new INDEXNODE(byref, level, offset, size, index); return; } if (unsigned(index->value) >= size->value) // range check immediately Report->error(223); else { if (base) delete base; base = new VARNODE(byref, level, offset + index->value); } delete index; delete size; } void CGEN::markstack(AST &p, int level, int entrypoint) { p = new PROCNODE(level, entrypoint); } // +++++++++++++++ code generation requiring tree walk ++++++++++++++++++ void CGEN::jumponfalse(AST condition, CGEN_labels &here, CGEN_labels destination) { if (condition) { condition->emit1(); delete condition; } here = codetop; emit(int(STKMC_bze)); emit(destination); } void CGEN::assign(AST dest, AST expr) { if (dest) { dest->emit2(); delete dest; } if (expr) { expr->emit1(); delete expr; emit(int(STKMC_sto)); } } void CGEN::readvalue(AST i) { if (i) { i->emit2(); delete i; } emit(int(STKMC_inn)); } void CGEN::writevalue(AST i) { if (i) { i->emit1(); delete i; } emit(int(STKMC_prn)); }

void CGEN::call(AST &p) { if (p) { p->emit1(); delete p; } } void CGEN::signalop(AST s) { if (s) { s->emit2(); delete s; } emit(int(STKMC_sig)); } void CGEN::waitop(AST s) { if (s) { s->emit2(); delete s; } emit(int(STKMC_wgt)); } void CGEN::forkprocess(AST &p) { if (p) { p->emit2(); delete p; } } // +++++++++++++++ code generation not requiring tree walk ++++++++++++++ void CGEN::newline(void) { emit(int(STKMC_nln)); } void CGEN::writestring(CGEN_labels location) { emit(int(STKMC_prs)); emit(location); } void CGEN::stackstring(char *str, CGEN_labels &location) { int l = strlen(str); if (stktop <= codetop + l + 1) { Report->error(212); generatingcode = false; return; } location = stktop - 1; for (int i = 0; i < l; i++) { stktop--; Machine->mem[stktop] = str[i]; } stktop--; Machine->mem[stktop] = 0; } void CGEN::dereference(AST &a) { /* not needed */ } void CGEN::openstackframe(int size) { if (size > 0) { emit(int(STKMC_dsp)); emit(size); } } void CGEN::leaveprogram(void) { emit(int(STKMC_hlt)); } void CGEN::leavefunction(int blocklevel) { emit(int(STKMC_ret)); emit(blocklevel); emit(1); } void CGEN::functioncheck(void) { emit(int(STKMC_nfn)); } void CGEN::leaveprocedure(int blocklevel) { emit(int(STKMC_ret)); emit(blocklevel); emit(0); } void CGEN::cobegin(CGEN_labels &location) { location = codetop; emit(int(STKMC_cbg)); emit(undefined); } void CGEN::coend(CGEN_labels location, int number) { if (number >= STKMC_procmax) Report->error(216); else { Machine->mem[location+1] = number; emit(int(STKMC_cnd)); } } void CGEN::storelabel(CGEN_labels &location) { location = codetop; } void CGEN::jump(CGEN_labels &here, CGEN_labels destination) { here = codetop; emit(int(STKMC_brn)); emit(destination); } void CGEN::backpatch(CGEN_labels location) { if (codetop == location + 2 && STKMC_opcodes(Machine->mem[location]) == STKMC_brn) codetop -= 2; else Machine->mem[location+1] = codetop; } void CGEN::dump(void) { emit(int(STKMC_stk)); } void CGEN::getsize(int &codelength, int &initsp) { codelength = codetop; initsp = stktop; } int CGEN::gettop(void) { return codetop; } ----- clang.frm --------------------------------------------------/* Clang compiler generated by Coco/R 1.06 (C++ version) */ #include <stdio.h>

#include #include #include

<fcntl.h> <stdlib.h> <string.h>

#if __MSDOS__ || MSDOS || WIN32 || __WIN32__ # include <io.h> #else # include <unistd.h> # define O_BINARY 0 #endif #include #include #include #include #include "misc.h" "set.h" "table.h" "cgen.h" "stkmc.h"

typedef Set<7> classset; #include -->ScanHeader #include -->ParserHeader #include "cr_error.hpp" static FILE *lst; static char SourceName[256], ListName[256], CodeName[256]; TABLE CGEN STKMC REPORT *Table; *CGen; *Machine; *Report;

class clangError : public CRError { public: clangError(char *name, AbsScanner *S) : CRError(name, S, MAXERROR) {}; virtual char *GetUserErrorMsg(int n); virtual char *GetErrorMsg(int n) { if (n <= MAXERROR) return ErrorMsg[n]; else return GetUserErrorMsg(n); } private: static char *ErrorMsg[]; }; char *clangError::ErrorMsg[] = { #include -->ErrorHeader "User error number clash", "" }; char *clangError::GetUserErrorMsg(int n) { switch (n) { // first few are extra syntax errors case 91: return "Relational operator expected"; case 92: return "Malformed expression"; case 93: return "Bad declaration order"; // remainder are constraint (static semantic) errors case 200: return "Constant out of range"; case 201: return "Identifier redeclared"; case 202: return "Undeclared identifier"; case 203: return "Unexpected parameters"; case 204: return "Unexpected subscript"; case 205: return "Subscript required"; case 206: return "Invalid class of identifier"; case 207: return "Variable expected"; case 208: return "Too many formal parameters"; case 209: return "Wrong number of parameters"; case 210: return "Invalid assignment"; case 211: return "Cannot read this type of variable"; case 212: return "Program too long"; case 213: return "Too deeply nested"; case 214: return "Invalid parameter"; case 215: return "COBEGIN only allowed in main program"; case 216: return "Too many concurrent processes"; case 217: return "Only global procedure calls allowed here"; case 218: return "Type mismatch"; case 219: return "Unexpected expression"; case 220: return "Missing expression"; case 221: return "Boolean expression required"; case 222: return "Invalid expression"; case 223: return "Index out of range"; case 224: return "Division by zero"; default: return "Compiler error"; } }

class clangReport : public REPORT { // interface for code generators and other auxiliaries public: clangReport(clangError *E) { Error = E; } virtual void error(int errorcode) { Error->ReportError(errorcode); errors = true; } private: clangError *Error; }; void main(int argc, char *argv[]) { int codelength, initsp; int S_src; char reply; lst = stderr; // check on correct parameter usage if (argc < 2) { fprintf(stderr, "No input file specified\n"); exit(1); } // open the source file strcpy(SourceName, argv[1]); if ((S_src = open(SourceName, O_RDONLY | O_BINARY)) == -1) { fprintf(stderr, "Unable to open input file %s\n", SourceName); exit(1); } if (argc > 2) strcpy(ListName, argv[2]); else appendextension(SourceName, ".lst", ListName); if ((lst = fopen(ListName, "w")) == NULL) { fprintf(stderr, "Unable to open list file %s\n", ListName); exit(1); } // instantiate Scanner, Parser and Error handlers -->ScanClass *Scanner = new -->ScanClass(S_src, -->IgnoreCase); clangError *Error = new clangError(SourceName, Scanner); -->ParserClass *Parser = new -->ParserClass(Scanner, Error); Report = new clangReport(Error); CGen = new CGEN(Report); Table = new TABLE(Report); Machine = new STKMC(); // parse the source Parser->Parse(); close(S_src); // generate source listing Error->SetOutput(lst); Error->PrintListing(Scanner); fclose(lst); // list generated code for interest CGen->getsize(codelength, initsp); appendextension(SourceName, ".cod", CodeName); Machine->listcode(CodeName, codelength); if (Error->Errors) fprintf(stderr, "Compilation failed - see %s\n", ListName); else { fprintf(stderr, "Compilation successful\n"); while (true) { printf("\nInterpret? (y/n) "); do { scanf("%c", &reply); } while (toupper(reply) != N && toupper(reply) != Y); if (toupper(reply) == N) break; scanf("%*[^\n]"); getchar(); Machine->interpret(codelength, initsp); } } delete delete delete delete delete delete delete } Scanner; Parser; Error; Table; Report; CGen; Machine;