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)