[Win32forth-cvs] win32forth/src FLOAT.F,1.10,1.11

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

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

Modified Files:
	FLOAT.F 
Log Message:
gah: modified rep-normal to (hopefully) work correctly for precision of 1 and fixed a few stack comments

Index: FLOAT.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** FLOAT.F	25 Jun 2005 16:29:02 -0000	1.10
--- FLOAT.F	1 Jul 2005 09:42:41 -0000	1.11
***************
*** 27,30 ****
--- 27,32 ----
  \ gah Thursday, May 26 2005 added macro 2>FPU
  \ gah Saturday, June 25 2005 modified rep-zero to correct bug in represent
+ \ gah Thursday, June 30 2005 modified rep-normal to correct bug in represent
+ \ gah Thursday, June 30 2005 made FLOOR FROUND FTRUNC thread-safe
  \ -------------------------------------------------------------------------
  
***************
*** 696,700 ****
  internal
  
! variable cwtemp
  
  in-system
--- 698,702 ----
  internal
  
! cell newuser cwtemp
  
  in-system
***************
*** 704,714 ****
  \ output: bx = org FPU Control Word
  macro:  set-rounding-mode
!                 fstcw   word cwtemp
!                 mov     ax, cwtemp
                  push    ax
                  and     ax, # 0x0f3ff
                  or      ax, bx
!                 mov     cwtemp , ax
!                 fldcw   word cwtemp
                  pop     bx
                  endm
--- 706,716 ----
  \ output: bx = org FPU Control Word
  macro:  set-rounding-mode
!                 fstcw   word cwtemp [up]
!                 mov     ax, cwtemp [up]
                  push    ax
                  and     ax, # 0x0f3ff
                  or      ax, bx
!                 mov     cwtemp [up], ax
!                 fldcw   word cwtemp [up]
                  pop     bx
                  endm
***************
*** 717,725 ****
  \ input: bx = org FPU Control Word
  macro:  restore-rounding-mode
!                 mov     cwtemp , bx
!                 fldcw   word cwtemp
                  endm
  
! \ Subroutine to round a floating point value
  \ input:  bx = rounding mode mask for the FPU Control Word
  macro:  (fround)
--- 719,727 ----
  \ input: bx = org FPU Control Word
  macro:  restore-rounding-mode
!                 mov     cwtemp [up], bx
!                 fldcw   word cwtemp [up]
                  endm
  
! \ Macro to round a floating point value
  \ input:  bx = rounding mode mask for the FPU Control Word
  macro:  (fround)
***************
*** 1565,1578 ****
                  THEN ;
  
! : rep-normal    ( addr u -- n true )
!                 1 max 2dup ascii 0 fill 18 umin
!                 fabs fdup dup 10**n-0.5 f<
!                 IF   fdup dup dup 1- 10**n-0.5 f<
!                      IF   fdup flog floor f>s 1+ dup>r
!                           - f*10**n
!                      ELSE >r
!                      THEN
!                 ELSE fdup flog floor f>s 1+ dup>r
!                      over - 10**n f/
                  THEN
                  fround fdup dup 10**n f<
--- 1567,1576 ----
                  THEN ;
  
! : rep-normal    ( addr u -- n true )  ( f: r -- )
!                 1 max 2dup [char] 0 fill 18 umin
!                 fdup flog floor f>s 1+ dup>r over -
!                 fdup over 10**n-0.5 f<
!                 IF   negate f*10**n
!                 ELSE 10**n f/
                  THEN
                  fround fdup dup 10**n f<
***************
*** 1588,1598 ****
                  ;
  
! : rep-denormal  ( addr u -- n true )
!                 rep-normal ;
  
  \ February 6th, 1996 - 18:05 tjz added 'FDROP' to the following def to
  \ correct for a floating point zero left on the stack during E. and F.S
  : rep-zero      ( addr u -- 1 true )  ( f: r -- )
!                 ascii 0 fill 1 true fdrop ;
  
  : rep-spec      ( addr u cstr -- n false )  ( f: r -- )
--- 1586,1595 ----
                  ;
  
! ' rep-normal alias rep-denormal  ( addr u -- n true )  ( f: r -- )
  
  \ February 6th, 1996 - 18:05 tjz added 'FDROP' to the following def to
  \ correct for a floating point zero left on the stack during E. and F.S
  : rep-zero      ( addr u -- 1 true )  ( f: r -- )
!                 [char] 0 fill 1 true fdrop ;
  
  : rep-spec      ( addr u cstr -- n false )  ( f: r -- )