&{ ================================================================ %% This is a translator from C- into a small abstract machine %% language. It uses an attribute grammar to specify the %% translation, and is written in a variant of yacc for Astarte. %% %% This version has VERY crude error checking and reporting. ================================================================ Import "testlexer". Import "machinedefs". Import "collect/listfun". Import "collect/sort". ================================================================ %% TYPE DEFINITIONS ================================================================ ---------------------------------------------------------- %% An Instruction describes a single machine executable %% instruction. ---------------------------------------------------------- Species Instruction = oneByteInstruction Natural | twoByteInstruction (Natural, Natural) | callInstruction (Natural, String) %Species ---------------------------------------------------------- %% A Type is one of the types that a variable might have. %% (Note: for this language, it would suffice to store the %% number of parameters of a function, not the types of all %% of the parameters. ---------------------------------------------------------- Species Type = integer_type | void_type | int_array Natural %% array, with size. | fun_type (Type, [Type]) %% (Return-type, Param-types) %Species ---------------------------------------------------------- %% A VarKind is one of the areas where a variable might %% be stored. ---------------------------------------------------------- Species VarKind = localvar | parameter | globalvar | other %Species ---------------------------------------------------------- %% The symbol table is a list of TableEntry values. Each %% holds the name of a variable, the area where that %% variable is stored, the offset of that variable in its %% area and the type of the variable. ---------------------------------------------------------- Abbrev TableEntry = (String, VarKind, Natural, Type). ---------------------------------------------------------- %% A Context holds a label number -- the next local label %% to be used. ---------------------------------------------------------- Species{noEqual} Context = (nextLabel ~> <:Natural:>, vartbl ~> [TableEntry] ) %Species ---------------------------------------------------------- %% The constant table is a list of ConstTableEntry values. %% Each entry holds a constant and an offset in the constant %% table where that constant is stored. ---------------------------------------------------------- Abbrev ConstTableEntry = (Natural, Natural) %% (Value, Offset) of constant table %Abbrev ---------------------------------------------------------- ================================================================ %% GLOBAL VARIABLES ================================================================ ---------------------------------------------------------- %% genfile contains the file where the code is written. ---------------------------------------------------------- Var genfile : Outfile(Char). ---------------------------------------------------------- %% binaryOutput is set true for output to be in binary, %% and to false for output to be in symbolic (assembly) form. ---------------------------------------------------------- Var binaryOutput: Boolean := false. ---------------------------------------------------------- %% offsetConst holds the offset in the constant table where %% the next constant will be put. ---------------------------------------------------------- Var offsetConst: Natural := 0. ---------------------------------------------------------- %% constTable is the constant table. It holds a list of %% constant table entries. ---------------------------------------------------------- Var constTable: [ConstTableEntry] := []. ---------------------------------------------------------- %% globalTable contains table entries for global %% variables and functions. ---------------------------------------------------------- Var globalTable: [TableEntry] := []. ================================================================ %% FUNCTIONS AND THEIR TYPES ================================================================ Expect UnknownVariable : String -> (). Expect CheckNoDuplicates: [TableEntry] -> (). Expect CheckInt : Type -> (). Expect CheckIntArray : Type -> (). Expect checkParams : (String, [Type], [TableEntry]) -> Type. Expect sortVartbl : [TableEntry] -> ([TableEntry], [TableEntry]). Expect fetchVar : (String, [TableEntry]) -> [Instruction]. Expect genOp : (OpKind, Type, Type) -> [Instruction]. Expect genRelop : (OpKind, <:Natural:>) -> [Instruction]. Expect genPop : (Type) -> [Instruction]. Expect genConst : (Natural) -> Natural. Expect genAlloc : ([TableEntry],[TableEntry]) -> [Instruction]. Expect genDealloc : ([TableEntry],[TableEntry]) -> [Instruction]. Expect sizeVars : (VarKind, [TableEntry]) -> Natural. Expect gen : ([Instruction]) -> (String). Expect gen : (Instruction) -> (String). Expect PrintConstTable : ([ConstTableEntry]) -> (). Expect GenByteCode : ([Instruction]) -> (). Expect WriteOneByteDeclaration: Natural -> (). Expect WriteTwoByteDeclaration: (Natural, Natural) -> (). Expect WriteStringDeclaration : (Natural, String) -> (). Expect WriteGlobalVars : [TableEntry] -> (). ================================================================ %% BEGIN PARSER ================================================================ &} /*--------------------------------------------------------------* * TOKENS * *--------------------------------------------------------------* * &token name * * * * indicates that token name has an attribute of type T. * *--------------------------------------------------------------*/ &token rw_INT /* int */ &token rw_VOID /* void */ &token rw_IF /* if */ &token rw_ELSE /* else */ &token rw_WHILE /* while */ &token rw_RETURN /* return */ &token tok_COMMA /* , */ &token tok_EQUAL /* = */ &token tok_SEMICOLON /* ; */ &token tok_LEFT_CURLY /* { */ &token tok_RIGHT_CURLY /* } */ &token tok_LEFT_PAREN /* ( */ &token tok_RIGHT_PAREN /* ) */ &token tok_LEFT_BRACKET /* [ */ &token tok_RIGHT_BRACKET /* ] */ &token tok_ID /* an identifier */ &token tok_NUM /* a numeric constant */ &token tok_ADDOP /* + and - */ &token tok_MULOP /* * and / */ &token tok_RELOP /* <=, <, >, >=, ==, != */ /*--------------------------------------------------------------* * ATTRIBUTES OF NONTERMINALS * *--------------------------------------------------------------* * &s-attribute N A * * * * indicates that nonterminal N has a synthesized attribute * * called A of type T. * * * * &i-attribute N A * * * * indicates that nonterminal N has an inherited attribute * * called A of type T. * *--------------------------------------------------------------*/ /* TYPE NONTERMINAL ATTRIBUTE */ /* -------------- ------------ ----------*/ &s-attribute <()> program gencode &s-attribute <()> startup gencode &s-attribute <()> declaration_list gencode &s-attribute <[TableEntry]> declaration_list entries &s-attribute <()> declaration gencode &s-attribute <[TableEntry]> declaration entries &i-attribute <[TableEntry]> declaration vartbl &s-attribute <[TableEntry]> var_declaration vartbl &i-attribute var_declaration varscope &i-attribute var_declaration offset &s-attribute type_specifier type &s-attribute <()> fun_declaration gencode &s-attribute fun_declaration entry &i-attribute <[TableEntry]> fun_declaration vartbl &s-attribute <[TableEntry]> params vartbl &s-attribute <[Type]> params types &s-attribute <[TableEntry]> param_list vartbl &s-attribute <[Type]> param_list types &s-attribute param_list size &s-attribute param type &s-attribute param entry &i-attribute param offset &s-attribute <[TableEntry]> local_declarations vartbl &s-attribute local_declarations size &i-attribute local_declarations offset &s-attribute <[Instruction]> statement_list code &i-attribute statement_list context &s-attribute <[Instruction]> statement code &i-attribute statement context &s-attribute <[Instruction]> expression_stmt code &i-attribute expression_stmt context &s-attribute <[Instruction]> compound_stmt code &i-attribute compound_stmt context &s-attribute <[Instruction]> selection_stmt code &i-attribute selection_stmt context &s-attribute <[Instruction]> iteration_stmt code &i-attribute iteration_stmt context &s-attribute <[Instruction]> return_stmt code &i-attribute return_stmt context &s-attribute <[Instruction]> expression code &s-attribute expression type &i-attribute expression context &s-attribute var name &s-attribute <[Instruction]> var code &i-attribute var context &s-attribute <[Instruction]> simple_expression code &s-attribute simple_expression type &i-attribute simple_expression context &s-attribute <[Instruction]> additive_expression code &s-attribute additive_expression type &i-attribute additive_expression context &s-attribute <[Instruction]> term code &s-attribute term type &i-attribute term context &s-attribute <[Instruction]> factor code &s-attribute factor type &i-attribute factor context &s-attribute <[Instruction]> call code &s-attribute call type &i-attribute call context &s-attribute <[Instruction]> args code &s-attribute args size &s-attribute <[Type]> args types &i-attribute args context &s-attribute <[Instruction]> arg_list code &s-attribute arg_list size &s-attribute <[Type]> arg_list types &i-attribute arg_list context /*------------------------------------------------------------* * NAME OF FUNCTION TO CREATE * *------------------------------------------------------------*/ &function parser && /*----------------------------------------------------------------------* * BEGIN GRAMMAR * *----------------------------------------------------------------------*/ /*----------------------------------------------------------------------* * ATTRIBUTES AND ATTRIBUTE EQUATIONS * *----------------------------------------------------------------------* * attr% = the attribute called attr of the left-hand side of * * the production. * * * * attr%n = the attribute called attr of the n-th thing on the * * right-hand side of the production. * * * * %n = the attribute of the token that is the n-th thing * * on the right-hand side of the production. * * * * An equation has the form * * * * attr : attrs * * = {val} * * * * This indicates that attr can only be computed after all of the * * attributes in list attrs have been computed. The value of attr is * * given by expression val. * * * * The attribute equations are put inside {...} after the production. * * * * When describing attributes in commments, [s] indicates a synthesized * * attribute and [i] indicates an inherited attribute. * *----------------------------------------------------------------------*/ /*======================================================================*/ /* program */ /*======================================================================* /* Attributes: */ /* */ /* [s] gencode: This attribute performs an action. It writes the */ /* constant table at the end of the code. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <()> program gencode */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &s-attribute <()> declaration_list gencode */ /* &s-attribute <()> startup gencode */ /*======================================================================*/ program : startup declaration_list { gencode% : gencode%1 gencode%2 = {PrintConstTable(!constTable).} } ; startup : /* empty */ { gencode% : = {WriteStringDeclaration(ms_START, "main").} } ; /*======================================================================*/ /* declaration_list */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] gencode: This forces generation of the code for the */ /* declarations in this declaration list. */ /* */ /* [s] entries: This is a list of the symbol table entries created */ /* by this declaration list. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <()> declaration_list gencode */ /* &s-attribute <[TableEntry]> declaration_list entries */ /* &i-attribute <[TableEntry]> declaration vartbl */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &s-attribute <()> declaration gencode */ /* &s-attribute <[TableEntry]> declaration entries */ /*======================================================================*/ declaration_list : declaration_list declaration { gencode% : gencode%1 gencode%2 = { () } entries% : entries%1 entries%2 = { entries%2 ++ entries%1 } vartbl%2 : entries%1 gencode%1 = { entries%1 ++ !globalTable } } | declaration { gencode% : gencode%1 = { () } entries% : entries%1 = {entries%1} vartbl%1 : = { !globalTable } } ; /*======================================================================*/ /* declaration */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] gencode: This forces generation of the code for */ /* this declaration. */ /* */ /* [s] entry: This is a symbol table entry telling the symbol that */ /* this declaration defines. */ /* */ /* [i] vartbl: This is a symbol table telling what is defined in the */ /* context where this declaration occurs. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <()> declaration gencode */ /* &s-attribute <[TableEntry]> declaration entries */ /* &i-attribute <[TableEntry]> fun_declaration vartbl */ /* &i-attribute var_declaration varscope */ /* &i-attribute var_declaration offset */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute <[TableEntry]> declaration vartbl */ /* &s-attribute <[TableEntry]> var_declaration vartbl */ /* &s-attribute <()> fun_declaration gencode */ /* &s-attribute fun_declaration entry */ /*======================================================================*/ declaration : var_declaration { gencode% : vartbl%1 = {WriteGlobalVars(vartbl%1).} entries% : vartbl%1 = {Make globalTable := vartbl%1 ++ !globalTable. If optionb "Trace" then Writeln["--Storing global var entry in table"]. %If Value vartbl%1. } varscope%1 : = { globalvar } offset%1 : vartbl% = { sizeVars(globalvar, vartbl%) } } | fun_declaration { gencode% : gencode%1 = { () } entries% : entry%1 = {Make globalTable := entry%1 :: !globalTable. If optionb "Trace" then Writeln["--Storing function entry in table"]. %If Value [entry%1]. } vartbl%1 : vartbl% = { vartbl% } } ; /*======================================================================*/ /* var_declaration */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] vartbl: This is a symbol table telling information about the */ /* variable defined in this declaration. */ /* */ /* [i] varscope: This is the kind of variable that is defined here */ /* (localvar or globalvar). */ /* */ /* [i] offset: This is the offset of this variable in its area. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[TableEntry]> var_declaration vartbl */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute var_declaration varscope */ /* &i-attribute var_declaration offset */ /* &s-attribute type_specifier type */ /* &token tok_ID */ /* &token tok_NUM */ /*======================================================================*/ var_declaration : type_specifier tok_ID tok_SEMICOLON { vartbl% : type%1 varscope% offset% = {CheckInt(type%1). [(%2, varscope%, offset%, type%1)] } } | type_specifier tok_ID tok_LEFT_BRACKET tok_NUM tok_RIGHT_BRACKET tok_SEMICOLON { vartbl% : type%1 varscope% offset% = {CheckInt(type%1). [(%2, varscope%, offset%, int_array(%4))] } } ; /*======================================================================*/ /* type_specifier */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] type: This is the type indicated by the type_specifier. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute type_specifier type */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /*======================================================================*/ type_specifier : rw_INT { type% : = { integer_type } } | rw_VOID { type% : = { void_type } } ; /*======================================================================*/ /* fun_declaration */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] gencode: This attribute has no value, but writes the code for */ /* the function definition. */ /* */ /* [s] entry: This is a symbol table entry that describes the */ /* function, giving its return-type and parameter types. */ /* */ /* [i] vartbl: This is a symbol table indicating what is defined in */ /* the context where this function definition occurs. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]>fun_declaration gencode */ /* &i-attribute compound_stmt context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute <[TableEntry]> fun_declaration vartbl */ /* &s-attribute <[Instruction]> compound_stmt code */ /* &s-attribute <[TableEntry]> params vartbl */ /*======================================================================*/ fun_declaration : type_specifier tok_ID tok_LEFT_PAREN params tok_RIGHT_PAREN compound_stmt { gencode% : code%6 = {WriteStringDeclaration(ms_FUNCTION, $(%2)). GenByteCode(code%6 ++ [oneByteInstruction m_RETURN]). WriteOneByteDeclaration ms_END. } entry% : type%1 types%4 = { (%2, other, 0, fun_type(type%1, types%4)) } context%6 : vartbl%4 vartbl% = { context(nextLabel ~> <:0:>, vartbl ~> vartbl%4 ++ vartbl% ) } } ; /*======================================================================*/ /* params */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] types: This is a list of the types of the parameters, in the */ /* same order as the parameters. It is an empty list if */ /* there are no parameters. */ /* */ /* [s] vartbl: This is a symbol table indicating the parameters */ /* of a function. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Type]> param types */ /* &s-attribute <[TableEntry]> param vartbl */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &s-attribute <[Type]> param_list types */ /* &s-attribute <[TableEntry]> param_list vartbl */ /*======================================================================*/ params : param_list { types% : types%1 = { types%1 } vartbl% : vartbl%1 = {CheckNoDuplicates(vartbl%1). Value vartbl%1. } } | rw_VOID { types% : = { [] } vartbl% : = { [] } } ; /*======================================================================*/ /* param_list */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] types: This is a list of the types of the parameters, in the */ /* same order as the parameters. It is an empty list if */ /* there are no parameters. */ /* */ /* [s] vartbl: This is a symbol table indicating the parameters */ /* in the param_list. */ /* */ /* [s] size: This is the number of words occupied by the */ /* parameters in this param_list. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Type]> param_list types */ /* &s-attribute <[TableEntry]> param_list vartbl */ /* &s-attribute param_list size */ /* &i-attribute param offset */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &s-attribute <[Type]> param_list types */ /* &s-attribute <[TableEntry]> param_list vartbl */ /* &s-attribute param_list size */ /* &s-attribute param type */ /* &s-attribute <[TableEntry]> param entry */ /*======================================================================*/ param_list : param_list tok_COMMA param { types% : types%1 type%3 = { types%1 ++ [type%3] } vartbl% : vartbl%1 entry%3 = { vartbl%1 ++ [entry%3] } size% : size%1 = {size%1 + 1} offset%3 : size%1 = {size%1} } | param { types% : type%1 = { [type%1] } vartbl% : entry%1 = { [entry%1] } size% : = {1} offset%1 : = {0} } ; /*======================================================================*/ /* param */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] type: This is the type of this parameter. */ /* */ /* [s] entry: This is a symbol table entry for this parameter. */ /* */ /* [i] offset: This is the offset of this parameter in the parameter */ /* area. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute param type */ /* &s-attribute <[TableEntry]> param entry */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute param offset */ /* &s-attribute type_specifier type */ /* &token tok_ID */ /*======================================================================*/ param : type_specifier tok_ID { type% : type%1 = { type%1 } entry% : type%1 offset% = {CheckInt(type%1). (%2, parameter, offset%, type%1) } } | type_specifier tok_ID tok_LEFT_BRACKET tok_RIGHT_BRACKET { type% : type%1 = {CheckInt(type%1). Value int_array(0). } entry% : type%1 offset% = {CheckInt(type%1). (%2, parameter, offset%, int_array(0)) } } ; /*======================================================================*/ /* compound_statement */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is a list of instructions that performs this */ /* compound statement. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> compound_stmt code */ /* &i-attribute statement_list context */ /* &i-attribute local_declarations offset */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute compound_stmt context */ /* &s-attribute <[Instruction]>statement_list code */ /* &s-attribute <[TableEntry]> local_declarations vartbl */ /* &s-attribute local_declarations size */ /*======================================================================*/ compound_stmt : tok_LEFT_CURLY local_declarations statement_list tok_RIGHT_CURLY { code% : code%3 vartbl%2 = {Let tblpair = sortVartbl(vartbl%2). Value genAlloc(tblpair) ++ code%3 ++ genDealloc(tblpair) %Value } context%3 : context% vartbl%2 = {CheckNoDuplicates(vartbl%2). Match context(?a,?tbl) = context%. Value context(a, vartbl%2 ++ tbl). } offset%2 : context% = { sizeVars(localvar, vartbl(context%)) } } ; /*======================================================================*/ /* local_declarations */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] vartbl: This is a symbol table describing the variables that */ /* are declared in this list of declarations. */ /* */ /* [s] size : This is the number of words occupied by the variables */ /* defined in this declarations list. */ /* */ /* [i] offset: This is the number of words occupied by the variables */ /* declared locally before this declaration list. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[TableEntry]> local_declarations vartbl */ /* &s-attribute local_declarations size */ /* &i-attribute local_declarations offset */ /* &i-attribute var_declaration varscope */ /* &i-attribute var_declaration offset */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute local_declarations offset */ /* &s-attribute <[TableEntry]> local_declarations vartbl */ /* &s-attribute local_declarations size */ /* &s-attribute <[TableEntry]> var_declaration vartbl */ /*======================================================================*/ local_declarations : local_declarations var_declaration { vartbl% : vartbl%1 vartbl%2 = { vartbl%1 ++ vartbl%2 } size% : size%1 = {size%1 + 1} varscope%2 : = { localvar } offset%1 : offset% = {offset%} offset%2 : size%1 offset% = { offset% + size%1 } } | /* empty */ { vartbl% : = { [] } size% : = { 0 } } ; /*======================================================================*/ /* statement_list */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that performs these statements. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]>statement_list code */ /* &i-attribute statement_list context */ /* &i-attribute statement context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute statement_list context */ /*======================================================================*/ statement_list : statement_list statement { code% : code%1 code%2 = { code%1 ++ code%2 } context%1 : context% = { context% } context%2 : context% = { context% } } | /* empty */ { code% : = { [] } } ; /*======================================================================*/ /* statement */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that performs this statement. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> statement code */ /* &i-attribute * context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute statement context */ /* &s-attribute <[Instruction]> * code */ /*======================================================================*/ statement : expression_stmt { code% : code%1 = { code%1 } context%1 : context% = { context% } } | compound_stmt { code% : code%1 = { code%1 } context%1 : context% = { context% } } | selection_stmt { code% : code%1 = { code%1 } context%1 : context% = { context% } } | iteration_stmt { code% : code%1 = { code%1 } context%1 : context% = { context% } } | return_stmt { code% : code%1 = { code%1 } context%1 : context% = { context% } } ; /*======================================================================*/ /* expression_stmt */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that performs this statement. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> expression_stmt code */ /* &i-attribute expression context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute expression_stmt context */ /* &s-attribute <[Instruction]> expression code */ /* &s-attribute expression type */ /*======================================================================*/ expression_stmt : expression tok_SEMICOLON { code% : code%1 type%1 = { code%1 ++ genPop(type%1) } context%1 : context% = { context% } } | tok_SEMICOLON { code% : = {[]} } ; /*======================================================================*/ /* selection_stmt */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that performs this statement. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> selection_stmt code */ /* &i-attribute expression context */ /* &i-attribute statement context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute selection_stmt context */ /* &s-attribute <[Instruction]> expression code */ /* &s-attribute <[Instruction]> statement code */ /*======================================================================*/ selection_stmt : rw_IF tok_LEFT_PAREN expression tok_RIGHT_PAREN statement { code% : code%3 code%5 context% type%3 = {Let lbx = nextLabel(context%). Let label1 = !lbx. Inc lbx. CheckInt(type%3). Value code%3 ++ [twoByteInstruction(m_GOTO_IF_ZERO, label1)] ++ code%5 ++ [twoByteInstruction(m_LABEL, label1)] %Value } context%3 : context% = { context% } context%5 : context% = { context% } } | rw_IF tok_LEFT_PAREN expression tok_RIGHT_PAREN statement rw_ELSE statement { code% : code%3 code%5 code%7 context% type%3 = {Let lbx = nextLabel(context%). Let label1 = !lbx. Let label2 = label1 + 1. Make lbx := !lbx + 2. CheckInt(type%3). Value code%3 ++ [twoByteInstruction(m_GOTO_IF_ZERO, label1)] ++ code%5 ++ [twoByteInstruction(m_GOTO, label2), twoByteInstruction(m_LABEL, label1)] ++ code%7 ++ [twoByteInstruction(m_LABEL, label2)] %Value } context%3 : context% = { context% } context%5 : context% = { context% } context%7 : context% = { context% } } ; /*======================================================================*/ /* iteration_statement */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that performs this statement. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> iteration_stmt code */ /* &i-attribute expression context */ /* &i-attribute statement context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute iteration_stmt context */ /* &s-attribute <[Instruction]> expression code */ /* &s-attribute <[Instruction]> statement code */ /*======================================================================*/ iteration_stmt : rw_WHILE tok_LEFT_PAREN expression tok_RIGHT_PAREN statement { code% : code%3 code%5 context% type%3 = {Let lbx = nextLabel(context%). Let label1 = !lbx. Let label2 = label1 + 1. Make lbx := !lbx + 2. CheckInt(type%3). Value [twoByteInstruction(m_LABEL, label1)] ++ code%3 ++ [twoByteInstruction(m_GOTO_IF_ZERO, label2)] ++ code%5 ++ [twoByteInstruction(m_GOTO, label1), twoByteInstruction(m_LABEL, label2)] %Value } context%3 : context% = { context% } context%5 : context% = { context% } } ; /*======================================================================*/ /* return_stmt */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that performs this statement. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> return_stmt code */ /* &i-attribute expression context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute return_stmt context */ /* &s-attribute <[Instruction]> expression code */ /*======================================================================*/ return_stmt : rw_RETURN tok_SEMICOLON { code% : = { [oneByteInstruction(m_RETURN)] } } | rw_RETURN expression tok_SEMICOLON { code% : code%2 type%2 = {CheckInt(type%2). Value code%2 ++ [oneByteInstruction(m_RETURN_INTEGER)] %Value } context%2 : context% = { context% } } ; /*======================================================================*/ /* expression */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that computes this expression and */ /* leaves its value on top of the stack. */ /* */ /* [s] type: This is the type of this expression. Currently, all */ /* expressions have type integer_type. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> expression code */ /* &s-attribute expression type */ /* &i-attribute expression context */ /* &i-attribute simple_expression context */ /* &i-attribute var context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute expression context */ /* &s-attribute <[Instruction]> expression code */ /* &s-attribute expression type */ /* &s-attribute <[Instruction]> simple_expression code */ /* &s-attribute simple_expression type */ /* &s-attribute <[Instruction]> var code */ /* &s-attribute var name */ /*======================================================================*/ expression : var tok_EQUAL expression { code% : name%1 code%1 code%3 type%3 context% = {CheckInt(type%3). Try Match(?kind, ?offset, ?types) = assoc name%1 (vartbl(context%)). then If nil? code%1 then code%3 ++ [oneByteInstruction(m_DUP_INTEGER), twoByteInstruction(m_STORE_LOCAL_INTEGER, offset)] else fetchVar(name%1, vartbl(context%)) ++ code%1 ++ code%3 ++ [oneByteInstruction( m_STORE_LEAVE_INTEGER_INDEXED)] %If else UnknownVariable(name%1). [] %Try } type% : type%3 = { type%3 } context%1 : context% = { context% } context%3 : context% = { context% } } | simple_expression { code% : code%1 = { code%1 } type% : type%1 = { type%1 } context%1 : context% = { context% } } ; /*======================================================================*/ /* var */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] name: This is the name of this variable. */ /* */ /* [s] code: In the case where this variable is an array reference, */ /* the code attribute is the code for the array index, */ /* and the name is the array name. If this variable is */ /* a simple variable, then the code is an empty list. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute var name */ /* &s-attribute <[Instruction]> var code */ /* &i-attribute expression context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &token tok_ID */ /* &s-attribute <[Instruction]> expression code */ /*======================================================================*/ var : tok_ID { name% : = { %1 } code% : context% = {Try Match (?,?,?tp) = assoc %1 (vartbl(context%)). then CheckInt(tp). [] else UnknownVariable(%1). [] %Try } } | tok_ID tok_LEFT_BRACKET expression tok_RIGHT_BRACKET { code% : context% code%3 type%3 = {Try Match (?,?,?tp) = assoc %1 (vartbl(context%)). then CheckIntArray(tp). CheckInt(type%3). Value code%3. else UnknownVariable(%1). [] %Try } name% : %1 = { %1 } context%3 : context% = { context% } } ; /*======================================================================*/ /* simple_expression */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that computes this expression and */ /* leaves its value on top of the stack. */ /* */ /* [s] type: This is the type of this expression. Currently, all */ /* expressions have type integer_type. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> simple_expression code */ /* &s-attribute simple__expression type */ /* &i-attribute additive_expression context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute simple_expression context */ /* &s-attribute <[Instruction]> additive_expression code */ /* &s-attribute additive_expression type */ /* &token tok_RELOP */ /*======================================================================*/ simple_expression : additive_expression tok_RELOP additive_expression { code% : type%1 code%1 type%3 code%3 context% = {CheckInt(type%1). CheckInt(type%3). Value code%1 ++ code%3 ++ genRelop(%2, nextLabel(context%)). } type% : = { integer_type } context%1 : context% = { context% } context%3 : context% = { context% } } | additive_expression { code% : code%1 = { code%1 } type% : type%1 = { type%1 } context%1 : context% = { context% } } ; /*======================================================================*/ /* additive_expression */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that computes this expression and */ /* leaves its value on top of the stack. */ /* */ /* [s] type: This is the type of this expression. Currently, all */ /* expressions have type integer_type. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> additive_expression code */ /* &s-attribute additive_expression type */ /* &i-attribute additive_expression context */ /* &i-attribute term context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute additive_expression context */ /* &s-attribute <[Instruction]> additive_expression code */ /* &s-attribute additive_expression type */ /* &s-attribute <[Instruction]> term code */ /* &s-attribute term type */ /* &token tok_ADDOP */ /*======================================================================*/ additive_expression : additive_expression tok_ADDOP term { code% : type%1 code%1 type%3 code%3 = {CheckInt(type%1). CheckInt(type%3). Value code%1 ++ code%3 ++ genOp(%2, type%1, type%3) %Value } type% : = { integer_type } context%1 : context% = { context% } context%3 : context% = { context% } } | term { code% : code%1 = { code%1 } type% : type%1 = { type%1 } context%1 : context% = { context% } } ; /*======================================================================*/ /* term */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that computes this expression and */ /* leaves its value on top of the stack. */ /* */ /* [s] type: This is the type of this expression. Currently, all */ /* expressions have type integer_type. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> term code */ /* &s-attribute term type */ /* &i-attribute term context */ /* &i-attribute factor context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute term context */ /* &s-attribute <[Instruction]> factor code */ /* &s-attribute factor type */ /* &s-attribute <[Instruction]> term code */ /* &s-attribute term type */ /* &token tok_MULOP */ /*======================================================================*/ term : term tok_MULOP factor { code% : type%1 code%1 type%3 code%3 = {CheckInt(type%1). CheckInt(type%3). Value code%1 ++ code%3 ++ genOp(%2, type%1, type%3) %Value } type% : = { integer_type } context%1 : context% = { context% } context%3 : context% = { context% } } | factor { code% : code%1 = { code%1 } type% : type%1 = { type%1 } context%1 : context% = { context% } } ; /*======================================================================*/ /* factor */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that computes this expression and */ /* leaves its value on top of the stack. */ /* */ /* [s] type: This is the type of this expression. Currently, all */ /* expressions have type integer_type. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> factor code */ /* &s-attribute factor type */ /* &i-attribute expression context */ /* &i-attribute var context */ /* &i-attribute call context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute factor context */ /* &s-attribute <[Instruction]> expression code */ /* &s-attribute expression type */ /* &s-attribute var name */ /* &s-attribute <[Instruction]> var code */ /* &s-attribute <[Instruction]> call code */ /* &s-attribute call type */ /* &token tok_NUM */ /*======================================================================*/ factor : tok_LEFT_PAREN expression tok_RIGHT_PAREN { code% : code%2 = { code%2 } type% : type%2 = { type%2} context%2 : context% = { context% } } | var { code% : context% name%1 code%1 = {Let gv = fetchVar(name%1, vartbl(context%)). If nil? code%1 then gv else gv ++ code%1 ++ [oneByteInstruction(m_INDEX)] %If } type% : = { integer_type } context%1 : context% = { context% } } | tok_NUM { code% : %1 = {If %1 > 255 then [twoByteInstruction(m_PUSH_INTEGER_CONSTANT, genConst(%1))] else [twoByteInstruction(m_PUSH_INTEGER, %1)] %If } type% : = { integer_type } } | call { code% : code%1 = { code%1 } type% : type%1 = { type%1 } context%1 : context% = { context% } } ; /*======================================================================*/ /* call */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that computes this expression and */ /* leaves its value on top of the stack. */ /* */ /* [s] type: This is the type of this expression. Currently, all */ /* expressions have type integer_type. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> call code */ /* &s-attribute call type */ /* &i-attribute args context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute call context */ /* &s-attribute <[Instruction]> args code */ /* &s-attribute args size */ /* &s-attribute <[Type]> args types */ /* &token tok_ID */ /*======================================================================*/ call : tok_ID tok_LEFT_PAREN args tok_RIGHT_PAREN { code% : code%3 size%3 type% = {Choose first matching %1 case "input" => [oneByteInstruction(m_READ_INTEGER)] case "output" => [oneByteInstruction(m_WRITE_INTEGER), twoByteInstruction(m_PUSH_INTEGER, 10), oneByteInstruction(m_WRITE_CHAR)] else => [callInstruction(size%3, %1)] %Choose } type% : context% types%3 = {checkParams(%1, types%3, vartbl(context%))} context%3 : context% = { context% } } ; /*======================================================================*/ /* args */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that computes the arguments and */ /* push them onto the stack. */ /* */ /* [s] size: This is the number of words occupied by the parameters. */ /* */ /* [s] types: This is a list of the types of the arguments. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]>args code */ /* &s-attribute args size */ /* &s-attribute <[Type]> args types */ /* &i-attribute arg_list context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute args context */ /* &s-attribute <[Instruction]> arg_list code */ /* &s-attribute arg_list size */ /*======================================================================*/ args : arg_list { code% : code%1 = { code%1 } size% : size%1 = { size%1 } types% : types%1 = { types%1 } context%1 : context% = { context% } } | /* empty */ { code% : = { [] } size% : = { 0 } types% : = { [] } } ; /*======================================================================*/ /* arg_list */ /*======================================================================*/ /* Attributes: */ /* */ /* [s] code: This is the code that computes the arguments and */ /* push them onto the stack. */ /* */ /* [s] size: This is the number of words occupied by the parameters. */ /* */ /* [s] types: This is a list of the types of the arguments. */ /* */ /* [i] context: This holds a variable that indicates the next label */ /* number to use and the symbol table. */ /*----------------------------------------------------------------------*/ /* Defined here: */ /* */ /* &s-attribute <[Instruction]> arg_list code */ /* &s-attribute arg_list size */ /* &s-attribute <[Type]> arg_list types */ /* &i-attribute arg_list context */ /* &i-attribute expression context */ /*----------------------------------------------------------------------*/ /* Available here: */ /* */ /* &i-attribute arg_list context */ /* &s-attribute <[Instruction]> arg_list code */ /* &s-attribute arg_list size */ /* &s-attribute <[Instruction]> expression code */ /* &s-attribute <[Instruction]> expression type */ /*======================================================================*/ arg_list : arg_list tok_COMMA expression { code% : code%1 code%3 = {CheckInt(type%3). Value code%1 ++ code%3. } size% : size%1 = { size%1 + 1 } types% : types%1 type%3 = { types%1 ++ [type%3] } context%1 : context% = { context% } context%3 : context% = { context% } } | expression { code% : code%1 = {CheckInt(type%1). Value code%1. } size% : = { 1 } types% : type%1 = { [type%1] } context%1 : context% = { context% } } ; && ======================================================================= ======================================================================= %% This is the end of the grammar. Below are the functions that %% %% are used in the grammar. %% ======================================================================= ======================================================================= ======================================================================= %% UnknownVariable ======================================================================= %% Complain that variable name is unknown. ======================================================================= Define UnknownVariable ?name. = Writeln["Unknown variable ", name]. %Define ======================================================================= %% CheckNoDuplicates ======================================================================= %% Check that there are no duplicate definitions in table tbl. ======================================================================= Define CheckNoDuplicates ?tbl. = Let names = sortRemovingDuplicates (==) (<=) (map left tbl). If length names =/= length tbl then Writeln["Duplicate variable definition"]. %If %Define ======================================================================= %% CheckInt ======================================================================= %% Check that type tp is integer_type. Complain if not. ======================================================================= Define CheckInt(?tp). = If tp =/= integer_type then Writeln["Require integer type here"]. %If %Define ======================================================================= %% CheckIntArray ======================================================================= %% Check that type tp is int_array. Complain if not. ======================================================================= Define CheckIntArray(?tp). = If not int_array?(tp) then Writeln["Require array type here"]. %If %Define ======================================================================= %% checkParams ======================================================================= %% Check that the correct number of parameters are passed to %% function fun. Also check that fun is a function. %% tbl is the symbol table in this context. %% %% Return the result type of the function. ======================================================================= Define checkParams(?fun, ?act_param_types, ?tbl) = Try Open Choose first matching fun case "input" => Let tp = fun_type(integer_type, []). case "output" => Let tp = fun_type(void_type, [integer_type]). else => Match (?,?,?tp) = assoc fun tbl. %Choose then Try Match fun_type(?result_type, ?param_types) = tp. then If length(act_param_types) =/= length(param_types) then Writeln["Call to function ", fun, " has the wrong number of params"]. %If result_type else Writeln[fun, " is not a function"]. integer_type %Try else Writeln["Unknown function ", fun]. integer_type %Try %Define ======================================================================= %% genOp ======================================================================= %% Produce a list of instructions that performs operator 'kind' %% on the top of the stack. The result is a list of instructions. %% (When it is just one instruction, the result is a singleton list.) ======================================================================= Define genOp(?kind,?type1,?type2) = Choose first matching kind case addop_kind => [oneByteInstruction m_INTEGER_ADD] case subop_kind => [oneByteInstruction m_INTEGER_SUBTRACT] case multop_kind => [oneByteInstruction m_INTEGER_MULTIPLY] case divop_kind => [oneByteInstruction m_INTEGER_DIVIDE] else => fail (domainX("genOp does not handle relops")) %Choose %Define ======================================================================= %% genRelop ======================================================================= %% Generate code to compare two integers according to %% relational operator relop. Parameter lbx is a box %% containing the next local label to use. It is modified %% to account for labels used here. ======================================================================= Define genRelop(?relop,?lbx) = Let jump = Choose first matching relop case eq_kind => m_GOTO_IF_ZERO case ne_kind => m_GOTO_IF_NOT_ZERO case gt_kind => m_GOTO_IF_POSITIVE case ge_kind => m_GOTO_IF_NOT_NEGATIVE case lt_kind => m_GOTO_IF_NEGATIVE case le_kind => m_GOTO_IF_NOT_POSITIVE else => 0 %Choose %Let Let label1 = !lbx. Let label2 = label1 + 1. Make lbx := !lbx + 2. [oneByteInstruction(m_COMPARE_INTEGERS), twoByteInstruction(jump, label1), twoByteInstruction(m_PUSH_INTEGER, 0), twoByteInstruction(m_GOTO, label2), twoByteInstruction(m_LABEL, label1), twoByteInstruction(m_PUSH_INTEGER, 1), twoByteInstruction(m_LABEL, label2)] %Define ======================================================================= %% genPop ======================================================================= %% Return code that will pop the value of an expression off the stack %% depending on the expression type: integer_type or int_array. ======================================================================= Define genPop(?type1) = Choose first matching type1 case integer_type => [oneByteInstruction m_POP_INTEGER] case int_array(?) => [oneByteInstruction m_POP_ARRAY] case void_type => [] else => [] %Choose %Define ======================================================================= %% genConst ======================================================================= %% Return the index of a table entry for an integer constant. ======================================================================= Define genConst(?constant: Natural) = Try Let offset = assoc constant !constTable. then offset else Let offset = !offsetConst. Make constTable := !constTable ++ [(constant, offset)]. Make offsetConst := !offsetConst + 1. offset %Try %Define ======================================================================= %% sortVartbl ======================================================================= %% Return a pair of tables (t1,t2) where t1 contains the simple %% variables declared in table tbl, and t2 contains the arrays %% in table tbl. ======================================================================= Define sortVartbl by case sortVartbl [] = ([],[]) case sortVartbl (?e::?r) = Match (?t1,?t2) = sortVartbl r. Match (?,?,?,?tp) = e. Choose first matching tp case integer_type => (e::t1, t2) case int_array(?) => (t1, e::t2) else => (e::t1, t2) %% Should not happen. %Choose %Define ======================================================================= %% sizeVars ======================================================================= %% Return the number of words occupied by the variables of the %% given kind in symbol table tbl. ======================================================================= Define sizeVars by first case sizeVars(?, []) = 0 case sizeVars(?kind, ((?,?kind,?,?) :: ?r)) = 1 + sizeVars(kind, r) case sizeVars(?kind, ? :: ?r) = sizeVars(kind,r) %Define ======================================================================= %% fetchVar ======================================================================= %% Return code that will fetch variable name. Parameter lists is %% the current vartbl information. ======================================================================= Define fetchVar(?name,?lists) = Try Let info = assoc name lists. then Match(?kind, ?offset, ?type1) = info. Choose first case kind == globalvar _and_ type1 == integer_type => [twoByteInstruction (m_FETCH_GLOBAL_INTEGER, offset)] case kind == globalvar _and_ int_array?(type1) => [twoByteInstruction (m_FETCH_GLOBAL_ARRAY, offset)] case kind == localvar _and_ type1 == integer_type => [twoByteInstruction (m_FETCH_LOCAL_INTEGER, offset)] case kind == localvar _and_ int_array?(type1) => [twoByteInstruction (m_FETCH_LOCAL_ARRAY, offset)] case kind == parameter _and_ type1 == integer_type => [twoByteInstruction (m_FETCH_PARAM_INTEGER, offset)] case kind == parameter _and_ int_array?(type1) => [twoByteInstruction (m_FETCH_PARAM_ARRAY, offset)] %Choose else UnknownVariable name. [] %Try %Define ======================================================================= %% alloc_size ======================================================================= %% This returns the number of words needed for the variables in %% symbol table tbl. ======================================================================= Let alloc_size(?tbl) = length(tbl). ======================================================================= %% genArrayAlloc ======================================================================= %% Produce an instruction to allocate a local array described by %% a table entry. The table entry is the parameter. ======================================================================= Define genArrayAlloc(?,localvar,?,int_array(?n)) = twoByteInstruction(m_MAKE_INTEGER_ARRAY, n) %Define ======================================================================= %% genArrayDealloc ======================================================================= %% Produce a list of instructions to deallocate a local array described %% by a table entry. The table entry is the parameter. ======================================================================= Define genArrayDealloc(?,localvar,?offset,?) = [twoByteInstruction(m_FETCH_LOCAL_ARRAY, offset), oneByteInstruction(m_DELETE_ARRAY)] %Define ======================================================================= %% genAlloc ======================================================================= %% Produce instructions to the simple variables %% in t1 and the array variables in t2. ======================================================================= Define genAlloc(?t1,?t2) = Let simps = If nil? t1 then [] else [twoByteInstruction(m_ALLOC, alloc_size(t1))] %If %Let Let arrs = map genArrayAlloc t2. Value simps ++ arrs. %Define ======================================================================= %% genDealloc ======================================================================= %% Produce instructions to deallocate the simple variables in table %% t1 and the array variables in table t2. ======================================================================= Define genDealloc(?t1,?t2) = Let simps = If nil? t1 then [] else [twoByteInstruction(m_DEALLOC, alloc_size(t1))] %If %Let Let arrs = flatten(map genArrayDealloc t2). Value simps ++ arrs. %Define ======================================================================= %% PrintConstTable ======================================================================= %% Prints the entire constant table. ======================================================================= Define PrintConstTable ?entries. = For (?val, ?) from entries do WriteStringDeclaration(ms_INTEGER_CONSTANT, $val). %For %Define ======================================================================= %% WriteGlobalVars ======================================================================= %% Write declarations of the global variables in symbol table tbl. ======================================================================= Define WriteGlobalVars(?tbl). = For (?,globalvar,?,?t) from tbl do Choose first matching t case integer_type => WriteOneByteDeclaration(ms_INTEGER_GLOBAL). case int_array(?n) => WriteTwoByteDeclaration(ms_INTEGER_ARRAY_GLOBAL, genConst(n)). else => () %Choose %For %Define ======================================================================= %% Instruction names ======================================================================= Let oneByteInstructionName = ["M_POP_INTEGER", "M_POP_REAL", "M_POP_ARRAY", "M_DUP_INTEGER", "M_DUP_REAL", "M_DUP_ARRAY", "M_INTEGER_ADD", "M_INTEGER_SUBTRACT", "M_INTEGER_MULTIPLY", "M_INTEGER_DIVIDE", "M_INTEGER_MOD", "M_REAL_ADD", "M_REAL_SUBTRACT", "M_REAL_MULTIPLY", "M_REAL_DIVIDE", "M_COMPARE_INTEGERS", "M_COMPARE_REALS", "M_MAKE_INTEGER_ARRAY", "M_MAKE_REAL_ARRAY", "M_DELETE_ARRAY", "M_INDEX", "M_STORE_INTEGER_INDEXED", "M_STORE_REAL_INDEXED", "M_STORE_LEAVE_INTEGER_INDEXED", "M_STORE_LEAVE_REAL_INDEXED", "M_RETURN_INTEGER", "M_RETURN_REAL", "M_RETURN", "M_READ_INTEGER", "M_READ_REAL", "M_READ_CHAR", "M_WRITE_INTEGER", "M_WRITE_REAL", "M_WRITE_CHAR" ] %Let Let twoByteInstructionName = ["M_PUSH_INTEGER", "M_PUSH_INTEGER_CONSTANT", "M_PUSH_REAL_CONSTANT", "M_ALLOC", "M_DEALLOC", "M_FETCH_LOCAL_INTEGER", "M_FETCH_LOCAL_REAL", "M_FETCH_LOCAL_ARRAY", "M_STORE_LOCAL_INTEGER", "M_STORE_LOCAL_REAL", "M_STORE_LOCAL_ARRAY", "M_FETCH_PARAM_INTEGER", "M_FETCH_PARAM_REAL", "M_FETCH_PARAM_ARRAY", "M_STORE_PARAM_INTEGER", "M_STORE_PARAM_REAL", "M_STORE_PARAM_ARRAY", "M_FETCH_GLOBAL_INTEGER", "M_FETCH_GLOBAL_REAL", "M_FETCH_GLOBAL_ARRAY", "M_STORE_GLOBAL_INTEGER", "M_STORE_GLOBAL_REAL", "M_STORE_GLOBAL_ARRAY", "M_LABEL", "M_GOTO", "M_GOTO_IF_ZERO", "M_GOTO_IF_NOT_ZERO", "M_GOTO_IF_POSITIVE", "M_GOTO_IF_NOT_POSITIVE", "M_GOTO_IF_NEGATIVE", "M_GOTO_IF_NOT_NEGATIVE", "M_GOTO_IF_FAILED", "M_GOTO_IF_EOF" ] %Let Let declarationName = ["MS_INTEGER_CONSTANT", "MS_REAL_CONSTANT", "MS_FUNCTION", "MS_INTEGER_GLOBAL", "MS_REAL_GLOBAL", "MS_INTEGER_ARRAY_GLOBAL", "MS_REAL_ARRAY_GLOBAL", "MS_START", "MS_END" ] %Let ======================================================================= %% gen ======================================================================= %% This function converts a single instruction to a string ======================================================================= Let gen by case gen(oneByteInstruction(?n)) = If !binaryOutput then [char(n)] else oneByteInstructionName#_(n -- firstOneByteInstruction) ++ "\n" %If case gen(twoByteInstruction(?n,?k)) = If !binaryOutput then [char(n), char(k)] else twoByteInstructionName#_(n -- firstTwoByteInstruction) ++ " " ++ $k ++ "\n" %If case gen(callInstruction(?n,?s)) = If !binaryOutput then [char(m_CALL), char(n)] ++ s ++ ['\0'] else "M_CALL " ++ $n ++ " " ++ s ++ "\n" %If %Let ======================================================================= %% gen ======================================================================= %% This function converts a list of instructions to a string, with the %% instructions seperated by newline characters. ======================================================================= Let gen ?instrs = flatten(map gen instrs) %Let ======================================================================= %% GenByteCode ======================================================================= %% Write out the byte code. ======================================================================= Define GenByteCode(?codes). = FWrite !genfile, [gen codes]. %Define ======================================================================= %% WriteOneByteDeclaration ======================================================================= %% Print one-byte declaration d. ======================================================================= Define WriteOneByteDeclaration(?d). = If !binaryOutput then FWrite !genfile, [[char d]]. else FWrite !genfile, [declarationName#d, "\n"]. %If %Define ======================================================================= %% WriteTwoByteDeclaration ======================================================================= %% Print two-byte declaration d with parameter k. ======================================================================= Define WriteTwoByteDeclaration(?d,?k). = If !binaryOutput then FWrite !genfile, [[char d, char k]]. else FWrite !genfile, [declarationName#d, " ", $k, "\n"]. %If %Define ======================================================================= %% WriteStringDeclaration ======================================================================= %% Print declaration d with string parameter s. ======================================================================= Define WriteStringDeclaration(?d,?s). = If !binaryOutput then FWrite !genfile, [[char d], s, "\0"]. else FWrite !genfile, [declarationName#d, " ", s, "\n"]. %If %Define ======================================================================= %% YyError ======================================================================= %% This function is called by the parser when there is a syntax error. ======================================================================= Define{override} YyError ?. = Writeln["Parse error at line ", $currentLineNumber()]. %Define ======================================================================= Execute Make binaryOutput := false; %Make Let fmode = If !binaryOutput then [binaryMode] else [] %If. Make genfile := outfile fmode "codeout". (parser(yylex())) CloseFile !genfile. %Execute