[Oberon] Bug? procedure variable in procedure call parameter

[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