-- MMTraps.Mesa; edited by Sandman on May 17, 1979 3:14 PM
-- Edited by Forrest on July 15, 1980 8:14 PM
DIRECTORY
AltoDefs USING [BYTE, PageSize],
ControlDefs USING [
AV, AVItem, ControlLink, ControlModule, EntryInfo, FrameHandle,
FrameVec, GFT, GFTIndex, GFTItem, GlobalFrameHandle, LargeReturnSlot,
MainBodyIndex, NullControl, NullFrame, NullGlobalFrame, PrefixHandle,
PrefixInfo, ProcDesc, SpecialReturnSlot, StateVector, SVPointer],
CoreSwapDefs USING [SVPointer],
FrameDefs,
FrameOps USING [
Free, GetReturnFrame, GetReturnLink, MyLocalFrame, SetReturnFrame, Start],
ImageDefs USING [PuntMesa],
InlineDefs USING [
BITNOT, BITOR, BITSHIFT, BITXOR, COPY, DIVMOD, LDIVMOD, LongDiv,
LongDivMod, LongMult, LongNumber],
MMInit,
MMSDEntries,
Mopcodes USING [zDESCBS, zKFCB, zRBL, zSFC],
ProcessDefs USING [DisableInterrupts, EnableInterrupts],
SDDefs USING [sAllocTrap, SD, sProcessBreakpoint],
SegmentDefs USING [
DataSegmentAddress, DataSegmentHandle, DeleteDataSegment,
DefaultBase, MakeDataSegment],
TrapDefs,
TrapOps USING [ReadATP, ReadOTP];
MMTraps: PROGRAM
IMPORTS FrameOps, ImageDefs, InlineDefs, ProcessDefs,
SegmentDefs, TrapOps
EXPORTS FrameDefs, FrameOps, MMInit, MMSDEntries, TrapDefs =
PUBLIC BEGIN OPEN ControlDefs;
-- allocation of frame space
LargeFrameSlot: CARDINAL = 12;
FrameSize: PUBLIC PROC [fsi: CARDINAL] RETURNS [CARDINAL] =
{ RETURN[FrameVec[fsi]] };
pgft: TYPE = POINTER TO ARRAY [0..0) OF GFTItem;
ItemPointer: TYPE = POINTER TO ControlDefs.AVItem;
FrameSegment: TYPE = MACHINE DEPENDENT RECORD [
segment: SegmentDefs.DataSegmentHandle,
link: POINTER TO FrameSegment,
size, fsi: CARDINAL];
-- maintain a list of all new "permanent" frame segments;
ExtraSpaceSize: CARDINAL = 128;
ExtraSpace: ARRAY [0..ExtraSpaceSize) OF WORD;
InitNewSpace: POINTER = LOOPHOLE[InlineDefs.BITOR[BASE[ExtraSpace],3]];
InitWordsLeft: CARDINAL = BASE[ExtraSpace]+ExtraSpaceSize-InitNewSpace;
NULLPtr: FrameHandle = LOOPHOLE[0];
AllocTrap: PROC [otherframe: FrameHandle]
RETURNS [myframe: FrameHandle] =
BEGIN OPEN ProcessDefs, SegmentDefs;
ATFrame: TYPE = POINTER TO FRAME [AllocTrap];
state: StateVector;
newframe: FrameHandle;
newseg: DataSegmentHandle;
long: BOOLEAN;
i, fsize, fIndex: CARDINAL;
p: POINTER;
newG: GlobalFrameHandle;
NewSpacePtr: POINTER;
WordsLeft: CARDINAL ← 0;
recurring: BOOLEAN ← otherframe = NULLPtr;
alloc: BOOLEAN;
dest, tempdest: ControlLink;
gfi: GFTIndex;
ep: CARDINAL;
myframe ← FrameOps.MyLocalFrame[];
state.dest ← myframe.returnlink;
state.source ← 0;
state.instbyte ← 0;
state.stk[0] ← myframe;
state.stkptr ← 1;
ProcessDefs.DisableInterrupts[]; -- so that undo below works
DO ENABLE ANY => ImageDefs.PuntMesa[];
IF ~recurring THEN
BEGIN
LOOPHOLE[otherframe, ATFrame].NewSpacePtr ← InitNewSpace;
LOOPHOLE[otherframe, ATFrame].WordsLeft ← InitWordsLeft;
AV[SpecialReturnSlot] ← [data[0,empty]];
END;
-- the following RR and POP is to guarantee that there is no NOOP between
-- the DWDC and the LST
[] ← TrapOps.ReadATP[];
ProcessDefs.EnableInterrupts[]; -- guarantees one more instruction
TRANSFER WITH state;
ProcessDefs.DisableInterrupts[];
state ← STATE;
dest ← TrapOps.ReadATP[];
SDDefs.SD[SDDefs.sAllocTrap] ← otherframe;
myframe.returnlink ← state.source;
tempdest ← dest;
DO
SELECT tempdest.tag FROM
frame =>
{ alloc ← TRUE; fIndex ← LOOPHOLE[tempdest, CARDINAL]/4; EXIT };
procedure =>
BEGIN OPEN proc: LOOPHOLE[tempdest, ProcDesc];
gfi ← proc.gfi; ep ← proc.ep;
[frame: newG, epbase: fIndex] ← GFT[gfi]; -- use fIndex as temp
long ← newG.code.highByte = 0;
IF long THEN
BEGIN
GetEntryInfo: PROC [LONG POINTER] RETURNS [EntryInfo] =
MACHINE CODE BEGIN Mopcodes.zRBL, 1 END;
info: EntryInfo ← GetEntryInfo[
@LOOPHOLE[newG.code.longbase, LONG PrefixHandle].entry[
fIndex + ep]];
fIndex ← info.framesize;
END
ELSE
fIndex ← LOOPHOLE[newG.code.shortbase, PrefixHandle].entry[
fIndex + ep].info.framesize;
alloc ← FALSE;
EXIT
END;
indirect => tempdest ← tempdest.link↑;
ENDCASE => ImageDefs.PuntMesa[];
ENDLOOP;
IF ~recurring THEN FlushLargeFrames[]
ELSE
IF (p ← AV[SpecialReturnSlot].link) # LOOPHOLE[AVItem[data[0,empty]]] THEN
BEGIN
WordsLeft ← WordsLeft + (NewSpacePtr-p+1);
NewSpacePtr ← p-1;
AV[SpecialReturnSlot] ← [data[0,empty]];
END;
IF fIndex < LargeFrameSlot THEN
BEGIN
fsize ← FrameVec[fIndex]+1; -- includes overhead word
THROUGH [0..1] DO
p ← NewSpacePtr+1;
IF fsize <= WordsLeft THEN
BEGIN
newframe ← p;
(p-1)↑ ← IF recurring THEN SpecialReturnSlot ELSE fIndex;
WordsLeft ← WordsLeft - fsize;
NewSpacePtr ← NewSpacePtr + fsize;
EXIT;
END
ELSE
BEGIN
IF recurring THEN ImageDefs.PuntMesa[];
FOR i DECREASING IN [0..fIndex) DO
IF FrameVec[i] < WordsLeft THEN
{ (p-1)↑ ← i; p↑ ← AV[i].link; AV[i].link ← p; EXIT };
ENDLOOP;
NewSpacePtr ←
(p←DataSegmentAddress[newseg←
MakeDataSegment[DefaultBase,1,[hard, bottomup, frame]]]) + 3;
WordsLeft ← AltoDefs.PageSize-3;
END;
ENDLOOP
END
ELSE
BEGIN
fsize ← FrameVec[fIndex];
p ← DataSegmentAddress[
newseg ← MakeDataSegment[
DefaultBase, (fsize + AltoDefs.PageSize + 3)/AltoDefs.PageSize,
[hard, bottomup, frame]]];
newframe ← p + 4;
LOOPHOLE[p, POINTER TO FrameSegment]↑ ←
[segment: newseg, link: NIL, size: fsize, fsi: LargeReturnSlot];
END;
IF alloc THEN
BEGIN
state.dest ← myframe.returnlink;
state.stk[state.stkptr] ← newframe;
state.stkptr ← state.stkptr+1;
END
ELSE
BEGIN
state.dest ← dest;
newframe.accesslink ← LOOPHOLE[AV[fIndex].link];
AV[fIndex].frame ← newframe;
state.source ← myframe.returnlink;
END;
SDDefs.SD[SDDefs.sAllocTrap] ← myframe;
ENDLOOP;
END;
FlushLargeFrames: PUBLIC PROC =
BEGIN
p: POINTER;
item: ItemPointer ← @AV[LargeReturnSlot];
WHILE item.tag = frame DO
p ← item.frame; item.frame ← p↑;
SegmentDefs.DeleteDataSegment[LOOPHOLE[(p-4)↑]];
ENDLOOP;
END;
-- other traps
UnboundProcedure: PUBLIC SIGNAL [dest: ControlLink] RETURNS [ControlLink] = CODE;
UnboundProcedureTrap: PROC =
BEGIN
dest: ControlLink;
state: StateVector;
ProcessDefs.DisableInterrupts[];
state ← STATE;
dest ← TrapOps.ReadOTP[];
[] ← ERROR UnboundProcedure[dest];
END;
CodeTrap: PROC =
BEGIN
dest: ControlLink;
state: StateVector;
frame: GlobalFrameHandle;
ProcessDefs.DisableInterrupts[];
state ← STATE;
dest ← TrapOps.ReadOTP[];
ProcessDefs.EnableInterrupts[];
state.dest ← dest;
state.source ← FrameOps.GetReturnLink[];
DO
SELECT dest.tag FROM
frame => BEGIN frame ← dest.frame.accesslink; EXIT END;
procedure => BEGIN frame ← GFT[dest.gfi].frame; EXIT END;
ENDCASE => dest ← dest.link↑;
ENDLOOP;
IF ~frame.started THEN FrameOps.Start[[frame[frame]]];
SwapInCode[frame];
RETURN WITH state;
END;
SwapInCode: PUBLIC PROC [f: GlobalFrameHandle] =
BEGIN
IF ~f.code.out THEN RETURN;
f.code.out ← FALSE;
f.code.shortbase ← f.code.handle + f.code.offset;
RETURN
END;
-- Getting the Debugger
Break: PROC =
-- executed by (non-worry) BRK instruction
BEGIN
ProcessBreakpoint: PROC [CoreSwapDefs.SVPointer] =
MACHINE CODE BEGIN Mopcodes.zKFCB, SDDefs.sProcessBreakpoint END;
f: FrameHandle;
state: StateVector;
state ← STATE;
state.dest ← f ← state.source;
state.source ← FrameOps.MyLocalFrame[];
f.pc ← [IF f.pc < 0 THEN -f.pc ELSE (1-f.pc)];
ProcessBreakpoint[@state];
RETURN WITH state
END;
StackError: PUBLIC ERROR = CODE;
StackErrorTrap: PROC =
{ state: StateVector; state ← STATE; ERROR StackError };
ControlFault: PUBLIC SIGNAL [source: FrameHandle] RETURNS [ControlLink] = CODE;
ControlFaultTrap: PROC =
BEGIN
savedState: StateVector;
savedState ← STATE;
[] ← ERROR ControlFault[FrameOps.MyLocalFrame[]];
END;
StartFault: PUBLIC SIGNAL [dest: GlobalFrameHandle] = CODE;
MainBody: PROCEDURE [GlobalFrameHandle] RETURNS [ControlLink] = MACHINE CODE
BEGIN Mopcodes.zDESCBS, MainBodyIndex END;
Call: PROCEDURE [ControlLink] = MACHINE CODE BEGIN Mopcodes.zSFC END;
Start: PUBLIC PROCEDURE [cm: ControlModule] =
BEGIN
state: StateVector;
state ← STATE;
IF ~cm.multiple THEN
BEGIN
IF cm.frame = NullGlobalFrame OR cm.frame.started THEN
ERROR StartFault[cm.frame];
-- FrameDefs.ValidateGlobalFrame[cm.frame];
StartCM[cm.frame.global[0], cm.frame, @state];
IF ~cm.frame.started THEN
BEGIN cm.frame.started ← TRUE; StartWithState[cm.frame, @state]; END
ELSE IF state.stkptr # 0 THEN SIGNAL StartFault[cm.frame];
END
ELSE
BEGIN
StartCM[cm, NIL, NIL];
IF state.stkptr # 0 THEN SIGNAL StartFault[cm.frame];
END;
RETURN
END;
StartCM: PROCEDURE [
cm: ControlModule, frame: GlobalFrameHandle, state: ControlDefs.SVPointer] =
BEGIN
SELECT TRUE FROM
cm = NullControl => RETURN;
cm.multiple =>
BEGIN
i, length: CARDINAL;
cm.multiple ← FALSE;
IF (length ← cm.list.nModules) = 0 THEN RETURN;
cm.list.nModules ← 0;
FOR i IN [0..length) DO
StartCM[[frame[cm.list.frames[i]]], frame, state]; ENDLOOP;
FrameOps.Free[cm.list];
END;
cm.frame.started => RETURN;
ENDCASE =>
BEGIN
control: ControlModule ← cm.frame.global[0];
IF control # cm THEN StartCM[control, frame, state];
IF ~cm.frame.started THEN
BEGIN
cm.frame.started ← TRUE;
IF frame # cm.frame THEN Call[MainBody[cm.frame]]
ELSE StartWithState[frame, state];
END;
END;
RETURN
END;
StartWithState: PROCEDURE [
frame: GlobalFrameHandle, state: ControlDefs.SVPointer] =
BEGIN OPEN ControlDefs;
s: StateVector ← state↑;
retFrame: FrameHandle ← FrameOps.GetReturnLink[].frame;
s.dest ← MainBody[frame];
s.source ← retFrame.returnlink;
FrameOps.Free[retFrame];
RETURN WITH s;
END;
Restart: PUBLIC PROCEDURE [dest: GlobalFrameHandle] =
BEGIN
stops: BOOLEAN;
frame: FrameHandle;
IF dest = NullGlobalFrame THEN ERROR StartFault[dest];
-- FrameDefs.ValidateGlobalFrame[dest];
IF ~dest.started THEN Start[[frame[dest]]];
-- FrameDefs.SwapInCode[dest];
IF dest.code.highByte = 0 THEN
BEGIN
GetPrefixInfo: PROC [LONG POINTER] RETURNS [PrefixInfo] =
MACHINE CODE BEGIN Mopcodes.zRBL, 1 END;
stops ← GetPrefixInfo[dest.code.longbase].stops;
END
ELSE stops ← LOOPHOLE[dest.code.shortbase, PrefixHandle].header.info.stops;
-- FrameOps.ReleaseCode[dest];
IF ~stops THEN ERROR StartFault[dest];
IF (frame ← dest.global[0]) # NullFrame THEN
BEGIN
frame.returnlink ← FrameOps.GetReturnLink[];
FrameOps.SetReturnFrame[frame];
END;
RETURN
END;
-- unimplemented instructions
BlockEqual: PROC [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;
PPA: TYPE = POINTER TO PACKED ARRAY [0..0) OF AltoDefs.BYTE;
ByteBlockEqual: PROC [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: PROC [p1: POINTER, n: CARDINAL, offset: CARDINAL]
RETURNS [BOOLEAN] =
BEGIN
frame: GlobalFrameHandle = FrameOps.GetReturnFrame[].accesslink;
RETURN[BlockEqual[p1: p1, n: n, p2: frame.code.shortbase+offset]]
END;
ByteBlockEqualCode: PROC [p1: POINTER, n: CARDINAL, offset: CARDINAL]
RETURNS [BOOLEAN] =
BEGIN
frame: GlobalFrameHandle = FrameOps.GetReturnFrame[].accesslink;
RETURN[ByteBlockEqual[p1: p1, n: n, p2: frame.code.shortbase+offset]]
END;
-- data shuffling
StringInit: PROC [coffset, n: CARDINAL, reloc, dest: POINTER] =
BEGIN OPEN ControlDefs;
g: GlobalFrameHandle = FrameOps.GetReturnFrame[].accesslink;
InlineDefs.COPY[from: g.code.shortbase+coffset, to: dest, nwords: n];
FOR i: CARDINAL IN [0..n) DO (dest+i)↑ ← (dest+i)↑ + reloc ENDLOOP;
RETURN
END;
-- long, signed and mixed mode arithmetic
DIVMOD: PROC [n,d: CARDINAL] RETURNS [QR] = LOOPHOLE[InlineDefs.DIVMOD];
LDIVMOD: PROC [nlow, nhigh,d: CARDINAL] RETURNS [QR] =
LOOPHOLE[InlineDefs.LDIVMOD];
QR: TYPE = RECORD [q, r: INTEGER];
PQR: TYPE = POINTER TO QR;
LongSignDivide: PROC [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[negnum, negden] # 0 THEN pqr.q ← -pqr.q;
IF negnum THEN pqr.r ← -pqr.r;
RETURN
END;
SignDivide: PROC =
BEGIN
state: ControlDefs.StateVector;
p: PQR;
t: CARDINAL;
state ← STATE;
state.stkptr ← t ← state.stkptr-1;
state.dest ← FrameOps.GetReturnLink[];
p ← @state.stk[t-1];
LongSignDivide[numhigh: (IF p.q<0 THEN -1 ELSE 0), pqr: p];
RETURN WITH state
END;
DDivMod: PROC [
num, den: Number] RETURNS [quotient, remainder: Number] =
BEGIN
negNum, negDen: BOOLEAN ← FALSE;
IF LOOPHOLE[num.highbits, INTEGER] < 0 THEN
BEGIN negNum ← TRUE; num.li ← -num.li; END;
IF LOOPHOLE[den.highbits, INTEGER] < 0 THEN
BEGIN negDen ← TRUE; den.li ← -den.li; END;
[quotient: quotient, remainder: remainder] ←
DUnsignedDivMod[num: num, den: den];
IF InlineDefs.BITXOR[negNum,negDen] # 0 THEN
quotient.li ← -quotient.li;
IF negNum THEN remainder.li ← -remainder.li;
RETURN
END;
DDiv: PROC [a,b: Number] RETURNS [Number] =
{ RETURN[DDivMod[a,b].quotient] };
DMod: PROC [a,b: Number] RETURNS [r: Number] =
{ [remainder: r] ← DDivMod[a,b]; RETURN };
DMultiply: PROC [a,b: Number] RETURNS [product: Number] =
BEGIN
product.lc ← InlineDefs.LongMult[a.lowbits, b.lowbits];
product.highbits ←
product.highbits + a.lowbits*b.highbits + a.highbits*b.lowbits;
RETURN
END;
Number: PRIVATE TYPE = InlineDefs.LongNumber;
DUnsignedDivMod: PROC [
num, den: Number] RETURNS [quotient, remainder: Number] =
BEGIN OPEN InlineDefs;
qq: CARDINAL;
count: [0..31);
lTemp: Number;
IF den.highbits = 0 THEN
BEGIN
[quotient.highbits, qq] ← LongDivMod[
LOOPHOLE[Number[num[lowbits:num.highbits, highbits:0]]], den.lowbits];
[quotient.lowbits, remainder.lowbits] ← LongDivMod[
LOOPHOLE[Number[num[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.lc, lTemp.lowbits]; -- trial quotient
qq ← BITSHIFT[qq, -count];
lTemp.lc ← LongMult[den.lowbits, qq]; -- multiply by trial quotient
lTemp.highbits ← lTemp.highbits + den.highbits*qq;
UNTIL lTemp.lc <= num.lc DO
-- decrease quotient until product is small enough
lTemp.lc ← lTemp.lc - den.lc;
qq ← qq - 1;
ENDLOOP;
quotient.lowbits ← qq;
remainder.lc ← num.lc - lTemp.lc;
END;
RETURN
END;
DUnsignedDiv: PROC [a,b: Number] RETURNS [Number] =
{ RETURN[DUnsignedDivMod[a,b].quotient] };
DUnsignedMod: PROC [a,b: Number] RETURNS [r: Number] =
{ [remainder: r] ← DUnsignedDivMod[a,b]; RETURN };
END....