Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50512/worker.b36
There are no other files named worker.b36 in the archive.
MODULE WORKER ( ! Network Testing stuff
IDENT = '1(1) 31-Mar-80'
) =
BEGIN
COMPILETIME BLS36C=1; !Use BLS36C compiler
!
! COPYRIGHT (c) 1980, 1980 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY:
!
! ABSTRACT:
!
!
! ENVIRONMENT:
!
! AUTHOR: , CREATION DATE:
!
! MODIFIED BY:
!
! , : VERSION
! 01 -
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
TALK:NOVALUE, !Send something to the other end
LISTEN:NOVALUE, !Wait for data from other end
THANDLE, !Handler for LISTEN
ACCEPT: NOVALUE, !ACCEPT (commect) testing command
CONNECT: NOVALUE, !CONNECT (to node) testing command
SEND: NOVALUE; !SEND (data on link) testing command
!
! INCLUDE FILES:
!
LIBRARY 'INTR';
%IF BLS36C
%THEN MACRO RUNNING=RUN %,
$=FILE$START %;
LITERAL STS$K_ERROR=2,
STS$K_WARN=0,
STS$K_SEVEREERROR=4,
STS$K_CONTINUE=1,
STS$K_NORMAL=1,
STS$K_RESIGNAL=0,
STS$K_UNWIND=%O'100';
LITERAL FREG=%O'15';
EXTERNAL RUN: REF PROCESS_BLOCK;
EXTERNAL ROUTINE %NAME('.CRASH'), OPENFILE, UNWIND;
%FI;
!
! MACROS:
!
MACRO PREFIX='TST' %;
MACRO WR_STRING(PTR)= !PTR is addr of b.p., remaining are strings
BEGIN
EXTERNAL ROUTINE MOVEAZ;
MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ %STRING(%REMAINING)))),PTR)
END %;
!
! EQUATED SYMBOLS:
!
GLOBAL LITERAL
SENDJUNK=%O'37777777772', !Send junk over link
SENDFILE=%O'37777777771'; !Send a file over the link
!
! OWN STORAGE:
!
OWN RECSIZE: INITIAL(512);
OWN IB_SENDFILE: INT_BLOCK
!!!!!! PRESET([INT$SIGNAL_ARGS]=1,[INT$CODE]=SENDFILE);
INITIAL(0,0,0,0,0,1,SENDFILE);
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
WRNUMA,
MSTIME,
FINDP,
FPARSE,
BIN,
WRSIXA,
BOUT,
FSIGNL,
XINPUT,
XOUT_NOWAIT, !Output with no wait
XBOUT, !Send a byte
QUIT,
EATSPACES,
RDSIXA,
RDNUMA,
XOUTPUT,
LINK,
TERROR,
FBINI,
NDBINI,
ALLOC; !
%IF NOT BLS36C
%THEN
EXTERNAL
RUNNING: REF PROCESS_BLOCK;
%FI;
GLOBAL ROUTINE TALK (ARGS) :NOVALUE = !
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
MAP ARGS: REF VECTOR; !Get our arguments
BIND NB=.ARGS[1]: NDB; !NDB is only argument
%IF BLS36C
%THEN
ESTABLISH(THANDLE);
%ELSE
ENABLE THANDLE;
%FI;
RUNNING[P$NDB]=NB[$]; !Say it's ours
LINK(NB[$]); !Establish a logical link
INFO('Test Connection Established');
WHILE 1 DO
BEGIN
XINPUT(NB[$]); !Eat any input we get
END;
END; !End of TALK
GLOBAL ROUTINE LISTEN :NOVALUE = !
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
LOCAL
FB: REF FILE_BLOCK,
NB: REF NDB; !Ptr to NDB
%IF BLS36C
%THEN
ESTABLISH(THANDLE);
%ELSE
ENABLE THANDLE;
%FI;
NB=ALLOC(NDB_LEN); !Get the storage
FB=ALLOC(FB_LEN); !File block also
NDBINI(NB[$]); !Set it up
FBINI(FB[$]); !
NB[NDB$FB]=FB[$]; !Link the file block to the NDB
LINK(NB[$]); !Open passive task
INFO('Test Connection Accepted'); !Say we got one
WHILE 1 DO
BEGIN
XINPUT(NB[$]); !Eat whatever gets sent
END;
END; !End of LISTEN
ROUTINE THANDLE (SIGNAL_ARGS,MECH_ARGS,ENABLE_ARGS) = !LISTEN handler
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
MAP SIGNAL_ARGS: REF VECTOR,
MECH_ARGS: REF VECTOR,
ENABLE_ARGS: REF VECTOR;
BIND NB=.RUNNING[P$NDB]: NDB;
%IF NOT BLS36C
%THEN
ENABLE THANDLE;
%FI;
SELECT .SIGNAL_ARGS[SA_CODE] OF SET
[SENDJUNK]:
BEGIN
LOCAL STARTTIME, PTR,BUFF: VECTOR[CH$ALLOCATION(80)];
STARTTIME=MSTIME();
DECR N FROM .SIGNAL_ARGS[2]-1 TO 0 !Send this much junk
DO BEGIN
DECR C FROM .RECSIZE-1 TO 0 !In (RECSIZE) byte records
DO XBOUT(NB[$],%C'X');
XOUTPUT(NB[$]); !Force end-of-record
END;
XOUTPUT(NB[$]);
INFO_NCRLF('Sent ');
PTR=CH$PTR(BUFF);
WRNUMA(.SIGNAL_ARGS[2],10,PTR);
WR_STRING(PTR,' Records at ');
WRNUMA((.SIGNAL_ARGS[2]*.RECSIZE*8000)/(MSTIME()-.STARTTIME),
10,PTR);
WR_STRING(PTR,' Baud on Link "');
WRSIXA(.RUNNING[P$NAME],PTR);
WR_STRING(PTR,'"]',CRLF);
TSTR(BUFF);
RETURN STS$K_CONTINUE;
END;
[SENDFILE]:
BEGIN
ROUTINE SENDIT=
BEGIN
BIND NB=.RUNNING[P$NDB]: NDB;
BIND FB=.NB[NDB$FB]: FILE_BLOCK;
ROUTINE SENDHANDLE(SIGNAL_ARGS,MECH_ARGS,ENABLE_ARGS)=
BEGIN
MAP SIGNAL_ARGS: REF VECTOR,
MECH_ARGS: REF VECTOR;
!BLS36C ONLY!!!!!!
IF .SIGNAL_ARGS[SA_CODE] EQL ENDFILE^3
THEN UNWIND(.MECH_ARGS[MA_DEPTH]+1);
RETURN STS$K_RESIGNAL;
END;
ESTABLISH(SENDHANDLE);
!End BLS36C ONLY!!
WHILE 1 DO
BEGIN
DECR I FROM .RECSIZE-1 TO 0 DO
BEGIN
XBOUT(NB[$],BIN(FB[$])); !shove the data out
END;
XOUTPUT(NB[$]); !End of record
END;
END;
SENDIT();
RETURN STS$K_CONTINUE;
END;
[ENDFILE]: RETURN
%IF BLS36C %THEN UNWIND(.MECH_ARGS[MA_DEPTH]+1)
%ELSE SETUNWIND()
%FI;
[STS$K_UNWIND]: RETURN STS$K_CONTINUE; !No action
TES;
TERROR(.SIGNAL_ARGS,.MECH_ARGS,.ENABLE_ARGS); !Type error msg
CASE .$SEVERITY FROM 0 TO 7 OF SET
[STS$K_WARN,STS$K_NORMAL]: RETURN STS$K_CONTINUE;
[STS$K_SEVEREERROR]: CRASH('Fatal Error encountered');
[STS$K_ERROR]: QUIT(.$CODE);
[INRANGE,OUTRANGE]: CRASH('Unknown Error type');
TES;
END; !End of THANDLE
GLOBAL ROUTINE ACCEPT (PTR,ARGS) :NOVALUE = !
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! PTR: Addr of B.P. to command string
! ARGS: ignored
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! PTR is updated
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! A process is created to LISTEN
!
!--
BEGIN
LOCAL
PB: REF PROCESS_BLOCK; !Addr of new process block
PB=FORK(LISTEN); !Create the process
EATSPACES(.PTR); !Remove leading spaces
PB[P$NAME]=RDSIXA(.PTR); !Get name of process
END; !End of ACCEPT
GLOBAL ROUTINE CONNECT (PTR,ARGS) :NOVALUE = !
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! PTR: Addr of B.P. to command string
! ARGS: ignored
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! PTR is updated
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! A process is created to TALK
!
!--
BEGIN
LOCAL
NB: REF NDB, !Addr of NDB we will create
FB: REF FILE_BLOCK, !
PB: REF PROCESS_BLOCK; !Addr of new process block
EATSPACES(.PTR); !Eat leading spaces
NB=ALLOC(NDB_LEN); !Make an NDB for him
FB=ALLOC(FB_LEN); !File block also
NDBINI(NB[$]); !Set it up
FBINI(FB[$]); !
NB[NDB$FB]=FB[$]; !Link the file block to the NDB
NB[NDB$NODEID]=RDSIXA(.PTR);!Let him know who to TALK to
WHILE CH$RCHAR(..PTR) EQL %C':' DO CH$RCHAR_A(.PTR); !Eat ::
PB=FORK(TALK,NB[$]); !Create the process and say who to connect to
EATSPACES(.PTR); !Eat spaces after nodeid
FB[FILE$NAME]=PB[P$NAME]=RDSIXA(.PTR); !Get name of process
RUNNING[P$NDB]=0; !Disown the NDB
END; !End of CONNECT
GLOBAL ROUTINE SEND (PTR,ARGS) :NOVALUE = !
!++
! FUNCTIONAL DESCRIPTION:
!
! Send data on a test link
!
! FORMAL PARAMETERS:
!
! PTR: addr of b.p. to cmd string
! ARGS: ignored
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! A block of data is sent on the specified link
!
!--
BEGIN
LOCAL
NB: REF NDB, !NDB we are using
FB: REF FILE_BLOCK, !Associated file block
PB: REF PROCESS_BLOCK; !PB for process on whose link we are sending
EATSPACES(.PTR); !Clean out leading spaces
IF (PB=FINDP(RDSIXA(.PTR))) EQL 0 !Process block to send to
THEN (WRN ('No such process'); RETURN 0); !Doesn't exist
IF (NB=.PB[P$NDB]) EQL 0 !The process' NDB (if any)
THEN (WRN ('Process has no logical link'); RETURN);
DO BEGIN
SELECT EATSPACES(.PTR) OF SET !Swallow up spaces
[%C':']: CH$RCHAR_A(.PTR); !And colons
[%C'"',%c'''']:
BEGIN !Raw text
LOCAL C;
BIND D=CH$RCHAR_A(.PTR);!Get the delimiter
WHILE (C=CH$RCHAR_A(.PTR)) NEQ D DO XBOUT(NB[$],.C);
END;
[%C'+']: ONOEOR(NB)=1; !No-End-of-Record
[%C'-']: ONOEOR(NB)=0; !Yes-End-of-Record
[0]: BEGIN
XOUT_NOWAIT(NB[$]);
EXITLOOP;
END;
[%C'+',%C'-']: CH$RCHAR_A(.PTR); !Eat it
[%C'*']: BEGIN
OWN JUNKIB: INT_BLOCK
INITIAL(0,0,0,0,0,2,SENDJUNK); !Signal
CH$RCHAR_A(.PTR); !Eat the *
EATSPACES(.PTR); !Strip leading spaces
JUNKIB[INT$STATUS]=RDNUMA(.PTR,10); !How much junk?
FSIGNL(.PB,JUNKIB); !Make him do it
RETURN;
END;
[%C'=']: BEGIN !Send a file
CH$RCHAR_A(.PTR); !Eat it
FB=.NB[NDB$FB]; !Get the file block
FPARSE(FB[$],.PTR); !Parse the filespec
OPEN_R(FB[$]); !Open the file
FSIGNL(.PB,IB_SENDFILE);!Make him send it
RETURN; !Finished
END;
[%C'0' TO %C'7']:
BEGIN
XBOUT(NB[$],RDNUMA(.PTR,8)); !Send octal
END;
[OTHERWISE]: CH$RCHAR_A(.PTR); !Ignore
TES
END WHILE 1
END; !End of SEND
END !End of module
ELUDOM