gcc/ada/vxlink-bind.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                          V X L I N K . B I N D                           --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2018, AdaCore                          --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 pragma Ada_2012;
  27
  28 with Ada.Text_IO;       use Ada.Text_IO;
  29 with Ada.IO_Exceptions;
  30 with Ada.Strings.Fixed;
  31
  32 with GNAT.Regpat;       use GNAT.Regpat;
  33
  34 package body VxLink.Bind is
  35
  36    function Split_Lines (S : String) return Strings_List.Vector;
  37
  38    function Split (S : String; C : Character) return Strings_List.Vector;
  39
  40    function Parse_Nm_Output (S : String) return Symbol_Sets.Set;
  41
  42    procedure Emit_Module_Dtor
  43      (FP : File_Type);
  44
  45    procedure Emit_CDtor
  46      (FP  : File_Type;
  47       Var : String;
  48       Set : Symbol_Sets.Set);
  49
  50    -----------------
  51    -- Split_Lines --
  52    -----------------
  53
  54    function Split_Lines (S : String) return Strings_List.Vector
  55    is
  56       Last : Natural := S'First;
  57       Ret  : Strings_List.Vector;
  58    begin
  59       for J in S'Range loop
  60          if S (J) = ASCII.CR
  61            and then J < S'Last
  62            and then S (J + 1) = ASCII.LF
  63          then
  64             Ret.Append (S (Last .. J - 1));
  65             Last := J + 2;
  66          elsif S (J) = ASCII.LF then
  67             Ret.Append (S (Last .. J - 1));
  68             Last := J + 1;
  69          end if;
  70       end loop;
  71
  72       if Last <= S'Last then
  73          Ret.Append (S (Last .. S'Last));
  74       end if;
  75
  76       return Ret;
  77    end Split_Lines;
  78
  79    -----------
  80    -- Split --
  81    -----------
  82
  83    function Split (S : String; C : Character) return Strings_List.Vector
  84    is
  85       Last : Natural := S'First;
  86       Ret  : Strings_List.Vector;
  87    begin
  88       for J in S'Range loop
  89          if S (J) = C then
  90             if J > Last then
  91                Ret.Append (S (Last .. J - 1));
  92             end if;
  93
  94             Last := J + 1;
  95          end if;
  96       end loop;
  97
  98       if Last <= S'Last then
  99          Ret.Append (S (Last .. S'Last));
 100       end if;
 101
 102       return Ret;
 103    end Split;
 104
 105    ---------------------
 106    -- Parse_Nm_Output --
 107    ---------------------
 108
 109    function Parse_Nm_Output (S : String) return Symbol_Sets.Set
 110    is
 111       Nm_Regexp        : constant Pattern_Matcher :=
 112                            Compile ("^[0-9A-Za-z]* ([a-zA-Z]) (.*)$");
 113       type CDTor_Type is
 114         (CTOR_Diab,
 115          CTOR_Gcc,
 116          DTOR_Diab,
 117          DTOR_Gcc);
 118       subtype CTOR_Type is CDTor_Type range CTOR_Diab .. CTOR_Gcc;
 119       CTOR_DIAB_Regexp : aliased constant Pattern_Matcher :=
 120                            Compile ("^__?STI__*([0-9]+)_");
 121       CTOR_GCC_Regexp  : aliased constant Pattern_Matcher :=
 122                            Compile ("^__?GLOBAL_.I._*([0-9]+)_");
 123       DTOR_DIAB_Regexp : aliased constant Pattern_Matcher :=
 124                            Compile ("^__?STD__*([0-9]+)_");
 125       DTOR_GCC_Regexp  : aliased constant Pattern_Matcher :=
 126                            Compile ("^__?GLOBAL_.D._*([0-9]+)_");
 127       type Regexp_Access is access constant Pattern_Matcher;
 128       CDTor_Regexps    : constant array (CDTor_Type) of Regexp_Access :=
 129                            (CTOR_Diab => CTOR_DIAB_Regexp'Access,
 130                             CTOR_Gcc  => CTOR_GCC_Regexp'Access,
 131                             DTOR_Diab => DTOR_DIAB_Regexp'Access,
 132                             DTOR_Gcc  => DTOR_GCC_Regexp'Access);
 133       Result           : Symbol_Sets.Set;
 134
 135    begin
 136       for Line of Split_Lines (S) loop
 137          declare
 138             Sym     : Symbol;
 139             Nm_Grps : Match_Array (0 .. 2);
 140             Ctor_Grps : Match_Array (0 .. 1);
 141          begin
 142             Match (Nm_Regexp, Line, Nm_Grps);
 143
 144             if Nm_Grps (0) /= No_Match then
 145                declare
 146                   Sym_Type : constant Character :=
 147                                Line (Nm_Grps (1).First);
 148                   Sym_Name : constant String :=
 149                                Line (Nm_Grps (2).First .. Nm_Grps (2).Last);
 150                begin
 151                   Sym :=
 152                     (Name     => To_Unbounded_String (Sym_Name),
 153                      Cat      => Sym_Type,
 154                      Internal => False,
 155                      Kind     => Sym_Other,
 156                      Priority => -1);
 157
 158                   for J in CDTor_Regexps'Range loop
 159                      Match (CDTor_Regexps (J).all, Sym_Name, Ctor_Grps);
 160
 161                      if Ctor_Grps (0) /= No_Match then
 162                         if J in CTOR_Type then
 163                            Sym.Kind := Sym_Ctor;
 164                         else
 165                            Sym.Kind := Sym_Dtor;
 166                         end if;
 167
 168                         Sym.Priority := Integer'Value
 169                           (Line (Ctor_Grps (1).First .. Ctor_Grps (1).Last));
 170
 171                         exit;
 172                      end if;
 173                   end loop;
 174
 175                   Result.Include (Sym);
 176                end;
 177             end if;
 178          end;
 179       end loop;
 180
 181       return Result;
 182    end Parse_Nm_Output;
 183
 184    ----------------
 185    -- Initialize --
 186    ----------------
 187
 188    procedure Initialize
 189      (Binder      : out VxLink_Binder;
 190       Object_File : String)
 191    is
 192       Args                   : Arguments_List;
 193       Module_Dtor_Not_Needed : Boolean := False;
 194       Module_Dtor_Needed     : Boolean := False;
 195
 196    begin
 197       Args.Append (Nm);
 198       Args.Append (Object_File);
 199
 200       declare
 201          Output  : constant String := Run (Args);
 202          Symbols : Symbol_Sets.Set;
 203       begin
 204          if Is_Error_State then
 205             return;
 206          end if;
 207
 208          Symbols := Parse_Nm_Output (Output);
 209
 210          for Sym of Symbols loop
 211             if Sym.Kind = Sym_Ctor then
 212                Binder.Constructors.Insert (Sym);
 213             elsif Sym.Kind = Sym_Dtor then
 214                Binder.Destructors.Insert (Sym);
 215             elsif Match ("_?__.*_atexit$", To_String (Sym.Name)) then
 216                if Sym.Cat = 'T' then
 217                   Module_Dtor_Not_Needed := True;
 218                elsif Sym.Cat = 'U' then
 219                   Module_Dtor_Needed := True;
 220                end if;
 221             end if;
 222          end loop;
 223
 224          Binder.Module_Dtor_Needed :=
 225            not Module_Dtor_Not_Needed and then Module_Dtor_Needed;
 226       end;
 227    end Initialize;
 228
 229    --------------------
 230    -- Parse_Tag_File --
 231    --------------------
 232
 233    procedure Parse_Tag_File
 234      (Binder : in out VxLink_Binder;
 235       File   : String)
 236    is
 237       FP   : Ada.Text_IO.File_Type;
 238
 239    begin
 240       Open
 241         (FP,
 242          Mode => In_File,
 243          Name => File);
 244       loop
 245          declare
 246             Line   : constant String :=
 247                       Ada.Strings.Fixed.Trim
 248                         (Get_Line (FP), Ada.Strings.Both);
 249             Tokens : Strings_List.Vector;
 250
 251          begin
 252             if Line'Length = 0 then
 253                --  Skip empty lines
 254                null;
 255
 256             elsif Line (Line'First) = '#' then
 257                --  Skip comment
 258                null;
 259
 260             else
 261                Tokens := Split (Line, ' ');
 262                if Tokens.First_Element = "section" then
 263                   --  Sections are not used for tags, only when building
 264                   --  kernels. So skip for now
 265                   null;
 266                else
 267                   Binder.Tags_List.Append (Line);
 268                end if;
 269             end if;
 270          end;
 271       end loop;
 272
 273    exception
 274       when Ada.IO_Exceptions.End_Error =>
 275          Close (FP);
 276       when others =>
 277          Log_Error ("Cannot open file " & File &
 278                       ". DKM tags won't be generated");
 279    end Parse_Tag_File;
 280
 281    ----------------------
 282    -- Emit_Module_Dtor --
 283    ----------------------
 284
 285    procedure Emit_Module_Dtor
 286      (FP : File_Type)
 287    is
 288       Dtor_Name : constant String := "_GLOBAL__D_65536_0_cxa_finalize";
 289    begin
 290       Put_Line (FP, "extern void __cxa_finalize(void *);");
 291       Put_Line (FP, "static void " & Dtor_Name & "()");
 292       Put_Line (FP, "{");
 293       Put_Line (FP, "  __cxa_finalize(&__dso_handle);");
 294       Put_Line (FP, "}");
 295       Put_Line (FP, "");
 296    end Emit_Module_Dtor;
 297
 298    ----------------
 299    -- Emit_CDtor --
 300    ----------------
 301
 302    procedure Emit_CDtor
 303      (FP  : File_Type;
 304       Var : String;
 305       Set : Symbol_Sets.Set)
 306    is
 307    begin
 308       for Sym of Set loop
 309          if not Sym.Internal then
 310             Put_Line (FP, "extern void " & To_String (Sym.Name) & "();");
 311          end if;
 312       end loop;
 313
 314       New_Line (FP);
 315
 316       Put_Line (FP, "extern void (*" & Var & "[])();");
 317       Put_Line (FP, "void (*" & Var & "[])() =");
 318       Put_Line (FP, "  {");
 319       for Sym of Set loop
 320          Put_Line (FP, "  " & To_String (Sym.Name) & ",");
 321       end loop;
 322       Put_Line (FP, "  0};");
 323       New_Line (FP);
 324    end Emit_CDtor;
 325
 326    ---------------
 327    -- Emit_CTDT --
 328    ---------------
 329
 330    procedure Emit_CTDT
 331      (Binder    : in out VxLink_Binder;
 332       Namespace : String)
 333    is
 334       FP         : Ada.Text_IO.File_Type;
 335       CDtor_File : constant String := Namespace & "-cdtor.c";
 336    begin
 337       Binder.CTDT_File := To_Unbounded_String (CDtor_File);
 338       Create
 339         (File => FP,
 340          Name => CDtor_File);
 341       Put_Line (FP, "#if defined(_HAVE_TOOL_XTORS)");
 342       Put_Line (FP, "#include <vxWorks.h>");
 343       if Binder.Module_Dtor_Needed then
 344          Put_Line (FP, "#define _WRS_NEED_CALL_CXA_FINALIZE");
 345       end if;
 346       Put_Line (FP, "#include TOOL_HEADER (toolXtors.h)");
 347       Put_Line (FP, "#else");
 348       Put_Line (FP, "");
 349
 350       if Binder.Module_Dtor_Needed then
 351          Emit_Module_Dtor (FP);
 352       end if;
 353
 354       Emit_CDtor (FP, "_ctors", Binder.Constructors);
 355       Emit_CDtor (FP, "_dtors", Binder.Destructors);
 356
 357       Put_Line (FP, "#endif");
 358
 359       if not Binder.Tags_List.Is_Empty then
 360          New_Line (FP);
 361          Put_Line (FP, "/* build variables */");
 362          Put_Line (FP, "__asm(""  .section \"".wrs_build_vars\"",\""a\"""");");
 363          for Tag of Binder.Tags_List loop
 364             Put_Line (FP, "__asm(""  .ascii \""" & Tag & "\"""");");
 365             Put_Line (FP, "__asm(""  .byte 0"");");
 366          end loop;
 367          Put_Line (FP, "__asm(""  .ascii \""end\"""");");
 368          Put_Line (FP, "__asm(""  .byte 0"");");
 369       end if;
 370
 371       Close (FP);
 372
 373    exception
 374       when others =>
 375          Close (FP);
 376          Set_Error_State ("Internal error");
 377          raise;
 378    end Emit_CTDT;
 379
 380    ---------------
 381    -- CTDT_File --
 382    ---------------
 383
 384    function CTDT_File (Binder : VxLink_Binder) return String
 385    is
 386    begin
 387       return To_String (Binder.CTDT_File);
 388    end CTDT_File;
 389
 390 end VxLink.Bind;