1742 lines
41 KiB
Plaintext
1742 lines
41 KiB
Plaintext
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
LET'S BUILD A COMPILER!
|
|
|
|
By
|
|
|
|
Jack W. Crenshaw, Ph.D.
|
|
|
|
3 June 1989
|
|
|
|
|
|
Part XI: LEXICAL SCAN REVISITED
|
|
|
|
|
|
*****************************************************************
|
|
* *
|
|
* COPYRIGHT NOTICE *
|
|
* *
|
|
* Copyright (C) 1989 Jack W. Crenshaw. All rights reserved. *
|
|
* *
|
|
*****************************************************************
|
|
|
|
|
|
INTRODUCTION
|
|
|
|
I've got some good news and some bad news. The bad news is that
|
|
this installment is not the one I promised last time. What's
|
|
more, the one after this one won't be, either.
|
|
|
|
The good news is the reason for this installment: I've found a
|
|
way to simplify and improve the lexical scanning part of the
|
|
compiler. Let me explain.
|
|
|
|
|
|
BACKGROUND
|
|
|
|
If you'll remember, we talked at length about the subject of
|
|
lexical scanners in Part VII, and I left you with a design for a
|
|
distributed scanner that I felt was about as simple as I could
|
|
make it ... more than most that I've seen elsewhere. We used
|
|
that idea in Part X. The compiler structure that resulted was
|
|
simple, and it got the job done.
|
|
|
|
Recently, though, I've begun to have problems, and they're the
|
|
kind that send a message that you might be doing something wrong.
|
|
|
|
The whole thing came to a head when I tried to address the issue
|
|
of semicolons. Several people have asked me about them, and
|
|
whether or not KISS will have them separating the statements. My
|
|
intention has been NOT to use semicolons, simply because I don't
|
|
like them and, as you can see, they have not proved necessary.
|
|
|
|
But I know that many of you, like me, have gotten used to them,
|
|
and so I set out to write a short installment to show you how
|
|
they could easily be added, if you were so inclined.
|
|
|
|
Well, it turned out that they weren't easy to add at all. In
|
|
fact it was darned difficult.
|
|
|
|
I guess I should have realized that something was wrong, because
|
|
of the issue of newlines. In the last couple of installments
|
|
we've addressed that issue, and I've shown you how to deal with
|
|
newlines with a procedure called, appropriately enough, NewLine.
|
|
In TINY Version 1.0, I sprinkled calls to this procedure in
|
|
strategic spots in the code.
|
|
|
|
It seems that every time I've addressed the issue of newlines,
|
|
though, I've found it to be tricky, and the resulting parser
|
|
turned out to be quite fragile ... one addition or deletion here
|
|
or there and things tended to go to pot. Looking back on it, I
|
|
realize that there was a message in this that I just wasn't
|
|
paying attention to.
|
|
|
|
When I tried to add semicolons on top of the newlines, that was
|
|
the last straw. I ended up with much too complex a solution. I
|
|
began to realize that something fundamental had to change.
|
|
|
|
So, in a way this installment will cause us to backtrack a bit
|
|
and revisit the issue of scanning all over again. Sorry about
|
|
that. That's the price you pay for watching me do this in real
|
|
time. But the new version is definitely an improvement, and will
|
|
serve us well for what is to come.
|
|
|
|
As I said, the scanner we used in Part X was about as simple as
|
|
one can get. But anything can be improved. The new scanner is
|
|
more like the classical scanner, and not as simple as before.
|
|
But the overall compiler structure is even simpler than before.
|
|
It's also more robust, and easier to add to and/or modify. I
|
|
think that's worth the time spent in this digression. So in this
|
|
installment, I'll be showing you the new structure. No doubt
|
|
you'll be happy to know that, while the changes affect many
|
|
procedures, they aren't very profound and so we lose very little
|
|
of what's been done so far.
|
|
|
|
Ironically, the new scanner is much more conventional than the
|
|
old one, and is very much like the more generic scanner I showed
|
|
you earlier in Part VII. Then I started trying to get clever,
|
|
and I almost clevered myself clean out of business. You'd think
|
|
one day I'd learn: K-I-S-S!
|
|
|
|
|
|
THE PROBLEM
|
|
|
|
The problem begins to show itself in procedure Block, which I've
|
|
reproduced below:
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Parse and Translate a Block of Statements }
|
|
|
|
procedure Block;
|
|
begin
|
|
Scan;
|
|
while not(Token in ['e', 'l']) do begin
|
|
case Token of
|
|
'i': DoIf;
|
|
'w': DoWhile;
|
|
'R': DoRead;
|
|
'W': DoWrite;
|
|
else Assignment;
|
|
end;
|
|
Scan;
|
|
end;
|
|
end;
|
|
{--------------------------------------------------------------}
|
|
|
|
|
|
As you can see, Block is oriented to individual program
|
|
statements. At each pass through the loop, we know that we are
|
|
at the beginning of a statement. We exit the block when we have
|
|
scanned an END or an ELSE.
|
|
|
|
But suppose that we see a semicolon instead. The procedure as
|
|
it's shown above can't handle that, because procedure Scan only
|
|
expects and can only accept tokens that begin with a letter.
|
|
|
|
I tinkered around for quite awhile to come up with a fix. I
|
|
found many possible approaches, but none were very satisfying. I
|
|
finally figured out the reason.
|
|
|
|
Recall that when we started with our single-character parsers, we
|
|
adopted a convention that the lookahead character would always be
|
|
prefetched. That is, we would have the character that
|
|
corresponds to our current position in the input stream fetched
|
|
into the global character Look, so that we could examine it as
|
|
many times as needed. The rule we adopted was that EVERY
|
|
recognizer, if it found its target token, would advance Look to
|
|
the next character in the input stream.
|
|
|
|
That simple and fixed convention served us very well when we had
|
|
single-character tokens, and it still does. It would make a lot
|
|
of sense to apply the same rule to multi-character tokens.
|
|
|
|
But when we got into lexical scanning, I began to violate that
|
|
simple rule. The scanner of Part X did indeed advance to the
|
|
next token if it found an identifier or keyword, but it DIDN'T do
|
|
that if it found a carriage return, a whitespace character, or an
|
|
operator.
|
|
|
|
Now, that sort of mixed-mode operation gets us into deep trouble
|
|
in procedure Block, because whether or not the input stream has
|
|
been advanced depends upon the kind of token we encounter. If
|
|
it's a keyword or the target of an assignment statement, the
|
|
"cursor," as defined by the contents of Look, has been advanced
|
|
to the next token OR to the beginning of whitespace. If, on the
|
|
other hand, the token is a semicolon, or if we have hit a
|
|
carriage return, the cursor has NOT advanced.
|
|
|
|
Needless to say, we can add enough logic to keep us on track.
|
|
But it's tricky, and makes the whole parser very fragile.
|
|
|
|
There's a much better way, and that's just to adopt that same
|
|
rule that's worked so well before, to apply to TOKENS as well as
|
|
single characters. In other words, we'll prefetch tokens just as
|
|
we've always done for characters. It seems so obvious once you
|
|
think about it that way.
|
|
|
|
Interestingly enough, if we do things this way the problem that
|
|
we've had with newline characters goes away. We can just lump
|
|
them in as whitespace characters, which means that the handling
|
|
of newlines becomes very trivial, and MUCH less prone to error
|
|
than we've had to deal with in the past.
|
|
|
|
|
|
THE SOLUTION
|
|
|
|
Let's begin to fix the problem by re-introducing the two
|
|
procedures:
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Get an Identifier }
|
|
|
|
procedure GetName;
|
|
begin
|
|
SkipWhite;
|
|
if Not IsAlpha(Look) then Expected('Identifier');
|
|
Token := 'x';
|
|
Value := '';
|
|
repeat
|
|
Value := Value + UpCase(Look);
|
|
GetChar;
|
|
until not IsAlNum(Look);
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Get a Number }
|
|
|
|
procedure GetNum;
|
|
begin
|
|
SkipWhite;
|
|
if not IsDigit(Look) then Expected('Number');
|
|
Token := '#';
|
|
Value := '';
|
|
repeat
|
|
Value := Value + Look;
|
|
GetChar;
|
|
until not IsDigit(Look);
|
|
end;
|
|
{--------------------------------------------------------------}
|
|
|
|
|
|
These two procedures are functionally almost identical to the
|
|
ones I showed you in Part VII. They each fetch the current
|
|
token, either an identifier or a number, into the global string
|
|
Value. They also set the encoded version, Token, to the
|
|
appropriate code. The input stream is left with Look containing
|
|
the first character NOT part of the token.
|
|
|
|
We can do the same thing for operators, even multi-character
|
|
operators, with a procedure such as:
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Get an Operator }
|
|
|
|
procedure GetOp;
|
|
begin
|
|
Token := Look;
|
|
Value := '';
|
|
repeat
|
|
Value := Value + Look;
|
|
GetChar;
|
|
until IsAlpha(Look) or IsDigit(Look) or IsWhite(Look);
|
|
end;
|
|
{--------------------------------------------------------------}
|
|
|
|
Note that GetOp returns, as its encoded token, the FIRST
|
|
character of the operator. This is important, because it means
|
|
that we can now use that single character to drive the parser,
|
|
instead of the lookahead character.
|
|
|
|
We need to tie these procedures together into a single procedure
|
|
that can handle all three cases. The following procedure will
|
|
read any one of the token types and always leave the input stream
|
|
advanced beyond it:
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Get the Next Input Token }
|
|
|
|
procedure Next;
|
|
begin
|
|
SkipWhite;
|
|
if IsAlpha(Look) then GetName
|
|
else if IsDigit(Look) then GetNum
|
|
else GetOp;
|
|
end;
|
|
{--------------------------------------------------------------}
|
|
|
|
|
|
***NOTE that here I have put SkipWhite BEFORE the calls rather
|
|
than after. This means that, in general, the variable Look will
|
|
NOT have a meaningful value in it, and therefore we should NOT
|
|
use it as a test value for parsing, as we have been doing so far.
|
|
That's the big departure from our normal approach.
|
|
|
|
Now, remember that before I was careful not to treat the carriage
|
|
return (CR) and line feed (LF) characters as white space. This
|
|
was because, with SkipWhite called as the last thing in the
|
|
scanner, the encounter with LF would trigger a read statement.
|
|
If we were on the last line of the program, we couldn't get out
|
|
until we input another line with a non-white character. That's
|
|
why I needed the second procedure, NewLine, to handle the CRLF's.
|
|
|
|
But now, with the call to SkipWhite coming first, that's exactly
|
|
the behavior we want. The compiler must know there's another
|
|
token coming or it wouldn't be calling Next. In other words, it
|
|
hasn't found the terminating END yet. So we're going to insist
|
|
on more data until we find something.
|
|
|
|
All this means that we can greatly simplify both the program and
|
|
the concepts, by treating CR and LF as whitespace characters, and
|
|
eliminating NewLine. You can do that simply by modifying the
|
|
function IsWhite:
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Recognize White Space }
|
|
|
|
function IsWhite(c: char): boolean;
|
|
begin
|
|
IsWhite := c in [' ', TAB, CR, LF];
|
|
end;
|
|
{--------------------------------------------------------------}
|
|
|
|
|
|
We've already tried similar routines in Part VII, but you might
|
|
as well try these new ones out. Add them to a copy of the Cradle
|
|
and call Next with the following main program:
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Main Program }
|
|
|
|
begin
|
|
Init;
|
|
repeat
|
|
Next;
|
|
WriteLn(Token, ' ', Value);
|
|
until Token = '.';
|
|
end.
|
|
{--------------------------------------------------------------}
|
|
|
|
|
|
Compile it and verify that you can separate a program into a
|
|
series of tokens, and that you get the right encoding for each
|
|
token.
|
|
|
|
This ALMOST works, but not quite. There are two potential
|
|
problems: First, in KISS/TINY almost all of our operators are
|
|
single-character operators. The only exceptions are the relops
|
|
>=, <=, and <>. It seems a shame to treat all operators as
|
|
strings and do a string compare, when only a single character
|
|
compare will almost always suffice. Second, and much more
|
|
important, the thing doesn't WORK when two operators appear
|
|
together, as in (a+b)*(c+d). Here the string following 'b' would
|
|
be interpreted as a single operator ")*(."
|
|
|
|
It's possible to fix that problem. For example, we could just
|
|
give GetOp a list of legal characters, and we could treat the
|
|
parentheses as different operator types than the others. But
|
|
this begins to get messy.
|
|
|
|
Fortunately, there's a better way that solves all the problems.
|
|
Since almost all the operators are single characters, let's just
|
|
treat them that way, and let GetOp get only one character at a
|
|
time. This not only simplifies GetOp, but also speeds things up
|
|
quite a bit. We still have the problem of the relops, but we
|
|
were treating them as special cases anyway.
|
|
|
|
So here's the final version of GetOp:
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Get an Operator }
|
|
|
|
procedure GetOp;
|
|
begin
|
|
SkipWhite;
|
|
Token := Look;
|
|
Value := Look;
|
|
GetChar;
|
|
end;
|
|
{--------------------------------------------------------------}
|
|
|
|
|
|
Note that I still give the string Value a value. If you're truly
|
|
concerned about efficiency, you could leave this out. When we're
|
|
expecting an operator, we will only be testing Token anyhow, so
|
|
the value of the string won't matter. But to me it seems to be
|
|
good practice to give the thing a value just in case.
|
|
|
|
Try this new version with some realistic-looking code. You
|
|
should be able to separate any program into its individual
|
|
tokens, with the caveat that the two-character relops will scan
|
|
into two separate tokens. That's OK ... we'll parse them that
|
|
way.
|
|
|
|
Now, in Part VII the function of Next was combined with procedure
|
|
Scan, which also checked every identifier against a list of
|
|
keywords and encoded each one that was found. As I mentioned at
|
|
the time, the last thing we would want to do is to use such a
|
|
procedure in places where keywords should not appear, such as in
|
|
expressions. If we did that, the keyword list would be scanned
|
|
for every identifier appearing in the code. Not good.
|
|
|
|
The right way to deal with that is to simply separate the
|
|
functions of fetching tokens and looking for keywords. The
|
|
version of Scan shown below does NOTHING but check for keywords.
|
|
Notice that it operates on the current token and does NOT advance
|
|
the input stream.
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ 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 begin
|
|
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;
|
|
{-------------------------------------------------------------}
|
|
|
|
|
|
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.
|
|
|
|
(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;
|
|
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;
|
|
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;
|
|
begin
|
|
IsAlpha := UpCase(c) in ['A'..'Z'];
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Recognize a Decimal Digit }
|
|
|
|
function IsDigit(c: char): boolean;
|
|
begin
|
|
IsDigit := c in ['0'..'9'];
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Recognize an AlphaNumeric Character }
|
|
|
|
function IsAlNum(c: char): boolean;
|
|
begin
|
|
IsAlNum := IsAlpha(c) or IsDigit(c);
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Recognize an Addop }
|
|
|
|
function IsAddop(c: char): boolean;
|
|
begin
|
|
IsAddop := c in ['+', '-'];
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Recognize a Mulop }
|
|
|
|
function IsMulop(c: char): boolean;
|
|
begin
|
|
IsMulop := c in ['*', '/'];
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Recognize a Boolean Orop }
|
|
|
|
function IsOrop(c: char): boolean;
|
|
begin
|
|
IsOrop := c in ['|', '~'];
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Recognize a Relop }
|
|
|
|
function IsRelop(c: char): boolean;
|
|
begin
|
|
IsRelop := c in ['=', '#', '<', '>'];
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Recognize White Space }
|
|
|
|
function IsWhite(c: char): boolean;
|
|
begin
|
|
IsWhite := c in [' ', TAB, 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 }
|
|
|
|
function InTable(n: Symbol): Boolean;
|
|
begin
|
|
InTable := Lookup(@ST, n, NEntry) <> 0;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Check to See if an Identifier is in the Symbol Table }
|
|
{ Report an error if it's not. }
|
|
|
|
|
|
procedure CheckTable(N: Symbol);
|
|
begin
|
|
if not InTable(N) then Undefined(N);
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Check the Symbol Table for a Duplicate Identifier }
|
|
{ Report an error if identifier is already in table. }
|
|
|
|
|
|
procedure CheckDup(N: Symbol);
|
|
begin
|
|
if InTable(N) then Duplicate(N);
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Add a New Entry to Symbol Table }
|
|
|
|
procedure AddEntry(N: Symbol; T: char);
|
|
begin
|
|
CheckDup(N);
|
|
if NEntry = MaxEntry then Abort('Symbol Table Full');
|
|
Inc(NEntry);
|
|
ST[NEntry] := N;
|
|
SType[NEntry] := T;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Get an Identifier }
|
|
|
|
procedure GetName;
|
|
begin
|
|
SkipWhite;
|
|
if Not IsAlpha(Look) then Expected('Identifier');
|
|
Token := 'x';
|
|
Value := '';
|
|
repeat
|
|
Value := Value + UpCase(Look);
|
|
GetChar;
|
|
until not IsAlNum(Look);
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Get a Number }
|
|
|
|
procedure GetNum;
|
|
begin
|
|
SkipWhite;
|
|
if not IsDigit(Look) then Expected('Number');
|
|
Token := '#';
|
|
Value := '';
|
|
repeat
|
|
Value := Value + Look;
|
|
GetChar;
|
|
until not IsDigit(Look);
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Get an Operator }
|
|
|
|
procedure GetOp;
|
|
begin
|
|
SkipWhite;
|
|
Token := Look;
|
|
Value := Look;
|
|
GetChar;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Get the Next Input Token }
|
|
|
|
procedure Next;
|
|
begin
|
|
SkipWhite;
|
|
if IsAlpha(Look) then GetName
|
|
else if IsDigit(Look) then GetNum
|
|
else GetOp;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Scan the Current Identifier for Keywords }
|
|
|
|
procedure Scan;
|
|
begin
|
|
if Token = 'x' then
|
|
Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1];
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Match a Specific Input String }
|
|
|
|
procedure MatchString(x: string);
|
|
begin
|
|
if Value <> x then Expected('''' + x + '''');
|
|
Next;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Output a String with Tab }
|
|
|
|
procedure Emit(s: string);
|
|
begin
|
|
Write(TAB, s);
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Output a String with Tab and CRLF }
|
|
|
|
procedure EmitLn(s: string);
|
|
begin
|
|
Emit(s);
|
|
WriteLn;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Generate a Unique Label }
|
|
|
|
function NewLabel: string;
|
|
var S: string;
|
|
begin
|
|
Str(LCount, S);
|
|
NewLabel := 'L' + S;
|
|
Inc(LCount);
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Post a Label To Output }
|
|
|
|
procedure PostLabel(L: string);
|
|
begin
|
|
WriteLn(L, ':');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Clear the Primary Register }
|
|
|
|
procedure Clear;
|
|
begin
|
|
EmitLn('CLR D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Negate the Primary Register }
|
|
|
|
procedure Negate;
|
|
begin
|
|
EmitLn('NEG D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Complement the Primary Register }
|
|
|
|
procedure NotIt;
|
|
begin
|
|
EmitLn('NOT D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Load a Constant Value to Primary Register }
|
|
|
|
procedure LoadConst(n: string);
|
|
begin
|
|
Emit('MOVE #');
|
|
WriteLn(n, ',D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Load a Variable to Primary Register }
|
|
|
|
procedure LoadVar(Name: string);
|
|
begin
|
|
if not InTable(Name) then Undefined(Name);
|
|
EmitLn('MOVE ' + Name + '(PC),D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Push Primary onto Stack }
|
|
|
|
procedure Push;
|
|
begin
|
|
EmitLn('MOVE D0,-(SP)');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Add Top of Stack to Primary }
|
|
|
|
procedure PopAdd;
|
|
begin
|
|
EmitLn('ADD (SP)+,D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Subtract Primary from Top of Stack }
|
|
|
|
procedure PopSub;
|
|
begin
|
|
EmitLn('SUB (SP)+,D0');
|
|
EmitLn('NEG D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Multiply Top of Stack by Primary }
|
|
|
|
procedure PopMul;
|
|
begin
|
|
EmitLn('MULS (SP)+,D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Divide Top of Stack by Primary }
|
|
|
|
procedure PopDiv;
|
|
begin
|
|
EmitLn('MOVE (SP)+,D7');
|
|
EmitLn('EXT.L D7');
|
|
EmitLn('DIVS D0,D7');
|
|
EmitLn('MOVE D7,D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ AND Top of Stack with Primary }
|
|
|
|
procedure PopAnd;
|
|
begin
|
|
EmitLn('AND (SP)+,D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ OR Top of Stack with Primary }
|
|
|
|
procedure PopOr;
|
|
begin
|
|
EmitLn('OR (SP)+,D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ XOR Top of Stack with Primary }
|
|
|
|
procedure PopXor;
|
|
begin
|
|
EmitLn('EOR (SP)+,D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Compare Top of Stack with Primary }
|
|
|
|
procedure PopCompare;
|
|
begin
|
|
EmitLn('CMP (SP)+,D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Set D0 If Compare was = }
|
|
|
|
procedure SetEqual;
|
|
begin
|
|
EmitLn('SEQ D0');
|
|
EmitLn('EXT D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Set D0 If Compare was != }
|
|
|
|
procedure SetNEqual;
|
|
begin
|
|
EmitLn('SNE D0');
|
|
EmitLn('EXT D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Set D0 If Compare was > }
|
|
|
|
procedure SetGreater;
|
|
begin
|
|
EmitLn('SLT D0');
|
|
EmitLn('EXT D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Set D0 If Compare was < }
|
|
|
|
procedure SetLess;
|
|
begin
|
|
EmitLn('SGT D0');
|
|
EmitLn('EXT D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Set D0 If Compare was <= }
|
|
|
|
procedure SetLessOrEqual;
|
|
begin
|
|
EmitLn('SGE D0');
|
|
EmitLn('EXT D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Set D0 If Compare was >= }
|
|
|
|
procedure SetGreaterOrEqual;
|
|
begin
|
|
EmitLn('SLE D0');
|
|
EmitLn('EXT D0');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Store Primary to Variable }
|
|
|
|
procedure Store(Name: string);
|
|
begin
|
|
EmitLn('LEA ' + Name + '(PC),A0');
|
|
EmitLn('MOVE D0,(A0)')
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Branch Unconditional }
|
|
|
|
procedure Branch(L: string);
|
|
begin
|
|
EmitLn('BRA ' + L);
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Branch False }
|
|
|
|
procedure BranchFalse(L: string);
|
|
begin
|
|
EmitLn('TST D0');
|
|
EmitLn('BEQ ' + L);
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Read Variable to Primary Register }
|
|
|
|
procedure ReadIt(Name: string);
|
|
begin
|
|
EmitLn('BSR READ');
|
|
Store(Name);
|
|
end;
|
|
|
|
|
|
{ Write from Primary Register }
|
|
|
|
procedure WriteIt;
|
|
begin
|
|
EmitLn('BSR WRITE');
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Write Header Info }
|
|
|
|
procedure Header;
|
|
begin
|
|
WriteLn('WARMST', TAB, 'EQU $A01E');
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Write the Prolog }
|
|
|
|
procedure Prolog;
|
|
begin
|
|
PostLabel('MAIN');
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Write the Epilog }
|
|
|
|
procedure Epilog;
|
|
begin
|
|
EmitLn('DC WARMST');
|
|
EmitLn('END MAIN');
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Allocate Storage for a Static Variable }
|
|
|
|
procedure Allocate(Name, Val: string);
|
|
begin
|
|
WriteLn(Name, ':', TAB, 'DC ', Val);
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Parse and Translate a Math Factor }
|
|
|
|
procedure BoolExpression; Forward;
|
|
|
|
procedure Factor;
|
|
begin
|
|
if Token = '(' then begin
|
|
Next;
|
|
BoolExpression;
|
|
MatchString(')');
|
|
end
|
|
else begin
|
|
if Token = 'x' then
|
|
LoadVar(Value)
|
|
else if Token = '#' then
|
|
LoadConst(Value)
|
|
else Expected('Math Factor');
|
|
Next;
|
|
end;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Recognize and Translate a Multiply }
|
|
|
|
procedure Multiply;
|
|
begin
|
|
Next;
|
|
Factor;
|
|
PopMul;
|
|
end;
|
|
|
|
|
|
{-------------------------------------------------------------}
|
|
{ Recognize and Translate a Divide }
|
|
|
|
procedure Divide;
|
|
begin
|
|
Next;
|
|
Factor;
|
|
PopDiv;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Parse and Translate a Math Term }
|
|
|
|
procedure Term;
|
|
begin
|
|
Factor;
|
|
while IsMulop(Token) do begin
|
|
Push;
|
|
case Token of
|
|
'*': Multiply;
|
|
'/': Divide;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Recognize and Translate an Add }
|
|
|
|
procedure Add;
|
|
begin
|
|
Next;
|
|
Term;
|
|
PopAdd;
|
|
end;
|
|
|
|
|
|
{-------------------------------------------------------------}
|
|
{ Recognize and Translate a Subtract }
|
|
|
|
procedure Subtract;
|
|
begin
|
|
Next;
|
|
Term;
|
|
PopSub;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Parse and Translate an Expression }
|
|
|
|
procedure Expression;
|
|
begin
|
|
if IsAddop(Token) then
|
|
Clear
|
|
else
|
|
Term;
|
|
while IsAddop(Token) do begin
|
|
Push;
|
|
case Token of
|
|
'+': Add;
|
|
'-': Subtract;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Get Another Expression and Compare }
|
|
|
|
procedure CompareExpression;
|
|
begin
|
|
Expression;
|
|
PopCompare;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Get The Next Expression and Compare }
|
|
|
|
procedure NextExpression;
|
|
begin
|
|
Next;
|
|
CompareExpression;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Recognize and Translate a Relational "Equals" }
|
|
|
|
procedure Equal;
|
|
begin
|
|
NextExpression;
|
|
SetEqual;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Recognize and Translate a Relational "Less Than or Equal" }
|
|
|
|
procedure LessOrEqual;
|
|
begin
|
|
NextExpression;
|
|
SetLessOrEqual;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Recognize and Translate a Relational "Not Equals" }
|
|
|
|
procedure NotEqual;
|
|
begin
|
|
NextExpression;
|
|
SetNEqual;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Recognize and Translate a Relational "Less Than" }
|
|
|
|
procedure Less;
|
|
begin
|
|
Next;
|
|
case Token of
|
|
'=': LessOrEqual;
|
|
'>': NotEqual;
|
|
else begin
|
|
CompareExpression;
|
|
SetLess;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Recognize and Translate a Relational "Greater Than" }
|
|
|
|
procedure Greater;
|
|
begin
|
|
Next;
|
|
if Token = '=' then begin
|
|
NextExpression;
|
|
SetGreaterOrEqual;
|
|
end
|
|
else begin
|
|
CompareExpression;
|
|
SetGreater;
|
|
end;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Parse and Translate a Relation }
|
|
|
|
|
|
procedure Relation;
|
|
begin
|
|
Expression;
|
|
if IsRelop(Token) then begin
|
|
Push;
|
|
case Token of
|
|
'=': Equal;
|
|
'<': Less;
|
|
'>': Greater;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Parse and Translate a Boolean Factor with Leading NOT }
|
|
|
|
procedure NotFactor;
|
|
begin
|
|
if Token = '!' then begin
|
|
Next;
|
|
Relation;
|
|
NotIt;
|
|
end
|
|
else
|
|
Relation;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Parse and Translate a Boolean Term }
|
|
|
|
procedure BoolTerm;
|
|
begin
|
|
NotFactor;
|
|
while Token = '&' do begin
|
|
Push;
|
|
Next;
|
|
NotFactor;
|
|
PopAnd;
|
|
end;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Recognize and Translate a Boolean OR }
|
|
|
|
procedure BoolOr;
|
|
begin
|
|
Next;
|
|
BoolTerm;
|
|
PopOr;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Recognize and Translate an Exclusive Or }
|
|
|
|
procedure BoolXor;
|
|
begin
|
|
Next;
|
|
BoolTerm;
|
|
PopXor;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ Parse and Translate a Boolean Expression }
|
|
|
|
procedure BoolExpression;
|
|
begin
|
|
BoolTerm;
|
|
while IsOrOp(Token) do begin
|
|
Push;
|
|
case Token of
|
|
'|': BoolOr;
|
|
'~': BoolXor;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Parse and Translate an Assignment Statement }
|
|
|
|
procedure Assignment;
|
|
var Name: string;
|
|
begin
|
|
CheckTable(Value);
|
|
Name := Value;
|
|
Next;
|
|
MatchString('=');
|
|
BoolExpression;
|
|
Store(Name);
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
{ 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;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Parse and Translate a WHILE Statement }
|
|
|
|
procedure DoWhile;
|
|
var L1, L2: string;
|
|
begin
|
|
Next;
|
|
L1 := NewLabel;
|
|
L2 := NewLabel;
|
|
PostLabel(L1);
|
|
BoolExpression;
|
|
BranchFalse(L2);
|
|
Block;
|
|
MatchString('ENDWHILE');
|
|
Branch(L1);
|
|
PostLabel(L2);
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Read a Single Variable }
|
|
|
|
procedure ReadVar;
|
|
begin
|
|
CheckIdent;
|
|
CheckTable(Value);
|
|
ReadIt(Value);
|
|
Next;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Process a Read Statement }
|
|
|
|
procedure DoRead;
|
|
begin
|
|
Next;
|
|
MatchString('(');
|
|
ReadVar;
|
|
while Token = ',' do begin
|
|
Next;
|
|
ReadVar;
|
|
end;
|
|
MatchString(')');
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Process a Write Statement }
|
|
|
|
procedure DoWrite;
|
|
begin
|
|
Next;
|
|
MatchString('(');
|
|
Expression;
|
|
WriteIt;
|
|
while Token = ',' do begin
|
|
Next;
|
|
Expression;
|
|
WriteIt;
|
|
end;
|
|
MatchString(')');
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Parse and Translate a Block of Statements }
|
|
|
|
procedure Block;
|
|
begin
|
|
Scan;
|
|
while not(Token in ['e', 'l']) do begin
|
|
case Token of
|
|
'i': DoIf;
|
|
'w': DoWhile;
|
|
'R': DoRead;
|
|
'W': DoWrite;
|
|
else Assignment;
|
|
end;
|
|
Scan;
|
|
end;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Allocate Storage for a Variable }
|
|
|
|
procedure Alloc;
|
|
begin
|
|
Next;
|
|
if Token <> 'x' then Expected('Variable Name');
|
|
CheckDup(Value);
|
|
AddEntry(Value, 'v');
|
|
Allocate(Value, '0');
|
|
Next;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Parse and Translate Global Declarations }
|
|
|
|
procedure TopDecls;
|
|
begin
|
|
Scan;
|
|
while Token = 'v' do
|
|
Alloc;
|
|
while Token = ',' do
|
|
Alloc;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Initialize }
|
|
|
|
procedure Init;
|
|
begin
|
|
GetChar;
|
|
Next;
|
|
end;
|
|
|
|
|
|
{--------------------------------------------------------------}
|
|
{ Main Program }
|
|
|
|
begin
|
|
Init;
|
|
MatchString('PROGRAM');
|
|
Header;
|
|
TopDecls;
|
|
MatchString('BEGIN');
|
|
Prolog;
|
|
Block;
|
|
MatchString('END');
|
|
Epilog;
|
|
end.
|
|
{--------------------------------------------------------------}
|
|
*****************************************************************
|
|
* *
|
|
* COPYRIGHT NOTICE *
|
|
* *
|
|
* Copyright (C) 1989 Jack W. Crenshaw. All rights reserved. *
|
|
* *
|
|
*****************************************************************
|
|
|