diff --git a/compiler/debug.corth b/compiler/debug.corth index eec2a7d..4e6f30f 100644 --- a/compiler/debug.corth +++ b/compiler/debug.corth @@ -444,7 +444,7 @@ in let log-item log-stream in arg1 log-stream fput-log-item else type LOG-TYPE:STACK-SIZE-NOT-EQ = if - "error: stack size do not match the expected stack size\n" log-stream fputs + "error: the current local stack size does not match the expected stack size\n" log-stream fputs "expected: " log-stream fputs arg1 log-stream fput-types log-stream fputnl "got: " log-stream fputs arg2 log-stream fput-types log-stream fputnl diff --git a/corth b/corth index 75bdbe3..a921ba2 100755 Binary files a/corth and b/corth differ diff --git a/examples/malloc_example.corth b/examples/malloc_example.corth index 6206647..f473784 100644 --- a/examples/malloc_example.corth +++ b/examples/malloc_example.corth @@ -3,17 +3,20 @@ include "core/stack.corth" macro malloc:ARRAY-SIZE 0x4000 endmacro macro malloc:AVAIL-STACK-SIZE 0x100 endmacro -include "dynamic/malloc.corth" include "dynamic/debug_malloc.corth" +memory index sizeof(int) end + proc allocate-space int -> ptr in let size in - size malloc let object in + size index @64 malloc let object in object mlength size != if "[INFO] Size does not match.\n" puts + 1 exit drop else - "[INFO] Successfully allocated object.\n" puts + "[INFO] Successfully allocated object with index " puts index @64 puti ".\n" puts + index @inc64 end STDOUT debug-dynamic-memory @@ -24,10 +27,13 @@ end end proc deallocate-space ptr -> in let container in - container mfree if - "[INFO] Successfully deallocated object.\n" puts - else - "[INFO] Could not deallocate object.\n" puts + container debug-malloc:get-tag let tag in + container mfree if + "[INFO] Successfully deallocated object with index " puts tag puti ".\n" puts + else + "[INFO] Could not deallocate object.\n" puts + 1 exit drop + end end STDOUT debug-dynamic-memory @@ -37,6 +43,7 @@ proc main int int -> int in let argc argv in malloc:init + 0 index !64 STDOUT debug-dynamic-memory diff --git a/std/dynamic/_malloc.corth b/std/dynamic/_malloc.corth new file mode 100644 index 0000000..2085b00 --- /dev/null +++ b/std/dynamic/_malloc.corth @@ -0,0 +1,238 @@ +// Before this library is included, malloc:ARRAY-SIZE and malloc:AVAIL-STACK-SIZE must be defined. +// Before using any of the procedures or macros, malloc:init must be called. + +// malloc:array is a linked list with items called 'blocks'. + +// Block structure: +// int* next-block +// byte[] container + +// malloc:avail-stack is a sorted stack that contains the pointers of the unused blocks. + +include "collections/stack64.corth" +include "collections/sorted64.corth" + +memory malloc:array malloc:ARRAY-SIZE and + malloc:avail-stack-array malloc:AVAIL-STACK-SIZE and + malloc:avail-stack-length sizeof(int) end + +namespace malloc + +macro avail-stack malloc:avail-stack-array malloc:avail-stack-length endmacro + + +proc _init -> in + // Set the available stack length to 0. + 0 malloc:avail-stack-length !64 + + // Create the first block. + malloc:array malloc:ARRAY-SIZE + malloc:array !64 + + // Append the block as available to the available stack. + malloc:array malloc:avail-stack stack64:append +end + + +// ptr: block -> ptr: next-block +macro next-block + @64 +endmacro + + +// ptr: next-block ptr: block -> +macro set-next-block + !64 +endmacro + + +// ptr: container -> ptr: block +macro block + 8 - +endmacro + + +// ptr: block -> ptr: container +macro container + 8 + +endmacro + + +// ptr: block -> int: size +// Returns the size of the block. +// The size of the block is equal to the difference between the next block and the current block. +macro block-size let _block_ in + _block_ malloc:next-block _block_ - +end endmacro + + +// ptr: block -> int: size +// Returns the size of the block. +// The size of the container is equal to the size of the block that contains the container minus eight. +macro container-size + malloc:block-size 8 - +endmacro + + +proc find-min-available + // int: expected-size -> ptr: available-group int: group-size int: group-id + int -> ptr int int +in let size in + memory available-group sizeof(ptr) and + available-size sizeof(int) and + available-id sizeof(int) in + + // available-id is the ID of stack item that points to the group. + // group = stack[id] + // size = *group - group + + NULLPTR available-group !64 + MAX-INT available-size !64 + + // Find the group with the smallest size that has enough space. + 0 while dup malloc:avail-stack-length @64 < do let id in + id malloc:avail-stack stack64:get let group in + group malloc:block-size let group-size in + group-size size 8 + = if + // If group-size is equal to size + 8, then we have found the best possible block, no need to keep iterating. + group group-size id return + end + + group-size size 16 + >= if + // If the group has enough space, that is, if the group has at least expected size plus sixteen bytes of free space. + group-size available-size @64 < if + // Find the smallest group. + group available-group !64 + group-size available-size !64 + id available-id !64 + end + end + end + end + id end inc end drop + + available-group @64 available-size @64 available-id @64 + end +end end + +endnamespace + + +proc _malloc + // int: length -> ptr: addr + int -> ptr + // Allocates memory with a specific size, allows dynamic memory management. + // Always allocates the smallest availiable segment for memory efficiency. +in let size in + // Check if the size argument is valid. + size is-neg if + NULLPTR return + end + + // Find the block with the smallest size that has enough space. + size malloc:find-min-available let available-block available-size available-id in + + // Could not find a block with enough size. + available-block malloc:next-block is-null if NULLPTR return end + + size 8 + available-size = if + // Size was equal to available space, therefore the block should be kept intact. + + available-id malloc:avail-stack stack64:pop drop + else + // Size was less than available, therefore the block should be split in two. + + // ____________________________ + // / \ + // |-------|---------------------|-------|------| + // | &next |######container######| &next |@cont@| + // |-------|---------------------|-------|------| + + // Will be split as: + + // _____________ _____________ + // / \/ \ + // |-------|------|-------|------|-------|------| + // | &next |@cont@| &next |#cont#| &next |@cont@| + // |-------|------|-------|------|-------|------| + + // (# represents unused space, @ represents used space.) + + // This means that even if the containers are empty, we need 16 bytes of free space for the pointers. + // To split a block into two sub-blocks with one of the sub-blocks having L bytes of space, the block must have at least L + 16 bytes of free space. + + available-block malloc:container size + let new-next in + + // Set the new block's next-block to the selected-block's next-block. + available-block malloc:next-block new-next malloc:set-next-block + + // Set the next-block as the next block. + new-next available-block malloc:set-next-block + + // Update the available blocks table. + new-next available-id malloc:avail-stack stack64:set + end + end + + // Return the container position. + available-block malloc:container + end +end end + + +proc _mfree + // ptr: container -> bool: successful + ptr -> bool + // Frees space up allocated by malloc. +in malloc:block let block in + block malloc:avail-stack-array malloc:avail-stack-array malloc:avail-stack-length @64 8 * + sorted64:available if drop + // If that block was already specified as free. + false return + end + + malloc:avail-stack-array - 8 / let index in + // Add the block to the available blocks table. + block index malloc:avail-stack stack64:insert + + // Merge the next block, if it is unused. + index inc malloc:avail-stack-length < if + block malloc:next-block index inc malloc:avail-stack stack64:get = if + // Remove the next block from the available blocks table. + index inc malloc:avail-stack stack64:pop drop + + // Set the next-next block as the next block. + block malloc:next-block malloc:next-block block malloc:set-next-block + end + end + + index is-pos if + index dec malloc:avail-stack stack64:get let prev-block in + // Merge the previous block, if it is unused. + prev-block malloc:next-block block = if + // Set the next block as the next block of the previous block. + block malloc:next-block prev-block malloc:set-next-block + + // Remove the block from the available blocks table. + // TODO: There is the possibility of performing two consecutive pop operations, which causes a call to memcpy Twice. This could be made more efficient by calling memcpy only once. + index malloc:avail-stack stack64:pop drop + end + end + end + end +end true end + + +// Deallocates both the array and ALL of its sub items. +macro _mfree-deep let _array_ in // ptr: array -> bool: success + _array_ while dup _array_ malloc:block malloc:next-block < do + dup @64 mfree drop + 8 + end drop + + _array_ mfree +end endmacro + + +macro _mlength + // ptr: addr -> int: length + // Returns the length of an object created using malloc. + malloc:block malloc:container-size +endmacro diff --git a/std/dynamic/debug_malloc.corth b/std/dynamic/debug_malloc.corth index d35f8ef..0f43b3d 100644 --- a/std/dynamic/debug_malloc.corth +++ b/std/dynamic/debug_malloc.corth @@ -1,6 +1,6 @@ include "linux_x86/sys.corth" include "linux_x86/io/output.corth" -include "dynamic/malloc.corth" +include "dynamic/_malloc.corth" // Can be used to debug malloc segments. @@ -54,7 +54,7 @@ in true end -// Can bu used to see how much space is available and to check memory leaks. +// Can be used to check the space available and to check memory leaks. proc get-available-dynamic-memory -> int in @@ -68,3 +68,19 @@ in sum @64 end end + +macro malloc:init malloc:_init endmacro + +// This returns a shifted pointer. +// The created dynamicly-placed object contains debug tag information which is hidden from the user. +macro malloc let _size_ _debug_ in + size 8 + _malloc peek _obj_ in _obj_ isn-null if + _debug_ _obj_ !64 + end end 8 + +end endmacro +macro mfree 8 - _mfree endmacro +macro mfree-deep _mfree-deep endmacro +macro mlength 8 - _mlength 8 - endmacro + +macro debug-malloc:get-tag 8 - @64 endmacro +macro debug-malloc:set-tag 8 - !64 endmacro diff --git a/std/dynamic/malloc.corth b/std/dynamic/malloc.corth index 1237112..a012342 100644 --- a/std/dynamic/malloc.corth +++ b/std/dynamic/malloc.corth @@ -1,238 +1,8 @@ -// Before this library is included, malloc:ARRAY-SIZE and malloc:AVAIL-STACK-SIZE must be defined. -// Before using any of the procedures or macros, malloc:init must be called. +include "dynamic/_malloc.corth" -// malloc:array is a linked list with items called 'blocks'. +macro malloc:init malloc:_init endmacro -// Block structure: -// int* next-block -// byte[] container - -// malloc:avail-stack is a sorted stack that contains the pointers of the unused blocks. - -include "collections/stack64.corth" -include "collections/sorted64.corth" - -memory malloc:array malloc:ARRAY-SIZE and - malloc:avail-stack-array malloc:AVAIL-STACK-SIZE and - malloc:avail-stack-length sizeof(int) end - -namespace malloc - -macro avail-stack malloc:avail-stack-array malloc:avail-stack-length endmacro - - -proc init -> in - // Set the available stack length to 0. - 0 malloc:avail-stack-length !64 - - // Create the first block. - malloc:array malloc:ARRAY-SIZE + malloc:array !64 - - // Append the block as available to the available stack. - malloc:array malloc:avail-stack stack64:append -end - - -// ptr: block -> ptr: next-block -macro next-block - @64 -endmacro - - -// ptr: next-block ptr: block -> -macro set-next-block - !64 -endmacro - - -// ptr: container -> ptr: block -macro block - 8 - -endmacro - - -// ptr: block -> ptr: container -macro container - 8 + -endmacro - - -// ptr: block -> int: size -// Returns the size of the block. -// The size of the block is equal to the difference between the next block and the current block. -macro block-size let _block_ in - _block_ malloc:next-block _block_ - -end endmacro - - -// ptr: block -> int: size -// Returns the size of the block. -// The size of the container is equal to the size of the block that contains the container minus eight. -macro container-size - malloc:block-size 8 - -endmacro - - -proc find-min-available - // int: expected-size -> ptr: available-group int: group-size int: group-id - int -> ptr int int -in let size in - memory available-group sizeof(ptr) and - available-size sizeof(int) and - available-id sizeof(int) in - - // available-id is the ID of stack item that points to the group. - // group = stack[id] - // size = *group - group - - NULLPTR available-group !64 - MAX-INT available-size !64 - - // Find the group with the smallest size that has enough space. - 0 while dup malloc:avail-stack-length @64 < do let id in - id malloc:avail-stack stack64:get let group in - group malloc:block-size let group-size in - group-size size 8 + = if - // If group-size is equal to size + 8, then we have found the best possible block, no need to keep iterating. - group group-size id return - end - - group-size size 16 + >= if - // If the group has enough space, that is, if the group has at least expected size plus sixteen bytes of free space. - group-size available-size @64 < if - // Find the smallest group. - group available-group !64 - group-size available-size !64 - id available-id !64 - end - end - end - end - id end inc end drop - - available-group @64 available-size @64 available-id @64 - end -end end - -endnamespace - - -proc malloc - // int: length -> ptr: addr - int -> ptr - // Allocates memory with a specific size, allows dynamic memory management. - // Always allocates the smallest availiable segment for memory efficiency. -in let size in - // Check if the size argument is valid. - size is-neg if - NULLPTR return - end - - // Find the block with the smallest size that has enough space. - size malloc:find-min-available let available-block available-size available-id in - - // Could not find a block with enough size. - available-block malloc:next-block is-null if NULLPTR return end - - size 8 + available-size = if - // Size was equal to available space, therefore the block should be kept intact. - - available-id malloc:avail-stack stack64:pop drop - else - // Size was less than available, therefore the block should be split in two. - - // ____________________________ - // / \ - // |-------|---------------------|-------|------| - // | &next |######container######| &next |@cont@| - // |-------|---------------------|-------|------| - - // Will be split as: - - // _____________ _____________ - // / \/ \ - // |-------|------|-------|------|-------|------| - // | &next |@cont@| &next |#cont#| &next |@cont@| - // |-------|------|-------|------|-------|------| - - // (# represents unused space, @ represents used space.) - - // This means that even if the containers are empty, we need 16 bytes of free space for the pointers. - // To split a block into two sub-blocks with one of the sub-blocks having L bytes of space, the block must have at least L + 16 bytes of free space. - - available-block malloc:container size + let new-next in - - // Set the new block's next-block to the selected-block's next-block. - available-block malloc:next-block new-next malloc:set-next-block - - // Set the next-block as the next block. - new-next available-block malloc:set-next-block - - // Update the available blocks table. - new-next available-id malloc:avail-stack stack64:set - end - end - - // Return the container position. - available-block malloc:container - end -end end - - -proc mfree - // ptr: container -> bool: successful - ptr -> bool - // Frees space up allocated by malloc. -in malloc:block let block in - block malloc:avail-stack-array malloc:avail-stack-array malloc:avail-stack-length @64 8 * + sorted64:available if drop - // If that block was already specified as free. - false return - end - - malloc:avail-stack-array - 8 / let index in - // Add the block to the available blocks table. - block index malloc:avail-stack stack64:insert - - // Merge the next block, if it is unused. - index inc malloc:avail-stack-length < if - block malloc:next-block index inc malloc:avail-stack stack64:get = if - // Remove the next block from the available blocks table. - index inc malloc:avail-stack stack64:pop drop - - // Set the next-next block as the next block. - block malloc:next-block malloc:next-block block malloc:set-next-block - end - end - - index is-pos if - index dec malloc:avail-stack stack64:get let prev-block in - // Merge the previous block, if it is unused. - prev-block malloc:next-block block = if - // Set the next block as the next block of the previous block. - block malloc:next-block prev-block malloc:set-next-block - - // Remove the block from the available blocks table. - // TODO: There is the possibility of performing two consecutive pop operations, which causes a call to memcpy Twice. This could be made more efficient by calling memcpy only once. - index malloc:avail-stack stack64:pop drop - end - end - end - end -end true end - - -// Deallocates both the array and ALL of its sub items. -macro mfree-deep let _array_ in // ptr: array -> bool: success - _array_ while dup _array_ malloc:block malloc:next-block < do - dup @64 mfree drop - 8 + end drop - - _array_ mfree -end endmacro - - -macro mlength - // ptr: addr -> int: length - // Returns the length of an object created using malloc. - malloc:block malloc:container-size -endmacro +macro malloc _malloc endmacro +macro mfree _mfree endmacro +macro mfree-deep _mfree-deep endmacro +macro mlength _mlength endmacro