PupWatch.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Russ Atkinson, March 13, 1985 3:56:47 pm PST
Andrew Birrell October 25, 1983 11:29 am
Hal Murray, December 4, 1986 2:08:47 pm PST
EtherWatch and ArpaWatch have a similar structure. If you fix a bug here, consider fixing them too.
DIRECTORY
Ascii USING [CR, SP],
Basics USING [BITAND, bytesPerWord, LowHalf],
BasicTime USING [FromPupTime, GetClockPulses, GMT, Now, nullGMT, OutOfRange, Pulses, PulsesToMicroseconds],
Buttons USING [Button, ButtonProc, Create, ReLabel, SetDisplayStyle],
CommBuffer USING [Encapsulation],
CommDriver USING [CreateInterceptor, DestroyInterceptor, GetNetworkChain, Interceptor, Network, RecvInterceptor, RecvType],
CommDriverType USING [Encapsulation],
Containers USING [ChildXBound, ChildYBound, Create],
Convert USING [AppendTime],
Endian USING [CardFromF, FWORD, HWORD],
FS USING [Copy, Error, StreamOpen],
Imager USING [black, Box, Context, MaskBox, Rectangle, SetColor, SetFont, SetXY, ShowText, white],
ImagerBackdoor USING [GetBounds, GetCP],
ImagerFont USING [Font, FontBoundingBox, RopeWidth],
IO USING [Close, Put, PutChar, PutRope, STREAM],
Labels USING [Create],
Menus USING [MouseButton],
PrincOpsUtils USING [LongCopy],
Process USING [Abort, Detach, EnableAborts, Priority, priorityBackground, priorityNormal, SetPriority],
Pup USING [Address, nullSocket, Socket],
PupBuffer USING [Buffer, bytesPerRoutingInfoResponse, FileLookupReply, maxDataBytes, TimeResponse],
PupName USING [AddressToRope, Error, NameLookup],
PupSocket USING [GetMyAddress],
PupType USING [bytesOfPupOverhead, CardFromSocket, ErrorCode, HeaderWithoutChecksum],
PupWKS USING [bspSink, copyDisk, echo, eftp, fileLookup, ftp, gatewayInfo, gvLily, gvMSClientInput, gvMSForward, gvMSPoll, gvMSRetrieve, gvRSEnquiry, gvRSPoll, leaf, misc, rpc, telnet, teleSwat],
Rope USING [Cat, Length, ROPE, Text],
RPCPkt USING [Header],
TeledebugProtocol USING [CoreStoreRequest, DiskAddressSetRequest],
VFonts USING [EstablishFont],
ViewerClasses USING [DestroyProc, PaintProc, Viewer, ViewerClass, ViewerClassRec],
ViewerOps USING [CreateViewer, FindViewer, OpenIcon, PaintViewer, RegisterViewerClass, RestoreViewer],
ViewerTools USING [GetContents, MakeNewTextViewer, SetContents, SetSelection],
VM USING [AddressForPageNumber, Allocate, Free, Interval, PagesForWords];
PupWatch: MONITOR
IMPORTS Basics, BasicTime, Buttons, CommDriver, Containers, Convert, Endian, FS, Imager, ImagerBackdoor, ImagerFont, IO, Labels, PrincOpsUtils, Process, Rope, PupName, PupSocket, PupType, VFonts, ViewerOps, ViewerTools, VM
EXPORTS CommBuffer = {
Exported Types
Encapsulation: PUBLIC TYPE = CommDriverType.Encapsulation;
Simple things
ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;
MSec: PROC [rawClock: BasicTime.Pulses] RETURNS [LONG CARDINAL] = INLINE {
RETURN[BasicTime.PulsesToMicroseconds[rawClock]/1000];
};
User input
InputAction: TYPE = RECORD [SELECT act: * FROM
fast => NULL,
newHost => [name: ROPE],
pauseContinue => NULL,
replay => NULL,
slow => NULL,
start => NULL,
stop => NULL,
writeLog => [mouseButton: Menus.MouseButton, shift, control: BOOL],
pktSize => [big: BOOL],
ENDCASE];
Pup level
bufferSize: INT;
copySize: NAT;
maxPupLength: NAT;
bigPupLength: NAT = PupBuffer.maxDataBytes;
smallPupLength: NAT = 100;
showIdAndSockets: BOOL ← TRUE;
showText: INT; -- Filters for WriteLog
showBytes: BOOL;
showWords: BOOL;
Buffer: TYPE = LONG POINTER TO BufferData;
BufferData: TYPE = MACHINE DEPENDENT RECORD [
encap: CommBuffer.Encapsulation,
header: PupType.HeaderWithoutChecksum,
pupBody: SELECT OVERLAID * FROM
null => [],
big => [bigChars: PACKED ARRAY [0..bigPupLength) OF CHAR],
small => [smallChars: PACKED ARRAY [0..smallPupLength) OF CHAR],
pupChars => [pupChars: PACKED ARRAY [0..0) OF CHAR],
pupBytes => [pupBytes: PACKED ARRAY [0..0) OF [0..377B]],
pupWords => [pupWords: ARRAY [0..0) OF CARDINAL],
pupString => [pupString: StringBody],
rfc => [address: Pup.Address],
ack => [maximumBytesPerPup, numberOfPupsAhead, numberOfBytesAhead: CARDINAL],
abort => [abortCode: CARDINAL, abortText: PACKED ARRAY [0..0) OF CHAR],
error => [ error: RECORD [
header: PupType.HeaderWithoutChecksum,
code: PupType.ErrorCode,
options: Endian.HWORD,
errorText: PACKED ARRAY [0..0) OF CHAR] ],
addresses => [addresses: ARRAY [0..0) OF Pup.Address],
fileLookupReply => [fileLookupReply: PupBuffer.FileLookupReply],
time => [time: PupBuffer.TimeResponse],
ENDCASE];
ContentsBytes: PROC [b: Buffer] RETURNS [CARDINAL] = INLINE {
RETURN[b.header.byteLength - PupType.bytesOfPupOverhead];
};
nBuffers: CARDINAL = 1000;
BufferIndex: TYPE = [0..nBuffers);
bufferSpace: VM.Interval;
buffers: LONG POINTER TO --ARRAY BufferIndex OF-- BufferData ← NIL;
times: REF ARRAY BufferIndex OF BasicTime.Pulses ← NIL;
lost: PACKED ARRAY BufferIndex OF BOOL ← ALL[FALSE];
logged: PACKED ARRAY BufferIndex OF BOOL ← ALL[FALSE];
wBuffer: BufferIndex ← 0; -- buffer being written by ethernet driver
rBuffer: BufferIndex ← 0; -- buffer Looker wants to read
fullBuffers: [0..nBuffers] ← 0;
bufferChange: CONDITION;
lookerWaiting: BOOL ← FALSE;
allUsed: BOOL ← FALSE; -- whether all buffers have been written
lookerProcess: PROCESS;
AllocBuffers: ENTRY PROC [big: BOOL] = {
IF buffers # NIL THEN FreeBuffers[];
bufferSize ← IF big THEN SIZE[big BufferData] ELSE SIZE[small BufferData];
copySize ← CARDINAL[bufferSize - SIZE[null BufferData]];
bufferSpace ← VM.Allocate[VM.PagesForWords[nBuffers * bufferSize]];
buffers ← VM.AddressForPageNumber[bufferSpace.page];
maxPupLength ← IF big THEN bigPupLength ELSE smallPupLength;
times ← NEW[ARRAY BufferIndex OF BasicTime.Pulses];
InnerFlush[];
};
FreeBuffers: PROC = {
VM.Free[bufferSpace];
times ← NIL;
};
GetBuffer: ENTRY PROC RETURNS [BufferIndex] = {
ENABLE UNWIND => lookerWaiting ← FALSE;
WHILE fullBuffers = 0
DO lookerWaiting ← TRUE; WAIT bufferChange ENDLOOP;
lookerWaiting ← FALSE;
RETURN[rBuffer]
};
ReturnBuffer: ENTRY PROC = {
rBuffer ← IF rBuffer = LAST[BufferIndex] THEN 0 ELSE SUCC[rBuffer];
fullBuffers ← fullBuffers-1;
NOTIFY bufferChange;
};
ReplayBuffers: ENTRY PROC = {
rBuffer ← IF allUsed
THEN IF wBuffer = LAST[BufferIndex] THEN 0 ELSE SUCC[wBuffer]
ELSE 0;
fullBuffers ← (wBuffer+nBuffers-rBuffer) MOD nBuffers;
IF lookerWaiting THEN NOTIFY bufferChange;
};
FlushBuffers: ENTRY PROC = { InnerFlush[] };
InnerFlush: INTERNAL PROC = {
rBuffer ← wBuffer ← 0;
fullBuffers ← 0; allUsed ← FALSE; lost ← ALL[FALSE]; logged ← ALL[FALSE];
waitingForBuffers ← FALSE;
NOTIFY bufferChange;
};
waitingForBuffers: BOOL ← FALSE;
NextBuffer: INTERNAL PROC = {
IF fullBuffers >= nBuffers/2 OR ( waitingForBuffers AND fullBuffers+50 >= nBuffers/2 --make sure we have 50 free--)
THEN { waitingForBuffers ← TRUE; lost[wBuffer] ← TRUE; RETURN };
waitingForBuffers ← FALSE;
IF wBuffer = LAST[BufferIndex]
THEN { allUsed ← TRUE; wBuffer ← 0 }
ELSE wBuffer ← SUCC[wBuffer];
fullBuffers ← fullBuffers+1;
IF lookerWaiting THEN NOTIFY bufferChange;
logged[wBuffer] ← lost[wBuffer] ← FALSE;
};
wanted: Pup.Address;
myNet: CARDINAL ← 0;
big: REF BOOL ← NEW[BOOL ← FALSE];
background: REF BOOL ← NEW[BOOL ← TRUE];
broadcast: REF BOOL ← NEW[BOOL ← FALSE];
route: REF BOOL ← NEW[BOOL ← TRUE];
misc: REF BOOL ← NEW[BOOL ← TRUE];
rpc: REF BOOL ← NEW[BOOL ← TRUE];
echo: REF BOOL ← NEW[BOOL ← TRUE];
error: REF BOOL ← NEW[BOOL ← TRUE];
raee: REF BOOL ← NEW[BOOL ← TRUE]; -- rfc, abort, end, endRep
aData: REF BOOL ← NEW[BOOL ← TRUE]; -- data and aData, "data" clashes in Recv
mark: REF BOOL ← NEW[BOOL ← TRUE]; -- mark and aMark
ack: REF BOOL ← NEW[BOOL ← TRUE];
eftp: REF BOOL ← NEW[BOOL ← TRUE];
routing: REF BOOL ← NEW[BOOL ← TRUE];
Filter: PROC [who: Pup.Address] RETURNS [reject: BOOL] = {
IF (who.net # wanted.net AND wanted.net # 0) AND (who.net # 0 OR wanted.net # myNet) THEN RETURN[TRUE];
IF (who.host # wanted.host AND wanted.host # 0) AND (who.host # 0 OR ~broadcast^) THEN RETURN[TRUE];
IF (who.socket # wanted.socket) AND (wanted.socket # Pup.nullSocket) THEN RETURN[TRUE];
RETURN[FALSE];
};
Recv: ENTRY CommDriver.RecvInterceptor = TRUSTED {
myBuffer: BufferIndex = wBuffer;
b: PupBuffer.Buffer = LOOPHOLE[buffer];
new: Buffer = LOOPHOLE[buffers + myBuffer * bufferSize];
IF Filter[b.dest] AND Filter[b.source] THEN RETURN;
IF (b.dest.socket = PupWKS.gatewayInfo OR b.source.socket = PupWKS.gatewayInfo) AND ~route^ THEN RETURN;
IF (b.dest.socket = PupWKS.misc OR b.source.socket = PupWKS.misc) AND ~misc^ THEN RETURN;
IF (b.dest.socket = PupWKS.rpc OR b.source.socket = PupWKS.rpc) AND ~rpc^ THEN RETURN;
IF (b.type = echoMe OR b.type = iAmEcho) AND ~echo^ THEN RETURN;
IF b.type = error AND ~error^ THEN RETURN;
IF (b.type = rfc OR b.type = abort OR b.type = end OR b.type = endRep) AND ~raee^ THEN RETURN;
IF (b.type = data OR b.type = aData) AND ~aData^ THEN RETURN;
IF (b.type = mark OR b.type = aMark) AND ~mark^ THEN RETURN;
IF b.type = ack AND ~ack^ THEN RETURN;
IF (b.type = eData OR b.type = eAck OR b.type = eEnd OR b.type = eAbort) AND ~eftp^ THEN RETURN;
times[myBuffer] ← BasicTime.GetClockPulses[];
new.encap ← buffer.ovh.encap;
PrincOpsUtils.LongCopy[
from: @buffer.data,
to: @new.header,
nwords: MIN[(b.byteLength+1)/2, copySize]];
NextBuffer[];
};
interceptor: CommDriver.Interceptor;
network: CommDriver.Network ← CommDriver.GetNetworkChain[];
Patch by hand to watch other nets
TakeEthernet: ENTRY PROC = {
recvMask: PACKED ARRAY CommDriver.RecvType OF BOOL ← ALL[FALSE];
recvMask[pup] ← TRUE;
interceptor ← CommDriver.CreateInterceptor[
network: network,
sendMask: ALL[FALSE],
sendProc: NIL,
recvMask: recvMask,
recvProc: Recv,
data: NIL,
promiscuous: TRUE];
};
GiveEthernet: ENTRY PROC = {
CommDriver.DestroyInterceptor[interceptor];
};
Synchronization with user type-in
inputActive: BOOL ← FALSE;
lookerActive: BOOL ← FALSE;
pauseWanted: BOOL ← FALSE;
inputChange: CONDITION;
lookerChange: CONDITION;
wantedPriority: Process.Priority ← Process.priorityBackground;
lookerPriority: Process.Priority;
ActivateLooker: ENTRY PROC RETURNS [BOOL] = {
ENABLE UNWIND => NULL;
IF lookerPriority # wantedPriority THEN Process.SetPriority[lookerPriority ← wantedPriority];
IF inputActive OR pauseWanted THEN {
WHILE inputActive OR pauseWanted DO WAIT inputChange ENDLOOP;
RETURN[FALSE] }
ELSE { lookerActive ← TRUE; RETURN[TRUE]; };
};
DeactivateLooker: ENTRY PROC = {
lookerActive ← FALSE;
IF inputActive THEN NOTIFY lookerChange;
};
ActivateInput: ENTRY PROC = {
ENABLE UNWIND => NULL;
WHILE inputActive DO WAIT inputChange ENDLOOP;
inputActive ← TRUE;
WHILE lookerActive DO WAIT lookerChange ENDLOOP;
};
DeactivateInput: ENTRY PROC = {
inputActive ← FALSE;
BROADCAST inputChange;
};
Output subroutines
mode: { display, disk} ← display;
Display line layout is:
7777: from 77#377#777 [aData,L:777,to:177777]abcdefghijklmn
7777: to 77#377#777 [aData,L:777,to:177777]abcdefghijklmn
tabFrom: REAL;
tabTo: REAL;
tabAddr: REAL;
tabPkt: REAL;
tabData: REAL;
Disk log line layout is:
7777: from 377#377#377 [aData,L:1024,to:177777] abcdefghijklmn
7777: to 377#377#377 [aData,L:1024,to:177777] abcdefghijklmn
diskFrom: CARDINAL;
diskPkt: CARDINAL;
InitTabs: PROC = {
tabFrom ← GetLength["7777: "];
tabTo ← tabFrom + (GetLength["from"]-GetLength["to"]);
tabAddr ← tabFrom + GetLength["from "];
tabPkt ← tabAddr + GetLength["377#777#777 "];
tabData ← tabPkt + GetLength["[aData,to:177777,L:1777] "];
diskFrom ← Rope.Length["9999: "];
diskPkt ← diskFrom + Rope.Length["from 377#377#777 "];
};
WriteChar: PROC [CHARACTER] ← DisplayChar;
WriteMultiple: PROC [LONG DESCRIPTOR FOR PACKED ARRAY OF CHARACTER] ←
DisplayMultiple;
WriteDigit: PROC [card: CARDINAL] = INLINE { WriteChar['0+card]; };
WriteHexDigit: PROC [card: CARDINAL] = INLINE {
SELECT card FROM
IN [0..9] => WriteChar['0+card];
IN [10..15] => WriteChar['A+card-10];
ENDCASE => ERROR; };
WriteHexByte: PROC [card: CARDINAL] = INLINE {
WriteHexDigit[card/16];
WriteHexDigit[card MOD 16];
};
WriteString: PROC [s: LONG STRING] = {
WriteMultiple[DESCRIPTOR[@(s.text), s.length]];
};
WriteText: PROC [r: Rope.Text] = {
s: LONG STRING = LOOPHOLE[r];
WriteMultiple[DESCRIPTOR[@(s.text), s.length]];
};
WriteTextOctal: PROC [r: Rope.Text, n: CARDINAL] = {
s: LONG STRING = LOOPHOLE[r];
WriteMultiple[DESCRIPTOR[@(s.text), s.length]];
WriteOctal[n];
};
WritePup: PROC [b: Buffer] = {
WriteMultiple[DESCRIPTOR[@(b.pupChars), MIN[ContentsBytes[b],maxPupLength]]];
};
WriteTail: PROC [b: Buffer, wordOffset: NAT] = {
bytes: NAT ← MIN[ContentsBytes[b], maxPupLength];
byteOffset: NAT = wordOffset*Basics.bytesPerWord;
bytesToPrint: INT = bytes-byteOffset;
IF bytes < byteOffset THEN { WriteString["..."]; RETURN; };
WriteMultiple[DESCRIPTOR[@b.pupChars+wordOffset, bytesToPrint]];
IF bytes < bytesToPrint THEN WriteString["..."];
};
WritePupHex: PROC [b: Buffer] = {
length: NAT ← ContentsBytes[b];
bytes: NAT ← MIN[length, maxPupLength];
WriteTextOctal["L:", length];
FOR i: NAT IN [0..bytes) DO
IF (i MOD 2 = 0) THEN WriteString[","];
WriteHexByte[b.pupBytes[i]];
ENDLOOP;
};
WriteOctal: PROC [n: CARDINAL] = {
SELECT n FROM
< 10B =>
Fastest case, probably most common, too.
GO TO Final;
< 100B => {
Second fastest case, probably second most common, too.
WriteDigit[(n / 10B)];
GO TO Final; };
< 1000B => {
WriteDigit[(n / 100B)];
WriteDigit[(n / 10B) MOD 10B];
GO TO Final; };
>= 10000B => {
IF n >= 100000B THEN WriteChar['1];
WriteDigit[(n / 10000B) MOD 10B]; };
ENDCASE;
WriteDigit[(n / 1000B) MOD 10B];
WriteDigit[(n / 100B) MOD 10B];
WriteDigit[(n / 10B) MOD 10B];
GO TO Final;
EXITS Final => WriteDigit[(n MOD 10B)];
};
WriteLongOctal: PROC [n: LONG CARDINAL] = {
SELECT n FROM
<= LAST[CARDINAL] => WriteOctal[n];
ENDCASE => {
radix: CARDINAL = 8;
radixPower: LONG CARDINAL ← 1;
lwb: LONG CARDINAL ← n/radix;
WHILE radixPower <= lwb DO radixPower ← radixPower*radix ENDLOOP;
WHILE radixPower > 0 DO
x: CARDINAL = n/radixPower;
WriteDigit[x];
n ← n - x*radixPower;
radixPower ← radixPower/radix;
ENDLOOP;
};
};
WriteId: PROC [id: Endian.FWORD] = {
WriteLongOctal[Endian.CardFromF[id]];
};
WriteSocket: PROC [socket: Pup.Socket] = {
WriteLongOctal[PupType.CardFromSocket[socket]];
};
WriteDecimal: PROC [n: CARDINAL] = {
tenPower: CARDINAL ← 1;
n10: CARDINAL ← n/10;
WHILE tenPower <= n10 DO tenPower ← tenPower*10 ENDLOOP;
WHILE tenPower > 0 DO
x: CARDINAL = n/tenPower;
WriteDigit[x];
n ← n - x*tenPower;
tenPower ← tenPower/10;
ENDLOOP;
};
WriteLongDecimal: PROC [n: LONG CARDINAL] = {
tenPower: LONG CARDINAL ← 1;
n10: LONG CARDINAL ← n/10;
WHILE tenPower <= n10 DO tenPower ← tenPower*10 ENDLOOP;
WHILE tenPower > 0 DO
x: CARDINAL = n/tenPower;
WriteDigit[x];
n ← n - x*tenPower;
tenPower ← tenPower/10;
ENDLOOP;
};
WriteAddr: PROC [addr: Pup.Address] = {
lowSocket: WORD ← Basics.LowHalf[PupType.CardFromSocket[addr.socket]];
WriteOctal[addr.net];
WriteChar['#];
WriteOctal[addr.host];
WriteChar['#];
WriteOctal[Basics.BITAND[lowSocket,777B]];
};
WriteFullAddr: PROC [addr: Pup.Address] = {
WriteOctal[addr.net];
WriteChar['#];
WriteOctal[addr.host];
WriteChar['#];
WriteLongOctal[PupType.CardFromSocket[addr.socket]];
};
WriteTo: PROC [id: Endian.FWORD, length: CARDINAL] = {
n: LONG CARDINAL = Endian.CardFromF[id] + length;
WriteTextOctal["to:", Basics.LowHalf[n]];
};
time: REF TEXT ← NEW[TEXT[20]];
WriteTime: PROC [gmt: BasicTime.GMT] = {
time.length ← 0;
time ← Convert.AppendTime[time, gmt, years, seconds];
WriteText[LOOPHOLE[time]];
};
prevMS: LONG CARDINAL ← 0;
Major procedures
Watch: PROC [b: Buffer, time: BasicTime.Pulses] = {
WriteOneAddress: PROC [b: Buffer] = {
expected: CARDINAL = SIZE[Pup.Address, Basics.bytesPerWord];
bytes: CARDINAL = ContentsBytes[b];
IF bytes # expected THEN { WriteTextOctal["L:", bytes]; WriteText[","]; };
WriteFullAddr[b.address]
};
WriteBootFileNumber: PROC [b: Buffer] = {
bytes: CARDINAL = ContentsBytes[b];
IF bytes # 0 THEN { WriteTextOctal["L:", bytes]; WriteText[","]; };
WriteId[b.header.id];
};
DefaultBodyPrintout: PROC [b: Buffer] = {
WriteTextOctal["L:", ContentsBytes[b]];
};
{
misc: BOOL = b.header.source.socket = PupWKS.misc
OR b.header.dest.socket = PupWKS.misc;
lookupFile: BOOL = b.header.source.socket = PupWKS.fileLookup
OR b.header.dest.socket = PupWKS.fileLookup;
leaf: BOOL = b.header.source.socket = PupWKS.leaf
OR b.header.dest.socket = PupWKS.leaf;
teleSwat: BOOL = b.header.source.socket = PupWKS.teleSwat
OR b.header.dest.socket = PupWKS.teleSwat;
newMS: LONG CARDINAL = MSec[time];
SELECT (newMS-prevMS) FROM
< 10000 => WriteDecimal[(newMS-prevMS)];
< 1000*LONG[1000] => { -- 1000 seconds
WriteDecimal[(newMS-prevMS)/1000];
WriteChar['s]; }
ENDCASE => WriteText[IF prevMS = 0 THEN "first" ELSE "long"];
prevMS ← newMS;
WriteChar[':];
IF mode = display THEN {
IF Filter[b.header.dest] THEN {
SetPos[tabTo];
WriteText["to"];
SetPos[tabAddr];
WriteAddr[b.header.dest] }
ELSE {
SetPos[tabFrom];
WriteText["from"];
SetPos[tabAddr];
WriteAddr[b.header.source] };
SetPos[tabPkt]; }
ELSE {
DiskPos[diskFrom];
IF Filter[b.header.dest] THEN { WriteText[" to "]; WriteAddr[b.header.dest] }
ELSE { WriteText["from "]; WriteAddr[b.header.source] };
DiskPos[diskPkt]; };
WriteChar['[];
{
type: Rope.Text = SELECT b.header.type FROM
registered pup types
echoMe => "echoMe,",
iAmEcho => "iAmEcho,",
badEcho => "badEcho,",
error => "error,",
rfc => "rfc,",
abort => "abort,",
end => "end,",
endRep => "endRep,",
data => "data,",
aData => "aData,",
ack => "ack,",
mark => "mark,",
int => "int,",
intRep => "intRep,",
aMark => "aMark,",
eData => "eData,",
eAck => "eAck,",
eEnd => "eEnd,",
eAbort => "eAbort,",
rpp => "rpp,",
Cedar RPC pup types. Bits are:
8..10: 3 (=> start at pt140)
11: {end(0),notEnd(1)}
12: {dontAck(0),pleaseAck(1)}
13..15: {call,data,ack,spare,rfa}
LOOPHOLE[140B] => "RPC-call-end",
LOOPHOLE[141B] => "RPC-data-end",
LOOPHOLE[142B] => "RPC-ack",
LOOPHOLE[143B] => "RPC-spare",
LOOPHOLE[144B] => "RPC-RFA",
LOOPHOLE[150B] => "RPC-a-call-end",
LOOPHOLE[151B] => "RPC-a-data-end",
LOOPHOLE[152B] => "RPC-ping",
LOOPHOLE[153B] => "RPC-a-spare",
LOOPHOLE[154B] => "RPC-a-RFA",
LOOPHOLE[160B] => "RPC-call-more",
LOOPHOLE[161B] => "RPC-data-more",
LOOPHOLE[170B] => "RPC-a-call-more",
LOOPHOLE[171B] => "RPC-a-data-more",
unregistered pup types (possible overlap)
gatewayRequest--200-- =>
IF lookupFile THEN "fileLookup," ELSE "gatewayRequest,",
also dateTextRequest (socket 4), statisticsRequest (socket 22)
gatewayInfo--201-- =>
IF lookupFile THEN "fileInfo," ELSE "gatewayInfo",
also dateTextIs (socket 4), statisticsAre (socket 22)
tenexTimeRequest--202-- =>
IF lookupFile THEN "fileError,"
ELSE IF teleSwat THEN "go," ELSE "tenexTimeRequest,",
tenexTimeReply--203-- =>
IF teleSwat THEN "goReply," ELSE "tenexTimeReply,",
LOOPHOLE[204B] =>
IF teleSwat THEN "ack" ELSE "pt204",
altoTimeRequest--206-- => "altoTimeRequest",
altoTimeReply--207-- => "altoTimeReply,",
mailCheck--210-- => "mailCheck,",
mailIsNew--211-- => "mailIsNew",
mailNotNew--212-- => "mailNotNew",
mailError--213-- => "mailError",
mailCheckLaurel--214-- => "mailCheckL,",
nameLookup--220-- => "nameLookup,",
nameReply--221-- => "nameReply,",
nameError--222-- => "nameError,",
addressLookup--223-- => "addrLookup,",
addressReply--224-- => "addressReply,",
whereIsUser--230-- => "whereIsUser",
userIs--231-- => "userIs,",
userError--232-- => "userError,",
netDirVersion--240-- => "netDirVersion,",
sendNetDir--241-- => "sendNetDir,",
bootFileSend--244-- => "bootFileSend,",
kissOfDeath--247-- => "kissOfDeath,",
userAuthReq--250-- => "userAuthReq,",
userAuthOk--251-- => "userAuthOk,",
userAuthBad--252-- => "userAuthBad,",
bootDirReq--257-- => "bootDirReq,",
bootDirReply--260-- =>
IF leaf THEN "leaf," ELSE "bootDirReply,",
microcodeRequest--264-- => "microcodeRequest,",
microcodeReply--265-- => "microcodeReply,",
pageStoreRequest--300-- => "wCore,",
pageFetchRequest--301-- => "rCore,",
diskAddress--302-- => "diskAddr,",
diskStoreRequest--303-- => "wDisk,",
diskFetchRequest--304-- => "rDisk,",
ENDCASE => NIL;
IF type = NIL THEN {
WriteTextOctal["pt", b.header.type.ORD];
WriteText[","]; }
ELSE WriteText[type];
};
IF b.header.byteLength < PupType.bytesOfPupOverhead THEN {
Avoid Bounds Fault from bogus/mashed packet
WriteTextOctal[" *** byteLength is too short: ", b.header.byteLength];
WriteChar[Ascii.CR];
RETURN; };
SELECT b.header.type FROM
error => {
WriteOctal[b.error.code.ORD];
WriteString[",id:"];
WriteId[b.header.id];
IF b.header.source # b.error.header.dest THEN {
WriteString[",From:"];
WriteFullAddr[b.header.source]; };
WriteString[","];
WriteTail[b, SIZE[PupType.HeaderWithoutChecksum]+1+1]; };
eData => {
WriteText["id="];
WriteId[b.header.id];
WriteString[","];
WritePupHex[b]; };
eAck, eEnd => {
WriteText["id="];
WriteId[b.header.id]; };
abort => {
WriteOctal[b.abortCode];
WriteString[","];
WriteTail[b, 1]; };
data, aData => {
l: NAT = ContentsBytes[b];
WriteTo[b.header.id, l];
WriteTextOctal[",L:", l]; };
ack => {
WriteTo[b.header.id, 0];
WriteTextOctal[",b/p:", b.maximumBytesPerPup];
WriteTextOctal[",pups:", b.numberOfPupsAhead];
WriteTextOctal[",bytes:", b.numberOfBytesAhead]; };
mark, aMark => {
WriteTo[b.header.id, 1];
WriteTextOctal[",mk:", b.pupBytes[0]]; };
iAmEcho => WritePupHex[b];
rfc, echoMe => {
wellKnown: Rope.Text = SELECT b.header.dest.socket FROM
PupWKS.telnet => "telnet",
PupWKS.gatewayInfo => "gateway",
PupWKS.ftp => "ftp",
PupWKS.misc => "misc",
PupWKS.echo => "echo",
PupWKS.bspSink => "bspSink",
PupWKS.eftp => "eftp",
PupWKS.copyDisk => "copyDisk",
PupWKS.rpc => "rpc",
PupWKS.gvRSEnquiry => "RS-Enquiry",
PupWKS.gvRSPoll => "RS-Poll",
PupWKS.gvLily => "GV-Lily",
PupWKS.gvMSPoll => "MS-Poll",
PupWKS.gvMSForward => "MS-Forward",
PupWKS.gvMSClientInput => "MS-Send",
PupWKS.gvMSRetrieve => "MS-Retrieve",
ENDCASE => NIL;
IF wellKnown # NIL THEN WriteText[wellKnown];
SELECT b.header.type FROM
rfc => {
WriteString[","];
WriteId[b.header.id];
WriteString[","];
WriteFullAddr[b.address]; };
echoMe => { WriteString[","]; WritePupHex[b]; };
ENDCASE => NULL; };
end, endRep, int, intRep => WriteId[b.header.id];
IN [LOOPHOLE[140B]..LOOPHOLE[171B]] => {
Cedar RPC packet
h: LONG POINTER TO RPCPkt.Header = LOOPHOLE[@b.header];
overhead: CARDINAL = SIZE[RPCPkt.Header]+1--checksum--;
WriteText[",Len:"];
IF h.length < overhead THEN WriteTextOctal["**?-", overhead-h.length]
ELSE WriteOctal[h.length-overhead];
WriteTextOctal[",Cnv:", h.conv.ls MOD 1000B];
WriteTextOctal[",Call:", h.pktID.callSeq MOD 1000B];
WriteTextOctal[",Pkt:", h.pktID.pktSeq MOD 1000B];
IF h.type.class = call THEN
WriteTextOctal[",Disp:", h.dispatcher.dispatcherHint MOD 1000B]; };
altoTimeRequest => NULL;
altoTimeReply => {
pupTime: LONG CARDINAL ← Endian.CardFromF[b.time.time];
gmt: BasicTime.GMT ← BasicTime.nullGMT;
gmt ← BasicTime.FromPupTime[pupTime ! BasicTime.OutOfRange => CONTINUE];
IF gmt = BasicTime.nullGMT THEN WriteLongOctal[pupTime]
ELSE WriteTime[gmt]; };
mailCheck, mailCheckLaurel => WritePup[b];
mailIsNew, mailNotNew => NULL;
nameLookup => WritePup[b];
nameReply => {
bytes: NAT ← MIN[ContentsBytes[b], maxPupLength];
answers: NAT ← bytes/SIZE[Pup.Address, Basics.bytesPerWord];
FOR i: NAT IN [0..answers) DO
IF i # 0 THEN WriteText[","];
WriteFullAddr[b.addresses[i]];
ENDLOOP; };
nameError => WritePup[b];
addressLookup => WriteFullAddr[b.address];
addressReply => WritePup[b];
gatewayRequest => IF lookupFile THEN WritePup[b];
gatewayInfo =>
IF lookupFile THEN {
pupTime: LONG CARDINAL ← Endian.CardFromF[b.fileLookupReply.createTime];
gmt: BasicTime.GMT ← BasicTime.nullGMT;
gmt ← BasicTime.FromPupTime[pupTime ! BasicTime.OutOfRange => CONTINUE];
WriteText["V:"];
WriteDecimal[b.fileLookupReply.version];
WriteText[",T:"];
IF gmt = BasicTime.nullGMT THEN WriteLongOctal[pupTime] ELSE WriteTime[gmt];
WriteText[",L:"];
WriteLongDecimal[Endian.CardFromF[b.fileLookupReply.length]]; }
ELSE { -- Gateway
entries: CARDINAL = ContentsBytes[b] / PupBuffer.bytesPerRoutingInfoResponse;
WriteTextOctal[",N:", entries]; };
userAuthReq => WriteString[@(b.pupString)];
userAuthOk => DefaultBodyPrintout[b];
userAuthBad => DefaultBodyPrintout[b];
netDirVersion => {
bytes: CARDINAL ← ContentsBytes[b];
WriteText["Old:"];
WriteDecimal[b.pupWords[0]];
IF bytes = 4 THEN {
WriteText[",New:"];
WriteDecimal[b.pupWords[1]]; }; };
sendNetDir => WriteOneAddress[b];
bootFileSend => WriteBootFileNumber[b];
bootDirReply => {
SELECT TRUE FROM
leaf => WritePupHex[b];
ENDCASE => DefaultBodyPrintout[b]; };
microcodeRequest => WriteBootFileNumber[b];
microcodeReply => DefaultBodyPrintout[b];
pageStoreRequest, pageFetchRequest =>
IF teleSwat THEN
WriteLongOctal[LOOPHOLE[@b.pupBody, LONG POINTER TO TeledebugProtocol.CoreStoreRequest].page];
diskAddress =>
IF teleSwat AND ContentsBytes[b] = 2*SIZE[TeledebugProtocol.DiskAddressSetRequest] THEN
WriteLongOctal[LOOPHOLE[@b.pupBody, LONG POINTER TO TeledebugProtocol.DiskAddressSetRequest].page];
ENDCASE => DefaultBodyPrintout[b];
WriteChar[']];
SELECT TRUE FROM
mode = disk => {
IF showIdAndSockets THEN {
WriteChar[Ascii.CR];
DiskPos[diskPkt];
WriteText["id="];
WriteId[b.header.id];
WriteText[" "];
WriteFullAddr[b.header.dest];
WriteText[" <= "];
WriteFullAddr[b.header.source]; };
{
length: CARDINAL = MIN[ContentsBytes[b], maxPupLength];
IF showText > 0 THEN {
WriteChar[Ascii.CR];
DiskPos[diskPkt];
IF length = 0 THEN WriteText["{empty}"] ELSE {
chars: INT ← MIN[length, showText];
WriteMultiple[DESCRIPTOR[@(b.pupChars), chars]]; }; };
IF length # 0 AND showBytes THEN {
WriteChar[Ascii.CR];
DiskPos[diskPkt];
WriteText["Bytes="];
FOR i: CARDINAL IN [0..length) DO
WriteOctal[b.pupBytes[i]];
WriteChar[Ascii.SP]
ENDLOOP; };
IF length # 0 AND showWords THEN {
WriteChar[Ascii.CR];
DiskPos[diskPkt];
WriteText["Words="];
FOR i: CARDINAL IN [0..length/2) DO
WriteOctal[b.pupWords[i]];
WriteChar[Ascii.SP]
ENDLOOP; }; }; };
b.header.type = data, b.header.type = aData => {
SetPos[tabData];
WritePup[b]; };
ENDCASE;
WriteChar[Ascii.CR]; };
};
speed: {slow, fast} ← fast;
lookerCount: CARDINAL;
StartPause: PROC = {
WriteText["Pausing ..."];
SendNow[];
NotePausing[TRUE];
pauseWanted ← TRUE;
};
LookerMain: PROC = {
Process.SetPriority[lookerPriority ← wantedPriority];
DO
ENABLE ABORTED => EXIT;
this: BufferIndex = GetBuffer[];
IF ActivateLooker[] THEN {
IF lost[this] THEN {
WriteText["Lost packet(s)"];
WriteChar[Ascii.CR]; };
Watch[buffers + this * bufferSize, times[this]];
ReturnBuffer[];
IF speed = slow AND (lookerCount ← lookerCount+1) >= threeQuarterScreen
THEN StartPause[];
DeactivateLooker[]; };
ENDLOOP;
};
WriteDiskLog: PROC = {
WriteChar ← DiskChar;
WriteMultiple ← DiskMultiple;
mode ← disk;
WriteChar[Ascii.CR];
ReplayBuffers[];
IF logged[GetBuffer[]] THEN {
WriteText["{ continued from previous logged packets }"];
WriteChar[Ascii.CR];
FOR i: NAT IN [0..fullBuffers) DO
this: BufferIndex = GetBuffer[];
IF logged[this] THEN prevMS ← MSec[times[this]] ELSE EXIT;
ReturnBuffer[];
ENDLOOP; }
ELSE {
WriteTextOctal["Watching host ", wanted.net];
WriteTextOctal["#", wanted.host];
WriteText["#"];
WriteChar[Ascii.CR]; };
FOR i: NAT IN [0..fullBuffers) DO
this: BufferIndex = GetBuffer[];
IF lost[this] THEN {
WriteText["Lost packet(s)"];
WriteChar[Ascii.CR]; };
Watch[buffers + this * bufferSize, times[this]];
logged[this] ← TRUE;
ReturnBuffer[];
ENDLOOP;
DiskCommit[];
WriteChar ← DisplayChar;
WriteMultiple ← DisplayMultiple;
mode ← display;
};
user command input
WriteTitle: PROC = {
DisplayTitle[Rope.Cat["PupWatch: watching host ", PupName.AddressToRope[wanted]]];
};
DoAction: PROC [act: InputAction] = {
InputAction: TYPE = RECORD[SELECT act: * FROM
fast => NULL,
newHost => [name: ROPE],
pauseContinue => NULL,
quit => NULL,
replay => NULL,
slow => NULL,
start => NULL,
stop => NULL,
writeLog => [mouseButton: Menus.MouseButton, shift, control: BOOL],
pktSize => [big: BOOL],
ENDCASE];
alreadyPaused: BOOL;
ActivateInput[];
alreadyPaused ← pauseWanted;
IF pauseWanted AND act.act # pauseContinue THEN WriteChar[Ascii.CR];
lookerCount ← 0;
WITH act: act SELECT FROM
fast => {
WriteText["Fast"];
speed ← fast;
NoteSlow[FALSE];
pauseWanted ← FALSE; };
newHost => {
WriteText["Host ... "];
SendNow[];
GiveEthernet[]; -- stops driver
SELECT Lookup[act.name] FROM
ok => {
WriteText["ok"];
SendNow[];
Clear[];
FlushBuffers[];
WriteTitle[];
pauseWanted ← FALSE; };
noResponse => WriteText["no name-lookup response"];
noRoute => WriteText["no route to that host"];
badName => WriteText["name not found"];
ENDCASE => ERROR;
TakeEthernet[]; }; -- starts driver
pktSize => AllocBuffers[big: act.big];
replay => {
Clear[];
WriteText["Replay (Slow)"];
ReplayBuffers[]; speed ← slow;
NoteSlow[TRUE];
pauseWanted ← FALSE; };
slow => {
WriteText["Slow"];
speed ← slow;
NoteSlow[TRUE];
pauseWanted ← FALSE; };
start => {
InitTabs[];
AllocBuffers[big: FALSE];
wanted ← PupSocket.GetMyAddress[];
myNet ← wanted.net;
WriteTitle[];
pauseWanted ← FALSE;
lookerProcess ← FORK LookerMain[];
TakeEthernet[]; };
stop => {
Process.Abort[lookerProcess];
JOIN lookerProcess;
GiveEthernet[];
FreeBuffers[]; };
writeLog => {
showBytes ← act.shift;
showWords ← act.control;
SELECT act.mouseButton FROM
red => showText ← 0; -- Left
yellow => showText ← 50; -- Middle
blue => showText ← 1000; -- Right
ENDCASE => showText ← 1000;
WriteText["Writing log file ... "];
SendNow[];
WriteDiskLog[];
WriteText["ok"];
showText ← 1000; };
pauseContinue =>
IF pauseWanted THEN { WriteText[" continuing"]; pauseWanted ← FALSE; }
ELSE StartPause[];
ENDCASE => ERROR;
IF ~pauseWanted OR alreadyPaused THEN WriteChar[Ascii.CR];
IF ~pauseWanted AND act.act # stop THEN NotePausing[FALSE];
DeactivateInput[];
};
Address Lookup
LookupOutcome: TYPE = { ok, badName, noResponse, noRoute };
Lookup: PROC [name: ROPE] RETURNS [outcome: LookupOutcome] = {
outcome ← ok;
wanted ← PupName.NameLookup[IF name.Length[] = 0 THEN "ME" ELSE name, Pup.nullSocket
! PupName.Error => {
outcome ← SELECT code FROM noRoute => noRoute, noResponse => noResponse,
ENDCASE => badName;
CONTINUE }];
};
Display interface
font: ImagerFont.Font = VFonts.EstablishFont["Helvetica",8];
fontAscent: REAL ← ImagerFont.FontBoundingBox[font].ascent;
fontDescent: REAL ← ImagerFont.FontBoundingBox[font].descent;
fontSpace: REAL ← fontAscent+fontDescent;
topPos: REAL = fontAscent;
myViewer: Viewer;
pause, fast, slow, hostText: Viewer;
line: REF TEXT = NEW[TEXT[500+3*bigPupLength]];
xPos: REAL ← 0.0;
yPos: REAL ← topPos; -- offset from top of text area --
DisplayChar: PROC [c: CHAR] = {
IF c = Ascii.CR THEN { SendNow[]; xPos ← 0.0; yPos ← yPos + fontSpace; }
ELSE { line[line.length] ← c; line.length ← line.length+1 };
};
DisplayMultiple: PROC [desc: LONG DESCRIPTOR FOR PACKED ARRAY OF CHAR] = {
amount: CARDINAL = MIN[line.maxLength-line.length, LENGTH[desc]];
IF line.length MOD 2 = 0 THEN
PrincOpsUtils.LongCopy[
from: BASE[desc],
nwords: (amount+1)/2,
to: LOOPHOLE[line,LONG POINTER]+SIZE[TEXT[0]]+line.length/2]
ELSE FOR i: CARDINAL IN [0..amount) DO line[line.length+i] ← desc[i]; ENDLOOP;
line.length ← line.length + amount;
};
GetLength: PROC [r: ROPE] RETURNS [length: REAL] = {
RETURN[ImagerFont.RopeWidth[font, r].x]
};
SetPos: PROC [pos: REAL] = {
SendNow[];
xPos ← pos;
};
SendNow: PROC = {
ViewerOps.PaintViewer[myViewer, client, FALSE, line];
line.length ← 0;
};
Clear: PROC = {
ViewerOps.PaintViewer[myViewer, client, FALSE, $Clear];
};
DisplayTitle: PROC [rope: ROPE] = {
myViewer.parent.name ← rope;
ViewerOps.PaintViewer[myViewer.parent, caption, FALSE, NIL];
};
myClass: ViewerClasses.ViewerClass = NEW[ViewerClasses.ViewerClassRec ←[
paint: MyPaint,
destroy: MyDestroy,
icon: tool]];
screenLines: CARDINAL ← 0;
threeQuarterScreen: CARDINAL ← 0;
MyPaint: ViewerClasses.PaintProc = TRUSTED {
self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOLEAN
bounds: Imager.Rectangle = ImagerBackdoor.GetBounds[context];
box: Imager.Box ← [xmin: bounds.x, xmax: bounds.x+bounds.w, ymin: bounds.y, ymax: bounds.y+bounds.h];
IF whatChanged = NIL THEN {
tempY: REAL ← topPos;
yPos ← topPos;
screenLines ← 0;
WHILE box.ymax - tempY - fontDescent >= box.ymin DO
screenLines ← screenLines+1;
tempY ← tempY + fontSpace;
ENDLOOP;
threeQuarterScreen ← (screenLines * 3) / 4;
RETURN };
WITH whatChanged SELECT FROM
text: REF TEXT => {
IF box.ymax - yPos - fontDescent < box.ymin THEN yPos ← topPos;
IF xPos = 0.0 THEN {
start of a new line
yBase: REAL =
IF box.ymax - yPos - fontDescent - fontSpace < box.ymin
THEN topPos
ELSE yPos + fontSpace;
Imager.SetColor[context, Imager.white];
Imager.MaskBox[context, [
xmin: box.xmin, ymin: box.ymax - yBase - fontDescent,
xmax: box.xmax, ymax: box.ymax - yBase + fontAscent]];
Imager.SetColor[context, Imager.black];
};
Imager.SetXY[context, [box.xmin + xPos, box.ymax - yPos]];
Imager.SetFont[context, font];
FOR i: NAT IN [0..text.length) DO
We force all characters > \177 to be that character, to avoid problems with potentially small fonts for our printing.
IF text[i] > '\177 THEN text[i] ← '\177;
ENDLOOP;
Imager.ShowText[context, text];
xPos ← ImagerBackdoor.GetCP[context].x - box.xmin;
};
x: ATOM => SELECT x FROM
$Clear => {
Imager.SetColor[context, Imager.white];
Imager.MaskBox[context,
[xmin: box.xmin, ymin: box.ymin,
xmax: box.xmax, ymax: box.ymax - topPos + fontAscent]];
xPos ← 0.0;
yPos ← topPos;
};
ENDCASE => NULL;
ENDCASE => NULL;
};
MyDestroy: ViewerClasses.DestroyProc = TRUSTED {
self: Viewer
Process.Detach[FORK DoAction[[stop[]]]];
};
active: ATOM = $WhiteOnBlack;
Create: PROC RETURNS [text: Viewer] = {
returns viewer which is the non-scrolling text area
outer: Viewer = Containers.Create[
info: [name: "PupWatch", column: right, scrollable: FALSE, iconic: TRUE]];
child: Viewer ← CreateChildren[outer];
Buttons.SetDisplayStyle[fast, active, FALSE];
text ← ViewerOps.CreateViewer[
flavor: $PupWatch,
info: [parent: outer, scrollable: FALSE, border: FALSE, wx: 2, wy: child.wy + child.wh + 2]];
Containers.ChildXBound[outer, text];
Containers.ChildYBound[outer, text];
ViewerOps.OpenIcon[outer];
};
CreateChildren: PROC [v: Viewer] RETURNS [child: Viewer] = {
InputButton: PROC [name: ROPE, action: InputAction] = {
child ← Buttons.Create[
info: [name: name, parent: v, border: TRUE,
wx: IF child = NIL THEN 2 ELSE 2+child.wx+child.ww,
wy: IF child = NIL THEN 1 ELSE child.wy],
proc: DoSimpleAction,
clientData: NEW[InputAction ← action],
fork: TRUE];
};
SimpleLabel: PROC [name: ROPE, newLine: BOOL ← FALSE] = {
child ← Labels.Create[
info: [name: name, parent: v, border: FALSE,
wx: IF newLine THEN 2 ELSE 2+child.wx+child.ww,
wy: IF newLine THEN child.wy + child.wh + 2 ELSE child.wy]];
};
SimpleButton: PROC [name: ROPE, proc: Buttons.ButtonProc, newLine: BOOL ← FALSE, border: BOOL ← TRUE] RETURNS [Viewer] = {
child ← Buttons.Create[
info: [name: name, parent: v, border: border,
wx: IF newLine THEN 2 ELSE 2+child.wx+child.ww,
wy: IF newLine THEN child.wy + child.wh + 2 ELSE child.wy],
proc: proc, fork: TRUE];
RETURN [child];
};
child ← NIL;
InputButton["Continue", [pauseContinue[]]]; pause ← child;
InputButton["Fast", [fast[]]]; fast ← child;
InputButton["Slow", [slow[]]]; slow ← child;
InputButton["Replay", [replay[]]];
[] ← SimpleButton["WriteLog", DoWriteLog];
[] ← SimpleButton["NewHost", DoHost];
[] ← SimpleButton[" Host: ", DoHostPrompt, FALSE, TRUE];
hostText ← ViewerTools.MakeNewTextViewer[
info: [parent: v, scrollable: FALSE, border: FALSE,
wx: 2+child.wx+child.ww, wy: child.wy,
ww: v.cw-(2+child.wx+child.ww), wh: child.wh]];
Containers.ChildXBound[v, hostText];
child ← MakeBool[name: "Bkg", init: background, change: DoPriority, parent: v, x: 2, y: child.wy+child.wh+2];
child ← MakeBool[name: "Big", init: big, change: DoSize, parent: v, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "Bcst", init: broadcast, parent: v, x: child.wx+child.ww+5, y: child.wy];
child ← MakeBool[name: "Route", init: route, parent: v, x: child.wx+child.ww+5, y: child.wy];
child ← MakeBool[name: "Misc", init: misc, parent: v, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "RPC", init: rpc, parent: v, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "Echo", init: echo, parent: v, x: child.wx+child.ww+5, y: child.wy];
child ← MakeBool[name: "Err", init: error, parent: v, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "RAEE", init: raee, parent: v, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "Data", init: aData, parent: v, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "Mark", init: mark, parent: v, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "Ack", init: ack, parent: v, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "Eftp", init: eftp, parent: v, x: child.wx+child.ww+2, y: child.wy];
};
BoolProc: TYPE = PROC [parent: Viewer, clientData: REF, value: BOOL];
Bool: TYPE = REF BoolRec;
BoolRec: TYPE = RECORD [
value: REF BOOL,
change: BoolProc,
clientData: REF,
button: Viewer ];
MakeBool: PROC [name: ROPE, init: REF BOOL, change: BoolProc ← NIL, clientData: REF ← NIL, parent: Viewer, x, y: INTEGER]
RETURNS [child: Viewer] = {
bool: Bool ← NEW [BoolRec ← [
value: IF init # NIL THEN init ELSE NEW [BOOL ← TRUE],
change: change,
clientData: clientData,
button: NIL ] ];
child ← Buttons.Create[
info: [name: name, parent: parent, border: TRUE, wx: x, wy: y],
proc: BoolHelper, clientData: bool, fork: TRUE, paint: TRUE];
bool.button ← child;
IF bool.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack];
};
BoolHelper: Buttons.ButtonProc = TRUSTED {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
self: Buttons.Button = NARROW[parent];
bool: Bool = NARROW[clientData];
bool.value^ ← ~bool.value^;
IF bool.value^ THEN Buttons.SetDisplayStyle[bool.button, $WhiteOnBlack]
ELSE Buttons.SetDisplayStyle[bool.button, $BlackOnWhite];
IF bool.change # NIL THEN bool.change[self.parent, bool.clientData, bool.value^];
};
NotePausing: ENTRY PROC [nowPausing: BOOL] = {
Buttons.ReLabel[pause, IF nowPausing THEN "Continue" ELSE "Pause"];
};
DoSimpleAction: Buttons.ButtonProc = TRUSTED {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
DoAction[NARROW[clientData, REF InputAction]^];
};
isSlow: BOOL ← FALSE;
NoteSlow: ENTRY PROC [nowSlow: BOOL] = {
Buttons.SetDisplayStyle[IF isSlow THEN slow ELSE fast, $BlackOnWhite];
isSlow ← nowSlow;
Buttons.SetDisplayStyle[IF isSlow THEN slow ELSE fast, active];
};
DoWriteLog: Buttons.ButtonProc = TRUSTED {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
DoAction[[writeLog[mouseButton, shift, control]]];
};
DoHost: Buttons.ButtonProc = TRUSTED {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
DoAction[[newHost[ViewerTools.GetContents[hostText]]]];
};
DoHostPrompt: Buttons.ButtonProc = TRUSTED {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
text: Viewer = hostText;
SELECT mouseButton FROM
red => ViewerTools.SetSelection[text, NIL];
blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] };
yellow => NULL;
ENDCASE => ERROR;
};
DoPriority: BoolProc = TRUSTED {
IF background^ THEN wantedPriority ← Process.priorityBackground
ELSE wantedPriority ← Process.priorityNormal;
};
DoSize: BoolProc = TRUSTED {
DoAction[[pktSize[big: big^]]];
};
Disk logging
logName: Rope.ROPE = "PupWatch.log";
file: IO.STREAM;
lineLength: NAT ← 0;
lineMaxlength: NAT = 100;
firstChar: BOOL ← TRUE;
firstTime: BOOL ← TRUE;
DiskChar: PUBLIC PROC [c: CHAR] = {
IF firstChar THEN {
firstChar ← FALSE;
IF firstTime THEN {
firstTime ← FALSE;
file ← FS.StreamOpen[logName, $create]; }
ELSE {
[] ← FS.Copy[from: logName, to: logName, keep: 1 ! FS.Error => CONTINUE];
file ← FS.StreamOpen[logName, $append]; };
LogTime[]; };
IF c = Ascii.CR THEN { IO.PutChar[file, c]; lineLength ← 0 }
ELSE { IO.PutChar[file, c]; lineLength ← lineLength+1 };
};
LogTime: PROC = {
IO.PutRope[file, "PupWatch.log written at "];
IO.Put[file, [time[BasicTime.Now[]]]];
};
DiskMultiple: PUBLIC PROC [desc: LONG DESCRIPTOR FOR PACKED ARRAY OF CHAR] = {
FOR i: CARDINAL IN [0..LENGTH[desc]) DO
c: CHAR = desc[i];
IF c IN [40C..176C] THEN DiskChar[c] ELSE DiskChar['?];
ENDLOOP;
};
DiskPos: PUBLIC PROC [pos: NAT] = {
FOR i: NAT IN [lineLength..pos) DO
IO.PutChar[file, Ascii.SP];
lineLength ← lineLength.SUCC;
ENDLOOP;
};
DiskCommit: PUBLIC PROC = {
DiskChar[Ascii.CR];
DiskChar[Ascii.CR];
IO.Close[file];
{
v: Viewer = ViewerOps.FindViewer["PupWatch.log"].viewer;
IF v = NIL THEN [] ← ViewerTools.MakeNewTextViewer[
info: [name: logName, file: "PupWatch.log", iconic: FALSE]]
ELSE ViewerOps.RestoreViewer[v];
};
firstChar ← TRUE;
};
Initialization
Process.EnableAborts[@bufferChange];
Process.EnableAborts[@inputChange];
Process.EnableAborts[@lookerChange];
ViewerOps.RegisterViewerClass[$PupWatch, myClass];
myViewer ← Create[];
DoAction[[start[]]];
DoAction[[newHost[NIL]]];
}.