win32forth-cvs

[Alex M. <ale...@us...>]

Update of /cvsroot/win32forth/win32forth-stc/src/kernel
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5036

Modified Files:
	gkernel.f gversion.f 
Log Message:
arm: bring kernel up to latest version
remove do;-chain as no longer required
consistent support for inline

Index: gkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** gkernel.f	23 Sep 2006 09:54:28 -0000	1.3
--- gkernel.f	27 Sep 2006 21:38:59 -0000	1.4
***************
*** 2303,2306 ****
--- 2303,2308 ----
  variable latestxt               \ xt of last definition
  variable last-link              \ address of last link for last header created
+ 0 value ofa                     \ ofa support
+ 
  
   26 offset  link>name ( lfa -- nfa )
***************
*** 2391,2395 ****
  
  : (compiles) ( xt2 xt1 -- )                   \ set the compile word
!             xt>ct ! ;
  
  : (comp-only)   ( -- )                        \ compile only message
--- 2393,2397 ----
  
  : (compiles) ( xt2 xt1 -- )                   \ set the compile word
!             >comp ! ;
  
  : (comp-only)   ( -- )                        \ compile only message
***************
*** 2429,2437 ****
              body-off + @ ;
  
- : dogen     ( xt <-name-> -- )                \ generate do code
-             header                            \ header
-             here movecx#, xt-jmp,             \ name -> mov ecx, # here | jmp xt
-             _next move-code ;                 \ stops disasm
- 
  gcode _lit
                  mov     -4 [ebp], eax
--- 2431,2434 ----
***************
*** 2443,2460 ****
              ( -- n )                          \ run time
      (comp-only)                               \ compile only
!     compilation> ( -- xt ) drop
!             code-here _lit move-code
              5 + !                             \ update the literal in the code
              ;
  
  0 1 in/out : constant  ( n "name" )           \ compile time
              ( -- n )                          \ run time
!             header
              postpone literal
              _next move-code                   \ stops disassembler
!             ;
! 
! 0 1 in/out : create    ( -<name>- )           \ pointer
!             ['] dovar dogen
              ;
  
--- 2440,2469 ----
              ( -- n )                          \ run time
      (comp-only)                               \ compile only
!     compilation> ( -- xt )
!             drop code-here _lit move-code
              5 + !                             \ update the literal in the code
              ;
  
+ : dogen     ( xt <-name-> -- )                \ generate do code
+             header                            \ header
+             here movecx#, xt-jmp,             \ name -> mov ecx, # here | jmp xt
+             ofa-calc                          \ length calculation
+             _next move-code ;                 \ stops disasm
+ 
+ 0 1 in/out : create    ( -<name>- )           \ pointer
+             ['] dovar dogen
+             ;
+ 
+ : (x-cons)  ( xt -- )                         \ execute & compile a literal
+             execute postpone literal ;
+ 
  0 1 in/out : constant  ( n "name" )           \ compile time
              ( -- n )                          \ run time
! \            >system create , system>          \ create in system space
!             header                            \
              postpone literal
+             ofa-calc                          \ length calculation
              _next move-code                   \ stops disassembler
!             ['] (x-cons) latestxt @ (compiles)
              ;
  
***************
*** 2464,2469 ****
--- 2473,2491 ----
              ;
  
+ gcode _litval
+                 mov     -4 [ebp], eax
+                 mov     eax, 1234
+                 lea     ebp, -4 [ebp]
+                 ;g
+                 
+ : (litval)  ( n -- )
+             >body 
+             code-here _litval move-code
+             5 + !                             \ update the literal in the code
+             ;
+ 
  0 1 in/out : value     ( n -<name>- )         \ self fetching value
              ['] doval dogen ,
+             ['] (litval) latestxt @ (compiles)
              ;
  
***************
*** 2476,2488 ****
              ;                                 \ compile only
  
- \ : literal   ( n -- )                        \ literal
- \             movecx#, ['] dolit compile, ; immediate
- 
- \ : constant  ( n "name")                     \ constant
- \             ['] docon dogen , ;
- 
- \ : variable  ( "name")                       \ variable
- \             create 0 , ;
- 
  \ -------------------- Link Operations (Single Linked)  --------------------
  
--- 2498,2501 ----
***************
*** 3471,3476 ****
  
  : 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 ;
  
--- 3484,3490 ----
  
  : inline        ( -- )                           \ code will be inlined
!                 tail-call 0= if                   \ there's a tail-call, so not inlineable
!                   ['] xt-inline,
!                   last @ name>ct cell- !          \ comp field
                  then ;
  
***************
*** 3567,3571 ****
  : header    ( -<name>- )                      \ build a header
              code-align                        \ align code section, temporary
!             bl word count "header ;
  
  : alias     ( xt -<name>- )                   \ make another 'name' for 'xt'
--- 3581,3587 ----
  : 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
!             ;
  
  : alias     ( xt -<name>- )                   \ make another 'name' for 'xt'
***************
*** 4521,4525 ****
                  postpone then ;
  
- defer do-;chain ' noop is do-;chain
  variable csp                           \ current stack pointer variable
  
--- 4537,4540 ----
***************
*** 4532,4537 ****
  \ Words to support ;
  
- 0 value ofa
- 
  : (ofa-calc)    ( ofa -- )
                  code-here swap -       \ length of the code
--- 4547,4550 ----
***************
*** 4546,4550 ****
                  postpone unnest        \ extra ret to stop see (ret ret is end of definition)
                  postpone [ ?csp        \ stop compiling, check stack
!                 do-;chain ;
  
  |: ;noname      ( -- )                 \ ; for :noname
--- 4559,4563 ----
                  postpone unnest        \ extra ret to stop see (ret ret is end of definition)
                  postpone [ ?csp        \ stop compiling, check stack
!                 ;
  
  |: ;noname      ( -- )                 \ ; for :noname
***************
*** 4552,4556 ****
  
  |: ;name        ( -- )                 \ ; for :
!                 latestxt @ (ofa-calc)  \ length calculation
                  (;noname) reveal ;     \ reveal the name
  
--- 4565,4569 ----
  
  |: ;name        ( -- )                 \ ; for :
!                 ofa-calc               \ length calculation
                  (;noname) reveal ;     \ reveal the name
  
***************
*** 4759,4764 ****
  
  : get-order     ( -- widn .. wid1 n )      \ fetch widn .. wid1 n
!                 context-base context
!                 - 2 rshift dup >r
                  0 ?do
                    context-base i 1+ cells - @
--- 4772,4777 ----
  
  : get-order     ( -- widn .. wid1 n )      \ fetch widn .. wid1 n
!                 context-base context -
!                 2 rshift dup >r
                  0 ?do
                    context-base i 1+ cells - @
***************
*** 4849,4853 ****
                  s" ." defext$ place
                  /parse-s$ count
!                 over c@ [char] . = if 1 /string then
                  6 min defext$ +place
                  defext$ +null
--- 4862,4866 ----
                  s" ." defext$ place
                  /parse-s$ count
!                 over c@ [char] . = negate /string
                  6 min defext$ +place
                  defext$ +null
***************
*** 5471,5474 ****
--- 5484,5488 ----
              header                            \ create a defer
              jmp[], ['] defer-err ,            \ the jump
+             ofa-calc                          \ length calculation
              ;
  
***************
*** 5942,5944 ****
--- 5956,5959 ----
  ' warnmsg       resolves warnmsg
  ' find          resolves find
+ ' ofa-calc      resolves ofa-calc
  

Index: gversion.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gversion.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** gversion.f	21 Sep 2006 16:26:33 -0000	1.1
--- gversion.f	27 Sep 2006 21:38:59 -0000	1.2
***************
*** 3,7 ****
  cr .( Loading META version info)
  
! 00203     VALUE #VERSION#
  
  \ Change only the version number above; the build number is automatically assigned.
--- 3,7 ----
  cr .( Loading META version info)
  
! 00204     VALUE #VERSION#
  
  \ Change only the version number above; the build number is automatically assigned.