Trailing-Edge - PDP-10 Archives - BB-J724A-SM_1980 - sources/ibmcon.mac
There are 2 other files named ibmcon.mac in the archive. Click here to see a list.
;<JENNESS>IBMCON.MAC.6, 30-Oct-79 14:43:22, Edit by JENNESS
; [103] Add a word in entry 233 to give port and line number.
;<JENNESS>IBMCON.MAC.2, 29-Oct-79 10:39:18, Edit by JENNESS
; [102] Add WAIT command and try to suppress superflous prompts during polling.
;<JENNESS>IBMCON.MAC.2, 29-Oct-79 10:38:45, Edit by MIERSWA
; [101] Fix to properly check for ports 10, 11 on KS
; IBMCON - IBM communications SYSERR recorder

;			  COPYRIGHT (c) 1980, 1979
;     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
;     DIGITAL assumes no responsibility for the use or reliability
;     of  its  software  on  equipment  which  is  not supplied by
;     DIGITAL.
	SUBTTL	Universal searches and version information

	SALL				; Make nice clean listings

	.DIRECTIVE FLBLST		; List only 1st binary word in multi
					;  word text strings

	SEARCH	GLXMAC			; General GLXLIB definitions
	SEARCH	QSRMAC			; QUASAR definitions
	SEARCH	ORNMAC			; Command block definitions
	SEARCH	D60UNV			; Get DN60 linkage definitions

	PROLOGUE (IBMCON)		; Initialize GLXLIB assembly options

; Version

	XP	ICMVER,	1		; Major version number
	XP	ICMMIN,	0		; Minor version number
	XP	ICMWHO,	0		; Who did editing last (0=DEC)
	XP	ICMEDT,	102		; Edit number

	%%.ICM=:<VRSN. (ICM)>		; Set value of edit level/version

Define VOUTX ($S1,$S2,$S3,$S4)
 <TITLE $S1 $S2'$S3'('$S4')
  PRINTX $S1 $S2'$S3'('$S4')>

 IFN <ICMMIN>,<VOUTX (IBMCON IBM communications SYSERR recorder,\ICMVER,\"<"A"+ICMMIN>,\ICMEDT)>
 IFE <ICMMIN>,<VOUTX (IBMCON IBM communications SYSERR recorder,\ICMVER,,\ICMEDT)>

 > ;End IF1
	SUBTTL	Miscellaneous

; Assembly parameters

	ND	NPORT,	4		; Range of port numbers (start at 10)
	ND	NLINE,	6		; Maximum number of lines/front end

; Global externals

	EXTERNAL D60INI			; D60JSY initialization
	EXTERNAL INIDMY,RLSHAN		;  Interface handle entry routines
	EXTERNAL LINSTS,PRTSTS		;  Interface status routines
	EXTERNAL SWAPB			;  Byte swapping routine
	EXTERNAL STSBUF			;  Interface status buffer
	.REQUIRE D60HOK			; Require its inclusion at load time

	PARSET				; Define parser semantic externals
	EXTERNAL PARSER			; Syntactic parser
	.REQUIRE OPRPAR			; Where all the parser routines live

; Constants

	XP	PDLSIZ,	100		; Size of the stack

	XP	SEC%D6,	233		; Line status event code
	XP	SEC%DE,	234		; Enable/disable event code

	XP	DEFLOG,	^d60		; Default logging interval

	XP	TIMCHN,	1		; TIMER interrupt channel
	XP	TIMLEV,	1		; TIMER interrupt level
	XP	DMYCHN,	2		; Dummy channel
	XP	DMYLEV,	1		; Dummy level for OPRPAR

; Keyword values

	XP	.DIS,	0		; Disable
	XP	.ENA,	1		; Enable
	XP	.SET,	2		; Set
	XP	.EXT,	3		; Exit
	XP	.WAI,	4		; Wait

; Error codes

	XP	.ERR1,	1		; Port number out of range KS
	XP	.ERR2,	2		; Port number out of range KL
	XP	.ERR3,	3		; Line number out of range
	SUBTTL	Macros

; Macro - CNVPRT
; Function - To convert a port number (10 to (NPORT+9)) into a address of a
; 	port status block.
; Parameters -
;	S1/	Port number
; Results - S1 contains address of port status block

Define CNVPRT <
	SUBI	S1,10			;; Remove DTE offset
	IMULI	S1,P.SIZ		;; Increment by table entry size
	ADDI	S1,PRTLST		;; Add in base address
    > ;End CNVPRT definition

; Macro - CNVLIN
; Function - To convert a port number (10 to (NPORT+9)) and a line number
; 	(0 to (NLINE-1)) into the address of a line status block.
; Parameters -
;	S1/	Port number
;	S2/	Line number
; Results - S1 contains address of line status block

Define CNVLIN <
	SUBI	S1,10			;; Remove DTE offset
	IMULI	S1,NLINE		;; Move by number of lines per port
	ADD	S1,S2			;; Move to actual block for this line
	IMULI	S1,L.SIZ		;; Increment to line block
	ADDI	S1,LINLST		;; Add in base address
    > ;End CNVLIN definition
	SUBTTL	Data structures for polling/logging

Comment &

	Port status block

  This block describes the state of a port.  The blocks for
all the ports are concatenated together in the area PRTLST.
To find the port status block for a particular port the port
number is converted to DTE number (subtract octal 10), multiplied
by the port status block size (P.SIZ) and added to PRTLST.

    !       Port polling enabled/number of lines	!
    !		 Polling interval			!
    !		Next polling time (UDT)			!


	P.EN==0			; Polling being done on this port
	 P.GO==-1		;  Polling started
	 P.STP==0		;  Polling stopped	
	P.INT==1		; Polling interval for this port (minutes)
	P.NXT==2		; Next time port will be polled (UDT format)
	P.SIZ==3		; Size of port status block
Comment &

	Line status block

   This block describes that logging state of a line.  All the line
blocks are concatenated together.  To find a particular block the
port number must be known.  After knowing the port number using the
following will give the base address of the line block:

	Base = ((port-^O10)*NLINES+line number)*(L.SIZ)+LINLST

    !		Line logging enabled			!
    !		 Logging interval			!
    !		Next logging time (UDT)			!


	L.EN==0			; Logging being done on this line
	 L.POL==-1		;  Poll this line (line disabled)
	 L.LOG==1		;  Log on this line (line enabled)
	 L.STP==0		;  Don't look at this line
	L.INT==1		; Logging interval for this line (minutes)
	L.NXT==2		; Next time line will be logged (UDT format)
	L.SIZ==3		; Size of the line status block
	SUBTTL	SYSERR entry format

Comment &

  This is a description of the SYSERR entry header. The body descriptions
follow later.

    !   Code   !   n/u   ! T ! Version ! 4  !  Length	!
    !    Date and time in Universal date/time format	!
    ! 		      System uptime			!
    !		  Processor serial number		!


	DEFSTR	(SYCOD,0,8,9)		; Event code
	DEFSTR	(SYT20,0,17,1)		; Entry was created by TOPS20
	DEFSTR	(SYVER,0,23,6)		; SYSERR entry type version number
	DEFSTR	(SYHLN,0,26,3)		; Header length (currently 4)
	DEFSTR	(SYLEN,0,35,9)		; Length of entry (w/o header)
	DEFSTR	(SYDAT,1,35,36)		; Date and time of this entry
	DEFSTR	(SYUPT,2,35,36)		; System uptime  days,,fraction of day
	DEFSTR	(SYPSN,3,35,36)		; Proc. serial number of recording CPU

	.SYDAT==4			; Offset to data portion of entry
	SUBTTL	Data format for SYSERR code 233

Comment &

    !      Port number	    !       Line number		!
    !			Status string			!
    /							/
    /							/

 The line status string is returned as a 8 bit byte string packed 4 bytes left
  justified in a 36 bit word.  In each byte the bit numbering is bit 0 to
  the right (LSB) and bit 7 to the left (MSB).
 Any 16 bit values have the 8 bit bytes that make it up swapped. So before
  these bits defined below are valid, the bytes have to be swapped back again.

	 7       0 15      8 7       0 15      8	Bit no.'s in -11's word
	 !       ! !       ! !       ! !       !
	! byte 0  ! byte 1  ! byte 2  ! byte 3  !  !	Byte no. in -11
	 !    11-word 0    ! !     11-word 1   !  !	Word no. in -11
         0                15 16                31 35	Bit no.'s in -10's word

Line status  [ 70 (8 bit) bytes, 18 (36 bit) words ]

 Byte		Meaning
 ----		-------

 0		Terminal type: 0 = unknown, 1 = 3780, 2 = 2780, 3 = HASP
 1-2		Flags:	bit 0 set = simulate, clear = support
			bit 1 set = primary BSC protocol, clear = secondary
			bit 2 set = signed on
			bit 3 set = transparent
			bit 4 set = disable in progress
			bit 5 set = line enable complete
			bit 6 set = line abort complete
			bit 7 set = off line (2780/3780 only)
			bit 8 set = line disable complete
			bit 9 set = disable done by DTE failure
			bit 10 set = Line aborted by hardware failure
			bit 11 set = Communications established
 3		Line info:
			bit 0 set = line is enabled
			bit 1 set = DTR (data terminal ready)
			bit 2 set = DSR (data set ready)
 4-5		Count of DQ11/DUP11 error interrupts
 6-7		DQ11/DUP11 status register 1 at last error
 8-9		DQ11/DUP11 status register 2 at last error
 10-11		Count of times receiver wasn't fast enough
 12-13		Count of times transmitter wasn't fast enough
 14-15		Count of CTS (clear to send) failures
 16-17		Count of message sent and ACK'ed
 18-19		Count of NAK's received (+wrong acknowledge after timeout)
 20-21		Count of invalid responses to TTD
 22-23		Count of invalid responses to messages
 24-25		Count of TTD's sent
 26-27		Count of WACK's received in response to messages
 28-29		Count of EOT's (aborts) in response to messages
 30-31		Count of invalid bids of responses to bids
 32-33		Count of RVI's received while transmitting
 34-35		Count of message received ok
 36-37		Count of bad BCC's
 38-39		Count of NAK's sent in response to data messages
 40-41		Count of WACK's sent
 42-43		Count of TTD's received
 44-45		Count of EOT's sent or received which abort the stream
 46-47		Count of messages ignored (out of chunks, unrecognizable or 
 48-49		Count of transparent msg with an invalid character after DLE
 50-51		Count of attempts to change between transparent and normal mode
		 in a blocked message
 52-53		Count of transmitter timeouts
 54-55		Clear to send delay in jiffies
 56-57		Count of silo overflows
 58-59		Number of bytes in silo warning area (usually 64, must be even)
 60-61		Max number of bytes used in silo warning area since set last
 62-63		Max bytes per message
 64-65		Number of records per message
 66-67		Line signature
 68-69		Line driver type: 1 = DQ11, 2 = KMC11/DUP11, 3 = DUP11 w/o KMC

	SUBTTL Format for SYSERR code 234

Comment &

Node enable/disable

	!			!	Enable/disable code	!
	!		Node name in sixbit			!
	!	Port #		!	Line #			!
	!	Flags		!	Station type		!
	!		Clear to send delay (in jiffies)	!
	!		Silo warning level (in bytes)		!
	!		Bytes per message			!
	!		Records per message			!
	!		Line signature				!


	 Enable/disable code is:

		.CNENB = 1	Enable the line
		.CNDIS = 2	Disable the line (hang-up)

	 Node name is the sixbit name that GALAXY uses for the node

	 Port and line number uniquely describe the synchronous line
	  talking to IBM node

	 Flags are:

		CN$TRA = 1b15		Transparency enabled
		CN$PSP = 1b16		Primary protocol if 1,
					 secondary if 0
		CN$ETF = 1b17		Emulation node if 1, termination if 0

	 Station type is:

		SL378 = 1		3780 protocol
		SL278 = 2		2780 protocol
		SLHSP = 3		HASP multileaving protocol

	 Clear to send delay is a 16 bit value in jiffies.

	 Bytes per message and silo warning level are 16 bit values in bytes.

	 Records per message is a 16 bit value in records.

	 Line signature is a 16 bit value of no dimensions, used for
	  identification only.


	NED.CD==.SYDAT+0		; Enable/disable code
	NED.NM==NED.CD+1		; Node name
	NED.ID==NED.NM+1		; Port,,line (ID)
	NED.FL==NED.ID+1		; Flags,,type
	NED.CS==NED.FL+1		; Clear to send delay
	NED.SW==NED.CS+1		; Silo warning level
	NED.BM==NED.SW+1		; Bytes per message
	NED.RM==NED.BM+1		; Records per message
	NED.SG==NED.RM+1		; Line signature

	NED.SZ==^d9			; Size of entry w/o header
	NED.SH==^d3			; Short entry for disable
	SUBTTL	GLXLIB initialization blocks

	INTVEC==<LEVTAB,,CHNTAB>	; Interrupt vector address

; Initialization block

IB:	$BUILD	IB.SZ			; Size of initialization block
	 $SET	(IB.PRG,,'IBMCON')	;  Program name
	 $SET	(IB.INT,,INTVEC)	;  Interrupt system base
	 $SET	(IB.FLG,IT.OCT,1)	;  Open command terminal
	 $SET	(IB.OUT,,T%TTY)		;  Default $TEXT output routine
	SUBTTL	Local writeables


CPUTYP:	BLOCK	1			; Loop cntr for ports (cpu dependant)
TIMCHK:	BLOCK	1			; Flagged if logging interrupt occured
LOGCHK:	BLOCK	1			; Flagged on entry of LOGGER it TIMCHK
CURTIM:	BLOCK	1			; Current time, start of LOGGER co-rtn
POLFLG:	BLOCK	1			; Flag for polling on current port
WAITFL:	BLOCK	1			; Wait flag .. to process no commands
KSFLG:	BLOCK	1			; Non-zero if on a KS (zero if KL)

PPAGE:	BLOCK	1			; Address of command page
LPAGE:	BLOCK	1			; Address of logging page

PARBLK:	XWD	0,TOPPDB		; First PDB in command syntax
	XWD	0,[ASCIZ /IBMCON>/]	; Prompt
	XWD	0,0			; Address of parsed data page
	XWD	0,0			; Address of string to parse (0=TTY)

PRTLST:	BLOCK	NPORT*P.SIZ		; Port status block storage
LINLST:	BLOCK	NLINE*NPORT*L.SIZ	; Line status block storage

; Software interrupt system data base

LEVTAB:	EXP	LEV1PC			; Where to store PC's for
	EXP	LEV2PC			;  each of the 3 levels that
	EXP	LEV3PC			;  interrupts can occur at

CHNTAB:	EXP	0			; Channel 0 not used
	XWD	TIMLEV,INTTIM		; TIMER interrupts on level 1 CHN 1
	BLOCK	^d34			; Room for other unused channels

LEV1PC:	EXP	0			; PC storage for PSI interrupts
LEV2PC:	EXP	0			;  on each of the levels
	SUBTTL	Startup and initialization

Comment &

  This code is executed at program startup time.  It initializes the
GLXLIB interface, the DN60 interface and the interrupt system.



IBMCON:	RESET				; Clear up everything
	MOVE	P,[IOWD PDLSIZ,PDL]	; Start up the stack
	MOVX	S1,IB.SZ		; Size of initialization block
	MOVEI	S2,IB			; Address of initialization block
	$CALL	I%INIT			; Initialize GLXLIB
	SETZM	KSFLG			; Assume a KL processor
	MOVE	T1,[-4,,10]		; 3 ports, 11,12,13
	MOVE	S1,[.ABGAD,,.FHSLF]	; Retrieve address break
	ADBRK				; to distinguish between KL and KS
	 ERJMP	[SETOM KSFLG		;  Have found a KS processor
		 MOVE T1,[-3,,7]	;  2 ports (lines) 10,11
		 JRST .+1]
	MOVEM	T1,CPUTYP		; Save the port count
	$CALL	D60INI			; Initialize DN60 interface
	$CALL	INTINI			; Initialize the PSI system
	MOVE	S1,[DMYLEV,,DMYCHN]	; Dummy level and channel
	MOVX	S2,INTVEC		;  so that OPRPAR will
	$CALL	P$INIT			;  allow interrupts to break out.
	SETZM	TIMCHK			; Clear timer interrupt flag
	$CALL	M%GPAG			; Get a page for logging
	$CALL	I%ION			; Turn on interrupts and start
	JRST	COMMAND			;  processing
	SUBTTL	Command processing co-routine (COMMAND)

Comment &

  This is the command processor co-routine.  All data base setting for
polling/logging intervals are set here.  When a timer interrupt occurs
the logging co-routine is called.


	$CALL	LOGGER			; Check for polling/logging
	SKIPN	WAITFL			; Check for "WAIT" being done
	 JRST	COMGO			;  No .. go process a command

WAI1ST:	WAIT				; WAIT forever
WAILST:	JRST	COMMAND			; Go process the logging/polling

COMGO:	SETOM	S1			; Reparse flag for no re-prompt
	SKIPN	LOGCHK			; Check for TIMER just serviced
	 MOVX	S1,PAR.SZ		;  No, size of the parser arg block
	MOVEI	S2,PARBLK		; Address of parser argument block
	$CALL	PARSER			; Parse a command
	JUMPT	CMMD.5			; Success in parsing a command

	MOVE	T1,PRT.FL(S2)		; Failed .. get parser flags
	TXNE	T1,P.INTE		; Check for interrupt break out
	 JRST	COMMAND			;  Yes .. execute logger co-routine
	LOAD	T1,PRT.CF(S2)		; Get COMND flags
	TXNE	T1,CM%ESC		; Escape last character?
	 $TEXT	,<>			;  Yes .. move to new line
	SKIPE	T1,PRT.EC(S2)		; Check for ACTION error code
	 JRST	[$TEXT ,<? ^I/@EMSG-1(T1)/>
	$TEXT	,<? ^T/@PRT.EM(S2)/>	; Output error message
	JRST	COMMAND			; Go execute logger co-routine

CMMD.5:	MOVE	S1,PRT.CM(S2)		; Get address of command page
	MOVEM	S1,PPAGE		; Save page address for releasing
	MOVE	S2,COM.PB(S1)		; Get offset to parser blocks
	ADD	S1,S2			; Make address to start of blocks
	$CALL	P$SETUP			; Start semantic parsing
	$CALL	P$KEYW			; Get keyword value
	$CALL	@CMDVEC(S1)		; Vector to processing routine
	MOVE	S1,PPAGE		; Get page address of command
	$CALL	M%RPAG			; Return it to memory manager
	JRST	COMMAND			; Execute logger co-routine


EMSG:	[ITEXT <Port number out of valid range (10-11)>]
	[ITEXT <Port number out of valid range (11-13)>]
	[ITEXT <Line number out of valid range (0-^O/[NLINE-1]/)>]
	SUBTTL	Semantic processing routines

; Routine - DISABLE
; Function - To disable a port polling and any lines that are active.

	$CALL	P$NUM			; Get port number
	MOVE	P1,S1			; Save the port number
	CNVPRT				; Convert port number to address
	SKIPN	P.EN(S1)		; Check if this port is polling
	 JRST	[$TEXT ,<?Port ^O/P1/ is not enabled>
	MOVX	S2,P.STP		; Value to stop polling
	MOVEM	S2,P.EN(S1)		; Stop polling on port, get nmbr lines

; Routine - ENABLE
; Function - To set the start flag for the port which will initialize
;	any lines active during the next execution of the LOGGER co-routine
;	execution.

	$CALL	P$NUM			; Get port number
	MOVE	P1,S1			; Save port number
	CNVPRT				; Convert to status block address
	SKIPE	P.EN(S1)		; Check for port already polling
	 JRST	[$TEXT ,<?Port ^O/P1/ already enabled>
	MOVE	P2,S1			; Save address
	MOVX	S1,P.GO			; Get start status code
	MOVEM	S1,P.EN(P2)		; Set in status block
	$CALL	P$NUM			; Get polling interval (minutes)
	MOVEM	S1,P.INT(P2)		; Put interval into status block

; Routine - EXIT
; Function - To exit to monitor level.  If the program is continued
;	all states will be saved and running.

; Routine - WAITR
; Function - To set that indefinite wait flag. This causes to COMMAND
;	co-routine to stop processing console commands until the flag
;	is cleared.

WAITR:	SETOM	WAITFL			; Set the only flag needed
; Routine - SET
; Function - To set the logging interval for a particular line

SET:	$CALL	P$NUM			; Get line number
	MOVE	P2,S1			; Save it
	$CALL	P$NUM			; Get port number
	MOVE	P1,S1			; Save it also
	$CALL	P$NUM			; Get logging interval
	MOVE	P3,S1			; Save
	DMOVE	S1,P1			; Get port/line number
	CNVLIN				; Convert to line status block addr
	MOVEM	P3,L.INT(S1)		; Set logging interval
	SUBTTL	Port polling and line logging co-routine (LOGGER)

Comment &

  This routine is called whenever the command co-routine goes through
a major command loop.  The command loop is cycled when either a command
is finished or a TIMER interrupt occurs.  If this co-routine is entered
after a timer interrupt has occured, line logging time is check.  If
not, ports are only checked for new enables.


LOGGER:	SETM	LOGCHK			; Clear logging flag
	AOSG	TIMCHK			; Check if any TIMER gone off
	 SETOM	LOGCHK			;  Yes .. say that logging can be done
;	$TEXT	,<- LOGGER called at: ^H/[-1]/>
	$CALL	I%NOW			; Get current time (UDT format)
	MOVEM	S1,CURTIM		; Save it for all logging routines
	MOVE	P1,CPUTYP		; loop index for all ports

LOG.P:	AOBJP	P1,.RETT		; Return if all ports polled
	HRRZ	S1,P1			; Get port number
	CNVPRT				; Convert to port status block address
	MOVE	P3,S1			; Save status block address
	SKIPN	S2,P.EN(S1)		; Check if port polling enabled
	 JRST	LOG.P			;  No .. move onto next port
	CAXE	S2,P.GO			; Check for first time thru
	 JRST	[SKIPN LOGCHK		;  No .. check for TIMER gone off
		  JRST LOG.P		;   No .. continue onto next port
		 JRST  LOG.GO]		;   Yes .. go check lines on port
	$CALL	POLINI			; Initialize port and all line blocks
	 JUMPF	LOG.P			;  If port not running .. goto next
	SETOM	POLFLG			; Set polling flag for lines
	JRST	LOG.LS			; Go start polling loop

LOG.GO:	MOVE	S1,P.NXT(P3)		; Get polling time for this port
	SETZM	POLFLG			; Reset poll time flag
	CAML	S1,CURTIM		; Check if time to poll
	 JRST	LOG.LS			;  No .. just look for logging lines
	SETOM	POLFLG			; Yes .. poll while checking logging
	MOVE	S1,P.INT(P3)		; Get polling interval
	MOVE	S1,P.INT(P3)		; Get polling interval again
	$CALL	TIMSET			; Set a TIMER interrupt for it
	MOVEM	S1,P.NXT(P3)		; Set next time to poll this port

LOG.LS:	MOVNI	P2,1(S2)		; Set up count
	HRLOS	P2			;  and index for line loop
LOG.L:	AOBJP	P2,LOG.P		; Check for anymore lines on port
	HRRZ	S1,P1			; Get port number
	HRRZ	S2,P2			; Get line number
	CNVLIN				; Convert to line status block address
	SKIPN	S2,L.EN(S1)		; Check if line is allowed to log/poll
	 JRST	LOG.L			;  No .. move onto next line
	MOVE	T1,L.NXT(S1)		; Get time for logging
	CAXN	S2,L.LOG		; Check for logging
	CAML	T1,CURTIM		; Is it late enough for logging?
	 JRST	[SKIPE POLFLG		;  Check if port polling now
		  $CALL POLLIN		;   Yes .. poll line
		 JRST LOG.L]		;  Move onto next line
	$CALL	LOGLIN			; Log line counters
	JRST	LOG.L			; Move onto next line
	SUBTTL	Polling initialization for a port

; Routine - POLINI
; Function - To initialize polling on a particular port.  If the port
;	is running the number of lines on it is retrieved.  This is stored
;	in the port status block and each line has the polling (L.POL)
;	set in it's enable block. 
;	If the port is not running, an error message is printed and
;	the polling for the port is disabled.
; Parameters -
;	S1/	Port status block address
;	P1/	RH = port number
; Returns - True/ S2 contains number of lines
;	    False/ if port is not running


	MOVE	P2,S1			; Save status block address
	HRRZ	S1,P1			; Get port number
	$CALL	INIDMY			; Initialize a dummy handle entry
	 JUMPF	PLI.F			;  Can't get a dummy entry
	$CALL	PRTSTS			; Get port status
	 JUMPF	PLI.F			;  Can't get status .. shut down
	$CALL	RLSHAN			; Release handle/front end
	LOAD	T1,,S6LIN		; Get number of lines on port
	CAILE	T1,NLINE		; Maximum line in data base exceeded
	 JRST	[$TEXT ,<%More lines (^O/S2/) on port than allowed (^O/[NLINE]/)>
		 MOVX T1,NLINE		;  Truncate to max
		 JRST .+1]
	MOVEM	T1,P.EN(P2)		; Put into enable word in port status
	MOVE	S1,P.INT(P2)		; Get polling interval
	$CALL	TIMSET			; Set a polling TIMER interrupt
	MOVEM	S1,P.NXT(P2)		; Set next time to poll this port

	MOVE	S2,P.EN(P2)		; Get number of lines again
PLI.L:	SOJL	S2,PLI.R		; Loop over all lines .. return after
	HRRZ	S1,P1			; Get port number
	CNVLIN				; Convert to line status block address
	MOVX	T1,L.POL		; Get poll line enable code
	MOVEM	T1,L.EN(S1)		; Store enable code
	SKIPN	T1,L.INT(S1)		; Get stored logging interval
	 MOVX	T1,DEFLOG		;  Get default logging interval
	MOVEM	T1,L.INT(S1)		; Store appropriate logging interval
	JRST	PLI.L			; Move onto next line

PLI.R:	MOVE	S2,L.EN(P2)		; Get number of lines on port
	$RETT				; Return and check lines

PLI.F:	HRRZ	S1,P1			; Get port number
	$TEXT	,<?Port ^O/S1/ not running.>
	MOVEM	S1,P.EN(P2)		; Stop polling on port
	SUBTTL	LOGLIN logging SYSERR info on a line

; Routine - LOGLIN
; Function - To log SYSERR information about a line specified in the Action
;	Queue data word.  To get this information, hooks into the D60JSY
;	package call internal routines to call the line status (LINSTS)
;	routine and retrieve it's buffer.  The SYSERR header is built
;	and the data copied.  Then it is all shipped to the SYSERR data
;	base by whatever mechanism the system supplies.
;	If the line turns out to be non-active, the node disable SYSERR
;	entry is made and the line status enable code is changed to just
;	polling (L.POL).
; Parameters -
;	S1/	Line status block address
;	P1/	RH = port number
;	P2/	RH = line number
; Returns - always


	HRL	P1,S1			; Save status block address
	MOVE	P3,LPAGE		; Get the address of buffer
	MOVX	S1,SEC%D6		; DN60 line logging code
	MOVX	S2,<LS.BYT+3>/4		; Number of words in entry (w/o header)
	$CALL	SYRHDR			; Make a SYSERR entry header
	HRRZ	S1,P1			; Get port number
	$CALL	INIDMY			; Start up a dummy handle list entry
	 JUMPF	LLG.F			;  Failed to open front end
	STORE	P2,(S2),H$LIN		; Store line number
	STORE	P2,(S2),H$HLN		;  in handle and PDD entries
	$CALL	LINSTS			; Get the line statistics
	 JUMPF	[$CALL RLSHAN		;  Failed .. imply line shut down
	$CALL	RLSHAN			; Release the handle
	HRLM	P1,.SYDAT(P3)		; Put port number
	HRRM	P2,.SYDAT(P3)		;  and line number into data portion
	HRLI	S1,STSBUF		; Get address of status buffer
	HRRI	S1,.SYDAT+1(P3)		; Address of SYSERR data body
	BLT	S1,.SYDAT+1+<LS.BYT+3>/4(P3) ; Move it all
	MOVE	S1,P3			; Get address of SYSERR entry
	MOVX	S2,.SYDAT+1+<LS.BYT+3>/4 ; Length of the total entry
	SYERR				; Dump it to SYSERR data base
	HLRZ	S2,P1			; Get address of line status block
	MOVE	S1,L.INT(S2)		; Get logging interval
	$CALL	TIMSET			; Set a timer interrupt for then
	MOVEM	S1,L.NXT(S2)		; Store the future time to log again
	JRST	POL.CK			; Go check for status claiming line
					;  gone away.

LLG.F:	$CALL	LINDWN			; Record that line has died
	HRLZ	S1,P1			; Get line status block address
	MOVX	S2,L.POL		; Stop logging .. poll only
	MOVEM	S2,L.EN(S1)		; Put into line enable flag
	SUBTTL	POLLIN Polling lines for lines come up/gone away

; Routine - POLLIN
; Function - To poll a specific line, checking for a state transition.
;	If the line has come up, the line is activated for logging and
;	a node enable entry is made in SYSERR.  If the line has gone down,
;	the line is put back into polling state and a node disable entry
;	is made.
; Parameters -
;	S1/	Line status block address
;	P1/	RH = port number
;	P2/	RH = line number


	HRL	P1,S1			; Save status block address
	HRRZ	S1,P1			; Get port number
	$CALL	INIDMY			; Initialize a handle list entry and FE
	 JUMPF	PLL.G			;  Line has gone away for good.
	STORE	P2,(S2),H$LIN		; Store line number
	STORE	P2,(S2),H$HLN		;  in handle and PPD entries
	$CALL	LINSTS			; Get the status
	 JUMPF	[$CALL RLSHAN		;  Failed .. release FE device
		 JRST PLL.G]		;  Line has gone away
	$CALL	RLSHAN			; Release the handle here also

POL.CK:	LOAD	S1,,SLFLG		; Get line flags
	TXNE	S1,SLHWA		; Check hardware abort flag
	 JRST	PLL.G			;  Yes .. line gone away
	LOAD	S1,,SLINF		; Get line info flags
	TXNN	S1,SLDSR		; Check DSR set flag
	 JRST	PLL.G			;  No DSR .. line down
	HLRZ	S1,P1			; Get line status block address
	MOVE	S2,L.EN(S1)		; Get logging state of line
	CAXN	S2,L.LOG		; Check for line is already logging
	 $RETT				;  Yes .. just return, line is ok
	$CALL	LINUP			; Record that line has been enabled
	MOVX	S2,L.LOG		; Make this line now in the
	MOVEM	S2,L.EN(S1)		;  logging state
	MOVE	S1,L.INT(S1)		; Get logging interval
	$CALL	TIMSET			; Set a TIMER interrupt for loggin
	HLRZ	S2,P1			; Get line status block address again
	MOVEM	S1,L.NXT(S2)		; Store time in future for logging
	$RETT				; Return

PLL.G:	HLRZ	S1,P1			; Get line status block address
	MOVE	S2,L.EN(S1)		; Get logging state of line
	CAXN	S2,L.POL		; Check for line only polling
	 $RETT				;  Yes .. not a state transition
	$CALL	LINDWN			; Record that line has died
	MOVX	S2,L.POL		; Get line polling state
	MOVEM	S2,L.EN(S1)		; Put line back to polling only
	SUBTTL	Line gone down SYSERR recording

; Routine - LINDWN
; Function - To make the SYSERR entry stating that the line has gone
;	down.
; Parameters -
;	P1/	RH = port number
;	P2/	RH = line number

LINDWN:	$SAVE	<S1,S2,P3>		; Save some registers

	MOVE	P3,LPAGE		; Get address of logging page
	MOVX	S1,SEC%DE		; Line enable/disable entry
	MOVX	S2,NED.SH		; Short entry
	$CALL	SYRHDR			; Make header for this entry
	MOVX	S1,.CNDIS		; Line disable
	HRRZM	S1,NED.CD(P3)		; Put in enable/disable code
	SETZM	NED.NM(P3)		; Don't know node name
	HRLM	P1,NED.ID(P3)		; Store port number
	HRRM	P2,NED.ID(P3)		; Store line number
	MOVE	S1,P3			; Get address of entry
	MOVX	S2,NED.SH+.SYDAT	; Total length of entry
	SYERR				; Put in ERROR.SYS file
	SUBTTL	Line come up SYSERR recording

; Routine - LINUP
; Function - To make the SYSERR entry stating that the line has come up.
; Parameters -
;	P1/	RH = port number
;	P2/	RH = line number
;	STSBUF/	Current line status

LINUP:	$SAVE	<S1,S2,P3>		; Save some registers

	MOVE	P3,LPAGE		; Get address of logging page
	MOVX	S1,SEC%DE		; Line enable/disable entry
	MOVX	S2,NED.SZ		; Length of entry
	$CALL	SYRHDR			; Make header for this entry
	MOVX	S1,.CNENB		; Line enable
	HRRZM	S1,NED.CD(P3)		; Put in enable/disable code
	SETZM	NED.NM(P3)		; Don't know node name
	HRLM	P1,NED.ID(P3)		; Store port number
	HRRM	P2,NED.ID(P3)		; Store line number
	LOAD	S1,,SLCSD		; Transfer clear to send delay
	LOAD	S1,,SLSWL		; Transfer silo warning level
	LOAD	S1,,SLBPM		; Transfer bytes per message
	LOAD	S1,,SLRPM		; Transfer records per message
	LOAD	S1,,SLSIG		; Transfer line signature
	MOVE	S1,P3			; Get address of entry
	MOVX	S2,NED.SZ+.SYDAT	; Total length of entry
	SYERR				; Put in ERROR.SYS file

	SUBTTL	SYSERR entry header creation

; Routine - SYRHDR
; Function - To create a SYSERR entry header containing the pertinent
;	data.
; Parameters -
;	S1/	SYSERR Event code
;	S2/	Length of entry (without header)
;	P3/	Address of SYSERR block
; Returns - yes

SYRHDR:	STORE	S1,(P3),SYCOD		; Store event code (SY%XXX)
	STORE	S2,(P3),SYLEN		; Store length of entry
	MOVX	S1,4			; Get length of SYSERR entry header
	STORE	S1,(P3),SYHLN		; Store in header
	MOVX	S1,1			; Get version of SYSERR header
	STORE	S1,(P3),SYVER		; Store in header
	SETO	S1,			; Turn on all the bits (only for one)
	STORE	S1,(P3),SYT20		; Note that this entry made by TOPS-20
	GTAD				; Get current time and date
	STORE	S1,(P3),SYDAT		; Store time and date in entry
	TIME				; Get current uptime
	IDIV	S1,[<^D1000*^D3600*^D24>/<1_^D18>] ; Convert to days,,fractions of days
	STORE	S1,(P3),SYUPT		; Store uptime in entry header
	MOVE	S1,[SIXBIT/APRID/]	; Get table name
	SYSGT				; Get processor serial number
	STORE	S1,(P3),SYPSN		; Save processor serial number
	SUBTTL	Interrupt system management

; Routine - INTINI
; Function - To initialize the interrupt system.  After this routine is
;	executed, interrupts will be allowed to come in.
; Parameters - none
; Returns - Success always
; Notes - Turns the interrupt system on

INTINI:	MOVX	S1,.FHSLF		; Point to this process
	MOVX	S2,1b<TIMCHN>		; TIMER interrupts
	AIC				; Activate the system
	CIS				; Clear interrupt system
	SUBTTL	Interrupt service routines

; Routine - INTTIM
; Function - To flag a "TIMER gone off" event to the command parser so
;	that the parser will return and logging/polling can be executed.
; Parameters - none
; Returns - to non-interrupt level
; Notes - The data word in the queue entry is the time of day that the
;	interrupt occured.

INTTIM:	$BGINT	TIMLEV			; Start service for level 1

	SETOM	TIMCHK			; Say that TIMER has gone off
	$CALL	P$INTR			; Flag to PARSER for command break out
	MOVX	S1,.FHSLF		; Point to this process
	MOVX	S2,1b<DMYCHN>		; Interrupt for the OPRPAR
	IIC				; TIMER interrupt services
	MOVX	S2,1b5			; User mode flag
	HRRZ	S1,LEV1PC		; Get address of interrupted execution
	CAIL	S1,WAI1ST		; Check for bounds
	CAILE	S1,WAILST		;  of the "WAIT" command routine
	IORM	S2,LEV1PC		; Turn on user mode .. break from WAIT
	$DEBRK				; Go back to non-interrupt level

; Routine - TIMSET
; Function - To set a TIMER interrupt.
; Parameters -
;	S1/	Incremental time for interrupt (from now) in minutes
;	CURTIM/	Current time in UDT format
; Returns - 
;	S1/	UDT format time that interrupt will occur

TIMSET:	$SAVE	<S2,T1,P1>		; Save the registers
	MOVE	P1,S1			; Save time (minutes)
	IMULI	S1,^d60*^d1000		; Change time to milliseconds
	MOVSI	S1,.FHSLF		; Point to this process
	HRRI	S1,.TIMEL		; Elapsed time function
	HRRZI	T1,TIMCHN		; Get channel for interrupt
	TIMER				; Set the interrupt
	 ERJMP	[$STOP UST,<Unable to set timer interrupt>]
	IMULI	P1,^d3*^d60		; Convert to third of second
	MOVE	S1,CURTIM		; Get current time
	ADD	S1,P1			; Make into future time
;	$TEXT	,< - TIMSET interrupt set for: ^H/S1/>
	SUBTTL	Command syntax tables

TOPPDB:	$INIT	(TOP.1)			; Top level initialization
TOP.1:	$KEYDSP	(TOP.2)			; First key word


; DISABLE (polling on port) nn

DISPDB:	$NOISE	(DIS001,<polling on port>)
DIS001:	$NUMBER	(DIS002,^d8,<Port number>,<$Action (PRTCHK)>)

; ENABLE (polling on port) nn (interval) mm

ENAPDB:	$NOISE	(ENA001,<polling on port>)
ENA001:	$NUMBER	(ENA002,^d8,<Port number>,<$Action (PRTCHK)>)
ENA002:	$NOISE	(ENA003,<interval>)
ENA003:	$NUMBER	(ENA004,^d10,<minutes between polling>,<$Default (10)>)

; SET (logging interval on line) ll (port) pp (interval) mm

SETPDB:	$NOISE	(SET001,<logging interval on line>)
SET001:	$NUMBER	(SET002,^d8,<Line number>,<$Action (LINCHK)>)
SET002:	$NOISE	(SET003,<port>)
SET003:	$NUMBER	(SET004,^d8,<Port number (11-13)>,<$Action (PRTCHK)>)
SET004:	$NOISE	(SET005,<interval>)
SET005:	$NUMBER	(SET006,^d10,<minutes between logging>,<$Default (60)>)

WAIPDB:	$NOISE	(WAI001,<forever>)
	SUBTTL	Command action routines

; Routine - PRTCHK
; Function - To validate the range of a port number.  It must be between
;	10 and 11 (inclusive) on the KS and 11 and 13 (inclusive)
;	on the KL.
; Parameters - Standard parser action routine

PRTCHK:	SKIPE	KSFLG			; Check for a KS processor
	 JRST	KS			;  Yes .. go check for "lines"
	MOVE	T1,CR.RES(S2)		; Get value that was input
	CAIL	T1,11			; Check for less than minimum
	CAILE	T1,10+NPORT-1		; or greater than max
	 JRST	[MOVX S1,.ERR2		;  Yes .. give error return

KS:	MOVE	T1,CR.RES(S2)		; Get input value
	CAIL	T1,10			; Check for less than min
	CAILE	T1,11			; or greater than max
	 JRST	[MOVX S1,.ERR1		;  Yes, give error return

; Routine - LINCHK
; Function - To validate the range of a line number.  It must be between
;	0 and NLINE (inclusive).
; Parameters - Standard parser action routine

LINCHK:	MOVE	T1,CR.RES(S2)		; Get value input
	CAIL	T1,0			; Check for negative line
	CAILE	T1,NLINE-1		; or greater than max lines
	 JRST	[MOVX S1,.ERR3		;  Yes .. give error return