source: branches/virtualcpu2/UMachine.pas

Last change on this file was 154, checked in by chronos, 8 years ago
  • Added: More opcodes with handlers.
File size: 24.2 KB
Line 
1unit UMachine;
2
3{$mode delphi}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils;
9
10type
11 Int8 = ShortInt;
12 Int16 = SmallInt;
13 Int32 = Longint;
14 PInt8 = ^Int8;
15 PInt16 = ^Int16;
16 PInt32 = ^Int32;
17 UInt8 = Byte;
18 UInt16 = Word;
19 UInt32 = Cardinal;
20 PUInt8 = ^UInt8;
21 PUInt16 = ^UInt16;
22 PUInt32 = ^UInt16;
23
24
25 //TAddrInt = Int8;
26 TAddrInt = Int16;
27 //TAddrInt = Int32;
28 //TAddrInt = Int64;
29 PAddrInt = ^TAddrInt;
30 TDataInt = QWord;
31 //TDataInt = Int16;
32 //TDataInt = Int32;
33 //TDataInt = Int64;
34 PDataInt = ^TDataInt;
35
36 TRegIndex = Byte;
37 TRegSize = Int8;
38
39 TOpcode = (
40 // Special
41 opNop,
42 opHalt,
43 opGetSize,
44 opSetSize, opSetSize8, opSetSize16, opSetSize32, opSetSize64,
45 // Data move
46 opCopy,
47 opCopyFromMem,
48 opCopyToMem,
49 opCopyConst,
50 opXchg,
51 // Arithmetic
52 opInc,
53 opDec,
54 opAdd,
55 opSub,
56 opMul,
57 opDiv,
58 // Stack
59 opPush,
60 opPop,
61 // Skip
62 opTestZero,
63 opTestNotZero,
64 opSkipCarry,
65 opSkipNotCarray,
66 // Subroutine
67 opCallRel,
68 opCallAbs,
69 opCallRelCond,
70 opCallAbsCond,
71 opRet,
72 // Jump
73 opJumpRel,
74 opJumpAbs,
75 opJumpRelCond,
76 opJumpAbsCond,
77 // Logical operations
78 opAnd,
79 opOr,
80 opXor,
81 // Bit shift
82 opShr,
83 opShl,
84 // I/O access
85 opIn,
86 opOut,
87 // Block operations
88 opLdir,
89 opLddr
90 );
91
92 TOpcodeHandler = procedure of object;
93 TDataSize = (dsNative, ds8, ds16, ds32, ds64);
94
95 { TMachine }
96
97 TMachine = class
98 private
99 OpcodeTable: array[TOpcode, TDataSize] of TOpcodeHandler;
100 procedure CheckIP;
101 procedure OpcodeNop;
102 procedure OpcodeHalt;
103 procedure OpcodeCopy;
104 procedure OpcodeCopy8;
105 procedure OpcodeCopy16;
106 procedure OpcodeCopy32;
107 procedure OpcodeCopy64;
108 procedure OpcodeCopyFromMem;
109 procedure OpcodeCopyToMem;
110 procedure OpcodeCopyConst;
111 procedure OpcodeCopyConst8;
112 procedure OpcodeCopyConst16;
113 procedure OpcodeCopyConst32;
114 procedure OpcodeCopyConst64;
115 procedure OpcodeGetDataSize;
116 procedure OpcodeXchg;
117 procedure OpcodeAdd;
118 procedure OpcodeSub;
119 procedure OpcodeAnd;
120 procedure OpcodeOr;
121 procedure OpcodeXor;
122 procedure OpcodePop;
123 procedure OpcodePop8;
124 procedure OpcodePop16;
125 procedure OpcodePop32;
126 procedure OpcodePop64;
127 procedure OpcodePush;
128 procedure OpcodePush8;
129 procedure OpcodePush16;
130 procedure OpcodePush32;
131 procedure OpcodePush64;
132 procedure OpcodeLdir;
133 procedure OpcodeInc;
134 procedure OpcodeInc8;
135 procedure OpcodeInc16;
136 procedure OpcodeInc32;
137 procedure OpcodeInc64;
138 procedure OpcodeDec;
139 procedure OpcodeDec8;
140 procedure OpcodeDec16;
141 procedure OpcodeDec32;
142 procedure OpcodeDec64;
143 procedure OpcodeTestNotZero;
144 procedure OpcodeTestZero;
145 procedure OpcodeJumpRel;
146 procedure OpcodeJumpRel8;
147 procedure OpcodeJumpRel16;
148 procedure OpcodeJumpRel32;
149 procedure OpcodeJumpRel64;
150 procedure OpcodeJumpAbs;
151 procedure OpcodeJumpAbs8;
152 procedure OpcodeJumpAbs16;
153 procedure OpcodeJumpAbs32;
154 procedure OpcodeJumpAbs64;
155 procedure OpcodeJumpRelCond;
156 procedure OpcodeJumpRelCond8;
157 procedure OpcodeJumpRelCond16;
158 procedure OpcodeJumpRelCond32;
159 procedure OpcodeJumpRelCond64;
160 procedure OpcodeJumpAbsCond;
161 procedure OpcodeJumpAbsCond8;
162 procedure OpcodeJumpAbsCond16;
163 procedure OpcodeJumpAbsCond32;
164 procedure OpcodeJumpAbsCond64;
165 procedure OpcodeCallRel;
166 procedure OpcodeCallAbs;
167 procedure OpcodeCallRelCond;
168 procedure OpcodeCallAbsCond;
169 procedure OpcodeUnsupported;
170 procedure OpcodeSetSize;
171 procedure OpcodeSetSize8;
172 procedure OpcodeSetSize16;
173 procedure OpcodeSetSize32;
174 procedure OpcodeSetSize64;
175 function ReadNext: TDataInt;
176 function ReadNext8: UInt8;
177 function ReadNext16: UInt16;
178 function ReadNext32: UInt32;
179 function ReadNext64: UInt64;
180 function ReadNextS: TDataInt;
181 function ReadNextS8: Int8;
182 function ReadNextS16: Int16;
183 function ReadNextS32: Int32;
184 function ReadNextS64: Int64;
185 procedure SetOpcode(Opcode: TOpcode; Handler: TOpcodeHandler; DataSize: TDataSize = dsNative);
186 procedure InitOpcode;
187 procedure Step;
188 public
189 Registers: array of TDataInt;
190 //RegisterSize: array of TRegSize;
191 Memory: array of Byte;
192 IP: TAddrInt;
193 SP: TAddrInt;
194 DataSize: TDataSize;
195 BaseDataSize: TDataSize;
196 Terminated: Boolean;
197 Condition: Boolean;
198 procedure Run;
199 constructor Create;
200 end;
201
202 { TInstructionWriter }
203
204 TInstructionWriter = class
205 Addr: Integer;
206 Machine: TMachine;
207 procedure AddData(Data: TDataInt);
208 procedure AddDataS(Data: Int64);
209 procedure AddData8(Data: Byte);
210 procedure AddDataS8(Data: ShortInt);
211 procedure AddCopyConst(Reg: TRegIndex; Value: TDataInt);
212 procedure AddCopyConst8(Reg: TRegIndex; Value: UInt8);
213 procedure AddGetDataSize(Reg: TRegIndex);
214 procedure AddCopyFromMem(Reg, Src: TRegIndex);
215 procedure AddCopyToMem(Reg, Dest: TRegIndex);
216 procedure AddInc(Reg: TRegIndex);
217 procedure AddDec(Reg: TRegIndex);
218 procedure AddHalt;
219 procedure AddTestNotZero(Reg: TRegIndex);
220 procedure AddJumpRelCond(Reg: Integer);
221 procedure AddJumpRelCond8(Reg: TRegIndex);
222 constructor Create;
223 end;
224
225const
226 DataSizeValue: array[TDataSize] of Byte = (SizeOf(TDataInt), SizeOf(UInt8),
227 SizeOf(UInt16), SizeOf(UInt32), SizeOf(UInt64));
228
229implementation
230
231{ TMachine }
232
233procedure TMachine.Run;
234begin
235 IP := 0;
236 Terminated := False;
237 while not Terminated do begin
238 Step;
239 end;
240end;
241
242procedure TMachine.SetOpcode(Opcode: TOpcode; Handler: TOpcodeHandler; DataSize: TDataSize);
243begin
244 if SizeOf(TDataInt) >= DataSizeValue[DataSize] then OpcodeTable[Opcode, DataSize] := Handler
245 else OpcodeTable[Opcode, DataSize] := OpcodeUnsupported;
246end;
247
248procedure TMachine.InitOpcode;
249begin
250 SetOpcode(opNop, OpcodeNop);
251 SetOpcode(opHalt, OpcodeHalt);
252 SetOpcode(opCopy, OpcodeCopy);
253 SetOpcode(opCopy, OpcodeCopy8, ds8);
254 SetOpcode(opCopy, OpcodeCopy16, ds16);
255 SetOpcode(opCopy, OpcodeCopy32, ds32);
256 SetOpcode(opCopy, OpcodeCopy64, ds64);
257 SetOpcode(opCopyFromMem, OpcodeCopyFromMem);
258 SetOpcode(opCopyToMem, OpcodeCopyToMem);
259 SetOpcode(opCopyConst, OpcodeCopyConst);
260 SetOpcode(opCopyConst, OpcodeCopyConst8, ds8);
261 SetOpcode(opCopyConst, OpcodeCopyConst16, ds16);
262 SetOpcode(opCopyConst, OpcodeCopyConst32, ds32);
263 SetOpcode(opCopyConst, OpcodeCopyConst64, ds64);
264 SetOpcode(opXchg, OpcodeXchg);
265 SetOpcode(opGetSize, OpcodeGetDataSize);
266 SetOpcode(opInc, OpcodeInc);
267 SetOpcode(opInc, OpcodeInc8, ds8);
268 SetOpcode(opInc, OpcodeInc16, ds16);
269 SetOpcode(opInc, OpcodeInc32, ds32);
270 SetOpcode(opInc, OpcodeInc64, ds64);
271 SetOpcode(opDec, OpcodeDec);
272 SetOpcode(opDec, OpcodeDec8, ds8);
273 SetOpcode(opDec, OpcodeDec16, ds16);
274 SetOpcode(opDec, OpcodeDec32, ds32);
275 SetOpcode(opDec, OpcodeDec64, ds64);
276 SetOpcode(opTestZero, OpcodeTestZero);
277 SetOpcode(opTestNotZero, OpcodeTestNotZero);
278 SetOpcode(opJumpRel, OpcodeJumpRel);
279 SetOpcode(opJumpRel, OpcodeJumpRel8, ds8);
280 SetOpcode(opJumpRel, OpcodeJumpRel16, ds16);
281 SetOpcode(opJumpRel, OpcodeJumpRel32, ds32);
282 SetOpcode(opJumpRel, OpcodeJumpRel64, ds64);
283 SetOpcode(opJumpAbs, OpcodeJumpAbs);
284 SetOpcode(opJumpAbs, OpcodeJumpAbs8, ds8);
285 SetOpcode(opJumpAbs, OpcodeJumpAbs16, ds16);
286 SetOpcode(opJumpAbs, OpcodeJumpAbs32, ds32);
287 SetOpcode(opJumpAbs, OpcodeJumpAbs64, ds64);
288 SetOpcode(opJumpRelCond, OpcodeJumpRelCond);
289 SetOpcode(opJumpRelCond, OpcodeJumpRelCond8, ds8);
290 SetOpcode(opJumpRelCond, OpcodeJumpRelCond16, ds16);
291 SetOpcode(opJumpRelCond, OpcodeJumpRelCond32, ds32);
292 SetOpcode(opJumpRelCond, OpcodeJumpRelCond64, ds64);
293 SetOpcode(opJumpAbsCond, OpcodeJumpAbsCond);
294 SetOpcode(opJumpAbsCond, OpcodeJumpAbsCond8, ds8);
295 SetOpcode(opJumpAbsCond, OpcodeJumpAbsCond16, ds16);
296 SetOpcode(opJumpAbsCond, OpcodeJumpAbsCond32, ds32);
297 SetOpcode(opJumpAbsCond, OpcodeJumpAbsCond64, ds64);
298 SetOpcode(opCallRel, OpcodeCallRel);
299 SetOpcode(opCallAbs, OpcodeCallAbs);
300 SetOpcode(opCallRelCond, OpcodeCallRelCond);
301 SetOpcode(opCallAbsCond, OpcodeCallAbsCond);
302 SetOpcode(opAdd, OpcodeAdd);
303 SetOpcode(opSub, OpcodeSub);
304 SetOpcode(opLdir, OpcodeLdir);
305 SetOpcode(opAnd, OpcodeAnd);
306 SetOpcode(opOr, OpcodeOr);
307 SetOpcode(opXor, OpcodeXor);
308 SetOpcode(opPush, OpcodePush);
309 SetOpcode(opPush, OpcodePush8, ds8);
310 SetOpcode(opPush, OpcodePush16, ds16);
311 SetOpcode(opPush, OpcodePush32, ds32);
312 SetOpcode(opPush, OpcodePush64, ds64);
313 SetOpcode(opPop, OpcodePop);
314 SetOpcode(opPop, OpcodePop8, ds8);
315 SetOpcode(opPop, OpcodePop16, ds16);
316 SetOpcode(opPop, OpcodePop32, ds32);
317 SetOpcode(opPop, OpcodePop64, ds64);
318 SetOpcode(opSetSize, OpcodeSetSize);
319 SetOpcode(opSetSize8, OpcodeSetSize8);
320 SetOpcode(opSetSize16, OpcodeSetSize16);
321 SetOpcode(opSetSize32, OpcodeSetSize32);
322 SetOpcode(opSetSize64, OpcodeSetSize64);
323end;
324
325procedure TMachine.Step;
326var
327 Opcode: TOpcode;
328 OpcodeHandler: TOpcodeHandler;
329begin
330 if IP >= Length(Memory) then IP := 0;
331 Opcode := TOpcode(ReadNext8);
332 if (Opcode <= High(Opcode)) then begin
333 OpcodeHandler := OpcodeTable[Opcode, DataSize];
334 if Assigned(OpcodeHandler) then OpcodeHandler
335 else raise Exception.Create('Opcode without handler: ' + IntToHex(Integer(Opcode), 2));
336 end else raise Exception.Create('Unknown opcode: ' + IntToHex(Integer(Opcode), 2));
337 if (DataSize <> BaseDataSize) and (Opcode <> opSetSize) and (Opcode <> opSetSize8) and
338 (Opcode <> opSetSize16) and (Opcode <> opSetSize32) and (Opcode <> opSetSize64) then
339 DataSize := BaseDataSize;
340end;
341
342constructor TMachine.Create;
343begin
344 SetLength(Registers, 16);
345 InitOpcode;
346end;
347
348procedure TMachine.OpcodeNop;
349begin
350end;
351
352procedure TMachine.OpcodeHalt;
353begin
354 Terminated := True;
355end;
356
357procedure TMachine.OpcodeCopy8;
358var
359 Source: TRegIndex;
360 Dest: TRegIndex;
361begin
362 Dest := ReadNext8;
363 Source := ReadNext8;
364 PUInt8(@Registers[Dest])^ := PUInt8(@Registers[Source])^;
365end;
366
367procedure TMachine.OpcodeCopy16;
368var
369 Source: TRegIndex;
370 Dest: TRegIndex;
371begin
372 Dest := ReadNext8;
373 Source := ReadNext8;
374 PUInt16(@Registers[Dest])^ := PUInt16(@Registers[Source])^;
375end;
376
377procedure TMachine.OpcodeCopy32;
378var
379 Source: TRegIndex;
380 Dest: TRegIndex;
381begin
382 Dest := ReadNext8;
383 Source := ReadNext8;
384 PUInt32(@Registers[Dest])^ := PUInt32(@Registers[Source])^;
385end;
386
387procedure TMachine.OpcodeCopy64;
388var
389 Source: TRegIndex;
390 Dest: TRegIndex;
391begin
392 Dest := ReadNext8;
393 Source := ReadNext8;
394 PUInt64(@Registers[Dest])^ := PUInt64(@Registers[Source])^;
395end;
396
397procedure TMachine.OpcodeCopy;
398var
399 Source: TRegIndex;
400 Dest: TRegIndex;
401begin
402 Dest := ReadNext8;
403 Source := ReadNext8;
404 PDataInt(@Registers[Dest])^ := PDataInt(@Registers[Source])^;
405end;
406
407procedure TMachine.OpcodeCopyFromMem;
408var
409 Source: TRegIndex;
410 Dest: TRegIndex;
411begin
412 Dest := ReadNext8;
413 Source := ReadNext8;
414 PDataInt(@Registers[Dest])^ := PDataInt(@Memory[Registers[Source]])^;
415end;
416
417procedure TMachine.OpcodeCopyToMem;
418var
419 Source: TRegIndex;
420 Dest: TRegIndex;
421begin
422 Source := ReadNext8;
423 Dest := ReadNext8;
424 PDataInt(@Memory[Registers[Dest]])^ := PDataInt(@Registers[Source])^;
425end;
426
427procedure TMachine.OpcodeCopyConst;
428var
429 Source: TDataInt;
430 Dest: TRegIndex;
431begin
432 Dest := ReadNext8;
433 Source := ReadNext;
434 PDataInt(@Registers[Dest])^ := Source;
435end;
436
437procedure TMachine.OpcodeCopyConst8;
438var
439 Source: UInt8;
440 Dest: TRegIndex;
441begin
442 Dest := ReadNext8;
443 Source := ReadNext8;
444 PUInt8(@Registers[Dest])^ := Source;
445end;
446
447procedure TMachine.OpcodeCopyConst16;
448var
449 Source: UInt16;
450 Dest: TRegIndex;
451begin
452 Dest := ReadNext8;
453 Source := ReadNext16;
454 PUInt16(@Registers[Dest])^ := Source;
455end;
456
457procedure TMachine.OpcodeCopyConst32;
458var
459 Source: UInt32;
460 Dest: TRegIndex;
461begin
462 Dest := ReadNext8;
463 Source := ReadNext32;
464 PUInt32(@Registers[Dest])^ := Source;
465end;
466
467procedure TMachine.OpcodeCopyConst64;
468var
469 Source: UInt64;
470 Dest: TRegIndex;
471begin
472 Dest := ReadNext8;
473 Source := ReadNext64;
474 PUInt64(@Registers[Dest])^ := Source;
475end;
476
477procedure TMachine.OpcodeGetDataSize;
478var
479 Dest: TRegIndex;
480begin
481 Dest := ReadNext8;
482 Registers[Dest] := SizeOf(TDataInt);
483end;
484
485procedure TMachine.OpcodeXchg;
486var
487 Source: TRegIndex;
488 Dest: TRegIndex;
489 Temp: TDataInt;
490begin
491 Dest := ReadNext8;
492 Source := ReadNext8;
493 Temp := PDataInt(@Registers[Dest])^;
494 PDataInt(@Registers[Dest])^ := PDataInt(@Registers[Source])^;
495 PDataInt(@Registers[Source])^ := Temp;
496end;
497
498procedure TMachine.OpcodeAdd;
499var
500 Op1: TRegIndex;
501 Op2: TRegIndex;
502begin
503 Op1 := ReadNext8;
504 Op2 := ReadNext8;
505 PDataInt(@Registers[Op1])^ := PDataInt(@Registers[Op1])^ + PDataInt(@Registers[Op2])^;
506end;
507
508procedure TMachine.OpcodeSub;
509var
510 Op1: TRegIndex;
511 Op2: TRegIndex;
512begin
513 Op1 := ReadNext8;
514 Op2 := ReadNext8;
515 PDataInt(@Registers[Op1])^ := PDataInt(@Registers[Op1])^ - PDataInt(@Registers[Op2])^;
516end;
517
518procedure TMachine.OpcodeAnd;
519var
520 Op1: TRegIndex;
521 Op2: TRegIndex;
522begin
523 Op1 := ReadNext8;
524 Op2 := ReadNext8;
525 PDataInt(@Registers[Op1])^ := PDataInt(@Registers[Op1])^ and PDataInt(@Registers[Op2])^;
526end;
527
528procedure TMachine.OpcodeOr;
529var
530 Op1: TRegIndex;
531 Op2: TRegIndex;
532begin
533 Op1 := ReadNext8;
534 Op2 := ReadNext8;
535 PDataInt(@Registers[Op1])^ := PDataInt(@Registers[Op1])^ or PDataInt(@Registers[Op2])^;
536end;
537
538procedure TMachine.OpcodeXor;
539var
540 Op1: TRegIndex;
541 Op2: TRegIndex;
542begin
543 Op1 := ReadNext8;
544 Op2 := ReadNext8;
545 PDataInt(@Registers[Op1])^ := PDataInt(@Registers[Op1])^ xor PDataInt(@Registers[Op2])^;
546end;
547
548procedure TMachine.OpcodePop;
549var
550 Reg: TRegIndex;
551begin
552 Reg := ReadNext8;
553 PDataInt(@Registers[Reg])^ := PDataInt(@Memory[SP])^;
554 Inc(SP, SizeOf(TDataInt));
555end;
556
557procedure TMachine.OpcodePop8;
558var
559 Reg: TRegIndex;
560begin
561 Reg := ReadNext8;
562 PUInt8(@Registers[Reg])^ := PUInt8(@Memory[SP])^;
563 Inc(SP, SizeOf(UInt8));
564end;
565
566procedure TMachine.OpcodePop16;
567var
568 Reg: TRegIndex;
569begin
570 Reg := ReadNext8;
571 PUInt16(@Registers[Reg])^ := PUInt16(@Memory[SP])^;
572 Inc(SP, SizeOf(UInt16));
573end;
574
575procedure TMachine.OpcodePop32;
576var
577 Reg: TRegIndex;
578begin
579 Reg := ReadNext8;
580 PUInt32(@Registers[Reg])^ := PUInt32(@Memory[SP])^;
581 Inc(SP, SizeOf(UInt32));
582end;
583
584procedure TMachine.OpcodePop64;
585var
586 Reg: TRegIndex;
587begin
588 Reg := ReadNext8;
589 PUInt64(@Registers[Reg])^ := PUInt64(@Memory[SP])^;
590 Inc(SP, SizeOf(UInt64));
591end;
592
593procedure TMachine.OpcodePush;
594var
595 Source: TRegIndex;
596begin
597 Source := ReadNext8;
598 Dec(SP, SizeOf(TDataInt));
599 PDataInt(@Memory[SP])^ := PDataInt(@Registers[Source])^;
600end;
601
602procedure TMachine.OpcodePush8;
603var
604 Source: TRegIndex;
605begin
606 Source := ReadNext8;
607 Dec(SP, SizeOf(Byte));
608 PUInt8(@Memory[SP])^ := PUInt8(@Registers[Source])^;
609end;
610
611procedure TMachine.OpcodePush16;
612var
613 Source: TRegIndex;
614begin
615 Source := ReadNext8;
616 Dec(SP, SizeOf(Word));
617 PUInt16(@Memory[SP])^ := PUInt16(@Registers[Source])^;
618end;
619
620procedure TMachine.OpcodePush32;
621var
622 Source: TRegIndex;
623begin
624 Source := ReadNext8;
625 Dec(SP, SizeOf(Cardinal));
626 PUInt32(@Memory[SP])^ := PUInt32(@Registers[Source])^;
627end;
628
629procedure TMachine.OpcodePush64;
630var
631 Source: TRegIndex;
632begin
633 Source := ReadNext8;
634 Dec(SP, SizeOf(QWord));
635 PUInt64(@Memory[SP])^ := PUInt64(@Registers[Source])^;
636end;
637
638procedure TMachine.OpcodeLdir;
639var
640 Src: TRegIndex;
641 Dst: TRegIndex;
642 Count: TRegIndex;
643begin
644 Src := ReadNext8;
645 Dst := ReadNext8;
646 Count := ReadNext8;
647 while Count > 0 do begin
648 PDataInt(@Registers[Dst])^ := PDataInt(@Registers[Src])^;
649 Inc(Src);
650 Inc(Dst);
651 Dec(Count);
652 end;
653end;
654
655procedure TMachine.OpcodeInc;
656var
657 Reg: TRegIndex;
658begin
659 Reg := ReadNext8;
660 PDataInt(@Registers[Reg])^ := PDataInt(@Registers[Reg])^ + 1;
661end;
662
663procedure TMachine.OpcodeInc8;
664var
665 Reg: TRegIndex;
666begin
667 Reg := ReadNext8;
668 PUInt8(@Registers[Reg])^ := PUInt8(@Registers[Reg])^ + 1;
669end;
670
671procedure TMachine.OpcodeInc16;
672var
673 Reg: TRegIndex;
674begin
675 Reg := ReadNext8;
676 PUInt16(@Registers[Reg])^ := PUInt16(@Registers[Reg])^ + 1;
677end;
678
679procedure TMachine.OpcodeInc32;
680var
681 Reg: TRegIndex;
682begin
683 Reg := ReadNext8;
684 PUInt32(@Registers[Reg])^ := PUInt32(@Registers[Reg])^ + 1;
685end;
686
687procedure TMachine.OpcodeInc64;
688var
689 Reg: TRegIndex;
690begin
691 Reg := ReadNext8;
692 PUInt64(@Registers[Reg])^ := PUInt64(@Registers[Reg])^ + 1;
693end;
694
695procedure TMachine.OpcodeDec;
696var
697 Reg: TRegIndex;
698begin
699 Reg := ReadNext8;
700 Registers[Reg] := Registers[Reg] - 1;
701end;
702
703procedure TMachine.OpcodeDec8;
704var
705 Reg: TRegIndex;
706begin
707 Reg := ReadNext8;
708 PUInt8(@Registers[Reg])^ := PUInt8(@Registers[Reg])^ - 1;
709end;
710
711procedure TMachine.OpcodeDec16;
712var
713 Reg: TRegIndex;
714begin
715 Reg := ReadNext8;
716 PUInt16(@Registers[Reg])^ := PUInt16(@Registers[Reg])^ - 1;
717end;
718
719procedure TMachine.OpcodeDec32;
720var
721 Reg: TRegIndex;
722begin
723 Reg := ReadNext8;
724 PUInt32(@Registers[Reg])^ := PUInt32(@Registers[Reg])^ - 1;
725end;
726
727procedure TMachine.OpcodeDec64;
728var
729 Reg: TRegIndex;
730begin
731 Reg := ReadNext8;
732 PUInt64(@Registers[Reg])^ := PUInt64(@Registers[Reg])^ - 1;
733end;
734
735procedure TMachine.OpcodeTestNotZero;
736var
737 Reg: TRegIndex;
738begin
739 Reg := ReadNext8;
740 Condition := Registers[Reg] <> 0;
741end;
742
743procedure TMachine.OpcodeTestZero;
744var
745 Reg: TRegIndex;
746begin
747 Reg := ReadNext8;
748 Condition := Registers[Reg] = 0;
749end;
750
751procedure TMachine.OpcodeJumpRel;
752var
753 Reg: TRegIndex;
754begin
755 Reg := ReadNext8;
756 IP := IP + PDataInt(@Registers[Reg])^;
757end;
758
759procedure TMachine.OpcodeJumpRel8;
760var
761 Reg: TRegIndex;
762begin
763 Reg := ReadNext8;
764 IP := IP + PInt8(@Registers[Reg])^;
765end;
766
767procedure TMachine.OpcodeJumpRel16;
768var
769 Reg: TRegIndex;
770begin
771 Reg := ReadNext8;
772 IP := IP + PInt16(@Registers[Reg])^;
773end;
774
775procedure TMachine.OpcodeJumpRel32;
776var
777 Reg: TRegIndex;
778begin
779 Reg := ReadNext8;
780 IP := IP + PInt32(@Registers[Reg])^;
781end;
782
783procedure TMachine.OpcodeJumpRel64;
784var
785 Reg: TRegIndex;
786begin
787 Reg := ReadNext8;
788 IP := IP + PInt64(@Registers[Reg])^;
789end;
790
791procedure TMachine.OpcodeJumpAbs;
792var
793 Reg: TRegIndex;
794begin
795 Reg := ReadNext8;
796 IP := PDataInt(@Registers[Reg])^;
797end;
798
799procedure TMachine.OpcodeJumpAbs8;
800var
801 Reg: TRegIndex;
802begin
803 Reg := ReadNext8;
804 IP := PByte(@Registers[Reg])^;
805end;
806
807procedure TMachine.OpcodeJumpAbs16;
808var
809 Reg: TRegIndex;
810begin
811 Reg := ReadNext8;
812 IP := PWord(@Registers[Reg])^;
813end;
814
815procedure TMachine.OpcodeJumpAbs32;
816var
817 Reg: TRegIndex;
818begin
819 Reg := ReadNext8;
820 IP := PCardinal(@Registers[Reg])^;
821end;
822
823procedure TMachine.OpcodeJumpAbs64;
824var
825 Reg: TRegIndex;
826begin
827 Reg := ReadNext8;
828 IP := PQWord(@Registers[Reg])^;
829end;
830
831procedure TMachine.OpcodeJumpRelCond;
832var
833 Reg: TRegIndex;
834begin
835 Reg := ReadNext8;
836 if Condition then IP := IP + PDataInt(@Registers[Reg])^;
837end;
838
839procedure TMachine.OpcodeJumpRelCond8;
840var
841 Reg: TRegIndex;
842begin
843 Reg := ReadNext8;
844 if Condition then IP := IP + PInt8(@Registers[Reg])^;
845end;
846
847procedure TMachine.OpcodeJumpRelCond16;
848var
849 Reg: TRegIndex;
850begin
851 Reg := ReadNext8;
852 if Condition then IP := IP + PInt16(@Registers[Reg])^;
853end;
854
855procedure TMachine.OpcodeJumpRelCond32;
856var
857 Reg: TRegIndex;
858begin
859 Reg := ReadNext8;
860 if Condition then IP := IP + PInt32(@Registers[Reg])^;
861end;
862
863procedure TMachine.OpcodeJumpRelCond64;
864var
865 Reg: TRegIndex;
866begin
867 Reg := ReadNext8;
868 if Condition then IP := IP + PInt64(@Registers[Reg])^;
869end;
870
871procedure TMachine.OpcodeJumpAbsCond;
872var
873 Reg: TRegIndex;
874begin
875 Reg := ReadNext8;
876 if Condition then IP := PDataInt(@Registers[Reg])^;
877end;
878
879procedure TMachine.OpcodeJumpAbsCond8;
880var
881 Reg: TRegIndex;
882begin
883 Reg := ReadNext8;
884 if Condition then IP := PByte(@Registers[Reg])^;
885end;
886
887procedure TMachine.OpcodeJumpAbsCond16;
888var
889 Reg: TRegIndex;
890begin
891 Reg := ReadNext8;
892 if Condition then IP := PWord(@Registers[Reg])^;
893end;
894
895procedure TMachine.OpcodeJumpAbsCond32;
896var
897 Reg: TRegIndex;
898begin
899 Reg := ReadNext8;
900 if Condition then IP := PCardinal(@Registers[Reg])^;
901end;
902
903procedure TMachine.OpcodeJumpAbsCond64;
904var
905 Reg: TRegIndex;
906begin
907 Reg := ReadNext8;
908 if Condition then IP := PQWord(@Registers[Reg])^;
909end;
910
911procedure TMachine.OpcodeCallRel;
912var
913 RelAddr: TAddrInt;
914begin
915 RelAddr := ReadNextS;
916 Dec(SP, SizeOf(TAddrInt));
917 PAddrInt(@Memory[SP])^ := IP;
918 IP := IP + RelAddr;
919end;
920
921procedure TMachine.OpcodeCallAbs;
922var
923 Addr: TAddrInt;
924begin
925 Addr := ReadNext;
926 Dec(SP, SizeOf(TAddrInt));
927 PAddrInt(@Memory[SP])^ := IP;
928 IP := Addr;
929end;
930
931procedure TMachine.OpcodeCallRelCond;
932var
933 RelAddr: TAddrInt;
934begin
935 RelAddr := ReadNextS;
936 if Condition then begin
937 Dec(SP, SizeOf(TAddrInt));
938 PAddrInt(@Memory[SP])^ := IP;
939 IP := IP + RelAddr;
940 end;
941end;
942
943procedure TMachine.OpcodeCallAbsCond;
944var
945 Addr: TAddrInt;
946begin
947 Dec(SP, SizeOf(TAddrInt));
948 if Condition then begin
949 PAddrInt(@Memory[SP])^ := IP;
950 Addr := ReadNext;
951 IP := Addr;
952 end;
953end;
954
955procedure TMachine.OpcodeUnsupported;
956begin
957 raise Exception.Create('Unsupported instruction');
958end;
959
960procedure TMachine.OpcodeSetSize;
961begin
962 DataSize := dsNative;
963end;
964
965procedure TMachine.OpcodeSetSize8;
966begin
967 DataSize := ds8;
968end;
969
970procedure TMachine.OpcodeSetSize16;
971begin
972 DataSize := ds16;
973end;
974
975procedure TMachine.OpcodeSetSize32;
976begin
977 DataSize := ds32;
978end;
979
980procedure TMachine.OpcodeSetSize64;
981begin
982 DataSize := ds64;
983end;
984
985procedure TMachine.CheckIP;
986begin
987 if (IP < 0) and (IP >= Length(Memory)) then
988 raise Exception.Create('Memory access out of range ' + IntToHex(IP, 8));
989end;
990
991function TMachine.ReadNext: TDataInt;
992begin
993 CheckIP;
994 Result := PDataInt(@Memory[IP])^;
995 Inc(IP, SizeOf(TDataInt));
996end;
997
998function TMachine.ReadNextS: TDataInt;
999begin
1000 CheckIP;
1001 Result := PDataInt(@Memory[IP])^;
1002 Inc(IP, SizeOf(TDataInt));
1003end;
1004
1005function TMachine.ReadNext8: UInt8;
1006begin
1007 CheckIP;
1008 Result := Memory[IP];
1009 Inc(IP);
1010end;
1011
1012function TMachine.ReadNextS8: Int8;
1013begin
1014 CheckIP;
1015 Result := Memory[IP];
1016 Inc(IP);
1017end;
1018
1019function TMachine.ReadNextS16: Int16;
1020begin
1021 CheckIP;
1022 Result := PInt16(@Memory[IP])^;
1023 Inc(IP, SizeOf(Int16));
1024end;
1025
1026function TMachine.ReadNextS32: Int32;
1027begin
1028 CheckIP;
1029 Result := PInt32(@Memory[IP])^;
1030 Inc(IP, SizeOf(Int32));
1031end;
1032
1033function TMachine.ReadNextS64: Int64;
1034begin
1035 CheckIP;
1036 Result := PInt64(@Memory[IP])^;
1037 Inc(IP, SizeOf(Int64));
1038end;
1039
1040function TMachine.ReadNext16: UInt16;
1041begin
1042 CheckIP;
1043 Result := PWord(@Memory[IP])^;
1044 Inc(IP, SizeOf(Word));
1045end;
1046
1047function TMachine.ReadNext32: UInt32;
1048begin
1049 CheckIP;
1050 Result := PCardinal(@Memory[IP])^;
1051 Inc(IP, SizeOf(Cardinal));
1052end;
1053
1054function TMachine.ReadNext64: UInt64;
1055begin
1056 CheckIP;
1057 Result := PQWord(@Memory[IP])^;
1058 Inc(IP, SizeOf(QWord));
1059end;
1060
1061{ TInstructionWriter }
1062
1063procedure TInstructionWriter.AddData(Data: TDataInt);
1064begin
1065 PDataInt(@(Machine.Memory[Addr]))^ := Data;
1066 Inc(Addr, SizeOf(TDataInt));
1067end;
1068
1069procedure TInstructionWriter.AddDataS(Data: Int64);
1070begin
1071 PInt64(@(Machine.Memory[Addr]))^ := Data;
1072 Inc(Addr, SizeOf(Int64));
1073end;
1074
1075procedure TInstructionWriter.AddData8(Data: Byte);
1076begin
1077 PByte(@(Machine.Memory[Addr]))^ := Data;
1078 Inc(Addr, SizeOf(Byte));
1079end;
1080
1081procedure TInstructionWriter.AddDataS8(Data: ShortInt);
1082begin
1083 PShortInt(@(Machine.Memory[Addr]))^ := Data;
1084 Inc(Addr, SizeOf(ShortInt));
1085end;
1086
1087procedure TInstructionWriter.AddCopyConst(Reg: TRegIndex; Value: TDataInt);
1088begin
1089 AddData8(Integer(opCopyConst));
1090 AddData8(Reg);
1091 AddData(Value);
1092end;
1093
1094procedure TInstructionWriter.AddCopyConst8(Reg: TRegIndex; Value: UInt8);
1095begin
1096 AddData8(Integer(opSetSize8));
1097 AddData8(Integer(opCopyConst));
1098 AddData8(Reg);
1099 AddData8(Value);
1100end;
1101
1102procedure TInstructionWriter.AddGetDataSize(Reg: TRegIndex);
1103begin
1104 AddData8(Integer(opGetSize));
1105 AddData8(Reg);
1106end;
1107
1108procedure TInstructionWriter.AddCopyFromMem(Reg, Src: TRegIndex);
1109begin
1110 AddData8(Integer(opCopyFromMem));
1111 AddData8(Reg);
1112 AddData8(Src);
1113end;
1114
1115procedure TInstructionWriter.AddCopyToMem(Reg, Dest: TRegIndex);
1116begin
1117 AddData8(Integer(opCopyToMem));
1118 AddData8(Reg);
1119 AddData8(Dest);
1120end;
1121
1122procedure TInstructionWriter.AddInc(Reg: TRegIndex);
1123begin
1124 AddData8(Integer(opInc));
1125 AddData8(Reg);
1126end;
1127
1128procedure TInstructionWriter.AddDec(Reg: TRegIndex);
1129begin
1130 AddData8(Integer(opDec));
1131 AddData8(Reg);
1132end;
1133
1134procedure TInstructionWriter.AddHalt;
1135begin
1136 AddData8(Integer(opHalt));
1137end;
1138
1139procedure TInstructionWriter.AddTestNotZero(Reg: TRegIndex);
1140begin
1141 AddData8(Integer(opTestNotZero));
1142 AddData8(Reg);
1143end;
1144
1145procedure TInstructionWriter.AddJumpRelCond(Reg: Integer);
1146begin
1147 AddData8(Integer(opJumpRelCond));
1148 AddDataS(Reg);
1149end;
1150
1151procedure TInstructionWriter.AddJumpRelCond8(Reg: TRegIndex);
1152begin
1153 AddData8(Integer(opSetSize8));
1154 AddData8(Integer(opJumpRelCond));
1155 AddData8(Reg);
1156end;
1157
1158constructor TInstructionWriter.Create;
1159begin
1160 Addr := 0;
1161end;
1162
1163end.
1164
Note: See TracBrowser for help on using the repository browser.