Inline deferred words that cannot be altered in cross compiled output.

Author: Molorius

pkg/forth/builtin/02_core.f

@@ -30,6 +30,7 @@
     POSTPONE @ \ compile @
     POSTPONE EXECUTE \ compile EXECUTE
     POSTPONE ; \ end the definition
+    LAST SET-DEFERRED \ mark the new word as deferred
 ;
 
 : DEFER@ ( xt1 -- xt2 ) >BODY @ ;

pkg/forth/cell.go

@@ -96,6 +96,7 @@ func (c CellAddress) AddToList(u *Ulp) error {
 }
 
 func (c CellAddress) BuildExecution(u *Ulp) (string, error) {
+	c.Entry.Flag.inToken = true
 	name, err := c.OutputReference(u)
 	if err != nil {
 		return "", err
@@ -168,6 +169,10 @@ func (c CellLiteral) AddToList(u *Ulp) error {
 	}
 	litref := c.reference(ref)
 	u.literals[litref] = ref
+	cellAddress, ok := c.cell.(CellAddress)
+	if ok {
+		cellAddress.Entry.Flag.inToken = true
+	}
 	return nil
 }
 

pkg/forth/flag.go

@@ -17,4 +17,6 @@ type Flag struct {
 	recursive   bool // This Forth word is recursive.
 	visited     bool // This Forth word has already been visited in this optimization pass.
 	isExit      bool // This assembly word is the EXIT word.
+	isDeferred  bool // This forth word is deferred.
+	inToken     bool // This word is compiled into a token somewhere (literal or data).
 }

pkg/forth/optimize.go

@@ -15,6 +15,10 @@ func (o *Optimizer) Optimize() error {
 	if err != nil {
 		return errors.Join(fmt.Errorf("could not tag recursion during optimization"), err)
 	}
+	err = o.removeDeferred()
+	if err != nil {
+		return errors.Join(fmt.Errorf("could not remove deferred word"), err)
+	}
 	// change calls at end of words to tail calls
 	err = o.putTailCalls()
 	if err != nil {
@@ -75,6 +79,36 @@ func (o *Optimizer) putTailCalls() error {
 	return nil
 }
 
+func (o *Optimizer) removeDeferred() error {
+	for _, w := range o.u.forthWords {
+		f := w.Entry.Flag
+		// if this word was made with DEFER and it cannot be altered
+		if f.isDeferred && !f.inToken {
+			literal, ok := w.Cells[0].(CellLiteral)
+			if !ok {
+				return fmt.Errorf("could not read literal %s in %s", w.Cells[0], w)
+			}
+			address, ok := literal.cell.(CellAddress)
+			if !ok {
+				return fmt.Errorf("could not read address in %s", w)
+			}
+			data, ok := address.Entry.Word.(*WordForth)
+			if !ok {
+				return fmt.Errorf("error reading a deferred word, please file a bug report.")
+			}
+			if len(data.Cells) < 1 {
+				return fmt.Errorf("deferred word not allocated, please file a bug report.")
+			}
+			embedded := data.Cells[0]
+			exit := w.Cells[len(w.Cells)-1]
+			w.Cells = w.Cells[0:2]
+			w.Cells[0] = embedded
+			w.Cells[1] = exit
+		}
+	}
+	return nil
+}
+
 func (o *Optimizer) clearVisited() {
 	for _, w := range o.u.forthWords {
 		w.Entry.ClearVisited()

pkg/forth/primitive.go

@@ -1056,6 +1056,22 @@ func PrimitiveSetup(vm *VirtualMachine) error {
 				return nil
 			},
 		},
+		{
+			name: "SET-DEFERRED",
+			goFunc: func(vm *VirtualMachine, entry *DictionaryEntry) error {
+				cell0, err := vm.Stack.Pop()
+				if err != nil {
+					return PopError(err, entry)
+				}
+				cellAddr, ok := cell0.(CellAddress)
+				if !ok {
+					return EntryError(entry, "requires an address cell, found %s type %T", cell0, cell0)
+				}
+				flag := true
+				cellAddr.Entry.Flag.isDeferred = flag
+				return nil
+			},
+		},
 		{
 			name: "EXIT",
 			flag: Flag{

pkg/forth/ulpBuild.go

@@ -162,6 +162,15 @@ func (u *Ulp) buildAssemblyHelper(vm *VirtualMachine, header string) (string, er
 	if err != nil {
 		return "", err
 	}
+	// rebuild the various lists because optimizations may have changed things
+	err = u.clearLists()
+	if err != nil {
+		return "", err
+	}
+	err = u.buildLists(vmInitEntry)
+	if err != nil {
+		return "", err
+	}
 	// create the different assemblies
 	asm, err := u.buildAssemblyWords()
 	if err != nil {
@@ -270,6 +279,19 @@ func (u *Ulp) buildLists(entry *DictionaryEntry) error {
 	return entry.AddToList(u)
 }
 
+func (u *Ulp) clearLists() error {
+	for _, w := range u.forthWords {
+		w.Entry.Flag.addedToList = false
+	}
+	for _, w := range u.assemblyWords {
+		w.Entry.Flag.addedToList = false
+	}
+	for _, w := range u.dataWords {
+		w.Entry.Flag.addedToList = false
+	}
+	return nil
+}
+
 func (u *Ulp) name(middle string, word string, addSuffix bool) string {
 	// Forth words can have any character, replace them all
 	fixed := u.replaceOtherChars(word)