"Beginning installation of lib-stackrng... @prog lib-stackrng 1 99999 d 1 i ( lib-stackrng: $Date: 2004/03/26 03:16:32 $ $Revision: 1.9 $ Originally from the FuzzBall MUF distribution ) ( --------------------------------------------------------------------------- ) ( ***** Stack based range handling object -- SRNG **** offset is how many stack items are between range and parms pos is the position within the range you wish to deal with. num is the number of range items to deal with. A 'range' is defines as a set of related items on the stack with an integer 'count' of them on the top. ie: "bat" "cat" "dog" 3 sr-extractrng[ {rng} ... offset num pos -- {rng'} ... {subrng} ] pulls a subrange out of a range buried in the stack, removing them. sr-copyrng [ {rng} ... offset num pos -- {rng} ... {rng} ] copies a subrange out of a range buried in the stack. sr-deleterng [ {rng} ... offset num pos -- {rng'} ] deletes a subrange from a range buried on the stack. sr-insertrng [ {rng1} ... {rng2} offset pos -- {rng} ] inserts a subrange into the middle of a buried range on the stack. sr-filterrng [ {rng} funcaddr -- {rng'} {filtrdrng} ] Takes the given range and tests each item with the given filter function address. The function takes a single data value and returns an integer. If the integer is non-zero, it pulls that data item out of the range and puts it into the filtered range. The data items can be of any type. sr-catrng [ {rng1} {rng2} -- {rng} ] concatenates two ranges into one range. sr-poprng [ {rng} -- ] removes a range from the stack. sr-swaprng [ {rng1} {rng2} -- {rng2} {rng1} ] takes two ranges on the stack and swaps them. ) ( --------------------------------------------------------------------------- ) ( $Log: lib-stackrng,v $ Revision 1.9 2004/03/26 03:16:32 feaelin Fixed bug with 'swaprange' where it didn't finish properly. Revision 1.8 2004/03/02 03:26:22 feaelin Fixed bugs in swaprng. It now works as advertised. Revision 1.7 2004/03/01 23:31:43 feaelin Fixed logic flaws in filterrange Revision 1.6 2004/03/01 16:58:26 feaelin Added SRNGxxx entries, so future uses can be more obvious. Revision 1.5 2001/02/23 16:18:39 feaelin Fixed incompatibility problem with older versions that have been upgraded Required adding a 'removal' of a definition to insure that a conflict between the stackrng def of popn didn't interfere with the inserver one. Revision 1.4 2000/01/10 18:53:35 feaelin Fixed documentation...not all lines were being listed. Revision 1.3 1998/07/28 19:22:05 glow Fixed _lib-version number. Revision 1.2 1998/07/28 19:21:11 glow Removed popoffn and replaced the definition of sr-poprng with it simply calling the inserver 'popn'. Revision 1.1 1998/07/28 19:18:38 glow Initial revision ) ( --------------------------------------------------------------------------- ) : catranges ( {rng1} {rng2} -- {rng} ) dup 2 + rotate + ; : copy-loop ( {rng} ... {rng2} offset num pos -- {rng} ... {rng} ) 4 pick 4 pick + 5 + pick over < 3 pick 1 < or if pop pop pop exit then ( {rng} ... {rng2} offset num pos ) 4 pick 4 pick + 5 + pick ( {rng} ... {rng2} offset num pos xc) 5 pick + 4 pick + 6 + over - pick ( {rng} ... {rng2} offset num pos xn) 5 rotate 1 + -5 rotate -5 rotate ( {rng} ... {rng2} offset num pos) 1 + swap 1 - swap 'copy-loop jmp ; : copyrange ( {rng} ... offset num pos -- {rng} ... {rng} ) 0 -4 rotate copy-loop ; : extract-loop ( {rng} ... {rng2} offset num pos -- {rng} ... {rng} ) 4 pick 4 pick + 6 + dup pick 3 pick < 4 pick 1 < or if pop pop pop pop exit then ( {rng} ... {rng2} offset num pos rot) dup pick over + 1 + 3 pick - rotate ( {rng} ... {rng2} offset num pos rot xn) swap dup 1 + rotate 1 - swap -1 * rotate ( {rng} ... {rng2} offset num pos xn) -5 rotate 4 rotate 1 + -4 rotate ( {rng} ... {rng2} offset num pos) swap 1 - swap 'extract-loop jmp ; : extractrange ( {rng} ... offset num pos -- {rng'} ... {subrng} ) 0 -4 rotate extract-loop ; : swapranges ( {rng1} {rng2} -- {rng2} {rng1} ) dup 1 + dup 2 + pick 1 extractrange dup dup 3 + pick + 3 + rotate pop ; : deleterange ( {rng} ... offset num pos -- {rng'} ) extractrange popn ; : insertrange ( {rng1} ... {rng2} offset pos-- {rng} ) 3 pick not if pop pop pop exit then ( {rng1} ... {rng2} offset pos ) rot 1 - rot rot 4 rotate ( {rng1} ... {rng2} offset pos elem ) 4 pick 5 + 4 pick + dup 2 + dup rotate ( {rng1} ... {rng2} offset pos elem rot rots rng1c ) 1 + dup rot -1 * rotate + ( {rng1} ... {rng2} offset pos elem rot ) 3 pick - -1 * rotate ( {rng1} ... {rng2} offset pos ) 'insertrange jmp ; : filterrange-loop ( {rng} {rng2} funcaddr pnt -- {rng'} {rng2'} ) dup 0 = if pop pop exit then (If done, then clean up and exit) 3 pick over + 4 + pick (get the datum from the old range) 3 pick execute if (check to see if datum is to be filtered) 3 pick over + 4 + rotate (get data from old range) -4 rotate (out it in the new one) rot 1 + rot rot (Increment the new range counter) 3 pick 4 + pick 1 - (decrememnt the old range counter) 4 pick 4 + put (and put it back) then 1 - 'filterrange-loop jmp (repeat until done.) ; : filterrange ( {rng} funcaddr -- {rng'} {filtrdrng} ) 0 swap 3 pick filterrange-loop ; public catranges public extractrange public swapranges public copyrange public deleterange public insertrange public filterrange . c q @register lib-stackrng=lib/stackrng @register #me lib-stackrng=tmp/prog1 @set $tmp/prog1=L @set $tmp/prog1=M3 @set $tmp/prog1=/_defs/popn: @set $tmp/prog1=/_defs/sr-catrng:"$lib/stackrng" match "catranges" call @set $tmp/prog1=/_defs/sr-copyrng:"$lib/stackrng" match "copyrange" call @set $tmp/prog1=/_defs/sr-deleterng:"$lib/stackrng" match "deleterange" call @set $tmp/prog1=/_defs/sr-extractrng:"$lib/stackrng" match "extractrange" call @set $tmp/prog1=/_defs/sr-filterrng:"$lib/stackrng" match "filterrange" call @set $tmp/prog1=/_defs/sr-insertrng:"$lib/stackrng" match "insertrange" call @set $tmp/prog1=/_defs/sr-poprng:popn @set $tmp/prog1=/_defs/sr-swaprng:"$lib/stackrng" match "swapranges" call @set $tmp/prog1=/_defs/SRNGcatrng:"$lib/stackrng" match "catranges" call @set $tmp/prog1=/_defs/SRNGcopyrng:"$lib/stackrng" match "copyrange" call @set $tmp/prog1=/_defs/SRNGdeleterng:"$lib/stackrng" match "deleterange" call @set $tmp/prog1=/_defs/SRNGextractrng:"$lib/stackrng" match "extractrange" call @set $tmp/prog1=/_defs/SRNGfilterrng:"$lib/stackrng" match "filterrange" call @set $tmp/prog1=/_defs/SRNGinsertrng:"$lib/stackrng" match "insertrange" call @set $tmp/prog1=/_defs/SRNGpoprng:popn @set $tmp/prog1=/_defs/SRNGswaprng:"$lib/stackrng" match "swapranges" call @set $tmp/prog1=/_docs:@list $lib/stackrng=1-41 @set $tmp/prog1=/_/de:lib-stackrng: List lines 1-41 for documentation. @set $tmp/prog1=/_lib-version:FM$Revision: 1.9 $ "Installation of lib-stackrng completed