Auto-save/restore strings, stacks and string arrays

parent 3b42b2a6
......@@ -70,6 +70,3 @@ s" Config error" exception Value config-throw
endcase
;] map-wordlist ;] r@ outfile-execute
r> close-file throw ;
:noname defers 'cold config-recognizer $boot ; is 'cold
:noname config-recognizer $save defers 'image ; is 'image
......@@ -152,9 +152,6 @@ is ?warning
; is check-shadow
[then]
:noname defers 'cold warning-recs $boot ; is 'cold
:noname defers 'image warning-recs $save ; is 'image
: ?warn-dp ( -- )
>num-state @ >num-state off 1 and 0= dpl @ 0>= and warnings @ abs 1 > and
[: '' emit input-lexeme 2@ type
......
......@@ -9566,7 +9566,7 @@ doc-$del
doc-$ins
doc-$+!
doc-c$+!
doc-$off
doc-$free
doc-$init
doc-$split
doc-$iter
......@@ -9585,7 +9585,15 @@ doc-$[]map
doc-$[]slurp
doc-$[]slurp-file
doc-$[].
doc-$[]off
doc-$[]free
doc-$save
doc-$[]save
doc-$boot
doc-$[]boot
doc-$saved
doc-$[]saved
doc-$variable
doc-$[]variable
@node Terminal output, Single-key input, String words, Other I/O
@subsection Terminal output
......
......@@ -31,6 +31,18 @@ UNLOCK tlast @ LOCK
dup forth-wordlist has? ec 0= [IF] wordlist-id [THEN] ! Last !
unlock vt, tvtable-list @ lock vtable-list !
align here boot[][] !
1 cells ,
included-files A,
align here boot$[] !
1 cells ,
default-recognizer A,
unlock included-files, lock included-files !
align here default-recognizer !
2 cells , ' rec:num A, ' rec:word A,
>ram here normal-dp !
......@@ -64,11 +64,11 @@ User ofile
User tfile
: os-cold ( -- )
boot-strings
fpath off
ofile off
tfile off
pathstring 2@ fpath only-path
init-included-files ;
pathstring 2@ fpath only-path ;
\ The path Gforth uses for @code{included} and friends.
......@@ -82,7 +82,7 @@ User tfile
: clear-path ( path-addr -- ) \ gforth
\G Set the path @i{path-addr} to empty.
s" " rot $! ;
$init ;
: only-path ( adr len path -- )
dup clear-path also-path ;
......
......@@ -83,7 +83,7 @@ AConstant r:dnum
: stack: ( n "name" -- )
\G create a named stack with at least @var{n} cells space
drop Variable ;
drop $Variable ;
: stack ( n -- addr )
\G create an unnamed stack with at least @var{n} cells space
drop align here 0 , ;
......@@ -100,13 +100,6 @@ AConstant r:dnum
AVariable default-recognizer
\G The system recognizer
here default-recognizer !
2 cells , ' rec:num A, ' rec:word A,
Defer 'image ( -- )
:noname ( -- )
default-recognizer $save ; IS 'image
default-recognizer AValue forth-recognizer
: get-recognizers ( -- xt1 .. xtn n )
......
......@@ -43,9 +43,6 @@ AVariable included-files
\G undefined.
loadline @ ;
: init-included-files ( -- ) \ gforth-internal
included-files $boot ;
: str>loadfilename# ( addr u -- n )
included-files $@ bounds ?do ( addr u )
2dup I $@ str= if
......
......@@ -94,12 +94,6 @@
>r >r dup $@ r> safe/string r@ delete
dup $@len r> - 0 max swap $!len ;
: $boot ( $addr -- )
\G take string from dictionary to allocated memory
dup >r $@ r@ off r> $! ;
: $save ( $addr -- )
\G push string to dictionary for savesys
dup >r $@ here r> ! dup , here swap dup aligned allot move ;
: $init ( $addr -- )
\G store an empty string there, regardless of what was in before
s" " $make swap ! ;
......@@ -120,4 +114,62 @@
>r >r
$@ BEGIN dup WHILE r@ $split i' -rot >r >r execute r> r>
REPEAT 2drop rdrop rdrop ;
\ auto-save and restore strings in images
: $boot ( $addr -- )
\G take string from dictionary to allocated memory
dup >r $@ r@ off r> $! ;
: $save ( $addr -- )
\G push string to dictionary for savesys
dup >r $@ here r> ! dup , here swap dup aligned allot move ;
: $boot[] ( addr -- )
\G take string array from dictionary to allocated memory
dup $boot $@ bounds ?DO
I $boot
cell +LOOP ;
: $[]save ( addr -- )
\G push string array to dictionary for savesys
dup $save $@ bounds ?DO
I $save
cell +LOOP ;
AVariable boot$[] \ strings to be booted
AVariable boot[][] \ arrays to be booted
: $saved ( addr -- )
\ mark an address as booted/saved
boot$[] >stack ;
: $[]saved ( addr -- )
\ mark an address as booted/saved
boot[][] >stack ;
: $Variable ( -- )
\G A string variable which is preserved across savesystem
Create here $saved 0 , ;
: $[]Variable ( -- )
\G A string variable which is preserved across savesystem
Create here $[]saved 0 , ;
: boot-strings ( -- )
boot[][] @ >r
boot$[] $boot
boot$[] $@ bounds ?DO
I @ $boot
cell +LOOP
boot[][] $boot
boot[][] $@ bounds ?DO
I @ $boot[]
cell +LOOP
rdrop ( r> dp ! ) ;
: save-strings ( -- )
boot[][] $save
boot[][] $@ bounds ?DO
I @ $[]save
cell +LOOP
boot$[] $save
boot$[] $@ bounds ?DO
I @ $save
cell +LOOP ;
Defer 'image ( -- ) \G deferred word executed before saving an image
' save-strings IS 'image
[THEN]
\ No newline at end of file
......@@ -801,7 +801,7 @@ DEFER compile-wrapper-function ( -- )
: lha, ( -- )
\ create an empty library handle
align here 0 , lib-handle-addr @ , 0 , $10 allot lib-handle-addr ! ;
align here 0 , lib-handle-addr @ , here $saved 0 , $10 allot lib-handle-addr ! ;
: clear-libs ( -- ) \ gforth
\G Clear the list of libs
......@@ -1027,7 +1027,6 @@ set-current
.lib-error !!openlib!! throw
;] map-libs ;
:noname [: lha-name $save ;] map-libs defers 'image ; is 'image
:noname ( -- )
defers 'cold
init-libcc reopen-libs rebind-libcc lib-filename $off ;
......
......@@ -18,14 +18,9 @@
\ along with this program. If not, see http://www.gnu.org/licenses/.
: update-image-included-files ( -- )
included-files $save
s" GFORTHDESTDIR" getenv included-files $@ bounds ?DO
I @ in-dictionary? 0= IF
2dup I $@ string-prefix? IF
I 0 2 pick $del THEN
I $save
THEN
cell +LOOP 2drop maxalign ;
2dup I $@ string-prefix? IF I 0 2 pick $del THEN
cell +LOOP 2drop ;
: update-maintask ( -- )
throw-entry main-task udp @ throw-entry next-task - /string move ;
......
......@@ -152,17 +152,6 @@ Vocabulary Root ( -- ) \ gforth
defer 'image ( -- ) ' noop is 'image
[then]
:noname ( -- )
\ save search order here
defers 'image vocstack $save ; is 'image
: init-vp ( -- )
vocstack $boot ;
:noname
init-vp DEFERS 'cold ;
IS 'cold
Only Forth also definitions
\ set initial search order 14may93py
......
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