hp41cx_tools_1.6.3_ca239e6b/src/hp41cx_tools-decoder.adb

------------------------------------------------------------------------------
--: Copyright © 2020 … 2023 Martin Krischik «krischik@users.sourceforge.net»
------------------------------------------------------------------------------
--: This program is free software; you can redistribute it and/or modify it
--: under the terms of the GNU General Public License as published by the Free
--: Software Foundation; either version 2 of the License, or (at your option)
--: any later version.
--:
--: This program is distributed in the hope that it will be useful, but
--: WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
--: or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
--: for more details.
--:
--: You should have received a copy of the GNU General Public License along
--: with this program; if not, write to the Free Software Foundation, Inc., 59
--: Temple Place - Suite 330, Boston, MA 02111-1307, USA.
------------------------------------------------------------------------------
pragma License (Modified_Gpl);
pragma Ada_2022;
pragma Extensions_Allowed (On);

with Ada.Calendar;
with Ada.Characters.Conversions;
with Ada.Containers;
with Ada.Strings.Wide_Fixed;
with Ada.Strings.Wide_Unbounded;
with AdaCL.Wide_Strings;
with AdaCL.Trace;
with HP41CX_Tools.Alarm;
with HP41CX_Tools.Vector_IO;

---
--  @summary Decode PX-41CX memory dump
--
--  @description
--  Decode PX-41CX memory dump
--
package body HP41CX_Tools.Decoder is
   use type AdaCL.Trace.Parameter_Vectors.Vector;
   use type Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;

   package Fixed renames Ada.Strings.Wide_Fixed;
   package Strings renames Ada.Strings;
   package Unbounded renames Ada.Strings.Wide_Unbounded;
   package Conversions renames Ada.Characters.Conversions;

   ---
   --  Decode file.
   --
   --  @param In_File: File to decode @param Out_File: File to write result to
   --
   procedure Decode (In_File : in String; Out_File : in String) is
      pragma Debug (AdaCL.Trace.Entering (AdaCL.Trace.Parameter & In_File'Image & Out_File'Image));

      In_Data  : constant String_Vectors.Vector      := Vector_IO.Read_File (In_File);
      Out_Data : constant Wide_String_Vectors.Vector := Decode (In_Data);
   begin
      Vector_IO.Write_File (Out_File, Out_Data);

      pragma Debug (AdaCL.Trace.Exiting);
      return;
   end Decode;

   ---
   --  Decode text.
   --
   --  @param In_File: Text to decode @return Decoded Text
   --
   function Decode (Text : String_Vectors.Vector) return Wide_String_Vectors.Vector is
      pragma Debug (AdaCL.Trace.Entering (AdaCL.Trace.Parameter & Text'Image));

      use type Ada.Containers.Count_Type;
      use type Registers.Address_Type;

      Special          : Wide_String_Vectors.Vector;
      Register         : Wide_String_Vectors.Vector;
      Extended         : Wide_String_Vectors.Vector;
      Program          : Wide_String_Vectors.Vector;
      Program_Data     : Registers.Program_Digit_Array := [others => 16#00#];
      Program_Position : Positive                      := Program_Data'Last;
      Alpha            : Wide_String (1 .. 28)         := [others => ' '];
      Alarm_Data       : Registers.Program_Digit_Array := [others => 16#00#];
      Alarm_Position   : Positive                      := Alarm_Data'First;
      Alarm_Start      : Registers.Address_Type        := Registers.Main_Memory'Last;
      Alarm_End        : Registers.Address_Type        := Registers.Main_Memory'First;
      Address_Start    : Registers.Address_Type        := Registers.Main_Memory'First;
      Address_End      : Registers.Address_Type        := Registers.Main_Memory'Last;
      Memory_Size      : Registers.Address_Type        := Registers.Main_Memory'Last;
      Stack_Data       : Registers.Line_Data           :=
         [others =>
            [others => 16#00#]];

      function Decode_Alpha_Register (Data : Registers.Register_Digit_Array) return Wide_String is
         Retval : Wide_String (1 .. 7) := [others => ' '];
      begin
         for I in Retval'Range loop
            Retval (I) := Registers.Decode_Alpha (Data, I);
         end loop;
         return Retval;
      end Decode_Alpha_Register;

      procedure Add_Stack (Decoded : in Registers.Line_Type) is
      begin
         Stack_Data := Decoded.Data;
      end Add_Stack;

      procedure Add_LastX (Decoded : in Registers.Line_Type) is
      begin
         Alpha (22 .. 28) := Decode_Alpha_Register (Decoded.Data (2));
         Alpha (15 .. 21) := Decode_Alpha_Register (Decoded.Data (3));
         Alpha (8 .. 14)  := Decode_Alpha_Register (Decoded.Data (4));

         Special.Append
            ("; STACK = " & Registers.Convert (Stack_Data (4))'Wide_Image & " " &
             Registers.Convert (Stack_Data (3))'Wide_Image & " " & Registers.Convert (Stack_Data (2))'Wide_Image &
             " " & Registers.Convert (Stack_Data (1))'Wide_Image & " " &
             Registers.Convert (Decoded.Data (1))'Wide_Image);
      end Add_LastX;

      procedure Add_Alpha (Decoded : in Registers.Line_Type) is
      begin
         Alpha (1 .. 7) := Decode_Alpha_Register (Decoded.Data (1));

         Special.Append ("; ALPHA = " & Registers.Format_Alpha
                (Alpha (5 .. 28),
                 Add_Quotes  => True,
                 Trim_Spaces => False,
                 Trim_Null   => True));
      end Add_Alpha;

      procedure Add_Extended_Register (Decoded : in Registers.Line_Type) is
      begin
         Extended.Append
            ("; MEM = " & Registers.Image (Decoded.Address) & " " & Registers.Image (Decoded.Data (1)) & ' ' &
             Registers.Image (Decoded.Data (2)) & ' ' & Registers.Image (Decoded.Data (3)) & ' ' &
             Registers.Image (Decoded.Data (4)));
      end Add_Extended_Register;

      procedure Add_Key_Assignment (Data : in Registers.Key_Assignment_Digit_Array) is
         pragma Debug (AdaCL.Trace.Entering (AdaCL.Trace.Parameter & Data'Image));

         Assign_Key : HP41_Byte_Code renames Registers.Get_Byte (Data (5 .. 6));
      begin
         if Data not in Registers.Null_Key_Assignment_Digit_Array then
            Special.Append
               ("; KEY = " &
                (if Registers.Get_Byte (Data (1 .. 2)) in XROM_Code then Decode_XROM (Data (1 .. 4))
                 else Decode_HP41 (Data (3 .. 4))) &
                ' ' & HP41_Key_Map (Assign_Key)'Wide_Image);
         end if;

         pragma Debug (AdaCL.Trace.Exiting);
         return;
      end Add_Key_Assignment;

      procedure Add_Register (Decoded : in Registers.Line_Type) is
         Register_Line : Unbounded.Unbounded_Wide_String;
         Memory_Line   : Unbounded.Unbounded_Wide_String;
      begin
         for I in Decoded.Data'Range loop
            declare
               Data_Address : constant Registers.Address_Type := Decoded.Address + Registers.Address_Type (I) - 1;
            begin
               if Data_Address in Address_End .. Address_Start then
                  --  Decode register containing programm data. Note that the programm is stored in reverse and that
                  --  start is larger then end.

                  if Program.Length = 0 then
                     Program.Append
                        ("; PRG = " & Registers.Image (Address_Start) & " .. " & Registers.Image (Address_End));
                  end if;

                  Program_Data (Program_Position - Registers.Digits_Per_Register + 1 .. Program_Position) :=
                     Decoded.Data (I);
                  Program_Position := @ - Registers.Digits_Per_Register;
               elsif Data_Address in Alarm_Start .. Alarm_End then
                  --  Decode alarm data. Note that the alarm address data must be decoded first.

                  Alarm_Data (Alarm_Position .. Alarm_Position + Registers.Digits_Per_Register - 1) :=
                     Decoded.Data (I);
                  Alarm_Position := @ + Registers.Digits_Per_Register;
               elsif Data_Address > Address_Start then
                  --  Decode Register containing numeric or alpha data.

                  if Register_Line.Length = 0 then
                     Register_Line :=
                        Register_Line & "; REG" &
                        Registers.Address_Display_Text (Decoded.Address - Address_Start - 1) & " =";
                  end if;

                  Register_Line.Append (" " & Registers.Display_Text (Decoded.Data (I)));
               elsif Registers.Get_Byte (Decoded.Data (I) (1 .. 2)) = 16#F0# then
                  --  Decode register containing numeric or alpha data.

                  Add_Key_Assignment (Decoded.Data (I) (3 .. 8));
                  Add_Key_Assignment (Decoded.Data (I) (9 .. 14));
               elsif Registers.Get_Byte (Decoded.Data (I) (1 .. 2)) = 16#AA# then
                  --  Decode alarm address range. Note that the actual alarm data is decoded further up.

                  Alarm_Start := Decoded.Address + Registers.Address_Type (I) - 1;
                  Alarm_End   :=
                     Alarm_Start + Registers.Address_Type (Registers.Get_Byte (Decoded.Data (I) (3 .. 4)) - 1);
               elsif Decoded.Data (I) not in Registers.Null_Register_Digit_Array then
                  --  Just add anything else as a comment

                  if Memory_Line.Length = 0 then
                     Memory_Line :=
                        Memory_Line & "; " & Registers.Image (Decoded.Address + Registers.Address_Type (I) - 1) & " =";
                  end if;
                  Memory_Line.Append (" " & Registers.Image (Decoded.Data (I)));
               end if;
            end;
         end loop;

         if Register_Line.Length > 0 then
            Register.Append (Register_Line.Trim (Side => Strings.Right).To_Wide_String);
         end if;
         if Memory_Line.Length > 0 then
            Register.Append (Memory_Line.Trim (Side => Strings.Right).To_Wide_String);
         end if;
      end Add_Register;

      procedure Extract_Program_Address (Decoded : in Registers.Line_Type) is
         Register_2 : constant Registers.Register_Digit_Array := Decoded.Data (2);
         SReg_Start : constant Registers.Address_Type         := Registers.Get_Address (Register_2, 1);
         Prg_Start  : constant Registers.Address_Type         := Registers.Get_Address (Register_2, 8);
         Prg_End    : constant Registers.Address_Type         := Registers.Get_Address (Register_2, 11);
      begin
         Memory_Size   := Registers.Main_Memory'Last + 1 - Prg_Start;
         Address_Start := Prg_Start - 1;
         Address_End   := Prg_End;
         Special.Append ("; SIZE = " & Memory_Size'Wide_Image);
         Special.Append ("; ΣREG = " & SReg_Start'Wide_Image);
      end Extract_Program_Address;

      Retval : Wide_String_Vectors.Vector;
   begin
      --  Check_Header (In_Text);

      for Cursor in Text.Iterate loop
         declare
            Line : constant String := Text (Cursor);
         begin
            exit when Line = PX41_Footer;

            if Line'Length = 0 or else Line = PX41_Header or else Line = DM41_Header then
               --  Header or footer - ignore. Maybe add consitancy checks later.
               null;
            elsif Line (2) = ':' then
               --  Internal CPU register. Just add as a comment.
               Special.Append ("; " & Conversions.To_Wide_String (Line));
            else
               --  register line
               declare
                  Decoded : constant Registers.Line_Type := Registers.Value (Line);
               begin
                  case Decoded.Address is
                     when 16#000# =>
                        Add_Stack (Decoded);
                     when 16#004# =>
                        Add_LastX (Decoded);
                     when 16#008# =>
                        Add_Alpha (Decoded);
                     when 16#00c# =>
                        Extract_Program_Address (Decoded);
                     when Registers.Extended_1
                        | Registers.Extended_2
                        | Registers.Extended_3 =>
                        Add_Extended_Register (Decoded);
                     when others =>
                        Add_Register (Decoded);
                  end case;
               end;
            end if;
         end;
      end loop;

      if Alarm_Position > Alarm_Data'First then
         Decode_Alarm (Alarm_Data (Alarm_Data'First .. Alarm_Position - 1), Special);
      end if;
      if Special.Length > 0 then
         Retval.Append_Vector (Special);
      end if;
      if Register.Length > 0 then
         Retval.Append_Vector (Register);
      end if;
      if Program.Length > 0 then
         Decode_Program (Program_Data (Program_Position + 1 .. Program_Data'Last), Program);
         Retval.Append_Vector (Program);
      end if;
      if Extended.Length > 0 then
         Retval.Append_Vector (Extended);
      end if;

      pragma Debug (AdaCL.Trace.Exiting (Out_Parameter => Retval'Image));
      return Retval;
   end Decode;

   function Decode_HP41 (Code : in Registers.Byte_Digit_Array) return Wide_String is
      (Fixed.Trim (HP41_Single_Code_Map (Registers.Get_Byte (Code)), Side => Strings.Right));

   function Decode_XROM (Code : in Registers.Word_Digit_Array) return Wide_String is
      Code_Nr  : constant HP41_Word_Code := Registers.Get_Word (Code);
      Code_Str : Wide_String (1 .. 7)    := [others => ' '];
   begin
      if Code_Nr in ROM_Code_Map'Range then
         Code_Str := ROM_Code_Map (Code_Nr);
      end if;

      return
         (if Code_Str (1) /= ' ' then Fixed.Trim (Code_Str, Side => Strings.Right)
          else "XROM " & Registers.Image (Code));
   end Decode_XROM;

   procedure Decode_Step
      (Code     : in     Registers.Digit_Array;
       Position : in out Positive;
       Text     : in out Wide_String_Vectors.Vector)
   is
      function Trace_Code
         (Code     : in Registers.Digit_Array;
          Position : in Positive)
          return AdaCL.Trace.Parameter_Vectors.Vector is
         ([Conversions.To_String (Registers.Image (Code (Position .. Positive'Min (Position + 5, Code'Last)))),
          Position'Image & Text'Image]) with
         Inline, Pre => Position <= Code'Last;
      pragma Debug (AdaCL.Trace.Entering (Trace_Code (Code, Position)));

      use type Registers.Digit_Array;
      use type Registers.Digit_Type;

      A              : constant Registers.Digit_Type := 10;
      B              : constant Registers.Digit_Type := 11;
      C              : constant Registers.Digit_Type := 12;
      D              : constant Registers.Digit_Type := 13;
      E              : constant Registers.Digit_Type := 14;
      F              : constant Registers.Digit_Type := 15;
      Program_Lenght : constant                      := 20;

      procedure Append
         (Code        : in     Registers.Digit_Array;
          Instruction : in     Unbounded.Unbounded_Wide_String;
          Position    : in out Positive;
          Increment   : in     Natural;
          Text        : in out Wide_String_Vectors.Vector)
      is
         Line : Unbounded.Unbounded_Wide_String := Instruction;
      begin
         if Increment > 0 then
            Line :=
               @ & (Program_Lenght - @.Length) * ' ' & "; " &
               Registers.Image (Code (Position .. Position + Increment - 1));

            Position := @ + Increment;
         end if;

         Text.Append (Line.To_Wide_String);
      end Append;

      procedure Append
         (Code        : in     Registers.Digit_Array;
          Instruction : in     Wide_String;
          Position    : in out Positive;
          Increment   : in     Natural;
          Text        : in out Wide_String_Vectors.Vector)
      is
      begin
         Append (Code, Unbounded.To_Unbounded_Wide_String (Instruction), Position, Increment, Text);
      end Append;

      function Equal
         (Check  : in Registers.Digit_Array;
          Offset : in Natural := 0)
          return Boolean with
         Inline
      is
         pragma Debug (AdaCL.Trace.Entering (AdaCL.Trace.Parameter & Check'Image & Offset'Image));

         First  : constant Positive := Position + Offset;
         Last   : constant Positive := First + Check'Length - 1;
         Retval : Boolean;
      begin
         Retval := Last <= Code'Last and then Code (First .. Last) = Check;

         pragma Debug (AdaCL.Trace.Exiting (Out_Parameter => Retval'Image));
         return Retval;
      end Equal;

      procedure Decode_Number
         (Code     : in     Registers.Digit_Array;
          Position : in out Positive;
          Text     : in out Wide_String_Vectors.Vector)
      is
         pragma Debug (AdaCL.Trace.Entering (Trace_Code (Code, Position)));

         Instruction : Unbounded.Unbounded_Wide_String;
         Code_Comp   : Unbounded.Unbounded_Wide_String;
      begin
         loop
            declare
               Current : Registers.Digit_Array renames Code (Position .. Position + 1);
            begin
               AdaCL.Trace.Write (Current'Image);

               Instruction := @ & Decode_HP41 (Current);
               Code_Comp   := @ & Registers.Image (Current);
               Position    := @ + 2;

               AdaCL.Trace.Write ("Pos = " & Position'Image & "; Code'Last = " & Code'Last'Image);

               exit when not
                  ((Position + 1 <= Code'Last)
                   and then Registers.Get_Byte (Code (Position .. Position + 1)) in 16#10# .. 16#1C#);
            end;
         end loop;

         Instruction := @ & (Program_Lenght - @.Length) * ' ' & "; " & Code_Comp;
         Text.Append (Instruction.To_Wide_String);

         pragma Debug (AdaCL.Trace.Exiting (AdaCL.Trace.Parameter & Position'Image & Text'Image));
         return;
      end Decode_Number;

      function Decode_Synt
         (Code      : in HP41_Byte_Code;
          For_Label : in Boolean)
          return Wide_String
      is
         Retval : Synthetic_Text := [others => ' '];
      begin
         if Code in Register_Code and then (not For_Label or else Code in Label_Code) then
            Retval := HP41_Synthetic_Register_Map (Code);
         end if;
         return Retval;
      end Decode_Synt;

      ---
      --: alpha Fxxxxx.... xx
      --: 1111 nnnn aabb ccdd .... eeff
      --: 1111 is F
      --:      nnnn is number of letters in the text
      --:           aabb ccdd .... eeff is the text
      --:
      procedure Decode_Alpha
         (Code     : in     Registers.Digit_Array;
          Position : in out Positive;
          Text     : in out Wide_String_Vectors.Vector)
      is
         pragma Debug
            (AdaCL.Trace.Entering
                (AdaCL.Trace.Parameter & Code (Position .. Position + 6)'Image & Position'Image & Text'Image));

         Instruction : Unbounded.Unbounded_Wide_String;
         Lenght      : constant Positive    := Positive (Code (Position + 1)) * 2;
         Start       : constant Positive    := 2;
         Alpha_Code  : Registers.Digit_Array renames Code (Position + Start .. Position + Start + Lenght - 1);
         Alpha       : constant Wide_String := Registers.Format_Alpha
               (Alpha_Code,
                Add_Quotes  => True,
                Trim_Spaces => False,
                Trim_Null   => True);
      begin
         Instruction := @ & Alpha;
         Append (Code, Instruction, Position, Start + Lenght, Text);

         pragma Debug (AdaCL.Trace.Exiting (AdaCL.Trace.Parameter & Position'Image & Text'Image));
         return;
      end Decode_Alpha;

      ---
      --: LBL alpha: Cx xx Fx aa aa aa .. aa^
      --:
      --: 1010 bbbr rrrr rrrr 1111 nnnn kkkk aabb ccdd .... eeff
      --: 1010 is C
      --:      bbb is number of bytes to next LBL
      --:         r rrrr rrrr is number of registers to next LBL
      --:                     1111 is F
      --:                          nnnn is number of letters + 1
      --:                               kkkk is assign keycode
      --:                                    aabb ccdd .... eeff is the text
      --:
      procedure Decode_LBL_Alpha
         (Code     : in     Registers.Digit_Array;
          Position : in out Positive;
          Text     : in out Wide_String_Vectors.Vector)
      is
         pragma Debug
            (AdaCL.Trace.Entering
                (AdaCL.Trace.Parameter & Code (Position .. Position + 6)'Image & Position'Image & Text'Image));

         Instruction : Unbounded.Unbounded_Wide_String;
         Lenght      : constant Positive       := Positive (Code (Position + 5) - 1) * 2;
         Start       : constant                := 8;
         Label_Key   : constant HP41_Byte_Code := Registers.Get_Byte (Code (Position + 6 .. Position + 7));
         Alpha_Code  : Registers.Digit_Array renames Code (Position + Start .. Position + Start + Lenght - 1);
         Alpha       : constant Wide_String    := Registers.Format_Alpha
               (Registers.Decode_Reg_Alpha (Alpha_Code),
                Add_Quotes  => True,
                Trim_Spaces => False,
                Trim_Null   => True);
      begin
         Instruction := @ & "LBL " & Alpha;

         if Label_Key /= 16#00# and then Label_Key in HP41_Key_Map'Range and then HP41_Key_Map (Label_Key) /= 0 then
            Instruction := @ & (Program_Lenght - @.Length) * ' ' & "; Key: " & HP41_Key_Map (Label_Key)'Wide_Image;
            Position    := @ + Start + Lenght;
            Text.Append (Instruction.To_Wide_String);
         else
            Append (Code, Instruction, Position, Start + Lenght, Text);
         end if;

         pragma Debug (AdaCL.Trace.Exiting (AdaCL.Trace.Parameter & Position'Image & Text'Image));
         return;
      end Decode_LBL_Alpha;

      ---
      --: GTO alpha 1D Fx xx xx ....
      --: 0001 1101 1111 nnnn aabb ccdd .... eeff
      --: 0001 1101 1111 is 1D F
      --:                nnnn is number of letters in the text
      --:                     aabb ccdd .... eeff is the text
      --:
      --: XEQ alpha 1E Fx xx xx....
      --: 0001 1110 1111 nnnn aabb ccdd .... eeff
      --: 0001 1110 1111 er 1E F
      --:                nnnn is number of letters in the text
      --:                     aabb ccdd .... eeff is the text
      --:
      procedure Decode_GTO_Alpha
         (Code     : in     Registers.Digit_Array;
          Position : in out Positive;
          Text     : in out Wide_String_Vectors.Vector)
      is
         pragma Debug
            (AdaCL.Trace.Entering
                (AdaCL.Trace.Parameter & Code (Position .. Position + 6)'Image & Position'Image & Text'Image));

         Instruction : Unbounded.Unbounded_Wide_String;
         Lenght      : constant Positive    := Positive (Code (Position + 3)) * 2;
         Start       : constant             := 4;
         Alpha_Code  : Registers.Digit_Array renames Code (Position + Start .. Position + Start + Lenght - 1);
         Alpha       : constant Wide_String := Registers.Format_Alpha
               (Registers.Decode_Reg_Alpha (Alpha_Code),
                Add_Quotes  => True,
                Trim_Spaces => False,
                Trim_Null   => True);
      begin
         Instruction := @ & Decode_HP41 (Code (Position .. Position + 1)) & ' ' & Alpha;

         Append (Code, Instruction, Position, Start + Lenght, Text);

         pragma Debug (AdaCL.Trace.Exiting (AdaCL.Trace.Parameter & Position'Image & Text'Image));
         return;
      end Decode_GTO_Alpha;

      ---
      --:  END:  Cx xx xx
      --:  1100 bbbr rrrr rrrr 0ne0 1pc1
      --:  1100 is C
      --:       bbb is number of bytes to next END
      --:          r rrrr rrrr is number of registers to next END
      --:                       n is 0=NOT PRIVATE or 1=PRIVATE
      --:                        e is 0=END or 1=.END.
      --:                            p is 0=packed or 1=unpacked
      --:                             c is 0=compiled or 1=not compiled
      procedure Decode_End
         (Code     : in     Registers.Digit_Array;
          Position : in out Positive;
          Text     : in out Wide_String_Vectors.Vector)
      is
         pragma Debug (AdaCL.Trace.Entering (Trace_Code (Code, Position)));

      begin
         if (Code (Position + 4) and 2#0010#) = 0 then
            Append (Code, "END", Position, 6, Text);
         else
            Append (Code, ".END.", Position, 6, Text);
         end if;

         pragma Debug (AdaCL.Trace.Exiting (AdaCL.Trace.Parameter & Position'Image & Text'Image));
         return;
      end Decode_End;

      procedure Decode_LBL
         (Code     : in     Registers.Digit_Array;
          Position : in out Positive;
          Text     : in out Wide_String_Vectors.Vector)
      is
         pragma Debug (AdaCL.Trace.Entering (Trace_Code (Code, Position)));

         Instruction : Unbounded.Unbounded_Wide_String;
         Code_2      : constant HP41_Byte_Code := Registers.Get_Byte (Code (Position + 2 .. Position + 3));
      begin
         Instruction := @ & Decode_HP41 (Code (Position .. Position + 1));

         if Code_2 in 10#100# .. 16#7F# then
            Instruction := @ & " " & Decode_Synt (Code_2, For_Label => True);
         else
            Instruction := @ & " " & Registers.Address_Display_Text (Code_2);
         end if;

         Append (Code, Instruction, Position, 4, Text);

         pragma Debug (AdaCL.Trace.Exiting);
         return;
      end Decode_LBL;

      ---
      --: XEQ & GTO IND: AE xx
      --: 1010 1110 trrr rrrr
      --: 1010 1110 is AE
      --:           t is 0=GTO IND or 1=XEQ IND
      --:            rrr rrrr is the ”indirect” registe
      procedure Decode_GTO_IND
         (Code     : in     Registers.Digit_Array;
          Position : in out Positive;
          Text     : in out Wide_String_Vectors.Vector)
      is
         pragma Debug (AdaCL.Trace.Entering (Trace_Code (Code, Position)));

         Instruction : Unbounded.Unbounded_Wide_String;
         Code_1      : constant Wide_String := Decode_HP41 (Code (Position .. Position + 1));
         Code_2      : HP41_Byte_Code       := Registers.Get_Byte (Code (Position + 2 .. Position + 3));
      begin
         if (Code_2 and 2#1000_0000#) = 0 then
            Instruction := @ & AdaCL.Wide_Strings.First_Word (Code_1);
         else
            Instruction := @ & AdaCL.Wide_Strings.Last_Word (Code_1);
         end if;

         Code_2 := @ and 2#0111_1111#;

         Instruction := @ & " IND";

         if Code_2 in 10#100# .. 16#7F# then
            Instruction := @ & " " & Decode_Synt (Code_2, For_Label => True);
         else
            AdaCL.Trace.Write ("Instruction num");

            Instruction := @ & " " & Registers.Address_Display_Text (Code_2);
         end if;

         Append (Code, Instruction, Position, 4, Text);

         pragma Debug (AdaCL.Trace.Exiting);
         return;
      end Decode_GTO_IND;

      ---
      --  GTO 00 - 14: forward
      --  Bx xx
      --  1011 llll 0bbb rrrr
      --  1011 is B
      --       llll is label# + 1
      --            0 is forward
      --             bbb is number of bytes
      --                 rrrr is number of registers
      --
      --  GTO 00 - 14 backwards
      --  Bx xx
      --  1011 llll 1bbb rrrr
      --  1011 is B
      --       llll is label# + 1
      --            1 is backwards
      --             bbb is number of bytes
      --                 rrrr is number of registers
      procedure Decode_GTO_00
         (Code     : in     Registers.Digit_Array;
          Position : in out Positive;
          Text     : in out Wide_String_Vectors.Vector)
      is
         pragma Debug (AdaCL.Trace.Entering (Trace_Code (Code, Position)));

      begin
         Append (Code, Decode_HP41 (Code (Position .. Position + 1)), Position, 4, Text);

         pragma Debug (AdaCL.Trace.Exiting);
         return;
      end Decode_GTO_00;

      ---
      --: GTO 15 - 99 forward:  Dx xx xx
      --: 1101 bbbr rrrr rrrr 0lll llll
      --: 1101 is D
      --:      bbb is number of bytes
      --:           r rrrr rrrr is number of registers
      --:                     0 is forward
      --:
      --: GTO 15 - 99 backwards: Dx xx xx
      --: 1101 bbbr rrrr rrrr 1lll llll
      --: 1101 is D
      --:      bbb is number of bytes
      --:           r rrrr rrrr is number of registers
      --:                     1 is backwards
      --:                     lll llll is label#
      --:
      procedure Decode_GTO_15
         (Code     : in     Registers.Digit_Array;
          Position : in out Positive;
          Text     : in out Wide_String_Vectors.Vector)
      is
         pragma Debug (AdaCL.Trace.Entering (Trace_Code (Code, Position)));

         Instruction : Unbounded.Unbounded_Wide_String;
         Code_2      : constant HP41_Byte_Code := Registers.Get_Byte (Code (Position + 4 .. Position + 5));
      begin
         Instruction := @ & Decode_HP41 (Code (Position .. Position + 1));

         if Code_2 in 10#100# .. 16#7F# then
            Instruction := @ & " " & Decode_Synt (Code_2, For_Label => True);
         else
            AdaCL.Trace.Write ("Instruction num");

            Instruction := @ & " " & Registers.Address_Display_Text (Code_2 and 2#0111_1111#);
         end if;

         Append (Code, Instruction, Position, 6, Text);

         pragma Debug (AdaCL.Trace.Exiting);
         return;
      end Decode_GTO_15;

      procedure Decode_FIX
         (Code     : in     Registers.Digit_Array;
          Position : in out Positive;
          Text     : in out Wide_String_Vectors.Vector)
      is
         pragma Debug (AdaCL.Trace.Entering (Trace_Code (Code, Position)));

         Instruction : Unbounded.Unbounded_Wide_String;
         Code_2      : constant HP41_Byte_Code := Registers.Get_Byte (Code (Position + 2 .. Position + 3));
      begin
         Instruction := @ & Decode_HP41 (Code (Position .. Position + 1));
         Instruction := @ & " " & Registers.Fix_Display_Text (Code_2);

         Append (Code, Instruction, Position, 4, Text);

         pragma Debug (AdaCL.Trace.Exiting);
         return;
      end Decode_FIX;

      procedure Decode_Register
         (Code     : in     Registers.Digit_Array;
          Position : in out Positive;
          Text     : in out Wide_String_Vectors.Vector)
      is
         pragma Debug (AdaCL.Trace.Entering (Trace_Code (Code, Position)));

         Instruction : Unbounded.Unbounded_Wide_String;
         Code_2      : HP41_Byte_Code := Registers.Get_Byte (Code (Position + 2 .. Position + 3));
      begin
         Instruction := @ & Decode_HP41 (Code (Position .. Position + 1));

         --  codecomp = Left(CodeString, 2)
         if Code_2 > 16#7F# then
            AdaCL.Trace.Write ("Instruction IND");

            if Code_2 >= 16#F0# then
               --  Instruction IND alpha
               Code_2      := @ - 16#80#;
               Instruction := @ & " IND " & Decode_Synt (Code_2, For_Label => False);
            else
               --  Instruction IND num
               Code_2      := @ - 16#80#;
               Instruction := @ & " IND " & Registers.Address_Display_Text (Code_2);
            end if;
         else
            AdaCL.Trace.Write ("Instruction num");

            Instruction := @ & " " & Registers.Address_Display_Text (Code_2);
         end if;

         Append (Code, Instruction, Position, 4, Text);

         pragma Debug (AdaCL.Trace.Exiting);
         return;
      end Decode_Register;
   begin
      --!pp off
      if Equal ([0, 0, 0, 0]) then
         --  Text.Append ("; 2NULL");
         Position := @ + 4;
      elsif Equal ([0, 0]) then
         --  Text.Append ("; NULL");
         Position := @ + 2;
      elsif  Position + 5 <= Code'Last and then
         Code (Position + 0) =  C      and then
         Code (Position + 4) in 0 .. 6 and then
         Code (Position + 5) in 9 .. F
      then
         AdaCL.Trace.Write ("Check for END");
         Decode_End (Code, Position, Text);
      elsif Position + 6 < Code'Last   and then
         Code (Position + 0) =  C      and then
         Code (Position + 4) =  F      and then
         Code (Position + 5) in 2 .. 8
      then
         AdaCL.Trace.Write ("Check for LBL`");
         Decode_LBL_Alpha (Code, Position, Text);
      elsif Equal ([C, F]) then
         AdaCL.Trace.Write ("Check for LBL letter or num");
         Decode_LBL (Code, Position, Text);
      elsif Equal ([D]) or else Equal ([E]) then
         AdaCL.Trace.Write ("Check for GTO / XEQ");
         Decode_GTO_15 (Code, Position, Text);
      elsif Equal ([B]) then
         AdaCL.Trace.Write ("Check for GTO 00 .. 14");
         Decode_GTO_00 (Code, Position, Text);
      elsif Equal ([1, D, F]) or else Equal ([1, E, F]) then
         AdaCL.Trace.Write ("Check for GTO / XEQ Alpha");
         Decode_GTO_Alpha (Code, Position, Text);
      elsif Equal ([A, E]) then
         AdaCL.Trace.Write ("Check for GTO / XEQ IND");
         Decode_GTO_IND (Code, Position, Text);
      elsif Equal ([F]) and then not Equal ([0], 1) then
         AdaCL.Trace.Write ("Check for text string");
         Decode_Alpha (Code, Position, Text);
      elsif Registers.Get_Byte (Code (Position .. Position + 1)) in 16#9C# .. 16#9F# then
         AdaCL.Trace.Write ("Check for FIX, SCI, ENG, TONE");
         Decode_FIX (Code, Position, Text);
      elsif Registers.Get_Byte (Code (Position .. Position + 1))
         in 16#A8# .. 16#AD# | 16#90# .. 16#9B# | 16#CE#
      then
         AdaCL.Trace.Write ("Check for STO, RCL, ST+, ST-, ST*, ST/ ...");
         Decode_Register (Code, Position, Text);
      elsif  Equal ([1]) then
         AdaCL.Trace.Write ("Check for any number input");
         Decode_Number (Code, Position, Text);
      elsif Registers.Get_Byte (Code (Position .. Position + 1)) in XROM_Code then
         AdaCL.Trace.Write ("Check for ROM Code");
         Append (Code, Decode_XROM (Code (Position .. Position + 3)), Position, 4, Text);
      else
         AdaCL.Trace.Write ("Check for HP41 Code");
         Append (Code, Decode_HP41 (Code (Position .. Position + 1)), Position, 2, Text);
      end if;
      --!pp on

      pragma Debug (AdaCL.Trace.Exiting);
      return;
   end Decode_Step;

   procedure Decode_Program (Code : in Registers.Digit_Array; Text : in out Wide_String_Vectors.Vector) is
      pragma Debug (AdaCL.Trace.Entering (AdaCL.Trace.Parameter & Code'Image & Text'Image));

      Position : Positive := Code'First;
   begin
      while Position < Code'Last loop
         if Position < Code'Last - Registers.Digits_Per_Register then
            AdaCL.Trace.Write_Wide
               ("Current Register = " &
                Registers.Image (Code (Position .. Position + Registers.Digits_Per_Register - 1)) & " / " &
                Position'Wide_Image & " .. " & Code'Last'Wide_Image);
         else
            AdaCL.Trace.Write_Wide
               ("Current Register = " & Registers.Image (Code (Position .. Code'Last)) & " / " & Position'Wide_Image &
                " .. " & Code'Last'Wide_Image);
         end if;

         Decode_Step (Code, Position, Text);
      end loop;

      pragma Debug (AdaCL.Trace.Exiting (Out_Parameter => Text'Image));
      return;
   end Decode_Program;

   procedure Decode_Alarm (Code : in Registers.Digit_Array; Text : in out Wide_String_Vectors.Vector) is
      pragma Debug (AdaCL.Trace.Entering (AdaCL.Trace.Parameter & Code'Image & Text'Image));

      use type Registers.Digit_Type;
      use type Registers.Digit_Array;

      Position : Positive := Code'First;
   begin
      while Position < Code'Last and then Code (Position .. Position + 13) /= Alarm.EOF loop
         AdaCL.Trace.Write_Wide ("Current Register => " & Registers.Image (Code (Position .. Position + 13)));

         declare
            Line           : Unbounded.Unbounded_Wide_String;
            Start_Time     : constant Ada.Calendar.Time    :=
               Alarm.To_Start_Time (Code (Position .. Position + Alarm.Alarm_Digit_Array'Last - 1));
            Repeat_Flag    : constant Registers.Digit_Type := Code (Position + 11);
            Alpha_Register : constant Registers.Digit_Type := Code (Position + 13);  --  Length in Registers
         begin
            Position := @ + Registers.Digits_Per_Register;
            Line     := @ & "; ALARM = " & Alarm.Start_Image (Start_Time);

            AdaCL.Trace.Write_Wide ("Line => " & Unbounded.To_Wide_String (Line));

            if Repeat_Flag /= 16#0# then
               declare
                  Repeat_Time : constant Alarm.Repeat_Time :=
                     Alarm.To_Repeat_Time (Code (Position .. Position + Alarm.Alarm_Digit_Array'Last - 1));
               begin
                  Position := @ + Registers.Digits_Per_Register;
                  Line     := @ & ' ' & Alarm.Repeat_Image (Repeat_Time);
               end;
            end if;

            if Alpha_Register > 16#0# then
               declare
                  Alpha_Length : constant Positive    := Registers.Digits_Per_Register * Integer (Alpha_Register);
                  Text         : constant Wide_String := Registers.Format_Alpha
                        (Code (Position .. Position + Alpha_Length - 1),
                         Add_Quotes  => True,
                         Trim_Spaces => False,
                         Trim_Null   => True);
               begin
                  Line := @ & ' ' & Text;

                  Position := @ + Alpha_Length;
               end;
            end if;

            Text.Append (Line.To_Wide_String);
            AdaCL.Trace.Write ("Position     => " & Position'Image & Code'Last'Image);
         end;
      end loop;

      pragma Debug (AdaCL.Trace.Exiting (Out_Parameter => Text'Image));
      return;
   end Decode_Alarm;

end HP41CX_Tools.Decoder;