diff options
| -rw-r--r-- | evaluation.adb | 57 | ||||
| -rw-r--r-- | parse.adb | 6 | ||||
| -rw-r--r-- | sem_assocs.adb | 2 | ||||
| -rw-r--r-- | sem_expr.adb | 1 | ||||
| -rw-r--r-- | sem_names.adb | 3 | ||||
| -rw-r--r-- | translate/ghdldrv/Makefile | 6 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 20 | ||||
| -rw-r--r-- | translate/grt/Makefile.inc | 3 | ||||
| -rw-r--r-- | translate/grt/config/linux.c | 7 | ||||
| -rw-r--r-- | translate/translation.adb | 136 |
10 files changed, 142 insertions, 99 deletions
diff --git a/evaluation.adb b/evaluation.adb index baff1ae..77183cc 100644 --- a/evaluation.adb +++ b/evaluation.adb @@ -836,6 +836,28 @@ package body Evaluation is return Build_Simple_Aggregate (Res_List, Orig, Res_Type); end Eval_Concatenation; + function Eval_Array_Equality (Left, Right : Iir) return Boolean + is + L_List : Iir_List; + R_List : Iir_List; + N : Natural; + begin + -- FIXME: the simple aggregates are lost. + L_List := Get_Simple_Aggregate_List (Eval_String_Literal (Left)); + R_List := Get_Simple_Aggregate_List (Eval_String_Literal (Right)); + N := Get_Nbr_Elements (L_List); + if N /= Get_Nbr_Elements (R_List) then + return False; + end if; + for I in 0 .. N - 1 loop + -- FIXME: this is wrong: (eg: evaluated lit) + if Get_Nth_Element (L_List, I) /= Get_Nth_Element (R_List, I) then + return False; + end if; + end loop; + return True; + end Eval_Array_Equality; + -- ORIG is either a dyadic operator or a function call. function Eval_Dyadic_Operator (Orig : Iir; Left, Right : Iir) return Iir @@ -1073,34 +1095,10 @@ package body Evaluation is (Get_Fp_Value (Left) / Iir_Fp64 (Get_Value (Right)), Orig); when Iir_Predefined_Array_Equality => - declare - L_List : Iir_List; - R_List : Iir_List; - R : Boolean; - N : Natural; - begin - -- FIXME: the simple aggregates are lost. - L_List := - Get_Simple_Aggregate_List (Eval_String_Literal (Left)); - R_List := - Get_Simple_Aggregate_List (Eval_String_Literal (Right)); - N := Get_Nbr_Elements (L_List); - if N /= Get_Nbr_Elements (R_List) then - R := False; - else - R := True; - for I in 0 .. N - 1 loop - -- FIXME: this is wrong: (eg: evaluated lit) - if Get_Nth_Element (L_List, I) - /= Get_Nth_Element (R_List, I) - then - R := False; - exit; - end if; - end loop; - end if; - return Build_Boolean (R, Orig); - end; + return Build_Boolean (Eval_Array_Equality (Left, Right), Orig); + + when Iir_Predefined_Array_Inequality => + return Build_Boolean (not Eval_Array_Equality (Left, Right), Orig); when Iir_Predefined_Array_Sll | Iir_Predefined_Array_Srl @@ -1111,8 +1109,7 @@ package body Evaluation is return Eval_Shift_Operator (Eval_String_Literal (Left), Right, Orig, Func); - when Iir_Predefined_Array_Inequality - | Iir_Predefined_Array_Less + when Iir_Predefined_Array_Less | Iir_Predefined_Array_Less_Equal | Iir_Predefined_Array_Greater | Iir_Predefined_Array_Greater_Equal @@ -3540,7 +3540,7 @@ package body Parse is Set_Location (Res); Set_Expression (Res, Parse_Expression); - Expect (Tok_Select, "after expression"); + Expect (Tok_Select, "'select' expected after expression"); Scan.Scan; if Current_Token = Tok_Left_Paren then Target := Parse_Aggregate; @@ -3556,13 +3556,13 @@ package body Parse is Build_Init (Last); loop Wf_Chain := Parse_Waveform; - Expect (Tok_When, "after waveform"); + Expect (Tok_When, "'when' expected after waveform"); Scan.Scan; Assoc := Parse_Choices (Null_Iir); Set_Associated (Assoc, Wf_Chain); Append_Subchain (Last, Res, Assoc); exit when Current_Token = Tok_Semi_Colon; - Expect (Tok_Comma, "after choice"); + Expect (Tok_Comma, "',' (comma) expected after choice"); Scan.Scan; end loop; return Res; diff --git a/sem_assocs.adb b/sem_assocs.adb index 4069583..3239d92 100644 --- a/sem_assocs.adb +++ b/sem_assocs.adb @@ -551,7 +551,7 @@ package body Sem_Assocs is exit when Index_Type = Null_Iir; Chain := Get_Individual_Association_Chain (Assoc); Sem_Choices_Range - (Chain, Index_Type, True, Get_Location (Assoc), Low, High); + (Chain, Index_Type, False, Get_Location (Assoc), Low, High); Set_Individual_Association_Chain (Assoc, Chain); end loop; end Finish_Individual_Assoc_Array_Subtype; diff --git a/sem_expr.adb b/sem_expr.adb index f3e767f..a0ec9b7 100644 --- a/sem_expr.adb +++ b/sem_expr.adb @@ -2278,6 +2278,7 @@ package body Sem_Expr is Lb := Low; Hb := High; end if; + -- Checks all values between POS and POS_MAX are handled. Pos := Eval_Pos (Lb); Pos_Max := Eval_Pos (Hb); if Pos > Pos_Max then diff --git a/sem_names.adb b/sem_names.adb index 41e6830..4a01133 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -1974,7 +1974,8 @@ package body Sem_Names is Error_Msg_Sem ("function name is a procedure", Name); when Iir_Kind_Process_Statement - | Iir_Kind_Component_Declaration => + | Iir_Kind_Component_Declaration + | Iir_Kind_Type_Conversion => Error_Msg_Sem (Disp_Node (Prefix) & " cannot be indexed or sliced", Name); Res := Null_Iir; diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile index 41e19a4..e9d940b 100644 --- a/translate/ghdldrv/Makefile +++ b/translate/ghdldrv/Makefile @@ -36,10 +36,10 @@ GRTSRCDIR=../grt include $(GRTSRCDIR)/Makefile.inc ghdl_mcode: GRT_FLAGS+=-DWITH_GNAT_RUN_TIME -ghdl_mcode: default_pathes.ads $(GRT_ADD_OBJS) mmap_binding.o force - gnatmake -aI../../ortho/mcode $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs mmap_binding.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) +ghdl_mcode: default_pathes.ads $(GRT_ADD_OBJS) memsegs_c.o force + gnatmake -aI../../ortho/mcode $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs memsegs_c.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) -mmap_binding.o: ../../ortho/mcode/mmap_binding.c +memsegs_c.o: ../../ortho/mcode/memsegs_c.c $(CC) -c -g -o $@ $< ghdl_gcc: default_pathes.ads force diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index 5adaeba..0dc31f4 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -35,7 +35,7 @@ with System; use System; with Trans_Decls; with Ortho_Code.Binary; with Ortho_Code.Debug; -with Ortho_Code.X86.Emits; +with Ortho_Code.Abi; with Types; with Iirs; use Iirs; with Flags; @@ -177,13 +177,6 @@ package body Ghdlrun is pragma Export (C, Ieee_Std_Logic_1164_Resolved_Resolv_Ptr, "ieee__std_logic_1164__resolved_RESOLV_ptr"); - -- From GCC. - function Divdi3 (A, B : Long_Integer) return Long_Integer; - pragma Import (C, Divdi3, "__divdi3"); - - function Muldi3 (A, B : Long_Integer) return Long_Integer; - pragma Import (C, Muldi3, "__muldi3"); - function Find_Untruncated_Text_Read return O_Dnode is use Types; @@ -266,6 +259,8 @@ package body Ghdlrun is Binary_File.Memory.Write_Memory_Init; + Ortho_Code.Abi.Link_Intrinsics; + Def (Trans_Decls.Ghdl_Memcpy, Grt.Lib.Ghdl_Memcpy'Address); Def (Trans_Decls.Ghdl_Bound_Check_Failed_L0, @@ -525,15 +520,6 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_Get_Instance_Name, Grt.Names.Ghdl_Get_Instance_Name'Address); - Binary_File.Memory.Set_Symbol_Address - (Ortho_Code.X86.Emits.Intrinsics_Symbol - (Ortho_Code.X86.Intrinsic_Mul_Ov_I64), - Muldi3'Address); - Binary_File.Memory.Set_Symbol_Address - (Ortho_Code.X86.Emits.Intrinsics_Symbol - (Ortho_Code.X86.Intrinsic_Div_Ov_I64), - Divdi3'Address); - -- Find untruncated_text_read, if any. Decl := Find_Untruncated_Text_Read; if Decl /= O_Dnode_Null then diff --git a/translate/grt/Makefile.inc b/translate/grt/Makefile.inc index 4df5275..584ed55 100644 --- a/translate/grt/Makefile.inc +++ b/translate/grt/Makefile.inc @@ -81,6 +81,7 @@ GRT_ADD_OBJS:=$(GRT_TARGET_OBJS) grt-cbinding.o grt-cvpi.o #GRT_USE_PTHREADS=y ifeq ($(GRT_USE_PTHREADS),y) + GRT_CFLAGS+=-DUSE_THREADS GRT_ADD_OBJS+=grt-cthreads.o GRT_EXTRA_LIB+=-lpthread endif @@ -128,7 +129,7 @@ amd64.o: $(GRTSRCDIR)/config/amd64.S $(CC) -c $(GRT_FLAGS) -o $@ $< linux.o: $(GRTSRCDIR)/config/linux.c - $(CC) -c $(GRT_FLAGS) -o $@ $< + $(CC) -c $(GRT_FLAGS) $(GRT_CFLAGS) -o $@ $< win32.o: $(GRTSRCDIR)/config/win32.c $(CC) -c $(GRT_FLAGS) -o $@ $< diff --git a/translate/grt/config/linux.c b/translate/grt/config/linux.c index ab999c0..2fe92c0 100644 --- a/translate/grt/config/linux.c +++ b/translate/grt/config/linux.c @@ -189,7 +189,12 @@ static void grt_signal_setup (void) #endif /* Context for the main stack. */ -static __thread struct stack_context main_stack_context; +#ifdef USE_THREADS +#define THREAD __thread +#else +#define THREAD +#endif +static THREAD struct stack_context main_stack_context; extern void grt_set_main_stack (struct stack_context *stack); diff --git a/translate/translation.adb b/translate/translation.adb index 467ae9c..92a4d04 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -1797,15 +1797,13 @@ package body Translation is -- Check bounds length of L match bounds length of R. -- If L_TYPE (resp. R_TYPE) is not a thin array, then L_NODE - -- (resp. R_NODE) are not used (and may be o_lnode_null). + -- (resp. R_NODE) are not used (and may be Mnode_Null). -- If L_TYPE (resp. T_TYPE) is a fat array, then L_NODE (resp. R_NODE) - -- must be a variable pointing to the array. + -- must designate the array. procedure Check_Array_Match (L_Type : Iir; - L_Node : O_Lnode; - L_Mode : Object_Kind_Type; + L_Node : Mnode; R_Type : Iir; - R_Node : O_Lnode; - R_Mode : Object_Kind_Type; + R_Node : Mnode; Loc : Iir); -- Create a subtype range to be stored into the location pointed by @@ -8412,10 +8410,19 @@ package body Translation is return True; end Need_Range_Check; - procedure Check_Range (Value : O_Dnode; Expr : Iir; Atype : Iir) + procedure Check_Range_Low (Value : O_Dnode; Atype : Iir) is If_Blk : O_If_Block; begin + Open_Temp; + Start_If_Stmt (If_Blk, Not_In_Range (Value, Atype)); + Chap6.Gen_Bound_Error (Null_Iir); + Finish_If_Stmt (If_Blk); + Close_Temp; + end Check_Range_Low; + + procedure Check_Range (Value : O_Dnode; Expr : Iir; Atype : Iir) is + begin if not Need_Range_Check (Expr, Atype) then return; end if; @@ -8428,20 +8435,14 @@ package body Translation is Chap6.Gen_Bound_Error (Expr); end if; else - Open_Temp; - Start_If_Stmt (If_Blk, Not_In_Range (Value, Atype)); - Chap6.Gen_Bound_Error (Null_Iir); - Finish_If_Stmt (If_Blk); - Close_Temp; + Check_Range_Low (Value, Atype); end if; end Check_Range; procedure Check_Array_Match (L_Type : Iir; - L_Node : O_Lnode; - L_Mode : Object_Kind_Type; + L_Node : Mnode; R_Type : Iir; - R_Node : O_Lnode; - R_Mode : Object_Kind_Type; + R_Node : Mnode; Loc : Iir) is L_Tinfo, R_Tinfo : Type_Info_Acc; @@ -8491,10 +8492,10 @@ package body Translation is exit when Index = Null_Iir; Sub_Cond := New_Compare_Op (ON_Neq, - Chap6.Get_Array_Ptr_Bound_Length (L_Node, L_Type, - I + 1, L_Mode), - Chap6.Get_Array_Ptr_Bound_Length (R_Node, R_Type, - I + 1, R_Mode), + M2E (Range_To_Length + (Get_Array_Range (L_Node, L_Type, I + 1))), + M2E (Range_To_Length + (Get_Array_Range (R_Node, R_Type, I + 1))), Ghdl_Bool_Type); if I = 0 then Cond := Sub_Cond; @@ -10081,8 +10082,8 @@ package body Translation is New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var), New_Value (M2Lp (Chap3.Get_Array_Base (Name_Node)))); - Chap3.Check_Array_Match (Decl_Type, O_Lnode_Null, Kind, - Name_Type, M2Lp (Name_Node), Kind, + Chap3.Check_Array_Match (Decl_Type, T2M (Decl_Type, Kind), + Name_Type, Name_Node, Decl); Close_Temp; when Type_Mode_Scalar => @@ -11691,6 +11692,16 @@ package body Translation is end; end if; + if Get_Kind (Formal_Type) in Iir_Kinds_Array_Type_Definition + then + -- Check length matches. + Stabilize (Formal_Node); + Stabilize (Actual_Node); + Chap3.Check_Array_Match (Formal_Type, Formal_Node, + Actual_Type, Actual_Node, + Assoc); + end if; + Data := (Actual_Node => Actual_Node, Actual_Type => Actual_Type, Mode => Mode, @@ -14420,8 +14431,8 @@ package body Translation is E := Create_Temp_Init (T_Info.Ortho_Ptr_Type (Mode_Value), Val); Chap3.Check_Array_Match - (Target_Type, M2Lp (T), Mode_Value, - Get_Type (Expr), New_Obj (E), Mode_Value, + (Target_Type, T, + Get_Type (Expr), Dp2M (E, T_Info, Mode_Value), Null_Iir); Chap3.Translate_Object_Copy (T, New_Obj_Value (E), Target_Type); @@ -15169,9 +15180,10 @@ package body Translation is begin E := Create_Temp_Init (Expr_Info.Ortho_Ptr_Type (Mode_Value), Expr); - Chap3.Check_Array_Match (Res_Type, O_Lnode_Null, Mode_Value, - Expr_Type, New_Obj (E), Mode_Value, - Loc); + Chap3.Check_Array_Match + (Res_Type, Mnode_Null, + Expr_Type, Dp2M (E, Expr_Info, Mode_Value), + Loc); return New_Convert_Ov (New_Value (Chap3.Get_Array_Ptr_Base_Ptr (New_Obj (E), Expr_Type, Mode_Value)), @@ -15199,9 +15211,10 @@ package body Translation is Chap3.Get_Array_Bounds_Ptr (O_Lnode_Null, Expr_Type, Mode_Value)); -- Check array match. - Chap3.Check_Array_Match (Res_Type, New_Obj (Res), Mode_Value, - Expr_Type, New_Obj (E), Mode_Value, - Loc); + Chap3.Check_Array_Match + (Res_Type, Dv2M (Res, Res_Info, Mode_Value), + Expr_Type, Dp2M (E, Expr_Info, Mode_Value), + Loc); Close_Temp; return New_Address (New_Obj (Res), Res_Info.Ortho_Ptr_Type (Mode_Value)); @@ -22283,19 +22296,58 @@ package body Translation is function Translate_Val_Attribute (Attr : Iir) return O_Enode is - T : O_Dnode; - Prefix : Iir; - Ttype : O_Tnode; + Val : O_Enode; + Attr_Type : Iir; + Res_Var : O_Dnode; + Res_Type : O_Tnode; begin - Prefix := Get_Type (Attr); - Ttype := Get_Ortho_Type (Prefix, Mode_Value); - T := Create_Temp (Ttype); - New_Assign_Stmt - (New_Obj (T), - New_Convert_Ov (Chap7.Translate_Expression (Get_Parameter (Attr)), - Ttype)); - Chap3.Check_Range (T, Attr, Get_Type (Get_Prefix (Attr))); - return New_Obj_Value (T); + Attr_Type := Get_Type (Attr); + Res_Type := Get_Ortho_Type (Attr_Type, Mode_Value); + Res_Var := Create_Temp (Res_Type); + Val := Chap7.Translate_Expression (Get_Parameter (Attr)); + + case Get_Kind (Attr_Type) is + when Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + -- For enumeration, always check the value is in the enum + -- range. + declare + Val_Type : O_Tnode; + Val_Var : O_Dnode; + If_Blk : O_If_Block; + begin + Val_Type := Get_Ortho_Type (Get_Type (Get_Parameter (Attr)), + Mode_Value); + Val_Var := Create_Temp_Init (Val_Type, Val); + Start_If_Stmt + (If_Blk, + New_Dyadic_Op + (ON_Or, + New_Compare_Op (ON_Lt, + New_Obj_Value (Val_Var), + New_Lit (New_Signed_Literal + (Val_Type, 0)), + Ghdl_Bool_Type), + New_Compare_Op (ON_Ge, + New_Obj_Value (Val_Var), + New_Lit (New_Signed_Literal + (Val_Type, + Integer_64 + (Get_Nbr_Elements + (Get_Enumeration_Literal_List + (Attr_Type))))), + Ghdl_Bool_Type))); + Chap6.Gen_Bound_Error (Attr); + Finish_If_Stmt (If_Blk); + Val := New_Obj_Value (Val_Var); + end; + when others => + null; + end case; + + New_Assign_Stmt (New_Obj (Res_Var), New_Convert_Ov (Val, Res_Type)); + Chap3.Check_Range (Res_Var, Attr, Get_Type (Get_Prefix (Attr))); + return New_Obj_Value (Res_Var); end Translate_Val_Attribute; function Translate_Pos_Attribute (Attr : Iir; Res_Type : Iir) |