// 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<<LC.vc
if lc<<LC.create & lc<<LC.multiple %
not lc<<LC.multiple & vc eq lcVAll %
not lc<<LC.create & vc eq lcVNext then
IFSError(ecIllegalLookupControl)
// scan the name string and set up the pointers in the FD
let code = ScanFD(fd)
if code gr 0 resultis code //error
if code ls 0 then unless fd>>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)
]