From bce77d6846cea41a44c3ae41491c2ab31fa85c24 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bart=C5=82omiej=20Szostak?= Date: Fri, 3 May 2024 19:15:16 +0200 Subject: [PATCH] Working on taking numbers as input --- src/shardware.adb | 91 ++++++++++++++++++++++++++++++++++++++++---- src/shardware.ads | 12 +++++- src/sillymachine.adb | 29 +++++++++----- 3 files changed, 113 insertions(+), 19 deletions(-) diff --git a/src/shardware.adb b/src/shardware.adb index 880187f..c613151 100644 --- a/src/shardware.adb +++ b/src/shardware.adb @@ -26,6 +26,18 @@ package body Shardware is end if; end UnToSignedInt; + function IntToUnSigned (Value : Integer) return Unsigned_32 is + Result : Integer := 0; + begin + if Value < 0 then + Result := Value + 1073741824; + Result := Result + 1073741824; + return Unsigned_32(Result) + 2147483648; + else + return Unsigned_32(Value); + end if; + end IntToUnSigned; + function BytesToBits (TheBytes : ByteArr) return BitArr is CurByte : Byte := 0; Buff : BitArr (1 .. 32); @@ -142,6 +154,33 @@ package body Shardware is return Result; end BytesToF; + function UToBytes (Number : Unsigned_32) return ByteArr is + BitBuff : BitArr (1 .. 32); + NumBuff : Unsigned_32 := Number; + begin + for i in reverse 1 .. 32 loop + if NumBuff mod 2 > 0 then + BitBuff (i) := True; + else + BitBuff (i) := False; + end if; + NumBuff := NumBuff / 2; + end loop; + return BitsToBytes(BitBuff); + end UToBytes; + + function IToBytes (Number : Integer) return ByteArr is + begin + return UToBytes(IntToUnSigned(Number)); + end IToBytes; + + function FToBytes (Number : Float) return ByteArr is + ByteBuff : ByteArr (1 .. 4); + begin + raise Constraint_Error with "Not Implemented!"; + return ByteBuff; + end FToBytes; + function ReadMem (Memory : ByteArr; Address : Unsigned_32; Length : Unsigned_32) return ByteArr is Result : ByteArr (1 .. Length); begin @@ -149,9 +188,22 @@ package body Shardware is Result (i) := Memory (Address - 1 + i); end loop; return Result; - end ReadMem; + end ReadMem; - procedure Trap (Registers : RegArrU; Memory : in out ByteArr; MemorySize : in out Unsigned_32) is + procedure WriteMem (Memory : in out ByteArr; Address : Unsigned_32; Stuff : ByteArr; ReverseFlag : Boolean := False) is + begin + if ReverseFlag then + for i in reverse 1 .. Stuff'Length loop + Memory (Address - 1 + Unsigned_32(i)) := Stuff (Unsigned_32(i)); + end loop; + else + for i in 1 .. Stuff'Length loop + Memory (Address - 1 + Unsigned_32(i)) := Stuff (Unsigned_32(i)); + end loop; + end if; + end WriteMem; + + procedure Trap (Registers : RegArrU; Memory : in out ByteArr; MemorySize : in out Unsigned_32; InputTypeFlag : InputType) is begin case Registers(0) is when 0 => @@ -160,11 +212,36 @@ package body Shardware is Length : Integer := Integer(Registers (3)); CharBuff : String (1 .. Length); begin - Get_Line(CharBuff ,Length); - for i in 1 .. Length loop - Memory (Pointer + Unsigned_32(i)) := Character'Pos(CharBuff (i)); - end loop; - Memory (Pointer + Unsigned_32(Length) + 1) := 10; + Get_Line(CharBuff, Length); + if InputTypeFlag = LEString then + for i in 1 .. Length loop + Memory (Pointer + Unsigned_32(i)) := Character'Pos(CharBuff (i)); + end loop; + Memory (Pointer + Unsigned_32(Length) + 1) := 10; + elsif InputTypeFlag = LEUint then + declare + ByteBuff : ByteArr (1 .. 4); + begin + ByteBuff := UToBytes(Unsigned_32'Value(CharBuff)); + WriteMem(Memory, Pointer, ByteBuff, True); + end; + elsif InputTypeFlag = LEInt then + declare + ByteBuff : ByteArr (1 .. 4); + begin + ByteBuff := IToBytes(Integer'Value(CharBuff)); + WriteMem(Memory, Pointer, ByteBuff, True); + end; + elsif InputTypeFlag = LEFloat then + declare + ByteBuff : ByteArr (1 .. 4); + begin + ByteBuff := FToBytes(Float'Value(CharBuff)); + WriteMem(Memory, Pointer, ByteBuff, True); + end; + else + null; + end if; end; when 1 => declare diff --git a/src/shardware.ads b/src/shardware.ads index 7b5b60a..6c23b65 100644 --- a/src/shardware.ads +++ b/src/shardware.ads @@ -13,9 +13,12 @@ package Shardware is type RegArrF is array (Integer range <>) of Float; type RegArrU is array (Integer range <>) of Unsigned_32; + type InputType is (LEString, LEUint, LEInt, LEFloat); + function TempBytes (Instruction : ByteArr) return ByteArr; function UnToSignedInt (Value : Unsigned_32) return Integer; + function IntToUnSigned (Value : Integer) return Unsigned_32; function BytesToBits (TheBytes : ByteArr) return BitArr; function BitsToBytes (BinNumber : BitArr) return ByteArr; @@ -26,9 +29,14 @@ package Shardware is function BytesToI (TheBytes : ByteArr) return Integer; function BytesToF (TheBytes : ByteArr) return Float; - function ReadMem (Memory : ByteArr; Address : Unsigned_32; Length : Unsigned_32) return ByteArr; + function UToBytes (Number : Unsigned_32) return ByteArr; + function IToBytes (Number : Integer) return ByteArr; + function FToBytes (Number : Float) return ByteArr; - procedure Trap (Registers : RegArrU; Memory : in out ByteArr; MemorySize : in out Unsigned_32); + function ReadMem (Memory : ByteArr; Address : Unsigned_32; Length : Unsigned_32) return ByteArr; + procedure WriteMem (Memory : in out ByteArr; Address : Unsigned_32; Stuff : ByteArr; ReverseFlag : Boolean := False); + + procedure Trap (Registers : RegArrU; Memory : in out ByteArr; MemorySize : in out Unsigned_32; InputTypeFlag : InputType); procedure MovU (Register : in out Unsigned_32; Value : Unsigned_32); procedure MovI (Register : in out Integer; Value : Integer); diff --git a/src/sillymachine.adb b/src/sillymachine.adb index df9ca81..9d92212 100644 --- a/src/sillymachine.adb +++ b/src/sillymachine.adb @@ -28,6 +28,8 @@ procedure sillymachine is ZeroFlag : Boolean := False; + InputTypeFlag : InputType := LEString; + begin @@ -112,8 +114,8 @@ begin end loop; case MyShiftU(Instruction (0), 8) + Unsigned_32(Instruction (1)) is -- execute the instruction - when 0 => null; -- NOP - when 1 => Trap(RegisterU, MemoryArr, MemorySize); -- TRAP + when 0 => null; -- NOP + when 1 => Trap(RegisterU, MemoryArr, MemorySize, InputTypeFlag); -- TRAP when 2 => MovU(RegisterU(Integer(Instruction (2))), -- Move Unsigned_32 to Register BytesToU(TempBytes(Instruction))); when 3 => MovU(RegisterU(Integer(Instruction (2))), -- Move Register to Register (Unsigned_32) @@ -180,30 +182,37 @@ begin BytesToF(TempBytes(Instruction))); when 34 => DivF(RegisterF(Integer(Instruction(2))), -- Divide Register by Register (Float) RegisterF(Integer(Instruction (3)))); - when 35 => ZeroFlag := CmpU(RegisterU(Integer(Instruction(2))), + when 35 => ZeroFlag := CmpU(RegisterU(Integer(Instruction(2))), -- Compare Register to Unsigned_32 BytesToU(TempBytes(Instruction))); - when 36 => ZeroFlag := CmpU(RegisterU(Integer(Instruction(2))), + when 36 => ZeroFlag := CmpU(RegisterU(Integer(Instruction(2))), -- Compare Register to Register (Unsigned_32) RegisterU(Integer(Instruction (3)))); - when 37 => ZeroFlag := CmpI(RegisterI(Integer(Instruction(2))), + when 37 => ZeroFlag := CmpI(RegisterI(Integer(Instruction(2))), -- Compare Register to Integer BytesToI(TempBytes(Instruction))); - when 38 => ZeroFlag := CmpI(RegisterI(Integer(Instruction(2))), + when 38 => ZeroFlag := CmpI(RegisterI(Integer(Instruction(2))), -- Compare Register to Register (Integer) RegisterI(Integer(Instruction (3)))); - when 39 => ZeroFlag := CmpF(RegisterF(Integer(Instruction(2))), + when 39 => ZeroFlag := CmpF(RegisterF(Integer(Instruction(2))), -- Compare Register to Float BytesToF(TempBytes(Instruction))); - when 40 => ZeroFlag := CmpF(RegisterF(Integer(Instruction(2))), + when 40 => ZeroFlag := CmpF(RegisterF(Integer(Instruction(2))), -- Compare Register to Register (Float) RegisterF(Integer(Instruction (3)))); - when 41 => + when 41 => -- Jump if ZeroFlag = True if ZeroFlag then PC := Jump(BytesToU(TempBytes(Instruction))); else null; end if; - when 42 => + when 42 => -- Jump if ZeroFlag = False if ZeroFlag then null; else PC := Jump(BytesToU(TempBytes(Instruction))); end if; + when 43 => -- Set InputTypeFlag + case RegisterU(27) is + when 1 => InputTypeFlag := LEUint; + when 2 => InputTypeFlag := LEInt; + when 3 => InputTypeFlag := LEFloat; + when others => InputTypeFlag := LEString; + end case; when 65535 => goto THE_END; -- exit opcode when others => null; end case;