!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