begin % code generator %
    % parse tree nodes %
    record node( integer         type
               ; reference(node) left, right
               ; integer         iValue % nString/nIndentifier number or nInteger value %
               );
    integer    nIdentifier, nString, nInteger, nSequence, nIf,   nPrtc, nPrts
          ,    nPrti,       nWhile,  nAssign,  nNegate,   nNot,  nMultiply
          ,    nDivide,     nMod,    nAdd,     nSubtract, nLess, nLessEqual
          ,    nGreater,    nGreaterEqual,     nEqual,    nNotEqual,    nAnd, nOr
          ;
    string(14) array ndName ( 1 :: 25 );
    integer    array nOp    ( 1 :: 25 );
    integer    MAX_NODE_TYPE;
    % string literals and identifiers - uses a linked list - a hash table might be better... %
    string(1)  array text ( 0 :: 4095 );
    integer    textNext, TEXT_MAX;
    record textElement ( integer start, length; reference(textElement) next );
    reference(textElement) idList, stList;
    % op codes %
    integer    oFetch, oStore, oPush
          ,    oAdd,   oSub,   oMul, oDiv, oMod, oLt, oGt,   oLe,   oGe,   oEq,  oNe
          ,    oAnd,   oOr,    oNeg, oNot, oJmp, oJz, oPrtc, oPrts, oPrti, oHalt
          ;
    string(6)  array opName ( 1 :: 24 );
    % code - although this is intended to be byte code, as we are going to output    %
    %        an assembler source, we use integers for convenience                    %
    % labelLocations are: - ( referencing location + 1 ) if they have been referenced but not defined yet, %
    %                     zero     if they are unreferenced and undefined,                                 %
    %                     ( referencing location + 1 )   if they are defined                               %
    integer    array byteCode ( 0 :: 4095 );
    integer    array labelLocation( 1 :: 4096 );
    integer    nextLocation, MAX_LOCATION, nextLabelNumber, MAX_LABEL_NUMBER;

    % returns a new node with left and right branches %
    reference(node) procedure opNode ( integer value opType; reference(node) value opLeft, opRight ) ; begin
        node( opType, opLeft, opRight, 0 )
    end opNode ;

    % returns a new operand node %
    reference(node) procedure operandNode ( integer value opType, opValue ) ; begin
        node( opType, null, null, opValue )
    end operandNode ;

    % reports an error and stops %
    procedure genError( string(80) value message ); begin
        integer errorPos;
        write( s_w := 0, "**** Code generation error: " );
        errorPos := 0;
        while errorPos < 80 and message( errorPos // 1 ) not = "." do begin
            writeon( s_w := 0, message( errorPos // 1 ) );
            errorPos := errorPos + 1
        end while_not_at_end_of_message ;
        writeon( s_w := 0, "." );
        assert( false )
    end genError ;

    % reads a node from standard input %
    reference(node) procedure readNode ; begin
        reference(node) resultNode;

        % parses a string from line and stores it in a string in the text array %
        % - if it is not already present in the specified textElement list.     %
        % returns the position of the string in the text array                  %
        integer procedure readString ( reference(textElement) value result txList; string(1) value terminator ) ; begin
            string(256) str;
            integer     sLen, sPos, ePos;
            logical     found;
            reference(textElement) txPos, txLastPos;
            % get the text of the string %
            str  := " ";
            sLen := 0;
            str( sLen // 1 ) := line( lPos // 1 );
            sLen := sLen + 1;
            lPos := lPos + 1;
            while lPos <= 255 and line( lPos // 1 ) not = terminator do begin
                str( sLen // 1 ) := line( lPos // 1 );
                sLen := sLen + 1;
                lPos := lPos + 1
            end while_more_string ;
            if lPos > 255 then genError( "Unterminated String in node file." );
            % attempt to find the text in the list of strings/identifiers %
            txLastPos := txPos := txList;
            found := false;
            ePos := 0;
            while not found and txPos not = null do begin
                ePos  := ePos + 1;
                found := ( length(txPos) = sLen );
                sPos  := 0;
                while found and sPos < sLen do begin
                    found := str( sPos // 1 ) = text( start(txPos) + sPos );
                    sPos  := sPos + 1
                end while_not_found ;
                txLastPos := txPos;
                if not found then txPos := next(txPos)
            end while_string_not_found ;
            if not found then begin
                % the string/identifier is not in the list - add it %
                ePos := ePos + 1;
                if txList = null then txList := textElement( textNext, sLen, null )
                                 else next(txLastPos) := textElement( textNext, sLen, null );
                if textNext + sLen > TEXT_MAX then genError( "Text space exhausted." )
                else begin
                    for cPos := 0 until sLen - 1 do begin
                        text( textNext ) := str( cPos // 1 );
                        textNext := textNext + 1
                    end for_cPos
                end
            end if_not_found ;
            ePos
        end readString ;

        % gets an integer from the line - no checks for valid digits %
        integer procedure readInteger ; begin
            integer n;
            n := 0;
            while line( lPos // 1 ) not = " " do begin
                n    := ( n * 10 ) + ( decode( line( lPos // 1 ) ) - decode( "0" ) );
                lPos := lPos + 1
            end while_not_end_of_integer ;
            n
        end readInteger ;

        string(256) line;
        string(16)  name;
        integer     lPos, tPos, ndType;
        tPos := lPos := 0;
        readcard( line );
        % get the node type name %
        while line( lPos // 1 ) = " " do lPos := lPos + 1;
        name := "";
        while lPos < 256 and line( lPos // 1 ) not = " " do begin
            name( tPos // 1 ) := line( lPos // 1 );
            lPos := lPos + 1;
            tPos := tPos + 1
        end  while_more_name ;
        % determine the node type %
        ndType         := 1;
        resultNode     := null;
        if name not = ";" then begin
            % not a null node %
            while ndType <= MAX_NODE_TYPE and name not = ndName( ndType ) do ndType := ndType + 1;
            if ndType > MAX_NODE_TYPE then genError( "Malformed node." );
            % handle the additional parameter for identifier/string/integer, or sub-nodes for operator nodes %
            if ndType = nInteger or ndType = nIdentifier or ndType = nString then begin
                while line( lPos // 1 ) = " " do lPos := lPos + 1;
                if      ndType = nInteger    then resultNode := operandNode( ndType, readInteger )
                else if ndType = nIdentifier then resultNode := operandNode( ndType, readString( idList, " "  ) )
                else  % ndType = nString     %    resultNode := operandNode( ndType, readString( stList, """" ) )
                end
            else begin
                % operator node %
                reference(node) leftNode;
                leftNode   := readNode;
                resultNode := opNode( ndType, leftNode, readNode )
            end
        end if_non_null_node ;
        resultNode
    end readNode ;

    % returns the next free label number %
    integer procedure newLabel ; begin
        nextLabelNumber := nextLabelNumber + 1;
        if nextLabelNumber > MAX_LABEL_NUMBER then genError( "Program too complex" );
        nextLabelNumber
    end newLabel ;

    % defines the specified label to be at the next location %
    procedure defineLabel ( integer value labelNumber ) ; begin
        if labelLocation( labelNumber ) > 0 then genError( "Label already defined" )
        else begin
            % this is the first definition of the label, define it and if it has already been referenced, fill in the reference %
            integer currValue;
            currValue := labelLocation( labelNumber );
            labelLocation( labelNumber ) := nextLocation + 1; % we store pc + 1 to ensure the label location is positive %
            if currValue < 0 then % already referenced % byteCode( - ( currValue + 1 ) ) := labelLocation( labelNumber )
        end
    end defineLabel ;

    % stores a byte in the code %
    procedure genByte ( integer value byteValue ) ; begin
        if nextLocation > MAX_LOCATION then genError( "Program too large" );
        byteCode( nextLocation ) := byteValue;
        nextLocation := nextLocation + 1
    end genByte ;

    % stores an integer in the code %
    procedure genInteger ( integer value integerValue ) ; begin
        % we are storing the bytes of the code in separate integers for convenience %
        genByte( integerValue ); genByte( 0 ); genByte( 0 ); genByte( 0 )
    end genInteger ;

    % generates an operation acting on an address %
    procedure genDataOp ( integer value opCode, address ) ; begin
        genByte( opCode );
        genInteger( address )
    end genDataOp ;

    % generates a nullary operation %
    procedure genOp0  ( integer value opCode ) ; begin
        genByte( opCode )
    end genOp0 ;

    % generates a unary/binary operation %
    procedure genOp ( reference(node) value n ) ; begin
        gen(  left(n) );
        gen( right(n) ); % right will be null for a unary op so no code will be generated %
        genByte( nOp( type(n) ) )
    end genOp ;

    % generates a jump operation %
    procedure genJump   ( integer value opCode, labelNumber ) ; begin
        genByte( opCode );
        % if the label is not defined yet - set it's location to the negative of the referencing location %
        % so it can be resolved later %
        if labelLocation( labelNumber ) = 0 then labelLocation( labelNumber ) := - ( nextLocation + 1 );
        genInteger( labelLocation( labelNumber ) )
    end genJump ;

    % generates code for the node n %
    procedure gen ( reference(node) value n ) ; begin

        if           n  = null        then % empty node % begin end
        else if type(n) = nIdentifier then genDataOp( oFetch, iValue(n) )
        else if type(n) = nString     then genDataOp( oPush,  iValue(n) - 1 )
        else if type(n) = nInteger    then genDataOp( oPush,  iValue(n) )
        else if type(n) = nSequence   then begin
            gen(  left(n) );
            gen( right(n) )
            end
        else if type(n) = nIf         then % if-else         % begin
            integer elseLabel;
            elseLabel := newLabel;
            gen( left(n) );
            genJump( oJz, elseLabel );
            gen( left( right(n) ) );
            if right(right(n)) = null then % no "else" part % defineLabel( elseLabel )
            else begin
                % have an "else" part %
                integer endIfLabel;
                endIfLabel := newLabel;
                genJump( oJmp, endIfLabel );
                defineLabel( elseLabel );
                gen( right(right(n)) );
                defineLabel( endIfLabel )
            end
            end
        else if type(n) = nWhile      then % while-loop      % begin
            integer loopLabel, exitLabel;
            loopLabel := newLabel;
            exitLabel := newLabel;
            defineLabel( loopLabel );
            gen(  left(n) );
            genJump( oJz,  exitLabel );
            gen( right(n) );
            genJump( oJmp, loopLabel );
            defineLabel( exitLabel )
            end
        else if type(n) = nAssign     then % assignment      % begin
            gen( right( n ) );
            genDataOp( oStore, iValue(left(n)) )
            end
        else genOp( n )
    end gen ;

    % outputs the generated code to standard output %
    procedure emitCode ; begin

        % counts the number of elements in a text element list %
        integer procedure countElements ( reference(textElement) value txHead ) ; begin
            integer count;
            reference(textElement) txPos;
            count := 0;
            txPos := txHead;
            while txPos not = null do begin
                count := count + 1;
                txPos := next(txPos)
            end while_txPos_not_null ;
            count
        end countElements ;

        integer pc, op;
        reference(textElement) txPos;

        % code header %
        write( i_w := 1, s_w := 0
             , "Datasize: ", countElements( idList )
             , " Strings: ", countElements( stList )
             );
        % output the string literals %
        txPos := stList;
        while txPos not = null do begin
            integer cPos;
            write( """" );
            cPos := 1; % start from 1 to skip over the leading " %
            while cPos < length(txPos) do begin
                writeon( s_w := 0, text( start(txPos) + cPos ) );
                cPos := cPos + 1
            end while_not_end_of_string ;
            writeon( s_w := 0, """" );
            txPos := next(txPos)
        end while_not_at_end_of_literals ;

        % code body %
        pc := 0;
        while pc < nextLocation do begin
            op := byteCode( pc );
            write( i_w := 4, s_w := 0, pc, " ", opName( op ) );
            pc := pc + 1;
            if      op = oFetch or op = oStore then begin
                % data load/store - add the address in square brackets %
                writeon( i_w := 1, s_w := 0, "[", byteCode( pc ) - 1, "]" );
                pc := pc + 4
                end
            else if op = oPush                 then begin
                % push constant - add the constant %
                writeon( i_w := 1, s_w := 0, byteCode( pc ) );
                pc := pc + 4
                end
            else if op = oJmp   or op = oJz    then begin
                % jump - show the relative address in brackets and the absolute address %
                writeon( i_w := 1, s_w := 0, "(", ( byteCode( pc ) - 1 ) - pc, ") ", byteCode( pc ) - 1 );
                pc := pc + 4
            end
        end while_pc_lt_nextLocation
    end emitCode ;

    oFetch :=  1; opName( oFetch ) := "fetch"; oStore :=  2; opName( oStore ) := "store"; oPush :=  3; opName( oPush ) := "push";
    oAdd   :=  4; opName( oAdd   ) := "add";   oSub   :=  5; opName( oSub   ) := "sub";   oMul  :=  6; opName( oMul  ) := "mul";
    oDiv   :=  7; opName( oDiv   ) := "div";   oMod   :=  8; opName( oMod   ) := "mod";   oLt   :=  9; opName( oLt   ) := "lt";
    oGt    := 10; opName( oGt    ) := "gt";    oLe    := 11; opName( oLe    ) := "le";    oGe   := 12; opName( oGe   ) := "ge";
    oEq    := 13; opName( oEq    ) := "eq";    oNe    := 14; opName( oNe    ) := "ne";    oAnd  := 15; opName( oAnd  ) := "and";
    oOr    := 16; opName( oOr    ) := "or";    oNeg   := 17; opName( oNeg   ) := "neg";   oNot  := 18; opName( oNot  ) := "not";
    oJmp   := 19; opName( oJmp   ) := "jmp";   oJz    := 20; opName( oJz    ) := "jz";    oPrtc := 21; opName( oPrtc ) := "prtc";
    oPrts  := 22; opName( oPrts  ) := "prts";  oPrti  := 23; opName( oPrti  ) := "prti";  oHalt := 24; opName( oHalt ) := "halt";

    nIdentifier      :=  1; ndName( nIdentifier   ) := "Identifier";   nString   :=  2; ndName( nString   ) := "String";
    nInteger         :=  3; ndName( nInteger      ) := "Integer";      nSequence :=  4; ndName( nSequence ) := "Sequence";
    nIf              :=  5; ndName( nIf           ) := "If";           nPrtc     :=  6; ndName( nPrtc     ) := "Prtc";
    nPrts            :=  7; ndName( nPrts         ) := "Prts";         nPrti     :=  8; ndName( nPrti     ) := "Prti";
    nWhile           :=  9; ndName( nWhile        ) := "While";        nAssign   := 10; ndName( nAssign   ) := "Assign";
    nNegate          := 11; ndName( nNegate       ) := "Negate";       nNot      := 12; ndName( nNot      ) := "Not";
    nMultiply        := 13; ndName( nMultiply     ) := "Multiply";     nDivide   := 14; ndName( nDivide   ) := "Divide";
    nMod             := 15; ndName( nMod          ) := "Mod";          nAdd      := 16; ndName( nAdd      ) := "Add";
    nSubtract        := 17; ndName( nSubtract     ) := "Subtract";     nLess     := 18; ndName( nLess     ) := "Less";
    nLessEqual       := 19; ndName( nLessEqual    ) := "LessEqual";    nGreater  := 20; ndName( nGreater  ) := "Greater";
    nGreaterEqual    := 21; ndName( nGreaterEqual ) := "GreaterEqual"; nEqual    := 22; ndName( nEqual    ) := "Equal";
    nNotEqual        := 23; ndName( nNotEqual     ) := "NotEqual";     nAnd      := 24; ndName( nAnd      ) := "And";
    nOr              := 25; ndName( nOr           ) := "Or";
    MAX_NODE_TYPE    := 25; TEXT_MAX := 4095; textNext := 0;
    stList := idList := null;
    for nPos := 1 until MAX_NODE_TYPE do nOp( nPos ) := -1;
    nOp( nPrtc     ) := oPrtc; nOp( nPrts      ) := oPrts; nOp( nPrti    ) := oPrti; nOp( nNegate       ) := oNeg; nOp( nNot      ) := oNot;
    nOp( nMultiply ) := oMul;  nOp( nDivide    ) := oDiv;  nOp( nMod     ) := oMod;  nOp( nAdd          ) := oAdd; nOp( nSubtract ) := oSub;
    nOp( nLess     ) := oLt;   nOp( nLessEqual ) := oLe;   nOp( nGreater ) := oGt;   nOp( nGreaterEqual ) := oGe;  nOp( nEqual    ) := oEq;
    nOp( nNotEqual ) := oNe;   nOp( nAnd       ) := oAnd;  nOp( nOr      ) := oOr;
    nextLocation     := 0; MAX_LOCATION := 4095;
    for pc := 0 until MAX_LOCATION do byteCode( pc ) := 0;
    nextLabelNumber := 0; MAX_LABEL_NUMBER := 4096;
    for lPos := 1 until MAX_LABEL_NUMBER do labelLocation( lPos ) := 0;

    % parse the output from the syntax analyser and generate code from the parse tree %
    gen( readNode );
    genOp0( oHalt );
    emitCode
end.