diff --git a/pkg/forth/builtin/02_core.f b/pkg/forth/builtin/02_core.f index a9f639b..78fac90 100644 --- a/pkg/forth/builtin/02_core.f +++ b/pkg/forth/builtin/02_core.f @@ -373,17 +373,23 @@ DROP 0 \ drop the result, return 0 ; -0 BUFFER: DATASPACE \ create a buffer starting at size 0 to hold the data space +VARIABLE DATASPACE \ create a variable to hold the currently allocated data space VARIABLE DATAPOINTER \ create a variable to keep track of the data space pointer -DATASPACE DATAPOINTER ! \ set the data space pointer + +: NEW-DATASPACE ( ) \ set up a new data space + 0 ALLOCATE DROP DUP ( addr addr ) + DATASPACE ! \ save this new address to the dataspace + DATAPOINTER ! \ also to the pointer +; +NEW-DATASPACE \ run it right away : HERE ( -- addr ) - DATAPOINTER @ \ return the dataspace pointer plus the size + DATAPOINTER @ \ return the dataspace pointed address ; : DATASIZE - DATAPOINTER @ DATASPACE - \ find the size difference - 0x7FFF AND + DATAPOINTER @ DATASPACE @ - \ find the size difference + 0x7FFF AND \ remove any alignment bits ; : ALLOT ( n -- ) @@ -395,7 +401,7 @@ EXIT THEN ( n newSize ) SWAP DATAPOINTER +! ( newSize ) \ update the data space pointer - DATASPACE SWAP ( dataspace newSize ) + DATASPACE @ SWAP ( dataspace newSize ) RESIZE ( newaddress 0 ) \ resize the dataspace 2DROP \ remove the extra values from the resize ; @@ -407,7 +413,7 @@ ; : C, ( char -- ) - HERE DATASPACE - \ find the size difference + HERE DATASPACE @ - \ find the size difference 0< IF \ if the upper bit is set then we don't need to allocate ELSE @@ -450,7 +456,7 @@ ; : CREATE - ALIGN \ align the data space pointer + NEW-DATASPACE \ create a fresh section of aligned data space HERE \ get the data space pointer : \ parse the next input, create a word with that name POSTPONE LITERAL \ create a literal of the previous data space pointer diff --git a/pkg/forth/suite_test.go b/pkg/forth/suite_test.go index 5bed1d1..b16dc34 100644 --- a/pkg/forth/suite_test.go +++ b/pkg/forth/suite_test.go @@ -297,7 +297,23 @@ func TestSuite(t *testing.T) { `, }, // CR does not have any tests - // CREATE does not have any tests + { + name: "CREATE", + setup: ` + T{ CREATE CR1 -> }T + T{ : ADDR1 [ HERE ] LITERAL ; -> }T + T{ 1 , -> }T + T{ CREATE CR2 -> }T + T{ : ADDR2 [ HERE ] LITERAL ; -> }T + T{ FF , -> }T + `, + code: ` + T{ CR1 -> ADDR1 }T + T{ CR2 -> ADDR2 }T + T{ CR1 @ -> 1 }T + T{ CR2 @ -> FF }T + `, + }, { name: "C!", // not in test suite setup: "T{ VARIABLE c1 -> }T",