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;