10.13. Conclusion

10.13. Conclusion
	Chapter 10. Introducing "TINY"
At this point we have TINY completely defined. It's not much … actually a toy compiler. TINY has only one data type and no subroutines … but it's a complete, usable language. While you're not likely to be able to write another compiler in it, or do anything else very seriously, you could write programs to read some input, perform calculations, and output the results. Not too bad for a toy.
Most importantly, we have a firm base upon which to build further extensions. I know you'll be glad to hear this: this is the last time I'll start over in building a parser … from now on I intend to just add features to TINY until it becomes KISS. Oh, there'll be other times we will need to try things out with new copies of the Cradle, but once we've found out how to do those things they'll be incorporated into TINY.
What will those features be? Well, for starters we need subroutines and functions. Then we need to be able to handle different types, including arrays, strings, and other structures. Then we need to deal with the idea of pointers. All this will be upcoming in future installments.
See you then.
For references purposes, the complete listing of TINY Version 1.0 is shown below:
Example 10.1. TINY version 1.0
program Tiny10;

{ Constant Declarations }
const TAB = ^I;
      CR  = ^M;
      LF  = ^J;

      LCount: integer = 0;
      NEntry: integer = 0;

{ Type Declarations }
type Symbol = string[8];

     SymTab = array[1..1000] of Symbol;
     TabPtr = ^SymTab;

{ Variable Declarations }
var Look : char;             { Lookahead Character }
    Token: char;             { Encoded Token       }
    Value: string[16];       { Unencoded Token     }

const MaxEntry = 100;

var ST   : array[1..MaxEntry] of Symbol;
    SType: array[1..MaxEntry] of char;

{ Definition of Keywords and Token Types }
const NKW =   11;
      NKW1 = 12;

const KWlist: array[1..NKW] of Symbol =
              ('IF', 'ELSE', 'ENDIF', 'WHILE', 'ENDWHILE',
               'READ', 'WRITE', 'VAR', 'BEGIN', 'END', 'PROGRAM');

const KWcode: string[NKW1] = 'xileweRWvbep';

{ Read New Character From Input Stream }
procedure GetChar;
begin
   Read(Look);
end;

{ Report an Error }
procedure Error(s: string);
begin
   WriteLn;
   WriteLn(^G, 'Error: ', s, '.');
end;

{ Report Error and Halt }
procedure Abort(s: string);
begin
   Error(s);
   Halt;
end;

{ Report What Was Expected }
procedure Expected(s: string);
begin
   Abort(s + ' Expected');
end;

{ Report an Undefined Identifier }
procedure Undefined(n: string);
begin
   Abort('Undefined Identifier ' + n);
end;

{ Recognize an Alpha Character }
function IsAlpha(c: char): boolean;
begin
   IsAlpha := UpCase(c) in ['A'..'Z'];
end;

{ Recognize a Decimal Digit }
function IsDigit(c: char): boolean;
begin
   IsDigit := c in ['0'..'9'];
end;

{ Recognize an AlphaNumeric Character }
function IsAlNum(c: char): boolean;
begin
   IsAlNum := IsAlpha(c) or IsDigit(c);
end;

{ Recognize an Addop }
function IsAddop(c: char): boolean;
begin
   IsAddop := c in ['+', '-'];
end;

{ Recognize a Mulop }
function IsMulop(c: char): boolean;
begin
   IsMulop := c in ['*', '/'];
end;

{ Recognize a Boolean Orop }
function IsOrop(c: char): boolean;
begin
   IsOrop := c in ['|', '~'];
end;

{ Recognize a Relop }
function IsRelop(c: char): boolean;
begin
   IsRelop := c in ['=', '#', '<', '>'];
end;

{ Recognize White Space }
function IsWhite(c: char): boolean;
begin
   IsWhite := c in [' ', TAB];
end;

{ Skip Over Leading White Space }
procedure SkipWhite;
begin
   while IsWhite(Look) do
      GetChar;
end;

{ Skip Over an End-of-Line }
procedure NewLine;
begin
   while Look = CR do begin
      GetChar;
      if Look = LF then GetChar;
      SkipWhite;
   end;
end;

{ Match a Specific Input Character }
procedure Match(x: char);
begin
   NewLine;
   if Look = x then GetChar
   else Expected('''' + x + '''');
   SkipWhite;
end;

{ Table Lookup }
function Lookup(T: TabPtr; s: string; n: integer): integer;
var i: integer;
    found: Boolean;
begin
   found := false;
   i := n;
   while (i > 0) and not found do
      if s = T^[i] then
         found := true
      else
         dec(i);
   Lookup := i;
end;

{ Locate a Symbol in Table }
{ Returns the index of the entry.  Zero if not present. }
function Locate(N: Symbol): integer;
begin
   Locate := Lookup(@ST, n, MaxEntry);
end;

{ Look for Symbol in Table }
function InTable(n: Symbol): Boolean;
begin
   InTable := Lookup(@ST, n, MaxEntry) <> 0;
end;

{ Add a New Entry to Symbol Table }
procedure AddEntry(N: Symbol; T: char);
begin
   if InTable(N) then Abort('Duplicate Identifier ' + N);
   if NEntry = MaxEntry then Abort('Symbol Table Full');
   Inc(NEntry);
   ST[NEntry] := N;
   SType[NEntry] := T;
end;

{ Get an Identifier }
procedure GetName;
begin
   NewLine;
   if not IsAlpha(Look) then Expected('Name');
   Value := '';
   while IsAlNum(Look) do begin
      Value := Value + UpCase(Look);
      GetChar;
   end;
   SkipWhite;
end;

{ Get a Number }
function GetNum: integer;
var Val: integer;
begin
   NewLine;
   if not IsDigit(Look) then Expected('Integer');
   Val := 0;
   while IsDigit(Look) do begin
      Val := 10 * Val + Ord(Look) - Ord('0');
      GetChar;
   end;
   GetNum := Val;
   SkipWhite;
end;

{ Get an Identifier and Scan it for Keywords }
procedure Scan;
begin
   GetName;
   Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1];
end;

{ Match a Specific Input String }
procedure MatchString(x: string);
begin
   if Value <> x then Expected('''' + x + '''');
end;

{ Output a String with Tab }
procedure Emit(s: string);
begin
   Write(TAB, s);
end;

{ Output a String with Tab and CRLF }
procedure EmitLn(s: string);
begin
   Emit(s);
   WriteLn;
end;

{ Generate a Unique Label }
function NewLabel: string;
var S: string;
begin
   Str(LCount, S);
   NewLabel := 'L' + S;
   Inc(LCount);
end;

{ Post a Label To Output }
procedure PostLabel(L: string);
begin
   WriteLn(L, ':');
end;

{ Clear the Primary Register }
procedure Clear;
begin
   EmitLn('CLR D0');
end;

{ Negate the Primary Register }
procedure Negate;
begin
   EmitLn('NEG D0');
end;

{ Complement the Primary Register }
procedure NotIt;
begin
   EmitLn('NOT D0');
end;

{ Load a Constant Value to Primary Register }
 LoadConst(n: integer);
begin
   Emit('MOVE #');
   WriteLn(n, ',D0');
end;

{ Load a Variable to Primary Register }
procedure LoadVar(Name: string);
begin
   if not InTable(Name) then Undefined(Name);
   EmitLn('MOVE ' + Name + '(PC),D0');
end;

{ Push Primary onto Stack }
procedure Push;
begin
   EmitLn('MOVE D0,-(SP)');
end;

{ Add Top of Stack to Primary }
procedure PopAdd;
begin
   EmitLn('ADD (SP)+,D0');
end;

{ Subtract Primary from Top of Stack }
procedure PopSub;
begin
   EmitLn('SUB (SP)+,D0');
   EmitLn('NEG D0');
end;

{ Multiply Top of Stack by Primary }
procedure PopMul;
begin
   EmitLn('MULS (SP)+,D0');
end;

{ Divide Top of Stack by Primary }
procedure PopDiv;
begin
   EmitLn('MOVE (SP)+,D7');
   EmitLn('EXT.L D7');
   EmitLn('DIVS D0,D7');
   EmitLn('MOVE D7,D0');
end;

{ AND Top of Stack with Primary }
procedure PopAnd;
begin
   EmitLn('AND (SP)+,D0');
end;

{ OR Top of Stack with Primary }
procedure PopOr;
begin
   EmitLn('OR (SP)+,D0');
end;

{ XOR Top of Stack with Primary }
procedure PopXor;
begin
   EmitLn('EOR (SP)+,D0');
end;

{ Compare Top of Stack with Primary }
procedure PopCompare;
begin
   EmitLn('CMP (SP)+,D0');
end;

{ Set D0 If Compare was = }
procedure SetEqual;
begin
   EmitLn('SEQ D0');
   EmitLn('EXT D0');
end;

{ Set D0 If Compare was != }
procedure SetNEqual;
begin
   EmitLn('SNE D0');
   EmitLn('EXT D0');
end;

{ Set D0 If Compare was > }
procedure SetGreater;
begin
   EmitLn('SLT D0');
   EmitLn('EXT D0');
end;

{ Set D0 If Compare was < }
procedure SetLess;
begin
   EmitLn('SGT D0');
   EmitLn('EXT D0');
end;

{ Set D0 If Compare was <= }
procedure SetLessOrEqual;
begin
   EmitLn('SGE D0');
   EmitLn('EXT D0');
end;

{ Set D0 If Compare was >= }
procedure SetGreaterOrEqual;
begin
   EmitLn('SLE D0');
   EmitLn('EXT D0');
end;

{ Store Primary to Variable }
procedure Store(Name: string);
begin
   if not InTable(Name) then Undefined(Name);
   EmitLn('LEA ' + Name + '(PC),A0');
   EmitLn('MOVE D0,(A0)')
end;

{ Branch Unconditional  }
procedure Branch(L: string);
begin
   EmitLn('BRA ' + L);
end;

{ Branch False }
procedure BranchFalse(L: string);
begin
   EmitLn('TST D0');
   EmitLn('BEQ ' + L);
end;

{ Read Variable to Primary Register }
procedure ReadVar;
begin
   EmitLn('BSR READ');
   Store(Value[1]);
end;

{ Write Variable from Primary Register }
procedure WriteVar;
begin
   EmitLn('BSR WRITE');
end;

{ Write Header Info }
procedure Header;
begin
   WriteLn('WARMST', TAB, 'EQU $A01E');
end;

{ Write the Prolog }
procedure Prolog;
begin
   PostLabel('MAIN');
end;

{ Write the Epilog }
procedure Epilog;
begin
   EmitLn('DC WARMST');
   EmitLn('END MAIN');
end;

{ Parse and Translate a Math Factor }
procedure BoolExpression; Forward;
procedure Factor;
begin
   if Look = '(' then begin
      Match('(');
      BoolExpression;
      Match(')');
      end
   else if IsAlpha(Look) then begin
      GetName;
      LoadVar(Value);
      end
   else
      LoadConst(GetNum);
end;

{ Parse and Translate a Negative Factor }
procedure NegFactor;
begin
   Match('-');
   if IsDigit(Look) then
      LoadConst(-GetNum)
   else begin
      Factor;
      Negate;
   end;
end;

{ Parse and Translate a Leading Factor }
procedure FirstFactor;
begin
   case Look of
     '+': begin
             Match('+');
             Factor;
          end;
     '-': NegFactor;
   else  Factor;
   end;
end;

{ Recognize and Translate a Multiply }
procedure Multiply;
begin
   Match('*');
   Factor;
   PopMul;
end;

{ Recognize and Translate a Divide }
procedure Divide;
begin
   Match('/');
   Factor;
   PopDiv;
end;

{ Common Code Used by Term and FirstTerm }
procedure Term1;
begin
   while IsMulop(Look) do begin
      Push;
      case Look of
       '*': Multiply;
       '/': Divide;
      end;
   end;
end;

{ Parse and Translate a Math Term }
procedure Term;
begin
   Factor;
   Term1;
end;

{ Parse and Translate a Leading Term }
procedure FirstTerm;
begin
   FirstFactor;
   Term1;
end;

{ Recognize and Translate an Add }
procedure Add;
begin
   Match('+');
   Term;
   PopAdd;
end;

{ Recognize and Translate a Subtract }
procedure Subtract;
begin
   Match('-');
   Term;
   PopSub;
end;

{ Parse and Translate an Expression }
procedure Expression;
begin
   FirstTerm;
   while IsAddop(Look) do begin
      Push;
      case Look of
       '+': Add;
       '-': Subtract;
      end;
   end;
end;

{ Recognize and Translate a Relational "Equals" }
procedure Equal;
begin
   Match('=');
   Expression;
   PopCompare;
   SetEqual;
end;

{ Recognize and Translate a Relational "Less Than or Equal" }
procedure LessOrEqual;
begin
   Match('=');
   Expression;
   PopCompare;
   SetLessOrEqual;
end;

{ Recognize and Translate a Relational "Not Equals" }
procedure NotEqual;
begin
   Match('>');
   Expression;
   PopCompare;
   SetNEqual;
end;

{ Recognize and Translate a Relational "Less Than" }
procedure Less;
begin
   Match('<');
   case Look of
     '=': LessOrEqual;
     '>': NotEqual;
   else begin
           Expression;
           PopCompare;
           SetLess;
        end;
   end;
end;

{ Recognize and Translate a Relational "Greater Than" }
procedure Greater;
begin
   Match('>');
   if Look = '=' then begin
      Match('=');
      Expression;
      PopCompare;
      SetGreaterOrEqual;
      end
   else begin
      Expression;
      PopCompare;
      SetGreater;
   end;
end;

{ Parse and Translate a Relation }
procedure Relation;
begin
   Expression;
   if IsRelop(Look) then begin
      Push;
      case Look of
       '=': Equal;
       '<': Less;
       '>': Greater;
      end;
   end;
end;

{ Parse and Translate a Boolean Factor with Leading NOT }
procedure NotFactor;
begin
   if Look = '!' then begin
      Match('!');
      Relation;
      NotIt;
      end
   else
      Relation;
end;

{ Parse and Translate a Boolean Term }
procedure BoolTerm;
begin
   NotFactor;
   while Look = '&' do begin
      Push;
      Match('&');
      NotFactor;
      PopAnd;
   end;
end;

{ Recognize and Translate a Boolean OR }
procedure BoolOr;
begin
   Match('|');
   BoolTerm;
   PopOr;
end;

{ Recognize and Translate an Exclusive Or }
procedure BoolXor;
begin
   Match('~');
   BoolTerm;
   PopXor;
end;

{ Parse and Translate a Boolean Expression }
procedure BoolExpression;
begin
   BoolTerm;
   while IsOrOp(Look) do begin
      Push;
      case Look of
       '|': BoolOr;
       '~': BoolXor;
      end;
   end;
end;

{ Parse and Translate an Assignment Statement }
procedure Assignment;
var Name: string;
begin
   Name := Value;
   Match('=');
   BoolExpression;
   Store(Name);
end;

{ Recognize and Translate an IF Construct }
procedure Block; Forward;
procedure DoIf;
var L1, L2: string;
begin
   BoolExpression;
   L1 := NewLabel;
   L2 := L1;
   BranchFalse(L1);
   Block;
   if Token = 'l' then begin
      L2 := NewLabel;
      Branch(L2);
      PostLabel(L1);
      Block;
   end;
   PostLabel(L2);
   MatchString('ENDIF');
end;

{ Parse and Translate a WHILE Statement }
procedure DoWhile;
var L1, L2: string;
begin
   L1 := NewLabel;
   L2 := NewLabel;
   PostLabel(L1);
   BoolExpression;
   BranchFalse(L2);
   Block;
   MatchString('ENDWHILE');
   Branch(L1);
   PostLabel(L2);
end;

{ Process a Read Statement }
procedure DoRead;
begin
   Match('(');
   GetName;
   ReadVar;
   while Look = ',' do begin
      Match(',');
      GetName;
      ReadVar;
   end;
   Match(')');
end;

{ Process a Write Statement }
procedure DoWrite;
begin
   Match('(');
   Expression;
   WriteVar;
   while Look = ',' do begin
      Match(',');
      Expression;
      WriteVar;
   end;
   Match(')');
end;

{ Parse and Translate a Block of Statements }
procedure Block;
begin
   Scan;
   while not(Token in ['e', 'l']) do begin
      case Token of
       'i': DoIf;
       'w': DoWhile;
       'R': DoRead;
       'W': DoWrite;
      else Assignment;
      end;
      Scan;
   end;
end;

{ Allocate Storage for a Variable }
procedure Alloc(N: Symbol);
begin
   if InTable(N) then Abort('Duplicate Variable Name ' + N);
   AddEntry(N, 'v');
   Write(N, ':', TAB, 'DC ');
   if Look = '=' then begin
      Match('=');
      If Look = '-' then begin
         Write(Look);
         Match('-');
      end;
      WriteLn(GetNum);
      end
   else
      WriteLn('0');
end;

{ Parse and Translate a Data Declaration }
procedure Decl;
begin
   GetName;
   Alloc(Value);
   while Look = ',' do begin
      Match(',');
      GetName;
      Alloc(Value);
   end;
end;

{ Parse and Translate Global Declarations }
procedure TopDecls;
begin
   Scan;
   while Token <> 'b' do begin
      case Token of
        'v': Decl;
      else Abort('Unrecognized Keyword ' + Value);
      end;
      Scan;
   end;
end;

{ Parse and Translate a Main Program }
procedure Main;
begin
   MatchString('BEGIN');
   Prolog;
   Block;
   MatchString('END');
   Epilog;
end;

{  Parse and Translate a Program }
procedure Prog;
begin
   MatchString('PROGRAM');
   Header;
   TopDecls;
   Main;
   Match('.');
end;

{ Initialize }
procedure Init;
var i: integer;
begin
   for i := 1 to MaxEntry do begin
      ST[i] := '';
      SType[i] := ' ';
   end;
   GetChar;
   Scan;
end;

{ Main Program }
begin
   Init;
   Prog;
   if Look <> CR then Abort('Unexpected data after ''.''');
end.

10.12. Input/Output		Chapter 11. Lexical Scan Revisited