[Oberon] System Freeze in Oberon System

[Patrik Reali]

----- Original Message -----
Subject: Re: [Oberon] System Freeze in Oberon System

> Pieter Muller writes:

> Yes, this indeed seems to be a problem.  The Decoder shows that the
> problem is that the copying of the value parameter in dosomething
> is done from low memory to high memory.  In some circumstances this
> can also cause a crash in Native Oberon and Aos.
>
> A possible fix would be to do the copying in the other direction.
> Compiler-Patrik, are you listening? :-)

This time I was listening :-)
Anyway, till the end of october my time for Oberon will be rather limited,
and
I will be fixing the urgent problems.

I've prepared a fix for this problem for both OP2 and Paco. The only problem
is, I'm only able to test it on the compilers by bootstrapping them (which
was fine),
but have no chance to test it by compiling the whole system before two
weeks.
So it would be nice if somebody could please make a quick rebuild to
validate my fixes.

About the OP2 fix:
* in OPC.Enter, substitute MoveBlock with MoveBlockReversed
(this already solves the ploblem)
* in OPL.GenRepMovs, I wrote an optimized version that
tries to make REP MOVSBs for backwards moves whenever possible
(like in the forward REP MOV implementation). This change is optional
but recommended for performance reasons

About the Paco fix:
I took the stack-touch approach: beginning from the top of the destination
memory block, the block is touched every 4096 bytes (one memory page).
This approach is simpler to implement, as Paco has no reverse copy block
operation, and should also fit both back-ends (Bernhard please confirm for
the StrongARM!).

The proposed fixes are in the attachment.

Ciao,
  Patrik


---------------------------------------------------------------------

OP2 Changes:

OPC.Enter
(use MoveBlockReversed instead of MoveBlock)

	PROCEDURE Enter* (proc: OPT.Object; dataSize: LONGINT; node: OPT.Node);
		VAR par: OPT.Object; x, z, t0, t1, size: Item; step, scale: SHORTINT;  useRef: BOOLEAN;
	BEGIN (* !!later due to a bug this procedure looks no longer very nice *)
		useRef := (proc # NIL) & (proc.sysflag # 0);
		IF proc # NIL THEN 
			OPL.FixupLocalProcCall (proc); (* fixup local procedure calls and assign target pc to procedure *)
			par := proc.link
		ELSE par := NIL;
		END;
		Gen1 (enter, dataSize, node);
		WHILE par # NIL DO (* copy val parameter SDynArr, OpenArr *)
			IF par.mode = Var THEN
				IF (par.typ.comp IN {OpenArr, SDynArr}) THEN
					MakeVar(x, par);
					TypeSize(x, size, step, scale);
					ASSERT(step IN {OPO.Bit8, OPO.Bit16, OPO.Bit32});
					ASSERT(scale IN {OPO.Scale1, OPO.Scale2, OPO.Scale4});
					load(size);
					ASSERT(size.mode=Reg);
					Gen2(neg, t0, size);
					z.mode:=RegRel; z.adr:=ESP; z.inx:=t0.adr; z.scale:=scale; z.typ:=OPT.linttyp;
					loadAdr(z); OPL.Instr [pc-1].hint := OPL.useESP;
					IF step # OPO.Bit32 THEN			(*clear the last 2 bits -> grows down!*)
						z.typ := OPT.linttyp;
						MakeCon(t0, OPT.linttyp, -4);  t1 := z; Gen3 (and, z, t1, t0); OPL.Instr [pc-1].hint := OPL.useESP
					END;
					MoveBlockReversed(z, x, size, step);
					MakeVar(x, par); x.typ := OPT.linttyp;  z.mode:=Reg; z.adr:=ESP; Move(x, z)
				ELSIF par.typ.comp = DynArr THEN
					MakeCon(x, OPT.linttyp, 0); GenPush(x); (*allocate*)
					MakeVar(z, par);
					x.mode:=RegRel; x.adr:=ESP; x.offs:=0; x.inx:=none; x.typ:=par.typ; x.descReg:=none;
					CopyDynArr(x, z);
					GenPop(x);
					MakeVar(z, par); Move(z, x);
				ELSIF useRef & (par.typ.comp IN {StaticArr, Record}) THEN (* copy array, record *)
					z.mode := Var; z.typ := OPT.linttyp; z.node := NIL; z.adr := par.linkadr; z.mnolev := par.mnolev;
					x.mode := VarPar; x.typ := OPT.linttyp; x.adr := par.adr; x.node := NIL; x.mnolev := par.mnolev;
					MakeCon (size, OPT.linttyp, par.typ.size);
					MoveBlockReversed (z, x, size, OPO.Bit8)
				END
			END;
			par := par.link
		END
	END Enter;


OPL.GenRepMovs

	PROCEDURE GenRepMovs (VAR instr: Instruction);
	(* repMovs *)
		VAR
			src, dest, nofElem, tmp: SHORTINT;
	BEGIN
		FindLoadReg (instr.dest, dest);
		ASSERT (dest IN {EAX..EDI});
		IF dest # EDI THEN
			IF instr.dest >= 0 THEN AssignThisReg (instr.dest, EDI)
			ELSE GetThisReg (EDI)
			END;
			OPO.GenMOV (RegReg, EDI, dest, noInx, noScale, noDisp, noImm);
			IF ~(dest IN {ESP, EBP}) THEN regTab [dest] := free END;
		END;
		FindLoadReg (instr.src1, src);
		ASSERT (src IN {EAX..EDI});
		IF src # ESI THEN
			IF instr.src1 >= 0 THEN AssignThisReg (instr.src1, ESI)
			ELSE GetThisReg (ESI)
			END;
			OPO.GenMOV (RegReg, ESI, src, noInx, noScale, noDisp, noImm);
			IF ~(src IN {ESP, EBP}) THEN regTab [src] := free END;
		END;
		FindLoadReg (instr.src2, nofElem);
		ASSERT (nofElem IN {EAX..EDI});
		IF nofElem # ECX THEN
			IF instr.src2 >= 0 THEN AssignThisReg (instr.src2, ECX)
			ELSE GetThisReg (ECX)
			END;
			OPO.GenMOV (RegReg, ECX, nofElem, noInx, noScale, noDisp, noImm);
			IF ~(nofElem IN {ESP, EBP}) THEN regTab [nofElem] := free END;
		END;
		IF (instr.inx = AL) & (instr.hint = noHint) THEN (*8-bit move, forward move*)
			GetReg8(tmp);
			OPO.GenMOV(RegReg, tmp, CL, noInx, noScale, noDisp, noImm);
			OPO.GenShiftRot(SHR, ImmReg, ECX, noBase, noInx, noScale, noDisp, 2);
			OPO.GenTyp1(AND, ImmReg, tmp, noBase, noInx, noScale, noDisp, 3);
			OPO.GenRepString(MOVS, EAX);
			OPO.GenMOV(RegReg, CL, tmp, noInx, noScale, noDisp, noImm);
			OPO.GenRepString(MOVS, AL);
			FreeReg(tmp)
		ELSIF (instr.inx = AL) & (instr.hint = 1) THEN (*8-bit move, backward move*)
			GetReg(tmp);
			OPO.GenMOV(RegReg, tmp, ECX, noInx, noScale, noDisp, noImm);
			OPO.GenShiftRot(SHR, ImmReg, tmp, noBase, noInx, noScale, noDisp, 2);
			OPO.GenTyp1(AND, ImmReg, CL, noBase, noInx, noScale, noDisp, 3);
			OPO.GenRepString(MOVS, AL);
			OPO.GenTyp1(SUB, ImmReg, ESI, noBase, noInx, noScale, noDisp, 3);
			OPO.GenTyp1(SUB, ImmReg, EDI, noBase, noInx, noScale, noDisp, 3);
			OPO.GenMOV(RegReg, ECX, tmp, noInx, noScale, noDisp, noImm);
			OPO.GenRepString(MOVS, EAX);
			FreeReg(tmp)
		ELSE
			OPO.GenRepString (MOVS, SHORT (instr.inx))
		END;
		IF regTab [ECX] = Occupied THEN FreeReg (ECX)
		ELSE DecReg (ECX) (* nofElem *)
		END;
		IF regTab [ESI] = Occupied THEN FreeReg (ESI)
		ELSE DecReg (ESI) (* src *)
		END;
		IF regTab [EDI] = Occupied THEN FreeReg (EDI)
		ELSE DecReg (EDI) (* dest *)
		END
	END GenRepMovs;


Paco changes:

PCC.LocalArray
PROCEDURE LocalArray*(code: Code;  par: PCT.Parameter);
VAR  x, size, dim: Item;  reg, mask: PCLIR.Register;  aligned: BOOLEAN;  offs: LONGINT;
	reg2, const: PCLIR.Register; begin, end: Label; skip: BOOLEAN;
BEGIN
	ASSERT(~par.ref);
	MakeItem(x, par, 0);  LoadAdr(code, x);  offs := x.offs;
		(*compute size*)
	dim.mode := RegRel;  dim.adr := x.breg;  dim.offs := x.boffs;  dim.type := PCT.Int32;
	GetArrayBaseSize(code, size, x);
	aligned := (size.mode = Const) & (size.value MOD 4 = 0);
	DOp(code, PCS.times, size, dim);
	skip := (size.mode = Const) & (size.value < 4096);
	Load(code, size);
	GenConv(code, PCLIR.convu, size, PCLIR.Address, FALSE);

	PCLIR.EmitLoadConst(code, const, PCLIR.Address, FALSE, 0);
	PCLIR.Emit12(code, PCLIR.add, reg2, PCLIR.SP, const);
	
		(*allocate*)
	PCLIR.Emit12(code, PCLIR.sub, reg, PCLIR.SP, size.adr);
	IF ~aligned THEN
		PCLIR.EmitLoadConst(code, mask, PCLIR.Address, FALSE, 0FFFFFFFCH);
		PCLIR.Emit12(code, PCLIR.and, reg, reg, mask);
	END;

	PCLIR.Emit01(code, PCLIR.loadsp, reg);
	IF ~skip THEN
	
		DefLabel(code, begin);
		
		PCLIR.EmitLoadConst(code, const, PCLIR.Address, FALSE, 1000H);
		PCLIR.Emit12(code, PCLIR.sub, reg2, reg2, const);
		
		end := code.pc;
		PCLIR.Emit02C(code, PCLIR.jb, reg2, PCLIR.SP, -1);
		
		PCLIR.EmitLoadConst(code, const, PCLIR.Int8, FALSE, 1000H);
		PCLIR.EmitStoreRelative(code, 0, reg2, const);
		
		PCLIR.Emit0C(code, PCLIR.jmp, begin);
		
		PCLIR.FixList(code, end, code.pc);
		PCLIR.Emit0C(code, PCLIR.label, 0);
	
	END;
		(*move*)
	PCLIR.Emit03(code, PCLIR.move, x.adr, reg, size.adr);
		(*store address*)
	PCLIR.EmitStoreRelative(code, offs, PCLIR.FP, PCLIR.SP)
END LocalArray;

----- End of forwarded message from Patrik Reali -----