Move sources to src/ subdirectory.

1 files changed, 0 insertions, 391 deletions

diff --git a/ortho/llvm/ortho_code_main.adb b/ortho/llvm/ortho_code_main.adb
deleted file mode 100644
index 300bb32..0000000
--- a/ortho/llvm/ortho_code_main.adb
+++ /dev/null
@@ -1,391 +0,0 @@
---  LLVM back-end for ortho - Main subprogram.
---  Copyright (C) 2014 Tristan Gingold
---
---  GHDL 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, or (at your option) any later
---  version.
---
---  GHDL 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 GCC; see the file COPYING.  If not, write to the Free
---  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
---  02111-1307, USA.
-
-with Ada.Command_Line; use Ada.Command_Line;
-with Ada.Unchecked_Deallocation;
-with Ada.Unchecked_Conversion;
-with Ada.Text_IO; use Ada.Text_IO;
-
-with Ortho_Front; use Ortho_Front;
-with LLVM.BitWriter;
-with LLVM.Core; use LLVM.Core;
-with LLVM.ExecutionEngine; use LLVM.ExecutionEngine;
-with LLVM.Target; use LLVM.Target;
-with LLVM.TargetMachine; use LLVM.TargetMachine;
-with LLVM.Analysis;
-with LLVM.Transforms.Scalar;
-with Ortho_LLVM; use Ortho_LLVM;
-with Interfaces;
-with Interfaces.C; use Interfaces.C;
-
-procedure Ortho_Code_Main is
-   --  Name of the output filename (given by option '-o').
-   Output : String_Acc := null;
-
-   type Output_Kind_Type is (Output_Llvm, Output_Bytecode,
-                             Output_Assembly, Output_Object);
-   Output_Kind : Output_Kind_Type := Output_Llvm;
-
-   --  True if the LLVM output must be displayed (set by '--dump-llvm')
-   Flag_Dump_Llvm : Boolean := False;
-
-   --  Index of the first file argument.
-   First_File : Natural;
-
-   --  Set by '--exec': function to call and its argument (an integer)
-   Exec_Func : String_Acc := null;
-   Exec_Val : Integer := 0;
-
-   --  Current option index.
-   Optind : Natural;
-
-   --  Number of arguments.
-   Argc : constant Natural := Argument_Count;
-
-   --  Name of the module.
-   Module_Name : String := "ortho" & Ascii.Nul;
-
-   --  Target triple.
-   Triple : Cstring := Empty_Cstring;
-
-   --  Execution engine
-   Engine : aliased ExecutionEngineRef;
-
-   Target : aliased TargetRef;
-
-   CPU : constant Cstring := Empty_Cstring;
-   Features : constant Cstring := Empty_Cstring;
-   Reloc : constant RelocMode := RelocDefault;
-
-   procedure Dump_Llvm
-   is
-      use LLVM.Analysis;
-      Msg : aliased Cstring;
-   begin
-      DumpModule (Module);
-      if LLVM.Analysis.VerifyModule
-        (Module, PrintMessageAction, Msg'Access) /= 0
-      then
-         null;
-      end if;
-   end Dump_Llvm;
-
-   function To_String (C : Cstring) return String is
-      function Strlen (C : Cstring) return Natural;
-      pragma Import (C, Strlen);
-
-      subtype Fat_String is String (Positive);
-      type Fat_String_Acc is access Fat_String;
-
-      function To_Fat_String_Acc is new
-        Ada.Unchecked_Conversion (Cstring, Fat_String_Acc);
-   begin
-      return To_Fat_String_Acc (C)(1 .. Strlen (C));
-   end To_String;
-
-   Codegen : CodeGenFileType := ObjectFile;
-
-   Msg : aliased Cstring;
-begin
-   Ortho_Front.Init;
-
-   --  Decode options.
-   First_File := Natural'Last;
-   Optind := 1;
-   while Optind <= Argc loop
-      declare
-         Arg : constant String := Argument (Optind);
-      begin
-         if Arg (1) = '-' then
-            if Arg = "--dump-llvm" then
-               Flag_Dump_Llvm := True;
-            elsif Arg = "-o" then
-               if Optind = Argc then
-                  Put_Line (Standard_Error, "error: missing filename to '-o'");
-                  return;
-               end if;
-               Output := new String'(Argument (Optind + 1) & ASCII.Nul);
-               Optind := Optind + 1;
-            elsif Arg = "-quiet" then
-               --  Skip silently.
-               null;
-            elsif Arg = "-S" then
-               Output_Kind := Output_Assembly;
-               Codegen := AssemblyFile;
-            elsif Arg = "-c" then
-               Output_Kind := Output_Object;
-               Codegen := ObjectFile;
-            elsif Arg = "-O0" then
-               Optimization := CodeGenLevelNone;
-            elsif Arg = "-O1" then
-               Optimization := CodeGenLevelLess;
-            elsif Arg = "-O2" then
-               Optimization := CodeGenLevelDefault;
-            elsif Arg = "-O3" then
-               Optimization := CodeGenLevelAggressive;
-            elsif Arg = "--emit-llvm" then
-               Output_Kind := Output_Llvm;
-            elsif Arg = "--emit-bc" then
-               Output_Kind := Output_Bytecode;
-            elsif Arg = "--exec" then
-               if Optind + 1 >= Argc then
-                  Put_Line (Standard_Error,
-                            "error: missing function name to '--exec'");
-                  return;
-               end if;
-               Exec_Func := new String'(Argument (Optind + 1));
-               Exec_Val := Integer'Value (Argument (Optind + 2));
-               Optind := Optind + 2;
-            elsif Arg = "-g" then
-               Flag_Debug := True;
-            else
-               --  This is really an argument.
-               declare
-                  procedure Unchecked_Deallocation is
-                     new Ada.Unchecked_Deallocation
-                    (Name => String_Acc, Object => String);
-
-                  Opt : String_Acc := new String'(Arg);
-                  Opt_Arg : String_Acc;
-                  Res : Natural;
-               begin
-                  if Optind < Argument_Count then
-                     Opt_Arg := new String'(Argument (Optind + 1));
-                  else
-                     Opt_Arg := null;
-                  end if;
-                  Res := Ortho_Front.Decode_Option (Opt, Opt_Arg);
-                  case Res is
-                     when 0 =>
-                        Put_Line (Standard_Error,
-                                  "unknown option '" & Arg & "'");
-                        return;
-                     when 1 =>
-                        null;
-                     when 2 =>
-                        Optind := Optind + 1;
-                     when others =>
-                        raise Program_Error;
-                  end case;
-                  Unchecked_Deallocation (Opt);
-                  Unchecked_Deallocation (Opt_Arg);
-               end;
-            end if;
-         else
-            First_File := Optind;
-            exit;
-         end if;
-      end;
-      Optind := Optind + 1;
-   end loop;
-
-   --  Link with LLVM libraries.
-   InitializeNativeTarget;
-   InitializeNativeAsmPrinter;
-
-   LinkInJIT;
-
-   Module := ModuleCreateWithName (Module_Name'Address);
-
-   if Output = null and then Exec_Func /= null then
-      -- Now we going to create JIT
-      if CreateExecutionEngineForModule
-        (Engine'Access, Module, Msg'Access) /= 0
-      then
-         Put_Line (Standard_Error,
-                   "cannot create execute: " & To_String (Msg));
-         raise Program_Error;
-      end if;
-
-      Target_Data := GetExecutionEngineTargetData (Engine);
-   else
-      --  Extract target triple
-      Triple := GetDefaultTargetTriple;
-      SetTarget (Module, Triple);
-
-      --  Get Target
-      if GetTargetFromTriple (Triple, Target'Access, Msg'Access) /= 0 then
-         raise Program_Error;
-      end if;
-
-      --  Create a target machine
-      Target_Machine := CreateTargetMachine
-        (Target, Triple, CPU, Features, Optimization, Reloc, CodeModelDefault);
-
-      Target_Data := GetTargetMachineData (Target_Machine);
-   end if;
-
-   SetDataLayout (Module, CopyStringRepOfTargetData (Target_Data));
-
-   if False then
-      declare
-         Targ : TargetRef;
-      begin
-         Put_Line ("Triple: " & To_String (Triple));
-         New_Line;
-         Put_Line ("Targets:");
-         Targ := GetFirstTarget;
-         while Targ /= Null_TargetRef loop
-            Put_Line (" " & To_String (GetTargetName (Targ))
-                        & ": " & To_String (GetTargetDescription (Targ)));
-            Targ := GetNextTarget (Targ);
-         end loop;
-      end;
-      -- Target_Data := CreateTargetData (Triple);
-   end if;
-
-   Ortho_LLVM.Init;
-
-   Set_Exit_Status (Failure);
-
-   if First_File > Argument_Count then
-      begin
-         if not Parse (null) then
-            return;
-         end if;
-      exception
-         when others =>
-            return;
-      end;
-   else
-      for I in First_File .. Argument_Count loop
-         declare
-            Filename : constant String_Acc :=
-              new String'(Argument (First_File));
-         begin
-            if not Parse (Filename) then
-               return;
-            end if;
-         exception
-            when others =>
-               return;
-         end;
-      end loop;
-   end if;
-
-   if Flag_Debug then
-      Ortho_LLVM.Finish_Debug;
-   end if;
-
-   --  Ortho_Mcode.Finish;
-
-   if Flag_Dump_Llvm then
-      Dump_Llvm;
-   end if;
-
-   --  Verify module.
-   if LLVM.Analysis.VerifyModule
-     (Module, LLVM.Analysis.PrintMessageAction, Msg'Access) /= 0
-   then
-      DisposeMessage (Msg);
-      raise Program_Error;
-   end if;
-
-   if Optimization > CodeGenLevelNone then
-      declare
-         use LLVM.Transforms.Scalar;
-         Global_Manager : constant Boolean := False;
-         Pass_Manager : PassManagerRef;
-         Res : Bool;
-         pragma Unreferenced (Res);
-         A_Func : ValueRef;
-      begin
-         if Global_Manager then
-            Pass_Manager := CreatePassManager;
-         else
-            Pass_Manager := CreateFunctionPassManagerForModule (Module);
-         end if;
-
-         LLVM.Target.AddTargetData (Target_Data, Pass_Manager);
-         AddPromoteMemoryToRegisterPass (Pass_Manager);
-         AddCFGSimplificationPass (Pass_Manager);
-
-         if Global_Manager then
-            Res := RunPassManager (Pass_Manager, Module);
-         else
-            A_Func := GetFirstFunction (Module);
-            while A_Func /= Null_ValueRef loop
-               Res := RunFunctionPassManager (Pass_Manager, A_Func);
-               A_Func := GetNextFunction (A_Func);
-            end loop;
-         end if;
-      end;
-   end if;
-
-   if Output /= null then
-      declare
-         Error : Boolean;
-      begin
-         Msg := Empty_Cstring;
-
-         case Output_Kind is
-            when Output_Assembly
-              | Output_Object =>
-               Error := LLVM.TargetMachine.TargetMachineEmitToFile
-                 (Target_Machine, Module,
-                  Output.all'Address, Codegen, Msg'Access) /= 0;
-            when Output_Bytecode =>
-               Error := LLVM.BitWriter.WriteBitcodeToFile
-                 (Module, Output.all'Address) /= 0;
-            when Output_Llvm =>
-               Error := PrintModuleToFile
-                 (Module, Output.all'Address, Msg'Access) /= 0;
-         end case;
-         if Error then
-            Put_Line (Standard_Error,
-                      "error while writing to " & Output.all);
-            if Msg /= Empty_Cstring then
-               Put_Line (Standard_Error,
-                         "message: " & To_String (Msg));
-               DisposeMessage (Msg);
-            end if;
-            Set_Exit_Status (2);
-            return;
-         end if;
-      end;
-   elsif Exec_Func /= null then
-      declare
-         use Interfaces;
-         Res : GenericValueRef;
-         Vals : GenericValueRefArray (0 .. 0);
-         Func : aliased ValueRef;
-      begin
-         if FindFunction (Engine, Exec_Func.all'Address, Func'Access) /= 0 then
-            raise Program_Error;
-         end if;
-
-         -- Call the function with argument n:
-         Vals (0) := CreateGenericValueOfInt
-           (Int32Type, Unsigned_64 (Exec_Val), 0);
-         Res := RunFunction (Engine, Func, 1, Vals);
-
-         -- import result of execution
-         Put_Line ("Result is "
-                     & Unsigned_64'Image (GenericValueToInt (Res, 0)));
-
-      end;
-   else
-      Dump_Llvm;
-   end if;
-
-   Set_Exit_Status (Success);
-exception
-   when others =>
-      Set_Exit_Status (2);
-      raise;
-end Ortho_Code_Main;