refactor iterators to be pointers to a two-cell structure

iter.jrt

@@ -1,8 +1,10 @@
 ( iteration control stacks
   We create two new stacks - a small stack to hold the "current" value
   of the loop, or the "i" stack, and a larger stack to hold any extra 
-  state, as well as the cp of a word that moves to the next value, which
-  we call the "next" stack.
+  state, which we call the "next" stack. Typically the top of the next
+  stack would contain an "iterator" that knows how to advance to the next 
+  value and how to be cancelled, depending on the needs of the calling code.
+
   With these two new stacks, we can create a generic loop construct for
   iterating over streaming values. Not only that, but those values can be 
   arbitrarily filtered and transformed simply by pushing a new value onto
@@ -44,6 +46,7 @@ nexttop :peek nextpeek
 :ASM >r ( c -- )
   MOV BX @[ SS: r@ @]
   POP CX
+  SHL CX 1 #
   ADD BX CX
   MOV @[ SS: <r @] BX
   NEXT ; }
@@ -53,9 +56,7 @@ itop    :ndrop n-idrop
 nexttop :drop nextdrop
 nexttop :ndrop n-nextdrop
 
-: iterdrop ( ci cnext -- ) n-nextdrop n-idrop ;
-: finished ( -- 0 ) cancel 0 ;
-: finish? ( f -- f ) if 1 else finished then ;
+: iterdrop ( n-next -- ) n-nextdrop idrop ;
 
 { : :push ( pixp -- )
 :ASM >r
@@ -75,6 +76,8 @@ nexttop :push >next
 : i 0 ipeek ; : j 1 ipeek ;
 
 :asm n-<next ( n |n| args... -- args... |n| )
+  MOV AX SS
+  MOV ES AX
   POP CX
   JCXZ 2 @>
   MOV DI @[ SS: nexttop @]
@@ -95,6 +98,8 @@ nexttop :push >next
   NEXT
 
 :asm n->next ( args... n |n| -- |n| args... )
+  MOV AX SS
+  MOV ES AX
   POP CX
   JCXZ 1 @>
   MOV DI @[ SS: nexttop @]
@@ -109,26 +114,25 @@ nexttop :push >next
 1 <:
   NEXT
 
-( iterator words must have the following shape: )
-( -- xt-iter xt-cancel )
-( The xt-iter word must take care of updating the stacks directly. If 
+( iterators are pointers to an array containing two function pointers: 
+  xt-iter xt-cancel
+  The xt-iter word must take care of updating the stacks directly. If 
   there are no more values, it must remove the values from the i-stack, 
   drop itself from the next-stack, and return 0. "finished" and "finish?"
   are useful words to help with this.
 
   The xt-cancel word should remove all of the iterator's state from the
-  iteration stacks and return nothing. "iterdrop" is a useful word to help
-  with this. If the iterator is itself making use of an iterator below it
-  on the stack, the xt-cancel word should call "cancel" to recursively clean
-  that up once it's done.
+  iteration stacks and return nothing. "n-nextdrop" and "iterdrop" are useful 
+  words to help with this. If the iterator is itself making use of an 
+  iterator below it on the stack, the xt-cancel word should call "cancel" to 
+  recursively clean that up once it's done.
 
   Note that all "next" words _must_ be defined in the target Forth!
   This means that any iterator that dereferences near memory, such as "links",
   WILL NOT WORK on the host Forth! )
 
-: call-next ( -- xt-iter xt-cancel ) 0 nextpeek execute ;
-: iterate call-next drop execute ;
-: cancel call-next swap drop execute ;
+: iterate 0 nextpeek @ execute ;
+: cancel 0 nextpeek cell + @ execute ;
 
 : EACH_ <r iterate if cell + else @ then >r ;
 
@@ -141,40 +145,67 @@ nexttop :push >next
   :timm each t, EACH_ patchpt >i ;
   : CONTINUE t, GOTO_ i cell - w>t ;
   :timm continue CONTINUE ;
-  :timm next CONTINUE <i patch!t ; }
+  :timm next CONTINUE <i patch!t ; 
+  : iter, ( xt-iter xt-cancel -- iter ) target >i swap w>t w>t ; 
+  :timm >iter <i compilenum t, >next ; }
 
-: >cancel :| ' finished :| nextdrop cancel |; |; >next ;
-{ : break ' >cancel , ['] continue ; immediate            
+: finished ( -- 0 ) cancel 0 ;
+: finish? ( f -- f ) if 1 else finished then ;
+
+( n ) ' finished ( c ) :noname nextdrop cancel ; iter, : >cancel >iter ;
+
+{ : break ' >cancel , ['] continue ; immediate
   :timm break t, >cancel CONTINUE ; }
 
-: nothing :| ' 0 ' nextdrop |; >next ;
-: 1cancel 1 1 iterdrop ;
-: single >i :| nextdrop :| ' finished ' 1cancel |; >next 1 |; 
-                        ' 1cancel |; >next ;
-: times ( n -- ) >i :| :| <i dup 1- >i finish? |; ' 1cancel |; >next ;
-: links ( p -- ) dup 
-  if >i :| :| <i @ dup >i finish? |; ' 1cancel |; >next else nothing then ;
-: +for? ( n -- f ) <i + dup >i 1 nextpeek = finish? ;
-: for ( start lim -- ) 
-  >next 1- >i :| :| 1 +for? |; :| 1 2 iterdrop |; |; >next ;
-: for+ ( start lim inc -- )
-  >next >next 1 nextpeek - >i 
-  :| :| 2 nextpeek +for? |; :| 1 3 iterdrop |; |; >next ;
-: pchars ( st -- ) 1- >i 
-  :| :| <i 1+ dup >i b@ finished? |; ' 1cancel |; >next ;
+( n ) ' 0 ( c ) ' nextdrop iter, 
+: nothing >iter ;
+
+: 1cancel idrop nextdrop ; 
+
+( n ) ' finished ( c ) ' 1cancel iter, 
+( n ) :noname nextdrop 1 >iter ; ( c ) ' 1cancel iter, 
+: single >i >iter ;
+
+( n ) :noname <i dup 1- >i finish? ; ( c ) ' 1cancel iter,
+: times ( n -- ) >i >iter ;
+
+( n ) :noname <i @ dup >i finish? ; ( c ) ' 1cancel iter,
+: links ( p -- ) dup if >i >iter else nothing then ;
+
+: +for? ( n -- f ) <i + dup >i 1 nextpeek != finish? ;
+
+( n ) :noname 1 +for? ; ( c ) :noname 2 iterdrop ; iter,
+: for ( start lim -- ) >next 1- >i >iter ;
+
+( n ) :noname 2 nextpeek +for? ; ( c ) :noname 3 iterdrop ; iter,
+: for+ ( start lim inc -- ) >next >next 1 nextpeek - >i >iter ;
+
+( n ) :noname <i 1+ dup >i b@ finish? ; ( c ) ' 1cancel iter, 
+: pchars ( st -- ) 1- >i >iter ;
 
 : nth ( i -- v ) 0 each 2dup = if drop i break then 1+ next swap drop ;
 : count 0 each 1+ next ;
 
-:asm _suspend>args ( |n| |r| yieldpoint -- argcount |n| yieldpoint |r| )
-  DEC BP DEC BP
-  MOV DI @[ BP]
+:asm _suspend>args 
+( iter |r| yieldpoint -- argcount |r| yieldpoint iter )
+  MOV DI @[ -2 @+ BP]
+  POP @[ BP]
+  INC BP INC BP
   XOR AH AH
-  MOV AL @[ SS: DI]
+  MOV AL @[ DS: DI]
   PUSH AX
+  NEXT
+
+:asm 2r>next
   MOV BX @[ SS: nexttop @]
-  DEC BX DEC BX
-  MOV @[ SS: BX] DI
+  ( bp grows up. top: BP-2, second: BP-4
+    nexttop grows down. top: nexttop, second: nexttop+2 )
+  SUB BX 4 # ( make room for 2 more items on next stack )
+  MOV AX @[ -4 @+ BP]
+  MOV @[ SS: 2 @+ BX] AX
+  MOV AX @[ -2 @+ BP]
+  MOV @[ SS: BX] AX
+  SUB BP 4 # ( pop two off return stack )
   MOV @[ SS: nexttop @] BX
   NEXT
 
@@ -187,39 +218,62 @@ nexttop :push >next
   MOV AL @[ DS: DI]
   INC DI
   PUSH AX ( argcount )
-  MOV DI @[ BP]
+  MOV @[ BP] DI
   INC BP INC BP
   NEXT
 
 : _resume _resume>args n-<next rswap ;
-: _suspend rswap _suspend>args swap >r n->next <r >next ;
+: _suspend 
+  ( args... iter |r| yieldpoint ret -- 1 |r| ret |n| args... yieldpoint iter )
+  rswap _suspend>args n->next 2r>next 1 ;
 : _cancel _resume>args n-nextdrop rdrop ;
 
-: GENSTART_ <r >next :| :| _resume |; ' _cancel |; >next ;
+( n ) :noname _resume>args n-<next ; ( c ) ' _cancel iter,
+: GENSTART_ <r >next >iter ;
 
 ( yielding from a generator has three moving parts:
-  )
+  suspend: run immediately when the generator yields. takes care of updating
+           the i-stack appropriately, as well as potentially saving any
+           yield-specific state to the next-stack. After this runs, the 
+           generator's extra parameters are pushed to the next-stack, along
+           with the generator's "resume" pointer and the yielder's iterator.
+  resume: run when the generator is resumed by iterating. Before this runs,
+          the yielder will take care of placing the "resume" pointer back
+          on the stack and restoring the generator's arguments, so the
+          stack environments should match what they were when the suspension
+          happened. This deals with cleaning up after the yielder so the
+          rest of the generator can run.
+  cancel: run when the generator is aborted. Before this runs, the next-stack
+          is cleared of the "resume" pointer and all of the generator's
+          arguments. This should remove any yield-specific data from the
+          iteration stacks, and potentially call "cancel" to clean up the
+          iterator underneath if the yielder is intended to map or filter
+          another iterator. )
+
 { var gen-arg-count 
   :timm (( t:| t, GENSTART_ gen-arg-count @ >t ;
-  :timm )) t|; t, execute 0 gen-arg-count ! ;
+  :timm )) t, 0 t|; t, execute 0 gen-arg-count ! ;
   : +arg  1 gen-arg-count !+ ; :timm +arg +arg ;
   : -arg -1 gen-arg-count !+ ; :timm -arg -arg ;
   :timm >arg t, >next +arg ;
-  ( TODO: totally wrong now )
-  : :yield } create immediate target , startcolon 
-           does> @ w>t gen-arg-count @ >t ; }
+  : colonpair ( xt-first xt-second -- xt )
+    target <rot gencolon w>t swap w>t t, return ;
+  : :yield ( xt-suspend xt-resume xt-cancel -- )
+    } t' _cancel swap colonpair swap t' _resume swap colonpair
+    target >r w>t w>t gencolon w>t r@ compilenum t, _suspend t, return
+    create immediate <r 2 cells + , does> @ w>t gen-arg-count @ >t ; }
 
-: i>next <i >next >i ; : 2>i >i >i ; : 2idrop idrop idrop ;
+: shadow-i <i >next >i ; : 2>i >i >i ; : 2idrop idrop idrop ;
 : unmap idrop <next >i ; : mapcancel unmap cancel ;
-: unsuspend rdrop <r 1+ >r ; ( don't yield at all, skip past the yielder )
+: unsuspend rdrop rdrop <r 1+ >r ; ( don't yield at all, skip past the yielder )
 : suspend? not if unsuspend then ;
 
 (       suspend    resume      cancel )
-         ' noop    ' noop      ' noop :yield yield0
+         ' noop    ' noop      ' noop :yield yield0 [
            ' >i   ' idrop     ' idrop :yield yield
            ' >i      ' <i     ' idrop :yield yield>
           ' 2>i  ' 2idrop         dup :yield yield2
-       ' i>next   ' unmap ' mapcancel :yield map
+     ' shadow-i   ' unmap ' mapcancel :yield map
          ' noop    ' noop    ' cancel :yield pass
      ' suspend?    ' noop    ' cancel :yield filter
 

zipoff.jrt

@@ -102,7 +102,8 @@ s" coredefs.jrt" loadfile
 : t" t, INLINEDATA_ patchpt t", patch!t ;
 :timm s" state if t" else target t", then ;
 
-: startcolon t& $DOCOLON w>t ] ;
+: gencolon t& $DOCOLON w>t ;
+: startcolon gencolon ] ;
 : t:| t, INLINEDATA_ patchpt startcolon ;
 : t|; t, return patch!t ;
 :timm :| t:| ;