{ Scan the Current Identifier for Keywords }

       procedure Scan;
       begin
          if Token = 'x' then
             Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1];
       end;
       {--------------------------------------------------------------}


       There is one last detail.  In the compiler there are a few places
       that we must  actually  check  the  string  value  of  the token.
       Mainly, this  is done to distinguish between the different END's,
       but there are a couple  of  other  places.    (I  should  note in
       passing that we could always  eliminate the need for matching END
       characters by encoding each one  to a different character.  Right
       now we are definitely taking the lazy man's route.)

       The  following  version  of MatchString takes the  place  of  the
       character-oriented Match.  Note that, like Match, it DOES advance
       the input stream.


       {--------------------------------------------------------------}
       { Match a Specific Input String }

       procedure MatchString(x: string);
       begin
          if Value <> x then Expected('''' + x + '''');
          Next;
       end;
       {--------------------------------------------------------------}


       FIXING UP THE COMPILER

       Armed with these new scanner procedures, we can now begin  to fix
       the compiler to  use  them  properly.   The changes are all quite
       minor,  but  there  are quite a  few  places  where  changes  are
       necessary.  Rather than  showing  you each place, I will give you
       the general idea and then just give the finished product.


       First of all, the code for procedure Block doesn't change, though
       its function does:


       {--------------------------------------------------------------}
       { Parse and Translate a Block of Statements }

       procedure Block;
       begin
          Scan;
          while not(Token in ['e', 'l']) do beginA*2A*
                                     - 9 -

PA2A





             case Token of
              'i': DoIf;
              'w': DoWhile;
              'R': DoRead;
              'W': DoWrite;
             else Assignment;
             end;
             Scan;
          end;
       end;
       {--------------------------------------------------------------}


       Remember that the new version of Scan doesn't  advance  the input
       stream, it only  scans  for  keywords.   The input stream must be
       advanced by each procedure that Block calls.

       In general, we have to replace every test on Look with  a similar
       test on Token.  For example:


       {---------------------------------------------------------------}
       { Parse and Translate a Boolean Expression }

       procedure BoolExpression;
       begin
          BoolTerm;
          while IsOrOp(Token) do begin
             Push;
             case Token of
              '|': BoolOr;
              '~': BoolXor;
             end;
          end;
       end;
       {--------------------------------------------------------------}


       In procedures like Add, we don't  have  to use Match anymore.  We
       need only call Next to advance the input stream:


       {--------------------------------------------------------------}
       { Recognize and Translate an Add }

       procedure Add;
       begin
          Next;
          Term;
          PopAdd;
       end;
       {-------------------------------------------------------------}AB2AB
                                    - 10 -A*2A*

PA2A





       Control  structures  are  actually simpler.  We just call Next to
       advance over the control keywords:


       {---------------------------------------------------------------}
       { Recognize and Translate an IF Construct }

       procedure Block; Forward;

       procedure DoIf;
       var L1, L2: string;
       begin
          Next;
          BoolExpression;
          L1 := NewLabel;
          L2 := L1;
          BranchFalse(L1);
          Block;
          if Token = 'l' then begin
             Next;
             L2 := NewLabel;
             Branch(L2);
             PostLabel(L1);
             Block;
          end;
          PostLabel(L2);
          MatchString('ENDIF');
       end;
       {--------------------------------------------------------------}


       That's about the extent of the REQUIRED changes.  In  the listing
       of TINY  Version  1.1  below,  I've  also  made a number of other
       "improvements" that  aren't really required.  Let me explain them
       briefly:

        (1)  I've deleted the two procedures Prog and Main, and combined
             their functions into the main program.  They didn't seem to
             add  to program clarity ... in fact  they  seemed  to  just
             muddy things up a little.

        (2)  I've  deleted  the  keywords  PROGRAM  and  BEGIN  from the
             keyword list.  Each  one  only occurs in one place, so it's
             not necessary to search for it.

        (3)  Having been  bitten  by  an  overdose  of  cleverness, I've
             reminded myself that TINY  is  supposed  to be a minimalist
             program.  Therefore I've  replaced  the  fancy  handling of
             unary minus with the dumbest one I could think of.  A giant
             step backwards in code quality, but a  great simplification
             of the compiler.  KISS is the right place to use  the other
             version.AB2AB
                                    - 11 -A*2A*

PA2A





        (4)  I've added some  error-checking routines such as CheckTable
             and CheckDup, and  replaced  in-line code by calls to them.
             This cleans up a number of routines.

        (5)  I've  taken  the  error  checking  out  of  code generation
             routines  like Store, and put it in  the  parser  where  it
             belongs.  See Assignment, for example.

        (6)  There was an error in InTable and Locate  that  caused them
             to search all locations  instead  of  only those with valid
             data  in them.  They now search only  valid  cells.    This
             allows us to eliminate  the  initialization  of  the symbol
             table, which was done in Init.

        (7)  Procedure AddEntry now has two  arguments,  which  helps to
             make things a bit more modular.

        (8)  I've cleaned up the  code  for  the relational operators by
             the addition of the  new  procedures  CompareExpression and
             NextExpression.

        (9)  I fixed an error in the Read routine ... the  earlier value
             did not check for a valid variable name.


        CONCLUSION

       The resulting compiler for  TINY  is given below.  Other than the
       removal  of  the  keyword PROGRAM, it parses the same language as
       before.    It's  just  a  bit cleaner, and more importantly  it's
       considerably more robust.  I feel good about it.

       The next installment will be another  digression:  the discussion
       of  semicolons  and  such that got me into this mess in the first
       place.  THEN we'll press on  into  procedures and types.  Hang in
       there with me.  The addition of those features will go a long way
       towards removing KISS from  the  "toy  language" category.  We're
       getting very close to being able to write a serious compiler.


       TINY VERSION 1.1


       {--------------------------------------------------------------}
       program Tiny11;

       {--------------------------------------------------------------}
       { Constant Declarations }

       const TAB = ^I;
             CR  = ^M;
             LF  = ^J;

             LCount: integer = 0;A*2A*
                                    - 12 -

PA2A





             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 =   9;
             NKW1 = 10;

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

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


       {--------------------------------------------------------------}
       { Read New Character From Input Stream }

       procedure GetChar;
       begin
          Read(Look);
       end;

       {--------------------------------------------------------------}
       { Report an Error }

       procedure Error(s: string);
       begin
          WriteLn;A*2A*
                                    - 13 -

PA2A





          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;


       {--------------------------------------------------------------}
       { Report a Duplicate Identifier }

       procedure Duplicate(n: string);
       begin
          Abort('Duplicate Identifier ' + n);
       end;


       {--------------------------------------------------------------}
       { Check to Make Sure the Current Token is an Identifier }

       procedure CheckIdent;
       begin
          if Token <> 'x' then Expected('Identifier');
       end;


       {--------------------------------------------------------------}
       { Recognize an Alpha Character }

       function IsAlpha(c: char): boolean;
       beginA*2A*
                                    - 14 -

PA2A





          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;
       beginA*2A*
                                    - 15 -

PA2A





          IsRelop := c in ['=', '#', '<', '>'];
       end;


       {--------------------------------------------------------------}
       { Recognize White Space }

       function IsWhite(c: char): boolean;
       begin
          IsWhite := c in [' ', TAB, CR, LF];
       end;


       {--------------------------------------------------------------}
       { Skip Over Leading White Space }

       procedure SkipWhite;
       begin
          while IsWhite(Look) do
             GetChar;
       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, NEntry);
       end;


       {--------------------------------------------------------------}
       { Look for Symbol in Table }A62A6
                                    - 16 -A*2A*

PA2A





       function InTable(n: Symbol): Boolean;
       begin
          InTable := Lookup(@ST, n, NEntry) <> 0;
       end;