Types
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
ProcID: TYPE ~ CirioNub.ProcID;
Block16: TYPE ~ CirioNub.Block16;
Block16Record: TYPE ~ CirioNub.Block16Record;
Block32: TYPE ~ CirioNub.Block32;
Block32Record: TYPE ~ CirioNub.Block32Record;
CallResult: TYPE ~ CirioNub.CallResult;
CallResultRecord: TYPE ~ CirioNub.CallResultRecord;
ReturnCode: TYPE ~ CirioNub.ReturnCode;
Wrapper: TYPE ~ CirioNubPrivate.Wrapper;
Tag: TYPE ~ CirioNubPrivate.Tag;
nullProcID: ProcID ~ CARD.LAST;
WrapperAndFWord:
TYPE ~
--WORD16--
MACHINE
DEPENDENT
RECORD [
wrapper: Wrapper,
fWord: PBasics.FWORD
];
Handle: TYPE ~ REF Object;
Object:
PUBLIC
TYPE ~
RECORD [
debuggee: ROPE,
streamIn: STREAM ← NIL,
streamOut: STREAM ← NIL,
procBeingCalled: ProcID ← nullProcID,
putBlockDeficit: CARD ← 0
];
Parameters
wordSize: PBasics.Word ← BYTES[PBasics.Word];
wordSizeMask: PBasics.Word ← PBasics.BITNOT[(wordSize-1)];
wellKnownDebuggee: ROPE ← ":4815";
defaultProtocolFamily: ATOM ← $ARPA;
FixDebuggeeRope:
PROC [family:
ATOM, debuggee:
ROPE]
RETURNS [fixed:
ROPE] ~ {
IF family # $ARPA THEN RETURN [debuggee];
IF Rope.IsEmpty[debuggee] THEN RETURN [wellKnownDebuggee];
IF Rope.Find[debuggee, ":"] = -1 THEN RETURN [Rope.Concat[debuggee, wellKnownDebuggee]];
RETURN [debuggee];
};
RoundUp:
PROC [x: PBasics.Word]
RETURNS [PBasics.Word] ~
INLINE {
RETURN[ PBasics.BITAND[x+(wordSize-1), LOOPHOLE[wordSizeMask]] ] };
Exported Procedures
Create:
PUBLIC
PROC [protocolFamily:
ATOM, debuggee:
ROPE, timeoutMsec:
CARD]
RETURNS [h: Handle] ~ {
IF protocolFamily = NIL THEN protocolFamily ← defaultProtocolFamily;
h ← NEW[Object ← [debuggee~FixDebuggeeRope[protocolFamily, debuggee]]];
{
ENABLE {
NetworkStream.Error, IO.Error => ERROR Error[$connectError];
NetworkStream.Timeout => ERROR Error[$timeout];
};
[in~h.streamIn, out~h.streamOut] ←
NetworkStream.CreateStreams[ protocolFamily, debuggee, $basicStream, timeoutMsec, NIL ];
};
??? Ought to be some sort of handshake here ???
};
Destroy:
PUBLIC
PROC [h: Handle] ~ {
ENABLE IO.Error, IO.EndOfStream, NetworkStream.Error, NetworkStream.Timeout => CONTINUE;
s: STREAM;
s ← h.streamIn; h.streamIn ← NIL; IO.Close[s, TRUE];
s ← h.streamOut; h.streamOut ← NIL; IO.Close[s, TRUE];
};
StartCall:
PUBLIC
PROC [h: Handle, procID: ProcID] ~ {
IF h.streamOut = NIL THEN ERROR Error[$noConnectionFromStartCall];
h.putBlockDeficit ← 0;
IF h.procBeingCalled # nullProcID THEN ERROR;
h.procBeingCalled ← procID;
};
MakeUpPutBlockDeficit:
PROC [h: Handle] ~ {
buf: CARD32 ← 0;
WHILE h.putBlockDeficit > 0
DO
len: INT ~ MIN[h.putBlockDeficit, 4];
TRUSTED {
IO.UnsafePutBlock[h.streamOut, [base~LOOPHOLE[LONG[@buf]], startIndex~0, count~len] ];
};
h.putBlockDeficit ← h.putBlockDeficit - len;
ENDLOOP;
};
Put32Inner:
PROC [h: Handle, card32:
CARD32, tag: Tag] ~ {
DoPut32Inner:
PROC ~ {
wf: WrapperAndFWord ← [
wrapper ~ [
tag ~ PBasics.HFromCard16[ORD[tag]],
len ~ PBasics.HFromCard16[BYTES[CARD32]] ],
fWord ~ PBasics.FFromCard32[card32]
];
IF h.streamOut = NIL THEN ERROR Error[$noConnectionFromPut32Inner];
IF h.putBlockDeficit # 0 THEN MakeUpPutBlockDeficit[h];
TRUSTED {
IO.UnsafePutBlock[h.streamOut,
[base~LOOPHOLE[LONG[@wf]], startIndex~0, count~BYTES[WrapperAndFWord]] ];
};
};
CallEnabled[DoPut32Inner];
PutCard32:
PUBLIC
PROC [h: Handle, card32:
CARD32] ~ {
Put32Inner[h, card32, card32];
};
PutInt32:
PUBLIC
PROC [h: Handle, int32:
INT32] ~ {
Put32Inner[h, LOOPHOLE[int32, CARD32], int32];
};
PutRope:
PUBLIC
PROC [h: Handle, rope:
ROPE] ~ {
DoPutRope:
PROC ~ {
len: CARD16 ← CARD16[Rope.Length[rope]];
w: Wrapper ← [
tag ~ PBasics.HFromCard16[ORD[Tag.string]],
len ~ PBasics.HFromCard16[len]
];
IF h.streamOut = NIL THEN ERROR Error[$noConnectionFromPutRope];
IF h.putBlockDeficit # 0 THEN MakeUpPutBlockDeficit[h];
TRUSTED {
IO.UnsafePutBlock[h.streamOut, [base~LOOPHOLE[LONG[@w]], startIndex~0, count~BYTES[Wrapper]] ];
};
h.putBlockDeficit ← RoundUp[len];
IO.PutRope[h.streamOut, rope];
h.putBlockDeficit ← h.putBlockDeficit - len;
};
CallEnabled[DoPutRope];
};
PutBlock8:
PUBLIC
PROC [h: Handle, block8:
REF
TEXT] ~ {
DoPutBlock8:
PROC ~ {
len: CARD16 ← block8.length;
w: Wrapper ← [
tag ~ PBasics.HFromCard16[ORD[Tag.block8]],
len ~ PBasics.HFromCard16[len]
];
IF h.streamOut = NIL THEN ERROR Error[$noConnectionFromPutBlock8];
IF h.putBlockDeficit # 0 THEN MakeUpPutBlockDeficit[h];
TRUSTED {
IO.UnsafePutBlock[h.streamOut, [base~LOOPHOLE[LONG[@w]], startIndex~0, count~BYTES[Wrapper]] ];
};
h.putBlockDeficit ← RoundUp[len];
IO.PutText[h.streamOut, block8];
h.putBlockDeficit ← h.putBlockDeficit - len;
};
CallEnabled[DoPutBlock8];
};
PutBlock8Cnt:
PUBLIC
PROC [h: Handle, cnt:
CARDINAL] ~ {
DoPutBlock8Cnt:
PROC ~ {
w: Wrapper ← [
tag ~ PBasics.HFromCard16[ORD[Tag.block8]],
len ~ PBasics.HFromCard16[CARD16[cnt]]
];
IF h.streamOut = NIL THEN ERROR Error[$noConnectionFromPutBlock8Cnt];
IF h.putBlockDeficit # 0 THEN MakeUpPutBlockDeficit[h];
TRUSTED {
IO.UnsafePutBlock[h.streamOut, [base~LOOPHOLE[LONG[@w]], startIndex~0, count~BYTES[Wrapper]] ];
};
h.putBlockDeficit ← RoundUp[cnt];
};
CallEnabled[DoPutBlock8Cnt];
};
PutBlock8Next:
PUBLIC
PROC [h: Handle, byte:
BYTE] ~ {
DoPutBlock8Next:
PROC ~ {
IF h.streamOut = NIL THEN ERROR Error[$noConnectionFromPutBlock8Next];
IF h.putBlockDeficit < 1 THEN ERROR Error[$putBlockErrorFromPutBlock8Next];
IO.PutChar[h.streamOut, VAL[byte]];
h.putBlockDeficit ← h.putBlockDeficit - 1;
};
CallEnabled[DoPutBlock8Next];
};
PutBlock16:
PUBLIC
PROC [h: Handle, block16: Block16] ~ {
DoPutBlock16:
PROC ~ {
len: CARD16 ← block16.count*BYTES[CARD16];
w: Wrapper ← [
tag ~ PBasics.HFromCard16[ORD[Tag.block16]],
len ~ PBasics.HFromCard16[len]
];
IF h.streamOut = NIL THEN ERROR Error[$noConnectionFromPutBlock16];
IF h.putBlockDeficit # 0 THEN MakeUpPutBlockDeficit[h];
TRUSTED {
IO.UnsafePutBlock[h.streamOut, [base~LOOPHOLE[LONG[@w]], startIndex~0, count~BYTES[Wrapper]] ];
};
h.putBlockDeficit ← RoundUp[len];
FOR i:
NAT
IN [0 .. block16.count)
DO
x: PBasics.HWORD ← PBasics.HFromCard16[block16[i]];
TRUSTED {IO.UnsafePutBlock[h.streamOut, [base~LOOPHOLE[LONG[@x]], startIndex~0, count~BYTES[CARD16]]]};
ENDLOOP;
h.putBlockDeficit ← h.putBlockDeficit - len;
};
CallEnabled[DoPutBlock16];
};
hEqC16: BOOL [TRUE..TRUE] ~ BYTES[CARD16] = BYTES[PBasics.HWORD];
PutBlock16Cnt:
PUBLIC
PROC [h: Handle, cnt:
CARDINAL] ~ {
DoPutBlock16Cnt:
PROC ~ {
w: Wrapper ← [
tag ~ PBasics.HFromCard16[ORD[Tag.block16]],
len ~ PBasics.HFromCard16[CARD16[cnt]]
];
IF h.streamOut = NIL THEN ERROR Error[$noConnectionFromPutBlock16Cnt];
IF h.putBlockDeficit # 0 THEN MakeUpPutBlockDeficit[h];
TRUSTED {
IO.UnsafePutBlock[h.streamOut, [base~LOOPHOLE[LONG[@w]], startIndex~0, count~BYTES[Wrapper]] ];
};
h.putBlockDeficit ← RoundUp[cnt];
};
CallEnabled[DoPutBlock16Cnt];
};
PutBlock16Next:
PUBLIC
PROC [h: Handle, card16:
CARD16] ~ {
DoPutBlock16Next:
PROC ~ {
it: PBasics.HWORD;
IF h.streamOut = NIL THEN ERROR Error[$noConnectionFromPutBlock16Next];
IF h.putBlockDeficit < BYTES[PBasics.HWORD] THEN ERROR Error[$putBlockErrorFromPutBlock16Next];
it ← PBasics.HFromCard16[card16];
TRUSTED {
IO.UnsafePutBlock[h.streamOut, [base~LOOPHOLE[LONG[@it]], startIndex~0, count~BYTES[PBasics.HWORD]] ];
};
h.putBlockDeficit ← h.putBlockDeficit - BYTES[PBasics.HWORD];
};
CallEnabled[DoPutBlock16Next];
};
PutBlock32:
PUBLIC
PROC [h: Handle, block32: Block32] ~ {
DoPutBlock32:
PROC ~ {
len: CARD16 ← block32.count*BYTES[CARD32];
w: Wrapper ← [
tag ~ PBasics.HFromCard16[ORD[Tag.block32]],
len ~ PBasics.HFromCard16[len]
];
IF h.streamOut = NIL THEN ERROR Error[$noConnectionFromPutBlock32];
IF h.putBlockDeficit # 0 THEN MakeUpPutBlockDeficit[h];
TRUSTED {
IO.UnsafePutBlock[h.streamOut, [base~LOOPHOLE[LONG[@w]], startIndex~0, count~BYTES[Wrapper]] ];
};
h.putBlockDeficit ← RoundUp[len];
FOR i:
NAT
IN [0 .. block32.count)
DO
f: PBasics.FWORD ← PBasics.FFromCard32[block32[i]];
TRUSTED {IO.UnsafePutBlock[h.streamOut, [base~LOOPHOLE[LONG[@f]], startIndex~0, count~BYTES[CARD32]]]};
ENDLOOP;
h.putBlockDeficit ← h.putBlockDeficit - len;
};
CallEnabled[DoPutBlock32];
};
fEqCard32: BOOL[TRUE..TRUE] ~ BYTES[CARD32] = BYTES[PBasics.FWORD];
PutBlock32Cnt:
PUBLIC
PROC [h: Handle, cnt:
CARDINAL] ~ {
DoPutBlock32Cnt:
PROC ~ {
w: Wrapper ← [
tag ~ PBasics.HFromCard16[ORD[Tag.block32]],
len ~ PBasics.HFromCard16[CARD16[cnt]]
];
IF h.streamOut = NIL THEN ERROR Error[$noConnectionFromPutBlock32Cnt];
IF h.putBlockDeficit # 0 THEN MakeUpPutBlockDeficit[h];
TRUSTED {
IO.UnsafePutBlock[h.streamOut, [base~LOOPHOLE[LONG[@w]], startIndex~0, count~BYTES[Wrapper]] ];
};
h.putBlockDeficit ← RoundUp[cnt];
};
CallEnabled[DoPutBlock32Cnt];
};
PutBlock32Next:
PUBLIC
PROC [h: Handle, card32:
CARD32] ~ {
DoPutBlock32Next:
PROC ~ {
it: PBasics.FWORD;
IF h.streamOut = NIL THEN ERROR Error[$noConnectionFromPutBlock32Next];
IF h.putBlockDeficit < BYTES[PBasics.FWORD] THEN ERROR Error[$putBlockErrorFromPutBlock32Next];
it ← PBasics.FFromCard32[card32];
TRUSTED {
IO.UnsafePutBlock[h.streamOut,
[base~LOOPHOLE[LONG[@it]], startIndex~0, count~BYTES[PBasics.FWORD]] ];
};
h.putBlockDeficit ← h.putBlockDeficit - BYTES[PBasics.FWORD];
};
CallEnabled[DoPutBlock32Next];
Get32:
PROC [h: Handle]
RETURNS [
CARD32] ~ {
ENABLE NetworkStream.Error, IO.Error, IO.EndOfStream => ERROR Error[$communicationFailureFromGet32];
it: PBasics.FWORD;
IF h.streamIn = NIL THEN ERROR Error[$noConnectionFromGet32];
TRUSTED {
nRead: INT ← IO.UnsafeGetBlock[h.streamIn, [base~LOOPHOLE[LONG[@it]], startIndex~0, count~BYTES[PBasics.FWORD]] ];
IF nRead # BYTES[PBasics.FWORD] THEN ERROR Error[$protocolFromGet32];
};
RETURN[ PBasics.Card32FromF[it] ];
};
GetBlock8:
PROC [h: Handle, len:
CARD16]
RETURNS[block8:
REF
TEXT] ~ {
DoGetBlock8:
PROC ~ {
roundedLen: INT ← RoundUp[len];
IF h.streamIn = NIL THEN ERROR Error[$noConnectionFromGetBlock8];
block8 ← RefText.New[roundedLen];
TRUSTED {
nRead: INT ← IO.UnsafeGetBlock[h.streamIn, [base~LOOPHOLE[block8], startIndex~BYTES[TEXT[0]], count~roundedLen] ];
IF nRead # roundedLen THEN ERROR Error [$protocolFromGetBlock8];
};
block8.length ← len;
};
CallEnabled[DoGetBlock8];
};
GetBlock16:
PROC [h: Handle, len:
CARD16]
RETURNS[block16: Block16] ~ {
DoGetBlock16:
PROC ~ {
roundedLen: INT ← RoundUp[len];
IF h.streamIn = NIL THEN ERROR Error[$noConnectionFromGetBlock16];
block16 ← NEW[ Block16Record[roundedLen/BYTES[CARD16]] ];
TRUSTED {
nRead: INT ← IO.UnsafeGetBlock[h.streamIn, [base~LOOPHOLE[block16], startIndex~BYTES[Block16Record[0]], count~roundedLen] ];
IF nRead # roundedLen THEN ERROR Error [$protocolFromGetBlock16];
};
block16.count ← len / BYTES[CARD16];
FOR i:
CARDINAL
IN [0 .. block16.count)
DO
block16[i] ← PBasics.Card16FromH[LOOPHOLE[block16[i]]];
ENDLOOP;
};
CallEnabled[DoGetBlock16];
};
GetBlock32:
PROC [h: Handle, len:
CARD16]
RETURNS[block32: Block32] ~ {
DoGetBlock32:
PROC ~ {
roundedLen: INT ← RoundUp[len];
IF h.streamIn = NIL THEN ERROR Error[$noConnectionFromGetBlock32];
block32 ← NEW[ Block32Record[roundedLen/BYTES[CARD32]] ];
TRUSTED {
nRead: INT ← IO.UnsafeGetBlock[h.streamIn, [base~LOOPHOLE[block32], startIndex~BYTES[Block32Record[0]], count~roundedLen] ];
IF nRead # roundedLen THEN ERROR Error[$protocolFromGetBlock32];
};
block32.count ← len/BYTES[CARD32];
FOR i:
CARDINAL
IN [0 .. block32.count)
DO
block32[i] ← PBasics.Card32FromF[LOOPHOLE[block32[i]]];
ENDLOOP;
};
CallEnabled[DoGetBlock32];
};
Call:
PUBLIC
PROC [h: Handle]
RETURNS [rc: ReturnCode, result: CallResult] ~ {
DoCall:
PROC ~ {
AddRes:
PROC [r:
REF] ~ {
IF result.count >= result.maxCount
THEN {
oldRes: CallResult ← result;
result ← NEW[CallResultRecord[oldRes.maxCount*2]];
FOR i: CARDINAL IN [0 .. oldRes.count) DO result.val[i] ← oldRes.val[i] ENDLOOP;
result.count ← oldRes.count;
};
result.val[result.count] ← r;
result.count ← result.count.SUCC;
};
IF (h.streamIn = NIL) OR (h.streamOut = NIL)THEN ERROR Error[$noConnectionFromCall];
IF h.putBlockDeficit # 0 THEN MakeUpPutBlockDeficit[h];
Put32Inner[h, h.procBeingCalled, procID];
NetworkStream.SendSoon[h.streamOut, 0];
result ← NEW[CallResultRecord[10]];
result.count ← 0;
DO
w: Wrapper;
t: Tag;
len: CARDINAL;
TRUSTED {
nRead: INT ← IO.UnsafeGetBlock[ h.streamIn, [base~LOOPHOLE[LONG[@w]], startIndex~0, count~BYTES[Wrapper]] ];
IF nRead # BYTES[Wrapper] THEN ERROR Error[$protocol1FromCall];
};
t ← VAL[PBasics.Card16FromH[w.tag]];
len ← PBasics.Card16FromH[w.len];
SELECT t
FROM
retCode => { rc ← VAL[CARD16[Get32[h]]]; EXIT };
card32 => { AddRes[ NEW[CARD32 ← LOOPHOLE[Get32[h]]] ] };
int32 => { AddRes[ NEW[INT32 ← LOOPHOLE[Get32[h]]] ] };
string, block8 => { AddRes[ GetBlock8[h, len] ] };
block16 => { AddRes[ GetBlock16[h, len] ] };
block32 => { AddRes[ GetBlock32[h, len] ] };
ENDCASE => ERROR Error[$protocol2FromCall];
ENDLOOP;
h.procBeingCalled ← nullProcID;
};
CallEnabled[DoCall];
};