[Win32forth-cvs] win32forth/src/kernel fkernel.f,1.29,1.30

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth/src/kernel
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21554/src/kernel

Modified Files:
	fkernel.f 
Log Message:
NOOP-CHAIN-ADD-BEFORE added; same as NOOP-CHAIN-ADD but for reverse chains like BYE.

Index: fkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v
retrieving revision 1.29
retrieving revision 1.30
diff -C2 -d -r1.29 -r1.30
*** fkernel.f	13 May 2006 20:46:40 -0000	1.29
--- fkernel.f	21 May 2006 10:04:49 -0000	1.30
***************
*** 4491,4494 ****
--- 4491,4495 ----
  
  : new-chain     ( -- )
+ \ *G Create a new chain.
                  create 0 , ['] noop compile,
                  in-sys? if sys-chain-link else chain-link then
***************
*** 4497,4500 ****
--- 4498,4502 ----
  
  : new-sys-chain ( -- )
+ \ *G Create a new chain in the system space.
                  >system
                  new-chain
***************
*** 4502,4531 ****
                  ;
  
! |: ?sys-chain    ( chain_address cfa -- chain_address cfa )
                  over sys-addr? 0=             \ chain NOT in system space?
                  over sys-addr? and            \ and cfa in system space?
                  sys-warning? and              \ and we want warnings
!                 if
!                   WARN_SYSWORD WARNMSG
!                 then    ;
  
! : noop-chain-add ( chain_address -- addr )      \ add chain item,
!                                                 \ return addr of cfa added
                  begin   dup @
                  while   @
!                 repeat  here swap ! 0 , here ['] noop compile, ;
  
! : chain-add     ( chain_address -<word_to_add>- )   \ for normal forward chains
!                 ' ?sys-chain >r
!                 noop-chain-add
                  r> swap ! ;
  
! : chain-add-before ( chain_address -<word_to_add>- ) \ for reverse chains like BYE
                  ' ?sys-chain >r
!                 here over @ , r> , swap ! ;
  
  in-application
  
  : do-chain      ( chain_address -- )
                  begin   @ ?dup
                  while   dup>r           \ make sure stack is clean during
--- 4504,4551 ----
                  ;
  
! |: ?sys-chain   ( chain_address cfa -- chain_address cfa )
! \ Warn the user about adding a word in system-space to a chain in application space.
                  over sys-addr? 0=             \ chain NOT in system space?
                  over sys-addr? and            \ and cfa in system space?
                  sys-warning? and              \ and we want warnings
!                 if   WARN_SYSWORD WARNMSG
!                 then ;
  
! |: noop-compile ( -- addr )
!                 here ['] noop compile, ;
! 
! : noop-chain-add ( chain_address -- addr )
! \ *G Add chain item, return addr of cfa added.
! \ ** For normal forward chains.
                  begin   dup @
                  while   @
!                 repeat  here swap ! 0 ,
!                         noop-compile ;
  
! : chain-add     ( chain_address -<word_to_add>- )
! \ *G Add chain item.
! \ ** For normal forward chains.
!                 ' ?sys-chain >r         \ chain_addr    | cfa_of_word_to_add
!                 noop-chain-add          \ addr          | cfa
                  r> swap ! ;
  
! : noop-chain-add-before ( chain_address -- addr )
! \ *G Add chain item, return addr of cfa added.
! \ ** For reverse chains like BYE
!                 here over @ ,   \ compile current head-chain-item
!                 swap !          \ store the addr of this chain-item in the chain-head
!                 noop-compile ;
! 
! : chain-add-before ( chain_address -<word_to_add>- )
! \ *G Add chain item
! \ ** For reverse chains like BYE
                  ' ?sys-chain >r
!                 noop-chain-add-before
!                 r> swap ! ;
  
  in-application
  
  : do-chain      ( chain_address -- )
+ \ *G Execute all words in a chain.
                  begin   @ ?dup
                  while   dup>r           \ make sure stack is clean during
***************
*** 4545,4551 ****
                  mov      0 [ebp], ecx \ save ecx for next time round
                  mov      eax, 4 [ecx] \ get the xt to execute
!                 xchg     esp, ebp      \ swap regs for call
                  call     callf        \ call the forth word there
!                 xchg     esp, ebp      \ swap regs for call
                  mov      ecx, 0 [ebp] \ restore ecx
                  mov      ecx, 0 [ecx] \ get next strand
--- 4565,4571 ----
                  mov      0 [ebp], ecx \ save ecx for next time round
                  mov      eax, 4 [ecx] \ get the xt to execute
!                 xchg     esp, ebp     \ swap regs for call
                  call     callf        \ call the forth word there
!                 xchg     esp, ebp     \ swap regs for call
                  mov      ecx, 0 [ebp] \ restore ecx
                  mov      ecx, 0 [ecx] \ get next strand
***************
*** 4562,4565 ****
--- 4582,4587 ----
                  >body here over @ , r> , swap ! ; \ add in to chain
  
+ \ ---------------------------------------------------------------------------
+ 
  : offset        ( n1 <-name-> -- )        \ compiling
                  ( n2 -- n3 )              \ runtime n3=n1+n2