diff --git a/startup.4th b/startup.4th index 86fe31a..5062ae5 100644 --- a/startup.4th +++ b/startup.4th @@ -1366,6 +1366,7 @@ VARIABLE TOTAL >>FORTH : ALLOCATE ( size -- obj-addr ) + DUP 0= IF EXIT THEN CELL+ DUP BUDDY-MAX-BYTES U> IF PAGESIZE ALIGNED-TO DUP MMAP-ALLOCATE TUCK ! CELL+ EXIT THEN @@ -1378,12 +1379,14 @@ VARIABLE TOTAL SWAP OVER ! CELL+ ; : FREE ( obj-addr -- ) - CELL- DUP @ - DUP BUDDY-ORDERS U< IF SWAP BUDDY-FREE EXIT THEN - BEGIN - 2DUP SYS_MUNMAP SYSCALL2 ?DUP 0= IF 2DROP EXIT THEN - NEGATE ERRNO_EINTR <> "munmap failed" ?FAIL - AGAIN ; + ?DUP IF + CELL- DUP @ + DUP BUDDY-ORDERS U< IF SWAP BUDDY-FREE EXIT THEN + BEGIN + 2DUP SYS_MUNMAP SYSCALL2 ?DUP 0= IF 2DROP EXIT THEN + NEGATE ERRNO_EINTR <> "munmap failed" ?FAIL + AGAIN + THEN ; >>SYSTEM @@ -1392,7 +1395,16 @@ VARIABLE TOTAL >>FORTH -: RESIZE ( obj-addr1 size -- obj-addr1 | obj-addr2 ) +\ If size is 0 then free obj-addr1 (which may be zero / NULL) and return 0 +\ Otherwise if obj-addr1 is 0 (NULL) then allocate size bytes +\ If neither obj-addr1 nor size is 0 then return an object with allocated size +\ greater than or equal to size containing the same bytes as obj-addr1 up to +\ size or the original object size, whichever is less +\ The returned address may be equal to obj-addr1; if it is not, the original +\ obj-addr1 is freed and no longer valid +: RESIZE ( obj-addr1 size -- obj-addr1 | obj-addr2 | 0 ) + DUP 0= IF DROP FREE 0 EXIT THEN + OVER 0= IF NIP ALLOCATE EXIT THEN 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 ) diff --git a/test/allocate.4th b/test/allocate.4th index 8407800..cb1a370 100644 --- a/test/allocate.4th +++ b/test/allocate.4th @@ -24,6 +24,12 @@ ?DUP WHILE DUP @ SWAP FREE - REPEAT ; + REPEAT + + "Allocate 0 bytes" HEADING + 0 ALLOCATE "Result: " TYPE U. EOL + + "Free a NULL pointer" HEADING + 0 FREE ; TEST diff --git a/test/allocate.exp b/test/allocate.exp index 34b3f4f..0508090 100644 --- a/test/allocate.exp +++ b/test/allocate.exp @@ -2,4 +2,7 @@ * Free large object * Allocate 1000 small objects (200 B) * Free 1000 small objects +* Allocate 0 bytes +Result: 0 +* Free a NULL pointer exit-code: 0