perm filename SAIFIL.FAI[S,AIL]2 blob sn#191955 filedate 1975-12-15 generic text, type T, neo UTF8
SEARCH HDRFIL
COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
↑↑FILNAM:
	SUB	SP,X22		;ADJUST STACK
	FOR II←1,3 <
	SETZM	FNAME+II(USER)>
	MOVEI	X,FNAME(USER)	;WHERE TO PUT IT
	PUSHJ	P,FLSCAN	;GET FILE NAME
	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
	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.
	PUSHJ	P,RJUST		;JUSTIFY(AND CONVERT IF EXPORT) PROG #
	HRRM	X,FNAME+3(USER)
FLDUN1:
	CAIN	Y,"]"
FLDUN:	AOS	(P)		;SUCCESSFUL
FLERR:	POPJ	P,		;DONE, NOT NECESSARILY RIGHT
ENDCOM(FIL)
END