Add latestnt

parent a64290e5
Pipeline #867 passed with stage
in 10 minutes and 1 second
......@@ -391,16 +391,15 @@ FORTH_SRC = $(KERN_SRC) $(GFORTH_FI_DIST_SRC) $(EC_SRC) $(LIBCC_FORTH_SRC) \
make-app.fs doc/makedoc.fs locate.fs locate1.fs more.fs onebench.fs \
fft-bench.fs other.fs prims2x.fs prims2x0.6.2.fs proxy.fs random.fs \
regexp.fs regexp-test.fs sokoban.fs string.fs table.fs tags.fs tt.fs \
quotations.fs unbuffer.fs wordsets.fs 2012words.fs $(patsubst %, \
test/%, $(TEST_SRC)) bubble.fs siev.fs matrix.fs fib.fs oof.fs \
oofsampl.fs objects.fs objexamp.fs mini-oof.fs moof-exm.fs \
moofglos.fs fixpath.fs mini-oof2.fs moof2-example.fs callable.fs \
add.fs lib.fs oldlib.fs sieve.fs list.fs endtry-iferror.fs \
recover-endtry.fs $(patsubst %, unix/%, $(UNIX_SRC)) date.fs \
script.fs wf.fs traceall.fs rec-scope.fs rec-env.fs rec-meta.fs \
notfound.fs utf16.fs archive.fs cilk.fs sections.fs fixfiles.fs \
bits.fs reverse-words.fs config.fs set-compsem.fs coverage.fs \
tokenize.fs
unbuffer.fs wordsets.fs 2012words.fs $(patsubst %, test/%, \
$(TEST_SRC)) bubble.fs siev.fs matrix.fs fib.fs oof.fs oofsampl.fs \
objects.fs objexamp.fs mini-oof.fs moof-exm.fs moofglos.fs fixpath.fs \
mini-oof2.fs moof2-example.fs callable.fs add.fs lib.fs oldlib.fs \
sieve.fs list.fs endtry-iferror.fs recover-endtry.fs $(patsubst %, \
unix/%, $(UNIX_SRC)) date.fs script.fs wf.fs traceall.fs rec-scope.fs \
rec-env.fs rec-meta.fs notfound.fs utf16.fs archive.fs cilk.fs \
sections.fs fixfiles.fs bits.fs reverse-words.fs config.fs \
set-compsem.fs coverage.fs tokenize.fs
COMPAT = compat/README \
compat/anslocal.fs \
......
......@@ -48,7 +48,7 @@ Variable extra-locals ( additional hidden locals size )
locals-types definitions
: :}* ( vtaddr u latest latestxt wid 0 a-addr1 u1 ... xt -- ) \ gforth close-brace-dictionary
: :}* ( vtaddr u latest latestnt wid 0 a-addr1 u1 ... xt -- ) \ gforth close-brace-dictionary
0 lit, lits, here cell- >r
compile, ]] >lp [[
:}
......@@ -57,19 +57,19 @@ locals-types definitions
['] execute is end-d ['] noop is endref,
extra-locals off ;
: :}xt ( vtaddr u latest latestxt wid 0 a-addr1 u1 ... -- ) \ gforth close-brace-xt
: :}xt ( vtaddr u latest latestnt wid 0 a-addr1 u1 ... -- ) \ gforth close-brace-xt
\G end a closure's locals declaration. The closure will be allocated by
\G the xt on the stack, so the closure's run-time stack effect is @code{(
\G xt-alloc -- xt-closure}.
\ run-time: ( xt size -- ... )
[: swap execute ;] :}* ;
: :}d ( vtaddr u latest latestxt wid 0 a-addr1 u1 ... -- ) \ gforth close-brace-dictionary
: :}d ( vtaddr u latest latestnt wid 0 a-addr1 u1 ... -- ) \ gforth close-brace-dictionary
\G end a closure's locals declaration. The closure will be allocated in
\G the dictionary.
['] allocd :}* ;
: :}h ( vtaddr u latest latestxt wid 0 a-addr1 u1 ... -- ) \ gforth close-brace-heap
: :}h ( vtaddr u latest latestnt wid 0 a-addr1 u1 ... -- ) \ gforth close-brace-heap
\G end a closure's locals declaration. The closure will be allocated on
\G the heap.
['] alloch :}* ;
......@@ -86,7 +86,7 @@ forth definitions
locals-types definitions
: :}l ( vtaddr u latest latestxt wid 0 a-addr1 u1 ... -- ) \ gforth close-brace-locals
: :}l ( vtaddr u latest latestnt wid 0 a-addr1 u1 ... -- ) \ gforth close-brace-locals
\G end a closure's locals declaration. The closure will be allocated on
\G the local's stack.
:}
......@@ -108,7 +108,7 @@ forth definitions
: closure-:-hook ( sys -- sys addr xt n )
\ addr is the nfa of the defined word, xt its xt
latest latestxt
latest latestnt
clear-leave-stack
dead-code off
defstart ;
......@@ -130,7 +130,7 @@ forth definitions
endcase
['] (closure-;]) colon-sys-xt-offset stick ;
: [{: ( -- vtaddr u latest latestxt wid 0 ) \ gforth-experimental start-closure
: [{: ( -- vtaddr u latest latestnt wid 0 ) \ gforth-experimental start-closure
\G starts a closure. Closures first declare the locals frame they are
\G going to use, and then the code that is executed with those locals.
\G Closures end like quotations with a @code{;]}. The locals declaration
......@@ -147,7 +147,7 @@ forth definitions
postpone {:
; immediate compile-only
: <{: ( -- vtaddr u latest latestxt wid 0 ) \ gforth-experimental start-homelocation
: <{: ( -- vtaddr u latest latestnt wid 0 ) \ gforth-experimental start-homelocation
\G starts a home location
#0. push-locals postpone {:
; immediate compile-only
......
......@@ -57,7 +57,7 @@ vocabulary assembler ( -- ) \ tools-ext
: (;code) ( -- ) \ gforth
\ execution semantics of @code{;code}
r> latestxt code-address! ;
r> latestnt code-address! ;
[ifundef] ?colon-sys
: ?colon-sys ( ... xt tag -- )
......@@ -65,7 +65,7 @@ vocabulary assembler ( -- ) \ tools-ext
[then]
:noname ( -- colon-sys )
align here latestxt code-address!
align here latestnt code-address!
defstart init-asm ;
:noname ( colon-sys1 -- colon-sys2 ) \ tools-ext semicolon-code
( create the [;code] part of a low level defining word )
......@@ -80,7 +80,7 @@ interpret/compile: ;code ( compilation. colon-sys1 -- colon-sys2 ) \ tools-ext s
[ifdef] do;abicode:
: !;abi-code ( addr -- )
latestxt do;abicode: any-code! ;
latestnt do;abicode: any-code! ;
: ;abi-code ( -- ) \ gforth semicolon-abi-code
['] !;abi-code does>-like postpone [ init-asm ; immediate
......@@ -91,5 +91,5 @@ interpret/compile: ;code ( compilation. colon-sys1 -- colon-sys2 ) \ tools-ext s
\G return from the ABI call (for @code{abi-code}) or the dispatch
\G to the next VM instruction (for @code{code} and @code{;code})
\G yourself.
latestxt here over - flush-icache
latestnt here over - flush-icache
previous ?struc reveal ;
......@@ -220,7 +220,7 @@ set-current
' NestXT IF EXIT THEN (debug) Leave-D ;
: break:, ( -- )
latestxt postpone literal ;
latestnt postpone literal ;
: break: ( -- ) \ gforth
break:, postpone (break:) ; immediate
......
......@@ -457,22 +457,22 @@ create new-locals-map ( -- wordlist-map )
new-locals-map mappedwordlist Constant new-locals-wl
\ and now, finally, the user interface words
: { ( -- vtaddr u latest latestxt wid 0 ) \ gforth open-brace
: { ( -- vtaddr u latest latestnt wid 0 ) \ gforth open-brace
( >docolloc ) vtsave \ as locals will mess with their own vttemplate
latest latestxt get-current
latest latestnt get-current
get-order new-locals-wl swap 1+ set-order
also locals definitions locals-types
val-part off
0 TO locals-wordlist
0 postpone [ ; immediate
synonym {: { ( -- vtaddr u latest latestxt wid 0 ) \ forth-2012 open-brace-colon
synonym {: { ( -- vtaddr u latest latestnt wid 0 ) \ forth-2012 open-brace-colon
\G Start standard locals declaration. All Gforth locals extensions are
\G supported by Gforth, though the standard only supports the subset of cells.
locals-types definitions
: } ( vtaddr u latest latestxt wid 0 a-addr1 u1 ... -- ) \ gforth close-brace
: } ( vtaddr u latest latestnt wid 0 a-addr1 u1 ... -- ) \ gforth close-brace
\ ends locals definitions
]
begin
......@@ -483,13 +483,13 @@ locals-types definitions
drop vt,
locals-size @ alignlp-f locals-size ! \ the strictest alignment
previous previous
set-current lastcfa ! last !
set-current lastnt ! last !
vtrestore
locals-list 0 wordlist-id - TO locals-wordlist ;
synonym :} }
: -- ( vtaddr u latest latestxt wid 0 ... -- ) \ gforth dash-dash
: -- ( vtaddr u latest latestnt wid 0 ... -- ) \ gforth dash-dash
}
BEGIN '}' parse dup WHILE
+ 1- c@ dup bl = swap ':' = or UNTIL
......@@ -611,7 +611,7 @@ is adjust-locals-list
: locals-:-hook ( sys -- sys addr xt n )
\ addr is the nfa of the defined word, xt its xt
DEFERS :-hook
latest latestxt
latest latestnt
clear-leave-stack
0 locals-size !
0 locals-list!
......@@ -628,7 +628,7 @@ is free-old-local-names
: locals-;-hook ( sys addr xt sys -- sys )
?struc
0 TO locals-wordlist
lastcfa ! last !
lastnt ! last !
DEFERS ;-hook ;
\ THEN (another control flow from before joins the current one):
......
......@@ -155,7 +155,7 @@ Defer check-shadow ( addr u wid -- )
cfalign 0 last !
here xt-location drop ;
: namevt, ( namevt -- )
, here lastcfa ! ; \ add location stamps on vt+cf
, here lastnt ! ; \ add location stamps on vt+cf
: noname-vt ( -- )
\G modify vt for noname words
......@@ -232,10 +232,14 @@ variable nextname$
\g be given by @code{latestxt}.
['] noname-header IS header-name, ;
: latestnt ( -- nt ) \ gforth
\G @i{nt} is the name token of the last word defined.
\ The main purpose of this word is to get the nt of words defined using noname
lastnt @ ;
: latestxt ( -- xt ) \ gforth
\G @i{xt} is the execution token of the last word defined.
\ The main purpose of this word is to get the xt of words defined using noname
lastcfa @ ;
lastnt @ name>int ;
' latestxt alias lastxt \ gforth-obsolete
\G old name for @code{latestxt}.
......@@ -271,9 +275,9 @@ immediate restrict
' noop Alias recurse
\g Alias to the current definition.
unlock tlastcfa @ lock >body AConstant lastcfa
\ this is the alias pointer in the recurse header, named lastcfa.
\ changing lastcfa now changes where recurse aliases to
unlock tlastcfa @ lock >body AConstant lastnt
\ this is the alias pointer in the recurse header, named lastnt.
\ changing lastnt now changes where recurse aliases to
\ it's always an alias of the current definition
\ it won't work in a flash/rom environment, therefore for Gforth EC
\ we stick to the traditional implementation
......@@ -290,7 +294,7 @@ Variable litstack
: cfa, ( code-address -- ) \ gforth cfa-comma
here
dup lastcfa !
dup lastnt !
0 A,
code-address! ;
......@@ -608,17 +612,17 @@ Create vttemplate
: make-latest ( xt -- )
\G make @i{xt} the latest definition, which can be manipulated
\G by @{immediate} and @code{set-*} operations
vt, dup last ! lastcfa ! ;
vt, dup last ! lastnt ! ;
: ?vt ( -- )
\G check if deduplicated, duplicate if necessary
lastcfa @ >namevt @ vttemplate <> IF
lastcfa @
lastnt @ >namevt @ vttemplate <> IF
lastnt @
dup >namevt @ vttemplate vtsize move
vt-activate
THEN ;
: !namevt ( addr -- ) latestxt >namevt ! ;
: !namevt ( addr -- ) latestnt >namevt ! ;
: general-compile, ( xt -- )
postpone literal postpone execute ;
......@@ -632,7 +636,7 @@ Create vttemplate
\G @code{set-optimizer} afterwards if you want a more efficient
\G implementation.
['] general-compile, set-optimizer
latestxt code-address! ;
latestnt code-address! ;
: set-does> ( xt -- ) \ gforth
\G Changes the current word such that it pushes its body address
\G and then executes @i{xt}. Also changes the \code{compile,}
......@@ -640,7 +644,7 @@ Create vttemplate
\G afterwards if you want a more efficient implementation.
['] does, set-optimizer
vttemplate >vtextra !
dodoes: latestxt code-address! ;
dodoes: latestnt code-address! ;
: set-to ( to-xt -- ) ?vt vttemplate >vtto ! ;
: set-defer@ ( defer@-xt -- ) ?vt vttemplate >vtdefer@ ! ;
: set->int ( xt -- ) ?vt vttemplate >vt>int ! ;
......@@ -758,7 +762,7 @@ defer 0-adjust-locals-size ( -- )
:noname ; aconstant dummy-noname
: :noname ( -- xt colon-sys ) \ core-ext colon-no-name
dummy-noname noname-from
latestxt colon-sys ] :-hook ;
latestnt colon-sys ] :-hook ;
: ; ( compilation colon-sys -- ; run-time nest-sys ) \ core semicolon
;-hook [compile] exit ?colon-sys
......
......@@ -400,9 +400,9 @@ defer adjust-locals-list ( wid -- )
\ quotations
: wrap@ ( -- wrap-sys )
vtsave latest latestxt leave-sp @ locals-wordlist ( unlocal-state @ ) ;
vtsave latest latestnt leave-sp @ locals-wordlist ( unlocal-state @ ) ;
: wrap! ( wrap-sys -- )
( unlocal-state ! ) to locals-wordlist leave-sp ! lastcfa ! last ! vtrestore ;
( unlocal-state ! ) to locals-wordlist leave-sp ! lastnt ! last ! vtrestore ;
: (int-;]) ( some-sys lastxt -- ) >r vt, wrap! r> ;
: (;]) ( some-sys lastxt -- )
......
......@@ -919,7 +919,7 @@ named-vt \ but is actually a named vt
' cfun, set-optimizer
' rt-does> set-does>
latestxt to rt-vtable
latestnt to rt-vtable
: (c-function) ( xt-parse "forth-name" "c-name" "{stack effect}" -- )
{ xt-parse-types }
......@@ -980,7 +980,7 @@ latestxt to rt-vtable
>r Create here dup ccb% dup allot erase
lib-handle-addr @ swap dup >r ccb-lha !
parse-function-types
here latestxt name>string string, count sanitize
here latestnt name>string string, count sanitize
callback# 1- r> ccb-num !
r> c-source-file-execute
['] callback-does> set-does> ;
......
......@@ -62,10 +62,6 @@ require compat/strcomp.fs
warnings off
\ redefinitions of kernel words not present in gforth-0.6.1
: latestxt lastcfa @ ;
: latest last @ ;
[IFUNDEF] try
include startup.fs
[THEN]
......
\ anonymous definitions in a definition
: [: ( -- 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 ;
: ;] ( compile-time: quotation-sys -- ; run-time: -- xt )
\g ends a quotation
POSTPONE ; >r IF
] postpone ENDSCOPE
locals-list !
postpone THEN
leave-sp ! lastcfa ! last ! to locals-wordlist
r> postpone ALiteral
ELSE r> THEN ( xt ) ; immediate
0 [IF] \ tests
: if-else ( ... f xt1 xt2 -- ... )
\ Postscript-style if-else
rot IF
drop
ELSE
nip
THEN
execute ;
: test ( f -- )
[: ." true" ;]
[: ." false" ;]
if-else ;
1 test cr \ writes "true"
0 test cr \ writes "false"
\ locals within quotations
: foo { a b } a b
[: { x y } x y + ;] execute . a . b . ;
2 3 foo
[THEN]
\ No newline at end of file
......@@ -44,7 +44,7 @@ standard:field
: extend-structure ( n "name" -- struct-sys n ) \ Gforth
\g extend an existing structure
standard:field >r 0 value latestxt >body r> ;
standard:field >r 0 value latestnt >body r> ;
: begin-structure ( "name" -- struct-sys 0 ) \ X:structures
0 extend-structure ;
......
......@@ -114,7 +114,7 @@ AUser CSP
POSTPONE (const-does>)
POSTPONE ;
noname : POSTPONE rdrop
latestxt r> cell+ ! \ patch the literal
latestnt r> cell+ ! \ patch the literal
; immediate
\ !! rewrite slurp-file using slurp-fid
......
......@@ -39,6 +39,6 @@ Create cs-wordlist-search-map ( -- wordlist-map )
: cs-vocabulary ( "name" -- ) \ gforth
\g Create a case-senisitve vocabulary
Vocabulary cs-wordlist-search-map latestxt >body ! ;
Vocabulary cs-wordlist-search-map latestnt >body ! ;
' cs-vocabulary alias voctable
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