Google
 

Trailing-Edge - PDP-10 Archives - BB-4170G-SM - sources/io.mac
There are 60 other files named io.mac in the archive. Click here to see a list.
;<3A.MONITOR>IO.MAC.7, 25-Aug-78 17:09:34, EDIT BY HELLIWELL
;CALL ULKSTR INSTEAD OF DIRECTLY DECREMENTING STRLK
;<3A.MONITOR>IO.MAC.6,  8-Mar-78 16:38:52, EDIT BY MILLER
;FIX UNLDS1 TO JUMP TO EMRET0 ON ERRF SET
;<3A.MONITOR>IO.MAC.5,  2-Mar-78 12:48:16, 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
;<3A.MONITOR>IO.MAC.3,  2-Mar-78 08:10:59, EDIT BY MILLER
;SINR CODE MUST INSURE ALL OF RECORD IS IN BEFORE ABORTING
;<3A.MONITOR>IO.MAC.2, 27-Feb-78 14:23:08, Edit by BORCHEK
;fix dumpo doing goto words wrong at dumpo4+2
;<4.MONITOR>IO.MAC.1, 13-Oct-77 15:47:52, EDIT BY MILLER
;COMBINE TRVAR AND STKVAR IN SIN
;<3-MONITOR>IO.MAC.217, 13-Oct-77 08:30:46, EDIT BY MILLER
;CHECK FOR PRIMARY I/O PROPERLY
;<3-MONITOR>IO.MAC.216, 12-Oct-77 13:51:51, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-MONITOR>IO.MAC.215, 11-Oct-77 12:04:01, EDIT BY OSMAN
;PUT SEMICOLON ON BEGINNING OF LINE STARTING ";CHECK FOR FEBWT"
;<3-MONITOR>IO.MAC.214, 29-Sep-77 17:05:00, EDIT BY MILLER
;CHECK FOR FEBWT IN UNLDSN
;<3-MONITOR>IO.MAC.213,  8-Sep-77 09:51:46, EDIT BY HURLEY
;<3-MONITOR>IO.MAC.212,  7-Sep-77 19:06:37, EDIT BY HURLEY
;<3-MONITOR>IO.MAC.211,  7-Sep-77 16:11:57, EDIT BY P.HURLEY
;SPEED UP CHKJFN AND UNLCKF
;<3-MONITOR>IO.MAC.210, 29-Aug-77 10:08:39, EDIT BY MILLER
;FIX MISORDERING OF TRVAR AND STKVAR IN SOUT CODE
;<3-MONITOR>IO.MAC.209, 23-Aug-77 12:53:38, EDIT BY MILLER
;MAKE SPECIAL CHECK FOR FE DISMISS
;<3-MONITOR>IO.MAC.208, 12-Aug-77 11:19:57, Edit by HESS
;FIX BYTBLT TO HANDLE POINTERS WITH INDEX FIELDS
;<3-MONITOR>IO.MAC.207, 18-Jul-77 08:33:26, EDIT BY MILLER
;ADD INTERFACE ROUTINE TO BYTBLT FOR DECNET CODE
;<3-MONITOR>IO.MAC.206, 11-Jul-77 09:41:34, Edit by HESS
;TCO 1836 - SIN/SOUT TO CHECK FOR OPEN FILE
;<3-MONITOR>IO.MAC.205, 30-Jun-77 13:43:46, EDIT BY HURLEY
;MADE SIN1 GO TO UNL ON EOF TO PREVENT NUL FROM BEING ATTACHED TO END
;<3-MONITOR>IO.MAC.204, 20-Jun-77 13:08:50, EDIT BY MILLER
;MAKE BYTBLT DO BYTE-AT-A-TIME FOR INDEXED OR INDIRECT BYTE POINTERS
;<3-MONITOR>IO.MAC.202,  7-Jun-77 13:56:13, EDIT BY MILLER
;MAKE RECOUT BLOCK IF REQUESTED
;<3-MONITOR>IO.MAC.201, 28-May-77 23:17:58, Edit by MCLEAN
;FIX BYTBLT FOR EXTENDED ADDRESSING AGAIN (SRCHLL)
;<3-MONITOR>IO.MAC.200, 27-May-77 14:53:02, EDIT BY MILLER
;UNLCKF NEEDS TO CHECK IF TTY OR PTY JFN WAS REASSIGNED
;<3-MONITOR>IO.MAC.199, 10-May-77 15:10:36, EDIT BY MILLER
;FINISH SPEED UP CHANGES FOR DN64
;<3-MONITOR>IO.MAC.198,  2-May-77 20:33:36, EDIT BY BOSACK
;<3-MONITOR>IO.MAC.197,  6-Apr-77 20:36:47, Edit by HESS
;<3-MONITOR>IO.MAC.196,  6-Apr-77 13:11:48, Edit by HESS
;TCO 1770 - ADD BLOCK CO-ROUTINES
;<3-MONITOR>IO.MAC.195, 28-Mar-77 18:02:23, Edit by MCLEAN
;REMOVE XHLLI IT IS BROKEN
;<3-MONITOR>IO.MAC.194, 28-Mar-77 13:43:46, Edit by HESS
;FIX BOUT TO SET UP DEV CORRECTLY FOR UPDLEN CALL
;<3-MONITOR>IO.MAC.193,  7-Mar-77 22:34:12, Edit by MCLEAN
;ADD XHLLI TO CORRECT SECTION NUMBER FOR BYTE POINTERS
;<3-MONITOR>IO.MAC.192,  7-Mar-77 22:30:24, Edit by MCLEAN
;<3-MONITOR>IO.MAC.191,  5-Mar-77 19:04:47, Edit by MCLEAN
;<3-MONITOR>IO.MAC.190, 23-Feb-77 20:06:16, EDIT BY HALL
;TCO 1740 - CHANGED CHKJFN'S REFERENCE TO TTFORK TO A CALL TO TTYSRV
;<3-MONITOR>IO.MAC.189,  9-Feb-77 15:16:35, Edit by MCLEAN
;<3-MONITOR>IO.MAC.188,  9-Feb-77 15:11:38, Edit by MCLEAN
;FIX BYTBLT D CONTAINED LEFT HALF JUNK
;<3-MONITOR>IO.MAC.187,  7-Feb-77 21:04:29, Edit by HESS
;TCO 1726 - FIX TO SIMULTANEOUS UPDATE EOF PROBLEM
;<3-MONITOR>IO.MAC.185,  3-Feb-77 21:10:49, Edit by MCLEAN
;<3-MONITOR>IO.MAC.184,  3-Feb-77 14:42:47, Edit by MCLEAN
;<3-MONITOR>IO.MAC.183,  2-Feb-77 17:53:25, Edit by MCLEAN
;<3-MONITOR>IO.MAC.182,  2-Feb-77 16:42:23, Edit by MCLEAN
;<3-MONITOR>IO.MAC.181,  2-Feb-77 16:18:08, Edit by MCLEAN
;<3-MONITOR>IO.MAC.180,  2-Feb-77 15:21:39, Edit by MCLEAN
;<3-MONITOR>IO.MAC.179, 28-Jan-77 14:08:28, Edit by MCLEAN
;<3-MONITOR>IO.MAC.178, 23-Jan-77 20:18:57, Edit by MCLEAN
;<3-MONITOR>IO.MAC.177, 23-Jan-77 14:58:47, Edit by MCLEAN
;<3-MONITOR>IO.MAC.176, 23-Jan-77 14:55:46, Edit by MCLEAN
;<3-MONITOR>IO.MAC.175, 15-Jan-77 17:54:18, Edit by MCLEAN
;<3-MONITOR>IO.MAC.174, 15-Jan-77 17:28:42, Edit by MCLEAN
;<3-MONITOR>IO.MAC.173, 13-Jan-77 15:28:52, Edit by MCLEAN
;<3-MONITOR>IO.MAC.172, 28-Dec-76 22:28:36, Edit by MCLEAN
;<3-MONITOR>IO.MAC.171, 27-Dec-76 17:33:03, EDIT BY HURLEY
;<3-MONITOR>IO.MAC.170, 28-Nov-76 12:51:19, Edit by MCLEAN
;<3-MONITOR>IO.MAC.169, 27-Nov-76 22:54:59, Edit by MCLEAN
;<3-MONITOR>IO.MAC.168, 26-Nov-76 20:18:43, Edit by MCLEAN
;<3-MONITOR>IO.MAC.167, 26-Nov-76 16:31:24, Edit by MCLEAN
;<2-MONITOR>IO.MAC.166, 24-Nov-76 14:25:34, EDIT BY WERME
;TCO 1667 - FIX BYTINA TO NOT DISCARD NULL IF IT'S THE FIRST BYTE OF AN ASCII FILE
;<2-MONITOR>IO.MAC.165, 31-Oct-76 13:50:44, EDIT BY HURLEY
;FIX BYTBLT TO USE XBLTUU INSTEAD OF XCTU
;<2-MONITOR>IO.MAC.164, 28-Oct-76 16:54:12, Edit by HESS
;FIX QUOTA EXCEDED INTERUPT PC BACKUP (UNLDIS)
;<2-MONITOR>IO.MAC.163, 21-Oct-76 09:46:03, Edit by HESS
;TCO 1610 - DUMPI/DUMPO IMPROVEMENTS
;<2-MONITOR>IO.MAC.162, 18-Oct-76 19:04:34, EDIT BY HURLEY
;TCO 1607 - MAKE PROPER TEST FOR LH = -1 IN SIN
;<2-MONITOR>IO.MAC.161, 13-Oct-76 13:36:21, EDIT BY HURLEY
;TCO 1592 - MAKE SOUT INTERRUPTABLE EVERY PAGE
;MAKE OVER QUOTA NOT CLOBBER AC 1 ON ERROR
;<2-MONITOR>IO.MAC.160, 11-Oct-76 09:24:28, EDIT BY HURLEY
;TCO 1583 - MAKE MAGTAPE WAITS BE DONE WITH HDISMS
;<2-MONITOR>IO.MAC.159,  9-Aug-76 17:00:47, Edit by HESS
;<2-MONITOR>IO.MAC.158,  6-Aug-76 09:41:30, EDIT BY HURLEY
;CHANGING GETFPD TO RETURN A 36 BIT DIR NUMBER
;<HESS>IO.MAC.3,  2-Aug-76 16:39:51, Edit by HESS
;TCO 1478 -- QUOTA CHECKING
;<1MILLER>IO.MAC.11,  8-Jul-76 17:33:23, EDIT BY MILLER
;<1MILLER>IO.MAC.10,  8-Jul-76 14:47:08, EDIT BY MILLER
;<1MILLER>IO.MAC.9,  8-Jul-76 08:26:08, EDIT BY MILLER
;FIX UP ROUTINES RELATED TO DISMOUNTED STRUCTURES
;<1MILLER>IO.MAC.8,  7-Jul-76 14:20:43, EDIT BY MILLER
;<1MILLER>IO.MAC.7,  7-Jul-76 14:08:46, EDIT BY MILLER
;ADD LUNLK0 ROUTINE
;<1MILLER>IO.MAC.6,  7-Jul-76 09:26:27, EDIT BY MILLER
;FIX REGISTER USAGE IN DMOCHK AND STRDMO
;<1MILLER>IO.MAC.5,  6-Jul-76 16:43:28, EDIT BY MILLER
;MAKE STRDMO INTERNAL
;<1MILLER>IO.MAC.4,  6-Jul-76 15:57:17, EDIT BY MILLER
;MAKE LUNLKF INTERNAL
;<1MILLER>IO.MAC.3,  6-Jul-76 14:21:12, EDIT BY MILLER
;USE STR TO GET STRUCTURE NUMBER
;<1MILLER>IO.MAC.2,  6-Jul-76 12:19:23, EDIT BY MILLER
;<1MILLER>IO.MAC.1,  6-Jul-76 12:03:24, EDIT BY MILLER
;ADD STRDMO, AND DMOCHK AND CALL THEM FROM CHKJFN
;<2-MONITOR>IO.MAC.1, 17-Jun-76 11:54:42, EDIT BY MILLER
;REMOVE SJFN. ADD MLJFN
;<1B-MONITOR>IO.MAC.154, 14-JUN-76 16:05:38, EDIT BY HURLEY
;<1B-MONITOR>IO.MAC.153, 14-JUN-76 14:53:07, EDIT BY JMCCARTHY
;TCO 1409 - MAKE CHKJFN UNDERSTAND DEVICE DESIGNATORS THAT ARE
;TERMINALS
;<1B-MONITOR>IO.MAC.152, 10-JUN-76 17:49:37, EDIT BY HURLEY
;TCO 1398 - MAKE BOUTA ALWAYS CLEAR BLKF IF SET.
;<1MONITOR>IO.MAC.151, 23-MAR-76 16:53:14, EDIT BY HURLEY
;<1MONITOR>IO.MAC.150, 23-MAR-76 15:16:26, EDIT BY HURLEY
;TCO 1206 - CHANGE ERROR CODE OF DSKJFN FROM PMAPX1 TO DESX8
;<1MONITOR>IO.MAC.149, 10-MAR-76 12:08:09, EDIT BY MILLER
;<1MONITOR>IO.MAC.148,  3-MAR-76 15:30:04, EDIT BY MILLER
;TCO 1147. ON ERRF, UNLOCK FILE AND RETURN IMMEDIATELY
;<2MONITOR>IO.MAC.147, 16-JAN-76 17:49:19, EDIT BY MURPHY
;<2MONITOR>IO.MAC.146,  7-JAN-76 19:07:39, EDIT BY HURLEY

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION

	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

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


CHKJFD::TDZA D,D		;REMEMBER TO SKIP DISMOUNTED CHECK
CHKJFN::SETO D,			;CHECK FOR DISMOUNTED STRUCTURE
	CAIN JFN,.PRIIN		;PRIMARY INPUT?
	HLRZ JFN,PRIMRY		;YES. GET INPUT JFN
	CAIN JFN,.PRIOU		;PRIMARY OUTPUT?
	HRRZ JFN,PRIMRY		;YES. GET OUTPUT JFN
	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
	NOSKED			;NOW CHECK IF STR IS STILL MOUNTED
	LOAD A,FILUC,(JFN)	;GET STR UNIQUE CODE
	LOAD P5,STR,(JFN)	;GET STR NUMBER
	SKIPN P5,STRTAB(P5)	;GET THE SDB ADDRESS
	JRST [	OKSKED		;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 [	OKSKED		;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
	OKSKED			;ALLOW OTHER SCHEDULING AGAIN
	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 CHKJF7		;No, garbage designator
	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:	MOVE A,JOBNO
	HLLZ DEV,JOBPT(A)	;GET CONTROLLING TTY NUMBER
	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

;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 CHKJ8A
	TQNN <FRKF>		;Test for file restricted to one fork
	JRST CHKJF9
CHKJ2B:	HLRZ A,FILVER(JFN)
	PUSH P,D		;SAVE THE ENTRY FLAG
	CALL SKIIF		;OWNER INFERIOR TO THIS FORK?
	 JRST CHKJF8		;NO, ACCESS ILLEGAL
	POP P,D			;RESTOR THE ENTRY FLAG
CHKJF9:	MOVE DEV,FILDEV(JFN)	;Set up dev
	HRRZ P3,DEV
	SETZB F,P5
	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:	POP P,0(P)		;CLEAN UP THE STACK
CHKJ8A:	UNLOCK FILLCK(JFN)
	OKINT
CHKJFB:	MOVEI A,DESX3
	RET

CHKJF1:	JUMPGE JFN,CHKJF6
	HLRZ A,JFN		;GET LEFT HALF
	CAIE A,600000+.DVTTY	;TTY DESIGNATOR?
	JRST CHKJF0		;NO
	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:	POP P,JFN		;RESTORE GOOD DESIGNATOR
	HRRZ P3,DEV
	RETSKP

CHKJF0:	CAML JFN,[777777,,0]
	HRLI JFN,440700		;Insert if lh = 777777
	CAMGE JFN,[444500,,0]
	JRST CHKJF6
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 (,<ULKDIR
		CALL UNLCKF>)
	HRRZ T2,.FBPRT(T1)	;GET PROTECTION
	LOAD T1,FILUC,(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,FILUC,(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::	MOVEM A,LSTERR
	JRST ITRAP

;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
	NOSKED			;PROTECT DATA BASES
	CALL DMOCHK		;CHECK STRUCTURE
	 RETBAD (DESX10,<OKSKED>) ;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:	OKSKED			;ALLOW SCHEDULING
	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

DMOCHK::LOAD C,FILUC,(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
; 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
	AOSE FILLCK(1)
	JRST SLBIN0
	CALL STRDMO		;VERIFY STRUCTURE
	 JRST SLBIN1		;BEEN DISMOUNTED
	MOVE STS,FILSTS(1)
	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>
	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 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
SIN00:	SKIPG FILCNT(JFN)	;ANY BYTES IN BUFFER?
	 JRST SIN1		;NO, DO IT THE SLOW WAY
	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
	MOVE A,FILBYT(JFN)	;SOURCE POINTER
	UMOVE B,2		;TARGET
	MOVX D,FLINPT!BBLTMU	;FROM FILE, COPY MONITOR TO USER
	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
	MOVEM A,FILBYT(JFN)
	CALL UNLCKF		;UNLOCK FILE TO ALLOW INTS
	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.

; 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
	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]
	CALL SIND		;DEPOSIT THE BYTE
	CALL SIONXT		;Test for end of string
	 JRST SINTT1		;Not end, continue
	JRST UNL		;ALL DONE

SIN1:	CALL BYTINA		;Read a byte from the source
	 JRST SINW		;SERVICE ROUTINE WANTS TO BLOCK
	SKIPLE SINRF		;DOING SINR ABORT?
	JRST SIN00		;YES. GO CHECK THEN
	JUMPE B,[TQNN <EOFF>
		XCTU [SKIPN 3]
		JRST UNL
		JRST .+1]
	CALL SIND		;DEPOSIT THE BYTE
	CALL SIONXT		;Test for end of string
	 JRST SIN00		;Not end, continue
	JRST UNL		;ALL DONE

;LOCAL ROUTINE USED BY ABOVE TO DEPOSIT BYTE

SIND:
	XCTBUU [IDPB B,2]	;Deposit the byte
	RET
SIN4:	CALL UNLCKF		;UNLOCK THE LOCKS
	JRST SIN2		;GO ADD NULL TO END

SIN3:	XCTU [SKIPE 3]		;NON-ZERO COUNT CASE?
	JRST MRETN		;YES, RETURN

SIN2:	SETZ B,			;GET A NULL TERMINATOR
	UMOVE A,2
	XCTBU [IDPB B,A]
	JRST MRETN

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
		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 <STRSRC>		;BYTE POINTER IN JFN?
	JRST SIOR23		;YES, IGNORE FILCNT
	CAML C,FILCNT(JFN)	;KEEP MIN OF THIS
	MOVE C,FILCNT(JFN)	;AND BYTES IN BUFFER
	SKIPA Q2,FILCNT(JFN)	;GET LENGTH OF SOURCE STRING FOR LINE # REMOVER
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
	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
	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

BYTINA:	JUMPGE STS,NOTOPN
BYTIA1:	CALL BYTINX		;GET A BYTE
	 RET			;ERROR - PASS DOWN THE LINE
	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
	CAIN A,<POINT 7,0,6>_-^D24;FIRST BYTE?
	CAIGE C,4		;ENUF FOR A LINE #?
	RETSKP			;NO TO ONE, LET IT THRU

;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 [	MOVE A,FILBYN(JFN);NOT A LINE NUMBER. FIRST CHAR?
		SOJE A,BYTIA3	;IF SO, SKIP THIS NONSENSE IN THE FUTURE
		RETSKP]		;NOT FIRST, RETURN THIS BYTE
	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

BYTIA3:	TQO <PASLSN>		;HERE IF WE DECIDE FILE ISN'T SEQUENCED
	RETSKP			;RETURN CURRENT BYTE
;SUBROUTINE CALLED ONLY BY BYTINA:
BYTINX:	TQNN <READF>
	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,<BYTINA: BLKF SET BEFORE CALLING SERVICE ROUTINE>)
	XMOVEI C,BYTINB		;BYTIN BLOCK ROUTINE
	MOVE D,SAVJFN		;ORIGINAL JFN
	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
	TQNE <ERRF>
	JRST INERR
	TQNE <EOFF>
	JRST INEOF
	MOVE B,A
	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:	PUSH P,T2		;SAVE JFN RETURNED
	CALL UNLDIS		;UNLOCK JFN & DISMISS
	POP P,JFN		;RESTORE JFN
	CALL CHKJFN		;RE-VALIDATE IT
	 RETBAD ()
	 JFCL
	 JFCL
	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:	TQNE <ERRF>		;IS ERROR UP?
	JRST [	FILINT (IOX5)	;YES. GIVE INTERRUPT
		CALL UNLCKF	;ALLOW INTERRUPT TO TAKE
		MOVEI A,IOX5	;IF HE PROCEEDS, GEN ERROR
		JRST EMRET0]	;AND RETURN
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
	MOVE B,MPP		;RETURN PC POINTER
	SOS -1(B)		;BACK UP PC TO INSTR
	MOVE C,0(B)		;PICK UP FLAGS
	TLNE C,(UMODF)		;USER MODE PC?
	SOS -3(B)		;YES - TWO PC'S THEN
	MOVE A,BITS+.ICQTA	;GET CHANNEL BITS
	CALL IICSLF		;CAUSE INTERUPT
UNLDSN:	CALL UNLCKF		;UNLOCK THE FILE AND DO AN OKINT
				;INTERUPT WILL HAPPENED IF POSTED
	POP P,A			;GET BACK ARG
	HRRZ B,A		;GET ADDRESS OF ROUTINE BEING CALLED
	CAIE B,FEBWT		;FE INPUT WAIT?
	CAIN B,FEDOBE		;FE DEVICE WAIT?
	JRST UNLFE		;YES. GO DO SPECIAL HANDLING
	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

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.

UNLFE:	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
	SOSGE FILCNT(1)
	JRST SLBOU2
	CALL STRDMO		;VERIFY STRUCTURE
	 JRST SLBOU1		;BEEN DISMOUNTED
	AOS C,FILBYN(1)
	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
	IDPB 2,FILBYT(1)
	CALL LUNLKF		;FREE UP FILE
	JRST MRETN

SLBOU2:	AOS FILCNT(1)
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 A,101
	DOBE
	HRROI A,[ASCIZ /
?/]
	PSOUT
	MOVEI A,100
	;CFIBF
	UMOVE 1,1
	JRST PSOUT1
; 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>
	MOVEM Q2,SOUTRF		;SAVE SOUTR FLAG
	JUMPGE 2,SOUT0
	MOVSI C,440700
	CAML 2,[777777,,0]
	XCTU [HLLM C,2]
SOUT0:	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:	SKIPG FILCNT(JFN)
	 JRST SOUT1		;DO IT THE OLD WAY
	MOVE B,FILBYT(JFN)	;TARGET IS FILE
	UMOVE A,2		;SOURCE IS USER
	MOVX D,XFRLSN!BBLTUM	;ALWAYS PASS LSNS (THERE AREN'T ANY)
	CALL SIOR2
	UMOVEM A,2
	MOVEM B,FILBYT(JFN)
	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
	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
		CALL UNLCKF	;NO. ERROR
		JRST EMRET0]	;AND EXIT
	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
	CALL APPNUL		;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:	CALL SOUTB		;OUTPUT THE BYTE
	 JRST [	JUMPN A,SOUT0	;DEVICE BLOCKED, START OVER
		JRST SOUTRR]	;ALL THROUGH
	JRST SOUTT1		;LOOP BACK FOR ALL BYTES

;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 APPNUL
	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,<BYTOUA: BLKF SET BEFORE CALL TO SERVICE ROUTINE>)
	XMOVEI C,BYTOUB		;CO-ROUTINE ADDRS
	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
	MOVEI C,0
	TLZ JFN,7700
	TLO JFN,700
	CAMN JFN,-1(P)		;HAVE ASCII BYTE PTR
	XCTBU [IDPB C,JFN]	;YES, APPEND NULL
	POP P,C
	POP P,JFN
	RET

;ROUTINE TO BLOCK FOR BYTOUT SERVICE ROUTINES

BYTOUB:	PUSH P,T2		;SAVE JFN RETURNED
	CALL UNLDIS		;UNLOCK JFN & DISMISS
	POP P,JFN		;RESTORE JFN
	CALL CHKJFN
	 RETBAD ()		;GARBAGE
	 JFCL
	 JFCL
	RETSKP			;GIVE GOOD RETURN
; 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

BYTBLT::STKVAR <<TEMPA,3>,SAVQ3,SAVP6,SAVP5,SAVP3,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
	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 <XFRLSN>		;SKIPPING LINE NUMBERS?
	TQNE <XFR2TM>		;OR UP TO A TERMINATOR?
	JRST CHKTRM		;Yes TO EITHER, look for it
	TLNN B,7700		;Zero byte size?
	JRST BYTLP		;Well...if you insist
	MOVE Q1,B		;Compare target
	XOR Q1,A		;To source
	TLNN Q1,7700		;And if byte size differs
	CAIG C,20		;Or short transfer
	JRST BYTLP		;Do byte at a time
	LDB Q2,[POINT 6,B,11]	;Get byte size
	MOVEM Q2,BYTSIZ		;Save it
	ROT Q2,-6		;Position in p field
LP1:	SOJL C,DONE		;Until cnt < 0
	XCT LDBTB(P5)		;Do transfer bytes
	XCT DPBTB(P5)
	CAMG Q2,B		;Until less than 1 byte remains in tgt
	JUMPGE Q2,LP1		;Loop unless bytesize >= 32
				;(once is always enough)
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
	HLLO Q1,A		;Get source...prevent borrows
	SUB Q1,B		;When getting bit offset
	ROT Q1,6
	ANDI Q1,77		;Retain just the position difference
	JUMPN Q1,BYTBL1		;Move word at a time
	DMOVEM A,TEMPA		;SAVE A-C
	MOVEM C,2+TEMPA
	AOS Q3,B		;CALCULATE DESTINATION ADDRS
	TLZ Q3,777740		;SAVE EFFECTIVE ADDRS
	TXO Q3,<XMOVEI C,>	;CONS INSTRUCTION
	XCT DMVITB(P5)		;GET ADDRS
	AOS Q3,A		;CALCULATE SOURCE ADDRS
	TLZ Q3,777740
	TXO Q3,<XMOVEI B,>	;BUILD INSTR
	XCT SMVITB(P5)		;GET ADDRS
	MOVE A,Q2		;NUMBER OF WORDS TO MOVE
	ADDM Q2,TEMPA		;UPDATE SRC / DEST POINTERS
	ADDM Q2,1+TEMPA
	XCT BLTTB(P5)		;CORRECT BLT ROUTINE
	DMOVE A,TEMPA		;RESTORE REGS
	MOVE C,2+TEMPA		;...
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,SAVP3
	MOVE P5,SAVP5
	MOVE P6,SAVP6
	RET
; Transfer a word at a time
; Q1/	POSITION OFFSET (RIGHT SHIFT AMOUNT)
; Q2/	WORD COUNT
; 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
	MOVE Q3,A		;COPY POINTER (SOURCE)
	TLZ Q3,777740		;CLEAR ALL BUT EFFECTIVE ADDRS
	TXO Q3,<MOVEI P3,>	;BUILD INSTR
	XCT SMVITB(P5)		;GET ADDRS
	HRRM P3,0+PRG		;STORE FOR FIRST MOVE
	AOS P3			;ADDRS OF SECOND MOVE
	HRRM P3,1+PRG		;STORE IT
	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		;...
	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
	MOVE Q3,B		;POINTER TO DESTINATION
	TLZ Q3,777740		;CLEAR ALL BUT EFFECTIVE ADDRS
	TXO Q3,<MOVEI P3,>	;BUILD INSTR
	XCT DMVITB(P5)		;GET ADDRS
	HRRI P6,1(P3)		;ADDRS OF MOVEM
	MOVEM P6,5+PRG		;AND NEW MOVEM INST
	HRRM Q1,3+PRG		;Fill in lshc amount
	ADDM Q2,B		;Update target
	ADDM Q2,A		;And source
	TRNE D,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 D,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

BYTLPD:	MOVE A,TEMPA		;RESTORE SOURCE POINTER
	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]
	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
; 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

; 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,.-.(A)		;Note most rh's are filled at run time
	MOVE Q2,.-.(A)		;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,.-.(A)		;Store
	AOBJN A,PRG		;Loop
	JRST BYTLPD		;Done
LPRG==.-PROTO
;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
; Dump io
; Parameters and variables

NDUMP==10
RS(DMPASW)			;Dump buffer assignment word
RS(DMPCNT)			;Dump buffer free count
RS(DMPLCK)			;Dump buffer assignment lock
NRP(DMPBUF,NDUMP*1000)		;Dump buffers

; 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



; 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
	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:	CALL UNLDIS		;UNLOCK JFN
	UMOVE JFN,1		;RESTORE USER ARG
	CALL CHKJFN
	 RETBAD ()
	 JFCL
	 JFCL
	RETSKP			;GOOD RETURN TO PROCEED
; 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(CHK,DMPRLF,<DMPREL-FAILED TO RELEASE PAGE>)
	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

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)

DMPTST:	CAML 1,DMPCNT
	JRST 0(4)
	JRST 1(4)
	SWAPCD

	TNXEND
	END