Menu
▾
▴
win32forth-cvs
|
From: Alex M. <ale...@us...> - 2007-07-12 21:00:31
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv3305/src Modified Files: Class.f asmwin32.f optinline.f optliterals.f Log Message: arm: correct compiler; metat generating incorrect code for smart compile, (words using compilation> in the kernel like IF etc) and simplified the kernel once this was fixed. Index: asmwin32.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/asmwin32.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** asmwin32.f 22 Mar 2007 02:08:33 -0000 1.6 --- asmwin32.f 12 Jul 2007 21:00:18 -0000 1.7 *************** *** 34,49 **** also asm-hidden definitions ! : (_end-code) ! _end-code ! \ *enhance needs work to support standard ;name ! \ ;name ! ['] (comp-only) is ; ! ; ! ! ' (_end-code) is end-code : (_code) ( start a native code definition ) : init-asm postpone [ \ runs in interpreted mode, not compile - ['] end-code is ; \ set the code ; word ; --- 34,41 ---- also asm-hidden definitions ! ' _end-code is end-code : (_code) ( start a native code definition ) : init-asm postpone [ \ runs in interpreted mode, not compile ; Index: Class.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/Class.f,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** Class.f 22 May 2007 07:36:20 -0000 1.12 --- Class.f 12 Jul 2007 21:00:18 -0000 1.13 *************** *** 1281,1285 **** \ Total Hack to be removed when TO and +TO are properly sorted. ! code oldto call ' to >ct @ next ;c : (classto) ( n -<value>- -- ) --- 1281,1286 ---- \ Total Hack to be removed when TO and +TO are properly sorted. ! \ code oldto call ' to >ct @ next ;c ! defer oldto ' to >comp @ is oldto : (classto) ( n -<value>- -- ) *************** *** 1304,1308 **** ' (classto) compiles-for to ! code old+to call ' +to >ct @ next ;c : (class+to) ( n -<value>- -- ) --- 1305,1310 ---- ' (classto) compiles-for to ! \ code old+to call ' +to >ct @ next ;c ! defer old+to ' +to >comp @ is old+to : (class+to) ( n -<value>- -- ) Index: optliterals.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optliterals.f,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** optliterals.f 13 May 2007 21:39:26 -0000 1.15 --- optliterals.f 12 Jul 2007 21:00:18 -0000 1.16 *************** *** 44,48 **** : 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! ; --- 44,48 ---- : compiles-nse ( xt -- ) \ compiles-for and no side effects ! ' dup>r >comp! \ set the compiling word r> >name n>flg dup sc@ nse or swap c! ; *************** *** 54,65 **** \ are broken up into their constituent parts for compile time ! :noname drop cell 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 2 postpone literal postpone - ; compiles-for 2- ! :noname drop 2 postpone literal postpone + ; compiles-for 2+ ! :noname drop 1 postpone literal postpone + ; dup compiles-for 1+ compiles-for char+ \ This stack of literals should really be a queue, as we need fifo. Emulated --- 54,65 ---- \ are broken up into their constituent parts for compile time ! :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 2 postpone literal postpone - ; compiles-for 2- ! :noname drop 2 postpone literal postpone + ; compiles-for 2+ ! :noname drop 1 postpone literal postpone + ; dup compiles-for 1+ ! compiles-for char+ \ This stack of literals should really be a queue, as we need fifo. Emulated *************** *** 112,146 **** then ; - : pop-tos { } 0 n[ebp]->tos -1 n+stk ; - : push-tos { } -4 tos->n[ebp] 1 n+stk ; - - 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 ; - : 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 ; - : xor-tos,#n ( n ) >r macro[ xor r@ tos,#n ]macro r>drop ; - : cmp-tos,#n ( n ) >r macro[ cmp r@ tos,#n ]macro r>drop ; - : jne-mark2 ( -- ) macro[ jne 0 ]macro >mark 2 ; - : 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 ; - : imul-tos,#n ( n ) $C069 code-w, code-, ; \ no opcode for this? imul eax, # n - : litstack ( n xt -- ) \ stack literal drop lits spush ; \ the xt is of literal, just loose it --- 112,115 ---- *************** *** 174,177 **** --- 143,177 ---- ' litsync is sync-code + : pop-tos ( ) 0 n[ebp]->tos -1 n+stk ; + : push-tos ( ) -4 tos->n[ebp] 1 n+stk ; + + 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 ; + : 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 ; + : xor-tos,#n ( n ) >r macro[ xor r@ tos,#n ]macro r>drop ; + : cmp-tos,#n ( n ) >r macro[ cmp r@ tos,#n ]macro r>drop ; + : jne-mark2 ( -- ) macro[ jne 0 ]macro >mark 2 ; + : 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 ; + : imul-tos,#n ( n ) $C069 code-w, code-, ; \ no opcode for this? imul eax, # n + : opt/ ( xt -- ) lits>1? if lits s2pop swap rot execute lits spush else xt-inline, then ; *************** *** 250,254 **** begin dup @ dup \ fetch the entry while ! r@ swap (compiles-set) 2 cells+ \ next entry repeat r>drop 2drop ; execute \ do it now --- 250,254 ---- begin dup @ dup \ fetch the entry while ! r@ swap >comp! 2 cells+ \ next entry repeat r>drop 2drop ; execute \ do it now *************** *** 322,325 **** --- 322,356 ---- ' optc! compiles-for c! + : optloc-save ( -- ) \ generate save if locals not in use + sync-code + localstk 0= if \ if zero, not using locals + macro[ + push lp [up] \ push local ptr + mov lp [up] , esp \ new local ptr + ]macro + -1 to localstk \ mark as localalloc + then ; + + : optloc ( xt -- ) \ optimise localalloc + drop + lits>0? if \ constant? + lits spop aligned >r \ align it + optloc-save \ generate possible save + postpone dup + macro[ + sub esp, # r@ \ adjust rstack pointer + ]macro r>drop + else + optloc-save \ generate possible save + macro[ + sub esp, eax \ subtract n1 from return stack + and esp, # -4 \ cell align return stack + ]macro + then + macro[ + mov eax, esp \ move to top of stack + ]macro + ; ' optloc compiles-for localalloc + : optof ( xt -- ) \ optimise the constant case "n of ... endof" drop 1+ >r Index: optinline.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optinline.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** optinline.f 13 May 2007 21:39:26 -0000 1.8 --- optinline.f 12 Jul 2007 21:00:18 -0000 1.9 *************** *** 42,45 **** --- 42,46 ---- \ set some optimisation for constants in the kernel + \ should really be done in meta compilation ' (comp-cons) compiles-for bl *************** *** 49,52 **** --- 50,59 ---- ' (comp-cons) compiles-for cell ' (comp-cons) compiles-for -cell + ' (comp-cons) compiles-for maxbuffer + ' (comp-cons) compiles-for maxcounted + ' (comp-cons) compiles-for maxstring + ' (comp-cons) compiles-for r/o + ' (comp-cons) compiles-for w/o + ' (comp-cons) compiles-for r/w ' (comp-val) compiles-for stdin ' (comp-val) compiles-for stdout *************** *** 161,165 **** ' xt-inline, compiles-for wcount ' xt-inline, compiles-for lcount ! ' xt-inline, compiles-for zcount ' xt-inline, compiles-for bounds --- 168,172 ---- ' xt-inline, compiles-for wcount ' xt-inline, compiles-for lcount ! \ ' xt-inline, compiles-for zcount ' xt-inline, compiles-for bounds |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X