Thread: [Win32forth-cvs] win32forth/src FLOAT.F,1.18,1.19

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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

Modified Files:
	FLOAT.F 
Log Message:
gah: More optimisations to produce shorter and faster code.

Index: FLOAT.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** FLOAT.F	3 Sep 2005 09:02:38 -0000	1.18
--- FLOAT.F	7 Nov 2005 13:19:27 -0000	1.19
***************
*** 32,35 ****
--- 32,37 ----
  \ dbu Sonntag, Juli 31 2005 changed the default display of the floating point stack in the debuger
  \                           from .FDEPTH to F.S
+ \ gah Sunday, November 6 2005 major changes to macros to reduce code size and increase speed
+ \                             and make code more easy to port to STC (work in progress)
  \ -------------------------------------------------------------------------
  
***************
*** 39,43 ****
  
  macro: DATASTACK_MEMORY      ( -- )
!                 0 [ebx] endm
  
  in-application
--- 41,45 ----
  
  macro: DATASTACK_MEMORY      ( -- )
!                 0 [tos] endm
  
  in-application
***************
*** 45,49 ****
  code >fregs     ( addr -- ) \ Restore x87 FPU State
                  frstor  DATASTACK_MEMORY
!                 pop     ebx
                  next,
                  end-code
--- 47,51 ----
  code >fregs     ( addr -- ) \ Restore x87 FPU State
                  frstor  DATASTACK_MEMORY
!                 pop     tos
                  next,
                  end-code
***************
*** 52,56 ****
                  fsave   DATASTACK_MEMORY
                  frstor  DATASTACK_MEMORY
!                 pop     ebx
                  next,
                  end-code
--- 54,58 ----
                  fsave   DATASTACK_MEMORY
                  frstor  DATASTACK_MEMORY
!                 pop     tos
                  next,
                  end-code
***************
*** 114,117 ****
--- 116,122 ----
                  FSTACK [ecx] [edx] endm
  
+ macro: +FSTACK_MEMORY ( n -- )
+                 FSTACK + [ecx] [edx] endm
+ 
  in-application
  
***************
*** 197,234 ****
  in-system
  
  \ makro to copy ST(0) on the seperate float stack
  macro:  (FPU>)
                  mov     ecx, FSP_MEMORY
!                 fstp    FSIZE FSTACK_MEMORY
                  endm
  
- \ makro to copy the top of the seperate float stack into st(0)
- macro:  (>FPU)
-                 mov     ecx, FSP_MEMORY
-                 sub     ecx, # B/FLOAT
-                 fld     FSIZE FSTACK_MEMORY
-                 endm
  
  \ makro to move ST(0) on the seperate float stack
  macro:  FPU>
                  (FPU>)
!                 add     ecx, # B/FLOAT
!                 mov     FSP_MEMORY , ecx
                  endm
  
  \ makro to move the top of the seperate float stack into st(0)
  macro:  >FPU
!                 (>FPU)
!                 mov     FSP_MEMORY , ecx
                  endm
  
  \ macro to move the top 2 values from the seperate float stack into st(0) and st(1)
  macro: 2>FPU
!                 (>FPU)
!                 sub     ecx, # B/FLOAT
!                 fld     FSIZE FSTACK_MEMORY
!                 mov     FSP_MEMORY , ecx
                  endm
  
  in-application
  
--- 202,254 ----
  in-system
  
+ false value fsp-cached?
+ 0 value fsp-adjust
+ 
  \ makro to copy ST(0) on the seperate float stack
  macro:  (FPU>)
+                 fsp-cached? 0= if
                  mov     ecx, FSP_MEMORY
!                 true to fsp-cached? then
!                 fstp    FSIZE fsp-adjust +FSTACK_MEMORY
                  endm
  
  
  \ makro to move ST(0) on the seperate float stack
  macro:  FPU>
                  (FPU>)
! \                add     ecx, # B/FLOAT
!                 B/FLOAT +to fsp-adjust
                  endm
  
  \ makro to move the top of the seperate float stack into st(0)
  macro:  >FPU
!                 fsp-cached? 0= if
!                 mov     ecx, FSP_MEMORY
!                 true to fsp-cached? then
! \                sub     ecx, # B/FLOAT
!                 b/float negate +to fsp-adjust
!                 fld     FSIZE fsp-adjust +FSTACK_MEMORY
!                 endm
! 
! \ makro to copy the top of the seperate float stack into st(0)
! macro:  (>FPU)
!                 >FPU
! \                add     ecx, # B/FLOAT
!                 b/float +to fsp-adjust
                  endm
  
  \ macro to move the top 2 values from the seperate float stack into st(0) and st(1)
  macro: 2>FPU
!                 >FPU >FPU
                  endm
  
+ \ macro to end float words
+ macro: float;
+                 fsp-adjust if
+                 add     ecx,  # fsp-adjust
+                 mov     FSP_MEMORY , ecx
+                 0 to fsp-adjust then
+                 false to fsp-cached? next ;c endm
+ 
  in-application
  
***************
*** 242,246 ****
           [ELSE] shl eax, # 3
           [THEN] mov     ecx, FSP_MEMORY
!                 sub     ecx, eax
                  js      short L$1
                  ret     \ stack is fine, return to caller
--- 262,266 ----
           [ELSE] shl eax, # 3
           [THEN] mov     ecx, FSP_MEMORY
!                 cmp     ecx, eax
                  js      short L$1
                  ret     \ stack is fine, return to caller
***************
*** 255,258 ****
--- 275,279 ----
                  mov     eax, # 1
                  call    fstack-check
+                 true to fsp-cached?
                  endm
  
***************
*** 261,264 ****
--- 282,286 ----
                  mov     eax, # 2
                  call    fstack-check
+                 true to fsp-cached?
                  endm
  
***************
*** 267,270 ****
--- 289,293 ----
                  mov     eax, # 3
                  call    fstack-check
+                 true to fsp-cached?
                  endm
  
***************
*** 280,285 ****
  
                  pop     ebx
!                 next,
!                 end-code
  
  code SF@        ( addr -- )  ( FS: -- r ) \ fetch a 32 bit (short) float
--- 303,307 ----
  
                  pop     ebx
!                 float;
  
  code SF@        ( addr -- )  ( FS: -- r ) \ fetch a 32 bit (short) float
***************
*** 288,293 ****
  
                  pop     ebx
!                 next,
!                 end-code
  
  code DF@        ( addr -- )  ( FS: -- r ) \ fetch a 64 bit (double) float
--- 310,314 ----
  
                  pop     ebx
!                 float;
  
  code DF@        ( addr -- )  ( FS: -- r ) \ fetch a 64 bit (double) float
***************
*** 296,301 ****
  
                  pop     ebx
!                 next,
!                 end-code
  
  code F!         ( addr -- )  ( fs: r -- ) \ store a float
--- 317,321 ----
  
                  pop     ebx
!                 float;
  
  code F!         ( addr -- )  ( fs: r -- ) \ store a float
***************
*** 306,311 ****
  
                  pop     ebx
!                 next,
!                 end-code
  
  code SF!        ( addr -- )  ( fs: r -- ) \ store a 32 bit (short) float
--- 326,330 ----
  
                  pop     ebx
!                 float;
  
  code SF!        ( addr -- )  ( fs: r -- ) \ store a 32 bit (short) float
***************
*** 316,321 ****
  
                  pop     ebx
!                 next,
!                 end-code
  
  code DF!        ( addr -- )  ( fs: r -- ) \ store a 64 bit (double) float
--- 335,339 ----
  
                  pop     ebx
!                 float;
  
  code DF!        ( addr -- )  ( fs: r -- ) \ store a 64 bit (double) float
***************
*** 326,331 ****
  
                  pop     ebx
!                 next,
!                 end-code
  
  code F+!        ( addr -- ) ( fs: r -- )        \ ? overflow error
--- 344,348 ----
  
                  pop     ebx
!                 float;
  
  code F+!        ( addr -- ) ( fs: r -- )        \ ? overflow error
***************
*** 338,343 ****
  
                  pop     bx
!                 next,
!                 end-code
  
  : F,            ( -- ) ( F: r -- ) \ compile a float
--- 355,359 ----
  
                  pop     bx
!                 float;
  
  : F,            ( -- ) ( F: r -- ) \ compile a float
***************
*** 347,352 ****
                  fld     FSIZE DATASTACK_MEMORY
                  pop     ebx
!                 next,
!                 end-code DEPRECATED
  
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
--- 363,367 ----
                  fld     FSIZE DATASTACK_MEMORY
                  pop     ebx
!                 float; DEPRECATED
  
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
***************
*** 369,374 ****
  
                          pop     ebx
!                         next,
!                 end-code
  
  in-application
--- 384,388 ----
  
                          pop     ebx
!                 float;
  
  in-application
***************
*** 381,386 ****
                  fstp    FSIZE DATASTACK_MEMORY
                  pop     ebx
!                 next,
!                 end-code
  
  in-system
--- 395,399 ----
                  fstp    FSIZE DATASTACK_MEMORY
                  pop     ebx
!                 float;
  
  in-system
***************
*** 405,410 ****
                  FPU>
  
!                 next,
!                 end-code DEPRECATED
  
  code fpop       ( f: -- r )   ( fs: r -- )  \ move from simulated stack on FPU stack
--- 418,422 ----
                  FPU>
  
!                 float; DEPRECATED
  
  code fpop       ( f: -- r )   ( fs: r -- )  \ move from simulated stack on FPU stack
***************
*** 413,418 ****
                  >FPU
  
!                 next,
!                 end-code DEPRECATED
  
  code FDROP      ( fs: r -- )
--- 425,429 ----
                  >FPU
  
!                 float; DEPRECATED
  
  code FDROP      ( fs: r -- )
***************
*** 431,436 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code FSWAP      ( fs: r1 r2 -- r2 r1 )
--- 442,446 ----
                  FPU>
  
!                 float;
  
  code FSWAP      ( fs: r1 r2 -- r2 r1 )
***************
*** 443,448 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code FOVER      ( fs: r1 r2 -- r1 r2 r3 )
--- 453,457 ----
                  FPU>
  
!                 float;
  
  code FOVER      ( fs: r1 r2 -- r1 r2 r3 )
***************
*** 458,463 ****
                  mov     FSP_MEMORY , ecx
  
!                 next,
!                 end-code
  
  code FROT       ( fs: r1 r2 r3 -- r2 r3 r1 )
--- 467,471 ----
                  mov     FSP_MEMORY , ecx
  
!                 float;
  
  code FROT       ( fs: r1 r2 r3 -- r2 r3 r1 )
***************
*** 479,484 ****
                  fstp    FSIZE FSTACK_MEMORY
  
!                 next,
!                 end-code
  
  code FPICK      ( n -- ) ( fs: -- r )
--- 487,491 ----
                  fstp    FSIZE FSTACK_MEMORY
  
!                 float;
  
  code FPICK      ( n -- ) ( fs: -- r )
***************
*** 503,508 ****
  
                  pop     ebx
!                 next,
!                 end-code
  
  : FNIP          ( fs: r1 r2 -- r2 )
--- 510,514 ----
  
                  pop     ebx
!                 float;
  
  : FNIP          ( fs: r1 r2 -- r2 )
***************
*** 537,542 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code f1.0       ( fs: -- r )
--- 543,547 ----
                  FPU>
  
!                 float;
  
  code f1.0       ( fs: -- r )
***************
*** 544,549 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code fL2t       ( fs: -- r )            \ log base 2 of 10
--- 549,553 ----
                  FPU>
  
!                 float;
  
  code fL2t       ( fs: -- r )            \ log base 2 of 10
***************
*** 551,556 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code fL2e       ( fs: -- r )             \ log base 2 of e
--- 555,559 ----
                  FPU>
  
!                 float;
  
  code fL2e       ( fs: -- r )             \ log base 2 of e
***************
*** 558,563 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code fLog2      ( fs: -- r )            \ log base 10 of 2
--- 561,565 ----
                  FPU>
  
!                 float;
  
  code fLog2      ( fs: -- r )            \ log base 10 of 2
***************
*** 565,570 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code fLn2       ( fs: -- r )            \ ln 2   natural logarithm
--- 567,571 ----
                  FPU>
  
!                 float;
  
  code fLn2       ( fs: -- r )            \ ln 2   natural logarithm
***************
*** 572,577 ****
                  FPU>
  
!                 next,
!                 end-code
  
  B/FLOAT 10 =                    nostack
--- 573,577 ----
                  FPU>
  
!                 float;
  
  B/FLOAT 10 =                    nostack
***************
*** 677,682 ****
          [IF]    add     esi, # 12        \ to keep dword alignment !
          [ELSE]  add     esi, # 8
!         [THEN]  next,
!                 end-code
  
  0 value &flit
--- 677,681 ----
          [IF]    add     esi, # 12        \ to keep dword alignment !
          [ELSE]  add     esi, # 8
!         [THEN]  float;
  
  0 value &flit
***************
*** 746,751 ****
                  pop     ebx
  
!                 next,
!                 end-code
  
  code FCEIL      ( fs: f1 -- fs: f2 )            \ Added 3/13/99 rls
--- 745,749 ----
                  pop     ebx
  
!                 float;
  
  code FCEIL      ( fs: f1 -- fs: f2 )            \ Added 3/13/99 rls
***************
*** 755,760 ****
                  pop     ebx
  
!                 next,
!                 end-code
  
  code FTRUNC     ( fs: f1 -- fs: f2 )            \ Added 3/13/99 rls
--- 753,757 ----
                  pop     ebx
  
!                 float;
  
  code FTRUNC     ( fs: f1 -- fs: f2 )            \ Added 3/13/99 rls
***************
*** 764,769 ****
                  pop     ebx
  
!                 next,
!                 end-code
  
  code FROUND     ( fs: f1 -- fs: f2 )
--- 761,765 ----
                  pop     ebx
  
!                 float;
  
  code FROUND     ( fs: f1 -- fs: f2 )
***************
*** 773,778 ****
                  pop     ebx
  
!                 next,
!                 end-code
  
  
--- 769,773 ----
                  pop     ebx
  
!                 float;
  
  
***************
*** 790,795 ****
                  FPU>
  
!                 next,
!                 end-code
  
  \ Changed 3/13/99 rls
--- 785,789 ----
                  FPU>
  
!                 float;
  
  \ Changed 3/13/99 rls
***************
*** 807,812 ****
                  xchg    ebx, 0 [esp]
  
!                 next,
!                 end-code
  
  code ZF>D       ( -- d )  ( fs: r -- )  \ ? out of range errors ?
--- 801,805 ----
                  xchg    ebx, 0 [esp]
  
!                 float;
  
  code ZF>D       ( -- d )  ( fs: r -- )  \ ? out of range errors ?
***************
*** 818,823 ****
                  xchg    ebx, 0 [esp]
  
!                 next,
!                 end-code
  
  : s>f           s>d d>f ;
--- 811,815 ----
                  xchg    ebx, 0 [esp]
  
!                 float;
  
  : s>f           s>d d>f ;
***************
*** 853,858 ****
                  (fcomp)
  
!                 next,
!                 end-code
  
  code ftstp      ( -- flags )  ( fs: r1 -- )
--- 845,849 ----
                  (fcomp)
  
!                 float;
  
  code ftstp      ( -- flags )  ( fs: r1 -- )
***************
*** 864,869 ****
                  fstp    st \ pop
  
!                 next,
!                 end-code
  
  external
--- 855,859 ----
                  fstp    st \ pop
  
!                 float;
  
  external
***************
*** 897,902 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code F-         ( fs: r1 r2 -- r3 )             \ ? overflow errors
--- 887,891 ----
                  FPU>
  
!                 float;
  
  code F-         ( fs: r1 r2 -- r3 )             \ ? overflow errors
***************
*** 908,913 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code F*         ( fs: r1 r2 -- r3 )             \ ? overflow errors
--- 897,901 ----
                  FPU>
  
!                 float;
  
  code F*         ( fs: r1 r2 -- r3 )             \ ? overflow errors
***************
*** 918,923 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code F/         ( fs: r1 r2 -- r3 )     \ ? error for ofl or /0 ?
--- 906,910 ----
                  FPU>
  
!                 float;
  
  code F/         ( fs: r1 r2 -- r3 )     \ ? error for ofl or /0 ?
***************
*** 929,934 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code FATAN2     ( fs: r1 r2 -- r3 )              \ OK for valid args
--- 916,920 ----
                  FPU>
  
!                 float;
  
  code FATAN2     ( fs: r1 r2 -- r3 )              \ OK for valid args
***************
*** 940,945 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code FNEGATE    ( fs: r1 -- r2 )
--- 926,930 ----
                  FPU>
  
!                 float;
  
  code FNEGATE    ( fs: r1 -- r2 )
***************
*** 950,955 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code f2/        ( fs: r1 -- r2 )
--- 935,939 ----
                  FPU>
  
!                 float;
  
  code f2/        ( fs: r1 -- r2 )
***************
*** 963,968 ****
                  fstp    st(0)
  
!                 next,
!                 end-code
  
  code f2*        ( fs: r1 -- r2 )                \ ? overflow error
--- 947,951 ----
                  fstp    st(0)
  
!                 float;
  
  code f2*        ( fs: r1 -- r2 )                \ ? overflow error
***************
*** 975,980 ****
                  fstp    st(0)
  
!                 next,
!                 end-code
  
  code FABS       ( fs: r1 -- r2 )
--- 958,962 ----
                  fstp    st(0)
  
!                 float;
  
  code FABS       ( fs: r1 -- r2 )
***************
*** 985,990 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code FSQRT      ( fs: r1 -- r2 )
--- 967,971 ----
                  FPU>
  
!                 float;
  
  code FSQRT      ( fs: r1 -- r2 )
***************
*** 996,1001 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code FLN        ( fs: r1 -- r2 )
--- 977,981 ----
                  FPU>
  
!                 float;
  
  code FLN        ( fs: r1 -- r2 )
***************
*** 1008,1013 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code FACOSH     ( fs: r1 -- r2 )        \ ? error for x < 1
--- 988,992 ----
                  FPU>
  
!                 float;
  
  code FACOSH     ( fs: r1 -- r2 )        \ ? error for x < 1
***************
*** 1027,1032 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code FASINH     ( fs: r1 -- r2 )        \ Note: well defined for r1 < 0
--- 1006,1010 ----
                  FPU>
  
!                 float;
  
  code FASINH     ( fs: r1 -- r2 )        \ Note: well defined for r1 < 0
***************
*** 1044,1049 ****
                  FPU>
  
!                 next,
!                 end-code
  
  internal
--- 1022,1026 ----
                  FPU>
  
!                 float;
  
  internal
***************
*** 1056,1061 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code (fcos)     ( f: r1 -- r2 )
--- 1033,1037 ----
                  FPU>
  
!                 float;
  
  code (fcos)     ( f: r1 -- r2 )
***************
*** 1066,1071 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code (fsincos)  ( f: r1 -- r2 r3 )
--- 1042,1046 ----
                  FPU>
  
!                 float;
  
  code (fsincos)  ( f: r1 -- r2 r3 )
***************
*** 1078,1083 ****
                  FPU>
  
!                 next,
!                 end-code
  
  \ January 13th, 1998 - 9:33 tjz for RLS
--- 1053,1057 ----
                  FPU>
  
!                 float;
  
  \ January 13th, 1998 - 9:33 tjz for RLS
***************
*** 1098,1103 ****
                  fstp    st(0)
  
!                 next,
!                 end-code
  
  : >a2**63_frem2pi ( f: r1 -- r2 )
--- 1072,1076 ----
                  fstp    st(0)
  
!                 float;
  
  : >a2**63_frem2pi ( f: r1 -- r2 )
***************
*** 1159,1164 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code FEXPM1     ( fs: r1 -- r2 )        \ ? overflow error
--- 1132,1136 ----
                  FPU>
  
!                 float;
  
  code FEXPM1     ( fs: r1 -- r2 )        \ ? overflow error
***************
*** 1258,1263 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code FACOS      ( fs: r1 -- r2 )        \ result for |x| > 1 is NAN
--- 1230,1234 ----
                  FPU>
  
!                 float;
  
  code FACOS      ( fs: r1 -- r2 )        \ result for |x| > 1 is NAN
***************
*** 1276,1281 ****
                  FPU>
  
!                 next,
!                 end-code
  
  code FASIN      ( fs: r1 -- r2 )        \ result for |x| > 1 is NAN
--- 1247,1251 ----
                  FPU>
  
!                 float;
  
  code FASIN      ( fs: r1 -- r2 )        \ result for |x| > 1 is NAN
***************
*** 1293,1298 ****
                  FPU>
  
!                 next,
!                 end-code
  
  internal
--- 1263,1267 ----
                  FPU>
  
!                 float;
  
  internal
***************
*** 2316,2317 ****
--- 2285,2287 ----
  L$2:            next,
                  end-code
+

Thread: [Win32forth-cvs] win32forth/src FLOAT.F,1.18,1.19

win32forth-cvs