!Graham Toal - latest development version of SKIMPB 12/02/80 16.25

%const %integer true = 0, false = 1

%external %integer %fn %spec find(%integer flag, %integer %name ty, la)
%external %integer %array %spec a(1 : 500)

%external %integer %array %spec taglink(0 : 255)

%external %integer %array %spec tag(1 : 512)

%external %integer %array %spec link(1 : 512)

!-----------------------------------------------------------------------
%external %routine %spec expr(%integer exprp)
%external %integer %fn %spec cond(%integer condp, tlabel, flabel)
%external %string (7) %fn %spec s(%integer n)
%external %string (255) %fn %spec strint(%integer n, p)
%external %integer %fn %spec getwork
%external %routine %spec returnwork(%integer work)
%external %routine %spec clearwork
%external %integer %fn %spec newtag
%external %routine %spec pushtag(%integer ident, form, type, dim, level, rad)
%external %routine %spec poptags
%external %integer %fn %spec getlabel(%integer constp)
%external %routine %spec filllabel(%integer label)
%external %integer %fn %spec fillbranch(%integer label)
%external %routine %spec poplabels
%external %integer %fn %spec nextplabel
%external %routine %spec dump(%string (7) lab, op, reg, addr)
%external %routine %spec fault(%string (63) mess)
%external %string (255) %fn %spec name(%integer ident)
%external %routine %spec pushstart(%integer flag, plab)
%external %routine %spec popstart(%integer %name flag, plab)
%external %routine %spec findcontinue(%integer %name type, flag)
%external %routine %spec findexit(%integer %name type, flag)
%external %routine %spec popcycle(%integer %name type, lab)
%external %routine %spec clearstart
%external %integer %fn %spec enter
%external %routine %spec dumpreturn
%external %routine %spec proc(%integer procp)
%external %routine %spec array(%integer arrayp)
%external %routine %spec endofprog
!-----------------------------------------------------------------------
%external %integer %array nextrad(0 : 15)

%external %string (5) %array display(0 : 15) = "Bug", "-2,X", "-4,X", %c
  "-6,X", "-8,X", "-10,X", "-12,X", "-14,X", "-16,X", "-18,X", "-20,X", %c
  "-22,X", "-24,X", "-26,X", "-28,X", "-30,X"

%external %integer level, nextcad = 1, pstr = 0
!-----------------------------------------------------------------------
%own %integer %array proctype(0 : 15)

%own %integer %array staticalloc(0 : 15)

%own %string (3) %array regs(1 : 2) = "A", "A,B"

%external %integer %array rt(0 : 15)

%external %integer %array parms(0 : 15)

%external %integer %spec traceopt, checkopt
%external %integer aopt = 0
!-----------------------------------------------------------------------
%external %routine statement(%integer statementp)
   %own %integer access = 1
   %routine %spec doloop(%integer loopsp)
   %routine %spec instr(%integer instrp)
   %string (4) base, b1, b2
   %switch sttype(1:13)
   %integer condp, instrp, elsep, constp, arrayp, namep, namesp, expr1p, %c
     expr2p, instr2p, tlabel, flabel, label, fplabel, tplabel, work1, work2, %c
     flag, plabel, procp, formalp, formp, params, procid, ident, form, paramt, %c
     paraml, dim, basep, type, cyclab, cntlab, extlab
   -> sttype(a(statementp))
   !-----------------------------------------------------------------------
sttype(1): 
   ! <instr><CYCLAUSE>
   %if access = 0 %then fault("ACCESS?") %and access = 1
   dump("", "SWI", "3", "") %if traceopt = 1
   %unless a(a(a(statementp + 2) + 1)) = 2 %then doloop(a(statementp + 2))
   instr(a(statementp + 1))
   %if a(a(a(statementp + 2) + 1)) = 2 %then %return
   %if access = 0 %then fault("DUBIOUS STATEMENT") %and access = 1
   condp = a(a(a(statementp + 2) + 1) + 1)
   a(1) = 1
   a(2) = 3
   %if a(a(statementp + 2)) <= 2 %then a(3) = 2 %else a(3) = 1
   statementp = 1
   -> untilst
   !-----------------------------------------------------------------------
sttype(2): 
   ! "IF"<cond>"THEN"<instr><else>
   condp = a(statementp + 1)
   instrp = a(statementp + 2)
   elsep = a(statementp + 3)
   %if access = 0 %then fault("ACCESS?") %and access = 1
   dump("", "SWI", "3", "") %if traceopt = 1
   %if 7 <= a(instrp) <= 8 %or a(instrp) = 2 %then %start
      ! branch
      %if a(instrp) = 7 %then findcontinue(type, tlabel) %c
      %else %if a(instrp) = 8 %then findexit(type, tlabel) %else %start
         constp = a(instrp + 1)
         tlabel = getlabel(constp)
      %finish
      %if a(elsep) = 2 %then filllabel(cond(condp, tlabel, -1)) %else %start
         instrp = a(elsep + 1)
         %if 7 <= a(instrp) <= 8 %or a(instrp) = 2 %then %start
            ! branch
            %if a(instrp) = 7 %then findcontinue(type, flabel) %c
            %else %if a(instrp) = 8 %then findexit(type, flabel) %else %start
               constp = a(instrp + 1)
               flabel = getlabel(constp)
            %finish
            access = 0
            filllabel(cond(condp, tlabel, flabel))
            dump("", "LBRA", "", "L" . s(flabel))
            %return
         %finish %else %start
            filllabel(cond(condp, tlabel, -1))
            %if a(instrp) = 3 %then pushstart(1, -1) %else instr(instrp)
         %finish
      %finish
   %finish %else %start
      %if a(elsep) = 2 %then %start
         fplabel = cond(condp, -1, -1)
         %if a(instrp) = 3 %then pushstart(0, fplabel) %else instr(instrp) %and filllabel(fplabel)
      %finish %else %start
         instr2p = a(elsep + 1)
         %if 7 <= a(instr2p) <= 8 %or a(instr2p) = 2 %then %start
            ! branch
            %if a(instr2p) = 7 %then findcontinue(type, flabel) %c
            %else %if a(instr2p) = 8 %then findexit(type, flabel) %else %start
               constp = a(instr2p + 1)
               flabel = getlabel(constp)
            %finish
            fplabel = cond(condp, -1, flabel)
            ! result always -1
            instr(instrp)
         %finish %else %start
            fplabel = cond(condp, -1, -1)
            instr(instrp)
            tplabel = nextplabel
            dump("", "LBRA", "", "L" . s(tplabel))
            filllabel(fplabel)
            %if a(instr2p) = 3 %then pushstart(1, tplabel) %c
            %else instr(instr2p) %and filllabel(tplabel)
         %finish
      %finish
   %finish
   access = 1
   %return
   !-----------------------------------------------------------------------
sttype(3): 
   ! <const>':'<statement>
   access = 1
   constp = a(statementp + 1)
   statementp = a(statementp + 2)
   label = getlabel(constp)
   filllabel(label)
   statement(statementp)
   %return
   !-----------------------------------------------------------------------
sttype(4): 
   ! "FINISH"<else>
   access = 1
   elsep = a(statementp + 1)
   popstart(flag, plabel)
   %if flag = 0 %then %start
      ! first %start/%finish
      %if a(elsep) = 1 %then %start
         instrp = a(elsep + 1)
         tplabel = nextplabel
         dump("", "LBRA", "", "L" . s(tplabel))
         filllabel(plabel)
         %if a(instrp) = 3 %then pushstart(1, tplabel) %c
         %else instr(instrp) %and filllabel(tplabel)
      %finish %else filllabel(plabel)
   %finish %else %start
      ! second %start/%finish
      %if a(elsep) = 1 %then fault("SPURIOUS %ELSE") %else filllabel(plabel)
   %finish
   %return
   !-----------------------------------------------------------------------
sttype(5): 
   ! "INTEGER"<array>
   arrayp = a(statementp + 1)
   namep = a(arrayp + 1)
   namesp = a(arrayp + 2)
   %if a(arrayp) = 1 %then %start
      ! array declaration
      dump("", "SWI", "3", "") %if traceopt = 1
      %if access = 0 %then fault("ACCESS?") %and access = 1
      %if find(2, cyclab, type) = true %then fault("ORDER?")
      %if level = 1 %then base = ",X" %else base = ",Y"
      %cycle 
         expr1p = a(arrayp + 3)
         expr2p = a(arrayp + 4)
         expr(expr1p)
         dump("", "SEX", "", "")
         dump("", "PSH", "U", "A,B")
         work1 = getwork
         !***dump("STR","ACC",display(level),work1)
         expr(expr2p)
         dump("", "SEX", "", "")
         dump("", "ADD", "D", "#1")
         dump("", "PSH", "U", "A,B")
         dump("", "TFR", "", "S,D")
         !***dump("LDA","ACC","ACC",1)
         work2 = getwork
         !***dump("STR","ACC",display(level),work2)
         %cycle 
            staticalloc(level) = staticalloc(level) + 2
            nextrad(level) = nextrad(level) + 2
            pushtag(a(namep + 1), 2, 1, 2, level, nextrad(level))
            dump("", "SUB", "D", "0,U")
            dump("", "ST", "D", "-" . s(nextrad(level)) . base)
            dump("", "ADD", "D", "2,U")
            !        DUMP("","SUB","D","#1")
            !***dump("SUB","STP",display(level),work1)
            !***dump("STR","STP",display(level),nextrad(level))
            !***dump("ADD","STP",display(level),work2)
            %if a(namesp) = 2 %then %exit
            namep = a(namesp + 1)
            namesp = a(namesp + 2)
         %repeat
         dump("", "TFR", "", "D,S")
         dump("", "LEA", "U", "4,U")
         returnwork(work1)
         returnwork(work2)
         %if a(a(arrayp + 5)) = 1 %then %start
            arrayp = a(arrayp + 5)
            namep = a(arrayp + 1)
            namesp = a(arrayp + 2)
            %continue
         %finish %else %return
      %repeat
   %finish %else %start
      %cycle 
         staticalloc(level) = staticalloc(level) + 1
         nextrad(level) = nextrad(level) + 1
         pushtag(a(namep + 1), 0, 1, 1, level, nextrad(level))
         %if a(namesp) = 2 %then %exit
         namep = a(namesp + 1)
         namesp = a(namesp + 2)
      %repeat
   %finish
   %return
   !-----------------------------------------------------------------------
sttype(6): 
   ! <proc><name><formal>
   %if level = 0 %then fault("PROCEDURE BEFORE %BEGIN")
   %if level = 15 %then fault("PROCEDURE NESTING TOO DEEP")
   access = 1
   procp = a(statementp + 1)
   namep = a(statementp + 2)
   formalp = a(statementp + 3)
   procid = a(namep + 1)
   !  skipproc(level)=nextcad
   pushtag(procid, 4, a(procp) - 1, 0, level, nextcad)
   level = level + 1
   rt(level) = tag(taglink(procid)) & 16_FFFF
   dump("", "LBRA", "", "S" . s(rt(level)))
   dump("E" . s(rt(level)), "EQU", "", "*")
   proctype(level) = a(procp)
   staticalloc(level) = enter
   !  nextrad(level)=2
   parms(level) = 0
   %if a(formalp) = 2 %then -> retn
   ! no parameters
   params = 0
   paraml = taglink(procid)
   %cycle 
      formp = a(formalp + 1)
      namep = a(formalp + 2)
      namesp = a(formalp + 3)
      formalp = a(formalp + 4)
      %if a(formp) = 1 %then form = 3 %and dim = 2 %else %start
         %if a(formp) = 2 %then form = 1 %and dim = 2 %c
         %else form = 0 %and dim = 1
      %finish
      %cycle 
         ident = a(namep + 1)
         ! declare parameters as locals
         nextrad(level) = nextrad(level) + dim
         staticalloc(level) = staticalloc(level) + dim
         pushtag(ident, form, 1, dim, level, nextrad(level))
         !      DUMP("","PUL","U",REGS(DIM))
         !      DUMP("","PSH","S",REGS(DIM))
         ! append parameter tag cells to procedure tag cell
         paramt = newtag
         tag(paramt) = tag(taglink(ident))
         link(paramt) = link(paraml)
         link(paraml) = paramt
         paraml = paramt
         parms(level) = parms(level) + dim
         params = params + 1
         %if params > 15 %then fault(name(procid) . " HAS TOO MANY PARAMETERS") %and %stop
         %if a(namesp) = 2 %then %exit
         namep = a(namesp + 1)
         namesp = a(namesp + 2)
      %repeat
   %repeat %until a(formalp) = 2
   ! insert number of parameters into tag cell
   tag(taglink(procid)) = tag(taglink(procid)) ! params << 20
retn: 
   dump("", "LEA", "S", "-A" . s(rt(level)) . ",S")
   %return
   !-----------------------------------------------------------------------
sttype(7): 
   ! "END"<ofprog>
   %if level > 1 %start
      !     DUMP("P".S(RT(LEVEL)),"EQU","",S(PARMS(LEVEL)))
      %if proctype(level) # 1 %and checkopt = 1 %then dump("", "SWI", "", "")
      !  %RESULT NOT ENCOUNTERED
      !     DUMP("R".S(RT(LEVEL)),"EQU","","*")
   %finish
   poptags
   poplabels
   clearstart
   clearwork
   dump("A" . s(rt(level)), "EQU", "", s(staticalloc(level)))
   %if proctype(level) >= 1 %and access = 1 %then dumpreturn
   access = 1
   level = level - 1
   %if a(a(statementp + 1)) = 2 %then %start
      ! %end
      %if level <= 0 %then fault("SPURIOUS %END") %and endofprog
      dump("S" . s(rt(level + 1)), "EQU", "", "*")
   %finish %else %start
      ! %endofprogram
      %if level # 0 %then fault("TOO FEW %ENDS")
      endofprog
   %finish
   %return
   !-----------------------------------------------------------------------
sttype(8): 
   ! "BEGIN"
   %if level # 0 %then fault("SPURIOUS %BEGIN") %else %start
      rt(1) = 0
      level = 1
      proctype(1) = 0
      staticalloc(1) = enter
      nextrad(1) = staticalloc(1)
   %finish
   %return
sttype(9): 
   ! <LOOPS>%CYCLE
   %if access = 0 %then fault("WARNING - ACCESS???") %and access = 1
   dump("", "SWI", "3", "") %if traceopt = 1
   doloop(a(statementp + 1))
   %return
sttype(10): 
   ! %REPEAT<UNTIL>
   condp = a(a(statementp + 1) + 1)
   dump("", "SWI", "3", "") %if traceopt = 1
untilst: 
   access = 1
   popcycle(type, cyclab)
   cntlab = cyclab + 1
   extlab = cntlab + 1
   %if a(a(statementp + 1)) # 2 %then %start
      dump("L" . s(cntlab), "EQU", "", "*")
      tplabel = cond(condp, -1, cyclab)
      %if type = 2 %then dump("L" . s(extlab), "LEA", "U", "4,U") %c
      %else dump("L" . s(extlab), "EQU", "", "*")
   %finish %else %start
      dump("L" . s(cntlab), "LBRA", "", "L" . s(cyclab))
      %if type = 2 %then dump("L" . s(extlab), "LEA", "U", "4,U") %c
      %else dump("L" . s(extlab), "EQU", "", "*")
   %finish
   %return
sttype(13): 
   ! "PRINTTEXT" <STRING>
   pstr = 1
   fault("ACCESS?") %and access = 1 %if access = 0
   dump("", "SWI", "3", "") %if traceopt = 1
   dump("", "LBSR", "", "PSTR")
   printstring("          FCB       ")
   work1 = 4
   %cycle 
      work2 = a(work1)
      %if work2 # 16_80 %then write(work2, 0) %else printstring("$80") %and %exit
      printsymbol(',')
      work1 = work1 + 1
   %repeat
   newline
   %return
sttype(11): 
   ! "CONSTANT" <NAME) '=' <VALUE>
   dump(name(a(a(statementp + 1) + 1)), "EQU", "", s(a(a(statementp + 2) + 1)))
   %return
sttype(12): 
   ! "LABEL" <NAME>
   dump(name(a(a(statementp + 1) + 1)), "EQU", "", "*")
   %return
   !-----------------------------------------------------------------------
   %routine instr(%integer instrp)
      %switch instype(1:14)
      %string (4) base
      %integer namep, assignp, constp, ident, actualp, exprp, nametag, %c
        disp, work, rinstrp, type, lab
      -> instype(a(instrp))
      !-----------------------------------------------------------------------
instype(1): 
      ! <name><actual><assign>
      namep = a(instrp + 1)
      actualp = a(instrp + 2)
      assignp = a(instrp + 3)
      rinstrp = a(instrp + 4)
      ident = a(namep + 1)
      !?  %if taglink(ident)=0 %then fault(name(ident)." NOT DECLARED") !?    %and %return
      %if taglink(ident) = 0 %start
         %if a(assignp) # 1 %then dump("", "FDB", "", name(ident)) %c
         %else expr(a(assignp + 1)) %and dump("", "ST", "B", name(ident))
      %finish %else %start
         nametag = tag(taglink(ident))
         ! %ROUTINE GET NAME ADDRESS ????
         %if a(assignp) = 1 %then %start
            %if nametag >> 28 = 4 %then fault(name(ident) . " NOT A DESTINATION") %and %return
            exprp = a(assignp + 1)
            %if nametag >> 28 >= 2 %then %start
               ! array variable
               expr(exprp)
               work = getwork
               dump("", "PSH", "U", "B")
               array(instrp)
               dump("", "PUL", "U", "B")
               dump("", "ST", "B", "[0,X]")
               returnwork(work)
            %finish %else %start
               expr(exprp)
               basep = nametag >> 16 & 16_F
               disp = nametag & 16_FFFF
               base = display(basep)
               base = ",Y" %if basep = level
               base = ",X" %if basep = 1
               %if basep = level %or basep = 1 %start
                  %if nametag >> 28 = 1 %then b1 = "[" %and b2 = "]" %else b1 = "" %and b2 = ""
                  dump("", "ST", "B", b1 . "-" . s(disp) . base . b2)
               %finish %else %start
                  dump("", "PSH", "U", "A,B")
                  dump("", "LD", "D", base)
                  dump("", "SUB", "D", "#" . s(disp))
                  dump("", "ST", "D", "0,X")
                  %if nametag >> 28 = 1 %then %start
                     dump("", "LD", "D", "[0,X]")
                     dump("", "ST", "D", "0,X")
                  %finish
                  dump("", "PUL", "U", "A,B")
                  dump("", "ST", "B", "[0,X]")
               %finish
               %if a(actualp) = 1 %then fault(name(ident) . " DECLARED AS SCALAR")
            %finish
            ! %END OF ROUTINE GET NAME ADDRESS???
         %finish %else %start
            %if nametag >> 28 = 4 %and nametag >> 24 & 16_F = 0 %c
            %then proc(instrp) %else fault(name(ident) . " NOT A ROUTINE NAME")
         %finish
      %finish
      %if a(rinstrp) = 1 %then instrp = a(rinstrp + 1) %and -> instype(a(instrp))
      %return
      !-----------------------------------------------------------------------
instype(2): 
      ! '->'<const>
      access = 0
      constp = a(instrp + 1)
      label = getlabel(constp)
      dump("", "LBRA", "", "L" . s(label))
      %return
      !-----------------------------------------------------------------------
instype(3): 
      ! "START"
      fault("ILLEGAL %START")
      %return
      !-----------------------------------------------------------------------
instype(4): 
      ! "RETURN"
      %if proctype(level) # 1 %then fault("%RETURN OUT OF CONTEXT")
      access = 0
      dumpreturn
      !  DUMP("","LBRA","","R".S(RT(LEVEL)))
      %return
      !-----------------------------------------------------------------------
instype(5): 
      ! "RESULT"'='<expr>
      %if proctype(level) # 2 %then fault("%RESULT OUT OF CONTEXT")
      access = 0
      expr(a(instrp + 1))
      dumpreturn
      !  DUMP("","LBRA","","R".S(RT(LEVEL)))
      %return
      !-----------------------------------------------------------------------
instype(6): 
      ! "STOP"
      access = 0
      dump("", "SWI", "2", "")
      !  CALL MONITOR AND HALT?
      %return
instype(7): 
      access = 0
      findcontinue(type, lab)
      dump("", "LBRA", "", "L" . s(lab))
      %return
instype(8): 
      access = 0
      findexit(type, lab)
      dump("", "LBRA", "", "L" . s(lab))
      %return
instype(9): 
      !    <OPCODE> # <CONST>
      dump("", name(a(a(instrp + 1) + 1)), "", "#" . s(a(a(instrp + 2) + 1)))
      %return
instype(10): 
      !    <OPCODE>   <CONST>
      dump("", name(a(a(instrp + 1) + 1)), "", s(a(a(instrp + 2) + 1)))
      %return
instype(11): 
      !    <OPCODE> # <NAME>
      namep = a(instrp + 2)
      ident = a(namep + 1)
      dump("", name(a(a(instrp + 1) + 1)), "", "#" . name(ident))
      %return
instype(12): 
      !    <OPCODE>   <NAME>
      namep = a(instrp + 2)
      ident = a(namep + 1)
      nametag = tag(taglink(ident)) %if taglink(ident) # 0
      %if taglink(ident) = 0 %or nametag >> 28 = 4 %start
         dump("", name(a(a(instrp + 1) + 1)), "", name(ident))
      %finish %else %start
         basep = nametag >> 16 & 15
         disp = nametag & 16_FFFF
         base = display(basep)
         base = ",Y" %if basep = level
         base = ",X" %if basep = 1
         b1 = ""
         b2 = ""
         b1 = "[" %and b2 = "]" %if nametag >> 28 = 1
         dump("", name(a(a(instrp + 1) + 1)), "", b1 . "-" . s(disp) . base . b2)
      %finish
      %return
instype(13): 
      !     <OPCODE>   <STRING>
      %begin
         %string (255) addr
         %integer i, sym
         addr = ""
         i = 10
         %cycle 
            sym = a(i)
            i = i + 1
            %exit %if sym = 128
            addr = addr . tostring(sym)
         %repeat
         dump("", name(a(a(instrp + 1) + 1)), "", addr)
      %end
      %return
instype(14): 
      !    <OPCODE>
      dump("", name(a(a(instrp + 1) + 1)), "", "")
      %return
   %end
   %routine doloop(%integer loopsp)
      %integer type, cyclab, cntlab, extlab, namep, actualp, forp, %c
        initp, incrp, finalp, tplabel, condp, whilep, disp, nametag
      %string (7) base, reg
      %switch cycle(1:3)
      %if a(loopsp) = 1 %then type = 2 %else type = 3
      cyclab = nextplabel
      cntlab = nextplabel
      extlab = nextplabel
      pushstart(type, cyclab)
      -> cycle(a(loopsp))
cycle(1): 
      !FOR
      forp = a(loopsp + 1)
      namep = a(forp + 1)
      actualp = a(forp + 2)
      initp = a(forp + 3)
      incrp = a(forp + 4)
      finalp = a(forp + 5)
      ident = a(namep + 1)
      reg = "D"
      !?      %if taglink(ident)=0 %then fault(name(ident)." NOT DECLARED") %andreturn
      %if taglink(ident) = 0 %then %start
         dump("", "LD", "D", "#" . name(ident))
      %finish %else %start
         nametag = tag(taglink(ident))
         %if nametag >> 28 = 4 %then %start
            fault("NOT A DESTINATION")
            %return
         %finish
         %if nametag >> 28 = 2 %start
            aopt = 1
            array(forp)
         %finish %else %start
            basep = nametag >> 16 & 16_F
            base = display(basep)
            disp = nametag & 16_FFFF
            base = "Y" %if basep = level
            base = "X" %if basep = 1
            %if nametag >> 28 = 1 %then %start
               %if 1 < basep < level %then %start
                  dump("", "LD", "D", base)
                  dump("", "SUB", "D", "#" . s(disp))
                  dump("", "ST", "D", "0,X")
                  dump("", "LD", "D", "[0,X]")
               %finish %else %start
                  dump("", "LD", "D", "-" . s(disp) . "," . base)
               %finish
            %finish %else %start
               %if 1 < basep < level %then %start
                  dump("", "LD", "D", base)
                  dump("", "SUB", "D", "#" . s(disp))
               %finish %else %start
                  %if basep = 1 = level %then %start
                     dump("", "LEA", "Y", "-" . s(disp) . ",X")
                     reg = "Y"
                  %finish %else %start
                     dump("", "TFR", "", base . ",D")
                     dump("", "SUB", "D", "#" . s(disp))
                  %finish
               %finish
               %if a(actualp) = 1 %then fault(name(ident) . " DECLARED AS SCALAR")
            %finish
         %finish
      %finish
      dump("", "PSH", "U", reg)
      expr(finalp)
      dump("", "PSH", "U", "B")
      expr(incrp)
      dump("", "PSH", "U", "B")
      expr(initp)
      dump("", "SUB", "B", ",U")
      dump("", "ST", "B", "[2,U]")
      dump("L" . s(cyclab), "EQU", "", "*")
      dump("", "LD", "B", "[2,U]")
      dump("", "CMP", "B", "1,U")
      dump("", "LBEQ", "", "L" . s(extlab))
      dump("", "ADD", "B", ",U")
      dump("", "ST", "B", "[2,U]")
      %return
      cycle(*):

      dump("L" . s(cyclab), "EQU", "", "*")
      %return %if a(loopsp) # 2
      whilep = a(loopsp + 1)
      condp = a(whilep + 1)
      tplabel = cond(condp, -1, extlab)
   %end
%end
%end %of %file