Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
stanford/makimp/makfil.sai
There are no other files named makfil.sai in the archive.
! MakeExt, MakeDir, GetDir, HasDir, GetExt, HasExt?;
! ********** L O W E R *********;
simp string procedure lower(string s);
begin
string new, c;
new_"";
while not (length(s)=0) do
begin
c_lop(s);
if c "A" and c "Z" then c_(c+"a"-"A")&"";
new_new&c
end;
return(new)
end;
IFWAITS
! ********** M A K E E X T **********;
procedure makeext (reference string s; string ext);
BEGIN "-- make extension --"
integer e,d; d_0; if s="" then begin s_"."&ext; return end;
do d_d+1 until d = length(s) or
equ(s[d+1 for 1],"[") or
equ(s[d+1 for 1],".");
if equ(s[d+1 for 1],".") then
begin "-- remove old extension --"
e_d; do e_e+1 until equ(s[e for 1],"[") or equ(e,length(s));
if e=length(s) then s _ s[1 for d]
else s _ s[1 for d] & s[e for length(s)-e+1];
end "-- remove old extension --";
s _ s[1 for d] & "." & ext & s[d+1 to length(s)];
END "-- make extension --";
string procedure getext(string name);
BEGIN "-- get ext --"
integer j,i,e; string ext; j_i_1; e_length(name);
if name="" then return("");
while not (equ(name[i for 1],".") or i=e) DO i_i+1;
if i=e then return("");
while not (equ(name[j+1 for 1],"[") or j=e) DO j_j+1;
if i=j then ext _ "" else ext _ name[i+1 to j];
if length(ext)>3 then ext_ext[1 to 3];
return(lower(ext));
END "-- get ext --";
define hasext(name) = "(not getext(name)=null)";
! ********** M A K E D I R **********;
procedure makedir (reference string s; string dir);
BEGIN "-- make directory --"
integer d; d_0;
do d_d+1 until equ(d,length(s)) or equ(s[d+1 for 1],"[");
s _ s[1 for d] & dir;
END "-- make directory --";
string procedure getdir(string name);
BEGIN "-- get dir --"
integer i,e; string dir; i_1; e_length(name);
while not (equ(name[i for 1],"[") or i=e) DO i_i+1;
if equ(name[e for 1],"]") then e_e-1;
if i=e then dir _ "" else dir _ name[i+1 to e];
return (lower(dir));
END "-- get dir --";
define hasdir(name) = "(not getdir(name)=null)";
ENDWAITS
IFTOPS20
require "scflnm.sai"source!file; ! filename scanning utility;
! ********** M A K E E X T **********;
internal simp procedure makeext (reference string s; string ext);
begin "-- make extension --"
string logname,direct,filname;
scanfilename(s,logname,direct,filname,junk,junk);
s_logname&direct&filname&(if not equ(ext,"") then "."&ext else "")
end "-- make extension --";
! ********** G E T E X T **********;
internal simp string procedure getext(reference string name);
begin "-- get ext --"
string ext;
scanfilename(name,junk,junk,junk,ext,junk);
return (lower(ext))
end "-- get ext --";
! ********** H A S E X T **********;
define hasext(name) = "(not getext(name)=null)";
! ********** M A K E D I R **********;
internal simp procedure makedir (reference string s; string dir);
begin "-- make directory --"
string logname,filname,ext,gen;
scanfilename(s,logname,junk,filname,ext,gen);
s_filname;
if not equ(ext,"") then
if not equ(gen,"") then s_s&"."&ext&"."&gen
else s_s&"."&ext;
s_dir&s
end "-- make directory --";
! ********** G E T D I R **********;
Internal simp string procedure getdir(reference string name);
begin "-- get dir --"
string direct;
scanfilename(name,junk,direct,junk,junk,junk);
return (lower(direct))
end "-- get dir --";
! B Y T E S I N
!
! ***********************************************************************
! For TOPS-20 fileinfo. Pentti Kanerva, 27-Oct-81;
! ***********************************************************************;
internal simp integer procedure Bytesin (integer chan,bytesize);
begin "-- BytesIn --"
integer bpw;
own integer array fdb [0:'24];
gtFDB (chan, fdb); ! File descriptor block;
if fdb['12] = 0 then return (0); ! Empty file;
if bytesize = ((fdb['11] rot 12) land '77) then return(fdb['12]);
! File size in bytes;
bpw_36 div ((fdb['11] rot 12) land '77); ! Bytes per word;
return ( (36 div bytesize)*((fdb['12] + bpw - 1) div bpw) )
! Words in file;
end "-- BytesIn --";
! W O R D S I N
!
! ***********************************************************************
! For TOPS-20 fileinfo. Pentti Kanerva, 27-Oct-81;
! ***********************************************************************;
internal simp integer procedure Wordsin (integer chan);
begin "-- wordsIn --"
integer bpw;
own integer array fdb [0:'24];
gtFDB (chan, fdb); ! File descriptor block;
if fdb['12] = 0 then return (0); ! Empty file;
bpw_36 div ((fdb['11] rot 12) land '77); ! Bytes per word;
return ( (fdb['12] + bpw - 1) div bpw ) ! Words in file;
end "-- wordsIn --";
! I N M A P
!
! ***********************************************************************
! Maps specified file page to specified process page;
! ***********************************************************************;
internal simp procedure InMap(integer jfn, filepage, procpage, number);
begin "-- in map --"
integer ac1,ac2,ac3;
printi3(<nl,"InMap, jfn ",jfn,", filepage ",cvos(filepage),
", process page ",cvos(procpage),", number of pages ",number>)
ac1_(jfn lsh 18) lor filepage;
ac2_(curfork lsh 18) lor procpage;
if number > 1 then ac3 _ '600000000000 lor number
else ac3 _ '200000000000;
Pmap(ac1,ac2,ac3)
end "-- in map --";
ENDTOPS20
! SepSwitches;
! S E P A R A T E S W I T C H E S
!
! **********************************************************************
! Separate file names and switches in input line.
! **********************************************************************;
internal simp string procedure sepswitches(reference string line);
begin "-- separate switches --"
integer i,l;
string s;
l_length(line); i_0;
while (equ(line[i for 1]," ") or equ(line[i for 1],'11)) and
i length(line) do i_i+1;
if i > length(line) then return("");
while not (equ(line[i for 1]," ") or equ(line[i for 1],'11) or
equ(line[i for 1],"/") or equ(line[i for 1],"\")) and
i length(line) do i_i+1;
if i>length(line) then return("");
s_line[i+1 to l];
line_line[1 to i-1];
return(s)
end "-- separate switches --";
! FileExists, TryExists;
IFWAITS
! F I L E E X I S T S
!
! **************************************************************
! given a name of a file, returns true if the file exists
! **************************************************************;
internal simp boolean procedure fileexists(reference string name);
begin
integer sav, eof, brch, ch;
open(ch_getchan,"DSK", '10, 2, 0, 512, brch, eof);
lookup (ch, name, eof); sav_eof;
release(ch); return (not eof)
end;
ENDWAITS
IFTOPS20
! F I L E E X I S T S
!
! **************************************************************
! given a name of a file, returns true if the file exists.
! This code accepts wildcards, and will reset filename if a match is
! found. This section by Jan Stoeckenius, 1/2/82
! **************************************************************;
internal simp boolean procedure fileexists(reference string name);
begin "-- file exists? --"
integer ch;
string s;
ch_GTJFN(name,'100101000000);
if ch=-1 then return(FALSE)
else
begin "-- yes --"
MakeExt(name,JFNS(ch,'000100000000)); ! Get extension;
release(ch);
return(TRUE)
end "-- yes --"
end "-- file exists? --";
ENDTOPS20
! T R Y E X T E N S I O N S
!
! ******************************************************************
! TryExts tries to put different extensions on a file name until
! it finds a file that exists. Num is the number of extensions
! (followed by a space) in the passed string s. When an extension
! works, the working name is returned in the reference string name
! and the ordinal number of the extension returned. Otherwise,
! the extensions are deleted from the name and a 0 returned;
! ******************************************************************;
internal simp integer procedure tryexts(reference string file;
string num, s);
begin "-- try extensions --"
integer i,n;
string c,ext; ! NOTE: an extension has NO ".";
while not (length(num)=0) do
begin "-- try one --"
ext_""; n_intscan(num,i);
if not length(s)=0 then do ext _ ext & lop(s) until s="" or s=" ";
makeext(file,ext);
if fileexists(file) then return(n);
if not s="" then c_lop(s) else
begin "-- no good --"
makeext(file,"");
return(0)
end "-- no good --"
end "-- try one --";
makeext(file,""); return(0)
end "-- try extensions --";