Suggested temporary fix:
DevCPL486 wrote:
PROCEDURE GenFLoad* (VAR src: Item);
VAR f: BYTE; mf: INTEGER;
BEGIN
IF src.mode = Con THEN (* predefined constants *)
DevCPE.GenByte(0D9H); DevCPE.GenByte(0E8H + src.offset)
ELSIF src.form = Int64 THEN
DevCPE.GenByte(0DFH); GenCExt(28H, src)
ELSE
f := src.form; IF src.form = Pointer THEN src.form := Int32 END; CheckForm(src.form, mf); src.form := f;
DevCPE.GenByte(0D9H + mf); GenCExt(0, src)
END
END GenFLoad;
Why:
A simpler offending program is
Code: Select all
VAR r: Real; x: INTEGER;
r := SYSTEM.ADR(x)
The front-end of the compiler inserts a conversion function application because this assignment has an implicit type conversion, and also SYSTEM.ADR is represented as a convertion function application, as well. Thus, after the front-end, this statement looks something like:
r := CONV(CONV(x, Pointer), Real64)
The procedure CheckForm, called from GenFLoad, checks that requested conversion is ok, and traps otherwise.
From looking at the text of CheckForm, my guess is that the possibility of Pointer->Real64 conversion, which is totally permissible under the language rules, was nonetheless forgotten by the authors of CheckForm, being obviously a very rare case.
Code: Select all
PROCEDURE CheckForm (form: BYTE; VAR mf: INTEGER);
BEGIN
IF form = Real32 THEN mf := 0
ELSIF form = Real64 THEN mf := 4
ELSIF form = Int32 THEN mf := 2
ELSE ASSERT(form = Int16); mf := 6
END
END CheckForm;
CheckForm is called from many places, so I hesitated to change it; rather, I made a workaround for a more specific case: GenFLoad generates code to load a floating-point value, and my fix tricks CheckForm to think that it's presented with an Int32. If my guess is right, CheckForm might be amended after some testing.
Testing
Here is the simple test I used:
Code: Select all
MODULE TmpLuowy;
IMPORT SYSTEM;
VAR r, s: REAL; x: INTEGER;
PROCEDURE Do* ();
BEGIN
s := SYSTEM.ADR(x);
x := SYSTEM.ADR(x);
r := 0;
r := r + SYSTEM.ADR(x)
END Do;
END TmpLuowy.
Here are the global variables after a call to TmpLuowy.Do:
Code: Select all
.r REAL -173993812.0
.s REAL -173993812.0
.x INTEGER -173993812
Looks good to me!