Commit 6cfcfe9b authored by Bernd Paysan's avatar Bernd Paysan

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