[Win32forth-cvs] win32forth/src/kernel fkernel.f,1.7,1.8

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

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

Modified Files:
	fkernel.f 
Log Message:
zEXEC rewritten (see Shell.f), made DEPRECATED work for class members,SF[1178189] fixed, SF[1178189] fixed, SF[1178186] fixed, SF[1167791] fixed, SF[774094] fixed; and some other small changes I can't remebere any more

Index: fkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** fkernel.f	13 Apr 2005 00:09:27 -0000	1.7
--- fkernel.f	18 Apr 2005 17:39:42 -0000	1.8
***************
*** 2539,2543 ****
  \ -------------------- Parse Input Stream --------------------
  
! \ WORD is doesn't met the ANS-Standard in Win32Forth.
  \ The standrad reqires that a space, not included in the length, must follow
  \ the string. In Win32Forth a NULL follow's the string.
--- 2539,2543 ----
  \ -------------------- Parse Input Stream --------------------
  
! \ WORD doesn't met the ANS-Standard in Win32Forth.
  \ The standrad reqires that a space, not included in the length, must follow
  \ the string. In Win32Forth a NULL follow's the string.
***************
*** 3968,3981 ****
     0 0 rot FILE_END SetFP nip nip ; \ ior - 0 = success
  
  : file-size     ( fileid -- len-ud ior )
!    dup>r file-position
!    ?DUP IF r>drop >R 2drop 0 0 R> _EXIT THEN  \ error, exit
!    0 0 R@                                \ position, fileid
!    FILE_END SetFP                       \ move to end
!    ?dup if r>drop 4drop _EXIT then      \ error, exit
!    2SWAP R> reposition-file ;           \ otherwise reposition
  
! : flush-file ( fileid -- ior )
!    call FlushFileBuffers 0= ;                   \ ior - 0 = success
  
  | CODE ADJ-LENS ( buff len buff' -- len len' )  \ adjust lengths: rot - tuck swap - ;
--- 3968,3993 ----
     0 0 rot FILE_END SetFP nip nip ; \ ior - 0 = success
  
+ 2 PROC GetFileSize
  : file-size     ( fileid -- len-ud ior )
! \    dup>r file-position
! \    ?DUP IF r>drop >R 2drop 0 0 R> _EXIT THEN  \ error, exit
! \    0 0 R@                               \ position, fileid
! \    FILE_END SetFP                       \ move to end
! \    ?dup if r>drop 4drop _EXIT then      \ error, exit
! \    2SWAP R> reposition-file ;           \ otherwise reposition
! \ this is about 3 times faster; thank's Lcc Wizard for
! \ sending me this (Mittwoch, März 16 2005 dbu)
!  		cell _LOCALALLOC dup>r
! 		swap call GetFileSize
! 		r> @ over INVALID_FILE_SIZE =
! 		if   call GetLastError NO_ERROR =
! 		     if false
! 		     else 2drop 0.0 true
! 		     then
! 		else false
! 		then _LOCALFREE ;
  
! : flush-file    ( fileid -- ior )
!                 call FlushFileBuffers 0= ;      \ ior - 0 = success
  
  | CODE ADJ-LENS ( buff len buff' -- len len' )  \ adjust lengths: rot - tuck swap - ;
***************
*** 5155,5160 ****
                  TRUE  TO DPR-WARNING? ;
  
! |: (dprwarn)    ( -- ) \ warn if deprected word was found
! 		DPR-WARNING? LATEST-NFA @ n>bfa c@ BFA_DEPRECATED and and
                  IF WARN_DEPRECATEDWORD WARNMSG THEN ;
  
--- 5167,5172 ----
                  TRUE  TO DPR-WARNING? ;
  
! : (dprwarn)     ( f -- f ) \ warn if deprected word was found
! 		dup 0<> DPR-WARNING? LATEST-NFA @ n>bfa c@ BFA_DEPRECATED and and and
                  IF WARN_DEPRECATEDWORD WARNMSG THEN ;
  
***************
*** 5178,5183 ****
                  THEN
  
! 		\ warn if deprecated word is found
! 		dup 0<> if (dprwarn) then ;
  
  ' PARMFIND IS FIND
--- 5190,5194 ----
                  THEN
  
! 		(dprwarn) ; \ warn if deprecated word is found
  
  ' PARMFIND IS FIND
***************
*** 5733,5734 ****
--- 5744,5746 ----
  ' ?THROW        RESOLVES ?THROW
  ' WARNMSG       RESOLVES WARNMSG
+