win32forth-cvs

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

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

Modified Files:
	FLOAT.F 
Log Message:
gah: made Float.f more thread-safe ( F. FE. FS. etc ) and optimized some code

Index: FLOAT.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** FLOAT.F	1 Jul 2005 09:42:41 -0000	1.11
--- FLOAT.F	4 Jul 2005 07:58:26 -0000	1.12
***************
*** 1326,1330 ****
                  ELSE    fdup f0=
                          IF      fdrop FLOATSTACK FLOATSP @ + B/FLOAT - dup B/FLOAT -
!                                 swap B/FLOAT swap B/FLOAT compare 0=
                                  f2drop
                          ELSE    \ January 16th, 1998 rls add "fswap"
--- 1326,1330 ----
                  ELSE    fdup f0=
                          IF      fdrop FLOATSTACK FLOATSP @ + B/FLOAT - dup B/FLOAT -
!                                 swap B/FLOAT swap B/FLOAT str=
                                  f2drop
                          ELSE    \ January 16th, 1998 rls add "fswap"
***************
*** 1507,1513 ****
  
  fvariable ftemp
! create $ftemp 128 allot
  create $ftemp1 128 allot
! create fbcd-buf 10 allot
  
  external
--- 1507,1513 ----
  
  fvariable ftemp
! 128 newuser $ftemp
  create $ftemp1 128 allot
! 10 newuser fbcd-buf
  
  external
***************
*** 1889,1894 ****
  : +represent    { $buf \ -- flag }
                  $ftemp precision represent 0=
!                 IF   2drop $ftemp precision $buf +PLACE s"  " $buf +PLACE true
!                 ELSE false
                  THEN ;
  
--- 1889,1893 ----
  : +represent    { $buf \ -- flag }
                  $ftemp precision represent 0=
!                 -IF  3drop $ftemp precision $buf +PLACE s"  " $buf +PLACE true
                  THEN ;
  
***************
*** 2044,2058 ****
  \ synonym f** f^x
  
! : fsqr          f0.5 f** ;
  
! : 1/f           -1 f**n ;
  
! : f>r           r> rp@ b/float - rp! rp@ f! >r ;
  
! : fdup>r        r> fdup rp@ b/float - rp! rp@ f! >r ;
  
! : r>f           r> rp@ f@ b/float rp@ + rp! >r ;
  
! : fr@           r> r@ f@ >r ;
  \ <-- rbs
  
--- 2043,2058 ----
  \ synonym f** f^x
  
! \ : fsqr          f0.5 f** ;
! synonym fsqr fsqrt deprecated
  
! : 1/f           -1 f**n ; deprecated
  
! : f>r           r> rp@ b/float - rp! rp@ f! >r ; deprecated
  
! : fdup>r        r> fdup rp@ b/float - rp! rp@ f! >r ; deprecated
  
! : r>f           r> rp@ f@ b/float rp@ + rp! >r ; deprecated
  
! : fr@           r> r@ f@ >r ; deprecated
  \ <-- rbs