aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ada_chip.adb146
-rw-r--r--src/bit_ops.adb31
-rw-r--r--src/bit_ops.ads9
-rw-r--r--src/cpu.adb114
-rw-r--r--src/cpu.ads30
-rw-r--r--src/isa.adb10
-rw-r--r--src/isa.ads51
-rw-r--r--src/video.adb59
-rw-r--r--src/video.ads32
9 files changed, 482 insertions, 0 deletions
diff --git a/src/ada_chip.adb b/src/ada_chip.adb
new file mode 100644
index 0000000..b79db1c
--- /dev/null
+++ b/src/ada_chip.adb
@@ -0,0 +1,146 @@
+with Ada.Command_Line;
+with Ada.Numerics.Discrete_Random;
+with Ada.Text_IO;
+with Sf;
+
+with ISA; use ISA;
+with CPU;
+with Video;
+
+procedure Ada_Chip is
+ package Random_Byte is new Ada.Numerics.Discrete_Random (Byte);
+
+ Steps_Per_Frame : constant := 16;
+
+ State : CPU.Instance;
+ Random_Generator : Random_Byte.Generator;
+
+ procedure Draw_Sprite (VX, VY : Register_Index; N : Byte) is
+ use Sf;
+
+ X, Y : sfUint32;
+ Row : aliased Byte;
+ Row_Pixels : Pixel with Address => Row'Address;
+ VF : Boolean := False;
+ begin
+ X := sfUint32 (State.Registers (VX));
+ Y := sfUint32 (State.Registers (VY));
+
+ for I in 0 .. N - 1 loop
+ Row := State.Memory (State.Address_Register + Address (I));
+
+ for J in 0 .. 7 loop
+ if Row_Pixels (7 - J) then
+ if Video.Toggle_Pixel (X + sfUint32 (J), Y + sfUint32 (I)) then
+ VF := True;
+ end if;
+ end if;
+ end loop;
+ end loop;
+
+ State.Registers (15) := (if VF then 1 else 0);
+ end Draw_Sprite;
+
+ procedure Run_Step is
+ ins : Opcode;
+ begin
+ ins := CPU.Get_Opcode (State);
+ case ins.Class is
+ when Flow =>
+ case ins.Value is
+ when 16#E0# => Video.Clear_Screen;
+ when 16#EE# => CPU.Ret (State);
+ when others => begin
+ Ada.Text_IO.Put_Line ("Unknown flow instruction!");
+ Ada.Text_IO.Put_Line (Opcode_Value'Image (ins.Value));
+ delay 1.0;
+ Video.Finish;
+ end;
+ end case;
+ when Jump => CPU.Jump (State, Address (ins.Value));
+ when Call => CPU.Call (State, Address (ins.Value));
+ when Equal =>
+ if State.Registers (X_Register (ins)) = To_Byte (ins) then
+ CPU.Skip (State);
+ end if;
+ when Not_Equal =>
+ if State.Registers (X_Register (ins)) /= To_Byte (ins) then
+ CPU.Skip (State);
+ end if;
+ when Compare =>
+ if State.Registers (X_Register (ins)) =
+ State.Registers (Y_Register (ins))
+ then
+ CPU.Skip (State);
+ end if;
+ when Set_Register =>
+ State.Registers (X_Register (ins)) := To_Byte (ins);
+ when Add =>
+ State.Registers (X_Register (ins)) :=
+ State.Registers (X_Register (ins)) + To_Byte (ins);
+ when Math =>
+ CPU.Math (State, X_Register (ins), Y_Register (ins),
+ To_Byte (ins) mod 16);
+ when Not_Compare =>
+ if State.Registers (X_Register (ins)) /=
+ State.Registers (Y_Register (ins))
+ then
+ CPU.Skip (State);
+ end if;
+ when Set_Address =>
+ State.Address_Register := Address (ins.Value);
+ when Random =>
+ State.Registers (X_Register (ins)) :=
+ Random_Byte.Random (Random_Generator) mod To_Byte (ins);
+ when Draw_Sprite =>
+ Draw_Sprite (X_Register (ins), Y_Register (ins),
+ To_Byte (ins) mod 16);
+ when Misc =>
+ case To_Byte (ins) is
+ when 16#07# =>
+ State.Registers (X_Register (ins)) := State.Delay_Timer;
+ when 16#15# =>
+ State.Delay_Timer := State.Registers (X_Register (ins));
+ when 16#1E# =>
+ State.Address_Register := State.Address_Register +
+ Address (State.Registers (X_Register (ins)));
+ when 16#55# =>
+ CPU.Reg_Store (State, X_Register (ins));
+ when 16#65# =>
+ CPU.Reg_Load (State, X_Register (ins));
+ when others => begin
+ Ada.Text_IO.Put_Line ("Unknown misc instruction!");
+ Ada.Text_IO.Put_Line (Opcode_Value'Image (ins.Value));
+ delay 1.0;
+ Video.Finish;
+ end;
+ end case;
+ when others => begin
+ Ada.Text_IO.Put_Line ("Unknown instruction class!");
+ Ada.Text_IO.Put_Line (Opcode_Class'Image (ins.Class));
+ delay 1.0;
+ Video.Finish;
+ end;
+ end case;
+ end Run_Step;
+begin
+ if Ada.Command_Line.Argument_Count /= 1 then
+ Ada.Text_IO.Put_Line ("usage: adachip <.c8 file>");
+ else
+ Video.Initialize;
+ Random_Byte.Reset (Random_Generator);
+ CPU.Load_File (State, Ada.Command_Line.Argument (1));
+
+ while Video.Is_Running loop
+ Video.Display;
+
+ if State.Delay_Timer > 0 then
+ State.Delay_Timer := State.Delay_Timer - 1;
+ end if;
+
+ for I in 0 .. Steps_Per_Frame loop
+ Run_Step;
+ end loop;
+ end loop;
+ end if;
+end Ada_Chip;
diff --git a/src/bit_ops.adb b/src/bit_ops.adb
new file mode 100644
index 0000000..032ff6c
--- /dev/null
+++ b/src/bit_ops.adb
@@ -0,0 +1,31 @@
+package body Bit_Ops is
+ function Bitwise_Or (X, Y : Byte) return Byte is
+ X_Bits : Pixel with Address => X'Address;
+ Y_Bits : Pixel with Address => Y'Address;
+ Bits : aliased Pixel;
+ Bits_Byte : Byte with Address => Bits'Address;
+ begin
+ Bits := X_Bits or Y_Bits;
+ return Bits_Byte;
+ end Bitwise_Or;
+
+ function Bitwise_And (X, Y : Byte) return Byte is
+ X_Bits : Pixel with Address => X'Address;
+ Y_Bits : Pixel with Address => Y'Address;
+ Bits : aliased Pixel;
+ Bits_Byte : Byte with Address => Bits'Address;
+ begin
+ Bits := X_Bits and Y_Bits;
+ return Bits_Byte;
+ end Bitwise_And;
+
+ function Bitwise_Xor (X, Y : Byte) return Byte is
+ X_Bits : Pixel with Address => X'Address;
+ Y_Bits : Pixel with Address => Y'Address;
+ Bits : aliased Pixel;
+ Bits_Byte : Byte with Address => Bits'Address;
+ begin
+ Bits := X_Bits xor Y_Bits;
+ return Bits_Byte;
+ end Bitwise_Xor;
+end Bit_Ops;
diff --git a/src/bit_ops.ads b/src/bit_ops.ads
new file mode 100644
index 0000000..b975a8a
--- /dev/null
+++ b/src/bit_ops.ads
@@ -0,0 +1,9 @@
+with ISA;
+
+package Bit_Ops is
+ use ISA;
+
+ function Bitwise_Or (X, Y : Byte) return Byte;
+ function Bitwise_And (X, Y : Byte) return Byte;
+ function Bitwise_Xor (X, Y : Byte) return Byte;
+end Bit_Ops;
diff --git a/src/cpu.adb b/src/cpu.adb
new file mode 100644
index 0000000..809e039
--- /dev/null
+++ b/src/cpu.adb
@@ -0,0 +1,114 @@
+with Ada.Sequential_IO;
+with Ada.Text_IO;
+with Bit_Ops;
+
+package body CPU is
+ function Get_Opcode (Inst : in out Instance) return Opcode is
+ Op : aliased Opcode_Raw;
+ Op_Record : Opcode with Address => Op'Address;
+ begin
+ Op := Opcode_Raw (Inst.Memory (Inst.Program_Counter)) * 2 ** 8;
+ Op := Op + Opcode_Raw (Inst.Memory (Inst.Program_Counter + 1));
+ Inst.Program_Counter := Inst.Program_Counter + 2;
+ return Op_Record;
+ end Get_Opcode;
+
+ procedure Reg_Store (Inst : in out Instance; VX : Register_Index) is
+ begin
+ for I in 0 .. VX loop
+ Inst.Memory (Inst.Address_Register + Address (I)) :=
+ Inst.Registers (I);
+ end loop;
+ end Reg_Store;
+
+ procedure Reg_Load (Inst : in out Instance; VX : Register_Index) is
+ begin
+ for I in 0 .. VX loop
+ Inst.Registers (I) := Inst.Memory
+ (Inst.Address_Register + Address (I));
+ end loop;
+ end Reg_Load;
+
+ procedure Ret (Inst : in out Instance) is
+ begin
+ Jump (Inst, Inst.Stack.Last_Element);
+ Inst.Stack.Delete_Last;
+ end Ret;
+
+ procedure Call (Inst : in out Instance; A : Address) is
+ begin
+ Inst.Stack.Append (Inst.Program_Counter);
+ Jump (Inst, A);
+ end Call;
+
+ procedure Jump (Inst : in out Instance; A : Address) is
+ begin
+ Inst.Program_Counter := A;
+ end Jump;
+
+ procedure Skip (Inst : in out Instance) is
+ begin
+ Inst.Program_Counter := Inst.Program_Counter + 2;
+ end Skip;
+
+ procedure Math (Inst : in out Instance; VX, VY : Register_Index; N : Byte)
+ is begin
+ case N is
+ when 0 =>
+ Inst.Registers (VX) := Inst.Registers (VY);
+ when 1 =>
+ Inst.Registers (VX) := Bit_Ops.Bitwise_Or
+ (Inst.Registers (VX), Inst.Registers (VY));
+ when 2 =>
+ Inst.Registers (VX) := Bit_Ops.Bitwise_And
+ (Inst.Registers (VX), Inst.Registers (VY));
+ when 3 =>
+ Inst.Registers (VX) := Bit_Ops.Bitwise_Xor
+ (Inst.Registers (VX), Inst.Registers (VY));
+ when 4 =>
+ declare
+ X : constant Byte := Inst.Registers (VX);
+ Y : constant Byte := Inst.Registers (VY);
+ begin
+ Inst.Registers (VX) := X + Y;
+ Inst.Registers (15) :=
+ (if Integer (X) + Integer (Y) > Integer (X + Y)
+ then 1 else 0);
+ end;
+ when 5 =>
+ declare
+ X : constant Byte := Inst.Registers (VX);
+ Y : constant Byte := Inst.Registers (VY);
+ begin
+ Inst.Registers (VX) := X - Y;
+ Inst.Registers (15) := (if X >= Y then 1 else 0);
+ end;
+ when 6 =>
+ Inst.Registers (15) := Inst.Registers (VX) mod 2;
+ Inst.Registers (VX) := Inst.Registers (VX) / 2;
+ when 14 =>
+ Inst.Registers (15) := Inst.Registers (VX) / (2 ** 7);
+ Inst.Registers (VX) := Inst.Registers (VX) * 2;
+ when others => begin
+ Ada.Text_IO.Put_Line ("Uh oh!");
+ Ada.Text_IO.Put_Line (Byte'Image (N));
+ end;
+ end case;
+ end Math;
+
+ procedure Load_File (Inst : in out Instance; File_Name : String) is
+ package Byte_IO is new Ada.Sequential_IO (Byte);
+
+ I : Address := Start_Address;
+ File_Handle : Byte_IO.File_Type;
+ begin
+ Byte_IO.Open (File_Handle, Byte_IO.In_File, File_Name);
+
+ while not Byte_IO.End_Of_File (File_Handle) loop
+ Byte_IO.Read (File_Handle, Inst.Memory (I));
+ I := I + 1;
+ end loop;
+
+ Byte_IO.Close (File_Handle);
+ end Load_File;
+end CPU;
diff --git a/src/cpu.ads b/src/cpu.ads
new file mode 100644
index 0000000..2fb34f2
--- /dev/null
+++ b/src/cpu.ads
@@ -0,0 +1,30 @@
+with Ada.Containers.Vectors;
+with ISA;
+
+package CPU is
+ use ISA;
+
+ package Address_Stack is new Ada.Containers.Vectors
+ (Index_Type => Natural, Element_Type => Address);
+
+ type Instance is record
+ Memory : Bank;
+ Registers : Register_Bank;
+ Program_Counter : Address := Start_Address;
+ Address_Register : Address := 0;
+ Stack : Address_Stack.Vector;
+ Delay_Timer : Byte := 0;
+ end record;
+
+ procedure Load_File (Inst : in out Instance; File_Name : String);
+
+ function Get_Opcode (Inst : in out Instance) return Opcode;
+
+ procedure Reg_Store (Inst : in out Instance; VX : Register_Index);
+ procedure Reg_Load (Inst : in out Instance; VX : Register_Index);
+ procedure Ret (Inst : in out Instance);
+ procedure Call (Inst : in out Instance; A : Address);
+ procedure Jump (Inst : in out Instance; A : Address);
+ procedure Skip (Inst : in out Instance);
+ procedure Math (Inst : in out Instance; VX, VY : Register_Index; N : Byte);
+end CPU;
diff --git a/src/isa.adb b/src/isa.adb
new file mode 100644
index 0000000..5941660
--- /dev/null
+++ b/src/isa.adb
@@ -0,0 +1,10 @@
+package body ISA is
+ function To_Byte (O : Opcode) return Byte
+ is (Byte (O.Value mod 256));
+
+ function X_Register (O : Opcode) return Register_Index
+ is (Register_Index (O.Value / 256));
+
+ function Y_Register (O : Opcode) return Register_Index
+ is (Register_Index (O.Value / 16 mod 16));
+end ISA;
diff --git a/src/isa.ads b/src/isa.ads
new file mode 100644
index 0000000..656fcbf
--- /dev/null
+++ b/src/isa.ads
@@ -0,0 +1,51 @@
+package ISA is
+ type Byte is mod 2 ** 8;
+ type Address is mod 2 ** 12;
+ type Register_Index is mod 2 ** 4;
+ type Bank is array (Address) of Byte;
+ type Register_Bank is array (Register_Index) of Byte;
+ type Pixel is array (0 .. 7) of Boolean;
+ pragma Pack (Pixel);
+
+ type Opcode_Value is mod 2 ** 12;
+ type Opcode_Class is (
+ Flow, Jump, Call, Equal, Not_Equal, Compare, Set_Register, Add, Math,
+ Not_Compare, Set_Address, Jump_Relative, Random, Draw_Sprite, Input, Misc
+ ) with Size => 4;
+ type Opcode_Raw is mod 2 ** 16;
+ type Opcode is record
+ Value : Opcode_Value;
+ Class : Opcode_Class;
+ end record with
+ Size => 16;
+
+ for Opcode use record
+ Value at 0 range 0 .. 11;
+ Class at 0 range 12 .. 15;
+ end record;
+
+ for Opcode_Class use (
+ Flow => 0,
+ Jump => 1,
+ Call => 2,
+ Equal => 3,
+ Not_Equal => 4,
+ Compare => 5,
+ Set_Register => 6,
+ Add => 7,
+ Math => 8,
+ Not_Compare => 9,
+ Set_Address => 10,
+ Jump_Relative => 11,
+ Random => 12,
+ Draw_Sprite => 13,
+ Input => 14,
+ Misc => 15);
+
+ Start_Address : constant Address := 16#200#;
+
+ function To_Byte (O : Opcode) return Byte;
+
+ function X_Register (O : Opcode) return Register_Index;
+ function Y_Register (O : Opcode) return Register_Index;
+end ISA;
diff --git a/src/video.adb b/src/video.adb
new file mode 100644
index 0000000..0a93592
--- /dev/null
+++ b/src/video.adb
@@ -0,0 +1,59 @@
+with Sf.Window;
+with Sf.Window.Event;
+with Sf.Graphics.Color;
+
+package body Video is
+ procedure Clear_Screen is
+ begin
+ for X in 0 .. sfUint32 (Width) - 1 loop
+ for Y in 0 .. sfUint32 (Height) - 1 loop
+ Image.setPixel (Pixels, X, Y, Color.sfBlack);
+ end loop;
+ end loop;
+ end Clear_Screen;
+
+ procedure Initialize is
+ begin
+ Sprite.setTexture (Pixels_Sprite, Pixels_Texture);
+ Sprite.setPosition (Pixels_Sprite, (Float (0), Float (0)));
+ Sprite.setScale (Pixels_Sprite, (Float (Scale), Float (Scale)));
+ RenderWindow.setFramerateLimit (app, 60);
+ end Initialize;
+
+ function Is_Running return Boolean is
+ begin
+ return RenderWindow.isOpen (app) = sfTrue;
+ end Is_Running;
+
+ procedure Display is
+ use Sf.Window.Event;
+
+ e : sfEvent;
+ begin
+ while RenderWindow.pollEvent (app, event => e) = sfTrue loop
+ if e.eventType = sfEvtClosed then
+ RenderWindow.close (app);
+ end if;
+ end loop;
+
+ RenderWindow.clear (app, Color.sfWhite);
+ Texture.updateFromImage (Pixels_Texture, Pixels, 0, 0);
+ RenderWindow.drawSprite (app, Pixels_Sprite);
+ RenderWindow.display (app);
+ end Display;
+
+ function Toggle_Pixel (X, Y : sfUint32) return Boolean is
+ use Color;
+
+ P : constant sfColor := Image.getPixel (Pixels, X, Y);
+ R : constant Boolean := P = sfWhite;
+ begin
+ Image.setPixel (Pixels, X, Y, (if R then sfBlack else sfWhite));
+ return R;
+ end Toggle_Pixel;
+
+ procedure Finish is
+ begin
+ RenderWindow.close (app);
+ end Finish;
+end Video;
diff --git a/src/video.ads b/src/video.ads
new file mode 100644
index 0000000..09ff6e8
--- /dev/null
+++ b/src/video.ads
@@ -0,0 +1,32 @@
+with Sf;
+with Sf.Graphics;
+with Sf.Graphics.Image;
+with Sf.Graphics.RenderWindow;
+with Sf.Graphics.Sprite;
+with Sf.Graphics.Texture;
+
+package Video is
+ use Sf;
+ use Sf.Graphics;
+
+ Width : constant := 64;
+ Height : constant := 32;
+ Scale : constant := 10;
+ Title : constant String := "Ada-Chip";
+
+ procedure Clear_Screen;
+ procedure Initialize;
+ function Is_Running return Boolean;
+ procedure Display;
+ function Toggle_Pixel (X, Y : sfUint32) return Boolean;
+ procedure Finish;
+
+private
+ Pixels : constant sfImage_Ptr := Image.create (Width, Height);
+ Pixels_Sprite : constant sfSprite_Ptr := Sprite.create;
+ Pixels_Texture : constant sfTexture_Ptr :=
+ Texture.createFromImage (Pixels);
+
+ app : constant sfRenderWindow_Ptr := RenderWindow.create
+ ((Width * Scale, Height * Scale, 32), Title);
+end Video;
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-04 02:45:41 +0000