DIRECTORY
Basics USING [BITAND, BITSHIFT, FFromInt32, FWORD, HighByte, Int32FromF, LongNumber, LowByte, LowHalf],
IO USING [card, int, PutF, STREAM],
Process USING [MsecToTicks, SetTimeout],
Pup USING [Address, nullAddress ],
PupBuffer USING [ Buffer ],
PupName USING [ AddressLookup, AddressToRope, Error, NameLookup ],
PupSocket USING [ Socket, Get, Send, CreateEphemeral, CreateServer, AllocBuffer, FreeBuffer, Destroy, SetUserBytes ],
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.SetUserBytes[b, BYTES[CorePktObject]+(cb.count+1)];
b.id ← NewPupID[];
b.type ← debugRequest;
KingSend[b, h.address];
};
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.CreateServer[
local: 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[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: Basics.FWORD ← NewPupID[];
IF b#NIL THEN PupSocket.FreeBuffer[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.SetUserBytes[b, BYTES[CorePktObject]+(requestcb.count+1)];
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[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: Basics.FWORD ← NewPupID[];
replycb: CorePkt;
IF h=NIL THEN RETURN[FALSE, 0];
FOR actualAttempts
IN [1..tries]
DO
IF b#NIL THEN PupSocket.FreeBuffer[b];
b ← PupSocket.AllocBuffer[king];
replycb ← LOOPHOLE[@b.body];
replycb.advice ← requestcb.advice;
replycb.address ← requestcb.address;
replycb.count ← requestcb.count;
PupSocket.SetUserBytes[b, BYTES[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[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: Basics.FWORD ← NewPupID[];
replycb: CorePkt;
IF h=NIL THEN RETURN[FALSE, 0];
FOR actualAttempts
IN [1..tries]
DO
IF b#NIL THEN PupSocket.FreeBuffer[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.SetUserBytes[b, BYTES[CorePktObject]+(requestcb.count+1)];
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[b];
};
Exchange:
INTERNAL
PROC [h: Handle, request: PupBuffer.Buffer, type: PupType.Type, id: Basics.
FWORD]
RETURNS[PupBuffer.Buffer] = {
reply: PupBuffer.Buffer ← NIL;
waitTime: INT ← kingWaitTime;
request.id ← id;
request.type ← type;
KingSend[request, h.address];
DO
IF reply#NIL THEN PupSocket.FreeBuffer[reply];
reply ← KingGet[h.address, waitTime];
waitTime ← waitTime + kingWaitTime;
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: Basics.FWORD ← [[6, 175], [0,1]]; -- = [1711, 1]; ?????
These variables are handled outside the monitor
king: PupSocket.Socket;
kingProcess: PROCESS;
KingGet:
INTERNAL
PROC [from: Pup.Address, waitTime:
INT←kingWaitTime]
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[waitTime]];
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 [Basics.
FWORD] = {
myID ← Basics.FFromInt32[Basics.Int32FromF[myID]+1];
RETURN [myID];
};
KingSend:
INTERNAL
PROC [b: PupBuffer.Buffer ←
NIL, to: Pup.Address] = {
IF king =
NIL
THEN {
PupSocket.FreeBuffer[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[lastPacket];
lastPacket ← b;
NOTIFY kingWait;
};
king ← PupSocket.CreateEphemeral[remote: Pup.nullAddress, 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.SetUserBytes[b, BYTES[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];
};
}.
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