[Win32forth-cvs] win32forth-stc/src/kernel gkernel.f, 1.5, 1.6 gmeta-compiler.f, 1.1, 1.2

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

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

Modified Files:
	gkernel.f gmeta-compiler.f 
Log Message:
arm: rename xt>name, xt>ct... and name>xt to omit xt part; in line with other Forths
 that use >name

Index: gmeta-compiler.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gmeta-compiler.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** gmeta-compiler.f	21 Sep 2006 16:26:33 -0000	1.1
--- gmeta-compiler.f	30 Sep 2006 23:30:52 -0000	1.2
***************
*** 832,836 ****
  t: [']       ( -- )     't-ptr [transition] literal   t;
  t: [compile]   't execute    t;
! t: postpone    't-ptr [transition] literal [target] xt>ct-exec t;
  
  : t-count dup 1+ swap t-c@ ;
--- 832,836 ----
  t: [']       ( -- )     't-ptr [transition] literal   t;
  t: [compile]   't execute    t;
! t: postpone    't-ptr [transition] literal [target] >ct-exec t;
  
  : t-count dup 1+ swap t-c@ ;

Index: gkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** gkernel.f	30 Sep 2006 15:17:32 -0000	1.5
--- gkernel.f	30 Sep 2006 23:30:52 -0000	1.6
***************
*** 2295,2301 ****
              code-here swap dup code-allot move ;
  
! : move-code ( addr -- )                       \ routine to move the code
!             count (move-code) ;
! 
  \ -------------------- Vocabulary/header support -----------------------
  
--- 2295,2300 ----
              code-here swap dup code-allot move ;
  
! : move-code ( addr -- ) count (move-code) ;     \ routine to move the code
!             
  \ -------------------- Vocabulary/header support -----------------------
  
***************
*** 2339,2343 ****
  \     4     xt for DUP
  \
! \ When we do an XT>CT 2@ EXECUTE of the token, this gives
  \     ' DUP ' COMPILE,
  \ which compiles DUP. COMPILE, invokes the comp field for this purpose.
--- 2338,2342 ----
  \     4     xt for DUP
  \
! \ When we do an >ct 2@ EXECUTE of the token, this gives
  \     ' DUP ' COMPILE,
  \ which compiles DUP. COMPILE, invokes the comp field for this purpose.
***************
*** 2348,2352 ****
  \     4     xt for CHARS
  \
! \ When we do an XT>CT 2@ EXECUTE of the token, this gives
  \     ' CHARS ' EXECUTE
  \ which executes CHARS.
--- 2347,2351 ----
  \     4     xt for CHARS
  \
! \ When we do an >ct 2@ EXECUTE of the token, this gives
  \     ' CHARS ' EXECUTE
  \ which executes CHARS.
***************
*** 2375,2400 ****
  \   : x swap ; inline
  
! : xt>ct     ( xt -- ct )                      \ given an xt, get the ct
!             dup cell- @ + ;                   \ relative to abs address
! 
! : xt>ct-exec ( xt -- )                        \ execute the ct
!             xt>ct 2@ execute ;
! 
! : name>ct-exec ( nfa -- )                     \ execute the ct
!             name>ct 2@ execute ;
! 
! : xt>name   ( xt -- nfa ) xt>ct ct>name ;   \ get the name
! 
! : >comp     ( xt -- comp )                    \ point to the comp field
!             xt>ct cell- ;
! 
! : compile,  ( xt -- )                         \ compile xt on the stack
!             dup >comp @ execute ;             \ execute comp token
! 
! : (compiles) ( xt2 xt1 -- )                   \ set the compile word
!             >comp ! ;
! 
! : (comp-only)   ( -- )                        \ compile only message
!             throw_componly throw  ;
  
  \ ------------------------- Address support words ---------------------------
--- 2374,2384 ----
  \   : x swap ; inline
  
! : >ct       ( xt -- ct )   dup cell- @ + ;    \ given an xt, get the ct
! : >comp     ( xt -- comp ) >ct cell- ;        \ point to the comp field
! : (compiles) ( 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,  ( xt -- ) dup >comp @ execute ;   \ compile xt on the stack
! : (comp-only) ( -- ) throw_componly throw ;   \ compile only message
  
  \ ------------------------- Address support words ---------------------------
***************
*** 2403,2420 ****
              code-here - cell- code-, ;        \ the xt relative adjusted
  
! : xt-rel,   ( xt op -- )                      \ generate opcode and rel adjusted xt
!             code-c, xt-reladdr, ;             \ opcode and the xt relative adjusted
! 
! : xt-jmp,   ( xt -- )                         \ generate jump to xt on the stack
!             $e9 xt-rel, ;
  
  0 | value tail-call                           \ see exit for use
  
! : xt-call,  ( xt -- )                         \ compile call to xt on the stack
!             $e8 xt-rel,                       \ call address
              code-here to tail-call ;          \ possible tail call
  
  : xt-inline, ( xt -- )                        \ inline the xt
!             dup xt>name n>ofa w@ (move-code) ; \ get the length and move the code
  
  \ ---------------------------- Defining Words --------------------------------
--- 2387,2401 ----
              code-here - cell- code-, ;        \ the xt relative adjusted
  
! : xt-rel,   ( xt op -- ) code-c, xt-reladdr, ; \ generate opcode and rel adjusted xt
  
+ : xt-jmp,   ( xt -- ) $e9 xt-rel, ;           \ generate jump to xt on the stack
+             
  0 | value tail-call                           \ see exit for use
  
! : xt-call,  ( xt -- ) $e8 xt-rel,             \ compile call to xt on the stack
              code-here to tail-call ;          \ possible tail call
  
  : xt-inline, ( xt -- )                        \ inline the xt
!             dup >name n>ofa w@ (move-code) ;  \ get the length and move the code
  
  \ ---------------------------- Defining Words --------------------------------
***************
*** 2428,2434 ****
  7 equ addr-off                                \ the offset of the address part
  
! : >body     ( xt -- body )                    \ get body of created word
!             body-off + @ ;
! 
  gcode _lit
                  mov     -4 [ebp], eax
--- 2409,2414 ----
  7 equ addr-off                                \ the offset of the address part
  
! : >body     ( xt -- body ) body-off + @ ;     \ get body of created word
!             
  gcode _lit
                  mov     -4 [ebp], eax
***************
*** 2455,2461 ****
              ;
  
! : (x-cons)  ( xt -- )                         \ execute & compile a literal
!             execute postpone literal ;
! 
  0 1 in/out : constant  ( n "name" )           \ compile time
              ( -- n )                          \ run time
--- 2435,2440 ----
              ;
  
! : (x-cons)  ( xt -- ) execute postpone literal ; \ execute & compile a literal
!             
  0 1 in/out : constant  ( n "name" )           \ compile time
              ( -- n )                          \ run time
***************
*** 2493,2500 ****
      (comp-only)                               \ compile only
      compilation> ( -- xt ) drop
!             swap                              \ n on first
!             postpone literal                  \ generate literal
!             postpone literal                  \ and another
!             ;                                 \ compile only
  
  \ -------------------- Link Operations (Single Linked)  --------------------
--- 2472,2477 ----
      (comp-only)                               \ compile only
      compilation> ( -- xt ) drop
!             swap postpone literal postpone literal
!             ;
  
  \ -------------------- Link Operations (Single Linked)  --------------------
***************
*** 2696,2705 ****
                  next;
  
! : char      ( -- char )
!             parse-word drop c@ ;
! 
! : [char]    ( -- char )
!             char postpone literal ; immediate
! 
  : /parse    ( -- addr u )
              >in @ char swap >in ! dup '"' = over ''' =
--- 2673,2680 ----
                  next;
  
! : char      ( -- char ) parse-word drop c@ ;
!             
! : [char]    ( -- char ) char postpone literal ; immediate
!             
  : /parse    ( -- addr u )
              >in @ char swap >in ! dup '"' = over ''' =
***************
*** 2738,2742 ****
      compilation> ( -- xt ) drop
              postpone [']                      \ generate xt
!             postpone xt>ct-exec
              ;
  
--- 2713,2717 ----
      compilation> ( -- xt ) drop
              postpone [']                      \ generate xt
!             postpone >ct-exec
              ;
  
***************
*** 2744,2749 ****
      (comp-only)                               \ compile only
      compilation> ( -- xt ) drop
!             ' dup xt>ct @ ['] compile, <> if
!               postpone literal postpone xt>ct-exec
              else
                compile,
--- 2719,2724 ----
      (comp-only)                               \ compile only
      compilation> ( -- xt ) drop
!             ' dup >ct @ ['] compile, <> if
!               postpone literal postpone >ct-exec
              else
                compile,
***************
*** 2753,2759 ****
  \ -------------------- String Literals --------------------------------------
  
! : "parse    ( -- addr len )
!             [char] " parse ;
! 
  : ",        ( a1 n1 -- )               \ compile a1,n1 at here (counted)
              here over c, over allot 1+ swap cmove ;
--- 2728,2733 ----
  \ -------------------- String Literals --------------------------------------
  
! : "parse    ( -- addr len ) [char] " parse ;
!             
  : ",        ( a1 n1 -- )               \ compile a1,n1 at here (counted)
              here over c, over allot 1+ swap cmove ;
***************
*** 3405,3409 ****
                    s" :noname-" type $.          \ print the hex address
                  else
!                   xt>name .id
                  then ;
  
--- 3379,3383 ----
                    s" :noname-" type $.          \ print the hex address
                  else
!                   >name .id
                  then ;
  
***************
*** 4467,4471 ****
  : (interpret-c) ( str -- ??? )
                  find if
!                   xt>ct-exec      \ smart compile time
                  else
                    count number
--- 4441,4445 ----
  : (interpret-c) ( str -- ??? )
                  find if
!                   >ct-exec            \ smart compile time
                  else
                    count number
***************
*** 4475,4479 ****
  : (interpret-i) ( str -- ??? )
                  find if
!                   execute ?stack  \ interpret
                  else
                    count number
--- 4449,4453 ----
  : (interpret-i) ( str -- ??? )
                  find if
!                   execute ?stack       \ interpret
                  else
                    count number
***************
*** 5895,5899 ****
          begin   @ dup
          while
!           dup vlink>voc voc>vxt@ xt>name dup to .olly-vocname count
            s" locals" str= not if
              dup .olly-voc
--- 5869,5873 ----
          begin   @ dup
          while
!           dup vlink>voc voc>vxt@ >name dup to .olly-vocname count
            s" locals" str= not if
              dup .olly-voc