Google
 

Trailing-Edge - PDP-10 Archives - BB-Y393U-SM - monitor-sources/io.mac
There are 60 other files named io.mac in the archive. Click here to see a list.
; *** Edit 7509 to IO.MAC by RASPUZZI on 4-Aug-87 (TCO 7.1032)
; Fix problem in edit 7391. Mainly, do not change a MONX02 error to IOX5.
; Instead, make sure it is translated as IOX7.
; *** 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 if bit SF%LSN is on.
; 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 
;Edit 2907 - Prevent file corruption with 4 bit bytes
; UPD ID= 265, FARK:<4-1-WORKING-SOURCES.MONITOR>IO.MAC.4,  13-Dec-82 16:38:35 by DONAHUE
;Edit 2887 - Set TRPSTK flag before leaving BYTBLT
; UPD ID= 208, FARK:<4-1-WORKING-SOURCES.MONITOR>IO.MAC.3,  14-Oct-82 09:07:56 by DONAHUE
;Edit 2834 - Insert ERJMP near SINW to prevent ILMNRF
; UPD ID= 94, FARK:<4-1-WORKING-SOURCES.MONITOR>IO.MAC.2,  15-Jun-82 14:48:10 by BENCE
;<4-1-FIELD-IMAGE.MONITOR>IO.MAC.2, 25-Feb-82 20:24:41, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 976, FARK:<4-WORKING-SOURCES.MONITOR>IO.MAC.15,  12-Feb-82 15:32:59 by GROUT
;EDIT 1979 - PUT EDIT 1977 IN STANDARD FORM
; UPD ID= 967, FARK:<4-WORKING-SOURCES.MONITOR>IO.MAC.14,   8-Feb-82 14:20:28 by GROUT
;EDIT 1977 - MAKE 600000+.DVTTY DESIGNATORS WORK FOR BIN, BOUT, SIN, AND SOUT
; UPD ID= 796, FARK:<4-WORKING-SOURCES.MONITOR>IO.MAC.13,  15-Sep-81 11:34:05 by MOSER
;EDIT 1941 - MOVE EDIT 1940 FROM DEVICE TO SIN CODE HERE.
; UPD ID= 4, FARK:<4-WORKING-SOURCES.MONITOR>IO.MAC.11,   2-Sep-81 13:36:49 by MOSER
;EDIT 1938 - LOAD BYTE BEFORE GOING NOINT WHEN DOING SIN/SINR.
; UPD ID= 693, FARK:<4-WORKING-SOURCES.MONITOR>IO.MAC.6,   6-Aug-81 12:55:25 by SCHMITT
;Edit 1919 - Perform an Increment on users byte pointer at SOUT0:
; UPD ID= 481, FARK:<4-WORKING-SOURCES.MONITOR>IO.MAC.5,  27-Apr-81 16:52:04 by SCHMITT
; UPD ID= 413, FARK:<4-WORKING-SOURCES.MONITOR>IO.MAC.4,   9-Mar-81 14:02:30 by DONAHUE
;Edit 1836 - Insert ERJMP after ILDB at SIN1+7 to prevent ILMNRFs
; UPD ID= 329, FARK:<4-WORKING-SOURCES.MONITOR>IO.MAC.3,  14-Dec-80 00:22:45 by ZIMA
;Edit 1818 - Remove more historical code to free up address space at DMPINI.
; UPD ID= 223, FARK:<4-WORKING-SOURCES.MONITOR>IO.MAC.2,  29-Sep-80 15:38:07 by ZIMA
;Edit 1790 - Remove historical code.
; UPD ID= 103, FARK:<4-WORKING-SOURCES.MONITOR>IO.MAC.3,  26-Jun-80 15:17:35 by ZIMA
;EDIT 1751 - FIX SIN FOR AC3 NONZERO CASE APPENDING NULL AT END.
; UPD ID= 75, FARK:<4-WORKING-SOURCES.MONITOR>IO.MAC.2,  11-Jun-80 14:41:27 by SCHMITT
;<4.MONITOR>IO.MAC.276,  3-Jan-80 08:08:58, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.MONITOR>IO.MAC.275,  6-Nov-79 10:06:31, 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


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	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


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
	LOCK STRLOK		;PREVENT DISMOUNTING
	LOAD A,FILUC,(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 JOB FORK NUMBER
	PUSH P,B		;PRESERVE B
	IDIVI A,2		;COMPUTE OFFSET INTO CONTROLLING TTY TABLE
	ADD A,FKCTYP(B)		;MAKE POINTER TO CORRECT HALFWORD
	LDB JFN,A		;GRAB OUR FORK'S CONTROLLING TERMINAL
	POP P,B			;RESTORE B
	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

;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
	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
	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

;**;[1977] Add Routine C60DVT	JRG	8-FEB-82
;**;[1979] Change 1 line at CHKFIL:+6L	JRG	12-FEB-82
;[1979] ROUTINE TO CHANGE .DVDES+.DVTTY,, LINE # DESIGNATOR TO .TTDES+LINE #
;ACCEPTS IN JFN/ I/O DESIGNATOR TO CHECK
;RETURNS +1:	ALWAYS, UPDATED DESIGNATOR IN JFN

;**;[1979] Change 2 lines at C60DVT:+0L	JRG	12-FEB-82
C60DVT::CAMGE JFN,[.DVDES+.DVTTY,,NLINES] ;[1979] Is it the TTY designator
	CAMGE JFN,[.DVDES+.DVTTY,,0] ;[1979] that we should change?
	 RET			;No, don't change it
	HRRZS JFN		;Change to other kind of TTY designator
;**;[1979] Change 1 line at C60DVT:+4L	JRG	12-FEB-82
	ADDI JFN,.TTDES		;[1979] (.TTDES+Line #) in AC JFN
	RET			;Return

;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
;**;[7133]  Change 1 line at GETFPD:+5			DML	15-Aug-85
	 RETBAD (,<CALL UNLCKF>);[7133] Error, unlock JFN and return
	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
	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,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
; 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
;**;[2628] Add one line for null NSP messages  .BIN: +7L  CLB  15-JUN-82
	TQZ	<NSPNUL>	;[2628]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
;**;[1751] Revamp at SINR1: +0L	JGZ	26-JUN-80
SINR1:	TRVAR <SAVJFN,SINRF,SINZF> ;[1751] LOCAL STORAGE
	SETZM SINZF		;[1751] ASSUME USER AC3 ZERO
	XCTU [SKIPE 3]		;[1751] TEST IT
	SETOM SINZF		;[1751] NONZERO, SUPPRESS APPENDED NULL
	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
;**;[1938] ADD 2 LINES AT SIN0: + 0L	TAM	1-SEP-81
SIN0:	UMOVE C,2		;[1938] GET BYTE POINTER FROM USER
	XCTBU [ILDB C,C]	;[1938] ATTEMPT TO GET BYTE FROM POINTER
	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
;**;[1977] Change 1 line at SIN0:+8L	JRG	8-FEB-82
		JRST SINBAT	;[1977] 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
;**;[2628] ADD 5 LINES + LABEL SIN0: +12L  CLB  15-JUN-82
	TQZE <NSPNUL>		;[2628] WAS THERE A NUL NSP MSG?
	SKIPL SINRF		;[2628] YES, WAS THIS A SINR?
	JRST SIN00E		;[2628] NO
	CALL UNLCKF		;[2628] YES, SINR AND NULL NSP - UNLOCK FILE
	JRST MRETN		;[2628] GOOD RETURN
;**;[1941] ADD 4 LINES AT SIN0: + 12L	TAM	15-SEP-81
SIN00E:	MOVE B,FILLEN(JFN)	;[1941] [2628] GET TOTAL FILE LENGTH
	SUB B,FILBYN(JFN)	;[1941] COMPUTE BYTES LEFT IN FILE
	CAMGE B,FILCNT(JFN)	;[1941] THIS BUFFER PASSES EOF?
	MOVEM B,FILCNT(JFN)	;[1941] YES, REDUCE BUFFER COUNT
	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

;**;[1977] Replace 1 line with 2 at SINTTY:+0L	JRG	8-FEB-82
SINTTY:	CALL C60DVT		;[1977] CHANGE TO GOOD TTY DESIGNATOR
SINBAT:	CALL @JFNID(P3)		;[1977] 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:	CALL BYTINS		;Read a byte from the source
	 JRST SINW		;SERVICE ROUTINE WANTS TO BLOCK
	TQZE <RECF>		;EOR ENCOUNTERED?
	JRST [	SKIPG SINRF	;ABORTING A SINR?
		JRST SIN00	;NO. PROCEED AS USUAL THEN
		CALL UNLCKF	;YES.
		JRST SIN03]	;TERMINATE THEN
	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
;**;[1836] Add 2 lines at SIN1: +14.L	 PED	9-MAR-81
	 ERJMP [ FILINT (ILLX02) ;[1836] IF ERROR RETURN PROPER CODE
		 EMRETN (ILLX02,<CALL UNLCKF>)] ;[1836] 
	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

;**;[1751] Change one line at SIN3: +0L	JGZ	26-JUN-80
SIN3:	SKIPE SINZF		;[1751] NONZERO 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
;**;[2834] Add 2 lines at SINW:+6L	PED	13-OCT-82
		 ERJMP [FILINT (ILLX02);[2834] SEE INTERRUPT
			EMRETN (ILLX02)];[2834] AND 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
	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
;**;[1977] Change 1 line at BYTIN1:+2L	JRG	8-FEB-82
;**;[1979] Change 1 line at BYTIN1:+2L	JRG	8-FEB-82
	 CALL C60DVT		;[1977][1979] TTY - Check for .DVDES+.DVTTY
	 JFCL			;Byte pointer
BYTIN2:	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
;**;[1742] Replace 3 lines at BYTIA2+2 with following 4 lines  RAS  11-JUN-80
	CAIE A,<POINT 7,0,6>_-^D24;FIRST BYTE?
	RETSKP			;NO, LET IT THRU
	CAIGE C,4		;ENUF FOR A LINE #?
	JRST BYTIA4		; NO, possible skip this in the 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 [	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

;**;[1742]  Insert Two lines before BYTIA3  RAS  11-JUN-80
BYTIA4:	MOVE A,FILBYN(JFN)	; Not a line number. First Char?
	SOSN A			; If so, skip this 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:
;**;[7321]At BYTINX:+0L make BYTINX global  JYCW  6/16/86
;BYTINX expects the original JFN to be stored in SAVJFN (via TRVAR <SAVJFN>).
BYTINX::TQNN <READF>		;7[321]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(BLKF1)
	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

;**;[7391] Replace 5 lines with 10 lines at UNLDS1:+1L  JCR  7-Nov-86
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]
;**;[7509] Replace 1 line with 6 lines at UNLDS1:+6L	MDR	4-AUG-87
	  CAIE A,MONX02		;[7509] JSB free space full?
	  IFSKP.		;[7509] If so,
	    FILINT (IOX7)	;[7509] Return correct error
	  ELSE.			;[7509] If not,
	    FILINT (IOX5)	;[7509][7391] No, assume device or data error
	  ENDIF.		;[7509]
	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
	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 T1,101
	DOBE
	RFPOS			;GET POSITION ON LINE
	HRROI T1,[ASCIZ /
/]
	TRNE T2,-1		;ALREADY AT BEGINNING OF LINE?
	PSOUT			;NO, GET THERE
	MOVEI T1,"?"		;ERROR CHARACTER
	PBOUT
	MOVEI T1,100
	CFIBF
	IMCALL PSOUT		;OUTPUT THE MESSAGE
	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>
	MOVEM Q2,SOUTRF		;SAVE SOUTR FLAG
	JUMPGE 2,SOUT0
	MOVSI C,440700
	CAML 2,[777777,,0]
	XCTU [HLLM C,2]
;**;[1857] Replace one line with two at SOUT0:	RAS	27-APR-81
;**;[1919] Replace one line with two at SOUT0:	RAS	6-AUG-81
SOUT0:	UMOVE C,2		;[1919] GET BYTE POINTER FROM USER
	XCTBU [ILDB C,C]	;[1919] ATTEMPT TO GET BYTE FROM POINTER
	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
;**;[1977] Change 1 line at SOUT0:+8L	JRG	8-FEB-82
		JRST SOUBAT	;[1977] 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
	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
	CALL APPNUL		;APPEND NULL
	JRST SOUTRR		;AND RETURN

;SOUT WHICH MUST BE DONE BYTE-AT-A-TIME
;**;[1977] Replace 3 lines with 5 at SOUBYT:+12L	JRG	8-FEB-82
;[1977] SOUTTY - FOR CASES WHERE WE HAVE A TTY DESIGNATOR
;[1977] SOUBAT - FOR OTHER CASES WHERE WE DO NOT HAVE A REAL JFN

SOUTTY: CALL C60DVT		;[1977] CHANGE TO GOOD TTY DESIGNATOR
SOUBAT:	CALL @JFNOD(P3)		;[1977] 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
;**;[1977] Change 2 lines at BYTOU1:+2L	JRG	8-FEB-82
;**;[1979] Change 1 line at BYTOU1:+2L	JRG	12-FEB-82
	CALL C60DVT		;[1977][1979] TTY - Check for .DVDES+.DVTTY
	JFCL			;[1977] Byte pointer
BYTOU2:	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(BLKF2)
	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
	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
; 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,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
	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
	;..
;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 UNLESS THE FIRST WORD OF THE TARGET HAS
;BEEN FILLED.

	;..
	LDB Q2,[POINT 6,B,11]	;Get byte size
	MOVEM Q2,BYTSIZ		;Save it
;**;[2907] Delete 1 line at LP1:-1	PED	4-FEB-83
LP1:	SOJL C,DONE		;Until cnt < 0
	XCT LDBTB(P5)		;Do transfer bytes
	XCT DPBTB(P5)
;**;[2907] Insert 1 line,Change 1 at LP1:+3L	PED	4-FEB-83
	LDB Q1,[POINT 6,B,5]	;[2907] Get number bits left in word
	CAMG Q2,Q1		;[2907] Until less than 1 byte remains in tgt
	JUMPGE Q2,LP1		;Loop unless bytesize >= 32
				;(once is always enough)

;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.

	HLLO Q1,A		;Get source...prevent borrows
	TLO Q1,77		;MORE BORROW PROTECTION
	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
	;..
;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
	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
;**;[2887] Add 3 lines at BYTLP:-9L	PED	13-DEC-82
	EXCH A,TRPDSP		;[2887] GET TRPDSP
	TXO A,TRPSTK		;[2887] SAY WE ARE LEAVING BYTBLT
	EXCH A,TRPDSP		;[2887] AND RESTORE TRPDSP
	XCT BLTTB(P5)		;CORRECT BLT ROUTINE
;**;[2887] ADD 3 LINES AT BYTLP:-3L	PED	13-DEC-82
	MOVX A,TRPSTK		;[2887] TURN OFF FLAG
	XORM A,TRPDSP		;[2887]  IN TRPDSP
	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

;**;[2887] Add 4 lines at BYTERR:+0L	PED	13-DEC-82
BYTERR:	MOVE Q1,TRPDSP		;[2887] CHECK FLAG IN TRPDSP TO SEE
	TXNE Q1,TRPSTK		;[2887]  IF INTERRUPT OCCURRED IN BYTBLT 
	ADJSP P,-1		;[2887] IT DIDN'T, ADJUST STACK
	SETZM TRPDSP		;[2887] AND TURN OFF TRPDSP
	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)
	TLZ Q3,777740		;CLEAR ALL BUT EFFECTIVE ADDRS
	TXO Q3,<XMOVEI B,>	;BUILD INSTR
	XCT SMVITB(P5)		;GET ADDRS

;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
	TLZ Q3,777740		;CLEAR ALL BUT EFFECTIVE ADDRS
	TXO Q3,<XMOVEI C,>	;BUILD INSTR
	XCT DMVITB(P5)		;GET ADDRS
	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

; 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
;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
;**;[1818] Add one line at ATSMOV: +4L	JGZ	14-DEC-80
   REPEAT 0,<			;[1818] 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
;**;[1818] Add one line at DMPINI: +10L	JGZ	14-DEC-80
   >				;[1818] 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
;**;[1790] Delete 4 lines at .DUMPI: +1L	JGZ	29-SEP-80
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
;**;[1790] Delete 4 lines at .DUMPO: +1L	JGZ	29-SEP-80
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
;**;[1790] Insert one line at DUMPC: -4L	JGZ	29-SEP-80
   REPEAT 0,<			;[1790] 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

;**;[1790] Add several lines at LCKTST: -1L	JGZ	29-SEP-80
   >				;[1790] END OF REPEAT ZERO ON HISTORICAL CODE

;[1790] LCKTST - CALLING ROUTINE FOR LCKTSS SCHEDULER TEST

	RESCD			;[1790]

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)

;**;[1790] Add one line at DMPTST: +0L	JGZ	29-SEP-80
   REPEAT 0,<			;[1790] MORE HISTORICAL CODE NO LONGER USED
DMPTST:	CAML 1,DMPCNT
	JRST 0(4)
	JRST 1(4)
;**;[1790] Add one line at DMPTST: +3L	JGZ	29-SEP-80
   >				;[1790] END OF REPEAT ZERO ON HISTORICAL CODE
	SWAPCD

	TNXEND
	END