Commit a5f043c7 authored by Bernd Paysan's avatar Bernd Paysan

Get rid of dodoes: in the kernel, still has some closure issues

parent 468de529
Pipeline #660 passed with stage
in 8 minutes and 42 seconds
......@@ -1912,12 +1912,11 @@ previous
: (cr) >tempdp colon, tempdp> ; ' (cr) plugin-of colon-resolve
: (ar) T ! H ; ' (ar) plugin-of addr-resolve
: doer/does, ( ghost -- )
dup >magic @ <do:> =
IF doer, ELSE dodoes, THEN ;
: (dr) ( ghost res-pnt target-addr addr )
>tempdp drop over
dup >magic @ <do:> =
IF doer,
ELSE dodoes,
THEN
>tempdp drop over doer/does,
tempdp> ; ' (dr) plugin-of doer-resolve
: (cm) ( -- addr )
......@@ -2587,15 +2586,19 @@ T 2 cells H Value xt>body
: (doeshandler,) ( -- )
T H ; ' (doeshandler,) plugin-of doeshandler,
Defer gset-extra
: (dodoes,) ( does-action-ghost -- )
]comp [G'] :dodoes addr, comp[
addr,
2 fillcfa ; ' (dodoes,) plugin-of dodoes,
]comp [G'] :dodoes addr, comp[
dup gset-extra
addr,
2 fillcfa ;
: doextraxt, ( -- )
]comp [G'] :doextraxt addr, comp[
0 addr,
2 fillcfa ;
: doextraxt, ( does-action-ghost -- )
]comp [G'] :doextraxt addr, comp[
0 addr,
gset-extra
2 fillcfa ; ' doextraxt, plugin-of dodoes,
: (dlit,) ( n -- ) compile lit td, ; ' (dlit,) plugin-of dlit,
......@@ -2825,7 +2828,6 @@ Cond: [ ( -- ) interpreting-state ;Cond
Ghost does, drop
Defer gset-optimizer
Defer gset-extra
: !does ( does-action -- )
tlastcfa @ [G'] :dovar killref
......@@ -2860,22 +2862,13 @@ X has? primcentric [IF]
IF there resolve THEN ;
Cond: DOES>
T here H [ T has? primcentric H [IF] ] 5 [ [ELSE] ] 4 [ [THEN] ] T cells
H + alit, compile !does compile ;s
doeshandler, resolve-does>-part
;Cond
Cond: EXTRA>
T here cfaligned H [ T has? primcentric H [IF] ] 8 [ [ELSE] ] 7 [ [THEN] ] T cells
H + alit, compile !extraxt compile ;
T :noname H 2drop depth resolve-does>-part
Last-Header-Ghost @ >do:ghost @ >r
T :noname H
r> ?dup IF swap resolve ELSE drop THEN
;Cond
: oldDOES>
['] does-resolved created >comp !
switchrom doeshandler, T here H !does
instant-interpret-does>-hook
depth ;Resolve off T ] H ;
: DOES>
['] extra-resolved created >comp !
T here cfaligned #10 cells H \ includes noname header+vtable
......@@ -2931,14 +2924,11 @@ Cond: DOES>
: gdoes, ( ghost -- )
\ makes the codefield for a word that is built
>do:ghost @ dup undefined? 0=
IF
dup >magic @ <do:> =
IF doer,
ELSE dodoes,
THEN
>do:ghost @ dup undefined? 0=
IF
doer/does,
EXIT
THEN
THEN
\ compile :dodoes gexecute
\ T here H tcell - reloff
2 refered
......@@ -3215,8 +3205,7 @@ variable cross-boot[][]
>space here >r ghostheader space>
['] colon-resolved r@ >comp !
r@ created >do:ghost ! r@ swap resolve
r> gset-extra
tlastcfa @ >tempdp doextraxt, tempdp> ;
r> tlastcfa @ >tempdp doextraxt, tempdp> ;
IS !newdoes
: ;DO ( [xt] [colon-sys] -- )
......
......@@ -81,7 +81,7 @@ $10 stack: cov-stack
coverage? cov-stack >stack false to coverage? ; immediate
: ]nocov ( -- )
\G end of temporary turned off coverage
cov-stack stack> to coverage? ; immediate
cov-stack stack> to coverage? ; immediate
\ print a no-overhead backtrace
......
......@@ -481,27 +481,6 @@ Variable to-style# 0 to-style# !
: !!?addr!! ( -- ) to-style# @ -1 = -2056 and throw ;
: uvalue-to ( n uvalue-xt -- )
\g uvalue-to is the to-method for uvalues; it's xt is only
\g there to be consumed by @code{set-to}.
\ should be defined with TO: OPT-TO:, but not supported by cross.fs
!!?addr!! >body @ next-task + !-table to-!exec ;
opt: ( uvalue-xt to-xt -- )
!!?addr!! drop >body @ postpone useraddr , !-table to-!, ;
: u-compile, ( xt -- ) >body @ postpone user@ , ;
: UValue ( "name" -- )
\G Define a per-thread value
Create cell uallot , ['] uvalue-to set-to
['] u-compile, set-optimizer
DOES> @ next-task + @ ;
: 2Constant ( w1 w2 "name" -- ) \ double two-constant
Create ( w1 w2 "name" -- )
2,
DOES> ( -- w1 w2 )
2@ ;
: (Field) Header reveal dofield, ?noname-vt ;
\ IS Defer What's Defers TO 24feb93py
......
......@@ -38,9 +38,6 @@ doer? :dodefer 0= [IF] \D compileddofillers .( DODEFER )
[THEN]
\D compileddofillers .( DO2CON )
| : 2Constant ( w1 w2 "name" -- )
DOES> ( -- w1 w2 )
2@ ;
doer? :docon 0= [IF] \D compileddofillers .( DOCON )
| : (Constant) DOES> @ ;
......
......@@ -19,8 +19,32 @@
hex \ everything now hex! 11may93jaw
\ important definers
: uvalue-to ( n uvalue-xt -- )
\g uvalue-to is the to-method for uvalues; it's xt is only
\g there to be consumed by @code{set-to}.
\ should be defined with TO: OPT-TO:, but not supported by cross.fs
!!?addr!! >body @ next-task + !-table to-!exec ;
opt: ( uvalue-xt to-xt -- )
!!?addr!! drop >body @ postpone useraddr , !-table to-!, ;
: u-compile, ( xt -- ) >body @ postpone user@ , ;
: UValue ( "name" -- )
\G Define a per-thread value
Create cell uallot , ['] uvalue-to set-to
['] u-compile, set-optimizer
DOES> @ next-task + @ ;
: 2Constant ( w1 w2 "name" -- ) \ double two-constant
Create ( w1 w2 "name" -- )
2,
DOES> ( -- w1 w2 )
2@ ;
\ important constants 17dec92py
\ dpANS6 (sect 3.1.3.1) says
\ "a true flag ... [is] a single-cell value with all bits set"
\ better definition: 0 0= constant true ( no dependence on 2's compl)
......
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