;<FOONEX>IO.MAC;19 18-Mar-81 19:45:31, Edit by MMCM
; SUMEX ERJMP/ERCAL additions
;<FOONEX>IO.MAC;18 14-Mar-81 13:11:49, Edit by MMCM
;VARIOUS KLUDGES TO MAKE CHAOSNET JFN'S WORK IN INPUT OR OUTPUT MODE
;<134-TENEX>IO.MAC;17    28-Mar-80 20:32:22    EDIT BY PETERS
; Moved IOXBUF declaration into PARAMS
;<134-TENEX>IO.MAC;16    27-Jan-80 17:36:53    EDIT BY PETERS
; Fix KAFLG to KAFLG!F3FLG
;<134-TENEX>IO.MAC;15    28-Nov-79 16:00:01    EDIT BY PETERS
;#1 Fixed ancient eof bug in sin
;<134-TENEX>IO.MAC;14     2-Jul-79 14:31:46    EDIT BY PETERS
;<134-TENEX>IO.MAC;13    10-Sep-78 18:08:35    EDIT BY PETERS
;<134-TENEX>IO.MAC;12    10-Sep-78 16:28:01    EDIT BY PETERS
;<134-TENEX>IO.MAC;11    10-Sep-78 14:41:01    EDIT BY PETERS
;<TENEX-SOURCES>IO.MAC;13416  14-JUL-77 13:31:25  EDIT BY DALE
;[BBN] Add .SOUT2 (which for now equals .SOUT)
;<XTENEX>IO.MAC;9503  10-JUL-76 15:31:42  EDIT BY DALE
;[ISI] Bug fix at DMPSE7+11: force UMOVES to avoid possible AC value
;<XTENEX>IO.MAC;9502  10-FEB-76 03:35:53  EDIT BY DALE
;[ISI] force SIN on MLP thru SINOLD
;<XTENEX>IO.MAC;9501  20-JAN-76 18:44:54  EDIT BY DALE
;[1.34] don't use locking macros with FILLCK, LCKTST = CNTLCK (See SCHED),
;[1.34] correct check for page existance @ DMPSE5,
;[1.34] NIN remembers errors into LSTERR
;<XTENEX>IO.MAC;4  16-JUN-75 12:13:09  EDIT BY DALE
;[ISI] allow lowercase input to be recognized valid in NIN (DIGIN1+3 lit)
;<XTENEX>IO.MAC;3  16-APR-75 21:40:00  EDIT BY DALE
;[ISI] corrected disastrous typeo at BYTBL1+33
;<XTENEX>IO.MAC;2  26-FEB-75 22:48:46  EDIT BY DALE
;[ISI] added necessary KI mods to BYTBLT,
;[ISI] replaced STRDEV with STRDTB
;<133-TENEX>IO.MAC;86    19-SEP-74 11:45:12    EDIT BY ALLEN
; CORRECT BUG IN LCKTST
;<133-TENEX>IO.MAC;85    16-SEP-74 19:56:39    EDIT BY ALLEN
; CORRECT LCKTST SO THAT LOCK MAY BE ADDRESSED BY ANY AC EXCEPT P
;<133-TENEX>IO.MAC;84     4-SEP-74 17:17:20    EDIT BY ALLEN
; FIX BUG IN LCKTST WHEN INDEXING INTO TABLE OF LOCKS
;<133-TENEX>IO.MAC;83     4-SEP-74 16:28:51    EDIT BY ALLEN
; CORRECT ERROR IN DISPLACEMENT FROM FRAME BASE IN DEFINITIONS
; OF BYTREM, BYTSIZ AND TRMBYT
;<133-TENEX>IO.MAC;82    11-JUL-74 17:50:29    EDIT BY CLEMENTS
; SIOR FIX FOR BYTE COUNT 0 SIN
;<TENEX-132>IO.MAC;81    19-JUN-74 12:55:01    EDIT BY TOMLINSON
; FIXED FAST SIN BUG WITH 0 AC3 (FAILED TO COUNT FINAL BYTE)
; REMOVED NULL SUPPRESSOR FROM BYTIN
;<TENEX-132>IO.MAC;80    14-MAY-74 09:02:02    EDIT BY TOMLINSON
; INTERNED DOINT FOR FILE INTERRUPTS
;<TENEX-132>IO.MAC;79    17-APR-74 21:42:42	EDIT BY TOMLINSON
; MISSING JRST EDESX1 AFTER PUSHJ P,FIXPTR IN PSOUT
;<TENEX-132>IO.MAC;78    16-APR-74 15:52:48	EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;77    16-APR-74 14:19:25	EDIT BY TOMLINSON
; INSTALL CHECKS FOR INDIRECTION/INDEXING OF BYTE POINTERS
;<TENEX-132>IO.MAC;76    15-APR-74 13:11:47	EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;75     1-APR-74 20:30:01	EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;74     1-APR-74 19:53:25	EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;73     1-APR-74 19:21:15	EDIT BY TOMLINSON
; CONVERTED CHKJFN TO RETURN DOUBLE SKIP FOR NIL DESIGNATOR
;<TENEX-132>IO.MAC;72     1-APR-74 19:03:08	EDIT BY TOMLINSON
; ALLOW RADIX UP TO 36 FOR NIN
;<TENEX-132>IO.MAC;71    25-NOV-73 23:23:48	EDIT BY CLEMENTS
; YET ANOTHER FIX TO NO FREE 0 ON END OF -N TYPE SIN
;<TENEX-132>IO.MAC;70    10-NOV-73 20:01:14	EDIT BY CLEMENTS
;<TENEX-132>IO.MAC;69    10-NOV-73 14:34:14	EDIT BY CLEMENTS
; KI CHANGES, SMALL BUG FIXES
;<TENEX-132>IO.MAC;68    13-JUN-73 21:12:19	EDIT BY CLEMENTS
;<TENEX-132>IO.MAC;67     9-APR-73 16:11:23	EDIT BY TOMLINSON
; FIXED NEG WORD COUNT SIN TO NOT APPEND 0 BYTE
;<TENEX-132>IO.MAC;66     3-APR-73 18:04:30	EDIT BY PLUMMER
;<TENEX-132>IO.MAC;65    12-MAR-73 13:16:25	EDIT BY TOMLINSON
; Fix BYTBL1 to leave unused bits 0
;<TENEX-132>IO.MAC;63     6-MAR-73 12:59:49	EDIT BY TOMLINSON
; MISC FIXES TO SIN/SOUT
;<TENEX-132>IO.MAC;62    23-FEB-73 18:03:51	EDIT BY CLEMENTS
;<TENEX-132>IO.MAC;61    22-FEB-73 18:45:00	EDIT BY CLEMENTS
;<TENEX-132>IO.MAC;60    13-FEB-73 19:58:17	EDIT BY CLEMENTS
;<TENEX-132>IO.MAC;57    26-JAN-73 08:45:16	EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;56    24-JAN-73 22:42:43	EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;55    24-JAN-73 16:07:56	EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;54    24-JAN-73 14:40:10	EDIT BY TOMLINSON
;<TENEX-131>IO.MAC;53    10-JAN-73 11:00:09	EDIT BY TOMLINSON
;<TENEX-131>IO.MAC;52     9-JAN-73 14:36:18	EDIT BY TOMLINSON
; FIXED DUMPI/O LOCKUP BUG
;<TENEX-130>IO.MAC;51    20-NOV-72 13:14:45	EDIT BY TOMLINSON
; ADDED OPNF CHECK IN RIN
;<FILESYSTEM>IO.MAC;50    25-AUG-72 17:38:36	EDIT BY TOMLINSON
;<FILESYSTEM>IO.MAC;49    25-AUG-72 16:08:17	EDIT BY TOMLINSON
;<FILESYSTEM>IO.MAC;48    25-AUG-72 15:45:03	EDIT BY TOMLINSON
;<FILESYSTEM>IO.MAC;47    29-JUN-72  9:59:08	EDIT BY TOMLINSON

	SEARCH	PROLOG,STENEX
	TITLE	IO
	SUBTTL	R.S.Tomlinson

EXTERN	CPOPJ,SKPRET,SK2RET,SK3RET,ERRSAV,LSTERR,PRIMRY,CAPENB
EXTERN	PBYTSZ,PBYTPO
EXTERN	EDISMS,ERRD,FKHPTN,FPTA,MJRSTF,MLKPG,MRPT,MULKPG,SKIIF,BHC
EXTERN	NILDTB,STRDTB,TTYDTB,SFBNR
EXTERN	ITRAP,TTFORK,JOBPT,DISGE,MENTR,MRETN,MSTKOV,MRTNE1
EXTERN	MRPACS,SETMPG

	USE	SWAPPC

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

DEFINE	FILABT(N,EXTRA)<
JRST [	EXTRA
	MOVEI A,N
	JRST ABTDO]>

DOINT::	MOVEM JFN,ERRSAV
	MOVEM A,LSTERR
	TEST(NE,HLTF)
	JRST ABTDO		; Halt on these conditions
	MOVEI 1,400000
	MOVSI 2,(1B11)
	PUSHJ P,JSERT##		; ERJMP/ERCAL handling?
	 POPJ P,		; Yes, don't interrupt
	IIC
	POPJ P,

ABTDO:	MOVEM A,LSTERR
	PUSHJ P,UNLCKF
	JRST ITRAP

; Check tenex source/destination designator
; Call:	JFN		; The designator
;	PUSHJ P,CHKJFN
; Return
;	+1	; Error, as has error #
;	+2	; Tty
;	+3	; Byte pointer, or other special designator type (e.g. NIL:)
;	+4	; File
; In all cases, the following is set up
;	LH(DEV)	; Unit number (tty no dta no etc)
;	RH(DEV)	; Loc of device dispatch table
;	JFN	; True jfn for files, byte pointer for same
;	STS	; File status bits
; The file is locked if it is a file


CHKJFN::SETZB F,F1
	TLNE JFN,777777		; Lh zero?
	JRST CHKJF1		; No, some kind of byte pointer
	CAIN JFN,100		; Primary input designator?
	HLRZ JFN,PRIMRY		; Get primary input jfn from psb
	CAIN JFN,101		; Primary output designator?
	HRRZ JFN,PRIMRY		; Get primary output jfn from psb
	CAMGE JFN,MAXJFN	; Possibly a jfn?
	JRST CHKJF3		; Yes
	CAIN JFN,777777		; Controlling tty
	JRST CHKJF4		; Yes
	CAIN JFN,377777		; Nil designator
	 JRST CHKJFW		; Yes.
	CAIGE JFN,400000+NLINES	; Valid tty designator?
	CAIGE JFN,400000
	JRST CHKJF7		; No, garbage designator
	HLRZ DEV,TTFORK-400000(JFN)	; Get assignment of tty
	CAIE DEV,777777		; Unattached?
	CAMN DEV,JOBNO		; Or assigned to this job?
	JRST CHKJF5		; Yes, ok to use
	MOVE A,CAPENB
	TRNE A,WHEEL!OPR
	JRST CHKJF5
IFN NPTY,< ; PARTIAL CODE FOR PTY'S - NOT YET SUPPORTED
	SUBI JFN,400000+PTYLO	;SEE IF DEV DESIG IS A PTY
	CAIL JFN,0		;RANGE CHECK
	CAIL JFN,NPTY		; ..
	JRST CHKJF0		;NO. GIVE UP
	MOVE DEV,PTYJOB##(JFN)	;YES. SEE IF THIS JOB OWNS IT.
	ADDI JFN,400000+PTYLO	;RESTORE JFN TO TTY DESIGNATOR
	CAMN DEV,JOBNO
	JRST CHKJF5		;JOB MATCHES. ACCEPT THIS DESIGNATOR
>;END COND ON NPTY
CHKJF0:	MOVEI A,DESX2		; Illegal tty designator
	POPJ P,

CHKJF4:	MOVE A,JOBNO
	MOVEI A,JOBPT(A)
	SKIPGE DEV,(A)
	PUSHJ P,DISGE		; Dismiss until it is greater or equal
	SKIPGE DEV,(A)
	JRST CHKJF4
	HLRZS DEV
	MOVEI JFN,400000(DEV)
CHKJF5:	MOVEI DEV,TTYDTB	; Set up dev to be tty
	HRLI DEV,-400000(JFN)	; And the proper unit
	HRLZI STS,READF!WRTF!OPNF
	JRST SKPRET		; Skip return

CHKJFW:	MOVEI DEV,NILDTB
	HRLZI STS,READF!WRTF!OPNF
	JRST SK2RET

CHKJF3:	LSH JFN,SJFN
	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]
	MOVE STS,FILSTS(JFN)
	TEST(NN,NAMEF)
	JRST CHKJF8
	TEST(NN,FRKF)		; Test for file restricted to one fork
	JRST CHKJF9
	HLRZ A,FILVER(JFN)
	PUSHJ P,SKIIF
	JRST CHKJF8		; Can't access
CHKJF9:	MOVE DEV,FILDEV(JFN)	; Set up dev
	HRRZ A,DEV
	CAIN A,TTYDTB
	 JRST [	SETOM FILLCK(JFN)
		OKINT
		JRST .+1]
	JRST SK3RET		; Triple skip return

CHKJF8:	SETOM FILLCK(JFN)
	OKINT
CHKJFB:	MOVEI A,DESX3
	POPJ P,

CHKJF1:	MOVE A,JFN
	CALL FIXPTR
	 JRST CHKJF7		; BAD DESIGNATOR
	MOVEM A,JFN
	MOVEI DEV,STRDTB	; Set up to dispatch to string routines
	HRLZI STS,READF!WRTF!OPNF
	JRST SK2RET		; Double skip return

CHKJF7:	MOVEI A,DESX1		; Garbage designator
	POPJ P,

; Unlock file
; Call:	JFN	; Job file number
;	STS	; New filsts
;	PUSHJ P,UNLCKF

UNLCKF::TLNE JFN,777777
	UMOVEM JFN,1
	CAIL JFN,0
	CAIL JFN,RJFN
	POPJ P,
	MOVEM STS,FILSTS(JFN)
	PUSH P,A
	MOVEI A,(DEV)
	CAIN A,TTYDTB
	 JRST [	POP P,A
		POPJ P,]
	POP P,A
	SETOM FILLCK(JFN)
	OKINT
	POPJ P,

NOTOPN:	FILABT CLSX1

EDESX1:	MOVEI A,DESX1
IOERR::	MOVEM A,LSTERR
	JRST ITRAP

; Bin from primary io file
; Call:	1	; Character
;	PBIN

.PBIN::	JSYS MENTR
	MOVEI JFN,100
	PUSHJ P,BYTIN
	UMOVEM B,1
	JRST MRETN

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

PS(BIOAC0)

.BIN::	NOINT
	JUMPL 1,SLBIN
	CAML 1,MAXJFN		; Possible a jfn?
	JRST SLBIN
	LSH 1,SJFN
	AOSE FILLCK(1)
	JRST SLBIN0
	MOVE 2,FILSTS(1)
	TLC 2,OPNF!READF
	TLCN 2,OPNF!READF
	TLNE 2,ERRF!FRKF
	JRST SLBIN1
	SOSGE FILCNT(1)
	JRST SLBIN2
	AOS 2,FILBYN(1)
	CAMLE 2,FILLEN(1)
	JRST SLBIN3
	ILDB 2,FILBYT(1)
	SETOM FILLCK(1)
	LSH 1,-SJFN
	OKINT
	XCT MJRSTF

SLBIN3:	SOS FILBYN(1)
SLBIN2:	AOS FILCNT(1)
SLBIN1:	SETOM FILLCK(1)
SLBIN0:	LSH 1,-SJFN
SLBIN:	OKINT
	JSYS MENTR		; Become slow etc.
	MOVE JFN,1
	PUSHJ P,BYTIN		; Read the byte
	XCTUU [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::	JSYS MENTR
	MOVE JFN,1
	PUSHJ P,CHKJFN
	JRST IOERR
	JFCL
	FILABT DESX4		; Tty and byte designators are illegal
	JUMPGE STS,NOTOPN
	TEST(NN,RNDF)
	FILABT IOX3		; Illegal to change pointer
	TEST(NN,READF)
	FILABT IOX1		; Illegal to read
IFDEF CHAOS,<HRRZ A,DEV
	CAIN A,CHADTB##
	 CALL CHAINP##>		;SET FOR INPUT
	UMOVE A,3
	PUSHJ P,SFBNR		; Set up byte pointer
	JRST ABTDO
	PUSHJ P,BYTINA		; Get the byte
	UMOVEM B,2
	JRST MRETN

; String input jsys
; 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
; 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.

.SIN::	JSYS MENTR		; Become slow etc.
SIN0:	UMOVE JFN,1
	CAIN JFN,100
	 JRST SINOOO		; DO IT THIS WAY TO GET ECHOOS DONE
	PUSHJ P,SIOR1		; CHECK JFN ETC
	 JRST SINTTY		; TTY
	 JRST [	CAIE DEV,STRDTB
		 JRST .+1
		JRST SINBYT]	; BYTE POINTER
	TEST(NN,READF)
	 FILABT(IOX1)		; ILLEGAL READ
IFDEF CHAOS,<HRRZ A,DEV
	CAIN A,CHADTB##
	 CALL CHAINP##>		;SET FOR INPUT
	MOVE A,FILLEN(JFN)	;#1 GET TOTAL LENGTH OF FILE IN BYTES
	SUB A,FILBYN(JFN)	;#1 MINUS PTR GIVES BYTES UNTIL EOF
	CAMGE A,FILCNT(JFN)	;#1 IF THIS IS FEWER THAN BYTES LEFT IN BUFFER
	 MOVEM A,FILCNT(JFN)	;#1 THEN CLOBBER SO EOF WORKS
	SKIPG FILCNT(JFN)	; ANY BYTES IN BUFFER?
	 JRST SINOLD		; NO, DO IT THE SLOW WAY
	MOVE A,FILBYT(JFN)	; SOURCE POINTER
	UMOVE B,2		; TARGET
	MOVE D,[1B3+1]		; FROM FILE, TO USER.
	PUSHJ P,SIOR2		; SET UP REST OF ARGS AND DO BYTBLT
	UMOVEM B,2		; UPDATE POINTERS
	MOVEM A,FILBYT(JFN)
	PUSHJ P,UNLCKF		; UNLOCK FILE TO ALLOW INTS
	JUMPN D,SIN0		; DO MORE IF NOT DONE
	JUMPN E,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
	MOVE D,[1B2+3]		; BYTE POINTER AND USER TO USER
	PUSHJ P,SIOR2
	UMOVEM B,2
	UMOVEM A,1
	JRST SIN3

; DO SLOW SIN FOR ONE BYTE

SINOOO:	UMOVE A,2
	PUSHJ P,FIXPTR		; FIX UP POINTER
	 JRST EDESX1
	UMOVEM A,2
	PUSHJ P,BYTIN
	JRST SINOL1

SINTTY:
SINOLD:	PUSHJ P,BYTINA		; Read a byte from the source
SINOL1:	JUMPE B,[TEST(NN,EOFF)
		XCTUU [SKIPN 3]
		JRST SIN2
		JRST .+1]
IFN KAFLG!F3FLG,<
	XCTUU [IDPB B,2]>	; Deposit the byte
IFN KIFLG,<			; ON KI-10, MUST HANDLE WITH
	XCTUU [MOVE 3,2]	;  THE POINTER IN MONITOR SPACE
	TLNE 3,37		; AND INDIRECTING/INDEXING
	FILABT DESX1		;  DOESN'T WORK
	XCTUU [IDPB B,3]	; OK. STORE THE BYTE
	XCTUU [MOVEM 3,2]	; RETURN UPDATED POINTER
>
	JSP A,SIONXT		; Test for end of string
	JRST SIN0		; Not end, continue

SIN3:	XCTUU [SKIPE 3]		; NON-ZERO COUNT CASE?
	JRST MRETN		;YES. RETURN.
SIN2:	SETZ B,
	UMOVE A,2
	XCTBU [IDPB B,A]
	JRST MRETN

; SUBROUTINE TO FIX AC2 AND CHECK JFN

SIOR1:	UMOVE A,2
	PUSHJ P,FIXPTR
	 JRST EDESX1
	UMOVEM A,2
	UMOVE JFN,1
	PUSHJ P,CHKJFN
	 JRST IOERR		; GARBAGE
	 POPJ P,
	 JRST [	CAIN DEV,STRDTB
		 AOS 0(P)	; SINGLE SKIP FOR STRING POINTERS
		RET]		; NONE FOR OTHER SPECIAL DESIGNATORS
	TEST(NN,OPNF)
	 FILABT(DESX5)
	CAIL JFN,RJFN
	 POPJ P,
	JRST SK2RET

FIXPTR:	TLC A,777777		; IF LH = -1 CONVERT TO 0
	TLCN A,777777		; UNCONVERT WAS IT -1?
	 HRLI A,440700		; YES. SET TO LEFT BYTE 7-BIT
	TLZN A,37		; DOES POINTER HAVE INDIRECTION OR INDEXING?
	 AOS 0(P)		; NO, GIVE SKIP RETURN
	POPJ P,

; SUBROUTINE TO SET UP REST OF SIN/SOUT AND DO BYTBLT

SIOR2:	UMOVE E,3		; GET COUNT
	MOVM C,E		; MAGNITUDE OF COUNT
	SKIPL E			; TERMINATING BYTE?
	 TLO D,(1B0)		; YES, SET FLAG
	SKIPLE E		; SPECIFIC TERMINATOR?
	 JRST [	UMOVE E,4	; YES. GET (NOTE 0 IN E IF COUNT=0)
		TLO D,(1B1)	; FLAG SPECIFIC TERMINATOR
		JRST .+1]
	SKIPN C			; NON-ZERO COUNT
	 HRLOI C,77		; NO, SET MAX COUNT
	TLNE D,(1B2)		; 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
SIOR23:	PUSH P,C		; SAVE COUNT
	PUSHJ P,BYTBLT		; DO THE TRANSFER
	SUB C,0(P)		; GET NEG OF BYTES TRANSFERRED
	TLNE D,(1B2)		; BYTE POINTER IN JFN?
	 JRST SIOR24
	TLNE D,(1B4)		; WAS AN EXTRA BYTE READ BUT NOT WRITTEN
	TLNN D,(1B3)		; YES. IS THIS A SIN?
	 SKIPA E,C		; NO. USE STRAIGHT COUNT
	  HRREI E,-1(C)		; YES. COMPENSATE FOR THE EXTRA BYTE
	ADDM E,FILCNT(JFN)	; UPDATE FILCNT
	MOVNS E
	ADDB E,FILBYN(JFN)
	CAML E,FILLEN(JFN)
	 MOVEM E,FILLEN(JFN)
SIOR24:	XCTUU [SKIPGE E,3]	; WHAT KIND OF COUNT
	 MOVNS C		; MAKE SIGN AGREE
	JUMPE E,SIOR21		; DON'T UPDATE COUNT IF 0
	XCTUU [ADDB C,3]	; DO UPDATE
	JUMPE C,SIOR22		; IF COUNT BECOMES 0, THEN DONE
	SKIPL C			; NOT DONE IF NEG COUNT SUPPLIED & STILL
SIOR21:	TLNE D,(1B0)		; ELSE DONE IF TERMINATOR FOUND
	TROA D,-1		; NOT DONE, SET D NON-0
SIOR22:	SETZ D,			; DONE, SET D = 0
	SUB P,BHC+1
	POPJ P,

; Check for end of string io string
; Call:	B	; Character just transfered
; User	3	; Sin/sout argument
; User	4	; Sin/sout argument
;	JSP A,SIONXT
; Return
;	+1	; Continue
;	MRETN	; If no more left to do
; Updates user 3

SIONXT:	TLNE JFN,777777		; If byte pointer,
	UMOVEM JFN,1		; Restore updated jfn
	XCTUU [SKIPN C,3]
	JRST (A)
SIO1:	JUMPG C,SIO2		; Positive
	XCTUU [AOSGE 3]
	JRST (A)
	JRST MRETN

SIO2:	XCTUU [SOSLE 3]
	XCTUU [CAMN B,4]
	JRST MRETN
	JRST (A)

IFN KAFLG!F3FLG,<	;[ISI] for KA, define MOVE/MOVEM .xor. UMOVE/UMOVEM
MXUM==<<MOVE>&<-1-<UMOVE>>>!<<-1-<MOVE>>&<UMOVE>>
MXUMM==<<MOVEM>&<-1-<UMOVEM>>>!<<-1-<MOVEM>>&<UMOVEM>>
>

; Accumulators

; Arguments...returned updated

SRC=1		; Source byte pointer
TGT=2		; Target byte pointer
CNT=3		; Byte count
MOD=4		; Mode

; Temporaries

T1=5
T2=6
T3=7

; Program space starts here

PRG==T3

P=17
FRM=16

; Local variables

DEFINE	BYTREM<4(FRM)>
DEFINE	BYTSIZ<5(FRM)>
DEFINE	TRMBYT<6(FRM)>

NLCLS==3

; Move bytes
; Call:
; 1/	SOURCE POINTER
; 2/	TARGET POINTER
; 3/	BYTE COUNT
; 4/	MODE BITS AS FOLLOWS:
;	B1/	TRANSFER TERMINATOR BYTE
;	B0/	TRANSFER UNTIL TERMINATOR
;	B34/	FROM USER
;	B35/	TO USER
; E/	TERMINATOR IF ANY

BYTBLT::PUSH P,FRM		; Save old frm
	MOVE FRM,P		; Set up frame base
	PUSH P,T1		; Save temps
	PUSH P,T2
	PUSH P,T3
	ADD P,BHC+NLCLS		; Cover space for locals
	JUMPGE P,MSTKOV
	MOVEM E,TRMBYT		; Shuffle args

; Preliminaries out of the way
; Now get to work

BYTB1:	TLNE MOD,(1B0)		; Terminator?
	 JRST CHKTRM		; Yes, look for it
	TLNN TGT,7700		; Zero byte size?
	 JRST BYTLP		; Well...if you insist
	MOVE T1,TGT		; Compare target
	XOR T1,SRC		; To source
	TLNN T1,7700		; And if byte size differs
	CAIG CNT,20		; Or short transfer
	 JRST BYTLP		; Do byte at a time
	LDB T2,[POINT 6,TGT,11]	; Get byte size
	MOVEM T2,BYTSIZ		; Save it
	ROT T2,-6		; Position in p field
LP1:	SOJL CNT,DONE		; Until cnt < 0
	XCT LDBTB(MOD)		; Do transfer bytes
	XCT DPBTB(MOD)
	CAMG T2,TGT		; Until less than 1 byte remains in tgt
	 JUMPGE T2,LP1		; Loop unless bytesize >= 32
				; (once is always enough)
BYTB2:	MOVEI T1,^D36		; Word size
	IDIV T1,BYTSIZ		; Compute bytes/word and remainder
	MOVEM T1+1,BYTREM	; Save remainder
	MOVE T2,CNT
	IDIV T2,T1		; Compute words to transfer
	MOVEM T2+1,CNT		; Remaining bytes
	JUMPE T2,BYTLP		; Zero words...do byte at a time
	HLLO T1,SRC		; Get source...prevent borrows
	SUB T1,TGT		; When getting bit offset
	ROT T1,6
	ANDI T1,77		; Retain just the position difference
	JUMPN T1,BYTBL1		; Move word at a time
	HRLZ T1,SRC		; Make blt pointer
	HRR T1,TGT
	ADD T1,BHC+1		; Adjust 'cause byte pointer behind by 1
	ADDM T2,SRC		; Adjust src by word count
	ADDB T2,TGT		; And adjust tgt
	XCT BLTTB(MOD)		; Blt t1,0(t2)
BYTLP:	JUMPLE CNT,DONE		; Do rest a byte at a time
BYTLP1:	XCT LDBTB(MOD)
	XCT DPBTB(MOD)
	SOJG CNT,BYTLP1
DONE:	SUB P,BHC+NLCLS		; Flush local storage
	POP P,T3		; Restore temps
	POP P,T2
	POP P,T1
	POP P,FRM		; Restore frm
	POPJ P,

; Transfer a word at a time
; T1/	POSITION OFFSET (RIGHT SHIFT AMOUNT)
; T2/	WORD COUNT
; Bytrem/ lsh amount to right justify first word

BYTBL1:	ADD P,BHC+LPRG-1	; Make room to save ac's
	JUMPGE P,MSTKOV
	MOVSI T3,PRG+1
	HRRI T3,2-LPRG(P)
	BLT T3,0(P)		; Save ac's
	MOVE PRG+LPRG-2,[PROTO,,PRG]
	BLT PRG+LPRG-2,PRG+LPRG-2	; Load up proto program except last word
	HRRI PRG+0,0(SRC)	; Address of first move
	HRRI PRG+1,1(SRC)	; Address of second move
	HRR PRG+4,BYTREM	; Fill in shift amount to left justify
	MOVNS BYTREM		; Get right shift amount
	HRR PRG+2,BYTREM	; Fill in LSH
	MOVNS T1		; NEGATE OFFSET
	ADD T1,BYTREM		; Total right shift = offset + remainder
	CAMG T1,[-^D18]		; Less than half a word?
	 TLCA PRG+4,(<Z <<T1&<-1-T2>>!<<-1-T1>&T2>>,0>)
				; My kingdom for an xor operator
				; Change ac of lsh from t1 to t2
	  TLCA PRG+5,(<Z <<T1&<-1-T2>>!<<-1-T1>&T2>>,0>)
				; No, change ac of MOVEM to T1
	ADDI T1,^D36		; Leave movem t1, change shift amount
	HRRI PRG+5,1(TGT)	; Address of movem
	HRRM T1,PRG+3		; Fill in lshc amount
	ADDM T2,TGT		; Update target
	ADDM T2,SRC		; And source
	PUSH P,SRC		; Want to use SRC for AOBJN
	MOVNS T2		; Make aobjn
	HRLZ SRC,T2		; word in SRC
	MOVE PRG+LPRG-1,PROTO+LPRG-1; Last word of program
IFN KAFLG!F3FLG,<	;[ISI] possible change of MOVE/MOVEM to UMOVE/UMOVEM
	TRNE MOD,1		;Is to "user"?
	 TLC PRG+5,(MXUMM)	; yes, use UMOVEM
	TRNN MOD,2		;Is from "user"?
	JRST PRG		; No, do the program, return to BYTLPD
	 TLC PRG+0,(MXUM)	; yes, use "UMOVE"
	 TLC PRG+1,(MXUM)
	JRST PRG		;Do the program, return to BYTLPD
>
IFN KIFLG,<	;[ISI] do same for KI, but in a more difficult way..
	PUSH P,PRG+5		;KI has no wired UMOVE/UMOVEM,
	PUSH P,PRG+1		;  so push instructions and replace with
	PUSH P,PRG+0		;  "XCTUU stack" if necessary
	TRNE MOD,1
	 MOVE PRG+5,[XCTUU -2(P)]
	TRNN MOD,2
	JRST PRG
	 MOVE PRG+0,[XCTUU -0(P)]
	 MOVE PRG+1,[XCTUU -1(P)]
	JRST PRG
>

BYTLPD:
IFN KIFLG,<	;[ISI] remove UMOVEx literals from stack
	SUB P,BHC+3 >
	POP P,SRC
	MOVSI T1,2-LPRG(P)	; Cleanup
	HRRI T1,PRG+1
	BLT T1,PRG+LPRG-1
	SUB P,BHC+LPRG-1
	JRST BYTLP		; Finish up any odd bytes

; Transfer til terminator

CHKTRM:	JUMPLE CNT,DONE
CHKTR1:	XCT LDBTB(MOD)
	CAMN T1,TRMBYT
	 JRST [	TLZ MOD,(1B0)	; TERMINATOR HAS BEEN SEEN
		TLNN MOD,(1B1)	; SPECIFIC TERMINATOR (I.E. KEEP IT?)
		 JRST [	TLO MOD,(1B4)
			JRST DONE]
		XCT DPBTB(MOD)
		SOJA CNT,DONE]
	XCT DPBTB(MOD)
	SOJG CNT,CHKTR1
	JRST 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 T1,SRC
	ILDB T1,SRC
	XCTBU LDBTB
	XCTBU LDBTB

DPBTB:	IDPB T1,TGT
	XCTBU DPBTB
	IDPB T1,TGT
	XCTBU DPBTB

BLTTB:	BLT T1,0(T2)
	XCTMU BLTTB
	XCTUM BLTTB
	XCTUU BLTTB

; 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 T1 if shift left and T2 if right
; Furthermore, the MOVE's and MOVEM's may be changed to UMOVE or
; UMOVEM's depending on the address space of SRC and TGT respectively

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

; Byte input subroutine
; Call:	1	; Source designator
;	PUSHJ P,BYTIN
; Return
;	+1	; Ok
;	B	; A byte
; Clobbers most everything

BYTIN::	MOVS B,PRIMRY
	CAIN JFN,100		; If not from primary input
	CAMN B,PRIMRY		; Or if primary input = output
	 JRST BYTINQ		; Not special
	PUSHJ P,BYTINQ		; Otherwise, do byte in
	JUMPE B,CPOPJ		; Cone if null
	EXCH A,B
	PBOUT
	EXCH A,B
	POPJ P,

BYTINQ:	PUSHJ P,CHKJFN		; Check the designator
	JRST IOERR		; Bad designator
	JFCL			; Tty
	JFCL			; Byte pointer, or special designator
IFDEF CHAOS,<HRRZ A,DEV
	CAIN A,CHADTB##
	 CALL CHAINP##>		;SET FOR INPUT
BYTINA:	JUMPGE STS,NOTOPN
	TEST(NN,READF)
	FILABT IOX1		; Illegal read
	TEST(NE,ERRF)
	FILINT(IOX5)		; Generate data error interrupt
	TEST(NE,EOFF)
	JRST INEOF
	PUSHJ P,@BIND(DEV)	; Dispatch to device dependent code
	TEST(NE,ERRF)
	FILINT(IOX5)
	TEST(NE,EOFF)
	JRST INEOF
	MOVE B,A
	JRST UNLCKF

INEOF:	MOVEI A,IOX4
	MOVEM A,LSTERR
	MOVEM JFN,ERRSAV
	MOVEI 1,400000
	MOVSI 2,(1B10)
	PUSHJ P,JSERT##		; ERJMP/ERCAL handling?
	 SKIPA			; Yes, don't interrupt
	  IIC			; Initiate interrupt on channel 10
	MOVEI B,0
	JRST UNLCKF

; Output to primary output file
; Call:	1	BYTE
;	PBOUT

.PBOUT::JSYS MENTR
	MOVEI JFN,101
	UMOVE B,1
	PUSHJ P,BYTOUT
	JRST MRETN

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

.BOUT::	NOINT
	JUMPL 1,SLBOU
	CAML 1,MAXJFN		; Possibly a jfn?
	 JRST SLBOU		; Not possible
	LSH 1,SJFN		; Convert number to index
	AOSE FILLCK(1)
	JRST SLBOU0
	MOVEM C,BIOAC0
	MOVE C,FILSTS(1)
	TLC C,OPNF!WRTF
	TLCN C,OPNF!WRTF
	TLNE C,FRKF!ERRF
	JRST SLBOU1
	SOSGE FILCNT(1)
	JRST SLBOU2
	AOS C,FILBYN(1)
	CAMLE C,FILLEN(1)
	MOVEM C,FILLEN(1)
	IDPB 2,FILBYT(1)
	MOVE C,BIOAC0
	SETOM FILLCK(1)
	LSH 1,-SJFN
	OKINT
	XCT MJRSTF

SLBOU2:	AOS FILCNT(1)
SLBOU1:	MOVE C,BIOAC0
	SETOM FILLCK(1)
SLBOU0:	LSH 1,-SJFN
SLBOU:	OKINT
	JSYS MENTR
	MOVE JFN,1
	PUSHJ P,BYTOUT		; Output the byte
	JRST MRETN

; Random output jsys
; Call:	1	; Tenex source designator
;	2	; A byte
;	3	; Byte number
;	ROUT

.ROUT::	JSYS MENTR
	MOVE JFN,1
	PUSHJ P,CHKJFN
	JRST IOERR
	JFCL
	FILABT DESX4		; Tty and byte designators are illegal
	JUMPGE STS,NOTOPN
	TEST(NN,RNDF)
	FILABT IOX3		; Illegal to change pointer
	TEST(NN,WRTF)
	FILABT IOX2		; Illegal write
IFDEF CHAOS,<HRRZ A,DEV
	CAIN A,CHADTB##
	 CALL CHAOUP##>		;SET FOR OUTPUT
	UMOVE A,3
	PUSHJ P,SFBNR
	JRST ABTDO
	UMOVE B,2
	PUSHJ P,BYTOUA
	JRST MRETN

; String output to primary io file
; Call:	1	; String pointer, designator, or location of string
;	PSOUT

.PSOUT::JSYS MENTR
PSOUT1:	TLCE A,777777		; IS LH = 0?
	 TLC A,777777		; NO. UNCOMPLEMENT
	PUSHJ P,FIXPTR		; YES. LEAVE IT -1 AND FIX IT UP ANYWAY
	 JRST EDESX1
PSOUT0:	PUSH P,A		; Make a copy of byte pointer
	XCTBU [ILDB B,0(P)]
	JUMPE B,[XCTMU [POP P,1]
		JRST MRETN]
	MOVEI JFN,101
	PUSHJ P,BYTOUT
	POP P,A
	UMOVEM A,1
	JRST PSOUT0

; PRIMARY ERROR STRING OUTPUT

.ESOUT::JSYS MENTR
	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.

.SOUT2::			;[BBN]
.SOUT::	JSYS MENTR		; Become slow etc
SOUT0:	PUSHJ P,SIOR1		; FIX UP AC2, CHECK JFN
	 JRST SOUTTY
	 JRST [	CAIE DEV,STRDTB
		 JRST .+1
		JRST SOUBYT]
	TEST(NN,WRTF)
	 FILABT(IOX2)
IFDEF CHAOS,<HRRZ A,DEV
	CAIN A,CHADTB##
	 CALL CHAOUP##>		;SET FOR OUTPUT
	SKIPG FILCNT(JFN)
	 JRST SOUTLD		; DO IT THE OLD WAY
	MOVE B,FILBYT(JFN)	; TARGET IS FILE
	UMOVE A,2		; SOURCE IS USER
	MOVEI D,2
	PUSHJ P,SIOR2
	UMOVEM A,2
	MOVEM B,FILBYT(JFN)
	PUSHJ P,UNLCKF
	JUMPN D,SOUT0
	JRST MRETN

; SOUT TO STRING POINTER

SOUBYT:	MOVE B,JFN
	UMOVE A,2
	MOVE D,[1B2+3]
	PUSHJ P,SIOR2
	UMOVEM A,2
	UMOVEM B,1
	MOVEM B,JFN
	PUSHJ P,APPNUL		; APPEND NULL
	JRST MRETN

; OLD STYLE SOUT

SOUTTY:
SOUTLD:	XCTUM [PUSH P,2]
	XCTBU [ILDB B,0(P)]
	XCTUU [SKIPN 3]
	JUMPE B,[XCTMU [POP P,2]
		PUSHJ P,UNLCKF

		JRST MRETN]	; Don't write zero bytes if arg3 = 0
	PUSH P,B
	PUSHJ P,BYTOUA
	POP P,B
	XCTMU [POP P,2]
	PUSHJ P,APPNUL
	JSP A,SIONXT
	JRST SOUT0

; Byte output subroutine
; Call:	1	; Source designator
;	PUSHJ P,BYTOUT
; Return
;	+1	; Ok
; Clobbers most everything

BYTOUT::PUSHJ P,CHKJFN		; Check the designator
	JRST IOERR		; Bad designator
	JFCL			; Tty
	JFCL			; Byte pointer or special designator
IFDEF CHAOS,<HRRZ A,DEV
	CAIN A,CHADTB##
	 CALL CHAOUP##>		;SET FOR OUTPUT
BYTOUA::JUMPGE STS,NOTOPN
	TEST(NN,WRTF)
	FILABT IOX2		; Illegal write
	TEST(NE,ENDF)
	FILABT(IOX6)		; Past abs end of file
	TEST(NE,ERRF)
	FILINT(IOX5)		; Error interrupt
	MOVE A,B
	PUSHJ P,@BOUTD(DEV)	; Dispatch to device dependent code
	JRST UNLCKF

; 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)
	XCTBU [IDPB C,JFN]
	POP P,C
	POP P,JFN
	POPJ P,

; Dump io
; Parameters and variables

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

; Initialize dump io

	USE	RESPC

DMPINI::MOVEI A,NDUMP
	MOVEM A,DMPCNT
	SETOM DMPLCK
	SETCM A,[-1_<^D36-NDUMP>]
	MOVEM A,DMPASW
	POPJ P,

	USE	SWAPPC

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

.DUMPI::JSYS MENTR
	PUSHJ P,DUMPC		; Call common dump code
	TEST(NN,READF)		; Executed to discover file access
	IOX1			; Error number for no read access
	PUSHJ P,@DMPID(DEV)	; Device dependent routine dispatch
	040400000000		; Memory access needed

; Dump output
; Call:	1	; Jfn
;	2	; Pointer to first command
;	DUMPO
; Return
;	+1	; Error
;	+2	; Ok

.DUMPO::JSYS MENTR
	PUSHJ P,DUMPC
	TEST(NN,WRTF)
	IOX2
	PUSHJ P,@DMPOD(DEV)
	100000000000		; Memory access needed

; Dump common code

DMPSEB:	JUMPE B,[AOS -1(P)
		JRST MRETN]
	UMOVEM B,2
DUMPC:	UMOVE A,2		; Get command pointer
	UMOVE B,(A)		; And command
	JUMPGE B,DMPSEB		; Branch or disconnect
	PUSH P,B		; Save iowd
	HLRE A,B		; - word count
	MOVNS A			; Word count
	ADDI A,(B)		; Last address
	CAILE A,777777		; Must not cross end of memory
	JRST [	MOVEI A,DUMPX3	; Error if happens
		JRST ERRD]
	MOVEI B,1(B)		; First address
	LSH A,-9		; Last page number
	LSH B,-9		; First page number
	SUBM B,A
	SOS A			; -# pages
	CAMGE A,[-NDUMP]
	JRST [	MOVEI A,DUMPX3
		JRST ERRD]	; Too many pages
	NOINT
	MOVE C,-1(P)		; Get saved pc
	PUSH P,3(C)		; Save access bits
	LOCK DMPLCK,<PUSHJ P,LCKTST##>
DMPSE0:	MOVSI B,400000
	ASH B,1(A)		; Get a one for each page needed
	HRLZ C,A		; Initial aobjn word
	PUSH P,DMPCNT		; SAVE CURRENT LEVEL OF AVAILABILITY
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
	EXCH A,0(P)		; SAVE A, GET FORMER DMPCNT
	HRLZS A
	HRRI 1,DMPTST
	JSYS EDISMS		; Dismiss until buffers released
	POP P,1
	JRST DMPSE0		; Then try again

DMPSE2:	SUB P,BHC+1		; FLUSH SAVE DMPCNT
	IORM B,DMPASW		; Mark these buffers as taken
	ADDM A,DMPCNT		; Decrement count of free buffers
	UNLOCK DMPLCK
	PUSH P,C		; Save aobjn word
	HRRZ A,-2(P)		; Get user first address-1
	AOS A
	LSH A,-9		; Page number
IFN KAFLG!F3FLG,<
	JSP B,.+1
	TLNN B,2000		; Call from monitor?
>
IFN KIFLG,<
	MOVE B,-4(P)		; CHECK CALLER'S PC WORD
	TLNE B,(1B5)>		; CALL FROM MONITOR?
	HRLI A,400000		; No, insert fork id

DMPSE3:	PUSH P,A		; Save vulnerable ac's
	PUSH P,C
	JUMPGE A,[LSH A,9
		PUSHJ P,FPTA	; Convert monitor address to ptn.pn
		JRST DMPSE5]
	PUSHJ P,FKHPTN		; Convert user address to ptn.pn
DMPSE5:	PUSH P,A		; Save ptn.pn
	PUSHJ P,MRPACS		; Read access of page
	TLNN A,(1B5)
	 JRST [	MOVE A,-2(P)	; Non-existant page, create it
		LSH A,9
		UMOVE A,(A)	; By referencing it
		POP P,A
		JRST DMPSE5]
	TDNN A,-4(P)		; Test against needed access
	JRST DMPSE4		; Access not permitted
	TLNN A,(1B6)		; Indirect?
	JRST DMPSE7		; No.
	POP P,A			; Yes, track it down
	PUSHJ P,MRPT		; Get id of page pointed to
	JRST DMPSE5		; Not file, continue
	PUSH P,A		; File, repush
	JRST DMPSE6

DMPSE7:	TLNN A,400		; Write copy?
	 JRST DMPSE6		; No.
	MOVE B,-4(P)		; Yes.
	TLNN B,40000		; Write?
	 JRST DMPSE6		; No.
	TLNN A,100000		; Yes, can we read?
	 JRST DMPSE4		; No, must fail
	MOVE B,-2(P)
	LSH B,9
	UMOVES 0,20(B)		;[ISI] Write in page to make not write copy
	POP P,A
	POP P,C
	POP P,A
	JRST DMPSE3		; Recompute

DMPSE6:	HRRZ A,-1(P)		; Get buffer number
	LSH A,9
	ADDI A,IOXBUF		; Convert to address
	MOVE B,A
	EXCH A,(P)		; Save address, get ptn.pn
	HRLI B,140000
	PUSHJ P,SETMPG		; Map the user page into monitor
	POP P,A			; Get back address
	PUSHJ P,FPTA
	PUSHJ P,MLKPG		; Lock the page
	POP P,C			; Restore vulnerable ac's
	POP P,A
	AOS A			; Next page
	AOBJN C,DMPSE3		; Until done
	POP P,C			; Aobjn word
	MOVEM C,(P)		; Back to stack (clobers access bit)
	MOVEI A,IOXBUF		; Do things the hard way cause macro
	ASH A,-9		; Can't divide externals
	ADDI A,(C)
	AOS -1(P)
	DPB A,[POINT 9,-1(P),26]; Modify iowd to address monitor buffer
	SOS -1(P)

; At this point the dump region has been mapped into the monitor
; Buffer region and access checked
; -1(p) has the iowd needed for the data xfer
; 0(p) has the aobjn word needed to restore buffers when finished

	UMOVE JFN,1
	PUSHJ P,CHKJFN
	 JRST DMPER1		; Error, release buffers
	 JFCL
	 JRST [	CAIE DEV,STRDTB
		 JRST .+1
		MOVEI A,DESX4
		JRST DMPER1]
	TEST(NN,OPNF)
	JRST [	MOVEI A,DESX5
		JRST DMPER2]
	MOVE B,STS
	ANDI B,17
	CAIE B,17
	JRST [	MOVEI A,DUMPX2
		JRST DMPER2]
	MOVE B,-2(P)
	MOVE A,1(B)
	XCT 0(B)
	JRST DMPER2
	POP P,A
	EXCH A,(P)		; Get iowd, leave aobjn word on stack
	XCT 2(B)		; Call device dependent routine
	POP P,A
	PUSHJ P,DMPREL		; Release buffers
	OKINT
	PUSHJ P,UNLCKF
	MOVEI A,IOX4
	TEST(NE,EOFF)
	JRST [	UMOVEM A,1
		JRST MRTNE1]		; Stop if eof
	MOVEI A,IOX5
	TEST(NE,ERRF)
	JRST [	UMOVEM A,1
		JRST MRTNE1]		; Or error
	XCTUU [AOS 2]
	JRST DUMPC

DMPER2:	PUSHJ P,UNLCKF
DMPER1:	EXCH A,(P)
	PUSHJ P,DMPREL
	XCTMU [POP P,1]
	JRST MRTNE1

DMPSE4:	POP P,A
	POP P,A
	POP P,B
	PUSH P,A
	PUSHJ P,DMPRL1		; Release buffers assigned but unlocked
	POP P,C
	HLRES C
	MOVNS C
	HRLZS C
	POP P,A
	ADD A,C
	SKIPGE A
	PUSHJ P,DMPREL		; Release buffers both lock and assigned
	MOVEI A,DUMPX4
	JRST ERRD		; Access error

DMPREL:	PUSH P,A
DMPRL0:	PUSH P,A
	LSH A,9
	MOVEI A,IOXBUF(A)
	PUSH P,A
	PUSHJ P,FPTA
	PUSHJ P,MULKPG
	POP P,B
	MOVEI A,0
	PUSHJ P,SETMPG
	POP P,A
	AOBJN A,DMPRL0
	POP P,A
DMPRL1:	HLRE B,A
	MOVSI C,400000
	ASH C,1(B)
	MOVNI A,(A)
	ROT C,(A)
	ANDCAM C,DMPASW
	MOVNS B
	ADDM B,DMPCNT
	POPJ P,

	USE	RESPC

DMPTST:	CAML 1,DMPCNT
	JRST 0(4)
	JRST 1(4)

	USE	SWAPPC

; Fixed point number output
; Call:	1		; Destination designator
;	2		; Number to be output
;	RH(3)		; Radix
;	3(0)		; 1 to treat number as 36 bit magnitude
;	3(1)		; 1 to always print some kind of sign
;	3(2)		; Right justify the number
;	3(3)		; Print leading zeros if any
;	3(4)		; Print something on errors
;	3(5)		; Print * on errors rather than whole number
;	3(11-17)	; Field width, 0 means large enough to hold all
;	NOUT
; Return
;	+1		; Error, bad radix, or number too big for field
;	+2		; Successful

.NOUT::	JSYS MENTR
	PUSHJ P,NOUTX
	JRST [	MOVE A,LSTERR
		UMOVEM A,3
		JRST MRTNE1]
	AOS (P)
	JRST MRETN

NOUTX::	HRRZ D,C		; Get radix
	CAIL D,2
	CAILE D,^D10+^D26		; Must be 2 - 36
	JRST [	MOVEI A,NOUTX1
		MOVEM A,LSTERR
		POPJ P,]
	HLL D,C			; Save flags in d too
	LDB F,[POINT 8,D,17]	; Extract column width
	MOVEI E,1		; Initilize digit counter
	TLNN D,(1B0)		; Magnitude printout?
	CAIL B,0		; Or positive number?
	TLZA D,(1B6)		; Yes, remember not minus sign
	TLO D,(1B6+1B1)		; No, remember minus sign
	TLNE D,(1B6)		; - sign to be printed?
	MOVMS B			; Yes complement number
	TLNE D,(1B1)		; A sign of some sort to be printed?
NOUT1:	AOS E			; Yes, count as digit
	LSHC B,-^D35		; Make into double
	LSH C,-1		; Length dividend
	DIVI B,(D)		; Produce a digit
	PUSH P,C		; Save on stack
	JUMPN B,NOUT1		; Repeat until all digits generated
	CAIN F,0		; Zero field width specified?
	MOVE F,E		; Yes, make it same as number of digits
	TLNE D,(1B2)		; Right justify number?
NOUT2:	CAML E,F		; And filler needed?
	JRST NOUT3		; No
	TLNE D,(1B3)		; Yes. leading 0's?
	PUSHJ P,SGNOUT		; Yes, output sign now
	MOVEI B," "		; Get a space
	TLNE D,(1B3)		; Unless 0's wanted
	MOVEI B,"0"		; Then get a 0
	PUSHJ P,BOUTN		; Call bout so strings will work
	SOJA F,NOUT2		; Decrease remaining width and loop

NOUT3:	CAML F,E		; Sufficient room?
	JRST NOUT4		; Yes
	MOVEI B,NOUTX2		; Error
	MOVEM B,LSTERR
	TLNN D,(1B4)		; Print something anyway?
	JRST NOUT7		; No, go away
	TLNN D,(1B5)		; Asterisks?
	JRST NOUT4		; No, print the whole number
	MOVEI B,"*"		; Yes,
NOUT6:	SOJL F,NOUT7		; Column filled
	PUSHJ P,BOUTN
	JRST NOUT6

NOUT7:	TLNE D,(1B1)		; If one position reserved for -,
	SOS E			; One less thing on stack
NOUT71:	SOJL E,CPOPJ
	POP P,B
	JRST NOUT71

NOUT4:	PUSHJ P,SGNOUT		; Output sign before number
NOUT5:	SOJL E,NOUT8		; Any digits left?
	POP P,B			; Yes, get one
	ADDI B,"0"
	CAILE B,"9"
	ADDI B,"A"-"9"-1
	PUSHJ P,BOUTN		; Print it
	SOJA F,NOUT5		; Decrease field width

NOUT8:	SKIPL F
	AOS (P)			; Skip if no error
	MOVEI B," "
	JRST NOUT6		; Insert trailing blanks if necessary

SGNOUT:	TLZN D,(1B1)		; Sign still needed?
	POPJ P,			; No, return immediately
	MOVEI B,"-"
	TLNN D,(1B6)
	MOVEI B,"+"
	PUSHJ P,BOUTN
	SOS E			; Decrement digit count
	SOS F			; Decrement remaining field width
	POPJ P,

; Call bout

BOUTN::	PUSH P,A
	UMOVE A,1		; Output designator
	TLNN A,777777		; String pointer?
	JRST BOUTN1		; No
	PUSHJ P,FIXPTR		; FIX BYTE POINTER
	 JFCL			; IGNORE INDEX/INDIRECTION
	XCTBU [IDPB B,A]
	UMOVEM A,1
	PUSH P,B
	SETZ B,
	XCTBU [IDPB B,A]
	POP P,B
	POP P,A
	POPJ P,

BOUTN1:	BOUT			; For ordinary jfn's just do a bout
	POP P,A
	POPJ P,

; Number input
; Call:	1	; Source designator
;	NIN
; Return
;	+1	; Error
;	+2	OK
;	2	NUMBER

.NIN::	JSYS MENTR
	CAILE 3,1
	CAILE 3,^D10+^D26
	JRST [	MOVEI A,IFIXX1	; Illegal radix
		UMOVEM A,3
		MOVEM A,LSTERR	; Leave it around for ERSTR
		JRST MRTNE1]
	MOVEI 1,400000
	RCM			; Read interrupt enables
	PUSH P,1		; Save to restore when done
	MOVEI 1,400000
	MOVSI 2,(1B6)
	DIC			; Turn off overflow int
	JOV .+1
	MOVEI C,0
	PUSHJ P,BIN1
	CAIN B,40
	JRST .-2		; Skip leading spaces
	CAIN B,"-"
	JRST MININ
	CAIN B,"+"
	PUSHJ P,BIN1
	PUSHJ P,DIGIN1
	JRST [	MOVEI A,IFIXX2
		UMOVEM A,3
		MOVEM A,LSTERR		; For ERSTR
		JRST PLINX]
PLIN:	PUSHJ P,NIN9
	UMOVEM C,2
	JOV [	MOVEI A,IFIXX3
		UMOVEM A,3
		MOVEM A,LSTERR
		JRST PLINX]
	AOS -1(P)
	SKIPA 2,[MRETN]		; Set success return
PLINX:	 MOVEI 2,MRTNE1		; Set error return
	EXCH 2,0(P)		; 2 _ interrupt enables, save rtn
	MOVEI 1,400000
	AIC			; Re-enable
	POP P,2			; 2 _ return routine adr
	JRST 0(2)

MININ:	PUSHJ P,NIN91
	MOVNS C
	JRST PLIN+1

NIN9:	XCTUU [MUL C,3]
	ASH C,^D34		; Shift lost bits off setting ovrflo
	LSH C,1			; Position old b35 at b0
	ADD C+1,C		; Complete the 36-bit mult
	EXCH C,C+1		; 36-bit prod to c, hi part to c+1
	ADD C+1,C+1		; Set overflow if sign is wrong now
	ADD C,B			; Add in digit
NIN91:	PUSHJ P,DIGIN
	POPJ P,
	JRST NIN9

DIGIN:	PUSHJ P,BIN1
DIGIN1:	SUBI 2,60
	JUMPL 2,CPOPJ
	CAILE 2,9

	 JRST [	CAIL 2,"A"+40-60	;[ISI] Allow lowercase a-z
		 SUBI 2,40		;[ISI]
		CAIL 2,"A"-60
		CAILE 2,"Z"-60
		 POPJ P,
		SUBI 2,"A"-"9"-1
		JRST .+1]
	XCTUU [CAMGE 2,3]
	AOS (P)
	POPJ P,

BIN1::	PUSH P,A
	UMOVE A,1
	TLNN A,777777
	JRST BIN1A
	PUSHJ P,FIXPTR		; FIX UP POINTER
	 JFCL			; IGNORE BADNESS
	XCTBU [ILDB B,A]
	UMOVEM A,1
	POP P,A
	POPJ P,

BIN1A:	BIN
	POP P,A
	POPJ P,
	POPJ P,

;DELCH CALL: 1 JFN
;RETURN +1 NOT TERMINAL
;	+2 DISPLAY-LINE EMPTY
;	+3 DISPLAY-DELETE DONE
;	+4 NON-DISPLAY TERMINAL

.DELCH::JSYS MENTR
	UMOVE JFN,1
	PUSHJ P,CHKTC1
	JRST MRETN
	HLRZ 2,DEV
	PUSHJ P,TTDELO##
	JRST DCH4	;NON-DISPLAY OR BINARY MODE
	JRST DCH2
	JRST DCH3
DCH4:	AOS (P)
DCH3:	AOS (P)
DCH2:	AOS (P)
	JRST MRETN

;CHECK FOR TTY AND SKIP IF TTY

CHKTCO:: HRRZ JFN,PRIMRY
CHKTC1:: PUSHJ P,CHKJFN
	JRST IOERR		;ERROR
	JRST CHKTC2		;TTY
	POPJ P,			;STRING
	MOVEI A,(DEV)
	CAIE A,TTYDTB
	JRST 	[PUSHJ P,UNLCKF
		POPJ P,]
CHKTC2:	AOS (P)			;SKIP
	POPJ P,

	END