initial upload
parent
cf8c3a51cb
commit
8fa66b024f
GPG Key ID:
7BA5A2980566A649
@ -1,7 +1,5 @@
|
||||
# ---> Ada
|
||||
# Object file
|
||||
*.o
|
||||
|
||||
# Ada Library Information
|
||||
*.ali
|
||||
|
||||
alire
|
||||
bin
|
||||
obj
|
||||
*.c8
|
||||
*.ch8
|
||||
|
||||
@ -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;
|
||||
@ -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"
|
||||
@ -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;
|
||||
@ -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;
|
||||
@ -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
|
||||
@ -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;
|
||||
@ -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;
|
||||
@ -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
|
||||
@ -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;
|
||||
@ -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;
|
||||
@ -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;
|
||||
@ -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;
|
||||
@ -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;
|
||||
@ -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;
|
||||
@ -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;
|
||||
@ -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;
|
||||
@ -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;
|
||||
Loading…
Reference in New Issue