aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorClyne Sullivan <clyne@bitgloo.com>2025-01-11 12:14:28 -0500
committerClyne Sullivan <clyne@bitgloo.com>2025-01-11 12:14:28 -0500
commit8fa66b024f91e47d8b5273e8c85ec5f60fe42d5b (patch)
tree1e3da4ec5bdfbbcb36ebd30ab9c055c45f50f279
parentcf8c3a51cb01b64ad2bc700fdd2b4906ef864877 (diff)
initial upload
-rw-r--r--.gitignore12
-rw-r--r--ada_chip.gpr22
-rw-r--r--alire.toml15
-rw-r--r--config/ada_chip_config.ads20
-rw-r--r--config/ada_chip_config.gpr51
-rw-r--r--config/ada_chip_config.h20
-rw-r--r--config/adachip_config.ads20
-rw-r--r--config/adachip_config.gpr52
-rw-r--r--config/adachip_config.h20
-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
18 files changed, 707 insertions, 7 deletions
diff --git a/.gitignore b/.gitignore
index f83922d..6060e87 100644
--- a/.gitignore
+++ b/.gitignore
@@ -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
index 0000000..63e5968
--- /dev/null
+++ b/ada_chip.gpr
@@ -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
index 0000000..6930eb5
--- /dev/null
+++ b/alire.toml
@@ -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
index 0000000..625aeb8
--- /dev/null
+++ b/config/ada_chip_config.ads
@@ -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
index 0000000..58d9276
--- /dev/null
+++ b/config/ada_chip_config.gpr
@@ -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
index 0000000..c0a1fa9
--- /dev/null
+++ b/config/ada_chip_config.h
@@ -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
index 0000000..1949cad
--- /dev/null
+++ b/config/adachip_config.ads
@@ -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
index 0000000..adaade1
--- /dev/null
+++ b/config/adachip_config.gpr
@@ -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
index 0000000..1c5495e
--- /dev/null
+++ b/config/adachip_config.h
@@ -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
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;