Google
 

Trailing-Edge - PDP-10 Archives - BB-F493Z-DD_1986 - 10,7/filex.mac
There are 6 other files named filex.mac in the archive. Click here to see a list.
	TITLE	FILEX - GENERAL FILE TRANSFER ROUTINE - %20(62)
	SUBTTL	RC CLEMENTS/TCK/PFC/RKH/LCR/JAD		2-JAN-86



;COPYRIGHT (C) 1969,1978,1979,1986 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

FLXWHO==0		;WHO EDITED FILEX LAST
FLXVER==20		;MAJOR VERSION NUMBER
FLXMIN==0		;MINOR VERSION NUMBER
FLXEDT==62		;EDIT NUMBER

	SEARCH	JOBDAT,MACTEN,UUOSYM
%%JOBD==%%JOBD
%%MACT==%%MACT
%%UUOS==%%UUOS

	.REQUEST REL:HELPER

	TWOSEG
	SALL

	LOC	.JBVER
	VRSN.	FLX
	RELOC	400000

;ASSEMBLY PARAMETERS

ND	LN$PDL,20	;PDL LENGTH
ND	LASTOB,1101	;LAST BLOCK ON -10 DTA
ND	LN$SFD,5	;MAX SFD DEPTH
LN$PPN==2+1+LN$SFD+1	;PATH: PREFIX+UFD+SFD'S+ZERO
ND	LN$PDS,^D255	;MAX NUMBER OF PAGE DESCRIPTORS IN .EXE

;PARAMETERS FOR MAKING SAVE FILES

ND	SAVPMX,^D60	;MAXIMUM POSIBLE IOWD DATA BLOCK IN COMPRESSED FILES
ND	SAVPMN,4	;BUFFER SPACE USED FOR MAKING COMPRESSED FILES
	SUBTTL	TABLE OF CONTENTS

;
;
;                          SECTION                            PAGE
;    1. TABLE OF CONTENTS.....................................   2
;    2. REVISION HISTORY......................................   3
;    3. DEFINITIONS...........................................   4
;    4. MAIN ROUTINE..........................................   7
;    5. ROUTINE TO READ AND LIST A DIRECTORY BLOCK............  11
;    6. ROUTINE TO PROCESS COPY OPERATIONS....................  12
;    7. END OF MAIN LOOP......................................  14
;    8. TRANSFER MODE SELECTIONS..............................  16
;    9. 36-BIT TRANSFER ROUTINES..............................  19
;   10. TRANSFERS FROM NON-36 TO 36-BIT.......................  30
;   11. TRANSFERS FROM 36-BIT TO NON-36.......................  34
;   12. DIRECTORY LISTER......................................  40
;   13. ZERO OUTPUT TAPE ROUTINES.............................  47
;   14. SELECT (LOOKUP) FILE..................................  50
;   15. ROUTINES TO ENTER OUTPUT FILE.........................  57
;   16. CLOSE ROUTINES........................................  66
;   17. READ BINARY WORD, EXPANDING TO CORE IMAGE.............  69
;   18. READ BINARY WORD ROUTINES.............................  74
;   19. WRITE BINARY WORD ROUTINES............................  80
;   20. BLOCK INPUT/OUTPUT ROUTINES...........................  85
;   21. FILE SPEC SCANNER INPUT ROUTINE.......................  90
;   22. TYPE OUT ROUTINES.....................................  92
;   23. ERROR ROUTINES........................................ 101
;   24. STORAGE............................................... 107
	SUBTTL	REVISION HISTORY

;5	STRIP LINE SEQ NUMBERS WHEN GOING TO -15 DTA
;6	DO DATE75 ON -10 DTA
;7	BLT ON -10 TO -10 XFRS; HANDLE CONTIGUOUS -11 DTA FILES;
;	HANDLE -11 DTA PROTECTION
;%15(7)

;10	-11 DTA DATE74 FIX
;%16(10) NOV 74

;11	REMOVE SPECIAL SYS: PROTECTION LOGIC SINCE IN MONITOR
;12	REWORK /R TO NOT REQUIRE DTA BE MOUNTED
;13	CLEAN UP I/O LOGIC SLIGHTLY
;14	CONVERT TO USE C
;15	ALLOW /P/R ON OUTPUT DTA-BOTH REUSE SCRATCH UNLESS /Z;
;		/R SUPPRESSES TAPE WRITE
;16	/L IS GENERAL SWITCH; IF NO =, JUST /L
;17	DROP OLD USAGE OF _ AND 175, 176
;20	MAKE REENTRANT
;21	REFORMAT WITH PGRFMT; LC MESSAGES
;22	CHANGE DEVPPN TO PATH. FOR ERSATZ DEVICES
;23	IMPLEMENT SFD'S AND DEFAULT PROJ AND PROG AND ACCEPT <>
;24	ALLOW /Z IF NO =
;25	/Z ON OUTPUT ASSUMED IF /Q OR XFO FILE MISSING
;26	IF /R, USE DEVICE AS TEMP FILE NAME WITH .DTA AS EXTENSION
;27	MAKE DEV STICKY, SECOND DEVICE IS TEMP FILE NAME
;30	ADD .HGH, .EXE SUPPORT
;	IF .HGH OR .SHR =.EXE, MAY ALSO CREATE .LOW
;	IF .EXE=.HGH OR .SHR, MAY ALSO READ .LOW
;31	SUPPORT NUL:
;32	PDP-11 DIRECTORIES WERE LISTED WRONG
;33	DTAX:/Q=A,B DID WRITE A ZERO TAPE BUT FORGOT TO ENTER A ZERO
;	DTA STRUCTURE
;34	DTAX:/Q/Z/L=A,B TRIES TO LIST FROM A SCRATCH FILE WHICH NO LONGER
;	EXISTS INSTEAD USE THE REAL DECTAPE
;35	DSK:=DTAX:/Q DOES NO LONGER WORK AS READBZ CLOBBERS I/O STATUS
;36	DTAX:/Q/L=FOO WAS BROKEN FOR PDP10 FILES
;37	ALL TEN TO TEN TRANSFERS WITH DEVICES HAVING DIFFERENT
;	BUFFERS SIZES DO NOT WORK

;40	CHANGE EXEFLG DEFINITION TO A BLOCK 1 STATEMENT SO
;	NO LOW SEGMENT IS CREATED
;41	CONVERSION FROM SHR(HGH) & LOW TO EXE FORMAT DOES NOT
;	WORK WHEN THE SAVE FILES IOWDS DO NOT FILL UP THE LAST
;	PAGES
;42	=DTA0:/L USED TO LIST ONLY DIRECTORY NOW IT COPIES ALL
;	THE FILES ON THE TAPE CAUSING FILES TO DISAPPEAR
;43	DTA0:/L WILL LIST THE DIRECTORY OF THE DECTAPE AND
;	AFTER SOME WAITING A FILE DTA0 WILL BE IN THE DISK AREA
;	THIS WAS INTRODUCED BY EDIT 42
;44	A.XPN=A.EXE THE EXPANDED FILE CREATED WAS WRONG THE FIRST
;	20 LOCATIONS ARE NON ZERO CAUSING GRIEF TO FILDDT E.G.
;45	A.SAV=A.EXE DID NOT WORK CORRECTLY
;46	A.EXE=A.SHR DID NOT ALAWAYS WORK CORRECTLY
;47	THE EXPLICIT SPECIFICATION OF EXTENSIONS ON CONVERTING SAVE
;	FILES IS BOTHERSOME, THEREFORE THE FOLLOWING WAS DONE:
;CONVERSION OF SAVE FILES CAN BE DONE USING THE C SWITCH
;AND A BLANK INPUT EXTENSION.
;OLD SAVE FILES ARE FILES WITH EXTENSION SHR HGH SAV OR LOW (OEX)
;NEW SAVE FILES HAVE AN EXTENSION EXE
;AS LINK PRODUCES OLD SAVE FILES THE DEFAULT CONVERSION MODE
;IS FROM OLD TYPE SAVE FILES TO NEW TYPE SAVE FILES ELSE AN EXPLICIT
;OUTPUT EXTENSION MUST BE USED TO FORCE THE CONVERSION TYPE.
;NOTE NO SCRATCH OUTPUT IS ACCEPTED
;EXAMPLES OF THE VARIOUS CONVERSION COMMANDS ARE:

; 1	A.EXE=A/C	;CONVERT OLD FORMAT SAVE FILE A TO EXE FORMAT
; 2	A=A/C		;SAME AS (1)
; 3	A.OEX=A/C	;CONVERT A.EXE TO OLD SAVE FILE FORMAT
; 4	*=*/C		;CONVERT ALL OLD SAVE FILES TO EXE FORMAT &
			;ALL EXE FILES FOR WHICH NO OLD SAVE FILE
			;EXISTS
; 5	A:*=B:*/C	;IF A EQL B THEN AS (4) ELSE CONVERT ALL SAVE FILES
; 6	A:*.EXE=B:*/C	;CONVERT ALL OLD SAVE FORMAT FILES
; 7	A:*.OEX=B:*/C	;CONVERT ALL EXE FILES TO OLD SAVE FILE FORMAT
;
;IN CASE 2 A WARNING WILL BE GIVEN IF THE EXTENSION IMPLIED BY THE
;CONTENT OF THE EXE FILE DIFFERS FROM THESPEIFIED ONE 
;E.G. A.SHR=A/C  WHERE A.HGH WOULD BE GENERATED
;50	CONVERSION OF SHR FILES TO EXE FILES WITHOUT A LOW SEGMENT
;	RESULTS IN EXE FILES,WHICH ON A RUN RESULT IN 
;	" ILLEGAL MEMORY REFERENCE " 
;51	CONVERTING EXE FILES TO SAVE FILES CAN RESULT IN FILES,WHICH
;	PRODUCE THE ERROR MESSAGE "NOT A SAVE FILE".
;	THIS WAS DUE TO LOAD INSTRUCTIONS BEING SPLIT IN SEVERAL
;	AEQUIVALENT ONES.THE PARAMETER SAVPMX DEFINES THE SIZE OF
;	THE MAXIMUM LOAD INSTRUCTION GENERATED BY FILEX (IN PAGES).
;52	FILEX GENERATES ZERO CREATION TIME FOR FILES
;53	DETECT MORE IOWDS THAN ZEROS IN SAVE FILE AND GIVE ERROR
;	SPR 10-17277		RKH	14-JAN-76
;54	EXPAND XBUF SIZE TO REDUCE POSSIBILITY OF MORE IOWDS THAN ZEROS
;	WHEN CREATING A SAVE FILE
;	SPR 10-17277		RKH	14-JAN-76
;55	ALLOW FILEX TO ACT LIKE PIP FOR CREATION DATE RETENTION
;	SPR 10-17277		RKH	26-JAN-76
;56	PREVENT PDL OVERFLOW IF TOO MANY ';' SEEN
;	SPR 10-18089		RKH	26-JAN-76
;57	PREVENT A HALT AT PC 0 IF LOW FILE IS NOT FOUND
;	SPRS 10-19500, 10-19449	RKH	12-APR-76
;60	RESTORE .JBHCR FROM .JBCOR+XBUF WHEN RECREATING ONE SEGMENT FILES
;	(HGH/SHR) ONLY, FROM .EXE FILES.
;	SPR 10-20113		LCR	17-AUG-76
;61	MAINTAIN .JBFF IN SAVOUT WHEN CONVERTING .EXE FILES TO .SAV FILES.
;	SPR 10-23496		CGN	07-JUL-78
;62	SEARCH MACTEN AND UUOSYM INSTEAD OF C, UPDATE COPYRIGHTS, ETC.
;	NO SPR			JAD	02-JAN-86
	SUBTTL	DEFINITIONS

;AC'S

F=0		;FLAGS
A=1		;FOUR AC'S FOR LOOKUPS, AND WORK.
B=2
C=3
D=4

T=5		;3 TEMPS
T1=6
T2=7

CA=10		;CORE ADDRESS AND COUNTS IN XFR ROUTINES
CKS=11		;CHECKSUMS IN XFR ROUTINES

N=12		;NUMBERS FOR DEC & OCT ROUTINES

W=14		;WORD SIZE DATA
CH=15		;CHARACTERS FOR TTY IO

P=17		;STACK

;I/O CHANNELS

INF==1		;INPUT TAPE
OUTF==2		;OUTPUT TAPE
SCRF==3		;DISK SCRATCH FILE
SCOF==4		;DISK SCRATCH FOR OUTPUT TAPE
UFDF==5		;DIRECTORY FOR * ON DSK
;LEFT HALF FLAGS

L.DSKI==1	;INPUT DEV IS A DSK
L.DTI==2	;INPUT DEV IS A DTA
L.SCRI==4	;INPUT DTA HAS BEEN PUT ON NNNXFR.TMP
L.6DO==10	;OUTPUT FILE IS 6 DMP MODE (200 WDS PER BLK, NOT 177)
		; ALSO USED FOR PDP15 ABS FILES, PDP10 COMPRESSED+SHR
		; FOR TIGHT SPACING.
L.WFI==20	;INPUT FILE IS *
L.WEI==40	;INPUT EXT IS *
L.WFO==100	;OUTPUT FILE IS *
L.WEO==200	;OUTPUT EXT IS *
L.MFI==400	;INPUT FILE TERMINATED BY ","
L.STR1==1000	;FLAG HAVE PROCESSED AT LEAST ONE * INPUT FILE
L.DTO==2000	;OUTPUT IS TO DTA
L.DSKO==4000	;OUTPUT IS DISK
L.FRCL==10000	;FORCE LOOKUP FROM TIFILE/TIEXT;SUPPRESS CLOSE IN XFRCP
L.BEO==20000	;BLANK EXTENSION ON OUTPUT
L.SCRO==40000	;SCRATCH FILE FOR OUTPUT TAPE
	;SPARE
L.BFO==400000	;BLANK OUTPUT NAME

;RIGHT HALF FLAGS

R.EXT==1	;EXPLICIT EXTENSION TYPED
R.DOT==2	;DOT TYPED
R.TMP==R.DOT	;FOR USE AS A HANDY FLAG
R.SW==4		;PARENS, NOT SLASHES
R.UPA==10	;UPARROW (TAPEID)
R.ALL==R.DOT!R.UPA	;SYNTAX FLAG
R.OMT==R.UPA	;OUTPUT ALLOCATOR TURNAROUND. (SHARED BIT)
R.ITD==20	;INPUT TAPE DIRECTION IF NEEDED
R.SBLK==40	;OUTPUT IN S-BLK RATHER THAN COMPRESSED (-10)
R.GO==100	;/G IN EFFECT
R.GOS==200	;/G AND ERROR MSG ALREADY OUTPUT
R.EOF==400	;NO MORE DATA IN INPUT FILE
R.OMD==1000	;1 IF OUTPUT MAC DIRECTION IS REVERSE
R.OMF==2000	;1 IF FREE BLOCK SKIPPED DURING ALLOCATION ON MACTAPE
R.JSCR==4000	;1 IF SHOULD JUNK SCRATCH FILE AT END
R.IN==10000	;1 IF ANY INPUT AT ALL
R.ABC==20000	;CURRENT INPUT FILE HAS ALWAYS BAD CHECKSUM BIT
R.BDO=40000	;BLANK OUT DEVICE FILE AND EXTTENSION
R.SAVX=100000	;CONVERTING SAVE FILES
R.6DI==200000	;INPUT FILE IS SIX FORMAT DUMP (200W/B)
R.MFI2==400000	;MULT FILE INPUT SO DON'T REPEAT OUTPUT OPENS
;TABLE OFFSETS

TYPNDT==0		;NON-DECTAPE
TYPTEN==1		;PDP10 DECTAPE
TYPSIX==2		;PDP6  DECTAPE
TYPMAC==3		;PROJ MAC DTA
TYPFIF==4		;PDP15 TAPE
TYPVEN==5		;PDP ELEVEN TAPE

;FLAGS IN RTYP AND PROG (.EXE) DIRECTORY

PF$HGH==1B0	;HIGH SEG
PF$SHR==1B1	;SHARABLE
PF$WRT==1B2	;WRITABLE (LOW SEG)

;MISC PARAMETERS

JOBSV6==73		;RH OF IOWD FOR PDP6 DMP FILE

DEFINE MSG$ (M) <
	XLIST
	MOVEI	W,[ASCIZ \M\]
	PUSHJ	P,MSG
	LIST
>

DEFINE EMSG$ (M) <
	XLIST
	CLRBFI
	MOVEI	W,[ASCIZ \M\]
	PUSHJ	P,MSG
	LIST
>

;MACRO TO COPY [P,PN,SFD...] TO NEW LOCATION

DEFINE	MOVPPN (FROM,TO) <
	MOVE	T,[FROM+1,,TO+1] ;;COPY
	BLT	T,TO+LN$PPN	;;  PATH IF ANY
	MOVE	T,FROM		;;GET PPN OR POINTER
	CAIN	T,FROM+1	;;IF PATH POINTER,
	MOVEI	T,TO+1		;;  CHANGE TO NEW LOCATION
	MOVEM	T,TO		;;STORE PPN OR POINTER
>
	SUBTTL	MAIN ROUTINE

FILEX:	JFCL			;JUST IN CASE OF CCL ENTRY
	RESET			;CLEAR THE WORLD
	HRRZ	T,.JBFF		;GET FIRST FREE LOCATION
	CORE	T,		;AND RETURN CORE (ERROR CODE COMES HERE TOO)
	 JFCL			;SHOULD NOT OCCUR AND DOES NOT BOTHER
	SETZB	F,LCOR		;CLEAR FLAGS AND LOW CORE
	MOVE	A,[LCOR,,LCOR+1]
	BLT	A,ELCOR
	MOVE	A,[IOWD 200,DIRECT]
	MOVEM	A,DIRIOW
	HRRI	A,ODIREC-1
	MOVEM	A,ODIIOW
	HRRI	A,WBUF-1
	MOVEM	A,WIOL
	HRRI	A,TBUF-1
	MOVEM	A,TIOL
	MOVE	A,[IOWD 400,TBUF]
	MOVEM	A,TXIOL
	MOVE	P,[IOWD LN$PDL,PDL]	;SETUP STACK
	SETOM	LSNFLG		;CLEAR LINE-SEQUENCE-NUMBER-SEEN FLAG
	MOVX	T,%LDMFD	;GET MFD PPN
	GETTAB	T,
	  MOVE	T,[1,,1]	;IN CASE OF LEV.C
	MOVEM	T,MFDPPN
	GETPPN	T,		;GET OUR
	  JFCL			; PPN
	MOVEM	T,MYPPN		;STORE FOR LATER
	PJOB	T,		;MAKE TEMP FILE NAME
	MOVEI	N,3
SCRL1:	IDIVI	T,12		;TIME-HONORED NAME MAKER
	ADDI	T1,'0'		;DECIMAL SIXBIT OF JOB NUMBER
	LSHC	T1,-6		;TO T2
	SOJG	N,SCRL1		;THREE DIGITS
	HRRI	T2,'XFR'	;NNNXFR.TMP IS NAME
	MOVEM	T2,SCRNAM	;SAVE IT.
	MOVEI	W,[ASCIZ /
*/]
	PUSHJ	P,MSG		;TYPE ASTERISK
;GET OUTPUT SPECIFICATION

	PUSHJ	P,FILSPC	;GET FILE FOR OUTPUT
	  JRST	FILEX		;TRY AGAIN - ERROR RETURN
	SKIPE	SWHELP		;IF /H,
DOHELP:	JRST	[CLRBFI		;CLEAR ANY MORE TYPING
		 HRROI A,.GTPRG	;YES--GET NAME OF PROGRAM
		 GETTAB A,	; ..
		   MOVEI A,0	; ..
		 SKIPN A	; ..
		 MOVE  A,['FILEX ']
		 PUSHJ P,.HELPR##
		 JRST  FILEX]	;AND START OVER
	MOVE	T,$BRKC		;GET LAST BREAK
	CAIE	T,","		;IF COMMA
	CAIN	T,.CHLFD	; OR END OF LINE,
	JRST	[MOVE T,$TSW	; THEN CHECK
		 TRNN T,SW$Z	;UNLESS /Z,
		 JRST ASKINL	; PROCEED--MUST BE /L
		 SKIPE SWLIST	;IF /Z,
		 JRST ERR22	; /L IS AN ERROR
		 SETOM SWONLZ	;INDICATE ONLY /Z
		 JRST .+1]	; AND PROCEED
	MOVE	T,$TSW		;GET SWITCHES
	TRNE	T,SW$R		;IF /R,
	JRST	[SKIPE T,$DEV	; SEE IF DEVICE
		 MOVEM T,OPDEV	;YES--NAME OF PSEUDO FILE
		 JRST  .+2]	;AND PROCEED
	MOVE	T,$DEV		;GET DEVICE
	IOR	T,$FILE		;ADD FILE BITS
	IOR	T,$EXT		;AND EXTENSION
	SKIPN	T		;ANYTHING SAID
	TRO	F,R.BDO		;(NO) REMEMBER BLAK OUT SPEC
	SKIPN	T,$DEV		;ANY DEVICE SPECIFIED?
	MOVSI	T,'DSK'		;NO. USE DISK
	MOVEM	T,ODEV		;SAVE OUTPUT DEVICE
	DEVCHR	T,		;GET OUT DEV CHARS
	JUMPE	T,ERR47		;ANY SUCH THING?
	TXNE	T,DV.DSK	;IF DISK,
	TXZ	T,DV.DTA	; NOT DTA (MUST BE NUL)
	TXNE	T,DV.DTA	;DECTAPE?
	TLO	F,L.DTO		;YES. REMEMBER IT
	MOVE	T1,$TSW		;GET SWITCHES
	TRNE	T1,SW$SCR	;SEE IF SCRATCH FILE
	TXZ	T,DV.DSK	;YES--KILL DISK INDICATOR
	TXNE	T,DV.DSK	;DISK?
	TLO	F,L.DSKO	;YES--REMEMBER THAT
				CONT.
	TXNN	T,DV.M14	;BINARY SUPPORTED?
	JRST	ERR44		;NO. ERROR
	MOVS	T,$FILE		;GET FILE NAME
	CAIN	T,'*  '		;WILD?
	TLO	F,L.WFO		;YES. FLAG WILD FILE OUTPUT
	SKIPN	T		;ANY NAME?
	TLO	F,L.BFO		;NO. REMEMBER BLANK OUTPUT
	MOVSM	T,OFILE		;SAVE NAME
	MOVS	T,$EXT		;FILE EXTENSION
	CAIN	T,'*  '		;WILD?
	TLO	F,L.WEO		;YES. FLAG WILD EXT OUTPUT
	SKIPN	T		;ANY EXT?
	TLO	F,L.BEO		;NO. REMEMBER BLANK OUTPUT
	MOVSM	T,OEXT		;SAVE EXTENSION
	MOVPPN	$TPPN,OPPN	;MOVE DIRECTORY
	MOVE	T,$TPRT		;GET PROTECTION FOR OUTPUT
	MOVEM	T,OPRT		;SAVE IT.
	MOVE	T,$TID		;OUTPUT TAPE IDENTIFIER
	MOVEM	T,OTID		; ..
	MOVE	T,$TSW		;OUTPUT SWITCHES
	TRNE	T,SW$G		;GO BEYOND ERRORS?
	TRO	F,R.GO		;YES
	MOVEM	T,OSW		;SAVE THE SWITCHES
	TRNE	T,SW$TAP	;A TAPE SWITCH?
	TLNE	F,L.DTO		;BUT NOT A TAPE ON OUTPUT?
	SKIPA			;NO. OK
	JRST	[TRNN T,SW$R	;YES--SEE IF ON DISK
		 JRST ERR42	;NO--ERROR
		 JRST .+1]	;YES--OK TO PROCEED

BEG1:	TLNN	F,L.DTO		;SEE IF DECTAPE
	TDZA	T1,T1		;NO--CLEAR FLAG
	SETOM	T1		;YES--SET FLAG
	PUSHJ	P,SELDTT	;SELECT TAPE FORMAT
	MOVEM	T1,OTYPEX	;STORE INDEX FOR OUTPUT
	JRST	ASKINP		;GET INPUT SPECIFICATION
;FLAG THE END OF JOB FLAG FOR A DIRECTORY LISTING ON THE TTY

ASKINL:	SETOM	EOJFLG		;THIS IS THE END OF JOB

;NOW GET AN INPUT FILE SPECIFIER

ASKINP:	MOVE	T,.JBFF		;REMEMBER .JBFF BEFORE ANY FILES
	MOVEM	T,SJFF		; FOR THE DISK DIRECTORY BUFFER
	MOVEM	T,SJFF2		; FOR THE INPUT BUFFERS
	MOVEM	T,SJFF3		; FOR THE OUTPUT FILE BUFFERS
	MOVEM	T,SJFF4		; FOR THE RPBSCR ROUTINE, AFTER OUT FILE
	MOVE	T,$BRKC		;SEE IF CORRECT FORMAT COMMAND
	CAIE	T,","		;SEE IF COMMA
	CAIN	T,.CHLFD	; OR IF END
	JRST	[SKIPN SWLIST	;YES--IF /L,
		 JRST  .+1	;NO--CONTINUE
		 SETZM ODEV	;YES--CLEAR OUTPUT
		 JRST  REINP1]	;AND PROCEED
	SETZM	$PSW		;THESE DONT CARRY OVER THE ARROW
	SETZM	$PPRT		; ..
	SETZM	$PPPN		; ..
	SETZM	$DEV		; ..
	SETZM	$SDEV		; ..
	SETZM	IFILE		;CLEAR INPUT FILE NAME
	SETZM	IEXT		;AND EXT IN CASE NULL INPUT.
	CAIE	T,","		;SEE IF COMMA
	CAIN	T,.CHLFD	;SEE IF END
	JRST	[SKIPE SWONLZ	;IF PLAIN /Z
		 JRST  OUTASK	; PROCEED
		 JRST  ERR22]	;NO--BAD BREAK
	CAIE	T,"="		; ..
	JRST	ERR22		;NO GOOD.

REINP:	TRZ	F,R.IN		;INITIALIZE THIS FLAG
	TLZ	F,L.MFI		;AND CLEAR COMMA-SEEN FLAG
	PUSHJ	P,FILSPC	;GET AN INPUT FILE SPECIFIER
	  JRST	FILEX		;BAD SYNTAX.
	SKIPE	SWHELP		;SEE IF /H
	JRST	DOHELP		;YES--GO HANDLE THAT
REINP1:	SKIPE	$TPRT		;CHECK FOR PROTECTION SPECIFIED
	PUSHJ	P,ERR30		;YES--WARNING
	SKIPE	$TID		;CHECK FOR TAPE ID SPECIFIED
	PUSHJ	P,ERR31		;YES--WARNING
	TLZ	F,L.STR1	;NO STAR FILES PROCESSED YET
	MOVE	T,$DEV		;ANY INPUT REQUESTED?
	IOR	T,$FILE		; ..
	IOR	T,$EXT
	IOR	T,$TSW
	SKIPE	T
	TRO	F,R.IN		;YES. REMEMBER THAT
				CONT.
	SKIPE	$SDEV		;SEE IF PSEUDO DEVICE SET
	JRST	ASKI01		;YES--CAN USE DIRECTLY
	MOVE	T,$TSW		;GET SWITCHES
	TRNE	T,SW$R		;IF /R,
	JRST	[SKIPE T,$DEV	; SEE IF DEVICE
		 MOVEM T,IPDEV	;YES--NAME OF PSEUDO FILE
		 JRST  ASKI0]	;AND PROCEED
ASKI01:	SKIPE	T,$SDEV		;IF PSEUDO DEVICE,
	MOVEM	T,IPDEV		;REMEMBER IT AS TEMP FILE NAME
	SKIPE	T,$DEV		;ANY DEVICE SPECIFIED?
	JRST	ASKI1		;YES.
ASKI0:	SKIPN	T,IDEV		;ANY PREVIOUS DEVICES?
	MOVSI	T,'DSK'		;NO. FIRST TIME, DEFAULT IS DISK
ASKI1:	MOVEM	T,IDEV		;STORE INPUT DEVICE
	TLZ	F,L.DTI!L.DSKI	;FIND DEVICE TYPE. CLEAR OLD ONES.
	DEVCHR	T,		;GET DEVICE CHAR BITS
	JUMPE	T,ERR48		;ANY SUCH THING?
	TXNE	T,DV.DSK	;IF DISK,
	TXZ	T,DV.DTA	; CAN'T BE DTA (IN CASE NUL:)
	TXNE	T,DV.DTA	;DECTAPE?
	TLO	F,L.DTI		;YES.
	MOVE	T1,$TSW		;GET SWITCHES
	TRNE	T1,SW$SCR	;SEE IF SCRATCH FILE
	TXZ	T,DV.DSK	;YES--KILL DISK INDICATOR
	TXNE	T,DV.DSK	;DISK?
	TLO	F,L.DSKI	;YES.
	TXNN	T,DV.M14	;BINARY SUPPORTED?
	JRST	ERR45		;NO. ERROR
	SKIPE	SWLIST		;SEE IF /L
	TRNN	F,R.BDO		; AND NO OUTPUT
	SKIPA			;NO
	JRST	[MOVE T,$TSW	;YES--GET SWITCHES
		 TRNN T,SW$SCR	;MUST SIMULATE
		 TLNE F,L.DTI	; OR REAL DTA
		 JRST .+1	;OK
		 JRST ERR50]	;BAD--GIVE ERROR
	MOVS	T,$FILE		;GET INPUT FILE NAME
	SKIPN	T		;ANY IN INPUT STRING?
	MOVS	T,IFILE		;NO. COPY PREVIOUS IF ANY
	SKIPN	T		;ANY SPECIFIED?
	MOVEI	T,'*  '		;NO. ASSUME HE MEANS WILD.
	CAIN	T,'*  '		;IS IT WILD?
	TLO	F,L.WFI		;YES. REMEMBER THAT.
	MOVSM	T,IFILE		;AND SAVE IT.
	MOVS	T,$EXT		;GET INPUT EXT FROM CMD STRING
	TRNE	F,R.EXT		;ANY SPECIFIED?
	JRST	ASKI2		;YES. USE IT EVEN IF BLANK
	MOVS	T,IEXT		;GET PREVIOUS ONE
	SKIPN	T		;ANY THERE?
	MOVEI	T,'*  '		;NO. USE WILD.
				CONT.
ASKI2:	CAIN	T,'*  '		;WILD?
	TLO	F,L.WEI		;YES. REMEMBER THAT.
	MOVSM	T,IEXT		;SAVE INPUT EXTENSION
	MOVPPN	$TPPN,IPPN	;MOVE DIRECTORY
	MOVE	T,$TSW		;SWITCHES
	MOVEM	T,ISW		;SAVE THEM
	TRNE	T,SW$TAP	;A TAPE SWITCH?
	TLNE	F,L.DTI		;BUT NOT A TAPE INPUT?
	SKIPA			;NO. OK
	JRST	[TRNE T,SW$R	;YES--SEE IF /R
		 JRST .+1	;YES--OK
		 JRST ERR41]	;NO--ERROR
	TRNE	T,SW$G		;GO SWITCH ON?
	TRO	F,R.GO		;YES. REMEMBER IF FLAG AC
	MOVE	T1,$BRKC	;GET BREAK CHARACTER
	CAIN	T1,","		;COMMA?
	TLO	F,L.MFI		;YES. MULTIPLE INPUT FILES.
	SKIPN	ODEV		;SEE IF OUTPUT
	JRST	ASKI3		;NO--SKIP THESE TESTS
	SETOM	CNVSME		;ASUME IDEV=ODEV
	SETOM	CNVWEO		;AND A WILD OUTPUT EXTENSION
	TRZ	F,R.SAVX	;ASSUME NO SAVE CONVERSION
	TLNE	F,L.WEI		;IF A BLANK OR WILD INPUT EXT
	TRNN	T,SW$C		;OR NO /C THEN
	JRST	ASKI23		;SKIP THE CONVERSION SPECIALS
	SETZM	SOEXT		;ASSUME BLANK OUTPUT
	TLNE	F,L.WEO!L.BEO	;IS OUT BLANK OR WILD
	JRST	ASKI20		;OKAY NO WISHES
	MOVE	T1,[-EXTLEN,,EXTLST] ;GET LIST OF EXTENSIONS
	MOVE	T2,OEXT		;GET OUTPUT EXTENSION
	CAME	T2,(T1)		;SEE IF IT IS IN THE LIST
	AOBJN	T1,.-1
	JUMPG	T1,ASKI23	;NO THEN NO C STUFF
	CAME	T2,[ SIXBIT /LOW/] ;IF LOW IS EXTENSION
	MOVSI	T2,(SIXBIT /HGH/)  ;THEN USE HIGH
	MOVEM	T2,SOEXT	;OEXT MIGHT CHANGE SO VEREXT KNOWS RIGHT ONE
	SETZM	CNVWEO		;NO WILD EXTENSION
	MOVE	T1,[-1,,EXEIDX] ;GET POINTER TO EXE
	HLRZ	T2,OEXT		;GET HIS EXTENSION
	CAIN	T2,(SIXBIT /EXE/) ;IF EXE THEN
	SKIPA	T1,[-3,,SAVIDX] ;TAKE OLD SAVE INPUT
ASKI20:	MOVE	T1,[-4,,SAVIDX] ;START AT THE BEGINNING
	TLZ	F,L.WEO!L.BEO!L.WEI	;ZAP THE EXTENSION FLAGS
	MOVEM	T1,EXTPTR	;TO SCAN
	MOVE	T1,ODEV		;OUTPUT DEVICE
	DEVNAM	T1,		;GET ITS REAL NAME
	SETZM	T1		;ERROR CASE JUST MISMATCH
	MOVE	T2,IDEV		;INPUT DEVICE
	DEVNAM	T2,		;GET THE REAL ONE AGAIN
	SETOM	T2,		;JUST DO ALL
	CAME	T1,T2		;IDENTCAL DEVICES
	SETZM	CNVSME		;NO DIFFERENT
	TRO	F,R.SAVX	;FLAG CONVERTING
ASKI23:	TLNE	F,L.MFI!L.WEI!L.WFI	;MORE THAN ONE INPUT?
	TLNE	F,L.WFO!L.WEO!L.BFO!L.BEO	;YES. MUST BE MULTIPLE OUTPUT TOO.
	SKIPA			;OK.
	JRST	ERR11		;NO GOOD.
	TLNE	F,L.WEI		;MAKE SURE *S LINE UP
	TLNE	F,L.WEO!L.BEO	;INP EXT WILD
	SKIPA			;  IMPLIES OUT EXT WILD
	JRST	ERR11		;NO
	TLNE	F,L.WFI		;INP NAME WILD
	TLNE	F,L.WFO!L.BFO	;  IMPLIES OUT NAME WILD
	SKIPA			;YES
	JRST	ERR11		;NO
ASKI3:	TRNE	T,SW$Z		;ZERO SWITCH ON INPUT?
	PUSHJ	P,ERR43		;YES. NON-FATAL ERROR.
;SEE IF WANT TO PUT TAPE ON SCRATCH FILE

EOJLOP:	TRNE	T,SW$R		;SEE IF /R (REUSE)
	JRST	ASKI4		;YES--SKIP OPENS
	RELEAS	INF,		;CLEAR ANY PREVIOUS USE OF CHANNEL
	MOVEI	A,IO.NSD!.IODMP	;GET TAPE IN KLUDGE MODE
	MOVE	B,IDEV		; ..
	MOVEI	C,IHED2		; ..
	OPEN	INF,A		; ..
	  JRST	ERR1		;NOT THERE.
ASKI4:	TLNN	F,L.DTI		;SEE IF DECTAPE
	TDZA	T1,T1		;NO--CLEAR INDICATOR
	SETOM	T1		;YES--SET FLAG
	PUSHJ	P,SELDTT	;SELECT DECTAPE TYPE
	MOVEM	T1,ITYPEX	;SAVE TYPE INDEX
	TRNN	T,SW$R		;UNLESS /R,
	TLNE	F,L.DTI		; IF INPUT IS A DTA,
	TRNN	T,SW$SCR	;WANT QUICK MODE?
	JRST	GETDIR		;NO. FORGET IT THEN.
	TRNN	T,SW$P!SW$R	;WANT TO KEEP IT?
	TRO	F,R.JSCR	;NO. REMEMBER TO FLUSH IT
SCRL2:	HRRZ	T,.JBREL	;COMPUTE NUMBER OF BLOCKS TO FIT IN CORE
	HRRZ	T1,.JBFF	; ..
	SUB	T,T1		;SIZE OF FREE CORE
	ASH	T,-7		;IN TAPE BLOCKS
	SUBI	T,1		;MINUS FRAGMENT
	MOVEM	T,BLKS		;SAVE NUMBER OF BLOCKS
	CAIL	T,40		;SMALL NUMBER?
	JRST	SCRB		;NO. USE THIS NUMBER
	MOVE	T,.JBREL	;TRY FOR MORE CORE
	MOVEI	T,1(T)		;ASK FOR ANOTHER K
	CORE	T,		;...
	  JRST	SCRB		;NOT THERE, USE WHAT WE HAVE.
	JRST	SCRL2		;GOT IT. RECOMPUTE BLOCKS.
SCRB:	MOVE	T,ITYPEX	;GET TYPE OF TAPE
	MOVE	T1,LBLK(T)	;GET LENGTH OF THAT TYPE
	CAIN	T,TYPSIX	;IF SIX TAPE,
	HLRZ	T1,DIRECT+0	;GET LENGTH OF USED TAPE
	CAIG	T1,LASTOB	;RANGE AHECK SIX TAPE
	CAIGE	T1,1		; ..
	JRST	ERR5		;NO GOOD 6 DIRECTORY
	MOVEM	T1,LASTBK	;SAVE FOR LATER
				CONT.
SCR1:	MOVEI	A,.IODMP	;GET DUMP MODE DISK FOR SCRATCH
	MOVSI	B,'DSK'		; ..
	MOVEI	C,0		;NO BUFFERS
	OPEN	SCRF,A		;ASK FOR DISK
	  JRST	ERR3		;NOT THERE.
	MOVE	A,SCRNAM	;GET THE SCRATCH FILE NAME
	SKIPE	EOJFLG		;IF END PASS,
	HRRI	A,'XFO'		; THEN USE OUTPUT SCRATCH
	MOVE	C,IPDEV		;GET INPUT PSEUDO FILE
	SKIPE	EOJFLG		;IF END PASS,
	MOVE	C,OPDEV		; GET OUTPUT PSEUDO FILE
	SKIPE	C		;IF PSEUDO SET
	MOVE	A,C		; USE AS FILE NAME
	MOVSI	B,'TMP'		;AND EXT
	SKIPE	C		;IF PSEUDO SET
	MOVSI	B,'DTA'		; USE ITS EXTENSION
	SETZB	C,D		; ..
	LOOKUP	SCRF,A		;SEE IF FILE ALREADY THERE.
	  JRST	SCRA		;NO. GOOD.
	MOVE	T,ISW		;YES. SEE IF REALLY WANT NEW ONE
	TRNE	T,SW$R		; ..
	JRST	SCRC		;NO. WANT TO REUSE OLD ONE
	SETZB	A,B		;YES. CLEAR NAME TO DELETE
	SETZB	C,D		; ..
	CLOSE	SCRF,		;CLOSE FILE
	RENAME	SCRF,A		;DELETE FILE
	  JFCL			;IGNORE FAIL RETURN, ENTER WILL PROB FAIL

SCRA:	MOVE	T,ISW		;GET INPUT SWITCHES
	TRNE	T,SW$R		;IF /R
	JRST	ERR62		; FILE MUST EXIST
	CLOSE	SCRF,		;CLOSE FILE FROM LOOKUP
	STORE	A,ENTBLK,ENTBLK+.RBEST,0	;CLEAR EXTENDED ENTER BLOCK
	MOVEI	A,.RBEST
	MOVEM	A,ENTBLK
	MOVE	A,SCRNAM	;NOW WRITE SCRATCH FILE
	MOVEM	A,ENTBLK+.RBNAM
	MOVSI	A,'TMP'
	MOVEM	A,ENTBLK+.RBEXT
	MOVE	A,LASTBK	;ESTIMATE
	MOVEM	A,ENTBLK+.RBEST	; AS DTA SIZE
	ENTER	SCRF,ENTBLK	;TRY TO WRITE NEW SCRATCH FILE
	  JRST	ERR4		;CAN'T. GIVE UP ON TEMP ON DSK
	MOVEI	T,0		;BLOCK NUMBER 0
	PUSHJ	P,READBT	;READ BLOCK TO TBUF
	  PUSHJ	P,ERR39		;ERROR ON BLK 0
	OUT	SCRF,TIOL	;WRITE BLOCK 0 ON DISK FILE
	  SKIPA
	  PUSHJ	P,ERR7
	MOVEI	B,1		;CURRENT BLOCK IS NOW BLK 1
				CONT.
SCRRL:	CAMLE	B,LASTBK	;STILL SOME TO READ?
	JRST	SCREND		;NO. DONE.
	MOVE	T1,LASTBK	;SEE HOW MANY FOR THIS READ.
	ADDI	T1,1		; ..
	SUB	T1,B		;ALL OF REMAINING TAPE
	MOVE	T,BLKS		;AMOUNT THAT FITS IN CORE
	ADD	T,B		;BLK TO READ IF CAN FILL CORE
	CAMGE	T,LASTBK	;WOULD THAT EXCEED TAPE?
	MOVE	T1,BLKS		;YES. JUST READ ENOUGH FOR CORE.
	MOVEM	T1,D		;SAVE THIS NUMBER OF BLOCKS
	MOVNS	T1		;MAKE IOWD TO READ THIS
	LSH	T1,31		;MINUS WORD COUNT
	HRR	T1,SJFF		;ADDRESS-1
	MOVEM	T1,CORIOW	;PUT IN COMMAND LIST
	USETI	INF,(B)		;SET FOR INPUT BLOCK
	IN	INF,CORIOW	;READ TAPE
	  SKIPA
	  PUSHJ	P,ERR6		;YES. SEE IF /G
	OUT	SCRF,CORIOW	;NOW WRITE ON DISK
	  SKIPA
	  PUSHJ P,ERR7		;ERR. SEE IF /G
	ADD	B,D		;UPDATE NEXT BLOCK TO READ
	JRST	SCRRL		;AND SEE IF DONE YET.

SCREND:	MTREW.	INF,		;DONE WITH DTA. REWIND IT.
	CLOSE	SCRF,		;CLOSE SCRATCH FILE
	MOVE	A,SCRNAM	;NOW SET TO READ SCRATCH FILE
	MOVSI	B,'TMP'		; ..
	SETZB	C,D		; ..
	LOOKUP	SCRF,A		;OPEN FOR READING
	  JRST	ERR8		;OOPS. CAN'T
SCRC:	TLO	F,L.SCRI	;FLAG READING SCRATCH FILE ON DSK
	SETOM	SCRBK1		;FLAG NOT YET READING SCRF
	SUBTTL	ROUTINE TO READ AND LIST A DIRECTORY BLOCK

GETDIR:	TLNN	F,L.DTI!L.SCRI	;SEE IF SIMULATED OR REAL TAPE
	JRST	OUTASK		;NO--SKIP /L REQUEST IF ANY
	MOVE	T,ITYPEX	;GET INPUT TAPE TYPE
	MOVE	T,DBLK(T)	;GET DIRECTORY BLOCK
	MOVEM	T,DIRBKN	;SAVE NUMBER WHICH IS IN DIRECT BUFFER
	PUSHJ	P,RBTDIR	;READ INTO DIRECTORY BUFFER
	  JRST	ERR2		;ERROR READING.
	MOVE	T1,ITYPEX	;GET INPUT TYPE
	CAIE	T1,TYPVEN	;PDP-11 TAPE?
	JRST	TYPDIQ		;NO
	HLRZ	T,DIRECT+1	;YES. PRE-PROCESS A BIT. GET PBM BLK #
	MOVEM	T,PBMBKI
	HLRZ	T,DIRECT+0	;GET LINK TO MFD DATA
	MOVEM	T,DIRBKN	;REMEMBER WHAT'S INDIRECT
	PUSHJ	P,RBTDIR	;READ DIRECTORY
	  JRST	ERR2
	HRRZ	T,DIRECT+0	;GET UIC (PPN)
	MOVEM	T,VENPPI	;SAVE IT
	HRRZ	T,DIRECT+1	;GET LENGTH OF EACH ENTRY IN UFD
	MOVEM	T,VWPEI		;SAVE IT FOR LATER
	HLRZ	T,DIRECT+1	;FIRST BLK OF UFD
	MOVEM	T,VDIRB1	;FIRST REAL DATA BLOCK
	MOVEM	T,DIRBKN	;REMEMBER WHAT BLK THIS IS
	PUSHJ	P,RBTDIR	;READ IT INTO DIRECT. THIS IS THE REAL STUFF
	  JRST	ERR2
	HLRZ	T,DIRECT
	MOVEM	T,VDIRB2	;AND SECOND ONE

TYPDIQ:	SKIPN	SWLIST		;SEE IF /L
	JRST	TYPD.1		;NO--PROCEED
	TLNE	F,L.DTI!L.SCRI	;IS THIS A DECTAPE?
	PUSHJ	P,DIR		;YES--LIST DIRECTORY
TYPD.1:	SKIPE	EOJFLG		;TEST FOR END-OF-JOB PASS
	JRST	EOJ1		;YES--GO BACK TO EOJ PROCESSING
	SUBTTL	ROUTINE TO PROCESS COPY OPERATIONS

OUTASK:	TRNE	F,R.BDO		;ANY OUT SPEC?
	JRST	EPROCS		; ALL DONE
	MOVE	T,OSW		;GET OUTPUT FILE SWITCHES
	TRZE	F,R.MFI2	;REPEATING AFTER COMMA?
	JRST	SELFIL		;YES. OUTPUT ALREADY SET UP
	TLNN	F,L.DTO		;IS OUTPUT A DECTAPE?
	TRNE	T,SW$SCR	; OR SIMULATED ONE
	SKIPA			;YES
	JRST	SELFIL		;NO. SKIP THIS SECTION
	TRNE	T,SW$R		;REUSING?
	JRST	OUTASL		;YES--SKIP ONWARD
	MOVEI	A,IO.NSD!.IODMP	;GET OUTPUT TAPE IN KLUDGE MODE
	MOVE	B,ODEV		; ..
	MOVEI	C,0		;NO BUFFERS
	OPEN	OUTF,A		;TRY TO GET TAPE
	  JRST	ERR9		;CAN'T GET IT?
	TRNN	T,SW$SCR	;QUICK OUTPUT?
	JRST	OUTZA		;NO.
OUTASL:	MOVEI	A,.IODMP	;YES. GET DSK FOR SCRATCH FILE
	MOVSI	B,'DSK'		; ..
	MOVEI	C,0		;NO HEADERS
	OPEN	SCOF,A		;ASK FOR DSK
	  JRST	ERR3		;NOT THERE?
	TRNN	T,SW$Z!SW$Q	;IF /Z OR /Q,
	JRST	OUTZSA		; PROCEED
				CONT.
OUTASZ:	MOVEI	T,SW$Z		;FORCE A ZER FILE SRUCTURE
	IORB	T,OSW		;REMEMBERIT
	STORE	A,ENTBLK,ENTBLK+.RBEST,0	;CLEAR EXTENDED ENTER
	MOVEI	A,.RBEST
	MOVEM	A,ENTBLK
	MOVE	A,SCRNAM	;GET SCRATCH NAME
	HRRI	A,'XFO'		;OUTPUT SCRATCH NAME
	SKIPE	OPDEV		;IF PSEUDO FILE,
	MOVE	A,OPDEV		; GET IT
	MOVEM	A,ENTBLK+.RBNAM
	MOVSI	A,'TMP'
	SKIPE	OPDEV		;IF PSEUDO FILE,
	MOVSI	A,'DTA'		; USE SPECIAL EXTENSION
	MOVEM	A,ENTBLK+.RBEXT
	MOVEI	A,LASTOB
	MOVEM	A,ENTBLK+.RBEST
	ENTER	SCOF,ENTBLK	;ENTER IT FOR OUTPUT
	  JRST	ERR4		;CAN'T?
	SETZM	TBUF		;USE THIS BLOCK FOR SOME ZEROES
	MOVE	T,[XWD TBUF,TBUF+1]
	BLT	T,XBUF+177	;CLEAR IT
	MOVEI	T,<LASTOB+1>/2	;LENGTH OF PSEUDO TAPE
	OUT	SCOF,TXIOL	;WRITE BLKS 0 THRU 1101
	  SKIPA
	  PUSHJ	P,ERR35		;YES
	SOJG	T,.-3		;WRITE WHOLE TAPE'S WORTH
	CLOSE	SCOF,		;CLOSE THE FILE
OUTZSA:	MOVE	A,SCRNAM	;GET SCRATCH NAME
	HRRI	A,'XFO'		;CONVERT FOR OUTPUT
	SKIPE	OPDEV		;IF PSEUDO FILE,
	MOVE	A,OPDEV		; GET IT
	MOVSI	B,'TMP'		;INDICATE TEMP FILE
	SKIPE	OPDEV		;IF PSEUDO FILE,
	MOVSI	B,'DTA'		; USE SPECIAL EXTENSION
	SETZB	C,D		; ..
	LOOKUP	SCOF,A		;OPEN FILE FOR UPDATING
	  JRST	[MOVE T,OSW	;GET OUTPUT SWITCHES
		 TRNN T,SW$Z!SW$Q ;IF /Z OR /Q,
		 TRNE B,77	; OR IF OTHER THAN "NOT FOUND",
		 JRST ERR35	; THEN ERROR
		 PUSHJ P,ERR51	;ELSE, WARN THAT /Z ASSUMED
		 MOVEI T,SW$Z	;SET
		 IORM T,OSW	; /Z ON OUTPUT
		 JRST OUTASZ]	;AND TRY JUST ONCE MORE
	HLLZS	B
	SETZB	C,D
	ENTER	SCOF,A		; ..
	  JRST	ERR35
	TLO	F,L.SCRO	;SUCCESSFUL. FLAG FOR LATER ROUTINES.
				CONT.
OUTZA:	MOVE	T,OSW		;GET OUTPUT SWITCHES
	TRNN	T,SW$Z		;WANT OUTPUT ZEROED?
	JRST	OUTZA1		;NO. SKIP THIS
	MOVEI	T1,SW$Z		;CLEAR BIT IN SWITCH WORD
	ANDCAM	T1,OSW		;SO ONLY DO THIS ONCE
	PUSHJ	P,ZER		;ZERO OUTPUT TAPE

OUTZA1:	SETOM	VODIB1		;PREPARE THESE BECAUSE DONT KNOW THEM YET
	SETOM	VODIB2		; ..
	TLNN	F,L.DTO!L.SCRO	;NO, IS OUTPUT TO DECTAPE?
	JRST	SELFIL		;NO. SKIP THIS
	MOVE	T,OTYPEX	;GET OUTPUT TYPE
	MOVE	T,DBLK(T)	;GET DIRECTORY BLOCK NUMBER
	MOVEM	T,ODIBKN	;SAVE FOR MULTI-BLOCK ON ELEVEN
	PUSHJ	P,INOUTD	;READ OUTPUT DIRECTORY
	JRST	SELFIL		;PROCEED

DBLK:	0		;NOT DECTAPE
	144		;TEN
	1		;SIX
	100		;MAC
	100		;FIFTEEN
	100		;ELEVEN

LBLK:	0		;NOT DECTAPE
	LASTOB		;TEN
	LASTOB		;SIX
	1067		;MAC
	1077		;FIFTEEN
	1077		;ELEVEN


SELFIL:	TRNN	F,R.IN		;ANYTHING WANTED?
	JRST	SCOQ		;NO. QUIT.
	SETOM	SRCHP		;FLAG NOT YET INTO DIRECTORY
	MOVE	T,SJFF		;RECLAIM SPACE
	MOVEM	T,.JBFF		; ..
	MOVEM	T,SJFF2		;SET MINIMUM PER-FILE .JBFF
;SELECT FILES AND DISPATCH TO THE TRANSFER ROUTINE

RESELF:	PUSHJ	P,SELFST	;GO SELECT ANOTHER FILE
	  JRST	[TLZ  F,L.WFI!L.WEI ;CLEAR WILD INPUT FLAGS
		 TLZN F,L.STR1	;NO MORE STAR. WAS THERE ONE?
		 JRST ERR23	;NO. THEN THERE WAS NO SUCH FILE.
		 JRST EPROCS]	;OK. GO TO END OF PROCESSING.

PROCES:	SETZM	RCA		;CLEAR READ ADDRESS COUNTER
	MOVE	T,ITYPEX	;GET INPUT TYPE
	PUSHJ	P,SELDTP	;SELECT TAPE MACHINE TYPE
	MOVE	B,T		;SAVE FOR LATER
	MOVE	T,OTYPEX	;GET OUTPUT TYPE
	PUSHJ	P,SELDTP	;SELECT TAPE MACHINE TYPE
	IMULI	B,DT$NUM	;ALLOW FOR N-TYPES
	ADDI	B,(T)		;COMPUTE MACHINE CONVERSION
	JUMPN	B,[ADDI B,FT$NUM*FT$NUM+FT$NUM ;OFFSET BEYOND 36-BIT TABLE
		   JRST PROC.1]	;GO PROCESS TRANSFER

;HERE WHEN TRNASFER IS SOME KIND OF 36 BIT TO 36 BIT
	HLRZ	A,TIEXT		;GET AN EXTENSION
	MOVE	C,ISW		;AND SWITCHES
	PUSHJ	P,SELFTP	;AND SELECT FILE TYPE
	MOVE	B,RDWRD-1(T)	;GET TYPE OF READ ROUTINE
	MOVEM	B,RPC		;INTIALIZE ROUTINE
	MOVE	B,T		;GET ANSWER
	MOVE	C,OSW		;GET OUTPUT SWITCHES
	HLRZ	A,TOEXT		;GET OUTPUT EXTENSION
	TLNE	F,L.WEO		;WILD OUTPUT?
	HLRZ	A,TIEXT		;YES. COPY INPUT
	PUSHJ	P,SELFTP	;SELECT FILE TYPE
	TLZ	F,L.6DO		;ASSUME NOT SIX DUMP
	CAIN	T,FT$D		;SIX DUMP?
	TLO	F,L.6DO		;YES. REMEMBER IT
	CAIE	T,FT$C		;SHOULD FILE BE WRITTEN TIGHT ON TEN?
	CAIN	T,FT$E		;NAMELY COMPRESSED OR EXPANDED?
	TLO	F,L.6DO		;YES.
	CAIE	T,FT$H		;IF HIGH SEG
	CAIN	T,FT$P		; OR PROGRAM,
	TLO	F,L.6DO		; SET IT ALSO
	IMULI	B,FT$NUM	;MAKE MORE SIGNIFICANT
	ADDI	B,(T)		;GET OFFSET INTO TABLE FOR XFER
PROC.1:	PUSH	P,B		;SAVE DISPATCH
	CAIE	B,FT$P*FT$NUM+FT$H ;SEE IF P TO H
	CAIN	B,FT$P*FT$NUM+FT$C ;OR P TO C
	SKIPA			;IN THOSE CASES SKIP THE ENTER
	PUSHJ	P,ENTRN		;NO--JUST ENTER NORMAL OUTPUT FILE
				;(P TO H CHOOSES AUTOMATIC EXTENSIONS)
	POP	P,B		;RESTORE DISPATCH
PROC.2:	PUSHJ	P,@XARRAY-1-FT$NUM(B)	;DO THE TRANSFER
				; AND CLOSE THE FILE
	SUBTTL	END OF MAIN LOOP

EPROCS:	TRNN	F,R.BDO		;IF NO OUTPUT , AND NOT
	TLNN	F,L.MFI!L.WEI!L.WFI	;MULT INPUTS?
	JRST	SCOQ		;NO. GO SEE IF TAPE NEEDS WRITING FM SCRATCH
	TRO	F,R.MFI2	;FLAG RE-SCANNING, OUTPUT ALREADY OPEN
	TLNN	F,L.WEI!L.WFI	;WILD?
	JRST	EPROC0		;CHECK IF /C NEEDS 
	TLO	F,L.STR1	;FLAG HAVE READ ONE * FILE
	JRST	RESELF		;YES. READ ANOTHER OF THE * FILES.
EPROC0:	TRZN	F,R.SAVX	;CONVERTING WITH /C?
	JRST	REINP		;GET NEW INPUT
	MOVE	T,SOEXT		;IF NO OUT EXTENSION
	MOVEM	T,OEXT		;THEN RESTORE IT
	SKIPE	CNVWEO		;RESET F FLAG
	TLO	F,L.BEO!L.WEO	; TO WILD
	JRST	REINP		;RE DO INPUT

SCOQ:	TLNN	F,L.SCRO	;SCRATCH OUTPUT?
	JRST	EOJ		;NO. ALL DONE
	CLOSE	SCOF,		;HAVE TO CLOSE FILE BEFORE READING
	RELEAS	INF,		;CLEAR THESE CHANNELS BECAUSE WILL USE
	RELEAS	UFDF,		; THEIR BUFFER AREAS FOR OUTPUTTING
	MOVE	T,OSW		;GET OUTPUT SWITCHES
	TRNE	T,SW$R		;SEE IF TO BE REUSED
	JRST	SCOENX		;YES--SKIP ON
	MOVE	A,SCRNAM	;AND RE-OPEN IT FOR INPUT
	HRRI	A,'XFO'
	MOVSI	B,'TMP'
	SETZB	C,D
	LOOKUP	SCOF,A		;READ THE FILE
	  JRST	ERR34		;NOT THERE?
	USETI	SCOF,1		;READ TAPE'S BLOCK 0
	IN	SCOF,WIOL	;INTO WBUF
	  SKIPA
	  JRST	ERR35		;YES. QUIT
	PUSHJ	P,WBK0		;WRITE BLOCK 0 ON TAPE
	  JRST	ERR19		;ERROR ON TAPE
SCOL2:	HRRZ	T,.JBREL	;SEE HOW MUCH CORE IS AVAILABLE
	HRRZ	T1,.JBFF
	SUB	T,T1
	ASH	T,-7		;IN TAPE BLKS
	SUBI	T,1
	MOVEM	T,BLKS		;SAVE FOR LOOP
	CAIL	T,40		;ENOUGH FOR EFFICIENCY?
	JRST	SCOB		;YES.
	MOVE	T,.JBREL	;NO.
	MOVEI	T,1(T)		;ASK FOR ANOTHER K
	CORE	T,		; ..
	  JRST	SCOB		;CANT HAVE IT. WELL, USE WHAT YOU HAVE
	JRST	SCOL2		;GOT IT. SEE IF ANY MORE NEEDED
				CONT.
SCOB:	MOVEI	B,1		;START AT BLK 1 (0 DONE ABOVE)

SCOL:	CAILE	B,LASTOB	;ALL WRITTEN?
	JRST	SCOEND		;YES.
	MOVEI	T1,LASTOB	;NO.
	ADDI	T1,1		;LAST PLUS ONE
	SUB	T1,B		;MINUS WHERE WE ARE
	MOVE	T,BLKS		;SPACE WE HAVE IN CORE
	ADD	T,B		;WHERE THAT WOULD LEAVE US
	CAIGE	T,LASTOB	;TOO MUCH?
	MOVE	T1,BLKS		;NO. GET IT ALL
	MOVEM	T1,D		;SAVE
	MOVNS	T1		;MINUS BLKS
	LSH	T1,31		;MINUS WDS,,0
	HRR	T1,SJFF		;PLACE FOR IT
	MOVEM	T1,CORIOW	;TO IO LIST
	USETI	SCOF,1(B)	;GET THE TAPE IMAGE BLK
	IN	SCOF,CORIOW	; ..
	  SKIPA
	  PUSHJ	P,ERR32		;NO.
	USETO	OUTF,(B)	;WHERE TO WRITE ON TAPE
	OUT	OUTF,CORIOW	;DO SO.
	  SKIPA
	  PUSHJ	P,ERR33		;OOPS
	ADD	B,D		;ONWARD DOWN THE TAPE
	JRST	SCOL		;LOOP FOR MORE

SCOEND:	CLOSE	OUTF,		;CLOSE THE DTA
	MTREW.	OUTF,		;REWIND IT
	RELEAS	OUTF,		;SO IT CAN BE USED FOR INPUT
	SETZB	A,B
	SETZB	C,D		;RENAME TO 0
	MOVE	T,OSW		;GET OUTPUT SWITCHES
	TRNN	T,SW$P!SW$R	;SEE IF PRESERVING
	RENAME	SCOF,A		; ..
	  JFCL
SCOENX:	RELEAS	SCOF,		; ..
;ACTUAL END OF JOB PROCESSING

EOJ:	TLNE	F,L.DTO!L.SCRO	;REAL OR SIMULATED TAPE?
	SKIPN	SWLIST		;YES--WAS A DIRECTORY LISTING REQUESTED
	JRST	EOJ1		;NO--SKIP THE OUTPUT
	MOVE	T,ODEV		;COPY OUTPUT DEVICE
	MOVEM	T,IDEV		;  TO INPUT DEVICE
	SETZM	ODEV		;INDICATE NO COPY
	MOVE	T,OSW		;COPY OUTPUT SWITCHES
	TRZ	T,SW$Q		;NO MORE A TEMP FILE
	TRZE	T,SW$SCR	;IF TEMP FILE,
	TRO	T,SW$R		; USE /R FOR OUTPUT LISTING
	MOVEM	T,ISW		;  TO INPUT SWITCHES
				;  AND LEAVE IN T
	TLO	F,L.DTI		;FLAG AS DECTAPE INPUT
	SETOM	EOJFLG		;FLAG AS END-OF-JOB PASS
	JRST	EOJLOP		;GO TO DIRECTORY LISTER
EOJ1:	TRNN	F,R.JSCR	;WANT TO JUNK SCRATCH?
	JRST	EOJE		;NO
	MOVEI	A,.IODMP	;YES. GET DSK
	MOVSI	B,'DSK'
	MOVEI	C,0
	OPEN	SCRF,A
	  JRST	EOJE
	MOVE	A,SCRNAM
	MOVSI	B,'TMP'
	SETZB	C,D
	LOOKUP	SCRF,A
	  JRST	EOJE
	SETZB	A,B
	SETZB	C,D
	CLOSE	SCRF,
	RENAME	SCRF,A
	  JFCL
EOJE:	CLOSE	SCRF,
	JRST	FILEX
	SUBTTL	TRANSFER MODE SELECTIONS

;DUMB ROUTINE TO SELECT THE CURRENT FILE TYPE.
;ARGS - EXTENSION IN RH OF A, SWITCHES IN C. RETURNS TYPE IN T

FT$C==1		;COMPRESSED SAVE FILE
FT$E==2		;EXPANDED SAVE FILE
FT$D==3		;DUMP (SIX) FILE
FT$S==4		;SBLK (MAC) FILE
FT$B==5		;RANDOM BINARY
FT$H==6		;HIGH SEGMENT (.HGH, .SHR)
FT$P==7		;PROGRAM (.EXE) EXECUTABLE
FT$NUM==7	;NUMBER OF TYPES

SELFTP:	MOVEI	T,FT$B		;IN CASE NOTHING ELSE SHOWS UP
	CAIE	A,'SVE'		;CHECK FOR TEN SAVE EXTENSIONS
	CAIN	A,'SAV'		; ..
	MOVEI	T,FT$C		;YES
	CAIN	A,'LOW'		;ONE MORE
	MOVEI	T,FT$C
	CAIN	A,'XPN'		;EXPANDED SAVE FILE?
	MOVEI	T,FT$E		;YES.
	CAIN	A,'DMP'		;SIX DUMP FILE?
	MOVEI	T,FT$D		;YES
	CAIE	A,'HGH'		;HIGH
	CAIN	A,'SHR'		; SEGMENT?
	MOVEI	T,FT$H		;YES
	CAIN	A,'EXE'		;EXECUTABLE PROGRAM?
	MOVEI	T,FT$P		;YES
	TRNE	C,SW$S		;SWITCHES OVERRIDING ABOVE?
	MOVEI	T,FT$S		; S SWITCH
	TRNE	C,SW$D
	MOVEI	T,FT$D
	TRNE	C,SW$E
	MOVEI	T,FT$E
	TRNE	C,SW$B
	MOVEI	T,FT$B
	TRNN	C,SW$C		;UNLESS /C,
	POPJ	P,		; DONE
	CAIE	T,FT$H		;/C--LOOK IF EXTENSION
	CAIN	T,FT$P		; HIGH AND PROGRAM
	POPJ	P,		; OVERRIDE /C
	MOVEI	T,FT$C		;OTHERWISE, FORCE COMPRESSION
	POPJ	P,		;RETURN FILE TYPE
				CONT.
;DUMB ROUTINE TO SELECT THE CURRENT MACHINE TYPE
;ARG - T/?TYPEX CODE, RETURNS TYPE IN T

DT$TEN==0	;-10
DT$FIF==1	;-15
DT$VEN==2	;-11
DT$NUM==3	;NUMBER OF TYPES

SELDTP:	SUBI	T,TYPFIF-1	;MAKE 15'S 1
	SKIPGE	T		;IF -10,
	MOVEI	T,0		; SET TO 0
	POPJ	P,		;RETURN
;SWITCH TABLE - INDEX BY LETTER FROM A
;CONTAINS XWD SET BIT(S), CLR BIT(S)

SWTAB:	XWD	SW$A,SW$I				;A
	XWD	SW$B,SW$C!SW$D!SW$E!SW$S!SW$A!SW$I	;B
	XWD	SW$C,SW$B!SW$D!SW$E!SW$S!SW$A!SW$I	;C
	XWD	SW$D,SW$B!SW$C!SW$E!SW$S!SW$A!SW$I	;D
	XWD	SW$E,SW$B!SW$C!SW$D!SW$S!SW$A!SW$I	;E
	XWD	SW$F,SW$M!SW$V!SW$O!SW$T		;F
	XWD	SW$G,0					;G
	XWD	0,SWHELP				;H
	XWD	SW$I,SW$A				;I
	0						;J
	0						;K
	XWD	0,SWLIST				;L
	XWD	SW$M,SW$F!SW$V!SW$O!SW$T		;M
	0						;N
	XWD	SW$O,SW$F!SW$M!SW$V!SW$T		;O
	XWD	SW$P,SW$Q!SW$R				;P
	XWD	SW$Q,SW$P!SW$R				;Q
	XWD	SW$R,SW$P!SW$Q				;R
	XWD	SW$S,SW$B!SW$C!SW$D!SW$E!SW$A!SW$I	;S
	XWD	SW$T,SW$M!SW$V!SW$O!SW$F		;T
	0						;U
	XWD	SW$V,SW$F!SW$M!SW$O!SW$T		;V	
	0						;W
	0						;X
	0						;Y
	XWD	SW$Z,0					;Z

.ZZ==1			;BITS
DEFINE M$SW(A)<
IRP<A>,<SW$'A==.ZZ
.ZZ==.ZZ+.ZZ>>

;1 FREE BIT; Z COULD ALSO BE RECLAIMED
M$SW(<A,B,C,D,E,F,G,I,M,O,P,Q,R,S,T,V,Z>)

;THE FOLLOWING SWITCHES CONSTITUTE THE SCRATCH FILE SPECIFIERS

SW$SCR==SW$P!SW$Q!SW$R

;THE FOLLOWING SWITCHES ARE MEANINGFUL ONLY ON THE SIDE OF LEFTARROW
; WHICH HAS A DECTAPE AS THE DEVICE

SW$TAP==SW$F!SW$M!SW$O!SW$SCR!SW$T!SW$V!SW$Z
;DISPATCH TABLE FOR TYPE OF TRANSFER OPERATION

;THE FOLLOWING DEFINES AS ILLEGAL CONVERSIONS BETWEEN LOW
;SEGMENT AND HIGH SEGMENT

	DEFINE	ERR53$(A),<
IRP (A),<XFR'A==ERR53>
>
	ERR53$	<HC,HD,HS,CH,DH,SH>


;THE FOLLOWING IS THE DISPATCH FOR THE GENERAL WORD READER
;EACH IS THE INITIAL POINT TO EXPAND THE APPROPRIATE TYPE OF FILE

	DEFINE	RDWRD$(A),<
IRP (A),<RDWRD'A>
>
	XALL
RDWRD:	RDWRD$	(<C,E,D,S,B,H,P>)	;
	SALL


	DEFINE	XFR$(A),< XFR$$(<A>,<A>) >
	DEFINE	XFR$$(X,Y),<
IRP (X),<
IRP (Y),<
....==1
IFIDN <X><B>, ....==0
IFIDN <Y><B>, ....==0
IFIDN <X><Y>, ....==0
IFE ....,<
	XFRBB		;X TO Y (NO CONVERSION)
>
IFN ....,<
	XFR'X'Y		;X TO Y
>
>>>
				CONT.
	XALL
XARRAY:	XFR$	(<C,E,D,S,B,H,P>)	;
				CONT.
;THESE MUST FOLLOW IMMEDIATELY
	XFRTF		;TEN TO FIFTEEN
	XFRTV		;TEN TO ELEVEN
	XFRFT		;FIFTEEN TO TEN
	XFRBB		;FIFTEEN TO FIFTEEN
	ERR36		;FIFTEEN TO ELEVEN
	XFRVT		;ELEVEN TO TEN
	ERR36		;ELEVEN TO FIFTEEN
	XFRVV		;ELEVEN TO ELEVEN
	SUBTTL	36-BIT TRANSFER ROUTINES

;ALL TRANSFERS WHICH CONSIST OF A SIMPLE BINARY COPY FROM INPUT
; TO OUTPUT. THIS IS ALL FOR WHICH INPUT AND OUTPUT ARE THE
; SAME BINARY FORMAT AND ALL THOSE TO AND FROM BINARY MODE.

;THIS IS SO COMMON, THAT SPECIAL CODE TO OPTIMIZE IT IS DESIRABLE.
;IF THE INPUT AND OUTPUT ARE BOTH -10 DEVICES AND NOT
;THE SIMULATED DECTAPES, THEN NO SPECIAL ROUTINES ARE NEEDED
;AND A SIMPLE BLT BETWEEN INPUT AND OUTPUT BUFFERS IS POSSIBLE

XFRBB:	TLNE	F,L.SCRO!L.SCRI	;IF SCRATCH IN OR OUT,
	JRST	XBBSLO		; CAN NOT USE FAST MODE
	MOVE	A,ITYPEX	;GET INPUT DEVICE TYPE
	CAILE	A,1		;SEE IF -10 DEVICE
	JRST	XBBSLO		;NO--DO IT THE SLOW WAY
	MOVE	A,OTYPEX	;YES--GET OUTPUT TYPE
	CAIGE	A,1		;SEE IF -10 DEVICE
	JRST	XBBFAS		;YES DO IT FAST

;HERE IF MUST DO COPY THE SLOW WAY (ONE WORD AT A TIME)

XBBSLO:	PUSHJ	P,RPB		;SIMPLE BINARY TRANSFER
	  JRST	CLS		;END OF FILE
	PUSHJ	P,PPB		;WRITE
	  JRST	CLS
	JRST	XBBSLO
				CONT.
;THE NEXT CODE IS THE CODE DOING A STRAIGHT FORWARD
;TRANSFER FROM PDP-10 FILE TO PDP-10 FILE
;THE ALGORITHM USED IS:
;	WHILE NO EOF OR ERROR ON CHANNEL INF DO
;		(A:=NUMBER OF WORDS IN INPUT BUFFER
;		WHILE THERE ARE ARE NO OUTPUT ERRORS DO
;		 B:=OUPUT CAPACITY;
;		  BLOCK TRANSFER INPUT DATA TO OUTPUT BUFFER;)
XBBFAS:	SKIPE	A,IHED+2	;NUMBER OF CHARACTERS IN INPUT BUFFER
	JRST	XBBF.1		;STILL DATA THERE
	IN	INF,		;GET A NEW BUFFER
	  JRST	XBBFAS
	STATZ	INF,IO.ERR	;ANY ERRORS?
	  PUSHJ	P,ERR16		;YES REPORT THEM
	STATZ	INF,IO.EOF	;END OF FILE FOUND?
	  JRST	CLS		;YES READY
	JRST	XBBFAS		;LOOP WITH NEW DATA
XBBF.1:	SKIPE	B,OHED+2	;ROOM IN OUTPUT BUFFER
	JRST	XBBF.2		;THEN DO THE BLT
	OUT	OUTF,		;MAKE ROOM
	  JRST	XBBF.1		;SET UP B FOR BLT
	JRST	ERR19		;SORRY
XBBF.2:	CAMLE	A,B		;MOVE THE SMALLEST NUMBER
	MOVE	A,B		;WHICH HAPPENS TO BE IN B
	HRL	B,IHED+1	;SOURCE ADDRESS
	HRR	B,OHED+1	;TARGET ADDRESS -1
	ADD	B,[1,,1]	;GET REAL ADDRESSES
	MOVEI	C,(B)		;FIRST TARGET WORD
	ADDI	C,(A)		;1 TOO FAR!!!!!
	BLT	B,-1(C)		;COMPENSATE BY OFFSET
	ADDM	A,IHED+1	;ACCOUNT IN INPUT HEADER
	ADDM	A,OHED+1	;TO GET THE LAST DATA OUT
	MOVNS	A		;DO ACCOUNTING
	ADDM	A,IHED+2	;UPDATE INPUT HEADER
	ADDM	A,OHED+2	;UPDATE OUTPUT HEADER
	JRST	XBBFAS		;GO FOR MORE
;TRANSFER FROM EXPANDED TO HIGH SEGMENT

XFREH:	MOVEI	CA,.JBDA	;INDICATE LENGTH OF JOB DATA AREA
XEH.1:	PUSHJ	P,@RPC		;SKIP OVER IT
	  JRST	ERR54		;ERROR IF THAT IS ALL
	SOJG	CA,XEH.1	;LOOP
	MOVEI	CA,.JBHGH-.JBDA	;INDICATE START OF HIGH SEG
XEH.2:	PUSHJ	P,@RPC		;GET NEXT WORD OF XPN
	  JRST	ERR54		;ERROR IF EOF
	JUMPN	W,ERR54		;MUST ALL BE 0
	SOJG	CA,XEH.2	;LOOP OVER THE 128K OF ZEROS
	JRST	XFRCE		;THEN WRAP UP WITH SIMPLE COPY

;CONVERT EXE TO XPN FORMAT JUST USE 20 ZEROES INSTEAD OF
;THE SAVE FILE CONTENT

XFRPE:	MOVEI	CA,20		;ALL ZEROES
XFRPE0:	PUSHJ	P,@RPC		;GET A WORD
	 JRST	CLS		;EOF
	SETZ	W,		;A ZERO
	PUSHJ	P,PPB		;WITE IT
	 JRST	CLS		;END IF ERROR
	SOJG	CA,XFRPE0		;ALL FIRST ZERO
	PJRST	XFRCE		;REST IS TANDARD

;CONVERT TO -6 (.DMP) SAVE FILE

XFRED:!
XFRSD:!
XFRPD:!
XFRCD:	MOVEI	CA,JOBSV6	;INDICATE WHERE -6 STARTS
XCD.1:	PUSHJ	P,@RPC		;READ AN EXPANDED WORD
	  JRST	CLS		;GIVE UP!
	SOJGE	CA,XCD.1	;LOOP UNTIL DONE WITH SKIP
				;THEN HANDLE LIKE TO XPN

;CONVERT TO EXPANDED (.XPN) FILE

XFRDE:!
XFRHE:!
XFRSE:!
XFRCE:	PUSHJ	P,@RPC		;READ EXPANDED WORD FROM INPUT
	  JRST	CLS		;CLOSE WHEN DONE
	PUSHJ	P,PPB		;WRITE OUTPUT
	  JRST	CLS		;END IF ERROR
	JRST	XFRCE		;LOOP INDEFINITELY
;TRANSFER TO PROJECT MAC S-BLK FILE

XFRDS:!
XFRPS:!
XFRES:	PUSHJ	P,OUTMRL	;ISSUE BOOTSTRAP
	  JRST	CLS		;CLOSE IF ERROR
	TROA	F,R.SBLK	;INDICATE S-BLK OUTPUT

;TRANSFER TO COMPRESSED (.SAV) FILE

XFRDC:!
XFREC:	TRZ	F,R.SBLK	;INDICATE NOT S-BLK
	MOVEI	CA,20		;EXPANDED TO COMPRESSED
	MOVEM	CA,ICA		;ADDRESS ABOUT TO GET FROM INPUT FILE
XEC.1:	PUSHJ	P,@RPC		;READ EXPANDED FILE
	  JRST	CLS		;ERROR
	SOJG	CA,XEC.1	;DISCARD FIRST 20 LOCS OF EXP FILE
	MOVEI	CA,200		;SET UP XBUF COUNT
	TRNN	F,R.SBLK	;CHECK FOR PROJECT MAC
	ADDI	CA,600		;ITS TOPS-10 SO USE LARGER BUFFER
	MOVEM	CA,CACNT	;AND SET UP OVERFLOW TEST COUNT
	SETZM	ZCOUNT		;CLEAR COUNT OF ZEROS
	SETZB	CA,OCA		;CLEAR OUTPUT POINTERS
	SETZM	SAVSTA		;NO STARTING ADDRESS KNOWN YET
XEC.2:	PUSHJ	P,@RPC		;READ INPUT WORD
	  JRST	XEC.5		;END OF FILE
	JUMPE	W,XEC.3		;ZERO WORD FROM INPUT?
	MOVEM	W,XBUF(CA)	;PUT INTO TRANSFER BUFFER
	ADDI	CA,1		;COUNT SIZE OF XFR BUF
	CAMGE	CA,CACNT	;FULL?
	JRST	XEC.2		;NO.
	PUSHJ	P,XECERR	;YES. OUTPUT THIS BLOCK AS ONE AOBJN WD
	  JRST	CLS		;ERROR
	JRST	XEC.2		;READ SOME MORE.

XEC.3:	JUMPE	CA,XEC.4	;ZERO IN. NEED TO WRITE BLK?
	PUSHJ	P,XECERR	;YES. DO SO.
	  JRST	CLS		;ERROR
XEC.4:	AOS	ZCOUNT		;INCREMENT COUNT OF ZEROS
	AOS	ICA		;COUNT INPUT ADDRESS
	JRST	XEC.2		;AND GO ON.

XEC.5:	JUMPE	CA,XEC.6	;NEED TO OUTPUT A BLOCK?
	PUSHJ	P,XECERR	;YES. DO.
	  JRST	CLS		;ERROR
XEC.6:	SKIPE	W,SAVSTA	;HAS A NON-ZERO START ADR BEEN SEEN?
	TLOA	W,(JRST)	;YES. MAKE A JRST TO IT.
	MOVSI	W,(HALT)	;OUTPUT JRST WORD (NO SA KNOWN)
	PUSHJ	P,PPB		; ..
	  JRST	CLS		;ERROR
	TRZE	F,R.SBLK	;IF S-BLK OUTPUT,
	PUSHJ	P,PPB		;ISSUE AGAIN (NO SYMBOLS)
	  JFCL			;IGNORE ERROR
	JRST	CLS		;END OF FILE
;HERE FOR WARNING MESSAGE THAT THE MONITOR
;MAY NOT BE ABLE TO EXPAND SAVE FILE
;THIS OCCURS WHEN THERE ARE MORE IOWDS THAN
;ZEROS IN THE CORE IMAGE

XECERR:	SOSL	ZCOUNT		;ENOUGH ZEROS?
	JRST	XECOBK		;YES
	HRLOI	W,400000	;NO ERROR
	ANDCAM	W,ZCOUNT	;SET FLAG FOR ONLY ONE MESSAGE
	OUTSTR	[ASCIZ /
%Warning - monitor may not be able to expand .SAV file
%More IOWDs than zeros in core image
/]
	JRST	XECOBK
;ROUTINE TO OUTPUT DATA BLOCK FOR COMPRESSOR ABOVE
;IT HANDLES EITHER -10 COMPRESSED OR MAC S-BLK
;CALLED WITH COUNT IN CA AND START ADDRESS IN ICA
;DATA IS IN XBUF

XECOBK:	MOVE	T,[T,,XBUF]	;GET POINTER TO DATA BLOCK
	MOVEM	T,GETPTR	;AND SET UP THE GET POINTER

;ENTER AT XECOB0 WITH GET PTR INITIALIZED TO A DATA BLOCK

XECOB0:	MOVN	W,CA		;OUTPUT  DATA BLOCK
	HRLZS	W		;MAKE COUNT OF BUFFER
	HRR	W,ICA		;ADDRESS OF BUFFER STARTING IN CORE
	SETZB	T,OCA		;CLEAR COUNT
	TRNE	F,R.SBLK	;IF S-BLK,
	JRST	XECO.2		; GO DO THAT

;HERE TO OUTPUT -10 COMPRESSED IOWD DATA BLOCK

	HRRI	W,-1(W)		;MINUS ONE FOR BLKI PTR
	PUSHJ	P,PPB		;OUTPUT THE POINTER
	  POPJ	P,		;ERROR
XECO.1:	MOVE	W,@GETPTR	;GET A DATA ITEM
	PUSHJ	P,PPB		;OUTPUT IT
	  POPJ	P,		;ERROR
	AOS	T,ICA		;COUNT INPUT ADDRESS
	CAIN	T,.JBSA+1	;IS IT WHERE START ADDR LIVES?
	HRRZM	W,SAVSTA	;YES. SAVE IT.
	AOS	T,OCA		;COUNT AMT OF XBUF WRITTEN
	CAIGE	T,(CA)		;ALL OF IT?
	JRST	XECO.1		;NO.
	JRST	XECO.4		;FINISH UP

;HERE TO OUTPUT PROJECT MAC S-BLK AOBJN BLOCK

XECO.2:	MOVE	CKS,W		;INITIAL CHECKSUM
	PUSHJ	P,PPB		;OUTPUT AOBJN PTR
	  POPJ	P,		;ERROR
XECO.3:	MOVE	W,@GETPTR	;GET DATA
	ROT	CKS,1		;PUT IT IN CKSUM
	ADD	CKS,W		; ..
	PUSHJ	P,PPB		;OUTPUT THE DATUM
	  POPJ	P,		;ERROR
	AOS	ICA		;COUNT TRANSFERRED INPUT WORD
	AOS	T,OCA		;HOW MUCH OF BLOCK XFRD
	CAIGE	T,(CA)		;ALL OF IT?
	JRST	XECO.3		;NOT YET
	MOVE	W,CKS		;OUTPUT THE CHECKSUM
	PUSHJ	P,PPB		; ..
	  POPJ	P,		;ERROR
XECO.4:	MOVEI	CA,0		;YES. CLEAR COUNT OF FILLED BFR
	JRST	CPOPJ1		;OK RETURN.
;ROUTINE TO OUTPUT THE PROJECT MAC S-BLK
;BOOTSTRAP LOADER

OUTMRL:	MOVE	CA,[XWD -MRLL,MRL]	;POINTER TO LOADER
OUTM.1:	MOVE	W,(CA)		;GET A WORD OF IT
	PUSHJ	P,PPB		;OUTPUT IT
	  POPJ	P,		;ERROR
	AOBJN	CA,OUTM.1	;LOOP FOR ALL
	JRST	CPOPJ1		;SUCCESS RETURN

MRL:	DATAI	PTR,4
	JUMPGE	16,16
	DATAI	PTR,5
	JSP	14,30
	DATAI	PTR,6
	DATAI	PTR,0(16)
	DATAI	PTR,7
	ROT	15,1
	DATAI	PTR,10
	ADD	15,0(16)
	DATAI	PTR,11
	AOBJN	16,5
	DATAI	PTR,12
	MOVEI	14,33
	DATAI	PTR,13
	JRST	30
	DATAI	PTR,30
	CONSO	PTR,10
	DATAI	PTR,31
	JRST	30
	DATAI	PTR,32
	JRST	0(14)
	DATAI	PTR,33
	DATAI	PTR,16
	DATAI	PTR,34
	CAMN	15,16
	DATAI	PTR,35
	JUMPA	1
	DATAI	PTR,36
	HALT
	JRST	1
MRLL==.-MRL
;CONVERT COMPRESSED FILE TO S-BLK

XFRCS:	PUSHJ	P,OUTMRL	;OUTPUT MAC RIM LOADER
	  JRST	CLS		;ERROR
XCS.1:	PUSHJ	P,RPB		;GET A POINTER OR JRST WORD
	  JRST	CLS		;EOF
	JUMPGE	W,SCS.3		;JRST WORD
	MOVE	CA,W		;POINTER
	ADDI	W,1		;MAKE AOBJN NOT BLKI
	MOVE	CKS,W		;START CHECKSUM OF THIS BLOCK
	PUSHJ	P,PPB		;OUTPUT POINTER
	  JRST	CLS		;ERROR

XCS.2:	ROT	CKS,1		;CHECKSUM
	PUSHJ	P,RPB		;READ A DATUM FROM TEN FILE
	  JRST	CLS		;BAD END
	ADD	CKS,W		;CHECKSUM
	PUSHJ	P,PPB		;OUTPUT THE WORD TO MAC FILE
	  JRST	CLS		;ERROR
	AOBJN	CA,XCS.2	;LOOP THROUGH AOBJN BLOCK
	MOVE	W,CKS		;END OF BLOCK. OUTPUT CKSUM
	PUSHJ	P,PPB		; ..
	  JRST	CLS
	JRST	XCS.1		;READ NEXT POINTER OR JRST

SCS.3:	PUSHJ	P,PPB		;OUTPUT THE FINAL JRST WORD
	  JRST	CLS
	PUSHJ	P,PPB		;TWICE (NO SYMS)
	  JRST	CLS
	JRST	CLS		;END OF FILE
;CONVERT S-BLK TO COMPRESSED

XFRSC:	SETOM	OCA		;SBLK TO COMPRESSED
	PUSHJ	P,RPB		;SKIP TO CUE WORD
	  JRST	CLS		;ERROR
	CAME	W,[JRST 1]	;CUE?
	JRST	XFRSC		;NOT YET.

XSC.1:	PUSHJ	P,RPB		;GET POINTER OR JRST WORD
	  JRST	CLS		;EOF OR ERROR
	JUMPGE	W,XSC.3		;JRST WORD
	MOVE	CKS,W		;AOBJN BLK. SET UP CKS
	HLL	CA,W		;GET COUNT
	SKIPGE	OCA		;OR IF DATA,
	MOVE	CA,W		;GET COUNT AND ADDR
	SKIPL	OCA		;SYMS OR DATA?
	HRRI	W,(CA)		;SYMS. PUT AFTER DATA.
	HRRI	W,-1(W)		;MAKE BLKI PTR
	PUSHJ	P,PPB		;OUTPUT POINTER
	  JRST	CLS		;ERROR
XSC.2:	PUSHJ	P,RPB		;READ A DATUM
	  JRST	CLS		;ERROR
	ROT	CKS,1		;CHECKSUM IT
	ADD	CKS,W		; ..
	PUSHJ	P,PPB		;OUTPUT IT
	  JRST	CLS		;ERROR
	AOBJN	CA,XSC.2	;COUNT THRU BLK
	PUSHJ	P,RPB		;READ CHECKSUM
	  JRST	CLS		;ERROR
	CAME	W,CKS		;CHECK IT
	PUSHJ	P,CKSERR	;NO GOOD
	JRST	XSC.1		;READ ANOTHER BLK

XSC.3:	AOSG	OCA		;COUNT OUTPUT ADDRESS AS FLAG
	JRST	XSC.1		;JUST FIRST ONE. GO ON
	PUSHJ	P,PPB		;OUTPUT THE JRST WORD AT END
	  JRST	CLS		;ERROR
	JRST	CLS		;END OF FILE
;TRANSFER FROM PROGRAM (.EXE) TO HIGH (.HGH/.SHR & .LOW)
;NOTE THAT THIS ROUTINE IS ENTERRED WITHOUT AN OUTPUT FILE OPEN
;IT WILL SELECT .HGH/.SHR AND .LOW/.SAV AS NEEDED

XFRPC:!
XFRPH:	TLNN	F,L.DSKO!L.DTO!L.SCRO ;MAKE SURE RE-OPENABLE
	JRST	ERR59		;NO--GIVE UP
	MOVSI	CA,-.JBDA	;SKIP JOB DATA
XPH.1:	PUSHJ	P,@RPC		;READ A WORD
	  POPJ	P,		;GIVE UP IF THIS SHORT
	MOVEM	W,XBUF(CA)	;SAVE IN BUFFER
	AOBJN	CA,XPH.1	;LOOP
XPH.2:	PUSHJ	P,@RPC		;READ FIRST USER WORD
	  POPJ	P,		;!
	MOVE	T,RTYP		;GET TYPE
	TXNE	T,PF$HGH	;SEE IF HIGH SEG
	JRST	[MOVEM W,RW	;YES--SAVE WORD
		 JRST  XPH.9]	; AND NO LOW NEEDED
	SKIPN	W		;IF NON-ZERO, THEN NEED LOW
	JRST	XPH.2		;ELSE LOOP UNTIL WE KNOW

;HERE IF .LOW NEEDED
	MOVEM	W,XBUF+.JBDA	;SAVE START OF LOW
	MOVE	T1,PDSCNT	;LOOK AT .EXE DIRECTORY
	LSH	T1,1		;COMPUTE
	ADD	T1,PDSPTR	; LENGTH-1
XPH.3:	MOVE	T,PDS(T1)	;LOOK AT FLAGS
	TXNE	T,PF$HGH	;SEE IF HIGH SEGMENT
	JRST	XPH.3A		;YES--GO ENTER .LOW FIRST
	SOS	T1		;BACK UP TWO WORDS
	SOJGE	T1,XPH.3	; AND LOOP OVER DIRECTORY
	MOVSI	T,'SAV'		;NO HIGH SEG--ENTER .SAV
	PUSHJ	P,VEREXT	;SEE IF THAT WAS WANTED
	JRST	XPH.3B		; AND DO JUST THAT
XPH.3A:	MOVSI	T,'LOW'		;FORCE EXTENSION
XPH.3B:	PUSHJ	P,ENTR		;GO ENTER LOW
	PUSHJ	P,SAVINI	;INITIALIZE COMPRESSED SEGMENT STORAGE
	MOVEI	CA,0		;CLEAR OUTPUT COUNTER
	TRZ	F,R.SBLK	;INDICATE NOT S-BLK
	MOVEI	T,XPHR		;SET SPECIAL ROUTINE
	EXCH	T,RPC		;GET OLD ONE
	MOVEM	T,RPOP		;SAVE FOR LATER
	MOVE	T,RCA		;SAVE READ COUNT
	MOVEM	T,RPOC		; POINT FOR LATER
	MOVE	T,.JB41+XBUF	;MOVE .JB41
	MOVEM	T,.SG41+XBUF	; TO SAVE FILE LOCATION
	MOVE	T,.JBDDT+XBUF	;MOVE .JBDDT
	MOVEM	T,.SGDDT+XBUF	; TO SAVE FILE LOCATION
	SETZM	SAVSTA		;INDICATE START ADDRESS UNKNOWN
	MOVEI	T,104		;START WITH REAL CORE
	MOVEM	T,ICA		; ..
	MOVEM	T,RCA		; ..
				CONT.
;LOOP OVER LOW SEGMENT CREATING COMPRESSED FILE
XPH.4:	PUSHJ	P,@RPC		;READ NEXT WORD
	  JRST	[SETZM RPC	;INDICATE NO HIGH FILE
		 JRST  XPH.7]	; AND FINISH UP LOW
	MOVE	T,RTYP		;GET TYPE
	TXNE	T,PF$HGH	;SEE IF HI SEG YET
	JRST	XPH.7		;YES--GO FINISH LOW
	JUMPE	W,XPH.5		;A ZERO--GO COMPRESS IT
	PUSHJ	P,SAVWRD	;SAVE THE WORD
	 PJRST	SAVCLS		;GIVE UP ERROR
	AOJA	CA,XPH.4	;LOOP
XPH.5:	JUMPE	CA,XPH.6	;JUMP IF STRING OF ZEROS
	PUSHJ	P,SAVOUT	;WITE THE BLOCK
	 PJRST	SAVCLS		;AND CLEAN UP ERROR
XPH.6:	AOS	ICA		;ADVANCE CORE LOC
	JRST	XPH.4		;LOOP

;HERE WHEN HIGH SEG SEEN
XPH.7:	MOVEM	W,RW		;SAVE HI SEG WORD
	JUMPE	CA,XPH.8	;JUMP IF BUFFER EMPTY
	PUSHJ	P,SAVOUT	;WRITE THE LAST BLOCK
	 PJRST	SAVCLS		;OUT LOST
XPH.8:	SKIPE	W,SAVSTA	;GET START ADDRESS
	TLOA	W,(JRST)	;SET--MAKE INTO JRST XXX
	MOVSI	W,(HALT)	;NOT SET--STOP READER
	PUSHJ	P,PPB		;STORE END OF LOW
	 PJRST	SAVCLS		;GIVE UP ERROR
	PUSHJ	P,SAVCLS	;CLOSE COMPRESS STUFF
	SKIPN	RPC		;SEE IF HIGH WANTED
	POPJ	P,		;NO ALL SET
				CONT.
;HERE TO DO HIGH FILE
XPH.9:	MOVE	T1,RTYP		;GET TYPE
	MOVSI	T,'HGH'		;SET NON-SHARABLE
	TXNE	T1,PF$SHR	;IF SHARABLE,
	MOVSI	T,'SHR'		; SET SHARABLE
	PUSHJ	P,VEREXT	;AND VERIFY THE EXTENSION
	PUSHJ	P,ENTR		;FORCE ENTER
	MOVE	W,RW		;RESTORE WORD
	PUSHJ	P,PPB		;OUTPUT IT
	  JFCL
	HRRZ	T1,.JBSA+XBUF	;GET START ADDRESS
	CAIE	T1,400010	;IS THERE ROOM FOR VESTIGIAL DATA?
	JRST	XFRCE		;NO, DO A STRAIGHT COPY
	MOVSI	CA,-2		;FORM LOOP COUNTER
XPH.10:	PUSHJ	P,@RPC		;READ A WORD
	  JRST	CLS		;JUST IN CASE OF EOF
	HRRZ	T1,CA		;GET CURRENT POSITION
	CAIN	T1,1		;IS IT .JBHCR?
	MOVE	W,.JBCOR+XBUF	;YES. COPY .JBCOR FROM LOW PORTION
	PUSHJ	P,PPB		;NOW WRITE THE WORD
	  JRST	CLS		;JUST IN CASE OF AN ERROR
	AOBJN	CA,XPH.10	;LOOP BACK
	JRST	XFRCE		;ALL DONE

;LOCAL ROUTINE TO READ BACK JOBDATA AREA

XPHR:	AOS	W,RCA		;COUNT NEXT LOCATION
	CAMN	W,RPOC		;SEE IF DONE YET
	JRST	XPHR.1		;YES--GO RETURN LAST WORD
	CAILE	W,.JBDA		;NO--SEE IF STILL IN SAVED AREA
	TDZA	W,W		;NO--CLEAR RESULT
	MOVE	W,XBUF-1(W)	;YES--GET IT
	JRST	CPOPJ1		;RETURN VALUE
XPHR.1:	MOVE	W,RPOP		;GET ORIGINAL PC
	MOVEM	W,RPC		;RESTORE IT
	MOVE	W,XBUF+.JBDA	;RESTORE LAST WORD
	JRST	CPOPJ1		;RETURN IT

;VEREXT VERIFY IF THE EXTENSION CHOSEN ON CONVERTING AN EXE FILE
;IS IDENTICAL TO THE ONE EXPLICITLY CHOSEN BY THE USER
;THE EXTENSION CHOSEN IS IN T

VEREXT:	TRNN	F,R.SAVX	;CONVERTING SAVE FILES
	JRST	VEREX0		;NOT WITH /C SWITCH
	SKIPN	CNVWEO		;IF WILD OUT PUT
	CAMN	T,SOEXT		;OR WHAT HE WISHED
	POPJ	P,		;THEN RETURN
	TLNE	F,L.WFO		;IF 2WILD FILE OUTPUT
	POPJ	P,		;THEN IGNORE IT
	MOVE	T1,SOEXT	;EXTENSION TYPED IN
	PJRST	ERR64		;WARN THE USER
VEREX0:	CAME	T,OEXT		;IF DESIRED NAME OR
	TLNE	F,L.WEO		;IF WILD OUTPUT THEN
	POPJ	P,		; JUST RETURN
	MOVE	T1,OEXT		;OUTPUT EXTENSION TYPED
	PJRST	ERR64		;WARN PRESERVES T
;AUXILLARY ROUTINES TO MAKE A COMPRESSED FILE.
;A CORE AREA WILL BE USED TO BUILD COMPRESSED FILES STARTING
;AT SAVFPG AND ENDING AT SAVLPG. THE MAXIMUM LENGTH OF THIS AREA
;CAN BE SAVPMX PAGES.

;SAVINI INTIALIZE COMPRESSED SPACE. CALLED AFTER ALL BUFFERS ARE ALLOCATED

SAVINI:	HRRZ	T,.JBFF		;START OF FREE CORE
	HRLI	T,CA		;GET STORE POINTER
	MOVEM	T,SAVPTR	;FOR BUILDING THE DATA BLOCK
	HRLI	T,T		;GET A GET POINTER
	MOVEM	T,GETPTR	;FOR MAKING THE OUT BLOCK
	ADDI	T,1000*SAVPMN	;MINIMUM AMOUNT
	HRRZM	T,SAVFPG	;END OF FIRST CHUNK
	HRRZM	T,SAVLPG	;IS LAST ONE TOO
	ADDI	T,<SAVPMX-SAVPMN+1>*1000	;LAST ADDRESS +1001
	HRRZM	T,SAVMAX	;SAVE THE BORDER
	HRRZ	T,SAVFPG	;GET THE CORE NECXT
	CORE	T,		;TRY TO GET IT
	 PJRST	ERR65		;YOU LOST
	MOVEI	T,1000*SAVPMN	;AMOUNT OF USABLE WORDS
	MOVEM	T,SAVCNT	;AVAILABLE CAPACITY
	ADDM	T,.JBFF		;UPDATE THE ACCOUNTING
	POPJ	P,

;SAVWRD SAVE A WORD IN THE COMPRESSED FILE

SAVWRD:	SOSLE	SAVCNT		;ANY SPACE
	JRST	SAVWR1		;YES USE IT
	HRRZ	T,.JBFF		;START OF FREE CORE
	CAME	T,SAVLPG	;CONSISTENT
	 PJRST	ERR67		;ERROR FOR MAINTAINER
	ADDI	T,1000		;NEXT CHUNK
	CAME	T,SAVMAX	;PASSING THE BORDER
	CORE	T,
	 JRST	SAVBLK		;GET THIS PIECE OUT
	MOVEI	T,1000		;FREE AMOUNT
	MOVEM	T,SAVCNT	;SORE THAT
	ADDB	T,.JBFF		;REMEMBR IT
	HRRM	T,SAVLPG	;LAST ONE+1
	JRST	SAVWRD		;TRY TO SAVE IT AGAIN
SAVWR1:	MOVEM	W,@SAVPTR	;STORE DATA
	JRST	CPOPJ1		;AND FLAG THE RESULT
SAVBLK:	PUSH	P,W		;SAVE THE DATA
	PUSH	P,CA		;AND OUT ADDRESS
	PUSHJ	P,ERR66		;WARN FOR THE SURPRISE
	POP	P,CA		;GET INDEX BACK
	PUSHJ	P,SAVOUT	;GET THE DATA OUT
	JRST	SAVBL0		;AN ERROR OCCURRED
	POP	P,W		;GET DATA BACK
	JRST	SAVWRD		;AND RETRY
SAVBL0:	POP	P,W		;GET ACC BACK
	POPJ	P,		;AND GIVE ERROR RETURN

SAVCLS:	HRRZ	T,.JBFF		;GET LAST LOCATION
	CAME	T,SAVLPG	;DO WE AGREE
	 PJRST	ERR67		;NO COMPLAIN
	HRRZ	T,SAVPTR	;GET FIRST ADDRESS WE HAD
	HRRM	T,.JBFF		;UPDATE THE WORLD
	CORE	T,
	 JFCL			;DON'T BOTHER
	JRST	CLS

;SAVOUT

SAVOUT:	PUSHJ	P,XECOB0	;WRIT A BLOCK
	 POPJ	P,		;AN ERROR
	HRRZ	T,SAVFPG	;START OF DATA
	HRRM	T,SAVLPG	;UPDATE LAST
	HRRZ	T,SAVPTR	;FIRST LOC
	SUB	T,SAVFPG	;LAST ONE+1
	MOVMM	T,SAVCNT	;# OF FREE WORDS
	HRRZ	T,SAVFPG	;START OF AREA
	HRRZM	T,.JBFF		;REMEMBER THAT WE GAVE CORE BACK
	CORE	T,		;GIVE CORE BACK
	 JFCL
	JRST	CPOPJ1		;OKAY
;TRANSFER FROM HIGH (.HGH/.SHR &.LOW) TO PROGRAM (.EXE)

XFRHP:	TLNN	F,L.DSKI!L.DTI!L.SCRI ;SEE IF CAPABLE OF RANDOM ACCESS
	JRST	ERR60		;NO--NEED RANDOM FILE INPUT
	TLNN	F,L.DSKO	;MUST BE DISK OUTPUT
	JRST	ERR56		;ERROR IF NOT
	MOVSI	CA,-.JBHDA	;LENGTH OF VESTIGIAL JOB DATA AREA
XHP.1:	PUSHJ	P,RPB		;READ VEST. JDA
	  JRST	CLS		;GIVE UP IF INCOMPLETE
	MOVEM	W,RW(CA)	;STORE IN TEMP AREA
	AOBJN	CA,XHP.1	;LOOP
	TLO	F,L.FRCL	;FORCE LOOKUP
	PUSH	P,SRCHP		;SAVE SEARCH POINT
	HLRZ	T,RW+.JBHCR	;GET LENGTH OF NON-ZERO LOW
	CAIGE	T,.JBDA		;IF ONLY IN JOBDAT,
	JRST	XHP.2		; THEN JUST DO HIGH FILE

;HERE IF NEED TO GET LOW FILE
	SETOM	SRCHP		;INITIALIZE FOR LOOP
	PUSH	P,TIEXT		;SAVE TEMP EXT
	MOVSI	T,'LOW'		;INDICATE .LOW
	MOVEM	T,TIEXT		; FOR LOOKUP
	PUSHJ	P,SEL		;SELECT INPUT FILE
	  JRST	ERR61		;ERROR IF MISSING
	PUSH	P,RPC		;SAVE READ ROUTINE
	MOVEI	T,RDWRDC	;SET FOR
	MOVEM	T,RPC		; COMPRESSED FILE READER
	PUSH	P,RCA		;SAVE READ ADDRESS
	SETZM	RCA		;CLEAR FOR LOW FILE
	PUSHJ	P,XFRCP		;CONVERT TO PROG
				; NOTE THAT L.FRCL IS STILL SET
	POP	P,RCA		;RESTORE READ ADDRESS
	POP	P,RPC		;RESTORE HIGH FILE READ ROUTINE
	POP	P,TIEXT		;RESTORE HIGH EXTENSION
	JRST	XHP.4		;GO APPEND HIGH FILE
				CONT.
;HERE WHEN JUST A HIGH SEG--MAKE DUMMY JOB DATA AREA
XHP.2:	SETZM	OCA		;CLEAR OUTPUT ADDRESS
	MOVEI	T,^D512		;SKIP DIRECTORY
	PUSHJ	P,PPBPOS	; PAGE--IT IS FILLED IN LATER
	SETZM	PDSCNT		;CLEAR DIRECTORY COUNTER
	MOVE	T,[PF$WRT!1]	;SET LOW AS PAGE ONE
	MOVEI	T1,0		; AND JUST ONE PAGE
	PUSHJ	P,XEPD		;SET INTO DIRECTORY
	HLRZ	T1,.JBHSA+RW	;GET .JBFF
	LSH	T1,-^D9		;REMOVE OFFSET
	SOJL	T1,XHP.20	;GET REPEAT COUNT -1
	ROT	T1,-9		;MOVE # IN PLACE
	HRRI	T1,1		;START AT PPN 1
	MOVE	T,[PF$WRT]	;UNALLOCATED PAGE
	PUSHJ	P,XEPD		;STORE IN DIRECTORY
XHP.20:	MOVSI	CA,-LXHPT	;POINT FOR JOBDAT SETUP
XHP.3:	HLRZ	T,XHPT(CA)	;GET NEXT JOBDATA LOC
	ADDI	T,^D512		;ALLOW FOR DIRECTORY
	PUSHJ	P,PPBPOS	;SKIP AHEAD TO IT
	HRRE	W,XHPT(CA)	;GET SOURCE
	SKIPL	W		;IF NOT A SPECIAL THEN
	SKIPA	W,RW(W)		;THEN JUST LOAD W
	XCT	XHPT(W)		;ELSE CALL THE SPECIAL CASE
	PUSHJ	P,PPBP		;SET INTO OUTPUT
	AOBJN	CA,XHP.3	;LOOP
	MOVEI	T,^D512*2	;SKIP REST OF PAGE
	PUSHJ	P,PPBPOS	; ..
	JRST	XHP.4		;AND FINISH HIGH SEG

	HRRZ	W,.JBHRN+RW	;-3 GET .JBREN
	HLRZ	W,.JBHSA+RW	;-2 GET .JBFF
	PUSHJ	P,GETHRL	;-1 BUILD .JBHRL
XHPT:	.JB41,,.JBH41
	.JBHRL,,-1		;USE AN EXECUTE
	.JBSA,,.JBHSA
	.JBFF,,-2		;USE AN EXECUTE
	.JBREN,,-3		;USE AN EXECUTE
	.JBCOR,,.JBHCR
	.JBVER,,.JBHVR
LXHPT==.-XHPT

GETHRL:	HLLZ	W,.JBHRN+RW	;GET HIGHSET LOC RELATIVE
	HLRS	W		;COPY IT
	IORI	W,400777	;ADD THE ESSENTIAL BITS
	POPJ	P,
				CONT.
;HERE AFTER DONE WITH LOW--DO HIGH SEG
XHP.4:	SETOM	SRCHP		;INITIALIZE SEARCH AGAIN
	PUSHJ	P,SEL		;RESELECT IT
	  JRST	ERR58		;ERROR IF DISAPPEARED
	POP	P,SRCHP		;RESTORE POINTER FOR WILD-CARDS
	TLZ	F,L.FRCL	;CLEAR SPECIAL INDICATOR
	MOVE	T,OCA		;GET START
	LSH	T,-^D9		;CONVERT TO PAGE
	TXO	T,PF$HGH	;INDICATE HIGH SEG
	HLRZ	T1,TIEXT	;GET HIGH EXT
	CAIN	T1,'SHR'	;IF .SHR
	TXO	T,PF$SHR	; INDICATE SHARABLE
	LDB	T1,[POINT 9,.JBHGA+RW,17]
	SKIPN	T1		;IF START IS NOT SET,
	MOVEI	T1,400		; USE 400K
	PUSH	P,T1		;SAVE
	PUSHJ	P,XEPD		;SET INTO DIRECTORY
	POP	P,CA		;GET BACK HI-SEG PAGE
	LSH	CA,^D9		;CONVERT TO WORDS
XHP.5:	PUSHJ	P,@RPC		;READ WORD
	  JFCL			;(IGNORE EOF)
	SOJG	CA,XHP.5	;SKIP OVER LOW SEG DUMMY
	MOVEI	CA,0		;SET HIGH LENGTH COUNTER
XHP.6:	PUSHJ	P,@RPC		;GET NEXT WORD
	  JRST	XHP.7		;FINISH UP
	PUSHJ	P,PPBP		;WRITE TO OUTPUT
	AOJA	CA,XHP.6	;LOOP
XHP.7:	SOS	CA		;TRUNCATE ONE LESS
	LSH	CA,-^D9		;TRUNCATE TO PAGES REPEATED
	MOVE	T,PDSCNT	;GET DIRECTORY INDEX
	ADDI	T,-2(T)		;COMPUTE LAST ENTRY
	DPB	CA,[POINT 9,PDS+1(T),8]
	JRST	XEPX		;FINISH AND WRITE DIRECTORY
;TRANSFER .DMP TO .EXE

XFRDP:	MOVEI	T,JOBSV6+1	;INDICATE AN EXTRA
	ADDM	T,LENFIL	; LENGTH
	JRST	XFREP		;AND GO HANDLE

;TRANSFER S-BLK TO .EXE
;TRANSFER .SAV TO .EXE
;TRANSFER .XPN TO .EXE

XFRSP:!
XFRCP:	SETZM	LENFIL		;CAN'T PREDICT LENGTH

XFREP:	SETZM	OCA		;CLEAR OUTPUT ADDRESS
	TLNE	F,L.DSKO	;SEE IF DISK OUTPUT
	JRST	XEP.1		;YES--CAN DO IT THE CLEAN WAY
	SKIPE	LENFIL		;IF NO ESTIMATE,
	TLNN	F,L.DSKI	;NO--SEE IF DISK INPUT
	JRST	ERR56		;NO--CAN NOT DO IT!
	MOVE	W,[1776,,3]	;DISK TO NON-DISK, DIRTY ANSWER
	PUSHJ	P,PPBP		;OUTPUT SINGLE POINTER
	MOVE	W,[PF$WRT!1]	;INDICATE ALL IS "LOW"
	PUSHJ	P,PPBP		; STARTING AT NEXT PAGE
	MOVE	W,LENFIL	;GET LENGTH OF INPUT (XPN) FILE
	SUBI	W,^D512-^D511	;ROUND UP AND SUBTRACT 1 PAGE
	LSH	W,-^D9		;MAKE INTO PAGE REPEAT COUNT
	PUSHJ	P,PPBP		; INDICATE STARTS AT PROG PAGE 0
	MOVE	W,[1777,,1]	;INDICATE END OF DIRECTORY
	PUSHJ	P,PPBP		; OF PAGES IN PROGRAM
	MOVEI	T,^D512		;SKIP REST OF THIS PAGE
	PUSHJ	P,PPBPOS	; (DATA IS PAGE ALIGNED)
	JRST	XFRCE		;AND DO A STRAIGHT BINARY COPY
				CONT.
;HERE IF OUTPUT IS DISK, CAN DO AN ELEGANT JOB

XEP.1:	MOVEI	T,^D512		;SKIP ONE PAGE FOR DIRECTORY
	PUSHJ	P,PPBPOS	; (WILL FILL IN CONTENTS AT END)
	SETZM	PDSCNT		;CLEAR DIRECTORY INDEX
	SETZM	EXEFLG		;CLEAR EXE FLAG
	MOVSI	CA,-.JBCOR-1	;SET UP TO READ PART OF JOB DATA AREA
OVER0:	PUSHJ	P,@RPC		;GET A WORD
	 JRST	CLS		;EXIT IF EOF
	MOVEM	W,TBUF(CA)	;STORE IN TBUF
	AOBJN	CA,OVER0	;LOOP
	MOVE	T,.JBCOR+TBUF	;SAVE JOBCOR
	MOVEM	T,SJBCOR	;FOR LATER
	MOVE	T,.SGDDT+TBUF	;RESTORE JOBDDT
	MOVEM	T,.JBDDT+TBUF
	MOVE	T,.SG41+TBUF	;AND JOB41
	MOVEM	T,.JB41+TBUF
	SETZM	CA		;CLEAR INPUT ADDRESS
XEP.2:	MOVEI	CKS,0		;CLEAR "STRING OF ZEROS" COUNTER
XEP.3:	PUSHJ	P,EXREAD	;GET NEXT INPUT WORD
	  JRST	XEP.6		;EOF FINISH IT
	AOS	CA		;COUNT INPUT POSITION
REPEAT 0,<	;NON-VM REQUIRES NO ZERO-COMPRESSOR
	SKIPN	W		;IF ZERO CONTENTS,
	AOJA	CKS,XEP.3	; LOOP COUNTING
	CAIGE	CKS,^D512	;SEE IF AT LEAST A PAGE
	JRST	XEP.4		;NO--CAN'T COMPRESS
	MOVX	T,PF$WRT	;INDICATE LOW SEG
	MOVEI	T1,-^D512(CKS)	;GET REPEAT COUNT (ROUNDED DOWN)
	LSH	T1,-^D9		;ELSE CONVERT TO PAGE REPEAT COUNT
	LSH	T1,^D27		;POSITION RESULT
	MOVE	T2,CA		;GET CURRENT POSITION OF PROGRAM
	SUB	T2,CKS		;COMPUTE START OF ZEROS
	LSH	T2,-^D9		;CONVERT TO PAGES
	IOR	T1,T2		;SET INTO DIRECTORY
	PUSHJ	P,XEPD		;STORE IN DIRECTORY
>;END REPEAT 0
				CONT.
;HERE WHEN A NON-ZERO INPUT
XEP.4:	PUSHJ	P,CHKXPD		;SET INTO DIRECTORY
REPEAT 0,<	;CONTINUATION OF REPEAT 0 ABOVE
	PUSH	P,W		;SAVE THIS WORD
	ANDI	CKS,777		;GET NUMBER OF WORDS 0 IN THIS PAGE
	MOVE	T,OCA		;GET CURRENT OUTPUT ADDRESS
	ADD	T,CKS		;ADVANCE BY RESIDUAL ZEROS
	PUSHJ	P,PPBPOS	;ADVANCE OUTPUT POSITION
	POP	P,W		;RESTORE WORD
>;END OF REPEAT 0
XEP.5:	PUSHJ	P,PPBP		;STORE CURRENT WORD
	MOVE	T,OCA		;GET OUTPUT ADDRESS
	TRNN	T,777		;IF END OF PAGE,
	JRST	XEP.2		; GO LOOK FOR ZEROS AGAIN
	PUSHJ	P,EXREAD	;GET ANOTHER WORD
	  JRST	XEP.6		;CLEAN IT UP
	AOS	CA		;COUNT INPUT WORD
	JRST	XEP.5		;LOOP OVER DATA PAGE

;END OF FILE FOUND FINISH THE LOW SEG

XEP.6:	HRRZ	T1,SJBCOR	;GET SAVED JOBCOR
	ADDI	T1,777		;ROUND UP TO NEXT PAGE
	TRZ	T1,777
	CAMN	T1,CA		;IS THERE MORE TO GO?
	JRST	XEPX		;ALL IS DONE
	SUB	T1,CA		;GET THE DIFFERENCE
XEP.7:	PUSH	P,T1		;SAVE THE COUNTER
	PUSHJ	P,CHKXPD	;CHECK FOR DIRECTORY UPDATE
	SETZ	W,		;GET A ZERO WORD
	PUSHJ	P,PPBP		;AND OUTPUT IT
	AOS	CA		;UPDATE THE ADDESS
	POP	P,T1		;GET COUNT BACK
	SOJG	T1,XEP.7	;AND REDO THE WORK
REPEAT	0,<	;NO VM ALLOWS NO ZERO COMPRESSION
	JUMPE CKS,XEPX	;IF NO ZEROS, THAT'S ALL
	MOVEI T1,-1(CKS) ;ROUND UP AND SUB 1 FOR REPEAT COUNT
	LSH   T1,-^D9	;POSITION AS PAGE REPEATER
	LSH   T1,^D27	;POSITION FOR RESULT
	MOVE  T2,CA	;GET CURRENT POSITION OF PROGRAM
	SUB   T2,CKS	;COMPUTE START OF ZEROS
	LSH   T2,-^D9	;CONVERT TO PAGES
	IOR   T1,T2	;SET INTO DIRECTORY
	PUSHJ P,XEPD	;SET IN PAGE DIRECTORY
	>;END REPEAT 0

;HERE WHEN DONE--NEED TO WRITE DIRECTORY PAGE OUT
XEPX:	MOVE	T,OCA		;GET CURRENT OUTPUT POSITION
	ADDI	T,777		;ROUND UP
	TRZ	T,777		;TO AN EVEN PAGE
	PUSHJ	P,PPBPOS	;POSITION OUTPUT
	TLNE	F,L.FRCL	;IF CONTROLLING OUTPUT,
	POPJ	P,		;WAIT TILL LATER TO FINISH
	OUT	OUTF,		;FLUSH CURRENT OUTPUT
	  SKIPA		;PROCEED IF NO ERROR
	  JRST	ERR19		;GIVE UP IF ERROR
	WAIT	OUTF,		;WAIT FOR OUTPUT TO COMPLETE
	USETO	OUTF,1		;GO TO BEGINING OF FILE
	MOVE	W,PDSCNT	;GET COUNT OF DIRECTORY
	LSH	W,1		;CONVERT TO WORD COUNT
	ADDI	W,1		;ALLOW FOR HEADER WORD
	HRLI	W,1776		;INDICATE PAGE DIRECTORY
	PUSHJ	P,PPBP		;OUTPUT TO FILE
	MOVN	CA,PDSCNT	;GET NEGATIVE COUNT AGAIN
	IMULI	CA,2		;CONVERT TO NEGATIVE WORDS
	HRLZS	CA		;MAKE INTO AOBJN POINTER
XEPX.1:	MOVE	W,PDS(CA)	;GET NEXT WORD
	PUSHJ	P,PPBP		;OUTPUT IT
	AOBJN	CA,XEPX.1	;LOOP OVER PAGE DIRECTORY
	MOVE	W,[1777,,1]	;INDICATE END OF DIRECTORY
	PUSHJ	P,PPBP		;OUTPUT THAT
	JRST	CLS		;AND FINISH FILE


;SUBROUTINE TO READ A WORD FROM AN EXE FILE. IF
; CA IS .LT. .JBCOR, THEN THE WORD IS FETCHED FROM TBUF. OTHERWISE,
; IT IS GOTTEN FROM THE EXE FILE.
EXREAD:	CAILE	CA,.JBCOR	;WITHIN THIS PART OF JOB DATA AREA?
	JRST	@RPC		;NO, DO NORMAL STUFF
	MOVE	W,TBUF(CA)	;GET WORD FROM TBUF
	JRST	CPOPJ1		;SKIP RETURN
;CHKXPD CHECK IF DIRECTORY NEEDS UPDATING

CHKXPD:	MOVE	T,OCA		;GET OUTPUT ADDRESS
	TRNE	T,777		;IF NOT END OF PAGE THEN
	POPJ	P,		;JUST RETURN
	LSH	T,-^D9		;MAKE IT PAGE COUNT
	TXO	T,PF$WRT	;INDICATE LOW SEG
	MOVE	T1,CA		;GET CURRENT ADDRESS
	LSH	T1,-^D9		;CONVERT TO PAGES
	PJRST	XEPD		;UPDATE DIRECTORY

;ROUTINE TO ADD ENTRY TO THE PROGRAM PAGE DIRECTORY
; IT WILL HANDLE REPEATS AND COALESCE POINTERS
;ENTRY IS IN T/T1
;PDSCNT INDEXES THE PDS BLOCK
;USES T2, A, B

XEPD:	SKIPN	T2,PDSCNT	;GET CURRENT COUNT
	JRST	XEPD.1		;NONE--JUST ADD THIS ONE
	ADDI	T2,-2(T2)	;CONVERT TO WORDS
	MOVE	A,T		;GET NEW ENTRY'S FLAGS
	XOR	A,PDS(T2)	;COMPARE WITH LAST ENTRY
	TLNE	A,(777B8)	;SEE IF FLAGS MATCH
	JRST	XEPD.1		;NO--JUST MAKE NEW ENTRY
	LDB	A,[POINT 9,PDS+1(T2),8] ;YES--GET OLD REPEAT
	HRRZ	B,PDS(T2)	;GET OLD FILE PAGE
	JUMPE	B,XEPD.1	;JUMP IF NOT DATA
	ADD	B,A		;INCREMENT TO WHERE IT LEFT OFF
	CAIE	B,-1(T)		;SEE IF WHERE WE ARE STARTING
	JRST	XEPD.1		;NO--ADD NEW ENTRY
	HRRZ	B,PDS+1(T2)	;GET OLD PROGRAM PAGE
	ADD	B,A		;INCREMENT TO WHERE IT LEFT OFF
	CAIE	B,-1(T1)	;SEE IF WHERE WE ARE STARTING
	JRST	XEPD.1		;NO--ADD NEW ENTRY
	LSH	T1,-^D27	;YES--CAN EXPAND IT
	ADDI	A,1(T1)		;REPEAT NEW REPEAT PLUS ONE PAGE
	DPB	A,[POINT 9,PDS+1(T2),8] ;STORE EXPANDED REPEAT
	POPJ	P,		;AND RETURN

XEPD.1:	AOS	T2,PDSCNT	;ADD NEW ENTRY
	CAILE	T2,LN$PDS	;MAKE SURE NO OVERFLOW
	JRST	ERR57		;BAD IF TOO LONG
	ADDI	T2,-2(T2)	;CONVERT TO WORD POINTER
	MOVEM	T,PDS(T2)	;STORE FLAG AND FILE LOC
	MOVEM	T1,PDS+1(T2)	;STORE
	POPJ	P,		;RETURN
	SUBTTL	TRANSFERS FROM NON-36 TO 36-BIT

;FROM 18-BIT (PDP-15) TO 36-BIT

XFRFT:	HLRZ	T,TIEXT		;INPUT EXTENSION OF 15 FILE
	CAIN	T,'ABS'		;DUMP OF CORE?
	JRST	XFRFAB		;YES.
	PUSHJ	P,RPB		;NO. ASSUME IOPS FORMAT
	  JRST	CLS		;EOF?
	LDB	T,[POINT 4,W,17]	;IOPS MODE BYTE
	CAIN	T,2		;IOPS ASCII?
	JRST	XFRFTB		;YES. TEXT HANDLING
	JUMPE	T,XFRFB		;MODE 0 IS IOPS BIN
XFBB.1:	PUSH	P,W		;SAVE 36 BIT WORD
	HLRZS	W		;GET 18 BIT WORD
	PUSHJ	P,PPB		;OUTPUT IT
	  JRST	CLS
	POP	P,W		;GET BACK INPUT WORDS
	HRRZS	W		;SECOND WORD (18 BITS)
	PUSHJ	P,PPB		;SEND IT TOO
	  JRST	CLS
	PUSHJ	P,RPB		;GET SOME MORE
	  JRST	CLS		;EOF
	JRST	XFBB.1		;LOOP

XFRFAB:	PUSHJ	P,RPB		;FOR CORE DUMP, TRANSFER WHOLE THING.
	  JRST	CLS		;END OF FILE
	JRST	XFBB.1		;LOOP

XFRFTB:	SETZM	FITXW1		;FIFTEEN INPUT TEXT WORD
	MOVE	T,[XWD 440700,FITXW1]
	MOVEM	T,FITXP1
XFAB.1:	MOVEM	W,FTEMP		;SAVE INPUT DATA FOR CKSM
	LDB	T,[POINT 8,FTEMP,8]	;GET WORD-PAIR COUNT
	MOVEM	T,FCOUNT	;SAVE IT FOR LOOP CONTROL
	JRST	XFAB.3		;COUNT DOWN THIS HEADER PAIR
XFAB.2:	PUSHJ	P,RPB		;READ A PAIR
	  JRST	XFICLS		;END OF FILE
	MOVEM	W,FITXW2
	MOVE	T,[XWD 440700,FITXW2]
	MOVEM	T,FITXP2
	ILDB	CH,FITXP2
	PUSH	P,CH
	CAIN	CH,12
	SETZM	XFILFQ
	MOVEI	CH,12
	AOSN	XFILFQ
	PUSHJ	P,FIPPA0
	POP	P,CH
	PUSHJ	P,FIPPA0
				CONT.
REPEAT 4,<
		ILDB CH,FITXP2
		PUSHJ P,FIPPA0
>
XFAB.3:	SOSLE	FCOUNT		;DONE?
	JRST	XFAB.2		;NO
	SETOM	XFILFQ		;FLAG PROB WANT LINEFEED NEXT
	PUSHJ	P,RPB		;INPUT PLEASE
	  JRST	XFICLS		;EOF
	TLNN	W,-1		;NON-BLANK?
	JRST	.-3		;BLANK
	SETZM	FIFFLG		;END OF LINE FLAG
	JRST	XFAB.1		;NON-BLANK HEADER. PROCESS IT
FIPPA0:	SKIPE	FIFFLG		;HAS A CR BEEN SEEN
	POPJ	P,		;IN THIS CASE FORGET CHARACTER
	CAIN	CH,15		;SEVEN BITS AND NO PARITY
	SETOM	FIFFLG		;FLAG THE CR CHARACTER

FIPPA:	MOVE	T,FITXP1
	TLNN	T,760000
	PUSHJ	P,FIPPA1
	IDPB	CH,FITXP1
	POPJ	P,

FIPPA1:	MOVE	W,FITXW1
	PUSHJ	P,PPB
	  JRST	CLS
	MOVE	T,[XWD 440700,FITXW1]
	MOVEM	T,FITXP1
	SETZM	FITXW1
	POPJ	P,

XFICLS:	MOVEI	CH,12
	SKIPGE	XFILFQ
	PUSHJ	P,FIPPA
	PUSHJ	P,FIPPA1
	JRST	CLS
XFRFB:	MOVEM	W,FTEMP
	LDB	T,[POINT 8,FTEMP,8]
	MOVEM	T,FCOUNT
	JRST	XFIB.2

XFIB.1:	PUSHJ	P,RPB
	  JRST	CLS
	PUSH	P,W
	HLRZS	W
	PUSHJ	P,PPB
	  JRST	CLS
	POP	P,W
	ANDI	W,-1
	PUSHJ	P,PPB
	  JRST	CLS
XFIB.2:	SOSLE	FCOUNT
	JRST	XFIB.1
	PUSHJ	P,RPB
	  JRST	CLS
	TLNN	W,-1
	JRST	.-3
	JRST	XFRFB
;FROM 16-BIT (PDP-11) TO 36-BIT

XFRVT:	MOVE	T,OSW
	IOR	T,ISW		;SEE IF ANY SWITCHES OF INTEREST
	TRNE	T,SW$I
	JRST	PIVIMG		;TRANSFER 8 BITS PER 36 BIT WORD
	TRNE	T,SW$A		;ASCII?
	JRST	PIVASC		;YES. CONVERT TO PDP10 PACKING ASCII
	TRNE	T,SW$B		;BINARY?
	JRST	PIVBIN		;YES. 32 BITS IN 36 BIT WD
	HLLZ	T,TOEXT		;NO. SEE IF EXT DECLARES BINARY.
	MOVSI	T1,-VBINXL
	CAMN	T,VBINXT(T1)	;CHECK AN EXT
	JRST	PIVBIN		;MATCHES. PROCESS BINARY
	AOBJN	T1,.-2		;LOOP THRU ALL LISTED EXTS
	JRST	PIVASC		;NO. ASSUME IT IS ASCII

VBINXT:	SIXBIT	/BIN/
	SIXBIT	/OBJ/
	SIXBIT	/SYS/
	SIXBIT	/LDA/
	SIXBIT	/LDR/
	SIXBIT	/LOD/
	SIXBIT	/LBO/
	SIXBIT	/MFD/
	SIXBIT	/UFD/
	SIXBIT	/SYM/
VBINXL==.-VBINXT
PIVASC:	SETZM	FITXW1		;ASCII. BORROW PDP FIFTEEN ROUTINE
	MOVE	T,[XWD 440700,FITXW1]
	MOVEM	T,FITXP1
XVAA.1:	PUSHJ	P,RPAVEN	;GET AN EIGHT BIT BYTE
	 JRST PIVAS1		;EOF
	JUMPE	CH,XVAA.1	;SKIP NULLS
	PUSHJ	P,FIPPA		;STASH SEVEN OF THEM
	JRST	XVAA.1

PIVAS1:	PUSHJ	P,FIPPA1	;OUTPUT PARTIAL WD
	JRST	CLS

PIVIMG:	PUSHJ	P,RPAVEN	;GET 8 BITS
	 JRST CLS
	MOVE	W,CH
	PUSHJ	P,PPB		;WRITE IN 36 BIT WD
	  JRST	CLS
	JRST	PIVIMG

PIVBIN:	PUSHJ	P,RPBVEN
	 JRST CLS
	MOVEM	W,FITXW1	;SAVE FIRST 16 BITS
	PUSHJ	P,RPBVEN	;GET SECOND
	  JRST	PIVBIX		;NO SECOND. FILL WITH 0
	HRL	W,FITXW1	;MAKE 32 BIT WORD
	PUSHJ	P,PPB		;COPY 32 OF 36 BITS STRAIGHT FROM TAPE
	  JRST	CLS
	JRST	PIVBIN		;LOOP

PIVBIX:	HRLZ	W,FITXW1	;GET FIRST 16 BITS IN LH
	PUSHJ	P,PPB
	  JRST	CLS
	JRST	CLS		;END OF FILE
	SUBTTL	TRANSFERS FROM 36-BIT TO NON-36

;HERE WHEN OUTPUT IS 18-BIT (PDP-15)

XFRTF:	HLRZ	T,TOEXT		;NO. WHAT KIND OF FILE?
	MOVE	T1,ISW
	IOR	T1,OSW		;GET SWITCHES
	TRNE	T1,SW$A		;A SWITCH OVERRIDES EXT DEFAULT
	JRST	XFRAFA		;YES.
	TRNN	T1,SW$I		;I SWITCH FORCES BINARY TRANSFER
	CAIN	T,'ABS'
	JRST	XFRBFA
	CAIN	T,'BIN'
	JRST	XFRBFB

;HERE TO TRANSFER ASCII TO FIFTEEN ASCII
XFRAFA:	SETZM	FOTXP1		;ASSUME TEXT. CLEAR FOR RPA

XAFA.1:	MOVEI	T,<5*176>	;SET MAX NUMBER CHARACTERS
	MOVEM	T,IOPSOC
	MOVE	T,[POINT 7,IOPSOB+1]
	MOVEM	T,IOPSOP
	SETZM	IOPSOB
	MOVE	T,[XWD IOPSOB,IOPSOB+1]
	BLT	T,IOPSOB+177
XAFA.2:	PUSHJ	P,FORPA
	  JRST	XAFAX
	SOSL	IOPSOC
	IDPB	CH,IOPSOP
	CAIN	CH,15
	JRST	XAFA.3		;TEXT END OF LINE
	JRST	XAFA.2

XAFA.3:	HRRZ	T,IOPSOP
	SUBI	T,IOPSOB-1	;WORDS ACTUALL WRITTEN PLUS HDR
	ANDI	T,377
	LSH	T,11
	MOVEI	T1,2(T)
	HRLZM	T1,IOPSOB
XAFA.4:	LDB	T,[POINT 8,IOPSOB,8]
	MOVEM	T,IOPSOC
	SKIPE	OHED+2		;NEW BLK BEING STARTED?
	CAMG	T,OHED+2	;WILL IT FIT IN CURRENT OUTPUT BLK?
	JRST	XAFA.5		;YES.
	MOVEI	W,0
	PUSHJ	P,PPB
	  JRST	CLS
	JRST	XAFA.4
XAFA.5:	MOVEI	CKS,0
	HLRZ	T1,IOPSOB-1(T)
	HRRZ	T2,IOPSOB-1(T)
	ADD	CKS,T1
	ADD	CKS,T2
	SOJG	T,.-4
	MOVNS	CKS
	HRRM	CKS,IOPSOB
	MOVEI	CKS,0
POFTLL:	MOVE	W,IOPSOB(CKS)
	PUSHJ	P,PPB
	  JRST	CLS
	ADDI	CKS,1
	CAMGE	CKS,IOPSOC
	JRST	POFTLL
	JRST	XAFA.1

FORPA:	MOVE	T,FOTXP1
	TLNN	T,760000
	JRST	FORP.1
	ILDB	CH,FOTXP1
	JUMPE	CH,FORPA
	JRST	CPOPJ1

FORP.1:	MOVE	T,[XWD 440700,FOTXW1]
	MOVEM	T,FOTXP1
	PUSHJ	P,RPB
	  POPJ	P,
	MOVEM	W,FOTXW1
	TRNE	W,1		;LINE-SEQUENCE NUMBER IN ASCII FILE (PDP-10)
	AOSLE	LSNFLG		;YES, WARNED YET?
	JRST	FORPA		;NO LINE-SEQUENCE NUMBER OR ALREADY WARNED
	JRST	ERR49		;NOT WARNED YET, SO DO SO (CLOBBERS AC W)

XAFAX:	MOVE	W,[XWD 001005,776773]
	PUSHJ	P,PPB
	  JRST	CLS
	JRST	CLS
;HERE TO TRANSFER BINARY TO FIFTEEN ABSOLUTE
XFRBFA:	TLZ	F,L.6DO
XBFA.1:	PUSHJ	P,RPB
	  JRST	CLS
	TLCE	F,L.6DO
	JRST	XBFA.3
	HRLZM	W,FOTXW1
	MOVE	T,OHED+2
	CAILE	T,1
	JRST	XBFA.1
	TLZ	F,L.6DO
XBFA.2:	PUSHJ	P,PPB
	  JRST	CLS
	JRST	XBFA.1

XBFA.3:	HLL	W,FOTXW1
	JRST	XBFA.2

;HERE TO TRANSFER BINARY TO FIFTEEN BINARY
XFRBFB:	MOVEI	T,30
	MOVEM	T,IOPSOC
	MOVE	T,[POINT 18,IOPSOB+1]
	MOVEM	T,IOPSOP
	SETZM	IOPSOB
	MOVE	T,[XWD IOPSOB,IOPSOB+1]
	BLT	T,IOPSOB+177
XBFB.1:	PUSHJ	P,RPB
	  JRST	POFBCL
	IDPB	W,IOPSOP
	SOSLE	IOPSOC
	JRST	XBFB.1

	PUSHJ	P,POFEBB
	JRST	XFRBFB

POFBCL:	PUSHJ	P,POFEBB
	MOVE	W,[XWD 001005,776773]
	PUSHJ	P,PPB
	  JRST	CLS
	JRST	CLS
POFEBB:	HRRZ	T,IOPSOP
	SUBI	T,IOPSOB-1
	ANDI	T,377
	LSH	T,11
	HRLZM	T,IOPSOB
	MOVEI	CKS,0
POFE.1:	LDB	T,[POINT 8,IOPSOB,8]
	MOVEM	T,IOPSOC
	SKIPE	OHED+2
	CAMG	T,OHED+2
	JRST	POFE.2
	MOVEI	W,0
	PUSHJ	P,PPB
	  JRST	CLS
	JRST	POFE.1

POFE.2:	MOVEI	CKS,0
	HLRZ	T1,IOPSOB-1(T)
	HRRZ	T2,IOPSOB-1(T)
	ADD	CKS,T1
	ADD	CKS,T2
	SOJG	T,.-4
	MOVNS	CKS
	HRRM	CKS,IOPSOB
	MOVEI	CKS,0
POFE.3:	MOVE	W,IOPSOB(CKS)
	PUSHJ	P,PPB
	  JRST	CLS
	ADDI	CKS,1
	CAMGE	CKS,IOPSOC
	JRST	POFE.3
	POPJ	P,
;HERE WHEN OUTPUT TAPE IS PDP ELEVEN STYLE. INPUT MAY BE TOO?

XFRTV:	HLLZ	T,TOEXT		;NO. INPUT IS 36 BIT. WHAT KIND OF FILE?
	MOVE	T1,ISW		;GET SWITCHES FOR INPUT
	IOR	T1,OSW		;AND OUTPUT
	TRNE	T1,SW$A		;ASCII SPECIFIED?
	JRST	XFRAVA		;YES.
	TRNE	T1,SW$I		;IMAGE (8 BIT) SPECIFIED?
	JRST	XFRBVI		;YES.
	TRNE	T1,SW$B		;BINARY?
	JRST	XFRBVB		;YES.
	MOVSI	T1,-VBINXL	;SEE IF EXT FORCES BINARY TRANSFER
	CAMN	T,VBINXT(T1)
	JRST	XFRBVB		;YES
	AOBJN	T1,.-2		;LOOP
				;NO. ASSUME ASCII IF NO SWITCH OR SPECIAL EXT
XFRAVA:	SETZM	FOTXP1		;CLEAR POINTER FOR FIRST BYTE
XAVA.1:	PUSHJ	P,FORPA		;READ FROM 36 BIT WORD INTO CH
	  JRST	CLS		;END OF FILE
	PUSHJ	P,PPBVEN	;OUTPUT TO ELEVEN, FROM CH
	  JRST	CLS		;ERROR ON OUTPUT. CLOSE FILE.
	JRST	XAVA.1		;LOOP TILL EOF

XFRVV:	PUSHJ	P,RPBVEN	;GET 16 BITS
	  JRST	CLS		;EOF
	MOVEM	W,FITXW1	;SAVE IT
	PUSHJ	P,RPBVEN	;GET 16 MORE BITS
	  JRST	XVV.1		;END OF FILE
	HRL	W,FITXW1	;MAKE 32 BITS
	PUSHJ	P,PROVBR	;OUTPUT 32 BITS
	JRST	XFRVV		;LOOP

XVV.1:	MOVE	W,FITXW1	;GET THE 16 BITS
	MOVEM	W,FOTXW1	;STORE IT
	PUSHJ	P,PROVBZ	;OUTPUT WITH 16 ZEROES AFTER THEM
	JRST	CLS		;AND CLOSE THE FILE
XFRBVI:	PUSHJ	P,RPB		;GET 36 BITS
	  JRST	CLS		;END OF FILE
	MOVE	CH,W		;OUTPUT THEM
	ANDI	CH,377		;JUST EIGHT BITS OF THE WORD
	PUSHJ	P,PPBVEN	;OUTPUT THEM
	  JRST	CLS		;ERROR
	JRST	XFRBVI		;LOOP UNTIL EOF

XFRBVB:	PUSHJ	P,RPB		;READ 36 BITS
	  JRST	CLS		;END OF FILE
	PUSHJ	P,PROVBR	;OUTPUT 32 BITS
	JRST	XFRBVB		;LOOP

PROVBR:	MOVEM	W,FOTXW1	;STORE 32 BITS
	LDB	CH,[POINT 8,FOTXW1,17]
	PUSHJ	P,PPBVEN	;OUTPUT FIRST 8
	  JRST	CLS		;ERROR ON OUTPUT. CLOSE FILE.
	LDB	CH,[POINT 8,FOTXW1,9]
	PUSHJ	P,PPBVEN	;OUTPUT SECOND 8
	  JRST	CLS		;ERROR ON OUTPUT. CLOSE FILE.
PROVBZ:	LDB	CH,[POINT 8,FOTXW1,35]
	PUSHJ	P,PPBVEN	;THIRD EIGHT
	  JRST	CLS		;ERROR ON OUTPUT. CLOSE FILE.
	LDB	CH,[POINT 8,FOTXW1,27]
	PUSHJ	P,PPBVEN	;FOURTH EIGHT
	  JRST	CLS		;ERROR ON OUTPUT. CLOSE FILE.
	POPJ	P,		;RETURN FROM 32 BIT HANDLING SUBR
	SUBTTL	DIRECTORY LISTER

;ROUTINE TO SELECT DEVICE (DECTAPE) TYPE
;CALL WITH T CONTAINING SWITCHES AND T1 NE 0 IF DECTAPE
;RETURNS T1 WITH TYPE INDEX AND T UNCHANGED

SELDTT:	TRNN	T,SW$SCR	;UNLESS SCRATCH FILE
	JUMPE	T1,CPOPJ	; IF NOT DEC-TAPE, RETURN NDT (=0)
	MOVEI	T1,TYPTEN	;DEFAULT IS -10
	TRNE	T,SW$M		;IF PROJECT MAC,
	MOVEI	T1,TYPMAC	; INDICATE THAT
	TRNE	T,SW$O		;IFOLD -6 FORMAT,
	MOVEI	T1,TYPSIX	; INDICATE THAT
	TRNE	T,SW$F		;IF FIFTEEN,
	MOVEI	T1,TYPFIF	; INDICATE THAT
	TRNE	T,SW$V		;IF ELEVEN,
	MOVEI	T1,TYPVEN	; INDICATE THAT
	POPJ	P,		;RETURN TYPE OF DECTAPE


;ROUTINE TO HANDLE DIRECTORY LISTING

DIR:	PUSHJ	P,CRLF
	PUSHJ	P,CRLF		;SPACE TO DIRECTORY ON PAPER
	MOVE	T,ITYPEX	;GET INPUT TYPE
	JRST	@DIRRT(T)	;GO TO LISTER

DIRRT:	DIRTEN		;NON-DECTAPE (MUST BE NON-SCRATCH -10)
	DIRTEN		;TEN
	DIRSIX		;SIX
	DIRMAC		;MAC
	DIRFIF		;FIFTEEN
	DIRVEN		;ELEVEN
;PDP-10 FORMAT DTA DIRECTORY LISTER

DIRTEN:	SKIPE	T,DIRECT+177	;ANY TAPE ID?
	CAMN	T,[-1]		;YES--IS IT MEANINGFUL?
	JRST	DIRTN1		;NO
	MOVEI	W,[ASCIZ /Tape Id: /]
	PUSHJ	P,MSG
	PUSHJ	P,SIXCR		;OUTPUT IT, WITH CRLF

DIRTN1:	MOVEI	W,[ASCIZ /free: /]
	PUSHJ	P,MSG
	MOVEI	C,0		;LOOK FOR BLOCKS IN FILE 0
	PUSHJ	P,BLKC10	;COUNT, 10 FORMAT, ANS IN T
	PUSHJ	P,DECPRT	;OUTPUT BLOCKS
	MOVEI	W,[ASCIZ / blks, /]
	PUSHJ	P,MSG
	MOVEI	T,0		;COUNT FILES FREE. CLEAR ANSWER
	MOVEI	T1,26		;LENGTH OF DIRECTORY FILE SPACE
	SKIPN	DIRECT+122(T1)	;THIS ONE BUSY?
	ADDI	T,1		;NO. COUNT FREE FILE
	SOJG	T1,.-2		;LOOP FOR ALL FILE SLOTS
	PUSHJ	P,DECPRT	;NOW OUTPUT ANSWER
	MOVEI	W,[ASCIZ / files
/]
	PUSHJ	P,MSG		;FINISH LINE.
	MOVEI	C,1		;NOW TYPE ALL FILENAMES ETC
DIRTNL:	SKIPN	T,DIRECT+122(C)	;THIS FILE EXIST?
	JRST	DIRTNN		;NO. SKIP IT
	PUSHJ	P,SIXTAB	;YES. TYPE NAME.
	HLLZ	T,DIRECT+150(C)	;GET EXTENSION
	PUSHJ	P,SIXTAB	;OUTPUT DIRECTORY EXTENSION
	PUSHJ	P,BLKC10	;COUNT BLOCKS IN THIS FILE
	PUSHJ	P,DECPR2	;OUTPUT ANSWER
	PUSHJ	P,TAB		;TAB TO DATE COLUMN
	PUSHJ	P,SLTDAT	;GET DATE IN REG T (CLOBBERS T1)
	MOVEI	A,(T)
	PUSHJ	P,DATOUT	;OUTPUT DATE
	PUSHJ	P,CRLF		;AND RETURN
DIRTNN:	CAIGE	C,26		;DONE ALL FILES?
	AOJA	C,DIRTNL	;NO. DO ANOTHER.
	PJRST	CRLF		;EXTRA LINE AT END
;OLD PDP6 FORMAT TAPE DIRECTORY LISTER

DIRSIX:	HLRZ	T,DIRECT	;GET LAST BLOCK USED
	MOVNS	T
	ADDI	T,LASTOB	;COMPUTE FREE
	PUSHJ	P,DECPRT	;OUTPUT FREE BLKS
	MOVEI	W,[ASCIZ /. Free blocks
/]
	PUSHJ	P,MSG		;OUTPUT HEADER LINE
	HRRZ	C,DIRECT	;START OF FOUR WORD BLOCKS
DIRSXL:	JUMPE	C,DIRSXE	;CHECK RANGE ON INDEX
	CAIL	C,175		; ..
	JRST	DIRSXE		; ..
	SKIPN	T,DIRECT(C)	;GET FILE NAME, IF ANY
	JRST	DIRSXX		;NONE. END OF DIRECTORY
	PUSHJ	P,SIXTAB	;OUTPUTNAME
	HLLZ	T,DIRECT+1(C)	;GET EXTENSION
	PUSHJ	P,SIXTAB	;OUTPUT EXTENSION
	LDB	A,[POINT 15,DIRECT+2(C),35]	;GET PDP-6 DATE
	PUSHJ	P,DATOUT	;OUTPUT DATE
	PUSHJ	P,CRLF		;END OF LINE
	ADDI	C,4		;STEP TO NEXT NAME
	CAIGE	C,200		;END OF DIRECTORY?
	JRST	DIRSXL		;NO. ONWARD.
DIRSXX:	PUSHJ	P,CRLF		;END OF DIRECTORY
	PJRST	CRLF		;SPACE UP AND RETURN

DIRSXE:	MOVEI	W,[ASCIZ /? Bad format in PDP6 directory
/]
	PJRST	MSG		;OUTPUT AND RETURN
;PROJECT MAC DIRECTORY LISTER

DIRMAC:	HRRZ	T,DIRECT+177	;GET TAPE ID IF ANY
	JUMPE	T,DIRMC1	;SKIP THIS IF NONE
	MOVEI	W,[ASCIZ /Tape Id: /]
	PUSHJ	P,MSG
	HRLZ	T,DIRECT+177	;GET THE ID
	PUSHJ	P,SIXCR		;OUTPUT IT WITH CRLF
DIRMC1:	MOVEI	W,[ASCIZ /free: /]
	PUSHJ	P,MSG
	MOVEI	C,0		;COUNT BLOCKS IN FILE 0
	PUSHJ	P,BLKCMC	;IN MAC FILE DIR
	PUSHJ	P,DECPRT	;PRINT ANSWER
	MOVEI	W,[ASCIZ / blks, /]
	PUSHJ	P,MSG		;MORE HEADER
	MOVEI	T,0		;CLEAR COUNT OF FREE FILES
	MOVEI	T1,27*2		;LENGTH OF DIR NAME AREA
DIRM1L:	SKIPN	DIRECT-2(T1)	;THIS FILE IN USE?
	SKIPE	DIRECT-1(T1)	; ..
	SKIPA			;YES
	ADDI	T,1		;NO. COUNT IT.
	SUBI	T1,2		;CHECK NEXT ONE
	JUMPG	T1,DIRM1L	;LOOP IF MORE
	PUSHJ	P,DECPRT	;OUTPUT TOTAL
	MOVEI	W,[ASCIZ / files
/]
	PUSHJ	P,MSG
	MOVEI	C,1		;SET TO LIST FILE NAMES
DIRMCL:	LSH	C,1		;CHANGE INDEX TO OFFSET
	MOVE	T,DIRECT-2(C)	;GET NAME
	TLNN	T,-1		;NAME IN USE?
	JRST	DIRMCN		;NO. SKIP IT.
	PUSHJ	P,SIXTAB	;OUTPUT IT AND A TAB
	MOVE	T,DIRECT-1(C)	;AND THE EXTENSION
	PUSHJ	P,SIXTAB	;OUTPUT IT.
	LSH	C,-1		;CONVERT BACK TO FILE NUMBER FOR BLK CT
				CONT.
	PUSHJ	P,BLKCMC	;COUNT BLOCKS IN THIS FILE
	PUSH	P,C		;SAVE CURRENT FILE NUMBER OVER EXTS
	PUSH	P,T		;SAVE CURRENT COUNT
DIRMCC:	MOVEI	T1,27*2		;PREPARE TO COUNT THROUGH FILENAMES
DIRML2:	CAMN	C,DIRECT-1(T1)	;IS THIS THE EXTENSION OF PREV FILE?
	SKIPE	DIRECT-2(T1)	; ..
	SKIPA			;NO
	JRST	DIRMCA		;YES. GO COUNT ITS BLOCKS
	SUBI	T1,2		;COUNT TO NEXT FILENAME
	JUMPG	T1,DIRML2	;LOOP IF MORE
	JRST	DIRMCB		;NO MORE CONTINUATIONS

DIRMCA:	MOVE	C,T1		;CONTINUE FILE OFFSET
	LSH	C,-1		;CONTINUE FILE NUMBER
	PUSHJ	P,BLKCMC	;HOW MANY BLKS IN CONTINUATION FILE?
	ADDM	T,(P)		;ADD TO COUNT
	JRST	DIRMCC		;AND SEE IF IT TURNS AROUND AGAIN

DIRMCB:	POP	P,T		;RESTORE TOTAL FOR FILE AND CONTS
	POP	P,C		;AND FILE NUMBER
	PUSHJ	P,DECPR2	;OUTPUT NUMBER OF BLOCKS
	PUSHJ	P,CRLF		;OUTPUT END OF LINE
DIRMN1:	CAIGE	C,27		;COMPLETED ALL FILES?
	AOJA	C,DIRMCL	;NO. BACK FOR NEXT
	PUSHJ	P,CRLF		;YES. EOL.
	PJRST	CRLF		; ..

DIRMCN:	LSH	C,-1
	JRST	DIRMN1		;CONTINUE WITH FILE NUMBER
BLKCMC:	MOVE	B,[POINT 5,DIRECT+56]	;BYTES IN MAC FILE DIR
	MOVEI	T1,1067		;HOW FAR TO COUNT
	JRST	BLKCNT		;GO COUNT THEM

BLKC10:	MOVE	B,[POINT 5,DIRECT]	;BYTES IN DEC FILE DIR
	MOVEI	T1,LASTOB	;HOW MANY TO COUNT
BLKCNT:	MOVEI	T,0		;INITIALIZE COUNT
BLKCL:	ILDB	A,B		;GET A BYTE
	CAIN	A,(C)		;IS THIS BYTE IN THE DESIRED FILE?
	ADDI	T,1		;YES. COUNT IT.
	SOJG	T1,BLKCL	;LOOP TO NEXT BYTE
	POPJ	P,		;RETURN ANSWER IN T
;PDP15 DIRECTORY LISTER

DIRFIF:	MOVEI	W,[ASCIZ /Directory listing
/]
	PUSHJ	P,MSG
	MOVE	A,[POINT 1,DIRECT]
	MOVEI	T,0
	MOVEI	B,1100
	ILDB	C,A
	SKIPN	C
	ADDI	T,1
	SOJG	B,.-3
	PUSHJ	P,OCTP4S	;FREE BLOCKS
	MOVEI	W,[ASCIZ / free blks
/]
	PUSHJ	P,MSG
	SETZB	C,T
DIRFL2:	MOVE	T1,DIRECT+21(C)	;GET A FILE USE BIT
	TRNE	T1,400000	;BIT ON?
	ADDI	T,1		;YES. COUNT FILE IN USE
	ADDI	C,2		;LOOK AT NEXT FILE
	CAIGE	C,160
	JRST	DIRFL2
	PUSHJ	P,OCTP4S	;OUTPUT NUMBER OF FILES
	MOVEI	W,[ASCIZ / user files
/]
	PUSHJ	P,MSG
	SETZB	C,TBBLK
				CONT.
DIRFL:	SKIPN	T,DIRECT+20(C)
	JRST	DIRFX
	PUSHJ	P,TRMSIX	;CONVERT TO SIXBIT
	PUSHJ	P,SIXTAB
	HLLZ	T,DIRECT+21(C)
	PUSHJ	P,TRMSIX	;CONVERT TO SIXBIT
	PUSHJ	P,SIXTAB
	LDB	T,[POINT 10,DIRECT+21(C),35]
	PUSHJ	P,OCTP4S	;FIRST BLOCK OF FILE
	PUSHJ	P,SPACE		;MOVE OVER
	MOVE	T,C
	LSH	T,-4		;FIND BIT MAP
	ADDI	T,71
	CAMN	T,TBBLK		;READ IT ALREADY?
	JRST	DIRFL4		;YES
	MOVEM	T,TBBLK		;NO. UPDATE TO THIS BLK
	PUSHJ	P,READBT	;GET TAPE BLOCK
DIRFL4:	MOVE	T1,C
	ANDI	T1,16
	LSH	T1,3		;WORDS WITHIN BLK FOR MAP
	ADDI	T1,TBUF		;IN THE BUFFER
	HRLI	T1,440100
	MOVEI	N,1100
	MOVEI	T,0
DIRFL3:	ILDB	T2,T1
	SKIPE	T2
	ADDI	T,1		;COUNT BLOCK IN USE
	SOJG	N,DIRFL3
	PUSHJ	P,OCTP4S	;OUTPUT TOTAL THIS FILE
	PUSHJ	P,CRLF
DIRFX:	ADDI	C,2
	CAIGE	C,160
	JRST	DIRFL
	PJRST	CRLF
;PDP-11 DIRECTORY LISTER

DIRVEN:	MOVEI	W,[ASCIZ /
directory  [/]
	PUSHJ	P,MSG
	LDB	T,[POINT 8,VENPPI,27]
	PUSHJ	P,OCTPRT
	PUSHJ	P,COMMA
	LDB	T,[POINT 8,VENPPI,35]
	PUSHJ	P,OCTPRT
	MOVEI	W,[ASCIZ /]

/]
	PUSHJ	P,MSG
	SETZM	VENFBN		;BORROW CELL AS COUNTER OF FREE FILES
DIRVL2:	MOVEI	C,0		;START OF DIRECTORY BLOCK
DIRVL1:	MOVEI	T,0		;GET FIRST HALF OF NAME
	PUSHJ	P,GTVDWD	;GET THE WORD
	SKIPN	T		;BLANK?
	AOS	VENFBN		;YES. COUNT AS A FREE FILE
	JUMPE	T,DIRVNN	;IF BLANKS, SKIP FILE
	PUSHJ	P,R5VOUT	;PRINT IT
	MOVEI	T,1		;SECOND HALF OF NAME
	PUSHJ	P,GTVDWD	;GET THE WORD
	PUSHJ	P,R5VOUT	;PRINT IT
	PUSHJ	P,DOT		;SEPARATOR
	MOVEI	T,2		;EXTENSION
	PUSHJ	P,GTVDWD	;GET THE WORD
	PUSHJ	P,R5VOUT	;PRINT IT
	MOVEI	T,0		;CODE FOR THREE SPACES
	PUSHJ	P,R5VOUT
	MOVEI	T,6		;GET SIZE OF FILE
	PUSHJ	P,GTVDWD	; ..
	PUSHJ	P,DECP3S	;PRINT IT RIGHT ADJ IN 3 SPACES
	MOVEI	T,3
	PUSHJ	P,GTVDWD	;GET THE DATE
	MOVEI	CH," "		;ASSUME LINKED FILE
	TRZE	T,100000	;IS IT A CONTIGUOUS ONE
	MOVEI	CH,"C"		;YES
	PUSHJ	P,TYO		;INDICATE CONTIGUOUS OR LINKED
	PUSHJ	P,SPACE2	;GIVE TWO SPACES
	PUSHJ	P,VENDAT	;PRINT IT
	PUSHJ	P,SPACE2
	MOVEI	T,10		;GET THE PRIV WORD
	PUSHJ	P,GTVDWD
	ANDI	T,777
	PUSHJ	P,PROOUT	;PRINT IN ANGLES
	PUSHJ	P,CRLF
				CONT.
DIRVNN:	MOVE	T,VWPEI		;SEE IF NEXT FILE EXISTS
	ADDI	C,(T)
	MOVE	T1,C
	ADDI	T1,(T)
	CAIGE	T1,377		;OFF END OF BLK?
	JRST	DIRVL1		;NO. PRINT SOME MORE
	HLRZ	T,DIRECT	;YES. SEE IF A LINK
	JUMPE	T,DIRVNY	;IF NONE, PRINT SUMMARY
	MOVEM	T,DIRBKN	;SAVE AS DIRECTORY BLOCK NUMBER
	PUSHJ	P,RBTDIR	;READ THE BLK
	  JRST	ERR2		;OOPS - ERROR ON DIRECTORY
	JRST	DIRVL2

DIRVNY:	MSG$ <
free blks:  >
	MOVE	T,PBMBKI
	PUSHJ	P,READBT
	  JRST	ERR2
	MOVEI	T1,TBUF+2
	MOVEI	T,0
	MOVEI	N,1100
	MOVSI	T2,400000
DIRVL3:	JUMPN	T2,DIRVY2
	MOVSI	T2,400000
	ADDI	T1,1
DIRVY2:	TDNN	T2,[XWD 600000,600000]
	JRST	DIRVY1
	LSH	T2,-1
	JRST	DIRVL3
DIRVY1:	TDNN	T2,(T1)
	ADDI	T,1
	LSH	T2,-1
	SOJG	N,DIRVL3
	PUSHJ	P,DECP4S
	MSG$ <
free files: >
	MOVE	T,VENFBN
	PUSHJ	P,DECP4S
	PJRST	CRLF2
;TWO SUBRS TO GET WORD FROM PDP11 DIRECTORY.
;CALL WITH INDECES IN T AND C SUCH THAT ADDING THEM GIVES NUMBER OF
;PDP11 WORDS INTO DESIRED DIRECTORY.
GTVODW:	MOVEI	T1,1(T)
	ADDI	T1,(C)
	ROT	T1,-1
	MOVE	T,ODIREC(T1)
	SKIPL	T1
	MOVS	T,ODIREC(T1)
	ANDI	T,177777
	POPJ	P,

GTVDWD:	MOVEI	T1,1(T)
	ADDI	T1,(C)
	ROT	T1,-1
	MOVE	T,DIRECT(T1)
	SKIPL	T1
	MOVS	T,DIRECT(T1)
	ANDI	T,177777
	POPJ	P,
	SUBTTL	ZERO OUTPUT TAPE ROUTINES

ZER:	MOVE	T,OTYPEX	;GET OUTPUT TYPE
	JRST	@ZERRT(T)	;GO TO CORRECT ROUTINE

ZERRT:	ZERTEN		;NOT DECTAPE (MUST BE NON-SCRATCH -10)
	ZERTEN		;TEN
	ZERSIX		;SIX
	ZERMAC		;MAC
	ZERFIF		;FIFTEEN
	ZERVEN		;ELEVEN

;ROUTINE TO ZERO TEN DECTAPE

ZERTEN:	HRROI	T,144		;READ BLOCK ^O144--IGNORE ERRORS
	PUSHJ	P,INOUTD	; INTO DIRECTORY AREA
	SETZM	ODIREC		;CLEAR THE DIRECTORY
	MOVE	T,[XWD ODIREC,ODIREC+1]
	BLT	T,ODIREC+176	;EXCEPT LAST WORD
	SKIPE	T,OTID		;ANY REQUESTED ID?
	MOVEM	T,ODIREC+177	;YES. STORE IT.
	MOVSI	T,(<36B4!36B9>)
	MOVEM	T,ODIREC	;ALLOCATE BLKS 1 AND 2
	MOVSI	T,(36B9)
	MOVEM	T,ODIREC+16	;AND 144
	HRLOI	T,7		;AND 1102 ON
	MOVEM	T,ODIREC+122	; ..
	MOVEI	T,144		;PDP10 DIRECTORY BLOCK
OUTZX:	TLNE	F,L.SCRO	;SCRATCH FILE?
	JRST	OUTZY		;YES.
	USETO	OUTF,(T)	;SELECT DIRECTORY BLOCK
	OUT	OUTF,ODIIOW	;WRITE DIRECTORY OUT
	  POPJ	P,
	  JRST	ERR10		;YES.

OUTZY:	USETO	SCOF,1(T)	;SET TO WRITE DIR BLK
	OUT	SCOF,ODIIOW	;WRITE IT
	  POPJ	P,
	  JRST	ERR29		;YES.

;ROUTINE TO ZERO SIX DECTAPE

ZERSIX:	MOVE	T,[XWD 1,5]	;SIX DIRECTORY. CLEAR IT IN CORE
	MOVEM	T,ODIREC	;INITIAL WORD OF 6 DIRECTORY
	SETZM	ODIREC+1	;CLEAR REST OF DIRECTORY AREA
	MOVE	T,[XWD ODIREC+1,ODIREC+2]
	BLT	T,ODIREC+177	; ..
	MOVEI	T,1		;PDP6 DIRECTORY BLOCK NUMBER
	JRST	OUTZX		;CHECK FOR ERRORS
;ROUTINE TO ZERO ELEVEN DECTAPE

ZERVEN:	SKIPN	OPPN		;OUTPUT PPN SPECIFIED?
	JRST	ZERV.1		;NO.
	HRRZ	T1,OPPN		;CHECK IT FOR RANGE
	CAIE	T1,0
	CAILE	T1,377
	JRST	ERR37		;NO GOOD
	HLRZ	T,OPPN
	CAIE	T,0
	CAILE	T,377
	JRST	ERR37
ZERV.1:	PUSHJ	P,CLRWBF	;HAVE TO CLEAR FILE BIT MAPS
	MOVEI	T,70
	MOVEM	T,OBLK		;THEY START HERE
ZERV.2:	PUSHJ	P,PPBBLK	;CLEAR ONE
	AOS	T,OBLK
	CAIGE	T,100		;UP TO DATA?
	JRST	ZERV.2		;NO. CLEAR SOME MORE
	MOVE	T,[XWD 101,4]	;LINK,INTERLEAVE FACTOR
	MOVEM	T,WBUF		; TO OUTPUT BUFFER
	MOVE	T,[XWD 104,104]	;FIRST PBM,LAST PBM
	MOVEM	T,WBUF+1
	PUSHJ	P,PPBBLK
	AOS	OBLK		;BLK 101
	SKIPN	OPPN		;OUTPUT PPN SPECIFIED?
	JRST	ZERV.3		;NO. DEFAULT TO 1,1
	HLRZ	T,OPPN
	LSH	T,10		;OK PUT IN LEFT BYTE
	TROA	T,(T1)		;AND RIGHT BYTE
ZERV.3:	MOVEI	T,401		;XWD MFD LINK,USER IDENT CODE (PPN) 1,1
	MOVEM	T,WBUF
	MOVE	T,[XWD 102,11]	;FIRST BLK OF UFD, WDS PER ENTRY IN UFD
	MOVEM	T,WBUF+1
	PUSHJ	P,PPBBLK	;WRITE BLK 101
	MOVEI	T,104		;NEXT BLK TO WRITE
	MOVEM	T,OBLK
	MOVE	T,[XWD DAT104,WBUF]
	BLT	T,WBUF+4	;COPY IN THE PBM'S INITIAL STATE
	MOVE	T,[XWD 177777,177777]
	MOVEM	T,WBUF+24	;THIS SEEMS TO BE IN REST OF BLK
	MOVE	T,[XWD WBUF+24,WBUF+25]
	BLT	T,WBUF+177	; ...
	PUSHJ	P,PPBBLK	;WRITE PBM
	PUSHJ	P,CLRWBF	;ZEROS IN WBUF
	SOS	OBLK		;BLK 103
	PUSHJ	P,PPBBLK	;CLEAR BLK 103 (2ND BLK OF UFD)
	MOVSI	T,103		;UFD LINK FOR BLK 102 TO 103
	MOVEM	T,ODIREC	;INTO OUTPUT DIRECTORY IMAGE
	SETZM	ODIREC+1	;CLEAR THE REST OF IT
	MOVE	T,[XWD ODIREC+1,ODIREC+2]
	BLT	T,ODIREC+177
	MOVEI	T,102		;WHERE OUTPUT DIRECTORY GOES
	JRST	OUTZX		;GO WRITE IT.
DAT104:	XWD	0,1		;LINK,NUMBER OF PBM
	XWD	44,104		;WDS/MAP,1ST MAP BLK
	XWD	1,0		;BLKS 17-0,37-20
	XWD	0,177400	;BLKS 57-40,77-60
	XWD	37,0		;BLKS 117-100,137-120

;ROUTINE TO ZERO PROJECT MAC DECTAPE

ZERMAC:	HRROI	T,100		;READ BLOCK ^O100--IGNORE ERRORS
	PUSHJ	P,INOUTD	; INTO DIRECTORY AREA
	SETZM	ODIREC		;FIRST CLEAR EVERYTHING
	MOVE	T,[XWD ODIREC,ODIREC+1]
	BLT	T,ODIREC+176	;CLEAR ALL BUT TAPE ID
	HRROS	ODIREC+177	;ALLOCATE BLK 1070 ON
	SKIPE	T,OTID		;REQUESTED TAPE ID?
	HLROM	T,ODIREC+177	;YES. STORE IT.
	MOVSI	T,(<36B4!36B9>)	;ALLOCATE BLOCKS 1 AND 2 AS BOOTSTRAP
	MOVEM	T,ODIREC+56	; ..
	MOVSI	T,(<33B4>)	;ALLOCATE BLOCK 100 AS DIRECTORY
	MOVEM	T,ODIREC+67	; ..
	MOVEI	T,100		;BLOCK TO WRITE IT BACK OUT ON
	JRST	OUTZX

;ROUTINE TO ZERO FIFTEEN DECTAPE

ZERFIF:	PUSHJ	P,CLRWBF	;CLEAR WBUF FOR BIT MAP BLOCKS
	MOVEI	T,71		;FIRST MAP BLK
	MOVEM	T,OBLK		; WHERE PPBBLK WANTS IT
ZERF.1:	PUSHJ	P,PPBBLK	;CLEAR A BIT MAP BLOCK
	AOS	T,OBLK		;NEXT BLOCK
	CAIGE	T,100		;TO DIRECTORY?
	JRST	ZERF.1		;NO. CLEAR ANOTHER
	SETZM	ODIREC		;NOW THE DIRECTORY ITSELF
	MOVE	T,[XWD ODIREC,ODIREC+1]	; ..
	BLT	T,ODIREC+177	;CLEAR IT.
	MOVEI	T,077600	;ALLOCATE THE DIRECTORY BLKS, 71-100
	MOVEM	T,ODIREC+1	; ..
	MOVEI	T,100		;BLOCK NUMBER TO WRITE IT IN
	JRST	OUTZX		;GO WRITE IT OUT
	SUBTTL	SELECT (LOOKUP) FILE

SELFST:	SETZM	ODATE		;CLEAR OUTPUT DATE
	SETZM	VIPRT		;CLEAR OUTPUT PROTECTION
	MOVE	T,ITYPEX	;GET INPUT TYPE
	TRNE	F,R.SAVX	;CONVERTING A SAVE FILE
	CAIL	T,NO10XF	;AND NO A PDP-10 FILE
	JRST	@SELRT(T)	;THEN GO TO SELECTION ROUTINE
	MOVE	T1,EXTPTR	;GET OUR EXTENSION POINTER
	JRST	SEL2		;AND TRY TO CONVRT
SEL0:	MOVE	T1,EXTPTR	;GET POINTER
	AOBJN	T1,SEL1		;AND UPDATE IT
	JRST	SELFF		;THEN OBVIOUSLY A FAILLURE
SEL1:	MOVEM	T1,EXTPTR	;AND STORE THE POINTER
SEL2:	MOVE	T1,EXTLST(T1)	;GET THE EXTENSION
	MOVEM	T1,IEXT		;AND TRY THIS ONE
	MOVE	T,ITYPEX	;GET INPUT TYPE
	PUSHJ	P,@SELRT(T)	;TRY TO FIND THE FILE
	JRST	SEL3		;RESELECT
	HRRZ	T,EXTPTR	;GET INPUT EXTENSION
	MOVSI	T1,(SIXBIT /SHR/) ;ONE OF THE MANY
	CAIE	T,EXEIDX	;IF EXE THEN READY
	MOVSI	T1,(SIXBIT /EXE/) ;ELSE USE EXE
	MOVEM	T1,TOEXT	;AS AN OUTPUT EXTENSION
	SKIPE	CNVWEO		;IF NO WILD OUT EXT
	SKIPN	CNVSME		;OR ON THE SAME DEVICE THEN
	JRST	CPOPJ1		;PROCES THE FILE
	HRRZ	T1,EXTPTR	;GET THE POINTER
	CAIL	T1,DEFIDX	;IF DEFAULT INPUT OR
	TLNN	F,L.WFO		;WILD OUTPUT
	JRST	CPOPJ1		;THEN PROCES
	MOVEI	A,.IOBIN	;THE MODE USED
	SKIPN	B,ODEV		;GET OUTPUT DEVICE
	MOVSI	B,(SIXBIT /DSK/) ;ELSE DISK
	MOVSI	C,OHED		;USE THIS HAEDER
	OPEN	OUTF,A		;TRY TO OPEN IT
	 JRST	ERR14		;BAD DEVICE
	MOVE	A,TIFILE	;GET FILE NAME
	MOVE	T1,[-3,,SAVIDX]	;LIST OF HIGHER UPS IN LIST
SEL20:	SETZB	C,D		;LAST 2 ARUGMENT
	MOVE	B,EXTLST(T1)	;AND EXTENSION
	LOOKUP	OUTF,A		;SSE IF IT IS THERE
	 AOBJN	T1,SEL20	;NO TRY NEXT ONE
	RELEASE	OUTF,		;RELAESE IT
	JUMPG	T1,CPOPJ1	;OKAY TO MAKE IT
	TLNE	F,L.WFO!L.BFO	;WILD OUTPUT
	JRST	SEL2		;THEN CONTINUE SCAN
	JRST	SEL0		;ELSE NEXT EXTENSION
SEL3:	SETOM	SRCHP		;THEN RESET DIRECTOTY SCANNER
	JRST	SEL0		;NEXT ONES
;TABLES USED TO CONVERT COMMANDS OF THE TYPE:
; ODEV:OFILE.OEXT=IDEV.IFILE/C
;WITH 10 DEVICES AND OEXT A SAVE EXTENSION OF SOME KIND

EXTLST:	SIXBIT	/LOW/		;THIS IS CLASS OLD SAVE

SAVIDX=.-EXTLST			;START OF SHR HGH & EXE EXTENSIONS
	SIXBIT	/SHR/		;1...SHR NEXT
	SIXBIT	/HGH/		;2...HGH
	SIXBIT	/SAV/		;3...SAV
DEFIDX=.-EXTLST		;END OF DEFAULT EXTENSIONS
EXEIDX=.-EXTLST			;INDEX OF EXE EXTENSION
	SIXBIT	/EXE/		;4 ...EXE
EXTLEN=.-EXTLST


SELRT:	SELNDT		;NON-DECTAPE
	SELTEN		;TEN
NO10XF=.-SELRT
	SELSIX		;SIX
	SELMAC		;MAC
	SELFIF		;FIFTEEN
	SELVEN		;ELEVEN


SEL:	SETZM	ODATE		;CLEAR OUTPUT DATE
	SETZM	VIPRT		;CLEAR OUT PRODUCTION
	MOVE	T,ITYPEX	;GET INPUT TYPE
	JRST	@SELRT(T)	;SELECT THE FILE
;ROUTINE TO SELECT FROM PROJECT MAC DECTAPE

SELMAC:	SKIPGE	C,SRCHP		;MAC. GET DIRECTORY INDEX
	MOVEI	C,0		;NONE YET
	JRST	SELM.2		;ON TO NEXT ONE

SELM.1:	MOVE	A,DIRECT-2(C)	;GET A FILENAME
	MOVE	B,DIRECT-1(C)	;AND EXTENSION
	TLNN	A,-1		;FILE IN USE?
	JRST	SELM.2		;NO. ON TO NEXT ONE
	CAME	A,IFILE		;THIS THE ONE DESIRED?
	TLNE	F,L.WFI		;OR IS IT WILD?
	SKIPA			;YES. WANT THIS.
	JRST	SELM.2		;NO. ON TO NEXT ONE.
	CAME	B,IEXT		;IF THE EXTENSION IS RIGHT, THAT IS.
	TLNE	F,L.WEI		;OR IT'S WILD
	JRST	SELM.3		;GOOD MATCH.
SELM.2:	ADDI	C,2		;ON TO NEXT FILE
	CAIGE	C,60		;LOOKED AT THEM ALL?
	JRST	SELM.1		;NO. TRY NEXT ONE.
	JRST	SELFF		;YES. FAILURE ON THIS LOOKUP

SELM.3:	MOVEM	C,SRCHP		;SAVE SEARCH POINTER IN CASE OF STAR
	MOVEM	C,SRCHPM	;AND FOR EXTENSIONS
	JRST	SELFW		;GIVE SUCCESS RETURN.
;ROUTINE TO SELECT FROM SIX DECTAPE

SELSIX:	SKIPL	C,SRCHP		;GET OFFSET INTO SIX DIRECTORY
	JRST	SELS.1		; OK. USE IT.
	HRRZ	C,DIRECT+0	;NONE YET. GET STARTER FROM DIRECTORY
	JRST	SELS.2		;DONT INCREMENT IT
SELS.1:	ADDI	C,4		;NEXT FILE PLEASE
SELS.2:	CAILE	C,174		;STILL ON THE TAPE?
	JRST	SELFF		;NO. FAILURE.
	MOVE	A,DIRECT(C)	;YES. GET FILENAME
	JUMPE	A,SELFF		;JUMP IF END OF DIRECTORY
	HLLZ	B,DIRECT+1(C)	;AND EXTENSION FROM THE DIRECTORY
	HLLZ	D,IEXT		;JUST HALF INPUT EXT WORD
	CAME	A,IFILE		;NAME MATCH?
	TLNE	F,L.WFI		;OR WILD?
	SKIPA			;YES. CHECK EXT
	JRST	SELS.3		;NO. ON TO NEXT.
	CAME	B,D		;EXTENSION MATCH?
	TLNE	F,L.WEI		;OR WILD?
	JRST	SELS.4		;YES. USE THIS FILE
SELS.3:	JRST	SELS.1		;NO. ON TO NEXT FILE IN DIR

SELS.4:	MOVEM	C,SRCHP		;SAVE THIS POSITION IN DIR
	LDB	T,[POINT 15,DIRECT+2(C),35]	;GET DATE FROM DIR
	MOVEM	T,ODATE		;SAVE FOR OUTPUT DATE
	TRZ	F,R.6DI		;ASSUME NOT A DUMP FILE
	SKIPGE	T,DIRECT+3(C)	;IS IT A DUMP FILE?
	TRO	F,R.6DI		;YES. SET FLAG
	HLRES	T		;SAVE LENGTH FROM WORD 3
	MOVNM	T,IHED+0	; ..
	JRST	SELFW		; AND GO TO SELECT FILE WIN
SELTEN:	SKIPGE	C,SRCHP		;POINTER INTO TEN DIRECTORY
	MOVEI	C,0		;FIRST TIME IN
	JRST	SELT.2		;ON TO NEXT FILE
SELT.1:	MOVE	A,DIRECT+122(C)	;GET FILE NAME FROM DTA
	JUMPE	A,SELT.2	;SKIP EMPTY SLOTS
	HLLZ	B,DIRECT+150(C)	;AND EXTENSION FROM DTA DIR
	TLNE	F,L.FRCL	;SEE IF FORCING
	JRST	[CAMN A,TIFILE	;YES--SEE IF FILE MATCHES
		 CAME B,TIEXT	; AND IF EXTENSION MATCHES
		 JRST SELT.2	;NO--LOOP ONWARDS
		 JRST SELT.3]	;YES--ACCEPT THIS FILE
	HLLZ	D,IEXT		;HALFWORD REQUESTED EXT
	CAME	A,IFILE		;DOES NAME MATCH?
	TLNE	F,L.WFI		;OR IS IT WILD?
	SKIPA			;YES. CHECK EXT
	JRST	SELT.2		;NO MATCH.
	CAME	B,D		;EXTENSIONS MATCH?
	TLNE	F,L.WEI		;OR WILD CARD?
	JRST	SELT.3		;MATCH.
SELT.2:	CAIGE	C,26		;CHECKED THE WHOLE DIR?
	AOJA	C,SELT.1	;NO. TRY ANOTHER
	JRST	SELFF		;YES. NOT THERE. GO TO FAIL

SELT.3:	MOVEM	C,SRCHP		;SAVE CURRENT INDEX
	PUSHJ	P,SLTDAT	;GET DATE IN REG T (CLOBBERS T1)
	MOVEM	T,ODATE		;SAVE IT
	JRST	SELFW		;AND GO TO WIN

	;ROUTINE TO GET 15 BIT FILE DATE FROM DECTAPE DIRECTORY
	;AT LOCATION DIRECT.
	;CLOBBERS REGS T AND T1
	;CALLING SEQUENCE
	;	MOVEI	C,FILE SLOT NUMBER (DECIMAL 1 THROUGH 22)
	;	PUSHJ	P,SLTDAT

SLTDAT:	LDB	T,[POINT 12,DIRECT+150(C),35]	;GET LOW ORDER PART
	MOVEI	T1,1		;SET UP TO GET HIGH-ORDER PART
	TDNE	T1,DIRECT-1(C)	;IS BIT SET?
	TRO	T,1B23		;YES, OR BIT INTO DATE
	TDNE	T1,DIRECT+^D21(C)
	TRO	T,1B22
	TDNE	T1,DIRECT+^D43(C)
	TRO	T,1B21
	POPJ	P,		;RETURN
SELFIF:	SKIPGE	C,SRCHP		;FILE INDEX
	MOVEI	C,16		;FIRST TIME THRU
	JRST	SELF.2		;GO LOOP

SELF.1:	MOVE	T,DIRECT(C)	;GET FILE ENTRY
	JUMPE	T,SELF.2	;IF EMPTY, SKIP IT
	PUSHJ	P,TRMSIX	;GET CORRECTED SIXBIT
	MOVE	A,T		;TO RIGHT AC
	HLLZ	T,DIRECT+1(C)
	PUSHJ	P,TRMSIX	;TO SIXBIT
	HLLZ	B,T		;TO COMPARISON AC
	HLLZ	D,IEXT		;REQUESTED EXTENSION
	CAME	A,IFILE		;MATCH?
	TLNE	F,L.WFI		;OR WILD?
	SKIPA			;YES. MATCH
	JRST	SELF.2
	CAME	B,D		;EXT MATCH TOO?
	TLNE	F,L.WEI		;OR WILD?
	JRST	SELF.3		;YES.
SELF.2:	CAIL	C,176
	JRST	SELFF		;FAIL
	ADDI	C,2
	JRST	SELF.1		;TRY ANOTHER

SELF.3:	MOVEM	C,SRCHP		;FOUND ONE. SAVE INDEX
	SETZM	ODATE		;NO DATE IN FIFTEEN DTA DIRECTORY
	JRST	SELFW		;TO WIN EXIT
SELVEN:	SKIPGE	C,SRCHP		;STARTED?
	MOVEI	C,0		;NO
	JRST	SELV.2		;NEXT FILE PLEASE
SELV.1:	PUSHJ	P,SELVR		;READ FILE NAME AND EXT FOR THIS INDEX
	MOVE	A,VIFFIL	;GET FILE NAME
	JUMPE	A,SELV.2	;NONE, SKIP IT
	HLLZ	B,VIFEXT	;GET EXTENSION
	HLLZ	D,IEXT		;AND REQUESTED ONE
	CAME	A,IFILE		;MATCH ON FILE NAME?
	TLNE	F,L.WFI		;OR WILD?
	SKIPA			;OK. CHECK EXT
	JRST	SELV.2		;NO GOOD. MOVE ON
	CAME	B,D
	TLNE	F,L.WEI		;EXTENSION MATCH OR WILD?
	JRST	SELV.3		;YES. FULL MATCH
SELV.2:	CAIGE	C,^D56		;END TEST (SHOULD COMPUTE IT)
	AOJA	C,SELV.1	;MOVE ON
	JRST	SELFF		;FAIL RETURN FROM SELFIL

SELV.3:	MOVEM	C,SRCHP		;STORE INDEX OF DESIRED FILE
	SETZM	RPAVC1		;START IN PHASE FOR RPAVEN ROUTINE
	MOVE	T,IDATE		;GET INPUT DATE
	MOVEM	T,ODATE		;COPY FOR OUTPUT
	JRST	SELFW		;SELECT FILE WIN



;ROUTINE TO READ AND CONVERT NEXT FILE NAME AND EXT

SELVR:	PUSH	P,C		;SAVE INDEX
	MOVE	T,VWPEI		;CONVERT TO INDEX OFFSET IN ELEVEN WORDS
	IMULI	T,(C)		;SEE IF OFF END OF BLK 1
	CAIL	T,377		; ..
	JRST	SVR1		;YES. TRY BLK 2
	SUB	T,VWPEI		;IN BLK 1. RESET TO INDEX
	PUSH	P,T		;SAVE OFFSET INTO DIR BLK
	MOVE	T,VDIRB1	;ARE WE IN BLK 1 AT THE MOMENT?
SVR3:	CAMN	T,DIRBKN	;IS THIS BLK IN DIRECT BUFFER
	JRST	SVR2		;YES.
	MOVEM	T,DIRBKN	;NO. MUST READ
	PUSHJ	P,RBTDIR	;READ THE BLK TO TBUF AND DIRECT
	  JRST	ERR2		;ERROR ON DIRECTORY READ
				CONT.
SVR2:	MOVEI	C,0		;PREVENT OFFSET IN GTVDWD ROUTINE
	MOVE	T,(P)		;GET INDEX IN ELEVEN WORDS
	PUSHJ	P,GTVDWD	;GET THE WORD
	PUSHJ	P,R5VSIX	;MAKE SIXBIT
	HRLM	T,VIFFIL	;HALF THE NAME
	AOS	T,(P)		;SECOND ELEVEN WORD
	PUSHJ	P,GTVDWD	; GET IT
	PUSHJ	P,R5VSIX	;CONVERT TO SIXBIT
	HRRM	T,VIFFIL	;SAVE IT
	AOS	T,(P)		;AND THE EXTENSION
	PUSHJ	P,GTVDWD	;GET WORD
	PUSHJ	P,R5VSIX	;CONVERT TO SIXBIT
	HRLZM	T,VIFEXT	;STORE IN EXT WORD
	AOS	T,(P)		;AND DATE
	PUSHJ	P,GTVDWD	; ..
	SETZM	VCONTG		;ASSUME FILE IS NOT CONTIGUOUS
	TRZE	T,100000	;BEFORE MAKING THE TEST
	SETOM	VCONTG		;FLAG THAT FILE IS CONTIGUOUS
	PUSHJ	P,DATVT		;CONVERT TO TEN FORMAT DATE
	MOVEM	T,IDATE		;SAVE IT FOR LATER
	POP	P,T		;REMOVE INDEX FROM STACK
	ADDI	T,2		;GET FIRST BLOCK NUMBER
	PUSH	P,T		;SAVE INDEX IN UFD
	PUSHJ	P,GTVDWD	;FROM DIR
	MOVEM	T,VENFBN	;SAVE IN CASE WANT TO READ THIS
	AOS	T,(P)		;SKIP LENGTH
	AOS	T,(P)		;SKIP TO LAST BLOCK #
	SKIPN	VCONTG		;NOW CHECK THE CONTIGUITY FLAG
	JRST	NOTCON		;NO A LINKED FILE
	PUSHJ	P,GTVDWD	;GET THE LAST BLOCK #
	MOVEM	T,VCONTG	;AND REPLACE TEMP FLAG
NOTCON:	POP	P,T		;GET # BACK
	ADDI	T,1		;AND SKIP TO PROTECTION
	PUSHJ	P,GTVDWD	;AND GET IT
	ANDI	T,377		;MASK OUT SPARE BITS
	MOVEM	T,VIPRT		;AND SAVE IT
	POP	P,C		;GET THE FILE NUMBER
	POPJ	P,		;AND RETURN

SVR1:	MOVEI	T,377
	IDIV	T,VWPEI		;SEE HOW MANY FILES PER DIR BLK
	MOVNS	T
	ADD	T,(P)		;INDEX IN FILES INTO SECOND DIR BLK
	IMUL	T,VWPEI		;TOO BIG FOR BLK 2?
	CAIL	T,377		; ..
	JRST	ERR38		;YES
	SUB	T,VWPEI		;NO. RESTORE WORD OFFSET INTO T
	PUSH	P,T		;STACK IT
	MOVE	T,VDIRB2	;SECOND BLOCK OF UFD DATA
	JRST	SVR3		;GO READ IT.
;ROUTINE TO SELECT FILE FROM NON-DECTAPE

SELNDT:	TLNE	F,L.FRCL	;SEE IF FORCING
	JRST	[MOVE A,TIFILE	;YES--GET FILE NAME
		 MOVE B,TIEXT	; AND EXTENSION
		 JRST SELFW]	;DECLARE A WIN
	TLNE	F,L.DSKI	;NON TAPE. DISK?
	TLNN	F,L.WFI!L.WEI	;YES. NEED TO SEARCH DISK DIRECTORY?
	JRST	SELFNW		;NO. LOOKUP WHAT WE GOT.
	AOSE	SRCHP		;STARTING DISK DIRECTORY SEARCH THIS PASS?
	JRST	SELFD1		;NO. MOVE ON.
	MOVEI	B,0		;MAY NEED TO FIDDLE UP SYS PPN
	MOVE	A,IDEV		;GET INPUT DEVICE
	SETZB	B,C		;CLEAR ANSWER AREA
	MOVE	T,[3,,A]	;POINT TO AREA
	PATH.	T,		;INQUIRE IF ERSATZ
	  JFCL			; !!
	TXNE	B,PT.IPP	;IF IGNORE PPN,
	MOVEM	C,IPPN		; OVERRIDE WHAT USER TYPED
	MOVEI	A,.IOBIN	;HAVE TO READ DISK DIRECTORY
	SKIPN	B,IDEV		;LET'S MAKE SURE THERE'S SOMETHING THERE
	MOVSI	B,'DSK'		;DEFAULT TO DSK IF NOTHING INPUT
	MOVEI	C,UHED		; ..
	OPEN	UFDF,A		; ..
	  JRST	ERR12		; NO DISK??
	SKIPN	A,IPPN		;IS THE PROJPROG SPECIFIED?
	JRST	[MOVE  A,[LN$PPN,,IPPN+1] ;NO--GET DEFAULT
		 MOVEM B,IPPN+1	; FOR THIS DEVICE
		 PATH. A,	; FROM MONITOR
		   JRST [MOVE A,B ;NO PATH.--USE
			 DEVPPN A, ; OLD CHEAP UUO
			   MOVE A,MYPPN ; OR STANDARD CODE
			 JRST .+1] ;AND FINISH
		 TLZ   A,-1	;CLEAR JUNK FROM POINTER
		 JRST  .+1]	;AND FINISH
	MOVSI	B,'UFD'		;AND UFD EXTENSION
	SETZB	C,T
	MOVE	D,MFDPPN	;IN THE MASTER FILE DIR
	TLNE	A,-1		;PATH?
	JRST	SELN.1		;NO--OK TO PROCEED
	SKIPN	.PTPPN+1(A)	;YES--SEE IF REALLY NEEDED
	JRST	[MOVE A,.PTPPN(A) ;NO--GET UFD
		 JRST SELN.1]	; AND PROCEED ANY WAY
	MOVE	D,A		;YES--SET DIRECTORY TO PATH
	SKIPE	.PTPPN(A)	;LOOK AT PATH FOR END
	AOJA	A,.-1		;LOOP UNTIL END
	MOVE	T,A		;SAVE POINTER TO END
	MOVE	A,.PTPPN-1(A)	;GET BOTTOM DIRECTORY AS FILE
	SETZM	.PTPPN-1(T)	;CLEAR FROM PATH LIST
	SKIPN	.PTPPN+1(D)	;IF ONLY UFD LEFT,
	MOVE	D,.PTPPN(D)	; USE THAT
	MOVSI	B,'SFD'		;USE .SFD
				CONT.
SELN.1:	LOOKUP	UFDF,A		;TRY TO READ THE DISK DIRECTORY
	  JRST	ERR12		;CANT READ IT.
	SKIPE	T		;IF CLEARED IN PATH,
	MOVEM	A,.PTPPN-1(T)	; RESTORE WHAT WE ZAPPED
	INBUF	UFDF,1		;ALLOCATE A BUFFER
	MOVE	T,.JBFF		;AND UPDATE FREE CORE FOR FILE
	MOVEM	T,SJFF2		; ..
SELFD1:	PUSHJ	P,URPB		;READ A WORD FROM DISK DIRECTORY
	  JRST	SELFF		;END OF FILE. NOT THERE.
	MOVE	A,W		;GET THE NAME
	PUSHJ	P,URPB		;READ THE EXTENSION
	  JRST	SELFF		;SHOULDNT QUIT HERE
	JUMPE	A,SELFD1	;COULD BE OVER A BLOCK. SKIP 0'S
	HLLZ	B,W		;GET THE EXTENSION
	HLLZ	D,IEXT		;GET REQUESTED EXT
	CAME	A,IFILE		;FILE NAME MATCH?
	TLNE	F,L.WFI		;OR WILD CARD?
	SKIPA			;OK SO FAR
	JRST	SELFD1		;NO GOOD. MOVE ON
	CAME	B,[SIXBIT /TMP/]	;DSK FILE A .TMP?
	JRST	SELFD2		;NO.
	TLNE	F,L.WEI		;YES. ARE WE DOING .* FILES?
	JRST	SELFD1		;YES. .TMP'S ARE NOT INCLUDED
				;UNLESS STATED EXPLICITLY.
SELFD2:	CAME	B,D		;EXTENSION MATCH?
	TLNE	F,L.WEI		;OR WILD CARD?
	JRST	SELFW		;MATCH ON EXT TOO
	JRST	SELFD1		;NO MATCH. LOOP

;SUBSIDIARY ROUTINE TO READ THE DISK DIRECTORY

URPB:	SOSLE	UHED+2		;ANY IN THIS BUFFER?
	JRST	URPB.1		;YES.
	IN	UFDF,		;NO. GET ANOTHER BUFFER
	  JRST	URPB.1		;JUMP IF OK
	STATZ	UFDF,IO.ERR	;ERRORS?
	  JRST	ERR13		;YES.
	POPJ	P,		;YES. QUIT.
URPB.1:	ILDB	W,UHED+1	;OK. GET A WORD
	JRST	CPOPJ1		;AND RETURN IT
;FINISH UP WITH A WINNER

SELFNW:	MOVE	A,IFILE		;HERE WHEN NEITHER WILD NOR DTA
	HLLZ	B,IEXT		;GET FILE AND EXT
SELFW:	MOVEM	A,TIFILE	;STORE IN TEMPS
	MOVEM	B,TIEXT		; ..
	MOVE	T,SJFF2		;SET UP BUFFER AREA FOR FILE
	MOVEM	T,.JBFF		; ..
	MOVEM	T,SJFF3		;FOR BUFFERED OUTPUTS, AND
	MOVEM	T,SJFF4		; FOR RPBSCR RTN IN CASE NO BUF OUT
	TLNN	F,L.WFO!L.BFO	;SPECIFIED OUTPUT FILE?
	MOVE	A,OFILE		;YES. GET IT.
	SKIPN	A		;IF NO FILE AT ALL,
	MOVE	A,IDEV		;GET INPUT DEVICE NAME FOR FILENAME
	MOVEM	A,TOFILE	;STORE RESULT AWAY FOR ENTER
	TLNN	F,L.WEO!L.BEO	;SPECIFIED OUTPUT EXT?
	MOVE	B,OEXT		;YES. GET IT.
	MOVEM	B,TOEXT		;STORE IT AWAY FOR ENTER
	SETOM	IBLK		;CLEAR FLAGS FOR READ AND COPY ROUTINES
	SETZM	IHED+2		;SINCE THIS IS A NEW FILE
	TRZ	F,R.ABC		;FIND OUT ABOUT BAD CKSM
	TLNE	F,L.SCRI	;ON SCRATCH FILE?
	JRST	SELW.4		;NO LOOKUP NEEDED
	MOVE	T,ITYPEX	;NOT SCRATCH. WHAT TYPE IS IT?
	CAIE	T,TYPMAC	;MAC AND SIX DONT NEED LOOKUP
	CAIN	T,TYPSIX	; ..
	JRST	SELW.4		; ..
	CAIE	T,TYPVEN	;ELEVEN TAPE?
	CAIN	T,TYPFIF
	JRST	SELW.4		;ELEVEN OR PDP15 TAPE
				CONT.
SELW.1:	MOVE	D,IPPN		;NEED A LOOKUP. GET DIRECTORY
	MOVEI	T,.IOBIN	;READ IN BINARY
	MOVE	T1,IDEV		;DEVICE NAME
	MOVEI	T2,IHED		;BUFFER HEADER
	OPEN	INF,T		;GET THE DEVICE
	  JRST	ERR26		;CAN'T
	MOVE	A,TIFILE	;SET BACK UP FOR LOOKUP
	MOVE	B,TIEXT		; ..
	TLNN	F,L.DSKI	;READING FROM DISK?
	JRST	SELW.2		;NO.
	MOVEI	T,.RBSTS	;YES. DO EXTENDED LOOKUP
	MOVEM	T,XBUF		;USE TRANSFER BUFFER, ITS FREE
	MOVEM	A,XBUF+2	;NAME
	HLLZM	B,XBUF+3	;EXTENSION
	MOVEM	D,XBUF+1	;AND DIRECTORY
	LOOKUP	INF,XBUF	;DO THE LOOKUP
	 JRST	[ TRNN	F,R.SAVX	;/C CONVERSION
		  JRST	ERR28		;NO GIVE ERROR MESSAGE
		  POPJ	P, ]		;YES GIVE LOOSE RETURN
	LDB	T,[POINT 12,XBUF+4,35]	;GET THE FILE CREATION DATE(LOW PART)
	MOVEM	T,ODATE		;SAVE FOR THE ENTER
	LDB	T,[POINT 3,XBUF+.RBEXT,20]	;GET HIGH PART OF DATE
	DPB	T,[POINT 3,ODATE,23]	;AND STORE
	MOVE	T,XBUF+.RBSIZ	;GET SIZE OF FILE
	MOVEM	T,LENFIL	;STORE FOR LATER
	MOVE	T,XBUF+.RBSTS	;GET THE STATUS WORD
	TRNE	T,RP.ABC	;BAD CKSUM BIT?
	TRO	F,R.ABC		;YES. REMEMBER IT
	JRST	SELW.3		;LOOKUP DONE

SELW.2:	LOOKUP	INF,A		;LEVEL C LOOKUP
	 JRST	[ TRNN	F,R.SAVX	;SAVE CONVERSION WITH /C
		  JRST	ERR29		;AN ERROR
		  POPJ	P, ]		;(YES) SIGNAL CALLER
	LDB	T,[POINT 12,C,35]	;GET TWELVE BIT CREATION DATE
	MOVEM	T,ODATE		;SAVE FOR ENTER
	LDB	T,[POINT 3,B,20];GET REMAINING 3 BITS(HIGH PART)
	DPB	T,[POINT 3,ODATE,23];AND STORE
	HLRE	T,D		;GET LENGTH
	SKIPLE	T		;IF POSITIVE,
	LSH	T,7		; CONVERT BLOCKS TO WORDS
	TLNN	F,L.DSKI	;IF NOT DISK,
	MOVEI	T,0		; CLEAR LENGTH
	MOVMM	T,LENFIL	;STORE NO WORDS FOR LATER
SELW.3:	INBUF	INF,3		;ALLOCATE THE BUFFER SPACE
SELW.4:	MOVE	T,.JBFF		;UPDATE OUTPUT SPACE DEFINER
	MOVEM	T,SJFF3		; FOR BUFFERED OUTPUTS
	MOVEM	T,SJFF4		; AND FOR RPBSCR IN CASE NO BUFFERED OUTS
	TRZ	F,R.EOF		;INDICATE NOT AT EOF YET
	JRST	CPOPJ1		;GIVE WIN RETURN

;HERE IF FAIL TO FIND

SELFF:	TRO	F,R.EOF		;INDICATE NO DATA
	POPJ	P,		;GIVE FAILURE RETURN
	SUBTTL	ROUTINES TO ENTER OUTPUT FILE

ENTRN:	MOVEI	T,0		;DO NORMAL ENTER
ENTR:	MOVEM	T,FOEXT		;CLEAR FORCED OUTPUT EXTENSION
	JUMPN	T,ENTR.2	;IF ARGUMENT, USE IT
	MOVE	T,OSW		;GET OUTPUT SWITCHES
	TRNE	T,SW$S!SW$C!SW$D!SW$E!SW$B	;SPECIFIC SWITCH?
	JRST	ENTR.2		;OUTPUT FORMAT SPECIFIED.
	TLNN	F,L.WEO		;WILD OUTPUT EXTENSION?
	TLNN	F,L.BEO		;NO. SPECIFIED EXTENSION?
	JRST	ENTR.2		;YES. USE SPECIFIED ONE.
	MOVE	C,ISW		;UNDECLARED EXT. COMPUTE ONE.
	HLRZ	A,TIEXT		;FROM INPUT AND TAPE FORMAT
	PUSHJ	P,SELFTP	;WHAT IS INPUT FILE TYPE?
	CAIN	T,FT$B		;BINARY?
	JRST	ENTR.2		;YES.
	MOVE	T,OTYPEX	;ITS A CORE FILE OF SOME SORT.
	HLRZ	T,ONMTAB(T)	;SELECT ON BASIS OF OUT DEVICE
	CAIE	T,'SAV'		;IS THIS ONE SAV?
	JRST	ENTR.1		;NO--USE IT
	CAIE	A,'SVE'		;SEE IF INPUT IS SVE
	CAIN	A,'LOW'		;OR LOW
	MOVE	T,A		;YES--PRESERVE THE ORIGINAL
	CAIE	A,'HGH'		;SEE IF A
	CAIN	A,'SHR'		; HIGH SEGMENT
	MOVE	T,A		;YES--USE THAT
	CAIE	A,'XPN'		;SEE IF EXPANDED CORE
	CAIN	A,'EXE'		; OR NEW CORE IMAGE
	MOVE	T,A		;YES--USE THAT
ENTR.1:	HRLZM	T,FOEXT		;SAVE AS FORCED EXTENSION
ENTR.2:	TLNN	F,L.WFO!L.WEO	;DO WE HAVE A WILD OUTPUT SPEC?
	SKIPN	OFILE		;OR NO OUTPUT FILE NAME?
	SKIPA			;THEN RETAIN CREATION DATE
	SETZM	ODATE		;OTHERWISE MAKE TODAY CREATION DATE
	SETZM	OFILEL		;CLEAR LENGTH OF OUTPUT FILE
	SETOM	OBLK		;CLEAR CURRENT OUTPUT BLOCK
	SETZM	OHED		;IN CASE ANYONE RELIES ON THESE
	SETZM	OHED+1		; ..
	SETZM	OHED+2		; ..
	MOVE	T,OTYPEX	;GET TYPE OF OUTPUT FILE
	JRST	@ENTRT(T)	;GO TO CORRECT ROUTINE FOR ENTER

ENTRT:	ENTNDT			;NOT DECTAPE
	ENTTEN			;10 STYLE DTA
	ENTSIX			;SIX STYLE DTA
	ENTMAC			;MAC STYLE DTA
	ENTFIF			;FIFTEEN STYLE DTA
	ENTVEN			;ELEVEN STYLE DTA

ONMTAB:	SIXBIT	/SAV/		;NOT DECTAPE
	SIXBIT	/SAV/		;10 STYLE DTA
	SIXBIT	/DMP/		;SIX STYLE DTA
	SIXBIT	/BIN/		;MAC STYLE DTA
	SIXBIT	/ABS/		;FIFTEEN STYLE DTA
	SIXBIT	/LOD/		;ELEVEN STYLE DTA
;ROUTINE TO ENTER A FILE ON TEN DECTAPE

ENTTEN:	TLNE	F,L.SCRO	;SCRATCH OUTPUT FILE?
	JRST	ENTTS		;YES.
ENTNDT:	MOVEI	A,.IOBIN	;NO KLUDGERY. JUST ENTER
	SKIPN	B,ODEV		;OUTPUT DEVICE
	MOVSI	B,'DSK'		;DEFAULT IS DISK
	MOVSI	C,OHED		;BUFFER HEADER
	OPEN	OUTF,A		;GET THE DEVICE
	  JRST	ERR14		;CANT
	HLRZ	A,FOEXT		;GET FORCED EXTENSION
	SKIPN	A		;IF BLANK, THEN
	HLRZ	A,TOEXT		;DECIDE IF SPACING SHOULD BE TIGHT
	MOVE	C,OSW		;ON BASIS OF SWITCHES AND FILE EXTENSION
	PUSHJ	P,SELFTP	;SEE IF ITS A KNOWN EXTENSION
	TLNE	F,L.DTO		;DECTAPE OUTPUT?
	CAIN	T,FT$B		;AND NOT A DULL FILE?
	SKIPA			;NO. STANDARD SPACING
	UGETF	OUTF,T		;YES. TIGHT SPACING FORCED BY UGETF
	MOVE	A,TOFILE	;GET OUTPUT FILE NAME
	SKIPN	B,FOEXT		;USE FORCED EXTENSION, IF SET
	HLLZ	B,TOEXT		;GET EXTENSION
	MSTIME	C,		;GET TIME IN MSECS
	IDIVI	C,^D60*^D1000	;MAKE IT MINUTES
	LSH	C,^D12		;MOVE IT TO BIT 23
	LDB	D,[POINT 3,ODATE,23];GET HIGH PART OF DATE
	DPB	D,[POINT 3,B,20];STORE WITH EXTENSION
	LDB	D,[POINT 12,ODATE,35];GET LOW PART OF DATE
	TLNE	F,L.DTO		;IF DECTAPE OUTPUT THEN
	SETZ	C,		;ZERO TIME
	IOR	C,D		;COMBINE TIME AND DATE
	MOVE	D,OPPN		;GET PROJ PROG NUMBER
	ENTER	OUTF,A		;WRITE THE FILE
	  JRST	ERR46		;CANT
	MOVE	T,SJFF3		;SET .JBFF TO THE RIGHT PLACE
	MOVEM	T,.JBFF		; ..
	OUTBUF	OUTF,3		;ALLOCATE THE BUFFER SPACE
	MOVE	T,.JBFF		;GET TOP OF BUFFERS NOW
	MOVEM	T,SJFF4		;AND SAVE IT FOR RPBSCR ROUTINE'S ALLOCATION
	SETOM	SCRBK1		;FLAG HAVE CHANGED AVAIL CORE SO RPBSCR
				; WILL RECOMPUTE SPACE
	POPJ	P,		;RETURN

ENTTS:	MOVE	A,TOFILE	;GET NAME
	SKIPN	B,FOEXT		;AND EXT. FORCED?
	HLLZ	B,TOEXT		;NO. USE SUPPLIED ONE
	MOVEI	C,1		;START OF DIRECTORY INDEX
ENTTL1:	HLLZ	T,ODIREC+150(C)	;GET EXT FOR FILE FROM DIR
	CAMN	A,ODIREC+122(C)
	CAME	B,T		;EXACT MATCH?
	SKIPA			;NO
	JRST	ENTTSS		;YES. SUPERSEDE
	CAIGE	C,26		;LOOKED AT THEM ALL?
	AOJA	C,ENTTL1	;NO. LOOK ON.
	MOVEI	C,1		;YES. NOW LOOK FOR A FREE ONE
ENTTL2:	SKIPN	ODIREC+122(C)	;FILE FREE?
	JRST	ENTTNW		;NEW FILE.
	CAIGE	C,26		;CHECKED ALL OF THEM?
	AOJA	C,ENTTL2	;NOT YET
	JRST	ERR15		;YES. DIRECTORY FULL.
ENTTSS:	MOVE	T,[POINT 5,ODIREC+0]	;BYTES IN DIR
	MOVEI	T1,0		;SOURCE OF ZEROES
	MOVEI	N,1102		;COUNTER
	ILDB	T2,T		;GET A BYTE
	CAIN	T2,(C)		;BELONG TO THIS FILE?
	DPB	T1,T		;YES. FREE IT
	SOJG	N,.-3		;LOOP FOR WHOLE TAPE.
ENTTNW:	MOVEM	C,OFILEX	;SAVE FILE INDEX
	MOVEI	N,1		;LOOK FOR A FREE BLOCK FOR FIRST.
	MOVE	T,[POINT 5,ODIREC]
	ILDB	T1,T		;GET A BYTE
	JUMPE	T1,ENTTB	;IF FREE, GO USE IT.
	CAIGE	N,LASTOB	;LOOKED AT ALL BLOCKS?
	AOJA	N,.-3		;NO. LOOK ON.
	JRST	ERR15		;YES. THE TAPE'S FULL

ENTTB:	MOVEM	N,OFIRBK	;SAVE OUTPUT FIRST BLOCK
	MOVEM	T,OFIRBP	;AND POINTER TO IT.
	MOVEM	A,ODIREC+122(C)	;STORE NAME
	SKIPN	T,ODATE		;GET OUTPUT DATE
	DATE	T,		; USE TODAY IF NOTHING BETTER
	DPB	T,[POINT 12,B,35];STORE LOW PART
	MOVEM	B,ODIREC+150(C)	;STORE EXT,DATE
	MOVEI	T1,1		;SETUP TO STORE HIGH PART OF DATE
	ANDCAM	T1,ODIREC-1(C)	;CLEAR EXISTING BITS
	ANDCAM	T1,ODIREC+^D21(C)
	ANDCAM	T1,ODIREC+^D43(C)
	TRNE	T,1B23		;IS BIT IN DATE SET?
	IORM	T1,ODIREC-1(C)	;YES, SET CORRESPONDING BIT IN DIRECTORY
	TRNE	T,1B22
	IORM	T1,ODIREC+^D21(C)
	TRNE	T,1B21
	IORM	T1,ODIREC+^D43(C)
	SETZM	OHED+2		;NO WORDS LEFT IN WRT BUF
	POPJ	P,		;RETURN
;ROUTINE TO ENTER FILE ON SIX DECTAPE

ENTSIX:	PUSHJ	P,OPOUTF	;OPEN OUTPUT FILE
	MOVE	A,TOFILE	;GET OUTPUT FILE NAME
	SKIPN	B,FOEXT		;FORCED OUTPUT EXTENSION?
	HLLZ	B,TOEXT		;OUTPUT EXTENSION
	HRRZ	C,ODIREC+0	;POINTER INTO DIRECTORY
	JRST	ENTS2A		;RANGE CHECK
ENTSL1:	SKIPN	ODIREC(C)	;FREE FILE?
	JRST	ENTS1		;YES. USE IT.
	CAME	A,ODIREC(C)	;SUPERSEDE FILE?
	JRST	ENTS2		;NO
	HLLZ	D,ODIREC+1(C)	;MAYBE. CHECK EXT
	CAMN	B,D		; ..
	JRST	ENTS3		;YES. GO SUPERSEDE
ENTS2:	ADDI	C,4		;ON TO NEXT ENTRY
ENTS2A:	CAIGE	C,175		;TO END OF DIR?
	JRST	ENTSL1		;ON TO ANOTHER SLOT
	JRST	ERR27		;ERROR. ENTER FAILS

ENTS1:	MOVEM	A,ODIREC(C)	;PUT IN NEW FILE NAME
	HLR	B,ODIREC+0	;GET FILE'S FIRST BLOCK-1
	ADDI	B,1		;FIRST BLOCK
	MOVEM	B,ODIREC+1(C)	;TO DIRECTORY
	HRLM	B,ODIREC+0	;COUNT ALLOCATED BLOCK
	SKIPN	A,ODATE		;GET OUTPUT DATE, IF ANY
	DATE	A,		;NONE. USE TODAY.
	MOVEM	A,ODIREC+2(C)	;STORE IN DIRECTORY
	SETZM	ODIREC+3(C)	;NO IOWD (YET)
	MOVEM	C,OFILEX	;SAVE DIRECTORY SLOT FOR LATER
	POPJ	P,		;RETURN

ENTS3:	PUSH	P,C		;SAVE CURRENT SLOT OF MATCHING FILE
ENTS3L:	MOVE	T,ODIREC+4(C)	;GET NEXT SLOT
	MOVEM	T,ODIREC+0(C)	;COPY IT DOWN BY ONE
	CAIGE	C,177		;COPIED IT ALL?
	AOJA	C,ENTS3L	;NO. MORE.
	SETZM	ODIREC+177	;YES. CLEAR LAST FEW WORDS
	SETZM	ODIREC+176
	SETZM	ODIREC+175
	SETZM	ODIREC+174
	POP	P,C		;GET BACK THE SLOT NUMBER
	JRST	ENTSL1		;AND LOOK FOR END.
;ROUTINE TO ENTER FILE ON PROJECT MAC DECTAPE

ENTMAC:	PUSHJ	P,OPOUTF	;OPEN OUTPUT FILE
	MOVE	A,TOFILE	;GET OUTPUT FILE NAME
	SKIPN	B,FOEXT		;FORCED OUTPUT EXTENSION?
	MOVE	B,TOEXT		;AND EXTENSION (FULL WORD)
	JUMPN	B,ENTM2		;SHUFFLE WORDS IF BLANK EXT
	MOVE	B,A		; ..
	MOVSI	A,'@  '		; ..
ENTM2:	MOVEI	C,2		;FIRST FILE SLOT INDEX
ENTML1:	SKIPN	ODIREC-2(C)	;THIS SLOT FREE?
	SKIPE	ODIREC-1(C)	;AND EXT?
	SKIPA			;NO
	JRST	ENTM1		;YES. GO USE IT.
	CAME	A,ODIREC-2(C)	;NO. IS IT SAME AS NEW FILE?
	JRST	ENTM3		;NO.
	CAMN	B,ODIREC-1(C)	;MAYBE. CHECK EXT
	JRST	ENTM4		;YES. RE-USE THE SLOT
ENTM3:	ADDI	C,2		;COUNT ON TO NEXT SLOT
	CAIGE	C,60		;CHECKED THEM ALL?
	JRST	ENTML1		;NO. GO ON.
	JRST	ERR27		;YES. NO MORE ROOM ON TAPE.

ENTM4:	ASH	C,-1		;CONVERT TO FILE NUMBER
	PUSH	P,C		;SAVE CURRENT INDEX
	PUSHJ	P,DELFM		;DELETE ITS FILE AND EXTS
	POP	P,C		;RESTORE INDEX
	ASH	C,1		;BACK TO INDEX
				;AND NOW USE THIS SLOT

ENTM1:	MOVEM	A,ODIREC-2(C)	;USE THIS SLOT. ENTER NAME
	MOVEM	B,ODIREC-1(C)	;AND THE EXTENSION
	ASH	C,-1		;CONVERT TO FILE NUMBER
	MOVEM	C,OFILEX	;AND SAVE IT FOR LATER
	POPJ	P,		;RETURN
DELFMA:	MOVE	C,T		;EXTENSION FILE
	ASH	C,-1		;FILE NUMBER
DELFM:	ASH	C,1		;GET INDEX TO CLEAR NAMES
	SETZB	N,ODIREC-2(C)	;CLEAR THIS FILE NAME, GET A ZERO AC
	SETZM	ODIREC-1(C)	;CLEAR EXT TOO
	ASH	C,-1		;BACK TO FILE NUMBER
	MOVEI	T,1067		;LAST BLK TO LOOK AT
	MOVE	T1,[POINT 5,ODIREC+56]
DELFML:	ILDB	T2,T1		;GET A DIR BYTE
	CAMN	T2,C		;IN THIS FILE?
	DPB	N,T1		;YES. FREE IT
	SOJG	T,DELFML	;RUN THRU WHOLE DIR
	MOVEI	T,2		;NOW SEE IF THERES AN EXTENSION
DELFMB:	SKIPN	ODIREC-2(T)	;SEE IF EXT
	CAME	C,ODIREC-1(T)	;IS THE EXT = THE CURRENT FILE NO?
	SKIPA			;NOT AN EXT.
	JRST	DELFMA		;AN EXT. GO DELETE IT TOO
	ADDI	T,2		;ON TO NEXT ONE
	CAIL	T,60		;ALL OF THEM?
	POPJ	P,		;YES.
	JRST	DELFMB		;NO. MORE.
;ENTER ROUTINE FOR PDP11 TAPES

ENTVEN:	PUSHJ	P,OPOUTF	;OPEN OUTPUT FILE
	HLRZ	T,TOFILE	;GET THREE CHARS OF OUT FILE NAME
	PUSHJ	P,SIXR5V	;CONVERT TO R50VEN
	MOVEM	T,OFIL1V	;SAVE FOR LOOKUP COMPARE RTN
	HRRZ	T,TOFILE	;SECOND THREE CHARS
	PUSHJ	P,SIXR5V	; ..
	MOVEM	T,OFIL2V
	SKIPN	T,FOEXT		;FORCED OUT EXT?
	HLLZ	T,TOEXT		;NO. STANDARD ONE
	HLRZS	T		;TO RH
	PUSHJ	P,SIXR5V	;TO R50VEN
	MOVEM	T,OEXTV		;TO TEMP STORAGE
	MOVEI	T,100		;NOW GET THE PBM FROM MFD
	PUSHJ	P,ROUTBT	;READ THE MFD PRIMARY BLK
	  JRST	ERR40		;ERROR ON MFD
	HLRZ	T,TBUF+1	;BIT MAP BLK NUMBER (USUALLY 104)
	MOVEM	T,PBMBKO	;SAVE FOR RESTORING IT LATER
	HLRZ	T,TBUF+0	;LINK TO REST OF MFD
	PUSHJ	P,ROUTBT	;READ IT TO TEM BUF
	  JRST	ERR40		;LOSS
	HRRZ	T,TBUF+0	;GET USER ID CODE
	MOVEM	T,VOUIC		;SAVE FOR LATER
	HRRZ	T,TBUF+1	;LENGTH OF UFD ENTRIES
	MOVEM	T,VWPEO		;SAVE VEN WDS PER ENTRY OUTPUT TAPE
	HLRZ	T,TBUF+1	;FIRST BLK OF UFD
	MOVEM	T,VODIB1	;SAVE
	PUSHJ	P,ROUTBT	;AND READ TO GET LINK
	  JRST	ERR40		;LOSS
	MOVEM	T,ODIBKN	;SAVE AS CURRENT CONTENTS OF ODIREC
	HLRZ	T,TBUF+0	;GET LINK TO SECOND BLK
	MOVEM	T,VODIB2	;SAVE IT
	MOVE	T,[XWD TBUF,ODIREC]
	BLT	T,ODIREC+177	;COPY INTO OUTPUT DIRECTORY BUFFER
	MOVE	T,PBMBKO	;NOW READ PBM MAP BLOCK
	PUSHJ	P,ROUTBT	;READ PBM
	  JRST	ERR40		;NO GOOD
	MOVE	T,[XWD TBUF,VBMAPO]	;COPY INTO VEN BIT MAP OUTPUT
	BLT	T,VBMAPO+177	; ..
	MOVEI	C,1		;START COUNTER THRU VEN DIRECTORY
	MOVEM	C,OFILEX	;OUTPUT FILE INDEX (1-56.)
				CONT.
	SETZM	FBMX		;CLEAR CELL FOR FREE FILE NUMBER DURING COMPARE
EVL1:	PUSHJ	P,EVCMP		;SUBR TO GET ENTRY AND CHECK IT AND MARK IF FREE
	  JRST	EV1		;MATCHED. MUST DELETE OLD ENTRY
	AOS	C,OFILEX	;NO MATCH. LOOK ONWARD
	CAIG	C,^D56		;END TEST (SHOULD BE COMPUTED)***
	JRST	EVL1		;LOOK ON
	SKIPN	C,FBMX		;NO MATCH. ANY FREE SLOTS?
	JRST	ERR27		;NO. DIRECTORY FULL. LOSES.
	MOVEM	C,OFILEX	;YES. STORE FREE INDEX
EV1:	PUSHJ	P,EVGET		;GET THE DIRECTORY ENTRY FOR THIS INDEX
	MOVE	T,OFIL1V	;COPY THE FILE ENTRY DATA. NAME1
	MOVEM	T,EVSN1
	MOVE	T,OFIL2V	;NAME2
	MOVEM	T,EVSN2
	MOVE	T,OEXTV		;EXTENSION
	MOVEM	T,EVSEXT
	SKIPN	T,ODATE		;DATE
	DATE	T,		; USE TODAY IF NOTHING BETTER
	PUSHJ	P,DATTV		;IN ELEVEN FORMAT
	MOVEM	T,EVSDAT
	SKIPN	T,OPRT		;PROTECTION
	SKIPN	T,VIPRT		;GET THE OLD ELEVEN PRIORITY
	MOVEI	T,233		;DEFAULT PROTECTION FOR VEN TAPES
	HRRZM	T,EVSPRT	; ..
	MOVE	T,OFILEX	;NOW GET THIS FILE'S BIT MAP IN ITS BLK
	SUBI	T,1		;FILE 1 TO 0
	IDIVI	T,7		;FILES PER PBM BLK
	ADDI	T,70		;FIRST FBM BLK. SHOULD BE IN MFD!!!
	MOVEM	T,FBMBLK	;BLK NUMBER
	IMULI	T1,22		;OFFSET INTO BLOCK
	MOVEM	T1,FBMX		;INDEX INTO FBM
	PUSHJ	P,ROUTBT	;READ THE FBM BLK TO TBUF
	  JRST	ERR40		;LOSS
	MOVEI	T,TBUF		;NOW MAKE A BLT WORD TO COPY BITS OUT
	ADD	T,FBMX		; ..
	MOVSI	T,(T)		; ..
	HRRI	T,FBMBUF	; ..
	BLT	T,FBMBUF+21	;COPY THE BITS TO FBMBUF
	MOVSI	T,-22		;CLEAR THEM IN MASTER (FILE GOING AWAY)
	MOVE	T1,FBMBUF(T)	;GET SOME BITS
	ANDCAM	T1,VBMAPO+2(T)	; CLEAR IN MASTER
	SETZM	FBMBUF(T)	;AND IN THIS FILE
	AOBJN	T,.-3		;LOOP THRU ALL BITS IN THE FBM
	POPJ	P,		;RETURN

;LEAVE COPYING FROM SLOT TO ODIREC UNTIL CLOSE TIME.
;THEN WILL HAVE NAME, EXT, FIRST AND LAST BLK, NUMBER OF BLKS ALL
; READY TO WRITE OUT TOGETHER.
;AT CLOSE TIME, WRITE THE PBM,FBM,AND ODIREC.
;SUBR TO GET OUT DIR ENTRY NAME1, NAME2, EXT INTO EVSLOT

EVGET:	MOVE	T,OFILEX	;OUTPUT FILE NUMBER, 1-56.
	IMUL	T,VWPEO		;TIMES WORDS PER ENTRY
	CAILE	T,377		;IN FIRST BLOCK?
	JRST	EVGET2		;NO
	SUB	T,VWPEO		;ENTRY 1 IS OFFSET 0
	PUSH	P,T
	MOVE	T,VODIB1	;IS THIS BLK IN ODIREC ALREADY?
EVGT2A:	CAMN	T,ODIBKN	;COMPARE ODIREC'S NUMBER
	JRST	EVGT1A		;ALREADY THERE. DONT READ AGAIN
	PUSHJ	P,ROBTOD	;READ OUTPUT DIRECTORY
	  JRST	ERR40
EVGT1A:	POP	P,A
	MOVEM	A,EVSPOS	;SAVE FOR USE AT CLOSE TIME
	MOVE	T,A		;GET WORDS INTO BLK
	MOVEI	C,0		;ARG TO GET ROUTINE
	PUSHJ	P,GTVODW	;GET VEN OUT DIR WORD
	MOVEM	T,EVSN1		;NAME ONE
	MOVEI	T,1(A)		;NAME TWO OFFSET
	PUSHJ	P,GTVODW	;GET FROM ODIREC
	MOVEM	T,EVSN2		; ..
	MOVEI	T,2(A)		;AND EXT WORD
	PUSHJ	P,GTVODW	; ..
	MOVEM	T,EVSEXT	;STORE
	POPJ	P,		;RETURN

EVGET2:	MOVEI	T,377		;TRY SECOND BLK
	IDIV	T,VWPEO		;HOW MANY FIT IN BLK 1?
	MOVNS	T		;SUBTRACT THAT
	ADD	T,OFILEX	;FROM INDEX
	IMUL	T,VWPEO		;BACK TO WORDS
	CAILE	T,377		;TOO BIG?
	JRST	ERR38		;YES. LOSE.
	SUB	T,VWPEO		;CONVERT DOWN 1 (FILE 1 IS IDX 0)
	PUSH	P,T		;STACK ZEROTH WORD
	MOVE	T,VODIB2	;GET BLK NUMBER TWO OF VEN DIR
	JRST	EVGT2A		;AND GO READ IT

EVCMP:	PUSHJ	P,EVGET		;GET THE ENTRY
	MOVE	T,EVSN1		;COMPARE SLOT NAME 1
	CAME	T,OFIL1V	;TO OUTPUT NAME 1
	JRST	EVCMP1		;NOT A MATCH. SEE IF FREE
	MOVE	T,EVSN2		;SAME FOR NAME PART 2
	CAME	T,OFIL2V	; ..
	JRST	CPOPJ1		;NO MATCH
	MOVE	T,EVSEXT	;AND EXTENSION
	CAME	T,OEXTV		; ..
	JRST	CPOPJ1		;NO MATCH
	POPJ	P,		;MATCH. NON-SKIP RETURN
				CONT.
EVCMP1:	JUMPN	T,CPOPJ1	;IF IN USE, RETURN
	MOVE	T,OFILEX	;FREE. GET INDEX
	SKIPN	FBMX		;FIRST FREE ONE?
	MOVEM	T,FBMX		;YES. USE IT FOR ENTER.
	JRST	CPOPJ1		;AND SKIP (DIFFERENT) RETURN

PTVODW:	ANDI	T,177777	;MAKE SURE FITS IN ELEVEN WORD
	MOVEI	T1,1(C)		;SKIP LINK WORD
	ROT	T1,-1		;HALF WORDS ON TEN
	SKIPL	T1		;WHICH HALF
	HRLM	T,ODIREC(T1)	;LEFT
	SKIPGE	T1
	HRRM	T,ODIREC(T1)	;RIGHT
	POPJ	P,
;ROUTINE TO ENTER FILE ON FIFTEEN DECTAPE

ENTFIF:	PUSHJ	P,OPOUTF	;OPEN OUTPUT FILE
	MOVE	T,TOFILE	;GET OUTPUT FILE NAME
	PUSHJ	P,TRMSIX	;CONVERT TO PDP15 FORMAT SIXBIT
	MOVE	A,T
	SKIPN	T,FOEXT
	MOVE	T,TOEXT
	PUSHJ	P,TRMSIX	;SAME FOR EXTENSION
	HLLZ	B,T
	SETZB	C,OBVFLG	;SEARCH FILE DIR FOR THIS FILE
				; AND CLEAR WRITE-DIRECTION FLAG FOR LATER
ENTFL1:	CAME	A,ODIREC+20(C)	;FILE NAME MATCH?
	JRST	ENTF1		;NO
	HLLZ	T,ODIREC+21(C)	;EXT HALFWORD
	CAMN	B,T		;EXT MATCH TOO?
	JRST	ENTF2		;YES. SUPERSEDE THIS FILE
ENTF1:	ADDI	C,2		;COUNT ON TO NEXT FILE
	CAIGE	C,160		;LOOKED AT ALL?
	JRST	ENTFL1		;NO. LOOK ON
	MOVEI	C,0		;YES. FILE NOT THERE. FIND A FREE ONE
ENTFL2:	MOVE	T,ODIREC+21(C)	;DEFINED BY BIT 18 OF EXT WD
	TRNN	T,400000	;IN USE?
	JRST	ENTF3		;NO. USE IT.
	ADDI	C,2		;YES. LOOK ONWARD
	CAIGE	C,160		;TO END OF FD?
	JRST	ENTFL2		;NO. LOOK ON
	JRST	ERR27		;YES. NO FREE FILES. YOU LOSE.
ENTF2:
ENTF3:	MOVEM	A,ODIREC+20(C)	;STORE FILE NAME TO WRITE
	HRRI	B,400000	;SET FILE SLOT IN USE BIT
	MOVEM	B,ODIREC+21(C)	;STORE EXT AND BIT (NO FIRST BLK YET)
	MOVEM	C,OFILEX	;STORE FILE INDEX
	MOVE	T,C		;COPY IT FOR ARITHMETIC
	LSH	T,-4		;CONVERT TO BLOCK NUMBER WHERE BIT MAP IS
	ADDI	T,71		; ..
	MOVEM	T,FBMBLK	;REMEMBER FOR ALLOCATION
	PUSHJ	P,ROUTBT	;READ FROM SCOF OR OUTF TO TBUF
	  JRST	ERR2		;BAD ON DIRECTORY READ
	MOVE	T,[XWD TBUF,FBMBUF]	;COPY INTO ITS OWN BUFFER
	BLT	T,FBMBUF+177	; ..
	MOVE	T,OFILEX	;NOW FREE ANY BLOCKS IT HAS NOW
	ANDI	T,16		;GET BIT GROUP IN BLK
	LSH	T,3		;MAKE IT A WORD OFFSET
	MOVEM	T,FBMX		;SAVE THIS INDEX
	MOVEI	T1,0		;INDEX FOR MASTER BIT MAP
ENTFL3:	MOVE	T2,FBMBUF(T)	;GET A WORD OF BITS OCCUPIED BY FILE
	ANDCAM	T2,ODIREC(T1)	;CLEAR THEM IN MASTER
	SETZM	FBMBUF(T)	;AND IN BIT MAP FOR FILE
	ADDI	T1,1		;STEP
	AOBJN	T,ENTFL3	;LOOP ALL SIXTEEN WORDS
	POPJ	P,		;RETURN
	SUBTTL	CLOSE ROUTINES

CLS:	MOVE	T1,OTYPEX	;GET TYPE OF OUTPUT FILE
	PUSHJ	P,@CLST(T1)	;DISPATCH
	SETOM	OBLK		;CLEAR USE OF THIS POINTER
	POPJ	P,		;RETURN FROM PROCES

CLST:	CLSNDT			;NON DECTAPE
	CLSTEN			;TEN DECTAPE
	CLSSIX			;SIX DECTAPE
	CLSMAC			;MAC DECTAPE
	CLSFIF			;PDP15 DECTAPE
	CLSVEN			;PDP11 DECTAPE

;ROUTINE TO CLOSE NON-DECTAPE

CLSNDT:	CLOSE	OUTF,		;CLOSE THE FILE
	TLNE	F,L.DTO		;IS OUTPUT A DTA?
	JRST	CLSN2		;YES. NO PROTECTION
	MOVE	A,TOFILE	;GET FILE NAME
	SKIPN	B,FOEXT		;GET FORCED EXTENSION
	HLLZ	B,TOEXT		;EXTENSION
	SKIPN	C,OPRT		;PROTECTION
	JRST	CLSN2		;NO--USE SYSTEM DEFAULT
	LSH	C,^D27		;IN RIGHT FIELD
	MOVE	D,OPPN		;PROJ PROG NUMBER
	RENAME	OUTF,A		;PUT PROT ON
	  PUSHJ	P,ERR25		;CAN'T RENAME
	CLOSE	OUTF,		;CLOSE AGAIN
CLSN2:	STATZ	OUTF,IO.ERR	;ERRORS?
	  JRST	ERR21		;YES
	POPJ	P,		;NO.

;ROUTINE TO CLOSE PROJECT MAC DECTAPE

CLSMAC:	MOVEI	A,100		;DIRECTORY BLOCK NUMBER
CLSS3:	MOVEM	A,ODIBKN	;SAVE BLK NUMBER (MAC OR SIX)
	SKIPG	OBLK		;IS THERE AN OUTPUT BLOCK?
	JRST	CLSM1		;NO. JUST WRITE DIR
	PUSHJ	P,PPBBLK	;WRITE THE CURRENT BUFFER
CLSM1:	MOVE	A,ODIBKN	;GET BLK NUMBER FOR DIRECTORY
CLSXIT:	MOVEM	A,OBLK		;FOR WRITER
	MOVE	T,[XWD ODIREC,WBUF]
	BLT	T,WBUF+177	;COPY INTO WRITE BUFFER
	PJRST	PPBBLK		;AND WRITE IT ON DSK OR TAPE
;PDP-15 FORMAT CLOSE ROUTINE

CLSFIF:	HLLOS	WBUF+177	;-1 LINK IS EOF
	SKIPGE	OBLK		;ACTUALLY WRITTEN?
	JRST	CLSF1		;NO. JUST DUMP DIRECTORY
	SKIPN	OBVFLG		;GOING BACKWARDS?
	JRST	CLSF2		;NO
	MOVE	T,[XWD WBUF,TBUF]	;YES. MUST SHUFFLE BITS
	BLT	T,TBUF+177	; MOVE OVER
	PUSHJ	P,OBVCOM	;SHUFFLE
	MOVE	T,[XWD TBUF,WBUF]
	BLT	T,WBUF+177	;MOVE BACK
CLSF2:	PUSHJ	P,PPBBLK	;OUTPUT THE BLOCK
CLSF1:	MOVE	T,[XWD FBMBUF,WBUF]	;PUT BIT MAP IN WBUF
	BLT	T,WBUF+177
	MOVE	T,FBMBLK	;WHERE IT GOES ON TAPE
	MOVEM	T,OBLK		;TO OUTPUTTER'S ARG
	PUSHJ	P,PPBBLK	;WRITE IT
	MOVEI	A,100		;POINT TO DIRECTORY
	JRST	CLSXIT		;GO FINISH OUTPUTTING

;PDP-11 CLOSE ROUTINE

CLSVEN:	SKIPN	VCONTG		;DO NOT CLEAR DATA FOR A CONT. FILE
	HRRZS	WBUF+0		;CLEAR LINK. NO MORE TO WRITE.
	SKIPGE	OBLK		;WRITE ANY AT ALL?
	JRST	CLSV1		;NO. JUST DUMP DIRECTORY AND STUFF
	SKIPN	OBVFLG		;YES. WHICH WAY WE GOING?
	JRST	CLSV2		;FORWARD
	MOVE	T,[XWD WBUF,TBUF]	;BACKWARD. HAVE TO SWAP DATA AROUND
	BLT	T,TBUF+177
	PUSHJ	P,OBCVEN
	MOVE	T,[XWD TBUF,WBUF]
	BLT	T,WBUF+177
CLSV2:	PUSHJ	P,PPBBLK	;WRITE OUT THE BLOCK
				CONT.
CLSV1:	MOVE	T,[XWD VBMAPO,WBUF]	;WRITE THE MASTER BIT MAP BLK
	BLT	T,WBUF+177	;COPY TO WRITE BUFFER
	MOVE	T,PBMBKO	;GET BK NUMBER WHERE IT GOES
	MOVEM	T,OBLK		;FOR WRITER
	PUSHJ	P,PPBBLK	;WRITE IT
	MOVE	T,FBMBLK	;NOW READ THE FILE'S MAP BLK
	MOVEM	T,OBLK		;(WILL WRITE IT IN A MINUTE)
	PUSHJ	P,ROUTBT	;READ IT SO CAN UPDATE ONE FILE'S ENTRY
	  JRST	ERR40		;OOPS
	MOVEI	T,TBUF		;COMPUTE WHERE THE BITS GO
	ADD	T,FBMX
	HRLI	T,FBMBUF	;BLT WORD
	MOVEI	T1,21(T)	;END CONDITION
	BLT	T,(T1)		;MOVE THE BITS FOR THIS FILE
	MOVE	T,[XWD TBUF,WBUF]
	BLT	T,WBUF+177	;COPY OVER FOR WRITING
	PUSHJ	P,PPBBLK	;WRITE IT OUT
	MOVE	C,EVSPOS	;NOW GET THE POSITION FOR OUTPUT SLOT IN ODIRECT
	MOVE	T,EVSN1		;NAME PART 1
	PUSHJ	P,PTVODW	;PUT IT IN ODIREC
	ADDI	C,1		;TO NEXT HALF NAME
	MOVE	T,EVSN2		;GET NAME PART 2
	PUSHJ	P,PTVODW	;PUT IT IN ODIREC
	ADDI	C,1		;TO EXT
	MOVE	T,EVSEXT	;GET THE EXT
	PUSHJ	P,PTVODW	;PUT IT IN ODIREC
	ADDI	C,1		;NOW THE DATE
	MOVE	T,EVSDAT	;ALREADY IN VEN FORMAT
	PUSHJ	P,PTVODW	;PUT IT IN ODIREC
	ADDI	C,2		;FIRST BLK NUMBER
	MOVE	T,EVSFBN	;GET IT
	PUSHJ	P,PTVODW	;PUT IT IN ODIREC
	ADDI	C,1		;LAST BLOCK NUMBER
	MOVE	T,EVSLEN	;GET IT
	PUSHJ	P,PTVODW	;PUT IT IN ODIREC
	ADDI	C,1		;AND LENGTH
	MOVE	T,EVSLAS	;GET IT
	PUSHJ	P,PTVODW	;PUT IT IN ODIREC
	ADDI	C,1		;AND FINALLY PROTECTION CODE
	MOVE	T,EVSPRT	;GET IT
	PUSHJ	P,PTVODW	;PUT IT IN ODIREC
	JRST	CLSM1		;GO FINISH UP
;PDP6 FORMAT CLOSE ROUTINE

CLSSIX:	TLNE	F,L.6DO		;DUMP OUTPUT?
	JRST	CLSS1		;YES.
	HRRZS	WBUF		;NO. CLEAR LINK
	HRRZ	A,OHED+2	;GET USED WORDS COUNT THIS BFR
	MOVNS	A
	ADDI	A,177
	HRRM	A,WBUF		;PUT INTO LINK WORD
	JRST	CLSS2		;GO WRITE THE BLOCK

CLSS1:	HRRZ	A,OHED+2	;GET USED WORDS IN DUMP FILE
	MOVNS	A
	ADDI	A,200
	ADDB	B,OFILEL	;INTO OUTPUT FILE LENGTH
	MOVNS	A		;MAKE IOWD FOR WHOLE FILE
	HRLZS	A
	HRRI	A,JOBSV6	;FIRST ADR MINUS ONE
	MOVE	C,OFILEX	;GET DIRECTORY INDEX
	MOVEM	A,ODIREC+3(C)	;PUT IOWD IN DIRECTORY
CLSS2:	MOVEI	A,1		;DIRECTORY BLOCK NUMBER
	JRST	CLSS3		;WRITE IT OUT

;PDP10 CLOSE ROUTINE

CLSTEN:	TLNN	F,L.SCRO	;SCRATCH OUTPUT FILE?
	JRST	CLSNDT		;NO. USE SYSTEM CLOSE
	SKIPG	OBLK		;YES. ANY DATA WRITTEN?
	JRST	CLST1		;NO
	MOVE	T,OFIRBK	;OUTPUT FIRST BLK
	LSH	T,10		;TO LINK BYTE
	MOVN	T1,OHED+2	;USED WORDS IN LAST BK
	ADDI	T1,177		; ..
	IOR	T,T1		;OR INTO LINK
	HRRZM	T,WBUF		;TO LINK IN WBUF, NO NEXT BLK
	PUSHJ	P,PPBBLK	;OUTPUT THE BLOCK
CLST1:	MOVEI	A,144		;POINT TO DIR BLK
	JRST	CLSXIT		; AND GO WRITE IT
	SUBTTL	READ BINARY WORD, EXPANDING TO CORE IMAGE

;ALL THESE ROUTINES HAVE THE SAME INTERFACE. EACH CALL
;RESULTS IN THE NEXT WORD OF THE LOGICAL ADDRESS SPACE
;BEING RETURNED.
; INTIALIZE:
;	RCA/	0
;	RPC/	ROUTINE FOR FILE TYPE:
;			RDWRD? WHERE ?= FILE TYPE
;				C=.SAV
;				E=.XPN
;				D=.DMP
;				S=MAC S-BLK
;				B=BINARY
;				H=.HGH
;				P=.EXE
;
;CALL:	PUSHJ	P,@RPC
;	RETURN +1 AT END OF ADDRESS SPACE
;	RETURN +2 WITH
;		W/ CONTENTS OF NEXT LOCATION
;		RCA/ ADDRESS OF NEXT LOCATION (INCREASES BY EXACTLY 1)
;		RTYP/ BITS:	(0 MEANS DUMMY AREA)
;			SAME AS .EXE DIRECTORY
;USES ONLY T, T1, T2, A, B, C, D

;ROUTINE TO READ .XPN AND BINARY

RDWRDB:!
RDWRDE:	MOVX	W,PF$WRT	;ALL OF FILE IS LOW SEGMENT
	MOVEM	W,RTYP		;SET FOR CALLER
;HERE TO STRAIGHT COPY REST OF INPUT
RDWRX:	PUSHJ	P,RPB		;READ A WORD
	  POPJ	P,		;RETURN IF EOF
	PUSHJ	P,RWO		;SKIP RETURN VALUE
	JRST	RDWRX		;LOOP FOR EVER
;ROUTINE TO READ .SAV

RDWRDC:	MOVX	W,PF$WRT	;ALL OF FILE IS LOW SEGMENT
	MOVEM	W,RTYP		;SET FOR CALLER
RWC.1:	PUSHJ	P,RPB		;GET NEXT IOWD WORD
	  POPJ	P,		;RETURN IF EOF
	JUMPGE	W,CPOPJ		;END RETURN IF JRST WORD
	HLREM	W,RWC		;SAVE IOWD COUNT
	MOVEI	T,1(W)		;GET NEXT ADDRESS (OF FIRST WORD)
	PUSHJ	P,RPO		;POSITION OUTPUT
RWC.2:	PUSHJ	P,RPB		;READ NEXT DATA WORD
	  POPJ	P,		;RETURN IF EOF
	PUSHJ	P,RWO		;SKIP RETURN OUTPUT
	AOSGE	RWC		;ADVANCE LOOP COUNT
	JRST	RWC.2		;LOOP OVER DATA
	JRST	RWC.1		;LOOP FOR NEXT IOWD

;ROUTINE TO READ S-BLK

RDWRDS:	MOVX	T,PF$WRT	;ASSUME JUST LOW SEG
	MOVEM	T,RTYP		;SET FOR CALLER
RWS.1:	PUSHJ	P,RPB		;SKIP OVER BOOT
	  POPJ	P,		;RETURN IF NOTHING
	CAME	W,[JRST 1]	;LOOK FOR PROGRAM CUE
	JRST	RWS.1		;LOOP

RWS.2:	PUSHJ	P,RPB		;GET NEXT AOBJN
	  POPJ	P,		;RETURN IF DONE
	JUMPGE	W,CPOPJ		;RETURN IF JRST WORD
	MOVEM	W,RCKS		;AOBJN--SAVE AS START OF CHECKSUM
	HLREM	W,RWC		;SET AOBJN COUNTER
	MOVEI	T,(W)		;GET START OF DATA ADDRESS
	PUSHJ	P,RPO		;POSITION OUTPUT
RWS.3:	PUSHJ	P,RPB		;GET NEXT DATA WORD
	  POPJ	P,		;RETURN IF EOF
	MOVE	T,RCKS		;GET PARTIAL CHECKSUM
	ROT	T,1		;ADVANCE
	ADD	T,W		;INCLUDE THIS WORD
	MOVEM	T,RCKS		;SAVE AGAIN
	PUSHJ	P,RWO		;SKIP RETURN THIS DATA WORD
	AOSGE	RW		;COUNT IT
	JRST	RWS.3		;LOOP OVER DATA
	PUSHJ	P,RPB		;READ CHECKSUM
	  POPJ	P,		;RETURN IF DONE
	CAME	W,RCKS		;SEE IF OK
	PUSHJ	P,CKSERR	;WARN IF NOT
	JRST	RWS.2		;LOOP OVER FILE
;ROUTINE TO READ .DMP

RDWRDD:	MOVX	W,PF$WRT	;INDICATE LOW SEG
	MOVEM	W,RTYP		; FOR CALLER
	MOVEI	T,JOBSV6+1	;SKIP THIS
	PUSHJ	P,RPO		; MUCH
	JRST	RDWRX		;FINISH AS STRAIGHT COPY

;ROUTINE TO READ .HGH

RDWRDH:	SETZM	RTYP		;INDICATE DUMMY
	PUSH	P,CA		;SAVE AN AC
	MOVSI	CA,-.JBHGA-1	;LENGTH OF VESTIGIAL JOB DATA AREA
RWH.1:	PUSHJ	P,RPB		;GET WORD
	  JRST	[POP  P,CA	;RESTORE AC
		 POPJ P,]	;EOF RETURN
	MOVEM	W,RW(CA)	;SAVE FOR LATER
	AOBJN	CA,RWH.1	;LOOP OVER DATA
	POP	P,CA		;RESTORE AC
	LSH	W,^D9		;POSITION STARTING ADDRESS
	HLRZS	W		;POSITION IN RH
	SKIPN	T,W		;POSITION
	MOVEI	T,400000	;IF NULL, THEN 400K
	PUSHJ	P,RPO		;SKIP TO THAT POINT

	MOVX	T,PF$HGH	;SET FOR HIGH SEGMENT
	HLRZ	T1,TIEXT	;GET INPUT EXTENSION
	CAIN	T1,'SHR'	;IF SHARABLE,
	TXO	T,PF$SHR	; INDICATE SHARABLE
	MOVEM	T,RTYP		;SAVE TYPE
	MOVSI	T,-.JBHGA-1	;GET LENGTH IN BUFFER
RWH.2:	MOVEM	T,RWC		;SAVE COUNT
	MOVE	W,RW(T)		;GET NEXT WORD FROM BUFFER
	PUSHJ	P,RWO		;SKIP RETURN TO CALLER
	MOVE	T,RWC		;GET COUNT
	AOBJN	T,RWH.2		;LOOP OVER BUFFER
	JRST	RDWRX		;THEN STRAIGHT COPY THE REST
;ROUTINE TO READ PROGRAM (.EXE) FORMAT
;AFTER THE FIRST WORD READ, THE DIRECTORY IS LEFT IN PDS
; THE LAST ENTRY IS AT PDS+C(PDSPTR)+2*C(PDSCNT)

RDWRDP:	SETZM	RPBPCT		;CLEAR PROG COUNTER
	PUSH	P,CA		;SAVE AN AC
RWP.1:	PUSHJ	P,RPBP		;GET NEXT WORD, COUNTING
	HLRZ	T,W		;GET CODE
	CAIN	T,1776		;SEE IF PROGRAM PAGE DIRECTORY
	JRST	RWP.3		;YES--GO READ PROGRAM DIRECTORY
	CAIN	T,1777		;NO--IS IT END OF PROGRAM?
	JRST	[POP  P,CA	;YES--NO PROGRAM HERE
		 POPJ P,]	; SO END
	MOVEI	CA,-1(W)	;NO--SKIP THIS BLOCK TYPE
RWP.2:	PUSHJ	P,RPBP		;GET WORD IN BLOCK
	SOJG	CA,RWP.2	;LOOP
	JRST	RWP.1		;THEN TRY NEXT BLOCK
RWP.3:	MOVEI	T,-1(W)		;GET WORDS IN PROGRAM PAGE DIRECTORY
	LSH	T,-1		;GET NUMBER OF ENTRIES
	MOVEM	T,PDSCNT	;SAVE FOR LATER
	CAILE	T,LN$PDS	;SEE IF ROOM
	JRST	ERR57		;NO--TELL USER
	LSH	T,1		;GET WORD COUNT
	MOVNS	T		;MAKE NEGATIVE
	HRLZ	CA,T		;MAKE INTO AOBJN COUNTER
RWP.4:	PUSHJ	P,RPBP		;GET PAGE DIRECTORY WORD
	MOVEM	W,PDS(CA)	;SAVE IN TABLE
	AOBJN	CA,RWP.4	;LOOP OVER PAGE DIRECTORY
	POP	P,CA		;RESTORE AC
	MOVNI	T,2		;INITIALIZE PAGE DIRECTORY INDEX
	MOVEM	T,PDSPTR	; TO CONTROL INPUT PROGRESS
				CONT.
RWP.5:	MOVEI	T,2		;ADVANCE PAGE DIRECTORY
	ADDB	T,PDSPTR	; POINTER TO NEXT ENTRY
	SOSGE	PDSCNT		;COUNT DOWN PROGRESS
	POPJ	P,		;DONE WHEN DIRECTORY EXPIRED
	MOVE	T,PDS+1(T)	;GET TARGET (PROGRAM) PAGE
	ANDI	T,777		;USE JUST PAGE
	LSH	T,^D9		;MAKE WORD ADDRESS
	SETZM	RTYP		;INDICATE DUMMY REGION
	PUSHJ	P,RPO		;POSITION OUTPUT FILE
	MOVE	T2,PDSPTR	;GET POINTER
	MOVE	T,PDS+1(T2)	;GET REPEAT COUNT
	LSH	T,-^D27		;POSITION COUNT
	ADDI	T,1		;MAKE INTO ITERATION COUNT
	LSH	T,^D9		;POSITION AS WORD COUNT
	MOVE	T2,PDS(T2)	;GET FILE POSITION
	HLLZ	T1,T2		;MAKE A COPY OF FLAGS
	TLZ	T1,777		;CLEAR TO JUST FLAGS
	MOVEM	T1,RTYP		;SAVE FOR CALLER
	TLZ	T2,(777B8)	;CLEAR FLAGS
	JUMPE	T2,[PUSHJ P,RPN	;POSITION THAT FAR AHEAD
		    JRST  RWP.5] ;AND CONTINUE
	MOVEM	T,RWC		;SET LENGTH AS COUNT
	MOVE	T,T2		;GET FILE PAGE
	LSH	T,^D9		;CONVERT TO WORDS
	PUSHJ	P,RPBPOS	;ELSE, POSITION INPUT
RWP.6:	PUSHJ	P,RPB		;READ INPUT
	  JRST	[MOVE  T,RWC	;EOF--SEE IF IN LAST PAGE
		 CAIGE T,^D512	; ..
		 JRST  .+1	;YES--OK, JUST A CHINCY WRITER
		 JRST  ERR55]	;NO--SOMETHING SEVERLY WRONG
	AOS	RPBPCT		;COUNT WORD
	PUSHJ	P,RWO		;STORE IN OUTPUT, COUNTING
	SOSLE	RWC		;FOR R+1 PAGES,
	JRST	RWP.6		;  LOOP
	JRST	RWP.5		;THEN GO FOR NEXT DIRECTORY ENTRY
;HELPER ROUTINES FOR RDWRD? ROUTINES

;RPO--POSITION OUTPUT TO LOCATION C(T)
;RPN--POSITION OUTPUT C(T) LOCATIONS AHEAD

RPO:	SUB	T,RCA		;SEE HOW FAR FROM CURRENT OUTPUT
RPN:	JUMPL	T,ERR24		;ERROR IF NO DISTANCE TO GO
	MOVEM	T,RPOC		;SAVE COUNT OF DISTANCE TO GO
	POP	P,RPOP		;SAVE RETURN POINT FOR LATER
RPO.1:	SOSGE	RPOC		;DECREMENT COUNT
	JRST	@RPOP		;RETURN IF ALL DONE
	MOVEI	W,0		;RETURN A ZERO
	PUSHJ	P,RWO		;SKIP RETURN IT TO OUTER ROUTINE
	JRST	RPO.1		;LOOP

;RWO--ROUTINE TO EFFECT A CO-ROUTINE EXIT
; IT RETURNS CONTENTS OF W TO CALLER AS DATA
; AND ADVANCES RPC (VIRTUAL ADDRESS COUNTER)

RWO:	POP	P,RPC		;INDICATE RE-ENTRY ADDRESS
	AOS	RCA		;ADVANCE COUNT
	JRST	CPOPJ1		;SKIP RETURN
	SUBTTL	READ BINARY WORD ROUTINES

;ROUTINE TO POSITION INPUT UP TO C(T) LOCATION

RPBPOS:	PUSH	P,T		;SAVE LOC
RPBP.1:	MOVE	T,(P)		;GET TARGET
	CAMG	T,RPBPCT	;SEE IF THERE YET
	JRST	RPBP.2		;YES--FINISH UP
	PUSHJ	P,RPBP		;NO--READ A WORD
	JRST	RPBP.1		;LOOP
RPBP.2:	POP	P,T		;RESTORE TARGET
	CAME	T,RPBPCT	;IF NOT RIGHT ON,
	JRST	ERR24		; MUST HAVE STARTED TOO FAR
	POPJ	P,		;ELSE, OK RETURN

;ROUTINE TO READ KEEPING TRACK OF PROGRESS

RPBP:	PUSHJ	P,RPB		;READ ONE WORD
	  JRST	ERR55		;BAD .EXE FILE IF EOF
	AOS	RPBPCT		;COUNT PROGRESS
	POPJ	P,		;RETURN

RPB:	MOVE	T1,ITYPEX	;READ A WORD FROM CORRECT READ ROUTINE
	TRNN	F,R.EOF		;SEE IF EOF
	PUSHJ	P,@RPBT(T1)	;NO--READ ONE WORD
	  TROA	F,R.EOF		;EOF--SET FLAG
	JRST	CPOPJ1		;OK--GIVE DATA RETURN
	MOVEI	W,0		;IF EOF, RETURN 0
	POPJ	P,		;AND INDICATE EOF

RPBT:	RPBNDT
	RPBTEN
	RPBSIX
	RPBMAC
	RPBFIF
	RPBVEN

RPBNDT:	SOSLE	IHED+2		;ANY MORE IN BUFFER?
	JRST	RPBNOK		;YES. GO GET ONE
	IN	INF,		;NO. READ A BLOCK
	  JRST	RPBNOK		;ALL OK
	STATZ	INF,IO.ERR	;ANY ERRORS?
	  PUSHJ	P,ERR16		;YES, UNLESS ABC OR /G
	STATZ	INF,IO.EOF	;EOF?
	  POPJ	P,		;YES. NON-SKIP RETURN
RPBNOK:	ILDB	W,IHED+1	;GET A WORD
CPOPJ1:	AOS	(P)		;SKIP RETURN
CPOPJ:	POPJ	P,		;RETURN
RPBTEN:	TLNN	F,L.SCRI	;READING FROM A SCRATCH FILE?
	JRST	RPBNDT		;NO. TREAT LIKE NON-DECTAPE
	SOSLE	IHED+2		;GET ANOTHER WORD, IF ANY
	JRST	RPBT1		;OK READ THE WORD
	SKIPL	IBLK		;NEED A BLOCK. STARTED YET?
	JRST	RPBT2		;YES. MOVE ON
	MOVE	C,SRCHP		;NO. GET FIRST BLOCK THE HARD WAY
	MOVEI	T,1		;FIRST BLOCK
	MOVE	B,[POINT 5,DIRECT]
RPBTL1:	ILDB	A,B		;GET A BYTE
	CAIN	A,(C)		;IN THIS FILE?
	JRST	RPBT3		;YES.
	CAIGE	T,LASTOB	;TO EOT YET?
	AOJA	T,RPBTL1	;NO. ONWARD
	POPJ	P,		;YES. ASSUME EOF, SINCE NO DATA BLKS

RPBT3:	PUSHJ	P,RPBSCR	;READ THE BLOCK FOR LINK WORD
	  JRST	ERR17		;ERROR ON SCRATCH FILE
	LDB	T,[POINT 10,TBUF,27]	;GET FIRST WORD BYTE
	JRST	RPBT4		;GO READ IT

RPBT2:	LDB	T,[POINT 10,TBUF,17]	;LINK TO NEXT BLOCK
	JUMPE	T,CPOPJ		;IF NONE, EOF
RPBT4:	MOVEM	T,IBLK		;SAVE THIS BLOCK NUMBER
	CAILE	T,LASTOB	;CHECK FOR BAD BLOCK
	JRST	ERR18		;BAD.
	PUSHJ	P,RBTRBF	;READ BLK(T) INTO RBUF
	  JRST	ERR17		;ERROR ON SCRATCH FILE
	LDB	T,[POINT 7,RBUF,35]	;GET COUNT OF WORDS IN BLOCK
	MOVEM	T,IHED+2	;SAVE FOR RPB
	JUMPE	T,RPBT2		;IF NO DATA WORDS, LOOP
	MOVEI	T,RBUF+0	;SKIP LINK
	MOVEM	T,IHED+1	;SAVE POINTER
RPBT1:	AOS	W,IHED+1	;COUNT TO DESIRED WORD
	MOVE	W,(W)		;GET THE WORD
	JRST	CPOPJ1		;AND SKIP RETURN
RPBSIX:	SOSLE	IHED+2		;ANY LEFT IN TEMP BUFFER?
	JRST	RPBS1		;YES. GO GET IT
	SKIPL	IBLK		;NEED A BLOCK. FIRST ONE?
	JRST	RPBS2		;NO. ONWARD
	MOVE	C,SRCHP		;YES. DROP BACK TO DIRECTORY
	HRRZ	T,DIRECT+1(C)	;GET FIRST BLOCK NUMBER
	JRST	RPBS3		;AND GO READ IT
RPBS2:	TRNE	F,R.6DI		;DUMP FILE?
	JRST	RPBS4		;YES.
	LDB	T,[POINT 10,RBUF,17]	;NO. GET LINK
	JRST	RPBS3		;READ THAT ONE
RPBS4:	AOS	T,IBLK		;ASSUME NEXT BLOCK IF DUMP FILE
RPBS3:	JUMPE	T,CPOPJ		;NO MORE IF ZERO LINK. EOF.
	MOVEM	T,IBLK		;STORE CURRENT BLOCK
	CAILE	T,LASTOB	;END OF TAPE?
	JRST	ERR18		;LINK OFF END. QUIT
	PUSHJ	P,RBTRBF	;READ THE BLOCK
	  PUSHJ	P,ERR16		;ERROR. SEE IF /G IN EFFECT
	LDB	T,[POINT 7,RBUF,35]	;GET WORD COUNT
	TRNN	F,R.6DI		;DUMP FILE?
	JRST	RPBS7		;NO. USE COUNT FROM LINK
	MOVE	T,IHED+0	;GET THE COUNT LEFT
	JUMPLE	T,CPOPJ		;ANY LEFT?
	CAILE	T,200		;OVER A BLOCK LEFT?
	MOVEI	T,200		;200 WORDS THIS BLOCK
	MOVNS	T		;MAKE MINUS
	ADDM	T,IHED+0	;DECREMENT REMAINING QTY
	MOVNS	T		;MAKE PLUS AGAIN
RPBS7:	MOVEM	T,IHED+2	;STORE WORD COUNT
	JUMPE	T,RPBS2		;IF NONE IN BLK, LOOP
	MOVEI	T,RBUF		;ADDRESS OF BUFFER AFTER LINK
	TRNE	F,R.6DI		;DUMP FILE?
	SUBI	T,1		;YES. NO LINK. MORE DATA
	MOVEM	T,IHED+1	;TO POINTER TO DATA
RPBS1:	AOS	W,IHED+1	;COUNT POINTER
	MOVE	W,(W)		;GET DATUM
	JRST	CPOPJ1		;AND SKIP RETURN
RPBMAC:	SOSLE	IHED+2		;ANY LEFT IN TEMP BUFFER?
	JRST	RPBM1		;YES. GO GET ONE.
RPBM0:	MOVE	C,SRCHPM	;NO. GET FILE NUMBER FOR BLOCK SEARCH
	ASH	C,-1		; ..
	SKIPL	A,IBLK		;STARTED YET?
	JRST	RPBM2		;YES. CONTINUE
	TRZ	F,R.ITD		;CLEAR INPUT TAPE DIRECTION FLAG
	MOVEI	A,1		;SEARCH FOR BLOCK
	MOVE	B,[POINT 5,DIRECT+56]
RPBML1:	ILDB	T,B		;GET A BYTE
	CAIN	T,(C)		;IN THIS FILE?
	JRST	RPBM3		;YES. GO READ IT
	CAIGE	A,1067		;TO EOT?
	AOJA	A,RPBML1	;LOOK AT ANOTHER
	POPJ	P,		;ASSUME EOF IF NO BLKS IN FILE AT ALL

RPBM2:	MOVE	B,IMACP		;CONTINUE SEARCH
	TRNE	F,R.ITD		;WHICH WAY?
	JRST	RPBM4N		;BACKWARDS
	JRST	RPBM2N		;FORWARDS

RPBM2L:	CAILE	A,1067		;TO END YET?
	JRST	RPBMRV		;YES. REVERSE
	ILDB	T,B		;GET A BYTE
	CAIE	T,(C)		;IN THIS FILE?
RPBM2N:	AOJA	A,RPBM2L	;ON TO NEXT BYTE
	JRST	RPBM3		;FOUND A BYTE IN THIS FILE.

RPBM4L:	CAIGE	A,1		;STILL ON TAPE?
	JRST	RPBMFW		;NO. GO FORWARD NOW
	ADD	B,[XWD 050000,0]	;DECREMENT POINTER
	SKIPGE	B		;OFF TOP OF WORD?
	SUB	B,[XWD 430000,1]	;TO PREVIOUS WORD
	LDB	T,B		;GET THE BYTE
	CAIE	T,(C)		;BELONG TO THIS FILE?
RPBM4N:	SOJA	A,RPBM4L	;LOOP TO NEXT BYTE BACK
	JRST	RPBM3		;FOUND A BLOCK
				CONT.
RPBMFW:
RPBMRV:	MOVEI	A,2		;SEARCH FOR EXTENSION FILE
RPBMRL:	SKIPN	DIRECT-2(A)	;NAME BLANK?
	CAME	C,DIRECT-1(A)	;THIS THE EXTENSION?
	SKIPA			;NO
	JRST	RPBMR1		;YES.
	ADDI	A,2		;NO. TRY NEXT
	CAIGE	A,60		;END OF DIR?
	JRST	RPBMRL		;NO. LOOP FOR NEXT SLOT
	POPJ	P,		;NO EXTENSION. EOF.

RPBMR1:	MOVEM	A,SRCHPM	;STORE SEARCH POINTER
	MOVEI	A,0		;NOW LOOK FOR BLOCK FOR THIS FILE
	MOVE	B,[POINT 5,DIRECT+56]
	TRCE	F,R.ITD		;COMPLEMENT DIRECTION FLAG
	JRST	RPBMR2		;NOW GOING FORWARD
	MOVEI	A,1070		;NOW GOING REVERSE. SWITCH COUNTERS
	MOVE	B,[POINT 5,DIRECT+177,4]
RPBMR2:	MOVEM	A,IBLK		;STORE BLOCK NUMBER
	MOVEM	B,IMACP		;AND POINTER
	JRST	RPBM0		;AND CONTINUE SEARCH

RPBM3:	MOVEM	A,IBLK		;SAVE FOR NEXT BLOCK
	MOVEM	B,IMACP		; ..
	MOVEI	T,200		;WORDS IN A BLOCK
	MOVEM	T,IHED+2	; ..
	MOVEI	T,RBUF-1	;POINTER TO DATA
	MOVEM	T,IHED+1	; ..
	MOVEI	T,(A)		;TO BLOCK NUMBER ARG AC
	CAILE	T,0		;IS BLOCK NUMBER GOOD?
	CAIL	T,1070		; ..
	JRST	ERR18		;NO. LOST SOMEWHERE.
	PUSHJ	P,RBTRBF	;READ TO RBUF
	  PUSHJ P,ERR16		;ERROR. SEE IF /G
RPBM1:	AOS	W,IHED+1	;GET WORD ADDRESS
	MOVE	W,(W)		;AND WORD
	JRST	CPOPJ1		;AND SKIP RETURN
RPBFIF:	SOSLE	IHED+2
	JRST	RPBF1		;BUFFER HAS SOME
	TRZ	F,R.TMP		;CLEAR OBVERSE COMP FLAG
	SKIPL	IBLK		;READ ANY AT ALL YET?
	JRST	RPBF2		;YES. GO GET LINK
	MOVE	C,SRCHP		;NO. GET FIRST BLK NUMBER FROM DIR
	HRRZ	T,DIRECT+1(C)	; ..
	JRST	RPBF3		;USE IT
RPBF2:	HRRZ	T,RBUF+177	;GET LINK TO NEXT BLOCK
	CAMGE	T,IBLK		;GOING FORWARD?
	TRO	F,R.TMP		;NO. FLAG NEED TO COMP DATA
	JRST	RPBF3

RPBF3:	CAIN	T,-1		;EOF FLAG OF MINUS 1?
	POPJ	P,		;YES. QUIT
	TRZ	T,400000	;ACTIVE FLAG FROM DIRECTORY IS JUNK
	CAILE	T,1077		;LEGAL PDP15 TAPE BLOCK?
	JRST	ERR18		;NO.
	MOVEM	T,IBLK		;SAVE IT
	PUSHJ	P,RBTRBF	;READ TO RBUF
	  PUSHJ	P,ERR16		;ERROR - SEE IF /G
	TRNE	F,R.TMP		;NEED TO SHUFFLE THE DATA?
	PUSHJ	P,OBVCMR	;YES. DO SO.
	MOVEI	T,200		;WORD COUNT IS 128 MINUS HALF A WORD
	MOVEM	T,IHED+2	;STORE IT
	JUMPE	T,RPBF2		;IF ZERO, SKIP BLOCK
	MOVEI	T,RBUF-1	;SET FOR PSEUDO ILDB
	MOVEM	T,IHED+1
RPBF1:	AOS	W,IHED+1	;NEXT WORD
	MOVE	W,(W)		;DATA WORD
	JRST	CPOPJ1		;EXIT HAPPY
;ROUTINE TO READ -11 DECTAPE WORD

RPBVEN:	SOSLE	IHED+2
	JRST	RPBV1
	SKIPL	IBLK		;STARTED YET?
	JRST	RPBV2		;YES. FOLLOW LINK
	MOVE	T,VENFBN	;NO. REMEMBER FBN FROM LOOKUP
	JRST	RPBV3
RPBV2:	SKIPN	T1,VCONTG	;LAST BLOCK # OF A CONTIGUOUS FILE
	JRST	LKDFLE		;NO A LINKED FILE
	AOS	T,IBLK		;UPDATE THE NEXT BLOCK NUMBER
	CAILE	T,(T1)		;WAS THE LAST ONE READ
	SETZB	T,IBLK		;YES SHOW EOF
	JRST	RPBV3		;SKIP THE LINKED FILE LOGIC
LKDFLE:	HLRZ	T,RBUF+0	;LINK TO NEXT BLOCK
	TRNE	T,100000	;NEGATIVE?
	TRO	T,600000	;YES EXTEND SIGN
	HRRES	T		; ..
RPBV3:	MOVEM	T,IBLK		;STORE AWAY
	JUMPE	T,CPOPJ		;QUIT ON EOF
	MOVM	T,IBLK		;GET INPUT BLOCK NUMBER BACK
	CAILE	T,1077		;MAX BLK IN BIT MAP
	JRST	ERR18		;OUT OF BOUNDS
	PUSHJ	P,RBTRBF	;READ THE BLOCK FROM TAPE OR SCRATCH FILE
	  PUSHJ	P,ERR16		;ERROR. SEE IF /G
	SKIPGE	IBLK		;WHICH DIRECTION WAS READ?
	PUSHJ	P,OBCVR		;BACKWARDS. SWAP DATA AROUND
	MOVMS	IBLK		;MAKE SURE NOT NEGATIVE FOR NEXT RPB
	MOVEI	T,377		;NUMBER OF 16 BIT WORDS TO READ
	SKIPE	VCONTG		;IF IT IS A CONTIGUOUS FILE
	MOVEI	T,400		;THERE IS NO LINK SO ONE MORE
	MOVEM	T,IHED+2
	MOVE	T,[XWD 442200,RBUF]	;POINTER TO THEM
	SKIPN	VCONTG		;A CONTIGUOUS FILE STARTS ONE EARLIER
	IBP	T		;SO COMPENSATE IT
	MOVEM	T,IHED+1
RPBV1:	ILDB	W,IHED+1
	JRST	CPOPJ1		;GOOD RETURN

RPAVEN:	SKIPE	RPAVC1		;HAVE A BYTE LEFT?
	JRST	RPAVN1		;YES
	PUSHJ	P,RPBVEN	;NO. READ A HALF WORD
	  POPJ	P,		;EOF
	MOVEM	W,RPAVW1	;STORE THE REMAINING HALF WORD
	LDB	CH,[POINT 8,W,35]	;GET THE FIRST (RIGHT) BYTE
	SETOM	RPAVC1		;FLAG ONE LEFT
	JRST	CPOPJ1
				CONT.
RPAVN1:	LDB	CH,[POINT 8,RPAVW1,27]	;SECOND (LEFT) BYTE
	SETZM	RPAVC1		;NEED NEW WORD NEXT TIME
	JRST	CPOPJ1		;GOOD RETURN.

OBCVEN:	MOVSI	N,-100
OBCVL1:	MOVS	T,TBUF(N)
	MOVNI	T1,(N)
	EXCH	T,TBUF+177(T1)
	MOVSM	T,TBUF(N)
	AOBJN	N,OBCVL1
	POPJ	P,

OBCVR:	PUSHJ	P,MOVRT
	PUSHJ	P,OBCVEN
	JRST	MOVTR
	SUBTTL	WRITE BINARY WORD ROUTINES
;ROUTINE TO SKIP OUTPUT UP TO A GIVE POINT IN C(T)

PPBPOS:	PUSH	P,T		;SAVE TARGET
	MOVEI	W,0		;GET A CONSTANT 0
PPBP.1:	MOVE	T,(P)		;GET TARGET
	CAMG	T,OCA		;SEE IF THERE YET
	JRST	PPBP.2		;YES--GO FINISH
	PUSHJ	P,PPBP		;NO--WRITE A 0
	JRST	PPBP.1		;LOOP
PPBP.2:	POP	P,T		;RESTORE TARGET
	CAME	T,OCA		;SEE IF RIGHT ON
	JRST	ERR24		;NO--ERROR
	POPJ	P,		;RETURN OK

;ROUTINE TO WRITE COUNTING PROGRESS IN OCA

PPBP:	PUSHJ	P,PPB		;WRITE WORD
	  HALT
	AOS	OCA		;COUNT PROGRESS
	POPJ	P,		;RETURN

PPB:	MOVE	T1,OTYPEX	;GET OUTPUT TYPE INDEX
	JRST	@PPBT(T1)	;DISPATCH

PPBT:	PPBNDT			;NON DECTAPE
	PPBTEN
	PPBSIX
	PPBMAC
	PPBFIF
	PPBVEN

PPBNDT:	SOSLE	OHED+2		;ANY LEFT IN THIS BUFFER?
	JRST	PPBNOK		;YES
	OUT	OUTF,		;NO. SEND BUFFER
	  SKIPA
	  JRST	ERR19		;YES. QUIT
PPBNOK:	IDPB	W,OHED+1	;PLACE WORD IN BFR
	JRST	CPOPJ1		;OK RETURN

PPBTEN:	TLNN	F,L.SCRO	;SCRATCH OUTPUT FILE?
	JRST	PPBNDT		;NO. USE SYSTEM'S IO
	SKIPLE	OHED+2		;HAS BUFFER ANY SPACE?
	JRST	PPBT1		;YES. USE IT
	SKIPLE	OBLK		;NO. HAS I/O BEEN STARTED BEFORE?
	JRST	PPBTN1		;YES. GO HANDLE END OF BLOCK
	MOVE	A,OFIRBK	;NO. GET FIRST BLOCK.
	MOVE	B,OFIRBP	;AND POINTER TO IT
	MOVE	C,OFILEX	;FILE INDEX
	DPB	C,B		;ALLOCATE THE FIRST BLOCK
	TRZ	F,R.OMF!R.OMD!R.OMT	;CLEAR ALLOCATION CUES
	JRST	PPBT3		;DIVE INTO ALLOCATER AT BUFFER CLR
				CONT.
PPBTL1:	ILDB	T,B		;GET A DIR BYTE
	JUMPE	T,PPBT4		;JUMP IF ITS FREE
PPBT2:	CAIGE	A,LASTOB	;TO END OF TAPE?
	AOJA	A,PPBTL1	;NO. LOOK FORWARD
	JRST	PPBTRV		;YES. REVERSE THE SEARCH
PPBT4:	HRRZ	T,OBLK		;GET THE OUTPUT BLOCK NUMBER LAST USED
	SUB	T,A		;DISTANCE TO THE FREE BLOCK
	MOVMS	T		;MAGNITUDE OF DISTANCE
	TRZE	F,R.OMT		;TURNAROUND IN PROGRESS?
	JRST	PPBT4A		;YES. FORGET INT FACTOR FOR NOW
	TLNN	F,L.6DO		;TIGHT FILE?
	JRST	PPBT4B		;NO
	CAIL	T,2		;YES. CLOSE ENOUGH?
	JRST	PPBT4A		;YES. PUT IT THERE.
PPBT4B:	CAIGE	T,4		;FOUR APART?
	JRST	PPBTN		;NO.
PPBT4A:	DPB	C,B		;YES. ALLOCATE THE BLK
	HRLM	A,WBUF		;PUT IT IN THE LINK WORD OF PREV BLK
	MOVE	T,OFIRBK	;GET THE FIRST BLOCK OF FILE
	LSH	T,10		;PUT IN ITS BYTE OF LINK
	TRO	T,177		;FULL BLOCK, 177 WORDS OF DATA
	HRRM	T,WBUF		;PUT IN LINK WD IN BUF
	PUSHJ	P,PPBBLK	;OUTPUT THE BLK TO TAPE OR SCRATCH FILE

PPBT3:	MOVEM	A,OBLK		;SAVE AS NEXT BLK TO WRITE
	PUSHJ	P,CLRWBF	;CLEAR WBUF FOR NEXT BLOCK
	MOVEI	T,177
	MOVEM	T,OHED+2	;SET UP FOR NEXT BLOCK
	MOVEI	T,WBUF
	MOVEM	T,OHED+1	;FIRST DATUM TO WBUF+1
PPBT1:	SOS	OHED+2		;ONE LESS FREE DATUM
	AOS	T,OHED+1	;WHERE TO PUT IT
	MOVEM	W,(T)		; DO SO
	JRST	CPOPJ1		;SUCCESS RETURN

PPBTN:	TRO	F,R.OMF		;SKIPPED A BLK
PPBTN1:	TRNN	F,R.OMD		;WHICH WAY PASSING OVER DIR?
	JRST	PPBT2		;FWD
	JRST	PPBT6		;BACK

PPBTL2:	ADD	B,[XWD 050000,0]	;BACK A BYTE
	SKIPGE	B		;OFF START OF WORD?
	SUB	B,[XWD 430000,1]	;YES. BACK A WORD
	LDB	T,B		;GET THE BYTE
	JUMPE	T,PPBT4		;JUMP IF BLK IS FREE
PPBT6:	CAILE	A,1		;OFF FRONT OF TAPE?
	SOJA	A,PPBTL2	;NO. TRY ANOTHER
PPBTRV:	TRZN	F,R.OMF		;WORTH TURNING AROUND?
	JRST	ERR20		;NO. NONE AVAIL ON TAPE
	TRC	F,R.OMD		;YES. COMPLEMENT DIRECTION
	TRO	F,R.OMT		;FLAG TURN-AROUND CONDITION
	JRST	PPBTN1		;AND GO PICK ANOTHER BLOCK
PPBSIX:	SOSLE	OHED+2		;ROOM LEFT IN WBUF?
	JRST	PPBS1		;YES.
	SKIPLE	OBLK		;NO. NEED A BLOCK. STARTED YET?
	JRST	PPBS2		;YES. CONTINUE.
	MOVE	C,OFILEX	;NO. GET FIRST BLOCK, SET UP BEFORE
	HRRZ	A,ODIREC+1(C)	;FROM THE DIRECTORY SLOT
	MOVEM	A,OBLK		;STORE THAT
	JRST	PPBS3		;AND GO START WRITING IT

PPBS2:	HRRZ	A,OHED+2	;GET COUNT
	MOVNS	A
	ADDI	A,177		;WORDS USED
	TLNE	F,L.6DO		;DUMP OUTPUT?
	ADDI	A,1		;YES. ANOTHER WORD (NO LINK)
	ADDM	A,OFILEL	;ADD TO LENGTH FOR LATER UPDATE OF DIR
	HLRZ	B,ODIREC+0	;LAST USED BLOCK
	ADDI	B,1		;COUNT IT
	HRLM	B,ODIREC+0	;NOW USED ANOTHER
	HRLM	B,A		;MAKE LINK WORD
	TLNN	F,L.6DO		;UNLESS DUMP FILE,
	MOVEM	A,WBUF		;PUT IN LINK WORD OF THIS BLOCK
	PUSHJ	P,PPBBLK	;OUTPUT BLK ON TAPE OR DSK SCRATCH
	CAILE	B,LASTOB	;STILL ON THE TAPE?
	JRST	ERR20		;NO. EXCEEDED TAPE CAPACITY
	MOVEM	B,OBLK		;NEW OUTPUT BLOCK

PPBS3:	MOVEI	A,200		;SIZE OF BLOCK
	TLNN	F,L.6DO		;UNLESS NOT DUMP,
	MOVEI	A,177		;SIZE OF NON-DUMP BLOCK
	MOVEM	A,OHED+2	;STORE FOR COUNTDOWN
	MOVEI	A,WBUF-1	;OUTPUT POINTER WORD
	TLNN	F,L.6DO		;DUMP FILE?
	MOVEI	A,WBUF+0	;LEAVE SPACE FOR LINK
	MOVEM	A,OHED+1	;STORE AS POINTER
	PUSHJ	P,CLRWBF	;CLEAR WBUF FOR NEXT BLK
PPBS1:	AOS	T,OHED+1	;COUNT OUTPUT POINTER
	MOVEM	W,(T)		;STORE DATUM
	JRST	CPOPJ1		;AND RETURN
PPBMAC:	SOSLE	OHED+2		;ROOM IN WBUF?
	JRST	PPBM1		;YES.
	SKIPLE	OBLK		;NEED A BLOCK. STARTED?
	JRST	PPBM2		;YES. CONTINUE.
	MOVEI	A,1		;NO. SEARCH FOR A FREE BLOCK
	MOVE	B,[POINT 5,ODIREC+56]
	TRZ	F,R.OMD!R.OMF!R.OMT	;INITIALIZE OUTPUT FLAGS
	MOVE	C,OFILEX	;GET FILE INDEX
PPBML1:	ILDB	T,B		;GET A BLOCK BYTE
	JUMPE	T,PPBM3		;IF FREE, GO CONSIDER IT
PPBM5:	CAIGE	A,1067		;END OF TAPE?
	AOJA	A,PPBML1	;NO. LOOK FURTHER
	JRST	PPBMRV		;NOW GO REVERSE IF ANY

PPBM3:	HRRZ	T,OBLK		;CHECK FOR SPACING
	SUB	T,A		;FROM PRV TO CURRENT BLK
	MOVMS	T		;MAGNITUDE OF DISTANCE
	TRZE	F,R.OMT		;TURNAROUND COND?
	JRST	PPBM3A		;YES. IGNORE SPACING COND
	CAIGE	T,4		;FOUR BLOCKS?
	JRST	PPBMN		;NO. SKIP THIS ONE
PPBM3A:	DPB	C,B		;ALLOCATE THIS BLOCK
	MOVEM	A,OBLK		;STORE BLOCK NUMBER
	MOVEM	B,OMACP		;AND BYTE POINTER
	MOVEI	T,200		;SIZE OF BLOCK
	MOVEM	T,OHED+2	;FOR SOSLE
	MOVEI	T,WBUF-1	;AND DATA ADDRESS
	MOVEM	T,OHED+1	; ..
	PUSHJ	P,CLRWBF	;CLEAR THE BUFFER

PPBM1:	AOS	T,OHED+1	;WRITE THE WORD VIA POINTER
	MOVEM	W,(T)		; INTO BUFFER
	JRST	CPOPJ1		;AND SKIP RETURN

PPBM2:	PUSHJ	P,PPBBLK	;OUTPUT BLK ON TAPE OR DSK SCRATCH
	MOVE	C,OFILEX	;GET THE CURRENT FILE NUMBER
	MOVE	A,OBLK		;GET OUTPUT BLOCK
	SKIPA	B,OMACP		;AND BYTE POINTER TO DIRECTORY
PPBMN:	TRO	F,R.OMF		;SKIPPING A BLOCK. REMEMBER THAT
PPBMN1:	TRNN	F,R.OMD		;WHICH WAY WE GOING?
	JRST	PPBM5		;FORWARD. GET NEXT FREE BLOCK
	JRST	PPBM6		;BACKWARD. GET NEXT FREE BLK
				CONT.
PPBML2:	ADD	B,[XWD 050000,0]	;BACK UP A BYTE
	SKIPGE	B		;OUT OF WORD?
	SUB	B,[XWD 430000,1]	;YES RIGHT 35 BITS, BACK A WORD
	LDB	T,B		;GET THIS BYTE
	JUMPE	T,PPBM3		;IF FREE, CONSIDER IT
PPBM6:	CAILE	A,1		;NOT FREE. AT FRONT?
	SOJA	A,PPBML2	;NO. LOOK ON.
	JRST	PPBMFW		;YES. TURN AROUND AGAIN

PPBMRV:
PPBMFW:	TRZN	F,R.OMF		;DID WE PASS ANY BLOCKS?
	JRST	ERR20		;NO. TAPE FULL
	MOVEI	C,2		;YES. LOOK FOR A FILE FOR EXT.
PPBMRL:	SKIPN	ODIREC-2(C)	;THIS ONE FREE?
	SKIPE	ODIREC-1(C)	; ..
	SKIPA			;NO.
	JRST	PPBMR1		;YES. GO USE IT.
	CAIL	C,60		;LOOKED AT ALL?
	JRST	ERR20		;YES. GIVE UP.
	ADDI	C,2		;NO. ONWARD
	JRST	PPBMRL		; ..

PPBMR1:	MOVE	T,C		;COPY OF FILE INDEX
	ASH	C,-1		;CONVERT TO FILE NUMBER
	EXCH	C,OFILEX	;SAVE OUTPUT FILE INDEX, GET OLD ONE
	MOVEM	C,ODIREC-1(T)	;MARK EXTENSION IN NEW SLOT
	TRC	F,R.OMD		;TURN AROUND
	MOVE	C,OFILEX	;GET NEW FILE INDEX
	TRO	F,R.OMT		;REMEMBER TURNAROUND COND
	JRST	PPBMN1		;AND ON TO NEXT BLOCK
PPBFIF:	SKIPLE	OHED+2		;ROOM IN CURRENT BUFFER?
	JRST	PPBF1		;YES - USE IT
	SKIPL	OBLK		;NEED A BLK. FIRST TIME IN?
	JRST	PPBF2		;NO.
	MOVEI	A,1		;YES. SEARCH FOR A BLK
	MOVE	B,[POINT 1,ODIREC,0]
	ILDB	T,B		;GET A BIT
	JUMPE	T,PPBF3		;IS IT FREE?
	CAIGE	A,1077		;NO. TO END OF TAPE?
	AOJA	A,.-3		;LOOP
	JRST	ERR20		;TAPE FULL.

PPBF3:	MOVE	C,OFILEX	;GET FILE INDEX
	DPB	A,[POINT 10,ODIREC+21(C),35]
	MOVEI	T,1		;ALLOCATE IN MASTER DIR
	DPB	T,B
	MOVE	T1,B		;AND IN OWN BIT MAP
	ADDI	T1,FBMBUF-ODIREC	;MOVE TO OTHER BLOCK
	ADD	T1,FBMX		;AND TO SUBGROUP IN BLK
	DPB	T,T1		;ALLOCATE IN FILE'S MAP
	TRZ	F,R.OMD!R.OMF!R.OMT	;INITIALIZE ALLOCATOR FLAGS

PPBF4:	MOVEM	A,OBLK		;STORE FOR OUTPUTTER
	MOVEM	B,OMACP		;AND SAVE POINTER TO BYTE
	PUSHJ	P,CLRWBF	;CLEAR THE WRITE BUFFER
	MOVEI	T,177		;NUMBER OF PDP10 WORDS IN BUFFER
	MOVEM	T,OHED+2	;STORE FOR SOSLE
	MOVEI	T,WBUF-1	;PLACE WHERE WORDS GO
	MOVEM	T,OHED+1
PPBF1:	SOS	OHED+2		;USE A COUNT
	AOS	T,OHED+1	;COUNT WORD POSITION
	MOVEM	W,(T)		;STORE WORD IN WBUF
	JRST	CPOPJ1		;OK RETURN.

PPBF2:	MOVE	A,OBLK		;WHERE WAS LAST OUTPUT
	SKIPA	B,OMACP		;AND ITS POINTER
PPBFN:	TRO	F,R.OMF		;MARK SKIPPING A BLK
PPBFN1:	TRNN	F,R.OMD		;WHICH WAY SCANNING BYTES?
	JRST	PPBF2A		;FORWARD
	JRST	PPBF6A		;BACKWARD
					CONT.
PPBFL1:	ILDB	T,B		;GET A MASTER DIRECTORY BIT
	JUMPE	T,PPBF4A	;JUMP IF FREE
PPBF2A:	CAIGE	A,1076		;LOOKED AT ALL LEGAL BLKS?
	AOJA	A,PPBFL1	;NO. LOOK ON
	JRST	PPBFRV		;YES. REVERSE THE SCAN

PPBF4A:	HRRZ	T,OBLK		;GET PREVIOUS WRITTEN BLK
	SUB	T,A		;DISTANCE
	MOVMS	T
	TRZE	F,R.OMT		;AT THE TURNAROUND?
	JRST	PPBF4C		;YES. FORGET THE SPACING THIS TIME
	CAIGE	T,5		;SPACE FIVE APART
	JRST	PPBFN		;TOO CLOSE TOGETHER
PPBF4C:	MOVEI	T,1		;OK. ALLOCATE IT
	DPB	T,B		;IN MASTER BYTE TABLE
	MOVE	T1,B		;AND IN ITS OWN BYTE TABLE
	ADDI	T1,FBMBUF-ODIREC
	ADD	T1,FBMX
	DPB	T,T1
	HRRM	A,WBUF+177	;LINK TO NEXT BLK
	SKIPN	OBVFLG		;NEED TO OBVERSE COMP THIS BLK?
	JRST	PPBF4B		;NO.
	MOVE	T,[XWD WBUF,TBUF]	;YES. COPY IT
	BLT	T,TBUF+177
	PUSHJ	P,OBVCOM
	MOVE	T,[XWD TBUF,WBUF]
	BLT	T,WBUF+177
PPBF4B:	SETZM	OBVFLG
	CAMG	A,OBLK
	SETOM	OBVFLG		;GOING BACKWARDS NEXT BLK.
	PUSHJ	P,PPBBLK	;FINALLY OUTPUT THE OLD BLK
	JRST	PPBF4		;NOW CLEAR AND PUT W IN

PPBFL2:	ADD	B,[XWD 010000,0]
	HLRZ	T,B
	CAIN	T,440100
	SUB	B,[XWD 440000,1]
	LDB	T,B		;GET BYTE FROM ODIREC
	JUMPE	T,PPBF4A	;JUMP IF FREE
PPBF6A:	CAILE	A,0		;TO FRONT OF TAPE?
	SOJA	A,PPBFL2	;NO. LOOK ONWARD
PPBFRV:	TRZN	F,R.OMF		;TAPE ENTIRELY FULL?
	JRST	ERR20		;YES. LOSE
	TRC	F,R.OMD		;CHANGE DIRECTION
	TRO	F,R.OMT		;SUPPRESS SPACING FACTOR ON TURNAROUND
	JRST	PPBFN1		;AND LOOK ONWARD
PPBVEN:	SKIPLE	OHED+2		;ANY SPACE IN BLK?
	JRST	PPBV1		;YES
	SKIPL	OBLK		;NO. STARTED OUTPUT FILE YET?
	JRST	PPBV2		;YES. GET ANOTHER BLK
	SETZM	EVSLEN		;CLEAR THE LENGTH IN BLKS OF THIS FILE
	SETZM	EVSLAS		;AND FIRST AND LAST BLKS, IN CASE NONE
	SETZM	EVSFBN		; ..
	MOVEI	A,1		;NO. START AT BLK 1
	PUSHJ	P,PVFREQ	;IS BLK FREE?
	  JRST	PPBV3		;YES.
	CAIGE	A,1100		;NO. TO EOT?
	AOJA	A,.-3		;NO, LOOK ON
	JRST	ERR20		;YES. TAPE FULL.

PPBV3:	MOVEM	A,EVSFBN	;STORE FIRST BLK NUMBER FOR DIRECTORY
	PUSHJ	P,PVALOC	;ALLOCATE AND LEAVE TRACKS
	TRZ	F,R.OMF!R.OMD!R.OMT	;INIT FLAGS FOR ALLOCATOR
	SETZM	OBVFLG		; ..
PPBV4:	MOVEM	A,OBLK		;STORE THIS BLK NUMBER AS OUTPUT BLK
	PUSHJ	P,CLRWBF	;CLEAR THE WRITE BUFFER
	MOVEI	T,1		;SET UP BYTE POINTER TO SECOND VEN WORD
	MOVEM	T,OHED+1	; ..
	MOVEI	T,776		;NUMBER OF BYTES WHICH BLK WILL HOLD
	MOVEM	T,OHED+2	;AFTER USING UP LINK.
PPBV1:	SOS	OHED+2		;COUNT USING A BYTE
	AOS	T,OHED+1	;AND GET ITS INDEX
	IDIVI	T,4		;CONVERT TO STORE IT
	DPB	CH,PPAVT1(T1)	;STORE BYTE
	JRST	CPOPJ1		;OK RETURN

PPAVT1:	POINT	8,WBUF(T),17
	POINT	8,WBUF(T),09
	POINT	8,WBUF(T),35
	POINT	8,WBUF(T),27

PVFREQ:	PUSH	P,A		;SAVE BLOCK NUMBER
	IDIVI	A,40		;BITS IN TWO VEN WORDS
	MOVEI	T,1		;CONVERT TO BIT POSITION
	LSH	T,(B)		; ..
	TDNE	T,[XWD 037777,600000]
	LSH	T,2		;IN LEFT HALF
	MOVSS	T		;BUT WORDS IN OTHER ORDER
	MOVE	T1,A		;COPY FOR ALLOCATOR
	TDNE	T,VBMAPO+2(T1)	;FREE?
	AOS	-1(P)		;NO. SKIP RETURN
	POP	P,A
	POPJ	P,

PVALOC:	IORM	T,VBMAPO+2(T1)	;ALLOCATE IN MASTER MAP
	IORM	T,FBMBUF(T1)	;AND INDIVIDUAL MAP
	MOVEM	A,EVSLAS	;LAST BLOCK (SO FAR)
	AOS	EVSLEN		;COUNT ANOTHER IN LENGTH
	POPJ	P,		;RETURN
				CONT.
PPBV2:	MOVE	A,OBLK
PPBVN:	TRO	F,R.OMF
PPBVN1:	TRNN	F,R.OMD
	JRST	PPBV2A
	JRST	PPBV6A

PPBVL1:	PUSHJ	P,PVFREQ	;FREE?
	  JRST	PPBV4A		;YES. SEE IF FAR ENOUGH AWAY
PPBV2A:	CAIGE	A,1077		;EOT?
	AOJA	A,PPBVL1	;NO
	JRST	PPBVRV		;YES. REVERSE DIRECTION

PPBV4A:	HRRZ	T,OBLK		;GET LAST WRITTEN BLK
	SUB	T,A		;DISTANCE
	MOVMS	T		;MAGNITUDE OF IT
	TRZE	F,R.OMT		;TURN-AROUND IN PROCESS?
	JRST	PPBV4D		;YES. IGNORE SPACING
	CAIGE	T,6		;FAR ENOUGH? 6 TO SPEED UP PROCESSING
	JRST	PPBVN		;NO
PPBV4D:	PUSHJ	P,PVFREQ	;YES. RECOMPUTE T AND T1
	  SKIPA
	JRST	ERR38		;THIS CANT BE BUSY - IT WAS JUST FREE
	PUSHJ	P,PVALOC	;ALLOCATE THE BLOCK
	HRLM	A,WBUF+0	;PUT LINK IN DATA BLK
	CAML	A,OBLK		;WILL NEXT BLK BE WRITTEN BACKWARDS?
	JRST	PPBV4C		;NO
	MOVN	T,A		;YES. NEGATE THE BLK NUMBER AS FLAG
	ANDI	T,177777	;ONLY 16 BITS
	HRLM	T,WBUF+0	;STORE NEGATIVE
PPBV4C:	SKIPN	OBVFLG		;WRITING BACKWARDS IN THIS CURRENT BLK?
	JRST	PPBV4B		;NO
	MOVE	T,[XWD WBUF,TBUF]	;YES. MUST OBV COM CURRENT DATA
	BLT	T,TBUF+177	;COPY FOR OBVCOM RTN
	PUSHJ	P,OBCVEN
	MOVE	T,[XWD TBUF,WBUF]
	BLT	T,WBUF+177
PPBV4B:	SETZM	OBVFLG		;NOW SET UP FLAG FOR NEXT TIME
	CAMG	A,OBLK		;WHICH WAY?
	SETOM	OBVFLG		;BACKWARDS
	PUSHJ	P,PPBBLK	;WRITE THE DATA
	JRST	PPBV4		;SET UP WBUF FOR NEXT BLK IF ANY

PPBVL2:	PUSHJ	P,PVFREQ	;FREE?
	  JRST	PPBV4A		;YES
PPBV6A:	CAILE	A,1		;TO FRONT OF TAPE?
	SOJA	A,PPBVL2	;NO
PPBVRV:	TRZN	F,R.OMF		;REVERSE. PASS ANY FREE ONES?
	JRST	ERR20		;NO. ITS FULL
	TRC	F,R.OMD		;YES. CHANGE DIRECTION FLAG
	TRO	F,R.OMT		;FLAG IN TURN-AROUND
	JRST	PPBVN1		;ON TO NEXT BLK
	SUBTTL	BLOCK INPUT/OUTPUT ROUTINES

OBVCMR:	PUSHJ	P,MOVRT
	PUSHJ	P,OBVCOM
	JRST	MOVTR

OBVCOM:	MOVSI	N,-100		;COUNTER FOR BUFFER LENGTH/2
OBVCL1:	MOVE	T,TBUF(N)	;GET A DATA WORD
	MOVNI	T1,(N)		;COUNTER BACK FROM END OF BUFFER
	EXCH	T,TBUF+177(T1)	;SWAP TWO WORDS
	MOVEM	T,TBUF(N)	; ..
	AOBJN	N,OBVCL1	;LOOP THRU WHOLE BUFFE

	SETZM	RADIX		;BORROW THIS TEMP TO COUNT TO 200
OBVCL2:	MOVE	T,RADIX		;INDEX
	SETCM	T2,TBUF(T)	;GET A WORD, COMPLEMENT IT
	MOVEI	N,14		;TWELVE 3BIT BYTES
	ROTC	T1,-3		;SHUFFLE THEM
	LSHC	T,3		; ..
	SOJG	N,.-2
	MOVE	T2,RADIX	;WHERE IT GOES
	MOVEM	T,TBUF(T2)	;STORE IT BACK
	AOS	T,RADIX		;COUNT THRU BUFFER
	CAIGE	T,200		;DONE YET?
	JRST	OBVCL2		;NO. LOOP
	POPJ	P,		;YES. QUIT

READBT:	TLNE	F,L.SCRI	;READING FROM SCRATCH FILE?
	JRST	RPBSCR		;YES. GO TO DISK ROUTINE
	JUMPE	T,READBZ	;SPECIAL HANDLING FOR BLK ZERO
	USETI	INF,(T)		;NORMAL BLOCK. SET IT UP
	IN	INF,TIOL	;TO TBUF
	  JRST	CPOPJ1		;NO ERROR. SKIP RETURN
	POPJ	P,		;ERROR RETURN

READBZ:	SETSTS	INF,IO.NSD!IO.SYN!IO.UWC!.IOBIN	;FOLLOWING MESS READS BLOCK ZERO
	MOVEI	T,TBUF		;PLACE FOR IT AND RING HDR
	EXCH	T,.JBFF
	INBUF	INF,1		;GET BUFFER
	MOVEM	T,.JBFF		;RESTORE .JBFF
	USETI	INF,0		;SET FOR BLK 0
	IN	INF,		;READ THE BLOCK
	  JRST	READBX		;OK
	SETSTS	INF,IO.NSD!.IODMP	;BACK TO REGULAR KLUDGE IO MODE
	POPJ	P,		;YES. NON-SKIP RETURN
READBX:	SETSTS	INF,IO.NSD!.IODMP	;BACK TO REGULAR KLUDGE IO MODE
	HRLZ	T,IHED2+1	;GET START OF DATA
	HRRI	T,TBUF		;MOVE IT DOWN WHERE IT BELONGS
	BLT	T,TBUF+177	; ..
	JRST	CPOPJ1		;SKIP RETURN - SUCCESSFUL
;OUTPUT WBUF TO BLOCK IN OBLK, ON DSK SCRATCH OR DTA AS APPROPRIATE

PPBBLK:	TLNE	F,L.SCRO	;OUTPUTTING TO TAPE OR DSK?
	JRST	PPBSCR		;DISK
	SKIPN	OBLK		;TAPE. IS IT BLK 0?
	JRST	PPBB0		;YES.
	USETO	OUTF,@OBLK	;SET FOR BLK
	OUT	OUTF,WIOL	;PUT OUT WBUF
	  SKIPA
	  JRST	ERR19		;YES
	POPJ	P,		;NO

PPBB0:	PUSHJ	P,WBK0		;GET THE TAPE, WRITE BK 0
	  JRST	ERR19		;TAPE ERROR
	POPJ	P,

PPBSCR:	MOVE	T,OBLK		;GET OUTPUT BLK
	USETO	SCOF,1(T)	;RIGHT BLK ON DSK
	OUT	SCOF,WIOL	;SEND THE DATA
	  SKIPA
	  JRST	ERR3		;YES.
	POPJ	P,		;NO. RETURN

CLRWBF:	MOVE	T,[XWD WBUF,WBUF+1]
	SETZM	WBUF		;CLEAR BUFFER FOR NEXT BLK
	BLT	T,WBUF+177	; ..
	POPJ	P,

ROBTOD:	MOVEM	T,ODIBKN	;SAVE BLK NUMBER IN ODIREC
	PUSHJ	P,ROUTBT	;READ TO TBUF
	  SOS (P)		;ERROR
	MOVE	T,[XWD TBUF,ODIREC]
	BLT	T,ODIREC+177	;COPY TO ODIREC BUFFER
	JRST	CPOPJ1		;OK RETURN
RBTDIR:	PUSHJ	P,READBT	;READ BLOCK IN T INTO TBUF
	  SOS (P)		;SET FOR ERROR RETURN
	MOVE	T,[XWD TBUF,DIRECT]	;OK. COPY IT TO DIRECTORY BLOCK
	BLT	T,DIRECT+177	; ..
	JRST	CPOPJ1		;SUCCESS RETURN

RBTRBF:	PUSHJ	P,READBT	;READ THE BLOCK INTO TBUF
	  SOS (P)		;SET FOR ERROR RETURN
	MOVE	T,[XWD TBUF,RBUF]	;COPY INTO READ BUFFER
	BLT	T,RBUF+177	; ..
	JRST	CPOPJ1		;RETURN

MOVRT:	MOVE	T,[XWD RBUF,TBUF]
	BLT	T,TBUF+177
	POPJ	P,

MOVTR:	MOVE	T,[XWD TBUF,RBUF]
	BLT	T,RBUF+177
	POPJ	P,
WBK0:	PUSH	P,A		;SAVE WORK AC'S
	PUSH	P,B		; ..
	PUSH	P,C		; ..
	MOVEI	A,IO.NSD!IO.SYN!IO.UWC!.IOBIN	;NOW WRITE ON THE TAPE. KLUDGE FOR BK 0
	MOVE	B,ODEV
	MOVSI	C,OHED2		;HEADER FOR BK 0 WRITER
	OPEN	OUTF,A
	  JRST	ERR14
	POP	P,C		;RESTORE THEM
	POP	P,B		; ..
	POP	P,A		; ..
	PUSH	P,.JBFF		;GET A BUFFER FOR BLK 0
	MOVEI	T,TBUF		;IN TBUF
	MOVEM	T,.JBFF
	OUTBUF	OUTF,1		;ONE BUFFER
	POP	P,.JBFF		;RESTORE
	USETO	OUTF,0		;WRITE BLK 0
	OUTPUT	OUTF,		;GET USE BITS RIGHT
	SOS	OHED2+1		;MODIFY LINK WD
	MOVE	T,WIOL		;COPY WBUF TO TBUF
	MOVE	T1,1(T)		;GET A WORD
	IDPB	T1,OHED2+1	;COPY IT TO TBUF
	AOBJN	T,.-2		;COPY 128 WDS
	SETZM	OHED2+2		;WROTE ALL WDS
	OUT	OUTF,		;WRITE IT ON TAPE
	  SKIPA
	  POPJ	P,		;YES. LOSE
	SETSTS	OUTF,IO.NSD!.IODMP	;OK. RETURN TO DUMP MODE
	JRST	CPOPJ1		;GOOD RETURN

ROUTBT:	TLNE	F,L.SCRO	;SCRATCH OUTPUT FILE OPEN?
	JRST	ROBT1		;YES
	USETI	OUTF,(T)	;NO. READ FROM TAPE, BLK IN T
	IN	OUTF,TIOL	;READ THE BLOCK TO TBUF
	  JRST	CPOPJ1		;OK
	POPJ	P,

ROBT1:	USETI	SCOF,1(T)	;SELECT BLOCK VIA T
	IN	SCOF,TIOL	;READ TO TBUF
	  JRST	CPOPJ1
	POPJ	P,		; ..
;ROUTINE TO GET A BLK FROM SCRATCH FILE

RPBSCR:	SKIPLE	T1,SCRBK1	;STARTED COR BFR YET?
	JRST	RPBSCC		;YES
	HRRZ	T2,.JBREL	;NO. COMPUTE BLOCKS TO FIT
	SUB	T2,SJFF4	; ..
	ASH	T2,-7		; ..
	MOVEI	T2,-1(T2)	; ..
	MOVEM	T2,BLKS		;SAVE
RPBSCC:	CAIGE	T,-1(T1)	;DESIRED BLOCK BEFORE CURRENT?
	JRST	RPBSCA		;YES. MUST READ
	ADD	T1,BLKS		;CHECK IF IN CORE
	CAIGE	T,-1(T1)	;OFF THE TOP?
	JRST	RPBSCB		;ITS IN CORE. GO GET IT
RPBSCA:	MOVE	T1,BLKS		;COMPUTE WHERE TO START DSK
	ASH	T1,-2		;STATISTICALLY FORWARD MOSTLY
	MOVNS	T1
	ADDI	T1,1(T)		;REQ-SIZ/4
	SKIPG	T1		;UNLESS TOO LOW
	MOVEI	T1,1		;START AT BEGINNING
	MOVEM	T1,SCRBK1	;HERE'S BASE OF COR IMAGE
	USETI	SCRF,(T1)	;SET DSK TO IT
	ADD	T1,BLKS		;HOW MUCH TO READ
	MOVE	T2,LASTBK	;CHECK TO MAKE SURE STILL ON TAPE
	CAILE	T1,1(T2)	;OFFSET BY ONE FOR BLK ZERO BEING BLK 1 OF DSK
	MOVEI	T1,1(T2)	;TOO MANY. JUST READ THRU LASTBK OF TAPE
	ADDI	T1,1		;NUMBER OF BLOCKS
	SUB	T1,SCRBK1	; ..
	MOVNS	T1		;- BLOCKS
	ASH	T1,31		;(-WDS)
	HRR	T1,SJFF4	;FREE CORE
	MOVEM	T1,CORIOW	;IO LIST
	IN	SCRF,CORIOW	;READ IT
	  SKIPA
	  POPJ	P,		;ERROR. FAIL RETURN
RPBSCB:	MOVEI	T1,1(T)		;SEE WHERE DESIRED BLK IS IN CORE
	SUB	T1,SCRBK1	;DISTANCE IN BLKS
	ASH	T1,7		; IN WORDS
	ADD	T1,CORIOW	;ADDRESS
	ADDI	T1,1		;FOR THE IOWD OFFSET
	MOVSS	T1		;FOR BLT
	HRRI	T1,TBUF		;DESTINATION
	BLT	T1,TBUF+177	;END OF BUFFER
	JRST	CPOPJ1		;SUCCESS RETURN
OPOUTF:	TLNE	F,L.SCRO	;SEE IF SCRATCH OUTPUT
	POPJ	P,		;YES--ALREADY OPEN
	MOVEI	A,IO.NSD!.IODMP	;NO--SET SPECIAL MODE
	MOVE	B,ODEV		;GET OUTPUT DEVICE
	MOVEI	C,0		;NO BUFFERS
	OPEN	OUTF,A		;OPEN DEVICE
	  JRST	ERR14		;ERROR IF NOT AVAILABLE
	POPJ	P,		;OK--RETURN

INOUTD:	TLNE	F,L.SCRO	;SEE IF SCRATCH OUTPUT
	JRST	[USETI SCOF,1(T) ;YES--POSITION TO BLOCK
		 IN    SCOF,ODIIOW ;INPUT BLOCK
		   POPJ P,	;RETURN IF OK
		 JRST  ERR32]	;ERROR IS FATAL IS SCRATCH
	USETI	OUTF,(T)	;POSITION TO BLOCK ON TAPE
	IN	OUTF,ODIIOW	;INPUT BLOCK
	  POPJ	P,		;OK IF OK
	JUMPGE	T,ERR10		;UNLESS "ERROR IS OK", GIVE ERROR
	SETSTS	OUTF,IO.NSD!.IODMP ;OK--JUST CLEAR ERROR STATUS
	POPJ	P,		;RETURN
	SUBTTL	FILE SPEC SCANNER INPUT ROUTINE

FILSPC:	SETZM	$FILE
	SETZM	$EXT
	SETZM	$TID
	MOVE	T,$PSW
	MOVEM	T,$TSW		;COPY PERM SW'S
	MOVPPN	$PPPN,$TPPN
	MOVE	T,$PPRT
	MOVEM	T,$TPRT

	TRZ	F,R.DOT!R.SW!R.EXT!R.UPA
FILSL:	PUSHJ	P,SIXBRD	;READ A WORD
	CAIN	CH,":"		;BREAK CHAR
	JRST	FILS1
	TRNN	F,R.ALL
	JRST	FILS2
	TRZE	F,R.UPA		;TAPE ID?
	MOVEM	W,$TID
	TRZN	F,R.DOT
	JRST	FILSRE
	MOVEM	W,$EXT
	TRO	F,R.EXT		;EXPLICIT EXTENSION
FILSRE:	CAIE	CH,"_"		;BREAKS?
	CAIG	CH,40		; ..
	JRST	FILSX
	CAIE	CH,","
	CAIN	CH,"="
	JRST	FILSX
	CAIN	CH,"["
	JRST	FILSU
	CAIN	CH,"<"
	JRST	FILSP
	CAIN	CH,"."
	JRST	FILSD
	CAIN	CH,"^"		;UPARROW?
	JRST	FILSUA
	CAIN	CH,"/"
	JRST	FILSW
	CAIN	CH,"("
	JRST	FILSS
	JRST	ERR63		;MUST BE JUNKY CHARACTER
				CONT.
FILS1:	SKIPE	$DEV		;IF DEVICE ALREADY,
	JRST	[MOVEM W,$SDEV	; SET AS PSEUDO DEVICE
		 JRST  .+2]	; AND CONTINUE
	MOVEM	W,$DEV		;SAVE DEVICE
	SETZM	$PPPN		;CLEAR PROJ-PROG
	SETZM	$TPPN
	SETZM	$PPRT		;CLEAR PROTECTION
	SETZM	$TPRT
	JRST	FILSL

FILS2:	SKIPE	W		;ANY NAME?
	MOVEM	W,$FILE		;YES
	JRST	FILSRE

FILSX:	MOVEM	CH,$BRKC
	SKIPN	$SDEV		;SEE IF PSEUDO DEVICE
	JRST	CPOPJ1		;NO--GIVE OK RETURN
	MOVE	T,$DEV		;YES--GET REAL DEVICE
	DEVCHR	T,		;SEE IF
	TXNN	T,DV.DTA	; IT IS A DTA
	JRST	ERR52		;ERROR IF NOT
	MOVE	T,$TSW		;GET SWITCHES
	TRNN	T,SW$SCR	;SEE IF FAST MODE
	JRST	ERR52		;NO--ERROR
	JRST	CPOPJ1
				CONT.
FILSU:	PUSHJ	P,OCTIN
FILSU1:	  HLRZ	N,MYPPN		;NULL--GET USER'S PROJECT
FILSU2:	CAIE	CH,","
	JRST	FILSYN		;SYNTAX ERROR
	HRLM	N,$TPPN
	PUSHJ	P,OCTIN
	  HRRZ	N,MYPPN		;NULL--GET USER'S PROGRAMMER NO.
	HRRM	N,$TPPN
	CAIE	CH,","		;SEE IF SFD COMING
	JRST	FILSU8		;NO--GO VERIFY END OF DIRECTORY
	MOVE	T,$TPPN		;YES--GET UFD
	MOVEM	T,$TPPN+1+.PTPPN ; AND PLACE IT IN PATH
	SETZM	$TPPN+1		;CLEAR START OF
	SETZM	$TPPN+2		; PATH AREA
	MOVEI	T,$TPPN+1	;POINT TO PATH AREA
	MOVEM	T,$TPPN		;FROM DIRECTORY
	MOVE	T,[-LN$SFD,,$TPPN+1+.PTPPN+1]
FILSU5:	PUSHJ	P,SIXBRD	;GET SIXBIT WORD
	JUMPE	W,FILSYN	;ERROR IF NULL
	CAIN	W,['*     ']	;ERROR IF
	JRST	FILSYN		; WILD
	MOVEM	W,(T)		;STORE PATH
	SETZM	1(T)		;CLEAR NEXT WORD
	CAIN	CH,","		;IF MORE PATH
	AOBJN	T,FILSU5	; LOOP IF STILL ROOM
FILSU8:	CAIN	CH,.CHLFD	;END OF LINE OK
	JRST	FILSU9		; ..
	CAIE	CH,"]"		;CLOSE BRACKET
	CAIN	CH,">"		; OR THIS TOO
	SKIPA			;OK
	JRST	FILSYN		;ELSE, ERROR
FILSU9:	SKIPE	$FILE
	JRST	FILSUX
	MOVPPN	$TPPN,$PPPN
	JRST	FILSUX
				CONT.
FILSP:	PUSHJ	P,OCTIN
	  JRST	FILSU1		;NULL--MUST BE DIRECTORY
	CAIE	CH,">"
	CAIN	CH,.CHLFD	;EOL IS OK
	SKIPA			;OK
	JRST	FILSU2		;MUST BE DIRECTORY OR ERROR
	HRROM	N,$TPRT
	SKIPN	$FILE
	HRROM	N,$PPRT
FILSUX:	CAIN	CH,.CHLFD
	JRST	FILSX
	JRST	FILSL

FILSUA:	TROA	F,R.UPA
FILSD:	TRO	F,R.DOT
	JRST	FILSL

FILSS:	TRO	F,R.SW		;PARENS
FILSW:	PUSHJ	P,TYI
	CAIL	CH,"A"
	CAILE	CH,"Z"		;ONLY LETTERS ARE SWITCHES
	JRST	FILSWQ
	SKIPN	A,SWTAB-"A"(CH)
	JRST	BADSW
	TLNN	A,-1		;SEE IF GLOBAL
	JRST	[SETOM (A)	;YES--SET IT
		 JRST  FILSWL]		;AND LOOP ON
	HRRZ	A,SWTAB-"A"(CH)	;GET SWS TO CLR
	ANDCAM	A,$TSW		; ..
	SKIPN	$FILE		;PERM?
	ANDCAM	A,$PSW		;YES
	HLRZ	A,SWTAB-"A"(CH)	;GET SET SWS
	IORM	A,$TSW
	SKIPN	$FILE
	IORM	A,$PSW
FILSWL:	TRNE	F,R.SW		;PARENS?
	JRST	FILSS		;YES
	JRST	FILSL		;NO

FILSWQ:	TRZE	F,R.SW
	CAIE	CH,")"
	JRST	BADSW
	JRST	FILSL
SIXBRD:	MOVE	A,[POINT 6,W]
	MOVEI	W,0
SIXBRL:	PUSHJ	P,TYI
	CAIN	CH,"*"
	JRST	SIXLTR
	CAIL	CH,"A"
	CAILE	CH,"Z"
	SKIPA
	JRST	SIXLTR
	CAIL	CH,"0"
	CAILE	CH,"9"
	POPJ	P,
SIXLTR:	SUBI	CH,40
	TLNE	A,770000
	IDPB	CH,A
	JRST	SIXBRL

OCTIN:	MOVEI	N,0
	PUSHJ	P,TYI		;LOOK AT FIRST CHAR
	CAIL	CH,"0"		;IF
	CAILE	CH,"7"		; OCTAL,
	POPJ	P,		;NO--NON-SKIP SINCE NULL FIELD
	SKIPA			;YES--OK
OCTINL:	PUSHJ	P,TYI
	CAIL	CH,"0"
	CAILE	CH,"7"
	JRST	CPOPJ1
	ASH	N,3
	ADDI	N,-"0"(CH)
	JRST	OCTINL
	SUBTTL	TYPE OUT ROUTINES

SIXDOT:	PUSHJ	P,SIXOUT	;OUTPUT SIXBIT
DOT:	MOVEI	CH,"."		;AND A DOT
	JRST	TYO

SIXTAB:	PUSHJ	P,SIXOUT
TAB:	MOVEI	CH,.CHTAB
TYO:	OUTCHR	CH
	POPJ	P,

MINUS:	MOVEI	CH,"-"
	JRST	TYO

COLON:	MOVEI	CH,":"		;TYPE A COLON
	JRST	TYO
COMMA:	MOVEI	CH,","
	JRST	TYO
SPACE:	MOVEI	CH," "
	JRST	TYO
SIXCR:	PUSHJ	P,SIXOUT
CRLF:	MOVEI	W,[ASCIZ /
/]
MSG:	HRLI	W,(POINT 7,)
MSG.1:	ILDB	CH,W
	JUMPE	CH,CPOPJ
	PUSHJ	P,TYO
	JRST	MSG.1

R5VOUT:	PUSHJ	P,R5VSIX	;CONVERT R50 TO SIXBIT IN RH OF T
SIXOU3:	HRLZS	T		;POSITION TO LH
SIXOUT:	MOVE	T1,T		;COPY TO SCRATCH
SIXO.1:	JUMPE	T1,CPOPJ	;EXIT IF DONE
	MOVEI	T,0		;CLEAR ACCUMULATOR
	LSHC	T,6		;GET NEXT CHARACTER
	MOVEI	CH,40(T)		;CONVERT TO ASCII
	PUSHJ	P,TYO		;OUTPUT IT
	JRST	SIXO.1		;LOOP
DATOUT:	JUMPLE	A,NODATE
	PUSH	P,C
	IDIVI	A,^D31
	MOVEI	T,1(B)
	PUSHJ	P,DECPR2
	IDIVI	A,^D12
	MOVE	T,MONTAB(B)
	MOVEI	T1,0
	MOVEI	W,T
	PUSHJ	P,MSG
	MOVEI	T,^D64(A)
	CAIL	T,^D100		;TWO DIGITS ONLY FOR DATE
	SUBI	T,^D100
	PUSHJ	P,DECPR2
	POP	P,C
	POPJ	P,

OCTP4S:	CAIGE	T,1000
	PUSHJ	P,SPACE
	CAIGE	T,100
	PUSHJ	P,SPACE
	CAIGE	T,10
	PUSHJ	P,SPACE
	JRST	OCTPRT
;RADIX FIFTY CONVERTER FOR PDP-11 TAPE DIRECTORIES
;NOTE THAT FOR SOME REASON THE CODING OF THIS RADIX 50 IS NOT THE
;SAME AS THAT FOR THE PDP10 (SIGH)

R5VSIX:	SETZM	W		;CLEAR ANSWER CELL
	MOVE	T2,[POINT 6,W,17]	;POINTER TO OUTPUT
	ANDI	T,177777	;MAKE SURE REASONABLE SIZE
	IDIVI	T,3100		;GET FIRST CHAR
	PUSH	P,T1		;SAVE OTHER 2
	PUSHJ	P,R5VOU1	;OUTPUT FIRST
	POP	P,T		;RESTORE 2 AND 3
	IDIVI	T,50		;SPLIT APART
	PUSH	P,T1		;SAVE LAST CHAR
	PUSHJ	P,R5VOU1	;OUTPUT SECOND
	POP	P,T		;RESTORE THIRD
	PUSHJ	P,R5VOU1	;LAST CHARACTER CONVERSION
	MOVE	T,W		;ANSWER TO RIGHT AC
	POPJ	P,

R5VOU1:	IDIVI	T,6		;USUAL CODE CONVERSION BYTE POINTER HACK
	LDB	CH,R5VOU2(T1)	;GET CHAR IN SIXBIT
	IDPB	CH,T2		;PUT IN W
	POPJ	P,		;AND RETURN IT

R5VOU2:	POINT	6,R5VTAB(T),5
	POINT	6,R5VTAB(T),11
	POINT	6,R5VTAB(T),17
	POINT	6,R5VTAB(T),23
	POINT	6,R5VTAB(T),29
	POINT	6,R5VTAB(T),35

R5VTAB:	SIXBIT	\ ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789?\
;AND THE REVERSE CONVERSION. CALL WITH 3 SIXBIT CHARS IN RH OF T,
; RETURN WITH RADIX 50 (11 STYLE) IN T (AND W) , ALL BAD CHARS CODED
; AS 35'S, THE UNDEFINED CHAR, WHICH FILEX TREATS AS "%".

SIXR5V:	MOVEI	W,0		;CLEAR ANSWER
	MOVE	N,[POINT 6,T,17]	;POINT TO INPUT
SXR5VL:	ILDB	T1,N		;GET A CHAR
	IDIVI	T1,6		;CODE CONVERT
	LDB	CH,SXR5V2(T2)	;GET THE R50 BYTE
	IMULI	W,50		;LEFT SHIFT PREV BYTES
	ADDI	W,(CH)		;ADD IN THIS ONE
	TLNE	N,770000	;DONE?
	JRST	SXR5VL		;NO
	MOVE	T,W		;YES. ANSWER TO AC T
	POPJ	P,		;AND RETURN

SXR5V2:	POINT	6,SXR5V3(T1),05
	POINT	6,SXR5V3(T1),11
	POINT	6,SXR5V3(T1),17
	POINT	6,SXR5V3(T1),23
	POINT	6,SXR5V3(T1),29
	POINT	6,SXR5V3(T1),35

SXR5V3:	BYTE	(6) 0,35,35,35,33,35,35,35,35,35,35,35
	BYTE	(6) 35,35,34,35,36,37,40,41,42,43,44,45
	BYTE	(6) 46,47,35,35,35,35,35,35,35,01,02,03
	BYTE	(6) 04,05,06,07,10,11,12,13,14,15,16,17
	BYTE	(6) 20,21,22,23,24,25,26,27,30,31,32,35,35,35,35,35,35,35
DECP4S:	CAIGE	T,^D1000
	PUSHJ	P,SPACE
DECP3S:	CAIGE	T,^D100
	PUSHJ	P,SPACE
DECP2S:	CAIGE	T,^D10
	PUSHJ	P,SPACE
	JRST	DECPRT

PROOUT:	PUSH	P,T
	MOVEI	CH,74
	PUSHJ	P,TYO
	POP	P,T
	PUSHJ	P,OCTPR3
	MOVEI	CH,76
	JRST	TYO

OCTPR3:	CAIGE	T,100
	PUSHJ	P,ZEROUT
OCTPR2:	CAIGE	T,10
	PUSHJ	P,ZEROUT
	JRST	OCTPRT

SPACE2:	PUSHJ	P,SPACE
	JRST	SPACE

CRLF2:	PUSHJ	P,CRLF
	JRST	CRLF

DATTV:	IDIVI	T,^D31*^D12	;CONVERT DATES FROM TEN TO ELEVEN
	IDIVI	T1,^D31
	MOVE	N,T
	SUBI	T,6		;1970-1964
	MOVEI	CH,0
	IMULI	T,^D1000	;1000 TIMES YEARS SINCE 70
DATTV2:	JUMPE	T1,DATTV3	;IF TO RIGHT MONTH, JUMP
	ADD	T,MONTB2(CH)	;ADD IN A MONTH OF DAYS
	CAIN	CH,1		;FEBRUARY
	TRNE	N,3		;AND LEAP YR
	SKIPA			;NO
	ADDI	T,1		;YES.
	SUBI	T1,1		;COUNT DOWN A MONTH
	AOJA	CH,DATTV2	;COUNT TABLE INDEX, LOOP
DATTV3:	ADDI	T,1(T2)		;ADD IN DAY OF MONTH
	TDNE	T,[^-77777]
	MOVEI	T,0		;IF OVERFLOW
	POPJ	P,		;RETURN
DATVT:	JUMPE	T,CPOPJ
	IDIVI	T,^D1000
	MOVEI	N,2(T)
	IMULI	T,^D372		;DAYS IN A PDP10 YEAR
	ADDI	T,^D2232	;1 JAN 70
	MOVEI	CH,0		;MONTH TABLE INDEX
DATVT2:	MOVE	T2,MONTB2(CH)
	CAIN	CH,1		;FEB?
	TRNE	N,3		;LEAP YR?
	SKIPA			;NO
	ADDI	T2,1		;YES. IT'S 29 DAYS LONG
	CAMG	T1,T2		;IN THIS MONTH?
	JRST	DATVT1		;YES
	SUB	T1,T2		;NO
	ADDI	T,^D31
	AOJA	CH,DATVT2	;LOOP, COUNT MONTH INDEX
DATVT1:	ADDI	T,-1(T1)	;ADD IN DAY OF MONTH
	POPJ	P,		;RETURN

OUTLST:	MOVE	T,ODEV		;OUTPUT DEVICE
	PUSHJ	P,SIXOUT
	PUSHJ	P,COLON
	MOVE	T,TOFILE
	PUSHJ	P,SIXDOT
	HLRZ	T,TOEXT
	JRST	SIXOU3

CONTQ:	TRNN	F,R.GO
	POPJ	P,
	MOVEI	W,[ASCIZ \ (continuing - /G) \]
	TRON	F,R.GOS
	PUSHJ	P,MSG
	PUSHJ	P,CRLF
	JRST	CPOPJ1
VENDAT:	JUMPG	T,VDATE1	;BLANK?
NODATE:	MOVEI	W,[ASCIZ /(undated)/]
	JRST	MSG
VDATE1:	PUSH	P,T		;SAVE DATE
	IDIVI	T,^D1000	;GET DAY OF YEAR
	ADDI	T,2		;BECAUSE 1970 WASNT A LEAP YEAR
	MOVEI	N,0		;COMPUTE REAL DATE
VDATE3:	MOVE	T2,MONTB2(N)	;GET TABLE ENTRY
	CAIN	N,1		;FEBRUARY?
	TRNE	T,3		;AND LEAP YEAR?
	SKIPA			;NO
	ADDI	T2,1		;YES. THE MONTH IS LONGER
	CAMG	T1,T2		;IN THIS MONTH?
	JRST	VDATE2		;YES
	SUB	T1,T2		;MOVE TO NEXT MONTH
	ADDI	N,1		;NEXT MONTH
	CAIGE	N,14		;PAST DECEMBER?
	JRST	VDATE3		;NO. TRY IT.
	POP	P,T		;YES. BAD DATE.
	MOVEI	W,[ASCIZ /bad  date/]
	JRST	MSG

VDATE2:	PUSH	P,N
	MOVE	T,T1
	PUSHJ	P,DECPR2
	POP	P,T
	MOVE	T,MONTAB(T)
	MOVEI	T1,0
	MOVEI	W,T
	PUSHJ	P,MSG
	POP	P,T
	IDIVI	T,^D1000
	ADDI	T,^D70
VDATE5:	CAIG	T,^D99
	JRST	VDATE4
	SUBI	T,^D100
	JRST	VDATE5
VDATE4:	PUSHJ	P,DECPR2
	POPJ	P,

MONTB2:	DEC	31,28,31,30,31,30,31,31,30,31,30,31
MONTAB:	ASCII	/-Jan--Feb--Mar--Apr--May--Jun-/
	ASCII	/-Jul--Aug--Sep--Oct--Nov--Dec-/

OCTPRT:	MOVEI	CH,10
	JRST	RDXPRT
DECPR2:	CAIG	T,11
	PUSHJ	P,ZEROUT
DECPRT:	MOVEI	CH,12
RDXPRT:	MOVEM	CH,RADIX
	SKIPGE	T		;IF NEGATIVE,
	PUSHJ	P,MINUS		; TELL USER
RDXP.1:	IDIV	T,RADIX
	MOVMS	T1
	HRLM	T1,(P)
	SKIPE	T
	PUSHJ	P,RDXP.1
	HLRZ	CH,(P)
	ADDI	CH,"0"
	JRST	TYO
ZEROUT:	MOVEI	CH,"0"
	JRST	TYO
TYI:	PUSHJ	P,TYI1		;GET A CHARACTER
	POPJ	P,		;RETURN WITH CHARACTER IN CH

TYI.1:	PUSHJ	P,TYI1		;SCAN FOR END OF COMMENT LINE
	CAILE	CH,37		;CHARACTER A TERMINATOR?
	JRST	TYI.1		;NO GET ANOTHER
	POPJ	P,		;YES RETURN

TYI1:	INCHWL	CH		;GET A CHARACTER
	JUMPE	CH,TYI1		;DISCARD NULLS
	CAIE	CH,.CHDEL	;DELETE?
	CAIN	CH,.CHCRT	;CARRIAGE RETURN?
	JRST	TYI1		;YES. SKIP IT
	CAIE	CH," "		;SPACE?
	CAIN	CH,.CHTAB	;OR TAB?
	JRST	TYI1		;YES. SKIP THEM.
	CAIL	CH,140		;LOWER CASE?
	TRZ	CH,40		;YES. MAKE UPPER CASE.
	CAIE	CH,.CHVTB	;VERTICAL TAB
	CAIN	CH,.CHFFD	; AND FORM FEED
	MOVEI	CH,.CHLFD	;ARE SAME AS NEW LINE
	CAIE	CH,.CHCNC	;CONTROL C?
	CAIN	CH,.CHCNZ	;CONTROL Z?
	JRST	[RESET		;YES--CLEAR IO
		 MONRT.		;EXIT TO MONITOR
		 JRST FILEX]	;IF CONTINUE, START OVER
	CAIE	CH,";"
	CAIN	CH,"!"
	JRST	CPOPJ1		;COMMENT LINE SO SKIP RETURN
	POPJ	P,		;AND RETURN CHARACTER

TRMSIX:	MOVSI	T1,770000
	MOVSI	T2,400000
TRMSXL:	TDNE	T,T1
	XOR	T,T2
	LSH	T1,-6
	LSH	T2,-6
	JUMPN	T1,TRMSXL
	POPJ	P,
	SUBTTL	ERROR ROUTINES

ERR1:	PUSH	P,B
	EMSG$ <? Can't access input device >
	POP	P,T
	PUSHJ	P,SIXOUT
	JRST	FILEX
ERR2:	EMSG$ <? Error reading tape directory>
	JRST	FILEX
ERR3:	MSG$ <% Can't access DSK for scratch file
>
	JRST	TYPDIQ
ERR4:	EMSG$ <? Can't ENTER scratch file on disk
>
	JRST	FILEX
ERR5:	EMSG$ <? Bad free count on PDP6 directory>
	JRST	FILEX
ERR6:	MSG$ <% I/O error reading tape - continuing
>
	JRST	TYPDIQ
ERR7:	MSG$ <% I/O error writing scratch file - continuing
>
	JRST	TYPDIQ
ERR8=ERR3
ERR9:	EMSG$ <? Can't OPEN output device>
	JRST	FILEX
ERR10:	EMSG$ <? Error on output device >
	GETSTS	OUTF,T
	PUSHJ	P,OCTPRT
	JRST	FILEX
ERR11:	EMSG$ <? Command error - no * on output with multiple input>
	JRST	FILEX
ERR12:	EMSG$ <? Can't access DSK for directory>
	JRST	FILEX
ERR13:	EMSG$ <? I/O error reading disk directory>
	JRST	FILEX
ERR14=ERR9
ERR15:	EMSG$ <? Can't ENTER file >
	MOVE	T,A
	PUSHJ	P,SIXDOT
	MOVE	T,B
	PUSHJ	P,SIXCR
	JRST	FILEX
ERR16:	TRNE	F,R.ABC		;ALWAYS BAD CKSM?
	JRST	ERR16C		;YES. CONSIDER WHAT BIT
ERR16B:	TROE	F,R.GOS		;ERROR. FIRST?
	JRST	ERR16E		;NO
	TRNN	F,R.GO		;/G?
	JRST	ERR16D		;NO. GIVE FATAL MESSAGE
	MSG$ <% I/O error reading input file - continuing (/G)
>
ERR16E:	GETSTS	INF,T
	TRZ	T,IO.ERR
	SETSTS	INF,(T)
	POPJ	P,		;YES
ERR16C:	STATZ	INF,IO.ERR-IO.IMP	;ERRORS BESIDES CKSM?
	  JRST	ERR16B		;YES. GIVE MESSAGE
	POPJ	P,		;NO. IGNORE ERROR.
ERR16D:	EMSG$ <? I/O error reading input file
>
	JRST	FILEX
ERR17:	EMSG$ <? Error reading disk scratch file
>
	POPJ	P,
ERR18:	EMSG$ <? Bad link block number on tape
>
	POPJ	P,
ERR19:	EMSG$ <? Error on output device>
	JRST	FILEX
ERR20:	EMSG$ <? Output tape full
>
	JRST	CLS
ERR21=ERR10
ERR22:	MOVE	A,ODEV		;SEE IF SOMETHING
	IOR	A,$DEV
	IOR	A,$FILE
	IOR	A,$EXT
	IOR	A,$TPPN
	IOR	A,$TPRT
	IOR	A,$TSW
	SKIPN	A
	CAIL	T,40		;NO. END OF LINE?
	SKIPA			;BAD
	JRST	FILEX		;BLANK LINE. IGNORE IT
	EMSG$ <? Command error - no = after output file>
	JRST	FILEX
ERR23:	EMSG$ <? No such file as >
	MOVE	T,IFILE
	PUSHJ	P,SIXDOT
	MOVE	T,IEXT
	PUSHJ	P,SIXCR
	JRST	EPROCS
ERR24:	EMSG$ <? Non-monotonic input data
>
	JRST	CLS
ERR25:	MSG$ <protection RENAME failed
>
	POPJ	P,
ERR26:	EMSG$ <? Can't access input device>
	JRST	FILEX
ERR27:	EMSG$ <? Tape directory full>
	JRST	FILEX
ERR28:	PUSH	P,XBUF+3	;SAVE ERROR CODE
	SKIPA
ERR29:	PUSH	P,B		;SAVE ERROR CODE
	HRRZ	T,(P)		;GET ERROR CODE
	TLNE	F,L.FRCL	;IF FORCING,
	JUMPE	T,[POP P,T	;AND NOT FOUND, THEN INDICATE NO FILE
		JRST SELFF]	;AFTER CLEANING UP STACK
	EMSG$ <? LOOKUP failure (>
	POP	P,T
	HRRZS	T
	PUSHJ	P,OCTPR2
	MSG$ <) file >
	MOVE	T,A
	PUSHJ	P,SIXDOT
	MOVE	T,B
	PUSHJ	P,SIXCR
	JRST	EPROCS		;TRY TO CONTINUE IF MULT FILES
ERR30:	MSG$	<% Protection ignored on input file
>
	POPJ	P,
ERR31:	MSG$	<% Tape ID ignored on input file
>
	POPJ	P,
ERR32:	EMSG$ <? Error reading output scratch file
>
	JRST	FILEX
ERR33:	EMSG$ <? Error writing scratch file for output tape
>
	JRST	FILEX
ERR34:	EMSG$ <? Can't read output scratch file
>
	JRST	FILEX
ERR35:	EMSG$ <? I/O error on output scratch file
>
	JRST	FILEX
ERR36:	EMSG$ <? Can't process directly between 16 & 18 bit machine tapes.
>
	JRST	FILEX
ERR37:	EMSG$ <? Illegal value for PDP11 UIC
>
	JRST	FILEX
ERR38:	EMSG$ <? Consistency check in PDP11 tape directory
>
	JRST	FILEX
ERR39:	MSG$ <% Error reading block 0 - continuing
>
	POPJ	P,
ERR40:	EMSG$ <? Error on output directory
>
	JRST	EPROCS
ERR41:	EMSG$ <? DECtape switch on non-DECtape input device
>
	JRST	FILEX

ERR42:	EMSG$ <? DECtape switch on non-DECtape output device
>
	JRST	FILEX

ERR43:	MSG$ <% Zero switch on input device ignored
>
	POPJ	P,

ERR44:	EMSG$ <? Output device not a binary device>
	JRST	FILEX

ERR45:	EMSG$ <? Input device not a binary device>
	JRST	FILEX

ERR46:	EMSG$ <? ENTER failure >
	HRRZ	T,B
	PUSHJ	P,OCTPRT
	MSG$ < on output >
	PUSHJ	P,OUTLST
	PUSHJ	P,CONTQ		;/G?
	  JRST	FILEX
	JRST	EPROCS		;YES

ERR47:	EMSG$ <? Device >
	MOVE	T,ODEV
ERR47A:	PUSHJ	P,SIXOUT
	MSG$ < does not exist>
	JRST	FILEX
ERR48:	EMSG$ <? Device >
	MOVE	T,IDEV
	JRST	ERR47A
ERR49:	MSG$ <% Converting PDP-10 line-sequence numbers to regular text
>
	JRST	FORPA
ERR50:	EMSG$	<? Can't list disk directory
>
	JRST	FILEX
ERR51:	MSG$	<% No existing output scratch file, /Z assumed
>
	POPJ	P,
ERR52:	EMSG$	<? Can't specify pseudo tape unless /P /Q or /R for a DECtape
>
	JRST	FILEX
ERR53:	EMSG$	<? Can't convert between high and compressed files
>
	JRST	FILEX
ERR54:	EMSG$	<? Non-zero location below 400K writing high file
>
	JRST	FILEX
ERR55:	EMSG$	<? Incorrectly formatted .EXE file
>
	JRST	FILEX
ERR56:	EMSG$	<? Can't create .EXE file unless to or from disk
>
	JRST	FILEX
ERR57:	EMSG$	<? Too many descriptors for .EXE file
>
	JRST	FILEX
ERR58:	EMSG$	<? No high segment
>
	JRST	FILEX
ERR59:	EMSG$	<? Converting .EXE to .HGH requires disk or DECtape output
>
	JRST	FILEX
ERR60:	EMSG$	<? Converting .HGH to .EXE requires disk or DECtape input
a>
	JRST	FILEX
ERR61:	EMSG$	<? .LOW file missing
>
	JRST	FILEX
ERR62:	EMSG$	<? Input scratch tape does not exist
>
	JRST	FILEX
ERR63:	EMSG$	<? Command error--illegal separator
>
	JRST	FILEX
;ERR64 PRINT THAT EXTENSION IN T DIFFERS FROM EXTENSION IN OEXT

ERR64:	PUSH	P,T			;SAVE THE EXTENSION
	PUSH	P,T1			;EXTENSION TYPED
	MSG$	<% Extension >
	PUSHJ	P,SIXOUT		;PRINT T IN 6 BIT
	MSG$	< was chosen for EXE conversion >
	POP	P,T			;TYPED ONE
	PUSHJ	P,SIXOUT
	MSG$	< was specified>
	PUSHJ	P,CRLF			;A NEW LINE
	POP	P,T			;GET EXTENSION BACK
	POPJ	P,

ERR65:	EMSG$	<? No core available to create compressed file
>
	JRST	FILEX		;RESTART

ERR66:	MSG$	<% IOWD was truncated in a compressed file
>
	POPJ	P,

;ERR67 SHOULD ONLY BE SEEN BY FILEX MAINTAINERS

ERR67:	EMSG$	<? Storage for a compressed file has to be contiguous
>
	JRST	FILEX
CKSERR:	MSG$ <MAC file checksum error - continuing
>
	POPJ	P,
FILSYN:	EMSG$ <? Eh?
>
	POPJ	P,
BADSW:	PUSHJ	P,TYO
	MSG$ < is a bad switch
?>
	POPJ	P,
	SUBTTL	STORAGE

	XLIST		;LITERALS
	LIT
	LIST
	RELOC	0

LCOR:!
SWHELP:	BLOCK	1
SWLIST:	BLOCK	1
SWONLZ:	BLOCK	1
IDEV:	BLOCK	1
IPDEV:	BLOCK	1
IPPN:	BLOCK	1+LN$PPN
IFILE:	BLOCK	1
TIFILE:	BLOCK	1
IEXT:	BLOCK	1
TIEXT:	BLOCK	1
SCRNAM:	BLOCK	1
LASTBK:	BLOCK	1
SJFF:	BLOCK	1		;.JBFF FOR DISK DIRECTORY FOR WILDCARD LOOKUP
SJFF2:	BLOCK	1		;.JBFF FOR INPUT BUFFER BASE
SJFF3:	BLOCK	1		;.JBFF AS SEEN FOR OUTPUT BUFFER BASE
SJFF4:	BLOCK	1		;.JBFF AS SEEN BY RPBSCR RTN
BLKS:	BLOCK	1
ODEV:	BLOCK	1
OPDEV:	BLOCK	1
OFILE:	BLOCK	1
TOFILE:	BLOCK	1
OEXT:	BLOCK	1
FOEXT:	BLOCK	1
TOEXT:	BLOCK	1
OPPN:	BLOCK	1+LN$PPN
OPRT:	BLOCK	1
IDATE:	BLOCK	1
ODATE:	BLOCK	1
LENFIL:	BLOCK	1
IBLK:	BLOCK	1
OBLK:	BLOCK	1
OSW:	BLOCK	1
ISW:	BLOCK	1
OFILEX:	BLOCK	1
CNVSME:	BLOCK	1	;-1 IF SAVE INPUT DEVICE=OUT DEVICE
CNVWEO:	BLOCK	1	;-1 IF OUT EXT IS WILD ON A SAVE CONVERSION
EXEFLG:	BLOCK	1	;FLAG FOR EXE FILES
;STORAGE FOR MAKING COMPRESSED FILES
CACNT:	BLOCK	1	;CURRENT SIZE OF XBUF
ZCOUNT:	BLOCK	1	;RELATIVE COUNT OF ZEROS AND IOWDS
SAVCNT:	BLOCK	1	;# OF FREE LOCS IN COMPRESSED STORAGE
SAVLPG:	BLOCK	1	;FIRST ADDRESS AFTER COMPRESSED STORAGE
SAVFPG:	BLOCK	1	;FIRST ADDRESS AFTER DEFAULT COMPRESSED STORAGE
SAVMAX:	BLOCK	1	;1 ST NOT AVAIL. ADDR. + 1000 FOR COMPRESSED STORAGE
SAVPTR:	BLOCK	1	;POINTER TO STORE DATA INDIRECTLY IN COMPRESSED STORAGE
GETPTR:	BLOCK	1	;POINTER TO GET DATA FROM COMPRESSED STORAGE
OCA:	BLOCK	1
ICA:	BLOCK	1
RCA:	BLOCK	1
RPC:	BLOCK	1
RPOC:	BLOCK	1
RPOP:	BLOCK	1
RWC:	BLOCK	1
RW:	BLOCK	10
RTYP:	BLOCK	1
RCKS:	BLOCK	1
RPBPCT:	BLOCK	1
PDSCNT:	BLOCK	1
PDSPTR:	BLOCK	1
PDS:	BLOCK	2*LN$PDS
$DEV:	BLOCK	1
$SDEV:	BLOCK	1
$FILE:	BLOCK	1
$EXT:	BLOCK	1
$PPPN:	BLOCK	1+LN$PPN
$TPPN:	BLOCK	1+LN$PPN
$PPRT:	BLOCK	1
$TPRT:	BLOCK	1
$PSW:	BLOCK	1
$TSW:	BLOCK	1
$BRKC:	BLOCK	1
OFIRBK:	BLOCK	1
OFIRBP:	BLOCK	1
OFIL1V:	BLOCK	1		;NAME1 OF VEN OUT FILE IN R50VEN
OFIL2V:	BLOCK	1		;SECOND HALF NAME
OEXTV:	BLOCK	1		;AND EXT
RADIX:	BLOCK	1
SJBCOR:	BLOCK	1	;PLACE TO SAVE JOBCOR FOR EXE FILES
OTYPEX:	BLOCK	1
ITYPEX:	BLOCK	1
SRCHP:	BLOCK	1
EXTPTR:	BLOCK	1
SOEXT:	BLOCK	1		;SAVE OUT EXTENSION ON /C CONVERT
SRCHPM:	BLOCK	1
OFILEL:	BLOCK	1
IMACP:	BLOCK	1
OMACP:	BLOCK	1
$TID:	BLOCK	1
OTID:	BLOCK	1
SCRBK1:	BLOCK	1
EOJFLG:	BLOCK	1
FTEMP:	BLOCK	1
FCOUNT:	BLOCK	1
MFDPPN:	BLOCK	1		;PPN TO FIND UFD'S
MYPPN:	BLOCK	1		;PPN FOR ME ON DSK
FBMX:	BLOCK	1
FBMBLK:	BLOCK	1		;BLOCK NUMBER FOR BIT MAP FOR CURRENT OUTPUT FILE
PBMBKI:	BLOCK	1		;BLK NUMBER FOR MASTER BIT MAP ON VEN TAPE
PBMBKO:	BLOCK	1		;SAME FOR OUTPUT VEN TAPE
TBBLK:	BLOCK	1		;BLOCK WHICH IS CURRENTLY IN TBUF
OBVFLG:	BLOCK	1		;FLAG NEED OBVCOM OF PREV BLK
IOPSOC:	BLOCK	1
IOPSOP:	BLOCK	1
FOTXP1:	BLOCK	1
FOTXW1:	BLOCK	1
IOPSOB:	BLOCK	200
VBMAPO=IOPSOB			;ELEVEN OUTPUT MASTER BIT MAP IN SAME SPACE
FITXP1:	BLOCK	1
FITXP2:	BLOCK	1
FITXW1:	BLOCK	1
FITXW2:	BLOCK	1
XFILFQ:	BLOCK	1
SAVSTA:	BLOCK	1		;START ADDR WHEN MAKING A SAV FILE
DIRBKN:	BLOCK	1		;BLK NUMBER CURRENTLY IN DIRECT BUFFER
ODIBKN:	BLOCK	1		;BLK NUMBER CURRENTLY IN ODIREC BUFFER
VENPPI:	BLOCK	1		;PPN (UIC) OF INPUT VEN TAPE
VOUIC:	BLOCK	1		;VEN OUTPUT USER ID CODE
VWPEI:	BLOCK	1		;VEN WORDS PER ENTRY IN UFD ON INPUT TAPE
VWPEO:	BLOCK	1		;VEN WDS PER UFD ENTRY OUTPUT TAPE
VIFFIL:	BLOCK	1		;INPUT FILE NAME FOR CURRENT VEN DIRECT SLOT IN SIXBIT
VIFEXT:	BLOCK	1		;INPUT FILE EXT IN SIXBIT ...
VDIRB1:	BLOCK	1		;FIRST REAL DATA BLK OF VEN DIR
VDIRB2:	BLOCK	1		;SECOND .. ..
VODIB1:	BLOCK	1		;FIRST REAL DATA BLK OF OUTPUT VEN DIR
VODIB2:	BLOCK	1		;SECOND ...
VENFBN:	BLOCK	1		;FIRST BLOCK NUMBER (AFTER A LOOKUP)
VIPRT:	BLOCK	1		;OLD PROTECTION OF A PDP-11 FILE
VCONTG:	BLOCK	1		;LAST BLOCK NUMBER OF A 11 CONTIGUOUS FILE
FIFFLG:	BLOCK	1		;FLAG SET TO INDICATE THAT THE LAST CHARACTER
				;OF A PDP-15 ASCI FILE WAS SEEN(CR)
RPAVC1:	BLOCK	1		;FLAG FOR WHICH BYTE OF WORD
RPAVW1:	BLOCK	1		;WORD HELD BETWEEN TWO RPA'S
LSNFLG:	BLOCK	1		;LINE-SEQUENCE-NUMBER-SEEN FLAG
DIRIOW:	BLOCK	1		;IOWD 200,DIRECT
	BLOCK	1
DIRECT:	BLOCK	200
ODIIOW:	BLOCK	1		;IOWD 200,ODIREC
	BLOCK	1
ODIREC:	BLOCK	200

WIOL:	BLOCK	1		;IOWD 200,WBUF
	BLOCK	1
WBUF:	BLOCK	200
RBUF:	BLOCK	200

IHED2:	BLOCK	3
OHED2:	BLOCK	3

TIOL:	BLOCK	1		;IOWD 200,TBUF
	BLOCK	1
;DO NOT SEPARATE - NEEDED FOR BLOCK ZERO READER
TXIOL:	BLOCK	1		;IOWD 400,TBUF
	BLOCK	1
TBUF:	BLOCK	200
XBUF:	BLOCK	1000
;END DO NOT SEPARATE
FBMBUF:	BLOCK	200
EVSPOS=FBMBUF+37		;POSITION IN THE DIRECTORY BLOCK OF THIS SLOT
EVSLOT=FBMBUF+40		;SLOT FOR OUTPUT VEN ENTRY
EVSN1=EVSLOT+0			;NAME FIRST THREE CHARS
EVSN2=EVSLOT+1			;SECOND THREE
EVSEXT=EVSLOT+2			;EXTENSION
EVSDAT=EVSLOT+3			;DATE
EVSFBN=EVSLOT+5			;FIRST BLOCK IN FILE
EVSLEN=EVSLOT+6			;NUMBER OF BLOCKS
EVSLAS=EVSLOT+7			;LAST BLOCK
EVSPRT=EVSLOT+10		;PROTECTION CODE
CORIOW:	BLOCK	1
	BLOCK	1

ENTBLK:	BLOCK	.RBEST+1
IHED:	BLOCK	3
OHED:	BLOCK	3
UHED:	BLOCK	3

PDL:	BLOCK	LN$PDL+1
ELCOR==.-1

	END	FILEX		;END OF FILEX