xref  ipop
   xref  popnum
   xref  r.ipush
   xref  msg
   xref  reinterp
   xref  type_mismatch

   section one

   include  "ps.h"

   xdef  initloops



  DEF    exec
   bsr      ipop
   cmp.w    #ICode,D2
   bne      r.ipush
   move.l   D0,A0
   jmp      (A0)

  DEF    if
  ARG    ICode
   move.l   D0,-(SP)
  ARG    Boolean
   tst.l    D0
   bne      1$
   addq     #4,SP
1$ rts

  DEF    ifelse
  ARG    ICode
   move.l   D0,D1
  ARG    ICode
   move.l   D0,D3
  ARG    Boolean
   tst.l    D0
   bne      1$
   move.l   D1,A0
   jmp      (A0)
1$ move.l   D3,A0
   jmp      (A0)

  DEF    for
  ARG    ICode
   bsr      makeloop

   bsr      popnum
   move.l   D0,4(SP)   limit
   bsr      popnum
   move.l   D0,8(SP)   incr
   bsr      popnum
   move.l   D0,12(SP)  init

1$ move.l   12(SP),D0
   move.l   8(SP),D1
   move.l   4(SP),D2

   tst.l    D1
   bmi      2$
   cmp.l    D2,D0
   bra      3$
2$ cmp.l    D0,D2
3$ bgt      _exit

   move.w   #Integer,D2
   bsr      r.ipush

   add.l    D1,D0
   move.l   D0,12(SP)

   move.l   (SP),A0
   jsr      (A0)
   bra      1$

  DEF    repeat
  ARG    ICode
   bsr      makeloop
   bsr      popnum
1$ subq.l   #1,D0
   bmi      _exit
   move.l   D0,4(SP)
   move.l   (SP),A0
   jsr      (A0)
   move.l   4(SP),D0
   bra      1$

  DEF    loop
  ARG    ICode
   bsr      makeloop
1$ move.l   (SP),A0
   jsr      (A0)
   bra      1$

* stack while looping:
*  ret after loop
*  save exitsp           16(SP)
*  init                  12(SP) <- addr for looping proc
*  incr                   8(SP)
*  limit                  4(SP)
*  proc                    (SP)
*  ret for next repeat


  DEF    exit
   move.w   loops,D0
   beq      1$
   subq.w   #1,D0
   move.w   D0,loops
   move.l   exitsp,D0
   beq      1$               this should be impossible
   move.l   D0,SP
   move.l   (SP)+,exitsp
   rts
1$ ERR      no_loop

makeloop
   move.l   (SP)+,A0         ret address to loop requestor
   move.l   exitsp,-(SP)
   move.l   SP,exitsp        for possible call to _exit
   lea      -12(SP),SP       room for init, incr, limit
   move.l   D0,-(SP)         procedure to loop on
   move.w   loops,D0         note one more nesting level
   addq.w   #1,D0
   move.w   D0,loops
   jmp      (A0)             return

initloops
   moveq    #0,D0
   move.w   D0,loops
   move.l   D0,exitsp
   rts

loops    dc.w  0
exitsp   dc.l  0


  DEF    stop
   move.l   stopsave,D0
   beq      type_mismatch     change
   move.l   D0,SP
   rts

  DEF    stopped
  ARG    ICode
   pea      ..stop
   move.l   SP,stopsave
   move.l   D0,A0
   jsr      (A0)
   addq.l   #4,SP
   moveq    #0,D0
  RETURN    Boolean

stopsave    dc.l  0

..stop
   moveq    #-1,D0
  RETURN    Boolean

  DEF    countexecstack
   move.w   #Integer,D2
   moveq    #0,D0
  RETURN    Integer

  DEF    execstack
   rts


  DEF    start
   rts


   bstr     no_loop,<exit outside loop>

   end