
<<TeleLoadImpl.mesa>>
    <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
<<Last Edited by: Stewart, December 26, 1983 4:11 pm>>
<<Last Edited by: Swinehart, May 16, 1986 11:21:30 am PDT>>

DIRECTORY
Basics USING [BITAND, BITSHIFT, HighByte, LongNumber, LowByte, LowHalf],
Endian USING [ FWORD ],
IO USING [card, int, PutF, STREAM],
Process USING [MsecToTicks, SetTimeout],
Pup USING [Address, nullHost, nullNet ],
PupBuffer USING [ Buffer ],
PupName USING [ AddressLookup, AddressToRope, Error, NameLookup ],
PupSocket USING [ Socket, Get, Send, Create, AllocBuffer, FreeBuffer, Destroy, SetUserSize ],
PupType USING [ Type ],
Rope USING [ROPE],
TeleLoad;

TeleLoadImpl: CEDAR MONITOR
IMPORTS Basics, IO, Process, PupName, PupSocket
EXPORTS TeleLoad = {
OPEN TeleLoad;

BitOp: TYPE = PROC [a, b: UNSPECIFIED] RETURNS [UNSPECIFIED];

And: BitOp = INLINE { RETURN[Basics.BITAND[a,b]]; };
Shift: BitOp = INLINE { RETURN[Basics.BITSHIFT[a,b]]; };

locMaxByte: PUBLIC NAT _ 150;
kingWaitTime: INT _ 200;    -- Packet exchange reply wait time

NameToAddress: PUBLIC PROC [name: Rope.ROPE] RETURNS [address: Pup.Address, ok: BOOL _ TRUE] = {
address _ PupName.NameLookup[name, teleSwatSocket !
PupName.Error => {ok _ FALSE; CONTINUE; }];
};

AddressToName: PUBLIC PROC [address: Pup.Address] RETURNS [nameRope, addressRope: Rope.ROPE] = {
nameRope _ PupName.AddressLookup[address];
addressRope _ PupName.AddressToRope[address];
};

Start: PUBLIC PROC [host: Rope.ROPE, log: IO.STREAM] RETURNS [h: Handle] = {
sendHim: Pup.Address;
allok: BOOL;
[sendHim, allok] _ NameToAddress[host];
sendHim.socket _ TeleLoad.teleSwatSocket;
IF NOT allok THEN RETURN[NIL];
h _ NEW[TLObject _ [
host: host,
address: sendHim,
cacheSize: locMaxByte,
log: log]];
RETURN[h];
};

Stop: PUBLIC PROC [h: Handle] = {
IF h=NIL THEN RETURN;
h.host _ NIL;
h.log _ NIL;
};

Store: PUBLIC ENTRY TeleLoadProc = {
ENABLE UNWIND => NULL;
[ok, attempts] _ GStore[h: h, requestcb: cb, type: coreStoreRequest, tries: tries];
};

Fetch: PUBLIC ENTRY TeleLoadProc = {
ENABLE UNWIND => NULL;
[ok, attempts] _ GFetch[h: h, requestcb: cb, type: coreFetchRequest, tries: tries];
};

SlaveStore: PUBLIC ENTRY TeleLoadProc = {
ENABLE UNWIND => NULL;
[ok, attempts] _ GStore[h: h, requestcb: cb, type: slaveStoreRequest, tries: tries];
};

SlaveFetch: PUBLIC ENTRY TeleLoadProc = {
ENABLE UNWIND => NULL;
[ok, attempts] _ GFetch[h: h, requestcb: cb, type: slaveFetchRequest, tries: tries];
};

Call: PUBLIC ENTRY TeleLoadProc = {
ENABLE UNWIND => NULL;
[ok, attempts] _ GExchange[h: h, requestcb: cb, type: callRequest, tries: tries];
};

Go: PUBLIC ENTRY TeleLoadProc = {
ENABLE UNWIND => NULL;
[ok, attempts] _ GStore[h: h, requestcb: cb, type: goRequest, tries: 1];
};

GoFromBreak: PUBLIC ENTRY TeleLoadProc = {
ENABLE UNWIND => NULL;
[ok, attempts] _ GStore[h: h, requestcb: cb, type: goFromBreakRequest, tries: 1];
};

SingleStep: PUBLIC ENTRY TeleLoadProc = {
ENABLE UNWIND => NULL;
[ok, attempts] _ GStore[h: h, requestcb: cb, type: singleStepRequest, tries: 1];
};

FetchState: PUBLIC ENTRY TeleLoadProc = {
ENABLE UNWIND => NULL;
[ok, attempts] _ GFetch[h: h, requestcb: cb, type: stateFetchRequest, tries: tries];
};

GoToDebugger: PUBLIC ENTRY TeleLoadProc = TRUSTED {
ENABLE UNWIND => NULL;
b: PupBuffer.Buffer _ PupSocket.AllocBuffer[king];
replycb: CorePkt;
replycb _ LOOPHOLE[@b.body];
replycb.advice _ cb.advice;
replycb.address _ cb.address;
replycb.count _ cb.count;
FOR j: CARDINAL IN [0..cb.count) DO
replycb.data[j] _ cb.data[j];
ENDLOOP;
PupSocket.SetUserSize[b, SIZE[CorePktObject]+((cb.count+1)/2)];
b.id _ NewPupID[];
b.type _ debugRequest;
KingSend[b, h.address];
};

<<Fires up a process to watch for unsolicited news items from debugees>>

eventServerUseCount: INT _ 0;
eventServerActive: BOOL _ FALSE;
eventServerProcess: PROCESS;
eventServerPollingInterval: NAT _ 500;
eventSocket: PupSocket.Socket _ NIL;
eventClientProcedure: EventProc;
eventClientData: REF ANY;

StartEventServer: PUBLIC ENTRY PROC [proc: EventProc, clientData: REF ANY] = {
eventServerUseCount _ eventServerUseCount + 1;
IF eventServerUseCount > 1 THEN RETURN;
IF eventServerActive THEN RETURN;
eventClientProcedure _ proc;
eventClientData _ clientData;
eventServerActive _ TRUE;
eventServerProcess _ FORK TeleloadEventServer[];
};

StopEventServer: PUBLIC ENTRY PROC = TRUSTED {
eventServerUseCount _ MAX[0, eventServerUseCount - 1];
IF eventServerUseCount > 0 THEN RETURN;
eventServerActive _ FALSE;
JOIN eventServerProcess;
};

TeleloadEventServer: PROC =  TRUSTED{
b: PupBuffer.Buffer _ NIL;
er: EventRecord;
cp: CorePkt;
eventSocket _ PupSocket.Create[
local: teleSwatSocket, remote: [Pup.nullNet, Pup.nullHost, teleSwatSocket],
getTimeout: eventServerPollingInterval];
DO
b _ eventSocket.Get[];
IF b # NIL THEN {
cp _ LOOPHOLE[@b.body];
er _ LOOPHOLE[@cp^.data];
eventClientProcedure[b.source, er^, eventClientData];
PupSocket.FreeBuffer[eventSocket, b];
};
IF NOT eventServerActive THEN EXIT;
ENDLOOP;
eventClientData _ NIL;
eventClientProcedure _ NIL;
PupSocket.Destroy[eventSocket];
};

GStore: INTERNAL PROC [h: Handle, requestcb: CoreBlock, type: PupType.Type, tries: NAT] RETURNS [a: BOOL _ TRUE, actualAttempts: 
NAT] = TRUSTED {
b: PupBuffer.Buffer _ NIL;
replycb: CorePkt;
IF h=NIL THEN RETURN[FALSE, 0];
FOR actualAttempts IN [1..tries] DO
id: Endian.FWORD _ NewPupID[];
IF b#NIL THEN PupSocket.FreeBuffer[king, b];
b _ PupSocket.AllocBuffer[king];
replycb _ LOOPHOLE[@b.body];
replycb.advice _ requestcb.advice;
replycb.address _ requestcb.address;
replycb.count _ requestcb.count;
FOR j: CARDINAL IN [0..requestcb.count) DO
replycb.data[j] _ requestcb.data[j];
ENDLOOP;
PupSocket.SetUserSize[b, SIZE[CorePktObject]+((requestcb.count+1)/2)];
b _ Exchange[h, b, type, id];
IF b=NIL THEN LOOP;
replycb _ LOOPHOLE[@b.body];
IF NOT Check[requestcb, replycb] THEN LOOP;
requestcb.advice _ replycb.advice;
EXIT;
REPEAT
FINISHED => a _ FALSE;
ENDLOOP;
IF b#NIL THEN PupSocket.FreeBuffer[king, b];
};

GFetch: INTERNAL PROC [h: Handle, requestcb: CoreBlock, type: PupType.Type, tries: CARDINAL] RETURNS [a: BOOL _ TRUE, 
actualAttempts: NAT] = TRUSTED {
b: PupBuffer.Buffer _ NIL;
id: Endian.FWORD _ NewPupID[];
replycb: CorePkt;
IF h=NIL THEN RETURN[FALSE, 0];
FOR actualAttempts IN [1..tries] DO
IF b#NIL THEN PupSocket.FreeBuffer[king, b];
b _ PupSocket.AllocBuffer[king];
replycb _ LOOPHOLE[@b.body];
replycb.advice _ requestcb.advice;
replycb.address _ requestcb.address;
replycb.count _ requestcb.count;
PupSocket.SetUserSize[b, SIZE[CorePktObject]];
b _ Exchange[h, b, type, id];
IF b=NIL THEN LOOP;
replycb _ LOOPHOLE[@b.body];
IF replycb.address # requestcb.address THEN LOOP;
IF replycb.count # requestcb.count THEN LOOP;
FOR j: CARDINAL IN [0..requestcb.count) DO
requestcb.data[j] _ replycb.data[j];
ENDLOOP;
requestcb.advice _ replycb.advice;
EXIT;
REPEAT
FINISHED => a _ FALSE;
ENDLOOP;
IF b#NIL THEN PupSocket.FreeBuffer[king, b];
};

GExchange: INTERNAL PROC [h: Handle, requestcb: CoreBlock, type: PupType.Type, tries: CARDINAL] RETURNS [a: BOOL _ TRUE, 
actualAttempts: NAT] = TRUSTED {
b: PupBuffer.Buffer _ NIL;
id: Endian.FWORD _ NewPupID[];
replycb: CorePkt;
IF h=NIL THEN RETURN[FALSE, 0];
FOR actualAttempts IN [1..tries] DO
IF b#NIL THEN PupSocket.FreeBuffer[king, b];
b _ PupSocket.AllocBuffer[king];
replycb _ LOOPHOLE[@b.body];
replycb.advice _ requestcb.advice;
replycb.address _ requestcb.address;
replycb.count _ requestcb.count;
FOR j: CARDINAL IN [0..requestcb.count) DO
replycb.data[j] _ requestcb.data[j];
ENDLOOP;
PupSocket.SetUserSize[b, SIZE[CorePktObject]+((requestcb.count+1)/2)];
b.id _ id;
b _ Exchange[h, b, type, id];
IF b=NIL THEN LOOP;
replycb _ LOOPHOLE[@b.body];
IF replycb.address # requestcb.address THEN LOOP;
IF replycb.count # requestcb.count THEN LOOP;
FOR j: CARDINAL IN [0..requestcb.count) DO
requestcb.data[j] _ replycb.data[j];
ENDLOOP;
requestcb.advice _ replycb.advice;
EXIT;
REPEAT
FINISHED => a _ FALSE;
ENDLOOP;
IF b#NIL THEN PupSocket.FreeBuffer[king, b];
};

Exchange: INTERNAL PROC [h: Handle, request: PupBuffer.Buffer, type: PupType.Type, id: Endian.FWORD] RETURNS[PupBuffer.Buffer] = {
reply: PupBuffer.Buffer _ NIL;
request.id _ id;
request.type _ type;
KingSend[request, h.address];
DO
IF reply#NIL THEN PupSocket.FreeBuffer[king, reply];
reply _ KingGet[h.address];
IF reply = NIL THEN RETURN[NIL];
IF reply.type # LOOPHOLE[LOOPHOLE[type, CARDINAL]+1] THEN LOOP;
IF reply.id # id THEN LOOP;
RETURN[reply];
ENDLOOP;
};

Check: INTERNAL PROC [a: CoreBlock, b: CorePkt]    RETURNS [BOOL] = TRUSTED {
IF a.address # b.address THEN RETURN[FALSE];
IF a.count # b.count THEN RETURN[FALSE];
FOR i: CARDINAL IN [0..a.count) DO
IF a.data[i] # b.data[i] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
};

<<Communication stuff more conveniently arranged>>

Failed: PUBLIC ERROR = CODE;
<<>>
GetCoreBlock: PUBLIC ENTRY PROC[h: Handle, addr: CoreAddress, count: CARDINAL, addressSpace: AddressSpace _ main] RETURNS [cb: 
CoreBlock] = {
ENABLE UNWIND => NULL;
RETURN [GetCoreBlockInternal[h, addr, count, addressSpace]];
};

GetCoreBlockInternal: INTERNAL PROC[h: Handle, addr: CoreAddress, count: CARDINAL, addressSpace: AddressSpace] RETURNS [cb: 
CoreBlock] = {
ok: BOOLEAN;
tries: NAT;
cb _ NEW[CoreBlockObject[count]];
cb.address _ addr;
cb.advice _ [FALSE, FALSE, 0];
[ok, tries] _ GFetch[h, cb, IF addressSpace = main THEN coreFetchRequest ELSE slaveFetchRequest, 5];
IF NOT ok THEN {
IF h.log # NIL THEN h.log.PutF[" ... %d byte read from %08x failed, (%d tries).\n", IO.card[count], IO.card[cb.address], 
IO.int[tries]];
cb_NIL;
ERROR Failed;
};
};

ReadWord: PUBLIC ENTRY PROC [h: Handle, addr: CoreAddress, addressSpace: AddressSpace _ main] RETURNS [v: CARDINAL] = {
ENABLE UNWIND => NULL;
RETURN [ReadInternal[h, addr, addressSpace] + LOOPHOLE[Shift[ReadInternal[h, addr+1, addressSpace], 8], CARDINAL]];
};

Read: PUBLIC ENTRY PROC [h: Handle, addr: CoreAddress, addressSpace: AddressSpace _ main] RETURNS [v: CARDINAL] = {
ENABLE UNWIND => NULL;
RETURN[ReadInternal[h, addr, addressSpace]];
};

ReadInternal: INTERNAL PROC [h: Handle, addr: CoreAddress, addressSpace: AddressSpace] RETURNS [v: CARDINAL] = {
temp: Basics.LongNumber;
blockAddr: CoreAddress;
count: NAT _ h.cacheSize;
IF h.cacheSize = 0 THEN h.cacheSize _ locMaxByte;
h.cacheSize _ MAX[1, MIN[h.cacheSize, locMaxByte]];
temp.lc _ addr;
temp.lc _ temp.lc - (temp.lc MOD h.cacheSize);
blockAddr _ temp.lc;
IF h.cacheCB = NIL THEN {
h.cacheCB _ GetCoreBlockInternal[h: h, addr: blockAddr, count: h.cacheSize, addressSpace: addressSpace];
h.addressSpace _ addressSpace;
};
IF h.cacheCB.address # blockAddr OR h.addressSpace # addressSpace THEN {
FlushWritesInternal[h];
h.cacheCB _ GetCoreBlockInternal[h: h, addr: blockAddr, count: h.cacheSize, addressSpace: addressSpace];
h.addressSpace _ addressSpace;
};
RETURN[h.cacheCB.data[Basics.LowHalf[addr-blockAddr]]];
};

WriteWord: PUBLIC ENTRY PROC [h: Handle, addr: CoreAddress, value: CARDINAL, addressSpace: AddressSpace _ main] = {
ENABLE UNWIND => NULL;
WriteInternal[h, addr, And[value, 377B], addressSpace];
WriteInternal[h, addr + 1, Shift[value, -8], addressSpace];
};

Write: PUBLIC ENTRY PROC [h: Handle, addr: CoreAddress, value: CARDINAL, addressSpace: AddressSpace _ main] = {
ENABLE UNWIND => NULL;
WriteInternal[h, addr, value, addressSpace];
};

WriteInternal: INTERNAL PROC [h: Handle, addr: CoreAddress, value: CARDINAL, addressSpace: AddressSpace] = {
temp: Basics.LongNumber;
blockAddr: CoreAddress;
[] _ ReadInternal[h, addr, addressSpace];
temp.lc _ addr;
temp.lc _ temp.lc - (temp.lc MOD h.cacheSize);
blockAddr _ temp.lc;
h.cacheCB.data[Basics.LowHalf[addr-blockAddr]] _ value;
h.dirty _ TRUE;
};

FlushWrites: PUBLIC ENTRY PROC [h: Handle] = {
ENABLE UNWIND => NULL;
FlushWritesInternal[h];
};

FlushWritesInternal: INTERNAL PROC [h: Handle] = {
IF h.dirty THEN {
ok: BOOL;
tries: NAT;
[ok, tries] _ GStore[h, h.cacheCB, IF h.addressSpace = main THEN coreStoreRequest ELSE slaveStoreRequest, 5];
h.dirty _ FALSE;
IF NOT ok THEN {
IF h.log # NIL THEN h.log.PutF[" Write to %08x failed (%d tries), cache reset anyway.\n", IO.card[h.cacheCB.address], 
IO.int[tries]];
ERROR Failed;
};
};
};

ResetCache: PUBLIC ENTRY PROC [h: Handle] = {
ENABLE UNWIND => NULL;
FlushWritesInternal[h];
h.cacheCB _ NIL;
};

SetCacheSize: PUBLIC ENTRY PROC [h: Handle, bytes: NAT] = {
ENABLE UNWIND => NULL;
FlushWritesInternal[h];
h.cacheCB _ NIL;
h.cacheSize _ IF bytes = 0 THEN locMaxByte ELSE MAX[1, MIN[locMaxByte, bytes]];
};

Swab: PUBLIC PROC [a: CARDINAL] RETURNS [b: CARDINAL] = {
b _ Basics.BITSHIFT[Basics.LowByte[a], 8] + Basics.HighByte[a];
};

SwabState: PUBLIC PROC [state: State8086Object] RETURNS [State8086Object] = {
FOR i: Registers8086 IN [AX..FL] DO
state.Regs[i] _ Swab[state.Regs[i]];
ENDLOOP;
RETURN[state];
};

SwabEvent: PUBLIC PROC [state: EventRecordObject] RETURNS [EventRecordObject] = {
state.regs _ SwabState[state.regs];
state.reason _ Swab[state.reason];
state.clockLow _ Swab[state.clockLow];
state.clockHigh _ Swab[state.clockHigh];
state.bootSwitches _ Swab[state.bootSwitches];
state.advice _ Swab[state.advice];
state.monRelays _ Swab[state.monRelays];
state.tlNet _ Swab[state.tlNet];
state.tlHost _ Swab[state.tlHost];
state.tlImHost _ Swab[state.tlImHost];
state.localNet _ Swab[state.localNet];
RETURN[state];
};

<<Here lives the single king socket.>>
<<>>
<<These variables are only touched by procedures in the monitor>>
kingUseCount: INT _ 0;
kingWait: CONDITION;
lastPacket: PupBuffer.Buffer;
pleaseStopKing: BOOL _ TRUE;
myID: Endian.FWORD _ [1711, 1];

<<These variables are handled outside the monitor>>
king: PupSocket.Socket;
kingProcess: PROCESS;

KingGet: INTERNAL PROC [from: Pup.Address] RETURNS [PupBuffer.Buffer] = TRUSTED {
b: PupBuffer.Buffer;
IF lastPacket # NIL AND lastPacket.source.net = from.net AND lastPacket.source.host = from.host THEN {
b _ lastPacket;
lastPacket _ NIL;
RETURN[b];
};
Process.SetTimeout[condition: @kingWait, ticks: Process.MsecToTicks[kingWaitTime]];
WAIT kingWait;
IF lastPacket # NIL AND lastPacket.source.net = from.net AND lastPacket.source.host = from.host THEN {
b _ lastPacket;
lastPacket _ NIL;
RETURN[b];
};
RETURN[NIL];
};

NewPupID: INTERNAL PROC RETURNS [Endian.FWORD] = {
myID.low _ myID.low + 1;
RETURN [myID];
};

KingSend: INTERNAL PROC [b: PupBuffer.Buffer _ NIL, to: Pup.Address] = {
IF king = NIL THEN {
<<PupSocket.FreeBuffer[king, b]; -- no socket to free it to, "drop it on the floor".>>
RETURN;
};
PupSocket.Send[king, b, to];
};

KingDaemon: PROC = {
b: PupBuffer.Buffer;
SetKingPacket: ENTRY PROC [b: PupBuffer.Buffer] = {
IF lastPacket # NIL THEN PupSocket.FreeBuffer[king, lastPacket];
lastPacket _ b;
NOTIFY kingWait;
};
king _ PupSocket.Create[getTimeout: 500];
DO
IF pleaseStopKing THEN EXIT;
b _ king.Get[];
IF b # NIL THEN SetKingPacket[b];
ENDLOOP;
PupSocket.Destroy[king];
king _ NIL;
SetKingPacket[NIL];
};

StartKing: PUBLIC ENTRY PROC = {
kingUseCount _ kingUseCount + 1;
IF kingUseCount > 1 THEN RETURN;
IF NOT pleaseStopKing THEN RETURN; 
pleaseStopKing _ FALSE;
kingProcess _ FORK KingDaemon[];
};

StopKing: PUBLIC PROC = TRUSTED  {
giveUp: BOOL _ FALSE;
GetLock: ENTRY PROC = TRUSTED {
kingUseCount _ MAX[0, kingUseCount - 1];
IF kingUseCount > 0 THEN giveUp _ TRUE; 
IF pleaseStopKing THEN giveUp _ TRUE; 
pleaseStopKing _ TRUE;
};
GetLock[];
IF NOT giveUp THEN JOIN kingProcess;
};

StopHimProbing: PUBLIC ENTRY PROC [h: Handle, setPointers: BOOL] = TRUSTED {
replycb: CorePkt;
b: PupBuffer.Buffer _ NIL;
IF h = NIL THEN RETURN;
b _ PupSocket.AllocBuffer[king];
replycb _ LOOPHOLE[@b.body];
replycb.advice _ [setPointers, FALSE, 0];
replycb.address _ 0;
replycb.count _ 10;
PupSocket.SetUserSize[b, SIZE[CorePktObject]];
b.id _ NewPupID[];
b.type _ coreFetchRequest;
KingSend[b, h.address];
};

GetEventData: PUBLIC PROC [h: Handle, setPointers: BOOL] RETURNS [event: EventRecordObject, ok: BOOL] = TRUSTED {
deleteOnReturn: BOOL _ FALSE;
er: EventRecord;
cb: CoreBlock;
IF h = NIL THEN RETURN [event: event, ok: FALSE];
cb _ NEW[CoreBlockObject[SIZE[EventRecordObject] * 2]];
cb.address _ 0DA00H;
cb.advice _ [setPointers, FALSE, 0];
ok _ Fetch[h, cb, 1].ok;
IF NOT ok THEN RETURN [event: event, ok: FALSE];
er _ LOOPHOLE[BASE[DESCRIPTOR[cb.data]], EventRecord];
event _ SwabEvent[er^];
RETURN [event: event, ok: TRUE];
};


}.

December 30, 1981    3:14 PM, Stewart, created from AudioSocket.mesa
December 22, 1982 3:17 pm, Stewart, modifications to TeleLoad
April 25, 1983 11:22 am, LCS, new Event interface and locMaxByte
May 28, 1983 5:47 pm, LCS, cacheSize added, in order to make alteration of running program safe!
December 26, 1983 2:40 pm, LCS, patchup addresses with StripChar
May 16, 1986 10:26:24 am PDT, DCS, increase packet exchange wait time, make it a global vbl.
    <<Swinehart, May 16, 1986 10:01:07 am PDT>>
        <<Cedar 6.1>>
        <<changes to: TeleLoadImpl , NameToAddress , AddressToName , Start , Stop , Store , Fetch , SlaveStore , 
        SlaveFetch , Call , Go , GoFromBreak , SingleStep , FetchState , GoToDebugger , StartEventServer , 
        StopEventServer , TeleloadEventServer , GStore , GFetch , GExchange , Exchange , GetCoreBlock , ReadWord , 
        Read , WriteWord , Write , FlushWrites , ResetCache , SetCacheSize , Swab , SwabState , SwabEvent , 
        KingGet , KingSend , KingDaemon , SetKingPacket (local of KingDaemon) , StartKing , StopKing , StopHimProbing 
        , GetEventData >>
    <<>>