Menu
▾
▴
[Win32forth-cvs] win32forth/src FLOAT.F,1.34,1.35
|
From: George H. <geo...@us...> - 2006-02-07 19:23:17
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22051/win32forth/src Modified Files: FLOAT.F Log Message: gah: More dexing and optimising (still work in progress) Index: FLOAT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v retrieving revision 1.34 retrieving revision 1.35 diff -C2 -d -r1.34 -r1.35 *** FLOAT.F 6 Feb 2006 15:40:36 -0000 1.34 --- FLOAT.F 7 Feb 2006 11:26:46 -0000 1.35 *************** *** 116,120 **** \ *G Get x87 FPU Status Word. push tos ! fnstsw ax mov tos, eax next, --- 116,120 ---- \ *G Get x87 FPU Status Word. push tos ! fstsw ax mov tos, eax next, *************** *** 208,212 **** L$1: fld FSIZE FSTACK_MEMORY fxam ! fnstsw ax mov ebx, eax and ebx, # FPU_STATUS_CCF_MASK --- 208,212 ---- L$1: fld FSIZE FSTACK_MEMORY fxam ! fstsw ax mov ebx, eax and ebx, # FPU_STATUS_CCF_MASK *************** *** 221,228 **** \ ** Tasks in a multi-task program should execute this word before executing any \ ** other floating-point words. ! 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] --- 221,228 ---- \ ** Tasks in a multi-task program should execute this word before executing any \ ** other floating-point words. ! finit mov FSP_MEMORY , edi B/FLOAT 10 = 0= [IF] ! fstcw word -4 [ebp] and word -4 [ebp], # 0x0eff \ 8 byte mode fldcw word -4 [ebp] [THEN] *************** *** 750,760 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ Rounding Modes \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - internal - - cell newuser cwtemp - in-system --- 750,756 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ *N Rounding functions \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ in-system *************** *** 763,774 **** \ 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 --- 759,769 ---- \ output: bx = org FPU Control Word macro: set-rounding-mode ! fstcw word -4 [ebp] ! mov ax, -4 [ebp] and ax, # 0x0f3ff or ax, bx ! mov -8 [ebp], ax ! fldcw word -8 [ebp] ! mov bx, -4 [ebp] endm *************** *** 776,781 **** \ input: bx = org FPU Control Word macro: restore-rounding-mode ! mov cwtemp [up], bx ! fldcw word cwtemp [up] endm --- 771,776 ---- \ input: bx = org FPU Control Word macro: restore-rounding-mode ! mov -4 [ebp], bx ! fldcw word -4 [ebp] endm *************** *** 793,800 **** in-application - external - - \ *N Rounding functions - code FLOOR ( fs: r1 -- r2 ) \ ANSI Floating \ *G Round r1 to an integral value using the round toward negative infinity rule, --- 788,791 ---- *************** *** 848,878 **** mov tos, 8 [esp] lea esp, 12 [esp] - FPU> - float; \ 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 >FPU ! push ebx mov bx, # 0x00c00 \ Set rounding to truncate set-rounding-mode - sub esp, # 8 fistp qword 0 [esp] restore-rounding-mode ! pop ebx ! xchg ebx, 0 [esp] float; code ZF>D ( -- d ; fs: r -- ) \ W32F Floating extra fstack-check_1 >FPU sub esp, # 8 fistp qword 0 [esp] ! xchg ebx, 4 [esp] float; --- 839,876 ---- mov tos, 8 [esp] lea esp, 12 [esp] FPU> float; \ Changed 3/13/99 rls code F>D ( -- d ; fs: r -- ) \ ANSI Floating ! \ *G Convert floating-point number to double number, by rounding towards zero. If the ! \ ** result would be too large to fit in a double number then \n -9223372036854775808 ! \ ** is returned. fstack-check_1 >FPU ! sub esp, # 12 ! mov 8 [esp], tos ! xor ebx, ebx mov bx, # 0x00c00 \ Set rounding to truncate set-rounding-mode fistp qword 0 [esp] restore-rounding-mode ! mov tos, 4 [esp] ! mov eax, 0 [esp] ! mov 4 [esp], eax ! add esp, # 4 float; code ZF>D ( -- d ; fs: r -- ) \ W32F Floating extra + \ *G Convert floating-point number to double number, using the current rounding mode + \ ** (rounding towards zero unless changed by the user). If the result would be too + \ ** large to fit in a double number then \n -9223372036854775808 is returned. fstack-check_1 >FPU sub esp, # 8 fistp qword 0 [esp] ! mov eax, 4 [esp] ! mov 4 [esp], tos ! mov tos, eax float; *************** *** 927,931 **** macro: (fcomp) ! fnstsw ax push ebx mov ebx, eax --- 925,929 ---- macro: (fcomp) ! fstsw ax push ebx mov ebx, eax *************** *** 1027,1031 **** fstack-check_2 2>FPU - \ fxch fdivrp st(1), st FPU> --- 1025,1028 ---- *************** *** 1083,1087 **** internal ! code f**+n ( fs: r1 -- r2 ; n -- ) fstack-check_1 fld1 --- 1080,1084 ---- internal ! code f**+n ( n -- ; fs: r1 -- r2 ) \ r2 is r1 to the power n, where n is positve. fstack-check_1 fld1 *************** *** 1104,1110 **** float; ! : f**n ( Fs: r1 -- r2 ; n -- ) \ Floating number raised to integer power. DUP 0< ! IF ABS F**+N F1.0 FSWAP F/ ELSE F**+N THEN ; --- 1101,1107 ---- float; ! : f**n ( n -- ; fs: r1 -- r2 ) \ r2 is r1 to the power n. DUP 0< ! IF ABS F**+N 1/f ELSE F**+N THEN ; *************** *** 1141,1145 **** >FPU L$1: fprem1 ! fnstsw ax sahf jp short L$1 --- 1138,1142 ---- >FPU L$1: fprem1 ! fstsw ax sahf jp short L$1 *************** *** 1249,1253 **** fld FSIZE sq2m1 fcomp st(1) ! fnstsw ax sahf jp short L$3 --- 1246,1250 ---- fld FSIZE sq2m1 fcomp st(1) ! fstsw ax sahf jp short L$3 *************** *** 1255,1259 **** fld FSIZE sq2/2m1 fcomp st(1) ! fnstsw ax sahf jb short L$4 --- 1252,1256 ---- fld FSIZE sq2/2m1 fcomp st(1) ! fstsw ax sahf jb short L$4 *************** *** 1287,1291 **** >FPU \ 1 fxam ! fnstsw ax and ax, # FPU_STATUS_CCF_MASK cmp ax, # FPU_STATUS_CCF_INFINITY --- 1284,1288 ---- >FPU \ 1 fxam ! fstsw ax and ax, # FPU_STATUS_CCF_MASK cmp ax, # FPU_STATUS_CCF_INFINITY *************** *** 1321,1325 **** >fpu fxam ! fnstsw ax and ax, # FPU_STATUS_CCF_MASK cmp ax, # FPU_STATUS_CCF_INFINITY --- 1318,1322 ---- >fpu fxam ! fstsw ax and ax, # FPU_STATUS_CCF_MASK cmp ax, # FPU_STATUS_CCF_INFINITY *************** *** 1335,1344 **** fld1 fcom st(1) ! fnstsw ax sahf jbe short L$4 fchs fcomp st(1) ! fnstsw ax sahf jnc short L$5 --- 1332,1341 ---- fld1 fcom st(1) ! fstsw ax sahf jbe short L$4 fchs fcomp st(1) ! fstsw ax sahf jnc short L$5 *************** *** 1375,1378 **** --- 1372,1379 ---- THEN ; + : FALOG ( fs: r1 -- r2 ) \ ANSI Floating ext + \ *G Raise ten to the power r1, giving r2. + f10.0 fswap f** ; + synonym f^x f** DEPRECATED *************** *** 1448,1452 **** \ July 29th, 1998 - 8:53 tjz \ added '@' after FLOATSP to fix a bug reported by Pierre Abbat ! : F~ ( fs: r1 r2 r3 -- ) ( -- flag ) fdup f0< IF fabs fover fabs 3 fpick fabs f+ f* \ r1 r2 r3*(r1+r2) --- 1449,1460 ---- \ July 29th, 1998 - 8:53 tjz \ added '@' after FLOATSP to fix a bug reported by Pierre Abbat ! : F~ ( -- flag ; fs: r1 r2 r3 -- ) \ ANSI Floating ext ! \ *G If r3 is positive, flag is true if the absolute value of (r1 minus r2) is less than r3. ! \ ** If r3 is zero, flag is true if the implementation-dependent encoding of r1 and r2 are ! \ ** exactly identical (positive and negative zero are unequal if they have distinct encodings). ! \ ** If r3 is negative, flag is true if the absolute value of (r1 minus r2) is less than the ! \ ** absolute value of r3 times the sum of the absolute values of r1 and r2. ! \ *P This provides the three types of floating point equality in common use -- close in ! \ ** absolute terms, exact equality as represented, and relatively close. fdup f0< IF fabs fover fabs 3 fpick fabs f+ f* \ r1 r2 r3*(r1+r2) *************** *** 1583,1593 **** 10 newuser fbcd-buf - external - - : FALOG ( fs: r1 -- r2 ) \ ? overflow error ? - f10.0 fswap f** ; - - internal - : 10**n ( fs: -- r ) ( n -- ) \ 10 raised to n f10.0 f**n ; --- 1591,1594 ---- *************** *** 1946,1950 **** \ ** floating-point representation. If the string represents a valid floating-point \ ** number in the syntax below, its value r and true are returned. If the string does not ! \ ** represent a valid floating-point number only false is returned. \n \ ** F# used at the end of a line is treated as a special case representing zero. \n \ ** If interpreting the FP number is placed on the FP stack, while it is compiled as --- 1947,1951 ---- \ ** floating-point representation. If the string represents a valid floating-point \ ** number in the syntax below, its value r and true are returned. If the string does not ! \ ** represent a valid floating-point number an error is thrown. \n \ ** F# used at the end of a line is treated as a special case representing zero. \n \ ** If interpreting the FP number is placed on the FP stack, while it is compiled as *************** *** 2050,2054 **** THEN ; ! : (FE.) ( addr -- ; fs: r -- ) \ convert fp # into a string (in engineering notation) { $buf \ -- } $buf off --- 2051,2056 ---- THEN ; ! : (FE.) ( addr -- ; fs: r -- ) \ W32F Floating extra ! \ *G Format r as a string in engineering notation. { $buf \ -- } $buf off *************** *** 2065,2069 **** base @ >r decimal (.) $buf +PLACE r> base ! ; ! : (E.) ( addr -- ; fs: r -- ) \ convert fp # into a string (in scientific notation) { $buf \ -- } $buf off --- 2067,2072 ---- base @ >r decimal (.) $buf +PLACE r> base ! ; ! : (E.) ( addr -- ; fs: r -- ) \ W32F Floating extra ! \ *G Format r as a string in scientific notation. { $buf \ -- } $buf off *************** *** 2080,2084 **** base @ >r decimal (.) $buf +PLACE r> base ! ; ! : (G.) ( addr -- ; fs: r -- ) \ convert fp # into a string fdepth 0 <= IF EXIT THEN --- 2083,2089 ---- base @ >r decimal (.) $buf +PLACE r> base ! ; ! : (G.) ( addr -- ; fs: r -- ) \ W32F Floating extra ! \ *G Format r as a string using scientific notation or ordinary representation according ! \ ** to the size of r. fdepth 0 <= IF EXIT THEN *************** *** 2091,2096 **** THEN ; ! SYNONYM (FS.) (E.) ( addr -- ; fs: r -- ) \ convert fp # into a string (in scientific notation) ! \ ----------------------------------------------------------------------------- --- 2096,2101 ---- THEN ; ! SYNONYM (FS.) (E.) ( addr -- ; fs: r -- ) \ W32F Floating extra ! \ *G Format r as a string in scientific notation. \ ----------------------------------------------------------------------------- |
