Add to:/defer@: and ~-opt: to cross compiler

parent 369da799
Pipeline #713 passed with stage
in 8 minutes and 31 seconds
......@@ -3161,6 +3161,11 @@ ghost :dodefer drop
: opt: ( -- colon-sys ) gstart-xt set-optimizer ;
: comp: ( -- colon-sys ) gstart-xt set-optimizer ;
: to: T : H ;
: defer@: T : H ;
: to-opt: T opt: H ;
: defer@-opt: T opt: H ;
variable cross-boot$[]
variable cross-boot[][]
......
......@@ -237,6 +237,10 @@ PARSED-TYPE specifies what kind of text is parsed. It should be on of 'name',
(("]" "]l") definition-starter (font-lock-keyword-face . 1))
((":") definition-starter (font-lock-keyword-face . 1)
"[ \t\n]" t name (font-lock-function-name-face . 3))
(("to:") definition-starter (font-lock-keyword-face . 1)
"[ \t\n]" t name (font-lock-function-name-face . 3))
(("defer@:") definition-starter (font-lock-keyword-face . 1)
"[ \t\n]" t name (font-lock-function-name-face . 3))
(("event:") definition-starter (font-lock-keyword-face . 1)
"[ \t\n]" t name (font-lock-function-name-face . 3))
(("immediate" "compile-only" "restrict")
......
......@@ -396,14 +396,12 @@ include ./recognizer.fs
: s>int ( nt -- xt ) >body @ name>int ;
: s>comp ( nt -- xt1 xt2 ) >body @ name>comp ;
: s-to ( val nt -- )
\ actually a TO: TO-OPT: word, but cross.fs does not support that
to: s-to ( val nt -- )
>body @ (int-to) ;
opt: >body @ (comp-to) ;
: s-defer@ ( xt1 -- xt2 )
\ actually a DEFER@ DEFER@-OPT: word, but cross.fs does not support that
to-opt: ( xt -- ) >body @ (comp-to) ;
defer@: s-defer@ ( xt1 -- xt2 )
>body @ defer@ ;
opt: >body @ defer@, ;
defer@-opt: ( xt -- ) >body @ defer@, ;
: s-compile, ( xt -- ) >body @ compile, ;
: Alias ( xt "name" -- ) \ gforth
......@@ -495,12 +493,10 @@ defer defer-default ( -- )
Header Reveal dodefer, ?noname-vt
['] defer-default A, ;
\ The following should use DEFER@: and DEFER@-OPT:, but cross.fs does
\ not support them.
: defer-defer@ ( xt -- )
defer@: defer-defer@ ( xt -- )
\ The defer@ implementation of children of DEFER
>body @ ;
opt: ( xt -- )
defer@-opt: ( xt -- )
>body lit, postpone @ ;
: Defers ( compilation "name" -- ; run-time ... -- ... ) \ gforth
......@@ -643,13 +639,12 @@ interpret/compile: comp:
' (int-to) alias defer! ( xt xt-deferred -- ) \ gforth defer-store
\G Changes the @code{defer}red word @var{xt-deferred} to execute @var{xt}.
\ The following should use TO: OPT-TO:, but that's not supported by cross.fs
: value-to ( n value-xt -- ) \ gforth-internal
to: value-to ( n value-xt -- ) \ gforth-internal
\g this is the TO-method for normal values; it's tickable, but the
\g only purpose of its xt is to be consumed by @code{set-to}. It
\g does not compile like a proper word.
>body !-table to-!exec ;
opt: ( value-xt -- ) \ run-time: ( n -- )
to-opt: ( value-xt -- ) \ run-time: ( n -- )
>body postpone ALiteral !-table to-!, ;
: <IS> ( "name" xt -- ) \ gforth
......
......@@ -35,18 +35,14 @@
\ : :loc, >body ['] call-loc peephole-compile, , ;
: (uv) ( xt addr -- ) 2@ next-task + @ cell- @ swap cells + ;
: umethod! ( xt xt-method -- )
\ this is not a proper word, but a TO: OPT-TO: word (but the
\ cross-compiler does not implement them).
to: umethod! ( xt xt-method -- )
>body cell+ (uv) ! ;
opt: ( xt-method -- )
to-opt: ( xt-method -- )
>body cell+ lit, postpone (uv) postpone ! ;
: umethod@ ( addr -- xt )
\ this is not a proper word, but a DEFER@: OPT-DEFER@: word (but
\ the cross-compiler does not implement them).
defer@: umethod@ ( addr -- xt )
>body cell+ (uv) @ ;
opt: ( xt-method -- )
defer@-opt: ( xt-method -- )
>body cell+ lit, postpone (uv) postpone @ ;
AVariable vtable-list
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