DragomanXfer:
CEDAR PROGRAM
IMPORTS DragomanRefTab, RI: DragomanPrivate, BasicTime, PrincOpsUtils
EXPORTS DragomanPrivate = {
OPEN PrincOps;
Types and Global Data
Value: TYPE = RI.Value;
DValue: TYPE = RI.DValue;
Ptr1: TYPE = RI.Ptr1;
Ptr2: TYPE = RI.Ptr2;
LPtr1: TYPE = RI.LPtr1;
LPtr2: TYPE = RI.LPtr2;
Machine:
TYPE = RI.Machine;
Byte: TYPE = RI.Byte;
Bytes: TYPE = RI.Bytes;
Pair: TYPE = RI.Pair;
FieldDescriptor: TYPE = PrincOps.FieldDescriptor;
RestartInterpreter: PUBLIC SIGNAL [iFrame: FrameHandle] RETURNS [uFrame: FrameHandle] = CODE;
FetchLink:
PUBLIC
PROC [m: Machine, lki:
CARDINAL]
RETURNS [ControlLink] =
TRUSTED {
codeLinks: BOOLEAN;
RI.ReadAtAddress[m, LONG[m.g]];
codeLinks ← LOOPHOLE[m.g, GlobalFrameHandle].codelinks;
IF codeLinks
THEN
{
cp: LONG POINTER ← LOOPHOLE[m.cb - (lki+1)*SIZE[ControlLink]];
RETURN[LOOPHOLE[RI.Read[m, cp]]]}
ELSE
{
cps: POINTER ← LOOPHOLE[m.g - (lki+1)*SIZE[ControlLink]];
RETURN[LOOPHOLE[RI.Read[m, LONG[cps]]]]}
};
MakeProcDesc:
PUBLIC
PROC [m: Machine, gf: GlobalFrameHandle, entry:
CARDINAL]
RETURNS [ControlLink] =
TRUSTED {
gfi: GFTIndex;
RI.ReadAtAddress[m, LONG[gf]];
gfi ← gf.gfi;
RETURN [[procedure[gfi: gfi + entry / EPRange, ep: entry MOD EPRange, tag: TRUE]]]};
Xfer:
PUBLIC
PROC [m: Machine, dst, src: ControlLink, push:
BOOL ←
TRUE, free:
BOOL ←
FALSE] =
TRUSTED {
copied pretty much from PrincOps document version3.0c
nlf: FrameHandle;
nPc: CARDINAL;
GF: GlobalFrameHandle;
CB: FrameCodeBase;
nDst: ControlLink ← dst; -- final destination
GFTFrame:
PROC [gfti: GFTItem]
RETURNS [GlobalFrameHandle] =
TRUSTED {
gfti.epbias ← 0; RETURN [gfti.framePtr]};
ControlLinkType:
PROC [link: ControlLink]
RETURNS [ControlLinkTag] =
TRUSTED {
SELECT
TRUE
FROM
link.proc => RETURN [procedure];
link.indirect => RETURN [indirect];
ENDCASE => RETURN [frame]};
CBRep:
TYPE =
MACHINE
DEPENDENT
RECORD [
lo(0:0..14): [0..77777B], out(0:15..15): BOOL, hi(1): CARDINAL];
WHILE ~nDst.proc
AND nDst.indirect
DO
nDst ← LOOPHOLE[RI.Read[m, LOOPHOLE[LONG[nDst.link]]]];
ENDLOOP;
SELECT ControlLinkType[nDst]
FROM
procedure => {
evi: CARDINAL;
ev: EntryVectorItem;
gfti: GFTItem;
IF ~m.interestingGfi[nDst.gfi]
THEN {
CallDirectly[m, nDst];
RETURN};
RI.ReadAtAddress[m, LONG[@GFT[nDst.gfi]]];
gfti ← GFT[nDst.gfi];
m.g ← LOOPHOLE[GF ← GFTFrame[gfti]];
IF GF = NIL THEN RI.UnboundProcTrap[m, dst];
RI.DoubleReadAtAddress[m, LONG[@GF.code]];
CB ← GF.code;
IF
LOOPHOLE[
CB, CBRep].out
THEN {
LOOPHOLE[CB, CBRep].out ← FALSE;
START LOOPHOLE[GF, PROGRAM]}; -- let the start code run in microcode
m.cb ← LOOPHOLE[CB];
evi ← gfti.epbias * EPRange + nDst.ep;
RI.DoubleReadAtAddress[m, @LOOPHOLE[CB, LCB].entry[evi]];
ev ← LOOPHOLE[CB, LCB].entry[evi];
nPc ← ev.initialpc * 2;
IF nPc = 0 THEN RI.UnboundProcTrap[m, dst];
don't bother to record references for Alloc since Dragon uses other scheme
nlf ← RI.AllocFrame[ev.info.framesize];
RI.WriteAtAddress[m, LONG[@nlf.accesslink]];
nlf.accesslink ← GF;
RI.WriteAtAddress[m, LONG[@nlf.returnlink]];
nlf.returnlink ← src;
nlf.pc ← [nPc+1]; -- to make display lf get the right procedure
};
frame => {
IF nDst = LOOPHOLE[0] THEN RI.ControlTrap[m, src];
nlf ← LOOPHOLE[nDst];
RI.ReadAtAddress[m, LONG[@nlf.accesslink]];
m.g ← LOOPHOLE[GF ← nlf.accesslink];
RI.DoubleReadAtAddress[m, LONG[@GF.code]];
m.cb ← GF.code.longbase;
IF LOOPHOLE[CB, CBRep].out THEN CodeTrap[dst]
RI.ReadAtAddress[m, LONG[@nlf.pc]];
nPc ← nlf.pc;
IF nPc = 0 THEN RI.UnboundProcTrap[m, dst];
};
ENDCASE;
IF push
THEN {
RI.Push[m, LOOPHOLE[dst]];
RI.Push[m, LOOPHOLE[src]];
m.sd ← m.sd - 2};
IF free THEN RI.FreeFrame[LOOPHOLE[m.l]];
m.l ← LOOPHOLE[nlf];
RI.SetPc[m, nPc];
};
Pulses: PROC RETURNS [BasicTime.Pulses] = {RETURN [BasicTime.GetClockPulses[]]};
lastPulse: BasicTime.Pulses = LAST [BasicTime.Pulses]; -- 2**32 -1
DragomanRefTabSize: CARDINAL ← 101;
CallDirectly:
PROC [m: Machine, proc: ControlLink] =
TRUSTED {
m.outCalls ← m.outCalls + 1;
IF m.flushOnCall THEN RI.FlushAllCaches[m];
IF m.recordXferOut
THEN {
lc: DragomanRefTab.Ref ← LOOPHOLE[m.xferData];
found: BOOLEAN;
val: DragomanRefTab.Val;
IF lc =
NIL
THEN {
m.xferData ← lc ← DragomanRefTab.Create[DragomanRefTabSize];
found ← FALSE}
ELSE [found, val] ← DragomanRefTab.Fetch[lc, [link: proc]];
IF found THEN {val.lCount ← val.lCount + 1; val.time ← val.time + (lastPulse - Pulses[]) + 1}
ELSE [] ← DragomanRefTab.Store[lc, [link: proc], NEW [DragomanRefTab.ValRec ← [lCount: 1, time: (lastPulse - Pulses[]) + 1]]];
};
CallFromSimulatedStack[m, proc];
Xfer[m: m, dst: [frame[LOOPHOLE[m.l]]], src: NullLink, push: FALSE]; -- simulate return from called proc
IF m.recordXferOut
THEN {
lc: DragomanRefTab.Ref ← LOOPHOLE[m.xferData];
found: BOOLEAN;
val: DragomanRefTab.Val;
[found, val] ← DragomanRefTab.Fetch[lc, [link: proc]];
val.time ← val.time + Pulses[];
};
RETURN;
};
CallFromSimulatedStack:
PROC [m: Machine, proc: ControlLink] =
TRUSTED {
actualReturn: ControlLink ← PrincOpsUtils.GetReturnLink[];
LF: FrameHandle ← RI.FH[m.l];
PrincOpsUtils.SetReturnLink[[frame[LF]]]; -- to make signaller work
DoDirectCall[m, proc !
UNWIND => {
m.sd ← 0; -- after the unwind, stack should be empty
LOOPHOLE[m.l, FrameHandle] ← SIGNAL RestartInterpreter[LOOPHOLE[actualReturn]]}];
PrincOpsUtils.SetReturnLink[actualReturn];
RETURN;
};
DoDirectCall:
PROC [m: Machine, proc: ControlLink] =
TRUSTED {
extrajunk: INT ← 0; -- to move state vector to reasonable place
args, results: StateVector;
args ← [
stk: NULL,
instbyte: 0,
stkptr: m.sd,
data: lst[dest: proc, source: [frame[PrincOpsUtils.MyLocalFrame[ ]]]]];
FOR i:
CARDINAL
IN [0..
MIN[m.sd+2, 14])
DO
args.stk[i] ← m.stack[i];
ENDLOOP;
TRANSFER WITH args;
results ← STATE; -- could use same state vector once debugged
FOR i:
CARDINAL
IN [0..
MIN[results.stkptr+2, 14])
DO
m.stack[i] ← LOOPHOLE[results.stk[i]];
ENDLOOP;
m.sd ← results.stkptr;
RETURN;
};
LoadState:
PUBLIC
PROC [m: Machine, free:
BOOL] =
TRUSTED {
alpha: CARDINAL ← RI.NextOpByte[m];
st: POINTER TO StateVector = LOOPHOLE[m.l + alpha];
FOR i:
CARDINAL
IN [0..
MIN[st.stkptr+2, 14])
DO
RI.ReadLocal[m, alpha+i];
m.stack[i] ← LOOPHOLE[st.stk[i]];
ENDLOOP;
RI.ReadLocal[m, alpha+PrincOps.stackDepth];
m.sd ← st.stkptr;
IF ~free
THEN {
RI.WriteAtAddress[m, LONG[@LOOPHOLE[m.l, FrameHandle].pc]];
LOOPHOLE[m.l, FrameHandle].pc ← [m.pc]};
RI.ReadLocal[m, alpha+PrincOps.stackDepth+1];
RI.ReadLocal[m, alpha+PrincOps.stackDepth+2];
Xfer[m: m, dst: st.dest, src: st.source, push: FALSE, free: free]};
}.