------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- V X L I N K . B I N D -- -- -- -- B o d y -- -- -- -- Copyright (C) 2018, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT 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 distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ pragma Ada_2012; with Ada.Text_IO; use Ada.Text_IO; with Ada.IO_Exceptions; with Ada.Strings.Fixed; with GNAT.Regpat; use GNAT.Regpat; package body VxLink.Bind is function Split_Lines (S : String) return Strings_List.Vector; function Split (S : String; C : Character) return Strings_List.Vector; function Parse_Nm_Output (S : String) return Symbol_Sets.Set; procedure Emit_Module_Dtor (FP : File_Type); procedure Emit_CDtor (FP : File_Type; Var : String; Set : Symbol_Sets.Set); ----------------- -- Split_Lines -- ----------------- function Split_Lines (S : String) return Strings_List.Vector is Last : Natural := S'First; Ret : Strings_List.Vector; begin for J in S'Range loop if S (J) = ASCII.CR and then J < S'Last and then S (J + 1) = ASCII.LF then Ret.Append (S (Last .. J - 1)); Last := J + 2; elsif S (J) = ASCII.LF then Ret.Append (S (Last .. J - 1)); Last := J + 1; end if; end loop; if Last <= S'Last then Ret.Append (S (Last .. S'Last)); end if; return Ret; end Split_Lines; ----------- -- Split -- ----------- function Split (S : String; C : Character) return Strings_List.Vector is Last : Natural := S'First; Ret : Strings_List.Vector; begin for J in S'Range loop if S (J) = C then if J > Last then Ret.Append (S (Last .. J - 1)); end if; Last := J + 1; end if; end loop; if Last <= S'Last then Ret.Append (S (Last .. S'Last)); end if; return Ret; end Split; --------------------- -- Parse_Nm_Output -- --------------------- function Parse_Nm_Output (S : String) return Symbol_Sets.Set is Nm_Regexp : constant Pattern_Matcher := Compile ("^[0-9A-Za-z]* ([a-zA-Z]) (.*)$"); type CDTor_Type is (CTOR_Diab, CTOR_Gcc, DTOR_Diab, DTOR_Gcc); subtype CTOR_Type is CDTor_Type range CTOR_Diab .. CTOR_Gcc; CTOR_DIAB_Regexp : aliased constant Pattern_Matcher := Compile ("^__?STI__*([0-9]+)_"); CTOR_GCC_Regexp : aliased constant Pattern_Matcher := Compile ("^__?GLOBAL_.I._*([0-9]+)_"); DTOR_DIAB_Regexp : aliased constant Pattern_Matcher := Compile ("^__?STD__*([0-9]+)_"); DTOR_GCC_Regexp : aliased constant Pattern_Matcher := Compile ("^__?GLOBAL_.D._*([0-9]+)_"); type Regexp_Access is access constant Pattern_Matcher; CDTor_Regexps : constant array (CDTor_Type) of Regexp_Access := (CTOR_Diab => CTOR_DIAB_Regexp'Access, CTOR_Gcc => CTOR_GCC_Regexp'Access, DTOR_Diab => DTOR_DIAB_Regexp'Access, DTOR_Gcc => DTOR_GCC_Regexp'Access); Result : Symbol_Sets.Set; begin for Line of Split_Lines (S) loop declare Sym : Symbol; Nm_Grps : Match_Array (0 .. 2); Ctor_Grps : Match_Array (0 .. 1); begin Match (Nm_Regexp, Line, Nm_Grps); if Nm_Grps (0) /= No_Match then declare Sym_Type : constant Character := Line (Nm_Grps (1).First); Sym_Name : constant String := Line (Nm_Grps (2).First .. Nm_Grps (2).Last); begin Sym := (Name => To_Unbounded_String (Sym_Name), Cat => Sym_Type, Internal => False, Kind => Sym_Other, Priority => -1); for J in CDTor_Regexps'Range loop Match (CDTor_Regexps (J).all, Sym_Name, Ctor_Grps); if Ctor_Grps (0) /= No_Match then if J in CTOR_Type then Sym.Kind := Sym_Ctor; else Sym.Kind := Sym_Dtor; end if; Sym.Priority := Integer'Value (Line (Ctor_Grps (1).First .. Ctor_Grps (1).Last)); exit; end if; end loop; Result.Include (Sym); end; end if; end; end loop; return Result; end Parse_Nm_Output; ---------------- -- Initialize -- ---------------- procedure Initialize (Binder : out VxLink_Binder; Object_File : String) is Args : Arguments_List; Module_Dtor_Not_Needed : Boolean := False; Module_Dtor_Needed : Boolean := False; begin Args.Append (Nm); Args.Append (Object_File); declare Output : constant String := Run (Args); Symbols : Symbol_Sets.Set; begin if Is_Error_State then return; end if; Symbols := Parse_Nm_Output (Output); for Sym of Symbols loop if Sym.Kind = Sym_Ctor then Binder.Constructors.Insert (Sym); elsif Sym.Kind = Sym_Dtor then Binder.Destructors.Insert (Sym); elsif Match ("_?__.*_atexit$", To_String (Sym.Name)) then if Sym.Cat = 'T' then Module_Dtor_Not_Needed := True; elsif Sym.Cat = 'U' then Module_Dtor_Needed := True; end if; end if; end loop; Binder.Module_Dtor_Needed := not Module_Dtor_Not_Needed and then Module_Dtor_Needed; end; end Initialize; -------------------- -- Parse_Tag_File -- -------------------- procedure Parse_Tag_File (Binder : in out VxLink_Binder; File : String) is FP : Ada.Text_IO.File_Type; begin Open (FP, Mode => In_File, Name => File); loop declare Line : constant String := Ada.Strings.Fixed.Trim (Get_Line (FP), Ada.Strings.Both); Tokens : Strings_List.Vector; begin if Line'Length = 0 then -- Skip empty lines null; elsif Line (Line'First) = '#' then -- Skip comment null; else Tokens := Split (Line, ' '); if Tokens.First_Element = "section" then -- Sections are not used for tags, only when building -- kernels. So skip for now null; else Binder.Tags_List.Append (Line); end if; end if; end; end loop; exception when Ada.IO_Exceptions.End_Error => Close (FP); when others => Log_Error ("Cannot open file " & File & ". DKM tags won't be generated"); end Parse_Tag_File; ---------------------- -- Emit_Module_Dtor -- ---------------------- procedure Emit_Module_Dtor (FP : File_Type) is Dtor_Name : constant String := "_GLOBAL__D_65536_0_cxa_finalize"; begin Put_Line (FP, "extern void __cxa_finalize(void *);"); Put_Line (FP, "static void " & Dtor_Name & "()"); Put_Line (FP, "{"); Put_Line (FP, " __cxa_finalize(&__dso_handle);"); Put_Line (FP, "}"); Put_Line (FP, ""); end Emit_Module_Dtor; ---------------- -- Emit_CDtor -- ---------------- procedure Emit_CDtor (FP : File_Type; Var : String; Set : Symbol_Sets.Set) is begin for Sym of Set loop if not Sym.Internal then Put_Line (FP, "extern void " & To_String (Sym.Name) & "();"); end if; end loop; New_Line (FP); Put_Line (FP, "extern void (*" & Var & "[])();"); Put_Line (FP, "void (*" & Var & "[])() ="); Put_Line (FP, " {"); for Sym of Set loop Put_Line (FP, " " & To_String (Sym.Name) & ","); end loop; Put_Line (FP, " 0};"); New_Line (FP); end Emit_CDtor; --------------- -- Emit_CTDT -- --------------- procedure Emit_CTDT (Binder : in out VxLink_Binder; Namespace : String) is FP : Ada.Text_IO.File_Type; CDtor_File : constant String := Namespace & "-cdtor.c"; begin Binder.CTDT_File := To_Unbounded_String (CDtor_File); Create (File => FP, Name => CDtor_File); Put_Line (FP, "#if defined(_HAVE_TOOL_XTORS)"); Put_Line (FP, "#include "); if Binder.Module_Dtor_Needed then Put_Line (FP, "#define _WRS_NEED_CALL_CXA_FINALIZE"); end if; Put_Line (FP, "#include TOOL_HEADER (toolXtors.h)"); Put_Line (FP, "#else"); Put_Line (FP, ""); if Binder.Module_Dtor_Needed then Emit_Module_Dtor (FP); end if; Emit_CDtor (FP, "_ctors", Binder.Constructors); Emit_CDtor (FP, "_dtors", Binder.Destructors); Put_Line (FP, "#endif"); if not Binder.Tags_List.Is_Empty then New_Line (FP); Put_Line (FP, "/* build variables */"); Put_Line (FP, "__asm("" .section \"".wrs_build_vars\"",\""a\"""");"); for Tag of Binder.Tags_List loop Put_Line (FP, "__asm("" .ascii \""" & Tag & "\"""");"); Put_Line (FP, "__asm("" .byte 0"");"); end loop; Put_Line (FP, "__asm("" .ascii \""end\"""");"); Put_Line (FP, "__asm("" .byte 0"");"); end if; Close (FP); exception when others => Close (FP); Set_Error_State ("Internal error"); raise; end Emit_CTDT; --------------- -- CTDT_File -- --------------- function CTDT_File (Binder : VxLink_Binder) return String is begin return To_String (Binder.CTDT_File); end CTDT_File; end VxLink.Bind;