[Win32forth-cvs] win32forth/src/kernel fkernel.f,1.98,1.99

[George H. <geo...@us...>]

Update of /cvsroot/win32forth/win32forth/src/kernel
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv28403

Modified Files:
	fkernel.f 
Log Message:
Added a variable to allow CREATE ...IMMEDIATE....DOES>... words to be put in system space w/o issuing warnings when new descendants are created.Modified DOES> and ;CODE to use latestxt.

Index: fkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v
retrieving revision 1.98
retrieving revision 1.99
diff -C2 -d -r1.98 -r1.99
*** fkernel.f	19 Nov 2013 16:31:44 -0000	1.98
--- fkernel.f	28 Nov 2013 19:28:18 -0000	1.99
***************
*** 4544,4557 ****
                  @ @ 0x00FFFFFF and 0xC1C790 = ;   \ nop  mov ecx, # ?; used in see and debugger
  
  in-application
  
  : (;CODE)       ( -- )
!                 R> @ LAST @ NAME> !  ;
  
  : (DOES>)       ( -- )
!                 LAST @ NAME> R> TUCK @ OVER !
!                 SYS-ADDR? 0= SWAP
!                 SYS-ADDR? AND SYS-WARNING? AND
!                 IF WARN_SYSWORD3 WARNMSG THEN ;
  
  : #(;CODE)      ( a1 -- )
--- 4544,4563 ----
                  @ @ 0x00FFFFFF and 0xC1C790 = ;   \ nop  mov ecx, # ?; used in see and debugger
  
+ variable suppress suppress off
+ 
+ : Sys-warn-does?  ( newcode destxt -- )
+                 suppress @ if suppress off 2drop else
+                 SYS-ADDR? 0= SWAP
+                 SYS-ADDR? AND SYS-WARNING? AND
+                 IF WARN_SYSWORD3 WARNMSG THEN then ;
+ 
  in-application
  
  : (;CODE)       ( -- )
!                 R> @ Latestxt @ !  ;
  
  : (DOES>)       ( -- )
!                 Latestxt @ R> TUCK @ OVER !
!                 turnkeyed? if 2drop else Sys-warn-does? then ;
  
  : #(;CODE)      ( a1 -- )
***************
*** 6072,6076 ****
  \                PARMS IF      COMPILE UNNESTP ELSE    COMPILE UNNEST THEN
                  [COMPILE] EXIT
!                 FALSE TO ?:M  [COMPILE] [ PARMS-INIT DO-;CHAIN ; IMMEDIATE
  
  
--- 6078,6082 ----
  \                PARMS IF      COMPILE UNNESTP ELSE    COMPILE UNNEST THEN
                  [COMPILE] EXIT
!                 FALSE TO ?:M  [COMPILE] [ PARMS-INIT DO-;CHAIN suppress off ; IMMEDIATE