Changeset 217 for branches/CpuSingleSize
- Timestamp:
- Oct 14, 2020, 7:34:55 PM (4 years ago)
- 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
-
Property svn:ignore
set to
-
branches/CpuSingleSize/CpuSingleSize.lpi
r216 r217 75 75 </Item2> 76 76 </RequiredPackages> 77 <Units Count="1 7">77 <Units Count="18"> 78 78 <Unit0> 79 79 <Filename Value="CpuSingleSize.lpr"/> … … 171 171 <ResourceBaseClass Value="Form"/> 172 172 </Unit16> 173 <Unit17> 174 <Filename Value="UParser.pas"/> 175 <IsPartOfProject Value="True"/> 176 </Unit17> 173 177 </Units> 174 178 </ProjectOptions> -
branches/CpuSingleSize/CpuSingleSize.lpr
r216 r217 10 10 Forms, UFormMain, UCpu, UAssembler, UInstructions, UFormScreen, UMachine, 11 11 UFormCpu, UFormConsole, UFormAssembler, UCore, UFormDisassembler, 12 UDisassembler, UMemory, UFormMessages, UMessages, SysUtils, UFormHelp ;12 UDisassembler, UMemory, UFormMessages, UMessages, SysUtils, UFormHelp, UParser; 13 13 14 14 {$R *.res} -
branches/CpuSingleSize/Forms/UFormMessages.lfm
r216 r217 30 30 ViewStyle = vsReport 31 31 OnData = ListView1Data 32 OnDblClick = ListView1DblClick 32 33 end 33 34 end -
branches/CpuSingleSize/Forms/UFormMessages.pas
r216 r217 15 15 ListView1: TListView; 16 16 procedure ListView1Data(Sender: TObject; Item: TListItem); 17 procedure ListView1DblClick(Sender: TObject); 17 18 private 18 19 public … … 29 30 30 31 uses 31 UCore, UMessages ;32 UCore, UMessages, UFormAssembler; 32 33 33 34 { TFormMessages } … … 44 45 end; 45 46 47 procedure TFormMessages.ListView1DblClick(Sender: TObject); 48 begin 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; 54 end; 55 46 56 procedure TFormMessages.Reload; 47 57 begin -
branches/CpuSingleSize/Sample.asm
r216 r217 1 DB Start 2 DB KeyInterrupt 1 DB Start, KeyInterrupt 3 2 NOP 4 3 NOP 5 4 NOP 6 5 6 ORG 16 7 7 Start: 8 8 -
branches/CpuSingleSize/UAssembler.pas
r216 r217 6 6 7 7 uses 8 Classes, SysUtils, UInstructions, UCpu, Generics.Collections, StrUtils,9 UMemory, UMessages ;8 Classes, SysUtils, UInstructions, UCpu, Generics.Collections, 9 UMemory, UMessages, UParser; 10 10 11 11 type 12 TErrorEvent = procedure (Text: string; Pos: TPoint) of object;13 14 12 { TLabelRef } 15 13 … … 21 19 end; 22 20 23 TTokenKind = (tkKeyword, tkString, tkNumber, tkSpecialSymbol, tkEof, tkIdentifier);24 25 TToken = record26 Kind: TTokenKind;27 Value: string;28 Pos: TPoint;29 end;30 31 { TParserPos }32 33 TParserPos = record34 Index: Integer;35 Pos: TPoint;36 procedure Reset;37 procedure NextChar;38 procedure NextLine;39 end;40 41 { TParser }42 43 TParser = class44 private45 FOnError: TErrorEvent;46 public47 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 63 21 { TAssembler } 64 22 … … 67 25 FOnError: TErrorEvent; 68 26 Parser: TParser; 27 function ParseDb: Boolean; 28 function ParseOrg: Boolean; 29 function ParseInstruction: Boolean; 30 function ParseLabel: Boolean; 69 31 procedure UpdateLabelRefs; 70 32 procedure ParseNumParam(Token: TToken); … … 87 49 implementation 88 50 89 { TParserPos }90 91 procedure TParserPos.Reset;92 begin93 Index := 1;94 Pos := Point(1, 1);95 end;96 97 procedure TParserPos.NextChar;98 begin99 Inc(Index);100 Inc(Pos.X);101 end;102 103 procedure TParserPos.NextLine;104 begin105 Inc(Index);106 Pos.X := 1;107 Inc(Pos.Y);108 end;109 110 { TParser }111 112 function TParser.IsDigit(Value: Char): Boolean;113 begin114 Result := Value in ['0'..'9'];115 end;116 117 function TParser.IsSpecialSymbol(C: Char): Boolean;118 begin119 Result := (C = ':') or (C = ',');120 end;121 122 function TParser.IsAlpha(C: Char): Boolean;123 begin124 Result := (C in ['a'..'z']) or (C in ['A'..'Z']);125 end;126 127 function TParser.IsAlphaNumeric(C: Char): Boolean;128 begin129 Result := IsAlpha(C) or IsDigit(C) or (C = '_');130 end;131 132 function TParser.IsWhiteSpace(C: Char): Boolean;133 begin134 Result := (C = ' ') or (C = #9);135 end;136 137 function TParser.ReadNext: TToken;138 type139 TParserState = (psNone, psNumber, psString, psComment, psIdentifier);140 var141 C: Char;142 State: TParserState;143 begin144 State := psNone;145 Result.Value := '';146 while Pos.Index < Length(Source) do begin147 C := Source[Pos.Index];148 if State = psNone then begin149 if IsWhiteSpace(C) then begin150 end else151 if C = ';' then begin152 State := psComment;153 end else154 if IsAlpha(C) then begin155 Result.Pos := Pos.Pos;156 Result.Kind := tkIdentifier;157 Result.Value := C;158 State := psIdentifier;159 end else160 if IsDigit(C) then begin161 Result.Pos := Pos.Pos;162 Result.Kind := tkNumber;163 Result.Value := C;164 State := psNumber;165 end else166 if C = '''' then begin167 Result.Pos := Pos.Pos;168 Result.Kind := tkString;169 State := psString;170 end else171 if C = #10 then begin172 Pos.NextLine;173 Continue;174 end else175 if IsSpecialSymbol(C) then begin176 Result.Pos := Pos.Pos;177 Result.Kind := tkSpecialSymbol;178 Result.Value := C;179 Pos.NextChar;180 Break;181 end else182 Error('Unknown character ' + C, Pos.Pos);183 end else184 if State = psIdentifier then begin185 if IsAlphaNumeric(C) then begin186 Result.Value := Result.Value + C;187 end else begin188 Break;189 end;190 end else191 if State = psComment then begin192 if (C = #10) or (C = #13) then begin193 State := psNone;194 Continue;195 end;196 end else197 if State = psNumber then begin198 if IsDigit(C) then Result.Value := Result.Value + C199 else begin200 Break;201 end;202 end else203 if State = psString then begin204 if C = '''' then begin205 Pos.NextChar;206 Break;207 end else begin208 Result.Value := Result.Value + C;209 end;210 end;211 Pos.NextChar;212 end;213 if (State = psNone) and (Pos.Index >= Length(Source)) then begin214 Result.Kind := tkEof;215 Result.Value := '';216 end;217 end;218 219 function TParser.CheckNext(Kind: TTokenKind; Value: string = ''): Boolean;220 var221 LastPos: TParserPos;222 Token: TToken;223 begin224 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 var232 LastPos: TParserPos;233 Token: TToken;234 begin235 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 var243 Token: TToken;244 begin245 Token := ReadNext;246 if (Token.Kind <> Kind) or (Token.Value <> Value) then247 Error('Expected ' + Value + ' but ' + Token.Value +' found.', Token.Pos);248 end;249 250 procedure TParser.Error(Text: string; Pos: TPoint);251 begin252 if Assigned(FOnError) then253 FOnError(Text, Pos);254 end;255 256 constructor TParser.Create;257 begin258 Pos.Reset;259 end;260 261 51 { TLabelRef } 262 52 … … 308 98 309 99 procedure TAssembler.Compile(Source: string); 310 var311 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;321 100 begin 322 101 Messages.Clear; … … 324 103 Labels.Clear; 325 104 LabelRefs.Clear; 105 Parser.Reset; 326 106 Parser.Source := Source; 327 107 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 335 110 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); 367 119 UpdateLabelRefs; 368 120 Error('Compilation finished.', Point(0, 0)); 121 end; 122 123 function TAssembler.ParseDb: Boolean; 124 var 125 Token: TToken; 126 begin 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; 142 end; 143 144 function TAssembler.ParseOrg: Boolean; 145 var 146 Token: TToken; 147 begin 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; 156 end; 157 158 function TAssembler.ParseInstruction: Boolean; 159 var 160 InstructionInfo: TInstructionInfo; 161 I: Integer; 162 Token: TToken; 163 LastPos: TParserPos; 164 begin 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; 188 end; 189 190 function TAssembler.ParseLabel: Boolean; 191 var 192 LastPos: TParserPos; 193 Token: TToken; 194 Addr: Integer; 195 begin 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; 369 206 end; 370 207 -
branches/CpuSingleSize/UMemory.pas
r216 r217 25 25 Position: Integer; 26 26 procedure Write(Value: TInteger); 27 procedure WriteString(Value: string); 27 28 procedure WriteMemory(Memory: TMemory); 28 29 function Read: TInteger; … … 81 82 procedure TMemory.Write(Value: TInteger); 82 83 begin 83 if Position >=FSize then Size := Position + 1;84 if Position + 1 > FSize then Size := Position + 1; 84 85 Data[Position] := Value; 85 86 Inc(Position); 87 end; 88 89 procedure TMemory.WriteString(Value: string); 90 var 91 I: Integer; 92 begin 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; 86 99 end; 87 100 … … 91 104 if Position + Memory.Size > FSize then Size := Position + Memory.Size; 92 105 Move(Memory.Data[0], Data[Position], Memory.Size * SizeOf(TInteger)); 106 Inc(Position, Memory.Size); 93 107 end; 94 108 end;
Note:
See TracChangeset
for help on using the changeset viewer.