Menu
▾
▴
[Win32forth-cvs] win32forth-stc/src/kernel gkernel.f, 1.26, 1.27 gmeta-compiler.f, 1.9, 1.10
|
From: Alex M. <ale...@us...> - 2006-11-30 20:17:37
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21033 Modified Files: gkernel.f gmeta-compiler.f Log Message: arm: more support for type system Index: gmeta-compiler.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gmeta-compiler.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** gmeta-compiler.f 31 Oct 2006 00:06:53 -0000 1.9 --- gmeta-compiler.f 30 Nov 2006 20:17:32 -0000 1.10 *************** *** 633,636 **** --- 633,659 ---- [THEN] + ALSO ASSEMBLER DEFINITIONS + + : label a; tcode-here constant ; + + : (end-code) + a; + in-meta check-labels + [ asm-hidden ] ?finished ?unres [ assembler ] ?csp + in-code? off + ; + + ' (end-code) is end-code + ' (end-code) is ;c + + PREVIOUS DEFINITIONS + + : ofa-meta ( -- ) + tcode-here ofa-h - \ length of code section + last-h @ n>ofa tsys-w! \ save it + ; + + ' ofa-meta is ofa-calc + : init-assembler ( -- ) \ prepare for assembly code [ assembler ] clear-labels *************** *** 661,688 **** >r code r> t-align t-here t-ecxaddr make-tjmp, \ name -> mov ecx, # here | jmp xt ! macro[ next c; ]macro ; ! ! ALSO ASSEMBLER DEFINITIONS ! ! : label a; tcode-here constant ; ! ! : (end-code) ! a; ! in-meta check-labels ! [ asm-hidden ] ?finished ?unres [ assembler ] ?csp ! in-code? off ! ; ! ! ' (end-code) is end-code ! ' (end-code) is ;c ! ! PREVIOUS DEFINITIONS ! ! : ofa-meta ( -- ) ! tcode-here ofa-h - \ length of code section ! last-h @ n>ofa tsys-w! \ save it ! ; ! ! ' ofa-meta is ofa-calc \ ====================================================================== --- 684,689 ---- >r code r> t-align t-here t-ecxaddr make-tjmp, \ name -> mov ecx, # here | jmp xt ! macro[ c; ]macro ! ofa-meta ; \ ====================================================================== *************** *** 721,726 **** mov ecx, # r@ jmp s" 't-ptr dovoc" evaluate - next (end-code) ]macro r>drop in-application --- 722,727 ---- mov ecx, # r@ jmp s" 't-ptr dovoc" evaluate (end-code) + ofa-meta ]macro r>drop in-application *************** *** 763,767 **** cr ct-link ! begin @ dup while dup ctlink>ptr tsys-there --- 764,768 ---- cr ct-link ! begin @ dup while dup ctlink>ptr tsys-there *************** *** 1017,1023 **** >r code r@ t-literal ! macro[ ! next c; ! ]macro r>drop ; --- 1018,1022 ---- >r code r@ t-literal ! macro[ next c; ]macro r>drop ; *************** *** 1114,1118 **** 2dup ste-o ! ste-i ! ! last-h @ n>ste dup>r 1+ tsys-c! r> tsys-c! ; \ ====================================================================== --- 1113,1117 ---- 2dup ste-o ! ste-i ! ! last-h @ n>ste dup>r 1+ tsys-c! r> tsys-c! ; \ ====================================================================== Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.26 retrieving revision 1.27 diff -C2 -d -r1.26 -r1.27 *** gkernel.f 22 Nov 2006 00:07:14 -0000 1.26 --- gkernel.f 30 Nov 2006 20:17:32 -0000 1.27 *************** *** 244,251 **** \ -------------------------- Primitives ----------------------------- - gcode _next - next - ;g - code dovar ( -- n ) \ variable mov -4 [ebp], eax --- 244,247 ---- *************** *** 2457,2475 **** then ; \ ---------------------------- Defining Words -------------------------------- ! 1 constant tval ! 2 constant tvar 3 constant tcon ! 4 constant tusr 5 constant tdef 6 constant tloc 7 constant tcol ! : mov-tos,#n ( n -- ) \ generate a mov eax, # n sync-code \ generate pending code $C0C7 code-w, code-, ; \ mov eax, # ! : mov-ecx,#n ( n -- ) \ generate a mov ecx, # n sync-code \ generate pending code $C1C7 code-w, code-, ; \ mov ecx, # --- 2453,2478 ---- then ; + : unnest ( -- ) \ generate a return + $c3 code-c, ; immediate + \ ---------------------------- Defining Words -------------------------------- ! 1 constant tval \ constants for type system ! 2 constant tvar \ in support of TO and +TO 3 constant tcon ! 4 constant tusr 5 constant tdef 6 constant tloc 7 constant tcol + 8 constant tvoc + 9 constant tflt + 10 constant tstr + 11 constant tobj ! : mov-tos,#n ( n -- ) \ generate a mov eax, # n sync-code \ generate pending code $C0C7 code-w, code-, ; \ mov eax, # ! : mov-ecx,#n ( n -- ) \ generate a mov ecx, # n sync-code \ generate pending code $C1C7 code-w, code-, ; \ mov ecx, # *************** *** 2491,2496 **** tfa! \ set the type here mov-ecx,#n xt-jmp, \ name -> mov ecx, # here | jmp xt ! ofa-calc \ length calculation ! _next (copy-code) ; \ stops disasm : (comp-cons) ( xt -- ) execute postpone literal ; \ execute & compile a literal --- 2494,2498 ---- tfa! \ set the type here mov-ecx,#n xt-jmp, \ name -> mov ecx, # here | jmp xt ! ofa-calc ; \ length calculation : (comp-cons) ( xt -- ) execute postpone literal ; \ execute & compile a literal *************** *** 2508,2512 **** 0 1 in/out : create ( -<name>- ) \ pointer ['] dovar tvar dogen ! ['] (comp-create) compiles-last \ doesn't work because of DOES> needs fixed ; --- 2510,2514 ---- 0 1 in/out : create ( -<name>- ) \ pointer ['] dovar tvar dogen ! ['] (comp-create) compiles-last \ doesn't work because of DOES> , needs fixed ??? ; *************** *** 3180,3186 **** : _dosconsole ( fl -- ) \ true = open, false = close if call AllocConsole drop ! STD_OUTPUT_HANDLE call getstdhandle to stdout ! STD_INPUT_HANDLE call getstdhandle to stdin ! STD_ERROR_HANDLE call getstdhandle to stderr else call FreeConsole drop then ; --- 3182,3188 ---- : _dosconsole ( fl -- ) \ true = open, false = close if call AllocConsole drop ! STD_OUTPUT_HANDLE call GetStdHandle to stdout ! STD_INPUT_HANDLE call GetStdHandle to stdin ! STD_ERROR_HANDLE call GetStdHandle to stderr else call FreeConsole drop then ; *************** *** 4550,4556 **** 0 value localstk \ support for locals (including localalloc) - : unnest ( -- ) \ generate a return - $c3 code-c, ; immediate - \ EXIT compiles _LOCALFREE, but leaves LOCALSTK alone so that ; can \ also compile _LOCALFREE --- 4552,4555 ---- *************** *** 4875,4881 **** |: (voc) ( #threads -<name>- -- ) #wordlist dup \ wid address ! header code-here swap voc>vxt ! \ set the xt for this name ! mov-ecx,#n ['] dovoc xt-jmp, \ set ecx, jmp to dovoc ! postpone unnest ; --- 4874,4881 ---- |: (voc) ( #threads -<name>- -- ) #wordlist dup \ wid address ! header tvoc tfa! \ header, it's vocabulary ! code-here swap voc>vxt ! \ set the xt for this name ! mov-ecx,#n ['] dovoc xt-jmp, \ set ecx, jmp to dovoc ! ofa-calc ; |
