[Win32forth-cvs] win32forth/src/kernel fkernel.f,1.74,1.75

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/src/kernel
In directory vz-cvs-4.sog:/tmp/cvs-serv8115

Modified Files:
	fkernel.f 
Log Message:
Jos Added chain-remove

Index: fkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v
retrieving revision 1.74
retrieving revision 1.75
diff -C2 -d -r1.74 -r1.75
*** fkernel.f	11 Jul 2011 18:50:40 -0000	1.74
--- fkernel.f	13 Jul 2011 11:52:26 -0000	1.75
***************
*** 4701,4704 ****
--- 4701,4715 ----
                  r> swap ! ;
  
+ : chain-remove      ( cfa chain_address -- )
+ \ *G Remove the specified item from the chain.
+         begin   ( cfa link^ )
+                 dup @
+         while   ( cfa link^ )
+                2dup @ CELL+ @  =
+                 if    dup @  @ over  !  \ Delete chain member
+                 else    @               \ Retain chain member
+                 then
+         repeat  2drop ;
+ 
  : noop-chain-add-before ( chain_address -- addr )
  \ *G Add chain item, return addr of cfa added.