!Graham Toal - latest development version of SKIMPC 23/01/80 16.41
external integer array spec a(1 : 500)

external integer spec condopt
!-----------------------------------------------------------------------
external routine spec expr(integer exprp)
external routine spec dump(string (7) lab, op, reg, addr)
external routine spec filllabel(integer label)
external integer fn spec fillbranch(integer label)
external integer fn spec nextplabel
external routine spec fault(string (63) mess)
external string (7) fn spec s(integer i)
!-----------------------------------------------------------------------
external integer condflag = 0
!-----------------------------------------------------------------------
external integer fn cond(integer condp, tlabel, flabel)
   routine spec processcond(integer condp)
   routine spec test(integer ltestp)
   routine spec condrest(integer condrestp)
   routine spec store(integer testp, level, andor)
   routine spec show(string (7) an, integer array name a, integer p)
   const string (4) array true(1 : 6) = c
     "LBEQ", "LBNE", "LBLE", "LBLT", "LBGE", "LBGT"

   const string (4) array false(1 : 6) = c
     "LBNE", "LBEQ", "LBGT", "LBGE", "LBLT", "LBLE"

   string (4) opn
   const integer array index(1 : 17) = c
     1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17

   integer array testpa, levela, andora, brancha(1 : 16), labela(1 : 17)
   integer p, pp, ppp, testp, level, andor, comp
   level = 0
   p = 1
   processcond(condp)
   store(testp, -1, 1)
   ! pseudo-%and
   store(0, -2, 2)
   ! pseudo-%or
   p = p - 2
   for pp = 1, 1, p cycle
      ! find branch destinations
      level = levela(pp)
      andor = andora(pp)
      for ppp = pp + 1, 1, p + 1 cycle
         if levela(ppp) < level then start
            level = levela(ppp)
            if andora(ppp) # andor then exit
         finish
      repeat
      brancha(pp) = ppp + 1
   repeat
   if tlabel >= 0 then start
      andora(p) = 2
      ! change last branch to branch on true
      brancha(p) = p + 1
      labela(p + 1) = tlabel
   finish
   labela(p + 2) = flabel
   for pp = 1, 1, p cycle
      ! assign private labels where needed
      if labela(brancha(pp)) < 0 then labela(brancha(pp)) = nextplabel
   repeat
   if condopt = 1 then start
      newline
      show("      ", index, p + 2)
      show("TESTP ", testpa, p)
      show("LEVEL ", levela, p + 1)
      show("ANDOR ", andora, p + 1)
      show("BRANCH", brancha, p)
      show("LABEL ", labela, p + 2)
      newline
   finish
   for pp = 1, 1, p cycle
      ! generate test code and fill labels
      if labela(pp) >= 0 then filllabel(labela(pp))
      condflag = 1
      expr(testpa(pp))
      comp = a(a(testpa(pp) + 2))
      if andora(pp) = 1 then opn = false(comp) else opn = true(comp)
      dump("", opn, "", "L" . s(labela(brancha(pp))))
   repeat
   if labela(p + 1) >= 0 and tlabel < 0 then filllabel(labela(p + 1))
   if flabel >= 0 then result = -1 else result = labela(p + 2)
   !-----------------------------------------------------------------------
   routine processcond(integer condp)
      test(a(condp + 1))
      condrest(a(condp + 2))
   end
   !-----------------------------------------------------------------------
   routine test(integer ltestp)
      if a(ltestp) = 1 then testp = ltestp c
      else level = level + 1 and processcond(a(ltestp + 1)) and level = level - 1
   end
   !-----------------------------------------------------------------------
   routine condrest(integer condrestp)
      integer andor
      andor = a(condrestp)
      unless andor = 3 then start
         store(testp, level, andor) and test(a(condrestp + 1)) and c
           condrestp = a(condrestp + 2) until a(condrestp) = 2
      finish
   end
   !-----------------------------------------------------------------------
   routine store(integer testp, level, andor)
      if p > 16 then fault("CONDITION TOO LONG") and stop
      testpa(p) = testp
      levela(p) = level
      andora(p) = andor
      labela(p) = -1
      p = p + 1
   end
   !-----------------------------------------------------------------------
   routine show(string (7) an, integer array name a, integer p)
      integer pp
      printstring(an . "  ")
      for pp = 1, 1, p cycle
         write(a(pp), 5)
      repeat
      newline
   end
end
end of file