Trailing-Edge
-
PDP-10 Archives
-
cuspmar86binsrc_2of2_bb-fp63a-sb
-
10,7/lcp/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,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