Commit f1c69d2c authored by Bernd Paysan's avatar Bernd Paysan

Changed names for smart compile, to match VFX

parent 99bc4ac9
......@@ -73,10 +73,10 @@ variable assert-level ( -- a-addr ) \ gforth
IF ['] noop assert-canary ELSE postpone ( THEN ;
: debug: ( -- ) Create false ,
debug-does>
COMPILE> >body
comp: >body
]] Literal @ IF [[ [: ]] THEN [[ ;] assert-canary ;
: )else( ]] ) ( [[ ;
compile> drop 2>r ]] ELSE [[ 2r> ;
comp: drop 2>r ]] ELSE [[ 2r> ;
: else( ['] noop assert-canary ; immediate
: +db ( "word" -- ) ' >body on ;
......
......@@ -106,7 +106,7 @@ IS store-backtrace
: bt ( -- )
\G backtrace for interactive use
backtrace-rp0 @ #10 cells + dup 3 cells - @ cell- print-backtrace ;
compile> drop ]] store-backtrace dobacktrace nothrow [[ ;
comp: drop ]] store-backtrace dobacktrace nothrow [[ ;
:noname ( -- )
backtrace-rs-buffer 2@ over + print-backtrace ;
......
......@@ -691,7 +691,10 @@ Variable comp-state
['] pi-undefined , \ action
['] pi-undefined , \ target plugin action
8765 , \ plugin magic
[IFDEF] value!
[IFDEF] set-to
['] value! set-to
[THEN]
[IFDEF] !to
['] value! !to
[THEN]
DOES> perform ;
......@@ -2921,7 +2924,7 @@ Create vttemplate vtsize allot
T here H lastxt T 0 cell+ H -
dup [G'] docol-vt killref T ! H [T'] no-to 0 T vtable, H ;
: compile> ( -- colon-sys )
: comp: ( -- colon-sys )
T 0 cell+ cfoddalign here vtsize cell+ H + [T'] post, T >vtable :noname H drop ;
>CROSS
......
......@@ -71,7 +71,7 @@ stderr value debug-fid ( -- fid )
\G Prints the source code location of the @code{~~} and the stack
\G contents with @code{.debugline}.
current-sourcepos .debugline-directed ;
compile> ( compilation -- ; run-time -- ) drop
comp: ( compilation -- ; run-time -- ) drop
compile-sourcepos POSTPONE .debugline-directed ;
:noname ( -- ) stderr to debug-fid defers 'cold ; IS 'cold
......@@ -122,9 +122,9 @@ s" You've reached a !!FIXME!! marker" exception constant FIXME#
\ watching variables and values
: watch-does> ( -- ) DOES> dup @ ~~ drop ;
: watch-compile> ( xt -- ) compile> >body ]] Literal dup @ ~~ drop [[ ;
: watch-comp: ( xt -- ) comp: >body ]] Literal dup @ ~~ drop [[ ;
: ~~Variable ( "name" -- )
Create 0 , watch-does> watch-compile> ;
Create 0 , watch-does> watch-comp: ;
: ~~Value ( n "name" -- )
Value [: ~~ >body ! ; compile> drop ]] Literal ~~ >body ! [[ ;] !to ;
Value [: ~~ >body ! ; comp: drop ]] Literal ~~ >body ! [[ ;] set-to ;
......@@ -159,8 +159,8 @@ si-prefixes count bl scan drop Constant zero-exp
[ifdef] r:fail
: r:fnumber ;
compile> drop postpone Fliteral ;
postpone> >r postpone Fliteral r> post, ;
comp: drop postpone Fliteral ;
post: >r postpone Fliteral r> post, ;
: fnum-recognizer ( addr u -- float int-table | r:fail )
prefix-number
......
......@@ -319,12 +319,12 @@ variable locals-dp \ so here's the special dp for locals.
vocabulary locals-types \ this contains all the type specifyers, -- and }
locals-types definitions
[IFDEF] !to
[IFDEF] set-to
: to-w: ( -- ) -14 throw ;
compile> drop POSTPONE laddr# >body @ lp-offset, POSTPONE ! ;
comp: drop POSTPONE laddr# >body @ lp-offset, POSTPONE ! ;
[THEN]
: W: ( "name" -- a-addr xt ) \ gforth w-colon
create-local [IFDEF] !to ['] to-w: !to [THEN]
create-local [IFDEF] set-to ['] to-w: set-to [THEN]
\ xt produces the appropriate locals pushing code when executed
['] compile-pushlocal-w
does> ( Compilation: -- ) ( Run-time: -- w )
......@@ -337,12 +337,12 @@ locals-types definitions
does> ( Compilation: -- ) ( Run-time: -- w )
postpone laddr# @ lp-offset, ;
[IFDEF] !to
[IFDEF] set-to
: to-f: ( -- ) -14 throw ;
compile> drop POSTPONE laddr# >body @ lp-offset, POSTPONE f! ;
comp: drop POSTPONE laddr# >body @ lp-offset, POSTPONE f! ;
[THEN]
: F: ( "name" -- a-addr xt ) \ gforth f-colon
create-local [IFDEF] !to ['] to-f: !to [THEN]
create-local [IFDEF] set-to ['] to-f: set-to [THEN]
['] compile-pushlocal-f
does> ( Compilation: -- ) ( Run-time: -- w )
@ lp-offset compile-f@local ;
......@@ -353,12 +353,12 @@ locals-types definitions
does> ( Compilation: -- ) ( Run-time: -- w )
postpone laddr# @ lp-offset, ;
[IFDEF] !to
[IFDEF] set-to
: to-d: ( -- ) -14 throw ;
compile> drop POSTPONE laddr# >body @ lp-offset, POSTPONE 2! ;
comp: drop POSTPONE laddr# >body @ lp-offset, POSTPONE 2! ;
[THEN]
: D: ( "name" -- a-addr xt ) \ gforth d-colon
create-local [IFDEF] !to ['] to-d: !to [THEN]
create-local [IFDEF] set-to ['] to-d: set-to [THEN]
['] compile-pushlocal-d
does> ( Compilation: -- ) ( Run-time: -- w )
postpone laddr# @ lp-offset, postpone 2@ ;
......@@ -369,12 +369,12 @@ locals-types definitions
does> ( Compilation: -- ) ( Run-time: -- w )
postpone laddr# @ lp-offset, ;
[IFDEF] !to
[IFDEF] set-to
: to-c: ( -- ) -14 throw ;
compile> drop POSTPONE laddr# >body @ lp-offset, POSTPONE c! ;
comp: drop POSTPONE laddr# >body @ lp-offset, POSTPONE c! ;
[THEN]
: C: ( "name" -- a-addr xt ) \ gforth c-colon
create-local [IFDEF] !to ['] to-c: !to [THEN]
create-local [IFDEF] set-to ['] to-c: set-to [THEN]
['] compile-pushlocal-c
does> ( Compilation: -- ) ( Run-time: -- w )
postpone laddr# @ lp-offset, postpone c@ ;
......@@ -762,7 +762,7 @@ is free-old-local-names
code-address!
then ;
[IFUNDEF] !to
[IFUNDEF] set-to
: (int-to) ( xt -- ) dup >definer
case
[ ' locals-wordlist ] literal >definer \ value
......@@ -794,7 +794,7 @@ is free-old-local-names
: TO ( c|w|d|r "name" -- ) \ core-ext,local
' (int-to) ;
compile> drop comp' drop (comp-to) ;
comp: drop comp' drop (comp-to) ;
[THEN]
: locals| ( ... "name ..." -- ) \ local-ext locals-bar
......
......@@ -443,22 +443,22 @@ defer defer-default ( -- )
defstart ;
\ : !does ( addr -- ) \ gforth store-does
\ ['] spaces >namevt @ >vtcompile, @ !compile,
\ ['] spaces >namevt @ >vtcompile, @ set-compiler
\ latestxt does-code! ;
extra>-dummy (doextra-dummy)
: !extra ( addr -- ) \ gforth store-extra
vttemplate >vtcompile, @ ['] udp >namevt @ >vtcompile, @ =
IF
['] extra, !compile,
['] extra, set-compiler
THEN
latestxt extra-code! ;
: DOES> ( compilation colon-sys1 -- colon-sys2 ; run-time nest-sys -- ) \ core extra
cfalign 0 , here !extra ] defstart :-hook ;
compile> drop ['] !extra does>-like :-hook ;
comp: drop ['] !extra does>-like :-hook ;
\ compile> to define compile, action
\ comp: to define compile, action
Create vttemplate 0 A, ' peephole-compile, A, ' post, A, 0 A, ' no-to A, \ initialize to one known vt
......@@ -489,17 +489,17 @@ Create vttemplate 0 A, ' peephole-compile, A, ' post, A, 0 A, ' no-to A, \ initi
: start-xt-like ( colonsys xt -- colonsys )
nip reveal does>-like drop start-xt drop ;
: !compile, ( xt -- ) vttemplate >vtcompile, ! ;
: !postpone ( xt -- ) vttemplate >vtpostpone ! ;
: !to ( xt -- ) vttemplate >vtto ! ;
: set-compiler ( xt -- ) vttemplate >vtcompile, ! ;
: set-postpone ( xt -- ) vttemplate >vtpostpone ! ;
: set-to ( xt -- ) vttemplate >vtto ! ;
: compile> ( -- colon-sys )
start-xt !compile, ;
compile> ['] !compile, start-xt-like ; ( compilation colon-sys1 -- colon-sys2 ; run-time nest-sys -- ) \ gforth compile-to
: comp: ( -- colon-sys )
start-xt set-compiler ;
comp: ['] set-compiler start-xt-like ; ( compilation colon-sys1 -- colon-sys2 ; run-time nest-sys -- ) \ gforth compile-to
: postpone> ( -- colon-sys )
start-xt !postpone ;
compile> ['] !postpone start-xt-like ; ( compilation colon-sys1 -- colon-sys2 ; run-time nest-sys -- ) \ gforth lit-to
: post: ( -- colon-sys )
start-xt set-postpone ;
comp: ['] set-postpone start-xt-like ; ( compilation colon-sys1 -- colon-sys2 ; run-time nest-sys -- ) \ gforth lit-to
\ defer and friends
......@@ -509,7 +509,7 @@ compile> ['] !postpone start-xt-like ; ( compilation colon-sys1 -- colon-sy
: value! ( xt xt-deferred -- ) \ gforth defer-store
>body ! ;
compile> drop >body postpone ALiteral postpone ! ;
comp: drop >body postpone ALiteral postpone ! ;
: <IS> ( "name" xt -- ) \ gforth
\g Changes the @code{defer}red word @var{name} to execute @var{xt}.
......@@ -525,7 +525,7 @@ compile> drop >body postpone ALiteral postpone ! ;
: TO ( value "name" -- )
(') (name>x) drop (int-to) ;
compile> drop (') (name>x) drop (comp-to) ;
comp: drop (') (name>x) drop (comp-to) ;
' TO alias IS
......@@ -560,7 +560,7 @@ defer ;-hook ( sys2 -- sys1 )
: interpret/compile: ( interp-xt comp-xt "name" -- ) \ gforth
>r >r : r> compile, postpone ;
start-xt !compile, postpone drop r> compile, postpone ; ;
start-xt set-compiler postpone drop r> compile, postpone ; ;
\ \ Search list handling: reveal words, recursive 23feb93py
......
......@@ -28,7 +28,7 @@ has? new-does [IF]
: >comp ( xt -- ) name>comp execute ;
: post, ( xt -- ) lit, postpone >comp ;
: no-to ( -- ) -32 throw ;
compile> -32 throw ;
comp: -32 throw ;
[THEN]
require ./basics.fs \ bounds decimal hex ...
......
......@@ -61,7 +61,7 @@ require ./vars.fs
[ [THEN] ]
;
has? compiler [IF]
compile> drop [char] " parse postpone SLiteral ;
comp: drop [char] " parse postpone SLiteral ;
[THEN]
: ." ( compilation 'ccc"' -- ; run-time -- ) \ core dot-quote
......@@ -72,5 +72,5 @@ has? compiler [IF]
\G display a string from within a definition; see examples below.
[char] " parse type ;
has? compiler [IF]
compile> drop [char] " parse postpone sLiteral postpone type ;
comp: drop [char] " parse postpone sLiteral postpone type ;
[THEN]
......@@ -147,7 +147,7 @@ User (i)
: [I] ( -- n ) \ gforth bracket-i
(i) @ ;
compile> drop (i) @ postpone Literal ;
comp: drop (i) @ postpone Literal ;
: [BEGIN] ( -- ) \ gforth bracket-begin
>in @ >r BEGIN r@ >in ! interpret UNTIL rdrop ; immediate
......
......@@ -3,11 +3,11 @@
\ template for methods and ivars
Create o 0 , DOES> @ o#+ [ 0 , ] + ;
compile> >body @ postpone o#+ , ;
comp: >body @ postpone o#+ , ;
: to-m >body @ + ! ;
Create m 0 , DOES> @ o#+ [ -1 cells , ] @ + perform ;
compile> >body @ cell/ postpone o#exec , ;
' to-m !to
comp: >body @ cell/ postpone o#exec , ;
' to-m set-to
' o Value var-xt
' m Value method-xt
: current-o ['] o to var-xt ['] m to method-xt ;
......
......@@ -18,8 +18,8 @@
\ along with this program. If not, see http://www.gnu.org/licenses/.
: r:to (int-to) ;
compile> drop (comp-to) ;
postpone> >r lit, r> post, ;
comp: drop (comp-to) ;
post: >r lit, r> post, ;
: to-recognizer ( addr u -- xt r:to | r:fail )
2dup s" ->" string-prefix? 0= IF 2drop ['] r:fail EXIT THEN
......
\ anonymous definitions in a definition
:noname false :noname ;
:noname locals-wordlist last @ lastcfa @ leave-sp @
: [: ( -- quotation-sys )
\G Starts a quotation
false :noname ;
comp: drop locals-wordlist last @ lastcfa @ leave-sp @
postpone AHEAD
locals-list @ locals-list off
postpone SCOPE
true :noname ;
interpret/compile: [: ( -- quotation-sys )
\G Starts a quotation
: ;] ( compile-time: quotation-sys -- ; run-time: -- xt )
\g ends a quotation
......
......@@ -20,8 +20,8 @@
: slit, postpone sliteral ;
: r:string ;
compile> drop slit, ;
postpone> >r slit, r> post, ;
comp: drop slit, ;
post: >r slit, r> post, ;
: string-recognizer ( addr u -- addr u' r:string | r:fail )
2dup s\" \"" string-prefix?
......
......@@ -352,7 +352,7 @@ comp' sliteral drop alias postpone-sliteral
: action-of ( interpretation "name" -- xt; compilation "name" -- ; run-time -- xt ) \ gforth
' defer@ ;
compile> drop postpone ['] postpone defer@ ;
comp: drop postpone ['] postpone defer@ ;
\G @i{Xt} is the XT that is currently assigned to @i{name}.
' action-of Alias what's ( interpretation "name" -- xt; compilation "name" -- ; run-time -- xt ) \ gforth-obsolete
......
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