Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 7/monitor/io.mac
There are 60 other files named io.mac in the archive. Click here to see a list.
; UPD ID= 8527, RIP:<7.MONITOR>IO.MAC.4,   9-Feb-88 16:15:13 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 60, RIP:<7.MONITOR>IO.MAC.3,   4-Aug-87 14:23:22 by RASPUZZI
;TCO 7.1032 - Fix problem in edit 7391. It was changing a MONX02 error
;to a IOX5 error.
; *** Edit 7391 to IO.MAC by JROSSELL on 14-Nov-86, for SPR #21291
; Return the correct error (IOX7) when a SOUTR% fails due to insufficient JSB
; free space.
; *** Edit 7321 to IO.MAC by WONG on 17-Jun-86, for SPR #20898 (TCO none)
; Rewrite .SFPTR JSYS to include LSN in its calculation of the byte count if
; bit SF%LSN is on.
; *** Edit 7319 to IO.MAC by PRATT on 11-Jun-86
; Comment out edit 7317 (possibly only temporarily). The fix is fine, but
; fixing the bug could potentially cause serious problems with user programs
; depending on the bug. 
; *** Edit 7317 to IO.MAC by PRATT on 11-Jun-86, for SPR #87
; Don't output a null byte if user specified positive number in AC 3 to SOUT.
; Edit 7133 to IO.MAC by LOMARTIRE on 15-Aug-85, for SPR #17490 (TCO 6-1-1523)
; Prevent DIRDNL and ULKSTZ BUGCHKs at GETFPD 
; UPD ID= 2084, SNARK:<6.1.MONITOR>IO.MAC.27,   3-Jun-85 14:44:01 by MCCOLLUM
;TCO 6.1.1406  - Update copyright notice.
; UPD ID= 1996, SNARK:<6.1.MONITOR>IO.MAC.26,  21-May-85 16:51:05 by MCCOLLUM
;More of TCO 6.2194 - Add for ERJMPRs in .ESOUT
; UPD ID= 1900, SNARK:<6.1.MONITOR>IO.MAC.25,   4-May-85 16:08:40 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1825, SNARK:<6.1.MONITOR>IO.MAC.24,  25-Apr-85 16:30:18 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 4906, SNARK:<6.MONITOR>IO.MAC.23,  10-Oct-84 04:48:41 by TBOYLE
;TCO 6.2240 (QAR 706228) Teach APPNUL to check for 7-bit OWGBPs.
; UPD ID= 4810, SNARK:<6.MONITOR>IO.MAC.22,  17-Sep-84 10:01:30 by PURRETTA
;Update copyright notice
; UPD ID= 4745, SNARK:<6.MONITOR>IO.MAC.19,  24-Aug-84 11:18:16 by HAUDEL
;TCO 6.2194 - Add ERJMPRs in the .ESOUT code after the DOBE and RFPOS.
; UPD ID= 2639, SNARK:<6.MONITOR>IO.MAC.18,  27-Jun-83 16:19:07 by CHALL
;TCO 6.1673 CHKJFN- Handle signal JFN specially
; UPD ID= 1841, SNARK:<6.MONITOR>IO.MAC.17,  20-Feb-83 22:17:23 by MURPHY
;TCO 6.1514 - Use ITERX instead of JRST ITRAP.
; UPD ID= 1822, SNARK:<6.MONITOR>IO.MAC.16,  18-Feb-83 09:03:03 by MCINTEE
;TYPO IN BYTBLT ONE WORD GLOBAL LOGIC
; UPD ID= 1599, SNARK:<6.MONITOR>IO.MAC.15,  29-Dec-82 13:33:06 by DONAHUE
;TCO 6.1414 - Set a flag in TRPDSP when leaving BYTBLT
; UPD ID= 1595, SNARK:<6.MONITOR>IO.MAC.14,  29-Dec-82 10:36:45 by DONAHUE
;TCO 6.1173 - Add ERJMP after IDPB in SIN
; UPD ID= 1450, SNARK:<6.MONITOR>IO.MAC.13,  16-Nov-82 15:25:17 by PAETZOLD
;TCO 6.1378 - Convert universal TTY designators to the .TTDES form in CHKJFN
; UPD ID= 1376, SNARK:<6.MONITOR>IO.MAC.12,  25-Oct-82 11:55:26 by DONAHUE
;TCO 6.1318 - Prevent ILMNRF near SINW with ERJMP
; UPD ID= 1320, SNARK:<6.MONITOR>IO.MAC.11,  10-Oct-82 14:35:43 by PAETZOLD
;More TCO 6.1226 - Use index registers in FILNO references
; UPD ID= 1294, SNARK:<6.MONITOR>IO.MAC.10,   7-Oct-82 14:13:22 by MCINTEE
;TCO 6.1030 - MAKE BYTINB GLOBAL SO OTHER DEVICE ROUTINES CAN USE IT
; UPD ID= 1177, SNARK:<6.MONITOR>IO.MAC.9,  14-Sep-82 11:07:02 by MCINTEE
;More TCO 6.1226 - set SINRF before calling BYTINS in SIN1
; UPD ID= 1152, SNARK:<6.MONITOR>IO.MAC.8,   7-Sep-82 13:17:03 by MCINTEE
;More TCO 6.1226 - no skipping at end of IFSKP. clauses
; UPD ID= 1084, SNARK:<6.MONITOR>IO.MAC.7,  16-Aug-82 08:33:07 by GRANT
;TCO 6.1226 - add tests for new asynchronous output flag FILNO
; UPD ID= 858, SNARK:<6.MONITOR>IO.MAC.6,   7-Jun-82 09:38:51 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 783, SNARK:<6.MONITOR>IO.MAC.5,  25-May-82 12:32:45 by MCINTEE
;Fix up BYTBLT
; UPD ID= 759, SNARK:<6.MONITOR>IO.MAC.4,  18-May-82 14:18:16 by MCINTEE
;More TCO 6.1030 - The DAP% jsys needs 8 bit byte string packing &
;  unpacking (XFER8 & XFER36). Also add OWGBP intelligence to BYTBLT.
;  and a jacket routine for BYTBLT that preserves Q1 & Q2.
;  and make BBLTxx global symbols
; UPD ID= 272, SNARK:<6.MONITOR>IO.MAC.3,   5-Jan-82 09:03:20 by GRANT
;TCO 5.1649 - Add NSP null message checking
;<6.MONITOR>IO.MAC.2, 16-Oct-81 18:01:57, EDIT BY MURPHY
;TCO 6.1030 - Node names in filespecs; etc.
;Revise DTB format; get rid of double skips on NLUKD, etc.
; UPD ID= 176, SNARK:<5.MONITOR>IO.MAC.11,  15-Sep-81 11:51:51 by MOSER
;TCO 5.1511 MOVE CODE FROM 5.1499 TO IO FROM DEVICE.
; UPD ID= 140, SNARK:<5.MONITOR>IO.MAC.10,   2-Sep-81 16:56:39 by MOSER
;TCO 5.1485 - Reference byte before going NOINT for a SIN/SINR.
; UPD ID= 125, SNARK:<5.MONITOR>IO.MAC.9,  27-Aug-81 20:15:25 by PAETZOLD
;Change TCO 5.1008X to 5.1471
; UPD ID= 114, SNARK:<5.MONITOR>IO.MAC.8,  22-Aug-81 16:09:27 by PAETZOLD
;TCO 5.1008X - Fix CHKJFN and BYTBLT for OWGBP's
; UPD ID= 92, SNARK:<5.MONITOR>IO.MAC.7,   6-Aug-81 13:58:46 by SCHMITT
;More of TCO 5.1300 - do an ILDB on pointer to avoid NonExist Ref.
; UPD ID= 1893, SNARK:<5.MONITOR>IO.MAC.6,  27-Apr-81 17:16:03 by SCHMITT
;TCO 5.1300 - Attempt to load byte before going NOINT
; UPD ID= 1524, SNARK:<5.MONITOR>IO.MAC.5,   6-Feb-81 12:46:56 by ZIMA
;TCO 5.1258 - remove historical code.
; UPD ID= 708, SNARK:<5.MONITOR>IO.MAC.4,  26-Jun-80 15:48:07 by ZIMA
;TCO 5.1084 - HAVE MEMORY TO MEMORY SIN CHECK FOR AC3 ZERO PROPERLY
; UPD ID= 655, SNARK:<5.MONITOR>IO.MAC.3,  16-Jun-80 17:00:17 by OSMAN
;tco 5.1050 - Make jfn on TTY: use fork's controlling terminal
; UPD ID= 437, SNARK:<5.MONITOR>IO.MAC.2,  13-Apr-80 15:13:30 by OSMAN
; UPD ID= 429, SNARK:<4.1.MONITOR>IO.MAC.277,  13-Apr-80 14:35:01 by OSMAN
;Reference FRKTTY instead of FKCTYP
; UPD ID= 19, SNARK:<4.1.MONITOR>IO.MAC.276,  27-Nov-79 13:25:03 by SCHMITT
;TCO 4.1.1030 - SET PASLSN IF FILE LENGTH IS LESS THAN FIVE BYTES
;<4.1.MONITOR>IO.MAC.275,  6-Nov-79 10:08:25, EDIT BY DBELL
;TCO 4.2564 - CHANGE MJFN TO RJFN AT CHKJFT
;<4.MONITOR>IO.MAC.274, 24-Oct-79 12:50:58, EDIT BY MURPHY
;UNLDIS - ITRAP IF WAIT ROUTINE ADDRESS IS 0
;<4.MONITOR>IO.MAC.273, 24-Oct-79 12:22:03, EDIT BY MURPHY
;TRPDSP IN BYTBLT
;<4.MONITOR>IO.MAC.271,  5-Oct-79 16:02:03, EDIT BY MILLER
;TCO 4.2511. DON'T DIDDLE PC IN UNLDIS FOR OVER QUOTA ERROR
;<4.MONITOR>IO.MAC.270,  4-Oct-79 14:13:44, EDIT BY OSMAN
;more 4.2256 - Don't put spurious crlf's when reading from tape to memory
;<4.MONITOR>IO.MAC.269, 19-Sep-79 09:30:36, EDIT BY OSMAN
;more 4.2256 - Prevent nulls in files copied from tape to disk
;<OSMAN.MON>IO.MAC.1, 10-Sep-79 15:35:00, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>IO.MAC.267, 20-Aug-79 13:39:44, EDIT BY DBELL
;CHECK ACRLFF FLAG BEFORE INDEXING BY JFN IN BYTINX
;<4.MONITOR>IO.MAC.266, 27-Jul-79 15:48:17, EDIT BY ENGEL
;RETURN VALID JFN (MULITPLIED BY MLJFN) FOR ALL DESX3'S
;<4.MONITOR>IO.MAC.265, 27-Jul-79 13:48:57, EDIT BY HALL
;FIX BYTBLT TO HANDLE INDEXED BYTE POINTERS
;<4.MONITOR>IO.MAC.264, 25-Jul-79 15:12:48, EDIT BY R.ACE
;TCO 4.2345 - FIX BYTBLT WITH INDEXED BYTE POINTER
;<4.MONITOR>IO.MAC.263, 24-Jul-79 08:26:45, EDIT BY OSMAN
;MORE 4.2256 - If count used up, don't attempt crlf sequence
;<4.MONITOR>IO.MAC.262, 30-Jun-79 20:24:41, EDIT BY DBELL
;TCO 4.2318 - HAVE CHKJFN USE FORK'S CONTROLLING TERMINAL FOR 777777
;<4.MONITOR>IO.MAC.261, 19-Jun-79 08:43:51, EDIT BY MILLER
;<4.MONITOR>IO.MAC.260, 19-Jun-79 08:38:56, EDIT BY MILLER
;MAKE SIN1 MORE EFFICIENT
;<4.MONITOR>IO.MAC.259, 17-Jun-79 11:40:29, EDIT BY MILLER
;MORE DIDDLES FOR ADDING CR-LF
;<4.MONITOR>IO.MAC.258, 16-Jun-79 14:24:54, EDIT BY MILLER
;MORE FIXES FOR CR-LF CODE. MAYBE IT WILL WORK NOW
;RANDOM AND SCATTERED FIXES FOR NEW CR-LF CODE
;In BYTBLT, use DCRNXT, DLFNXT instead of  CRNXT, LFNXT
;<4.MONITOR>IO.MAC.257, 12-Jun-79 18:18:31, EDIT BY MILLER
;RANDOM FIXES FOR HANDLING 0 AND 1 BYTE RECORDS
;<4.MONITOR>IO.MAC.256,  6-Jun-79 09:22:22, EDIT BY OSMAN
;tco 4.2256 - give crlf's at end-of-record for appropriate tapes
;<4.MONITOR>IO.MAC.255, 28-Mar-79 12:40:25, Edit by LCAMPBELL
; Better error code from CHKJFN when large (but potentially legal) JFN given
;<4.MONITOR>IO.MAC.254,  4-Mar-79 17:29:14, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>IO.MAC.253,  2-Feb-79 13:41:42, EDIT BY MILLER
;FIXES TO RECORD PROCESSING
;<4.MONITOR>IO.MAC.252, 20-Jan-79 14:42:45, EDIT BY MILLER
;ADD RECF CODE SO CAN RETURN A NULL RECORD
;<4.MONITOR>IO.MAC.251,  9-Jan-79 11:40:59, EDIT BY MILLER
;IF CALL TO RECOUT FAILS, DO FILABT INSTEAD OF JRST EMRET0
;<4.MONITOR>IO.MAC.250,  6-Jan-79 13:03:55, EDIT BY MILLER
;CHECK FOR EOFF AT DUMPIW
;<4.MONITOR>IO.MAC.249, 10-Dec-78 15:10:27, EDIT BY MILLER
;<4.MONITOR>IO.MAC.248,  8-Dec-78 17:25:21, EDIT BY MILLER
;ADD HLDF TEST TO UNLDIS. REMOVE SPECIAL TESTS FOR FE AND CDR
;<4.MONITOR>IO.MAC.247,  8-Dec-78 16:58:37, EDIT BY MILLER
;CHECK FOR CDBBLK AT UNLDSN AND HOLD PROCESS IN BALSET IF SO
;<4.MONITOR>IO.MAC.246, 13-Nov-78 11:22:36, EDIT BY MILLER
;PASS BLOCK PARAMETERS TO "RECORD OUT" ROUTINE
;<2MCLEAN>IO.MAC.245, 10-Oct-78 23:58:34, Edit by MCLEAN
;<2MCLEAN>IO.MAC.244,  3-Oct-78 00:13:14, Edit by MCLEAN
;<4.MONITOR>IO.MAC.244,  4-Oct-78 16:37:08, EDIT BY GILBERT
;More TCO 4.2008 - fix an editing error.
;<4.MONITOR>IO.MAC.243,  2-Oct-78 23:03:21, Edit by MCLEAN
;REMOVE CALL TO APPNUL FROM SOUTB (YOU CAN'T GET THERE WITH JFN
;BEING A STRING POINTER) ALSO OTHER SPEEDUPS.
;<4.MONITOR>IO.MAC.242, 14-Sep-78 20:55:48, EDIT BY GILBERT
;TCO 4.2008 - Make ESOUT JSYS skip CRLF if already at beginning of line.
;<4.MONITOR>IO.MAC.241, 10-Aug-78 01:12:12, Edit by MCLEAN
;FIX CO-ROUTINES TO CHECK FOR CHANGE IN JFN
;<4.MONITOR>IO.MAC.240, 10-Aug-78 01:11:47, Edit by MCLEAN
;<4.MONITOR>IO.MAC.239, 21-Jul-78 11:24:24, EDIT BY MILLER
;FIX TYPEO IN UNLDIS
;<4.MONITOR>IO.MAC.238, 21-Jul-78 08:49:22, EDIT BY MILLER
;REPLACE PSOUT IN ESOUT WITH IMCALL
;<4.MONITOR>IO.MAC.237, 20-Jul-78 14:31:20, EDIT BY MILLER
;FIX ESOUT TO DO PSOUT INTEAD OF JUMPING INTO JSYS
;<4.MONITOR>IO.MAC.236,  7-Jul-78 09:19:41, EDIT BY MILLER
;ADD SOME COMMENTS TO DMOCHK
;<4.MONITOR>IO.MAC.235,  7-Jul-78 09:15:48, EDIT BY MILLER
;USE ULKSTR TO UNLOCK STRUCTURES
;<4.MONITOR>IO.MAC.234, 29-Jun-78 11:25:21, EDIT BY MILLER
;MAKE SURE STRDMO IS NOINT WHEN IT HAS STRLOK LOCKED
;<4.MONITOR>IO.MAC.233, 22-Jun-78 14:41:46, EDIT BY MILLER
;REMOVE NOSKEDS THAT PROTECTED SDBS. USE "LOCK STRLOK"
;<4.MONITOR>IO.MAC.232,  3-Jun-78 20:24:36, Edit by JBORCHEK
;REMOVE DMPBUF TO STG
;<4.MONITOR>IO.MAC.231,  9-Mar-78 08:54:31, EDIT BY MILLER
;DON'T BACK UP PC ON QUOTA EXCEEDED IF ALREADY DONE
;<4.MONITOR>IO.MAC.230,  8-Mar-78 16:39:41, EDIT BY MILLER
;JUMP TO EMRET0 AT UNLDS1 IF ERRF SET
;<4.MONITOR>IO.MAC.229,  2-Mar-78 12:47:36, EDIT BY MILLER
;FIX NEW SINR CODE NOT TO CLOBBER A
;<3A.MONITOR>IO.MAC.4,  2-Mar-78 09:27:43, EDIT BY MILLER
;MORE FIXES FOR SINR RUNNING OUT
;<4.MONITOR>IO.MAC.227,  2-Mar-78 08:13:13, EDIT BY MILLER
;SINR CODE MUST INSURE ALL OF RECORD IS IN BEFORE ABORTING
;<4.MONITOR>IO.MAC.226, 27-Feb-78 17:15:50, EDIT BY MILLER
;REMOVE CODE FROM UNLDIS THAT CHECKS FOR JSYS. DIDN'T WORK
;<4.MONITOR>IO.MAC.225, 27-Feb-78 14:26:26, Edit by BORCHEK
;fix dumpo doing goto words wrong at dumpo4+2
;<4.MONITOR>IO.MAC.224, 18-Feb-78 16:04:38, EDIT BY MILLER
;MORE FIXES. DON'T DIDDLE PC IF PREVIOUS-CONTEXT IS MONITOR
;<4.MONITOR>IO.MAC.223, 18-Feb-78 15:39:59, EDIT BY MILLER
;FIX UNLDIS TO NOT BACK UP PC ON QUOTA ERROR IF ALREADY BACKED-UP
;<4.MONITOR>IO.MAC.222, 31-Jan-78 12:29:38, Edit by HALL
;ADDED ATSMOV
;<4.MONITOR>IO.MAC.221, 28-Jan-78 23:24:19, Edit by PORCHER
;Fix bugs in CREADF
;<4.MONITOR>IO.MAC.220, 28-Jan-78 14:46:17, EDIT BY PORCHER
;Combine TRVAR and STKVAR in SINR
;<4.MONITOR>IO.MAC.219, 27-Jan-78 09:54:58, EDIT BY PORCHER
;Add routines SREADF and CREADF for Execute-Only
;Also change CHKJFN to restrict access to single process

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

	SEARCH PROLOG
	TTITLE IO
	SWAPCD

;SPECIAL AC DEFINITIONS USED HEREIN

DEFAC (STS,P1)		;SEE GTJFN FOR FUNCTIONS
DEFAC (JFN,P2)
DEFAC (DEV,P4)

;BYTBLT COMMUNICATION REGISTER FLAGS:
MSKSTR(XFR2TM,D,1B0)		;TRANSFER STRING TO TERMINATOR (TURNED OFF
				;  WHEN TERMINATOR READ)
MSKSTR(XFRTRM,D,1B1)		;TRANSFER TERMINATOR
MSKSTR(STRSRC,D,1B2)		;SOURCE BYTE POINTER IS A STRING
;---------
MSKSTR(FLINPT,D,1B3)		;ON WHEN DOING SIN FROM FILE
MSKSTR(BBDONE,D,1B4)		;SET WHEN BYTBLT IS DONE TO EXIT SIN/SOUT LOOPS
MSKSTR(XFRLSN,D,1B5)		;SET FOR BYTBLT TO COPY LINE NUMBERS
;---------
MSKSTR(DISCRD,D,1B6)		;SET BY BYTBLT TO HAVE CALLER DISCARD THE
				; TAB AFTER A LINE NUMBER.
MSKSTR(FEEDME,D,1B7)		;SET BY BYTBLT WHEN SOURCE STRING RUNS OUT WHILE
				; WHILE SCANNING LINE NUMBERS OR NULLS
;---------
	;NOTE:	KEEP THESE TOGETHER.  SEE REFS TO CRSTUF AND DCRSTF
MSKSTR(DCRNXT,D,1B8)		;TELL BYTBLT TO DELIVER A CARRIAGE RETURN NEXT
MSKSTR(DLFNXT,D,1B9)		;LINEFEED NEXT
MSKSTR(DFRSTF,D,1B10)		;THIS RECORD HAS BEEN FROSTED ALREADY
	MSKSTR(DCRSTF,D,DCRNXT!DLFNXT!DFRSTF)	;COMPOSITE CR STUFF FIELD

BBLTMM==:0			;DATA DIRECTIONS - BYTBLT MON TO MON
BBLTMU==:1			;MONITOR TO USER
BBLTUM==:2			;USER TO MONITOR
BBLTUU==:3			;USER TO USER

DEFINE FILINT(N,EXTRA)<
	CALL [EXTRA
		MOVEI A,N
		JRST DOINT]>

DEFINE FILABT(N,EXTRA)<
	JRST [	EXTRA
		MOVEI A,N
		JRST ABTDO]>
DOINT:	MOVEM JFN,ERRSAV
	MOVEM A,LSTERR
	TQNE <HLTF>
	JRST ABTDO		;Halt on these conditions
	MOVE T1,MPP		;GET BASE LEVEL PUSH DOWN LIST
	MOVE T2,-1(T1)		;GET PC
	MOVE T1,(T1)		;GET ADR OF JSYS+1(FLAGS)
	CALL CHKERT		;IS THERE AN ERJMP OR ERCAL AFTER JSYS?
	 SKIPA T1,BITS+.ICDAE	;NO, GO DO INTERRUPT
	RET			;YES, DONT CAUSE INTERRUPT
	CALL IICSLF		;INTERRUPT THIS FORK
	RET

ABTDO:	MOVEM A,LSTERR
	CALL UNLCKF
	ITERR()

	RESCD

SK3RET::AOS (P)
SK2RET::AOS (P)
	AOS (P)
CPOPJ::	RET

SKPUNL:: AOS -1(P)
UNL::	CALL UNLCKF
	JRST MRETN

	SWAPCD
;CHECK STATUS OF JFN OR OTHER DESIGNATOR
; T1/ DESIGNATOR
;	CALL CHKJFA
; RETURN +1 FAILURE, BAD DESIGNATOR.  T1/ ERROR CODE
; RETURN +2 SUCCESS,
;  T1/ DESIGNATOR TYPE CODE
;	0 (JF%FIL) - A REGULAR JFN
;	1 (JF%TTY) - A TTY DESIGNATOR
;	2 (JF%BYP) - A BYTE POINTER OR NULL
;  T2/ THE CURRENT FILE STATUS
;  T3/ UNIT NUMBER,,DEVICE DISPATCH TABLE ADDRESS
;  T4/ JFN INDEX

;THIS IS MERELY A JACKET ROUTINE FOR CHKJFN WHICH FOLLOWS
;THE STANDARD SUBROUTINE CONVENTIONS.
; ***N.B.*** THIS DOES NOT LEAVE THE JFN LOCKED NOR GO NOINT.

;CODES

JF%FIL==:0			;FILE
JF%TTY==:1			;TTY DESIGNATOR
JF%BYP==:2			;BYTE POINTER

CHKJFA::SAVEP
	MOVE JFN,T1		;SETUP THE JFN
	CALL CHKJFN		;DO THE WORK
	 RETBAD ()		;BAD DESIGNATOR
	 JRST [	MOVX T1,JF%TTY	;A TTY
		JRST CHKJA1]
	 JRST [	MOVX T1,JF%BYP	;A BYTE POINTER
		JRST CHKJA1]
	CALL UNLCKF		;REGULAR JFN, UNLOCK IT
	MOVX T1,JF%FIL		;REGULAR JFN
CHKJA1:	MOVE T2,STS		;RETURN STATUS
	MOVE T3,DEV		;AND DEVICE
	MOVE T4,JFN		;AND INDEX
	RETSKP
; Check tenex source/destination designator
; Call:	JFN		;The designator
;	CALL CHKJFN
; Return
;	+1	;Error, A has error #
;	+2	;Tty
;	+3	;Byte pointer OR NULL
;	+4	;File - REAL JFN
; In all cases, the following is set up
;	LH(DEV)	;Unit number
;	RH(DEV)	;Loc of device dispatch table
;	P3	;RH OF DEV
;	JFN	;True jfn for files, byte pointer for same
;	STS	;File status bits
;	DOES NOT CLOBBER B AND C
; The file is locked if it is a file

; If previous context section (PCS) is zero OWGBPs will not be allowed
; as designators.  Non-skip return will result.
;
; If PCS is non-zero then OWGBPs will be allowed.  The UDX form of TTY
; designator will not be allowed from a non-zero PCS.  The .TTDES form
; of TTY designator is allowed from non-zero PCS

CHKJFD::TDZA D,D		;REMEMBER TO SKIP DISMOUNTED CHECK
CHKJFN::SETO D,			;CHECK FOR DISMOUNTED STRUCTURE
	MOVE T1,JFN		;COPY JFN SO JRST CHKJFN WINS FOR .SIGIO
	CAIN T1,.PRIIN		;PRIMARY INPUT?
	HLRZ T1,PRIMRY		;YES. GET INPUT JFN
	CAIN T1,.PRIOU		;PRIMARY OUTPUT?
	HRRZ T1,PRIMRY		;YES. GET OUTPUT JFN
	CAIN T1,.SIGIO		;SIGNAL JFN?
	JRST CHKJFX		;YES, HANDLE IT
	MOVE JFN,T1		;UPDATE JFN IN CASE OR PRIMARY IO
	SKIPLE JFN		;IS THIS A REAL JFN
	CAML JFN,MAXJFN		;...
	JRST CHKJFS		;NO, GO CHECK FOR OTHER LEGAL JFN FORMS
	IMULI JFN,MLJFN		;GET INDEX NTO JFN TABLES
	NOINT
	AOSE FILLCK(JFN)	;LOCK THE JFN LOCK
	JRST [	OKINT		;FAILED
		JRST CHKJ3A]	;GO WAIT FOR THE LOCK TO FREE UP
	MOVE STS,FILSTS(JFN)	;SET UP THE REQUIRED ACS
	TQNE <FRKF>		;NO ACCESS BY OTHER FORKS?
	JRST CHKJ2B		;YES, GO CHECK IF ACCESS IS LEGAL
	MOVE DEV,FILDEV(JFN)	;SET UP DEV
	HRRZ P3,DEV		;AND P3
	CAIE P3,DSKDTB		;IS THIS A DISK?
	JRST CHKJ2A		;NO, GO CHECK OTHER SPECIAL CASES
	LOCK STRLOK		;PREVENT DISMOUNTING
	LOAD A,FLUC,(JFN)	;GET STR UNIQUE CODE
	LOAD P5,STR,(JFN)	;GET STR NUMBER
	SKIPN P5,STRTAB(P5)	;GET THE SDB ADDRESS
	JRST [	UNLOCK STRLOK	;DISMOUNTED
		SETZB F,P5
		JUMPE D,SK3RET	;IF DONT CARE, EXIT OK
		JRST CHKJDM]	;OTHERWISE, GO RETURN FAILURE
	LOAD CX,STRUC,(P5)	;GET UNIQUE CODE FOR THIS STR
	CAME A,CX		;DO THEY MATCH?
	JRST [	UNLOCK STRLOK	;NO
		SETZB F,P5
		JUMPE D,SK3RET	;IF DONT CARE, EXIT OK
		JRST CHKJDM]	;OTHERWISE, GO RETURN FAILURE
	INCR STRLK,(P5)		;LOCK THE STR LOCK
	NOINT			;LEAVE THIS PROCESS NOINTED
	UNLOCK STRLOK		;ALLOW DISMOUNTS NOW
	SETZB F,P5
	JRST SK3RET		;ALL DONE
CHKJFS:	SETZB F,P5
	TLNE JFN,777777		;Lh zero?
	JRST CHKJF1		;No, some kind of byte pointer
	CAIN JFN,777777		;Controlling tty
	JRST CHKJF4		;Yes
	CAIN JFN,377777		;Nil designator
	 JRST CHKJFW		;Yes.
CHKJFT:	CAIGE JFN,400000+NLINES	;Valid tty designator?
	CAIGE JFN,400000
	JRST [	JUMPLE JFN,CHKJF7	;REJECT NONPOSITIVE VALUES
		IMULI JFN,MLJFN		;CONVERT TO REAL JFN
		CAIL JFN,RJFN		;COULD THIS EVER BE A JFN?
		JRST CHKJF7		;no, give invalid s/d designator return
		MOVEI A,DESX3		;yes, give JFN not assigned return
		RET]			; ..
	PUSH P,C		;CAN'T CLOBBER C
	PUSH P,B		; OR B
	MOVEI B,-.TTDES(JFN)	;B/ LINE NUMBER
	CALL GTCJOB		;GET CONTROLLING JOB
	 JRST [	POP P,B		;NONE. RESTORE B
		POP P,C		; AND C
		JRST CHKJF5]	;OK TO USE
	POP P,B			;RESTORE B
	CAIE C,-1		;ASSIGNED TO ANY JOB?
	CAMN C,JOBNO		;YES. assigned to this job?
	 JRST [	POP P,C		;OK TO USE
		JRST CHKJF5]
	POP P,C
	MOVE A,CAPENB
	TRNE A,SC%WHL!SC%OPR
	JRST CHKJF5
	MOVEI A,-400000(JFN)
	CALL PTCHKA		;TEST FOR PTY OWNER
	JUMPN A,CHKJF5		;TRUE = OK BECAUSE CONTROLLED BY PTY
	MOVEI A,DESX2		;Illegal tty designator
	RET

CHKJF5:	MOVEI DEV,TTYDTB	;SET DEVICE TO BE TTY
	HRLI DEV,-400000(JFN)	;AND SPECIFIED UNIT
	JRST CHKJT1
CHKJF4:	HRRZ A,FORKN		;GET OUR JOB FORK NUMBER
	LOAD JFN,FRKTTY,(A)	;GET FORK'S CONTROLLING TERMINAL
	CAIE JFN,-1		;ONE SPECIFIED?
	JRST CHKJFT		;YES, GO CHECK IT
	MOVE A,JOBNO		;NO, THEN USE JOB'S CONTROLLING TERMINAL
	HLLZ DEV,JOBPT(A)	;GET IT
	HRRI DEV,TTYDTB		;SET DEVICE TO BE TTY
CHKJT1:	MOVX STS,READF!WRTF!OPNF!PASLSN
	HRRZ P3,DEV
	RETSKP			;Skip return

CHKJFW:	MOVEI DEV,NILDTB
	HRRZ P3,DEV
	MOVX STS,READF!WRTF!OPNF!PASLSN
	JRST SK2RET

CHKJFX:	PUSH P,T2		;SAVE OLD T2
	CALL FKTMI		;TELL SUPERIOR FORK
	MOVX T1,FRZB1%		;SET INTERRUPT STATUS TO FROZEN
	MOVE T2,FORKX
	IORM T1,FKINT(T2)
	SETZM PIOLDS		;CLEAR OLD STATE
	HRROI T1,FRZWT		;SET UP SCHED TEST
	MDISMS			;WAIT UNTIL SUPERIOR CONTINUES
	POP P,T2
	JRST CHKJFN		;GO TRY AGAIN WHEN CONTINUED

;CHKJF3:	JUMPE JFN,CHKJFB	;0 NEVER EXISTS
;	IMULI JFN,MLJFN
CHKJ3A:	MOVEI A,^D60		;Try 60 times to lock file
CHKJF2:	SOJL A,CHKJFB		;Then fail
	NOINT
	AOSE FILLCK(JFN)
	 JRST [	OKINT
		PUSH P,A
		MOVEI A,^D1000
		DISMS
		POP P,A
		JRST CHKJF2]
CHKJ2A:	MOVE STS,FILSTS(JFN)
	TQNN <NAMEF>
	JRST CHKJF8
	TQNN <FRKF>		;Test for file restricted to one fork
	JRST CHKJF9
CHKJ2B:	HLRZ A,FILVER(JFN)
REPEAT 0,< ;Restricted-access now means just the current process
	PUSH P,D		;SAVE ENTRY FLAG
	CALL SKIIF		;OWNER INFERIOR TO THIS FORK?
	 JRST CHKJF8		;NO, ACCESS ILLEGAL
	POP P,D			;RESTORE ENTRY FLAG
> ;End of REPEAT 0
	CAME A,FORKN		;This owning process?
	 JRST CHKJF8		;No, access illegal
CHKJF9:	MOVE DEV,FILDEV(JFN)	;Set up dev
	HRRZ P3,DEV
	SETZB F,P5
	CAIN P3,TTYDTB		;IS THIS A TERMINAL?
	JRST [	HLRZ A,FILDDN(JFN)	;YES, GET ADDRESS OF DEVICE NAME BLOCK
		MOVE A,1(A)	;GET NAME
		TRZ A,377	;FLUSH POSSIBLE GARBAGE
		CAME A,[ASCIZ /TTY/]	;IS DEVICE "TTY"?
		JRST .+1	;NO, SO DEV IS CORRECT ALREADY
		MOVE A,FORKN	;YES, GET FORK NUMBER
		LOAD A,FRKTTY,(A)	;GET POSSIBLE FORK'S CONTROLLING TERMINAL
		HRLI DEV,-.TTDES(A)	;SET UP UNIT NUMBER
		CAIN A,-1	;IS THERE REALLY A FORK CONTROLLING TERMINAL?
		HRL DEV,CTRLTT	;NO, SO USE JOB'S CONTROLLING TERMINAL
		JRST .+1]
	CAIE P3,PTYDTB
	CAIN P3,TTYDTB
	 JRST [	SETOM FILLCK(JFN)
		OKINT
		JRST .+1]
	MOVEI A,0(JFN)		;GET THE JFN
	PUSH P,D		;SAVE ENTRY FLAG
	CALL STRDMO		;CHECK IF DISMOUNTED AND BUMP LOCK
	 JRST [	POP P,D		;GET BACK ENTRY CODE
		JUMPE D,SK3RET	;IF DONT CARE ABOUT DISMOUNTED STRS, EXIT
		JRST CHKJDM]	;OTHERWISE, GIVE FAILURE RETURN
	POP P,(P)		;CLEAN UP THE STACK
	JRST SK3RET		;Triple skip return


CHKJDM:	UNLOCK FILLCK(JFN)	;CLEAN UP
	OKINT
	RETBAD (DESX10)		;AND GIVE DISMOUNTED ERROR RETURN
CHKJF8:	UNLOCK FILLCK(JFN)
	OKINT
CHKJFB:	MOVEI A,DESX3
	RET

CHKJF1:	JUMPGE JFN,CHKJF6
	HLRZ A,JFN		;GET LEFT HALF
	CALL SPCSNZ		;DID JSYS COME FROM A NON-ZERO SECTION?
	 CAIE A,600000+.DVTTY	;NO...CHECK THIS FORM OF TTY DESIGNATOR?
	  JRST CHKJF0		;FROM A NONZERO SECTION OR NOT A TTY UDX
	PUSH P,JFN		;YES, GAVE TTY DEVICE DESIGNATOR
	MOVEI JFN,400000(JFN)	;CREATE TERMINAL DESIGNATOR
	CALL CHKJFT		;CHECK THIS TERMINAL
	JRST CHKBTY		;BAD TERMINAL
	JRST CHKGTY		;GOOD TERMINAL
	CAIA			;BYTE POINTER ISN'T A TERMINAL
	JFCL			;NEITHER IS A REAL JFN
CHKBTY:	POP P,JFN		;RESTORE ORIGINAL BAD DESIGNATOR
	RET			;ASSUME ERROR CODE IN A

CHKGTY:	ADJSP P,-1		;DISCARD THE UDX FORM OF DESIGNATOR
	HRRZ P3,DEV
	RETSKP

CHKJF0:	CAML JFN,[777777,,0]
	HRLI JFN,440700		;Insert if lh = 777777
	MOVX A,<770000,,0>	;ASSUME NON-ZERO PCS
	CALL SPCSNZ		;NON-ZERO PCS?
	 MOVX A,<444500,,0>	;NO...ZERO PCS...OWGBPS ILLEGAL
	CAMGE JFN,A		;BYTE POINTER IN RANGE
	 JRST CHKJF6		;YES
CHKJF7:	MOVEI A,DESX1		;Garbage designator
	RET

CHKJF6:	MOVEI DEV,STRDTB	;Set up to dispatch to string routines
	HRRZ P3,DEV
	MOVX STS,READF!WRTF!OPNF!PASLSN
	JRST SK2RET		;Double skip return
;CHECK DSK JFN - ACCEPTS ONLY JFN FOR DEVICE DSK
; JFN/ A DESIGNATOR
;	CALL DSKJFN
; RETURN +1: FAILURE, ERROR CODE IN A
; RETURN +2: SUCCESS, REGISTERS SETUP AS FOR CHKJFN

DSKJFN::CALL CHKFIL		;CHECK FOR A FILE JFN
	 RETBAD ()		;WASN'T
	TQNE <ASTF>		;RULE OUT STARS
	JRST [	MOVEI A,DESX7
		CALLRET UNLCKF]
	HRRZ B,DEV
	CAIN B,DSKDTB		;DISK?
	RETSKP			;YES
	MOVEI A,DESX8		;NO
	CALLRET UNLCKF

;CHECK FILE JFN - REJECTS TTY OR BYTE DESIGNATORS
; JFN/ A DESIGNATOR
;	CALL CHKFIL
; RETURN +1: FAILURE, ERROR CODE IN A
; RETURN +2: SUCCESS, REGISTERS SETUP AS FOR CHKJFN

CHKFIL::CALL CHKJFN
	 RETBAD()		;BAD DESIGNATOR
	 JFCL
	 RETBAD(DESX4)		;ILLEGAL DESIGNATOR
	RETSKP


;ROUTINE TO GET PROTECTION AND DIR # OF A FILE (CALLED BY CHKAC)
;ACCEPTS IN T1/	JFN
;RETURNS +1:	ERROR
;	 +2:	T1/	DIR #
;		T2/	PROT

GETFPD::SAVEPQ			;SAVE ALL PERMENANT ACS
	MOVE JFN,T1		;SET UP FOR CHKJFN
	CALL DSKJFN		;MAKE SURE IT IS A DSK JFN
	 RETBAD			;IT ISNT
	CALL GETFDB		;MAP IN FDB
	 RETBAD (,<CALL UNLCKF>);[7133] Error, unlock JFN and return
	HRRZ T2,.FBPRT(T1)	;GET PROTECTION
	LOAD T1,FLUC,(JFN)	;GET STR #
	HRLZS T1
	HRR T1,FILDDN(JFN)	;AND DIR #
	ULKDIR			;UNLOCK DIR FROM GETFDB CALL
	CALL UNLCKF		;UNLOCK THE JFN
	RETSKP			;AND RETURN
; Unlock file
; Call:	JFN	;Job file number
;	STS	;New filsts
;	CALL UNLCKF
;PRESERVES A IN CASE ERROR CODE THEREIN

UNLCKF::TLNE JFN,777777
	UMOVEM JFN,1
	SKIPLE JFN
	CAIL JFN,RJFN
	RET
	PUSH P,A
	MOVEI A,(DEV)
	CAIE A,DSKDTB		;DISK JFN?
	JRST UNLKF1		;NO
	MOVEM STS,FILSTS(JFN)	;YES, STORE STS
	LOAD A,STR,(JFN)	;GET THE STR NUMBER
	PUSH P,B		;SAVE AN AC
	SKIPN B,STRTAB(A)	;IS THIS STR STILL THERE?
	JRST UNLKF2		;NO
	LOAD B,STRUC,(B)	;GET THE UNIQUE CODE OF THE STR
	LOAD CX,FLUC,(JFN)	;GET UNIQUE CODE
	CAME CX,B		;MATCH?
	JRST UNLKF2		;NO
	CALL ULKSTR		;YES. UNLOCK THE STR LOCK
UNLKF2:	SETOM FILLCK(JFN)	;UNLOCK THE JFN
	POP P,B			;RESTORE ACS
	POP P,A
	OKINT
	RET			;ALL DONE

UNLKF1:	CAIE A,PTYDTB
	CAIN A,TTYDTB
	 JRST [	POP P,A
		CAMN DEV,FILDEV(JFN) ;IS THIS THE SAME JFN?
		MOVEM STS,FILSTS(JFN) ;YES. SAVE UPDATED STATUS THEN
		RET]
	MOVEM STS,FILSTS(JFN)	;SAVE NEW FILE STATUS BITS
	MOVEI A,0(JFN)		;GET JFN
	CALL LUNLKF		;DO UNLOCK
	POP P,A
	OKINT
	RET

NOTOPN:	FILABT CLSX1

IOERR::	ITERR ()

;ROUTINE TO UNLOCK A FILE AND IF FILE IS ON A MOUNTABLE STRUCTURE
;TO DECREMENT THE LOCK COUNT IN THE SDB.
;	ACCEPTS: 1/ JFN

LUNLKF::CALL LUNLK0		;FREE UP FILE LOCK IN SDB
	SETOM FILLCK(A)		;RELEASE LOCK
	RET			;AND DONE

;ROUTINE TO RELEASE FILE LOCK FOR A JFN.
;	1/ THE JFN

LUNLK0::SAVET			;SAVE ALL REGISTERS
	CALL DMOCHK		;CHECK IF MOUNTED
	 RET			;ITS NOT. GIVE IT UP
	JUMPE B,R		;IF NOT MOUNTABLE, GIVE IT UP
	LOAD A,STR,(A)		;IT IS. GET STR NUMBER
	CALLRET ULKSTR		;UNLOCK STRUCTURE
;ROUTINES TO CHECK IF A STRUCTURE HAS BEEN DISMOUNTED

;STRDMO: CHECK IF A STRUCTURE IS STILL MOUNTED AND IF SO
;INCREMENTS THE LOCK COUNT IN THE SDB.
;	ACCEPTS: 1/JFN
;	RETURNS: +1 IF STRUCTURE HAS BEEN DISMOUNTED
;	 	 +2 IF STRUCTURE IS STILL MOUNTED. LOCK COUNT INCREMENTED
;			OR IF NOT A MOUNTABLE STRUCTURE

STRDMO::SAVET			;SAVE ALL REGS
	NOINT			;MAKE SURE CAN'T BE INTERRUPTED
	LOCK STRLOK		;PREVENT DISMOUNTS
	CALL DMOCHK		;CHECK STRUCTURE
	 RETBAD (DESX10,<UNLOCK STRLOK
			OKINT>)	;DISMOUNTED
	JUMPE B,STRDM1		;IF NOT MOUNTABLE, JUST GO AWAY
	INCR STRLK,(B)		;STILL MOUNTED. BUMP LOCK COUNT
	NOINT			;MUST BE NOINT FOR EVERY LOCK HELD
STRDM1:	UNLOCK STRLOK		;ALLOW DISMOUNTS NOW
	OKINT			;NO LONGER HAVE THE LOCK
	RETSKP			;AND RETURN

;ROUTINE TO CHECK IF A STRUCTURE IS STILL MOUNTED.
;	ACCEPTS: 1/ JFN
;	RETURNS: +1 IF STRUCTURE HAS BEEN DISMOUNTED
;		 +2 IF STRUCTURE STILL MOUNTED
;			B= SDB INDEX
;		  OR    B=0 IF A VALID JFN ON A NON-MOUNTABLE
;			  DEVICE
;PRESERVES A

DMOCHK::LOAD C,FLUC,(A)	;GET UNIQUE CODE
	SETZ B,			;IN CASE NOT A MOUNTABLE STRUCTURE
	JUMPE C,RSKP		;IF NO UNIQUE CODE, STILL MOUNTED
	LOAD D,STR,(A)		;GET STRUCTURE NUMBER
	SKIPN B,STRTAB(D)	;GET SDB POINTER
	RET			;NONE ,STRUCTURE HAS BEEN DISMOUNTED
	LOAD D,STRUC,(B)	;GET UNIQUE CODE
	CAME D,C		;SAME?
	RET			;NO. STRUCTURE HAS BEEN DISMOUNTED
	RETSKP			;YES. STRUCTURE STILL MOUNTED
; Subroutines for Execute-Only
;
; SREADF - Set READ access and restrict access to this process
;
; Call:
;	T1/	JFN
;	CALL SREADF
;
; Returns:
;	+1:	Always
;	T2/	Previous state of FRKF and READF in LH,
;		process for FRKF in RH
; Clobbers T1
;
SREADF::
	MOVX T2,READF!FRKF	;Get desired state of bits
	HRR T2,FORKN		; and current process
;	CALLRET CREADF		;Set up bits and process
;
;
; CREADF - Reset READ access and restricted access
;	(Undo what SREADF did)
;
; Call:
;	T1/	JFN
;	T2/	Previous state of FRKF and READF in LH,
;		process for FRKF in RH
;
; Returns:
;	+1:	Always
; Clobbers T1,T2
;
CREADF::
	SAVEP			;Save all the P's
	PUSH P,F		;Also save F
	PUSH P,T2		;Save argument
	MOVE JFN,T1		;Get JFN for CHKJFN
	CALL CHKJFN		;Check out the JFN and lock it, etc.
	 JFCL			;Invalid JFN, just ignore it
	 JFCL			;Terminal
	 JRST [			;Byte pointer
		POP P,T2		;Not a file-- just return calling argument
		POP P,F			;Restore F
		RET]			;And return from CREADF/SREADF
				;Yes! we have a real file!
	MOVE T2,STS		;Get current status
	ANDX T2,<FRKF!READF>	;Clear all but restricted access and READ
	HLR T2,FILVER(JFN)	;Get process (JRFN) for restricted access
	EXCH T2,(P)		;Save current state on stack
				; and get desired state from call
	HRLM T2,FILVER(JFN)	;Set new process id
	TQZ <FRKF,READF>	;Clear current state of FRKF and READF
	HLLZ T2,T2		;Get desired state of bits
	TDO STS,T2		;Set them in STS
	POP P,T2		;Restore previous state of bits and process
	POP P,F			;Restore F
	CALLRET UNLCKF		;Unlock JFN, restore P's, and return from SREADF/CREADF
; Bin from primary io file
; Call:	1	;Character
;	PBIN

.PBIN::	MCENT
	MOVEI JFN,100
	CALL BYTIN
	 JRST EMRET0		;CHECK FOR ERJMP OR ERCAL AFTER JSYS
	UMOVEM B,1
	JRST MRETN

; Byte input jsys
; Call:	1	;Tenex source designator
;	BIN
; Return
;	+1
;	B	;A byte

.BIN::	MCENT
	NOINT
	JUMPLE 1,SLBIN
	CAIE 1,.PRIIN		;PRIMARY INPUT?
	CAIN 1,.PRIOU		;OR PRIMARY OUTPUT?
	JRST SLBIN		;YES. DO THE IT THE SLOW WAY
	CAML 1,MAXJFN		;POSSIBLY A JFN?
	JRST SLBIN
	IMULI A,MLJFN
	TQZ <NSPNUL>		;NOT A NULL NSP MESSAGE
	AOSE FILLCK(1)
	JRST SLBIN0
	CALL STRDMO		;VERIFY STRUCTURE
	 JRST SLBIN1		;BEEN DISMOUNTED
	MOVE STS,FILSTS(1)
	TQNE <ACRLFF>		;ADDING CRLF'S?
	JRST SLBIN1		;YES, DO IT THE SLOW WAY, SINCE BYTIN KNOWS HOW.
	TQC <OPNF,READF,FILINP>
	TQCN <OPNF,READF,FILINP>
	TQNE <ERRF,FRKF>
	JRST SLBIN1
BIN1:	SOSGE FILCNT(1)
	JRST SLBIN2
	AOS 2,FILBYN(1)
	CAMLE 2,FILLEN(1)
	JRST SLBIN3
	ILDB 2,FILBYT(1)
	TQNN <PASLSN>		;DOES USER WANT LINE NUMBERS?
	JRST [	JUMPE 2,BIN1	;DISCARD NULLS
		HRRZ C,FILBYT(1);GET THE WORD WE'RE READING
		MOVE C,0(C)	;DO INDIRECT
		TXNE C,1B35	;IS IT A LINE NUMBER?
		JRST SLBIN4	;YES, REDO READ VIA BYTIN
		JRST .+1]
	CALL LUNLKF		;FREE UP FILE
	UMOVEM 2,2
	JRST MRETN

SLBIN4:	MOVX C,7B5		;FIXUP BYTE POINTER WE WERE READING FROM
	ADDM C,FILBYT(1)	;  SO THAT BYTIN WORKS RIGHT
SLBIN3:	SOS FILBYN(1)
SLBIN2:	AOS FILCNT(1)
SLBIN1:	CALL LUNLKF		;FREE UP FILE
SLBIN0:	IDIVI 1,MLJFN
SLBIN:	OKINT
	MOVE JFN,1
	CALL BYTIN		;Read the byte
	 JRST [	XCTU [SETZM 2]	;RETURN A ZERO IN 2
		JRST EMRET0]	;GO GIVE NON-SKIP RETURN
	XCTU [MOVEM B,2]	;Store in user's ac
	JRST MRETN		;Restore user ac's and return
; Random input jsys
; Call:	1	;Tenex source designator
;	3	;Byte number
;	RIN
; Returns
;	+1
;	2	;The byte

.RIN::	MCENT
	TRVAR <SAVJFN>
RIN0:	UMOVE JFN,1
	MOVEM JFN,SAVJFN
	CALL CHKJFN
	 JRST IOERR
	 JFCL
	 FILABT DESX4		;Tty and byte designators are illegal
	TQNN <OPNF>		;OPEN?
	JRST NOTOPN		;NO
	TQNN <RNDF>
	FILABT IOX3		;Illegal to change pointer
	TQNN <READF>
	FILABT IOX1		;Illegal to read
	CALL @JFNID(P3)		;INIT JFN FOR INPUT
	UMOVE A,3
	CALL SFBNR		;Set up byte pointer
	 JRST ABTDO
	CALL BYTINA		;Get the byte
	 JRST RINW		;DEVICE SERVICE ROUTINE IS BLOCKING
	UMOVEM B,2
	CALL UNLCKF		;UNLOCK THE JFN
	JRST MRETN

RINW:	JUMPN A,[CALL UNLCKF	;IF ERROR, UNLOCK THE JFN
		XCTU [SETZM 2]	; LEAVE BYTE AS 0
		JRST EMRET0]	; AND GIVE ERROR RETURN
	MOVE A,B		;GET MDISMS WORD
	CALL UNLDIS		;UNLOCK THE JFN AND MDISMS
	JRST RIN0		;GO TRY AGAIN
; String input jsys'S
; Call:	1	;Tenex source designator
;	2	;Byte pointer (lh = 777777 will be filled in)
;	3	;Byte count or zero
;		;If zero, the a zero byte terminates
;		;If positive then transfer the specified number
;		;Of characters, or terminate on reading a byte
;		;Equal to that given in 4
;		;If negative, then transfer the specified number
;		;Of bytes
;	4	;(optional) if 3 is > 0, 4 has a terminating byte
;	SIN	(OR SINR FOR RECORD MODE)
; Return
;	+1	;Always
;	2	;Updated string pointer
;	3	;Updated count (always counts toward zero)
; The updated string pointer always points to the last byte read
; Unless 3 contained zero, then it points to the last non-zero byte.

.SINR::	MCENT
	SETO Q2,		;MARK THAT A SINR WAS DONE
	JRST SINR1		;ENTER COMMON CODE

.SIN::	MCENT			;Become slow etc.
	SETZ Q2,		;MARK THAT A SIN WAS DONE
SINR1:	TRVAR <SAVJFN,SINRF,SINZF>
	SETZM SINZF		;ASSUME USER AC3 ZERO
	XCTU [SKIPE 3]		;BUT TEST IT
	SETOM SINZF		;USER AC3 IS NONZERO
	MOVEM Q2,SINRF		;SAVE SIN/SINR FLAG
	MOVSI C,440700
	TLC 2,-1		;SEE IF LH = -1
	TLCN 2,-1
	XCTU [HLLM C,2]		;YES, TURN IT INTO ASCII POINTER
SIN0:	UMOVE T3,2		;GET USERS POINTER
	XCTBU [ILDB T3,T3]	;ATTEMPT TO GET A BYTE
	UMOVE JFN,1
	MOVEM JFN,SAVJFN
	CALL CHKJFN		;CHECK THE JFN AND LOCK UP
	 JRST IOERR		;GIVE THE APPROPRIATE RETURN
	 JRST SINTTY		;TTY
	 JRST [	CAIE DEV,STRDTB
		JRST SINTTY	;NOT BYTE PTR, DO BYTE AT A TIME
		JRST SINBYT]	;BYTE POINTER
	TQNE <OPNF>		;OPENED?
	TQNN <READF>
	 FILABT(IOX1)		;ILLEGAL READ
	CALL @JFNID(P3)		;INIT JFN FOR INPUT
	TQZE <NSPNUL>		;WAS THERE A NULL NSP MESSAGE?
	SKIPL SINRF		;YES, WAS THIS A SINR?
	JRST SIN00E		;NO
	CALL UNLCKF		;YES, SINR AND NULL NSP - UNLOCK THE FILE
	JRST MRETN		;GOOD RETURN
SIN00E:	MOVE B,FILLEN(JFN)	;GET TOTAL FILE LENGTH
	SUB B,FILBYN(JFN)	;COMPUTE BYTES LEFT IN FILE
	CAMGE B,FILCNT(JFN)	;THIS BUFFER PASSES EOF?
	MOVEM B,FILCNT(JFN)	;YES, REDUCE BUFFER COUNT SO EOF WILL BE SEEN
	SKIPG FILCNT(JFN)	;ANY BYTES IN BUFFER?
	 JRST SIN1		;NO, DO IT THE SLOW WAY
SIN00:	SKIPLE SINRF		;ABORTING A SINR?
	JRST [	CALL UNLCKF	;YES. UNLOCK FILE
		SETZM A		;GET A ZERO
		EXCH A,FILCNT(JFN) ;GET REMAINING COUNT.
		ADDB A,FILBYN(JFN) ;NEW FILE POSITION
		JRST SIN01]	;AND PROCEED
	CALL SIORX		;TRANSFER SOME DATA
	MOVE A,FILBYN(JFN)	;SEE WHERE WE'RE UP TO IN THE FILE
	CAML A,FILLEN(JFN)	;IF WE'RE AT END OF RECORD,
	TQNN <ACRLFF>		;AND WE'RE SUPPOSED TO AUGMENT WITH CRLF'S
	CAIA			;(WE'RE NOT)
	JRST [	SKIPN SINRF	;SINR?
		TQNN <FROSTF>	;DON'T START FROSTING IF ALREADY FROSTED
		TQNE <LFNXT>	;AND WE'RE NOT IN THE MIDDLE OF A CRLF,
		JRST .+1	;IN MIDDLE OF FROSTING OR ALREADY FROSTED
		TQO <CRNXT>	;THEN TELL BYTBLT TO PUT IN CRLF SEQUENCE NOW.
		TQNN <BBDONE>	;SIORX WILL MISINTERPRET A 0 IN AC3!
		CALL SIORX	;SO THE CRLF FOLLOWS THE RECORD
		JRST .+1]
	CALL UNLCKF		;UNLOCK FILE TO ALLOW INTS
SIN03:	SKIPE SINRF		;DOING A SINR JSYS?
	JRST [	MOVE A,FILBYN(JFN)
		CAML A,FILLEN(JFN) ;ANY BYTES LEFT?
		JRST MRETN	;NO, GIVE OK RETURN
		TQNN <BBDONE>	;DONE?
		JRST SIN0	;NO, GO DO SOME MORE
		ADD A,FILCNT(JFN) ;PICK UP REST OF BYTES IN BUFFER
		MOVEM A,FILBYN(JFN) ;NEW FILE POSITION
		SETZM FILCNT(JFN)
		MOVEI B,1	;REMEMBER DOING SINR ABORT
		MOVEM B,SINRF
		JRST SIN01]	;AND PROCEED
	TQNN <BBDONE>		;IS BYTBLT FINISHED?
	JRST SIN0		;NO, JUST KEEP GOING
	JUMPN Q1,MRETN		;IF NON-ZERO COUNT SUPPLIED, NO 0.
	JRST SIN2		;PUT THE ZERO ON THE END.

;ROUTINE CALLED FROM ABOVE TO TRANSFER SOME DATA.

SIORX:	MOVE A,FILBYT(JFN)	;SOURCE POINTER
	MOVX D,FLINPT!BBLTMU	;FROM FILE, COPY MONITOR TO USER
	LOAD B,CRSTUF		;GET CARRIAGE RETURN STUFF
	STOR B,DCRSTF		;COPY FOR BYTBLT
	UMOVE B,2		;TARGET
	TQNE <PASLSN>		;COPYING LINE NUMBERS FROM FILE?
	TQO <XFRLSN>		;YES, HAVE BYTBLT DO ALSO
	CALL SIOR2		;SET UP REST OF ARGS AND DO BYTBLT
	UMOVEM B,2		;UPDATE POINTERS
	LOAD B,DCRSTF		;GET CARRIAGE RETURN STUFF
	STOR B,CRSTUF		;STORE BACK INTO STATUS
	MOVEM A,FILBYT(JFN)
	RET

; DO SIN FROM BYTE POINTER

SINBYT:	MOVE A,JFN
	UMOVE B,2
	MOVX D,STRSRC!XFRLSN!BBLTUU;STRING IN USER SPACE AND SHOULDN'T HAVE LINE #'S
	CALL SIOR2
	UMOVEM B,2
	UMOVEM A,1
	JRST SIN3

;GET HERE WHEN SINR RUNS OUT. CHECK FOR DONE
;	A/ CURRENT FILE POSITION

SIN01:	CAMGE A,FILLEN(JFN) 	;AT EOR YET?
	JRST SIN0		;NO. KEEP TRYING
SIN02:	FILINT (IOX10)		;YES. GIVE INT
	MOVEI A,IOX10		;GET ERROR CODE
	JRST EMRET0		;AND GIVE UP
;SIN WHICH MUST BE DONE BYTE-AT-A-TIME

SINTTY:	CALL @JFNID(P3)		;INIT JFN FOR INPUT
SINTT1:	CALL BYTINA		;Read a byte from the source
	 JRST SINW		;SERVICE ROUTINE WANTS TO BLOCK
	JUMPE B,[TQNN <EOFF>
		XCTU [SKIPN 3]
		JRST SIN4
		JRST .+1]
	XCTBUU [IDPB B,2]	;DEPOSIT THE BYTE
	CALL SIONXT		;Test for end of string
	 JRST SINTT1		;Not end, continue
	JRST UNL		;ALL DONE

SIN1:	MOVE T1,SINRF		;get SINR flag
	CALL BYTINS		;Read a byte from the source
	 JRST SINW		;SERVICE ROUTINE WANTS TO BLOCK
	TQZE <RECF>		;EOR ENCOUNTERED?
	JRST SIN00         	;yes. proceed.
	SKIPLE SINRF		;DOING SINR ABORT?
	JRST SIN00		;YES. GO CHECK THEN
	JUMPE B,[TQNN <EOFF>
		XCTU [SKIPN 3]
		JRST UNL
		JRST .+1]
	XCTBUU [IDPB B,2]	;DEPOSIT THE BYTE
	 ERJMP [FILINT (ILLX02)	;IF ERROR RETURN PROPER CODE
		EMRETN (ILLX02,<CALL UNLCKF>)]
	CALL SIONXT		;Test for end of string
	 JRST SIN00		;NOT END
	JRST UNL		;ALL DONE
SIN4:	CALL UNLCKF		;UNLOCK THE LOCKS
	JRST SIN2		;GO ADD NULL TO END

SIN3:	SKIPE SINZF		;NON-ZERO COUNT CASE?
	MRETNG			;YES, RETURN

SIN2:	SETZ B,			;GET A NULL TERMINATOR
	UMOVE A,2		;FETCH USER'S DESTINATION POINTER
	XCTBU [IDPB B,A]	;DEPOSIT THE NULL
	MRETNG			;RETURN FROM JSYS

SINW:	JUMPN A,[CALL UNLCKF	;ERROR OCCURED
		TQNN <EOFF>	;EOF SEEN?
		JRST EMRET0	;NO, BOMB OUT
		SETZ B,		;APPEND A NULL
		UMOVE C,2	;GET BYTE POINTER
		XCTBU [IDPB B,C] ;STORE THE NULL
		 ERJMP [ FILINT (ILLX02);SEE INTERRUPT
			 EMRETN (ILLX02)];RETURN ERROR
		JRST EMRET0]
	MOVE A,B		;GET DISMIS INFO
	CALL UNLDIS		;UNLOCK LOCKS AND MDISMS
	JRST SIN0		;GO START OVER AGAIN

; Check for end of string io string
; Call:	B	;Character just transfered
; User	3	;Sin/sout argument
; User	4	;Sin/sout argument
;	CALL SIONXT
; Return
;	+1	;Continue
;	+2	;NO MORE LEFT TO DO
; Updates user 3

SIONXT::TLNE JFN,777777		;If byte pointer,
	UMOVEM JFN,1		;Restore updated jfn
	XCTU [SKIPN C,3]
	RET
	JUMPG C,SIO2		;Positive
	XCTU [AOSGE 3]
	RET
	RETSKP

SIO2:	XCTU [SOSLE 3]
	XCTU [CAMN B,4]
	RETSKP
	RET
; SUBROUTINE TO SET UP REST OF SIN/SOUT AND DO BYTBLT

SIOR2:	UMOVE Q1,3		;GET COUNT
	MOVM C,Q1		;MAGNITUDE OF COUNT
	SKIPL Q1		;TERMINATING BYTE?
	TQO <XFR2TM>		;YES, SET FLAG
	SKIPLE Q1		;SPECIFIC TERMINATOR?
	JRST [	UMOVE Q1,4	;YES. GET (NOTE 0 IN Q1 IF COUNT=0)
		TQO <XFRTRM>	;FLAG SPECIFIC TERMINATOR
		JRST .+1]
	SKIPN C			;NON-ZERO COUNT
	HRLOI C,77		;NO, SET MAX COUNT
	TQNE <DCRNXT,DLFNXT>	;WANT TO ADD CR OR LF?
	JRST [	TQO <XFRTRM>	;YES, USE EXACT COUNT
		JRST SIOR23]
	TQNE <STRSRC>		;BYTE POINTER IN JFN?
	JRST SIOR23		;YES, IGNORE FILCNT
	TMNN FILNO,(JFN)	;NEW OUTPUT?
	IFSKP.			;YES
	   CAML C,FILBCO(JFN)	;KEEP MIN OF THIS
	   MOVE C,FILBCO(JFN)	;AND BYTES IN BUFFER
	   MOVE Q2,FILBCO(JFN)	;GET LENGTH OF SOURCE STRING FOR LINE # REMOVER
	ELSE.			;NO, OLD IO OR NEW INPUT
	   CAML C,FILCNT(JFN)	;KEEP MIN OF THIS
	   MOVE C,FILCNT(JFN)	;AND BYTES IN BUFFER
	   MOVE Q2,FILCNT(JFN)	;GET LENGTH OF SOURCE STRING FOR LINE # REMOVER
	ENDIF.
	SKIPA
SIOR23:	MOVE Q2,C		;GET LENGTH OF SOURCE STRING
	PUSH P,C		;SAVE COUNT
	CALL BYTBLT		;DO THE TRANSFER
	SKIPLE C		;BYTES LEFT?
	JRST [	TQNE <FEEDME>	;YES. DID SOURCE RUNOUT?
		JRST .+1	;YEP. GO GET SOME MORE
		TQNE <FLINPT>	;WAS FILE INPUT?
		TQNE <XFRTRM>	;YES. NEED TO DO EXTRA DECREMENT?
		JRST .+1	;NO
		SOJA C,.+1]	;YES, DO IT AND CONTINUE
	SUB C,0(P)		;GET NEG OF BYTES TRANSFERRED
	POP P,(P)		;DON'T NEED THIS NOW
	TQNE <STRSRC>		;BYTE POINTER IN JFN?
	JRST SIOR24
	TMNN FILNO,(JFN)	;NEW OUTPUT?
	IFSKP.			;YES
	   ADDM Q1,FILBNO(JFN)	;COUNT BYTES SKIPPED AS BYTES READ
	   MOVN Q1,Q1		;NOW WE NEED IT NEGATIVE
	   ADDM Q1,FILBCO(JFN)	;AND COUNT BYTES SKIPPED AS BYTES REMOVED
	   ADDM C,FILBCO(JFN)	;UPDATE FILCNT
	   MOVN Q1,C
	   ADDB Q1,FILBNO(JFN)
	   TQNE <DISCRD>	;DISCARD A TAB?
	   AOS FILBNO(JFN)	;YES. THIS IS EASY, AS WE KNOW FILCNT=0
	ELSE.			;NO, OLD IO OR NEW INPUT
	   ADDM Q1,FILBYN(JFN)	;COUNT BYTES SKIPPED AS BYTES READ
	   MOVN Q1,Q1		;NOW WE NEED IT NEGATIVE
	   ADDM Q1,FILCNT(JFN)	;AND COUNT BYTES SKIPPED AS BYTES REMOVED
	   ADDM C,FILCNT(JFN)	;UPDATE FILCNT
	   MOVN Q1,C
	   ADDB Q1,FILBYN(JFN)
	   TQNE <DISCRD>	;DISCARD A TAB?
	   AOS FILBYN(JFN)	;YES. THIS IS EASY, AS WE KNOW FILCNT=0
	ENDIF.
	CAML Q1,FILLEN(JFN)
	CALL [	MOVEM Q1,FILLEN(JFN)
		CALLRET UPDLEN]	;UPDATE OFN LENGTH
SIOR24:	XCTU [SKIPGE Q1,3]	;WHAT KIND OF COUNT
	MOVNS C		;MAKE SIGN AGREE
	JUMPE Q1,SIOR21		;DON'T UPDATE COUNT IF 0
	XCTU [ADDB C,3]		;DO UPDATE
	JUMPE C,SIOR22		;IF COUNT BECOMES 0, THEN DONE
	JUMPL C,R		;STILL MORE TO DO, DON'T SAY DONE
SIOR21:	TQZE <DISCRD,FEEDME>	;IF BYTBLT RETURNED 'CAUSE IT HAS TO
	RET			; DISCARD A LINE NUMBER, DON'T STOP SIN.
	TQNN <XFR2TM>		;FOUND THE TERMINATOR YET?
SIOR22:	TQO <BBDONE>		;YES, SAY WE'RE DONE
	RET
; Byte input subroutine
; Call:	1	;Source designator
;	CALL BYTIN
; Return
;	+1	;ERROR OCCURED, ERROR CODE IS IN A
;	+2	;Ok
;	B	;A byte
; Clobbers most everything

BYTIN:	TRVAR <SAVJFN>
	MOVEM JFN,SAVJFN	;SAVE FOR BLOCK
BYTIN1:	CALL CHKJFN		;Check the designator
	 JRST IOERR		;Bad designator
	 JFCL			;Tty
	 JFCL			;Byte pointer
	CALL @JFNID(P3)		;INIT JFN FOR INPUT
	CALL BYTINA		;GET A BYTE
	 JRST BYTINW		;SERVICE ROUTINE WANTS TO BLOCK
	CALL UNLCKF		;UNLOCK THE LOCKS
	RETSKP			;AND RETURN OK

BYTINW:	JUMPN A,[CALLRET UNLCKF];IF ERROR, RETURN
	MOVE A,B		;GET DISMIS INFO
	CALL UNLDIS		;UNLOCK LOCKS AND DO MDISMS
	MOVE JFN,SAVJFN		;GET JFN BACK
	JRST BYTIN1		;LOOP BACK AND TRY AGAIN
;ROUTINE TO INPUT A BYTE FROM DEVICE DEPENDENT SEQUENTIAL INPUT ROUTINE
;CALLED WITH THE JFN ALREADY LOCKED BY CHKJFN AND JFNID(P3) HAS BEEN CALLED
;CALL:	CALL BYTINA
;RETURN
;	+1	IF A IS NON-ZERO, AN ERROR OCCURED
;		IF A = 0, ROUTINE WANTS TO BLOCK
;		;MDISMS ARGUMENT IS IN B
;	+2	;BYTE IN B
;BYTINS USED IF MAY BE A SINR

BYTINA:	SETZM T1		;NOT A SINR
BYTINS:	STKVAR <FLAGS>		;SAVE ENTRY FLAG HERE
	MOVEM T1,FLAGS		;SAVE IT NOW
	JUMPGE STS,NOTOPN
BYTIA1:	TQZ <RECF>		;NOT END OF RECORD IF HERE
	CALL BYTINX		;GET A BYTE
	 RET			;ERROR - PASS DOWN THE LINE
	TQNE <RECF>		;END OF RECORD SEEN?
	JRST [	TQNN <ACRLFF>	;ADDING CR-LF?
		SKIPE FLAGS	;NO. A SINR?
		RETSKP		;YES. RETURN NOW THEN
		JRST BYTIA1]	;NO. GET NEXT BYTE NOW
	TQNE <PASLSN>		;LETTING LINE #S THRU?
	RETSKP			;YES, EASY RETURN
	TQZE <SKIPBY>		;ARE WE SUPPOSED TO THROW THIS AWAY (SEE BELOW)
	JRST BYTIA1		;YEP, GO GET A REAL ONE
	JUMPN B,BYTIA2		;DISCARD LSN'S MEANS ALSO DISCARD NULLS
	MOVE A,FILBYN(JFN)	;HOWEVER, IF IT'S THE FIRST BYTE OF THE FILE
	SOJE A,BYTIA3		; THEN THE FILE CAN'T HAVE LINE NUMBERS
	JRST BYTIA1		;NOT FIRST BYTE, SAFE TO DISCARD IT

BYTIA2:	LDB A,[POINT 12,FILBYT(JFN),11];DID WE JUST GET THE FIRST CHARACTER OF A WORD?
	MOVE C,FILCNT(JFN)	;AND BETTER MAKE SURE THERE ARE ENUF LEFT
	CAIE A,<POINT 7,0,6>_-^D24;FIRST BYTE?
	RETSKP			; NO, LET IT THROUGH.
	CAIGE C,4		;ENUF FOR A LINE #?
	JRST BYTIA4		; NO, POSSIBLY SKIP THIS IN FUTURE

;POSSIBLE LINE NUMBER. LET'S ALSO CHECK TO SEE IF WE ARE ON THE FIRST WORD
;OF THE FILE AND IT IT ISN'T A LINE #, THEN SET PASLSN TO SPEED THINGS UP
;IN THE FUTURE
	HRRZ A,FILBYT(JFN)	;GET THE WORD WE GOT THE CHARACTER FROM
	MOVE A,0(A)		;DO INDIRECT
	TXNN A,1B35		;BIT 35 ON? IF SO, CALL IT A LINE #
	JRST BYTIA4		; NOT A LINE NUM. POSSIBLY SKP THIS IN FUTURE
	MOVNI A,4		;SKIP THE REST OF THE LINE NUMBER QUICKLY
	ADDM A,FILCNT(JFN)	;(WE KNOW FILCNT WAS GEQ 4 BEFORE)
	MOVEI A,4		;ALSO UPDATE FILBYN
	ADDM A,FILBYN(JFN)
	MOVX A,77B5		;NOW POINT TO LAST BYTE IN WORD
	ANDCAM A,FILBYT(JFN)	;TO "READ" THOSE 4
	CALL BYTINX		;SKIP THE TAB AFTER THE LSN
	 TQOA <SKIPBY>		;OOPS, NOT THIS TIME, REMEMBER AFTER WE UNBLOCK
	JRST BYTIA1		;AND GET A REAL ONE
	RET			;RETURN TO BLOCK

BYTIA4:	MOVE A,FILBYN(JFN)	;NOT A LINE NUMBER. FIRST CHAR?
	SOSN A			;IF SO, SKIP THIS NONSENSE IN THE FUTURE
BYTIA3:	TQO <PASLSN>		;HERE IF WE DECIDE FILE ISN'T SEQUENCED
	RETSKP			;RETURN CURRENT BYTE
;SUBROUTINE CALLED ONLY BY BYTINA: and TSTLSN
;BYTINX expects the original JFN to be stored in SAVJFN (via TRVAR <SAVJFN>).
BYTINX::TQNN <READF>		;[7321]Make routine BYTINX external
	FILABT IOX1		;Illegal read
	TQNE <ERRF>
	JRST INERR		;GO GENERATE DATA ERROR INTERRUPT
	TQNE <EOFF>
	JRST INEOF
	TQZE <BLKF,XQTAF>	;SEE IF FLAG IS ALREADY SET
	BUG.(CHK,BLKF1,IO,HARD,<BYTINA - BLKF set before calling service routine>,,<


Cause:	This is a consistency check in BYTINX.  The environment is in IO where  
	sequential input is being processed.  The code is getting ready to  
	jump to the device dependant code.  Before doing so it sees if a bit  
	(BLKF) is set in STS (AC 8).  This bit indicates that the service 
	routine wants to block.  Therefore, no matter what the device 
	dependent routines do, the process will ultimately block.  It is 
	unlikely that this is being done on purpose.  It is more likely that  
	somewhere BLKF is not being cleaned up properly.

Action:	If this is becoming a problem change the BUGCHK to a BUGHLT and
	look at the dump.If FILSTS for the current JFN has the bit on then
	the problem gets a little tricky since the previous use of it left
	BLKF on.  If BLKF is off in FILSTS then somewhere past the call to
	CHKJFN it is being turned on.

>)
	XMOVEI C,BYTINB		;BYTIN BLOCK ROUTINE
	MOVE D,SAVJFN		;ORIGINAL JFN
	TQZE <CRNXT>		;CR NEXT
	JRST [	MOVEI B,.CHCRT	;YES, LOAD IT UP
		TQO <LFNXT>	;REMEMBER THAT LF COMES NEXT
		RETSKP]
	TQZE <LFNXT>		;TIME FOR LF?
	JRST [	MOVEI B,.CHLFD	;YES, LOAD IT UP
		TQO <FROSTF>	;NOTE THAT THIS RECORD HAS BEEN FROSTED
		RETSKP]
	CALL @BIND(P3)		;Dispatch to DEVIce dependent code
	TQNN <XQTAF>		;QUOTA EXCEEDED?
	TQZE <BLKF>		;CHECK IF SERVICE ROUTINE WANTS TO BLOCK
	JRST [	MOVE B,A	;YES, LEAVE DISMIS DATA IN B
		JRST RETZ]	;AND RETURN WITH A=0
	TQZ <FROSTF>		;NEW RECORD HASN'T BEEN FROSTED WITH CRLF YET
	TQNE <ERRF>
	JRST INERR
	TQNE <EOFF>
	JRST INEOF
	MOVE B,A
	TQNN <ACRLFF>		;WANT TO AUGMENT RECORDS WITH CRLFS?
	RETSKP			;NO, JUST GIVE SKIP WITH LOCKS STILL SET
	MOVE C,FILBYN(JFN)	;SEE HOW FAR WE'VE READ
	CAMGE C,FILLEN(JFN)	;ARE WE AT END OF RECORD?
	CAIA			;NOT END OF RECORD OR ALREADY FROSTED
	TQO <CRNXT>		;AUGMENTING, START SEQUENCE.
	RETSKP			;SKIP RETURN LEAVING LOCKS STILL SET

INEOF:	MOVEI A,IOX4
	MOVEM A,LSTERR
	MOVEM JFN,ERRSAV
	MOVE A,MPP		;GET BASE LEVEL STACK
	MOVE B,-1(A)		;GET PC
	MOVE A,0(A)		;GET ADR OF JSYS+1
	CALL CHKERT		;SEE IF AN ERCAL OR ERJMP
	 SKIPA A,BITS+.ICEOF	;NO, CAUSE INTERRUPT ON CHANNEL 10
	JRST INEOF1		;YES, DONT INTERRUPT
	CALL IICSLF		;ON THIS FOR
INEOF1:	MOVEI B,0
	RETBAD (IOX4)		;GIVE ERROR RETURN

INERR:	FILINT (IOX5)		;GIVE CHANNEL 11 INTERRUPT
	RETBAD (IOX5)		;AND RETURN

;ROUTINE TO HANDLE SERVICE ROUTINE BLOCK REQUEST

BYTINB::STKVAR <SAVDEV>		;SAVE DEV
	MOVEM DEV,SAVDEV	;SAVE DEV
	PUSH P,T2		;SAVE JFN RETURNED
	CALL UNLDIS		;UNLOCK JFN & DISMISS
	POP P,JFN		;RESTORE JFN
	CALL CHKJFN		;RE-VALIDATE IT
	 RETBAD ()
	 JFCL
	 JFCL
	CAME DEV,SAVDEV		;CHECK FOR DEV MATCH
	RETBAD (DESX4)		;NOT LEGAL TO CHANGE JFN'S
	RETSKP			;ALLOW SERVICE ROUTINE TO PROCEED
;ROUTINE TO UNLOCK LOCKS AND TO DO AN MDISMS
;CALLED WITH MDISMS ARGUMENT IN A
;ENTRY AT UNLDS1, WILL CHECK ERRF FIRST, AND IF SET, WILL
;GUARANTEE THAT PROCESS "SEES" INTERRUPT

UNLDS1:	TQNN <ERRF>		;[7391]Is error up?
	JRST UNLDIS		;[7391]No, continue on
	CAIE A,IOX7		;[7391]JSB free space full?
        IFSKP.			;[7391]
	  FILINT (IOX7)		;[7391]Yes, give the interrupt
	ELSE.			;[7391]
	  CAIE A,MONX02		;[7.1032] No more JSB space?
	  IFSKP.		;[7.1032]
	    FILINT (IOX7)	;[7.1032] Yes, give correct error
	  ELSE.			;[7.1032]
	    FILINT (IOX5)	;[7.1032] No, assume device or data error
	  ENDIF.		;[7.1032]
	ENDIF.			;[7391]
	CALL UNLCKF		;[7391]Success, unlock the file
	JRST EMRET1		;[7391]Give error
UNLDIS::PUSH P,A		;SAVE MDISMS ARGUMENT
	TQZN <XQTAF>		;QUOTA EXCEEDED?
	JRST UNLDSN		;NO - GO ON
	MOVE A,MPP		;YES - GET ADDRS OF JSYS+1
	MOVE B,-1(A)		;GET PC
	MOVE A,0(A)		;...
	CALL CHKERT		;SEE IF ERJMP/ERCAL
	 SKIPA			;NONE - TRY INTERRUPT
	EMRETN (IOX11,<CALL UNLCKF>) ;TAKE ERROR RETURN
   REPEAT 0,<			;OLD, INCORRECT CODE
	MOVE B,MPP		;RETURN PC POINTER
	MOVE C,0(B)		;PICK UP FLAGS
	TXOE C,QUOTAB		;ALREADY "BACKED UP"?
	JRST UNLDS2		;YES. DON'T DO IT AGAIN
	SOS -1(B)		;DECREMENT RETURN PC
	MOVEM C,0(B)		;NEW FLAGS
	TLNE C,(UMODF)		;USER MODE PC?
	SOS -3(B)		;YES. ONE MORE PC THEN
   >				;END OF REPEAT 0
UNLDS2:	MOVE A,BITS+.ICQTA	;GET CHANNEL BITS
	CALL IICSLF		;CAUSE INTERUPT
UNLDSN:	PUSH P,STS		;SAVE STS
	TQZ <HLDF>		;NEVER STORE HLDF
	CALL UNLCKF		;UNLOCK THE FILE AND DO AN OKINT
				;INTERUPT WILL HAPPENED IF POSTED
	POP P,STS		;RESTORE ORIGINAL STS
	POP P,A			;GET BACK ARG
	HRRZ B,A		;LOOK AT ROUTINE ADDRESS
	JUMPE B,UNLERC		;NONE, ONLY ERROR CODE IN LH
	TQNE <HLDF>		;WANT TO HOLD PROCESS IN BAL SET?
	JRST UNLHLD		;YES. GO ARRANGE IT
	CAIE B,MTDWT1		;IS THIS A MAG TAPE WAIT?
	CAIN B,MTAWAT
	JRST UNLMTA		;YES, GO DO A HDISMS
	CAIN B,MTARWT		;ANOTHER TYPE OF MTA WAIT?
	JRST UNLMTA		;YES
	MDISMS			;WAIT UNTIL CONDITION IS SATISFIED
	RET			;RETURN TO CALLER

;HERE IF SERVICE ROUTINE DOESN'T REALLY WANT TO BLOCK, BUT RATHER TO
;RETURN A SPECIFIC ERROR CODE

UNLERC:	HLRZ T1,T1		;GET ERROR CODE
	ITERR ()

UNLMTA:	HDISMS (^D50)		;WAIT FOR ENOUGH TIME FOR A RECORD READ
	RET

;SPECIAL BLOCK FOR FE DEVICE WAIT
;THIS CODE IS HERE TO REDUCE SCHEDULER OVERHEAD FROM THE DN64'S
;1/3 SEC POLLING CYCLE. THE WAIT TIME IS A GUESS AT HOW LONG IT TAKES
;TO CLANK THE POLLER. THE INTENDED EFFECT IS TO HELP THE SCHEDULER
;DEDUCE WAHT IS GOING ON.

UNLHLD:	HDISMS (^D80)		;WAIT LONG ENOUGH FOR FE AND 3780 TO
				; RESPOND
	RET			;AND DONE
; Output to primary output file
; Call:	1	BYTE
;	PBOUT

.PBOUT::MCENT
	MOVEI JFN,101
	UMOVE B,1
	CALL BYTOUT
	JRST MRETN

; Byte output
; Call:	1	;Tenex destination designator
;	2	;A byte
;	BOUT

.BOUT::	MCENT
	NOINT
	JUMPLE 1,SLBOU
	CAIE 1,.PRIIN		;PRIMARY INPUT?
	CAIN 1,.PRIOU		;OR PRIMARY OUTPUT?
	JRST SLBOU		;YES. DO IT THE SLOW WAY
	CAML 1,MAXJFN		;Possibly a jfn?
	 JRST SLBOU		;Not possible
	IMULI 1,MLJFN		;CONVERT TO INTERNAL INDEX
	AOSE FILLCK(1)
	JRST SLBOU0
	MOVE C,FILSTS(1)
	TXC C,OPNF!WRTF!FILOUP
	TXCN C,OPNF!WRTF!FILOUP
	TXNE C,FRKF!ERRF
	JRST SLBOU1
	TMNN FILNO,(1)		;NEW OUTPUT?
	IFSKP.			;YES
	   SOSGE FILBCO(1)
	   JRST SLBOU2
	ELSE.			;NO, OLD IO OR NEW INPUT
	   SOSGE FILCNT(1)
	   JRST SLBOU2
	ENDIF.
	CALL STRDMO		;VERIFY STRUCTURE
	 JRST SLBOU1		;BEEN DISMOUNTED
	TMNN FILNO,(1)		;NEW OUTPUT?
	AOSA C,FILBYN(1)	;NO, OLD IO OR NEW INPUT
	AOS C,FILBNO(1)		;YES,
	CAMLE C,FILLEN(1)
	CALL [	MOVEM C,FILLEN(1)
		MOVE JFN,1	;COPY FOR UPDLEN
		HRRZ DEV,FILDEV(JFN)
		MOVE STS,FILSTS(JFN)
		CALLRET UPDLEN]	;UPDATE OFN LENGTH
	UMOVE 2,2
	TMNN FILNO,(1)		;NEW OUTPUT?
	IDPB 2,FILBYT(1)	;NO, OLD IO OR NEW INPUT
	TMNE FILNO,(1)		;NEW OUTPUT?
	IDPB 2,FILBFO (1)	;YES
	CALL LUNLKF		;FREE UP FILE
	JRST MRETN

SLBOU2:	TMNN FILNO,(1)		;NEW OUTPUT?
	AOSA FILCNT(1)		;NO, OLD IO OR NEW INPUT
	AOS FILBCO(1)		;YES
SLBOU1:	SETOM FILLCK(1)
SLBOU0:	UMOVE 1,1		;GET BACK ORIGINAL JFN
SLBOU:	OKINT
	MOVE JFN,1
	CALL BYTOUT		;Output the byte
SLBOUR:	TQNN <ERRF>		;ERROR OCCUR?
	JRST MRETN		;NO, EXIT
	MOVEI A,IOX5		;YES, GET ERROR CODE
	JRST EMRET0		;AND EXIT

SLBOUU:	CALL UNLCKF		;UNLOCK THE JFN
	JRST SLBOUR		;AND RETURN
; Random output jsys
; Call:	1	;Tenex source designator
;	2	;A byte
;	3	;Byte number
;	ROUT

.ROUT::	MCENT
	TRVAR <SAVJFN>
ROUT0:	UMOVE JFN,1
	MOVEM JFN,SAVJFN
	CALL CHKJFN
	JRST IOERR
	JFCL
	FILABT DESX4		;Tty and byte designators are illegal
	JUMPGE STS,NOTOPN
	TQNN <RNDF>
	FILABT IOX3		;Illegal to change pointer
	TQNN <WRTF>
	FILABT IOX2		;Illegal write
	CALL @JFNOD(P3)		;INIT JFN FOR OUTPUT
	UMOVE A,3
	CALL SFBNR
	JRST ABTDO
	UMOVE B,2
	CALL BYTOUA
	 JRST ROUTW		;SERVICE ROUTINE WANTS TO BLOCK
	JRST SLBOUU		;UNLOCK AND RETURN

ROUTW:	CALL UNLDS1		;UNLOCK THE LOCKS AND WAIT
	JRST ROUT0		;TRY AGAIN
; String output to primary io file
; Call:	1	;String pointer, designator, or location of string
;	PSOUT

.PSOUT::MCENT
	TRVAR <SAVJFN>
PSOUT1:	TLNE 1,777777
	JUMPGE 1,PSOUT0
	MOVSI C,440700
	CAML 1,[777777,,0]
	XCTU [HLLM C,1]
PSOUT0:	MOVEI JFN,101		;GET JFN OF PRIMARY DEVICE
	MOVEM JFN,SAVJFN	;SAVE IT IN GLOBAL VARIABLE
	CALL CHKJFN		;TURN IT INTO A REAL JFN
	 JRST IOERR		;BAD ARGUMENT
	 JFCL			;TTY
	 JFCL			;BYTE POINTER
	CALL @JFNOD(P3)		;INIT JFN FOR OUTPUT
PSOUT2:	XPSHUM [PUSH P,1]	;Make a copy of byte pointer
	XCTBU [ILDB B,0(P)]
	JUMPE B,[XPOPMU [POP P,1]
		JRST SLBOUU]	;UNLOCK AND RETURN
	CALL BYTOUA
	 JRST PSOUTW		;SERVICE ROUTINE WANTS TO BLOCK
	XPOPMU [POP P,1]
	JRST PSOUT2

PSOUTW:	CALL UNLDS1		;UNLOCK AND BLOCK
	POP P,(P)		;REMOVE BYTE POINTER FROM STACK
	JRST PSOUT0		;START OVER AGAIN

; PRIMARY ERROR STRING OUTPUT

.ESOUT::MCENT
	MOVEI T1,101
	DOBE
	 ERJMPR [ITERX]		;FAILED. PASS BACK ERROR.
	RFPOS			;GET POSITION ON LINE
	 ERJMPR [ITERX]		;FAILED. PASS BACK ERROR.
	HRROI T1,[ASCIZ /
/]
	TRNE T2,-1		;ALREADY AT BEGINNING OF LINE?
	PSOUT			;NO, GET THERE
	 ERJMPR [ITERX]		;FAILED. PASS BACK ERROR.
	MOVEI T1,"?"		;ERROR CHARACTER
	PBOUT
	 ERJMPR [ITERX]		;FAILED. PASS BACK ERROR.
	MOVEI T1,100
	CFIBF
	 ERJMPR [ITERX]		;FAILED. PASS BACK ERROR.
	IMCALL PSOUT		;OUTPUT THE MESSAGE
	 ERJMPR [ITERX]		;FAILED. PASS BACK ERROR.
	MRETNG			;AND DONE
; String output
; Call:	1	;Tenex source designator
;	2	;Byte pointer (lh = 777777 will be filled in)
;	3	;Byte count or zero
;		;If zero, the a zero byte terminates
;		;If positive then transfer the specified number
;		;Of characters, or terminate on reading a byte
;		;Equal to that given in 4
;		;If negative, then transfer the specified number
;		;Of bytes
;	4	;(optional) if 3 is > 0, 4 has a terminating byte
;	SOUT
; Return
;	+1	;Always
;	2	;Updated string pointer
;	3	;Updated count (always counts toward zero)
; The updated string pointer always points to the last byte read
; Unless 3 contained zero, then it points to the last non-zero byte.

.SOUTR::MCENT
	SETO Q2,		;MARK THAT A SOUTR WAS DONE
	JRST SOUTR1		;ENTER COMMON CODE

.SOUT::	MCENT			;Become slow etc
	SETZ Q2,		;MARK THAT A SOUT WAS DONE
;SOUTR1:TRVAR <SAVJFN,SOUTRF,SOUAC3> ;[7317] [7319]
;	SETZM SOUAC3		;[7317] CLEAR AC3 FLAG
;	UMOVE C,3		;[7317] GET USERS AC 3 (COUNT WORD)
;	SKIPLE C		;[7317] IS IT POSITIVE ?
;	SETOM SOUAC3		;[7317] YES, REMEMBER THIS FOR LATER
SOUTR1:	TRVAR <SAVJFN,SOUTRF> 	;[7319] 
	MOVEM Q2,SOUTRF		;SAVE SOUTR FLAG
 	JUMPGE 2,SOUT0
	MOVSI C,440700
	CAML 2,[777777,,0]
	XCTU [HLLM C,2]
SOUT0:	UMOVE T3,2		;GET USERS POINTER
	XCTBU [ILDB T3,T3]	;ATTEMPT TO GET A BYTE
	UMOVE JFN,1		;GET USERS JFN
	MOVEM JFN,SAVJFN	;SAVE IT
	CALL CHKJFN		;GET REAL JFN AND LOCK UP
	 JRST IOERR		;BAD ARGUMENT
	 JRST SOUTTY
	 JRST [	CAIE DEV,STRDTB
		JRST SOUTTY	;NOT BYTE PTR, DO BYTE AT A TIME
		JRST SOUBYT]
	TQNE <OPNF>		;OPENED?
	TQNN <WRTF>
	 FILABT(IOX2)
	CALL @JFNOD(P3)		;INIT JFN FOR OUTPUT
	SKIPLE SOUTRF		;NEED TO MOVE SOME BYTES?
	JRST SOUTRR		;NO. GO RIGHT TO RECOUT CODE
SOUT00:	TMNN FILNO,(JFN)	;NEW OUTPUT?
	IFSKP.			;YES
	   SKIPG FILBCO(JFN)
	    JRST SOUT1		;DO IT THE OLD WAY
	   MOVE B,FILBFO(JFN)	;TARGET IS FILE
	ELSE.			;NO, OLD IO OR NEW INPUT
	   SKIPG FILCNT(JFN)
	    JRST SOUT1		;DO IT THE OLD WAY
	   MOVE B,FILBYT(JFN)	;TARGET IS FILE
	ENDIF.
	UMOVE A,2		;SOURCE IS USER
	MOVX D,XFRLSN!BBLTUM	;ALWAYS PASS LSNS (THERE AREN'T ANY)
	CALL SIOR2
	UMOVEM A,2
	TMNN FILNO,(JFN)	;NEW OUTPUT?
	MOVEM B,FILBYT(JFN)	;NO, OLD IO OR NEW INPUT
	TMNE FILNO,(JFN)	;NEW OUTPUT?
	MOVEM B,FILBFO(JFN)	;YES
	TQNN <BBDONE>		;HAS BYTBLT FINISHED?
	 JRST [	CALL UNLCKF	;NO, DO SOME MORE
		JRST SOUT0]	;BUT UNLOCK FIRST TO ALLOW INTERRUPTS
SOUTRR:	SKIPN SOUTRF		;DOING A SOUTR JSYS?
	JRST SLBOUU		;NO, JUST EXIT
	XMOVEI C,BYTINB		;COMMON BLOCK ROUTINE
	MOVE D,SAVJFN		;THE ORIGINAL JFN
	CALL @RECOUT(P3)	;IF SOUTR, CALL SERVICE ROUTINE
	 JRST [	TQZE <BLKF>	;WANT TO BLOCK?
		JRST [	CALL UNLDIS ;YES. SO DO IT
			MOVEI T1,1 ;REMEMBER THIS HAPPENED
			MOVEM T1,SOUTRF ;""
			JRST SOUT0] ;AND DO IT AGAIN
		FILABT (IOX5)]	;NO, ERROR
	JRST SLBOUU		;UNLOCK AND EXIT
; SOUT TO STRING POINTER

SOUBYT:	MOVE B,JFN
	UMOVE A,2
	MOVX D,STRSRC!XFRLSN!BBLTUU;FROM STRING, DON'T WORRY ABOUT LSNS,
				;  AND COPY USER TO USER
	CALL SIOR2
	UMOVEM A,2
	UMOVEM B,1
	MOVEM B,JFN
;	SKIPN SOUAC3		;[7317] [7319] USER AC3 ORIGINALLY POSITIVE ?
	CALL APPNUL		;[7317] NO, EITHER 0 OR NEGATIVE, APPEND NULL
	JRST SOUTRR		;AND RETURN

;SOUT WHICH MUST BE DONE BYTE-AT-A-TIME
;SOUTTY - FOR CASES WHERE WE DO NOT HAVE A REAL JFN

SOUTTY:	CALL @JFNOD(P3)		;INIT JFN FOR OUTPUT
SOUTT1:	CAIN P3,TTYDTB		;TTY?
	JRST STTYOP		;YES DO OPTIMIZATION
	CALL SOUTB		;OUTPUT THE BYTE
	 JRST [	JUMPN A,SOUT0	;DEVICE BLOCKED, START OVER
		JRST SOUTRR]	;ALL THROUGH
	JRST SOUTT1		;LOOP BACK FOR ALL BYTES

;OPTIMIZATION FOR SOUT TO A TTY.  IT USES THE RECOUT ENTRY
;SINCE IT TRIES TO OPTIMIZE AND SOUTR IS IGNORED FOR TTY'S.
;REGISTERS USED FROM USER AS IN CALL TO SOUT

STTYOP:	JUMPGE STS,NOTOPN
	TQNN <WRTF>
	FILABT IOX2		;ILLEGAL WRITE
	TQNE <ENDF>
	FILABT IOX6		;PAST ABS END OF FILE
	TQNE <ERRF>
	FILINT(IOX5)		;ERROR INTERRUPT
	XMOVEI C,BYTINB		;COMMON CO-ROUTINE
	CALL TTYBLO		;OUTPUT
	JRST [	CALL UNLDS1	;UNLOCK AND BLOCK
		TQNN <BLKF>	;BLOCK
		JRST SOUT0
		JRST SLBOUU]	;UNLOCK AND EXIT
	JRST SLBOUU		;UNLOCK AND EXIT


;SOUT1 - FOR CASES WHERE WE HAVE A REAL JFN, TRY FAST WAY AFTER DOING
;EACH BYTE IN CASE FILCNT IS THEN SETUP

SOUT1:	CALL SOUTB		;OUTPUT THE BYTE
	 JRST [	JUMPN A,SOUT0	;DEVICE BLOCKED, START OVER
		JRST SOUTRR]	;ALL DONE
	JRST SOUT00		;SEE IF FILCNT IS NOW SET UP

;ROUTINE TO OUTPUT A BYTE
;CALL:	CALL SOUTB
;RETURNS +1	A=TRUE MEANS DEVICE BLOCKED,START OVER
;	   	A=FALSE MEANS ALL THROUGH
;	 +2	MORE BYTES TO BE DONE

SOUTB:	XPSHUM [PUSH P,2]
	XCTBU [ILDB B,0(P)]
	XCTU [SKIPN 3]
	JUMPE B,[XPOPMU [POP P,2]
		JRST RFALSE]	;Don't write zero bytes if arg3 = 0
	PUSH P,B
	CALL BYTOUA
	 JRST SOUTW		;SERVICE ROUTINE WANTS TO BLOCK
	POP P,B
	XPOPMU [POP P,2]
	CALL SIONXT
	 RETSKP			;GIVE SKIP RETURN BECAUSE MORE TO BE DONE
	JRST RFALSE		;RETURN

SOUTW:	CALL UNLDS1		;UNLOCK AND BLOCK
	POP P,B			;GET BACK BYTE
	POP P,(P)		;POP OFF BYTE POINTER
	JRST RTRUE		;TRY AGAIN
; Byte output subroutine
; Call:	1	;Source designator
;	2	;BYTE
;	CALL BYTOUT
; Return
;	+1	;Ok
; Clobbers most everything

BYTOUT::TRVAR <SAVJFN>
	MOVEM JFN,SAVJFN	;SAVE ARGUMENT
BYTOU1:	CALL CHKJFN		;Check the designator
	JRST IOERR		;Bad designator
	JFCL			;Tty
	JFCL			;Byte pooutter
	PUSH P,B		;SAVE BYTE
	CALL @JFNOD(P3)		;INIT JFN FOR OUTPUT
	MOVE B,0(P)		;GET BACK THE BYTE
	CALL BYTOUA		;SEND IT OUT
	 JRST BYTOUW		;SERVICE ROUTINE WANTS TO BLOCK
	POP P,B			;GET BACK BYTE
	CALLRET UNLCKF		;UNLOCK THE LOCKS

BYTOUW:	CALL UNLDS1		;UNLOCK AND BLOCK
	POP P,B			;GET BYTE BACK
	MOVE JFN,SAVJFN		;GET ARG TO CHKJFN BACK
	JRST BYTOU1		;AND TRY AGAIN

;ROUTINE TO SEND A BYTE TO SERVICE ROUTINE
;CALLED WITH FILE LOCKED DOWN AND BYTE IN B AND JFNOD(P3) HAVING BEEN CALLED

BYTOUA::JUMPGE STS,NOTOPN
	TQNN <WRTF>
	FILABT IOX2		;Illegal write
	TQNE <ENDF>
	FILABT(IOX6)		;Past abs end of file
	TQNE <ERRF>
	FILINT(IOX5)		;Error interrupt
	MOVE A,B
	TQZE <BLKF,XQTAF>	;MAKE SURE BLKF IS OFF BEFORE CALL
	 BUG.(CHK,BLKF2,IO,HARD,<BYTOUA - BLKF set before call to service routine>,,<

Cause:	This is a consistency check in BYTOUA.  The environment is in IO just
	before it gets ready to call the device dependent routines to do output.
	Bit BLKF in STS (AC 8) is on.  It should be off.  It causes the process
	to block.  It is unlikely that this sort of knowledge is available.   
	It is more likely that this is an error.

Action:	If the problem persists change the BUGCHK to a BUGHLT and look at
	the dump.  If FILSTS for the current JFN has the BLKF bit on then
	the last one to user the JFN left it in that state.  A hard problem
	to find.  If BLKF is off in FILSTS then somewhere after the call to
	CHKJFN the bit is being set on not reset.

>)
	XMOVEI C,BYTINB		;COMMON CO-ROUTINE
	MOVE D,SAVJFN
	CALL @BOUTD(P3)	;Dispatch to DEVIce dependent code
	TQZN <BLKF>		;DOES SERVICE ROUTINE WANT TO BLOCK?
	TQNE <ERRF,XQTAF>	;GOT AN ERROR?
	 RET			;YES, TAKE NON-SKIP RETURN
	RETSKP			;NO, SKIP RETURN WITHOUT UNLOCKING
; Append null to string output designator

APPNUL::PUSH P,JFN
	PUSH P,C
	PUSH P,B
	MOVEI C,0
	LDB B,[POINT 6,JFN,5]	;GET PS FIELD FROM BYTE PTR
	CAIL B,61		;ARE WE .GE. OWGBP FOR P=36 S=7
	CAILE B,66		;ARE WE .LE. OWGBP FOR P=1 S=7
	SKIPA			;NO, NOT ASCII BYTE PTR
	XCTBU [IDPB C,JFN]	;YES, HAVE OWGBP ASCII BYTE PTR
	TLZ JFN,7700
	TLO JFN,700
	CAMN JFN,-2(P)		;HAVE REGULAR ASCII BYTE PTR
	XCTBU [IDPB C,JFN]	;YES, APPEND NULL
	POP P,B
	POP P,C
	POP P,JFN
	RET
;table to convert P,S field of OWGBP to P or S
;access table using the structures, OWGSZ & OWGPS, with index = P,S field
;or the routines GETSIZ & GETPOS
OWGBTB:	6,,44
	6,,36
	6,,30
	6,,22
	6,,14
	6,,6
	6,,0
	10,,44
	10,,34
	10,,24
	10,,14
	10,,4
	7,,44
	7,,35
	7,,26
	7,,17
	7,,10
	7,,1
	11,,44
	11,,33
	11,,22
	11,,11
	11,,0
	22,,44
	22,,22
	22,,0
	77,,77			;illegal

DEFSTR OWGSZ,OWGBTB-^O45,17,18	;size field
DEFSTR OWGPS,OWGBTB-^O45,35,18	;position field
;get size field from a byte pointer, global or local
;CALL GETSIZ
;T1/ byte pointer
;returns +1 on with T1/ size
;preserves all other ACs
GETSIZ::SAVEAC <Q1>
	MOVE Q1,T1		;save pointer
	LDB T1,[POINT 6,T1,5]
	CAIGE T1,45		;OWGBP ?
	IFSKP.
	  LOAD T1,OWGSZ,(T1)	;yes. convert.
	ELSE.
	  LDB T1,[POINT 6,Q1,11] ;no. get size field
	ENDIF.
	RET

;get position field from a byte pointer, global or local
;CALL GETPOS
;T1/ byte pointer
;returns +1 with T1/ position
;preserves all other ACs
GETPOS::LDB T1,[POINT 6,T1,5]
	CAIL T1,45		;OWGBP ?
	LOAD T1,OWGPS,(T1)	;yes. convert.
	RET

;ROUTINE TO BLOCK FOR BYTOUT SERVICE ROUTINES
; Move bytes
; Call:
; A/	SOURCE POINTER
; B/	TARGET POINTER
; C/	BYTE COUNT
; D/	MODE BITS AS AS DEFINED AT START OF LISTING
; Q1/	TERMINATOR IF ANY
; Q2/	LENGTH OF SOURCE STRING (USED BY CHKTRM ONLY)

;RETURNS A-D UPDATED,
;Q1/ # OF BYTES DISCARDED AS LINE NUMBERS OR NULL
;Q2/ CLOBBERED

;NOTE: ATS CALLS THIS ROUTINE USING AN INDEXED BYTE POINTER
;INDEXING ON P1. THIS ROUTINE MUST NOT CHANGE P1.

BYTBLT::STKVAR <<TEMPA,3>,SAVQ3,SAVP6,SAVP5,SAVP3,SAVTDS,OWGBSF,OWGBTF,BYTREM,BYTSIZ,TRMBYT,BYTSKP,<PRG,LPRG>>
	MOVEM Q1,TRMBYT		;Shuffle args
	MOVEM Q3,SAVQ3		;SAVE PERMANENT ACS
	MOVEM P3,SAVP3
	MOVEM P5,SAVP5
	MOVEM P6,SAVP6
	XMOVEI P3,BYTERR	;SETUP DISPATCH FOR ANY ILLEG REF
	TXO P3,TRPIRF		; THAT MIGHT OCCUR HEREIN
	EXCH P3,TRPDSP		; SAVE PREVIOUS
	MOVEM P3,SAVTDS
	HRRZ P5,D		;SET TYPE OF XFER
	SETZM BYTSKP		;HAVEN'T SKIPPED ANYTHING YET

; Preliminaries out of the way
; Now get to work

BYTB1:	TQNE <DCRNXT,DLFNXT>	;ADDING CRLF'S?
	JRST CHKCRL		;YES. GO DO CR-LF STUFF
	TQNE <XFRLSN>		;SKIPPING LINE NUMBERS?
	TQNE <XFR2TM>		;OR UP TO A TERMINATOR?
	JRST CHKTRM		;Yes TO EITHER, look for it
	CAIG C,20		;Short transfer ?
	JRST BYTLP		;Do byte at a time
	;...
	;...
;get byte size of source & target, set flags & get position of target
	LDB Q1,[POINT 6,A,5]	;GET SOURCE P FIELD
	CAIGE Q1,45		;IS SOURCE A OWGBP?
	IFSKP.
	  SETOM OWGBSF		;yes. flag source as global
	  LOAD Q1,OWGSZ,(Q1)	;get byte size
	ELSE.
	  SETZM OWGBSF		;no. flag source as local
	  LDB Q1,[POINT 6,A,11]	;get byte size
	ENDIF.
	LDB Q2,[POINT 6,B,5]	;GET TARGET P FIELD
	CAIGE Q2,45		;IS TARGET A OWGBP?
	IFSKP.
	  SETOM OWGBTF		;yes. flag target as global
	  LOAD Q3,OWGSZ,(Q2)	;get byte size
	  LOAD Q2,OWGPS,(Q2)	;get byte position
	ELSE.
	  SETZM OWGBTF		;no. flag target as local
	  LDB Q3,[POINT 6,B,11]	;get byte size
	ENDIF.
	JUMPE Q3,BYTLP		;if target byte size = 0, do slowly.
	CAME Q1,Q3		;byte sizes differ ?
	JRST BYTLP		;yes. do slowly.
	MOVEM Q1,BYTSIZ		;no. save byte size.

;BYTE SIZES FOR SOURCE AND DESTINATION MATCH, AND TRANSFER IS
;LONG ENOUGH TO JUSTIFY THE OVERHEAD OF TRYING TO OPTIMIZE.
;COPY A BYTE AT A TIME UNTIL THE FIRST WORD OF THE TARGET HAS
;BEEN FILLED.

	CAMLE Q3,Q2		;at end of word to start with ?
	MOVEI Q2,^D36		;yes. transfer a full word's worth of bytes
	IDIV Q2,Q3		;compute # of bytes to move
LP1:	SOJL C,DONE		;Until cnt < 0
	XCT LDBTB(P5)		;Do transfer bytes
	XCT DPBTB(P5)
	SOJG Q2,LP1		;Or until first word of target is filled

;ONE WORD HAS BEEN FILLED IN THE DESTINATION. MAKE SURE WE NEED
;TO TRANSFER AT LEAST ONE WORD.

BYTB2:	MOVEI Q1,^D36		;Word size
	IDIV Q1,BYTSIZ		;Compute bytes/word and remainder
	MOVEM Q2,BYTREM		;Save remainder
	MOVE Q2,C
	IDIV Q2,Q1		;Compute words to transfer
	MOVEM Q3,C		;Remaining bytes
	JUMPE Q2,BYTLP		;Zero words...do byte at a time

;COMPUTE THE DIFFERENCE IN BIT POSITIONS BETWEEN THE SOURCE
;AND DESTINATION. IF THEY ARE DIFFERENT, GO OFF TO SHIFT THE SOURCE.

	LDB Q1,[POINT 6,A,5]	;get source P field, assume local
	SKIPE OWGBSF		;was source a OWGBP ?
	LOAD Q1,OWGPS,(Q1)	;yes. get byte position.
	LDB Q3,[POINT 6,B,5]	;get target P field, assume local
	SKIPE OWGBTF		;was destinaion a OWGBP ?
	LOAD Q3,OWGPS,(Q3)	;yes. get byte position.
	SUB Q1,Q3		;the difference
	ANDI Q1,77		;in 6 bits
	JUMPN Q1,BYTBL1		;Move word at a time
	;..
;THE BYTE SIZES MATCH, AND THE ALIGNMENTS WITHIN THE WORDS
;MATCH, SO BLT THE DATA FROM SOURCE TO DESTINATION.

	;..
	DMOVEM A,TEMPA		;SAVE A-C
	MOVEM C,2+TEMPA
	AOS Q3,B		;CALCULATE DESTINATION ADDRS
	SKIPN OWGBTF		;OWGBP target ?
	IFSKP.
	  MOVE C,Q3		;yes
	  TLZ C,770000		;addr is in low 30 bits, no index or indirect
	ELSE.
	  TLZ Q3,777740		;NO. SAVE EFFECTIVE ADDRESS
	  TXO Q3,<XMOVEI C,>	;CONS INSTRUCTION
	  XCT DMVITB(P5)	;GET ADDRS
	ENDIF.
	AOS Q3,A		;CALCULATE SOURCE ADDRS
	SKIPN OWGBSF		;OWGBP source ?
	IFSKP.
	  MOVE B,Q3		;yes.
	  TLZ B,770000		;address is in low 30 bits, no index or indirect
	ELSE.
	  TLZ Q3,777740		;NO. SAVE EFFECTIVE ADDRESS
	  TXO Q3,<XMOVEI B,>	;BUILD INSTR
	  XCT SMVITB(P5)	;GET ADDRS
	ENDIF.
	MOVE A,Q2		;NUMBER OF WORDS TO MOVE
	ADDM Q2,TEMPA		;UPDATE SRC / DEST POINTERS
	ADDM Q2,1+TEMPA
	MOVX Q2,TRPSTK		;SET FLAG IN TRPDSP
	IORM Q2,TRPDSP		; TO SAY WE LEFT BYTBLT
	XCT BLTTB(P5)		;CORRECT BLT ROUTINE
	MOVX A,TRPSTK		;TURN OFF FLAG
	ANDCAM A,TRPDSP		; TO SAY WE'RE BACK
	DMOVE A,TEMPA		;RESTORE REGS
	MOVE C,2+TEMPA		;...

;TRANSFER THE REMAINING (PRESUMABLY FEW) BYTES ONE AT A TIME

BYTLP:	JUMPLE C,DONE		;Do rest a byte at a time
BYTLP1:	XCT LDBTB(P5)
	XCT DPBTB(P5)
	SOJG C,BYTLP1
DONE:	MOVE Q1,BYTSKP		;RETURN # BYTES SKIPPED
	MOVE Q3,SAVQ3		;RESTORE PERMANENT ACS
	MOVE P3,SAVTDS		;RESTORE
	MOVEM P3,TRPDSP
	MOVE P3,SAVP3
	MOVE P5,SAVP5
	MOVE P6,SAVP6
	RET

;HERE ON ANY ILLEG MEM REF IN BYTBLT

BYTERR:	MOVE Q1,TRPDSP		;CHECK TRPDSP TO SEE
	TXNE Q1,TRPSTK		; IF FLAG WAS SET
	ADJSP P,-1		;IT WAS - ADJUST STACK
	SETZM TRPDSP		;ZERO IT
	JRST DONE		;NOTHING SPECIAL, JUST QUIT
;HERE WHEN BYTE SIZES MATCH BUT ALIGNMENT OF BYTES WITHIN
;WORDS DIFFERS. SHIFT THE SOURCE TO LINE UP WITH THE DESTINATION
;AND COPY A WORD AT A TIME.

; T1/ SOURCE POINTER
; T2/ DESTINATION POINTER
; Q1/	POSITION OFFSET (RIGHT SHIFT AMOUNT)
; Q2/	WORD COUNT
; P5/ KIND OF TRANSFER (FROM T4 ON ENTRY)
; Bytrem/ lsh amount to right justify first word

BYTBL1:	HRLI P3,PROTO		;LOAD PROTO PROGRAM ONTO STACK
	HRRI P3,PRG
	BLT P3,LPRG-1+PRG
	DMOVEM B,1+TEMPA	;SAVE B AND C

;SET UP THE SOURCE ADDRESS

	MOVE Q3,A		;COPY POINTER (SOURCE)
	SKIPN OWGBSF		;OWGBP source ?
	IFSKP.
	  MOVE B,Q3		;yes.
	  TLZ B,770000		;addr is in low 30 bits, no index or indirect
	ELSE.
	  TLZ Q3,777740		;NO. CLEAR ALL BUT EFFECTIVE ADDRS
	  TXO Q3,<XMOVEI B,>	;BUILD INSTR
	  XCT SMVITB(P5)	;GET ADDRS
	ENDIF.

;FIX LSH INSTRUCTIONS TO SHIFT OUT THE BITS THAT ARE TO THE
;RIGHT OF THE LAST BYTE

	HRR P3,BYTREM		;Fill in shift amount to left justify
	HRRM P3,4+PRG		;STORE IN PROGRAM
	MOVNS BYTREM		;Get right shift amount
	HRR P3,BYTREM		;Fill in LSH
	HRRM P3,2+PRG		;...

;FIGURE OUT WHICH WAY TO DO THE COMBINED SHIFT AND WHICH AC TO
;STORE FROM

	MOVNS Q1		;NEGATE OFFSET
	ADD Q1,BYTREM		;Total right shift = offset + remainder
	MOVE P3,4+PRG		;GET LSH INSTRUCTION
	MOVE P6,5+PRG		;AND MOVEM INST
	CAMG Q1,[-^D18]		;Less than half a word?
	TLCA P3,(<Z Q1^!Q2,0>)	;Change ac of lsh from Q1 to Q2
	TLCA P6,(<Z Q1^!Q2,0>)	;No, change ac of MOVEM to Q1
	ADDI Q1,^D36		;Leave movem Q1, change shift amount
	MOVEM P3,4+PRG		;RESTORE NEW LSH INST
	HRRM Q1,3+PRG		;Fill in lshc amount
	MOVEM P6,5+PRG		;PUT BACK THE FIXED MOVEM

;FIX UP THE DESTINATION POINTER

	MOVE Q3,1+TEMPA		;POINTER TO DESTINATION
	SKIPN OWGBTF		;OWGBP target ?
	IFSKP.
	  MOVE C,Q3		;yes.
	  TLZ C,770000		;addr is in low 30 bits, no index or indirect
	ELSE.
	  TLZ Q3,777740		;NO. CLEAR ALL BUT EFFECTIVE ADDRS
	  TXO Q3,<XMOVEI C,>	;BUILD INSTR
	  XCT DMVITB(P5)	;GET ADDRS
	ENDIF.
	AOS C			;START STORING IN SECOND WORD
	;..
;UPDATE THE SOURCE AND DESTINATION POINTERS FOR RETURN TO THE CALLER

	;..
	ADDM Q2,1+TEMPA		;Update target
	ADDM Q2,A		;And source

;IF TRANSFER INVOLVES USER, CHANGE PROTOTYPE PROGRAM TO DUE
;XCTU'S INSTEAD OF MOVE'S AND MOVEM'S

	TRNE P5,2		;IS THIS FROM "USER"?
	JRST [	MOVE Q3,[XCTU Q3]
		EXCH Q3,0+PRG	;YES, SET UP XCT INST INSTEAD
		MOVE P6,[XCTU P6]
		EXCH P6,1+PRG
		JRST .+1]
	TRNE P5,1		;IS THIS TO "USER"?
	JRST [	MOVE P3,[XCTU P3]
		EXCH P3,5+PRG	;YES, SET UP PROPER XCT INST
		JRST .+1]
	MOVEM A,TEMPA		;Want to use A for AOBJN
	MOVNS Q2		;Make aobjn
	HRLZ A,Q2		;word in A
	JRST PRG		;Do the program, return to done

;PROGRAM ON STACK COMES HERE WHEN DONE

BYTLPD:	MOVE A,TEMPA		;RESTORE SOURCE POINTER
	DMOVE B,1+TEMPA		;RESTORE B AND C
	JRST BYTLP		;Finish up any odd bytes
; Transfer til terminator OR DISCARD LINE NUMBERS

CHKTR0:	XCT LDBTB(P5)		;OUT WITH THE BAD BYTE, IN WITH THE GOOD BYTE
CHKTR1:	AOS BYTSKP		;BUT REMEMBER IT AS A BYTE WE SKIPPED
CHKTRM:	JUMPLE C,DONE
	JUMPLE Q2,[TQO FEEDME	;ALSO END WHEN SOURCE RUNS OUT
		JRST DONE]
	XCT LDBTB(P5)
	SOJ Q2,			;REMEMBER WE GOT IT
	TQNN <XFRLSN>		;PASSING LINE NUMBERS?
	JRST CHKLIN		;NOPE, CHECK THIS ONE
STOBYT:	CAMN Q1,TRMBYT
	JRST [	TQZN <XFR2TM>	;TELL CALLER WE GOT THE TERMINATOR
		JRST .+1	;BUT HE'S NOT INTERESTED IN THE FIRST PLACE,
				;  AND ONLY WANTS TO DISCARD LINE #S
		TQNN <XFRTRM>	;TRANSFER TERMINATOR?
		JRST DONE	;NO, SAY WE DIDN'T COPY IT
		XCT DPBTB(P5)
		SOJA C,DONE]
STOBT1:	XCT DPBTB(P5)
	SOJA C,CHKTRM		;TRY FOR SOME MORE

CHKLIN:	JUMPE Q1,CHKTR1		;DISCARDING, THEREFORE DISCARD NULLS
	LDB Q3,[POINT 12,A,11]	;IS THIS THE FIRST BYTE OF A WORD?
	CAIL Q2,4		;AND ARE THERE ENOUGH DATA TO BE A LINE #?
	CAIE Q3,<POINT 7,0,6>_-^D24;YES, FIRST CHARACTER?
	JRST STOBYT		;NO TO EITHER, MUST BE REAL DATA
	PUSH P,A		;SAVE A
	HRRZS A			;ELIMINATE BYTEPOINTER BITS
	XCT MOVETB(P5)		;GET THE WORD
	POP P,A			;RESTORE A
	TXNN Q3,1B35		;IF BIT 35 ON, THEN A LINE #
	JRST STOBYT		;OTHERWISE JUST VALID DATA
	SUBI Q2,5		;SKIP THE REST OF THE WORD AND TAB QUICKLY
	TXZ A,77B5		;"READ" THE 4 CHARS
	MOVEI Q3,5		;REMEMBER WE JUST FORGOT 5 CHARACTERS
	ADDM Q3,BYTSKP
	JUMPGE Q2,CHKTR0	;IF ANY LEFT, GO DISCARD THE TAB AFTER THE LSN
	TQO <DISCRD,FEEDME>	;NONE THERE - MUST LET CALLER
	JRST DONE		;  DISCARD IT FOR US
;HERE WHEN CALLER WANTS CR-LF ADDED TO DESTINATION STRING.

CHKCRL:	TQZE <DCRNXT>		;TIME FOR A CR?
	JRST [	MOVEI Q1,.CHCRT	;YES, LOAD ONE UP
		XCT STOBT1	;STASH BYTE
		SOJG C,.+1	;IF MORE BYTES DO LF NOW
		TQO <DLFNXT>	;SAY THAT LF NEEDED NEXT
		JRST DONE]	;AND GIVE UP FOR NOW
	TQZ <DLFNXT>		;CLEAR LF NEEDED FLAG
	MOVEI Q1,.CHLFD		;GET A LF
	TQO <DFRSTF>		;REMEMBER THAT THIS RECORD HAS BEEN FROSTED
	XCT STOBT1		;STASH IT
	SOJA C,DONE		;AND DONE
; Instruction tables for different mapping modes
; 00 -- monitor to monitor
; 01 -- monitor to user
; 10 -- user to monitor
; 11 -- user to user

LDBTB:	ILDB Q1,A
	ILDB Q1,A
	XCTBU LDBTB
	XCTBU LDBTB

DPBTB:	IDPB Q1,B
	XCTBU DPBTB
	IDPB Q1,B
	XCTBU DPBTB

BLTTB:	CALL XBLTA
	CALL BLTMU
	CALL BLTUM
	CALL BLTUU

SMVITB:	XCT Q3			;FROM MONITOR
	XCT Q3			; SAME
	XCTUU Q3		;FROM USER
	XCTUU Q3		; SAME

DMVITB:	XCT Q3			;TO MONITOR
	XCTUU Q3		;TO USER
	XCT Q3			;TO MONITOR
	XCTUU Q3		;TO USER

MOVETB:	MOVE Q3,(A)		;FROM MONITOR
	MOVE Q3,(A)		;DITTO
	XCTU MOVETB		;FROM USER
	XCTU MOVETB		;DITTO
;for XFER36 and XFER8 routines
DMVTB:	MOVEM Q2,(T2)		;TO MONITOR
	UMOVEM Q2,(T2)		;TO USER
	MOVEM Q2,(T2)		;TO MONITOR
	UMOVEM Q2,(T2)		;TO USER

DMV1TB:	ORM Q2,(T2)		;TO MONITOR
	XCTU DMV1TB		;TO USER
	ORM Q2,(T2)		;TO MONITOR
	XCTU DMV1TB		;TO USER

SMVTB:	MOVE Q2,(T1)		;FROM MONITOR
	MOVE Q2,(T1)		; SAME
	UMOVE Q2,(T1)		;FROM USER
	UMOVE Q2,(T1)		; SAME
; Prototype byte blt program
; Note that address designated by .-. are filled in at run time
; also, the LSH and MOVEM instructions at PROTO +4 and +5 have their
; ac fields modified depending on where the LSHC is made to shift right
; or left.  Only one of these instructions is modified in either case
; thus the two instruction end up using Q1 if shift left and Q2 if right
; Furthermore, the MOVE's and MOVEM's may be changed to UMOVE or
; UMOVEM's depending on the address space of A and B respectively

PROTO:	MOVE Q1,(B)		;Note most rh's are filled at run time
	MOVE Q2,1(B)		;Pick up next word
	LSH Q1,.-.		;Right justify first word
	LSHC Q1,.-.		;Shift to target position+unused bits
	LSH Q2,.-.		;Shift back to clear unused bits
	MOVEM Q1,(C)		;Store
	AOS B
	AOS C
	AOBJN A,PRG		;Loop
	JRST BYTLPD		;Done
LPRG==.-PROTO

	ENDSV.
;routine to move bytes a la BYTBLT, but preserving Q1 & Q2, and sets
; a mode bit so it will go fast.
;CALL BZTBLT
; T1/ source pointer
; T2/ target pointer
; T3/ byte count
; T4/ mode bits as defined at start of listing
; returns +1 with T1-T3 updated.
BZTBLT::SAVEAC <Q1,Q2>
	SETZB Q1,Q2
	TQO <XFRLSN>		;copy line #s
	CALL BYTBLT
	RET
;move a 36-bit block of data into an 8-bit byte string
;CALL XFER36
;T1/ source addr
;T2/ destination 8-bit byte pointer
;T3/ word count
;T4/ mode
;T4 is preserved.
;returns +1 on failure, with error in T1
;returns +2 on success, with
;T1/ source addr updated
;T2/ destination byte pointer updated
;NOTE if an odd # of words are transferred the low order 4 bits of the last
;     8-bit byte will be zero.
XFER36::STKVAR <EXTRA,MODE,PTR,NBLCKS>
	CALL ALIGNX		;transfer until source & destination are word
				;aligned
	 RET       		;bad byte pointer
	MOVEM T4,MODE		;grab temp
	MOVE T4,T3		;compute # of words left over after
	ANDX T4,7		; the transfer of the blocks
	MOVEM T4,EXTRA
	LSH T3,-3		;# of blocks to transfer (c.f. BLTTV)
	MOVEM T3,NBLCKS		;save it.
	IMULI T3,^D36		;# of 8-bit bytes to transfer
	MOVEM T2,PTR		;current dest. byte pointer
	MOVE T2,T3 		;compute what the dest byte pointer
	ADJBP T2,PTR		; should be after the blocks are transferred
	EXCH T2,PTR		;save that in PTR, get the current b.p. in T2
	MOVE T3,NBLCKS		;get # of blocks to transfer
	MOVE T4,MODE		;get mode of transfer
	CALL BLTTV		;transfer blocks
	MOVE T2,PTR		;get the now accurate byte pointer
	MOVE T3,EXTRA		;and the # of words left over
	CALL B368		;transfer those remaining words
	RETSKP
	ENDSV.
;transfer words to 8-bit byte string until none are left or
;the source and destination are word aligned
;CALL ALIGNX
;T1/ source addr
;T2/ destination byte pointer
;T3/ word count
;T4/ mode
;T4 is preserved.
;returns +1 on failure, (bad byte pointer)
;returns +2 on success with
;T1/ updated source addr
;T2/ updated destination byte pointer
;T3/ updated word count
ALIGNX:	STKVAR <ADDR,PTR,WRDLFT>
	MOVEM T1,ADDR		;save source addr
	MOVE T1,T2		;get byte pointer into T1
	CALL GETSIZ		;check byte size
	CAIE T1,10		;is it eight ?
	RET			;no. fail.
	MOVE T1,T2 		;calculate # of words to transfer
	CALL GETPOS		;to get alignment
	CAIL T1,10		;is byte position less than eight
	CAIN T1,44		; AND not equal to thirty-six ?
	IFSKP.
	  LSH T1,-3		;yes. must transfer some words. calculate :
	  LSH T1,1		; (# of bytes left in current target word)*2
	  CAMG T1,T3		;is that more than we have ?
	  IFSKP.
	    SETZM WRDLFT	;yes. there is nothing left.
	  ELSE.
	    SUB T3,T1		;no. calculate how many words will be left.
	    MOVEM T3,WRDLFT	;save it
	    MOVE T3,T1		;# of words to transfer in T3
	  ENDIF.
	  MOVE T1,ADDR		;restore source addr
	  CALL B368		;move those words
	  MOVE T3,WRDLFT	;restore remaining word count
	ELSE.
	  MOVE T1,ADDR		;no. restore source addr
	ENDIF.
	RETSKP
;moves blocks of words into an 8-bit byte string, assuming that
;the dest. byte string is starting on a word boundary.
;CALL BLTTV
;T1/ source addr
;T2/ dest 8-bit byte pointer
;T3/ # of blocks of words (8 words / block)
;T4/ mode
;preserves T4
;returns +1 always,
; with T1/ updated source addr
BLTTV:	SAVEAC <Q1,Q2,Q3>
	EXCH T1,T2		;convert byte pointer
	CALL PTRADR		; to address
	 TRN			;shouldn't happen
	EXCH T1,T2		;restore args
	TRNE T4,1		;destination = monitor ?
	IFSKP.
	  SETZM (T2)		;yes. init first dest word
	ELSE.
	  XCTU [SETZM (T2)]	;no. init first dest word
	ENDIF.
;outer loop
BLTTVA: MOVEI Q1,40		;initialize bit split
;inner loop
BLTTVB:	XCT SMVTB(T4)		;get source word into Q2
	SETZ Q3,		;zero 2nd source word
	AOS T1			;update source index
	LSHC Q2,-44(Q1)		;split source word
	LSH Q2,4		;left justify first part
	XCT DMV1TB(T4)		;finish this dest. word - ORM Q2,(T2)
	AOS T2			;update dest index
	MOVE Q2,Q3		;get second part (of split word)
	XCT DMVTB(T4) 		;start next dest. word - MOVEM Q2,(T2)
	SUBI Q1,4		;update bit split
	CAIE Q1,0 		;done with this chunk ?
	JRST BLTTVB		;no. continue
;end of inner loop
	AOS T2			;update dest index
	SOJG T3,BLTTVA		;do next block
;end of outer loop
	RET			;done
;move words into an 8-bit byte string (slowly)
;CALL B368
;T1/ source addr
;T2/ dest. byte pointer
;T3/ word count
;T4/ mode of transfer
;T4 is preserved.
;returns +1 always with
;T1/ updated source addr
;T2/ updated byte pointer
B368: 	SAVEAC <Q1,Q2,Q3>
B368A:	SKIPG T3		;anything left to do ?
	RET			;no.
	CALL B368D   		;get next word into Q2
	 RET			;none left.
	CALL B368B		;move 32 bits of it to destination
	ROTC Q1,4		;get the low order 4 bits into Q1
	CALL B368D		;get next word into Q2
	IFNSK.
	  LSH Q1,4		;no more words. shift over those 4 bits,
	  XCT DPBTB(T4)		;put into destination string. - IDPB Q1,T2
	  RET			;all done
	ENDIF.
	ROTC Q1,4		;get high 4 bits around into Q1
	XCT DPBTB(T4)		;put into destination string. - IDPB Q1,T2
	CALL B368B		;move next 32 bits into dest. string
	JRST B368A		;continue

;move the leftmost 32 bits of Q2 into the string pointed to by T2
;returns +1 always
B368B:	MOVEI Q3,4		;loop counter
B368C:	ROTC Q1,10		;get 8 bits into Q1
	XCT DPBTB(T4)		;deposit - IDPB Q1,T2
	SOJG Q3,B368C		;loop
	RET

;get the next word into Q1
;returns +1 on failure (no more words)
;returns +2 on success with T1 & T3 updated
B368D:	SOSGE T3		;any left ?
	RET			;no.
	XCT SMVTB(T4)		;yes. get next - MOVE Q1,(T1)
	AOS T1			;update source addr
	RETSKP
;pack an 8 bit byte string into 36 bit words
;T1/ source byte pointer
;T2/ dest addr
;T3/ byte count
;T4/ mode of transfer
;preserves T4
;returns +2 on success
;returns +1 on failure, (bad byte pointer)
XFER8::	STKVAR <EXTRA,MODE,PTR>
	CALL ALIGN		;alignment
	 RET
	MOVEM T4,MODE		;save mode
	IDIVI T3,44		;compute # of blocks -
				;4 bytes/word, 11 words/block
	MOVEM T4,EXTRA		;save left over byte count
	MOVE T4,T3		;calculate what source byte pointer should
	IMULI T4,44		; be after the
	ADJBP T4,T1		;  transfer of the blocks
	MOVEM T4,PTR		;and save it.
	MOVE T4,MODE		;get mode
	CALL BLTVT		;transfer blocks
	MOVE T1,PTR		;restore the now accurate source byte pointer
	MOVE T3,EXTRA		;transfer the left over bytes
	CALL B836
	RETSKP
;packs 32 bit bytes into 36 bit words in blocks of nine / eight
;CALL BLTVT
;T1/ source byte pointer
;T2/ dest addr
;T3/ # of blocks
;T4/ mode
;preserves T4
;returns +1 always,
; with T2/ updated dest addr
BLTVT:	SAVEAC <Q1,Q2,Q3>
	SAVEAC <P3>
	SKIPG T3		;anything to do ?
	RET			;no. return.
	CALL PTRADR		;convert byte pointer to address
	RET			;bad byte pointer, should never happen
;outer loop
BLTVT1:	XCT SMVTB(T4)		;transfer first 32 bits
	XCT DMVTB(T4)
	AOS T1			;update source index
        MOVEI P3,4 		;initialize bit split
BLTVT2:	XCT SMVTB(T4)		;get source word
	SETZ Q3,		;zero 2nd source word
	AOS T1			;update source index
	LSHC Q2,-44(P3)		;split source word
	XCT DMV1TB(T4)		;finish this dest. word
	AOS T2			;update dest index
	MOVE Q2,Q3		;get second part of split
	XCT DMVTB(T4)		;start next dest. word
	ADDI P3,4		;update bit split
	CAIE P3,40		;done with this chunk ?
	JRST BLTVT2		;no. continue
;end of inner loop
	XCT SMVTB(T4)		;get source word
	LSH Q2,-4		;slide it over
	AOS T1			;update source index
	XCT DMV1TB(T4)		;put it in
	AOS T2			;update dest index
	SOJG T3,BLTVT1		;if more to do, continue
;end of outer loop
	RET			;done
;pack 8 bit bytes into 36 bit words until source & destination are
; word aligned, or until there are no more bytes
;CALL ALIGN
;T1/ source byte pointer
;T2/ dest addr
;T3/ byte count
;T4/ mode
;preserves T4
;returns +2 on success
; with T1/ updated source byte pointer
; and  T2/ addr of next dest word
; and  T3/ # of bytes left.
;returns +1 on failure (bad byte pointer)
ALIGN:	STKVAR <PTR,BYTLFT>
	MOVEM T1,PTR		;save
	CALL GETSIZ		;is byte
	CAIE T1,10		; size legal ?
	RET                   	;no. failure.
	MOVE T1,PTR		;calculate how many
	CALL GETPOS		; byte must be transferred to align.
	CAIL T1,10		;is byte position < eight AND
	CAIN T1,44		; not equal to 36 ?
	IFSKP.
	  LSH T1,-3		;yes. calculate # of bytes left in current word
	  IMULI T1,^D9		;# to transfer = 9*that
	  CAML T3,T1		;is that more than we have ?
	  IFSKP.
	    SETZM BYTLFT	;yes. send all we have. nothing left over.
	  ELSE.
	    SUB T3,T1		;no. calculate left over bytes.
	    MOVEM T3,BYTLFT	;save it.
	    MOVE T3,T1		;get # of bytes to transfer.
	  ENDIF.
	  MOVE T1,PTR		;restore source byte pointer
	  CALL B836		;move those bytes
	  MOVE T3,BYTLFT	;restore leftover byte count
	ELSE.
	  MOVE T1,PTR		;no. no bytes to transfer. restore byte pointer
	ENDIF.
	RETSKP
	ENDSV.
;pack 8 bit bytes into 36 bit words (slowly)
;CALL B836
;T1/ source byte pointer
;T2/ dest addr
;T3/ byte count
;T4/ mode
;preserves T4
;returns +1 always with
;T1/ source byte pointer updated
;T2/ dest addr updated
B836: 	SAVEAC <Q1,Q2,Q3>	;note Q3 used in the LSHC Q2,xxx
	SAVEAC <P3>		;P3 used in B836B
B836A:	SKIPG T3		;anything left to do ?
	RET			;no. return
       	SETZ Q3,		;the word we build
        CALL B836B		;transfer 4 bytes
	 RET			;ran out, all is done
	CALL B836D		;get next byte
	IFNSK.
	  LSH Q3,4		;none to get, shift the word over 4
	  XCT DMVTB(T4)		;put it in the destination
	  RET
	ENDIF.
	LSHC Q1,-4		;split the byte
	LSH Q3,4		;shift the word
	OR Q3,Q1		;put the 4 MSB of the byte in the 4 LSB of the
	XCT DMVTB(T4)		;word, and put the word in the destination
	AOS T2			;update destination index
	LSHC Q1,4		;get back the byte.
	MOVE Q3,Q1		;start the next word (don't worry about the
				;high 4 bits, they'll be shifted out)
	CALL B836B		;transfer 4 bytes
	 RET             	;ran out of bytes, all is done.
	XCT DMVTB(T4)		;put the word in the destination.
	AOS T2			;update destination index
	JRST B836A		;continue
	;...
	;...
;get 4 bytes into Q3, if possible. return +2 if 4 bytes were moved into Q3
;if not, shift Q3 by the amount it would be if 4 bytes were moved, and place
;Q3 in destination, and return +1
B836B:	MOVEI P3,4
B836C:	CALL B836D		;get a byte into Q1
	IFSKP.
	  LSH Q3,10		;got it. shift word over.
	  OR Q3,Q1		;put byte into word.
	  SOJG P3,B836C		;loop.
	  RETSKP		;did all four bytes.
	ELSE.
	  LSH P3,3		;no more bytes. calculate the remaining
				;shift for the word
	  LSH Q3,(P3)		;do it.
	  XCT DMVTB(T4)		;put word in destination
	  RET			;didn't do all 4 bytes
	ENDIF.

;get next byte into Q1, return +2 if there was a byte, +1 if none
B836D:	SOSGE T3		;any bytes left ?
	RET			;no.
	XCT LDBTB(T4)		;yes. get one.
	RETSKP
;convert byte pointer to address
;CALL PTRADR
;T1/ byte pointer
;returns +1 on failure (invalid byte pointer)
;returns +2 on success with address where the next byte would go in T1
; that is, the address in the pointer, except when the position of the
; pointer is less than the byte size.
;preserves all ACs except T1
PTRADR:	STKVAR <PTR,SIZE>
	MOVEM T1,PTR		;save byte pointer
	CALL GETSIZ		;get byte size
	MOVEM T1,SIZE		;save it
	MOVE T1,PTR		;get byte pointer
	CALL GETPOS		;get byte position
	CAIN T1,77		;illegal ?
	RET			; yes.
	CAMGE T1,SIZE		;is it at the end of the word ?
	AOS PTR			;yes. bump byte pointer
	LDB T1,[POINT 6,PTR,5]	;is byte pointer
	CAIGE T1,45		; global ?
	IFSKP.
	  MOVE T1,PTR		;yes. addr is in low 30 bits.
	  TLZ T1,770000
	ELSE.
	  HRRZ T1,PTR		;no. addr is in low 18 bits
	ENDIF.
	RETSKP
;SPECIAL ROUTINE USED BY DECNET SERVICE TO MOVE DATA BETWEEN
;NETWORK BUFFERS AND JFN BUFFERS. IT IS MERELY AN INTERFACE TO
;BYTBLT.
;ACCEPTS:	T1/ SOURCE POINTER
;		T2/ DESTINATION POINTER
;		T3/ COUNT
;RETURNS WITH ALL REGS UPDATED AS DESCRIBED IN BYTBLT COMMENTS

NETMOV::SAVEQ			;SAVE PERMANENT REGS
	MOVX D,XFRLSN		;PASS LINE NUMBERS AND MONITOR-TO-MONITOR
	CALLRET BYTBLT		;AND DO IT


;ATSMOV - SPECIAL ROUTINE USED BY ATS SERVICE TO MOVE DATA BETWEEN
;MONITOR BUFFER AND USER BUFFER.

;ACCEPTS:
;	T1/ SOURCE POINTER
;	T2/ DESTINATION POINTER
;	T3/ COUNT
;RETURNS WITH ALL REGS UPDATED AS DESCRIBED IN BYTBLT COMMENTS

ATSMOV::SAVEQ			;SAVE PERMANENT REGS
	MOVX D,XFRLSN!BBLTMU	;PASS LINE NUMBERS AND MONITOR-TO-USER
	CALLRET BYTBLT		;AND DO IT
   REPEAT 0,<			;HISTORICAL CODE NO LONGER USED
; Dump io
; Parameters and variables

RS(DMPASW)			;Dump buffer assignment word
RS(DMPCNT)			;Dump buffer free count
RS(DMPLCK)			;Dump buffer assignment lock

; Initialize dump io

DMPINI::MOVEI A,NDUMP
	MOVEM A,DMPCNT
	SETOM DMPLCK
	SETCM A,[-1_<^D36-NDUMP>]
	MOVEM A,DMPASW
	SETZ A,
	MOVEI B,DMPBUF
	MOVEI C,NDUMP
	CALL MSETMP		;MAKE SURE ALL PAGES INITIALLY CLEAR
	RET

   >				;END OF REPEAT ZERO ON HISTORICAL CODE


; Dump input
; Call:	1	;Jfn
;	2	;Pointer to first command
;	DUMPI
; Return
;	+1	;Error
;	+2	;Ok

.DUMPI::MCENT
	MOVEI P6,[TQNN <READF> ;Executed to discover file access
		IOX1		;Error number for no read access
		CALL @DMPID(P3) ; Device dependent routine dispatch
		040400000000]	;Memory access needed
DUMPI1:	CALL DMPCKJ		;CHECK THE JFN FOR LEGALITY
	 RETERR ()		;NOT A VALID JFN
	CALL @JFNID(P3)		;INIT JFN FOR INPUT
	UMOVE A,2		;GET IOWD FOR SERVICE ROUTINE
	UMOVE A,(A)		;GET COMMAND
	JUMPE A,DUMPI3		;ZERO MEANS ALL DONE
	TLNN A,-1		;GO TO COMMAND?
	JRST DUMPI4		;YES - HANDLE XFER COMMAND
	XMOVEI C,DUMPB		;DUMP BLOCK CO-ROUTINE
	CALL @DMPID(P3)	;DO THE DEVICE DEPENDENT STUFF
	 JRST DUMPIW		;SEE IF WE NEED TO BLOCK
	XCTU [AOS A,2]		;STEP THE IOWD
	UMOVE A,(A)		;GET NEXT COMMAND
	JUMPE A,DUMPI3		;DONE IF ZERO
	TLNN A,-1		;XFER COMMAND?
	JRST DUMPI4		;YES - HANDLE
	CALL UNLCKF		;UNLOCK IN CASE OF COMMAND LIST LOOPS
	JRST DUMPI1		;LOOP

DUMPI3:	CALL UNLCKF		;UNLOCK THE JFN
	SMRETN			;AND GIVE SUCCESSFUL RETURN

DUMPI4:	XCTU [HRRM A,2]		;STORE NEW ADDRS
	CALL UNLCKF		;UNLOCK JFN
	JRST DUMPI1		;START OVER

DUMPIW:	TQZE <XQTAF>		;EXCEEDED QUOTA?
	RETERR (IOX11,<CALL UNLCKF>) ;YES -RETURN ERROR
	TQNE <EOFF>		;EOF DETECTED?
	RETERR (IOX4,<CALL UNLCKF>) ;YES. SO NOTED
	TQZN <BLKF>		;NEED TO BLOCK?
	RETERR (,<CALL UNLCKF>)	;NO, ERROR
	CALL UNLDIS		;GO DISMIS
	JRST DUMPI1		;TRY AGAIN
; Dump output
; Call:	1	;Jfn
;	2	;Pointer to first command
;	DUMPO
; Return
;	+1	;Error
;	+2	;Ok

.DUMPO::MCENT
	MOVEI P6,[TQNN <WRTF>
		IOX2
		CALL @DMPOD(P3)
		100000000000]	;Memory access needed
DUMPO1:	CALL DMPCKJ		;CHECK THE JFN FOR LEGALITY
	 RETERR ()		;NOT A VALID JFN
	CALL @JFNOD(P3)		;INIT JFN FOR OUTPUT
	UMOVE A,2		;GET IOWD FOR SERVICE ROUTINE
	UMOVE A,(A)		;GET COMMAND
	JUMPE A,DUMPO3		;ZERO MEANS ALL DONE
	TLNN A,-1		;GO TO COMMAND?
	JRST DUMPO4		;YES - HANDLE
	XMOVEI C,DUMPB		;DUMP BLOCK CO-ROUTINE
	CALL @DMPOD(P3)	;DO THE DEVICE DEPENDENT STUFF
	 JRST DUMPOW		;SEE IF WE NEED TO BLOCK
	XCTU [AOS A,2]		;STEP THE IOWD
	UMOVE A,(A)		;GET NEXT COMMAND
	JUMPE A,DUMPO3		;EXIT IF ZERO
	TLNN A,-1		;SEE IF XFER COMMAND
	JRST DUMPO4		;YES - HANDLE
	CALL UNLCKF		;UNLOCK IN CASE OF COMMAND LIST LOOPS
	JRST DUMPO1		;SEE IF MORE TO BE DONE

DUMPO3:	CALL UNLCKF		;UNLOCK THE JFN
	SMRETN			;AND GIVE SUCCESSFUL RETURN

DUMPO4:	XCTU [HRRM A,2]		;STORE NEW ADDRS
	CALL UNLCKF		;UNLOCK JFN
	JRST DUMPo1		;START OVER
DUMPOW:	TQZE <XQTAF>		;EXCEEDED QUOTA?
	RETERR (IOX11,<CALL UNLCKF>) ;YES - RETURN ERROR
	TQZN <BLKF>		;NEED TO BLOCK?
	RETERR (,<CALL UNLCKF>)	;NO, ERROR
	CALL UNLDIS		;GO DISMIS
	JRST DUMPO1		;TRY AGAIN
;ROUTINE TO CHECK THE JFN ARGUMENT ON A DUMPI/O JSYS

DMPCKJ:	UMOVE JFN,1		;GET THE JFN
	CALL CHKJFN		;CHECK IT
	 RETBAD ()
	 JFCL
	 RETBAD (DESX4)
	TQNN <OPNF>		;DEVICE OPENED?
	RETBAD (DESX5,<CALL UNLCKF>)
	TRC STS,17		;OPENED IN DUMP MODE?
	TRCE STS,17
	RETBAD (DUMPX2,<CALL UNLCKF>)	;NO
	UMOVE B,2
	TXNE B,DM%NWT		;NO-WAIT REQUESTED?
	TQOA <NWTF>		;YES, PASS ON BIT
	TQZ <NWTF>		;NO
	RETSKP			;JFN IS GOOD

;DUMP MODE BLOCK CO-ROUTINE

DUMPB:	STKVAR <SAVDEV>		;SAVE DEV
	MOVEM DEV,SAVDEV
	CALL UNLDIS		;UNLOCK JFN
	UMOVE JFN,1		;RESTORE USER ARG
	CALL CHKJFN
	 RETBAD ()
	 JFCL
	 JFCL
	CAME DEV,SAVDEV		;CHECK FOR SAME DEVICE
	RETBAD (DESX4)		;NOPE THIS IS ILLEGAL
	RETSKP			;GOOD RETURN TO PROCEED
   REPEAT 0,<			;HISTORICAL CODE NO LONGER USED
; Dump common code
; A/ ADR OF SERVICE ROUTINE TO CALL TO DO THE WORK
; P6/ PTR TO CONSTANTS NEEDED

DUMPC::	STKVAR <DUMPCA,DIOWD,DAOBW,LT1,LT2,LT3>
	MOVEM A,DUMPCA		;SAVE ADDRESS OF ROUTINE TO CALL
DUMPC0:	UMOVE A,2		;Get command pointer
	TXNE A,DM%FIN		;FINISH-ONLY REQUEST?
	JRST [	SETZM DIOWD	;YES, NO BUFFERS TO SETUP
		SETZM DAOBW
		NOINT
		JRST DMPNOP]
	UMOVE B,(A)		;And command
	JUMPE B,RSKP		;0 IS END OF LIST, RETURN GOOD
	JUMPG B,[XCTU [HRRM B,2] ;BRANCH CMND, SET NEW LIST ADR
		JRST DUMPC0]	;CONTINUE WITH LIST
	MOVEM B,DIOWD		;IOWD FOR COMMAND - SAVE IT
	HLRE A,B		;- word count
	MOVNS A			;Word count
	ADDI A,(B)		;Last address
	CAILE A,777777		;Must not cross end of memory
	RETBAD(DUMPX3)		;ERROR IF HAPPENS
	MOVEI B,1(B)		;First address
	LSH A,-PGSFT		;Last page number
	LSH B,-PGSFT		;First page number
	SUBM B,A
	SOS A			;-# pages
	CAMGE A,[-NDUMP]
	RETBAD(DUMPX3)		;TOO MANY PAGES
	NOINT
DMPSE0:	LOCK DMPLCK,<CALL LCKTST>
	MOVSI B,400000
	ASH B,1(A)		;Get a one for each page needed
	HRLZ C,A		;Initial aobjn word
	MOVE P3,DMPCNT		;SAVE CURRENT AVAILABLE COUNT
DMPSE1:	TDNN B,DMPASW		;Are these contiguous buffers free
	JRST DMPSE2		;Yes, assign them
	ROT B,-1		;No, try next set
	AOS C			;Modify aobjn word
	JUMPGE B,DMPSE1		;When low bit wraps around
	UNLOCK DMPLCK		;COULDN'T GET BUFFERS, RELEASE LOCK
	EXCH A,P3		;SAVE A, GET ORIGINAL DMPCNT
	MOVSI A,0(A)
	HRRI 1,DMPTST
	MDISMS			;Dismiss until buffers released
	MOVE A,P3		;RECOVER A
	JRST DMPSE0		;Then try again
;"AOBJN" WORD STARTS WITH -NPAGES,,MON BFR NUMBER

DMPSE2:	IORM B,DMPASW		;Mark these buffers as taken
	ADDM A,DMPCNT		;Decrement count of free buffers
	UNLOCK DMPLCK
	MOVEM C,DAOBW		;SAVE AOBJN WORD
	HRRZ A,DIOWD		;Get user first address-1
	AOS A
	LSH A,-PGSFT		;Page number

;TOP OF LOOP TO SETUP EACH PAGE IN ONE COMMAND

DMPSE3:	MOVEM A,LT1
	MOVEM C,LT2		;SAVE VULNERABLE ACS
	LSH A,PGSFT			;GET ADDRESS
	XSFM B			;SET FLAGS IN LEFT HALF OF B
	TXNE B,PCU		;PREVIOUS CONTEXT WAS USER?
	HRLI A,(1B0)		;YES
	CALL FPTA		;CONSTRUCT IDENT FOR ADDRESS
DMPSE5:	MOVEM A,LT3		;SAVE IDENT
	CALL MRPACS		;Read access of page
	JUMPE A,[MOVE A,LT1	;Non-existent page, create it
		LSH A,PGSFT
		UMOVE A,(A)	;By referencing it
		MOVE A,LT3
		JRST DMPSE5]
	TDNN A,3(P6)		;Test against needed access
	JRST DMPSE4		;Access not permitted
	TLNN A,(1B6)		;Indirect?
	JRST DMPSE7		;No.
	MOVE A,LT3		;YES, TRACK IT DOWN
	CALL MRPT		;Get id of page pointed to
	 JRST DMPSE5		;Not file, continue
	MOVEM A,LT3		;FILE
	JRST DMPSE6

DMPSE7:	TLNN A,400		;Write copy?
	 JRST DMPSE6		;No.
	MOVE B,3(P6)		;YES, GET ACCESS BITS NEEDED
	TLNN B,40000		;Write?
	 JRST DMPSE6		;No.
	TLNN A,100000		;Yes, can we read?
	 JRST DMPSE4		;No, must fail
	MOVE B,LT1
	LSH B,PGSFT
	XCTU [MOVES 0(B)]	;WRITE IN PAGE TO MAKE IT PRIVATE
	MOVE A,LT1
	MOVE C,LT2
	JRST DMPSE3		;Recompute
DMPSE6:	HRRZ A,LT2		;Get buffer number
	LSH A,PGSFT
	ADDI A,DMPBUF		;Convert to address
	MOVE B,A
	EXCH A,LT3		;Save address, get ptn.pn
	HRLI B,140000
	CALL SETIOP		;MAP AND LOCK PAGE
	 JRST DMPSE4		;FAILED, GIVE UP
	MOVE C,LT2
	MOVE A,LT1		;RESTORE VULNERABLE ACS
	AOS A			;Next page
	AOBJN C,DMPSE3		;LOOP FOR ALL PAGES IN THIS IOWD
	MOVE C,DAOBW		;RECOVER AOBJN WORD
	MOVEI A,DMPBUF		;Do things the hard way cause macro
	ASH A,-PGSFT		;Can't divide externals
	ADDI A,(C)
	AOS DIOWD
	DPB A,[POINT 9,DIOWD,26]; Modify iowd to address monitor buffer
	SOS DIOWD
	;..
; At this point the dump region has been mapped into the monitor
; Buffer region and access checked
; DIOWD has the iowd needed for the data xfer
; DAOBW has the aobjn word needed to restore buffers when finished

DMPNOP:	MOVE A,1(P6)		;GET ERROR CODE
	XCT 0(P6)		;TEST STATUS OF JFN
	 JRST DMPER1
	UMOVE B,2
	TXNE B,DM%NWT		;NO-WAIT REQUESTED?
	TQOA <NWTF>		;YES, PASS ON BIT
	TQZ <NWTF>		;NO
	MOVE A,DIOWD		;GET IOWD
DMPSDO:	CALL @DUMPCA		;CALL DEVICE DEPENDENT ROUTINE
	OKINT
	TQNE <EOFF>
	RETBAD(IOX4)		;FAIL RETURN, EOF
	TQNE <ERRF>
	RETBAD(IOX5)		;FAIL RETURN, ERROR
	RETSKP			;RETURN GOOD
;HERE ON FILE REFERENCE ERRORS (JFN NOT OPEN, ETC).  ALL BUFFERS
;MUST BE RELEASED

DMPER1:	EXCH A,DAOBW		;SAVE ERROR CODE, GET AOBJN WORD
	CALL DMPREL
	MOVE 1,DAOBW
	RETBAD()

;HERE ON ERRORS SETTING UP BUFFER PAGES.  RELEASE WHATEVER HAS BEEN
;ASSIGNED/LOCKED SO FAR.

DMPSE4:	MOVE A,LT2
	CALL DMPRL1		;Release buffers assigned but unlocked
	HLRE C,LT2
	MOVNS C
	HRLZS C
	MOVE A,DAOBW
	ADD A,C
	SKIPGE A
	CALL DMPREL		;Release buffers both lock and assigned
	MOVEI A,DUMPX4
	RETBAD()		;ACCESS ERROR

;RELEASE DUMP BUFFERS. CALLED AT INTERRUPT LEVEL AFTER TRANSFER
;COMPLETED.
; A/ IOWD OF LAST XFER
;	CALL DMPDON
; RETURN +1 ALWAYS

	RESCD

DMPDON::HLRE B,A		;GET COUNT
	JUMPGE B,R

;CONSTRUCT "AOBJN" WORD TO IDENTIFY MONITOR BUFFERS

	MOVM B,B		;GET POSITIVE COUNT
	MOVEI A,1(A)		;A=FIRST ADDRESS
	ADD B,A			;B=END ADDRESS
	ADDI B,777		;BUMP TO END OF PARTIAL PAGE
	LSH A,-PGSFT		;A=FIRST PAGE
	LSH B,-PGSFT		;B=END PAGE
	SUBM A,B		;B=NEG PAGE COUNT
	MOVEI C,DMPBUF
	ASH C,-PGSFT		;C=FIRST MON BUFFER PAGE
	SUB A,C			;REMOVE OFFSET
	HRL A,B			;PAGE CNT TO LH
	CALLRET DMPREL		;NOW RELEASE THEM
;RELEASE DUMP BUFFERS (WINDOW PAGES)
; A/ -NPAGES,,FIRST RELATIVE PAGE
;	CALL DMPREL
; RETURN +1 ALWAYS

DMPREL:	JUMPE A,R
	PUSH P,A
DMPRL0:	PUSH P,A
	LSH A,PGSFT
	MOVEI B,DMPBUF(A)
	MOVEI A,0
	CALL SETIOP		;UNLOCK AND UNMAP THE PAGE
	 BUG(DMPRLF)
	POP P,A
	AOBJN A,DMPRL0
	POP P,A
DMPRL1:	JUMPE A,R
	HLRE B,A
	MOVSI C,400000
	ASH C,1(B)
	MOVNI A,(A)
	ROT C,(A)
	ANDCAM C,DMPASW
	MOVNS B
	ADDM B,DMPCNT
	RET
   >				;END OF REPEAT ZERO ON HISTORICAL CODE

;LCKTST - CALLING ROUTINE FOR LCKTSS SCHEDULER TEST

	RESCD

LCKTST::PUSH P,1
	MOVE 1,-1(P)
	HRLZ 1,-2(1)
	HRRI 1,LCKTSS
	MDISMS
	POP P,1
	RET

LCKTSS:	AOSE 0(1)
	JRST 0(4)
	JRST 1(4)

   REPEAT 0,<			;MORE HISTORICAL CODE NO LONGER USED
DMPTST:	CAML 1,DMPCNT
	JRST 0(4)
	JRST 1(4)
   >				;END OF REPEAT ZERO ON HISTORICAL CODE
	SWAPCD

	TNXEND
	END