// 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.
//
// SYNTAX
//
// 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.
//
// SEMANTICS
// 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.
//
// EXAMPLE I:
//
// 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.
//
// EXAMPLE II:
// The equivalent in the bcpl world is:
//
// bcpl/f prog.bcpl
// If prog.bt/s+ERROR+ then bravo/b prog else bldr prog
//
// EXAMPLE III:
//
// 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; EraseBits
           FalsePredicate; FileLength; FilePos; FindFdEntry
           Gets; MoveBlock; OpenFile; OpenFileFromFp
           ParseFileName; Puts; ReadBlock; Resets
           SysErr; Timer; TruncateDiskStream; Usc
           Wns; Wos; WriteBlock; Wss; Zero
           dsp; fpComCm; fpRemCm; fpSysDir; keys; sysZone; sysDisk
         ]

external [ 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	//Depth of nesting in braces, see AccountGets
       ]

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

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

   Scom=OpenFile("com.cm",ksTypeReadOnly,charItem,0,fpComCm)
   Srem=OpenFile("rem.cm",ksTypeReadWrite,charItem,0,fpRemCm)
   Nread=ReadBlock(Srem,Buffer,Buffsize)
   test Endofs(Srem)
   then
   [  Resets(Srem)
      Transcribe(Scom,Srem)
      if (FilePos(Srem)&1) eq 1 do Puts(Srem,$*n) //word boundary for:
      WriteBlock(Srem,Buffer,Nread)
      TruncateDiskStream(Srem)
   ]
   or
   [  Scratch=OpenFile("if.scratch",ksTypeReadWrite,charItem)
      WriteBlock(Scratch,Buffer,Nread)
      Copystream(Srem,Scratch,Buffer,Buffsize)
      Resets(Srem); Resets(Scratch)
      Transcribe(Scom,Srem)
      Copystream(Scratch,Srem,Buffer,Buffsize)
      Closes(Scratch)
   ]
   Closes(Scom); Closes(Srem)
]main

and Transcribe(Scom,Srem) = valof
[T
   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
                     ch=Gets(Scom)
                  ]
                  test Gets(Scom) eq term //used as escape?
                  then
                  [  if len ge 126 do Abort("String too long")
                     len=len+1; str!len=term
                     ch=Gets(Scom)
                  ]
                  or break
               ] repeat
               str!0=len
               resultis S ? MatchInStream(str,S), false
            ]
            default:
               resultis LookupFileName(name, 0)
         ]
      ]
      then
      [  if ScanFor(Scom,"then") do
               CopyUntil(Scom,Srem,"else")
      ]
      or
      [  if ScanFor(Scom,"else") do
               CopyUntil(Scom,Srem,"then")
      ]
   ]
]T

and ScanFor(s,str) = valof
//scan, discarding, up to and including str plus delimeter
//Ignore occurrences within braces
[C
   let unstrU=vec 256
   and unstrL=vec 256
   and found=0
   and ch=0
   and len=UnPackUL(str,unstrU,unstrL)
	depth=0
// scan for str
   [  while depth ne 0 do
	   [ if Endofs(s) resultis false
	     AccountGets(s)
	   ]
	   found=true
      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
]C

and CopyUntil(s,s2,str) be
//Copy from s to s2 up to and discarding str plus delimiter
//Ignore occurrences within braces
[C
   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)
	depth=0
//scan for str
   [  while depth ne 0 do
	   [ if Endofs(s) return
	     ch = AccountPuts(s2,Gets(s))
	   ]
	   index=-1
      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)
         return
      ]
      or  //output matched chars followed by unmatched one
      [  for i=1 to index-1 do Puts(s2,strbuf!i)	//not braces
         AccountPuts(s2,ch)
      ]
// scan for next delimiter
      until WhiteSpace(ch) do
      [  if Endofs(s) return
         ch = Gets(s)
         AccountPuts(s2,ch)
      ]
   ] repeat
]C

and UnPackUL(str,strU,strL) = valof //Unpack into upper and lower case versions. Returns length
[UP
   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; ]
      or
      [  strU!i = str>>STRING.char^i
         strL!i = strU!i
      ] 
   ]
   resultis len
]UP

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

and AccountPuts(s,ch) = valof
//Put ch on s if not an outermost brace, and adjust depth
[AC
	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
]AC

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
[MIS
   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
   Zero(buffer+1,63)
   nread = ReadBlock(S,buffer+1,63)
   [  Zero(buffer+64,63)
      nread=ReadBlock(S,buffer+64,63)
      if MatchKPMTemplate(buffer,tmplt) eq 0 do resultis true
       MoveBlock(buffer+1,buffer+64,63)
   ] repeatuntil nread ne 63
   resultis false
]MIS

and Abort(str) be
[C
   Wss(dsp,str);Puts(dsp,$*n)
// Should really ask for effective result of the if command to be typed in here and insert it into rem.cm
   finish
]C

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

and ReadString(Si,So,String,StringChar,EscapeChar) = valof
[Rt let ch=0
   and escape=false
   String>>STRING.length=0
   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
   [mainloop
      switchon ch into
      [ default: test escape % ch ne EscapeChar
                 then [ if So do Puts(So,ch)
                        unless StringChar(ch)%escape do break
                        String>>STRING.length=String>>STRING.length+1
                        String>>STRING.char^(String>>STRING.length)=ch
                        escape=false
                      ]
                 or escape=true
                 endcase
         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
                       ]
                     ]
                  endcase
         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
                  ]
                  EraseBits(So,-width)
                  endcase
      ]
      if MyEndofs(Si) do break
      ch=PromptGets(Si,So,escape?EscapeChar,$|)
   ]mainloop repeat
   resultis ch
]Rt

and ReadFileName(S,name) = valof
[RFN
   let ch=0
   ch=ReadString(S, S eq keys?dsp,0, name, Filechar, 0)
   DotInFileName=false
   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
]RFN
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
[readn
   let N=0
   doch=echoGets(S)
   while doch ge $0 & doch le $9 do
   [  N=N*10 + (doch-$0)
      doch=echoGets(S)
   ]
   resultis N
]readn

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)
]PG

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

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
[GFD
	let dv = vec lDV
	unless LookupFileName(name, dv) do
	[ Zero(time, lTIME)
	  return
	]
	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)
	    endcase
	  case $w: // read date
	  case $W:
		 MoveBlock(time, lv ld>>LD.written, lTIME)
		 endcase
	  case $c:
	  case $C:	// create
	    MoveBlock(time, lv ld>>LD.created, lTIME)
		 endcase
	  default: Abort("Switch error")
	]
]GFD(635)\f8 2474f0 9f8 183f0 2f8 66f0 1f8 83f0 9f8 6591f0 5f8 3f0 5f8 35f0 5f8 3f0 5f8 168f0 1f8 105f0 1f8 17f0 1f8 655f0 128f8 4146f0 10f8 173f0 11f8

and LookupFileName(name, dv) = valof
// Look up the dv of a file, return true if found.  Dv may be 0.
[LFN
	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)
	Closes(dirS)
	resultis ptr ne -1
]LFN