st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-06 06:48:48 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Debug output is now hidden when DEBUG_VERSION compilation option is off, added LAMA_ENV compilation option to control whether global area scan is needed

Browse source
This commit is contained in:
Egor Sheremetov 2023-07-28 16:37:39 +02:00
parent 18eac4375c
commit 99ce39ca28
5 changed files with 228 additions and 408 deletions
Download patch file Download diff file Expand all files Collapse all files

74
runtime/.clang-format
View file

@ -11,22 +11,22 @@ IndentCaseLabels: true
Language: Cpp Language: Cpp
DisableFormat: false DisableFormat: false
Standard: Cpp11 Standard: Auto
AccessModifierOffset: -4 AccessModifierOffset: -4
AlignAfterOpenBracket: true AlignAfterOpenBracket: true
AlignConsecutiveAssignments: true AlignConsecutiveAssignments: Consecutive
AlignConsecutiveDeclarations: true AlignConsecutiveDeclarations: Consecutive
AlignEscapedNewlines: Right AlignEscapedNewlines: Right
AlignOperands: true AlignOperands: true
AlignTrailingComments: false AlignTrailingComments: false
AllowAllParametersOfDeclarationOnNextLine: true AllowAllParametersOfDeclarationOnNextLine: true
AllowShortBlocksOnASingleLine: true AllowShortBlocksOnASingleLine: Always
AllowShortCaseLabelsOnASingleLine: true AllowShortCaseLabelsOnASingleLine: true
AllowShortFunctionsOnASingleLine: All AllowShortFunctionsOnASingleLine: All
AllowShortIfStatementsOnASingleLine: AllIfsAndElse AllowShortIfStatementsOnASingleLine: AllIfsAndElse
AllowShortLoopsOnASingleLine: true AllowShortLoopsOnASingleLine: true
AlwaysBreakAfterDefinitionReturnType: false AlwaysBreakAfterDefinitionReturnType: None
AlwaysBreakAfterReturnType: None AlwaysBreakAfterReturnType: None
AlwaysBreakBeforeMultilineStrings: false AlwaysBreakBeforeMultilineStrings: false
AlwaysBreakTemplateDeclarations: Yes AlwaysBreakTemplateDeclarations: Yes
@ -38,26 +38,25 @@ BitFieldColonSpacing: Both
# Configure each individual brace in BraceWrapping # Configure each individual brace in BraceWrapping
BreakBeforeBraces: Attach BreakBeforeBraces: Attach
# Control of individual brace wrapping cases # Control of individual brace wrapping cases
BraceWrapping: { BraceWrapping:
AfterClass: 'true' AfterClass: true
AfterControlStatement: 'true' AfterControlStatement: Always
AfterEnum : 'true' AfterEnum : true
AfterFunction : 'true' AfterFunction : true
AfterNamespace : 'true' AfterNamespace : true
AfterStruct : 'true' AfterStruct : true
AfterUnion : 'true' AfterUnion : true
BeforeCatch : 'true' BeforeCatch : true
BeforeElse : 'true' BeforeElse : true
IndentBraces : 'false' IndentBraces : false
AfterExternBlock : 'true' AfterExternBlock : true
SplitEmptyFunction : 'false' SplitEmptyFunction : false
SplitEmptyRecord : 'false' SplitEmptyRecord : false
SplitEmptyNamespace : 'true' SplitEmptyNamespace : true
}
BreakAfterJavaFieldAnnotations: true BreakAfterJavaFieldAnnotations: true
BreakBeforeInheritanceComma: false BreakBeforeInheritanceComma: false
BreakArrays: false
BreakBeforeBinaryOperators: NonAssignment BreakBeforeBinaryOperators: NonAssignment
BreakBeforeTernaryOperators: true BreakBeforeTernaryOperators: true
BreakConstructorInitializersBeforeComma: true BreakConstructorInitializersBeforeComma: true
@ -97,17 +96,17 @@ SpaceAfterCStyleCast: false
SpaceAfterLogicalNot: false SpaceAfterLogicalNot: false
SpaceBeforeAssignmentOperators: true SpaceBeforeAssignmentOperators: true
SpaceBeforeParens: Custom SpaceBeforeParens: Custom
SpaceBeforeParensOptions: { SpaceBeforeParensOptions:
AfterControlStatements: 'true' AfterControlStatements: true
AfterForeachMacros: 'true' AfterForeachMacros: true
AfterFunctionDeclarationName: 'true' AfterFunctionDeclarationName: true
AfterFunctionDefinitionName: 'true' AfterFunctionDefinitionName: true
AfterIfMacros: 'true' AfterIfMacros: true
AfterOverloadedOperator: 'true' AfterOverloadedOperator: true
AfterRequiresInClause: 'true' AfterRequiresInClause: true
AfterRequiresInExpression: 'true' AfterRequiresInExpression: true
BeforeNonEmptyParentheses: 'false' BeforeNonEmptyParentheses: false
}
SpaceBeforeRangeBasedForLoopColon: false SpaceBeforeRangeBasedForLoopColon: false
SpaceInEmptyBlock: true SpaceInEmptyBlock: true
SpaceInEmptyParentheses: false SpaceInEmptyParentheses: false
@ -120,14 +119,12 @@ SpacesInParentheses: false
SpacesInSquareBrackets: false SpacesInSquareBrackets: false
SpaceAfterTemplateKeyword: true SpaceAfterTemplateKeyword: true
SpaceBeforeInheritanceColon: true SpaceBeforeInheritanceColon: true
VerilogBreakBetweenInstancePorts: true
SortUsingDeclarations: true SortUsingDeclarations: true
SortIncludes: CaseInsensitive SortIncludes: CaseInsensitive
IndentGotoLabels: false IndentGotoLabels: false
InsertBraces: false InsertBraces: false
InsertNewlineAtEOF: true
# Comments are for developers, they should arrange them # Comments are for developers, they should arrange them
ReflowComments: false ReflowComments: false
@ -135,10 +132,3 @@ ReflowComments: false
IncludeBlocks: Regroup IncludeBlocks: Regroup
IndentPPDirectives: AfterHash IndentPPDirectives: AfterHash
SeparateDefinitionBlocks: Always SeparateDefinitionBlocks: Always
IntegerLiteralSeparator:
Binary: 4
Decimal: 0
Hex: 0
---

2
runtime/Makefile
View file

@ -1,5 +1,5 @@
CC=gcc CC=gcc
FLAGS=-m32 -g2 -fstack-protector-all -DFULL_INVARIANT_CHECKS FLAGS=-m32 -g2 -fstack-protector-all -DFULL_INVARIANT_CHECKS -DLAMA_ENV
all: gc_runtime.o gc.o runtime.o all: gc_runtime.o gc.o runtime.o
ar rc runtime.a gc_runtime.o runtime.o gc.o ar rc runtime.a gc_runtime.o runtime.o gc.o

152
runtime/gc.c
View file

@ -23,7 +23,7 @@ size_t cur_id = 0;
static extra_roots_pool extra_roots; static extra_roots_pool extra_roots;
extern size_t __gc_stack_top, __gc_stack_bottom; extern size_t __gc_stack_top, __gc_stack_bottom;
#ifndef DEBUG_VERSION #ifdef LAMA_ENV
extern const size_t __start_custom_data, __stop_custom_data; extern const size_t __start_custom_data, __stop_custom_data;
#endif #endif
@ -54,14 +54,15 @@ void *alloc (size_t size) {
#endif #endif
size_t bytes_sz = size; size_t bytes_sz = size;
size = BYTES_TO_WORDS(size); size = BYTES_TO_WORDS(size);
#ifdef DEBUG_VERSION
fprintf(stderr, "allocation of size %zu words (%zu bytes): ", size, bytes_sz); fprintf(stderr, "allocation of size %zu words (%zu bytes): ", size, bytes_sz);
#endif
void *p = gc_alloc_on_existing_heap(size); void *p = gc_alloc_on_existing_heap(size);
if (!p) { if (!p) {
// not enough place in heap, need to perform GC cycle // not enough place in heap, need to perform GC cycle
p = gc_alloc(size); p = gc_alloc(size);
// return gc_alloc(size); // return gc_alloc(size);
} }
// fprintf(stderr, "%p, tag=%zu\n", p, tag);
return p; return p;
} }
@ -183,20 +184,21 @@ void *gc_alloc_on_existing_heap (size_t size) {
} }
void *gc_alloc (size_t size) { void *gc_alloc (size_t size) {
#ifdef DEBUG_VERSION
fprintf(stderr, "===============================GC cycle has started\n"); fprintf(stderr, "===============================GC cycle has started\n");
// #ifdef FULL_INVARIANT_CHECKS #endif
#ifdef FULL_INVARIANT_CHECKS
FILE *stack_before = print_stack_content("stack-dump-before-compaction"); FILE *stack_before = print_stack_content("stack-dump-before-compaction");
FILE *heap_before = print_objects_traversal("before-mark", 0); FILE *heap_before = print_objects_traversal("before-mark", 0);
fclose(heap_before); fclose(heap_before);
fclose(stack_before); #endif
// #endif
mark_phase(); mark_phase();
// #ifdef FULL_INVARIANT_CHECKS #ifdef FULL_INVARIANT_CHECKS
FILE *heap_before_compaction = print_objects_traversal("after-mark", 1); FILE *heap_before_compaction = print_objects_traversal("after-mark", 1);
// #endif #endif
compact_phase(size); compact_phase(size);
// #ifdef FULL_INVARIANT_CHECKS #ifdef FULL_INVARIANT_CHECKS
FILE *stack_after = print_stack_content("stack-dump-after-compaction"); FILE *stack_after = print_stack_content("stack-dump-after-compaction");
FILE *heap_after_compaction = print_objects_traversal("after-compaction", 0); FILE *heap_after_compaction = print_objects_traversal("after-compaction", 0);
@ -205,36 +207,45 @@ void *gc_alloc (size_t size) {
fprintf(stderr, "Stack is modified incorrectly, see position %d\n", pos); fprintf(stderr, "Stack is modified incorrectly, see position %d\n", pos);
exit(1); exit(1);
} }
fclose(stack_before);
fclose(stack_after);
pos = files_cmp(heap_before_compaction, heap_after_compaction); pos = files_cmp(heap_before_compaction, heap_after_compaction);
if (pos >= 0) { // position of difference is found if (pos >= 0) { // position of difference is found
fprintf(stderr, "GC invariant is broken, pos is %d\n", pos); fprintf(stderr, "GC invariant is broken, pos is %d\n", pos);
exit(1); exit(1);
} }
fclose(heap_before_compaction); fclose(heap_before_compaction);
fclose(heap_after_compaction); fclose(heap_after_compaction);
// #endif #endif
#ifdef DEBUG_VERSION
fprintf(stderr, "===============================GC cycle has finished\n"); fprintf(stderr, "===============================GC cycle has finished\n");
#endif
return gc_alloc_on_existing_heap(size); return gc_alloc_on_existing_heap(size);
} }
void mark_phase (void) { void mark_phase (void) {
#ifdef DEBUG_VERSION
fprintf(stderr, "marking has started\n"); fprintf(stderr, "marking has started\n");
fprintf(stderr, fprintf(stderr,
"__gc_root_scan_stack started: gc_top=%p bot=%p\n", "__gc_root_scan_stack has started: gc_top=%p bot=%p\n",
__gc_stack_top, __gc_stack_top,
__gc_stack_bottom); __gc_stack_bottom);
#endif
__gc_root_scan_stack(); __gc_root_scan_stack();
fprintf(stderr, "__gc_root_scan_stack finished\n"); #ifdef DEBUG_VERSION
fprintf(stderr, "scan_extra_roots started\n"); fprintf(stderr, "__gc_root_scan_stack has finished\n");
fprintf(stderr, "scan_extra_roots has started\n");
#endif
scan_extra_roots(); scan_extra_roots();
fprintf(stderr, "scan_extra_roots finished\n"); #ifdef DEBUG_VERSION
// #ifndef DEBUG_VERSION fprintf(stderr, "scan_extra_roots has finished\n");
fprintf(stderr, "scan_global_area started\n"); fprintf(stderr, "scan_global_area has started\n");
#endif
scan_global_area(); scan_global_area();
fprintf(stderr, "scan_global_area finished\n"); #ifdef DEBUG_VERSION
// #endif fprintf(stderr, "scan_global_area has finished\n");
fprintf(stderr, "marking has finished\n"); fprintf(stderr, "marking has finished\n");
#endif
} }
void compact_phase (size_t additional_size) { void compact_phase (size_t additional_size) {
@ -281,7 +292,9 @@ void compact_phase (size_t additional_size) {
} }
size_t compute_locations () { size_t compute_locations () {
#ifdef DEBUG_VERSION
fprintf(stderr, "GC compute_locations started\n"); fprintf(stderr, "GC compute_locations started\n");
#endif
size_t *free_ptr = heap.begin; size_t *free_ptr = heap.begin;
heap_iterator scan_iter = heap_begin_iterator(); heap_iterator scan_iter = heap_begin_iterator();
@ -296,13 +309,17 @@ size_t compute_locations () {
} }
} }
#ifdef DEBUG_VERSION
fprintf(stderr, "GC compute_locations finished\n"); fprintf(stderr, "GC compute_locations finished\n");
#endif
// it will return number of words // it will return number of words
return free_ptr - heap.begin; return free_ptr - heap.begin;
} }
void scan_and_fix_region (memory_chunk *old_heap, void *start, void *end) { void scan_and_fix_region (memory_chunk *old_heap, void *start, void *end) {
#ifdef DEBUG_VERSION
fprintf(stderr, "GC scan_and_fix_region started\n"); fprintf(stderr, "GC scan_and_fix_region started\n");
#endif
for (size_t *ptr = (size_t *)start; ptr < (size_t *)end; ++ptr) { for (size_t *ptr = (size_t *)start; ptr < (size_t *)end; ++ptr) {
size_t ptr_value = *ptr; size_t ptr_value = *ptr;
// this can't be expressed via is_valid_heap_pointer, because this pointer may point area corresponding to the old // this can't be expressed via is_valid_heap_pointer, because this pointer may point area corresponding to the old
@ -316,25 +333,38 @@ void scan_and_fix_region (memory_chunk *old_heap, void *start, void *end) {
*(void **)ptr = new_addr + content_offset; *(void **)ptr = new_addr + content_offset;
} }
} }
#ifdef DEBUG_VERSION
fprintf(stderr, "GC scan_and_fix_region finished\n"); fprintf(stderr, "GC scan_and_fix_region finished\n");
#endif
} }
void scan_and_fix_region_roots (memory_chunk *old_heap) { void scan_and_fix_region_roots (memory_chunk *old_heap) {
#ifdef DEBUG_VERSION
fprintf(stderr, "extra roots started: number os extra roots %i\n", extra_roots.current_free); fprintf(stderr, "extra roots started: number os extra roots %i\n", extra_roots.current_free);
#endif
for (int i = 0; i < extra_roots.current_free; i++) { for (int i = 0; i < extra_roots.current_free; i++) {
size_t *ptr = extra_roots.roots[i]; size_t *ptr = (size_t *)extra_roots.roots[i];
size_t ptr_value = *ptr; size_t ptr_value = *ptr;
if (extra_roots.roots[i] > __gc_stack_top && extra_roots.roots[i] <= __gc_stack_bottom) { if (!is_valid_pointer((size_t *)ptr_value)) { continue; }
if (is_valid_heap_pointer(ptr_value)) { // skip this one since it was already fixed from scanning the stack
if ((extra_roots.roots[i] >= (void **)__gc_stack_top
&& extra_roots.roots[i] < (void **)__gc_stack_bottom)
#ifdef LAMA_ENV
|| (extra_roots.roots[i] <= (void **)&__stop_custom_data
&& extra_roots.roots[i] >= (void **)&__start_custom_data)
#endif
) {
#ifdef DEBUG_VERSION
if (is_valid_heap_pointer((size_t *)ptr_value)) {
fprintf(stderr, fprintf(stderr,
"|\tskip extra root: %p (%p), since it points to Lama's stack top=%p bot=%p\n", "|\tskip extra root: %p (%p), since it points to Lama's stack top=%p bot=%p\n",
extra_roots.roots[i], extra_roots.roots[i],
ptr_value, ptr_value,
__gc_stack_top, __gc_stack_top,
__gc_stack_bottom); __gc_stack_bottom);
} else if ((extra_roots.roots[i] <= (void *)&__stop_custom_data }
&& extra_roots.roots[i] >= (void *)&__start_custom_data) # ifdef LAMA_ENV
|| (extra_roots.roots[i] <= (void *)&__stop_custom_data else if ((extra_roots.roots[i] <= (void *)&__stop_custom_data
&& extra_roots.roots[i] >= (void *)&__start_custom_data)) { && extra_roots.roots[i] >= (void *)&__start_custom_data)) {
fprintf( fprintf(
stderr, stderr,
@ -344,29 +374,37 @@ void scan_and_fix_region_roots (memory_chunk *old_heap) {
(void *)&__stop_custom_data, (void *)&__stop_custom_data,
(void *)&__start_custom_data); (void *)&__start_custom_data);
exit(1); exit(1);
} else { }
# endif
else {
fprintf(stderr, fprintf(stderr,
"|\tskip extra root: %p (%p): not a valid Lama pointer \n", "|\tskip extra root: %p (%p): not a valid Lama pointer \n",
extra_roots.roots[i], extra_roots.roots[i],
ptr_value); ptr_value);
} }
#endif
continue; continue;
} }
if (is_valid_pointer((size_t *)ptr_value) && (size_t)old_heap->begin <= ptr_value if ((size_t)old_heap->begin <= ptr_value && ptr_value <= (size_t)old_heap->current) {
&& ptr_value <= (size_t)old_heap->current) {
void *obj_ptr = (void *)heap.begin + ((void *)ptr_value - (void *)old_heap->begin); void *obj_ptr = (void *)heap.begin + ((void *)ptr_value - (void *)old_heap->begin);
void *new_addr = void *new_addr =
(void *)heap.begin + ((void *)get_forward_address(obj_ptr) - (void *)old_heap->begin); (void *)heap.begin + ((void *)get_forward_address(obj_ptr) - (void *)old_heap->begin);
size_t content_offset = get_header_size(get_type_row_ptr(obj_ptr)); size_t content_offset = get_header_size(get_type_row_ptr(obj_ptr));
*(void **)ptr = new_addr + content_offset; *(void **)ptr = new_addr + content_offset;
#ifdef DEBUG_VERSION
fprintf(stderr, "|\textra root (%p) %p -> %p\n", extra_roots.roots[i], ptr_value, *ptr); fprintf(stderr, "|\textra root (%p) %p -> %p\n", extra_roots.roots[i], ptr_value, *ptr);
#endif
} }
} }
#ifdef DEBUG_VERSION
fprintf(stderr, "|\textra roots finished\n"); fprintf(stderr, "|\textra roots finished\n");
#endif
} }
void update_references (memory_chunk *old_heap) { void update_references (memory_chunk *old_heap) {
#ifdef DEBUG_VERSION
fprintf(stderr, "GC update_references started\n"); fprintf(stderr, "GC update_references started\n");
#endif
heap_iterator it = heap_begin_iterator(); heap_iterator it = heap_begin_iterator();
while (!heap_is_done_iterator(&it)) { while (!heap_is_done_iterator(&it)) {
if (is_marked(get_object_content_ptr(it.current))) { if (is_marked(get_object_content_ptr(it.current))) {
@ -406,16 +444,19 @@ void update_references (memory_chunk *old_heap) {
// fix pointers from extra_roots // fix pointers from extra_roots
scan_and_fix_region_roots(old_heap); scan_and_fix_region_roots(old_heap);
// #ifndef DEBUG_VERSION #ifdef LAMA_ENV
// fix pointers from static area
assert((void *)&__stop_custom_data >= (void *)&__start_custom_data); assert((void *)&__stop_custom_data >= (void *)&__start_custom_data);
scan_and_fix_region(old_heap, (void *)&__start_custom_data, (void *)&__stop_custom_data); scan_and_fix_region(old_heap, (void *)&__start_custom_data, (void *)&__stop_custom_data);
// #endif #endif
#ifdef DEBUG_VERSION
fprintf(stderr, "GC update_references finished\n"); fprintf(stderr, "GC update_references finished\n");
#endif
} }
void physically_relocate (memory_chunk *old_heap) { void physically_relocate (memory_chunk *old_heap) {
#ifdef DEBUG_VERSION
fprintf(stderr, "GC physically_relocate started\n"); fprintf(stderr, "GC physically_relocate started\n");
#endif
heap_iterator from_iter = heap_begin_iterator(); heap_iterator from_iter = heap_begin_iterator();
while (!heap_is_done_iterator(&from_iter)) { while (!heap_is_done_iterator(&from_iter)) {
@ -431,7 +472,9 @@ void physically_relocate (memory_chunk *old_heap) {
} }
from_iter = next_iter; from_iter = next_iter;
} }
#ifdef DEBUG_VERSION
fprintf(stderr, "GC physically_relocate finished\n"); fprintf(stderr, "GC physically_relocate finished\n");
#endif
} }
bool is_valid_heap_pointer (const size_t *p) { bool is_valid_heap_pointer (const size_t *p) {
@ -458,7 +501,6 @@ static inline void *queue_dequeue (heap_iterator *head_iter) {
} }
void mark (void *obj) { void mark (void *obj) {
// fprintf(stderr, "Marking object with content address %p on the heap\n", obj);
if (!is_valid_heap_pointer(obj) || is_marked(obj)) { return; } if (!is_valid_heap_pointer(obj) || is_marked(obj)) { return; }
// TL;DR: [q_head_iter, q_tail_iter) q_head_iter -- current dequeue's victim, q_tail_iter -- place for next enqueue // TL;DR: [q_head_iter, q_tail_iter) q_head_iter -- current dequeue's victim, q_tail_iter -- place for next enqueue
@ -497,7 +539,7 @@ void scan_extra_roots (void) {
} }
} }
#ifndef DEBUG_VERSION #ifdef LAMA_ENV
void scan_global_area (void) { void scan_global_area (void) {
// __start_custom_data is pointing to beginning of global area, thus all dereferencings are safe // __start_custom_data is pointing to beginning of global area, thus all dereferencings are safe
for (size_t *ptr = (size_t *)&__start_custom_data; ptr < (size_t *)&__stop_custom_data; ++ptr) { for (size_t *ptr = (size_t *)&__start_custom_data; ptr < (size_t *)&__stop_custom_data; ++ptr) {
@ -507,30 +549,14 @@ void scan_global_area (void) {
#endif #endif
extern void gc_test_and_mark_root (size_t **root) { extern void gc_test_and_mark_root (size_t **root) {
#ifdef DEBUG_VERSION
fprintf(stderr, fprintf(stderr,
"\troot = %p (%p), stack addresses: [%p, %p)\n", "\troot = %p (%p), stack addresses: [%p, %p)\n",
root, root,
*root, *root,
(void *)__gc_stack_top + 4, (void *)__gc_stack_top + 4,
(void *)__gc_stack_bottom); (void *)__gc_stack_bottom);
// if (is_valid_pointer(*root) && !is_valid_heap_pointer(*root)) { #endif
// fprintf(stderr,
// "Found weird pointer on the stack by address %p, value is %p (stack starts at %p, ends "
// "at %p)\n",
// root,
// *root,
// (void *)__gc_stack_top + 4,
// (void *)__gc_stack_bottom);
// } else {
// if (is_valid_pointer(*root)) {
// // fprintf(stderr,
// // "Object that is supposed to be on the heap on the stack by address %p, value is %p\n",
// // root,
// // *root);
// } else {
// fprintf(stderr, "Value on the stack by address %p, value is %d\n", root, UNBOX(*root));
// }
// }
mark((void *)*root); mark((void *)*root);
} }
@ -554,7 +580,7 @@ extern void __init (void) {
extern void __shutdown (void) { extern void __shutdown (void) {
munmap(heap.begin, heap.size); munmap(heap.begin, heap.size);
#ifdef DEBUG_VERSION #ifdef FULL_INVARIANT_CHECKS
cur_id = 0; cur_id = 0;
#endif #endif
heap.begin = NULL; heap.begin = NULL;
@ -572,7 +598,7 @@ void push_extra_root (void **p) {
perror("ERROR: push_extra_roots: extra_roots_pool overflow\n"); perror("ERROR: push_extra_roots: extra_roots_pool overflow\n");
exit(1); exit(1);
} }
assert(p >= __gc_stack_top || p < __gc_stack_bottom); assert(p >= (void **)__gc_stack_top || p < (void **)__gc_stack_bottom);
extra_roots.roots[extra_roots.current_free] = p; extra_roots.roots[extra_roots.current_free] = p;
extra_roots.current_free++; extra_roots.current_free++;
} }
@ -591,8 +617,7 @@ void pop_extra_root (void **p) {
/* Functions for tests */ /* Functions for tests */
#ifdef DEBUG_VERSION #if defined(FULL_INVARIANT_CHECKS) && defined(DEBUG_VERSION)
size_t objects_snapshot (int *object_ids_buf, size_t object_ids_buf_size) { size_t objects_snapshot (int *object_ids_buf, size_t object_ids_buf_size) {
size_t *ids_ptr = (size_t *)object_ids_buf; size_t *ids_ptr = (size_t *)object_ids_buf;
size_t i = 0; size_t i = 0;
@ -605,7 +630,9 @@ size_t objects_snapshot (int *object_ids_buf, size_t object_ids_buf_size) {
} }
return i; return i;
} }
#endif
#ifdef DEBUG_VERSION
extern char *de_hash (int); extern char *de_hash (int);
void dump_heap () { void dump_heap () {
@ -721,12 +748,11 @@ lama_type get_type_header_ptr (void *ptr) {
TAG(*header), TAG(*header),
heap.size, heap.size,
cur_id, cur_id,
__gc_stack_top, (void *)__gc_stack_top,
__gc_stack_bottom); (void *)__gc_stack_bottom);
FILE *heap_before_compaction = print_objects_traversal("dump_kill", 1); FILE *heap_before_compaction = print_objects_traversal("dump_kill", 1);
close(heap_before_compaction); fclose(heap_before_compaction);
kill(getpid(), SIGSEGV); kill(getpid(), SIGSEGV);
#endif #endif
exit(1); exit(1);
} }
@ -828,8 +854,10 @@ size_t get_header_size (lama_type type) {
void *alloc_string (int len) { void *alloc_string (int len) {
data *obj = alloc(string_size(len)); data *obj = alloc(string_size(len));
obj->data_header = STRING_TAG | (len << 3); obj->data_header = STRING_TAG | (len << 3);
fprintf(stderr, "%p, [STRING] tag=%zu\n", obj, TAG(obj->data_header));
#ifdef DEBUG_VERSION #ifdef DEBUG_VERSION
fprintf(stderr, "%p, [STRING] tag=%zu\n", obj, TAG(obj->data_header));
#endif
#ifdef FULL_INVARIANT_CHECKS
obj->id = cur_id; obj->id = cur_id;
#endif #endif
obj->forward_address = 0; obj->forward_address = 0;
@ -839,7 +867,9 @@ void *alloc_string (int len) {
void *alloc_array (int len) { void *alloc_array (int len) {
data *obj = alloc(array_size(len)); data *obj = alloc(array_size(len));
obj->data_header = ARRAY_TAG | (len << 3); obj->data_header = ARRAY_TAG | (len << 3);
#ifdef DEBUG_VERSION
fprintf(stderr, "%p, [ARRAY] tag=%zu\n", obj, TAG(obj->data_header)); fprintf(stderr, "%p, [ARRAY] tag=%zu\n", obj, TAG(obj->data_header));
#endif
#ifdef FULL_INVARIANT_CHECKS #ifdef FULL_INVARIANT_CHECKS
obj->id = cur_id; obj->id = cur_id;
#endif #endif
@ -850,7 +880,9 @@ void *alloc_array (int len) {
void *alloc_sexp (int members) { void *alloc_sexp (int members) {
sexp *obj = alloc(sexp_size(members)); sexp *obj = alloc(sexp_size(members));
obj->sexp_header = obj->contents.data_header = SEXP_TAG | (members << 3); obj->sexp_header = obj->contents.data_header = SEXP_TAG | (members << 3);
#ifdef DEBUG_VERSION
fprintf(stderr, "%p, SEXP tag=%zu\n", obj, TAG(obj->contents.data_header)); fprintf(stderr, "%p, SEXP tag=%zu\n", obj, TAG(obj->contents.data_header));
#endif
#ifdef FULL_INVARIANT_CHECKS #ifdef FULL_INVARIANT_CHECKS
obj->contents.id = cur_id; obj->contents.id = cur_id;
#endif #endif
@ -863,7 +895,9 @@ void *alloc_closure (int captured) {
data *obj = alloc(closure_size(captured)); data *obj = alloc(closure_size(captured));
obj->data_header = CLOSURE_TAG | (captured << 3); obj->data_header = CLOSURE_TAG | (captured << 3);
#ifdef DEBUG_VERSION
fprintf(stderr, "%p, [CLOSURE] tag=%zu\n", obj, TAG(obj->data_header)); fprintf(stderr, "%p, [CLOSURE] tag=%zu\n", obj, TAG(obj->data_header));
#endif
#ifdef FULL_INVARIANT_CHECKS #ifdef FULL_INVARIANT_CHECKS
obj->id = cur_id; obj->id = cur_id;
#endif #endif

9
runtime/gc.h
View file

@ -66,10 +66,10 @@ void mark (void *obj);
void mark_phase (void); void mark_phase (void);
// written in ASM, scans stack for pointers to the heap and starts marking process // written in ASM, scans stack for pointers to the heap and starts marking process
extern void extern void
__gc_root_scan_stack (void); // TODO: write without ASM, since it is absolutely not necessary __gc_root_scan_stack (void);
// marks each pointer from extra roots // marks each pointer from extra roots
void scan_extra_roots (void); void scan_extra_roots (void);
#ifndef DEBUG_VERSION #ifdef LAMA_ENV
// marks each valid pointer from global area // marks each valid pointer from global area
void scan_global_area (void); void scan_global_area (void);
#endif #endif
@ -105,14 +105,15 @@ void pop_extra_root (void **p);
/* Functions for tests */ /* Functions for tests */
#ifdef DEBUG_VERSION #if defined(FULL_INVARIANT_CHECKS) && defined(DEBUG_VERSION)
// makes a snapshot of current objects in heap (both alive and dead), writes these ids to object_ids_buf, // makes a snapshot of current objects in heap (both alive and dead), writes these ids to object_ids_buf,
// returns number of ids dumped // returns number of ids dumped
// object_ids_buf is pointer to area preallocated by user for dumping ids of objects in heap // object_ids_buf is pointer to area preallocated by user for dumping ids of objects in heap
// object_ids_buf_size is in WORDS, NOT BYTES // object_ids_buf_size is in WORDS, NOT BYTES
size_t objects_snapshot (int *object_ids_buf, size_t object_ids_buf_size); size_t objects_snapshot (int *object_ids_buf, size_t object_ids_buf_size);
#endif
#ifdef DEBUG_VERSION
// essential function to mock program stack // essential function to mock program stack
void set_stack (size_t stack_top, size_t stack_bottom); void set_stack (size_t stack_top, size_t stack_bottom);

341
runtime/runtime.c
View file

@ -12,8 +12,6 @@
# define alloc malloc # define alloc malloc
#endif #endif
//# define DEBUG_PRINT 1
#ifdef __ENABLE_GC__ #ifdef __ENABLE_GC__
/* GC extern invariant for built-in functions */ /* GC extern invariant for built-in functions */
@ -32,6 +30,24 @@ void __post_gc_subst () { }
#endif #endif
/* end */ /* end */
#define PRE_GC() \
bool flag = true; \
if (__gc_stack_top == 0) { flag = false; } \
__pre_gc(); \
assert(__gc_stack_top != 0); \
assert(__builtin_frame_address(0) <= (void *)__gc_stack_top);
#define POST_GC() \
assert(__builtin_frame_address(0) <= (void *)__gc_stack_top); \
__post_gc(); \
\
if (!flag && __gc_stack_top != 0) { \
fprintf(stderr, "Moving stack???\n"); \
assert(false); \
}
extern size_t __gc_stack_top, __gc_stack_bottom;
static void vfailure (char *s, va_list args) { static void vfailure (char *s, va_list args) {
fprintf(stderr, "*** FAILURE: "); fprintf(stderr, "*** FAILURE: ");
vfprintf(stderr, s, args); // vprintf (char *, va_list) <-> printf (char *, ...) vfprintf(stderr, s, args); // vprintf (char *, va_list) <-> printf (char *, ...)
@ -68,7 +84,6 @@ void Lassert (void *f, char *s, ...) {
failure("string value expected in %s\n", memo); \ failure("string value expected in %s\n", memo); \
while (0) while (0)
//extern void* alloc (size_t);
extern void *Bsexp (int n, ...); extern void *Bsexp (int n, ...);
extern int LtagHash (char *); extern int LtagHash (char *);
@ -92,14 +107,10 @@ extern int LcompareTags (void *p, void *q) {
qd = TO_DATA(q); qd = TO_DATA(q);
if (TAG(pd->data_header) == SEXP_TAG && TAG(qd->data_header) == SEXP_TAG) { if (TAG(pd->data_header) == SEXP_TAG && TAG(qd->data_header) == SEXP_TAG) {
return return BOX((TO_SEXP(p)->tag) - (TO_SEXP(q)->tag));
#ifndef DEBUG_PRINT } else {
BOX((TO_SEXP(p)->tag) - (TO_SEXP(q)->tag));
#else
BOX((GET_SEXP_TAG(TO_SEXP(p)->data_header)) - (GET_SEXP_TAG(TO_SEXP(p)->data_header)));
#endif
} else
failure("not a sexpr in compareTags: %d, %d\n", TAG(pd->data_header), TAG(qd->data_header)); failure("not a sexpr in compareTags: %d, %d\n", TAG(pd->data_header), TAG(qd->data_header));
}
return 0; // never happens return 0; // never happens
} }
@ -108,7 +119,7 @@ extern int LcompareTags (void *p, void *q) {
void *Ls__Infix_58 (void *p, void *q) { void *Ls__Infix_58 (void *p, void *q) {
void *res; void *res;
__pre_gc(); PRE_GC();
push_extra_root(&p); push_extra_root(&p);
push_extra_root(&q); push_extra_root(&q);
@ -116,7 +127,7 @@ void *Ls__Infix_58 (void *p, void *q) {
pop_extra_root(&q); pop_extra_root(&q);
pop_extra_root(&p); pop_extra_root(&p);
__post_gc(); POST_GC();
return res; return res;
} }
@ -257,34 +268,17 @@ extern int LtagHash (char *s) {
} }
char *de_hash (int n) { char *de_hash (int n) {
// static char *chars = (char*) BOX (NULL);
static char buf[6] = {0, 0, 0, 0, 0, 0}; static char buf[6] = {0, 0, 0, 0, 0, 0};
char *p = (char *)BOX(NULL); char *p = (char *)BOX(NULL);
p = &buf[5]; p = &buf[5];
#ifdef DEBUG_PRINT
indent++;
print_indent();
printf("de_hash: data_header: %d\n", n);
fflush(stdout);
#endif
*p-- = 0; *p-- = 0;
while (n != 0) { while (n != 0) {
#ifdef DEBUG_PRINT
print_indent();
printf("char: %c\n", chars[n & 0x003F]);
fflush(stdout);
#endif
*p-- = chars[n & 0x003F]; *p-- = chars[n & 0x003F];
n = n >> 6; n = n >> 6;
} }
#ifdef DEBUG_PRINT
indent--;
#endif
return ++p; return ++p;
} }
@ -480,7 +474,7 @@ extern void *Lsubstring (void *subj, int p, int l) {
if (pp + ll <= LEN(d->data_header)) { if (pp + ll <= LEN(d->data_header)) {
data *r; data *r;
__pre_gc(); PRE_GC();
push_extra_root(&subj); push_extra_root(&subj);
r = (data *)alloc_string(ll); r = (data *)alloc_string(ll);
@ -488,7 +482,7 @@ extern void *Lsubstring (void *subj, int p, int l) {
strncpy(r->contents, (char *)subj + pp, ll); strncpy(r->contents, (char *)subj + pp, ll);
__post_gc(); POST_GC();
return r->contents; return r->contents;
} }
@ -537,63 +531,29 @@ void *Lclone (void *p) {
sexp *sobj; sexp *sobj;
void *res; void *res;
int n; int n;
#ifdef DEBUG_PRINT
register int *ebp asm("ebp");
indent++;
print_indent();
printf("Lclone arg: %p %p\n", &p, p);
fflush(stdout);
#endif
__pre_gc();
if (UNBOXED(p)) return p; if (UNBOXED(p)) return p;
else {
PRE_GC();
data *a = TO_DATA(p); data *a = TO_DATA(p);
int t = TAG(a->data_header), l = LEN(a->data_header); int t = TAG(a->data_header), l = LEN(a->data_header);
push_extra_root(&p); push_extra_root(&p);
switch (t) { switch (t) {
case STRING_TAG: case STRING_TAG: res = Bstring(TO_DATA(p)->contents); break;
#ifdef DEBUG_PRINT
print_indent();
printf("Lclone: string1 &p=%p p=%p\n", &p, p);
fflush(stdout);
#endif
res = Bstring(TO_DATA(p)->contents);
#ifdef DEBUG_PRINT
print_indent();
printf("Lclone: string2 %p %p\n", &p, p);
fflush(stdout);
#endif
break;
case ARRAY_TAG: case ARRAY_TAG:
#ifdef DEBUG_PRINT
print_indent();
printf("Lclone: array &p=%p p=%p ebp=%p\n", &p, p, ebp);
fflush(stdout);
#endif
obj = (data *)alloc_array(l); obj = (data *)alloc_array(l);
memcpy(obj, TO_DATA(p), array_size(l)); memcpy(obj, TO_DATA(p), array_size(l));
res = (void *)obj->contents; res = (void *)obj->contents;
break; break;
case CLOSURE_TAG: case CLOSURE_TAG:
#ifdef DEBUG_PRINT
print_indent();
printf("Lclone: closure &p=%p p=%p ebp=%p\n", &p, p, ebp);
fflush(stdout);
#endif
obj = (data *)alloc_closure(l); obj = (data *)alloc_closure(l);
memcpy(obj, TO_DATA(p), closure_size(l)); memcpy(obj, TO_DATA(p), closure_size(l));
res = (void *)(obj->contents); res = (void *)(obj->contents);
break; break;
case SEXP_TAG: case SEXP_TAG:
#ifdef DEBUG_PRINT
print_indent();
printf("Lclone: sexp\n");
fflush(stdout);
#endif
sobj = (sexp *)alloc_sexp(l); sobj = (sexp *)alloc_sexp(l);
memcpy(sobj, TO_SEXP(p), sexp_size(l)); memcpy(sobj, TO_SEXP(p), sexp_size(l));
res = (void *)sobj->contents.contents; res = (void *)sobj->contents.contents;
@ -602,20 +562,8 @@ void *Lclone (void *p) {
default: failure("invalid data_header %d in clone *****\n", t); default: failure("invalid data_header %d in clone *****\n", t);
} }
pop_extra_root(&p); pop_extra_root(&p);
}
#ifdef DEBUG_PRINT
print_indent();
printf("Lclone ends1\n");
fflush(stdout);
#endif
__post_gc(); POST_GC();
#ifdef DEBUG_PRINT
print_indent();
printf("Lclone ends2\n");
fflush(stdout);
indent--;
#endif
return res; return res;
} }
@ -654,11 +602,7 @@ int inner_hash (int depth, unsigned acc, void *p) {
case ARRAY_TAG: i = 0; break; case ARRAY_TAG: i = 0; break;
case SEXP_TAG: { case SEXP_TAG: {
#ifndef DEBUG_PRINT
int ta = TO_SEXP(p)->tag; int ta = TO_SEXP(p)->tag;
#else
int ta = GET_SEXP_TAG(TO_SEXP(p)->data_header);
#endif
acc = HASH_APPEND(acc, ta); acc = HASH_APPEND(acc, ta);
i = 0; i = 0;
break; break;
@ -728,12 +672,7 @@ extern int Lcompare (void *p, void *q) {
break; break;
case SEXP_TAG: { case SEXP_TAG: {
#ifndef DEBUG_PRINT
int ta = TO_SEXP(p)->tag, tb = TO_SEXP(q)->tag; int ta = TO_SEXP(p)->tag, tb = TO_SEXP(q)->tag;
#else
int ta = GET_SEXP_TAG(TO_SEXP(p)->data_header),
tb = GET_SEXP_TAG(TO_SEXP(q)->data_header);
#endif
COMPARE_AND_RETURN(ta, tb); COMPARE_AND_RETURN(ta, tb);
COMPARE_AND_RETURN(la, lb); COMPARE_AND_RETURN(la, lb);
i = 0; i = 0;
@ -775,7 +714,7 @@ extern void *LmakeArray (int length) {
ASSERT_UNBOXED("makeArray:1", length); ASSERT_UNBOXED("makeArray:1", length);
__pre_gc(); PRE_GC();
n = UNBOX(length); n = UNBOX(length);
r = (data *)alloc_array(n); r = (data *)alloc_array(n);
@ -783,7 +722,7 @@ extern void *LmakeArray (int length) {
p = (int *)r->contents; p = (int *)r->contents;
while (n--) *p++ = BOX(0); while (n--) *p++ = BOX(0);
__post_gc(); POST_GC();
return r->contents; return r->contents;
} }
@ -794,11 +733,11 @@ extern void *LmakeString (int length) {
ASSERT_UNBOXED("makeString", length); ASSERT_UNBOXED("makeString", length);
__pre_gc(); PRE_GC();
r = (data *)alloc_string(n); // '\0' in the end of the string is taken into account r = (data *)alloc_string(n); // '\0' in the end of the string is taken into account
__post_gc(); POST_GC();
return r->contents; return r->contents;
} }
@ -807,42 +746,15 @@ extern void *Bstring (void *p) {
int n = strlen(p); int n = strlen(p);
void *s = NULL; void *s = NULL;
__pre_gc(); PRE_GC();
void *before_frame = __builtin_frame_address(0);
#ifdef DEBUG_PRINT
indent++;
print_indent();
printf("Bstring: call LmakeString %s %p %p %p %i\n", p, &p, p, s, n);
fflush(stdout);
if (before_frame != __builtin_frame_address(0)) {
fprintf(stderr, "WARNING!!!!!!! stack pointer moved\n");
exit(1);
}
#endif
push_extra_root(&p); push_extra_root(&p);
s = LmakeString(BOX(n)); s = LmakeString(BOX(n));
pop_extra_root(&p); pop_extra_root(&p);
#ifdef DEBUG_PRINT
print_indent();
printf("\tBstring: call strncpy: %p %p %p %i\n", &p, p, s, n);
fflush(stdout);
#endif
strncpy((char *)&TO_DATA(s)->contents, p, n + 1); // +1 because of '\0' in the end of C-strings strncpy((char *)&TO_DATA(s)->contents, p, n + 1); // +1 because of '\0' in the end of C-strings
#ifdef DEBUG_PRINT
print_indent(); POST_GC();
printf("\tBstring: ends\n");
fflush(stdout);
indent--;
#endif
if (before_frame != __builtin_frame_address(0)) {
fprintf(stderr, "WARNING!!!!!!! stack pointer moved\n");
exit(1);
}
__post_gc();
if (before_frame != __builtin_frame_address(0)) {
fprintf(stderr, "WARNING!!!!!!! stack pointer moved\n");
exit(1);
}
return s; return s;
} }
@ -851,7 +763,7 @@ extern void *Lstringcat (void *p) {
/* ASSERT_BOXED("stringcat", p); */ /* ASSERT_BOXED("stringcat", p); */
__pre_gc(); PRE_GC();
createStringBuf(); createStringBuf();
stringcat(p); stringcat(p);
@ -862,7 +774,7 @@ extern void *Lstringcat (void *p) {
deleteStringBuf(); deleteStringBuf();
__post_gc(); POST_GC();
return s; return s;
} }
@ -870,7 +782,7 @@ extern void *Lstringcat (void *p) {
extern void *Lstring (void *p) { extern void *Lstring (void *p) {
void *s = (void *)BOX(NULL); void *s = (void *)BOX(NULL);
__pre_gc(); PRE_GC();
createStringBuf(); createStringBuf();
printValue(p); printValue(p);
@ -881,13 +793,12 @@ extern void *Lstring (void *p) {
deleteStringBuf(); deleteStringBuf();
__post_gc(); POST_GC();
return s; return s;
} }
extern void *Bclosure (int bn, void *entry, ...) { extern void *Bclosure (int bn, void *entry, ...) {
void *before_frame = __builtin_frame_address(0);
va_list args; va_list args;
int i, ai; int i, ai;
register int *ebp asm("ebp"); register int *ebp asm("ebp");
@ -895,21 +806,8 @@ extern void *Bclosure (int bn, void *entry, ...) {
data *r; data *r;
int n = UNBOX(bn); int n = UNBOX(bn);
if (before_frame != __builtin_frame_address(0)) { PRE_GC();
fprintf(stderr, "WARNING!!!!!!! stack pointer moved\n");
exit(1);
}
__pre_gc();
if (before_frame != __builtin_frame_address(0)) {
fprintf(stderr, "WARNING!!!!!!! stack pointer moved\n");
exit(1);
}
#ifdef DEBUG_PRINT
indent++;
print_indent();
printf("Bclosure: create n = %d\n", n);
fflush(stdout);
#endif
argss = (ebp + 12); argss = (ebp + 12);
for (i = 0; i < n; i++, argss++) { push_extra_root((void **)argss); } for (i = 0; i < n; i++, argss++) { push_extra_root((void **)argss); }
@ -926,49 +824,22 @@ extern void *Bclosure (int bn, void *entry, ...) {
va_end(args); va_end(args);
__post_gc(); POST_GC();
pop_extra_root(&r); pop_extra_root(&r);
argss--; argss--;
for (i = 0; i < n; i++, argss--) { pop_extra_root((void **)argss); } for (i = 0; i < n; i++, argss--) { pop_extra_root((void **)argss); }
#ifdef DEBUG_PRINT
print_indent();
printf("Bclosure: ends\n", n);
fflush(stdout);
indent--;
#endif
if (before_frame != __builtin_frame_address(0)) {
fprintf(stderr, "WARNING!!!!!!! stack pointer moved\n");
exit(1);
}
return r->contents; return r->contents;
} }
extern void *Barray (int bn, ...) { extern void *Barray (int bn, ...) {
void *before_frame = __builtin_frame_address(0);
va_list args; va_list args;
int i, ai; int i, ai;
data *r; data *r;
int n = UNBOX(bn); int n = UNBOX(bn);
if (before_frame != __builtin_frame_address(0)) {
fprintf(stderr, "WARNING!!!!!!! stack pointer moved\n");
exit(1);
}
__pre_gc(); PRE_GC();
if (before_frame != __builtin_frame_address(0)) {
fprintf(stderr, "WARNING!!!!!!! stack pointer moved\n");
exit(1);
}
#ifdef DEBUG_PRINT
indent++;
print_indent();
printf("Barray: create n = %d\n", n);
fflush(stdout);
#endif
r = (data *)alloc_array(n); r = (data *)alloc_array(n);
va_start(args, bn); va_start(args, bn);
@ -980,15 +851,7 @@ extern void *Barray (int bn, ...) {
va_end(args); va_end(args);
__post_gc(); POST_GC();
#ifdef DEBUG_PRINT
indent--;
#endif
if (before_frame != __builtin_frame_address(0)) {
fprintf(stderr, "WARNING!!!!!!! stack pointer moved\n");
exit(1);
}
return r->contents; return r->contents;
} }
@ -997,7 +860,6 @@ extern memory_chunk heap;
#endif #endif
extern void *Bsexp (int bn, ...) { extern void *Bsexp (int bn, ...) {
void *before_frame = __builtin_frame_address(0);
va_list args; va_list args;
int i; int i;
int ai; int ai;
@ -1006,22 +868,8 @@ extern void *Bsexp (int bn, ...) {
data *d; data *d;
int n = UNBOX(bn); int n = UNBOX(bn);
if (before_frame != __builtin_frame_address(0)) { PRE_GC();
fprintf(stderr, "WARNING!!!!!!! stack pointer moved\n");
exit(1);
}
__pre_gc();
if (before_frame != __builtin_frame_address(0)) {
fprintf(stderr, "WARNING!!!!!!! stack pointer moved\n");
exit(1);
}
#ifdef DEBUG_PRINT
indent++;
print_indent();
printf("Bsexp: allocate %zu!\n", sizeof(int) * (n + 1));
fflush(stdout);
#endif
int fields_cnt = n - 1; int fields_cnt = n - 1;
r = (sexp *)alloc_sexp(fields_cnt); r = (sexp *)alloc_sexp(fields_cnt);
d = &(r->contents); d = &(r->contents);
@ -1032,32 +880,15 @@ extern void *Bsexp (int bn, ...) {
for (i = 0; i < n - 1; i++) { for (i = 0; i < n - 1; i++) {
ai = va_arg(args, int); ai = va_arg(args, int);
#ifdef DEBUG_VERSION
if (!UNBOXED(ai)) { assert(is_valid_heap_pointer((size_t *)ai)); }
#endif
p = (size_t *)ai; p = (size_t *)ai;
((int *)d->contents)[i] = ai; ((int *)d->contents)[i] = ai;
} }
r->tag = UNBOX(va_arg(args, int)); r->tag = UNBOX(va_arg(args, int));
#ifdef DEBUG_PRINT
r->data_header = SEXP_TAG | ((r->data_header) << 3);
print_indent();
printf("Bsexp: ends\n");
fflush(stdout);
indent--;
#endif
va_end(args); va_end(args);
__post_gc(); POST_GC();
if (before_frame != __builtin_frame_address(0)) {
fprintf(stderr, "ERROR!!!!!!! stack pointer moved\n");
exit(1);
}
return d->contents; return d->contents;
} }
@ -1067,20 +898,12 @@ extern int Btag (void *d, int t, int n) {
if (UNBOXED(d)) return BOX(0); if (UNBOXED(d)) return BOX(0);
else { else {
r = TO_DATA(d); r = TO_DATA(d);
#ifndef DEBUG_PRINT
return BOX(TAG(r->data_header) == SEXP_TAG && TO_SEXP(d)->tag == UNBOX(t) return BOX(TAG(r->data_header) == SEXP_TAG && TO_SEXP(d)->tag == UNBOX(t)
&& LEN(r->data_header) == UNBOX(n)); && LEN(r->data_header) == UNBOX(n));
#else
return BOX(TAG(r->data_header) == SEXP_TAG && GET_SEXP_TAG(TO_SEXP(d)->data_header) == UNBOX(t)
&& LEN(r->data_header) == UNBOX(n));
#endif
} }
} }
int get_tag (data *d) { int get_tag (data *d) { return TAG(d->data_header); }
// printf("%")
return TAG(d->data_header);
}
int get_len (data *d) { return LEN(d->data_header); } int get_len (data *d) { return LEN(d->data_header); }
@ -1106,7 +929,7 @@ extern int Bstring_patt (void *x, void *y) {
if (TAG(rx->data_header) != STRING_TAG) return BOX(0); if (TAG(rx->data_header) != STRING_TAG) return BOX(0);
return BOX(strcmp(rx->contents, ry->contents) == 0 ? 1 : 0); // TODO: ??? return BOX(strcmp(rx->contents, ry->contents) == 0 ? 1 : 0);
} }
} }
@ -1141,7 +964,6 @@ extern int Bsexp_tag_patt (void *x) {
extern void *Bsta (void *v, int i, void *x) { extern void *Bsta (void *v, int i, void *x) {
if (UNBOXED(i)) { if (UNBOXED(i)) {
ASSERT_BOXED(".sta:3", x); ASSERT_BOXED(".sta:3", x);
// ASSERT_UNBOXED(".sta:2", i);
if (TAG(TO_DATA(x)->data_header) == STRING_TAG) ((char *)x)[UNBOX(i)] = (char)UNBOX(v); if (TAG(TO_DATA(x)->data_header) == STRING_TAG) ((char *)x)[UNBOX(i)] = (char)UNBOX(v);
else ((int *)x)[UNBOX(i)] = (int)v; else ((int *)x)[UNBOX(i)] = (int)v;
@ -1197,7 +1019,7 @@ extern void * /*Lstrcat*/ Li__Infix_4343 (void *a, void *b) {
da = TO_DATA(a); da = TO_DATA(a);
db = TO_DATA(b); db = TO_DATA(b);
__pre_gc(); PRE_GC();
push_extra_root(&a); push_extra_root(&a);
push_extra_root(&b); push_extra_root(&b);
@ -1210,10 +1032,9 @@ extern void * /*Lstrcat*/ Li__Infix_4343 (void *a, void *b) {
strncpy(d->contents, da->contents, LEN(da->data_header)); strncpy(d->contents, da->contents, LEN(da->data_header));
strncpy(d->contents + LEN(da->data_header), db->contents, LEN(db->data_header)); strncpy(d->contents + LEN(da->data_header), db->contents, LEN(db->data_header));
d->contents[LEN(da->data_header) + LEN(db->data_header)] = 0; d->contents[LEN(da->data_header) + LEN(db->data_header)] = 0;
__post_gc(); POST_GC();
return d->contents; return d->contents;
} }
@ -1231,13 +1052,13 @@ extern void *Lsprintf (char *fmt, ...) {
vprintStringBuf(fmt, args); vprintStringBuf(fmt, args);
__pre_gc(); PRE_GC();
push_extra_root((void **)&fmt); push_extra_root((void **)&fmt);
s = Bstring(stringBuf.contents); s = Bstring(stringBuf.contents);
pop_extra_root((void **)&fmt); pop_extra_root((void **)&fmt);
__post_gc(); POST_GC();
deleteStringBuf(); deleteStringBuf();
@ -1248,13 +1069,13 @@ extern void *LgetEnv (char *var) {
char *e = getenv(var); char *e = getenv(var);
void *s; void *s;
if (e == NULL) return (void *)BOX(0); // TODO add (void*) cast? if (e == NULL) return (void *)BOX(0);
__pre_gc(); PRE_GC();
s = Bstring(e); s = Bstring(e);
__post_gc(); POST_GC();
return s; return s;
} }
@ -1373,9 +1194,9 @@ extern void *Lfexists (char *fname) {
f = fopen(fname, "r"); f = fopen(fname, "r");
if (f) return (void *)BOX(1); // (void*) cast? if (f) return (void *)BOX(1);
return (void *)BOX(0); // (void*) cast? return (void *)BOX(0);
} }
extern void *Lfst (void *v) { return Belem(v, BOX(0)); } extern void *Lfst (void *v) { return Belem(v, BOX(0)); }
@ -1398,12 +1219,12 @@ extern int Lread () {
} }
extern int Lbinoperror (void) { extern int Lbinoperror (void) {
/* fprintf(stderr, "ERROR: POINTER ARITHMETICS is forbidden; EXIT\n"); /* fprintf(stderr, "ERROR: POINTER ARITHMETICS is forbidden; EXIT\n");
exit(1);*/ exit(1);*/
} }
extern int Lbinoperror2 (void) { extern int Lbinoperror2 (void) {
/* fprintf(stderr, "ERROR: Comparing BOXED and UNBOXED value ; EXIT\n"); /* fprintf(stderr, "ERROR: Comparing BOXED and UNBOXED value ; EXIT\n");
exit(1);*/ exit(1);*/
} }
@ -1433,49 +1254,23 @@ extern int Ltime () {
extern void set_args (int argc, char *argv[]) { extern void set_args (int argc, char *argv[]) {
data *a; data *a;
int n = argc, *p = NULL; int n = argc;
int *p = NULL;
int i; int i;
__pre_gc(); PRE_GC();
#ifdef DEBUG_PRINT
indent++;
print_indent();
printf("set_args: call: n=%i &p=%p p=%p: ", n, &p, p);
fflush(stdout);
for (i = 0; i < n; i++) printf("%s ", argv[i]);
printf("EE\n");
#endif
p = LmakeArray(BOX(n)); p = LmakeArray(BOX(n));
push_extra_root((void **)&p); push_extra_root((void **)&p);
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) { ((int *)p)[i] = (int)Bstring(argv[i]); }
#ifdef DEBUG_PRINT
print_indent();
printf("set_args: iteration %i %p %p ->\n", i, &p, p);
fflush(stdout);
#endif
((int *)p)[i] = (int)Bstring(argv[i]);
#ifdef DEBUG_PRINT
print_indent();
printf("set_args: iteration %i <- %p %p\n", i, &p, p);
fflush(stdout);
#endif
}
pop_extra_root((void **)&p); pop_extra_root((void **)&p);
__post_gc(); POST_GC();
global_sysargs = p; global_sysargs = p;
push_extra_root((void **)&global_sysargs); push_extra_root((void **)&global_sysargs);
#ifdef DEBUG_PRINT
print_indent();
printf("set_args: end\n", n, &p, p);
fflush(stdout);
indent--;
#endif
} }
/* GC starts here */ /* GC starts here */