Представление "TINY"

Представление "TINY" - ЗАКЛЮЧЕНИЕ

Содержание материала

Страница 14 из 14

ЗАКЛЮЧЕНИЕ

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

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

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

Увидимся.

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

Code:

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.

 

 

Новые статьи

Ранние статьи

Случайные статьи

Популярные статьи

Подробности
Категория: Лекции по построению компилятора на Pascal

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!

Защитный код
Обновить