Commit 6839bbf7 authored by Bernd Paysan's avatar Bernd Paysan

Tables added - most of them at least

parent aca77fde
......@@ -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 -- )
......
......@@ -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]
......
\ 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
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment