Changeset 217 for branches


Ignore:
Timestamp:
Oct 14, 2020, 7:34:55 PM (4 years ago)
Author:
chronos
Message:
  • Modified: Improved assembler parsing.
  • Modified: TParser moved to separate unit.
Location:
branches/CpuSingleSize
Files:
1 added
8 edited

Legend:

Unmodified
Added
Removed

  • branches/CpuSingleSize

    • Property svn:ignore set to
      heaptrclog.trc
      lib
      CpuSingleSize
      CpuSingleSize.lps
      CpuSingleSize.res
      CpuSingleSize.dbg

  • branches/CpuSingleSize/CpuSingleSize.lpi

    r216 r217  
    7575      </Item2>
    7676    </RequiredPackages>
    77     <Units Count="17">
     77    <Units Count="18">
    7878      <Unit0>
    7979        <Filename Value="CpuSingleSize.lpr"/>
    … …  
    171171        <ResourceBaseClass Value="Form"/>
    172172      </Unit16>
     173      <Unit17>
     174        <Filename Value="UParser.pas"/>
     175        <IsPartOfProject Value="True"/>
     176      </Unit17>
    173177    </Units>
    174178  </ProjectOptions>

  • branches/CpuSingleSize/CpuSingleSize.lpr

    r216 r217  
    1010  Forms, UFormMain, UCpu, UAssembler, UInstructions, UFormScreen, UMachine,
    1111  UFormCpu, UFormConsole, UFormAssembler, UCore, UFormDisassembler,
    12   UDisassembler, UMemory, UFormMessages, UMessages, SysUtils, UFormHelp;
     12  UDisassembler, UMemory, UFormMessages, UMessages, SysUtils, UFormHelp, UParser;
    1313
    1414{$R *.res}

  • branches/CpuSingleSize/Forms/UFormMessages.lfm

    r216 r217  
    3030    ViewStyle = vsReport
    3131    OnData = ListView1Data
     32    OnDblClick = ListView1DblClick
    3233  end
    3334end

  • branches/CpuSingleSize/Forms/UFormMessages.pas

    r216 r217  
    1515    ListView1: TListView;
    1616    procedure ListView1Data(Sender: TObject; Item: TListItem);
     17    procedure ListView1DblClick(Sender: TObject);
    1718  private
    1819  public
    … …  
    2930
    3031uses
    31   UCore, UMessages;
     32  UCore, UMessages, UFormAssembler;
    3233
    3334{ TFormMessages }
    … …  
    4445end;
    4546
     47procedure TFormMessages.ListView1DblClick(Sender: TObject);
     48begin
     49  if Assigned(ListView1.Selected) then begin
     50    FormAssembler.SynEdit1.CaretXY := TMessage(ListView1.Selected.Data).Position;
     51    FormAssembler.SynEdit1.SetFocus;
     52    FormAssembler.Show;
     53  end;
     54end;
     55
    4656procedure TFormMessages.Reload;
    4757begin

  • branches/CpuSingleSize/Sample.asm

    r216 r217  
    1      DB   Start
    2      DB   KeyInterrupt
     1     DB   Start, KeyInterrupt
    32     NOP
    43     NOP
    54     NOP
    65     
     6     ORG 16
    77Start:
    88 

  • branches/CpuSingleSize/UAssembler.pas

    r216 r217  
    66
    77uses
    8   Classes, SysUtils, UInstructions, UCpu, Generics.Collections, StrUtils,
    9   UMemory, UMessages;
     8  Classes, SysUtils, UInstructions, UCpu, Generics.Collections,
     9  UMemory, UMessages, UParser;
    1010
    1111type
    12   TErrorEvent = procedure (Text: string; Pos: TPoint) of object;
    13 
    1412  { TLabelRef }
    1513
    … …  
    2119  end;
    2220
    23   TTokenKind = (tkKeyword, tkString, tkNumber, tkSpecialSymbol, tkEof, tkIdentifier);
    24 
    25   TToken = record
    26     Kind: TTokenKind;
    27     Value: string;
    28     Pos: TPoint;
    29   end;
    30 
    31   { TParserPos }
    32 
    33   TParserPos = record
    34     Index: Integer;
    35     Pos: TPoint;
    36     procedure Reset;
    37     procedure NextChar;
    38     procedure NextLine;
    39   end;
    40 
    41   { TParser }
    42 
    43   TParser = class
    44   private
    45     FOnError: TErrorEvent;
    46   public
    47     Pos: TParserPos;
    48     Source: string;
    49     function IsDigit(Value: Char): Boolean;
    50     function IsSpecialSymbol(C: Char): Boolean;
    51     function IsAlpha(C: Char): Boolean;
    52     function IsAlphaNumeric(C: Char): Boolean;
    53     function IsWhiteSpace(C: Char): Boolean;
    54     function ReadNext: TToken;
    55     function CheckNext(Kind: TTokenKind; Value: string = ''): Boolean;
    56     function CheckNextKind(Kind: TTokenKind): Boolean;
    57     procedure Expect(Kind: TTokenKind; Value: string);
    58     procedure Error(Text: string; Pos: TPoint);
    59     constructor Create;
    60     property OnError: TErrorEvent read FOnError write FOnError;
    61   end;
    62 
    6321  { TAssembler }
    6422
    … …  
    6725    FOnError: TErrorEvent;
    6826    Parser: TParser;
     27    function ParseDb: Boolean;
     28    function ParseOrg: Boolean;
     29    function ParseInstruction: Boolean;
     30    function ParseLabel: Boolean;
    6931    procedure UpdateLabelRefs;
    7032    procedure ParseNumParam(Token: TToken);
    … …  
    8749implementation
    8850
    89 { TParserPos }
    90 
    91 procedure TParserPos.Reset;
    92 begin
    93   Index := 1;
    94   Pos := Point(1, 1);
    95 end;
    96 
    97 procedure TParserPos.NextChar;
    98 begin
    99   Inc(Index);
    100   Inc(Pos.X);
    101 end;
    102 
    103 procedure TParserPos.NextLine;
    104 begin
    105   Inc(Index);
    106   Pos.X := 1;
    107   Inc(Pos.Y);
    108 end;
    109 
    110 { TParser }
    111 
    112 function TParser.IsDigit(Value: Char): Boolean;
    113 begin
    114   Result := Value in ['0'..'9'];
    115 end;
    116 
    117 function TParser.IsSpecialSymbol(C: Char): Boolean;
    118 begin
    119   Result := (C = ':') or (C = ',');
    120 end;
    121 
    122 function TParser.IsAlpha(C: Char): Boolean;
    123 begin
    124   Result := (C in ['a'..'z']) or (C in ['A'..'Z']);
    125 end;
    126 
    127 function TParser.IsAlphaNumeric(C: Char): Boolean;
    128 begin
    129   Result := IsAlpha(C) or IsDigit(C) or (C = '_');
    130 end;
    131 
    132 function TParser.IsWhiteSpace(C: Char): Boolean;
    133 begin
    134   Result := (C = ' ') or (C = #9);
    135 end;
    136 
    137 function TParser.ReadNext: TToken;
    138 type
    139   TParserState = (psNone, psNumber, psString, psComment, psIdentifier);
    140 var
    141   C: Char;
    142   State: TParserState;
    143 begin
    144   State := psNone;
    145   Result.Value := '';
    146   while Pos.Index < Length(Source) do begin
    147     C := Source[Pos.Index];
    148     if State = psNone then begin
    149       if IsWhiteSpace(C) then begin
    150       end else
    151       if C = ';' then begin
    152         State := psComment;
    153       end else
    154       if IsAlpha(C) then begin
    155         Result.Pos := Pos.Pos;
    156         Result.Kind := tkIdentifier;
    157         Result.Value := C;
    158         State := psIdentifier;
    159       end else
    160       if IsDigit(C) then begin
    161         Result.Pos := Pos.Pos;
    162         Result.Kind := tkNumber;
    163         Result.Value := C;
    164         State := psNumber;
    165       end else
    166       if C = '''' then begin
    167         Result.Pos := Pos.Pos;
    168         Result.Kind := tkString;
    169         State := psString;
    170       end else
    171       if C = #10 then begin
    172         Pos.NextLine;
    173         Continue;
    174       end else
    175       if IsSpecialSymbol(C) then begin
    176         Result.Pos := Pos.Pos;
    177         Result.Kind := tkSpecialSymbol;
    178         Result.Value := C;
    179         Pos.NextChar;
    180         Break;
    181       end else
    182         Error('Unknown character ' + C, Pos.Pos);
    183     end else
    184     if State = psIdentifier then begin
    185       if IsAlphaNumeric(C) then begin
    186         Result.Value := Result.Value + C;
    187       end else begin
    188         Break;
    189       end;
    190     end else
    191     if State = psComment then begin
    192       if (C = #10) or (C = #13) then begin
    193         State := psNone;
    194         Continue;
    195       end;
    196     end else
    197     if State = psNumber then begin
    198       if IsDigit(C) then Result.Value := Result.Value + C
    199       else begin
    200         Break;
    201       end;
    202     end else
    203     if State = psString then begin
    204       if C = '''' then begin
    205         Pos.NextChar;
    206         Break;
    207       end else begin
    208         Result.Value := Result.Value + C;
    209       end;
    210     end;
    211     Pos.NextChar;
    212   end;
    213   if (State = psNone) and (Pos.Index >= Length(Source)) then begin
    214     Result.Kind := tkEof;
    215     Result.Value := '';
    216   end;
    217 end;
    218 
    219 function TParser.CheckNext(Kind: TTokenKind; Value: string = ''): Boolean;
    220 var
    221   LastPos: TParserPos;
    222   Token: TToken;
    223 begin
    224   LastPos := Pos;
    225   Token := ReadNext;
    226   Result := (Token.Kind = Kind) and (Token.Value = Value);
    227   Pos := LastPos;
    228 end;
    229 
    230 function TParser.CheckNextKind(Kind: TTokenKind): Boolean;
    231 var
    232   LastPos: TParserPos;
    233   Token: TToken;
    234 begin
    235   LastPos := Pos;
    236   Token := ReadNext;
    237   Result := Token.Kind = Kind;
    238   Pos := LastPos;
    239 end;
    240 
    241 procedure TParser.Expect(Kind: TTokenKind; Value: string);
    242 var
    243   Token: TToken;
    244 begin
    245   Token := ReadNext;
    246   if (Token.Kind <> Kind) or (Token.Value <> Value) then
    247     Error('Expected ' + Value + ' but ' + Token.Value +' found.', Token.Pos);
    248 end;
    249 
    250 procedure TParser.Error(Text: string; Pos: TPoint);
    251 begin
    252   if Assigned(FOnError) then
    253     FOnError(Text, Pos);
    254 end;
    255 
    256 constructor TParser.Create;
    257 begin
    258   Pos.Reset;
    259 end;
    260 
    26151{ TLabelRef }
    26252
    … …  
    30898
    30999procedure TAssembler.Compile(Source: string);
    310 var
    311   I: Integer;
    312   J: Integer;
    313   Name: string;
    314   Value: string;
    315   Line: string;
    316   Addr: Integer;
    317   LabelName: string;
    318   LabelRef: TLabelRef;
    319   InstructionInfo: TInstructionInfo;
    320   Token: TToken;
    321100begin
    322101  Messages.Clear;
    … …  
    324103  Labels.Clear;
    325104  LabelRefs.Clear;
     105  Parser.Reset;
    326106  Parser.Source := Source;
    327107  while not Parser.CheckNextKind(tkEof) do begin
    328     Token := Parser.ReadNext;
    329     if Parser.CheckNext(tkSpecialSymbol, ':') then begin
    330       Parser.Expect(tkSpecialSymbol, ':');
    331       LabelName := Token.Value;
    332       if not Labels.TryGetValue(LabelName, Addr) then begin
    333         Labels.Add(LabelName, Memory.Position);
    334       end else Error('Duplicate label ' + LabelName + '.', Token.Pos);
     108    ParseLabel;
     109    if ParseDb then begin
    335110    end else
    336     if Token.Kind = tkIdentifier then begin
    337       if LowerCase(Token.Value) = 'db' then begin
    338         Token := Parser.ReadNext;
    339         if Token.Kind = tkString then begin
    340           for J := 1 to Length(Token.Value) do
    341             Memory.Write(Ord(Token.Value[J]));
    342         end else
    343           ParseNumParam(Token);
    344         Continue;
    345       end else begin
    346         InstructionInfo := InstructionSet.SearchName(Token.Value);
    347         if Assigned(InstructionInfo) then begin
    348           Memory.Write(Integer(InstructionInfo.Instruction));
    349           for J := 0 to Length(InstructionInfo.Params) - 1 do begin
    350             if J > 0 then
    351               Parser.Expect(tkSpecialSymbol, ',');
    352             Token := Parser.ReadNext;
    353             if InstructionInfo.Params[J] = ptReg then begin
    354               if (Token.Value <> '') and (Token.Value[1] = 'R') then
    355                 Token.Value := Copy(Token.Value, 2, MaxInt)
    356                 else Error('Expected register name.', Token.Pos);
    357               Memory.Write(StrToInt(Token.Value));
    358             end else
    359             if InstructionInfo.Params[J] = ptNumber then begin
    360               ParseNumParam(Token);
    361             end;
    362           end;
    363         end else Error('Unknown keyword ' + Token.Value, Token.Pos);
    364       end;
    365     end;
    366   end;
     111    if ParseOrg then begin
     112    end else
     113    if ParseInstruction then begin
     114    end;
     115    if Parser.CheckNextKind(tkEof) then begin
     116    end else Parser.Expect(tkEol);
     117  end;
     118  Parser.Expect(tkEof);
    367119  UpdateLabelRefs;
    368120  Error('Compilation finished.', Point(0, 0));
     121end;
     122
     123function TAssembler.ParseDb: Boolean;
     124var
     125  Token: TToken;
     126begin
     127  Result := False;
     128  if Parser.CheckNextAndRead(tkIdentifier, 'DB') then begin
     129    Result := True;
     130    while True do begin
     131      Token := Parser.ReadNext;
     132      if Token.Kind = tkString then begin
     133        Memory.WriteString(Token.Value);
     134      end else
     135        ParseNumParam(Token);
     136      if Parser.CheckNextAndRead(tkSpecialSymbol, ',') then begin
     137        Continue;
     138      end;
     139      Break;
     140    end;
     141  end;
     142end;
     143
     144function TAssembler.ParseOrg: Boolean;
     145var
     146  Token: TToken;
     147begin
     148  Result := False;
     149  if Parser.CheckNextAndRead(tkIdentifier, 'ORG') then begin
     150    Result := True;
     151    Token := Parser.ReadNext;
     152    if Token.Kind = tkNumber then begin
     153      Memory.Position := StrToInt(Token.Value);
     154    end else Error('Expected number but ' + Token.Value + ' found.', Token.Pos);
     155  end;
     156end;
     157
     158function TAssembler.ParseInstruction: Boolean;
     159var
     160  InstructionInfo: TInstructionInfo;
     161  I: Integer;
     162  Token: TToken;
     163  LastPos: TParserPos;
     164begin
     165  Result := False;
     166  LastPos := Parser.Pos;
     167  Token := Parser.ReadNext;
     168  InstructionInfo := InstructionSet.SearchName(Token.Value);
     169  if Assigned(InstructionInfo) then begin
     170    Result := True;
     171    Memory.Write(Integer(InstructionInfo.Instruction));
     172    for I := 0 to Length(InstructionInfo.Params) - 1 do begin
     173      if I > 0 then
     174        Parser.Expect(tkSpecialSymbol, ',');
     175      Token := Parser.ReadNext;
     176      if InstructionInfo.Params[I] = ptReg then begin
     177        if (Token.Value <> '') and (Token.Value[1] = 'R') then
     178          Token.Value := Copy(Token.Value, 2, MaxInt)
     179          else Error('Expected register name.', Token.Pos);
     180        Memory.Write(StrToInt(Token.Value));
     181      end else
     182      if InstructionInfo.Params[I] = ptNumber then begin
     183        ParseNumParam(Token);
     184      end;
     185    end;
     186  end;
     187  if not Result then Parser.Pos := LastPos;
     188end;
     189
     190function TAssembler.ParseLabel: Boolean;
     191var
     192  LastPos: TParserPos;
     193  Token: TToken;
     194  Addr: Integer;
     195begin
     196  Result := False;
     197  LastPos := Parser.Pos;
     198  Token := Parser.ReadNext;
     199  if Parser.CheckNextAndRead(tkSpecialSymbol, ':') then begin
     200    Result := True;
     201    if not Labels.TryGetValue(Token.Value, Addr) then begin
     202      Labels.Add(Token.Value, Memory.Position);
     203    end else Error('Duplicate label ' + Token.Value + '.', Token.Pos);
     204  end;
     205  if not Result then Parser.Pos := LastPos;
    369206end;
    370207

  • branches/CpuSingleSize/UMemory.pas

    r216 r217  
    2525    Position: Integer;
    2626    procedure Write(Value: TInteger);
     27    procedure WriteString(Value: string);
    2728    procedure WriteMemory(Memory: TMemory);
    2829    function Read: TInteger;
    … …  
    8182procedure TMemory.Write(Value: TInteger);
    8283begin
    83   if Position >= FSize then Size := Position + 1;
     84  if Position + 1 > FSize then Size := Position + 1;
    8485  Data[Position] := Value;
    8586  Inc(Position);
     87end;
     88
     89procedure TMemory.WriteString(Value: string);
     90var
     91  I: Integer;
     92begin
     93  if Length(Value) > 0 then begin
     94    if Position + Length(Value) > FSize then Size := Position + Length(Value);
     95    for I := 0 to Length(Value) - 1 do
     96      Data[Position + I] := Ord(Value[I + 1]);
     97    Inc(Position, Length(Value));
     98  end;
    8699end;
    87100
    … …  
    91104    if Position + Memory.Size > FSize then Size := Position + Memory.Size;
    92105    Move(Memory.Data[0], Data[Position], Memory.Size * SizeOf(TInteger));
     106    Inc(Position, Memory.Size);
    93107  end;
    94108end;
Note: See TracChangeset for help on using the changeset viewer.