summaryrefslogtreecommitdiff
path: root/ortho
diff options
context:
space:
mode:
Diffstat (limited to 'ortho')
-rw-r--r--ortho/debug/ortho_debug-disp.adb14
-rw-r--r--ortho/debug/ortho_debug-main.adb1
-rw-r--r--ortho/debug/ortho_debug.adb25
-rw-r--r--ortho/debug/ortho_debug.private.ads3
-rw-r--r--ortho/gcc/Makefile10
-rw-r--r--ortho/gcc/Makefile.inc12
-rw-r--r--ortho/gcc/ortho-lang.c102
-rw-r--r--ortho/gcc/ortho_ident.adb1
-rw-r--r--ortho/mcode/binary_file.adb18
-rw-r--r--ortho/mcode/binary_file.ads2
-rw-r--r--ortho/mcode/disa_x86.adb1
-rw-r--r--ortho/mcode/ortho_code-decls.adb4
-rw-r--r--ortho/mcode/ortho_code-disps.adb8
-rw-r--r--ortho/mcode/ortho_code-dwarf.adb7
-rw-r--r--ortho/mcode/ortho_code-exprs.adb3
-rw-r--r--ortho/mcode/ortho_code-opts.adb2
-rw-r--r--ortho/mcode/ortho_code-types.adb1
-rw-r--r--ortho/mcode/ortho_code-x86-abi.adb7
-rw-r--r--ortho/mcode/ortho_code-x86-abi.ads1
-rw-r--r--ortho/mcode/ortho_code-x86-emits.adb25
-rw-r--r--ortho/mcode/ortho_code-x86-insns.adb32
-rw-r--r--ortho/mcode/ortho_ident.adb6
-rw-r--r--ortho/mcode/ortho_mcode.adb5
23 files changed, 101 insertions, 189 deletions
diff --git a/ortho/debug/ortho_debug-disp.adb b/ortho/debug/ortho_debug-disp.adb
index 36c1750..b97ff50 100644
--- a/ortho/debug/ortho_debug-disp.adb
+++ b/ortho/debug/ortho_debug-disp.adb
@@ -109,6 +109,7 @@ package body Ortho_Debug.Disp is
is
Status : size_t;
Res : int;
+ pragma Unreferenced (Status, Res);
begin
if Ctx.Line_Len > 0 then
Status := fwrite (Ctx.Line'Address, size_t (Ctx.Line_Len), 1,
@@ -176,6 +177,7 @@ package body Ortho_Debug.Disp is
procedure New_Line
is
Status : int;
+ pragma Unreferenced (Status);
begin
if Ctx.Line_Len > 0 then
Flush;
@@ -185,8 +187,9 @@ package body Ortho_Debug.Disp is
Ctx.Next_Tab := Ctx.Tab;
end New_Line;
- procedure Put (C : Character) is
- S : String (1 .. 1) := (1 => C);
+ procedure Put (C : Character)
+ is
+ S : constant String (1 .. 1) := (1 => C);
begin
Put (S);
end Put;
@@ -364,6 +367,8 @@ package body Ortho_Debug.Disp is
end case;
end Get_Lnode_Name;
+ pragma Unreferenced (Get_Lnode_Name);
+
procedure Disp_Enode_Name (Kind : OE_Kind) is
begin
Put (Get_Enode_Name (Kind));
@@ -388,7 +393,7 @@ package body Ortho_Debug.Disp is
function Image (Lit : Integer) return String
is
- S : String := Integer'Image (Lit);
+ S : constant String := Integer'Image (Lit);
begin
if S (1) = ' ' then
return S (2 .. S'Length);
@@ -997,4 +1002,7 @@ package body Ortho_Debug.Disp is
Disp_Snode (N, null);
Pop_Context (Ctx);
end Debug_Snode;
+
+ pragma Unreferenced (Debug_Tnode, Debug_Enode, Debug_Fnode,
+ Debug_Dnode, Debug_Lnode, Debug_Snode);
end Ortho_Debug.Disp;
diff --git a/ortho/debug/ortho_debug-main.adb b/ortho/debug/ortho_debug-main.adb
index 714b853..b470dea 100644
--- a/ortho/debug/ortho_debug-main.adb
+++ b/ortho/debug/ortho_debug-main.adb
@@ -136,6 +136,7 @@ begin
if Output /= NULL_Stream then
declare
Status : int;
+ pragma Unreferenced (Status);
begin
Status := fclose (Output);
end;
diff --git a/ortho/debug/ortho_debug.adb b/ortho/debug/ortho_debug.adb
index 2cb4d42..7ca70c1 100644
--- a/ortho/debug/ortho_debug.adb
+++ b/ortho/debug/ortho_debug.adb
@@ -972,16 +972,7 @@ package body Ortho_Debug is
is
subtype O_Lnode_Indexed is O_Lnode_Type (OL_Indexed_Element);
Res : O_Lnode;
- Rtype : O_Tnode;
begin
- case Arr.Rtype.Kind is
- when ON_Array_Type =>
- Rtype := Arr.Rtype.El_Type;
- when ON_Array_Sub_Type =>
- Rtype := Arr.Rtype.Base_Type.El_Type;
- when others =>
- raise Type_Error;
- end case;
Check_Ref (Arr);
Res := new O_Lnode_Indexed'(Kind => OL_Indexed_Element,
Rtype => Get_Base_Type (Arr.Rtype).El_Type,
@@ -1231,20 +1222,20 @@ package body Ortho_Debug is
procedure New_Debug_Line_Decl (Line : Natural)
is
- subtype O_Dnode_Line_Decl is O_Dnode (ON_Debug_Line_Decl);
- N : O_Dnode_Line_Decl;
+ subtype O_Dnode_Line_Decl is O_Dnode_Type (ON_Debug_Line_Decl);
+ N : O_Dnode;
begin
- N := new O_Dnode_Type (ON_Debug_Line_Decl);
+ N := new O_Dnode_Line_Decl;
N.Line := Line;
Add_Decl (N, False);
end New_Debug_Line_Decl;
procedure New_Debug_Comment_Decl (Comment : String)
is
- subtype O_Dnode_Comment_Decl is O_Dnode (ON_Debug_Comment_Decl);
- N : O_Dnode_Comment_Decl;
+ subtype O_Dnode_Comment_Decl is O_Dnode_Type (ON_Debug_Comment_Decl);
+ N : O_Dnode;
begin
- N := new O_Dnode_Type (ON_Debug_Comment_Decl);
+ N := new O_Dnode_Comment_Decl;
N.Comment := new String'(Comment);
Add_Decl (N, False);
end New_Debug_Comment_Decl;
@@ -1321,6 +1312,8 @@ package body Ortho_Debug is
subtype O_Dnode_Const_Value is O_Dnode_Type (ON_Const_Value);
N : O_Dnode;
begin
+ Const := Const;
+
if Const.Const_Value /= O_Dnode_Null then
-- Constant already has a value.
raise Syntax_Error;
@@ -1349,6 +1342,8 @@ package body Ortho_Debug is
procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode)
is
begin
+ Const := Const;
+
if Const.Const_Value = O_Dnode_Null then
-- Start_Const_Value not called.
raise Syntax_Error;
diff --git a/ortho/debug/ortho_debug.private.ads b/ortho/debug/ortho_debug.private.ads
index ab77b55..03489c5 100644
--- a/ortho/debug/ortho_debug.private.ads
+++ b/ortho/debug/ortho_debug.private.ads
@@ -16,9 +16,6 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Ortho_Ident;
-use Ortho_Ident;
-
package Ortho_Debug is
type O_Enode is private;
type O_Cnode is private;
diff --git a/ortho/gcc/Makefile b/ortho/gcc/Makefile
index 63fb5e3..18fc0b1 100644
--- a/ortho/gcc/Makefile
+++ b/ortho/gcc/Makefile
@@ -2,9 +2,10 @@ ortho_srcdir=..
orthobe_srcdir=$(ortho_srcdir)/gcc
agcc_objdir=.
agcc_srcdir=$(ortho_srcdir)/gcc
-AGCC_GCCSRC_DIR:=$(HOME)/dist/gcc-4.2.4
+AGCC_GCCSRC_DIR:=$(HOME)/dist/gcc-4.3.1
AGCC_GCCOBJ_DIR:=$(AGCC_GCCSRC_DIR)-objs/
SED=sed
+GNATMAKE=gnatmake
all: $(ortho_exec)
@@ -15,12 +16,13 @@ ORTHO_PACKAGE=Ortho_Gcc
$(ortho_exec): $(AGCC_DEPS) $(ORTHO_BASENAME).ads force
- gnatmake -m -o $@ -g -aI$(ortho_srcdir) \
+ $(GNATMAKE) -m -o $@ -g -aI$(ortho_srcdir) \
-aI$(ortho_srcdir)/gcc $(GNAT_FLAGS) ortho_gcc-main \
- -bargs -E -largs $(AGCC_OBJS) \
+ -bargs -E -largs $(AGCC_OBJS) \
$(AGCC_GCCOBJ_DIR)libcpp/libcpp.a \
$(AGCC_GCCOBJ_DIR)libiberty/libiberty.a \
- $(AGCC_GCCOBJ_DIR)libdecnumber/libdecnumber.a #-static
+ $(AGCC_GCCOBJ_DIR)libdecnumber/libdecnumber.a \
+ -lmpfr -lgmp #-static
clean: agcc-clean
$(RM) -f *.o *.ali ortho_nodes-main
diff --git a/ortho/gcc/Makefile.inc b/ortho/gcc/Makefile.inc
index ef60808..8b7289a 100644
--- a/ortho/gcc/Makefile.inc
+++ b/ortho/gcc/Makefile.inc
@@ -27,24 +27,16 @@ AGCC_INC_FLAGS=-I$(AGCC_GCCOBJ_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/include \
-I$(AGCC_GCCSRC_DIR)/libcpp/include
AGCC_CFLAGS=-g -Wall -DIN_GCC $(AGCC_INC_FLAGS)
-AGCC_LOCAL_OBJS=ortho-lang.o gcc-version.o
+AGCC_LOCAL_OBJS=ortho-lang.o
AGCC_DEPS := $(AGCC_LOCAL_OBJS)
AGCC_OBJS := $(AGCC_LOCAL_OBJS) \
$(AGCC_GCCOBJ_DIR)gcc/toplev.o \
+ $(AGCC_GCCOBJ_DIR)gcc/attribs.o \
$(AGCC_GCCOBJ_DIR)gcc/libbackend.a \
$(AGCC_GCCOBJ_DIR)libcpp/libcpp.a \
$(AGCC_GCCOBJ_DIR)libiberty/libiberty.a
-gcc-version.c: $(AGCC_GCCSRC_DIR)/gcc/BASE-VER
- -$(RM) -f $@
- echo '#include "version.h"' > $@
- echo "const char version_string[] = \""`cat $<` "(ghdl)\";" >> $@
- echo 'const char bug_report_url[] = "<URL:http://gna.org/projects/ghdl>";' >> $@
-
-gcc-version.o: gcc-version.c
- $(CC) -c -o $@ $< $(AGCC_CFLAGS)
-
ortho-lang.o: $(agcc_srcdir)/ortho-lang.c \
$(AGCC_GCCOBJ_DIR)gcc/gtype-vhdl.h \
$(AGCC_GCCOBJ_DIR)gcc/gt-vhdl-ortho-lang.h
diff --git a/ortho/gcc/ortho-lang.c b/ortho/gcc/ortho-lang.c
index a5037f9..c37e391 100644
--- a/ortho/gcc/ortho-lang.c
+++ b/ortho/gcc/ortho-lang.c
@@ -247,7 +247,7 @@ ortho_init (void)
{
tree n;
- input_location.line = 0;
+ input_location = BUILTINS_LOCATION;
/* Create a global binding. */
push_binding ();
@@ -372,13 +372,6 @@ ortho_handle_option (size_t code, const char *arg, int value)
}
}
-#if 0
-void
-linemap_init (void *s)
-{
-}
-#endif
-
extern int lang_parse_file (const char *filename);
static void
@@ -391,6 +384,9 @@ ortho_parse_file (int debug)
else
filename = in_fnames[0];
+ linemap_add (line_table, LC_ENTER, 0, filename ? filename :"*no-file*", 1);
+ input_location = linemap_line_start (line_table, 0, 252);
+
if (!lang_parse_file (filename))
errorcount++;
else
@@ -398,19 +394,7 @@ ortho_parse_file (int debug)
cgraph_finalize_compilation_unit ();
cgraph_optimize ();
}
-}
-
-static void
-ortho_expand_function (tree fndecl)
-{
- if (DECL_CONTEXT (fndecl) != NULL_TREE)
- {
- push_function_context ();
- tree_rest_of_compilation (fndecl);
- pop_function_context ();
- }
- else
- tree_rest_of_compilation (fndecl);
+ linemap_add (line_table, LC_LEAVE, 0, NULL, 1);
}
/* Called by the back-end or by the front-end when the address of EXP
@@ -610,6 +594,7 @@ builtin_function (const char *name,
make_decl_rtl (decl);
DECL_BUILT_IN_CLASS (decl) = class;
DECL_FUNCTION_CODE (decl) = function_code;
+ DECL_SOURCE_LOCATION (decl) = input_location;
return decl;
}
@@ -653,32 +638,6 @@ type_for_mode (enum machine_mode mode, int unsignedp)
return type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
}
-/* Return the unsigned version of a TYPE_NODE, a scalar type. */
-static tree
-unsigned_type (tree type)
-{
- return type_for_size (TYPE_PRECISION (type), 1);
-}
-
-/* Return the signed version of a TYPE_NODE, a scalar type. */
-static tree
-signed_type (tree type)
-{
- return type_for_size (TYPE_PRECISION (type), 0);
-}
-
-/* Return a type the same as TYPE except unsigned or signed according to
- UNSIGNEDP. */
-static tree
-signed_or_unsigned_type (int unsignedp, tree type)
-{
- if (!INTEGRAL_TYPE_P (type)
- || TYPE_UNSIGNED (type) == unsignedp)
- return type;
- else
- return type_for_size (TYPE_PRECISION (type), unsignedp);
-}
-
#undef LANG_HOOKS_NAME
#define LANG_HOOKS_NAME "vhdl"
#undef LANG_HOOKS_IDENTIFIER_SIZE
@@ -752,23 +711,24 @@ const char * const tree_code_name[] = {
union lang_tree_node
GTY((desc ("0"),
- chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
+ chain_next ("(union lang_tree_node *) GENERIC_NEXT (&%h.generic)")))
{
- union tree_node GTY ((tag ("0"),
- desc ("tree_node_structure (&%h)")))
- generic;
+ union tree_node GTY ((tag ("0"))) generic;
};
struct lang_decl GTY(())
{
+ char dummy;
};
struct lang_type GTY (())
{
+ char dummy;
};
struct language_function GTY (())
{
+ char dummy;
};
struct chain_constr_type
@@ -1004,8 +964,7 @@ new_alloca (tree rtype, tree size)
cur_binding_level->save_stack = 1;
args = tree_cons (NULL_TREE, fold_convert (size_type_node, size), NULL_TREE);
- res = build3 (CALL_EXPR, ptr_type_node, stack_alloc_function_ptr,
- args, NULL_TREE);
+ res = build_call_list (ptr_type_node, stack_alloc_function_ptr, args);
return fold_convert (rtype, res);
}
@@ -1074,9 +1033,9 @@ new_float_literal (tree ltype, double value)
else
hi = s >> (8 * sizeof (HOST_WIDE_INT));
- res = build_int_cst_wide (ltype, lo, hi);
+ res = build_int_cst_wide (long_integer_type_node, lo, hi);
REAL_VALUE_FROM_INT (r_sign, lo, hi, DFmode);
- real_2expN (&r_exp, ex - 60);
+ real_2expN (&r_exp, ex - 60, DFmode);
real_arithmetic (&r, MULT_EXPR, &r_sign, &r_exp);
res = build_real (ltype, r);
return res;
@@ -1496,14 +1455,14 @@ ortho_build_addr (tree lvalue, tree atype)
ortho_mark_addressable (base);
- offset = fold_build2 (MULT_EXPR, TREE_TYPE (idx), idx,
+ idx = fold_convert (sizetype, idx);
+ offset = fold_build2 (MULT_EXPR, sizetype, idx,
array_ref_element_size (lvalue));
base = array_to_pointer_conversion (base);
base_type = TREE_TYPE (base);
- res = build2 (PLUS_EXPR, base_type,
- base, convert (base_type, offset));
+ res = build2 (POINTER_PLUS_EXPR, base_type, base, offset);
}
else
{
@@ -1606,7 +1565,7 @@ new_value (tree lvalue)
void
new_debug_line_decl (int line)
{
- input_location.line = line;
+ input_location = linemap_line_start (line_table, line, 252);
}
void
@@ -1806,6 +1765,8 @@ finish_subprogram_decl (struct o_inter_list *interfaces, tree *res)
decl = build_decl (FUNCTION_DECL, interfaces->ident,
build_function_type (interfaces->rtype,
interfaces->param_list.first));
+ DECL_SOURCE_LOCATION (decl) = input_location;
+
is_global = current_function_decl == NULL_TREE
|| interfaces->storage == o_storage_external;
if (is_global)
@@ -1876,7 +1837,7 @@ finish_subprogram_body (void)
DECL_SAVED_TREE (func) = bind;
/* Initialize the RTL code for the function. */
- allocate_struct_function (func);
+ allocate_struct_function (func, false);
/* Store the end of the function. */
cfun->function_end_locus = input_location;
@@ -1898,14 +1859,14 @@ finish_subprogram_body (void)
cgraph_finalize_function (func, false);
current_function_decl = parent;
- cfun = NULL;
+ set_cfun (NULL);
}
void
new_debug_line_stmt (int line)
{
- input_location.line = line;
+ input_location = linemap_line_start (line_table, line, 252);
}
void
@@ -1948,10 +1909,9 @@ new_association (struct o_assoc_list *assocs, tree val)
tree
new_function_call (struct o_assoc_list *assocs)
{
- return build3 (CALL_EXPR,
- TREE_TYPE (TREE_TYPE (assocs->subprg)),
- build_function_ptr (assocs->subprg),
- assocs->list.first, NULL_TREE);
+ return build_call_list (TREE_TYPE (TREE_TYPE (assocs->subprg)),
+ build_function_ptr (assocs->subprg),
+ assocs->list.first);
}
void
@@ -1959,10 +1919,9 @@ new_procedure_call (struct o_assoc_list *assocs)
{
tree res;
- res = build3 (CALL_EXPR,
- TREE_TYPE (TREE_TYPE (assocs->subprg)),
- build_function_ptr (assocs->subprg),
- assocs->list.first, NULL_TREE);
+ res = build_call_list (TREE_TYPE (TREE_TYPE (assocs->subprg)),
+ build_function_ptr (assocs->subprg),
+ assocs->list.first);
TREE_SIDE_EFFECTS (res) = 1;
append_stmt (res);
}
@@ -1987,7 +1946,8 @@ new_func_return_stmt (tree value)
res = DECL_RESULT (current_function_decl);
assign = build2 (MODIFY_EXPR, TREE_TYPE (value), res, value);
TREE_SIDE_EFFECTS (assign) = 1;
- stmt = build1 (RETURN_EXPR, TREE_TYPE (value), assign);
+ stmt = build1 (RETURN_EXPR, void_type_node, assign);
+ TREE_SIDE_EFFECTS (stmt) = 1;
append_stmt (stmt);
}
diff --git a/ortho/gcc/ortho_ident.adb b/ortho/gcc/ortho_ident.adb
index c8acd58..1fac9ab 100644
--- a/ortho/gcc/ortho_ident.adb
+++ b/ortho/gcc/ortho_ident.adb
@@ -7,6 +7,7 @@ package body Ortho_Ident is
(Id : O_Ident; Str : Address; Size : Integer)
return Boolean;
pragma Import (C, Compare_Identifier_String);
+ pragma Warnings (Off, Compare_Identifier_String);
function Get_Identifier (Str : String) return O_Ident is
begin
diff --git a/ortho/mcode/binary_file.adb b/ortho/mcode/binary_file.adb
index 488aac8..1407424 100644
--- a/ortho/mcode/binary_file.adb
+++ b/ortho/mcode/binary_file.adb
@@ -16,12 +16,9 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System;
-with System.Storage_Elements;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters.Latin_1;
with Ada.Unchecked_Conversion;
-with Ada.Unchecked_Deallocation;
-with GNAT.Table;
with Hex_Images; use Hex_Images;
with Disassemble;
@@ -169,7 +166,7 @@ package body Binary_File is
Resize (Sect, New_Max);
end Sect_Prealloc;
- procedure Merge_Section (Dest : Section_Acc; Src : in out Section_Acc)
+ procedure Merge_Section (Dest : Section_Acc; Src : Section_Acc)
is
Rel : Reloc_Acc;
begin
@@ -309,7 +306,7 @@ package body Binary_File is
while Reloc /= null loop
if Reloc.Addr = Off then
declare
- Str : String := Get_Symbol_Name (Reloc.Sym);
+ Str : constant String := Get_Symbol_Name (Reloc.Sym);
begin
Line (Line'First .. Line'First + Str'Length - 1) := Str;
Line_Len := Line_Len + Str'Length;
@@ -671,9 +668,7 @@ package body Binary_File is
Cur_Sect.Pc := Cur_Sect.Pc + Pc_Type (Length);
end Gen_Space;
- procedure Set_Symbol_Pc (Sym : Symbol; Export : Boolean)
- is
- use Ada.Text_IO;
+ procedure Set_Symbol_Pc (Sym : Symbol; Export : Boolean) is
begin
case Get_Scope (Sym) is
when Sym_Local =>
@@ -953,9 +948,8 @@ package body Binary_File is
-- Tmp := Val + N - 1;
-- return Tmp - (Tmp mod N);
-- end Align_Pow;
- procedure Disp_Stats
- is
- use Ada.Text_IO;
+
+ procedure Disp_Stats is
begin
Put_Line ("Number of Symbols: " & Symbol'Image (Symbols.Last));
end Disp_Stats;
@@ -964,7 +958,6 @@ package body Binary_File is
is
Sect : Section_Acc;
Rel, N_Rel : Reloc_Acc;
- Old_Rel : Reloc_Acc;
begin
Symbols.Free;
Sect := Section_Chain;
@@ -973,7 +966,6 @@ package body Binary_File is
Rel := Sect.First_Reloc;
while Rel /= null loop
N_Rel := Rel.Sect_Next;
- Old_Rel := Rel;
Free (Rel);
Rel := N_Rel;
end loop;
diff --git a/ortho/mcode/binary_file.ads b/ortho/mcode/binary_file.ads
index 1433627..db31cb6 100644
--- a/ortho/mcode/binary_file.ads
+++ b/ortho/mcode/binary_file.ads
@@ -59,7 +59,7 @@ package Binary_File is
Align : Natural;
Esize : Natural);
- procedure Merge_Section (Dest : Section_Acc; Src : in out Section_Acc);
+ procedure Merge_Section (Dest : Section_Acc; Src : Section_Acc);
-- Set the current section.
procedure Set_Current_Section (Sect : Section_Acc);
diff --git a/ortho/mcode/disa_x86.adb b/ortho/mcode/disa_x86.adb
index 24c70cf..0653ce7 100644
--- a/ortho/mcode/disa_x86.adb
+++ b/ortho/mcode/disa_x86.adb
@@ -15,7 +15,6 @@
-- 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 Interfaces; use Interfaces;
with System.Address_To_Access_Conversions;
package body Disa_X86 is
diff --git a/ortho/mcode/ortho_code-decls.adb b/ortho/mcode/ortho_code-decls.adb
index 0a8b02c..741d2cc 100644
--- a/ortho/mcode/ortho_code-decls.adb
+++ b/ortho/mcode/ortho_code-decls.adb
@@ -231,7 +231,7 @@ package body Ortho_Code.Decls is
function Get_Subprg_Interfaces (Decl : O_Dnode) return O_Dnode
is
- Res : O_Dnode := Decl + 1;
+ Res : constant O_Dnode := Decl + 1;
begin
if Get_Decl_Kind (Res) = OD_Interface then
return Res;
@@ -242,7 +242,7 @@ package body Ortho_Code.Decls is
function Get_Interface_Chain (Decl : O_Dnode) return O_Dnode
is
- Res : O_Dnode := Decl + 1;
+ Res : constant O_Dnode := Decl + 1;
begin
if Get_Decl_Kind (Res) = OD_Interface then
return Res;
diff --git a/ortho/mcode/ortho_code-disps.adb b/ortho/mcode/ortho_code-disps.adb
index d017576..2f29414 100644
--- a/ortho/mcode/ortho_code-disps.adb
+++ b/ortho/mcode/ortho_code-disps.adb
@@ -432,9 +432,6 @@ package body Ortho_Code.Disps is
end loop;
Put ('}');
end;
- when others =>
- Put_Line (Standard_Error, "disps.disp_type: unknown type "
- & OT_Kind'Image (Kind));
end case;
end Disp_Type;
@@ -549,9 +546,6 @@ package body Ortho_Code.Disps is
Disp_Subprg (Indent, Get_Body_Stmt (Decl));
when OD_Block =>
null;
- when others =>
- Put_Line (Standard_Error, "debug.disp_decl: unknown decl "
- & OD_Kind'Image (Kind));
end case;
if Nl then
New_Line;
@@ -743,12 +737,10 @@ package body Ortho_Code.Disps is
is
Stmt : O_Enode;
N_Ident : Natural := Ident;
- Kind : OE_Kind;
begin
Stmt := S_Entry;
loop
Stmt := Get_Stmt_Link (Stmt);
- Kind := Get_Expr_Kind (Stmt);
Disp_Stmt (N_Ident, Stmt);
exit when Get_Expr_Kind (Stmt) = OE_Leave;
end loop;
diff --git a/ortho/mcode/ortho_code-dwarf.adb b/ortho/mcode/ortho_code-dwarf.adb
index 6f807d0..6816199 100644
--- a/ortho/mcode/ortho_code-dwarf.adb
+++ b/ortho/mcode/ortho_code-dwarf.adb
@@ -27,7 +27,6 @@ with Ortho_Code.Consts;
with Ortho_Code.Flags;
with Ortho_Ident;
with Ortho_Code.Binary;
-with Binary_File; use Binary_File;
package body Ortho_Code.Dwarf is
-- Dwarf debugging format.
@@ -336,11 +335,7 @@ package body Ortho_Code.Dwarf is
Gen_Ua_32 (Orig_Sym, 0);
Gen_Ua_32 (End_Sym, 0);
Gen_String_Nul ("T.Gingold ortho_mcode (2004)");
- declare
- Dir : String := GNAT.Directory_Operations.Get_Current_Dir;
- begin
- Gen_String_Nul (Dir);
- end;
+ Gen_String_Nul (GNAT.Directory_Operations.Get_Current_Dir);
end Init;
procedure Emit_Decl (Decl : O_Dnode);
diff --git a/ortho/mcode/ortho_code-exprs.adb b/ortho/mcode/ortho_code-exprs.adb
index 0724bcc..e47c75e 100644
--- a/ortho/mcode/ortho_code-exprs.adb
+++ b/ortho/mcode/ortho_code-exprs.adb
@@ -638,7 +638,7 @@ package body Ortho_Code.Exprs is
is
Res : O_Enode := O_Enode_Null;
Blk : O_Enode;
- Last_Blk : O_Enode := Get_Label_Block (Label);
+ Last_Blk : constant O_Enode := Get_Label_Block (Label);
begin
Blk := Cur_Block;
while Blk /= Last_Blk loop
@@ -1546,7 +1546,6 @@ package body Ortho_Code.Exprs is
procedure Disp_Enode (Indent : Natural; N : O_Enode)
is
use Ada.Text_IO;
- use Ortho_Code.Debug;
use Ortho_Code.Debug.Int32_IO;
begin
Set_Col (Count (Indent));
diff --git a/ortho/mcode/ortho_code-opts.adb b/ortho/mcode/ortho_code-opts.adb
index 83071b4..0ea6b03 100644
--- a/ortho/mcode/ortho_code-opts.adb
+++ b/ortho/mcode/ortho_code-opts.adb
@@ -157,7 +157,7 @@ package body Ortho_Code.Opts is
N_Stmt := Next;
P_Stmt := Stmt;
Label := Get_Jump_Label (Stmt);
- Flag_Discard := Kind = OE_Jump;
+ Flag_Discard := True;
loop
if N_Stmt = Label then
-- Remove STMT.
diff --git a/ortho/mcode/ortho_code-types.adb b/ortho/mcode/ortho_code-types.adb
index fda7a21..004b15c 100644
--- a/ortho/mcode/ortho_code-types.adb
+++ b/ortho/mcode/ortho_code-types.adb
@@ -18,7 +18,6 @@
with Ada.Text_IO;
with Ada.Unchecked_Conversion;
with GNAT.Table;
-with Ada.Text_IO;
with Ortho_Code.Consts; use Ortho_Code.Consts;
with Ortho_Code.Debug;
with Ortho_Code.Abi; use Ortho_Code.Abi;
diff --git a/ortho/mcode/ortho_code-x86-abi.adb b/ortho/mcode/ortho_code-x86-abi.adb
index 5456235..ff766b0 100644
--- a/ortho/mcode/ortho_code-x86-abi.adb
+++ b/ortho/mcode/ortho_code-x86-abi.adb
@@ -16,7 +16,6 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ortho_Code.Decls; use Ortho_Code.Decls;
-with Ortho_Code.Types; use Ortho_Code.Types;
with Ortho_Code.Exprs; use Ortho_Code.Exprs;
with Ortho_Code.Consts;
with Ortho_Code.Debug;
@@ -177,8 +176,8 @@ package body Ortho_Code.X86.Abi is
is
use Ada.Text_IO;
use Ortho_Code.Debug.Int32_IO;
- Obj : O_Dnode := Get_Addr_Object (Stmt);
- Frame : O_Enode := Get_Addrl_Frame (Stmt);
+ Obj : constant O_Dnode := Get_Addr_Object (Stmt);
+ Frame : constant O_Enode := Get_Addrl_Frame (Stmt);
begin
if Frame = O_Enode_Null then
Put ("fp");
@@ -550,13 +549,11 @@ package body Ortho_Code.X86.Abi is
is
use Ada.Text_IO;
- Last : O_Enode;
Stmt : O_Enode;
begin
Disp_Subprg_Decl (Get_Body_Decl (Subprg));
Stmt := Get_Body_Stmt (Subprg);
- Last := Get_Entry_Leave (Stmt);
loop
exit when Stmt = O_Enode_Null;
Disp_Stmt (Stmt);
diff --git a/ortho/mcode/ortho_code-x86-abi.ads b/ortho/mcode/ortho_code-x86-abi.ads
index 613e37b..eb3b5a1 100644
--- a/ortho/mcode/ortho_code-x86-abi.ads
+++ b/ortho/mcode/ortho_code-x86-abi.ads
@@ -15,7 +15,6 @@
-- 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 Ortho_Code.Exprs; use Ortho_Code.Exprs;
with Ortho_Code.Types; use Ortho_Code.Types;
package Ortho_Code.X86.Abi is
diff --git a/ortho/mcode/ortho_code-x86-emits.adb b/ortho/mcode/ortho_code-x86-emits.adb
index d64d096..059711a 100644
--- a/ortho/mcode/ortho_code-x86-emits.adb
+++ b/ortho/mcode/ortho_code-x86-emits.adb
@@ -28,7 +28,6 @@ with Ortho_Code.Binary; use Ortho_Code.Binary;
with Ortho_Ident;
with Ada.Text_IO;
with Interfaces; use Interfaces;
-with Binary_File; use Binary_File;
package body Ortho_Code.X86.Emits is
type Insn_Size is (Sz_8, Sz_16, Sz_32l, Sz_32h);
@@ -126,9 +125,7 @@ package body Ortho_Code.X86.Emits is
-- end case;
-- end Gen_Imm32;
- procedure Gen_Imm (N : O_Enode; Sz : Insn_Size)
- is
- use Interfaces;
+ procedure Gen_Imm (N : O_Enode; Sz : Insn_Size) is
begin
case Get_Expr_Kind (N) is
when OE_Const =>
@@ -811,7 +808,7 @@ package body Ortho_Code.X86.Emits is
-- addl esp, val
Gen_B8 (2#100000_01#);
Gen_B8 (2#11_000_100#);
- Gen_Le32 (Unsigned_32 (Val));
+ Gen_Le32 (Val);
end if;
End_Insn;
end if;
@@ -1199,11 +1196,9 @@ package body Ortho_Code.X86.Emits is
procedure Gen_Conv_U8 (Stmt : O_Enode)
is
Op : O_Enode;
- Reg_Op : O_Reg;
Reg_Res : O_Reg;
begin
Op := Get_Expr_Operand (Stmt);
- Reg_Op := Get_Expr_Reg (Op);
Reg_Res := Get_Expr_Reg (Stmt);
case Get_Expr_Mode (Stmt) is
when Mode_U32
@@ -1223,11 +1218,9 @@ package body Ortho_Code.X86.Emits is
procedure Gen_Conv_B2 (Stmt : O_Enode)
is
Op : O_Enode;
- Reg_Op : O_Reg;
Reg_Res : O_Reg;
begin
Op := Get_Expr_Operand (Stmt);
- Reg_Op := Get_Expr_Reg (Op);
Reg_Res := Get_Expr_Reg (Stmt);
case Get_Expr_Mode (Stmt) is
when Mode_U32
@@ -1244,12 +1237,8 @@ package body Ortho_Code.X86.Emits is
procedure Gen_Conv_I64 (Stmt : O_Enode)
is
Op : O_Enode;
- Reg_Op : O_Reg;
- Reg_Res : O_Reg;
begin
Op := Get_Expr_Operand (Stmt);
- Reg_Op := Get_Expr_Reg (Op);
- Reg_Res := Get_Expr_Reg (Stmt);
case Get_Expr_Mode (Stmt) is
when Mode_I32 =>
-- move dx to reg_helper
@@ -1285,11 +1274,8 @@ package body Ortho_Code.X86.Emits is
end Gen_Conv_I64;
-- Convert FP to xxx.
- procedure Gen_Conv_Fp (Stmt : O_Enode)
- is
- Op : O_Enode;
+ procedure Gen_Conv_Fp (Stmt : O_Enode) is
begin
- Op := Get_Expr_Operand (Stmt);
case Get_Expr_Mode (Stmt) is
when Mode_I32 =>
-- subl %esp, 4
@@ -1842,9 +1828,11 @@ package body Ortho_Code.X86.Emits is
Error_Emit ("emit_insn: oe_arg", Stmt);
end case;
when OE_Setup_Frame =>
+ pragma Warnings (Off);
if Flags.Stack_Boundary > 4 then
Emit_Setup_Frame (Stmt);
end if;
+ pragma Warnings (On);
when OE_Call =>
Emit_Call (Stmt);
when OE_Intrinsic =>
@@ -1985,8 +1973,6 @@ package body Ortho_Code.X86.Emits is
procedure Emit_Prologue (Subprg : Subprogram_Data_Acc)
is
use Ortho_Code.Decls;
- use Binary_File;
- use Interfaces;
use Ortho_Code.Flags;
use Ortho_Code.X86.Insns;
Sym : Symbol;
@@ -2070,7 +2056,6 @@ package body Ortho_Code.X86.Emits is
procedure Emit_Epilogue (Subprg : Subprogram_Data_Acc)
is
- use Binary_File;
use Ortho_Code.Decls;
use Ortho_Code.Types;
use Ortho_Code.Flags;
diff --git a/ortho/mcode/ortho_code-x86-insns.adb b/ortho/mcode/ortho_code-x86-insns.adb
index bfd1635..819e670 100644
--- a/ortho/mcode/ortho_code-x86-insns.adb
+++ b/ortho/mcode/ortho_code-x86-insns.adb
@@ -72,8 +72,6 @@ package body Ortho_Code.X86.Insns is
-- Swap Stack_Offset with Max_Stack of STMT.
procedure Swap_Stack_Offset (Blk : O_Dnode)
is
- use Ortho_Code.Decls;
-
Prev_Offset : Uns32;
begin
Prev_Offset := Get_Block_Max_Stack (Blk);
@@ -227,16 +225,16 @@ package body Ortho_Code.X86.Insns is
return N;
end Insert_Move;
- function Insert_Spill (Expr : O_Enode) return O_Enode
- is
- N : O_Enode;
- begin
- N := New_Enode (OE_Spill, Get_Expr_Mode (Expr), O_Tnode_Null,
- Expr, O_Enode_Null);
- Set_Expr_Reg (N, R_Spill);
- Link_Stmt (N);
- return N;
- end Insert_Spill;
+-- function Insert_Spill (Expr : O_Enode) return O_Enode
+-- is
+-- N : O_Enode;
+-- begin
+-- N := New_Enode (OE_Spill, Get_Expr_Mode (Expr), O_Tnode_Null,
+-- Expr, O_Enode_Null);
+-- Set_Expr_Reg (N, R_Spill);
+-- Link_Stmt (N);
+-- return N;
+-- end Insert_Spill;
procedure Error_Gen_Insn (Stmt : O_Enode; Reg : O_Reg)
is
@@ -290,9 +288,9 @@ package body Ortho_Code.X86.Insns is
Used : Boolean;
end record;
- Init_Reg_Info : Reg_Info_Type := (Num => O_Free,
- Stmt => O_Enode_Null,
- Used => False);
+ Init_Reg_Info : constant Reg_Info_Type := (Num => O_Free,
+ Stmt => O_Enode_Null,
+ Used => False);
type Reg32_Info_Array is array (Regs_R32) of Reg_Info_Type;
Regs : Reg32_Info_Array := (others => Init_Reg_Info);
Reg_Cc : Reg_Info_Type := Init_Reg_Info;
@@ -349,6 +347,8 @@ package body Ortho_Code.X86.Insns is
end loop;
end Dump_Regs;
+ pragma Unreferenced (Dump_Regs);
+
procedure Error_Reg (Msg : String; Stmt : O_Enode; Reg : O_Reg)
is
use Ada.Text_IO;
@@ -1881,7 +1881,6 @@ package body Ortho_Code.X86.Insns is
procedure Gen_Subprg_Insns (Subprg : Subprogram_Data_Acc)
is
First : O_Enode;
- Last : O_Enode;
Stmt : O_Enode;
N_Stmt : O_Enode;
begin
@@ -1906,7 +1905,6 @@ package body Ortho_Code.X86.Insns is
Stack_Offset := 0;
First := Subprg.E_Entry;
Expand_Decls (Subprg.D_Body + 1);
- Last := Get_Entry_Leave (First);
Abi.Last_Link := First;
-- Generate instructions.
diff --git a/ortho/mcode/ortho_ident.adb b/ortho/mcode/ortho_ident.adb
index 59c1276..034aeae 100644
--- a/ortho/mcode/ortho_ident.adb
+++ b/ortho/mcode/ortho_ident.adb
@@ -66,7 +66,7 @@ package body Ortho_Ident is
function Get_String (Id : O_Ident) return String
is
Res : String (1 .. Get_String_Length (Id));
- Start : Natural := Ids.Table (Id);
+ Start : constant Natural := Ids.Table (Id);
begin
for I in Res'Range loop
Res (I) := Strs.Table (Start + I - 1);
@@ -76,8 +76,8 @@ package body Ortho_Ident is
function Is_Equal (Id : O_Ident; Str : String) return Boolean
is
- Start : Natural := Ids.Table (Id);
- Len : Natural := Get_String_Length (Id);
+ Start : constant Natural := Ids.Table (Id);
+ Len : constant Natural := Get_String_Length (Id);
begin
if Len /= Str'Length then
return False;
diff --git a/ortho/mcode/ortho_mcode.adb b/ortho/mcode/ortho_mcode.adb
index bc4dc32..e774483 100644
--- a/ortho/mcode/ortho_mcode.adb
+++ b/ortho/mcode/ortho_mcode.adb
@@ -15,7 +15,6 @@
-- 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 Ortho_Code.Abi;
with Ada.Text_IO;
with Ortho_Code.Debug;
with Ortho_Code.Sysdeps;
@@ -61,7 +60,9 @@ package body Ortho_Mcode is
null;
end Start_Const_Value;
- procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode) is
+ procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode)
+ is
+ pragma Warnings (Off, Const);
begin
New_Const_Value (Const, Val);
end Finish_Const_Value;
generated by cgit (git 2.34.1) at 2024-12-21 06:55:00 +0000