Add gnat.adc, tidy code, fix handling of cmd options.

aosvs_dump.adb

@@ -1,4 +1,4 @@
--- Copyright 2021 S.Merrony
+-- Copyright 2021.2022 S.Merrony
 
 -- Permission is hereby granted, free of charge, to any person obtaining a copy of this software
 -- and associated documentation files (the "Software"), to deal in the Software without restriction,
@@ -33,9 +33,11 @@ package body Aosvs_Dump is
     end Read_Word;
 
     function Read_Blob
-       (Num_Bytes : in Positive; Dump_Stream : Stream_Access;
-        Reason    : in Unbounded_String) return Blob_Type
+       (Num_Bytes   : Positive; 
+        Dump_Stream : Stream_Access;
+        Reason      : String) return Blob_Type
     is
+        pragma Unreferenced(Reason);
         Blob : Blob_Type (1 .. Num_Bytes);
     begin
         -- Ada.Text_IO.Put_Line ("DEBUG: Read_Blob called for bytes: " & Integer'Image(Num_Bytes));

aosvs_dump.ads

@@ -1,4 +1,4 @@
--- Copyright 2021 S.Merrony
+-- Copyright 2021,2022 S.Merrony
 
 -- Permission is hereby granted, free of charge, to any person obtaining a copy of this software
 -- and associated documentation files (the "Software"), to deal in the Software without restriction,
@@ -86,12 +86,9 @@ package Aosvs_Dump is
    type Blob_Type is array (Positive range <>) of Unsigned_8;
 
    function Read_Word (Dump_Stream : Stream_Access) return Unsigned_16;
-   function Read_Blob
-     (Num_Bytes : in Positive; Dump_Stream : Stream_Access;
-      Reason    : in Unbounded_String) return Blob_Type;
-   function Extract_First_String(Blob : Blob_Type) return Unbounded_String;
-   function Read_Header
-     (Dump_Stream : Stream_Access) return Record_Header_Type;
+   function Read_Blob (Num_Bytes : Positive; Dump_Stream : Stream_Access; Reason : String) return Blob_Type;
+   function Extract_First_String (Blob : Blob_Type) return Unbounded_String;
+   function Read_Header (Dump_Stream : Stream_Access) return Record_Header_Type;
    function Read_SOD (Dump_Stream : Stream_Access) return SOD_Type;
    function To_Linux_Filename (Aosvs_Filename : Unbounded_String) return Unbounded_String;
 

gnat.adc

@@ -0,0 +1,11 @@
+pragma Detect_Blocking;
+pragma License (GPL);
+-- pragma Restrictions (No_Direct_Boolean_Operators);
+pragma Restrictions (No_Implicit_Dynamic_Code);
+pragma Style_Checks ("r"); -- require consistency of identifier casing
+pragma Style_Checks ("B"); -- Check Boolean operators
+pragma Style_Checks ("e"); -- Check end/exit labels.
+pragma Style_Checks ("I"); -- check mode IN keywords.
+pragma Style_Checks ("k"); -- All keywords must be in lower case
+pragma Style_Checks ("n"); -- Check casing of entities in Standard.
+pragma Style_Checks ("x"); -- Check extra parentheses.

loada.adb

@@ -1,4 +1,4 @@
--- Copyright 2021 S.Merrony
+-- Copyright 2021,2022 S.Merrony
 
 -- Permission is hereby granted, free of charge, to any person obtaining a copy of this software
 -- and associated documentation files (the "Software"), to deal in the Software without restriction,
@@ -23,19 +23,21 @@ with Ada.Strings.Unbounded;   use Ada.Strings.Unbounded;
 with Ada.Task_Identification; use Ada.Task_Identification;
 with Ada.Text_IO;
 
+with GNAT.Traceback.Symbolic;
+
 with Interfaces; use Interfaces;
 
 with Aosvs_Dump; use Aosvs_Dump;
 
 procedure Loada is
 
-   SemVer : constant String := "v1.4.1";
+   SemVer : constant String := "v1.4.2";
 
    Dump_File_Name  : Unbounded_String;
    Extracting      : Boolean := False;
    Ignoring_Errors : Boolean := False;
    Listing         : Boolean := False;
-   Summary         : Boolean := False;
+   Summary         : Boolean := true;
    Verbose         : Boolean := False;
 
    ArgIx             : Integer := 1;
@@ -49,15 +51,16 @@ procedure Loada is
    Working_Dir : Unbounded_String := To_Unbounded_String (Base_Dir);
 
    Buffer              : array (1 .. MaxBlockSize) of Unsigned_8;
-   Current_Buff_Len    : Integer range 0 .. MaxBlockSize;
-   Current_Buff_In_Use : Unbounded_String;
    FSB_Type_Indicator  : Integer;
    Current_File_Name   : Unbounded_String;
 
    SOD                           : SOD_Type;
    Record_Header                 : Record_Header_Type;
    Total_File_Size, Padding_Size : Unsigned_32 := 0;
    Done, In_A_File, Load_It      : Boolean     := False;
+   File_Count                    : Natural     := 0;
+
+   Cannot_Create_Link : exception;
 
    function symlink (fname, linkname : String) return Integer;
    pragma Import (C, symlink);
@@ -76,30 +79,24 @@ procedure Loada is
       Set_Exit_Status (Failure);
    end Print_Help;
 
-   procedure Load_Buffer
-     (Num_Bytes : in Integer; Reason : in Unbounded_String)
+   procedure Load_Buffer (Num_Bytes : Integer; Reason : String)
    is
       Tmp_Blob : Blob_Type (1 .. Num_Bytes);
    begin
-      Current_Buff_In_Use := Reason;
       Tmp_Blob            := Read_Blob (Num_Bytes, Dump_File_Stream, Reason);
       for B in 1 .. Num_Bytes loop
          Buffer (B) := Tmp_Blob (B);
       end loop;
-      Current_Buff_Len := Num_Bytes;
    end Load_Buffer;
 
-   function Process_Name_Block
-     (Record_Header : in Record_Header_Type) return Unbounded_String
+   function Process_Name_Block (Record_Header : Record_Header_Type) return Unbounded_String
    is
       Name_Bytes : Blob_Type (1 .. Record_Header.Record_Length);
       File_Name, Write_Path, Display_Path : Unbounded_String;
       This_Entry_Type                     : Fstat_Entry_Rec;
    begin
       Name_Bytes :=
-        Read_Blob
-          (Record_Header.Record_Length, Dump_File_Stream,
-           To_Unbounded_String ("File Name"));
+        Read_Blob (Record_Header.Record_Length, Dump_File_Stream, "File Name");
       File_Name := Extract_First_String (Name_Bytes);
       File_Name := To_Linux_Filename (File_Name);
       if Summary and Verbose then
@@ -115,7 +112,7 @@ procedure Loada is
          end if;
       end if;
 
-      if Summary then
+      if Listing then
          if Working_Dir = "" then
             Display_Path := File_Name;
          else
@@ -131,14 +128,16 @@ procedure Loada is
          end if;
       end if;
 
+      File_Count := File_Count + 1;
+
       if Extracting and Load_It then
          if Working_Dir = "" then
             Write_Path := File_Name;
          else
             Write_Path := Working_Dir & "/" & File_Name;
          end if;
          if Verbose then
-            Ada.Text_IO.Put (" Creating file: " & To_String (Write_Path));
+            Ada.Text_IO.Put_Line (" Creating file: " & To_String (Write_Path));
          end if;
          Create (Write_File, Out_File, To_String (Write_Path));
          -- Ada.Text_IO.Put_Line ("DEBUG: Output file created" );
@@ -147,16 +146,13 @@ procedure Loada is
       return File_Name;
    end Process_Name_Block;
 
-   procedure Process_Data_Block (Record_Header : in Record_Header_Type) is
+   procedure Process_Data_Block is
       DHB       : Data_Header_Type;
       FourBytes : Blob_Type (1 .. 4);
       TwoBytes  : Blob_Type (1 .. 2);
    begin
       -- first get the address and length
-      FourBytes :=
-        Read_Blob
-          (Num_Bytes => 4, Dump_Stream => Dump_File_Stream,
-           Reason    => To_Unbounded_String ("Byte Addr"));
+      FourBytes := Read_Blob (4, Dump_File_Stream, "Byte Addr");
       DHB.Byte_Address := Unsigned_32 (FourBytes (1));
       DHB.Byte_Address :=
         Shift_Left (DHB.Byte_Address, 8) + Unsigned_32 (FourBytes (2));
@@ -165,10 +161,7 @@ procedure Loada is
       DHB.Byte_Address :=
         Shift_Left (DHB.Byte_Address, 8) + Unsigned_32 (FourBytes (4));
 
-      FourBytes :=
-        Read_Blob
-          (Num_Bytes => 4, Dump_Stream => Dump_File_Stream,
-           Reason    => To_Unbounded_String ("Byte Length"));
+      FourBytes := Read_Blob (4, Dump_File_Stream, "Byte Length");
       DHB.Byte_Length := Unsigned_32 (FourBytes (1));
       DHB.Byte_Length :=
         Shift_Left (DHB.Byte_Length, 8) + Unsigned_32 (FourBytes (2));
@@ -191,10 +184,7 @@ procedure Loada is
               " (bytes)");
       end if;
 
-      TwoBytes :=
-        Read_Blob
-          (Num_Bytes => 2, Dump_Stream => Dump_File_Stream,
-           Reason    => To_Unbounded_String ("Alignment Count"));
+      TwoBytes := Read_Blob (2, Dump_File_Stream, "Alignment Count");
       DHB.Alighnment_Count := Unsigned_16 (TwoBytes (1));
       DHB.Alighnment_Count :=
         Shift_Left (DHB.Alighnment_Count, 8) + Unsigned_16 (TwoBytes (2));
@@ -207,25 +197,16 @@ procedure Loada is
                  " alignment byte(s)");
          end if;
          declare
-            t : Blob_Type (1 .. Integer (DHB.Alighnment_Count));
+            Dummy_Blob : Blob_Type (1 .. Integer (DHB.Alighnment_Count));
          begin
-            --t := Read_Blob (Num_Bytes => , Dump_Stream => Dump_File_Stream, Reason => To_Unbounded_String("Alignment"));
-            t :=
-              Read_Blob
-                (Num_Bytes   => Integer (DHB.Alighnment_Count),
-                 Dump_Stream => Dump_File_Stream,
-                 Reason      => To_Unbounded_String ("Alignment"));
+            Dummy_Blob := Read_Blob (Integer (DHB.Alighnment_Count), Dump_File_Stream, "Alignment");
          end;
       end if;
 
       declare
          Data_Blob : Blob_Type (1 .. Integer (DHB.Byte_Length));
       begin
-         Data_Blob :=
-           Read_Blob
-             (Num_Bytes   => Integer (DHB.Byte_Length),
-              Dump_Stream => Dump_File_Stream,
-              Reason      => To_Unbounded_String ("Data Block"));
+         Data_Blob := Read_Blob (Integer (DHB.Byte_Length), Dump_File_Stream, "Data Block");
 
          -- large areas of NULLs may be skipped over by DUMP_II/III
          -- this is achieved by simply advancing the byte address so
@@ -262,22 +243,21 @@ procedure Loada is
 
    procedure Process_End_Block is
    begin
-      if In_A_File then
-         if Extracting and Load_It then
-            Close (Write_File);
-            -- Ada.Text_IO.Put_Line ("DEBUG: File Closed");
+      if Is_Open (Write_File) then
+         Close (Write_File);
+         if Verbose then
+            Ada.Text_IO.Put_Line (" File Closed");
          end if;
-         if Summary then
+      end if;
+      if In_A_File then
+         if Listing then
             Ada.Text_IO.Put_Line (" " & Unsigned_32'Image (Total_File_Size) & " bytes");
          end if;
          Total_File_Size := 0;
          In_A_File       := False;
       else
          if Working_Dir /= Base_Dir then -- Don't go up from start dir
-            declare
-               lastSlash : Natural :=
-                 Ada.Strings.Unbounded.Index
-                   (Working_Dir, "/", Ada.Strings.Backward);
+            declare lastSlash : constant Natural := Ada.Strings.Unbounded.Index (Working_Dir, "/", Ada.Strings.Backward);
             begin
                Working_Dir := Head (Working_Dir, lastSlash - 1);
             end;
@@ -292,31 +272,30 @@ procedure Loada is
       end if;
    end Process_End_Block;
 
-   procedure Process_Link
-     (Record_Header : in Record_Header_Type; Link_Name : in Unbounded_String)
+   procedure Process_Link (Record_Header : Record_Header_Type; Link_Name : Unbounded_String)
    is
       Link_Target_Blob : Blob_Type (1 .. Record_Header.Record_Length);
       Link_Target      : Unbounded_String;
    begin
-      Link_Target_Blob :=
-        Read_Blob
-          (Record_Header.Record_Length, Dump_File_Stream,
-           To_Unbounded_String ("Link Target"));
+      Link_Target_Blob := Read_Blob (Record_Header.Record_Length, Dump_File_Stream, "Link Target");
       Link_Target := Extract_First_String (Link_Target_Blob);
       Link_Target := To_Linux_Filename (Link_Target);
-      if Summary or Verbose then
+      if Listing or Verbose then
          Ada.Text_IO.Put_Line (" -> Link Target: " & To_String (Link_Target));
       end if;
       if Extracting then
          declare
             RC : Integer;
-            Target_Str : String := To_String (Link_Target) & ASCII.Nul;
-            Link_Str   : String := To_String( Working_Dir ) & "/" & 
+            Target_Str : constant String := To_String (Link_Target) & ASCII.Nul;
+            Link_Str   : constant String := To_String( Working_Dir ) & "/" & 
               To_String (Link_Name) & ASCII.Nul;
          begin
             RC := symlink (Target_Str, Link_Str);
             if RC /= 0 then
                Ada.Text_IO.Put_Line ("ERROR: Could not create symbolic link");
+               if not Ignoring_Errors then
+                  raise Cannot_Create_Link;
+               end if;
             end if;
          end;
       end if;
@@ -410,22 +389,17 @@ begin
             Set_Exit_Status (Failure);
             Abort_Task (Current_Task);
          when FSB_Byte =>
-            Load_Buffer
-              (Record_Header.Record_Length, To_Unbounded_String ("FSB"));
+            Load_Buffer (Record_Header.Record_Length, "FSB");
             FSB_Type_Indicator := Integer (Buffer (2));
             Load_It            := False;
          when Name_Block_Byte =>
             Current_File_Name := Process_Name_Block (Record_Header);
          when UDA_Byte =>
             -- throw away for now
-            Load_Buffer
-              (Record_Header.Record_Length,
-               To_Unbounded_String
-                 ("UDA")); -- TODO Check this is OK
+            Load_Buffer (Record_Header.Record_Length, "UDA"); -- TODO Check this is OK
          when ACL_Byte =>
             -- We don't do anything except report ACLs at the moment
-            Load_Buffer
-              (Record_Header.Record_Length, To_Unbounded_String ("ACL"));
+            Load_Buffer (Record_Header.Record_Length, "ACL");
             if Verbose then
                Ada.Text_IO.Put_Line
                  (" ACL: "); -- & Unsigned_8'Image(Buffer));
@@ -436,10 +410,13 @@ begin
             -- nothing to do - it's just a record header
             null;
          when Data_Block_Byte =>
-            Process_Data_Block (Record_Header);
+            Process_Data_Block;
          when Data_End_Byte =>
             Process_End_Block;
          when End_Dump_Byte =>
+            if Summary then
+               Ada.Text_IO.Put_Line (File_Count'Image & " objects in dump file");
+            end if;
             Ada.Text_IO.Put_Line ("=== End of Dump ===");
             Done := True;
          when others =>
@@ -454,9 +431,10 @@ begin
    end loop Process_Each_Block;
 
 exception
-   when Error : others =>
+   when E : others =>
       Ada.Text_IO.Put ("Unexpected Error: ");
-      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (Error));
+      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
+      Ada.Text_IO.Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
       raise;
 
 end Loada;