From: Alex M. <ale...@us...> - 2006-10-31 00:06:56
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv26980 Modified Files: gkernel.f gmeta-compiler.f gversion.f Log Message: arm: various updates; start of type system, improve optimisation, minor correction to float Index: gmeta-compiler.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gmeta-compiler.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** gmeta-compiler.f 24 Oct 2006 12:41:54 -0000 1.8 --- gmeta-compiler.f 31 Oct 2006 00:06:53 -0000 1.9 *************** *** 495,505 **** \ ------------------------------------------------------- ! 26 offset link>name ( lfa -- nfa ) ! -18 offset name>ct ( nfa -- ct ) ! 18 offset ct>name ( ct -- nfa ) ! -14 offset name>xtptr ( nfa -- cfa-ptr ) ! -10 offset name>ffa ( nfa -- ffa ) ! -4 offset n>ste ( nfa -- ste ) ! -2 offset n>ofa ( nfa -- ofa ) variable ct-link ct-link off \ list of cts --- 495,509 ---- \ ------------------------------------------------------- ! 28 offset link>name ( lfa -- nfa ) ! -28 offset name>link ( nfa -- lfa ) ! -20 offset name>ct ( nfa -- ct ) ! 20 offset ct>name ( ct -- nfa ) ! -16 offset name>xtptr ( nfa -- xt-ptr ) ! ! -2 offset n>tfa ( nfa -- tfa ) ! -4 offset n>ofa ( nfa -- ofa ) ! -6 offset n>ste ( nfa -- ste ) ! -8 offset n>vfa ( nfa -- vfa ) ! -12 offset n>ffa ( nfa -- ffa ) variable ct-link ct-link off \ list of cts *************** *** 527,530 **** --- 531,536 ---- -1 tsys-c, -1 tsys-c, \ ste 0 tsys-w, \ ofa + 0 tsys-c, \ typeflag + 0 tsys-c, \ flag tsys-here last-h ! \ remember nfa dup tsys-c, tsys-s, 0 tsys-c, \ count byte nfa name string *************** *** 556,560 **** dup cell- \ comp field xt-xt-call, swap tsys-! \ point at xt-call, ! ct>name name>ffa xt-fptr swap tsys-! \ update the ffa ; --- 562,566 ---- dup cell- \ comp field xt-xt-call, swap tsys-! \ point at xt-call, ! ct>name n>ffa xt-fptr swap tsys-! \ update the ffa ; Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** gkernel.f 28 Oct 2006 09:07:08 -0000 1.22 --- gkernel.f 31 Oct 2006 00:06:53 -0000 1.23 *************** *** 2293,2306 **** ! 26 offset link>name ( lfa -- nfa ) ! -26 offset name>link ( nfa -- lfa ) ! -18 offset name>ct ( nfa -- ct ) ! 18 offset ct>name ( ct -- nfa ) ! -14 offset name>xtptr ( nfa -- xt-ptr ) ! -2 offset n>ofa ( nfa -- ofa ) ! -4 offset n>ste ( nfa -- ste ) ! -6 offset n>vfa ( nfa -- vfa ) ! -10 offset n>ffa ( nfa -- ffa ) : name>xt ( nfa -- xt ) name>xtptr @ ; \ get the xt --- 2293,2307 ---- ! 28 offset link>name ( lfa -- nfa ) ! -28 offset name>link ( nfa -- lfa ) ! -20 offset name>ct ( nfa -- ct ) ! 20 offset ct>name ( ct -- nfa ) ! -16 offset name>xtptr ( nfa -- xt-ptr ) ! -2 offset n>tfa ( nfa -- tfa ) ! -4 offset n>ofa ( nfa -- ofa ) ! -6 offset n>ste ( nfa -- ste ) ! -8 offset n>vfa ( nfa -- vfa ) ! -12 offset n>ffa ( nfa -- ffa ) : name>xt ( nfa -- xt ) name>xtptr @ ; \ get the xt *************** *** 2422,2425 **** --- 2423,2433 ---- \ ---------------------------- Defining Words -------------------------------- + 1 constant tval + 2 constant tvar + 3 constant tcon + 4 constant tusr + 5 constant tdef + 6 constant tloc + : mov-tos,#n ( n -- ) \ generate a mov eax, # n sync-code \ generate pending code *************** *** 2442,2447 **** mov-tos,#n ; ! : dogen ( xt <-name-> -- ) \ generate do code header \ header here mov-ecx,#n xt-jmp, \ name -> mov ecx, # here | jmp xt ofa-calc \ length calculation --- 2450,2456 ---- mov-tos,#n ; ! : dogen ( xt type-of-name <-name-> -- ) \ generate do code header \ header + last @ n>tfa c! \ set the type here mov-ecx,#n xt-jmp, \ name -> mov ecx, # here | jmp xt ofa-calc \ length calculation *************** *** 2453,2457 **** ( -- n ) \ run time >system \ constant value in system space ! ['] doval dogen , dp> ['] (comp-cons) compiles-last \ make the defined word compile this --- 2462,2466 ---- ( -- n ) \ run time >system \ constant value in system space ! ['] doval tcon dogen , dp> ['] (comp-cons) compiles-last \ make the defined word compile this *************** *** 2461,2465 **** 0 1 in/out : create ( -<name>- ) \ pointer ! ['] dovar dogen \ ['] (comp-create) compiles-last \ doesn't work because of DOES> needs fixed ; --- 2470,2474 ---- 0 1 in/out : create ( -<name>- ) \ pointer ! ['] dovar tvar dogen \ ['] (comp-create) compiles-last \ doesn't work because of DOES> needs fixed ; *************** *** 2474,2478 **** 0 1 in/out : value ( n -<name>- ) \ self fetching value ! ['] doval dogen , ['] (comp-val) compiles-last \ make the defined word compile this ; --- 2483,2487 ---- 0 1 in/out : value ( n -<name>- ) \ self fetching value ! ['] doval tval dogen , ['] (comp-val) compiles-last \ make the defined word compile this ; *************** *** 3514,3517 **** --- 3523,3528 ---- -1 c, -1 c, \ ste 0 w, \ ofa + 0 c, \ tfa -- typeflag + 0 c, \ flag here last ! \ nfa is last ", 0 c, align \ nfa *************** *** 3559,3563 **** : header ( -<name>- ) \ build a header code-align \ align code section, temporary ! bl word count "header latestxt @ to ofa \ for length calculations of the code generated ; --- 3570,3574 ---- : header ( -<name>- ) \ build a header code-align \ align code section, temporary ! parse-word "header latestxt @ to ofa \ for length calculations of the code generated ; *************** *** 3577,3581 **** : user ( n -<name>- ) \ create a user variable ! ['] dousr dogen , ; --- 3588,3592 ---- : user ( n -<name>- ) \ create a user variable ! ['] dousr tusr dogen , ; *************** *** 4555,4559 **** (;noname) postpone unnest \ extra ret to stop see (ret ret is end of definition) ! latestxt @ ; \ return the xt |: ;name ( -- ) \ ; for : --- 4566,4571 ---- (;noname) postpone unnest \ extra ret to stop see (ret ret is end of definition) ! latestxt @ ! ; |: ;name ( -- ) \ ; for : *************** *** 5348,5351 **** --- 5360,5364 ---- >local "header \ build a header + tloc last @ n>tfa c! \ mark as a local local> localstk cells [ local-ptrs cell- ] literal \ table is zero offset Index: gversion.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gversion.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** gversion.f 27 Sep 2006 21:38:59 -0000 1.2 --- gversion.f 31 Oct 2006 00:06:53 -0000 1.3 *************** *** 3,7 **** cr .( Loading META version info) ! 00204 VALUE #VERSION# \ Change only the version number above; the build number is automatically assigned. --- 3,7 ---- cr .( Loading META version info) ! 00205 VALUE #VERSION# \ Change only the version number above; the build number is automatically assigned. |