source: branches/virtcpu fixed int/UCpu.pas

Last change on this file was 215, checked in by chronos, 5 years ago
  • Added: TMachine class which contains CPU and peripherals.
  • Added: Execute TCpu inside background thread.
File size: 14.4 KB
Line 
1unit UCpu;
2
3{$DEFINE EXT_MEMORY}
4{$DEFINE EXT_IO}
5{$DEFINE EXT_ARITHMETIC}
6{$DEFINE EXT_CONDITIONAL}
7{$DEFINE EXT_LOGICAL}
8{$DEFINE EXT_STACK}
9{$DEFINE EXT_SUBROUTINE}
10{$DEFINE EXT_ROTATION}
11{$DEFINE EXT_MULTIPLICATION}
12{$DEFINE EXT_SHIFT}
13{$DEFINE EXT_BLOCK}
14{$DEFINE EXT_GENERAL}
15{$DEFINE EXT_BIT}
16{$DEFINE EXT_REL_JUMP}
17{$DEFINE EXT_OS}
18
19// Extension dependencies
20{$IFDEF EXT_SUBROUTINE}
21{$DEFINE EXT_STACK}
22{$ENDIF}
23{$IFDEF EXT_MULTIPLICATION}
24{$DEFINE EXT_ARITHMETIC}
25{$ENDIF}
26
27
28{$mode delphi}{$H+}
29
30interface
31
32uses
33 Classes, SysUtils;
34
35type
36 T = Integer;
37
38 TOpcode = (opNop, opLoad, opLoadConst, opNeg,
39 opJump, {$IFDEF EXT_REL_JUMP}opJumpRel,{$ENDIF}
40 opInc, opDec,
41 {$IFDEF EXT_MEMORY}opLoadMem, opStoreMem, opLoadMemIndexed, opStoreMemIndexed,{$ENDIF}
42 {$IFDEF EXT_ARITHMETIC}opAdd, opSub,{$ENDIF}
43 {$IFDEF EXT_IO}opInput, opOutput,{$ENDIF}
44 {$IFDEF EXT_SUBROUTINE}opCall,
45 {$IFDEF EXT_REL_JUMP}opCallRel,{$ENDIF}
46 opRet,{$ENDIF}
47 {$IFDEF EXT_GENERAL}opExchg,{$ENDIF}
48 {$IFDEF EXT_LOGICAL}opAnd, opOr, opXor,{$ENDIF}
49 {$IFDEF EXT_SHIFT}opShl, opShr,{$ENDIF}
50 {$IFDEF EXT_ROTATION}opRor, opRol,{$ENDIF}
51 {$IFDEF EXT_STACK}opPush, opPop,{$ENDIF}
52 {$IFDEF EXT_CONDITIONAL}
53 {$IFDEF EXT_REL_JUMP}opJumpRelCond,{$ENDIF}
54 {$IFDEF EXT_BLOCK}opLdir, opLddr,{$ENDIF}
55 opJumpCond, opTestEqual, opTestNotEqual, opTestLess,
56 opTestLessEqual, opTestGreater, opTestGreaterEqual,
57 opTestZero, opTestNotZero,
58 {$ENDIF}
59 {$IFDEF EXT_OS}opSysCall,{$ENDIF}
60 {$IFDEF EXT_MULTIPLICATION}
61 opMul, opDiv,
62 {$ENDIF}
63 opHalt
64 );
65
66 TOpcodeHandler = procedure of object;
67 TInputEvent = function (Port: T): T of object;
68 TOutputEvent = procedure (Port, Value: T) of object;
69 TCpuThread = class;
70
71 { TCPU }
72
73 TCPU = class(TComponent)
74 private
75 FOnInput: TInputEvent;
76 FOnOutput: TOutputEvent;
77 FOpcodeHandlers: array[TOpcode] of TOpcodeHandler;
78 FRunning: Boolean;
79 function ReadNext: T; inline;
80 procedure OpcodeNop;
81 procedure OpcodeHalt;
82 procedure OpcodeLoad;
83 procedure OpcodeLoadConst;
84 procedure OpcodeJump;
85 {$IFDEF EXT_REL_JUMP}
86 procedure OpcodeJumpRel;
87 {$ENDIF}
88 procedure OpcodeNeg;
89 procedure OpcodeInc;
90 procedure OpcodeDec;
91 {$IFDEF EXT_MEMORY}
92 procedure OpcodeLoadMem;
93 procedure OpcodeStoreMem;
94 procedure OpcodeLoadMemIndexed;
95 procedure OpcodeStoreMemIndexed;
96 {$ENDIF}
97 {$IFDEF EXT_GENERAL}
98 procedure OpcodeExchange;
99 {$ENDIF}
100 {$IFDEF EXT_CONDITIONAL}
101 procedure OpcodeTestEqual;
102 procedure OpcodeTestNotEqual;
103 procedure OpcodeTestGreatEqual;
104 procedure OpcodeTestGreat;
105 procedure OpcodeTestLessEqual;
106 procedure OpcodeTestLess;
107 procedure OpcodeTestZero;
108 procedure OpcodeTestNotZero;
109 procedure OpcodeJumpCond;
110 {$IFDEF EXT_REL_JUMP}
111 procedure OpcodeJumpRelCond;
112 {$ENDIF}
113 {$ENDIF}
114 {$IFDEF EXT_SHIFT}
115 procedure OpcodeShl;
116 procedure OpcodeShr;
117 {$ENDIF}
118 {$IFDEF EXT_ROTATION}
119 procedure OpcodeRor;
120 procedure OpcodeRol;
121 {$ENDIF}
122 {$IFDEF EXT_LOGICAL}
123 procedure OpcodeAnd;
124 procedure OpcodeOr;
125 procedure OpcodeXor;
126 {$ENDIF}
127 {$IFDEF EXT_STACK}
128 procedure OpcodePush;
129 procedure OpcodePop;
130 {$ENDIF}
131 {$IFDEF EXT_SUBROUTINE}
132 procedure OpcodeCall;
133 procedure OpcodeReturn;
134 {$IFDEF EXT_REL_JUMP}
135 procedure OpcodeCallRel;
136 {$ENDIF}
137 {$ENDIF}
138 {$IFDEF EXT_IO}
139 procedure OpcodeOutput;
140 procedure OpcodeInput;
141 {$ENDIF}
142 {$IFDEF EXT_ARITHMETIC}
143 procedure OpcodeAdd;
144 procedure OpcodeSub;
145 {$ENDIF}
146 {$IFDEF EXT_MULTIPLICATION}
147 procedure OpcodeMul;
148 procedure OpcodeDiv;
149 {$ENDIF}
150 {$IFDEF EXT_BLOCK}
151 procedure OpcodeLdir;
152 procedure OpcodeLddr;
153 {$ENDIF}
154 {$IFDEF EXT_OS}
155 procedure OpcodeSysCall;
156 {$ENDIF}
157 public
158 Registers: array of T;
159 IP: T;
160 {$IFDEF EXT_CONDITIONAL}
161 Condition: Boolean;
162 {$ENDIF}
163 {$IFDEF EXT_STACK}
164 SP: T;
165 {$ENDIF}
166 Memory: array of T;
167 Ticks: Integer;
168 Terminated: Boolean;
169 Thread: TCpuThread;
170 procedure Reset;
171 procedure Start;
172 procedure Stop;
173 procedure Run;
174 procedure Step;
175 constructor Create(AOwner: TComponent); override;
176 destructor Destroy; override;
177 property Running: Boolean read FRunning;
178 published
179 property OnInput: TInputEvent read FOnInput write FOnInput;
180 property OnOutput: TOutputEvent read FOnOutput write FOnOutput;
181 end;
182
183 { TCpuThread }
184
185 TCpuThread = class(TThread)
186 Cpu: TCpu;
187 procedure Execute; override;
188 end;
189
190
191implementation
192
193{ TCpuThread }
194
195procedure TCpuThread.Execute;
196begin
197 Cpu.Run;
198end;
199
200{ TCPU }
201
202function TCPU.ReadNext: T;
203begin
204 Result := Memory[IP];
205 Inc(IP);
206end;
207
208procedure TCPU.OpcodeHalt;
209begin
210 Terminated := True;
211end;
212
213procedure TCPU.OpcodeNop;
214begin
215 // Do nothing
216end;
217
218procedure TCPU.OpcodeLoad;
219var
220 P1: T;
221 P2: T;
222begin
223 P1 := ReadNext;
224 P2 := ReadNext;
225 Registers[P1] := Registers[P2];
226end;
227
228procedure TCPU.OpcodeLoadConst;
229var
230 P1: T;
231 P2: T;
232begin
233 P1 := ReadNext;
234 P2 := ReadNext;
235 Registers[P1] := P2;
236end;
237
238{$IFDEF EXT_MEMORY}
239procedure TCPU.OpcodeLoadMem;
240var
241 P1: T;
242 P2: T;
243begin
244 P1 := ReadNext;
245 P2 := ReadNext;
246 Registers[P1] := Memory[Registers[P2]];
247end;
248
249procedure TCPU.OpcodeStoreMem;
250var
251 P1: T;
252 P2: T;
253begin
254 P1 := ReadNext;
255 P2 := ReadNext;
256 Memory[Registers[P1]] := Registers[P2];
257end;
258
259procedure TCPU.OpcodeLoadMemIndexed;
260var
261 P1: T;
262 P2: T;
263 P3: T;
264begin
265 P1 := ReadNext;
266 P2 := ReadNext;
267 P3 := ReadNext;
268 Registers[P1] := Memory[Registers[P2] + P3];
269end;
270
271procedure TCPU.OpcodeStoreMemIndexed;
272var
273 P1: T;
274 P2: T;
275 P3: T;
276begin
277 P1 := ReadNext;
278 P2 := ReadNext;
279 P3 := ReadNext;
280 Memory[Registers[P1] + P3] := Registers[P2];
281end;
282{$ENDIF}
283
284procedure TCPU.OpcodeNeg;
285var
286 P1: T;
287begin
288 P1 := ReadNext;
289 Registers[P1] := -Registers[P1];
290end;
291
292{$IFDEF EXT_GENERAL}
293procedure TCPU.OpcodeExchange;
294var
295 P1, P2, Temp: T;
296begin
297 P1 := ReadNext;
298 P2 := ReadNext;
299 Temp := Registers[P1];
300 Registers[P1] := Registers[P2];
301 Registers[P2] := Temp;
302end;
303{$ENDIF}
304
305procedure TCPU.OpcodeJump;
306begin
307 IP := ReadNext;
308end;
309
310{$IFDEF EXT_REL_JUMP}
311procedure TCPU.OpcodeJumpRel;
312begin
313 IP := IP + ReadNext;
314end;
315{$ENDIF}
316
317{$IFDEF EXT_CONDITIONAL}
318procedure TCPU.OpcodeTestEqual;
319begin
320 Condition := ReadNext = ReadNext;
321end;
322
323procedure TCPU.OpcodeTestNotEqual;
324begin
325 Condition := ReadNext <> ReadNext;
326end;
327
328procedure TCPU.OpcodeTestGreatEqual;
329begin
330 Condition := ReadNext >= ReadNext;
331end;
332
333procedure TCPU.OpcodeTestGreat;
334begin
335 Condition := ReadNext > ReadNext;
336end;
337
338procedure TCPU.OpcodeTestLessEqual;
339begin
340 Condition := ReadNext <= ReadNext;
341end;
342
343procedure TCPU.OpcodeTestLess;
344begin
345 Condition := ReadNext < ReadNext;
346end;
347
348procedure TCPU.OpcodeTestZero;
349begin
350 Condition := ReadNext = 0;
351end;
352
353procedure TCPU.OpcodeTestNotZero;
354begin
355 Condition := ReadNext <> 0;
356end;
357
358procedure TCPU.OpcodeJumpCond;
359var
360 Addr: T;
361begin
362 Addr := ReadNext;
363 if Condition then IP := Addr;
364end;
365
366{$IFDEF EXT_REL_JUMP}
367procedure TCPU.OpcodeJumpRelCond;
368var
369 Addr: T;
370begin
371 Addr := ReadNext;
372 if Condition then IP := IP + Addr;
373end;
374{$ENDIF}
375{$ENDIF}
376
377{$IFDEF EXT_ROTATION}
378procedure TCPU.OpcodeRor;
379var
380 P1, P2: T;
381begin
382 P1 := ReadNext;
383 P2 := ReadNext;
384 Registers[P1] := (Registers[P1] shr Registers[P2]) or
385 ((Registers[P1] and ((1 shl Registers[P2]) - 1)) shl (SizeOf(T) * 8 - Registers[P2]));
386end;
387
388procedure TCPU.OpcodeRol;
389var
390 P1, P2: T;
391begin
392 P1 := ReadNext;
393 P2 := ReadNext;
394 Registers[P1] := (Registers[P1] shl Registers[P2]) or
395 ((Registers[P1] shr (SizeOf(T) * 8 - Registers[P2])) and ((1 shl Registers[P2]) - 1));
396end;
397{$ENDIF}
398
399{$IFDEF EXT_SHIFT}
400procedure TCPU.OpcodeShl;
401var
402 P1, P2: T;
403begin
404 P1 := ReadNext;
405 P2 := ReadNext;
406 Registers[P1] := Registers[P1] shl Registers[P2];
407end;
408
409procedure TCPU.OpcodeShr;
410var
411 P1, P2: T;
412begin
413 P1 := ReadNext;
414 P2 := ReadNext;
415 Registers[P1] := Registers[P1] shr Registers[P2];
416end;
417{$ENDIF}
418
419{$IFDEF EXT_LOGICAL}
420procedure TCPU.OpcodeAnd;
421var
422 P1, P2: T;
423begin
424 P1 := ReadNext;
425 P2 := ReadNext;
426 Registers[P1] := Registers[P1] and Registers[P2];
427end;
428
429procedure TCPU.OpcodeOr;
430var
431 P1, P2: T;
432begin
433 P1 := ReadNext;
434 P2 := ReadNext;
435 Registers[P1] := Registers[P1] or Registers[P2];
436end;
437
438procedure TCPU.OpcodeXor;
439var
440 P1, P2: T;
441begin
442 P1 := ReadNext;
443 P2 := ReadNext;
444 Registers[P1] := Registers[P1] xor Registers[P2];
445end;
446{$ENDIF}
447
448{$IFDEF EXT_STACK}
449procedure TCPU.OpcodePush;
450begin
451 Memory[SP] := Registers[ReadNext];
452 Dec(SP);
453end;
454
455procedure TCPU.OpcodePop;
456begin
457 Inc(SP);
458 Registers[ReadNext] := Memory[SP];
459end;
460{$ENDIF}
461
462{$IFDEF EXT_SUBROUTINE}
463procedure TCPU.OpcodeCall;
464var
465 Addr: T;
466begin
467 Addr := ReadNext;
468 Memory[SP] := IP;
469 Dec(SP);
470 IP := Addr;
471end;
472
473{$IFDEF EXT_REL_JUMP}
474procedure TCPU.OpcodeCallRel;
475var
476 Addr: T;
477begin
478 Addr := ReadNext;
479 Memory[SP] := IP;
480 Dec(SP);
481 IP := IP + Addr;
482end;
483{$ENDIF}
484
485procedure TCPU.OpcodeReturn;
486begin
487 Inc(SP);
488 IP := Memory[SP];
489end;
490{$ENDIF}
491
492{$IFDEF EXT_IO}
493procedure TCPU.OpcodeOutput;
494var
495 R1: T;
496 R2: T;
497begin
498 R1 := ReadNext;
499 R2 := ReadNext;
500 if Assigned(FOnOutput) then
501 FOnOutput(Registers[R1], Registers[R2]);
502end;
503
504procedure TCPU.OpcodeInput;
505var
506 R1: T;
507 R2: T;
508begin
509 R1 := ReadNext;
510 R2 := ReadNext;
511 if Assigned(FOnInput) then
512 Registers[R1] := FOnInput(Registers[R2]);
513end;
514{$ENDIF}
515
516procedure TCPU.OpcodeInc;
517var
518 R: T;
519begin
520 R := ReadNext;
521 Registers[R] := Registers[R] + 1;
522end;
523
524procedure TCPU.OpcodeDec;
525var
526 R: T;
527begin
528 R := ReadNext;
529 Registers[R] := Registers[R] - 1;
530end;
531
532{$IFDEF EXT_ARITHMETIC}
533procedure TCPU.OpcodeAdd;
534var
535 R1: T;
536 R2: T;
537begin
538 R1 := ReadNext;
539 R2 := ReadNext;
540 Registers[R1] := Registers[R1] + Registers[R2];
541end;
542
543procedure TCPU.OpcodeSub;
544var
545 R1: T;
546 R2: T;
547begin
548 R1 := ReadNext;
549 R2 := ReadNext;
550 Registers[R1] := Registers[R1] - Registers[R2];
551end;
552{$ENDIF}
553
554{$IFDEF EXT_MULTIPLICATION}
555procedure TCPU.OpcodeMul;
556var
557 R1: T;
558 R2: T;
559begin
560 R1 := ReadNext;
561 R2 := ReadNext;
562 Registers[R1] := Registers[R1] * Registers[R2];
563end;
564
565procedure TCPU.OpcodeDiv;
566var
567 R1: T;
568 R2: T;
569begin
570 R1 := ReadNext;
571 R2 := ReadNext;
572 Registers[R1] := Registers[R1] div Registers[R2];
573end;
574{$ENDIF}
575
576{$IFDEF EXT_BLOCK}
577procedure TCPU.OpcodeLdir;
578var
579 Src: T;
580 Dst: T;
581 Size: T;
582begin
583 Src := ReadNext;
584 Dst := ReadNext;
585 Size := ReadNext;
586 while Registers[Size] > 0 do begin
587 Memory[Registers[Dst]] := Memory[Registers[Src]];
588 Inc(Registers[Src]);
589 Inc(Registers[Dst]);
590 Dec(Registers[Size]);
591 end;
592end;
593
594procedure TCPU.OpcodeLddr;
595var
596 Src: T;
597 Dst: T;
598 Size: T;
599begin
600 Src := ReadNext;
601 Dst := ReadNext;
602 Size := ReadNext;
603 while Registers[Size] > 0 do begin
604 Memory[Registers[Dst]] := Memory[Registers[Src]];
605 Dec(Registers[Src]);
606 Dec(Registers[Dst]);
607 Dec(Registers[Size]);
608 end;
609end;
610{$ENDIF}
611
612{$IFDEF EXT_OS}
613procedure TCPU.OpcodeSysCall;
614var
615 Addr: T;
616begin
617 Addr := ReadNext;
618 Memory[SP] := IP;
619 Dec(SP);
620 IP := Memory[Addr];
621end;
622
623{$ENDIF}
624
625procedure TCPU.Reset;
626begin
627 Ticks := 0;
628 Terminated := False;
629 IP := 0;
630 {$IFDEF EXT_STACK}
631 SP := Length(Memory);
632 {$ENDIF}
633end;
634
635procedure TCPU.Start;
636begin
637 if not Running then begin
638 Terminated := False;
639 Thread := TCpuThread.Create(True);
640 Thread.Cpu := Self;
641 Thread.Start;
642 FRunning := True;
643 end;
644end;
645
646procedure TCPU.Stop;
647begin
648 if Running then begin
649 Terminated := True;
650 Thread.Terminate;
651 Thread.WaitFor;
652 FreeAndNil(Thread);
653 FRunning := False;
654 end;
655end;
656
657procedure TCPU.Run;
658begin
659 while not Terminated do
660 Step;
661end;
662
663procedure TCPU.Step;
664var
665 Data: T;
666 Opcode: TOpcode;
667begin
668 Data := ReadNext;
669 Inc(Ticks);
670 if (Data >= 0) and (Data <= T(High(TOpcode))) then begin
671 Opcode := TOpcode(Data);
672 FOpcodeHandlers[Opcode];
673 end else raise Exception.Create(Format('Unsupported instruction %d', [Data]));
674end;
675
676constructor TCPU.Create(AOwner: TComponent);
677begin
678 inherited;
679 SetLength(Registers, 16);
680 SetLength(Memory, 1024);
681 FOpcodeHandlers[opNop] := OpcodeNop;
682 FOpcodeHandlers[opHalt] := OpcodeHalt;
683 FOpcodeHandlers[opLoad] := OpcodeLoad;
684 FOpcodeHandlers[opLoadConst] := OpcodeLoadConst;
685 FOpcodeHandlers[opNeg] := OpcodeNeg;
686 FOpcodeHandlers[opJump] := OpcodeJump;
687 FOpcodeHandlers[opInc] := OpcodeInc;
688 FOpcodeHandlers[opDec] := OpcodeDec;
689 {$IFDEF EXT_REL_JUMP}
690 FOpcodeHandlers[opJumpRel] := OpcodeJumpRel;
691 {$ENDIF}
692 {$IFDEF EXT_MEMORY}
693 FOpcodeHandlers[opLoadMem] := OpcodeLoadMem;
694 FOpcodeHandlers[opStoreMem] := OpcodeStoreMem;
695 FOpcodeHandlers[opLoadMemIndexed] := OpcodeLoadMemIndexed;
696 FOpcodeHandlers[opStoreMemIndexed] := OpcodeStoreMemIndexed;
697 {$ENDIF}
698 {$IFDEF EXT_GENERAL}
699 FOpcodeHandlers[opExchg] := OpcodeExchange;
700 {$ENDIF}
701 {$IFDEF EXT_LOGICAL}
702 FOpcodeHandlers[opAnd] := OpcodeAnd;
703 FOpcodeHandlers[opOr] := OpcodeOr;
704 FOpcodeHandlers[opXor] := OpcodeXor;
705 {$ENDIF}
706 {$IFDEF EXT_SHIFT}
707 FOpcodeHandlers[opShl] := OpcodeShl;
708 FOpcodeHandlers[opShr] := OpcodeShr;
709 {$ENDIF}
710 {$IFDEF EXT_STACK}
711 FOpcodeHandlers[opPush] := OpcodePush;
712 FOpcodeHandlers[opPop] := OpcodePop;
713 {$ENDIF}
714 {$IFDEF EXT_SUBROUTINE}
715 FOpcodeHandlers[opCall] := OpcodeCall;
716 {$IFDEF EXT_REL_JUMP}
717 FOpcodeHandlers[opCallRel] := OpcodeCallRel;
718 {$ENDIF}
719 FOpcodeHandlers[opRet] := OpcodeReturn;
720 {$ENDIF}
721 {$IFDEF EXT_ROTATION}
722 FOpcodeHandlers[opRor] := OpcodeRor;
723 FOpcodeHandlers[opRol] := OpcodeRol;
724 {$ENDIF}
725 {$IFDEF EXT_IO}
726 FOpcodeHandlers[opInput] := OpcodeInput;
727 FOpcodeHandlers[opOutput] := OpcodeOutput;
728 {$ENDIF}
729 {$IFDEF EXT_ARITHMETIC}
730 FOpcodeHandlers[opAdd] := OpcodeAdd;
731 FOpcodeHandlers[opSub] := OpcodeSub;
732 {$ENDIF}
733 {$IFDEF EXT_BLOCK}
734 FOpcodeHandlers[opLdir] := OpcodeLdir;
735 FOpcodeHandlers[opLddr] := OpcodeLddr;
736 {$ENDIF}
737 {$IFDEF EXT_CONDITIONAL}
738 FOpcodeHandlers[opJumpCond] := OpcodeJumpCond;
739 {$IFDEF EXT_REL_JUMP}
740 FOpcodeHandlers[opJumpRelCond] := OpcodeJumpRelCond;
741 {$ENDIF}
742 FOpcodeHandlers[opTestEqual] := OpcodeTestEqual;
743 FOpcodeHandlers[opTestNotEqual] := OpcodeTestNotEqual;
744 FOpcodeHandlers[opTestLess] := OpcodeTestLess;
745 FOpcodeHandlers[opTestLessEqual] := OpcodeTestLessEqual;
746 FOpcodeHandlers[opTestGreater] := OpcodeTestGreat;
747 FOpcodeHandlers[opTestGreaterEqual] := OpcodeTestGreatEqual;
748 FOpcodeHandlers[opTestZero] := OpcodeTestZero;
749 FOpcodeHandlers[opTestNotZero] := OpcodeTestNotZero;
750 {$ENDIF}
751 {$IFDEF EXT_MULTIPLICATION}
752 FOpcodeHandlers[opMul] := OpcodeMul;
753 FOpcodeHandlers[opDiv] := OpcodeDiv;
754 {$ENDIF}
755 {$IFDEF EXT_OS}
756 FOpcodeHandlers[opSysCall] := OpcodeSysCall;
757 {$ENDIF}
758end;
759
760destructor TCPU.Destroy;
761begin
762 Stop;
763 inherited;
764end;
765
766end.
767
Note: See TracBrowser for help on using the repository browser.