DIRECTORY
PrincOps
USING [
CSegPrefix, FrameHandle, GFT, GFTIndex, GlobalFrameHandle, MainBodyIndex, NullFrame, NullGlobalFrame, sCopy, SD, sGFTLength, sSelfDestruct, sUnNew],
PrincOpsUtils
USING [
Alloc, BITAND, Codebase, COPY, EnterGlobalFrame, Free, GetFrame, GetReturnFrame, GFTFull, GlobalFrame, InvalidGlobalFrame, MakeFsi, RemoveGlobalFrame, SetReturnLink, UnNew, ValidateGlobalFrame];
zCopy:
ENTRY
PROC [old: GlobalFrameHandle]
RETURNS [new: GlobalFrameHandle] =
conceptually, Copy is PUBLIC, but it is accessed via the System Dispatch table.
BEGIN
AllocGlobalFrame:
PROC [old: GlobalFrameHandle, cp:
LONG
POINTER
TO CSegPrefix]
RETURNS [frame: GlobalFrameHandle, linkspace: CARDINAL] = {
pbody: LONG POINTER = cp + CARDINAL[cp.entry[MainBodyIndex].initialpc];
nlinks: CARDINAL = cp.header.info.nlinks;
linkspace ← IF old.codelinks THEN 0 ELSE nlinks + BITAND[-LOOPHOLE[nlinks, INTEGER], 3B];
frame ← Alloc[MakeFsi[(pbody - 1)^ + linkspace]];
};
linkspace: CARDINAL;
codebase: LONG POINTER TO CSegPrefix;
ValidateGlobalFrame[old ! InvalidGlobalFrame => GO TO invalid];
codebase ← Codebase[LOOPHOLE[old, PROGRAM]];
[new, linkspace] ← AllocGlobalFrame[old, codebase];
new ← new + linkspace;
new^ ← [
gfi: , alloced: TRUE, shared: TRUE, copied: TRUE, started: FALSE,
trapxfers: FALSE, codelinks: old.codelinks, code: old.code, global:];
new.code.out ← TRUE; -- cause start trap
new.global[0] ← NullGlobalFrame;
IF linkspace ~= 0
THEN
COPY[from: old - linkspace, to: new - linkspace, nwords: linkspace];
[] ← EnterGlobalFrame[new, codebase.header.info.ngfi ! GFTFull => GO TO full];
old.shared ← TRUE;
EXITS
invalid => RETURN WITH ERROR InvalidGlobalFrame[old];
full => RETURN WITH ERROR GFTFull;
END;
zUnNew:
ENTRY
PROC [frame: GlobalFrameHandle] =
conceptually, (z)UnNew is PUBLIC, but is accessed via the System Dispatch table.
BEGIN
sharer: GlobalFrameHandle ← NullGlobalFrame;
original: GlobalFrameHandle ← NullGlobalFrame;
copy: GlobalFrameHandle ← NullGlobalFrame;
codebase: LONG POINTER TO CSegPrefix;
nothers: CARDINAL ← 0;
nlinks: CARDINAL;
ValidateGlobalFrame[frame ! InvalidGlobalFrame => GO TO invalid];
codebase ← Codebase[LOOPHOLE[frame, PROGRAM]];
nlinks ← codebase.header.info.nlinks;
FOR gfi: GFTIndex
IN [1..
SD[sGFTLength])
DO
f: GlobalFrameHandle = GetFrame[GFT[gfi]];
IF frame = NullGlobalFrame OR GFT[gfi].epbias ~= 0 THEN LOOP;
IF f ~= frame
THEN {
IF f.global[0] = frame AND ~f.started THEN f.global[0] ← NullFrame;
IF Codebase[
LOOPHOLE[f,
PROGRAM]] = codebase
THEN
IF f.copied THEN copy ← f ELSE original ← f;
};
ENDLOOP;
IF original = NullGlobalFrame
AND ~frame.copied
AND copy # NullGlobalFrame
THEN
GO TO invalid;
RemoveGlobalFrame[frame];
IF frame.alloced
THEN {
Align: PROC [POINTER, WORD] RETURNS [POINTER] = LOOPHOLE[BITAND];
IF frame.codelinks THEN Free[frame]
ELSE Free[Align[frame - nlinks, 177774B]]
};
EXITS
invalid => RETURN WITH ERROR InvalidGlobalFrame[frame];
END;
zSelfDestruct:
PROC = {
conceptually, (z)SelfDestruct is PUBLIC, but is accessed via the System Dispatch table.
destructee: FrameHandle = GetReturnFrame[];
SetReturnLink[destructee.returnlink];
UnNew[LOOPHOLE[GlobalFrame[destructee]]];
Free[destructee];
};