perm filename SAIFIL.FAI[S,AIL] blob sn#376435 filedate 1978-08-29 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ITSSW←←1
C00012 ENDMK
C⊗;
ITSSW←←1
STANSW←←0
CMUSW←←0
SEARCH HDRFIL
COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
↑↑FILNAM:
	SUB	SP,X22		;ADJUST STACK
	FOR II←1,3 <
	SETZM	FNAME+II(USER)>
NOITS <
	MOVEI	X,FNAME(USER)	;WHERE TO PUT IT
	PUSHJ	P,FLSCAN	;GET FILE NAME
TYMSHR <	CAIE Y,"("
	JRST CHKEXT	;NOT USER NAME
	SETZM FUSER(USER)
	SETZM FUSER1(USER)
	HRRZS 1(SP)
	MOVEI D,12	;12 CHRS MAX
	MOVEI X,FUSER(USER)
	PUSHJ P,FLSCAN+2
	CAIE Y,")"
	JRST FLERR	;NOT DELIMITED PROPERLY
	MOVEI X,FUSER(USER)
	HRRZM X,FNAME+3(USER)	;STORE POINTER
	MOVEI X,FNAME(USER)
	PUSHJ P,FLSCAN
CHKEXT:
>; TYMSHR
	JUMPE	Y,FLDUN	;FILE NAME ONLY
	CAIE	Y,"."		;EXTENSION?
	JRST	FLEXT		;NO, CHECK PPN
	MOVEI	X,FNAME+1(USER)
	PUSHJ	P,FLSCAN
FLEXT:	JUMPE	Y,FLDUN	;NO PPN SPECIFIED
	CAIE	Y,"["
	JRST	FLERR		;INVALID CHARACTER
CMU <		;HANDLE PPNS VIA UUO, MAYBE
	HRRZS	1(SP)	;LENGTH PART
	SKIPN	1(SP)	;IS THERE A FIRST CHAR?
	JRST	FLERR	; NO.
	MOVE	X,2(SP)
	ILDB	X,X
	CAIN	X,"]"		;is it null?
	JRST	OCTPPN		; yes -- let the other guy handle it.
	CAIL	X,"0"
	CAILE	X,"7"
	SKIPA		; NOT OCTAL DIGIT
	JRST	OCTPPN
	PUSH	P,A	;NEED MORE ROOM
	PUSH	P,B
	SETZM	A	;CLEAR THE AREA
	SETZM	B
	SETZM	C
	MOVEI	D,=13+1	;MAX #CHARS+1
	MOVE	X,[POINT 7,A]	;DUMP THEM THERE
FLN2:	SOSGE	1(SP)
	JRST	FLERRC	;RAN OUT OF STRING
	ILDB	Y,2(SP)	;THE NEXT CHAR
	JUMPE	Y,FLN2	;IGNORE NULLS
	CAIN	Y,"]"	;THE END?
	JRST	GOTRB	; YES
	JUMPLE	D,FLERRC	;WE DON'T WANT ANY MORE CHARACTERS
	IDPB	Y,X	;STICK THE CHAR THERE
	SOJA	D,FLN2	;GET ANOTHER
GOTRB:	MOVEI	X,A	;THATS WHERE THE UUO WILL FIND THEM
	CALLI	X,-2		;CMUDEC UUO
	JRST	FLERRC	;SOMETHING WRONG
	MOVEM	X,FNAME+3(USER)	;SAVE IT
	AOS	-2(P)		;INDICATE SUCCESS
FLERRC:	POP	P,B
	POP	P,A
	POPJ	P,
OCTPPN:
>;CMU
TYMSHR <	SKIPE FNAME+3(USER)	;IGNORE IF USER NAME
	JRST FLDUN	;TREAT AS DONE
>;TYMSHR
	PUSHJ	P,[
	RJUST:	SETZM	PROJ(USER)
		MOVEI	X,PROJ(USER)
		PUSHJ	P,FLSCAN	;GET PROJ OR PROG IN SIXBIT
IFN SIXSW,<
		MOVE	X,PROJ(USER)
		IMULI	D,-6		;SHIFT FACTOR
		LSH	X,(D)		;RIGHT-JUSTIFY THE PROJ OR PROG
>;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
IFE SIXSW,<
		MOVEI	X,0
		SKIPN	D,PROJ(USER)
		POPJ	P,
	FBACK:	MOVEI	C,0
		LSHC	C,6		;GET A SIXBIT CHAR
		CAIL	C,'0'
		CAILE	C,'7'
		JRST	FLERR		;INVALID OCTAL
		LSH	X,3
		IORI	X,-'0'(C)
		JUMPN	D,FBACK
>;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
	FPOP:	POPJ	P,]
	HRLZM	X,FNAME+3(USER)
	CAIE	Y,","
	JRST	[JUMPE	X,FLDUN1	;ALLOW NULL PPN - CHECK FOR "]"
		 JRST	FLERR]		;A REAL ERROR.
DEC<
IFE ALWAYS,<EXTERN MYPPN>
	JUMPN	X,.+3	;IF NULL FIRST HALF,
	MOVE	X,MYPPN	;USE OUR PPN INSTEAD
	HLLM	X,FNAME+3(USER)
>;DEC
	PUSHJ	P,RJUST		;JUSTIFY(AND CONVERT IF EXPORT) PROG #
DEC<
	JUMPN	X,.+2
	MOVE	X,MYPPN	;IF NULL SECOND HALF, USE OUR PPN
>;DEC
	HRRM	X,FNAME+3(USER)
FLDUN1:
SFDS<
	CAIN	Y,"]"
	JRST	FLDUN	;IF ], OK
	CAIE	Y,","	;IF "," MUST BE SFD COMING
	JRST	FLERR	;IF NEITHER, ERROR
	SETZM	PATHBL(USER)	;INIT PATHBLOCK
	SETZM	PATHBL+1(USER)
	MOVE	C,PRPN(USER)	;GET PPN AND PUT IN PATH BLOCK
	MOVEM	C,PATHBL+2(USER)
	MOVEI	C,PATHBL(USER)	;AND PUT PTR TO PATH BLOCK IN PPN
	MOVEM	C,PRPN(USER)
	MOVEI	X,PATHBL+3(USER)	;FIRST SFD PLACE
	MOVEI	C,SFDLVL	;COUNTER - SFDLVL IS MAX NO. OF SFDS
FLSFD:	PUSHJ	P,FLSCAN	;GET SFD NAME
	CAIN	Y,"]"	;IF LAST ONE
	JRST	FLSFD1	;FINISHED
	MOVEI	X,1(X)	;OTHERWISE LOOK AT NEXT
	CAIN	Y,","
	SOJG	C,FLSFD	;UNLESS TOO MANY
	JRST	FLERR	;WHICH IS ERROR
FLSFD1:	SETZM	1(X)	;PUT ZERO AT END OF PATH BLOCK
> ;SFDS
FLDUN:	AOS	(P)		;SUCCESSFUL
FLERR:	POPJ	P,		;DONE, NOT NECESSARILY RIGHT
>;NOITS
ITS <
begin FNR
break←a		;returns with character that broke scan
dev←b		;returns dev,fn1,fn2,sname
fn1←c
fn2←d
sname←x
ac←y
char←z
acptr←q3
limbo←temp	;scanner read ahead character
for a in(a,b,c,z,q3,temp)
<	push p,a
>
	hrrzs 1(sp)		;only want length part
	pushj p,getfil
	jfcl			;null spec is okay
	movem fn1,fname(user)
	movem fn2,ext(user)
	movem sname,prpn(user)
	cain dev,0
fnrxit:	aos -6(p)		;do a skip return
for a in (temp,q3,z,c,b,a)
<	pop p,a
>
cpopj:	popj p,
getcc:	skipn break,limbo
	pushj p,nextc
	setzm limbo
	popj p,
nextc:	movei break,0		;assume no more
	sosl 1(sp)
	ildb break,2(sp)
	popj p,
psname:	pushj p,getcc		;break off word from input stream
	caie break,40		;ignore leading spaces
	cain break,11		;tabs too
	jrst psname
	move acptr,[440600,,ac]
	tdza ac,ac
name1:	pushj p,getcc
	pushj p,brktst
	jrst nambrk		;found a break character
name2:	tlne acptr,770000	;ignore everything after 6 characters
	idpb char,acptr
	jrst name1
nambrk:	jumpn char,cpopj	;no trailing spaces
nambr1:	pushj p,getcc
	caie break,40		;ignore trailing spaces
	cain break,11
	jrst nambr1
	pushj p,brktst
	popj p,			;a break character
	movem break,limbo	;space broke us
	movei break,40
	popj p,
brktst:	cain break,11
	movei break,40
	pushj p,sixtst
	jumpl char,[	caie break,21		;↑Q
			popj p,		;non-sixbit breaks us
			pushj p,getcc
			pushj p,sixtst
			jumpl char,cpopj	;non-sixbit
			jrst brkt1]
	jumpe char,cpopj
	caie char,':'
	cain char,';'
	popj p,
brkt1:	aos (p)
	popj p,
sixtst:	movni char,1
	cail break,40
	caile break,"←"
	jrst sixt1	;might be lower case
	movei char,-40(break)
	popj p,
sixt1:	cail break,"a"
	caile break,"z"
	popj p,
	movei char,<"A"-"a"-40>(break)
	popj p,
getfil:	setzb fn1,fn2
	setzb dev,sname
	setzm limbo
	pushj p,psname
	jumpe ac,cpopj
	aosa (p)
getf1:	pushj p,psname		;break off first name
	jumpe ac,cpopj		;let initl worry about it
	cain break,":"
	jrst [	move dev,ac
		jrst getf1]
	cain break,";"
	jrst [	move sname,ac
		jrst getf1]
	caie break,40
	jrst [	jumpn fn1,[	move fn2,ac
				popj p,]
		move fn1,ac
		popj p,]
	jumpn fn1,[	move fn2,ac
			jrst getf1]
	move fn1,ac
	jrst getf1
bend FNR
>;ITS
ENDCOM(FIL)