Google
 

Trailing-Edge - PDP-10 Archives - BB-5255D-BM - language-sources/d60jsy.mac
There are 66 other files named d60jsy.mac in the archive. Click here to see a list.
;<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
;                    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	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,	203		; 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
	SUBTTL	Misc. definitions

	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,	^d10		; Times to check input permission req
	XP	RQTIM,	^d1		; Sleep time between input per req chk
	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. Before
;	     TOPS20 style entries can be logged, they must be first converted
;	     to CAL11. style which is done by the external routine FELOG.
;	     Under TOPS10 the CAL11. block is assumed pointer to by P3 and
;	     the C11LOG external routine is called.
;
; 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==1b1> ;; Before CAL11.
	IFIDN <$%PHSE>,<AFTER>, <%%.PHS==1b0> ;; After CAL11.
	IFE %%.PHS,<IF1,<PRINTX $FELOG called with illegal phase: "'$%PHSE'">>

	JRST	[MOVX	T4,%%.PHS	;; Load the phase value
		 TDNN	T4,DBGFLG#	;; Check for this phase being logged
		  JRST	.+1		;;  No .. continue on main line
TOPS20 <	 $CALL	FELOG##>	;; Yes .. call external log converter
TOPS10 <	 IOR	T4,P3		;; Point to the CAL11. argument block
		 $CALL	C11LOG##>	;; Call directly to logger
		 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
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,OPNDIE)	;  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

	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$RUN		; Get the input running flag
	JUMPN	S1,SINGO		;  If yes then go do some input
	$CALL	LCKLIN			; Lock the line from use (2780/3780)
	 JUMPF	 ERT (D6DOL,SINBAD)	;  Can't .. 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	@.RETF			;  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

	$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
	$LNCMD	(LC.CTR,RLSHAN)		; Clear output transparency
	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
	$LNCMD	(LC.STR,RLSHAN)		; Set transparency on/off
CND.9:	$LNCMD	(LC.DTR,RLSHAN)		; Set the data terminal ready

	PJRST	RLSHAN			; Release handle, FE and return
	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, or give non-blocking return (if bit set) when no
;	     request has been made.
;
; Parameters -
;
;	S2/	Handle list entry address

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

	$CALL	CKIABT			; Check for any outstanding input abort
	 JUMPF	@.RETF			;  Yes .. so just return with failure
	TXNN	T1,SDIPW!SDIRN		; Check for input perm. was requested
	 JRST	ERT (D6DOL)		;  No .. so say device offline

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	@.RETF			;  Can't get line status .. error
	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	@.RETF			;  Failed .. give error return
	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	@.RETF			;  Failed .. give error return
	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	APRNUM			; Is processor serial number known
	 $CALL	PRCTYP			;  No so type the processor
	SKIPE	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
	$CALL	DEQD60			;  we can release the port.
	 JUMPF	@.RETF			; Had a problem dequeueing the port
	$RETT				; Return succesfully (true)

; 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
	$CALL	DEQD60			; Release the line
	$RET
	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
;
;	APRNUM/	Contains the processor serial number
;	KSFLG/	0 if KL, non-zero if KS

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

	MOVE	S1,[SIXBIT \APRID\]	; Table in TOPS20 to check
	SYSGT				;  for the processor serial number
	MOVEM	S1,APRNUM		; Save the processor serial number
	SETZM	KSFLG			; Default to KL
	CAIL	S1,^d4096		; Test for a KS serial number
	 SETOM	KSFLG			;  Yes .. so set such an indicator
	$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
	SKIPE	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
	$CALL	M%RMEM			; Give it back to GLXLIB
	$RET				; Return, ignoring errors
	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
	SKIPN	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:	$FELOG	(BEFORE)		; Log before any action on FE device
	$CALL	PUTHDR			; Output the header to say read data
	 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
	SKIPE	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:	$FELOG	(BEFORE)		; Log before any FE I/O action
	$CALL	PUTHDR			; Output the transmit header
	 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
	SKIPE	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
	SKIPE	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
	SKIPE	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
	SKIPE	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,[[$SAVE <TF>		; Define return through release routine
		   MOVX	S1,C$SIZ	;  Get size of block
		   MOVE	S2,P3		;  Location of block
		   PJRST M%RMEM]]	;  Give memory to GLX handler; return

	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.
    > ;End if TOPS10
	SUBTTL	Data area - Locals (to this fork)

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

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

APRNUM:	BLOCK	1			; Processor serial number
KSFLG:	BLOCK	1			; 0 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

 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:;
; Auto Save Mode:2
; Word Abbrev Mode:1
; End: