[Oberon] Static variable overflow (bug?)
Andreas Pirklbauer
andreas_pirklbauer at yahoo.com
Thu Feb 27 10:42:39 CET 2020
Below is a slightly more elaborate variant that fixes the current bug in ORG.Put1a
and makes MyViewers.Mod (see below) work on a Project Oberon 2013 system:
PROCEDURE Put1a(op, a, b, im: LONGINT);
VAR r: INTEGER;
BEGIN (*same as Put1, but with range test -10000H <= im < 10000H*)
IF (im >= -10000H) & (im <= 0FFFFH) THEN Put1(op, a, b, im)
ELSIF op = Mov THEN
Put1(Mov+U, a, 0, im DIV 10000H);
IF im MOD 10000H # 0 THEN Put1(Ior, a, a, im MOD 10000H) END
ELSE r := RH;
IF b = RH THEN incR END ;
Put1(Mov+U, RH, 0, im DIV 10000H);
IF im MOD 10000H # 0 THEN Put1(Ior, RH, RH, im MOD 10000H) END ;
Put0(op, a, b, RH);
IF RH > r THEN DEC(RH) END
END
END Put1a;
Comments:
1. Procedure incR is to be moved up to before procedure ORG.Put0
2. The use of incR ensures that in fact we do have enough registers available
3. Register optimization: But a new register is used only when needed (when b = RH)
4. Instruction optimization: For op = Mov, the extra MOV instruction at the end is avoided
----------------------------------------------------------------------------------------------------------------------
A simple fix to make the program “MyViewer” below work, i.e. to allow variable
offsets < 64KB is to fix a bug in the current ORG.Put1a, by changing it
From:
PROCEDURE Put1a(op, a, b, im: LONGINT);
BEGIN (*same as Put1, but with range test -10000H <= im < 10000H*)
IF (im >= -10000H) & (im <= 0FFFFH) THEN Put1(op, a, b, im)
ELSE Put1(Mov+U, RH, 0, im DIV 10000H);
IF im MOD 10000H # 0 THEN Put1(Ior, RH, RH, im MOD 10000H) END ;
Put0(op, a, b, RH)
END
END Put1a;
To:
PROCEDURE Put1a(op, a, b, im: LONGINT);
BEGIN (*same as Put1, but with range test -10000H <= im < 10000H*)
IF (im >= -10000H) & (im <= 0FFFFH) THEN Put1(op, a, b, im)
ELSE Put1(Mov+U, RH+1, 0, im DIV 10000H);
IF im MOD 10000H # 0 THEN Put1(Ior, RH+1, RH+1, im MOD 10000H) END ;
Put0(op, a, b, RH+1)
END
END Put1a;
i.e. by replacing RH with RH+1 in the ELSE clause.
Note that this is a quick fix which neither checks whether there are in fact enough registers available (as incR does) nor does any register optimization. But it will make the program below work..
---------------------
MODULE MyViewer;
(* Test of the menu line of a viewer *)
IMPORT Display, Viewers, Oberon, MenuViewers, TextFrames;
CONST
max = 16377; (* If max >= 16367 the frame name disappears; If max >= 16377 the whole menu line disappears! *)
menu = "System.Close System.Copy System.Grow";
TYPE
XYframe = POINTER TO XYframeDesc;
XYframeDesc = RECORD (Display.FrameDesc) END;
VAR bitmap: ARRAY max OF SET; (* with this variable present the menu may remain empty! *)
PROCEDURE Restore(F: XYframe);
BEGIN
Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
Display.ReplConst(Display.black, F.X, F.Y, F.W, F.H, Display.replace); (* clear *)
END Restore;
PROCEDURE Handle(F: Display.Frame; VAR M: Display.FrameMsg);
VAR F1: XYframe;
BEGIN
CASE F OF XYframe:
CASE M OF
Oberon.InputMsg:
IF M.id = Oberon.track THEN Oberon.DrawMouseArrow(M.X, M.Y) END |
Oberon.CopyMsg:
Oberon.RemoveMarks(F.X, F.Y, F.W, F.H); NEW(F1); F1^ := F^; M.F := F1 |
MenuViewers.ModifyMsg:
IF (M.Y # F.Y) OR (M.H # F.H) THEN F.Y := M.Y; F.H := M.H; Restore(F) END
END
END
END Handle;
PROCEDURE Open*;
VAR F: XYframe; V: Viewers.Viewer; x, y: INTEGER;
BEGIN
NEW(F); F.handle := Handle;
Oberon.AllocateUserViewer(Oberon.Par.vwr.X, x, y);
V := MenuViewers.New(TextFrames.NewMenu("MyViewer", menu), F, TextFrames.menuH, x, y)
END Open;
END MyViewer.
More information about the Oberon
mailing list