// If //
// Copyright Xerox Corporation 1979

// Modified July 9, 1982 8:47 AM by Swinehart -- add /c switch, unload /w switch
// Last modified December 4, 1979 10:13 AM by Deutsch
// Last modified October 12, 1979 9:25 AM by Newell
// Last modified October 8, 1979 7:21 PM by Taft
// Martin Newell. December 1978.

// If implements conditional execution of groups of commands
// to the Alto Executive.
// If <condition> [then <commands>] [else <commands>]
// where [] denotes an optional clause, and
// <condition> is one of:
// filename (yields true if file exists)
// filename/l=N (yields true if length of file = N)
// filename/l<N (yields true if length of file < N)
// filename/l>N (yields true if length of file > N)
// filename/s"string" (yields true if file contains string)
// filename/r=otherfilename/r (yields true if read date of
// file = read date of otherfile)
// {similarly with < or >}
// {similarly with either or both ’r’ changed to ’w’ meaning
// write date, or ’c’ meaning the creation date}
// and N is a decimal constant
// <commands> is any string of Alto executive commands
// separated by ’;’.
// Note necessity to escape semicolon past the Executive
// command line reader.
// It is possible to nest Ifs by enclosing <commands> in braces
// (’{’ and ’}’): the braces will be removed, but occurrences of
// " then " or " else " within the braces will not terminate the
// <commands> with respect to the outer If.
// In the case that <condition> yields true the <commands>
// in the then clause (if present) are passed to the
// Executive for execution, otherwise the <commands> in the
// else clause (if present) are passed.
// Compiler prog.mesa
// If prog.errlog then bravo/m prog else mesa prog
// This is a modification of the m quit macro in bravo for
// mesa.
// The equivalent in the bcpl world is:
// bcpl/f prog.bcpl
// If prog.bt/s+ERROR+ then bravo/b prog else bldr prog
// If prog.mesa/w>prog.bcd/w then Compiler prog.mesa

// To load:
// Bldr 100/w If KPMTemplatea KPMTemplateb
// (change the 100 to a larger number if Bldr complains about
// insufficient space for statics)

get "streams.d"
get "altofilesys.d"
get "disks.d"
// No other way to get file read/write dates!

external [ BFSActOnPages; CharWidth; Closes; Endofs;
FalsePredicate; FileLength; FilePos; FindFdEntry
Gets; MoveBlock; OpenFile; OpenFileFromFp
ParseFileName; Puts; ReadBlock; Resets
Timer; TruncateDiskStream; Usc
Wns; Wos; WriteBlock; Wss;
dsp; fpComCm; fpRemCm; fpSysDir; keys; sysZone; sysDisk

[ MakeKPMTemplate; MatchKPMTemplate ]

static [ doch //Last char read from .do file
Scom //input stream from com.cm
comch //Last char read from com.cm (Scom)
DotInFileName //set in ReadFileName
//Depth of nesting in braces, see AccountGets

manifest [ Buffsize=5000; pLeftBrace=${; pRightBrace=$};
pHerald=$#; pEscape=$"; bs=#10 ]

let Main() be
let Srem=0
and Scratch=0
and ch=0
and Buffer=vec Buffsize
and Nread=0

test Endofs(Srem)
[ Resets(Srem)
if (FilePos(Srem)&1) eq 1 do Puts(Srem,$*n) //word boundary for:
[ Scratch=OpenFile("if.scratch",ksTypeReadWrite,charItem)
Resets(Srem); Resets(Scratch)
Closes(Scom); Closes(Srem)

and Transcribe(Scom,Srem) = valof
let name=vec maxLengthFnInWords
and sw=$*s
comch=Gets(Scom) repeatuntil
Endofs(Scom) % (comch eq $*n) %
((comch ne $*s) & (comch ne $*t)) //find command
until Endofs(Scom) % WhiteSpace(comch)
do comch=Gets(Scom) //skip over command
if ReadFileName(Scom,name) do
[ test valof
[ if comch eq $/ do sw=Gets(Scom) //read switch
switchon sw into
[ case $l: //length
case $L:
[ let S=OpenFile(name,ksTypeReadOnly, charItem)
and length = (S? FileLength(S), 0)
resultis selecton Gets(Scom) into //the operator
[ case $=: length eq Readn(Scom)
case $<: Usc(length, Readn(Scom)) ls 0
case $>: Usc(length, Readn(Scom)) gr 0
default: length ne 0
case $r: //read date
case $R:
case $w: //write date
case $W:
case $c:
// create date
case $C:
[ let time1, time2 = vec lTIME, vec lTIME
and chrel = nil
GetFileDate(name, sw, time1)
chrel = Gets(Scom)
//relation character
ReadFileName(Scom, name)
if comch eq $/ then sw = Gets(Scom)
GetFileDate(name, sw, time2)
resultis selecton chrel into
[ case $=: LongUsc(time1, time2) eq 0
case $<: LongUsc(time1, time2) ls 0
case $>: LongUsc(time1, time2) gr 0
default: false
case $s: //contains string
case $S:
[ let S=OpenFile(name,ksTypeReadOnly, wordItem)
and str=vec 256
and term=Gets(Scom)
and ch=Gets(Scom)
and len=0
// read string to be matched
[ until ch eq term do
[ if len ge 126 do Abort("String too long")
len=len+1; str!len=ch
test Gets(Scom) eq term //used as escape?
[ if len ge 126 do Abort("String too long")
len=len+1; str!len=term
or break
] repeat
resultis S ? MatchInStream(str,S), false
resultis LookupFileName(name, 0)
[ if ScanFor(Scom,"then") do
[ if ScanFor(Scom,"else") do

and ScanFor(s,str) = valof
//scan, discarding, up to and including str plus delimeter
//Ignore occurrences within braces
let unstrU=vec 256
and unstrL=vec 256
and found=0
and ch=0
and len=UnPackUL(str,unstrU,unstrL)
// scan for str
[ while depth ne 0 do
[ if Endofs(s) resultis false
for i=1 to len do
[ if Endofs(s) resultis false
ch = AccountGets(s)
if (ch ne unstrU!i) & (ch ne unstrL!i) do
[ found=false; break ]
if found do
[ unless Endofs(s) do
[ if WhiteSpace(AccountGets(s)) resultis true ]
until ch eq $*s do
[ if Endofs(s) resultis false
ch = AccountGets(s)
] repeat

and CopyUntil(s,s2,str) be
//Copy from s to s2 up to and discarding str plus delimiter
//Ignore occurrences within braces
let unstrU=vec 256
and unstrL=vec 256
and strbuf=vec 256
and index=0 //used as found flag
and ch=0
and len=UnPackUL(str,unstrU,unstrL)
//scan for str
[ while depth ne 0 do
[ if Endofs(s) return
ch = AccountPuts(s2,Gets(s))
for i=1 to len do
[ if Endofs(s) return
ch = Gets(s); strbuf!i = ch
if (ch ne unstrU!i) & (ch ne unstrL!i) do
[ index=i; break ]
//if string matched, check delimiter
if index eq -1 do
[ unless Endofs(s) do
[ ch=Gets(s)
unless WhiteSpace(ch) do index=len
test index eq -1
then //found
[ Puts(s2,$*n)
or //output matched chars followed by unmatched one
[ for i=1 to index-1 do Puts(s2,strbuf!i)
//not braces
// scan for next delimiter
until WhiteSpace(ch) do
[ if Endofs(s) return
ch = Gets(s)
] repeat

and UnPackUL(str,strU,strL) = valof //Unpack into upper and lower case versions. Returns length
let ch=0
and len=str>>STRING.length
// unpack str into Upper and Lower case versions
strU!0,strL!0 = len,len
for i=1 to len do
[ ch = str>>STRING.char↑i & #337 //i.e. Upper case if letter
test ($A le ch) & (ch le $Z)
then [ strU!i = ch; strL!i = ch + #40; ]
[ strU!i = str>>STRING.char↑i
strL!i = strU!i
resultis len

and AccountGets(s) = valof
//Get character from s and adjust depth
let ch = Gets(s)
test ch eq pLeftBrace
then depth = depth+1
or if ch eq pRightBrace
then depth = depth-1
resultis ch

and AccountPuts(s,ch) = valof
//Put ch on s if not an outermost brace, and adjust depth
test ch eq pLeftBrace then
[ if depth ne 0 then Puts(s,ch)
depth = depth+1
or test ch eq pRightBrace then
[ depth = depth-1
if depth ne 0 then Puts(s,ch)
or Puts(s,ch)
resultis ch

and MatchInStream(str,S) = valof
//search for unpacked string str in stream S
//str must contain no more than 126 chars
//S must be a word stream
let buffer=vec 128
and pstr=vec 64
and tmplt=0
and nread=0
and len=str!0

//pack str with prefix and postfix * for wildcard
for i=1 to len do pstr>>STRING.char↑(i+1) = str!i
pstr>>STRING.char↑1 = $**
pstr>>STRING.char↑(len+2) = $**
pstr>>STRING.length = len+2

tmplt = MakeKPMTemplate(pstr)
buffer!0=#177400 //string length 255, first char 0
nread = ReadBlock(S,buffer+1,63)
[ Zero(buffer+64,63)
if MatchKPMTemplate(buffer,tmplt) eq 0 do resultis true
] repeat
until nread ne 63
resultis false

and Abort(str) be
// Should really ask for effective result of the if command to be typed in here and insert it into rem.cm

and Copystream(s1,s2,Buf,Bufsiz) be
until Endofs(s1) do
[ let Nread=ReadBlock(s1,Buf,Bufsiz)

and ReadString(Si,So,String,StringChar,EscapeChar) = valof
[Rt let ch=0
and escape=false
until MyEndofs(Si) do //find first valid char
[ ch=PromptGets(Si,So,escape?EscapeChar,$|)
if StringChar(ch) do break
if MyEndofs(Si) do resultis ch //didn’t find a string
switchon ch into
[ default: test escape % ch ne EscapeChar
then [ if So do Puts(So,ch)
unless StringChar(ch)%escape do break
or escape=true
case bs: test escape then escape=false
or [ if String>>STRING.length ne 0 do
[ if So do EraseBits(So,-CharWidth(So,String>>STRING.char↑(String>>STRING.length)))
String>>STRING.length=String>>STRING.length - 1
case $:̆ escape=false
let width=0
while String>>STRING.length gr 0 do
[ width=width+CharWidth(So,String>>STRING.char↑(String>>STRING.length))
String>>STRING.length=String>>STRING.length - 1
if String>>STRING.length eq 0 %
String>>STRING.char↑(String>>STRING.length) eq $*S %
String>>STRING.char↑(String>>STRING.length) eq $*T do break
if MyEndofs(Si) do break
]mainloop repeat
resultis ch

and ReadFileName(S,name) = valof
let ch=0
ch=ReadString(S, S eq keys?dsp,0, name, Filechar, 0)
for i= 1 to name>>STRING.length do
if name>>STRING.char↑i eq $. do DotInFileName=true
if S eq Scom do comch=ch
resultis name>>STRING.length > 0
and Filechar(ch) = ((ch ge $A) & (ch le $Z)) %
((ch ge $a) & (ch le $z)) %
((ch ge $0) & (ch le $9)) %
(ch eq $+) %
(ch eq $-) %
(ch eq $.) %
(ch eq $!) %
(ch eq $$)

and Readn(S) = valof //assumes first char of number next
let N=0
while doch ge $0 & doch le $9 do
[ N=N*10 + (doch-$0)
resultis N

and PromptGets(Si,So,prompt) = valof
[PG let Tv=vec 2
and on=false
if Si eq keys & Endofs(Si) do
[ [ let T=Timer(Tv)+600
on=not on
test on
then Puts(So,prompt)
or EraseBits(So,-CharWidth(So,prompt))
while Timer(Tv) ls T do
unless Endofs(Si) do break
] repeatwhile Endofs(Si)
if on do EraseBits(So,-CharWidth(So,prompt))
resultis Gets(Si)

and echoGets(S) = valof
[e let ch=Gets(S)
if S eq keys do Puts(dsp,ch)
resultis ch

and MyEndofs(S) = Endofs(S) & (S ne keys)

and WhiteSpace(ch) = (ch eq $*s) % (ch eq $*t) % (ch eq $*n)

and LongUsc(ln1, ln2) =
//Double-precision unsigned compare, for dates and file lengths
(ln1!0 ne ln2!0? Usc(ln1!0, ln2!0), Usc(ln1!1, ln2!1))

and GetFileDate(name, ch, time) be
//Get read or write date (ch=$r or $w) from file to vector time
let dv = vec lDV
unless LookupFileName(name, dv) do
[ Zero(time, lTIME)
let ld = vec 256
//The following is really unfortunate, should be an OS call
let fp = lv dv>>DV.fp
let DAs = vec 2
DAs!0, DAs!1 = fp>>FP.leaderVirtualDa, fillInDA
BFSActOnPages(sysDisk, lv ld, DAs, fp, 0, 0, DCreadD)
switchon ch into
[ case $r:// read date
case $R:
MoveBlock(time, lv ld>>LD.read, lTIME)
case $w: // read date
case $W:
MoveBlock(time, lv ld>>LD.written, lTIME)
case $c:
case $C:// create
MoveBlock(time, lv ld>>LD.created, lTIME)
default: Abort("Switch error")

and LookupFileName(name, dv) = valof
// Look up the dv of a file, return true if found. Dv may be 0.
let destName = vec maxLengthFnInWords
let lst = vec 4// see ParseFileName on p. 11 of the OS manual
lst!0 = SysErr
lst!1 = sysZone
lst!3 = sysDisk
let dirS = ParseFileName(destName, name, lst, verLatest)
if dirS eq 0 resultis false
let ptr = FindFdEntry(dirS, destName, 0, dv)
resultis ptr ne -1