Tables added - most of them at least

cross.fs

@@ -882,6 +882,8 @@ Struct
 
   cell% field >ghost-name
 
+\  cell% field >ghost-vt
+
 End-Struct ghost-struct
 
 Variable ghost-list
@@ -2266,7 +2268,13 @@ Defer setup-execution-semantics  ' noop IS setup-execution-semantics
     ELSE
 	T align H view,
 	>in @ T name, H >in !
-	tlast @ T A, 0 A, H  there tlast !
+	tlast @ T A, H
+	executed-ghost @ ?dup IF
+	    >do:ghost @ >exec2 @ addr,
+	ELSE
+	    0 T A, H
+	THEN
+	there tlast !
 	1 headers-named +!	\ Statistic
     THEN
     T cfalign here H tlastcfa !
@@ -2803,6 +2811,17 @@ Cond: DOES>
   Ghost do:ghost!
   :noname postpone gdoes> ;
 
+: vt:  ( ghost -- )  Ghost built >do:ghost @ >exec2 ! ;
+
+Variable vtable-list
+
+>TARGET
+: vtable: ( compile-xt extra-xt "name" -- )
+    Ghost >do:ghost @ >exec2 @ hereresolve
+    vtable-list @ T here swap A, H vtable-list !
+    swap T A, A, H ;
+>CROSS
+
 : ;DO ( [xt] [colon-sys] -- )
   postpone ; doexec! ; immediate
 
@@ -2822,6 +2841,7 @@ Cond: DOES>
 Builder (Constant)
 Build:  ( n -- ) ;Build
 by: :docon ( target-body-addr -- n ) T @ H ;DO
+vt: docon-vt
 
 Builder Constant
 Build:  ( n -- ) T , H ;Build
@@ -2834,10 +2854,12 @@ by (Constant)
 Builder 2Constant
 Build:  ( d -- ) T , , H ;Build
 DO: ( ghost -- d ) T dup cell+ @ swap @ H ;DO
+vt: do2con-vt
 
 Builder Create
 BuildSmart: ;Build
 by: :dovar ( target-body-addr -- addr ) ;DO
+vt: dovar-vt
 
 Builder Variable
 T has? rom H [IF]
@@ -2905,6 +2927,7 @@ by AVariable
 Builder User
 Build: 0 u, X , ;Build
 by: :douser ( ghost -- up-addr )  X @ tup@ + ;DO
+vt: douser-vt
 
 Builder 2User
 Build: 0 u, X , 0 u, drop ;Build
@@ -2920,6 +2943,7 @@ T has? rom H [IF]
 Builder (Value)
 Build:  ( n -- ) ;Build
 by: :dovalue ( target-body-addr -- n ) T @ @ H ;DO
+vt: dovalue-vt
 
 Builder Value
 Build: T here 0 A, H switchram T align here swap ! , H ;Build
@@ -2932,6 +2956,7 @@ by (Value)
 Builder (Value)
 Build:  ( n -- ) ;Build
 by: :dovalue ( target-body-addr -- n ) T @ H ;DO
+vt: dovalue-vt
 
 Builder Value
 BuildSmart: T , H ;Build
@@ -2952,10 +2977,12 @@ T has? rom H [IF]
     BuildSmart:  ( -- ) [T'] noop T A, H ;Build
     by: :dodefer ( ghost -- ) X @ texecute ;DO
 [THEN]
+vt: dodefer-vt
 
 Builder interpret/compile:
 Build: ( inter comp -- ) swap T A, A, H ;Build-immediate
 DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO
+vt: doi/c-vt
 
 \ Sturctures                                           23feb95py
 
@@ -2967,6 +2994,7 @@ DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO
 Builder (Field)
 Build: ;Build
 by: :dofield T @ H + ;DO
+vt: dofield-vt
 
 Builder Field
 Build: ( align1 offset1 align size "name" --  align2 offset2 )
@@ -2986,30 +3014,35 @@ by (Field)
 Builder (ABI-CODE)
 Build: ;Build
 by: :doabicode noop ;DO
+vt: abicode-vt
 
 BUILDER (;abi-code)
 Build: ;Build
 by: :do;abicode noop ;DO
+vt: ;abicode-vt
 
 \ Input-Methods                                            01py
 
 Builder input-method
 Build: ( m v -- m' v )  dup T , cell+ H ;Build
 DO:  abort" Not in cross mode" ;DO
+vt: doim-vt
 
 Builder input-var
 Build: ( m v size -- m v' )  over T , H + ;Build
 DO:  abort" Not in cross mode" ;DO
+vt: doiv-vt
 
 \ Mini-OOF
 
 Builder method
 Build: ( m v -- m' v )  over T , swap cell+ swap H ;Build
 DO:  abort" Not in cross mode" ;DO
+vt: do-moof-method-vt
 
 Builder var
 Build: ( m v size -- m v+size )  over T , H + ;Build
-DO: ( o -- addr ) T @ H + ;DO
+by (Field)
 
 Builder end-class
 Build: ( addr m v -- )

kernel/kernel.fs

@@ -22,11 +22,8 @@
 has? interpreter [IF]
     include ./int.fs
     has? compiler [IF]
-	has? EC [IF]
-	    include ./comp-ec.fs
-	[ELSE]
-	    include ./comp.fs
-	[THEN]
+	include ./vtables.fs
+	include ./comp.fs
     [THEN]
 [THEN]
 has? new-input [IF]

kernel/vtables.fs

+\ vtables.fs does the intelligent compile, vtable handling
+
+\ Copyright (C) 2012 Free Software Foundation, Inc.
+
+\ This file is part of Gforth.
+
+\ Gforth is free software; you can redistribute it and/or
+\ modify it under the terms of the GNU General Public License
+\ as published by the Free Software Foundation, either version 3
+\ of the License, or (at your option) any later version.
+
+\ This program is distributed in the hope that it will be useful,
+\ but WITHOUT ANY WARRANTY; without even the implied warranty of
+\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+\ GNU General Public License for more details.
+
+\ You should have received a copy of the GNU General Public License
+\ along with this program. If not, see http://www.gnu.org/licenses/.
+
+:noname >body ['] lit@ peephole-compile, , ;        0 vtable: Value
+:noname >body @ ['] lit peephole-compile, , ;       0 vtable: Constant
+:noname >body 2@ swap
+    ['] lit peephole-compile, ,
+    ['] lit peephole-compile, , ;                   0 vtable: 2Constant    
+\ :noname >body ['] call peephole-compile, , ;        0 vtable: :
+:noname >body ['] lit peephole-compile, , ;         0 vtable: Variable
+:noname >body @ ['] useraddr peephole-compile, , ;  0 vtable: User
+:noname >body ['] lit-perform peephole-compile, , ; 0 vtable: Defer
+:noname >body @ ['] lit+ peephole-compile, , ;      0 vtable: Field
+:noname >body ['] abi-call peephole-compile, , ;    0 vtable: (abi-code)
+:noname ['] ;abi-code-exec peephole-compile, , ;    0 vtable: (;abi-code)
+:noname ['] does-exec peephole-compile, , ;         0 vtable: input-var
+:noname ['] does-exec peephole-compile, , ;         0 vtable: input-method
+:noname >body @ peephole-compile, ;                 0 vtable: interpret/compile:
\ No newline at end of file