Google
 

Trailing-Edge - PDP-10 Archives - BB-J845A-SM - source/d60jsy.mac
There are 66 other files named d60jsy.mac in the archive. Click here to see a list.
;<DN65-DEVELOPMENT>D60JSY.MAC.59, 28-Jan-80 11:07:32, Edit by JENNESS
; [207] Remove superfluous LC.CTR command in D60CND
;<DN65-DEVELOPMENT>, 26-Jan-80 11:53:06, Edit by JENNESS
; [206] Fix bug in D60STS line status routine that didn't return
;	D6LGA error (just returned error code 3: reject).
;<DN65-DEVELOPMENT>D60JSY.MAC.55, 17-Dec-79 13:17:20, Edit by JENNESS
; [205] Change to a better 2020 test routine than checking serial number.
;<DN65-DEVELOPMENT>D60JSY.MAC.6,  4-Dec-79 13:35:42, Edit by JENNESS
; [204] Fix up code to do proper termination signon validation
;<DN65-DEVELOPMENT>D60JSY.MAC.3, 18-Oct-79 15:19:52, Edit by JENNESS
; [203] Decouple D60UNV from D60JSY because of QSRMAC deadly embrace.
;<DN65-DEVELOPMENT>D60JSY.MAC.2,  9-Oct-79 14:26:28, Edit by JENNESS
; [202] Add code in D60CND to support transparent transmission enabling
;       for HASP lines.
;<DN65-DEVELOPMENT>D60JSY.MAC.256,  7-Sep-79 10:19:19, Edit by JENNESS
; [201] Remove edit 175 .. the BOOT JSYS has been fixed.
;<DN65-DEVELOPMENT>D60JSY.MAC.252,  4-Sep-79 15:29:44, Edit by JENNESS
; [200] Remove CONLY conditionals, remove QSRMAC symbol conflicts.
;<DN65-DEVELOPMENT>D60JSY.MAC.250,  4-Sep-79 13:50:44, Edit by JENNESS
; [177] Change arg block to condition call again .. make it QUASAR setup block.
;<DN65-DEVELOPMENT>D60JSY.MAC.249, 15-Aug-79 09:43:42, Edit by JENNESS
; [176] Change D6DNU error so that IBMSPL can turn it off in NBIO.
;<DN65-DEVELOPMENT>D60JSY.MAC.248, 14-Aug-79 09:17:23, Edit by JENNESS
; [175] Change 2020 read routine to do it's own byte pointer updating,
;	the BOOT JSYS doesn't do it.
;<DN65-DEVELOPMENT>D60JSY.MAC.247, 16-Jul-79 14:11:56, Edit by JENNESS
; [174] Add external HOOKing code, gives access to guts of this package.
;<DN65-DEVELOPMENT>D60JSY.MAC.246, 11-Jul-79 16:17:53, Edit by JENNESS
; [173] Give D6DNU (DSR not up) on D60OPN call at appropriate times.
;<DN65-DEVELOPMENT>D60JSY.MAC.244,  5-Jul-79 15:28:28, Edit by JENNESS
; [172] Give reject error code when DN6x gives no bytes read with success code.
;<DN65-DEVELOPMENT>D60JSY.MAC.240,  2-Jul-79 16:25:45, Edit by JENNESS
; [171] Fix another dumb bug in FEI%O for TOPS10.
;<DN65-DEVELOPMENT>D60JSY.MAC.238, 29-Jun-79 13:58:07, Edit by JENNESS
; [170] Another fix for 2780/3780 input/output deadlock race on input EOF.
;<DN65-DEVELOPMENT>D60JSY.MAC.237, 29-Jun-79 13:22:48, Edit by JENNESS
; [167] Typo fix in FEI%O for TOPS10.
;<DN65-DEVELOPMENT>D60JSY.MAC.235, 29-Jun-79 09:04:39, Edit by JENNESS
; [166] Change the ERRS macro to give DDT type out of the error values.
;<DN65-DEVELOPMENT>D60JSY.MAC.235, 29-Jun-79 09:00:27, Edit by JENNESS
; [165] Fix REQOUT to relieve the lost output grant.
;<DN65-DEVELOPMENT>D60JSY.MAC.233, 28-Jun-79 17:59:05, Edit by JENNESS
; [164] Fix to stop deadlock interaction between console and LPT under 3780.
;<DN65-DEVELOPMENT>D60JSY.MAC.231, 26-Jun-79 09:00:59, Edit by JENNESS
; [163] Swap the line signature and line driver type in line status, makes it
;	easier for front end to clear an old LCB.
;<DN65-DEVELOPMENT>D60JSY.MAC.230, 25-Jun-79 16:24:37, Edit by JENNESS
; [162] Change last D6DOL in REQOUT to a D6CGO .. fixes console deadly embrace.
;<DN65-DEVELOPMENT>D60JSY.MAC.229, 25-Jun-79 09:33:46, Edit by JENNESS
; [161] Another fix in edit 153 when DTE is already selected.
;<DN65-DEVELOPMENT>D60JSY.MAC.225, 21-Jun-79 10:41:06, Edit by JENNESS
; [160] Fix the horrible mess made when releasing devices on disabled lines.
;<DN65-DEVELOPMENT>D60JSY.MAC.224, 21-Jun-79 08:53:45, Edit by JENNESS
; [157] Fix REQOUT to check for line gone away in DSRLP.
;<DN65-DEVELOPMENT>D60JSY.MAC.225, 19-Jun-79 09:43:59, Edit by JENNESS
; [156] Fix a problem in OPNFE caused by edit 153 when FEJFN already open.
;<DN65-DEVELOPMENT>D60JSY.MAC.223, 18-Jun-79 13:11:44, Edit by JENNESS
; [155] Change FEI%O for TOPS10 to use reentrant type C11BLKs.
;<DN65-DEVELOPMENT>D60JSY.MAC.222, 15-Jun-79 16:44:48, Edit by JENNESS
; [154] Fix a glaring error in SRCPDD that has been there forever.
;<DN65-DEVELOPMENT>D60JSY.MAC.221, 14-Jun-79 16:54:35, Edit by JENNESS
; [153] Change a little in OPNFE to jump to SELDTE if JFN already assigned.
;<DN65-DEVELOPMENT>D60JSY.MAC.220, 14-Jun-79 15:22:36, Edit by JENNESS
; [152] Add code to release all devices opened on a D60CND line disable.
;<DN65-DEVELOPMENT>D60JSY.MAC.211, 12-Jun-79 13:54:04, Edit by JENNESS
; [151] Add printx to output name, version and other sundries during assembly.
;<DN65-DEVELOPMENT>D60JSY.MAC.209, 12-Jun-79 11:37:27, Edit by JENNESS
; [150] Append line and device command strings to FEI%O arg block. Get rid of
;	the ALC1WD and RLS1WD routines.
;<DN65-DEVELOPMENT>D60JSY.MAC.209, 12-Jun-79 11:36:40, Edit by JENNESS
; [147] Change the status string symbols so SWAPB and SWAP32 aren't needed.
;<DN65-DEVELOPMENT>D60JSY.MAC.208, 12-Jun-79 09:45:35, Edit by JENNESS
; [146] Move some more symbols into the D60JSY.UNV universal file.
;<DN65-DEVELOPMENT>D60JSY.MAC.206, 11-Jun-79 11:19:10, Edit by JENNESS
; [145] Fix a bug in D60SOUT (bad load) and add IOWAIT to SNOOZE in REQOUT.
;<DN65-DEVELOPMENT>D60JSY.MAC.204,  8-Jun-79 09:40:54, Edit by JENNESS
; [144] Add return immediate code in FEI%O to stop blocking on console read.
;<DN65-DEVELOPMENT>D60JSY.MAC.203,  7-Jun-79 17:20:51, Edit by JENNESS
; [143] Change in REQIN to reduce the possibility of a race.
;<DN65-DEVELOPMENT>D60JSY.MAC.202,  7-Jun-79 15:33:57, Edit by JENNESS
; [142] Change status formats to reflect more frontend bullet proofing.
;<DN65-DEVELOPMENT>D60JSY.MAC.199,  7-Jun-79 10:55:08, Edit by JENNESS
; [141] Fix D60SOUT for errors that are appropriate the running flag is cleared
;<DN65-DEVELOPMENT>D60JSY.MAC.197,  7-Jun-79 10:36:37, Edit by JENNESS
; [140] Some fixes for line status failure and a D60RLS on dead lines.
;<DN65-DEVELOPMENT>D60JSY.MAC.196,  7-Jun-79 09:37:23, Edit by JENNESS
; [137] Fix a problem in REQIN that failed it input was already running.
;<DN65-DEVELOPMENT>D60JSY.MAC.194,  6-Jun-79 16:42:57, Edit by JENNESS
; [136] Fix a bug in the DSR wait loop in REQOUT.
;<DN65-DEVELOPMENT>D60JSY.MAC.193,  6-Jun-79 09:32:56, Edit by JENNESS
; [135] Add IOWAIT argument to the SNOOZE macro for task descheduling.
;<DN65-DEVELOPMENT>D60JSY.MAC.191,  4-Jun-79 09:21:51, Edit by JENNESS
; [134] Dump output buffers (in 11) if outputing to a console device.
;<DN65-DEVELOPMENT>D60JSY.MAC.187,  1-Jun-79 10:58:38, Edit by JENNESS
; [133] Add code to handle new line hardware abort checking.
;<DN65-DEVELOPMENT>D60JSY.MAC.184, 30-May-79 16:18:50, Edit by JENNESS
; [132] Don't clear aborts in REQIN/REQOUT, now only set for valid reasons.
;<DN65-DEVELOPMENT>D60JSY.MAC.183, 30-May-79 13:32:02, Edit by JENNESS
; [131] More fixes for device error handling and input/output deadlock.
;<DN65-DEVELOPMENT>D60JSY.MAC.176, 25-May-79 16:23:21, Edit by JENNESS
; [130] Handle aborts caused by line disconnection.
;<DN65-DEVELOPMENT>D60JSY.MAC.175, 24-May-79 15:14:16, Edit by JENNESS
; [127] Fix D60EOF and the line releasing code for 2780/3780.
;<DN65-DEVELOPMENT>D60JSY.MAC.172, 23-May-79 15:21:46, Edit by JENNESS
; [126] Fix D60OPN to properly handle errors on the device commands.
;<DN65-DEVELOPMENT>D60JSY.MAC.172, 23-May-79 15:21:22, Edit by JENNESS
; [125] Have found some more holes in the FE releasing.
;<DN65-DEVELOPMENT>D60JSY.MAC.168, 21-May-79 11:41:31, Edit by JENNESS
; [124] More fixes for properly releasing FE devices.
;<DN65-DEVELOPMENT>D60JSY.MAC.167, 21-May-79 09:38:50, Edit by JENNESS
; [123] Add structure block sizes in universal file.
;<DN65-DEVELOPMENT>D60JSY.MAC.165, 21-May-79 09:36:35, Edit by JENNESS
; [122] Another fix in REQOUT to release the line when input is coming.
;<DN65-DEVELOPMENT>D60JSY.MAC.161, 17-May-79 18:11:01, Edit by JENNESS
; [121] Fix so FE is properly released if DTE select fails.
;<DN65-DEVELOPMENT>D60JSY.MAC.160, 16-May-79 11:21:33, Edit by JENNESS
; [120] Fix write routine to release FE for a second after lot of data output.
;<DN65-DEVELOPMENT>D60JSY.MAC.159, 16-May-79 11:11:28, Edit by JENNESS
; [117] Change ENQD60 to block until lock is gained. Gives higher lock hits.
;<DN65-DEVELOPMENT>D60JSY.MAC.157, 16-May-79 09:22:10, Edit by JENNESS
; [116] Remove copy code for 8 bit DDCMP buffer, now can handle real byte ptrs.
;<DN65-DEVELOPMENT>D60JSY.MAC.152, 14-May-79 14:51:26, Edit by JENNESS
; [115] Add line signature code.
;<DN65-DEVELOPMENT>D60JSY.MAC.146, 10-May-79 12:42:28, Edit by JENNESS
; [114] Fix so delays from the FE on line commands resend command correctly.
;<DN65-DEVELOPMENT>D60JSY.MAC.145, 10-May-79 11:17:39, Edit by JENNESS
; [113] Change location of $FELOG logging calls in FEI%O.
;<DN65-DEVELOPMENT>D60JSY.MAC.144, 10-May-79 10:20:00, Edit by JENNESS
; [112] Add require for FELOG when FTDEBUG switch is turned on.
;<DN65-DEVELOPMENT>D60JSY.MAC.143,  3-May-79 09:57:26, Edit by JENNESS
; [111] And yet another fix for the deadlock problem, release if REQOUT fails.
;<DN65-DEVELOPMENT>D60JSY.MAC.141,  2-May-79 14:29:16, Edit by JENNESS
; [110] Another fix to stop input/output deadlocks on 2780/3780.
;<DN65-DEVELOPMENT>D60JSY.MAC.140,  1-May-79 16:48:50, Edit by JENNESS
; [107] Increase retry counter for BOOT JSYS retry on input.
;<DN65-DEVELOPMENT>D60JSY.MAC.139,  1-May-79 16:33:52, Edit by JENNESS
; [106] Some code clean up, more on the abort problem, and really use D60CGO.
;<DN65-DEVELOPMENT>D60JSY.MAC.137, 30-Apr-79 12:57:04, Edit by JENNESS
; [105] Fix input request code to block less and add better errors to D60CND.
;<DN65-DEVELOPMENT>D60JSY.MAC.133, 25-Apr-79 16:18:22, Edit by JENNESS
; [104] Put in error checks after device and line status calls.
;<DN65-DEVELOPMENT>D60JSY.MAC.129, 25-Apr-79 13:47:32, Edit by JENNESS
; [103] Fix so that the line isn't released if the device goes off line.
;<DN65-DEVELOPMENT>D60JSY.MAC.127, 25-Apr-79 08:25:46, Edit by JENNESS
; [102] Add device command in D60OPN to do space compression.
;<DN65-DEVELOPMENT>D60JSY.MAC.124, 24-Apr-79 14:39:33, Edit by JENNESS
; [101] Add code to ENQ/DEQ line for 2780/3780 so only 1 device can be active
;	at a time.
;   D60JSY - Interface package for DN62/DN65 Galaxy IBM spooling system

;
;
;			COPYRIGHT (c) 1979, 1980
;                    DIGITAL EQUIPMENT CORPORATION
;
;     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.
;
;	TITLE	D60JSY	DN62/DN65 interface to GALAXY spooling components.

	SALL				; Make nice clean listings

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

	SEARCH	GLXMAC			; Use GALAXY group's macros/symbols
	SEARCH	QSRMAC			; Symbols for setup message
	SEARCH	ORNMAC			; Symbols to talk to ORION
	SEARCH	D60UNV			; Search for linkage symbols
	PROLOGUE (D60JSY)		; Initialize Galaxy symbol definitions

; Version

	XP	D60VER,	3		; Major version number
	XP	D60MIN,	0		; Minor version number
	XP	D60EDT,	207		; Edit level
	XP	D60WHO,	0		; Who did last edit (0=DEC)

; Conditional assembly flags.

	ND	FTDEBUG, 0		; If on .. then generate debuging code

	ND	FTNDNU,	0		; Normally give the D6DNU error.

IFN FTDEBUG,<.REQUIRE FELOG>		; Get CAL11. logger if debugging

; Version

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

; Print information to log during compilation

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

IF1,<
 IFN <D60MIN>,<VOUTX (D60JSY interface package,\D60VER,\"<"A"+D60MIN>,\D60EDT)>
 IFE <D60MIN>,<VOUTX (D60JSY interface package,\D60VER,,\D60EDT)>

 IFN <FTDEBUG>,<PRINTX Debug code enabled.>
 .IF SNOOZE,MACRO,<PRINTX External SNOOZE macro definition being used.>

 .IF HOOK,MACRO,<PRINTX External HOOK has been defined.
	HOOK			; Invoke the HOOK
     > ;End if HOOK defined
    > ;End IF1

IF2,<Printx Pass 2.>
	SUBTTL	Misc. definitions

; Warning: do not change timing values untill all error paths have been
;	thoroughly checked.

	XP	SEC,	^d1000		; 1000 milliseconds in a second
	XP	TIMOFF,	^d3		; Time off to wait for 11 to be freed
	XP	TIMDLY,	^d1		; Time waiting for delayed to clear
	XP	TIMSTS,	^d2		; Time waiting on delayed status
	XP	OFLDFL,	^d10		; Default number of delay to offline
	XP	RQREP,	^d12		; Times to check input permission req
	XP	RQTIM,	^d1		; Sleep time between input per req chk
	XP	SONREP,	^d60		; One minute of signon input timeout
	XP	RQOTIM,	^d30		; Number of seconds to wait for DSR
	XP	SOTDLY,	^d1		; Sleep time between output grant chks
	XP	RQDTRY,	^d10		; Times to chk after output req. drops
	XP	TIMDSR,	^d1500		; Time to wait between DSR check (ms)
	XP	DTEOFF,	10		; Offset from port number to DTE number
	XP	MAXDTE,	13		; Maximum DTE number
	XP	MAXFE,	15		; Maximum number of FE's on system
	XP	MXNHSP,	5		; Maximum device type on 2780/3780
	XP	MXHSP,	6		; Maximum device type on HASP
	XP	MXUHSP,	4		; Maximum unit number on HASP
	XP	HSPOFF,	20		; HASP multiple device offset
	XP	RLSTHR,	^d2000		; FE device transfer release threshold
	SUBTTL	Error symbol definitions

; Use the previously defined macros in D60JSY.UNV to set up the error symbol
; values.

	D60ERR				; Invoke the error symbol macro
	SUBTTL	Macros -- ERT, Snooze

; Macro - ERT
;
; Function - To set an error code in S1 and jump to the specified exit vector.
;
; Parameters -
;
;	$%ERR	Error number (usually a D6xxx mnemonic)
;	$%VEC	Where to jump to after S1 is loaded with the error number

	Define ERT ($%ERR,$%VEC)

<[MOVX	S1,$%ERR		;; Load the error number to return
  IFNB <$%VEC>,<SETZ TF,	;; Set success flag to failure (false)
		JRST $%VEC>	;; If a jump vector given .. then jump there
  IFB  <$%VEC>,<JRST @.RETF>	;;  else give a default of false return
	]
   > ;End of ERT definition


; Macro - Snooze
;
; Function - To put the process to sleep for the specified amount of time.
;
; Parameters -
;
;	$%TIM	# of milli-seconds to sleep
;	$%DUM	Dummy argument (used by externally defined SNOOZE's)
;
; Note -
;
;	This macro is used to dismis the process because of a event wait. If
;	the host program wishes to instead of sleeping reschedule an internal
;	task this macro should be defined in a file that will prefix this one
;	during assembly. This macro generates code that is non-skipable and
;	will always preserve the intergrity of the registers.

.IFN SNOOZE,MACRO,<
	Define SNOOZE ($%TIM,$%DUM)

<	MOVX	S1,$%TIM		;; Get number of milliseconds to sleep
TOPS10 <SLEEP	S1,>			;; Use SLEEP MUUO on TOPS10
TOPS20 <DISMS>				;;  and on TOPS20 dismiss the process
					;;  for the number of mS given.
    > ;End SNOOZE definition
   > ;End if SNOOZE not defined
	SUBTTL	Macros -- $LNCMD, $DVCMD

; Macro - $LNCMD
;
; Function - To set up the arguments to the line command routine (LINCMD)
;
; Parameters -
;
;	$%CMD	Command number
;	$%VEC	Where to vector to on command failure

	Define $LNCMD ($%CMD,$%VEC)

<	MOVX	S1,$%CMD		;; Load the command number
	$CALL	LINCMD			;; Call the line command routine
IFNB <$%VEC>,<JUMPF $%VEC>		;; Command failure .. jump
    > ;End $LNCMD definition

; Macro - $DVCMD
;
; Function - To set up the arguments to the device command routine (DEVCMD)
;
; Parameters -
;
;	$%CMD	Command number
;	$%VEC	Where to vector to on command failure

	Define $DVCMD ($%CMD,$%VEC)

<	MOVX	S1,$%CMD		;; Load the command number
	$CALL	DEVCMD			;; Call the device command routine
IFNB <$%VEC>,<JUMPF $%VEC>		;; Command failure .. jump
    > ;End $DVCMD definition
	SUBTTL	Macros -- $FELOG

; Macro - $FELOG
;
; Function - This macro generates the conditional code, depending on value
;	     of FTDEBUG, for writing entries to the CAL11. log file.
;
; Parameters -
;
;	$%PHSE	Phase of logging, "BEFORE" or "AFTER"

	Define $FELOG ($%PHSE)

<IFN FTDEBUG,<				;; If debugging enabled
	%%.PHS==0			;; Init to no phase defined yet
	IFIDN <$%PHSE>,<BEFORE>,<%%.PHS==PHSBEF> ;; Before CAL11.
	IFIDN <$%PHSE>,<AFTER>, <%%.PHS==PHSAFT> ;; After CAL11.
	IFE %%.PHS,<IF1,<PRINTX $FELOG called with illegal phase: "'$%PHSE'">>

	JRST	[MOVX	T4,%%.PHS	;; Load the phase value
TOPS10 <	 IOR	T4,P3>		;; Point to the CAL11. argument block
TOPS20 <
IFIDN <$%PHSE>,<BEFORE>,<IORI T4,XMTHDR>;; Before transmission .. give XMT hdr
IFIDN <$%PHSE>,<AFTER>,<IORI T4,RCVHDR> ;; After .. give RCV header
   > ;End if TOPS20
		 $CALL	FELOG##		;; Yes .. call logging routine
		 JRST	.+1]		;; Return to main line

	PURGE	%%.PHS			;; Kill the extraneous symbol
    >> ;End $FELOG definition
	SUBTTL	Global routine -- D60INI

; Routine - D60INI
;
; Function - To initialize internal data bases to the D60 communication package.
;	This routine assumes that a "RESET" has already been done that will
;	clear all ENQ/DEQ requests/entries and all device/JFN assignments.
;
; Parameters - none

	ENTRY	D60INI

D60INI:	$SAVE	<S1,S2>			; Save registers

	HRRZ	S1,SONSTR		; Get length of the table
	SETZM	SONSTR+1		; Clear the first entry
	CAIN	S1,1			; Check for only one entry
	 JRST	D6I.1			;  Yes .. so skip BLT
	MOVE	S2,[SONSTR+1,,SONSTR+2]	; Standard zero BLTing argument
	ADDI	S1,SONSTR		; Find end of the table
	BLT	S2,(S1)			; Clear the table

D6I.1:
TOPS20< MOVEI	S1,LOCALS		; Get location of local data base
	LSH	S1,-^d9			; Convert to page number
	HRLI	S1,.FHSLF		; This process handle
	MOVX	S2,PA%RD+PA%WT+PA%EX+PA%CPY
	SPACS				; Change locals to COPY-ON-WRITE
	 ERJMP	@.RETF			;  on failure .. give error return
	MOVEI	S1,ENDLOC		; Get where the locals end
	LSH	S1,-^d9			; Convert to a page number
	HRLI	S1,.FHSLF		; Point to this process
	MOVX	S2,PA%RD+PA%WT+PA%EX+PA%CPY
	SPACS				; Change up to end of locals to C-O-W

	SETZM	FEJFN			; Clear the JFN for I/O to the FE
	SETZM	LSTDTE			; Clear the last DTE to be selected.
    >; End if TOPS20

	SETOM	HANLST			; Clear the handle list name
ININHN:
TOPS20 <MOVX	S1,.DEQDA		; Dequeue all locks for this process
	DEQ>
TOPS10 <HRLI	S1,.DEQDA		; Dequeue all locks for this job
	DEQ.	S1,>
	 JFCL				;  No relevant errors can occur

TOPS20 <MOVX	S1,.FHSLF		; Point to this process again
	MOVX	S2,LSTRX1		; No last error, error code
	SETER>				; Clear any error up to this point

	$RETT				; It worked (it should).
	SUBTTL	Global routine -- D60OPN

; Routine - D60OPN
;
; Function - To setup a device on a remote station (or link up to 360/370) and
;	define a unique handle that will describe this link.
;
; Parameters -
;
;	S1/	-Count of argument block
;	S2/	Location of open block
;
;		or
;
;	S1/	Dev-type,,Unit
;	S2/	Port,,Line
;
;	The device type codes are:
;	  1=LPT, 2=CDP, 3=CDR, 4=Console in, 5=Console out, 6=Signon
;
;	Format of open block:
;
;	ARGBLK/   Dev-type,,Unit
;	ARGBLK+1/ Port,,Line
;	ARGBLK+2/ Line signature
;
; Returns -
;
;	True	S1/ Handle used for referencing the device
;	False	S1/ Error code
;

	ENTRY	D60OPN

D60OPN:	$SAVE	<S2,T1>			; Save registers
	ACVAR	<SIG>			; Local storage for line signature
	SETZ	SIG,			; Clear line signature
	JUMPG	S1,OPN.1		; If open block type parameters
	 LOAD	SIG,(S2),OP$SIG		;  Get line signature
	 ANDI	SIG,177777		;  Clear to only 16 bits worth
	 LOAD	S1,(S2),OP$DEV		;  Get device and unit number
	 LOAD	S2,(S2),OP$STA		;  Get port and line number
OPN.1:	$CALL	PCKPDD			; Make up the PDD for the device
	MOVE	T1,S1			; Put in another reg for safe keeping
	SKIPGE	S1,HANLST		; Check for handle list already started
	 $CALL	L%CLST			;  and make one up if not
	MOVEM	S1,HANLST		; Save the handle list name
	MOVE	S1,T1			; Get the PDD of this device and
	$CALL	SRCPDD			;  check to see if it already exists
	 JUMPT	ERT (D6AUT)		;  Error .. the device being used by us
	MOVE	S1,HANLST		; Get the name of the handle list
	$CALL	L%LAST			; Point after the last entry in list
	MOVE	S1,HANLST		; Get name again in case no entries
	MOVX	S2,H$SIZ		; Load in size of a handle list entry
	$CALL	L%CENT			;  and create one.
	STORE	T1,(S2),H$PDD		; Save the PDD in this list entry
	LOAD	T1,(S2),H$DEV		; Get the generic device number
	MOVE	S1,DEFTHR		; Get the default offline threshold
	CAIE	T1,.OPCIN		; If either the console input
	CAIN	T1,.OPCOU		;  or the console output
	 MOVX	S1,1			;   set to very short offline threshold
	STORE	S1,(S2),H$THR		;  and save it for this device
	SETO	S1,			; Initially set the bytes per message
	STORE	S1,(S2),H$BPM		;  to +infinity to force I/O
	LOAD	S1,(S2),H$PRT		; Get the port number
	CAIGE	S1,DTEOFF		; Do we have a DL10 # (0-7)
	 JRST	OPNDL			;  Yes .. so go validate the DL10 #
	CAILE	S1,MAXDTE		; Check to see if the DTE # is ok
	 JRST	ERT (D6NSP,OPNDIE)	;  No .. it's too large
	JRST	PRTOK			; This port is valid.
OPNDL:					; On -10's DL10's are valid
TOPS20 <MOVX	S1,D6NSP		; No such port (no DL10 on -20)
	JRST	OPNDIE>			;  and go release the list entry
PRTOK:	LOAD	S1,(S2),H$PRT		; Get the port from the PDD
	STORE	S1,(S2),H$HPR		;  put into the handle
	LOAD	S1,(S2),H$PDD		; Get the packed device descriptor
	$CALL	ENQDEV			; Enqueue the device (until released)
	 JUMPF	ERT (D6AUA,OPNDEQ)	;  Someone else already has it
	$CALL	OPNFE			; Go open a FE (-10 check for 11 up)
	 JUMPF	ERT (D6COF,OPNDEQ)	;  Can't open a front end
	$CALL	PRTSTS			; Get the port status
	 JUMPF	ERT (D6COF,OPNDEQ)	;  Can't get port status .. dead 11
	LOAD	S1,,S6LIN		; Get the maximum line number
	LOAD	T1,(S2),H$LIN		; Get the line number we want
	CAILE	T1,(S1)			; Check to see if in range
	 JRST	ERT (D6NSL,OPNDEQ)	;  No such line on this port
	LOAD	S1,,S6TRN		; Get the translation options
	TXNN	S1,TR$IBM		; Does the DN60 support IBM stuff?
	 JRST	ERT (D6PIU,OPNDEQ)	;  No ... this port is useless
	$CALL	LINSTS			; Get the line status
	 JUMPF	OPNDEQ			;  Someone died .. go release device
IFE FTNDNU,<
	LOAD	T1,,SLINF		; Get line info
	TXNN	T1,SLDSR		; Check for line dialed up (DSR set)
	 JRST	ERT (D6DNU,OPNDEQ)	;  No .. so give error
    > ;End if not FTNDNU
	LOAD	T1,,SLSIG		; Get line signature
	$CALL	SWAPB			; Move the bytes around
	CAIE	T1,(SIG)		; Check against given line signature
	 JRST	ERT (D6BLS,OPNDEQ)	;  Bad line signature .. refuse open
	STORE	SIG,(S2),H$SIG		; Save the line signature for device
	LOAD	S1,,SLTYP		; Get the remote station type
	STORE	S1,(S2),H$STY		; Save the station type in list entry
	CAIN	S1,SLHSP		; Test to see if it is a HASP station
	 JRST	OPNHSP			;  Yes .. go create HASP device code
	LOAD	S1,(S2),H$UNT		; Get the unit number on 2780/3780
	JUMPN	S1,ERT (D6UNS,OPNDEQ)	;  Can't give a unit number on non-HASP
	LOAD	S1,(S2),H$DEV		; Get the device code
	CAILE	S1,MXNHSP		; Check for max device on non-HASP
	 JRST	ERT (D6UND,OPNDEQ)	;  Unknown device
	STORE	S1,(S2),H$HDV		; Store as the unique device number
	SETZ	S1,			; All devices are really 0 on 2780/3780
	STORE	S1,(S2),H$CDV		; Store the -11 device com. number
	JRST	OPNDFD			; Device found ok .. continue

OPNHSP:	LOAD	S1,(S2),H$DEV		; Get the device code
	CAILE	S1,0			; Check to see if the device type is
	CAILE	S1,MXHSP		;  in range for a HASP station
	 JRST	ERT (D6UND,OPNDEQ)	;   No .. unknown device type
	MOVE	T1,[XWD 0,4		; Translate OPN numbers to DN60 device
		    XWD 0,5		;  numbers used when talking to -11
		    XWD	0,3
		    XWD	0,2
		    XWD 0,1
		    XWD	0,3]-1(S1)
	STORE	T1,(S2),H$CDV		; Store as the -11 com. device number
	MOVE	T1,[SDLP1		; Component code for a LPT
		    SDCP1		;  or a CDP (card punch)
		    SDCR1		;  or a CDR (card reader)
		    SDCIN		;  or a input console
		    SDCOU		;  or a output console
		    SDSON]-1(S1)	;  or a sigon device
	LOAD	S1,(S2),H$UNT		; Get unit of device-type to select
	CAILE	S1,MXUHSP		; Check against maximum number of units
	 JRST	ERT (D6UND,OPNDEQ)	;  Too bad .. unknown unit
	IMULI	S1,HSPOFF		; Multiply by the unit offset
	ADD	S1,T1			; Get the final device selection code
	STORE	S1,(S2),H$HDV		; Store as the unique device number

OPNDFD:	LOAD	S1,(S2),H$LIN		; Get the line number from the PDD
	STORE	S1,(S2),H$HLN		;  put into handle to complete it.
	LOAD	T1,,SLFLG		; Get line status flags
	LOAD	T1,T1,SLETF		; Get termination/emulation flag
	STORE	T1,(S2),H$TEM		; Save it in the handle list entry

	$CALL	SETIOM			; Set the input/output mode of device
	$DVCMD	(DC.COE,OPNDEQ)		; Clear output EOF flag
	$DVCMD	(DC.CIE,OPNDEQ)		; Clear input EOF flag
;	$DVCMD	(DC.COA,OPNDEQ)		; Clear output abort
;	$DVCMD	(DC.CIA,OPNDEQ)		; Clear input abort

	LOAD	S1,(S2),H$TEM		; Get the emulation/termination flag
	JUMPE	S1,OPNSEM		; Jump if we want to do termination
	$DVCMD	(DC.SCI,OPNDEQ)		;  Set interpret CC on input
	$DVCMD	(DC.CCO,OPNDEQ)		;  Clear inpterpret CC on output
	JRST	OPNOV1			; Continue on

OPNSEM:	$DVCMD	(DC.CCI,OPNDEQ)		; Clear interpret CC on input
	$DVCMD	(DC.SCO,OPNDEQ)		; Set interpret CC on output
	LOAD	S1,(S2),H$DEV		; Get device type
	SETZ	T1,			; Clear return immediate
	CAIN	S1,.OPCOU		; Unless a console (output from IBM)
	 SETO	T1,			;  Then set return immediate flag
	STORE	T1,(S2),H$RTI		; Store return immediate for FEI%O

OPNOV1:	LOAD	S1,(S2),H$STY		; Get the station type
	CAIN	S1,SLHSP		; If it is HASP then go give 
	 JRST	OPNHP2			;  component code
	CAIN	S1,SL278		; Check for 2780 type station
	 JRST	OPN278			;  Yes .. go set proper protocol
	$DVCMD	(DC.C27,OPNDEQ)		; Use new protocol for 3780
	JRST	OPNOV3			; Go clear the component code

OPN278:	$DVCMD	(DC.S27,OPNDEQ)		; Use the old protocol for 2780
OPNOV3:	$DVCMD	(DC.DCC,OPNDEQ)		; 2780/3780 so don't use component code
	$DVCMD	(DC.CSC,OPNDEQ)		; Clear space compression flag
	JRST	OPNOV2			; Continue again

OPNHP2:	LOAD	T1,(S2),H$HDV		; Get the device code from handle
	$DVCMD	(DC.SCC,OPNDEQ)		; Specify component code
	$DVCMD	(DC.C27,OPNDEQ)		; Don't use old protocol
	$DVCMD	(DC.SSC,OPNDEQ)		; Set space compression flag

OPNOV2:	MOVX	T1,^d82			; Currently set to 82.
	STORE	T1,(S2),H$BPM		; Save as the bytes per message
	$CALL	SWAPB			; Swap bytes in 16 bit word
	$DVCMD	(DC.BPR,OPNDEQ)		; Set bytes per record of device

	$CALL	SONSET			; Set station signed on flag

	LOAD	S1,(S2),H$HAN		; Get the handle to pass back
	$RETT				; Return saying success


;
; Here when the open has failed and we need to release (Dequeue) the device.
;

OPNDEQ:	PUSH	P,S1			; Save the error code
	LOAD	S1,(S2),H$PDD		; Get the packed device descriptor
	$CALL	DEQDEV			;  and release the device
	SKIPA				; Now go destroy the list entry
;
; Here when the open fails and we need to delete the entry in the handle list
;  that we have created temporarily for this open attempt.
;
OPNDIE:	PUSH	P,S1			; Save the error code
	MOVE	S1,HANLST		; Get the handle list name
	$CALL	L%DENT			; Delete the current entry
	POP	P,S1			; Restore the error code
	$RETF				;  and give the false return
	SUBTTL	Global routine -- D60SIN

; Global routine - D60SIN
;
; Function - To input a string from a remote station device.
;
; Parameters -
;
;	S1/	Handle of remote device (gotten from D60OPN)
;	S2/	Byte pointer to where string is to be read into
;	T1/	Negative byte count to be read


	ENTRY	D60SIN

D60SIN:	ACVAR	<ARGI>			; Allocate register for input arg block
	MOVE	ARGI,S1			; Save the handle temporarily
	$CALL	ALCARG			; Allocate an FEI%O arg block
	EXCH	ARGI,S1			; Swap them back

	STORE	S2,(ARGI),ARG$PT	; Save the byte pointer to input area
	STORE	T1,(ARGI),ARG$BC	; Save the byte count	
	JUMPGE	T1,ERT (D6CNN,SINFAI)	; Test for illegal byte count
	MOVX	T1,FC.RD		; Function to read from device
	STORE	T1,(ARGI),ARG$FC	; Put into I/O argument block
	HRRZS	S1			; Clear the flags in left half
	$CALL	SRCHAN			; Look for handle on handle entry list
	 JUMPF	ERT (D6NSH,SINFAI)	;  Illegal handle
	LOAD	S1,(S2),H$IOM		; Get the input/output mode
	JUMPE	S1,ERT (D6DCI,SINFAI)	;  Device can't do input
	LOAD	S1,(S2),H$SON		; Check for station signed on
	JUMPN	S1,SIN.SN		; If set .. skip signon checking
	$CALL	SONRD			; Read and validate signon string
	 JUMPF	[$LNCMD (LC.DIS)	;  Failed .. disable the line
		 MOVX	S1,D6LGA	;  Say that line has gone away
		 JRST	SINFAI]

SIN.SN:	LOAD	S1,(S2),H$RUN		; Get the input running flag
	JUMPN	S1,SINGO		;  If yes then go do some input
SIN.LK:	$CALL	LCKLIN			; Lock the line from use (2780/3780)
	 JUMPF	[LOAD S1,(S2),H$SPN	;  Check for signon pending
		 JUMPN S1,SIN.LK	;  Yes .. go try locking again
		 JRST ERT (D6DOL,SINBAD)]; No .. device offline
	$CALL	REQIN			; Go check on input request
	 JUMPF	SINFAI			;  If input grant failed .. return

SINGO:	MOVE	S1,ARGI			; Point to the argblk for FE I/O
	$CALL	FEI%O			; Do the input
	 JUMPF	SINREJ			;  If failed .. check for EOF
	LOAD	S1,(S2),H$HAN		; Get the handle back on success
	JRST	SINSUC			; Set the true flag and return

SINREJ:	$CALL	CKIABT			; Check for input abort
	 JUMPF	SINFAI			;  Yes .. go release and clean up
	TXNE	T1,SDSUS		; Is the device suspended? (HASP)
	 JRST	[MOVX	S1,D6DOL	;  Yes .. so device is offline
		 JRST	SINBAD]		;  Go say that still there, but offline
	TXNE	T1,SDIEC		; Did an EOF occur?
	 JRST	[$DVCMD	(DC.CIE)	;  Yes .. clear EOF complete flag
		 MOVX	S1,D6EOF	;  Set EOF code
		 JRST	SINFAI]		;  Close off line and shutdown device

	LOAD	T1,(ARGI),ARG$RC	; Get the result code from FEI%O
	CAIN	T1,RC.REJ		; Check for a reject
	 JRST	ERT (D6IOE,SINFAI)	;  Yes .. a case of I/O error

	LOAD	T1,(S2),H$DEV		; No .. get generic device number
	CAIE	T1,.OPCIN		; Check for either type of console
	CAIN	T1,.OPCOU		;  device and set the
	 JRST	SINNBR			;   non-blocking return code
	MOVX	S1,D6DOL		; Not console .. so device offline

SINFAI:	ZERO	((S2),H$RUN)		; Clear the I/O running bit
	$CALL	RLSLIN			; Release the line (2780/3780)
	JRST	SINBAD			; Go set the failure and return

SINNBR:	MOVX	S1,D6NBR		; Set non-blocking code
SINSUC:	SKIPA	TF,[TRUE]		; Set true flag
SINBAD:	 MOVX	TF,FALSE		;  Set the failure flag	
SINRET:	LOAD	T1,(ARGI),ARG$BC	; Get the count of bytes not transfered
	LOAD	S2,(ARGI),ARG$PT	; Get pointer where string left off
	EXCH	S1,ARGI			; Exchange return code(handle) and ptr
	$CALL	RLSARG			; Release the argument block
	MOVE	S1,ARGI			; Get the return code(handle) back
	$RET				; Give failure return
	SUBTTL	Global routine -- D60SOUT

; Global routine - D60SOUT
;
; Function - To output a string to a remote device
;
; Parameters -
;
;	S1/	Handle of device received from D60OPN
;	S2/	Byte pointer of string to output
;	T1/	Negative byte count

	ENTRY	D60SOUT
D60SOU:	ACVAR	<ARGO>			; Allocate register for output arg blk
	MOVE	ARGO,S1			; Save the handle temporarily
	$CALL	ALCARG			; Allocate an FEI%O arg block
	EXCH	ARGO,S1			; Swap them back

	STORE	S2,(ARGO),ARG$PT	; Save the byte pointer to input area
	STORE	T1,(ARGO),ARG$BC	; Save the byte count	
	JUMPGE	T1,ERT (D6CNN,SOTF.2)	; Test for illegal byte count
	MOVX	T1,FC.WD		; Function to write data to device
	STORE	T1,(ARGO),ARG$FC	; Put into I/O argument block
	HRRZS	S1			; Clear the flags in left half
	$CALL	SRCHAN			; Look for handle on handle entry list
	 JUMPF	ERT (D6NSH,SOTF.2)	;  Illegal handle
	LOAD	S1,(S2),H$IOM		; Get the input/output mode
	JUMPN	S1,ERT (D6DCO,SOTF.2)	;  Device can't do output
	LOAD	S1,(S2),H$RUN		; Check to see if the output already
	JUMPN	S1,SOTGO		;  running

	$CALL	LCKLIN			; Lock the BSC line (2780/3780)
	 JUMPF	 ERT (D6CGO,SOTRET)	;  Can't .. imply offline
	$CALL	REQOUT			; Request output permission
	 JUMPF	SOTF.1			;  Didn't get it ... release line

SOTGO:	MOVE	S1,ARGO			; Point arg blk for FE I/O
	$CALL	FEI%O			; Do the output
	 JUMPF	SOTTST			;  Go check why the output failed
	LOAD	S1,(S2),H$DEV		; Get device type number
	CAIE	S1,.OPCIN		; Check for console input
	CAIN	S1,.OPCOU		;  or console output device
	 JRST	[$DVCMD	(DC.DOB)	;   Yes .. dump output buffers
		  JUMPF	SOTF.1		;    Failed doing dump
		 JRST	.+1]		;   Continue on with output success
	LOAD	S1,(S2),H$HAN		; Get the handle back on success
	MOVX	TF,TRUE			; Set success code
	JRST	SOTRET			; Go release the arg block and return

SOTTST:	LOAD	T1,(ARGO),ARG$RC	; Get the result code from FEI%O
	CAIN	T1,RC.REJ		; Check for a reject
	 JRST	ERT (D6IOE,SOTF.1)	;  Yes .. a case of I/O error
	$CALL	CKOABT			; Check for output aborts
	 JUMPF	SOTF.1			;  Yes .. go release and clean up
	LOAD	T1,(S2),H$DEV		; Get device type
	CAIE	T1,.OPCIN		; Check for console input device
	CAIN	T1,.OPCOU		;  or console output device
	 SKIPA	S1,[D6NBR]		;   Yes .. set non-blocking error
	MOVX	S1,D6DOL		; No .. so device is off line
	JRST	SOTF.2			; Go give a false return

SOTF.1:	$CALL	RLSLIN			; Release the BSC line (2780/3780)
	ZERO	((S2),H$RUN)		; Clear the running flag
SOTF.2:	MOVX	TF,FALSE		; Set failure flag
	JRST	SOTRET			; Release arg block and return

SOTRET:	LOAD	T1,(ARGO),ARG$BC	; Get the count of bytes not done
	LOAD	S2,(ARGO),ARG$PT	; Get pointer where string left off
	EXCH	S1,ARGO			; Swap error code(handle) and ptr
	$CALL	RLSARG			; Release the argument block
	MOVE	S1,ARGO			; Get the error code(handle) back
	$RET				; Give failure return with code in S1
	SUBTTL	Global routine -- D60OPR

; Global routine - D60OPR
;
; Function - To set parameters and characteristics of a I/O link to a remote
;	device
;
; Parameters -
;
;	S1/	Handle of device
;	S2/	Function code
;	T1/	Optional argument value or block pointer

	ENTRY	D60OPR

D60OPR:	$SAVE	<S2,T1,P1>		; Save registers
	MOVE	P1,S2			; Save the function code
	HRRZS	S1			; Clear out the left half flags
	$CALL	SRCHAN			; Search for the handle on the list
	 JUMPF	ERT (D6NSH)		;  No such handle
	CAIN	P1,.MOABT		; Function to abort I/O transfers
	 JRST	DOPABT			;  Yes .. go set abort flags
	CAIN	P1,.MORQI		; Function to request output permission
	 JRST	DOPRQI			;  Yes .. go get it
	CAIN	P1,.MOTHR		; Function to set off line threshold
	 JRST	 DOPTHR			;  Yes .. go set new threshold
	JRST	ERT (D6FNI)		;  No .. no other function implemented


DOPRQI:	LOAD	S1,(S2),H$IOM		; Get the input/output mode of device
	JUMPN	S1,DOPIN		; Check to see if input .. go grant
	$CALL	REQOUT			;  otherwise get output permission
	CAIA				;  (skip input grant)
DOPIN:	$CALL	REQIN			; Grant input permission
	$RET				; Return T/F from REQOUT or REQIN

DOPABT:	ZERO	((S2),H$RUN)		; Clear the I/O running flag
	LOAD	S1,(S2),H$IOM		; Get the input/output mode
	JUMPN	S1,DOPIAB		; Input flag .. set input abort
	$DVCMD	(DC.SOA)		; Signal output abort on device
	$RET				; Propagate any error back
DOPIAB:	$DVCMD	(DC.SIA)		; Signal input abort on device
	$RET				; Propagate any errors that occured

DOPTHR:	STORE	T1,(S2),H$THR		; Store new value as off line threshold
	$RET
	SUBTTL	Global routine -- D60EOF

; Global routine - D60EOF
;
; Function - To signal the end of I/O on a handle and to turn the line
;	around if it needs to.
;
; Parameters -
;
;	S1/	Handle of device

	ENTRY	D60EOF

D60EOF:	$SAVE	<S2,T1>			; Save some registers
	HRRZS	S1			; Clear out the left half flags
	$CALL	SRCHAN			; Find the handle list entry
	 JUMPF	ERT (D6NSH)		;  Didn't find the handle
	PUSH	P,[RLSLIN]		; Release the line if 2780/3780
INTEOF:	$CALL	LINSTS			; Get the line status
	LOAD	T1,,SLSIG		; Get line signature
	$CALL	SWAPB			; Swap the bytes around
	LOAD	S1,(S2),H$SIG		; Get signature from handle
	CAME	S1,T1			; Check for a match
	 JRST	ERT (D6LGA,EOFL.1)	;  No .. so line has gone away

	LOAD	S1,(S2),H$IOM		; Get the input/output mode
	 JUMPN	S1,ERT (D6DCO)		;  Input device .. can't output EOF
	LOAD	S1,(S2),H$RUN		; Check to see if I/O is running
	 JUMPN	S1,EOFSND		;  Yes .. so go send the EOF
	$CALL	CKOABT			; Check for an output abort
	 JUMPF	EOFL.1			;  Yes .. go clean up and return
	TXNN	T1,SDORN		; Test for output running
	 JRST	EOFL.2			;  No .. so just give successful return

EOFSND:	$DVCMD	DC.SOE			; Signal EOF on device
EOFLOP:	SNOOZE	SEC			; Sleep for a second
	LOAD	T1,(S2),H$DEV		; Get the device number
	CAIN	T1,.OPSGN		; Check for signon device
	 JRST	EOFL.2			;  Yes .. so don't try to read status
	$CALL	CKOABT			; Check for an output abort
	 JUMPF	EOFL.1			;  Yes .. give error and failure return
	TXNN	T1,SDEOC		; Test for output EOF complete
	 JRST	EOFLOP			;  No .. so loop until it is.
	$DVCMD	DC.COE			; Yes .. so clear the EOF complete flg
	JRST	EOFL.2			; Give successful return

EOFL.1:	TDZA	TF,TF			; Set the failue flag if here
EOFL.2:	 SETOM	TF			;  or to success if here
	ZERO	((S2),H$RUN)		; Clear the run flag in handle entry
	$RET				; Successful return
	SUBTTL	Global routine -- D60RLS

; Global routine - D60RLS
;
; Function - To release a device and handle of the device
;
; Parameters -
;
;	S1/	Handle of device received from D60OPN

	ENTRY	D60RLS

D60RLS:	HRRZS	S1			; Clear out and flags that may be set
	$CALL	SRCHAN			; Find the handle list entry
	 JUMPF	ERT (D6NSH)		;  If no entry .. give error return
	$CALL	D60EOF			; Make sure that the I/O is closed off
	 JUMPT	RLS.1			; If no problems releasing .. continue
	CAIE	S1,D6DCO		; If input device .. ignore error
	 $SAVE	<TF,S1>			;  Save error flag and error code
RLS.1:	LOAD	S1,(S2),H$PDD		; Get the packed device descriptor
	$CALL	DEQDEV			;  and release the device to the world
	PJRST	RLSHAN			; Release the handle entry and possibly
					;  the FE device if not needed.
	SUBTTL	Global routine -- D60STS

; Global routine - D60STS
;
; Function - To get the status of a device(s) on a remote station.
;
; Parameters -
;
;	S1/	Function,,arg
;	S2/	Pointer to status return area or line number
;
;	where function is:
;
;		.STDEV	0	for device status
;		.STPRT	1	for port status
;		.STLIN	2	for line status
;
;	where arg is:
;
;		Port number (0-7, 10-13) for .STPRT and .STLIN
;		Device handle (from D60OPN) for .STDEV
;
; Returns -
;
;	Device status and line status - flags in S2
;	Multiple device activity status - in block pointed to by S2

	ENTRY	D60STS

D60STS:	$SAVE	<T1,T2>			; Save registers
	HLRZ	T1,S1			; Get function code
	ANDX	T1,7			; Clear all bits except the function
	CAIN	T1,.STPRT		; Check for port status
	 JRST	MULSTS			;  Yes .. so get the activity status
	CAIN	T1,.STLIN		; Check for line status
	 JRST	STSLIN			;  Yes .. so get line staus flags
	CAIE	T1,.STDEV		; Check for device status
	 JRST	ERT (D6FNI)		;  No .. so the function is not here

	HRRZS	S1			; Clear out the left half flags
	$CALL	SRCHAN			; Go find the handle in the handle list
	JUMPF	ERT (D6NSH)		;  No .. so give error return
	$CALL	DEVSTS			; Get the device status
	 JUMPF	@.RETF			;  Can't get device status .. die
	LOAD	T1,,SDFLG		; Get the status flags for the device
	LOAD	T2,(S2),H$IOM		; Get the Input/Output mode
	STORE	T2,T1,SDIOM		; Put the mode into the status bits
	MOVE	S2,T1			; Put the status value where looked for
	$RETT				; Give a true return

MULSTS:	MOVE	T1,S2			; Save the value return pointer
	$CALL	INIDMY			; Start up a dummy list entry
	 JUMPF	@.RETF			;  Can't get at the port
	$CALL	PRTSTS			; Get the port status
	 JUMPF	RLSHAN			;  If it failed .. give false return
	HRLI	S1,STSBUF+S6ACT		; Point to where active bits start
	HRR	S1,T1			;  and where to transfer them to
	BLT	S1,S6ALN-1(T1)		; Transfer to the user program
	MOVX	TF,TRUE			; Set success flag
	PJRST	RLSHAN			; Return while releasing dummy handle

STSLIN:	MOVE	T1,S2			; Move line number to a safe place
	$CALL	INIDMY			; Start up a dummy list entry
	 JUMPF	@.RETF			;  Failed to start a front end
	STORE	T1,(S2),H$LIN		; Store lower 9 bits as line number
	STORE	T1,(S2),H$HLN		;  in handle and PDD entries
	$CALL	LINSTS			; Get status of line
	$CALL	RLSHAN			; Release the dummy handle
	 JUMPF	ERT (D6LGA)		;  If line status failed .. bad return
	LOAD	T1,,SLFLG		; Get flags
	ANDI	T1,177400		; Get only significant part
	LOAD	S2,,SLINF		; Get line info
	IOR	S2,T1			; Put them all together
	$RETT				; Return successfully


INIDMY:	$SAVE	<T1>			; Save a register
	$CALL	ALCHAN			; Make up a dummy handle entry
	STORE	S1,(S2),H$PRT		; Put the port number in to dummy entry
	STORE	S1,(S2),H$HPR		;  in both places.
	LOAD	S1,(S2),H$PDD		; Get the packed device descriptor
	$CALL	OPNFE			; Open the front end
	 JUMPF	ERT (D6COF,RLSHAN)	;  Can't open front end, rls dummy
	$RETT				; Front end opened just fine
	SUBTTL	GLobal routine -- D60CND, D60DIS

; Routine - D60CND, D60DIS
;
; Function - To condition a 2780/3780/HASP line with the appropriate parameters
;
; Parameters -
;
;	S1/	Address of QUASAR setup message
;
;		c(S1)+SUP.CN = address of conditioning arg block
;
;	argblk/	Port,,Line		; Only need this word on disable
;		Flags
;		 1b15 Transparent
;		 1b16 Primary protocol
;		 1b17 Emulation
;		 right half - station translation type
;		  1 - 3780
;		  2 - 2780
;		  3 - HASP
;		Clear to send delay
;		Silo warning area size
;		Number of bytes/message
;		Number of records/message
;		Line signature

	ENTRY	D60CND, D60DIS

D60CND:	$SAVE	<S2,T1,T2,P1,P2,P3>	; Save some registers
	MOVX	P1,.CNENB		; Line enable function
	MOVE	P3,S1			; Save address of setup message
	MOVEI	P2,SUP.CN(P3)		; Get address of conditioning block
	JRST	CNDGO			; Go to common code

D60DIS:	$SAVE	<S2,T1,T2,P1,P2,P3>	; Save some registers
	MOVX	P1,.CNDIS		; Line disable function
	MOVE	P2,S1			; Get address of port,,line

CNDGO:	LOAD	T1,(P2),CN$PRT		; Get port number
	LOAD	T2,(P2),CN$LIN		; Get line number being disabled

CND.X:	SKIPGE	S1,HANLST		; Check for any devices opened
	 JRST	CND.2			;  No .. just go disable line
	$CALL	L%FIRST			; Point to first entry in list
	 JUMPF	CND.2			;  No first entry .. go disable line
CND.1:	LOAD	S1,(S2),H$PRT		; Get port number
	CAME	S1,T1			; Check against one being disabled
	 JRST	CND.1A			;  No .. continue to next entry
	LOAD	S1,(S2),H$LIN		; Get line number of entry
	CAME	S1,T2			; Check against one being disabled
	 JRST	CND.1A			;  No .. continue until last entry
	LOAD	S1,(S2),H$HAN		; Get handle of current entry
	$CALL	D60RLS			; Release the device (call global rtn)
	JRST	CND.X			; Go start at top of list again

CND.1A:	MOVE	S1,HANLST		; Get handle list name
	$CALL	L%NEXT			; Find next handle list entry
	 JUMPT	CND.1			;  Another one .. check releasability


CND.2:	$CALL	ALCHAN			; Make up a dummy handle entry

	LOAD	S1,(P2),CN$PRT		; Get the port to start up
	STORE	S1,(S2),H$PRT		;  and save it in pseudo handle block
	LOAD	S1,(P2),CN$LIN		; Get the line to init
	STORE	S1,(S2),H$LIN		;  and save that also
	LOAD	S1,(S2),H$PDD		; Get the packed device descriptor
	$CALL	OPNFE			; Open up the front end for setup
	 JUMPF	ERT (D6COF,RLSHAN)	;  Couldn't open a front end

	$CALL	LINSTS			; Get the line status
;	 JUMPF	RLSHAN			;  Release handle, give error if failed
	LOAD	T1,,SLINF		; Get line info flags
	TXNN	T1,SLLEN		; Check for line enabled
	 JRST	CND.5			;  No .. go issue line enable
	LOAD	T1,,SLTYP		; Get station type enabled for
	CAIN	T1,SLHSP		; Check for HASP
	 JRST	CND.3			;  Yes .. just go disable line
	$CALL	DEVSTS			; Get device (0) sts on 2780/3780 line
	 JUMPF	RLSHAN			;  Failed .. release and clean up
	LOAD	T1,,SDFLG		; Get device flags
	TXNN	T1,SDOAS!SDIAS		; Check for any aborts pending
	 JRST	CND.3			;  No .. just disable the line
	$DVCMD	(DC.CIA,RLSHAN)		; Clear input abort
	$DVCMD	(DC.COA,RLSHAN)		; Clear output abort

CND.3:	$LNCMD	(LC.DIS,RLSHAN)		; Shut down the line (disable)
	SNOOZE	SEC			; Sleep for a second, let -11 catch up

CND.5:	CAIN	P1,.CNDIS		; If the function was to disable the
	 $RETT				;  line only .. we have gone far enough

	LOAD	S1,(P2),CN$ETF		; Get emulation/termination flag
	JUMPN	S1,CND.6		; If emulation .. ignore signon
	$CALL	SONFIL			; Go read and setup signon string
	 JUMPF	RLSHAN			;  If failed .. just release and return

CND.6:	$CALL	PRTSTS			; Get status of front end
	 JUMPF	RLSHAN			;  Can't get port status .. so die
	LOAD	T1,(P2),CN$TYP		; Get desired translation type
	MOVE	T1,[EXP TR$X78,TR$X78,TR$HSP]-1(T1)
	LOAD	S1,,S6TRN		; Get translations avaiable in FE
	TDNN	S1,T1			; Check wanted against available
	 JRST	ERT (D6PIU,RLSHAN)	;  Nope .. port is useless
	LOAD	T1,(P2),CN$TYP		; Get the station type (terminal type)
	LSH	T1,^d8			; Shift it up to the second byte
	LOAD	S1,(P2),CN$MAP		; Get the emulation/termination flag
					;  and primary/secondary flag
	IOR	T1,S1			; Put into second byte and
	$LNCMD	(LC.EL,RLSHAN)		;  start it up again (enable)
	LOAD	T1,(P2),CN$CTS		; Get the clear to send delay
	$CALL	SWAPB			;  swap the bytes in 16 bit word
	$LNCMD	(LC.CSD,RLSHAN)		;  and set it
	LOAD	T1,(P2),CN$WRN		; Get the silo warning level
	$CALL	SWAPB			;  swap the bytes in 16 bit word
	$LNCMD	(LC.WAR,RLSHAN)		;  and set it
	LOAD	T1,(P2),CN$BPM		; Get the bytes per message
	$CALL	SWAPB			;  swap the bytes in 16 bit word
	$LNCMD	(LC.BPM,RLSHAN)		;  and set it
	LOAD	T1,(P2),CN$RPM		; Get the records per message
	$CALL	SWAPB			;  swap the bytes in 16 bit word
	$LNCMD	(LC.RPM,RLSHAN)		;  and set it
	LOAD	T1,(P2),CN$SIG		; Get line signature to set
	ANDI	T1,177777		; Clear superfluous bits
	$CALL	SWAPB			;  swap bytes in 16 bit word
	$LNCMD	(LC.SLS,RLSHAN)		; Set the line signature
	LOAD	S1,(P2),CN$TYP		; Get station type again
	CAIE	S1,SLHSP		; Check for HASP station
	 JRST	CND.9			;  No.. ignore transparent transmission
	LOAD	T1,(P2),CN$TRA		; Get transparency flag
	JUMPN	T1,[$LNCMD (LC.STR,RLSHAN); Set transparency on
		    JRST CND.9]
	$LNCMD	(LC.CTR,RLSHAN)		; Set transparency off

CND.9:	$LNCMD	(LC.DTR,RLSHAN)		; Set the data terminal ready

	PJRST	RLSHAN			; Release handle, FE and return
	SUBTTL	Signon string validation

; The state diagram of the signon string comparison follows.  This
; algorithm allows floating fields on the line.

XLIST
Comment &

Explaination of state diagram symbols

	Start	Where processing begins
	(x)	Condition causing transfer to next state
	 (EOS)	 End of string, either by character or count
	 (B)	 Blank character (tab or space)
	 (NB)	 Non-blank character
	 (OK)	 Result of comparison
	<>	Loop back to same state
	GET A	Get next character from "A" string
	GET B	Get next character from "B" string
	A=B ?	Compare last characters fetched from strings
	"OK"	String comparison succeeded
	"F"	String comparison failed


				+======0+
				! START	!
				+=======+
				    !
				    V
	+======8+		+======1+
   (B)<>! GET B	!<--------------! GET A	!<>(B)
	+=======+	^ (EOS)	+=======+
	  !   !		!	  !
	  !   !		!     (NB)!
     (EOS)!   !(NB)	!	  +<------------------------------------+
	  V   V		!	  V					!
        "OK" "F"	!	+======2+ (EOS)				!
			!  (B)<>! GET B	!---->"F"			!
			!	+=======+				!
			!	  !					!
			!	  !(NB)					!
			!	  V					!
			!	+======3+				!
			! "F"<--! A=B ?	!<--------+			!
			!	+=======+	  !			!
			!	  !		  !			!
			!	  !(OK)		  ! (NB)		!
			!	  V		  !			!
			! (EOS)	+======4+ (NB)	+======6+  (B)		!
			+<------! GET A	!------>! GET B	!------>"F"	!
			!	+=======+	+=======+ (EOS)		!
			!	  !					!
			!	  !(B)					!
			!	  V					!
			! (EOS)	+======5+	+======7+  (NB)		!
			+<------! GET A	!------>! GET B	!------>"F"	!
				+=======+	+=======+ (EOS)		!
				  ^  !		  !			!
				  !  !(B)	  ! (B)			!
				  +--+		  +---------------------+

	&
LIST

Define $GETA (NB,B,EOS)

< XLIST
	DMOVE	P3,PTRA			; Get pointer, count for string "A"
	$CALL	G$SCHK			; Get character and check it
	DMOVEM	P3,PTRA			; Store byte pointer back
	MOVEM	S2,P1			; Save character for later
	JRST	@[EXP NB,B,EOS](S1)	; Move onto next state
  LIST
    > ;End Define $GETA


Define $GETB (NB,B,EOS)

< XLIST
	DMOVE	P3,PTRB			; Get pointer, count for string "B"
	$CALL	G$SCHK			; Get character and check it
	DMOVEM	P3,PTRB			; Store byte pointer back
	MOVEM	S2,P2			; Save character for later
	JRST	@[EXP NB,B,EOS](S1)	; Move onto next state
  LIST
    > ;End Define $GETB

SCS.0:	$SAVE	<P1,P2,P3,P4>		; Save working registers
SCS.1:	$GETA	(SCS.2,SCS.1,SCS.8)	; Loop until non-blank
SCS.2:	$GETB	(SCS.3,SCS.2,SCS.F)	; Loop also until non-blank
SCS.3:	CAME	P1,P2			; Check for character match
	 JRST	SCS.F			;  No .. comparison failed

SCS.4:	$GETA	(SCS.6,SCS.5,SCS.8)	; Get next character in atom
SCS.5:	$GETA	(SCS.7,SCS.5,SCS.8)	; Atom done .. find next one
SCS.6:	$GETB	(SCS.3,SCS.F,SCS.F)	; Get character, if none .. failure
SCS.7:	$GETB	(SCS.F,SCS.2,SCS.F)	; Atom should be done
SCS.8:	$GETB	(SCS.F,SCS.8,SCS.T)	; Scan off trailing blanks

SCS.F:	$RETF				; String compare failed
SCS.T:	$RETT				; String compare suceeded
; Routine - G$SCHK
;
; Function - To get the next character from a string and set the state
;	vector value appropriate for the type of character.
;
; Parameters -
;
;	P3/	Byte pointer
;	P4/	String character count
;
; Returns -
;
;	S1/	State condition value
;		 0 = Non-blank character
;		 1 = Blank character (tab or space)
;		 2 = Control character (end of string), or count expired
;	S2/	Character read

G$SCHK:	SOJL	P4,G$S.E		; Check for end of string count
	ILDB	S2,P3			; Get next character
	CAIGE	S2," "			; Check for control character
	 JRST	G$S.E			;  Yes .. end of string
	CAIE	S2," "			; Check for space
	CAIN	S2,"	"		; or tab
	 JRST	[MOVEI S1,1		;  Blank character encountered
		 $RET]			;  Return
	CAILE	S2,"_"			; Check for lowercase range
	 SUBI	S2,"a"-"A"		;  Yes .. convert to upper case
	MOVEI	S1,0			; Non-blank character read
	$RET				; Return

G$S.E:	MOVEI	S1,2			; End of string
	$RET
; Routine - SONSET
;
; Function - To set the station signed on flag to the appropriate value
;	depending on emulation/termination, device type and signon string
;	values.
;
; Parameters -
;
;	S2/	Handle list entry address

SONSET:	$SAVE	<S2>			; Save the handle list entry address

	LOAD	S1,(S2),H$DEV		; Get device type code
	CAIE	S1,SDCDR		; Check for card reader
	 JRST	SONS.5			;  No .. suppress reading signon
	MOVE	T1,S2			; Make another copy of it.
	LOAD	S1,(S2),H$PRT		; Get port number
	LOAD	S2,(S2),H$LIN		; Get line number
	LSH	S1,^d9			; Shift port
	IOR	S1,S2			;  and make port/line number
	MOVEI	S2,SONSTR		; Point to table of signon strings
	$CALL	T$EFND			; Find one for this port/line
	MOVE	S2,T1			; Get entry address back
	SETZ	T1,			; Clear Signon done flag
	SKIPT				; If no string found
SONS.5:	 SETO	T1,			;  then no signon needed (already done)
	STORE	T1,(S2),H$SON		; Save flag value
	$RETT
; Routine - SONRD
;
; Function - To read the signon string from the RJE card-reader and match
;	it against the string read from the .SON file.
;
; Parameters -
;
;	S2/	Handle list entry address

SONRD:	$SAVE	<S2,P1,P2,P3>

	MOVE	P1,S2			; Make copy of handle entry address
	LOAD	S1,(P1),H$RTI		; Get "return immediate" value
	PUSH	P,S1			; Save (restore before exit)
	SETO	S1,			; Turn on the signed on
	STORE	S1,(P1),H$SON		;  flag so that D60SIN can be recursive
	STORE	S1,(P1),H$SPN		; Set signon pending flag
	LOAD	S1,(P1),H$HAN		; Get device handle
	HRROI	S2,SONBUF		; Point to input string buffer
	MOVX	T1,-^d82		; Length of string to read
	$CALL	D60SIN			; Read the signon string
	 JUMPF	SRD.F			;  If failed .. just return
	DMOVE	S1,[POINT 7,SONBUF
		    ^d82]		; "A" string descriptor
	DMOVEM	S1,PTRA			; Save it
	LOAD	S1,(P1),H$PRT		; Get port number
	LOAD	T1,(P1),H$LIN		; Get line number
	LSH	S1,^d9			; Shift the port number
	IOR	S1,T1			; Combine to make port/line id
	MOVEI	S2,SONSTR		; Signon string table address
	$CALL	T$EFND			; Find the entry
	JUMPF	[$STOP SSD,<Signon string disappeared from data base.>]
	DMOVE	P2,S1			; Save table address and block address
	HRLI	S1,440700		; Make into a byte pointer
	ADDI	S1,SONTXT		; Add offset to string text
	MOVX	S2,^d82			; Max length of string
	DMOVEM	S1,PTRB			; "B" string descriptor
	$CALL	SCS.0			; Run string comparsion state machine
	 JUMPF	SRD.F			;  If failed .. just return
	MOVE	S2,P1			; Restore handle list entry address
	$DVCMD	(DC.CIE)		; Clear input EOF complete
	$CALL	RLSLIN			; Release the line
	SNOOZE	SEC*3			; Sleep for a while .. let LPT catch up
	$WTO	<Node signed on>,<>,<SONTYP(P2)>
	MOVE	S2,P1			; Restore handle list entry address
	$CALL	RLSLIN			; Release the line
	POP	P,S1			; Get the "return immediate" back
	STORE	S1,(P1),H$RTI
	SETZ	S1,			; Clear the signon pending flag
	STORE	S1,(P1),H$SPN
	STORE	S1,(P1),H$RUN		; Clear CDR running flag
	$RETT				; and return

SRD.F:	POP	P,S1			; Get the "return immediate" off stack
	$RETF				; Failure during signon
; Routine - SONFIL
;
; Function - Read and store a signon file for a particular node.
;
; Parameters -
;
;	P3/	Address of setup message from QUASAR
;
; Returns - False if failed to read signon file ($WTO sent)
;	    True  if signon file read and string stored

SONFIL:	$SAVE	<S1,S2,T1,T2,P1,P2,P3>

	MOVE	S1,SUP.ST(P3)		; Get status word of node
	TXNN	S1,NETSGN		; Check for "signon" required
	 JRST	SNF.NS			;  No .. just clear any left around

; Open the signon file

	SETZ	P2,			; Clear IFN of file (so far)
	$TEXT <-1,,SONFD+1>,<^T/SONDIR/^W/SUP.NO(P3)/.SON^0>
	MOVX	S1,FOB.MZ		; Get size of FOB
	MOVEI	S2,SONFOB		; Signon file FOB
	$CALL	F%IOPN			; Open file for input
	 JUMPF	SNF.F			;  Signon file failure
	MOVE	P2,S1			; Save IFN of file

; Get a buffer to store signon string, from file, into

	MOVX	S1,SNBLEN		; Length for signon block
	$CALL	M%GMEM			; Get it from mangler
	MOVE	P1,S2			; Save it's address
	MOVE	T2,S2			; Make a byte pointer
	HRLI	T2,440700		; to the string
	ADDI	T2,SONTXT		; Index to the string area in block
	MOVX	T1,^d82			; Max string length of 82 characters
	MOVE	S1,P2			; Get IFN of input file

; Loop to read in the signon string, max of 82 characters.

SNF.1:	SOJL	T1,SNF.E		; End of string (truncated)
	$CALL	F%IBYT			; Get next byte from file
	 JUMPF	[CAIE S1,EREOF$		;  Check for EOF
		  JRST SNF.F		;   No .. give error
		 JRST SNF.E]		;  Yes .. end the string
	IDPB	S2,T2			; Store byte and
	JRST	SNF.1			; go onto the next one

; Here to put string into signon string table

SNF.E:	SETZ	S2,			; Put a null byte
	IDPB	S2,T2			; at the end of the string
	MOVE	S1,P2			; Get file IFN again
	$CALL	F%REL			; Release the file
	DMOVE	S1,SUP.TY(P3)		; Get device type/unit
	DMOVEM	S1,SONTYP(P1)		; Put into signon block
	MOVE	S1,SUP.NO(P3)		; Get device node
	MOVEM	S1,SONNOD(P1)		; Put that also into signon block

	MOVEI	P2,SUP.CN(P3)		; Get address of line conditioning blk
	LOAD	S1,(P2),CN$PRT		; Get port number
	LOAD	S2,(P2),CN$LIN		; Get line number
	$CALL	SNFREL			; Release any previous signon block
	SETZ	S1,			; Look for a null entry
	MOVEI	S2,SONSTR		; Address of table again
	$CALL	T$EFND
	 JUMPF	[$STOP STF,<Signon table full .. can't setup signon string>]
	MOVEM	P1,(S2)			; Store address of signon block
	HRLM	P2,(S2)			; Store port/line code
	$RETT				; Success in storing signon string


; Here when there is a failure reading the signon file.

SNF.F:	$WTO <Signon failure>,<Signon file ^F/SONFD/^M^J^E/[-1]/>,<SUP.TY(P3)>
	SKIPN	S1,P2			; Check for IFN already assigned
	 $RETF				;  No .. just give error return
	$CALL	F%REL			; Release the file
	$RETF				; then give a failure return


; Here if signon is not required.  The port/line is searched for
; in the signon string block, and if found it is removed.

SNF.NS:	MOVEI	P2,SUP.CN(P3)		; Get address of line conditioning blk
	LOAD	S1,(P2),CN$PRT		; Get port number
	LOAD	S2,(P2),CN$LIN		; Get line number
	PJRST	SNFREL			; Release block and return
; Routine - SNFREL
;
; Function - To search for and release a previously allocated signon block.
;
; Parameters -
;
;	S1/	Port number
;	S2/	Line number
;
; Returns - True always   P2/ port/line number

SNFREL:	$SAVE	<T1>

	LSH	S1,^d9			; Move up the port number
	IOR	S1,S2			; Combine with line number
	MOVE	P2,S1			; 18bit unique port/line number
	MOVEI	S2,SONSTR		; Address of signon string table
	$CALL	T$EFND			; Find if there is one
	 JUMPF	.RETT			;  No .. just return
	MOVE	T1,S2			; Save address of table entry
	MOVE	S2,S1			; Get address of signon block
	MOVX	S1,SNBLEN		; Get length of signon block
	$CALL	M%RMEM			; Release block to free pool
	SETZ	S1,			; Yes .. make a null entry
	MOVEM	S1,(T1)			; and use it to clear table entry
	$RETT				; Return
; Routine - T$EFND
;
; Function - To search a table for a particular 18 bit value and return
;	the associated 18 bit data value if found.
;
; Parameters -
;
;	S1/	Value to search for
;	S2/	Address of table
;
;	Table format:
;
;		Max-entries,,actual-entry-count
;		Key-value-1,,data-value-1
;		Key-value-n,,data-value-n
;		etc.
;
; Returns -
;
;	False if not found in table (or no entries)
;	True  if found and S1 contains the associated data value.

T$EFND:	HRRZ	TF,(S2)			; Get count of entries in table
	JUMPE	TF,.RETF		; If none .. search fails
	MOVNS	TF			; Make negative count
	HRL	S2,TF			; Make AOBJP pointer for search loop
	AOS	S2			; Move onto first entry in table

EFND.1:	HLRZ	TF,(S2)			; Get next table key value
	CAMN	TF,S1			; Check for a match
	 JRST	[HRRZ S1,(S2)		;  If so .. get data value
		 $RETT]			;  and give search success flag
	AOBJN	S2,EFND.1		; No match .. move onto next entry
	$RETF				; Ran out of entries .. search fails
	SUBTTL	Lock/release BSC lines for 2780/3780 half-duplex

; Routine - LCKLIN
;
; Function - This routine locks a BSC line so that no other process or task
;	in this process can attempt to do I/O on the line while the current
;	task has an object (card reader/line printer) already running.
;
; Parameters -
;
;	S2/	Handle list entry

LCKLIN:	$SAVE	<S2>			; Save register

	LOAD	S1,(S2),H$STY		; Get terminal (station) type
	CAIN	S1,SLHSP		; Check for a HASP station
	 $RETT				;  Yes .. so line needn't be locked
	LOAD	S1,(S2),H$PDD		; Get packed device descriptor
	PJRST	ENQLIN			; Enqueue the line and return


; Routine - RLSLIN
;
; Function - To release a line so that it can be turned around or another
;	task can talk to a common device (such as a line-printer being used
;	for both an output console and a printer).
;
; Parameters -
;
;	S2/	Location of handle list entry

RLSLIN:	$SAVE	<TF,S1,S2>		; Save some error code and return value

	LOAD	S1,(S2),H$STY		; Get station type
	CAIN	S1,SLHSP		; Check for a HASP station
	 $RETT				;  Yes .. so just return .. not locked
	LOAD	S1,(S2),H$PDD		; Get packed device descriptor
	PJRST	DEQLIN			; Release the line and return
	SUBTTL	Grant input permission


; Routine - REQIN
;
; Function - To grant an input request if one pending, wait for one and
;	     grant it.
;
; Parameters -
;
;	S2/	Handle list entry address

REQIN:	$SAVE	<T1,T2>			; Save registers

	SETZ	T2,			; No .. clear repeat count
	LOAD	T1,(S2),H$SPN		; Get "signon pending" flag
	SKIPE	T1			; Check if set
	 MOVX	T2,SONREP		;  Yes .. repeat test for a while
REQSPN:	$CALL	CKIABT			; Check for any outstanding input abort
	 JUMPF	@.RETF			;  Yes .. so just return with failure
	TXNE	T1,SDIPW!SDIRN		; Check for input perm. was requested
	 JRST	REQRTY			;  Yes .. go answer request
	SOJLE	T2,ERT (D6DOL)		; Check for more retrys .. else offline
	SNOOZE	SEC			; Sleep for a second
	JRST	REQSPN			; Go check for a request again.

REQRTY:	MOVX	T2,RQREP		; Get the max number of tries for req
REQRDS:	$CALL	CKIABT			; Check for input aborts again
	 JUMPF	@.RETF			;  Failure caused by abort
	TXNE	T1,SDIRN		; Check for input already running
	 JRST	REQCKI			;  Yes .. go check for aborts
	TXNE	T1,SDIPR		; Check for a new input request
	 JRST	REQGRT			;  Yes .. so go grant it
	SNOOZE	SEC*RQTIM		; No .. sleep for a while
	SOJG	T2,REQRDS		; If more tries left .. go check again
	JRST	ERT (D6DOL)		;  else assume the device is offline

REQGRT:	$DVCMD	DC.GIP			; Do a device input permission grant
	$DVCMD	DC.CIP			; Clear the request flag
REQGLP:	$CALL	CKIABT			; Check for input aborts
	 JUMPF	@.RETF			;  Failure do to abort on device
	TXNN	T1,SDIPG		; Check for the grant cleared
	 JRST	REQCKI			;  Yes .. the device took the grant
	SNOOZE	SEC			;  No .. sleep and loop
	JRST	REQGLP

REQCKI:	TXNN	T1,SDIEC!SDIRN		; Check for EOF or running
	 JRST	REQRTY			;  No .. grant was eaten .. try again
	SETO	T1,			;  Yes .. so turn on
	STORE	T1,(S2),H$RUN		;   the I/O running flag
	$RETT				; Give a successful return
	SUBTTL	Request output permission

; Routine - REQOUT
;
; Funtion - To request output permission on a device
;
; Parameters -
;
;	S2/	Handle list entry address

REQOUT:	$SAVE	<T1,T2>			; Save registers

	MOVX	T2,RQOTIM		; Number of times to retry DSR check
DSRLP:	$CALL	LINSTS			; Get the line status
	 JUMPF	ERT (D6LGA)		;  Failed .. line must be dead
	LOAD	T1,,SLINF		; Get the info status byte
	TXNE	T1,SLDSR		; Test for the DSR set
	 JRST	STOGST			;  Yes .. start output grant request
	SNOOZE	TIMDSR			; No .. so sleep and then
	SOJG	T2,DSRLP		;  go try for DSR again
	LOAD	T1,,SLFLG		; Get line flags.
	MOVX	S1,D6CGO		; Can't get output perm. .. no line
	TXNE	T1,SLCME		; Check for line failure
	 MOVX	S1,D6LGA		;  Yes .. say line has gone away.
	$RETF				; Failure return

STOGST:	$DVCMD	(DC.CIP)		; Clear input requested flag
	LOAD	S1,(S2),H$DEV		; Get the generic device type
	CAIN	S1,.OPSGN		; Check for a signon device
	 JRST	STGRUN			;  Yes .. so imply grant already gotten
	$CALL	CKOABT			; Check for output aborts
	 JUMPF	@.RETF			;  Yes .. just give error return
	TXNE	T1,SDIPW!SDIPR		; Check for input requested
	 JRST	ERT (D6CGO)		;  Input coming .. can't do output
	TXNN	T1,SDORN!SDOPG		; Output running or granted already?
	 JRST	REQGO			;  No so go request output
	$CALL	INTEOF			;  and put out an EOF to stop the
	 JUMPF	@.RETF			;  output (unless failed .. give error)
REQGO:	$DVCMD	DC.ROP			; Request to do output

	MOVX	T2,RQDTRY		; Number of retries after request drops
STGRLP:	SNOOZE	(<SEC*SOTDLY>,IOWAIT)	; Wait for the request to be processed
	$CALL	CKOABT			; Check for output aborts
	 JUMPF	@.RETF			;  Yes .. failure on device
	TXNE	T1,SDOPG!SDORN		; Check to see if grant gotten
	 JRST	STGRUN			;  Yes .. so go set the run flag
	TXNE	T1,SDIPW!SDIPR		; Check for input requested
	 JRST	ERT (D6CGO)		;  Yes .. input is coming, can't output
	TXNE	T1,SDOPR		; Check to see if request still up
	 JRST	STGRLP			;  Yes .. wait for it to go down
	SOJG	T2,STGRLP		; Check for retry exhausted
	JRST	ERT (D6CGO)		;  Device must be off line (maybe)

STGRUN:	SETO	T1,			; Set the flag saying that
	STORE	T1,(S2),H$RUN		;  the output is now running
	$RETT				; Give good return (output running)
	SUBTTL	Check for input abort

; Routine - CKIABT
;
; Function - This routine checks the device status for an occurence of either
;	a hardware line abort or a protocol soft device abort.  If either
;	has occured, an error will be returned.  If device status can't be
;	gotten an error will also be returned.  After a device soft abort
;	is seen it will be acknowledged (cleared) so the front end will
;	clean up.
;
; Parameters -
;
;	S2/	Handle list entry address
;
; Returns -
;
;	False	S1/ error code
;	True	T1/ device flags

CKIABT:	$CALL	DEVSTS			; Get device status
	 JUMPF	ERT (D6LGA)		;  Failed .. line has done away
	LOAD	T1,,SDLFG		; Get line status flags
	TXNE	T1,SDHWA		; Check for a hardware abort
	 JRST	ERT (D6LGA)		;  Yes .. line gone away
	LOAD	T1,,SDFLG		; Get device flags
	TXNN	T1,SDIAS		; Has input abort occured?
	 $RETT				;  No .. we are ok here
	TXNN	T1,SDIAC		; Has the abort completed?
	 JRST	[SNOOZE	SEC		;  No .. sleep for a second
		 JRST	CKIABT]		;  Go check the status again
	$DVCMD	(DC.CIA)		; Clear input abort flag
	 SKIPF				;  Failed to clear flag
	  MOVX	S1,D6IOE		;   Cleared .. I/O error occured
	$RETF				; Give failure return for all
	SUBTTL	Check for output abort

; Routine - CKOABT
;
; Function - This routine checks the device status for an occurence of either
;	a hardware line abort or a protocol soft device abort.  If either
;	has occured, an error will be returned.  If device status can't be
;	gotten an error will also be returned.  After a device soft abort
;	is seen it will be acknowledged (cleared) so the front end will
;	clean up.
;
; Parameters -
;
;	S2/	Handle list entry address
;
; Returns -
;
;	False	S1/ error code
;	True	T1/ device flags

CKOABT:	$CALL	DEVSTS			; Get device status
	 JUMPF	ERT (D6LGA)		;  Failed .. line has gone away
	LOAD	T1,,SDLFG		; Get line status flags
	TXNE	T1,SDHWA		; Check for a hardware abort
	 JRST	ERT (D6LGA)		;  Yes .. line gone away
	LOAD	T1,,SDFLG		; Get device flags
	TXNE	T1,SDIEC		; Check for old input EOF still there
	 JRST	[$DVCMD	DC.CIE		;  Clear the input EOF completed
		 JRST	CKOABT]		;  Start abort checking all over.
	TXNN	T1,SDOAS		; Has output abort occured?
	 $RETT				;  No .. we are ok here
	TXNN	T1,SDOAC		; Has the abort completed?
	 JRST	[SNOOZE	SEC		;  No .. sleep for a second
		 JRST	CKOABT]		;  Go check the status again
	$DVCMD	(DC.COA)		; Clear output abort flag
	 SKIPF				;  Failed to clear flag
	  MOVX	S1,D6IOE		;   Cleared .. I/O error occured
	$RETF				; Give failure return for all
	SUBTTL	Pack a unique device descriptor

; Routine - PCKPDD
;
; Function - To pack the PORT, LINE, DEVICE-TYPE and UNIT numbers into a single
;	word to use as a unique descriptor of that device.  This is useful so
;	that when searching tables we will only have to do single word compares.
;
; Parameters -
;
;	S1/	dev-type#,,unit#
;	S2/	port#,,line#
;
; Returns -
;
;	S1/	port,line,dev,unit each in 9 bits


PCKPDD:	$SAVE	<T1,T2>			; Save a couple registers

	HLL	T1,S2			; Get port number into LH
	HLR	T1,S1			; Get device type number into RH
	LSH	T1,^d9			; Shift them up to where they need be
	TLZ	T1,777			; Clear out where line # will be
	HRL	T2,S2			; Get line number into LH
	HRR	T2,S1			; Get unit number into RH
	AND	T2,[777,,777]		; Clear out where port and device go
	IOR	T1,T2			; Put them all together
	MOVE	S1,T1			;  and it's magic. (all packed into A)
	$RETT				; Only a true return
	SUBTTL	Create/destroy a handle list entry

; Routine - ALCHAN
;
; Function - To create a new handle list entry in the handle list. This routine
;	     also initializes the needed values to talk to FEI%O.
;
; Parameters - none
;
; Returns -
;
;	S2/	Location of the new handle list entry

ALCHAN:	$SAVE	<S1>			; Save a register

	SKIPGE	S1,HANLST		; Check for a handle list already
	 $CALL	L%CLST			;  No .. so create one
	MOVEM	S1,HANLST		; Save the name of the handle list
	MOVX	S2,H$SIZ		; Get the size of a handle entry
	$CALL	L%CENT			; Create a handle list entry
	MOVE	S1,DEFTHR		; Get the default threshold
	STORE	S1,(S2),H$THR		;  and save it for this dummy
	SETO	S1,			; Set the bytes per message to
	STORE	S1,(S2),H$BPM		;  +infinity so commands go through
	$RETT				; Only success can be had.

; Routine - RLSHAN
;
; Function - To release a handle list entry and to optionally let the
;	     logical front end device (TOPS20) go back to the monitor pool.
;	     The reason that this routine searches for the handle entry in the
;	     list instead of assuming that the CURRENT entry is the one being
;	     used is that the CURRENT pointer may be changed when the TASK is
;	     descheduled whiling in a wait state.
;
; Parameters -
;
;	S2/	Location of handle list entry
;
;  This routine releases the logical front end when the handle list is
;  empty.

RLSHAN:	$SAVE	<TF,S1,T1>		; Save a couple of registers

	MOVE	T1,S2			; Make a copy of list entry address
	SKIPGE	S1,HANLST		; Get handle list name
	 PJRST	RLSFE			;  If no handle list .. go release FE
	$CALL	L%FIRST			; Point to first entry in list
	JUMPF	RLSFE			; If no first entry .. release FE
RLSH.1:	CAMN	T1,S2			; Check for entry address
	 JRST	RLSH.2			;  Yes .. so go kill the entry
	$CALL	L%NEXT			; Move onto the next entry
	JUMPT	RLSH.1			; If an entry exists .. check it
	PJRST	RLSFE			; No more entries .. release FE

RLSH.2:	MOVE	S1,HANLST		; Get the handle list name
	$CALL	L%DENT			; Destroy the handle list entry
	PJRST	RLSFE			; Go conditionally release the FE
	SUBTTL	Enqueue a line or device for current task

; Routine - ENQLIN, ENQDEV
;
; Function -
;	(ENQLIN) To block a line under 2780/3780 from use by any other process.
;		 This allows only one direction of I/O to proceed at a time.
;
;	(ENQDEV) This routine blocks all others from ever using the device we
;		 are talking to so that two processes can't confuse him.
;
; Parameters -
;
;	S1/	Packed device descriptor (Port/Line/Device/Unit)

ENQDEV:	$SAVE	<S1,S2>			; Save registers
	$CALL	QUEDEV			; Make argblk for device specific ENQ
	JRST	ENQ001			; Go do the ENQ

ENQLIN:	$SAVE	<S1,S2>			; Save registers
	$CALL	QUELIN			; Make up argblk for line specific ENQ

ENQ001:
TOPS20 <MOVX	S1,.ENQAA		; Get the enqueue function number
	ENQ>				;  and try to do it.
TOPS10 <HRLI	S2,.ENQAA		; Put function number in left half
	ENQ.	S2,>			;  try the enqueue.
	 $RETF				;  False return if we can't ENQ
	$RETT				; Do a true return
	SUBTTL Enqueue a port for current task

; Routine - ENQD60
;
; Function -
;	(ENQD60) To ENQ a DN60 front end to block others from using it while
;	 	 we are.
; Parameters -
;
;	S1/	Packed device descriptor (Port/Line/Device/Unit)

ENQD60:	$SAVE	<S2>			; Save registers
	$CALL	QUED60			; Make up the argblk for ENQ

TOPS20 <MOVX	S1,.ENQBL		; Get the enqueue function number
	ENQ>				;  and try to do it.
TOPS10 <HRLI	S2,.ENQBL		; Put function number in left half
	ENQ.	S2,>			;  try the enqueue.
	 $RETF				;  False return if we can't ENQ
	$RETT				; Do a true return
	SUBTTL	Dequeue a port, line or device

; Routine - DEQD60, DEQDEV
;
; Function -
;	(DEQD60) To dequeue a DN60 on a port so that others can use it again.
;
;	(DEQDEV) To release a device off a 2780/3780/HASP station so that
;		 someone else can talk to it.
;
; Parameters-
;
;	S1/	Packed device descriptor (Port/Line/Device/Unit)


DEQDEV:	$SAVE	<S1,S2>			; Save registers
	$CALL	QUEDEV			; Make arg block to DEQ specific device
	JRST	DEQ001			; Go do the DEQ

DEQLIN:	$SAVE	<S1,S2>			; Save registers
	$CALL	QUELIN			; Make arg block to DEQ specific line
	JRST	DEQ001			; Go DEQ the line

DEQD60:	$SAVE	<S1,S2>			; Save registers
	$CALL	QUED60			; Make up the DEQ argblk

DEQ001:
TOPS20 <MOVX	S1,.DEQDR		; Get the DEQ function code
	DEQ>
TOPS10 <HRLI	S2,.DEQDR		; Put function in LH w/ addr in rh
	DEQ.	S2,>
	 $RETF				; False return on error.
	$RETT				;  and give a true return on success
	SUBTTL	Create an ENQ/DEQ argument block for a port

; Routine - QUED60
;
; Function - To make up the argument block needed to ENQ/DEQ a specific port.
;
; Parameters -
;
;	S1/	packed device descriptor (only port number used)

QUED60:	$SAVE	<S1>			; Save registers

	MOVEI	S2,QD60BF		; Location of ENQ D60 port string
	ROT	S1,6			; Move high order port number around
	DPB	S1,QPRT1		;  and store it in string
	ROT	S1,3			; Rotate around the low order number
	DPB	S1,QPRT0		;  and store that also
	HRRM	S2,ENQBLK+3		; Store string loc in the byte pointer
	MOVEI	S2,ENQBLK		; Get the location of the ENQ/DEQ block
	$RETT				;  and do a true return
	SUBTTL	Create ENQ/DEQ argument block for a specific device

; Routine - QUEDEV
;
; Function - To make an argument block for the ENQ/DEQ monitor calls to lock
;	or unlock a specific device.  This is so that only one process can
;	talk to a specific device during the life of that process or until
;	it explicitly releases the device.
;
; Parameters -
;
;	S1/	Packed device descriptor (port/line/device/unit)
;	S2/	returns pointer to arg block here

QUEDEV:	$SAVE	<S1,T1,T2>		; Save registers

	MOVEI	S2,QDEVBF		; Get pointer to device Q' string
	MOVE	T2,S1			; Put packed device descriptor in T2
	LSHC	T1,6			; Shift up to high order port number
	DPB	T1,QPRT1		;  and store it
	LSHC	T1,3			; Shift up the low order port number
	DPB	T1,QPRT0		;  and store that too.
	LSHC	T1,6			; Shift up to high order line number
	DPB	T1,QLIN1		;  and store it
	LSHC	T1,3			; Shift up the low order line number
	DPB	T1,QLIN0		;  and store it.
	LSHC	T1,3			; Shift the first digit of device type
	DPB	T1,QDEV2		;  and store it
	LSHC	T1,3			; Repeat for next two digits of the
	DPB	T1,QDEV1		;  device type number
	LSHC	T1,3
	DPB	T1,QDEV0
	LSHC	T1,6			; Shift up the first unit number
	DPB	T1,QUNT1		;  and store it
	LSHC	T1,3			; Get last number of unit and string
	DPB	T1,QUNT0		;  and store it too.
	HRRM	S2,ENQBLK+3		; Store the pointer to the string
	MOVEI	S2,ENQBLK		;  get the pointer to the ENQ block
	$RETT				; Success and return
	SUBTTL	Create ENQ/DEQ argument block for a port/line

; Routine - QUELIN
;
; Function - To make up the argument block needed to ENQ/DEQ a whole station
;	hung off a DN60 line.
;
; Parameters -
;
;	S1/	PDD of the requested station

QUELIN:	$SAVE	<S1,T1,T2>		; Save registers

	MOVEI	S2,QLINBF		; Get pointer to line Q' string
	MOVE	T2,S1			; Put packed device descriptor in T2
	LSHC	T1,6			; Shift up to high order port number
	DPB	T1,QPRT1		;  and store it
	LSHC	T1,3			; Shift up the low order port number
	DPB	T1,QPRT0		;  and store that too.
	LSHC	T1,6			; Shift up to high order line number
	DPB	T1,QLIN1		;  and store it
	LSHC	T1,3			; Shift up the low order line number
	DPB	T1,QLIN0		;  and store it.
	HRRM	S2,ENQBLK+3		; Store the pointer to the string
	MOVEI	S2,ENQBLK		;  and get the pointer to ENQ/DEQ blk
	$RETT				; Only successful returns available
	SUBTTL	OPNFE -- Open a port and return JFN on TOPS20
TOPS20 <

; Routine - OPNFE
;
; Function - To open up a port and check out the 11
;
; Parameters -
;
;	S1/	Packed device descriptor


OPNFE:	SKIPN	KSFLG			; Check for processor type known
	 $CALL	PRCTYP			;  No so type the processor
	SKIPG	KSFLG			; Check for a KS10 (2020)
	 JRST	OPN.22			;  Yes .. so go flush DDCMP buffers
	$SAVE	<S2,T1,T2>		; Save registers
	ACVAR	<PDD,FENM>		; Temporary location to save the packed
					;  device descriptor code and FEn
	MOVE	PDD,S1			; Save the PDD

	SETZM	LSTDTE			; Force a new DTE selection
	LOAD	S1,PDD,PD$PRT		; Get port number to work on.
	SKIPE	FEJFN			; If JFN already assigned .. then
	 PJRST	SELDTE			;  just go select the DTE

	MOVX	FENM,1			; Start with FE device FE1:
	MOVE	S1,PDD			; Get the packed device descriptor
	$CALL	ENQD60			; Enqueue the port and get a JFN.

OPFE2:	MOVE	S1,FENM			; Get the next FE number to try to get.
	CAILE	S1,MAXFE		; Check if have run out of FE:'s
	 JRST	OPDIE			;  Yes .. so let go and crap out.
	$CALL	FENAM			; Make up the front end name
	MOVX	S1,GJ%OLD+GJ%SHT	; Old file, short form of GETJFN
	GTJFN				;  and try it.
	 ERJMP	OPERR1			;   Didn't get it.
	MOVEM	S1,FEJFN		; Save the JFN for everyone
	MOVX	S2,FLD(^d8,OF%BSZ)+OF%RD+OF%WR ; Read/write in 8 bit mode
	OPENF				; Try to open the FE
	 ERJMP	OPERR2			;  nope can't do it to this one.
OPNSEL:	LOAD	S1,PDD,PD$PRT		; Get the DTE number from the PDD
	$CALL	SELDTE			; Go select the DTE
	 JUMPF	OPERR3			;  Didn't select properly
	MOVE	S1,PDD			; Get the PDD back again so that
	PJRST	DEQD60			;  we can release the port and return.


; Here if GTJFN fails on FEn:

OPERR1:	CAIN	S1,GJFX29		; Device available?
	 AOJA	FENM,OPFE2		;  No .. so try next one
	JRST	OPCLR			; Yes it was so just die.

; Here if the DTE select fails

OPERR3:	EXCH	S1,FEJFN		; Save error and get JFN of FE device
	IORX	S1,CZ%ABT		; Set abort and close flag
	CLOSF				; Close the FE device
	 ERJMP	OPCLR			;  Can't release FE device so die
	JRST	OPERRX

; Here if OPENF fails

OPERR2:	EXCH	S1,FEJFN		; Get the JFN of the FE
	RLJFN				; Release the JFN
	 ERJMP	OPCLR			;  Can't release the FE so die.
OPERRX:	HRRZ	S1,FEJFN		; Get the error code back again
	CAIE	S1,OPNX9		; Check for simultaneous access or
	CAIN	S1,OPNX7		;  for device already assigned
	 AOJA	FENM,OPFE2		;  Yes .. so go try another one
	JRST	OPCLR			; No .. we have some other error

; Here on fatal errors that need to dequeue the port

OPCLR:	SETZM	FEJFN			; Clear the JFN before returning
OPDIE:	EXCH	S1,PDD			; Get the device descriptor
	$CALL	DEQD60			; Get rid of the port
	EXCH	S1,PDD			; Get the fatal error back
	$RETF				; And give a failure (false) return.

; Routine - FENAM
;
; Function - To make a name string for a specific front end number. i.e. for
;	front end number 1 we want string "FE1:".
;
; Parameters -
;
;	S1/	FE#
;	S2/	returns pointer to string

FENAM:	MOVE	T2,[POINT 7,FEDEVS,13]	; Point to byte for first digit
	LDB	T1,[POINT 3,S1,32]	; First octal digit
	JUMPE	T1,FEN1			; If zero then suppress it
	ADDX	T1,"0"			;  else make it ASCII
	IDPB	T1,T2			;  and store it in the name
FEN1:	LDB	T1,[POINT 3,S1,35]	; Get 2nd octal digit
	ADDX	T1,"0"			;  make it ASCII
	IDPB	T1,T2			;  and store it in name
	MOVX	T1,":"			; Device name terminator
	IDPB	T1,T2			;  store in the name
	SETZ	T1,			; And the null byte
	IDPB	T1,T2			;  to make it an ASCIZ string
	MOVE	S2,[POINT 7,FEDEVS]	; Pointer to name string
	$RETT				;  and only a true return
	SUBTTL	OPNFE -- Routine to check out the 11 for 2020 TOPS20

; Routine - OPNFE
;
; Function - Under TOPS20 on a 2020 this routine checks to see if the front
;	     end is up and running. It as a side effect also checks to see
;	     if our DDCMP link to the DN200 is running.
;	     If any messages are in the input queue, it is assumed that they
;	     are garbage left from a fatally exited process. They are then
;	     flushed and thrown away.

OPN.22:	$SAVE	<T1,T2,T3,S1,S2>	; Save a register
	LOAD	T2,(S2),H$PRT		; Get the port number
	SUBI	T2,DTEOFF		; Remove the DTE offset
	STORE	T2,(S2),H$HPR		; Store back the DMC line number
	LOAD	T3,(S2),H$PDD		; Get packed device descriptor
	MOVE	S1,T3			; Move to where enq routine expects it
	$CALL	ENQD60			; ENQ the line

OPFE.1:	MOVEI	S2,BTARG		; Point to BOOT argument block
	MOVEM	T2,.BTDTE(S2)		; Set it as the DTE/line in BOOT block
	MOVX	T1,^D500		; Abitrarily large number of bytes
	MOVMM	T1,.BTLEN(S2)		; Set number of bytes to read
	MOVE	T1,[POINT 8,XMSG]	; Point to flush buffer
	MOVEM	T1,.BTMSG(S2)		; Set pointer to 8 bit byte area
	MOVX	S1,.BTRDD		; Read DDCMP message function
	BOOT				; Do the read
	 ERJMP	ERT (D6CTF,OPFE.2)	;  BOOT JSYS failed
	SKIPE	.BTLEN(S2)		; Check for no message returned
	 JRST	OPFE.1			;  Message there .. continue Q flush
	JRST	OPFE.3			; No more .. so return

OPFE.2:	TDZA	TF,TF			; Set error flag
OPFE.3:	 SETOM	TF			;  or set success flag
	$SAVE	<TF,S1>			; Save the failure flag and result code
	MOVE	S1,T3			; Get the PDD again
	PJRST	DEQD60			; Release the line and return
	SUBTTL	PRCTYP -- Routine to type the processor

; Routine - PRCTYP
;
; Function -
;
;	This routine determines whether we are running on a KL or KS system.
;
; Parameters - none
;
; Returns - True always
;
;	KSFLG/	1 if KL, -1 if KS

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

	SETZM	KSFLG			; Set to processor type KL20
	MOVE	S1,[.ABGAD,,.FHSLF]	; Try to get address break
	ADBRK
	 ERJMP	[SETOM	KSFLG		; set to ks20
		 $RETT]
	AOS	KSFLG			; Store process type flag
	$RETT

    > ;End if TOPS20
	SUBTTL	OPNFE -- Routine to check out the 11 for TOPS10
TOPS10 <

; Routine - OPNFE
;
; Function - Under TOPS10 to check to see if the 11 is up and running the
;	proper program.  This will also (obviously) catch if there is a FE
;	there at all.
;
; Parameters -
;
;	S1/	PDD	(packed device descriptor)
;
; Returns - CAL11. error codes


OPNFE:	$SAVE	<T1,P2>			; Save registers

	MOVEI	P2,C11BLK		; Get location of CAL11. arg block
	LOAD	T1,S1,PD$PRT		; Get the port number from handle list
	STORE	T1,(P2),C$PRT		; Store it in the CAL11. block
	MOVX	T1,.C11UP		; CAL11. function to check up/down
	STORE	T1,(P2),C$FNC		;  status of the FE
	MOVE	T1,[1,,C11BLK]
	CAL11.	T1,			; Well ... check it.
	 $RETF				;  It didn't go.
	CAIE	T1,1			; Check for 11 up?
	 JRST	ERT (D6DNR)		;  DN60 not running
	MOVX	T1,.C11NM		; Function to get program name from 11
	STORE	T1,(P2),C$FNC		;  to see if it is our kind.
	MOVE	T1,[1,,C11BLK]
	CAL11.	T1,
	 $RETF				; Doesn't like us for some reason
	CAME	T1,[SIXBIT /DN60  /]	; Check for running DN60 type code
	 JRST	ERT (D6DNR)		;  No .. not running DN60 code
	$RETT				; Else we are golden, give good return.
    > ;End if TOPS10
	SUBTTL	Release front end for any device

; Routine - RLSFE
;
; Function - To release the remote device association with the front end.
;	     What this actually does is close the TOPS20 front end JFN
;	     if it is determined that there are no more devices in this
;	     process that are using the FE JFN.

RLSFE:
TOPS20 <
	$SAVE	<TF,S1>			; Save last error flag and return code
	SKIPG	KSFLG			; If a 2020 then just return
	 $RET				;  saying that front end is released
	SKIPGE	S1,HANLST		; Get list name again
	 $RET				;  If no handle list .. just return
	$CALL	L%FIRST			; Position to first entry
	 JUMPT	.POPJ			; If entry found then return
	MOVE	S1,FEJFN		; Last entry in list is destroyed
	IORX	S1,CZ%ABT		; Don't try to clean up any FE buffers
	CLOSF				; Close the front end
	 JFCL				;  Ignore errors
	SETZM	FEJFN			; Clear the front end JFN
	SETZM	LSTDTE			;  and the last port with it.
    >; End if TOPS20

	$RET				; Return saying that it is done.
	SUBTTL	Search handle linked list for PDD

; Routine - SRCPDD
;
; Function - To search the linked list that contains all the info about all the
;	active handles to see if a device specified is already in the list.
;
; Parameters -
;
;	S1/	PDD	(packed device descriptor)
;
; Returns -
;
;	True	Found the PDD in the table, the current pointer points to it.
;	False	Didn't find the PDD in the table, the current pointer points to
;		 where it was before starting the search

SRCPDD:	$SAVE	<S1,T1,T2>		; Save registers

	MOVE	T1,S1			; Put the PDD into another register so
					;   S1 can be used for subr linkage.
	SKIPGE	S1,HANLST		; Check to see if the list is created
	$CALL	L%CLST			;  and make it if not.
	MOVEM	S1,HANLST		; Save the list name for future tests.

	$CALL	L%CURR			; Point to current entry
	 JUMPF	SRCFST			;  if none .. start at first entry
	LOAD	T2,(S2),H$PDD		; Get the handle in the entry
	CAMN	T1,T2			; Check if this is the one
	 $RETT				;  Yes .. then looking for current one

SRCFST:	MOVE	S1,HANLST		; Reset list name in case of error
	$CALL	L%FIRST			; Point to first entry in list
	JUMPF	@.RETF			; No entries ... so not found

SRCLOP:	LOAD	T2,(S2),H$PDD		; Get the PDD field in the entry
	CAMN	T1,T2			; Compare the PDD against list entry
	 $RETT				;  good compare ... this is it.
	$CALL	L%NEXT			; Move onto the next list entry
	JUMPT	SRCLOP			; If no error then assume entries left.
	$RETF				;  else give a false return
	SUBTTL	Search handle linked list for handle

; Routine - SRCHAN
;
; Function - To search the linked list that contains all the info about all the
;	active handles to see if a device specified is already in the list.
;
; Parameters -
;
;	S1/	Handle of device (received from D60OPN)
;
; Returns -
;
;	True	Found handle in the table, the current pointer points to it.
;	False	Didn't find handle in the table, the current pointer points to
;		 where it was before starting the search

SRCHAN:	$SAVE	<S1,T1,T2>		; Save registers

	MOVE	T1,S1			; Put the PDD into another register so
					;  that S1 can be used for subr linkage
	SKIPGE	S1,HANLST		; Check to see if the list is created
	$CALL	L%CLST			;  and make it if not.
	MOVEM	S1,HANLST		; Save the list name for future tests.

	$CALL	L%CURR			; Point to the current entry
	 JUMPF	HSRFST			;  If no current .. start at first
	LOAD	T2,(S2),H$HAN		; Get the handle in the entry
	CAMN	T1,T2			; See if it is the one we want
	 $RETT				;  Yes .. so point at this current one
HSRFST:	MOVE	S1,HANLST		; Reset list name in case of error
	$CALL	L%FIRST			; Point to first entry in list
	JUMPF	@.RETF			; No entries ... so not found

HSRCLP:	LOAD	T2,(S2),H$HAN		; Get the handle field in the entry
	CAMN	T1,T2			; Compare the handle against list entry
	 $RETT				;  good compare ... this is it.
	$CALL	L%NEXT			; Move onto the next list entry
	JUMPT	HSRCLP			; If no error then assume entries left.
	$RETF				;  and give a false return
	SUBTTL	Return port status

; Routine - PRTSTS
;
; Function - To get the status of a port specified in the given PDD.
;
; Parameters -
;
;	S2/	Pointer to handle list entry
;
; Returns -

PRTSTS:	$SAVE	<T1,T2>			; Save registers
	ACVAR	<ARGP>			; Pointer to port argument block
	$CALL	ALCARG			; Allocate a FEI%O argument block	
	MOVE	ARGP,S1			; Save another copy of arg blk ptr
	MOVX	T1,FC.R6S		; Function to read port status
	MOVEM	T1,(ARGP)		; Put into argument block
	DMOVE	T1,[EXP -D6.BYT		;  Reinitialize the byte count
		    POINT 8,STSBUF]	;  and byte pointer, may be destroyed
	DMOVEM	T1,1(ARGP)
	$CALL	FEI%O			; I/O to the front end (Device status)
	SETZ	S1,			; Default to no error occured
	SKIPT				; If an error occured
	 LOAD	S1,(ARGP),ARG$RC	;  get the result code
	EXCH	S1,ARGP			; Exchange error code and blk ptr
	$CALL	RLSARG			; Release the argument block
	MOVE	S1,ARGP			; Get the error code again
	JUMPE	S1,@.RETT		; If no error then give success
	$RETF				;  else give error return
	SUBTTL	Return device status

; Routine - DEVSTS
;
; Function - To get the status of a device specified in the given PDD.
;
; Parameters -
;
;	S2/	Pointer to handle list entry
;
; Returns -

DEVSTS:	$SAVE	<T1,T2>			; Save registers
	ACVAR	<ARGD>			; Pointer to device argument block
	$CALL	ALCARG			; Allocate a FEI%O argument block	
	MOVE	ARGD,S1			; Save another copy of arg blk ptr
	MOVX	T1,FC.RDS		; Function to read device status
	MOVEM	T1,(ARGD)		; Put into argument block
	DMOVE	T1,[EXP -DS.BYT		;  Reinitialize the byte count
		    POINT 8,STSBUF]	;  and byte pointer, may be destroyed
	DMOVEM	T1,1(ARGD)
	$CALL	FEI%O			; I/O to the front end (Device status)
	SETZ	S1,			; Default to no error occured
	SKIPT				; If an error occured
	 LOAD	S1,(ARGD),ARG$RC	;  get the result code
	EXCH	S1,ARGD			; Exchange error code and blk ptr
	$CALL	RLSARG			; Release the argument block
	MOVE	S1,ARGD			; Get the error code again
	JUMPE	S1,@.RETT		; If no error then give success
	$RETF				;  else give error return
	SUBTTL	Return line status

; Routine - LINSTS
;
; Function - To get the status of a line specified in the given PDD.
;
; Parameters -
;
;	S2/	Pointer to handle list entry
;
; Returns -

LINSTS:	$SAVE	<T1,T2>			; Save registers
	ACVAR	<ARGL>			; Pointer to line argument block
	$CALL	ALCARG			; Allocate a FEI%O argument block	
	MOVE	ARGL,S1			; Save another copy of arg blk ptr
	MOVX	T1,FC.RLS		; Function to read line status
	MOVEM	T1,(ARGL)		; Put into argument block
	DMOVE	T1,[EXP -LS.BYT		;  Reinitialize the byte count
		    POINT 8,STSBUF]	;  and byte pointer, may be destroyed
	DMOVEM	T1,1(ARGL)
	$CALL	FEI%O			; I/O to the front end (Device status)
	SETZ	S1,			; Default to no error occured
	JUMPT	LNST.5			; If no error .. continue on

	SETZM	STSBUF			; Clear first word in status buffer
	MOVE	S1,[XWD STSBUF,STSBUF+1] ; Point to the status buffer and
	BLT	S1,STSBUF+<LS.BYT-1>/4	;  clear all words
	LOAD	S1,(ARGL),ARG$RC	; Get the failure result code

LNST.5:	EXCH	S1,ARGL			; Exchange error code and blk ptr
	$CALL	RLSARG			; Release the argument block
	MOVE	S1,ARGL			; Get the error code again
	JUMPE	S1,@.RETT		; If no error then give success
	$RETF				;  else give error return
	SUBTTL	SETIOM -- Set the I/O mode of a device

; Routine - SETIOM
;
; Function - To determine whether a device is setup to do input or output and
;	save a flag in the handle list entry for future reference.
;
; Parameters -
;
;	S2/	Location of handle list entry

SETIOM:	$SAVE	<S1,T1>			; Save a couple of registers

	LOAD	S1,(S2),H$STY		; Get the station type code
	CAIN	S1,SLHSP		; Check for a HASP station
	 JRST	STHSP			;  Yes .. go get IOM from device status
	SETZ	T1,			; On 2780/3780 figure out IOM
	LOAD	S1,(S2),H$DEV		;  from the device type
	CAIN	S1,.OPCDR		;  which if it is a card reader
	 MOVX	T1,1			;  then it's doing input
	LOAD	S1,(S2),H$TEM		;  unless we are in
	SKIPE	S1			;  emulation mode in which case
	 TXC	T1,1			;  the I/O goes in the other direction
	JRST	SETDNE			; Done figuring out for a 2780/3780

STHSP:	LOAD	S1,(S2),H$DEV		; Get D60OPN device number
	CAIN	S1,.OPSGN		; Check for signon device
	 JRST	STHP.1			;  Yes .. so infer default of input
	CAIE	S1,.OPCIN		; Check for console input device
	CAIN	S1,.OPCOU		;  or for console output device
	 CAIA				;   Yes .. set I/O mode
	  JRST	HSPDEV			;  No .. so get I/O mode from DN60
	SETZ	T1,			; Default to output device
	CAIN	S1,.OPCIN		; Check for console input device
STHP.1:	 MOVX	T1,1			;  Yes so set to input mode
	LOAD	S1,(S2),H$TEM		; Get termination/emulation mode flag
	SKIPE	S1			; Check for termination
	 TXC	T1,1			;  No .. so reverse the I/O direction
	JRST	SETDNE			; Go store mode and return

HSPDEV:	$CALL	DEVSTS			; Get the device status
	 JUMPF	@.RETF			;  Can't get status so fail.
	LOAD	T1,,SDFLG		; Get the flags on the device
	LOAD	T1,T1,SDIOM		; Get the I/O mode flag

SETDNE:	STORE	T1,(S2),H$IOM		; Save the I/O mode for this device
	$RETT				; Return succesfully
	SUBTTL	ALCARG, RLSARG -- FEI%O argument block allocation/release

; Routine - ALCARG
;
; Function - This routine allocates a dynamic argument block for use with
;	     FEI%O.
;
; Parameters -
;
;	S1/	Pointer to block returned here

ALCARG:	$SAVE	<S2>			; Save a GLX parameter register
	MOVX	S1,ARGSIZ		; Size of argument block
	$CALL	M%GMEM			; Get from GLX memory mangler
	MOVE	S1,S2			; Move pointer to return register
	$RET				; Return, ignoring errors

; Routing - RLSARG
;
; Function - This routine releases a FEI%O argument block that was allocated
;	     with ALCARG.
;
; Parameters -
;
;	S1/	Location of argument block

RLSARG:	$SAVE	<TF,S1,S2>			; Save GLX parameter register
	MOVE	S2,S1			; Move block pointer
	MOVX	S1,ARGSIZ		; Size of argument block
	PJRST	M%RMEM			; Give it back to GLXLIB and return
	SUBTTL	LINCMD, DEVCMD -- Output a line (device) command

; Routine - LINCMD, DEVCMD
;
; Function - To output a DN60 line (device) command to the line (device)
;	specified in the handle entry.
;
; Parameters -
;
;	S1/	Line (device) command function code
;	S2/	Handle list entry
;	T1/	Command value (optional)

LINCMD:	ACVAR	<ARGC,FC,CLEN>		; Arg blk ptr, func code, cmd length
	MOVX	FC,FC.WLC		; Function code to write a line command
	MOVE	CLEN,LNCBYT(S1)		; Get number of bytes in value for cmd
	JRST	CNTCMD			; Continue on common command code

DEVCMD:	ACVAR	<ARGC,FC,CLEN>		; Arg blk ptr, func code, cmd length
	MOVX	FC,FC.WDC		; Function code to write a device cmd
	MOVE	CLEN,DVCBYT(S1)		; Get number of bytes in cmd string

CNTCMD:
	LOAD	TF,(S2),H$THR		; Get offline threshold for device
	PUSH	P,TF			; Save the offline threshold
	SETZ	TF,			; Set threshold so that when a delay
	STORE	TF,(S2),H$THR		;  occurs .. off line returns
	MOVE	ARGC,S1			; Save the command number
	$CALL	ALCARG			; Allocate a FEI%O arg block
	EXCH	S1,ARGC			; Swap arg blk ptr and command number
	STORE	FC,(ARGC),ARG$FC	; Save the function code (write cmd)
	STORE	S1,(ARGC),CMD$FC	; Put command function in cmd string
	CAIN	CLEN,1			; Check for only 1 byte in cmd string
	 JRST	SNDCMD			;  Yes .. so no data follows it.
	CAIN	CLEN,2			; Check for 2 bytes in cmd string
	 JRST	B1CMD			;  Yes .. so 1 byte of data follows
	STORE	T1,(ARGC),CMD$2B	; Otherwise we have 2 bytes of data
	JRST	SNDCMD			;  to send
B1CMD:	STORE	T1,(ARGC),CMD$1B	; Store the single byte of cmd data
SNDCMD:	MOVNS	CLEN			; Make the byte count and
SNDC.1:	MOVE	S1,[POINT 8,]		; Make a pointer to the command string
	HRRI	S1,CMD$WD(ARGC)		;  in dynamic memory
	STORE	S1,(ARGC),ARG$PT	; Put it into the FE I/O arg block
	STORE	CLEN,(ARGC),ARG$BC	; Set the number of bytes to output
	MOVE	S1,ARGC			; Point to the arg block
	$CALL	FEI%O			;  and do the I/O to the front end
	SETZ	S1,			; Default to no error occured
	JUMPF	[LOAD	S1,(ARGC),ARG$RC ; Get the result code on error
		 CAIE	S1,D6DOL	; Check for device off line (delayed)
		  JRST	.+1		;  Nope .. some other obtuse error 
		 SNOOZE	SEC		; Yes .. sleep for a second and
		 JRST	SNDC.1]		;  retry until it works
	EXCH	S1,ARGC			; Exchange error code and blk ptr
	$CALL	RLSARG			; Release the argument block
	MOVE	S1,ARGC			; Get the error code again
	POP	P,TF			; Get real offline threshold back
	STORE	TF,(S2),H$THR		;  and put into handle list entry
	JUMPE	S1,@.RETT		; If no error then give success
	$RETF				;  else give error return
	SUBTTL	Routines -- SWAPB, SWAP32

; Routines - SWAPB, SWAP32
;
; Function - To swap the bytes in 16 bit numeric values before they are
;	shipped to the DN60 front end.  This is needed because the FE
;	always swaps the bytes so that text strings are properly accessable.
;
; Parameters -
;
;	T1/	Value be swapped

; SWAPB returns the 16 bit value in the lower order 15 bits of T1

SWAPB:	$SAVE	<S1,S2>			; Save a couple of registers
	SETZB	S1,S2			; Clear them out
	ROTC	S2,-^d8			; Shift high order byte into S2
	LSHC	S1,^d8			; Shift it into S1
	ROTC	S2,-^d8			; Shift the low order byte into S2
	LSHC	S1,^d8			; Shift it lower into S1
	MOVE	T1,S1			; Move to return value
	$RET				; Give any old return .. no T/F

REPEAT 0,<
; SWAP32 Reverses the order of the 4 8bit bytes in T1

SWAP32:	$SAVE	<S1,S2>			; Save a couple of registers

	SETZB	S1,S2			; Clear them out
	ROTC	S2,-^d8			; Shift the high order byte
	LSHC	S1,^d8			; Put into bottom of S1
	ROTC	S2,-^d8			; Shift next byte down
	LSHC	S1,^d8			; Put below MSB in S1
	ROTC	S2,-^d8			; Same for 3rd byte
	LSHC	S1,^d8			;  and add into S1
	ROTC	S2,-^d8			; Shift the LSB into S2
	LSHC	S1,^d8			; Put as lowest byte in S1
	MOVE	T1,S1			; Return value
	$RET				;  and go back
    > ;End REPEAT 0
	SUBTTL	Select a DTE on the open FEn device
TOPS20 <

; Routine - SELDTE
;
; Function - To select which DTE is currently attached to the FEn: device
;	that was previously opened.  This routine assumes that the caller
;	has already enq'd the port.
;
; Parameters -
;
;	S1/	DTE # to be selected
;
; Returns -
;
;	True	was successful
;	False	MTOPR Jsys failed and the error code is in S1
;
; Note - It has been verified by looking at the monitor listings that this
;	routine does not need the port ENQ'd before selecting the DTE.

SELDTE:	MOVX	S2,.MODTE		; Select the appropriate DTE
	HRROI	T1,-10(S1)		; Get the port number
	CAMN	T1,LSTDTE		; Was it the same as the last one used?
	 $RETT				;  Yes so assume he is still set up.
	HRRZ	T1,T1			; Make it only the DTE number
	MOVE	S1,FEJFN		; Use the FE JFN already opened
	MTOPR				; Do the select
	 ERJMP	DSLERR			;  Didn't work, bad DTE
	HRROM	T1,LSTDTE		; Save the last DTE to be selected
	$RETT				; It is now selected on the DTE

DSLERR:	SETZM	LSTDTE			; Clear the last DTE selected (none)
	MOVX	S1,.FHSLF		; Get the last error that occured
	GETER				;  in this process
	HRRZ	S1,S2			; Set the error value 
	$RETF				;  and return flaging failure.

    >; End if TOPS20
	SUBTTL	FEI%O -- Front end I/O interface

; Routine - FEI%O
;
; Function - To do I/O to a device as specified by an argument block and the
;	data in the specified handle list entry.
;
; Parameters -
;
;	S1/	Location of argument block
;	S2/	Pointer to handle list entry
;
;	argument block format:
;			0/	function code
;			1/	negative number of bytes to transfer
;			2/	byte pointer to buffer to transfer from/to
;			3/	number of bytes actually transfered
;			4/	result code from I/O

FEI%O:
	SUBTTL	FEI%O -- TOPS20 SIN/SOUT front end interface (.C11QU functions)
TOPS20 <

	$SAVE	<P1,P2,T1,T2,T3,T4>	; Save registers

	DMOVE	P1,S1			; Set up arg and handle structure ptrs

	SETZM	NBXFRD(P2)		; Clear the number of bytes transfered
	SETZM	NBSDLY(P2)		; Clear number of bytes since last dly
	LOAD	S1,(P2),H$PRT		; Get the DTE #
	CAIL	S1,DTEOFF		; Check to see if the DTE # is within
	CAILE	S1,MAXDTE		;  valid bounds
	 JRST	ERT (D6NSP,FIOFAI)	;   Port number not defined
	SKIPL	KSFLG			; Check for KL style I/O
	 JRST	[$CALL	SELDTE		;  Make the link to the correct DTE
		  JUMPF	FIOFAI		;   If didn't work give error return
		 JRST .+1]		;  Go back to inline code
	LOAD	T1,(P1),ARG$BC		; Get the number of bytes to transmit
	JUMPGE	T1,ERT (D6CNN,FIOFAI)	; Must be greater than zero bytes
	MOVEM	T1,NBTXFR(P2)		; Save number of bytes yet to transfer
	LOAD	S1,(P2),H$PDD		; Get device descriptor
	$CALL	ENQD60			; Enqueue the port for SIN/SOUT I/O
	LOAD	T1,(P1),ARG$PT		; Get the pointer to the buffer area
	HLRZ	T2,T1			; Get the position/size part
	CAIN	T2,-1			; If it is a HRRO type byte pointer
	 HRLI	T1,440700		;  then convert it to a real byte pntr
	STORE	T1,(P1),ARG$PT		; Put the byte pointer back
	LOAD	T1,(P1),ARG$FC		; Get function code to perform
	STORE	T1,,XMTFC		; Put it into 2nd byte in header
	LOAD	T1,(P2),H$LIN		; Get line number to do I/O to.
	STORE	T1,,XMTLN		; Put it into 3rd byte in header
	LOAD	T1,(P2),H$CDV		; Get communications device number
	STORE	T1,,XMTDV		; Put the device code in the 4th byte
	LOAD	T1,(P1),ARG$FC		; Get the function we are doing
	TRNN	T1,1			; If it is odd then we do a read
	 JRST	WRITE			;  else we are doing a write operation.
	JRST	READ			; Go do read
	SUBTTL	FEI%O -- Read in from device (TOPS20)

READ:	$CALL	PUTHDR			; Output the header to say read data
	$FELOG	(BEFORE)		; Log "BEFORE" event on FE device
	 JUMPF	FIOFDQ			;  Header failure test
	$CALL	GETHDR			; Get the response header
	 JUMPF	FIOFDQ			;  Input header no good
	LOAD	S1,,RCVRC		; Get the result of the header
	CAIN	S1,RC.REJ		; Check for reject of header
	 JRST	FIOFDQ			;  If so .. terminate this read
	CAIE	S1,RC.DLY		; Check for a delayed return
	 JRST	READOK			;  No .. so continue on reading
	LOAD	S1,(P2),H$DLY		; Get the transfered delayed count
	AOJ	S1,			; Increment the number of delays
	STORE	S1,(P2),H$DLY		;  and save it for next check
	LOAD	S2,(P2),H$THR		; Get the off-line threshold
	CAML	S1,S2			; Check for off-line by inference
	 JRST	ERT (D6DOL,FIOFDQ)	;  Yes .. too long to respond
	$FELOG	(AFTER)			; Log that a delay has occured
	$CALL	FIOSLP			; Dismiss while waiting for -11 to
	JRST	READ			;  catch up .. then try again

READOK:	LOAD	T1,,RCVBC		; Number of bytes to read in
	JUMPE	T1,ERT (RC.REJ,FIOFDQ)	; Can't talk to FE if no bytes Xfer'd
	MOVE	S1,FEJFN		; Get JFN for logical FE
	LOAD	S2,(P1),ARG$PT		; Get byte pointer to data buffer
	MOVN	T1,T1			; Negative the byte count to read
	SKIPG	KSFLG			; Check for 2020 style I/O
	 JRST	RD.220			;  Yes so go do boots
	SIN				; Read in the data string
	 ERJMP	ERT (D6CTF,FIOFDQ)	;  The input JSYS failed
	STORE	S2,(P1),ARG$PT		; Save the pointer to continue on
	$CALL	IOBRK			; Force all the input to be done
	 JUMPF	FIOFDQ			;  The force didn't work
	JRST	RD.WRK			; Input worked .. continue on

RD.220:	$CALL	RD2020			; Do a 2020 style read data string
	 JUMPF	FIOFDQ			;  Input failed
	STORE	S2,(P1),ARG$PT		; Save byte pointer for continuation

RD.WRK:	ZERO	((P2),H$DLY)		; Clear delayed return count
	LOAD	T1,,RCVBC		; Get the byte count to read again.
	ADDM	T1,NBXFRD(P2)		; Up the bytes transfered count
	ADDB	T1,NBTXFR(P2)		; Down the bytes yet to transfer
	JUMPGE	T1,FIOTDQ		; Test for no more bytes yet to move
	LOAD	T1,(P2),H$RTI		; Get return immediately on any data
	JUMPN	T1,FIOTDQ		; If set .. return on partial transfer
	$FELOG	(AFTER)			; Log that partial read has been done
	JRST	READ			; Go continue transfer
	SUBTTL	FEI%O -- Write out to device (TOPS20)

WRITE:	$CALL	PUTHDR			; Output the transmit header
	$FELOG	(BEFORE)		; Log "BEFORE" event on FE device
	 JUMPF	FIOFDQ			;  The header transmission failed
	MOVE	S1,FEJFN		; Get the JFN to do I/O on
	LOAD	S2,(P1),ARG$PT		; Point to the string to output
	LOAD	T1,,XMTBC		; Number of bytes to output
	MOVN	T1,T1			; Make negative for JSYS size delimit
	SKIPG	KSFLG			; Check for 2020 style I/O
	 JRST	WR.220			;  Yes .. go do the BOOTS
	SOUT				; Output the string
	 ERJMP	ERT (D6CTF,FIOFDQ)	;  The SOUT failed .. can't talk to FE
	MOVEM	S2,LSTPNT(P2)		; Save the pointer to last byte
	$CALL	IOBRK			; Force the output to the -11
	 JUMPF	FIOFDQ			;  Die if the output didn't go to -11
	JRST	WRT.23			; Data output just fine .. continue

WR.220:	$CALL	WR2020			; Output string 2020 style
	 JUMPF	FIOFDQ			;  Output failed .. release the device
	MOVEM	S2,LSTPNT(P2)		; Save the updated byte pointer

WRT.23:	$CALL	GETHDR			; Get the -11's reply to transmission
	 JUMPF	FIOFDQ			;  Die if we can't get the result
	LOAD	S1,,RCVRC		; Get the result code
	CAIN	S1,RC.REJ		; Check for a reject
	 JRST	FIOFDQ			;  and if so .. give failure return
	LOAD	T1,,RCVBC		; Get the number of bytes sent
	ADDM	T1,NBXFRD(P2)		;  add onto number of bytes transfered
	ADDM	T1,NBSDLY(P2)		;  add onto bytes since last delay
	ADDB	T1,NBTXFR(P2)		; Remove from number of bytes yet to do
	CAIE	S1,RC.DLY		; Check for a delayed I/O return
	 JRST	WRTOK			;  No .. so the -11 is ready
	SETZM	NBSDLY(P2)		; Clear bytes transfered since this dly
	LOAD	S1,(P2),H$DLY		; Get the delayed count
	AOJ	S1,			; Increment it
	STORE	S1,(P2),H$DLY		;  and save it back
	LOAD	S2,(P2),H$THR		; Get the offline threshold
	CAML	S1,S2			; Check for offline inference
	 JRST	ERT (D6DOL,FIOFDQ)	;  Yes .. the device seems offline
	$FELOG	(AFTER)			; Log that a delay has occured
	$CALL	FIOSLP			; Dismiss process for a while
	JRST	WRITE			; Go retry to output

WRTOK:	ZERO	((P2),H$DLY)		; Clear the delayed output counter
	MOVE	S2,LSTPNT(P2)		; Get the pointer to last byte
	STORE	S2,(P1),ARG$PT		; Save byte pointer to next byte
	JUMPGE	T1,FIOTDQ		; If none left .. then successful
	$FELOG	(AFTER)			; Log partial transfer done
	MOVE	S1,NBSDLY(P2)		; Get number of bytes since last delay
	CAIL	S1,RLSTHR		; Check against release threshold
	 $CALL	FIOSLP			;  Yes .. let go for a second
	JRST	WRITE			; Go finish writing
	SUBTTL	FEI%O -- Routine PUTHDR, GETHDR, IOBRK (TOPS20)

; Routine - PUTHDR
;
; Function - To create a transmit header for read/write function that contains
;	the number of bytes to read/write in it. This routine is invoked before
;	each read/write is done if more data is needed to be read/written.
;	This routines also transmits the header and makes sure that it has gone
;	out.

PUTHDR:	MOVM	T1,NBTXFR(P2)		; Get # of bytes left to read/write

	LOAD	T2,(P2),H$BPM		; Get number of bytes per message
	SKIPG	KSFLG			; Check for DDCMP (2020) line
	 MOVX	T2,^O274		;  Max number of bytes for DMC driver

	CAMLE	T1,T2			; Check to see if number of bytes legal
	 MOVE	T1,T2			;  Too many .. truncate 1st message
	STORE	T1,,XMTBC		; Store in the # bytes to transfer cnt
	MOVE	S1,FEJFN		; Get the JFN for the FE
	MOVE	S2,[POINT 8,XMTHDR]	; Point to the transmit header
	MOVX	T1,-6			; Get the string byte count
	SKIPG	KSFLG			; Check for 2020 style I/O
	 JRST	PTH.22			;  Yes .. go do the BOOTS
	SOUT				; Output the header to the device
	 ERJMP	ERT (D6CTF)		;  Can't talk to FE
	PJRST	IOBRK			; Make sure the header gets output.

PTH.22:	$CALL	WR2020			;  and output the header 2020 style
	$RET				; Propagate return success/failure

; Routine - GETHDR
;
; Function - To read a receive header from the port that we are currently
;	talking to.

GETHDR:	MOVE	S1,FEJFN		; Get the JFN of the FE
	MOVE	S2,[POINT 8,RCVHDR]	; Point to the receive header string
	MOVX	T1,-6			; 6 bytes in the header
	SKIPG	KSFLG			; Check for 2020 style I/O
	 JRST	GTH.22			;  Go do the BOOTS
	SIN				; Read the header from the FE
	 ERJMP	ERT (D6CTF)		;  Can't talk to FE
	PJRST	IOBRK			; Force the header to be read

GTH.22:	$CALL	RD2020			; Read header 2020 style
	$RET				; Propagate error return code
; Routine - IOBRK
;
; Function - To create a break in the I/O stream and force the current buffers
;	to be flushed or finished reading in.


IOBRK:	MOVE	S1,FEJFN		; Get the JFN of the FE device
	MOVX	S2,.MOEOF		; Get the EOF function
	MOVX	T1,1			; Clear FE buffers w/o doing real EOF
	MTOPR				; Force I/O completion
	 ERJMP	ERT (D6CTF)		;  Can't talk to FE
	$RETT				; The I/O was completed succesfully.


; Routine - FIOSLP
;
; Function - This routine saves the transmission header before dismissing
;	     the process. This is needed during FEI%O (TOPS20) execution
;	     to insure if the host program is a multi-tasker, that the
;	     header is still intact and the port is DEQ/ENQ for others to use.

FIOSLP:	$SAVE	<XMTHDR,XMTHDR+1>	; Save the transmission header
	LOAD	S1,(P2),H$PDD		; Get the packed device descriptor
	$CALL	DEQD60			; Release the port for some other task
FIOS.1:	SNOOZE	SEC*TIMDLY,IOWAIT	; Delay on time (or IO done if tasking)
	LOAD	S1,(P2),H$PDD		; Get the packec device desriptor again
	$CALL	ENQD60			; Try to get the port back again
	$RET
	SUBTTL	FEI%O -- Routines FIOTDQ, FIOFDQ, FIOFAI (TOPS20)

;
; Common return point for the FEI%O routines after the port has been ENQ'd.
;  This is for good (successful) returns that give a zero result code.
;

FIOTDQ:	LOAD	S1,(P2),H$PDD		; Get the port number
	$CALL	DEQD60			; Dequeue the port
	ZERO	((P1),ARG$RC)		; Clear the result code for good signal
	MOVE	S1,NBXFRD(P2)		; Get the number of bytes transfered
	STORE	S1,(P1),ARG$XF		;  and return that also
	MOVE	S1,NBTXFR(P2)		; Get number of bytes not transfered
	STORE	S1,(P1),ARG$BC		; Save it as the byte count
	DMOVE	S1,P1			; Restore the arg registers
	$FELOG	(AFTER)			; Log the successful result from 11
	$RETT				; Return with success

;
; Common failure return point before the port is enqueued
;

FIOFAI:	STORE	S1,(P1),ARG$RC		; Save the error result code
	JRST	FIOFD0			; Go to common error exit

;
; Common failure return point .. Deq's the port and stores the error code
;

FIOFDQ:	STORE	S1,(P1),ARG$RC		; Save the result code
	LOAD	S1,(P2),H$PDD		; Get the packed device descriptor
	$CALL	DEQD60			; Release the port
	MOVE	S1,NBTXFR(P2)		; Get number of bytes not transfered
	STORE	S1,(P1),ARG$BC		; Save it as the byte count

FIOFD0:	MOVE	S1,NBXFRD(P2)		; Get the number of bytes transfered
	STORE	S1,(P1),ARG$XF		;  and return that also
	DMOVE	S1,P1			; Restore the 2nd arg register
	$FELOG	(AFTER)			; Log the failed result from 11
	$RETF				; Return type of a failure
	SUBTTL	Support for DN200 running DN65B code on a TOPS20 2020


; Routine WR2020
;
; Function - This routine is used to simulate the SOUT to a front end
;	     device. It actually ships the data over a synchronous link
;	     using DDCMP to a DN200
;
; Parameters -
;
;	S1/	Ignored JFN
;	S2/	Byte pointer to string
;	T1/	Negative byte count

WR2020:	SKIPLE	T1			; Check for valid byte count LSS 0
	 JRST	ERT (D6CNN)		;  Byte count not negative
	MOVMM	T1,.BTLEN+BTARG		; Set the byte count to transfer
	MOVEM	S2,.BTMSG+BTARG		; Set pointer to 8 bit byte area
	LOAD	S1,(P2),H$HPR		; Get synchronous line number
	MOVEM	S1,.BTDTE+BTARG		; Set it as the DTE/line in BOOT block
	MOVEI	S2,BTARG		; Get location of BOOT arg block
	MOVX	S1,.BTSDD		; Send DDCMP message to DN200
	BOOT
	 ERJMP	ERT (D6CTF)		;  BOOT JSYS failed
	MOVE	S2,.BTMSG+BTARG		; Get update byte pointer
	SETZ	T1,			; Say that all the bytes where output
	$RETT				; Sucess in sending data
; Routine RD2020
;
; Function - To read a string from a DN200 that is connected by a DDCMP
;	     synchronous link. This routine simulates the SIN JSYS that
;	     is normally used with a front end device.
;
; Parameters -
;
;	S1/	Ignored JFN
;	S2/	Byte pointer to input buffer
;	T1/	Negative byte count to input

RD2020:	DMOVEM	S2,RDSAVE		; Save the read arguments
	MOVX	S1,20			; Set up the retry counter so that
	MOVEM	S1,RETRY		;  we try at least 2 seconds worth
	LOAD	S1,(P2),H$HPR		; Get synchronous line number
	MOVEM	S1,.BTDTE+BTARG		; Set it as the DTE/line in BOOT block

RD20ST:	MOVMM	T1,.BTLEN+BTARG		; Set the byte count to transfer
	MOVEM	S2,.BTMSG+BTARG		; Set pointer to data buffer
	MOVEI	S2,BTARG		; Get location of BOOT arg block
	MOVX	S1,.BTRDD		; Read DDCMP message function
	BOOT				; Do the read
	 ERJMP	ERT (D6CTF)		;  BOOT JSYS failed
	MOVE	S1,.BTLEN+BTARG		; Get transfered length/error code
	JUMPE	S1,R20RTY		; If zero .. must try again
	TXNN	S1,BT%CTL		; Check for control message flag
	 JRST	R20OK			;  No .. so message was read ok
	CAXE	S1,BT%CTL+.BTCMP	; Transmission complete?
	 JRST	ERT (D6DNR)		;  No .. so front end not running
	JRST	R20AGN			; Try to read it again
R20RTY:	SOSGE	S1,RETRY		; Have we already tried enough?
	 JRST	ERT (D6DNR)		;  Yes .. so front end not running
	MOVE	S1,[DEC 1000,1000,1000,1000,1000,100,100,100
		    DEC 100,100,100,100,100,100,100,100](S1)
	DISMS				; Increasing sleep increments
					;  with time
R20AGN:	DMOVE	S2,RDSAVE		; Get the arguments back again
	JRST	RD20ST			; Go try to read it again

R20OK:	MOVE	T1,S1			; Get the count of bytes transfered
	ADD	T1,RDSLEN		; Make it minus the number yet to get
	MOVE	S2,.BTMSG+BTARG		; Get updated byte pointer
	$RETT				; Success

    >;End if TOPS20
	SUBTTL	FEI%O -- TOPS10 CAL11. interface (.C11QU function)

TOPS10 <
	$SAVE	<S1,S2,P1,P2,P3,T4>	; Save registers

	DMOVE	P1,S1			; Setup regs for structure accesses

	MOVX	S1,C$SIZ		; Get size of a CAL11. argument block
	$CALL	M%GMEM			; Get a block from memory mangler
	MOVE	P3,S2			; Point to the new, fresh block
	PUSH	P,[FIORET]		; Put memory release co-routine into
					; return path

	LOAD	S2,(P2),H$PRT		; Get the port number
	STORE	S2,(P3),C$PRT		; Save it in the CAL11. block
	LOAD	S2,(P2),H$LIN		; Get the line number
	STORE	S2,(P3),C$LIN		; Save it also
	LOAD	S2,(P2),H$CDV		; Get device number to talk to
	STORE	S2,(P3),C$DEV		; Save in argument block

	LOAD	S1,(P1),ARG$FC		; Get the desired function to perform
	STORE	S1,(P3),C$FC		; Save in CAL11. argument block
	MOVX	S1,.C11QU		; We assume that all CAL11. functions
	STORE	S1,(P3),C$FNC		;  are subfunctions of the "queue" func

	LOAD	S1,(P1),ARG$PT		; Get the byte pointer to the string
	LOAD	S2,S1,BP.ADR		; Get the address of the string
	STORE	S2,(P3),C$BFA		;  and store as where the string starts
	LOAD	S2,S1,BP.SIZ		; Get the byte size
	CAIN	S2,77			; Check for HRRO type byte pointer
	 MOVX	S2,7			;  and if so assume ASCII (7bit)
	MOVE	S2,[0,,6		; Get the number of bytes per word
		    0,,5		;  depending on the number of bits
		    0,,4]-6(S2)		;  per byte in the string
	STORE	S2,(P3),C$BPW		; Save in CAL11. bytes per word entry
	LOAD	S2,S1,BP.POS		; Get the position of the first byte
	CAIN	S2,77			; Check again for a HRRO pointer
	 MOVX	S2,44			;  and start at MSB if so.
	SUBX	S2,44			; Remove the number of bits per word
	MOVM	S1,S2			; Get the magnitude of the difference
	LOAD	S2,(P3),C$BPW		; Retrieve the number of bytes per word
	IDIV	S1,S2			; Divide to get the position of the
	STORE	S1,(P3),C$PFB		;  first byte in the first word.
	LOAD	S2,(P1),ARG$BC		; Get the number of bytes to transfer
	MOVM	S2,S2			; Get it as a positive number
	STORE	S2,(P3),C$NBT		; Save byte count to transfer
	ADDI	S2,-1(S1)		;  add on the position of first byte -1
	HRRZ	S1,S2			; Move them around so that
	LOAD	S2,(P3),C$BPW		;  we can divide by the number of bytes
	IDIV	S1,S2			;  per word and then increment by
	AOJ	S1,			;  one to round off the odd word
	STORE	S1,(P3),C$BFS		; Store as the buffer size in words.

FERTRY:	ZERO	((P3),C$RC)		; Clear out the result code

	HRLI	S1,C$SIZ		; Length of CAL11. block
	HRR	S1,P3			; Location of CAL11. block
	$FELOG	(BEFORE)		; Log the data before sending it
	CAL11.	S1,			;  for the talk to the 11.
	 JRST	FEERR			;   Error while talking to 11
	$FELOG	(AFTER)			; Log the result from the 11
	LOAD	S1,(P3),C$BXF		; Get the number of byts transfered
	STORE	S1,(P1),ARG$XF		;  and return in to the caller
	LOAD	S1,(P3),C$RC		; Get the result code of the transfer
	STORE	S1,(P1),ARG$RC		;  return that also to the caller
	$RETT				; Return with a good indication

FEERR:	$FELOG	(AFTER)			; Log the failure from the 11
	CAIE	S1,C11IU%		; Was the 11 in use when we tried it?
	 JRST	FEFATL			;  No .. we got some other fatal error
	SNOOZE	SEC*TIMOFF		; Take time off to give the other user
	JRST	FERTRY			;  a chance to release the 11 and retry

FEFATL:	STORE	S1,(P1),ARG$RC		; Store error code for the caller to
	$RETF				;  see and return falsely.


; All return paths from FEI%O go through here.

FIORET:	$SAVE <TF>			; Save result code
	MOVX	S1,C$SIZ		; Get size of block
	MOVE	S2,P3			; Location of block
	PJRST	M%RMEM			; Release memory and return
    > ;End if TOPS10
	SUBTTL	Data area - Locals (to this fork)

LOCALS:					; This label must be first in local
					;  data base area.

IFN FTDEBUG,<
LOGFLG:: BLOCK	1			; Logging flags
    >; End if FTDEBUG

ENQBLK:	XWD	1,5			; 1 lock,,length of block is 5
	XWD	0,0			; PSI chn 0,, ID
TOPS10 <BYTE	(2)1(16)0(18)-2>	; No PSI or level and exclusive access
TOPS20 <EXP	EN%BLN+EN%LTL+<0,,-3>>	; long term data base,, Operator only
	POINT	7,0			; Pointer to string of resource name
	XWD	0,0			; 1 resource,, number of accesses

QPRT0:	POINT	3,1(S2),20		; Low order digit of port number
QPRT1:	POINT	3,1(S2),13		; High order digit of port number
QLIN0:	POINT	3,2(S2),6		; Low order digit of line number
QLIN1:	POINT	3,1(S2),34		; High order digit of line number
QDEV0:	POINT	3,2(S2),34		; Low order digit of device number
QDEV1:	POINT	3,2(S2),27		; Middle digit of device number
QDEV2:	POINT	3,2(S2),20		; High order digit of device number
QUNT0:	POINT	3,3(S2),20		; Low order digit of unit number
QUNT1:	POINT	3,3(S2),13		; High order digit of unit number

QD60BF:	ASCIZ	\DN60-P00\		; Same name as used by D60SPD and
					;  D60SPL so that if they run at the
					;  same time somehow we won't die.
QLINBF:	ASCIZ	\DN60-P00L00\		; Use to ENQ/DEQ a particular station
QDEVBF:	ASCIZ	\DN60-P00L00D000U00\	; Define unique Q' entry for a
					;  particular device on a specific 2780

FEDEVS:	ASCIZ	/FE/			; Start of front end name

TOPS20 <
FEJFN:	BLOCK	1			; JFN of the front end device FEn:
LSTDTE:	BLOCK	1			; Last DTE that was selected
RCVHDR:: BLOCK	2			; Receive header
XMTHDR:: BLOCK	2			; Transmit header

KSFLG:	BLOCK	1			; 1 if KL -1 if KS

XMSG:	BLOCK	^o274/4+1		; DDCMP Q flush buffer
RETRY:	BLOCK	1			; BOOT retry counter
BTARG:	BLOCK	5			; BOOT JSYS argument block
RDSAVE:	BLOCK	1			; Save area for RD2020 arguments
RDSLEN:	BLOCK	1			;  including the length
    >;End if TOPS20

TOPS10 <
C11BLK:	BLOCK	C$SIZ			; Block for OPNFE DN60 checking
    >;End if TOPS10

HANLST:	EXP	-1			; Name of handle linked list.
STSBUF:	BLOCK	<STSMAX+3>/4		; Status buffer for port,line or device
					;  status strings (8 bit bytes).
DEFTHR:	EXP	OFLDFL			; Default number of delayed returns
					;  before offline device implied

; Termination signon data base.

SONSTR:	5,,5				; Length of table
	BLOCK	5			; Pointer to each string
					;  format: port/line,,address

SONFOB:	SONFD				; Address of file descriptor
	FB.LSN+7			; ASCII and strip line seq numbers

SONFD:	6,,0				; Max words in file name
	BLOCK	5			; Buffer for file descriptor

SONDIR:	ASCIZ	\PS:<DN60>\

PTRA:	BLOCK	2			; Pointer and count for A string
PTRB:	BLOCK	2			; Pointer and count for B string

SONBUF:	BLOCK	^d25			; Buffer to read RJE string into

 ENDLOC==.-1				; End of process local data base
	SUBTTL	Data area - literals


DVCBYT:	EXP	0,2,3,1,1		; Number of bytes in dev cmd's 0-4
	EXP	0,1,1,1,1		;	5-9
	EXP	0,0,2,1,3		;	10-14
	EXP	1,3,1,1,1		;	15-19
	EXP	1,1,1,1,1		;	20-24
	EXP	1,1,1,1,1		;	25-29
	EXP	1,1,3			;	30-32

LNCBYT:	EXP	0,3,2,1,1		; Number of bytes in line cmds 0-4
	EXP	3,3,1,1,3		;	5-9
	EXP	3,3			;	10,11

D6JVER:: EXP	%%.D60			; Cell containing version number

	XLIST				; Suppress listing of literals
	LIT
	LIST

	END
; Local Modes:
; Mode:Fundamental
; Comment Column:40
; Comment Start:;
; Word Abbrev Mode:1
; End: