Add RESIZE and FREE with test cases.

Author: Molorius

pkg/forth/builtin/02_core.f

@@ -361,3 +361,11 @@
 : /- /-REM NIP ;
 : -REM /-REM DROP ;
 
+\ memory allocation is automatic in go, so
+\ we don't need to manually free
+: FREE ( addr io )
+    @ \ try reading from this address, this will be caught by
+    \ the host if attempting to run on something not an address
+    DROP 0 \ drop the result, return 0
+;
+

pkg/forth/primitive.go

@@ -614,7 +614,7 @@ func PrimitiveSetup(vm *VirtualMachine) error {
 				if err != nil {
 					return JoinEntryError(err, entry, "could not parse name")
 				}
-				// get global
+				// get global flag
 				nGlobal, err := vm.Stack.PopNumber()
 				if err != nil {
 					return PopError(err, entry)
@@ -625,6 +625,7 @@ func PrimitiveSetup(vm *VirtualMachine) error {
 				if err != nil {
 					return PopError(err, entry)
 				}
+				// create the new data, defaulted to 0
 				var de DictionaryEntry // note that we don't put this entry into the dictionary
 				w := WordForth{
 					Cells: make([]Cell, n),
@@ -633,6 +634,7 @@ func PrimitiveSetup(vm *VirtualMachine) error {
 				for i := range w.Cells {
 					w.Cells[i] = CellNumber{0}
 				}
+				// create the entry for it
 				de = DictionaryEntry{
 					Name: string(name),
 					Word: &w,
@@ -641,14 +643,60 @@ func PrimitiveSetup(vm *VirtualMachine) error {
 						GlobalData: global,
 					},
 				}
+				// create the cell for it
 				newCell := CellAddress{
 					Offset: 0,
 					Entry:  &de,
 				}
+				// push the cell onto the stack
 				err = vm.Stack.Push(newCell)
 				if err != nil {
 					return PushError(err, entry)
 				}
+				// push 0 onto the stack
+				err = vm.Stack.Push(CellNumber{0})
+				if err != nil {
+					return PushError(err, entry)
+				}
+				return nil
+			},
+		},
+		{
+			name: "RESIZE",
+			goFunc: func(vm *VirtualMachine, entry *DictionaryEntry) error {
+				// get size
+				n, err := vm.Stack.PopNumber() // the number of inputs
+				if err != nil {
+					return PopError(err, entry)
+				}
+				// get address
+				cell, err := vm.Stack.Pop()
+				if err != nil {
+					return PopError(err, entry)
+				}
+				cellAddress, ok := cell.(CellAddress)
+				if !ok {
+					return EntryError(entry, "can only resize an address, got %s type %T", cellAddress, cellAddress)
+				}
+				w, ok := cellAddress.Entry.Word.(*WordForth)
+				if !ok {
+					return EntryError(entry, "can only resize forth data words found %s type %T", w, w)
+				}
+				// create the new data, defaulted to 0
+				newCells := make([]Cell, n)
+				for i := range newCells {
+					newCells[i] = CellNumber{0}
+				}
+				// copy the data over
+				copy(newCells, w.Cells)
+				// attach the new data to the word
+				w.Cells = newCells
+				// push the same cell onto the stack
+				err = vm.Stack.Push(cellAddress)
+				if err != nil {
+					return PushError(err, entry)
+				}
+				// push 0 onto the stack
 				err = vm.Stack.Push(CellNumber{0})
 				if err != nil {
 					return PushError(err, entry)

pkg/forth/suite_test.go

@@ -1509,6 +1509,46 @@ func TestSuite(t *testing.T) {
 		// 2ROT
 		// 2VALUE
 		// 2VARIABLE
+
+		{
+			name: "ALLOCATE",
+			setup: `
+				T{ 50 CELLS ALLOCATE SWAP addr ! -> 0 }T
+				T{ addr @ ALIGNED -> addr @ }T    \ Test address is aligned
+				// T{ HERE -> datsp @ }T              \ Check data space pointer is unaffected
+				addr @ 50 write-cell-mem
+				addr @ 50 check-cell-mem         \ Check we can access the heap
+				T{ addr @ FREE -> 0 }T
+
+				T{ 99 ALLOCATE SWAP addr ! -> 0 }T
+				T{ addr @ ALIGNED -> addr @ }T    \ Test address is aligned
+				T{ addr @ FREE -> 0 }T
+				// T{ HERE -> datsp @ }T              \ Data space pointer unaffected by FREE
+				T{ -1 ALLOCATE SWAP DROP 0= -> <TRUE> }T    \ Memory allocation works with max size
+			`,
+		},
+		{
+			name: "RESIZE",
+			setup: `
+				T{ 50 CHARS ALLOCATE SWAP addr ! -> 0 }T
+				addr @ 50 write-char-mem addr @ 50 check-char-mem
+				\ Resize smaller does not change content.
+				T{ addr @ 28 CHARS RESIZE SWAP addr ! -> 0 }T
+				addr @ 28 check-char-mem
+
+				\ Resize larger does not change original content.
+				T{ addr @ 100 CHARS RESIZE SWAP addr ! -> 0 }T
+				addr @ 28 check-char-mem
+
+				\ We can resize to the maximum size
+				T{ addr @ -1 RESIZE 0= -> addr @ <TRUE> }T
+
+				T{ addr @ FREE -> 0 }T
+				// T{ HERE -> datsp @ }T    \ Data space pointer is unaffected
+			`,
+			code: ``,
+		},
+		// FREE does not have any tests
 	}
 
 	r := asm.Runner{}

pkg/forth/test/suite_test.f

@@ -122,4 +122,36 @@
 \ ' EXIT CONSTANT 1ST
 T{ VARIABLE 1ST -> }T \ not the same as the test suite
 
+VARIABLE addr
+VARIABLE datsp
+: write-char-mem ( address n -- )
+    \ from 0 to n
+    0 ?DO
+        I OVER ( address i address )
+        C! \ write i to address
+        CHAR+ ( address+1 ) \ increment address
+    LOOP
+    DROP ( )
+;
+
+: write-cell-mem ( address n -- )
+    2* write-char-mem
+;
+
+: check-char-mem ( address n -- )
+    \ from 0 to n
+    0 ?DO
+        DUP C@ ( address value )
+        I <> IF \ if the value isn't equal to loop count
+            UNLOOP ." char-char-mem failed " DROP EXIT
+        THEN
+        CHAR+ ( address+1 )
+    LOOP
+    DROP
+;
+
+: check-cell-mem
+    2* check-char-mem
+;
+
 RESET-TEST