summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ortho/llvm/ortho_code_main.adb22
-rw-r--r--ortho/llvm/ortho_jit.adb7
-rw-r--r--ortho/llvm/ortho_llvm-main.adb77
-rw-r--r--ortho/llvm/ortho_llvm-main.ads57
-rw-r--r--ortho/llvm/ortho_llvm.adb97
-rw-r--r--ortho/llvm/ortho_llvm.ads33
-rw-r--r--ortho/llvm/ortho_llvm.private.ads33
7 files changed, 153 insertions, 173 deletions
diff --git a/ortho/llvm/ortho_code_main.adb b/ortho/llvm/ortho_code_main.adb
index eec8490..300bb32 100644
--- a/ortho/llvm/ortho_code_main.adb
+++ b/ortho/llvm/ortho_code_main.adb
@@ -18,8 +18,9 @@
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_LLVM.Main; use Ortho_LLVM.Main;
+
with Ortho_Front; use Ortho_Front;
with LLVM.BitWriter;
with LLVM.Core; use LLVM.Core;
@@ -28,11 +29,11 @@ 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
+procedure Ortho_Code_Main is
-- Name of the output filename (given by option '-o').
Output : String_Acc := null;
@@ -84,6 +85,19 @@ is
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;
@@ -235,7 +249,7 @@ begin
-- Target_Data := CreateTargetData (Triple);
end if;
- Ortho_LLVM.Main.Init;
+ Ortho_LLVM.Init;
Set_Exit_Status (Failure);
diff --git a/ortho/llvm/ortho_jit.adb b/ortho/llvm/ortho_jit.adb
index cdb4f0f..9aa6c1c 100644
--- a/ortho/llvm/ortho_jit.adb
+++ b/ortho/llvm/ortho_jit.adb
@@ -19,7 +19,7 @@
-- with GNAT.OS_Lib; use GNAT.OS_Lib;
with Ada.Text_IO; use Ada.Text_IO;
-with Ortho_LLVM.Main; use Ortho_LLVM.Main;
+with Ortho_LLVM; use Ortho_LLVM;
with Ortho_LLVM.Jit;
with LLVM.Core; use LLVM.Core;
@@ -59,15 +59,14 @@ package body Ortho_Jit is
if CreateExecutionEngineForModule
(Ortho_LLVM.Jit.Engine'Access, Module, Msg'Access) /= 0
then
- Put_Line (Standard_Error,
- "cannot create execute: " & To_String (Msg));
+ Put_Line (Standard_Error, "cannot create execution engine");
raise Program_Error;
end if;
Target_Data := GetExecutionEngineTargetData (Ortho_LLVM.Jit.Engine);
SetDataLayout (Module, CopyStringRepOfTargetData (Target_Data));
- Ortho_LLVM.Main.Init;
+ Ortho_LLVM.Init;
end Init;
procedure Set_Address (Decl : O_Dnode; Addr : Address)
diff --git a/ortho/llvm/ortho_llvm-main.adb b/ortho/llvm/ortho_llvm-main.adb
deleted file mode 100644
index f315fe4..0000000
--- a/ortho/llvm/ortho_llvm-main.adb
+++ /dev/null
@@ -1,77 +0,0 @@
--- LLVM back-end for ortho.
--- 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.Unchecked_Conversion;
-
-package body Ortho_LLVM.Main is
- Dbg_Str : constant String := "dbg";
-
- 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;
-
- procedure Init is
- begin
- Builder := CreateBuilder;
- Decl_Builder := CreateBuilder;
-
- Char_Type := New_Unsigned_Type (8);
- New_Type_Decl (Get_Identifier ("__llvm_char"), Char_Type);
-
- if False then
- Char_Ptr_Type := New_Access_Type (Char_Type);
- New_Type_Decl (Get_Identifier ("__llvm_char_ptr"), Char_Ptr_Type);
-
- Stacksave_Fun := AddFunction
- (Module, Stacksave_Name'Address,
- FunctionType (Get_LLVM_Type (Char_Ptr_Type),
- TypeRefArray'(1 .. 0 => Null_TypeRef), 0, 0));
-
- Stackrestore_Fun := AddFunction
- (Module, Stackrestore_Name'Address,
- FunctionType
- (VoidType,
- TypeRefArray'(1 => Get_LLVM_Type (Char_Ptr_Type)), 1, 0));
- end if;
-
- if Flag_Debug then
- Debug_ID := GetMDKindID (Dbg_Str, Dbg_Str'Length);
-
- declare
- Atypes : TypeRefArray (1 .. 2);
- Ftype : TypeRef;
- Name : String := "llvm.dbg.declare" & ASCII.NUL;
- begin
- Atypes := (MetadataType, MetadataType);
- Ftype := FunctionType (VoidType, Atypes, Atypes'Length, 0);
- Llvm_Dbg_Declare := AddFunction (Module, Name'Address, Ftype);
- AddFunctionAttr (Llvm_Dbg_Declare,
- NoUnwindAttribute + ReadNoneAttribute);
- end;
- end if;
- end Init;
-end Ortho_LLVM.Main;
diff --git a/ortho/llvm/ortho_llvm-main.ads b/ortho/llvm/ortho_llvm-main.ads
deleted file mode 100644
index 56bbdb4..0000000
--- a/ortho/llvm/ortho_llvm-main.ads
+++ /dev/null
@@ -1,57 +0,0 @@
--- LLVM back-end for ortho.
--- 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 GNAT.Directory_Operations;
-with LLVM.Target; use LLVM.Target;
-with LLVM.TargetMachine; use LLVM.TargetMachine;
-
-package Ortho_LLVM.Main is
- use LLVM.Core;
-
- -- LLVM specific: the module.
- Module : ModuleRef;
-
- -- Descriptor for the layout.
- Target_Data : TargetDataRef;
-
- Target_Machine : TargetMachineRef;
-
- -- Optimization level
- Optimization : CodeGenOptLevel := CodeGenLevelDefault;
-
- -- Set by -g to generate debug info.
- Flag_Debug : Boolean := False;
-
- Debug_ID : unsigned;
-
- -- Some predefined types and functions.
- Char_Type : O_Tnode;
- Char_Ptr_Type : O_Tnode;
-
- Stacksave_Fun : ValueRef;
- Stacksave_Name : constant String := "llvm.stacksave" & ASCII.NUL;
- Stackrestore_Fun : ValueRef;
- Stackrestore_Name : constant String := "llvm.stackrestore" & ASCII.NUL;
-
- Current_Directory : constant String :=
- GNAT.Directory_Operations.Get_Current_Dir;
-
- function To_String (C : Cstring) return String;
-
- procedure Init;
-end Ortho_LLVM.Main;
diff --git a/ortho/llvm/ortho_llvm.adb b/ortho/llvm/ortho_llvm.adb
index be9364f..862435d 100644
--- a/ortho/llvm/ortho_llvm.adb
+++ b/ortho/llvm/ortho_llvm.adb
@@ -16,29 +16,56 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Ortho_LLVM.Main; use Ortho_LLVM.Main;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with LLVM.Target; use LLVM.Target;
+with GNAT.Directory_Operations;
package body Ortho_LLVM is
-
- -- Target_Data : TargetDataRef;
+ -- The current function for LLVM (needed to add new basic blocks).
Cur_Func : ValueRef;
+
+ -- The current function node (needed for return type).
Cur_Func_Decl : O_Dnode;
+
+ -- Wether the code is currently unreachable. LLVM doesn't accept basic
+ -- blocks that cannot be reached (using trivial rules). So we need to
+ -- discard instructions after a return, a next or an exit statement.
Unreach : Boolean;
+ -- Builder for statements.
+ Builder : BuilderRef;
+
+ -- Builder for declarations (local variables).
+ Decl_Builder : BuilderRef;
+
+ -- Declaration of llvm.dbg.declare
+ Llvm_Dbg_Declare : ValueRef;
+
+ Debug_ID : unsigned;
+
+ Current_Directory : constant String :=
+ GNAT.Directory_Operations.Get_Current_Dir;
+
+ -- Additional data for declare blocks.
type Declare_Block_Type;
type Declare_Block_Acc is access Declare_Block_Type;
type Declare_Block_Type is record
+ -- First basic block of the declare.
Stmt_Bb : BasicBlockRef;
+ -- Debug data for the scope of the declare block.
Dbg_Scope : ValueRef;
+
+ -- Previous element in the stack.
Prev : Declare_Block_Acc;
end record;
+ -- Current declare block.
Cur_Declare_Block : Declare_Block_Acc;
+
+ -- Chain of unused blocks to be recycled.
Old_Declare_Block : Declare_Block_Acc;
-- For debugging
@@ -257,18 +284,23 @@ package body Ortho_LLVM is
is
Res : Declare_Block_Acc;
begin
+ -- Try to recycle an unused record.
if Old_Declare_Block /= null then
Res := Old_Declare_Block;
Old_Declare_Block := Res.Prev;
else
+ -- Create a new one if no unused records.
Res := new Declare_Block_Type;
end if;
+ -- Chain.
Res.Prev := Cur_Declare_Block;
Cur_Declare_Block := Res;
if not Unreach then
Res.Stmt_Bb := AppendBasicBlock (Cur_Func, Empty_Cstring);
+ else
+ Res.Stmt_Bb := Null_BasicBlockRef;
end if;
end Create_Declare_Block;
@@ -276,7 +308,10 @@ package body Ortho_LLVM is
is
Blk : constant Declare_Block_Acc := Cur_Declare_Block;
begin
+ -- Unchain.
Cur_Declare_Block := Blk.Prev;
+
+ -- Put on the recyle list.
Blk.Prev := Old_Declare_Block;
Old_Declare_Block := Blk;
end Destroy_Declare_Block;
@@ -701,7 +736,6 @@ package body Ortho_LLVM is
Append (Enum_Nodes, MDNode (Vals, Vals'Length));
end Dbg_Add_Enumeration;
-
----------------------
-- New_Boolean_Type --
----------------------
@@ -1232,7 +1266,6 @@ package body Ortho_LLVM is
when ON_Neg_Ov =>
Res := BuildNeg (Builder, Operand.LLVM, Empty_Cstring);
when ON_Abs_Ov =>
- -- FIXME: float ?
Res := BuildSelect
(Builder,
BuildICmp (Builder, IntSLT,
@@ -2762,4 +2795,58 @@ package body Ortho_LLVM is
(Module, Module_Flags'Address, MDNode (Flags2, Flags2'Length));
end;
end Finish_Debug;
+
+ Dbg_Str : constant String := "dbg";
+
+ Stacksave_Fun : ValueRef;
+ pragma Unreferenced (Stacksave_Fun);
+ Stacksave_Name : constant String := "llvm.stacksave" & ASCII.NUL;
+ Stackrestore_Fun : ValueRef;
+ pragma Unreferenced (Stackrestore_Fun);
+ Stackrestore_Name : constant String := "llvm.stackrestore" & ASCII.NUL;
+
+ procedure Init is
+ -- Some predefined types and functions.
+ Char_Type : O_Tnode;
+ Char_Ptr_Type : O_Tnode;
+ begin
+ Builder := CreateBuilder;
+ Decl_Builder := CreateBuilder;
+
+ Char_Type := New_Unsigned_Type (8);
+ New_Type_Decl (Get_Identifier ("__llvm_char"), Char_Type);
+
+ if False then
+ Char_Ptr_Type := New_Access_Type (Char_Type);
+ New_Type_Decl (Get_Identifier ("__llvm_char_ptr"), Char_Ptr_Type);
+
+ Stacksave_Fun := AddFunction
+ (Module, Stacksave_Name'Address,
+ FunctionType (Get_LLVM_Type (Char_Ptr_Type),
+ TypeRefArray'(1 .. 0 => Null_TypeRef), 0, 0));
+
+ Stackrestore_Fun := AddFunction
+ (Module, Stackrestore_Name'Address,
+ FunctionType
+ (VoidType,
+ TypeRefArray'(1 => Get_LLVM_Type (Char_Ptr_Type)), 1, 0));
+ end if;
+
+ if Flag_Debug then
+ Debug_ID := GetMDKindID (Dbg_Str, Dbg_Str'Length);
+
+ declare
+ Atypes : TypeRefArray (1 .. 2);
+ Ftype : TypeRef;
+ Name : String := "llvm.dbg.declare" & ASCII.NUL;
+ begin
+ Atypes := (MetadataType, MetadataType);
+ Ftype := FunctionType (VoidType, Atypes, Atypes'Length, 0);
+ Llvm_Dbg_Declare := AddFunction (Module, Name'Address, Ftype);
+ AddFunctionAttr (Llvm_Dbg_Declare,
+ NoUnwindAttribute + ReadNoneAttribute);
+ end;
+ end if;
+ end Init;
+
end Ortho_LLVM;
diff --git a/ortho/llvm/ortho_llvm.ads b/ortho/llvm/ortho_llvm.ads
index 206188f..8e68eb1 100644
--- a/ortho/llvm/ortho_llvm.ads
+++ b/ortho/llvm/ortho_llvm.ads
@@ -21,14 +21,31 @@
with Interfaces; use Interfaces;
with Interfaces.C; use Interfaces.C;
-with Ortho_Ident;
-use Ortho_Ident;
-with LLVM.Core;
+with Ortho_Ident; use Ortho_Ident;
+with LLVM.Core; use LLVM.Core;
+with LLVM.TargetMachine;
+with LLVM.Target;
-- Interface to create nodes.
package Ortho_LLVM is
+ procedure Init;
procedure Finish_Debug;
+ -- LLVM specific: the module.
+ Module : ModuleRef;
+
+ -- Descriptor for the layout.
+ Target_Data : LLVM.Target.TargetDataRef;
+
+ Target_Machine : LLVM.TargetMachine.TargetMachineRef;
+
+ -- Optimization level
+ Optimization : LLVM.TargetMachine.CodeGenOptLevel :=
+ LLVM.TargetMachine.CodeGenLevelDefault;
+
+ -- Set by -g to generate debug info.
+ Flag_Debug : Boolean := False;
+
-- Start of common part
type O_Enode is private;
@@ -462,8 +479,6 @@ private
-- No support for nested subprograms in LLVM.
Has_Nested_Subprograms : constant Boolean := False;
- use LLVM.Core;
-
type O_Tnode_Type (<>);
type O_Tnode is access O_Tnode_Type;
O_Tnode_Null : constant O_Tnode := null;
@@ -719,12 +734,4 @@ private
end record;
function Get_LLVM_Type (Atype : O_Tnode) return TypeRef;
-
- -- Builder for statements.
- Builder : BuilderRef;
-
- -- Builder for declarations (local variables).
- Decl_Builder : BuilderRef;
-
- Llvm_Dbg_Declare : ValueRef;
end Ortho_LLVM;
diff --git a/ortho/llvm/ortho_llvm.private.ads b/ortho/llvm/ortho_llvm.private.ads
index 30b86a4..842a119 100644
--- a/ortho/llvm/ortho_llvm.private.ads
+++ b/ortho/llvm/ortho_llvm.private.ads
@@ -18,20 +18,35 @@
with Interfaces; use Interfaces;
with Interfaces.C; use Interfaces.C;
-with Ortho_Ident;
-use Ortho_Ident;
-with LLVM.Core;
+with Ortho_Ident; use Ortho_Ident;
+with LLVM.Core; use LLVM.Core;
+with LLVM.TargetMachine;
+with LLVM.Target;
-- Interface to create nodes.
package Ortho_LLVM is
+ procedure Init;
procedure Finish_Debug;
+ -- LLVM specific: the module.
+ Module : ModuleRef;
+
+ -- Descriptor for the layout.
+ Target_Data : LLVM.Target.TargetDataRef;
+
+ Target_Machine : LLVM.TargetMachine.TargetMachineRef;
+
+ -- Optimization level
+ Optimization : LLVM.TargetMachine.CodeGenOptLevel :=
+ LLVM.TargetMachine.CodeGenLevelDefault;
+
+ -- Set by -g to generate debug info.
+ Flag_Debug : Boolean := False;
+
private
-- No support for nested subprograms in LLVM.
Has_Nested_Subprograms : constant Boolean := False;
- use LLVM.Core;
-
type O_Tnode_Type (<>);
type O_Tnode is access O_Tnode_Type;
O_Tnode_Null : constant O_Tnode := null;
@@ -287,12 +302,4 @@ private
end record;
function Get_LLVM_Type (Atype : O_Tnode) return TypeRef;
-
- -- Builder for statements.
- Builder : BuilderRef;
-
- -- Builder for declarations (local variables).
- Decl_Builder : BuilderRef;
-
- Llvm_Dbg_Declare : ValueRef;
end Ortho_LLVM;
generated by cgit (git 2.34.1) at 2025-01-10 17:37:04 +0000