// IFSDirParse.bcpl -- Parse IFS filenames // Copyright Xerox Corporation 1979, 1981, 1982 // Last modified May 11, 1982 2:04 PM by Taft get "Ifs.decl" get "IfsFiles.decl" get "IfsDirs.decl" get "IfsRs.decl" external [ // Outgoing procedures CreateFD; DestroyFD; ParseFD; UpdateFD IFSParseVersion; IFSAppendVersion; SetDRLength // Incoming procedures -- rest of IFS IFSError; CreateStringStream; CopyString; FreePointer; PutTemplate MakeKPMTemplate // Incoming procedures -- operating system DefaultArgs; SysAllocateZero Puts; Wns; Wss; Closes // Incoming statics primaryIFS; CtxRunning ] //--------------------------------------------------------------------------- let CreateFD(name, lc, lvErrorCode, fs, dirName; numargs na) = valof //--------------------------------------------------------------------------- // Parses the supplied "name" (a BCPL string) and returns an FD // structure suitable for lookup purposes in file system fs, or zero // if the name is malformed. "lc" is the lookup control parameter. // "dirName" is the default directory name, and overrides the one in // the userInfo if supplied. // If an error is encountered and lvErrorCode is supplied, an // error code is stored in @lvErrorCode; zero is stored upon success. // The returned structure is allocated from sysZone. [ let userInfo = CtxRunning>>RSCtx.userInfo DefaultArgs(lv na, -2, lv na, primaryIFS, (userInfo>>UserInfo.defaultDir ne 0? userInfo>>UserInfo.defaultDir, userInfo>>UserInfo.connName)) if dirName eq 0 then dirName = "" // Blunder check on string lengths if name>>STRING.length gr maxPathNameChars % dirName>>STRING.length gr maxPathNameChars then [ @lvErrorCode = ecNameTooLong; resultis 0 ] // Generate the full filename let fullName = vec 127 let ss = CreateStringStream(fullName, 255) test name>>STRING.char^1 eq $< ifso Wss(ss, name) ifnot [ // If the default directory is in the form ">xxx" then prefix the // connect name; otherwise use it as it stands. let pref = dirName>>STRING.length ne 0 & dirName>>STRING.char^1 eq $>? userInfo>>UserInfo.connName, "" PutTemplate(ss, "<$S$S>$S", pref, dirName, name) ] Closes(ss) // build the FD and DR structures. // the DR must be long enough to accomodate appending a version. let length = fullName>>STRING.length if length gr maxPathNameChars then [ @lvErrorCode = ecNameTooLong; resultis 0 ] let fd = SysAllocateZero(lenFD) fd>>FD.fs = fs fd>>FD.lc = lc let dr = SysAllocateZero(lenDRHeader + (length+9) rshift 1) CopyString(lv dr>>DR.pathName, fullName) dr>>DR.type = drTypeNormal fd>>FD.dr = dr // attempt to parse the name. @lvErrorCode = ParseFD(fd) if @lvErrorCode ne 0 then fd = DestroyFD(fd) resultis fd ] //--------------------------------------------------------------------------- and DestroyFD(fd) = valof //--------------------------------------------------------------------------- // Deallocates the supplied FD and returns zero to permit one to say // "foo = DestroyFD(foo)" [ FreePointer(lv fd>>FD.dr, lv fd>>FD.template, lv fd>>FD.pathStk, lv fd) resultis 0 ] //--------------------------------------------------------------------------- and ParseFD(fd) = valof //--------------------------------------------------------------------------- // Parses the name string in the fd's DR and sets up the auxiliary // lookup information in the FD. Returns zero if successful and // an error code if unsuccessful. [ // reject illegal combinations of lookup control parameters let lc = fd>>FD.lc let vc = lc<>FD.lc.multiple resultis ecIllegalStar fd>>FD.iFirstStar = -code //record index of first "*" // parse the version number if there is one let dr = fd>>FD.dr let length = dr>>DR.pathName.length test fd>>FD.lenBodyString gr 0 & fd>>FD.lenBodyString ls length ifso switchon IFSParseVersion(lv dr>>DR.pathName, fd>>FD.lenBodyString+1, length, lv fd>>FD.version) into [ case 0: // successfully parsed version [ vc = lcVExplicit; endcase ] case 1: // non-digit encountered [ if fd>>FD.lenBodyString eq length-1 then [ // test for special cases of !H, !N, !L, !* let nvc = selecton dr>>DR.pathName.char^length into [ case $H: case $h: lcVHighest case $N: case $n: lcVNext case $L: case $l: lcVLowest case $**: lcVAll default: 0 ] if nvc ne 0 then [ vc = nvc; endcase ] ] // not one of the special cases, treat as no version case fd>>FD.lenBodyString = length+1 endcase ] case 2: // illegal version number, error resultis ecIllegalVersion ] ifnot fd>>FD.lenBodyString = length+1 // where to append version fd>>FD.lc.vc = vc // ParseFD (cont'd) // special case: no "*" and no version in string and lcVAll default? if vc eq lcVAll & fd>>FD.iFirstStar eq 0 then fd>>FD.iFirstStar = length+2 // where "*" will be eventually // remaining processing depends on whether name contains "*"s test fd>>FD.iFirstStar eq 0 ifso [ // no "*"s, compute and append version for actual lookup unless vc eq lcVExplicit do fd>>FD.version = (vc eq lcVLowest? 0, #177777) IFSAppendVersion(fd) ] ifnot [ // "*"s, generate KPM template and truncate name in DR unless vc eq lcVExplicit do [ // append "!*" let i = fd>>FD.lenBodyString dr>>DR.pathName.char^i = $! dr>>DR.pathName.char^(i+1) = $** dr>>DR.pathName.length = i+1 ] fd>>FD.template = MakeKPMTemplate(lv dr>>DR.pathName) dr>>DR.pathName.length = fd>>FD.iFirstStar-1 fd>>FD.lenBodyString = dr>>DR.pathName.length ] resultis (dr>>DR.pathName.length gr maxPathNameChars? ecNameTooLong, 0) ] //--------------------------------------------------------------------------- and UpdateFD(fd) be //--------------------------------------------------------------------------- // Re-parses the FD's pathname and resets the lenDirString, // lenBodyString, and version fields in the FD. This should be // done only after the FD's pathname is replaced by a real // filename. [ if ScanFD(fd) ne 0 % fd>>FD.lenBodyString eq 0 then IFSError(ecIllegalExistingName, lv fd>>FD.dr>>DR.pathName) IFSParseVersion(lv fd>>FD.dr>>DR.pathName, fd>>FD.lenBodyString+1, fd>>FD.dr>>DR.pathName.length, lv fd>>FD.version) ] //--------------------------------------------------------------------------- and ScanFD(fd) = valof //--------------------------------------------------------------------------- // Scans the fd.dr.pathName string and sets the lenDirString, lenSubDirString, // and lenBodyString fields in the fd. lenBodyString is set // to zero if no "!" is encountered. no attempt is made // to parse the version. Returns one of: // zero - normal // positive - error code // negative - negative of the index of the first "*" [ let dr = fd>>FD.dr fd>>FD.lenDirString, fd>>FD.lenBodyString = 0, 0 let iFirstStar = 0 // no "*" seen yet for i = 1 to dr>>DR.pathName.length do [ let char = dr>>DR.pathName.char^i switchon char into [ case $>: [ if fd>>FD.lenDirString eq 0 then fd>>FD.lenDirString = i fd>>FD.lenSubDirString = i endcase ] case $!: [ fd>>FD.lenBodyString = i; endcase ] case $**: [ if iFirstStar eq 0 then iFirstStar = i; endcase ] default: [ if char le #40 % char ge #177 resultis ecIllegalChar ] ] ] if fd>>FD.lenDirString eq 0 & iFirstStar eq 0 % dr>>DR.pathName.char^1 ne $< & iFirstStar ne 1 then resultis ecNameMalformed // "<" or ">" missing resultis -iFirstStar // zero if no "*" ] //--------------------------------------------------------------------------- and IFSParseVersion(string, firstChar, lastChar, lvVersion) = valof //--------------------------------------------------------------------------- // Attempts to parse the substring described by the arguments // as a version number. Stores the version in @lvVersion if // successful. A code is returned describing the outcome: // 0 successful // 1 non-digit encountered // 2 illegal version number (zero or overflowed 16 bits) [ let code,version = 0,0 for i = firstChar to lastChar do [ let digit = string>>STRING.char^i-$0 if digit ls 0 % digit gr 9 resultis 1 // non-digit encountered if version ugr 6553 % (version eq 6553 & digit gr 5) then code = 2 // overflowed, but keep scanning to find non-digits version = 10*version+digit ] if version eq 0 then code = 2 @lvVersion = version resultis code ] //--------------------------------------------------------------------------- and IFSAppendVersion(fd) be //--------------------------------------------------------------------------- // Appends the version number to the pathname string in the // FD structure fd. Assumes that the lenBodyString // word contains the index of the character to be overwritten // by the "!". Updates directory entry length and string length. [ let dr = fd>>FD.dr let ss = CreateStringStream(lv dr>>DR.pathName, 999, fd>>FD.lenBodyString) Puts(ss, $!) Wns(ss, fd>>FD.version, 0, 10) // unsigned decimal Closes(ss) SetDRLength(dr) ] //--------------------------------------------------------------------------- and SetDRLength(dr) be //--------------------------------------------------------------------------- // Sets the DR's length based on its type and the pathname's length [ dr>>DR.length = lenDRHeader+1 + dr>>DR.pathName.length rshift 1 + (dr>>DR.type eq drTypeDIF? lenDIFRec, 0) ]