Menu
▾
▴
[Win32forth-cvs] win32forth-stc/src float.f, 1.2, 1.3 optliterals.f, 1.6, 1.7
|
From: Alex M. <ale...@us...> - 2006-10-31 00:06:36
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv26964 Modified Files: float.f optliterals.f Log Message: arm: various updates; start of type system, improve optimisation, minor correction to float Index: float.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/float.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** float.f 25 Oct 2006 10:13:32 -0000 1.2 --- float.f 31 Oct 2006 00:06:31 -0000 1.3 *************** *** 387,391 **** : FTO state @ \ compiletime: ( FS: n - ) ( -<name_fvalue>- ) ! if postpone ['] postpone _fto else ' _fto \ runtime: ( FS: n - ) ( 'fvalue - ) then ; IMMEDIATE --- 387,392 ---- : FTO state @ \ compiletime: ( FS: n - ) ( -<name_fvalue>- ) ! \ if postpone ['] postpone _fto ! if ' postpone literal postpone _fto else ' _fto \ runtime: ( FS: n - ) ( 'fvalue - ) then ; IMMEDIATE Index: optliterals.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optliterals.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** optliterals.f 30 Oct 2006 09:15:14 -0000 1.6 --- optliterals.f 31 Oct 2006 00:06:31 -0000 1.7 *************** *** 9,13 **** \ \ Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com) ! \ Dirk Busch (dirk at win32forth.org) \ George Hubert (georgeahubert at yahoo.co.uk) \ --- 9,13 ---- \ \ Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com) ! \ Dirk Busch (dirk.yahoo @ schneider-busch.de) \ George Hubert (georgeahubert at yahoo.co.uk) \ *************** *** 32,39 **** \ ------------------------------------------------------------------------ ! cr .( Loading Constants & literals optimisation ) also optimise definitions 100 stack lits --- 32,51 ---- \ ------------------------------------------------------------------------ ! cr .( Loading optimiser [literals]...) ! ! [undefined] optimise [if] ! vocabulary optimise ! : xt-inline, ( xt -- ) \ inline the xt ! dup >name n>ofa \ get the length ! w@ copy-code ; \ and copy the code ! [then] also optimise definitions + :noname drop postpone cell postpone + ; compiles-for cell+ + :noname drop postpone -cell postpone + ; compiles-for cell- + :noname drop 1 postpone literal postpone - ; dup compiles-for 1- + :noname drop 1 postpone literal postpone + ; dup compiles-for 1+ compiles-for char+ + 100 stack lits *************** *** 43,71 **** reset-stack-chain chain-add reset-lits ! : mov-n[ebp],eax { n } macro[ mov n [ebp], eax ]macro ; ! : movzx-eax,n { addr -- } macro[ movzx eax, byte addr ]macro ; ! : mov-n[ebp],#n { n off } macro[ mov off [ebp], dword # n ]macro ; ! : lea-ebp,n[ebp] { n } macro[ lea ebp, n [ebp] ]macro ; ! : mov-eax,n { addr } macro[ mov eax, addr ]macro ; ! : mov-eax,n[ebp] { off } macro[ mov eax, off [ebp] ]macro ; ! : pop-eax { } 0 mov-eax,n[ebp] 4 lea-ebp,n[ebp] ; ! : push-eax { } -4 mov-n[ebp],eax -4 lea-ebp,n[ebp] ; ! : shl-eax,n { n } macro[ shl eax, n ]macro ; ! : shr-eax,n { n } macro[ shr eax, n ]macro ; ! : and-eax,#n { n } n -1 <> if macro[ and eax, # n ]macro then ; ! : or-eax,#n { n } n if macro[ or eax, # n ]macro then ; ! : xor-eax,#n { n } n if macro[ xor eax, # n ]macro then ; ! : mov-n,eax { n } macro[ mov n , eax ]macro ; ! : add-n,eax { n } macro[ add n , eax ]macro ; ! : mov-n,#n { addr n } macro[ mov addr , dword # n ]macro ; ! : add-n,#n { addr n } n if macro[ add addr , dword # n ]macro then ; ! : add-eax,#n { n } n if macro[ add eax, # n ]macro then ; ! : sub-eax,#n { n } n negate add-eax,#n ; ! : mov-n,al { n } macro[ mov n , al ]macro ; ! : mov-n,#c { addr n } macro[ mov addr , # n ]macro ; ! : loop-add { n } macro[ add [esp], dword # n jno 0 ]macro ; ! : setcc { } macro[ cmp eax, # 1 sbb eax, eax ]macro ; : litstack ( n xt -- ) \ stack literal --- 55,123 ---- reset-stack-chain chain-add reset-lits ! 0 value std-delay ! : std-adjust ( -- ) \ generate delayed stack adjust ! std-delay if ! macro[ lea ebp, std-delay negate cells [ebp] ]macro ! 0 to std-delay ! then ; ! : std+n { n } \ adjust stack ! macro[ lea ebp, n negate cells [ebp] ]macro ; ! \ addressing the data stack ! \ std[0] refers to top of stack (eax in this case) ! \ std[-1] is next left (as in a stack diagram) ! \ std[1] is a new right stack entry ! ! macro: std[] ( n -- ) \ generate code to address stack entry n ! dup if ! dup 0< if 1+ then ! negate cells [ebp] ! else drop eax then ;m ! ! macro: std[-1] -1 std[] ;m \ next of stack ! macro: std[0] 0 std[] ;m \ top of stack ! macro: std[1] 1 std[] ;m \ new on stack ! ! ! : mov-tos,n[ebp] { off } macro[ mov eax, off [ebp] ]macro ; ! : mov-n[ebp],tos { off } macro[ mov off [ebp], eax ]macro ; ! ! macro: std[],# std[] , dword # ;m ! ! : #n->std[] { n off } ! n if ! n -1 = if macro[ or off std[],# n ]macro ! else macro[ mov off std[],# n ]macro ! then ! else macro[ and off std[],# n ]macro ! then ; ! ! : pop-tos { } 0 mov-tos,n[ebp] -1 std+n ; ! : push-tos { } -4 mov-n[ebp],tos 1 std+n ; ! ! macro: tos,#n ( n ) eax, # ;m \ macro: supports asm fragments ! ! : var->tos { var } macro[ mov eax, var ]macro ; ! : cvar->tos { var } macro[ movzx eax, byte var ]macro ; ! : #n->tos ( n ) >r macro[ mov r@ tos,#n ]macro r>drop ; ! : tos->var { var } macro[ mov var , eax ]macro ; ! : tos->cvar { var } macro[ mov var , al ]macro ; ! : #n->var { var n } macro[ mov var , dword # n ]macro ; ! : #n->cvar { var c } macro[ mov var , byte # c ]macro ; ! ! : add-v,tos { var } macro[ add var , eax ]macro ; ! : add-v,#n { var n } n if macro[ add var , dword # n ]macro then ; ! : add-tos,#n ( n ) dup if >r macro[ add r@ tos,#n ]macro r>drop else drop then ; ! : sub-tos,#n ( n ) >r macro[ sub r@ tos,#n ]macro r>drop ; ! : shl-tos,#n ( n ) >r macro[ shl r@ tos,#n ]macro r>drop ; ! : shr-tos,#n ( n ) >r macro[ shr r@ tos,#n ]macro r>drop ; ! : and-tos,#n ( n ) >r macro[ and r@ tos,#n ]macro r>drop ; ! : or-tos,#n ( n ) >r macro[ or r@ tos,#n ]macro r>drop ; ! : xor-tos,#n ( n ) >r macro[ xor r@ tos,#n ]macro r>drop ; ! : not-tos ( -- ) macro[ not eax ]macro ; ! ! : loop-add { n } macro[ add [esp], dword # n jno 0 ]macro ; ! : setcc { } macro[ cmp eax, # 1 sbb eax, eax ]macro ; : litstack ( n xt -- ) \ stack literal *************** *** 84,96 **** in-sync @ 0= if \ recursing? in-sync on \ no, so set lits>0? dup if \ anything to do? ! lits spop >r \ save last entry (it's eax) ! -4 mov-n[ebp],eax \ save eax lits sdepth 0 ?do \ do for n-1 entries ! lits spop over negate i + cells ! mov-n[ebp],#n \ generate a move loop ! cells negate lea-ebp,n[ebp] \ adjust stack ! r> mov-tos,#n \ load eax else drop then --- 136,148 ---- in-sync @ 0= if \ recursing? in-sync on \ no, so set + std-adjust lits>0? dup if \ anything to do? ! -4 mov-n[ebp],tos \ save tos ! lits spop #n->tos \ load tos lits sdepth 0 ?do \ do for n-1 entries ! lits spop over i - ! #n->std[] \ generate a move loop ! std+n \ adjust stack else drop then *************** *** 110,118 **** ' uniopt compiles-for not ' uniopt compiles-for 0<> ! ' uniopt compiles-for 0< ! ' uniopt compiles-for 0> ' uniopt compiles-for cells ! \ ' binopt compiles-for <> ' binopt compiles-for < ' binopt compiles-for > --- 162,170 ---- ' uniopt compiles-for not ' uniopt compiles-for 0<> ! ' uniopt compiles-for 0< ! ' uniopt compiles-for 0> ' uniopt compiles-for cells ! ' binopt compiles-for <> ' binopt compiles-for < ' binopt compiles-for > *************** *** 127,155 **** : 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 ; : optpick ( xt -- ) lits>0? if ! litstart push-eax cells dup if ! mov-eax,n[ebp] else drop then else xt-inline, then ; ! : opt+ ( xt -- ) lits=1? if litstart add-eax,#n else binopt then ; ! : opt- ( xt -- ) lits=1? if litstart sub-eax,#n else binopt then ; ! : optlshift ( xt -- ) lits=1? if litstart shl-eax,n else binopt then ; ! : optrshift ( xt -- ) lits=1? if litstart shr-eax,n else binopt then ; ! : optand ( xt -- ) lits=1? if litstart and-eax,#n else binopt then ; ! : optor ( xt -- ) lits=1? if litstart or-eax,#n else binopt then ; ! : optxor ( xt -- ) lits=1? if litstart xor-eax,#n else binopt then ; ! : opt= ( xt -- ) lits=1? if litstart sub-eax,#n setcc else binopt then ; ! : opt<> ( xt -- ) lits=1? if litstart sub-eax,#n setcc ! macro[ not eax ]macro else binopt then ; : opt! ( xt -- ) lits=1? if ! litstart mov-n,eax pop-eax else lits>1? if ! drop lits s2pop mov-n,#n else xt-inline, --- 179,206 ---- : litstart ( xt -- n ) \ drop the xt, get constant drop lits spop sync-code ; ! ! : opt@ ( xt -- ) lits>0? if litstart push-tos var->tos else xt-inline, then ; ! : optc@ ( xt -- ) lits>0? if litstart push-tos cvar->tos else xt-inline, then ; : optpick ( xt -- ) lits>0? if ! litstart push-tos cells dup if ! mov-tos,n[ebp] else drop then else xt-inline, then ; ! : opt+ ( xt -- ) lits=1? if litstart add-tos,#n else binopt then ; ! : opt- ( xt -- ) lits=1? if litstart sub-tos,#n else binopt then ; ! : optlshift ( xt -- ) lits=1? if litstart shl-tos,#n else binopt then ; ! : optrshift ( xt -- ) lits=1? if litstart shr-tos,#n else binopt then ; ! : optand ( xt -- ) lits=1? if litstart and-tos,#n else binopt then ; ! : optor ( xt -- ) lits=1? if litstart or-tos,#n else binopt then ; ! : optxor ( xt -- ) lits=1? if litstart xor-tos,#n else binopt then ; ! : opt= ( xt -- ) lits=1? if litstart sub-tos,#n setcc else binopt then ; ! : opt<> ( xt -- ) lits=1? if litstart sub-tos,#n setcc not-tos else binopt then ; : opt! ( xt -- ) lits=1? if ! litstart tos->var pop-tos else lits>1? if ! drop lits s2pop #n->var else xt-inline, *************** *** 157,166 **** then ; ! : opt+! ( xt -- ) lits=1? if ! litstart add-n,eax pop-eax else lits>1? if ! drop lits s2pop add-n,#n else xt-inline, --- 208,217 ---- then ; ! : opt+! ( xt -- ) lits=1? if ! litstart add-v,tos pop-tos else lits>1? if ! drop lits s2pop add-v,#n else xt-inline, *************** *** 171,177 **** : optc! ( xt -- ) lits=1? if ! litstart mov-n,al pop-eax else lits>1? if ! drop lits s2pop mov-n,#c else xt-inline, --- 222,228 ---- : optc! ( xt -- ) lits=1? if ! litstart tos->cvar pop-tos else lits>1? if ! drop lits s2pop #n->cvar else xt-inline, *************** *** 179,183 **** then ; ! ' litstack compiles-for literal ' litsync is sync-code --- 230,234 ---- then ; ! ' litstack compiles-for literal ' litsync is sync-code *************** *** 200,206 **** - :noname drop postpone cell postpone + ; compiles-for cell+ - :noname drop postpone -cell postpone + ; compiles-for cell- - :noname drop 1 postpone literal postpone + ; dup compiles-for 1+ compiles-for char+ - previous definitions --- 251,253 ---- |
