Update of /cvsroot/win32forth/win32forth-stc/src/kernel
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv3275
Modified Files:
gkernel.f
Log Message:
arm: correct TO on values with same name as local
Index: gkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** gkernel.f 8 Oct 2006 14:41:26 -0000 1.16
--- gkernel.f 8 Oct 2006 20:37:41 -0000 1.17
***************
*** 2260,2265 ****
: code-align ( -- ) >code align dp> ;
- : break $cc code-c, ; immediate
-
\ -------------------- Vocabulary/header support -----------------------
--- 2260,2263 ----
***************
*** 2341,2347 ****
: >ct ( xt -- ct ) dup cell- @ + ; \ given an xt, get the ct
: >comp ( xt -- comp ) >ct cell- ; \ point to the comp field
: >ct-exec ( xt -- ) >ct 2@ execute ; \ execute the ct
: >name ( xt -- nfa ) >ct ct>name ; \ get the name
- : >comp! ( xt2 xt1 -- ) >comp ! ; \ set the compile word
: compile-for ( xt2 <name> -- ) ' >comp! ; \ parsing; set the compilation word
--- 2339,2345 ----
: >ct ( xt -- ct ) dup cell- @ + ; \ given an xt, get the ct
: >comp ( xt -- comp ) >ct cell- ; \ point to the comp field
+ : >comp! ( xt2 xt1 -- ) >comp ! ; \ set the compile word
: >ct-exec ( xt -- ) >ct 2@ execute ; \ execute the ct
: >name ( xt -- nfa ) >ct ct>name ; \ get the name
: compile-for ( xt2 <name> -- ) ' >comp! ; \ parsing; set the compilation word
***************
*** 4463,4466 ****
--- 4461,4465 ----
: unnest ( -- ) \ generate a return
+ sync-code
$c3 code-c, ; immediate
***************
*** 4525,4528 ****
--- 4524,4528 ----
is ; \ set the ; word
0 to localstk \ clear locals stack counter
+ 0 to tail-call \ will be non-zero if we have any calls
cs-leave -stack \ clear the stack used for leave addresses
!csp ] ; \ stack depth, start compiling
***************
*** 4537,4541 ****
: : ( -<name>- -- ) \ forth's primary function defining word
- 0 to tail-call \ will be non-zero if we have any calls
header hide
['] ;name (:noname) \ set the named ; word
--- 4537,4540 ----
***************
*** 4549,4553 ****
0 to localstk \ can have its own locals
cs-leave -stack \ clear the stack used for leave addresses
! code-here name-compiles \ make the defined word compile this
;
--- 4548,4552 ----
0 to localstk \ can have its own locals
cs-leave -stack \ clear the stack used for leave addresses
! code-here latestxt @ >ct ! \ make the defined word compile this
;
***************
*** 4629,4633 ****
execute
r> handler !
! r>drop
r>drop
r>drop
--- 4628,4632 ----
execute
r> handler !
! r>drop
r>drop
r>drop
***************
*** 4658,4663 ****
: abort" ( n -<string">- -- )
! postpone if [c"] postpone abort!
! postpone then ; immediate
\ ----------------- Vocabulary & wordlist support --------------------------
--- 4657,4666 ----
: abort" ( n -<string">- -- )
! (comp-only)
! compilation> drop
! postpone if
! postpone c"
! postpone abort!
! postpone then ;
\ ----------------- Vocabulary & wordlist support --------------------------
***************
*** 5368,5380 ****
|: _to ( -<value>- -- ) \ compile time
! bl word dup count
! [ ' locals >body ] literal \ locals wordlist
! (search-self) name>xtimm if \ might be a local
! nip execute \ execute it
! $418D code-here 3 - code-w! \ modify to "lea eax, n [ecx]"
! else
! find ?missing \ do a find, check not missing
! >body postpone literal \ compile as literal
! then ;
: to ( n -<value>- -- ) \ set a value
--- 5371,5386 ----
|: _to ( -<value>- -- ) \ compile time
! bl word
! localstk 0> if
! dup count [ ' locals >body ] literal \ locals wordlist
! search-wordlist if \ might be a local
! nip execute \ execute it
! $418D code-here 3 - code-w! \ modify to "lea eax, n [ecx]"
! exit
! then
! then
! find ?missing \ do a find, check not missing
! >body postpone literal \ compile as literal
! ;
: to ( n -<value>- -- ) \ set a value
***************
*** 5791,5794 ****
--- 5797,5802 ----
0 | value word-count
+ : break sync-code $cc code-c, ; immediate
+
: ((words)) ( nfa -- true )
dup count pad count search nip nip if
|
