Looks ok.  I will merge it.

Thanks!

Tristan.

----- Mail original -----
> # HG changeset patch
> # User Christophe CURIS <[email protected]>
> # Date 1392052434 -3600
> #      Mon Feb 10 18:13:54 2014 +0100
> # Node ID 42aa510d7bc3b3c7c1685f2f84a6a3fa54329f37
> # Parent  722467d0c45fb0e5b804e7eab88667265f531031
> Add option to handle allocation check behaviour (ticket #5)
> 
> When ghdl_malloc was returning null, the old behaviour was to
> ignore it and continue, which led to crash because the initialiser
> mechanism would try to dereference this null pointer.
> 
> This was almost ok because in most cases OS are overcommiting
> and thus malloc never returns null.
> 
> There are a few cases however where malloc may return null, so
> now:
>  - we properly check that, and issue an appropriate allocation
> failure message;
>  - if user explicitely wants it (optin -fno-check-allocation) then
> we can also return a null access pointer to the VHDL code so the
> case can be handled by user code
> 
> diff -r 722467d0c45f -r 42aa510d7bc3 doc/ghdl.texi
> --- a/doc/ghdl.texi   Mon Feb 10 01:43:01 2014 +0100
> +++ b/doc/ghdl.texi   Mon Feb 10 18:13:54 2014 +0100
> @@ -863,6 +863,21 @@
>  @option{--workdir=} option, or in the current directory if the
>  latter
>  option is not specified.
>  
> +@item -fno-check-allocation
> +@cindex @option{-fcheck-allocation} switch
> +@cindex @option{-fno-check-allocation} switch
> +When allocating memory with the @samp{new} operator, the VHDL LRM
> states that
> +the allocation cannot fail, so the default behaviour
> (@option{-fcheck-allocation})
> +is to raise an error if @samp{malloc} returns NULL.
> +
> +When @emph{compiling} with @option{-fno-check-allocation}, GHDL will
> generate
> +the appropriate code so that the VHDL code will receive a NULL
> access pointer,
> +to give your VHDL code the opportunity to handle the situation.
> +
> +Please note that on most OS the @emph{default} behaviour is to
> overcommit
> +(@samp{malloc} never fail), so the program will crash anyway during
> the
> +initialisation of the allocated data.
> +
>  @item -fexplicit
>  @cindex @option{-fexplicit} switch
>  When two operators are overloaded, give preference to the explicit
>  declaration.
> diff -r 722467d0c45f -r 42aa510d7bc3 flags.ads
> --- a/flags.ads       Mon Feb 10 01:43:01 2014 +0100
> +++ b/flags.ads       Mon Feb 10 18:13:54 2014 +0100
> @@ -109,6 +109,11 @@
>     --  If set, performs VITAL checks.
>     Flag_Vital_Checks : Boolean := True;
>  
> +   --  Specify how memory allocation failure are handled for the
> 'new' operator
> +   --  The default is to report an error as VHDL LRM states that
> 'new' never fails
> +   --  When disabled, returns a null access pointer to the VHDL code
> +   Flag_Allocation_Check : Boolean := True;
> +
>     -- --time-resolution=X
>     -- Where X corresponds to:
>     -- fs => 'f'
> diff -r 722467d0c45f -r 42aa510d7bc3 options.adb
> --- a/options.adb     Mon Feb 10 01:43:01 2014 +0100
> +++ b/options.adb     Mon Feb 10 18:13:54 2014 +0100
> @@ -116,6 +116,10 @@
>           Flag_Explicit := True;
>        elsif Opt = "-frelaxed-rules" then
>           Flag_Relaxed_Rules := True;
> +      elsif Opt = "-fcheck-allocation" then
> +         Flag_Allocation_Check := True;
> +      elsif Opt = "-fno-check-allocation" then
> +         Flag_Allocation_Check := False;
>        elsif Opt = "--syn-binding" then
>           Flag_Syn_Binding := True;
>        elsif Opt = "--no-vital-checks" then
> @@ -216,6 +220,7 @@
>  --    P ("           simulation.  LEVEL is note, warning, error,");
>  --    P ("           failure or none");
>        P ("Extensions:");
> +      P ("  -fno-check-allocation  do not raise error when
> allocation fail, return a NULL access");
>        P ("  -fexplicit         give priority to explicitly declared
>        operator");
>        P ("  -frelaxed-rules    relax some LRM rules");
>        P ("  -C  --mb-comments  allow multi-bytes chars in a
>        comment");
> diff -r 722467d0c45f -r 42aa510d7bc3 ortho/gcc/lang.opt
> --- a/ortho/gcc/lang.opt      Mon Feb 10 01:43:01 2014 +0100
> +++ b/ortho/gcc/lang.opt      Mon Feb 10 18:13:54 2014 +0100
> @@ -62,6 +62,10 @@
>  vhdl
>  Enable VITAL checks
>  
> +fcheck-allocation
> +vhdl Driver Report
> +-f[no-]check-allocation      Specify how to handle out-of-memory with
> 'new' operator
> +
>  fexplicit
>  vhdl
>  Explicit function declarations override implicit one in use
> diff -r 722467d0c45f -r 42aa510d7bc3 ortho/gcc/ortho-lang.c
> --- a/ortho/gcc/ortho-lang.c  Mon Feb 10 01:43:01 2014 +0100
> +++ b/ortho/gcc/ortho-lang.c  Mon Feb 10 18:13:54 2014 +0100
> @@ -425,6 +425,8 @@
>      case OPT__anaelab:
>        /* Only a few options have a real arguments.  */
>        return lang_handle_option (opt, arg) != 0;
> +    case OPT_fcheck_allocation:
> +      return lang_handle_option (value?opt:"-fno-check-allocation",
> NULL);
>      default:
>        /* The other options must have a joint argument.  */
>        if (arg != NULL)
> diff -r 722467d0c45f -r 42aa510d7bc3 translate/grt/grt-lib.adb
> --- a/translate/grt/grt-lib.adb       Mon Feb 10 01:43:01 2014 +0100
> +++ b/translate/grt/grt-lib.adb       Mon Feb 10 18:13:54 2014 +0100
> @@ -145,6 +145,8 @@
>              Error_C ("block already configured");
>           when 3 =>
>              Error_C ("bad configuration");
> +         when 6 =>
> +            Error_C ("could not allocate memory");
>           when others =>
>              Error_C ("unknown error code ");
>              Error_C (Integer (Code));
> diff -r 722467d0c45f -r 42aa510d7bc3 translate/translation.adb
> --- a/translate/translation.adb       Mon Feb 10 01:43:01 2014 +0100
> +++ b/translate/translation.adb       Mon Feb 10 18:13:54 2014 +0100
> @@ -2181,6 +2181,7 @@
>        Prg_Err_Dummy_Config : constant Natural := 3;
>        Prg_Err_No_Choice : constant Natural := 4;
>        Prg_Err_Bad_Choice : constant Natural := 5;
> +      Prg_Err_Alloc_NoMem : constant Natural := 6;
>        procedure Gen_Program_Error (Loc : Iir; Code : Natural);
>  
>        --  Generate code to emit a failure if COND is TRUE,
>        indicating an
> @@ -8589,6 +8590,7 @@
>           Dinfo : Type_Info_Acc;
>           Length : O_Enode;
>           Kind : constant Object_Kind_Type := Get_Object_Kind (Res);
> +         If_Blk : O_If_Block;
>        begin
>           Dinfo := Get_Info (Get_Base_Type (Arr_Type));
>           --  Compute array size.
> @@ -8598,6 +8600,15 @@
>             (M2Lp (Chap3.Get_Array_Base (Res)),
>              Gen_Alloc (Alloc_Kind, Length, Dinfo.T.Base_Ptr_Type
>              (Kind)));
>  
> +         if Alloc_Kind = Alloc_Heap then
> +            -- Allocation can fail, so we include a check to handle
> the case smoothly
> +            Start_If_Stmt (If_Blk,
> +                           New_Compare_Op (On_Neq,
> +                                           M2Addr
> (Chap3.Get_Array_Base (Res)),
> +                                           New_Lit (New_Null_Access
> (Dinfo.T.Base_Ptr_Type (Kind))),
> +                                           Ghdl_Bool_Type));
> +         end if;
> +
>           if Is_Complex_Type (Dinfo)
>             and then Dinfo.C (Kind).Builder_Need_Func
>           then
> @@ -8606,6 +8617,24 @@
>              Chap3.Gen_Call_Type_Builder (Res, Arr_Type);
>              Close_Temp;
>           end if;
> +
> +         if Alloc_Kind = Alloc_Heap then
> +            New_Else_Stmt (If_Blk);
> +            -- If we're here, the allocation failed for Array's data
> +            if Flag_Allocation_Check then
> +               Chap6.Gen_Program_Error (Arr_Type,
> Chap6.Prg_Err_Alloc_NoMem);
> +            else
> +               -- We release memory allocated for the bounds to make
> the access variable
> +               -- a valid looking NULL pointer to reflect that state
> of things so it can
> +               -- be properly handled in user's VHDL code
> +               Chap3.Gen_Deallocate (M2Addr (Chap3.Get_Array_Bounds
> (Res)));
> +               New_Assign_Stmt
> +                 (M2Lp (Chap3.Get_Array_Bounds (Res)),
> +                  New_Lit (New_Null_Access
> (Dinfo.T.Bounds_Ptr_Type)));
> +            end if;
> +
> +            Finish_If_Stmt (If_Blk);
> +         end if;
>        end Allocate_Fat_Array_Base;
>  
>        procedure Create_Array_Subtype (Sub_Type : Iir; Transient :
>        Boolean)
> @@ -8724,6 +8753,7 @@
>        is
>           Dinfo : Type_Info_Acc;
>           Kind : Object_Kind_Type;
> +         If_Blk : O_If_Block;
>        begin
>           Dinfo := Get_Info (Obj_Type);
>           Kind := Get_Object_Kind (Res);
> @@ -8736,6 +8766,16 @@
>                                                 Ghdl_Index_Type)),
>                            Dinfo.T.Bounds_Ptr_Type));
>  
> +            if Alloc_Kind = Alloc_Heap then
> +               -- Allocation can fail, so we include a check to
> avoid NULL
> +               -- pointer dereference in generated code
> +               Start_If_Stmt (If_Blk,
> +                              New_Compare_Op (On_Neq,
> +                                              M2Addr
> (Chap3.Get_Array_Bounds (Res)),
> +                                              New_Lit
> (New_Null_Access (Dinfo.T.Bounds_Ptr_Type)),
> +                                              Ghdl_Bool_Type));
> +            end if;
> +
>              --  Copy bounds to the allocated area.
>              Gen_Memcpy
>                (M2Addr (Chap3.Get_Array_Bounds (Res)),
> @@ -8744,6 +8784,22 @@
>  
>              --  Allocate base.
>              Allocate_Fat_Array_Base (Alloc_Kind, Res, Obj_Type);
> +
> +            if Alloc_Kind = Alloc_Heap then
> +               New_Else_Stmt (If_Blk);
> +               -- If we're here, the allocation for Bounds failed
> (no more memory)
> +               if Flag_Allocation_Check then
> +                  Chap6.Gen_Program_Error (Obj_Type,
> Chap6.Prg_Err_Alloc_NoMem);
> +               else
> +                  -- We initialise the pointer as a valid-looking
> NULL pointer
> +                  New_Assign_Stmt
> +                    (M2Lp (Chap3.Get_Array_Base (Res)),
> +                     New_Lit (New_Null_Access (Dinfo.T.Base_Ptr_Type
> (Kind))));
> +               end if;
> +
> +               Finish_If_Stmt (If_Blk);
> +            end if;
> +
>           else
>              New_Assign_Stmt
>                (M2Lp (Res),
> @@ -8753,6 +8809,14 @@
>                                         Obj_Type),
>                  Dinfo.Ortho_Ptr_Type (Kind)));
>  
> +            if Alloc_Kind = Alloc_Heap then
> +               Start_If_Stmt (If_Blk,
> +                              New_Compare_Op (ON_Neq,
> +                                              M2Addr (Res),
> +                                              New_Lit
> (New_Null_Access (Dinfo.Ortho_Ptr_Type (Kind))),
> +                                              Ghdl_Bool_Type));
> +            end if;
> +
>              if Is_Complex_Type (Dinfo)
>                and then Dinfo.C (Kind).Builder_Need_Func
>              then
> @@ -8762,6 +8826,13 @@
>                 Close_Temp;
>              end if;
>  
> +            if Alloc_Kind = Alloc_Heap then
> +               if Flag_Allocation_Check then
> +                  New_Else_Stmt (If_Blk);
> +                  Chap6.Gen_Program_Error (Obj_Type,
> Chap6.Prg_Err_Alloc_NoMem);
> +               end if;
> +               Finish_If_Stmt (If_Blk);
> +            end if;
>           end if;
>        end Translate_Object_Allocation;
>  
> @@ -16041,6 +16112,7 @@
>           D_Info : constant Type_Info_Acc := Get_Info (D_Type);
>           R : Mnode;
>           Rtype : O_Tnode;
> +         If_Blk : O_If_Block;
>        begin
>           --  Compute the expression.
>           Val := Translate_Expression (Get_Expression (Expr),
>           D_Type);
> @@ -16064,7 +16136,33 @@
>              when others =>
>                 raise Internal_Error;
>           end case;
> +
> +         if A_Info.Type_Mode = Type_Mode_Fat_Acc then
> +            Start_If_Stmt (If_Blk,
> +                           New_Compare_Op (On_Neq,
> +                                           M2Addr
> (Chap3.Get_Array_Base (R)),
> +                                           New_Lit (New_Null_Access
> +
>                                                    (D_Info.T.Base_Ptr_Type
> +
>                                                     (Get_Object_Kind
> (R)))),
> +                                           Ghdl_Bool_Type));
> +         else
> +            Start_If_Stmt (If_Blk,
> +                           New_Compare_Op (On_Neq,
> +                                           M2Addr (R),
> +                                           New_Lit (New_Null_Access
> +
>                                                    (D_Info.Ortho_Ptr_Type
> +
>                                                     (Get_Object_Kind
> (R)))),
> +                                           Ghdl_Bool_Type));
> +         end if;
> +
>           Chap3.Translate_Object_Copy (R, Val, D_Type);
> +
> +         if Flag_Allocation_Check then
> +            New_Else_Stmt (If_Blk);
> +            Chap6.Gen_Program_Error (Expr,
> Chap6.Prg_Err_Alloc_NoMem);
> +         end if;
> +         Finish_If_Stmt (If_Blk);
> +
>           return New_Convert_Ov (M2Addr (R), Rtype);
>        end Translate_Allocator_By_Expression;
>  
> @@ -16079,6 +16177,7 @@
>           P_Info : Type_Info_Acc;
>           D_Type : Iir;
>           D_Info : Type_Info_Acc;
> +         If_Blk : O_If_Block;
>        begin
>           P_Type := Get_Type (Expr);
>           P_Info := Get_Info (P_Type);
> @@ -16103,7 +16202,34 @@
>                 raise Internal_Error;
>           end case;
>           Chap3.Translate_Object_Allocation (Res, Alloc_Heap, D_Type,
>           Bounds);
> +
> +         if D_Info.Type_Mode = Type_Mode_Fat_Array then
> +            -- the allocation may have failed, do not initialise a
> NULL pointer
> +            Start_If_Stmt (If_Blk,
> +                           New_Compare_Op (ON_Neq,
> +                                           M2Addr
> (Chap3.Get_Array_Base (Res)),
> +                                           New_Lit (New_Null_Access
> +
>                                                    (D_Info.T.Base_Ptr_Type
> +
>                                                     (Get_Object_Kind
> (Res)))),
> +                                           Ghdl_Bool_Type));
> +         else
> +            Start_If_Stmt (If_Blk,
> +                           New_Compare_Op (ON_Neq,
> +                                           M2Addr (Res),
> +                                           New_Lit (New_Null_Access
> +
>                                                    (D_Info.Ortho_Ptr_Type
> +
>                                                     (Get_Object_Kind
> (Res)))),
> +                                           Ghdl_Bool_Type));
> +         end if;
> +
>           Chap4.Init_Object (Res, D_Type);
> +
> +         if Flag_Allocation_Check then
> +            New_Else_Stmt (If_Blk);
> +            Chap6.Gen_Program_Error (Expr,
> Chap6.Prg_Err_Alloc_NoMem);
> +         end if;
> +         Finish_If_Stmt (If_Blk);
> +
>           return New_Convert_Ov (M2Addr (Res), Rtype);
>        end Translate_Allocator_By_Subtype;
>  
> 
> _______________________________________________
> Ghdl-discuss mailing list
> [email protected]
> https://mail.gna.org/listinfo/ghdl-discuss
> 

_______________________________________________
Ghdl-discuss mailing list
[email protected]
https://mail.gna.org/listinfo/ghdl-discuss

Reply via email to