DIRECTORY
Atom USING [GetPName],
Basics USING [bytesPerWord, LowByte, LowHalf, RawBytes, UnsafeBlock],
BasicTime USING [GetClockPulses, Pulses, PulsesToSeconds],
Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
Commander USING [CommandProc, Register],
Containers USING [ChildXBound, ChildYBound, Create],
Convert USING [IntFromRope],
CountedVM USING [Free, Handle, SimpleAllocate],
FS USING [Error, StreamBufferParms, StreamOpen],
IO USING [Close, Flush, GetBlock, GetLength, PutBlock, PutF, PutRope, STREAM, UnsafeGetBlock, UnsafePutBlock, Value],
Labels USING [Create],
Loader USING [BCDBuildTime],
Process USING [Pause, priorityBackground, SecondsToTicks, SetPriority],
Pup USING [Address, nullAddress],
PupHop USING [GetRouting, RoutingTableEntry],
PupName USING [AddressToRope, Error, HisName, NameLookup],
PupStream USING [AllocateSocket, Create, CreateListener, DestroyListener, Listener, LocalAddress, Push, Sockets, StreamClosing, Timeout, WaitForRendezvous],
PupWKS USING [bspSink],
Rope USING [ROPE],
Rules USING [Create],
STP USING [ConfirmProcType, Close, Create, DesiredProperties, Error, GetProperty, Handle, Login, Open, Retrieve, SetDesiredProperties],
TypeScript USING [ChangeLooks, Create],
UserCredentials USING [Get],
VFonts USING [FontHeight, StringWidth],
ViewerClasses USING [Viewer],
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [AddProp, ComputeColumn, CreateViewer, FetchProp, MoveViewer, OpenIcon, SetOpenHeight],
ViewerTools USING [GetContents, MakeNewTextViewer, SetContents, SetSelection];
PupBSPTool:
CEDAR
MONITOR
IMPORTS
Atom, Basics, BasicTime, Buttons, Commander, Containers, Convert, CountedVM, FS, IO, Labels, Loader, Process, PupHop, PupName, PupStream, Rules, STP, TypeScript, UserCredentials, VFonts, ViewerEvents, ViewerIO, ViewerOps, ViewerTools =
BEGIN
The Monitor is used to protect 3 things:
1) Access to data.user - only one task can run at a time.
2) Access to ///Foo (on the disk).
3) Interleaving printout at the end of each task.
BYTE: TYPE = [0..100H);
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Viewer: TYPE = ViewerClasses.Viewer;
Viewer layout parameters
buttonHeight: INT ← VFonts.FontHeight[] + 3;
buttonWidth: INT ← VFonts.StringWidth["WrDsk"] + 2*3;
Server data (global)
serverLog: STREAM ← NIL;
listener: PupStream.Listener ← NIL;
ClientData: TYPE = REF ClientDataRep;
ClientDataRep:
TYPE =
RECORD [
log: STREAM ← NIL,
in: STREAM ← NIL,
pleaseStop: BOOLEAN ← FALSE,
loop: BOOL ← FALSE,
small: BOOL ← FALSE,
user: PROCESS ← NIL,
where: Pup.Address ← Pup.nullAddress,
target: Viewer ← NIL ];
global: ClientData ← NIL; -- debugging
Create: Commander.CommandProc = {
viewer, buttons, log: Viewer ← NIL;
data: ClientData ← NEW[ClientDataRep ← []];
global ← data;
viewer ← ViewerOps.CreateViewer [
flavor: $Container,
info: [name: "PupBSPTool", column: right, iconic: TRUE, scrollable: FALSE]];
[] ← ViewerEvents.RegisterEventProc[Poof, destroy, viewer, TRUE];
ViewerOps.AddProp[viewer, $PupBSPTool, data];
log ← TypeScript.Create[
[name: "PupBSPTool.log", wy: 27+4, parent: viewer, border: FALSE], FALSE];
[data.in, data.log] ← ViewerIO.CreateViewerStreams [
name: "PupBSPTool.log", backingFile: "PupBSPTool.log", viewer: log, editedStream: FALSE];
IF serverLog = NIL THEN serverLog ← data.log;
Containers.ChildXBound[viewer, log];
Containers.ChildYBound[viewer, log];
CreateButtons[data, viewer, log];
TypeScript.ChangeLooks[log, 'f];
IO.PutF[data.log, "PupBSPTool of %G.\n\n", [time[Loader.BCDBuildTime[Create]]]];
ViewerOps.OpenIcon[viewer]; };
CreateButtons:
PROC [data: ClientData, parent, log: Viewer] = {
child: Viewer ← NIL;
kids: Viewer = Containers.Create[
info: [parent: parent, border: FALSE, scrollable: FALSE, wx: 0, wy: -9999, ww: 9999, wh: 0] ];
Containers.ChildXBound[parent, kids];
child ← MakeRule[kids, child];
child ← data.target ← MakeLabeledText[
parent: kids,
sibling: child,
name: "Target:",
data: "Target",
width: VFonts.StringWidth["Big long name ................................."],
prev: data.target ];
child ← MakeRule[kids, child];
child ← MakeLabel[kids, child, "What: "];
child ← MakeButton[kids, child, data, "Stop", StopProc];
child ← MakeButton[kids, child, data, "Push", PushProc];
child ← MakeButton[kids, child, data, "Clump", ClumpProc];
child ← MakeButton[kids, child, data, "Flush", FlushProc];
child ← MakeButton[kids, child, data, "RdDsk", ReadDiskProc];
child ← MakeButton[kids, child, data, "WrDsk", WriteDiskProc];
child ← MakeButton[kids, child, data, "Snarf", SnarfProc];
child ← MakeButton[kids, child, data, "Rendezvous", RendezvousProc];
child ← MakeButton[kids, child, data, "BufferTest", BufferTestProc];
child ← MakeRule[kids, child];
{
kidsY: INTEGER = 2;
kidsH: INTEGER = child.wy + child.wh + 2;
ViewerOps.MoveViewer[viewer: log, x: 0, y: kidsY + kidsH, w: log.ww, h: parent.ch - (kids.wy + kidsH), paint: FALSE];
ViewerOps.SetOpenHeight[parent, kidsY + kidsH + 12 * buttonHeight];
IF ~parent.iconic THEN ViewerOps.ComputeColumn[parent.column];
ViewerOps.MoveViewer[viewer: kids, x: kids.wx, y: kidsY, w: kids.ww, h: kidsH]; };
};
Poof: ViewerEvents.EventProc = {
[viewer: ViewerClasses.Viewer, event: ViewerEvent, before: BOOL]
RETURNS[abort: BOOL ← FALSE]
data: ClientData ← NARROW[ViewerOps.FetchProp[viewer, $PupBSPTool]];
IF event # destroy OR before # TRUE THEN ERROR;
Stop[data];
SmashServerLog[data];
IO.Close[data.log];
IO.Close[data.in];
};
SmashServerLog:
ENTRY
PROC [data: ClientData] = {
IF data.log = serverLog THEN serverLog ← NIL;
};
StartServer:
PROC = {
IF listener # NIL THEN RETURN;
listener ← PupStream.CreateListener[
local: PupWKS.bspSink, worker: Server, getTimeout: 60000, putTimeout: 0];
};
StopServer:
PROC = {
IF listener = NIL THEN RETURN;
PupStream.DestroyListener[listener];
listener ← NIL;
};
Server:
PROC [stream:
STREAM, clientData:
REF
ANY, remote: Pup.Address] = {
start: BasicTime.Pulses ← BasicTime.GetClockPulses[];
stop: BasicTime.Pulses;
bytesReceived: INT ← 0;
temp: REF TEXT ← NEW[TEXT[1024]];
error: ROPE ← NIL;
DO
bytes:
INT ←
IO.GetBlock[stream, temp, 0 !
PupStream.StreamClosing => { IF why # remoteClose THEN error ← text; EXIT; };
PupStream.Timeout => { error ← "Timeout"; EXIT; }];
IF bytes = 0 THEN EXIT;
bytesReceived ← bytesReceived + bytes;
ENDLOOP;
IO.Close[stream];
stop ← BasicTime.GetClockPulses[];
ServerPrintout[remote, bytesReceived, start, stop, error];
};
StopProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
Stop[data];
};
Start:
PROC [data: ClientData, proc:
PROC [ClientData]] = {
p: PROCESS;
data.pleaseStop ← FALSE;
p ← FORK proc[data];
p ← StartInner[data, p];
IF p # NIL THEN TRUSTED { JOIN p; }; -- User pounding on the button
};
StartInner:
ENTRY
PROC [data: ClientData, p:
PROCESS]
RETURNS [q:
PROCESS] = {
q ← data.user;
data.user ← p;
};
Stop:
PROC [data: ClientData] = {
p: PROCESS ← StopInner[data];
data.pleaseStop ← TRUE;
IF p # NIL THEN TRUSTED { JOIN p; };
};
StopInner:
ENTRY
PROC [data: ClientData]
RETURNS [p:
PROCESS] = {
p ← data.user;
data.user ← NIL;
};
PushProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
data.small ← control;
Push[data];
};
Push:
PROC [data: ClientData] = {
target: ROPE = ViewerTools.GetContents[data.target];
Stop[data];
IO.PutF[data.log, "\nSending to %G", [rope[target]]];
IF ~FindPath[data, target] THEN RETURN;
Start[data, Pusher];
};
ClumpProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
data.loop ← shift;
data.small ← control;
Clump[data];
};
Clump:
PROC [data: ClientData] = {
target: ROPE = ViewerTools.GetContents[data.target];
Stop[data];
IO.PutF[data.log, "\nSending a clump to %G", [rope[target]]];
IF ~FindPath[data, target] THEN RETURN;
Process.Pause[5];
Start[data, Clumper];
};
FlushProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
Flush[data];
};
Flush:
PROC [data: ClientData] = {
target: ROPE = ViewerTools.GetContents[data.target];
Stop[data];
IO.PutF[data.log, "\nFlushing to %G", [rope[target]]];
IF ~FindPath[data, target] THEN RETURN;
Start[data, Flusher];
};
Rendezvous
Proc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
Rendezvous[data];
};
Rendezvous:
PROC [data: ClientData] = {
target: ROPE = ViewerTools.GetContents[data.target];
Stop[data];
IO.PutF[data.log, "\nTesting Rendezvous with self"];
IF ~FindPath[data, "ME"] THEN RETURN;
Start[data, Rendezvouser];
};
BufferTest
Proc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
BufferTest[data];
};
BufferTest:
PROC [data: ClientData] = {
target: ROPE = ViewerTools.GetContents[data.target];
Stop[data];
IO.PutF[data.log, "\nTesting huge buffer cases"];
IF ~FindPath[data, "ME"] THEN RETURN;
Process.SetPriority[Process.priorityBackground];
Start[data, BufferTester];
};
ReadDiskProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
ReadDisk[data]; };
WriteDiskProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
scale: NAT;
SELECT
TRUE
FROM
shift AND control => scale ← 1;
control => scale ← 2;
shift => scale ← 4;
ENDCASE => scale ← 8;
WriteDisk[data, scale]; };
SnarfProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
Snarf[data]; };
Pusher:
PROC [data: ClientData] = {
stream: STREAM;
start: BasicTime.Pulses ← BasicTime.GetClockPulses[];
open: BasicTime.Pulses;
flush: BasicTime.Pulses;
close: BasicTime.Pulses;
stop: BasicTime.Pulses;
bytesSent: INT ← 0;
error: ROPE ← NIL;
temp: REF TEXT ← NEW[TEXT[1024]];
temp.length ← temp.maxLength;
IF data.small THEN temp.length ← 32;
stream ← PupStream.Create[data.where, 0, 30000 ! PupStream.StreamClosing => {
IO.PutF[data.log, "Open failed: %G.\n\n", [rope[text]] ]; CONTINUE }];
IF stream = NIL THEN RETURN;
open ← BasicTime.GetClockPulses[];
UNTIL data.pleaseStop
DO
IO.PutBlock[stream, temp !
PupStream.StreamClosing => { error ← text; EXIT; };
PupStream.Timeout => { error ← "Timeout"; EXIT; }];
bytesSent ← bytesSent + temp.length;
IF data.small THEN PupStream.Push[stream];
ENDLOOP;
flush ← BasicTime.GetClockPulses[];
IO.Flush[stream !
PupStream.StreamClosing => { IF error = NIL THEN error ← text; CONTINUE; };
PupStream.Timeout => { IF error = NIL THEN error ← "Timeout"; CONTINUE; }];
close ← BasicTime.GetClockPulses[];
IO.Close[stream];
stop ← BasicTime.GetClockPulses[];
ClientPrintout[data, bytesSent, start, open, flush, close, stop, error];
};
clumpSize: NAT ← 32; -- Quarter megabit
Clumper:
PROC [data: ClientData] = {
clumpsToSend: INT ← clumpSize;
stream: STREAM;
start: BasicTime.Pulses;
open: BasicTime.Pulses;
flush: BasicTime.Pulses;
close: BasicTime.Pulses;
stop: BasicTime.Pulses;
temp: REF TEXT ← NEW[TEXT[1024]];
temp.length ← temp.maxLength;
IF data.small THEN {
temp.length ← 32;
clumpsToSend ← clumpsToSend * temp.maxLength / temp.length; };
UNTIL data.pleaseStop
DO
error: ROPE ← NIL;
bytesSent: INT ← 0;
start ← BasicTime.GetClockPulses[];
stream ← PupStream.Create[data.where, 0, 30000 ! PupStream.StreamClosing => {
IO.PutF[data.log, "Open failed: %G.\n\n", [rope[text]] ]; CONTINUE }];
IF stream = NIL THEN RETURN;
open ← BasicTime.GetClockPulses[];
FOR i:
INT
IN [0..clumpsToSend)
UNTIL data.pleaseStop
DO
IO.PutBlock[stream, temp !
PupStream.StreamClosing => { error ← text; EXIT; };
PupStream.Timeout => { error ← "Timeout"; EXIT; }];
bytesSent ← bytesSent + temp.length;
IF data.small THEN PupStream.Push[stream];
ENDLOOP;
flush ← BasicTime.GetClockPulses[];
IO.Flush[stream !
PupStream.StreamClosing => { IF error = NIL THEN error ← text; CONTINUE; };
PupStream.Timeout => { IF error = NIL THEN error ← "Timeout"; CONTINUE; }];
close ← BasicTime.GetClockPulses[];
IO.Close[stream];
stop ← BasicTime.GetClockPulses[];
ClientPrintout[data, bytesSent, start, open, flush, close, stop, error];
IF error # NIL THEN EXIT;
IF ~data.loop THEN EXIT;
Process.Pause[Process.SecondsToTicks[10]];
ENDLOOP;
};
flushClumpSize: INT ← 10;
Flusher:
PROC [data: ClientData] = {
stream: STREAM;
start: BasicTime.Pulses ← BasicTime.GetClockPulses[];
open: BasicTime.Pulses;
close: BasicTime.Pulses;
stop: BasicTime.Pulses;
error: ROPE ← NIL;
bytesSent: INT ← 0;
temp: REF TEXT ← NEW[TEXT[1024]];
temp.length ← temp.maxLength;
stream ← PupStream.Create[data.where, 0, 30000 ! PupStream.StreamClosing => {
IO.PutF[data.log, "Open failed: %G.\n\n", [rope[text]] ]; CONTINUE }];
IF stream = NIL THEN RETURN;
open ← BasicTime.GetClockPulses[];
UNTIL data.pleaseStop
OR error #
NIL
DO
FOR i:
INT
IN [0..flushClumpSize)
DO
IO.PutBlock[stream, temp !
PupStream.StreamClosing => { error ← text; EXIT; };
PupStream.Timeout => { error ← "Timeout"; EXIT; }];
bytesSent ← bytesSent + temp.length;
ENDLOOP;
IO.Flush[stream !
PupStream.StreamClosing => { error ← text; EXIT; };
PupStream.Timeout => { error ← "Timeout"; EXIT; }];
IO.Flush[stream !
-- Again to test the empty case
PupStream.StreamClosing => { error ← text; EXIT; };
PupStream.Timeout => { error ← "Timeout"; EXIT; }];
ENDLOOP;
close ← BasicTime.GetClockPulses[];
IO.Close[stream];
stop ← BasicTime.GetClockPulses[];
ClientPrintout[data, bytesSent, start, open, close, close, stop, error];
};
Rendezvouser:
PROC [data: ClientData] = {
sockets: PupStream.Sockets ← PupStream.AllocateSocket[data.where];
start: BasicTime.Pulses ← BasicTime.GetClockPulses[];
stop: BasicTime.Pulses;
bytesReceived: INT ← 0;
stream: IO.STREAM ← NIL;
temp: REF TEXT ← NEW[TEXT[1024]];
error: ROPE ← NIL;
helper: PROCESS;
data.where ← PupStream.LocalAddress[sockets];
helper ← FORK Clumper[data];
stream ← PupStream.WaitForRendezvous[sockets, 60000, 0, 20000 !
PupStream.StreamClosing => { error ← text; CONTINUE; } ];
DO
bytes:
INT ←
IO.GetBlock[stream, temp, 0 !
PupStream.StreamClosing => { IF why # remoteClose THEN error ← text; EXIT; };
PupStream.Timeout => { error ← "Timeout"; EXIT; }];
IF bytes = 0 THEN EXIT;
bytesReceived ← bytesReceived + bytes;
ENDLOOP;
IO.Close[stream];
stop ← BasicTime.GetClockPulses[];
ServerPrintout[data.where, bytesReceived, start, stop, error];
TRUSTED { JOIN helper[]; };
};
bigBufferWords: INT ← 250000; -- several times 64K
maxBigBufferCycles: INT = 10;
bigBufferCycles: [0..maxBigBufferCycles) ← 5;
BogusData: SIGNAL = CODE;
BufferTester:
PROC [data: ClientData] = {
sockets: PupStream.Sockets ← PupStream.AllocateSocket[data.where];
start: BasicTime.Pulses ← BasicTime.GetClockPulses[];
stop: BasicTime.Pulses;
bytesReceived: INT ← 0;
stream: IO.STREAM ← NIL;
countedVM: CountedVM.Handle ← CountedVM.SimpleAllocate[words: bigBufferWords+maxBigBufferCycles];
bigBlock: Basics.UnsafeBlock ← [base: NIL, startIndex: 0, count: bigBufferWords * Basics.bytesPerWord];
error: ROPE ← NIL;
helper: PROCESS;
finger: INT ← 0;
TRUSTED { bigBlock.base ← countedVM.pointer; };
data.where ← PupStream.LocalAddress[sockets];
helper ← FORK BufferPusher[data];
stream ← PupStream.WaitForRendezvous[sockets, 600000, 0, 20000 !
PupStream.StreamClosing => { error ← text; CONTINUE; } ];
FOR i:
INT
IN [0..9999)
DO
bytes: INT;
bigBlock.startIndex ← i MOD bigBufferCycles; -- Test various offset cases too
TRUSTED {
bytes ←
IO.UnsafeGetBlock[stream, bigBlock !
PupStream.StreamClosing => { IF why # remoteClose THEN error ← text; EXIT; };
PupStream.Timeout => { error ← "Timeout"; EXIT; }]; };
IF bytes = 0 THEN EXIT;
FOR i:
INT
IN [0..bytes)
DO
expected: BYTE ← IndexToByte[finger];
found: BYTE ← LoadByte[bigBlock, i];
IF found # expected THEN SIGNAL BogusData;
finger ← SUCC[finger];
ENDLOOP;
bytesReceived ← bytesReceived + bytes;
ENDLOOP;
IO.Close[stream];
stop ← BasicTime.GetClockPulses[];
ServerPrintout[data.where, bytesReceived, start, stop, error];
TRUSTED {
JOIN helper[];
CountedVM.Free[countedVM]; };
};
BufferPusher:
PROC [data: ClientData] = {
stream: STREAM;
start: BasicTime.Pulses;
open: BasicTime.Pulses;
flush: BasicTime.Pulses;
close: BasicTime.Pulses;
stop: BasicTime.Pulses;
countedVM: CountedVM.Handle ← CountedVM.SimpleAllocate[words: bigBufferWords+maxBigBufferCycles];
bigBlock: Basics.UnsafeBlock ← [base: NIL, startIndex: 0, count: bigBufferWords * Basics.bytesPerWord];
error: ROPE ← NIL;
bytesSent: INT ← 0;
finger: INT ← 0;
TRUSTED { bigBlock.base ← countedVM.pointer; };
start ← BasicTime.GetClockPulses[];
stream ← PupStream.Create[data.where, 0, 600000 ! PupStream.StreamClosing => {
IO.PutF[data.log, "Open failed: %G.\n\n", [rope[text]] ]; CONTINUE }];
IF stream = NIL THEN RETURN;
open ← BasicTime.GetClockPulses[];
FOR i:
INT
IN [0..bigBufferCycles)
UNTIL data.pleaseStop
DO
bigBlock.startIndex ← i; -- Test various offset cases too
FOR i:
INT
IN [0..bigBlock.count)
DO
expected: BYTE ← IndexToByte[finger];
StoreByte[bigBlock, i, expected];
finger ← SUCC[finger];
ENDLOOP;
IO.UnsafePutBlock[stream, bigBlock !
PupStream.StreamClosing => { error ← text; EXIT; };
PupStream.Timeout => { error ← "Timeout"; EXIT; }];
bytesSent ← bytesSent + bigBlock.count;
ENDLOOP;
flush ← BasicTime.GetClockPulses[];
IO.Flush[stream !
PupStream.StreamClosing => { IF error = NIL THEN error ← text; CONTINUE; };
PupStream.Timeout => { IF error = NIL THEN error ← "Timeout"; CONTINUE; }];
close ← BasicTime.GetClockPulses[];
IO.Close[stream];
stop ← BasicTime.GetClockPulses[];
ClientPrintout[data, bytesSent, start, open, flush, close, stop, error];
TRUSTED { CountedVM.Free[countedVM]; };
};
IndexToByte:
PROC [index:
INT]
RETURNS [
BYTE] =
INLINE {
RETURN[Basics.LowByte[Basics.LowHalf[(index+1234) MOD 256]]]; };
Super barfo. The Compiler can't hack PACKED ARRAYS OF BYTE > 64K. It generates code that gets a BoundsCheck (just before a WriteStringLong).
LoadByte:
PROC [block: Basics.UnsafeBlock, offset:
INT]
RETURNS [data:
BYTE] =
INLINE {
index: INT = block.startIndex + offset;
wordShift: INT = index / Basics.bytesPerWord;
byteShift: INT = wordShift * Basics.bytesPerWord;
leftovers: INT = index - byteShift;
base: LONG POINTER TO Basics.RawBytes = block.base + wordShift;
TRUSTED { RETURN[base[leftovers]]; }; };
StoreByte:
PROC [block: Basics.UnsafeBlock, offset:
INT, data:
BYTE] =
INLINE {
index: INT = block.startIndex + offset;
wordShift: INT = index / Basics.bytesPerWord;
byteShift: INT = wordShift * Basics.bytesPerWord;
leftovers: INT = index - byteShift;
base: LONG POINTER TO Basics.RawBytes = block.base + wordShift;
TRUSTED { base[leftovers] ← data; }; };
KrockeryToSeeWhatTheCompilerGenerates:
PROC = {
i: INT;
base: LONG POINTER TO PACKED ARRAY [0..0) OF BYTE;
TRUSTED { base[123] ← 6; };
TRUSTED { base[i] ← 6; }; };
filename: ROPE = "///Foo";
remoteFilename:
ROPE = "Foo";
readBuffers: FS.StreamBufferParms ← [vmPagesPerBuffer: 127, nBuffers: 2];
ReadDisk:
ENTRY
PROC [data: ClientData] = {
stream: STREAM;
start: BasicTime.Pulses ← BasicTime.GetClockPulses[];
open: BasicTime.Pulses;
close: BasicTime.Pulses;
stop: BasicTime.Pulses;
bytes: INT ← 0;
temp: REF TEXT ← NEW[TEXT[1024]];
stream ←
FS.StreamOpen[
fileName: filename,
accessOptions: $read,
streamBufferParms: readBuffers
!
FS.Error => {
IO.PutF[data.log, "Open for read failed: %G.\n\n", [rope[error.explanation]] ]; CONTINUE }];
IF stream = NIL THEN RETURN;
open ← BasicTime.GetClockPulses[];
DO
clump: INT ← IO.GetBlock[stream, temp, 0];
bytes ← bytes + clump;
IF clump = 0 THEN EXIT;
ENDLOOP;
close ← BasicTime.GetClockPulses[];
IO.Close[stream];
stop ← BasicTime.GetClockPulses[];
DiskPrintout[data.log, "read", bytes, start, open, close, stop];
};
writeBuffers: FS.StreamBufferParms ← [vmPagesPerBuffer: 127, nBuffers: 2];
WriteDisk:
ENTRY
PROC [data: ClientData, scale:
NAT] = {
stream: STREAM;
start: BasicTime.Pulses ← BasicTime.GetClockPulses[];
open: BasicTime.Pulses;
close: BasicTime.Pulses;
stop: BasicTime.Pulses;
bytes: INT ← 0;
temp: REF TEXT ← NEW[TEXT[1024]];
temp.length ← temp.maxLength;
stream ←
FS.StreamOpen[
fileName: filename,
accessOptions: $create,
createByteCount: scale*1048576,
streamBufferParms: writeBuffers
!
FS.Error => {
IO.PutF[data.log, "Open for write failed: %G.\n\n", [rope[error.explanation]] ]; CONTINUE }];
IF stream = NIL THEN RETURN;
open ← BasicTime.GetClockPulses[];
FOR i:
NAT
IN [0..scale*1024)
DO
-- n Megabytes (big M)
IO.PutBlock[stream, temp, 0];
bytes ← bytes + temp.length;
ENDLOOP;
close ← BasicTime.GetClockPulses[];
IO.Close[stream];
stop ← BasicTime.GetClockPulses[];
DiskPrintout[data.log, "written", bytes, start, open, close, stop];
};
stpBuffers: FS.StreamBufferParms ← [vmPagesPerBuffer: 127, nBuffers: 2];
Snarf:
ENTRY
PROC [data: ClientData] = {
Confirm:
STP.ConfirmProcType = {
size: ROPE ← STP.GetProperty[stp, size];
bytes: INT ← 1048576;
IF size # NIL THEN bytes ← Convert.IntFromRope[size];
stream ←
FS.StreamOpen[
fileName: filename,
accessOptions: $create,
createByteCount: bytes,
streamBufferParms: stpBuffers
!
FS.Error => {
IO.PutF[data.log, "Open for write failed: %G.\n\n", [rope[error.explanation]] ]; CONTINUE }];
IF stream = NIL THEN RETURN[abort, NIL];
open ← BasicTime.GetClockPulses[];
RETURN[do, stream]; };
start: BasicTime.Pulses ← BasicTime.GetClockPulses[];
open: BasicTime.Pulses;
close: BasicTime.Pulses;
stop: BasicTime.Pulses;
target: ROPE = ViewerTools.GetContents[data.target];
stp: STP.Handle ← STP.Create[];
herald, name, password: ROPE;
failed: BOOL ← FALSE;
stream: STREAM;
bytes: INT ← 0;
desiredProperties: STP.DesiredProperties ← ALL[FALSE];
desiredProperties[size] ← TRUE;
herald ←
STP.Open[stp, target !
STP.Error => {
IO.PutF[data.log, "STP Open failed: %G.\n\n", [rope[error]] ];
failed ← TRUE;
CONTINUE }];
IF failed THEN RETURN;
[name, password] ← UserCredentials.Get[];
STP.Login[stp, name, password];
STP.SetDesiredProperties[stp, desiredProperties];
STP.Retrieve[stp, remoteFilename, Confirm, NIL];
close ← BasicTime.GetClockPulses[];
bytes ← IO.GetLength[stream];
IO.Close[stream];
STP.Close[stp];
stop ← BasicTime.GetClockPulses[];
DiskPrintout[data.log, "copied", bytes, start, open, close, stop];
};
FindPath:
PROC [data: ClientData, target:
ROPE]
RETURNS [
BOOLEAN] = {
rte: PupHop.RoutingTableEntry;
data.where ← PupName.NameLookup[target, PupWKS.bspSink !
PupName.Error => { IO.PutF[data.log, " Oops: %G.\n", [rope[text]]]; GOTO Trouble; }];
IO.PutF[data.log, " = %G", [rope[PupName.AddressToRope[data.where]]]];
rte ← PupHop.GetRouting[[data.where.net]];
IF rte.hop # 0
THEN
IO.PutF[data.log, " which is %G hops via %G",
[integer[rte.hop]],
[rope[PupName.AddressToRope[rte.immediate]]] ];
IO.PutRope[data.log, ".\n"];
RETURN[TRUE];
EXITS Trouble => RETURN[FALSE];
};
ClientPrintout:
ENTRY
PROC [
data: ClientData, bytesSent: INT, start, open, flush, close, stop: BasicTime.Pulses, error: ROPE] = {
who: ROPE ← PupName.HisName[data.where];
bits: INT ← 8*bytesSent;
seconds: REAL ← BasicTime.PulsesToSeconds[stop-start];
bitsPerSecond: REAL ← bits/seconds;
IF error # NIL THEN IO.PutF[data.log, "*** Trouble: %G.\n", [rope[error]] ];
IF bitsPerSecond > 100000
THEN
IO.PutF[data.log, "%GK bits sent to %G in %3.2F seconds = %1.0FK bits/second.\n",
[integer[bits/1000]],
[rope[who]],
[real[seconds]],
[real[bitsPerSecond/1000]] ]
ELSE
IO.PutF[data.log, "%GK bits sent to %G in %3.2F seconds = %1.0F bits/second.\n",
[integer[bits/1000]],
[rope[who]],
[real[seconds]],
[real[bitsPerSecond]] ];
seconds ← BasicTime.PulsesToSeconds[open-start];
IO.PutF[data.log, "It took %3.2F seconds to open the connection.\n", [real[seconds]] ];
seconds ← BasicTime.PulsesToSeconds[close-flush];
IF close # flush
THEN
IO.PutF[data.log, "It took %3.2F seconds to flush the connection.\n", [real[seconds]] ];
seconds ← BasicTime.PulsesToSeconds[stop-close];
IO.PutF[data.log, "It took %3.2F seconds to close the connection.\n", [real[seconds]] ];
IO.PutRope[data.log, "\n"];
IO.Flush[data.log];
};
DiskPrintout:
INTERNAL
PROC [
log: STREAM, what: ROPE, bytes: INT, start, open, close, stop: BasicTime.Pulses] = {
bits: INT ← 8*bytes;
seconds: REAL ← BasicTime.PulsesToSeconds[close-open];
IO.PutF[log, "%GK bits %G in %3.2F seconds = %1.0FK bits/second.\n",
[integer[bits/1000]],
[rope[what]],
[real[seconds]],
[real[bits/seconds/1000]] ];
seconds ← BasicTime.PulsesToSeconds[open-start];
IO.PutF[log, "It took %3.2F more seconds to open the file.\n", [real[seconds]] ];
seconds ← BasicTime.PulsesToSeconds[stop-close];
IO.PutF[log, "It took %3.2F more seconds to close the file.\n", [real[seconds]] ];
IO.PutRope[log, "\n"];
};
ServerPrintout:
ENTRY
PROC [
remote: Pup.Address, bytes: INT, start, stop: BasicTime.Pulses, error: ROPE] = {
who: ROPE ← PupName.HisName[remote];
bits: INT ← 8*bytes;
seconds: REAL ← BasicTime.PulsesToSeconds[stop-start];
bitsPerSecond: REAL ← bits/seconds;
IF serverLog = NIL THEN RETURN;
IF error # NIL THEN IO.PutF[serverLog, "*** Trouble: %G.*** \n", [rope[error]] ];
IF bitsPerSecond > 100000
THEN
IO.PutF[serverLog, "%GK bits received from %G in %3.2F seconds = %1.0FK bits/second.\n",
[integer[bits/1000]],
[rope[who]],
[real[seconds]],
[real[bitsPerSecond/1000]] ]
ELSE
IO.PutF[serverLog, "%GK bits received from %G in %3.2F seconds = %1.0F bits/second.\n",
[integer[bits/1000]],
[rope[who]],
[real[seconds]],
[real[bitsPerSecond]] ];
IO.PutRope[serverLog, "\n"];
IO.Flush[serverLog];
};
MakeRule:
PROC [parent, sibling: Viewer]
RETURNS [child: Viewer] = {
child ← Rules.Create[
info: [parent: parent, border:
FALSE,
wy: IF sibling = NIL THEN 0 ELSE sibling.wy + sibling.wh + 2, wx: 0, ww: parent.ww, wh: 1],
paint: FALSE ];
Containers.ChildXBound[parent, child];
};
MakeButton:
PROC [parent, sibling: Viewer, data:
REF
ANY, name:
ROPE, proc: Buttons.ButtonProc]
RETURNS[child: Viewer] = {
child ← Buttons.Create[
info: [name: name, parent: parent, border:
TRUE,
wy: sibling.wy, wx: sibling.wx + sibling.ww - 1, ww: buttonWidth],
proc: proc,
clientData: data,
fork: TRUE,
paint: FALSE];
};
SelectorProc: TYPE = PROC [parent: Viewer, clientData: REF, value: ATOM];
Selector: TYPE = REF SelectorRec;
SelectorRec:
TYPE =
RECORD [
value: REF ATOM,
change: PROC [parent: Viewer, clientData: REF, value: ATOM],
clientData: REF,
buttons: LIST OF Buttons.Button,
values: LIST OF ATOM ];
MakeSelector:
PROC
[name: ROPE, values: LIST OF ATOM, init: REF ATOM ← NIL, change: SelectorProc ← NIL, clientData: REF ← NIL, parent: Viewer, x, y: INTEGER]
RETURNS [child: Viewer] = {
selector: Selector ←
NEW [SelectorRec ← [
value: IF init # NIL THEN init ELSE NEW [ATOM ← values.first],
change: change,
clientData: clientData,
buttons: NIL,
values: values ] ];
last: LIST OF Buttons.Button ← NIL;
child ← Labels.Create[info: [name: name, parent: parent, border: FALSE, wx: x, wy: y] ];
FOR a:
LIST
OF
ATOM ← values, a.rest
UNTIL a =
NIL
DO
child ← Buttons.Create[
info: [name: Atom.GetPName[a.first], parent: parent, border: TRUE, wx: child.wx + child.ww + 2, wy: child.wy],
proc: SelectorHelper, clientData: selector, fork: TRUE, paint: TRUE];
IF last = NIL THEN last ← selector.buttons ← CONS[first: child, rest: NIL]
ELSE { last.rest ← CONS[first: child, rest: NIL]; last ← last.rest };
IF a.first = selector.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack];
ENDLOOP; };
SelectorHelper: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
self: Buttons.Button = NARROW[parent];
selector: Selector = NARROW[clientData];
buttons: LIST OF Buttons.Button ← selector.buttons;
FOR a:
LIST
OF
ATOM ← selector.values, a.rest
UNTIL a =
NIL
DO
IF self = buttons.first
THEN {
selector.value^ ← a.first;
IF selector.change # NIL THEN selector.change[self.parent, selector.clientData, a.first];
Buttons.SetDisplayStyle[buttons.first, $WhiteOnBlack]; }
ELSE Buttons.SetDisplayStyle[buttons.first, $BlackOnWhite];
buttons ← buttons.rest;
ENDLOOP; };
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 = {
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^]; };
MakeLabel:
PROC [parent, sibling: Viewer, name:
ROPE]
RETURNS [child: Viewer] = {
child ← Labels.Create[
info: [name: name, parent: parent, border:
FALSE,
wy: sibling.wy + sibling.wh + (IF sibling.class.flavor = $Button THEN -1 ELSE 2),
wx: 2,
ww: VFonts.StringWidth[name] + 2*3 + 2],
paint: FALSE ]; };
MakeLabeledText:
PROC [
parent, sibling: Viewer, name, data: ROPE, prev: Viewer, width: INT, newline: BOOL ← TRUE] RETURNS [child: Viewer] = {
buttonWidth: INT ← VFonts.StringWidth[name] + 2*3;
x: INTEGER = IF newline THEN 2 ELSE sibling.wx + sibling.ww + 10;
y: INTEGER = IF newline THEN sibling.wy + sibling.wh + 1 ELSE sibling.wy;
child ← ViewerTools.MakeNewTextViewer[
info: [
parent: parent, wh: buttonHeight, ww: width+10,
data: IF prev = NIL THEN data ELSE ViewerTools.GetContents[prev],
border: FALSE,
wx: x + buttonWidth + 2, wy: y,
scrollable: FALSE ],
paint: FALSE ];
[] ← Buttons.Create[
info: [name: name, parent: parent, wh: buttonHeight, border: FALSE, wx: x, wy: y],
proc: LabeledTextProc, clientData: child, fork: FALSE, paint: FALSE];
RETURN[child]; };
LabeledTextProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
text: Viewer = NARROW[clientData];
SELECT mouseButton
FROM
red => ViewerTools.SetSelection[text, NIL];
yellow => NULL;
blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] };
ENDCASE => ERROR; };
Commander.Register["PupBSPTool", Create, "Test Pup Streams to another machine."];
END.