<!-- MHonArc v2.4.4 -->
<!--X-Subject: Tutorial: Let's build a Compiler! - Part XI: Lexical Scan Revisited -->
<!--X-From-R13: "Xba O. Znzoreg" <wyflfvapNvk.argpbz.pbz> -->
<!--X-Date: Mon, 02 Mar 1998 21:38:03 +0000 -->
<!--X-Message-Id: 000401bd4623$d5773140$ca3bd8ce@default -->
<!--X-Content-Type: text/plain -->
<!--X-Head-End-->
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<html>
<head>
<title>MUD-Dev message, Tutorial: Let's build a Compiler! - Part XI: Lexical Scan Revi</title>
<!-- meta name="robots" content="noindex,nofollow" -->
<link rev="made" href="mailto:jlsysinc#ix,netcom.com">
</head>
<body background="/backgrounds/paperback.gif" bgcolor="#ffffff"
text="#000000" link="#0000FF" alink="#FF0000" vlink="#006000">
<font size="+4" color="#804040">
<strong><em>MUD-Dev<br>mailing list archive</em></strong>
</font>
<br>
[ <a href="../">Other Periods</a>
| <a href="../../">Other mailing lists</a>
| <a href="/search.php3">Search</a>
]
<br clear=all><hr>
<!--X-Body-Begin-->
<!--X-User-Header-->
<!--X-User-Header-End-->
<!--X-TopPNI-->
Date:
[ <a href="msg00669.html">Previous</a>
| <a href="msg00671.html">Next</a>
]
Thread:
[ <a href="msg00671.html">Previous</a>
| <a href="msg00667.html">Next</a>
]
Index:
[ <A HREF="author.html#00670">Author</A>
| <A HREF="#00670">Date</A>
| <A HREF="thread.html#00670">Thread</A>
]
<!--X-TopPNI-End-->
<!--X-MsgBody-->
<!--X-Subject-Header-Begin-->
<H1>Tutorial: Let's build a Compiler! - Part XI: Lexical Scan Revisited</H1>
<HR>
<!--X-Subject-Header-End-->
<!--X-Head-of-Message-->
<UL>
<LI><em>To</em>: <<A HREF="mailto:mud-dev#null,net">mud-dev#null,net</A>></LI>
<LI><em>Subject</em>: Tutorial: Let's build a Compiler! - Part XI: Lexical Scan Revisited</LI>
<LI><em>From</em>: "Jon A. Lambert" <<A HREF="mailto:jlsysinc#ix,netcom.com">jlsysinc#ix,netcom.com</A>></LI>
<LI><em>Date</em>: Mon, 2 Mar 1998 16:39:06 -0500</LI>
</UL>
<!--X-Head-of-Message-End-->
<!--X-Head-Body-Sep-Begin-->
<HR>
<!--X-Head-Body-Sep-End-->
<!--X-Body-of-Message-->
<PRE>
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. *
* *
*****************************************************************
--
--/*\ Jon A. Lambert - TychoMUD Internet:jlsysinc#ix,netcom.com /*\--
--/*\ Mud Server Developer's Page <<A HREF="http://www.netcom.com/~jlsysinc">http://www.netcom.com/~jlsysinc</A>> /*\--
--/*\ "Everything that deceives may be said to enchant" - Plato /*\--
</PRE>
<!--X-Body-of-Message-End-->
<!--X-MsgBody-End-->
<!--X-Follow-Ups-->
<HR>
<!--X-Follow-Ups-End-->
<!--X-References-->
<!--X-References-End-->
<!--X-BotPNI-->
<UL>
<LI>Prev by Date:
<STRONG><A HREF="msg00669.html">Re: [MUD-Dev] Java and Javascript</A></STRONG>
</LI>
<LI>Next by Date:
<STRONG><A HREF="msg00671.html">Tutorial: Let's build a Compiler! - Part XII: Miscellany</A></STRONG>
</LI>
<LI>Prev by thread:
<STRONG><A HREF="msg00671.html">Tutorial: Let's build a Compiler! - Part XII: Miscellany</A></STRONG>
</LI>
<LI>Next by thread:
<STRONG><A HREF="msg00667.html">Re: [MUD-Dev] Net protocols for MUDing</A></STRONG>
</LI>
<LI>Index(es):
<UL>
<LI><A HREF="index.html#00670"><STRONG>Date</STRONG></A></LI>
<LI><A HREF="thread.html#00670"><STRONG>Thread</STRONG></A></LI>
</UL>
</LI>
</UL>
<!--X-BotPNI-End-->
<!--X-User-Footer-->
<!--X-User-Footer-End-->
<ul><li>Thread context:
<BLOCKQUOTE><UL>
<LI><strong><A NAME="00678" HREF="msg00678.html">Describing the environment</A></strong>,
Stephen Zepp <a href="mailto:zoran#enid,com">zoran#enid,com</a>, Tue 03 Mar 1998, 22:36 GMT
<UL>
<LI><strong><A NAME="00679" HREF="msg00679.html">Re: [MUD-Dev] Describing the environment</A></strong>,
Richard Woolcock <a href="mailto:KaVir#dial,pipex.com">KaVir#dial,pipex.com</a>, Tue 03 Mar 1998, 23:43 GMT
</LI>
</UL>
</LI>
<LI><strong><A NAME="00672" HREF="msg00672.html">Tutorial: Let's build a Compiler! - Part XIII: Procedures</A></strong>,
Jon A. Lambert <a href="mailto:jlsysinc#ix,netcom.com">jlsysinc#ix,netcom.com</a>, Mon 02 Mar 1998, 21:39 GMT
<LI><strong><A NAME="00671" HREF="msg00671.html">Tutorial: Let's build a Compiler! - Part XII: Miscellany</A></strong>,
Jon A. Lambert <a href="mailto:jlsysinc#ix,netcom.com">jlsysinc#ix,netcom.com</a>, Mon 02 Mar 1998, 21:38 GMT
<LI><strong><A NAME="00670" HREF="msg00670.html">Tutorial: Let's build a Compiler! - Part XI: Lexical Scan Revisited</A></strong>,
Jon A. Lambert <a href="mailto:jlsysinc#ix,netcom.com">jlsysinc#ix,netcom.com</a>, Mon 02 Mar 1998, 21:38 GMT
<LI><strong><A NAME="00667" HREF="msg00667.html">Re: [MUD-Dev] Net protocols for MUDing</A></strong>,
Chris Gray <a href="mailto:cg#ami-cg,GraySage.Edmonton.AB.CA">cg#ami-cg,GraySage.Edmonton.AB.CA</a>, Mon 02 Mar 1998, 09:35 GMT
<UL>
<li><Possible follow-up(s)><br>
<LI><strong><A NAME="00803" HREF="msg00803.html">Re: [MUD-Dev] Net protocols for MUDing</A></strong>,
Chris Gray <a href="mailto:cg#ami-cg,GraySage.Edmonton.AB.CA">cg#ami-cg,GraySage.Edmonton.AB.CA</a>, Sat 21 Mar 1998, 02:29 GMT
</LI>
</UL>
</LI>
<LI><strong><A NAME="00661" HREF="msg00661.html">Describe Concept</A></strong>,
Stephen Zepp <a href="mailto:zoran#enid,com">zoran#enid,com</a>, Sun 01 Mar 1998, 22:05 GMT
<UL>
<LI><strong><A NAME="00674" HREF="msg00674.html">Re: [MUD-Dev] Describe Concept</A></strong>,
Jon A. Lambert <a href="mailto:Jon.A.Lambert#ix,netcom.com">Jon.A.Lambert#ix,netcom.com</a>, Tue 03 Mar 1998, 07:01 GMT
</LI>
</UL>
</LI>
</UL></BLOCKQUOTE>
</ul>
<hr>
<center>
[ <a href="../">Other Periods</a>
| <a href="../../">Other mailing lists</a>
| <a href="/search.php3">Search</a>
]
</center>
<hr>
</body>
</html>
