Google
 

Trailing-Edge - PDP-10 Archives - bb-l014y-bm_tops20_v7_0_tsu02_1_of_2 - galsrc/d60jsy.mac
There are 66 other files named d60jsy.mac in the archive. Click here to see a list.
; [405]	7-Jun-88	LWS
;	NO-SIGNON-REQUIRED changes in edit 307 broke SIGNON-REQUIRED on the-10.
;	Change $STOP to STOPCD for TOPS-10.
; [404] 15-Feb-88	TPW	Conditionalize Edit 401.
; [403] 15-Feb-88	TPW	Remove 402 and try again with 404.
; [402] 12-Jan-88	TPW	Do them again (correctly).
; [401] 5-SEP-85	LEO	Do Copyrights.
; [400] 12-Mar-85	LWS	GCO 10159
;	Add code to check for new style CAL11. port argument and
;	lite sign bit in arg word. PD$PRT is can't hold 18 bits.
;	TOPS-10 only. Make D60JSY V5(400) since it must be used with
;	GALAXY V5.1.
; [311] 24-Mar-86	TPW	SPR 20-19734
;	Preserve line conditioning parameters when opening a node.
; [310] 18-July-85	TPW	SPR 20-19734
;	Distinquish between a SIGNON-REQUIRED and a NO SIGNON-REQUIRED
;	2780/3780 station when checking if it is ok to open a port.
; [307] 15-July-85	TPW	SPR 20-19734
;	Process another status flag in D60CND when conditioning the line
;	for signon-not-required.
; [306] 18-Oct-84	LWS	GCO 10112
;	Get rid the @.RETT, @.RETF, etc. some clever person coded.
;	Strange things happen now that .RETT and .RETF and others are
;	now in the low seg and don't use the entry vector.
; [305] 06-JUL-83	-MH-	SPR 20-19253
;	in D60OPN the packed device descriptor should be saved in S1.
;	CDRIVE will lose its port when opening a line for /NO-SIGNON.
; ******** EDITS STARTING WITH [305] ARE FOR 4.1/4.2 MAINTENANCE ********
; [304] 30-SEP-82	RLS	GCO 4.2.1514
;	in D60RLS check for communications established if attempt to complete
;	pending eof fails...if not, release the device anyway.
; [303] 29-SEP-82	RLS	GCO 4.2.1513
;	remove superfluous call to D60POL in D60DIS.
; [302] 02-SEP-82	TJW	GCO 4.2.1508
;     i	nsert a ERJMP .+1 after the SPRIW JSYS
; [301] 02-SEP-82	RLS	GCO 4.2.1507
;	load TF properly before exiting from SINCD4 on eof case.
; [300]	17-AUG-82	RLS	GCO 4.2.1492
;	in D60SIN card input handling, transfer partial buffers at eof time
;	to user area before returning a D6NBR.
; [277] 09-AUG-82	RLS	GCO 4.2.1486
;	return POLEST=0 on NBR return if some data was transferred
; [276] 18-JUN-82	RLS	GCO 4.2.1392
;	at SINREJ don't check error conditions unless request was rejected.
; [275] 24-MAY-82	RLS	GCO 4.2.1346
;	put component code setting commnand back in D60OPN.
; [274] 26-APR-82	RLS	GCO 4.2.1335
;	flush device default characteristics setting in D60OPN
; [273] 12-APR-82	RLS	GCO 4.2.1309
;	Make most errors go through EOFL.1. Make REQOUT check for output EOF
;	set and clear it if on.
; [272] 21-MAR-82	RLS	GC0 4.2.1283
;	Check H$RUN in D60EOF...fe flags might not be set yet for signon device
; [271] 16-MAR-82	RLS	GCO 4.2.1268
;	Return actual protocol version in PROTYP...check it in OPNFE.
; [270] 12-MAR-82	RLS	GCO 4.2.1266
;	clean up better on obscure exits from D60EOF.
; [267] 10-MAR-82	RLS	GCO 4.2.1262
;	remove checks for SDHWA...no longer fatal indicator.
; [266] 07-MAR-82	RLS	GCO 4.2.1250
;	Fix PROTYP to return -1 for BOOT failure and no protocol running.
; [265] 24-FEB-82	RLS
;	Make D60EOF always succeed unless its D6NBR.
; [264] 22-FEB-82	RLS
;	D60OPN to return D6NBR instead of D6DOL. Check DSR  in SONRD.
; [263] 09-FEB-82	RLS
;	change port numbers for DN22 from 10-13 to 0-3
; [262] 18-JAN-82	RLS
;	do CPUTYP as part of D60INI. Fix it too.
; [261]	14-JAN-82	RLS
;	 flush use of H$HPR,H$HLN, add timer to RD2020.
; [260] 13-JAN-82	RLS
;	remove FELOG
; [257]	22-DEC-81	RLS
;	Don't set line signature no more.
; [256] 17-DEC-81	RLS
;	Create HI.Q and LO.Q parameters to defines scheduler queue bounds
; [255] 01-DEC-81	RLS
;	Make D6.TRS and D6.TDT timeouts innocuous.
; [254] 01-DEC-81	RLS
;	Do SPRIW in D60INI to set process(fork) to be a system process.
;	Affects TOPS20 only.
; [253] 23-NOV-81	RLS
;	remove setting of silo warning level in D60CND. Its settable only
;	for diagnostic purposes now.
; [252] 19-NOV-81	RLS
;	fix read for DN60 protocol.
; [251] 05-NOV-81	RLS
;	GCO 4.2.1016	insert poll time estimates.
; [250] 15-OCT-81	RLS
;	remove all device and line enq/deq cruft. only port enq's left.
; [247] 06-OCT-81	RLS
;	Make data space for handles local to D60JSY.
; [246] 15-JUN-81	RLS
;	Add TOPS-20 version protocol to FEI%O.
; [245] 26-MAY-81	RLS
;	Make CDBUF a multiple card buffer - holds CDBFN card images.
;	Make OPNFE more persistent in finding a viable FE device.
; [244] 18-MAY-81	RLS
;	Replace  PRCTYP with CPUTYP.
; [243]	12-May-81	WEM
;	Modify CKIABT and CKOABT to return D6IAB and D6OAB error returns,
;	respectively.  These returns reflect soft aborts that should not
;	cause the line to be disabled.
; [242]	3-MAR-81	RLS
;	fix D60DIS so it can disable a line even with signon or enbale pending.
;	check SDIEC (input eof complete) in CKIABT before abort flags
; [241]	8-Nov-80	KR
;	add debugging messages for GALAXY testing.  Defines DBGSTR macro
;	to be used at an entry point which OUTSTRs the name of the entry
;	point and the result code if both 135 and DBGSWT are non-zero.
; [240]	7-Nov-80	KR
;	add crock to convert returned signon SIXBIT name to octal on exit
;	of SONFIL.  This to get around problems of first implementation of
;	prototype node names in GALAXY.
; [237]	5-Nov-80	KR
;	fix 2780/3780 console, which was broken by [235]
; [236] 3-NOV-80	RLS
;	 add silent device timeout for offline checking.
; [235] 23-OCT-80	RLS
;	remove dump output buffers command for console devices in d60sout.
;	make d60eof do it rather than real eof, d60rls will do a real eof for
;	console devices.
; [234]	29-SEP-80	RLS
;	CHANGE SONFIL TO COMPARE SIGNON CARD TO A FILE OF SIGNON STRINGS.
;	SONRD NOW CALLS SONFIL WHEN SIGNON CARD HAS BEEN READ. ALL OLD COMPARE
;	CRUFT HAS GONE AWAY. EXACT IMAGE IS NOW REQUIRED.  SONFIL RETURNS
;	SIXBIT NODE NAME IF MATCH OCCURS, WHICH IS EVENTUALLY RETURNED TO
;	GALAXY COMPONENT DOING THE D60CND. ELIMINATE H$THR.
; [233] 19-SEP-80	RLS
;	ADD OPNFE CHECK IN D60EOF SO IF FE IS DEAD , AN APPROPRIATE ERROR
;	CODE IS RETURNED.
; [232] 09-SEP-80	RLS
;	REMOVE SIGNON PROCESSING FROM D60SIN. ADD SIGNON PROCESSING TO END
;	OF D60CND. PATCH D60OPN TO REFUSE DEVICE OPENS (EXCEPT FOR SIGNON
;	DEVICE) UNTIL STATION IS SIGNED ON.
; [231] 26-AUG-80	RLS
;	FIX D60SOU SO IT WILL CHECK FOR AN OUTPUT EOF IN PROGRESS IF
;	THE SOUT FAILS.  THIS CONDITION ARISES WHEN USER DOESN'T COMPLETE
;	A D60EOF FUNCTION(WITH TRUE RETURN).
; [230] 26-AUG-80	RLS
;	D60OPN - CHANGE TO RELEASE ANY DEVICE ALREADY OPEN, THEN DO
;	THE OPEN.
; [227] 22-AUG-80	RLS
;	FIX SO D6DOL MSG RETURNED ONLY WHEN SDSUS(HASP) OR SDOFL(2780/3780)
;	SET. SOME SPECIAL CHECKING FOR CONSOL DEV IN D60SIN,D60SOU ERROR
;	PROCESSING FLUSHED. MAKE CKIABT,CKOAABT RETURN LINE FLAGS(SDLFG)
;	IN T2. CHANGE USE OF ALLOCATED AC VAR(ARGO) IN D60SOU TO P4.
;	SIGNON PROCESSING IN D60SIN CHANGED(SONRD CALL - NO POSTMORTEM).
;	USE H$SPN IN D60SIN,SONRD TIL SIGNON DONE.
; [226] 18-AUG-80	RLS
;	ADD TOPS10 CONDITIONALS TO SIGNON FILE NAME CONSTRUCTION.
; [225] 13-AUG-80	RLS
;	FIX SONFIL TO RETURN D6SON ERROR CODE(INSTEAD OF 0)
; [224] 11-AUG-80	RLS
;	D60OPN - FIX SO CARRIAGE CONTROL SET ONLY FOR LPT DEVICE.
;	TOPS10/FEI%O - FIX CALCULATION OF 1ST BYTE POSITION TO DIVIDE
;	BY BP.SIZ INSTEAD OF BYTES PER WORD.
; [223] 5-AUG-80	RLS
;	MODIFY D60SIN TO READ CARDS IN UNIT RECORDS. HANDLE LIST ENTRY FOR
;	CARD INPUT DEVICES(CDR FOR TERMINATION,CDP FOR EMULATION) GETS A CARD
;	IMAGE BUFFER ATTACHED TO BUFFER INPUT FROM FE.	D60SIN RETURNS A D6NBR
;	TIL A WHOLE CARD IS BUFFERED, THEN IT XFERS THE IMAGE. THUS CARDS ARE
;	XFERRED CORRECTLY AS LONG AS USER ASKS FOR BYTES COUNTS IN MULTIPLES OF
;	82 BYTES. ANYTHING ELSE WORKS BUT WILL NOT BE IN SYNCH WITH CARD.
;	ALCHAN,RLSHAN MODIFIED TO DEAL WITH CARD IMAGE BUFFERS.
; [222] 30-JUL-80	RLS
;	MAKE TOPS10 FEI%O DO TRANSFERS IN UNITS OF H$BPM(RECORD SIZE) AND
;	DO AS MUCH AS POSSIBLE BEFORE RETURNING...SIMILAR TO TOPS20 CRUFT.
; [221] 22-JUL-80	RLS
;	ADD SYSERR FUNCTIONS
; [220] 16-JUL-80	RLS
;	MAJOR SURGERY ON TOPS20 FEI%O FCNS TO ELIMNATE SOME GARBAGE AND
;	MAKE INTERFACE MORE NEARLY IDENTICALLY TO TOPS10 CRUFT.
; [217] 17-JUN-80	RLS
;	MAKE D60STS RETURN FULL LINE FLAGS IN S1,COMPOSITE LINE FLAGS AND
;	LINE INFO FLAGS IN S2(AS BEFORE)
;	MAKE STSBUF GLOBAL SO D60JSY USERS CAN LOOK AT FULL STATUS RETURNED.
; [216] 16-JUN-80	RLS
;	CONVERT TOPS20 FEI%O ROUTINES TO NON-BLOCKING MODE.
;	FIX LINSTS SO IT RETURNS "ZERO" STATUS WHEN LINE NOT ENABLED.
; [215] 27-MAY-80	RLS
;	CONVERT D60JSY TO ALL NON-BLOCKING FORM. INCREMENT TO MAJOR VERSION: 4.
; [214] 20-MAY-80	RLS
;	MAKE D60CND,D60DIS,LINCMD,DEVCMD NON-BLOCKING
;	REQIN,CKIABT,CKOABT TOO
; [213] 20-MAY-80	RLS
;	FIX D60OPN (OPNOV2) TO SET BYTES-PER-MSG TO 132 FOR LPT
;	COSMETIC MODS TO REQIN
; [212] 12-MAY-80	RLS
;	FIX REQOUT USE NON-BLOCKING RETURN.  D60SIN,D60SOU CHANGED
;	TO PERFORM EFFECTIVE ADDRESS CALCULATION ON STRING ARGS AT ENTRY.
; [211] 5-MAY-80	RLS
;	FIX USERS OF FEI%O FOR NEW ERROR FORMAT. MAKE DEVSTS,LINSTS
;	PRTSTS COMMON CODE
; [210] 1-MAY-80	RLS
;	UPGRADE TOPS10 FEI%O
;	 UPDATE BYTE PTR AND COUNT AFTER IO,
;	 INTERPRET CAL11 UUO ERRORS INTO D60 ERRORS.
;<DN65-DEVELOPMENT>D60JSY.MAC.59, 28-Jan-80 11:07:32, Edit by JENNESS
; [207] Remove superfluous LC.CTR command in D60CND
;<DN65-DEVELOPMENT>, 26-Jan-80 11:53:06, Edit by JENNESS
; [206] Fix bug in D60STS line status routine that didn't return
;	D6LGA error (just returned error code 3: reject).
;<DN65-DEVELOPMENT>D60JSY.MAC.55, 17-Dec-79 13:17:20, Edit by JENNESS
; [205] Change to a better 2020 test routine than checking serial number.
;<DN65-DEVELOPMENT>D60JSY.MAC.6,  4-Dec-79 13:35:42, Edit by JENNESS
; [204] Fix up code to do proper termination signon validation
;<DN65-DEVELOPMENT>D60JSY.MAC.3, 18-Oct-79 15:19:52, Edit by JENNESS
; [203] Decouple D60UNV from D60JSY because of QSRMAC deadly embrace.
;<DN65-DEVELOPMENT>D60JSY.MAC.2,  9-Oct-79 14:26:28, Edit by JENNESS
; [202] Add code in D60CND to support transparent transmission enabling
;	for HASP lines.
;<DN65-DEVELOPMENT>D60JSY.MAC.256,  7-Sep-79 10:19:19, Edit by JENNESS
; [201] Remove edit 175 .. the BOOT JSYS has been fixed.
;<DN65-DEVELOPMENT>D60JSY.MAC.252,  4-Sep-79 15:29:44, Edit by JENNESS
; [200] Remove CONLY conditionals, remove QSRMAC symbol conflicts.
;<DN65-DEVELOPMENT>D60JSY.MAC.250,  4-Sep-79 13:50:44, Edit by JENNESS
; [177] Change arg block to condition call again .. make it QUASAR setup block.
;<DN65-DEVELOPMENT>D60JSY.MAC.249, 15-Aug-79 09:43:42, Edit by JENNESS
; [176] Change D6DNU error so that IBMSPL can turn it off in NBIO.
;<DN65-DEVELOPMENT>D60JSY.MAC.248, 14-Aug-79 09:17:23, Edit by JENNESS
; [175] Change 2020 read routine to do it's own byte pointer updating,
;	the BOOT JSYS doesn't do it.
;<DN65-DEVELOPMENT>D60JSY.MAC.247, 16-Jul-79 14:11:56, Edit by JENNESS
; [174] Add external HOOKing code, gives access to guts of this package.
;<DN65-DEVELOPMENT>D60JSY.MAC.246, 11-Jul-79 16:17:53, Edit by JENNESS
; [173] Give D6DNU (DSR not up) on D60OPN call at appropriate times.
;<DN65-DEVELOPMENT>D60JSY.MAC.244,  5-Jul-79 15:28:28, Edit by JENNESS
; [172] Give reject error code when DN6x gives no bytes read with success code.
;<DN65-DEVELOPMENT>D60JSY.MAC.240,  2-Jul-79 16:25:45, Edit by JENNESS
; [171] Fix another dumb bug in FEI%O for TOPS10.
;<DN65-DEVELOPMENT>D60JSY.MAC.238, 29-Jun-79 13:58:07, Edit by JENNESS
; [170] Another fix for 2780/3780 input/output deadlock race on input EOF.
;<DN65-DEVELOPMENT>D60JSY.MAC.237, 29-Jun-79 13:22:48, Edit by JENNESS
; [167] Typo fix in FEI%O for TOPS10.
;<DN65-DEVELOPMENT>D60JSY.MAC.235, 29-Jun-79 09:04:39, Edit by JENNESS
; [166] Change the ERRS macro to give DDT type out of the error values.
;<DN65-DEVELOPMENT>D60JSY.MAC.235, 29-Jun-79 09:00:27, Edit by JENNESS
; [165] Fix REQOUT to relieve the lost output grant.
;<DN65-DEVELOPMENT>D60JSY.MAC.233, 28-Jun-79 17:59:05, Edit by JENNESS
; [164] Fix to stop deadlock interaction between console and LPT under 3780.
;<DN65-DEVELOPMENT>D60JSY.MAC.231, 26-Jun-79 09:00:59, Edit by JENNESS
; [163] Swap the line signature and line driver type in line status, makes it
;	easier for front end to clear an old LCB.
;<DN65-DEVELOPMENT>D60JSY.MAC.230, 25-Jun-79 16:24:37, Edit by JENNESS
; [162] Change last D6DOL in REQOUT to a D6CGO .. fixes console deadly embrace.
;<DN65-DEVELOPMENT>D60JSY.MAC.229, 25-Jun-79 09:33:46, Edit by JENNESS
; [161] Another fix in edit 153 when DTE is already selected.
;<DN65-DEVELOPMENT>D60JSY.MAC.225, 21-Jun-79 10:41:06, Edit by JENNESS
; [160] Fix the horrible mess made when releasing devices on disabled lines.
;<DN65-DEVELOPMENT>D60JSY.MAC.224, 21-Jun-79 08:53:45, Edit by JENNESS
; [157] Fix REQOUT to check for line gone away in DSRLP.
;<DN65-DEVELOPMENT>D60JSY.MAC.225, 19-Jun-79 09:43:59, Edit by JENNESS
; [156] Fix a problem in OPNFE caused by edit 153 when FEJFN already open.
;<DN65-DEVELOPMENT>D60JSY.MAC.223, 18-Jun-79 13:11:44, Edit by JENNESS
; [155] Change FEI%O for TOPS10 to use reentrant type C11BLKs.
;<DN65-DEVELOPMENT>D60JSY.MAC.222, 15-Jun-79 16:44:48, Edit by JENNESS
; [154] Fix a glaring error in SRCPDD that has been there forever.
;<DN65-DEVELOPMENT>D60JSY.MAC.221, 14-Jun-79 16:54:35, Edit by JENNESS
; [153] Change a little in OPNFE to jump to SELDTE if JFN already assigned.
;<DN65-DEVELOPMENT>D60JSY.MAC.220, 14-Jun-79 15:22:36, Edit by JENNESS
; [152] Add code to release all devices opened on a D60CND line disable.
;<DN65-DEVELOPMENT>D60JSY.MAC.211, 12-Jun-79 13:54:04, Edit by JENNESS
; [151] Add printx to output name, version and other sundries during assembly.
;<DN65-DEVELOPMENT>D60JSY.MAC.209, 12-Jun-79 11:37:27, Edit by JENNESS
; [150] Append line and device command strings to FEI%O arg block. Get rid of
;	the ALC1WD and RLS1WD routines.
;<DN65-DEVELOPMENT>D60JSY.MAC.209, 12-Jun-79 11:36:40, Edit by JENNESS
; [147] Change the status string symbols so SWAPB and SWAP32 aren't needed.
;<DN65-DEVELOPMENT>D60JSY.MAC.208, 12-Jun-79 09:45:35, Edit by JENNESS
; [146] Move some more symbols into the D60JSY.UNV universal file.
;<DN65-DEVELOPMENT>D60JSY.MAC.206, 11-Jun-79 11:19:10, Edit by JENNESS
; [145] Fix a bug in D60SOUT (bad load) and add IOWAIT to SNOOZE in REQOUT.
;<DN65-DEVELOPMENT>D60JSY.MAC.204,  8-Jun-79 09:40:54, Edit by JENNESS
; [144] Add return immediate code in FEI%O to stop blocking on console read.
;<DN65-DEVELOPMENT>D60JSY.MAC.203,  7-Jun-79 17:20:51, Edit by JENNESS
; [143] Change in REQIN to reduce the possibility of a race.
;<DN65-DEVELOPMENT>D60JSY.MAC.202,  7-Jun-79 15:33:57, Edit by JENNESS
; [142] Change status formats to reflect more frontend bullet proofing.
;<DN65-DEVELOPMENT>D60JSY.MAC.199,  7-Jun-79 10:55:08, Edit by JENNESS
; [141] Fix D60SOUT for errors that are appropriate the running flag is cleared
;<DN65-DEVELOPMENT>D60JSY.MAC.197,  7-Jun-79 10:36:37, Edit by JENNESS
; [140] Some fixes for line status failure and a D60RLS on dead lines.
;<DN65-DEVELOPMENT>D60JSY.MAC.196,  7-Jun-79 09:37:23, Edit by JENNESS
; [137] Fix a problem in REQIN that failed it input was already running.
;<DN65-DEVELOPMENT>D60JSY.MAC.194,  6-Jun-79 16:42:57, Edit by JENNESS
; [136] Fix a bug in the DSR wait loop in REQOUT.
;<DN65-DEVELOPMENT>D60JSY.MAC.193,  6-Jun-79 09:32:56, Edit by JENNESS
; [135] Add IOWAIT argument to the SNOOZE macro for task descheduling.
;<DN65-DEVELOPMENT>D60JSY.MAC.191,  4-Jun-79 09:21:51, Edit by JENNESS
; [134] Dump output buffers (in 11) if outputing to a console device.
;<DN65-DEVELOPMENT>D60JSY.MAC.187,  1-Jun-79 10:58:38, Edit by JENNESS
; [133] Add code to handle new line hardware abort checking.
;<DN65-DEVELOPMENT>D60JSY.MAC.184, 30-May-79 16:18:50, Edit by JENNESS
; [132] Don't clear aborts in REQIN/REQOUT, now only set for valid reasons.
;<DN65-DEVELOPMENT>D60JSY.MAC.183, 30-May-79 13:32:02, Edit by JENNESS
; [131] More fixes for device error handling and input/output deadlock.
;<DN65-DEVELOPMENT>D60JSY.MAC.176, 25-May-79 16:23:21, Edit by JENNESS
; [130] Handle aborts caused by line disconnection.
;<DN65-DEVELOPMENT>D60JSY.MAC.175, 24-May-79 15:14:16, Edit by JENNESS
; [127] Fix D60EOF and the line releasing code for 2780/3780.
;<DN65-DEVELOPMENT>D60JSY.MAC.172, 23-May-79 15:21:46, Edit by JENNESS
; [126] Fix D60OPN to properly handle errors on the device commands.
;<DN65-DEVELOPMENT>D60JSY.MAC.172, 23-May-79 15:21:22, Edit by JENNESS
; [125] Have found some more holes in the FE releasing.
;<DN65-DEVELOPMENT>D60JSY.MAC.168, 21-May-79 11:41:31, Edit by JENNESS
; [124] More fixes for properly releasing FE devices.
;<DN65-DEVELOPMENT>D60JSY.MAC.167, 21-May-79 09:38:50, Edit by JENNESS
; [123] Add structure block sizes in universal file.
;<DN65-DEVELOPMENT>D60JSY.MAC.165, 21-May-79 09:36:35, Edit by JENNESS
; [122] Another fix in REQOUT to release the line when input is coming.
;<DN65-DEVELOPMENT>D60JSY.MAC.161, 17-May-79 18:11:01, Edit by JENNESS
; [121] Fix so FE is properly released if DTE select fails.
;<DN65-DEVELOPMENT>D60JSY.MAC.160, 16-May-79 11:21:33, Edit by JENNESS
; [120] Fix write routine to release FE for a second after lot of data output.
;<DN65-DEVELOPMENT>D60JSY.MAC.159, 16-May-79 11:11:28, Edit by JENNESS
; [117] Change ENQD60 to block until lock is gained. Gives higher lock hits.
;<DN65-DEVELOPMENT>D60JSY.MAC.157, 16-May-79 09:22:10, Edit by JENNESS
; [116] Remove copy code for 8 bit DDCMP buffer, now can handle real byte ptrs.
;<DN65-DEVELOPMENT>D60JSY.MAC.152, 14-May-79 14:51:26, Edit by JENNESS
; [115] Add line signature code.
;<DN65-DEVELOPMENT>D60JSY.MAC.146, 10-May-79 12:42:28, Edit by JENNESS
; [114] Fix so delays from the FE on line commands resend command correctly.
;<DN65-DEVELOPMENT>D60JSY.MAC.145, 10-May-79 11:17:39, Edit by JENNESS
; [113] Change location of FELOG logging calls in FEI%O.
;<DN65-DEVELOPMENT>D60JSY.MAC.144, 10-May-79 10:20:00, Edit by JENNESS
; [112] Add require for FELOG when FTDEBUG switch is turned on.
;<DN65-DEVELOPMENT>D60JSY.MAC.143,  3-May-79 09:57:26, Edit by JENNESS
; [111] And yet another fix for the deadlock problem, release if REQOUT fails.
;<DN65-DEVELOPMENT>D60JSY.MAC.141,  2-May-79 14:29:16, Edit by JENNESS
; [110] Another fix to stop input/output deadlocks on 2780/3780.
;<DN65-DEVELOPMENT>D60JSY.MAC.140,  1-May-79 16:48:50, Edit by JENNESS
; [107] Increase retry counter for BOOT JSYS retry on input.
;<DN65-DEVELOPMENT>D60JSY.MAC.139,  1-May-79 16:33:52, Edit by JENNESS
; [106] Some code clean up, more on the abort problem, and really use D60CGO.
;<DN65-DEVELOPMENT>D60JSY.MAC.137, 30-Apr-79 12:57:04, Edit by JENNESS
; [105] Fix input request code to block less and add better errors to D60CND.
;<DN65-DEVELOPMENT>D60JSY.MAC.133, 25-Apr-79 16:18:22, Edit by JENNESS
; [104] Put in error checks after device and line status calls.
;<DN65-DEVELOPMENT>D60JSY.MAC.129, 25-Apr-79 13:47:32, Edit by JENNESS
; [103] Fix so that the line isn't released if the device goes off line.
;<DN65-DEVELOPMENT>D60JSY.MAC.127, 25-Apr-79 08:25:46, Edit by JENNESS
; [102] Add device command in D60OPN to do space compression.
;<DN65-DEVELOPMENT>D60JSY.MAC.124, 24-Apr-79 14:39:33, Edit by JENNESS
; [101] Add code to ENQ/DEQ line for 2780/3780 so only 1 device can be active
;	at a time.
;   D60JSY - Interface package for DN62/DN65 Galaxy IBM spooling system

;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979,1980,1981,1982,1983,1984,1985,1986.
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED 
;AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND
;WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE
;SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
;OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND 
;OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
;NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
;EQUIPMENT CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY 
;OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;

;	TITLE	D60JSY	DN62/DN65 interface to GALAXY spooling components.

	SALL				; Make nice clean listings

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

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

TOPS10<					;[404]Conditionalize this macro
.BCOPY
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979,1986. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
.ECOPY
>;end TOPS10				;[404]End conditional.

; Version

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

; Conditional assembly flags.

	ND	FTDBST, 0		; If on generate DBGSTR macro
	ND	JP%SYS,0		; release 5 symbol

; 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 <FTDBST>,<PRINTX Entry/exit tracing enabled.>
    >	;END IF1

IF2,<Printx Pass 2.>

;Define debugging string macros

Define DBGSTR (TXT) <>

IFN <FTDBST>,<

Define DBGSTR (TXT) <
	PUSH	P,[[ASCIZ |'TXT'-|]]
	PUSH	P,[EXP DBGRSL]
>;end Define DBGSTR

>;end IFN <FTDBST>
	SUBTTL	Misc. definitions


	XP	OFLDFL, ^d10		; Default number of delay to offline
	XP	RQREP,	^d12		; Times to check input permission req
	XP	DTEOFF, 10		; Offset from port number to DTE number
TOPS20 <XP	MAXDTE, 13>		; Maximum DTE number
TOPS10 <XP	MAXDTE, 153>		; Maximum DTE number
					; New CAL11. <DTE-based><CPU#><DTE#>
	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
	XP	LO.Q,2			; low priority scheduler queue to run in
	xp	HI.Q,1			; high priority scheduler queue to run in

					; SYSERR definitions
	XP	SEC%D6, 233		; Line status event code
	XP	SEC%DE, 234		; Enable/disable event code
	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	SYSERR entry format

Comment &

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

			TOPS20 VERSION

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



			TOPS10 VERSION

    +===================================================+
    !			.DMERR				!
    +---------------------------------------------------+
    !			code				!
    +===================================================+

NOTE:	DAEMON call in TOPS10 supplies rest of header info


    &

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

	.SYDAT==4			; Offset to data portion of entry
	>

TOPS10< DEFSTR	(SYFCN,0,35,36) 	; DAEMON function code
	DEFSTR	(SYCOD,1,35,36) 	; Event code
	.SYDAT==2			; Offset to data portion of entry
	>
	SUBTTL	Data format for SYSERR code 233

Comment &

    +===================================================+
    !	   Port number	    !	    Line number 	!
    +---------------------------------------------------+
    !			Status string			!
    /							/
    /							/
    +===================================================+

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


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

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

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

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

    &
	SUBTTL Format for SYSERR code 234

Comment &

Node enable/disable

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

	Where

	 Enable/disable code is:

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

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

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

	 Flags are:

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

	 Station type is:

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

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

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

	 Records per message is a 16 bit value in records.

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

    &

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

	NED.SZ==^d9			; Size of entry w/o header
	NED.SH==^d3			; Short entry for disable
	SUBTTL	Macros -- ERT

; 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>	;; [306]  else give a default of false return
	]
   > ;End of ERT definition
	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	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 -	S1/SYSERR enable/disable arg: 0 => disable,enable otherwise

	ENTRY	D60INI

D60INI:	DBGSTR	<D60INI>
	$SAVE	<S2>			; Save registers

TOPS20<	MOVEI	S1,LOCALS		; make data local to forks into
					; copy-on-write
	LSH	S1,-^D9			; make page number
	HRLI	S1,.FHSLF		; process handle
	MOVX	S2,PA%RD+PA%WT+PA%EX+PA%CPY
	SPACS				; do it
	ERJMP	@.RETF
	MOVEI	S1,ENDLOC		; get the end of said area
	LSH	S1,-^D9			; make page number
	HRLI	S1,.FHSLF		; process handle
	MOVX	S2,PA%RD+PA%WT+PA%EX+PA%CPY
	SPACS				; do it
	ERJMP	@.RETF
	SETZM	FEJFN			; no jfn for this fork yet
	SETZM	LSTDTE			; no dte assignment

	MOVX	S1,.FHSLF		; set ourselves to be a system process
	MOVX	S2,<<HI.Q>B29+<LO.Q+1>+JP%SYS>; JP%SYS only works for release 5+
	SPRIW				; do it
	ERJMP .+1			; not a problem if we can't

	$CALL	CPUTYP			; determine processor type
       >

	SETZM	LPAGE			; disable  SYSERR logging
	SKIPE	S1			; check for SYSERR logging state
	$CALL	LOGENB			; enable logging

	$CALL	HNDINI			; init handle space

	MOVEI	S1,.POMIN		; init polester
	MOVEM	S1,POLEST

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::DBGSTR	<D60OPN>
	$SAVE	<S2,T1,T2>		; Save registers
	JUMPG	S1,OPN.1		; If open block type parameters
	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
	$CALL	FNDPDD			; check if  it already exists
	JUMPF	OPN.1B			; If not, continue
	PUSH	P,S1			; Save the PDD
	MOVE	S1,S2			; Get the current core block
	$CALL	D60RLS			; yes - release it
	JUMPT	OPN.1C			; completed?
	CAIE	S1,D6NBR		; No, see why
	CAIN	S1,D6DOL
	JRST	[POP	P,(P)		; Fix stack
		 $RET]			; Come back later
OPN.1C:	POP	P,S1			; Restore the PDD
OPN.1B:	$CALL	ALCHAN			; create new entry
	JUMPF	.POPJ			; [306] can't
OPN.1A: MOVE	S1,HNDSTS		;[311]Retrieve conditioning parameters
	STORE	S1,(S2),H$STS		;[311]Restore to handle list entry
	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 #
TOPS20<	SKIPL	PTYPE>			; DN22 is 0-7
	CAILE	S1,MAXDTE		; Check to see if the DTE # is ok
	JRST	ERT (D6NSP,OPNDIE)	;  No .. it's too large
TOPS20<	JRST	PRTOK>			; This port is valid.

OPNDL:					; On -10's DL10's are valid
TOPS20<	SKIPGE	PTYPE			; check for DN22
	JRST	PRTOK
	MOVX	S1,D6NSP		; No such port (no DL10 on -20)
	JRST	OPNDIE> 		;  and go release the list entry

PRTOK:	LOAD	S1,(S2),H$PDD		; Get the packed device descriptor
	$CALL	OPNFE			; Go open a FE (-10 check for 11 up)
	JUMPF	.POPJ			; [306]  Can't open a front end
	$CALL	PRTSTS			; Get the port status
	JUMPF	.POPJ			; [306]  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)		;  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)		;  No ... this port is useless

	$CALL	LINSTS			; Get the line status
	JUMPF	.POPJ			; [306]  Someone died .. go release device

	LOAD	S1,,SLTYP		; Get the remote station type
	STORE	S1,(S2),H$STY		; Save the station type in list entry

	LOAD	T1,,SLINF		; get line info
	TXNN	T1,SLLEN		; make sure line is still up
	JRST	ERT(D6LGA)		; should not have called open unless it was
	LOAD	T1,,SLFLG		; Get line status flags
	TXNE	T1,SLETF
	JRST	OPNDF1			; OK TO OPEN DEVICES IN EMULATION MODE
;At PRTOK +22
	TXNN	T1,SLSON		;[310] is node signed on
	JRST	PRTNSO			;[310] no, then it's not openable yet
	LOAD	T2,(S2),H$STS	 	;[310] get line parameters 
	TXNE	T2,H$NSR		;[310] check if signon is not required
	JRST	OPNDF1			;[310] proceed if not
	LOAD	T2,(S2),H$DEV		;[310] if so check the device type
	CAIE	T2,.OPLPT		;[310] if it's a printer
	CAIN	T2,.OPCOU		;[310] or console out device
	JRST	OPNDF1			;[310] don't expect communication yet
	TXNE	T1,SLCME		;[310] cdr device should be talking
	JRST	OPNDF1			;ok to contiue
PRTNSO:	LOAD	T2,(S2),H$DEV		;[310] only signon device can be opened
	CAIE	T2,.OPSGN		; note: sonrd opens .OPSGN for all station types
	JRST	RETNBR			; no - device is "offline" til it's online

OPNDF1: LOAD	T1,T1,SLETF		; Get termination/emulation flag
	STORE	T1,(S2),H$TEM		; Save it in the handle list entry

OPNDF2:	LOAD	S1,(S2),H$STY		; now do some dev specific cruft
	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)		;  Can't give a unit number on non-HASP
	LOAD	S1,(S2),H$DEV		; Get the device code
	CAIN	S1,.OPSGN		; map SIGNON device to CDR
	MOVEI	S1,SDCDR		; SONRD opens .OPSGN for all stations
	CAIN	S1,.OPCOU		; map console out to lpt dev
	MOVEI	S1,SDLPT
	CAILE	S1,MXNHSP		; Check for max device on non-HASP
	JRST	ERT (D6UND)		;  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)		;   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
		    SDSGN]-1(S1)	;  or a sigon device
	CAIN	T1,SDSGN		; check for input signon device
	JRST	[LOAD	S1,(S2),H$TEM
		 SKIPN	S1		; skip if emulation mode
		 MOVEI	T1,SDCR1	; yes - map to cdr
		 JRST	.+1]
	LOAD	S1,(S2),H$UNT		; Get unit of device-type to select
	CAILE	S1,MXUHSP		; Check against maximum number of units
	JRST	ERT (D6UND)		;  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:	$CALL	SETIOM			; Set the input/output mode of device
	JUMPF	OPNDIE

	LOAD	S1,(S2),H$STY		; CHECK FOR HASP
	CAIE	S1,SLHSP
	JRST	OPNOV1
	LOAD	T1,(S2),H$HDV		; yes - must set component code
	$DVCMD	(DC.SCC)
	JUMPE	OPNDIE

OPNOV1:	LOAD	T1,(S2),H$DEV		; check device type
	CAIE	T1,.OPCOU		; console out
	CAIN	T1,SDLPT		; or lpt
	SKIPA	T1,[^D134]		; use 132 columns + crlf
	MOVX	T1,^D82 		; otherwise use 80 columns + crlf
 	STORE	T1,(S2),H$BPM		; Save as the bytes per message

	LOAD	S1,(S2),H$IOM		; check for input card device
	JUMPE	S1,OPNOV4		; not an input device
	LOAD	S1,(S2),H$DEV		; input dev...check for card dev
	CAIN	S1,.OPSGN
	JRST	OPNSG1			; SIGNON DEVICE
	CAIE	S1,SDCDR		; CDR
	CAIN	S1,SDCDP		; CDP
	CAIA
	JRST	OPNOV4			; neither
OPNSG1:	LOAD	S1,(S2),H$BPM		; get record size
	IMULI	S1,CDBFN		; buffer this may records
	MOVEM	S1,CDBSZ(S2)		; preserve this total byte count
	PUSH	P,S2			; save handle ptr
	IDIVI	S1,5			; calc. no. words
	SKIPE	S2
	AOS	S1
	$CALL	M%GMEM			; get card buffer
	EXCH	S2,(P)			; get handle ptr back
	POP	P,CDBUF(S2)		; drop the buffer ptr in handle entry

OPNOV4:	SETZM	IOTIM(S2)		; init offline timer for device
	LOAD	T1,(S2),H$DEV		; set up offline timer limit
	LOAD	S1,(S2),H$STY		; check for 2780/3780 console
	CAIN	S1,SLHSP		; Test to see if it is a HASP station
	JRST	OPNO4A			; yes - use device code
	CAIN	T1,.OPCOU		; map console out to lpt dev
	MOVEI	T1,SDLPT

OPNO4A:	LOAD	S1,(S2),H$TEM		; differentiate between emu/ter
	SKIPE	S1
	SKIPA	S1,EOLTB-1(T1)		; emulation device
	MOVE	S1,TOLTB-1(T1)		; termination device
	MOVEM	S1,OFLTIM(S2)		; crammit

	MOVE	S1,S2			; Get the handle to pass back
	$RETT				; Return saying success


; 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:	$CALL	RLSHAN			; release the handle
	$RETF				;  and give the false return

EOLTB:	.EOLPT				; lpt
	.EOCDP				; cdp
	.EOCDR				; cdr
	0				; console input
	0				; console output
	0				; signon device

TOLTB:	.TOLPT				; lpt
	.TOCDP				; cdp
	.TOCDR				; cdr
	0				; console input
	0				; console output
	0				; signon device
	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:	DBGSTR	<D60SIN>
	JUMPGE	T1,ERT (D6CNN)		; Test for illegal byte count

	$SAVE	<T2,P1,P2,P3,P4>

	TLC	S2,-1			; check for generic ascii ptr
	TLCN	S2,-1			; skip if specific
	HRLI	S2,(POINT 7)		; map it
TOPS10< HRRI	S2,@S2			; perform effective adr calculation
	TLZ	S2,77>			; 'cause cal11. uuo can't handle it
TOPS10< TLNN	S2,770000		; check for position = 0
	ADD	S2,[440000,,1]> 	; cause it can't handle this either

	DMOVE	P2,S2			; save the user parameters
	HRRZS	S1			; Clear the flags in left half
	$CALL	SRCHAN			; Look for handle on handle entry list
	 JUMPF	ERT (D6NSH)		;  Illegal handle
	MOVE	P1,S2			; Save the handle temporarily
	$CALL	ALCARG			; Allocate an FEI%O arg block
	MOVE	P4,S1			; keep arg block ptr safe

	MOVX	T1,FC.RD		; Function to read from device
	STORE	T1,(P4),ARG$FC		; Put into I/O argument block
	LOAD	S1,(P1),H$IOM		; Get the input/output mode
	JUMPE	S1,ERT (D6DCI,SINX1)	;  Device can't do input

SIN.SN: LOAD	S1,(P1),H$RUN		; Get the input running flag
	JUMPN	S1,SINGO		;  If yes then go do some input
SIN.LK: $CALL	REQIN			; Go check on input request
	 JUMPF	SINX1			;  If input grant failed .. return
	$CALL	CRAMT			; init time we did input
	MOVEM	S1,POTIM(P1)		; init last time polled
	MOVEI	S1,.POTM0		; init poll time estimate
	MOVEM	S1,IOPOL(P1)		; start fast
	SETZM	IOAMT(P1)		; init current amt xfer'd
	SETZM	CDERM(P1)		; init last FEI%O error seen

SINGO:	MOVE	S1,IOAMT(P1)		; save  previous amt xfer'd
	MOVEM	S1,IOPRV(P1)
	SETZM	IOAMT(P1)		; init current amt xfer'd

	SKIPE	CDBUF(P1)		; check for input card dev
	JRST	SINCD			; yes - only these will have a card buf
					; else - do input direct
	STORE	P2,(P4),ARG$PT		; Save the byte pointer to input area
	STORE	P3,(P4),ARG$BC		; Save the byte count
	$CALL	SINDO			; get the cruft
	DMOVE	P2,S2			; update the user parameters

SINX:	$CALL	ESTPOL			; generate poll estimate

SINX1:	DMOVE	S2,P2			; return updated user parameters
	EXCH	S1,P4			; Exchange return code(handle) and ptr
	$CALL	RLSARG			; Release the argument block
	MOVE	S1,P4			; Get the return code(handle) back
	JUMPT	.POPJ			; [306] true...return immediately


SINFAI: CAIE	S1,D6NBR		; check for non-fatal errs
	CAIN	S1,D6DOL
	$RET				; non-fatal
	ZERO	((P1),H$RUN)		; Clear the I/O running bit
	$RET


SINCD:	DMOVE	S2,CDPTR(P1)		; get current buf parameters
	JUMPL	T1,SINCD1		; still trying to complete a buffer
	JUMPG	T1,SINCD2		; some buffer left - user may be out of synch
	SKIPE	S1,CDERM(P1)		; check for leftover eof
	CAXN	S1,D6NBR		; anything other than nbr is terminal
	CAIA
	JRST	SINCD4			; yep

	MOVE	S2,CDBUF(P1)		; empty buffer - init pars
	HRLI	S2,(POINT 7)
	MOVN	T1,CDBSZ(P1)		; get  the record size
	DMOVEM	S2,CDPTR(P1)		; save current state of cdbuf pars
SINCD1: STORE	S2,(P4),ARG$PT		; Save the byte pointer to input area
	STORE	T1,(P4),ARG$BC		; Save the byte count
	$CALL	SINDO			; try to read a card
	SKIPF				; save error code
	SETZ	S1,
	MOVEM	S1,CDERM(P1)
	JUMPL	T1,SINCD4		; did buffer fill ?
	MOVE	S2,CDBUF(P1)		; yes - dump it to loser
	HRLI	S2,(POINT 7)
	MOVE	T1,CDBSZ(P1)		; S2,T1 set to xfer card image

SINCD2:	$CALL	SINXFR			; transfer the card buffer to caller's

SINCD4: DMOVEM	S2,CDPTR(P1)		; xfer done - save current cdbuf pars
					; the following code accounts for all
					; manner of evil conditions
	SKIPG	T1			; if buffer not empty, then user satisfied
	SKIPN	S1,CDERM(P1)		; check for error last time out
	JRST	[JUMPL	P3,SINCD	; true ret+user space left means continue
		 MOVX	TF,TRUE		; ELSE WE HAVE SUC'D!
		 JRST	SINX]
	MOVX	TF,FALSE		; yes - set false return and check state
					; error return - eof of particular interest
	JUMPE	T1,SINCD6		; card boundary means return whatever
	CAIE	S1,D6EOF		; check evilness
	JRST	SINCD6			; goodness prevails
	JUMPG	T1,SINCD5		; we are already xferring a partial card
	MOVE	S2,CDBSZ(P1)		; EOF means no more input and we have
					; a partial card. set up so user can
					; retrieve last piece before seeing EOF
	ADD	T1,S2			; calc number bytes in CDBUF
	JUMPE	T1,SINCD6		; empty card after all
	MOVE	S2,CDBUF(P1)		; set buf pars to indicate partial card
	HRLI	S2,(POINT 7)
	$CALL	SINXFR			; transfer what there is
	DMOVEM	S2,CDPTR(P1)		; keep track of what is left
	SKIPGE	P3			; if caller's request is satisfied

SINCD5: SKIPA	S1,[D6NBR]		; return delay error
	MOVX	TF,TRUE			; return success

SINCD6: JRST	SINX


SINDO:	MOVE	S1,P4			; Point to the argblk for FE I/O
	MOVE	S2,P1			; get the handle list entry ptr
	$CALL	FEI%O			; Do the input
	JUMPF	SINREJ			;  If failed .. check for EOF
	$CALL	CRAMT			; stuff new iotim
	MOVE	S1,P1			; Get the handle back on success
	JRST	SINSUC			; Set the true flag and return

SINREJ: 				; either D6NBR or D6REJ
					; have to check cases either way
	LOAD	S1,(P4),ARG$RC		; get the FEI%O error back
	CAIE	S1,D6REJ		; if reject, may be eof or input abort
	JRST	SINRJ1
	$CALL	CKIABT			; Check for input abort
	JUMPF	SINRET			;  Yes .. go release and clean up
	TXNE	T1,SDIEC		; Did an EOF occur?
	JRST	[$DVCMD (DC.CIE)	;  Yes .. clear EOF complete flag
		 JUMPF SINRET		;  if fails, return error code
		 MOVX	S1,D6EOF	;  Set EOF code
		 JRST	SINBAD] 	;  Close off line and shutdown device
	TXNN	T1,SDIRN		; input still running ?
	JRST	[$CALL	RNLOST		; this is not so pretty good
		 JRST	SINRET]

SINRJ1:	$CALL	CHKOFL			; check offline timer
	SKIPF				; true if offline
	SKIPA	S1,[D6DOL]		; device is arbitrarily delacred offline
					;  when it doesn't speak for a while.
	LOAD	S1,(P4),ARG$RC		; get the FEI%O error back
	JRST	SINBAD

SINNBR: MOVX	S1,D6NBR		; return non-blocking msg
SINBAD: MOVX	TF,FALSE		; get false flag
	CAIA
SINSUC: MOVX	TF,TRUE 		; get truth(and justice)
SINRET:	LOAD	T1,(P4),ARG$XF		; get amt xfer'd
	ADDM	T1,IOAMT(P1)		; update the current amt
	LOAD	T1,(P4),ARG$BC		; Get the count of bytes not transfered
	LOAD	S2,(P4),ARG$PT		; Get pointer where string left off
	$RET

SINXFR: ILDB	S1,S2			; card xfer loop - come here when T1
					; is positive
	IDPB	S1,P2			; crammit
	AOJL	P3,SINXF1		; count the byte into user area
	SOJA	T1,SINXFX		; user stuffed - count the byte out of
					; card buffer
SINXF1: SOJG	T1,SINXFR		; count the byte out of card buffer

SINXFX:	$RET

GNOW:	PUSH	P,S2			; protect device handle list entry
	$CALL	I%NOW			; get the time
	POP	P,S2
	$RET

CRAMT:	$CALL	GNOW			; set a new io time for device
	MOVEM	S1,IOTIM(S2)		; time device last did io
	$RET

CHKOFL:	SKIPE	IOTIM(S2)		; check if device offline(silent too long)
	SKIPN	OFLTIM(S2)
	$RETF				; IOTIM not set up or no OFLTIM
					; parameter implies not offline
	$CALL	GNOW			; device is subject to offline timing
	SUB	S1,IOTIM(S2)		; get time since last successful io
	CAMLE	S1,OFLTIM(S2)		; check threshold
	$RETT				; yes, it is true that device is offline
	$RETF				; no, it is false that device is offline

; IOPRV/previous amount xfer'd
; IOAMT/current amt xfer'd
; POTIM/time of last nonzero data xfer poll

ESTPOL:	$SAVE	<S1,S2>
	LOAD	S2,(P1),H$DEV		; check device
	CAILE	S2,.OPCDR
	JRST	ESTP3			; only data xfer devices get this service

	CAXN	S1,D6NBR		; D6NBR return is special
	SKIPN	IOAMT(P1)		; check if data transferred
	SKIPA	S1,[.POMIN]
	SETZ	S1,			; try again immed
	JRST	ESTP1A			; performance demands this


	MOVE	S1,IOPRV(P1)		; get previous amt
	MOVE	S2,IOAMT(P1)		; get current amt xfer'd
	LSH	S1,-7			; RESOLUTION MORE THAN CARD,LESS THAN LINE
	LSH	S2,-7
	JUMPE	S2,ESTP0		; if no io this time, wait longer
	CAMN	S1,S2			; have done io then and now
	SOSA	S1,IOPOL(P1)		; if static amt - back off
ESTP0:	AOS	S1,IOPOL(P1)		; if changing - increase time

ESTP1:	SKIPG	S1			; S1/new poll time - apply limits
	MOVEI	S1,.POMIN
	CAILE	S1,.POLMX
	MOVEI	S1,.POLMX

ESTP1A:	MOVEM	S1,IOPOL(P1)		; set new poll time estimate
	MOVEM	S1,POLEST		; set in global variable
	$RET

ESTP3:	CAIE	S2,.OPSGN		; non-data devices
	SKIPA	S1,[.POCON]		; console devices
	MOVEI	S1,.POSGN		; signon device
	JRST	ESTP1A
	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:	DBGSTR	<D60SOU>
	$SAVE	<T2,P1,P4> 		; save a couple

SOU.0:	TLC	S2,-1			; check for generic ascii ptr
	TLCN	S2,-1			; skip if specific
	HRLI	S2,(POINT 7)		; map it
TOPS10< HRRI	S2,@S2			; perform effective adr calculation
	TLZ	S2,77			; 'cause cal11. uuo can't handle it
	TLNN	S2,770000		; check for position = 0
	ADD	S2,[440000,,1]> 	; cause it can't handle this either

	MOVE	P4,S1			; Save the handle temporarily
	$CALL	ALCARG			; Allocate an FEI%O arg block
	EXCH	P4,S1			; Swap them back

	STORE	S2,(P4),ARG$PT		; Save the byte pointer to input area
	STORE	T1,(P4),ARG$BC		; Save the byte count
	JUMPGE	T1,ERT (D6CNN,SOTRT1)	; Test for illegal byte count
	MOVX	T1,FC.WD		; Function to write data to device
	STORE	T1,(P4),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,SOTRT1)	;  Illegal handle
	MOVE	P1,S2			; Save the handle temporarily
	LOAD	S1,(S2),H$IOM		; Get the input/output mode
	JUMPN	S1,ERT (D6DCO,SOTRT1)	;  Device can't do output
	LOAD	S1,(S2),H$RUN		; Check to see if the output already
	JUMPN	S1,SOTGO		;  running

	$CALL	REQOUT			; Request output permission
	 JUMPF	SOTRT1			;  Didn't get it ... release line

	$CALL	CRAMT			; init offline timer
	MOVEM	S1,POTIM(P1)		; init last time polled
	MOVEI	S1,.POTM0		; init poll time estimate
	MOVEM	S1,IOPOL(P1)		; start fast
	SETZM	IOAMT(P1)		; init current amt xfer'd

SOTGO:	MOVE	S1,IOAMT(P1)		; save  previous amt xfer'd
	MOVEM	S1,IOPRV(P1)
	SETZM	IOAMT(P1)		; init current amt xfer'd

	MOVE	S1,P4			; Point arg blk for FE I/O
	$CALL	FEI%O			; Do the output
	 JUMPF	SOTTST			; Go check why the output failed
	$CALL	CRAMT			; update offline timer
	MOVE	S1,S2			; Get the handle back on success
	MOVX	TF,TRUE 		; Set success code
	JRST	SOTRET			; Go release the arg block and return

SOTTST: 				; error is either D6NBR or D6REJ
					; either way we have to check some cases
	$CALL	CKOABT			; Check for output aborts
	 JUMPF	SOTF.1			; Yes .. go release and clean up
	TXNE	T1,SDEOS!SDEOC		; is there there and unrequitted eof ?
	JRST	[$CALL	EOFLOP		; yes - try to consumate it
		 JUMPF	SOTF.1		; if can't, return eof's error
		 MOVE	S1,S2		; get the handle back
		 $CALL	SOTRET		; eof satisfied, try the sout again
		 JRST	SOU.0]		; without passing go
	TXNN	T1,SDORN!SDOPG		; output still running
	JRST	[$CALL	RNLOST		; definitely not good
		 JRST	SOTRET]
	$CALL	CHKOFL			; check if device is offline
	SKIPF
	SKIPA	S1,[D6DOL]		; yes - return offline msg
	MOVX	S1,D6NBR		; No .. so device is merely delayed

SOTF.1: CAIE	S1,D6NBR		; check non-fatal causes
	CAIN	S1,D6DOL
	JRST	SOTF.2			; non-fatal
	ZERO	((S2),H$RUN)		; Clear the running flag

SOTF.2: MOVX	TF,FALSE		; Set failure flag
					; Release arg block and return

SOTRET:	LOAD	T1,(P4),ARG$XF		; get amt xfer'd
	ADDM	T1,IOAMT(P1)		; update the current amt
	$CALL	ESTPOL			; generate poll estimate

SOTRT1:	LOAD	T1,(P4),ARG$BC		; Get the count of bytes not done
	LOAD	S2,(P4),ARG$PT		; Get pointer where string left off
	EXCH	S1,P4			; Swap error code(handle) and ptr
	$CALL	RLSARG			; Release the argument block
	MOVE	S1,P4			; Get the error code(handle) back
	$RET

RNLOST:	ZERO	((S2),H$RUN)		; lost io run status - this most likely
					; to occur when there are two independent
					; users of the same line...one disables
					; and reenables the line while the other
					; is not looking or due to a race at eof
					; in 2780/3780.
	$CALL	DEVREJ			; analyze as device reject
	$RET
	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:	DBGSTR	<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
RETFNI: MOVX	S1,D6FNI		;  No .. no other function implemented
	$RETF


DOPRQI: LOAD	S1,(S2),H$IOM		; Get the input/output mode of device
	JUMPN	S1,REQIN		; Check to see if input .. go grant
	JRST	REQOUT			;  otherwise get output permission

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
DOPAB0:	$CALL	CKOABT			; see if output abort in progress
	JUMPT	DOPAB1			; no - set it
	CAIE	S1,D6OAB		; yes - skip if complete
	$RET				; no - return(D6NBR
	$RETT				; output abort completed and ccleared

DOPAB1:	$DVCMD	(DC.SOA)		; Signal output abort on device
	JRST	DOPAB0

DOPIAB:	$CALL	CKIABT			; check if input abort in progress
	JUMPT	DOPIA1			; no - set it
	CAIE	S1,D6IAB		; yes - check if complete
	$RET				; no - return(D6NBR)
	$RETT				; yes - input abort completed and cleared
DOPIA1:	$DVCMD	(DC.SIA)		; Signal input abort on device
	JRST	DOPIAB
	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:	DBGSTR	<D60EOF>
	$SAVE	<S2,T1,T2>		; 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
	LOAD	S1,(S2),H$PDD		; get the packed port descriptor
	$CALL	OPNFE			; find out if fe is alive
	JUMPF	.POPJ			; no - don't bother with more
	LOAD	S1,(S2),H$STY		; Get terminal (station) type [237]
	CAIE	S1,SLHSP		; Check for a HASP station [237]
	JRST	INTEOF			; no, do normal EOF processing for console [237]
	LOAD	S1,(S2),H$DEV		; Get device type number
	CAIE	S1,.OPCIN		; Check for console input
	CAIN	S1,.OPCOU		;  or console output device
	JRST	CONEOF			; don't send eof's to console dev

INTEOF:
INTEO1:	LOAD	S1,(S2),H$IOM		; Get the input/output mode
	JUMPN	S1,EOFL.2		;  Input device .. can't output EOF
	$CALL	CKOABT			; Check for an output abort
	JUMPF	EOFL.1			;  Yes .. go clean up and return
	LOAD	S1,(S2),H$RUN		;  check if we think io is running
	JUMPN	S1,EOFSND		;  yes - so do the eof
	TXNN	T1,SDORN!SDOPG!SDEOS!SDEOC ; Test for output running
	JRST	EOFL.2			;  No .. so just give successful return

EOFSND: TXNE	T1,SDEOS!SDEOC		; don't bother if eof already done
	JRST	EOFLP1
	$DVCMD	DC.SOE			; Signal EOF on device
	JUMPF	EOFL.1			; just go away if err'd

EOFLOP:	$CALL	CKOABT			; Check for an output abort
	JUMPF	EOFL.1			;  Yes .. give error and failure return

EOFLP1: TXNN	T1,SDEOC		; Test for output EOF complete
	JRST	RETNBR			;  No .. so wait until it is.
	$DVCMD	DC.COE			; Yes .. so clear the EOF complete flg
	JUMPT	EOFL.2			; Give successful return

EOFL.1: CAIN	S1,D6NBR		; errs...check non-fatal
	$RET				; non-fatal...come back later

EOFL.2:	ZERO	((S2),H$RUN)		; Clear the run flag in handle entry
	$RETT				; Successful return

CONEOF:	LOAD	S1,(S2),H$IOM		; Get the input/output mode
	 JUMPN	S1,.RETT		; [306]  Input device .. can't output EOF
	LOAD	S1,(S2),H$RUN		; Check to see if I/O is running
	JUMPE	S1,.RETT		; [306] no need
	$DVCMD (DC.DOB)			; dump output buffers
	JUMPF	EOFL.1
	$RETT
	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:	DBGSTR	<D60RLS>
	$SAVE	<S2,T1,T2>
	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
	LOAD	S1,(S2),H$RUN		; check if it is running
	JUMPE	S1,RLS.1		; no - not much to do
	LOAD	S1,(S2),H$IOM		; check  io mode of device
	JUMPN	S1,RLS.1		; if input, no need to do eof
	$CALL	INTEOF			; Make sure that the I/O is closed off
	 JUMPT	RLS.1			; If no problems releasing .. continue
	CAIE	S1,D6NBR		; errs...check non-fatal
	JRST	RLS.1			; if fatal - ignore the error
					; Note: D6DOL is essentially fatal here
					;	since we are trying to get unstuck.
	$CALL	CKOABT			; check special case for signon device
	JUMPF	RLS.1			; makes no difference now
					; T1/SDFLG, T2/SDLFG from device status
	TXNE	T2,SDCME		; if communications established...
	JRST	RETNBR			; then wait
					; otherwise, the eof will never complete

RLS.1:	ZERO	((S2),H$RUN)		; make sure this device is not running
	$CALL	RLSHAN			; Release the handle entry and possibly
	$RETT				;  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 -
;
;	Line status in s1,composite upper line status,line info in s2
;	Device status in S2
;	Multiple device activity status - in block pointed to by S2

	ENTRY	D60STS

D60STS:	DBGSTR	<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	RETFNI			;  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	.POPJ			; [306]  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
	HRLZ	S2,S1			; make a PDD
	SETZ	S1,
	$CALL	PCKPDD
	$CALL	INIDMY			; Start up a dummy list entry
	JUMPF	.POPJ			; [306]  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
	JRST	RLSHAN			; Return while releasing dummy handle

STSLIN: MOVE	T1,S2			; Move line number to a safe place
	HRL	S2,S1			; make a PDD
	SETZ	S1,
	$CALL	PCKPDD
	$CALL	INIDMY			; Start up a dummy list entry
	JUMPF	.POPJ			; [306]  Failed to start a front end
	STORE	T1,(S2),H$LIN		; Store lower 9 bits as line number
	$CALL	LINSTS			; Get status of line
	$CALL	RLSHAN			; Release the dummy handle
	JUMPF	.POPJ			; [306]  If line status failed .. bad return
	LOAD	T1,,SLFLG		; Get flags
	MOVE	S1,T1			; return full line flags in s1
	ANDI	T1,177400		; Get only significant part
	LOAD	S2,,SLINF		; Get line info
	IOR	S2,T1			; Put them all together
	$RETT				; Return successfully


INIDMY:					; S1/PDD
	$CALL	ALCHAN			; Make up a dummy handle entry
	$CALL	OPNFE			; Open the front end
	 JUMPF	RLSHAN			;  Can't open front end, rls dummy
	$RETT				; Front end opened just fine
	SUBTTL	GLobal routine -- D60CND

; Routine - D60CND
;
; 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
;
; Returns	S1/sixbit node name if TRUE signon match(if required)


	ENTRY	D60CND

D60CND:	DBGSTR	<D60CND>
	$SAVE	<S2,T1,T2,P1,P2,P3>	; Save some registers
	MOVE	P3,S1			; set up QUASAR msg ptr as a global parameter
	MOVEI	P2,SUP.CN(P3)		; Get address of conditioning block

	MOVE	S2,(P2)			; get S1/port,,line
	SETZ	S1,			; [405][307]
	$CALL	PCKPDD			; check if this port-line is alive
	$CALL	FNDPDD
	JUMPF	CND.0			; no - but kill it for good measure
	LOAD	S1,(S2),H$SPN		; yes - check for signon pending
	JUMPN	S1,CND.10		; yes - skip all the other cruft
	LOAD	S1,(S2),H$ENB		; check ENABLE in progress
	JUMPN	S1,CND.7		; continue ENABLE processing
					; previously incarnated - blow it away
CND.0:	MOVE	S1,(P2)			; get S1/port,,line
	MOVE	S2,SUP.NO(P3)		; and S2/node name
	$CALL	DISABL			; make sure line was disabled
	JUMPF	.POPJ			; [306] exit if failed
					; success - S2/handle list entry to use

CND.6:	$CALL	PRTSTS			; Get status of front end
	 JUMPF	RLSHAN			;  Can't get port status .. so die
	LOAD	T1,(P2),CN$TYP		; Get desired translation type
	MOVE	T1,[EXP TR$X78,TR$X78,TR$HSP]-1(T1)
	LOAD	S1,,S6TRN		; Get translations avaiable in FE
	TDNN	S1,T1			; Check wanted against available
	 JRST	ERT (D6PIU,RLSHAN)	;  Nope .. port is useless
	SETZ	T1,			; build enable argument blocks
	LOAD	S1,(P2),CN$TYP		; Get the station type (terminal type)
	STORE	S1,T1,EN$TYP		; stuff in its place
	LOAD	S1,(P2),CN$MAP		; Get the emulation/termination flag
					;  and primary/secondary flag
	STORE	S1,T1,EN$MAP		; Put into second byte and
	MOVE	S1,SUP.ST(P3)		; get signon requirements
	TXNN	S1,NETSGN		; skip if signon is required
	TXO	T1,EN$SON		; not required - so claim it already is

	LOAD	S1,(P2),CN$TYP		; set transparency flag
	CAIN	S1,SLHSP		; only relevant to hasp
	TXZA	T1,EN$SON		; HASP always requires signon in the protocol
	TDZA	S1,S1			; 2780/3780 - clear it
	LOAD	S1,(P2),CN$TRA		; HASP - get the argument
	STORE	S1,T1,EN$TRA		; and finally set the flag

	$LNCMD	(LC.EL,RLSHAN)		;  start the line up again (enable)
	SETO	S1,			; set ENABLE in progress flag
	STORE	S1,(S2),H$ENB

CND.7:	LOAD	T1,(P2),CN$CTS		; Get the clear to send delay
	$CALL	SWAPB			;  swap the bytes in 16 bit word
	$LNCMD	(LC.CSD,CNDERX) 		;  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,CNDERX) 		;  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,CNDERX) 		;  and set it

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

	SETZ	S1,
	STORE	S1,(S2),H$ENB		; clear the enable in progress

CND.10: MOVE	S1,SUP.ST(P3)		;[307] check on signon required
	TXNE	S1,NETSGN		;[405] skip if it is not required
	TDZA	S1,S1			;[405]
	SETO	S1,			;[307] if not, flag that fact
	STORE	S1,(S2),H$NSR		;[307] and update handle list entry
	STORE	S1,(S2),H$SON		;[307]  with the station's signon info

	$CALL	SONRD			; and do the signon processing
	JUMPF	.POPJ			; [306] no success exit till signed on
					; S1/sixbit node name

CND.11:	$CALL	LOGUP			; log line going up
;At CND.11 +1
	LOAD	T1,(S2),H$STS		;[311]Retrieve conditioning status word
	MOVEM	T1,HNDSTS		;[311]And stash it
	$CALL	RLSHAN			; Release handle, FE and return
	$RETT

CNDERX:	CAIN	S1,D6NBR		; analize errors during enable processing
	$RET
	CAIN	S1,D6REJ		; io rejected means line went down
	MOVEI	S1,D6LGA
	JRST	RLSHAN			; anything else is fatal alsoRU
	SUBTTL	GLobal routine -- D60DIS

; Routine -	D60DIS
;
; Function -	To disable a specific line
;
; Parameters -
;
;	S1/port,,line
;	S2/node name - for logging

	ENTRY	D60DIS

D60DIS:	DBGSTR	<D60DIS>
	$CALL	DISABL			; disable the line
	$CALL	RLSHAN			; flush the handle
	$RET

DISABL:	$SAVE	<T1,T2,P1,P2>		; make sure line is disabled
					; S1/port,,line
					; S2/node name
	DMOVE	P1,S1			; save the args
	HLRZ	T1,P1			; get T1/port
	HRRZ	T2,P1			; get T2/line

CND.X:	$CALL	LFIRST			; 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.1B			;  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.1B			;  No .. continue until last entry
					; clear line enable special modes
	SETZ	S1,
	STORE	S1,(S2),H$SPN		; no signon pending
	STORE	S1,(S2),H$ENB		; no enable pending

	PUSH	P,S2			; save this handle
	$CALL	LNEXT			; look up next one
	EXCH	S2,(P)			; recover current one and save next
	MOVE	S1,S2			; Get handle of current entry
	$CALL	D60RLS			; Release the device
	POP	P,S2			; recover next handle(current one is gonso)
	JUMPF	.POPJ			; [306] 
	JUMPN	S2,CND.1		; check for next handle
	JRST	CND.2			; no - can proceed now

CND.1B:	$CALL	LNEXT			; Find next handle list entry
	 JUMPT	CND.1			;  Another one .. check releasability


CND.2:	SETZ	S1,			; make a PDD
	MOVE	S2,P1
	$CALL	PCKPDD
	$CALL	ALCHAN			; Make up a dummy handle entry

	LOAD	S1,(S2),H$PDD		; Get the packed device descriptor
	$CALL	OPNFE			; Open up the front end for setup
	 JUMPF	RLSHAN			;  Couldn't open a front end
	$CALL	LINSTS			; check if line up now
	JUMPF	RLSHAN
	LOAD	S1,,SLFLG
	LOAD	T1,,SLINF		; get line status
	TXNN	S1,SLDIP!SLLDC		; check disable in progress or complete
	TXNN	T1,SLLEN		; check line enabled
	$RETT				; no - nothing further to do
	MOVE	S1,P2			; yes - log this shutdown
	$CALL	LOGDWN

CND.3:	$LNCMD	(LC.DIS,RLSHAN) 	; Shut down the line (disable)

	$RET
	SUBTTL	SONRD - signon processing

; Routine - SONRD
;
; Function - To read the signon string from the RJE card-reader and match
;	it against the string read from the .SON file.
;
; Parameters -
;
;	S2/	Handle list entry address for port,,line
;	P2/	ptr to conditioning block
;	P3/	ptr to QUASAR setup msg
;
; Returns	- 	S1/sixbit node name if signon is TRUE

SONRD:	LOAD	S1,(P2),CN$ETF		; Get emulation/termination flag
	JUMPN	S1,SONRTA		; If emulation .. ignore signon

	$SAVE	<S2,T4,P1,P2,P3>
					; register use:
					; P1/handle list entry for port,,line
					; P2/handle list entry for signon device
					; P3/ptr  to QUASAR setup msg

	MOVE	T4,P2			; save conditioning block for open
	MOVE	P1,S2			; Make copy of handle entry address
	SETO	S1,
	STORE	S1,(P1),H$SPN		; Set signon pending flag
	SETZ	P2,			; no signon device yet
	LOAD	S1,(P1),H$HSN		; get the signon device handle
	JUMPN	S1,SONRD1		; it's already there!
	MOVE	S1,SUP.NO(P3)		; make node name = arg til known different
	STORE	S1,(P1),H$NOD
	$CALL	LINSTS			; check if already signed on
	JUMPF	SONRDF
	LOAD	S1,,SLINF		; check some basics 1st
	TXNN	S1,SLLEN		; line still up?
	JRST	SONLGA
	TXNN	S1,SLDSR		; has anyone called?
	JRST	SONNBR			; no need to get excited yet
	LOAD	S1,,SLFLG		; get the line flags
	TXNE	S1,SLSON
	JRST	SONSUC			; already signed on

	MOVEI	S2,SONOPB		; ptr to inhouse open block for signon dev
	LOAD	S1,(P1),H$PRT		; have to open it
	STORE	S1,(S2),OP$PRT		; stuff in open block
	LOAD	S1,(P1),H$LIN
	STORE	S1,(S2),OP$LIN		; stuff it too
	MOVNI	S1,3			; length of open block
	$CALL	D60OPN			; open the signon device
	JUMPF	SONRDF			; hopefully just delayed

	STORE	S1,(P1),H$HSN		; SAVE THE SIGNON DEVICE HANDLE IN
					; port/line handle entry
SONRD1:	$CALL	SRCHAN			; get the handle list entry
	JUMPF	SONDIE			; amazing!
	MOVE	P2,S2			; save the signon device list entry

	LOAD	S1,(P2),H$SON		; did we make partial progress earlier?
	JUMPN	S1,SONRD0		; yes - just need to clean up
	MOVE	S1,P2			; Get device handle
	HRROI	S2,SONBUF		; Point to input string buffer
	MOVX	T1,-^d82		; Length of string to read
	$CALL	D60SIN			; Read the signon string
	SKIPE	T1			; ignore error if card was read
	JUMPF	SONRDF			; go analyze error
	MOVE	S1,SUP.ST(P3)		; check for signon required
	TXNN	S1,NETSGN
	JRST	[MOVE	S1,SUP.NO(P3)	; get the node name arg
		 TLNN	S1,-1		; make sure it is sixbit
		 $CALL	SMAP6
		 JRST	SONRDS]		; claim everything is hunkydory
	DMOVE	S2,[POINT 7,SONBUF	; really need to validate the signon string
		    ^d82]		; "A" string descriptor
	$CALL	SONFIL			; try to match signon string
	JUMPF	SONRDF			; mismatch

SONRDS:	STORE	S1,(P1),H$NOD		; save the node name til finally done
	SETO	S1,
	STORE	S1,(P2),H$SON		; [405][307]

SONRD0: MOVE	S2,P2			; Restore handle list entry address
	$DVCMD	(DC.CIE)		; Clear input EOF complete
	JUMPF	.POPJ			; [306] 
	$LNCMD	(LC.SON)		; set station signed on flag
	JUMPF	.POPJ			; [306] slowness

SONSUC:	SKIPE	S2,P2			; release the signon device and line
	$CALL	RLS.1			; release the signon device
	SETZ	S1,			; clean up the port,,line data base
	STORE	S1,(P1),H$SPN		; signon no longer pending
	STORE	S1,(P1),H$HSN		; no longer have a signon device handle
	LOAD	S1,(P1),H$NOD		; get the node name
	$WTOJ	<^N/S1/ signed on>,,<SUP.TY(P3)>

	$RETT				; and return

SONLGA:	SKIPA	S1,[D6LGA]		; line went away while we were waiting
SONNBR:	MOVX	S1,D6NBR		; no phone connection yet
	MOVX	TF,FALSE

SONRDF: CAIE	S1,D6NBR		; analyze failure exit
	CAIN	S1,D6DOL
	JRST	.POPJ			; [306] innocuous
					; fatal
	PUSH	P,S1			; save the error code
	SKIPE	S2,P2			; release the signon device and line
	$CALL	RLS.1			; release the signon device
	SETZ	S1,			; clean up the port,,line data base
	STORE	S1,(P1),H$SPN		; signon no longer pending
	STORE	S1,(P1),H$HSN		; no longer have a signon device handle
	STORE	S1,(P1),H$SON		; and definitely not signed on
	POP	P,S1			; retrieve the error
	$RETF				;  and return the error

SONRTA:	MOVE	S1,SUP.NO(P3)		; return arg as node name
	$RETT

SONDIE:
TOPS20 <$STOP	(NSH,<Can't find signon device handle after creating it!>)> ;[405]
TOPS10 <STOPCD	(NSH,HALT,,<Can't find signon device handle after creating it!>)> ;[405]
	SUBTTL	SONFIL - read signon file for node

; Routine - SONFIL
;
; Function - Read and store a signon file for a particular node.
;
; Parameters -
;	S2/ptr to signon string
;	T1/- no. bytes in signon string
;	P3/Address of setup message from QUASAR
;
; Returns -	False if failed to read signon file ($WTOJ sent)
;		TRUE - 	S1/sixbit node name of station signed on
;
; NOTE:	signon file format:
;	line pairs - line a: signon string to match against signon record
;		     line b: node name (1-6 alphanumeric characters)
;
;	signon string has floating fields of nonblank characters, trailing
;	blanks not required.

SONFIL: $SAVE	<S2,T1,T2,T3,T4,P1,P2,P3,P4>

TOPS10<	PUSH	P,[SIXCVT]>		;convert SIXBIT to number on exit
					; register use:
					; S1/no. bytes left in current IBUF
					; S2/ptr into current IBUF
					; T1/current char in signon file(IBUF)
					; T2/current char in signon string
					; T3/current signon string ptr
					; T4/ no. bytes currently left in signon string
					; P1/ptr to signon string
					; P2/no. byres in signon string
					; P3/ptr to QUASAR setup msg
					; P4/ifn for signon file


	MOVE	P1,S2			; save the signon parameters
	MOVM	P2,T1			; use positive count to be consistent
					; with f%ibuf values(avoids confusing me)
	DMOVE	T3,P1			; find last significant character in
					; signon record
	MOVE	S1,P2			; init char cnt
SONF00:	$CALL	SIGNB			; find next non-blank character
	JUMPF	SONF01			; done
	MOVE	S1,T4			; save char count of last nb char
	JRST	SONF00			; T4/characters remaining in signon record

SONF01:	SUB	P2,S1			; adjust P2 to number of significant characters
	JUMPE	P2,SONFL3		; blank signon record not allowed

; Open the signon file

	SETZ	P4,			; Clear IFN of file (so far)
TOPS20< $TEXT <-1,,SONFD+1>,<^T/SONDIR/^N/SUP.NO(P3)/.SON^0>>
TOPS10< MOVE	S1,SUP.NO(P3)		; get the station name
	TLNN	S1,-1			; check for binary node number
	$CALL	SMAP6			; map it to sixbit
	MOVEM	S1,SGNNAM >		; stuff it in fd
	MOVX	S1,FOB.MZ		; Get size of FOB
	MOVEI	S2,SONFOB		; Signon file FOB
	$CALL	F%IOPN			; Open file for input
	 JUMPF	SNF.F			;  Signon file failure
	MOVE	P4,S1			; Save IFN of file

SONF0:	SETZ	S1,			; no chars in buffer initially

SONF1:	DMOVE	T3,P1			; start new string compare
	JRST	SONF5			; start on 1st nonblank

SONF2:	$CALL	SIGCH			; get a signon string character
	JUMPF	SONN1			; end of signon string
					; T2/current signon string character

SONF3:	$CALL	FILCH			; get next file line character
	JUMPF	SONN3			; this is a mismatch
					; T1/current signon file character

SONF4:	CAME	T1,T2			; compare current characters of strings
	JRST	SONN2			; fundamental mismatch
	CAIE	T1,40			; check for blanks
	JRST	SONF2			; continue scan

SONF5:	$CALL	SIGNB			; get next non blank signon string ch
	JUMPF	SONN1			; end of signon string
					; more significant signon string
	$CALL	FILNB			; get next non blank file ch
	JUMPT	SONF4			; more significant file string, continue scan
	JRST	SONN3			; mismatch

SONN1:	$CALL	FILNB			; end of signon string
					; must be end of file line to match
	JUMPT	SONN2			; more file left - mismatch
	JUMPE	T1,SONWN0		; check for file done

SONWIN:					; match - get node name
	$CALL	GETNOD			; get the node name

SONWN0:	PUSH	P,TF			; save the truthity
	EXCH	S1,P4
	$CALL	F%REL			; close the signon file
	MOVE	S1,P4			; get the node name back
	POP	P,TF			;learn the truth again
	JUMPF	SONRTA			; just return arg if none
	$RETT

SONN2:	$CALL	SCNLIN			; mismatch - find next signon file string
	JUMPF	SONFDN			; no more - loses

SONN3:	JUMPE	T1,SONFDN		; check for file done
	$CALL	SCNLIN			; drop node name line
	JUMPF	SONFDN			; end of valid stations
	JRST	SONF1			; ready for another try


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

SNF.F:	$WTOJ <^N/SUP.NO(P3)/ Signon failure>,<Signon file ^F/SONFD/, error: ^E/S1/>,<SUP.TY(P3)>
	SKIPE	S1,P4			; Check for IFN already assigned
	$CALL	F%REL			; Release the file
RETSON: MOVX	S1,D6SON
	$RETF				; then give a failure return


SONFDN:	CAIE	S1,EREOF$		; check input error
	JRST	SNF.F			; io error

SONFL2:	MOVE	S1,P4			; ran out of file - this is a mismatch
	$CALL	F%REL			; close the file

SONFL3:					; here for blank signon record

	$WTOJ	<^N/SUP.NO(P3)/ SIGNON failure>,<signon record:^M^J^T/(P1)/... did not match signon file.>,<SUP.TY(P3)>
	JRST	RETSON

SIGCH:	SOJL	T4,SIGCHF		; precount char
	ILDB	T2,T3			; get a signon string character
	CAIN	T2,11			; map tabs
	MOVEI	T2,40
	CAIE	T2,15			; check end of card image
	CAIN	T2,12
SIGCHF:	$RETF				; yes - just fail
	$RETT				; no - suc

FILCH:	SOJGE	S1,FILCH0		; precount char
	MOVE	S1,P4			; read some more
	$CALL	F%IBUF
	SETZ	T1,			; error exit flag
	JUMPT	FILCH			; continue
	$RET				; just die - T1/0

FILCH0:	ILDB	T1,S2			; get next file line character
	CAIN	T1,11			; map tabs
	MOVEI	T1,40
	CAIN	T1,15			; check for end
	JRST	FILCH			; end - don't stop on cr
	CAIN	T1,12
	$RETF				; fail - T1/line feed
	$RETT				; still in the running

SIGNB:	$CALL	SIGCH			; scan signon string for non blank
	JUMPF	.POPJ			; [306] just return if end of string
	CAIN	T2,40			; is this a space
	JRST	SIGNB			; yes - continue scanning
	$RETT				; T2/good character to compare

FILNB:	$CALL	FILCH			; scan file line for non blank
	JUMPF	.POPJ			; [306] we are done one way or another
	CAIN	T1,40			; SPACE ?
	JRST	FILNB			; yes - continue scanning
	$RETT				; T1/good char to compare

SCNLIN:					; scan off a line in signon file
	$CALL	FILCH			; get next character on line
	JUMPT	SCNLIN			; if there is one, continue scanning
	JUMPE	T1,.POPJ		; [306] if file error, this fails
	$RETT				; otherwise it suc's

GETNOD:	MOVE	T3,[POINT 6,T2]		; get node name from signon file
	MOVEI	T4,6			; S2/ptr to beg of node name line
	SETZ	T2,
GETND1:	$CALL	FILCH			; get a char
	JUMPF	GETNDX			; end of line/file - check for name
	CAIL	T1,"A"			; check valid node name characters
	CAILE	T1,"Z"
	JRST	GETND3			; not a letter

GETND2:	SUBI	T1,40			; make sixbit
	IDPB	T1,T3			; crammit
	SOJG	T4,GETND1

GETNDX:	JUMPE	T2,.RETF		; [306] not a valid node name
	MOVE	S1,T2			; return node name
	$RETT

GETND3:	CAIL	T1,"0"			; check numeric
	CAILE	T1,"9"
	JRST	GETNDX			; terminate node name on 1st non-alphanumeric
	JRST	GETND2			; numeric - keep going

SMAP6:	$SAVE	<S2,T1,T2>		; S1/binary number to convert to sixbit
	MOVE	S2,[POINT 6,S1]		; a sixbit ptr
	MOVE	T1,S1
	SETZ	S1,			; build sixbit in S1
SMAP61:	IDIVI	T1,^D8			; the usual algorithm
	PUSH	P,T2			; node numbers are octal
	SKIPE	T1
	PUSHJ	P,SMAP61
	POP	P,T2
	ADDI	T2,'0'
	IDPB	T2,S2
	POPJ	P,

TOPS10<

SIXCVT:					;convert S1 from SIXBIT to octal
	$SAVE	<TF,S2>
	TDNE	S1,[EXP 505050505050]
	$RET
	SETZ	TF,
	MOVEI	S2,6
SIXLP:	LSH	S1,3
	LSHC	TF,3
	JUMPE	S1,SIXLPE
	SOJG	S2,SIXLP
SIXLPE:	MOVE	S1,TF
	$RET
	>
	SUBTTL	Grant input permission


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

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

REQSPN: $CALL	CKIABT			; Check for any outstanding input abort
	JUMPF	.POPJ			; [306]  Yes .. so just return with failure
	TXNN	T1,SDIPR!SDIPG!SDIPW!SDIEC!SDIRN ; Check for input perm. was requested
	JRST	NOACTI			; no active or recent request

REQRTY: TXNE	T1,SDIRN!SDIEC		; Check for input already running
	JRST	REQINS			;  Yes

REQGRT:	TXNE	T1,SDIPG		; check for input permission already granted
	JRST	REQGLP
	$DVCMD	DC.GIP			; Do a device input permission grant
	JUMPF	.POPJ			; [306] 

REQGLP:	$CALL	CKIABT			; Check for input aborts
	JUMPF	.POPJ			; [306]  Failure do to abort on device

	TXNN	T1,SDIEC!SDIRN		; Check for EOF or running
	JRST	RETNBR			; not yet

REQINS: SETO	T1,			;  Yes .. so turn on
	STORE	T1,(S2),H$RUN		;   the I/O running flag
	$RETT				; Give a successful return

NOACTI:	LOAD	S1,(S2),H$TEM		; no active input request
	JUMPN	S1,RETIAB		; emulation is responding to device active
					; termination is just fishing

RETNBR: MOVX	S1,D6NBR		; return non-fatal, "wait awhile" error
	$RETF
	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

DSRLP:	$CALL	LINSTS			; Get the line status
	JUMPF	.POPJ			; [306]  Failed .. line must be dead
	LOAD	T1,,SLINF		; Get the info status byte
	TXNE	T1,SLDSR		; Test for the DSR set
	JRST	STOGST			;  Yes .. start output grant request


	LOAD	T1,,SLFLG		; Get line flags.
	TXNN	T1,SLCME		; Check for line failure
RETDSR: SKIPA	S1,[D6DNU]		; no DSR
RETLGA: MOVX	S1,D6LGA		;  Yes .. say line has gone away.
	$RETF				; Failure return

STOGST:	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

REQODV:	$CALL	CKOABT			; Check for output aborts
	JUMPF	.POPJ			; [306]  Yes .. just give error return
	TXNE	T1,SDIPW!SDIPR!SDIRN!SDIPG!SDIEC ; Check for input requested
	JRST	RETCGO			;  Input coming .. can't do output
	TXNE	T1,SDEOS!SDEOC
	JRST	REQEOF
	TXNE	T1,SDORN!SDOPG		; Output running or granted already?
	JRST	STGRUN			;  No so go request output
REQGO:	$DVCMD	DC.ROP			; Request to do output
	JUMPF	.POPJ			; [306] 

	$CALL	CKOABT			; Check for output aborts
	JUMPF	.POPJ			; [306]  Yes .. failure on device
	TXNE	T1,SDOPG!SDORN		; Check to see if grant gotten
	JRST	STGRUN			; yes - go to it
	TXNE	T1,SDIPW!SDIPR!SDIRN!SDIPG!SDIEC ; no - check for reasons
	JRST	RETCGO			; input coming
	TXNE	T1,SDOPR		; still requesting output?
	JRST	RETNBR			; yes - wait
					; just can't seem to get it right today

RETCGO:	LOAD	S1,(S2),H$TEM		; tell caller he can't DO output now
	JUMPE	S1,RETNBR		; LPTSPL can't stand D6CGO
	MOVX	S1,D6CGO		; and IBMSPL requires it!
	$RETF

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

REQEOF:	$CALL	EOFLP1
	JUMPT	REQODV
	$RET
	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 occurred, 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
;		T2/ line flags

CKIABT: $CALL	DEVSTS			; Get device status
	JUMPF	.POPJ			; [306] 
	LOAD	T2,,SDLFG		; Get line status flags
	LOAD	T1,,SDFLG		; Get device flags
	TXNE	T1,SDIEC		; check for input eof 1st in case it
	$RETT				; is one step ahead of disaster
	TXNN	T1,SDIAS		; Has input abort occurred?
	$RETT				;  No .. we are ok here
	TXNN	T1,SDIAC		; Has the abort completed?
	JRST	RETNBR			; no - wait
	$DVCMD	(DC.CIA)		; Clear input abort flag
	JUMPF	.POPJ			; [306]  Failed to clear flag
RETIAB:	MOVX	S1,D6IAB		;[243]   Cleared .. input abort occurred
	$RETF				;[243] 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 occurred, 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
;		T2/ line flags

CKOABT: $CALL	DEVSTS			; Get device status
	JUMPF	.POPJ			; [306] 
	LOAD	T2,,SDLFG		; Get line status flags
	LOAD	T1,,SDFLG		; Get device flags
	TXNN	T1,SDOAS		; Has output abort occurred?
	$RETT				;  No .. we are ok here
	TXNN	T1,SDOAC		; Has the abort completed?
	JRST	RETNBR			; no - wait
	$DVCMD	(DC.COA)		; Clear output abort flag
	JUMPF	.POPJ			; [306] Failed to clear flag
RETOAB:	MOVX	S1,D6OAB		;[243] Cleared .. I/O error occurred
	$RETF				;[243] 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 - S1/PDD
;
; Returns -
;
;	S2/	Location of the new handle list entry

ALCHAN: $CALL	GETHND			; Create a handle list entry
	JUMPF	.POPJ			; [306] no more free space
	PUSH	P,S1
	SETO	S1,			; Set the bytes per message to
	STORE	S1,(S2),H$BPM		;  +infinity so commands go through
	SETZM	CDPTR(S2)		;  init input card dev data base
	SETZM	CDCNT(S2)
	SETZM	CDBUF(S2)
	SETZM	CDERM(S2)

	POP	P,S1
	$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
	$CALL	VALHND			; make very sure
	JUMPF	.POPJ			; [306] 
	MOVE	T1,S2			; Make a copy of list entry address

RLSH.2: SKIPE	CDBUF(S2)		; check for input card dev buffer
	JRST	[MOVE	S1,CDBSZ(T1)	; yes - release buffer
		 PUSH	P,S2		; save the handle
		 PUSH	P,CDBUF(S2)	; save the buffer address
		 IDIVI	S1,5		; calc no. words
		 SKIPE	S2
		 AOS	S1
		 POP	P,S2		; get the  buffer address back
		 $CALL	M%RMEM
		 POP	P,S2		; get the handle back
		 JRST	.+1]
	$CALL	REMHND			; flush the handle
	JRST	RLSFE			; Go conditionally release the FE
	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
;
; Function -
;	(DEQD60) To dequeue a DN60 on a port so that others can use it again.
;
; Parameters-
;
;	S1/	PDD


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	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:	SKIPG	PTYPE			; Check for a KS10 (2020)
	$RETT				; yes - nothing to do
	$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 the port number
	CAIL	S1,DTEOFF		; Check to see if the DTE # is within
	CAILE	S1,MAXDTE		;  valid bounds
	JRST	ERT (D6NSP)		; Port number not defined
	$CALL	PROTYP			; check protocol version
	JUMPL	S1,RETDNR		; no protocol running
	CAIN	S1,.VND60
	$RETT				; DN60 protocol running
	CAIE	S1,.VN20F
	JRST	ERT (D6PIU)		; some other protocol(MCB) running
					; RSX20F protocol running
	LOAD	S1,PDD,PD$PRT		; get the port number
	SKIPE	FEJFN			; If JFN already assigned .. then
	 PJRST	SELDTE			;  just go select the DTE

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

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

RETDNR:	MOVEI	S1,D6DNR		; no protocol running on fe
	$RETF

; Here if GTJFN fails on FEn:

OPERR1:	 AOJA	FENM,OPFE2		;  No .. so try next one

; 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

; Here on fatal errors that need to dequeue the port

OPCLR:	SETZM	FEJFN			; Clear the JFN before returning
OPDIE:	MOVE	S1,PDD			; Get the device descriptor
	$CALL	DEQD60			; Get rid of the port
	MOVX	S1,D6COF
	$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	CPUTYP -- Routine to type the processor

; Routine - CPUTYP
;
; Function -
;
;	This routine determines whether we are running on a KL or KS system.
;
; Parameters - none
;
; Returns - True always
;
;	PTYPE/ processor type code


; CPUTYP - cleverly determine what processor we are on

CPUTYP:	$SAVE	<S1,S2,T1,T2>
	JFCL	.+1			; clear the flags
	JRST	.+1			; see if we change the pc flag
	JFCL	S1,PDP6			; yes,it was a pdp-6
	SETO	S1,			; set ac to -1
	AOBJN	S1,.+1			; see how it adds 1,,1 to -1
	JUMPN	S1,KA10			; on a ka, it is two full adds
	BLT	S1,0			; noop blt
	JUMPE	S1,KI10			; ki wont update the word
	DMOVE	S1,[EXP 1,0]		; 1, and no string pointer
	DMOVE	T1,S1			; offset of 1 and string length of 0
	EXTEND	S1,[CVTBDO]		; convert binary to decimal with offset
	TLNE	T2,200000		; look for kl microcode bug
KL10:	SKIPA	S1,[P.KL10]		; set KL10 type
KS10:	MOVX	S1,P.KS10		; set KS10 type
SETCPU:	MOVEM	S1,PTYPE		; set the cpu type
	$RETT
KA10:	SKIPA	S1,[P.KA10]		; set KA10 type
KI10:	MOVX	S1,P.KI10		; set KI10 type
	JRST	SETCPU
PDP6:	MOVX	S1,P.PDP6		; set PDP-6 type
	JRST	SETCPU

;PTYPE:	0				; processor type
 P.KS10==1B0				; KS10 - deliberately the sign bit
 P.KL10==1B1				; KL10
 P.KI10==1B2				; KI10
 P.KA10==1B3				; KA10
 P.PDP6==1B4				; PDP-6

    > ;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	<S2,P2>			; Save registers

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

OPNFER:	CAIN	S1,C11IU%		; check non-fatal possibility
	JRST	RETNBR			; return non-fatalistic err
	MOVX	S1,D6COF		; fatal
	$RETF
    > ;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 <SKIPN	FEJFN			; check if any jfn to release
	$RET				; no - nothing to do
					; jfn implies RSX20F protocol
	$SAVE	<TF,S1> 		; Save last error flag and return code
	$CALL	LFIRST			; Position to first entry
	 JUMPT	.POPJ			; If entry found then return
	SKIPN	S1,FEJFN		; Last entry in list is destroyed
	$RET				; return if no jfn
	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	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: MOVE	S1,[-D6.BYT,,FC.R6S]
	$CALL	GETSTS			; do the status function
	$RET
	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: MOVE	S1,[-DS.BYT,,FC.RDS]
	$CALL	GETSTS			; do the status function
	JUMPF	DEVREJ			; analyze possible reject
	$RET
	SUBTTL	Return status

; Routine - GETSTS
;
; Function - To get the status specified in the given PDD.
;
; Parameters -
;
;	S1/	-<BYTE COUNT>,,FCN CODE
;	S2/	Pointer to handle list entry
;
; Returns - T/F AND STATUS IN STSBUF IF T

GETSTS: $SAVE	<T1,T2> 		; Save registers
	MOVE	T1,S1			; SAVE THE ARGS
	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
	HRRZM	T1,(ARGP)		; Put THE FCN CODE into argument block
	HLRES	T1			; INIT THE BYTE COUNT
	MOVE	T2,[POINT 8,STSBUF]	;  and byte pointer, may be destroyed
	DMOVEM	T1,1(ARGP)
	$CALL	FEI%O			; I/O to the front end (Device status)
	LOAD	S1,(ARGP),ARG$XF	; default to no. of bytes transferred
	SKIPT				; If an error occurred
	 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
	$RET				; RLSARG preserves TF so just 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: MOVE	S1,[-LS.BYT,,FC.RLS]
	$CALL	GETSTS			;GET THE STATUS
	JUMPT	[SKIPN	S1		;SUC'D BUT NO STATUS IS LINE DISABLED
		 PUSHJ	P,LINST1	;CLEAR THE STATUS BUFFER - LINE  DISABLED
		 $RETT] 		;AND RETURN TRUE
LINST1: PUSH	P,S1			;FAILED - RETURN 0'S FOR STATUS

	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

	POP	P,S1
	$RETF				; 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
	CAIE	S1,.OPSGN
	CAIN	S1,.OPCDR		;  which if it is a card reader
	MOVX	T1,1			;  then it's doing input
	JRST	STHP.2			; unless in emulation mode

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
STHP.2:	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	.POPJ			; [306]  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: PUSH	P,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
	POP	P,S2
	$RET				; Return, ignoring errors

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

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

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

LINCMD: $SAVE	<P1,P2,P3>		; Arg blk ptr, func code, cmd length
	MOVX	P2,FC.WLC		; Function code to write a line command
	MOVE	P3,LNCBYT(S1)		; Get number of bytes in value for cmd
	$CALL	CNTCMD			; do the command function
	$RET

DEVCMD: $SAVE	<P1,P2,P3>		; Arg blk ptr, func code, cmd length
	MOVX	P2,FC.WDC		; Function code to write a device cmd
	MOVE	P3,DVCBYT(S1)		; Get number of bytes in cmd string
	$CALL	CNTCMD			; do the command function
	JUMPF	DEVREJ			; check out possible reject
	$RET

CNTCMD:	MOVE	P1,S1			; Save the command number
	$CALL	ALCARG			; Allocate a FEI%O arg block
	EXCH	S1,P1			; Swap arg blk ptr and command number
	STORE	P2,(P1),ARG$FC		; Save the function code (write cmd)
	STORE	S1,(P1),CMD$FC		; Put command function in cmd string
	CAIN	P3,1			; Check for only 1 byte in cmd string
	JRST	SNDCMD			;  Yes .. so no data follows it.
	CAIN	P3,2			; Check for 2 bytes in cmd string
	JRST	B1CMD			;  Yes .. so 1 byte of data follows
	STORE	T1,(P1),CMD$2B		; Otherwise we have 2 bytes of data
	JRST	SNDCMD			;  to send
B1CMD:	STORE	T1,(P1),CMD$1B		; Store the single byte of cmd data
SNDCMD: MOVNS	P3			; Make the byte count and
SNDC.1: MOVSI	S1,(POINT 8)		; Make a pointer to the command string
	HRRI	S1,CMD$WD(P1)		;  in dynamic memory
	STORE	S1,(P1),ARG$PT		; Put it into the FE I/O arg block
	STORE	P3,(P1),ARG$BC		; Set the number of bytes to output
	MOVE	S1,P1			; Point to the arg block
	$CALL	FEI%O			;  and do the I/O to the front end
	LOAD	S1,(P1),ARG$RC		; Get the result code on error
	EXCH	S1,P1			; Exchange error code and blk ptr
	$CALL	RLSARG			; Release the argument block
	MOVE	S1,P1			; Get the error code again
	JUMPE	S1,.RETT		; [306] If no error then give success
	$RETF				;  else give error return
	SUBTTL	DEVREJ -- analyze device function failure

; Routine - DEVREJ
;
; Function - analyze the failure of a device related function. A reject might
;	     mean any of several things - the most probable being the line is
;	     gone.
;
; Parameters - S1/error code from previous function call
;	       S2/device handle
;
; Returns - S1/possibly mapped error code

DEVREJ:	CAIE	S1,D6REJ		; check if previous device function was rejected
	$RET				; no - just return
	$CALL	LINSTS			; yes - get the line status
	JUMPF	.POPJ			; [306] looks like the fe is dead or delayed
	$SAVE	T1
	LOAD	S1,,SLINF		; get line info
	LOAD	T1,,SLFLG		; get line flags
	TXNN	T1,SLDIP!SLLDC		; check line dying or dead
	TXNN	S1,SLLEN		; check line disabled
	JRST	RETLGA			; yes - reason for rejecting device fcn
	JRST	RETNBR			; no - must have been a race...maybe it will go away
	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:	DPB	T1,[POINT 8,T1,19]
	LSH	T1,-^D8
	$RET
	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 occurred
	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
TOPS20 <

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

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

	SETZM	NBXFRD(P2)		; clear the number of bytes transferred
	LOAD	S1,(P2),H$PRT		; Get the DTE #
	SETZ	P4,			; default protocol flag to old
	SKIPL	PTYPE			; Check for KL style I/O
	JRST	[SKIPE	P4,PVTYP-DTEOFF(S1)	; check for version 5 protocol
		 JRST	.+1		; yes - continue
		 $CALL	SELDTE		;  Make the link to the correct DTE
		 JUMPF	ERT(D6DTE,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 to xfer
	JUMPN	P4,FEI1			; no enq for version 5
	LOAD	S1,(P2),H$PDD		; Get device descriptor
	$CALL	ENQD60			; Enqueue the port for SIN/SOUT I/O
	JUMPF	FIONBR			; nothing's going right today

FEI1:	LOAD	T1,(P1),ARG$PT		; Get the pointer to the buffer area
	HLRZ	T2,T1			; Get the position/size part
	CAIN	T2,-1			; If it is a HRRO type byte pointer
	 HRLI	T1,440700		;  then convert it to a real byte pntr
	STORE	T1,(P1),ARG$PT		; Put the byte pointer back
	LOAD	T1,(P1),ARG$FC		; Get function code to perform
	STORE	T1,,XMTFC		; Put it into 2nd byte in header
	LOAD	T1,(P2),H$LIN		; Get line number to do I/O to.
	STORE	T1,,XMTLN		; Put it into 3rd byte in header
	LOAD	T1,(P2),H$CDV		; Get communications device number
	STORE	T1,,XMTDV		; Put the device code in the 4th byte
	LOAD	T1,(P1),ARG$FC		; Get the function we are doing
	TRNN	T1,1			; If it is odd then we do a read
	 JRST	WRITE			;  else we are doing a write operation.
	JRST	READ			; Go do read
	SUBTTL	FEI%O -- Read in from device (TOPS20)

READ:	$CALL	PUTHDR			; Output the header to say read data
	 JUMPF	FIOFDQ			;  Header failure test
	JUMPN	P4,RD.PV5		; if version 5, done
	$CALL	GETHDR			; Get the response header
	 JUMPF	FIOFDQ			;  Input header no good
	LOAD	T1,,RCVBC		; Number of bytes to read in
	JUMPG	T1,READOK		; check if any data to be read
	LOAD	S1,,RCVRC		; Get the result of the header
	CAIN	S1,RC.REJ		; Check for reject of header
	 JRST	FIOREJ			;  If so .. terminate this read
	CAIE	S1,RC.DLY		; delay ?
	JRST	FIOTDQ			; no - suc'd with no data returned
	JRST	FIONBR			; Dismiss while waiting for -11 to
					; catch up .. then try again

READOK:	MOVE	S1,FEJFN		; Get JFN for logical FE
	LOAD	S2,(P1),ARG$PT		; Get byte pointer to data buffer
	MOVN	T1,T1			; Negative the byte count to read
	SKIPG	PTYPE			; 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 the pointer to continue on

RD.WRK: LOAD	T1,,RCVBC		; Get the byte count to read again.
	LOAD	S1,,RCVRC		; Get the result of the header

RD.WR1:	JUMPE	T1,RD.WR2		; if no data xfer'd, skip updates
	ADDM	T1,NBXFRD(P2)		; Up the bytes transfered count
	ADDB	T1,NBTXFR(P2)		; Down the bytes yet to transfer

RD.WR2:	CAIN	S1,RC.DLY		; was last return a delay?
	JRST	FIONBR			; yes - don't bother to look for more
	JUMPGE	T1,FIOTDQ		; if no more bytes left  - done
	LOAD	S1,(P1),ARG$FC		; partial suc - check operation type
	CAIE	S1,FC.RD		; data reads are continuous
	JRST	FIOTDQ			; other operations are 1 shots
	JRST	READ			; Go continue transfer

RD.PV5:	LOAD	T1,,D6CNT		; check how much happened
	SKIPG	S2,T1
	JRST	RD.P5A
	LOAD	S1,(P1),ARG$PT		; get the original byte ptr
	ADJBP	S2,S1			; advance the ptr by that much
	STORE	S2,(P1),ARG$PT		; update the ptr
RD.P5A:	LOAD	S1,,D6RSP		; get the response code
	CAIE	S1,RC.REJ
	JRST	RD.WR1
	JRST	FIOREJ
	SUBTTL	FEI%O -- Write out to device (TOPS20)

WRITE:	$CALL	PUTHDR			; Output the transmit header
	 JUMPF	FIOFDQ			;  The header transmission failed
	JUMPN	P4,WR.PV5		; if version 5, done
	MOVE	S1,FEJFN		; Get the JFN to do I/O on
	LOAD	S2,(P1),ARG$PT		; Point to the string to output
	LOAD	T1,,XMTBC		; Number of bytes to output
	MOVN	T1,T1			; Make negative for JSYS size delimit
	SKIPG	PTYPE			; 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
	$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

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	FIOREJ			;  and if so .. give failure return
	LOAD	T1,,RCVBC		; Get the number of bytes

WRT.2A:	JUMPE	T1,WRT.24		; if no data actually xferred, skip ptr update
	ADDM	T1,NBXFRD(P2)		;  add onto number of bytes transferred
	MOVE	S2,T1			; prepare to adjust the ptr
	ADDB	T1,NBTXFR(P2)		; Remove from number of bytes yet to do
	LOAD	T2,(P1),ARG$PT		; get the beginning byte ptr
	ADJBP	S2,T2			; have to do this because the SOUT xferred
					; the whole amt regardless of how much was
					; accepted by the FE
	STORE	S2,(P1),ARG$PT		; save ptr to next byte

WRT.24:	CAIN	S1,RC.DLY		; Check for a delayed I/O return
	JRST	FIONBR			; Dismiss process for a while
	JUMPGE	T1,FIOTDQ		; If none left .. then successful
	JRST	WRITE			; Go finish writing

WR.PV5:	LOAD	T1,,D6CNT		; get the amount done
	LOAD	S1,,D6RSP		; and the response code
	CAIE	S1,RC.REJ
	JRST	WRT.2A
	JRST	FIOREJ
	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 number of bytes left to xfer
	JUMPN	P4,PUTHD5		; elsewhere for version 5 protocol
	SKIPL	PTYPE			; Check for DDCMP (2020) line
	SKIPA	T2,[^O376]		; limit for crock FE device service
	MOVEI	T2,^O274		;  Max number of bytes for DMC driver
	CAMLE	T1,T2			; check device service limits
	MOVE	T1,T2
	STORE	T1,,XMTBC		; Store in the # bytes to transfer cnt
	MOVE	S1,FEJFN		; Get the JFN for the FE
	MOVE	S2,[POINT 8,XMTHDR]	; Point to the transmit header
	MOVX	T1,-6			; Get the string byte count
	SKIPG	PTYPE			; 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.


PUTHD5:	MOVEI	S2,PUTARG		; send version 5 header
	STORE	T1,,D6CNT		; set count in XMTHDR
	LOAD	S1,(P1),ARG$FC
	TRNE	S1,1			; skip if write fcn
	MOVNS	T1			; read fcns use negative byte count
	STORE	T1,(S2),BT6DBC		; set byte count in BOOT arg block
	LOAD	S1,(P1),ARG$PT		; get the beginning byte ptr
	STORE	S1,(S2),BT6PTR		; and stuff it also
	LOAD	S1,(P2),H$PRT		; get the port number
	ANDI	S1,7
	STORE	S1,(S2),BT6DTE		; stuff the dte number
	MOVEI	S1,6			; size of header
	STORE	S1,(S2),BT6HDR
	MOVEI	S1,XMTHDR
	STORE	S1,(S2),BT6HDR		; where it is
	MOVEI	S1,.BTD60		; do a DN60 transaction
	BOOT
	ERJMP	V5ERR
	$RETT

V5ERR:					; analyze version errors
	LOAD	S1,(S2),BT6ERR		; get the error codes
	TXNE	S1,D6.BDP
	JRST	ERT(D6BAD)		; crufty byte ptr
	TXNE	S1,D6.TPO!D6.TRS!D6.TDT	; TRS observed when tgha run, assume
					; TDT might also occur
	JRST	RETNBR			; waited too long for port
	TXNE	S1,D6.NT6
	JRST	RETDNR			; not a DN60 front end

	MOVX	S1,D6IOE		; bad things are happening
	$RETF

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

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

GETHDR: MOVE	S1,FEJFN		; Get the JFN of the FE
	MOVE	S2,[POINT 8,RCVHDR]	; Point to the receive header string
	MOVX	T1,-6			; 6 bytes in the header
	SKIPG	PTYPE			; 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:	$SAVE	<S2,T1> 		; preserve results of SIN/SOUT
	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.
	SUBTTL	FEI%O -- Routines FIOTDQ, FIOFDQ, FIOFAI (TOPS20)

; 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

;REJECTED(AROGANTLY) IO RETURN

FIOREJ: MOVEI	S1,D6REJ		; return rejectedness
	JRST	FIOFDQ

;COMMON NON-FATAL NONBLOCKING RETURN

FIONBR: SKIPA	S1,[D6NBR]		; return non-fatal "wait awhile" error

; 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:	SETZ	S1,			; return error code of 0 to indicate success

; Common 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
	SKIPN	P4			; if version 5 protocol, didn't enq
	$CALL	DEQD60			; Release the port
	MOVE	S1,NBTXFR(P2)		; and the no. left to go
	STORE	S1,(P1),ARG$BC

FIOFD0: MOVE	S1,NBXFRD(P2)		; return no. of bytes actually xfrred
	STORE	S1,(P1),ARG$XF
	DMOVE	S1,P1			; Restore the 2nd arg register
	LOAD	0,(P1),ARG$RC		; check out type of return
	JUMPE	0,.RETT			; [306] suc'd
	$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$PRT		; Get synchronous line number
	ANDI	S1,7			; make 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:	$SAVE	T4
	DMOVEM	S2,RDSAVE		; Save the read arguments
	LOAD	S1,(P2),H$PRT		; Get synchronous line number
	ANDI	S1,7			; make line number
	MOVEM	S1,.BTDTE+BTARG 	; Set it as the DTE/line in BOOT block
	MOVEI	T4,^D100		; set retry counter

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	RETDNR			;  No .. so front end not running
	JRST	R20AGN			; Try to read it again
R20RTY:	SOJL	T4,RETDNR		; must be dead
	MOVEI	S1,^D10			; take a catnap
	DISMS

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

PROTYP:	$SAVE	S2			; S1/port
	PUSH	P,S1
	MOVEI	S2,PROARG		; determine protocol version running on dte
	ANDI	S1,7
	MOVEM	S1,.BTDTE(S2)		; stuff dte number
	MOVEI	S1,.BTSTS		; get dte status
	BOOT				; returns protocol version or -1
	ERJMP	PRODFL

	SKIPA	S1,PROARG+.BTCOD	; snatch the results
PRODFL:	SETO	S1,			; none running
	POP	P,S2
	MOVEM	S1,PVTYP-DTEOFF(S2)
	$RET

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

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

	DMOVE	P1,S1			; Setup regs for structure accesses
					; P1/arg block ptr, P2/ptr to handle list entry
	SETZ	S1,
	STORE	S1,(P1),ARG$XF		; init number of bytes transferred

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

FERTR0: LOAD	S2,(P2),H$PRT		; Get the port number
	TRO	S2,400000		; Using new style CAL11. arg word
	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
	JRST	[HRLI	S1,(POINT 7)	; MAP TO AN ASCII PTR
		 MOVX	S2,7		;  and if so assume ASCII (7bit)
		 STORE	S1,(P1),ARG$PT	; STUFF IT BACK
		 JRST	.+1]
	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
	LOAD	T1,S1,BP.SIZ		; get no. bits per byte
	SUBX	S2,44			; Remove the number of bits per word
	MOVM	S1,S2			; Get the magnitude of the difference
	IDIV	S1,T1			; 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
	CAL11.	S1,			;  for the talk to the 11.
	 JRST	FEERR			;   Error while talking to 11
	LOAD	S1,(P3),C$BXF		; Get the number of byts transfered
	JUMPE	S1,FERTR1		; no bytes xferred
	LOAD	S2,(P1),ARG$XF		; update total transferred
	ADD	S2,S1
	STORE	S2,(P1),ARG$XF		;  and return in to the caller
	LOAD	S2,(P1),ARG$BC		; adjust byte count by amount xferred
	ADD	S2,S1
	STORE	S2,(P1),ARG$BC		; set no. left to  xfer
	LOAD	S2,(P3),C$BPW		; optimistically assume bytes/word still there
	SOS	1			; do last ibp special to handle  byte
					; ptr in initial form 440700,,xxxxxx
	IDIV	S1,S2			; S1/no. full words,S2/residual bytes
	LOAD	T1,(P1),ARG$PT		; get the start ptr
	ADD	T1,S1			; advance by full words
	IBP	T1			; advance by bytes(always at least one)
	SOJGE	S2,.-1
	STORE	T1,(P1),ARG$PT		; set the updated ptr

FERTR1: LOAD	S1,(P3),C$RC		; Get the result code of the transfer
	CAIN	S1,RC.DLY		; delayed ?
	JRST	FERNBR			; yes - give innocuous error response
	CAIN	S1,RC.REJ		; rejected ?
	JRST	ERT (D6REJ,FERRET)	; yes - return error
	SETZ	S1,			; it suc'd
	STORE	S1,(P1),ARG$RC		;  return that also to the caller
					; check termination conditions
	LOAD	TF,(P3),C$BXF		; get number of bytes transferred last
	JUMPE	TF,.RETT		; [306] null transfer implies done
	LOAD	TF,(P1),ARG$BC		; check no bytes left to xfer
	JUMPGE	TF,.RETT		; [306] done?
	LOAD	TF,(P1),ARG$FC		; partial suc - check operation type
	CAIN	TF,FC.RD		; data reads are continuous
	JRST	FERTR0			; go around once more
	$RETT				; Return with a good indication

FEERR:	CAIE	S1,C11IU%		; Was the 11 in use when we tried it?
	 JRST	FEFATL			;  No .. we got some other fatal error


FERNBR: SKIPA	S1,[D6NBR]		; return non-fatal err

FEFATL: $CALL	FATMAP			; INTERPRET CAL11. ERRORS

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


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

FIORET: $SAVE <TF>			; Save result code
	MOVX	S1,C$SIZ		; Get size of block
	MOVE	S2,P3			; Location of block
	PJRST	M%RMEM			; Release memory and return

FATMAP: $SAVE	<S2,T1>
	MOVE	S2,[-FATERL,,FATERR]	; MAP CAL11. ERROR CODE IN S1 TO D60 CODE

FATMP0: HRRZ	T1,(S2) 		; SCAN TABLE FOR TRANSLATABLE ERRORS
	CAMN	T1,S1
	JRST	[HLRZ	S1,(S2) 	; SUC ! GET THE D60 ERROR CODE
		 $RETF] 		; RETURN AND ERROR CONDITION
	AOBJN	S2,FATMP0
	MOVEI	S1,D6IOE		; UNTRANSLATABLE ERROR
	$RETF

FATERR: D6PLD,,C11NP%			; THE MAPPER
	D6FNI,,C11UF%
	D6NSP,,C11ND%
	D6NBR,,C11IU%
	D6DNR,,C11NA%
	D6BAD,,C11OR%
	D6NBR,,C11FC%
	D6DNR,,C11DN%
	D6BAD,,C11FU%
FATERL=.-FATERR


    > ;End if TOPS10
	SUBTTL	GLOBAL ROUTINE -- D60LOG,   logging SYSERR info on a line

; Routine - D60LOG
;
; Function - To log SYSERR information about a line specified by the
;	handle argument.  To get this information, the line status (LINSTS)
;	routine is called and it's buffer retrieved.  The SYSERR header is
;	built and the data copied.  Then it is all shipped to the SYSERR data
;	base by whatever mechanism the system supplies.
;
; Parameters -	S1/device handle - only the port,line is used
;
; Returns -	TRUE if all copasetic; appropriate code if line/port error

	ENTRY	D60LOG

D60LOG:	DBGSTR	<D60LOG>
	$SAVE	<S2,P1,P2,P3,P4>

	$CALL	SRCHAN			; check validity of handle
	JUMPF	ERT(D6NSH)		; complain
	LOAD	P1,(S2),H$PRT		; get the port number
	LOAD	P2,(S2),H$LIN		; get the line number

D60LO1: SKIPN	LPAGE			; check if logging enabled
	$CALL	LOGENB			; no, do it
	MOVE	P4,S2			; save handle
	MOVE	P3,LPAGE		; Get the address of buffer

	MOVX	S1,SEC%D6		; DN60 line logging code
TOPS20< MOVX	S2,<LS.BYT+3>/4>	; Number of words in entry (w/o header)
	$CALL	SYRHDR			; Make a SYSERR entry header

	MOVE	S2,P4			; get the handel
	$CALL	LINSTS			; Get the line
	JUMPF	.POPJ			; [306]  Failed ... the line is down

	HRLM	P1,.SYDAT(P3)		; Put port number
	HRRM	P2,.SYDAT(P3)		;  and line number into data portion
	HRLI	S1,STSBUF		; Get address of status buffer
	HRRI	S1,.SYDAT+1(P3) 	; Address of SYSERR data body
	BLT	S1,.SYDAT+1+<LS.BYT+3>/4(P3) ; Move it all
	MOVE	S1,P3			; Get address of SYSERR entry
TOPS20< MOVX	S2,.SYDAT+1+<LS.BYT+3>/4 ; Length of the total entry
	SYERR				; Dump it to SYSERR data base
	 ERJMP	.ERSJF
	>
TOPS10< HRLI	S1,.SYDAT+1+<LS.BYT+3>/4 ; Length of the total entry
	DAEMON	S1,			; do it
	JRST	.ERSJF			; failed
	>

	MOVE	S2,P4			; get the handle and
	JRST	LINCH1			; Go check for status claiming line
					;  gone away.

LOGENB: $SAVE	<S1>			; enable SYSERR logging
	$CALL	M%GPAG			; Get a page for logging
	MOVEM	S1,LPAGE
	$RET				; logging now enabled

	SUBTTL	GLOBAL ROUTINE -- D60POL

; Routine -	D60POL
;
; Function -	D60LOG with port,line arg instead of handle
;
; Parameters -	S1/port,,line
;
; Returns -	same as D60LOG

	ENTRY	D60POL

D60POL:	DBGSTR	<D60POL>
	$SAVE	<S2,P1,P2,P3,P4>
	HLRZ	P1,S1			; get the port number
	HRRZ	P2,S1			; get the line number
	MOVE	S2,S1			; make a PDD
	SETZ	S1,
	$CALL	PCKPDD
	$CALL	INIDMY			; create a handle
	JUMPF	RLSHAN			; can't open FE, go away
	STORE	P2,(S2),H$LIN
	$CALL	D60LO1			; do the logging
	MOVE	S2,P4			; retrieve the handle
	JRST	RLSHAN			; and flush it on the way out
	SUBTTL	LINCHK - check lines for  upness/downess

; Routine - LINCHK
;
; Function - To poll a specific line, checking for a state transition.
;	 If the line has gone down, the line is put back into polling
;	 state and a node disable entry is made.
;
; Parameters -	S2/device handle
;
; Returns -	LINSTS results

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

	LOAD	P1,(S2),H$PRT		; get the port number
	LOAD	P2,(S2),H$LIN		; get the line number

	$CALL	LINSTS			; Get the status
	 JUMPF	.POPJ			; [306]  Failed ... go away

LINCH1: LOAD	S1,,SLFLG		; Get line flags
	TXNE	S1,SLDIP!SLLDC		; check disable in progress or complete
	 JRST	RETLGA			;  Yes .. line gone away
	LOAD	S1,,SLINF		; Get line info flags
	TXNN	S1,SLDSR		; Check DSR set flag
	 JRST	RETDSR			;  No DSR .. line down

	$RETT				; Return
	SUBTTL	Line gone down SYSERR recording

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

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

	SKIPN	P3,LPAGE		; Get address of logging page
	$RET				; logging not enabled
	PUSH	P,S1			; save the node name
	MOVX	S1,SEC%DE		; Line enable/disable entry
TOPS20< MOVX	S2,NED.SH>		; Short entry
	$CALL	SYRHDR			; Make header for this entry
	MOVX	S1,.CNDIS		; Line disable
	HRRZM	S1,NED.CD(P3)		; Put in enable/disable code
	POP	P,NED.NM(P3)		; stuff the node name
	HRLM	P1,NED.ID(P3)		; Store port number
	HRRM	P2,NED.ID(P3)		; Store line number
	MOVE	S1,P3			; Get address of entry
TOPS20< MOVX	S2,NED.SH+.SYDAT	; Total length of entry
	SYERR				; Put in ERROR.SYS file
	 ERJMP	.ERSJF
	>
TOPS10< HRLI	S1,NED.SH+.SYDAT	; Total length of entry
	DAEMON	S1,			; stuffit
	JRST	.ERSJF			; impervious to stuffing
	>

	$RETT

; ROUTINE - LOGDWN
;
; FUNCTION -  log line going away
;
; PARAMETERS -
;	S1/	sixbit node name
;	S2/	handle list entry
;
; RETURNS - eventually

LOGDWN: $SAVE	<S2,P1,P2>		; log downness
	LOAD	P1,(S2),H$PRT		; get the port
	LOAD	P2,(S2),H$LIN		; get the line
	$CALL	LINDWN			; loggit
	$RETT
	SUBTTL	Line come up SYSERR recording

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

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

	SKIPN	P3,LPAGE		; Get address of logging page
	$RET				; logging not enabled
	PUSH	P,S1			; save the node name
	MOVX	S1,SEC%DE		; Line enable/disable entry
TOPS20< MOVX	S2,NED.SZ>		; Length of entry
	$CALL	SYRHDR			; Make header for this entry
	MOVX	S1,.CNENB		; Line enable
	HRRZM	S1,NED.CD(P3)		; Put in enable/disable code
	POP	P,NED.NM(P3)		; stuff the node name
	HRLM	P1,NED.ID(P3)		; Store port number
	HRRM	P2,NED.ID(P3)		; Store line number
	LOAD	S1,,SLCSD		; Transfer clear to send delay
	MOVEM	S1,NED.CS(P3)
	LOAD	S1,,SLSWL		; Transfer silo warning level
	MOVEM	S1,NED.SW(P3)
	LOAD	S1,,SLBPM		; Transfer bytes per message
	MOVEM	S1,NED.BM(P3)
	LOAD	S1,,SLRPM		; Transfer records per message
	MOVEM	S1,NED.RM(P3)
	MOVE	S1,P3			; Get address of entry
TOPS20< MOVX	S2,NED.SZ+.SYDAT	; Total length of entry
	SYERR				; Put in ERROR.SYS file
	 ERJMP	.ERSJF
	>
TOPS10< HRLI	S1,NED.SZ+.SYDAT	; Total length of entry
	DAEMON	S1,			; crammittoit
	JRST	.ERSJF			; anticramming devices deployed
	>

	$RETT

.ERSJF: $WTOJ	<SYSERR entry failure>,<D60JSY attempt to make SYSERR entry failed>,IBMOBJ
	$RETT				;it's true


; ROUTINE - LOGUP
;
; FUNCTION -  log line going up
;
; PARAMETERS -	S1/sixbit node name
;		S2/handle
;
; RETURNS - eventually

LOGUP:	$SAVE	<S1,S2,P1,P2>		; log upness
	LOAD	P1,(S2),H$PRT		; get the port
	LOAD	P2,(S2),H$LIN		; get the line
	$CALL	LINUP			; loggit
	$RETT
	SUBTTL	SYSERR entry header creation

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

SYRHDR: STORE	S1,(P3),SYCOD		; Store event code (SY%XXX)

TOPS10< MOVX	S1,.DMERR		; get the  DAEMON  function for SYSERR entry
	STORE	S1,(P3),SYFCN		; insert with authority
	>

TOPS20< STORE	S2,(P3),SYLEN		; Store length of entry
	MOVX	S1,.SYDAT		; Get length of SYSERR entry header
	STORE	S1,(P3),SYHLN		; Store in header
	MOVX	S1,1			; Get version of SYSERR header
	STORE	S1,(P3),SYVER		; Store in header
	SETO	S1,			; Turn on all the bits (only for one)
	STORE	S1,(P3),SYT20		; Note that this entry made by TOPS-20
	$CALL	I%NOW			; Get current time and date
	STORE	S1,(P3),SYDAT		; Store time and date in entry
	TIME				; Get current uptime
	IDIV	S1,[<^D1000*^D3600*^D24>/<1_^D18>] ; Convert to days,,fractions of days
	STORE	S1,(P3),SYUPT		; Store uptime in entry header
	MOVE	S1,[SIXBIT/APRID/]	; Get table name
	SYSGT				; Get processor serial number
	STORE	S1,(P3),SYPSN		; Save processor serial number
	>
	$RETT
IFN <FTDBST>,<

	SUBTTL	DBGRSL - Print outgoing status

DBGRSL:	SKIPN	DBGSWT
	JRST	DBGEXT			;exit if either zero
	POP	P,DBGLST
	OUTSTR	@DBGLST
	SETOM	DBGERR
	JUMPF	DBGRFL			;if failed, go print error code
	OUTSTR	[ASCIZ |OK |]
	$RET
DBGEXT:	POP	P,DBGLST
	$RET
DBGRFL:	$SAVE	<TF,S1,S2>
	MOVEM	S1,DBGERR
	MOVEI	S2,^D12			;max digits to print
	SETZ	TF,
DBGDLP:	LSHC	TF,3			;get next octal digit
	JUMPE	TF,DBGNXT		;if leading zero, skip
	PUSH	P,TF			;save whole value
	TDZ	TF,[EXP 777777777770]	;clear all but low 3 bits
	IORI	TF,60			;make ASCII
	OUTCHR	TF			;print
	POP	P,TF			;get whole code back
DBGNXT:	SOJG	S2,DBGDLP		;go do next digit
	OUTCHR	[EXP 40]
	$RET

DBGSWT:	z				;make non-zero to get debugging output
DBGLST:	z				;address of text for last call
DBGERR:	z				;-1 for success, error code for fail

>;end IFN <FTDBST>
	SUBTTL	Handle space mgt

HNDINI:	SETZM	HNDLST			; init handle space - none
	$RET

SRCHAN:	HRRZ	S2,S1			; check if S1 has a legitimate handle

VALHND:	$SAVE	S1			; check if S2 has a legitimate handle
	SKIPN	S1,HNDLST		; get the list
	JRST	RETNSH			; empty - no handles possible
VALHN1:	CAMN	S1,S2			; check this one
	$RETT				; it suc's
	MOVE	S1,(S1)			; get the cdr
	JUMPN	S1,VALHN1

RETNSH:	MOVX	S1,D6NSH
	$RETF

LFIRST:	SKIPN	S2,HNDLST		; find 1st handle
	$RETF				; none yet assigned
	$RETT

LNEXT:	MOVE	S2,(S2)			; advance to next handle
	JUMPE	S2,RETNSH		; end of the line
	$RETT

FNDPDD:	$SAVE	T1			; find handle with S1/PDD
	SKIPN	S2,HNDLST		; get the 1st handle
	$RETF				; emptiness

FNDPD1:	LOAD	T1,(S2),H$PDD
	CAMN	S1,T1
	$RETT				; this handle suc's
	MOVE	S2,(S2)
	JUMPN	S2,FNDPD1
	$RETF

GETHND:	PUSH	P,S1			; find a handle with S1/PDD
	MOVEI	S1,HNDLSZ
	$CALL	M%GMEM			; get the block
	JUMPF	GETHN1
	MOVE	S1,(P)			; get the PDD
	STORE	S1,(S2),H$PDD		; stuff the PDD
	MOVE	S1,HNDLST		; get the current list
	MOVEM	S1,(S2)			; cons them
	MOVEM	S2,HNDLST		; and stash the new list
GETHN1:	POP	P,S1			; get the PDD back
	$RET

REMHND:	$SAVE	<TF,S1>			; remove S2/handle from HNDLST
	MOVEI	S1,HNDLST
REMHN1:	CAMN	S2,(S1)			; check next cell
	JRST	REMHN2
	MOVE	S1,(S1)
	JUMPN	S1,REMHN1
	$RET

REMHN2:	PUSH	P,S2
	MOVE	S2,(S2)			; get cdr of this handle
	MOVEM	S2,(S1)			; its gone
	POP	P,S2
	MOVEI	S1,HNDLSZ
	JRST	M%RMEM			; flush it altogether
	SUBTTL	Data area - global to this job



QPRT0:	POINT	3,1(S2),20		; Low order digit of port number
QPRT1:	POINT	3,1(S2),13		; High order digit of port number

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

TOPS20<
PVTYP:	BLOCK	MAXDTE-DTEOFF+1		; flag for version protocol
>

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

PTYPE:	0				; processor type

SONFOB: SONFD				; Address of file descriptor
	7				; ASCII

TOPS20<

SONDIR: ASCIZ	\D60:\
	>;END IF TOPS20

TOPS10	<
SONFD:	XWD	5,0		; Length of FDB
	SIXBIT	/D60/		; Device name
SGNNAM: EXP	0		; Filename (station name)
	SIXBIT	/SON/		; Extension (.SON or .SOF)
	EXP	0		; PPN
    >;End if TOPS10



					; object block for $WTOx fucntions
IBMOBJ: .OTIBM				; this is an IBM object
	0				; no unit
	0				; no device


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,1,0,0		;	10,11,12(,13,14)

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

L::					; mark end of D60JSY with short symbol

	XLIST				; Suppress listing of literals
	LIT
	LIST

TOPS20<
D60PAT:	BLOCK	^D511			; force locals to another page
	>
	SUBTTL	Data area - local to fork

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

POLEST:: 0				; estimated optimal time for next poll

HNDLST:: 0				; local handle list
HNDSTS:: BLOCK 1			;[311] Handle status word (H$STS)
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
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.

TOPS20 <
FEJFN:	0				; JFN of the front end device FEn:
LSTDTE: 0				; Last DTE that was selected

RCVHDR:: BLOCK	2			; Receive header
XMTHDR:: BLOCK	D6HWSZ			; Transmit header

XMSG:	BLOCK	^o274/4+1		; DDCMP Q flush buffer
RETRY:	BLOCK	1			; BOOT retry counter
PUTARG:					; TOPS-20 version 5 BOOT arg bloc
BTARG:	BLOCK	BT6SIZ			; BOOT JSYS argument block
RDSAVE: BLOCK	1			; Save area for RD2020 arguments
RDSLEN: BLOCK	1			;  including the length

PROARG:	BLOCK	2			; arg block for .BTSTS
SONFD:	6,,0				; Max words in file name
	BLOCK	5			; Buffer for file descriptor
>

STSBUF::BLOCK	<STSMAX+3>/4		; Status buffer for port,line or device
					;  status strings (8 bit bytes).

SONOPB:					; open block for signon device
	.OPSGN,,0			; dev,,unit
	0				; port,,line - inserted
	0				; line signature - inserted

					; SYSERR logging data
LPAGE:	BLOCK	1			; Address of logging page

SONBUF: BLOCK	^D80/5			; Buffer to read RJE string into
	EXP	0			; this will be an asciz string

ENDLOC==.-1				; end of data  local to a fork

	END


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