Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
stanford/makimp/scflnm.sai
There are no other files named scflnm.sai in the archive.
! ScanFileName;
! S C A N F I L E N A M E
!
! **********************************************************************
! Scans string s for TOPS20 file name syntax, placing device or structure
! or logical name in logname, directory name in directory, file name in
! filename, file name extension in extension, and generation count (as a
! string) in gencount. The procedure checks that the string s has proper
! syntax and ask the user to replace it with a new string. This had better
! not occur if calling program does strange things to the print command or
! the job is being run in batch mode;
! **********************************************************************;
internal procedure ScanFileName (reference string s, logname, directory,
filename, extension, gencount);
Begin "-- scan file name --"
define freescan = 1,
anglescan = 2,
squarescan = 3,
extensionscan = 4,
gencountscan = 5;
! Indicates what is currently being
scanned. Note that square and angle-bracketed
directories are handled separately;
define nothing = 1,
logscnd = 2,
dirscnd = 3;
! Indicates what has been scanned. Only
three states are necessary because others
are implied by what is being scanned (i.e.,
if an extension is being scanned the
filename must already have been scanned);
define error = -1,
fieldscanned = 0,
scanend = 1; ! indicates nature of return;
define curchar = "s[d for 1]"; ! current character;
define normal = "begin curbuff_curbuff&cur; return(scanfield); end";
define normall = "curbuff_curbuff&cur; return(scanfield)";
! Normal recursive step;
label start; ! Place to return to after error recovery;
boolean quotescan; ! If true, next character is quoted;
integer d, ! Pointer into string for current character;
e, ! Start of string after stripping initial spaces;
scantype, ! Type of field being scanned;
scannedtype, ! Type of field already scanned;
returntype; ! Type of return;
string curbuff, ! Holds scanned portion of field being scanned;
cur; ! Next character to be scanned;
recursive integer procedure scanfield; ! This does the real work;
begin "-- scan --"
d_d+1;
if d > length(s) then cur_" " else cur_curchar;
! all strings act as though ended by a terminator;
if (quotescan) then ! quote next character;
begin "-- quote one char --"
quotescan_FALSE;
normall
end "-- quote one char --"
else
begin "-- field scan --"
quotescan_FALSE;
case cur of begin "-- field scan case statement --"
NUMBERS normal;
LETTERS case scantype of begin "-- case statement --"
[freescan]
[anglescan]
[squarescan]
[extensionscan] normal;
[gencountscan] return(error)
end "-- case statement __";
TERMINATORS case scantype of begin "-- case --"
[freescan] begin "-- end scan --"
filename_curbuff;
if length(filename) > 0 then
return(scanend)
else return(error)
end "-- end scan --";
[extensionscan] begin "-- end scan --"
extension_curbuff;
return(scanend)
end "-- end scan --";
[gencountscan] begin "-- end scan --"
gencount_curbuff;
return(scanend)
end "-- end scan --";
[anglescan]
[squarescan] return(error)
end "-- case --";
["<"] case scannedtype of begin "-- case --"
[nothing]
[logscnd] begin "-- anglescan --"
if equ(curbuff,"") then
begin "-- a scan --"
scantype_anglescan;
normall
end "-- a scan --"
else return(error)
end "-- anglescan --";
[dirscnd] return(error)
end "-- case --";
["["] case scannedtype of begin "-- case --"
[nothing]
[logscnd] begin "-- square scan --"
if equ(curbuff,"") then
begin "-- a scan --"
scantype_squarescan;
normall
end "-- a scan --"
else return(error)
end "-- square scan --";
[dirscnd] return(error)
end "-- case --";
[">"] case scantype of begin "-- case --"
[anglescan] begin "-- end angle scan --"
directory_curbuff&cur;
scannedtype_dirscnd;
scantype_freescan;
if length(directory) > 2 then
return(fieldscanned)
else return(error)
end "-- end angle scan --";
[freescan]
[squarescan]
[extensionscan]
[gencountscan] return(error)
end "-- case --";
["]"] case scantype of begin "-- case --"
[squarescan] begin "-- end square scan --"
directory_curbuff&cur;
scannedtype_dirscnd;
scantype_freescan;
if length(directory) > 2 then
return(fieldscanned)
else return(error)
end "-- end square scan --";
[freescan]
[anglescan]
[extensionscan]
[gencountscan] return(error)
end "-- case --";
[":"] case scantype of begin "-- case --"
[freescan] case scannedtype of begin "- c -"
[nothing] begin "-- end l scan --"
logname_curbuff&cur;
scannedtype_logscnd;
if length(logname) > 1 then
return(fieldscanned)
else return(error)
end "-- end l scan --";
[logscnd]
[dirscnd] return(error)
end "- c -";
[anglescan]
[squarescan]
[extensionscan]
[gencountscan] return(error)
end "-- case --";
["."] case scantype of begin "-- case --"
[freescan] begin "-- change scan --"
filename_curbuff;
scantype_extensionscan;
if length(filename) > 0 then
return(fieldscanned)
else return(error)
end "-- change scan --";
[anglescan]
[squarescan] normal;
[extensionscan] begin "-- change scan --"
extension_curbuff;
scantype_gencountscan;
return(fieldscanned)
end "-- change scan --";
[gencountscan] return(error)
end "-- case --";
ILLEGALS return(error);
QUOTE begin "-- quote --"
quotescan_TRUE;
return(scanfield)
end "-- quote --"
end "-- field scan case statement --"
end "-- field scan --"
end "-- scan --";
start: d_1; curbuff_logname_directory_filename_extension_gencount_"";
print5(<nl,"Scan file name, input name is ",s>)
scannedtype_nothing; scantype_freescan; quotescan_FALSE;returntype_0;
while (equ(curchar," ") or equ(curchar,'11)) and d length(s)
do d_d+1;
if (d > length(s)) then return else d_d-1;
e_d; ! Strip off leading spaces;
! the interesting stuff starts here;
while not((error = returntype_scanfield) or
(scanend = returntype)) do curbuff_"";
if (returntype = error) then
begin "-- error --"
print(nl,"Can't parse filename: ",s[e to d-1]&'12&s[d to ]);
print(nl,nl,"New file name: "); s_s[1 to e-1]&intty;
go start
end "-- error --"
else return
end "-- scan file name --";