/MAGTAPE FOTP
/
/	MODIFIED FOR MAG TAPE BY
/		R.W. PHELPS
/		BEHAVIOR LAB
/		UNIV OF ROCHESTER
/
/	MODIFIED FOR SUB-FILE DIRECTORIES 10/77 (RWP)
/	SFD'S MOVED TO BEGINNING OF SUB-FILE BLOCK 11/77 (RWP)
/
/WITH FAILSAFE CHANGES	NOV 17, 1973	R.L.


/  FOTP (FILE ORIENTED TRANSFER PROGRAM)   H.J.


/CORE MAP

/FROM TOP OF CORE

/	FIELD 2 BUFFER

/	FIELD 1
/		7777-7600	MONITOR
/		7577-2000	FOTP CODE
/		1777-0		RESIDENT USR
/
/	FIELD 0
/		7777-7600	MONITOR
/		7577-7200	INPUT HANDLER
/		7177-6600	OUTPUT HANDLER
/		6577-6000	CODE, ERROR MESSAGES
/		5777-3000	OUTPUT DIRECTORY
/		2777-0		INCORE INPUT DIRECTORY
/
/PAGE 0 LOCATIONS OS/8 USR WON'T MANGLE

	PTR=20
	CNT=21
	INFPTR=22
	OUHAND=23
	INHAND=24
				/25 -- EMPTY
	EPTR=26
	INSCNT=27
	TEMP=30
	OKFLAG=31
	IFCNT=32
	BUFSIZ=33
	INFWDS=34
	BDPTR=35
	GPTR1=36
	INEOF=37

/AUTO INDEX REGISTERS USR WILL ALLOW ME TO USE TEMPORARILY

	XR=10
	XR1=11
	XR2=12


/VARIOUS CONSTANTS THAT CAN BE GENERATED

	AC2=CLA CLL CML RTL
	AC4000=CLA CLL CML RAR
	ACM2=CLA CLL CMA RAL
	ACM3=CLA CLL CMA RTL

/	LOCATIONS REFERENCED IN OS/8

	ALTOPT=7642
	OPT1=7643
	OPT2=7644
	DATE=7666
	DIRKEY=7	/"DIRECTORY SEGMENT IN CORE" KEY
	EQLS=7646
	OPT3=7645

/SYMBOLIC FOTP LOCATIONS:

OUBUFR=	3000		/OUTPUT BUFFER - IN FIELD 0
INBUFR=	0		/INPUT BUFFER - IN FIELD 0
VERSION=	2	/VERSION NUMBER
/SUBVER= 1		/SUBVERSION NUMBER
/
/	--FIXED PROBLEM WITH SUBFILE DATE
/	--ALLOW TWO DIGIT VERSION AS #.#
/	--CHANGED DEVICE CONTROL WORD SO IT IS RESET TO "READ-ONLY"
/		PROTECTING USER FROM DESTROYING DIRECTORY.  IT IS
/		CHANGED TO READ-WRITE, DIRECTORY FOR MTFOTP ONLY.
SUBVER= 2
/	--FIX FOR /S & /P TO WORK TOGETHER
/
/
/CODES FOR MTA HANDLER
	REWIND=1
	SKPFIL=3
	WRTEOF=5
	SKPREC=2
/STARTS AT <FOTP> IN FIELD 1 (ONCE ONLY CODE)

	FIELD 1
	*2000

CDCALL,	JMS I (200	/SEE WHAT THE PERSON WANTS
FIVE,	5
STAR,	5200		/IN SPECIAL MODE

BYPSCD,	JMS I (INTERC	/CATCH CALLS TO 7600

	TAD I (7600	/SAVE USER OUTPUT DEVICE
	DCA I (USEROD	/-FOR LATER


/ CHECK FOR ? IN OUTPUT SPECIFICATION
	TAD (-10	/8CHARACTERS TO LOOK AT
	DCA CNT		/CNT HAVING -10 PUTS US AT FIRST CHAR
S1C,	TAD (7605
	JMS I (GTSXBT	/GET A CHAR
	TAD (7701/(-"?!7700	/CHECK FOR ?
	SNA CLA
	JMP QINO	/? IN OUTPUT NOT ALLOWED
	ISZ CNT
	JMP S1C

/ CHECK FOR EMBEDDED * IN ANY SPECIFICATION

	TAD (7605
S4L,	DCA PTR
	TAD (-10
	DCA CNT
ACK,	TAD PTR
	JMS I (GTSXBT
	TAD (7726/(-"*!7700	/CHECK TO SEE IF CHARACTER *
	SZA CLA		/SKIP IF IT IS
	JMP CNTUP	/GO LOOK AT NEXT
	AC2
	TAD CNT		/ARE WE AT EXTENSION
	SZA		/SKIP IF YES
	TAD (6		/ARE WE AT START OF FILENAME?
	SNA CLA		/SKIP IF NOT
	ISZ CNT		/BUMP COUNT ONLY IF OK
	TAD PTR		/LOOK AT NEXT CHAR
	JMS I (GTSXBT
	SZA CLA		/SKIP IF ITS NULL - OK
	JMP AINO	/ERROR
CNTUP,	ISZ CNT		/BUMP TO NEXT CHAR
	JMP ACK		/CONTINUE CHECKING
	TAD I PTR	/ANY MORE INPUT
	SNA CLA		/SKIP IF THERE IS
	JMP NULLCK
	TAD FIVE	/BUMP TO NEXT ENTRY
	TAD PTR
	JMP S4L
/ CHECK FOR NULL OUTPUT SPECIFICATION AND MAKE *.*

NULLCK,	TAD I (7601	/WAS OUTPUT FILENAME GIVEN?
	SZA CLA		/SKIP IF NONE
	JMP DIDEML
	TAD STAR	/PUT AN ASTERISK IN
	DCA I (7601	/FILENAME
	TAD STAR
	DCA I (7604	/AND EXTENSION

/THIS CODE SETS A DEFAULT OUTPUT DEVICE ON DELETE

DIDEML,	TAD I (7600	/IS AN OUTPUT DEVICE SPECIFIED?
	SZA		/SKIP IF NOT
	JMP ODSPEC	/NOTE DEVICE NUMBER IN AC
	TAD I (OPT1	/CHECK FOR /D
	AND (400
	SZA CLA		/SKIP IF NOT /D
	TAD I (7605	/WE'LL SUBSTITUTE FIRST INPUT DEVICE FOR USER
ODSPEC,	AND (17		/CLEAR USER SPECIFIED LENGTH
	DCA I (7600	/WE KNOW BETTER

/THE FOLLOWING BRINGS IN THE OUTPUT DEVICE HANDLER,
/READS THE DIRECTORY INTO CORE AND VERIFIES IT.

	TAD (6601
	DCA HADDR2
	TAD I (7600	/IS THERE AN OUTPUT DEVICE?
	SZA
	JMS ASSIGN	/GET THE HANDLER AND ALLOCATE ITS SPACE
	DCA OUHAND	/AC RETURNS HANDLER ENTRY POINT
	TAD (2000
	AND OPT3
	SZA CLA
	JMP I (ZRODIR
	JMS I (ODIRIN	/READ IN THE OUTPUT DIRECTORY
			/  INCLUDES SOME INITILIZATION
	TAD (7605	/INGIALIZE INPUT POINTER

/THIS IS THE BEGINING OF THE INPUT FILE LOOP

DOMOIN,	DCA INFPTR	/POINTER TO CURRENT INPUT
	TAD (7201
	DCA HADDR2
	TAD I INFPTR	/WHEN 0 NO MORE INPUT
	SNA		/SKIP IF MORE TO DO
	JMP I (ENDCHK	/DO END PROCESSING
	JMS ASSIGN	/ASSIGN AND ALLOCATE SPACE FOR INPUT HANDLER
	DCA INHAND	/AND SAVE ITS ENTRY ADDRESS

	JMP I (PG1	/LINK TO NEXT SECTION
ONDERR,	JMS I (ERROR
	ODRERR+40	/ERROR READING OUT DIR
AINO,	JMS I (ERROR
	ILLA+40		/ILLEGAL *
QINO,	JMS I (ERROR
	ILLQ+40		/ILLEGAL ?

/
/
ASSIGN,	0
	JMS I (200
	1		/FETCH
HADDR2,	0
	JMP DEVERR
	TAD HADDR2	/RETURN ENTRY POINT ADDRESS
	JMP I ASSIGN
	PAGE
/CHECK FOR NON FILE STRUCTURED INPUT
/WE CAN'T HANDLE IT

PG1,	TAD I INFPTR
	TAD (7757
	DCA TEMP
	TAD I TEMP	/IS FILE STRUCTURED BIT ON
	SMA CLA
	JMP NFIN	/NOT FILE STRUCTURED!
	TAD I INFPTR	/ FILE STRUCTURED -- IS IT MTA?
	TAD NMTA
	SZA CLA
	JMP PG1X1	/NOT MTA
	CIF 0
	JMS I INHAND
	  REWIND
NMTA,	  0		/WASTED LOCATION USED FOR VARIABLE
	  0
	CLA
	DCA I (POSNL2
	DCA SDIRSW
PG1X1,	CIF 0
	JMS I INHAND	/READ INPUT DEVICES DIRECTORY
	1400
IDBUF,	INBUFR
	1
	JMP INDERR	/ERROR
	CDF 0
	TAD I IDBUF	/MAKE SURE THAT THE
	CMA CLL		/DIRECTORY OF
	TAD I (INBUFR+2	/THE DEVICE IS
	CDF 10		/GOOD
	SNL
	TAD (7700	/(SEE COMMENT ON TEST IN ROUTINE "ODIRIN")
	SZL CLA		/SKIP IF ITS GOOD
	JMP BIDIR	/ERROR

	DCA CNT
/SET SAME DEVICE FLAG FLAG 4000 IF /D

	TAD I (OPT1
	AND (400
	RTL CLL		/PUT /D BIT INTO AC 0
	RAL
	DCA SDFLG


/ COUNT NUMBER OF INPUTS FROM SAME DEVICE
/ALSO MAKE NULL INPUT FILENAMES *.*
/BUT ONLY IF NOT /D

	TAD INFPTR	/OK LETS GO THROUGH
	DCA PTR		/THE INPUT SPECIFICATIONS
GETCNT,	ISZ PTR		/POINT TO FILENAME WORD
	TAD (3		/SET TEMP TO POINT TO EXTENSION
	TAD PTR
	DCA TEMP
	TAD SDFLG	/ARE WE DOING /D
K7450,	SNA		/SKIP IF YES - AC NON 0
	TAD I PTR	/NO /D - LOOK AT FILENAME
	SZA CLA		/ITS NULL PUT IN *.*
	JMP NOSUB	/DONT CHANGE IT
	TAD (5200	/MAKE IT *
	DCA I PTR
	TAD (5200	/.*
	DCA I TEMP
NOSUB,	CLA IAC		/TEMP+1 POINTS TO NEW INPUT
	TAD TEMP
	DCA PTR
	ISZ CNT		/KEEP COUNT OF DEVICES IN GROUP
	TAD I (OPT2	/CHECK FOR /U (UGLY SWITCH)
	AND (50		/CHECKS BOTH /U AND /S
	SZA CLA		/SKIP IN NO /U
	JMP NOPTIM	/WERE FORCED TO DO ONE AT A TIME
	TAD I PTR	/COMPARE DEVICE NUMBERS
	CIA		/IN A GROUPING
	TAD I INFPTR
	SNA CLA		/SKIP IF NEW GROUP
	JMP GETCNT	/WE'LL DO ALL THE SAME AT ONCE
NOPTIM,	TAD CNT
	CIA		/NEGATE COUNT
	DCA INSCNT	/AS NUMBER OF INPUTS TO DO AT ONCE
	TAD PTR		/SAVE WHERE TO CONTINUE FOR REST
	DCA I (MOIN
/THE FOLLOWING CHECKS TO SEE IF A OPERATION
/IS BEING DONE FROM A DEVICE TO ITSELF

	TAD I (7600	/GET DEVICE NUMBER
	TAD (7646	/HANDLER ENTRY POINT TABLE
	DCA TEMP
	TAD I INFPTR	/GET INPUT ENTRY POINT
	TAD (7646
	DCA PTR
	TAD I PTR	/CHECK INPUT ENTRY POINT AGAINST
	CIA
	TAD I TEMP	/OUTPUT ENRTY POINT
	SNA CLA		/SKIP IF THEY ARE DIFFERENT
	ISZ SDFLG	/SET SAME DEVICE FLAG, AC11
	DCA BDPTR	/START OF DIRECTORY
	DCA TYPFND	/CLEAR FOUND FILE FLAG
	JMP I (NBLOCK	/LINK TO SOME MORE

TYPFND,	0
SDFLG,	0		/NEGATIVE MEANS /D, ODD MEANS OUTPUT DEV=INPUT DEV

NFIN,	JMS I (ERROR
	NFLEIN+40	/NON FILE STRUCTED INPUT
INDERR,	JMS I (ERROR
	BADIRD+40	/ERROR READING INPUT DIR
BIDIR,	JMS I (ERROR
	BIDIRM+40	/NOT A GOOD DIRECTORY

/
/
	PAGE
/THIS IS THE SUPERQUASIFACETED DIRECTORY PATTERN MATCHING ROUTINE

/THE INPUT DIRECTORY IS SEARCHED HERE, IF A MATCH
/IS FOUND USING THE INPUT GROUPING
/GOT1 GETS CONTROL WITH -BLOCKS IN THE AC

NBLOCK,	STA
	TAD BDPTR	/POINTER TO START OF DIR BLOCK
	DCA XR
	CDF 0
	TAD I XR	/GET COUNT OF NUMBER OF ENTRIES
	DCA ENTCNT	/SAVE LOCALLY TO AVOID HERB'S BUG
	TAD I XR	/GET BLOCK NUMBER FIRST FILE
	DCA BLOCK
	TAD I XR	/NEXT SEGMENT NUMBER
	DCA LFLAG	/IF IT 0 WE AT END
	ISZ XR		/SKIP TENTATIVE FILE WORD
	TAD I XR	/GET -NUMBER OF INFO WORDS
	CIA		/MAKE POSITVE
	DCA INFWDS
	TAD XR		/POINT TO FIRST
	IAC		/ENTRY
	DCA EPTR

BLOOP,	TAD I EPTR	/GET FILENAME WORD
	CDF 10
	SNA CLA		/SKIP IF FILE HERE
	JMP EMPTY	/NO... ITS REALLY AN EMPTY
	TAD INSCNT	/SET NUMBER OF INPUT TO LOOK
	DCA NCNT	/AT ALL AT ONCE
	DCA MATFLG	/CLEAR MATCH FLAG
	TAD INFPTR	/ADDRESS OF FIRST INPUT
	SKP
MN1,	TAD GPTR2	/ADDRESS OF CURRENT INPUT
	TAD (5		/GTSXBT SUBR REQUIRES US TO
	DCA GPTR2	/POINT TO END OF FIELD
	TAD EPTR	/POINT DIRECTORY POINTER TO
	TAD (4		/END OF ENTRY FOR SAME REASON
	DCA GPTR1
	TAD GPTR1	/SET EPNEXT TO POINT TO
	TAD INFWDS	/MINUS NUMBER OF BLOCKS IN
	DCA EPNEXT	/FILE WORD
	TAD (-10	/NUMBER OF CHARS TO LOOK AT
WILDNM,	DCA CNT
MLP,	TAD GPTR2	/OK - GET A CHARACTER FROM
	JMS I (GTSXBT	/STRING
	TAD (7726/(-"*!7700	/IS IT AN *
	SNA		/SKIP IF NOT *
	JMP WILDA	/YEP... ITS A WILD CARD
	TAD ("*-"?	/IS IT A ?
	SNA		/SKIP IF NOT
	JMP WILD	/YES... FORCE MATCH ON THIS CHAR
	TAD ("?&77	/RESTORE VALUE
	CIA		/NEGATE
	DCA CHAR	/AND SAVE
	TAD GPTR1	/NOW GET CHAR FROM DIRECTORY
	CDF 0
	JMS I (GTSXBT
	CDF 10
	TAD CHAR	/DO CHARS MATCH
	SZA CLA		/SKIP IF THEY DO
	JMP NM1		/NO MATCH ON THIS INPUT
WILD,	ISZ CNT		/BUMP COUNT OF CHARS & POINTER
	JMP MLP		/COMPARE ALL 8
MEXT,	ISZ MATFLG	/A MATCH!!!!!!!
NM1,	CLA		/WILD CARD COMES HERE WITH ICHY AC
	ISZ NCNT	/HAVE WE CHECKED GROUP OF INPUTS
	JMP MN1		/NO CHECK WHOLE GROUP
	TAD MATFLG	/HAVE THERE BEEN ANY MATCHES
	SZA CLA		/SKIP IF NOT
	TAD (4		/WILL INVERT /V SWITCH
	TAD I (OPT2	/ADD SWITCH
	AND (4		/ISOLATE IT
	CDF 0
/SKIPS IF INPUT DIRECTORY ENTRY IS NOT CANDIDATE
/THAT IS - IF A MATCH WAS NOT FOUND BETWEEN ANY
/OF THE INPUTS AND /V WAS NOT SPECIFIED   OR
/A MATCH WAS FOUND AND /V WAS SPECIFIED

/THIS ALLOWS /V TO MEAN EVERYTHING BUT...

	SZA CLA
	TAD I EPNEXT	/GET -NUMBER OF BLOCKS
	CDF 10
	SZA		/SKIPS IF TENTATIVE OR NOT CANDIDATE
	JMP I (GOT1	/PROCESS FILE
NENT,	TAD EPNEXT	/POINT EPTR TO BLOCK
	DCA EPTR	/COUNT OF FILE
	SKP
EMPTY,	ISZ EPTR	/ON EMPTY MAKE EPTR POINT TO BLOCK COUNT
	CDF 0
	TAD I EPTR	/GET BLOCK COUNT
	CIA		/MAKE POSITIVE
	TAD BLOCK
	DCA BLOCK	/KEEP SUM
	ISZ EPTR	/POINT TO NEXT ENTRY
	ISZ ENTCNT	/BUMP THE NUMBER OF ENTRIES
	JMP BLOOP	/NOT DONE WITH SEGMENT
	CDF 10
	TAD (400	/BUMP TO NEXT SEGMENT
	TAD BDPTR
	DCA BDPTR
	TAD LFLAG	/DID WE PROCESS LAST SEGMENT
	SZA CLA		/SKIP IF WE DID
	JMP NBLOCK	/PROCESS NEW SEGNENT
	JMP I (SAYNON

/HANDLE WILD CARDS

WILDA,	TAD CNT		/GET CURRENT CHAR POSITION
	TAD (6		/ADD SIZE OF FILENAME
	SPA		/SKIP IF IN EXTENSION FIELD
	JMP WILDNM	/THIS BUMPS TO EXTENSION
	JMP MEXT	/THIS MEANS IT HAS TO BE A MATCH


CHAR,	0
EPNEXT,	0
GPTR2,	0
LFLAG,	0
NCNT,	0
BLOCK,	0
MATFLG,	0
ENTCNT,	0


	PAGE
GOT1,	DCA IFCNT	/-# OF BLOCKS IN AC
	JMS I (DATCHK	/VERIFY IF /C OR /O ALSO MATCH
	TAD I INFPTR
	TAD NMTA
	SZA CLA		/MAG-TAPE INPUT?
	JMP SUBL30	/NO
	IAC		/YES - IF DIRECT SAYS > 1 BLOCK
	TAD IFCNT	/  IT IS A SUB-FILE DIRECTORY
	SPA CLA
	JMP SUBL4
SUBL30,	ISZ I (TYPFND	/COMES BACK IF THEY DO - 
			/TURN OFF NO FILES MSG FOR THIS INPUT GROUP
SUBL10,	TAD I (OPT2	/CHECK FOR /T
	AND (60		/USE TODAY'S DATE IF /S OR /T
	SNA CLA		/SKIP IF /T
	TAD INFWDS	/SEE IF DATE PRESENT
	CDF 0
	SZA CLA		/SKIP IF NO DATE OR /T
	TAD I GPTR1
	CDF 10
	SZA		/SKIP IF NO DATE OR /T
	DCA I (DATE	/GIVE MONITOR FILES DATE
	TAD (-4		/MAKE 2 COPIES -- REENTER FROM SFD SETUP
	DCA CNT		/OF THE INPUT
	CMA		/FILE NAME IN
	TAD EPTR	/FIELD 1 TO
	DCA XR		/WORK WITH THEM
	TAD (SPOT-1	/MAKE THEM AT SPOT
	DCA XR1		/AND SPOT1
	TAD (SPOT1	/SPOT1 WILL ALWAYS
	DCA PTR		/CONTAIN THE ORIGINAL
MOVENT,	CDF 0		/AND SPOT WILL
	TAD I XR	/CONTAIN THE
	CDF 10		/UPDATED VERSION AS
	DCA I PTR	/REFLECTED FROM
	TAD I PTR	/THE OUTPUT SPECIFICATION
	ISZ PTR		/-
	DCA I XR1	/-
	ISZ CNT		/-
	JMP MOVENT	/-
	TAD I (7601	/GET OUTPUT FILENAME
	TAD (-5200	/WAS IT *
	SNA CLA		/SKIP IF NOT
	JMP TSTEXT	/YES... LEAVE FILENAME ALONE
	TAD I (7601	/REPLACE INPUT NAME
	DCA I (SPOT	/WITH GIVEN
	TAD I (7602	/OUTPUT
	DCA I (SPOT+1	/SPECIFICATION
	TAD I (7603
	DCA I (SPOT+2	/-
TSTEXT,	TAD I (7604	/SEE IF EXTENSION
	TAD (-5200	/WAS *
	SNA CLA		/SKIP IF IT WASNT
	JMP .+3		/LEAVE INPUT DEFAULT ALONE
	TAD I (7604	/REPLCE EXTENSION
	DCA I (SPOT+3	/WITH GIVEN EXTENSION
	DCA TRFLG	/CLEAR THE TRANSFER FLAG
	TAD I (OPT2	/IS /R ON?
	AND (100
	TAD I (SDFLG	/OR /D OR INPUT DEV=OUTPUT DEV?
	SNA		/SKIP IF ANY
	JMP SETGD	/WE ARE DEFINITELY OK
	SMA CLA		/IF /D THEN CHECK OUTPUT
	TAD (SPOT1-SPOT	/OTHERWISE INPUT
	JMS I (LOOKUP
	JMP NSETGD	/NO OUTPUT FILE GIVEN
	SNA		/AC=BLOCK NO OF FILE OR 0 IF NONE
	JMP I (NENT	/NO FILE - DO NOTHING
	DCA TEMP	/SAVE - WE MIGHT NEED IT
	TAD I (SDFLG	/IF OPERATION IS TRANSFER THEN
			/TRFLG IS SET IF FILE HAS NOT
			/MOVED; IF /D TRFLG MUST NOT BE
			/SET ; WE DONT CARE ABOUT
			/RENAME - ITS IRRELEVANT.
	SMA CLA		/SKIP IF /D- WILL CAUSE TRFLG=0
	TAD TEMP	/GET THE BLOCK FILE IS NOW AT
	CIA		/CHECK AGAINST ORIGINAL
	TAD I (BLOCK	/LOCATION
	SNA CLA		/SKIP IF IT MOVED - NOTE THAT
			/IF THIS SKIPS THE USER IS DOING
			/A PLAY WITH DEATH OPERATION
SETGD,	ISZ TRFLG	/ENABLE TRANSFERING OF THE FILE
	JMP NSETGD
PAGE
NSETGD,	TAD I (SDFLG	/SET UP TO PROMPT OR LIST
	SPA CLA		/SKIP IF NOT /D
	TAD (SPOT-SPOT1	/USE OUTPUT NAME
	TAD (SPOT1+4	/USE INPUT NAME
	JMS I (PRINTE	/SEE IF HE WANTS TO BE PROMPTED
FLSRSM,	TAD I (OPT2
	RTL		/PUT /N INTO LINK
	AND (400	/ISOLATE /R OPTION
	SZA CLA		/SKIP IF NOT /R
	JMP I (RENAME	/GO TO RENAME CODE
	TAD I (SDFLG	/CHECK FOR NO /D AND SAME DEV
	SPA SNA CLA	/SKIP IF NO /D AND SANE DEV
	TAD I (7600	/IS THERE AN OUTPUT?
	SNA SZL		/SKIP IF NO /N AND OUTPUT DEV
			/DIDNT SKIP IF NO /D AND SAME DEVICE
	JMP NODEL	/DONT DELETE
	JMS I (FAKUSR	/FAKE USR HANDLER CALLS
	JMS I (200	/CALL USR
	4		/CLOSE
	SPOT		/OUTPUT FILE NAME
	0
	CLA SKP		/O.K. TO GET CLOSE ERROR NOW
	ISZ I (WRTDIR	/SIGNAL CHANGE MADE TO DIRECTRY
	JMS I (UNFAK	/FIXUP HANDLER ADDRESS AGAIN
NODEL,	CLA
	TAD TRFLG	/SET AC NOT 0 IF TRANSFER GO AHEAD
	JMP I (NPG	/LINK TO SOME MORE

TRFLG,	0


/THIS PAGE OF CODE PERFORMS FILE MOVES FROM
/INPUT TO OUTPUT

NPG,	SNA CLA		/SKIP IF WE CAN DO TRANSFER
	JMP NFUNCT	/GO PROCESS NEXT ENTRY
F2C1,	TAD (17
	DCA BUFSIZ
	TAD I INFPTR
	TAD NMTA
	SZA CLA
	JMP .+5
	DCA IFCNT	/MAKE INPUT FILE LENGTH 4096 BLOCKS IF
			/MAG-TAPE INPUT
	TAD I (BLOCK
	JMS POSN	/THEN POSITION TAPE
	  INHAND
	TAD (SPOT	/SET THE ADDRESS OF THE
	DCA SBLKN	/OUTPUT NAME
	TAD I (7600	/IS THERE AN OUTPUT FILE?
	SNA		/SKIP IF THERE IS
	JMP NFUNCT	/DO NO TRANSFER
	TAD (7757	/INDEX INTO TENTATIVE FILE
	DCA MSIZE	/TABLE IN ORDER TO
	TAD I MSIZE	/CLEAR OUT ANY
	AND (7770	/TENTATIVE WE DONT WANT
	DCA I MSIZE	/THIS COMES IF AN I/O ERROR HIT
	TAD I (7600	/DO THE ENTER
	JMS I (FAKUSR	/MAKE USR USE IN CORE HANDLER
	JMS I (200
	3		/ENTER
SBLKN,	SPOT
MSIZE,	0
	JMP I (NOROOM	/ENTER FAILED
	TAD I (SVDATE	/RESTORE REAL DATE TO MONITOR
	DCA I (DATE
	JMS I (UNFAK	/REMOVE OUR FAKE HANDLER
	JMS I (ADDINF	/COPY ADDITIONAL INFO WORDS
	TAD MSIZE
	DCA TEMP
	DCA INEOF	/CLEAR INPUT END OF FILE
	TAD SBLKN	/SET THE OUTPUT BLOCK NUMBER
	DCA OBLCKN
	TAD I (BLOCK	/SET THE INPUT BLOCK NUMBER
	DCA BLOCKN

	TAD I (7600
	TAD NMTA
	SZA CLA
	JMP SUBL11
	TAD (40		/OUTPUT TO MTA
	AND I (OPT2	/IS IT ALSO /S?
	SZA CLA
	JMP SUBL1	/YES - GO HANDLE IT
	TAD SBLKN
	JMS POSN	/POSITION MAG-TAPE TO OUTPUT
			/FILE IF OUTPUT TO TAPE
	  OUHAND
	JMP SUBL11
PAGE
SUBL11,	DCA SBLKN
MOVEIT,	TAD IFCNT	/GET THE NUMBER OF BLOCKS
	CLL		/ITS NEGATIVE
	TAD BUFSIZ	/ADD ON BUFFER SIZE
	DCA IFCNT	/SAVE IT -- IF +, CONTAINS # BLOCKS
			/  17 EXCEEDS DISTANCE TO EOF;
			/  LINK = 1 IF EOF
	SZL		/LINK=0 IF EOF NOT REACHED
	TAD IFCNT	/GET BACK IF OVERFLOW
	CIA		/SUBTRACT THESE EXTRA BLOCKS
			/  SETS LINK IF EOF NOT REACHED;
			/  CLEARS LINK IF EXACTLY 17 BLOCKS TO EOF;
			/  LINK LEFT SET (& AC=(# BLOCKS TO EOF)-17)
			/    IF EOF
	TAD BUFSIZ	/FROM BUFFER SIZE
			/  COMPLEMENTS LINK IF LATER CASE
			/  THUS LINK=0 AND AC=# BLOCKS LEFT
			/  TO TRANSFER IF EOF.  AC=17 IF NO EOF
			/NOTE: LINK IS CLEAR HERE IF THIS READ
			/	INCLUDES LAST BLOCK OF FILE
	SZL
	JMP .+4
	DCA SBLKN	/SAVE FOR INCREMENTING BLOCKS XFERRED
	TAD SBLKN
	ISZ INEOF	/SET EOF SWITCH
	RTR CLL		/BUILD THE
	RTR		/INPUT CONTROL
	RTR		/WORD
F2C2,	TAD (20		/BECOMES NOP IF ONLY 8K
	DCA INCTLW	/SET INPUT CONTROL WORD
	JMS I (CINTER	/CHECK FOR ^C
	SKP		/SKIP IF NOT
	JMP I (CTCDE	/ABORT OPERATION
	AC4000
	TAD INCTLW
	DCA OUCTLW
	CIF 0
	JMS I INHAND	/READ INPUT HUNK
INCTLW,	0
	0
BLOCKN,	0
	JMS EOF
	CLL
	TAD SBLKN	/RESIDUAL BLOCKS FOR SOFTWARE EOF
	SNA		/RETURNED FROM EOF OR SBLKN
			/  (OUCTLW MODIFIED BY EOF IF NECESSARY
	TAD BUFSIZ
	TAD MSIZE
	SZL
	JMP I (NOROOM
	DCA MSIZE
	TAD BLOCKN	/UPDATE BLOCK COUNT
	TAD BUFSIZ
	DCA BLOCKN
	ISZ I (MUSTWT	/SIGNAL REAL OUTPUT DONE
	CIF 0
	JMS I OUHAND	/WRITE A HUNK OF FILE
OUCTLW,	0
	0
OBLCKN,	0
	JMP I (WRTERR	/WHAT A CRUMBY OUTPUT DEVICE
	TAD OBLCKN	/UPDATE THE
	TAD BUFSIZ	/OUTPUT FILE
	DCA OBLCKN	/BLOCK NUMBER
	TAD INEOF	/SEE IF THATS ALL FOLKS
	SNA CLA		/SKIP IF WE TRANSFERED FILE
	JMP MOVEIT	/DO SOME MORE
	JMP EOFCNT
	PAGE
EOFCNT,	TAD TEMP
	CIA
	TAD MSIZE
	DCA OFCNT	/NUMBER OF BLOCKS WRITTEN TO NEW FILE
	TAD I (7600
	TAD NMTA
	SZA CLA
	JMP GTXA1
	IAC		/IF MAG-TAPE, MAKE IT ONLY 1 BLOCK
	DCA OFCNT
	ISZ I (POSNL2
	CIF 0
	JMS I OUHAND
	  WRTEOF
	  0
	  0
	  HLT
	ISZ FCOUNT
GTXA1,	TAD I (7600	/OK - LETS MAKE IT PERMANENT
	JMS I (FAKUSR	/TELL USR TO USE INCORE HANDLER
	JMS I (200
	4		/CLOSE
	SPOT
OFCNT,	0
	JMP I (CLOERR	/THIS IS IMPOSSIBLE (I HOPE)
	JMS I (UNFAK	/ENABLE SYSTEM USE OF REAL HANDLER
	ISZ I (WRTDIR	/SET WE CHANGED DIRECTORY FLAG
	TAD I INFPTR
	TAD NMTA
	SZA CLA
NFUNCT,	JMP I (NENT	/I KNOW ITS INEFFICIENT TO JUMP HERE
			/BUT- IT'S CLEAN...
	TAD I (EQLS	/THIS CODE ALOWS = OPTION TO READ NN
			/  FLES STARTING WITH SPECIFIED FILE
	SPA SNA CLA
	JMP I (NENT
	CMA CLL
	TAD I (EQLS
	SNA
	CLL		/CLEAR LINK IF DONE WITH NN FILES
	DCA I (EQLS
	IAC
	TAD I (INFPTR
	DCA NFUNZ
	SNL
	JMP NFUNXX	/CLEAR *.* AFTER LAST FILE
	TAD (5200	/MAKE INPUT FILE *.*
	DCA I NFUNZ
	ISZ NFUNZ
	DCA I NFUNZ
	ISZ NFUNZ
	DCA I NFUNZ
	ISZ NFUNZ
	TAD (5200
NFUNXX,	DCA I NFUNZ
	JMP I (NENT
NFUNZ,	0
/TYPE TAKES A CHARACTER IN THE AC AND CALLS
/TTY TO TYPE IT IF ^O IS NOT IN AFFECT
/ALSO CHECKS FOR ^C AND ^P

TYPE,	HLT
	DCA READKB	/SAVE CHARACTER
	JMS I (CINTER	/SEE IF ^C
	SKP		/NO
	JMP I (CTCDE	/ABORT OPERATION IF ^C OR ^P
	TAD (217	/^O
	JMS I (CTYPE	/SEE IF TYPED
	SKP		/SKIP IF NOT
	DCA ECHO	/CLEAR ECHO SWITCH
	TAD ECHO	/IS ECHO IN EFFECT
	SNA CLA		/SKIP IF YES
	JMP I TYPE	/IGNORE CHARACTER IF ^O
	TAD READKB	/TYPE CHAR
	JMS TTY
	JMP I TYPE

TTY,	0
	DCA TCHAR	/SAVE CHAR
	TAD TCHAR	/GET CHAR BACK
			/** NEXT 4 LOCATIONS REPLACED IF BATCH ACTIVE BY:
TTYOUT,	TLS		/** SKP
	TSF		/** 7400	/ADDRESS OF BATCH OUTPUT ROUTINE
	JMP .-1		/** CIF TOPFIELD
	CLA		/** JMS I .-2
	TAD TCHAR	/GET CHAR AGAIN
	TAD (-215	/IF WE JUST TYPED A C.R. TYPE
	SZA CLA		/A L.F.
	JMP I TTY
	TAD (12
	JMP TTY+1
TCHAR,	0

/GET A CHARACTER FROM KEYBOARD AND
/CHECK FOR ^C AND ^P

READKB,	HLT
	KSF
	JMP .-1
	JMS I (CINTER	/IS IT ^C
	SKP		/SKIP IF NOT
	JMP I (CTCDE	/YES
	KRB		/READ IT
	AND (177	/AND GET RID OF
	TAD (200	/PARITY
	JMP I READKB

ECHO,	1


	PAGE
/THIS IS THE CORE DEVICE HANDLER
/THE USR IS MADE TO COME HERE BY A CALL TO FAKUSR.
/THIS HANDLER SWAPS THE DESIRED BLOCK INTO
/THE USR AREA AND WRITES THE BLOCK BACK INTO THE
/INCORE DIRECTORY.

/THE CODE SET UP IN FIELD 0 TO CALL THE HANDLER IS:
/	*FAKHND
/	0		/ENTRY POINT
/	TAD FAKHND	/GET RETURN ADDRESS
/	CIF CDF 10
/	JMP I .+1	/PLOP UP TO BODY OF HANDLER IN FIELD 1
/	FAKBDY


FAKBDY,	DCA RETLOC	/SAVE ARGUMENT ADDRESS
	DCA DCATMP
	TAD I RETLOC	/GET CONTROL WORD
	SPA CLA
	ISZ DCATMP
	ISZ RETLOC	/BUMP TO LOCATION (ALWAYS 1400 FROM USR)
	ISZ RETLOC	/BUMP TO BLOCK NUMBER
	TAD I RETLOC	/GET IT
	ISZ RETLOC	/BUMP TO ERROR RETURN
	ISZ RETLOC	/NOW TO GOOD RETURN (WE WONT FAIL)
	CLL RTR		/MULTIPLY BY 400(8)
	RTR
	RAR
	TAD (OUBUFR-401	/ADD ON TO BEGINING OF DIRECTRY
DCAXR1,	DCA XR1		/SAVE IN BOTH XR1
	TAD (1377
	DCA XR2		/AND XR2
	TAD (-400	/SET WORD TRANSFER COUNT 
	DCA CNT
	TAD DCATMP
	SNA CLA
	JMP DCAL1
	TAD I XR2	/WRITE
	CDF 0
	DCA I XR1
	CDF 10
	ISZ CNT
	JMP .-5
	JMP I RETLOC
DCAL1,	CDF 0		/READ
	TAD I XR1
	CDF 10
	DCA I XR2
	ISZ CNT
	JMP .-5
	JMP I RETLOC
/
DCATMP,	0
/THIS ROUTINE DOES THE SETUP OF THE INCORE
/DIRECTORY HANDLER AND CHANGES THE REAL
/HANDLERS ENTRY POINT IN THE MONITOR SO THAT
/THE USR WILL CALL IT.

FAKUSR,	0
	DCA UNFAK	/SAVE DEVICE NUMBER
	TAD UNFAK	/INDEX INTO MONITORS RESIDENCY
	TAD (7646	/TABLE
	DCA TABAD
	TAD WRTDIR	/SEE IF DEVICE HAS DIRECTORY
	SPA CLA		/SKIP IF IT DOES
	JMP NOSUBST	/!!!DONT CHANGE IF NON-FILE DEV
	TAD (FAKHND	/PUT OUR HANDLERS ADDRESS IN
	DCA I TABAD	/MONITORS TABLE
NOSUBST,TAD UNFAK	/RETURN WITH DEVICE NUMBER IN AC
	JMP I FAKUSR

UNFAK,	0
	CLA
	TAD OUHAND	/RESET MONITORS TABLE TO
	DCA I TABAD	/POINT TO REAL HANDLER
	JMP I UNFAK

TABAD,	0
RETLOC,	0
/ENTER HERE IF A BRANCH TO 7600 OR 7605 OCCURS

FIXDIR,	CLA		/JUST IN CASE
	JMS I (CINTER	/CHECK FOR ^C
	NOP
	AC4000		/EITHER WAY GO BACK TO
	DCA I (ALTOPT	/MONITOR BUT AFTER WE HANDLE DIRECTORY
CTCDE,	TAD MUSTWT	/IS MUST WRITE SET?
	SNA CLA		/SKIP IF /Q OR MUST WRITE
	TAD WRTDIR	/CHECK TO SEE IF WE HAVE TO
	SPA SNA CLA	/WRITE THE DIRECTORY
	JMP ENDCHK	/CONTINUE
	DCA WRTDIR	/KEEP OLD DIRECTORY
	JMS I (ERROR	/TELL HIM
	DSVED+40

ENDCHK,	ISZ I (ECHO	/TURN ON ECHO
	JMS DIROUT	/WRITE OUT THE OUTPUT DIRECTORY
	JMS I (RESTORE	/RESTORE 7600 IN FIELD 0
	DCA I (OPT2	/STOPS RECUSION WITH ^P
	JMS I (ERROR	/PRINT VERSION NUMBER
	VERNO+40
	TAD (215
	JMS I (TYPE
NOVER,	TAD I (ALTOPT	/GO BACK TO MONITOR?
	SMA CLA		/SKIP IF YES
	JMP I (CDCALL	/CALL THE CD AGAIN
	CIF CDF 0	/RETURN TO MONITOR
	JMP I (7605


MUSTWT,	0
SVDATE,	0
WRTDIR,	0
PAGE
DIROUT,	0		/ROUTINE TO WRITE THE OUTPUT DIRECTORY
	TAD WRTDIR	/AC>0 IF WE HAVE TO WRITE IT
	SPA SNA CLA	/SKIP TO WRITE DIRECTORY
	JMP I DIROUT
	DCA WRTDIR	/PREVENT RECURSION IF OUTPUT DEVICE ERROR
	TAD I (7600
	TAD NMTA
	SZA CLA
	JMP DIR01
	TAD SDIRSW
	SMA SZA
	JMP SUBL2	/OUTPUT SFD
	SZA CLA
	JMP SFDERR	/I&O TO SAME DEVICE OR DELETE
			/ILLEGAL FOR SUB-FILES
DIR02,	CIF 0
	JMS I OUHAND
	  REWIND
	  0
	  0
	  JMP MTERR
	DCA I (POSNL2
DIR01,	CIF 0
	JMS I OUHAND	/WRITE DIRECTORY BACK ONTO DEVICE
	5400
	OUBUFR
	1
	JMP I (ODERR	/IS HE IN TROUBLE...
	DCA WRTDIR	/CLEAR WRITE DIRECTORY FLAG
	JMP I DIROUT	/RETURN


SKPERR,	JMS ERROR
	  XSKPER+40
CORERR,	JMS ERROR
	  XCORER+40
	CIF CDF 0
	JMP I (7605
ZROERR,	JMS ERROR
	  XZROER+40
ZR1ERR,	JMS ERROR
	  XZR1ER+40
WRERR,	JMS ERROR
	  XWRERR+40
MTERR,	CLA
	DCA I (WRTDIR	/FIX RECURSION
	JMS ERROR
	  XMTERR+40
DEVERR,	JMS ERROR
	  XDEVER+40
SFDERR,	JMS ERROR
	  XSFDER+40
/ROUTINE WHICH ECHOES ^(CHAR) AND SKIP RETURNS IF
/ONE WE WANTED

CTYPE,	0
	DCA T2		/SAVE CHARACTER
	TAD (200	/GT RID OF PARITY
	KRS		/SEE WHATS IN BUFFER
	CIA
	TAD T2		/COMPARE AGAINST DESIRED ONE
	SNA CLA		/SKIP IF NOT ONE
	KSF		/IS FLAG UP?
	JMP I CTYPE	/NO... JUST RETURN
	KCC		/CLEAR CHARACTER
	TAD ("^		/OUTPUT ^
	JMS I (TTY
	TAD T2
	TAD (100	/CHAR
	JMS I (TTY
	TAD (215
	JMS I (TTY
	ISZ CTYPE	/SKIP RETURN
	JMP I CTYPE

T2,	0
	PAGE
/THIS ROUTINE MODIFIES THE THE MONITOR RETURN
/LOCATIONS TO COME BACK TO FOTP AND SAVES WHAT
/WAS THERE SO RESTORE CAN RESTORE THEM

INTERC,	0
	TAD I (DATE
	DCA I (SVDATE	/SAVE MONITOR DATE
	CDF 0
	TAD I (7600	/SAVE 7600,7601,7602,7605
	DCA SCODE	/AND REPLACE WITH
	TAD (CIF CDF 10	/CIF CDF 10
	DCA I (7600	/JMP I .+1
	TAD I (7601	/FIXDIR
	DCA SCODE+1	/7605 GETS JMP 7600
	TAD (5602	/THIS ENABLES FOTP TO WRITE
	DCA I (7601	/OUT DIRECTORY AN MANUAL ABORT
	TAD I (7602	/OR IF HANDLER PICKS UP ^C
	DCA SCODE+2	/AND TRIES TO GO TO MONITOR
	TAD (FIXDIR
	DCA I (7602
	TAD I (7605
	DCA SCODE+3
	TAD (5200
	DCA I (7605
	CDF 10
	TAD MTAPTR
	SNA CLA
	JMP I INTERC
	TAD (1777	/IF MTA0 IN SYSTEM, CHANGE IT
	AND I MTAPTR	/TO DIRECTORY DEVICE
	TAD (4000	/FOR THIS PROGRAM ONLY
	DCA I MTAPTR
	JMP I INTERC

/THIS ROUTINE SIMPLY RESTORES THE MONITOR
/LOCATIONS TO THEIR ORIGINAL VALUE

RESTORE,0
	TAD I (SVDATE	/RESTORE DATE
	DCA I (DATE
	CDF 0
	TAD SCODE
	DCA I (7600	/RESTORE LOCATIONS
	TAD SCODE+1
	DCA I (7601
	TAD SCODE+2
	DCA I (7602
	TAD SCODE+3
	DCA I (7605
	CDF 10
	TAD MTAPTR
	SNA CLA
	JMP I RESTORE
	TAD (1777	/GET RID OF DIRECTORY BIT AND
	AND I MTAPTR	/FORCE READ-ONLY BIT
	TAD (2000
	DCA I MTAPTR
	JMP I RESTORE

SCODE,	0;0;0;0
MTAPTR,	0
/THIS IS THE MAGIC MESSAGE PRINTER
/IT IS ACTUALLY USED MORE THAN JUST FOR ERROR MESSAGES
/IF THE MESSAGE ENDS WITH A % THEN THE OPERATION
/IS ABORTED OTHERWISE CONTROL IS RETURNED
/TO THE CALLER AND NO CRLF IS GIVEN
/ALL MESSAGES COMMING THROUGH HERE ARE ECHOED

ERROR,	0
	CLA CLL		/JUNK MIGHT BE IN AC
	TAD I (ECHO	/SAVE ECHO STATUS SO WE CAN
	DCA I (ECTMP	/RESTORE IT AFTER MESSAGE
	ISZ I (ECHO	/TURN ON ECHO
	TAD (-100	/USED SO WE CAN USE GTSXBT TO
	DCA CNT		/UNPACK THE MESSAGES
PLOOP,	TAD I ERROR	/CONTAINS ADDRESS OF MESSAGE
	CDF 0		/IN FIELD 0
	JMS I (GTSXBT	/GET CHARACTER
	CDF 10
	TAD (-45	/IS IT %
	SNA		/SKIP IF NOT
	JMP CRLF	/WE HIT EOM AND CALLER NO WANT CONTROL
	TAD ("%&77	/RESTORE CHARACTER
	DCA DFLAG	/SAVE IT FOR LATER
	TAD DFLAG	/PRINT IT, 0 PRINTS AS BLANK
	JMS I (CONVTP
	ISZ CNT		/BUMP TO NEXT CHAR IN MESSAGE
	TAD DFLAG	/ARE WE AT END
	SZA CLA		/SKIP IF WE ARE
	JMP PLOOP	/DO ANOTHER CHARACTER
	ISZ ERROR	/SKIP ADDRESS OF MESSAGE
	JMP I ERROR	/RETURN
CRLF,	TAD (215	/PRINT CR
	JMS I (TYPE	/LF
	JMP I (ENDCHK	/FINISH PROCESSING

DFLAG,	0
	PAGE
/THIS ROUTINE PRINTS A FILENAME.EXTENSION

PNMSUB,	0
	DCA NMEPLC	/SAVE ADDRESS OF NAME
	TAD (-10	/SET CHAR COUNT
	DCA CNT
PNLOOP,	TAD NMEPLC	/GET THE SIXBIT CHAR
	JMS I (GTSXBT
	SZA		/SKIP IF NULL CHAR
	JMS I (CONVTP	/PRINT CHAR
	TAD (3		/SEE IF AT START OF
	TAD CNT		/EXTENSION
	SZA CLA		/SKIP IF SO
	JMP .+3
	TAD (".		/PRINT THE DOT
	JMS I (TYPE
	ISZ CNT
	JMP PNLOOP	/KEEP GOING
	JMP I PNMSUB

NMEPLC,	0
ECTMP,	0

RDERR,	JMS I (ERROR
	INERR+40	/ERROR READING FILE
DYSTF1,	TAD (SPOT1+4	/PRINT INPUT FILE NAME
DYSTUF,	JMS I (PNMSUB
	TAD (215
	JMS I (TYPE
	TAD ECTMP	/RESTORE ECHO FLAG AS
	DCA I (ECHO	/SAVED ON ENTRY TO ERROR
	JMP I (NENT	/GO TO NEXT FILE
WRTERR,	CLA
	TAD I (7600
	TAD NMTA
	SNA CLA
	JMP MTWERR
	JMS I (ERROR
	OUERR+40	/ERROR WRITING FILE
POUTNM,	TAD (SPOT+4	/PRINT OUTPUT FILE NAME
	JMP DYSTUF
NORUMX,	JMS I (ERROR	/NOT ENOUGH ROOM FOR
	SPRBLM+40	/FILE ON OUTPUT DEVICE
	JMP DYSTF1
/ROUTINE WHICH PRINTS NO FILES MSG IF NECESSARY
/IT WONT PRINT MESSAGE IF ANY FILE IN A SO CALLED
/INPUT GROUP MATCHES(A BUG?)

SAYNON,	TAD I (TYPFND	/GET INPUT MATCH FLAG
	SZA CLA		/SKIP IF NOTHING MATCHED
	JMP GOBCK	/DONT DO MESSAGE
TLP,	JMS I (ERROR	/PRINT MESSAGE
	NOFILE+40
	TAD INFPTR	/POINT TO END OF INPUT ENTRY
	TAD (5		/TO MAKE GTSXBT WORK CORRECTLY
	DCA INFPTR
	TAD INFPTR	/PRINT THE FILE NAME
	JMS I (PNMSUB
	TAD (OTAB-2	/NOW PRINT /V,/C,/O IF
	DCA XR2		/ANY OF THEM SPECIFIED
NOPT1,	ISZ XR2		/FIX POINTER WHEN SWITCH NOT ON
NOPT,	TAD I XR2	/GET ADDRESS OF OPTION
	SNA 		/SKIP IF NOT AT END
	JMP CRIT	/WE ARE AT END
	DCA TEMP
	TAD I TEMP	/GET OPTION WORD
	AND I XR2	/AND WITH OPTION BIT
	SNA CLA		/SKIP IF OPTION GIVEN
	JMP NOPT1	/DO ANOTHER
	TAD ("/		/PRINT /
	JMS I (TYPE
	TAD I XR2	/OPTION
	JMS I (TYPE
	JMP NOPT	/DO ANOTHER
CRIT,	TAD (215	/END WITH A CRLF
	JMS I (TYPE
	TAD ECTMP	/RESTORE ECHO FLAG THAT ERROR
	DCA I (ECHO	/SAVED
	ISZ INSCNT	/PRINT MESSAGE FOR ALL FILES
	JMP TLP		/IN GROUP
GOBCK,	TAD I (USEROD	/GET USER SPECIFIED DEVICE
	SNA CLA		/SKIP IF HE GAVE ONE
	TAD I (SDFLG	/IF HE DIDNT WE CANT HANDLE /D
	SPA CLA		/SKIP IF NO /D
	TAD I MOIN	/YEP. /D BETTER NOT BE ANY MORE INPUT
	SZA CLA		/THERE WASN'T - O.K.
	JMP DELERR	/WARN HIM OF THE SHORTCOMING
	TAD MOIN	/GET SAVED INPUT POINTER
	JMP I (DOMOIN	/AND DO SOME MORE INPUTS

DELERR,	JMS I (ERROR
	CNTDE2+40

USEROD,	0
MOIN,	0
/TABLE OF SWITCHES FOR "NO FILES" MESSAGE

OTAB,	OPT2
	4
	"V
	OPT1
	1000
	"C
	OPT2
	1000
	"O
	0

	PAGE
/THIS ROUTINE HANDLES THE /L AND /Q OPTIONS
/IF EITHER IS ON IT PRINTS THE NAME
/THEN IF ITS /Q IT PRINTS A ? AND WAITS FOR
/A RESPONSE. IF Y IT RETURNS, ANYTHING ELSE
/AND IT GOES TO PROCESS THE NEXT DIRECTORY ENTRY

PRINTE,	0
	DCA I (NMEPLC	/SAVE ADDRESS OF NAME
	TAD I (OPT1	/CHECK /L
	RAR
	SZL CLA		/SKIP IF NO /L
	JMP PIT		/PRINT NAME
	TAD I (OPT2	/CHECK /Q
	AND (200
	SNA CLA		/SKIP IF /Q
	JMP I PRINTE	/RETURN
	ISZ I (ECHO	/IF /Q FORCE ECHO ON
PIT,	TAD I (NMEPLC	/NOW PRINT FILENAME
	JMS I (PNMSUB
	DCA OKFLAG	/CLEAR OKFLAG
	TAD I (OPT2	/WAS IT /Q?
	AND (200
	SNA CLA		/SKIP IF /Q
	JMP FUNCT2	/JUST PRINT CRLF
	TAD ("?		/PRINT ?
	JMS I (TYPE
	CMA		/SET OKFLAG NO GOOD
	DCA OKFLAG
	JMS I (READKB	/GET A CHAR
	TAD (-"Y	/IS IT Y?
	SNA CLA		/SKIP ON NO
	ISZ OKFLAG	/IT WAS Y, SET OK AND SKIP
	TAD ("N-"Y	/GET N
	TAD ("Y		/GET Y
	JMS I (TYPE	/ECHO IT
FUNCT2,	TAD (215	/PRINT CRLF
	JMS I (TYPE
	TAD OKFLAG	/OKFLG=0 MEANS YES
	SZA CLA		/SKIP IF TO PROCESS FILE
	JMP I (NFUNCT	/SKIP THIS FILE
	JMP I PRINTE	/RETURN

ODERR,	CLA
	DCA I (WRTDIR	/FIX RECURSION
	JMS I (ERROR
	ODIERR+40	/ERROR WRITING DIRECTORY
BODIR,	JMS I (ERROR
	BODORM+40	/BAD OUTPUT DIRECTORY
CLOERR,	JMS I (ERROR
	SERR+40		/SYSTEM ERROR
	HLT		/DONT LET HIM CONTINUE
	JMP .-1		/IT CAN ONLY GET WORSE

SPOT,	ZBLOCK 4	/ROOM FOR OUTPUT FILE NAME
SPOT1,	ZBLOCK 4	/ROOM FOR INPUT FILE NAME
/CODE TO HANDLE OUT OF ROOM CONDITION ON OUTPUT DEVICE

NOROOM,	JMS I (UNFAK	/RESTORE THE REAL OUTPUT HANDLER
	TAD I (OPT1
	AND (100	/CHECK FOR THE /F OPTION SPECIFIED
	SNA CLA
	JMP I (NORUMX	/NO - GIVE AN ERROR MESSAGE
	JMS I (DIROUT	/FAILSAFING - WRITE OUT THE OUTPUT DIRECTORY
	JMS I (ERROR	/PRINT THE MESSAGE
	FLSFMS+40	/"MOUNT NEXT OUTPUT VOLUME"
	JMS I (READKB	/GET AN ANSWER
	CLA		/ANY CHAR EXCEPT ^C OR ^P IS YES
	TAD (215
	JMS I (TYPE	/PRINT CRLF
	JMS ODIRIN	/READ IN THE NEW OUTPUT DIRECTORY
	JMP I (FLSRSM	/RECOMPUTE THE PENDING TRANSFER.

ODIRIN,	0		/SUBROUTINE TO READ IN THE OUTPUT DIRECTORY
	TAD I (7600	/GET OUTPUT DEVICE NUMBER
	SNA		/IS IT PRESENT?
	JMP NOUTFL	/NO - DON'T READ OUTPUT DIRECTORY
	TAD (7757	/ADD ADDRESS OF MONITOR TABLE
	DCA TEMP	/TO INDEX INTO IT
	TAD I TEMP	/FILE STRUCTURED BIT IS 0
	SMA CLA		/SKIP IF DIRECTORY DEVICE
	JMP NOUTFL
	JMS OMTCK
	CIF 0
	JMS I OUHAND	/READ DIRECTORY
	1400
ODBUF,	OUBUFR
	1
	JMP I (ONDERR	/ERROR
	CDF 0
	TAD I ODBUF
	CMA CLL		/CHECK FOR LEGAL OUTPUT DIRECTORY - FIRST
	TAD I (OUBUFR+2	/WORD OF AN OS/8 DIRECTORY IS .LT. 50
	CDF 10
	SNL		/AND THE THIRD WORD MUST BE .LT. 7,
	TAD (7700	/SO WE CAN CHECK FOR THE SUM OF THOSE
	SZL CLA		/WORDS BEING .LT. 64
	JMP I (BODIR	/ERROR - CANT BE DIRECTORY
	SKP
NOUTFL,	AC4000		/WRTDIR MINUS MEANS DONT WRITE
	DCA I (WRTDIR	/DIRECTORY
	DCA I (MUSTWT	/CLEAR THE MUST WRITE FLAG
	DCA DIRKEY	/CLEAR THE OS/8 DIRECTORY KEY
	JMP I ODIRIN	/RETURN
	PAGE
/SUBROUTINE TO DO LOOKUPS ON OUTPUT DEVICE
/DOES IMMEDIATE RETURN IF NO OUTPUT DEVICE
/OTHERWISE RETURNS WITH BLOCK OF FILE IN AC   OR
/0 IN AC MEANING NOT FOUND OR NON-FILE STRUCTURED DEVICE
LOOKUP,	0
	TAD (SPOT	/ADDRESS OF FILE NAME
	DCA PLACE
	TAD I (7600	/GET OUTPUT DEVICE
	SNA		/SKIP IF PRESENT
	JMP I LOOKUP	/NO OUTPUT DEVICE
	JMS I (FAKUSR	/FAKE OUT THE USR
	JMS I (200
	2		/LOOKUP
PLACE,	SPOT
	0
	DCA PLACE	/NOT FOUND, 0 PLACE
	JMS I (UNFAK	/RESTORE RESIDENT HANDLER
	ISZ LOOKUP	/SKIP RETURN
	TAD PLACE	/WITH BLOCK IN AC
	JMP I LOOKUP
/HERE IS WHAT WE HAVE ALL BEEN WAITING FOR

    //////////////////////////////////////
   /					/
  /		RENAME		       /
 /				      /
//////////////////////////////////////

RENAME,	JMS LOOKUP
	JMP I (CLOERR	/SUPER SYSTEM DISATER
	SZA CLA		/SKIP IF LOOKUP FAILED
	JMP EXISTS	/WE DONT WANT TO CREATE 2 OF'EM
	TAD (SPOT1-SPOT	/LOOKUP INPUT FILE
	JMS LOOKUP
	JMP I (CLOERR	/SUPER SYSTEM DISASTER
	CLA		/IGNORE BLOCK
	TAD I (1404	/GET ADDRESS OF FILE
	TAD 17		/FROM MONITOR BY THE
	TAD (-4		/DOCUMENTED METHOD
	DCA TEMP
	TAD (SPOT-1	/GET NEW OUTPUT NAME
	DCA XR1
	TAD (-4		/SET UP COUNT OF WORDS TO MOVE
	DCA CNT
RNAM,	TAD I XR1	/MOVE THEM
	DCA I TEMP
	ISZ TEMP
	ISZ CNT
	JMP RNAM	/CONTINUE TIIL DONE
	TAD DIRKEY	/GET "SEGMENT IN CORE" KEY
	AND (7		/ISOLATE SEGMENT NUMBER
	DCA SEGNO	/NUMBER FOR WRITE
	CIF 0
	JMS I 51	/CALL HANDLER USR USED TO DO
	4210		/LOOKUP, THIS POINTS TO FOTPS
	1400		/INCORE DIRECTORY HANDLER
SEGNO,	0		/REWRITE UPDATED DIRECTORY BLOCK
	JMP I (CLOERR	/SYSTEM ERROR
	ISZ I (WRTDIR	/INDICATE DIRECTORY CHANGED
	JMP I (NFUNCT	/DO NEXT FILE


EXISTS,	JMS I (ERROR
	RENERR+40	/FILE ALREADY EXISTS
	JMP I (POUTNM
/THIS ROUTINE TRANSFERS THE ADDITIONAL
/INFORMATION WORDS OF THE INPUT FILE WHEN COPYING
/IT IF THERE ARE ANY

ADDINF,	0
	CLA IAC		/AC=1
	TAD I (1404	/GET NUMBER OF WORDS FROM OUTPUT DIRECTORY
	SMA		/SKIP IF 2 OR MORE
	JMP NOTRAN	/WE DONT TOUCH IT
	DCA LOOKUP	/SAVE NEGATIVE NUMBER TO MOVE
	TAD LOOKUP	/ADD NUMBER TO LOC 17
	TAD 17		/TO FIND ADDR(SECOND)
	DCA PPTR1	/USE 17
	TAD INFWDS	/GET NUMBER OF AIW IN INPUT
	CIA		/NEGATE
	IAC		/ADD 1
	SMA		/SKIP IF MORE THAN 1 AIW
	JMP ZEROUT	/ZERO OUTPUT AIW
	DCA TEMP	/SAVE COUNT
MOVEM,	ISZ GPTR1	/BUMP PTR (1ST TIME PAST DATE)
	CDF 0
	TAD I GPTR1	/GET WORD
ZLOOP,	CDF 10
	DCA I PPTR1	/PUT IT INTO OUTPUT DIRECTORY
	ISZ PPTR1
	ISZ LOOKUP	/HAS OUTPUT COUNT OVERFLOWED?
	JMP MORE	/MORE OUTPUT TO DO
NOTRAN,	CLA		/EXIT
	JMP I ADDINF	/WERE DONE
MORE,	ISZ TEMP	/BUMP INPUT COUNT
	JMP MOVEM	/IT HASNT OVERFLOWED
ZEROUT,	CLA CMA		/NO MORE INPUT WORDS-
	DCA TEMP	/SO FIX UP TO ZERO REST OF OUTPUT WORDS
	JMP ZLOOP	/DO ALL THE OUTPUTS

PPTR1,	0
/ROUTINE USED TO DETERMINE IF ^C OR ^P TYPED

CINTER,	0
	TAD (203	/CHECK FOR ^C
	JMS CTYPE
	JMP UPPCK	/NO  CHECK FOR ^P
	JMP SPURGE	/YES SET ALTMODE BIT
UPPCK,	TAD (220
	JMS CTYPE
	JMP I CINTER	/NOT EITHER ^P OR ^C
	SKP		/IF ^P CLEAR ALTMODE BIT
SPURGE,	CMA		/SET BIT
	DCA I (ALTOPT
	ISZ CINTER	/SKIP RETURN
	JMP I CINTER
	PAGE
/** THIS IS THE STARTING ADDRESS OF FOTP!!!

FOTP,	JMS INIT	/REGULAR ENTRY POINT
	JMS INIT	/CHAIN ENTRY POINT
	JMP I (CDCALL	/CALL COMMAND DECODER
	JMP I (BYPSCD	/DONT CALL COMMAND DECODER
INIT,	0
	ISZ INIT	/DO SKIP RETURN
	CLA CLL
	CDF 0
	TAD I (7777	/GET BATCH CONTROL WORD
	AND (70
	TAD FCIF0	/FORM CIF TO BATCH FIELD
	DCA BATCIF
	TAD I (7777
	CDF 10
	RTL
	SNL CLA		/BATCH RUNNING?
	JMP NOBTCH	/NO
BMOVLP,	TAD BATOUT
	DCA I TTOUTP	/MOVE IN SUBSTITUTE TTY OUTPUT CODE
	ISZ BMOVLP
	ISZ TTOUTP
	ISZ TTCNT4
	JMP .-5
	STA
NOBTCH,	DCA CORFUJ	/ =0 IF NO BATCH, -1 IF BATCH
	JMS I (200	/LOOKUP MTA
	  12
	  DEVICE MTA0
MTADDR=.-1
	  0
	JMP FOTP1	/NO SUCH DEVICE
	TAD (6403	/PROTECT BATCH FROM MTA0: BUFFER
	DCA JSW
	TAD MTADDR	/GET DEVICE #
	CIA
	DCA NMTA
	TAD MTADDR
	SZA
	TAD (7757
	DCA I (MTAPTR
FOTP1,	TAD (2000	/SET RESTART LOCATION
	CDF 0
	DCA I (7745
	TAD JSW		/SET JSW
	DCA I (7746
	CDF 10
FCIF0,	CIF 0
	JMS I (CORE
	TAD CORFUJ	/COMPUTE AMOUNT OF CORE EXCLUDING BATCH FIELD
	TAD (-2
	SMA CLA		/SKIP IF WE HAVE ONLY 8K (OR 12K AND BATCH)
	JMP I INIT
	JMP CORERR		/MUST HAVE 12K OR MORE


TTCNT4,	-4
TTOUTP,	TTYOUT
BATOUT,	SKP		/OUTPUT TO BATCH LOG
	7400
BATCIF,	HLT
	TTYOUT+1&177+4600	/JMS I .-2
JSW,	6003
CORFUJ=FOTP		/SAVES SPACE
POSN,	0		/MOVE MAG-TAPE TO C(AC) FILE
	DCA POSNL4
	TAD I POSN	/GET HANDLER CALL
	DCA POSNL5
	TAD I POSNL5
	DCA POSNL5
	ISZ POSN
	TAD POSNL4	/SUBTRACT WANTED FILE NUMBER
	CIA CLL
	TAD POSNL2	/FROM OLD FILE NUMBER
	SNA
	JMP POSNL7	/IF ALREADY AT WANTED FILE, DO NOTHING
			/(SAVES LOTS OF TAPE MOVEMENT)
	SMA
	CMA		/MUST SKIP BACK ONE MORE TO GET TO
	DCA POSNL3	/  START OF FILE DESIRED
	RAR		/LINK IS SET IF BACKWARD SKIP
	TAD (SKPFIL	/MAKE FUNCTION WORD
	DCA POSNL1
	CIF 0
	JMS I POSNL5
POSNL1,	  SKPFIL
POSNL2,	  0		/STORES CURRENT FILE TO WHICH TAPE IS POSITIONED
POSNL3,	  0
	JMP SKPERR
	TAD POSNL1
	SMA CLA
	JMP POSNL7
	CIF 0		/MUST MOVE FORWARD PAST FILE MARK
			/IF ABOVE WAS BACKWARD SKIP
	JMS I POSNL5
	  SKPREC
	  0
	  -1
	  CLA		/ERROR IS OK -- DEC'S HANDLER PROBLEM
POSNL7,	TAD POSNL4
	DCA POSNL2
	TAD (400	/ /P (POSITION ONLY)?
	AND I (OPT2
	SNA CLA
	JMP I POSN	/NO
	TAD (40		/IGNORE /P IF /S UNTIL WE
	AND I (OPT2	/LOOKUP SUB FILE DIRECTORY
	SZA CLA
	JMP I POSN
	AC4000
	DCA I (ALTOPT
	JMP I (ENDCHK
POSNL4=FOTP+1
POSNL5=FOTP+2
PAGE
OMTCK,	0
	TAD I (7600
	TAD I (NMTA
	SZA CLA
	JMP I OMTCK
	DCA I (POSNL2
	CIF 0
	JMS I OUHAND
	  REWIND
	  0
	  0
	CLA
	JMP I OMTCK
EOF,	0		/PROCESS INPUT EOF
	AND (7677	/MASK OUT EOF ERROR
	SZA
	JMP I (RDERR	/HARD (NOT EOF) ERROR
	TAD I INFPTR
	TAD NMTA
	SZA CLA
	JMP I (RDERR	/NOT MAG-TAPE -- SOFT ERRORS ON OTHER DEVICES ILLEGAL
EOFL5,	CDF 20
	TAD (7000	/1ST LOC OF LAST BLOCK OF BUFFER
EOFL1,	DCA EOFL4
	TAD I EOFL4
	SZA CLA
	JMP EOFL2
	TAD (-400
	TAD EOFL4
	JMP EOFL1
EOFL2,	CDF 10		/EOFL4 POINTS TO LAST BLOCK WITH DATA
			/BUT THIS IS ONLY ^S^S (EOF INDICATION)
	ISZ I (POSNL2	/TELL POSN WE SKIPPED FILE MARKER
	ISZ I (INEOF	/SET SOFTWARE EOF SWITCH
	TAD EOFL4
	SNA
	JMP I (EOFCNT	/NOTHING TO WRITE OUT
	TAD (-7400	/REDUCE # BLOCKS TO XFER BY THE DISTANCE
			/BETWEEN EOFL4 AND END OF BUFFER
	CLL CML RAR
	TAD I (OUCTLW
	DCA I (OUCTLW
	TAD EOFL4
	CLL RTL		/CHANGE EOFL4 TO + # BLOCKS
	RTL		/  BEING TRANSFERRED
	RAL
	JMP I EOF
EOFL4,	0
/ROUTINE TO MAKE SURE USER SPECIFIED
//C AND /O SWITCHES CAUSE CORRECT MATCH WITH DATE

DATCHK,	0
	TAD I (OPT1	/CHECK /C
	JMS MDATE
	NOP		/RETURN HERE WITH AC=0 IF NO /C
	SZA CLA		/RETURN HERE WITH AC=0 IF DATES MATCH
	JMP I (NENT	/DATES DONT MATCH AND /C GIVEN
	TAD I (OPT2	/CHECK /O
	JMS MDATE
	CMA CLA		/SET AC=-1 IF NO /O
	SNA CLA		/RETURN HERE AC=0 IF DATES SAME
	JMP I (NENT	/DATES SAME WITH /O-IGNORE FILE
	JMP I DATCHK	/CONTINUE

MDATE,	0		//O AND /C ARE AC2
	RTL		/IS IT OPTION ON?
	SMA CLA		/SKIP IF IT IS
	JMP I MDATE	/NO- RETURN WITH 0 AC
	ISZ MDATE	/SKIP RETURN
	CDF 00
	TAD I GPTR1
	CDF 10
	CIA
	TAD I (SVDATE	/COMPARE WITH MONITORS, 0 IF =
	JMP I MDATE
PAGE
/EMPTY DIRECTORY
/
MTDIR,	-1	/ONE ENTRY
	 1	/FIRST "BLOCK" OF FIRST FILE
	 0	/NO ADD'L DIRECTORY SEGMENTS
	 0	/NO TENTATIVE FILES
	-1	/ONE ADD'L INFO WORDS
	 0	/EMPTY FILE
	 2	/LENGTH 4095 "BLOCKS"
/
/
ZRODIR,	TAD I (7600
	SNA
	JMP ZROERR	/NO OUTPUT DEVICE AT ALL
	TAD I (NMTA
	SZA CLA
	JMP ZROERR	/NOT MAG-TAPE
			/  OR DEVICE NOT MAGTAPE
	CIF 0
	JMS I OUHAND
	  REWIND
	  0
	  0
	CLA
	CIF 0
	JMS I OUHAND
	  5610		/INCLUDES ONE "JUNK" BLOCKTO
			/PROTECT END OF FILE MARK

	  MTDIR
	  1
	  JMP ZR1ERR
	CIF 0
	JMS I OUHAND
	  WRTEOF
	  0
	  0
	JMP ZR1ERR
	JMP I (ENDCHK
/THIS UTILITY ROUTINE RETURNS A SIX BIT
/CHARACTER FROM ANY FIELD (SET ON ENTRY)
/FROM ADDRESS IN AC-COUNT(IN HALF WORDS)

GTSXBT,	HLT
	CLL RAL		/DOUBLE POINTER ADDRESS
	TAD CNT		/ADD NEGATIVE DISPLACEMENT
	CML RAR		/GET WORD ADDRESS AGAIN
	DCA TEMP	/SAVE IT
	TAD I TEMP	/GET WORD
	SNL		/SKIP IF WE WANT RIGHT HALF
	JMS ROTR6	/MAKE LEFT HALF RIGHT HALF
	AND (77		/GET LOW SIX BITS
	JMP I GTSXBT


ROTR6,	0
	RTR
	RTR
	RTR
	JMP I ROTR6

/THIS TAKES A SIX BIT CHAR IN AC AND CONVERTS
/IT TO ASCII TO TYPE IT

CONVTP,	HLT
	SZA		/CONVERT 0 TO BLANKS
	TAD (240
	AND (77
	TAD (240
	JMS I (TYPE	/TYPE IT
	JMP I CONVTP
PAGE
/COME HERE IF /S (SUBFILE DIRECTORY) REQUESTED AND MTA
/IS THE OUTPUT DEVICE.  SUB-FILE DIRECTORY NAME IS OUTPUT
/NAME OR FIRST INPUT NAME.  THIS FILE IS ALREADY OPEN
/AS A TENTATIVE FILE.
/
/WRITE OUT DIRECTORY WITH TENTATIVE FILE
/
SUBL1,	CIF 0
	JMS I OUHAND
	  REWIND
	  0
	  0
	  JMP WRERR
	CIF 0
	JMS I OUHAND
	  5400
	  OUBUFR
	  1
	  JMP WRERR
/
/WRITE DUMMY SFD -- THIS WILL LATER BE WRITTEN OVER
/
	TAD SBLKN	/WHICH FILE
	DCA SFDBLK
	TAD SFDBLK
	JMS POSN
	  OUHAND
	CIF 0
	JMS I OUHAND
	  5610
	  MTDIR
	  1
	  JMP ZR1ERR
	CIF 0
	JMS I OUHAND
	  WRTEOF
	  0
	  0
	  JMP ZR1ERR
	ISZ POSNL2
/
/SAVE DEVICE CONTROL WORD
/
	TAD I (7600
	TAD (7757
	DCA DCTRX
	TAD I DCTRX
	DCA DCTRLW
	DCA DIRKEY	/GET RID OF OLD BLOCK IN USR
/
/SET UP EMPTY DIRECTORY
/
	IAC		/LEAVE ROOM FOR DIRECTORY
	TAD SBLKN
	CDF 0
	DCA I (OUBUFR+1	/FIRST FILE LOCATION
	CMA
	DCA I (OUBUFR	/ONE ENTRY
	DCA I (OUBUFR+2	/NO SEGMENTS
	DCA I (OUBUFR+3	/NO TENTATIVE FILES
	CMA
	DCA I (OUBUFR+4	/ONE ADD'L WORD
	DCA I (OUBUFR+5	/EMPTY FILE
	CLA CML RTL CLL
	DCA I (OUBUFR+6	/LENGTH 4095
	CDF 10
/
/SET SWITCH FOR SPECIAL DIRECTORY WRITE
/
	ISZ SDIRSW
/
/CLEAR FILE COUNT
/
	DCA FCOUNT
/
/CLEAR /S SWITCH & OUTPUT FILE NAME, THEN RESTART
/
	TAD (7737
	AND I (OPT2
	DCA I (OPT2
	TAD STAR
	DCA I (7601
	DCA I (7602
	DCA I (7603
	TAD STAR
	DCA I (7604
/
/SAVE NAME FOR CLOSE FUNCTION
/
	TAD SPOT
	DCA SNAME
	TAD SPOT+1
	DCA SNAME+1
	TAD SPOT+2
	DCA SNAME+2
	TAD SPOT+3
	DCA SNAME+3
	JMP SUBL10
/
SDIRSW,	0		/SUBFILE IN USE SWITCH
			/4000 => INPUT SFD
			/   1 => OUTPUT SFD
DCTRX,	0		/POINTER TO DEVICE CONTROL WORD
DCTRLW,	0		/SAVED DEVICE CONTROL WORD
FCOUNT,	0		/COUNTS FILES XFERRED IN SFD
SNAME,	0;0;0;0		/OUTPUT SFD NAME FOR CLOSE FUNCTION
SFDBLK,	0
PAGE
/WRITE OUT DIRECTORY -- IF MTA & SDIRSW
/
SUBL2,	CLA
	TAD SFDBLK	/GET LOCATION OF SFD
	JMS POSN
	  OUHAND
	CIF 0		/WRITE SUB-FILE DIRECTORY
	JMS I OUHAND
	  5400
	  OUBUFR
	  1
	  JMP WRERR
	CIF 0
	JMS I OUHAND
	  REWIND
	  0
	  0
	  JMP MTERR
	CIF 0
	JMS I OUHAND	/GET REAL DIRECTORY
	  1400
	  OUBUFR
	  1
	  JMP MTERR
	TAD I (DCTRX
	DCA SUBL3
	TAD DCTRLW	/RESTORE DEVICE CONTROL WORD
	DCA I SUBL3
	DCA DIRKEY	/ERASE OLD BLOCK IN USR
	IAC		/GET LENGTH OF THIS SUB-FILE
	TAD FCOUNT
	DCA SUBL3
	TAD I (7600
	JMS I (FAKUSR
	JMS I (200
	  4		/CLOSE THIS FILE
	  SNAME
SUBL3,	  0
	JMP I (CLOERR
	JMS I (UNFAK
	JMP DIR02	/GO WRITE OUT NEW DIRECTORY
PAGE
/HERE IF MTA IS INPUT AND FILE HAD >1 BLOCK LISTED IN DIRECTORY
/
SUBL4,	TAD (40
	AND OPT2	/IF NO /S SWITCH THIS IS SFD
	SNA CLA
	JMP SFDR	/BUT NO SO STATED.!
	TAD (5		/SKIP FIRST INPUT FILE SINCE IT IS
			/.SFD NAME
	TAD INFPTR
	DCA INFPTR
	TAD I INFPTR
	SZA
	JMP SUBL41
	TAD NMTA	/FORCE MTA0:*.* FOR SECOND
	CIA		/  FILE IF NONE STATED
	DCA I INFPTR
	TAD INFPTR
	DCA XR
	TAD (5200
	DCA I XR
	DCA I XR
	DCA I XR
	TAD (5200
	DCA I XR
	JMP SUBL42
SUBL41,	TAD NMTA
	SZA CLA
	JMP SFDR	/2ND FILE MUST ALSO BE MTA:
SUBL42,	TAD I (BLOCK	/ADD START LOCATION
	JMS POSN	/SKIP TO THIS POSITIN ON THE TAPE
	  INHAND
	AC4000
	DCA SDIRSW
	TAD (7737	/.OR. OUT /S SWITCH SO NO REENTRY
	AND OPT2
	DCA OPT2
	JMP I (PG1X1	/GO READ NEW INPUT DIRECTORY
/
/
SFDR,	JMS I (ERROR
	  XSFDR+40
MTWERR,	JMS ERROR	/MAG TAPE WRITE ERROR
	XMTWER+40
	TAD (215
	JMS I (TYPE
	TAD ECTMP
	DCA I (ECHO
	CIF 0
	JMS I OUHAND
	  WRTEOF
TFP,	  0
	  0
	  JMP WRERR
	ISZ POSNL2
	CLL CMA RAL	/-2 => AC
	TAD I (1403	/GET POINTER TO TENTATIVE FILE EXTENSION
	DCA TFP
	TAD (5252
	DCA I TFP	/MAKE EXTENSION '**'
	TAD I (7600
	JMS I (FAKUSR
	JMS I (200	/CLOSE DUMMY FILE
	  4
	  SPOT
	  1
	  JMP I (CLOERR
	JMS I (UNFAK
	ISZ I (WRTDIR
	ISZ FCOUNT
	TAD EPNEXT
	DCA TFP+1
	CDF 0
	TAD I TFP+1
	CDF 10
	JMP GOT1	/GO RESTART THIS TRANSFER
FIELD 0
*5600
/SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF
/BANKS IN AC.
/MUST RUN IN FIELD 0.

CORE,	0
	TAD	C6203
	RDF
	DCA	CORRTN
	CDF 0
	TAD I (7777
	AND (70
	SNA		/DOES LOCATION 7777 SPECIFY CORE SIZE?
	JMP CORELP	/NO
	CLL RTR		/YES - BELIEVE IT.
	RAR
	JMP CORRTN
CORELP,	CDF 0		/NEEDED FOR PDP-8L
	TAD TRYFLD	/GET FLD TO TST
	CLL RTL
	RAL
	AND	COR70	/MASK USEFUL BITS
	TAD	CORELP
	DCA	.+1	/SET UP CDF TO FLD
COR706,	0
	TAD I	CORLOC	/SAV CURRENT CONTENTS
	NOP		/HACK FOR PDP-8
	DCA	.-3
	TAD	.-2	/7000 IS A GOOD PATTERN
	DCA I	CORLOC
COR70,	70		/HACK FOR PDP-8.,NO-OP
	TAD I	CORLOC	/TRY TO READ BK 7000
	7400		/HACK FOR PDP-8,.NO-OP
	TAD	.-1	/GUARD AGAINST WRAP AROUND
	TAD	CORLOC+1	/TAD 1400
	SZA CLA
	JMP	.+5	/NON EXISTENT FLD EXIT
	TAD	COR706	/RESTORE CONTENS DESTROYED
	DCA I	CORLOC
	ISZ	TRYFLD /TRY NXT HIGHER FLD
	JMP	CORELP
	STA
	TAD	TRYFLD
CORRTN,	0
	JMP I	CORE
CORLOC,	COR70+2		/ADR TO TST IN EACH FLD
	1400		/7000+7400+1400=0
TRYFLD,	1		/CURRENT FLD TO TST
C6203,	6203

/
PAGE
/
FAKHND,	0
	TAD FAKHND
	CIF CDF 10
	JMP I .+1
	  FAKBDY
/FOTP'S ERROR MESSAGES
MSGS,

ILLQ,	TEXT /ILLEGAL ?%/
ILLA,	TEXT /ILLEGAL *%/
SERR,	TEXT /SYSTEM ERROR/
RENERR,	TEXT /ALREADY EXISTS-/
VERNO,	TEXT \[MTFOTP \
*.-1
	2660+VERSION	/"V" & VERSION #
	5660+SUBVER	/"." & SUBVERSION #
	TEXT \]\
BADIRD,	TEXT /ERROR READING INPUT DIRECTORY%/
ODRERR,	TEXT /ERROR READING OUTPUT DIRECTORY%/
ODIERR,	TEXT /ERROR WRITING OUTPUT DIRECTORY%/
SPRBLM,	TEXT /NO ROOM, SKIPPING-/
INERR,	TEXT /ERROR ON INPUT DEVICE-SKIPPING-/
OUERR,	TEXT /ERROR ON OUTPUT DEVICE-SKIPPING-/
NFLEIN,	TEXT /USE PIP FOR NON-FILE STRUCTURED INPUT%/
NOFILE,	TEXT /NO FILES OF THE FORM:/
BIDIRM,	TEXT /BAD INPUT DIRECTORY%/
BODORM,	TEXT /BAD OUTPUT DIRECTORY%/
CNTDE2,	TEXT /CAN'T HANDLE MULTIPLE DEVICE DELETES%/
DSVED,	TEXT /ORIGINAL DIRECTORY PRESERVED%/
FLSFMS,	TEXT /MOUNT NEXT OUTPUT VOLUME:/

XSKPER,	TEXT "UNABLE TO POSITION TAPE%"
XCORER,	TEXT "NOT ENUF CORE (12K REQD, 16K WITH BATCH)"
XZROER,	TEXT "MUST HAVE MTA0 AS OUTPUT DEVICE FOR /Z%"
XZR1ER,	TEXT "ERROR WRITING ZERO DIRECTORY%"
XWRERR,	TEXT "CAN'T WRITE ON MTA0%"
XMTERR,	TEXT "MAG TAPE ERROR%"
XDEVER,	TEXT "BAD DEVICE%"
XSFDER,	TEXT "CAN'T CHANGE EXISTING SUB-FILES%"
XMTWER,	TEXT "MAG-TAPE ERROR -- WILL TRY AGAIN"
XSFDR,	TEXT "ILLEGAL SFD SPECIFICATION%"
IFNZRO 6600-.&4000 <ERROR, __TABLE OVERFLOW__>
	$