diff --git a/startup.4th b/startup.4th index 8c51201..1b47601 100644 --- a/startup.4th +++ b/startup.4th @@ -1130,8 +1130,10 @@ HIDE TOTAL R@ OVER R@ - MUNMAP DUP R> R@ 2* + SWAP R> + TUCK - MUNMAP ; -: ALLOCATE ( size -- a-addr ) - CELL+ DUP BUDDY-MAX-BYTES U> IF DUP MMAP-ALLOCATE TUCK ! CELL+ EXIT THEN +: ALLOCATE ( size -- obj-addr ) + 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 ( "ccc" -- ) diff --git a/test/resize.4th b/test/resize.4th new file mode 100644 index 0000000..3679e0e --- /dev/null +++ b/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 diff --git a/test/resize.exp b/test/resize.exp new file mode 100644 index 0000000..f5508b6 --- /dev/null +++ b/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