Trailing-Edge
-
PDP-10 Archives
-
BB-L014Z-BM_1990
-
galsrc/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