Google
 

Trailing-Edge - PDP-10 Archives - BB-BT99S-BB_1990 - 10,7/galaxy/operat/lcporn.mac
There are 13 other files named lcporn.mac in the archive. Click here to see a list.
IFNDEF FTSTANDALONE,<FTSTANDALONE==0>
	TITLE	LCPORN
	SUBTTL	Copyright

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1988, 1989.
;	ALL RIGHTS RESERVED.
;
;	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 THAT IS NOT SUPPLIED BY DIGITAL.

	SEARCH MACSYM
	SEARCH GLXMAC
	SEARCH ORNMAC
	PROLOG (LCPORN)
	.TEXT	"/LOCALS"
IF1,<
TOPS10 <PRINTX [Assembling TOPS-10 version of LCPORN]>
TOPS20 <PRINTX [Assembling TOPS-20 version of LCPORN]>
IFN FTSTANDALONE, <
	PRINTX [Standalone LCP]
>>

	EXTERN	LCPVRN

IFN FTSTANDALONE,<
	LOC 137
.JBVER::LCPVRN		;Version number from LCPTAB
	RELOC
>

	LS.ON==1	;LAT ON state
	LS.OFF==0	;LAT OFF state

	EXTERN P$SETU,P$KEYW,P$SWIT,P$QSTR,P$UQSTR,P$FLD,P$NUM
	EXTERN M%RPAG,M%GPAG
	EXTERN L$SHWM,P$NARG,P$TOK,P$COMMA
	EXTERN WTORTN,WTOPTR,OPRMES,MSGFIN,G$SND,SPDOPR

TOPS20 <
	DEFINE	$IACK(TEXT),<$TEXT (STOCHR,<TEXT' --^J>)>
>

TOPS10 <
IFE FTSTANDALONE,<
	STOCHR==WTORTN
>
IFN FTSTANDALONE,<
	DEFINE	$IACK(TEXT),<$TEXT (STOCHR,<TEXT' --^J>)>
>

	OPDEF ERJMP [JUMPA]

	DEFINE LATOP%,<LATOP. S1,>

	DEFINE .ERRT(A,B,C,MSG),<
TOPS10 <B==C>
TOPS20 <C==B>
	IFIW	[ASCIZ /MSG/]
>

ERRTAB:
	.ERRT (00,LATX01,LABTS%,<Buffer size too small for available data>)
	.ERRT (01,LATX02,LAVOR%,<LAT parameter value out of range>)
	.ERRT (02,LATX03,LALNO%,<LAT is not operational>)
	.ERRT (03,LATX04,LASVR%,<Invalid or unknown LAT server name>)
	.ERRT (04,LATX05,LAIPN%,<Invalid LAT parameter>)
	.ERRT (05,LATX06,LAIPV%,<Invalid LAT parameter value>)
	.ERRT (06,LATX07,LASVC%,<Invalid or unknown LAT service name>)
	.ERRT (07,LATX08,LAILR%,<Insufficient LAT Resources>)
	.ERRT (10,LATX09,LAHAS%,<LAT Host name already set>)
	.ERRT (11,ARGX02,LAIVF%,<Function code out of range>)
	.ERRT (12,ARGX04,LAABS%,<Argument list too small>)
	.ERRT (13,LATXAC,LAADC%,<Address check for argument list>)
	.ERRT (14,CAPX1,LAPRV%,<No privilege for attempted operation>)
	.ERRT (15,LATX10,LAPRT%,<Invalid or unknown LAT port name>)
	.ERRT (16,LATX11,LACID%,<Invalid or unknown LAT connect ID>)
	.ERRT (17,ARGX05,LAABL%,<Argument list too large>)
> ;END TOPS10

;LATREJ -- Table of rejection codes for LAT requests.
;Each entry in the table consists of three elements:
;	SYMB - Symbolic error value name
;	ABBR - Three-letter abbrieviation value
;	TEXT - Text message describing the error
	
	DEFINE	LATREJ,<
	RC (.LAUNK,<UNK>,<Unknown error>)
	RC (.LAURD,<URD>,<User requested disconnect>)
	RC (.LASSP,<SSP>,<System shutdown in progress>)
	RC (.LAISR,<ISR>,<Invalid slot received>)
	RC (.LAISC,<ISC>,<Invalid service class>)
	RC (.LAIRS,<IRS>,<Insufficient resources at server>)
	RC (.LASIU,<SIU>,<Service is in use>)
	RC (.LANSS,<NSS>,<No such service>)
	RC (.LASDI,<SDI>,<Service is disabled>)
	RC (.LASNP,<SNP>,<Service not offered by requested port>)
	RC (.LANSP,<NSP>,<No such port name>)
	RC (.LAIPW,<IPW>,<Invalid password>)
	RC (.LAENQ,<ENQ>,<Entry is not in the queue>)
	RC (.LAIAR,<IAR>,<Immediate access rejected>)
	RC (.LAACD,<ACD>,<Access denied>)
	RC (.LACSR,<CSR>,<Corrupted solicit request>)
	RC (.LACTI,<CTI>,<Command type code is illegal>)
	RC (.LASCS,<SCS>,<Start slot can't be sent>)
	RC (.LAQED,<QED>,<Queue entry deleted by local node>)
	RC (.LAIRP,<IRP>,<Inconsistent or illegal request parameters>)
>;END DEFINE LATREJ

;LATSTS -- Table of status codes for LAT requests.  These codes are
;returned by the Monitor, rather than being sent by the LAT server.
;Each entry in the table consists of three elements:
;	SYMB - Symbolic error value name
;	ABBR - Three-letter abbrieviation value
;	TEXT - Text message describing the error

	DEFINE LATSTS,<
	RC (.LASOL,<SOL>,<Currently soliciting request>)
	RC (.LAQUE,<QUE>,<Request is in the queue>)
	RC (.LACAN,<CAN>,<Request has been cancelled>)
	RC (.LATMO,<TMO>,<Request has timed out>)
>
	minsts==.latmo
	maxsts==.lasol

;Define the lists of values
	DEFINE	RC(SYMB,ABBR,TEXT),<
	EXP SYMB
>
REJTAB:	LATREJ			;The reject codes
	RJTSIZ==.-REJTAB

STSTAB:	LATSTS			;The status codes
	STTSIZ==.-STSTAB

;Define the lists of abbrieviations
	DEFINE 	RC(SYMB,ABBR,TEXT),<
		SIXBIT/'ABBR/
>
REJABB:	LATREJ
	RJASIZ==.-REJABB

STSABB:	LATSTS
	STAABB==.-STSABB

;Define the text strings
	DEFINE	RC(SYMB,ABBR,TEXT),<
		[ASCIZ /'TEXT/]
>

REJSTR:	LATREJ
	RJSSIZ==.-REJSTR

STSSTR:	LATSTS
	STSSIZ==.-STSSTR


MOSAV:	BLOCK	1
ANYSET:	BLOCK	1

BEGSTR	TC
	WORD NUM		;Number of terminal
	HWORD SNC		;Server name count
	HWORD TYP		;Port Type
	WORD NAM,^D4		;Server name string (16 chars max)
	HWORD PNC		;Port Name count
	HWORD SVC		;Service Name count
	WORD PNM,^D4		;Port Name (16 chars max)
	WORD SNM,^D4		;Service Name (16 chars max)
ENDSTR

BEGSTR	CH
	HWORD MXC		;Maximum allocatable circuit blocks
	HWORD NCC		;Number of currently allocated circuit blocks
	HWORD MAC		;Maximum number of active circuits
	HWORD NAC		;Number of currently active circuits
	HWORD MCO		;Maximum number of simultaneous connects
	HWORD CON		;Current number of active connects
	HWORD NUM		;Host number
	HWORD LAS		;LAT access state
	HWORD RLI		;Virtual circuit message retransmit limit
	HWORD TIM		;Virtual circuit timer initial value (sec)
	HWORD MTI		;Multicast timer initial value (sec)
	FILLER ^D18
	HWORD HPV		;High protocol version
	HWORD LPV		;Low protocol version
	HWORD ECO		;Current protocol ECO
	HWORD PRO		;Current protocol version
	HWORD MSI		;Maximum slot size
	HWORD MSL		;Maximum slots
	HWORD RFS		;Receive frame size
	HWORD MSV		;Maximum services
	HWORD PID		;Product ID
	FILLER ^D18
	WORD GRP,^D8		;Group codes
	HWORD NMC		;Host node name count
	HWORD IDC		;Host identification string count
	WORD NAM,2		;Host node name string
	WORD ID,^D13		;Host identification string
	WORD NSV		;Number of services.
	WORD SRV,<SB.LEN>	;Storage for service blocks
	
ENDSTR

BEGSTR	SB			;SERVICE BLOCK
	WORD RAT		;Service Rating.
	HWORD NC		;Count of bytes in service name.
	HWORD LC		;Count of bytes in service description
	WORD NAM,4		;Storage for up to 16 bytes of service name.
	WORD HID,^D13		;Storage for up to 64 bytes of service id.
ENDSTR



BEGSTR	SV
	WORD DNI,2		;NI address of remote server
	HWORD MTF		;Maximum transmit frame size for circuit
	HWORD RPV		;Remote protocol version and ECO
	HWORD MSL		;Maximum slots allowed by remote
	HWORD NBF		;Additional transmit buffers allowed by remote
	HWORD CTI		;Value of remote's circuit timer
	HWORD KTI		;Value of remote's keep-alive timer
	FIELD SVS,<^D18-^D8>	;Server specific product type byte
	FIELD PTC,^D8		;Product type code for remote node
	HWORD STA		;Virtual circuit state
	HWORD NUM		;Remote's system number
	HWORD RSC		;Remote's system name count
	HWORD RLC		;Remote's location text count
	WORD SNM,^D4		;Remote's system name
	WORD LOC,^D13		;Remote's location string	
ENDSTR

BEGSTR	SM
	HWORD NUM		;Remote's system number
	HWORD RSC		;Remote's system name count
	WORD SNM,^D4		;Remote's system name
	WORD DNI,2		;NI address of remote server
ENDSTR

;Structure returned when the .LASHC function is called to show host-initiated
;connects:

BEGSTR	HC
	HWORD JOB		;Job number
	HWORD CID		;Connect ID
	HWORD STS		;Connect status
	HWORD QDP		;Queue depth
	HWORD SRC		;Server_name character count
	HWORD PTC		;Port_name count
	WORD SRN,^D4		;Server_name (4 words)
	WORD PTN,^D4		;Port_name (4 words)
	HWORD SVC		;Service_Name count
	WORD SVN,^D4		;Service_Name (4 words)
ENDSTR
	HC.SIZ==^D16		;Size of above block

;Flags used to indicate various things...
	FL.SHC==1B0		;Lit=show All Host Connects; Off=Pending Only
	FL.HEA==1B1		;Lit to indicate that a header was generated
;The following flags indicate that various states were found.  If a flag
;is lit, the wrapup code must display the correct legends to explain the
;'status' field in the SHOW PENDING-CONNECTS/HOST-INITIATED CONNECTS commands.
	FL.ACT==1B2		;An active connect was found.
	FL.SOL==1B3		;A 'soliciting' request was found.
	FL.QUE==1B4		;A 'queued' request was found.
	FL.CAN==1B5		;A 'canceled' request was found.
	FL.TMO==1B6		;A 'timed-out' request was found.
	FL.REJ==1B7		;A 'rejected' request was found.
	FL.NPR==1B8		;No pending requests have been found.

CONCNT:	BLOCK 1			;Count of connections found
REJCNT:	BLOCK 1			;Count of rejected connections
REJCOD:	BLOCK ^D512/HC.SIZ	;Holder for rejection codes for requests


DEFINE ..MIN (LIST) <
	..X=377777
	DEFINE ..MN (M,A) <IRP A, <IFG <M-A>,<M=A>
				STOPI>>
	IRP LIST,<..MN(..X,LIST)
	          STOPI>
	IRP LIST,<..MN(..X,LIST)>
	.MIN=..X
	>

DEFINE ..MAX (LIST) <
	..X=0
	DEFINE ..MX (M,A) <IRP A, <IFL <M-A>,<M=A>
				STOPI>>
	IRP LIST,<..MX(..X,LIST)
	          STOPI>
	IRP LIST,<..MX(..X,LIST)>
	.MAX=..X
	>

DEFINE SEDSP. (TABLE,LIST) <
	..MIN(LIST)
	..MAX(LIST)
	SETTBL==.-.MIN
	 BLOCK <.MAX-.MIN+1>

DEFINE .LNTRY (ELIST) <
	IRP ELIST,<.AAA(ELIST)>
	>
DEFINE .AAA (C,D) <.ENTRY (C,D)>
DEFINE .ENTRY (A,B) <
	.ORG <TABLE +A>
	EXP B
	.ORG
	>
	.LNTRY (LIST)	>


	SEDSP. (SETTBL,<<<.LPMAC,SNUMBR>,<.LPMCO,SNUMBR>,<.LPNUM,SNUMBR>,<.LPLAS,SNUMBR>,<.LPRLI,SNUMBR>,<.LPTIM,SNUMBR>,<.LPMTI,SNUMBR>,<.LPCOD,SGROUP>,<.LPNNM,SNNAME>,<.LPNID,SNODID>,<.LPSRV,SERVC>>>)




PIDTYP:	[ASCIZ	/Undefined/]			;0
	[ASCIZ	/Ethernet Terminal Server/]	;1
	[ASCIZ	/DECserver 100/]		;2
	[ASCIZ	*VAX/VMS*]			;3
	[ASCIZ	/RSX11-M/]			;4
	[ASCIZ	/RSX11-M+/]			;5
	[ASCIZ	/TOPS-20/]			;6
	[ASCIZ	/TOPS-10/]			;7
	[ASCIZ	/ULTRIX-11/]			;8
	[ASCIZ	/LAT-11/]			;9
	[ASCIZ	*RSTS/E*]			;10
	[ASCIZ	*ULTRIX-32*]			;11
	[ASCIZ	*ELN*]				;12
	[ASCIZ	*MS/DOS*]			;13
	[ASCIZ	*P/OS*]				;14
	[ASCIZ	*PCSG-LAT*]			;15
	[ASCIZ	*DELIX*]			;16
	[ASCIZ	*DECserver 200*]		;17
	[ASCIZ	*DECserver 500*]		;18
	[ASCIZ	*Actor*]			;19
NPIDS=.-PIDTYP-1

	SUBTTL	LCP Initialization

LCPORN::
IFN FTSTANDALONE!FTJSYS,<
	SETZM	WTOPTR		;Reset output message byte pointer.
	$CALL	LCPOR1		;Call work routine.
	SKIPN	S1,WTOPTR	;Did we want to output anything?
	$RET			;No. Return to ORION and pass along status
	PUSH	P,TF		;Save flag from LCPOR1
	MOVE	MO,MOSAV	;Restore pointer to output message
	$CALL	MSGFIN		;Finish the message
	$CALL	L$SHWM		;Log the message
	MOVE	S1,G$SND	;Get senders PID
	MOVEI	S2,PAGSIZ	;Page message
	$CALL	SPDOPR		;Send to OPR
	POP	P,TF		;Restore original flag
	$RET			;and return
>; END IFN FTSTANDALONE

LCPOR1:
TOPS10<
	MOVEI	S1,S2		;Point to psuedo-LATOP block
	SETZ	S2,		;Invalidate length word
	LATOP.	S1,		;Try it -- better fail!
	 CAIE	S1,LAADC%	;Did we get correct error return?
	  JRST	LCPOR2		;No -- reject the command
>	
	MOVE	S2,COM.PB(MI)	;Was parser block filled in
	ADDI	S2,(MI)		;Point PB at the block
	MOVE	S1,S2		;Get the block pointer
	$CALL	P$SETU		;Setup the pointer
	$CALL P$KEYW		;Get the first keyword
	$RETIF			;Should not happen
	$CALL .SAVET		;Give workers room
	PJRST @CMDDSP(S1)	;Go dispatch to process command

TOPS10<
LCPOR2:	$IACK	(LCP commands unavailable - no monitor LAT support)
	$RETT

>;end TOPS10
	SUBTTL	SET/CLEAR Commands

SETCMD:	$CALL P$KEYW		;Get the parameter to be cleared
	  $RETIF
	TRNN S1,400000		;Was it a 2 word command?
	JRST SETCM1		;No, normal SET
;
;	Here if the guy typed "SET MAXIMUM xxx" or "SET RETRANS xxx"
;	Parse the next keyword to see what he wants to SET
;
	$CALL P$KEYW
	  $RETIF
SETCM1:	MOVEI T1,.LAPRM+1	;Basic SET argblk length
	MOVEM T1,ARGBLK+.LAACT	;Store as argument block count
	MOVEI T1,.LASET		;Put the SET function code
	MOVEM T1,ARGBLK+.LAFCN	; into the argument block too.
	MOVEM S1,ARGBLK+.LAPRM	;Parameter to set.
	$CALL @SETTBL(S1)	;Call the proper routine
	  $RETIF
	MOVEI S1,ARGBLK		;Address of JSYS argument block
	LATOP%			;Do the JSYS
	  ERJMP JSYSER		;JSYS failed
	$IACK	(Set Accepted)
	$RETT			;Return success.

CLRCMD:	$CALL P$KEYW		;Get the parameter to be cleared
	  $RETIF
	TRNN S1,400000		;Was it a 2 word command?
	JRST CLRCM1		;No, just normal
;
;	Here if the guy typed "CLEAR MAXIMUM xxx" or "CLEAR RETRANS xxx"
;	Parse the next keyword to see what he wants to clear
;
	$CALL P$KEYW
	  $RETIF
CLRCM1:	MOVEI T1,.LAPRM+1	;Basic CLEAR argblk length
	MOVEM T1,ARGBLK+.LAACT	;Store as argument block count
	MOVEI T1,.LACLR		;Put the CLEAR function code
	MOVEM T1,ARGBLK+.LAFCN	; into the argument block too.
	MOVEM S1,ARGBLK+.LAPRM	;Parameter to clear.
	CAIE S1,.LPSRV		;If clearing a service,
	IFSKP.			; we need the service name.
	  $CALL PAFLD		;Get the parsed name field.
	   $RETIF		; return error
	  MOVEM S1,ARGBLK+.LAVAL ;Put ASCIZ string pointer to it in argument
	  AOS ARGBLK+.LAACT	;Increment argument block count
	ENDIF.
	CAIE S1,.LPCOD		;If clearing group codes
	IFSKP.			; we need the group mask.
	  $CALL SGROUP		;Go build it.
	   $RETIF
	ENDIF.
	MOVEI S1,ARGBLK		;Address of the arg block
	LATOP%			;Do the JSYS
	  ERJMP JSYSER		;JSYS failed
	$IACK	(Clear Accepted)
	$RETT			;Return success.

	SUBTTL	SET/CLEAR Commands -- SET function code specific routines

;SNUMBR - For SET commands which set a single numeric value to a single
;  parameter

SNUMBR:	$CALL P$NUM		;Get the parameter value to set
	  $RETIF
	MOVEM S1,ARGBLK+.LAVAL	;Put into the argument block
	AOS ARGBLK+.LAACT	;Increment argument block count
	$RETT			;That's all to do.



;SNODID - Set Host node identification string

SNODID:	$CALL PAFLD		;Get pointer to parsed node id string
	  $RETIF
	MOVEM S1,ARGBLK+.LAVAL	;Put ASCIZ pointer to ID string in arg block
	AOS ARGBLK+.LAACT	;Increment argument block count
	$RETT			;Done successfully

SNNAME:	MOVEI S1,LATX09		;Node name already set (should never get here)
	$RETF			;Never set node name with LCP


	SUBTTL	SET/CLEAR Commands -- SET/CLEAR GROUPS

SGROUP:	$SAVE <P1,P2>
	MOVE T1,[STRNGZ,,STRNGZ+1];Clear out buffer for group mask
	SETZM STRNGZ		; ...
	BLT T1,STRNGZ+7		; ...
SGROU0:	$CALL P$NUM		;Next arg must be a number
	 $RETIF		;Error if not.
	MOVE P1,S1		;Save the number parsed as lower range element
	MOVE P2,S1		; and upper range element too.
	$CALL P$NARG		;Look at next argument
	 JUMPF NOARG		;Must be one.
	CAIE S1,.CMTOK		;A token
	IFSKP.
	  CALL P$TOK		;Read the token
	  MOVSI T1,440700	;Pointer to token parsed.
	  HRRI T1,1(S1)		; ...
	  ILDB T2,T1		;Get token
	  CAIE T2,":"		;Is it a colon?
	  JRST [$TEXT (STOCHR,<?Invalid range specified>) ;Only token allowed.
		$RETF]
	  CALL P$NUM		;Yes, next must be number
	   $RETIF		;Error
	  CAMG S1,P1		;Greater than lower bound?
	  IFSKP.
	    MOVE P2,S1		;Yes, it is the upper bound
	  ELSE.
	    MOVE P1,S1		;No, it is the lower bound
	  ENDIF.
	  CALL P$NARG		;Get next argument
	   JUMPF NOARG	
	ENDIF.
	CAIE S1,.CMCMA		;A comma?
	IFSKP.
	  $CALL P$COMMA		;
	  SKIPA
	ENDIF.
	CAIN S1,.CMCFM		; or CRLF?
	$CALL SETCOD		;(P1,P2) Yes set the bits so far.
	CAIE S1,.CMCFM
	JRST SGROU0		;Next
	MOVEI T1,STRNGZ
	MOVEM T1,ARGBLK+.LAVAL
	AOS ARGBLK+.LAACT
	$RETT

NOARG:	$TEXT (STOCHR,<Invalid SYNTAX, Parser confused>)
	$RETF



;SETCOD - Set up the group code mask for setting/clearing of group codes.
;Call:	P1/ Lower code in range of codes
;	P2/ Upper code in range of codes
;RET	Always

SETCOD:	MOVE T2,P2		;Upper bound of range
	SUB T2,P1		;Compute number of bits
	AOS T2			; in range.
	MOVE T1,P1		;First in range.
SETCD0:	$CALL SETBIT		;Set the bit in the mask
	SOJLE T2,.RETT		;If count exhausted, done.
	AOJA T1,SETCD0		;Increment next number in range.
		
;SETBIT - Set bit in 8 word 256 bit mask corresponding to group
;Call:	T1/ Group number

SETBIT:	$SAVE <T1,T2>		;T1-T2 must be returned intact.
	IDIVI T1,^D32		;T1/T2 Word/Bit in word
	MOVEI T3,1		;Set up bit to rotate
	MOVNS T2		;Will rotate right
	ROT T3,-1(T2)	;Rotate to proper bit position
	IORM T3,STRNGZ(T1);Set the bit in proper group code word.
	RET

;SERVC - Set Host Services

SERVC:	$CALL PAFLD		;Get pointer to service name
	  $RETIF
	MOVEM S1,ARGBLK+.LAVAL	;Put ASCIZ pointer to service name in arg block
	SETZM ARGBLK+.LAQUA	;Init the two extra args to 0
	SETZM ARGBLK+.LADSC
	MOVEI S1,.LADSC+1	;and adjust arg count
	MOVEM S1,ARGBLK+.LAACT
SERVSW:	$CALL P$SWIT		;Get a switch
	  JUMPF SRVEOL		;Not a switch, check for end-of-line
	JUMPE S1,SRVRAT		;Switch was /RATING:
	$CALL P$QSTR		;Switch was /IDENTIFICATION:
	   $RETIF	;
SRVID:	HRROI S1,1(S1)		;Make proper ASCIZ pointer to text
	MOVEM S1,ARGBLK+.LADSC	; ...
	MOVX T1,LA%DSC		;Indicate Id being set
	IORM T1,ARGBLK+.LAQUA	; ...
	JRST SERVSW		;Check for more switches
SRVRAT:	$CALL P$NUM		;Numeric rating specified?
	SKIPT 			;Yes
	MOVEI S1,-1		;No, dynamic so set -1
SRVRNU:	MOVX T1,LA%RAT		;Indicate rating being changed
	IORM T1,ARGBLK+.LAQUA	;
	HRRM S1,ARGBLK+.LAQUA	;Stuff new rating in ARGBLK
	JRST SERVSW		;Check for more switches	
SRVEOL:
	$RETT			;Done

	SUBTTL	SHOW Commands -- SHOW CHARACTERISTICS

SHWCMD:	$CALL P$KEYW		;See what he wants to SHOW
	  $RETIF
	MOVEI T1,.LABFA+1	;Basic SHOW argblk length
	MOVEM T1,ARGBLK+.LAACT	;Store as argument block count
	PJRST @SHWDSP(S1)	;Go dispatch to process command
		
SHWCHA:	MOVEI T1,.LASCH		;Show host characteristics
	MOVEM T1,ARGBLK+.LAFCN
	$CALL GPAG		;Get a page for characteristics
	MOVEI T1,^D512		;Length
	MOVEM T1,ARGBLK+.LABCT	;Store in argument block
	MOVEM S1,ARGBLK+.LABFA	;Store buffer address in arg block
	MOVE P1,S1		;Save for below.
	MOVEI S1,ARGBLK		;Argument block address of JSYS
	LATOP%
	  ERJMP JSYSER
	$IACK	(Host Characteristics)
	LOAD T2,CHLAS,(P1)	;Get the LAT Access state.
	$TEXT (STOCHR,<LAT Access State: ^5/LSTATE(T2)/>)
	LOAD T1,CHNMC,(P1)	;Get the host name count
	MOVEI T2,CH.NAM(P1)	;Address of string.
	$CALL MAKAZ
	$TEXT (STOCHR,<Host Name: ^T/STRNGZ/>)
	LOAD T1,CHIDC,(P1)
	MOVEI T2,CH.ID(P1)
	$CALL MAKAZ
	$TEXT (STOCHR,<Host id: ^T/STRNGZ/>)
	LOAD T1,CHNUM,(P1)
	$TEXT (STOCHR,<Host number: ^D/T1/>)
	LOAD T1,CHRLI,(P1)
	$TEXT (STOCHR,<Retransmit Limit: ^D/T1/>)
	LOAD T1,CHTIM,(P1)
	$TEXT (STOCHR,<Retransmit Timer: ^D/T1/>)
	LOAD T1,CHMTI,(P1)
	$TEXT (STOCHR,<Multicast Timer: ^D/T1/>)
	$CALL GRPDPY		;Show groups which are enabled
	$TEXT	(STOCHR,<
                     Current   Maximum
                     -------   ------->)
	LOAD	T1,CHNCC,(P1)		;CURRENT
	LOAD	T2,CHMXC,(P1)		;MAXIMUM
	$TEXT	(STOCHR,<Allocated circuits   ^D5R/T1/     ^D5R/T2/>)
	LOAD	T1,CHNAC,(P1)		;CURRENT
	LOAD	T2,CHMAC,(P1)		;MAXIMUM
	$TEXT	(STOCHR,<Active circuits      ^D5R/T1/     ^D5R/T2/>)
	LOAD	T1,CHCON,(P1)		;CURRENT
	LOAD	T2,CHMCO,(P1)		;MAXIMUM
	$TEXT	(STOCHR,<Sessions             ^D5R/T1/     ^D5R/T2/>)

	$CALL OSERVC		;Show data for all service names
	$RETT

;
;GRPDPY - Routine to display all group codes which are enabled
;
GRPDPY:	$SAVE <P1,P2,P3,P4>
	$TEXT (STOCHR,<Groups: ^A>)	;Display header
	SETOM ANYSET		;Initialize "first-group-seen" flag
	MOVEI P4,CH.GRP(P1)	;Point at first word of group codes
	MOVE P3,(P4)		;and get first word of group codes
	SETZB P1,P2		;Zero the group counters
GRPNXT:	SETO T1,		;Clear flag to say we are looking for first 1
	$CALL GRPFND		;Find first range of groups
	JUMPF GRPDON		;Finished
	$CALL PRIRNG		;Found a range, output it
	JRST GRPNXT		;and go for next range
GRPDON:	SKIPGE ANYSET		;Any groups set?
	  $TEXT (STOCHR,<None defined>)
	$TEXT (STOCHR,<^M>)
	$RETT

;
;	Here when it's time to get a new word full of group codes
;
NEWWRD:	SETZ P1,		;No bits done in new word yet
	ADDI P2,40		;Increment group number to new bunch
	TRZ P2,37		;Force to a 32 bit boundary
	CAIGE P2,^D256		;Have we hit group 256 yet?
	JRST NEWWR1		;No, proceed normally
	CAIG P2,^D256		;Have we gone past 256 already?
	SKIPGE T1		;or not accumulating 1s now?
	$RETF			;Yes to either, done.
;
; Here when we hit the end of the bits while we were accumulating 1s
;
	SETZ	P3,		;Zero the latest word of bits so next
				;call to GRPFND will fail the JFFO and will
	$RETT			;go to NEWWRD, and will get RETF there.

NEWWR1:	ADDI	P4,1		;Point to next word of group codes
	MOVE	P3,(P4)		;Get the codes
GRPFND:	MOVE	S1,P3		;Copy the current word of group codes
	SKIPL	T1		;Are we looking for 0s ?
	SETCA	S1,		;Yes, make 0s into 1s so JFFO finds them
	JFFO	S1,.+2		;Find next group of 1s
	JRST	NEWWRD		;No more in this word, go for next
	ADD	P1,S2		;Count number of bit places in current word
	TRNE	P1,777740	;Have we done more than 32 ?
	JRST	NEWWRD		;Yes, time for a new word
	ADD	P2,S2		;Still in same word, count bits we skipped
	LSH	P3,(S2)		;and skip over zeroes
				;If we had already marked the start of a group,
	JUMPGE	T1,.RETT	; then we just found the end, so return.
	MOVE	T1,P2		;Otherwise, mark the start of a group of 1s
	JRST	GRPFND		; and proceed to find the end

PRIRNG:	AOSE ANYSET		;Have we already printed some group?
	  $TEXT (STOCHR,<,^A>)	;Yes, separate previous group with a comma
	$TEXT (STOCHR,<^D/T1/^A>)	;Lower group in range
	MOVEI T2,-1(P2)		;Calculate last bit of group.
	CAME T2,T1		;Upper and lower group same?
	  $TEXT (STOCHR,<:^D/T2/^A>)	;No, output upper also
	$RETT

OSERVC:	$SAVE <P2,P3>
	OPSTR <SKIPN P3,>,CHNSV,(P1);Get the number of services
	$RETT			;There are none.	
	MOVEI P2,CH.SRV(P1)	;Start of service blocks
	$TEXT	(STOCHR,<
    Service Name       Rating        Identification
--------------------   ------   ------------------------>)
NEXTSB:	LOAD	T1,SBNC,(P2)	;Service name count
	MOVEI	T2,SB.NAM(P2)	;Address of service name
	PUSHJ	P,MAKAZ		;Make an ASCIZ string
	$TEXT	(STOCHR,<^T20L/STRNGZ/   ^A>)
	MOVEI	T2,[ITEXT (<  D   >)] ;Assume unknown
	OPSTR	<SKIPL	T1,>,SBRAT,(P2) ;Get the rating
	MOVEI	T2,[ITEXT (<^D6C/T1/>)] ;Known rating
	$TEXT	(STOCHR,<^I/(T2)/^A>)
	LOAD	T1,SBLC,(P2)	;Service Id count
	JUMPE	T1,OSRVCE
	MOVEI	T2,SB.HID(P2)	;Service description address
	PUSHJ	P,MAKAZ		;Make ASCIZ string
	$TEXT	(STOCHR,<   ^T/STRNGZ/>)
OSRVCE:	SOSG P3
	$RETT			;All services output
	ADDI P2,SB.LEN		;Advance to next service
	JRST NEXTSB

	SUBTTL	SHOW Commands -- SHOW SESSIONS

SHWSES:	SETZM T4		;Clear Host-Initiated flag
	MOVEI T1,.LASTC		;SHOW SESSIONS function
	MOVEM T1,ARGBLK+.LAFCN
	MOVEI T1,.LABFA+1
	MOVEM T1,ARGBLK+.LAACT	;Arg block size
	$CALL GPAG		;Get a page for the info
	MOVE P1,S1		;Save address of buffer for later
	MOVEI T1,^D512		;Length of a page
TOPS10 <
	TXO T1,LA.ECB		;We want extended connect blocks
>
TOPS20 <
	TXO T1,LA%ECB		;We want extended connect blocks
>
	MOVEM T1,ARGBLK+.LABCT	;Save block size in arg block
	MOVEM S1,ARGBLK+.LABFA	;Save buffer address in arg block
	XMOVEI S1,ARGBLK	;ARGBLK address for JSYS
	LATOP%			;Do it
	  ERJMP JSYSER		;Couldn't
	HLRZ T3,ARGBLK+.LABCT	;Find out how many words we got
	JUMPE T3,SHWSE4		;If zero, there are no such terminals
	IDIVI T3,TC.LEN		;Calculate how many terminals that is
	JUMPN T4,SHWSEE		;If there's a remainder something's wrong
	MOVE P2,T3		;Put count into P2 for looping
	$IACK	(Active LAT Sessions)
	$TEXT	(STOCHR,<Job Line Program   Server Name       Port Name             User>)
	$TEXT	(STOCHR,<--- ---- ------- ---------------- ---------------- -------------------->)

SHWSE1:
TOPS20 <
	LOAD T2,TCNUM,(P1)	;Get terminal number
	MOVEI S1,400000(T2)	;400000+TTY
	MOVE S2,[-<.JIPNM+1>,,STRNGZ]; <argblk length,,argblk address>
	MOVEI T1,.JIJNO	;First symbol in job info to get (JOB#)
	GETJI
	 JRST SHWSE2		;Error, assume no job
	LOAD T1,TCTYP,(P1)	;Get the connection type
	MOVEI T3," "		;Assume it's not reverse lat connection
	CAIE T1,.LAAPP		;Is it an application?
	IFSKP.
	  MOVEI T3,"*"		;It is a reverse lat connection
	  SETOM T4		;Flag it
	ENDIF.
	SKIPGE STRNGZ+.JIJNO	;Is there a job number?
	 JRST SHWSE2		;No job...
	HRRZS T1,STRNGZ+.JIJNO	;Isolate the job number
	MOVE S1,[POINT 7,<STRNGZ+.JIPNM+1>];Pointer for user name string
	MOVE S2,STRNGZ+.JIUNO	;Job's user number
	DIRST
	 SETZM <STRNGZ+.JIPNM+1>;Error, no user name
	$TEXT (STOCHR,<^D3/STRNGZ+.JIJNO/  ^O3/T2/ ^W7/STRNGZ+.JIPNM/ ^T16/TC.NAM(P1)/^7/T3/^T16/TC.PNM(P1)/ ^T/STRNGZ+.JIPNM+1/>)
	JRST SHWSE3
SHWSE2:
	$TEXT (STOCHR,< -   ^O3/T2/         ^T16/TC.NAM(P1)/^7/T3/^T16/TC.PNM(P1)/>)
	;Fall into SHWSE3
> ;END TOPS20

TOPS10 <
	LOAD T1,TCSNC,(P1)	;Get name count
	MOVEI T2,TC.NAM(P1)	;Point to name string
	$CALL MAKAZ		;MAKE IT AN ASCIZ STRING

	LOAD T1,TCNUM,(P1)	;get terminal number
	MOVEI T2,.UXTRM(T1)	;convert to udx
	MOVE S1,T2		;Make another copy
	DEVTYP S1,		;Get job number in a strange way
	  SETZ S1,		;Bad, pretend 0
	LDB S1,[POINT 9,S1,26]	;ISOLATE JOB NUMBER
	IFE. S1,
	  $TEXT (STOCHR,< -  ^O3/T1/  ^A>) ;No job number, T1 contains line #
	ELSE.
	  $TEXT (STOCHR,<^D3/S1/ ^O3/T1/  ^A>) ;Write the job number, line #
	ENDIF.

	DEVCHR T2,		;See what kind of device this is.
	TLNN T2,(DV.TTA)	;Is this a controlling terminal?
	 JRST SHWSE2		;No
	HRLZ T3,S1		;Job Number in left half
	HRRI T3,.GTPRG		;.GTPRG in right half
	GETTAB T3,		;Get program name
SHWSE2:	 SETZ T3,		;Oh well...
	MOVEI T2," "		;Default to standard TTY
	LOAD T1,TCTYP,(P1)	;Get the port type
	CAIE T1,.LAAPP		;Is it an application
	IFSKP.
	  MOVEI T2,"*"		;Yes
	  SETOM T4		;Flag it
	ENDIF.

	$TEXT (STOCHR,<^W6/T3/  ^T16/STRNGZ/^7/T2/^A>) ;Write prog & servername

	LOAD T1,TCPNC,(P1)	;Get the port count
	MOVEI T2,TC.PNM(P1)	;Get the address
	$CALL MAKAZ		;Make it an ASCIZ string

	HRLZ T1,S1		;Job Number in left half (again)
	HRRI T1,.GTPPN		;.GTPPN in right half
	GETTAB T1,		;Get PPN
	  SETZ T1,		;Oh well...
	HRLZ T2,S1		;Get our saved job number
	HRRI T2,.GTNM1		;Set up for gettab
	GETTAB T2,		;Get LH of user name
	 SETZ T2,		;Couldn't
	HRLZ T3,S1		;Get job number again
	HRRI T3,.GTNM2		;Set up for gettab
	GETTAB T3,		;Get RH of user name
	 SETZ T3,		;Couldn't

	$TEXT (STOCHR,<^T16/STRNGZ/ ^W/T2/^W/T3/ ^P/T1/>)
;	JRST SHWSE3
> ;END TOPS10

SHWSE3:	ADDI P1,TC.LEN
	SOJG P2,SHWSE1
	SKIPGE T4
	$TEXT (STOCHR,< * denotes an application terminal>)
	SETZM T4
	$RETT
SHWSE4:	$IACK	(No LAT Sessions Active)
	$RETT
	
SHWSEE: MOVEI T1,HC.SIZ		;Get the intended size
TOPS10 <
	$IACK (LATOP. UUO Error)
>
TOPS20 <
	$IACK (LATOP% JSYS Error)
>
	$TEXT (STOCHR,<Status Block size returned did not match expected size>)
	$TEXT (STOCHR,<Returned size=^D/T4/, expected size=^D/T1/>)
	$RETT			;Complain and return


	SUBTTL	SHOW Commands -- SHOW SERVERS

SHWSVR:	MOVEI T1,.LASAS		;Show servers function
	MOVEM T1,ARGBLK+.LAFCN
	MOVEI T1,.LAQUA+1	;Arg block size for this function
	MOVEM T1,ARGBLK+.LAACT
	$CALL GPAG		;Get a page for server data
	MOVEI T1,^D512		;Length
	MOVEM T1,ARGBLK+.LABCT	;Store in argument block
	MOVEM S1,ARGBLK+.LABFA	;Store buffer address in arg block
	MOVE P1,S1		;Save buffer address for below
	$CALL GTSRVR		;Get the desired server
	XMOVEI S1,ARGBLK	;ARGBLK address for JSYS
	LATOP%
	  ERJMP JSYSER
	HLRZ T4,ARGBLK+.LABCT	;Actual count returned.
	JUMPE T4,NOSVRS		;No servers
	SKIPN ARGBLK+.LAQUA	;Which display?
	JRST SHWSSM
	LOAD T1,SVRSC,(P1)	;Get the server name count
	MOVEI T2,SV.SNM(P1)	;Address of string.
	$CALL MAKAZ
	$IACK	(Information About Server ^T/STRNGZ/)
	LOAD T1,SVNUM,(P1)
	$TEXT (STOCHR,<Server Number: ^D/T1/>)
	LOAD T1,SVRLC,(P1)	;Get the server location count
	MOVEI T2,SV.LOC(P1)	;Address of string.
	$CALL MAKAZ
	$TEXT (STOCHR,<Server Location: ^T/STRNGZ/>)
	LOAD T1,SVPTC,(P1)	;Get the Product Type Code
	CAILE T1,NPIDS		;Less than maximum?
	SETZ T1,		;No, force undefined
	$TEXT (STOCHR,<Server Type: ^T/@PIDTYP(T1)/>)
	MOVEI T1,SV.DNI(P1)	;Address of NI address field
	$CALL ENADDR		;Build the string for the NI address
	$TEXT (STOCHR,<Ethernet Address: ^T/STRNGZ/>)
	LOAD T1,SVSTA,(P1)
	SKIPE T1
	MOVEI T1,1
	$TEXT (STOCHR,<Server Status: ^T/@CBSTA(T1)/>)
	LOAD T1,SVMSL,(P1)
	$TEXT (STOCHR,<Max Slots: ^D/T1/>)
	LOAD T1,SVMTF,(P1)
	$TEXT (STOCHR,<Data Link Size: ^D/T1/>)
	LOAD T1,SVCTI,(P1)
	IMULI T1,^D10
	$TEXT (STOCHR,<Circuit Timer(ms): ^D/T1/>)
	LOAD T1,SVKTI,(P1)
	$TEXT (STOCHR,<Keep-alive Timer(s): ^D/T1/>)
	$RETT
SHWSSM:	$IACK	(Summary of All Servers)
	DO.
	  LOAD T1,SMRSC,(P1)	;Get the server name count
	  MOVEI T2,SM.SNM(P1)	;Address of string.
	  $CALL MAKAZ
	  $TEXT (STOCHR,<Server Name(Number): ^T/STRNGZ/(^A>)
	  LOAD T1,SMNUM,(P1)
	  $TEXT (STOCHR,<^D/T1/) Address: ^A>)
	MOVEI T1,SM.DNI(P1)
	$CALL ENADDR
	$TEXT (STOCHR,<^T/STRNGZ/>)
	  SUBI T4,SM.LEN
	  JUMPLE T4,.RETT
	  ADDI P1,SM.LEN
	  LOOP.
	ENDDO.
NOSVRS:	$IACK	(No Known Servers)
	$RETT
	SUBTTL	SHOW COMMAND -- SHOW COUNTERS

SHWCOU:	MOVEI T1,.LASCO		;Show counters function
	MOVEM T1,ARGBLK+.LAFCN
	MOVEI T1,.LAQUA+1	;Arg block size for this function
	MOVEM T1,ARGBLK+.LAACT
	$CALL GPAG		;Get a page for counters
	MOVEI T1,^D512		;Length
	MOVEM T1,ARGBLK+.LABCT	;Store in argument block
	MOVEM S1,ARGBLK+.LABFA	;Store buffer address in arg block
	MOVE P1,S1		;Save buffer address for below
	$CALL GTSRVR		;Get the desired counter set
	XMOVEI S1,ARGBLK	;ARGBLK address for JSYS
	LATOP%
	  ERJMP JSYSER
	SKIPE S1,ARGBLK+.LAQUA		;Did he ask for "ALL-SERVERS" count?
	IFSKP.
	  $IACK (Counter Totals for All Servers)
	ELSE.
	  $IACK (Counters for Server ^Q/S1/)
	ENDIF.

	$TEXT (STOCHR,<Messages received: ^D/(P1)/>)
	$TEXT (STOCHR,<Messages transmitted: ^D/1(P1)/>)
	$TEXT (STOCHR,<Messages retransmitted: ^D/2(P1)/>)
	$TEXT (STOCHR,<Sequence errors received: ^D/3(P1)/>)
	$TEXT (STOCHR,<Illegal messages received: ^D/4(P1)/>)
	$TEXT (STOCHR,<Illegal slots received: ^D/5(P1)/>)
	$TEXT (STOCHR,<Resource failures: ^D/6(P1)/>)
	$RETT

	SUBTTL	SHOW PENDING-CONNECTS command

;Temporary AC usage in this routine:
;
;	T1 - T2 -- General temporaries, loop counter/limits
;	T3	-- General
;	T4	-- Holds local flags of interest

SHWPEN:
	SETZM T4		;T4 is used to indicate flags
	TXO T4,FL.NPR		;No pending requests seen yet
	JRST SHWBEG		;Skip around
SHWHIC:
	MOVE T4,[FL.SHC]	;Show all host-initiated connects
TOPS10<
SHWBEG:	MOVE T1,[%CNVER]	;First get the monitor version number
	GETTAB T1,		;Get it
	 JRST SHWPBM		;Can't - monitor must be ancient or broken
	CAILE T1,70300		;Is it 704 or greater?
	 JRST SHWP.0		;Yes - go on
SHWPBM: TXNE T4,FL.SHC		;What kind of connects were we showing?
	 $IACK (SHOW HOST-INITIATED-CONNECTS command not available)
	TXNN T4,FL.SHC
	 $IACK (SHOW PENDING-CONNECTS command not available)
	$TEXT (STOCHR,<The command is not supported by this Monitor version>)
	$RETT			;No - Complain and return
SHWP.0:
>;TOPS10
TOPS20<
SHWBEG:
>;TOPS20
	SETZM CONCNT		;Clear count of connects displayed
	SETZM REJCNT		;Clear count of rejected requests
	MOVEI T1,.LASHC		;Show Host-Initiated Connects
	MOVEM T1,ARGBLK+.LAFCN
	MOVEI T1,5		;Arg block size for this function
	MOVEM T1,ARGBLK+.LAACT
	MOVE P1,S1		;Save S1 for a bit
	$CALL GPAG		;Get a page for server data
	MOVEI T1,^D512		;Length
	MOVEM T1,ARGBLK+.LABCT	;Store in argument block
	MOVEM S1,ARGBLK+.LABFA	;Store buffer address in arg block
TOPS10 <
	MOVE T1,[LA.SYS]	;Get 'system-wide pending requests' bit
>
TOPS20 <
	MOVE T1,[LA%SYS]	;Get 'system-wide pending requests' bit
>
	MOVEM T1,ARGBLK+.LAQUA	;Store in qualifier word
	XMOVEI S1,ARGBLK	;ARGBLK address for JSYS
	LATOP%			;Do it!
	  ERJMP JSYSER		;Here if an error occurred
	MOVE S1,P1		;Restore S1
	HLRZ T3,ARGBLK+.LABCT	;Actual count returned.
	JUMPE T3,NOPENS		;No host-initiated connects found
	HRRZ P1,ARGBLK+.LABFA	;Get buffer address

;If we get here, the value returned is a multiple of the size of the status
;block.  To see how many, divide the size in T3 by the size of a block.
;If it doesn't divide evenly, complain and exit.
	MOVE T1,T3		;Copy size into T1
	IDIVI T1,HC.SIZ		;Divide by expected size
	JUMPN T2,SHWPDE		;If there's a remainder something's wrong
				;T1=Number of times to traverse loop
				;T2=Number of trips made so far
	MOVEI T2,1		;We're on the first trip

;Top of the loop.
SHWP.1:	PUSH P,T1		;Save the loop limit
	PUSH P,T2		;and the current count
	LOAD T3,HCSTS,(P1)	;Get the request status
	$CALL SHWPCS		;Go check the status of the connect
	TXNE T4,FL.SHC		;Are we showing all statuses?
	 JRST SHWP.2		;Yes - we don't care what its state is
	JUMPF SHWP.L		;No - Don't process if not pending

SHWP.2:	TXZ T4,FL.NPR		;If we're here, then we've found a request
	TXNE T4,FL.HEA		;Have we done the header?
	 JRST SHWP.3		;Yes - don't do it again
	TXO T4,FL.HEA		;No - make sure we only do it once
	TXNE T4,FL.SHC		;Showing all statuses?
	 $IACK (Current Host-Initiated Requests) ;Say so
	TXNN T4,FL.SHC		;Showing pending status only?
	 $IACK (Current Pending Connect Requests) ;Say so
	$TEXT (STOCHR,<^M^JJob Status    Server Name     Service Name      Port Name          User>)
	$TEXT (STOCHR,<--- ------ ---------------- ---------------- ---------------- --------------->)

;Here we begin building a text line.
;First, get the job number.
SHWP.3:	LOAD T1,HCJOB,(P1)	;Get the requesting job number
	$TEXT (STOCHR,<^D3/T1/ ^A>)
	LOAD T1,HCSTS,(P1)	;Get the status
	MOVE T3,T1		;Copy to T3
	$CALL SHWPCS		;Check Pending Status
	JUMPF SHWP.4		;If not pending, get a terminal number
	CAIL T1,MINSTS		;Is it a rejection code?
	 JRST SHWP.5		;No, go check the status code possibilities
	$TEXT (STOCHR,<REJ ^O2/T1/ ^A>) ;Yes, give a rejection code
	MOVE T2,REJCNT		;Get the rejected item counter
	MOVEM T1,REJCOD(T2)	;Save it in the table
	AOS REJCNT		;Bump the pointer up
	TXO T4,FL.REJ		;Light bit
	JRST SHWP.6		;Go after rest of fields

;Here if we have a UDX - print the TTY number of the connected link
SHWP.4:
TOPS10 <
	SUBI T1,.UXTRM		;Make into a TTY number
>
TOPS20 <
	TXZ T1,.TTDES		;Make into a TTY number
>
	$TEXT (STOCHR,<TTY^O3L/T1/ ^A>) ;Put it out
	TXO T4,FL.ACT		;Light bit
	JRST SHWP.6		;Go after rest of fields

;Here to check the Monitor-defined error codes
SHWP.5:	CAIN T1,.LASOL		;Is it Soliciting?
	 JRST [TXO T4,FL.SOL	;Yes- light flag
	       $TEXT (STOCHR,<SOL    ^A>) ;tell user
	      JRST SHWP.6]	;and go for other fields
	CAIN T1,.LAQUE		;Queued?
	 SKIPA			;Yes, bounce
	  JRST SHWP5A		;No, look for other possibilities
	LOAD T2,HCQDP,(P1)	;Get the queue depth
	$TEXT (STOCHR,<QUE ^D2/T2/ ^A>) ;Give count
	TXO T4,FL.QUE		;Light bit
	JRST SHWP.6		;Look at other fields
	
SHWP5A:	CAIN T1,.LACAN		;Cancelled?
	 JRST [TXO T4,FL.CAN	;Yes- light bit
	       $TEXT (STOCHR,<CAN    ^A>) ;Say so
	       JRST SHWP.6]	;Go look at other fields
	CAIN T1,.LATMO		;Timed out?
	 JRST [TXO T4,FL.TMO	;Yes- light bit
	       $TEXT (STOCHR,<TMO    ^A>) ;Tell people
	       JRST SHWP.6]	;and look at other fields
	MOVEI T2,STTSIZ		;Get size of status value table
	SUBI T2,1		;Bump down by one
	CAMGE T1,STSTAB(T2)	;Is value lower than allowed values?
	 $TEXT (STOCHR,<^O6/T1/ ^A>) ;Yes - put the status value in the field

;Here to fill in remainder of fields	
SHWP.6:	LOAD T1,HCSRC,(P1)	;Get the server name count
	MOVEI T2,HC.SRN(P1)	;Get address of string
	$CALL MAKAZ		;Convert it
	$TEXT (STOCHR,<^T16/STRNGZ/ ^A>)
	LOAD T1,HCSVC,(P1)	;Get the service name count
	MOVEI T2,HC.SVN(P1)	;Get its address
	$CALL MAKAZ		;Convert that
	$TEXT (STOCHR,<^T16/STRNGZ/ ^A>)
	LOAD T1,HCPTC,(P1)	;Get the port name string count
	MOVEI T2,HC.PTN(P1)	;And its address
	$CALL MAKAZ		;Convert
	$TEXT (STOCHR,<^T16/STRNGZ/ ^A>)

TOPS10 <
	LOAD T1,HCJOB,(P1)	;Get the job number again
	MOVE T2,T1		;Copy it for later
	MOVS T1,T1		;Swap it into LH
	HRRI T1,.GTPPN		;Set up to ask for PPN 
	GETTAB T1,		;Find out the PPN
	 SETZM T1		;We tried
	JUMPG T1,SHWP.7		;Skip next bit if there's a PPN
	$TEXT (STOCHR,<[SYSTEM]>) ;No PPN=either Orphan Request or System Req.
	JRST SHWP.L		;Go to end of loop

;Here on non-zero PPN - get the user name
SHWP.7:	HRLZ T3,T2		;Copy the job number into LH
	HRRI T3,.GTNM1		;Set up for 1st half of user name
	GETTAB T3,		;Get it
	 SETZM T3		;We didn't get it
	$TEXT (STOCHR,<^W/T3/^A>) ;Put out 1st half user name
	MOVS T3,T2		;Move job number into LH
	HRRI T3,.GTNM2		;Set up for 2nd half of user name
	GETTAB T3,		;Get it
	 SETZM T3		;We didn't
	$TEXT (STOCHR,<^W/T3/ ^P/T1/>) ;Put out Username [PPN] + CRLF
>;End of TOPS10

TOPS20 <
	LOAD S1,HCJOB,(P1)	;Get the job number
	MOVE S2,[-1,,STRNGZ]	;<argblk length,,argblk address>
	MOVEI T1,.JIUNO		;First symbol in job info to get (User#)
	GETJI
	 SETZM STRNGZ		;No job number.  Use 0
	MOVE S1,[POINT 7,<STRNGZ+1>] ;Pointer for user name string
	MOVE S2,STRNGZ		;Job's user number
	DIRST
	 SETZM <STRNGZ+1>	;Error, no user name
	$TEXT (STOCHR,<^T/STRNGZ+1/>) ;Put out username
> ;End TOPS20

;End of the loop - increment to point to next block or exit if done
SHWP.L:	POP P,T2		;Get our loop variables back
	POP P,T1		;...
	AOS CONCNT		;Bump up count of requests displayed
	CAML T2,T1		;Have we already traversed the loop enough?
	 JRST SHWP.W		;Yes - wrap up our message and leave
	AOS T2			;No - bump up count
	ADDI P1,HC.SIZ		;Point to next block
	JRST SHWP.1		;And back to the top

;Here to wrap up and leave - print out interpretation keys
SHWP.W:
	TXNE T4,FL.NPR		;No Pending Requests?
	 JRST NOPENS		;No.  Tell 'em...
	$TEXT(STOCHR,<^M^J^A>)	;Blank line
	TXNE T4,FL.ACT		;Any active?
	 $TEXT(STOCHR,<TTYnnn means connect is active and terminal nnn was assigned>)
	TXNE T4,FL.SOL		;Any soliciting?
	 $TEXT(STOCHR,<SOL means soliciting is in progress>)
	TXNE T4,FL.QUE		;Any queued?
	 $TEXT(STOCHR,<QUE nn means request was queued; entry is nn requests into the queue>)
	TXNE T4,FL.TMO		;Any timed out?
	 $TEXT(STOCHR,<TMO means request has timed out>)
	TXNN T4,FL.REJ		;Any rejected?
	 JRST SHWP.X		;No - give totals and leave
	MOVE T3,REJCNT		;Yes - get rejected count
	SUBI T3,1		;Subtract one from count of rejects
	$TEXT (STOCHR,<REJ nn means request was rejected with code nn, as follows:>)
	$TEXT (STOCHR,<^M^JCode                        Meaning>)
	$TEXT (STOCHR,<----   ---------------------------------------------------->)
	SETZM T1		;Clear an AC

SHWPWL:	MOVE T2,REJCOD(T1)	;Get a reject code
	$TEXT (STOCHR,< ^O2/T2/    ^T/@REJSTR(T2)/>)
	AOS T1			;Bump counter
	CAMG T1,T3		;Did we do them all?
	 JRST SHWPWL		;No, do another
				;Yes, fall through
SHWP.X: MOVE T1,CONCNT		;Get count of connects displayed
	CAILE T1,1		;Did we do more than one? Give count if so.
	 $TEXT(STOCHR,<^M^JA total of ^D/T1/ requests were found>)
	$RETT			;Leave.

;Support routines...

;SHWPCS - Check status value in T3 to see if it is not 
;active (where active is defined as having a terminal number assigned).
;  Return TRUE if pending, FALSE if not.
SHWPCS:
TOPS10 <
	CAIL T3,.UXTRM		;Is it out of the terminal UDX range?
	 CAIL T3,.UXTRM+777	;...
	  $RETT			;Yes
	   $RETF		;No
>
TOPS20 <
	TXNN T3,.TTDES		;Is it a TTY designator
	 $RETT			;No
	$RETF			;Yes
>
SHWPDE: MOVEI T1,HC.SIZ		;Get the intended size
	$IACK (LATOP. UUO Error)
	$TEXT (STOCHR,<Status Block size returned did not match expected size>)
	$TEXT (STOCHR,<Returned size=^D/T2/, expected size=^D/T1/>)
	$RETT			;Complain and return

NOPENS:	TXNE T4,FL.SHC		;Showing all statuses?
	 $IACK (No host-initiated requests found) ;Say so
	TXNN T4,FL.SHC		;Showing pending status only?
	 $IACK (No pending host-initiated connect requests found)
	$RETT
	SUBTTL	START COMMAND

;STACMD
	

STACMD:	MOVEI T1,.LAVAL+1	;Basic SET argblk length
	MOVEM T1,ARGBLK+.LAACT	;Store as argument block count
	MOVEI T1,.LASET		;Put the SET function code
	MOVEM T1,ARGBLK+.LAFCN	; into the argument block too.
	MOVEI T1,.LPLAS		;Function is SET LAT ACCESS STATE
	MOVEM T1,ARGBLK+.LAPRM	;Parameter to set.
	MOVEI T1,LS.ON		;Set it ON.
	MOVEM T1,ARGBLK+.LAVAL	; ...
	MOVEI S1,ARGBLK		;Address of JSYS argument block
	LATOP%			;Do the JSYS
	  ERJMP JSYSER		;JSYS failed
	$IACK	(Start Accepted)
	$RETT			;Return success.

	SUBTTL	STOP Command

STPCMD:	MOVEI T1,.LAVAL+1	;Basic SET argblk length
	MOVEM T1,ARGBLK+.LAACT	;Store as argument block count
	MOVEI T1,.LASET		;Put the SET function code
	MOVEM T1,ARGBLK+.LAFCN	; into the argument block too.
	MOVEI T1,.LPLAS		;Function is SET LAT ACCESS STATE
	MOVEM T1,ARGBLK+.LAPRM	;Parameter to set.
	MOVEI T1,LS.OFF		;Set it OFF.
	MOVEM T1,ARGBLK+.LAVAL	; ...
	MOVEI S1,ARGBLK		;Address of JSYS argument block
TOPS20 <SKIPE DEBUGW		;Disable the stop command if we're in
	JRST .+3		; a private world
> ;End TOPS20
	LATOP%			;Do the JSYS
	  ERJMP JSYSER		;JSYS failed
	$IACK	(Stop Accepted)
	$RETT			;Return success.

	SUBTTL	ZERO Command

ZROCMD:	$CALL P$KEYW		;Get the parsed keyword ("COUNTERS").
	  $RETIF
	MOVEI T1,.LAZCO		;Show counters function
	MOVEM T1,ARGBLK+.LAFCN
	MOVEI T1,.LAQUA+1	;Arg bloc size for this function
	MOVEM T1,ARGBLK+.LAACT
	$CALL GTSRVR		;Determine which counter set to zero
	XMOVEI S1,ARGBLK	;ARGBLK address for JSYS
	LATOP%
	  ERJMP JSYSER
	$IACK	(Zero Accepted)
	$RETT
; PAFLD - Get a parsed ASCII field

PAFLD:	$CALL P$FLD		;Get the address of ASCIZ string
	  $RETIF
	AOJ S1,0		;Point to start of test
	HRLI S1,-1		;Make a proper pointer
	$RETT			;Return to do JSYS

	SUBTTL	Utility Routines -- MAKAZ

;MAKAZ - Make an ASCIZ String from a counted string.
;Call:	T1/ Address of the string
;	T2/ Character count
;RET:	Converted string in STRNGZ

MAKAZ:	MOVE T3,T2		;Save the string address
	IDIVI T1,5		;Compute offset of last word of
	SKIPN T2		; destination string and the number of
	SOS T1			; in a partially filled word.
	HRLS T3			;Set up source,,destination
	HRRI T3,STRNGZ		; for BLT instruction.
	BLT T3,STRNGZ(T1)	;Do the move.
	MOVEI T1,0
	HRRZS T3
	SOS T3			;Move back to last destination word.
	DPB T1,PTR(T2)		;Deposit a null
	$RETT			;Return okay.
PTR:	POINT 7,1(T3),6
	POINT 7,(T3),13
	POINT 7,(T3),20
	POINT 7,(T3),27
	POINT 7,(T3),34

;GTSRVR - routine to get the parsed server name string pointer.
;
;Returns:
;	ARGBLK+.LAQUA/ 0 counters summed over all servers,
;	      or
;	ARGBLK+.LAQUA/ server number, for counters relative to a specific
;		       		      server

GTSRVR:	$CALL P$SWIT		;Get the parsed switch.
	 JUMPF GTSRV3		;Not a switch, might be ok.
	JUMPE S1,GTSRV2		;He said /ALL
GTSRV1:	$CALL PAFLD		;Get the server name into S1
	  $RETIF
GTSRV2:	MOVEM S1,ARGBLK+.LAQUA	;Put into JSYS arg block
	$RETT			;Return successfully
GTSRV3:	MOVEI S1,0		;If no switch, give default of 0
	MOVE T1,ARGBLK+.LAFCN	;Didn't type a switch, look at function
	CAIE T1,.LASCO		;Was it SHOW COUNTERS?
	CAIN T1,.LAZCO		;or ZERO COUNTERS?
	  JRST GTSRV2		;Yes, he wants total counters.
	JRST GTSRV1		;Not those, reparse field as server name

;ENADDR - Routine to convert 48-bit Ethernet address to the standard string
; XX-XX-XX-XX-XX-XX
;Call:	T1/ Address of 48-bit field, word aligned
;RET:	STRNGZ/ the converted string
FRMPTR:	BLOCK 1
TOPTR:	BLOCK 1

ENADDR:	
	HRLI T1,441000		;Build the byte pointer for
	MOVEM T1,FRMPTR		; the string source.
	MOVX T1,<POINT 7,STRNGZ>;Build the byte pointer for
	MOVEM T1,TOPTR		; the string destination
	MOVEI T3,6		;Total byte count in string
	DO.
	  ILDB T1,FRMPTR	;Get next NI address byte
	  MOVE T2,T1		;Save a copy.
	  LSH T1,-4		;Get the high order digit
	  CALL CCHHEX		;Convert to HEX
	  IDPB T1,TOPTR		;Deposit result
	  MOVE T1,T2		;Get the low order digit
	  ANDI T1,17		; ...
	  CALL CCHHEX		;Convert it too.
	  IDPB T1,TOPTR		;Stash it.
	  SOJE T3,ENDLP.	;Done
	  MOVEI T1,"-"		;Need a "dash"
	  IDPB T1,TOPTR		;Stash
	  LOOP.			;Continue with next byte
	ENDDO.
	MOVEI T1,0		;Make sure ASCIZ
	IDPB T1,TOPTR
	RET


;CCHHEX - Convert character to hexadecimal
;Call:	T1/ 4-bit BCD representation of character
;RET:	T1/ Hex represetation of character

CCHHEX:	CAILE T1,11
	IFSKP.
	  ADDI T1,"0"
	  RET
	ENDIF.
	ADDI T1,<"A"-12>
	RET


JSYSER:
TOPS20 <
	HRROI 1,STRNGZ
	HRLOI 2,.FHSLF		;Most recent error will be correct one
	SETZ 3,0
	ERSTR			;Print the string
	  TRN
	  TRN
	$TEXT	(STOCHR,<^T/STRNGZ/>)
>

TOPS10 <
	$IACK	(LATOP. UUO Error)
	$TEXT	(STOCHR,<^T/@ERRTAB(S1)/>)
>
;*** IS THIS RIGHT?
	MOVE	S1,[EXP MF.FAT!<INSVL.(<'LCP'>,MF.SUF)>] ;Get error flags
	MOVEM	S1,.MSFLG(MO)		;Set them for typeout
	$RETF			;Return unsuccessful


ARGBLK:	BLOCK 6			;JSYS argument block.
STRNGZ:	BLOCK 52		;Construct ASCIZ strings here.
CMDDSP:	
	CLRCMD
	SETCMD
	SHWCMD
	STACMD
	STPCMD
	ZROCMD
IFN FTSTANDALONE,<
	I%EXIT##	;Must be last (after ZERO command).
> ;END FTSTANDALONE

; SHOW command dispatching...

SHWDSP:	SHWCHA		;(0) CHARACTERISTICS
	SHWSES		;(1) SESSIONS
	SHWCOU		;(2) COUNTERS
	SHWSVR		;(3) SERVERS
	SHWPEN		;(4) PENDING-CONNECTS
	SHWHIC		;(5) HOST-INITIATED-CONNECTS

; ASCIZ strings for the LAT Access State

LSTATE:	ASCIZ /OFF/
	ASCIZ /ON/
	ASCIZ /SHUT/

; ASCIZ strings for circuit state

CBSTA:	[ASCIZ\Disconnected\]
	[ASCIZ\Connected\]

;
; GPAG -- Coroutine to get a page, return it on next POPJ
;
GPAG:	$CALL M%GPAG		;Call routine to get a page
	MOVEM S1,ARGBLK+.LABFA	;Save address of page
	$CALL @(P)		;and call the caller back
	  SKIPA			;He took non-skip return
	AOS -1(P)		;Took skip return, propagate it
	MOVEM TF,(P)		;Save flag and overwrite bogus return address
	EXCH S1,ARGBLK+.LABFA	;get the address of buffer to return
	$CALL M%RPAG		;Return it
	MOVE S1,ARGBLK+.LABFA	;restore S1
	POP P,TF		;restore flag
	$RET

	SUBTTL ORION text routines
;
;SETMSG - Routine to set up first part of a DISPLAY message
;	which LCPORN will send to the inquiring OPR.
;
IFN FTSTANDALONE!FTJSYS,<
SETMSG:	PUSH	P,S1		;Save character which caller wanted to type
	$CALL	OPRMES		;Set up message header.
	MOVEM	MO,MOSAV	;Save pointer to mesage page (it gets trashed)
TOPS20 <
	$TEXT	(STOCHR,<[LCP]		-- ^A>) ;Output header line
>
TOPS10 <
	$TEXT	(STOCHR,<		-- ^A>) ;Output header line
>
	POP	P,S1		;Restore character and fall into STOCHR

STOCHR:	SKIPN	WTOPTR		;Have we started the message yet?
	JRST	SETMSG		;No, do initial things.
	PJRST	WTORTN		;Call ORION routine to stuff a character.
>; END IFN FTSTANDALONE

IFE FTSTANDALONE,<END>
IFE FTSTANDALONE,<END>
IFN FTSTANDALONE,<
	PRGEND
	TITLE	LCP
	SEARCH MACSYM
	SEARCH GLXMAC
	SEARCH ORNMAC
	PROLOG	LCP
	.TEXT "REL:OPRPAR/SEG:LOW"
	.REQUIRE LCPTAB

	PDLEN==200	;Stack length

MESSAG:	BLOCK	1000		;PAGE OF SPACE FOR OUTPUT MESSAGE
WTOCNT:	BLOCK	1
WTOPTR::	BLOCK	1
PROMPT:	ASCIZ/LCP>/		;Program prompt string
PDL:	BLOCK PDLEN		;Stack

	SUBTTL	LCP Initialization


START:	RESET
	MOVE P,[IOWD PDLEN,PDL]
	MOVEI S1,IB.SZ		;Initialization block size
	MOVEI S2,INIBLK		;Address of initialization block
	$CALL I%INIT		;Initialize GLXLIB

	SUBTTL Main PARSER Loop

COMND:
	MOVE S1,LCPTAB##+2	;Get Top PDB in main LCPTAB
	ADDI	S1,1		;Bump to data portion of PDB
	HRRM	S1,MYTOP+1+.CMFLG	;Make it the alternate
	MOVEI	S1,MYINI		;Point to my INIT PDB
	MOVEM S1,PRSBLK+PAR.TB
	MOVEI S1,PAR.SZ		;Size of the argument block
	MOVEI S2,PRSBLK		;Address of the parser argument block
	$CALL PARSER##		;Call the parser
	JUMPF BADCMD		;Bad command
CMNDGO:	MOVE	MI,PRT.CM(S2)
	$CALL LCPORN##
	MOVE S1,MI		;get PARSER page
	$CALL M%RPAG##		;Throw it away now that we're done with it.
	JRST COMND

BADCMD: 
	$TEXT ,<^T/@PRT.EM(S2)/>
	JRST COMND		;Check for next command

INIBLK:	$BUILD IB.SZ		;GLXLIB initialization block (see GLXMAC.MAC)
	$SET (IB.PRG,,'LCP')	;Program name
	$SET (IB.FLG,,1B0);Open command terminal
	$EOB

PRSBLK:	$BUILD PAR.SZ		;PARSER argument block
	$SET (PAR.PM,,PROMPT)	;Program prompt string
	$EOB

	SUBTTL	Support routines normally found in ORION.

	G$SND==:0		;KEEP LCPORN HAPPY, NOT USED IN LCP

OPRMES::
	MOVEI	MO,MESSAG
	MOVEI	S1,<<PAGSIZ-1>-<ARG.DA+2+.OHDRS>>*5 ;NUMBER OF BYTES AVAILABLE
					;Page size -1 (so 777 works)
					;Minus size of header of argument block
					;  and message header
					;SAVE ROOM FOR TRUNCATING
	MOVEM	S1,WTOCNT		;SAVE IN WTOCNT
	MOVSI	S1,(POINT 7,0)		;SETUP BYTE POINTER
	HRRI	S1,ARG.DA+1+.OHDRS(MO)	;ADDRESS TO SAVE TEXT
	MOVEM	S1,WTOPTR		;SAVE THE BYTE POINTER
L$SHWM::				;another useless entry point
	$RETT

WTORTN::
	SOSG	WTOCNT
	$RETF
	IDPB	S1,WTOPTR
	$RETT

MSGFIN::
	MOVEI	S1,0
	IDPB	S1,WTOPTR
	$RETT


SPDOPR::	
	MOVEI S1,ARG.DA+1+.OHDRS(MO)	;Get address of message
	$TEXT ,<^T/(S1)/>		;and type it out
	$RETT


MYINI:	$INIT	(MYTOP)
MYTOP:	$KEYDSP	(MYCMD,$ALTERNATE(0))	;will fill in alternate at startup
MYCMD:	$STAB
TOPS10	<DSPTAB	(,$KLZRO##+1,\"32,CM%INV)>	;^Z
	DSPTAB	(CRLF,$KLZRO##+1,<EXIT>)
	$ETAB
CRLF:	$CRLF

	END	START
> ;END IFN FTSTANDALONE