-- NonResident.mesa; edited by Levin, January 25, 1979 8:31 AM
DIRECTORY
AllocDefs: FROM "allocdefs" USING [AllocHandle, AllocInfo, GetAllocationObject],
AltoDefs: FROM "altodefs" USING [BYTE, PageNumber, PageSize],
CodeDefs: FROM "codedefs" USING [
Codebase, CodeHandle, ReleaseCode],
ControlDefs: FROM "controldefs" USING [
Alloc, ControlLink, CSegPrefix, EntryVectorItem, EPRange, FrameCodeBase, FrameHandle, Free,
GetReturnFrame, GetReturnLink, GFT, GFTIndex, GFTItem, GlobalFrameHandle,
InstWord, Lreg, MainBodyIndex, MaxAllocSlot, NullEpBase, NullFrame,
NullGlobalFrame, Port, PortHandle, SD, StateVector],
CoreSwapDefs: FROM "CoreSwapDefs",
FrameDefs: FROM "framedefs" USING [FrameSize],
GlobalFrameDefs: FROM "GlobalFrameDefs" USING [GlobalFrameHandle],
ImageDefs: FROM "imagedefs",
InlineDefs: FROM "inlinedefs" USING [
BITAND, BITNOT, BITSHIFT, BITXOR, COPY, DIVMOD, LDIVMOD, LongCARDINAL,
LongDiv, LongDivMod, LongMult],
LoadStateDefs: FROM "loadstatedefs" USING [
ConfigIndex, ConfigNull, EnterGfi, InputLoadState, MapRealToConfig,
ReleaseLoadState],
MiscDefs: FROM "miscdefs",
Mopcodes: FROM "mopcodes" USING [zDADD, zDCOMP, zDSUB, zINC, zPORTI],
NucleusDefs: FROM "nucleusdefs",
ProcessDefs: FROM "processdefs" USING [DisableInterrupts, EnableInterrupts],
Resident: FROM "resident" USING [
AllocTrap, Break, CodeTrap, CSPort, level, MemorySwap, Restart, Start,
UnboundProcedureTrap, WBPort, WorryBreaker],
SDDefs: FROM "sddefs" USING [
sAllocTrap, sAlternateBreak, sBLTE, sBLTEC, sBreak, sBYTBLTE, sBYTBLTEC,
sControlFault, sCopy, sCoreSwap, SD, sDivSS, sError, sGFTLength,
sIOResetBits, sLongDiv, sLongDivMod, sLongMod, sLongMul, sRestart,
sStackError, sStart, sStringInit, sSwapTrap, sUnbound, sUnNew],
SegmentDefs: FROM "segmentdefs" USING [
DeleteFileSegment, EnumerateFileSegments, FileSegmentHandle, SwapIn, SwapError, Unlock],
TrapDefs: FROM "trapdefs" USING [UnboundProcedure],
XMESA: FROM "XMesaPrivateDefs" USING [ChocolateToVanilla, VanillaToChocolate, WhichWay,
XFileSegmentHandle, XMremote],
XMesaDefs: FROM "XMesaDefs" USING [DefaultBase0, DefaultXMBase, GetMemoryConfig,
LongAddressFromPage, LowHalfPtr, XFileSegmentAddress, XCOPY];
DEFINITIONS FROM ControlDefs;
NonResident: PROGRAM
IMPORTS AllocDefs, FrameDefs, LoadStateDefs, ResidentPtr: Resident, SegmentDefs,
TrapDefs, CodeDefs, XMESA, XMesaDefs --XM
EXPORTS FrameDefs, NucleusDefs, TrapDefs, XMESA, CoreSwapDefs
SHARES XMESA, ControlDefs, ImageDefs, Resident = BEGIN
-- Global Frame Table management
gftrover: CARDINAL ← 0; -- okay to start at 0 because incremented before used
NoGlobalFrameSlots: PUBLIC SIGNAL [CARDINAL] = CODE;
EnumerateGlobalFrames: PUBLIC PROCEDURE [
proc: PROCEDURE [GlobalFrameHandle] RETURNS [BOOLEAN]]
RETURNS [GlobalFrameHandle] =
BEGIN
i: GFTIndex;
frame: GlobalFrameHandle;
gft: POINTER TO ARRAY [0..0) OF GFTItem ← GFT;
FOR i IN [0..SD[SDDefs.sGFTLength]) DO
frame ← gft[i].frame;
IF frame # NullGlobalFrame AND gft[i].epbase = 0
AND proc[frame] THEN RETURN[frame];
ENDLOOP;
RETURN[NullGlobalFrame]
END;
EnterGlobalFrame: PUBLIC PROCEDURE [frame: GlobalFrameHandle, nslots: CARDINAL]
RETURNS [entryindex: GFTIndex] =
BEGIN
gft: POINTER TO ARRAY [0..0) OF GFTItem ← GFT;
i, imax, n, epoffset: CARDINAL;
i ← gftrover; imax ← SD[SDDefs.sGFTLength] - nslots; n ← 0;
DO
IF (i ← IF i>=imax THEN 1 ELSE i+1) = gftrover
THEN SIGNAL NoGlobalFrameSlots[nslots];
IF gft[i].frame # NullGlobalFrame THEN n ← 0
ELSE IF gft[i].epbase = NullEpBase THEN n ← 0
ELSE IF (n ← n+1) = nslots THEN EXIT;
ENDLOOP;
entryindex ← (gftrover←i)-nslots+1; epoffset ← 0;
FOR i IN [entryindex..gftrover] DO
gft[i] ← GFTItem[frame, epoffset];
epoffset ← epoffset + EPRange;
ENDLOOP;
RETURN
END;
RemoveGlobalFrame: PUBLIC PROCEDURE [frame: GlobalFrameHandle] =
BEGIN
gft: POINTER TO ARRAY [0..0) OF GFTItem ← GFT;
sd: POINTER TO ARRAY [0..0) OF CARDINAL ← SD;
i: CARDINAL;
FOR i ← frame.gfi, i+1
WHILE i<sd[SDDefs.sGFTLength] AND gft[i].frame=frame DO
gft[i] ← IF frame.copied THEN
GFTItem[NullGlobalFrame,0] ELSE GFTItem[NullGlobalFrame,NullEpBase];
ENDLOOP;
RETURN
END;
-- Traps
StackError: PUBLIC ERROR [FrameHandle] = CODE;
StackErrorTrap: PROCEDURE =
BEGIN
state: StateVector;
foo: BOOLEAN;
state ← STATE;
foo ← TRUE;
IF foo THEN ERROR StackError[GetReturnFrame[]];
END;
NullPort: PortHandle = LOOPHOLE[0];
PortFault: PUBLIC ERROR = CODE;
LinkageFault: PUBLIC ERROR = CODE;
ControlFault: PUBLIC SIGNAL [source: FrameHandle] RETURNS [ControlLink] = CODE;
PORTI: PROCEDURE = MACHINE CODE BEGIN Mopcodes.zPORTI END;
ControlFaultTrap: PROCEDURE =
BEGIN
errorStart, savedState: StateVector;
p, q: PortHandle;
sourceFrame, self: FrameHandle;
savedState ← STATE;
self ← REGISTER[Lreg];
IF PortCall[self.returnlink] THEN
BEGIN
p ← self.returnlink.port;
q ← p.dest.port;
sourceFrame ← p.frame;
IF q = NullPort THEN
errorStart.stk[0] ← LinkageFault
ELSE
BEGIN
q↑ ← Port[links[NullFrame,[indirect[port[p]]]]];
errorStart.stk[0] ← PortFault;
END;
errorStart.stk[1] ← 0;
errorStart.instbyte ← 0;
errorStart.stkptr ← 2;
errorStart.source ← sourceFrame.returnlink;
errorStart.dest ← SD[SDDefs.sError];
IF savedState.stkptr = 0 THEN
RETURN WITH errorStart -- RESPONDING port
ELSE
BEGIN
p.frame ← self;
TRANSFER WITH errorStart;
PORTI;
p.frame ← sourceFrame;
savedState.source ← p;
savedState.dest ← p.dest;
RETURN WITH savedState;
END;
END
ELSE
BEGIN
savedState.source ← self.returnlink;
savedState.dest ← SIGNAL ControlFault[savedState.source];
RETURN WITH savedState
END;
END;
PortCall: PROCEDURE [source: ControlLink] RETURNS [BOOLEAN] =
BEGIN
portcall: BOOLEAN ← FALSE;
WHILE source.tag = indirect DO
source ← source.link↑;
ENDLOOP;
IF source.tag = frame AND
FrameDefs.ReturnByte[source.frame,0] = Mopcodes.zPORTI THEN
portcall ← TRUE;
RETURN[portcall]
END;
ReturnByte: PUBLIC PROCEDURE [frame: FrameHandle, byteoffset: INTEGER]
RETURNS [byte: AltoDefs.BYTE] =
BEGIN
OPEN SegmentDefs;
g: GlobalFrameHandle = frame.accesslink;
iw: InstWord; --XM
bytePC: CARDINAL = byteoffset + (IF frame.pc<0
THEN 2*(-frame.pc)+1 ELSE 2*frame.pc);
XMesaDefs.XCOPY[from: CodeDefs.Codebase[g] + bytePC/2, to: LONG[@iw], nwords: SIZE[InstWord]];--XM
byte ← IF bytePC MOD 2 # 0 THEN iw.oddbyte ELSE iw.evenbyte;
CodeDefs.ReleaseCode[g];
RETURN
END;
-- Frame manipulation
InvalidGlobalFrame: PUBLIC SIGNAL [frame: GlobalFrameHandle] = CODE;
ValidateGlobalFrame: PUBLIC PROCEDURE [g: GlobalFrameHandle] =
BEGIN
IF ~ValidGlobalFrame[g] THEN SIGNAL InvalidGlobalFrame[g];
END;
ValidGlobalFrame: PROCEDURE [g: GlobalFrameHandle]
RETURNS[BOOLEAN] =
BEGIN
RETURN[LOOPHOLE[g, ControlLink].tag = frame AND g.gfi < SD[SDDefs.sGFTLength] AND --XM
GFT[g.gfi].frame = g] --XM
END;
GlobalFrame: PUBLIC PROCEDURE [link: UNSPECIFIED]
RETURNS [GlobalFrameHandle] =
BEGIN OPEN l: LOOPHOLE[link, ControlLink];
DO SELECT l.tag FROM
frame =>
BEGIN
IF link = 0 THEN RETURN[NullGlobalFrame];
IF ValidGlobalFrame[link] THEN RETURN[link];
IF ValidGlobalFrame[l.frame.accesslink] THEN
RETURN[l.frame.accesslink];
RETURN[NullGlobalFrame]
END;
procedure => RETURN[GFT[l.gfi].frame];
indirect => link ← l.link↑;
unbound => link ← SIGNAL TrapDefs.UnboundProcedure[link];
ENDCASE ENDLOOP
END;
Copy: PROCEDURE [old: GlobalFrameHandle] RETURNS [new: GlobalFrameHandle] =
BEGIN
linkspace: CARDINAL ← 0;
codebase: LONG POINTER TO CSegPrefix;
csegpfx: CSegPrefix; --XM
cseg: SegmentDefs.FileSegmentHandle; --XM
ValidateGlobalFrame[old];
codebase ← CodeDefs.Codebase[old];
[new, linkspace] ← AllocGlobalFrame[old, codebase];
IF ~old.codelinks THEN --XM
BEGIN
InlineDefs.COPY[from: old-linkspace, to: new, nwords: linkspace]; --XM
new ← new+linkspace; --XM
END;
cseg ← CodeDefs.CodeHandle[old];
new↑ ← [gfi:, unused: 0, alloced: TRUE, shared: TRUE, copied: TRUE,
started: FALSE, trapxfers: FALSE, codelinks: old.codelinks,
code:, codesegment: cseg, global:];
XMesaDefs.XCOPY[from: codebase, to: LONG[@csegpfx], nwords: SIZE[CSegPrefix]]; --XM
new.gfi ← FrameDefs.EnterGlobalFrame[new, csegpfx.ngfi]; --XM
new.code.offset ← XMesaDefs.LowHalfPtr[codebase] -
XMesaDefs.LowHalfPtr[XMesaDefs.XFileSegmentAddress[cseg]]; --XM
new.code.swappedout ← TRUE;
new.global[0] ← NullGlobalFrame;
old.shared ← TRUE;
CodeDefs.ReleaseCode[old];
RETURN
END;
MakeFsi: PUBLIC PROCEDURE [words: CARDINAL] RETURNS [fsi: CARDINAL] =
BEGIN
FOR fsi IN [0..MaxAllocSlot) DO
IF FrameDefs.FrameSize[fsi] >= words THEN RETURN;
ENDLOOP;
RETURN[words]
END;
AllocGlobalFrame: PROCEDURE [
old: GlobalFrameHandle, cp: LONG POINTER TO CSegPrefix]
RETURNS [frame: GlobalFrameHandle, linkspace: CARDINAL] =
BEGIN
size, nlinks: CARDINAL;
FrameSizePair: TYPE = MACHINE DEPENDENT RECORD[size2, size1: CARDINAL]; --XM
fsizes: FrameSizePair; --XM
csegpfx: CSegPrefix; --XM
mbEntry: EntryVectorItem; --XM
pbody: LONG POINTER; --XM
XMesaDefs.XCOPY[from: @cp.entry[MainBodyIndex], to: LONG[@mbEntry],
nwords: SIZE[EntryVectorItem]]; --XM
pbody ← cp+CARDINAL[mbEntry.initialpc]; --XM
XMesaDefs.XCOPY[from: pbody-2, to: LONG[@fsizes], nwords: SIZE[FrameSizePair]]; --XM
size ← IF mbEntry.framesize = MaxAllocSlot THEN fsizes.size2 ELSE fsizes.size1; --XM
XMesaDefs.XCOPY[from: cp, to: LONG[@csegpfx], nwords: SIZE[CSegPrefix]]; --XM
nlinks ← csegpfx.nlinks; --XM
linkspace ← nlinks + InlineDefs.BITAND[-LOOPHOLE[nlinks, INTEGER], 3B]; --XM
frame ← Alloc[MakeFsi[FrameDefs.FrameSize[size]+(IF old.codelinks THEN 0 ELSE linkspace)]]; --XM
RETURN
END;
UnNew: PROCEDURE [frame: GlobalFrameHandle] =
BEGIN
csegpfx: CSegPrefix; --XM
cseg: SegmentDefs.FileSegmentHandle;
sharer: GlobalFrameHandle ← NullGlobalFrame;
original: GlobalFrameHandle ← NullGlobalFrame;
copy: GlobalFrameHandle ← NullGlobalFrame;
codebase: LONG POINTER TO CSegPrefix;
fcb: FrameCodeBase;
nothers: CARDINAL ← 0;
nlinks: CARDINAL;
RemoveAllTraces: PROCEDURE [f: GlobalFrameHandle] RETURNS [BOOLEAN] =
BEGIN OPEN gf: LOOPHOLE[f, GlobalFrameDefs.GlobalFrameHandle];
seg: SegmentDefs.FileSegmentHandle;
IF f#frame THEN
BEGIN
IF f.global[0] = frame AND ~f.started THEN f.global[0] ← NullFrame;
seg ← CodeDefs.CodeHandle[f];
IF cseg = seg THEN
BEGIN
nothers ← nothers + 1; sharer ← f;
ProcessDefs.DisableInterrupts[];
IF (IF f.code.swappedout THEN gf.code.offset = fcb.offset
ELSE gf.code.codebase = LOOPHOLE[frame, GlobalFrameDefs.GlobalFrameHandle].code.codebase)
THEN IF f.copied THEN copy ← f ELSE original ← f;
ProcessDefs.EnableInterrupts[];
END;
END;
RETURN[FALSE];
END;
ValidateGlobalFrame[frame];
codebase ← CodeDefs.Codebase[frame];
XMesaDefs.XCOPY[from: codebase, to: LONG[@csegpfx], nwords: SIZE[CSegPrefix]]; --XM
nlinks ← csegpfx.nlinks; --XM
cseg ← CodeDefs.CodeHandle[frame];
fcb.offset ← frame.code.codebase - XMesaDefs.LowHalfPtr[XMesaDefs.XFileSegmentAddress[cseg]]; --XM
fcb.swappedout ← TRUE;
[] ← FrameDefs.EnumerateGlobalFrames[RemoveAllTraces];
CodeDefs.ReleaseCode[frame];
IF original = NullGlobalFrame AND ~frame.copied AND copy # NullGlobalFrame THEN
BEGIN OPEN LoadStateDefs;
config: ConfigIndex;
cgfi: GFTIndex;
copy.copied ← FALSE;
[] ← InputLoadState[];
[cgfi: cgfi, config: config] ← MapRealToConfig[frame.gfi];
EnterGfi[cgfi: 0, rgfi: frame.gfi, config: ConfigNull];
EnterGfi[cgfi: cgfi, rgfi: copy.gfi, config: config];
ReleaseLoadState[];
END;
IF frame.shared THEN
BEGIN
IF nothers = 1 THEN sharer.shared ← FALSE
END
ELSE
BEGIN OPEN SegmentDefs;
DeleteFileSegment[cseg ! SwapError => CONTINUE];
END;
FrameDefs.RemoveGlobalFrame[frame];
IF frame.alloced THEN
BEGIN
Align: PROCEDURE [POINTER, WORD] RETURNS [POINTER] =
LOOPHOLE[InlineDefs.BITAND];
IF frame.codelinks THEN Free[frame]
ELSE Free[Align[frame - nlinks, 177774B]]
END;
END;
MoveLockedCode: PUBLIC PROCEDURE [direction: XMESA.WhichWay] =
BEGIN OPEN SegmentDefs;
alloc: AllocDefs.AllocHandle ← AllocDefs.GetAllocationObject[];
CheckOne: PROCEDURE [fseg: FileSegmentHandle] RETURNS [BOOLEAN] =
BEGIN OPEN seg: LOOPHOLE[fseg, XMESA.XFileSegmentHandle];
ChangeFlavorProc: TYPE = PROCEDURE[newVMpage: AltoDefs.PageNumber] RETURNS [AltoDefs.PageNumber];
MoveThisSegment: PROCEDURE[basePage: AltoDefs.PageNumber, proc: ChangeFlavorProc] =
BEGIN OPEN XMesaDefs;
ResidentCodeInfo: AllocDefs.AllocInfo = [0, hard, bottomup, initial, code, TRUE, FALSE];
oldVMpage, newVMpage: AltoDefs.PageNumber;
delta: LONG INTEGER;
UpdateCodebase: PROCEDURE [f: GlobalFrameHandle] RETURNS [BOOLEAN] =
BEGIN OPEN frame: LOOPHOLE[f, GlobalFrameDefs.GlobalFrameHandle];
IF CodeDefs.CodeHandle[f] = fseg AND ~frame.code.swappedout THEN
SELECT direction FROM
up => frame.code.codebase ← LONG[frame.code.shortCodebase] + delta;
down =>
BEGIN
frame.code.codebase ← frame.code.codebase + delta;
IF frame.code.highHalf # 0 THEN ERROR;
frame.code.handle ← fseg;
END;
ENDCASE;
RETURN[FALSE]
END;
-- body of MoveThisSegment
SwapIn[fseg];
newVMpage ← alloc.alloc[basePage, fseg.pages, fseg, ResidentCodeInfo];
ProcessDefs.DisableInterrupts[];
oldVMpage ← proc[newVMpage];
XCOPY[from: LongAddressFromPage[oldVMpage],
to: LongAddressFromPage[newVMpage],
nwords: AltoDefs.PageSize * fseg.pages];
delta ← AltoDefs.PageSize * (LONG[LOOPHOLE[newVMpage,INTEGER]] - LONG[LOOPHOLE[oldVMpage,INTEGER]]);
[] ← EnumerateGlobalFrames[UpdateCodebase];
alloc.update[oldVMpage, fseg.pages, free, NIL];
alloc.update[newVMpage, fseg.pages, inuse, fseg];
ProcessDefs.EnableInterrupts[];
Unlock[fseg];
END;
-- body of CheckOne
IF seg.class = code AND seg.lock > 0 THEN
WITH s:seg SELECT FROM
disk =>
SELECT direction FROM
up =>
BEGIN
VtC: ChangeFlavorProc =
BEGIN
RETURN[XMESA.VanillaToChocolate[fseg, newVMpage]] -- note variant changes here!!
END;
MoveThisSegment[XMesaDefs.DefaultXMBase, VtC];
END;
down => NULL;
ENDCASE;
remote =>
IF s.proc = XMESA.XMremote THEN
SELECT direction FROM
up => NULL;
down =>
BEGIN
CtV: ChangeFlavorProc =
BEGIN
RETURN[XMESA.ChocolateToVanilla[@seg, newVMpage]] -- note variant changes here!!
END;
MoveThisSegment[XMesaDefs.DefaultBase0, CtV];
END;
ENDCASE;
ENDCASE;
RETURN[FALSE]
END;
-- body of MoveLockedCode
IF ~XMesaDefs.GetMemoryConfig[].useXM THEN RETURN;
[] ← EnumerateFileSegments[CheckOne];
END;
-- unimplemented instructions
BlockEqual: PROCEDURE [p1: POINTER, n: CARDINAL, p2: POINTER]
RETURNS [BOOLEAN] =
BEGIN
i: CARDINAL;
FOR i IN [0 .. n) DO
IF (p1+i)↑ # (p2+i)↑ THEN RETURN[FALSE]; ENDLOOP;
RETURN[TRUE]
END;
ByteArray: TYPE = PACKED ARRAY [0..0) OF AltoDefs.BYTE; --XM
PPA: TYPE = POINTER TO ByteArray; --XM
ByteBlockEqual: PROCEDURE [p1: PPA, n: CARDINAL, p2: PPA]
RETURNS [BOOLEAN] =
BEGIN
RETURN[BlockEqual[p1: p1, p2: p2, n: n/2] AND p1[n-1] = p2[n-1]]
END;
BlockEqualCode: PROCEDURE [p1: POINTER, n: CARDINAL, offset: CARDINAL]
RETURNS [result: BOOLEAN] =
BEGIN
frame: GlobalFrameHandle = GetReturnFrame[].accesslink;
codebase: LONG POINTER ← CodeDefs.Codebase[frame]+offset; --XM
i: CARDINAL;
imax, j: CARDINAL; --XM
bsize: CARDINAL = 10; --XM
codeblock: ARRAY [0..bsize) OF UNSPECIFIED; --XM
FOR j ← 0, j+bsize UNTIL j >= n --XM
DO --XM
imax ← MIN[bsize, n-j]; --XM
XMesaDefs.XCOPY[from: codebase+j, to: LONG[@codeblock[0]], nwords: imax]; --XM
FOR i IN [0..imax) --XM
DO IF codeblock[i] # (p1+j+i)↑ THEN GOTO NotEqual; ENDLOOP; --XM
REPEAT --XM
NotEqual => result ← FALSE; --XM
FINISHED => result ← TRUE; --XM
ENDLOOP; --XM
CodeDefs.ReleaseCode[frame];
RETURN
END;
ByteBlockEqualCode: PROCEDURE [p1: POINTER, n: CARDINAL, offset: CARDINAL]
RETURNS [result: BOOLEAN] =
BEGIN
frame: GlobalFrameHandle = GetReturnFrame[].accesslink;
i: CARDINAL;
codebase: LONG POINTER ← CodeDefs.Codebase[frame]+offset; --XM
imax, j: CARDINAL; --XM
bsize: CARDINAL = 10; --XM
codeblock: ARRAY [0..bsize) OF UNSPECIFIED; --XM
FOR j ← 0, j+bsize UNTIL j >= n/2 --XM
DO --XM
imax ← MIN[bsize, n/2-j]; --XM
XMesaDefs.XCOPY[from: codebase+j, to: LONG[@codeblock[0]], nwords: imax]; --XM
FOR i IN [0..imax) --XM
DO IF codeblock[i] # (p1+j+i)↑ THEN GOTO NotEqual; ENDLOOP; --XM
REPEAT --XM
NotEqual => result ← FALSE; --XM
FINISHED =>
result ← LOOPHOLE[p1, PPA][n-1] = LOOPHOLE[@codeblock, PPA][imax*2-1]; --XM
ENDLOOP; --XM
CodeDefs.ReleaseCode[frame];
RETURN
END;
-- data shuffling
StringInit: PROCEDURE [coffset, n: CARDINAL, reloc, dest: POINTER] =
BEGIN OPEN ControlDefs;
g: GlobalFrameHandle = GetReturnFrame[].accesslink;
i: CARDINAL;
codebase: LONG POINTER ← CodeDefs.Codebase[g]+coffset; --XM
imax, j: CARDINAL; --XM
bsize: CARDINAL = 10; --XM
codeblock: ARRAY [0..bsize) OF UNSPECIFIED; --XM
FOR j ← 0, j+bsize UNTIL j >= n --XM
DO --XM
imax ← MIN[bsize, n-j]; --XM
XMesaDefs.XCOPY[from: codebase+j, to: LONG[@codeblock[0]], nwords: imax]; --XM
FOR i IN [0..imax) --XM
DO (dest+j+i)↑ ← codeblock[i] + reloc; ENDLOOP; --XM
ENDLOOP; --XM
CodeDefs.ReleaseCode[g];
RETURN
END;
-- long, signed and mixed mode arithmetic
DIVMOD: PROCEDURE [n,d: CARDINAL] RETURNS [QR] =
LOOPHOLE[InlineDefs.DIVMOD];
LDIVMOD: PROCEDURE [nlow,nhigh,d: CARDINAL] RETURNS [QR] =
LOOPHOLE[InlineDefs.LDIVMOD];
QR: TYPE = RECORD [q, r: INTEGER];
PQR: TYPE = POINTER TO QR;
LongSignDivide: PROCEDURE [numhigh: INTEGER, pqr: PQR] =
BEGIN
negnum,negden: BOOLEAN ← FALSE;
IF negden ← (pqr.r < 0) THEN pqr.r ← -pqr.r;
IF negnum ← (numhigh < 0) THEN
BEGIN
IF pqr.q = 0 THEN numhigh ← -numhigh
ELSE BEGIN pqr.q ← -pqr.q; numhigh ← InlineDefs.BITNOT[numhigh] END;
END;
pqr↑ ← LDIVMOD[nlow: pqr.q, nhigh: numhigh, d: pqr.r];
-- following assumes TRUE = 1; FALSE = 0
IF InlineDefs.BITXOR[LOOPHOLE[negnum],LOOPHOLE[negden]] # 0 THEN
pqr.q ← -pqr.q;
IF negnum THEN pqr.r ← -pqr.r;
RETURN
END;
DivSS: PROCEDURE =
BEGIN
state: StateVector;
p: PQR;
t: CARDINAL;
state ← STATE;
state.stkptr ← t ← state.stkptr-1;
state.dest ← GetReturnLink[];
p ← @state.stk[t-1];
LongSignDivide[numhigh: (IF p.q<0 THEN -1 ELSE 0), pqr: p];
RETURN WITH state
END;
LongCARDINAL: TYPE = InlineDefs.LongCARDINAL;
DAdd: PROCEDURE [a,b: LongCARDINAL] RETURNS [LongCARDINAL] =
MACHINE CODE BEGIN Mopcodes.zDADD END;
DSub: PROCEDURE [a,b: LongCARDINAL] RETURNS [LongCARDINAL] =
MACHINE CODE BEGIN Mopcodes.zDSUB END;
DCompare: PROCEDURE [a,b: LongCARDINAL] RETURNS [{less, equal, greater}] =
MACHINE CODE BEGIN Mopcodes.zDCOMP; Mopcodes.zINC END;
DDivMod: PROCEDURE [num, den: LongCARDINAL]
RETURNS [quotient, remainder: LongCARDINAL] =
BEGIN OPEN InlineDefs;
negNum, negDen: BOOLEAN ← FALSE;
qq: CARDINAL;
count: [0..31);
lTemp: LongCARDINAL;
IF LOOPHOLE[num.highbits, INTEGER] < 0 THEN
BEGIN negNum ← TRUE; num ← DSub[[0,0],num]; END;
IF LOOPHOLE[den.highbits, INTEGER] < 0 THEN
BEGIN negDen ← TRUE; den ← DSub[[0,0],den]; END;
IF den.highbits = 0 THEN
BEGIN
[quotient.highbits, qq] ←
LongDivMod[[lowbits:num.highbits,highbits:0],den.lowbits];
[quotient.lowbits, remainder.lowbits] ←
LongDivMod[[lowbits:num.lowbits,highbits:qq],den.lowbits];
remainder.highbits ← 0;
END
ELSE
BEGIN
count ← 0;
quotient.highbits ← 0;
lTemp ← den;
WHILE lTemp.highbits # 0 DO -- normalize
lTemp.lowbits ←
BITSHIFT[lTemp.lowbits,-1] + BITSHIFT[lTemp.highbits,15];
lTemp.highbits ← BITSHIFT[lTemp.highbits,-1];
count ← count + 1;
ENDLOOP;
qq ← LongDiv[num,lTemp.lowbits]; -- trial quotient
qq ← BITSHIFT[qq,-count];
lTemp ← LongMult[den.lowbits,qq]; -- multiply by trial quotient
lTemp.highbits ← lTemp.highbits + den.highbits*qq;
UNTIL DCompare[lTemp, num] # greater DO
-- decrease quotient until product is small enough
lTemp ← DSub[lTemp,den];
qq ← qq - 1;
ENDLOOP;
quotient.lowbits ← qq;
remainder ← DSub[num,lTemp];
END;
IF BITXOR[LOOPHOLE[negNum],LOOPHOLE[negDen]] # 0 THEN
quotient ← DSub[[0,0],quotient];
IF negNum THEN remainder ← DSub[[0,0],remainder];
RETURN
END;
DDiv: PROCEDURE [a,b: LongCARDINAL] RETURNS [LongCARDINAL] =
BEGIN OPEN InlineDefs;
RETURN[DDivMod[a,b].quotient]
END;
DMod: PROCEDURE [a,b: LongCARDINAL] RETURNS [r: LongCARDINAL] =
BEGIN OPEN InlineDefs;
[remainder: r] ← DDivMod[a,b];
RETURN
END;
DMultiply: PROCEDURE [a,b: LongCARDINAL]
RETURNS [product: LongCARDINAL] =
BEGIN OPEN InlineDefs;
product ← LongMult[a.lowbits, b.lowbits];
product.highbits ←
product.highbits + a.lowbits*b.highbits + a.highbits*b.lowbits;
RETURN
END;
GetLevel: PUBLIC PROCEDURE RETURNS [INTEGER] =
BEGIN RETURN[ResidentPtr.level] END;
SetLevel: PUBLIC PROCEDURE [l: INTEGER] = BEGIN ResidentPtr.level ← l; END;
Init: PROCEDURE =
BEGIN OPEN SDDefs;
sd: POINTER TO ARRAY [0..0) OF UNSPECIFIED ← SD;
resident: POINTER TO FRAME [Resident] ← ResidentPtr;
sd[sStackError] ← StackErrorTrap;
sd[sControlFault] ← ControlFaultTrap;
sd[sBLTE] ← BlockEqual;
sd[sBYTBLTE] ← ByteBlockEqual;
sd[sBLTEC] ← BlockEqualCode;
sd[sBYTBLTEC] ← ByteBlockEqualCode;
sd[sStringInit] ← StringInit;
sd[sDivSS] ← DivSS;
sd[sLongMul] ← DMultiply;
sd[sLongDivMod] ← DDivMod;
sd[sLongMod] ← DMod;
sd[sLongDiv] ← DDiv;
sd[sCopy] ← Copy;
sd[sUnNew] ← UnNew;
BEGIN OPEN resident;
sd[sAllocTrap] ← AllocTrap[AllocTrap[NullFrame]];
sd[sSwapTrap] ← CodeTrap;
sd[sUnbound] ← UnboundProcedureTrap;
sd[sStart] ← Start;
sd[sRestart] ← Restart;
sd[sBreak] ← Break;
sd[sAlternateBreak] ← WorryBreaker[];
sd[sIOResetBits] ← 3;
LOOPHOLE[CSPort,Port].in ← MemorySwap;
LOOPHOLE[CSPort,Port].out ← @WBPort;
sd[sCoreSwap] ← LOOPHOLE[WBPort,Port].out ← @CSPort;
WBPort[NIL];
level ← -1;
END;
END;
-- Main Body;
Init[];
END...