SUBTTL	B. SCHREIBER UI HI ENERGY PHYSICS GROUP

SEARCH	JOBDAT,UUOSYM,MACTEN,SCNMAC
.DIREC	.XTABM
SALL
TWOSEG

;SHOW UNIVERSAL VERSION NUMBERS

%%JOBD==:%%JOBD
%%UUOS==:%%UUOS
%%MACT==:%%MACT
%%SCNM==:%%SCNM

;SELECTIVELY LOAD SCAN AND COMPANY

.TEXT	\/SEARCH REL:ALCOR/SEG:LOW\
.TEXT	\/SEARCH REL:SCN7B/EXCLUD:(.SCAN)/SEG:LOW,REL:SCN7B\
.REQUI	REL:HELPER		;LOAD HELPER IN HISEG

;COPYMT VERSION INFORMATION

CMTVER==7		;MAJOR VERSION
CMTEDT==40		;EDIT LEVEL
CMTMIN==0		;MINOR VERSION LETTER
CMTWHO==0		;WHO LAST EDITTED

LOC	.JBVER		;SET THE VERSION
%%CPYM==:VRSN.	(CMT)
EXP	%%CPYM

DEFINE CTITLE (TEXT,MAJVER,EDIT)
<TITLE	'TEXT'MAJVER(EDIT)>

CTITLE	(<COPYMT MAGNETIC TAPE COPY PROGRAM %>,\CMTVER,\CMTEDT)
SUBTTL	REVISION HISTORY

COMMENT	\

3(11)	23-SEP-76	ALL EDITS TO NOW RELEGATED TO DEVELOPMENT.
			ADD /UNLOAD
3(12)	27-SEP-76	REPORT TAPOP. UUO FAILURES. ONLY ASK ABOUT
			QUITTING ON BLOCK TOO LARGE ONCE.
4(13)	27-SEP-76	ADD IFTYP FACILITY...ENABLED BY /IFTYP IN COMMAND
4(14)	28-SEP-76	SPEED UP IFTYP HANDLING..USE JSP
5(15)	30-SEP-76	ADD CODE TO COPY MTA TO DSK AND DSK TO
			MTA (IREAD MODE ONLY). ALSO ADD STATISTICS
			SUCH AS RUNTIME AND ELAPSED TIME TO IFTYP STUFF
5(16)	04-OCT-76	USE RESULT OF DEVNAM FOR ALL MTCHR AND TAPOP
			UUOS. LOGICAL NAMES SOMETIMES DON'T WORK
			(ESP IF THEY ARE NUMERIC!) ALSO, WHEN TESTING
			A TAPE, TYPE OUT DENSITY AND TRACKS
5(17)	05-OCT-76	ADD ROUTINE DOTPOP ON TOP OF ETAPOP TO
			SAVE A FEW WORDS. ADD /TIME TO TYPE
			ELAPSED AND CPU TIME.
6(20)	08-OCT-76	ADD /TO32 TO COPY 36-BIT TAPE TO 32-BIT TAPE
6(21)	11-OCT-76	TURN OFF FL$EOT AT COPDUN IF END OF LIST SEEN.
			THIS WILL PREVENT EXTRA MTBSF. OUTC, AT DO.DUN
			WHICH WAS IO TO UNASS CHN BECAUSE WE DID NOT
			REOPEN OUTPUT
6(22)	22-OCT-76	ADD SETIBO/SETIBI
6(23)	27-OCT-76	FIX SWTCHS MACRO...MISPLACED CONDITIONAL AND
			FS.VRQ MISSING ON A FEW SWITCHES.
6(24)	05-NOV-76	FIX BUG IN CPYMTD IF IREAD LOGICAL RECORD
			ENDS ON BLOCK BOUNDARY (T3 GOT ZAPPED BY SETIBC)
6(25)	13-NOV-76	BF.IBC GOES IN BUFFER HEADER, NOT BUFFFER RING!
			ALSO MUST CLEAR IO.UWC AT OUTCLS OR NEXT TO LAST
			BUFFER GETS WRITTEN OUT AGAIN.
6(26)	15-NOV-76	ADD /ERROR:IGNORE. DEFAULT DSK EXTENSIONS TO .DAT.
			ADD "I" OPTION TO IFTYPE.
6(27)	16-NOV-76	CLEARING IO.UWC SOMETIMES GET IO TO UNASS CHN.
			SOLUTION: ADD FL$OPN=1 WHEN OUTPUT IS OPEN.
6(30)	1-26-77		BUG IF /COPY:N:M. DO NOT REOPEN OUTPUT IF N OR
			M RUNS OUT.
6(31)	1-26-77		6(30) WAS NOT QUITE RIGHT.  INSTEAD OF QUITTING
			GET NEXT FUNCTION. ALSO CHECK FOR OUTPUT OPEN AT
			DO.CPY IN CASE OF /COPY:X/SKIP:Y/COPY:Z.
6(32)	2-3-77		CHANGE TO ERROR., WARN., AND INFO.. ADD /RETRY:N
			TO SET # RETRIES FOR TAPE TESTING AND MAKE THE
			DEFAULT BE 4 INSTEAD OF 10 (TU70'S SHOULD NOT
			NEED 10 TRIES!!!)
6(33)	11-FEB-77	ADD /REPEAT:N TO TRY THE TAPE TEST N TIMES
7(34)	11-FEB-77	IMPLEMENT LOG FILE CAPABILITY
			WITH /LOG:FILESPEC, /COMMENT:"COMMENT FOR LOG FILE"
			AND /CLOSE
7(35)	13-FEB-77	CLOSE LOG FILE ON FATAL ERROR!
7(36)	13-FEB-77	IF LOG DEVICE IS LPT FORGET THE LOOKUP
7(37)	18-FEB-77	ALLOW /LOG WITH NO FILE SPEC (DEFAULT = DSK:COPYMT.LOG)
7(40)	23-FEB-77	SHOW FILE AND RECORD COUNTS AT END OF COPY
			FOR ALL MEDIA

	\;END OF REVISION HISTORY
SUBTTL	AC DEFINITIONS

;DEFINE THE ACCUMULATORS

DEFINE	AC$ (X)
<X=ZZ
ZZ==ZZ+1
X=X>
ZZ==0			;START THE BALL ROLLING

AC$	F,		;FLAGS
AC$	T1,		;T1-4 ARE TEMPORARY AND FOR ARGUMENT PASSING
AC$	T2,
AC$	T3,
AC$	T4,
AC$	P1,		;P1-4 MUST BE PRESERVED (.SAVEX ARE BEAUTIFUL!)
AC$	P2,
AC$	P3,
AC$	P4,
AC$	L,		;LINK FOR JSP
AC$	PLP,		;PARAMETER LIST POINTER
AC$	ACT,		;HOLDS DESIRED ACTION IN DO.IT
	P=17		;THE PUSH DOWN POINTER
	N=P3		;VALUE HOLDER FROM SCAN .XXXNW, ETC.
	C=P4		;CHARACTER AC FOR SCAN, .TICAN, ETC.
SUBTTL	BIT DEFINITIONS

;ASSEMBLY DIRECTIVES

ND LN$PRM,^D60		;PARAM LENGTH
ND LN$PDL,^D40		;PDL LENGTH
ND MY$NAM,'COPYMT'	;MY NAME IN SIXBIT
ND MY$PFX,'CMT'		;MESSAGE PREFIX
ND N$BUFS,2		;# I/O BUFFERS (BOTH INPUT AND OUTPUT)
ND N$LOGB,2		;# BUFFERS FOR LOG FILE
ND DF$BFZ,^D1024	;DEFAULT BUFFER SIZE IF NO /BUFSIZ GIVEN
ND MX$NPL,^D8		;# WORDS/LINE ON ERROR DUMP
ND FT$MTP,-1		;NON-ZERO FOR MTAPE MONITORY COMMAND
ND FT$DEB,0		;NON-ZERO FOR DEBUGGING CODE
ND FT$OPT,-1		;NON-ZERO TO READ SWITCH.INI
ND FT$TST,-1		;NON-ZERO TO INCLUDE /TAPTST CODE
IFN FT$TST,<
ND DF$TRY,4		;DEFAULT # RETRIES ON TAPE ERRORS
ND N$TSTB,1		;USE 1 BUFFER FOR /TAPTST
>;END IFN FT$TST
ND N$DSKB,6		;USE THIS MANY BUFFERS FOR DSK I/O


;FDB

LN$FDB==.FXLEN		;USE STD SIZE FDB

ATSIGN==(1B13)		;THE INDIRECT BIT

INPC==1			;INPUT CHANNEL
OUTC==2			;OUTPUT CHANNEL
LPTC==3			;LPT CHANNEL FOR ERROR DUMPING
LOGC==4			;CHANNEL FOR LOG FILES
;FLAGS IN F

DEFINE FLAG$ (F)
<FL$'F==..FL		;;DEFINE THE FLAG BIT
..FL==..FL_-1
FL$'F==FL$'F>		;;SHOW THE FLAG VALUE

..FL==(1B0)		;START AT BIT 0

FLAG$ (MRG)		;ON WHEN MERGING (CONCATENATING) FILES 
FLAG$ (OUT)		;ON WHEN OUTPUT SPEC ALLOCATED
FLAG$ (CPY)		;ON WHEN /COPY OR /CONCAT SEEN
FLAG$ (EOT)		;CLEARED WHEN RECORD OUTPUT, SET AT INPUT EOF
			;TWO SETS IN A ROW IMPLIES LOGICAL EOT
FLAG$ (LPO)		;ON MEANS LPT FILE IS OPEN
FLAG$ (BAT)		;ON IF BATCH JOB (PREFIX A FEW MSGS WITH $)
FLAG$ (FLG)		;GENERAL PORPOISE FLAG
IFN FT$MTP,<
FLAG$ (MTP)		;ON IF MTAPE MONITOR COMMAND
>;END IFN FT$MTP
IFN FT$TST,<
FLAG$ (TST)		;ON WHEN PROCESSING /T
>;END IFN FT$TST
FLAG$ (BKT)		;HAVE SEEN BKT BEFORE AND USER SAID CONTINUE
FLAG$ (ITY)		;/IFTYP WAS SEEN
	$FLITY==(FL$ITY);A LEFT HAND VALUE OF THE SAME THING
FLAG$ (DSI)		;ON IF INPUT IS DSK
FLAG$ (DSO)		;ON IF OUTPUT IS DSK
FLAG$ (232)		;ON IF 36-BIT TAPE TO 32-BIT TAPE
	$FL232==(FL$232);NEED LH VALUE
FLAG$ (OPN)		;ON WHEN OUTPUT IS OPEN
FLAG$ (LOG)		;ON WHEN LOG FILE IS OPEN
FLAG$ (TSN)		;ON WHEN TIME STAMP NEEDED IN LOG FILE
;MACRO TO DEFINE FUNCTION VALUES

DEFINE FUNCTS
<FN (<BSP,SKP,EOF,REW,UNL,CPY,CON>)>

DEFINE FN (X)
<IRP X,<ZZ==ZZ+1
FN$'X==ZZ>>
ZZ==0			;FUNCTIONS START AT 1

FUNCTS

FN$INP==-1		;FUNCTIONS FOLLOWING THIS ONE ARE FOR INPUT SIDE
FN$EOL==-2		;END OF FUNCTION LIST

;EXTRA FLAGS FOR SWTCHS MACRO

FS$XTR==1B7		;THIS SWITCH CAN TAKE EXTRA PARAMETERS
			;(I.E. /BACKSP:F:N)
FS$NVL==1B8		;THIS SWITCH NEVER TAKES A VALUE
FS$OUT==1B9		;THIS SWITCH IS OUTPUT ONLY
FS$INP==1B10		;THIS SWITCH IS INPUT  ONLY
FS$SPL==1B11		;THIS SWITCH REQUIRES SPECIAL PROCESSING
			;DO A JRST @SWTP(P1) TO DO IT
SUBTTL	ERROR MACRO DEFINITIONS

;ERROR.	($FLGS,$PFX,$MSG)
;
;$FLGS 	IS THE COMBINITATION OF THE FOLLOWING BITS:

	EF$ERR==0	;ERROR--PREFIX MSG WITH ?, RETURN CONTROL AFTER CALL
	EF$FTL==400	;FATAL ERROR--ABORT AND RESTART
	EF$WRN==200	;WARNING MESSAGE--CONTINUE
	EF$INF==100	;INFORMATIVE MESSAGE--CONTINUE
	EF$NCR==40	;NO FREE CRLF AFTER MESSAGE
	EF$OPR==20	;MESSAGE SHOULD BE PREFIXED WITH CRLF-$ IF BATCH
	EF$MAX==17	;MAX # OF TYPE CODES ALLOWABLE (9 BITS - ABOVE USED)

DEFINE ETYP ($TYP)
<ZZ==ZZ+1
EF$'$TYP==ZZ>

ZZ==0		;TYPE CODES ARE FROM 1-EF$MAX

ETYP	DEC,		;TYPE T1 IN DECIMAL AT END OF MESSAGE
ETYP	OCT,		;TYPE T1 IN OCTAL AT END OF MESSAGE
ETYP	SIX,		;TYPE T1 IN SIXBIT AT END OF MESSAGE
ETYP	PPN,		;TYPE T1 AS A PPN AT END OF MESSAGE
ETYP	STR,		;T1 PTS TO ASCIZ STR TO TYPE AT END OF MESSAGE
ETYP	FIL,		;T1 PTS TO SCAN FILE BLOCK TO TYPE AT END OF MSG
ETYP	LEB,		;T1 POINTS AT OPEN BLOCK
			;T2 POINTS AT LOOKUP/ENTER BLOCK

MX$ERR==ZZ		;MAXIMUM LEGAL ERROR TYPE
EF$NOP==0		;INTERNAL FOR ERROR HANDLER

IFG ZZ-EF$MAX,<PRINTX ?TOO MANY ERROR TYPES>

;$PFX IS THE 3-LETTER PREFIX FOR THE MESSAGE
;$MSG IS THE MESSAGE ITSELF

NOOP==	(CAI)		;DEFINE NO-MEMORY-REFERENCE RIGHT-HAND NOOP

DEFINE	ERROR.	($FLGS,$PFX,$MSG)
<PUSHJ	P,EHNDLR
XWD NOOP+<$FLGS>,[''$PFX'',,[ASCIZ @$MSG@ ] ]
>
;WARN.	($FLGS,$PFX,$MSG) -- GENERATE CALL TO ERROR HANDLER FOR WARNING

DEFINE WARN. ($FLGS,$PFX,$MSG)
<ERROR.	(EF$WRN!$FLGS,$PFX,$MSG)>

;INFO.	($FLGS,$PFX,$MSG) -- GENERATE CALL TO ERROR HANDLING FOR INFO

DEFINE INFO. ($FLGS,$PFX,$MSG)
<ERROR.	(EF$INF!$FLGS,$PFX,$MSG)>

;OPER$	($FLGS,$PFX,$MSG) -- MESSAGE THAT OPERATOR WILL SEE IN BATCH JOB

DEFINE OPER$ ($FLGS,$PFX,$MSG)
<ERROR.	(EF$OPR!$FLGS,$PFX,$MSG)>
SUBTTL	IMPLEMENTATION NOTES

COMMENT	\A NOTE ABOUT THE PARAMETER LIST -

THE LIST IS SET UP IN TWO WORD ARGUMENTS.  THE FIRST WORD IS THE FUNCTION
AND THE SECOND CONTAINS <FILE REPEAT COUNT,,RECORD REPEAT COUNT>.
FOR FUNCTIONS THAT HAVE NO COUNTS (I.E. /EOF) THE COUNT IS SET
TO ONE BY THE SWITCH HANDLER.  THE INTERNAL FUNCTIONS (FN$INP AND
FN$EOL) DO NOT USE THE SECOND ARGUMENT, BUT IS PRESENT FOR A HOMOGENOUS
LIST.

\;END NOTE

COMMENT	\

IF THIS PROGRAM IS REASSEMBLED AND DOES NOT APPEAR TO FUNCTION
CORRECTLY, CHECK UUOSYM DEFINITIONS FOR MTCHR. AND TAPOP. UUO, AND WHAT
THE MONITOR ACTUALLY STORES IN THESE ARG BLOCKS.  I EXPECT THAT THE
DEFINITIONS FOR .TFSTS (GET STATUS) ARE WRONG IN THE UUOSYM I USED
(.TSFIL==0, .TSREC==1).

\;END COMMENT
SUBTTL	OTHER MACRO DEFINITIONS

;SAVE$ SAVES DATA ON THE STACK

DEFINE	SAVE$	(X)
<XLIST
IRP X,<PUSH P,X>
LIST>

;RESTR$ RESTORES DATA FROM THE STACK

DEFINE	RESTR$	(X)
<XLIST
IRP X,<POP P,X>
LIST>

;MACRO TO ALLOCATE STORAGE IN THE LOW SEGMENT DATA BASE

DEFINE	U ($NAME,$WORDS<1>)
<$NAME:	BLOCK	$WORDS>

;STRNG$ (STRING) SENDS STRING TO OUTPUT THROUGH .TSTRG

DEFINE STRNG$ (S)
<MOVEI	T1,[ASCIZ \S\]
PUSHJ	P,.TSTRG##>
;HIGH$	SWITCHES TO HIGH SEGMENT

DEFINE	HIGH$
<IFE SEG$,<HILOC$==.
	SEG$==-1
	RELOC LOLOC$>
>

;LOW$	SWITCHES TO LOW SEGMENT

DEFINE	LOW$
<IFN SEG$,<LOLOC$==.
	SEG$==0
	RELOC HILOC$>
>

;RELOC$	DEFINES INITIAL CONDITIONS

DEFINE	RELOC$
<RELOC	0
LOLOC$==400000
SEG$==0>

;LIT$ FORCES OUT LITERALS IN CURRENT SEGMENT

DEFINE	LIT$
<XLIST
LIT
LIST>
SUBTTL	GET THE BALL ROLLING

;MAIN AND ONLY ENTRY POINT. REMEMBER IF CCL ENTRY OR NOT, AND REMEMBER
;WHERE WE CAME FROM.  THIS IS NECESSARY TO RECOVER THE SCAN HIGH SEGMENT
;AFTER WE HAVE FINISHED COPYING

	RELOC$			;INITIALIZE SEGMENTS

COPYMT:	TDZA	T1,T1		;NOT CCL ENTRY
	MOVEI	T1,1		;CCL START
	MOVEM	T1,OFFSET	;REMEMBER FOR SCANNING
	RESET			;STOP ALL I/O
REPEAT 0,<	;UN-REPEAT WHEN DISTRIBUTED
	MOVX	T1,%CNDVN	;MONITOR VERSION
	GETTAB	T1,
	SETZ	T1,		;WILL LOOSE BIG
	TXZ	T1,VR.WHO!VR.MIN;GET MAJOR VERSION #
	CAIGE	T1,60200	;MUST BE .GE. 602
	ERROR.	EF$FTL,N6M,<NEED 6.02 OR LATER MONITOR>
>;END REPEAT 0
	SKIPE	SAVRUN		;HAVE WE SAVED RUN UUO ARGS?
	 JRST	RUNSVD		;YES--SKIP AHEAD
	MOVEM	.SGNAM,SGNAM	;NO--DO SO NOW
	MOVEM	.SGPPN,SGPPN	;
	MOVEM	.SGDEV,SGDEV
	MOVEM	.SGLOW,SGLOW	;LOW FILE EXTENSION
	SETOM	SAVRUN

RESTRT:
RUNSVD:	STORE	17,0,16,0	;CLEAR ALL ACCUMULATORS
	STORE	17,FW$ZER,LW$ZER,0 ;AND ZEROED DATA BASE
	SKIPA	P,.+1		;LOAD UP PUSH DOWN POINTER
INIPDP:	 IOWD	LN$PDL,PDLIST
	PUSHJ	P,.RECOR##	;RESET CORE ALLOCATION
	PUSHJ	P,UPSCN		;IN CASE OF ABORT-RESTART
	PUSHJ	P,$CLOSE	;RESET THE /LOG SPEC BLOCK
	MOVE	T1,ISCNBL	;GET .ISCAN ARGUMENT BLOCK
	PUSHJ	P,.ISCAN##	;INITIALIZE THE SCANNER
	MOVEM	T1,ISCNVL	;REMEMBER VALUE RETURNED 
IFN FT$MTP,<
	SOJE	T1,DOMTAP	;JUMP IF MTAPE COMMAND (VALUE=1)
>;END IFN FT$MTP
	SKIPN	OFFSET		;CCL START?
	SKIPE	TLDVER		;TOLD VERSION YET?
	 JRST	CPYMT0		;YES--GO CALL .TSCAN
	STRNG$	<COPYMT %>	;NO--DO IT NOW
	MOVE	T1,.JBVER
	PUSHJ	P,.TVERW##
	PUSHJ	P,.TCRLF##
	SETOM	TLDVER
CPYMT0:	PUSHJ	P,UPSCN		;ENSURE SCAN AROUND
	SETZ	F,		;***CLEAR THE FLAGS
	PUSHJ	P,SCNCMD	;GET A COMMAND
	MSTIME	T1,		;GET TIME OF DAY
	MOVEM	T1,GOTIME	;SAVE AS GO-TIME
	SETZ	T1,		;GET MY RUNTIME
	RUNTIM	T1,
	MOVEM	T1,GORUNT	;SAVE AS INITIAL RUNTIME
	MOVE	T1,OUTSPC+.FXDEV;OUTPUT DEV NAME
	DEVNAM	T1,		;SEE WHAT IT REALLY IS
	 JRST	ILLODV		;CAN'T
	MOVEM	T1,ODVNAM	;SAVE FOR LATER
IFN FT$TST,<
	SKIPL	TESTFL		;NO INPUT IF /TEST
	 JRST	CPYMT1		;SO DON'T  TRY IT
>;END IFN FT$TST
	MOVE	T1,INPSPC+.FXDEV;INPUT NAME
	DEVNAM	T1,		;GET REAL NAME
	 JRST	ILLIDV		;CAN'T
	MOVEM	T1,IDVNAM
	PUSHJ	P,CHKCMD	;CHECK COMMAND FOR GOODNESS
	PUSHJ	P,DWNSCN	;POOF GOES THE HISEG!
	PUSHJ	P,OPNOUT	;OPEN OUTPUT FILE
	PUSHJ	P,OPNINP	;GET NEXT INPUT FILE
	PUSHJ	P,CHKLOG	;SEE ABOUT THE LOG FILE NOW
	PUSHJ	P,DO.IT		;DO IT
CPYMT9:	PUSHJ	P,CLSLOG	;CLOSE LOG IF IT WAS OPEN
	PUSHJ	P,.RECOR##	;RESET CORE ALLOCATION
	JRST	CPYMT0		;GET NEXT COMMAND

IFN FT$TST,<
CPYMT1:	PUSHJ	P,CHKBAT	;SEE IF BATCH JOB
	PUSHJ	P,DWNSCN	;MAKE ME SMALLER
	PUSHJ	P,OPNOUT	;OPEN OUTPUT
	PUSHJ	P,CHKLOG	;GO SEE ABOUT LOG FILE BEFORE WE FIRE IT UP
	PUSHJ	P,TESTIT	;TEST IT
	JRST	CPYMT9		;LOOP
>;END IFN FT$TST
PLPINI:	IOWD	LN$PRM,PRMPDL	;INITIAL PARAM LIST PTR
	LIT$			;FORCE OUT LITERALS
	HIGH$			;THIS CODE CAN DISSAPPEAR

SCNCMD:	MOVE	T1,TSCNBL	;GET .TSCAN ARGUMENT BLOCK
	PUSHJ	P,.TSCAN##	;CALL .TSCAN TO SCAN COMMAND
IFN FT$TST,<
	SKIPL	TESTFL		;/TAPTST?
	 JRST	SCNTST		;YES--SHOULD ONLY HAVE ONE DEVICE
>;END IFN FT$TST
	SKIPE	OUTSPC+.FXDEV	;OUTPUT THERE?
	SKIPN	INPSPC+.FXDEV	;YES--INPUT?
E$$CER:	ERROR.	EF$FTL,CER,<COMMAND ERROR>
IFN FT$OPT,<
	MOVE	T1,OSCNBL	;GET ARG PTR FOR .OSCAN
	PUSHJ	P,.OSCAN##	;SCAN DSK:SWITCH.INI[-]
>;END IFN FT$OPT
	POPJ	P,		;**SCNCMD RETURN
IFN FT$TST,<
SCNTST:	SKIPE	OUTSPC+.FXDEV	;WAS IT DEV:/TAPTST= ?
	 JRST	[SKIPN INPSPC+.FXDEV ;YES--BUT WAS INPUT SPEC THERE ALSO?
		JRST	SCNTS0	;NO--ALL IS WELL
		JRST	E$$CER]	;NO--COMMAND ERROR
	SKIPE	T1,INPSPC+.FXDEV;INPUT SPECIFIED?
	 CAME	T1,[SIXBIT/DSK/] ;YES--IF IT IS DSK
	 SKIPA			;'DSK' MEANS /TEST WAS TYPED
	SETZM	INPSPC+.FXDEV	;FAKE-OUT SO WE USE TAPTST:
	MOVE	T1,[INPSPC,,OUTSPC] ;SETUP TO BLT SPEC TO PROPER PLACE
	BLT	T1,OUTSPE	;...MOVE IT
SCNTS1:	MOVE	T1,[SIXBIT/TAPTST/] ;LAST CHANCE TRY IF NO NAME NOW
	SKIPN	OUTSPC+.FXDEV	;DID WE GET ON?
	 MOVEM	T1,OUTSPC+.FXDEV;NO--TRY THIS -- COMPLAIN IF FAILURE
SCNTS0:	MOVEI	T1,N$TSTB	;USE N$TSTB BUFFERS
	MOVEM	T1,NOBUFS	;AND SET IT
	MOVE	T1,OUTSPC+.FXDEV;CHECK DEVICE FOR MAGTAPE
	DEVNAM	T1,		;DO IT AGAIN IN CASE WE CHANGED IT (ABOVE)
	 JRST	ILLODV		;CAN'T GET AT IT
	MOVEM	T1,ODVNAM	;SAVE FOR LATER
	PUSHJ	P,CKISMT	;BECAUSE WE WON'T TEST ANYTHING ELSE
	JRST	E..DNM		;NOT MTA
	MOVE	T2,ODVNAM	;GET NAME FOR MTCHR.
	MTCHR.	T2,		;GET IT
	SETZ	T2,		;BETTER THIS THAN A HALT!
	PUSHJ	P,STSTBZ	;SET UP 1 FOOT RECORD BUFFERSIZE
IFN FT$OPT,<
	MOVE	T1,OSCNBL	;CAN HAVE /IFTYP IN SWITCH.INI
	PJRST	.OSCAN##	;SCAN AND RETURN
>;END IFN FT$OPT
IFE FT$OPT,<
	POPJ	P,		;END OF SCNCMD
>;END IFE FT$OPT
>;END IFN FT$TST
;ARGUMENT BLOCK FOR .ISCAN

ISCNBL:	XWD 5,	.+1
	IOWD N$CMDS,CMDLST	;LEGAL COMMAND LIST
	XWD OFFSET,MY$PFX
	XWD	0,CHROUT	;SO WE CAN MPX OUTPUT TO LOG FILE
	EXP	0
	XWD	DOPRMP,0

;.TSCAN ARGUMENT BLOCK

TSCNBL:	XWD 11,	.+1
	IOWD SWTL,SWTN
	XWD SWTD,SWTM
	XWD 0,SWTP
	EXP -1		;USE JOB NAME TABLE
	XWD CLRANS,CLRFIL
	XWD AIN,AOUT
	EXP 0
	EXP 0		;NO FLAGS
	EXP STOSWT

IFN FT$OPT,<
;.OSCAN ARGUMENT BLOCK

OSCNBL:	XWD 4,	.+1
	IOWD OPSWL,OPSWN
	XWD OPSWD,OPSWM
	XWD 0,OPSWP
	EXP -1
	EXP 0
>;END IFN FT$OPT

IFN FT$MTP,<	;MTAPE FEATURE
;.TSCAN ARG BLOCK FOR MTAPE COMMAND

MTSCNB:	XWD 11,	.+1
	IOWD MTSWL,MTSWN
	XWD MTSWD,MTSWM
	XWD 0,MTSWP
	EXP	-1
	XWD CLRANS,CLRFIL
	XWD AIN,AOUT
	EXP 0
	EXP 0
	EXP STOSWT
>;END IFN FT$MTP

CMDLST:	EXP	MY$NAM		;IF ANY BODY WANTS IT...
IFN FT$MTP,<	;MTAPE COMMAND
	SIXBIT	/MTAPE/		;
>;END IFN FT$MTP

	N$CMDS==.-CMDLST

;SCAN CALLS HERE TO PROMPT

DOPRMP:	SKIPL	T1		;INITIAL OR CONTINUATION?
	 SKIPA	T1,PRMPT0	;INITIAL
	 MOVSI	T1,'#  '	;CONTINUATION
	PJRST	.TSIXN##	;TYPE IT

PRMPT0:	XWD	MY$PFX,'>  '
SUBTTL	MTAPE COMMAND HANDLER

IFN FT$MTP,<

DOMTAP:	TLO	F,FL$MTP	;FLAG MTAPEING
	MOVE	T1,MTSCNB	;TSCAN BLOCK FOR MTAPE COMMAND
	PUSHJ	P,.TSCAN##	;CALL COMMAND SCANNER
	SKIPN	T1,INPSPC+.FXDEV;CHECK FOR AN INPUT SPEC
	 JRST	E$$CER		;NO--MUST HAVE SCREWED UP
	CAMN	T1,[SIXBIT/DSK/] ;IS IT DSK?
	 JRST	[SKIPN	T1,INPSPC+.FXNAM ;YES--PROBABLY FORGOT THE COLON
		JRST	E$$CER		;WHOOPS!! BAD COMMAND
		MOVEM	T1,INPSPC+.FXDEV ;SO TRY THE FILE NAME
		JRST	.+1]
	DEVNAM	T1,		;GET REAL NAME
	 JRST	ILLIDV		;NOT REAL
	MOVEM	T1,IDVNAM	;SAVE FOR LATER
	PUSHJ	P,CKISMT	;ENSURE MTA
	JRST	E..DNM		;NOTT-GO BOMB
	PUSHJ	P,OPINOB	;OPEN INPUT WITH NO BUFFERS
	PUSHJ	P,CHKBAT	;BETTER CHECK FOR BATCH...
	PUSHJ	P,DO.IT		;PERFORM THE OPERATIONS
	PUSHJ	P,.MONRT##	;ALL DONE
	JRST	RESTRT		;ON .CONTINUE GET THE PROMPT
>;END IFN FT$MTP
SUBTTL	CHECK COMMAND FOR REAL MAGTAPES AND OTHER GOOD THINGS

CHKCMD:	MOVE	T1,ODVNAM	;GET OUTPUT DEVICE REAL NAME
	PUSHJ	P,CKISMT	;ENSURE MTA
	 TLO	F,FL$DSO	;FLAG DSK OUTPUT
	MOVE	T1,IDVNAM	;SAME FOR INPUT
	PUSHJ	P,CKISMT
	 TLO	F,FL$DSI	;FLAG DSK INPUT
	TLNE	F,FL$DSO!FL$DSI	;CHECK FOR DSK IN OR OUT
	 JRST	[TLC	F,FL$DSI!FL$DSO ;YES--MAKE SURE NOT BOTH DSK
		TLCE	F,FL$DSI!FL$DSO ;
		JRST	CHKC.1	;A-OK--MOVIN' ALONG
		ERROR.	(EF$FTL,BDD,<BOTH DEVICES ARE DSK>)]
	MOVE	T1,ODVNAM	;MAKE SURE NOT SAME MTA
	MOVE	T2,IDVNAM	;...
	CAMN	T1,T2		;BETTER NOT BE THE SAME
	 JRST	E$$CUS		;YES--STUPID
	JRST	CHKC.2		;OK--NOW SKIP AHEAD
CHKC.1:	HRLOI	T2,'DAT'	;SETUP DEFAULT EXTENSION
	TLNE	F,FL$DSI	;DISK INPUT?
	SKIPE	INPSPC+.FXEXT	;NEED ONE?
	  SKIPA			;NO--DON'T TOUCH IT
	   MOVEM T2,INPSPC+.FXEXT ;YES--DEFAULT IT
	TLNE	F,FL$DSO	;DISK OUTPUT?
	SKIPE	OUTSPC+.FXEXT	;YES--NEED DEFAULT?
	  SKIPA			;NO
	   MOVEM T2,OUTSPC+.FXEXT ;YES--DEFAULT
CHKC.2:
CHKBAT:	HRROI	T1,.GTLIM	;NOW SEE IF I AM A BATCH JOB
	GETTAB	T1,		;ASK MON
	 SETZ	T1,		;JE NE SAIS PAS
	TLNE	T1,(JB.LBT)	;BATCH JOB?
	 TLO	F,FL$BAT	;YES--REMEMBER THAT
	POPJ	P,		;ALL IS WELL (I HOPE)

ILLODV:	SKIPA	T1,OUTSPC+.FXDEV;DEVNAM FAILED
ILLIDV:	MOVE	T1,INPSPC+.FXDEV
	ERROR.	EF$FTL!EF$SIX,IUD,<ILLEGAL OR UNKNOWN DEVICE - >

E$$CUS:	ERROR.	EF$FTL,CUS,<CAN'T USE SAME MTA FOR INPUT AND OUTPUT>
;CKISMT -- SEE IF DEVICE IS MTA
;CALL:	MOVE	T1,DEVNAM
;	PUSHJ	P,CKISMT
;	*ITS A DSK*
;	*ITS MTA*
;PRESERVES T1

CKISMT:	MOVE	T2,T1		;COPY DEVICE NAME
	DEVCHR	T2,		;GET CHARACTERISTICS
	TLNE	T2,(DV.MTA)	;IS IT AN MTA?
	 TLNE	T2,(DV.TTY)	; AND ALSO A TTY (IMPLIES NUL:)
	JRST	CKISM1		;NO--SEE IF DSK
	TLNE	T2,(DV.AVL)	;MTA--IS IT AVAILABLE TO ME?
	 JRST	.POPJ1##	;YES--DONE
	ERROR.	EF$FTL!EF$SIX,MNA,<MTA IS NOT AVAILABLE - >
CKISM1:	TLNE	T2,(DV.DSK)	;IS IT A DSK?
	 TLNE	T2,(DV.TTY)	;YES--AND NOT TTY (I.E. NOT NUL:)
E..DNM:	ERROR.	EF$SIX!EF$FTL,DNM,<DEVICE NOT A MAGTAPE - >
	POPJ	P,		;DEVICE IS A DISK
SUBTTL	SWITCH TABLE

DEFINE	SWTCHS,<
SP *BACKSP,FN$BSP,.SWDEC##,MTN,FS$XTR!FS.VRQ
SP BUFSIZ,BUFSIZ,.SWDEC##,BFZ,FS.NUE
SS CLOSE,$CLOSE,0,FS.NFS!FS.NCM!FS$SPL
SP COMMENT,<POINT ^D65-^D28,UCOMNT>,.SWASQ##,,FS.NUE
SP CONCAT,FN$CON,.SWDEC##,MTN,FS.VRQ!FS$XTR!FS$INP
SP *COPY,FN$CPY,.SWDEC##,MTN,FS$XTR!FS$INP!FS.VRQ
SS *EOF,FN$EOF,FN$EOF,FS$NVL
SL ERROR,ERRFLG,ERL,ERLCON,FS.NUE
SP IBUF,NIBUFS,.SWDEC##,BFS,FS.NUE
SS *IFTYP,<POINTR (F,$FLITY)>,1,FS.NUE
SP LOG,$LOGSW,.POPJ##,LGF,FS.NFS!FS.NCM!FS$SPL
SL MODE,MODFLG,MOD,MODBIN,FS.NUE
SS NORETR,RTRYFL,1,FS.NUE
SP OBUF,NOBUFS,.SWDEC##,BFS,FS.NUE
IFN FT$TST,<
SP REPEAT,RPETFL,.SWDEC##,RPT,FS.NUE
>;END IFN FT$TST
SS REPORT,RPTFLG,1,FS.NUE
SP RETRY,NUMTRY,.SWDEC##,TRY,FS.NUE
SS *REWIND,FN$REW,FN$REW,FS$NVL
SP *SKIP,FN$SKP,.SWDEC##,MTN,FS$XTR!FS.VRQ
IFN FT$TST,<
SP TAPTST,TESTFL,.SWDEC##,TST,FS.NUE
SP *TEST,TESTFL,.SWDEC##,TST,FS.NUE
>;END IFN FT$TST
SS TIME,TIMEFL,1,FS.NUE
SS TO32,<POINTR(F,$FL232)>,1,FS.NUE
SS *UNLOAD,FN$UNL,FN$UNL,FS$NVL
>

MX.LGF==.FXLEN
PD.LGF==1
DM (BFS,^D20,6,6)
DM (MTN,177777,177777,177777)
DM (BFZ,^D4096,^D2048,^D1024)
IFN FT$TST,<
DM (RPT,177777,1,1)
DM (TRY,^D100,DF$TRY,DF$TRY)
DM (TST,177777,0,0)
>;END IFN FT$TST
KEYS (ERL,<CONTIN,IGNORE,QUERY>)
KEYS (MOD,<BINARY,INDUST,SEVENB>)

DOSCAN	(SWT)
SUBTTL	.OSCAN/MTAPE COMMAND SWITCH TABLES

IFN FT$OPT,<	;ONLY IF ASSEMBLED FOR OPTION SCANNNING

DEFINE	SWTCHS,<
SP BUFSIZ,BUFSIZ,.SWDEC##,BFZ,FS.NUE
SL ERROR,ERRFLG,ERL,ERLCON,FS.NUE
SP IBUF,NIBUFS,.SWDEC##,BFS,FS.NUE
SS *IFTYP,<POINTR (F,$FLITY)>,1,FS.NUE
SP LOG,$LOGSW,.POPJ##,LGF,FS.NFS!FS.NCM!FS$SPL
SP OBUF,NOBUFS,.SWDEC##,BFS,FS.NUE
SS TIME,TIMEFL,1,FS.NUE
>

DOSCAN (OPSW)
>;END IFN FT$OPT

IFN FT$MTP,<

DEFINE SWTCHS,<
SP *BACKSP,FN$BSP,.SWDEC##,MTN,FS$XTR
SS *EOF,FN$EOF,FN$EOF,FS$NVL
SS *REWIND,FN$REW,FN$REW,FS$NVL
SP *SKIP,FN$SKP,.SWDEC##,MTN,FS$XTR
SS *UNLOAD,FN$UNL,FN$UNL,FS$NVL
>

DOSCAN (MTSW)
>;END IFN FT$MTP
SUBTTL	HELPER ROUTINES FOR SCANNING COMMANDS

;SCAN CALLS HERE TO ALLOCATE SPACE FOR INPUT SPEC

AIN:	TLNN	F,FL$CPY!IFN FT$MTP,<FL$MTP> ;DID WE SEE /COPY OR /CONCAT?
				;OR IS THIS MTAPE COMMAND?
	 PUSHJ	P,CPYHOL	;NO--SET UP TO COPY WHOLE TAPE
	HRROI	T1,FN$EOL	;SET END OF LIST
	PUSHJ	P,PRMSTO	;...
	MOVEI	T1,INPSPC	;POINT TO SPEC
	PJRST	ALEN		;GET LENGTH AND RETURN

;SCAN CALLS HERE TO ALLOC OUTPUT SPEC SPACE

AOUT:	HRROI	T1,FN$INP	;SET END OF OUTPUT LIST
	PUSHJ	P,PRMSTO	;...
	PUSHJ	P,ALEN		;SETUP MODFLG AND T2 (LENGTH)
	TLO	F,FL$OUT	;OUTPUT SPEC ALLOCATED
	MOVEI	T1,OUTSPC	;HERE IT IS!
	POPJ	P,		;RETURN FROM AOUT
ALEN:	SKIPG	T2,MODFLG	;/MODE:MODE SPECIFIED THIS SIDE?
	 JRST	ALEN2		;NO--DON'T BOTHER WITH IT
	TLNE	F,FL$OUT	;INPUT?
	MOVEM	T2,INPMOD	;YES
	TLNN	F,FL$OUT	;OUTPUT?
	MOVEM	T2,OUTMOD	;YES
	SETOM	MODFLG		;RESET MODFLG SO SCAN DOESN'T BARF
ALEN2:	MOVEI	T2,LN$FDB	;TELL SCAN LENGTH OF FDB
	POPJ	P,

;SCAN CALLS HERE TO CLEAR ALL ANSWERS

CLRANS:	STORE	T1,SCN$FZ,SCN$LZ,0
	STORE	T1,SWT$FO,SWT$LO,-1 ;WORD SWITCHES TO -1 PLEASE
	MOVE	PLP,PLPINI	;SETUP PARAM LIST PTR
IFN FT$MTP,<
	TLNN	F,FL$MTP	;MTAPE COMMAND?
	 POPJ	P,		;NO
	HRROI	T1,FN$INP	;YES--FORCE TO INPUT SIDE ONLY
	PUSHJ	P,PRMSTO	;SET ON PARAM LIST
>;END IFN FT$MTP
	POPJ	P,

;FIX UP TO COPY WHOLE TAPE...NO /COPY OR /CONCAT

CPYHOL:	MOVEI	T1,FN$CPY	;FUNCTION
	HRLOI	T2,677777	;LARGE NUMBER OF FILES/RECORDS
	PJRST	PRMSTO		;SET ON PARAM LIST AND RETURN

;HERE TO STORE /LOG SWITCH

$LOGSW:	CAIE	C,":"		;IS THERE A FILE SPEC?
	 JRST	[MOVEI	T1,1	;NO--STORE A 1
		MOVEM	T1,LOGSPC;...
		POPJ	P,]	;RETURN TO SCAN
	PUSHJ	P,.FILIN##	;READ THE FILE SPEC
	MOVEI	T1,LOGSPC	;POINT AT MY STORAGE
	MOVEI	T2,.FXLEN
	PUSHJ	P,.GTSPC##	;COPY SPEC TO MINE AREA
	MOVEI	T1,1		;NO SENSE IN SCAN CALLING CLRFIL NOW
	PJRST	.CLRFL##	;CLEAR FILE AREA AND RETURN
;SCAN CALLS HERE TO CLEAR ALL FILE ANSWERS

CLRFIL:	POPJ	P,		;***

;SCAN CALLS HERE TO STORE FILE SWITCHES
;WITH N=VALUE,T2=PTR (FUNCTION FN$XXX IN THIS CASE), AND T3=FLAGS (LH)
;ALSO P1=SWITCH INDEX

STOSWT:
	TLNE	T3,(FS$SPL)	;SPECIAL PROCESSING?
	 JRST	@SWTP(P1)	;YES--GO THERE
	TLNN	T3,(FS$OUT)	;SWITCH OUTPUT ONLY?
	 JRST	STOSWA		;NO
	TLNE	F,FL$OUT	;YES--IS OUTPUT DONE?
	 JRST	E$$OSI		;YES--GO BOMB--OUTPUT SWITCH ON INPUT
STOSWA:	TLNN	T3,(FS$INP)	;INPUT ONLY?
	 JRST	STOSWB		;NO--GO STORE IT
	TLNN	F,FL$OUT	;YES--OUTPUT DONE YET?
	 JRST	E$$ISO		;NO--GO BOMB
STOSWB:	TLNE	T3,(FS$NVL)	;NEVER TAKE A VALUE?
	 JRST	SWTS0A		;YES--MAKE SURE IT DOESN'T GET ONE
				;(BUT SET VALUE OF ONE SO IT GETS DONE ONCE)
	 TLNN	T3,(FS$XTR)	;NO--DOES IT TAKE EXTRA VALUES?
	  JRST	SWTST0		;NO--JUST MOVE ALONG
	CAIE	C,":"		;YES--IS THERE ONE?
	 JRST	SWTST0		;NO--ONLY RECORDS WERE GIVEN
	SAVE$	<N,T2>		;YES--SAVE VALUE, AND PTR (FUNCTION)
	PUSHJ	P,.DECNW##	;READ SECOND VALUE
	RESTR$	<T1,T2>		;RESTORE GOOD STUFF AND POSITION IN CORRECT ACS
	MOVSS	T2		;BUT FILE COUNT GOES IN LEFT HALF
	HRR	T2,N		;AND RECORD COUNT TO RIGHT HALF
	PJRST	PRMSTO		;STORE PARAMS, AND SKIP SCAN SWITCH STORE

SWTS0A:	MOVEI	N,1		;FS$NVL--MAKE SURE IT GETS DONE 1 TIME
SWTST0:	MOVE	T1,T2		;POSITION FUNCTION
	HRRZ	T2,N		;AND VALUE (NOTE /BACKSP:N MEANS N RECORDS)
;	PJRST	PRMSTO		;GO STORE PARAMS AND RETURN

;CALL PRMSTO TO STORE PARAMETERS IN FUNCTION PARAMETER LIST
;WITH T1=FUNCTION, T2=VALUE

PRMSTO:	PUSH	PLP,T1		;STORE PARAMETER
	PUSH	PLP,T2		;AND VALUE (NOT USED IF DOESN'T TAKE ONE)
	CAIE	T1,FN$CPY	;IF THIS IS /COPY
	CAIN	T1,FN$CON	;OR /CONCAT
	 TLO	F,FL$CPY	;THEN WE HAVE A COPY SWITCH
	POPJ	P,		;DONE

E$$OSI:	MOVE	T1,SWTN(P1)	;GET SWITCH NAME FOR DUM USER
	ERROR.	EF$FTL!EF$SIX,OSI,<OUTPUT SWITCH ILLEGAL ON INPUT - >
E$$ISO:	MOVE	T1,SWTN(P1)	;GET SWITCH NAME
	ERROR.	EF$FTL!EF$SIX,ISO,<INPUT SWITCH ILLEGAL ON OUTPUT - >
SUBTTL	DETERMINE BUFFER SIZE FOR TAPE TESTING

IFN FT$TST,<
STSTBZ:	LDB	T1,[POINTR (OUTSPC+.FXMOD,FX.DEN)] ;SEE IF /DENSITY
	SKIPN	T1		;GET ONE?
	LDB	T1,[POINTR (T2,MT.DEN)] ;NO--GET MTCHR. DENSITY
	TRNE	T2,MT.7TR	;7 TRACK?
	 CAIG	T1,3		;YES--.GT. 800 BPI?
	  JUMPN	T1,STSBZ0	;OK IF NON-ZERO
	 WARN.	0,CDD,<CAN'T DETERMINE DENSITY - 800 BPI ASSUMED>
	MOVEI	T1,3		;800 BPI
STSBZ0:	MOVEM	T1,TSTDEN	;SAVE TEST DENISTY
	TRNE	T2,MT.7TR	;SEVEN TRACK?
	 SKIPA	T1,BUFSZ7-1(T1)	;YES--GET PROPER LENGTH
	  MOVE	T1,BUFSZ9-1(T1)	;NO--USE 9-TRACK LENGTH
	MOVEM	T1,BUFSIZ	;SET IT
	POPJ	P,

;TABLE OF RECORD LENGTHS FOR DIFFERENT DENSITIES ON 7/9 TRACK UNITS
;LENGTH FOR ONE FOOT RECORDS = <DENSITY>/<BYTES/WORD ON TAPE>*<1 FOOT-IRG>
;(IRG=INTER-RECORD GAP)

BUFSZ7:	EXP	^D375,^D1042,^D1500 ;200/556/800
BUFSZ9:	EXP	0,0,^D1824,^D3648,^D14250   ;200/556/800/1600/6250
>;END IFN FT$TST

	LIT$			;FORCE OUT HISEG LITERALS
SUBTTL	HIGH SEGMENT HANDLING

	LOW$

;DWNSCN -- REMOVE THE HISEG IF PRESENT
;CALL:	PUSHJ	P,DWNSCN
;	*RETURN--ALL ACS SAVED*

DWNSCN:	SKIPN	.JBHRL		;HIGH SEGMENT AROUND?
	POPJ	P,		;NO--DON'T DO CORE UUO NOW
	SAVE$	T1		;PRESERVE T1 AS ADVERTIZED
	MOVSI	T1,1		;YES--GET RID OF IT
	CORE	T1,		;BYE/!
	 JFCL			;SNH
	PJRST	TPOPJ		;GET T1 AND RETURN

;UPSCN -- REGET THE HISEGMENT
;CALL:	PUSHJ 	P,UPSCN
;	*RETURN--ALL ACS SAVED*

UPSCN:	SKIPE	.JBHRL		;HIGH SEGMENT THERE?
	 POPJ	P,		;YES--SKIP COSTLY GETSEG
	MOVEM	17,SAVAC+17	;GETSEG DESTROYS ACS
	MOVEI	17,SAVAC
	BLT	17,SAVAC+16	;SAVE ALL
SEGAGN:	MOVE	T1,SGDEV	;SETUP FOR GETSEG
	MOVE	T2,SGNAM
	MOVE	T3,SGLOW
	SETZB	T4,P2
	MOVE	P1,SGPPN
	MOVEI	P3,T1		;POINT AT THE BLOCK
	GETSEG	P3,
	SKIPA	T1,P3		;OOOPS--SET UP T1 TO TYPE OUT CODE
	JRST	[MOVSI	17,SAVAC
		BLT	17,17
		POPJ	P,]
	MOVE	P,INIPDP	;JUST IN CASE..RESET PDL
	ERROR.	EF$ERR!EF$OCT,CGH,<CAN'T GET HIGH SEG - CODE = >
	EXIT	1,
	JRST	SEGAGN		;MAYBE IT WAS JUST LOST?
SUBTTL	LOG FILE HANDLING

;CHKLOG -- SEE IF LOG FILE NEEDED AND SETUP FOR IT

CHKLOG:	MOVE	T1,LOGSPC	;GET THE DEVICE NAME
	AOJE	T1,.POPJ##	;JUMP IF IT IS STILL (-1)
	 TLO	F,FL$LOG	;NO--IT WAS /LOG OR /LOG:SPEC
	PUSHJ	P,LOGOPN	;YES--OPEN THE LOG FILE
	MOVE	T1,UCOMNT	;SEE IF A COMMENT GIVEN
	AOJE	T1,.POPJ##	; IF NOT, UCOMNT WILL BE -1
	MOVEI	T1,[ASCIZ/COMMENT: /]
	PUSHJ	P,STRLOG	;SEND TO LOG FILE
	MOVEI	T1,UCOMNT	;POINT AT COMMENTS
	PUSHJ	P,STRLOG	;SEND TO LOG FILE
CLFLOG:	PJSP	T1,STRLOG	;SEND CRLF TO LOG AND RTURN
	ASCIZ	.
.
CLGNTS:	PUSHJ	P,CLFLOG	;SEND CRLF TO LOG FILE
	TLZ	F,FL$TSN	;CLEAR TIME STAMP NEEDED
	POPJ	P,		;RETURN

;STRLOG -- SEND STRING TO LOG FILE
;CALL:	MOVEI	T1,<ASCIZ STRING ADDR>
;	PUSHJ	P,STRLOG

STRLOG:	HRLI	T1,(POINT 7)	;FORM BYTE PTR
	PUSH	P,T1		;SAVE ON PDL
STRL.2:	ILDB	T1,(P)		;GET A CHAR
	JUMPE	T1,TPOPJ	;JUMP IF ALL DONE
	PUSHJ	P,CHRLOG	;SEND TO LOG FILE
	JRST	STRL.2

;CHROUT -- SEND CHARACTER TO TTY AND LOG FILE IF OPEN
;CHRLOG -- SEND CHARACTER TO LOG FILE
;CALL:	MOVEI	T1,<CHAR>
;	PUSHJ	P,CHRLOG/CHROUT

CHROUT:	OUTCHR	T1		;SEND TO TTY
	TLNN	F,FL$LOG	;ARE WE LOGGING?
	 POPJ	P,		;NO--DONE
CHRLOG:	TLZE	F,FL$TSN	;TIME FOR A TIME STAMP?
	PUSHJ	P,TIMSTM	;YES--DO ONE
	SOSG	GBHR+.BFCTR	;ROOM IN BUFFER?
	JRST	CHRLG1		;NO--GO DUMP ONE
CHRLG0:	IDPB	T1,GBHR+.BFPTR	;YES--STORE IN BUFFER
	CAIN	T1,.CHLFD	;LINEFEED?
	 TLO	F,FL$TSN
	POPJ	P,
CHRLG1:	PUSHJ	P,.PSH4T##	;PRESERVE T1-4
	PUSHJ	P,XCTIO		;SEND TO LOG FILE
	 OUT	LOGC,		;XCT'D
	TLZ	F,FL$LOG	;!!EOT!!--NO MORE LOG FILE
	PUSHJ	P,.POP4T##	;RESTORE T1-4
	TLNE	F,FL$LOG	;IS LOG STILL ALIVE?
	 JRST	CHRLG0		;YES--GO STOW CHARACTER
	JRST	CLSLG2		;SKIP SOME

;HERE FROM THE /CLOSE SWITCH TO CLOSE THE FILE IF OPEN, ETC.

$CLOSE:	STORE	T1,LOGSPC,LOGSPC+.FXLEN-1,-1 ;RESET THE SPEC
	TLZ	F,FL$LOG	;IN CASE OPEN
	POPJ	P,		;RETURN BYPASSING STORE

CLSLOG:	TLNN	F,FL$LOG	;LOG OPEN?
	 POPJ	P,		;NO
	PUSHJ	P,CLGNTS	;DO A COUPLE OF NEW LINES TO SEPARATE
	PUSHJ	P,CLGNTS	;THE DIFFERENT RUNS
CLSLG2:	CLOSE	LOGC,		;CLOSE THE CHANNEL
	RELEASE	LOGC,
	TLZ	F,FL$LOG	;CERTAINLY NOT OPEN NOW
	MOVEI	T1,GBHR		;FREE BUFFERS
	PJRST	TSTBHR

;HERE TO OPEN LOG FILE

LOGOPN:	PUSHJ	P,.SAVE1##	;PRESERVE P1
	MOVE	T1,LOGSPC+.FXDEV;GET DEVICE NAME
	SOJN	T1,LOGO.2	;JUMP IF DEFAULT NOT NEEDED
	STORE	T1,LOGSPC,LOGSPC+.FXLEN-1,0 ;NEED DEFAULT--ZERO THE BLOC
	  MOVSI	T1,'DSK'	;USE A GOOD DEFAULT
	MOVEM	T1,LOGSPC+.FXDEV;REMEMBER WHAT WE DECIDED ON
LOGO.2:	MOVE	T1,[SIXBIT/COPYMT/] ;MY NAME IN CASE NEEDED
	SKIPN	LOGSPC+.FXNAM	;DEFAULT NEEDED?
	 SETOM	LOGSPC+.FXNMM
	SKIPN	LOGSPC+.FXNAM
	MOVEM	T1,LOGSPC+.FXNAM
	HRLOI	T1,'LOG'	;DEFAULT EXTENSION
	SKIPN	LOGSPC+.FXEXT	;SEE IF EXTENSION GIVEN
	 MOVEM	T1,LOGSPC+.FXEXT;NO--SET IT IN
	MOVE	T1,[XWD .FXLEN,LOGSPC] ;SETUP TO CONVERT SCAN BLOCKS
	MOVEI	T2,OPNBLK
	MOVE	T3,[XWD .RBTIM+1,LKPBLK]
	MOVEI	T4,PTHBLK
	MOVSI	P1,LOGSPC	;POINT TO SPEC IN CASE OF ERRORS
	PUSHJ	P,.STOPB##	;CONVERT TO SCAN BLOCKS
	 JRST	WLDERR		;GO DIE IF WILD
	MOVEI	T1,.RBTIM	;SETUP BLOCK NOW
	MOVEM	T1,LKPBLK+.RBCNT
	MOVEI	T1,.IOASC	;IN ASCII
	MOVEM	T1,OPNBLK+.OPMOD
	MOVSI	T1,GBHR		;POINT AT BUFFER HEADER
	MOVEM	T1,OPNBLK+.OPBUF
	OPEN	LOGC,OPNBLK	;GET THE CHANNEL
	 JRST	OPENER		;CAN'T--DIE
	MOVE	T2,OPNBLK+.OPDEV;GET THE DEVICE NAME
	DEVTYP	T2,		;SEE IF SPOOLED OR LOOKUP NOT NEEDED
	 JRST	LOGO.3		;WE'LL NEVER KNOW
	TXNE	T2,TY.MAN	;SEE IF LOOKUP/ENTER REQUIRED
	TXNE	T2,TY.SPL	 ;SEE IF SPOOLED
	 JRST	[SETZ	T1,	;SOME SORT OF SPOOLED DEVICE OR NO LKEN NEEDED
		JRST	LOGO.4]	;SKIP AHEAD
LOGO.3:	SETO	T1,		;FLAG THAT FILE EXISTS
	LOOKUP	LOGC,LKPBLK	;SEE IF FILE LIVES
	 JRST	[HRRZ	T1,LKPBLK+.RBEXT ;NO--GET FAIL CODE
		JUMPN	T1,LKENER ;JUMP IF REALLY AN ERROR
		JRST	.+1]	;NO--JUMP BACK IN TO ENTER FILE
LOGO.4:	ENTER	LOGC,LKPBLK	;WRITE THE FILE
	 JRST	LKENER		;CAN'T
	SKIPE	T1		;DON'T USETI IF FILE NOT FOUND
	USETI	LOGC,-1		;PREPARE TO APPEND TO FILE
	MOVSI	T1,N$LOGB	;SETUP # BUFFERS
	MOVE	T2,[XWD OPNBLK,GBHR]
	PUSHJ	P,.ALCBF##	;ALLOCATE BUFFERS
	OUTPUT	LOGC,		;DUMMY OUTPUT
	TLO	F,FL$TSN	;FORCE A TIME STAMP ON FIRST LINE
	POPJ	P,		;LOG FILE IS OPEN

;HERE TO PUT A TIME STAMP INTO THE LOG FILE

TIMSTM:	PUSHJ	P,.PSH4T##	;PRESERVE REGISTERS--NO TELLING WHAT MIGHT BE UP
	MOVEI	T1,CHRLOG	;SETUP THE ROUTINE
	PUSHJ	P,.TYOCH##
	PUSH	P,T1		;SAVE OLD ONE
	TLZ	F,FL$TSN	;PREVENT RECURSING TO OVERFLOW
	PUSHJ	P,.TTIMN##	;TYPE THE TIME
	PUSHJ	P,.TSPAC##
	PUSHJ	P,.TSPAC##
	POP	P,T1
	PUSHJ	P,.TYOCH##	;RESET OUTPUT ROUTINE
	PJRST	POP4J		;RESTORE REGS AND RETURN
SUBTTL	OPEN FILES

OPNOUT:	MOVEI	T1,OUTSPC	;POINT AT SPEC
	PUSHJ	P,OPENIO	;OPEN IT
	CAI	OUTC,@OBHR(.IOBIN)
	PUSHJ	P,.SAVE3##	;SAVE P1-3
	TLNE	F,FL$DSO	;DSK OUTPUT?
	 JRST	OPNO$1		;YES--SKIP SOME
	MOVEI	T1,MODIND	;GET INDUSTRY MODE VALUE
	TLNE	F,FL$232	;/TO32?
	 MOVEM	T1,OUTMOD	;YES--THIS IS THE MODE
	MOVEI	P1,OUTC		;NO--GET MTCHR.
	MTCHR.	P1,
	 SETZ	P1,		;SNH
	MOVEI	P2,OUTSPC	;GET FDB ADDRESS
	MOVEI	P3,OUTC		;CHANNEL FOR SETCHR
	PUSHJ	P,SETCHR	;SET DENSITY,PARITY AND MODE
	GETSTS	OUTC,T1		;GET CURRENT STATUS
	SETSTS	OUTC,IO.UWC(T1)	;TELL MON TO USE MY WORD COUNT
OPNO$1:	MOVE	T1,NOBUFS	;GET USER VALUE FOR OBUFS
	TLNE	F,FL$DSO	;IF DSK OUTPUT
	MOVEI	T1,N$DSKB	;SPLURGE A LITTLE
	TLNN	F,FL$232	;/TO32?
	 JRST	OPNO$2		;NO
	SKIPG	T2,BUFSIZ	;YES--GET /BUFSIZ VALUE
	 MOVEI	T2,DF$BFZ	;NONE--USE DEFAULT
	IMULI	T2,^D9		;# 9-BIT BYTES/WORD
	IDIVI	T2,^D8		;# WORDS TO HOLD 8 4-BIT BYTES/WORD
	ADDI	T2,1		;IN CASE OF PARTIAL WORD
	SAVE$	BUFSIZ		;SAVE GIVEN BUFSIZ FOR INPUT OPEN
	MOVEM	T2,BUFSIZ	;SET AS THE BUFFERSIZE FOR BOTH
	JSP	L,STBUFZ	;SET UP # BUFFERS AND BUFFER SIZE
	RESTR$	BUFSIZ		;PUT BUFSIZ BACK
	SKIPA			;SKIP CALL TO STBUFZ
OPNO$2:	JSP	L,STBUFZ	;SET UP # BUFFERS AND BUFFER SIZE IN T1
	SKIPA	T2,.+1
	XWD	OPNBLK,OBHR	;FOR .ALCBF
	PUSHJ	P,.ALCBF##	;ALLOCATE BUFFERS
	OUT	OUTC,		;DUMMY OUTPUT
	JFCL			;(IN CASE)
	MOVSI	T1,(BF.IBC)	;GET INHIBIT BUFFER CLEARING BIT
	IORM	T1,OBHR+.BFADR	;SET IN BUFFER HEADER
	TLO	F,FL$OPN	;OUTPUT IS OPEN
	POPJ	P,
OPNINP:	MOVEI	T1,INPSPC	;POINT AT INPUT SPEC
	PUSHJ	P,OPENIO	;OPEN ETC
	CAI	INPC,IBHR(.IOBIN)
	PUSHJ	P,.SAVE3##	;SAVE P1-3
	TLNE	F,FL$DSI	;DSK INPUT?
	 JRST	OPNI$1		;YES
	MOVEI	P1,INPC		;CHANNEL FOR MTCHR.
	MTCHR.	P1,		;GET ARGS
	 SETZ	P1,		;SNH
	MOVEI	P2,INPSPC	;FDB ADDR
	MOVEI	P3,INPC		;INPUT CHANNEL
	MOVEI	T1,MODBIN	;GET MODE BINARY VALUE
	TLNE	F,FL$232	;/TO32?
	MOVEM	T1,INPMOD	;YES--SET INPUT MODE
	PUSHJ	P,SETCHR	;SET DENSITY,PARITY, AND MODE
	SKIPLE	RTRYFL		;GET RETRY FLAG
	 JRST	[GETSTS	INPC,T1	;AND SET NO RETRY IF DESIRED
		SETSTS	INPC,IO.NRC(T1);TELL TAPSER TO NOT RETRY
		JRST	.+1]	;JUMP IN AGAIN
OPNI$1:	MOVE	T1,NIBUFS	;GET USER VALUE
	TLNE	F,FL$DSI	;DSK INPUT?
	 MOVEI	T1,N$DSKB	;RUN FAST
	JSP	L,STBUFZ	;SET UP # BUFFERS AND BUFSIZ IN T1
	SKIPA	T2,.+1
	XWD	OPNBLK,IBHR
	PUSHJ	P,.ALCBF##	;ALLOCATE BUFFER
	MOVSI	T1,(BF.IBC)	;GET INHIBIT BUFFER CLEARING BIT
	IORM	T1,IBHR+.BFADR	;SET IN BUFFER HEADER
	POPJ	P,

INPCLS:	CLOSE	INPC,		;CLOSE INPUT
	RELEASE	INPC,		;FREE CHANEL
	MOVEI	T1,IBHR		;GET BHR
;	PJRST	TSTBHR		;RELEASE BUFFERS

TSTBHR:	SKIPN	(T1)		;USE IT?
	POPJ	P,		;NO--DONE
	SAVE$	T1		;YES--SAVE IT A SEC
	PUSHJ	P,.FREBF##	;FREE BUFFERS
	RESTR$	T1		;GET BHR ADDR
	SETZM	.BFADR(T1)
	SETZM	.BFPTR(T1)
	SETZM	.BFCTR(T1)
	POPJ	P,

OUTCLS:	TLZN	F,FL$OPN	;IS OUTPUT OPEN?
	 POPJ	P,		;NO--QUIT BEFORE WE DIE
	GETSTS	OUTC,T1		;GET I/O STATS
	TRZ	T1,IO.UWC	;CLEAR USER WORD COUNT
	SETSTS	OUTC,(T1)	;ELSE MON WRITES AN EXTRA RECORD!!
	CLOSE	OUTC,
	RELEASE	OUTC,
	MOVEI	T1,OBHR
	JRST	TSTBHR
LPTCLS:	CLOSE	LPTC,
	RELEASE	LPTC,
	MOVEI	T1,LBHR
	PJRST	TSTBHR

STBUFZ:	SKIPG	T1		;DID USER SPECIFY BUFFER COUNT?
	MOVEI	T1,N$BUFS	;NO--USE DEFAULT
	SKIPG	T2,BUFSIZ	;HOW ABOUT BUFSIZ?
	 MOVEI	T2,DF$BFZ	;NO--DEFAULT
	HRLI	T1,(T2)		;POSITION
	MOVS	T1,T1		;AND SWAP SIDES
	JRST	(L)		;RETURN
;CALL HERE TO COMPLAIN ABOUT TAPE BEING WRITE LOCKED

WRTLOK:	MOVE	T1,OUTSPC+.FXDEV;GET NAME
	OPER$	EF$WRN!EF$SIX,MWL,<MTA IS WRITE LOCKED - >
	OPER$	EF$FTL,JAB,<JOB ABORTED>
REPEAT 0,<
	OPER$	EF$INF,WEG,<PLEASE WRITE-ENABLE AND TYPE ANY CHARACTER>
	PUSHJ	P,GCHNWL	;GET CHAR AND .TCRLF
	GETSTS	OUTC,T1		;GET STATUS
	TRZ	T1,IO.IMP	;CLEAR IO.IMP WHICH GOT US HERE
	SETSTS	OUTC,(T1)	;AND TELL MON
	POPJ	P,		;NO--OK TO CONTINUE NOW
>;END REPEAT 0

;ROUTINE TO OPEN OUTPUT WITH NO BUFFERS -- FOR TAPE POSITIONING

OPONOB:	MOVEI	T1,.IODMP	;DUMP MODE -- WHY NOT?
	MOVE	T2,OUTSPC+.FXDEV;DEV NAME
	SETZ	T3,		;NO BUFFERS
	OPEN	OUTC,T1		;DO IT
	SKIPA	T1,[OUTSPC]	;ERROR
	POPJ	P,
	JRST	E$$COD		;TELL OF FAILURE

OPINOB:	MOVEI	T1,.IODMP	;OPEN INPUT WITH NO BUFFERS
	MOVE	T2,INPSPC+.FXDEV;NAME
	SETZ	T3,		;NO BUFFERS
	OPEN	INPC,T1		;DO IT
	 SKIPA	T1,[INPSPC]	;FAILED!
	POPJ	P,		;RETURN
	JRST	E$$COD		;CAN'T OPEN DEVICE
SUBTTL	SET TAPE CHARACTERISTICS

;SETCHR -- SET CHARACTERISTICS
;CALL --	MOVE	P1,<RESULT OF MTCHR.>
;		MOVEI	P2,<FDB>
;		MOVEI	P3,<CHANNEL>
;		PUSHJ	P,SETCHR

SETCHR:	LDB	T1,[POINTR (.FXMOD(P2),FX.DEN)] ;GET THE DENSITY
	JUMPE	T1,SETCH1	;JUMP IF NO DENSITY GIVEN
	XCT	DENDIS(T1)	;CHECK LEGALITY AND SETUP T4
	MOVE	T1,[XWD 3,T2]	;ARG WORD FOR TAPOP.
	MOVEI	T2,.TFDEN+.TFSET;FUNCTION
	MOVE	T3,P3		;CHANNEL NUMBER
	PUSHJ	P,DOTPOP	;DO TAPOP AND HANDLE ERROR
SETCH1:	LDB	T1,[POINTR (.FXMOD(P2),FX.PAR)] ;GET PARITY VALUE
	XCT	PARDIS(T1)	;SET THE PARITY
IFN FT$TST,<
	SKIPL	TESTFL		;IF /TEST OR /TAPTST THEN IGNORE MODE
	POPJ	P,		;IGNORE IT
>;END IFN FT$TST
	SKIPG	T1,MODES-1(P3)	;/MODE FOR THIS SIDE?
	 POPJ	P,		;NO--QUIT
	XCT	MODISP-1(T1)	;YES--GET TAPOP. ARGUMENT
	MOVE	T1,[XWD 3,T2]	;TAPOP. ARG WORD
	MOVEI	T2,.TFMOD+.TFSET;FUNCTION
	MOVE	T3,P3		;CHANNEL
	PUSHJ	P,DOTPOP	;DO TAPOP
	POPJ	P,		;DONE WITH SETS

PARDIS:	JFCL			;ODD PARITY IS THE DEFAULT
	PUSHJ	P,EVNPAR	;EVEN--MUST SET IT
EVNPAR:	MOVE	T1,[XWD 3,T2]	;ARG FOR TAPOP.
	MOVEI	T2,.TFPAR+.TFSET;FUNCTION+SET
	MOVE	T3,P3		;CHANNEL
	MOVEI	T4,1		;EVEN PARITY
	PUSHJ	P,DOTPOP	;SET IT
	POPJ	P,

DENDIS:	JFCL			;0--SHOULD BE COVERED ABOVE
	PUSHJ	P,DEN200	;1--200 BPI--7 TRACK ONLY
	PUSHJ	P,DEN556	;2--556 BPI--7 TRACK ONLY
	MOVEI	T4,.TFD80	;3--800 BPI--7/9 TRACK
	PUSHJ	P,DEN160	;4--1600 BPI--9 TRACK ONLY
	PUSHJ	P,DEN625	;5--6250 BPI--9 TRACK ONLY
DEN556:
DEN200:	TRNN	P1,MT.7TR	;MUST BE 7 TRACK
E$$ID9:	 ERROR.	EF$FTL,ID9,<ILLEGAL DENSITY FOR 9-TRACK>
	MOVE	T4,T1		;SET DENSITY
	POPJ	P,

DEN625:
DEN160:	TRNE	P1,MT.7TR	;CAN'T BE 7 TRACK
	 ERROR.	EF$FTL,ID7,<ILLEGAL DENSITY FOR 7-TRACK>
	MOVE	T4,T1		;SET DENSITY
	POPJ	P,

MODISP:	PUSHJ	P,DEFMOD	;1--DEC COMPATIBLE CORE DUMP (/MODE:BINARY)
	PUSHJ	P,INDMOD	;2--INDUSTRY COMPATIBLE 8BIT (/MODE:INDUST)
	PUSHJ	P,MODSVN	;3--SEVENBIT MODE (/MODE:SEVEN) TU70 ONLY

MODSVN:	TRNE	P1,MT.7TR	;NOT ON 7 TRACK
E$$IM7:	ERROR.	EF$FTL,IM7,<ILLEGAL MODE FOR 7-TRACK>
	MOVEI	T4,.TFM7B	;SET SEVEN BIT MODE
	POPJ	P,

INDMOD:	TRNE	P1,MT.7TR	;NOT ON 7
	JRST	E$$IM7		;TSK,TSK
	MOVEI	T4,.TFM8B	;8 BIT FORMAT
	POPJ	P,

DEFMOD:	TRNE	P1,MT.7TR	;SEVEN OR NINE?
	 SKIPA	T4,[.TFM7T]	;SEVEN
	MOVEI	T4,<.TFM9T==1>	;NO--NINE
	POPJ	P,
;DOTPOP -- DO TAPOP WITH ERROR REPORTING
;CALL:	MOVE	T1,[TAPOP. ARG BLOCK]
;	MOVEI	T2,<TAPOP. FN>
;	MOVE	T3,<TAPNAM,IOCHAN OR WHATEVER>
;	MOVE	T4,<ARG>
;	PUSHJ	P,DOTPOP
;	*RETURN*


DOTPOP:	TAPOP.	T1,		;DO THE UUO
	 CAIA			;FAILED--SKIP OVER TO REPORT ERROR
	POPJ	P,		;OK--QUIT NOW

;ETAPOP -- REPORT TAPOP. UUO FAILURE
;SEE DOTPOP FOR CALLING SEQUENCE

ETAPOP:	SAVE$	<T4,T3,T2,T1>	;SAVE T1-4 IN CONSPICUOUS PLACE
	WARN.	EF$OCT!EF$NCR,TUF,<TAPOP. UUO FAILURE--CODE = >
	STRNG$	<, FN = >
	MOVE	T1,-1(P)	;GET FUNCTION (WAS IN T2)
	PUSHJ	P,.TOCTW##	;
	PUSHJ	P,.TCRLF##
	RESTR$	<T1,T2,T3,T4>
	POPJ	P,
SUBTTL	DO THE REQUIRED STUFF

DO.IT:	
	PUSHJ	P,.SAVE4##	;SAVE THE REGISTERS
	MOVE	PLP,PLPINI	;SETUP PARM LIST PTR
	STORE	T1,FW$STS,LW$STS,0 ;CLEAR STATUS WORDS
	TDZA	P4,P4		;CLEAR I/O FLAG (SET TO 2 WHEN INPUT)
OUTDUN:	MOVEI	P4,2		;SET I/O FLAG TO 2 (OUTPUT SWTCHES DONE)
DANTHR:
	JSP	L,TYICHK	;SEE ABOUT TTY COMMANDS
	 JRST	DO.DUN		;SAID TO KILL THE COMMAND
	MOVE	ACT,1(PLP)	;GET THE FUNCTION
	ADDI	PLP,2		;MOVE TO NEXT FUNCTION
	JUMPL	ACT,@ACTDIS(ACT) ;DISPATCH IMMEDIATELY IF INTERNAL FUNCTION
	MOVE	P1,ACT		;COPY FOR ACTDIS XCT
	SUBI	ACT,1		;COMPUTE ACT CORRECTLY FOR DOLOOP
	IMULI	ACT,4		;...
	ADD	ACT,P4		;ADD IN OFFSET FOR INPUT/OUTPUT
	HLRZ	P2,0(PLP)	;GET (POSSIBLE) FILE COUNT
	HRRZ	P3,0(PLP)	;GET (POSSIBLE) RECORD COUNT
	JRST	@ACTDIS(P1)	;DISPATCH FOR ACTION

	JRST	DO.DUN		;(-2) ALL DONE
	JRST	OUTDUN		;(-1) OUTPUT DONE--INPUT ACTION NEXT
ACTDIS:	HALT	.		;(0)  ILLEGAL

	DEFINE FN (X)
<IRP X,<EXP DO.'X>>

	FUNCTS			;GENERATE THE DISPATCH TABLE
DO.BSP:	DO.SKP:	DO.EOF:
DO.REW:	DO.UNL:
DOLOOP:	JUMPLE	P2,DOLOP2	;JUMP IF NO MORE FILES
DOLOP1:	XCT	ACTABL(ACT)	;DO THE ACTION
IFN FT$MTP,<
	TLNE	F,FL$MTP	;MTAPE COMMAND?
	 JRST	WAITCK		;YES
>;END IFN FT$MTP
	MTWAT.	INPC,		;WAIT FOR THINGS TO STOP
	TLNE	F,FL$OPN	;ONLY WAIT ON OUTPUT IF OPEN
	MTWAT.	OUTC,
	SOJG	P2,DOLOP1	;DO ALL FILES
DOLOP2:	JUMPLE	P3,DANTHR	;NO RECORDS?
DOLOP3:	XCT	ACTABL+1(ACT)	;DO ACTION 
IFN FT$MTP,<
	TLNE	F,FL$MTP	;MTAPE
	 JRST	WAITCK		;YES
>;END IFN FT$MTP
	MTWAT.	INPC,
	TLNE	F,FL$OPN	;MAKE SURE CHAN IS OPEN
	MTWAT.	OUTC,
	SOJG	P3,DOLOP3
	JRST	DANTHR

IFN FT$MTP,<	;HERE TO DECIDE IF WE WAIT OR NOT

WAITCK:	SOJG	P2,MTPWAT	;WAIT IF MORE FILES TO DO
	SOJG	P3,MTPWAT	;OR MORE RECORDS
	HRROI	T1,FN$EOL	;GET END OF LIST MARKER
	CAMN	T1,1(PLP)	;WAIT IF NOT END OF LIST
	 JRST	DANTHR		;END OF LIST--GO EXEC IT
MTPWAT:	MTWAT.	INPC,		;WAIT FOR OP TO FINISH
	JUMPG	P2,DOLOP1	;JUMP IF MORE FILES
	JUMPG	P3,DOLOP3	;JUMP IF MORE RECORDS
	JRST	DANTHR		;NO--DO NEXT COMMAND
>;END IFN FT$MTP
SUBTTL	END OF PROCESSING

;HERE WHEN WE ARE ALL DONE

DO.DUN:	TLZE	F,FL$LPO	;LPT FILE OPEN?
	PUSHJ	P,LPTCLS	;YES--CLOSE IT
	PUSHJ	P,INPCLS	;CLOSE INPUT FILE
	TLNE	F,FL$MRG!FL$DSO	;MERGING? (OR DSK OUTPUT?)
	 JRST	DODUN1		;YES--NO EOF TO BSP OVER
	TLNE	F,FL$EOT	;DID WE STOP AT DOUBLE EOF?
	 MTBSF.	OUTC,		;YES--BACK OVER ONE OF THEM
DODUN1:	PUSHJ	P,OUTCLS	;CLOSE OUTPUT
IFN FT$MTP,<
	TLNE	F,FL$MTP	;MTAPE COMMAND?
	POPJ	P,		;YES--RETURN NOW
>;END IFN FT$MTP
	SKIPLE	TIMEFL		;IF REQUESTED
	PUSHJ	P,TYISTS	;TELL TOTAL TIME + CPU TIME USED
	SKIPG	TIMEFL		;IF TIME NOT REQUESTED
	PUSHJ	P,TYITOT	;THEN SHOW FILE, RECORD COUNTS NOW
ERRCHK:	MOVEI	P1,1		;SET INDEX TO REPORT ERRORS
TELERS:	MOVE	T1,ERRCNT(P1)	;GET COUNT
	INFO.	EF$NCR!EF$DEC,IOT,<TOTAL OF >
	MOVE	T1,ERRMES(P1)	;END THE MESSAGE
	PUSHJ	P,.TSTRG##	;...
	PUSHJ	P,.TCRLF##	;NEW LINE
IFN FT$TST,<	;ONLY DO OUTPUT IF /T
	TLNN	F,FL$TST	;/T?
>;END IFN FT$TST
	SOJGE	P1,TELERS	;TELL INPUT TOO
	POPJ	P,		;**DO.IT RETURN
ERRMES:	[ASCIZ	/ INPUT ERRORS]/]
	[ASCIZ	/ OUTPUT ERRORS]/]
SUBTTL	PROCESS TELETYPE COMMANDS WHILE RUNNING

;TYICHK -- ATTEND TO TTY INPUT FROM TERMINAL
;CALL:	JSP	L,TYICHK
;	*USER SAID TO QUIT*
;	*KEEP GOING*

TYICHK:	TLNN	F,FL$BAT!IFN FT$MTP,<FL$MTP> ;BATCH JOB?
	 TLNN	F,FL$ITY	;OR NOT /IFTYP
	 JRST	1(L)		;YES--RETURN QUICKLY
	INCHRS	T1		;CHAR TYPED?
	 JRST	1(L)		;NO--QUICK RETURN
	CLRBFI			;YES--EAT THE REST
	ADDI	L,1		;BUMP TO RETURN
	SAVE$	L		;REMEMBER IT ON THE STACK
	PUSHJ	P,.TCRLF##	;NEW LINE -- .TCRLF SAVES T1
	MOVSI	T2,-N$TYIO	;GET AOBJN LOOP CTR
	CAME	T1,IFTCHR(T2)	;THIS IT?
	AOBJN	T2,.-1
	JUMPL	T2,@TYIDSP(T2)	;JUMP IF GOT ONE
	MOVEI	T1,.CHBEL	;NO--GET A BELL
	PJRST	.TCHAR##	;BELL AND RETURN

IFTCHR:	EXP	"E","I","K","P","S"	;ERROR COUNT,IGNORE, KILL, PAUSE,STATS
	N$TYIO==.-IFTCHR

TYIDSP:	EXP	ERRSUM,TYIIGN,TYIKIL,TYIPAU,TYISTS

TYIIGN:	TLZ	F,FL$ITY	;CLEAR IFTYP FLAG
	POPJ	P,		;SKIP BACK

ERRSUM:	PUSHJ	P,.SAVE1##	;WE USE P1 FOR THIS
	PJRST	ERRCHK		;TELL ERROR SUMMARIES

TYIPAU:	INFO.	0,PTC,<PAUSING--TYPE ANY CHARACTER TO CONTINUE>
	PJRST	GCHNWL		;GET IT AND RETURN

TYIKIL:	WARN.	0,FKC,<FUNCTION KILLED BY COMMAND>
	SOS	0(P)		;CPOPJ PLEASE
	POPJ	P,		;CPOPJ TO DO A KILL

TYISTS:	MSTIME	T1,		;CURRENT TYME
	SUB	T1,GOTIME	;GET ELAPSED TIME
	PUSHJ	P,.TTIME##	;TYPE IT
	STRNG$	< ELAPSED TIME
>
	SETZ	T1,		;MY RUNTIME
	RUNTIM	T1,
	SUB	T1,GORUNT	;ELAPSED RUNTIME
	PUSHJ	P,.TTIME##	;TYPE IT
	STRNG$	< CPU TIME
>

TYITOT:	TLNE	F,FL$TST	;ARE WE TESTING TAPE?
	 POPJ	P,		;YES--WE REALLY SHOULD NOT BE HERE
	SKIPG	T1,FILTOT	;ANY FILES TODAY?
	 JRST	TYIT.2		;NO
	PUSHJ	P,.TDECW##	;YES--SHOW THEM
	STRNG$	< FILES, >
TYIT.2:	MOVE	T1,RECTOT	;GET RECORD TOTAL
	PUSHJ	P,.TDECW##
	PJSP	T1,.TSTRG##	;TYPE AND RETURN
	ASCIZ	. RECORDS COPIED
.
;HERE TO SET UP FOR MERGING

DO.CON:	TLNN	F,FL$DSO	;UNLESS DSK OUTPUT
	 TLO	F,FL$MRG	;FLAG WE ARE MERGING
				;(WILL HANDLE OTHER CORRECTLY)

;HERE TO COPY DATA FROM INPUT TO OUTPUT

DO.CPY:
	TLNE	F,FL$DSI	;DSK TO TAPE?
	 JRST	[SETZ	P2,	;YES--MAKE SURE FILE COUNT IS 0
		JRST	CPYDTM]	;AND GO COPY DSK TO TAPE
	TLNE	F,FL$DSO	;NO--TAPE TO DSK
	 JRST	CPYMTD		;YES
	TLNN	F,FL$OPN	;MAKE SURE OUTPUT TAPE IS OPEN
	PUSHJ	P,OPNOUT	;GOOD THING WE CHECKED
COPYIT:	SKIPG	P2		;FILE COUNT NOT ZERO?
	SOJL	P3,COPDUN	;YES--RECORDS RUN OUT?
	PUSHJ	P,XCTIO		;NO--GET A BUFFER
	 IN	INPC,		; XCT'D
	  JRST	CPYEOF		;END OF FILE
	TLNE	F,FL$232	;/TO32 BIT?
	 JRST	CPY232		;YES--GO THERE
	HRLZ	T1,IBHR+.BFPTR	;COPY FROM INPUT
	HRR	T1,OBHR+.BFPTR	;TO OUTPUT BUFFER
	AOBJP	T1,.+1		;BUT THEY ARE OFF BY ONE!
	MOVE	T2,IBHR+.BFCTR	;GET THE INPUT COUNT
	HRRM	T2,-1(T1)	;SET COUNT FOR MONITOR--IO.UWC IS ON
	ADDM	T2,IBHR+.BFPTR	;INCREASE THE POINTER
	ADDB	T2,OBHR+.BFPTR	;AND GET BLT TERMINATION PTR
	SETZM	IBHR+.BFCTR	;CLEAR COUNTER
	BLT	T1,(T2)		;COPY THE BUFFER
CPYDMP:	PUSHJ	P,XCTIO		;OUTPUT IT
	 OUT	OUTC,		;...
	  JRST	FULTAP		;HELP! TAPE IS FULL
	TLZ	F,FL$EOT	;FLAG DID OUTPUT (SET AT EOF ON INPUT)
	AOS	RECTOT		;COUNT RECORD
	JSP	L,TYICHK	;SEE ABOUT USER INPUT
	 JRST	DO.DUN		;YES--SAID TO KILL IT
	JRST	COPYIT		;LOOP FOR MORE
SUBTTL	COPY 36-BIT TO 32 BIT

CPY232:	PUSHJ	P,THRTY2	;CALL A ROUTINE SO WE CAN SAVE REGISTERS
	JRST	CPYDMP		;GO DUMP THE BUFFER

THRTY2:	PUSHJ	P,.SAVE3##	;SAVE SOME REGISTERS
	MOVE	P1,IBHR+.BFCTR	;INPUT WORD COUNT
	IMULI	P1,^D9		;# 4-BIT BYTES
	MOVSI	P2,(POINT 4)	;SETUP 4-BIT BYTE PTR
	HRR	P2,IBHR+.BFPTR	;GET THE PTR
	HRRI	P2,1(P2)	;POINT AT THE DATA
	MOVSI	P3,(POINT 8)	;FORM BYTE PTR TO STORE 8-BIT BYTES
	HRR	P3,OBHR+.BFPTR
	HRRI	P3,1(P3)

LUP32:	ILDB	T1,P2		;GET A BYTE
	LSH	T1,4		;POSITION TO HIGH FOUR BITS
	ILDB	T2,P2		;GET NEXT BYTE
	OR	T1,T2		;FORM A WORD
	IDPB	T1,P3		;STORE 8 BITS
	SUBI	P1,2		;COUNT BYTES USED
	JUMPG	P1,LUP32	;JUMP IF NOT DONE YET

	HRRZ	T1,OBHR+.BFPTR	;GET THE OUTPUT PTR
	MOVEI	T2,(P3)		;BEGIN TO COMPUTE WORDS TO OUTPUT
	SUBI	T2,(T1)		;COMPUTE THEM
	HRRM	T2,(T1)		;SET FOR IO.UWC
	MOVE	T1,IBHR+.BFCTR	;GET INPUT WORD COUNT
	SETZM	IBHR+.BFCTR	;CLEAR INPUT WORD COUNT
	ADDM	T1,IBHR+.BFPTR	;LET MON KNOW WE USED THE BUFFER UP
	POPJ	P,		;RETURN TO WRITE BUFFER
SUBTTL	COPY DSK TO MAGTAPE IN PHYSICS (IREAD) FORMAT

CPYDTM:	JSP	L,TYICHK	;SEE ABOUT THE TTY
	 JRST	DO.DUN		;SAID TO KILL
	SOJL	P3,COPDUN	;DONE COPYING RECORDS? (OR WHOLE FILE?)
CPDM$A:	JSP	L,CKIBUF	;MAKE SURE BUFFER HAS GOODIES
	 JRST	CPYEOF		;DONE--EOF
	ILDB	T3,IBHR+.BFPTR	;RECORD LENGTH
	SOS	IBHR+.BFCTR	;COUNT WHAT WE READ
	JUMPE	T3,CPDM$A	;IGNORE 0 LENGTH RECORDS (PROBABLY ERROR)
	TLNE	T3,-1		;NO RECORDS THIS LONG EITHER!
	 JRST	CPDM$A		;WE ARE PROBABLY LOST...
	MOVE	T2,OBHR+.BFADR	;ADDRESS CURRENT BUFFER
	HRRM	T3,1(T2)	;SET FOR IO.UWC
	MOVEM	T3,LSTBFZ	;SAVE IN CASE OF TOO LARGE RECORD

CPDM$0:	JSP	L,CKIBUF	;MAKE SURE SOMETHING IN INPUT BUFFER
	JRST	CPYEOF		;DSK END OF FILE
	MOVE	T1,IBHR+.BFCTR	;GET COUNT IN BUFFER
CPDM$1:	CAIGE	T3,(T1)		;CAN WE MOVE IT ALL?
	 MOVEI	T1,(T3)		;NO--JUST PART
	HRLZ	T2,IBHR+.BFPTR	;INPUT ADDRESS
	HRR	T2,OBHR+.BFPTR	;TO OUTPUT
	AOBJP	T2,.+1		;OFF BY ONE THO
	ADDM	T1,IBHR+.BFPTR	;UPDATE PTRS
	ADDM	T1,OBHR+.BFPTR	;...
	MOVN	T1,T1		;- COUNT
	ADD	T3,T1		;UPDATE WDS TO GO
	ADDM	T1,IBHR+.BFCTR	;UPDATE COUNTS
	ADDB	T1,OBHR+.BFCTR	;AND CHECK FOR REC TOO LARGE
	 JUMPL	T1,BFTSML	;JUMP IF TOO SMALL
	BLT	T2,@OBHR+.BFPTR	;MOVE WORDS
	JUMPG	T3,CPDM$0	;JUMP IF REC NOT DONE
	AOS	RECTOT		;COUNT THE RECORD
	PUSHJ	P,XCTIO		;YES--DUMP THE RECORD
	 OUT	OUTC,
	JRST	FULTAP		;GET ANOTHER TAPE
	JRST	CPYDTM		;DO NEXT RECORD

BFTSML:	MOVE	T1,LSTBFZ	;GET SIZE OF OFFENDER
	ERROR.	EF$DEC!EF$FTL,BTS,<MTA BUFFER TOO SMALL FOR REC LENGTH = >
SUBTTL	COPY MAGTAPE TO DSK FILE (IREAD FORMAT)

CPYMTD:	SKIPG	P2		;FILES LEFT
	SOJL	P3,COPDUN	;OR RECORDS
	JSP	L,CKIBUF	;YES--SEE IF INPUT THERE
	 JRST	CPYEOF		;ALL DONE
	JSP	L,TYICHK	;SEE ABOUT TTY
	 JRST	 DO.DUN		;SAID TO HANG IT UP
	AOS	RECTOT		;COUNT RECORDS COPIED
	MOVE	T4,IBHR+.BFCTR	;GET SIZE OF RECORD
	SKIPLE	OBHR+.BFCTR	;ROOM TO STORE WORD COUNT?
	 JRST	CPMD$0		;YES
	PUSHJ	P,XCTIO		;NO
	 OUT	OUTC,
	 JRST	E$$DIF		;**DSK IS FULL
	TLZ	F,FL$EOT	;WE HAVE WRITTEN DATA

CPMD$0:	IDPB	T4,OBHR+.BFPTR	;STORE IN OUTPUT
	SOS	OBHR+.BFCTR	;COUNT IT

CPMD0A:	SKIPG	IBHR+.BFCTR	;ANY WORDS LEFT THIS RECORD?
	 JRST	CPYMTD		;NO--GET NEXT RECORD

CPMD$1:	SKIPLE	OBHR+.BFCTR	;ROOM IN OUTPUT?
	 JRST	CPMD$2		;YES
	PUSHJ	P,XCTIO		;NO--DUMP BUFFER
	 OUT	OUTC,
	 JRST	E$$DIF		;**DSK 	IS FULL
	TLZ	F,FL$EOT	;WE HAVE WRITTEN DATA

CPMD$2:	MOVE	T1,IBHR+.BFCTR	;GET INPUT COUNT
	CAMLE	T1,OBHR+.BFCTR	;ROOM FOR IT ALL?
	 MOVE	T1,OBHR+.BFCTR	;NO--MOVE WHAT WE CAN
	HRLZ	T2,IBHR+.BFPTR	;SETUP AOBJN WORD
	HRR	T2,OBHR+.BFPTR	;...
	AOBJP	T2,.+1		;OFF BY ONE AS USUAL
	ADDM	T1,IBHR+.BFPTR	;UPDATE PTRS
	ADDM	T1,OBHR+.BFPTR
	MOVN	T1,T1		;- COUNT
	ADDM	T1,IBHR+.BFCTR	;UPDATE COUNTERS
	ADDM	T1,OBHR+.BFCTR
	BLT	T2,@OBHR+.BFPTR	;MOVE DATA
	JRST	CPMD0A		;LOOP FOR REST OF RECORD

E$$DIF:	ERROR.	EF$ERR,DIF,<DSK IS FULL -- ABORTING>
	JRST	DO.DUN

;CKIBUF -- SEE IF ANY INPUT THERE AND DO IN IF NOT
;CALL:	JSP	L,CKIBUF
;	 *EOF*
;	*DATA IN BUFFER*

CKIBUF:	SKIPLE	IBHR+.BFCTR	;ANYTHING THERE?
	 JRST	1(L)		;YES--SKIP BACK
	PUSHJ	P,XCTIO		;NO--GET NEXT RECORD
	 IN	INPC,		;XCT'D
	JRST	(L)		;EOF
	JRST	1(L)		;GOT DATA
;THIS TABLE IS XCT'D TO DO THE PROPER FUNCTION
;THE ORDER IS:
;	OUTPUT FILE ACTION
;	OUTPUT RECORD ACTION
;	INPUT  FILE ACTION
;	INPUT  RECORD ACTION

ACTABL:	MTBSF.	OUTC,
	MTBSR.	OUTC,
	MTBSF.	INPC,
	MTBSR.	INPC,
	MTSKF.	OUTC,
	MTSKR.	OUTC,
	MTSKF.	INPC,
	MTSKR.	INPC,
	JSP	L,OMTEOF
	JSP	L,OMTEOF
	JSP	L,OMTEOF	;/EOF ON INPUT SIDE ONLY EOF'S OUTPUT TAPE
	JSP	L,OMTEOF	;...
	MTREW.	OUTC,
	MTREW.	OUTC,
	MTREW.	INPC,
	MTREW.	INPC,
	MTUNL.	OUTC,
	MTUNL.	OUTC,
	MTUNL.	INPC,
	MTUNL.	INPC,

OMTEOF:
IFN FT$MTP,<
	TLNE	F,FL$MTP	;MTAPE COMMAND?
	JRST	OMTEF1		;YES--EOF INPUT SIDE THEN
>;END IFN FT$MTP
	MTEOF.	OUTC,
	TLZ	F,FL$MRG	;NOT MERGING ANY MORE
	JRST	(L)
IFN FT$MTP,<
OMTEF1:	MTEOF.	INPC,		;EOF INPUT IF MTAPE CMD
	JRST	(L)		;RETURN
>;END IFN FT$MTP
COPDUN:	TLNE	F,FL$MRG	;MERGING?
	 JRST	DANTHR		;YES--CRUISE ON
	PUSHJ	P,OUTCLS	;CLOSE OUTPUT
	HRROI	T1,FN$EOL	;GET EOL FUNCTION
	CAMN	T1,1(PLP)	;END OF LIST FUNCTION NEXT?
	 TLZA	F,FL$EOT	;YES--DON'T REOPEN OUTPUT AND CLEAR FL$EOT
	PUSHJ	P,OPNOUT	;NO--REOPEN OUTPUT
	JRST	DANTHR		;GO PROCESS THE NEXT FUNCTION

;HERE ON INPUT END-OF-FILE

CPYEOF:	PUSHJ	P,INPCLS	;CLOSE INPUT
	TLOE	F,FL$EOT	;SET/CHECK EOT FLAG
	 JRST	DO.DUN		;YES--GO FINISH UP
	TLNE	F,FL$DSI	;DSK IN?
	JRST	CPYEFA		;YES--GO FINISH UP
	AOS	FILTOT		;COUNT A FILE AS DONE
	PUSHJ	P,OPNINP	;RE-OPEN INPUT
	TLNE	F,FL$MRG	;MERGING?
	SOJA	P2,COPYIT	;YES--DEC FILE COUNT AND GO
	TLNE	F,FL$DSO	;NO--DSK OUTPUT?
	 SOJA	P2,CPYMTD	;YES--CONTINUE THERE
	 PUSHJ	P,OUTCLS	;NO--CLOSE OUTPUT FILE
	SOJG	P2,CPYEF0	;JUMP IF MORE TO DO
	JUMPG	P3,CPYEF0	;OR IF MORE RECORDS
	TLZ	F,FL$EOT	;CLEAR EOT FLAG IN CASE MORE COPYING LATER
	JRST	DANTHR		;NO MORE COPYING--GO GET NEXT FUNCTION AND DISP
CPYEFA:	TLZ	F,FL$EOT	;NOTHING ELSE TO DO--CLEAR EOT FLAG FOR DO.DUN
	JRST	DO.DUN		;AND THEN GO THERE
CPYEF0:	PUSHJ	P,OPNOUT	;OPEN OUTPUT AGAIN
	JRST	COPYIT		;GO AGAIN
;HERE WHEN TAPE IS FULL

FULTAP:	GETSTS	OUTC,T1		;GET STS BITS
	 TRZ	T1,IO.EOT	;CLEAR SO WE CAN DUMP BUFFERS
	SETSTS	OUTC,(T1)	;TELL TAPSER
	OPER$	EF$WRN,OTF,<OUTPUT TAPE IS FULL>
	PUSHJ	P,OUTCLS	;CLOSE OUTPUT FILE (WRITE EOFS)
ASKEOO:	PUSHJ	P,TYPDLR	;TYPE CRLF-$ IF BATCH
	STRNG$	<OPTION (H FOR HELP): >
	PUSHJ	P,GCHNWL	;GET CHAR + .TCRLF
	MOVSI	T2,-N$EOTO	;AOBJN
	CAME	T1,EOTOPT(T2)	;CHECK THEM
	AOBJN	T2,.-1
	JUMPL	T2,@EOTDSP(T2)	;JUMP IF GOOD ANSWER
EOTHLP:	SKIPA	T1,.+1		;LOAD UP FILNAME
	SIXBIT	/CMTETH/	;COPYMT END-OF-TAPE HELP
	PUSHJ	P,TYHELP	;TYPE SOME HELP
	JRST	ASKEOO		;ASK AGAIN

EOTOPT:	EXP	"C","E","H","R","U"
	N$EOTO==.-EOTOPT

EOTDSP:	EXP	FULCON
	EXP	EOTXIT
	EXP	EOTHLP
	EXP	EOTREW
	EXP	EOTUNL

EOTXIT:	EXIT	1,		;EXIT TO MONITOR
	JRST	ASKEOO		;ON CONTINUE GO FOR ANOTHER ONE

EOTUNL:	PUSHJ	P,OPONOB	;OPEN -- NO BUFFERS
	MTUNL.	OUTC,		;UNLOAD
	JRST	EOTFIN		;CLOSE TAPE OUT
EOTREW:	PUSHJ	P,OPONOB	;OPEN WITH NO BUFFERS
	MTREW.	OUTC,		;REWIND MTA
EOTFIN:	RELEASE	OUTC,		;CLOSE DEVICE
	JRST	ASKEOO		;WAIT FOR CONTINUE

FULCON:	PUSHJ	P,OPNOUT	;OPEN OUTPUT TAPE
	TLNE	F,FL$DSI	;DSK INPUT?
	 JRST	CPYDTM		;YES--CONTINUE THERE, ELSE
	JRST	COPYIT		;CONTINUE COPYING
SUBTTL	TAPE TESTING

IFN FT$TST,<	;ALL UNDER FT$TST

TESTIT:	PUSHJ	P,.SAVE4##	;SAVE P1-4
TEST.2:	MTREW.	OUTC,		;REWIND OUTPUT TAPE
	SETZM	OUTERS		;CLEAR ERROR COUNT FOR "E" IFTYPE CMD
	TLO	F,FL$TST	;FLAG /T IN PROGRESS
	MOVE	T1,OUTSPC+.FXDEV;GET NAME
	INFO.	EF$SIX!EF$NCR,NTT,<TESTING >
	PUSHJ	P,.TCOLN##	;TYPE A COLON
	STRNG$	</RETRY:>
	SKIPG	T1,NUMTRY	;GET # TRIES
	 MOVEI	T1,DF$TRY	;NO--ON SECOND THOUGHT, USE THE DEFAULT
	MOVEM	T1,NUMTRY	;REMEMBER IT FOR LATER
	PUSHJ	P,.TDECW##	;TYPE # RETRIES
	STRNG$	</REPEAT:>	;TELL HOW MANY TIMES WE ARE REPEATING
	SKIPG	T1,RPETFL
	MOVEI	T1,1
	PUSHJ	P,.TDECW##
	STRNG$	</DENSITY:>
	MOVE	T1,TSTDEN	;GET TEST DENSITY
	MOVEI	T1,DENSTR-1(T1)	;GET ASCIZ STRING FOR IT
	PUSHJ	P,.TSTRG##	;SEND IT
	STRNG$	</TRACK:>
	MOVE	T1,ODVNAM	;GET REAL NAME
	MTCHR.	T1,		;SEE IF SEVEN OR NINE-TRACK
	 SETZ	T1,		;NEVER KNOW
	TRNE	T1,MT.7TR	;SEVEN?
	 SKIPA	T1,[EXP 7]
	 MOVEI	T1,^D9		;NINE
	PUSHJ	P,.TDECW##	;TYPE 7 OR 9
	MOVEI	T1,[ASCIZ/]
/]
	PUSHJ	P,.TSTRG##	;END INFO
	MTWAT.	OUTC,		;WAIT NOW WHILE TTY IS BUSY
	GETSTS	OUTC,T1		;GET STATUS
	SETSTS	OUTC,IO.NRC(T1)	;TELL TAPSER TO NOT RETRY
	SETZB	P1,P3		;P1=RECORD COUNT, P3=TOTAL ERRORS
	JSP	T1,RESTRY	;RESET THE RETRY COUNTER
	SKIPG	P4,TESTFL	;GET VALUE OF /TEST:N
	 HRLOI	P4,377777	;JUST /T...DO WHOLE TAPE
	PUSHJ	P,TSTBUF	;TEST THE TAPE
ENDTST:	PUSHJ	P,OUTCLS	;CLOSE OUTPUT
	PUSHJ	P,OPONOB	;OPEN FOR REWINDING
	SKIPG	TESTFL		;UNLESS USER ONLY WANTED PART TESTED
	MTREW.	OUTC,		;REWIND IT
	MOVE	T1,P3		;COPY ERROR COUNT
	INFO.	EF$DEC,TNE,<TOTAL NUMBER OF ERRORS = >
	MOVE	T1,P1		;REC TOTAL=LENGTH
	INFO.	EF$DEC!EF$NCR,TLI,<TAPE LENGTH = >
	MOVEI	T1,[ASCIZ/ FEET]
/]
	PUSHJ	P,.TSTRG##	;
	SKIPLE	TIMEFL		;IF /TIME
	PUSHJ	P,TYISTS	;THEN DO IT
IFN FT$DEB,<
	SOSG	T1,BUFZER	;SEE IF MON CLEARED BUFFERS DESPITE UU.IBC
	PJRST	TEST.4		;NO--FINISH UP
	INFO.	EF$DEC,MCB,<MON CLEARED BUF = >
>;END IFN FT$DEB
TEST4:	SKIPG	TESTFL		;IF USER SAID /TEST:N
	 SOSG	RPETFL		; OR /REPEAT:1 OR NO /REPEAT AT ALL
	  PJRST	OUTCLS		;  THEN JUST CLOSE OUTPUT AND RETURN
;***UNCOMMENT NEXT LINE IF WANT TO NOT DO MULTIPLE RETRIES IF TAPE OK
;	JUMPLE	P3,OUTCLS	;IF TAPE IS OK, THEN SKIP MULTIPLE PASSES
	PUSHJ	P,OUTCLS	;NO /TEST:N AND .GT. /REPEAT:1
	PUSHJ	P,OPNOUT	; SO REOPEN THE OUTPUT TAPE
	TLNN	F,FL$LOG	; ARE WE LOGGING ALL OF THIS?
	 JRST	TEST.2		;NO--JUST GO AHEAD
	PUSHJ	P,CLGNTS	;YES--SEPARATE THE RUNS
	PUSHJ	P,CLFLOG
	JRST	TEST.2		;GO TEST IT NOW

DENSTR:	ASCIZ	/200/		;1--200 BPI
	ASCIZ	/556/		;2--556
	ASCIZ	/800/		;3--800
	ASCIZ	/1600/		;4--1600
	ASCIZ	/6250/		;5--6250

RESTRY:	MOVN	P2,NUMTRY	;GET -(NUMBER OF RETRIES)
	HRLZ	P2,P2		;PUT IN THE LH FOR AN AOBJN
	JRST	(T1)		;RETURN
TSTBUF:	JSP	L,TYICHK	;SEE ABOUT USER INPUT
	POPJ	P,		;SAID TO KILL IT OFF
	SOJL	P4,.POPJ##	;CHECK FOR REC COUNT OUT
	MOVE	T1,OBHR+.BFPTR	;GET PTR
	MOVE	T2,OBHR+.BFCTR	;AND COUNT
	HRRM	T2,(T1)		;SET IN BUFFER SO IO.UWC WORKS
	SETZM	OBHR+.BFCTR	;IN CASE IO.UWC DOESN'T WORK
	ADDB	T2,OBHR+.BFPTR	;ADJUST PTR AND GET BLT TERM (IN CASE
				; UU.IBC DIDN'T WORK)
	SKIPE	1(T1)		;MON CLEAR THE BUFFER (OR FIRST TIME)?
	 JRST	BFOTST		;NO--SKIP AHEAD
	SETOM	1(T1)		;YES--MAKE IT ALL ONES
	HRLI	T1,1(T1)	;FORM BLT WORD
	HRRI	T1,2(T1)	;...
	BLT	T1,(T2)		;FILL THE BUFFER
IFN FT$DEB,<AOS	BUFZER>		;COUNT THE TIMES MON CLEARED BUFFER
BFOTST:	OUT	OUTC,		;DUMP THE BUFFER
	 AOSA	P1		;OK--COUNT REC AND SKIP
	  JRST	OCHERR		;OOPS--PONDER THE ERROR
	HRRZ	T1,P2		;GET ERROR RETRIES
	JUMPE	T1,TSTBUF	;JUMP IF FIRST TRY THIS RECORD
	PUSHJ	P,.TDECW##	;NO--TYPE # OF TRIES
	STRNG$	< ATTEMPTS TO WRITE TAPE AT >
	MOVE	T1,P1		;REC #
	PUSHJ	P,.TDECW##
	PUSHJ	P,TYFEET	;FEET<CRLF>
OCHIEC:	JSP	T1,RESTRY	;RESET THE RETRY COUNTER IN P2
	AOS	OUTERS		;COUNT OUTPUT ERROR
	AOJA	P3,TSTBUF	;COUNT ERROR AND LOOP

OCHERR:	GETSTS	OUTC,T2		;GET ERROR BITS
	TRNE	T2,IO.EOT	;END OF TAPE?
	POPJ	P,		;YES--DONE WITH TEST
	TRZ	T2,IO.ERR	;CLEAR ERROR BITS
	SETSTS	OUTC,(T2)	;TELL MON
	AOBJN	P2,OCHFIX	;COUNT AND JUMP IF NOT ENOUGHT TRIES
	ADDI	P1,1		;COUNT THE RECORD
	MOVE	T1,NUMTRY	;GET # TRIES
	WARN.	EF$DEC!EF$NCR,FAR,<FAILED AFTER >
	STRNG$	< TRIES AT >
	MOVE	T1,P1		;GET RECORD COUNT
	PUSHJ	P,.TDECW##	;SHO THE FEET
	PUSHJ	P,TYFEET	;TYPE FEET<CRLF>
	JRST	OCHIEC		;GO FIX UP ERROR COUNTERS

OCHFIX:	MTBSR.	OUTC,		;BACKSPACE A RECORD (ONE IN ERROR)
	MTWAT.	OUTC,		;WAIT FOR IT
	JUMPLE	P1,TSTBUF	;IF FIRST REC THEN ALL DONE
	MTBSR.	OUTC,		;BACKSPACE ANOTHER
	MTWAT.	OUTC,		;WAIT
	MTSKR.	OUTC,		;FORWARD ONE
	MTWAT.	OUTC,		;WAIT
	JRST	TSTBUF		;GO AGAIN
>;END IFN FT$TST
SUBTTL	FIND BUFFER IN ERROR

REPEAT	0,<	;NOBODY USES IT YET

;FNDBFE -- FIND BUFFER IN ERROR
;CALL:	MOVE	T1,<1ST WORD OF BUFFER HEADER>
;	PUSHJ	P,FNDBFE
;	*NOT FUND*
;	*FOUND--T1 HAS COUNTER OF # BUFS FROM PRESENT ONE,,PTR TO IT

FNDBFE:	PUSHJ	P,.SAVE3##	;NEED REGS
	SETZ	P3,		;CLEAR COUNT
	HRRZ	P1,T1		;COPY PTR
BFELUP:	MOVE	P2,-1(P1)	;GET STATUS BITS
	ANDI	P2,IO.IMP!IO.DER!IO.BKT!IO.DTE
	JUMPN	P2,GOTBFE	;JUMP IF FOUND SOME ERROS
	HRRZ	P1,(P1)		;NO--MOVE ALONG RING
	CAME	P1,T1		;BACK TO WHERE WE STARTED?
	 AOJA	P3,BFELUP	;NO--COUNT AND LOOP
RTZER:	SETZ	T1,		;NONE FOUND
	POPJ	P,

;HERE WITH FOUND BUFFER IN ERROR

GOTBFE:	ANDCAM	P2,-1(P1)	;CLEAR ERROR BITS
	HRLZ	T1,P3		;COUNT
	HRRI	T1,(P1)		;BUFFER ADDR
	JRST	.POPJ1##	;SKIP BACK
>;END REPEAT 0
SUBTTL	OPENIO OPENS I/O CHANNELS

;OPENIO
;CALL:	MOVEI	T1,<FDB ADDR>
;	PUSHJ	P,OPENIO
;	CAI	CHANNEL,BUFADR	;@ IF OUTPUT, (MODE)
;	*ALL IS WELL RETURN*	;ABORT IF FAIL

OPENIO:	HRL	T1,0(P)		;REMEMBER CALLER
	AOS	(P)		;DO A SKIP BACK
	PUSHJ	P,.SAVE3##	;PRESERVE REGISTERS
	MOVS	P1,T1		;COPY ARGUMENTS
	MOVE	P2,(P1)		;GET REST OF THEM
	MOVSI	T1,.FXLEN	;SETUP FOR .STOPB
	HLR	T1,P1		;...
	MOVEI	T2,OPNBLK	;
	SKIPA	T3,.+1
	.RBTIM+1,,LKPBLK
	MOVEI	T4,PTHBLK	;PATCH
	PUSHJ	P,.STOPB##	;CONVERT TO OPEN/LOOKUP BLOCKS
	 JRST	WLDERR		;NO WILDCARDING!
DOOPEN:	MOVEI	T1,.RBTIM	;SETUP COUNT
	MOVEM	T1,LKPBLK+.RBCNT
	LDB	T1,[POINT 4,P2,17] ;GET MODE
	MOVEM	T1,OPNBLK+.OPMOD;STORE IN OPEN BLOCK
	HRRZ	T1,P2		;BUFFER HEADER ADDRESS
	TLNE	P2,ATSIGN	;READ OR WRITE?
	MOVSS	T1		;WRITING, POSITON FOR IT
	MOVEM	T1,OPNBLK+.OPBUF;STORE
	LDB	P3,[POINT 4,P2,12] ;GET I/O CHANNEL
	MOVSI	T1,(UU.IBC)	 ;GET INHIBIT BUFFER CLEARING BIT
	CAIN	P3,OUTC		;IF OUTPUT CHANNEL
	TLO	T1,(UU.SOE)	;THEN STOP ON ERROR ALSO
	CAIE	P3,LPTC		;UNLESS LINE PRINTER CHANNEL
	IORM	T1,OPNBLK+.OPMOD;STORE IN OPEN BLOCK
	LSH	P3,5		;POSITION CHANNEL
	MOVSS	P3		;IN CHANNEL POSITION
	MOVE	T1,[OPEN OPNBLK];FORM INSTR
	OR	T1,P3		;FINISH
	XCT	T1		;TRY TO OPEN DEVICE
	 JRST	OPENER		;CAN'T--BOMB OUT

	MOVE	T1,P3		;REGET I/O CHANNEL
	TLNE	P2,ATSIGN	;READ/WRITE?
	 TLOA	T1,(ENTER)	;WRITE
	  TLO	T1,(LOOKUP)	;READ
	HRRI	T1,LKPBLK	;COMPLETE INSTR
	XCT	T1		;FIND/WRITE THE FILE
	 JRST	LKENER		;CAN'T
	POPJ	P,		;RETURN
;OPENIO ERRORS

OPENER:	HLRZ	T1,P1		;COPY FDB ADDR
E$$COD:	ERROR.	EF$FTL!EF$FIL,COD,<CAN'T OPEN DEVICE, FILE >

WLDERR:	MOVE	T1,OPNBLK+.OPDEV;GET DEVICE
	DEVCHR	T1,		;MAKE SURE MTA
	TLNN	T1,(DV.MTA)	;IS IT?
	 JRST	WLDNMT		;NO
	JRST	DOOPEN		;YES--GO ON

WLDNMT:	HLRZ	T1,P1		;GET FDB
E$$DNM:	ERROR.	EF$FTL!EF$FIL,DNM,<DEVICE NOT A MAGTAPE - >

LKENER:	HRRZ	T1,LKPBLK+.RBEXT;GET FAIL CODE
	ERROR.	EF$ERR!EF$OCT!EF$NCR,LER,<LOOKUP/ENTER ERROR(>
	STRNG$	<) FILE >
	HLRZ	T1,P1
	PUSHJ	P,.TFBLK##	;TYPE SCAN BLOCK
	PUSHJ	P,.TCRLF##	;NEW LINE
	JRST	ERRFTL		;GO DIE

;SCAN BLOCK FOR LPT SPEC

LPTSPC:	SIXBIT	/LPT/		;.FXDEV
	EXP	MY$NAM		;.FXNAM
	EXP	-1		;.FXNMM
	'LPT',,-1		;.FXEXT
	BLOCK	.FXLEN-.FXEXT	;THE REST
SUBTTL	XCTIO EXECUTES IN/OUT UUO WITH ERROR HANDLING

;XCTIO
;CALL:	PUSHJ	P,XCTIO
;	<INSTR TO XCT>	;IN/OUT UUO
;	*EOF/EOT RETURN*
;	*NORMAL RETURN*

XCTIO:	SAVE$	T1		;SAVE POSSIBLE CHAR/WORD
	MOVE	T1,@-1(P)	;GET INSTR TO XCT
	AOS	-1(P)		;SKIP INSTR ON RETURN
	PUSHJ	P,XCTIOD	;DO THE I/O
	AOS	-1(P)		;OK--SKIP BACK
	JRST	TPOPJ		;RESTOR T1 AND RETURN

;THIS ROUTINE DOESN'T SKIP IF XCTIO SHOULD, AND SKIPS IF XCTIO SHOULDN'T

XCTIOD:	XCT	T1		;DO THE UUO
	POPJ	P,		;OK--CPOPJ SO XCTIO WILL CPOPJ1
	PUSHJ	P,.SAVE2##	;ERROR--SAVE P1 - 2
	SAVE$	T1		;SAVE OPERATION IN CASE OPTION=S
XCTIOE:	AND	T1,[17B12]	;ERROR--GET THE CHANNEL
;	MOVE	P1,T1		;COPY CHANNEL
;	OR	P1,[WAIT]	;FORM UUO TO WAIT FOR I/O TO FINISH
;	XCT	P1		;WAIT FOR IT
	MOVE	P1,T1		;COPY CHANNEL
	HLRZ	P2,P1		;GET IN RH FOR FUTURE TESTING
	LSH	P2,-5		;...
	OR	T1,[GETSTS T2]	;GET ERRROR BITS
	XCT	T1
	TRNE	T2,IO.EOF!IO.EOT;END OF SOMETHING?
	JRST	TPOPJ1		;YES--CPOPJ1 SO XCTIO WILL CPOPJ
	HRRZ	T1,T2		;NO--GET BITS IN RIGHT PLACE
	MOVEM	T2,TEMP		;SAVE IN A VERY VOLATILE PLACE
	TRZ	T2,IO.ERR	;CLEAR ERROR BITS
	TLO	P1,(SETSTS (T2)) ;FORM INSTR TO RESET STATUS
	XCT	P1		;MAKE ERROR DISSAPPEAR
	TRNE	T1,IO.IMP	;CHECK FOR WRITE LOCK
	 JRST	FIXWLK		;YES--GO HANDLE IT
	CAIN	P2,LOGC		;IF LOG FILE
	 JRST	[TLZ	F,FL$LOG;STOP OUTPUT FOR A WHILE
		JRST	XCTIO0]	;AND GO PUT MSG TO TTY
	CAIE	P2,LPTC		;UNLESS LPT CHANNEL
	AOS	ERRCNT-1(P2)	;COUNT THE ERROR
	CAIE	P2,INPC		;IF THIS IS INPUT CHANNEL
	 JRST	XCTIO0		;NO
	MOVE	T2,ERRFLG	;GET /ERROR VALUE
	SKIPLE	RTRYFL		;/NORETRY??
	 SKIPLE	RPTFLG		;YES--/REPORT?
	 CAIN	T2,ERLIGN	;HOW ABOUT /ERROR:IGNORE?
	JRST	TPOPJ		;/NORETRY AND /NOREPORT OR /ERROR:IGNORE
XCTIO0:	WARN.	EF$NCR!EF$OCT,IOE,<I/O STATUS = >
	PUSHJ	P,TELPRB	;TELL WHAT THE BITS MEAN
	STRNG$	<, ON >
	MOVE	T1,[EXP INPSPC,OUTSPC,LPTSPC,LOGSPC]-1(P2) ;GET RIGHT FDB
	PUSHJ	P,.TFBLK##	;TYPE IT OUT
	CAIN	P2,LOGC		;IS THIS THE LOG CHANNEL?
	 JRST	[TLO	F,FL$LOG;YES--MARK IT OPEN FOR BUSINESS AGAIN
		JRST	TPOPJ]	;AND GO RETURN
	CAIN	P2,LPTC		;OR LPT CHANNEL
	 JRST	TELCON		;YES--JUST GO CONTINUE
	MOVE	T1,P2		;COPY CHANNEL FOR TAPOP.
	PUSHJ	P,GMTSTS	;GET FILE AND RECORD COUNTS
	STRNG$	<, FILE >	;TELL FILE AND RECORD COUNTS
	MOVE	T1,TPOPBL+.TSFIL;GET FILE
	PUSHJ	P,.TDECW##
	STRNG$	< RECORD >
	MOVE	T1,TPOPBL+.TSREC;AND REC #
	PUSHJ	P,.TDECW##
	TLNN	F,FL$BAT	;IF BATCH JOB JUST CONTINUE
	CAIE	P2,INPC		;THIS INPUT CHANNEL?
	 JRST	TELCON		;NO--JUST CONTINUE
	MOVE	T1,TEMP		;GET SAVED I/O STATUS
	TRNE	T1,IO.BKT	;IF BLOCK TOO LARGE
	 PUSHJ	P,BKTERR	;GO HANDLE SEPARATELY
	SKIPLE	T1,ERRFLG	;GET /ERROR:LEVEL
	 CAIE	T1,ERLQUE	;/ERROR:QUERY?
	 JRST	TELCON		;NO--CONTINUE
	PUSHJ	P,.TCRLF##	;NEW LINE
	JRST	GETOPT		;GO GET ERROR OPTION

;HERE WHEN OUTPUT IS WRITE LOCKED--ASK USER TO WRITE-ENABLE IT

FIXWLK:	PUSHJ	P,WRTLOK	;TELL AND WAIT FOR WRTENBL
	MOVE	T1,0(P)		;GET I/O INSTR
	XCT	T1		;CLANK IT AGAIN
	 JRST	TPOPJ		;SUCCESS!
	JRST	XCTIOE		;OOPS..ERROR AGAIN
GETOPT:	STRNG$	<
OPTION (H FOR HELP): >
	PUSHJ	P,GCHNWL	;INCHRW T1 + .TCRLF
	MOVSI	T2,-N$OPTN	;AOBJ
	CAME	T1,OPTLST(T2)
	AOBJN	T2,.-1
	JUMPL	T2,@OP$DSP(T2)	;JUMP IF VALID
OP$HLP:	SKIPA	T1,.+1		;LOAD UP FILENAME
	SIXBIT	/CMTERH/	;COPYMT I/O ERROR HELP
	PUSHJ	P,TYHELP	;GO TYPE HELP
	JRST	GETOPT

OPTLST:	EXP	"C","D","E","G","H","I","S"
	N$OPTN==.-OPTLST

OP$DSP:	EXP	TPOPJ		;CONTINUE
	EXP	OP$DMP		;DUMP IT
	EXP	OP$EXI		;EXIT
	EXP	OP$G		;GO
	EXP	OP$HLP		;HEP ME
	EXP	OP$IGN		;IGNORE FURTHER ERRORS
	EXP	OP$SKP		;SKIP IT

OP$IGN:	MOVEI	T1,ERLIGN	;/ERROR:IGNORE
	MOVEM	T1,ERRFLG	;SET FOR LATER ERRORS
	JRST	TPOPJ		;AND RETURN
OP$G:	SETOM	ERRFLG		;FLAG NOT TO BOTHER USER
	JRST	TPOPJ		;CPOPJ SO XCTIO WILL CPOPJ1

OP$EXI:	EXIT	1,
	JRST	GETOPT		;IF HE CONTINUES

OP$SKP:	RESTR$	T1		;GET THE I/O INSTR BACK
	JRST	XCTIOD		;AND TRY AGAIN

TELCON:	STRNG$	< - CONTINUING
>
	JRST	TPOPJ		;CPOPJ SO XCTIO WILL CPOPJ1
TPOPJ1:	AOS	-1(P)
TPOPJ:	RESTR$	T1
	POPJ	P,
;CALL HERE WITH ERROR BITS IN T1--REPORTS WHAT THEY ALL MEAN

TELPRB:	PUSHJ	P,.PSH4T##	;SAVE T1-4
	MOVE	P1,T1		;COPY BITS
	ANDI	P1,IO.IMP!IO.DER!IO.DTE!IO.BKT ;NARROW TO WHAT WE NEED
	JUMPE	P1,PRBDUN	;JUMP IF NOT A PROBLEM!
	LSH	P1,-<ALIGN. (IO.BKT)> ;POSITION
	MOVEI	T1,[ASCIZ/ (/]	;START THE LIST
	PUSHJ	P,.TSTRG##
	TLZ	F,FL$FLG	;FL$FLG=1 MEANS NOT FIRST ONE--TYPE A COMMA
	MOVE	T4,[POINT 18,PRBNAM] ;POINT TO THE PROBLEM
PRBLUP:	ILDB	T2,T4		;GET ONE
	TRNN	P1,1		;THIS ONE A PROBLEM?
	 JRST	PRBNXT		;NO
	TLOE	F,FL$FLG	;YES--FIRST ONE?
	PUSHJ	P,TYSLSH	;NO--SLASH 1
	MOVSI	T1,(T2)		;POSITION ERROR CODE
	PUSHJ	P,.TSIXN##	;TYPE IT
PRBNXT:	LSH	P1,-1		;MOVE OVER ONE
	JUMPN	P1,PRBLUP
	MOVEI	T1,")"		;FINISH IT OFF
	PUSHJ	P,.TCHAR##	;...
PRBDUN:
POP4J:	PUSHJ	P,.POP4T##	;RESTORE T1-4
	POPJ	P,

PRBNAM:	'BKTPAR'		;BLOCK TOO LARGE/PARITY (DATA) ERROR
	'DERIMP'		;DEVICE ERROR/IMPROPER MODE
	EXP	0		;SNH

BKTERR:	TLOE	F,FL$BKT	;BEEN HERE BEFORE?
	 POPJ	P,		;YES--JUST RETURN
	PUSHJ	P,.TCRLF##	;NEW LINE
	INFO.	0,BKT,<BLOCK TOO LARGE ON INPUT--TRY LARGER /BUFSIZ>
ASKCON:	STRNG$	<CONTINUE (Y OR N)? >
	PUSHJ	P,GCHNWL	;GET HIS REPLY
	CAIE	T1,"Y"		;WHAT DID HE SAY?
	JRST	[CAIE	T1,"N"	;BUT DID HE REALLY SAY NO?
		JRST	ASKCON	;NO--MAKE SURE
		JRST	ERRFTL]	;YES--GO DIE
	POPJ	P,		;HE SAID TO CONTINUE OK
SUBTTL	ERROR DUMP ROUTINES

OP$DMP:	TLOE	F,FL$LPO	;LPT OPEN?
	 JRST	DUMP0		;YES
	MOVEI	T1,LPTSPC	;NO--GET SPEC ADDR
	PUSHJ	P,OPENIO	;DO IT
	CAI	LPTC,@LBHR(.IOASC) ;
	MOVSI	T1,2		;USE 2 BUFFERS
	SKIPA	T2,.+1		;
	XWD	OPNBLK,LBHR	;ARG FOR .ALCBF
	PUSHJ	P,.ALCBF##	;ALLOCATE BUFFERS

DUMP0:	PUSHJ	P,LHEDER	;HEADER FOR RECORD
	PUSHJ	P,LDMPBF	;DUMP THE BUFFER
	JRST	GETOPT		;ASK AGAIN

LDMPBF:	PUSHJ	P,.SAVE2##	;SAVE P1-2
	MOVEI	P1,MX$NPL	;PRESET COUNTER
	MOVN	T1,IBHR+.BFCTR	;GET NEG LENGTH OF BUFFER
	HRRZ	P2,IBHR+.BFPTR	;POINT TO BUFFER
	HRRI	P2,1(P2)	;POINT TO DATA WORDS
	HRLI	P2,(T1)		;FORM AOBJN WORD
LDMLUP:	MOVE	T2,(P2)		;GET A WORD
	PUSHJ	P,LOCTFW	;DUMP WITH FORMATTING
	AOBJN	P2,LDMLUP	;DO ALL WORDS
	PJRST	LCRLF		;NEW LINE AND RETURN

;CALL WITH WORD TO DUMP IN T2 (DUMPS ALL 12 OCTAL DIGITS WITH FORMATIING)

LOCTFW:	SOJGE	P1,LOCTF0	;JUMP IF COOL
	PUSHJ	P,FLCRLF	;NO--NEW LINE
LOCTF0:	MOVEI	T1," "		;NO--SPACE TWO
	PUSHJ	P,LCHR
	PUSHJ	P,LCHR
	MOVEI	T3,^D12		;12 DIGITS
LOCLUP:	SETZ	T1,		;CLEAR RESULT
	LSHC	T1,3		;GET BYTE
	MOVEI	T1,"0"(T1)	;ASSKEY-IZE IT
	PUSHJ	P,LCHR		;LIST IT
	SOJG	T3,LOCLUP	;DO ALL
	POPJ	P,

;LOCT--LIST OCTAL

LOCT:	IDIVI	T1,^D8		;GET A DIGIT
	HRLM	T2,(P)		;SAVE ON PDL
	SKIPE	T1		;DONE?
	PUSHJ	P,LOCT		;NO--RECURZE
	HLRZ	T1,(P)		;YES--GET DIGIT
	MOVEI	T1,"0"(T1)	;ASCII
	PJRST	LCHR		;UNRECURSE OR RETURN
;FLCRLF -- LIST CRLF TO PRINTER AND RESET P1

FLCRLF:	MOVEI	P1,MX$NPL	;RESET P1
;	PJRST	LCRLF		;CRLF AND RETURN

;LCRLF -- LIST CRLF TO PRINTER

LCRLF:	MOVEI	T1,.CHCRT	;CARRIAGE RETURN
	PUSHJ	P,LCHR
	MOVEI	T1,.CHLFD	;NEW LINE
;	PJRST	LCHR		;DUMP AND RETURN

;LCHR -- DUMP CHAR IN T1 TO LPT

LCHR:	SOSG	LBHR+.BFCTR	;ROOM?
	 JRST	LBUFO		;NO
LCHRC:	IDPB	T1,LBHR+.BFPTR	;YES--STORE IT
	POPJ	P,
LBUFO:	PUSHJ	P,XCTIO		;DO OUTPUT
	 OUT	LPTC,
	HALT	.		;EOT ON LPT!!??
	JRST	LCHRC		;DUMP CHAR AND RETURN

;LSTR -- T1 POINTS TO ASCIZ STRING TO DUMP TO LPT

LSTR:	HRLI	T1,(POINT 7)	;BYTE PTR
	PUSH	P,T1		;SAVE ON PDL
LSTRL:	ILDB	T1,(P)		;GET CHAR
	JUMPE	T1,TPOPJ	;PRUNE PDL AND RETURN
	PUSHJ	P,LCHR		;DUMP
	JRST	LSTRL

;LHEDER -- LIST HEADER FOR THIS RECORD

LHEDER:	MOVEI	T1,[ASCIZ \DUMP OF FILE \]
	PUSHJ	P,LSTR
	MOVE	T1,TPOPBL+.TSFIL;INPUT FILE #
	PUSHJ	P,LOCT
	MOVEI	T1,[ASCIZ \ RECORD \]
	PUSHJ	P,LSTR
	MOVE	T1,TPOPBL+.TSREC;RECORD #
	PUSHJ	P,LOCT
	PUSHJ	P,LCRLF		;NEW LINE
	PJRST	LCRLF		;AND ANOTHER AND RETURN
SUBTTL	MINOR SUBROUTINES

;GCHNWL -- INCHRW T1 + CLRBFI + .TCRLF
;USES NO ACS EXCEPT RETURNS CHAR IN T1

GCHNWL:	MOVEI	T1,.CHBEL	;TYPE A BELL IF NOT BATCH
	TLNN	F,FL$BAT	;IS IT?
	 PUSHJ	P,.TCHAR##	;NO--TYPE DING
	INCHRW	T1		;GET THE CHARACTER
	CLRBFI			;IN CASE DUMP USER
	PJRST	.TCRLF##	;NEW LINE AND RETURN

;TYPDLR -- TYPE CRLF-DOLLAR SIGN IF BATCH SO WE TALK TO OPERATOR

TYPDLR:	TLNN	F,FL$BAT	;BATCH JOB
	 POPJ	P,		;NOT TODAY
	PUSH	P,T1		;YES--SAVE T1
	STRNG$	<
$>				;SEND CRLF-$
	PJRST	TPOPJ		;GET T1 BACK AND RETURN

;TYSLSH -- TYPE A SLASH

TYSLSH:	MOVEI	T1,"/"		;GET ONE
	PJRST	.TCHAR##	;SEND IT

;TYFEET -- TYPE "FEET<CR><LF>"

TYFEET:	PJSP	T1,.TSTRG##
	ASCIZ	. FEET
.
;GMTSTS -- GET FILE AND RECORD COUNT
;CALL:	MOVE	T1,IOCHAN
;	PUSHJ	P,GMTSTS
;	*RETURN, STATUS IN TPOPBL*
;USES T1-T2

GMTSTS:	MOVEM	T1,TPOPBL-2	;STORE CHANNEL
	MOVEI	T2,.TFSTA	;FUNCTION
	MOVEM	T2,TPOPBL-3	;SET IN BLOK
	SKIPA	T2,.+1		;UUO ARG
	 XWD	5,TPOPBL-3	;5 WORDS,,ADDR
	TAPOP.	T2,		;ASK MON
	 JFCL			;(CAN'T POSSIBLY HAPPEN, SAID THE OPTIMIST)
	POPJ	P,

;TYHELP -- TYPE HELP FILE SPECIFIED BY C(T1)
;WILL RESTORE AND RELEASE HISEG IF IT IS CURRENTLY GONE

TYHELP:	TLZ	F,FL$FLG	;ASSUME NOT GONE
	SKIPE	.JBHRL		;BUT CHECK
	 JRST	TYHLP0		;IT'S THERE--GO ON
	PUSHJ	P,UPSCN		;OOPS--PUT IT BACK
	TLO	F,FL$FLG	;REMEMBER WHAT WE DID
TYHLP0:	PUSHJ	P,.HELPR##	;CALL HELPER TO TYPE THE HELP
	TLNN	F,FL$FLG	;CHECK THE FLAG
	POPJ	P,		;IT WAS ALREADY THERE
	PJRST	DWNSCN		;GO DISMISS IT
SUBTTL	ERROR HANDLER

;EHNDLR -- HANDLE ALL ERRORS
;THE ONLY CALL IS THRU THE ERROR. MACRO

EHNDLR:	PUSHJ	P,SAVACS	;SAVE THE ACS
	MOVE	P1,@0(P)	;GET FLAGS AND ADDRESSES
EHND.0:	MOVEI	T1,"?"		;ASSUME AN ERROR
	TLNE	P1,EF$WRN	;CHECK WARNING
	MOVEI	T1,"%"		;YES
	TLNE	P1,EF$INF	;IF BOTH OFF NOW THEN INFO
	MOVEI	T1,"["		;GOOD THING WE CHECKED
	TLNE	P1,EF$OPR	;OPERATOR SEE IT ALSO?
	PUSHJ	P,TYPDLR	;YES--TYPE THAT FIRST (NOTE: T1 IS PRESERVED)
	PUSHJ	P,.TCHAR##	;OUTPUT THE START OF MESSAGE
	MOVSI	T1,MY$PFX	;SET UP MY PREFIX
	HLR	T1,(P1)		;GET MESSAGE PREFIX
	PUSHJ	P,.TSIXN##	;OUTPUT THE PREFIXES
	PUSHJ	P,.TSPAC##	;AND A SPACE
	HRRZ	T1,(P1)		;GET STRING ADDRESS
	PUSHJ	P,.TSTRG##	;SEND IT
	MOVE	T1,SAVAC+T1	;GET ORIGINAL T1 IN CASE TYPEOUT DESIRED
	MOVE	T2,SAVAC+T2	;ORIGINAL T2 IN CASE .TOLEB
	LDB	T3,[POINT 5,P1,17] ;GET TYPED OUT DESIRED
	CAILE	T3,MX$ERR	;CHECK FOR IN-RANGE
	 MOVEI	T3,EF$NOP	;NO--MAKE IT CPOPJ
	PUSHJ	P,@ERRTAB(T3)	;CALL THE ROUTINE
	TLNE	P1,EF$NCR	;IF NO CRLF THEN DON'T CLOSE INFO
	 JRST	EHND.1		;NO--DON'T CHECK
	MOVEI	T1,"]"		;PREPARE TO CLOSE INFO
	TLNE	P1,EF$INF	;CHECK FOR INFO
	PUSHJ	P,.TCHAR##	;SEND INFO CLOSE
	TLNN	P1,EF$NCR	;NO CARRIAGE RETURN?
	PUSHJ	P,.TCRLF##	;YES--SEND ONE
EHND.1:	TLNE	P1,EF$FTL	;NOW CHECK FATAL
	 JRST	ERRFTL		;YES--GO DIE
	MOVEM	F,SAVAC+F	;NO--BUT PUT F INTO SAVAC SO UPDATED
				;FLAGS WILL BE SEEN
	;FALL INTO RESACS

;RESACS -- RESTORE ALL ACS FROM SAVAC AREA
;	PUSHJ	P,RESACS
;	*ACS RESTORED FROM SAVAC*

RESACS:	MOVEM	17,SAVAC+17	;SAVE 17 TO RESTORE INTO IT
	MOVSI	17,SAVAC
	BLT	17,17		;REGISTERS ARE RESTORED
	POPJ	P,		;RETURN
ERRTAB:	.POPJ##			;CODE 0 -- NO ACTION
	.TDECW##		;CODE 1 -- TYPE T1 IN DECIMAL
	.TOCTW##		;CODE 2 -- TYPE T1 IN OCTAL
	.TSIXN##		;CODE 3 -- TYPE T1 IN SIXBIT
	.TPPNW##		;CODE 4 -- TYPE T1 AS PPN
	.TSTRG##		;CODE 5 -- T1 POINTS TO ASCIZ STRING
	.TFBLK##		;CODE 6 -- T1 POINTS AT FDB
	.TOLEB##		;CODE 7 -- T1 POINTS AT OPEN BLOCK
				;	-- T2 POINTS AT LOOKUP BLOCK

;HERE TO DIE--

ERRFTL:	PUSHJ	P,CLSLOG	;CLOSE THE LOG IF WE ARE USEING IT
	RESET			;KILL ALL FILES
	MOVE	P,INIPDP	;RESET PDL
	PUSHJ	P,UPSCN		;MAKE SURE SCAN IS THERE
	SKIPN	OFFSET		;CCL ENTRY
	 SKIPL	ISCNVL		;OR A RECOGNIZED COMMAND
	  PUSHJ	P,.MONRT##	;YES--RETURN TO MONITOR
	JRST	RESTRT		;GO CONTINUE

;SAVAC -- SAVE ALL ACS
;CALL -- PUSHJ P,SAVACS
;	*ACS SAVED IN SAVAC*	BEWARE!!

SAVACS:	MOVEM	17,SAVAC+17	;SAVE ONE
	MOVEI	17,SAVAC
	BLT	17,SAVAC+16
	MOVE	17,SAVAC+17
	POPJ	P,		;ACS ARE SAVED
SUBTTL	STORAGE

;STORAGE THAT IS CONSTANT BETWEEN RUNS

U (ISCNVL)		;VALUE RETURNED BY .ISCAN
U (TLDVER)		;-1 WHEN VERSION HAS BEEN TYPED ON TTY
U (SAVRUN)		;-1 WHEN RUN UUO ARGS SAVED
U (SGDEV)		;SAVEGET DEVICE NAME
U (SGNAM)		;SAVEGET PROGRAM NAME
U (SGLOW)		;SAVEGET LOW SEGMENT NAME
U (SGPPN)		;SAVEGET PPN
U (OFFSET)		;STARTING OFFSET (REMEMBER FOR .ISCAN)

FW$ZER==.
U (LOGSPC,.FXLEN)	;SPACE FOR LOG FILE SPEC
U (ODVNAM)		;REAL NAME (FROM DEVNAM)
U (IDVNAM)		;REAL NAME (FROM DEVNAM)
U (GOTIME)		;MSTIME FOR START
U (GORUNT)		;RUNTIM FOR START
U (LSTBFZ)		;LAST BUFFER SIZE SEEN WHEN DSKTOTAPE
U (TEMP)		;VERY TEMPORARY STORAGE
IFN FT$DEB,<
U (BUFZER)		;COUNT TIMES MON CLEARED BUFFERS WITH UU.IBC ON
>;END IFN FT$DEB
U (IBHR,3)		;INPUT BHR
U (OBHR,3)		;OUTPUT BHR
U (LBHR,3)		;LPT BHR
U (GBHR,3)		;LOG FILE BHR
U (PDLIST,LN$PDL)	;ALLOCATE SPACE FOR PUSH DOWN LIST
U (SAVAC,20)		;AC SAVE BLOCK WHEN IN ERROR HANDLER
U (OPNBLK,3)		;OPEN BLOCK
U (LKPBLK,.RBTIM+1)	;LOOKUP/ENTER BLOCK
U (PTHBLK,^D9)		;PATH BLOCK (NOT USED, BUT CAN'T USE .STOPN)
U (PRMPDL,LN$PRM)	;PARAM PUSHDOWN LIST
	BLOCK	3	;***DO NOT TOUCH***USED BY TAPOP.
U (TPOPBL,2)		;TAPOP. ARG BLOCK
FW$STS==.
ERRCNT:
U (INPERS)		;INPUT ERROR COUNT
U (OUTERS)		;OUTPUT ERROR COUNT
U (RECTOT)		;RECORD TOTAL
U (FILTOT)		;FILE TOTAL
	LW$STS==.-1

SCN$FZ==.	;FIRST WORD CLEARED FOR SCAN
U (INPSPC,LN$FDB)	;INPUT SPEC STORAGE
	INPSPE==.-1
U (OUTSPC,LN$FDB)	;OUTPUT SPEC SPACE
	OUTSPE==.-1	;END OF OUTPUT SPEC SPACE
SWT$FO==.	;FIRST SWITCH WORD (SET TO -1 BY CLRANS)
U (UCOMNT,^D28)		;FOR /COMMENT:"COMMENT STRING" FOR LOG FILE
IFN FT$TST,<
U (TSTDEN)		;SAVE DENSITY HERE
U (TESTFL)		;/TAPTST FLAG
U (NUMTRY)		;/RETRY:N
U (RPETFL)		;/REPEAT:N
>;END IFN FT$TST
U (RTRYFL)		;RETRY FLAG
U (TIMEFL)		;/TIME FLAG
U (RPTFLG)		;REPEAT FLAG
U (IFTYFL)		;/IFTYP FLAG
BFRSIZ:		;**DO NOT SEPARATE
U (NIBUFS)		;# INPUT BUFFERS
U (NOBUFS)		;# OUTPUT BUFFERS
		;**END DO NOT SEPARATE
U (BUFSIZ)		;/BUFSIZ:N
U (ERRFLG)		;/ERROR:CONTIN OR /ERROR:QUERY
U (MODFLG)		;/MODE:MODE 
U (MODES,2)		;/MODE:MODE FOR INPUT AND OUTPUT
	INPMOD=MODES	;INPUT/MODE:MODE
	OUTMOD=MODES+1	;OUTPUT/MODE:MODE
SWT$LO==.-1
SCN$LZ==.-1
LW$ZER==.-1
	LIT$			;OUT GO THE LITERALS
CMTEND::END	COPYMT