unitmain.pas

词法.语法编译器 to 汇编语言 附带一个测试程序

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,StrUtils;

type
//symbol
    Symbol = (
    Nul, Aident, Bident, Number,
    Plus, Minus, Times, Slash,
    Eql, Neq, Lss, Leq, Gtr, Geq,
    Lparen, Rparen,
    Comma, Semicolon, Period, Becomes,
    ProgSym, IntegerSym, LogicalSym, IfSym,
    ThenSym ,ElseSym, WhileSym, RepeatSym,
    BeginSym, EndSym, OrSym, AndSym,
    NotSym, TrueSym, FalseSym, DoSym,
    UntilSym, WriteSym );

    TSymbolSet = set of Symbol;

    TObjekt = (obInteger, obLogical);

    //指令格式
    TInstruction = record
        Ins : string;
        ParamA , ParamB: integer;
    end;

    //------------------------------------------
    //  var
    //------------------------------------------
    TWordName = array[1..10] of Char;
    TVarRecord = record
      FType: TObjekt;      //类型
      FIdent: TWordName;   //变量名
      FValue: Integer;        //变量值
      FOffset: Word;       //地址偏移量
    end;

    //------------------------------------------
  //  变量解析状态
  //------------------------------------------
  TVarParseStatus = ( DeLogical,
                        DeInteger, Statement
                         );

//***********************************************
//                    mainform
//***********************************************
  TMainForm = class(TForm)
    ListText: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    ListBox1: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;


    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure ListBox3DblClick(Sender: TObject);

  private

  public
  //use in getchar
    LinePos,LineLen,LineNum:integer;
    SourceCode: Text;
    ch: char;
    LineBuf: Array[0..255] of Char;

  //use in getsym
    wsym : array[1..18] of Symbol;
    ssym : array[1..MAXCHAR] of Symbol;
    sword : array[1..18] of string;
    num : integer;
    sym : symbol;
    LastVar : TWordName;
    IntOrLog : boolean;

  //use in parse gen
    CodeCount:integer;
    CodeList : array [0..255] of TInstruction;
    CodeIndex : integer;

  //vartable
    VarData : array[0..255] of TVarRecord;
    VarCount : integer;
    VarParseStatus:TVarParseStatus;

    // pl/x程序起始符集
    StartState, StartDeclare, StartArithm, StartBool,
    StartRelate: TSymbolSet;

    //error
    sError : array [1..64] of String;
    ErrorList : TstringList;
    ErrorIdx : integer;

    //data stack
    StackDataCount : integer;
    StackData : array[0..255] of integer;

    procedure Initial;

    procedure InitialSymbol;
    function GetChar: Char;
    procedure ParseWords;
    procedure ParseConst;
    procedure ParseSingle;
    function GetSym: Symbol;

    //指令格式生成
    procedure Gen(sIns:string;iParamA:integer;iParamB:integer);

    //语法分析程序
    procedure Main_Program(AFollowSet: TSymbolSet);
    procedure Ds(AFollowSet: TSymbolSet);
    procedure De(AFollowSet: TSymbolSet);
    procedure Ss(AFollowSet: TSymbolSet);
    procedure St(AFollowSet: TSymbolSet);
    procedure Ae(AFollowSet: TSymbolSet);
    procedure At(AFollowSet: TSymbolSet);
    procedure Af(AFollowSet: TSymbolSet);
    procedure Be(AFollowSet: TSymbolSet);
    procedure Bt(AFollowSet: TSymbolSet);
    procedure Bf(AFollowSet: TSymbolSet);
    procedure Re(AFollowSet: TSymbolSet);

    procedure GrammarTest(AFollowSet, AStopSet: TSymbolSet; AErrorNo: Integer);

    //变量登记表
    function IsDeclared(AVarName: TWordName): Boolean;
    function GetVarInfo(AVarName: TWordName): TVarRecord;
    procedure EnterVar(AKind: TObjekt; AVarName: TWordName);
    function GetVarIndex(AVarName: TWordName):integer;

    //错误处理
    procedure ErrorFromFile( ErrorFileName : String);
    procedure PutErrorToList(ErrorNo : integer);

    //指令执行
    procedure pLit(paramA,ParamB: integer);
    procedure pLod(paramA,ParamB: integer);
    procedure pSto(paramA,ParamB: integer);
    procedure pJmp(paramA,ParamB: integer);
    procedure pJpc(paramA,ParamB: integer);
    procedure pOpr(paramA,ParamB: integer);
    procedure pOut(paramA,ParamB: integer);

    function DataPop: integer;
    procedure DataPush(data:integer);


    function TestShowVarList: TStrings;

  end;


const


  Current_File = 'program.txt';
  SYMBOL_NUMBER = 18;

var
  MainForm: TMainForm;

implementation

uses SysConst;

{$R *.dfm}
procedure TMainForm.Initial;
begin
     GetChar;
    VarCount := 0;
    CodeCount := -1;
    StackDataCount :=-1;
    ErrorFromFile('ErrorTable.txt');
    ErrorList:=Tstringlist.Create;
    ErrorIdx := 0;
    //初始化语句起始符集合
    StartState := [Aident, Bident, IfSym, WhileSym, RepeatSym, WriteSym];
    StartDeclare := [IntegerSym, LogicalSym];
    StartArithm := [Aident, Number, Lparen];
    StartBool := [Bident, NotSym, TrueSym, FalseSym, Lparen, Number, Aident];
    StartRelate := [Number, Aident];
end;
procedure TMainForm.InitialSymbol;
begin
      sword[1]  := 'program   ';    wsym[1 ] := ProgSym ;
  sword[2 ] := 'integer   ';    wsym[2 ] := IntegerSym ;
  sword[3 ] := 'logical   ';    wsym[3 ] := LogicalSym ;
  sword[4 ] := 'if        ';    wsym[4 ] := IfSym ;
  sword[5 ] := 'then      ';    wsym[5 ] := ThenSym ;
  sword[6 ] := 'else      ';    wsym[6 ] := ElseSym ;
  sword[7 ] := 'while     ';    wsym[7 ] := WhileSym ;
  sword[8 ] := 'repeat    ';    wsym[8 ] := RepeatSym ;
  sword[9 ] := 'begin     ';    wsym[9 ] := BeginSym ;
  sword[10] := 'end       ';    wsym[10] := EndSym ;
  sword[11] := 'or        ';    wsym[11] := OrSym ;
  sword[12] := 'and       ';    wsym[12] := AndSym ;
  sword[13] := 'not       ';    wsym[13] := NotSym ;
  sword[14] := 'true      ';    wsym[14] := TrueSym ;
  sword[15] := 'false     ';    wsym[15] := FalseSym ;
  sword[16] := 'do        ';    wsym[16] := DoSym ;
  sword[17] := 'until     ';    wsym[17] := UntilSym ;
  sword[18] := 'write     ';    wsym[18] := WriteSym;

  ssym[Ord('+')]:= Plus ;
  ssym[Ord('-')] := Minus ;
  ssym[Ord('*')] := Times ;
  ssym[Ord('/')] := Slash ;
  ssym[Ord('(')] := Lparen ;
  ssym[Ord(')')] := Rparen ;
  ssym[Ord('=')] := Eql ;
  ssym[Ord(',')] := Comma ;
  ssym[Ord(';')] := Semicolon ;
  ssym[Ord('.')] := Period ;
  ssym[Ord('<')] := Lss ;
  ssym[Ord('>')] := Gtr ;
end;

//******************************************************
//load from file
//******************************************************
procedure TMainForm.Button1Click(Sender: TObject);
begin
    ListText.items.LoadFromFile(Current_File);
    AssignFile(SourceCode, Current_File);
    Reset(SourceCode);
end;

//*******************************************************
//  GetChar
//*******************************************************
function TMainForm.GetChar: Char;

begin

    if LinePos = LineLen then begin
      LinePos := 0;
      LineLen :=0;

      // Read line to buffer
      while not Eoln(SourceCode) do
      begin
          Inc(LineLen);
          Read(SourceCode, ch);
          LineBuf[LineLen] := ch;
      end;

    // transfer return into whitespace
      Inc(LineLen);
      Inc(LineNum);
      ReadLn(SourceCode);
      LineBuf[LineLen] := ' ';
    end;

    Inc(LinePos);
    ch := LineBuf[LinePos];
    if ch in [#13{CR}, #10{LF}, #9{TAB}, ' '{SPC}] then ch := ' ';

    Result := ch;
end;

//-------------------------------------------------------
//  字符
//-------------------------------------------------------
procedure TMainForm.ParseWords;
var
  i, iSearch: integer;
  s, t: TWordName;
  bFound: Boolean;
  mSymbol : Symbol;
begin
  // Read a Symbol
  i :=0;
  while (ch in ['a'..'z']) or (ch in ['0'..'9']) do
  begin
    if i < 10 then
    begin
      Inc(i);
      s[i]:=ch;
    end;
    ch := GetChar;
  end;

    while i <> 10 do
    begin
      Inc(i);
      s[i] := ' ';
      //Inc(iReadCount);
    end;

  // Seeking Algorithm
  t := s;
  bFound:=False;
  for iSearch := 1 to SYMBOL_NUMBER do
    if t = sWord[iSearch] then
    begin
      bFound:=True;
      Break;
    end;


  if bFound=true then
    begin
      sym := wsym[iSearch];
    end
  else
    begin // Not Found, treat as Variable
      case VarParseStatus of

      DeLogical :
        begin
          //is the var declared?
          if IsDeclared(t) then PutErrorToList(22);

          EnterVar(obLogical, t);
          //bool型变量
          sym := Bident ;
          LastVar := t;
        end;
      DeInteger :
        begin
          if IsDeclared(t) then PutErrorToList(22);

          EnterVar(obInteger, t);
          //Integer型变量
          Sym := AIdent;
          LastVar := t;
        end;
      Statement :
        begin
          if not IsDeclared(t) then
          begin
            PutErrorToList(21);
            //错误处理，作为integer添加，后期再更新类型
            EnterVar(obInteger, t);
          end;

          //获得变量类型信息
          if GetVarInfo(t).FType = obLogical then
            Sym := Bident
          else
            Sym := Aident;
          LastVar := t;
        end;
      end;
    end;
end;

//-------------------------------------------------------
//  常量
//-------------------------------------------------------
procedure TMainForm.ParseConst;
begin
  num := 0;
  sym := Number;
  repeat
    num := 10 * num + (Ord(ch) - Ord('0'));
    ch := GetChar;
  until not (ch in ['0'..'9']);
end;

//-------------------------------------------------------
//  符号
//-------------------------------------------------------
procedure TMainForm.ParseSingle;
begin
  case ch of
  ':':
      begin
        ch := GetChar;
        if ch = '=' then begin
          sym := Becomes;
          ch := GetChar;
        end else
          sym := Semicolon;
      end;  // end of :
  '<':
      begin
        ch := GetChar;
        if ch = '=' then begin
          sym := Leq;
          ch := GetChar;
        end else
          sym := Lss;
      end;  //end of <
  '>':
      begin
        ch := GetChar;
        if ch = '=' then begin
          sym := Geq;
          ch := GetChar;
        end else
          sym := Gtr;
      end;  // end of >
  '/':
      begin
        ch := GetChar;
        if ch = '=' then begin
          sym := Neq;
          ch := GetChar;
        end else
          sym := Slash;
      end;  // end of /
  else
      begin
        sym := ssym[Ord(ch)];
        ch := GetChar;
      end;  // end of else
  end;  // end of case
end;

//-------------------------------------------------------
//  GetSym
//-------------------------------------------------------
function TMainForm.GetSym: Symbol;
begin

  // Filter Spaces
  while ch in [#13{CR}, #10{LF}, #9{TAB}, ' '{SPC}] do
    ch := GetChar;

  // Dispatch Symbol Parser
  if ch in ['a'..'z'] then
    ParseWords
  else if ch in ['0'..'9'] then
    ParseConst
        else
          begin
          ParseSingle ;
          end;

  result:=sym;
end;

/////////////////////////////////////////////////////////////////////////////
//
//                    以下是语法分析
//
/////////////////////////////////////////////////////////////////////////////
//*************************************************************************
//                Generate
//*************************************************************************
procedure TMainForm.Gen(sIns:string;iParamA:integer;iParamB:integer);
begin
    inc(CodeCount);