initial upload
parent
cf8c3a51cb
commit
8fa66b024f
@ -1,7 +1,5 @@
|
|||||||
# ---> Ada
|
alire
|
||||||
# Object file
|
bin
|
||||||
*.o
|
obj
|
||||||
|
*.c8
|
||||||
# Ada Library Information
|
*.ch8
|
||||||
*.ali
|
|
||||||
|
|
||||||
|
@ -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