source: branches/ByteArray/Assembler.pas

Last change on this file was 11, checked in by chronos, 17 months ago
  • Modified: Updated Common package.
  • Fixed: Wrong return address from CALL instruction.
File size: 14.8 KB
Line 
1unit Assembler;
2
3interface
4
5uses
6 Classes, SysUtils, Instructions, Cpu, Generics.Collections, Int,
7 IntMemory, Message, Parser;
8
9type
10 { TLabelRef }
11
12 TLabelRef = record
13 LabelName: string;
14 RefPos: Integer;
15 TextPos: TPoint;
16 class function Create(LabelName: string; RefPos: Integer; TextPos: TPoint): TLabelRef; static;
17 end;
18
19 { TAssembler }
20
21 TAssembler = class
22 private
23 FOnError: TErrorEvent;
24 Parser: TParser;
25 InstDataWidth: TIntSize;
26 InstAddressWidth: TIntSize;
27 function ParseVar: Boolean;
28 function ParseDb: Boolean;
29 function ParseOrg: Boolean;
30 function ParseInstruction: Boolean;
31 function ParseInstructionParameter(ParamType: TParamType; Memory: TMemory;
32 Offset: Integer): Boolean;
33 function ParseLabel: Boolean;
34 procedure UpdateLabelRefs;
35 function ParseNumParam(Offset: Integer; out Number: TInt): Boolean;
36 function ParseReg(out RegIndex: TRegIndex): Boolean;
37 function ParseDataWidth(out Size: TIntSize): Boolean;
38 function ParseAddressWidth(out Size: TIntSize): Boolean;
39 public
40 InstructionSet: TInstructionInfos;
41 Memory: TMemory;
42 Labels: TDictionary<string, TInt>;
43 LabelRefs: TList<TLabelRef>;
44 Variables: TDictionary<string, TInt>;
45 Messages: TMessages;
46 DataWidth: TIntSize;
47 AddressWidth: TIntSize;
48 procedure Error(Text: string; Pos: TPoint);
49 procedure Compile(Source: string);
50 procedure LoadFromFile(FileName: string);
51 function ParseStr(var Text: string; Separator: string): string;
52 constructor Create;
53 destructor Destroy; override;
54 property OnError: TErrorEvent read FOnError write FOnError;
55 end;
56
57
58implementation
59
60resourcestring
61 SCompilationFinished = 'Compilation finished.';
62 SExpectedNumber = 'Expected number.';
63 SExpectedRegisterName = 'Expected register name.';
64 SExpectedNumericIndex = 'Expected numeric register index.';
65 SExpectedVariableName = 'Expected variable name.';
66 SExpectedVariableValue = 'Expected variable value.';
67 SUnsupportedParameterType = 'Unsupported parameter type';
68 SDuplicateLabel = 'Duplicate label %s.';
69 SLabelReferencedButNotDefined = 'Label %s referenced but not defined.';
70 SDuplicateVariableName = 'Duplicate variable name %s';
71 SExpectedParameter = 'Expected parameter';
72 SExpectedParameterType = 'Expected parameter type [%s]';
73 SExpectedNumberButFound = 'Expected number but %s found.';
74
75{ TLabelRef }
76
77class function TLabelRef.Create(LabelName: string; RefPos: Integer; TextPos: TPoint): TLabelRef;
78begin
79 Result.LabelName := LabelName;
80 Result.RefPos := RefPos;
81 Result.TextPos := TextPos;
82end;
83
84{ TAssembler }
85
86procedure TAssembler.UpdateLabelRefs;
87var
88 I: Integer;
89 Addr: TInt;
90begin
91 for I := 0 to LabelRefs.Count - 1 do begin
92 if Labels.TryGetValue(LabelRefs[I].LabelName, Addr) then
93 Memory.Write(LabelRefs[I].RefPos, 1, Addr)
94 else Error(Format(SLabelReferencedButNotDefined, [LabelRefs[I].LabelName]),
95 LabelRefs[I].TextPos);
96 end;
97end;
98
99function TAssembler.ParseNumParam(Offset: Integer; out Number: TInt): Boolean;
100var
101 Token: TToken;
102 LastPos: TParserPos;
103begin
104 LastPos := Parser.Pos;
105 Result := False;
106 Token := Parser.ReadNext;
107 if Token.Kind = tkNumber then begin
108 if TryStrToInt64(Token.Value, Number) then begin
109 Result := True;
110 end;
111 end else
112 if Token.Kind = tkIdentifier then begin;
113 if Variables.TryGetValue(Token.Value, Number) then begin
114 Result := True;
115 end else
116 if Labels.TryGetValue(Token.Value, Number) then begin
117 Result := True;
118 end else begin
119 LabelRefs.Add(TLabelRef.Create(Token.Value, Memory.Position + 1 + Offset, Parser.Pos.Pos));
120 Number := 0;
121 Result := True;
122 end;
123 end;
124 if not Result then Parser.Pos := LastPos;
125end;
126
127function TAssembler.ParseReg(out RegIndex: TRegIndex): Boolean;
128var
129 LastPos: TParserPos;
130 Token: TToken;
131 Index: Integer;
132begin
133 Result := False;
134 LastPos := Parser.Pos;
135 Token := Parser.ReadNext;
136 if (Length(Token.Value) >= 2) and (Token.Value[1] = 'R') then begin
137 if TryStrToInt(Copy(Token.Value, 2, MaxInt), Index) then begin
138 RegIndex := Index;
139 Result := True;
140 end;
141 end;
142 if not Result then Parser.Pos := LastPos;
143end;
144
145function TAssembler.ParseDataWidth(out Size: TIntSize): Boolean;
146var
147 LastPos: TParserPos;
148 Token: TToken;
149 Index: Integer;
150begin
151 Result := False;
152 LastPos := Parser.Pos;
153 Token := Parser.ReadNext;
154 if (Length(Token.Value) >= 2) and (Token.Value[1] = 'D') then begin
155 if TryStrToInt(Copy(Token.Value, 2, MaxInt), Index) then begin
156 Size := Index;
157 Result := True;
158 end;
159 end;
160 if not Result then Parser.Pos := LastPos;
161end;
162
163function TAssembler.ParseAddressWidth(out Size: TIntSize): Boolean;
164var
165 LastPos: TParserPos;
166 Token: TToken;
167 Index: Integer;
168begin
169 Result := False;
170 LastPos := Parser.Pos;
171 Token := Parser.ReadNext;
172 if (Length(Token.Value) >= 2) and (Token.Value[1] = 'A') then begin
173 if TryStrToInt(Copy(Token.Value, 2, MaxInt), Index) then begin
174 Size := Index;
175 Result := True;
176 end;
177 end;
178 if not Result then Parser.Pos := LastPos;
179end;
180
181procedure TAssembler.Error(Text: string; Pos: TPoint);
182begin
183 Messages.AddMessage(Text, Pos);
184 if Assigned(FOnError) then
185 FOnError(Text, Pos);
186end;
187
188procedure TAssembler.Compile(Source: string);
189begin
190 Messages.Clear;
191 Memory.Size := 1000;
192 Memory.Position := 0;
193 Labels.Clear;
194 LabelRefs.Clear;
195 Variables.Clear;
196 Parser.Reset;
197 Parser.Source := Source;
198 while not Parser.CheckNextKind(tkEof) do begin
199 ParseLabel;
200 if ParseVar then begin
201 end else
202 if ParseDb then begin
203 end else
204 if ParseOrg then begin
205 end else
206 if ParseInstruction then begin
207 end;
208 if Parser.CheckNextKind(tkEof) then begin
209 end else Parser.Expect(tkEol);
210 end;
211 Parser.Expect(tkEof);
212 UpdateLabelRefs;
213 Error(SCompilationFinished, Point(0, 0));
214 Memory.Size := Memory.Position;
215end;
216
217function TAssembler.ParseVar: Boolean;
218var
219 TokenName: TToken;
220 TokenValue: TToken;
221 Number: TInt;
222begin
223 Result := False;
224 if Parser.CheckNextAndRead(tkIdentifier, 'VAR') then begin
225 Result := True;
226 while True do begin
227 TokenName := Parser.ReadNext;
228 if TokenName.Kind = tkIdentifier then begin
229 TokenValue := Parser.ReadNext;
230 if TokenValue.Kind = tkNumber then begin
231 if not Labels.ContainsKey(TokenName.Value) and not Variables.ContainsKey(TokenName.Value) then begin
232 if TryStrToInt64(TokenValue.Value, Number) then
233 Variables.Add(TokenName.Value, Number)
234 else Error(SExpectedNumber, TokenValue.Pos);
235 end else Error(Format(SDuplicateVariableName, [TokenName.Value]), TokenName.Pos);
236 end else Error(SExpectedVariableValue, TokenValue.Pos);
237 end else Error(SExpectedVariableName, TokenName.Pos);
238 if Parser.CheckNextAndRead(tkSpecialSymbol, ',') then begin
239 Continue;
240 end;
241 Break;
242 end;
243 end;
244end;
245
246function TAssembler.ParseDb: Boolean;
247var
248 Token: TToken;
249 Number: TInt;
250begin
251 Result := False;
252 if Parser.CheckNextAndRead(tkIdentifier, 'DB') then begin
253 Result := True;
254 while True do begin
255 if ParseNumParam(0, Number) then begin
256 Memory.WritePos(1, Number);
257 end else begin
258 Token := Parser.ReadNext;
259 if Token.Kind = tkString then begin
260 Memory.WriteStringPos(Token.Value);
261 end else
262 if Token.Kind = tkEof then
263 else if Token.Kind = tkEol then
264 else raise Exception.Create(SExpectedParameter);
265 end;
266 if Parser.CheckNextAndRead(tkSpecialSymbol, ',') then begin
267 Continue;
268 end;
269 Break;
270 end;
271 end;
272end;
273
274function TAssembler.ParseOrg: Boolean;
275var
276 Token: TToken;
277begin
278 Result := False;
279 if Parser.CheckNextAndRead(tkIdentifier, 'ORG') then begin
280 Result := True;
281 Token := Parser.ReadNext;
282 if Token.Kind = tkNumber then begin
283 Memory.Position := StrToInt(Token.Value);
284 end else Error(Format(SExpectedNumberButFound, [Token.Value]), Token.Pos);
285 end;
286end;
287
288function TAssembler.ParseInstruction: Boolean;
289var
290 InstructionInfos: TInstructionInfos;
291 I: Integer;
292 Token: TToken;
293 LastPos: TParserPos;
294 J: Integer;
295 AllowedParams: set of TParamType;
296 ParamType: TParamType;
297 ParamOk: Boolean;
298 LastMessagesCount: Integer;
299 Text: string;
300 EmptyParam: Boolean;
301 InstructionMemory: TMemory;
302 ParamMemory: TMemory;
303begin
304 Result := False;
305 LastPos := Parser.Pos;
306 Token := Parser.ReadNext;
307 InstructionInfos := InstructionSet.SearchByNameMultiple(Token.Value);
308 InstDataWidth := DataWidth;
309 InstAddressWidth := AddressWidth;
310 InstructionMemory := TMemory.Create;
311 InstructionMemory.Grow := True;
312 ParamMemory := TMemory.Create;
313 ParamMemory.Grow := True;
314 J := 0;
315 if InstructionInfos.Count > 0 then
316 repeat
317 EmptyParam := False;
318
319 if J > 0 then
320 Parser.Expect(tkSpecialSymbol, ',');
321
322 // Get allowed parameters
323 AllowedParams := [];
324 for I := 0 to InstructionInfos.Count - 1 do begin
325 if Length(InstructionInfos[I].Params) > J then
326 AllowedParams := AllowedParams + [InstructionInfos[I].Params[J]]
327 else EmptyParam := True;
328 end;
329
330 if AllowedParams <> [] then begin
331 ParamOk := False;
332 for ParamType := Low(TParamType) to High(TParamType) do begin
333 if ParamType in AllowedParams then begin
334 LastMessagesCount := Messages.Count;
335 ParamMemory.Clear;
336 if ParseInstructionParameter(ParamType, ParamMemory, InstructionMemory.Position) and
337 (LastMessagesCount = Messages.Count) then begin
338 ParamOk := True;
339 InstructionMemory.WriteMemoryPos(ParamMemory);
340 Break;
341 end else Messages.Count := LastMessagesCount;
342 end;
343 end;
344 if not ParamOk then begin
345 if EmptyParam then begin
346 ParamType := ptNone;
347 end else begin
348 Text := '';
349 for ParamType := Low(TParamType) to High(TParamType) do begin
350 if ParamType in AllowedParams then begin
351 if Text <> '' then Text := Text + ' or ';
352 Text := Text + ParamTypeString[ParamType]
353 end;
354 end;
355
356 Error(Format(SExpectedParameterType, [Text]), Parser.Pos.Pos);
357 Break;
358 end;
359 end;
360 end;
361
362 // Remove not matching instruction infos
363 for I := InstructionInfos.Count - 1 downto 0 do
364 if (Length(InstructionInfos[I].Params) > J) and
365 (InstructionInfos[I].Params[J] <> ParamType) then InstructionInfos.Delete(I);
366
367 if (InstructionInfos.Count = 1) and (J >= (Length(InstructionInfos[0].Params) - 1)) then begin
368 Memory.WritePos(1, Byte(InstructionInfos[0].Instruction));
369 Memory.WriteMemoryPos(InstructionMemory);
370 Result := True;
371 Break;
372 end;
373
374 Inc(J);
375 until False;
376
377 if not Result then Parser.Pos := LastPos;
378 FreeAndNil(ParamMemory);
379 FreeAndNil(InstructionMemory);
380end;
381
382function TAssembler.ParseInstructionParameter(ParamType: TParamType; Memory: TMemory;
383 Offset: Integer): Boolean;
384var
385 LastPos: TParserPos;
386 I: Integer;
387 RegIndex: TRegIndex;
388 Number: TInt;
389 Token: TToken;
390begin
391 LastPos := Parser.Pos;
392 Result := True;
393 case ParamType of
394 ptData: begin
395 if ParseNumParam(Offset, Number) then
396 Memory.WritePos(InstDataWidth, Number)
397 else begin
398 Error(SExpectedNumber, Parser.Pos.Pos);
399 Result := False;
400 end;
401 end;
402 ptAddress: begin
403 if ParseNumParam(Offset, Number) then
404 Memory.WritePos(InstAddressWidth, Number)
405 else begin
406 Error(SExpectedNumber, Parser.Pos.Pos);
407 Result := False;
408 end;
409 end;
410 ptReg: begin
411 if ParseReg(RegIndex) then Memory.WritePos(1, Byte(RegIndex))
412 else begin
413 Error(SExpectedRegisterName, Parser.Pos.Pos);
414 Result := False;
415 end;
416 end;
417 ptRegIndirect: begin
418 if not Parser.Expect(tkSpecialSymbol, '(') then Result := False;
419 if ParseReg(RegIndex) then Memory.WritePos(1, Byte(RegIndex))
420 else begin
421 Error(SExpectedRegisterName, Parser.Pos.Pos);
422 Result := False;
423 end;
424 if not Parser.Expect(tkSpecialSymbol, ')') then Result := False;;
425 end;
426 ptRegIndirectIndex: begin
427 if not Parser.Expect(tkSpecialSymbol, '(') then Result := False;
428 if ParseReg(RegIndex) then begin
429 Memory.WritePos(1, Byte(RegIndex));
430 if not Parser.Expect(tkSpecialSymbol, '+') then Result := False;
431 if ParseNumParam(Offset, Number) then Memory.WritePos(InstAddressWidth, Number)
432 else begin
433 Error(SExpectedNumericIndex, Parser.Pos.Pos);
434 Result := False;
435 end;
436 end else begin
437 Error(SExpectedRegisterName, Parser.Pos.Pos);
438 Result := False;
439 end;
440 if not Parser.Expect(tkSpecialSymbol, ')') then Result := False;
441 end;
442 ptDataWidth: begin
443 if ParseDataWidth(InstDataWidth) then begin
444 Memory.WritePos(1, InstDataWidth)
445 end else begin
446 Error(SExpectedRegisterName, Parser.Pos.Pos);
447 Result := False;
448 end;
449 end;
450 ptAddressWidth: begin
451 if ParseAddressWidth(InstAddressWidth) then begin
452 Memory.WritePos(1, InstAddressWidth)
453 end else begin
454 Error(SExpectedRegisterName, Parser.Pos.Pos);
455 Result := False;
456 end;
457 end;
458 else begin
459 Result := False;
460 Error(SUnsupportedParameterType, Parser.Pos.Pos);
461 end;
462 end;
463 if not Result then Parser.Pos := LastPos;
464end;
465
466function TAssembler.ParseLabel: Boolean;
467var
468 LastPos: TParserPos;
469 Token: TToken;
470 Addr: TInt;
471begin
472 Result := False;
473 LastPos := Parser.Pos;
474 Token := Parser.ReadNext;
475 if Parser.CheckNextAndRead(tkSpecialSymbol, ':') then begin
476 Result := True;
477 if not Labels.TryGetValue(Token.Value, Addr) then begin
478 Labels.Add(Token.Value, Memory.Position);
479 end else Error(Format(SDuplicateLabel, [Token.Value]), Token.Pos);
480 end;
481 if not Result then Parser.Pos := LastPos;
482end;
483
484procedure TAssembler.LoadFromFile(FileName: string);
485var
486 Lines: TStringList;
487begin
488 Lines := TStringList.Create;
489 try
490 Lines.LoadFromFile(FileName);
491 Compile(Lines.Text);
492 finally
493 Lines.Free;
494 end;
495end;
496
497function TAssembler.ParseStr(var Text: string; Separator: string): string;
498var
499 P: Integer;
500begin
501 P := Pos(Separator, Text);
502 if P > 0 then begin
503 Result := Trim(Copy(Text, 1, P - 1));
504 Text := Trim(Copy(Text, P + 1, MaxInt));
505 end else begin
506 Result := Trim(Text);
507 Text := '';
508 end;
509end;
510
511constructor TAssembler.Create;
512begin
513 Parser := TParser.Create;
514 Parser.OnError := Error;
515 Messages := TMessages.Create;
516 Memory := TMemory.Create;
517 InstructionSet := TInstructionInfos.Create;
518 InstructionSet.Init;
519 Labels := TDictionary<string, TInt>.Create;
520 LabelRefs := TList<TLabelRef>.Create;
521 Variables := TDictionary<string, TInt>.Create;
522end;
523
524destructor TAssembler.Destroy;
525begin
526 FreeAndNil(Variables);
527 FreeAndNil(Labels);
528 FreeAndNil(LabelRefs);
529 FreeAndNil(InstructionSet);
530 FreeAndNil(Memory);
531 FreeAndNil(Messages);
532 FreeAndNil(Parser);
533 inherited;
534end;
535
536end.
537
Note: See TracBrowser for help on using the repository browser.