software: Added more and more

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape7 / FOTP.PA

/3.1 OS/8 V3 FOTP		5-AUGUST-1975	(NOT HALLOWEEN)
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
\f/WITH FAILSAFE CHANGES	NOV 17, 1973	R.L.


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


/CORE MAP

/FROM TOP OF CORE

/	FIELD 2 GETS CONDITIONALLY USED AS BUFFER

/	FIELD 1
/		7777-7600	MONITOR
/		7577-4600	INCORE OUTPUT DIRECTORY
/		4577-2000	FOTP CODE
/		1777-0		RESIDENT USR
/
/	FIELD 0
/		7777-7600	MONITOR
/		7577-7200	ERROR MESSAGES
/		7177-0		WORK AREA AS:
/
/		AT TOP-	OUTPUT HANDLER IF NEEDED
/			1 OR 2 PAGES

/			INPUT HANDLER IF NEEDED
/			1 OR 2 PAGES

/			INPUT DEVICES DIRECTORY
/			(ONLY USED PORTION)

/			THE TRANSFER BUFFER IN 8K
/			IS WHAT EVER REMAINS.

/FIXES FOR MAINTENANCE RELEASE: (S.R. 5-AUG-75)

/1.	CHANGED COPYRIGHT DATE
/2.	INCORPORATED SEQ #1 PATCH (DSN MARCH 1975)
/	PERMITS FOTP TO RECOVER FROM A MONITOR ERROR 6
/	BY UNFAKING THE SYSTEM HANDLER
/3.	UPDATED FOTP VERSION NUMBER TO V8
/4.	ADDED SPACE FOR A PATCH LEVEL
/5.	ALLOWED /T SWITCH TO WORK IN CONJUNCTION WITH /R
/6.	PERMITS RENAMING A FILE TO IT'S OWN NAME
/7.	IF NO OUTPUT DEVICE IS SPECIFIED WITH /R,
/	ASSUME OUT DEV=INPUT DEVICE.

/8.	FIXED BUG RE ADDITIONAL INFO WORDS
\f/PAGE 0 LOCATIONS OS/8 USR WON'T MANGLE

	PTR=20
	CNT=21
	INFPTR=22
	OUHAND=23
	INHAND=24
	FPAGE=25
	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

/SYMBOLIC FOTP LOCATIONS:

OUBUFR=	4600		/OUTPUT BUFFER - IN FIELD 1
INBUFR=	0		/INPUT BUFFER - IN FIELD 0
LSTFPG=	7000		/FIRST LOC OF LAST FREE PAGE IN FIELD 0
FAKHND=	200		/LOCATION OF OS/8 FAKEOUT HANDLER
VERSION=	11	/VERSION NUMBER
SUBVER=		01	/SUB VERSION (PATCH LEVEL)
			/LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER
\f/STARTS AT 4600 IN FIELD 1 (ONCE ONLY CODE)

/SAVE INFO:

/	.LOAD FOTP(89P)
/	.SAVE SYS FOTP;14600

	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 (-"?!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 (-"*!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
\f/ 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
	JMP MOV		/OUTPUT=INPUT
	TAD I (OPT2	/V3C
	AND (100	/CHECK FOR /R
	SZA CLA		/V3C
MOV,	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 (LSTFPG	/SET THE FREE SPACE POINTER
	DCA FPAGE	/TO THE LAST FREE PAGE IN FIELD 0
	TAD I (7600	/IS THERE AN OUTPUT DEVICE?
	SZA		/IF NO OUTPUT, DON'T FETCH HANDLER
	JMS I (ASSIGN	/GET THE HANDLER AND ALLOCATE ITS SPACE
	DCA OUHAND	/AC RETURNS HANDLER ENTRY POINT
	JMS I (ODIRIN	/READ IN THE OUTPUT DIRECTORY
	TAD (7605	/INGIALIZE INPUT POINTER

/THIS IS THE BEGINING OF THE INPUT FILE LOOP

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

/THE FOLLOWING 2 INSTRUCTIONS HELP AVOID ALL KINDS OF
/PROBLEMS WITH THE MONITOR.  IF A HANDLER GETS LOADED, THE
/MONITOR MAKES IT RESIDENT FOR OTHER PEOPLE AND DOESN'T DELETE
/ITS RESIDENT STATUS IF A REQUEST IS MADE FOR A NEW HANDLER
/TO BE LOADED OVER IT IF THE NEW HANDLER IS ALREADY RESIDENT

	TAD FPAGE	/SAVE FREE SPACE POINTER HERE
	DCA SFUDG
	JMP I (PG1	/LINK TO NEXT SECTION

SFUDG,	0
\fONDERR,	JMS I (ERROR
	ODRERR+40	/ERROR READING OUT DIR
AINO,	JMS I (ERROR
	ILLA+40		/ILLEGAL *
QINO,	JMS I (ERROR
	ILLQ+40		/ILLEGAL ?

	PAGE
\f/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		/SKIP IF IT IS
	JMP NFIN	/ERROR
	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

/FIND LAST BLOCK OF DIRECTORY

	AC2		/LINK TO NEXT SGMENT NUMBER
FNDLST,	DCA PTR		/SAVE IT
	CDF 0
	TAD I PTR	/IS THERE ANOTHER SEGMENT?
	SNA CLA		/SKIP IF YES
	JMP ATIT	/NO...WE ARE POINTING TO LAST
	TAD PTR		/BUMP TO NEXT SEGMENT
	TAD (400
	JMP FNDLST	/LOOK AGAIN
ATIT,	ACM3		/AC=7775
	AND PTR		/AND OUT 2'S BIT
	TAD (400	/TOTAL SIZE OF IN CORE DIRECTRY
	CIA		/NEGATE FOR ISZ
	DCA CNT
	TAD FPAGE	/WE ARE GOING TO PACK DIRECTORY
	TAD (200	/RIGHT UP TO INPUT HANDLER SO
	TAD CNT		/WE GET MAX SIZE TRANSFER BUFFER
	DCA FPAGE	/ADJUSTED FREE CORE POINTER
	CMA
	TAD FPAGE
	DCA XR1		/SET UP PLACE TO MOVE TO
	CMA
	DCA XR2		/ALWAYS COMES FROM 0
	TAD I XR2	/MOVE
	DCA I XR1	/IT
	ISZ CNT
	JMP .-3
\f/SET SAME DEVICE FLAG FLAG 4000 IF /D

	CDF 10
	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
/NOTE CNT WAS SET BY ISZ'ING TO ZERO
	ISZ CNT		/KEEP COUNT OF DEVICES IN GROUP
	TAD I (OPT2	/CHECK FOR /U (UGLY SWITCH)
	AND (10
	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
\f/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
	TAD FPAGE	/SET POINTER TO
	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
\f/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
\fMLP,	TAD GPTR2	/OK - GET A CHARACTER FROM
	JMS I (GTSXBT	/STRING
	TAD (-"*!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
	TAD I (SFUDG	/RESET FREE CORE POINTER
	DCA FPAGE	/TO PRESERVE INPUT HANDLER IF PRESENT
	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
\fGOT1,	DCA IFCNT	/-# OF BLOCKS IN AC
	JMS I (DATCHK	/VERIFY IF /C OR /O ALSO MATCH
	ISZ I (TYPFND	/COMES BACK IF THEY DO - 
			/TURN OFF NO FILES MSG FOR THIS INPUT GROUP
	TAD I (OPT2	/CHECK FOR /T
	AND (20
	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
	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
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


	PAGE
\f/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

/THE FOLLOWING SMALL STRANGE PIECE OF CODE
/DYNAMICALLY ALLOCATES THE BUFFER ACCORDING
/TO THE FREE SPACE IN FIELD 0 (INCLUDING
/DIRECTORY SHRINKING) OR ALLOCATES 15 BLOCKS
/IN FIELD 2 IF ITS AVAILABLE.

F2C1,	TAD (7400	/BECOMES  TAD EPTR  IF ONLY 8K
	AND (7400	/CALCULATE FREE SPACE
	RAL CLL		/SIZE
	RTL		/AND SAVE
	RTL		/IT
	DCA BUFSIZ
	TAD IFCNT	/SET THE OUTPUT 
	CIA		/FILE COUNT
	DCA OFCNT	/AS POSITIVE NIMBER OF BLOCKS
	TAD OFCNT	/SET THE NUMBER
	AND (7400	/OF BLOCKS
	SNA CLA		/UP FOR ENTER
	TAD OFCNT	/IF IT IS LESS
	RTL CLL		/THAN 256 OR
	RTL		/SET IT TO 0
	DCA TEMP	/FOR FILES GREATER THAN 256
	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
	TAD TEMP	/ADD IN BLOCK COUNT
	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 IFCNT	/SEE IF ENTER SIZE
	STL CIA		/GIVEN BACK IS
	TAD MSIZE	/ENOUGH - HANDLES >255 AND
	SNL SZA CLA	/NON FILE STRUCTURED
	JMP I (NOROOM	/LENGTHS. NOT ENOUGH
	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

\f/THE FOLLOWING PIECE OF CODE IS A TRICKY PIECE
/THAT CALCULATES THE NUMBER OF BLOCKS TO READ

MOVEIT,	TAD IFCNT	/GET THE NUMBER OF BLOCKS
	CLL		/ITS NEGATIVE
	TAD BUFSIZ	/ADD ON BUFFER SIZE
	SNL		/SKIP IF MORE ROOM AVAILABLE THAN NEEDED
	DCA IFCNT	/OTHERWISE RESAVE NEW COUNT
	SZL		/SKIP IF NOT AT END OF FILE
	ISZ INEOF	/SET END OF FILE INDICATOR
	CIA		/MAKES -BUFSIZ+COUNT
	TAD BUFSIZ	/MAKES COUNT OF NUMBER OF BLOCK
	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
	CIF 0
	JMS I INHAND	/READ INPUT HUNK
INCTLW,	0
	0
BLOCKN,	0
	JMP I (RDERR	/WELL- SCRATCH THAT FILE
	TAD BLOCKN	/UPDATE BLOCK COUNT
	TAD BUFSIZ
	DCA BLOCKN
	AC4000		/SET THE OUTPUT
	TAD INCTLW	/CONTROL WORD
	DCA OUCTLW
	JMS I (CINTER	/CHECK FOR ^C
	SKP		/SKIP IF NOT
	JMP I (CTCDE	/ABORT OPERATION
	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
	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
NFUNCT,	JMP I (NENT	/I KNOW ITS INEFFICIENT TO JUMP HERE
			/BUT- IT'S CLEAN...
	PAGE
\f/HERE COMES GOBBS AND GOBBS OF GOODY LITTLE ROUTINES

/FIRST WE HAVE A NICE LITTLE ROUTINE WHICH WILL DO
/HANDY LITTLE THINGS LIKE FETCH A HANDLER
/AND IN ADDITION ALLOCATE THE SPACE FOR IT.
/JUST IMAGINE THIS CAN BE YOURS FOR THE LOW LOW PRICE
/OF 23 INSTRUCTIONS

ASSIGN,	0
	DCA TEMP	/SAVE DEVICE NUMBER
	TAD TEMP
	JMS I (200
	12		/INQUIRE ABOUT HANDLER
HADDR1,	0
	JMP I (CLOERR	/CANT HAPPEN (I HOPE)
	TAD HADDR1	/DID WE GET BACK ADDRESS
	SZA		/SKIP IF NOT- NON-RESIDENT
	JMP I ASSIGN	/YES... RETURN ITS ENTRY POINT
	SKP
TWOPAG,	IAC		/TURN ON 2-PAGE BIT
	TAD FPAGE	/GET FREE SPACE POINTER
	DCA HADDR2	/SET FOR FETCH
	TAD FPAGE	/TAKE AWAY
	TAD (-200	/PAGE FROM
	DCA FPAGE	/FREE SPACE
	TAD TEMP	/GET DEVICE NUMBER
	JMS I (200
	1		/FETCH
HADDR2,	0
	JMP TWOPAG	/FAILED- MUST BE 2-PAGER
	TAD HADDR2	/RETURN ENTRY POINT ADDRESS
	JMP I ASSIGN
\f/THIS UTILITY ROUTINE RETURNS A SIS 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
\f/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
\f/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 /V
	JMS MDATE
	CMA CLA		/SET AC=-1 IF NO /V
	SNA CLA		/RETURN HERE AC=0 IF DATES SAME
	JMP I (NENT	/DATES SAME WITH /V-IGNORE FILE
	JMP I DATCHK	/CONTINUE

MDATE,	0		//O AND /V 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 0
	TAD I GPTR1	/GET DATE WORD
	CIA
	CDF 10
	TAD I (SVDATE	/COMPARE WITH MONITORS, 0 IF =
	JMP I MDATE

ECHO,	1


	PAGE
\f/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
	TAD I RETLOC	/GET CONTROL WORD
	RAL		/R/W BIT INTO LINK
	CLA RAL		/R/W BIT INTO AC11
	TAD DCAXR1	/IF WRITE MAKE DCA XR2 ELSE XR1
	DCA DCASPT	/SAVE WHERE WE NEED IT
	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 (4177	/ADD ON TO BEGINING OF DIRECTRY
DCAXR1,	DCA XR1		/SAVE IN BOTH XR1
	TAD XR1
	DCA XR2		/AND XR2
	TAD (1377	/NOW SAVE USR BLOCK AREA
DCASPT,	HLT		/IN EITHER XR1 OR XR2 (R OR W)
	TAD (-400	/SET WORD TRANSFER COUNT 
	DCA CNT
	TAD I XR2	/GET A WORD
	DCA I XR1	/PUT A WORD
	ISZ CNT
	JMP .-3
	JMP I RETLOC	/GO BACK TO USR
\f/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,CDF 0
	TAD (1200	/PUT IN HANDLER INTERFACE CODE
	DCA I (FAKHND+1	/INTO FIELD 0 AS GIVEN ABOVE
	TAD (CIF CDF 10
	DCA I (FAKHND+2
	TAD (5604
	DCA I (FAKHND+3
	TAD (FAKBDY
	DCA I (FAKHND+4
	CDF 10
	TAD UNFAK	/RETURN WITH DEVICE NUMBER IN AC
	JMP I FAKUSR

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

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

FIXDIR,	JMS UNFAK	/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
	TAD I (OPT2	/GET OPTION /W
	RTR
	SNL CLA		/SKIP FOR VESION NUMBER
	JMP NOVER
	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
\fDIROUT,	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
	CIF 0
	JMS I OUHAND	/WRITE DIRECTORY BACK ONTO DEVICE
	5410
	4600
	1
	JMP I (ODERR	/IS HE IN TROUBLE...
	DCA WRTDIR	/CLEAR WRITE DIRECTORY FLAG
	JMP I DIROUT	/RETURN
	PAGE
\f/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

/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
\f/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
	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
	JMP I RESTORE

SCODE,	0;0;0;0
\f/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
\f/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,	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
\f/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
	CNTDEL+40	/MULTIPLE DEVICE DELETE
	TAD (215
	JMS I (TYPE
	JMS I (ERROR
	CNTDE2+40

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

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

	PAGE
\f/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
\f/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	/WE DONT WANT TO READ OR WRITE DIRECTORY
	CIF 0
	JMS I OUHAND	/READ DIRECTORY
	1410
ODBUF,	OUBUFR
	1
	JMP I (ONDERR	/ERROR
	TAD I ODBUF
	CMA CLL		/CHECK FOR LEGAL OUTPUT DIRECTORY - FIRST
	TAD I (OUBUFR+2	/WORD OF AN OS/8 DIRECTORY IS .LT. 50
	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
\f/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
\f/HERE IS WHAT WE HAVE ALL BEEN WAITING FOR

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

RENAME,	JMS LOOKUP
	JMP I (CLOERR	/SUPER SYSTEM DISASTER
	DCA OBLOCK	/V3C SAVE BLOCK OF NEW NAME (IF ANY)
	TAD (SPOT1-SPOT	/LOOKUP INPUT FILE
	JMS LOOKUP
	JMP I (CLOERR	/SUPER SYSTEM DISASTER
	CIA		/LOOKUP INPUT NAME ON OUTPUT DEVICE
	TAD OBLOCK	/IS IT SAME SPOT AS NEW NAME ON OUTPUT DEVICE?
	SZA CLA		/V3C
	JMS EXERR	/NO, MAYBE ALREADY EXISTS
	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 TILL DONE
	TAD I (1404	/V3C
	SNA CLA		/BUT IS THERE ROOM FOR DATE?
	JMP NONUDA	/NO, NO ADDITIONAL INFO WORDS
	TAD I (DATE	/YES, MOVE DATE
	DCA I TEMP	/INTO NEW FILENAME ENTRY
NONUDA,	JMS WRKEY	/V3C
	ISZ I (WRTDIR	/INDICATE DIRECTORY CHANGED
	JMP I (NFUNCT	/DO NEXT FILE

WRKEY,	0		/V9
	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
	JMP I WRKEY
\fEXERR,	0		/BLOCK NUMBERS DIFFERENT
	TAD OBLOCK	/LOOK AT BLOCK NUMBER OF EXISTING FILE
	SNA CLA		/DID IT REALLY EXIST?
	JMP I EXERR	/NO, OK TO RENAME TO THIS NAME
	JMS I (ERROR	/YES, TRYING TO RENAME TO EXISTING NAME
	RENERR+40	/FILE ALREADY EXISTS
	JMP I (POUTNM

OBLOCK,	0		/TEMPORARY, HOLDS BLOCK NUMBER OF ALREADY
			/EXISTING FILE WITH SAME NAME AS PROPOSED NEW NAME
			/ON OUT PUT DEVICE (OR 0 IF NONE)
\f/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
	JMS WRKEY	/V9
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
	PAGE
\f/** 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
MOVMSG,	TAD I ONCE	/MOVE MSGS TO LOWER FIELD
	CDF 0
	DCA I ONLY
	CDF 10
	TAD I M1
	CDF 0		/MOVE CORE DETERMINER
	DCA I M1	/INTO FIELD 0 ALSO
	CDF 10
	ISZ M1
	ISZ ONCE
	ISZ ONLY
	ISZ CODE
	JMP MOVMSG
	TAD (2000	/SET RESTART LOCATION
	CDF 0
	DCA I (7745
	TAD (6403	/SET JSW
	DCA I (7746
	CDF 10
FCIF0,	CIF 0
	JMS I (CORE
	TAD CORFUJ	/COMPUTE AMOUNT OF CORE EXCLUDING BATCH FIELD
	TAD (-1
	SZA CLA		/SKIP IF WE HAVE ONLY 8K (OR 12K AND BATCH)
	JMP I INIT
	TAD (TAD EPTR	/PATCH LOCATIONS IN FOTP
	DCA I (F2C1	/TO WORK WITH ONLY 8K
	TAD (NOP
	DCA I (F2C2
	JMP I INIT	/START

M1,	.&7600
ONCE,	MSGS
ONLY,	LSTFPG+200
CODE,	7400

CORFUJ,	0
TTCNT4,	-4
TTOUTP,	TTYOUT
BATOUT,	SKP		/OUTPUT TO BATCH LOG
	7400
BATCIF,	HLT
	TTYOUT+1&177+4600	/JMS I .-2
\f/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
\f/FOTP'S ERROR MESSAGES
/THESE RESIDE IN FIELD 0 LOCATIONS 7200-7577

MSGS,

	NOPUNCH
	*LSTFPG+200
	ENPUNCH

ILLQ,	TEXT /ILLEGAL ?%/
ILLA,	TEXT /ILLEGAL *%/
SERR,	TEXT /SYSTEM ERROR/
RENERR,	TEXT /ALREADY EXISTS-/
VERNO,	0617;2420;4026	/FOTP V
VERLOC,	VERSION+60^100+SUBVER	/ONE-DIGIT VERSION NUMBER AND 1 CHAR PATCH LEVEL
	0
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%/
CNTDEL,	TEXT /DELETES PERFORMED ONLY ON INPUT DEVICE GROUP 1/
CNTDE2,	TEXT /CAN'T HANDLE MULTIPLE DEVICE DELETES%/
DSVED,	TEXT /ORIGINAL DIRECTORY PRESERVED%/
FLSFMS,	TEXT /MOUNT NEXT OUTPUT VOLUME:/

	FIELD 1		/SELF-STARTING BINARY LOADER STUFF FOR ABSLDR
	*FOTP
	$