unitmain.pas

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

        Gen('LIT',0, 0);
        GetSym;
      end;
    NotSym:
      begin
        GetSym;
        Bt(AFollowSet);


        Gen('OPR',0, 16);
      end;
    Lparen:
      begin
        GetSym;
        Be(AFollowSet + [Rparen]);
        if Sym = Rparen then GetSym else PutErrorToList(17);
      end;
    else
      Re(AFollowSet);
    end;  //end of case
    GrammarTest(AFollowSet, [Lparen], 24);
  end; //end of while
end;

//--------------------------------------------------
//  re
//--------------------------------------------------
procedure TMainForm.Re(AFollowSet: TSymbolSet);
var
  r: Symbol ;
  iLastVarOffset: Word;
begin
  GrammarTest(StartRelate, AFollowSet, 19);
  if Sym in [Number, AIdent] then
  begin
    case Sym of
    Number:
      begin
        Gen('LIT',0, num);
      end;
    Aident:
      begin

      iLastVarOffset := GetVarInfo(LastVar).FOffset ;
      Gen('LOD',0, iLastVarOffset);
      end;
    end;
    
    GetSym;
    if Sym in [Eql, Gtr, Geq, Lss, Leq, Neq] then
    begin
      r := Sym;
      GetSym;
      Ae(AFollowSet);

      case r of
      Eql:  Gen('OPR',0, 8);
      Gtr:  Gen('OPR',0, 12);
      Geq:  Gen('OPR',0, 11);
      Lss:  Gen('OPR',0, 10);
      Leq:  Gen('OPR',0, 13);
      Neq:  Gen('OPR',0, 9);
      end;

    end  //end of if
    else
      PutErrorToList(19);
  end  //end of if
  else
    PutErrorToList(18);
end;

//--------------------------------------------------------
//  grammatest:处理遇到错误的情况：下一个符号不在跟随符集合中，开始定位到下一个语句的开始符
//--------------------------------------------------------
procedure TMainForm.GrammarTest(AFollowSet, AStopSet: TSymbolSet; AErrorNo: Integer);
begin
  if not (Sym in AFollowSet) then
  begin
    PutErrorToList(AErrorNo);
    while not (Sym in AFollowSet + AStopSet) do
    begin
      GetSym;
    end;
  end;
end;

/////////////////////////////////////////////////////////////////////////////
//                    错误报告
/////////////////////////////////////////////////////////////////////////////
procedure TMainForm.ErrorFromFile(ErrorFileName:String);
var
    s:Tstringlist;
    i:integer;
begin
    s:=Tstringlist.Create;
    i:=0;
    s.LoadFromFile(ErrorFileName);
    While i<>s.Count do
    begin
        sError[i]:= s.Strings[i];
        inc(i);
    end;
end;

procedure TMainForm.PutErrorToList(ErrorNo : integer);
begin
    ErrorList.Add(Format('[error]Line(%d):%s',[Linenum,sError[ErrorNo]]));
    inc(ErrorIdx);
end;

/////////////////////////////////////////////////////////////////////////////
//                             执行指令
/////////////////////////////////////////////////////////////////////////////

//-----------------------------------------------------------
//  LIT
//-----------------------------------------------------------
procedure TMainForm.pLit(ParamA,ParamB: integer);
begin
    DataPush(ParamB);
end;



//-----------------------------------------------------------
//  LOD
//-----------------------------------------------------------
procedure TMainForm.pLod(ParamA,ParamB: integer);
begin
    DataPush(VarData[ParamB].FValue);
end;


//-----------------------------------------------------------
//  STO
//-----------------------------------------------------------
procedure TMainForm.pSto(ParamA,ParamB: integer);
begin
    vardata[ParamB].FValue := DataPop;
end;


//-----------------------------------------------------------
//  JMP
//-----------------------------------------------------------
procedure TMainForm.pJmp(ParamA,ParamB: integer);
begin
    CodeIndex := ParamB;
end;


//-----------------------------------------------------------
//  JPC
//-----------------------------------------------------------
procedure TMainForm.pJpc(ParamA,ParamB: integer);
begin
  if DataPop = 1 then
      Inc(CodeIndex)
  else CodeIndex := ParamB;
end;

//-----------------------------------------------------------
//  OPR
//-----------------------------------------------------------
procedure TMainForm.pOpr(ParamA,ParamB: integer);
var
    iResult: integer;
begin
  case ParamB of
  0:   //Exit Program
    begin
     // Print(PChar('Finish Run'));
    end;

  1:   //-a
    begin
      iResult := - DataPop;
    end;


  2:   //a+b
    begin
      iResult := DataPop + DataPop;
    end;


  3:   //a-b 
    begin
      iResult := DataPop;
      iResult := DataPop - iResult;
    end;


  4:   //a*b
    begin
      iResult := DataPop * DataPop;
    end;


  5:   //a/b
    begin
      iResult := DataPop;
      iResult := DataPop div iResult;
    end;


  8:   //a==b
    begin
      if DataPop=DataPop then iResult := 1 else iResult := 0;
    end;


  9:   //a<>b
    begin
      if DataPop<>DataPop then iResult := 1 else iResult := 0;
    end;


  10:  //a<b
    begin
      iResult := DataPop;
      if DataPop<iResult then iResult := 1 else iResult := 0;
    end;


  11:  //a>=b 
    begin
      iResult := DataPop;
      if DataPop>=iResult then iResult := 1 else iResult := 0;
    end;


  12:  //a>b  
    begin 
      iResult := DataPop;
      if DataPop>iResult then iResult := 1 else iResult := 0;
    end;


  13:  //a<=b  
    begin 
      iResult := DataPop;
      if DataPop<=iResult then iResult := 1 else iResult := 0;
    end;


  14:  //and  
    begin
      if (DataPop=0) or (DataPop=0) then  iResult := 0 else iResult := 1;
    end;


  15:  //or   
    begin
      if (DataPop=1) or (DataPop=1) then  iResult := 1 else iResult := 0;
    end;


  16:  //not 
    begin
      if DataPop = 0 then iResult := 1 else iResult := 0;
    end;

  end;  //end of case

  //Push Result
  DataPush(iResult );

end;


//-----------------------------------------------------------
//  OUT
//-----------------------------------------------------------
procedure TMainForm.pOut(ParamA,ParamB: integer);
var
  sOut: string;
begin
  sOut := Format('>%d',[DataPop]);
  ListBox1.Items.Add(sOut);
end;

//*************************************************************
//   DataPush
//*************************************************************
procedure TMainForm.DataPush(data:integer);
begin
    Inc(StackDataCount);
    StackData[StackDataCount] := data;
end;

//**************************************************************
//    DataPop
//**************************************************************
function TMainForm.DataPop: integer;
begin
  if StackDataCount < 0 then
      ShowMessage('空栈不能操作')
  else
  begin
    Result := StackData[StackDataCount];
    Dec(StackDataCount);
  end;            
end;

/////////////////////////////////////////////////////////////////////////////
function SymbolNameToString(ASymName: Symbol): string;
begin
  case ASymName of
  Nul:                Result:= 'Nul';
  Aident:             Result:= 'Aident';
  Bident:             Result:= 'Bident';
  Number:             Result:= 'Number';
  Plus:               Result:= 'Plus';
  Minus:              Result:= 'Minus';
  Times:              Result:= 'Times';
  Slash:              Result:= 'Slash';
  Eql:                Result:= 'Eql';
  Neq:                Result:= 'Neq';
  Lss:                Result:= 'Lss';
  Leq:                Result:= 'Leq';
  Gtr:                Result:= 'Gtr';
  Geq:                Result:= 'Geq';
  Lparen:             Result:= 'Lparen';
  Rparen:             Result:= 'Rparen';
  Comma:              Result:= 'Comma';
  Semicolon:          Result:= 'Semicolon';
  Period:             Result:= 'Period';
  Becomes:            Result:= 'Becomes';
  ProgSym:            Result:= 'ProgSym';
  IntegerSym:         Result:= 'IntegerSym';
  LogicalSym:         Result:= 'LogicalSym';
  IfSym:              Result:= 'IfSym';     
  ThenSym:            Result:= 'ThenSym';
  ElseSym:            Result:= 'ElseSym';   
  WhileSym:           Result:= 'WhileSym';  
  RepeatSym:          Result:= 'RepeatSym';
  BeginSym:           Result:= 'BeginSym';
  EndSym:             Result:= 'EndSym';    
  OrSym:              Result:= 'OrSym';
  AndSym:             Result:= 'AndSym';
  NotSym:             Result:= 'NotSym';
  TrueSym:            Result:= 'TrueSym';
  FalseSym:           Result:= 'FalseSym';
  DoSym:              Result:= 'DoSym';
  UntilSym:           Result:= 'UntilSym';
  WriteSym:           Result:= 'WriteSym';
  else                  Result:= 'Error';
  end;
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin

    Edit1.Text:= SymbolNameToString(GetSym);
end;

procedure TMainForm.Button3Click(Sender: TObject);
begin
     ch:=GetChar;
end;
//***********************************************************************
//
//                 程序运行
//
//***********************************************************************
procedure TMainForm.Button4Click(Sender: TObject);
var
  idx: integer;
  sLine, code: string;
begin
    idx:=0;
    Initial;
    InitialSymbol;
    sym:=ProgSym;
    main_program([ProgSym]) ;

   //输出指令集
    if ErrorIdx<=0 then
    begin
      begin
        while idx <= CodeCount do
        begin
          sLine := Format('%s %d %d', [ CodeList[idx].Ins, CodeList[idx].ParamA, CodeList[idx].ParamB]);
          ListBox2.Items.Strings[idx]:=sLine;

          inc(idx);
        end;
      end;

    //执行指令
      while CodeIndex <= CodeCount do
      begin

      with CodeList[CodeIndex] do
          begin
              if ins='LIT' then  pLit(ParamA,ParamB)
              else if ins='STO' then pSto(ParamA,ParamB)
              else if ins='LOD' then pLod(ParamA,ParamB)
              else if ins='OPR' then pOpr(ParamA,ParamB)
              else if ins='JMP' then pJmp(ParamA,ParamB)
              else if ins='JPC' then pJpc(ParamA,ParamB)
              else if ins='OUT' then pOut(ParamA,ParamB);

              if ins <>'JMP' then
                if ins<>'JPC' then
                   Inc(CodeIndex);
          end;
      end;
    end;

    idx:=0;
    while idx<ErrorIdx do
    begin
        ListBox3.Items.Add(ErrorList.Strings[idx]);
        inc(idx);
    end;
//    ListBox3.Items.AddStrings(TestShowVarList);


  end;  //End of FOR
///////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////
// TEST: SHOW VARIABLE LIST
function TMainForm.TestShowVarList: TStrings;
var i: integer;
    s: string;
    list: TStrings;
begin
  list := TStringList.Create ;
  List.Clear;
  for i:= 1 to VarCount do
  begin
    //Name
    s:=VarData[i].FIdent;

    //Type
    if VarData[i].FType = obInteger then
      s:=s+'  [Integer]'
    else if VarData[i].FType = obLogical then
      s:=s+'  [Logical]'
    else
      s:=s+'  [Unknown]';

    //Value
    s:=s+'  '+IntToStr(VarData[i].FValue);
    List.Add(s);
  end;

  Result := List;
end;


procedure TMainForm.ListBox3DblClick(Sender: TObject);
var idx:integer;
begin
    idx:=ListBox3.ItemIndex;
end;

end.