PDP-10.its/src/midas/tsrtns.234

;-*-MIDAS-*-

SUBTTL TS Definitions, parameters

	; For convenience in defining isolated variables/tables,
	; especially when have to know on pass1 where the
	; table is going to be (.VECTOR etc don't know until end of pass)
DEFINE LVAR -LINE
VBLK
LINE
PBLK
TERMIN

DEFINE TMPLOC AT,STUFF
%%%TLC==. ? LOC AT
	STUFF
LOC %%%TLC
TERMIN

	; Nice macro for minimizing coding.  Doesn't hack indirection tho.
	; Could conceivably optimize to do MOVE AC,[FROM,,TO] but that
	; would be overly hairy for something you can do just by writing
	; 2 instructions.
DEFINE BLTMAC AC,LEN,FROM,TO
	MOVSI AC,FROM
	HRRI AC,TO
	BLT AC,TO+LEN-1
TERMIN

	; Also handy for standard zaps (and nice mnemonic)
	; won't work for indirection either.
DEFINE BLTZAC AC,LEN,FROM
	SETZM FROM
IFG LEN-1,[
	MOVEI AC,FROM+1
	HRLI AC,-1(AC)
	BLT AC,FROM+LEN-1
]
TERMIN

	; More convenient when A is clobberable...
DEFINE BLTM LEN,FROM,TO
BLTMAC A,LEN,FROM,TO
TERMIN

DEFINE BLTZ LEN,FROM
BLTZAC A,LEN,FROM
TERMIN

	; Following inserts a SYSCAL for JSYS's.  Be warned that it
	; clobbers T when used!!
IFN TNXSW,.INSRT XJSYS

IFNDEF PMAPSW,PMAPSW==TNXSW	; 1 to assemble PMAP input, 0 for SIN input.
IFNDEF ERRSW,ERRSW==1	; 1 for error file output capability.

IFNDEF TYPDLC,TYPDLC==7	; Maximum total depth of .insrt (including tty)
IFNDEF MX.INS,MX.INS==5	; Maximum depth .insrt files only
IFNDEF MAXIND,MAXIND==6	; Maximum # @: table entries for .insrt

		; Define sizes of various I/O buffers
IFN DECSW,[
IFNDEF DECBFL,DECBFL==203	; Standard DEC buffer size for DSK (200 wds data)
IFN SAILSW,IFNDEF NINBFS,NINBFS==19.	; For SAIL, hack full disk track of input.
IFNDEF NINBFS,NINBFS==2		; # standard-size buffers to use for input.
IFNDEF UTIBFL,UTIBFL==<DECBFL+1>*NINBFS	; Input buffs need 1 wd for EOB hacking
IFNDEF UTOBFL,UTOBFL==DECBFL	; All output chans have just 1 buffer.
IFNDEF CRFBSZ,CRFBSZ==DECBFL
IFNDEF LSTBSZ,LSTBSZ==DECBFL
IFNDEF ERRBSZ,ERRBSZ==DECBFL
] ;DECSW
IFN TNXSW,IFNDEF CMBFL,CMBFL==200	; Longer for PRARG% block stuff
IFNDEF CMBFL,CMBFL==50		; Length of command buffer.
IFNDEF UTIBFL,UTIBFL==400	;   "  Input buffer.
IFNDEF UTOBFL,UTOBFL==200	;   "  BIN output buffer.
IFNDEF CRFBSZ,CRFBSZ==200	;   "  CREF output buffer.
IFNDEF LSTBSZ,LSTBSZ==200	;   "  LIST output buffer.
IFNDEF ERRBSZ,ERRBSZ==1		;   "  ERR output buffer.  Very small to avoid
				; losing much data if things crash.


ERRC==0		; Err device input channel
TYIC==1		; TTY input channel
TYOC==2		; TTY output channel
CREFC==3	; CREF output
UTYOC==4	; BIN output
LPTC==5		; LIST output (LPT)
ERRFC==6	; ERR Assembly error output file.
UTYIC==7	; 1st input channel, UTYIC+n used for nth .INSRT level in dec version.

SUBTTL File Description Storage (FILBLK's)

VBLK
	; Definitions for indices into a FILBLK.

	; Scratch block FB is formed while defining indices...
FB:	OFFSET -.
		; Lots of crocks depend on the exact order of these 4 items.
$F6DEV:: 0			; SIXBIT Device name
$F6FNM:: $F6FN1:: 0		; SIXBIT Filename (on ITS, FN1)
$F6TYP:: $F6FN2:: $F6EXT:: 0	; SIXBIT Extension (on ITS, FN2)
$F6DIR:: 0			; SIXBIT Directory (may be numerical PPN)
	L$F6BLK==.
$FVERS:: $FGEN:: 0	; File version (or generation).  NUMBER, not string.
IFN TNXSW,[		; Almost all entries here are BP's to ASCIZ strings.
$FDEV::  0		; Device name
$FDIR::  0		; Directory name
$FNAME:: 0		; File name (i.e. main name)
$FTYPE:: $FEXT:: 0	; File type (or extension)
$FTEMP:: 0		; -1 => File is a temporary file.
$FACCT:: 0		; Account string
$FPROT:: 0		; Protection string
$FJFN::  0		; JFN for file (may be <desired JFN>,,<temp JFN>)
]
IFN ITSSW\DECSW,[
$FDEV==:$F6DEV		; These definitions made so some common code can do
$FDIR==:$F6DIR		; the right things.
$FNAME==:$F6FNM
$FTYPE==:$F6TYP
$FEXT==:$F6TYP
]
	L$FBLK==.	; Length of a FILBLK.
	OFFSET 0	; End of index definitions.


	; FILBLK's for various files

ISFB:	BLOCK L$FBLK	; Input file specification as given in command line.
INFB:	BLOCK L$FBLK	; Actual current input file.
OUTFB:	BLOCK L$FBLK	; Output file

IFN CREFSW,	CRFFB:	BLOCK L$FBLK	; CREF output file
IFN LISTSW,	LSTFB:	BLOCK L$FBLK	; Listing output file
IFN ERRSW,	ERRFB:	BLOCK L$FBLK	; Error output file

INFCNT:	0		; AOS'd each time an input file is opened.
INFCUR:	0		; What INFCNT was when current file opened.
INFERR:	0		; What INFCUR held at last err msg.

INDDP:	MAXIND,,TBLOFS		; Pointer into tables below
TBLOFS:	BLOCK MAXIND*L$FBLK	; Actual filenames corresponding to those in TBLSFS, for opening.
TBLSFS:	BLOCK MAXIND*L$FBLK	; Source-specified filenames for @: files


RFNAM1:	0		; .FNAM1, .FNAM2, .FVERS
RFNAM2:	0
RFVERS:	0
IFNM1:	0		; .IFNM1, .IFNM2, .IFVRS
IFNM2:	0
IFVRS:	0
INFFN1==:INFB+$F6FN1	; Some crocks seem to reference this.
OFNM1==:OUTFB+$F6FN1	; Pseudo .OFNM1 needs this.
OFNM2==:OUTFB+$F6FN2	; ditto, .OFNM2
RSYSNM:	0		; Initial system name

IFN TNXSW,[
USRNUM:	0			;User# of person running program
UNAMLN:	0			;# of words in his username.
USRNAM:	BLOCK 40./5		;Max username is 39. characters
FNAMLN:	0
FILNAM:	BLOCK 200./5		;Max filename is around 170. characters.
];TNXSW
PBLK

SUBTTL I/O Buffers

VBLK		; Input buffer and variables

UTIBUF:	BLOCK UTIBFL
UTIHDR:	0		; Input buffer header (dec version)
UREDP:	440700,,UTIBUF	; Input byte pointer
UTICNT:	0		; Input byte count (dec version)
IUREDP:	440700,,UTIBUF	; Initial UREDP, used for re-initializing.
UTIBED:	UTIBUF		; EOF comparison with RH(UREDP), 4.9 => EOF on .IOT

IFN DECSW,UTICHN:	UTYIC

		; BIN Output buffer

UTOBUF:	BLOCK UTOBFL	; Output buffer
UTOHDR:	UTOBFL,,UTOBUF-1
UTYOP:	444400,,	; Output (36. bit) byte pointer
UTYOCT:	0		; # words left in utobuf
IFN ITSSW,OCLOSP: @1(C)	; Turned into bp to unused part of last bffer wd used.

		; CREF output buffer
IFN CREFSW,[
CRFBUF:	BLOCK CRFBSZ
CRFHDR:	CRFBSZ,,CRFBUF-1	; Header, assembled value used only ifn itssw
CRFPTR:	444400,,	; Bp for filling buffer (full words)
CRFCNT:	0		; Num. wds. empty in buffer
]

		; LISTing output buffer
IFN LISTSW,[
LSTBUF:	BLOCK LSTBSZ
LSTHDR:	5*LSTBSZ,,LSTBUF-1
LSTPTR:	440700,,
LSTCNT:	0
]

		; ERRor output buffer
IFN ERRSW,[
ERRBUF:	BLOCK ERRBSZ
ERRHDR:	5*ERRBSZ,,ERRBUF-1
ERRPTR:	440700,,
ERRFCT:	0	; Can't call this ERRCNT since that's used for # errors.
ERRFP:	0	; Non-0 if want error output file.
ERRFOP:	0	; Non-0 if error file open (ie try outputting to it)
]
PBLK

SUBTTL Interrupt Handling

;	Note that only PDL OV is now enabled in general.
; TTY input interrupts are also handled when possible for
; ^H, ^W, and ^V.

.SCALAR INTSVP		; Saves P on interrupt for debugging

IFN ITSSW,[
	TMPLOC 42, JSR TSINT	; Interrupt vector for ITS
VBLK
.JBCNI:
TSINT:	0		; 1st wd interrupts currently considered fatal errors.
.JBTPC:	0		; Error processor re-enables interrupts
	.SUSET [.RJPC,,INTJPC]
	SKIPGE TSINT
	 JRST TTYINT	; Second-word ints.
	JRST TSINT1	; Jump into pure coding and process interrupt
INTJPC:	0		; Saves .JPC at interrupt.
PBLK
	; Jrst here from TSINT for 2nd wd interrupts.
TTYINT:	PUSH P,A
	MOVEI A,TYIC	; The tty chnl is the only one enabled.
	.ITYIC A,
	 JRST TTYINX	; No int. char.
	CAIN A,^W
	 AOS TTYFLG	; ^W silences,
	CAIN A,^V
	 SOS TTYFLG	; ^V unsilences,
	CAIN A,^H
	 SETOM TTYBRF	; ^H says break next time thru ASSEM1 loop.
TTYINX:	REST A
	.DISMIS .JBTPC
] ; IFN ITSSW

IFN DECSW, TMPLOC .JBAPR, TSINT1	; Interrupt vector for DEC

IFN ITSSW\DECSW,[
	; Amazing but can use almost same basic rtn for both!

TSINT1:	MOVEM P,INTSVP		; Save P for possible debugging
IFN ITSSW,.SUSET [.SPICL,,[-1]]	; For ITS, re-enable ints.
	MOVE A,.JBCNI		; Get interrupt request word
	TRNE A,200000		; PDL overflow?
	 JRST CONFLP
	MOVE B,[TYPE "Unknown interrupt - Fatal"]	; anything else.
	MOVEM B,40
	MOVE A,.JBTPC	; So error routine will print out properly
	JSA A,ERROR
]

IFN TNXSW,[
	; TENEX Interrupt handler
; Note that NXP (non-ex page) is enabled, but no provision is
; currently made for handling it.  This causes process termination and
; EXEC will print error message.  If NXP wasn't enabled, a page would
; simply be created without fuss (page is always created, incidentally,
; whether or not interrupt happens)

LVAR MEMDBG:	0	; For nonce, this gets set when PURIFG does.

LEVTAB:	INTPC1		; Where to store PC for level 1 interrupt.
	0 ? 0		; Levels 2 and 3 unused.
CHNTAB:	BLOCK 36.	; Where to go for indicated condition.  Most zero.

.IC.CV==1	; Define user channel 1 for ^V interrupt
.IC.CW==2	;   "  2 for ^W
.IC.CH==3	;   "  3 for ^H
%%LSV==.
LOC CHNTAB+.ICPOV ? 1,,TSINT1	; Put right word in CHNTAB for PDL OV dispatch.
LOC CHNTAB+.IC.CV ? 1,,INT.CV	; Ditto for ^V dispatch
LOC CHNTAB+.IC.CW ? 1,,INT.CW	; "  ^W
LOC CHNTAB+.IC.CH ? 1,,INT.CH	; "  ^H
	; The next 3 are to handle all reasonable interrupts resulting from
	; a failing JSYS.
LOC CHNTAB+.ICILI ? 1,,INT.IL	; Illegal instruction (normally a failing JSYS)
LOC CHNTAB+.ICEOF ? 1,,INT.IL	; EOF encountered
LOC CHNTAB+.ICDAE ? 1,,INT.IL	; Data error encountered
LOC %%LSV

.SCALAR	INTPC1		; Level 1 interrupt PC stored here.

	;  Handle PDL OV interrupt
TSINT1:	MOVEM P,INTSVP		; Save PDL ptr.
	MOVEI A,CONFLP		; OK to clobber A in PDLOV.
	MOVEM A,INTPC1		; Dismiss to CONFLP.
	DEBRK			; Off we go.

	; Handle ^V interrupt
INT.CV:	SOS TTYFLG	; Unsilence typeout
	DEBRK

	; Handle ^W
INT.CW:	AOS TTYFLG	; Silence typeout
	DEBRK

	; Handle ^H
INT.CH:	SETOM TTYBRF	; Set flag to check at main level ASSEM1 loop.
	DEBRK

	; Handle Illegal Instruction (normally a failing JSYS, bletch!)
	; 10X ERJMP-handling interrupt routine.
ERJMPA==:<JUMPA 16,>	; For use instead of ERJMP where JSYS normally skips.
IFNDEF ERJMP,ERJMP==:<JUMP 16,>
IFNDEF ERCAL,ERCAL==:<JUMP 17,>

ERXJMP==:<ERJMP_-27>	; For easier code writing
ERXCAL==:<ERCAL_-27>
ERXJPA==:<ERJMPA_-27>

INT.IL:	PUSH P,A
	PUSH P,B
	MOVE A,INTPC1		; Get PC we got interrupted from
	LDB B,[271500,,(A)]	; Get op-code and AC field of instr
	CAIN B,ERXJPA
	 JRST ERJFAK
	CAIE B,ERXJMP		; Is it a magic cookie?
	 CAIN B,ERXCAL
	  JRST ERJFAK
	AOJ A,
	LDB B,[271500,,(A)]	; Try next instr
	CAIE B,ERXJMP		; Any better luck?
	 CAIN B,ERXCAL
	  JRST ERJFAK
	ETF [ASCIZ "Fatal interrupt encountered"]

ERJFAK:	CAIN B,ERXCAL		; See which action to hack
	 JRST ERJFK2		; Go handle ERCAL, messy.
	MOVEI A,@(A)		; ERJMP, get the jump address desired
	MOVEM A,INTPC1		; Make it the new PC
	POP P,B
	POP P,A
	DEBRK
ERJFK2:	MOVEI B,@(A)		; Get jump address
	MOVEM B,INTPC1		; Make it the new PC
	POP P,B
	AOJ A,			; old PC needs to be bumped for return
	EXCH A,(P)		; Restore old A, and save PC+1 on stack
	DEBRK

; (Actually, since ERCAL is not special except after a JSYS, it would
; still work if the ERCAL-simulation didn't bump the PC; control would
; just drop through to the next instruction on return.  Might confuse
; people looking through the stack frames, though.)
] ;IFN TNXSW

SUBTTL MIDAS BEGINS HERE - Program Startup

VBLK
NVRRUN:	-1	; 0 => MIDAS was run; error to start or purify.
FATAL:	0	; At end of assembly, not 0 iff fatal error occurred.
PBLK

BEG:			; Start address!
IFN DECSW\TNXSW,[
	TDZA A,A
	 SETO A,
	MOVEM A,CCLFLG		; Remember type of start-up
]
	SETZ FF,		; Initialize flags
	MOVE P,[-LPDL,,PDL-1]	; Initialize P

IFN DECSW,[
	RESET
	MOVEI A,600000
	APRENB A,
]
	; For TENEX, must determine right away which system we're on.
IFN TNXSW,[
	RESET
;	TLZ FF,FL20X	; Assume 10X until proven otherwise. (done by SETZ above)

IFN 0,[	; One way of determining OS which doesn't work on some places.
	MOVE A,[112,,11] ; Magic word that will win on 10X,T20 (and maybe T10)
GETTAB=<047000,,41>	; CALLI 41
	GETTAB A,	; Returns 10000 T10, 20000 ITS, 30000 10X, 40000 T20
	 MOVEI A,30000	; Shouldn't ever fail, but if it does, assume 10X.
	LDB A,[140300,,A] ; Flush other fields too
	CAIN A,4	; = Tops-20?
	 TLO FF,FL20X	; Yes, set flag.
]; IFN 0
IFN 0,[	; This is a loser too, since there ARE KL Tenices!
	SETZ A,		; In lieu of above, use hardware hack...
	BLT A,		; test for KL-ness.
	CAIE A,
	 TLO FF,FL20X	; KL will fail to skip, assume that means 20X OS.
];IFN 0
IFN 1,[	; Boy I hope DEC never defines LOADTB! -- MRC
	SYSCAL SYSGT,[['LOADTB]][A ? D]
	SKIPN D		; If LOADTB is not defined
	 TLO FF,FL20X	; it must be a Twenex
]; IFN 1

	SYSCAL SCVEC,[[.FHSLF] ? [-1]]	; and flush compat package,
			; disabling UUO's 40-77; this is good for debugging.

	; Set up stuff for interrupts
	SYSCAL SIR,[[.FHSLF]
			[LEVTAB,,CHNTAB]]	; Specify tables
	SYSCAL EIR,[[.FHSLF]]			; Enable interrupts
	SYSCAL AIC,[[.FHSLF]		; Activate PDL OV and ^V, ^W, ^H
[IRP BIT,,[.ICPOV,.IC.CV,.IC.CW,.IC.CH]
<1_<35.-BIT>>+!TERMIN ]]
	SYSCAL ATI,[[.TICCV,,.IC.CV]]	; Make various mappings from
	SYSCAL ATI,[[.TICCW,,.IC.CW]]	; terminal bits to int. channels.
	SYSCAL ATI,[[.TICCH,,.IC.CH]]	; What a losing interrupt sys 10X has!
	SKIPN MEMDBG			; Hacking memory ref debugging?
	 JRST BEG20
	; Make sure that all low impure pages exist
	; whether or not they consist of all zeros.  Problem is that EXEC SAVE
	; command ignores pages that are all zero, so they won't exist on
	; startup and we have to re-create them or risk getting a NXP int.
	MOVSI A,-2*MINBNK
	MOVE B,(A)		; Reference them all to create them if nec.
	ADDI A,777
	AOBJN A,.-2
	MOVE B,<MXICLR*2000>-1	; Ditto last TNX page of initial MACTAB
	; Now enable interrupts for Non-eXistent Pages.
	SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]]

BEG20:	SYSCAL GJINF,[][USRNUM]			;Get your user# into USRNUM
	SYSCAL DIRST,[[-1,,USRNAM] ? USRNUM]	;And then make username string
	  JFCL
	MOVEI A,1		;# words in username string.
	MOVE B,USRNAM-1(A)
	TRNE B,376		;check last position in this word
	  AOJA A,.-2		;  filled, so check next word.
	MOVEM A,UNAMLN		;Save # words.

] ;TNXSW

IFN ITSSW,[
	MOVE A,[-5,,[		; Set and read various vars in a chunk.
		.SMASK,,[%PIPDL]	; 1st-wd Interrupt only on PDL ovfl.
		.SMSK2,,[1_TYIC]	; 2nd-wd on TTY input channel.
		.SPICL,,[-1]		; and enable interrupt system.
		.RSNAM,,RSYSNM		; Get system name (default dir to use)
		.RXJNAM,,B ]]		; and XJNAME for temp. hacking below.
	.SUSET A
	SYSCAL TTYSET,[1000,,TYIC	; Set TTYST wds - PI echo, no act/int
		[232020,,202020]	; except ctls activate & interrupt
		[232020,,220220]]	; CR, DEL activate but don't int;
					; DEL doesn't echo.
]

	AOSE NVRRUN	; Test for this job's already being run...
	 JRST [	TYPE "Can't restart MIDAS"
		JRST TSRETN]

	; Initialize impure memory for paged systems	
IFN ITSSW\TNXSW,[
	MOVE AA,[MXICLR-MXIMAC,,MXICLR]
	CALL CORGET		; Get MACTAB pages not loaded into.
IFN PURESW,[
	MOVE AA,[MINBNK-MINMAC,,MINBNK]
	CALL CORGET		; Get pages for blank code & symtab.
	SKIPN PURIFG
	 JRST .+3		; If purified, skip cleanup
	JSP F,FLSPGS		; If not purified => flush pages of
	 <MXIMAC-MINPUR>,,MXIMAC ; MACTAB created by loading but not needed.
] ;PURESW
] ;IFN ITSSW\TNXSW

	MOVEI D,SYMDSZ	; Get default symtab size
IFN ITSSW,[			; Remember that B set to XJNAME above.
	CAME B,['MMIDAS]	; Set symtab size larger for MMIDAS
	 CAMN B,[SIXBIT/MM/]	; (random sort of hack now that .SYMTAB exists)
	  MOVEI D,SYMMSZ
]
	SKIPGE ISYMF		; The first time through,
	 MOVEM D,SYMLEN		; Make that the size to use.
	CALL SITINI		; Initialize stuff for .SITE.
	CALL JCLINI		; Now try to fetch JCL; set CMPTR accordingly.
IFN ITSSW,[
	SKIPGE ISYMF		; Skip if syms spread; if not,
	 CALL TSYMGT		; get TS syms from system.
]
	SKIPE CMPTR		; If have JCL,
	 JRST GO2AA		; skip announcing midas's name and version.

IFG PURESW-DECSW,[	; If meaningful,
	SKIPGE PURIFG		; Check for purity
	 TYPE "NOTPUR "		; and type little warning if unpurified.
	]
	TYPE "MIDAS."		; and announce self.
	MOVE B,[MIDVRS]
	PUSHJ P,SIXTYO
	JRST GO2AA

SUBTTL MIDAS Top-level control path

GO2A:	SETZM CMPTR	; Recycles here, so JCL only hacked once.
GO2AA:	SETOM FATAL	; Assume fatal errors, unless cleared at GO8 when done.
	SETZM TTYFLG	; Allow TTY typeout.
	SETZM ERRCNT	; Initialize error counter (total errors)
IFN RUNTSW,[	PUSHJ P,RNTTMA	; Get initial run time.
		MOVEM A,IRUNTM]
	SETZM LSTTTY	; Tell TYOERR not to try output to LST file (none yet!)
	PUSHJ P,CMD	; Get typed in command (or scan cmd line if CMPTR ne 0)

	SKIPGE SMSRTF	; What's this for, I wonder?
	 JRST GO21
	TYPECR "SYMTAB clobbered"
	JRST GO2A

	; Filenames and switches all specified, now see if files can be set up.
GO21:	PUSHJ P,OPNRD	; Open input file
	 JRST GO2A	; Error, msg was typed, go try again with new cmd line.
	PUSHJ P,WINIT	; Open output file, cref file.
IFN DECSW\TNXSW,[
	SKIPGE CCLFLG
	 TYPE "MIDAS:	"
]
IFN A1PSW,[
	SETOM PRGC
	SETOM OUTC
GO3: ]
	MOVE A,WSWCNT
	MOVEM A,TTYFLG	; Turn off typeout if there were (W) switches.
	SETOM LSTTTY	; Allow TYOERR to output to both TTY and LST.
	JSP A,$INIT	; Initialize for assembly
	JSP A,PS1	; Do pass 1
	TRNN FF,FRNPSS	; If 2 pass assembly,
	 JRST GO4
	PUSHJ P,OPNRD	; Then re-open input file
	 JRST GO2A	; Couldn't re-open???? Do something better here.
GO4:	JSP A,PLOD	; Maybe punch out SBLK loader in some format
	JSP A,PS2	; Do pass 2
	JSP A,PSYMS	; Maybe punch out symbol table
IFN A1PSW,[
	TLZ FF,$FLOUT
	AOS PRGC	; Indicate end statement encountered
	SETOM OUTC	; " " "
	TRNN FF,FRNPSS	; If 1 pass assembly,
	 SKIPGE CONTRL
	  CAIA	
	JRST GO3	; Then try to assemble another program
]
IFN FASLP,[
	SKIPGE A,CONTRL
	TRNN A,FASL
	 JRST GO8
	MOVE A,[SIXBIT /*FASL*/]	; "finish" FASL file
	MOVEI B,17
	PUSHJ P,FASO	; Ignore end frob, but output FASL end code
	MOVE A,[ASCIC//]	; pad with ^C's.
	PUSHJ P,FASO1	; Randomness
	PUSHJ P,FASBE	; Write out last block
]
	; Jump directly here for certain main-input EOF conditions.
GO8:	SETZM FATAL	; There was no fatal error: output files get renamed.

	; Jump directly here if hit fatal error (incl .FATAL, illegal UUO, etc)
GO9:	PUSHJ P,.FILE		; Close (and rename if FATAL = 0) output files.
	SETZM LSTTTY
IFN RUNTSW, PUSHJ P,RNTTYO	; Type out run time used since GO2A
	CALL ERRCLS	; File away error file - only thing not closed by .FILE
	JRST TSRETN	; and die according to system's wishes.

SUBTTL MIDAS Death (TSRETN) - system dependent exit routines

IFN ITSSW,[
TSRETN:
IFN PURESW,[
	SKIPGE PURIFG	; If not yet purified, assume being debugged.
	 .VALUE
]
	.LOGOUT		; Come here to commit suicide.
	.BREAK 16,160000
] ;IFN ITSSW

IFN DECSW,[

TSRETN:	SKIPLE A,ERRCNT		; If had any errors,
	 ADDM A,.JBERR		; let loader know about them. (???) Well,
				.SEE ERR1 ; for strange comment.
	SKIPN CCLMOR	; Any more CCL commands?
	 EXIT		; Nope, all done.
	JRST RERUN	; More CCL to hack, start up a new MIDAS.
] ; IFN DECSW


IFN TNXSW,[
TSRETN:	SKIPE CCLMOR	; Need to hack any more CCL?
	 JRST RERUN	; Yeah.
ifdef prarg,[		; I don't know if tenex has a PRARG
;;; Try to simulate .logout 1, on TNX
	movei 2,[2,,0]	;2 is kill this fork code
	Move 1,[.PRAST,,.FHSLF]	;yea, kill ME
	Movei 3,1
	PRARG] ; ifdef PRARG
TSRET1:	HALTF
	HRROI 1,[ASCIZ/Can't continue/]
	PSOUT		; Better than dying randomly
	JRST TSRET1	; stupid system can't understand .logout 1,
] ; IFN TNXSW

SUBTTL MIDAS Murder - fatal internal error handling (GOHALT)

VBLK
HALTER:	0		; JSR'd here when fatal internal error seen.
	JRST HALTEP	; Jump to pure-code handling
PBLK
HALTEP:
IFN ITSSW,[
	.VALUE [ASCIZ |: ===== Fatal MIDAS internal error! =====
Please send a message to BUG-MIDAS describing circumstances.
Error was at location: 
HALTER/
|]
] ;IFN ITSSW

IFN TNXSW,[
.SCALAR HALTR1,HALTR2,HALTR3
	MOVEM R1,HALTR1	; Save R1 etc. for later examination
	MOVEM R2,HALTR2
	MOVEM R3,HALTR3
	HRROI R1,[ASCIZ | ===== Fatal MIDAS internal error! =====
Please send a message to BUG-MIDAS @ MIT-MC describing circumstances.
Error was at location: |]
	PSOUT
	MOVEI R1,.PRIOU
	HRRZ R2,HALTER
	MOVEI R3,8.
	NOUT
	 ERJMP .+1
	hrroi r1,[asciz /, ERRCOD = /]
	psout
	movei r1,.priou
	move r2,errcod
	nout
	 erjmp .+1
	hrroi r1,[asciz "
"] ?	psout
	MOVE R1,HALTR1	; Restore R1 etc. for later examination
	MOVE R2,HALTR2
	MOVE R3,HALTR3
	HALTF
] ;IFN TNXSW

IFN DECSW,[
	OUTSTR [ASCIZ | ===== Fatal MIDAS internal error! =====
Please send a message to BUG-MIDAS @ MIT-MC describing circumstances.
Error location can be found in HALTER/ (please look at it with DDT to
find out where the error came from).
|]
	EXIT
] ;IFN DECSW

	JRST .-1	; Just in case

SUBTTL MIDAS Purification - PURIFY startup, also DECDBM

IFN ITSSW\TNXSW,[
IFN PURESW,[

PURIFY:	SKIPL NVRRUN
IFN ITSSW,[ .VALUE [ASCIZ /: Already run, can't purify 
/]]
IFN TNXSW,[
	 JRST [	HRROI 1,[ASCIZ /? Already run, can't purify
/]
		PSOUT
		HALTF
		JRST .+1]	; If continued, go ahead anyway.
] ;IFN TNXSW
PURIF1:	MOVEI P,17			; Start PDL at 20
	JSP F,FLSPGS			; First flush blank-code pages,
	 <MINBNK-MINMAC>,,MINBNK	;	incl. symbol table area.
	JSP F,FLSPGS			; Flush MACTAB pages created by load
	 <MXICLR-MINPUR>,,MXICLR	;	but not needed.
	JSP F,PURIFD			; Purify pure pages.
	 <MINPUR-MAXPUR>,,MINPUR
	SETZM PURIFG			; Set "purified" flag
IFN TNXSW,SETOM MEMDBG			; For TNX, ask for mem checking.
	MOVE [1,,2]			; Now clear out remains of data of self
	MOVEI 1,0
	BLT 40
IFN ITSSW,[
	.VALUE [ASCIZ /: Purified, type CR to dump 
:PDUMP SYS;TS MIDAS/]
] ;IFN ITSSW

IFN TNXSW,[
	HRROI 1,[ASCIZ / Purified, now SAVE
/]
	PSOUT
	HALTF
] ; IFN TNXSW
	JRST BEG

	; JSP F,FLSPGS
	;  -<# pgs>,,<page to start>
	;	Flush pages specified by page AOBJN

FLSPGS:	MOVE A,(F)	; Get the page AOBJN
IFN ITSSW,[
	SYSCAL CORBLK,[MOVEI 0 ? MOVEI %JSELF ? A]
	 .LOSE 1000
]
IFN TNXSW,[
	ASH A,1		; Multiply # pages, page # by 2.
	HLRE B,A
	HRLI A,.FHSLF
	MOVNS B
	TLO B,(PM%CNT)	; Say hacking repeat count
FLSPG2:	SYSCAL PMAP,[[-1] ? A ? B]	; Flush these pages.
	TLNN FF,FL20X		; If on 20X, that's all.
	 JRST [	HRRI B,-1(B)	; Else, on 10X, must iterate manually.
		TRNE B,400000	; See if became "negative".
		 JRST .+1	; Yep, done with manual iteration.
		AOJA A,FLSPG2]	; Nope, bump page #.
]
	JRST 1(F)

	; JSP F,PURIFD - Just like FLSPGS, but purifies the pages instead.

PURIFD:	MOVE A,(F)	; Get page AOBJN
IFN ITSSW,[
	SYSCAL CORBLK,[MOVEI %CBNDR	; Read access only.
		MOVEI %JSELF ? A]
	 .LOSE 1000
]
IFN TNXSW,[
	ASH A,1		; Double everything to get in terms of TNX pages.
	HLRE B,A
	MOVNS B		; Get # pages in B
	MOVEI C,(A)
	ADDI C,-1(B)	; Find # of last page to purify
	LSH C,9.	; Get addr of 1st wd of last page
	MOVES (C)	; Touch it so that it is guaranteed to exist!
			; This is necessary since last ITS page may only
			; include one TNX page instead of two.
	HRLI A,.FHSLF
PURID1:	SYSCAL SPACS,[A ? [PA%RD+PA%EX]]
	ADDI A,1
	SOJG B,PURID1
]
	JRST 1(F)

IFN TNXSW,[

; PURSAV - A startup routine like PURIFY, for possible use on TNX if
;	the EXEC "SAVE" command does not preserve page access bits.
;	Current T20 EXEC seems to do OK though.  This is only useful
;	when trying to catch illegal writes to "read-only" code.

PURSV0:	PUSHJ P,RDJERR
PURSAV:	MOVEI P,20
	HRROI R1,[ASCIZ /Pure-Save to file: /]
	PSOUT
	MOVSI R1,(GJ%NEW+GJ%FOU+GJ%SHT+GJ%FNS)
	MOVE R2,[.PRIIN,,.PRIOU]
	GTJFN			; Get JFN from TTY
	 JRST PURSV0
	SETZM PURIFG		; Claim purified...
	SETOM MEMDBG		; and keeping watch on memory.
	HRLI R1,.FHSLF
	MOVEI R2,[
		2*<0-MINBNK>,,0+SS%RD+SS%WR+SS%EXE	; Variables/buffers
		2*<MINMAC-MXICLR>,,2*MINMAC+SS%RD+SS%WR+SS%EXE	; MACTAB init
		2*<MINPUR-MAXPUR>,,2*MINPUR+SS%RD+SS%EXE	; Purify pure pages.
		0 ]	; End of SSAVE table
	SETZ R3,
	SSAVE		; Do it!
	HRROI R1,[ASCIZ /Saved./]
	PSOUT
	HALTF
] ; IFN TNXSW

] ; IFN PURESW
] ; IFN ITSSW\TNXSW

IFN DECDBG,[
DECDBM:	0
	HRLZ A,.JBSYM	;GET ADDR OF START OF DDT SYMS,
	HRRI A,DECDBB+200	;LEAVE 200 WD SPACE BEFORE THEM.
	HRRM A,.JBSYM		;MOVE THEM INTO SPACE PROVIDED
	HLRE B,.JBSYM
	MOVMS B
	BLT A,DECDBB+177(B)	;SO THEY WON'T GET IN MACTAB'S WAY.
	JRST @DECDBM
]

SUBTTL System-dependent Symbol Table stuff.

IFN ITSSW,[

; TSYMGT - Gobble syms from system (ITS feature!)
;	TABLE AREA IN SYSTEM:
;	FIRST LOC SYSYMB
;	LAST (AS OPPOSED TO LAST + 1) SYSYME

TSYMGT:	MOVEI A,EISYMT	;EISYMT FIRST LOC FOR ITS SYMS
	MOVE B,[SIXBIT /CALLS/]	;SYSTEM CALLS
	.GETSYS A,	;READ IN SYSTEM CALLS (SHOULD SKIP)
	 .LOSE %LSSYS
	SKIPGE A
	 .LOSE		;.GETSYS DIDN'T UPDATE AOBJN POINTER
	HRRM A,SP1	;MARK END OF SYMS
	ANDI A,-1
	CAIL A,MACTBA+MACL
	 .LOSE		;MACL TOO SMALL!  INITS MIGHT LOSE.
	MOVEI B,EISYMT
	MOVEI AA,SYMC_<-18.+4>	;SQUOZE FLAG FOR SYM
TSYMG2:	DPB AA,[400400,,(B)]
	ADDI B,2
	CAIE B,(A)
	JRST TSYMG2
	POPJ P,
]; IFN ITSSW

SUBTTL .SITE pseudo & initialization (SITINI)

IFN ITSSW,	LVSITE==1	; ITS only uses 1 word of mach name.
IFN DECSW\TNXSW,LVSITE==5	; whereas others need 5 words (25 chars max)

LVAR	V.SITE:	BLOCK LVSITE	; .SITE string stored here.

	; .SITE N, returns nth word of sixbit machine name.

A.SITE:	CALL AGETFD	; Get field as argument.
	JUMPL A,CABPOP	; Ignore negative indices.
	CAIL A,LVSITE	; Make sure index is within bounds of string.
	 JRST CABPOP
	MOVE A,V.SITE(A)	; Win, get indexed word.
	JRST CLBPOP


; SITINI - Initialization routine called only at MIDAS startup, for
;	setting up .SITE and maybe other things.

SITINI:	BLTZ LVSITE,V.SITE	; Clear out string location

IFN ITSSW,[	; For ITS, use up just 1 word and need 1 call to set V.SITE
	SYSCAL SSTATU,[REPEAT 5,[ ? MOVEM A] ? MOVEM V.SITE]
	 .LOSE %LSSYS
	POPJ P,	]

IFN SAILSW,[	; SAIL needs special kludge, since it doesn't have the
	MOVE A,[SIXBIT /SAIL/]	; right GETTAB used.
	MOVEM A,V.SITE
	POPJ P,	]

	; This code sets TNX .OSMIDAS at runtime as appropriate.
IFN TNXSW,[
	MOVE A,[SIXBIT /TENEX/]	; Assume running on 10X
	TLNE FF,FL20X		; unless proved otherwise
	 MOVE A,[SIXBIT /TWENEX/]
	MOVEM A,OSMID		; Store directly as symtab value!
]
	; If TNX and on ARPA network, get Arpanet host name for .SITE
IFN TNXSW,[
	SYSCAL SYSGT,[['LHOSTN]][A ? B]	; Get local host #
	JUMPL A,SITIN3			; Tops-20 release 3 has a LHOSTN table
	JUMPE B,SITIN3			; Jump if none, not on net.
	SYSCAL CVHST,[FNBWP ? A][A]	; Write string into FNBUF.
	 JRST SITIN3		; No string for that host #??
	SETZ B,
	IDPB B,A		; Make sure string is ASCIZ'd.
	MOVE B,FNBWP		; Note that FNBWP isn't altered by the syscal!
	MOVE C,[440600,,V.SITE]
SITIN2:	ILDB A,B
	JUMPE A,APOPJ		; return when string ended.
	TRCE A,140		; Convert char to sixbit.
	 TRCE A,140
	  TRCE A,140
	IDPB A,C
	JRST SITIN2
]

	; For non-network TENEX and DEC in general, very similar.
IFN DECSW\TNXSW,[
IFN TNXSW,[			
SITIN3:	SYSCAL SYSGT,[['SYSVER]][A ? D]	; Best to get table index dynamically,
	JUMPE D,APOPJ		; If can't, lose.
	]
IFN DECSW,MOVEI D,11	; 11 = .GTCNF   But on T10 we can assume this.

	MOVE AA,[440600,,V.SITE]
	MOVSI C,-5	; Process 5 words of .GTCNF (max possible)
SITIN4:	HRLZ B,C	; Get subindex we want,
	HRRI B,(D)	; and produce <subindex>,,<table #>
IFN DECSW, GETTAB B,	; Get 1 word of table, using appropriate call.
IFN TNXSW, SYSCAL GETAB,[B][B]
	 POPJ P,	; If call fails, exit.
SITIN5:	SETZ A,
	LSHC A,7	; Extract an ascii char
	CAIE A,",	; If it's a comma,
	 CAIG A,40	; or ctl or space,
	  POPJ P,	; then let's stop.
	TRCE A,140	; Swap bit 40 with bit 100, thus turning
	 TRCE A,140	; "A to 'A, "a to 'A, "1 to '1, etc, and ^@ to ' .
	  TRCE A,140
	IDPB A,AA	; Store the sixbit into V.SITE
	JUMPN B,SITIN5	; When nothing left of this word of .GTCNF, get next.
	AOBJN C,SITIN4
	POPJ P,
] ;DECSW\TNXSW

SUBTTL RunTime - .MRUNT and end-of-assembly typeout
IFN RUNTSW,[

.SCALAR IRUNTM	; Holds initial run time (set at start of assembly)

	; .MRUNT - Returns runtime since start of assembly.

A.MRUN:	PUSHJ P,RNTTMA	; Get current run time
	SUB A,IRUNTM	; Subtract initial run time
IFN ITSSW,[MULI A,4069.	; ITS - Convert to nanoseconds,
	DIV A,[1.^6]	;   then to milliseconds.
]
	PJRST CLBPOP

	; RNTTMA - internal routine to return in A the current runtime,
	; in whatever units the OS furnishes.
RNTTMA:
IFN ITSSW, .SUSET [.RRUNT,,A]	; Gets runtime in 4.096 usec units.
IFN DECSW, SETZ A, ? RUNTIM A,	; Runtime in msec
IFN TNXSW,[
	IFN A-1, EXCH R1,A
	MOVEI R1,.FHSLF
	RUNTM			; Runtime in msec for self.
	IFN A-1, EXCH R1,A
	]
	POPJ P,

; RNTTYO - Called at end of assembly to type out runtime,
;	# of errors, and # symbols used.

RNTTYO:
IFN DECSW,[	; Nobody wants this on ITS, but other people do...sigh...
	SKIPE A,ERRCNT		; Any assembly errors?
	 JRST [	TYPE "? "	; Yes, error message for batch controllers
		CALL DPNT
		TYPECR " error(s) detected"
		JRST .+1]
	SKIPE CCLFLG			; Called via CCL?
	 RET
]
	TYPE "Run time = "
	CALL A.MRUN	; Get runtime in millisec. in A.
	IDIVI A,10.
	IDIVI A,100.	; Get secs and hundredths.
	HRLM B,(P)	; Save remainder
	PUSHJ P,HMSTYO	; Type out secs
	MOVEI A,".
	CALL TYO
	HLRZ A,(P)
	CALL HMSTY3	; Type out hundredths
	CALL CRR
	CALL A.SYMC
	CALL DPNT
	TYPE " Symbols including initial ones ("
	CALL A.SYMC
	IMULI A,100.
	IDIV A,SYMLEN	; Get % symtab used
	CALL DPNT
	TYPECR "% used)"
	RET

; HMSTYO - Type out H:MM:SS time in A
;	 Doesn't work for times .ge. 60. hours

HMSTYO:	IDIVI A,60.
	JUMPE A,[MOVE A,B ? PJRST DPNT]
	HRLM B,(P)
	PUSHJ P,HMSTYO
	MOVEI A,":
	PUSHJ P,TYO	; Type delimiting char
	HLRZ A,(P)
HMSTY3:	IDIVI A,10.
	PUSHJ P,ADGTYO	; Type out digit in A
	MOVEI A,"0(B)
	PJRST TYO

] ; IFN RUNTSW

SUBTTL COMMON Output Routine WINIT - Open all output files.

; WINIT - Called from top-level control to open all necessary output files.
;

WINIT:
IFN ERRSW,[
	SKIPN ERRFP	; If want error output file,
	 JRST WINIT2
	CALL OINIT	; Open it, first of all.
	 0 ERRFC,ERRFB
	 SIXBIT/ERROUT/
	 ERRHDR,,ERRBUF
	SETOM ERRFOP	; Error file now open.
WINIT2:	]
	PUSHJ P,OINIT		; Open main output file.
	 13^9 UTYOC,OUTFB	; <dec-mode> chnl,name-block.
	 SIXBIT/OUTPUT/
	 UTOHDR,,UTOBUF
IFN ITSSW,[
	TLZ FF,FLPTPF	; Initially assume device not paper tape punch
	.STATUS UTYOC,A	; Get status of output channel
	ANDI A,77	; Mask to device code
	CAIN A,7	; If paper tape punch,
	 TLO FF,FLPTPF	; Then set FLPTPF.
]
IFN LISTSW,[
	SKIPN LISTP
	 JRST WINIT1
	CALL OINIT		; Open listing file if desired.
	 0 LPTC,LSTFB
	 SIXBIT/LSTOUT/
	 LSTHDR,,LSTBUF
WINIT1:
]
IFN CREFSW,[
	SKIPN CREFP	; If cref requested,
	 RET
	PUSHJ P,OINIT		; Open cref file, FN2 = CRFOUT
	 13^9 CREFC,CRFFB
	 SIXBIT/CRFOUT/
	 CRFHDR,,CRFBUF
	MOVE A,[.BYTE 7 ? 177 ? "B ? ^W]
	PUSHJ P,CRFOUT		; Output header to indicate image input.
	PUSHJ P,CRFSSF		; Output set-source-file block.
]
	RET

SUBTTL COMMON Output Routines - Output Chars/Words to BIN, TTY, ERR, CREF, LIST

	; PPB - Punch Binary word.

PPB:	JUMPGE FF,CPOPJ		; Don't punch if not punching pass.
PPBA:			; This entry pt "Always" punches.
TPPB:	SOSGE UTYOCT		; If no more room in buffer,
	 JRST [	CALL TPPBF	; Output & re-init buffer.
		JRST TPPB]
	IDPB A,UTYOP
	RET

TPPBF:	PUSH P,[0 UTYOC,UTOHDR]	; Drop thru to COBUFO.

	; Common OBUFO.  Takes <ch>,<header> on stack, clobbers no ACs.
	; See rtns below for usual calling sequence.
COBUFO:	EXCH C,(P)	; Get arg off stack, save C.
	CALL OBUFO	; Output & re-init buffer.
	REST C
	RET

	; TYO - Output char in A, outputting also to ERR file if possible.
TAB:	MOVEI A,^I
TYO:	SKIPG A.TTYF
	 CALL TYOX	; Actually output to TTY with OS-dependent routine.
			; Then fall through for ERR output.
ERRCHR:
IFE ERRSW,RET
IFN ERRSW,[
	SKIPN ERRFOP	; Output char in A to error file if one is open.
	 RET
	SOSGE ERRFCT
	 JRST [	PUSH P,[ERRCHR]
		PUSH P,[0 ERRFC,ERRHDR]
		PJRST COBUFO]
	IDPB A,ERRPTR
	RET
] ;IFN ERRSW

	; CRFOUT -  Output word in A to CREF file.

IFN CREFSW,[
CRFOUT:	SOSGE CRFCNT
	 JRST [	PUSH P,[CRFOUT]		; Buffer full, go output it.
		PUSH P,[0 CREFC,CRFHDR]
		PJRST COBUFO]
	IDPB A,CRFPTR
	POPJ P,

CRFSSF:	SKIPA A,[1]	; Output set-source-file block.
CRFPSH:	MOVEI A,3	; Output push-source-file block.
REPEAT L$F6BL,[
	CALL CRFOUT
	MOVE A,INFB+$F6DEV+.RPCNT
	]
	JRST CRFOUT
] ; IFN CREFSW


	; PILPT -  Output character in A to listing file.

IFN LISTSW,[
PILPT:	SOSGE LSTCNT
	 JRST [	PUSH P,[PILPT]		; When buffer full, output it.
		PUSH P,[0 LPTC,LSTHDR]
		PJRST COBUFO]
	IDPB A,LSTPTR
	RET

LPTCLS=:CPOPJ	; Hmmm, random noop-ness ref'd by AEND.

] ;END IFN LISTSW,

SUBTTL COMMON Output Routine .FILE - Close all output files.

; .FILE - Counterpart to WINIT.
;	Close input, bin, cref and list files.

.FILE:			; Closing input file is simple enough...
IFN DECSW, RELEAS UTYIC,
IFN ITSSW, .CLOSE UTYIC,
IFN TNXSW,[
IFN PMAPSW, MOVE A,[NIBFPS,,1STBFP] ? CALL DELPGS	; flush buffer pages
	MOVE R1,INFB+$FJFN
	CLOSF
	 JFCL
	SETZM INFB+$FJFN
	SETZM JFNCHS+UTYIC
]
	MOVNI A,1
	SKIPL B,CONTRL	; If relocatable,
	 PUSHJ P,TPPB	; Output a -1 so stink will see EOF
	SETZ A,		; In dec fmt, output a 0 at end.
	TRNE B,DECREL
	 CALL TPPB
	SKIPE OUTFB+$FEXT	; Check general name.
	 JRST .FILE2		; Output fnam2 was explicitly specified

	; Output extension (fn2) wasn't specified, default depends
	; on system and output type.
IFN ITSSW, MOVSI A,'BIN		; Default to SBLK output format; note that
IFE ITSSW, MOVSI A,'SBK		; this will include RIM, RIM10.
	SKIPL B,CONTRL		; Using STINK output format?
IFN ITSSW, MOVSI A,'REL		; Yes, use appropriate thing for site.
IFE ITSSW, MOVSI A,'STK
	TRNE B,DECSAV		; Using DECSAV output format?
	 MOVSI A,'SAV
IFN TNXSW,[
	TRNE B,DECSAV		; If using DECSAV format and
	 TLNN FF,FL20X		; on a 20X, then
	  CAIA
	   MOVSI A,'EXE		; use this extension instead.
]
	TRNE B,DECREL		; Using DECREL output format?
	 MOVSI A,'REL
IFN FASLP,[
	TRNE B,FASL		; Using FASL output format?
IFE DECSW, MOVE A,[SIXBIT /FASL/]	; yes, smash as appropriate.
IFN DECSW, MOVSI A,'FAS
]
IFE TNXSW, MOVEM A,OUTFB+$F6EXT	; For 6bit systems, store final selection.
IFN TNXSW, PUSHJ P,TNXODF	; If Tenex, call output default hackery, since
				; changing stuff is a bit hairier.

.FILE2:	JSP A,OCLOSE
	 0 UTYOC,UTOHDR	; Write out buffer, rename and close output file.
	 OUTFB
IFN LISTSW,[
	SKIPN LISTP	; Listing file open =>
	 JRST .FILE3
	CALL PNTCR	; End with cr and ff.
	MOVEI A,^L
	CALL PILPT
	PUSH P,FATAL	; Rename listing file even if fatal error.
	SETZM FATAL
	JSP A,OCLOSE
	 0 LPTC,LSTHDR	; Output buffer, rename & close it.
	 LSTFB
	POP P,FATAL
.FILE3:
] ;IFN LISTSW
IFN CREFSW,[
	SKIPN CREFP	; If cref file open,
	 POPJ P,
	MOVEI A,0
	PUSHJ P,CRFOUT	; Output eof block,
	JSP A,OCLOSE	; Write buffer, close.
	 0 CREFC,CRFHDR	; 0 chnl,header
	 CRFFB
]
	RET

	; File out error output file.  This isn't done in .FILE so that
	; error file can include a few more goodies and be closed separately
	; later on.
ERRCLS:	SETZM FATAL	; Err file renamed even after fatal error.
IFN ERRSW,[
	SKIPN ERRFOP
	 RET		; There is none.
	MOVEI A,^M
	CALL ERRCHR	; Put crlf at ennd.
	MOVEI A,^J
	CALL ERRCHR
	JSP A,OCLOSE	; Rename and close.
	 0 ERRFC,ERRHDR
	 ERRFB
	SETZM ERRFOP
]
	RET

SUBTTL ITS - Output file Open, Output, Close/Rename.
IFN ITSSW,[

;	PUSHJ P,OINIT	; Open output file
;	 Mode chnl,name-block-addr
;	Sixbit/desired-temporary-fn2/
;	Header,,buffer space	;used only in dec version.
; The mode should be 13^9 for binary, 0 for ascii.

OINIT:	MOVE A,(P)
	HLRZ B,2(A)	; Get addr of header,
	SETOM 2(B)	; Set buffer byte count to -1 => not initted.
	MOVE AA,1(A)	; Get 2nd arg, temp FN2 to use.
	MOVE F,(A)	; Get 1st arg - <mode> <ch>,<filblk>
	SYSCAL TRANS,[5000,,.UAO		; For output mode,
		REPEAT 4,[?       .RPCNT(F) ]		; translate from given names
		REPEAT 4,[? MOVEM .RPCNT+FB+$F6DEV ]]	; into actual names, in scratch blk.
	 JRST OINITL	; (too many translations)

	SYSCAL DELETE,[FB+$F6DEV	; Delete old temp name file.
		TMPFN1 ? AA ? FB+$F6DIR]
	 JFCL				; If none, it's ok.
	LDB A,[270400,,F]	; Get channel num.
	HRLI A,.BAO		; Open mode (default ascii)
	TLNE F,777000		; But maybe want image mode.
	 HRLI A,.BIO		; Yep, use that instead, to get <mode>,,<ch>
	SYSCAL OPEN,[A ? FB+$F6DEV	; Open file,
		TMPFN1 ? AA		; using these temp filenames.
		FB+$F6DIR]
	 JRST OINITL
	BLTM L$F6BL,FB+$F6DEV,$F6DEV(F)	; Copy translated names into
				; name-block for file, for eventual rename.

POPJ3:	AOS (P)		; Skip over 3 args.
POPJ2:	AOS (P)
	JRST POPJ1

TMPFN1:	SIXBIT /_MIDAS/		; FN1 to use for temp filenames.



; OINITL - jumped to from OINIT if some lossage
;	encountered when opening output files.


OINITL:	HLLZ A,@(P)	; Get chnl num,
	TLZ A,777037	; Mask to just ac field (chnl num)
	IOR A,[.STATUS A]
	XCT A		; Read its status,
	PUSHJ P,OPNER	; Type out reason for open failure, and ask
	TYPE "Use what filename instead? "
	PUSHJ P,GTYIP	; Get typein, one line.
	MOVE F,@(P)	; Get <filblk>
	PUSHJ P,RFD	; Get new file description into filblk spec'd by F
	JRST OINIT	; and jump back to try again.

VBLK
ERRDNM:	.UAI,,'ERR ? 3
ERRCOD:	0
IFSTS:	0	; .STATUS word stored by OPNRD1 when .OPEN loses
PBLK

	; Openloss documentation routine

IOPNER:	MOVE A,IFSTS	; Input
OPNER:	MOVEM A,ERRCOD	; Save .status word
	PUSHJ P,TYPFB	; Type out file description
	PUSHJ P,CRRERR	; Now crlf to ensure room for following
	.OPEN ERRC,ERRDNM	; Now get the system to say what's wrong
	 .LOSE %LSSYS		; Can't open err device?
IOPNR2:	.IOT ERRC,A	; Get character from system
	CAIGE A,40	; Ends with ^L or ^C or other cruft.
	 PJRST CRRERR	; Return, typing out CRLF.
	PUSHJ P,TYOERR	; Type out character
	JRST IOPNR2	; Loop back for next


;	JSP A,OCLOSE
;	0 chnl,header
;	Nameblockaddr
; Write out last buffer, rename to names in nameblock and close.

OCLOSE:	MOVE C,(A)		; 1st wd of args is what OBUFO wants.
	LDB B,[360600,,1(C)]	; Just in case this is ascii file,
	DPB B,[300600,,OCLOSP]	; Get bp to unused part of last wd of buffer,
	MOVE B,[ASCIC//]
	DPB B,OCLOSP		; And pad with ^c's.
	SOS 2(C)		; Obufo assumes byte count was sos'd.
	CALL OBUFO		; Write out last partial buffer
	MOVE F,1(A)		; Get <filblk>
	LDB C,[270400,,(A)]	; Get chnl num.
	SKIPE FATAL
	 JRST OCLOS1		; After fatal error, don't rename outputfiles.
	SYSCAL RENMWO,[C	; Rename (F has nameblock addr)
		$F6FN1(F) ? $F6FN2(F)]
	 .LOSE %LSSYS
OCLOS1:	SYSCAL CLOSE,[C]	; Close channel.
	 .LOSE %LSSYS
	JRST 2(A)	; Skip over args on return.


; OBUFO - Write out and reinitialize buffer for file.
;	Assumes byte count (header 3rd wd) was sos'd.
;	C has <0 chnl,header>
;	In ITS version, header 1st wd has <size in bytes>,,<buffer addr>-1

OBUFO:	PUSH P,A
	PUSH P,AA
	AOSGE 2(C)	; Was count sos'd from -1?
	 JRST OBUFO1	; Yes, buffer hadn't been initted, don't write it.
	MOVN A,1(C)
	ADD A,(C)	; RH(A) has -<# wds used in buffer>.
	MOVSI A,(A)
	HRR A,(C)
	AOS A		; A has aobjn -> used part of buffer.
	HLLZ AA,C
	IOR AA,[.IOT A]
	CAIGE A,
	 XCT AA		; Write it in file.
OBUFO1:	MOVE A,1(C)
	HRR A,(C)	; Position the b.p. before start of buffer,
	TLZ A,770000	; After last byte in wd (idpb will use 1st buffer wd)
	MOVEM A,1(C)
	HLRE A,(C)
	MOVEM A,2(C)	; Set up byte count.
	REST AA
	JRST POPAJ

TFEED:	TLNN FF,FLPTPF	; If output device not PTP,
	 POPJ P,	; Then do nothing
	PUSHJ P,TPPBF	; Otherwise output the buffer,
TFEED1:	.FEED UTYOC,	; Feed a line,
	TLZA FF,FLPTPF	; If this is executed, utyoc doesn't have ptp after all
	 SOJG B,TFEED1	; Feed the specified number of lines,
	POPJ P,		; And return

] ; IFN ITSSW

SUBTTL DEC - Output file Open, Output, Close/Rename

IFN DECSW,[

OINIT:	MOVE AA,(P)
	MOVE F,(AA)	; Get <mode> <ch>,<filblk>
	HLLZ TT,F
	TLZ TT,#(0 17,)	; Mask off AC field in TT
	HRRZ D,2(AA)	; Get buffer space addr.
	HLLZ C,2(AA)	; Get header addr.
	HLRZ A,C
	SETZM (A)	; Clear out its-version contents of 1st header wd.
	LDB A,[331100,,F]	; Get mode to open in (will be ascii or image binary)
	IOR TT,[OPEN A]		; Cons up OPEN instruction for chan,
	MOVE B,$F6DEV(F)	; and bring in last arg.
	XCT TT			; Open channel,a
	 JRST OINITL		; Lost?

	PUSH P,.JBFF	; Now to fake out DEC system into consing up buffer
	MOVEM D,.JBFF	; at this location.  T10 uses .JBFF as pointer.
	XOR TT,[<OPEN A>#<OUTBUF 1>]	; Request buffer setup (one of)
	XCT TT
	REST .JBFF
	MOVE A,[SIXBIT /000MD /]
	PJOB B,		; Get job number, to make sixbit /<nnn>md<e, o, or l>/
	IDIVI B,10.
	DPB C,[220400,,A]
	IDIVI B,10.
	DPB C,[300400,,A]	; Put the digits of the job number into the sixbit word.
	DPB B,[360400,,A]
	MOVE AA,(P)
	LDB B,[360600,,1(AA)]	; Get 1st char of 'output, 'lstout, 'crfout, 'errout.
	IOR A,B			; Use it as last char of temp file name.
	MOVSI B,'TMP		; Set up ext (fn2),
	SETZ C,			; zap prot/date/time etc to default,
	MOVE D,$F6DIR(F)	; and PPN.
	XOR TT,[<OUTBUF 1>#<ENTER A>]
	XCT TT			; Do ENTER UTYOC,A
	 JRST OINITL
POPJ3:	AOS (P)
POPJ2:	AOS (P)
	JRST POPJ1

; OINITL - jumped to from OINIT if some lossage
;	encountered when opening output files.  Jumps back to OINIT
;	directly.

OINITL:	PUSHJ P,OPNER	; Type out reason for open failure, and ask:
	TYPE "Use what filename instead? "
	PUSHJ P,GTYIP	; Get typein, one line.
	PUSHJ P,RFD	; Get new file description into filblk spec'd by F
	JRST OINIT	; and jump back to try again.

	; Openloss documentation routine - not much to say.

IOPNER:		; Input
OPNER:	PUSHJ P,TYPFB		; Type out file description
	PUSHJ P,CRRERR		; Now crlf to ensure room for following
	TYPE "OPEN failed"
	PJRST CRRERR		; Return, typing out another CRLF.

;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS.

OCLOSE:	PUSH P,A	; Save return addr
	MOVE F,1(A)	; Get <filblk>
	SKIPGE FATAL	; If fatal error happened,
	 JRST OCLOS2	; don't rename, just close.
	MOVE C,$F6DEV(F)	; Delete any file with names
	SETZB B,D	; we want to rename to.
	OPEN ERRC,B	; Use ERRC as temporary channel.
	 JRST OCLOS1
	MOVE A,$F6FN1(F)
	HLLZ B,$F6EXT(F)
	SETZ C,
	MOVE D,$F6DIR(F)
	LOOKUP ERRC,A
	 JRST OCLOS1	; There is none, just rename.
	SETZ A,		; Say to delete this file
	MOVE D,$F6DIR(F)	; From right UFD
	RENAME ERRC,A
	 JFCL
	RELEAS ERRC,
OCLOS1:	MOVE A,$F6FN1(F)	; Desired fn1.
	HLLZ B,$F6EXT(F)	; Desired fn2.
	SETZ C,			; Bottoms-10 DATE75 lossage must never be forgotten!
	MOVE D,$F6DIR(F)	; Sname (that is, ppn)
	HLLZ AA,@(P)		; Get just chnl num.
	IOR AA,[CLOSE]		; Close it & finalize,
	XCT AA
	XOR AA,[CLOSE#<RENAME A>]
	XCT AA			; Then rename to desired names.
	 JFCL			; at this point, ignore any lossage, sigh.
OCLOS2:	HLLZ B,@(P)	; Get chnl in ac field.
	IOR B,[RELEAS]
	XCT B		; Finally, release channel.
	JRST POPJ2	; and skip over args on return.

	; Write out buffer of output file, C has <0 chnl,header>
OBUFO:	AND C,[0 17,]	; Get just chnl num. (sys remembers where header is for ch)
	TLO C,(OUT)	; Output current buffer.
	XCT C
	 RET		; Normal return!
	PUSH P,A		; Error return from out uuo.
	XOR C,[OUT#<GETSTS A>]
	XCT C		; Read file status.
	TRZ A,74^4	; Clear error bits.
	ETR [ASCIZ /Output data error/]
	XOR C,[<GETSTS A>#<SETSTS (A)>]
	XCT C
	JRST POPAJ

	; Paper tape stuff, do nothing.
TFEED:	RET

] ;END IFN DECSW,

SUBTTL TNX - Output file Open, Output, Close/Rename

IFN TNXSW,[

TFEED:	RET	; Again, null out paper-tape hack.

; OINIT - Open Output file.
;	P points to first word of args which follow the call:
;	1: <mode> <ch>,<filblk>		; <mode> is 0 for ascii, 13^9 for bin.
;	2: sixbit /<desired temp fn2>/
;	3: <header>,,<buffer-space>
;	<return to this location>
;	Clobbers A,B,C

; For Tenex, it is necessary to fudge the fileblock consistency slightly;
; $FJFN has in RH the actual JFN used to write to the temporary-name
; file, and in LH the JFN for the final desired filename.  Note that if
; the $FEXT is null for main output file, it will be defaulted by TNXODF
; at close time, (to SAV, EXE, or REL) and the
; "final desired" JFN won't actually be used.
;	Both JFNS are "active" rather than just a file spec.

OINIT:	MOVE C,(P)	; Get addr of arg block
	HLRZ A,2(C)	; Get <header>,
	SETOM 2(A)	; and set buffer byte cnt to -1 to mark for init.
	MOVE F,(C)	; Get <mode> <ch>,<filblk>
	PUSHJ P,GETJFO		; Get output JFN for filblk.
	 JRST OINIT5		; Lost?
OINIT2:	HRLZS $FJFN(F)		; Won, move JFN over into LH.

	; Aha, successfully grabbed a JFN for desired output filename.
	; Now must get another one for the temporary filename...
	MOVSI A,(GJ%FOU+GJ%NEW)
	PUSHJ P,TFMAP		; Must set up block again, may have changed due to RDJFNO.
	MOVE A,1(C)		; Get sixbit/tmpfn2/
	PUSHJ P,CV6STR		; Convert to ASCIZ and return BP to string.
	MOVEM A,GTJBLK+.GJEXT	; Store in long-form call blk.
	SYSCAL GTJFN,[[GTJBLK] ? [0]][A]	; Repeat the GTJFN call.
	 JRST [	MOVEM A,ERRCOD	; Ugh????
		JRST OINIT5]
	HRRM A,$FJFN(F)		; Good, got it...

	; Now have both JFN's packed away, can finally open the
	; temporary filename.
	HRRZ B,A		; Need JFN in RH with LH clear...
	LDB A,[331100,,F]	; Get <mode>
	CAIN A,
	 MOVSI A,070000		; If 0, use ASCII (7-bit bytes)
	TRNE A,-1
	 MOVSI A,440000		; If not 0, use WORD (36-bit bytes)
	TRO A,OF%WR		; Get write access.
	SYSCAL OPENF,[B ? A][A]	; Open up the temp file (JFN in RH)
	 JRST [	MOVEM A,ERRCOD ? JRST OINIT6]	; damn

	; Won, successfully opened output file stuff etc, now wrap up.
	HRRZ A,$FJFN(F)		; Get JFN used,
	LDB C,[270400,,F]	; and channel number argument,
	MOVEM A,JFNCHS(C)	; and store JFN away in channel slot.
	PUSHJ P,CVFSIX		; Now put right things in $F6 entries.
	MOVEI A,3
	ADDM A,(P)
	POPJ P,

.SCALAR ERRCOD

	; Come here when GTJFN fails trying to get a JFN for GTJBLK long
	; form argument block.  Must print out bad filename.
	; OINIT5 should really use names in GTJBLK, and
	; OINIT6 should really hack GJFNS call to get names, but for now...

OINIT5:	SKIPA A,[[ASCIZ /GTJFN failed for /]]
OINIT6:	 MOVEI A,[ASCIZ /OPENF failed for /]
	PUSHJ P,CRRERR
	TYPR (A)
	PUSHJ P,OPNER1		; Type out filename and error message.
	PUSHJ P,RDJFNO		; Read new JFN
	JRST OINIT2		; try to open it.

IOPNER:	PUSH P,[CRRERR]	; Do following and add CRLF.
OPNER1:	PUSHJ P,TYPFB
	TYPE "
Error - "		; Drop thru to TERSTR.


TERSTR:	MOVE A,ERRCOD
	HRLI A,.FHSLF
	SYSCAL ERSTR,[[-1,,ERSTRB] ? A ? [-LERSTR,,]][A ? A ? B]
	 JRST TERST7	; undefined err #?
	 GOHALT		; destination bad?
	TYPR ERSTRB
	POPJ P,
TERST7:	TYPE "Unknown error"
	POPJ P,

	LERSTR==80.
.VECTOR ERSTRB(<LERSTR+4>/5)

; RDJFNO - Hack to get a new JFN by reading from TTY, using recognition.
; RDJFNI - Same but for input.  Uses current FB for defaults.
;	Stashes JFN away in RH of $FJFN(F).

RDJFNO:	SKIPA A,[GJ%FOU+GJ%NEW+GJ%CFM]	; For output
RDJFNI:	 MOVSI A,(GJ%OLD+GJ%CFM)	; for input
	PUSHJ P,TFMAP
	MOVE A,[.PRIIN,,.PRIOU]	; Use primary JFNs (TTY) for I/O
	MOVEM A,GTJBLK+.GJSRC
	PUSH P,R1
	PUSH P,R2
	PUSH P,R3
	SYSCAL DTI,[[.TICCV]]	; Disable ^V as an interrupt character
	CAIA
RDJFN2:	 PUSHJ P,RDJERI		; Come here when get error in GTJFN.
	MOVEI R1,.PRIIN		; Make sure that
	CFIBF			; TTY input is reset.
	HRROI R1,[ASCIZ /
Use what filename instead? /]
	PSOUT
	MOVEI R1,
	MOVEI R1,GTJBLK
	SETZ R2,
	GTJFN
	 JRST RDJFN2	; Error, report it.
	SYSCAL ATI,[[.TICCV,,.IC.CV]]	; Turn back on ^V
	POP P,R3
	POP P,R2
	HRRM R1,$FJFN(F)
	POP P,R1
	PJRST JFNSTB	; Smash FB with names of the JFN we got, and return.
	
; RDJERR - Report last error message directly to TTY (primary output).
;	Useful when doing quick direct user interaction.

RDJERR:	TROA R2,-1	; Here to get last error, whatever it was.
RDJERI:	 MOVE R2,R1	; Here to use err code in R1.
	HRLI R2,.FHSLF
	HRROI R1,ERSTRB
	MOVSI R3,-LERSTR
	ERSTR		; Get error string
	 JRST RDJER6
	 GOHALT
	SKIPA R1,[-1,,ERSTRB]
RDJER6:	 HRROI R1,[ASCIZ /Unknown error/]
	ESOUT		; Output to TTY amid other hackery.
	POPJ P,


; TNXODF - Hack to get yet another "desired" JFN so that when no
;	extension was specified for binary output file, one appropriate to
;	the type can be selected.
;	Basically do a GTJFN again for binary output filenames, furnishing
;	the default extension selected, and use that to replace the one
;	already in LH of $FJFN.

TNXODF:	PUSHJ P,CV6STR	; Convert sixbit word in A to string, get BP in A
	MOVEI F,OUTFB		; Point at right filblk,
	MOVEM A,$FEXT(F)	; Store, and now
	PUSH P,$FJFN(F)		; Save current set of JFNs before
	PUSHJ P,GETJFO		; getting another one
	 JRST POPAJ		; If lossage, stick to old JFN.
	POP P,A
	HRLZS $FJFN(F)		; GETJFO puts JFN into RH, we want it in LH.
	HRRM A,$FJFN(F)		; now restore previous RH.
	HLRZS A			; and get old "desired" JFN in position for
	SYSCAL RLJFN,[A]	; releasing.
	 JFCL
	POPJ P,

; OCLOSE - Close output file, writing out remainder of buffer and renaming
;	from temporary to desired filename.
;	JSP A,OCLOSE
;	1: 0 <ch>,,<header>
;	2: <filblk>
;	Clobbers F,C (and obviously A)

; 10x must do CLOSF, not releasing the JFN, and then a RNAMF from temp
; JFN to desired JFN, after which both can be released.  The desired and
; used JFNs are in LH and RH respectively of $FJFN in <filblk>.  <ch>
; is ignored except to wipe out its JFNCHS entry.

OCLOSE:	PUSH P,A
	MOVE C,(A)	; Get <ch>,,<header>
	SOS 2(C)	; OBUFO assumes count was SOS'd before each call
	PUSHJ P,OBUFO	; Write out anything remaining in buffer.
	LDB C,[270400,,(A)]	; Get channel number
	MOVE F,1(A)	; Get <filblk>
	HRRZ A,$FJFN(F)	; Find JFN being used...
	CAME A,JFNCHS(C)	; Should be same as JFN for channel.
	 GOHALT		; Synch error or something.
	TLO A,(CO%NRJ)	; Say don't release JFN
	SYSCAL CLOSF,[A]	; Close file...
	 GOHALT		; ?!?!
	HRRZS A		; Get back 0,,jfn
	SETZM JFNCHS(C)	; Indicate "channel" closed...
	SKIPE FATAL	; If fatal error happened in assembly,
	 JRST OCLOS5	; don't rename from temp filenames.
	HLRZ C,$FJFN(F)	; Now see what if anything to rename it to.
	JUMPE C,OCLOS5	; If no renaming needed, skip hair.
	SYSCAL RNAMF,[A ? C]	; Rename file from JFN in A to JFN in C.
	 GOHALT		; WTF?
	SYSCAL RLJFN,[C]
	 GOHALT
	JRST OCLOS6	; JFN in A released by RNAMF.

OCLOS5:	SYSCAL RLJFN,[A]
	 GOHALT
OCLOS6:	SETZM $FJFN(F)
	POP P,A
	JRST 2(A)

; OBUFO - Output Buffer and reinitialize.
;	C/ 0 <ch>,<header>
;	Clobbers no ACs.

; 10X is pretty much like ITS, JFN is kept in JFNCHS table indexed by <ch>.

OBUFO:	PUSH P,A
	PUSH P,B
	MOVE A,1(C)	; Get write BP,
	HRR A,(C)	; and reset it...
	TLZ A,770000	; to point at start of buffer,
	MOVEM A,1(C)	; and store it back, which is OK since we have byte cnt
	AOSGE 2(C)	; Was buffer marked for initialization (cnt -1)?
	 JRST OBUFO1	; Yes, don't write anything, just go init rest of it.
	HLRZ A,(C)	; Get buffer size in wds,
	MOVNI A,(A)	; make negative,
	ADD A,2(C)	; and add count of bytes left to get -<# bytes used>.
	LDB B,[270400,,C]	; Get channel # as index to JFN
	PUSH P,T
	SYSCAL SOUT,[JFNCHS(B) ? 1(C) ? A]
	POP P,T
OBUFO1:	HLRZ A,(C)	; Get buffer size again,
	MOVEM A,2(C)	; and reset count with it.
	POP P,B
	POP P,A
	POPJ P,

] ;END IFN TNXSW

SUBTTL COMMON Input Routines - Main File Open, EOF handling

; Open main input file for reading (filespec in ISFB)

OPNRD:
IFN ITSSW, .IOPDL		; Re-initialize IO pdl
IFN DECSW\TNXSW, CALL IOPDLC	; Non-ITS systems must simulate.
	INSIRP SETZM,INFCNT INFCUR INFERR
	MOVE A,[-TYPDLS-1,,TTYPDL]
	MOVEM A,ITTYP		; Initialize "tty pdl"
	PUSHJ P,MACIN1		; Clobber macro expansion status
	MOVE A,[ISFB,,INFB]	; Copy ISFB specs to INFB (which will hold
	BLT A,INFB+L$FBLK-1	; actual names of current input file)
	MOVE A,ISFB+$FDEV	; Get device name
	CAMN A,FSTTY		; TTY?
	 JRST [	MOVE A,[ISFB+$F6FN1,,IFNM1]	; TTY specified, treat special
		BLT A,IFNM2		; Clobber .IFNM1, .IFNM2 to specified
		MOVE A,ISFB+$FVERS
		MOVEM A,IFVRS
		TYPECR "Reading from TTY:"
		MOVEI A,3	; => input from tty, don't quit on cr
		JRST OPNRT2]
	MOVEI F,INFB		; Point things at INFB.
	PUSHJ P,OPNRD1		; Try opening file
	 JRST [	PUSHJ P,IOPNER	; Open lost, type out message
		POPJ P,]	; Read new command (this may screw on pass2?)
	MOVEM A,INFERR		; Err msg in main file shouldn't type names.
	MOVEI A,0		; => input from file
IFN TNXSW,[
	MOVE T,INFB+$FJFN	; Copy actual jfn to avoid re-GTJFN
	MOVEM T,ISFB+$FJFN
]
OPNRT2:	MOVE T,[IFNM1,,RFNAM1]
	BLT T,RFVERS		; Set up .FNAM1, .FNAM2
	SETOM NEDCRL
	AOS (P)			; Won, skip on return.
	JRST RCHSET		; Set up to read from file or tty. (arg in A)


	; Common stuff for OPNRD1 in all (DEC/ITS/TENEX) versions.
OPNRD3:	HRRZM A,UTIBED		; Say buffer empty,
	MOVSI A,EOFCH_13
	MOVEM A,@UTIBED		; Cause immediate reload.
OPNRD4:	BLTM 2,$F6FN1(F),IFNM1	; Set up .IFNM1, .IFNM2 from filblk F points at
	MOVE A,$FVERS(F)
	MOVEM A,IFVRS
	AOS A,INFCNT		; Assign this file a number.
	MOVEM A,INFCUR		; OPNRD expects this left in A.
	JRST POPJ1

		; EOF while trying to read character

RPAEOF:	PUSH P,B	; Save B
RPAEO1:	MOVE B,ITTYP	; Get pdl pointer
	PUSHJ P,BPOPJ	; Call pop routine (maybe NED's out)
	JRST RCHTRB	; Return to get character

		; EOF from main file

NEDCHK:	TRNE FF,FRCMND	; ^C read in command, :KILL self.
	 JRST TSRETN
	SKIPN RCHMOD
	 AOSE NEDCRL
	  JRST NEDCH1

	; Invent one crlf after end of main file.
	MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? EOFCH]]
	MOVEM B,UREDP
	HRRZM B,UTIBED
IFN PMAPSW,[
	HRLI B,170700	; Make BP pointing at last (3rd) char
	MOVEM B,UTIBPE	; Set EOF BP properly.
]
	RET
NEDCH1:
IFN A1PSW,[
	PUSHJ P,OUTCHK
	MOVSI A,-LNEDT
	XCT NEDT(A)	; Skips if NED condition to be complained about
	AOBJN A,.-1
	JUMPGE A,GO8
]
	ETF [ASCIZ /No END statement/]

.SCALAR	NEDCRL	; -1 => haven't yet supplied a CRLF at EOF of main file.

IFN A1PSW,[	; Holler "NED" if any of the following:
NEDT:	SKIPL PRGC	; No end statements have been encountered
	SKIPGE OUTC	; Output has occured not matched by an end statement
	SKIPGE OUTN1	; Output has occured other than in 1pass mode
	TRNN FF,FRPSS2	; Currently in pass 2
LNEDT==.-NEDT	; Length of table
]

SUBTTL ITS - Input file Open, buffer input
IFN ITSSW,[

	; Try .OPENing input file pointed to by F.  Skips if successful.
	; Sets filenames to actual names.

OPNRD1:	SYSCAL OPEN,[[.BAI,,UTYIC]
		$F6DEV(F) ? $F6FN1(F) ? $F6EXT(F) ? $F6DIR(F)]
	 JRST [	.STATUS UTYIC,IFSTS	; Lost, save status now before possible
		POPJ P,]		; .IOPOP, and make failure return.
	SYSCAL RFNAME,[%CLIMM,,UTYIC	; Now find true filenames.
		MOVEM A
		MOVEM C			; But need to check FN1, FN2 so
		MOVEM D			; put them in ACs instead.
		MOVEM $F6DIR(F)]
	 .LOSE %LSFIL
	CAMN A,[SIXBIT/DSK/]
	 MOVE A,V.SITE		; Use machine name instead of DSK.
	MOVEM A,$F6DEV(F)
	CAIE C,			; If FN1 meaningless for device, skip to use
	 MOVEM C,$F6FN1(F)	; spec'd FN1 anyway, but else store actual FN1.
	CAIE D,
	 MOVEM D,$F6FN2(F)	; Ditto for FN2.
	MOVE D,[440600,,$F6FN2(F)]
	SETZ A,
OPNRD7:	TLNN D,770000
	 JRST OPNRD6
	ILDB C,D		; Calculate version number as number from fn2.
	CAIL C,'0		; Ignore non-digits.
	 CAILE C,'9
	  JRST OPNRD7
	IMULI A,10.
	ADDI A,-'0(C)
	JRST OPNRD7

OPNRD6:	SKIPN A			; No digits in FN2 => use -1 as version.
	 SETO A,
	MOVEM A,$FVERS(F)
	MOVE A,IUREDP		; Set up reading ptr,
	MOVEM A,UREDP
	JRST OPNRD3	; Set up ^C after buffer, infcur, etc.


	; EOFCH encountered on read, reload and jump back for next char

INCHR3:	HRRZ CH1,UREDP	; Get byte pointer
	CAME CH1,UTIBED	; End of block?
	 RET		; No, ^C in file.
	MOVE A,IUREDP
	MOVEM A,UREDP
	MOVE A,[-UTIBFL,,UTIBUF]
	.IOT UTYIC,A	; Read in block
	ANDI A,-1
	CAIN A,UTIBUF	; If the iot didn't give us anything, we are at EOF.
	 JRST RPAEOF
	HRRZM A,UTIBED	; Store RH (updated pointer) for EOF check at INCHR3
	MOVSI A,EOFCH_<18.-7>
	MOVEM A,@UTIBED	; Store a ^C after the data we read, so at EOB we come to INCHR3.
	JRST RCHTRA	; Now try next char
] ;END IFN ITSSW

SUBTTL DEC - Input file Open, buffer input

IFN DECSW,[

OPNRD1:	MOVEI C,UTIHDR	; Open the input file w/ names in dnam ... snam.
	SETZ A,		; Mode ascii.
	MOVEI D,UTIBUF
	MOVE TT,UTICHN	; Get channel num. to use.
	LSH TT,27	; Put in ac field.
	IOR TT,[OPEN A]
	MOVE B,$F6DEV(F)
	XCT TT		; Open channel,a
	 RET
	CALL BUFINI	; Initialize the input buffers and header.
	MOVE D,$F6DIR(F)
	MOVE A,$F6FNM(F)
	HLLZ B,$F6EXT(F)
	TLC TT,(OPEN#LOOKUP)
	XCT TT		; Lookup channel,a
	 RET		; Failed.
IFE SAILSW,[
	MOVE A,$F6DEV(F)
	DEVNAM A,	; Get real name of device.
	 CAIA
	MOVEM A,$F6DEV(F)
]
	MOVE D,[440600,,$F6FN2(F)]
	SETZ A,
OPNRD7:	TLNN D,770000
	 JRST OPNRD6
	ILDB C,D		; Calculate version number as number from fn2.
	CAIL C,'0		; Ignore non-digits.
	 CAILE C,'9
	  JRST OPNRD7
	IMULI A,10.
	ADDI A,-'0(C)
	JRST OPNRD7

OPNRD6:	SKIPN A			; No digits in FN2 => use -1 as version.
	 SETO A,
	MOVEM A,$FVERS(F)
	MOVE A,UREDP
	JRST OPNRD3


	; Reload buffer, DEC style.
INCHR3:	HRRZ CH1,UREDP	; Is this ^C at end of buffer?
	CAME CH1,UTIBED
	 RET		; No, ^C in file.
	PUSH P,B
	MOVE A,UTICHN
	LSH A,27	; Channel num. in ac fld.
	TLO A,(IN)
	XCT A		; Get next bufferfull.
	 CAIA		; Succeed.
	JRST INCHR4	; Error.
INCHR5:	MOVE A,UTICNT
	ADDI A,9
	IDIVI A,5
	ADD A,UREDP	; -> 1st wd not read into.
	HRRZM A,UTIBED
	HRRZ A,UREDP
	AOS A
	MOVEI B,1	; Scan the file and replace all line numbers with nulls.
INCHR6:	CAMN A,UTIBED
	 JRST INCHR7
	TDNE B,(A)
	 MOVEM B,(A)
	AOJA A,INCHR6

INCHR7:	MOVSI B,EOFCH_13
	MOVEM B,(A)	; Put EOF char after buffer, in extra word.
	JRST RCHTRB	; Retry RCH.

INCHR4:	XOR A,[<GETSTS B>#IN]
	XCT A
	TRZE B,74^4
	 ETR [ASCIZ /Input data error/]
	XOR A,[<GETSTS B>#<SETSTS (B)>]
	XCT A		; Clear error bits in status.
	TRNN B,2^4
	 JRST INCHR5
	JRST RPAEO1	; EOF.

; BUFINI - Create DEC-style buffer ring, with 1 extra word following
;	each buffer...
;	A/ <mode>
;	B/ <device name in 6bit>
;	C/ <header addr>
;	D/ <buffer space addr>
; Note that this extra-word crock is necessary just so it can be filled
; with ^C's to stop read loop and switch to next buffer.

BUFINI:	MOVEI AA,A
IFE SAILSW,DEVSIZ AA,
	 SKIPA AA,[DECBFL+1]	; Default buffer size is that for dsk.
	AOJLE AA,.-1	; Get size including extra wd.
	MOVEI T,1(D)	; Addr of wd 2 of 1st buffer.
	HRLI AA,T	; @AA is addr of 2nd wd of next buffer.
	SUBI D,(AA)	; Facilitate test for end of buffer space.
	HRLI T,400000
	MOVEM T,(C)	; Header -> a buffer, sign set.
	HRRM T,1(C)	; Make rh of bp -> buffer 1st wd.
	MOVSI T,440000	; Set up p-field of b.p.
	IORM T,1(C)
	HRRZ T,1(C)
	AOS 1(C)
	HRLI T,-3(AA)	; Data-area-size +1,,addr-of-2nd-wd
BUFIN1:	CAIGE D,-UTIBFL(T)	; Room for another after this buffer?
	 JRST BUFIN2	; No, wrap up.
	MOVEM T,@AA	; Yes, make next buffer -> this one,
	HRRI T,@AA	; Point to next one.
	JRST BUFIN1

BUFIN2:	ADDI D,1(AA)	; -> 2nd wd of 1st buffer.
	MOVEM T,(D)	; 1st buffer -> last, making ring.
	RET

] ;END IFN DECSW,

SUBTTL TNX - Input file Open, buffer input

IFN TNXSW,[

; OPNRD1 - Open File for Reading.  Old stuff assumed fnm in DNAM
;	using UTYIC channel, but new should furnish arguments:
;	F/ <filblk> to open

; Essentially just GTJFN and OPENF like OINIT does, with same
; sort of error handling, except that when reading from cmd line
; as opposed to .INSRT, just go back to get completely new command.
; (perhaps if typein is just CRLF, go to special TNX style cmd input?)

OPNRD1:	CAIN F,INFB	; Horrible kludge necessary because MIDAS main
			; level doesn't bother to explicitly close main
			; input file when pass 1 is done, and TNX barfs if
			; you try to re-open a JFN... sigh.
	 JRST [	SKIPN $FJFN(F)	; Main file.  Already opened it?
		 JRST .+1	; nope, get JFN & open normally.
		 IFE PMAPSW,[	; Already open. If not mapping, reset read ptr.
			SYSCAL SFPTR,[$FJFN(F) ? [0]][ERRCOD]
			 POPJ P,]
		JRST OPNRD2]	; and avoid attempt to re-open the JFN.
	SKIPN $FJFN(F)
	 JRST [	PUSHJ P,GETJFI		; No JFN, get one for input.
		 POPJ P,		; Could fail.
		JRST .+1]
	PUSH P,T		; Read access, full word input.
	SYSCAL OPENF,[$FJFN(F) ? [440000,,OF%RD]][ERRCOD]
	 JRST [POP P,T ? POPJ P,]	; Failure
	POP P,T
OPNRD2:	HRRZ A,$FJFN(F)
	MOVEM A,JFNCHS+UTYIC	; Indicate "channel" open with this JFN.
	PUSHJ P,JFNSTB		; Get actual names/version #.
	PUSHJ P,CVFSIX		; Put right stuff in $F6 entries.
	MOVE A,IUREDP		; Opened, set up buffer.
	MOVEM A,UREDP		; Initialize BP into buffer.
IFE PMAPSW,	JRST OPNRD3
IFN PMAPSW,	JRST OPNR50	; for PMAP hacking, lots of stuff to do.

	; Get a JFN for current FILBLK (in F) and stick it into $FJFN(F).
	; A should hold flags in LH to use in 1st wd of block.
	; GETJFI - sets usual flags for input
	; GETJFO - sets " " output
	; GETJFN - takes whatever A holds.

GETJFO:	SKIPA A,[GJ%FOU+GJ%NEW]	; If hacking output, ask for new version.
GETJFI:	 MOVSI A,(GJ%OLD)	; If hacking input, file must exist.
GETJFN:	PUSHJ P,TFMAP	; Stick filblk stuff into GTJFN scratch block.
	PUSH P,R1
	PUSH P,R2
	MOVEI R1,GTJBLK
	SETZ R2,
	GTJFN
	 JRST [	MOVEM R1,ERRCOD	; failure, save error code.
		JRST GETJF5]
	HRRM R1,$FJFN(F)	; Win, save JFN.
	AOS -2(P)
GETJF5:	POP P,R2	; Can't return in ACs cuz don't know what R1 etc are,
	POP P,R1	; and might clobber them here.
	POPJ P,

; TFMAP - Map Tenex filenames from filblk pointed to by F into
;	standard scratch block for long-form GTJFN.
;	A/ <flags>,,0	; flags will go into LH of .GJGEN.
;	Clobbers only A.

TFMAP:	HRR A,$FVERS(F)		; Put version # in RH
	SKIPE $FTEMP(F)		; If asking for temp file,
	 TLO A,(GJ%TMP)		; set appropriate flag.
	MOVEM A,GTJBLK+.GJGEN
IRP FROM,,[$FDEV,$FDIR,$FNAME,$FTYPE,$FPROT,$FACCT,$FJFN]TO,,[.GJDEV,.GJDIR,.GJNAM,.GJEXT,.GJPRO,.GJACT,.GJJFN]
	MOVE A,FROM(F)
	MOVEM A,GTJBLK+TO
TERMIN
	MOVE A,[.NULIO,,.NULIO]
	MOVEM A,GTJBLK+.GJSRC	; Don't hack I/O in gtjfn.
	POPJ P,

.VECTOR GTJBLK(10.)	; Need exactly this many wds for non-extended long call

IFE PMAPSW,[
	; EOFCH seen in input, check it here.

INCHR3:	HRRZ CH1,UREDP	; Get byte pointer
	CAME CH1,UTIBED	; End of block?
	 RET		; No, ^C in file.
	MOVE A,IUREDP
	MOVEM A,UREDP
	PUSH P,T
	SYSCAL SIN,[JFNCHS+UTYIC ? [444400,,UTIBUF] ? [-UTIBFL]][A ? A ? A]
	POP P,T
	ADDI A,UTIBUF+UTIBFL	; Get UTIBUF + <# bytes stored>
	CAIG A,UTIBUF	; If the sin didn't give us anything, we are at eof.
	 JRST RPAEOF
	HRRZM A,UTIBED	; Store rh (updated pointer) for eof check at inchr3
	MOVSI A,EOFCH_<18.-7>
	MOVEM A,@UTIBED	; Store a ^c after the data we read
	JRST RCHTRA	; Now try next character

] ; IFE PMAPSW

IFN PMAPSW,[	; New stuff for PMAP'ing input etc.

VBLK
IFNDEF NIBFPS,NIBFPS==10	; # of pages per buffer
PGBFL==NIBFPS*1000		; Length of a buffer in wds.
IFNDEF 1STBFP,1STBFP==500	; # of first page to start buffers at.

INBFPG:	1STBFP	; # of 1st buffer page (in our address space)
INFPAG:	0	; # of page in file corresponding to 1st page in buffer.
INPGCT:	0	; -# times to refill buffer with new pages.
INLPGS:	0	; # pages to slurp on last refill (instead of NIBFPS)
UTIBPE:	0	; BP to last byte of data in buffer (holding ^C)
UTIBPL:	0	; BP to last byte position in buffer area (constant)
UTIBPX:	0	; BP to last byte of data when last pages have been mapped.
INLCHR:	0	; Place to save char that ^C replaces.  If -1, no char.
;SOSSW:	0	; non-Z if hacking SOS line-number type file.
FBBYV:	0	; GTFDB dumps cruft in these two locs.
FBSIZ:	0	; e.g. this gets size of file in bytes.
PBLK

	; Wrap up open of an input file, by initializing all the cruft
	; above.
OPNR50:	SYSCAL GTFDB,[$FJFN(F) ? [2,,.FBBYV] ? MOVEI FBBYV]
	LDB C,[300600,,FBBYV]	; Get byte size of file
	CAIN C,
	 MOVEI C,36.	; If 0 use 36-bit bytes (full wds)
	MOVEI A,36.
	IDIVI A,(C)	; Get bytes per wd, ignore remainder.
	MOVE B,FBSIZ	; Now, with # bytes in file,
	EXCH A,B
	IDIVI A,(B)	; find <# in fil>/<# per wd> = # wds in file
	CAIE B,		; Also hack
	 ADDI A,1	; rounding up (gasp, wheeze, finally done.)
	IDIVI A,PGBFL	; Now get # times buffer will need slurping...
	ADDI A,1	; And another for the final slurp (even if it will be empty)
	MOVNM A,INPGCT	; Store -# slurps.
	MOVEI A,777(B)
	LSH A,-9.	; Find # pages last slurp really needs.
	MOVEM A,INLPGS	; and store away.
	HRLI B,010700
	MOVEM B,UTIBPX	; Store relative BP to last ch (when last pages mapped)
	HRRI B,PGBFL	; And relative BP to last char in whole buffer
	MOVEM B,UTIBPL	; Note UTIBPX and UTIBPL actually point to next wd
			; but this is fixed when abs addr is added in.

	MOVE A,INBFPG	; Find page # buffer starts at in core,
	LSH A,9.	; Get address, and
	SUBI A,1	; Subtract one, to fix UTIBPX, UTIBPL, and IUREDP.
	ADDM A,UTIBPX	; add into the BP's to make them absolute.
	ADDM A,UTIBPL
	HRLI A,010700	; And use for initial read pointer -
			; MUST be "canonical form", so that SEMIC hackery
	MOVEM A,IUREDP	; will work with weird way INCHR3 returns here.
	MOVNI A,NIBFPS	; Use this as initial file page #, so the ADDB in
	MOVEM A,INFPAG	; INCHR3 will do right thing to it.
	MOVE A,[440700,,[EOFCH_35]]
	MOVEM A,UREDP	; set up things so first RCH will instantly cause reload.
	ILDB B,A
	MOVEM A,UTIBPE
	SETOM INLCHR	; Mustn't forget that we don't have a stored char yet.
	JRST OPNRD4	; Finally done with PMAP init stuff.

	; Come here when hit ^C
INCHR3:	MOVE CH1,UREDP		; Get current read ptr
	CAME CH1,UTIBPE		; At end of buffer?
	 POPJ P,		; Nope, ^C in file, actual input.
	AOSLE CH1,INPGCT	; Aha, end of buffer.  Bump times refilled...
	 JRST INCH56		; and if no more refills, go handle EOF.
	MOVE A,IUREDP
	MOVEM A,UREDP
IFN A-1,PUSH P,R1
IFN A-2,PUSH P,R2
IFN A-3,PUSH P,R3
	MOVEI R1,NIBFPS		; Get # of input buffer pages
	ADDB R1,INFPAG		; and find current page in file to get
	HRL R1,$FJFN+INFB	; current input file's JFN
	MOVE R2,INBFPG		; and usual pointer to destination buffer page
	HRLI R2,.FHSLF		; Why the fuck doesn't 10X default this?!?!
	MOVEI R3,NIBFPS		; Set # pages to slurp up
	JUMPN CH1,INCH51	; But if this is last slurp,
	SKIPG R3,INLPGS		; Use pre-calculated # to avoid non-ex pages.
	 JRST INCH55		; No pages in last slurp!  Avoid new PMAP.

INCH51:	TLO R3,(PM%CNT+PM%RD+PM%CPY)	; Read access, copy-on-write.
INCH52:	PMAP		; Gobble gobble
	TLNN FF,FL20X	; If on 20X, that's all.
	 JRST [	HRRI R3,-1(R3)	; Else, on 10X, must iterate manually.
		TRNE R3,400000	; See if became "negative".
		 JRST INCH53	; Yep, done with manual iteration.
		ADDI R2,1	; Nope, bump page #'s.
		AOJA R1,INCH52]
INCH53:
IFN A-3,POP P,R3
IFN A-2,POP P,R2
IFN A-1,POP P,R1
	CAIE CH1,		; Was this the last slurp?
	 SKIPA CH1,UTIBPL	; no, use BP to Last char at end of buffer.
	  MOVE CH1,UTIBPX	; yes, need BP to last char in last page.
IFN 0,[	SKIPE SOSSW		; If hacking line number lossage,
	 JRST [	MOVE A,(CH1)	; must beware of getting wiped, so have to
		TRNE A,1	; check here, and if depositing EOFCH in #,
		 HRLI CH1,350700	; then move the EOFCH to beg of word!
		JRST .+1]
]
	LDB A,CH1		; Replace last char of buffer's data
	MOVEI CH2,EOFCH
	DPB CH2,CH1		; with the EOF char.
	MOVEM CH1,UTIBPE	; Remember ptr to end of data,
	EXCH A,INLCHR		; and save char for then, returning whatever
	JUMPL A,RCHTRA		; was the last char of last bufferfull.
				; (may be -1, in which case RCHTRA tries again)

	; Jump here to return a new char in A, something like
	; RCHTRA without all the fuss.
INCHR7:	POP P,CH1		; Get return addr
	ANDI CH1,-1
	CAIE CH1,RREOF+1
	 JRST -2(CH1)		; Note -2 not -3 as in RCHTRA!
	JRST (CH1)		; Special hack since -2 loses for RREOF.
				; Perhaps someday it will win.

INCH55:		; Here when doing last slurp and no pages to slurp.
IFN A-3,POP P,R3
IFN A-2,POP P,R2
IFN A-1,POP P,R1
INCH56:	SKIPGE A,INLCHR		; No more refills, see if last char left
	 JRST RPAEOF		; No?  All done, true EOF.
	SETOM INLCHR		; Almost, one last char.
	MOVE CH1,UREDP		; Must bump ptr back one char, so next read
	ADD CH1,[070000,,]	; will also stop.
	CAIG CH1,
	 SUB CH1,[430000,,1]
	MOVEM CH1,UREDP
	JRST INCHR7		; Return very last char in A.

] ; IFN PMAPSW

] ;END IFN TNXSW

ifn 0,[ ; turn off but keep around for a while.
SUBTTL old .INSRT Processing

;	.INSRT <filedescription><CR>	; Insert file here
; TTY: => ok, reads line at a time, rubout allowed within line
; Pushes macro expansion, other .INSRT's
; In filedescription, ^R => reset file name counter [?!? - KLH]
; If device is "@:", always ask for translation.

A.INSR:	NOVAL
	MOVE A,[ISFB,,FB]	; Default names are those of spec'd input file
	BLT A,FB+L$FBLK-1	; Zap them into scratch filblk.
	MOVEI F,FB		; And point at it.
	MOVE A,FSDSK
	MOVE B,FSTTY		; Compare "TTY" with
	CAMN B,$FDEV(F)		; device name, and if identical,
	 MOVEM A,$FDEV(F)	; default to DSK.
IFE ITSSW,MOVE A,FSMID		; Always set default extension to "MID" or ">"
IFN ITSSW,MOVE A,FSGRTN
	MOVEM A,$FEXT(F)

	TLO FF,FLUNRD
A.IN1:	PUSHJ P,RFD		; Read file description
	MOVE A,$FDEV(F)		; Get specified device name
	CAME A,FSATSN		; Atsign?
	 PUSHJ P,A.ITRY		; No, try opening file

	; If return, open failed.
	MOVE A,$F6DEV(F)
	AOJE A,A.INT1		; Already trying to set up table entry
	SKIPA F,[MAXIND,,TBLOFS]	; Atsign, or fnf, search table

A.IN2:	 SUBI F,-L$FBLK	; Loop point searching table, increment to next entry, count down LH
	CAMN F,INDDP	; Compare with pointer to top of table
	 JRST A.IN3	; Agree => this file not in table

;	MOVEI A,-TBLOFS(F)	; Get index relative to table base.
; MIDAS complains "illegal use of relocation" when try to use above addr, so must use next 2 instructions instead - barf barf
	MOVEI A,(F)
	SUBI A,TBLOFS

	MOVSI B,-L$FBLK		; And index into FB.
	MOVE T,TBLSFS(A)	; Get specification name this entry
A.IN25:	CAMN T,FB(B)		; Compare with that just specified
	 AOBJN B,[AOJA A,.-2]	; Check all names this entry
IFE TNXSW, JUMPL B,A.IN2
IFN TNXSW,[JUMPL B,[	MOVEI C,(B)
			CAIN C,$FJFN	; One item of entry didn7t match, was it JFN?
			 JRST A.IN25	; Yes, ignore it and continue.
			JRST A.IN2]	; Sigh, was something else, entry doesn't match.
	]

		; File is in table
	MOVSI A,(F)		; Move description from TBLOFS to FB.
	HRRI A,FB
	BLT A,FB+L$FBLK-1
IFN TNXSW, SETZM FB+$FJFN	; Since re-opening, must zap previous JFN.
	PUSHJ P,A.ITRY		; Try opening file

	; If return, open failed.
	MOVSI A,TBLSFS-TBLOFS(F)	; Set up LH(BLT pointer),
	HRRI A,FB
	BLT A,FB+L$FBLK-1	; Unmap to original names(TBLSFS to FB)
	PUSHJ P,TYPFB		; Type out specified names
	TYPE " -> "		; Type out pointer
	MOVSI A,(F)		; Copy translation (TBLOFS entry) back to FB.
	HRRI A,FB
	BLT A,FB+L$FBLK-1
	SETOM $F6DEV(F)		; "half-kill" entry in TBLOFS

A.INT1:	PUSH P,F
	MOVEI F,FB
	PUSHJ P,IOPNER	; Open lost, type out cruft
	POP P,F
	TYPE "Use what filename instead? "
A.INT2:	PUSHJ P,GTYIP	; Prepare to read one line from tty
	JRST A.IN1	; Try again with what he types in

		; File not in table, try to add a translation for it.

A.IN3:	TLNN F,-1	; More room for another entry in table?
	 ETF [ASCIZ /Too many @: files/]
	MOVEI A,TBLSFS-TBLOFS(F)	; Copy FB into TBLSFS (specified name)
	HRLI A,FB
	BLT A,TBLSFS-TBLOFS+L$FBLK-1(F)
	SETOM $F6DEV(F)		; Document fact that entry has only key, not translation
	MOVNI A,-L$FBLK
	ADDM A,INDDP		; Update pointer into table
	MOVE A,FB+$FDEV		; Get specified device name
	CAME A,FSATSN		; Atsign?
	 JRST A.INT1		; No, type out garbage and try again, reading from tty
	MOVE A,ISFB+$FDEV	; Yes, clobber from input device name
	MOVEM A,FB+$FDEV
	JRST A.INT2

;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL

A.ITRY:	MOVE A,FB+$FDEV		; Get specified device name
	CAMN A,FSTTY		; TTY?
	 JRST A.ITRT		; Yes, treat special
	TLO FF,FLUNRD
	PUSHJ P,IPUSH		; Save current status
	PUSH P,F		; save what F points at
	MOVEI F,FB
	PUSHJ P,OPNRD1
	 JRST [POP P,F ? JRST IPOPL]	; Lose, pop and return
	POP P,F
	MOVE B,[FB,,INFB]	; Kludge for time being - if win,
	BLT B,INFB+L$FBLK-1	; Copy all stuff into INFB.
IFN ITSSW,CALL SETWH2
	MOVE B,ITTYP
	MOVEI A,-2-TYPDEL(B)	;
	HRLI A,IFNM1
	BLT A,-TYPDEL(B)	; Introduce hysteresis so .INSRT'ing file can reference .IFNM1, .IFNM2
IFN CREFSW,[
	SKIPE CRFONP	; If creffing, output push-file block.
	 PUSHJ P,CRFPSH	; (pop-file block output at ipop)
]
A.ITR2:
	MOVE A,$F6DEV(F)	; Push successful, now check to see if table entry should be finished
	AOJN A,ASSEM1
	MOVEI A,(F)	; Move FB into TBLOFS as translation entry.
	HRLI A,FB
	BLT A,L$FBLK-1(F)
	JRST ASSEM1	; Now assemble from file (ASSEM1 clobbers pdl)

		; .INSRT TTY:

A.ITRT:	PUSHJ P,GTYIPA	; Read from tty, don't quit until .INEOF
	JRST A.ITR2	; Fall back in (doesn't touch .IFNM1, .IFNM2)
] ; end IFN 0

SUBTTL .INSRT Processing

;	.INSRT <filedescription><CR>	; Insert file here
; TTY: => ok, reads line at a time, rubout allowed within line
; Pushes macro expansion, other .INSRT's
; If device is "@:", always ask for translation.

A.INSR:	NOVAL

	; First set up defaults for parsing filename.
	BLTM L$FBLK,ISFB,FB 	; Default names are those of spec'd input file,
	MOVEI F,FB		; stuffed into scratch FB.
	MOVE A,FSDSK
	MOVE B,FSTTY		; Compare "TTY" with
	CAMN B,$FDEV(F)		; device name, and if identical,
	 MOVEM A,$FDEV(F)	; default to DSK.
IFE ITSSW,MOVE A,FSMID		; Always set default extension to "MID" or ">"
IFN ITSSW,MOVE A,FSGRTN
	MOVEM A,$FEXT(F)

	TLO FF,FLUNRD
	PUSHJ P,RFD		; Read file description from current input.
	MOVE A,$FDEV(F)		; Get specified device name
	CAMN A,FSATSN		; Atsign?
	 JRST A.IN50		; If so, check out translation right away.

A.IN2:	CAMN A,FSTTY		; TTY?  Must handle specially.
	 JRST [	PUSHJ P,GTYIPA	; Set up to read until .INEOF or EOF char.
		JRST ASSEM1]	; And don't do anything to .IFNM1/2, etc.
	PUSHJ P,IPUSH		; File, push the world.
	PUSHJ P,OPNRD1		; Try opening file.
	 JRST [	PUSHJ P,IPOPL	; Sigh, failed, pop world back and go
		JRST A.IN50]	; try translation entries or TTY input.
				; Always jumps back to A.IN2.

	; Come here when input file successfully opened.  Clean up etc.
	BLTM L$FBLK,(F),INFB	; Move current filespec to INFB,
IFN ITSSW,CALL SETWH2
	MOVE B,ITTYP
	BLTM 3,IFNM1,-2-TYPDEL(B)	; Copy new .IFNM1, .IFNM2 onto stack,
				; to clobber .IFNM1/2 for previous file, so
			; that .IFNM1/2 etc refers to last file .INSRT'd by
		; current file (or current file if none .INSRT'd yet)
IFN CREFSW,[
	SKIPE CRFONP	; If creffing, output a push-file block.
	 PUSHJ P,CRFPSH	; (pop-file block is output at IPOP)
	]

	JRST ASSEM1		; and jump off to smash things to toplevel.

	; Come here when open attempt fails or @: device specified.
A.IN50:	CAIE F,FB		; Tried translations yet?
	 JRST A.IN60		; Yes, skip table hacking and go get fnm from TTY.
	
	; First open attempt, so OK to search translation table.
	SKIPA D,[MAXIND,,TBLOFS]	; Load up aobjn-style index to transl table
A.IN52:	 SUBI D,-L$FBLK	; Loop point for searching table - increment to next entry, count down LH
	CAMN D,INDDP	; Compare with pointer to top of table
	 JRST A.IN60	; Agree => this file not in table, get from TTY.

	MOVEI A,(D)		; Get scratch index into tables,
	HRLI A,-L$FBLK		; making AOBJN of it,
	MOVEI B,(F)		; and get index into current FB.
A.IN54:	MOVE C,TBLSFS-TBLOFS(A)	; Get a specification name for this entry
IFN TNXSW,CAIE B,$FJFN(F)	; (ignoring the JFN item, for TENEX)
	CAMN C,(B)		; Compare name with that of failed filblk.
	 AOBJN A,[AOJA B,A.IN54]	; Check all names this entry
	JUMPL A,A.IN52		; If not found, try next entry.

	; File is in table, try opening it using TBLOFS description.
	MOVE F,D		; Replace old F by ptr to winning TBLOFS entry.
IFN TNXSW, SETZM $FJFN(F)	; Since re-opening, must zap any previous JFN.
	JRST A.IN2		; Jump off to try opening.

	; Come here when open failed and no matching transl entry.
	; Must set up to gobble down a translation from TTY...
A.IN60:	TYPE "Error in .INSRT; "
	CAIE F,FB		; Were we trying to open a translated entry?
	 JRST [	PUSHJ P,TYPFB	; Yes, so print out appropriate info
		TYPE " -> "	; to show translated stuff.
		JRST A.IN70]

	; First time, no translation entry exists, make one.
	MOVE A,INDDP		; Get current pointer to top of tables
	TLNN A,-1		; Room for more?
	 JRST A.IN70		; Nope, can't remember transl, but get right fnm anyway.
	MOVE F,A		; Yep, use it as pointer to table entry to use.
	SUBI A,-L$FBLK		; and get new table-top pointer with clever
	MOVEM A,INDDP		; SOS of LH and ADDI to RH.
	BLTM L$FBLK,FB,(F)	; Move FB contents to both TBLOFS,
	BLTM L$FBLK,FB,TBLSFS-TBLOFS(F)	; and TBLSFS.

A.IN70:		; Print out filename F points to, & err msg.
IFN TNXSW,[
	PUSHJ P,OPNER1
	PUSHJ P,RDJFNI	; On 10X, get new filename this way.
	]
IFN ITSSW\DECSW,[		; Elsewhere do it painful way.
	PUSHJ P,IOPNER
	TYPE "Use what filename instead? "
	PUSHJ P,GTYIP		; Setup to read 1 line from TTY,
	PUSHJ P,RFD		; and do it, parsing filename.
]
	JRST A.IN2		; now go try opening it.

SUBTTL Misc. .INSRT-related things

		; .INEOF - EOF pseudo

A.IEF2:	PUSHJ P,PMACP	; Loop point, pop entry off macro pdl
A.INEO:	TLNE FF,FLMAC	; Inputting from macro?
	 JRST A.IEF2	; Yes, pop it off
	PUSH P,CMACCR	; Back to inputting from file or tty, cause return to maccr
	MOVE B,ITTYP	; Get pdl pointer
	POPJ B,		; Return to pop routine


	; Call from ERRH; type input file's names if changed since last err msg.
ERRTFL:	MOVE C,INFCUR
	EXCH C,INFERR	; Say last error msg in this file.
	CAMN C,INFERR	; If prev. msg was in other file,
	 POPJ P,
	PUSH P,F
	MOVEI F,INFB	; Point to current input file,
	PUSHJ P,TYPFB	; and type out its filename.
	POP P,F
	PJRST CRRERR

SUBTTL COMMON IO PDL routines for input. (.INSRT support)

;IO PDL ROUTINES FOR INPUT FILE
; Push the input file

IPUSH:	AOSN CMEOF	; Want to pop out of tty? (^C  typed in)
	 CALL POPTT	; Yes, do now before forget.

IFE PMAPSW,[
	MOVE D,UREDP	; Get input byte pointer
IFN ITSSW\TNXSW,[
IFN ITSSW, .IOPUS UTYIC,
IFN TNXSW, MOVEI A,UTYIC ? PUSHJ P,$IOPUSH
	TLNN D,760000		; At end of word?
	 ADD D,[430000,,1]	; Yes, make it point to beginning of next word
	MOVEM D,UREDP
	MOVNI A,-2(D)
	ADD A,UTIBED	; Get # wds we'll need in MACTAB.
	HLR D,UTIBED	; Remember whether EOF on last .IOT.
	HRRZS UTIBED	; Now clear out left half for following
]
IFN DECSW,[
	AOS A,UTICHN	; Do ".IOPUSH" - use next channel.
	LSH A,27
	ADD A,[WAIT-<0 1,>]	; Construct a WAIT uuo for the current input channel.
	MOVE C,RCHMOD		; We mustn't copy the buffers while I/O is going on.
	CAMN A,[WAIT UTYIC,]	; But:  if we are currently in the top-level input file
	 CAIE C,3		; And it is device TTY:, this channel was never opened.
	  XCT A			; Don't move buffers while io going on!
	MOVEI A,UTIBFL+2	; Assume must save all buffer space.
]
	PUSH P,A
	ADD A,FREPTB
	ANDI A,-1
	PUSH P,A
	CAML A,MACTND	; No room in MACTAB => gc it.
	 CALL GCA1
	REST A
	CAML A,MACTND	; Did the GC win?
	 PUSHJ P,GCCORQ	; NO!!  Try to win somehow
	MOVEI A,370
	CALL PUTREL	; Indicate start of saved buffer.
	REST A
	AOS B,FREPTB
	SUBI A,1
	MOVE C,ITTYP	; Get addr of tty pdl wd that'll point to saved buffer.
	ADDI C,1
	HRRZM C,(B)	; Store in rh of 1st wd,
	MOVEI C,(B)	; Remember addr of saved buffer to push on ttypdl.
	HRLM A,(B)	; Put length in lh.
	AOS B
IFN ITSSW\TNXSW,HRL B,UREDP	; LH <- addr of 1st wd to save.
IFN DECSW,HRLI B,UTIBUF
	ADDI A,-2(B)	; Addr of last wd to blt into.
	BLT B,(A)
	HRLI A,041000
	MOVEM A,FREPTB	; Make free bp -> last byte just used.
	SUB A,MACTAD
	ANDI A,-1
	LSH A,2
	ADDI A,4	; Get char addr of next free byte.
	MOVEM A,FREEPT
]
IFN PMAPSW, CALL IOBPUS

	MOVE B,ITTYP	; Get local version of iopdl
IPSHP:
IFE PMAPSW, PUSH B,C		; Push -> saved buffer (GC will relocate)
IFN DECSW,PUSH B,UTIBED ? PUSH B,UTIHDR
REPEAT L$FBLK, PUSH B,INFB+.RPCNT	; Save names of input file.
	PUSH B,INFCUR		; Save number of input file.
IFE PMAPSW, PUSH B,D	; Lh=lh(old uredp), rh=lh(old utibed) (or just UREDP)
IFN PMAPSW, INSIRP PUSH B,[INFPAG INPGCT INLPGS UTIBPE UTIBPL UTIBPX INLCHR UREDP IUREDP ]

		; Following three must be last pushed
	INSIRP PUSH B,[IFNM1 IFNM2 IFVRS]	; Clobbered on pdl if .open successful
INPDEL==.-IPSHP		; Length of each entry on pdl

	MOVE A,FREEPT	; W must use same gc convention as putrel;
	CAML A,MACHI	; Namely, gc after using up the last byte.
	 CALL GCA1
	MOVEI A,0	; => input from file
	MOVEM B,ITTYP	; Store back updated pointer
	JSP B,PUSHTT	; Save stuff, address modify and return


	; Pop into the input file
IPOP:
IFN CREFSW,[ MOVEI A,2	; If creffing, output pop-file block.
	SKIPE CRFONP
	 PUSHJ P,CRFOUT]
IPOPL:	PUSHJ P,POPTT	; Come here if .INSRT's open failed.
	PUSH P,C
	MOVE B,ITTYP	; Get pointer
	INSIRP POP B,[IFVRS IFNM2 IFNM1]	; Pop stuff
IFE PMAPSW, POP B,A		; Pop off UREDP (or halves thereof)
IFN PMAPSW, INSIRP POP B,[ IUREDP UREDP INLCHR UTIBPX UTIBPL UTIBPE INLPGS INPGCT INFPAG]
	POP B,INFCUR
REPEAT L$FBLK,POP B,INFB+L$FBLK-1-.RPCNT
IFN DECSW,[
	POP B,C
	PUSH P,C		; Old UTIHDR
	POP B,UTIBED
]
IFE PMAPSW, POP B,C
	MOVEM B,ITTYP	; Save updated pdl pointer.
IFE PMAPSW,[
	HLRZ B,(C)	; Get length of saved buffer,
IFN ITSSW\TNXSW,[
	PUSH P,A
IFN ITSSW, CALL SETWH2 ? .IOPOP UTYIC,
IFN TNXSW, MOVEI A,UTYIC ? CALL $IOPOP
	REST A
	MOVEI AA,UTIBUF-1(B)	; Get addr of 1st wd won't blt into in utibuf,
	HRLI AA,(A)		; Get saved lh of utibed,
	MOVEM AA,UTIBED
	HRRI A,UTIBUF		; Make A -> 1st wd in buffer,
]
IFN DECSW,[
	MOVE AA,UTICHN
	LSH AA,27
	IOR AA,[RELEAS]
	XCT AA		; This code equivalent to .IOPOP.
	SOS UTICHN
	REST UTIHDR
]
	MOVEM A,UREDP
	MOVSI A,EOFCH_13
	MOVEM A,@UTIBED	; Put EOF char after buffer.
	MOVSI A,1(C)	; Get addr of 1st data wd of saved buffer,
	HRRI A,UTIBUF
	CAIE B,1
	 BLT A,UTIBUF-2(B)
	HLLZS (C)	; Tell GC to reclaim saved buffer.
] ;IFE PMAPSW

IFN PMAPSW, CALL IOBPOP

POPCJ:	REST C
	RET

;SAVE INTERNAL POINTERS CONCERNING INPUT MODE

TYPDEL==2		; Number of words in relevant pdl entry

PUSHTT:	PUSH P,A
	PUSH P,F
	AOSN CMEOF	; If supposed to pop out of tty soon,
	 CALL POPTT	; Do it now before cmeof clobbered.
	MOVE F,ITTYP	; Get relevant pdl pointer
	MOVEI A,0
	EXCH A,CLNN	; Set up new line number
	HRL A,CPGN	; Save current page number
	SETZM CPGN	; Now re-initialize
	SKIPGE CRFILE	; Save cref-all-on-one-line flag.
	TLO A,400000
	PUSH F,A	; Save cpgn,,clnn
	MOVE A,-1(P)	; Retrieve new mode
	PUSHJ P,PSHLMB	; Save limbo1 and set up instructions for new mode
IFN ITSSW,[
	CALL SETWH2
	.SUSET [.SWHO3,,A]
]
	MOVEM F,ITTYP	; Store back updated pointer
	JRST POPFAJ

		; Restore internal pointers concerning input mode

POPTT:	PUSH P,A
	PUSH P,F
	MOVE F,ITTYP	; Get pdl pointer
	PUSHJ P,POPLMB	; Pop into limbo1, set up new mode
	POP F,A		; Get cpgn,,clnn
	SETZM CRFILE	; Restore all-on-one-line flag.
	TLZE A,400000
	 SETOM CRFILE
	HLRZM A,CPGN
	HRRZM A,CLNN
IFN ITSSW,[
	CALL SETWH2
	ADD A,CPGN
	.SUSET [.SWHO3,,A]
]
	MOVEM F,ITTYP	; Store back updated pointer
	JRST POPFAJ

IFN ITSSW,[
SETWH2:	MOVE A,RCHMOD
	CAIL A,2
	 SKIPA A,[SIXBIT /TTY:/]
	  MOVE A,INFB+$F6FN1
	.SUSET [.SWHO2,,A]
	MOVE A,A.PASS
	LSH A,30
	ADD A,[SIXBIT /P0/+1]
	RET
]

SUBTTL Storage for IO PDL stuff

	 ; IO PDL storage stuff

VBLK
TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS
		; "tty pdl", stores information about current input mode
		; (similar to macro pdl but not garbage collected)

ITTYP:	-TYPDLS-1,,TTYPDL	; Pdl pointer (typdel=length of each entry)
TTYPDL:	NEDCHK		; Actual pdl: initial entry to overpop routine
	BLOCK TYPDLS	; Pdl proper
PBLK

SUBTTL TNX - IO PDL Routines (IOPDLC, $IOPUSH, $IOPOP)

IFN TNXSW,[

IFN PMAPSW,[
	; Push IO buffer & channel...
IOBPUS:	PUSH P,A
	MOVEI A,UTYIC
	CALL $IOPUSH
	MOVEI A,NIBFPS	; Point at next set of buffer pages.
	ADDM A,INBFPG
	POP P,A
	POPJ P,

	; Pop IO buffer & channel...
IOBPOP:	PUSH P,A
	MOVE A,INBFPG
	HRLI A,NIBFPS
	CALL DELPGS	; flush buffer pages.
	MOVNI A,NIBFPS
	ADDM A,INBFPG	; point down at previous set of buffer pages...
	MOVEI A,UTYIC
	CALL $IOPOP
	POP P,A
	POPJ P,

; DELPGS - Take arg in A as <# pgs>,,<page #> and flush these pages.

DELPGS:	PUSH P,A
	PUSH P,B
	HLRZ B,A
	HRLI A,.FHSLF	; <fork>,,<page #>
	TLO B,(PM%CNT)
	PUSH P,T
DELPG2:	SYSCAL PMAP,[[-1] ? A ? B][A ? A ? B]	; Free up buffer pages.
	TLNN FF,FL20X	; If on 20X, that's all.
	 JRST [	HRRI B,-1(B)	; Else, on 10X, must iterate manually.
		TRNE B,400000	; See if became "negative".
		 JRST .+1	; Yep, done with manual iteration.
		AOJA A,DELPG2]	; Nope, bump page #'s.
	POP P,T
	POP P,B
	POP P,A
	POPJ P,
] ;IFN PMAPSW

; IOPDLC - Clear IOPDL stack, close all channels on it.
;	Clobbers no ACs

; for 10x, need to CLOSF and release each JFN on IOPDL stack.

IOPDLC:	PUSH P,R1
IFE R1-A,.ERR IOPDLC WONT WORK WITH A=1
IFN PMAPSW,[
	MOVEI R1,1STBFP	; Reset to point at 1st page of buffer space.
	MOVEM R1,INBFPG
]
	EXCH A,IOPDLP
	JRST IOPDC3
IOPDC2:	MOVE R1,(A)
	CAME R1,ISFB+$FJFN	; Dont close main input file
	 CLOSF
	 JFCL
	SUB A,[1,,1]
IOPDC3:	CAMLE A,[-LIOPDL,,$IOPDL-1]
	 JRST IOPDC2
	EXCH A,IOPDLP
	POP P,R1
	POPJ P,

; $IOPUSH - Push I/O channel in A onto $IOPDL stack.
;	Clobbers no ACs
; for 10X this means storing JFN on stack and clearing JFNCHS table entry.

$IOPUSH:EXCH B,IOPDLP	; Get stack pointer
	PUSH B,JFNCHS(A)	; save JFN for channel
	EXCH B,IOPDLP
	SETZM JFNCHS(A)	; Zap entry in channel table to make it look gone
	POPJ P,

; $IOPOP - Pops channel off $IOPDL into channel # in A.
;	Clobbers no ACs

; for 10X just pop $IOPDL into JFNCHS, must close and release old JFN tho.

$IOPOP:	PUSH P,T
	SYSCAL CLOSF,[JFNCHS(A)]
	 JFCL
	POP P,T
	EXCH B,IOPDLP	; Get stack ptr
	POP B,JFNCHS(A)
	EXCH B,IOPDLP
	POPJ P,

VBLK
JFNCHS:	BLOCK 20	; Channel table index, JFNCHS(ch) gets JFN for chan.
			; (zero if none)
LIOPDL==8.	; Length of IO PDL
IOPDLP:	-LIOPDL,,$IOPDL-1
$IOPDL:	BLOCK LIOPDL
PBLK
] ; IFN TNXSW

SUBTTL DEC - IO PDL Routines (IOPDLC)

IFN DECSW,[

; IOPDLC - Simulate ITS .IOPDL call.  Flushes all channels from
;	UTICHN downwards to UTYIC.  Actually not a simulation but something
;	that works in the particular situation for which MIDAS uses .IOPDL.

IOPDLC:	MOVEI A,UTYIC
	EXCH A,UTICHN	; Set input chnl num. to lowest.
	LSH A,27
	IOR A,[RELEAS]	; Set up to releas the highest in use first.
IOPDL1:	XCT A		; Releas one input channel,
	CAMN A,[RELEAS UTYIC,]
	 RET		; All done.
	SUB A,[0 1,]
	JRST IOPDL1	; Releas the next one down.
] ;IFN DECSW

SUBTTL COMMON TTY input routines & variables

VBLK
CMBUF:	BLOCK CMBFL	; Typein buffer (also used as JCL buffer)
CMPTR:	0	; Byte pointer to CMBUF.
CMEOF:	0	; -1 => POPTT instead of reloading after this bufferfull.
TTYOPF:	0	; -1 => the TTY is already open.
LINEL:	0	; Width of TTY (may be 1,, meaning assume infinite).
A.TTYFLG:	; Value of .TTYFLG pseudo - another label for TTYFLG.
TTYFLG:	0	; TTY typeout permitted iff >= 0.
WSWCNT:	0	; The number of W-switches in the last cmd string.
TTYBRF:	0	; -1 => ^H break has been requested but not yet done.
PBLK
	; Cause input from tty (main routines)

GTYIPA:	SETZM A.TTYF		; Push to tty, don't stop at cr.

IFN ITSSW,   TYPECR "TTY: .INSRTed, end input with ^C"
IFN DECSW\TNXSW,[
  IFE SAILSW,TYPECR "TTY: .INSRTed, end input with ^Z"
  IFN SAILSW,TYPECR "TTY: .INSRTed, end input with CTL-META-LF"
  ]

GTYIP1:	SKIPA A,[3]
GTYIP:	 MOVEI A,2	; Input from tty, stop after 1 line.
	SETZM CMPTR	; Force reload on 1st read.
	JSP B,PUSHTT	; Set up variables and return
GTYIPR:	SETZM CMPTR	; Return on .ineof or cr
	JRST POPTT

	; Call here from ASSEM1 loop when a ^H interrupt is detected.
TTYBRK:	SETZM A.TTYF
	ETR [ASCIZ/^H - break /]	; Type filename, page and line #.
	SKIPE ASMOUT
	 TYPECR "within a <>, () or []"
	JRST GTYIPA

	; RCHSET routines for reading from TTY
	; RCHMOD=3 => don't quit on CR
	;	 2 => quit on CR.
RCHTRC:
RCHARC:	TLO FF,FLTTY	; Set flag
	JSP A,CPOPJ
RCHAC1:	REPEAT 2,[	; RCH2, RR1
	ILDB A,CMPTR	; Get char
	CAIN A,0	; End of string marked with 0
	 PUSHJ P,TYRLDR	; Reload, jump back for next char
]
	GOHALT		; RRL1
IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES.
	ILDB A,CMPTR	; SEMIC
	CAIN A,15
	 JRST SEMICR
	JUMPN A,SEMIC
	PUSHJ P,TYRLD
	JRST SEMIC

TYRLD:	MOVEI A,3	; Return after the call, not before.
	ADDM A,(P)

	; TYRLDR - Read in string.
	;	 Reload buffer if ran out in call to RCH.

TYRLDR:	AOSN CMEOF	; EOF detected after last reload =>
	 JRST RPAEOF	; Pop out of tty.
	PUSH P,A
	PUSH P,B
	MOVE B,RCHMOD
	PUSH P,F
	PUSH P,A.TTYF	; If chars rubbed out they should be printed.
	SETZM A.TTYF
IFN TNXSW,SYSCAL DTI,[[.TICCV]]	; Disable ^V as an interrupt character
	MOVE F,[10700,,CMBUF-1]	; Initial byte pointer to buffer
	MOVEM F,CMPTR	; Store as byte pointer for read
TYRLD2:	PUSHJ P,TYI	; Get character
IFN TNXSW,[
	CAMN F,CMPTR	; at beg of line?
	 CAIE A,^J	; and char is LF?
	  CAIA
	   JRST TYRLD2	; If so then ignore it completely.
]
	CAIN A,177	; Rubout?
	 JRST TYRLD3	; Yes
	CAIE A,^C
	 CAIN A,^Z
	  JRST TYRLD7	; ^C, ^Z => EOF.  Ought to be EOFCH for consistency?
	CAIN A,^U
	 JRST TYRLD5	; Rub out all
	CAIE B,2	; For .TTYMAC handling, convert lower case to upper.
	 JRST TYRLD6
	CAIL A,"A+40
	 CAILE A,"Z+40
	  CAIA
	   SUBI A,40
TYRLD6:	CAME F,[010700,,CMBUF+CMBFL-2]
	 IDPB A,F	; Store character in buffer unless buffer nearly full.
	CAIE A,^M	; CR?
	 JRST TYRLD2	; No, go back for next
	CAIN B,2	; .TTYMAC (mode 2) => CR ends input, so fake EOF.
	 SETOM CMEOF
	MOVEI A,^J	; Follow the CR with a LF.
	IDPB A,F
	PUSH P,F		; Output the entire line to the error file
	MOVE F,[10700,,CMBUF-1]
TYRLD8:	CAMN F,(P)
	 JRST TYRLD9
	ILDB A,F
	CAIN A,^M	; If line was ended by a ^C or ^Z, put that in error
	 SKIPL CMEOF	; file, which needs hair since that char is not
	  JRST TYRLD0	; In the string we stored.
	MOVEI A,"^
	CALL ERRCHR
IFN ITSSW,MOVEI A,"C
IFN DECSW\TNXSW,MOVEI A,"Z
	CALL ERRCHR
	LDB A,F
TYRLD0:	CALL ERRCHR
	JRST TYRLD8

TYRLD9:	REST F
	MOVEI A,0
	IDPB A,F	; Mark end of string
	IDPB A,F
IFN TNXSW,SYSCAL ATI,[[.TICCV,,.IC.CV]]	; Turn back on ^V
	REST A.TTYF
	REST F
	REST B
	REST A
	JRST RCHTRA

TYRLD7:	SETOM CMEOF	; ^C, ^Z force EOF,
	CALL TYRLCR	; After turning into ^M.
	MOVEI A,^M
	JRST TYRLD6

TYRLCR:	MOVEI A,^M
	CALL TYOX
	MOVEI A,^J
	JRST TYOX

TYRLD3:	CAMN F,[10700,,CMBUF-1]	; Rubout, beginning of buffer?
	 JRST TYRLD4		; Yes
	LDB A,F			; Get last character in buffer
	CALL TYOX		; Type it out, don't write in error file.
	ADD F,[70000,,]		; Decrement pointer
	JUMPGE F,TYRLD2		; Jump if valid
	SUB F,[430000,,1]	; Was 440700,,something, back it up
	JRST TYRLD2

TYRLD5:	MOVE F,[10700,,CMBUF-1]	; ^U, back to beginning of line
TYRLD4:	PUSHJ P,TYRLCR	; Rubout when at beginning of buffer, type CR
	JRST TYRLD2

SUBTTL ITS - TTY routines (TYOX, TYI, TTYINI) and JCLINI.

IFN ITSSW,[

	; TYOX - Type out char in A
TYOX:	SKIPN TTYOPF
	 CALL TTYINI
	.IOT TYOC,A
	POPJ P,

	; TYI - Get (just typed in) char in A
TYI:	SKIPN TTYOPF
	 CALL TTYINI	; Open the tty if not already done.
	.IOT TYIC,A
	ANDI A,-1	; Non-tty devices can return -1,,3.
	JUMPE A,TYI
	CAIN A,^L	; This must be assuming that ^L clears screen?
	 JRST TYI
	POPJ P,

		; Initialize tty
TTYINI:	PUSH P,A
	.OPEN TYIC,[.UAI,,'TTY]	; Input
	 .LOSE
	.OPEN TYOC,[%TJDIS+.UAO,,'TTY]	; Display mode output
	 .LOSE
	SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A]
	 MOVSI A,1	; TTY: is translated to something else => assume infinite linel
	MOVEM A,LINEL	; Else linel gets width of tty.
	SETOM TTYOPF	; Say the tty is now open.
	JRST POPAJ

JCLINI:	SETZM CMPTR
	.SUSET [.ROPTIO,,A]
	TLNN A,%OPCMD		; Has our superior said it has a cmd?
	 RET			; No.
	BLTZ CMBFL-1,CMBUF	; Zero all but last word,
	SETOM CMBUF+CMBFL-1	; and ensure last word non-zero.
	.BREAK 12,[5,,CMBUF]	; Try to read command string.
	MOVE A,[010700,,CMBUF-1]	; (Must be positive; see CMD)
	SKIPE CMBUF		; If read a cmd-string,
	 MOVEM A,CMPTR		; Tell TYRLD, GO2A it's there.
	POPJ P,

]; END IFN ITSSW

SUBTTL TNX - TTY routines (TYOX, TYI, TTYINI) and JCLINI

IFN TNXSW,[

	; TYOX - Type out char in A
TYOX:	SKIPN TTYOPF
	 CALL TTYINI
IFN A-1,EXCH A,R1
	PBOUT
IFN A-1,EXCH A,R1
	POPJ P,

	; TYI - Get (just typed in) char in A
	;	There is a screw for 20X in that it's not really possible
	;	to know if the system is going to feed you a CR-LF
	;	or just a CR; TYRLD2 checks for that, by flushing LF's, but
	;	this would be the place to check if it were easy to do.
TYI:	SKIPN TTYOPF
	 CALL TTYINI	; Open the tty if not already done.
IFN A-1,EXCH R1,A
	PBIN		; Get char into AC 1
	JUMPE R1,.-1	; Ignore nulls.
	TLNE FF,FL20X	; Cretinous differences between 10X/20X
	 JRST TYI2	; 20X, skip EOL check.
	CAIN R1,^_	; On 10X, CR turned into ^_ (EOL); change it back.
	 MOVEI R1,^M
TYI2:
IFN A-1,EXCH R1,A	; Restore everything to right place if necessary.
	POPJ P,

	; TTYINI - Initialize tty

TTYINI:	PUSH P,A
	PUSH P,T
	SYSCAL RFMOD,[[.PRIIN]][A ? A]
	POP P,T
	HLRZS A
	ANDI A,177	; Terminal width
	CAIGE A,30.	; If too low,
	 ADDI A,128.	; Assume twenex crockishness
	MOVEM A,LINEL	; Linel gets width of tty.
	SETOM TTYOPF	; Say the tty is now open.
	POP P,A
	POPJ P,

	; Read "JCL" - RSCAN buffer or nnnMID.TMP file (from CCL)

JCLINI:	SETZM CMPTR
	SKIPE CCLFLG	; Started at CCL location?
	 JRST JCLIN5	; Yep, go snarf stuff specially.
	TLNN FF,FL20X	; Is this Tenex?
	 JRST [	MOVEI R1,.PRIIN
		BKJFN	; see what previous character was
		 POPJ P,; *Gasp*
		PBIN
		CAIE R1,^_ ; Tenex newline?
		 SETOM CMPTR ; No, set flag saying "TTY but no prompt"
		POPJ P,]; and skip the Twenex hackery below
	SETZ R1,	; If not, check RSCAN.
	RSCAN		; See if have anything in RSCAN buffer.
	 POPJ P,	; Huh?  Shouldn't happen, but ignore it.
	JUMPLE R1,APOPJ	; Also return if char cnt says nothing there.
	MOVNI R3,(R1)	; Aha, set up cnt for SIN
	HRROI R2,CMBUF
	MOVEI R1,.CTTRM	; Now ready for business...
	SIN
	LDB R1,R2	; Now examine wages thereof
	CAIE R1,^M	; Last char CR?
	 JRST [	MOVEI R1,^M
		IDPB R1,R2	; If not, make it so.
		JRST .+1]
	SETZ R1,
	IDPB R1,R2		; Must also ensure ASCIZ.

	MOVE B,[440700,,CMBUF]	; Flush any spaces in front
	ILDB A,B
	CAIN A,40
	 JRST .-2

	; If the rescan line starts with "RUN", skip that.
	MOVE C,B		; Save backup pos
IRPC X,,[RUN]
	CAIE A,"X+40		; Allow lowercase
	 CAIN A,"X
	  CAIA
	   JRST JCLIN2		; Jump as soon as no match
	ILDB A,B		; Matched, get next char.
TERMIN
	
JCLIN2:	CAIE A,40		; Is next char a space?
	 JRST [	MOVE B,C	; When non-space seen, back up to saved pos
		LDB A,B
		JRST JCLIN4]
	ILDB A,B		; Saw space so we won.  Get next char
	MOVE C,B		; Say backup should start here
	JRST JCLIN2		; and flush all spaces.

	ILDB A,B
JCLIN4:	CAILE A,40		; Now skip the filename used to invoke MIDAS.
	 JRST .-2		; Flush until random ctl seen (space, ^M)
	CAIE A,40		; If it wasn't a space,
	 POPJ P,		; then forget about the whole thing.
JCLIN3:	MOVE C,B		; Now flush spaces.  Save last ptr for chars.
	ILDB A,B
	CAIN A,40
	 JRST JCLIN3
	CAIN A,^M		; And is first non-space something besides CR?
	 POPJ P,		; Bah, there wasn't anything in the JCL!!
	MOVEM C,CMPTR		; Else save ptr to start of real goods.
	POPJ P,

	; TNX snarf of CCL file.  No such thing as tmpcor, so just
	; look for real file with appropriate name.
JCLIN5:	SETZM CCLFLG		; Want 0 in case abort out, will reset if win.
	MOVE R1,[.PRARD,,.FHSLF]
	MOVEI R2,CMBUF		; First look for stuff in PRARG% block
	MOVEI R3,CMBFL		; (like PA1050, see PAT.MAC for details)
	PRARG%
	JUMPLE R3,JCLIN7	; No argument block, try file
	SKIPE R1,CMBUF		; Get count of "files"
	 TLNE R1,-1		; LH must be zero, RH non-zero
	  JRST JCLIN7		; Not TMPCOR format, try file
	MOVNS R1		; Make AOBJN pointer
	HRLZS R1
JCLIN6:	HRRZ R2,CMBUF+1(R1)	; Get "file" pointer
	HLRZ R3,CMBUF(R2)	; Get tag for this "file"
	CAIE R3,'MID		; MIDAS?
	 AOBJN R1,JCLIN6	; No, next "file"
	JUMPGE R1,JCLIN7	; Try real file if lost
	ADD R2,[010700,,CMBUF]	; Point at commands in buffer
	MOVEM R2,CMPTR		; NB: must be positive (see CMD:)
	SETOM CCLFLG		; Remember that we saw CCL
	POPJ P,			; And get out of here

	; Here when no PRARG% stuff, try for real file.
JCLIN7:	GJINF			; Get job # in R3
	HRROI R1,CMBUF		; Use CMBUF to form filename string.
	MOVEI R2,(R3)
	MOVE R3,[NO%LFL+NO%ZRO+<3_18.>+10.]
	NOUT			; ship out job num in 3 digits, radix 10.
	 GOHALT
	HRROI R2,[ASCIZ /MID.TMP/]
	SETZ R3,
	SOUT			; Flesh out rest of filename string.
	SETZ R2,		; Make sure it's ASCIZ.
	BOUT
	MOVE R1,[GJ%OLD+GJ%SHT]	; Use short-form GTJFN
	HRROI R2,CMBUF		; and gobble name from CMBUF.
	GTJFN
	 POPJ P,		; If failed, forget it.
	MOVE R2,[070000,,OF%RD]	; Read 7-bit bytes
	OPENF
	 POPJ P,		; Bah
	HRROI R2,CMBUF		; Gobble stuff up.
	MOVEI R3,CMBFL*5	; Read until buffer full,
	MOVEI R4,^J		; or LF seen.
	SIN
	JUMPLE R3,APOPJ		; Forget it if too big for buffer!!
	MOVE R2,[010700,,CMBUF-1]	; Aha, we've got something, so set
	MOVEM R2,CMPTR		; pointer to slurped stuff.
	SETOM CCLFLG
	HRROI R2,UTIBUF		; Slurp rest into larger buffer,
	MOVNI R3,UTIBFL*5	; using count only.
	SIN
	JUMPGE R3,APOPJ		; Refuse to hack grossly large file.
	ADDI R3,UTIBFL*5
	JUMPLE R3,APOPJ		; if nothing read, need write nothing out.
	HRLI R1,(CO%NRJ)	; Don't release JFN,
	CLOSF			; but stop reading from file.
	 POPJ P,
	MOVE R2,[070000,,OF%WR]	; Now try to hack write access.
	OPENF
	 POPJ P,
	MOVE R2,R1		; Source becomes destination...
	HRROI R1,UTIBUF		; and UTIBUF becomes source,
	MOVNS R3		; for just as many bytes as were read.
	SOUT
	MOVEI R1,(R2)		; done, now just close file.
	CLOSF			; (this time, release JFN).
	 POPJ P,
	SETOM CCLMOR		; say that more CCL remains.
	POPJ P,
] ; END IFN TNXSW

SUBTTL DEC - TTY routines (TYOX, TYI, TTYINI)

IFN DECSW,[

	; TYOX - Type out char in A
TYOX:	SKIPN TTYOPF
	 CALL TTYINI
	OUTCHR A
	POPJ P,

	; TYI - Get a typed-in char in A

TYI:	SKIPN TTYOPF	; Open the tty, if not already done.
	 CALL TTYINI
	INCHWL A
IFN SAILSW,[
	CAIN A,612	; On SAIL, EOF is 612,
	 MOVEI A,^Z	; so turn into normal EOF if found.
]
	CAIE A,^M	; Throw away the LF after a CR.
	 RET
	INCHWL A
	MOVEI A,^M	; Note that TYRLDR will put it back in.
	RET

TTYINI:	INSIRP PUSH P,AA A B
IFE SAILSW,[
	PJOB A,
	TRMNO. A,
	 JRST TTYIN1
	MOVEI AA,1012		; .TOWID
	MOVE B,[2,,AA]
	TRMOP. B,		; Read width of tty line into B.
]
TTYIN1:	 MOVEI B,80.		; TRMOP. failed or not tried => assume width is 80.
	MOVEM B,LINEL
	INSIRP POP P,B A AA
	SETOM TTYOPF
	RET

	TMPLOC .JBREN, TTYREN
TTYREN:	SETOM TTYBRF	; "REENTER" command comes here
R: G:	JRST @.JBOPC	; To request a ^H-break.  Note crufty labels pointing here.

];IFN DECSW

SUBTTL DEC Hackery for JCLINI - Read CCL commands.

IFN DECSW\TNXSW,[
VBLK
CCLFLG:	0	; Flag to indicate CCL entry from COMPIL, SNAIL, CCL, or EXEC
CCLMOR: 0	; -1 => There are more lines of CCL commands,
		; so do a RUN SYS:MIDAS when finished.
PBLK
]

IFN DECSW,[	; DEC only hacks CCL as "JCL".

.SCALAR CCLFIL	; Saves FN1 for tmp file hacking.

; Read MID temp core file, if that loses, try nnnMID.TMP file.
;  Clobbers A,B,C,D.

JCLINI:	SETZM CMPTR
	SKIPN CCLFLG		; Was midas called from CCL level?
	 RET			; No, do not snarf tempcore
	SETZM CCLFIL		; No CCL file yet
	SETZM CCLFLG		; If tmpcor loses want this 0 (will re-setom below)
	BLTZ CMBFL,CMBUF	; Zero cmd buffer.
	MOVE A,[2,,['MID,, ? -<CMBFL-1>,,CMBUF-1]]	; read (leave last wd 0)
	TMPCOR A,		; Read compil-generated command
	 JRST [	OPEN [17 ? 'DSK,, ? 0] ; No tempcore, maybe try dump mode.
		 RET		; Argh but let something else die
		PJOB A,		; Get job #
		IDIVI A,100.	; Want decimal job number in sixbit
		ADDI A,'0
		LSH A,6
		IDIVI B,10.
		ADDI A,'0(B)
		LSH A,6
		ADDI A,'0(C)
		LSH A,18.
		HRRI A,'MID	; Form file name as nnnMID.TMP
		MOVEM A,CCLFIL	; Save for writing below
		MOVSI B,'TMP
		SETZB C,D	; No protect or ppn trash
		LOOKUP A	; Try to get file
		 RET		; Give up
		MOVE A,[-<CMBFL-1>,,CMBUF-1]
		SETZ B,
		INPUT A		; Try to read command
		SETZB A,B
		RENAME A	; Try to delete it now
		 JFCL		; Ignore failure
		CLOSE		; Happy sail
		JRST .+1]
	SKIPN CMBUF		; One last check for it to be there
	 RET			; Alas, there is none
	MOVE A,[010700,,CMBUF-1]	; Load a byte pointer to the command
	SETOM CCLFLG
	MOVEM A,CMPTR		; There is, set command pointer
JCLIN1:	ILDB B,A
	CAIE B,^J		; See if our command file has anything after 1st line.
	 JRST JCLIN1
	ILDB B,A
	JUMPE B,JCLIN3
	SETOM CCLMOR		; It does; set flag so after handling 1st line we'll
	MOVE C,[440700,,UTIBUF+2]
JCLIN2:	IDPB B,C
	ILDB B,A
	JUMPN B,JCLIN2
	SUBI C,UTIBUF+1		; Get # words written in utibuf. operand is relocatable!
	HRLOI C,-1(C)		; These 2 insns turn size into -size,,utibuf+1
	EQVI C,UTIBUF+1
	MOVEM C,UTIBUF+1
	SKIPE A,CCLFIL		; Was this called with a temp file?
	 JRST [	MOVSI B,'TMP
		SETZB C,D
		ENTER A		; Try to re-write file
		 RET		; Sigh
		MOVE A,UTIBUF+1
		SETZ B,
		OUTPUT A
		RELEASE
		RET]
	MOVSI C,'MID
	MOVEM C,UTIBUF
	MOVE C,[3,,UTIBUF]
	TMPCOR C,
	 JFCL		; [KLH - there used to be some random cruft here.]
JCLIN3:	RET

] ;END IFN DECSW

SUBTTL Old Command Line Reader (CMD)
ifn 0,[
	 ; Read command & filenames & hack defaulting.

CMD:	SKIPE CMPTR	; Unless have DDT or RSCAN cmd string,
	 JRST CMD06	; (we don't)
	CALL CRR	; type a CRLF, prompt etc.
CMD05:	SETZM CMPTR
	TYPE "*"
CMD06:	MOVEI A,3	; Read from TTY (or string <- cmptr)
	CALL RCHSET
	MOVEI F,FB	; Point to scratch filblk.
	BLTZ L$FBLK,FB	; and clear the whole thing.
	TRO FF,FRCMND	; Tell RFD it's scanning a command line.
	CALL RFD	; Now see if command null, and whether has _.
IFN DECSW\TNXSW,[
	CAIN A,"!	; If terminator was "!", go run program.
	 JRST RFDRUN
]
	TRNN FF,FRNNUL	; If no filespec was seen,
	 CAIE A,^M	; and terminator is EOL,
	  CAIA
	   JRST CMD05	; then prompt again and get another string.
	TRZ FF,FRARRO	; Got something, clear saw-"_" flag.
CMD07:	CAIN A,"_
	 TRO FF,FRARRO	; FRARRO will be on if there's a "_" in string.
	CAIN A,^M
	 JRST CMD1	; Read thru the whole command.
	CALL RFD
	JRST CMD07

	; Now re-read the string, for real this time.  Previous scan was
	; mainly just to see if "_" existed.  If not, then first filename
	; must be input file, and output filenames are all defaulted.
CMD1:	MOVE T,[440700,,CMBUF]	; Restore original ptr to 
	MOVEM T,CMPTR		; beginning of string.
IFN CREFSW,SETZM CREFP		; Clear all switches before decoding them.
INSIRP SETZM 0,ERRFP TTYINS WSWCNT
IFN LISTSW,[
	SETZM LISTP
	SETOM LISTP1	; Will be AOSed by each (L) switch.
]

	MOVE T,FSDSK
	MOVEM T,$FDEV(F)
IFE TNXSW,[MOVE T,RSYSNM ? MOVEM T,$FDIR(F)]
IFN TNXSW, SETZM $FDIR(F)
	SETZM $FNAME(F)
	SETZM $FEXT(F)

	TRZ FF,FRNNUL
	TRNE FF,FRARRO	; Don't gobble input spec as output!
	 CALL RFD		; Read bin file spec.
	MOVE TT,FF		; Remember whether null
	BLTMAC T,L$FBLK,(F),OUTFB	; Copy from scratch to OUTFB.

	MOVE T,$FDEV(F)
	CAMN T,FSNUL
	 MOVE T,FSDSK
	MOVEM T,$FDEV(F)
IFE ITSSW, MOVE T,FSCRF
IFN ITSSW, MOVE T,FSCREF
	MOVEM T,$FEXT(F)

	TRNN FF,FRARRO	; If "_" doesn't exist in cmd line,
	 MOVEI A,"_	; then only filespec is for input, kludge to get it.
	CAIN A,"_	; If "_" exists in cmd line, did we hit it?
	 JRST CMD2	; Ran out of output specs => just use defaults.
	CALL RFD	; Read cref file spec.
IFN CREFSW,[
	TRNN FF,FRNNUL	; If spec not null or ended by _,
	 CAIN A,"_
	  SETOM CREFP	; We must want to cref.
CMD2:	BLTMAC T,L$FBLK,(F),CRFFB	; Copy specs from FB to CREF FB.
]
IFE CREFSW,CMD2:
	MOVE T,FSERR
	MOVEM T,$FEXT(F)
	CAIN A,"_
	 JRST CMD6	; No more output specs.
	CALL RFD	; Read error file sppec.
IFN ERRSW,[
	TRNN FF,FRNNUL	; Nonnull spec or last spec =>
	 CAIN A,"_
	  SETOM ERRFP	; Must want an error file.
CMD6:	BLTMAC T,L$FBLK,(F),ERRFB	; Copy specs from FB to ERR filblk.
]
IFE ERRSW,CMD6:
IFN LISTSW,[
IFE ITSSW, MOVE T,FSLST
IFN ITSSW, MOVE T,FSLIST
	MOVEM T,$FEXT(F)
	CAIN A,"_	; Any output spec remaining?
	 JRST CMD3
	CALL RFD	; Yes, read one.
	SETOM LISTP	; List spec given implies want listing.
CMD3:	BLTMAC T,L$FBLK,(F),LSTFB	; Copy specs from FB to LST filblk.
]

CMD5:	CAIN A,"_
	 JRST CMD4
	CALL RFD	; Ignore any output specs not needed.
	JRST CMD5

CMD4:	MOVE T,FSDSK		; Default the input names.
	MOVE A,$FDEV(F)
	CAME A,FSPTP		; Don't leave dev name set to common out-only devs.
	 CAMN A,FSNUL
	  MOVEM T,$FDEV(F)
IFE ITSSW, MOVE T,FSMID
IFN ITSSW, MOVE T,FSGRTN	; > on ITS.
	MOVEM T,$FEXT(F)
	MOVE T,FSPROG
	SKIPN $FNAME(F)		; The fn1 alone is sticky across the _.
	 MOVEM T,$FNAME(F)

	TRZ FF,FRARRO		; If only 1 name it should be FNAM1.
	CALL RFD		; Read input spec.
	BLTMAC T,L$FBLK,(F),ISFB	; Copy into specified-input filblk.
	MOVE T,$FNAME(F)	; Default output FN1's to input.
	SKIPN OUTFB+$FNAME
	 MOVEM T,OUTFB+$FNAME
IFN CREFSW,[
	SKIPN CRFFB+$FNAME
	 MOVEM T,CRFFB+$FNAME
]
IFN LISTSW,[
	SKIPN LSTFB+$FNAME
	 MOVEM T,LSTFB+$FNAME
]
IFN ERRSW,[
	SKIPN ERRFB+$FNAME
	 MOVEM T,ERRFB+$FNAME
]
	MOVE A,FSNUL		; The output dev defaults to NUL:
	MOVE T,$FDEV(F)		; If the input is from TTY:
	CAMN T,FSTTY
	 TRNE FF,FRNNUL		; And the bin spec was null.
	  CAIA
	   MOVEM A,OUTFB+$FDEV
	TRZ FF,FRARRO		; Don't louse up .INSRT's reading.
	RET
] ;ifn 0

SUBTTL Command Line Reader (CMD)

	 ; CMD - Read command & filenames & hack defaulting.

.SCALAR CMDPSV	; Saves read ptr into CMBUF, for re-scanning.

CMD:	SKIPLE T,CMPTR	; If we have DDT or RSCAN or CCL string,
	 JRST CMD06	; go hack it without typing anything out.
	CAMN T,[-1]	; If Tenex-type "JCL", normal TTY input 'cept no prompt
	 JRST CMD06X
	CALL CRR	; Nope, must type a CRLF, prompt etc.
CMD05:	TYPE "*"
CMD06X:	SETZB T,CMPTR
CMD06:	MOVEM T,CMDPSV	; Save pointer for later restoration
	MOVEI A,3	; Read from TTY (or string <- cmptr)
	CALL RCHSET

	MOVEI F,ISFB	; Point to input-spec filblk.
	BLTZ L$FBLK,(F)	; Zap it through and through.
	TRO FF,FRCMND	; Tell RFD it's scanning a command line.
	CALL RFD	; Now see if command null, and whether has _.
IFN DECSW\TNXSW,[
	CAIN A,"!	; If terminator was "!", go run program.
	 JRST RFDRUN
]
	TRNN FF,FRNNUL	; If no filespec was seen,
	 CAIE A,^M	; and terminator is EOL,
	  CAIA
	   JRST CMD05	; then prompt again and get another string.
	TRZA FF,FRARRO	; Got something, clear saw-"_" flag.
CMD07:	 CALL RFD
	CAIN A,"_
	 JRST [	TRO FF,FRARRO	; FRARRO will be on if there's a "_" in string.
		CALL RFD	; Gobble next filename, input filespec.
		JRST CMD1]
	CAIE A,^M
	 JRST CMD07	; Read thru the whole command until read input filespec


	; Now re-read the string, for real this time.  Previous scan was
	; mainly to latch onto input filespec and see if "_" existed.

CMD1:	SKIPN T,CMDPSV		; Restore original ptr if there's one,
	 MOVE T,[440700,,CMBUF]		; else point at beg of buffer.
	MOVEM T,CMPTR
	SETZM TTYINS ? SETZM WSWCNT	; Clear all switches.
IFN CREFSW,SETZM CREFP
IFN ERRSW, SETZM ERRFP
IFN LISTSW,SETZM LISTP ? SETOM LISTP1	; Will be AOSed by each (L) switch.
	SETZ A,
	TRNN FF,FRARRO	; If "_" doesn't exist in cmd line,
	 MOVEI A,"_	; then only filespec is for input, kludge to get it.

	MOVEI F,OUTFB
	BLTZAC T,L$FBLK,(F)		; Clear output filblk.
	MOVE T,FSDSK		; Default dev to DSK.
	MOVEM T,$FDEV(F)
	SKIPN T,$FNAME+ISFB	; Now default FN1 from input filespec
	 MOVE T,FSPROG		; (use "PROG" if none)
	MOVEM T,$FNAME(F)
IFE TNXSW,[MOVE T,RSYSNM	; Now default directory if need to
	MOVEM T,$FDIR(F)]

	TRZ FF,FRNNUL
	CAIE A,"_		; If it exists,
	 CALL RFD		; Read bin file spec.
	TRNN FF,FRNNUL		; If spec was null,
	 JRST [	MOVE T,FSTTY	; and input spec was TTY:,
		CAME T,$FDEV+ISFB
		 JRST .+1
		MOVE T,FSNUL	; then set device to NUL:.
		MOVEM T,$FDEV(F)
		JRST .+1]

DEFINE CFMAC SWIT,PTR,INSTR,DEXT
IFN SWIT,[
	MOVE T,DEXT
	MOVE TT,[[INSTR],,PTR]
] .ELSE SETZB T,TT
	PUSHJ P,CMDFGT
TERMIN

	CFMAC CREFSW,CRFFB,[SETOM CREFP][IFN ITSSW,[FSCREF] .ELSE FSCRF]

	CFMAC ERRSW, ERRFB,[SETOM ERRFP] FSERR

	CFMAC LISTSW,LSTFB,[SETOM LISTP][IFN ITSSW,[FSLIST] .ELSE FSLST]

CMD50:	CAIE A,"_
	 JRST [	SETZB T,TT	; Point to scratch FB etc.
		CALL CMDFGT	; Ignore any output specs not needed.
		JRST CMD50]	; Must do this way to retain default stuffs.

	; Finally read input file.
	BLTMAC T,L$FBLK,(F),ISFB	; Copy last stuff to input spec
	MOVEI F,ISFB		; and point at it.
	PUSHJ P,CMDDVX		; Hack device-name default.
IFE ITSSW, MOVE T,FSMID
IFN ITSSW, MOVE T,FSGRTN	; > on ITS.
	MOVEM T,$FEXT(F)
	CALL RFD		; Read input spec.
	RET		; Yep, that's really all!

	; TT has <addr of instr to xct if file spec'd>,,<filblk ptr>
	; T has default $FEXT.
	; Takes defaults from current F, sets F to new filblk.
CMDFGT:	JUMPE TT,[SETZ T,	; If 0, do usual but into oblivion (scratch FB)
		MOVE TT,[[JFCL],,FB]
		JRST .+1]
	BLTMAC B,L$FBLK,(F),(TT)	; Copy from current filblk to new.
	MOVE F,TT			; set new F.
	MOVEM T,$FEXT(F)	; Set default $FEXT
	PUSHJ P,CMDDVX		; Set up device, defaulting to DSK.
	CAIN A,"_	; If last delimiter was start of input spec,
	 POPJ P,	; don't read anything - just use defaults.
	PUSHJ P,RFD
	TRNN FF,FRNNUL	; If spec non-null or
	 CAIN A,"_	; ended by _, then
	  CAIA		; hack specified instr.
	   POPJ P,
	HLRZ T,F
	XCT (T)
	POPJ P,

CMDDVX:	SKIPN T,$FDEV(F)
	 MOVE T,FSDSK
	CAME T,FSPTP
	 CAMN T,FSNUL
	  MOVE T,FSDSK
	MOVEM T,$FDEV(F)
	POPJ P,

SUBTTL ITS/DEC Filename Reader/printer (RFD, TYPFB)

IFN DECSW\ITSSW,[	; Begin moby conditional for sixbit reader.

; RFD -  Reads a single file description from .INSRT or command line,
;	using RCH, into specified FILBLK.
;	F points at FILBLK to store description in.
; 	Implements crufty ^R hack (if see ^R, act as if just starting to
;	read filename, so effect is stuff before ^R has set defaults.)
; If FRCMND set, recognize -, comma, / and ( as special characters,
;	and hack switches.
; Sets FRNNUL if spec was nonnull.
; Clobbers A,B,C only.

RFD:	TRZ FF,FRNNUL
RFD01:	SETZM RFDCNT	; Zero cnt of "normal" filenames.  Jump here if see ^R.

RFD10:	PUSHJ P,GPASST	; Flush out spaces/tabs
	TRNN FF,FRCMND	; If parsing command line,
	 CAIE A,";	; or if char isn't semi-colon,
	  JRST RFD22	; just handle normally.
RFD15:	PUSHJ P,RCH	; Semi-colon and not command line!! Flush rest
	CAIE A,^M	; of line, assuming it's a comment!
	 JRST RFD15
	POPJ P,

RFD2:	PUSHJ P,RCH	; Get character in A
RFD20:	CAIE A,40	; Space  (Come here to scan already-read char.)
	 CAIN A,^I	; or tab?
	  JRST RFD10	; Ach, go into flush-whitespace loop.
RFD22:	CAIN A,^M	; End of line?
	 POPJ P,	; If so, obviously done.
	CAIN A,^R	; Crufty ^R hack?
	 JRST RFD01	; Sigh, pretend just starting to read filename.
	TRNN FF,FRCMND	; Reading command line?
	 JRST RFD40	; Nope, skip over cmnd-line frobs.

	; Reading cmd line, test special chars.
IFN ITSSW\SAILSW, CAIN A,"	; SAIL underscore, ITS backarrow like _.
  .ELSE		CAIN A,"=	; Either gets munged,
	 MOVEI A,"_	; into canonical "_".
	CAIE A,"_	; Backarrow is output_input marker.
	 CAIN A,",	; Comma is also a terminator...
	  POPJ P,
IFN DECSW\TNXSW,[	; I'm not sure if this belongs here, but
	CAIN A,"!	.SEE RFDRUN
	 POPJ P,
]
	PUSHJ P,CMDSW	; Check for switches...
	 JRST RFD20	; Got some, scan next char (returned by CMDSW)
			; Got none, drop thru.


	; No special delimiters,
	; Check for chars which signal what following word is.
RFD40:
IFN DECSW,[
	CAIN A,"[	;] Left bracket signals start of PPN.
	 JRST [	PUSHJ P,RFDPPN		; Slurp it up,
		MOVEM C,$F6DIR(F)	; store it,
		TRO FF,FRNNUL		; saying spec not null.
		JRST RFD20]	; and go process leftover delimiter.

	CAIN A,".	; Period signals start of extension.
	 JRST [	PUSHJ P,RCH		; Get the next character
		PUSHJ P,RFDW		; Read in a word.
		MOVEM C,$F6EXT(F)	; Store it...
		TRO FF,FRNNUL		; and say spec non-null (even if C/ 0)
		JRST RFD20]	; and process delimiting char.
]

	; Here, char doesn't signal the start of anything, so we'll assume
	; it's the start of a name.
	PUSHJ P,RFDW	; Gobble up a word.
	JUMPE C,RFD2	; If nothing was read, must ignore char; get another.

	; Aha, name was read, now examine delimiter to see if it specifies
	; anything we know about.
	TRO FF,FRNNUL	; Set flag saying spec non-null.
	CAIN A,":	; If colon...
	 JRST [	MOVEM C,$F6DEV(F)	; Then store name as device.
		JRST RFD2]		; and flush delimiter.
IFN ITSSW,[
	CAIN A,";	; If semicolon...
	 JRST [	MOVEM C,$F6DIR(F)	; Then store name as directory (sname)
		JRST RFD2]		; and flush delimiter.
]
	; Whatever it is, at this point delimiter doesn't signify anything
	; special in terms of what the name is.  So we just store it, using
	; the usual FN1 FN2 DEV DIR sequence, and hand delimiter off to
	; the prefix scanning stuff.
	MOVE B,RFDCNT		; Get current count for random names.
	XCT RFDTAB(B)		; Either MOVEM C, to right place, or ignore
	 AOS RFDCNT		; by skipping over this instr.
	JRST RFD20		; and go examine delimiter.


.SCALAR RFDCNT		; Count to index RFDTAB by.

RFDTAB:	MOVEM C,$F6FNM(F)	; 1st name.
	MOVEM C,$F6EXT(F)	; 2nd name.
	MOVEM C,$F6DEV(F)	; 3rd name is dev.
	MOVEM C,$F6DIR(F)	; 4th is sname.
	CAIA			; 5th and on ignored, don't incr. cnt.

; RFDW - Reads a "word" - any string of contiguous SIXBIT chars,
;	barring certain delimiters, and leaves SIXBIT result in C.
;	Begins reading with char currently in A.  Returns with delimiter
;	char in A (it's possible this can be the same char!)
;	Clobbers B.

RFDW:	SETZ C,		; First things first, zap result.
	SKIPA B,[440600,,C]
RFDW2:	 PUSHJ P,RCH
	CAIN A,^Q	; Is char the quoter char?
	 JRST [	PUSHJ P,RCH	; Yup, gobble next...
		CAIN A,^M	; and accept anything but CR
		 POPJ P,	; since that terminates the whole line.
		JRST RFDW7]	; OK, go stuff the char into C.
	CAIE A,40	; Space
	 CAIN A,^I	; or tab
	  POPJ P,	; is always a break.
	CAIN A,^M	; As is CR.
	 POPJ P,
	TRNN FF,FRCMND	; And certain chars are bummers when reading cmd.
	 JRST RFDW4
	CAIE A,"/
	 CAIN A,"(
	  POPJ P,
IFN DECSW\TNXSW, CAIE A,"=
	 CAIN A,"_
	  POPJ P,
IFN ITSSW\SAILSW, CAIE A,"
	 CAIN A,",
	  POPJ P,
IFN DECSW\TNXSW,[
	CAIN A,"!
	 POPJ P,
]
	; Not reading cmd line, or no cmd-line type chars seen.
RFDW4:
IFN ITSSW,[
	CAIE A,":	; For ITS filenames, these chars are special.
	 CAIN A,";
	  POPJ P,
]
IFN DECSW,[
	CAIL A,140	; For DEC, allow only alphanumeric.
	 SUBI A,40	; cvt to uppercase, then
	CAIL A,"A	; see if alpha.
	 CAILE A,"Z
	  JRST [CAIL A,"0	; Nope, see if numeric.
		 CAILE A,"9
		  POPJ P,	; Not alphanumeric, assume delimiter.
		JRST .+1]
]
RFDW7:	TLNN B,770000	; Enough room in C for another char?
	 JRST RFDW2	; Nope, ignore it and get next.
	CAIL A,140	; Enuf room, cvt lower to uppercase
	 SUBI A,40
	SUBI A,40	; and cvt to sixbit,
	IDPB A,B	; and deposit.
	JRST RFDW2	; Get another.

] ; END IFN DECSW\ITSSW

IFN DECSW,[	; PPN Reader

RFDPPN:	PUSHJ P,RFDOCT	; Read project num,
IFN CMUSW, JUMPE C,RCMUPP	; At CMU watch for our funny ppns
	HRLM C,(P)
	PUSHJ P,RFDOCT	; Read programmer num.
	HLL C,(P)
	POPJ P,

IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8	; Read octal numbers.
IFN SAILSW,RFDOCL==40 ? RFDOCH==140	; Read sixbit (right-justified).

RFDOCT:	SETZ C,		; Read octal num, return in C.
RFDOC1:	PUSHJ P,RCH
	CAIL A,140
	 SUBI A,40
IFN SAILSW,[ ;[		; Even if reading sixbit names (for SAIL),
	CAIE A,",	; Comma and closebracket are still special.
	 CAIN A,"]
	  POPJ P,
]
	CAIL A,RFDOCL
	 CAIL A,RFDOCH
	  POPJ P,	; Not octal or not 6bit, return.
	IMULI C,RFDOCH-RFDOCL
	ADDI C,-RFDOCL(A)
	JRST RFDOC1

IFN CMUSW,[	; [
RCMUPP:	CAIN A,"]	; Watch out for []
	 POPJ P,
REPEAT 4, SETZM PPNBUF+.RPCNT
	MOVE C,[440700,,PPNBUF]
RCMUPL:	CAIE A,^M		; Don't look too far
	 SKIPE PPNBUF+3
	  JRST RCMUPD
	IDPB A,C
	PUSHJ P,RCH	; [
	CAIE A,"]
	 JRST RCMUPL
RCMUPD:	MOVE A,[C,,PPNBUF]
	CMUDEC A,
	 SETZ C,
	POPJ P,

.VECTOR PPNBUF(4)	; Storage to buffer up a string for CMUDEC uuo to scan.

] ;IFN CMUSW
] ;IFN DECSW

IFN DECSW\ITSSW,[

; TYPFB - Type out current filblk (what F points at) as file specification
;	Clobbers A,B,C

TYPFB:	MOVSI C,-3-ITSSW
	HRR C,F
TYPF1:	MOVE B,$F6DEV(C)	; Get next name
	PUSHJ P,SIXTYO		; Type out name
	HLRZ A,C
	MOVE A,FILSPC+3+ITSSW(A)	; Now get delimiting character
	PUSHJ P,TYOERR	; Type out
	AOBJN C,TYPF1	; Loop for all names
IFN ITSSW, POPJ P,
IFN DECSW,[
	SKIPN B,$F6DEV(C)	; On DEC system PPN is a special case
	 POPJ P,
	MOVEI A,"[ ;]
	CALL TYOERR
IFN CMUSW,[
	MOVE A,[B,,PPNBUF]
	DECCMU A,
	 JRST OCTPPN
	TYPR PPNBUF
	JRST PPNRB
	]
IFE SAILSW,[
OCTPPN:	HLRZ B,$F6DEV(C)	; LH is proj,
	CALL OCTPNT
	]
.ELSE [	HLLZ B,$F6DEV(C)
	CALL SIXTYO
]
	MOVEI A,",
	CALL TYOERR
IFE SAILSW,[
	HRRZ B,$F6DEV(C)
	CALL OCTPNT	; RH is prog.
]
.ELSE [	HRLZ B,$F6DEV(C)
	CALL SIXTYO
	]
PPNRB:			; [
	MOVEI A,"]
	JRST TYOERR
];IFN DECSW

FILSPC:	":
IFN ITSSW, 40 ? 40 ? ";
IFN DECSW, ". ? 0

] ; END IFN DECSW\ITSSW

SUBTTL Command switches

; CMDSW - Hacks either a single switch or switch list; A should
; contain "/ for the former, "( for the latter.
; Returns in A next char after switch hackery done.  This may be ^M.
; Skip returns if neither "/ nor "( was furnished to it.

CMDSW:	CAIN A,"/	; Single switch?
	 JRST [	PUSHJ P,RCH	; Get next char
		CAIN A,^M
		 POPJ P,
		PUSHJ P,CMDSW1
		PJRST RCH]
	CAIE A,"(	; Switch list?
	 JRST POPJ1	; Neither slash nor paren, make skip return.
CMDSWL:	PUSHJ P,RCH
	CAIN A,^M
	 POPJ P,
	CAIN A,")
	 PJRST RCH
	PUSHJ P,CMDSW1
	JRST CMDSWL

	; Command switch processing.  CMDSW1 processes the switch char
	; in A.
CMDSW1:	CAIL A,140	; Lower case to upper.
	 SUBI A,40
	CAIN A,"T
	 SOS TTYINS	; Count # T-switches.

	CAIN A,"W	; W - prevent tty messages, and
IFE ERRSW,AOS WSWCNT	; request error output file if possible.
.ELSE [
	AOSA WSWCNT
	 CAIN A,"E	; E - request error log file.
	  SETOM ERRFP
	]

IFN CREFSW,[
	CAIN A,"C	; C - request CREF output.
	 SETOM CREFP
	]

IFN LISTSW,[
	CAIE A,"L	; L - request listing
	 POPJ P,
	SETOM LISTP	; Say want listing.
	AOS LISTP1	; (starts as -1, will be positive after 2nd (L))
	]

	POPJ P,

SUBTTL TENEX  Filename Reader/printer (RFD, TYPFB)

IFN TNXSW,[	; Moby conditional for Tenex reader.

; TNXRFD - TENEX-style Filename Reader.
;	Takes input from RCH,
;	Deposits name strings into filblk F points to.
;	Clobbers A,B,C,D, (and AA,T,TT due to FNCHK)
; Uses FRFEXT flag to see if already read extension (type) or not.
;	Refuses to accept existing defaults for version, ;T, account,
;	protection, or JFN.  It will also zap an existing directory
;	default if a device is specified, and vice versa.  This is so that
;	logical names will win a little better.
; 	Implements crufty ^R hack (if see ^R, act as if just starting to
;	read filename, so effect is stuff before ^R has set defaults.)

IFNDEF FRFDEV,FRFDEV==2		; Set if read device.
IFNDEF FRFDIR,FRFDIR==1		; Set if read directory.
IFNDEF FRFEXT,FRFEXT==FRFN1	; Borrow this bit.  Set if read extension.

RFD:	TRZ FF,FRNNUL
	SETZM $FJFN(F)	; Zap JFN since the filename we'll read won't match it.
	SETZM $FACCT(F)	; Also zap other things that we don't want defaulted.
	SETZM $FPROT(F)
	SETZM $FTEMP(F)
	SETZM $FVERS(F)
TRFD01:	TRZ FF,FRFEXT+FRFDEV+FRFDIR	; Jump here if ^R seen.
TRFD10:	PUSHJ P,GPASST	; remove tabs, spaces and get first non-tab/space
	TRNN FF,FRCMND	; If parsing command line,
	 CAIE A,";	; or if char isn't semicolon,
	  JRST TRFD21	; just handle normally.
TRFD15:	PUSHJ P,RCH	; Semi-colon and not command line, it's a comment!
	CAIE A,^M	; So flush rest, up to EOL.
	 JRST TRFD15
	POPJ P,

TRFD1:	TLO FF,FLUNRD	; come here to re-read last char
TRFD2:	PUSHJ P,RCH	; Get char
TRFD21:	CAIE A,40	; Space? (come here to scan already-read char)
	 CAIN A,^I	; or tab?
	  JRST [TRNE FF,FRCMND	; Space/tab, if reading command line
		 JRST TRFD2	; then ignore and continue scanning (for switches), but
		JRST TRFD15]	; if not in cmd line, go flush entire rest of line!
	CAIN A,^M	; End of line?
	 POPJ P,	; If so, obviously done.
	CAIN A,^R	; Crufty ^R hack?
	 JRST TRFD01	; Sigh, pretend starting over.
	TRNN FF,FRCMND	; Must we check for cmd line frobs?
	 JRST TRFD22	; Nope, skip them.

	; Must check for chars special only in command line.
	CAIN A,"=
	 MOVEI A,"_
	CAIE A,"_	; backarrow is filename terminator...
	 CAIN A,",	; as is comma.
	  POPJ P,
	CAIN A,"!	; For CCL hacking...
	 POPJ P,	.SEE RFDRUN
	PUSHJ P,CMDSW	; Check for switches...
	 JRST TRFD21	; got some, process next char (returned by CMDSW)
			; Skips if none, drop thru.

	; Now see if char signifies start of anything in particular.
TRFD22:	CAIE A,"<	; Start of directory name?
	 JRST TRFD24	; No
	PUSHJ P,RCH
	PUSHJ P,TRFDW	; Read word, starting with next char
TRFD23:	CAIN A,".	; Allow . as part of directory name
	 JRST [	PUSHJ P,TRFDW5	; Read a continuation to this word
		JRST TRFD23]	; And try again
	MOVEI D,$FDIR	; Set up index.
	CAIN A,">	; Terminator should be end of dir name...
	 PUSHJ P,RCH	; If so, get next to avoid scan of ">".
			; else bleah, but aren't supposed to fail...
	TRNN FF,FRFDEV	; Unless a device has been explicitly given,
	 SETZM $FDEV(F)	; zap any furnished default.  0 means DSK.
	TRO FF,FRFDIR	; Now say dir was explicitly given.
	JRST TRFD6	; Go store it.
TRFD24:	CAIN A,".	; Start of $FTYPE or $FVERS (20x)?
	 JRST [	MOVEI D,$FTYPE	; Assume reading $FTYPE field,
		TLNE FF,FL20X	; always if 10X, but if really on 20X, then
		 TRON FF,FRFEXT	; use $FTYPE only if not already seen.
		  JRST TRFD4	; $FTYPE - jump to get word & store.
		PUSHJ P,TRFDNM	; $FVERS - 20X and $FTYPE already seen. Get #.
		 MOVEM B,$FVERS(F)	; Store it away if successful.
		JRST TRFD1]		; and go re-read delimiting char.

	CAIN A,";	; Start of $FVERS (10x) or attribute?
	 JRST [	PUSHJ P,RCH	; Find what next char is.
		CAIL A,"a	; Must uppercasify.
		 CAILE A,"z
		  CAIA
		   SUBI A,40
		CAIN A,"T	; Temporary file?
		 JRST [	SETOM $FTEMP(C)
			JRST TRFD2]
		CAIN A,"A	; Account?
		 JRST [	MOVEI D,$FACCT	; Set index, and
			JRST TRFD4]	; go gobble following word.
		CAIN A,"P	; Protection?
		 JRST [	MOVEI D,$FPROT	; Set index, and
			JRST TRFD4]	; go gobble following word.
		TLO FF,FLUNRD	; Not alpha, try numeric.  Re-read char,
		PUSHJ P,TRFDNM	; trying to parse as number.
		 MOVEM B,$FVERS(F)	; Win, parsed as number! Store it.
		JRST TRFD1]	; If none of above, ignore ";" entirely.

	PUSHJ P,TRFDW	; Let's try reading it as word,
	JUMPLE C,APOPJ	; If nothing read, assume it's some terminating delimiter.
	CAIN A,":	; Else have something, check trailing delim for special cases
	 JRST [	MOVEI D,$FDEV		; Aha, a device.
		PUSHJ P,RCH		; Flush the terminator & get next char.
		TRNN FF,FRFDIR		; Unless dir was explicitly given,
		 SETZM $FDIR(F)		; zap furnished default. 0 uses connected dir.
		TRO FF,FRFDEV		; Say device was explicitly given, and
		JRST TRFD6]		; store name away.
	MOVEI D,$FNAME	; Else assume it's the filename.
	JRST TRFD6


TRFD4:	PUSHJ P,RCH	; Here when must gobble next char,
TRFD5:	PUSHJ P,TRFDW	; here when first char of wd already read.
TRFD6:	PUSHJ P,FNCHKZ	; Note this can return and store a null string!
	ADDI D,(F)	; Get address (filblk+index), and
	MOVEM A,(D)	; store string pointer in the appropriate place.
	TRO FF,FRNNUL	; Say non-null spec seen,
	JRST TRFD1	; and go re-read the delimiter, to process it.

; TRFDW - Read a word (string), for use by TNXRFD.  Copies sequence of
;	acceptable filename chars into FNBUF, until non-valid char seen.
;	A/ First char of word,
;	Returns A/ delimiting char, C/ count of chars in string,
;	clobbers nothing else.

TRFDW4:	SUBI A,40	; Make lowercase
TRFDW5:	IDPB A,FNBWP	; Deposit into FNBUF,
	PUSHJ P,RCH	; get next char,
	AOSA C		; and bump count, skipping over zap instruction.
TRFDW:	 SETZ C,	; When called, zero cnt of chars in string.
	CAIL A,"A	; See if char is uppercase alpha,
	 CAILE A,"Z
	  CAIA
	   JRST TRFDW5
	CAIL A,"a	; or lowercase alpha,
	 CAILE A,"z
	  CAIA
	   JRST TRFDW4
	CAIL A,"0	; or numeric,
	 CAILE A,"9
	  CAIA
	   JRST TRFDW5
	CAIE A,"$	; or dollarsign
	 CAIN A,"-	; or hyphen
	  JRST TRFDW5
	CAIN A,"_	; Backarrow is special case, because
	 JRST [	TRNN FF,FRCMND	; if reading command,
		 TLNN FF,FL20X	; or running on 10X,
		  POPJ P,	; must treat as delimiter.
		JRST TRFDW5]
	CAIN A,^V	; ^V is quote char...
	 JRST [	PUSHJ P,RCH	; Quote, get next.
		CAIE A,^M	; Quote anything but this.
		 CAIN A,0	; or this.
		  POPJ P,	; time to exit.
		PUSH P,A	; Quote it!  Save char,
		MOVEI A,^V	; so that a quoter can precede it.
		IDPB A,FNBWP	; Fortunately this hair only needs care
		POP P,A		; for quoted chars, which are
		JRST TRFDW5]	; rare.
	TLNE FF,FL20X	; Are we on a 10X?
	 POPJ P,	; If not, anything at this point is delimiter.
	CAIL A,41	; Check general bounds
	 CAIL A,137	; Range from space to _ exclusive.
	  POPJ P,	; If outside that, delimiter.
	CAIL A,72	; This range includes :, ;, <, =, >
	 CAILE A,76
	  CAIA
	   POPJ P,	; delimiter.
	CAIE A,".
	 CAIN A,",
	  POPJ P,
	CAIE A,"*
	 CAIN A,"@
	  POPJ P,
	; Finally, check out chars which are acceptable to 10X but which
	; might be delimiter in cmd line...
	TRNN FF,FRCMND
	 JRST TRFDW5	; Not hacking cmd line, it's an OK char.
	CAIE A,"/
	 CAIN A,"(
	  POPJ P,
	CAIN A,"!
	 POPJ P,
	JRST TRFDW5	; at long last done.


; TRFDNM - Read numerical string, halt when non-digit
;	seen, leaves result (decimal) in B, with delimiting char in A.
;	One peculiarity is skip return if no numerical char is seen at all;
;	else doesn't skip and B has a valid number.

TRFDNM:	PUSHJ P,RCH		; First char needs special check.
	CAIL A,"0
	 CAILE A,"9
	  JRST POPJ1		; Not a number at all?
	TDZA B,B
TRFDN2:	 IMULI B,10.
	ADDI B,-"0(A)		; Convert to number
	PUSHJ P,RCH		; Get following chars.
	CAIL A,"0
	 CAILE A,"9
	  POPJ P,		; Nope, not digit so treat as delimiter.
	JRST TRFDN2	; Yep, a number

] ;IFN TNXSW

IFN TNXSW,[

; TYPFB - Type out FB pointed to by F

TYPFB:	SKIPE B,$FDEV(F)	; First, device name?
	 JRST [	PUSHJ P,TYPZ
		MOVEI A,":
		PUSHJ P,TYOERR
		JRST .+1]
	SKIPE B,$FDIR(F)	; Directory?
	 JRST [	MOVEI A,"<
		PUSHJ P,TYOERR
		PUSHJ P,TYPZ
		MOVEI A,">
		PUSHJ P,TYOERR
		JRST .+1]
	SKIPE B,$FNAME(F)
	 PUSHJ P,TYPZ
	MOVEI A,".
	PUSHJ P,TYOERR
	SKIPE B,$FEXT(F)
	 PUSHJ P,TYPZ
	MOVEI A,".		; 20X uses "." to set off version,
	TLNN FF,FL20X		; but 10X uses ";".
	 MOVEI A,";
	PUSHJ P,TYOERR
	HRRE A,$FVERS(F)
	JUMPL A,[MOVM B,A	; Is possible to have -1, -2, etc.
		MOVEI A,"-
		PUSHJ P,TYOERR
		MOVE A,B
		JRST .+1]
	PUSHJ P,DPNT		; Version # output in decimal.
	SKIPE $FTEMP(F)
	 TYPE ";T"		; May be temporary.
	SKIPE B,$FPROT(F)
	 JRST [	TYPE ";P"
		PUSHJ P,TYPZ
		JRST .+1]
	SKIPE B,$FACCT(F)
	 JRST [	TYPE ";A"
		PUSHJ P,TYPZ
		JRST .+1]
	POPJ P,

	; Takes BP in B, outputs to TYOERR until zero byte seen.
TYPZ:	CAIA
	 PUSHJ P,TYOERR
	ILDB A,B
	JUMPN A,TYPZ+1
	POPJ P,
] ; IFN TNXSW

SUBTTL TENEX misc. Filename Routines, FS string storage

IFN TNXSW,[	.SEE FSDSK	; Part of this page is NOT conditionalized!!

; To handle filenames of ASCIZ strings instead of SIXBIT words, each
; word has instead a byte pointer to an ASCIZ string.  For purposes of
; easy comparison, all of these bp's point into FNBUF, and a routine
; (FNCHK) is provided which checks a just-stored string and returns a bp
; to either this string, if unique, or to a previously stored string if
; it is the same as the one just stored (which is then flushed).  Thus
; strings can be compared for equality simply by a comparison of their
; byte pointers.  While not necessary, strings are stored beginning on
; word boundaries for easier hacking.

	; <# files>*<avg # strings/file>*<avg # words/string>+<# wds for constants>
LFNBUF==<MAXIND+5>*5*3+20	; Enough to hold strings for all output files,
		; all translated files, and all .insrt files encountered.
		; Later a GC'er can be hacked up so that of the latter only
		; enough for the max .insrt level need be allocated.

LVAR	FNBUF:	BLOCK LFNBUF

	; Macro to easily define constant strings for comparison purposes
DEFINE DEFSTR *STR*
440700,,%%FNLC
%%LSAV==.
LOC %%FNLC
ASCIZ 
STR

%%FNLC==.
LOC %%LSAV
TERMIN
	%%FNLC==FNBUF
] ; IFN TNXSW!!!

	; If not assembling for TENEX, the following strings become
	; simple SIXBIT values.  This makes it possible to write simple
	; code to work for both TENEX and non-TENEX without messy conditionals.

IFE TNXSW,[EQUALS DEFSTR,SIXBIT]

FSDSK:	DEFSTR /DSK/	; This stuff defines various BP's into FNBUF to
FSSYS:	DEFSTR /SYS/	; use for comparison purposes later.
FSTTY:	DEFSTR /TTY/
FSNUL:	DEFSTR /NUL/
FSPTP:	DEFSTR /PTP/
FSATSN:	DEFSTR /@/
FSSBSY:	DEFSTR /SUBSYS/
FSPROG:	DEFSTR /PROG/
FSMID:	DEFSTR /MID/
FSMDAS:	DEFSTR /MIDAS/
FSGRTN:	DEFSTR />/
FSCRF:	DEFSTR /CRF/
FSCREF:	DEFSTR /CREF/
FSERR:	DEFSTR /ERR/
FSLST:	DEFSTR /LST/
FSLIST:	DEFSTR /LIST/
FSSAV:	DEFSTR /SAV/
FSEXE:	DEFSTR /EXE/

IFN TNXSW,[
VBLK
FNBBP:	440700,,FNBUF	; Points to beg of FNBUF (hook for dynamic alloc)
FNBEP:	FNBUF+LFNBUF-1	; Points to last wd in FNBUF (address, not BP)
FNBWP:	440700,,%%FNLC	; Write Pointer into FNBUF.
FNBLWP:	440700,,%%FNLC	; Last Write Pointer, points to beg of string being stored
PBLK
EXPUNG %%FNLC

; NOTE - provided MIDAS never restarts, no initialization is necessary to
; start using FNCHK.  (Unless of course FNBUF is dynamically allocated someday)

; FNCHK - Check out just-stored filename.  Returns BP in A to ASCIZ string,
;	which will be "canonical" for comparison purposes.
;	Clobbers A,B,T,TT,AA
; FNCHKZ - Makes sure just-writ string is ASCIZ'd out before FNCHK'ing.

FNCHKZ:	MOVE B,FNBWP		; Get write ptr,
	LDB A,B			; see if last char was 0,
	JUMPE A,FNCHK0		; if so can skip one clobberage.
	SETZ A,
	IDPB A,B		; zero out bytes,
FNCHK0:	TLNE B,760000		; until at end of word.
	 JRST .-2
	ADD B,[<440700,,1>-<010700,,>]	; bump BP to point canonically at next.
	MOVEM B,FNBWP

FNCHK:	HRRZ B,FNBWP		; See if write ptr
	CAML B,FNBEP		; has hit end of FNBUF, and
	 ETF [ASCIZ /Filename buffer overflow/]	; barf horribly if so.
	MOVE A,FNBBP		; A  - bp to start of existing string
	MOVE AA,FNBLWP		; AA - bp to start of new string to store
FNCHK2:	MOVEI T,(A)		; T  - current addr being checked, existing str
	MOVEI TT,(AA)		; TT - current addr, new str
	CAIL T,(TT)		; If addrs are same, or overran somehow,
	 JRST [	MOVE A,AA	; didn't find any match, accept new string.
		MOVE B,FNBWP
		MOVEM B,FNBLWP	; Set up new last-write-ptr
		POPJ P,]
FNCHK3:	MOVE B,(T)
	CAMN B,(TT)		; Compare strings, full word swoops.
	 JRST [	TRNE B,377			; equal, last char zero?
		 AOJA T,[AOJA TT,FNCHK3]	; no, continue for whole string
		; Found it!  Flush just-stored string, don't want duplicate.
		MOVEM AA,FNBWP		; Clobber write ptr to previous value.
		POPJ P,]
	; Not equal, move to next string to compare
	MOVEI B,377	; Check for ASCIZ,
	TDNE B,(T)	; moving to end of current string
	 AOJA T,.-1
	HRRI A,1(T)	; and updating BP to point at new string.
	JRST FNCHK2	; (T gets pointed there too at FNCHK2).

; JFNSTR - Get filename strings for active JFN.
;	A/ active JFN
;	F/ addr of filename block to clobber.
; JFNSTB - Same, but ignores A and assumes JFN is already stored in block.
;	Clobbers A,C

JFNSTB:	SKIPA A,$FJFN(F)	; JFNSTB gets the JFN from block itself.
JFNSTR:	 MOVEM A,$FJFN(F)	; whereas JFNSTR stores it there...
	MOVSI D,-NJSTRF		; Set up aobjn thru table.
JFNST2:	PUSH P,T
	SYSCAL JFNS,[FNBWP ? $FJFN(F) ? JSTRFX+1(D)][FNBWP]
	POP P,T
	MOVE C,JSTRFX(D)	; Now get index to place it belongs in file block,
	CAIN C,$FVERS		; and check for this, because
	 JRST [	MOVE A,FNBLWP	; it wants to be a number, not a string.
		MOVEM A,FNBWP	; Zap write pointer back to forget string,
		PUSHJ P,CVSDEC	; and quickly convert before anything clobbers it.
		JRST .+2]	; Skip over the FNCHKZ call.
	PUSHJ P,FNCHKZ		; Fix it up, and get BP to it.
	ADDI C,(F)		; make it an addr, and
	MOVEM A,(C)		; store BP. (or value, for $FVERS)
	ADDI D,1
	AOBJN D,JFNST2
	POPJ P,

	; Filblk idx, output format wd for JFNS call
JSTRFX:	$FDEV	? 100000,,
	$FDIR	? 010000,,
	$FNAME	? 001000,,
	$FTYPE	? 000100,,
	$FVERS	? 000010,,
NJSTRF==<.-JSTRFX>/2

; CVSDEC - Converts ASCIZ string to decimal, assumes only digits seen.
;	A/ BP to ASCIZ
;	Returns value in A, clobbers nothing else.

CVSDEC:	PUSH P,B
	PUSH P,C
	MOVE C,A
	SETZ A,
	JRST CVSDC3
CVSDC2:	IMULI A,10.
	ADDI A,-"0(B)
CVSDC3:	ILDB B,C
	JUMPN B,CVSDC2
	POP P,C
	POP P,B
	POPJ P,

; CVSSIX - Converts ASCIZ string to SIXBIT word.
;	A/ BP to ASCIZ string,
;	Returns SIXBIT word in A.  Clobbers nothing else.

CVSSIX:	PUSH P,B
	PUSH P,C
	PUSH P,D
	MOVE D,A
	SETZ A,
	MOVE B,[440600,,A]
	JRST CVSSX3
CVSSX2:	CAIL C,140
	 SUBI C,40	; Uppercase force
	SUBI C,40	; cvt to 6bit
	IDPB C,B	; deposit
	TLNN B,770000	; If BP at end of word,
	 JRST CVSSX5	; leave loop.
CVSSX3:	ILDB C,D
	JUMPN C,CVSSX2
CVSSX5:	POP P,D
	POP P,C
	POP P,B
	POPJ P,

; CV6STR - Takes 6bit word in A, writes into FNBUF and makes a string of
;	it, returning BP in A.
;	Clobbers A,B,T,TT,AA (due to FHCHKZ)

CV6STR:	MOVE B,A
CV6ST2:	SETZ A,
	LSHC A,6	; Get a 6bit char
	ADDI A,40	; Make ASCII
	IDPB A,FNBWP	; deposit
	JUMPN B,CV6ST2	; Continue until nothing left
	PJRST FNCHKZ	; Make output thus far a string.


; CVFSIX - Takes current filblk (pointed to by F) and puts the
;	right stuff in $F6 entries.

CVFSIX:	PUSH P,A
	PUSH P,B
	MOVSI B,-L$F6BL
CVFSX2:	MOVE A,@CVFTAB(B)	; Get BP to string
	PUSHJ P,CVSSIX		; Convert to 6bit
	ADDI B,$F6DEV(F)	; Get index to right place to store.
	MOVEM A,(B)
	SUBI B,$F6DEV(F)	; restore aobjn pointer...
	AOBJN B,CVFSX2
	POP P,B
	POP P,A
	POPJ P,

CVFTAB:	$FDEV(F)
	$FNAME(F)
	$FEXT(F)
	$FDIR(F)
IFN <.-CVFTAB>-L$F6BL, .ERR CVFTAB loses.

] ; IFN TNXSW

SUBTTL DEC/TENEX - RUN hacking. (Process FOO! in CCL)
IFN DECSW,[

; Process "FOO!", which means "run SYS:FOO with an offset of 1".
; Note that the RUN call needs a block of 6 ACs, but at this point
; it doesn't matter what gets clobbered.


	; Entry point for restart, from TSRETN.
RERUN:	MOVE B,FSMDAS		; Get name - using SYS:MIDAS
	SETZB C,D+1		; (no ext or ppn)
	JRST RFDRU1

VBLK

RFDRUN:	MOVE A,$F6DEV(F)	; Load up the 4 filenames to use.
	MOVE B,$F6FNM(F)
	MOVE C,$F6EXT(F)
	MOVE D+1,$F6DIR(F)
	JUMPN A,RFDRU3	; If device specified, use that,
	MOVSI A,'DSK	; else default to DSK
	CAIN D+1,	; if a PPN was given, and
RFDRU1:	 MOVSI A,'SYS	; to SYS: otherwise.
RFDRU3:	SETZB D,D+2	; These acs must always be zero...
	MOVEI D+3,177	; Flush all core above this address.
IFN SAILSW,[
	SETZ D+4,
	CORE2 D+4,	; Flush hiseg by hand on SAIL.
	 GOHALT
	]
.ELSE HRLI D+3,1	; Elsewhere, just set LH to this to flush hiseg.

	MOVE D+4,[RUNCOD,,D+5]	; Move core-less code into position in ACs.
	BLT D+4,<D+5>+LRUNCD-1
	MOVE D+4,[1,,A]	; <start offset>,,<address of arg block>
	JRST D+5	; Go flush core and run program.

RUNCOD:	CORE D+3,	; Flush as much core as possible; RUN uuo can lose
	 GOHALT		; Because of how much we have.
	RUN D+4,
	 GOHALT
LRUNCD==.-RUNCOD
	; Make sure symbols A-D leave enuf room.
IFL 17-<D+5+LRUNCD>, .ERR RFDRUN ACs lose.
PBLK
] ;END IFN DECSW

IFN TNXSW,[
	; On TENEX, we'll do things without compat package (boo hiss)

	; Entry point for starting new MIDAS, come here from TSRETN.
RERUN:	MOVEI F,FB
	BLTZ L$FBLK,FB		; Clear out scratch filblk, point at it.
	MOVE A,FSMDAS		; Get BP to "MIDAS", store in
	MOVEM A,$FNAME(F)	; filblk, and drop thru for defaults.

	; Here to start up specified program, for CCL hacking.
RFDRUN:	TLNN FF,FL20X		; 20X or Tenex?
	 JRST [	MOVE A,FSSBSY	; Tenex, get BP to SUBSYS string
		SKIPN $FDIR(F)	; Unless directory specified,
		 MOVEM A,$FDIR(F)	; default dir to <SUBSYS>.
		MOVE A,FSSAV	; And do similar thing for ext (.SAV)
		JRST RFDRN2]
	MOVE A,FSSYS		; 20X, get BP to SYS string
	SKIPN $FDEV(F)		; Unless device specified,
	 MOVEM A,$FDEV(F)	; default dev to SYS:.
	MOVE A,FSEXE		; And ditto for ext (.EXE)

RFDRN2:	SKIPN $FEXT(F)		; If extension not specified,
	 MOVEM A,$FEXT(F)	; Store appropriate one.
	PUSHJ P,GETJFI		; Get JFN for input...
	 GOHALT			; Ugh, bletch, etc.

	; OK, all ready to smash ACs with loader, etc.
	MOVE R1,$FJFN(F)	; Put JFN into RH
	HRLI R1,.FHSLF		; and fork handle (self) in LH.
	MOVE R2,[RUNCOD,,R3]	; Load into ACs beginning at AC 3
	BLT R2,R3+LRUNCD-1
	JRST R3			; Off we go, never to return...

	; Following code is executed in AC's, position independent.
RUNCOD:	GET		; Load up the file.
	MOVEI R1,.FHSLF
	GEVEC		; Find entry vector word for it, returned in AC 2.
	JRST R1(R2)	; and go execute instruction in reenter slot.
LRUNCD==.-RUNCOD	; Pretty small loader, huh?
] ; IFN TNXSW

SUBTTL Core Allocation routine - GCCORQ gets another K for MACTAB

; Get another K of MACTAB space.

GCCORQ:	MOVE A,MACHI
	LSH A,-2	; Convert to word #
	CAIL A,MXMACL	; Want more than allowed?
	 POPJ P,
	MOVE A,MACTND	; No, get addr of block we want to get.
	PUSH P,A	; Entry, save A in case have to try again
CORRQ1:
IFN ITSSW,[
	LSH A,-10.
	SYSCAL CORBLK,[MOVEI %CBNDR+%CBNDW
		MOVEI %JSELF ? A ? MOVEI %JSNEW]
	 JRST CORRQL	; Lose
]
IFN DECSW,[
	IORI A,1777
	CORE A,
	 JRST CORRQL	; Lose
]
IFN TNXSW,[
	SKIPN MEMDBG	; Only need to hack if want.
	 JRST CORRQ3
	; Super kludge.  No way to ask 10X for a "new page"; must
	; get it via default create-on-reference.  Hence to get page
	; without bombing, must be sure .ICNXP interrupt deactivated!
	PUSH P,T
	SYSCAL DIC,[[.FHSLF] ? [1_<35.-.ICNXP>]]	; Deactivate.
	SETZM (A)			; Reference 1st page
	SETZM 1000(A)			; Reference 2nd page.
	SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]]	; Re-activate.
	POP P,T
CORRQ3:
]

	REST A
	ADDI A,2000
	JRST MACIN2	; Update pointers to end of MACTAB.

IFN ITSSW\DECSW,[
	; Lossage handler for GCCORQ.  Only ITS or DEC can fail.
CORRQL:	PUSH P,C
	PUSH P,D
	TLOE AA,400000
	 JRST CORQL1
	TYPE "
No core for macro table."
CORQL1:	TYPE "
Try again? "
CORQL2:	PUSHJ P,TYI	; Get char
	CAIL A,140	; Cheap uppercase force
	 SUBI A,40
	CAIN A,"Y	; Y,
	 JRST CORRQA	; => try again
	CAIN A,"N	; N,
	 JRST CORRQB	; => back to DDT then try again
	CAIN A,"?	; ?,
	 ERJ CORQL1	; => type out error-type blurb
	TYPE "?  "	; something else
	JRST CORQL2

CORRQB:
IFN ITSSW,.VALUE	; Loop point for don't-proceed
IFN DECSW,EXIT 1,
	TLZ AA,400000
CORRQA:	POP P,D
	POP P,C
	MOVE A,(P)	; Restore A from PDL
	JRST CORRQ1
] ; IFN ITSSW\DECSW

SUBTTL CORGET - allocate fresh pages

; CORGET - Takes arg in AA, an ITS page AOBJN to pages to grab.
;	AA/ -<# pages>,,<1st page #>
;	Clobbers only AA.

CORGET:	JUMPGE AA,APOPJ		; Ignore arg if nothing to do about it.
IFN ITSSW,[
	SYSCAL CORBLK,[	MOVEI %CBNDR+%CBNDW	; Get both read and write.
			MOVEI %JSELF		; Into self
			AA			; AA is AOBJN of pages.
			MOVEI %JSNEW]		; Want fresh pages.
	 .LOSE %LSSYS
]
IFN TNXSW,[
	SKIPN MEMDBG	; Ignore anyway if not hacking mem ref debugging.
	 POPJ P,
	PUSH P,R1
	PUSH P,R2
	PUSH P,R3
	MOVE R3,AA
	ASH R3,1	; Get Tenex page AOBJN
	MOVEI R1,(R3)
	LSH R1,9.	; Get word address of first page.
	HRR R3,R1	; Stick back in AOBJN.

	; Super kludge.  No way to ask 10X for a "new page"; must
	; get it via default create-on-reference.  Hence to get page
	; without bombing, must be sure .ICNXP interrupt deactivated!
	MOVEI R1,.FHSLF
	MOVE R2,[1_<35.-.ICNXP>]
	DIC		; Deactivate.
TCORG3:	SETZM (R3)	; Get the page.
	ADDI R3,777	; Bump word address,
	AOBJN R3,TCORG3	; and get next page (note adds 1 more to RH)
	AIC		; Now re-activate...
	POP P,R3
	POP P,R2
	POP P,R1
] ;IFN TNXSW
	POPJ P,