diff options
| -rw-r--r-- | ortho/debug/ortho_debug-disp.adb | 12 | ||||
| -rw-r--r-- | sem_expr.adb | 10 | ||||
| -rw-r--r-- | translate/grt/grt-unithread.ads | 5 | ||||
| -rw-r--r-- | translate/translation.adb | 12 |
4 files changed, 28 insertions, 11 deletions
diff --git a/ortho/debug/ortho_debug-disp.adb b/ortho/debug/ortho_debug-disp.adb index 010f0f1..2725668 100644 --- a/ortho/debug/ortho_debug-disp.adb +++ b/ortho/debug/ortho_debug-disp.adb @@ -59,6 +59,10 @@ package body Ortho_Debug.Disp is procedure Put_Trim (Str : String); procedure Set_Mark; + + -- Flush to disk. Only for debugging in case of crash. + procedure Flush_File; + pragma Unreferenced (Flush_File); private type Disp_Context is record -- File where the info are written to. @@ -224,6 +228,14 @@ package body Ortho_Debug.Disp is begin Ctx.Mark := Ctx.Line_Len; end Set_Mark; + + procedure Flush_File is + Status : int; + pragma Unreferenced (Status); + begin + Flush; + Status := fflush (Ctx.File); + end Flush_File; end Formated_Output; use Formated_Output; diff --git a/sem_expr.adb b/sem_expr.adb index 6100150..42d6580 100644 --- a/sem_expr.adb +++ b/sem_expr.adb @@ -3365,6 +3365,9 @@ package body Sem_Expr is end if; end loop; Base_Type := Get_Base_Type (Aggr_Type); + + -- FIXME: should reuse AGGR_TYPE iff AGGR_TYPE is fully constrained + -- and statically match the subtype of the aggregate. if Aggr_Constrained then A_Subtype := Create_Array_Subtype (Base_Type, Get_Location (Aggr)); for I in Infos'Range loop @@ -3405,12 +3408,9 @@ package body Sem_Expr is -- Semantize aggregate EXPR whose type is expected to be A_TYPE. -- A_TYPE cannot be null_iir (this case is handled in sem_expression_ov) function Sem_Aggregate (Expr: Iir_Aggregate; A_Type: Iir) - return Iir_Aggregate - is + return Iir_Aggregate is begin - if A_Type = Null_Iir then - raise Internal_Error; - end if; + pragma Assert (A_Type /= Null_Iir); -- An aggregate is at most globally static. Set_Expr_Staticness (Expr, Globally); diff --git a/translate/grt/grt-unithread.ads b/translate/grt/grt-unithread.ads index cc8a176..b35b7be 100644 --- a/translate/grt/grt-unithread.ads +++ b/translate/grt/grt-unithread.ads @@ -46,7 +46,10 @@ package Grt.Unithread is procedure Set_Current_Process (Proc : Process_Acc); function Get_Current_Process return Process_Acc; - -- The secondary stack for the thread. + -- The secondary stack for the thread. In this implementation, there is + -- only one secondary stack, shared by all processes. This is allowed, + -- because a wait statement cannot appear within a function. So at a wait + -- statement, the secondary stack must be empty. function Get_Stack2 return Stack2_Ptr; procedure Set_Stack2 (St : Stack2_Ptr); diff --git a/translate/translation.adb b/translate/translation.adb index 857f456..a68c787 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -10810,7 +10810,7 @@ package body Translation is Data : Read_Source_Data; begin if Rinfo = null then - -- Not resolver for this function + -- No resolver for this function return; end if; @@ -10962,6 +10962,10 @@ package body Translation is end if; -- Call the resolution function. + if Finfo.Use_Stack2 then + Create_Temp_Stack2_Mark; + end if; + Start_Association (Assoc, Finfo.Ortho_Func); if Finfo.Res_Interface /= O_Dnode_Null then New_Association (Assoc, M2E (Res)); @@ -13593,14 +13597,12 @@ package body Translation is function Translate_Static_Aggregate (Aggr : Iir) return O_Cnode is - Aggr_Type : Iir; - El_Type : Iir; + Aggr_Type : constant Iir := Get_Type (Aggr); + El_Type : constant Iir := Get_Element_Subtype (Aggr_Type); List : O_Array_Aggr_List; Res : O_Cnode; begin - Aggr_Type := Get_Type (Aggr); Chap3.Translate_Anonymous_Type_Definition (Aggr_Type, True); - El_Type := Get_Element_Subtype (Aggr_Type); Start_Array_Aggr (List, Get_Ortho_Type (Aggr_Type, Mode_Value)); Translate_Static_Aggregate_1 |