Update of /cvsroot/win32forth/win32forth-stc/src/kernel
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29268
Modified Files:
gkernel.f gmeta-compiler.f
Log Message:
arm: correct in/out values in kernel for constant, value, variable words
Index: gmeta-compiler.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gmeta-compiler.f,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** gmeta-compiler.f 30 Nov 2006 20:17:32 -0000 1.10
--- gmeta-compiler.f 15 Dec 2006 12:21:48 -0000 1.11
***************
*** 722,726 ****
mov ecx, # r@
jmp s" 't-ptr dovoc" evaluate
! (end-code)
ofa-meta
]macro r>drop
--- 722,726 ----
mov ecx, # r@
jmp s" 't-ptr dovoc" evaluate
! c;
ofa-meta
]macro r>drop
***************
*** 1019,1023 ****
r@ t-literal
macro[ next c; ]macro r>drop
! ;
: value ( n -<name>- ) \ create a self fetching changeable value
--- 1019,1023 ----
r@ t-literal
macro[ next c; ]macro r>drop
! ;
: value ( n -<name>- ) \ create a self fetching changeable value
Index: gkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v
retrieving revision 1.27
retrieving revision 1.28
diff -C2 -d -r1.27 -r1.28
*** gkernel.f 30 Nov 2006 20:17:32 -0000 1.27
--- gkernel.f 15 Dec 2006 12:21:48 -0000 1.28
***************
*** 2178,2183 ****
0 dp-link !
- create kdp 0 , 0 , 0 , dp-link link, ," syscode" \ system code (aka kode)
create sdp 0 , 0 , 0 , dp-link link, ," sys" \ system
create adp 0 , 0 , 0 , dp-link link, ," app" \ application
create cdp 0 , 0 , 0 , dp-link link, ," appcode" \ code
--- 2178,2183 ----
0 dp-link !
create sdp 0 , 0 , 0 , dp-link link, ," sys" \ system
+ create kdp 0 , 0 , 0 , dp-link link, ," syscode" \ system code (aka kode)
create adp 0 , 0 , 0 , dp-link link, ," app" \ application
create cdp 0 , 0 , 0 , dp-link link, ," appcode" \ code
***************
*** 2456,2459 ****
--- 2456,2473 ----
$c3 code-c, ; immediate
+ \ -------------------- Various support words --------------------------
+
+ : (in/out@) ( nfa -- in out ) \ get the ste values
+ n>ste dup sc@ swap 1+ sc@ ;
+
+ : in/out@ ( -- in out ) \ get the ste values
+ last @ (in/out@) ;
+
+ : (in/out!) ( in out -- ) \ set the ste values
+ last @ n>ste
+ dup>r 1+ c! r> c! ;
+
+ ' (in/out!) alias in/out immediate \ immediate version
+
\ ---------------------------- Defining Words --------------------------------
***************
*** 2498,2502 ****
: (comp-cons) ( xt -- ) execute postpone literal ; \ execute & compile a literal
! 0 1 in/out : constant ( n "name" ) \ compile time
( -- n ) \ run time
>system \ constant value in system space
--- 2512,2516 ----
: (comp-cons) ( xt -- ) execute postpone literal ; \ execute & compile a literal
! : constant ( n "name" ) \ compile time
( -- n ) \ run time
>system \ constant value in system space
***************
*** 2504,2528 ****
dp>
['] (comp-cons) compiles-last \ make the defined word compile this
! ;
: (comp-create) ( xt -- ) >body postpone literal ;
! 0 1 in/out : create ( -<name>- ) \ pointer
['] dovar tvar dogen
['] (comp-create) compiles-last \ doesn't work because of DOES> , needs fixed ???
! ;
! 0 1 in/out : variable ( "name") \ compile time
( -- n ) \ run time
create 0 ,
! ['] (comp-cons) compiles-last ;
: (comp-val) ( n -- )
>body postpone literal postpone @ ;
! 0 1 in/out : value ( n -<name>- ) \ self fetching value
['] doval tval dogen ,
['] (comp-val) compiles-last \ make the defined word compile this
! ;
: 2literal ( n m -- ) \ run-time skeleton for 2literal
--- 2518,2547 ----
dp>
['] (comp-cons) compiles-last \ make the defined word compile this
! 0 1 in/out
! ; 1 0 in/out
: (comp-create) ( xt -- ) >body postpone literal ;
! : create ( -<name>- ) \ pointer
['] dovar tvar dogen
['] (comp-create) compiles-last \ doesn't work because of DOES> , needs fixed ???
! 0 1 in/out
! ; 0 0 in/out
! : variable ( "name") \ compile time
( -- n ) \ run time
create 0 ,
! ['] (comp-cons) compiles-last
! 0 0 in/out
! ; 0 1 in/out
: (comp-val) ( n -- )
>body postpone literal postpone @ ;
! : value ( n -<name>- ) \ self fetching value
['] doval tval dogen ,
['] (comp-val) compiles-last \ make the defined word compile this
! 0 1 in/out
! ; 1 0 in/out
: 2literal ( n m -- ) \ run-time skeleton for 2literal
***************
*** 5979,5996 ****
: ok ( -- ) ; immediate \ to allow console code with ok prompt to be pasted
- \ -------------------- Various support words --------------------------
-
- : (in/out@) ( nfa -- in out ) \ get the ste values
- n>ste dup sc@ swap 1+ sc@ ;
-
- : in/out@ ( -- in out ) \ get the ste values
- last @ (in/out@) ;
-
- : (in/out!) ( in out -- ) \ set the ste values
- last @ n>ste
- dup>r 1+ c! r> c! ;
-
- ' (in/out!) alias in/out immediate \ immediate version
-
\ ---------------------------------------------------------------------
\ ---------------------------------------------------------------------
--- 5998,6001 ----
|
