Commit 55163930 authored by jwilke's avatar jwilke

cleaned up bernds changes.

tried to manage the peephole/call threading stuff with the
existing plugin definitions.
parent 70906cce
......@@ -717,7 +717,6 @@ Plugin branchtoresolve, ( branch-addr -- ) \ resolves a forward reference from b
Plugin branchtomark, ( -- target-addr ) \ marks a branch destination
Plugin colon, ( tcfa -- ) \ compiles call to tcfa at current position
Plugin xt, ( tcfa -- ) \ compiles xt
Plugin prim, ( tcfa -- ) \ compiles primitive invocation
Plugin colonmark, ( -- addr ) \ marks a colon call
Plugin colon-resolve ( tcfa addr -- )
......@@ -751,9 +750,14 @@ Plugin next, ( for-token )
Plugin leave, ( -- )
Plugin ?leave, ( -- )
[IFUNDEF] ca>native
Plugin ca>native
[THEN]
Plugin ca>native \ Convert a code address to the processors
\ native address. This is used in doprim, and
\ code/code: primitive definitions word to
\ convert the addresses.
\ The only target where we need this is the misc
\ which is a 16 Bit processor with word addresses
\ but the forth system we build has a normal byte
\ addressed memory model
Plugin doprim, \ compiles start of a primitive
Plugin docol, \ compiles start of a colon definition
......@@ -904,18 +908,9 @@ Variable cross-space-dp-orig
THEN ;
Defer is-forward
Defer do-refered
: prim-forward ( ghost -- )
\ ." PF" .sourcepos
colonmark, 0 do-refered ; \ compile space for call
: doer-forward ( ghost -- )
\ ." DF" .sourcepos
colonmark, 2 do-refered ; \ compile space for doer
' prim-forward IS is-forward
: (ghostheader) ( -- )
ghost-list linked <fwd> , 0 , ['] NoExec , what's is-forward ,
ghost-list linked <fwd> , 0 , ['] NoExec , ['] is-forward ,
0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , ;
: ghostheader ( -- ) (ghostheader) 0 , ;
......@@ -1092,14 +1087,9 @@ Ghost lit-perform drop
Ghost lit+ drop
Ghost does-exec drop
' doer-forward IS is-forward
Ghost :docol Ghost :doesjump Ghost :dodoes 2drop drop
Ghost :dovar drop
' prim-forward IS is-forward
\ \ Parameter for target systems 06oct92py
......@@ -1658,11 +1648,6 @@ T has? relocate H
>CROSS
: call-forward ( ghost -- )
\ ." CF" .sourcepos
there 0 colon, 0 do-refered ;
' call-forward IS is-forward
Ghost (do) Ghost (?do) 2drop
Ghost (for) drop
Ghost (loop) Ghost (+loop) 2drop
......@@ -1672,8 +1657,6 @@ Ghost (.") Ghost (S") Ghost (ABORT") 2drop drop
Ghost (C") drop
Ghost ' drop
\ ' prim-forward IS is-forward
\ user ghosts
Ghost state drop
......@@ -1735,7 +1718,6 @@ previous
>CROSS
: (cc) T a, H ; ' (cc) plugin-of colon,
: (xt) T a, H ; ' (xt) plugin-of xt,
: (prim) T a, H ; ' (prim) plugin-of prim,
: (cr) >tempdp colon, tempdp> ; ' (cr) plugin-of colon-resolve
......@@ -1749,8 +1731,7 @@ previous
tempdp> ; ' (dr) plugin-of doer-resolve
: (cm) ( -- addr )
T here align H
-1 xt, ; ' (cm) plugin-of colonmark,
there -1 colon, ; ' (cm) plugin-of colonmark,
>TARGET
: compile, ( xt -- )
......@@ -1778,8 +1759,6 @@ previous
space>
;
' (refered) IS do-refered
: refered ( ghost tag -- )
\G creates a resolve structure
T here aligned H swap (refered)
......@@ -1837,11 +1816,18 @@ Defer resolve-warning
>link ! ;
: colon-resolved ( ghost -- )
>link @ colon, ; \ compile-call
\ compiles a call to a colon definition,
\ compile action for >comp field
>link @ colon, ;
: prim-resolved ( ghost -- )
\ compiles a call to a primitive
>link @ prim, ;
: (is-forward) ( ghost -- )
colonmark, 0 (refered) ; \ compile space for call
' (is-forward) IS is-forward
0 Value resolved
: resolve ( ghost tcfa -- )
......@@ -1864,10 +1850,16 @@ Defer resolve-warning
\ mark ghost as resolved
dup r@ >link ! <res> r@ >magic !
r@ to resolved
r@ >comp @ ['] prim-forward = IF
['] prim-resolved r@ >comp ! THEN
r@ >comp @ what's is-forward = IF
['] prim-resolved r@ >comp ! THEN
\ r@ >comp @ ['] is-forward =
\ ABORT" >comp action not set on a resolved ghost"
\ copmile action defaults to colon-resolved
\ if this is not right something must be set before
\ calling resolve
r@ >comp @ ['] is-forward = IF
['] colon-resolved r@ >comp !
THEN
\ loop through forward referencies
r> -rot
comp-state @ >r Resolving comp-state !
......@@ -2217,6 +2209,7 @@ Variable prim#
.sourcepos ." needs prim: " >in @ bl word count type >in ! cr
THEN
prim# @ (THeader ( S xt ghost )
['] prim-resolved over >comp !
dup >ghost-flags <primitive> set-flag
over resolve T A, H alias-mask flag!
-1 prim# +! ;
......@@ -2298,6 +2291,8 @@ T 2 cells H Value xt>body
: (docol,) ( -- ) [G'] :docol (doer,) ; ' (docol,) plugin-of docol,
' NOOP plugin-of ca>native
: (doprim,) ( -- )
there xt>body + ca>native T a, H 1 fillcfa ; ' (doprim,) plugin-of doprim,
......@@ -2336,15 +2331,23 @@ Defer (end-code)
>TARGET
: Code
defempty?
(THeader there resolve
(THeader ( ghost )
['] prim-resolved over >comp !
there resolve
[ T e? prims H 0= [IF] T e? ITC H [ELSE] true [THEN] ] [IF]
doprim,
[THEN]
depth (code) ;
\ FIXME : no-compile -1 ABORT" this ghost is not for compilation" ;
: Code:
defempty?
Ghost dup there ca>native resolve <do:> swap >magic !
Ghost >r
r@ there ca>native resolve
<do:> r@ >magic !
r> drop
depth (code) ;
: end-code
......@@ -2513,6 +2516,7 @@ Cond: [ ( -- ) interpreting-state ;Cond
: !does ( does-action -- )
tlastcfa @ [G'] :dovar killref
>space here >r ghostheader space>
['] colon-resolved r@ >comp !
r@ created >do:ghost ! r@ swap resolve
r> tlastcfa @ >tempdp dodoes, tempdp> ;
......@@ -2796,7 +2800,7 @@ DO: abort" Not in cross mode" ;DO
\ this section defines different compilation
\ actions for created words
\ this will help the peephole optimizer
\ I (jaw) took this from bernds lates cross-compiler
\ I (jaw) took this from bernds latest cross-compiler
\ changes but seperated it from the original
\ Builder words. The final plan is to put this
\ into a seperate file, together with the peephole
......@@ -2808,12 +2812,13 @@ T has? peephole H [IF]
>CROSS
: (callc) compile call T >body a, H ; ' (callc) plugin-of colon,
: (callcm) T here 0 a, 0 a, H ; ' (callcm) plugin-of colonmark,
: (call-res) >tempdp resolved gexecute tempdp> drop ;
' (call-res) plugin-of colon-resolve
: (prim) dup 0< IF $4000 - ELSE
." wrong usage of (prim) "
dup gdiscover IF .ghost ELSE . THEN cr -2 throw THEN
T a, H ; ' (prim) plugin-of prim,
: (pprim) dup 0< IF $4000 - ELSE
cr ." wrong usage of (prim) "
dup gdiscover IF .ghost ELSE . THEN cr -1 throw THEN
T a, H ; ' (pprim) plugin-of prim,
\ if we want this, we have to spilt aconstant
\ and constant!!
......
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