From: George H. <geo...@us...> - 2006-02-02 10:55:31
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14890/win32forth/src Modified Files: FLOAT.F Log Message: gah: More Dexing (still work in progress) optimizations and bug fixes Index: FLOAT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v retrieving revision 1.30 retrieving revision 1.31 diff -C2 -d -r1.30 -r1.31 *** FLOAT.F 1 Feb 2006 12:42:14 -0000 1.30 --- FLOAT.F 2 Feb 2006 10:55:21 -0000 1.31 *************** *** 100,104 **** push ebx xor eax, eax ! fstsw ax mov ebx, eax next, --- 100,104 ---- push ebx xor eax, eax ! fnstsw ax mov ebx, eax next, *************** *** 184,188 **** L$1: fld FSIZE FSTACK_MEMORY fxam ! fstsw ax mov ebx, eax and ebx, # FPU_STATUS_CCF_MASK --- 184,188 ---- L$1: fld FSIZE FSTACK_MEMORY fxam ! fnstsw ax mov ebx, eax and ebx, # FPU_STATUS_CCF_MASK *************** *** 199,213 **** fninit mov FSP_MEMORY , edi ! lea esp, -4 [esp] ! fnstcw word 0 [esp] ! mov eax, 0 [esp] ! B/FLOAT 10 = ! [IF] or eax, # 0x0300 \ 10 byte mode ! [ELSE] and eax, # 0x0eff \ 8 byte mode ! or eax, # 0x0200 ! [THEN] ! mov 0 [esp], eax ! fldcw word 0 [esp] ! lea esp, 4 [esp] next, end-code --- 199,206 ---- fninit mov FSP_MEMORY , edi ! B/FLOAT 10 = 0= [IF] ! fnstcw word -4 [ebp] ! and word -4 [ebp], # 0x0eff \ 8 byte mode ! fldcw word -4 [ebp] [THEN] next, end-code *************** *** 781,785 **** code FLOOR ( fs: f1 -- fs: f2 ) \ ANSI Floating ! \ *G Set rounding mode to round to -infinity. push ebx mov bx, # 0x00400 --- 774,779 ---- code FLOOR ( fs: f1 -- fs: f2 ) \ ANSI Floating ! \ *G Round r1 to an integral value using the round toward negative infinity rule, ! \ ** giving r2. push ebx mov bx, # 0x00400 *************** *** 789,793 **** code FCEIL ( fs: f1 -- fs: f2 ) \ W32F Floating extra ! \ *G Set rounding mode to round to +infinity. push ebx mov bx, # 0x00800 --- 783,788 ---- code FCEIL ( fs: f1 -- fs: f2 ) \ W32F Floating extra ! \ *G Round r1 to an integral value using the round toward positive infinity rule, ! \ ** giving r2. push ebx mov bx, # 0x00800 *************** *** 797,801 **** code FTRUNC ( fs: f1 -- fs: f2 ) \ W32F Floating extra ! \ *G Set rounding mode to truncate. push ebx mov bx, # 0x00c00 --- 792,796 ---- code FTRUNC ( fs: f1 -- fs: f2 ) \ W32F Floating extra ! \ *G Round r1 to an integral value using the round toward zero rule, giving r2. push ebx mov bx, # 0x00c00 *************** *** 806,810 **** code FROUND ( fs: f1 -- fs: f2 ) \ ANSI Floating ! \ *G Set rounding mode to round to nearest. push ebx mov bx, # 0x00000 --- 801,805 ---- code FROUND ( fs: f1 -- fs: f2 ) \ ANSI Floating ! \ *G Round r1 to an integral value using the round to nearest rule, giving r2. push ebx mov bx, # 0x00000 *************** *** 908,912 **** macro: (fcomp) ! fstsw ax push ebx mov ebx, eax --- 903,907 ---- macro: (fcomp) ! fnstsw ax push ebx mov ebx, eax *************** *** 1117,1121 **** >FPU L$1: fprem1 ! fstsw ax sahf jp short L$1 --- 1112,1116 ---- >FPU L$1: fprem1 ! fnstsw ax sahf jp short L$1 *************** *** 1132,1136 **** : 1/f ( fs: r1 -- r2 ) \ W32F Floating extra \ *G r2 is the reciprocal of r1. ! -1 f**n ; \ *N Trigonometric functions --- 1127,1131 ---- : 1/f ( fs: r1 -- r2 ) \ W32F Floating extra \ *G r2 is the reciprocal of r1. ! f1.0 fswap f/ ; \ *N Trigonometric functions *************** *** 1230,1234 **** fld FSIZE sq2m1 fcomp st(1) ! fstsw ax sahf jp short L$3 --- 1225,1229 ---- fld FSIZE sq2m1 fcomp st(1) ! fnstsw ax sahf jp short L$3 *************** *** 1236,1240 **** fld FSIZE sq2/2m1 fcomp st(1) ! fstsw ax sahf jb short L$4 --- 1231,1235 ---- fld FSIZE sq2/2m1 fcomp st(1) ! fnstsw ax sahf jb short L$4 *************** *** 1263,1268 **** code FEXP ( fs: r1 -- r2 ) \ ANSI Floating ext fstack-check_1 ! fldl2e \ log base 2 of e \ 1 ! >FPU \ 2 fmulp st(1), st \ modified exponent \ 1 fld st(0) \ duplicate exponent \ 2 --- 1258,1273 ---- code FEXP ( fs: r1 -- r2 ) \ ANSI Floating ext fstack-check_1 ! >FPU \ 1 ! fxam ! fnstsw ax ! and ax, # FPU_STATUS_CCF_MASK ! cmp ax, # FPU_STATUS_CCF_INFINITY ! je short L$2 ! cmp ax, # 0x700 \ FPU_STATUS_CCF_INFINITY FPU_STATUS_CCF_MASK_1 or ! jne short L$1 ! fstp st(0) ! fldz ! jmp short L$2 ! L$1: fldl2e \ log base 2 of e \ 2 fmulp st(1), st \ modified exponent \ 1 fld st(0) \ duplicate exponent \ 2 *************** *** 1277,1281 **** faddp st(1), st \ 2**frac \ 2 fmulp st(1), st \ 2**(int + frac) \ 1 ! FPU> \ 0 float; --- 1282,1286 ---- faddp st(1), st \ 2**frac \ 2 fmulp st(1), st \ 2**(int + frac) \ 1 ! L$2: FPU> \ 0 float; *************** *** 1283,1296 **** fstack-check_1 - fldl2e >fpu fld1 fcom st(1) ! fstsw ax sahf jbe short L$4 fchs fcomp st(1) ! fstsw ax sahf jnc short L$5 --- 1288,1313 ---- fstack-check_1 >fpu + fxam + fnstsw ax + and ax, # FPU_STATUS_CCF_MASK + cmp ax, # FPU_STATUS_CCF_INFINITY + je short L$6 + cmp ax, # 0x700 \ FPU_STATUS_CCF_INFINITY FPU_STATUS_CCF_MASK_1 or + jne short L$1 + fstp st(0) + fld1 + fchs + jmp short L$6 + L$1: fldl2e + fxch fld1 fcom st(1) ! fnstsw ax sahf jbe short L$4 fchs fcomp st(1) ! fnstsw ax sahf jnc short L$5 *************** *** 1298,1303 **** fmulp st(1), st(0) f2xm1 ! (fpu>) ! jmp short L$2 L$4: fstp st(0) \ 2 L$5: fmulp st(1), st(0) \ 1 --- 1315,1319 ---- fmulp st(1), st(0) f2xm1 ! jmp short L$6 L$4: fstp st(0) \ 2 L$5: fmulp st(1), st(0) \ 1 *************** *** 1316,1320 **** fld1 fsubp st(1), st \ Should be fsubrp ??????? ! fpu> jmp short L$2 L$3: fstp st(1) --- 1332,1336 ---- fld1 fsubp st(1), st \ Should be fsubrp ??????? ! L$6: fpu> jmp short L$2 L$3: fstp st(1) *************** *** 1322,1326 **** : f** ( F: r1 r2 -- r3 ) ! fswap fln f* fexp ; synonym f^x f** DEPRECATED --- 1338,1346 ---- : f** ( F: r1 r2 -- r3 ) ! \ fswap fln f* fexp ; ! FDUP FROUND FDUP F>S F- FDUP F0= ! if FDROP F**N ! else FOVER FLN F* FEXP FSWAP F**N F* ! THEN ; synonym f^x f** DEPRECATED *************** *** 1359,1363 **** \ *N Inverse hyperbolic functions ! code FASINH ( fs: r1 -- r2 ) \ Note: well defined for r1 < 0 fstack-check_1 fldln2 --- 1379,1384 ---- \ *N Inverse hyperbolic functions ! code FASINH ( fs: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the number whose hyperbolic sine is r1. fstack-check_1 fldln2 *************** *** 1373,1377 **** float; ! code FACOSH ( fs: r1 -- r2 ) \ ANSI Floating ext fstack-check_1 fldln2 --- 1394,1399 ---- float; ! code FACOSH ( fs: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the number whose hyperbolic cosine is r1. If r1 < 1.0 then r2 is a NAN. fstack-check_1 fldln2 *************** *** 1387,1391 **** float; ! : FATANH ( f: r1 -- r2 ) \ OK for valid args fdup f1.0 f+ fswap f1.0 fswap f- --- 1409,1414 ---- float; ! : FATANH ( f: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the number whose hyperbolic tangent is r1. IF |r1| > 1.0 then r2 is a NAN. fdup f1.0 f+ fswap f1.0 fswap f- |