aboutsummaryrefslogtreecommitdiffstats
path: root/src/ortho/llvm-nodebug/ortho_code_main39.adb
diff options
context:
space:
mode:
Diffstat (limited to 'src/ortho/llvm-nodebug/ortho_code_main39.adb')
-rw-r--r--src/ortho/llvm-nodebug/ortho_code_main39.adb318
1 files changed, 0 insertions, 318 deletions
diff --git a/src/ortho/llvm-nodebug/ortho_code_main39.adb b/src/ortho/llvm-nodebug/ortho_code_main39.adb
deleted file mode 100644
index 11e52220e..000000000
--- a/src/ortho/llvm-nodebug/ortho_code_main39.adb
+++ /dev/null
@@ -1,318 +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.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_Main39 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;
-
- -- 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;
-
- Target : aliased TargetRef;
-
- CPU : constant Cstring := Empty_Cstring;
- Features : constant Cstring := Empty_Cstring;
- Reloc : RelocMode := RelocDefault;
-
- 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" or else Arg = "-O" then
- Optimization := CodeGenLevelLess;
- elsif Arg = "-O2" then
- Optimization := CodeGenLevelDefault;
- elsif Arg = "-O3" then
- Optimization := CodeGenLevelAggressive;
- elsif Arg = "-fpic" or Arg = "-fPIC" then
- Reloc := RelocPIC;
- elsif Arg = "-fno-pic" then
- Reloc := RelocStatic;
- elsif Arg = "--emit-llvm" then
- Output_Kind := Output_Llvm;
- elsif Arg = "--emit-bc" then
- Output_Kind := Output_Bytecode;
- elsif Arg = "-glines"
- or else Arg = "-gline-tables-only"
- then
- null;
- elsif Arg = "-g" then
- null;
- 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
- Opt_Arg := null;
- if Optind < Argument_Count then
- declare
- Arg1 : constant String := Argument (Optind + 1);
- begin
- if Arg1 (Arg1'First) /= '-' then
- Opt_Arg := new String'(Arg1);
- end if;
- end;
- 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);
-
- -- 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 := CreateTargetDataLayout (Target_Machine);
- SetModuleDataLayout (Module, Target_Data);
-
- 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_Dump_Llvm then
- DumpModule (Module);
- end if;
-
- -- Verify module.
- if False then
- if LLVM.Analysis.VerifyModule
- (Module, LLVM.Analysis.PrintMessageAction, Msg'Access) /= 0
- then
- DisposeMessage (Msg);
- raise Program_Error;
- end if;
- 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;
-
- 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;
- else
- DumpModule (Module);
- end if;
-
- Set_Exit_Status (Success);
-exception
- when others =>
- Set_Exit_Status (2);
- raise;
-end Ortho_Code_Main39;
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-10 10:17:00 +0000