[Win32forth-cvs] win32forth/src FLOAT.F,1.27,1.28

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

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

Modified Files:
	FLOAT.F 
Log Message:
gah: More Dexing (still work in progress)

Index: FLOAT.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v
retrieving revision 1.27
retrieving revision 1.28
diff -C2 -d -r1.27 -r1.28
*** FLOAT.F	28 Jan 2006 10:28:31 -0000	1.27
--- FLOAT.F	30 Jan 2006 13:58:10 -0000	1.28
***************
*** 396,405 ****
                  create here  B/FLOAT allot  f!
                  ;code
!                         push    ebx
!                         lea     ebx, 4 [eax]
!                         fld     FSIZE DATASTACK_MEMORY
!                         FPU>
! 
!                         pop     ebx
                  float;
  
--- 396,401 ----
                  create here  B/FLOAT allot  f!
                  ;code
!                   fld      fsize 4 [eax]
!                   FPU>
                  float;
  
***************
*** 430,437 ****
  
  : FCONSTANT     \ ANSI               Floating
! \ *G \b Compiling: ( -<name>- ) ( F: r -- ) \n
! \ ** \b Run-time:  ( F: -- r ) \d \n
! \ *P Define an FP constant.
!                 create here f! B/FLOAT allot does> f@ ;
  
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
--- 426,477 ----
  
  : FCONSTANT     \ ANSI               Floating
! \ *G      \b Interpretation: ( -<name>- ) ( F: r -- ) \d \n
! \ ** Define an FP constant. \n
! \ **      \b Compilation: \d \n
! \ ** Append the run-time semantics given below to the current definition. \n
! \ **      \b Run-time:  ( F: -- r ) \d \n
! \ ** Place r on the floating-point stack.
! 
!                 create here f! B/FLOAT allot
!                 ;code
!                   fld      fsize 4 [eax]
!                   FPU>
!                 float;
! 
! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! \ Floating point literals. We store the 64-bit or 80-bit floating point
! \ literal inline and push to the FP stack at runtime.
! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! 
! internal
! 
! code flit       ( fs: -- r )
!                 fld     FSIZE 0 [esi]
!                 FPU>
! 
!         B/FLOAT 10 =
!         [IF]    add     esi, # 12        \ to keep dword alignment !
!         [ELSE]  add     esi, # 8
!         [THEN]  float;
! 
! 0 value &flit
! ' flit to &flit \ for the debugger
! 
! external
! 
! in-system
! 
! : FLITERAL      ( fs: r -- )             \ ANSI         Floating
! \ *G         \b Interpretation: \d \n
! \ ** Interpretation semantics for this word are undefined. \n
! \ **         \b Compilation: ( F: r -- ) \d \n
! \ ** Append the run-time semantics given below to the current definition. \n
! \ **         \b Run-time: ( F: -- r ) \d \n
! \ ** Place r on the floating-point stack.
!                 postpone flit
!                 here CELLS/FLOAT cells allot f!
!                 ; immediate
! 
! in-application
  
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
***************
*** 474,478 ****
                  float;
  
! code FOVER      ( fs: r1 r2 -- r1 r2 r3 )         \ ANSI           Floating
  \ *G Copy the 2nd FP stack number to the top of the FP stack.
                  fstack-check_2
--- 514,518 ----
                  float;
  
! code FOVER      ( fs: r1 r2 -- r1 r2 r1 )         \ ANSI           Floating
  \ *G Copy the 2nd FP stack number to the top of the FP stack.
                  fstack-check_2
***************
*** 534,538 ****
                  float;
  
! : F2DUP         ( fs: r1 r2 -- r1 r2 r3 r4 )       \ W32F          Floating extra
  \ *G Duplicate the top 2 FP stack entries.
                  fover fover ;
--- 574,578 ----
                  float;
  
! : F2DUP         ( fs: r1 r2 -- r1 r2 r1 r2 )       \ W32F          Floating extra
  \ *G Duplicate the top 2 FP stack entries.
                  fover fover ;
***************
*** 586,590 ****
  
  code fLn2       ( fs: -- r )         \ W32F         Floating extra
! \ *G Push the vlue of ln 2 (the natural logarithm).
                  fldLn2
                  FPU>
--- 626,630 ----
  
  code fLn2       ( fs: -- r )         \ W32F         Floating extra
! \ *G Push the value of ln 2 (the natural logarithm).
                  fldLn2
                  FPU>
***************
*** 653,712 ****
  
          f1.0 fconstant f2.0 ( FS: -- r ) \ W32F             Floating extra
! \ *G Push 2.0
                  0x40000000 ' f2.0 >body cell+ !
  
!         fvariable a2**63
!                 0 a2**63 !  0x43e00000 a2**63 cell+ !
! 
!         fvariable sq2m1                    \ sqrt(2) - 1
!                 0x99fcef34 sq2m1 !
!                 0x3fda8279 sq2m1 cell+ !
! 
!         fvariable sq2/2m1                  \ sqrt(2)/2 - 1
!                 0x33018866 sq2/2m1 !
!                 0xbfd2bec3 sq2/2m1 cell+ !
! 
!         f0.0 fconstant f10.0                    \ floating 10.0
                  ' f10.0 >body 0 over !  0x40240000 swap cell+ !
  
!         f1.0 fconstant f0.5                     \ floating 0.5
                  ' f0.5 >body 0 over !  0x3fe00000 swap cell+ !
  
!         f0.0 fconstant fbig             \ largest non-infinite number
                  ' fbig >body  -1 over !  0x7fefffff swap cell+ !
  
!         f0.0 fconstant feps             \ smallest non-zero number
                  1 ' feps >body !
  
!         f1.0 fconstant fsmall
                  ' fsmall >body 0 over !  0x00100000 swap cell+ !
  
! [THEN]
! 
! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! \ Floating point literals. We store the 80-bit floating point literal
! \ inline and push to the FP stack at runtime.
! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! 
! code flit       ( fs: -- r )
!                 fld     FSIZE 0 [esi]
!                 FPU>
! 
!         B/FLOAT 10 =
!         [IF]    add     esi, # 12        \ to keep dword alignment !
!         [ELSE]  add     esi, # 8
!         [THEN]  float;
  
! 0 value &flit
! ' flit to &flit \ for the debugger
  
! in-system
  
! : FLITERAL      ( fs: r -- )
!                 postpone flit
!                 here CELLS/FLOAT cells allot f!
!                 ; immediate
  
! in-application
  
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
--- 693,736 ----
  
          f1.0 fconstant f2.0 ( FS: -- r ) \ W32F             Floating extra
! \ *G Push floating-point 2.0.
                  0x40000000 ' f2.0 >body cell+ !
  
!         f0.0 fconstant f10.0 ( FS: -- r ) \ W32F             Floating extra
! \ *G Push floating-point 10.0.
                  ' f10.0 >body 0 over !  0x40240000 swap cell+ !
  
!         f1.0 fconstant f0.5 ( FS: -- r ) \ W32F             Floating extra
! \ *G Push floating-point 0.5.
                  ' f0.5 >body 0 over !  0x3fe00000 swap cell+ !
  
!         f0.0 fconstant fbig ( FS: -- r ) \ W32F             Floating extra
! \ *G Push the largest non-infinite floating-point number.
                  ' fbig >body  -1 over !  0x7fefffff swap cell+ !
  
!         f0.0 fconstant feps ( FS: -- r ) \ W32F             Floating extra
! \ *G Push the smallest non-zero floating-point number.
                  1 ' feps >body !
  
!         f1.0 fconstant fsmall ( FS: -- r ) \ W32F             Floating extra
! \ *G Push the smallest non-denormalised floating-point number.
                  ' fsmall >body 0 over !  0x00100000 swap cell+ !
  
! \ *N Variables
  
!         fvariable a2**63    ( -- addr )  \ W32F             Floating extra
! \ *G Return the address of a float containing 2**63.
!                 0 a2**63 !  0x43e00000 a2**63 cell+ !
  
!         fvariable sq2m1    ( -- addr )  \ W32F             Floating extra
! \ *G Return the address of a float containing sqrt(2) - 1.
!                 0x99fcef34 sq2m1 !
!                 0x3fda8279 sq2m1 cell+ !
  
!         fvariable sq2/2m1    ( -- addr )  \ W32F             Floating extra
! \ *G Return the address of a float containing sqrt(2)/2 - 1.
!                 0x33018866 sq2/2m1 !
!                 0xbfd2bec3 sq2/2m1 cell+ !
  
! [THEN]
  
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
***************
*** 800,804 ****
  \ *N Integer to float coversion
  
! code D>F        ( d -- )  ( F: -- r )
                  lea esp, -4 [esp]
                  mov ecx, 4 [esp]
--- 824,829 ----
  \ *N Integer to float coversion
  
! code D>F        ( d -- )  ( F: -- r )   \ ANSI           Floating
! \ *G Convert double number to floating-point number.
                  lea esp, -4 [esp]
                  mov ecx, 4 [esp]
***************
*** 814,818 ****
  
  \ Changed 3/13/99 rls
! code F>D        ( -- d )  ( fs: r -- )  \ ? out of range errors ?
                  fstack-check_1
  
--- 839,845 ----
  
  \ Changed 3/13/99 rls
! code F>D        ( -- d )  ( fs: r -- )  \ ANSI           Floating
! \ *G Convert floating-point number to double number. If the result would be too large
! \ ** to fit in a double number then \n -9223372036854775808 is returned.
                  fstack-check_1
  
***************
*** 972,977 ****
                  fstack-check_2
                  2>FPU
!                 fxch
!                 fdivp   st(1), st
                  FPU>
                  float;
--- 999,1004 ----
                  fstack-check_2
                  2>FPU
! \                fxch
!                 fdivrp   st(1), st
                  FPU>
                  float;
***************
*** 1095,1099 ****
  code frem2pi    ( f: r1 -- r2 )
                  fstack-check_1
- 
                  fld1
                  fldpi
--- 1122,1125 ----
***************
*** 1107,1111 ****
                  FPU>
                  fstp    st(0)
- 
                  float;
  
--- 1133,1136 ----
***************
*** 1117,1135 ****
  \ *N Trigonometric functions
  
! : FSIN          ( f: r1 -- r2 )         \ ? error if x > 2**63 ?
                  >a2**63_frem2pi (fsin) ;
  
! : FCOS          ( f: r1 -- r2 )         \ ? error if x > 2**63 ?
                  >a2**63_frem2pi (fcos) ;
  
! : FSINCOS       ( f: r1 -- r2 r3 )      \ ? error if x > 2**63 ?
                  >a2**63_frem2pi (fsincos) ;
  
! : FTAN          ( f: r1 -- r2 )         \ ? error if x > 2**63 ?
                  fsincos f/ ;
  
  \ *N Inverse Trigonometric functions
  
! code FASIN      ( fs: r1 -- r2 )        \ result for |x| > 1 is NAN
                  fstack-check_1
                  >FPU
--- 1142,1167 ----
  \ *N Trigonometric functions
  
! : FSIN          ( f: r1 -- r2 )         \ ANSI         Floating ext
! \ *G r2 is the sine of r1 in radians.
                  >a2**63_frem2pi (fsin) ;
  
! : FCOS          ( f: r1 -- r2 )         \ ANSI         Floating ext
! \ *G r2 is the cosine of r1 in radians.
                  >a2**63_frem2pi (fcos) ;
  
! : FSINCOS       ( f: r1 -- r2 r3 )      \ ANSI         Floating ext
! \ *G r2 is the sine and r3 the cosine of r1 in radians. This function is more efficient
! \ ** than calling FSIN and FCOS separately.
                  >a2**63_frem2pi (fsincos) ;
  
! : FTAN          ( f: r1 -- r2 )         \ ANSI         Floating ext
! \ *G r2 is the tangent of r1 in radians.
                  fsincos f/ ;
  
  \ *N Inverse Trigonometric functions
  
! code FASIN      ( fs: r1 -- r2 )        \ ANSI         Floating ext
! \ *G r2 is the radian angle whose sine is r1. The result for |x| =< 1 is between ±pi/2.
! \ ** The result for |x| > 1 is NAN.
                  fstack-check_1
                  >FPU
***************
*** 1145,1149 ****
                  float;
  
! code FACOS      ( fs: r1 -- r2 )        \ result for |x| > 1 is NAN
                  fstack-check_1
                  >FPU
--- 1177,1183 ----
                  float;
  
! code FACOS      ( fs: r1 -- r2 )        \ ANSI         Floating ext
! \ *G r2 is the radian angle whose cosine is r1. The result for |x| =< 1 is between 0 and pi.
! \ ** The result for |x| > 1 is NAN
                  fstack-check_1
                  >FPU
***************
*** 1160,1164 ****
                  float;
  
! code FATAN      ( fs: r1 -- r2 )        \ should be OK for legal args
                  fstack-check_1
                  >FPU
--- 1194,1199 ----
                  float;
  
! code FATAN      ( fs: r1 -- r2 )        \ ANSI          Floating ext
! \ *G r2 is the radian angle whose tangent is r1. The result is between ±pi/2.
                  fstack-check_1
                  >FPU
***************
*** 1169,1174 ****
  
  code FATAN2     ( fs: r1 r2 -- r3 )              \ ANSI         Floating ext
! \ *G r3 is the radian angle whose tangent is r1/r2. If r1 and r2 are both zero then r3
! \ ** is zero.
                  fstack-check_2
                  2>FPU
--- 1204,1211 ----
  
  code FATAN2     ( fs: r1 r2 -- r3 )              \ ANSI         Floating ext
! \ *G r3 is the radian angle whose tangent is r1/r2. The result is between ±pi
! \ ** with the same sign as r2. If r1 and r2 are both zero then r3 is ±zero.
! \ ** This function can be used to convert cartesian coordinates into the angle of the
! \ ** polar coordinates.
                  fstack-check_2
                  2>FPU
***************
*** 1178,1182 ****
                  float;
  
! code FLNP1      ( fs: r1 -- r2 )                \ ? error for x <= -1
                  fstack-check_1
  
--- 1215,1222 ----
                  float;
  
! \ *N Logarithmic functions
! 
! code FLNP1      ( fs: r1 -- r2 )                \ ANSI           Floating ext
! \ *G ? error for x <= -1
                  fstack-check_1