]> code.bitgloo.com Git - clyne/ada-chip.git/commitdiff
initial upload
authorClyne Sullivan <clyne@bitgloo.com>
Sat, 11 Jan 2025 17:14:28 +0000 (12:14 -0500)
committerClyne Sullivan <clyne@bitgloo.com>
Sat, 11 Jan 2025 17:14:28 +0000 (12:14 -0500)
18 files changed:
.gitignore
ada_chip.gpr [new file with mode: 0644]
alire.toml [new file with mode: 0644]
config/ada_chip_config.ads [new file with mode: 0644]
config/ada_chip_config.gpr [new file with mode: 0644]
config/ada_chip_config.h [new file with mode: 0644]
config/adachip_config.ads [new file with mode: 0644]
config/adachip_config.gpr [new file with mode: 0644]
config/adachip_config.h [new file with mode: 0644]
src/ada_chip.adb [new file with mode: 0644]
src/bit_ops.adb [new file with mode: 0644]
src/bit_ops.ads [new file with mode: 0644]
src/cpu.adb [new file with mode: 0644]
src/cpu.ads [new file with mode: 0644]
src/isa.adb [new file with mode: 0644]
src/isa.ads [new file with mode: 0644]
src/video.adb [new file with mode: 0644]
src/video.ads [new file with mode: 0644]

index f83922d01ae60f6e637a1a2b9f08871b4f87dfc8..6060e87ba0b37aba1809262ae4239f50f3543115 100644 (file)
@@ -1,7 +1,5 @@
-# ---> Ada
-# Object file
-*.o
-
-# Ada Library Information
-*.ali
-
+alire
+bin
+obj
+*.c8
+*.ch8
diff --git a/ada_chip.gpr b/ada_chip.gpr
new file mode 100644 (file)
index 0000000..63e5968
--- /dev/null
@@ -0,0 +1,22 @@
+with "config/adachip_config.gpr";
+project Ada_Chip is
+
+   for Source_Dirs use ("src/", "config/");
+   for Object_Dir use "obj/" & Adachip_Config.Build_Profile;
+   for Create_Missing_Dirs use "True";
+   for Exec_Dir use "bin";
+   for Main use ("ada_chip.adb");
+
+   package Compiler is
+      for Default_Switches ("Ada") use Adachip_Config.Ada_Compiler_Switches;
+   end Compiler;
+
+   package Binder is
+      for Switches ("Ada") use ("-Es"); --  Symbolic traceback
+   end Binder;
+
+   package Install is
+      for Artifacts (".") use ("share");
+   end Install;
+
+end Ada_Chip;
diff --git a/alire.toml b/alire.toml
new file mode 100644 (file)
index 0000000..6930eb5
--- /dev/null
@@ -0,0 +1,15 @@
+name = "ada_chip"
+description = "CHIP 8 emulator written in Ada"
+version = "0.1.0-dev"
+
+authors = ["Clyne Sullivan"]
+maintainers = ["Clyne Sullivan <clyne@bitgloo.com>"]
+maintainers-logins = ["clyne"]
+licenses = "GPL-3.0-or-later"
+website = "https://code.bitgloo.com/clyne/ada-chip"
+tags = []
+
+executables = ["ada_chip"]
+
+[[depends-on]]
+asfml = "^2.6.1"
diff --git a/config/ada_chip_config.ads b/config/ada_chip_config.ads
new file mode 100644 (file)
index 0000000..625aeb8
--- /dev/null
@@ -0,0 +1,20 @@
+--  Configuration for ada_chip generated by Alire
+pragma Restrictions (No_Elaboration_Code);
+pragma Style_Checks (Off);
+
+package Ada_Chip_Config is
+   pragma Pure;
+
+   Crate_Version : constant String := "0.1.0-dev";
+   Crate_Name : constant String := "ada_chip";
+
+   Alire_Host_OS : constant String := "linux";
+
+   Alire_Host_Arch : constant String := "x86_64";
+
+   Alire_Host_Distro : constant String := "debian";
+
+   type Build_Profile_Kind is (release, validation, development);
+   Build_Profile : constant Build_Profile_Kind := development;
+
+end Ada_Chip_Config;
diff --git a/config/ada_chip_config.gpr b/config/ada_chip_config.gpr
new file mode 100644 (file)
index 0000000..58d9276
--- /dev/null
@@ -0,0 +1,51 @@
+--  Configuration for ada_chip generated by Alire
+with "asfml.gpr";
+abstract project Ada_Chip_Config is
+   Crate_Version := "0.1.0-dev";
+   Crate_Name := "ada_chip";
+
+   Alire_Host_OS := "linux";
+
+   Alire_Host_Arch := "x86_64";
+
+   Alire_Host_Distro := "debian";
+   Ada_Compiler_Switches := External_As_List ("ADAFLAGS", " ");
+   Ada_Compiler_Switches := Ada_Compiler_Switches &
+          (
+            "-Og" -- Optimize for debug
+           ,"-ffunction-sections" -- Separate ELF section for each function
+           ,"-fdata-sections" -- Separate ELF section for each variable
+           ,"-g" -- Generate debug info
+           ,"-gnatwa" -- Enable all warnings
+           ,"-gnatw.X" -- Disable warnings for No_Exception_Propagation
+           ,"-gnatVa" -- All validity checks
+           ,"-gnaty3" -- Specify indentation level of 3
+           ,"-gnatya" -- Check attribute casing
+           ,"-gnatyA" -- Use of array index numbers in array attributes
+           ,"-gnatyB" -- Check Boolean operators
+           ,"-gnatyb" -- Blanks not allowed at statement end
+           ,"-gnatyc" -- Check comments
+           ,"-gnaty-d" -- Disable check no DOS line terminators present
+           ,"-gnatye" -- Check end/exit labels
+           ,"-gnatyf" -- No form feeds or vertical tabs
+           ,"-gnatyh" -- No horizontal tabs
+           ,"-gnatyi" -- Check if-then layout
+           ,"-gnatyI" -- check mode IN keywords
+           ,"-gnatyk" -- Check keyword casing
+           ,"-gnatyl" -- Check layout
+           ,"-gnatym" -- Check maximum line length
+           ,"-gnatyn" -- Check casing of entities in Standard
+           ,"-gnatyO" -- Check that overriding subprograms are explicitly marked as such
+           ,"-gnatyp" -- Check pragma casing
+           ,"-gnatyr" -- Check identifier references casing
+           ,"-gnatyS" -- Check no statements after THEN/ELSE
+           ,"-gnatyt" -- Check token spacing
+           ,"-gnatyu" -- Check unnecessary blank lines
+           ,"-gnatyx" -- Check extra parentheses
+           ,"-gnatW8" -- UTF-8 encoding for wide characters
+          );
+
+   type Build_Profile_Kind is ("release", "validation", "development");
+   Build_Profile : Build_Profile_Kind := "development";
+
+end Ada_Chip_Config;
diff --git a/config/ada_chip_config.h b/config/ada_chip_config.h
new file mode 100644 (file)
index 0000000..c0a1fa9
--- /dev/null
@@ -0,0 +1,20 @@
+/* Configuration for ada_chip generated by Alire */
+#ifndef ADA_CHIP_CONFIG_H
+#define ADA_CHIP_CONFIG_H
+
+#define CRATE_VERSION "0.1.0-dev"
+#define CRATE_NAME "ada_chip"
+
+#define ALIRE_HOST_OS "linux"
+
+#define ALIRE_HOST_ARCH "x86_64"
+
+#define ALIRE_HOST_DISTRO "debian"
+
+#define BUILD_PROFILE_RELEASE 1
+#define BUILD_PROFILE_VALIDATION 2
+#define BUILD_PROFILE_DEVELOPMENT 3
+
+#define BUILD_PROFILE  3
+
+#endif
diff --git a/config/adachip_config.ads b/config/adachip_config.ads
new file mode 100644 (file)
index 0000000..1949cad
--- /dev/null
@@ -0,0 +1,20 @@
+--  Configuration for adachip generated by Alire
+pragma Restrictions (No_Elaboration_Code);
+pragma Style_Checks (Off);
+
+package Adachip_Config is
+   pragma Pure;
+
+   Crate_Version : constant String := "0.1.0-dev";
+   Crate_Name : constant String := "adachip";
+
+   Alire_Host_OS : constant String := "linux";
+
+   Alire_Host_Arch : constant String := "x86_64";
+
+   Alire_Host_Distro : constant String := "debian";
+
+   type Build_Profile_Kind is (release, validation, development);
+   Build_Profile : constant Build_Profile_Kind := development;
+
+end Adachip_Config;
diff --git a/config/adachip_config.gpr b/config/adachip_config.gpr
new file mode 100644 (file)
index 0000000..adaade1
--- /dev/null
@@ -0,0 +1,52 @@
+--  Configuration for adachip generated by Alire
+with "asfml.gpr";
+abstract project Adachip_Config is
+   Crate_Version := "0.1.0-dev";
+   Crate_Name := "adachip";
+
+   Alire_Host_OS := "linux";
+
+   Alire_Host_Arch := "x86_64";
+
+   Alire_Host_Distro := "debian";
+   Ada_Compiler_Switches := External_As_List ("ADAFLAGS", " ");
+   Ada_Compiler_Switches := Ada_Compiler_Switches &
+          (
+            "-Og"
+           ,"-gnat2022"
+           ,"-ffunction-sections" -- Separate ELF section for each function
+           ,"-fdata-sections" -- Separate ELF section for each variable
+           ,"-g" -- Generate debug info
+           ,"-gnatwa" -- Enable all warnings
+           ,"-gnatw.X" -- Disable warnings for No_Exception_Propagation
+           ,"-gnatVa" -- All validity checks
+           ,"-gnaty3" -- Specify indentation level of 3
+           ,"-gnatya" -- Check attribute casing
+           ,"-gnatyA" -- Use of array index numbers in array attributes
+           ,"-gnatyB" -- Check Boolean operators
+           ,"-gnatyb" -- Blanks not allowed at statement end
+           ,"-gnatyc" -- Check comments
+           ,"-gnaty-d" -- Disable check no DOS line terminators present
+           ,"-gnatye" -- Check end/exit labels
+           ,"-gnatyf" -- No form feeds or vertical tabs
+           ,"-gnatyh" -- No horizontal tabs
+           ,"-gnatyi" -- Check if-then layout
+           ,"-gnatyI" -- check mode IN keywords
+           ,"-gnatyk" -- Check keyword casing
+           ,"-gnatyl" -- Check layout
+           ,"-gnatym" -- Check maximum line length
+           ,"-gnatyn" -- Check casing of entities in Standard
+           ,"-gnatyO" -- Check that overriding subprograms are explicitly marked as such
+           ,"-gnatyp" -- Check pragma casing
+           ,"-gnatyr" -- Check identifier references casing
+           ,"-gnatyS" -- Check no statements after THEN/ELSE
+           ,"-gnatyt" -- Check token spacing
+           ,"-gnatyu" -- Check unnecessary blank lines
+           ,"-gnatyx" -- Check extra parentheses
+           ,"-gnatW8" -- UTF-8 encoding for wide characters
+          );
+
+   type Build_Profile_Kind is ("release", "validation", "development");
+   Build_Profile : Build_Profile_Kind := "development";
+
+end Adachip_Config;
diff --git a/config/adachip_config.h b/config/adachip_config.h
new file mode 100644 (file)
index 0000000..1c5495e
--- /dev/null
@@ -0,0 +1,20 @@
+/* Configuration for adachip generated by Alire */
+#ifndef ADACHIP_CONFIG_H
+#define ADACHIP_CONFIG_H
+
+#define CRATE_VERSION "0.1.0-dev"
+#define CRATE_NAME "adachip"
+
+#define ALIRE_HOST_OS "linux"
+
+#define ALIRE_HOST_ARCH "x86_64"
+
+#define ALIRE_HOST_DISTRO "debian"
+
+#define BUILD_PROFILE_RELEASE 1
+#define BUILD_PROFILE_VALIDATION 2
+#define BUILD_PROFILE_DEVELOPMENT 3
+
+#define BUILD_PROFILE  3
+
+#endif
diff --git a/src/ada_chip.adb b/src/ada_chip.adb
new file mode 100644 (file)
index 0000000..b79db1c
--- /dev/null
@@ -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 (file)
index 0000000..032ff6c
--- /dev/null
@@ -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 (file)
index 0000000..b975a8a
--- /dev/null
@@ -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 (file)
index 0000000..809e039
--- /dev/null
@@ -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 (file)
index 0000000..2fb34f2
--- /dev/null
@@ -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 (file)
index 0000000..5941660
--- /dev/null
@@ -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 (file)
index 0000000..656fcbf
--- /dev/null
@@ -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 (file)
index 0000000..0a93592
--- /dev/null
@@ -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 (file)
index 0000000..09ff6e8
--- /dev/null
@@ -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;