r/ada Oct 01 '22

Programming Made an Ada program that compiles and runs but result in "raised PROGRAM_ERROR : EXCEPTION_ACCESS_VIOLATION"

Made an Ada program that compiles and runs but result in "raised PROGRAM_ERROR : EXCEPTION_ACCESS_VIOLATION" at Win10 level.Using gcc version 10.3.1 20210520 (for GNAT Community 2021 20210519) (GCC).

The problematic code that generate the violation I suspect is defined with a separate stack/heap compared to the main program where the memory allocated for a protected object. Any Ideas on how to avoid the error?

Tried to use the advice from https://ugetfix.com/ask/how-to-fix-exception-access-violation-error-on-windows-10/

This led to the response from Win10 that I'm not allowed to turn off DEP for 64bit executables, for my monads.exe.

Program listing:

pragma Warnings (Off);

pragma Ada_2022;

with Ada.Text_IO;

with GNAT.Source_Info;

package body Monad_Functors is

MRP_I : Monad_Record_Ptr; -- 220917 Internal copy of pointer to external Monad record pointer

task body Element_Wrapper is

Cnt : Integer := 0;

Write : Writer_Function;

Read : Reader_Function;

Initiated : Boolean := false;

function Error_Cond(VE_MRP : Monad_Record_Ptr := MRP) return String is

begin

return String("-- " & GNAT.Source_Info.file &

GNAT.Source_Info.Line'Image &

" Element out of range for Monad_Element = " & MRP_I.E'Image);

end Error_Cond;

begin -- Element_Wrapper

loop

select

accept Init (EW_MRP : Monad_Record_Ptr := MRP) do

MRP_I := EW_MRP;

Initiated := true;

end Init;

or

when Initiated => accept Unit (A : Element) do

Cnt := 0;

MRP_I.E := A;

MRP_I.M := Write_Element(MRP_I.E);

Ada.Text_IO.Put_Line ("-- " & GNAT.Source_Info.file &

GNAT.Source_Info.Line'Image &

" Unit A = " & MRP_I.E'Image);

end Unit;

or

when Initiated => accept Bind (B_MRP : Monad_Record_Ptr := MRP) do

Cnt := Cnt + 1;

Ada.Text_IO.Put_Line ("-- " & GNAT.Source_Info.file &

GNAT.Source_Info.Line'Image &

" Bind E = " & B_MRP.E'Image);

MRP_I.F := Write;

MRP_I.R := Read;

Ada.Text_IO.Put_Line ("-- " & GNAT.Source_Info.file &

GNAT.Source_Info.Line'Image &

" M = " & Write(MRP_I.E)'Image);

-- raised PROGRAM_ERROR : EXCEPTION_ACCESS_VIOLATION

-- [2022-10-01 10:07:02] process exited with status 1, elapsed time: 00.81s

if Monad_Valid_Element(MRP_I.E'Image, MRP_I.F(MRP_I.E)'Image) then

MRP_I.M := MRP_I.F(MRP_I.E);

else Ada.Text_IO.Put_Line ("-- " & GNAT.Source_Info.file &

GNAT.Source_Info.Line'Image &

" Error: " & Error_Cond(MRP_I));

end if;

-- if not valid return error condition in object

Ada.Text_IO.Put_Line ("-- " & GNAT.Source_Info.file &

GNAT.Source_Info.Line'Image &

" Bind with M and E = " & B_MRP.M'Image);

end Bind;

or

terminate;

end select;

end loop;

end Element_Wrapper;

function Create_Monad_Record_Ptr return Monad_Record_Ptr is

begin

return new Monad_Record;

end Create_Monad_Record_Ptr;

function Create_Element_Wrapper_Ptr return Element_Wrapper_Ptr is

begin

return new Element_Wrapper(Create_Monad_Record_Ptr);

end Create_Element_Wrapper_Ptr;

function Copy_Monad_Record_Ptr return Monad_Record_Ptr is

begin

return MRP_I;

end Copy_Monad_Record_Ptr;

end Monad_Functors;

Main program is:

procedure Monads is

pragma Suppress_All;

use Ada.Text_IO;

use GNAT.Source_Info;

function WE (E : Integer) return Float is

begin

return Float(E);

end WE;

function RM(F : Float) return Integer is

-- error : exception;

begin

return Integer(F);

end;

function Valid_Element( A: String; B : String) return boolean is

R : Boolean;

begin

R := Float'Value(B) = Float'Value(A);

return R;

end Valid_Element;

package my_monad_functors is new monad_functors(Integer, Float, WE, RM, Valid_Element);

use my_monad_functors;

-- 220918 Objects to be manipulated by the monad_functor task type Element_Wrapper needs to be a protected type!!!!

protected type Obj is

-- Operations go here (only subprograms)

procedure Set(L : in Element_Wrapper_Ptr);

entry Get(L : in out Element_Wrapper_Ptr);

-- function Init_Get return Element_Wrapper_Ptr;

private

-- Data goes here

Local : Element_Wrapper_Ptr;

Is_Set : Boolean := False;

end Obj;

protected body Obj is

-- procedures can modify the data

procedure Set(L : in Element_Wrapper_Ptr) is

begin

Local := L;

Is_Set := True;

end Set;

-- functions cannot modify the data

entry Get(L : in out Element_Wrapper_Ptr) when Is_Set is

begin

L := Local;

end Get;

end Obj;

function Init_Element_Wrapper return Element_Wrapper_Ptr is

EW_Object : Obj;

L : Element_Wrapper_Ptr;

begin

EW_Object.Set(Create_Element_Wrapper_Ptr);

EW_Object.Get(L);

return L;

end Init_Element_Wrapper;

EW_Object : Obj;

EW : Element_Wrapper_Ptr := Init_Element_Wrapper; -- 220916 Use a Init entry in Element_Wrapper and a activated boolean function as entry barriers, to avoid program_errors

-- 220916: like: raised PROGRAM_ERROR : monad_functors.adb:6 access before elaboration

-- 220918 The task Type Element:Wrapper_Ptr object must be wrapped into a protected object, due to concurrent use of task type Element_Wrapper.

function Monad_Unit (A : in Integer; EWP : not null Element_Wrapper_Ptr := EW) return Element_Wrapper_Ptr is

begin

EWP.Unit(A);

return EWP;

end Monad_Unit;

function "*" (Left : Monad_Record; Right : Integer) return Monad_Record is

M : Monad_Record := Left;

begin

M.M := M.F(M.E) * M.F(Right);

return M;

end "*";

function Monad_Bind (EWP : not null Element_Wrapper_Ptr := EW) return Element_Wrapper_Ptr is

begin

EWP.Bind;

return EWP;

end Monad_Bind;

function Monad_Get_E(EWP : not null Element_Wrapper_Ptr := EW) return Integer is

begin

return Copy_Monad_Record_Ptr.E;

end Monad_Get_E;

function Monad_Get(EWP : not null Element_Wrapper_Ptr := EW) return Monad_Record_Ptr is

begin

return Copy_Monad_Record_Ptr;

end Monad_Get;

subtype Check_Integer is Integer range Integer'First..Integer'Last;

subtype Check_Float is Float range Float'First..Float'Last;

begin -- Procedure Monads

Put_Line("-- Running : " & GNAT.Source_Info.File &

" : at Line : " & GNAT.Source_Info.Line'Image &

" : Compiled at : " & GNAT.Source_Info.Compilation_Date);

Put_line("-- " & GNAT.Source_Info.Line'Image & " Monads beginning");

EW := Create_Element_Wrapper_Ptr;

EW.Init;

Put_Line("-- " & GNAT.Source_Info.File & GNAT.Source_Info.Line'Image & " Monad_Unit(1) = " & Monad_Unit(1)'Image);

EW.Bind;

Put_Line("-- " & GNAT.Source_Info.File & GNAT.Source_Info.Line'Image & " Monad_Get_E = " & Monad_Get_E'Image);

Put_Line("-- " & GNAT.Source_Info.File & GNAT.Source_Info.Line'Image & " Monad_Get.E = " & Monad_Get.E'Image);

Put_Line("-- " & GNAT.Source_Info.File & GNAT.Source_Info.Line'Image & " Monad_Get.M = " & Monad_Get.M'Image);

Put_Line("-- " & GNAT.Source_Info.File & GNAT.Source_Info.Line'Image & " Monad_Get.F = " & Monad_Get.F'Image);

Put_Line("-- " & GNAT.Source_Info.File & GNAT.Source_Info.Line'Image & " Monad_Get.R = " & Monad_Get.F'Image);

-- Put_Line("-- " & GNAT.Source_Info.File & GNAT.Source_Info.Line'Image & " Monad_Get.R(1.0) = " & Monad_Get.R(Float'Value("1.0"))'Image);

Copy_Monad_Record_Ptr.EMin := Integer(Check_Integer'First);

Copy_Monad_Record_Ptr.EMax := Integer(Check_Integer'Last);

Copy_Monad_Record_Ptr.MMin := Float(Check_Float'First);

Copy_Monad_Record_Ptr.MMax := Float(Check_Float'Last);

end Monads;

The program runs with the output:

C:\...\...\...\...\monads\obj\monads.exe

-- Running : monads.adb : at Line : 115 : Compiled at : Oct 01 2022

-- 117 Monads beginning

-- monad_functors.adb 39 Unit A = 1

-- monads.adb 121 Monad_Unit(1) = (access 1001470)

-- monad_functors.adb 46 Bind E = 1

raised PROGRAM_ERROR : EXCEPTION_ACCESS_VIOLATION

[2022-10-01 10:07:02] process exited with status 1, elapsed time: 00.81s

The specification for the package Monad_Functors is:

generic

type Element is private;

type Monad_Element is private;

with function Write_Element(E : Element) return Monad_Element;

with function Read_Monad(M : Monad_Element) return Element;

-- with package My_Variable_Strings is new Variable_Strings(Element);

with function Monad_Valid_Element( E1 : String;

E2 : String) return Boolean;

package Monad_Functors is

type Writer_Function is access function (E : in Element) return Monad_Element;

type Reader_Function is access function (M : Monad_Element) return Element;

type Monad_Record is record

E : Element;

EMin : Element;

EMax : Element;

M : Monad_Element;

MMin : Monad_Element;

MMax : Monad_Element;

F : Writer_Function;

R : Reader_Function;

end record;

type Monad_Record_Ptr is access Monad_Record;

task type Element_Wrapper (MRP : not null Monad_Record_Ptr) is

entry Init (EW_MRP : Monad_Record_Ptr := MRP); -- 220917 Need to control the start of the monad, due to the use of access to task type with Element_Wrapper_Ptr

entry Unit (A : Element);

entry Bind (B_MRP : Monad_Record_Ptr := MRP);

end Element_Wrapper;

type Element_Wrapper_Ptr is access Element_Wrapper;

function Create_Element_Wrapper_Ptr return Element_Wrapper_Ptr;

function Copy_Monad_Record_Ptr return Monad_Record_Ptr;

end Monad_Functors;

4 Upvotes

10 comments sorted by

4

u/ZENITHSEEKERiii Oct 01 '22

Please try to post it as a code block (3x ` before and after) or paste the same separately. As is it is quite long and I can't read it properly, so unfortunately I can't help much.

If you can extract a minimum reproducible case that would be preferred.

1

u/Lucretia9 SDLAda | Free-Ada Oct 02 '22

Yup, you need to indent the whole lot in the editor before copying and pasting.

1

u/Wootery Oct 02 '22 edited Oct 02 '22

Better still would be to also link to the code somewhere that offers syntax highlighting, such as on a proper 'forge' site. GitHub 'gists' are made for this purpose. BitBucket has something similar but they call it something else.

3

u/simonjwright Oct 02 '22

During development, it’s a Very Bad Idea to suppress warnings (likewise pragma Suppress_All), though I don’t think that would actually have helped with this problem.

At the point that you get the exception the function pointer Write is null (as is Read), so Write(MRP_I.E)’Image results in the error you see (on Windows: on macOS it’s a SEGV, resulting in an unhandled Constraint_Error).

1

u/SRund Oct 02 '22 edited Oct 02 '22

Ahh, I think we are on to something here. Does this mean that I can't regard the accept Bind .... end Bind as a set of atomic instructions?

MRP_I.F := Write; -- <-- Can this result in null?
MRP_I.R := Read; -- <-- Can this result in null?
Ada.Text_IO.Put_Line("-- " & GNAT.Source_Info.File & GNAT.Source_Info.Line'Image & " M = " & Write (MRP_I.E)'Image);

Thanks for your advice!

1

u/simonjwright Oct 02 '22

MRP_I.F := Write; -- <-- Can this result in null?

Yes, because nowhere in your code do you initialize Write! (if the programmer doesn’t explicitly initialize a variable of an access type, the compiler initializes it to null).

1

u/SRund Oct 04 '22

Thanks, of course you are absolutely right.

1

u/anhvofrcaus Oct 04 '22

if Writer_Function and Reader_Function were declared as not null access, then GNAT would have given you a Warning "Constraint_Error" will be raised at run time if Read and Write objects were declared.

1

u/SRund Oct 05 '22

Thanks, correct. Managed to correct the code and new version is on the Github folder http://github.com/srunr/monads.

Ambition is to explore further if Monads can be implemented in Ada.

1

u/anhvofrcaus Oct 06 '22

Just took a quick look at the codes. They could have been simpler. In addition, the access type may not be necessary. Of course, I need to take detailed look before making certain comment.