PupTool.mesa;
By Steve Temple on August 27, 1982 9:39 am
Adapted from PupHacks by Hal Murray
Last edited by Steve Temple, November 11, 1982 2:41 pm
Converted to Cedar 5.2 by Neil Gunther, February 27, 1985 3:40:54 pm PST
Last edited by John Larson, July 29, 1985 4:41:57 pm PDT
DIRECTORY
BasicTime: TYPE USING [Now],
Buttons: TYPE USING [Button, ButtonProc, Create],
Commander USING [CommandProc, Register],
Containers: TYPE USING [ChildXBound, ChildYBound, Container, Create],
DriverDefs: TYPE USING [Network],
IO,
Labels: TYPE USING [Create, Label, Set, SetDisplayStyle],
Menus: TYPE USING [AppendMenuEntry, CreateEntry, CreateMenu, Menu, MenuProc],
Process: TYPE USING [Pause, SecondsToTicks],
ProcessorFace USING [processorID],
PupDefs: TYPE USING [DataWordsPerPupBuffer,
GetFreePupBuffer, GetPupAddress, GetPupContentsBytes,
MoveRopeToPupBuffer, ReturnFreePupBuffer, PupAddressToRope,
PupBuffer, PupNameTrouble, PupPackageDestroy,
PupPackageMake, PupRouterBroadcastThis, PupSocket,
PupSocketDestroy, PupSocketMake, SecondsToTocks,
SetPupContentsBytes],
PupRouterDefs: TYPE USING [GetRoutingTable,
GetRoutingTableEntry, RoutingTableEntry, RoutingTable, RoutingTableObject],
PupTypes: TYPE USING [echoSoc, fillInPupAddress, fillInSocketID,
maxDataWordsPerGatewayPup, miscSrvSoc, PupAddress, PupSocketID],
Rope: TYPE USING [Concat, FromChar, Length, ROPE, Substr],
SystemVersion USING [machineType],
TypeScript: TYPE USING [Create],
VFonts: TYPE USING [CharWidth],
ViewerClasses: TYPE USING [Viewer, ViewerClassRec],
ViewerIO: TYPE USING [CreateViewerStreams],
ViewerOps: TYPE USING [DestroyViewer, PaintViewer],
ViewerTools: TYPE USING [GetContents, MakeNewTextViewer, SetSelection];


PupTool: MONITOR

IMPORTS
BasicTime, Buttons, Commander, Containers,
IO, Labels, Menus, Process, ProcessorFace, PupDefs,
PupRouterDefs, Rope, SystemVersion, TypeScript,
VFonts, ViewerIO, ViewerOps, ViewerTools = BEGIN

entryHeight: NAT = 15;
entryVSpace: NAT = 8;
entryHSpace: NAT = 10;

-- a ToolHandle is a REF to the data for a particular instance of the tool.

ToolHandle: TYPE = REF ToolHandleRec;

ToolHandleRec: TYPE = RECORD [
 pleaseStop, echoInUse: BOOLFALSE, -- useful flags
 viewer, root, msg: ViewerClasses.Viewer, -- viewer and parent
 out: IO.STREAM,        -- text stream
 echoThrough: CONDITION];    -- echo process is done

  
MakeTool: PROC = BEGIN
 handle: ToolHandle ← NEW[ToolHandleRec];
 promptButton, textBox: ViewerClasses.Viewer;
 menu: Menus.Menu ← Menus.CreateMenu[1];
 height: NAT ← 0;
 charSize: INTEGER = VFonts.CharWidth['0];
 initData: Rope.ROPE = "ME"; -- must use this string

 PupDefs.PupPackageMake[];
  
 handle.root ← Containers.Create[[
  name: "PupTool",
  iconic: TRUE,
  menu: menu,
  column: left,
  scrollable: FALSE
  ]];  

 Menus.AppendMenuEntry[menu: menu, line: 0,
  entry: Menus.CreateEntry[clientData: handle,
  name: "EchoOn", proc: EchoProc, fork: TRUE]];
      
 Menus.AppendMenuEntry[menu: menu, line: 0,
  entry: Menus.CreateEntry[clientData: handle,
  name: "EchoOff", proc: StopProc, fork: FALSE]];

 Menus.AppendMenuEntry[menu: menu, line: 0,
  entry: Menus.CreateEntry[clientData: handle,
  name: "RoutingTable", proc: RouteProc, fork: FALSE]];
   
 Menus.AppendMenuEntry[menu: menu, line: 0,
  entry: Menus.CreateEntry[clientData: handle,
  name: "GetName", proc: ToNameProc, fork: FALSE]];
   
 Menus.AppendMenuEntry[menu: menu, line: 0,
  entry: Menus.CreateEntry[clientData: handle,
  name: "GetAddress", proc: ToAddressProc, fork: FALSE]];  

   
 Menus.AppendMenuEntry[menu: menu, line: 0,
  entry: Menus.CreateEntry[clientData: handle,
  name: "ProcessorID", proc: GetProcID, fork: FALSE]];  


 height ← height + entryVSpace;
   
 promptButton ← Buttons.Create[
  info: [name: "Name or Address", wy: height, wh: entryHeight,
    wx: 10*charSize, parent: handle.root],
  proc: Prompt,
  clientData: handle];
    
 handle.viewer ← ViewerTools.MakeNewTextViewer[[
  parent: handle.root,
  wx: promptButton.wx + promptButton.ww + entryHSpace,
  wy: height+2, -- (hack: add 2 to align text with button baseline)
  ww: 50*charSize, -- 50 digits worth of width
  wh: entryHeight,
  data: initData,
  scrollable: FALSE,
  border: FALSE
  ]];
  
 height ← height + entryHeight + entryVSpace;
   
 handle.msg ← Labels.Create[[
  parent: handle.root,
  wx: 10*charSize,
  wy: height,
  ww: 80*charSize, -- 80 digits worth of width
  wh: entryHeight,
  border: FALSE
  ]];
  
 height ← height + entryHeight + entryVSpace; -- interline spacing

 textBox ← TypeScript.Create [[
parent: handle.root,
border: FALSE,
wy: height
]];

Containers.ChildXBound[handle.root, textBox];
Containers.ChildYBound[handle.root, textBox];

 [, handle.out] ← ViewerIO.CreateViewerStreams[viewer: textBox, name: NIL]; 
PrintHeaderLine[handle.out];
ViewerOps.PaintViewer[handle.root, all];

END;


Prompt: Buttons.ButtonProc = TRUSTED BEGIN
 handle: ToolHandle ← NARROW[clientData]; -- get our data
 ViewerTools.SetSelection[handle.viewer];  -- force the selection
END;

PrintHeaderLine: PROC[out: IO.STREAM] = BEGIN
 meID: PupTypes.PupSocketID ← [0,0];
 me: PupTypes.PupAddress ← [,,[0,0]];
 pID: RECORD[a, b, c: NAT] ← LOOPHOLE[ProcessorFace.processorID];

 me ← PupDefs.GetPupAddress[meID, "ME"]; -- must use this string
IO.PutF[out, "PupTool of %t running on a %g processor\n",
IO.time[BasicTime.Now[]],
  [rope[SELECT SystemVersion.machineType FROM
  dolphin => "Dolphin",
  dorado => "Dorado",
  dandelion => "Dandelion",
  dicentra => "Dicentra",
  ENDCASE => "{Unknown processor type!}"]]];  
END;

ErrorMsg: PROC[l: Labels.Label, r: Rope.ROPENIL] = BEGIN
IF Rope.Length[r] > 70 THEN r ← Rope.Substr[r, 0, 70];
IF Rope.Length[r] < 62 THEN r ← Rope.Concat["ERROR —> ", r];
 Labels.Set[l, r];
 Labels.SetDisplayStyle[l, $WhiteOnBlack];
 Process.Pause[Process.SecondsToTicks[1]];  
 Labels.SetDisplayStyle[l, $BlackOnWhite];
 END;

ClearMsg: PROC[l: Labels.Label] = BEGIN
 Labels.Set[l, NIL];
 Labels.SetDisplayStyle[l, $BlackOnWhite];
END;

InRope: PROC[v: ViewerClasses.Viewer] RETURNS [r: Rope.ROPE ← NIL] = BEGIN
 r ← ViewerTools.GetContents[v];
END;

PutSep: PROC[out: IO.STREAM] = BEGIN
IO.PutText[out, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n"];
END;

NewLine: PROC[out: IO.STREAM] = BEGIN
IO.PutChar[out, '\n];
END;

ErrorPupToRope: PROC[b: PupDefs.PupBuffer] RETURNS[s: Rope.ROPE]=
 BEGIN
 source: PupTypes.PupAddress ← b.source;
 IF b.pupType = error THEN
BEGIN
 len: NAT = PupDefs.GetPupContentsBytes[b];
 s ← IO.PutFR["[Pup, code=%b, from: ", IO.card[LOOPHOLE[b.errorCode, NAT]]];
 s ← Rope.Concat[s, PupDefs.PupAddressToRope[source]];
 s ← Rope.Concat[s, "] "];
FOR i: NAT IN [0..len-2*(10+1+1)) DO
s ← Rope.Concat[s, Rope.FromChar[b.errorText[i]]];
ENDLOOP;
END
ELSE
s ← IO.PutFR["## Funny PupType = %b ##\n ",
IO.card[LOOPHOLE[b.pupType, NAT]]];
END;


PupBodyToRope: PROC[b: PupDefs.PupBuffer] RETURNS[s: Rope.ROPE]=
BEGIN
s ← NIL;
FOR i: NAT IN [0..PupDefs.GetPupContentsBytes[b]) DO
s ← Rope.Concat[s, Rope.FromChar[b.pupChars[i]]]; ENDLOOP;
END;


EchoProc: Menus.MenuProc = TRUSTED
BEGIN OPEN PupDefs, PupTypes;

h: ToolHandle = NARROW[clientData];
bytesPerBuffer: NAT;
funny, late, recv, sent, wrong: INT ← 0;
me, where: PupAddress ← [,,echoSoc];
mySoc: PupSocket;
mySocID: PupSocketID ← echoSoc;
packetNumber: NAT ← 0;
routing: PupRouterDefs.RoutingTableEntry;
r: Rope.ROPE;

IF EchoIsInUse[h] THEN RETURN;
ClearMsg[h.msg];
r ← InRope[h.viewer];
IF Rope.Length[r] = 0 THEN {ErrorMsg[h.msg, "Name needed"]; GOTO GetOut};
where ←
GetPupAddress[mySocID, r ! PupNameTrouble => {ErrorMsg[h.msg, e]; GOTO GetOut }];
mySoc ← PupSocketMake[fillInSocketID, where, SecondsToTocks[2]];
me ← mySoc.getLocalAddress[];

PutSep[h.out];
IO.PutF[h.out, "Echo to <%g> via [%g] => [", IO.rope[r], IO.rope[PupAddressToRope[me]]];
routing ← PupRouterDefs.GetRoutingTableEntry[where.net];
IF (routing.hop # 0) AND (routing.network # NIL) THEN
IO.PutF[h.out, "%b#%b#] => [",
IO.card[LOOPHOLE[routing.network.netNumber.b, NAT]],
IO.card[LOOPHOLE[routing.route, NAT]]];
IO.PutF[h.out, "%g]\n", IO.rope[PupAddressToRope[where]]];

bytesPerBuffer ←
2*MIN[DataWordsPerPupBuffer[], maxDataWordsPerGatewayPup];
UNTIL EchoShouldStop[h] DO
FOR len: NAT IN [0..bytesPerBuffer] UNTIL EchoShouldStop[h] DO
b: PupBuffer ← GetFreePupBuffer[];
b.pupID.a ← b.pupID.b ← (packetNumber ← packetNumber+1);
b.pupType ← echoMe;
SetPupContentsBytes[b,len];
FOR i: NAT IN [0..len) DO b.pupBytes[i] ← i MOD 400B; ENDLOOP;
mySoc.put[b];
sent ← sent+1;
UNTIL (b ← mySoc.get[]) = NIL DO
SELECT TRUE FROM
(b.pupType # iAmEcho) => {funny ← funny+1;
ErrorMsg[h.msg, ErrorPupToRope[b]];
IO.PutChar[h.out, 'x]; GOTO Wrong};
((b.pupID.a # packetNumber)
OR (b.pupID.b # packetNumber)
OR (len # GetPupContentsBytes[b])) => {IO.PutChar[h.out, '#]; late ← late+1 };
ENDCASE =>
BEGIN
FOR i: NAT IN [0..len) DO
IF b.pupBytes[i] # (i MOD 400B) THEN
{wrong ← wrong+1; IO.PutChar[h.out, '~]; GOTO Wrong};
ENDLOOP;
IO.PutChar[h.out, '!]; -- successful echo
recv ← recv+1;
EXIT;
END;
ReturnFreePupBuffer[b];
REPEAT Wrong => NULL;
ENDLOOP;
IF b # NIL THEN ReturnFreePupBuffer[b] ELSE IO.PutChar[h.out, '?];
ENDLOOP;
NewLine[h.out];
ENDLOOP;
PupSocketDestroy[mySoc];
IO.PutF[h.out, "Out: %d, In: %d (%d%%)\n",    -- ? timedout
IO.card[sent], IO.card[recv], IO.card[(recv*100)/sent]]; -- ! ok (outbound)
IF late # 0 THEN
IO.PutF[h.out, "Late: %d (%d%%)\n", IO.card[late], IO.card[(late*100)/sent]]; -- #
IF funny # 0 THEN IO.PutF[h.out, "%d funny packets\n", IO.card[funny]]; -- x
IF wrong # 0 THEN IO.PutF[h.out, "%d wrong data\n", IO.card[wrong]]; -- ~
EchoUserStopped[h];
EXITS GetOut => {h: ToolHandle = NARROW[clientData]; EchoUserStopped[h]};
END;


RouteProc: Menus.MenuProc = TRUSTED BEGIN
pupRt: PupRouterDefs.RoutingTable;
h: ToolHandle ← NARROW[clientData];
k: NAT ← 0;

PutSep[h.out];
ClearMsg[h.msg];
IO.PutText[h.out, "Local PupRouting Table\n"];
IO.PutText[h.out, "| Net Via Hops | Net Via Hops | Net Via Hops |\n"];
IO.PutText[h.out, "|.....................................|.......................................|......................................|\n"];
pupRt ← PupRouterDefs.GetRoutingTable[];

FOR i: NAT IN [0..pupRt.length) DO
r: PupRouterDefs.RoutingTableEntry = @pupRt[i];
network: DriverDefs.Network = r.network;
IF network=NIL THEN LOOP;
IF k=0 THEN IO.PutChar[h.out, '|];
IO.PutF[h.out, "%4b%4b#", IO.card[i],
IO.card[LOOPHOLE[network.netNumber.b, NAT]]];
IO.PutF[h.out, "%03b#%4b |",
IO.card[IF r.hop # 0 THEN r.route ELSE network.hostNumber], IO.card[r.hop]];
IF (k←k+1)=3 THEN {NewLine[h.out]; k𡤀};
ENDLOOP;
IF k # 0 THEN NewLine[h.out];
IO.PutText[h.out, "|.....................................|.......................................|......................................|\n\n"];
END;


ToNameProc: Menus.MenuProc = TRUSTED
BEGIN OPEN PupTypes, PupDefs;
h: ToolHandle = NARROW[clientData];
soc: PupSocket;
b: PupBuffer;
addrID: PupSocketID ← [0, 0];
addr: PupAddress ← [, , [0, 0]];
hit: BOOLFALSE;
r: Rope.ROPE;

r ← InRope[h.viewer];
ClearMsg[h.msg];
IF Rope.Length[r] = 0 THEN BEGIN ErrorMsg[h.msg, "Address needed"]; RETURN; END;
addr ← GetPupAddress[addrID, r ! PupNameTrouble =>
{ErrorMsg[h.msg, e]; GOTO NoName;}];
soc ← PupSocketMake[fillInSocketID, fillInPupAddress, SecondsToTocks[2]];

THROUGH [0..10) UNTIL hit DO
b ← GetFreePupBuffer[];
b.pupType ← addressLookup;
b.pupID ← [0, 0];
b.dest.socket ← PupTypes.miscSrvSoc;
b.source ← soc.getLocalAddress[];
b.address ← addr;
SetPupContentsBytes[b, 2*SIZE[PupAddress]];
PupRouterBroadcastThis[b];
UNTIL hit OR (b ← soc.get[]) = NIL DO
SELECT b.pupType FROM
  addressIs =>
BEGIN
  hit ← TRUE;
  PutSep[h.out];
IO.PutF[h.out, "Name of <%g> is: %g\n", IO.rope[r], IO.rope[PupBodyToRope[b]]];
END;
  nameError =>
BEGIN
  hit ← TRUE;
  ErrorMsg[h.msg, PupBodyToRope[b]];
END;
ENDCASE => ErrorMsg[h.msg, ErrorPupToRope[b]];
 ReturnFreePupBuffer[b];
ENDLOOP;
IF ~hit THEN ErrorMsg[h.msg, "No Response that try"];
ENDLOOP;
PupSocketDestroy[soc];
EXITS NoName => NULL;
END;

  
ToAddressProc: Menus.MenuProc = TRUSTED
BEGIN OPEN PupTypes, PupDefs;
h: ToolHandle = NARROW[clientData];
soc: PupSocket;
b: PupBuffer;
hit: BOOLFALSE;
r: Rope.ROPE;

r ← InRope[h.viewer];
ClearMsg[h.msg];
IF Rope.Length[r] = 0 THEN BEGIN ErrorMsg[h.msg, "Name needed"]; RETURN; END;
soc ← PupSocketMake[fillInSocketID, fillInPupAddress, SecondsToTocks[2]];
THROUGH [0..10) UNTIL hit DO
b ← GetFreePupBuffer[];
b.pupType ← nameLookup;
b.pupID ← [0, 0];
b.dest.socket ← PupTypes.miscSrvSoc;
b.source ← soc.getLocalAddress[];
PupDefs.MoveRopeToPupBuffer[b, r];
PupRouterBroadcastThis[b];
UNTIL hit OR (b ← soc.get[]) = NIL DO
SELECT b.pupType FROM
  nameIs =>
BEGIN
  n: NAT ← GetPupContentsBytes[b]/(2*SIZE[PupAddress]);
  addresses: LONG POINTER TO ARRAY [0..0) OF PupAddress ←
LOOPHOLE[@b.pupBody];
  hit ← TRUE;
  PutSep[h.out];
IO.PutF[h.out, "Address of <%g> is: ", IO.rope[r]];
FOR i: NAT IN [0..n) DO
IF i # 0 THEN IO.PutText[h.out, ", "];
IO.PutRope[h.out, PupAddressToRope[addresses[i]]];
ENDLOOP;
  NewLine[h.out];
END;
  nameError =>
BEGIN
  hit ← TRUE;
  ErrorMsg[h.msg, PupBodyToRope[b]];
END;
ENDCASE => ErrorMsg[h.msg, ErrorPupToRope[b]];
 ReturnFreePupBuffer[b];
ENDLOOP;
IF ~hit THEN ErrorMsg[h.msg, "No Response that try"];
ENDLOOP;
PupSocketDestroy[soc];
END;

QuitProc: Menus.MenuProc = TRUSTED
BEGIN
 h: ToolHandle = NARROW[clientData];
 StopEchoUser[h];
 ViewerOps.DestroyViewer[h.root];
 PupDefs.PupPackageDestroy[];
END;

StopProc: Menus.MenuProc = TRUSTED
BEGIN
 h: ToolHandle = NARROW[clientData];
 StopEchoUser[h];
END;
  
GetProcID: Menus.MenuProc = TRUSTED
BEGIN
h: ToolHandle = NARROW[clientData];
 pID: RECORD[a, b, c: NAT] ← LOOPHOLE[ProcessorFace.processorID];
 PutSep[h.out];
IO.PutF[h.out, "\nThis processor id is: %b%b%bB\n",
  [integer[pID.a]], [integer[pID.b]], [integer[pID.c]]];
END;



StopEchoUser: ENTRY PROC [h: ToolHandle] =
BEGIN
 h.pleaseStop ← TRUE;
UNTIL NOT h.echoInUse DO WAIT h.echoThrough ENDLOOP;
 h.pleaseStop ← FALSE;
END;

EchoShouldStop: ENTRY PROC [h: ToolHandle] RETURNS[BOOL] = INLINE
{RETURN[h.pleaseStop]};

EchoUserStopped: ENTRY PROC [h: ToolHandle] =
 {h.echoInUse ← FALSE; NOTIFY h.echoThrough};

EchoIsInUse: ENTRY PROC [h: ToolHandle] RETURNS [BOOL] =
 {IF h.echoInUse THEN RETURN [TRUE]; h.echoInUse ← TRUE; RETURN[FALSE]};


DoIt: Commander.CommandProc = TRUSTED
BEGIN
  MakeTool[] 
END;

Commander.Register[key: "PupTool", proc: DoIt, doc: "Simple network interrogation program"];

END.

John Larson July 29, 1985 2:28:05 pm PDT
changes to: DIRECTORY