------------------------------------------------------------------------------ --: 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;