Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv19532/win32forth/src
Modified Files:
FLOAT.F
Log Message:
gah: Removed stack checking from (fsin) (fcos) and (fsincos) since >a2**63_frem2pi will have already checked, plus finished off dexing (at loooong last).
Index: FLOAT.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v
retrieving revision 1.44
retrieving revision 1.45
diff -C2 -d -r1.44 -r1.45
*** FLOAT.F 25 Apr 2006 10:24:56 -0000 1.44
--- FLOAT.F 19 May 2006 15:46:14 -0000 1.45
***************
*** 1093,1097 ****
code FSQRT ( fs: r1 -- r2 ) \ ANSI Floating ext
! \ *G r2 is the positive square root of r1.
fstack-check_1
>FPU
--- 1093,1097 ----
code FSQRT ( fs: r1 -- r2 ) \ ANSI Floating ext
! \ *G r2 is the positive square root of r1. r2 is NAN for negative r1.
fstack-check_1
>FPU
***************
*** 1169,1173 ****
code (fsin) ( fs: r1 -- r2 )
- fstack-check_1
>FPU
fsin
--- 1169,1172 ----
***************
*** 1176,1180 ****
code (fcos) ( fs: r1 -- r2 )
- fstack-check_1
>FPU
fcos
--- 1175,1178 ----
***************
*** 1183,1187 ****
code (fsincos) ( fs: r1 -- r2 r3 )
- fstack-check_1
>FPU
fsincos
--- 1181,1184 ----
***************
*** 1192,1196 ****
code frem2pi ( fs: r1 -- r2 )
- fstack-check_1
fld1
fldpi
--- 1189,1192 ----
***************
*** 1244,1248 ****
fld1
fsubpr st(1), st
- fabs
fsqrt
fpatan
--- 1240,1243 ----
***************
*** 1261,1265 ****
fsubpr st(1), st
fsqrt
- fabs
fxch st(1)
fpatan
--- 1256,1259 ----
***************
*** 1639,1646 ****
cell newuser mantsign
- \ cell newuser expsign \ seems to only be set to 0 !
cell newuser intcnt
cell newuser fracnt
- \ cell newuser expcnt \ seems to only be set to 0 !
cell newuser charcnt
cell newuser zerochar
--- 1633,1638 ----
***************
*** 1649,1653 ****
10 newuser fbcd-buf
! create $ftemp1 128 allot deprecated \ doesn't appear to be used!
: 10**n ( fs: -- r ) ( n -- ) \ 10 raised to n
--- 1641,1645 ----
10 newuser fbcd-buf
! \ create $ftemp1 128 allot deprecated \ doesn't appear to be used!
: 10**n ( fs: -- r ) ( n -- ) \ 10 raised to n
***************
*** 2190,2214 ****
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
- \ display floating point stack
- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
-
- 6 value show-fp-depth
-
- : f.s ( -- ) \ W32F Floating debug
- \ *G Display floating point stack.
- fdepth
- IF fdepth cr ." {" 1 .r ." } "
- show-fp-depth fdepth umin dup 1- swap 0
- DO 10 ?cr
- dup i - fpick g.
- LOOP drop
- ELSE ." Empty fp stack "
- THEN ;
-
- : .fdepth ( -- )
- ." Items; " fdepth .
- ." Bytes: " FLOATSP @ . ;
-
- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
--- 2182,2185 ----
***************
*** 2221,2226 ****
: f^2 fdup f* ;
- synonym fsqr fsqrt deprecated
-
: f>r r> rp@ b/float - rp! rp@ f! >r ; deprecated
--- 2192,2195 ----
***************
*** 2239,2242 ****
--- 2208,2237 ----
\ *N Debugging tools
+ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+ \ display floating point stack
+ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+
+ 6 value show-fp-depth
+
+ : f.s ( -- ) \ W32F Floating debug
+ \ *G Display floating point stack.
+ fdepth
+ IF fdepth cr ." {" 1 .r ." } "
+ show-fp-depth fdepth umin dup 1- swap 0
+ DO 10 ?cr
+ dup i - fpick g.
+ LOOP drop
+ ELSE ." Empty fp stack "
+ THEN ;
+
+ : .fdepth ( -- ) \ W32F Floating debug
+ \ *G Display depth of floating point stack.
+ ." Items; " fdepth .
+ ." Bytes: " FLOATSP @ . ;
+
+ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+ \ display state of FPU unit
+ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+
internal
***************
*** 2455,2477 ****
\s
- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
-
- ((
- \ FCALL from Bill McCarthy <WJ...@po...> March 15th, 1999
- \ commented out as fcall uses wrong call -- should be assembler call?
- code fcallret ( n1 -- ; fpu: r -- ; fs: -- r )
- mov ecx, FSP_MEMORY
- fstp FSIZE FSTACK_MEMORY
- add ecx, # B/FLOAT
- mov FSP_MEMORY , ecx
- pop ebx
- next,
- end-code
-
- \ Thanks to Andrew McKewan for the following idea:
- : fcall postpone call s" fcallret" evaluate ; immediate
- ))
-
\ *S Handling Errors
--- 2450,2453 ----
|
