initial schip implementation; add command line arguments

src/ada_chip.adb

@@ -17,9 +17,13 @@ procedure Ada_Chip is
    State            : CPU.Instance;
    Delay_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
       use ISA;
+      use Sf;
+      use Video;
 
       X          : constant Byte := State.Registers (VX);
       Y          : constant Byte := State.Registers (VY);
@@ -27,14 +31,45 @@ procedure Ada_Chip is
       Row_Pixels : Pixel with Address => Row'Address;
       VF         : Byte := 0;
    begin
+      if Model = Super_Chip_10 and then N = 0 then
+         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
+                  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;
+
+            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
-                  (Sf.sfUint32 ((X + Byte (J)) mod Video.Width),
+                     (sfUint32 (X + Byte (J)) mod Video.Width,
-                     Sf.sfUint32 ((Y + I) mod Video.Height))
+                        sfUint32 (Y + I) mod Video.Height)
                   then
                      VF := 1;
                   end if;
@@ -43,6 +78,7 @@ procedure Ada_Chip is
          end loop;
 
          State.Registers (15) := VF;
+      end if;
    end Draw_Sprite;
 
    procedure Run_Flow (ins : ISA.Opcode) is
@@ -50,6 +86,8 @@ procedure Ada_Chip is
       case ins.Value is
          when ISA.Clear_Screen => Video.Clear_Screen;
          when ISA.Ret => CPU.Ret (State);
+         when ISA.Low_Res => Video.Low_Res;
+         when ISA.High_Res => Video.High_Res;
          when others =>
             Ada.Text_IO.Put_Line ("Machine code calls are unsupported!");
             delay 1.0;
@@ -85,10 +123,35 @@ procedure Ada_Chip is
          when Set_Sound => Sound_Timer := Natural (State.Registers (X));
          when Reg_Store => CPU.Reg_Store (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 :=
             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 =>
             State.Memory (State.Address_Register) :=
                State.Registers (X) / 100;
@@ -143,17 +206,46 @@ procedure Ada_Chip is
       end case;
    end Run_Step;
 
-   Steps_Per_Frame   : constant := 8;
    Beep_Sound        : constant Sf.Audio.sfSound_Ptr := Sf.Audio.Sound.create;
    Beep_Sound_Buffer : constant Sf.Audio.sfSoundBuffer_Ptr :=
       Sf.Audio.SoundBuffer.createFromFile ("beep.ogg");
+
+   File_Loaded : Boolean := False;
 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
-      Video.Initialize;
+      Video.Initialize (Model);
+      Video.Low_Res;
       Random_Byte.Reset (Random_Generator);
-      CPU.Load_File (State, Ada.Command_Line.Argument (1));
       Sf.Audio.Sound.setBuffer (Beep_Sound, Beep_Sound_Buffer);
 
       while Video.Is_Running loop

src/cpu.ads

@@ -25,6 +25,23 @@ package CPU is
          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#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
       );
       Registers        : Register_Bank;
@@ -33,6 +50,8 @@ package CPU is
       Stack            : Address_Stack.Vector;
    end record;
 
+   RPL_Stash : constant Address := 240;
+
    procedure Load_File (Inst : in out Instance; File_Name : String);
 
    function Get_Opcode (Inst : in out Instance) return Opcode;

src/isa.ads

@@ -45,6 +45,8 @@ package ISA is
 
    Clear_Screen : constant Opcode_Value := 16#E0#;
    Ret          : constant Opcode_Value := 16#EE#;
+   Low_Res      : constant Opcode_Value := 16#FE#;
+   High_Res     : constant Opcode_Value := 16#FF#;
 
    type Math_Class is (
       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 (
-      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 (
@@ -82,9 +84,12 @@ package ISA is
       Set_Sound   => Opcode_Value (16#18#),
       Add_Address => Opcode_Value (16#1E#),
       Get_Font    => Opcode_Value (16#29#),
+      Get_Font_10 => Opcode_Value (16#30#),
       Get_BCD     => Opcode_Value (16#33#),
       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#;

src/video.adb

@@ -2,22 +2,55 @@ with Sf.Window;
 with Sf.Window.Event;
 with Sf.Window.Keyboard;
 with Sf.Graphics.Color;
+with Sf.Graphics.Image;
+with Sf.Graphics.RenderWindow;
+with Sf.Graphics.Texture;
 
 package body Video is
    procedure Clear_Screen is
    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);
          end loop;
       end loop;
    end Clear_Screen;
 
-   procedure Initialize is
+   procedure Low_Res is
    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.setPosition (Pixels_Sprite, (Float (0), Float (0)));
-      Sprite.setScale (Pixels_Sprite, (Float (Scale), Float (Scale)));
       RenderWindow.setFramerateLimit (app, 60);
    end Initialize;
 

src/video.ads

@@ -1,24 +1,25 @@
 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;
 
+   type Model is (Chip_8, Super_Chip_10);
    type Key is range 0 .. 15;
    type Key_Map is array (Key'Range) of Boolean;
 
-   Width  : constant := 64;
-   Height : constant := 32;
-   Scale  : constant := 10;
    Title  : constant String := "Ada-Chip";
 
+   Width  : sfUint32;
+   Height : sfUint32;
+   Scale  : sfUint32;
+
    procedure Clear_Screen;
-   procedure Initialize;
+   procedure Low_Res;
+   procedure High_Res;
+   procedure Initialize (M : Model);
    procedure Display;
    procedure Finish;
    procedure Poll_Events;
@@ -31,11 +32,8 @@ package Video is
 
 private
    Keys           : Key_Map;
-   Pixels         : constant sfImage_Ptr   := Image.create (Width, Height);
+   app            : sfRenderWindow_Ptr;
+   Pixels         : sfImage_Ptr;
+   Pixels_Texture : sfTexture_Ptr;
    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;