Google
 

Trailing-Edge - PDP-10 Archives - bb-x130a-sb - dtscom.mac
There are 5 other files named dtscom.mac in the archive. Click here to see a list.
	TITLE	DTSCOM - Common Routines for DTS and DTR
	SUBTTL W. Nichols	May, 1981

	SEARCH	JOBDAT,UUOSYM,NSCAN,DTSPRM,MACTEN
	FTEXTRA==0
	IFN FTEXTRA,SEARCH SCPAR

	EXTERNAL .ISCAN,.TYOCH	;ASSURE THAT SCAN COMES IN FOR LITTLES
	.REQUEST REL:SCAN
	EXTERNAL .LKWLD		;ASSURE THAT WILD COMES IN FOR E.LKEN
	.REQUEST REL:WILD
	.REQUEST REL:HELPER

	SALL
	.DIRECTIVE FLBLST	;DON'T GIVE ME CODE FOR ASCIZ


;	This program conforms to the DTS specification version 1.1
;	published on 22 April 1981.




;Expand the INTERN/EXTERN macro from DTSPRM

	GLOBAL	INTERNAL,EXTERNAL


	$RELOC
	$HIGH
	SUBTTL	General Impure Storage

	$HIGH			;SHOULD ALREADY BE IN HISEG, BUT...

PDLIOW::IOWD	LN$PDL,DTSPDL	;IOWD TO LOAD INTO P UPON STARTUP

	$LOW

DTSPDL::BLOCK	LN$PDL+1	;THE STACK
CCLF1::	BLOCK	1		;THE CCL ENTRY FLAG FOR .ISCAN
TYPBOL::BLOCK	1		;TYPOUT AT BEG OF LINE IF NON-ZERO
TYPRCS::BLOCK	1		;TYPOUT IS RECURSING IF NON-ZERO
INIFF::	BLOCK	1		;INITIAL VALUE OF .JBFF
INICOR::BLOCK	1		;INITIAL VALUE OF .JBREL
CURCMD::BLOCK	1		;CURRENT COMMAND NAME, FOR UNKCMD

CHANEL::EXP	-1		;THE NSP. CHANNEL NUMBER ASSIGNED

LOGSPC::BLOCK	.FXLEN+1	;SCAN BLOCK FOR LOG SPECIFICATION

LOGFOP::BLOCK	FOPLEN		;FILOP. BLOCK FOR LOG FILE
LOGBRH::BLOCK	3		;LOG FILE'S BUFFER RING HEADER
LOGENT::BLOCK	LN$ENT		;ENTER BLOCK FOR LOG SPEC
LOGPTH::BLOCK	.PTMAX		;PATH FOR .STOPB TO SET UP

ERRPRI:	BLOCK	1		;NON-ZERO IF WE'RE PRINTING AN ERROR
ALWPRI::BLOCK	1		;NON-ZERO IF WE'RE PRINTING STATS
LASTIM:	BLOCK	1		;USED BY GETTIM


;The User Data Block

	USRLEN==1+<<LN$DAT+3>/4> ;STRING POINTER, COUNT+USER DATA(8-BIT)
IFL USRLEN-STRLNW,USRLEN==STRLNW

USERDA:	STRBLK	USRLEN		;A FREE STRING BLOCK FOR USER DATA
CNTUSR:	STRBLK	USRLEN		;READ THE CONNECT/DISCONNECT DATA HERE
RCVMSG:	STRBLK	MAXMGW		;THE DATA TEST'S RECEIVED MESSAGE

PRCVMSG:POINT	8,RCVMSG+1	;BYTE POINTER TO DATA TEST'S MESSAGE

	$HIGH

CPRGID:	EXP	PRGID		;MACRO CAN'T STAND THIS IN A LITERAL
;Call:	CHANEL/	The NSP. channel number
;	CALL	NSPREL
;	Normal Return
;
;Uses T1,T2,T3,T4

NSPREL::SETO	T1,		;MAKE A -1 TO COMPARE WITH
	CAMN	T1,CHANEL	;IS IT OPEN?
	RET			;NO, DON'T NEED TO RELEASE IT.
	TRACE	<NSPREL releasing channel state info follows>,CRLF
	LDB	T1,[POINTR(NSACH,NS.STA)]
	CAIE	T1,.NSSRN	;IN RUN STATE?
	JRST	NSPR.1		;NO, HAVE TO RELEASE
				;YES, WE SHOULD BE ABLE TO ABORT
	CALNSP	.NSFAB,,NS.WAI	;FIRST, TRY ABORT
	  TRNA			;FAILED, TRY RELEASE
	JRST	NSPR.X		;SUCCESS RETURN

	CALL NSPERR		;FAILED, TELL USER WHY

NSPR.1:	CALNSP	.NSFRL		;RELEASE (CLOSE) FUNCTION
	  CALL NSPERR
NSPR.X:	SETOB	NSACH,CHANEL	;THE CHANNEL IS NOW CLOSED
CPOPJ:	RET
	SUBTTL	.STATUS - Read the Status of the Link

;.STATUS is called by the STATUS command
;TYPSTA is called by error handlers
;that have found strange states in NSP. returns.
;
;Call:	CALL	.STATUS
;	Normal Return, message has been typed
;
;Uses T1,T2,T3,T4

DEFINE TYPSTB(bitname),<
	MOVEI	T1,[ASCIZ ", bitname: "]
	CALLSCAN .TSTRG##
	LDB	T1,[POINTR(NSACH,NS.'bitname)]
	CALLSCAN .TOCTW##
>

.STATUS::
	SKIPGE	CHANEL		;IS THE CHANNEL OPEN?
	JRST	NOSTAT		;NO, TELL THEM NOTHING DOING

TYPSTA::SAVEAC	<P1,P2>
	SKIPL	CHANEL		;IS THE CHANNEL OPEN?
	 CALL	NSPSTS		;YES, GET STATUS INTO NSAA1
	  RET			;PROPOGATE ERROR RETURN
	LDB	T1,[POINTR(NSACH,NS.STA)]
	CAILE	T1,MAXSTA	;LEGAL STATE?
	MOVX	T1,-1		;NO, GET ERROR MESSAGE
	MOVE	T1,STATAB(T1)
	CALL	INFMSG		;OUTPUT AN INFO MESSAGE HEADER
	MOVEI	T1,[ASCIZ / state/]
	CALLSCAN .TSTRG##
	TYPSTB	NDA		;NORMAL DATA AVAIL
	TYPSTB	NDR		;NORMAL DATA REQUESTS AVAIL
	TYPSTB	IDA		;INTERRUPT DATA AVAIL
	TYPSTB	IDR		;INTERRUPT DATA REQUESTS AVAIL
	CALLSCAN .TRBRK##	;A RIGHT SQUARE BRACKET FOR INFO
	CALLSCAN .TCRLF##
	RET			;"REPARSE" RETURN


NOSTAT:	ERROR	<No DECnet channel is open>,CRLF
	RET
;Type out Flow Control value from T1


TYPFLO::CAIL	T1,0
	CAILE	T1,3
	MOVEI	T1,4			;UNKNOWN FLOW CONTROL TYPE
	MOVE	T1,FLOTYP(T1)
	CALLSCAN .TSTRG##
	RET

FLOTYP:	[ASCIZ	/Unknown/]
	[ASCIZ	/None/]
	[ASCIZ	/Segment/]
	[ASCIZ	/Message/]
	[ASCIZ	/Erroneous/]
DEFINE STATE(code),<
	IFN .NSS'code-<.-STATAB>,PRINTX ?STATAB table wrong for code
	[ASCIZ /code/]
>

	[ASCIZ /Too Big (illegal)/] ;-1 value used when state too big
STATAB:	[ASCIZ /Zero (illegal)/]
	STATE	CW		;CONNECT WAIT
	STATE	CR		;CONNECT RECEIVED
	STATE	CS		;CONNECT SENT
	STATE	RJ		;LINK WAS REJECTED
	STATE	RN		;LINK IS UP AND RUNNING
	STATE	DR		;DISCONNECT RECEIVED
	STATE	DS		;DISCONNECT SENT
	STATE	DC		;DISCONNECT CONFIRMED
	STATE	CF		;NO CONFIDENCE
	STATE	LK		;NO LINK
	STATE	CM		;NO COMMUNICATION
	STATE	NR		;NO RESOURCES
MAXSTA==.-STATAB-1
;NSPSTS - Get status of NSP channel into NSACH
;
;Call:	CALL	NSPSTS
;	  Error Return if NSP. UUO failed, message already output
;	Normal Return with status in register NSACH

;This routine is expected to get the status and the other things
;that a read status function returns: seg size and flow control types.

NSPSTS::CALNSP	.NSFRS,NSAA2	;READ STATUS FUNCTION CODE
	  RET			;ERROR RETURN, LET USER
				; ANNOUNCE IT IF S/HE WANTS
	RETSKP			;SUCCESS RETURN
;RDCNDT - Read Connect User Data
;
;Call:	CALL	RDCNDT
;	  Error Return, message already put out
;	Normal Return, NSAxx and CNTUSR filled in,
;		and	NSAA1 holds pointer to CNTUSR
;			NSAA2 holds Segment Size
;			NSAA3 holds transmit flow control mode


RDCNDT::
	MOVEI	NSAA1,CNTUSR		;PTR TO DIS/CONNECT USER DATA
	CALNSP	.NSFRC,NSAA3		;READ CONNECT DATA (NO WAIT)
	  PJRST	NSPERR
	RETSKP





;RDDSDT - Read Disconnect User Data
;
;Call:	CALL	RDDSDT
;	  Error Return, message already put out
;	Normal Return, NSAxx and CNTUSR filled in,
;		and	NSAA1 holds pointer to CNTUSR
;			NSAA2 holds Segment Size
;			NSAA3 holds transmit flow control mode


RDDSDT::
	MOVEI	NSAA1,CNTUSR		;PTR TO DIS/CONNECT USER DATA
	CALNSP	.NSFRD,NSAA2		;READ DISCONNECT DATA (NO WAIT)
	  PJRST	NSPERR
	RETSKP
	SUBTTL	Error Routines

;NSPERR - Call this to interpret the error code from the NSP. UUO
;NSPERL - Same, but release the channel after printing the message
;
;Call:	T1/	returned from NSP.
;	CALL	NSPERR/NSPERL
;	Normal Return

NSPERL::CALL	NSPERR		;PRINT OUT THE ERROR
	PJRST	NSPREL		;THEN RELEASE THE CHANNEL


NSPERR::PUSH	P,T1		;SAVE ERROR FROM NSP. UUO
	WARN	<NSP. error: >
	POP	P,T1		;GET NSP. ERROR MSG BACK
	CAIG	T1,MAXERR	;DO WE KNOW THIS ERROR CODE?
	JRST	[MOVEI T2,.TSTRG##
		 MOVE  T1,NSPERC(T1)
		 JRST  NSPER1]
	MOVEI	T2,.TOCTW##	;NO, PRINT AS A OCTAL ERROR CODE
NSPER1:	CALL	(T2)		;PRINT STRING OR NUMBER
	MOVEI	T1,[ASCIZ /, function /]
	CALLSCAN .TSTRG##
	LDB	T1,[POINTR(NSAFN,NS.AFN)] ;GET FUNCTION CODE FROM ARGS
	CAILE	T1,FCNTBL	;OFFSET OK?
	MOVEI	T1,0		;NO, CALL IT ILLEGAL
	MOVE	T1,FCNTAB(T1)	;GET PTR TO ASCIZ STRING
	CALLSCAN .TSTRG##	;TELL USER ABOUT FUNCTION CODE
	CALLSCAN .TCRLF##
	RET
DEFINE ERRMAC(code,text),<
	IF1,<IFN code-<.-NSPERC>,<
		PRINTX ?NSP. error code out of order in NSPERC table>>
	ERRMC1(\code,text)
>
DEFINE ERRMC1(code,text),<[ASCIZ |(code) text|]>

NSPERC:	ERRMAC 0,     <Unknown Error Code>
	ERRMAC NSABE%,<Argument Block Format Error>
	ERRMAC NSALF%,<Allocation failure>
	ERRMAC NSBCN%,<Bad channel number>
	ERRMAC NSBFT%,<Bad format type in process block>
	ERRMAC NSCFE%,<Connect Block format error>
	ERRMAC NSIDL%,<Interrupt data too long>
	ERRMAC NSIFM%,<Illegal flow control mode>
	ERRMAC NSILF%,<Illegal function>
	ERRMAC NSJQX%,<Job quota exhausted>
	ERRMAC NSLQX%,<Link quota exhausted>
	ERRMAC NSNCD%,<No connect data to read>
	ERRMAC NSPIO%,<Percentage input out of bounds>
	ERRMAC NSPRV%,<No Privileges to Perform Function>
	ERRMAC NSSTB%,<Segment size too big>
	ERRMAC NSUKN%,<Unknown node name>
	ERRMAC NSUXS%,<Unexpected State: Unspecified>
	ERRMAC NSWNA%,<Wrong number of arguments>
	ERRMAC NSWRS%,<Function called in wrong state>

;New error codes (to be re-ordered):

	ERRMAC NSCBL%,<Connect block length error>
	ERRMAC NSPBL%,<Process block length error>
	ERRMAC NSSBL%,<String block length error>
	ERRMAC NSUDS%,<Unexpected State: Disconnect Sent>
	ERRMAC NSUDC%,<Unexpected State: Disconnect Confirmed>
	ERRMAC NSUCF%,<Unexpected State: No Confidence>
	ERRMAC NSULK%,<Unexpected State: No Link>
	ERRMAC NSUCM%,<Unexpected State: No Communication>
	ERRMAC NSUNR%,<Unexpected State: No Resources>

;Error codes which correspond to DECnet disconnect codes.

	ERRMAC NSRBO%,<Rejected by Object>
	ERRMAC NSDBO%,<Disconnected by Object>
	ERRMAC NSRES%,<No Resources at Remote Node>
	ERRMAC NSUNN%,<Unrecognized Node Name>
	ERRMAC NSRNS%,<Remote Node Shut Down>
	ERRMAC NSURO%,<Unrecognized Object>
	ERRMAC NSIOF%,<Invalid Object Name Format>
	ERRMAC NSOTB%,<Object Too Busy>
	ERRMAC NSABM%,<Abort by Management>
	ERRMAC NSABO%,<Abort by Object>
	ERRMAC NSINF%,<Invalid Node Name Format>
	ERRMAC NSLNS%,<Local Node Shut Down>
	ERRMAC NSACR%,<Access Control Rejection>
	ERRMAC NSNRO%,<No Response from Object>
	ERRMAC NSNUR%,<Node Unreachable>
	ERRMAC NSNLK%,<No Link>
	ERRMAC NSDSC%,<Disconnect Complete>
	ERRMAC NSIMG%,<Image Field Too Long>
	ERRMAC NSREJ%,<Unspecified Reject Reason>

	ERRMAC NSBCF%,<Bad combination of NS.EOM & NS.WAI flags>
	ERRMAC NSADE%,<Address Error>
;	ERRMAC NSIMF%,<Invalid Message Format: Network Error>

MAXERR==.-NSPERC-1
DEFINE FCNMAC(code,text),<
	IFN code-<.-FCNTAB>,<PRINTX ?NSP. function code out of order>
	[ASCIZ /text/]
>

FCNTAB:	FCNMAC 0,     <Illegal function code>
	FCNMAC .NSFEA,<Enter active>
	FCNMAC .NSFEP,<Enter passive>
	FCNMAC .NSFRI,<Read connect information>
	FCNMAC .NSFAC,<Accept the connect>
	FCNMAC .NSFRJ,<Reject the connect>
	FCNMAC .NSFRC,<Read connect confirm information>
	FCNMAC .NSFSD,<Synchronous disconnect>
	FCNMAC .NSFAB,<Abort>
	FCNMAC .NSFRD,<Read disconnect data>
	FCNMAC .NSFRL,<Release the channel>
	FCNMAC .NSFRS,<Read the channel status>
	FCNMAC .NSFIS,<Send interrupt data>
	FCNMAC .NSFIR,<Receive interrupt data>
	FCNMAC .NSFDS,<Send normal data>
	FCNMAC .NSFDR,<Receive normal data>
	FCNMAC .NSFSQ,<Set quotas>
	FCNMAC .NSFRQ,<Read quotas>
	FCNMAC .NSFJS,<Set job quotas>
	FCNMAC .NSFJR,<Read job quotas>
	FCNMAC .NSFPI,<Set PSI reasons>
FCNTBL==.-FCNTAB
;UNKCMD - Call this when .LKNAM fails to find a command
;
;Call:	CURCMD/ Set up by LOOKNM
;	T1/	The error code from .LKNAM
;	CALL	UNKCMD
;	Normal Return, always
;Changes T1,T2,T3,T4

UNKCMD::MOVE	T2,T1		;COPY ERROR CODE FROM .LKNAM
	MOVEI	T1,[ASCIZ \Unknown command: \]
	SKIPL	T2		;T2.LT.0 IF NOT MATCH
	MOVEI	T1,[ASCIZ \Ambiguous command: \]
	PJRST	ERRCMD
;ERRCMD - Type an error string followed by CURCMD
;
;Call:	T1/	Ptr to ASCIZ string
;	CALL	ERRCMD
;	Normal Return, always

ERRCMD::SETOM	ERRPRI		;ENABLE PRINT:ERROR
	CALL	ERRMSG
	MOVE	T1,CURCMD	;TYPE SIXBIT NAME SAVED BEFORE CALL
	CALLSCAN .TSIXN##	; TO .LKNAM
	CALLSCAN .TCRLF##
	PJRST	ERWM.2		;GO TO COMMON EXIT CODE

;xxxMSG - Type out a message, subject to /PRINT:xxx
;
;Call:	T1/ Pointer to ASCIZ string, including CRLF if so desired
;	CALL	ERRMSG
;	Normal Return

ERRMSG::PUSH	P,T1		;SAVE ERROR MESSAGE
	PUSH	P,["E"]
	SETOM	ERRPRI		;ENABLE PRINT:ERROR
	MOVEI	T1,"?"
	JRST	ERWM.1

WRNMSG::PUSH	P,T1		;SAVE WARNING MESSAGE
	PUSH	P,["W"]
	SETOM	ERRPRI		;ENABLE PRINT:ERROR
	MOVEI	T1,"%"
	JRST	ERWM.1

IFN FTTRACE,<
TRCMSG::PUSH	P,T1		;SAVE WARNING MESSAGE
	PUSH	P,["I"]
	MOVEI	T1,"["
	JRST	ERWM.1
>

INFMSG::PUSH	P,T1		;SAVE INFO MESSAGE
	PUSH	P,["I"]
	MOVEI	T1,"["
ERWM.1:	CALLSCAN .TCHAR##	;TYPE OUT ?,% OR [
	MOVE	T1,CPRGID	;GET 'DTS' OR 'DTR'
	CALLSCAN .TSIXN##	; (ITS IN SIXBIT)
	MOVEI	T1,[ASCIZ / --/]
	CALLSCAN .TSTRG##
	POP	P,T1		;POP E,I OR W
	CALLSCAN .TCHAR##	;PRINT THE ERROR-TYPE CHARACTER
	MOVEI	T1,[ASCIZ /-- /]
	CALLSCAN .TSTRG##
	POP	P,T1
	CALLSCAN .TSTRG##
ERWM.2:	SETOM	.FLCBF##	;THERE WAS AN ERROR, CLEAR REST OF LINE
	RET			; WHEN WE NEXT REACH TOP LEVEL
	SUBTTL STYPIN - Special Typeing Routine for SCAN

;STYPIN - Called only by SCAN because of argument to .ISCAN call
;
;Call:	CALL STYPIN
;	Normal Return with char in C
;
;Saves all ACs except C

;This routine hibers before calling INCHRW so that PSISER will get
;a chance to interrupt us.  The user-mode test bed depends on this.

;Here we use SKPINL and INCHRW rather than INCHSL so that
;MIC will see the INCHWL if the user types a space.

STYPIN:
REPEAT 0,<
	SKPINC			;ANY INPUT YET?
	 JRST	STYI.1		;NO, WAIT FOR IT
	  JRST	STYI.2		;YES, WAIT FOR A FULL LINE (FOR MIC)
STYI.1:	MOVE	C,[EXP HB.RTC ! ^D1000]	;WAKE ON CHARACTER INPUT
	HIBER	C,		;GIVE PSI A CHANCE TO INTERRUPT
	  JFCL			; THE INCHRW
	SKPINC	C		;SEE IF WE REALLY GOT A CHARACTER
	  JRST	STYI.1		;NO, FALSEHOOD AND LIES FROM PSISER
> ;END REPEAT 0
STYI.2:	INCHWL	C		;YES, GIVE CHAR TO SCAN
	RET


		Comment @

	Note that this routine will hang in TI state once the
	first character of a line has been typed.  This is for
	MIC.  The user types a space, then MIC types the rest
	of the line.

			@
	SUBTTL	STYPOU - Output a Char to TTY and/or Log File

;STYPOU - Called by SCAN to output a char to the user
;
;Call:	T1/ The Character
;	CALL	STYPOU
;	Normal Return

STYPOU::CALL	STYPSB		;DO ANY TYPE OUT THAT IS REQUIRED
	CAIN	T1,12		;WAS IT A LINE FEED?
	SETZM	ERRPRI		;YES, THAT WAS END OF ERROR LINE
	RET


STYPSB:	SAVEAC	<T1,T2,T3,T4>
	SKIPE	TYPRCS		;SKIP IF NO STYPOU RECURSION
	JRST	TYPO.3		;IF RECURSING, MUST BE TIME STAMPING
	MOVE	T2,PRINT	;GET PRINT OPTION FROM USER
	SKIPN	ALWPRI		;SET BY STATISTICS PRINTOUT
	CAIN	T2,PRI.AL	;PRINT:ALL?
	JRST	TYPO.1		;YES, TELL TTY AND LOG FILE
	CAIN	T2,PRI.NO	;PRINT:NONE?
	JRST	TYPO.2		;YES, TELL LOG FILE ONLY
	SKIPN	ERRPRI		;MUST BE PRINT:ERROR, PRINTING ERROR?
	JRST	TYPO.2		;NO, TELL LOG FILE ONLY
				;YES, TELL TTY AND LOG FILE
TYPO.1:	OUTCHR	T1

TYPO.2:	SKIPN	LOGFLG		;ARE WE LOGGING NOW?
	RET			;NO
	SKIPE	TYPBOL		;AT BEG OF LINE?
	CALL	TIMSTP		;YES, TIME STAMP THIS LINE
	CAIN	T1,12		;ARE WE STORING A LINE FEED?
	SETOM	TYPBOL		;YES, NEXT CHR WILL BE A BEG OF LINE
TYPO.3:	CALL	OUTBYT		;YES, PUT THE BYTE OUT TO THE LOG FILE
	  RET			;ERROR, ALREADY CLOSED, LOGFLG ZEROED
	RET			;SUCCESS RETURN
;The TIMSTP subroutine for STYPOU: time stamp a log file


TIMSTP::SAVEAC	T1		;SAVE CHR ABOUT TO BE STORED IN LOG

	SETOM	TYPRCS		;WE ARE RECURSING IN STYPOU

	CALLSCAN .TDATN##	;TYPE TODAY'S DATE INTO LOG FILE
	CALLSCAN .TSPAC##	;TYPE A SPACE
	CALLSCAN .TTIMN##	;TYPE CURRENT TIME INTO LOG FILE
	CALLSCAN .TTABC##	;TYPE A TAB

	SETZM	TYPRCS		;NO LONGER RECURSING
	SETZM	TYPBOL		;NO LONGER AT BEG OF LINE
	RET
	SUBTTL DDT Aid for Logging
REPEAT 0,<
;This routine is expected to be called by DDT with CALL LOGIT$X
;It is meant mostly for DTR, since DTS aleady has the LOG command.

LOGIT::	SAVEAC <CX,T1,T2,T3,T4,T5,T6,P1,P2,MB,MS,FREE1,FREE2>

	MOVX	P2,-1		;-1 MEANS USE THE DEFAULT LOG FILE NAME
	CALL	STRLOG
	MOVEM	N,LOGFLG
	RET
> ;END REPEAT 0
	SUBTTL	Log File I/O

;STRLOG - Start Logging to a Log File
;
;Call:	CALL	STRLOG
;	Normal Return with N set to the value to store in LOGFLG
;Changes T1,T2,T3,T4

STRLOG::SKIPN	LOGFLG		;HAVE A LOG FILE OPEN NOW?
	JRST	STRL.1		;NO
	CALL	CLSLOG		;YES, CLOSE IT SO WE CAN START ANOTHER
	SETZM	LOGSPC		;SMEAR LOGSPC TO ZEROS
	MOVE	T1,[LOGSPC,,LOGSPC+1]
	BLT	T1,LOGSPC+.FXLEN-1

;Return from .FILIN is in T1:
;	T1=0  if nothing typed
;	T1=-1 if file spec typed
;	T1=+1 if nothing but global switches typed

STRL.1:	JUMPL	C,STRL.2	;DON'T CALL .FILIN IF EOF
	CAIE	C,":"		;IS PUNCTUATION A COLON?
	CAIN	C,"="		;OR AN EQUAL?
	CAIA			;YES, GET A FILESPEC
	JRST	STRL.2		;NO, TAKE THE DEFAULTS

	OUTSTR	[ASCIZ /[A log file spec must be the last command on a line]
/]
	CALLSCAN .FILIN##	;GET THE FILE SPEC FROM THE USER

	MOVEI	T1,LOGSPC	;MOVE THE NEW SPEC TO HERE
	MOVEI	T2,.FXLEN	;IT IS THIS LONG
	CALLSCAN .GTSPC##	;...

STRL.2:	MOVE	T1,CPRGID	;DEFAULT TO NAME OF THIS PROGRAM
	SETO	T2,		;NON-WILD MASK FOR WILD
	SKIPN	LOGSPC+.FXNAM	;USER TYPE A NAME?
	DMOVEM	T1,LOGSPC+.FXNAM;NO, FILL IN NAME AND NON-WILD MASK

	HRLOI	T1,'LOG'	;DEFAULT TO .LOG EXTENSION
	SKIPN	LOGSPC+.FXEXT	;USER TYPE AN EXT (OR . FOR NULL)?
	MOVEM	T1,LOGSPC+.FXEXT;NO, MAKE IT .LOG

;Continued on Next Page
;From Previous Page with SCAN block all defaulted

	HRRI	T1,LOGSPC	;THE SCAN BLOCK,
	HRLI	T1,.FXLEN	;  AND ITS LENGTH.
	MOVEI	T2,LOGFOP+.FOIOS ;OUTPUT RING HDR BLK. (3-WORD)
	HRRI	T3,LOGENT	;EXTENDED ENTER BLOCK.
	HRLI	T3,LN$ENT	;  ITS LENGTH.
	MOVEI	T4,LOGPTH	;A PTHLNG-LENGTH-WORD PATH BLK.
	CALLSCAN .STOPB##	;NO-WILD SCAN BLK TO LOOKUP
	  JRST	STPERR		; BLOCK TRANSLATOR.

	MOVE	T1,[FO.PRV ! <LOGCHN>B17 ! .FOAPP]
	MOVEM	T1,LOGFOP+.FOFNC
	MOVEI	T1,LN$ENT	;LENGTH OF THE ENTER BLOCK
	MOVEM	T1,LOGENT	;STORE AS LENGTH FOR THE FILOP
	MOVEI	T1,LOGENT	;PTR TO THE ENTER BLOCK
	MOVEM	T1,LOGFOP+.FOLEB
	MOVEI	T1,LOGBRH	;GET A BUFFER RING HEADER ADDRESS
	HRLM	T1,LOGFOP+.FOBRH ;STORE IN THE FILOP BLOCK
	MOVE	T1,[FOPLEN,,LOGFOP]
	FILOP.	T1,		;APPEND THE LOG FILE (OR CREATE IT)
	  JRST	LGEERR		;OPEN ERROR

;Start the file with a form feed in case this is an appended file

	SETOM	TYPRCS		;TELL STYPOU THAT WE'RE RECURSING
	MOVEI	T1,14		;A FORM FEED
	CALLSCAN .TCHAR##	;TYPE THE CHAR INTO THE LOG FILE
	CALLSCAN .TCRLF##	;TYPE A CARRIAGE RETURN, LINE FEED
	SETZM	TYPRCS		;NO LONGER RECURSING

	SETOB	N,TYPBOL	;WE NOW HAVE A LOG FILE TO WRITE TO
				;RETURN VALUE TO STORE IN LOGFLG
				;SET TYPBOL NON-ZERO TO START TIME-
	RET			; STAMPING
STPERR:	MOVEI	T1,[ASCIZ \%Wild cards in log file name not supported\]
	CALL	ERRMSG
	MOVEI	T1,[ASCIZ \, logging disabled
\]
	CALL	ERRMSG
	JRST	LGECOM


LGEERR:	MOVEI	T1,LOGENT	;ENTER BLOCK
	MOVEI	T2,LN$ENT	;LENGTH OF ENTER BLOCK
	MOVEI	T3,LOGSPC	;SCAN BLOCK
	SETOM	ERRPRI		;ENABLE PRINT:ERROR
	CALLSCAN E.LKEN##	;ERROR ENTERRING LOG FILE


;Common exit for all STRLOG errors: set N to zero.
;Caller will store N in LOGFLG

LGECOM:	SETZ	N,		;TURN OFF LOGGING
	RET
;OUTBYT - Output a byte to the log file
;
;Call:	T1/ The Byte
;	CALL	OUTBYT
;	  Error Return
;	Normal Return
;Changes T1,T2,T3,T4

OUTBYT:
OUTB.1:	SOSGE	LOGBRH+.BFCTR	;LOGBRH = HEADER FOR FILE OUTPUT
	  JRST	OUTBYN		;NO ROOM, GET A NEW BUFFER
	IDPB	T1,LOGBRH+.BFPTR ;THE NORMAL OUTPUT DEPOSIT BYTE.
	AOS	(P)		;SUCCESS RETURN
	RET

OUTBYN:	CALL	OUTBUF		;OUTPUT THE BUFFER
	  RET			;"DON'T CONTINUE" RETURN
	JRST	OUTB.1		;GOT A BUFFER, GO COUNT IT DOWN



;CALL	CALL	OUTBUF
;	  "DON'T CONTINUE" RETURN
;	"OK" RETURN

OUTBUF:	OUT	LOGCHN,
	  JRST	.POPJ1		;OK RETURN: SUCCESS

	GETSTS	LOGCHN, T1
	PJRST	OTIOER		;TELL USER ABOUT I/O ERROR
;OTIOER - Tell user about output I/O error
;
;Call:	T1/	GETSTS code
;	CALL	OTIOER
;	Normal Return

OTIOER:	SAVEAC	<T1,T2,T3,T4,P1,P2,C,N>;DRASTIC, BUT NOT FREQUENT

	CALL	CLSLOG		;SALVAGE WHAT WE CAN OF THE LOG FILE

	PUSH	P, T1		;SAVE GETSTS CODE FOR A SEC
	MOVEI	T1,[ASCIZ "% Output I/O error, logging stopped"]
	CALLSCAN .TSTRG##
	POP	P, T1		;RESTORE GETSTS CODE
	CALL	ERRSTS		;TELL USER ABOUT ERROR
	CALLSCAN .TCRLF##
	RET			;NO, NON-SKIP RETURN
;CALL	T1/	GETSTS code
;	CALL	ERRSTS
;	Only return

DEFINE	ERRMAC (name, text),<
	MOVEI	T1,[ASCIZ " name:text"]
	$XLIST
	TXNE	T2,name
	  CALLSCAN .TSTRG##
	$LIST
>;END OF DEFINE ERRMAC



ERRSTS:	PUSH	P, T1		;SAVE THE GETSTS CODE
	CALLSCAN .TOCTW##	;PRINT IT IN OCTAL

	MOVEI	T1,[ASCIZ " ("]
	CALLSCAN .TSTRG##

	POP	P,T2		;RESTORE GETSTS CODE

	ERRMAC	IO.IMP, Software Detected Error
	ERRMAC	IO.DER, Device Error
	ERRMAC	IO.DTE, Data Error
	ERRMAC	IO.BKT, Block Too Large

	MOVEI	T1,[ASCIZ " )"]
	CALLSCAN .TSTRG##
	RET
	SUBTTL	STPLOG - Stop Logging to a Log File

;STPLOG - Stop Logging to a Log File
;
;Call:	CALL	STPLOG
;	Normal Return with N set to zero for caller to store in LOGFLG
;Changes T1,T2,T3,T4

STPLOG::CALL	CLSLOG		;CLOSE ANY LOG FILE THAT MAY HAVE
				; BEEN OPEN.
	SETZB	N,LOGFLG	;TELL STYPOU TO STOP LOGGING
	RET			;N GETS STORED IN LOGFLG BY CALLER






;Close the Log file politely

CLSLOG::CLOSE	LOGCHN,
	SETZM	LOGFLG		;TELL STYPOU NOT TO LOG ANY MORE
	PUSH	P,INIFF		;GET THE VALUE OF .JBFF AT STARTUP
	POP	P,.JBFF
	SETZM	LOGBRH		;NO LONGER HAVE THE BUFFER'S CORE
	SETZM	LOGBRH+1
	SETZM	LOGBRH+2
	RET
	SUBTTL	String Handling Routines

;SIX2ST - Convert a sixbit word to a string block
;
;Call:	T1/	Pointer to a string block big enough for six chars
;	T2/	The SIXBIT word
;	CALL SIX2ST
;	Normal Return
;
;Uses T1,T2,T3,T4

SIX2ST::SAVEAC	<P1,P2>
	MOVSI	P1,(POINT 8,)
	HRRI	P1,1(T1)
	MOVE	P2,[POINT 6,T2]
	MOVEI	T4,6		;UP TO SIX CHARS IN A SIXBIT WORD
SX2S.1:	ILDB	T3,P2		;GET A SIXBIT CHAR
	JUMPE	T3,SX2S.2	;STOP COPYING WHEN WE GET A NULL
	ADDI	T3," "		;MAKE IT ASCII
	IDPB	T3,P1		;STORE IN STRING BLOCK
	SOJG	T4,SX2S.1	;LOOP IF WE'VE NOT DONE ALL YET
SX2S.2:	MOVEI	T3,6		;MAX NUMBER WE COULD HAVE MOVED
	SUB	T3,T4		;GET NUMBER WE DID MOVE
	HRLM	T3,(T1)		;STORE NUMBER WE DID MOVE IN STRING BLK
	RET
;PUTxBY - Put a one- or two-byte value into a string block
;
;Call:	T1/	The value
;	T2/	Pointer to the string block
;	T3/	Number of bytes for PUTNBY, ignored by PUT1BY and PUT2BY
;	CALL	PUTxBY
;	Normal Return
;
;PUTxBY does NOT change T2, this is required for long sequences
; of calls to PUTxBY

PUT2BY:	MOVEI	T3,2		;NUMBER OF BYTES TO PUT
PUTNBY:	JUMPLE	T3,.POPJ	;IGNORE IF NO BYTES TO COPY
	CALL	PUT1BY		;STORE NEXT LOW-ORDER BYTE
	LSH	T1,-^D8		;SHIFT DOWN
	SOJA	T3,PUTNBY	;LOOP UP TO 4 TIMES


PUT1BY::HLRZ	T4,(T2)		;GET CURRENT BYTE COUNT FROM STR BLK
	AOS	T4		;INCR COUNT FOR THIS NEW BYTE
	HRLM	T4,(T2)		;FINISH UP A LEFT-HALF INCREMENT
	ADJBP	T4,[POINT 8,1(T2)] ;BUILD BYTE PTR TO FIRST FREE BYTE
	DPB	T1,T4
	RET
;GETxBY - Get a one- or two-byte value from a string block
;
;Call:	T1/	The offset of the byte to get (the first is 0)
;	T2/	Pointer to the string block
;	T3/	Number of bytes for GETNBY, ignored by GET1BY and GET2BY
;	CALL	GET1BY
;	  Error Return with T1 unchanged (for UNSUPT)
;	Normal Return with value in T1
;
;GETxBY does NOT change T2, this is required for long sequences
; of calls to GETxBY

GET2BY::MOVEI	T3,2		;NUMBER OF BYTES TO GET
	PJRST	GETNBY		;GET THEM

GET1BY::MOVEI	T3,1		;NUMBER OF BYTES TO GET

GETNBY::SAVEAC	T2		;CALLER EXPECTS THIS FOR MULTIPLE CALLS
	CAILE	T3,4		;MAX WE CAN HANDLE IS 4 BYTES/WORD
	HALT	.+1
	MOVE	T4,T3		;GET REQUESTED BYTE COUNT
	ADD	T4,T1		;GET OFFSET OF END OF PROPOSED STRING
	PUSH	P,T2
	HLRZ	T2,(T2)		;GET COUNT OF BYTES IN STR BLK
	CAMLE	T4,T2		;MUST BE LEAST N MORE BYTES
	JRST	[POP P,T2	;NOPE, ERROR RETURN WITH T1 UNCHANGED
		 RET]
	POP	P,T2
	MOVE	T4,T1		;GET OFFSET OF BEG OF STRING AGAIN
	ADJBP	T4,[POINT 8,1]	;BUILD OFFSET IDLB PTR TO FIRST BYTE
	ADD	T4,T2		;POINT IT INTO THE STRING BLOCK
	PUSH	P,T3		;SAVE COUNT REQUESTED
GETN.1:	ILDB	T1,T4		;GET NEXT HIGHER ORDER BYTE
	LSHC	T1,-^D8		;PUT INTO HIGH BYTE OF T2
	SOJG	T3,GETN.1	;DO ALL REQUESTED BYTES
	POP	P,T3		;HOW MANY WAS THAT?
	ASH	T3,3		;BYTE COUNT * 8 = BIT COUNT
				;WE KNOW T1 IS ZERO NOW
	LSHC	T1,(T3)		;RESULT NOW RIGHT JUSTIFIED IN T1
	RETSKP			;SUCCESS RETURN
;ASC2ST - Convert an ASCII string to a string block
;
;Call:	T1/	Pointer to a string block big enough
;	T2/	ILDB Byte Pointer to ASCII string
;	CALL ASC2ST
;	Normal Return
;
;Uses T1,T2,T3,T4

ASC2ST::SAVEAC	<P1,P2>
	MOVSI	P1,(POINT 8,)
	HRRI	P1,1(T1)
	HRRZ	T4,(T1)		;LENGTH OF THE STRING BLOCK (WORDS)
	SOJLE	T4,CPOPJ	;COUNT INCLUDES COUNT WORD AT BEGINNING
	ASH	T4,2		;MULTIPLY BY 4 TO GET BYTE COUNT
	MOVE	P2,T4		;SAVE COUNT FOR LATER
AS2S.1:	ILDB	T3,T2		;GET A ASCII CHAR
	JUMPE	T3,AS2S.2	;STOP COPYING WHEN WE GET A NULL
	IDPB	T3,P1		;STORE IN STRING BLOCK
	SOJG	T4,AS2S.1	;LOOP IF WE'VE NOT DONE ALL YET
AS2S.2:	SUB	P2,T4		;CALC NUMBER WE DID COPY
	HRLM	P2,(T1)		;STORE NUMBER WE MOVED IN STRING BLK
	RET
;SETQTA - Set SQUEUE or RQUEUE as the link quota
;
;Call:	T1/	Value of SQUEUE or RQUEUE
;	CALL SETQTA
;	  Error Return, message already given
;	Normal Return
;
;Uses T1,T2,T3,T4

SETQTA::SKIPG	T1		;ZERO OR NEGATIVE IS ILLEGAL
	MOVEI	T1,1		;DEFAULT TO 1 IN, 1 OUT
	IMULI	T1,2		;DOUBLE IT, HALF FOR IN, HALF FOR OUT

	MOVE	NSAA1,T1	;THE QUOTA
	MOVEI	NSAA2,^D50	;50% INPUT QUOTA
	MOVEI	NSAA3,0		;NO GOAL (YET)
	CALNSP	.NSFSQ,NSAA3	;SET QUOTA FUNCTION CODE
	  JRST	SETQTE
	RETSKP

SETQTE:	ERROR	<Unable to set buffer quota>,CRLF
	RET
;.TSTRB - Type out a string block's string
;
;Call:	T1/	Ptr to string block
;	CALL	.TSTRB
;	Normal Return
;
;Uses T1,T2,T3,T4

.TSTRB::SAVEAC	<P1,P2>
	HLRZ	P1,(T1)		;GET BYTES IN STRING
	JUMPE	P1,CPOPJ	;IGNORE NULL STRING
	MOVEI	P2,1(T1)
	HRLI	P2,(POINT 8,)
TSTB.1:	ILDB	T1,P2		;LOAD UP AN 8-BIT BYTE
	CALLSCAN .TCHAR##	;TYPE THE LOW-ORDER 7 BIT'S CHARACTER
	SOJG	P1,TSTB.1
	RET
	SUBTTL	Test String Routines

;FILSTD - Fill in a Standard Test String
;
;Call:	T1/	Pointer to String Block to Fill
;	T2/	Length of String to Fill
;	CALL	FILSTD
;	Normal Return
;
;Uses T1,T2,T3,T4

FILSTD::JUMPLE	T2,.POPJ
	HLRZ	T4,(T1)		;GET CURRENT BYTE COUNT IN STR BLK
	MOVE	T3,T4		;PREPARE TO UPDATE STRING BLK'S
	ADD	T3,T2		; BYTE COUNT TO TAKE IN NEW STRING
	HRLM	T3,(T1)		;STORE NEW COUNT BACK IN STRING BLK
	ADJBP	T4,[POINT 8,0]	;BUILD IDPB PTR FOR OFFSET
	ADDI	T4,1(T1)	;POINT IT INTO STRING BLOCK
FILS.1:	MOVE	T1,STDSPT	;BYTE PTR TO STANDARD STRING
FILS.2:	ILDB	T3,T1
	JUMPE	T3,FILS.1	;SOURCE ALL DONE, START OVER
	IDPB	T3,T4
	SOJG	T2,FILS.2	;REMAINING LENGTH OF DEST STRING
	RET

;CMPSTD - Compare a Standard Test String
;
;Call:	T1/	Byte Pointer to Target
;	T2/	Length of String to Compare
;	CALL	CMPSTD
;	  No Match Return
;	Match Return
;
;Uses T1,T2,T3,T4

CMPSTD::JUMPLE	T2,.POPJ1	;IF NO STRING, IT MATCHES
	SAVEAC	P1
CMPS.1:	MOVE	T4,STDSPT	;BYTE PTR TO STANDARD STRING
CMPS.2:	ILDB	T3,T4		;GET A STANDARD BYTE
	JUMPE	T3,CMPS.1	;SOURCE ALL DONE, START OVER
	ILDB	P1,T1		;GET A BYTE TO COMPARE
	CAME	P1,T3		;IF NOT EQUAL
	RET			; TAKE NO MATCH RETURN IMMEDIATELY
	SOJG	T2,CMPS.2	;ELSE KEEP COMPARING FOR REST OF
				; STRING PASSED BY USER
	RETSKP			;SUCCESS: MATCHED TO END OF USER STR


STDSPT:	POINT 7,STDSTR
STDSTR:	ASCIZ	/ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789/
;CMPSTB - Compare two string blocks
;
;Call:	T1/	Pointer to first string block
;	T2/	Pointer to second string block
;	CALL	CMPSTB
;	  No Match Return
;	Match Return
;
;Uses T1,T2,T3,T4

CMPSTB::SAVEAC	<P1,P2>
	HLRZ	T3,(T1)		;GET LENGTH OF FIRST BLOCK
	HLRZ	P1,(T2)		;GET LENGTH OF SECOND BLOCK
	CAME	T3,P1		;COMPARE THE LENGTHS
	RET			;NO-MATCH IF NOT SAME LENGTH
	HRLI	T1,(POINT 8,0,35) ;ILDB POINTER TO (T1)+1
	HRLI	T2,(POINT 8,0,35) ;ILDB POINTER TO (T2)+1
CSTB.1:	ILDB	P1,T1		;GET A BYTE OF THE FIRST STRING
	ILDB	P2,T2		;GET A BYTE OR THE SECOND
	CAME	P1,P2		;SAME?
	RET			;NO, NO-MATCH RETURN
	SOJG	T3,CSTB.1	;YES, TRY NEXT IF THERE IS A NEXT
	RETSKP			;ALL DONE, ALL MATCHED
	SUBTTL RSNTXT - Type Out Text for DECnet Reject Reason

;RSNTXT - Type Out Text for DECnet Reject Reason
;
;Call:	T1/ The Reason Code
;	CALL	RSNTXT
;	Normal Return


DEFINE RSNMAC(code,text),<
	CAIN	T1,code
	MOVEI	T2,[ASCIZ |code: text|]
>

RSNTXT::MOVEI	T2,0		;SO WE KNOW IF NO REASON HAS MATCHED

	RSNMAC RSNDBO,Disconnected/Rejected by Object
	RSNMAC RSNRES,No Resources
	RSNMAC RSNUNN,Unrecognized Node Name
	RSNMAC RSNRNS,Remote Node Shut Down
	RSNMAC RSNURO,Unrecognized Object
	RSNMAC RSNIOF,Invalid Object Name Format
	RSNMAC RSNOTB,Object Too Busy
	RSNMAC RSNABM,Abort by Management
	RSNMAC RSNABO,Abort by Object
	RSNMAC RSNINF,Invalid Node Name Format
	RSNMAC RSNLNS,Local Node Shut Down
	RSNMAC RSNACR,Access Control Rejection
	RSNMAC RSNRNO,No Response from Object
	RSNMAC RSNNUR,Node Unreachable
	RSNMAC RSNNLK,No Link
	RSNMAC RSNDSC,Disconnect Complete
	RSNMAC RSNIMG,Image Field Too Long

	JUMPE	T2,RSNT.1	;JUMP IF NO MATCH FOUND
	MOVE	T1,T2		;MOVE TO T1 FOR .TSTRG
	CALLSCAN .TSTRG##	;GOT A MATCH, TYPE OUT TEXT
	RET

RSNT.1:	PUSH	P,T1		;NO MATCH, TYPE OUT CODE IN DECIMAL
	MOVEI	T1,[ASCIZ /Unknown reason code: /]
	CALLSCAN .TSTRG##
	POP	P,T1
	CALLSCAN .TDECW##
	RET
	SUBTTL	Get Unwrapping Time

;GETTIM - Get Unwrapping time in Milliseconds
;
;Call:	CALL	GETTIM
;	Normal Return with time in T1


GETTIM::MSTIME	T1,		;GET MILLISECONDS SINCE MIDNIGHT
	CAMGE	T1,LASTIME	;WRAPPED AROUND?
	ADD	T1,[DEC 1000*60*60*24] ;MILLISECS IN A DAY
	MOVEM	T1,LASTIME	;STORE FOR NEXT TIME
	RET			;WITH TIME IN T1
	SUBTTL PSTATS - Print Statistics

;Called by DTS and by DTR after a DATA or INTERRUPT test.

;Call:	CALL PSTATS
;	Normal Return


PSTATS::SAVEAC	P1

	CALLSCAN .TCRLF##
	CALLSCAN .TTABC##
	MOVEI	T1,[ASCIZ /Test ran for /]
	CALLSCAN .TSTRG##
	MOVE	T1,ELPTIM	;GET ELAPSED TIME
	CALLSCAN .TDECW##
	MOVEI	T1,[ASCIZ / milliseconds/]
	CALLSCAN .TSTRG##
	CALLSCAN .TCRLF##

	CALLSCAN .TTABC##
	MOVE	T1,MSGSIZ	;GET MESSAGE SIZE
	CALLSCAN .TDECW##
	MOVEI	T1,[ASCIZ /	bytes per message, /]
	CALLSCAN .TSTRG##
	CALLSCAN .TCRLF##

	CALLSCAN .TCRLF##
	MOVEI	T1,[ASCIZ /Send statistics:/]
	CALLSCAN .TSTRG##
	CALLSCAN .TCRLF##
	MOVE	T1,SNDCNT	;LOAD UP # OF MSGS SENT
	MOVE	T2,SERRCNT	; AND # OF ERRORS SENDING THEM
	CALL	MSGSTS		;TYPE OUT SEND STATS

	CALLSCAN .TCRLF##
	MOVEI	T1,[ASCIZ /Receive statistics:/]
	CALLSCAN .TSTRG##
	CALLSCAN .TCRLF##
	MOVE	T1,RCVCNT	;LOAD UP # OF MSGS RECEIVED
	MOVE	T2,RERRCNT	; AND # OF ERRORS RECEIVING THEM
	CALL	MSGSTS		;TYPE OUT SEND STATS

	CALLSCAN .TCRLF##	;AN EXTRA CRLF
	RET
;Subroutine to type out received or sent stats

;Call:	T1/ SNDCNT or RCVCNT
;	T2/ SERRCNT or RERRCNT
;Return:
;	Non-skip only

MSGSTS:	SAVEAC <P1,P2>
	DMOVE P1,T1		;P1/ Message Count, P2/ Error Count
	CALLSCAN .TTABC##
	MOVE	T1,P1		;MESSAGE COUNT
	CALLSCAN .TDECW##
	MOVEI	T1,[ASCIZ /	messages (/]
	CALLSCAN .TSTRG##
	MOVE	T1,P2		;NUMBER OF ERRORS
	CALLSCAN .TDECW##
	MOVEI	T1,[ASCIZ / errors), /]
	CALLSCAN .TSTRG##

	MOVX	T1,^D1000	;MILLISECONDS
	IMUL	T1,P1		;GET # OF MSGS
	IDIV	T1,ELPTIM	;MAKE MSGS/SECOND OF ELAPSED TIME
	PUSH	P,T2		;SAVE REMAINDER
	CALLSCAN .TDECW##	;PRINT WHOLE-NUMBER PART
	MOVEI	T1,"."		;GET A DECIMAL POINT
	CALLSCAN .TCHAR##	;PRINT IT
	POP	P,T1		;GET REMAINDER BACK AGAIN
	IMULI	T1,^D100	;MAKE IT HUNDREDTHS
	IDIV	T1,ELPTIM	;CHANGE REMAINDER TO HUNDREDTHS
	MOVEI	T2,"0"		;FILL WITH ZERO
	CALLSCAN .TDEC2##	;TYPE 2-DIGIT REMAINDER WITH LEFT FILLER
	MOVEI	T1,[ASCIZ \ messages/second\]
	CALLSCAN .TSTRG##
	CALLSCAN .TCRLF##

	JUMPE	P1,CPOPJ	;LEAVE NOW IF NO MESSAGES COUNTED

;Characters per second and effective baud rate

	CALLSCAN .TTABC##
	MOVE	T1,P1		;NUMBER OF MESSAGES
	IMUL	T1,MSGSIZ	;TIMES THE MESSAGE SIZE = CHARS SENT
	IMULI	T1,^D1000	;SET TO DIVIDE BY MILLISECONDS
	IDIV	T1,ELPTIM	;DIVIDE BY MILLISECONDS ELAPSED
	MOVEI	P2,^D8		;MULTIPLY BY 8 FOR BITS/SEC ("BAUD")
	IMUL	P2,T1		;SAVE EFFECTIVE BAUD RATE
	CALLSCAN .TDECW##	;TYPE CHARS/SECOND
	MOVEI	T1,[ASCIZ \	characters/second\]
	CALLSCAN .TSTRG##
	CALLSCAN .TCRLF##

	CALLSCAN .TTABC##	;TYPE A TAB
	MOVE	T1,P2		;P2 NOW HAS EFFECTIVE BAUD RATE
	CALLSCAN .TDECW##	;TYPE OUT EFFECTIVE "BAUD" RATE
	MOVEI	T1,[ASCIZ \	effective baud rate = 8 * chars/sec\]
	CALLSCAN .TSTRG##
	CALLSCAN .TCRLF##

;Line efficiency if user declared an ideal baud rate
	SKIPG	BAUD		;GET USER-DECLARED BAUD RATE
	RET			;NO BAUD RATE, NO MORE TO SAY

	CALLSCAN .TTABC##	;TYPE A TAB
	MOVE	T1,P2		;GET EFFECTIVE BAUD RATE AGAIN
	IMULI	T1,^D100	;MAKE IT A PERCENT
	IDIV	T1,BAUD		;ACTUAL/THEORETICAL RATE = EFFICIENCY
	CALLSCAN .TDECW##	;TYPE CHARS/SECOND
	MOVEI	T1,[ASCIZ /%	line efficiency on a /]
	CALLSCAN .TSTRG##
	MOVE	T1,BAUD		;GET USER-DECLARED BAUD RATE
	CALLSCAN .TDECW##	;TYPE USER-DECLARED IDEAL BAUD RATE
	MOVEI	T1,[ASCIZ / baud line/]
	CALLSCAN .TSTRG##
	CALLSCAN .TCRLF##
	RET			;ONLY RETURN
	SUBTTL	Utility Routines

G::	PUSH	P,.JBOPC	;RETURN FROM DDT
	POPJ	P,		; WITHOUT TRASHING ACS

IFN FTEXTRA, OPDEF LL [CALL USLINK] ;FOR LL$X IN DDT
	SUBTTL USLINK - Type out the Port Block for a Link

IFN FTEXTRA,<

;This routine is expected to be called via the LINK command
;to DTS or by the CALL USLINK$X command to DDT, hence the huge
;SAVEAC call.


USLINK:	SAVEAC <CX,T1,T2,T3,T4,T5,T6,P1,P2,N,C,MB,MS,FREE1,FREE2>
	PROMPT <Link Number: >
	REDLIN .DECNW##		;GET DECIMAL NUMBER
	MOVE T1,N		;GET REQUESTED LINK NUMBER

	LOAD P1,QHBEG,+NSPAPQ##	;GET HEAD OF NSP'S ALL PORTS QUEUE
USLNK1:	JUMPE P1,USNOLINK	;TELL USER HE'S ASKED FOR BUM LINK
	OPSTR <CAMN T1,>,NPLLA,(P1) ;COMPARE WITH LOCAL LINK ADDRESS
	JRST USLNK2		    ;MATCH!
	LOAD P1,NPAPQ,(P1)	;NO MATCH, GET NEXT PORT BLOCK
	JRST USLNK1		;CHECK THIS NEXT ONE

USNOLINK:
	PROMPT <No such link address>
	CALLSCAN .TCRLF
	RET

>;END OF IFN FTEXTRA
IFN FTEXTRA,<

	EXTERN .TOCTW,.TXWDW,.TDECW,.TCHAR,.TCRLF,.TTABC


DEFINE TYPLNK(heading,symbol,typout,offset,text),<
	PROMPT <heading:	>
	LOAD T1,symbol,+offset(P1)
IFIDN <typout>,<OCT>,<	CALLSCAN TYPOCT>
IFDIF <typout>,<OCT>,<	CALLSCAN .TDECW
			MOVEI T1,"."
			CALLSCAN .TCHAR
                      >
	CALLSCAN .TTABC
	PROMPT(<;text>)
	CALLSCAN .TCRLF
>

DEFINE TYPLNQ(heading,symbol,offset,text),<
	TYPLNK heading+QHBEG,QHBEG,OCT,$'symbol+offset,<BEG PTR TO text>
	TYPLNK heading+QHEND,QHEND,OCT,$'symbol+offset,<END PTR TO text>
	TYPLNK heading+QHMAX,QHMAX,OCT,$'symbol+offset,<MAX COUNT OF text>
	TYPLNK heading+QHCNT,QHCNT,OCT,$'symbol+offset,<CUR COUNT OF text>
>

TYPOCT:	TLNN T1,-1		;ANYTHING IN THE LEFT HALF?
	CALLRET .TOCTW		;NO, TYPE OUT SIGNED OCTAL (SINGLE #)
	CALLRET .TXWDW		;YES, TYPE OUT 2 HALF-WORDS

>;END OF IFN FTEXTRA
IFN FTEXTRA,<

USLNK2:

TYPLNK NPAPQ,NPAPQ,OCT,0,<NEXT IN Q OF ALL PORT BLOCKS>
TYPLNK NPHBQ,NPHBQ,OCT,0,<NEXT IN Q OF PORTS IN A HASH BUCKET>
TYPLNK NPJFQ,NPJFQ,OCT,0,<NEXT IN Q OF PORTS NEEDING JIFFY SERVICE>
TYPLNK NPSNC,NPSNC,OCT,0,<SET IF NOT YET TOLD SC ABOUT NO CONF>
TYPLNK NPCNF,NPCNF,OCT,0,<SET IF WE HAVE CONFIDENCE IN LINK>
TYPLNK NPSCM,NPSCM,OCT,0,<SEND CONNECT MESSAGE NEXT JIFFY>
TYPLNK NPABO,NPABO,OCT,0,<ABORTING THIS LOGICAL LINK>
TYPLNK NPOJQ,NPOJQ,OCT,0,<PORT IS ON THE JIFFY-REQUEST QUEUE>
TYPLNK NPSTA,NPSTA,DEC,0,<NSP STATE OF THIS PORT>
TYPLNK NPVER,NPVER,DEC,0,<VERSION OF REMOTE NSP, 0=VER3.2,1=VER3.1>
TYPLNK NPSIZ,NPSIZ,DEC,0,<MAX SIZE OF A SEGMENT ON THIS LINK>
TYPLNK NPLLA,NPLLA,DEC,0,<LOCAL LINK ADDRESS>
TYPLNK NPRLA,NPRLA,DEC,0,<REMOTE LINK ADDRESS>
TYPLNK NPOTC,NPOTC,DEC,0,<COUNT OF MSGS OUT IN TRANSPORT>
TYPLNK NPDSG,NPDSG,DEC,0,<MSG SEGMENT BEING TIMED FOR DELAY CALC>
TYPLNK NPDTM,NPDTM,DEC,0,< AND TIME IT WAS FIRST SENT>
TYPLNK NPNNM,NPNNM,OCT,0,<THE REMOTE'S NODE NUMBER>
TYPLNK NPNDB,NPNDB,OCT,0,<PTR TO NSP NODE BLOCK>
TYPLNK NPTMA,NPTMA,DEC,0,<INACTIVITY TIMER>
TYPLNK NPSCV,NPSCV,OCT,0,<SCTL CALL VECTOR BASE ADDRESS>
TYPLNK NPSCB,NPSCB,OCT,0,<SESSION CONTROL BLOCK ID>
TYPLNK NPDIM,NPDIM,OCT,0,<PTR TO DI MESSAGE>
	CALLSCAN .TCRLF
PROMPT <The normal sublink block>
	CALLSCAN .TCRLF
TYPLNK NSOTH,NSOTH,OCT,NP.NSL,<SET IF THIS IS OTHER SUBLINK>
TYPLNK NSACK,NSACK,OCT,NP.NSL,<SEND ACK FOR THIS SUBLINK NEXT JIFFY>
TYPLNK NSROF,NSROF,OCT,NP.NSL,<RECEIVE IS OFF>
TYPLNK NSROC,NSROC,OCT,NP.NSL,<RECEIVE OFF HAS CHANGED>
TYPLNK NSXOF,NSXOF,OCT,NP.NSL,<XMIT IS OFF>
TYPLNK NSXOC,NSXOC,OCT,NP.NSL,<XMIT OFF HAS CHANGED>
TYPLNK NSRFL,NSRFL,DEC,NP.NSL,<RECEIVE FLOW CONTROL TYPE>
TYPLNK NSXFL,NSXFL,DEC,NP.NSL,<XMIT FLOW CONTROL TYPE>
TYPLNK NSGOL,NSGOL,DEC,NP.NSL,<DATA REQUEST GOAL>
TYPLNK NSCGL,NSCGL,DEC,NP.NSL,<AFTER-CONGESTION RECOVERY GOAL>
TYPLNK NSXLD,NSXLD,DEC,NP.NSL,<XMIT DRQS OUTSTANDING TO LOCAL SC>
TYPLNK NSXRD,NSXRD,DEC,NP.NSL,<XMIT DRQS OUTSTANDING TO REMOTE NSP>
TYPLNK NSXSD,NSXSD,DEC,NP.NSL,<XMIT DRQS NEED TO SEND TO SC>
TYPLNK NSRLD,NSRLD,DEC,NP.NSL,<RECEIVE DRQS OUTSTANDING TO LOCAL SC>
TYPLNK NSRRD,NSRRD,DEC,NP.NSL,<RECEIVE DRQS OUTSTANDING TO REMOTE NSP>
TYPLNK NSRSD,NSRSD,DEC,NP.NSL,<RECEIVE DRQS NEED TO SEND TO SC>
TYPLNK NSLMA,NSLMA,OCT,NP.NSL,<LAST MESSAGE NUMBER ASSIGNED>
TYPLNK NSLAR,NSLAR,OCT,NP.NSL,<LAST ACK RECEIVED (AND PROCESSED)>
TYPLNK NSLMR,NSLMR,OCT,NP.NSL,<LAST MESSAGE RECEIVED>
TYPLNQ NSAKQ,NSAKQ,NP.NSL,<TO-BE-ACKED Q>
TYPLNQ NSRCQ,NSRCQ,NP.NSL,<RECEIVE Q>
TYPLNQ NSXMQ,NSXMQ,NP.NSL,<XMIT Q>
	CALLSCAN .TCRLF
PROMPT <The other sublink block>
	CALLSCAN .TCRLF
TYPLNK NSOTH,NSOTH,OCT,NP.OSL,<SET IF THIS IS OTHER SUBLINK>
TYPLNK NSACK,NSACK,OCT,NP.OSL,<SEND ACK FOR THIS SUBLINK NEXT JIFFY>
TYPLNK NSROF,NSROF,OCT,NP.OSL,<RECEIVE IS OFF>
TYPLNK NSROC,NSROC,OCT,NP.OSL,<RECEIVE OFF HAS CHANGED>
TYPLNK NSXOF,NSXOF,OCT,NP.OSL,<XMIT IS OFF>
TYPLNK NSXOC,NSXOC,OCT,NP.OSL,<XMIT OFF HAS CHANGED>
TYPLNK NSRFL,NSRFL,DEC,NP.OSL,<RECEIVE FLOW CONTROL TYPE>
TYPLNK NSXFL,NSXFL,DEC,NP.OSL,<XMIT FLOW CONTROL TYPE>
TYPLNK NSGOL,NSGOL,DEC,NP.OSL,<DATA REQUEST GOAL>
TYPLNK NSCGL,NSCGL,DEC,NP.OSL,<AFTER-CONGESTION RECOVERY GOAL>
TYPLNK NSXLD,NSXLD,DEC,NP.OSL,<XMIT DRQS OUTSTANDING TO LOCAL SC>
TYPLNK NSXRD,NSXRD,DEC,NP.OSL,<XMIT DRQS OUTSTANDING TO REMOTE NSP>
TYPLNK NSXSD,NSXSD,DEC,NP.OSL,<XMIT DRQS NEED TO SEND TO SC>
TYPLNK NSRLD,NSRLD,DEC,NP.OSL,<RECEIVE DRQS OUTSTANDING TO LOCAL SC>
TYPLNK NSRRD,NSRRD,DEC,NP.OSL,<RECEIVE DRQS OUTSTANDING TO REMOTE NSP>
TYPLNK NSRSD,NSRSD,DEC,NP.OSL,<RECEIVE DRQS NEED TO SEND TO SC>
TYPLNK NSLMA,NSLMA,OCT,NP.OSL,<LAST MESSAGE NUMBER ASSIGNED>
TYPLNK NSLAR,NSLAR,OCT,NP.OSL,<LAST ACK RECEIVED (AND PROCESSED)>
TYPLNK NSLMR,NSLMR,OCT,NP.OSL,<LAST MESSAGE RECEIVED>
TYPLNQ NSAKQ,NSAKQ,NP.OSL,<TO-BE-ACKED Q>
TYPLNQ NSRCQ,NSRCQ,NP.OSL,<RECEIVE Q>
TYPLNQ NSXMQ,NSXMQ,NP.OSL,<XMIT Q>
	CALLSCAN .TCRLF
TYPLNK NPCHK,NPCHK,OCT,0,<ADDRESS OF THIS PB, FOR ADDR CHECK>

	RET

>;END OF IFN FTEXTRA
	SUBTTL	End of Library

	END