IFNDEF FTSTANDALONE,<FTSTANDALONE==0>
	TITLE	LCPORN
	SUBTTL	Copyright
;
;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986. 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  WHICH  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]
>>

	LCPVER==1	;Major version number
	LCPMIN==0	;Minor version number
	LCPWHO==0	;Who did last edit(0=DEC)
	LCPEDT==1	;Edit number

	LCPMAN==:LCPEDT		;Maintenance edit level (no edits yet)
	LCPDEV==:LCPEDT		;Development edit level

	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>)
> ;END TOPS10


MOSAV:	BLOCK	1
ANYSET:	BLOCK	1


BEGSTR	TC
	WORD NUM		;Number of terminal
	WORD SNC		;Server name count
	WORD NAM,^D4		;Server name string (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
	HWORD PTC		;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



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>>>)



;Macro to define the ASCIZ string associated with Product Type Codes. Only
; server product types are legal.  NPIDS is the maximum product type code
; which is defined.

DEFINE .PIDTY (LIST) <

	NPIDS==0
	[ASCIZ\Undefined\]
	IRP LIST,<
	NPIDS==NPIDS+1
	IFB <LIST>,<[ASCIZ\Undefined\]>
	IFNB <LIST>,<[ASCIZ\LIST\]>
	>>

PIDTYP: .PIDTY (<Ethernet Terminal Server,DECserver-100,,,,,,,LAT-11>)

	SUBTTL	LCP Initialization

LCPORN::
IFN FTSTANDALONE,<
	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:	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
	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,3		;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,3		;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
	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
	$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,4		;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,CHMXC,(P1)
	$TEXT (STOCHR,<Maximum allocated circuits: ^D/T1/>)
	LOAD T1,CHNCC,(P1)
	$TEXT (STOCHR,<Currently allocated circuits: ^D/T1/>)
	LOAD T1,CHMAC,(P1)
	$TEXT (STOCHR,<Maximum active circuits: ^D/T1/>)
	LOAD T1,CHNAC,(P1)
	$TEXT (STOCHR,<Currently active circuits: ^D/T1/>)
	LOAD T1,CHMCO,(P1)
	$TEXT (STOCHR,<Maximum sessions: ^D/T1/>)
	LOAD T1,CHCON,(P1)
	$TEXT (STOCHR,<Current sessions: ^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
	$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
NEXTSB:	LOAD T1,SBNC,(P2)	;Service name count
	MOVEI T2,SB.NAM(P2)	;Address of service name
	$CALL MAKAZ		;Make an ASCIZ string
	$TEXT (STOCHR,<Service name(rating): ^T/STRNGZ/(^A>)
	OPSTR <SKIPL T1,>,SBRAT,(P2);Get the rating.
	JRST OSRVC0
	$TEXT (STOCHR,<D)>)
	JRST OSRVC1
OSRVC0:	$TEXT (STOCHR,<^D/T1/)>)
OSRVC1:	LOAD T1,SBLC,(P2)	;Service Id count
	JUMPE T1,OSRVCE
	MOVEI T2,SB.HID(P2)	;Service description address
	$CALL MAKAZ		;Make ASCIZ string
	$TEXT (STOCHR,<Service Id: ^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:	MOVEI T1,.LASTC		;SHOW SESSIONS function
	MOVEM T1,ARGBLK+.LAFCN
	MOVEI T1,4
	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
	MOVEM T1,ARGBLK+.LABCT
	MOVEM S1,ARGBLK+.LABFA
	XMOVEI S1,ARGBLK	;ARGBLK address for JSYS
	LATOP%
	  ERJMP JSYSER
	HLRZ P2,ARGBLK+.LABCT	;Find out how many words we got
	JUMPE P2,SHWSE4
	IDIVI P2,TC.LEN		;Calculate how many terminals that is
	$IACK	(Active LAT Sessions)
	$TEXT	(STOCHR,<Job Line Program Server Name      User>)
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
	SKIPGE T1,STRNGZ+.JIJNO	;Job number returned
	JRST SHWSE2		;Job -1 is no job.	
	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	,<^D3/STRNGZ+.JIJNO/  ^O3/T2/ ^W7/STRNGZ+.JIPNM/ ^T16/TC.NAM(P1)/ ^T/STRNGZ+.JIPNM+1/>
	JRST 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
	SETZB T3,T4		;Zero the program name and PPN
	MOVEI T2,.UXTRM(T1)	;convert to udx
	MOVE S1,T2		;Make another copy
	DEVTYP T2,		;Get job number in a strange way
	  SETZ T2,		;Bad, pretend 0
	LDB T2,[POINT 9,T2,26]	;ISOLATE JOB NUMBER
	JUMPE T2,SHWSE2		;No job, just list line.
	DEVCHR S1,		;See what kind of device this is.
	TLNN S1,(DV.TTA)	;Is this a controlling terminal?
	JRST SHWSE0		;No, don't bother to get program etc.
	HRLZ T3,T2
	HRRI T3,.GTPRG
	GETTAB T3,
	  SETZ T3,
	HRLZ T4,T2
	HRRI T4,.GTPPN
	GETTAB T4,
	  SETZ T4,
SHWSE0:	$TEXT	(STOCHR,<^D3/T2/  ^O3/T1/ ^W7/T3/ ^T16/STRNGZ/ ^P/T4/>)
	JRST SHWSE3
> ;END TOPS10

SHWSE2:	$TEXT	(STOCHR,< -   ^O3/T1/         ^T/STRNGZ/>)
SHWSE3:	ADDI P1,TC.LEN
	SOJG P2,SHWSE1
	$RETT
SHWSE4:	$IACK	(No LAT Sessions Active)
	$RETT
	


	SUBTTL	SHOW Commands -- SHOW SERVERS

SHWSVR:	MOVEI T1,.LASAS		;Show servers function
	MOVEM T1,ARGBLK+.LAFCN
	MOVEI T1,5		;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,5		;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	START COMMAND

;STACMD
	

STACMD:	MOVEI T1,3		;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,3		;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
	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,5		;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

SHWDSP:	SHWCHA
	SHWSES
	SHWCOU
	SHWSVR

; 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,<
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)
	$TEXT	(STOCHR,<	[LCP] ^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