diff --git a/.gitignore b/.gitignore index 54bc858..ab22702 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ sillymachine *.bin +*.sib *.ali *.o diff --git a/src/shardware.adb b/src/shardware.adb index 3743a25..b9ddd24 100644 --- a/src/shardware.adb +++ b/src/shardware.adb @@ -2,25 +2,66 @@ with Interfaces; use Interfaces; package body Shardware is - function My_Shift (Value : Byte; Amount : Integer) return Integer is + function My_ShiftI (Value : Byte; Amount : Integer) return Integer is begin - if Value > 127 and Amount > 23 then - return Integer(Shift_Left(Unsigned_128(Value), 23)); - else - return Integer(Shift_Left(Unsigned_128(Value), Amount)); - end if; - end My_Shift; + return Integer(Shift_Left(Unsigned_128(Value), Amount)); + end My_ShiftI; + function My_ShiftF (Value : Byte; Amount : Integer) return Float is + begin + return Float(Shift_Left(Unsigned_128(Value), Amount)); + end My_ShiftF; - procedure Mov (Register : in out Integer; Value : Integer) is + function My_ShiftU (Value : Byte; Amount : Integer) return Unsigned_32 is + begin + return Unsigned_32(Shift_Left(Unsigned_128(Value), Amount)); + end My_ShiftU; + + function Bytes_To_I (Instruction : ByteArr) return Integer is + begin + return Integer(My_ShiftI(Instruction (7), 24) + + My_ShiftI(Instruction (8), 16) + + My_ShiftI(Instruction (9), 8) + + Integer(Instruction (10))); + end Bytes_To_I; + + function Bytes_To_U (Instruction : ByteArr) return Unsigned_32 is + begin + return Unsigned_32(My_ShiftU(Instruction (7), 24) + + My_ShiftU(Instruction (8), 16) + + My_ShiftU(Instruction (9), 8) + + Unsigned_32(Instruction (10))); + end Bytes_To_U; + + procedure MovI (Register : in out Integer; Value : Integer) is begin Register := Value; - end Mov; + end MovI; - procedure Add (Register : in out Integer; Value : Integer) is + procedure AddI (Register : in out Integer; Value : Integer) is begin Register := Register + Value; - end Add; + end AddI; + + procedure MovF (Register : in out Float; Value : Float) is + begin + Register := Value; + end MovF; + + procedure AddF (Register : in out Float; Value : Float) is + begin + Register := Register + Value; + end AddF; + + procedure MovU (Register : in out Unsigned_32; Value : Unsigned_32) is + begin + Register := Value; + end MovU; + + procedure AddU (Register : in out Unsigned_32; Value : Unsigned_32) is + begin + Register := Register + Value; + end AddU; end Shardware; diff --git a/src/shardware.ads b/src/shardware.ads index 863b15b..42bbb88 100644 --- a/src/shardware.ads +++ b/src/shardware.ads @@ -1,4 +1,5 @@ with Ada.Sequential_IO; +with Interfaces; use Interfaces; package Shardware is @@ -6,11 +7,22 @@ package Shardware is package Bin_IO is new Ada.Sequential_IO (Byte); type ByteArr is array (Integer range <>) of Byte; - type RegArr is array (Integer range <>) of Integer; + type RegArrI is array (Integer range <>) of Integer; + type RegArrF is array (Integer range <>) of Float; + type RegArrU is array (Integer range <>) of Unsigned_32; - function My_Shift (Value : Byte; Amount : Integer) return Integer; + function My_ShiftI (Value : Byte; Amount : Integer) return Integer; + function My_ShiftF (Value : Byte; Amount : Integer) return Float; + function My_ShiftU (Value : Byte; Amount : Integer) return Unsigned_32; - procedure Mov (Register : in out Integer; Value : Integer); - procedure Add (Register : in out Integer; Value : Integer); + function Bytes_To_I (Instruction : ByteArr) return Integer; + function Bytes_To_U (Instruction : ByteArr) return Unsigned_32; + + procedure MovI (Register : in out Integer; Value : Integer); + procedure AddI (Register : in out Integer; Value : Integer); + procedure MovF (Register : in out Float; Value : Float); + procedure AddF (Register : in out Float; Value : Float); + procedure MovU (Register : in out Unsigned_32; Value : Unsigned_32); + procedure AddU (Register : in out Unsigned_32; Value : Unsigned_32); end Shardware; diff --git a/src/sillymachine.adb b/src/sillymachine.adb index 40d9596..21bd9a6 100644 --- a/src/sillymachine.adb +++ b/src/sillymachine.adb @@ -4,6 +4,8 @@ with Ada.Text_IO; use Ada.Text_IO; with Ada.Command_Line; use Ada.Command_Line; with Ada.Directories; +with Interfaces; use Interfaces; + procedure sillymachine is F : Bin_IO.File_Type; @@ -20,9 +22,12 @@ procedure sillymachine is PC : Integer := 0; -- Program Counter Instruction : ByteArr (0 .. 15); - Register : RegArr (0 .. 27); + RegisterI : RegArrI (0 .. 27); + RegisterF : RegArrF (0 .. 27); + RegisterU : RegArrU (0 .. 27); begin + ValidHeader (0) := 6; ValidHeader (1) := 148; @@ -84,7 +89,9 @@ begin MemoryArr : ByteArr (0 .. MemorySize); begin for i in 0 .. 27 loop -- zero initialise registers - Register (i) := 0; + RegisterI (i) := 0; + RegisterF (i) := 0.0; + RegisterU (i) := 0; end loop; for i in 0 .. MemorySize loop -- zero initialise memory @@ -106,30 +113,34 @@ begin Instruction (i) := MemoryArr (PC + i); end loop; - case My_Shift(Instruction (0), 8) + Integer(Instruction (1)) is -- execute the instruction - when 0 => Mov(Register(Integer(Instruction (2))), -- Move Int to Register (Only positive values for now) - Integer(My_Shift(Instruction (7), 24) - + My_Shift(Instruction (8), 16) - + My_Shift(Instruction (9), 8) - + Integer(Instruction (10))) - ); - when 1 => Mov(Register(Integer(Instruction (2))), -- Move Register to Register - Register(Integer(Instruction (3)))); - when 3 => null; -- Move Memory to Register - when 4 => Add(Register(Integer(Instruction (2))), -- Add Int to Register (Only positive values for now) - Integer(My_Shift(Instruction (7), 24) - + My_Shift(Instruction (8), 16) - + My_Shift(Instruction (9), 8) - + Integer(Instruction (10))) - ); - when 5 => Add(Register(Integer(Instruction (2))), -- Add Register to Register - Register(Integer(Instruction (3)))); + case My_ShiftI(Instruction (0), 8) + Integer(Instruction (1)) is -- execute the instruction + when 0 => null; -- NOP + when 1 => null; -- TODO: TRAP + when 2 => MovU(RegisterU(Integer(Instruction (2))), + Bytes_To_U(Instruction)); -- Move Unsigned_32 to Register + when 3 => MovU(RegisterU(Integer(Instruction (2))), -- Move Register to Register (Unsigned_32) + RegisterU(Integer(Instruction (3)))); + when 4 => null; -- TODO: Move Memory to Register + when 5 => AddU(RegisterU(Integer(Instruction (2))), -- Add Unsigned_32 to Register (Only positive values for now) + Bytes_To_U(Instruction)); + when 6 => AddU(RegisterU(Integer(Instruction (2))), -- Add Register to Register (Unsigned_32) + RegisterU(Integer(Instruction (3)))); + when 7 => MovI(RegisterI(Integer(Instruction (2))), -- Move Int to Register + Bytes_To_I(Instruction)); + when 8 => MovI(RegisterI(Integer(Instruction (2))), -- Move Register to Register (Int) + RegisterI(Integer(Instruction (3)))); + when 9 => null; -- TODO: Move Memory to Register + when 10 => AddI(RegisterI(Integer(Instruction (2))), -- Add Int to Register + Bytes_To_I(Instruction)); + when 11 => AddI(RegisterI(Integer(Instruction (2))), -- Add Register to Register (Int) + RegisterI(Integer(Instruction (3)))); when 65535 => goto THE_END; -- exit opcode when others => null; end case; - Put_Line(Integer'Image(Register(0))); - Put_Line(Integer'Image(Register(1))); + Put_Line(Unsigned_32'Image(RegisterU(0))); + Put_Line(Unsigned_32'Image(RegisterU(1))); + --Put_Line(Integer'Image(RegisterI(0))); PC := PC + 16; -- increment program counter to next instruction end loop; @@ -139,6 +150,4 @@ begin << THE_END >> exception when Name_Error => New_Line(1); Put("Error: File '"); Put(FileName); Put_Line("' does not exist!"); New_Line(1); - when Constraint_Error => New_Line(1); Put_Line("Error: Memory should be passed as an Integer"); New_Line(1); - when Storage_Error => New_Line(1); Put_Line("Error: Something went silly!"); New_Line(1); end sillymachine;