
<<DragomanXfer.mesa>>
<<Last Edited by: Sweet, March 5, 1985 8:52:56 am PST>>
    <<Bertrand Serlet July 27, 1985 11:12:08 pm PDT>>

DIRECTORY
DragomanPrivate,
DragomanRefTab,
BasicTime, PrincOps, PrincOpsUtils;

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;
LCB: TYPE = RI.LCB;

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]};

}.