diff --git a/dialer.com b/dialer.com index 65bac37..de3c123 100755 Binary files a/dialer.com and b/dialer.com differ diff --git a/dialtest.com b/dialtest.com index 81a8352..3721f9d 100755 Binary files a/dialtest.com and b/dialtest.com differ diff --git a/iter.jrt b/iter.jrt index 9a5d972..931a058 100755 --- a/iter.jrt +++ b/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 @@ -75,6 +76,8 @@ nexttop :push >next : i 0 ipeek ; : j 1 ipeek ; :asm n- 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 ; @@ -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 swap w>t w>t ; + :timm >iter 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 finish? |; ' 1cancel |; >next ; -: links ( p -- ) dup - if >i :| :| i finish? |; ' 1cancel |; >next else nothing then ; -: +for? ( n -- f ) 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 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 finish? ; ( c ) ' 1cancel iter, +: times ( n -- ) >i >iter ; + +( n ) :noname i finish? ; ( c ) ' 1cancel iter, +: links ( p -- ) dup if >i >iter else nothing then ; + +: +for? ( n -- f ) 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 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-args swap >r n->next 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_ next :| :| _resume |; ' _cancel |; >next ; +( n ) :noname _resume>args n-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 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 @ w>t gen-arg-count @ >t ; } -: i>next next >i ; : 2>i >i >i ; : 2idrop idrop idrop ; +: shadow-i next >i ; : 2>i >i >i ; : 2idrop idrop idrop ; : unmap idrop i ; : mapcancel unmap cancel ; -: unsuspend rdrop r ; ( don't yield at all, skip past the yielder ) +: unsuspend rdrop rdrop 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 ' ' 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 diff --git a/swine.com b/swine.com index 4888b08..7e1d140 100755 Binary files a/swine.com and b/swine.com differ diff --git a/zipmin.com b/zipmin.com index 0dc80ee..0c6041a 100755 Binary files a/zipmin.com and b/zipmin.com differ diff --git a/zipoff.com b/zipoff.com index 114dc73..1f3ff3d 100755 Binary files a/zipoff.com and b/zipoff.com differ diff --git a/zipoff.jrt b/zipoff.jrt index ce53048..cb108b4 100755 --- a/zipoff.jrt +++ b/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:| ; diff --git a/zipstub.seg b/zipstub.seg index 71e0d4c..654385a 100755 Binary files a/zipstub.seg and b/zipstub.seg differ