ЗАКЛЮЧЕНИЕ

К этому моменту мы полностью определили TINY. Он не слишком значителен... в действительности игрушечный компилятор. TINY имеет только один тип данных и не имеет подпрограмм... но это законченный, пригодный для использования язык. Пока что вы не имеете возможности написать на нем другой компилятор или сделать что-нибудь еще очень серьезное, но вы могли бы писать программы для чтения входных данных, выполнения вычислений и вывода результатов. Не слишком плохо для игрушки.

Более важно, что мы имеем твердую основу для дальнейшего развития. Я знаю, что вы будете рады слышать это: в последний раз я начал с создания синтаксического анализатора заново... с этого момента я предполагаю просто добавлять возможности в TINY пока он не превратится в KISS. Ох, будет время, когда нам понадобится попробовать некоторые вещи с новыми копиями Cradle, но как только мы разузнаем как они делаются, они будут встроены в TINY.

Какие это будут возможности? Хорошо, для начала нам понадобятся подпрограммы и функции. Затем нам нужна возможность обрабатывать различные типы, включая массивы, строки и другие структуры. Затем нам нужно работать с идеей указателей. Все это будет в следующих главах.

Увидимся.

В справочных целях полный листинг TINY версии 1.0 показан ниже:

{--------------------------------------------------------------}

program Tiny10;

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

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

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

{--------------------------------------------------------------}
{ Type Declarations }

type Symbol = string[8];

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

{--------------------------------------------------------------}
{ Variable Declarations }

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

const MaxEntry = 100;

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

{--------------------------------------------------------------}
{ Definition of Keywords and Token Types }

const NKW = 11;
NKW1 = 12;

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

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

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

procedure GetChar;
begin
Read(Look);
end;

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

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

{--------------------------------------------------------------}
{ Report Error and Halt }

procedure Abort(s: string);
begin
Error(s);
Halt;
end;

{--------------------------------------------------------------}
{ Report What Was Expected }

procedure Expected(s: string);
begin
Abort(s + ' Expected');
end;

{--------------------------------------------------------------}
{ Report an Undefined Identifier }

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

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

function IsAlpha(c: char): boolean;
begin
IsAlpha := UpCase(c) in ['A'..'Z'];
end;

{--------------------------------------------------------------}
{ Recognize a Decimal Digit }

function IsDigit(c: char): boolean;
begin
IsDigit := c in ['0'..'9'];
end;

{--------------------------------------------------------------}
{ Recognize an AlphaNumeric Character }

function IsAlNum(c: char): boolean;
begin
IsAlNum := IsAlpha(c) or IsDigit(c);
end;

{--------------------------------------------------------------}
{ Recognize an Addop }

function IsAddop(c: char): boolean;
begin
IsAddop := c in ['+', '-'];
end;

{--------------------------------------------------------------}
{ Recognize a Mulop }

function IsMulop(c: char): boolean;
begin
IsMulop := c in ['*', '/'];
end;

{--------------------------------------------------------------}
{ Recognize a Boolean Orop }

function IsOrop(c: char): boolean;
begin
IsOrop := c in ['|', '~'];
end;

{--------------------------------------------------------------}
{ Recognize a Relop }

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

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

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

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

procedure SkipWhite;
begin
while IsWhite(Look) do
GetChar;
end;

{--------------------------------------------------------------}
{ Skip Over an End-of-Line }

procedure NewLine;
begin
while Look = CR do begin
GetChar;
if Look = LF then GetChar;
SkipWhite;
end;
end;

{--------------------------------------------------------------}
{ Match a Specific Input Character }

procedure Match(x: char);
begin
NewLine;
if Look = x then GetChar
else Expected('''' + x + '''');
SkipWhite;
end;

{--------------------------------------------------------------}
{ Table Lookup }

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

{--------------------------------------------------------------}
{ Locate a Symbol in Table }
{ Returns the index of the entry. Zero if not present. }

function Locate(N: Symbol): integer;
begin
Locate := Lookup(@ST, n, MaxEntry);
end;

{--------------------------------------------------------------}
{ Look for Symbol in Table }

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

{--------------------------------------------------------------}
{ Add a New Entry to Symbol Table }

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

{--------------------------------------------------------------}
{ Get an Identifier }

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

{--------------------------------------------------------------}
{ Get a Number }

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

{--------------------------------------------------------------}
{ Get an Identifier and Scan it for Keywords }

procedure Scan;
begin
GetName;
Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1];
end;

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

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

{--------------------------------------------------------------}
{ Output a String with Tab }

procedure Emit(s: string);
begin
Write(TAB, s);
end;

{--------------------------------------------------------------}
{ Output a String with Tab and CRLF }

procedure EmitLn(s: string);
begin
Emit(s);
WriteLn;
end;

{--------------------------------------------------------------}
{ Generate a Unique Label }

function NewLabel: string;
var S: string;
begin
Str(LCount, S);
NewLabel := 'L' + S;
Inc(LCount);
end;

{--------------------------------------------------------------}
{ Post a Label To Output }

procedure PostLabel(L: string);
begin
WriteLn(L, ':');
end;

{---------------------------------------------------------------}
{ Clear the Primary Register }

procedure Clear;
begin
EmitLn('CLR D0');
end;

{---------------------------------------------------------------}
{ Negate the Primary Register }

procedure Negate;
begin
EmitLn('NEG D0');
end;

{---------------------------------------------------------------}
{ Complement the Primary Register }

procedure NotIt;
begin
EmitLn('NOT D0');
end;

{---------------------------------------------------------------}
{ Load a Constant Value to Primary Register }

procedure LoadConst(n: integer);
begin
Emit('MOVE #');
WriteLn(n, ',D0');
end;

{---------------------------------------------------------------}
{ Load a Variable to Primary Register }

procedure LoadVar(Name: string);
begin
if not InTable(Name) then Undefined(Name);
EmitLn('MOVE ' + Name + '(PC),D0');
end;

{---------------------------------------------------------------}
{ Push Primary onto Stack }

procedure Push;
begin
EmitLn('MOVE D0,-(SP)');
end;

{---------------------------------------------------------------}
{ Add Top of Stack to Primary }

procedure PopAdd;
begin
EmitLn('ADD (SP)+,D0');
end;

{---------------------------------------------------------------}
{ Subtract Primary from Top of Stack }

procedure PopSub;
begin
EmitLn('SUB (SP)+,D0');
EmitLn('NEG D0');
end;

{---------------------------------------------------------------}
{ Multiply Top of Stack by Primary }

procedure PopMul;
begin
EmitLn('MULS (SP)+,D0');
end;

{---------------------------------------------------------------}
{ Divide Top of Stack by Primary }

procedure PopDiv;
begin
EmitLn('MOVE (SP)+,D7');
EmitLn('EXT.L D7');
EmitLn('DIVS D0,D7');
EmitLn('MOVE D7,D0');
end;

{---------------------------------------------------------------}
{ AND Top of Stack with Primary }

procedure PopAnd;
begin
EmitLn('AND (SP)+,D0');
end;

{---------------------------------------------------------------}
{ OR Top of Stack with Primary }

procedure PopOr;
begin
EmitLn('OR (SP)+,D0');
end;

{---------------------------------------------------------------}
{ XOR Top of Stack with Primary }

procedure PopXor;
begin
EmitLn('EOR (SP)+,D0');
end;

{---------------------------------------------------------------}
{ Compare Top of Stack with Primary }

procedure PopCompare;
begin
EmitLn('CMP (SP)+,D0');
end;

{---------------------------------------------------------------}
{ Set D0 If Compare was = }

procedure SetEqual;
begin
EmitLn('SEQ D0');
EmitLn('EXT D0');
end;

{---------------------------------------------------------------}
{ Set D0 If Compare was != }

procedure SetNEqual;
begin
EmitLn('SNE D0');
EmitLn('EXT D0');
end;

{---------------------------------------------------------------}
{ Set D0 If Compare was > }

procedure SetGreater;
begin
EmitLn('SLT D0');
EmitLn('EXT D0');
end;

{---------------------------------------------------------------}
{ Set D0 If Compare was < }

procedure SetLess;
begin
EmitLn('SGT D0');
EmitLn('EXT D0');
end;

{---------------------------------------------------------------}
{ Set D0 If Compare was <= }

procedure SetLessOrEqual;
begin
EmitLn('SGE D0');
EmitLn('EXT D0');
end;

{---------------------------------------------------------------}
{ Set D0 If Compare was >= }

procedure SetGreaterOrEqual;
begin
EmitLn('SLE D0');
EmitLn('EXT D0');
end;

{---------------------------------------------------------------}
{ Store Primary to Variable }

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

{---------------------------------------------------------------}
{ Branch Unconditional }

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

{---------------------------------------------------------------}
{ Branch False }

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

{---------------------------------------------------------------}
{ Read Variable to Primary Register }

procedure ReadVar;
begin
EmitLn('BSR READ');
Store(Value[1]);
end;

{ Write Variable from Primary Register }

procedure WriteVar;
begin
EmitLn('BSR WRITE');
end;

{--------------------------------------------------------------}
{ Write Header Info }

procedure Header;
begin
WriteLn('WARMST', TAB, 'EQU $A01E');
end;

{--------------------------------------------------------------}
{ Write the Prolog }

procedure Prolog;
begin
PostLabel('MAIN');
end;

{--------------------------------------------------------------}
{ Write the Epilog }

procedure Epilog;
begin
EmitLn('DC WARMST');
EmitLn('END MAIN');
end;

{---------------------------------------------------------------}
{ Parse and Translate a Math Factor }

procedure BoolExpression; Forward;

procedure Factor;
begin
if Look = '(' then begin
Match('(');
BoolExpression;
Match(')');
end
else if IsAlpha(Look) then begin
GetName;
LoadVar(Value);
end
else
LoadConst(GetNum);
end;

{--------------------------------------------------------------}
{ Parse and Translate a Negative Factor }

procedure NegFactor;
begin
Match('-');
if IsDigit(Look) then
LoadConst(-GetNum)
else begin
Factor;
Negate;
end;
end;

{--------------------------------------------------------------}
{ Parse and Translate a Leading Factor }

procedure FirstFactor;
begin
case Look of
'+': begin
Match('+');
Factor;
end;
'-': NegFactor;
else Factor;
end;
end;

{--------------------------------------------------------------}
{ Recognize and Translate a Multiply }

procedure Multiply;
begin
Match('*');
Factor;
PopMul;
end;

{-------------------------------------------------------------}
{ Recognize and Translate a Divide }

procedure Divide;
begin
Match('/');
Factor;
PopDiv;
end;

{---------------------------------------------------------------}
{ Common Code Used by Term and FirstTerm }

procedure Term1;
begin
while IsMulop(Look) do begin
Push;
case Look of
'*': Multiply;
'/': Divide;
end;
end;
end;

{---------------------------------------------------------------}
{ Parse and Translate a Math Term }

procedure Term;
begin
Factor;
Term1;
end;

{---------------------------------------------------------------}
{ Parse and Translate a Leading Term }

procedure FirstTerm;
begin
FirstFactor;
Term1;
end;

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

procedure Add;
begin
Match('+');
Term;
PopAdd;
end;

{-------------------------------------------------------------}
{ Recognize and Translate a Subtract }

procedure Subtract;
begin
Match('-');
Term;
PopSub;
end;

{---------------------------------------------------------------}
{ Parse and Translate an Expression }

procedure Expression;
begin
FirstTerm;
while IsAddop(Look) do begin
Push;
case Look of
'+': Add;
'-': Subtract;
end;
end;
end;

{---------------------------------------------------------------}
{ Recognize and Translate a Relational "Equals" }

procedure Equal;
begin
Match('=');
Expression;
PopCompare;
SetEqual;
end;

{---------------------------------------------------------------}
{ Recognize and Translate a Relational "Less Than or Equal" }

procedure LessOrEqual;
begin
Match('=');
Expression;
PopCompare;
SetLessOrEqual;
end;

{---------------------------------------------------------------}
{ Recognize and Translate a Relational "Not Equals" }

procedure NotEqual;
begin
Match('>');
Expression;
PopCompare;
SetNEqual;
end;

{---------------------------------------------------------------}
{ Recognize and Translate a Relational "Less Than" }

procedure Less;
begin
Match('<');
case Look of
'=': LessOrEqual;
'>': NotEqual;
else begin
Expression;
PopCompare;
SetLess;
end;
end;
end;

{---------------------------------------------------------------}
{ Recognize and Translate a Relational "Greater Than" }

procedure Greater;
begin
Match('>');
if Look = '=' then begin
Match('=');
Expression;
PopCompare;
SetGreaterOrEqual;
end
else begin
Expression;
PopCompare;
SetGreater;
end;
end;

{---------------------------------------------------------------}
{ Parse and Translate a Relation }

procedure Relation;
begin
Expression;
if IsRelop(Look) then begin
Push;
case Look of
'=': Equal;
'<': Less;
'>': Greater;
end;
end;
end;

{---------------------------------------------------------------}
{ Parse and Translate a Boolean Factor with Leading NOT }

procedure NotFactor;
begin
if Look = '!' then begin
Match('!');
Relation;
NotIt;
end
else
Relation;
end;

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

procedure BoolTerm;
begin
NotFactor;
while Look = '&' do begin
Push;
Match('&');
NotFactor;
PopAnd;
end;
end;

{--------------------------------------------------------------}
{ Recognize and Translate a Boolean OR }

procedure BoolOr;
begin
Match('|');
BoolTerm;
PopOr;
end;

{--------------------------------------------------------------}
{ Recognize and Translate an Exclusive Or }

procedure BoolXor;
begin
Match('~');
BoolTerm;
PopXor;
end;

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

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

{--------------------------------------------------------------}
{ Parse and Translate an Assignment Statement }

procedure Assignment;
var Name: string;
begin
Name := Value;
Match('=');
BoolExpression;
Store(Name);
end;

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

procedure Block; Forward;

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

{--------------------------------------------------------------}
{ Parse and Translate a WHILE Statement }

procedure DoWhile;
var L1, L2: string;
begin
L1 := NewLabel;
L2 := NewLabel;
PostLabel(L1);
BoolExpression;
BranchFalse(L2);
Block;
MatchString('ENDWHILE');
Branch(L1);
PostLabel(L2);
end;

{--------------------------------------------------------------}
{ Process a Read Statement }

procedure DoRead;
begin
Match('(');
GetName;
ReadVar;
while Look = ',' do begin
Match(',');
GetName;
ReadVar;
end;
Match(')');
end;

{--------------------------------------------------------------}
{ Process a Write Statement }

procedure DoWrite;
begin
Match('(');
Expression;
WriteVar;
while Look = ',' do begin
Match(',');
Expression;
WriteVar;
end;
Match(')');
end;

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

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

{--------------------------------------------------------------}
{ Allocate Storage for a Variable }

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

{--------------------------------------------------------------}
{ Parse and Translate a Data Declaration }

procedure Decl;
begin
GetName;
Alloc(Value);
while Look = ',' do begin
Match(',');
GetName;
Alloc(Value);
end;
end;

{--------------------------------------------------------------}
{ Parse and Translate Global Declarations }

procedure TopDecls;
begin
Scan;
while Token <> 'b' do begin
case Token of
'v': Decl;
else Abort('Unrecognized Keyword ' + Value);
end;
Scan;
end;
end;

{--------------------------------------------------------------}
{ Parse and Translate a Main Program }

procedure Main;
begin
MatchString('BEGIN');
Prolog;
Block;
MatchString('END');
Epilog;
end;

{--------------------------------------------------------------}
{ Parse and Translate a Program }

procedure Prog;
begin
MatchString('PROGRAM');
Header;
TopDecls;
Main;
Match('.');
end;

{--------------------------------------------------------------}
{ Initialize }

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

{--------------------------------------------------------------}
{ Main Program }

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

{--------------------------------------------------------------}