nybble
/
jumpforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add RESIZE definition to match ALLOCATE and FREE

This commit is contained in:
Jesse D. McDonald 2020-10-23 01:32:33 -05:00
parent 7b44312892
commit c09ca4a9e4
3 changed files with 76 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
startup.4th
View File

@ -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 ( "<spaces>ccc" -- )

15
test/resize.4th Normal file
View File

@ -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

36
test/resize.exp Normal file
View File

@ -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