Menu
▾
▴
[Win32forth-cvs] win32forth-stc/src float.f, 1.1, 1.2 optliterals.f, 1.2, 1.3 primutil.f, 1.12, 1.13
|
From: George H. <geo...@us...> - 2006-10-25 10:14:25
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv456/win32forth-stc/src Modified Files: float.f optliterals.f primutil.f Log Message: gah:Optimising version of offset, improved 1/f and changed mov-eax,#n to mov-tos,#n to match gkernel.f Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** primutil.f 6 Oct 2006 16:55:59 -0000 1.12 --- primutil.f 25 Oct 2006 10:13:32 -0000 1.13 *************** *** 109,115 **** in-application : offset ( n1 <-name-> -- ) \ compiling ( n2 -- n3 ) \ runtime n3=n1+n2 ! create , does> @ + ; : field+ ( n1 n2 <-name-> -- n3 ) \ compiling n3=n1+n2 stored offset=n1 --- 109,118 ---- in-application + : (comp-offs) ( xt -- ) + 0 swap execute postpone literal postpone + ; + : offset ( n1 <-name-> -- ) \ compiling ( n2 -- n3 ) \ runtime n3=n1+n2 ! create , ['] (comp-offs) compiles-last does> @ + ; : field+ ( n1 n2 <-name-> -- n3 ) \ compiling n3=n1+n2 stored offset=n1 Index: float.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/float.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** float.f 21 Sep 2006 16:26:33 -0000 1.1 --- float.f 25 Oct 2006 10:13:32 -0000 1.2 *************** *** 883,887 **** float; ! code FNEGATE ( fs: r1 -- r2 ) fstack-check_1 >FPU --- 883,888 ---- float; ! code FNEGATE ( fs: r1 -- r2 ) \ ANSI Floating ! \ *G Reverse the sign of r1. fstack-check_1 >FPU *************** *** 890,897 **** float; ! code f2/ ( fs: r1 -- r2 ) fstack-check_1 fld1 - fchs >FPU fscale --- 891,902 ---- float; ! : 1/f ( fs: r1 -- r2 ) \ W32F Floating extra ! \ *G r2 is the reciprocal of r1. ! f1.0 fswap f/ ; ! ! code f2* ( fs: r1 -- r2 ) \ W32F Floating extra ! \ *G Multiply by 2. fstack-check_1 fld1 >FPU fscale *************** *** 900,906 **** float; ! code f2* ( fs: r1 -- r2 ) \ ? overflow error fstack-check_1 fld1 >FPU fscale --- 905,913 ---- float; ! code f2/ ( fs: r1 -- r2 ) \ W32F Floating extra ! \ *G Divide by 2. fstack-check_1 fld1 + fchs >FPU fscale *************** *** 909,913 **** float; ! code FABS ( fs: r1 -- r2 ) fstack-check_1 >FPU --- 916,921 ---- float; ! code FABS ( fs: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the absolute value of r1. fstack-check_1 >FPU *************** *** 1379,1391 **** external - \ rbs January 26th, 2003 --> - \ : F** ( F: r1 r2 -- r3 ) - \ fdup fround fdup f>s f- \ r1 r4 - \ fdup f0= 0= - \ IF \ non-zero fractional part of exponent - \ fover fabs fln f* fexp fswap f**n f* - \ ELSE fdrop f**n - \ THEN ; - : f** ( F: r1 r2 -- r3 ) fswap fln f* fexp ; --- 1387,1390 ---- *************** *** 1469,1473 **** LOOP drop r> true ; ! ' rep-normal alias rep-denormal ( addr u -- n true ) ( f: r -- ) --- 1468,1472 ---- LOOP drop r> true ; ! ' rep-normal alias rep-denormal ( addr u -- n true ) ( f: r -- ) *************** *** 1918,1929 **** : f^2 fdup f* ; - \ : f^x fswap fln f* fexp ; - \ synonym f** f^x - - \ : fsqr f0.5 f** ; synonym fsqr fsqrt \ deprecated - : 1/f -1 f**n ; - : f>r r> rp@ b/float - rp! rp@ f! >r ; \ deprecated --- 1917,1922 ---- Index: optliterals.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optliterals.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** optliterals.f 24 Oct 2006 12:41:42 -0000 1.2 --- optliterals.f 25 Oct 2006 10:13:32 -0000 1.3 *************** *** 76,80 **** : lits>0? ( -- n ) lits sdepth ; : lits>1? ( -- n ) lits sdepth 1 > ; ! variable in-sync in-sync off \ to stop recursion in sync-code --- 76,80 ---- : lits>0? ( -- n ) lits sdepth ; : lits>1? ( -- n ) lits sdepth 1 > ; ! variable in-sync in-sync off \ to stop recursion in sync-code *************** *** 90,94 **** loop cells negate lea-ebp,n[ebp] \ adjust stack ! r> mov-eax,#n \ load eax else drop then --- 90,94 ---- loop cells negate lea-ebp,n[ebp] \ adjust stack ! r> mov-tos,#n \ load eax else drop then *************** *** 108,113 **** ' uniopt compiles-for not ' uniopt compiles-for 0<> ! ' uniopt compiles-for 0< ! ' uniopt compiles-for 0> ' uniopt compiles-for cells --- 108,113 ---- ' uniopt compiles-for not ' uniopt compiles-for 0<> ! ' uniopt compiles-for 0< ! ' uniopt compiles-for 0> ' uniopt compiles-for cells *************** *** 125,129 **** : litstart ( xt -- n ) \ drop the xt, get constant drop lits spop sync-code ; ! : opt@ ( xt -- ) lits>0? if litstart push-eax mov-eax,n else xt-inline, then ; : optc@ ( xt -- ) lits>0? if litstart push-eax movzx-eax,n else xt-inline, then ; --- 125,129 ---- : litstart ( xt -- n ) \ drop the xt, get constant drop lits spop sync-code ; ! : opt@ ( xt -- ) lits>0? if litstart push-eax mov-eax,n else xt-inline, then ; : optc@ ( xt -- ) lits>0? if litstart push-eax movzx-eax,n else xt-inline, then ; *************** *** 153,157 **** then ; ! : opt+! ( xt -- ) lits=1? if --- 153,157 ---- then ; ! : opt+! ( xt -- ) lits=1? if *************** *** 175,179 **** then ; ! ' litstack compiles-for literal ' litsync is sync-code --- 175,179 ---- then ; ! ' litstack compiles-for literal ' litsync is sync-code |
