Программа, показанная ниже является такой основой. Это остаточная форма TINY с односимвольными токенами. Она имеет объявления данных, но только в их самой простейшей форме... никаких списков или инициализаторов. Имеются операции присваивания, но только вида
Другими словами, единственным допустимым выражением является одиночное имя переменной. Нет никаких управляющих конструкций... единственным допустимым утверждением является присваивание.
Большую часть программы составляют просто подпрограммы из стандартного Cradle. Я показал ее здесь полностью только для того, чтобы быть уверенным что все мы начинаем с одного места:
{–}
program Calls;
{–}
{ Constant Declarations }
const TAB = ^I;
CR = ^M;
LF = ^J;
{–}
{ Variable Declarations }
var Look: char; { Lookahead Character }
var ST: Array['A'..'Z'] of char;
{–}
{ 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 an Duplicate Identifier }
procedure Duplicate(n: string);
begin
Abort('Duplicate Identifier ' + n);
end;
{–}
{ Get Type of Symbol }
function TypeOf(n: char): char;
begin
TypeOf := ST[n];
end;
{–}
{ Look for Symbol in Table }
function InTable(n: char): Boolean;
begin
InTable := ST[n] <> ' ';
end;
{–}
{ Add a New Symbol to Table }
procedure AddEntry(Name, T: char);
begin
if Intable(Name) then Duplicate(Name);
ST[Name] := T;
end;
{–}
{ Check an Entry to Make Sure It's a Variable }
procedure CheckVar(Name: char);
begin
if not InTable(Name) then Undefined(Name);
if TypeOf(Name) <> 'v' then Abort(Name + ' is not a
variable');
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 Fin;
begin
if Look = CR then begin
GetChar;
if Look = LF then
GetChar;
end;
end;
{–}
{ Match a Specific Input Character }
procedure Match(x: char);
begin
if Look = x then GetChar
else Expected('''' + x + '''');
SkipWhite;
end;
{–}
{ Get an Identifier }
function GetName: char;
begin
if not IsAlpha(Look) then Expected('Name');
GetName := UpCase(Look);
GetChar;
SkipWhite;
end;
{–}
{ Get a Number }
function GetNum: char;
begin
if not IsDigit(Look) then Expected('Integer');
GetNum := Look;
GetChar;
SkipWhite;
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;
{–}
{ Post a Label To Output }
procedure PostLabel(L: string);
begin
WriteLn(L, ':');
end;
{–}
{ Load a Variable to the Primary Register }
procedure LoadVar(Name: char);
begin
CheckVar(Name);
EmitLn('MOVE ' + Name + '(PC),D0');
end;
{–}
{ Store the Primary Register }
procedure StoreVar(Name: char);
begin
CheckVar(Name);
EmitLn('LEA ' + Name + '(PC),A0');
EmitLn('MOVE D0,(A0)')
end;
{–}
{ Initialize }
procedure Init;
var i: char;
begin
GetChar;
SkipWhite;
for i := 'A' to 'Z' do
ST[i] := ' ';
end;
{–}
{ Parse and Translate an Expression }
{ Vestigial Version }
procedure Expression;
begin
LoadVar(GetName);
end;
{–}
{ Parse and Translate an Assignment Statement }
procedure Assignment;
var Name: char;
begin
Name := GetName;
Match('=');
Expression;
StoreVar(Name);
end;
{–}
{ Parse and Translate a Block of Statements }
procedure DoBlock;
begin
while not(Look in ['e']) do begin
Assignment;
Fin;
end;
end;
{–}
{ Parse and Translate a Begin-Block }
procedure BeginBlock;
begin
Match('b');
Fin;
DoBlock;
Match('e');
Fin;
end;
{–}
{ Allocate Storage for a Variable }
procedure Alloc(N: char);
begin
if InTable(N) then Duplicate(N);
ST[N] := 'v';
WriteLn(N, ':', TAB, 'DC 0');
end;
{–}
{ Parse and Translate a Data Declaration }
procedure Decl;
var Name: char;
begin
Match('v');
Alloc(GetName);
end;
{–}
{ Parse and Translate Global Declarations }
procedure TopDecls;
begin
while Look <> 'b' do begin
case Look of
'v': Decl;
else Abort('Unrecognized Keyword ' + Look);
end;
Fin;
end;
end;
{–}
{ Main Program }
begin
Init;
TopDecls;
BeginBlock;
end.
{–}
Обратите внимание, что у нас есть таблица идентификаторов и есть логика для проверки допустимости имени переменной. Также стоит обратить внимание на то, что я включил код, который вы видели ранее для поддержки пробелов и переносов строк. Наконец заметьте, что основная программа ограничена как обычно операторными скобками BEGIN-END.
Если вы скопировали программу в Turbo, первым делом нужно откомпилировать ее и удостовериться что она работает. Сделайте несколько объявлений а затем блок begin. Попробуйте что-нибудь вроде:
Как обычно, вы должны сделать некоторые преднамеренные ошибки и проверить, что программа правильно их отлавливает.
Если вы удовлетворены, как работает наша маленькая программа, тогда пришло время поработать с процедурами. Так как мы еще не говорили о параметрах мы начнем с рассмотрения только таких процедур которые не имеют списка параметров.
