perm filename FILEX.MAC[JCR,GUE] blob sn#078239 filedate 1973-12-30 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00121 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00011 00002	TITLE FILEX - GENERAL FILE TRANSFER ROUTINE - V15(4)
C00013 00003	LEFT HALF FLAGS
C00016 00004	EXTERN .JBFF,.JBREL
C00018 00005	START OF FILEX
C00021 00006	BEG0A:	TRNN T,1←14		BINARY SUPPORTED?
C00023 00007	BEG1:	MOVSI T1,0		SEE WHAT OUTPUT FORMAT TAPE IS, IF TAPE
C00026 00008	REINP:	TRZ F,R.IN		INITIALIZE THIS FLAG
C00029 00009	ASKI2:	CAIN T,(SIXBIT /*/)	WILD?
C00031 00010	HERE TO READ AND LIST A DIRECTORY BLOCK
C00034 00011	SEE IF WANT TO PUT TAPE ON SCRATCH FILE
C00037 00012	SCR1:	MOVEI A,17		GET DUMP MODE DISK FOR SCRATCH
C00039 00013	SCRRL:	CAMLE B,LASTBK		STILL SOME TO READ?
C00041 00014	TYPDIQ:	MOVE T,ISW		GET INPUT SWITCHES
C00043 00015	PDP-10 FORMAT DTA DIRECTORY LISTER
C00046 00016	OLD PDP6 FORMAT TAPE DIRECTORY LISTER
C00048 00017	PROJECT MAC DIRECTORY LISTER
C00050 00018		PUSHJ P,BLKCMC		COUNT BLOCKS IN THIS FILE
C00053 00019	PDP15 DIRECTORY LISTER
C00054 00020	DIRFL:	SKIPN T,DIRECT+20(C)
C00056 00021	PDP-11 DIRECTORY LISTER
C00058 00022	DIRVNN:	MOVE T,VWPEI		SEE IF NEXT FILE EXISTS
C00060 00023	TWO SUBRS TO GET WORD FROM PDP11 DIRECTORY.
C00061 00024	OUTASK:	TRNN F,R.OUT		ANY OUTPUT REQUESTED?
C00064 00025		HLLZS B			CLEAN UP AC'S
C00066 00026	OUTZR1:	TLNE F,L.DTVO		ELEVEN?
C00068 00027	OUTZRV:	SKIPN OPPN		OUTPUT PPN SPECIFIED?
C00071 00028	DAT104:	XWD 0,1			LINK,NUMBER OF PBM
C00074 00029	SELFIL:	TRNN F,R.IN		ANYTHING WANTED?
C00077 00030	SELFO:	SKIPL C,SRCHP		GET OFFSET INTO SIX DIRECTORY
C00079 00031	SELFT:	SKIPGE C,SRCHP		POINTER INTO TEN DIRECTORY
C00081 00032	SELFIF:	SKIPGE C,SRCHP		FILE INDEX
C00083 00033	SELFV:	SKIPGE C,SRCHP		STARTED?
C00085 00034	SELFVR:	PUSH P,C		SAVE INDEX
C00088 00035	SELFNT:	TLNE F,L.DSKI		NON TAPE. DISK?
C00091 00036	SELFD1:	PUSHJ P,URPB		READ A WORD FROM UFD
C00093 00037	SELFNW:	MOVE A,IFILE		HERE WHEN NEITHER WILD NOR DTA
C00095 00038	SELFW1:	MOVE D,IPPN		NEED A LOOKUP. GET DIRECTORY
C00098 00039	ENTR:	SETZM FOEXT		CLEAR FORCED OUTPUT EXTENSION
C00101 00040	ENTTEN:	TLNE F,L.SCRO		SCRATCH OUTPUT FILE?
C00104 00041	ENTTNW:
C00106 00042	ENTSIX:	MOVEI A,117		GET THE OUTPUT TAPE IN KLUDGE MODE
C00109 00043	ENTER ROUTINE FOR MAC TAPES
C00111 00044	DELFMA:	MOVE C,T		EXTENSION FILE
C00113 00045	ENTER ROUTINE FOR PDP11 TAPES
C00116 00046		SETZM FBMX		CLEAR CELL FOR FREE FILE NUMBER DURING COMPARE
C00119 00047	SUBR TO GET OUT DIR ENTRY NAME1, NAME2, EXT INTO EVSLOT
C00122 00048	EVCMP1:	JUMPN T,CPOPJ1		IF IN USE, RETURN
C00123 00049	ENTFIF:	MOVEI A,117		GET OUTPUT TAPE
C00126 00050		MOVEI T1,0		INDEX FOR MASTER BIT MAP
C00129 00051	EPROCS:	TLNN F,L.MFI+L.WEI+L.WFI	MULT INPUTS?
C00132 00052	SCOB:	MOVEI B,1		START AT BLK 1 (0 DONE ABOVE)
C00134 00053	RPB:	MOVE T1,ITYPEX		READ A WORD FROM CORRECT READ ROUTINE
C00135 00054	RPBTEN:	TLNN F,L.SCRI		READING FROM A SCRATCH FILE?
C00137 00055	RPBSIX:	SOSLE IHED+2		ANY LEFT IN TEMP BUFFER?
C00140 00056	RPBMAC:	SOSLE IHED+2		ANY LEFT IN TEMP BUFFER?
C00142 00057	RPBMFW:
C00144 00058	RPBFIF:	SOSLE IHED+2
C00146 00059	RPBVEN:	SOSLE IHED+2
C00149 00060	ROUTINE TO GET A BLK FROM SCRATCH FILE
C00152 00061	PPB:	MOVE T1,OTYPEX		GET OUTPUT TYPE INDEX
C00154 00062	PPBTL1:	ILDB T,B		GET A DIR BYTE
C00157 00063	PPBSIX:	SOSLE OHED+2		ROOM LEFT IN WBUF?
C00160 00064	PPBMAC:	SOSLE OHED+2		ROOM IN WBUF?
C00163 00065	PPBML2:	ADD B,[XWD 050000,0]	BACK UP A BYTE
C00165 00066	PPBFIF:	SKIPLE OHED+2		ROOM IN CURRENT BUFFER?
C00168 00067	PPBFL1:	ILDB T,B		GET A MASTER DIRECTORY BIT
C00171 00068	PPAVEN:				USE SAME TAG FOR BOTH
C00174 00069	PPBV2:	MOVE A,OBLK
C00177 00070	CLOSE ROUTINES
C00180 00071	PDP-15 FORMAT CLOSE ROUTINE
C00182 00072	CLSV1:	MOVE T,[XWD VBMAPO,WBUF]	WRITE THE MASTER BIT MAP BLK
C00185 00073	PDP6 FORMAT CLOSE ROUTINE
C00187 00074	DUMB ROUTINE TO SELECT THE CURRENT FILE TYPE.
C00189 00075	SWITCH TABLE - INDEX BY LETTER FROM A
C00191 00076	DISPATCH TABLE FOR TYPE OF TRANSFER OPERATION
C00192 00077	TRANSFER ROUTINES
C00194 00078	HERE WHEN I/O IS FROM PDP15 TAPE TO 36BIT OUTPUT
C00197 00079	REPEAT 4,<
C00198 00080	XFRFB:	MOVEM W,FTEMP
C00200 00081	PIVASC:	SETZM FITXW1		ASCII. BORROW PDP FIFTEEN ROUTINE
C00202 00082	HERE WHEN OUTPUT TAPE IS PDP FIFTEEN STYLE. INPUT MAY BE TOO?
C00204 00083	POFTE1:	MOVEI CKS,0
C00205 00084	PROFAB:	TLZ F,L.6DO
C00206 00085	POFEBB:	HRRZ T,IOPSOP
C00207 00086	HERE WHEN OUTPUT TAPE IS PDP ELEVEN STYLE. INPUT MAY BE TOO?
C00210 00087	PROVI:	PUSHJ P,RPB		GET 36 BITS
C00212 00088	XFRCD:	MOVEI CA,JOBSV6+1		OUTPUT ADDRESS AT START
C00214 00089	XFRCS:	PUSHJ P,OUTMRL		OUTPUT MAC RIM LOADER
C00216 00090	XFRDC:	MOVEI T,JOBSV6+1	6 TO TEN DMP TO SAV
C00218 00091	XECOBK:	MOVN W,CA		OUTPUT XBUF BLOCK
C00220 00092	XFRDS:	MOVEI T,JOBSV6+1	DUMP TO SBLK
C00222 00093	XESOBK:	MOVN W,CA		ROUTINE TO OUTPUT BLOCK OF SBLK
C00224 00094	OUTMRL:	MOVE CA,[XWD -MRLL,MRL]	POINTER TO LOADER
C00226 00095	XFRSC:	SETOM OCA		SBLK TO COMPRESSED
C00228 00096	XFRSD:	MOVEI CA,JOBSV6+1	FIRST ADDRESS WANTED
C00231 00097	FILE SPECIFIER INPUT ROUTINE
C00233 00098	FILS1:	MOVEM W,.DEV		SAVE DEVICE
C00234 00099	FILSS:	TRO F,R.SW		PARENS
C00236 00100	OCTIN:	MOVEI N,0
C00238 00101	SIXDOT:	PUSHJ P,SIXOUT		OUTPUT SIXBIT
C00239 00102	DATOUT:	JUMPLE A,NODATE
C00240 00103	RADIX FIFTY CONVERTER FOR PDP-11 TAPE DIRECTORIES
C00242 00104	AND THE REVERSE CONVERSION. CALL WITH 3 SIXBIT CHARS IN RH OF T,
C00244 00105	DECP4S:	CAIGE T,↑D1000
C00246 00106	DATVT:	JUMPE T,CPOPJ
C00248 00107	VENDAT:	JUMPG T,VDATE1		BLANK?
C00250 00108	MONTAB:	ASCII /-JAN--FEB--MAR--APR--MAY--JUN-/
C00252 00109	OBVCMR:	PUSHJ P,MOVRT
C00255 00110	OUTPUT WBUF TO BLOCK IN OBLK, ON DSK SCRATCH OR DTA AS APPROPRIATE
C00258 00111	WBK0:	PUSH P,A		SAVE WORK AC'S
C00260 00112	ERROR ROUTINES
C00262 00113	ERR16:	TRNE F,R.ABC		ALWAYS BAD CKSM?
C00264 00114	ERR28:	PUSH P,XBUF+3		SAVE ERROR CODE
C00266 00115	ERR41:	.EMSG <? DECTAPE SWITCH ON NON-DECTAPE INPUT DEVICE
C00268 00116	HELP:	MOVEI W,HELPM
C00272 00117	TEMPORARIES
C00274 00118	OTYPEX:	0
C00277 00119	DIRIOW:	IOWD 200,DIRECT
C00279 00120	CORIOW:	0
C00280 00121	
C00281 ENDMK
C⊗;
TITLE FILEX - GENERAL FILE TRANSFER ROUTINE - V15(4)
SUBTTL RC CLEMENTS - 19 OCT 71
VWHO==0			;WHO EDITED FILEX LAST
VMAJ==15		;MAJOR VERSION NUMBER
VMIN==0			;MINOR VERSION NUMBER
VEDIT==4		;EDIT NUMBER

LOC 137
EXP <VWHO>B2+<VMAJ>B11+<VMIN>B17+VEDIT
RELOC

;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		;UFD FOR * ON DSK


;ASSEMBLY PARAMETERS

IFNDEF	SYSPRT,<SYSPRT==155>	;PROTECTION FOR SYS: (EXCEPT *.SYS)
IFNDEF	SSSPRT,<SSSPRT==157>	;PROTECTION FOR SYS:*.SYS
;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.DTMO==4000	;OUTPUT DTA IS MAC FORMAT
L.DTOO==10000	;OUTPUT DTA IS OLD SIX FORMAT
L.BEO==20000	;BLANK EXTENSION ON OUTPUT
L.SCRO==40000	;SCRATCH FILE FOR OUTPUT TAPE
L.DTFO==100000	;DECTAPE FIFTEEN OUTPUT
L.DTVO==200000	;DECTAPE ELEVEN OUTPUT
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.LEVD==40	;THIS SYS HAS LEV D DISK SERVICE
R.GO==100	;/G IN EFFECT
R.GOS==200	;/G AND ERROR MSG ALREADY OUTPUT
R.OUT==400	;OUTPUT FILE NON-BLANK
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.LST==40000	;SOME REQUEST HAD /L
R.SYS==100000	;OUTPUT DEVICE IS SYS: OR DSK:[SYSPPN]
R.6DI==200000	;INPUT FILE IS SIX FORMAT DUMP (200W/B)
R.MFI2==400000	;MULT FILE INPUT SO DON'T REPEAT OUTPUT OPENS
EXTERN .JBFF,.JBREL

;CALLI ADDRESSES

CI.RES==0		;RESET
CI.DCH==4		;DEVCHR
CI.UTC==13		;ZERO DECTAPE
CI.DAT==14		;GET TODAY'S DATE
CI.PPN==24		;MY PROJ-PROG
CI.GET==41		;GETTAB
CI.PJO==30		;JOB NUMBER
CI.COR==11		;CORE

;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

;MISC PARAMETERS

DVDSK==200000		;DISK IN DEVCHR
DVDTA==100		;DTA IN DEVCHR
JOBSV6==73		;RH OF IOWD FOR PDP6 DMP FILE
.JOBSA==120		;JOBSA TO GET START ADDRESS FROM FILE
S.DSK==400000		;FTDISK IN LH OF STATES
.RBSTS==17		;WORD OF STATUS IN EXT LOOKUP
.RPABC==1B22		;ALWAYS BAD CHECKSUM BIT IN .RBSTS

DEFINE .MSG (M) <
XLIST
	MOVEI W,[ASCIZ \M\]
	PUSHJ P,MSG
	LIST
>
DEFINE .EMSG (M) <
XLIST
	TTCALL 11,0
	MOVEI W,[ASCIZ \M\]
	PUSHJ P,MSG
	LIST
>
;START OF FILEX

FILEX:	JFCL			;JUST IN CASE OF CCL ENTRY
	CALLI CI.RES		;CLEAR THE WORLD
	MOVEI F,0		;CLEAR ALL FLAGS
	MOVE P,PDP		;SET UP STACK
	SETZM IDEV		;BECAUSE OF RE-USE LOGIC
	SETZM ODEV		; ..
	SETZM	.PPPN		;CLEAR PERMANENT STUFF
	SETZM	.PPRT		;  ..
	SETZM	.PSW		;  ..
	SETZM	EOJFLG		;CLEAR FINAL PASS FLAG
	MOVE T,[17,,11]		;GET STATES FROM SYSTEM
	CALLI T,CI.GET		;GET STATES FROM SYSTEM
	  MOVEI T,0		;NO GETTAB
	MOVEM T,STATES		;SAVE IN CORE
	TLNE T,(<7B9>)		;LEVL D OR ABOVE?
	TRO F,R.LEVD		;YES.
	MOVEI	T,16		;GET MFD PPN
	GETTAB	T,
	  MOVE	T,[1,,1]	;IN CASE OF LEV.C
	MOVEM	T,MFDPPN
	MOVE	T,[1,,16]	;GET SYS PPN
	GETTAB	T,
	  MOVE	T,[1,,1]	;IN CASE OF LEV.C
	MOVEM	T,SYSPPN
	MOVEI W,[ASCIZ /
*/]
	PUSHJ P,MSG		;TYPE ASTERISK
BEG0:	PUSHJ P,FILSPC		;GET FILE FOR OUTPUT
	  JRST FILEX		;TRY AGAIN - ERROR RETURN
	MOVE T,.TSW		;OUTPUT SWITCHES
	TRNE T,SW.H		;HELP SWITCH?
	JRST HELP		;YES. GO TYPE HELP MSG
	MOVE T,.FILE		;ANY FILE SPECIFIED AT ALL?
	IOR T,.EXT		; ..
	IOR T,.DEV		;HOW ABOUT A DEVICE?
	SKIPE T			;ANYTHING?
	TRO F,R.OUT		;YES. ELSE NO OUTPUT
	SKIPN T,.DEV		;ANY DEVICE SPECIFIED?
	MOVSI T,(SIXBIT /DSK/)	;NO. USE DISK
	MOVEM T,ODEV		;SAVE OUTPUT DEVICE
	MOVE	A,T		;SEE WHICH DIRECTORY FOR THIS DEVICE
;NEXT INSTRUCTION REMOVED BY RPH 12-17-73 ***** NOT IMPLEMENTED AT STANFORD
;	DEVPPN	A,
	  CAME	T,[SIXBIT /SYS/]  ;SEE IF NAME IS "SYS:"
	CAMN	A,SYSPPN	;COMPARE WITH SYS PPN
	TRO	F,R.SYS		;SET SYS BIT
	CALLI T,CI.DCH		;GET OUT DEV CHARACTERISTICS
	JUMPE T,ERR47		;ANY SUCH THING?
	TLNE T,DVDTA		;DECTAPE?
	TLO F,L.DTO		;YES. REMEMBER IT
BEG0A:	TRNN T,1←14		;BINARY SUPPORTED?
	JRST ERR44		;NO. ERROR
	MOVS T,.FILE		;GET FILE NAME
	CAIN T,(SIXBIT /*/)	;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,(SIXBIT /*/)	;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
	MOVE T,.TPPN		;GET PROJ PROG NUMBER IF ANY
	MOVEM T,OPPN		;SAVE IT.
	CAMN	T,SYSPPN	;COMPARE WITH SYS'S NUMBER
	TRO	F,R.SYS		;MATCH--SET SYS BIT
	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 ERR42		;YES. COMPLAIN
	TRNE T,SW.L		;SEE IF /L
	TRO F,R.LST		;YES--REMEMBER FOR END OF JOB
BEG1:	MOVSI T1,0		;SEE WHAT OUTPUT FORMAT TAPE IS, IF TAPE
	TRNE T,SW.M		;MAC FORMAT REQUESTED?
	MOVSI T1,L.DTMO		;YES.
	TRNE T,SW.O		;OLD (SIX) FORMAT REQUESTED?
	MOVSI T1,L.DTOO		;YES.
	TRNE T,SW.F		;FIFTEEN REQUESTED?
	MOVSI T1,L.DTFO		;YES
	TRNE T,SW.V		;ELEVEN TAPE REQUEST?
	MOVSI T1,L.DTVO		;YES.
	IOR F,T1		;SET FLAG IF ANY
	MOVEI T,TYPTEN		;ASSUME PDP10 TAPE
	TLNE F,L.DTOO		;OLD DECTAPE OUTPUT?
	MOVEI T,TYPSIX		;YES.
	TLNE F,L.DTMO		;MAC DECTAPE OUTPUT?
	MOVEI T,TYPMAC		;YES.
	TLNE F,L.DTFO		;FIFTEEN OUTPUT?
	MOVEI T,TYPFIF		;YES - GET TYPE INDEX
	TLNE F,L.DTVO		;ELEVEN OUTPUT?
	MOVEI T,TYPVEN		;YES
	TLNN F,L.DTO		;UNLESS NON-DECTAPE
	MOVEI T,TYPNDT		;IN WHICH CASE SAVE THAT TYPE
	MOVEM T,OTYPEX		;SAVE TYPE OF OUTPUT
	CALLI T,CI.PJO		;MAKE TEMP FILE NAME
	MOVEI N,3
SCRL1:	IDIVI T,12		;TIME-HONORED NAME MAKER
	ADDI T1,20		;DECIMAL SIXBIT OF JOB NUMBER
	LSHC T1,-6		;TO T2
	SOJG N,SCRL1		;THREE DIGITS
	HRRI T2,(SIXBIT /XFR/)	;NNNXFR.TMP IS NAME
	MOVEM T2,SCRNAM		;SAVE IT.

;NOW GET AN INPUT FILE SPECIFIER

ASKINP:	MOVE T,.BRKC		;SEE IF CORRECT FORMAT COMMAND
	CAIE T,"←"		;SEPARATOR MUST BE ONE OF THESE
	CAIN T,"="		; ..
	SKIPA			;OK
	JRST ERR22		;NO GOOD.
	SETZM .PSW		;THESE DONT CARRY OVER THE ARROW
	SETZM .PPRT		; ..
	SETZM .PPPN		; ..
	SETZM IFILE		;CLEAR INPUT FILE NAME
	SETZM IEXT		;AND EXT IN CASE NULL INPUT.
	MOVE T,.JBFF		;REMEMBER .JBFF BEFORE ANY FILES
	MOVEM T,SJFF		; FOR THE UFD 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
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.
REINP1:	SKIPE	.TPRT		;CHECK FOR PROTECTION SPECIFIED
	JRST	ERR30		;YES--ERROR
	SKIPE	.TID		;CHECK FOR TAPE ID SPECIFIED
	JRST	ERR31		;YES--ERROR
	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
	SKIPE T,.DEV		;ANY DEVICE SPECIFIED?
	JRST ASKI1		;YES.
	SKIPN T,IDEV		;ANY PREVIOUS DEVICES?
	MOVSI T,(SIXBIT /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.
	CALLI T,CI.DCH		;GET DEVICE CHAR BITS
	JUMPE T,ERR48		;ANY SUCH THING?
	TLNE T,DVDTA		;DECTAPE?
	TLO F,L.DTI		;YES.
	TLNE T,DVDSK		;DISK?
	TLO F,L.DSKI		;YES.
	TRNN T,1←14		;BINARY SUPPORTED?
	JRST ERR45		;NO. 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,(SIXBIT /*/)	;NO. ASSUME HE MEANS WILD.
	CAIN T,(SIXBIT /*/)	;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,(SIXBIT /*/)	;NO. USE WILD.
ASKI2:	CAIN T,(SIXBIT /*/)	;WILD?
	TLO F,L.WEI		;YES. REMEMBER THAT.
	MOVSM T,IEXT		;SAVE INPUT EXTENSION
	MOVE T,.TPPN		;GET INPUT P-PN
	MOVEM T,IPPN		; ..
	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 ERR41		;YES. COMPLAIN.
	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.
	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
	TRNE T,SW.Z		;ZERO SWITCH ON INPUT?
	PUSHJ P,ERR43		;YES. NON-FATAL ERROR.
	TLNN F,L.DTI		;IS INPUT A TAPE?
	JRST ASKINX		;NO. SKIP DIRECTORY STUFF
;HERE TO READ AND LIST A DIRECTORY BLOCK
GETDIR:	MOVEI N,144		;YES. ASSUME DEC FORMAT PDP10
	TRNE T,SW.O		;OLD (SIX) TAPE?
	MOVEI N,1		;YES. DIR BLK IS 1
	TRNE T,SW.M!SW.F!SW.V	;PDP-11,PDP15 OR MAC FORMAT?
	MOVEI N,100		;YES. DIR BLK IS 100 OCTAL
	MOVEM N,DIRBKN		;SAVE NUMBER WHICH IS IN DIRECT BUFFER
	RELEAS INF,0		;CLEAR ANY PREVIOUS USE OF CHANNEL
	MOVEI A,117		;GET TAPE IN KLUDGE MODE
	MOVE B,IDEV		; ..
	MOVEI C,IHED2		; ..
	OPEN INF,A		; ..
	 JRST ERR1		;NOT THERE.
	MOVEI T,0(N)		;BLOCK NUMBER TO READ
	PUSHJ P,RBTDIR		;READ INTO DIRECTORY BUFFER
	  JRST ERR2		;ERROR READING.
ASKINX:	MOVE T,ISW		;GET INPUT SWITCHES
	MOVEI T1,TYPTEN		;GET TYPE INDEX
	TRNE T,SW.O		;OLD FORMAT?
	MOVEI T1,TYPSIX		;YES GET TYPE CODE
	TRNE T,SW.M		;MAC FORMAT?
	MOVEI T1,TYPMAC		;YES. GET TYPE CODE
	TRNE T,SW.F		;PDP15 FORMAT?
	MOVEI T1,TYPFIF		;YES
	TRNE T,SW.V		;ELEVEN SWITCH?
	MOVEI T1,TYPVEN		;YES. SET TYPE
	TLNN F,L.DTI		;THIS IS A DECTAPE, ISNT IT?
	MOVEI T1,TYPNDT		;NO. GET NOT DECTAPE CODE
	MOVEM T1,ITYPEX		;SAVE TYPE INDEX
	CAIE T1,TYPVEN		;PDP-11 TAPE?
	JRST GETDIX		;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
	USETI INF,0(T)		;READ IT INTO DIRECT BUFFER
	INPUT INF,DIRIOW
	STATZ INF,740000
	  JRST ERR2
	MOVEM T,DIRBKN		;REMEMBER WHAT'S IN DIRECT
	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
	USETI INF,0(T)		;READ IT INTO DIRECT. THIS IS REAL STUFF
	INPUT INF,DIRIOW
	STATZ INF,740000
	  JRST ERR2
	MOVEM T,DIRBKN		;REMEMBER WHAT BLK THIS IS
	MOVEM T,VDIRB1		;FIRST REAL DATA BLOCK
	HLRZ T,DIRECT
	MOVEM T,VDIRB2		;AND SECOND ONE
GETDIX:
;SEE IF WANT TO PUT TAPE ON SCRATCH FILE

SCRATQ:	SKIPN	EOJFLG		;IS THIS THE END-OF-JOB PASS?
	TLNN F,L.DTI		;INPUT A TAPE?
	JRST TYPDIQ		;NO.
	MOVE T,ISW		;GET SWITCHES
	TRNN T,SW.P+SW.Q+SW.R	;WANT QUICK MODE?
	JRST TYPDIQ		;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,2000(T)		;ASK FOR ANOTHER K
	CALLI T,CI.COR		; ..
	  JRST SCRB		;NOT THERE, USE WHAT WE HAVE.
	JRST SCRL2		;GOT IT. RECOMPUTE BLOCKS.
SCRB:	MOVEI T1,1101		;ASSUME TEN TAPE. READ 1101 BLKS
	MOVE T,ITYPEX		;GET TYPE OF TAPE
	CAIN T,TYPSIX		;IF SIX TAPE,
	HLRZ T1,DIRECT+0	;GET LENGTH OF USED TAPE
	CAIN T,TYPMAC		;FOR MAC, READ A LITTLE LESS TAPE
	MOVEI T1,1067		; ..
	CAIN T,TYPFIF		;PDP15 TAPE?
	MOVEI T1,1077		;YES. USE BLKS 0-1077
	CAIN T,TYPVEN		;PDP ELEVEN TAPE?
	MOVEI T1,1077		;YES. BLKS 1-1077
	CAIG T1,1101		;RANGE CHECK SIX TAPE
	CAIGE T1,1		; ..
	JRST ERR5		;NO GOOD 6 DIRECTORY
	MOVEM T1,LASTBK		;SAVE FOR LATER
SCR1:	MOVEI A,17		;GET DUMP MODE DISK FOR SCRATCH
	MOVSI B,(SIXBIT /DSK/)	; ..
	MOVEI C,0		;NO BUFFERS
	OPEN SCRF,A		;ASK FOR DISK
	  JRST ERR3		;NOT THERE.
	MOVE A,SCRNAM		;GET THE SCRATCH FILE NAME
	MOVSI B,(SIXBIT /TMP/)	;AND EXT
	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,0		;CLOSE FILE
	RENAME SCRF,A		;DELETE FILE
	JFCL			;IGNORE FAIL RETURN, ENTER WILL PROB FAIL

SCRA:	CLOSE SCRF,0		;CLOSE FILE FROM LOOKUP
	MOVE A,SCRNAM		;NOW WRITE SCRATCH FILE
	MOVSI B,(SIXBIT /TMP/)	; ..
	SETZB C,D		; ..
	ENTER SCRF,A		;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
	OUTPUT SCRF,TIOL	;WRITE BLOCK 0 ON DISK FILE
	MOVEI B,1		;CURRENT BLOCK IS NOW BLK 1
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,0(B)		;SET FOR INPUT BLOCK
	INPUT INF,CORIOW		;READ TAPE
	STATZ INF,740000		;ANY ERRORS?
	PUSHJ P,ERR6		;YES. SEE IF /G
	OUTPUT SCRF,CORIOW	;NOW WRITE ON DISK
	STATZ SCRF,760000	;CHECK FOR ERRORS ON DISK
	PUSHJ P,ERR7		;ERR. SEE IF /G
	ADD B,D			;UPDATE NEXT BLOCK TO READ
	JRST SCRRL		;AND SEE IF DONE YET.

SCREND:	MTAPE INF,1		;DONE WITH DTA. REWIND IT.
	CLOSE SCRF,0		;CLOSE SCRATCH FILE
	MOVE A,SCRNAM		;NOW SET TO READ SCRATCH FILE
	MOVSI B,(SIXBIT /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
TYPDIQ:	MOVE T,ISW		;GET INPUT SWITCHES
	TRNN T,SW.L		;YES. WANT A DIRECTORY LISTING?
	  JRST OUTASK		;NO DIRECTORY
	TRO	F,R.LST		;FLAG /L FOR LATER
	TLNN	F,L.DTI		;IS THIS A DECTAPE?
	JRST	OUTASK		;NO--SKIP THE DIRECTORY
	PUSHJ P,CRLF
	PUSHJ P,CRLF		;SPACE TO DIRECTORY ON PAPER
	MOVEI T1,DIRTEN		;ASSUME TEN FORMAT TYPER
	TRNE T,SW.M		;MAC SWITCH?
	MOVEI T1,DIRMAC		;YES. THAT ROUTINE ADDRESS
	TRNE T,SW.O		;OLD SIX FORMAT?
	MOVEI T1,DIRSIX		;YES. THAT ROUTINE ADDRESS
	TRNE T,SW.F		;PDP15 FORMAT?
	MOVEI T1,DIRFIF		;YES. THAT ROUTINE ADDR
	TRNE T,SW.V		;ELEVEN TAPE?
	MOVEI T1,DIRVEN		;YES. THAT ROUTINE
	PUSHJ P,0(T1)		;LIST THE DIRECTORY
	SKIPE	EOJFLG		;TEST FOR END-OF-JOB PASS
	JRST	EOJ1		;YES--GO BACK TO EOJ PROCESSING
	JRST OUTASK
;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,SIXOUT		;YES. TYPE NAME.
	HLLZ T,DIRECT+150(C)	;GET EXTENSION
	JUMPE T,DIRTN2		;NONE.
	LSH T,-6		;PUT IN A DOT
	TLO T,<"."-40>B23	; ..
DIRTN2:	PUSHJ P,SIXOUT		;OUTPUT DIRECTORY EXTENSION
	PUSHJ P,BLKC10		;COUNT BLOCKS IN THIS FILE
	PUSHJ P,DECPR2		;OUTPUT ANSWER
	PUSHJ P,TAB		;TAB TO DATE COLUMN
	LDB A,[POINT 12,DIRECT+150(C),35]	;GET DATE.
	PUSHJ P,DATOUT		;OUTPUT DATE
	PUSHJ P,CRLF		;AND RETURN
DIRTNN:	CAIGE C,26		;DONE ALL FILES?
	AOJA C,DIRTNL		;NO. DO ANOTHER.
	JRST CRLF		;EXTRA LINE AT END
;OLD PDP6 FORMAT TAPE DIRECTORY LISTER

DIRSIX:	HLRZ T,DIRECT		;GET LAST BLOCK USED
	MOVNS T
	ADDI T,1101		;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,SIXOUT		;OUTPUT NAME
	HLLZ T,DIRECT+1(C)	;GET EXTENSION
	LSH T,-6		;MAKE ROOM FOR DOT
	TLO T,<"."-40>B23	;PUT IN DOT
	PUSHJ P,SIXOUT		;OUTPUT EXTENSION
	PUSHJ P,TAB		;OVER TO DATE FIELD
	LDB A,[POINT 12,DIRECT+2(C),35]	;GET 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
	JRST CRLF		;SPACE UP AND RETURN

DIRSXE:	MOVEI W,[ASCIZ /? BAD FORMAT IN PDP6 DIRECTORY
/]
	JRST 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
	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,0(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.
	JRST 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,1101		;HOW MANY TO COUNT
BLKCNT:	MOVEI T,0		;INITIALIZE COUNT
BLKCL:	ILDB A,B		;GET A BYTE
	CAIN A,0(C)		;IS THIS BYTE IN THE DESIRED FILE?
	ADDI T,1		;YES. COUNT IT.
	SOJG T1,BLKCL		;LOOP TO NEXT BYTE
	POPJ P,0		;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
				;FALL INTO LOOP
DIRFL:	SKIPN T,DIRECT+20(C)
	JRST DIRFX
	PUSHJ P,TRMSIX		;CONVERT TO SIXBIT
	PUSHJ P,SIXOUT
	PUSHJ P,SPACE
	HLLZ T,DIRECT+21(C)
	PUSHJ P,TRMSIX		;CONVERT TO SIXBIT
	PUSHJ P,SIXOUT
	PUSHJ P,SPACE
	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
	JRST 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
	PUSHJ P,SPACE2
	MOVEI T,3
	PUSHJ P,GTVDWD		;GET THE DATE
	ANDI T,7777		;DATE FIELD
	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
DIRVNN:	MOVE T,VWPEI		;SEE IF NEXT FILE EXISTS
	ADDI C,0(T)
	MOVE T1,C
	ADDI T1,0(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,0(T1)
	ADDI T,1
	LSH T2,-1
	SOJG N,DIRVL3
	PUSHJ P,DECP4S
	.MSG <
FREE FILES: >
	MOVE T,VENFBN
	PUSHJ P,DECP4S
	JRST 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,0(C)
	ROT T1,-1
	MOVE T,ODIREC(T1)
	SKIPL T1
	MOVS T,ODIREC(T1)
	ANDI T,177777
	POPJ P,0

GTVDWD:	MOVEI T1,1(T)
	ADDI T1,0(C)
	ROT T1,-1
	MOVE T,DIRECT(T1)
	SKIPL T1
	MOVS T,DIRECT(T1)
	ANDI T,177777
	POPJ P,0
OUTASK:	TRNN F,R.OUT		;ANY OUTPUT REQUESTED?
	JRST EOJ		;NO. QUIT HERE.
	TRZE F,R.MFI2		;REPEATING AFTER COMMA?
	JRST SELFIL		;YES. OUTPUT ALREADY SET UP
	TLNN F,L.DTO		;IS OUTPUT A DECTAPE?
	JRST OUTASX		;NO. SKIP THIS SECTION
	TLZ F,L.DTMO+L.DTOO+L.DTFO+L.DTVO+L.SCRO	;PREPARE THESE FLAGS
	MOVE T,OSW		;GET OUTPUT FILE SWITCHES
	TRNE T,SW.O		;OLD SIX FORMAT?
	TLO F,L.DTOO		;OLD OUTPUT FILE
	TRNE T,SW.M		;MAC FORMAT?
	TLO F,L.DTMO		;MAC OUTPUT FILE
	TRNE T,SW.F		;PDP15 TAPE?
	TLO F,L.DTFO		;YES
	TRNE T,SW.V		;ELEVEN?
	TLO F,L.DTVO		;YES.
	MOVEI A,117		;GET OUTPUT TAPE IN KLUDGE MODE
	MOVE B,ODEV		; ..
	MOVEI C,0		;NO BUFFERS
OUTAS1:	OPEN OUTF,A		;TRY TO GET TAPE
	  JRST ERR9		;CAN'T GET IT?
OUTZQ:	TRNN T,SW.Z		;WANT OUTPUT ZEROED?
	JRST OUTAS2		;NO. SKIP THIS
	MOVEI T1,SW.Z		;CLEAR BIT IN SWITCH WORD
	ANDCAM T1,OSW		;SO ONLY DO THIS ONCE
	TRNN T,SW.Q		;QUICK OUTPUT?
	JRST OUTZA		;NO.
OUTZS:	MOVEI A,17		;YES. GET DSK FOR SCRATCH FILE
	MOVSI B,(SIXBIT /DSK/)	; ..
	MOVEI C,0		;NO HEADERS
	OPEN SCOF,A		;ASK FOR DSK
	  JRST ERR3		;NOT THERE?
	MOVE A,SCRNAM		;GET SCRATCH NAME
	HRRI A,(SIXBIT /XFO/)	;FOR OUTPUT
	MOVSI B,(SIXBIT /TMP/)	;TEMP EXT
	SETZB C,D
	ENTER SCOF,A		;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,441		;LENGTH OF PSEUDO TAPE
	OUTPUT SCOF,TXIOL	;WRITE BLKS 0 THRU 1101
	STATZ SCOF,740000	;ERRORS?
	PUSHJ P,ERR35		;YES
	SOJG T,.-3		;WRITE WHOLE TAPE'S WORTH
	CLOSE SCOF,0		;CLOSE THE FILE
	HLLZS B			;CLEAN UP AC'S
	SETZB C,D		; ..
	LOOKUP SCOF,A		;OPEN FILE FOR UPDATING
	  JRST ERR35
	HLLZS B
	SETZB C,D
	ENTER SCOF,A		; ..
	  JRST ERR35
	TLO F,L.SCRO		;SUCCESSFUL. FLAG FOR LATER ROUTINES.

OUTZA:	TLNE F,L.DTMO+L.DTOO+L.DTFO+L.DTVO	;IS IT A PDP10 DTA?
	JRST OUTZR1		;NO. GO TO RIGHT ROUTINE
	USETI OUTF,144		;READ TEN DIRECTORY
	INPUT OUTF,ODIIOW	;TO GET ID
	SETSTS OUTF,117		;CLEAR ANY ERRORS
	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,0(T)		;SELECT DIRECTORY BLOCK
	OUTPUT OUTF,ODIIOW	;WRITE DIRECTORY OUT
	STATZ OUTF,740000	;ANY ERRORS?
	JRST ERR10		;YES.
OUTZZ:	JRST OUTAS2		;DONE ZEROING TAPE.

OUTZY:	USETO SCOF,1(T)		;SET TO WRITE DIR BLK
	OUTPUT SCOF,ODIIOW	;WRITE IT
	STATZ SCOF,740000	;ERRORS?
	JRST ERR29		;YES.
	JRST OUTZZ		;NO. DONE CLEARING DIRECTORY
OUTZR1:	TLNE F,L.DTVO		;ELEVEN?
	JRST OUTZRV		;YES.
	TLNE F,L.DTFO		;FIFTEEN?
	JRST OUTZRF		;YES.
	TLNE F,L.DTMO		;MAC OR SIX
	JRST OUTZR2		;MAC
	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

OUTZRF:	PUSHJ P,CLRWBF		;CLEAR WBUF FOR BIT MAP BLOCKS
	MOVEI T,71		;FIRST MAP BLK
	MOVEM T,OBLK		; WHERE PPBBLK WANTS IT
	PUSHJ P,PPBBLK		;CLEAR A BIT MAP BLOCK
	AOS T,OBLK		;NEXT BLOCK
	CAIGE T,100		;TO DIRECTORY?
	JRST .-3		;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
OUTZRV:	SKIPN OPPN		;OUTPUT PPN SPECIFIED?
	JRST OUTZV0		;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
OUTZV0:	PUSHJ P,CLRWBF		;HAVE TO CLEAR FILE BIT MAPS
	MOVEI T,70
	MOVEM T,OBLK		;THEY START HERE
	PUSHJ P,PPBBLK		;CLEAR ONE
	AOS T,OBLK
	CAIGE T,100		;UP TO DATA?
	JRST .-3		;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 OUTZV1		;NO. DEFAULT TO 1,1
	HLRZ T,OPPN
	LSH T,10		;OK PUT IN LEFT BYTE
	TROA T,0(T1)		;AND RIGHT BYTE
OUTZV1:	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

OUTZR2:	USETI OUTF,100		;GET MAC DIRECTORY
	INPUT OUTF,ODIIOW	;KEEP TAPE ID WORD
	SETSTS OUTF,117		;IN CASE OF INPUT ERRORS (IGNORED)
	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

OUTAS2:	SETOM VODIB1		;PREPARE THESE BECAUSE DONT KNOW THEM YET
	SETOM VODIB2		; ..
	TLNN F,L.SCRO		;IS OUTPUT TO SCRATCH FILE?
	TLNN F,L.DTO		;NO, IS OUTPUT TO DECTAPE?
	JRST OUTASX		;NO. SKIP THIS
	MOVEI T1,144		;NOW READ OUTPUT DIRECTORY
	TLNE F,L.DTOO		;SIX TAPE?
	MOVEI T1,1		;YES. BLOCK 1
	TLNE F,L.DTMO+L.DTFO+L.DTVO ;ELEVEN, FIFTEEN OR MAC TAPE?
	MOVEI T1,100		;YES. BLOCK 100 OCTAL
	MOVEM T1,ODIBKN		;SAVE FOR MULTI-BLOCK ON ELEVEN
	USETI OUTF,0(T1)	;READ THE OUTPUT DIRECTORY
	INPUT OUTF,ODIIOW	; ..
	STATZ OUTF,740000	;ANY ERRORS?
	JRST ERR10		;YES.
OUTASX:
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

RESELF:	SETZM ODATE		;NO OUTPUT DATE YET.
	TLNN F,L.DTI		;DECTAPE INPUT?
	JRST SELFNT		;NO.
	MOVE T,ISW		;YES. GET INPUT SWITCHES
	TRNN T,SW.M+SW.O+SW.F+SW.V	;WHAT KIND OF DTA?
	JRST SELFT		;PDP10 DECTAPE
	TRNE T,SW.F		;PDP15 TAPE?
	JRST SELFIF		;YES
	TRNE T,SW.V		;ELEVEN?
	JRST SELFV		;YES.
	TRNN T,SW.M		;MAC OR SIX
	JRST SELFO		;SIX (OLD)
SELFM:	SKIPGE C,SRCHP		;MAC. GET DIRECTORY INDEX
	MOVEI C,0		;NONE YET
	JRST SELFMN		;ON TO NEXT ONE

SELFML:	MOVE A,DIRECT-2(C)	;GET A FILENAME
	MOVE B,DIRECT-1(C)	;AND EXTENSION
	TLNN A,-1		;FILE IN USE?
	JRST SELFMN		;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 SELFMN		;NO. ON TO NEXT ONE.
	CAME B,IEXT		;IF THE EXTENSION IS RIGHT, THAT IS.
	TLNE F,L.WEI		;OR IT'S WILD
	JRST SELFM1		;GOOD MATCH.
SELFMN:	ADDI C,2		;ON TO NEXT FILE
	CAIGE C,60		;LOOKED AT THEM ALL?
	JRST SELFML		;NO. TRY NEXT ONE.
	JRST SELFF		;YES. FAILURE ON THIS LOOKUP

SELFM1:	MOVEM C,SRCHP		;SAVE SEARCH POINTER IN CASE OF STAR
	MOVEM C,SRCHPM		;AND FOR EXTENSIONS
	JRST SELFW		;GIVE SUCCESS RETURN.
SELFO:	SKIPL C,SRCHP		;GET OFFSET INTO SIX DIRECTORY
	JRST SELFO1		; OK. USE IT.
	HRRZ C,DIRECT+0		;NONE YET. GET STARTER FROM DIRECTORY
	JRST SELFO2		;DONT INCREMENT IT
SELFO1:	ADDI C,4		;NEXT FILE PLEASE
SELFO2:	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 SELFON		;NO. ON TO NEXT.
	CAME B,D		;EXTENSION MATCH?
	TLNE F,L.WEI		;OR WILD?
	JRST SELFO3		;YES. USE THIS FILE
SELFON:	JRST SELFO1		;NO. ON TO NEXT FILE IN DIR

SELFO3:	MOVEM C,SRCHP		;SAVE THIS POSITION IN DIR
	LDB T,[POINT 12,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
SELFT:	SKIPGE C,SRCHP		;POINTER INTO TEN DIRECTORY
	MOVEI C,0		;FIRST TIME IN
	JRST SELFTN		;ON TO NEXT FILE
SELFTL:	MOVE A,DIRECT+122(C)	;GET FILE NAME FROM DTA
	JUMPE A,SELFTN		;SKIP EMPTY SLOTS
	HLLZ B,DIRECT+150(C)	;AND EXTENSION FROM DTA DIR
	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 SELFTN		;NO MATCH.
	CAME B,D		;EXTENSIONS MATCH?
	TLNE F,L.WEI		;OR WILD CARD?
	JRST SELFT1		;MATCH.
SELFTN:	CAIGE C,26		;CHECKED THE WHOLE DIR?
	AOJA C,SELFTL		;NO. TRY ANOTHER
	JRST SELFF		;YES. NOT THERE. GO TO FAIL

SELFT1:	MOVEM C,SRCHP		;SAVE CURRENT INDEX
	LDB T,[POINT 12,DIRECT+150(C),35]	;GET DATE
	MOVEM T,ODATE		;SAVE IT
	JRST SELFW		;AND GO TO WIN
SELFIF:	SKIPGE C,SRCHP		;FILE INDEX
	MOVEI C,16		;FIRST TIME THRU
	JRST SELFFN		;GO LOOP

SELFFL:	MOVE T,DIRECT(C)	;GET FILE ENTRY
	JUMPE T,SELFFN		;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 SELFFN
	CAME B,D		;EXT MATCH TOO?
	TLNE F,L.WEI		;OR WILD?
	JRST SELFF1		;YES.
SELFFN:	CAIL C,176
	JRST SELFF		;FAIL
	ADDI C,2
	JRST SELFFL		;TRY ANOTHER

SELFF1:	MOVEM C,SRCHP		;FOUND ONE. SAVE INDEX
	SETZM ODATE		;NO DATE IN FIFTEEN DTA DIRECTORY
	JRST SELFW		;TO WIN EXIT
SELFV:	SKIPGE C,SRCHP		;STARTED?
	MOVEI C,0		;NO
	JRST SELFVN		;NEXT FILE PLEASE
SELFVL:	PUSHJ P,SELFVR		;READ FILE NAME AND EXT FOR THIS INDEX
	MOVE A,VIFFIL		;GET FILE NAME
	JUMPE A,SELFVN		;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 SELFVN		;NO GOOD. MOVE ON
	CAME B,D
	TLNE F,L.WEI		;EXTENSION MATCH OR WILD?
	JRST SELFV1		;YES. FULL MATCH
SELFVN:	CAIGE C,↑D56		;END TEST (SHOULD COMPUTE IT)
	AOJA C,SELFVL		;MOVE ON
	JRST SELFF		;FAIL RETURN FROM SELFIL

SELFV1:	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
SELFVR:	PUSH P,C		;SAVE INDEX
	MOVE T,VWPEI		;CONVERT TO INDEX OFFSET IN ELEVEN WORDS
	IMULI T,0(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
SVR2:	MOVEI C,0		;PREVENT OFFSET IN GTVDWD ROUTINE
	MOVE T,0(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,0(P)		;SECOND ELEVEN WORD
	PUSHJ P,GTVDWD		; GET IT
	PUSHJ P,R5VSIX		;CONVERT TO SIXBIT
	HRRM T,VIFFIL		;SAVE IT
	AOS T,0(P)		;AND THE EXTENSION
	PUSHJ P,GTVDWD		;GET WORD
	PUSHJ P,R5VSIX		;CONVERT TO SIXBIT
	HRLZM T,VIFEXT		;STORE IN EXT WORD
	AOS T,0(P)		;AND DATE
	PUSHJ P,GTVDWD		; ..
	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
	PUSHJ P,GTVDWD		;FROM DIR
	MOVEM T,VENFBN		;SAVE IN CASE WANT TO READ THIS
	POP P,C			;GET THE FILE NUMBER
	POPJ P,0		;AND RETURN

SVR1:	MOVEI T,377
	IDIV T,VWPEI		;SEE HOW MANY FILES PER DIR BLK
	MOVNS T
	ADD T,0(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.
SELFNT:	TLNE F,L.DSKI		;NON TAPE. DISK?
	TLNN F,L.WFI+L.WEI	;YES. NEED TO SEARCH UFD?
	JRST SELFNW		;NO. LOOKUP WHAT WE GOT.
	AOSE SRCHP		;STARTING UFD SEARCH THIS PASS?
	JRST SELFD1		;NO. MOVE ON.
	MOVEI B,0		;MAY NEED TO FIDDLE UP SYS PPN
	MOVE T,IDEV		;SEE IF INPUT IS DSK OR SYS
	MOVE A,T		; ..
	DEVPPN A,		;SEE WHAT PPN IS ASSOCIATED WITH IT
	  CAME T,[SIXBIT /SYS/]	;NO SUCH CALLI. IS IT SYS?
	CAMN A,SYSPPN		;IS THE PPN THE SYSTEM ONE?
	MOVE B,SYSPPN		;USE SYSTEM PPN AS NAME OF UFD
	SKIPE B			;IF ITS SYS,
	MOVEM B,IPPN		;STORE AS IF IT WERE TYPED IN.
	MOVEI A,14		;HAVE TO READ UFD
	SKIPN B			;WAS A SYSTEM DEVICE DECIDED ON?
	SKIPA B,IDEV		;NO. GET USER'S DISK-DEVICE NAME
	MOVSI B,(SIXBIT /SYS/)	;YES. READ DEVICE SYS TO GET SYS SRCH LIST
	SKIPN B			;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?
	CALLI A,CI.PPN		;NO. GET MINE FROM MONITOR
	MOVSI B,(SIXBIT /UFD/)	;AND UFD EXTENSION
	MOVEI C,0
	MOVE D,MFDPPN		;IN THE MASTER FILE DIR
	LOOKUP UFDF,A		;TRY TO READ THE UFD
	  JRST ERR12		;CANT READ IT.
	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 UFD
	  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 UFD

URPB:	SOSLE UHED+2		;ANY IN THIS BUFFER?
	JRST URPBOK		;YES.
	INPUT UFDF,0		;NO. GET ANOTHER BUFFER
	STATZ UFDF,020000		;END OF FILE?
	POPJ P,0		;YES. QUIT.
	STATZ UFDF,740000	;ERRORS?
	JRST ERR13		;YES.
URPBOK:	ILDB W,UHED+1		;OK. GET A WORD
	JRST CPOPJ1		;AND RETURN IT
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 SELFW2		;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 SELFW2		; ..
	CAIE T,TYPVEN		;ELEVEN TAPE?
	CAIN T,TYPFIF
	JRST SELFW2		;ELEVEN OR PDP15 TAPE
SELFW1:	MOVE D,IPPN		;NEED A LOOKUP. GET DIRECTORY
	MOVEI T,14		;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		; ..
	TLNE F,L.DSKI		;READING FROM DISK?
	TRNN F,R.LEVD		;NEW DISK ROUTINE?
	JRST SELLVC		;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 ERR28		;FILE NOT THERE?
	LDB T,[POINT 12,XBUF+4,35] ;GET THE FILE CREATION DATE
	MOVEM T,ODATE		;SAVE FOR THE ENTER
	MOVE T,XBUF+.RBSTS	;GET THE STATUS WORD
	TRNE T,.RPABC		;BAD CKSUM BIT?
	TRO F,R.ABC		;YES. REMEMBER IT
	JRST SELFW2		;LOOKUP DONE

SELLVC:	LOOKUP INF,A		;LEVEL C LOOKUP
	  JRST ERR29
	LDB T,[POINT 12,C,35]	;GET TWELVE BIT CREATION DATE
	MOVEM T,ODATE		;SAVE FOR ENTER
SELFW2:	INBUF INF,3		;ALLOCATE THE BUFFER SPACE
	MOVE T,.JBFF		;UPDATE OUTPUT SPACE DEFINER
	MOVEM T,SJFF3		; FOR BUFFERED OUTPUTS
	MOVEM T,SJFF4		; AND FOR RPBSCR IN CASE NO BUFFERED OUTS
	JRST ENTR		;AND GO FIND THE FILE.

SELFF:	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.
ENTR:	SETZM FOEXT		;CLEAR FORCED OUTPUT EXTENSION
	MOVE T,OSW		;GET OUTPUT SWITCHES
	TRNE T,SW.S+SW.C+SW.D+SW.E+SW.B	;SPECIFIC SWITCH?
	JRST ENTR2		;OUTPUT FORMAT SPECIFIED.
	TLNN F,L.WEO		;WILD OUTPUT EXTENSION?
	TLNN F,L.BEO		;NO. SPECIFIED EXTENSION?
	JRST ENTR2		;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 ENTR2		;YES.
	MOVE T,OTYPEX		;ITS A CORE FILE OF SOME SORT.
	HLRZ T,ONMTAB(T)	;SELECT ON BASIS OF OUT DEVICE
	CAIE	T,(SIXBIT /SAV/)  ;IS THIS ONE SAV?
	JRST	ENTR1		;NO--USE IT
	CAIE	A,(SIXBIT /SVE/)  ;SEE IF INPUT IS SVE
	CAIN	A,(SIXBIT /LOW/)  ;OR LOW
	MOVE	T,A		;YES--PRESERVE THE ORIGINAL
ENTR1:	HRLZM T,FOEXT		;SAVE AS FORCED EXTENSION
ENTR2:	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/
	SIXBIT /SAV/
	SIXBIT /DMP/
	SIXBIT /BIN/
	SIXBIT /ABS/
	SIXBIT /LOD/		;IS THIS RIGHT PDP11 SAVE FILE EXT?
ENTTEN:	TLNE F,L.SCRO		;SCRATCH OUTPUT FILE?
	JRST ENTTS		;YES.
ENTNDT:	MOVEI A,14		;NO KLUDGERY. JUST ENTER
	SKIPN B,ODEV		;OUTPUT DEVICE
	MOVSI B,(SIXBIT /DSK/)	;DEFAULT IS DISK
	MOVSI C,OHED		;BUFFER HEADER
	OPEN OUTF,A		;GET THE DEVICE
	  JRST ERR14		;CANT
	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
	MOVE C,ODATE		;GET 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
	JRST PROCES		;GO PASS THE DATA

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.
ENTTNW:
ENTTSS:	MOVEM C,OFILEX		;SAVE FILE INDEX
	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,0(C)		;BELONG TO THIS FILE?
	DPB T1,T		;YES. FREE IT
	SOJG N,.-3		;LOOP FOR WHOLE TAPE.
	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,1101		;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
	HRR B,ODATE		;GET OUTPUT DATE
	MOVEM B,ODIREC+150(C)	;STORE EXT,DATE
	SETZM OHED+2		;NO WORDS LEFT IN WRT BUF
	JRST PROCES		;GO WRITE THE FILE
ENTSIX:	MOVEI A,117		;GET THE OUTPUT TAPE IN KLUDGE MODE
	MOVE B,ODEV		; ..
	MOVEI C,0		;NO BUFFERS
	OPEN OUTF,A		;REQUEST DEVICE
	  JRST ERR14		;CANT HAVE IT?
	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)	;SUPERCEDE FILE?
	JRST ENTS2		;NO
	HLLZ D,ODIREC+1(C)	;MAYBE. CHECK EXT
	CAMN B,D		; ..
	JRST ENTS3		;YES. GO SUPERCEDE
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
	CALLI A,CI.DAT		;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
	JRST PROCES		;AND GO PROCESS FILE

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.
;ENTER ROUTINE FOR MAC TAPES

ENTMAC:	MOVEI A,117		;GET TAPE IN KLUDGE MODE
	MOVE B,ODEV
	MOVEI C,0		;NO BUFFERS
	OPEN OUTF,A		;GET THE DEVICE.
	  JRST ERR14		;IT WENT AWAY?
	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,(SIXBIT /@/)	; ..
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
	JRST PROCES		;GO COPY FILE.
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,0		;YES.
	JRST DELFMB		;NO. MORE.
;ENTER ROUTINE FOR PDP11 TAPES

ENTVEN:	MOVEI A,117		;FIRST OPEN OUTPUT TAPE IN KLUDGE MODE
	MOVE B,ODEV
	MOVEI C,0
	OPEN OUTF,A		; ..
	  JRST ERR14		;TAPE NOT AVAIL?
	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.)
	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
	MOVE T,ODATE		;DATE
	PUSHJ P,DATTV		;IN ELEVEN FORMAT
	MOVEM T,EVSDAT
	SKIPN T,OPRT		;PROTECTION
	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
	JRST PROCES		;NOW PROCESS THE FILE

;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
EVGET1:	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
EVGETA:	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,0		;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,0		;MATCH. NON-SKIP RETURN
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,0
ENTFIF:	MOVEI A,117		;GET OUTPUT TAPE
	MOVE B,ODEV
	MOVEI C,0		;IN UNBUFFERED MODE
	OPEN OUTF,A
	 JRST ERR14		;WENT AWAY?
	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
	JRST PROCES		;ENTER COMPLETED. GO DO READS AND WRITES

PROCES:	MOVE T,OTYPEX		;FIRST PEEL OUT NON-36 BIT CASES
	CAIN T,TYPFIF		;OUTPUT TO PDP15 TAPE?
	JRST PROFIF		;YES. PROCESS OUTPUT FIFTEEN
	CAIN T,TYPVEN		;OUTPUT TO ELEVEN TAPE?
	JRST PROVEN		;YES. PROCESS OUT ELEVEN
				;NO. OUTPUT IS A 36 BIT MACHINE
	MOVE T,ITYPEX		;INPUT TAPE CHECK
	CAIN T,TYPFIF		;FIFTEEN TAPE INPUT?
	JRST PRIFIF		;YES. PROCESS INPUT FIFTEEN
	CAIN T,TYPVEN		;INPUT FROM ELEVEN TAPE?
	JRST PRIVEN		;YES. PROCESS 16 BIT TO 36.
				;NO. TRANSFER IS SOME KIND OF 36 TO 36 BIT MACHINE
	HLRZ A,TIEXT		;GET AN EXTENSION
	MOVE C,ISW		;AND SWITCHES
	PUSHJ P,SELFTP		;AND SELECT FILE TYPE
	MOVE B,T		;GET ANSWER
	MOVE C,OSW		;GET OUTPUT SWITCHES
	HLRZ A,FOEXT		;SEE IF THERE'S A FORCED EXTENSION
	CAIN A,(SIXBIT /BIN/)	;FOR A MAC FILE?
	TRO C,SW.S		;YES. PRETEND HE TYPED /S
	SKIPN A			;USE FORCED, IF ANY
	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.
	IMULI B,5		;MAKE MORE SIGNIFICANT
	ADDI B,-5(T)		;GET OFFSET INTO TABLE FOR XFER
	PUSHJ P,@XARRAY-1(B)	;DO THE TRANSFER
				; AND CLOSE THE FILE
EPROCS:	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 REINP		;NO. COMMA. READ AGAIN.
	TLO F,L.STR1		;FLAG HAVE READ ONE * FILE
	JRST RESELF		;YES. READ ANOTHER OF THE * FILES.

SCOQ:	TLNN F,L.SCRO		;SCRATCH OUTPUT?
	JRST EOJ		;NO. ALL DONE
	CLOSE SCOF,0		;HAVE TO CLOSE FILE BEFORE READING
	RELEAS INF,0		;CLEAR THESE CHANNELS BECAUSE WILL USE
	RELEAS UFDF,0		; THEIR BUFFER AREAS FOR OUTPUTTING
	MOVE A,SCRNAM		;AND RE-OPEN IT FOR INPUT
	HRRI A,(SIXBIT /XFO/)
	MOVSI B,(SIXBIT /TMP/)
	SETZB C,D
	LOOKUP SCOF,A		;READ THE FILE
	  JRST ERR34		;NOT THERE?
SCO0:	USETI SCOF,1		;READ TAPE'S BLOCK 0
	INPUT SCOF,WIOL		;INTO WBUF
	STATZ SCOF,740000	;ERRORS?
	JRST ERR35		;YES. QUIT
	PUSHJ P,WBK0		;WRITE BLOCK 0 ON TAPE
	  JRST ERR19		;ERROR ON TAPE
SCO1:	SETSTS OUTF,117		;SWITCH TAPE TO DUMP MODE
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,2000(T)		;ASK FOR ANOTHER K
	CALLI T,CI.COR		; ..
	  JRST SCOB		;CANT HAVE IT. WELL, USE WHAT YOU HAVE
	JRST SCOL2		;GOT IT. SEE IF ANY MORE NEEDED
SCOB:	MOVEI B,1		;START AT BLK 1 (0 DONE ABOVE)

SCOL:	CAMLE B,LASTOB		;ALL WRITTEN?
	JRST SCOEND		;YES.
	MOVE 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
	CAMGE 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
	INPUT SCOF,CORIOW	; ..
	STATZ SCOF,760000	;OK?
	PUSHJ P,ERR32		;NO.
	USETO OUTF,0(B)		;WHERE TO WRITE ON TAPE
	OUTPUT OUTF,CORIOW	;DO SO.
	STATZ OUTF,760000	;OK?
	PUSHJ P,ERR33		;OOPS
	ADD B,D			;ONWARD DOWN THE TAPE
	JRST SCOL		;LOOP FOR MORE

SCOEND:	CLOSE OUTF,0		;CLOSE THE DTA
	MTAPE OUTF,1		;REWIND IT
	CLOSE SCOF,0		;FLUSH SCRATCH FILE
	SETZB A,B
	SETZB C,D		;RENAME TO 0
	RENAME SCOF,A		; ..
	JFCL
	RELEAS SCOF,0		; ..
	JRST EOJ		;ON TO END OF JOB PROCESSING
RPB:	MOVE T1,ITYPEX		;READ A WORD FROM CORRECT READ ROUTINE
	JRST @RPBT(T1)		; ..

RPBT:	RPBNDT
	RPBTEN
	RPBSIX
	RPBMAC
	RPBFIF
	RPBVEN

RPBNDT:	SOSLE IHED+2		;ANY MORE IN BUFFER?
	JRST RPBNOK		;YES. GO GET ONE
	INPUT INF,0		;NO. READ A BLOCK
	STATZ INF,740000	;ANY ERRORS?
	PUSHJ P,ERR16		;YES, UNLESS ABC OR /G
	STATZ INF,20000		;EOF?
	POPJ P,0		;YES. NON-SKIP RETURN
RPBNOK:	ILDB W,IHED+1		;GET A WORD
CPOPJ1:	AOS 0(P)		;SKIP RETURN
CPOPJ:	POPJ P,0		;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,0(C)		;IN THIS FILE?
	JRST RPBT3		;YES.
	CAIGE T,1101		;TO EOT YET?
	AOJA T,RPBTL1		;NO. ONWARD
	POPJ P,0		;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,1101		;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,0(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,1101		;END OF TAPE?
	JRST ERR18		;LINK OFF END. QUIT
	PUSHJ P,RBTRBF		;READ THE BLOCK
	  PUSHJ P,ERR16		;ERROR. SEE IF /G IN EFFECT
RPBS6:	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,0(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,0(C)		;IN THIS FILE?
	JRST RPBM3		;YES. GO READ IT
	CAIGE A,1067		;TO EOT?
	AOJA A,RPBML1		;LOOK AT ANOTHER
	POPJ P,0		;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,0(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,0(C)		;BELONG TO THIS FILE?
RPBM4N:	SOJA A,RPBM4L		;LOOP TO NEXT BYTE BACK
	JRST RPBM3		;FOUND A BLOCK
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,0		;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,0(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,0(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,0		;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
RPBF6:	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,0(W)		;DATA WORD
	JRST CPOPJ1		;EXIT HAPPY
RPBVEN:	SOSLE IHED+2
	JRST RPBV1
	SKIPL IBLK		;STARTED YET?
	JRST RPBV2		;YES. FOLLOW LINK
	MOVE T,VENFBN		;NO. REMEMBER FBN FROM LOOKUP
	MOVEM T,IBLK		;SET IT UP IN BLK FOR INPUT
	JRST RPBV3
RPBV2:	HLRZ T,RBUF+0		;LINK TO NEXT BLOCK
	TRNE T,100000		;NEGATIVE?
	TRO T,600000		;YES EXTEND SIGN
	HRRES T			; ..
	MOVEM T,IBLK		;STORE AWAY
RPBV3:	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
	MOVEM T,IHED+2
	MOVE T,[XWD 222200,RBUF]	;POINTER TO THEM
	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,0		;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

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,0(N)
	EXCH T,TBUF+177(T1)
	MOVSM T,TBUF(N)
	AOBJN N,OBCVL1
	POPJ P,0

OBCVR:	PUSHJ P,MOVRT
	PUSHJ P,OBCVEN
	JRST MOVTR
;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,0(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
	INPUT SCRF,CORIOW	;READ IT
	STATZ SCRF,740000	;ERRORS?
	POPJ P,0		;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
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
	OUTPUT OUTF,0		;NO. SEND BUFFER
	STATZ OUTF,740000	;ERRORS?
	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
PPBTL1:	ILDB T,B		;GET A DIR BYTE
	JUMPE T,PPBT4		;JUMP IF ITS FREE
PPBT2:	CAIGE A,1101		;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,0(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,1101		;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,0(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
PPBM4:	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,0(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
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,0(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
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
PPAVEN:				;USE SAME TAG FOR BOTH
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,0(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?
APOPJ1:	AOS -1(P)		;NO. SKIP RETURN
APOPJ:	POP P,A
	POPJ P,0

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,0		;RETURN
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,4		;FAR ENOUGH?
	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
;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,0		;RETURN FROM PROCES

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

CLSNDT:	CLOSE OUTF,0		;CLOSE THE FILE
	MOVE T,ODEV		;GET OUTPUT DEVICE NAME
	CALLI T,CI.DCH		;DEVICE BITS
	TLNN T,DVDSK		;DISK?
	JRST CLSN2		;NO. NO PROTECTION
	MOVE A,TOFILE		;GET FILE NAME
	SKIPN	B,FOEXT		;GET FORCED EXTENSION
	HLLZ B,TOEXT		;EXTENSION
	SKIPE C,OPRT		;PROTECTION
	JRST CLSN1		;SPECIFIED.
	TRNN	F,R.SYS		;NOT SPEC.--IS THIS SYS?
	JRST	CLSN2		;NO--USE SYSTEM DEFAULT
	MOVEI	C,SYSPRT	;SET-UP STANDARD SYS PROTECTION
	CAMN	B,[SIXBIT /SYS/]  ;IF EXT IS SYS
	MOVEI	C,SSSPRT	;  THEN USE SPECIAL PROTECTION
CLSN1:	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,0		;CLOSE AGAIN
CLSN2:	STATZ OUTF,740000	;ERRORS?
	JRST ERR21		;YES
	POPJ P,0		;NO.

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
	MOVEM A,OBLK		;FOR WRITER
	MOVE T,[XWD ODIREC,WBUF]
	BLT T,WBUF+177		;COPY INTO WRITE BUFFER
	PUSHJ P,PPBBLK		;AND WRITE IT ON DSK OR TAPE
	POPJ P,0		;END OF CLOSE ROUTINE
;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
	MOVE T,[XWD ODIRECT,WBUF]	;AND THE DIRECTORY ITSELF
	BLT T,WBUF+177		; ..
	MOVEI T,100		;WHERE IT LIVES ON TAPE
	MOVEM T,OBLK
	PUSHJ P,PPBBLK		;WRITE IT
	POPJ P,0		;DONE WITH CLOSE

;PDP-11 CLOSE ROUTINE

CLSVEN:	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
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,0(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
	MOVE T,ODIBKN		;BLOCK NUMBER THIS GOES IN
	MOVEM T,OBLK		;FOR WRITE RTN
	MOVE T,[XWD ODIREC,WBUF]	;MOVE IT TO WRITE BUFFER
	BLT T,WBUF+177		; ..
	PUSHJ P,PPBBLK		;OUT IT GOES
	POPJ P,0		;END OF PDP-11 CLOSE ROUTINE
;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:	USETO SCOF,144+1	;TO DIR BLK
	OUTPUT SCOF,ODIIOW	;OUTPUT THE DIR
	STATZ SCOF,760000	;PROBLEMS?
	JRST ERR3		;YES.
	POPJ P,0		;NO. RETURN FROM CLS
;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

SELFTP:	MOVEI T,FT.B		;IN CASE NOTHING ELSE SHOWS UP
	CAIE A,(SIXBIT /SVE/)	;CHECK FOR TEN SAVE EXTENSIONS
	CAIN A,(SIXBIT /SAV/)	; ..
	MOVEI T,FT.C		;YES
	CAIN A,(SIXBIT /LOW/)	;ONE MORE
	MOVEI T,FT.C
	CAIN A,(SIXBIT /XPN/)	;EXPANDED SAVE FILE?
	MOVEI T,FT.E		;YES.
	CAIN A,(SIXBIT /DMP/)	;SIX DUMP FILE?
	MOVEI T,FT.D		;YES
	TRNE C,SW.S		;SWITCHES OVERRIDING ABOVE?
	MOVEI T,FT.S		; S SWITCH
	TRNE C,SW.C		; ...
	MOVEI T,FT.C
	TRNE C,SW.D
	MOVEI T,FT.D
	TRNE C,SW.E
	MOVEI T,FT.E
	TRNE C,SW.B
	MOVEI T,FT.B
	POPJ P,0		;RETURN FILE TYPE
;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			;F
	XWD SW.G,0				;G
	XWD SW.H,0				;H
	XWD SW.I,SW.A				;I
	0					;J
	0					;K
	XWD SW.L,0				;L
	XWD SW.M,SW.F!SW.V!SW.O			;M
	0					;N
	XWD SW.O,SW.F!SW.M!SW.V			;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 0,SW.M!SW.V!SW.O!SW.F		;T
	0					;U
	XWD SW.V,SW.F!SW.M!SW.O			;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>>

;NOTE THAT ALL 18 BITS ARE IN USE....
M.SW(<A,B,C,D,E,F,G,H,I,L,M,O,P,Q,R,S,V,Z>)

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

SW.TAP==SW.F!SW.L!SW.M!SW.O!SW.P!SW.Q!SW.R!SW.V!SW.Z
;DISPATCH TABLE FOR TYPE OF TRANSFER OPERATION

XARRAY:	XFRBB	;C TO C
	XFRCE	;C TO E
	XFRCD	;C TO D
	XFRCS	;C TO S
	XFRBB	;C TO B
	XFREC	;E TO C
	XFRBB	;E TO E
	XFRED	;E TO D
	XFRES	;E TO S
	XFRBB	;E TO B
	XFRDC	;D TO C
	XFRDE	;D TO E
	XFRBB	;D TO D
	XFRDS	;D TO S
	XFRBB	;D TO B
	XFRSC	;S TO C
	XFRSE	;S TO E
	XFRSD	;S TO D
	XFRBB	;S TO S
	XFRBB	;S TO B
	XFRBB	;B TO C
	XFRBB	;B TO E
	XFRBB	;B TO D
	XFRBB	;B TO S
	XFRBB	;B TO B
;TRANSFER ROUTINES

XFRBB:
XFRBBL:	PUSHJ P,RPB		;SIMPLE BINARY TRANSFER
	  JRST CLS		;END OF FILE
	PUSHJ P,PPB		;WRITE
	  JRST CLS
	JRST XFRBBL

XFRCE:	SETZM OCA		;CLEAR OUTPUT CORE ADDRESS
XCEL1:	PUSHJ P,RPB		;READ A POINTER OR JRST
	  JRST XCEX		;EOF
	JUMPGE W,XCEX		;JRST WORD
	MOVE CA,W		;GET THE BLKI POINTER
	HRRI CA,1(CA)		;MAKE AN AOBJN POINTER
XCEL2:	MOVEI T,0(CA)		;COMPARE WITH CURRENT OUTPUT ADDR
	CAMG T,OCA
	JRST XCE1		;OK. OUTPUT HERE
	MOVEI W,0		;NEED SOME ZEROES
	PUSHJ P,PPB		;..
	  JRST XCEX		;TROUBLE
	AOS OCA			;NEXT OUTPUT ADDRESS
	JRST XCEL2		;LOOP TO ADDR OF POINTER

XCE1:	CAME T,OCA		;MONOTONIC?
	PUSHJ P,ERR24		;NO. LOSES.
XCEL3:	PUSHJ P,RPB		;READ A WORD FROM BLK
	  JRST XCEX		;EOF OR ERR
	PUSHJ P,PPB
	  JRST XCEX
	AOS OCA			;COUNT OUTPUT ADDR
	AOBJN CA,XCEL3		;FINISH BLOCK
	JRST XCEL1		;GET ANOTHER BLOCK OR JRST

XCEX:	JRST CLS		;END OF FILE
;HERE WHEN I/O IS FROM PDP15 TAPE TO 36BIT OUTPUT

PRIFIF:	PUSH P,[EPROCS]
	HLRZ T,TIEXT		;INPUT EXTENSION OF 15 FILE
	CAIN T,(SIXBIT /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
XFRFBL:	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 XFRFBL		;LOOP

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

XFRFTB:	SETZM FITXW1		;FIFTEEN INPUT TEXT WORD
	MOVE T,[XWD 440700,FITXW1]
	MOVEM T,FITXP1
XFRFTC:	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 XFTB1		;COUNT DOWN THIS HEADER PAIR
XFTBL:	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,FIPPA
	POP P,CH
	PUSHJ P,FIPPA
REPEAT 4,<
		ILDB CH,FITXP2
		PUSHJ P,FIPPA
>
XFTB1:	SOSLE FCOUNT		;DONE?
	JRST XFTBL		;NO
	SETOM XFILFQ		;FLAG PROB WANT LINEFEED NEXT
	PUSHJ P,RPB		;INPUT PLEASE
	 JRST XFICLS		;EOF
	TLNN W,-1		;NON-BLANK?
	JRST .-3		;BLANK
	JRST XFRFTC		;NON-BLANK HEADER. PROCESS IT

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

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

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 XFIBN

XFIBL:	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
XFIBN:	SOSLE FCOUNT
	JRST XFIBL
	PUSHJ P,RPB
	 JRST CLS
	TLNN W,-1
	JRST .-3
	JRST XFRFB

;HERE ON 36 BIT OUTPUT, PDP11 INPUT

PRIVEN:	PUSH P,[EPROCS]		;FAKE CALL FROM DISPATCH BY PUSHJ
	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
PIVASL:	PUSHJ P,RPAVEN		;GET AN EIGHT BIT BYTE
	 JRST PIVAS1		;EOF
	JUMPE CH,PIVASL		;SKIP NULLS
	PUSHJ P,FIPPA		;STASH SEVEN OF THEM
	JRST PIVASL

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
;HERE WHEN OUTPUT TAPE IS PDP FIFTEEN STYLE. INPUT MAY BE TOO?

PROFIF:	PUSH P,[EPROCS]
	MOVE T,ITYPEX		;SEE IF INPUT IS A FIFTEEN ALSO
	CAIN T,TYPFIF
	JRST XFRBB		;YES. DO BINARY XFR
	CAIN T,TYPVEN		;IS INPUT AN ELEVEN?
	JRST ERR36		;YES. CANT DO THAT (YET?)
	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 PROFIA		;YES.
	TRNN T1,SW.I		;I SWITCH FORCES BINARY TRANSFER
	CAIN T,(SIXBIT /ABS/)
	JRST PROFAB
	CAIN T,(SIXBIT /BIN/)
	JRST POFBIN
PROFIA:	SETZM FOTXP1		;ASSUME TEXT. CLEAR FOR RPA

POFTL1:	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
POFTL2:	PUSHJ P,FORPA
	  JRST POFTCL
	SOSL IOPSOC
	IDPB CH,IOPSOP
	CAIN CH,15
	JRST POFTEL		;TEXT END OF LINE
	JRST POFTL2

POFTEL:	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
POFTE2:	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 POFTE1		;YES.
	MOVEI W,0
	PUSHJ P,PPB
	 JRST CLS
	JRST POFTE2
POFTE1:	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 POFTL1

FORPA:	MOVE T,FOTXP1
	TLNN T,760000
	JRST FORPA1
	ILDB CH,FOTXP1
	JUMPE CH,FORPA
	JRST CPOPJ1

FORPA1:	MOVE T,[XWD 440700,FOTXW1]
	MOVEM T,FOTXP1
	PUSHJ P,RPB
	  POPJ P,0
	MOVEM W,FOTXW1
	JRST FORPA

POFTCL:	MOVE W,[XWD 001005,776773]
	PUSHJ P,PPB
	 JRST CLS
	JRST CLS
PROFAB:	TLZ F,L.6DO
POFAL1:	PUSHJ P,RPB
	 JRST CLS
	TLCE F,L.6DO
	JRST POFAB1
	HRLZM W,FOTXW1
	MOVE T,OHED+2
	CAILE T,1
	JRST POFAL1
	TLZ F,L.6DO
POFAB2:	PUSHJ P,PPB
	 JRST CLS
	JRST POFAL1

POFAB1:	HLL W,FOTXW1
	JRST POFAB2

POFBIN:
POFBL1:	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
POFBL2:	PUSHJ P,RPB
	 JRST POFBCL
	IDPB W,IOPSOP
	SOSLE IOPSOC
	JRST POFBL2

	PUSHJ P,POFEBB
	JRST POFBL1

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
POFEB2:	LDB T,[POINT 8,IOPSOB,8]
	MOVEM T,IOPSOC
	SKIPE OHED+2
	CAMG T,OHED+2
	JRST POFEB1
	MOVEI W,0
	PUSHJ P,PPB
	 JRST CLS
	JRST POFEB2

POFEB1:	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
POFEBL:	MOVE W,IOPSOB(CKS)
	PUSHJ P,PPB
	 JRST CLS
	ADDI CKS,1
	CAMGE CKS,IOPSOC
	JRST POFEBL
	POPJ P,0
;HERE WHEN OUTPUT TAPE IS PDP ELEVEN STYLE. INPUT MAY BE TOO?

PROVEN:	PUSH P,[EPROCS]		;FAKE CALL FROM PROCES DISPATCH
	MOVE T,ITYPEX		;SEE WHAT THE INPUT TAPE IS
	CAIN T,TYPVEN		;ELEVEN ALSO?
	JRST PRVV		;YES. PROCESS ELEVEN TO ELEVEN.
	CAIN T,TYPFIF		;FIFTEEN?
	JRST ERR36		;YES. NOT IMPLEMENTED.
	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 PROVA		;YES.
	TRNE T1,SW.I		;IMAGE (8 BIT) SPECIFIED?
	JRST PROVI		;YES.
	TRNE T,SW.B		;BINARY?
	JRST PROVB		;YES.
	MOVSI T1,-VBINXL	;SEE IF EXT FORCES BINARY TRANSFER
	CAMN T,VBINXT(T1)
	JRST PROVB		;YES
	AOBJN T1,.-2		;LOOP
				;NO. ASSUME ASCII IF NO SWITCH OR SPECIAL EXT
PROVA:	SETZM FOTXP1		;CLEAR POINTER FOR FIRST BYTE
PROVAL:	PUSHJ P,FORPA		;READ FROM 36 BIT WORD INTO CH
	  JRST CLS		;END OF FILE
	PUSHJ P,PPAVEN		;OUTPUT TO ELEVEN, FROM CH
	  JRST CLS		;ERROR ON OUTPUT. CLOSE FILE.
	JRST PROVAL		;LOOP TILL EOF

PRVV:	PUSHJ P,RPBVEN		;GET 16 BITS
	  JRST CLS		;EOF
	MOVEM W,FITXW1		;SAVE IT
	PUSHJ P,RPBVEN		;GET 16 MORE BITS
	  JRST PRVV1		;END OF FILE
	HRL W,FITXW1		;MAKE 32 BITS
	PUSHJ P,PROVB1		;OUTPUT 32 BITS
	JRST PRVV		;LOOP

PRVV1:	HRLZ W,FITXW1		;GET THE 16 BITS
	PUSHJ P,PROVB1		;OUTPUT WITH 16 ZEROES AFTER THEM
	JRST CLS		;AND CLOSE THE FILE
PROVI:	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,PPAVEN		;OUTPUT THEM
	  JRST CLS		;ERROR
	JRST PROVI		;LOOP UNTIL EOF

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

PROVB1:	MOVEM W,FOTXW1		;STORE 32 BITS
	LDB CH,[POINT 8,FOTXW1,17]
	PUSHJ P,PPAVEN		;OUTPUT FIRST 8
	  JRST CLS		;ERROR ON OUTPUT. CLOSE FILE.
	LDB CH,[POINT 8,FOTXW1,9]
	PUSHJ P,PPAVEN		;OUTPUT SECOND 8
	  JRST CLS		;ERROR ON OUTPUT. CLOSE FILE.
	LDB CH,[POINT 8,FOTXW1,35]
	PUSHJ P,PPAVEN		;THIRD EIGHT
	  JRST CLS		;ERROR ON OUTPUT. CLOSE FILE.
	LDB CH,[POINT 8,FOTXW1,27]
	PUSHJ P,PPAVEN		;FOURTH EIGHT
	  JRST CLS		;ERROR ON OUTPUT. CLOSE FILE.
	POPJ P,0		;RETURN FROM 32 BIT HANDLING SUBR
XFRCD:	MOVEI CA,JOBSV6+1		;OUTPUT ADDRESS AT START
	MOVEM CA,OCA
XCDL1:	PUSHJ P,RPB		;READ A POINTER WORD
	  JRST XCDX		;EOF
	JUMPGE W,XCDX		;JRST WORD.
	MOVE CA,W		;POINTER. GET ADDRESS
	HRRI CA,1(CA)		;AOBJN, NOT BLKI
XCDL2:	MOVEI T,0(CA)		;CURRENT ADDRESS IN AOBJN BLOCK
	CAMG T,OCA		;NEED TO FILL WITH ZEROES?
	JRST XCD1		;NO
	MOVEI W,0		;YES.
	PUSHJ P,PPB		;OUTPUT A ZERO
	  JRST XCDX		;ERROR
	AOS OCA			;COUNT THE OUTPUT ADDRESS
	JRST XCDL2		;SEE IF ENOUGH

XCD1:
XCDL3:	MOVEI T,0(CA)		;WHERE IN BLOCK?
	CAIG T,JOBSV6		;BELOW LOWEST LEGAL ADDR?
	JRST XCDN3		;YES. DISCARD WORD.
	CAME T,OCA		;AT CURRENT OUTPUT?
	JRST ERR24		;NO. NON-MONOTONIC
	PUSHJ P,RPB		;READ A WORD
	  JRST XCDX		;EOF
	PUSHJ P,PPB		;WRITE THE WORD
	  JRST XCDX		;ERROR
	AOS OCA			;OUTPUT ADDRESS UP ONE
XCDN3:	AOBJN CA,XCDL3		;LOOP FOR WHOLE AOBJN BLOCK
	JRST XCDL1		;NEXT BLK OR JRST

XCDX:	JRST CLS		;END OF FILE
XFRCS:	PUSHJ P,OUTMRL		;OUTPUT MAC RIM LOADER
	  JRST XCSX		;ERROR
XCSL1:	PUSHJ P,RPB		;GET A POINTER OR JRST WORD
	  JRST XCSX		;EOF
	JUMPGE W,XCSA		;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 XCSX		;ERROR

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

XCSA:	PUSHJ P,PPB		;OUTPUT THE FINAL JRST WORD
	  JRST XCSX
	PUSHJ P,PPB		;TWICE (NO SYMS)
	  JRST XCSX
XCSX:	JRST CLS		;END OF FILE
XFRDC:	MOVEI T,JOBSV6+1	;6 TO TEN DMP TO SAV
	JRST XDC1		;JUMP INTO ROUTINE BELOW

XFREC:	MOVEI CA,17		;EXPANDED TO COMPRESSED
XECL0:	PUSHJ P,RPB		;READ EXPANDED FILE
	  JRST XECX		;ERROR
	SOJGE CA,XECL0		;DISCARD FIRST 20 LOCS OF EXP FILE
	MOVEI T,20		;LOWEST ADDRESS WANTED
XDC1:	MOVEM T,ICA		;ADDRESS ABOUT TO GET FROM INPUT FILE
	SETZB CA,OCA		;CLEAR OUTPUT POINTERS
	SETZM SAVSTA		;NO STARTING ADDRESS KNOWN YET
XECL1:	PUSHJ P,RPB		;READ INPUT WORD
	  JRST XECE		;END OF FILE
	JUMPE W,XEC1		;XERO WORD FROM INPUT?
	MOVEM W,XBUF(CA)	;PUT INTO TRANSFER BUFFER
	ADDI CA,1		;COUNT SIZE OF XFR BUF
	CAIGE CA,200		;FULL?
	JRST XECL1		;NO.
	PUSHJ P,XECOBK		;YES. OUTPUT THIS BLOCK AS ONE AOBJN WD
	  JRST XECX		;ERROR
	JRST XECL1		;READ SOME MORE.

XEC1:	JUMPE CA,XEC2		;ZERO IN. NEED TO WRITE BLK?
	PUSHJ P,XECOBK		;YES. DO SO.
	  JRST XECX		;ERROR
XEC2:	AOS ICA			;COUNT INPUT ADDRESS
	JRST XECL1		;AND GO ON.

XECE:	JUMPE CA,XECE2		;NEED TO OUTPUT A BLOCK?
	PUSHJ P,XECOBK		;YES. DO.
	  JRST XECX		;ERROR
XECE2:	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 XECX		;ERROR
XECX:	JRST CLS		;END OF FILE
XECOBK:	MOVN W,CA		;OUTPUT XBUF BLOCK
	HRLZS W			;MAKE COUNT OF BUFFER
	HRR W,ICA		;ADDRESS OF BUFFER STARTING IN CORE
	HRRI W,-1(W)		;MINUS ONE FOR BLKI PTR
	PUSHJ P,PPB		;OUTPUT THE POINTER
	  POPJ P,0		;ERROR
	SETZB T,OCA		;CLEAR COUNT
XECL2:	MOVE W,XBUF(T)		;GET A WORD FROM XBUF
	PUSHJ P,PPB		;OUTPUT IT
	  POPJ P,0		;ERROR
	AOS T,ICA		;COUNT INPUT ADDRESS
	CAIN T,.JOBSA+1		;IS IT WHERE START ADDR LIVES?
	HRRZM W,SAVSTA		;YES. SAVE IT.
	AOS T,OCA		;COUNT AMT OF XBUF WRITTEN
	CAIGE T,0(CA)		;ALL OF IT?
	JRST XECL2		;NO.
	MOVEI CA,0		;YES. CLEAR COUNTER, GO ON
	JRST CPOPJ1		;SUCCESSFUL RETURN

XFRED:	MOVEI CA,JOBSV6		;EXPANDED TO DUMP (SIX)
XEDL0:	PUSHJ P,RPB		;DISCARD WORDS UP TO SIX STARTER
	  JRST XEDX		;ERROR
	SOJGE CA,XEDL0		;COUNT DOWN JUNK
	JRST XFRBB		;FROM HERE ON, ITS A COPY.

XFRDE:	MOVEI CA,JOBSV6		;DUMP (SIX) TO EXPANDED
XDEL0:	MOVEI W,0		;WRITE OUT SOME LEADING ZEROES
	PUSHJ P,PPB		; ..
	  JRST XDEX		;ERROR
	SOJGE CA,XDEL0		;LOOP FOR ENOUGH ZEROES
	JRST XFRBB		;AND TRANSFER REST AS BINARY

XEDX:
XDEX:	JRST CLS		;ERROR EOF
XFRDS:	MOVEI T,JOBSV6+1	;DUMP TO SBLK
	JRST XDS1		;INTO ROUTINE BELOW

XFRES:	MOVEI CA,17		;EXPANDED TO SBLK
XESL0:	PUSHJ P,RPB		;READ AN AC FROM EXP FILE
	  JRST XESX		;ERROR
	SOJGE CA,XESL0		;DISCARD THE AC'S FROM EXP FILE
	MOVEI T,20		;NEXT ADDRESS TO COME IN
XDS1:	MOVEM T,ICA		;STORE NEXT INPUT ADDRESS
	PUSHJ P,OUTMRL		;OUTPUT MAC RIM LOADER
	  JRST XESX
	SETZB CA,OCA		;CLEAR OUTPUT COUNTERS
XESL1:	PUSHJ P,RPB		;READ A CORE WORD FROM EXP FILE
	  JRST XESX		;END OF FILE
	JUMPE W,XES1		;ZERO IN INPUT?
	MOVEM W,XBUF(CA)	;NO. STORE DATUM
	ADDI CA,1		;COUNT FILLING XFER BUFFER
	CAIGE CA,200		;FULL?
	JRST XESL1		;NO. READ ON
	PUSHJ P,XESOBK		;YES. OUTPUT BLOCK
	  JRST XESX		;ERROR
	JRST XESL1		;READ ON.

XES1:	JUMPE CA,XES2		;ANYTHING TO OUTPUT?
	PUSHJ P,XESOBK		;YES. DO SO
	  JRST XESX		;ERROR
XES2:	AOS ICA			;COUNT THIS ZERO
	JRST XESL1		;AND READ ON

XESX:	MOVSI W,(HALT)		;NO START ADDRESS KNOWN
	PUSHJ P,PPB		;OUTPUT JRST WORD
	  JFCL
	PUSHJ P,PPB		;TWICE
	  JFCL
	JRST CLS		;END OF FILE
XESOBK:	MOVN W,CA		;ROUTINE TO OUTPUT BLOCK OF SBLK
	HRLZS W			;MAKE IOWD
	HRR W,ICA		;GET ADDRESS FOR START OF BLOCK
	MOVE CKS,W		;INITIAL CHECKSUM
	PUSHJ P,PPB		;OUTPUT AOBJN PTR
	  POPJ P,0		;ERROR
	SETZB T,OCA		;CLEAR OUTPUT COUNTER
XESL2:	MOVE W,XBUF(T)		;GET OUTPUT DATUM
	ROT CKS,1		;PUT IT IN CKSUM
	ADD CKS,W		; ..
	PUSHJ P,PPB		;OUTPUT THE DATUM
	  POPJ P,0		;ERROR
	AOS ICA			;COUNT TRANSFERRED INPUT WORD
	AOS T,OCA		;HOW MUCH OF BLOCK XFRD
	CAIGE T,0(CA)		;ALL OF IT?
	JRST XESL2		;NOT YET
	MOVEI CA,0		;YES. CLEAR COUNT OF FILLED BFR
	MOVE W,CKS		;OUTPUT THE CHECKSUM
	PUSHJ P,PPB		; ..
	  POPJ P,0		;ERROR
	JRST CPOPJ1		;OK RETURN.
OUTMRL:	MOVE CA,[XWD -MRLL,MRL]	;POINTER TO LOADER
OUTMR1:	MOVE W,0(CA)		;GET A WORD OF IT
	PUSHJ P,PPB		;OUTPUT IT
	  POPJ P,0		;ERROR
	AOBJN CA,OUTMR1		;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
XFRSC:	SETOM OCA		;SBLK TO COMPRESSED
	PUSHJ P,RPB		;SKIP TO CUE WORD
	  JRST XSCX		;ERROR
	CAME W,[JRST 1]		;CUE?
	JRST XFRSC		;NOT YET.

XSCL1:	PUSHJ P,RPB		;GET POINTER OR JRST WORD
	  JRST XSCX		;EOF OR ERROR
	JUMPGE W,XSCA		;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,0(CA)		;SYMS. PUT AFTER DATA.
	HRRI W,-1(W)		;MAKE BLKI PTR
	PUSHJ P,PPB		;OUTPUT POINTER
	  JRST XSCX		;ERROR
XSCL2:	PUSHJ P,RPB		;READ A DATUM
	  JRST XSCX		;ERROR
	ROT CKS,1		;CHECKSUM IT
	ADD CKS,W		; ..
	PUSHJ P,PPB		;OUTPUT IT
	  JRST XSCX		;ERROR
	AOBJN CA,XSCL2		;COUNT THRU BLK
	PUSHJ P,RPB		;READ CHECKSUM
	  JRST XSCX		;ERROR
	CAME W,CKS		;CHECK IT
	PUSHJ P,CKSERR		;NO GOOD
	JRST XSCL1		;READ ANOTHER BLK

XSCA:	AOSG OCA		;COUNT OUTPUT ADDRESS AS FLAG
	JRST XSCL1		;JUST FIRST ONE. GO ON
	PUSHJ P,PPB		;OUTPUT THE JRST WORD AT END
	  JRST XSCX		;ERROR
XSCX:	JRST CLS		;END OF FILE
XFRSD:	MOVEI CA,JOBSV6+1	;FIRST ADDRESS WANTED
	MOVEM CA,OCA		;SAVE IT
	MOVEM CA,ICA
	JRST XSDL0A		;INTO PROCESSING LOOP

XFRSE:	MOVEI CA,20		;SBLK TO EXPANDED
	MOVEM CA,OCA		;STORE COUNT
	MOVEM CA,ICA		;STORE INPUT ADDRESS
XSDL0:	MOVEI W,0		;OUTPUT A ZERO
	PUSHJ P,PPB		; ..
	JRST XSDX		;ERR
	SOJG CA,XSDL0		;LOOP
	MOVE CA,OCA		;GET OUTPUT CURRENT ADDRESS

XSDL0A:	PUSHJ P,RPB		;READ FOR MAC CUE
	  JRST XCDX		;ERR
	CAME W,[JRST 1]		;CUE?
	JRST XSDL0A		;NOT YET.
XSDL1:	PUSHJ P,RPB		;READ POINTER OR JRST
	  JRST XSDX		; ERR
	JUMPGE W,XSDX		;JRST WORD
	MOVE CA,W		;GET POINTER
	MOVE CKS,W		;START CHECK SUM
XSDL2:	MOVEI T,0(CA)		;CHECK CONTINUITY
	CAMG T,OCA		; ..
	JRST XSD1		;BREAK
	MOVEI W,0		;OUTPUT SOME ZEROS
	AOS OCA			;COUNT OUTPUT ADDRESS
	PUSHJ P,PPB		;AND OUTPUT THE ZERO
	  JRST XSDX		;ERR
	JRST XSDL2		;LOOP

XSD1:
XSDL3:	MOVEI T,0(CA)		;CHECK MONOTONICITY
	CAMG T,ICA		; ..
	JRST XSDN3		;BELOW STARTER
	CAME T,OCA		;AT OUTPUT?
	JRST ERR24		;NON-MONOTONIC
	PUSHJ P,RPB		;GOOD. GET DATUM
	  JRST XSDX		;ERR
	ROT CKS,1		;COMPUTE CHECK
	ADD CKS,W		; ..
	PUSHJ P,PPB		;OUTPUT DATUM
	  JRST XSDX		;ERR
	AOS OCA			;COUNT OUTPUT ADR
XSDN3:	AOBJN CA,XSDL3		;COUNT POINTER
	PUSHJ P,RPB		;END OF BLOCK. CHECK CKS
	JRST XSDX		;ERR
	CAME W,CKS		;CHECK IT
	PUSHJ P,CKSERR		;ERROR
	JRST XSDL1		;READ ANOTHER POINTER

XSDX:	JRST CLS		;END OF FILE
;FILE SPECIFIER INPUT ROUTINE

FILSPC:	SETZM .DEV		;INITIALIZE
	SETZM .FILE
	SETZM .EXT
	SETZM .TID
	MOVE T,.PSW
	MOVEM T,.TSW		;COPY PERM SW'S
	MOVE T,.PPPN	;AND PPN
	MOVEM T,.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 FILSL		;LOOP
FILS1:	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
	JRST CPOPJ1

FILSU:	PUSHJ P,OCTIN
	CAIE CH,","
	JRST FILSYN		;SYNTAX ERROR
	HRLM N,.TPPN
	SKIPN .FILE
	HRLM N,.PPPN
	PUSHJ P,OCTIN
	CAIE	CH,"]"
	JRST	FILSYN
	HRRM N,.TPPN
	SKIPN .FILE
	HRRM N,.PPPN
	JRST FILSL

FILSP:	PUSHJ P,OCTIN
	CAIE CH,">"
	JRST FILSYN
	HRROM N,.TPRT
	SKIPN .FILE
	HRROM N,.PPRT
	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 SWTAB-"A"(CH)
	JRST BADSW
	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
	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,"@"
	CAILE CH,"Z"
	SKIPA
	JRST SIXLTR
	CAIL CH,"0"
	CAILE CH,"9"
	POPJ P,0
SIXLTR:	SUBI CH,40
	TLNE A,770000
	IDPB CH,A
	JRST SIXBRL
OCTIN:	MOVEI N,0
OCTINL:	PUSHJ P,TYI
	CAIL CH,"0"
	CAILE CH,"7"
	POPJ P,0
	ASH N,3
	ADDI N,-"0"(CH)
	JRST OCTINL

EOJ:	TRNE	F,R.LST		;WAS A DIRECTORY LISTING REQUESTED
	TLNN	F,L.DTO		;YES--WAS THE OUTPUT A DECTAPE?
	JRST	EOJ1		;NO--SKIP THE OUTPUT
	MOVE	T,ODEV		;COPY OUTPUT DEVICE
	MOVEM	T,IDEV		;  TO INPUT DEVICE
	MOVE	T,OSW		;COPY OUTPUT SWITCHES
	TRO	T,SW.L		;  WITH /L
	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	GETDIR		;GO TO DIRECTORY LISTER
EOJ1:	TRNN F,R.JSCR		;WANT TO JUNK SCRATCH?
	JRST EOJE		;NO
	MOVEI A,17		;YES. GET DSK
	MOVSI B,(SIXBIT /DSK/)
	MOVEI C,0
	OPEN SCRF,A
	  JRST EOJE
	MOVE A,SCRNAM
	MOVSI B,(SIXBIT /TMP/)
	SETZB C,D
	LOOKUP SCRF,A
	  JRST EOJE
	SETZB A,B
	SETZB C,D
	CLOSE SCRF,0
	RENAME SCRF,A
	  JFCL
EOJE:	CLOSE SCRF,0
	JRST FILEX
SIXDOT:	PUSHJ P,SIXOUT		;OUTPUT SIXBIT
DOT:	MOVEI CH,"."		;AND A DOT
	JRST TYO

SIXTAB:	PUSHJ P,SIXOUT
TAB:	MOVEI CH,11
TYO:	TTCALL 1,CH
	POPJ P,0

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,440700
MSGL:	ILDB CH,W
	JUMPE CH,CPOPJ
	PUSHJ P,TYO
	JRST MSGL

R5VOUT:	PUSHJ P,R5VSIX		;CONVERT R50 TO SIXBIT IN RH OF T
SIXOU3:	SKIPA T1,[POINT 6,T,17]		;TYPE JUST RH OF T
SIXOUT:	MOVE T1,[POINT 6,T]
SIXL:	ILDB CH,T1
	ADDI CH,40
	PUSHJ P,TYO
	TLNE T1,770000
	JRST SIXL
	POPJ P,0
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)
	PUSHJ P,DECPRT
	POP P,C
	POPJ P,0

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,0

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,0		;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,0(CH)		;ADD IN THIS ONE
	TLNE N,770000		;DONE?
	JRST SXR5VL		;NO
	MOVE T,W		;YES. ANSWER TO AC T
	POPJ P,0		;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
	CAIL T,6
	JRST DATTV1
RETZT:	MOVEI T,0
	POPJ P,0
DATTV1:	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
	POPJ P,0		;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,0		;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,0
	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,0

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-/

DECPR2:	CAIG T,11
	PUSHJ P,ZEROUT
DECPRT:	MOVEI CH,12
RDXPRT:	MOVEM CH,RADIX
RDXPRL:	IDIV T,RADIX
	HRLM T1,0(P)
	SKIPE T
	PUSHJ P,RDXPRL
	HLRZ CH,0(P)
	ADDI CH,"0"
	JRST TYO
ZEROUT:	MOVEI CH,"0"
	JRST TYO

TYI:	TTCALL 4,CH		;GET A CHARACTER
	CAILE CH,174		;ALTMODES?
	MOVEI CH,33		;YES.
	CAIE CH,0		;NULL?
	CAIN CH,15		;CARRIAGE RETURN?
	JRST TYI		;YES. SKIP IT
	CAIE CH,40		;SPACE?
	CAIN CH,11		;OR TAB?
	JRST TYI		;YES. SKIP THEM.
	CAIL CH,140		;LOWER CASE?
	TRZ CH,40		;YES. MAKE UPPER CASE.
	CAIN CH,32		;CONTROL Z?
	CALLI 12		;YES. EXIT
	POPJ P,0		;AND RETURN CHARACTER

OCTPRT:	MOVEI CH,10
	JRST RDXPRT

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,0
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,0(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,0		;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,0(T)		;NORMAL BLOCK. SET IT UP
	INPUT INF,TIOL		;TO TBUF
	STATO INF,740000	;ERRORS?
	AOS 0(P)		;NO. SKIP RETURN
	POPJ P,0		;RETURN

READBZ:	SETSTS INF,174		;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
	INPUT INF,0		;READ THE BLOCK
	GETSTS INF,T		;SEE IF ANY ERRORS
	SETSTS INF,117		;BACK TO REGULAR KLUDGE IO MODE
	TRNE T,740000		;ERRORS?
	POPJ P,0		;YES. NON-SKIP RETURN
	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
	OUTPUT OUTF,WIOL	;PUT OUT WBUF
	STATZ OUTF,740000	;ERRORS?
	JRST ERR19		;YES
	POPJ P,0		;NO

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

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

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

ROBTOD:	MOVEM T,ODIBKN		;SAVE BLK NUMBER IN ODIREC
	PUSHJ P,ROUTBT		;READ TO TBUF
	  SOS 0(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 0(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 0(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,0

MOVTR:	MOVE T,[XWD TBUF,RBUF]
	BLT T,RBUF+177
	POPJ P,0
WBK0:	PUSH P,A		;SAVE WORK AC'S
	PUSH P,B		; ..
	PUSH P,C		; ..
	MOVEI A,174		;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,0		;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
	OUTPUT OUTF,0		;WRITE IT ON TAPE
	STATZ OUTF,740000	;ERRORS?
	  POPJ P,0		;YES. LOSE
	SETSTS OUTF,117		;OK. RETURN TO DUMP MODE
	JRST CPOPJ1		;GOOD RETURN

ROUTBT:	TLNE F,L.SCRO		;SCRATCH OUTPUT FILE OPEN?
	JRST ROBT1		;YES
	USETI OUTF,0(T)		;NO. READ FROM TAPE, BLK IN T
	INPUT OUTF,TIOL		;READ THE BLOCK TO TBUF
	STATO OUTF,740000	;TROUBLE?
	AOS 0(P)		;NO. SKIP RETURN
	POPJ P,0

ROBT1:	USETI SCOF,1(T)		;SELECT BLOCK VIA T
	INPUT SCOF,TIOL		;READ TO TBUF
	STATO SCOF,740000	;OK?
	AOS 0(P)		;OK. SKIP RETURN
	POPJ P,0		; ..
;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:	.MSG <% CAN'T ENTER SCRATCH FILE ON DISK
>
	JRST TYPDIQ
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 UFD>
	JRST FILEX
ERR13:	.EMSG <? I/O ERROR READING UFD>
	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
ERR16A:	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,740000
	SETSTS INF,0(T)
	POPJ P,0		;YES
ERR16C:	STATZ INF,340000	;ERRORS BESIDES CKSM?
	JRST ERR16B		;YES. GIVE MESSAGE
	POPJ P,0		;NO. IGNORE ERROR.
ERR16D:	.EMSG <? I/O ERROR READING INPUT FILE
>
	JRST FILEX
ERR17:	.EMSG <? ERROR READING DISK SCRATCH FILE
>
	POPJ P,0
ERR18:	.EMSG <? BAD LINK BLOCK NUMBER ON TAPE
>
	POPJ P,0
ERR19:	.EMSG <? ERROR ON OUTPUT DEVICE>
	JRST FILEX
ERR20:	.EMSG <? OUTPUT TAPE FULL
>
	JRST CLS
ERR21=ERR10
ERR22:	TRNN F,R.OUT		;ANY OUTPUT SPEC?
	CAIL T,40		;NO. END OF LINE?
	SKIPA			;BAD
	JRST FILEX		;BLANK LINE. IGNORE IT
	.EMSG <? COMMAND ERROR - NO ← OR =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,0
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
	.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:	.EMSG	<? PROTECTION ILLEGAL ON INPUT FILE>
	JRST	FILEX
ERR31:	.EMSG	<? TAPE ID ILLEGAL ON INPUT FILE>
	JRST	FILEX
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,0
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,0

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
HELP:	MOVEI W,HELPM
	PUSHJ P,MSG
	JRST FILEX

HELPM:	ASCIZ \COMMANDS ARE OF THE FORM:
DEV:FILE.EXT[P,PN]<PROT>/S←DEV:FILE.EXT[P,PN]/S

"=" IS THE SAME AS "←"
THE INPUT (RIGHT-HAND) SIDE MAY HAVE MORE FILES IN THE SAME FORMAT,
 SEPARATED BY COMMAS.
DEV: DEFAULTS TO DSK:
FILE, .EXT DEFAULT TO *
 BUT .TMP FILES ARE NOT INCLUDED IN .* WHEN READING FROM DSK:.

PROT DEFAULTS TO SYSTEM STANDARD, <233> ON PDP11 TAPES
/S IS A SWITCH LETTER
(SSSS) IS OK FOR MULTIPLE SWITCHES

FILES ARE TRANSFERRED IN BINARY AND INDIVIDUALLY AT ALL TIMES,
 EXCEPT IN SOME CASES OF /V AND /F

SWITCHES ARE:

/A FORCES ASCII PROCESSING OF /V AND /F FILES
/B FORCES BINARY FILE TRANSFERS
/C SAYS FILE IS COMPRESSED (PDP10 .SAV)
/D SAYS FILE IS PDP6 .DMP FORMAT
/E SAYS FILE IS PDP10 .XPN FORMAT
/F SAYS TAPE IS A PDP FIFTEEN TAPE
/G SAYS GO ON IN CASE OF I/O ERRORS
/H SAYS HELP MESSAGE (NO FILE TRANSFERS ARE DONE)
/I FORCES IMAGE MODE ON /V TAPES
/L SAYS LIST FILE DIRECTORY OF TAPE (DO NOT SAY TTY:. THAT'S ASSUMED.)
/M SAYS TAPE IS PROJECT MAC FORMAT
/O SAYS TAPE IS OLD PDP6 FORMAT
/P SAYS SAME AS /Q BUT PRESERVE THE TEMP FILE IF ON INPUT TAPE
/Q SAYS QUICK MODE PROCESSING (COPY IN BIG GULPS BETWEEN DSK AND TAPE)
  BUT /Q IS NOT BELIEVED ON OUTPUT UNLESS /Z APPEARS TOO
/R SAYS SAME AS /Q BUT RE-USE TEMP FILE SAVED BY AN EARLIER /P
/S SAYS FILE IS A PROJECT MAC SAVE FILE (SBLK)
/T SAYS TAPE IS A NORMAL PDP TEN TAPE
/V SAYS TAPE IS A PDP-ELE-V-EN TAPE
/Z SAYS ZERO THE TAPE
 "↑TAPEID" OR "[P,PN]" MAY APPEAR WITH /Z FOR TAPES WHERE THIS
 IS MEANINGFUL.

IN THE EVENT NO SWITCHES DIRECT PROCESSING, FILE EXTENSIONS CAUSE THE
RIGHT THING TO HAPPEN IN THE FOLLOWING CASES:
.DMP IMPLIES /D
.SAV, .LOW, .SVE IMPLY /C
.XPN IMPLIES /E
THESE FILE EXTENSIONS ARE IMPLIED FOR OUTPUT FILES WITH THOSE
SWITCHES TOO, AS IS .BIN FOR /S.

IN THE CASE OF /V, THE FOLLOWING EXTENSIONS IMPLY /B PROCESSING:
.BIN, .OBJ, .SYS, .LDA, .LDR, .LOD, .LBO, .MFD, .UFD, .SYM
OTHERWISE, /A IS ASSUMED

IN THE CASE OF /F, .ABS IMPLIES /B (NOT IOPS), AND .BIN IMPLIES
IOPS BINARY TRANSFERS. OTHERWISE, IOPS ASCII IS ASSUMED FOR OUTPUT
TO /F, AND IOPS HEADERS ARE CHECKED FOR INPUT FROM /F.

\

CKSERR:	.MSG <MAC FILE CHECKSUM ERROR - CONTINUING
>
	POPJ P,0
FILSYN:	.EMSG <? EH?
>
	POPJ P,0
BADSW:	PUSHJ P,TYO
	.MSG < IS A BAD SWITCH
?>
	POPJ P,0
NOTYET:	.EMSG <? FEATURE NOT YET IMPLEMENTED>
	JRST FILEX
;TEMPORARIES

STATES:	0
IDEV:	0
IPPN:	0
IFILE:	0
TIFILE:	0
IEXT:	0
TIEXT:	0
DTFMTI:	0
SCRNAM:	0
LASTBK:	0
SJFF:	0			;.JBFF FOR UFD FOR WILDCARD LOOKUP
SJFF2:	0			;.JBFF FOR INPUT BUFFER BASE
SJFF3:	0			;.JBFF AS SEEN FOR OUTPUT BUFFER BASE
SJFF4:	0			;.JBFF AS SEEN BY RPBSCR RTN
BLKS:	0
ODEV:	0
OFILE:	0
TOFILE:	0
OEXT:	0
FOEXT:	0
TOEXT:	0
OPPN:	0
OPRT:	0
IDATE:	0
ODATE:	0
IBLK:	0
OBLK:	0
OSW:	0
ISW:	0
OFILEX:	0
IFILEX:	0
OCA:	0
ICA:	0
.DEV:	0
.FILE:	0
.EXT:	0
.PPPN:	0
.TPPN:	0
.PPRT:	0
.TPRT:	0
.PSW:	0
.TSW:	0
.BRKC:	0
OFIRBK:	0
OFIRBP:	0
OFIL1V:	0			;NAME1 OF VEN OUT FILE IN R50VEN
OFIL2V:	0			;SECOND HALF NAME
OEXTV:	0			;AND EXT
RADIX:	0
OTYPEX:	0
ITYPEX:	0
SRCHP:	0
SRCHPM:	0
OFILEL:	0
IMACP:	0
OMACP:	0
.TID:	0
OTID:	0
SCRBK1:	0
EOJFLG:	0
FTEMP:	0
FCOUNT:	0
MFDPPN:	0			;PPN TO FIND UFD'S
SYSPPN:	0			;PPN FOR SYS ON DSK
FBMX:	0
FBMBLK:	0			;BLOCK NUMBER FOR BIT MAP FOR CURRENT OUTPUT FILE
PBMBKI:	0			;BLK NUMBER FOR MASTER BIT MAP ON VEN TAPE
PBMBKO:	0			;SAME FOR OUTPUT VEN TAPE
TBBLK:	0			;BLOCK WHICH IS CURRENTLY IN TBUF
OBVFLG:	0			;FLAG NEED OBVCOM OF PREV BLK
IOPSOC:	0
IOPSOP:	0
FOTXP1:	0
FOTXP2:	0
FOTXW1:	0
FOTXW2:	0
IOPSOB:	BLOCK 200
VBMAPO=IOPSOB			;ELEVEN OUTPUT MASTER BIT MAP IN SAME SPACE
FITXP1:	0
FITXP2:	0
FITXW1:	0
FITXW2:	0
XFILFQ:	0
SAVSTA:	0			;START ADDR WHEN MAKING A SAV FILE
DIRBKN:	0			;BLK NUMBER CURRENTLY IN DIRECT BUFFER
ODIBKN:	0			;BLK NUMBER CURRENTLY IN ODIREC BUFFER
VENPPI:	0			;PPN (UIC) OF INPUT VEN TAPE
VOUIC:	0			;VEN OUTPUT USER ID CODE
VWPEI:	0			;VEN WORDS PER ENTRY IN UFD ON INPUT TAPE
VWPEO:	0			;VEN WDS PER UFD ENTRY OUTPUT TAPE
VIFFIL:	0			;INPUT FILE NAME FOR CURRENT VEN DIRECT SLOT IN SIXBIT
VIFEXT:	0			;INPUT FILE EXT IN SIXBIT ...
VDIRB1:	0			;FIRST REAL DATA BLK OF VEN DIR
VDIRB2:	0			;SECOND .. ..
VODIB1:	0			;FIRST REAL DATA BLK OF OUTPUT VEN DIR
VODIB2:	0			;SECOND ...
VENFBN:	0			;FIRST BLOCK NUMBER (AFTER A LOOKUP)
RPAVC1:	0			;FLAG FOR WHICH BYTE OF WORD
RPAVW1:	0			;WORD HELD BETWEEN TWO RPA'S
DIRIOW:	IOWD 200,DIRECT
	0
DIRECT:	BLOCK 200
ODIIOW:	IOWD 200,ODIREC
	0
ODIREC:	BLOCK 200

WIOL:	IOWD 200,WBUF
	0
WBUF:	BLOCK 200
RBUF:	BLOCK 200

IHED2:	BLOCK 3
OHED2:	BLOCK 3

TIOL:	IOWD 200,TBUF
	0
;DO NOT SEPARATE - NEEDED FOR BLOCK ZERO READER
TXIOL:	IOWD 400,TBUF
	0
TBUF:	BLOCK 200
XBUF:	BLOCK 200
;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:	0
	0

IHED:	BLOCK 3
OHED:	BLOCK 3
UHED:	BLOCK 3

LASTOB:	1101		;CONST FOR NOW
PDP:	IOWD 20,PDL
PDL:	BLOCK 20

	XLIST			;LITERALS
	LIT
	LIST

FILEXX:
	END FILEX		;END OF FILEX