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

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

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

Modified Files:
	fkernel.f 
Log Message:
Made Main-Task findable. Added LATESTXT (as in STC). Moved user variables used by exceptions.

Index: fkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v
retrieving revision 1.97
retrieving revision 1.98
diff -C2 -d -r1.97 -r1.98
*** fkernel.f	15 Nov 2013 19:35:03 -0000	1.97
--- fkernel.f	19 Nov 2013 16:31:44 -0000	1.98
***************
*** 2011,2014 ****
--- 2011,2016 ----
    DUP USER &EXREC        CELL+ ( for exception handling )
    DUP USER &EXCEPT       CELL+ ( for exception handling )
+   DUP USER exc-guard     CELL+
+   DUP USER exc-access    CELL+
    DUP USER HANDLER       CELL+ ( throw frame )
    DUP USER LP            CELL+ ( local variable pointer )
***************
*** 2045,2049 ****
                   Task-Status @ and 0 <> ;
  
! 1 | Constant Main-Task
  2 Constant Assync-Task
  
--- 2047,2051 ----
                   Task-Status @ and 0 <> ;
  
! 1 Constant Main-Task
  2 Constant Assync-Task
  
***************
*** 2903,2906 ****
--- 2905,2909 ----
  VARIABLE CONTEXT #VOCS CELLS ALLOT     \ make context array of #VOCS+1 cells
  VARIABLE CURRENT
+ VARIABLE LatestXT
  VARIABLE LAST                   \ NFA of last header created
  VARIABLE LAST-LINK              \ address of last link for last header created
***************
*** 4457,4461 ****
  \ follows the CFA-pointer when compiling definitions into some named space
  \ (which may not be the same space as the header).
!             align HERE CFAPTR!
              ;
  
--- 4460,4464 ----
  \ follows the CFA-pointer when compiling definitions into some named space
  \ (which may not be the same space as the header).
!             align HERE dup LatestXT ! CFAPTR!
              ;
  
***************
*** 4498,4502 ****
  \ *P NOTE View of either name can go to the synonym instead (it depends which name
  \ ** is found first in a full dictionary search).
!                 HEADER CFAPTR! ;
  
  : SYNONYM       ( -<newname> <oldname>- )  \ 200X
--- 4501,4505 ----
  \ *P NOTE View of either name can go to the synonym instead (it depends which name
  \ ** is found first in a full dictionary search).
!                 HEADER CFAPTR! dup latestXT ! ;
  
  : SYNONYM       ( -<newname> <oldname>- )  \ 200X
***************
*** 4513,4517 ****
                  DEFINED DUP ?MISSING
                  1 = IF IMMEDIATE THEN       \ make synonym immediate if original is
!                 CFAPTR! reveal ;            \ set the cfa pointer of header
  
  
--- 4516,4520 ----
                  DEFINED DUP ?MISSING
                  1 = IF IMMEDIATE THEN       \ make synonym immediate if original is
!                 CFAPTR! dup latestXT ! reveal ;            \ set the cfa pointer of header
  
  
***************
*** 4579,4583 ****
  
  : :NONAME       ( -- xt )       \ start a headerless colon definition
!                 ALIGN HERE DUP ANON ! :COLONDEF ;
  
  : :             ( "name" -- )    \ Forth's primary function defining word
--- 4582,4586 ----
  
  : :NONAME       ( -- xt )       \ start a headerless colon definition
!                 ALIGN HERE DUP ANON ! :COLONDEF dup latestXT ! ;
  
  : :             ( "name" -- )    \ Forth's primary function defining word
***************
*** 4871,4875 ****
  
  \ 07/07/2003 21:10:55 fkernel.f  [ 745385 ] Bug in "Find Text in Files" Dialog
! DEFER WINPAUSE      ( -- )  \ release control to OS for a moment, pump message loop (in wrapper)
  : (WINPAUSE)    KEY? DROP ; ' (WINPAUSE) IS WINPAUSE
  
--- 4874,4878 ----
  
  \ 07/07/2003 21:10:55 fkernel.f  [ 745385 ] Bug in "Find Text in Files" Dialog
! DEFER WINPAUSE      ( -- )  \ release control to OS for a moment, pump the message loop
  : (WINPAUSE)    KEY? DROP ; ' (WINPAUSE) IS WINPAUSE
  
***************
*** 5675,5683 ****
  \ -------------------- Task support & initialisation ------------------------
  
- \ VARIABLE &EXCEPT
- \ VARIABLE &EXREC
- cell NEXT-USER @ SWAP OVER + NEXT-USER ! USER exc-guard
- cell NEXT-USER @ SWAP OVER + NEXT-USER ! USER exc-access
- 
  align
  here: K32VAL
--- 5678,5681 ----