diff options
Diffstat (limited to 'translate')
| -rwxr-xr-x | translate/gcc/dist.sh | 1 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdldrv.adb | 1 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 10 | ||||
| -rw-r--r-- | translate/grt/Makefile.inc | 7 | ||||
| -rw-r--r-- | translate/grt/config/amd64.S | 116 | ||||
| -rw-r--r-- | translate/translation.adb | 336 |
6 files changed, 348 insertions, 123 deletions
diff --git a/translate/gcc/dist.sh b/translate/gcc/dist.sh index 59effd48e..e16475aad 100755 --- a/translate/gcc/dist.sh +++ b/translate/gcc/dist.sh @@ -366,6 +366,7 @@ i386.S sparc.S ppc.S ia64.S +amd64.S times.c clock.c linux.c diff --git a/translate/ghdldrv/ghdldrv.adb b/translate/ghdldrv/ghdldrv.adb index 6612fb3fe..5b9b8adbb 100644 --- a/translate/ghdldrv/ghdldrv.adb +++ b/translate/ghdldrv/ghdldrv.adb @@ -1223,6 +1223,7 @@ package body Ghdldrv is if Elab_Index < 0 then Analyze_Files (Args, True); else + Flags.Flag_Whole_Analyze := True; Set_Elab_Units ("-c", Args (Elab_Index + 1 .. Args'Last)); Setup_Compiler (False); diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index df64ebc66..55be418fe 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -84,6 +84,9 @@ package body Ghdlrun is -- Initialize. Back_End.Finish_Compilation := Trans_Be.Finish_Compilation'Access; + -- The design is always analyzed in whole. + Flags.Flag_Whole_Analyze := True; + Setup_Libraries (False); Libraries.Load_Std_Library; @@ -458,8 +461,11 @@ package body Ghdlrun is Std_Standard_Bit_RTI_Ptr := Get_Address (Trans_Decls.Std_Standard_Bit_Rti); if Ieee.Std_Logic_1164.Resolved /= Null_Iir then - Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := Get_Address - (Translation.Get_Resolv_Ortho_Decl (Ieee.Std_Logic_1164.Resolved)); + Decl := Translation.Get_Resolv_Ortho_Decl + (Ieee.Std_Logic_1164.Resolved); + if Decl /= O_Dnode_Null then + Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := Get_Address (Decl); + end if; end if; Def (Trans_Decls.Ghdl_Protected_Enter, diff --git a/translate/grt/Makefile.inc b/translate/grt/Makefile.inc index 249e84b8a..4e4388ace 100644 --- a/translate/grt/Makefile.inc +++ b/translate/grt/Makefile.inc @@ -45,6 +45,10 @@ ifeq ($(filter-out i%86 linux,$(arch) $(osys)),) GRT_TARGET_OBJS=i386.o linux.o times.o GRT_EXTRA_LIB=-ldl endif +ifeq ($(filter-out x86_64 linux,$(arch) $(osys)),) + GRT_TARGET_OBJS=amd64.o linux.o times.o + GRT_EXTRA_LIB=-ldl +endif ifeq ($(filter-out sparc solaris%,$(arch) $(osys)),) GRT_TARGET_OBJS=sparc.o linux.o times.o GRT_EXTRA_LIB=-ldl @@ -109,6 +113,9 @@ ppc.o: $(GRTSRCDIR)/config/ppc.S ia64.o: $(GRTSRCDIR)/config/ia64.S $(CC) -c $(GRT_FLAGS) -o $@ $< +amd64.o: $(GRTSRCDIR)/config/amd64.S + $(CC) -c $(GRT_FLAGS) -o $@ $< + linux.o: $(GRTSRCDIR)/config/linux.c $(CC) -c $(GRT_FLAGS) -o $@ $< diff --git a/translate/grt/config/amd64.S b/translate/grt/config/amd64.S new file mode 100644 index 000000000..76475acdb --- /dev/null +++ b/translate/grt/config/amd64.S @@ -0,0 +1,116 @@ +/* GRT stack implementation for amd64 (x86_64) + Copyright (C) 2005 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. +*/ + .file "amd64.S" + .version "01.01" + + .text + + /* Function called to loop on the process. */ + .align 4 + .type grt_stack_loop,@function +grt_stack_loop: + mov 0(%rsp),%rdi + call *8(%rsp) + jmp grt_stack_loop + .size grt_stack_loop, . - grt_stack_loop + + /* function Stack_Create (Func : Address; Arg : Address) + return Stack_Type; + Args: FUNC (RDI), ARG (RSI) + */ + .align 4 + .globl grt_stack_create + .type grt_stack_create,@function +grt_stack_create: + /* Standard prologue. */ + pushq %rbp + movq %rsp,%rbp + /* Save args. */ + sub $0x10,%rsp + mov %rdi,-8(%rbp) + mov %rsi,-16(%rbp) + + /* Allocate the stack, and exit in case of failure */ + callq grt_stack_allocate + test %rax,%rax + je .Ldone + + /* Note: %RAX contains the address of the stack_context. This is + also the top of the stack. */ + + /* Prepare stack. */ + /* The function to be executed. */ + mov -8(%rbp), %rdi + mov %rdi, -8(%rax) + /* The argument. */ + mov -16(%rbp), %rsi + mov %rsi, -16(%rax) + /* The return function. Must be 8 mod 16. */ + movq $grt_stack_loop, -24(%rax) + /* The context. */ + mov %rbp, -32(%rax) + mov %rbx, -40(%rax) + mov %r12, -48(%rax) + mov %r13, -56(%rax) + mov %r14, -64(%rax) + mov %r15, -72(%rax) + + /* Save the new stack pointer to the stack context. */ + lea -72(%rax), %rsi + mov %rsi, (%rax) + +.Ldone: + leave + ret + .size grt_stack_create,. - grt_stack_create + + + + .align 4 + .globl grt_stack_switch + /* Arguments: TO (RDI), FROM (RSI) [VAL (RDX)] + Both are pointers to a stack_context. */ + .type grt_stack_switch,@function +grt_stack_switch: + /* Save call-used registers. */ + pushq %rbp + pushq %rbx + pushq %r12 + pushq %r13 + pushq %r14 + pushq %r15 + /* Save the current stack. */ + movq %rsp, (%rsi) + /* Stack switch. */ + movq (%rdi), %rsp + /* Restore call-used registers. */ + popq %r15 + popq %r14 + popq %r13 + popq %r12 + popq %rbx + popq %rbp + /* Return val. */ + movq %rdx, %rax + /* Run. */ + ret + .size grt_stack_switch, . - grt_stack_switch + + + .ident "Written by T.Gingold" diff --git a/translate/translation.adb b/translate/translation.adb index 7881530c5..a55314a4a 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -1377,8 +1377,15 @@ package body Translation is function Get_Resolv_Ortho_Decl (Func : Iir) return O_Dnode is + Info : Subprg_Resolv_Info_Acc; begin - return Get_Info (Func).Subprg_Resolv.Resolv_Func; + Info := Get_Info (Func).Subprg_Resolv; + if Info = null then + -- Maybe the resolver is not used. + return O_Dnode_Null; + else + return Info.Resolv_Func; + end if; end Get_Resolv_Ortho_Decl; -- Return true is INFO is a type info for a composite type, ie: @@ -1987,8 +1994,10 @@ package body Translation is -- Get the offset in the range pointed by RANGE_PTR of INDEX. -- This checks INDEX belongs to the range. + -- INDEX_TYPE is the subtype of the array index. function Translate_Index_To_Offset (Range_Ptr : O_Dnode; Index : O_Enode; + Index_Expr : Iir; Index_Type : Iir; Loc : Iir) return O_Enode; @@ -2249,6 +2258,9 @@ package body Translation is -- Close the temporary region. procedure Close_Temp; + -- Check there is no temporary region. + procedure Check_No_Temp; + -- Free all old temp. -- Used only to free memory. procedure Free_Old_Temp; @@ -3099,6 +3111,9 @@ package body Translation is -- never deallocated. Old_Level : Temp_Level_Acc := null; + -- If set, emit comments for open_temp/close_temp. + Flag_Debug_Temp : constant Boolean := False; + procedure Open_Temp is L : Temp_Level_Acc; @@ -3119,6 +3134,10 @@ package body Translation is L.Level := Temp_Level.Level + 1; end if; Temp_Level := L; + if Flag_Debug_Temp then + New_Debug_Comment_Stmt + ("Open_Temp level " & Natural'Image (L.Level)); + end if; end Open_Temp; procedure Add_Transient_Type_In_Temp (Atype : Iir) @@ -3139,6 +3158,11 @@ package body Translation is -- OPEN_TEMP was not called. raise Internal_Error; end if; + if Flag_Debug_Temp then + New_Debug_Comment_Stmt + ("Close_Temp level " & Natural'Image (Temp_Level.Level)); + end if; + if Temp_Level.Stack2_Mark /= O_Dnode_Null then Start_Association (Constr, Ghdl_Stack2_Release); New_Association (Constr, @@ -3171,6 +3195,13 @@ package body Translation is Old_Level := L; end Close_Temp; + procedure Check_No_Temp is + begin + if Temp_Level /= null then + raise Internal_Error; + end if; + end Check_No_Temp; + procedure Free_Old_Temp is procedure Free is new Ada.Unchecked_Deallocation @@ -4258,8 +4289,7 @@ package body Translation is Chap7.Translate_Expression (Get_Nth_Element (Get_Index_List (Spec), 0), Iter_Type), - Iter_Type, - Spec), + Scheme, Iter_Type, Spec), True); Close_Temp; end; @@ -4289,8 +4319,7 @@ package body Translation is (Range_Ptr, New_Value (New_Selected_Element (New_Obj (Slice), Type_Info.T.Range_Left)), - Iter_Type, - Spec)); + Spec, Iter_Type, Spec)); Right := Create_Temp_Init (Ghdl_Index_Type, Chap6.Translate_Index_To_Offset @@ -4298,8 +4327,7 @@ package body Translation is New_Value (New_Selected_Element (New_Obj (Slice), Type_Info.T.Range_Right)), - Iter_Type, - Spec)); + Spec, Iter_Type, Spec)); Index := Create_Temp (Ghdl_Index_Type); High := Create_Temp (Ghdl_Index_Type); Start_If_Stmt @@ -4786,6 +4814,8 @@ package body Translation is Chap4.Elab_Declaration_Chain (Subprg, Final); + pragma Debug (Check_No_Temp); + -- If finalization is required, create a dummy loop around the -- body and convert returns into exit out of this loop. -- If the subprogram is a function, also create a variable for the @@ -4838,6 +4868,8 @@ package body Translation is Finish_Subprogram_Body; + pragma Debug (Check_No_Temp); + Pop_Identifier_Prefix (Mark); end Translate_Subprogram_Body; @@ -5318,7 +5350,7 @@ package body Translation is Info.C := new Complex_Type_Info; Info.C.Size_Var (Mode_Value) := Create_Var (Create_Var_Identifier ("SIZE"), Ghdl_Index_Type); - if Get_Signal_Type_Flag (Def) then + if Get_Has_Signal_Flag (Def) then Info.C.Size_Var (Mode_Signal) := Create_Var (Create_Var_Identifier ("SIGSIZE"), Ghdl_Index_Type); end if; @@ -5790,7 +5822,7 @@ package body Translation is ------------- function Type_To_Last_Object_Kind (Def : Iir) return Object_Kind_Type is begin - if Get_Signal_Type_Flag (Def) then + if Get_Has_Signal_Flag (Def) then return Mode_Signal; else return Mode_Value; @@ -6015,7 +6047,7 @@ package body Translation is if not Completion then Create_Array_Fat_Pointer (Info, Mode_Value); end if; - if Get_Signal_Type_Flag (Def) then + if Get_Has_Signal_Flag (Def) then Create_Array_Fat_Pointer (Info, Mode_Signal); end if; Finish_Type_Definition (Info, Completion); @@ -6083,6 +6115,7 @@ package body Translation is else -- Length is known. Create a constrained array. Info.Type_Mode := Type_Mode_Array; + Info.Ortho_Type (Mode_Signal) := O_Tnode_Null; for I in Mode_Value .. Type_To_Last_Object_Kind (Def) loop case I is when Mode_Value => @@ -6342,6 +6375,7 @@ package body Translation is El := Get_Chain (El); end loop; + Info.Ortho_Type (Mode_Signal) := O_Tnode_Null; for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop Start_Record_Type (El_List); El := Get_Element_Declaration_Chain (Def); @@ -6355,9 +6389,6 @@ package body Translation is end loop; Finish_Record_Type (El_List, Info.Ortho_Type (Kind)); end loop; - if Get_Signal_Type_Flag (Def) = False then - Info.Ortho_Type (Mode_Signal) := O_Tnode_Null; - end if; Info.Type_Mode := Type_Mode_Record; Finish_Type_Definition (Info); @@ -6717,7 +6748,6 @@ package body Translation is Chap2.Finish_Subprg_Instance_Use (Info.T.Prot_Final_Instance); Finish_Subprogram_Body; - end Translate_Protected_Type_Body_Subprograms; --------------- @@ -7355,7 +7385,7 @@ package body Translation is -- Declare subprograms. Id := Get_Identifier (Decl); Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Value); - if Get_Signal_Type_Flag (Def) then + if Get_Has_Signal_Flag (Def) then Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Signal); end if; @@ -7367,12 +7397,12 @@ package body Translation is case Get_Kind (Def) is when Iir_Kind_Array_Type_Definition => Create_Array_Type_Builder (Def, Mode_Value); - if Get_Signal_Type_Flag (Def) then + if Get_Has_Signal_Flag (Def) then Create_Array_Type_Builder (Def, Mode_Signal); end if; when Iir_Kind_Record_Type_Definition => Create_Record_Type_Builder (Def, Mode_Value); - if Get_Signal_Type_Flag (Def) then + if Get_Has_Signal_Flag (Def) then Create_Record_Type_Builder (Def, Mode_Signal); end if; when others => @@ -8758,12 +8788,9 @@ package body Translation is -- FIXME: to be improved ? -- Only required for transient types. - -- FIXME: check this (why open/close_temp ?) - Open_Temp; Define_Global_Const (Info.Object_Var, Chap7.Translate_Static_Expression (Val, Def)); - Close_Temp; end if; when others => Error_Kind ("create_objet", El); @@ -10170,40 +10197,6 @@ package body Translation is end case; end Translate_Declaration; - -- Mark FUNC (by adding the subprg_resolv info) iif it can be a - -- resolution function. - procedure Check_Resolution_Function (Func : Iir) - is - Param : Iir; - Param_Type : Iir; - Res_Type : Iir; - Info : Subprg_Info_Acc; - begin - Param := Get_Interface_Declaration_Chain (Func); - - -- Return now if the number of parameters is not 1. - if Param = Null_Iir or else Get_Chain (Param) /= Null_Iir then - return; - end if; - Param_Type := Get_Type (Param); - case Get_Kind (Param_Type) is - when Iir_Kind_Array_Type_Definition - | Iir_Kind_Unconstrained_Array_Subtype_Definition => - null; - when others => - return; - end case; - Res_Type := Get_Return_Type (Func); - if Get_Base_Type (Get_Element_Subtype (Param_Type)) - /= Get_Base_Type (Res_Type) - then - return; - end if; - -- FUNC can be a resolution function. - Info := Get_Info (Func); - Info.Subprg_Resolv := new Subprg_Resolv_Info; - end Check_Resolution_Function; - procedure Translate_Resolution_Function (Func : Iir; Block : Iir) is -- Type of the resolution function parameter. @@ -10592,8 +10585,10 @@ package body Translation is else Info := Add_Info (El, Kind_Subprg); Chap2.Translate_Subprogram_Interfaces (El); - if Get_Kind (El) = Iir_Kind_Function_Declaration then - Check_Resolution_Function (El); + if Get_Kind (El) = Iir_Kind_Function_Declaration + and then Get_Resolution_Function_Flag (El) + then + Info.Subprg_Resolv := new Subprg_Resolv_Info; end if; end if; when Iir_Kind_Function_Body @@ -12044,8 +12039,34 @@ package body Translation is Finish_If_Stmt (If_Blk); end Check_Bound_Error; + -- Return TRUE if an array whose index type is RNG_TYPE indexed by + -- an expression of type EXPR_TYPE needs a bound check. + function Need_Index_Check (Expr_Type : Iir; Rng_Type : Iir) + return Boolean + is + Rng : Iir; + begin + -- No check if the expression has the type of the index. + if Expr_Type = Rng_Type then + return False; + end if; + + -- No check for 'Range or 'Reverse_Range. + Rng := Get_Range_Constraint (Expr_Type); + if (Get_Kind (Rng) = Iir_Kind_Range_Array_Attribute + or Get_Kind (Rng) = Iir_Kind_Reverse_Range_Array_Attribute) + and then Get_Type (Rng) = Rng_Type + then + return False; + end if; + + return True; + end Need_Index_Check; + + function Translate_Index_To_Offset (Range_Ptr : O_Dnode; Index : O_Enode; + Index_Expr : Iir; Index_Type : Iir; Loc : Iir) return O_Enode @@ -12059,7 +12080,7 @@ package body Translation is Bound_Node : O_Dnode; Index_Info : Type_Info_Acc; begin - Index_Info := Get_Info (Index_Type); + Index_Info := Get_Info (Get_Base_Type (Index_Type)); Res := Create_Temp (Ghdl_Index_Type); @@ -12098,20 +12119,22 @@ package body Translation is Ghdl_Index_Type)); -- Check bounds. - Cond1 := New_Compare_Op - (ON_Lt, - New_Obj_Value (Off), - New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value), - 0)), - Ghdl_Bool_Type); - - Cond2 := New_Compare_Op - (ON_Ge, - New_Obj_Value (Res), - New_Value_Selected_Acc_Value (New_Obj (Range_Ptr), - Index_Info.T.Range_Length), - Ghdl_Bool_Type); - Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0); + if Need_Index_Check (Get_Type (Index_Expr), Index_Type) then + Cond1 := New_Compare_Op + (ON_Lt, + New_Obj_Value (Off), + New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value), + 0)), + Ghdl_Bool_Type); + + Cond2 := New_Compare_Op + (ON_Ge, + New_Obj_Value (Res), + New_Value_Selected_Acc_Value (New_Obj (Range_Ptr), + Index_Info.T.Range_Length), + Ghdl_Bool_Type); + Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0); + end if; Close_Temp; @@ -12250,8 +12273,7 @@ package body Translation is R := Translate_Index_To_Offset (M2Dp (Range_Ptr), Chap7.Translate_Expression (Index, Ibasetype), - Ibasetype, - Index); + Index, Itype, Index); when Type_Mode_Array => -- BASE is a thin array. R := Translate_Thin_Index_Offset (Itype, Dim, Index); @@ -12340,11 +12362,11 @@ package body Translation is Index_Type := Get_Nth_Element (Get_Index_Subtype_List (Prefix_Type), 0); + Kind := Get_Object_Kind (Prefix); + -- Evaluate slice bounds. Chap3.Create_Array_Subtype (Slice_Type, True); - Kind := Get_Object_Kind (Prefix); - Prefix_Info := Get_Info (Prefix_Type); Slice_Info := Get_Info (Slice_Type); @@ -12545,7 +12567,6 @@ package body Translation is end case; --Finish_If_Stmt (If_Blk); - end Translate_Slice_Name; function Translate_Interface_Name @@ -13403,7 +13424,8 @@ package body Translation is Formal_Base := Get_Base_Name (Formal); case Get_Kind (Formal_Base) is - when Iir_Kind_Constant_Interface_Declaration => + when Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_File_Interface_Declaration => return Translate_Expression (Actual, Get_Type (Formal_Base)); when Iir_Kind_Signal_Interface_Declaration => return Translate_Implicit_Conv @@ -15757,34 +15779,93 @@ package body Translation is end case; end Translate_Expression; --- procedure Translate_Range_Expression --- (Res : O_Lnode; Expr : Iir; Range_Type : Iir) --- is --- T_Info : Type_Info_Acc; --- begin --- T_Info := Get_Info (Range_Type); --- Open_Temp; --- New_Assign_Stmt --- (New_Selected_Element (Res, T_Info.T.Range_Left), --- Chap7.Translate_Range_Expression_Left (Expr, Range_Type)); --- New_Assign_Stmt --- (New_Selected_Element (Res, T_Info.T.Range_Right), --- Chap7.Translate_Range_Expression_Right (Expr, Range_Type)); --- New_Assign_Stmt (New_Selected_Element (Res, T_Info.T.Range_Dir), --- Chap7.Translate_Static_Range_Dir (Expr)); --- if T_Info.T.Range_Length /= O_Fnode_Null then --- Open_Temp; --- New_Assign_Stmt (New_Selected_Element (Res, T_Info.T.Range_Length), --- Chap7.Translate_Range_Expression_Length (Expr)); --- Close_Temp; --- end if; --- Close_Temp; --- end Translate_Range_Expression; + -- Check if RNG is of the form: + -- 1 to T'length + -- or T'Length downto 1 + -- or 0 to T'length - 1 + -- or T'Length - 1 downto 0 + -- In either of these cases, return T'Length + function Is_Length_Range_Expression (Rng : Iir_Range_Expression) + return Iir + is + -- Pattern of a bound. + type Length_Pattern is + ( + Pat_Unknown, + Pat_Length, + Pat_Length_1, -- Length - 1 + Pat_1, + Pat_0 + ); + Length_Attr : Iir := Null_Iir; + + -- Classify the bound. + -- Set LENGTH_ATTR is the pattern is Pat_Length. + function Get_Length_Pattern (Expr : Iir; Recurse : Boolean) + return Length_Pattern + is + begin + case Get_Kind (Expr) is + when Iir_Kind_Length_Array_Attribute => + Length_Attr := Expr; + return Pat_Length; + when Iir_Kind_Integer_Literal => + case Get_Value (Expr) is + when 0 => + return Pat_0; + when 1 => + return Pat_1; + when others => + return Pat_Unknown; + end case; + when Iir_Kind_Substraction_Operator => + if not Recurse then + return Pat_Unknown; + end if; + if Get_Length_Pattern (Get_Left (Expr), False) = Pat_Length + and then + Get_Length_Pattern (Get_Right (Expr), False) = Pat_1 + then + return Pat_Length_1; + else + return Pat_Unknown; + end if; + when others => + return Pat_Unknown; + end case; + end Get_Length_Pattern; + Left_Pat, Right_Pat : Length_Pattern; + begin + Left_Pat := Get_Length_Pattern (Get_Left_Limit (Rng), True); + if Left_Pat = Pat_Unknown then + return Null_Iir; + end if; + Right_Pat := Get_Length_Pattern (Get_Right_Limit (Rng), True); + if Right_Pat = Pat_Unknown then + return Null_Iir; + end if; + case Get_Direction (Rng) is + when Iir_To => + if (Left_Pat = Pat_1 and Right_Pat = Pat_Length) + or else (Left_Pat = Pat_0 and Right_Pat = Pat_Length_1) + then + return Length_Attr; + end if; + when Iir_Downto => + if (Left_Pat = Pat_Length and Right_Pat = Pat_1) + or else (Left_Pat = Pat_Length_1 and Right_Pat = Pat_0) + then + return Length_Attr; + end if; + end case; + return Null_Iir; + end Is_Length_Range_Expression; procedure Translate_Range_Expression_Ptr (Res_Ptr : O_Dnode; Expr : Iir; Range_Type : Iir) is T_Info : Type_Info_Acc; + Length_Attr : Iir; begin T_Info := Get_Info (Range_Type); Open_Temp; @@ -15804,17 +15885,26 @@ package body Translation is T_Info.T.Range_Length), New_Lit (Translate_Static_Range_Length (Expr))); else - Open_Temp; - New_Assign_Stmt - (New_Selected_Acc_Value (New_Obj (Res_Ptr), - T_Info.T.Range_Length), - Compute_Range_Length - (New_Value_Selected_Acc_Value (New_Obj (Res_Ptr), - T_Info.T.Range_Left), - New_Value_Selected_Acc_Value (New_Obj (Res_Ptr), - T_Info.T.Range_Right), - Get_Direction (Expr))); - Close_Temp; + Length_Attr := Is_Length_Range_Expression (Expr); + if Length_Attr = Null_Iir then + Open_Temp; + New_Assign_Stmt + (New_Selected_Acc_Value (New_Obj (Res_Ptr), + T_Info.T.Range_Length), + Compute_Range_Length + (New_Value_Selected_Acc_Value (New_Obj (Res_Ptr), + T_Info.T.Range_Left), + New_Value_Selected_Acc_Value (New_Obj (Res_Ptr), + T_Info.T.Range_Right), + Get_Direction (Expr))); + Close_Temp; + else + New_Assign_Stmt + (New_Selected_Acc_Value (New_Obj (Res_Ptr), + T_Info.T.Range_Length), + Chap14.Translate_Length_Array_Attribute + (Length_Attr, Null_Iir)); + end if; end if; end if; Close_Temp; @@ -24406,20 +24496,24 @@ package body Translation is New_Record_Aggr_El (Aggr, New_Rti_Address (Base_Info.Type_Rti)); New_Record_Aggr_El (Aggr, Var_Acc_To_Loc (Bounds)); for I in Mode_Value .. Mode_Signal loop - if I = Mode_Signal and then not Get_Signal_Type_Flag (Atype) then - Val := Get_Null_Loc; - else - case Info.Type_Mode is - when Type_Mode_Array => + case Info.Type_Mode is + when Type_Mode_Array => + if Info.Ortho_Type (I) /= O_Tnode_Null then Val := New_Union_Aggr (Ghdl_Rti_Loc, Ghdl_Rti_Loc_Offset, New_Sizeof (Info.Ortho_Type (I), Ghdl_Index_Type)); - when Type_Mode_Ptr_Array => + else + Val := Get_Null_Loc; + end if; + when Type_Mode_Ptr_Array => + if Info.C.Size_Var (I) /= null then Val := Var_Acc_To_Loc (Info.C.Size_Var (I)); - when others => - Error_Kind ("generate_array_subtype_definition", Atype); - end case; - end if; + else + Val := Get_Null_Loc; + end if; + when others => + Error_Kind ("generate_array_subtype_definition", Atype); + end case; New_Record_Aggr_El (Aggr, Val); end loop; |