add RESIZE definition to match ALLOCATE and FREE

startup.4th

@@ -1130,8 +1130,10 @@ HIDE TOTAL
    R@ OVER R@ - MUNMAP
    DUP R> R@ 2* + SWAP R> + TUCK - MUNMAP ;
 
-: ALLOCATE ( size -- a-addr )
+: ALLOCATE ( size -- obj-addr )
-   CELL+ DUP BUDDY-MAX-BYTES U> IF DUP MMAP-ALLOCATE TUCK ! CELL+ EXIT THEN
+   CELL+ DUP BUDDY-MAX-BYTES U> IF
+      PAGESIZE ALIGNED-TO DUP MMAP-ALLOCATE TUCK ! CELL+ EXIT
+   THEN
    NATURALLY-ALIGNED DUP BUDDY-MIN-BYTES U< IF DROP BUDDY-MIN-BYTES THEN
    BUDDY-ORDER-FROM-BYTES DUP ['] BUDDY-ALLOCATE CATCH ?DUP IF
       DUP EXCP-HEAP-OVERFLOW <> IF RETHROW THEN DROP
@@ -1140,7 +1142,7 @@ HIDE TOTAL
    THEN
    SWAP OVER ! CELL+ ;
 
-: FREE ( a-addr -- )
+: FREE ( obj-addr -- )
    CELL- DUP @
    DUP BUDDY-ORDERS U< IF SWAP BUDDY-FREE EXIT THEN
    BEGIN
@@ -1148,6 +1150,26 @@ HIDE TOTAL
       NEGATE ERRNO_EINTR <> "munmap failed" ?FAIL
    AGAIN ;
 
+: OBJECT-SIZE ( obj-addr -- size )
+   CELL- @ DUP BUDDY-ORDERS U< IF BUDDY-ORDER-BYTES THEN CELL- ;
+
+: RESIZE ( obj-addr1 size -- obj-addr1 | obj-addr2 )
+   OVER OBJECT-SIZE CELL+ OVER CELL+ BUDDY-MIN-BYTES UMAX 2DUP U>= IF
+      \ Allocated space is larger than requested size, shrink if <= 50% used
+      ( S: obj-addr1 size obj-size req-size )
+      SWAP 2/ U> IF DROP EXIT THEN
+   ELSE
+      \ Allocated space is smaller, must reallocate
+      ( S: obj-addr1 size obj-size req-size )
+      2DROP
+   THEN
+   ( S: obj-addr1 size )
+   TUCK ALLOCATE
+   ( S: size obj-addr1 obj-addr2 )
+   OVER >R OVER OBJECT-SIZE >R ROT R> UMIN OVER >R
+   ( S: obj-addr1 obj-addr2 copy-size R: obj-addr1 obj-addr2 )
+   CMOVE R> R> FREE ;
+
 \ Begin a new colon definition; hide & redirect the previous word
 \ with the same name to the new definition
 : :REPLACE ( "<spaces>ccc" -- )

test/resize.4th

@@ -0,0 +1,15 @@
+: STATUS ( obj-addr c-addr u -- obj-addr )
+   TYPE ":\n  " TYPE BUDDY-STATS "  Value: " TYPE DUP @ .
+   "\n  Object size: " TYPE DUP OBJECT-SIZE U. EOL EOL ;
+
+: TEST
+   28 ALLOCATE 1234 OVER ! "Allocated 28 bytes" STATUS
+   33 RESIZE "Resized to 33 bytes" STATUS
+   28 RESIZE "Resized to 28 bytes" STATUS
+   256 KB CELL- RESIZE "Resized to 256 KiB - 1 cell" STATUS
+   32 RESIZE "Resized to 32 bytes" STATUS
+   28 RESIZE "Resized to 28 bytes" STATUS
+   4 RESIZE "Resized to 4 bytes" STATUS
+   FREE ;
+
+TEST

test/resize.exp

@@ -0,0 +1,36 @@
+Allocated 28 bytes:
+  1x32 1x64 1x128 1x256 1x512 1x1024 1x2048 1x4096 1x8192 1x16384 1x32768 1x65536 1x131072 1x262144 1x524288 1x1048576 1x2097152 total 4194272
+  Value: 1234
+  Object size: 28
+
+Resized to 33 bytes:
+  1x64 1x128 1x256 1x512 1x1024 1x2048 1x4096 1x8192 1x16384 1x32768 1x65536 1x131072 1x262144 1x524288 1x1048576 1x2097152 total 4194240
+  Value: 1234
+  Object size: 60
+
+Resized to 28 bytes:
+  1x32 1x64 1x128 1x256 1x512 1x1024 1x2048 1x4096 1x8192 1x16384 1x32768 1x65536 1x131072 1x262144 1x524288 1x1048576 1x2097152 total 4194272
+  Value: 1234
+  Object size: 28
+
+Resized to 256 KiB - 1 cell:
+  1x262144 1x524288 1x1048576 1x2097152 total 3932160
+  Value: 1234
+  Object size: 262140
+
+Resized to 32 bytes:
+  1x64 1x128 1x256 1x512 1x1024 1x2048 1x4096 1x8192 1x16384 1x32768 1x65536 1x131072 1x262144 1x524288 1x1048576 1x2097152 total 4194240
+  Value: 1234
+  Object size: 60
+
+Resized to 28 bytes:
+  1x32 1x64 1x128 1x256 1x512 1x1024 1x2048 1x4096 1x8192 1x16384 1x32768 1x65536 1x131072 1x262144 1x524288 1x1048576 1x2097152 total 4194272
+  Value: 1234
+  Object size: 28
+
+Resized to 4 bytes:
+  1x32 1x64 1x128 1x256 1x512 1x1024 1x2048 1x4096 1x8192 1x16384 1x32768 1x65536 1x131072 1x262144 1x524288 1x1048576 1x2097152 total 4194272
+  Value: 1234
+  Object size: 28
+
+exit-code: 0