From: George H. <geo...@us...> - 2006-01-30 13:58:19
|
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 |