Preliminary work to interface with rust

Author: tgingold

src/errorout-console.adb

@@ -130,6 +130,12 @@ package body Errorout.Console is
       Program_Name := new String'(Name);
    end Set_Program_Name;
 
+   procedure Set_Program_Name_With_Len
+     (Str : Thin_String_Ptr; Len : Natural) is
+   begin
+      Program_Name := new String'(Str (1 .. Len));
+   end Set_Program_Name_With_Len;
+
    procedure Disp_Program_Name is
    begin
       if Program_Name /= null then

src/errorout-console.ads

@@ -19,6 +19,9 @@ package Errorout.Console is
    --  if not initialized.
    procedure Set_Program_Name (Name : String);
 
+   --  Likewise, but for non-Ada.
+   procedure Set_Program_Name_With_Len (Str : Thin_String_Ptr; Len : Natural);
+
    --  Report handle for the console.
    procedure Console_Error_Start (E : Error_Record);
    procedure Console_Message (Str : String);

src/ghdldrv/ghdlcomp.adb

@@ -329,10 +329,12 @@ package body Ghdlcomp is
    procedure Common_Compile_Init (Analyze_Only : Boolean) is
    begin
       if Analyze_Only then
+         --  Initialize library path and load std+work libraries.
          if not Setup_Libraries (True) then
             raise Option_Error;
          end if;
       else
+         --  Initialize library path and load std library.
          if not Setup_Libraries (False)
            or else not Libraries.Load_Std_Library
          then
@@ -487,99 +489,107 @@ package body Ghdlcomp is
         & ASCII.LF & "  aliases: -a, analyse";
    end Get_Short_Help;
 
-   procedure Perform_Action (Cmd : in out Command_Analyze;
-                             Args : String_Acc_Array;
-                             Success : out Boolean)
+   function Analyze_File (Id : Name_Id) return Boolean
    is
-      pragma Unreferenced (Cmd);
-      Id : Name_Id;
       Design_File : Iir_Design_File;
       New_Design_File : Iir_Design_File;
       Unit : Iir;
       Next_Unit : Iir;
    begin
-      Success := False;
+      --  Parse file.
+      Design_File := Load_File_Name (Id);
+      if Errorout.Nbr_Errors > 0
+        and then not Flags.Flag_Force_Analysis
+      then
+         return False;
+      end if;
 
-      if Args'Length = 0 then
-         Error ("no file to analyze");
-         return;
+      New_Design_File := Null_Iir;
+
+      if False then
+         --  Speed up analysis: remove all previous designs.
+         --  However, this is not in the LRM...
+         Libraries.Purge_Design_File (Design_File);
       end if;
 
-      Expect_Filenames (Args);
+      if Design_File /= Null_Iir then
+         Unit := Get_First_Design_Unit (Design_File);
+         while Unit /= Null_Iir loop
+            --  Analyze unit.
+            Finish_Compilation (Unit, True);
 
-      Hooks.Compile_Init.all (True);
+            Next_Unit := Get_Chain (Unit);
 
-      --  Parse all files.
-      for I in Args'Range loop
-         Id := Name_Table.Get_Identifier (Args (I).all);
+            if Errorout.Nbr_Errors = 0
+              or else (Flags.Flag_Force_Analysis
+                         and then Get_Library_Unit (Unit) /= Null_Iir)
+            then
+               Set_Chain (Unit, Null_Iir);
+               Libraries.Add_Design_Unit_Into_Library (Unit);
+               New_Design_File := Get_Design_File (Unit);
+            end if;
+
+            Unit := Next_Unit;
+         end loop;
 
-         --  Parse file.
-         Design_File := Load_File_Name (Id);
          if Errorout.Nbr_Errors > 0
            and then not Flags.Flag_Force_Analysis
          then
-            Success := Flag_Expect_Failure;
-            return;
+            return False;
          end if;
 
-         New_Design_File := Null_Iir;
-
-         if False then
-            --  Speed up analysis: remove all previous designs.
-            --  However, this is not in the LRM...
-            Libraries.Purge_Design_File (Design_File);
+         if New_Design_File = Design_File then
+            pragma Assert (Flags.Flag_Force_Analysis);
+            null;
+         else
+            Free_Iir (Design_File);
          end if;
 
-         if Design_File /= Null_Iir then
-            Unit := Get_First_Design_Unit (Design_File);
+         --  Do late analysis checks.
+         if New_Design_File /= Null_Iir then
+            Unit := Get_First_Design_Unit (New_Design_File);
             while Unit /= Null_Iir loop
-               --  Analyze unit.
-               Finish_Compilation (Unit, True);
-
-               Next_Unit := Get_Chain (Unit);
-
-               if Errorout.Nbr_Errors = 0
-                 or else (Flags.Flag_Force_Analysis
-                            and then Get_Library_Unit (Unit) /= Null_Iir)
-               then
-                  Set_Chain (Unit, Null_Iir);
-                  Libraries.Add_Design_Unit_Into_Library (Unit);
-                  New_Design_File := Get_Design_File (Unit);
-               end if;
-
-               Unit := Next_Unit;
+               Vhdl.Sem.Sem_Analysis_Checks_List
+                 (Unit, Is_Warning_Enabled (Warnid_Delayed_Checks));
+               Unit := Get_Chain (Unit);
             end loop;
 
             if Errorout.Nbr_Errors > 0
               and then not Flags.Flag_Force_Analysis
             then
-               Success := Flag_Expect_Failure;
-               return;
+               return False;
             end if;
+         end if;
+      end if;
 
-            if New_Design_File = Design_File then
-               pragma Assert (Flags.Flag_Force_Analysis);
-               null;
-            else
-               Free_Iir (Design_File);
-            end if;
+      return True;
+   end Analyze_File;
 
-            --  Do late analysis checks.
-            if New_Design_File /= Null_Iir then
-               Unit := Get_First_Design_Unit (New_Design_File);
-               while Unit /= Null_Iir loop
-                  Vhdl.Sem.Sem_Analysis_Checks_List
-                    (Unit, Is_Warning_Enabled (Warnid_Delayed_Checks));
-                  Unit := Get_Chain (Unit);
-               end loop;
-
-               if Errorout.Nbr_Errors > 0
-                 and then not Flags.Flag_Force_Analysis
-               then
-                  Success := Flag_Expect_Failure;
-                  return;
-               end if;
-            end if;
+   procedure Perform_Action (Cmd : in out Command_Analyze;
+                             Args : String_Acc_Array;
+                             Success : out Boolean)
+   is
+      pragma Unreferenced (Cmd);
+      Id : Name_Id;
+   begin
+      Success := False;
+
+      if Args'Length = 0 then
+         Error ("no file to analyze");
+         return;
+      end if;
+
+      Expect_Filenames (Args);
+
+      Hooks.Compile_Init.all (True);
+
+      --  Parse all files.
+      for I in Args'Range loop
+         Id := Name_Table.Get_Identifier (Args (I).all);
+
+         if not Analyze_File (Id) then
+            Success := Flag_Expect_Failure;
+            return;
          end if;
       end loop;
 
@@ -588,7 +598,6 @@ package body Ghdlcomp is
          return;
       end if;
 
-
       if Flag_Expect_Failure then
          Success := False;
          return;

src/ghdldrv/ghdlcomp.ads

@@ -112,4 +112,9 @@ package Ghdlcomp is
 
    --  Hook for verilog.
    Init_Verilog_Options : Compile_Init_Acc;
+
+private
+   --  For Rust:
+   --  Analyze one file, return False on error.
+   function Analyze_File (Id : Name_Id) return Boolean;
 end Ghdlcomp;

src/ghdldrv/ghdlrun.ads

@@ -15,4 +15,9 @@
 --  along with this program.  If not, see <gnu.org/licenses>.
 package Ghdlrun is
    procedure Register_Commands;
+
+private
+   --  For Rust:
+   --  To be called before any compilation.
+   procedure Compile_Init (Analyze_Only : Boolean);
 end Ghdlrun;