Menu
▾
▴
[Win32forth-cvs] win32forth-stc/src optliterals.f,1.7,1.8
|
From: Alex M. <ale...@us...> - 2006-11-05 23:35:00
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv27513 Modified Files: optliterals.f Log Message: arm: better optimisation Index: optliterals.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optliterals.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** optliterals.f 31 Oct 2006 00:06:31 -0000 1.7 --- optliterals.f 5 Nov 2006 23:34:56 -0000 1.8 *************** *** 41,49 **** [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+ --- 41,84 ---- [then] + code s-reverse ( n[k]..2 1 0 k -- 0 1 2..n[k] ) \ w32f + \ *g reverse n items on stack \n + \ ** usage: 1 2 3 4 5 5 s-reverse ==> 5 4 3 2 1 + lea ecx, -4 [ebp] \ ecx points 4 under top of stack + lea eax, 4 [ecx] [eax*4] \ eax points 4 over stack + \ bump pointers, if they overlap, stop + @@1: sub eax, # 4 \ adjust top + add ecx, # 4 \ adjust bottom + cmp ecx, eax \ compare + jae short @@2 \ ecx passing ebx, so exit + \ rotate a pair + mov edx, 0 [eax] \ bottom to edx + xor 0 [ecx], edx \ exchange top and edx + xor edx, 0 [ecx] + xor 0 [ecx], edx + mov 0 [eax], edx \ eax to bottom + jmp short @@1 \ next pair + + @@2: mov eax, [ebp] + lea ebp, 4 [ebp] + next c; + also optimise definitions + (( no stack effects; needs work + 1 constant nse \ no side effects + + : compiles-nse ( xt -- ) \ compiles-for and no side effects + ' dup>r (compiles-set) \ set the compiling word + r> >name n>flg dup sc@ nse or swap c! ; + + : nse? ( nfa -- flag ) \ is this no side effects? + n>flg c@ nse and ; + )) + + :noname drop 4 postpone literal ; compiles-for cell :noname drop postpone cell postpone + ; compiles-for cell+ :noname drop postpone -cell postpone + ; compiles-for cell- ! :noname drop postpone cells postpone + ; compiles-for cells+ ! :noname drop 1 postpone literal postpone - ; compiles-for 1- :noname drop 1 postpone literal postpone + ; dup compiles-for 1+ compiles-for char+ *************** *** 84,88 **** : mov-n[ebp],tos { off } macro[ mov off [ebp], eax ]macro ; ! macro: std[],# std[] , dword # ;m : #n->std[] { n off } --- 119,123 ---- : mov-n[ebp],tos { off } macro[ mov off [ebp], eax ]macro ; ! macro: std[],# std[] , dword # ;m : #n->std[] { n off } *************** *** 113,116 **** --- 148,152 ---- : 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 ; + : sar-tos,#n ( n ) >r macro[ sar 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 ; *************** *** 120,123 **** --- 156,160 ---- : loop-add { n } macro[ add [esp], dword # n jno 0 ]macro ; : setcc { } macro[ cmp eax, # 1 sbb eax, eax ]macro ; + : imul-tos,#n ( n ) $C069 code-w, code-, ; \ no opcode for this? imul eax, # n : litstack ( n xt -- ) \ stack literal *************** *** 150,200 **** then ; ! : uniopt ( xt -- ) \ unary ops where 1 literal; execute it ! lits>0? if lits spop swap execpush else xt-inline, then ; ! : binopt ( xt -- ) \ binary ops where 2 literals; execute it ! lits>1? if lits s2pop swap rot execpush else xt-inline, then ; ! ' uniopt compiles-for invert ! ' uniopt compiles-for negate ! ' uniopt compiles-for 0= ! ' 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 > ! ' binopt compiles-for <= ! ' binopt compiles-for >= ! ' binopt compiles-for arshift ! ' binopt compiles-for * ! ' binopt compiles-for / : 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 -- ) --- 187,287 ---- then ; + + ' litstack compiles-for literal + ' litsync is sync-code ! : opt/ ( xt -- ) lits>1? if lits s2pop swap rot execpush else xt-inline, then ; ! : opt= sub-tos,#n setcc ; ! : opt<> sub-tos,#n setcc not-tos ; ! : opt< sub-tos,#n postpone 0< ; ! : opt<= 1+ opt< ; ! : opt>= opt< not-tos ; ! : opt> opt<= not-tos ; ! : optswap 1 #n->std[] 1 std+n ; ! create opt-lit-table1 ! \ Only add entries with optimising code, or those with stack effects [...] n -- [...] ! \ where n can be a literal. ! ' + , ' add-tos,#n , ! ' - , ' sub-tos,#n , ! ' * , ' imul-tos,#n , ! ' and , ' and-tos,#n , ! ' or , ' or-tos,#n , ! ' xor , ' xor-tos,#n , ! ' = , ' opt= , ! ' <> , ' opt<> , ! ' < , ' opt< , ! ' <= , ' opt<= , ! ' >= , ' opt>= , ! ' > , ' opt> , ! ' 0= , ' setcc , ! ' 0<> , ' xt-inline, , ! ' 0< , ' xt-inline, , ! ' 0> , ' xt-inline, , ! ' not , ' setcc , ! ' invert , ' xt-inline, , ! ' negate , ' xt-inline, , ! ' lshift , ' shl-tos,#n , ! ' rshift , ' shr-tos,#n , ! ' arshift , ' sar-tos,#n , ! ' cells , ' xt-inline, , ! ' dup , ' xt-inline, , ! ' drop , ' xt-inline, , ! ' swap , ' optswap , ! ' nip , ' xt-inline, , ! 0 , 0 , ! : nseopt ( xt -- ) \ code gen for no-side-effect type words ! dup >name \ xt nfa ! (in/out@) \ get the in/out stack effects ! over lits sdepth <= if \ if we have enough input literals ! >r swap >r \ save the output count & the xt ! dup>r 0 ?do lits spop loop \ get literals onto the stack ! r> s-reverse \ reverse the order ! r> execute \ execute the word ! r> 0 ?do lits spush loop \ push outputs back on literal stack ! exit ! then 2drop \ drop the in/out ! lits>0? if \ might be a single literal operation ! >r opt-lit-table1 \ save xt on rstack, the table ! begin dup @ dup \ fetch the entry ! while ! r@ = if \ if a match ! r> drop \ no longer need the xt ! lits spop sync-code \ pop the literal, sync the code ! swap cell+ @ execute \ get the xt from table, go do ! exit \ and finish ! then ! 2 cells+ \ next entry ! repeat drop \ otherwise just drop it ! then ! xt-inline, ; \ else just inline it ! ! :noname ( -- ) \ set nseopt as the optimiser for specified xts ! ['] nseopt >r \ the optimisation code to run ! opt-lit-table1 \ the table ! begin dup @ dup \ fetch the entry ! while ! r@ swap (compiles-set) ! 2 cells+ \ next entry ! repeat r>drop 2drop ; execute \ do it now : litstart ( xt -- n ) \ drop the xt, get constant drop lits spop sync-code ; ! : 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>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 ; : opt! ( xt -- ) *************** *** 208,212 **** then ; ! : opt+! ( xt -- ) lits=1? if --- 295,299 ---- then ; ! : opt+! ( xt -- ) lits=1? if *************** *** 230,253 **** then ; - - ' litstack compiles-for literal - ' litsync is sync-code ! ' opt+ compiles-for + ! ' opt- compiles-for - ' opt@ compiles-for @ ' optc@ compiles-for c@ ' optpick compiles-for pick - ' optlshift compiles-for lshift - ' optrshift compiles-for rshift - ' optand compiles-for and - ' optor compiles-for or - ' optxor compiles-for xor ' opt! compiles-for ! ' opt+! compiles-for +! ' optc! compiles-for c! - ' opt= compiles-for = - ' opt<> compiles-for <> - previous definitions --- 317,340 ---- then ; ! (( ! create opt-lit-table2 ! \ Entries of the format ( n [ m ] -- x ) where m or n and m can be literals. ! \ First entry is for 1 literal, 2nd for 2. For 0 literals, just inline. ! \ Side effects not allowed ! ! ' @ , opt@-1 , opt@-2 , ! ' c@ , optc@-1 , optc@-2 , ! ' ! , opt!-1 , opt!-2 , ! ' +! , opt+!-1 , opt+!-2 , ! ' c! , optc!-1 , optc!-2 , ! 0 , ! )) ' opt@ compiles-for @ ' optc@ compiles-for c@ ' optpick compiles-for pick ' opt! compiles-for ! ' opt+! compiles-for +! ' optc! compiles-for c! previous definitions |
