ICFP Ada virtual machine
The ICFP contest of this year starts with the implementation of a virtual machine. While I didn’t participate to the contest itself, I wrote one in Python and rewrote another one in Ada for performance reasons. Here is its code, released in the public domain.
The Unchecked_Conversion
may look ugly, but they are the best way to get good performances out of the virtual machine. The code (155 lines including the header) shows how easy it is to write such a virtual machine in Ada.
This program has been written for a 32 bits machine, and should be endianness-agnostic.
-- ICFP Programming Contest 2006 -- Virtual Machine
-- Written by Samuel Tardieu <sam@rfc1149.net>, public domain
-- To compile: gnatmake -O3 -gnatp -fomit-frame-pointer vm
-- To run: ./vm codex.umz
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Interfaces; use Interfaces;
procedure VM is
type Arr is array (Unsigned_32 range <>) of Unsigned_32;
type Arr_Access is access Arr;
for Arr_Access'Size use 32;
procedure Free is
new Ada.Unchecked_Deallocation (Arr, Arr_Access);
function To_Unsigned_32 is
new Ada.Unchecked_Conversion (Arr_Access, Unsigned_32);
function To_Access is
new Ada.Unchecked_Conversion (Unsigned_32, Arr_Access);
: Arr_Access;
Mem0
: array (Unsigned_32'(0) .. 7) of Unsigned_32 := (others => 0);
Regs
: Unsigned_32 := 0;
PC
: exception;
End_Of_Program : exception;
Unknown_Opcode
procedure Interpret_Opcode is
: constant Unsigned_32 := Mem0 (PC);
Opcode : constant Unsigned_32 := Opcode / (2**28);
Operator : constant Unsigned_32 := (Opcode / 64) and 7;
A : constant Unsigned_32 := (Opcode / 8) and 7;
B : constant Unsigned_32 := Opcode and 7;
C : constant Unsigned_32 := PC;
Current_PC begin
if PC <= Mem0'Last then
:= PC + 1;
PC end if;
case Operator is
when 0 =>
if Regs (C) /= 0 then
(A) := Regs (B);
Regs end if;
when 1 =>
declare
: constant Arr_Access := To_Access (Regs (B));
Base begin
if Base = null then
(A) := Mem0 (Regs (C));
Regs else
(A) := Base (Regs (C));
Regs end if;
end;
when 2 =>
declare
: constant Arr_Access := To_Access (Regs (A));
Base begin
if Base = null then
(Regs (B)) := Regs (C);
Mem0 else
(Regs (B)) := Regs (C);
Base end if;
end;
when 3 =>
(A) := Regs (B) + Regs (C);
Regs when 4 =>
(A) := Regs (B) * Regs (C);
Regs when 5 =>
(A) := Regs (B) / Regs (C);
Regs when 6 =>
(A) := not (Regs (B) and Regs (C));
Regs when 7 =>
raise End_Of_Program;
when 8 =>
declare
: Unsigned_32;
Last begin
if Regs (C) = 0 then
:= 0;
Last else
:= Regs (C) - 1;
Last end if;
(B) := To_Unsigned_32 (new Arr'(0 .. Last => 0));
Regs end;
when 9 =>
declare
: Arr_Access := To_Access (Regs (C));
Base begin
(Base);
Free end;
when 10 =>
(Character'Val (Regs (C)));
Put
Flush;when 11 =>
declare
: Character;
X begin
(X);
Get_Immediate (X);
Put
Flush;(C) := Character'Pos (X);
Regs end;
when 12 =>
declare
: constant Arr_Access := To_Access (Regs (B));
Base begin
if Regs (B) /= 0 then
(Mem0);
Free := new Arr'(Base.all);
Mem0 end if;
:= Regs (C);
PC end;
when 13 =>
((Opcode / 2**25) and 7) := Opcode and (2**25 - 1);
Regs when others =>
raise Unknown_Opcode;
end case;
end Interpret_Opcode;
procedure Load is
use Ada.Streams, Ada.Streams.Stream_IO;
: Ada.Streams.Stream_IO.File_Type;
F : Stream_Element_Array (1 .. 4);
S : Stream_Element_Offset;
L begin
(F, In_File, Argument (1));
Open := new Arr (0 .. Unsigned_32 (Size (F)) / 4 - 1);
Mem0 for I in Mem0'Range loop
(F, S, L);
Read (I) := Unsigned_32 (S (1)) * 2**24 +
Mem0 (S (2)) * 2**16 +
Unsigned_32 (S (3)) * 2**8 +
Unsigned_32 (S (4));
Unsigned_32 end loop;
(F);
Close end Load;
begin
Load;loop
Interpret_Opcode;end loop;
exception
when End_Of_Program =>
null;
end VM;
blog comments powered by Disqus