Context Navigation

UCpu.pas

Visit:

Last change on this file was 197, checked in by chronos, 5 years ago
Modified: All parts of virtual machine have own form in Forms subdirectory. Modified: Main form moved to Forms subdirectory. Modified: TCpu class moved to UCpu unit. Added: Assembler and dissasembler forms.
File size: 11.1 KB

Line
1	unit UCpu;
2
3	{$mode delphi}
4
5	interface
6
7	uses
8	Classes, SysUtils, UVarInt;
9
10	type
11	T = TVarInt;
12
13	TOpcode = (opNop, opLoad, opLoadConst, opNeg,
14	opJump, opJumpRel,
15	opInc, opDec,
16	opLoadMem, opStoreMem,
17	opAdd, opSub,
18	opInput, opOutput,
19	opCall, opCallRel, opRet,
20	opExchg,
21	opAnd, opOr, opXor,
22	opShl, opShr,
23	opRor, opRol,
24	opPush, opPop,
25	opJumpRelCond,
26	opLdir, opLddr,
27	opJumpCond, opTestEqual, opTestNotEqual, opTestLess,
28	opTestLessEqual, opTestGreater, opTestGreaterEqual, opTestZero, opTestNotZero,
29	opMul, opDiv, opHalt, opMod,
30	opClear
31	);
32
33	TOpcodeHandler = procedure of object;
34	TInputEvent = function (Port: T): T of object;
35	TOutputEvent = procedure (Port, Value: T) of object;
36
37	{ TCPU }
38
39	TCPU = class(TComponent)
40	private
41	FOnInput: TInputEvent;
42	FOnOutput: TOutputEvent;
43	OpcodeHandlers: array[TOpcode] of TOpcodeHandler;
44	function ReadNext: T; inline;
45	procedure OpcodeNop;
46	procedure OpcodeHalt;
47	procedure OpcodeLoad;
48	procedure OpcodeLoadConst;
49	procedure OpcodeJump;
50	procedure OpcodeJumpRel;
51	procedure OpcodeNeg;
52	procedure OpcodeInc;
53	procedure OpcodeDec;
54	procedure OpcodeLoadMem;
55	procedure OpcodeStoreMem;
56	procedure OpcodeExchange;
57	procedure OpcodeTestEqual;
58	procedure OpcodeTestNotEqual;
59	procedure OpcodeTestGreatEqual;
60	procedure OpcodeTestGreat;
61	procedure OpcodeTestLessEqual;
62	procedure OpcodeTestLess;
63	procedure OpcodeTestZero;
64	procedure OpcodeTestNotZero;
65	procedure OpcodeJumpCond;
66	procedure OpcodeJumpRelCond;
67	procedure OpcodeShl;
68	procedure OpcodeShr;
69	procedure OpcodeRor;
70	procedure OpcodeRol;
71	procedure OpcodeAnd;
72	procedure OpcodeOr;
73	procedure OpcodeXor;
74	procedure OpcodePush;
75	procedure OpcodePop;
76	procedure OpcodeCall;
77	procedure OpcodeReturn;
78	procedure OpcodeCallRel;
79	procedure OpcodeOutput;
80	procedure OpcodeInput;
81	procedure OpcodeAdd;
82	procedure OpcodeSub;
83	procedure OpcodeMul;
84	procedure OpcodeDiv;
85	procedure OpcodeMod;
86	procedure OpcodeLdir;
87	procedure OpcodeLddr;
88	procedure OpcodeClear;
89	public
90	Memory: Pointer;
91	Registers: array of T;
92	IP: T;
93	SP: T;
94	Condition: Boolean;
95	Terminated: Boolean;
96	Ticks: Integer;
97	procedure Start;
98	procedure Stop;
99	procedure Step; inline;
100	constructor Create(AOwner: TComponent); override;
101	published
102	property OnInput: TInputEvent read FOnInput write FOnInput;
103	property OnOutput: TOutputEvent read FOnOutput write FOnOutput;
104	end;
105
106
107	implementation
108
109	{ TCPU }
110
111	function TCPU.ReadNext: T;
112	begin
113	IP := IP + Result.ReadFromAddr(Pointer(NativeUInt(Memory) + IP));
114	end;
115
116	procedure TCPU.OpcodeHalt;
117	begin
118	Terminated := True;
119	end;
120
121	procedure TCPU.OpcodeNop;
122	begin
123	// Do nothing
124	end;
125
126	procedure TCPU.OpcodeLoad;
127	var
128	P1: T;
129	P2: T;
130	begin
131	P1 := ReadNext;
132	P2 := ReadNext;
133	Registers[P1] := Registers[P2];
134	end;
135
136	procedure TCPU.OpcodeLoadConst;
137	var
138	P1: T;
139	P2: T;
140	begin
141	P1 := ReadNext;
142	P2 := ReadNext;
143	Registers[P1] := P2;
144	end;
145
146	procedure TCPU.OpcodeLoadMem;
147	var
148	P1: T;
149	P2: T;
150	begin
151	P1 := ReadNext;
152	P2 := ReadNext;
153	Registers[P1].ReadFromAddr(Pointer(NativeUInt(Memory) + Integer(Registers[P2])));
154	end;
155
156	procedure TCPU.OpcodeStoreMem;
157	var
158	P1: T;
159	P2: T;
160	begin
161	P1 := ReadNext;
162	P2 := ReadNext;
163	Registers[P2].WriteToAddr(Pointer(NativeUInt(Memory) + Registers[P1]));
164	end;
165
166	procedure TCPU.OpcodeNeg;
167	var
168	P1: T;
169	begin
170	P1 := ReadNext;
171	Registers[P1] := -Registers[P1];
172	end;
173
174	procedure TCPU.OpcodeExchange;
175	var
176	P1, P2, Temp: T;
177	begin
178	P1 := ReadNext;
179	P2 := ReadNext;
180	Temp := Registers[P1];
181	Registers[P1] := Registers[P2];
182	Registers[P2] := Temp;
183	end;
184
185	procedure TCPU.OpcodeJump;
186	begin
187	IP := ReadNext;
188	end;
189
190	procedure TCPU.OpcodeJumpRel;
191	begin
192	IP := IP + ReadNext;
193	end;
194
195	procedure TCPU.OpcodeTestEqual;
196	begin
197	Condition := ReadNext = ReadNext;
198	end;
199
200	procedure TCPU.OpcodeTestNotEqual;
201	begin
202	Condition := ReadNext <> ReadNext;
203	end;
204
205	procedure TCPU.OpcodeTestGreatEqual;
206	begin
207	Condition := ReadNext >= ReadNext;
208	end;
209
210	procedure TCPU.OpcodeTestGreat;
211	begin
212	Condition := ReadNext > ReadNext;
213	end;
214
215	procedure TCPU.OpcodeTestLessEqual;
216	begin
217	Condition := ReadNext <= ReadNext;
218	end;
219
220	procedure TCPU.OpcodeTestLess;
221	begin
222	Condition := ReadNext < ReadNext;
223	end;
224
225	procedure TCPU.OpcodeTestZero;
226	begin
227	Condition := ReadNext = 0;
228	end;
229
230	procedure TCPU.OpcodeTestNotZero;
231	begin
232	Condition := ReadNext <> 0;
233	end;
234
235	procedure TCPU.OpcodeJumpCond;
236	var
237	Addr: T;
238	begin
239	Addr := ReadNext;
240	if Condition then IP := Addr;
241	end;
242
243
244	procedure TCPU.OpcodeJumpRelCond;
245	var
246	Addr: T;
247	begin
248	Addr := ReadNext;
249	if Condition then IP := IP + Addr;
250	end;
251
252	procedure TCPU.OpcodeRor;
253	var
254	P1, P2: T;
255	begin
256	P1 := ReadNext;
257	P2 := ReadNext;
258	Registers[P1] := (Registers[P1] shr Registers[P2]) or
259	((Registers[P1] and ((1 shl Registers[P2]) - 1)) shl (SizeOf(T) * 8 - Registers[P2]));
260	end;
261
262	procedure TCPU.OpcodeRol;
263	var
264	P1, P2: T;
265	begin
266	P1 := ReadNext;
267	P2 := ReadNext;
268	Registers[P1] := (Registers[P1] shl Registers[P2]) or
269	((Registers[P1] shr (SizeOf(T) * 8 - Registers[P2])) and ((1 shl Registers[P2]) - 1));
270	end;
271
272	procedure TCPU.OpcodeShl;
273	var
274	P1, P2: T;
275	begin
276	P1 := ReadNext;
277	P2 := ReadNext;
278	Registers[P1] := Registers[P1] shl Registers[P2];
279	end;
280
281	procedure TCPU.OpcodeShr;
282	var
283	P1, P2: T;
284	begin
285	P1 := ReadNext;
286	P2 := ReadNext;
287	Registers[P1] := Registers[P1] shr Registers[P2];
288	end;
289
290	procedure TCPU.OpcodeAnd;
291	var
292	P1, P2: T;
293	begin
294	P1 := ReadNext;
295	P2 := ReadNext;
296	Registers[P1] := Registers[P1] and Registers[P2];
297	end;
298
299	procedure TCPU.OpcodeOr;
300	var
301	P1, P2: T;
302	begin
303	P1 := ReadNext;
304	P2 := ReadNext;
305	Registers[P1] := Registers[P1] or Registers[P2];
306	end;
307
308	procedure TCPU.OpcodeXor;
309	var
310	P1, P2: T;
311	begin
312	P1 := ReadNext;
313	P2 := ReadNext;
314	Registers[P1] := Registers[P1] xor Registers[P2];
315	end;
316
317	procedure TCPU.OpcodePush;
318	var
319	P1: T;
320	begin
321	P1 := ReadNext;
322	SP := SP - Registers[P1].GetByteSize;
323	Registers[P1].WriteToAddr(Pointer(NativeUInt(Memory) + Integer(SP)));
324	end;
325
326	procedure TCPU.OpcodePop;
327	begin
328	SP := SP + Registers[ReadNext].ReadFromAddr(Pointer(NativeUInt(Memory) + Integer(SP)));
329	end;
330
331	procedure TCPU.OpcodeCall;
332	var
333	Addr: T;
334	begin
335	Addr := ReadNext;
336	SP := SP - IP.GetByteSize;
337	IP.WriteToAddr(Pointer(NativeUInt(Memory) + SP));
338	IP := Addr;
339	end;
340
341	procedure TCPU.OpcodeCallRel;
342	var
343	Addr: T;
344	begin
345	Addr := ReadNext;
346	SP := SP - IP.GetByteSize;
347	IP.WriteToAddr(Pointer(NativeUInt(Memory) + SP));
348	IP := IP + Addr;
349	end;
350
351	procedure TCPU.OpcodeReturn;
352	begin
353	SP := SP + IP.ReadFromAddr(Pointer(NativeUInt(Memory) + SP));
354	end;
355
356	procedure TCPU.OpcodeOutput;
357	var
358	R1: T;
359	R2: T;
360	begin
361	R1 := ReadNext;
362	R2 := ReadNext;
363	if Assigned(FOnOutput) then
364	FOnOutput(Registers[R1], Registers[R2]);
365	end;
366
367	procedure TCPU.OpcodeInput;
368	var
369	R1: T;
370	R2: T;
371	begin
372	R1 := ReadNext;
373	R2 := ReadNext;
374	if Assigned(FOnInput) then
375	Registers[R1] := FOnInput(Registers[R2]);
376	end;
377
378	procedure TCPU.OpcodeInc;
379	var
380	R: T;
381	begin
382	R := ReadNext;
383	Registers[R] := Registers[R] + 1;
384	end;
385
386	procedure TCPU.OpcodeDec;
387	var
388	R: T;
389	begin
390	R := ReadNext;
391	Registers[R] := Registers[R] - 1;
392	end;
393
394	procedure TCPU.OpcodeAdd;
395	var
396	R1: T;
397	R2: T;
398	begin
399	R1 := ReadNext;
400	R2 := ReadNext;
401	Registers[R1] := Registers[R1] + Registers[R2];
402	end;
403
404	procedure TCPU.OpcodeSub;
405	var
406	R1: T;
407	R2: T;
408	begin
409	R1 := ReadNext;
410	R2 := ReadNext;
411	Registers[R1] := Registers[R1] - Registers[R2];
412	end;
413
414	procedure TCPU.OpcodeMul;
415	var
416	R1: T;
417	R2: T;
418	begin
419	R1 := ReadNext;
420	R2 := ReadNext;
421	Registers[R1] := Registers[R1] * Registers[R2];
422	end;
423
424	procedure TCPU.OpcodeDiv;
425	var
426	R1: T;
427	R2: T;
428	begin
429	R1 := ReadNext;
430	R2 := ReadNext;
431	Registers[R1] := Registers[R1] div Registers[R2];
432	end;
433
434	procedure TCPU.OpcodeMod;
435	var
436	R1: T;
437	R2: T;
438	begin
439	R1 := ReadNext;
440	R2 := ReadNext;
441	Registers[R1] := Registers[R1] mod Registers[R2];
442	end;
443
444	procedure TCPU.OpcodeLdir;
445	var
446	Src: T;
447	Dst: T;
448	Count: T;
449	Bytes: T;
450	begin
451	Src := ReadNext;
452	Dst := ReadNext;
453	Count := ReadNext;
454	Bytes := ReadNext;
455	while Registers[Count] > 0 do begin
456	Move(Pointer(NativeUInt(Memory) + Registers[Src])^,
457	Pointer(NativeUInt(Memory) + Registers[Dst])^, Bytes);
458	Inc(Registers[Src], Bytes);
459	Inc(Registers[Dst], Bytes);
460	Dec(Registers[Count]);
461	end;
462	end;
463
464	procedure TCPU.OpcodeLddr;
465	var
466	Src: T;
467	Dst: T;
468	Count: T;
469	Bytes: T;
470	begin
471	Src := ReadNext;
472	Dst := ReadNext;
473	Count := ReadNext;
474	Bytes := ReadNext;
475	while Registers[Count] > 0 do begin
476	Move(Pointer(NativeUInt(Memory) + Registers[Src])^,
477	Pointer(NativeUInt(Memory) + Registers[Dst])^, Bytes);
478	Dec(Registers[Src], Bytes);
479	Dec(Registers[Dst], Bytes);
480	Dec(Registers[Count]);
481	end;
482	end;
483
484	procedure TCPU.OpcodeClear;
485	var
486	P1: T;
487	begin
488	P1 := ReadNext;
489	Registers[P1] := 0;
490	end;
491
492	procedure TCPU.Start;
493	begin
494	Terminated := False;
495	Ticks := 0;
496	IP := 0;
497	SP := MemSize(Memory);
498	while not Terminated do
499	Step;
500	end;
501
502	procedure TCPU.Stop;
503	begin
504	Terminated := True;
505	end;
506
507	procedure TCPU.Step;
508	var
509	Opcode: T;
510	begin
511	Opcode := ReadNext;
512	if (Opcode >= 0) and (Opcode <= T(Integer(High(TOpcode)))) then
513	OpcodeHandlers[TOpcode(Byte(Opcode))]
514	else raise Exception.Create(Format('Unsupported instruction %d on address %x', [Int64(Opcode), Int64(IP)]));
515	Inc(Ticks);
516	end;
517
518	constructor TCPU.Create(AOwner: TComponent);
519	begin
520	inherited;
521	SetLength(Registers, 16);
522	OpcodeHandlers[opNop] := OpcodeNop;
523	OpcodeHandlers[opHalt] := OpcodeHalt;
524	OpcodeHandlers[opLoad] := OpcodeLoad;
525	OpcodeHandlers[opLoadConst] := OpcodeLoadConst;
526	OpcodeHandlers[opNeg] := OpcodeNeg;
527	OpcodeHandlers[opJump] := OpcodeJump;
528	OpcodeHandlers[opInc] := OpcodeInc;
529	OpcodeHandlers[opDec] := OpcodeDec;
530	OpcodeHandlers[opJumpRel] := OpcodeJumpRel;
531	OpcodeHandlers[opLoadMem] := OpcodeLoadMem;
532	OpcodeHandlers[opStoreMem] := OpcodeStoreMem;
533	OpcodeHandlers[opExchg] := OpcodeExchange;
534	OpcodeHandlers[opAnd] := OpcodeAnd;
535	OpcodeHandlers[opOr] := OpcodeOr;
536	OpcodeHandlers[opXor] := OpcodeXor;
537	OpcodeHandlers[opShl] := OpcodeShl;
538	OpcodeHandlers[opShr] := OpcodeShr;
539	OpcodeHandlers[opPush] := OpcodePush;
540	OpcodeHandlers[opPop] := OpcodePop;
541	OpcodeHandlers[opCall] := OpcodeCall;
542	OpcodeHandlers[opCallRel] := OpcodeCallRel;
543	OpcodeHandlers[opRet] := OpcodeReturn;
544	OpcodeHandlers[opRor] := OpcodeRor;
545	OpcodeHandlers[opRol] := OpcodeRol;
546	OpcodeHandlers[opInput] := OpcodeInput;
547	OpcodeHandlers[opOutput] := OpcodeOutput;
548	OpcodeHandlers[opAdd] := OpcodeAdd;
549	OpcodeHandlers[opSub] := OpcodeSub;
550	OpcodeHandlers[opLdir] := OpcodeLdir;
551	OpcodeHandlers[opLddr] := OpcodeLddr;
552	OpcodeHandlers[opJumpCond] := OpcodeJumpCond;
553	OpcodeHandlers[opJumpRelCond] := OpcodeJumpRelCond;
554	OpcodeHandlers[opTestEqual] := OpcodeTestEqual;
555	OpcodeHandlers[opTestNotEqual] := OpcodeTestNotEqual;
556	OpcodeHandlers[opTestLess] := OpcodeTestLess;
557	OpcodeHandlers[opTestLessEqual] := OpcodeTestLessEqual;
558	OpcodeHandlers[opTestGreater] := OpcodeTestGreat;
559	OpcodeHandlers[opTestGreaterEqual] := OpcodeTestGreatEqual;
560	OpcodeHandlers[opTestZero] := OpcodeTestZero;
561	OpcodeHandlers[opTestNotZero] := OpcodeTestNotZero;
562	OpcodeHandlers[opMul] := OpcodeMul;
563	OpcodeHandlers[opDiv] := OpcodeDiv;
564	OpcodeHandlers[opClear] := OpcodeClear;
565	OpcodeHandlers[opMod] := OpcodeMod;
566	end;
567
568
569	end.
570

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: branches/virtcpu varint/UCpu.pas

Download in other formats: