PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/soupr/parse.mac

	TITLE	INDIR
	SEARCH	PRS,UUOSYM
	TWOSEG
	RELOC	0
SPC:	BLOCK	SPCSIZ			;FILESPEC OF INDIRECT FILE
	RELOC	400000
	ENTRY	INDIR
	EXTERN	CI,ICH,FNDCH,LKP,ICLS,SPCI,EATCR,BP,PRSSYN,CPOPJ1
INDIR:	CAIE	C,"@"			;INDIRECT?
	POPJ	P,			;NO
	PUSHJ	P,CI			;YES, EAT "@"
	 POPJ	P,
	PUSH	P,P1			;SAVE P1
	PUSHJ	P,PSPC			;PARSE THE SPEC
	 JRST	INDDN2
	PUSH	P,ICH			;SAVE INPUT CH
	PUSHJ	P,FNDCH			;ALLOCATE A CH
	 HALT
	PUSH	P,T1			;SAVE IT ON STACK
	MOVEM	T1,ICH			;AND SELECT IT
	MOVEI	P1,SPC			;OPEN THE FILE
	PUSHJ	P,LKP
	 JRST	INDDON
INDLOP:	MOVE	T1,(P)			;SELECT THE CHANNEL
	MOVEM	T1,ICH
	PUSHJ	P,CI			;INPUT 1ST CHAR
	 JRST	INDDON
	PUSHJ	P,@-3(P)		;LET USER PARSE THIS LINE
	 JFCL
	JRST	INDLOP
INDDON:	POP	P,ICH			;CLOSE THE FILE
	PUSHJ	P,ICLS
	POP	P,ICH			;RESTORE ORIGINAL CH
INDDN2:	POP	P,P1			;RESTORE P1
	POP	P,T1			;PUSHJ P,INDIR
	POPJ	P,

PSPC:	SETZM	SPC			;BUILD DEFAULT SPEC
	MOVE	T1,[XWD SPC,SPC+1]
	BLT	T1,SPC+SPCSIZ-1
	MOVSI	T1,SPCSIZ
	MOVEM	T1,SPC+.SBSIZ
	MOVSI	T1,'DSK'
	MOVEM	T1,SPC+.SBDEV
	HRROI	T1,.GTPRG
	GETTAB	T1,
	 MOVSI	T1,'SPC'
	MOVEM	T1,SPC+.SBNAM
	MOVSI	T1,'CMD'
	MOVEM	T1,SPC+.SBEXT
	MOVEI	T1,.IOASC
	MOVEM	T1,SPC+.SBMOD
	MOVEI	P1,SPC			;PARSE THE SPEC
	PUSHJ	P,SPCI
	 POPJ	P,
	PUSHJ	P,EATCR			;TEST FOR BREAK CHAR
	 POPJ	P,
	PUSHJ	P,BP
	 JRST	PRSSYN
	JRST	CPOPJ1
	PRGEND
	TITLE	SWINI - READ SWITCH.INI
;THIS ROUTINE WILL READ SWITCH.INI ON A FREE CH AND PARSE THE SWITCHES
;ENTER WITH P2 AND P3 SET UP FOR SWTCH
;RETURNS CPOPJ IF I/O ERROR IN SWITCH.INI
;ELSE RETURNS CPOPJ1
	SEARCH	PRS,UUOSYM
	TWOSEG
	RELOC	400000
	ENTRY	SWINI
	EXTERN	EATCR,PRSSYN,BP,CPOPJ1
	EXTERN	SAVE1,ICH,FNDCH,FOO,SLKP,CI,ICLS,EATEOL,SIXI,SWTCH
SWINI:	PUSHJ	P,SAVE1			;SAVE P1
	PUSH	P,ICH			;SAVE INPUT CH
	PUSHJ	P,FNDCH			;FIND A FREE CH
	 HALT
	MOVEM	T1,ICH
	PUSH	P,C			;SAVE CHAR
	SETZM	FOO			;CLEAR FOO
	MOVE	T1,[XWD FOO,FOO+1]
	BLT	T1,FOO+FOOSIZ-1
	HRLZI	T1,'DSK'		;SET UP FILESPEC
	MOVEM	T1,FOO+.SBDEV
	HRLZI	T1,'INI'
	MOVEM	T1,FOO+.SBEXT
	MOVE	T1,[SIXBIT /SWITCH/]
	MOVEM	T1,FOO+.SBNAM
	HRROI	T1,.GTPPN
	GETTAB	T1,
	 HALT
	MOVEM	T1,FOO+.SBPPN
	MOVEI	T1,.IOASC
	MOVEM	T1,FOO+.SBMOD
	MOVEI	P1,FOO			;LOOKUP THE FILE
	PUSHJ	P,SLKP
	 JRST	WIN
	HRROI	P1,.GTPRG		;PROGRAM TO LOOK FOR
	GETTAB	P1,
	 HALT
SWLOP:	PUSHJ	P,CI			;INPUT 1ST CHAR
	 JRST	SWINI9
	PUSHJ	P,SIXI			;INPUT THE PROGRAM NAME
	 JRST	LOOSE
	CAMN	P1,T1			;OUR NAME?
	JRST	SWFND			;YES, WE FOUND IT
	PUSHJ	P,EATEOL		;NO, EAT THE LINE
	 JRST	LOOSE
	JRST	SWLOP			;KEEP LOOKING
SWFND:	PUSHJ	P,SWTCH			;PROCESS THE SWITCHES
	 JRST	LOOSE
	PUSHJ	P,EATCR			;TEST FOR BREAK CHAR
	 JRST	LOOSE
	PUSHJ	P,BP
	 JRST	LOOSE
	JRST	WIN
LOOSE:	TRON	C,IO.ERR		;TYPED AN ERROR MESSAGE YET?
	PUSHJ	P,PRSSYN		;NO, USE THE CATCH ALL
SWINI9:	TRNE	C,IO.ERR		;EOF OR ERROR?
	SOS	-2(P)			;ERROR, NOSKIP RETURN
WIN:	PUSHJ	P,ICLS			;CLOSE SWITCH.INI
	POP	P,C			;RESTORE THE CHAR
	POP	P,ICH			;RESTORE THE CH
	JRST	CPOPJ1
	PRGEND
	TITLE	VERBO - OUTPUT A VERBOSITY ERROR MESSAGE
;CALL:
;	MOVEI	T1,FOO
;	PUSHJ	P,VERBO
;	ETC
;	ADDR2
;	ADDR1
;FOO:	XWD	BITS,"?"
;	SIXBIT	/PREFIX/
;	ASCIZ	/FIRST/
;WHERE THE FIRST OCCURENCE OF "^" IN FIRST CAUSES VERBO TO DO A
;PUSHJ TO ADDR1. IT IS ASSUMED THAT ADDR1 IS THE ADDRESS OF A ROUTINE
;THAT WILL TYPE OUT SOME VARIABLE PART OF THE ERROR MESSAGE.
;THE SECOND OCCURENCE OF "^" CAUSES VERBO TO DO A PUSHJ TO ADDR2. ETC.
;ARGS CAN BE PASSED FROM THE CALLER OF VERBO TO THE ADDRN ROUTINE IN P1.
;P1 IS PRESERVED THROUGH VERBO FOR THIS PURPOSE.
;THE ADDRN ROUTINE MAY RETURN CPOPJ OR CPOPJ1,
;BUT VERBO ALWAYS RETURNS CPOPJ
	SEARCH	PRS,UUOSYM
	TWOSEG
	RELOC	400000
	ENTRY	VERBO
	EXTERN	OCH,SAVE3,SIXO,CRLFO,CO,CPOPJ
VERBO:	SETOM	OCH			;OSELECT TTY
	PUSHJ	P,SAVE3			;SAVE P1-P3
	MOVE	P2,T1			;COPY ARG
	HRROI	P3,.GTWCH		;GET VERB BITS
	GETTAB	P3,
	 SETZ	P3,
	TLNN	P3,(JW.WPR+JW.WFL)
	HRLZI	P3,(JW.WPR+JW.WFL)
	PUSHJ	P,CRLFO
	 HALT
	MOVE	T1,(P2)			;EAT TYPE AHEAD?
	TLNE	T1,(ER.EAT)
	CLRBFI				;YES
	HRRZ	C,T1			;TYPE "%" OR "?"
	PUSHJ	P,CO
	 HALT
	MOVE	T1,1(P2)		;GET PREFIX
	TLNE	P3,(JW.WPR)		;PREFIX?
	PUSHJ	P,SIXO			;YES, TYPE IT
	 JFCL
	TLNN	P3,(JW.WFL)		;FIRST?
	POPJ	P,
	MOVEI	C," "
	PUSHJ	P,CO
	 HALT
	MOVEI	P3,2(P2)		;YES, TYPE IT
	HRLI	P3,(POINT 7)
VERBO8:	ILDB	C,P3			;GET NEXT CHAR
	JUMPE	C,CPOPJ			;QUIT IF EOS
	CAIN	C,"^"			;SPECIAL?
	JRST	VERBO9			;YES
	PUSHJ	P,CO			;NO
	 HALT
	JRST	VERBO8
VERBO9:	PUSHJ	P,@-1(P2)		;FILL IN THE BLANK
	 JFCL
	SOJA	P2,VERBO8		;BACK PNTR UP AND GO FOR MORE
	PRGEND
	TITLE	SPCSI - PARSE A STRING OF FILE SPECS
;P1 PASSES ADR OF 1ST SPC (DESTROYED)
;SPC MUST BE PRE-LOADED WITH DEFAULTS
;P2+P3 PASS SWITCH ARGS
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	SPCSI
	EXTERN	SPCI,SWTCH,EATS,CPOPJ1,CI,GETBLK
SPCSI:	PUSHJ	P,SPCI			;GET FILE SPEC
	 POPJ	P,
	PUSHJ	P,SWTCH			;DO SWITCHES
	 POPJ	P,
	PUSHJ	P,EATS			;ANOTHER SPC COMING?
	 POPJ	P,
	CAIE	C,","
	JRST	CPOPJ1			;NO
	PUSHJ	P,CI			;YES, EAT THE COMMA
	 POPJ	P,
	HLRZ	T1,.SBSIZ(P1)		;GET CORE FOR ANOTHER SPC
	PUSHJ	P,GETBLK
	 POPJ	P,
	ADD	T1,T2			;STICKY DEFAULTS
	HRLZ	T3,P1
	HRR	T3,T2
	BLT	T3,-1(T1)
	HRRM	T2,.SBNXT(P1)		;APPEND TO LINK LIST
	MOVE	P1,T2
	JRST	SPCSI			;GO GET THE SPC
	PRGEND
	TITLE	LSTI - INPUT A SIXBIT LIST
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	LSTI
	EXTERN	CI,EATS,GETBLK,WSIXI,CPOPJ1,PRSSYN
LSTI:	PUSHJ	P,EATS			;EAT SPACES
	 POPJ	P,
	SETZ	P1,			;0 MEANS END OF LIST
	CAIE	C,"("			;REAL LIST OR JUST 1?
	JRST	LSTESY			;ONE
LSTLOP:	PUSHJ	P,CI			;EAT IT
	 POPJ	P,
	PUSHJ	P,LSTESY		;GET ONE ITEM
	 POPJ	P,
	PUSHJ	P,EATS			;EAT SPACES
	 POPJ	P,
	CAIN	C,","			;ANOTHER COMING?
	JRST	LSTLOP			;YES
	CAIE	C,")"			;NO, BETTER BE END
	JRST	PRSSYN
	JRST	CI			;EAT THE RIGHT
LSTESY:	MOVEI	T1,3			;GET A CORE BLOCK
	PUSHJ	P,GETBLK
	 POPJ	P,
	HRRM	P1,(T2)			;LINK IT TO FRONT OF LIST
	MOVE	P1,T2			;NEW FRONT
	PUSHJ	P,WSIXI			;GET A SIXBIT WORD
	 POPJ	P,
	MOVEM	T1,1(P1)		;STORE IT
	MOVEM	T2,2(P1)
	JRST	CPOPJ1
	PRGEND
	TITLE	EXT - EXIT SWITCH
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	EXT
	EXTERN	EATEOL
EXT:	PUSHJ	P,EATEOL		;EAT UNTIL EOL
	 HALT
	EXIT
	PRGEND
	TITLE	EATEOL - EAT UNTIL EOL
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	EATEOL
	EXTERN	CI,BP,CPOPJ1
EATEO2:	PUSHJ	P,CI			;EAT IT
	 POPJ	P,
;ENTER HERE
EATEOL:	PUSHJ	P,BP			;BREAK CHAR?
	 JRST	EATEO2			;NO
	JRST	CPOPJ1			;YES
	PRGEND
	TITLE	HELPER - HELP SWITCH
	SEARCH	PRS,UUOSYM
	TWOSEG
	RELOC	400000
	ENTRY	HELPER
	EXTERN	SAVE1,ICH,FNDCH,FOO,LKP,GETC,ICLS
HELPER:	PUSHJ	P,SAVE1			;SAVE P1
	PUSH	P,ICH			;SAVE INPUT CH
	PUSHJ	P,FNDCH			;FIND A FREE CH
	 HALT
	MOVEM	T1,ICH			;ISELECT IT
	PUSH	P,C			;SAVE CHAR
	SETZM	FOO			;CLEAR FOO
	MOVE	T1,[XWD FOO,FOO+1]
	BLT	T1,FOO+FOOSIZ-1
	HRLZI	T1,'HLP'		;HLP:*.HLP
	MOVEM	T1,FOO+.SBDEV
	MOVEM	T1,FOO+.SBEXT
	HRROI	T1,.GTPRG		;GET PROGRAM NAME
	GETTAB	T1,
	 HALT
	MOVEM	T1,FOO+.SBNAM
	MOVEI	T1,.IOASC
	MOVEM	T1,FOO+.SBMOD
	MOVEI	P1,FOO			;LOOKUP THE FILE
	PUSHJ	P,LKP
	 JRST	HLPDON
HLPLOP:	PUSHJ	P,GETC			;INPUT A CHAR
	 JRST	HLPDON
	OUTCHR	C			;OUTPUT IT
	JRST	HLPLOP
HLPDON:	PUSHJ	P,ICLS			;RELEASE CH
	POP	P,C			;RECALL CHAR
	POP	P,ICH			;RECALL INPUT CH
	POPJ	P,
	PRGEND
	TITLE	RST - RESET
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	RST
	EXTERN	FREMEM,RNGHDR
RST:	RESET				;MONITOR DOES MOST
	SETZM	FREMEM			;NO FREE BLOCKS
	SETZM	RNGHDR			;CLEAR RING HDR TABLE
	MOVE	T1,[XWD RNGHDR,RNGHDR+1]
	BLT	T1,RNGHDR+17
	POPJ	P,
	PRGEND
	TITLE	SWTCH - PARSE SWITCHES
;P2 PASSES AOBJN POINTER TO TABLE OF SWITCH NAMES
;P3 PASSES ADR OF TABLE OF ONE INSTRUCTION ROUTINES
;SWTCH WILL XCT THE INSTRUCTION CORRESPONDING TO THE SWITCH NAME.
;IF ONE INSTRUCTION ISN'T ENOUGH, USE A PUSHJ TO A SUBROUTINE.
;THE SUBROUTINE IS EXPECTED TO PRESERVE P1-P4, BUT MAY DESTROY T1-T4.
;THE SUBROUTINE IS EXPECTED TO RETURN CPOPJ.
;CPOPJ1 WILL BE REGARDED AS AN ERROR RETURN,
;AND SWTCH WILL PASS THE ERROR TO ITS CALLER BY RETURNING CPOPJ.
;SWTCH NORMALLY RETURNS CPOPJ1.
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	SWTCH
	EXTERN	EATS,CPOPJ1,CI,SIXI,FNDNAM
SWTCH:	PUSHJ	P,EATS			;EAT SPACES
	 POPJ	P,
	CAIE	C,"/"			;ANY SWITCHES?
	JRST	CPOPJ1			;NO
	PUSHJ	P,CI			;YES, EAT THE SLASH
	 POPJ	P,
	PUSHJ	P,SIXI			;GET THE SWITCH NAME
	 POPJ	P,
	MOVE	T2,P2			;FIND IT IN TABLE
	PUSHJ	P,FNDNAM
	 POPJ	P,
	ADD	T2,P3			;XCT THE SWITCH
	XCT	(T2)
	 JRST	SWTCH			;SWITCH WON, LOOK FOR ANOTHER
	POPJ	P,			;SWITCH LOST
	PRGEND
	TITLE	WILDER - WILDCARD LOOKUP
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	WILDER
	EXTERN	WLDCNT,WILD,WLDNSF,CPOPJ1
WILDER:	SETZM	WLDCNT			;RESET COUNT
	PUSHJ	P,WILD			;WILDCARD LOOKUP
	 JFCL
	SKIPN	WLDCNT			;ANY FILES?
	JRST	WLDNSF			;NO
	JRST	CPOPJ1
	PRGEND
	TITLE	WILD - WILDCARD LOOKUP
;P1 PASSES ADR FILE SPEC
;P2 PASSES ADR OF USER ROUTINE
;WILD WILL PUSHJ TO THE USER ROUTINE FOR EACH FILE MATCHED BY THE WILDCARD
;WHEN THE USER ROUTINE IS CALLED, P1 WILL STILL POINT TO THE FILE SPEC,
;BUT THE SPEC WILL HAVE BEEN MODIFIED TO REPRESENT THE PARTICULAR FILE
;THE USER ROUTINE MAY RETURN CPOPJ1 IF IT LIKES, NON-SKIP RETURNS
;ARE IGNORED
;WILD WILL RESTORE THE SPEC TO ITS ORG STATE BEFORE IT EXITS
;WILD MAY RETURN CPOPJ1 (MEANINGLESS)
	SEARCH	PRS,UUOSYM
	TWOSEG
	RELOC	400000
	ENTRY	WILD
	EXTERN	IINS,ICH,GETC,WILDP,WLDNSF,PRSIN,PRSOPN
	EXTERN	CPOPJ1,FOO,FNDCH,OPN,ICLS,CNVSPC,RNGHDR
	EXTERN	GETRNG,CPOPJ,PRSLKP,MYPATH,FIL,GETBLK,SLKP
	DIRBLK=^D100			;BLK OF DTA DIRECTORY
	DTNAM=^D83			;INDEX OF 1ST FILENAME IN DIR
	DTNUM=^D22			;FILES IN DIR
	DTEXT=DTNAM+DTNUM		;INDEX OF 1ST EXT
WILD:	PUSHJ	P,WILDP			;ANY WILD CARDS?
	 JRST	(P2)			;NO, JUST DO IT
	SKIPE	.SMDEV(P1)		;WILD DEVICE?
	JRST	AL			;YES, SUBSET OF ALL
	MOVE	T1,.SBDEV(P1)		;NO, GET DEVICE TYPE
	DEVCHR	T1,
	TLNE	T1,(DV.DTA)		;DEC-TAPE?
	JRST	DTA			;YES
	TLNN	T1,(DV.DSK)		;DISK?
	JRST	(P2)			;NO, NOT A DIRECTORY DEVICE
	MOVE	T1,.SBDEV(P1)		;YES, GET IT'S PATH
	MOVEM	T1,FOO
	MOVE	T2,[XWD FOOSIZ,FOO]
	PATH.	T2,
	 HALT
	MOVE	T1,FOO			;UNDONE LOGICAL NAME
	MOVE	T2,FOO+.PTSWT		;GET SWITCHES
	LDB	T3,[POINT 3,T2,29]	;GET SEARCH LIST TYPE
	TRNN	T2,PT.IPP		;ERSATZ?
	JRST	WILD1
	MOVE	T4,FOO+.PTPPN		;YES, OVER-RIDE USER PATH
	MOVEM	T4,.SBPPN(P1)
	IFN	SFDS,<
	SETZM	.SBPPN+1(P1)
>
	SETZM	.SMPPN(P1)
	CAIN	T3,.PTSLN		;ERSATZ WITH NO SEARCH LIST?
	HRLI	T1,'DSK'		;YES, USE THAT PPN ON DSKX
WILD1:	MOVEM	T1,.SBDEV(P1)		;PUT FINAL VERSION OF DEVICE BACK
	CAMN	T1,[SIXBIT /DSK/]	;IS IT DEFAULT DSK?
	MOVEI	T3,.PTSLJ		;YES, AVOID A MONITOR BUG
	CAIN	T3,.PTSLN		;NON-STANDARD SEARCH LIST
	JRST	WLD
	CAIN	T3,.PTSLJ		;JOB SEARCH LIST
	JRST	JOB
	CAIN	T3,.PTSLA		;ALL SEARCH LIST
	JRST	ALL
	CAIN	T3,.PTSLS		;SYS SEARCH LIST
	JRST	SYS
	HALT
;JOB SEARCH LIST
JOB:	SETOB	T1,T2			;OUR JOB, OUR PPN
	JRST	SYS1

;SYS SEARCH LIST
SYS:	SETZ	T1,			;SYS=JOB 0
SYS1:	SETO	T3,			;1ST STR IN SEARCH LIST
	PUSH	P,.SBDEV(P1)		;SAVE ORG DEVICE
	PUSH	P,.SMDEV(P1)
	PUSH	P,T1			;SAVE GOBSTR ARG BLK IN STACK
	PUSH	P,T2
	PUSH	P,T3
SYSLOP:	MOVEI	T1,-2(P)		;GET NEXT STR
	HRLI	T1,3
	GOBSTR	T1,
	 HALT
	SKIPN	T1,(P)
	JRST	SYSDON			;FENCE
	MOVEM	T1,.SBDEV(P1)		;PASS IT TO USER
	PUSHJ	P,WLD			;DO WILD CARDS
	 JFCL
	JRST	SYSLOP			;TRY FOR ANOTHER STR
;ALL SEARCH LIST
ALL:	SETOM	.SMDEV(P1)		;MAKE ALL *
AL:	PUSH	P,.SBDEV(P1)		;SAVE ORG DEVICE
	PUSH	P,.SMDEV(P1)		;AND MASK
	SETZM	.SMDEV(P1)		;PASS NON-WILD MASK TO USER
	TDZA	T1,T1			;1ST STR IN SEARCH LIST
ALLOP:	MOVE	T1,.SBDEV(P1)		;GET NEXT STR
	SYSSTR	T1,
	 HALT
	JUMPE	T1,ALLDON		;0 MEANS NONE LEFT
	MOVEM	T1,.SBDEV(P1)		;PASS IT TO USER
	XOR	T1,-1(P)		;MATCH WILD MASK?
	ANDCM	T1,(P)
	JUMPN	T1,ALLOP		;NO, TRY NEXT STR
	PUSHJ	P,WLD			;YES, DO WILDCARDS
	 JFCL
	JRST	ALLOP			;TRY FOR ANOTHER

;HERE WHEN SYS SEARCH IS DONE
SYSDON:	POP	P,T3			;EAT GOBSTR ARG BLK
	POP	P,T2
	POP	P,T1

;HERE WHEN ALL SEARCH IS DONE
ALLDON:	POP	P,.SMDEV(P1)		;RESTORE MASK
	POP	P,.SBDEV(P1)		;RESTORE DEVICE
	JRST	CPOPJ1
;HERE WHEN DEVICE IS DEC-TAPE
DTA:	HRRZ	T1,.SMEXT(P1)		;ANY WILDCARDS?
	IOR	T1,.SMNAM(P1)
	JUMPE	T1,(P2)			;NO, JUST GOTO USER ROUTINE
	PUSHJ	P,FNDCH			;FIND A FREE CH
	 HALT
	MOVEM	T1,ICH			;ISELECT IT
	MOVEI	T1,3			;GET A RING HDR
	PUSHJ	P,GETBLK
	 POPJ	P,
	MOVEM	T2,OPN+.OPBUF
	MOVE	T1,.SBDEV(P1)		;AND BUILD OPEN BLK
	MOVEM	T1,OPN+.OPDEV
	MOVEI	T1,.IOIBN
	MOVEM	T1,OPN+.OPMOD
	PUSHJ	P,IINS			;OPEN IT
	OPEN	OPN
	 JRST	PRSOPN
	MOVE	T3,ICH			;STORE ADR RING HDR
	HRRZ	T2,OPN+.OPBUF
	HRRM	T2,RNGHDR(T3)
	PUSHJ	P,GETRNG		;GET BUF RING
	 JRST	ICLS
	PUSHJ	P,IINS			;WILL READ DIRECTORY BLOCK
	USETI	DIRBLK
	PUSHJ	P,IINS			;READ IT
	IN
	 CAIA				;WIN
	JRST	PRSIN			;COMPLAIN
	PUSHJ	P,IINS			;RELEASE CH
	RELEAS
	PUSH	P,.SBNAM(P1)		;-3(P) SAVE ORG STUFF
	PUSH	P,.SMNAM(P1)		;-2(P)
	SETZM	.SMNAM(P1)		;PASS NON-WILD MASK TO USER
	PUSH	P,.SBEXT(P1)		;-1(P)
	MOVE	T1,OPN+.OPBUF		;GET ADR OF BUF
	HRRZ	T1,1(T1)
	TLOA	T1,-<DTNUM+1>		;AOB POINTER
DTALOP:	POP	P,T1			;RECALL COUNTS
	AOBJP	T1,DTADON		;BUMP COUNTS
	PUSH	P,T1			;STORE COUNTS AGAIN
	SKIPN	T2,DTNAM-1(T1)		;GET FILENAME FROM DIR
	JRST	DTALOP
	MOVEM	T2,.SBNAM(P1)		;PASS IT TO USER
	XOR	T2,-3(P)		;MATCH WILD MASK?
	ANDCM	T2,-2(P)
	JUMPN	T2,DTALOP		;NO, TRY NEXT FILE
	MOVE	T2,DTEXT-1(T1)		;GET EXTENSION FROM DIR
	HLLZM	T2,.SBEXT(P1)		;PASS IT TO USER
	XOR	T2,-1(P)		;MATCH WILD MASK?
	HRLO	T3,-1(P)
	ANDCM	T2,T3
	JUMPN	T2,DTALOP		;NO, TRY NEXT FILE
	PUSHJ	P,(P2)			;YES, DO USER ROUTINE
	 JFCL
	JRST	DTALOP			;TRY FOR ANOTHER FILE

;HERE WHEN ALL 22 DTA FILES ARE DONE
DTADON:	POP	P,.SBEXT(P1)		;RESTORE ORG STUFF
	POP	P,.SMNAM(P1)
	POP	P,.SBNAM(P1)
	PUSHJ	P,ICLS			;CLOSE THE CH
	JRST	CPOPJ1
;ROUTINE TO DO DISK WILDCARDS
;P1 PASSES ADR FILE SPEC
;P2 PASSES ADR USER ROUTINE
;POSSIBLE SKIP RETURN (MEANINGLESS)
WLD:	PUSHJ	P,WILDP			;WILD?
	 JRST	(P2)			;NO, JUST GOTO USER ROUTINE
	PUSH	P,P3			;0(P3) BUILD ARG BLK TO WLDU IN STACK
	MOVE	P3,P			;SAVE IT'S ADR
	PUSH	P,P2			;1(P3)
	MOVEI	P2,WLDU
	PUSH	P,.SBNAM(P1)		;2(P3)
	PUSH	P,.SMNAM(P1)		;3(P3)
	PUSH	P,.SBEXT(P1)		;4(P3)
	PUSHJ	P,PSHSPC		;GET PARENT DIR
	PUSHJ	P,WLD			;CALL WLDU FOR EACH FILE IN DIR
	 JFCL
	PUSHJ	P,POPSPC		;GET OFFSPRING PATH
	POP	P,.SBEXT(P1)		;RESTORE ORG STUFF
	POP	P,.SMNAM(P1)
	POP	P,.SBNAM(P1)
	POP	P,P2
	POP	P,P3
	POPJ	P,
;WLD IS SUPPOSED TO CALL A USER ROUTINE
;SOMETIMES IT CALLS ITSELF RECURSIVELY INSTEAD
;IF SO, IT REPLACES THE USER CALL WITH A CALL TO WLDU
;WLDU'S FUNCTION IS TO CALL THE ORG USER ROUTINE,
;ONCE FOR EACH FILE IN THE DIR
;CALL:
;	MOVEI	P1,<SPEC OF DIR>
;	MOVEI	P2,WLDU
;	MOVEI	P3,FOO
;	PUSHJ	P,(P2)
;	 JFCL
;FOO:	WHEN CALLED RECURSIVELY, ADR OF CALLER'S ARG BLOCK
;FOO+1:	ADR USER ROUTINE CALLER WAS SUPPOSED TO CALL
;FOO+2:	NAME OF FILE TO FIND IN DIR
;FOO+3:	WILD MASK FOR ABOVE FILENAME
;FOO+4:	EXTENSION AND MASK
WLDU:	PUSHJ	P,FNDCH			;FIND A FREE CH
	 HALT
	MOVEM	T1,ICH			;ISELECT IT
	PUSHJ	P,LU			;LOOKUP THE DIR
	 JRST	WLDLKP
	PUSHJ	P,POPSPC		;GET OFFSPRING PATH
	MOVE	P2,1(P3)		;RESTORE ADR ORG USER ROUTINE
	PUSH	P,P3			;SAVE ADR ARG BLK
	HRRZ	T1,4(P3)		;WILD?
	IOR	T1,3(P3)
	MOVE	P3,(P3)			;RESTORE ADR CALLER'S ARG BLK
	JUMPE	T1,WLDESY		;NO, EASY
	SETZM	.SMNAM(P1)		;PASS NON-WILD MASK TO USER
WLDLOP:	PUSHJ	P,GETC			;INPUT THE FILE NAME
	 JRST	WLDEOF			;EOF OR ERROR
	MOVEM	C,.SBNAM(P1)		;PASS IT TO USER
	PUSHJ	P,GETC			;INPUT THE EXTENSION
	 HALT
	HLLZM	C,.SBEXT(P1)		;PASS IT TO USER
	SKIPN	T1,.SBNAM(P1)		;NULL FILE?
	JRST	WLDLOP			;YES, IGNORE IT
	MOVE	T2,(P)			;FILENAME MATCH MASK?
	XOR	T1,2(T2)
	ANDCM	T1,3(T2)
	JUMPN	T1,WLDLOP		;NO, TRY NEXT FILE
	XOR	C,4(T2)			;EXTENSION MATCH MASK?
	HRLO	T1,4(T2)
	ANDCM	C,T1
	JUMPN	C,WLDLOP		;NO, TRY NEXT FILE
	PUSH	P,ICH			;SAVE DIR CH
	PUSHJ	P,(P2)			;CALL USER ROUTINE
	 JFCL
	POP	P,ICH			;RESTORE DIR CH
	JRST	WLDLOP			;TRY FOR ANOTHER FILE
;HERE WHEN SPEC ISN'T WILD AFTER ALL
WLDESY:	MOVE	T2,(P)			;GET ADR ARG BLK
	MOVE	T1,2(T2)		;PUT IN NAME OF FILE
	MOVEM	T1,.SBNAM(P1)
	MOVE	T1,4(T2)
	MOVEM	T1,.SBEXT(P1)
	PUSH	P,ICH			;SAVE CH
	PUSHJ	P,(P2)			;CALL USER ROUTINE
	 JFCL
	POP	P,ICH			;RESTORE CH
WLDEOF:	PUSHJ	P,PSHSPC		;GET PARENT DIR BACK
	POP	P,P3			;RESTORE ADR ARG BLK
	MOVEI	P2,WLDU			;RESTORE P2
WLDLKP:	JRST	ICLS			;RELEASE THE CH
;ROUTINE TO FIND PARENT SFD OR UFD
;P1 PASSES ADR OF FILE SPEC
;THE SPEC IS NOT PRESERVED!
;IT IS CONVERTED INTO PARENT SPEC
PSHSPC:	SKIPN	.SBPPN(P1)		;PATH SPECIFIED?
	PUSHJ	P,MYPATH		;NO, USE DEFAULT
	IFE	SFDS,<
	MOVE	T2,.SBPPN(P1)		;MOVE UFD TO FRONT
	MOVEM	T2,.SBNAM(P1)
	MOVE	T2,.SMPPN(P1)
	MOVEM	T2,.SMNAM(P1)
>	;END IFE SFDS
	IFN	SFDS,<
	MOVE	T1,P1			;FIND END OF PATH
PSHSP1:	SKIPE	.SBPPN+1(T1)
	AOJA	T1,PSHSP1
	MOVE	T2,.SBPPN(T1)		;MOVE LAST SFD TO FRONT
	MOVEM	T2,.SBNAM(P1)
	MOVE	T2,.SMPPN(T1)
	MOVEM	T2,.SMNAM(P1)
	HRLZI	T2,'SFD'
	MOVEM	T2,.SBEXT(P1)
	SETZM	.SBPPN(T1)		;CHOP IT OFF THE END
	CAME	T1,P1			;IT WAS AN SFD WASN'T IT?
	POPJ	P,			;YES, LUCKY GUESS
>	;END IFN SFDS
	HRLZI	T2,'UFD'		;NO, OOPS A UFD
	MOVEM	T2,.SBEXT(P1)
	MOVE	T2,[%LDMFD]		;A UFD'S PARENT IS THE MFD
	GETTAB	T2,			;GET THE MFD PPN
	 MOVE	T2,[XWD 1,1]
	MOVEM	T2,.SBPPN(P1)
	SETZM	.SMPPN(P1)		;THERE'S ONLY ONE MFD!
	POPJ	P,
;THIS ROUTINE IS THE CONVERSE OF PSHSPC
;IE IT CONVERTS THE SPEC OF A DIR INTO THE PATH OF AN OFFSPRING FILE
POPSPC:	IFN	SFDS,<
	MOVE	T1,P1			;ASSUME UFD
	HLRZ	T2,.SBEXT(P1)		;A UFD?
	CAIN	T2,'UFD'
	JRST	POPSP1			;YES, ALREADY KNOW LENGTH OF PATH
POPSP2:	SKIPE	.SBPPN(T1)		;NO, FIND END OF PATH
	AOJA	T1,POPSP2
POPSP1:	MOVE	T2,.SBNAM(P1)		;MOVE FILE THERE
	MOVEM	T2,.SBPPN(T1)
	MOVE	T2,.SMNAM(P1)
	MOVEM	T2,.SMPPN(T1)
	SETZM	.SBPPN+1(T1)		;ADD TERMINATOR
>	;END IFN SFDS
	IFE	SFDS,<
	MOVE	T2,.SBNAM(P1)		;MOVE FILE TO PATH
	MOVEM	T2,.SBPPN(P1)
	MOVE	T2,.SMNAM(P1)
	MOVEM	T2,.SMPPN(P1)
>	;END IFE SFDS
	POPJ	P,
LU:	PUSH	P,.SBMOD(P1)		;SAVE ORG MODE
	MOVEI	T1,.IOIBN		;SET MODE TO IMAGE
	MOVEM	T1,.SBMOD(P1)
	PUSHJ	P,SLKP			;TRY TO LOOKUP
	 JRST	LU0
	POP	P,.SBMOD(P1)		;RESTORE ORG MODE
	JRST	CPOPJ1
LU0:	POP	P,.SBMOD(P1)		;RESTORE ORG MODE
	HRRZ	T1,FIL+1		;GET ERROR CODE
	JUMPE	T1,CPOPJ		;ERFNF% FILE NOT FOUND
	IFN	SFDS,<
	CAIE	T1,ERSNF%		;SFD NOT FOUND
>	;END IFN SFDS
	CAIN	T1,ERIPP%		;UFD NOT FOUND
	POPJ	P,
	JRST	PRSLKP
	PRGEND
	TITLE	WLDNSF
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	WLDNSF
	INTERN	WLDCNT
	EXTERN	SPCO,VERBO
WLDNSF:	MOVEI	T1,WLD1
	PJRST	VERBO
	SPCO
WLD1:	VB	0,"%",WLDNSF,<No such files as ^>
	LIT				;PUT LITERALS IN HISEG
	RELOC	0			;SWITCH TO LOWSEG
WLDCNT:	BLOCK	1			;COUNT OF FILES
	PRGEND
	TITLE	WILDP - TEST IF SPEC IS WILD
;P1 PASSES ADR SPEC
;SKIP IF WILD
;THIS ROUTINE ONLY CONSIDERS THE MASK WORDS
;IT DOESN'T CHECK SEARCH LISTS
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	WILDP
	EXTERN	CPOPJ1
WILDP:	HRRZ	T1,.SMEXT(P1)		;EXTENSION
	IOR	T1,.SMDEV(P1)		;DEVICE
	IOR	T1,.SMNAM(P1)		;FILENAME
	IFN	SFDS,<
	SKIPA	T2,P1			;SETUP LOOP
WILDP1:	IOR	T1,.SMPPN-1(T2)		;SFD
	SKIPE	.SBPPN(T2)		;LAST SFD?
	AOJA	T2,WILDP1		;NO, TRY NEXT
>	;END IFN SFDS
	IFE	SFDS,<
	IOR	T1,.SMPPN(P1)		;UFD
>	;END IFE SFDS
	JUMPN	T1,CPOPJ1
	POPJ	P,
	PRGEND
	TITLE	FNDCH - FIND A FREE CH
;T1 RETURN CH
;SKIP IF WIN
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	FNDCH
	EXTERN	CPOPJ1
FNDCH:	MOVEI	T1,17			;COUNT CH'S
FNDCH1:	MOVE	T2,T1			;GET DEVICE TYPE
	DEVTYP	T2,
	 HALT
	JUMPE	T2,CPOPJ1		;0 MEANS NOT OPEN
	SOJGE	T1,FNDCH1		;ELSE TRY NEXT CH
	HALT
	PRGEND
	TITLE	IREN - RENAME INPUT
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	IREN
	EXTERN	CNVSPC,IINS,FIL,PRSLKP,ICLS,CPOPJ1
IREN:	PUSHJ	P,CNVSPC		;CONVERT TO TRAD FORMAT
	PUSHJ	P,IINS			;RENAME IT
	RENAME	FIL
	 JRST	PRSLKP
	PUSHJ	P,ICLS			;CLOSE CH
	JRST	CPOPJ1
	PRGEND
	TITLE	OREN - RENAME OUTPUT
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	OREN
	EXTERN	CNVSPC,OINS,FIL,PRSLKP,OCL,PUTBUF,CPOPJ1
OREN:	PUSHJ	P,PUTBUF		;OUTPUT LAST BUF
	 POPJ	P,
	PUSHJ	P,CNVSPC		;CONVERT TO TRAD FORMAT
	PUSHJ	P,OINS			;RENAME IT
	RENAME	FIL
	 JRST	PRSLKP
	PUSHJ	P,OCL			;CLOSE CH
	JRST	CPOPJ1
	PRGEND
	TITLE	LKP - LOOKUP A FILE
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	LKP
	EXTERN	SLKP,PRSLKP,CPOPJ1
LKP:	PUSHJ	P,SLKP			;DO THE LOOKUP
	 JRST	PRSLKP
	JRST	CPOPJ1
	PRGEND
	TITLE	SLKP - LOOKUP A FILE
	SEARCH	PRS,UUOSYM
	TWOSEG
	RELOC	400000
	ENTRY	SLKP
	EXTERN	OPN,ICLS,GETBLK
	EXTERN	ICH,RNGHDR,GETRNG,CNVSPC,IINS,FIL,CPOPJ1
SLKP:	PUSHJ	P,ICLS			;IN CASE ALREADY OPEN
	PUSHJ	P,CNVSPC		;CONVERT TO TRAD FORMAT
	MOVEI	T1,3			;GET A RING HDR
	PUSHJ	P,GETBLK
	 POPJ	P,
	MOVEM	T2,OPN+.OPBUF		;STORE ADR
	MOVE	T3,ICH
	HRRM	T2,RNGHDR(T3)
	PUSHJ	P,IINS			;OPEN DEV
	OPEN	OPN
	 JRST	SLKP0
	HRRZ	T2,OPN+.OPBUF		;GET BUF RING
	PUSHJ	P,GETRNG
	 POPJ	P,
	PUSHJ	P,IINS			;LOOKUP FILE
	LOOKUP	FIL
	 POPJ	P,
	JRST	CPOPJ1
SLKP0:	MOVEI	T1,ERNSD%		;OPEN FAILED
	HRRM	T1,FIL+1
	POPJ	P,
	PRGEND
	TITLE	NTR - ENTER A FILE
	SEARCH	PRS,UUOSYM
	TWOSEG
	RELOC	400000
	ENTRY	NTR
	EXTERN	OCH,RNGHDR,GETRNG,CNVSPC,OINS,FIL,PRSOPN,PRSLKP,CPOPJ1
	EXTERN	OPN,OCL,GETBLK
NTR:	PUSHJ	P,OCL			;IN CASE ALREADY OPEN
	PUSHJ	P,CNVSPC		;CONVERT TO TRAD FORMAT
	MOVEI	T1,3			;GET A RING HDR
	PUSHJ	P,GETBLK
	 POPJ	P,
	HRLZM	T2,OPN+.OPBUF		;STORE ADR
	MOVE	T3,OCH
	HRLM	T2,RNGHDR(T3)
	PUSHJ	P,OINS			;OPEN DEV
	OPEN	OPN
	 JRST	PRSOPN
	HLRZ	T2,OPN+.OPBUF		;GET BUF RING
	PUSHJ	P,GETRNG
	 POPJ	P,
	PUSHJ	P,OINS			;ENTER FILE
	ENTER	FIL
	 JRST	PRSLKP
	JRST	CPOPJ1
	PRGEND
	TITLE	PRSOPN
	SEARCH	PRS,UUOSYM
	TWOSEG
	RELOC	400000
	ENTRY	PRSOPN
	EXTERN	FIL,PRSLKP
PRSOPN:	MOVEI	T1,ERNSD%		;NO SUCH DEVICE
	HRRM	T1,FIL+1
	JRST	PRSLKP
	PRGEND
	TITLE	PRSLKP
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	PRSLKP
	EXTERN	OCTO,SPCO,FIL,VERBO
PRSLKP:	MOVEI	T1,ERRM
	PJRST	VERBO
	SPCO
	ERRM1
ERRM:	VB	ER.EAT,"?",PRSLKP,<LOOKUP ENTER error ^ for ^>
ERRM1:	HRRZ	T1,FIL+1
	PJRST	OCTO
	PRGEND
	TITLE	ICLS - CLOSE INPUT CH
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	ICLS
	EXTERN	IINS,ICH,RNGHDR,DELRNG
ICLS:	PUSHJ	P,IINS			;RELEASE IT
	RELEAS
	MOVE	T2,ICH			;GET ADR RING HDR
	HRRZ	T1,RNGHDR(T2)
	HLLZS	RNGHDR(T2)		;CLEAR SAME
	JRST	DELRNG			;RECLAIM CORE
	PRGEND
	TITLE	OCLS - CLOSE OUTPUT CH
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	OCLS
	EXTERN	PUTBUF,OCL,CPOPJ1
OCLS:	PUSHJ	P,PUTBUF		;OUTPUT LAST BUF
	 POPJ	P,
	PUSHJ	P,OCL
	JRST	CPOPJ1
	PRGEND
	TITLE	OCL
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	OCL
	EXTERN	RNGHDR,OINS,OCH,DELRNG
OCL:	PUSHJ	P,OINS			;RELEASE IT
	RELEAS
	MOVE	T2,OCH			;GET ADR RING HDR
	HLRZ	T1,RNGHDR(T2)
	HRRZS	RNGHDR(T2)		;CLEAR SAME
;FALL TO DELRNG
	PRGEND
	TITLE	DELRNG
;T1 PASSES ADR RING HDR
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	DELRNG
	EXTERN	CPOPJ,FREMEM
DELRNG:	JUMPE	T1,CPOPJ		;QUIT IF NO HDR
	MOVEI	T2,3			;LENGHT HDR
	HRRZ	T3,(T1)			;ADR 1ST BUF
RNGLOP:	SETZM	1(T1)			;FLAG THAT WE'VE BEEN HERE
	HRLZM	T2,(T1)			;STORE LENGHT
	HRRZ	T2,FREMEM		;DELETE BLK
	HRRM	T2,(T1)
	HRRM	T1,FREMEM
	MOVEI	T1,-1(T3)		;TOP OF BLK
	HLRZ	T2,1(T1)		;LENGHT
	ADDI	T2,2
	HRRZ	T3,1(T1)		;ADR NEXT BUF
	JUMPN	T3,RNGLOP		;LOOP UNLESS BEEN HERE BEFORE
	POPJ	P,
	PRGEND
	TITLE	PUR - PURGE CORE
;RECLAIMS CORE FROM A LINKAGE LIST
;T1 PASSES ADR OF ADR OF LIST
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	PUR
	EXTERN	CPOPJ,FREMEM
PUR:	HRRZ	T2,(T1)			;ADR NEXT BLK
	JUMPE	T2,CPOPJ		;QUIT IF NONE
	HRRZ	T3,(T2)			;UNLINK IT
	HRRM	T3,(T1)
	HRRZ	T3,FREMEM		;LINK TO FREE LIST
	HRRM	T3,(T2)
	HRRM	T2,FREMEM		;NEW 1ST FREE
	JRST	PUR			;TRY ANOTHER
	PRGEND
	TITLE	GETRNG - GET BUF RING
;T2 PASSES ADR RING HDR
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	GETRNG
	EXTERN	SAVE2,GETBLK,CPOPJ1,OPN
GETRNG:	PUSHJ	P,SAVE2			;SAVE P1-P2
	MOVE	P2,T2			;P2=ADR RING HDR
	MOVEI	T1,OPN			;GET DEVICE SIZE
	DEVSIZ	T1,
	 HALT
	HLRZ	P1,T1			;P1=# BUFS
	TLZ	T1,-1			;T1=SIZE BUF
RNGLOP:	PUSHJ	P,GETBLK		;GET A CORE BLK
	 POPJ	P,
	AOS	T3,T2			;USE ADR+1
	HRLI	T3,(1B0)		;SET USE BIT
	SKIPN	(P2)			;1ST BUF?
	MOVEM	T3,(P2)			;YES, STORE ADR IN HDR
	MOVE	T3,@(P2)		;GET LINK FROM 1ST BUF
	MOVEM	T3,(T2)			;MOVE TO NEW BUF
	HRLI	T2,-2(T1)		;BUILD LINK TO NEW BUF
	MOVEM	T2,@(P2)		;STORE IN 1ST BUF
	SOJG	P1,RNGLOP		;LOOP FOR EACH BUF
	JRST	CPOPJ1
	PRGEND
	TITLE	GETBLK - GET A CORE BLOCK
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	GETBLK
	EXTERN	.JBFF,.JBREL,PRSCOR,SAVE3,CPOPJ1,CPOPJ,FREMEM
;T1 PASSES SIZE OF BLK (PRESERVED)
;T2 RETURNS ADR OF BLK
GETBLK:	PUSHJ	P,TRYBLK		;ANY FREE BLOCKS?
	 JRST	GOT			;YES
	MOVE	T2,.JBFF		;NO, ENOUGH CORE TO MAKE 1?
	ADD	T2,T1
	CAMG	T2,.JBREL
	JRST	GETESY			;YES
	PUSHJ	P,GC			;NO, GARBAGE COLLECT
	PUSHJ	P,TRYBLK		;TRY AGAIN
	 JRST	GOT			;WIN
	MOVE	T2,.JBFF		;STILL LOSE, GET MORE CORE
	ADD	T2,T1
	MOVE	T3,T2
	CORE	T3,
	 JRST	PRSCOR
GETESY:	EXCH	T2,.JBFF		;T2=ADR OF BLK
GOT:	HRLZM	T1,(T2)			;BLK KNOWS ITS OWN SIZE
	JRST	CPOPJ1

;ROUTINE TO TRY TO FIND A FREE CORE BLK
;T1 PASSES SIZE OF BLK (PRESERVED)
;T2 RETURNS ADR OF BLK
;SKIP IF FAIL
TRYBLK:	PUSHJ	P,SAVE3			;SAVE P1-P3
	SETO	P1,			;FLAG NONE SO FAR
	MOVEI	P2,FREMEM		;POINT TO 0TH FREE BLK
TRYLOP:	MOVE	P3,P2			;ADVANCE TO NEXT BLK
	HRRZ	P2,(P3)
	JUMPE	P2,TRY1			;QUIT IF NO MORE BLKS
	HLRZ	T4,(P2)			;GET SIZE OF BLK
	CAML	T4,T1			;BIG ENOUGH?
	CAIL	T4,(P1)			;AND SMALLEST SO FAR?
	JRST	TRYLOP			;NO
	MOVE	P1,T4			;YES, REMEMBER WHERE IT IS
	MOVE	T3,P3
	CAME	P1,T1			;BEST PERFECT?
	JRST	TRYLOP			;NO, CHECK THE REST
TRY1:	JUMPL	P1,CPOPJ1		;QUIT IF NO WINNERS AT ALL
	HRRZ	T2,(T3)			;ADR OF BEST
	CAMG	P1,T1			;TOO BIG?
	JRST	TRYESY			;NO, JUST RIGHT
	MOVE	P2,T2			;COMPUTE ADR OF LEFTOVER
	ADD	P2,T1
	SUB	P1,T1			;COMPUTE SIZE OF LEFTOVER
	HRL	P1,(T2)			;SPLIT INTO TWO BLKS
	MOVSM	P1,(P2)
	HRL	P2,T1
	MOVEM	P2,(T2)
TRYESY:	HRRZ	T4,(T2)			;UNLINK THE BLK
	HRRM	T4,(T3)
	POPJ	P,

;GARBAGE COLLECT ROUTINE
;COMBINES CONSECUTIVE FRAGMENTS
;T1 IS PRESERVED
GC:	PUSHJ	P,SAVE3			;SAVE P1-P3
	MOVEI	P3,FREMEM		;POINT TO 0TH FREE BLK
GCLOP1:	HRRZ	P3,(P3)			;ADVANCE TO NEXT BLK
	JUMPE	P3,CPOPJ		;QUIT IF NO MORE BLKS
	HLRZ	T3,(P3)			;COMPUTE ADR JUST PAST END
GCAGN:	ADD	T3,P3
	MOVEI	P2,FREMEM		;SEARCH FOR A FREE BLK THERE
GCLOP2:	MOVE	P1,P2
	HRRZ	P2,(P1)
	JUMPE	P2,GCLOP1
	CAME	P2,T3
	JRST	GCLOP2
	HRRZ	T3,(P2)			;UNLINK IT
	HRRM	T3,(P1)
	HLRZ	T3,(P3)			;COMPUTE SIZE COMBINED BLK
	HLRZ	T2,(P2)
	ADD	T3,T2
	HRLM	T3,(P3)			;COMBINE THEM
	JRST	GCAGN
	PRGEND
	TITLE	PRSCOR
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	PRSCOR
PRSCOR:	ERR	0,"%",PRSCOR,<Not enough core>
	PRGEND
	TITLE	SPCO - OUTPUT FILE SPEC
;P1 PASSES ADR SPEC
	SEARCH	PRS,UUOSYM
	TWOSEG
	RELOC	400000
	ENTRY	SPCO
	EXTERN	SIXO,CO,CPOPJ1,FOO,SAVE1,SAVE2
SPCO:	MOVE	T2,.SBDEV(P1)		;DEVICE NAME
	SKIPE	T4,.SMDEV(P1)		;WILD DEVICE?
	JRST	SPCO5			;YES, NOT DSK
	CAMN	T2,[SIXBIT /DSK/]	;DEVICE DSK?
	JRST	SPCO1			;YES, DON'T SAY IT
SPCO5:	PUSHJ	P,WSIXO			;SAY DEVICE
	 POPJ	P,
	MOVEI	C,":"
	PUSHJ	P,CO
	 POPJ	P,
SPCO1:	HLRZ	T1,.SBEXT(P1)		;UFD?
	CAIE	T1,'UFD'
	JRST	NOTUFD			;NO
	MOVE	T1,.SBNAM(P1)		;YES, OUTPUT FILENAME AS PPN
	MOVE	T2,.SMNAM(P1)
	PUSHJ	P,WPPNO
	 POPJ	P,
	MOVEI	C,"]"			;RIGHT BRACKET
	PUSHJ	P,CO
	 POPJ	P,
	JRST	UFD
NOTUFD:	MOVE	T2,.SBNAM(P1)		;FILENAME
	MOVE	T4,.SMNAM(P1)
	PUSHJ	P,WSIXO
	 POPJ	P,
UFD:	MOVEI	C,"."			;DOT
	PUSHJ	P,CO
	 POPJ	P,
	HLLZ	T2,.SBEXT(P1)		;EXTENSION
	HRRZ	T4,.SMEXT(P1)
	CAIN	T4,-1
	SETO	T4,
	MOVSS	T4
	PUSHJ	P,WSIXO
	 POPJ	P,
	SKIPE	.SMDEV(P1)		;WILD DEVICE MEANS DISK
	JRST	SPCO2
	MOVE	T1,.SBDEV(P1)		;A DISK?
	DEVCHR	T1,
	TLNN	T1,(DV.DSK)
	JRST	CPOPJ1			;NO, ONLY DISKS HAVE PATHS
SPCO2:	SKIPN	.SBPPN(P1)		;PATH SPECIFIED?
	JRST	CPOPJ1			;NO
	SETOM	FOO			;GET DEFAULT PATH
	MOVE	T1,[XWD SFDS+4,FOO]
	PATH.	T1,
	 HALT
	IFE	SFDS,<
	SKIPE	.SMPPN(P1)		;ALWAYS PRINT WILDCARDS
	JRST	SPCO3
	MOVE	T1,FOO+.PTPPN		;MATCHES DEFAULT PATH?
	CAMN	T1,.SBPPN(P1)
	JRST	CPOPJ1			;YES, DON'T SAY IT
>
	IFN	SFDS,<
	MOVE	T1,P1			;POINTERS TO PATH
	MOVEI	T2,FOO+.PTPPN
SPCO4:	SKIPE	T3,.SBPPN(T1)		;GET WORD FROM PATH
	SKIPN	.SMPPN(T1)		;ALWAYS PRINT WILDCARDS
	CAME	T3,(T2)			;PRINT IF NOT DEFAULT
	JRST	SPCO3
	JUMPE	T3,CPOPJ1		;QUIT IF LAST SFD
	ADDI	T2,1			;LOOP UNTIL 0 SFD
	AOJA	T1,SPCO4
>
SPCO3:	MOVE	T1,.SBPPN(P1)		;OUTPUT PPN
	MOVE	T2,.SMPPN(P1)
	PUSHJ	P,WPPNO
	 POPJ	P,
	IFN	SFDS,<
	PUSHJ	P,SAVE1			;SAVE P1
SPCLOP:	SKIPN	.SBPPN+1(P1)		;ANOTHER SFD?
	JRST	SPCDON			;NO
	MOVEI	C,","			;YES, COMMA
	PUSHJ	P,CO
	 POPJ	P,
	MOVE	T2,.SBPPN+1(P1)		;SFD
	MOVE	T4,.SMPPN+1(P1)
	PUSHJ	P,WSIXO
	 POPJ	P,
	AOJA	P1,SPCLOP		;LOOP UNTIL 0 SFD
>	;END IFN FTSFDS
SPCDON:	MOVEI	C,"]"			;END PATH
	JRST	CO

;ROUTINE TO OUTPUT A PPN WITH WILDCARDS
;T1 PASSES PPN
;T2 PASSES MASK
WPPNO:	PUSHJ	P,SAVE2			;SAVE P1-P2
	MOVE	P1,T1			;SAVE PPN
	MOVE	P2,T2			;SAVE MASK
	MOVEI	C,"["			;LEFT BRACKET
	PUSHJ	P,CO
	 POPJ	P,
	HLRZ	T1,P1			;PROJECT
	HLRZ	T3,P2			;PROJECT MASK
	PUSHJ	P,WOCTO			;OUTPUT IT
	 POPJ	P,
	MOVEI	C,","			;COMMA
	PUSHJ	P,CO
	 POPJ	P,
	HRRZ	T1,P1			;PROGRAMMER
	HRRZ	T3,P2			;PROGRAMMER MASK
;FALL TO WOCTO

;ROUTINE TO OUTPUT OCTAL NUMBER WITH WILDCARDS
;T1 PASSES NUMBER
;T3 PASSES MASK
WOCTO:	SETZB	T2,T4
WOCTO1:	LSHC	T1,-3			;GET LOW ORDER NIBBLE
	LSH	T2,-3			;CONVERT TO SIXBIT
	TLO	T2,'0  '
	LSHC	T3,-3			;GET LOW ORDER NIBBLE OF MASK
	ASH	T4,-3			;REPLICATE HIGH BIT
	JUMPN	T1,WOCTO1		;LOOP UNTIL WORD GONE
	JUMPN	T3,WOCTO1		;AND MASK GONE
;FALL TO WSIXO

;ROUTINE TO OUTPUT SIXBIT NAME WITH WILDCARDS
;T2 PASSES NAME
;T4 PASSES MASK
WSIXO:	ANDCM	T2,T4			;REMOVE WILD FIELDS
	MOVE	T1,[SIXBIT /??????/]	;EXTRACT WILD FIELDS
	AND	T1,T4
	ADD	T1,T2			;COMBINE THEM
	CAMN	T1,[SIXBIT /??????/]	;STAR?
	HRLZI	T1,'*  '		;YES, SAY SO
	JRST	SIXO			;OUTPUT IT
	PRGEND
	TITLE	PROMPT - PROMPT USER
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	PROMPT
	EXTERN	ICH,CI,SWTCH,EATCR,BP,CPOPJ1,CRLF
PROMPT:	SKPINC				;STOP CTRL-O
	 JFCL
	SETOM	ICH			;ISELECT TTY
	OUTSTR	CRLF
LOOP:	OUTCHR	["*"]			;PROMPT HIM
	PUSHJ	P,CI			;INPUT 1ST CHAR
	 POPJ	P,
	PUSHJ	P,SWTCH			;PARSE SWITCHES
	 POPJ	P,
	PUSHJ	P,EATCR			;EAT <CR>
	 POPJ	P,
	PUSHJ	P,BP			;BREAK CHAR?
	 JRST	CPOPJ1			;NO
	CAIN	C,"Z"-100		;YES, CONTROL Z?
	EXIT	1,			;YES
	JRST	LOOP
	PRGEND
	TITLE	PRMPT - PROMPT USER
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	PRMPT
	EXTERN	ICH,CI,EATCR,BP,CPOPJ1,CRLF
PRMPT:	SKPINC				;STOP CTRL-O
	 JFCL
	SETOM	ICH			;ISELECT TTY
	OUTSTR	CRLF
LOOP:	OUTCHR	["*"]			;PROMPT HIM
	PUSHJ	P,CI			;INPUT 1ST CHAR
	 POPJ	P,
	PUSHJ	P,EATCR			;EAT <CR>
	 POPJ	P,
	PUSHJ	P,BP			;BREAK CHAR?
	 JRST	CPOPJ1			;NO
	CAIN	C,"Z"-100		;YES, CONTROL Z?
	EXIT	1,			;YES
	JRST	LOOP
	PRGEND
	TITLE	CRLFO - OUTPUT CARRIAGE RETURN LINE FEED
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	CRLFO
	EXTERN	STRO,CRLF
CRLFO:	MOVEI	T1,CRLF
;FALL TO STRO
	PRGEND
	TITLE	STRO - OUTPUT AN ASCIZ STRING
;T1 PASSES ADR OF STRING
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	STRO
	EXTERN	BPO
STRO:	HRLI	T1,(POINT 7,0)		;MAKE INTO BP
;FALL TO BPO
	PRGEND
	TITLE	BPO - OUTPUT AN ASCIZ STRING
;T1 PASSES BP TO STRING
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	BPO
	EXTERN	CPOPJ1,CO,SAVE1
BPO:	PUSHJ	P,SAVE1			;SAVE P1
	MOVE	P1,T1			;COPY ARG
PTBPLP:	ILDB	C,P1			;GET A CHAR
	JUMPE	C,CPOPJ1		;QUIT ON 0
	PUSHJ	P,CO			;OUTPUT IT
	 POPJ	P,
	JRST	PTBPLP
	PRGEND
	TITLE	DECO - OUTPUT A DECIMAL NUMBER
;T1 PASSES THE NUMBER
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	DECO
	EXTERN	NUMO
DECO:	MOVEI	T3,^D10			;RADIX 10
	JRST	NUMO
	PRGEND
	TITLE	OCTO - OUTPUT AN OCTAL NUMBER
;T1 PASSES THE NUMBER
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	OCTO
	EXTERN	NUMO
OCTO:	MOVEI	T3,10			;RADIX 8
	JRST	NUMO
	PRGEND
	TITLE	NUMO - OUTPUT A NUMBER
;T1 PASSES THE NUMBER
;T3 PASSES THE RADIX
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	NUMO
	EXTERN	CO
NUMO:	IDIV	T1,T3			;DIVIDE BY RADIX
	HRLM	T2,(P)			;STORE REMAINDER
	JUMPE	T1,NUMO1		;LOOP UNTIL NONE LEFT
	PUSHJ	P,NUMO
	 POPJ	P,
NUMO1:	HLRZ	C,(P)			;RECALL REMAINDER LIFO
	ADDI	C,"0"			;CONVERT TO ASCII DIGIT
	JRST	CO			;OUTPUT IT
	PRGEND
	TITLE	SIXO - OUTPUT SIXBIT WORD
;T1 PASSES THE WORD
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	SIXO
	EXTERN	CO,CPOPJ1,SAVE2
SIXO:	PUSHJ	P,SAVE2			;SAVE P1-P2
	MOVE	P2,T1			;COPY ARG
SIXOLP:	JUMPE	P2,CPOPJ1		;QUIT IF NONE LEFT
	LSHC	P1,6			;EXTRACT HIGH CHAR
	ANDI	P1,77
	MOVEI	C,40(P1)		;CONVERT TO ASCII
	PUSHJ	P,CO			;OUTPUT IT
	 POPJ	P,
	JRST	SIXOLP			;LOOP UNTIL NONE LEFT
	PRGEND
	TITLE	CO - OUTPUT CHAR
;C PASSES THE CHAR
;OCH SELECTS WHERE OUTPUT GOES:
;TTY OCH=-1
;CORE OCH=POINT X,Y,Z
;DISK OCH=XWD 0,CHANNEL
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	CO
	EXTERN	OCH,PUTC,CPOPJ1,PUTC1
CO:	MOVE	T1,OCH			;GET OUTPUT CH
	TLNN	T1,-1			;FILE?
	JRST	PUTC1			;YES
	TLNE	T1,40			;NO, BP?
	JRST	CO0			;NO, MUST BE TTY
	IDPB	C,OCH			;YES
	JRST	CPOPJ1
CO0:	OUTCHR	C			;TTY
	JRST	CPOPJ1
	PRGEND
	TITLE	PUTC - OUTPUT A CHAR
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	PUTC
	INTERN	PUTC1
	EXTERN	OCH,RNGHDR,PUTBUF,CPOPJ1
PUTC2:	PUSHJ	P,PUTBUF		;OUTPUT THE BUF
	 POPJ	P,
PUTC:	MOVE	T1,OCH			;GET OUTPUT CH
PUTC1:	HLRZ	T1,RNGHDR(T1)		;GET ADR RING HDR
	SOSGE	2(T1)			;MORE ROOM IN BUF?
	JRST	PUTC2			;NO, OUTPUT THE BUF
	IDPB	C,1(T1)			;YES, PUT CHAR IN
	JRST	CPOPJ1
	PRGEND
	TITLE	PUTBUF - OUTPUT A BUFFER
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	PUTBUF
	EXTERN	OINS,CPOPJ1,PRSOUT
PUTBUF:	PUSHJ	P,OINS
	OUT
	JRST	CPOPJ1
	JRST	PRSOUT
	PRGEND
	TITLE	PRSOUT
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	PRSOUT
	EXTERN	OCH,SIXO,SAVE1,VERBO,OCTO,OINS
PRSOUT:	PUSHJ	P,SAVE1
	PUSHJ	P,OINS
	GETSTS	P1
	HRL	P1,OCH
	MOVEI	T1,ERRM
	PJRST	VERBO
ERRM2:	HRRZ	T1,P1
	PJRST	OCTO
	ERRM1
	ERRM2
ERRM:	VB	ER.EAT,"?",PRSOUT,<Output error ^ for ^>
ERRM1:	HLRZ	T1,P1
	DEVNAM	T1,
	 HALT
	PJRST	SIXO
	PRGEND
	TITLE	WLDMAT - MATCH WLD SPC'S
;P1 PASSES ADR LOOKUP SPC (OUTPUT FROM WILD)
;P2 PASSES ADR WILD SPC
;P3 PASSES ADR TO RETURN NEW SPC
;WLDMAT TAKES SPECIFICS FROM P1 ADDS THEM TO P2 AND PUTS
;RESULTS IN P3
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	WLDMAT
WLDMAT:	HRLZ	T1,P2			;COPY SWITCHES
	HRR	T1,P3
	HLRZ	T2,(P2)
	ADD	T2,P3
	BLT	T1,-1(T2)
	MOVE	T1,.SBDEV(P2)		;DEVICE
	ANDCM	T1,.SMDEV(P2)
	MOVE	T2,.SBDEV(P1)
	AND	T2,.SMDEV(P2)
	ADD	T1,T2
	MOVEM	T1,.SBDEV(P3)
	SETZM	.SMDEV(P3)
	MOVE	T1,.SBNAM(P2)		;FILENAME
	ANDCM	T1,.SMNAM(P2)
	MOVE	T2,.SBNAM(P1)
	AND	T2,.SMNAM(P2)
	ADD	T1,T2
	MOVEM	T1,.SBNAM(P3)
	SETZM	.SMNAM(P3)
	HLRZ	T1,.SBEXT(P2)		;EXTENSION
	HRRZ	T2,.SMEXT(P2)
	ANDCM	T1,T2
	HLRZ	T3,.SBEXT(P1)
	AND	T3,T2
	ADD	T1,T3
	HRLZM	T1,.SBEXT(P3)
	IFN	SFDS,<
	EXTERN	SAVE3
	PUSHJ	P,SAVE3			;SAVE P1-P3
>	;END IFN SFDS
WLDMT0:	MOVE	T1,.SBPPN(P2)		;DIRECTORY
	ANDCM	T1,.SMPPN(P2)
	MOVE	T2,.SBPPN(P1)
	AND	T2,.SMPPN(P2)
	ADD	T1,T2
	MOVEM	T1,.SBPPN(P3)
	SETZM	.SMPPN(P3)
	IFN	SFDS,<
	ADDI	P2,1			;LOOP FOR EACH DIR
	ADDI	P3,1
	SKIPE	.SBPPN+1(P1)
	AOJA	P1,WLDMT0
>	;END IFN SFDS
	POPJ	P,
	PRGEND
	TITLE	CNVSPC - CONVERT SPC BLK TO TRADITIONAL BLKS
;P1 PASSES ADR SPC BLK
	SEARCH	PRS,UUOSYM
	TWOSEG
	RELOC	400000
	ENTRY	CNVSPC
	EXTERN	FIL,OPN
CNVSPC:	MOVE	T4,.SBDEV(P1)		;DEVICE
	MOVEM	T4,OPN+.OPDEV
	MOVE	T4,.SBMOD(P1)		;MODE
	MOVEM	T4,OPN+.OPMOD
	LDB	T4,[POINT 4,T4,35]	;GET I/O MODE
	CAIE	T4,.IOASC		;SOME FLAVOR OF ASCII MODE
	CAIN	T4,.IOASL		;...
	SKIPA	T4,[UU.LBF]		;YES, GET LARGE BUFFERS BIT
	SETZ	T4,			;NO, GET A ZERO
	IORM	T4,OPN+.OPMOD		;INCLUDE IN MODE WORD
	MOVE	T4,.SBNAM(P1)		;FILENAME
	MOVEM	T4,FIL
	HLLZ	T4,.SBEXT(P1)		;EXTENSION
	MOVEM	T4,FIL+1
	SETZM	FIL+2
	IFE	SFDS,<
	MOVE	T4,.SBPPN(P1)		;PPN
	MOVEM	T4,FIL+3
>	;END IFE SFDS
	IFN	SFDS,<
	EXTERN	PTH
	HRLZI	T1,.SBPPN(P1)		;COPY PATH
	HRRI	T1,PTH+.PTPPN
	BLT	T1,PTH+.PTPPN+SFDS+1
	SKIPE	T3,.SBPPN(P1)		;POINT TO PATH
	MOVEI	T3,PTH
	MOVEM	T3,FIL+3
>	;END IFN SFDS
	POPJ	P,
	PRGEND
	TITLE	SPCI - INPUT A FILE SPEC
;P1 PASSES ADR OF FILE SPEC
;SKIP IF SUCCESSFUL
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	SPCI
	EXTERN	WSIXI,EATS,CI,CPOPJ1,PRSPTH,MYPATH,SAVE2
SPCI:	PUSHJ	P,WSIXI			;DEVICE OR FILE NAME?
	 POPJ	P,
	PUSHJ	P,EATS			;WHICH?
	 POPJ	P,
	CAIE	C,":"
	JRST	SPCI2			;FILENAME
	JUMPE	T1,SPCI5		;0 MEANS USE DEFAULT
	MOVEM	T1,.SBDEV(P1)		;DEVICE, SAVE IT
	MOVEM	T2,.SMDEV(P1)
SPCI5:	PUSHJ	P,CI			;EAT THE COLON
	 POPJ	P,
	PUSHJ	P,WSIXI			;INPUT THE FILENAME
	 POPJ	P,
SPCI2:	JUMPE	T1,SPCI6		;0 MEANS USE DEFAULT
	MOVEM	T1,.SBNAM(P1)		;SAVE FILENAME
	MOVEM	T2,.SMNAM(P1)
SPCI6:	PUSHJ	P,EATS			;EXTENSION?
	 POPJ	P,
	CAIE	C,"."
	JRST	SPCI3			;NO
	PUSHJ	P,CI			;YES, EAT THE DOT
	 POPJ	P,
	PUSHJ	P,WSIXI			;INPUT THE EXTENSION
	 POPJ	P,
	HLR	T1,T2			;APPEND MASK
	MOVEM	T1,.SBEXT(P1)		;NO, SAVE IT
	PUSHJ	P,EATS			;PATH SPECIFIED?
	 POPJ	P,
SPCI3:	CAIE	C,"["
	JRST	CPOPJ1			;NO
	PUSHJ	P,CI			;YES, EAT THE BRACKET
	 POPJ	P,
	PUSHJ	P,MYPATH		;GET DEFAULT PATH
	PUSHJ	P,WOCTI			;INPUT THE PROJECT NUMBER
	 POPJ	P,
	CAIN	C,"-"			;DEFAULT PATH INDICATOR?
	JRST	[PUSHJ	P,CI		;GET A CHARACTER
		  POPJ	P,
		 JRST	SPCI10]		;HANDLE [-]
	JUMPE	T1,SPCI7		;0 MEANS USE DEFAULT
	HRLM	T1,.SBPPN(P1)		;SAVE IT
	HRLM	T2,.SMPPN(P1)
SPCI7:	PUSHJ	P,EATS			;EAT A COMMA
	 POPJ	P,
	CAIE	C,","
	 JRST	PRSPTH
	PUSHJ	P,CI
	 POPJ	P,
	PUSHJ	P,WOCTI			;INPUT THE PROGRAMER NUMBER
	 POPJ	P,
	JUMPE	T1,SPCI8		;0 MEANS USE DEFAULT
	HRRM	T1,.SBPPN(P1)		;SAVE IT
	HRRM	T2,.SMPPN(P1)
SPCI8:
	IFN	SFDS,<
	EXTERN	SAVE1
	PUSHJ	P,SAVE1			;SAVE P1
	HRLI	P1,-SFDS		;COUNT SFDS
SPCLOP:	PUSHJ	P,EATS			;ANOTHER SFD?
	 POPJ	P,
	CAIE	C,","
	JRST	SPCI4			;NO
	PUSHJ	P,CI			;YES, EAT THE COMMA
	 POPJ	P,
	PUSHJ	P,WSIXI			;INPUT THE SFD NAME
	 POPJ	P,
	JUMPE	T1,SPCI9		;0 MEANS USE DEFAULT
	MOVEM	T1,.SBPPN+1(P1)		;SAVE IT
	MOVEM	T2,.SMPPN+1(P1)
SPCI9:	AOBJN	P1,SPCLOP		;LOOK FOR ANOTHER
	JRST	PRSPTH
SPCI4:	SETZM	.SBPPN+1(P1)		;TERMINATE PATH
>	;END IFN SFDS
SPCI10:	PUSHJ	P,EATS			;EAT A BRACKET
	 POPJ	P,
	CAIN	C,"]"
	JRST	CI
	JRST	CPOPJ1
;INPUT A PROJECT OR PROGRAMMER, WITH WILDCARDS
;T1 RETURNS THE NUMBER
;T2 RETURNS A WILDCARD MASK
WOCTI:	PUSHJ	P,SAVE2			;SAVE P1-P2
	SETZB	P1,P2			;DEFAULT TO ZERO
	PUSHJ	P,EATS			;EAT SPACES
	 POPJ	P,
	CAIE	C,"*"			;THE UNIVERSE?
	JRST	WOCTI3			;NO
	PUSHJ	P,CI			;YES, EAT IT
	 POPJ	P,
	SETOB	T1,T2			;RETURN THE WORLD
	JRST	CPOPJ1
WOCTI3:	CAIL	C,"0"			;VALID DIGIT OR WILDCARD?
	CAILE	C,"7"
	CAIN	C,"?"
	JRST	WOCTI1			;YES
WOCTI2:	MOVE	T1,P1			;NO, RETURN RESULTS
	MOVE	T2,P2
	JRST	CPOPJ1
WOCTI1:	LSH	P1,3			;YES, APPEND TO NUMBER
	LSH	P2,3
	TRZE	C,10
	ADDI	P2,7
	ADDI	P1,-"0"(C)
	PUSHJ	P,CI			;INPUT NEXT CHAR
	 POPJ	P,
	JRST	WOCTI3			;TEST IF VALID
	PRGEND
	TITLE	MYPATH - GET MY DEFAULT PATH
	SEARCH	PRS,UUOSYM
	TWOSEG
	RELOC	400000
	ENTRY	MYPATH
	EXTERN	FOO
MYPATH:	SETOM	FOO			;GET DEFAULT PATH
	MOVE	T1,[XWD SFDS+4,FOO]
	PATH.	T1,
	 HALT
	IFE	SFDS,<
	MOVE	T1,FOO+.PTPPN		;COPY IT TO SPC
	MOVEM	T1,.SBPPN(P1)
>	;END IFE SFDS
	SETZM	.SMPPN(P1)		;CLEAR WILDCARDS
	IFN	SFDS,<
	HRRZI	T1,.SBPPN(P1)		;COPY IT TO SPC
	HRLI	T1,FOO+.PTPPN
	BLT	T1,.SBPPN+SFDS+1(P1)
	HRLZI	T1,.SMPPN(P1)
	HRRI	T1,.SMPPN+1(P1)
	BLT	T1,.SMPPN+SFDS(P1)
>	;END IFN SFDS
	POPJ	P,
	PRGEND
	TITLE	PRSPTH
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	PRSPTH
PRSPTH:	ERR	ER.EAT,"?",PRSPTH,<Illegal format for path>
	PRGEND
	TITLE	DECI - INPUT A DECIMAL NUMBER
;T1 RETURNS THE NUMBER
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	DECI
	EXTERN	NUMI
DECI:	MOVEI	T3,^D10			;RADIX 10
	JRST	NUMI
	PRGEND
	TITLE	OCTI - INPUT AN OCTAL NUMBER
;T1 RETURNS THE NUMBER
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	OCTI
	EXTERN	NUMI
OCTI:	MOVEI	T3,10			;RADIX 8
	JRST	NUMI
	PRGEND
	TITLE	NUMI - INPUT A NUMBER
;T3 PASSES THE RADIX
;T1 RETURNS THE NUMBER
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	NUMI
	EXTERN	SAVE2,CI,CPOPJ1,EATS
NUMI:	PUSHJ	P,SAVE2			;SAVE P1-P2
	SETZ	P1,			;DEFAULT TO ZERO
	MOVE	P2,T3			;COPY RADIX
	PUSHJ	P,EATS			;EAT SPACES
	 POPJ	P,
NUMILP:	CAIL	C,"0"			;LEGAL DIGIT?
	CAILE	C,"0"-1(P2)
	JRST	NUMI1			;NO
	IMUL	P1,P2			;YES, APPEND TO NUMBER
	ADDI	P1,-"0"(C)
	PUSHJ	P,CI			;INPUT NEXT CHAR
	 POPJ	P,
	JRST	NUMILP
NUMI1:	MOVE	T1,P1			;NO, RETURN NUMBER
	JRST	CPOPJ1
	PRGEND
	TITLE	SIXI - INPUT A SIXBIT WORD
;T1 RETURNS THE WORD
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	SIXI
	EXTERN	EATS,CI,CPOPJ1,SAVE2
SIXI:	PUSHJ	P,SAVE2			;SAVE P1-P2
	MOVEI	P2,6*6			;BIT COUNT
	PUSHJ	P,EATS			;EAT SPACES
	 POPJ	P,
SIXLOP:	SUBI	C,40			;CONVERT LOWER CASE TO UPPER
	CAIL	C,"A"			;UPPER CASE?
	CAILE	C,"Z"
	ADDI	C,40			;NO, OOPS CONVERT BACK
	CAIL	C,"0"			;VALID SIXBIT CHAR?
	CAILE	C,"9"
	CAIL	C,"A"
	CAILE	C,"Z"
	JRST	SIXGOT			;NO
	JUMPE	P2,SIXNX		;ONLY 1ST 6 CHARS SIGNIFICANT
	LSH	P1,6			;APPEND CHAR TO NAME
	ADDI	P1,-40(C)
	SUBI	P2,6			;COUNT IT
SIXNX:	PUSHJ	P,CI			;INPUT NEXT CHAR
	 POPJ	P,
	JRST	SIXLOP			;TEST IF VALID
SIXGOT:	LSH	P1,(P2)			;NO, LEFT JUSTIFY RESULTS
	MOVE	T1,P1
	JRST	CPOPJ1
	PRGEND
	TITLE	WSIXI - INPUT A WILD SIXBIT WORD
;T1 RETURNS THE WORD
;T2 RETURNS A WILDCARD MASK
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	WSIXI
	EXTERN	EATS,CI,CPOPJ1,SAVE4
WSIXI:	PUSHJ	P,SAVE4			;SAVE P1-P4
	SETZB	P2,P3			;INITIAL MASK
	MOVEI	P4,6*6			;BIT COUNT
	PUSHJ	P,EATS			;EAT SPACES
	 POPJ	P,
WSIXI3:	SUBI	C,40			;CONVERT LOWER CASE TO UPPER
	CAIL	C,"A"			;UPPER CASE?
	CAILE	C,"Z"
	ADDI	C,40			;NO, OOPS CONVERT BACK
	CAIE	C,"*"			;VALID SIXBIT CHAR?
	CAIL	C,"0"
	CAILE	C,"9"
	CAIL	C,"A"
	CAILE	C,"Z"
	CAIN	C,"?"
	JRST	WSIXI1			;YES
WSIXI4:	LSH	P1,(P4)			;NO, LEFT JUSTIFY RESULTS
	LSHC	P2,(P4)
	MOVE	T1,P1
	MOVE	T2,P2
	JRST	CPOPJ1
WSIXI1:	JUMPE	P4,WSIXI2		;ONLY 1ST 6 CHARS SIGNIFICANT
	LSH	P1,6			;APPEND CHAR TO NAME
	ADDI	P1,-40(C)
	CAIN	C,"?"
	TLO	P3,770000
	CAIN	C,"*"
	SETO	P3,
	LSHC	P2,6
	SUBI	P4,6			;COUNT IT
WSIXI2:	PUSHJ	P,CI			;INPUT NEXT CHAR
	 POPJ	P,
	JUMPL	P3,WSIXI4		;QUIT IF "*"
	JRST	WSIXI3			;ELSE LOOP
	PRGEND
	TITLE	EATCR - EAT <CR>
;EATS LEADING SPACES AND TABS 1ST
;SKIP IF OK
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	EATCR
	EXTERN	EATS,CI,CPOPJ1
EATCR:	PUSHJ	P,EATS			;EAT SPACES
	 POPJ	P,
	CAIE	C,15			;EAT CR
	JRST	CPOPJ1
	JRST	CI
	PRGEND
	TITLE	BP - TEST FOR BREAK CHAR
;SKIP IF YES
;ABE'S METHOD
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	BP
BP:	MOVEI	T1,1			;BREAK CHAR?
	LSH	T1,(C)
	TDNE	T1,[1400016000]
	AOS	(P)			;YES, SKIP
	POPJ	P,			;NO
	PRGEND
	TITLE	COLON - EAT COLON
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	COLON
	EXTERN	EATS,CI,PRSSYN
COLON:	PUSHJ	P,EATS			;EAT SPACES
	 POPJ	P,
	CAIE	C,":"			;COLON?
	JRST	PRSSYN
	JRST	CI			;YES, EAT IT
	PRGEND
	TITLE	EATS - EAT SPACES AND TABS
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	EATS
	EXTERN	CI,CPOPJ1
EATS1:	PUSHJ	P,CI			;INPUT NEXT CHAR
	 POPJ	P,
EATS:	CAIE	C," "			;SPACE OR TAB?
	CAIN	C,11
	JRST	EATS1			;YES, EAT IT
	JRST	CPOPJ1			;NO
	PRGEND
	TITLE	PRSSYN
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	PRSSYN
PRSSYN:	ERR	ER.EAT,"?",PRSSYN,<Syntax error>
	PRGEND
	TITLE	CI - INPUT A CHAR
;C RETURNS THE CHAR
;ICH SELECTS WHERE INPUT FROM:
;TTY ICH=-1
;CORE ICH=POINT X,Y,Z
;DISK ICH=XWD 0,CHANNEL
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	CI
	EXTERN	ICH,LSNI,CPOPJ1
CI:	MOVE	C,ICH			;GET INPUT CH
	TLNN	C,-1			;FILE?
	JRST	LSNI			;YES
	TLNE	C,40			;NO, CORE?
	JRST	CI1			;NO, MUST BE TTY
	ILDB	C,ICH			;YES
	JRST	CPOPJ1
CI1:	INCHWL	C			;TTY
	JRST	CPOPJ1
	PRGEND
	TITLE	LSNI - INPUT A CHAR
;IGNORES LINE SEQUENCE NUMBERS
;SKIP IF OK
;ELSE NOSKIP
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	LSNI
	EXTERN	ICH,RNGHDR,GETC,CPOPJ1,SAVE2
LSNI:	PUSHJ	P,SAVE2			;SAVE P1-P2
	MOVE	P1,ICH			;GET INPUT CH
	HRRZ	P1,RNGHDR(P1)		;GET ADR RING HDR
	MOVEI	P2,1			;COUNT CHARS
LSNLOP:	PUSHJ	P,GETC			;GET A CHAR
	 POPJ	P,
	JUMPE	C,LSNLOP		;EAT NULLS
	MOVE	T1,@1(P1)		;GET LSN BIT
	CAIE	P2,1			;ALREADY SEEN IT?
	SETZ	T1,			;YES, DON'T LOOK AT IT AGAIN
	TRNE	T1,1			;LSN?
	MOVEI	P2,7			;YES, EAT 7 CHARS
	SOJG	P2,LSNLOP		;LOOP FOR EACH CHAR
	JRST	CPOPJ1
	PRGEND
	TITLE	GETC - INPUT A CHAR
;SKIP IF OK
;ELSE NOSKIP
;NOSKIP WITH C=ERROR BITS
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	GETC
	EXTERN	ICH,RNGHDR,CPOPJ1,IINS,PRSIN
GETC:	MOVE	C,ICH			;GET INPUT CH
	HRRZ	C,RNGHDR(C)		;GET ADR RING HDR
	SOSGE	2(C)			;MORE CHARS IN BUF?
	JRST	GETC9
	ILDB	C,1(C)			;YES, GET ONE
	JRST	CPOPJ1
GETC9:	PUSHJ	P,IINS			;NO, INPUT A BUF
	IN
	 JRST	GETC			;TRY AGAIN
	JRST	PRSIN			;NO, REAL ERROR
	PRGEND
	TITLE	PRSIN
	SEARCH	PRS,UUOSYM
	TWOSEG
	RELOC	400000
	ENTRY	PRSIN
	EXTERN	ICH,SIXO,IINS,VERBO,SAVE1,OCTO
PRSIN:	PUSHJ	P,SAVE1			;SAVE P1
	PUSHJ	P,IINS			;GET ERROR BITS
	GETSTS	P1
	TRNN	P1,IO.ERR		;FAILED BECAUSE EOF?
	JRST	PRSIN2			;YES
	MOVEI	T1,ERRM
	PUSHJ	P,VERBO
PRSIN2:	MOVE	C,P1			;RESTORE ERROR BITS
	POPJ	P,
ERRM1:	MOVE	T1,ICH			;TYPE DEVICE NAME
	DEVNAM	T1,
	 HALT
	PJRST	SIXO
ERRM2:	MOVE	T1,P1			;TYPE THE STATUS
	PJRST	OCTO
	ERRM1
	ERRM2
ERRM:	VB	ER.EAT,"?",PRSIN,<Input error ^ for ^>
	PRGEND
	TITLE	OINS - XCT AN OUTPUT INSTRUCTION
;CALL:
;	PUSHJ	P,OINS
;	FOO	0,@FOO(FOO)
;NOSKIP
;SKIP
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	OINS
	EXTERN	OCH,IINS
OINS:	SKIPA	T1,OCH			;GET THE CH
;FALL TO IINS
	PRGEND
	TITLE	IINS - XCT AN INPUT INSTRUCTION
;CALL:
;	PUSHJ	P,IINS
;	FOO	0,@FOO(FOO)
;NOSKIP
;SKIP
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	IINS
	EXTERN	ICH,CPOPJ1
IINS:	MOVE	T1,ICH			;BUILD THE INS
	LSH	T1,^D23
	ADD	T1,@(P)
	AOS	(P)
	XCT	T1			;DO IT
	POPJ	P,
	JRST	CPOPJ1
	PRGEND
	TITLE	FNDNAM - FIND ABBREVIATED NAME IN TABLE
;T1 PASSES ABBR
;T2 PASSES AOBJN POINTER TO TABLE OF NAMES
;NO SKIP IF UNSUCCESSFUL
;SKIP RETURN:
;T2=INDEX INTO TABLE
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	FNDNAM
	EXTERN	CPOPJ1,SAVE3,PRSUKN
FNDNAM:	PUSHJ	P,SAVE3			;SAVE P1-P3
	SETO	P1,			;MATCH MASK
	TDZA	T3,T3			;WIN FLAG
FNDNM2:	LSH	P1,-6			;BUILD UP THE MASK
	TDNE	T1,P1
	JRST	FNDNM2
	MOVE	P2,T2			;SAVE INITIAL POINTER
FNDLP:	MOVE	P3,(T2)			;GET TABLE ENTRY
	XOR	P3,T1			;COMPARE
	JUMPE	P3,FNDWON		;EXACT MATCH WINS
	ANDCM	P3,P1			;CLOSE ENOUGH?
	JUMPN	P3,FNDNM1
	JUMPN	T3,PRSUKN		;YES, 2ND WIN AMBIGUOUS
	MOVE	T3,T2			;SAVE ADR OF WIN
FNDNM1:	AOBJN	T2,FNDLP		;LOOP THROUGH TABLE
	SKIPN	T2,T3			;RECALL WIN
	JRST	PRSUKN
FNDWON:	SUB	T2,P2			;COMPUTE INDEX
	TLZ	T2,-1
	JRST	CPOPJ1
	PRGEND
	TITLE	PRSUKN
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	PRSUKN
	EXTERN	SIXO,SAVE1,VERBO
PRSUKN:	PUSHJ	P,SAVE1
	MOVE	P1,T1
	MOVEI	T1,ERRM
	PJRST	VERBO
	ERRM1
ERRM:	VB	ER.EAT,"?",PRSUKN,<Unknown or ambiguous abbreviation ^>
ERRM1:	MOVE	T1,P1
	PJRST	SIXO
	PRGEND
	TITLE	CRLF
	TWOSEG
	RELOC	400000
	ENTRY	CRLF
CRLF:	BYTE	(7)15,12
	PRGEND
	TITLE	OPN
	TWOSEG
	RELOC	0
	ENTRY	OPN
OPN:	BLOCK	3			;ARGS FOR OPEN UUO
	PRGEND
	TITLE	ICH - INPUT CH
	TWOSEG
	RELOC	0
	ENTRY	ICH
ICH:	BLOCK	1			;INPUT CH
	PRGEND
	TITLE	OCH - OUTPUT CH
	TWOSEG
	RELOC	0
	ENTRY	OCH
OCH:	BLOCK	1			;OUTPUT CH
	PRGEND
	TITLE	FREMEM
	TWOSEG
	RELOC	0
	ENTRY	FREMEM
FREMEM:	BLOCK	1			;ADR FREE CHAIN
	PRGEND
	TITLE	RNGHDR - TABLE OF POINTERS TO RING HDRS
;INDEX BY CH
;LH=ADR OUTPUT RING HDR
;RH=ADR INPUT RING HDR
	TWOSEG
	RELOC	0
	ENTRY	RNGHDR
RNGHDR:	BLOCK	20
	PRGEND
	TITLE	FOO - SCR SPACE
	SEARCH	PRS
	TWOSEG
	RELOC	0
	ENTRY	FOO
FOO:	BLOCK	FOOSIZ
	PRGEND
	TITLE	FIL
	TWOSEG
	RELOC	0
	ENTRY	FIL
FIL:	BLOCK	4			;ARGS FOR LOOKUP/ENTER UUO
	PRGEND
	TITLE	PTH
	SEARCH	PRS
	TWOSEG
	RELOC	0
	ENTRY	PTH
PTH:	BLOCK	SFDS+4			;ARGS FOR PATH UUO
	PRGEND
	TITLE	SAVE1 - SAVE P1
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	SAVE1
	EXTERN	CJRA,RET1
SAVE1:	EXCH	P1,(P)
	HRL	P1,P
	PUSHJ	P,CJRA
	 SOS	-1(P)
	JRST	RET1
	PRGEND
	TITLE	SAVE2 - SAVE P1-P2
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	SAVE2
	EXTERN	CJRA,RET2
SAVE2:	EXCH	P1,(P)
	HRL	P1,P
	PUSH	P,P2
	PUSHJ	P,CJRA
	 SOS	-2(P)
	JRST	RET2
	PRGEND
	TITLE	SAVE3 - SAVE P1-P3
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	SAVE3
	EXTERN	CJRA,RET3
SAVE3:	EXCH	P1,(P)
	HRL	P1,P
	PUSH	P,P2
	PUSH	P,P3
	PUSHJ	P,CJRA
	 SOS	-3(P)
	JRST	RET3
	PRGEND
	TITLE	SAVE4 - SAVE P1-P4
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	SAVE4
	EXTERN	CJRA,RET3
SAVE4:	EXCH	P1,(P)
	HRL	P1,P
	PUSH	P,P2
	PUSH	P,P3
	PUSH	P,P4
	PUSHJ	P,CJRA
	 SOS	-4(P)
	POP	P,P4
;FALL TO RET3
	PRGEND
	TITLE	RET3
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	RET3
	EXTERN	RET2
RET3:	POP	P,P3
;FALL TO RET2
	PRGEND
	TITLE	RET2
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	RET2
	EXTERN	RET1
RET2:	POP	P,P2
;FALL TO RET1
	PRGEND
	TITLE	RET1
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	RET1
	EXTERN	CPOPJ1
RET1:	POP	P,P1
;FALL TO CPOPJ1
	PRGEND
	TITLE	CPOPJ1 - SKIP RETURN
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	CPOPJ1
	EXTERN	CPOPJ
CPOPJ1:	AOS	(P)
;FALL TO CPOPJ
	PRGEND
	TITLE	CPOPJ
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	CPOPJ
CPOPJ:	POPJ	P,
	PRGEND
	TITLE	CJRA
	SEARCH	PRS
	TWOSEG
	RELOC	400000
	ENTRY	CJRA
CJRA:	JRA	P1,(P1)
	END