I have from time to time wanted to perform clean up actions when a marker is
run, often close files. Win32Forth allowed this by having MARKER-CHAIN run and
I found it quite useful. The other advantage of this arrangement is that it is
possible to localize the clean up actions in the same file as the data
structure is defined.
I have attached a proposed patch. It is pretty simple and only affects the
marker.fs file.
From 86387a00b7baad4837e71b19582b08ac0949dff3 Mon Sep 17 00:00:00 2001
From: "Daniel E. Wilson" <[email protected]>
Date: Fri, 8 May 2026 22:41:26 -0700
Subject: [PATCH] Added code to allow for chains to used for clean up when a
marker is run.
---
marker.fs | 30 +++++++++++++++++++++---------
1 file changed, 21 insertions(+), 9 deletions(-)
diff --git a/marker.fs b/marker.fs
index 1c80d5e1..a2123895 100644
--- a/marker.fs
+++ b/marker.fs
@@ -18,6 +18,12 @@
\ You should have received a copy of the GNU General Public License
\ along with this program. If not, see http://www.gnu.org/licenses/.
+\ Make certain that we have chains.
+include chains.fs
+
+\ Now create the marker chain and initialize it to zero.
+variable marker-chain
+0 marker-chain !
\ Marker creates a mark that is removed (including everything
\ defined afterwards) when executing the mark.
@@ -79,6 +85,20 @@
sections-marker, \ here is stored and restored separately
;
+: marker-vocabulary-stack-clean-up ( -- )
+ \ clean up vocabulary stack
+ 0 ['] search-order >body $@ cell MEM+DO
+ I @ dup here u>
+ IF drop ELSE swap 1+ THEN
+ LOOP
+ dup 0= or set-order \ -1 set-order if order is empty
+ get-current here > IF
+ forth-wordlist set-current
+ THEN ;
+
+\ Add the vocabulary stack clean up to the chain.
+' marker-vocabulary-stack-clean-up marker-chain chained
+
: marker! ( mark -- )
\ reset included files count; resize will happen on next add-included-file
dup @ dup >r included-files $@ r> /string cell MEM+DO I $free LOOP
@@ -111,15 +131,7 @@
cell+ sections-marker!
drop
->here
- \ clean up vocabulary stack
- 0 ['] search-order >body $@ cell MEM+DO
- I @ dup here u>
- IF drop ELSE swap 1+ THEN
- LOOP
- dup 0= or set-order \ -1 set-order if order is empty
- get-current here > IF
- forth-wordlist set-current
- THEN ;
+ marker-chain chainperform ;
: marker ( "<spaces> name" -- ) \ core-ext
\G Create a definition, @i{name} (called a @i{mark}) whose
--
2.53.0
