[Oberon] Bug? procedure variable in procedure call parameter

[volkert at nivoba.de]

Dear Peter,

i recompiled "ORG.Mod" including your fix and it seems to work.

BW,
Volkert

Am 07.04.2014 07:02, schrieb volkert at nivoba.de:
> Thank you. Very interesting, this ORTool.DecObj command.
>
> What is the best way get the original sources fixed?
>
> BW,
> Volkert
>
>
>
> Am 06.04.2014 20:18, schrieb Peter De Wachter:
>> You've run into compiler bug here. I couldn't reproduce at first, as the
>> dummy assignment to Test in your original mail masked the problem. This
>> is a smaller test case:
>>
>> MODULE Scratch2;
>>
>> PROCEDURE Id(x: INTEGER): INTEGER;
>> BEGIN RETURN x
>> END Id;
>>
>> PROCEDURE P(a, b: INTEGER)
>> BEGIN
>> END P;
>>
>> PROCEDURE Test*;
>> VAR f: PROCEDURE (x: INTEGER): INTEGER;
>> BEGIN
>>     f := Id;
>>     P(100, f(101))
>> END Test;
>>
>> END Scratch2.
>>
>> The compiler generated the following code for the Test procedure:
>> (disassembled with the ORTool.DecObj command)
>>
>> (* setup stack frame *)
>>     14     4EE90008    SUB SP SP      8
>>     15     AFE00000    STR  LNK SP       0
>> (* assignment of f *)
>>     16     F7000000    BL       0
>>     17     40F90044    SUB  R0 LNK     68
>>     18     A0E00004    STR   R0 SP       4
>> (* first parameter *)
>>     19     40000064    MOV  R0  R0    100
>> (* get value of f -> destroys the MT register! *)
>> (* should have been stored in R11 *)
>>     20     8CE00004    LDR MT SP       4
>>     21     D100EA5C    BLEQ  MT
>> (* now do the function call *)
>> (* the system will crash as R11 isn't initialized *)
>>     22     41000065    MOV  R1  R0    101
>>     23     4EE90004    SUB SP SP      4
>>     24     A0E00000    STR   R0 SP       0
>>     25     00000001    MOV  R0  R0  R1
>>     26     D700000B    BL  R11
>> (* ... *)
>>
>> So the problem is that the function pointer is loaded in the wrong
>> register. Replacing the PrepCall procedure in the ORG module with the
>> following code seems to fix it.
>>
>>     PROCEDURE PrepCall*(VAR x: Item; VAR r: LONGINT);
>>     BEGIN
>>       IF x.type.form = ORB.Proc THEN
>>         IF x.mode # ORB.Const THEN
>>           load(x); code[pc-1] := code[pc-1] + (11 - x.r) * 01000000H; x.r
>> := 11; DEC(RH); inhibitCalls := TRUE;
>>           IF check THEN Trap(EQ, 5) END
>>         END
>>       ELSE ORS.Mark("not a procedure")
>>       END ;
>>       r := RH
>>     END PrepCall;
>>
>>
>> On 31-03-14 19:17, Volkert Barr wrote:
>>> Dear all,
>>>
>>> i have a "problem" with the evaluation of a "procedure variable" used as parameter in a procedure call.
>>>
>>> this case leads to a ABORT or TRAP in Line 1. Procedure variable is FunId.
>>>
>>> BEGIN
>>> (*1*) Texts.WriteRealFix(W, FunId(1.0), 5,3);
>>>     ...
>>> END...
>>>
>>> this case with the dummy assigment to "Test" gives the correct output
>>> BEGIN
>>>     Test := FunId(1.0);	
>>>     Texts.WriteRealFix(W, FunId(1.0), 5,3);
>>>     ...
>>> END...
>>>
>>> The complete code can be found in the appended Module
>>>
>>> Bug or Feature??
>>>
>>> I use the Oberon-Image (RISC.IMG) from Paul Reed´s "Project Oberon"-Website with the nice "Oberon RISC Emulator" from Peter De Wachter (thanks for it).
>>>
>>> BW,
>>> Volkert
>>> ----
>>>
>>> MODULE Scratch;
>>> IMPORT Texts, Oberon;
>>>
>>>       TYPE Function = PROCEDURE (x:REAL) : REAL;
>>>
>>>       VAR W: Texts.Writer;
>>> 	FunId : Function;
>>>
>>>       PROCEDURE RealId(x:REAL):REAL;
>>>       BEGIN
>>>           RETURN x
>>>       END RealId;
>>>
>>>
>>>       PROCEDURE DoIt*;
>>>       VAR
>>> 	Test : REAL;
>>>       BEGIN
>>> 	Test := FunId(1.0);			
>>> 	Texts.WriteRealFix(W, FunId(1.0), 5,3);
>>> 	Texts.WriteRealFix(W, RealId(1.0), 5,3);
>>> 	Texts.WriteLn(W);
>>> 	Texts.Append(Oberon.Log, W.buf)
>>>       END DoIt;
>>>
>>> BEGIN Texts.OpenWriter(W);
>>>         FunId := RealId;
>>> END Scratch.
>>>
>>>
>>>
>>> --
>>> Oberon at lists.inf.ethz.ch mailing list for ETH Oberon and related systems
>>> https://lists.inf.ethz.ch/mailman/listinfo/oberon
>> --
>> Oberon at lists.inf.ethz.ch mailing list for ETH Oberon and related systems
>> https://lists.inf.ethz.ch/mailman/listinfo/oberon
>
> --
> Oberon at lists.inf.ethz.ch mailing list for ETH Oberon and related systems
> https://lists.inf.ethz.ch/mailman/listinfo/oberon