clyne
/
ada-chip
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

initial schip implementation; add command line arguments

Browse Source
super-chip
Clyne 1 week ago
parent 2eecfdaeca
commit 3465042dc2
Signed by: clyne
GPG Key ID: 3267C8EBF3F9AFC7
5 changed files with 188 additions and 41 deletions
Show Stats Download Patch File Download Diff File

132
src/ada_chip.adb
Unescape Escape View File

@ -17,9 +17,13 @@ procedure Ada_Chip is
State : CPU.Instance; State : CPU.Instance;
Delay_Timer : Natural := 0; Delay_Timer : Natural := 0;
Sound_Timer : Natural := 0; Sound_Timer : Natural := 0;
Model : Video.Model := Video.Chip_8;
Steps_Per_Frame : Natural := 8;
procedure Draw_Sprite (VX, VY : ISA.Register_Index; N : ISA.Byte) is procedure Draw_Sprite (VX, VY : ISA.Register_Index; N : ISA.Byte) is
use ISA; use ISA;
use Sf;
use Video;
X : constant Byte := State.Registers (VX); X : constant Byte := State.Registers (VX);
Y : constant Byte := State.Registers (VY); Y : constant Byte := State.Registers (VY);
@ -27,22 +31,54 @@ procedure Ada_Chip is
Row_Pixels : Pixel with Address => Row'Address; Row_Pixels : Pixel with Address => Row'Address;
VF : Byte := 0; VF : Byte := 0;
begin begin
for I in 0 .. N - 1 loop if Model = Super_Chip_10 and then N = 0 then
Row := State.Memory (State.Address_Register + Address (I)); for I in 0 .. Byte (15) loop
Row := State.Memory (State.Address_Register + Address (I * 2));
for J in 0 .. 7 loop
if Row_Pixels (7 - J) then for J in 0 .. 7 loop
if Video.Toggle_Pixel if Row_Pixels (7 - J) then
(Sf.sfUint32 ((X + Byte (J)) mod Video.Width), if Video.Toggle_Pixel
Sf.sfUint32 ((Y + I) mod Video.Height)) (sfUint32 (X + Byte (J)) mod Video.Width,
then sfUint32 (Y + I) mod Video.Height)
VF := 1; then
VF := 1;
end if;
end if; end if;
end if; end loop;
Row := State.Memory (State.Address_Register + Address (I * 2 + 1));
for J in 0 .. 7 loop
if Row_Pixels (7 - J) then
if Video.Toggle_Pixel
(sfUint32 (8 + X + Byte (J)) mod Video.Width,
sfUint32 (Y + I) mod Video.Height)
then
VF := 1;
end if;
end if;
end loop;
end loop;
State.Registers (15) := VF;
else
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
(sfUint32 (X + Byte (J)) mod Video.Width,
sfUint32 (Y + I) mod Video.Height)
then
VF := 1;
end if;
end if;
end loop;
end loop; end loop;
end loop;
State.Registers (15) := VF; State.Registers (15) := VF;
end if;
end Draw_Sprite; end Draw_Sprite;
procedure Run_Flow (ins : ISA.Opcode) is procedure Run_Flow (ins : ISA.Opcode) is
@ -50,6 +86,8 @@ procedure Ada_Chip is
case ins.Value is case ins.Value is
when ISA.Clear_Screen => Video.Clear_Screen; when ISA.Clear_Screen => Video.Clear_Screen;
when ISA.Ret => CPU.Ret (State); when ISA.Ret => CPU.Ret (State);
when ISA.Low_Res => Video.Low_Res;
when ISA.High_Res => Video.High_Res;
when others => when others =>
Ada.Text_IO.Put_Line ("Machine code calls are unsupported!"); Ada.Text_IO.Put_Line ("Machine code calls are unsupported!");
delay 1.0; delay 1.0;
@ -85,10 +123,35 @@ procedure Ada_Chip is
when Set_Sound => Sound_Timer := Natural (State.Registers (X)); when Set_Sound => Sound_Timer := Natural (State.Registers (X));
when Reg_Store => CPU.Reg_Store (State, X); when Reg_Store => CPU.Reg_Store (State, X);
when Reg_Load => CPU.Reg_Load (State, X); when Reg_Load => CPU.Reg_Load (State, X);
when Reg_Store_X => declare
I : constant Address := State.Address_Register;
begin
State.Address_Register := CPU.RPL_Stash;
CPU.Reg_Store (State, X);
State.Address_Register := I;
end;
when Reg_Load_X => declare
I : constant Address := State.Address_Register;
begin
State.Address_Register := CPU.RPL_Stash;
CPU.Reg_Load (State, X);
State.Address_Register := I;
end;
when Add_Address => State.Address_Register := when Add_Address => State.Address_Register :=
State.Address_Register + Address (State.Registers (X)); State.Address_Register + Address (State.Registers (X));
when Get_Font => when Get_Font => declare
State.Address_Register := Address (State.Registers (X) mod 16) * 5; use Video;
VX : constant Byte := State.Registers (X);
begin
if Model = Video.Super_Chip_10 and then VX > 15 then
State.Address_Register := Address (VX mod 16) * 10 + 80;
else
State.Address_Register := Address (VX mod 16) * 5;
end if;
end;
when Get_Font_10 =>
State.Address_Register := Address (State.Registers (X) mod 16)
* 10 + 80;
when Get_BCD => when Get_BCD =>
State.Memory (State.Address_Register) := State.Memory (State.Address_Register) :=
State.Registers (X) / 100; State.Registers (X) / 100;
@ -143,17 +206,46 @@ procedure Ada_Chip is
end case; end case;
end Run_Step; end Run_Step;
Steps_Per_Frame : constant := 8;
Beep_Sound : constant Sf.Audio.sfSound_Ptr := Sf.Audio.Sound.create; Beep_Sound : constant Sf.Audio.sfSound_Ptr := Sf.Audio.Sound.create;
Beep_Sound_Buffer : constant Sf.Audio.sfSoundBuffer_Ptr := Beep_Sound_Buffer : constant Sf.Audio.sfSoundBuffer_Ptr :=
Sf.Audio.SoundBuffer.createFromFile ("beep.ogg"); Sf.Audio.SoundBuffer.createFromFile ("beep.ogg");
File_Loaded : Boolean := False;
begin begin
if Ada.Command_Line.Argument_Count /= 1 then for I in 1 .. Ada.Command_Line.Argument_Count loop
Ada.Text_IO.Put_Line ("usage: adachip <.c8 file>"); declare
Arg : constant String := Ada.Command_Line.Argument (I);
begin
if Arg = "--schip" then
Ada.Text_IO.Put_Line ("Super-CHIP model selected.");
Model := Video.Super_Chip_10;
else
if Arg'Length > 6
and then Arg (1 .. 6) = "--spf="
then
Steps_Per_Frame := Natural'Value (Arg (7 .. Arg'Length));
else
if File_Loaded then
Ada.Text_IO.Put_Line ("More than one ROM specified!");
File_Loaded := False;
exit;
else
Ada.Text_IO.Put_Line ("Loading ROM: " &
Ada.Command_Line.Argument (I));
CPU.Load_File (State, Ada.Command_Line.Argument (I));
File_Loaded := True;
end if;
end if;
end if;
end;
end loop;
if not File_Loaded then
Ada.Text_IO.Put_Line ("usage: adachip [flags] <.c8 file>");
else else
Video.Initialize; Video.Initialize (Model);
Video.Low_Res;
Random_Byte.Reset (Random_Generator); Random_Byte.Reset (Random_Generator);
CPU.Load_File (State, Ada.Command_Line.Argument (1));
Sf.Audio.Sound.setBuffer (Beep_Sound, Beep_Sound_Buffer); Sf.Audio.Sound.setBuffer (Beep_Sound, Beep_Sound_Buffer);
while Video.Is_Running loop while Video.Is_Running loop

19
src/cpu.ads
Unescape Escape View File

@ -25,6 +25,23 @@ package CPU is
16#E0#, 16#90#, 16#90#, 16#90#, 16#E0#, -- D 16#E0#, 16#90#, 16#90#, 16#90#, 16#E0#, -- D
16#F0#, 16#80#, 16#F0#, 16#80#, 16#F0#, -- E 16#F0#, 16#80#, 16#F0#, 16#80#, 16#F0#, -- E
16#F0#, 16#80#, 16#F0#, 16#80#, 16#80#, -- F 16#F0#, 16#80#, 16#F0#, 16#80#, 16#80#, -- F
16#F0#, 0, 16#90#, 0, 16#90#, 0, 16#90#, 0, 16#F0#, 0, -- 0
16#20#, 0, 16#60#, 0, 16#20#, 0, 16#20#, 0, 16#70#, 0, -- 1
16#F0#, 0, 16#10#, 0, 16#F0#, 0, 16#80#, 0, 16#F0#, 0, -- 2
16#F0#, 0, 16#10#, 0, 16#F0#, 0, 16#10#, 0, 16#F0#, 0, -- 3
16#90#, 0, 16#90#, 0, 16#F0#, 0, 16#10#, 0, 16#10#, 0, -- 4
16#F0#, 0, 16#80#, 0, 16#F0#, 0, 16#10#, 0, 16#F0#, 0, -- 5
16#F0#, 0, 16#80#, 0, 16#F0#, 0, 16#90#, 0, 16#F0#, 0, -- 6
16#F0#, 0, 16#10#, 0, 16#20#, 0, 16#40#, 0, 16#40#, 0, -- 7
16#F0#, 0, 16#90#, 0, 16#F0#, 0, 16#90#, 0, 16#F0#, 0, -- 8
16#F0#, 0, 16#90#, 0, 16#F0#, 0, 16#10#, 0, 16#F0#, 0, -- 9
16#F0#, 0, 16#90#, 0, 16#F0#, 0, 16#90#, 0, 16#90#, 0, -- A
16#E0#, 0, 16#90#, 0, 16#E0#, 0, 16#90#, 0, 16#E0#, 0, -- B
16#F0#, 0, 16#80#, 0, 16#80#, 0, 16#80#, 0, 16#F0#, 0, -- C
16#E0#, 0, 16#90#, 0, 16#90#, 0, 16#90#, 0, 16#E0#, 0, -- D
16#F0#, 0, 16#80#, 0, 16#F0#, 0, 16#80#, 0, 16#F0#, 0, -- E
16#F0#, 0, 16#80#, 0, 16#F0#, 0, 16#80#, 0, 16#80#, 0, -- F
others => 0 others => 0
); );
Registers : Register_Bank; Registers : Register_Bank;
@ -33,6 +50,8 @@ package CPU is
Stack : Address_Stack.Vector; Stack : Address_Stack.Vector;
end record; end record;
RPL_Stash : constant Address := 240;
procedure Load_File (Inst : in out Instance; File_Name : String); procedure Load_File (Inst : in out Instance; File_Name : String);
function Get_Opcode (Inst : in out Instance) return Opcode; function Get_Opcode (Inst : in out Instance) return Opcode;

11
src/isa.ads
Unescape Escape View File

@ -45,6 +45,8 @@ package ISA is
Clear_Screen : constant Opcode_Value := 16#E0#; Clear_Screen : constant Opcode_Value := 16#E0#;
Ret : constant Opcode_Value := 16#EE#; Ret : constant Opcode_Value := 16#EE#;
Low_Res : constant Opcode_Value := 16#FE#;
High_Res : constant Opcode_Value := 16#FF#;
type Math_Class is ( type Math_Class is (
Assign, Bit_Or, Bit_And, Bit_Xor, Add, Sub_Y, Shift_Right, Sub_X, Assign, Bit_Or, Bit_And, Bit_Xor, Add, Sub_Y, Shift_Right, Sub_X,
@ -71,8 +73,8 @@ package ISA is
); );
type Misc_Class is ( type Misc_Class is (
Get_Delay, Get_Key, Set_Delay, Set_Sound, Add_Address, Get_Font, Get_BCD, Get_Delay, Get_Key, Set_Delay, Set_Sound, Add_Address, Get_Font,
Reg_Store, Reg_Load Get_Font_10, Get_BCD, Reg_Store, Reg_Load, Reg_Store_X, Reg_Load_X
); );
for Misc_Class use ( for Misc_Class use (
@ -82,9 +84,12 @@ package ISA is
Set_Sound => Opcode_Value (16#18#), Set_Sound => Opcode_Value (16#18#),
Add_Address => Opcode_Value (16#1E#), Add_Address => Opcode_Value (16#1E#),
Get_Font => Opcode_Value (16#29#), Get_Font => Opcode_Value (16#29#),
Get_Font_10 => Opcode_Value (16#30#),
Get_BCD => Opcode_Value (16#33#), Get_BCD => Opcode_Value (16#33#),
Reg_Store => Opcode_Value (16#55#), Reg_Store => Opcode_Value (16#55#),
Reg_Load => Opcode_Value (16#65#) Reg_Load => Opcode_Value (16#65#),
Reg_Store_X => Opcode_Value (16#75#),
Reg_Load_X => Opcode_Value (16#85#)
); );
Start_Address : constant Address := 16#200#; Start_Address : constant Address := 16#200#;

41
src/video.adb
Unescape Escape View File

@ -2,22 +2,55 @@ with Sf.Window;
with Sf.Window.Event; with Sf.Window.Event;
with Sf.Window.Keyboard; with Sf.Window.Keyboard;
with Sf.Graphics.Color; with Sf.Graphics.Color;
with Sf.Graphics.Image;
with Sf.Graphics.RenderWindow;
with Sf.Graphics.Texture;
package body Video is package body Video is
procedure Clear_Screen is procedure Clear_Screen is
begin begin
for X in 0 .. sfUint32 (Width) - 1 loop for X in 0 .. Width - 1 loop
for Y in 0 .. sfUint32 (Height) - 1 loop for Y in 0 .. Height - 1 loop
Image.setPixel (Pixels, X, Y, Color.sfBlack); Image.setPixel (Pixels, X, Y, Color.sfBlack);
end loop; end loop;
end loop; end loop;
end Clear_Screen; end Clear_Screen;
procedure Initialize is procedure Low_Res is
begin begin
Video.Width := 64;
Video.Height := 32;
Video.Scale := 10;
Sprite.setScale (Pixels_Sprite, (Float (Scale), Float (Scale)));
end Low_Res;
procedure High_Res is
begin
Video.Width := 128;
Video.Height := 64;
Video.Scale := 5;
Sprite.setScale (Pixels_Sprite, (Float (Scale), Float (Scale)));
end High_Res;
procedure Initialize (M : Model) is
begin
case M is
when Chip_8 =>
Width := 64;
Height := 32;
Scale := 10;
when Super_Chip_10 =>
Width := 128;
Height := 64;
Scale := 5;
end case;
app := RenderWindow.create ((Width * Scale, Height * Scale, 32), Title);
Pixels := Image.create (Width, Height);
Pixels_Texture := Texture.createFromImage (Pixels);
Sprite.setTexture (Pixels_Sprite, Pixels_Texture); Sprite.setTexture (Pixels_Sprite, Pixels_Texture);
Sprite.setPosition (Pixels_Sprite, (Float (0), Float (0))); Sprite.setPosition (Pixels_Sprite, (Float (0), Float (0)));
Sprite.setScale (Pixels_Sprite, (Float (Scale), Float (Scale)));
RenderWindow.setFramerateLimit (app, 60); RenderWindow.setFramerateLimit (app, 60);
end Initialize; end Initialize;

26
src/video.ads
Unescape Escape View File

@ -1,24 +1,25 @@
with Sf; with Sf;
with Sf.Graphics; with Sf.Graphics;
with Sf.Graphics.Image;
with Sf.Graphics.RenderWindow;
with Sf.Graphics.Sprite; with Sf.Graphics.Sprite;
with Sf.Graphics.Texture;
package Video is package Video is
use Sf; use Sf;
use Sf.Graphics; use Sf.Graphics;
type Model is (Chip_8, Super_Chip_10);
type Key is range 0 .. 15; type Key is range 0 .. 15;
type Key_Map is array (Key'Range) of Boolean; type Key_Map is array (Key'Range) of Boolean;
Width : constant := 64;
Height : constant := 32;
Scale : constant := 10;
Title : constant String := "Ada-Chip"; Title : constant String := "Ada-Chip";
Width : sfUint32;
Height : sfUint32;
Scale : sfUint32;
procedure Clear_Screen; procedure Clear_Screen;
procedure Initialize; procedure Low_Res;
procedure High_Res;
procedure Initialize (M : Model);
procedure Display; procedure Display;
procedure Finish; procedure Finish;
procedure Poll_Events; procedure Poll_Events;
@ -31,11 +32,8 @@ package Video is
private private
Keys : Key_Map; Keys : Key_Map;
Pixels : constant sfImage_Ptr := Image.create (Width, Height); app : sfRenderWindow_Ptr;
Pixels_Sprite : constant sfSprite_Ptr := Sprite.create; Pixels : sfImage_Ptr;
Pixels_Texture : constant sfTexture_Ptr := Pixels_Texture : sfTexture_Ptr;
Texture.createFromImage (Pixels); Pixels_Sprite : constant sfSprite_Ptr := Sprite.create;
app : constant sfRenderWindow_Ptr := RenderWindow.create
((Width * Scale, Height * Scale, 32), Title);
end Video; end Video;

Write Preview
Loading…
Cancel
Save