#
LET'S BUILD A COMPILER!
By
Jack W. Crenshaw, Ph.D.
21 May 1989

## Part X: INTRODUCING "TINY"

## INTRODUCTION

In the last installment, I showed you the general idea for the top-down development of a compiler. I gave you the first few steps of the process for compilers for `Pascal` and `C`, but I stopped far short of pushing it through to completion. The reason was simple: if we're going to produce a real, functional compiler for any language, I'd rather do it for `KISS`, the language that I've been defining in this tutorial series.

In this installment, we're going to do just that, for a subset of `KISS` which I've chosen to call `TINY`.

The process will be essentially that outlined in Installment IX, except for one notable difference. In that installment, I suggested that you begin with a full BNF description of the language. That's fine for something like `Pascal` or `C`, for which the language definition is firm. In the case of `TINY`, however, we don't yet have a full description ... we seem to be defining the language as we go. That's OK. In fact, it's preferable, since we can tailor the language slightly as we go, to keep the parsing easy.

So in the development that follows, we'll actually be doing a top-down development of both the language and its compiler. The BNF description will grow along with the compiler.

In this process, there will be a number of decisions to be made, each of which will influence the BNF and therefore the nature of the language. At each decision point I'll try to remember to explain the decision and the rationale behind my choice. That way, if you happen to hold a different opinion and would prefer a different option, you can choose it instead. You now have the background to do that. I guess the important thing to note is that nothing we do here is cast in concrete. When you're designing your language, you should feel free to do it your way.

Many of you may be asking at this point: Why bother starting over from scratch? We had a working subset of `KISS` as the outcome of Installment VII (lexical scanning). Why not just extend it as needed? The answer is threefold. First of all, I have been making a number of changes to further simplify the program ... changes like encapsulating the code generation procedures, so that we can convert to a different target machine more easily. Second, I want you to see how the development can indeed be done from the top down as outlined in the last installment. Finally, we both need the practice. Each time I go through this exercise, I get a little better at it, and you will, also.

## GETTING STARTED

Many years ago there were languages called `Tiny BASIC`, `Tiny Pascal`, and `Tiny C`, each of which was a subset of its parent full language. `Tiny BASIC`, for example, had only single-character variable names and global variables. It supported only a single data type. Sound familiar? At this point we have almost all the tools we need to build a compiler like that.

Yet a language called Tiny-anything still carries some baggage inherited from its parent language. I've often wondered if this is a good idea. Granted, a language based upon some parent language will have the advantage of familiarity, but there may also be some peculiar syntax carried over from the parent that may tend to add unnecessary complexity to the compiler. (Nowhere is this more true than in `Small C`.)

I've wondered just how small and simple a compiler could be made and still be useful, if it were designed from the outset to be both easy to use and to parse. Let's find out. This language will just be called "`TINY`," period. It's a subset of `KISS`, which I also haven't fully defined, so that at least makes us consistent (!). I suppose you could call it `TINY` `KISS`. But that opens up a whole can of worms involving cuter and cuter (and perhaps more risque) names, so let's just stick with `TINY`.

The main limitations of `TINY` will be because of the things we haven't yet covered, such as data types. Like its cousins `Tiny C` and `Tiny BASIC`, `TINY` will have only one data type, the 32-bit integer. The first version we develop will also have no procedure calls and will use single-character variable names, although as you will see we can remove these restrictions without much effort.

The language I have in mind will share some of the good features of `Pascal`, `C`, and `Ada`. Taking a lesson from the comparison of the `Pascal` and `C` compilers in the previous installment, though, `TINY` will have a decided `Pascal` flavor. Wherever feasible, a language structure will be bracketed by keywords or symbols, so that the parser will know where it's going without having to guess.

One other ground rule: As we go, I'd like to keep the compiler producing real, executable code. Even though it may not do much at the beginning, it will at least do it correctly.

Finally, I'll use a couple of `Pascal` restrictions that make sense: All data and procedures must be declared before they are used. That makes good sense, even though for now the only data type we'll use is a word. This rule in turn means that the only reasonable place to put the executable code for the main program is at the end of the listing.

The top-level definition will be similar to `Pascal`:

         <program> ::= PROGRAM <top-level decl> <main> '.'

Already, we've reached a decision point. My first thought was to make the main block optional. It doesn't seem to make sense to write a "program" with no main program, but it does make sense if we're allowing for multiple modules, linked together. As a matter of fact, I intend to allow for this in `KISS`. But then we begin to open up a can of worms that I'd rather leave closed for now. For example, the term "PROGRAM" really becomes a misnomer. The MODULE of Modula-2 or the Unit of `Turbo Pascal` would be more appropriate. Second, what about scope rules? We'd need a convention for dealing with name visibility across modules. Better for now to just keep it simple and ignore the idea altogether.

There's also a decision in choosing to require the main program to be last. I toyed with the idea of making its position optional, as in `C`. But this doesn't really make much sense in view of the `Pascal`-like requirement that all data and procedures be declared before they're referenced. Since the main program can only call procedures that have already been declared, the only position that makes sense is at the end, a la `Pascal`.

Given the BNF above, let's write a parser that just recognizes the brackets:

    -- ------------------------------------------------------------
    -- Parse and translate a program
    : prog ( -- )
            'p' match
            header
            prolog
            '.' match
            epilog ;
    -- ------------------------------------------------------------

The procedure Header just emits the startup code required by the assembler:

    -- ------------------------------------------------------------
    -- Write header info
    : header ( -- )
            S" -- DATA section --------" emitdln
            S" " emitdln ;
    -- ------------------------------------------------------------

The procedures Prolog and Epilog emit the code for identifying the main program, and for returning to the OS (i.e. Forth):

    -- ------------------------------------------------------------
    -- Write the prolog
    : prolog ( -- )
            S" " emitln
            S" -- CODE section --------" emitdln
            S" "          emitdln
            S" CODE main" emitdln
            S" rpush,"    emitln
            newlabel postlabel ;
    -- ------------------------------------------------------------
    -- Write the epilog
    : epilog ( -- )
            S" rpop,  ebx jmp," emitln
            S" END-CODE"        emitdln ;
    -- ------------------------------------------------------------

The main program just calls Prog, and then looks for a clean ending:

    -- -------------------------------------------------------------------------
    : tiny10 ( -- )
            init prog
            Look ^M <> IF  S" Unexpected data after " S" ." name.aborts  ENDIF ;
    -- -------------------------------------------------------------------------

At this point, `TINY` will accept only one input "program," the null program (chap10a.frt):

         PROGRAM .   (or 'p.' in our shorthand.)

Note, though, that the compiler does generate correct code for this program. It will run, and do what you'd expect the null program to do, that is, nothing but return gracefully to the OS.

As a matter of interest, one of my favorite compiler benchmarks is to compile, link, and execute the null program in whatever language is involved. You can learn a lot about the implementation by measuring the overhead in time required to compile what should be a trivial case. It's also interesting to measure the amount of code produced. In many compilers, the code can be fairly large, because they always include the whole run-time library whether they need it or not. Early versions of `Turbo Pascal` produced a 12K object file for this case. VAX `C` generates 50K!

The smallest null programs I've seen are those produced by Modula-2 compilers, and they run about 200-800 bytes.

In the case of `TINY`, we have no run-time library as yet, so the object code is indeed tiny: two bytes. That's got to be a record, and it's likely to remain one since it is the minimum size required by the OS.

The next step is to process the code for the main program. I'll use the `Pascal` `BEGIN`-block:

         <main> ::= BEGIN <block> END

Here, again, we have made a decision. We could have chosen to require a "PROCEDURE MAIN" sort of declaration, similar to `C`. I must admit that this is not a bad idea at all ... I don't particularly like the `Pascal` approach since I tend to have trouble locating the main program in a `Pascal` listing. But the alternative is a little awkward, too, since you have to deal with the error condition where the user omits the main program or misspells its name. Here I'm taking the easy way out.

Another solution to the "where is the main program" problem might be to require a name for the program, and then bracket the main by

         BEGIN <name>
         END <name>

similar to the convention of `Modula 2`. This adds a bit of "syntactic sugar" to the language. Things like this are easy to add or change to your liking, if the language is your own design.

To parse this definition of a main block, change procedure `Prog` to read:

    -- ------------------------------------------------------------
    -- Parse and translate a program
    : prog ( -- )
            'p' match
            header
            main
            '.' match ;
    -- ------------------------------------------------------------

and add the new procedure:

    -- ------------------------------------------------------------
    -- Parse and translate a main program
    : main ( -- )
            'b' match
            prolog
            'e' match
            epilog ;
    -- ------------------------------------------------------------

Now, the only legal program is (chap10b.frt):

         PROGRAM BEGIN END . (or 'pbe.')

Aren't we making progress??? Well, as usual it gets better. You might try some deliberate errors here, like omitting the 'b' or the 'e', and see what happens. As always, the compiler should flag all illegal inputs.

## DECLARATIONS

The obvious next step is to decide what we mean by a declaration. My intent here is to have two kinds of declarations: variables and procedures/functions. At the top level, only global declarations are allowed, just as in `C`.

For now, there can only be variable declarations, identified by the keyword `VAR` (abbreviated 'v'):

         <top-level decls> ::= ( <data declaration> )*

         <data declaration> ::= VAR <var-list>

Note that since there is only one variable type, there is no need to declare the type. Later on, for full `KISS`, we can easily add a type description.

The procedure `Prog` becomes:

    -- ------------------------------------------------------------
    -- Parse and translate a program
    : prog ( -- )
            'p' match
            header
            topdecls
            main
            '.' match ;
    -- ------------------------------------------------------------

Now, add the two new procedures:

    -- ------------------------------------------------------------
    -- Process a data declaration
    : decl ( -- )
            'v' match
            getchar ;
    -- ------------------------------------------------------------
    -- Parse and translate global declarations
    : topdecls ( -- )
            BEGIN   Look 'b' <>
            WHILE   CASE Look
                     'v' OF decl  ENDOF
                         S" Unrecognized keyword " Look name.aborts
                    ENDCASE
            REPEAT ;
    -- ------------------------------------------------------------

Note that at this point, `Decl` is just a stub. It generates no code, and it doesn't process a list ... every variable must occur in a separate `VAR` statement.

OK, now we can have any number of data declarations, each starting with a 'v' for `VAR`, before the `BEGIN`-block. Try a few cases and see what happens (chap10c.frt).

## DECLARATIONS AND SYMBOLS

That looks pretty good, but we're still only generating the null program for output. A real compiler would issue assembler directives to allocate storage for the variables. It's about time we actually produced some code.

With a little extra code, that's an easy thing to do from procedure `Decl`. Modify it as follows:

    -- ------------------------------------------------------------
    -- Parse and translate a data declaration
    : decl ( -- )
            'v' match
            getname alloc ;
    -- ------------------------------------------------------------

The procedure `Alloc` just issues a command to the assembler to allocate storage:

    -- ------------------------------------------------------------
    -- Allocate storage for a variable
    : alloc ( char -- )
            S" CREATE " ROT CHAR-APPEND S"  0 , " $+ emitdln ;
    -- ------------------------------------------------------------

Give this one a whirl (chap10d.frt). Try an input that declares some variables, such as:

         pvxvyvzbe.

See how the storage is allocated? Simple, huh? Note also that the entry point, "MAIN," comes out in the right place.

For the record, a "real" compiler would also have a symbol table to record the variables being used. Normally, the symbol table is necessary to record the type of each variable. But since in this case all variables have the same type, we don't need a symbol table for that reason. As it turns out, we're going to find a symbol necessary even without different types, but let's postpone that need until it arises.

Of course, we haven't really parsed the correct syntax for a data declaration, since it involves a variable list. Our version only permits a single variable. That's easy to fix, too.

The BNF for <var-list> is

         <var-list> ::= <ident> (, <ident>)*

Adding this syntax to `Decl` gives this new version:

    -- ------------------------------------------------------------
    -- Parse and translate a data declaration
    : decl ( -- )
            'v' match
            getname alloc
            BEGIN  Look ',' =
            WHILE  getchar getname alloc
            REPEAT ;
    -- ------------------------------------------------------------

OK, now compile this code and give it a try (chap10e.frt). Try a number of lines of `VAR` declarations, try a list of several variables on one line, and try combinations of the two. Does it work?

## INITIALIZERS

As long as we're dealing with data declarations, one thing that's always bothered me about `Pascal` is that it doesn't allow initializing data items in the declaration. That feature is admittedly sort of a frill, and it may be out of place in a language that purports to be a minimal language. But it's also so easy to add that it seems a shame not to do so. The BNF becomes:

         <var-list> ::= <var> ( <var> )*

         <var> ::= <ident> [ = <integer> ]

Change `Alloc` as follows:

    -- ------------------------------------------------------------
    -- Allocate storage for a variable
    : alloc ( char -- )
            S" CREATE " ROT CHAR-APPEND BL CHAR-APPEND
            Look '=' = IF   '=' match
                            getnum (.)
                     ELSE   S" 0"
                    ENDIF   $+
            S"  ," $+ emitln ;
    -- ------------------------------------------------------------

There you are: an initializer with six added lines of `Pascal`.

OK, try this version of `TINY` and verify that you can, indeed, give the variables initial values (chap10f.frt).

By golly, this thing is starting to look real! Of course, it still doesn't do anything, but it looks good, doesn't it?

Before leaving this section, I should point out that we've used two versions of function `GetNum`. One, the earlier one, returns a character value, a single digit. The other accepts a multi-digit integer and returns an integer value. Either one will work here, since `WriteLn` will handle either type. But there's no reason to limit ourselves to single-digit values here, so the correct version to use is the one that returns an integer. Here it is:

    -- ------------------------------------------------------------
    -- Get a Number
    : getnum ( -- val )
            Look digit? 0= IF  S" Integer" expected  ENDIF
            0 >R
            BEGIN   Look digit?
            WHILE   R> #10 *  Look '0' - +  >R
                    getchar
            REPEAT  R> ;
    -- ------------------------------------------------------------

As a matter of fact, strictly speaking we should allow for expressions in the data field of the initializer, or at the very least for negative values. For now, let's just allow for negative values by changing the code for `Alloc` as follows:

    -- ------------------------------------------------------------
    -- Allocate storage for a variable
    : alloc ( char -- )
            S" CREATE " ROT CHAR-APPEND BL CHAR-APPEND
            Look '=' = IF   '=' match
                            Look '-' = IF '-' match S" -" $+ ENDIF
                            getnum (.)
                     ELSE   S" 0"
                    ENDIF   $+
            S"  ," $+ emitln ;

    -- ------------------------------------------------------------

Now you should be able to initialize variables with negative and/or multi-digit values (chap10g.frt).

## THE SYMBOL TABLE

There's one problem with the compiler as it stands so far: it doesn't do anything to record a variable when we declare it. So the compiler is perfectly content to allocate storage for several variables with the same name. You can easily verify this with an input like

         pvavavabe.

Here we've declared the variable A three times. As you can see, the compiler will cheerfully accept that, and generate three identical labels. Not good.

Later on, when we start referencing variables, the compiler will also let us reference variables that don't exist. The assembler will catch both of these error conditions, but it doesn't seem friendly at all to pass such errors along to the assembler. The compiler should catch such things at the source language level.

So even though we don't need a symbol table to record data types, we ought to install one just to check for these two conditions. Since at this point we are still restricted to single-character variable names, the symbol table can be trivial. To provide for it, first add the following declaration at the beginning of your program:

         CREATE ST  26 CHARS ALLOT

and insert the following function:

    -- ------------------------------------------------------------
    -- Look for symbol in table
    : intable ( char -- tf ) 'A' - ST + C@  0<> ;
    -- ------------------------------------------------------------

We also need to initialize the table to all blanks. The following lines in `Init` will do the job:

    begin
            ST 26 ERASE
       ...

Finally, insert the following two lines at the beginning of `Alloc`:

            ( n) DUP intable IF  S" Duplicate variable name" ROT name.aborts  ENDIF
            'v' OVER 'A' - ST + C!

That should do it. The compiler will now catch duplicate declarations. Later, we can also use InTable when generating references to the variables. (chap10h.frt)

## EXECUTABLE STATEMENTS

At this point, we can generate a null program that has some data variables declared and possibly initialized. But so far we haven't arranged to generate the first line of executable code.

Believe it or not, though, we almost have a usable language! What's missing is the executable code that must go into the main program. But that code is just assignment statements and control statements ... all stuff we have done before. So it shouldn't take us long to provide for them, as well.

The BNF definition given earlier for the main program included a statement block, which we have so far ignored:

         <main> ::= BEGIN <block> END

For now, we can just consider a block to be a series of assignment statements:

         <block> ::= (Assignment)*

Let's start things off by adding a parser for the block. We'll begin with a stub for the assignment statement:

    -- ------------------------------------------------------------
    -- Parse and translate an assignment statement
    : assignment ( -- ) getchar ;
    -- ------------------------------------------------------------
    -- Parse and translate a block of statements
    : block ( -- )
            BEGIN  Look 'e' <>
            WHILE  assignment
            REPEAT ;
    -- ------------------------------------------------------------

Modify procedure Main to call `Block` as shown below:

    -- ------------------------------------------------------------
    -- Parse and translate a main program
    : main ( -- )
            'b' match
            prolog
            block
            'e' match
            epilog ;
    -- ------------------------------------------------------------

This version still won't generate any code for the "assignment statements" ... all it does is to eat characters until it sees the 'e' for 'END.' But it sets the stage for what is to follow.

The next step, of course, is to flesh out the code for an assignment statement. This is something we've done many times before, so I won't belabor it. This time, though, I'd like to deal with the code generation a little differently. Up till now, we've always just inserted the Emits that generate output code in line with the parsing routines. A little unstructured, perhaps, but it seemed the most straightforward approach, and made it easy to see what kind of code would be emitted for each construct.

However, several of you have asked me if the CPU-dependent code couldn't be collected into one spot where it would be easier to retarget to another CPU. The answer, of course, is yes.

To accomplish this, insert the following "code generation" routines:

    -- -----------------------------------------------------------------------------------------------------------------------
    -- Load/store primary register with a constant/variable
    : loadconstant  ( u -- ) (.) S"  d# -> eax  mov," $+ emitln ;

    : loadvariable  ( char -- )
            DUP intable 0= IF  .undefined  ENDIF
            S"  dword-ptr -> eax  mov," ROT CHAR-PREPEND emitln ;

    : storevariable ( char -- )
            DUP intable 0= IF  .undefined  ENDIF
            S" eax -> " ROT CHAR-APPEND S"  dword-ptr  mov," $+ emitln ;

    -- Allocate storage for a static variable
    : allocatestorage ( char c-addr u -- )
            ROT
            S" CREATE " ROT CHAR-APPEND BL CHAR-APPEND
            2SWAP $+ S"  , " $+ emitdln ;

    : callfunction  ( char -- ) S"  offset NEAR call," ROT CHAR-PREPEND emitln ;    -- call a function

    : _negate ( -- ) S" eax  neg,"   emitln ;                                       -- negate primary
    : _not    ( -- ) S" eax  not,"   emitln ;                                       -- not primary
    : _push   ( -- ) S" eax  push,"  emitln ;                                       -- push primary to stack
    : _pop    ( -- ) S" eax  pop,"   emitln ;                                       -- pop primary from stack
    : _decr   ( -- ) S" 1 b# -> eax sub," emitln ;                                  -- decrement primary
    : _incr   ( -- ) S" 1 b# -> eax add," emitln ;                                  -- increment primary
    : _decSP  ( -- ) S" [esp -4 +] -> esp lea," emitln ;                            -- drop 1 stack item
    : _incSP  ( -- ) S" [esp  4 +] -> esp lea," emitln ;                            -- restore stack item
    : _popadd ( -- ) S" [esp] -> eax  add,  [esp 4 +] -> esp lea," emitln ;         -- add TOS to primary
    : _popsub ( -- ) S" [esp] -> eax  sub,  [esp 4 +] -> esp lea," emitln _negate ; -- subtract TOS from primary
    : _popor  ( -- ) S" [esp] -> eax  or,   [esp 4 +] -> esp lea," emitln ;         -- or TOS to primary
    : _popxor ( -- ) S" [esp] -> eax  xor,  [esp 4 +] -> esp lea," emitln ;         -- xor TOS to primary
    : _popand ( -- ) S" [esp] -> eax  and,  [esp 4 +] -> esp lea," emitln ;         -- xor TOS to primary
    : _popcmp ( -- ) S" [esp] -> eax  cmp,  [esp 4 +] -> esp lea," emitln ;         -- compare TOS to primary
    : _sete   ( -- ) S" al  sete,   al -> eax  movsx," emitln ;                     -- set primary if equal
    : _setne  ( -- ) S" al  setne,  al -> eax  movsx," emitln ;                     -- set primary if NOT equal
    : _setg   ( -- ) S" al  setl,   al -> eax  movsx," emitln ;                     -- set primary if greater
    : _setl   ( -- ) S" al  setg,   al -> eax  movsx," emitln ;                     -- set primary if less
    : _setge  ( -- ) S" al  setle,  al -> eax  movsx," emitln ;                     -- set primary if greater or equal
    : _setle  ( -- ) S" al  setge,  al -> eax  movsx," emitln ;                     -- set primary if less or equal

    -- jump always; jump if eax 0
    : _branch    ( c-addr u -- ) S"  offset NEAR  jmp," $+ emitln ;
    : _pcmp+b0>  ( c-addr u -- ) _popcmp S"  offset NEAR  jg,"  $+ emitln ;
    : _branch0   ( c-addr u -- ) S" eax -> eax or,  " 2SWAP $+ S"  offset NEAR  je,"  $+ emitln ;
    : _branch<>0 ( c-addr u -- ) S" eax -> eax or,  " 2SWAP $+ S"  offset NEAR  jnz," $+ emitln ;

    -- multiply TOS and primary; divide primary by TOS
    : _popmul ( -- ) S" [esp] dword mul, [esp 4 +] -> esp lea," emitln ;
    : _popdiv ( -- ) S" ecx pop, ecx -> eax xchg, eax -> edx mov, #31 b# -> edx sar, ebx idiv," emitln ;
    -- -----------------------------------------------------------------------------------------------------------------------

The nice part of this approach, of course, is that we can retarget the compiler to a new CPU simply by rewriting these "code generator" procedures. In addition, we will find later that we can improve the code quality by tweaking these routines a bit, without having to modify the compiler proper.

Note that both `LoadVariable` and `StoreVariable` check the symbol table to make sure that the variable is defined. The error handler `.Undefined` simply calls `Abort`:

    -- ------------------------------------------------------------------
    -- Report an undefined identifier
    : .undefined ( char -- )
       S" Undefined identifier `" ROT CHAR-APPEND &' CHAR-APPEND aborts ;
    -- ------------------------------------------------------------------

OK, we are now finally ready to begin processing executable code. We'll do that by replacing the stub version of procedure `Assignment`.

We've been down this road many times before, so this should all be familiar to you. In fact, except for the changes associated with the code generation, we could just copy the procedures from Part VII. Since we are making some changes, I won't just copy them, but we will go a little faster than usual.

The BNF for the assignment statement is:

         <assignment> ::= <ident> = <expression>

         <expression> ::= <first term> ( <addop> <term> )*

         <first term> ::= <first factor> <rest>

         <term> ::= <factor> <rest>

         <rest> ::= ( <mulop> <factor> )*

         <first factor> ::= [ <addop> ] <factor>

         <factor> ::= <var> | <number> | ( <expression> )

This version of the BNF is also a bit different than we've used before ... yet another "variation on the theme of an expression." This particular version has what I consider to be the best treatment of the unary minus. As you'll see later, it lets us handle negative constant values efficiently. It's worth mentioning here that we have often seen the advantages of "tweaking" the BNF as we go, to help make the language easy to parse. What you're looking at here is a bit different: we've tweaked the BNF to make the code generation more efficient! That's a first for this series.

Anyhow, the following code implements the BNF:

    -- -------------------------------------------------------------
    -- Parse and Translate a Math Factor

    DEFER expression

    : factor ( -- )
       Look '(' =  IF  '(' match expression ')' match EXIT  ENDIF
       Look alpha? IF  getname loadvariable
                 ELSE  getnum  loadconstant
                ENDIF ;
    -- ------------------------------------------------------------
    -- Parse and translate a negative factor
    : negfactor ( -- )
       '-' match
       Look digit? IF  getnum NEGATE loadconstant EXIT  ENDIF
       factor _negate ;
    -- ------------------------------------------------------------
    -- Parse and translate a leading factor
    : firstfactor ( -- )
       CASE Look
         '+' OF  '+' match factor ENDOF
         '-' OF   negfactor       ENDOF
                  factor
       ENDCASE ;
    -- ------------------------------------------------------------
    -- Recognize and translate a multiply
    : multiply ( -- ) '*' match factor _popmul ;
    -- ------------------------------------------------------------
    -- Recognize and translate a divide
    : divide ( -- ) '/' match factor _popdiv ;
    -- ------------------------------------------------------------
    -- Common code used by term and firstterm
    : term1 ( -- )
       BEGIN Look mulop?
       WHILE _push
             CASE Look
              '*' OF multiply ENDOF
              '/' OF divide   ENDOF
             ENDCASE
       REPEAT ;
    -- ------------------------------------------------------------
    -- Parse and translate a math term
    : term ( -- ) factor term1 ;
    -- ------------------------------------------------------------
    -- Parse and translate a leading term
    : firstterm ( -- ) firstfactor term1 ;
    -- ------------------------------------------------------------
    -- Recognize and translate an add
    : add ( -- ) '+' match term _popadd ;
    -- ------------------------------------------------------------
    -- Recognize and translate a subtract
    : subtract ( -- ) '-' match term _popsub ;
    -- ------------------------------------------------------------
    -- Parse and translate an expression
    :NONAME ( -- )
       firstterm
       BEGIN Look addop?
       WHILE _push
             CASE Look
              '+' OF Add      ENDOF
              '-' OF Subtract ENDOF
             ENDCASE
       REPEAT ; IS expression
    -- ------------------------------------------------------------
    -- Parse and translate an assignment statement
    : assignment ( -- )
       getname LOCAL name
       '=' match
       expression
       name storevariable ;
    -- ------------------------------------------------------------

OK, if you've got all this code inserted, then compile it and check it out. You should be seeing reasonable-looking code, representing a complete program that will assemble and execute. We have a compiler! (chap10i.frt)

## BOOLEANS

The next step should also be familiar to you. We must add Boolean expressions and relational operations. Again, since we've already dealt with them more than once, I won't elaborate much on them, except where they are different from what we've done before. Again, we won't just copy from other files because I've changed a few things just a bit. Most of the changes just involve encapsulating the machine-dependent parts as we did for the arithmetic operations. I've also modified procedure `NotFactor` somewhat, to parallel the structure of `FirstFactor`.

To begin, we're going to need some more recognizers:

    -- ------------------------------------------------------------
    -- Recognize a boolean Orop
    : orop? ( char -- tf ) DUP '|' = SWAP '~' = OR ;
    -- ------------------------------------------------------------
    -- Recognize a relop
    : relop? ( char -- tf )
            DUP  '=' =
            OVER '#' = OR
            OVER '<' = OR
            SWAP '>' = OR ;
    -- ------------------------------------------------------------

All of this gives us the tools we need. The BNF for the Boolean expressions is:

         <bool-expr> ::= <bool-term> ( <orop> <bool-term> )*

         <bool-term> ::= <not-factor> ( <andop> <not-factor> )*

         <not-factor> ::= [ '!' ] <relation>

         <relation> ::= <expression> [ <relop> <expression> ]

Sharp-eyed readers might note that this syntax does not include the non-terminal "bool-factor" used in earlier versions. It was needed then because I also allowed for the Boolean constants TRUE and FALSE. But remember that in `TINY` there is no distinction made between Boolean and arithmetic types ... they can be freely intermixed. So there is really no need for these predefined values ... we can just use -1 and 0, respectively.

In `C` terminology, we could always use the defines:

         #define TRUE -1
         #define FALSE 0

(That is, if `TINY` had a preprocessor.) Later on, when we allow for declarations of constants, these two values will be predefined by the language.

The reason that I'm harping on this is that I've already tried the alternative, which is to include TRUE and FALSE as keywords. The problem with that approach is that it then requires lexical scanning for every variable name in every expression. If you'll recall, I pointed out in Installment VII that this slows the compiler down considerably. As long as keywords can't be in expressions, we need to do the scanning only at the beginning of every new statement ... quite an improvement. So using the syntax above not only simplifies the parsing, but speeds up the scanning as well.

OK, given that we're all satisfied with the syntax above, the corresponding code is shown below:

    -- -------------------------------------------------------------
    -- Recognize and translate a relational "equals"
    : equals ( -- ) '=' match expression _popcmp _sete ;
    -- -------------------------------------------------------------
    -- Recognize and translate a relational "not equals"
    : notequals ( -- ) '#' match expression _popcmp _setne ;
    -- -------------------------------------------------------------
    -- Recognize and translate a relational "less than"
    : less ( -- ) '<' match expression _popcmp _setl ;
    -- -------------------------------------------------------------
    -- Recognize and translate a relational "greater than"
    : greater ( -- ) '>' match expression _popcmp _setg ;
    -- -------------------------------------------------------------
    -- Parse and translate a relation
    : relation ( -- )
       expression
       Look relop? 0= ?EXIT
       _push
       CASE Look
        '=' OF equals    ENDOF
        '#' OF notequals ENDOF
        '<' OF less      ENDOF
        '>' OF greater   ENDOF
       ENDCASE ;
    -- -------------------------------------------------------------
    -- Parse and translate a boolean factor with leading NOT
    : notfactor ( -- )
       Look '!' <> IF  relation  EXIT  ENDIF
       '!' match  relation _not ;
    -- -------------------------------------------------------------
    -- Parse and translate a boolean term
    : boolterm ( -- )
       notfactor
       BEGIN  Look '&' =
       WHILE  _push  '&' match  notfactor  _popand
       REPEAT ;
    -- ------------------------------------------------------------
    -- Recognize and translate a boolean OR
    : boolOR ( -- ) '|' match boolterm _popor ;
    -- ------------------------------------------------------------
    -- Recognize and translate an EXCLUSIVE OR
    : boolXOR ( -- ) '~' match boolterm _popxor ;
    -- ------------------------------------------------------------
    -- Parse and translate a boolean expression
    :NONAME ( -- )
       boolterm
       BEGIN Look orop?
       WHILE _push
             CASE Look
              '|' OF boolor ENDOF
              '~' OF boolxor ENDOF
             ENDCASE
       REPEAT ; IS boolexpression
    -- ------------------------------------------------------------

To tie it all together, don't forget to change the references to `Expression` in procedures `Factor` and `Assignment` so that they call `BoolExpression` instead.

OK, if you've got all that typed in, compile it and give it a whirl (chap10j.frt). First, make sure you can still parse an ordinary arithmetic expression. Then, try a Boolean one. Finally, make sure that you can assign the results of relations. Try, for example:

         pvx,y,zbx=z>ye.

which stands for:

         PROGRAM
         VAR X,Y,Z
         BEGIN
         X = Z > Y
         END.

See how this assigns a Boolean value to X?

## CONTROL STRUCTURES

We're almost home. With Boolean expressions in place, it's a simple matter to add control structures. For `TINY`, we'll only allow two kinds of them, the `IF` and the `WHILE`:

         <if> ::= IF <bool-expression> <block> [ ELSE <block>] ENDIF

         <while> ::= WHILE <bool-expression> <block> ENDWHILE

Once again, let me spell out the decisions implicit in this syntax, which departs strongly from that of `C` or `Pascal`. In both of those languages, the "body" of an `IF` or `WHILE` is regarded as a single statement. If you intend to use a block of more than one statement, you have to build a compound statement using `BEGIN-END` (in `Pascal`) or '{}' (in `C`). In `TINY` (and `KISS`) there is no such thing as a compound statement ... single or multiple they're all just blocks to these languages.

In `KISS`, all the control structures will have explicit and unique keywords bracketing the statement block, so there can be no confusion as to where things begin and end. This is the modern approach, used in such respected languages as `Ada` and `Modula 2`, and it completely eliminates the problem of the "dangling else."

Note that I could have chosen to use the same keyword `END` to end all the constructs, as is done in `Pascal`. (The closing '}' in `C` serves the same purpose.) But this has always led to confusion, which is why `Pascal` programmers tend to write things like

         end { loop }

or

         end { if }

As I explained in Part V, using unique terminal keywords does increase the size of the keyword list and therefore slows down the scanning, but in this case it seems a small price to pay for the added insurance. Better to find the errors at compile time rather than run time.

One last thought: The two constructs above each have the non-terminals

          <bool-expression> and <block>

juxtaposed with no separating keyword. In `Pascal` we would expect the keywords `THEN` and `DO` in these locations.

I have no problem with leaving out these keywords, and the parser has no trouble either, on condition that we make no errors in the bool-expression part. On the other hand, if we were to include these extra keywords we would get yet one more level of insurance at very little cost, and I have no problem with that, either. Use your best judgment as to which way to go.

OK, with that bit of explanation let's proceed. As usual, we're going to need some new code generation routines. We already defined most of them above.

Except for the encapsulation of the code generation, the code to parse the control constructs is the same as you've seen before:

    -- -------------------------------------------------------------
    -- Recognize and translate an IF Construct

    DEFER block ( -- )

    : doIF ( -- )
            0 0 LOCALS| L2 L1 |
            'i' match
            boolexpression
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L1 PACK DROP
            L1 COUNT DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2 PACK DROP
            L1 COUNT _branch0
            block
            Look 'l'  = IF  L2 FREE ?ALLOCATE
                            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2 PACK DROP
                            L2 COUNT _branch
                            L1 COUNT postlabel
                            block
                     ENDIF
            L2 COUNT postlabel
            'e' match
            L1 FREE ?ALLOCATE
            L2 FREE ?ALLOCATE ;
    -- ------------------------------------------------------------
    -- Parse and translate a WHILE Statement
    : doWHILE ( -- )
            0 0 LOCALS| L2 L1 |
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L1 PACK DROP
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2 PACK DROP
            'w' match
            L1 COUNT postlabel
            boolexpression
            L2 COUNT _branch0
            block
            'e' match
            L1 COUNT _branch
            L2 COUNT postlabel
            L1 FREE ?ALLOCATE
            L2 FREE ?ALLOCATE ;
    -- ------------------------------------------------------------

To tie everything together, we need only modify procedure `Block` to recognize the "keywords" for the `IF` and `WHILE`. As usual, we expand the definition of a block like so:

         <block> ::= ( <statement> )*

where

         <statement> ::= <if> | <while> | <assignment>

The corresponding code is:

    -- ------------------------------------------------------------
    -- Parse and translate a block of statements
    :NONAME BEGIN  Look 'e' <>
                   Look 'l' <> AND
            WHILE  CASE Look
                    'i' OF  doIF      ENDOF
                    'w' OF  doWHILE   ENDOF
                            assignment
                   ENDCASE
            REPEAT ; IS block
    -- ------------------------------------------------------------

OK, add the routines I've given, compile and test them (chap10k.frt). You should be able to parse the single-character versions of any of the control constructs. It's looking pretty good!

As a matter of fact, except for the single-character limitation we've got a virtually complete version of `TINY`. I call it, with tongue planted firmly in cheek, `TINY Version 0.1`.

## LEXICAL SCANNING

Of course, you know what's next: We have to convert the program so that it can deal with multi-character keywords, newlines, and whitespace. We have just gone through all that in Part VII. We'll use the distributed scanner technique that I showed you in that installment. The actual implementation is a little different because the way I'm handling newlines is different.

To begin with, let's simply allow for whitespace. This involves only adding calls to `SkipWhite` at the end of the three routines, `GetName`, `GetNum`, and `Match`. A call to `SkipWhite` in `Init` primes the pump in case there are leading spaces.

Next, we need to deal with newlines. This is really a two-step process, since the treatment of the newlines with single-character tokens is different from that for multi-character ones. We can eliminate some work by doing both steps at once, but I feel safer taking things one step at a time.

Insert the new procedure:

    -- ------------------------------------------------------------
    -- Skip over an end-of-line
    : newline ( -- )
       BEGIN Look ^M =
       WHILE getchar
             Look ^J = IF  getchar  ENDIF
             skipwhite
       REPEAT ;
    -- ------------------------------------------------------------

Note that we have seen this procedure before in the form of word `Fin`. I've changed the name since this new one seems more descriptive of the actual function. I've also changed the code to allow for multiple newlines and lines with nothing but white space.

The next step is to insert calls to `NewLine` wherever we decide a newline is permissible. As I've pointed out before, this can be very different in different languages. In `TINY`, I've decided to allow them virtually anywhere. This means that we need calls to `NewLine` at the beginning (not the end, as with `SkipWhite`) of the procedures `GetName`, `GetNum`, and `Match`.

For procedures that have while loops, such as `TopDecl`, we need a call to `NewLine` at the beginning of the procedure and at the bottom of each loop. That way, we can be assured that `NewLine` has just been called at the beginning of each pass through the loop.

If you've got all this done, try the program out and verify that it will indeed handle white space and newlines.

If it does, then we're ready to deal with multi-character tokens and keywords. To begin, add the additional declarations (copied almost verbatim from Part VII):

    -- ------------------------------------------------------------
    -- Type declarations
      8 =: /symbol
    100 =: maxentry
    -- ------------------------------------------------------------
    -- Variable declarations
    0 VALUE token                  -- encoded token
    CREATE token$ 16 CHARS ALLOT   -- unencoded token
    -- ------------------------------------------------------------
    -- Definition of keywords and token types
    -- helper to build symbol tables
    : $, ( c-addr u size -- )
            >S S MIN >R
            R@ C, R@ 0 ?DO  C@+ C,  LOOP DROP
            S> R> - CHARS ALLOT ;
    -- Symboltable builder itself
    : SYMTAB ( size -- )
            CREATE  DUP 0< IF  0 , ABS DUP ,
                               1+ maxentry * ALLOT
                         ELSE  HERE >R
                               0 ,  ( #items )
                               DUP >S ,  ( itemsize )
                               BEGIN  BL <WORD> DUP
                               WHILE  S $, 1 R@ +!
                               REPEAT 2DROP -R -S
                        ENDIF
            DOES>   CELL+ @+ 1+ ROT * + ( ix -- addr ) ;

    /symbol SYMTAB KWlist IF ELSE ENDIF WHILE ENDWHILE VAR BEGIN END PROGRAM

    : KW->token ( kw_index -- ) 2+ C" xilewevbep" + C@ TO token ;
    -- ------------------------------------------------------------

Next, add the three procedures, also from Part VII:

    -- ------------------------------------------------------------
    -- Table Lookup
    : lookup ( c-addr u 'table -- n2 | -1 )
            0 0 LOCALS| /symbol n table sz addr |
            table 2 CELLS - @+ TO n  @ TO /symbol
            n 0<= IF  -1 EXIT  ENDIF
               0 n DO
                      /symbol 1+ I * table + COUNT
                      addr sz COMPARE 0= IF  I UNLOOP EXIT  ENDIF
             -1 +LOOP
            -1 ;
    -- ------------------------------------------------------------
    .
    .
    -- ------------------------------------------------------------
    -- Get an identifier and scan it for keywords
    : scan ( -- ) getname 0 KWlist lookup KW->token ;
    -- ------------------------------------------------------------
    -- Match a specific input string
    : matchstring ( c-addr u -- )
            token$ COUNT 2OVER
            COMPARE IF  &` CHAR-PREPEND &' CHAR-APPEND expected
                  ELSE  2DROP
                 ENDIF ;
    -- ------------------------------------------------------------

Now, we have to make a fairly large number of subtle changes to the remaining procedures. First, we must change the function `GetName` to a procedure, again as we did in Part VII:

    -- ------------------------------------------------------------
    -- Get an identifier
    : getname ( -- c-addr u )
            newline
            Look alpha? 0= IF  S" Name" expected  ENDIF
            token$ C0!
            BEGIN   Look alnum?
            WHILE   Look >UPC token$ char+!  getchar
            REPEAT
            token$ COUNT  skipwhite ;
    -- ------------------------------------------------------------

Note that this word also leaves its result in the global string `token$`.

Next, we have to change every reference to `GetName` to reflect its new form. These occur in `Factor`, `Assignment`, and `Decl`:

    -- -------------------------------------------------------------
    -- Parse and translate a math factor

    DEFER boolexpression ( -- )

    : factor ( -- )
            Look '('  = IF  '(' match  boolexpression  ')' match EXIT  ENDIF
            Look alpha? IF  getname DROP C@ loadvariable         EXIT  ENDIF
            getnum loadconstant ;
    -- ------------------------------------------------------------
    .
    .
    -- ------------------------------------------------------------
    -- Parse and translate an assignment statement
    : assignment ( -- )
            token$ COUNT DUP 1+ ALLOCATE ?ALLOCATE DUP LOCAL name PACK DROP
            '=' match
            boolexpression
            name COUNT DROP C@ storevariable
            name FREE ?ALLOCATE ;
    -- ------------------------------------------------------------
    .
    .
    -- ------------------------------------------------------------
    -- Parse and translate a data declaration
    : decl ( -- )
            getname DROP C@ alloc
            BEGIN  Look ',' =
            WHILE  ',' match  getname DROP C@ alloc
            REPEAT ;
    -- ------------------------------------------------------------

(Note that we're still only allowing single-character variable names, so we take the easy way out here and simply use the first character of the string.)

Finally, we must make the changes to use `Token` instead of `Look` as the test character and to call `Scan` at the appropriate places. Mostly, this involves deleting calls to `Match`, occasionally replacing calls to `Match` by calls to MatchString, and Replacing calls to `NewLine` by calls to `Scan`. Here are the affected routines:

    -- -------------------------------------------------------------
    -- Recognize and translate an IF construct

    DEFER block

    : doIF ( -- )
            0 0 LOCALS| L2 L1 |
            boolexpression
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L1 PACK DROP
            L1 COUNT DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2 PACK DROP
            L1 COUNT _branch0
            block
            token 'l' = IF  L2 FREE ?ALLOCATE
                            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2 PACK DROP
                            L2 COUNT _branch
                            L1 COUNT postlabel
                            block
                     ENDIF
            L2 COUNT postlabel
            S" ENDIF" matchstring

            L1 FREE ?ALLOCATE
            L2 FREE ?ALLOCATE ;
    -- ------------------------------------------------------------
    -- Parse and translate a WHILE statement
    : doWHILE ( -- )
            0 0 LOCALS| L2 L1 |
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L1 PACK DROP
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2 PACK DROP

            L1 COUNT postlabel
            boolexpression
            L2 COUNT _branch0
            block
            L1 COUNT _branch
            L2 COUNT postlabel
            S" ENDWHILE" matchstring

            L1 FREE ?ALLOCATE
            L2 FREE ?ALLOCATE ;
    -- ------------------------------------------------------------
    -- Parse and translate a block of statements
    :NONAME ( label -- )
            LOCAL L
            scan
            BEGIN  token 'e' <>
                   token 'l' <> AND
            WHILE  CASE token
                    'i' OF  doIF      ENDOF
                    'w' OF  doWHILE   ENDOF
                            assignment
                   ENDCASE
                   scan
            REPEAT ; IS block
    -- ------------------------------------------------------------
    -- Parse and Translate Global Declarations
    : topdecls ( -- )
            scan
            BEGIN   token 'b' <>
            WHILE   CASE token
                     'v' OF decl  ENDOF
                         S" Unrecognized keyword "
                         token$ COUNT name.aborts
                    ENDCASE
                    scan
            REPEAT ;
    -- ------------------------------------------------------------
    -- Parse and translate a main program
    : doprogram ( -- )
            S" BEGIN" matchstring
            prolog
            block
            S" END" matchstring
            epilog ;
    -- ------------------------------------------------------------
    -- Parse and translate a program
    : prog ( -- )
            S" PROGRAM" matchstring
            getname prog$ PACK DROP
            header
            topdecls
            doprogram
            '.' match ;
    -- ------------------------------------------------------------
    -- Initialize
    : init ( -- )
            CLEAR Lcount
            ST 26 CHARS ERASE
            CR getchar scan ;
    -- ------------------------------------------------------------

That should do it. If all the changes got in correctly, you should now be parsing programs that look like programs. (If you didn't make it through all the changes, don't despair. A complete listing of the final form is given later.)

Did it work? If so, then we're just about home. In fact, with a few minor exceptions we've already got a compiler that's usable. There are still a few areas that need improvement.

## MULTI-CHARACTER VARIABLE NAMES

One of those is the restriction that we still have, requiring single-character variable names. Now that we can handle multi-character keywords, this one begins to look very much like an arbitrary and unnecessary limitation. And indeed it is. Basically, its only virtue is that it permits a trivially simple implementation of the symbol table. But that's just a convenience to the compiler writers, and needs to be eliminated.

We've done this step before. This time, as usual, I'm doing it a little differently. I think the approach used here keeps things just about as simple as possible.

The natural way to implement a symbol table in `Forth` is by declaring an array of symbol strings. This has the advantage that we can use the existing procedure `Lookup` to search the symbol table as well as the keyword list. As it turns out, even when we need more fields we can still use the same approach, simply by storing the other fields in separate arrays.

OK, here are the changes that need to be made. First, add the new constant:

          0 ST    2 CELLS - =: [cnt]ST
          0 SType 2 CELLS - =: [cnt]SType

Then change the definition of the symbol table as follows:

    100 =: maxentry
    .
    .
    /symbol  NEGATE SYMTAB ST
    =CELL 1- NEGATE SYMTAB SType

(The NEGATE prevents initializing the symbol table from the input stream.)

Next, we need to replace `InTable`:

    -- ------------------------------------------------------------
    -- Look for symbol in table
    : intable ( c-addr u -- tf ) 0 ST lookup 0>= ;
    -- ------------------------------------------------------------

We also need a new procedure, `AddEntry`, that adds a new entry to the table:

    -- ------------------------------------------------------------
    -- Add a new entry to the symbol table
    : addentry ( c-addr u type -- )
            [cnt]ST LOCALS| #entries T sz addr |
            addr sz intable IF  S" Duplicate identifier " addr sz name.aborts  ENDIF
            #entries @ maxentry = IF  S" Symbol table full" aborts  ENDIF
            1 #entries +!
            addr sz  #entries @ ST    PACK DROP
            T        #entries @ SType C! ;
    -- ------------------------------------------------------------

This procedure is called by `Alloc`:

    -- ------------------------------------------------------------
    -- Allocate storage for a variable
    : alloc ( c-addr u -- )
            LOCALS| sz addr |
            addr sz intable IF  S" Duplicate variable name "
                                addr sz name.aborts
                         ENDIF
            addr sz 'v' addentry
    .
    .
    .
    -- ------------------------------------------------------------

Finally, we must change all the routines that currently treat the variable name as a single character. These include `LoadVariable`, `StoreVariable`, and `Factor`, `Assignment`, and `Decl` (change `token$ CHAR+ C@` to `token$ COUNT` ).

One last thing: change procedure `Init` to clear the array as shown:

    -- ------------------------------------------------------------
    -- Initialize
    : init ( -- )
            CLEAR Lcount
            [cnt]ST    OFF
            [cnt]SType OFF
            CR getchar scan ;
    -- ------------------------------------------------------------

That should do it. Try it out and verify that you can, indeed, use multi-character variable names.

## MORE RELOPS

We still have one remaining single-character restriction: the one on relops. Some of the relops are indeed single characters, but others require two. These are '<=' and '>='. I also prefer the `Pascal` '<>' for "not equals," instead of '#'.

If you'll recall, in Part VII I pointed out that the conventional way to deal with relops is to include them in the list of keywords, and let the lexical scanner find them. But, again, this requires scanning throughout the expression parsing process, whereas so far we've been able to limit the use of the scanner to the beginning of a statement.

I mentioned then that we can still get away with this, since the multi-character relops are so few and so limited in their usage. It's easy to just treat them as special cases and handle them in an ad hoc manner.

The changes required affect only the code generation routines and procedures `Relation` and friends.

Modify the relation parsing routines as shown below:

    -- -------------------------------------------------------------
    -- Recognize and translate a relational "less than or equal"
    : lessorequal ( -- )  '=' match  expression _popcmp _setle ;
    -- -------------------------------------------------------------
    -- Recognize and Translate a Relational "Not Equals"
    : notequals   ( -- )  '>' match  expression _popcmp _setne ;
    -- -------------------------------------------------------------
    -- recognize and translate a relational "less than"
    : less ( -- )
            '<' match
            Look '=' = IF  lessorequal EXIT  ENDIF
            Look '>' = IF  notequals   EXIT  ENDIF
            expression _popcmp _setl ;
    -- -------------------------------------------------------------
    -- recognize and translate a relational "greater than"
    : greater ( -- )
            '>' match
            Look '=' = IF   '=' match expression _popcmp _setge
                            EXIT
                    ENDIF
            expression _popcmp _setg ;
    -- -------------------------------------------------------------

That's all it takes. Now you can process all the relops. Try it.

## INPUT/OUTPUT

We now have a complete, working language, except for one minor embarassment: we have no way to get data in or out. We need some I/O.

Now, the convention these days, established in `C` and continued in `Ada` and `Modula 2`, is to leave I/O statements out of the language itself, and just include them in the subroutine library. That would be fine, except that so far we have no provision for subroutines. Anyhow, with this approach you run into the problem of variable-length argument lists. In `Pascal`, the I/O statements are built into the language because they are the only ones for which the argument list can have a variable number of entries. In `C`, we settle for kludges like scanf and printf, and must pass the argument count to the called procedure. In `Ada` and `Modula 2` we must use the awkward (and slow!) approach of a separate call for each argument.

So I think I prefer the `Pascal` approach of building the I/O in, even though we don't need to.

As usual, for this we need some more code generation routines. These turn out to be the easiest of all, because all we do is to call library procedures to do the work:

    -- -------------------------------------------------------------
    -- read to primary register and store in variable
    : readvar  ( c-addr u -- ) S" READ" callfunction  storevariable ;
    -- -------------------------------------------------------------
    -- write from primary register
    : writevar ( -- ) S" WRITE" callfunction ;

The idea is that `READ` loads the value from input to EAX, and WRITE outputs it from there.

These two words represent our first encounter with a need for library procedures ... the components of a Run Time Library (RTL). Of course, someone (namely us) has to write these routines, but they're not part of the compiler itself. I won't even bother showing the routines here, since these are obviously very much OS-dependent. I will simply say that for Windows XP, they are not particularly simple.. One reason I won't show them here is that you can add all kinds of fanciness to the things, for example by prompting in `READ` for the inputs, and by giving the user a chance to reenter a bad input.

But that is really separate from compiler design, so for now I'll just assume that a library call TINYLIB.LIB exists. Since we now need it loaded, we need to add a statement to include it in procedure Header:

    -- ------------------------------------------------------------
    -- Write header info
    : header ( -- )
            S" -- DATA section --------" emitdln
            S" NEEDS -tinylib" emitdln
            S" " emitdln ;
    -- ------------------------------------------------------------

That takes care of that part. Now, we also need to recognize the read and write commands. We can do this by adding two more keywords to our list:

    -- ------------------------------------------------------------
    -- Definition of keywords and token types
    /symbol SYMTAB KWlist IF ELSE ENDIF WHILE ENDWHILE READ WRITE VAR BEGIN END PROGRAM

    : KW->token ( kw_index -- ) 2+ C" xileweRWvbep" + C@ TO token ;
    -- ------------------------------------------------------------

(Note how I'm using upper case codes here to avoid conflict with the 'w' of `WHILE`.)

Next, we need procedures for processing the read/write statement and its argument list:

    -- ------------------------------------------------------------
    -- Process a read statement
    : doread ( -- )
            '(' match
            getname readvar
            BEGIN  Look ',' =
            WHILE  ',' match getname readvar
            REPEAT
            ')' match ;
    -- -------------------------------------------------------------
    -- Process a write statement
    : dowrite ( -- )
            '(' match
            expression writevar
            BEGIN  Look ',' =
            WHILE  ',' match expression writevar
            REPEAT
            ')' match ;
    -- ------------------------------------------------------------

Finally, we must expand procedure `Block` to handle the new statement types:

    -- ------------------------------------------------------------
    -- Parse and translate a block of statements
    :NONAME ( -- )
            scan
            BEGIN  token 'e' <>
                   token 'l' <> AND
            WHILE  CASE token
                    'i' OF  doIF      ENDOF
                    'w' OF  doWHILE   ENDOF
                    'R' OF  doread    ENDOF
                    'W' OF  dowrite   ENDOF
                            assignment
                   ENDCASE
                   scan
            REPEAT ; IS block
    -- ------------------------------------------------------------

That's all there is to it. Now we have a language!

## CONCLUSION

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 (tiny10.frt):

    -- Variable declarations --------------------------------------------------------------------------------------------------

    -1 =: unknown

    0 VALUE Lcount                          -- label counter
    0 VALUE Look                            -- lookahead character
    0 VALUE token                           -- encoded token

    #100 =: maxentry

    CREATE token$  0 C, #256 CHARS ALLOT    -- unencoded token
    CREATE prog$   0 C, #256 CHARS ALLOT    -- program name

    -- Symbol tables and Labels ----------------------------------------------------------------------------------------------------------

    -- helper to build symbol tables
    : $, ( c-addr u size -- )
            >S S MIN >R
            R@ C, R@ 0 ?DO  C@+ C,  LOOP DROP
            S> R> - CHARS ALLOT ;

    -- Type declarations
    : SYMTAB ( size -- )
            CREATE  DUP 0< IF  0 , ABS DUP ,
                               1+ maxentry * ALLOT
                         ELSE  HERE >R
                               0 ,  ( #items )
                               DUP >S ,  ( itemsize )
                               BEGIN  BL <WORD> DUP
                               WHILE  2DUP S" \" COMPARE
                                      0= IF  2DROP REFILL DROP
                                       ELSE  S $, 1 R@ +!
                                      ENDIF
                               REPEAT 2DROP -R -S
                        ENDIF
            DOES>   CELL+ @+ 1+ ROT * + ( ix -- addr ) ;

    -- Definition of keywords and token types

    8 CHARS =: /symbol

    /symbol SYMTAB KWlist   IF ELSE ENDIF   \
                            WHILE ENDWHILE  \
                            DO ENDDO        \
                            LOOP ENDLOOP    \
                            REPEAT UNTIL    \
                            FOR TO ENDFOR   \
                            BREAK           \
                            READ WRITE      \
                            VAR BEGIN END PROGRAM

    : KW->token ( kw_index -- ) 2+ C" xilewedeLerufteBRWvbep" + C@ TO token ;

            /symbol  NEGATE SYMTAB ST
            =CELL 1- NEGATE SYMTAB SType

    0 ST    2 CELLS - =: [cnt]ST
    0 SType 2 CELLS - =: [cnt]SType

    : lookup ( c-addr u 'table -- n2|unknown )
            0 0 LOCALS| /symbol n table sz addr |
            table 2 CELLS - @+ TO n  @ TO /symbol
            n 0<= IF  unknown EXIT  ENDIF
               0 n DO
                      /symbol 1+ I * table + COUNT
                      addr sz COMPARE 0= IF  I UNLOOP EXIT  ENDIF
             -1 +LOOP
            unknown ;

    -- Locate a symbol in table
    -- Returns the index of the entry.  (unknown) -1 if not present.
    : locate ( c-addr u -- ix ) 0 ST lookup ;

    -- Look for symbol in table
    : intable ( c-addr u -- tf )
            0 ST lookup 0>= ;

    -- Dump the symbol tabel
    : .symbols ( -- )
            [cnt]ST @ 0= IF  CR ." No symbols defined." EXIT  ENDIF
            CR ." -- type --.-------- name ---------"
            CR
            [cnt]ST @ 0 ?DO  CR   2 HTAB   I 1+ SType C@ EMIT
                                  #14 HTAB I 1+ ST    .$
                       LOOP ;

    -- Tools ------------------------------------------------------------------------------------------------------------------

    : getchar  ( -- )          EKEY TO Look ;                       -- read new character from input stream
    : error    ( c-addr u -- ) CR ^G EMIT ." Error: " TYPE ." ." ;  -- report an error
    : aborts   ( c-addr u -- ) error ABORT ;                        -- report error and halt
    : expected ( c-addr u -- ) S"  Expected" $+ aborts ;            -- report what was expected
    : alpha?   ( char -- tf )  >UPC 'A' 'Z' 1+ WITHIN ;             -- recognize an alpha character
    : digit?   ( char -- tf )  '0' '9' 1+ WITHIN ;                  -- recognize a decimal digit
    : alnum?   ( char -- tf )  DUP alpha? SWAP digit? OR ;          -- recognize alphanumeric
    : white?   ( char -- tf )  DUP Tab =  SWAP BL  =  OR ;          -- recognize white space
    : orop?    ( char -- tf )  DUP '|' =  SWAP '~' =  OR ;          -- recognize an OR operand
    : addop?   ( char -- tf )  DUP '+' =  SWAP '-' =  OR ;          -- test for AddOp
    : mulop?   ( char -- tf )  DUP '*' =  SWAP '/' =  OR ;          -- test for MulOp
    : emits    ( c-addr u -- ) Tab EMIT TYPE ;                      -- output a string with tab
    : emitdln  ( c-addr u -- ) CR TYPE ;                            -- output a string without tab, +crlf
    : emitln   ( c-addr u -- ) CR emits ;                           -- output a string with tab and crlf

    -- abort, reporting offending item
    : name.aborts ( c-addr1 u1 c-addr2 u2 )
            &` CHAR-PREPEND &' CHAR-APPEND $+ aborts ;

    : .undefined ( c-addr u -- )
            S" Undefined identifier " 2SWAP name.aborts ;

    -- generate a unique label
    : newlabel ( -- c-addr u ) S" @" Lcount U>D <# #S #> $+  1 +TO Lcount ;

    -- post a label to output
    : postlabel ( c-addr u -- ) CR TYPE ':' EMIT ;

    -- Recognize a relop
    : relop? ( char -- tf )
            DUP  '=' =
            OVER '#' = OR
            OVER '<' = OR
            SWAP '>' = OR ;

    : char+!   ( c addr -- )   DUP >S COUNT + C!  1 S> C+! ;

    -- skip white space
    : skipwhite ( -- )
            BEGIN  Look white?
            WHILE  getchar
            REPEAT ;

    -- skip cr+lf
    : fin ( -- )
            Look ^M = IF getchar ENDIF
            Look ^J = IF getchar ENDIF
            skipwhite ;

    : newline ( -- ) BEGIN  Look ^M = WHILE  fin  REPEAT ;

    -- match a specific input character
    : match ( char -- )
            DUP Look = IF  DROP getchar skipwhite
                     ELSE  S" `" ROT CHAR-APPEND &' CHAR-APPEND expected
                    ENDIF ;

    -- get an identifier.
    : getname ( -- c-addr u )
            newline
            Look alpha? 0= IF  S" Name" expected  ENDIF
            token$ C0!
            BEGIN   Look alnum?
            WHILE   Look >UPC token$ char+!  getchar
            REPEAT
            token$ COUNT  skipwhite ;

    -- get a number
    : getnum ( -- val )
            newline
            Look digit? 0= IF  S" Integer" expected  ENDIF
            0 >R
            BEGIN   Look digit?
            WHILE   R> #10 *  Look '0' - +  >R
                    getchar
            REPEAT  '#' TO token
            R>  skipwhite ;

    -- Get an identifier and scan it for keywords
    : scan ( -- ) getname 0 KWlist lookup KW->token ;

    -- Add a new entry to symbol table
    : addentry ( c-addr u type -- )
            [cnt]ST LOCALS| #entries T sz addr |
            addr sz intable IF  S" Duplicate identifier " addr sz name.aborts  ENDIF
            #entries @ maxentry = IF  S" Symbol table full" aborts  ENDIF
            1 #entries +!
            addr sz  #entries @ ST  PACK DROP
            T #entries @ SType C! ;

    -- Match a specific input string
    : matchstring ( c-addr u -- )
            token$ COUNT 2OVER
            COMPARE IF  &` CHAR-PREPEND &' CHAR-APPEND expected
                  ELSE  2DROP
                 ENDIF ;

    -- Code generation -------------------------------------------------------------------------------------------------------

    -- Load/store primary register with a constant/variable
    : loadconstant  ( u -- ) (.) S"  d# -> eax  mov," $+ emitln ;

    : loadvariable  ( c-addr u -- )
            2DUP intable 0= IF  .undefined  ENDIF
            S"  dword-ptr -> eax  mov," $+ emitln ;

    : storevariable ( c-addr u -- )
            2DUP intable 0= IF  .undefined  ENDIF
            S" eax -> " 2SWAP $+ S"  dword-ptr  mov," $+ emitln ;

    -- Allocate storage for a static variable
    : allocatestorage ( c-addr1 u1 c-addr2 u2 -- )
            S" CREATE " 2ROT $+ BL CHAR-APPEND 2SWAP $+ S"  , " $+ emitdln ;

    : callfunction  ( c-addr u -- ) S"  offset NEAR call," $+ emitln ;              -- call a function

    : _negate ( -- ) S" eax  neg,"   emitln ;                                       -- negate primary
    : _not    ( -- ) S" eax  not,"   emitln ;                                       -- not primary
    : _push   ( -- ) S" eax  push,"  emitln ;                                       -- push primary to stack
    : _pop    ( -- ) S" eax  pop,"   emitln ;                                       -- pop primary from stack
    : _decr   ( -- ) S" 1 b# -> eax sub," emitln ;                                  -- decrement primary
    : _incr   ( -- ) S" 1 b# -> eax add," emitln ;                                  -- increment primary
    : _decSP  ( -- ) S" [esp -4 +] -> esp lea," emitln ;                            -- drop 1 stack item
    : _incSP  ( -- ) S" [esp  4 +] -> esp lea," emitln ;                            -- restore stack item
    : _popadd ( -- ) S" [esp] -> eax  add,  [esp 4 +] -> esp lea," emitln ;         -- add TOS to primary
    : _popsub ( -- ) S" [esp] -> eax  sub,  [esp 4 +] -> esp lea," emitln _negate ; -- subtract TOS from primary
    : _popor  ( -- ) S" [esp] -> eax  or,   [esp 4 +] -> esp lea," emitln ;         -- or TOS to primary
    : _popxor ( -- ) S" [esp] -> eax  xor,  [esp 4 +] -> esp lea," emitln ;         -- xor TOS to primary
    : _popand ( -- ) S" [esp] -> eax  and,  [esp 4 +] -> esp lea," emitln ;         -- xor TOS to primary
    : _popcmp ( -- ) S" [esp] -> eax  cmp,  [esp 4 +] -> esp lea," emitln ;         -- compare TOS to primary
    : _sete   ( -- ) S" al  sete,   al -> eax  movsx," emitln ;                     -- set primary if equal
    : _setne  ( -- ) S" al  setne,  al -> eax  movsx," emitln ;                     -- set primary if NOT equal
    : _setg   ( -- ) S" al  setl,   al -> eax  movsx," emitln ;                     -- set primary if greater
    : _setl   ( -- ) S" al  setg,   al -> eax  movsx," emitln ;                     -- set primary if less
    : _setge  ( -- ) S" al  setle,  al -> eax  movsx," emitln ;                     -- set primary if greater or equal
    : _setle  ( -- ) S" al  setge,  al -> eax  movsx," emitln ;                     -- set primary if less or equal

    -- jump always; jump if eax 0
    : _branch    ( c-addr u -- ) S"  offset NEAR  jmp," $+ emitln ;
    : _pcmp+b0>  ( c-addr u -- ) _popcmp S"  offset NEAR  jg,"  $+ emitln ;
    : _branch0   ( c-addr u -- ) S" eax -> eax or,  " 2SWAP $+ S"  offset NEAR  je,"  $+ emitln ;
    : _branch<>0 ( c-addr u -- ) S" eax -> eax or,  " 2SWAP $+ S"  offset NEAR  jnz," $+ emitln ;

    -- multiply TOS and primary; divide primary by TOS
    : _popmul ( -- ) S" [esp] dword mul, [esp 4 +] -> esp lea," emitln ;
    : _popdiv ( -- ) S" ecx pop, ecx -> eax xchg, eax -> edx mov, #31 b# -> edx sar, ebx idiv," emitln ;

    -- read to primary register and store in variable
    : readvar  ( c-addr u -- ) S" READ" callfunction  storevariable ;

    -- write from primary register
    : writevar ( -- ) S" WRITE" callfunction ;

    -- Write assembler header info; epilogue, and prologue
    : header ( -- )
            S" -- DATA section --------" emitdln
            S" " emitdln ;

    : prolog ( -- )
            S" " emitln
            S" -- CODE section --------" emitdln
            S" "          emitdln
            S" CODE " prog$ COUNT $+ emitdln
            S" rpush,"    emitln
            newlabel postlabel ;

    : epilog ( -- )
            S" rpop,  ebx jmp," emitln
            S" END-CODE"        emitdln ;

    -- Expressions -----------------------------------------------------------------------------------------------------------

    -- parse and translate an identifier.
    -- Note that we need to store getname locally because parsing a call's
    -- parameterlist may clobber it.
    : ident ( -- )
            getname DUP 1+ ALLOCATE ?ALLOCATE DUP LOCAL name PACK DROP
            Look '(' = IF   '(' match ')' match
                            name COUNT callfunction
                     ELSE   name COUNT loadvariable
                    ENDIF
            name FREE ?ALLOCATE ;

    DEFER expression
    DEFER boolexpression

    -- parse and translate a math factor
    : factor ( -- )
            Look '('  = IF  '(' match  boolexpression  ')' match EXIT  ENDIF
            Look alpha? IF  getname loadvariable  EXIT  ENDIF
            getnum loadconstant ;

    -- parse and translate the first math factor
    : signedfactor ( -- )
            Look '+'  = IF  getchar       ENDIF
            Look '-' <> IF  factor  EXIT  ENDIF
            getchar skipwhite
            Look digit? IF  getnum NEGATE loadconstant
                      ELSE  factor _negate
                     ENDIF ;

    -- recognize and translate multiply / divide
    : multiply  ( -- ) '*' match  factor _popmul ;
    : divide    ( -- ) '/' match  factor _popdiv ;

    -- parse and translate a math term
    : term ( -- )
            signedfactor
            BEGIN Look mulop?
            WHILE   _push
                    CASE Look
                      '*' OF multiply  ENDOF
                      '/' OF divide    ENDOF
                             S" Mulop" expected
                    ENDCASE
            REPEAT ;

    -- recognize and translate add / subtract
    : add       ( -- ) '+' match  term   _popadd ;
    : subtract  ( -- ) '-' match  term   _popsub ;

    -- parse and translate an expression
    :NONAME ( -- )
            term
            BEGIN   Look addop?
            WHILE   _push
                    CASE Look
                      '+' OF add      ENDOF
                      '-' OF subtract ENDOF
                             S" Addop" expected
                    ENDCASE
            REPEAT ; IS expression

    -- recognize and translate a relational "equals"
    : equals      ( -- )  '=' match  expression _popcmp _sete ;

    -- recognize and translate a relational "less or equal"
    : lessorequal ( -- )  '=' match  expression _popcmp _setle ;

    -- recognize and translate a relational "not equals"
    : notequals   ( -- )  '>' match  expression _popcmp _setne ;

    -- recognize and translate a relational "less than"
    : less ( -- )
            '<' match
            Look '=' = IF  lessorequal EXIT  ENDIF
            Look '>' = IF  notequals   EXIT  ENDIF
            expression _popcmp _setl ;

    -- recognize and translate a relational "greater than"
    : greater ( -- )
            '>' match
            Look '=' = IF  '=' match expression _popcmp _setge EXIT  ENDIF
            expression _popcmp _setg ;

    -- parse and translate a relation
    : relation ( -- )
            expression
            Look relop? 0= ?EXIT
            _push
            CASE Look
              '=' OF  equals     ENDOF
              '<' OF  less       ENDOF
              '>' OF  greater    ENDOF
            ENDCASE ;

    -- parse and translate a boolean factor with NOT
    : notfactor ( -- )
            Look '!' <> IF  relation EXIT  ENDIF
            '!' match  relation _not ;

    -- parse and translate a boolean term
    : boolterm ( -- )
            notfactor
            BEGIN   Look '&' =
            WHILE   _push  '&' match  notfactor _popand
            REPEAT ;

    -- Recognize and translate a boolean OR
    : boolOR ( -- )  '|' match boolterm _popor ;

    -- Recognize and translate an EXCLUSIVE OR
    : boolXOR ( -- ) '~' match boolterm _popxor ;

    -- Parse and translate a boolean expression
    :NONAME ( -- )
            boolterm
            BEGIN   Look orop?
            WHILE   _push
                    CASE Look
                      '|' OF  boolOR  ENDOF
                      '~' OF  boolXOR ENDOF
                    ENDCASE
            REPEAT ; IS boolexpression

    -- Block statements -------------------------------------------------------------------------------------------------------

    DEFER block

    -- Parse and translate an assignment statement
    : assignment ( -- )
            token$ COUNT DUP 1+ ALLOCATE ?ALLOCATE DUP LOCAL name PACK DROP
            '=' match
            boolexpression
            name COUNT storevariable
            name FREE ?ALLOCATE ;

    -- Recognize and translate an IF construct
    : doIF ( label -- )
            0 0 LOCALS| L2 L1 L |
            boolexpression
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L1 PACK DROP
            L1 COUNT DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2 PACK DROP
            L1 COUNT _branch0
            L block
            token 'l' = IF  L2 FREE ?ALLOCATE
                            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2 PACK DROP
                            L2 COUNT _branch
                            L1 COUNT postlabel
                            L block
                     ENDIF
            L2 COUNT postlabel
            S" ENDIF" matchstring

            L1 FREE ?ALLOCATE
            L2 FREE ?ALLOCATE ;

    : doWHILE ( -- )
            0 0 LOCALS| L2 L1 |
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L1 PACK DROP
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2 PACK DROP

            L1 COUNT postlabel
            boolexpression
            L2 COUNT _branch0
            L2 block
            L1 COUNT _branch
            L2 COUNT postlabel
            S" ENDWHILE" matchstring

            L1 FREE ?ALLOCATE
            L2 FREE ?ALLOCATE ;

    -- Parse and translate a loop statement
    : doLOOP ( -- )
            0 0 LOCALS| L2 L1 |
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L1 PACK DROP
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2 PACK DROP

            L1 COUNT postlabel
            L2 block
            L1 COUNT _branch
            L2 COUNT postlabel
            S" ENDLOOP" matchstring

            L1 FREE ?ALLOCATE
            L2 FREE ?ALLOCATE ;

    -- Parse and translate a REPEAT statement
    : doREPEAT ( -- )
            0 0 LOCALS| L2 L1 |
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L1 PACK DROP
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2 PACK DROP

            L1 COUNT postlabel
            L2 block
            S" UNTIL" matchstring
            boolexpression
            L1 COUNT _branch0
            L2 COUNT postlabel

            L1 FREE ?ALLOCATE
            L2 FREE ?ALLOCATE ;

    -- Parse and translate a for statement
    : doFOR ( -- )
            0 0 0 LOCALS| name L2 L1 |
            getname  DUP 1+ ALLOCATE ?ALLOCATE DUP TO name PACK DROP
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L1   PACK DROP
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2   PACK DROP

            '=' match  expression
            _decr
            name COUNT storevariable
            scan S" TO" matchstring  expression
            _push
            L1 COUNT postlabel
            name COUNT loadvariable
            _incr
            name COUNT storevariable
            L2 COUNT _pcmp+b0>
            L2 block
            L1 COUNT _branch
            L2 COUNT postlabel
            S" ENDFOR" matchstring
            _incSP

            name FREE ?ALLOCATE
            L1   FREE ?ALLOCATE
            L2   FREE ?ALLOCATE ;

    -- Parse and Translate a DO Statement
    : doDO ( -- )
            0 0 LOCALS| L2 L1 |
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L1 PACK DROP
            newlabel DUP 1+ ALLOCATE ?ALLOCATE DUP TO L2 PACK DROP

            expression
            L1 COUNT postlabel
            _push
            L2 block
            _pop
            _decr
            L1 COUNT _branch<>0
            _decSP
            L2 COUNT postlabel
            S" ENDDO" matchstring
            _incSP

            L1 FREE ?ALLOCATE
            L2 FREE ?ALLOCATE ;

    -- Recognize and translate a BREAK
    : doBREAK ( label -- )
            DUP C@ 0= IF  S" No loop to break from" aborts  ENDIF
            COUNT _branch ;

    -- Process a read statement
    : doread ( -- )
            '(' match
            getname readvar
            BEGIN  Look ',' =
            WHILE  ',' match getname readvar
            REPEAT
            ')' match ;

    -- Process a write statement
    : dowrite ( -- )
            '(' match
            expression writevar
            BEGIN  Look ',' =
            WHILE  ',' match expression writevar
            REPEAT
            ')' match ;

    -- Recognize and translate a statement block
    :NONAME ( label -- )
            LOCAL L
            scan
            BEGIN  token 'e' <>
                   token 'l' <> AND
                   token 'u' <> AND
            WHILE  CASE token
                    'i' OF  L doIF    ENDOF
                    'w' OF  doWHILE   ENDOF
                    'd' OF  doDO      ENDOF
                    'L' OF  doLOOP    ENDOF
                    'r' OF  doREPEAT  ENDOF
                    'f' OF  doFOR     ENDOF
                    'B' OF  L doBREAK ENDOF
                    'R' OF  doread    ENDOF
                    'W' OF  dowrite   ENDOF
                            assignment
                   ENDCASE
                   scan
            REPEAT ; IS block

    -- Declarations -----------------------------------------------------------------------------------------------------------

    -- Allocate storage for a variable
    : alloc ( c-addr u -- )
            LOCALS| sz addr |
            addr sz intable IF  S" Duplicate variable name " addr sz name.aborts  ENDIF
            addr sz 'v' addentry
            addr sz
            Look '=' = IF   '=' match
                            Look '-' = IF   '-' match
                                            S" -"
                                     ELSE   S" "
                                    ENDIF
                            getnum (.) $+
                     ELSE   S" 0"
                    ENDIF   allocatestorage ;

    -- Parse and translate a data declaration
    : decl ( -- )
            getname alloc
            BEGIN  Look ',' =
            WHILE  ',' match  getname alloc
            REPEAT ;

    -- Parse and translate the global declarations
    : topdecls ( -- )
            scan
            BEGIN   token 'b' <>
            WHILE   CASE token
                     'v' OF decl  ENDOF
                         S" Unrecognized keyword " token$ COUNT name.aborts
                    ENDCASE
                    scan
            REPEAT ;

    -- Parse and translate MAIN code
    : doprogram ( -- )
            S" BEGIN" matchstring
            prolog
            C" " block
            S" END" matchstring
            epilog ;

    -- Parse and translate a program ------------------------------------------------------------------------------------------
    : prog ( -- )
            S" PROGRAM" matchstring
            getname prog$ PACK DROP
            header
            topdecls
            doprogram
            '.' match ;

    -- initialize
    : init ( -- )
            CLEAR Lcount
            [cnt]ST    OFF
            [cnt]SType OFF
            CR getchar scan ;

    : TINY10 ( -- )
            init prog
            Look ^M <> IF  S" Unexpected data after " S" ." name.aborts  ENDIF ;

    *****************************************************************
    *                                                               *
    *                        COPYRIGHT NOTICE                       *
    *                                                               *
    *   Copyright (C) 1989 Jack W. Crenshaw. All rights reserved.   *
    *                                                               *
    *****************************************************************