Update of /cvsroot/win32forth/win32forth-stc/src/kernel
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9400/win32forth-stc/src/kernel
Modified Files:
gkernel.f
Log Message:
gah:Fixed bug in loocals plus correct (tested) version of previous mods
Index: gkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** gkernel.f 22 Sep 2006 10:31:57 -0000 1.2
--- gkernel.f 23 Sep 2006 09:54:28 -0000 1.3
***************
*** 3470,3480 ****
;
! : inline ( -- ) \ code will be inlined
! tail-call 0= if \ there's at least one call, so no inline
! ['] xt-inline,
! last @ name>ct cell- ! \ comp field
then ;
-
: compiles ( xt2 <name> -- ) \ parsing; set the compilation word
' (compiles) ; \ stack will be ( xt -- )
--- 3470,3478 ----
;
! : inline ( -- ) \ code will be inlined
! tail-call 0= if \ there's at least one call, so no inline
! ['] xt-inline, last @ name>ct cell- ! \ comp field
then ;
: compiles ( xt2 <name> -- ) \ parsing; set the compilation word
' (compiles) ; \ stack will be ( xt -- )
***************
*** 3669,3695 ****
0x10 proc-modify ;
! |: compile-call ( xt -- )
! ignore-missing-procs? not if \ should we ignore missing?
! res-multi-libs \ else resolve call now!
! then
! postpone literal _call move-code
! winproc-last @ proc>pcnt c@ dup $10 and
! if $0f and ?dup
! if _stdcall move-code
! cells code-here 1- code-c!
! then
! else drop
! then ;
\ -------------------- Calling Procedures -----------------------------------
: proc>xt ( -<proc>- -- xt )
! 0x80 parse-word #"proc ; \ build the proc (0x80 =unknown # parms)
! -1 1 in/out : call ( [args..] -<proc>- -- result ) \ compile or
! execute a windows procedure
! proc>xt (call) \ interpret
! compilation> drop \ and while compiling
! proc>xt compile-call ;
--- 3667,3695 ----
0x10 proc-modify ;
! |: compile-call ( xt -- )
! ignore-missing-procs? not if \ should we ignore missing?
! res-multi-libs \ else resolve call now!
! then
! postpone literal _call move-code
! winproc-last @ proc>pcnt c@ dup $10 and
! if $0f and ?dup
! if _stdcall move-code
! cells code-here 1- code-c!
! then
! else drop
! then
! ;
!
!
\ -------------------- Calling Procedures -----------------------------------
: proc>xt ( -<proc>- -- xt )
! 0x80 parse-word #"proc ; \ build the proc (0x80 = unknown # parms)
! -1 1 in/out : call ( [args..] -<proc>- -- result ) \ compile or execute a windows procedure
! proc>xt (call) \ interpret
! compilation> drop \ and while compiling
! proc>xt compile-call ;
***************
*** 4576,4580 ****
0 to tail-call \ will be non-zero if we have any calls
header hide
! ['] ;name (:noname) \ set the named ; word
;
--- 4576,4580 ----
0 to tail-call \ will be non-zero if we have any calls
header hide
! ['] ;name (:noname) \ set the named ; word
;
***************
*** 4589,4594 ****
;
! : as ( 'name' -- ) \ make name an alias of call last
! winproc : winproc-last @ proc>ep compile-call postpone ; inline ;
\ ---------------------------- DOES> -----------------------------------
--- 4589,4595 ----
;
! : as ( 'name' -- ) \ make name an alias of call last winproc
! : winproc-last @ proc>ep compile-call
! postpone ; inline ;
\ ---------------------------- DOES> -----------------------------------
***************
*** 5335,5338 ****
--- 5336,5340 ----
1 +to localstk \ total count of stack parms
localstk #-locals > throw_localstoomany ?throw
+ get-current >r \ save current
also locals definitions \ move to locals area
last @ last-link @ 2>r \ save last (we wipe out)
***************
*** 5345,5349 ****
r> latestxt !
2r> last-link ! last ! \ restore last, last-link
! previous definitions \ back out of locals
locflg +to localsi \ locflg counts initialised
else 2drop localsgen, \ go on to create locals
--- 5347,5351 ----
r> latestxt !
2r> last-link ! last ! \ restore last, last-link
! previous r> set-current \ back out of locals
locflg +to localsi \ locflg counts initialised
else 2drop localsgen, \ go on to create locals
***************
*** 5423,5427 ****
;
! : +to ( n -<value>- -- ) \ add to a value
[to] +! \ runtime
compilation> drop
--- 5425,5429 ----
;
! : +to ( n -<value>- -- ) \ set a value
[to] +! \ runtime
compilation> drop
***************
*** 5429,5437 ****
;
! : &of ( -<value>- -- addr ) \ get address
! [to] \ runtime
compilation> drop
! _to ; \ compile time
!
\ -------------------- Locals Allocation on rstack --------------------------
--- 5431,5438 ----
;
! : &of ( -<value>- -- addr )
! [to]
compilation> drop
! _to ;
\ -------------------- Locals Allocation on rstack --------------------------
|
