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

2
runtime/Makefile
View file

@ -1,5 +1,5 @@
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
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;
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;
#endif
@ -54,14 +54,15 @@ void *alloc (size_t size) {
#endif
size_t bytes_sz = size;
size = BYTES_TO_WORDS(size);
#ifdef DEBUG_VERSION
fprintf(stderr, "allocation of size %zu words (%zu bytes): ", size, bytes_sz);
#endif
void *p = gc_alloc_on_existing_heap(size);
if (!p) {
// not enough place in heap, need to perform GC cycle
p = gc_alloc(size);
// return gc_alloc(size);
}
// fprintf(stderr, "%p, tag=%zu\n", p, tag);
return p;
}
@ -183,20 +184,21 @@ void *gc_alloc_on_existing_heap (size_t size) {
}
void *gc_alloc (size_t size) {
#ifdef DEBUG_VERSION
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 *heap_before = print_objects_traversal("before-mark", 0);
fclose(heap_before);
fclose(stack_before);
// #endif
#endif
mark_phase();
// #ifdef FULL_INVARIANT_CHECKS
#ifdef FULL_INVARIANT_CHECKS
FILE *heap_before_compaction = print_objects_traversal("after-mark", 1);
// #endif
#endif
compact_phase(size);
// #ifdef FULL_INVARIANT_CHECKS
#ifdef FULL_INVARIANT_CHECKS
FILE *stack_after = print_stack_content("stack-dump-after-compaction");
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);
exit(1);
}
fclose(stack_before);
fclose(stack_after);
pos = files_cmp(heap_before_compaction, heap_after_compaction);
if (pos >= 0) { // position of difference is found
fprintf(stderr, "GC invariant is broken, pos is %d\n", pos);
exit(1);
}
fclose(heap_before_compaction);
fclose(heap_after_compaction);
// #endif
#endif
#ifdef DEBUG_VERSION
fprintf(stderr, "===============================GC cycle has finished\n");
#endif
return gc_alloc_on_existing_heap(size);
}
void mark_phase (void) {
#ifdef DEBUG_VERSION
fprintf(stderr, "marking has started\n");
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_bottom);
#endif
__gc_root_scan_stack();
fprintf(stderr, "__gc_root_scan_stack finished\n");
fprintf(stderr, "scan_extra_roots started\n");
#ifdef DEBUG_VERSION
fprintf(stderr, "__gc_root_scan_stack has finished\n");
fprintf(stderr, "scan_extra_roots has started\n");
#endif
scan_extra_roots();
fprintf(stderr, "scan_extra_roots finished\n");
// #ifndef DEBUG_VERSION
fprintf(stderr, "scan_global_area started\n");
#ifdef DEBUG_VERSION
fprintf(stderr, "scan_extra_roots has finished\n");
fprintf(stderr, "scan_global_area has started\n");
#endif
scan_global_area();
fprintf(stderr, "scan_global_area finished\n");
// #endif
#ifdef DEBUG_VERSION
fprintf(stderr, "scan_global_area has finished\n");
fprintf(stderr, "marking has finished\n");
#endif
}
void compact_phase (size_t additional_size) {
@ -281,7 +292,9 @@ void compact_phase (size_t additional_size) {
}
size_t compute_locations () {
#ifdef DEBUG_VERSION
fprintf(stderr, "GC compute_locations started\n");
#endif
size_t *free_ptr = heap.begin;
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");
#endif
// it will return number of words
return free_ptr - heap.begin;
}
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");
#endif
for (size_t *ptr = (size_t *)start; ptr < (size_t *)end; ++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
@ -316,25 +333,38 @@ void scan_and_fix_region (memory_chunk *old_heap, void *start, void *end) {
*(void **)ptr = new_addr + content_offset;
}
}
#ifdef DEBUG_VERSION
fprintf(stderr, "GC scan_and_fix_region finished\n");
#endif
}
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);
#endif
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;
if (extra_roots.roots[i] > __gc_stack_top && extra_roots.roots[i] <= __gc_stack_bottom) {
if (is_valid_heap_pointer(ptr_value)) {
if (!is_valid_pointer((size_t *)ptr_value)) { continue; }
// 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,
"|\tskip extra root: %p (%p), since it points to Lama's stack top=%p bot=%p\n",
extra_roots.roots[i],
ptr_value,
__gc_stack_top,
__gc_stack_bottom);
} else if ((extra_roots.roots[i] <= (void *)&__stop_custom_data
&& extra_roots.roots[i] >= (void *)&__start_custom_data)
|| (extra_roots.roots[i] <= (void *)&__stop_custom_data
}
# ifdef LAMA_ENV
else if ((extra_roots.roots[i] <= (void *)&__stop_custom_data
&& extra_roots.roots[i] >= (void *)&__start_custom_data)) {
fprintf(
stderr,
@ -344,29 +374,37 @@ void scan_and_fix_region_roots (memory_chunk *old_heap) {
(void *)&__stop_custom_data,
(void *)&__start_custom_data);
exit(1);
} else {
}
# endif
else {
fprintf(stderr,
"|\tskip extra root: %p (%p): not a valid Lama pointer \n",
extra_roots.roots[i],
ptr_value);
}
#endif
continue;
}
if (is_valid_pointer((size_t *)ptr_value) && (size_t)old_heap->begin <= ptr_value
&& ptr_value <= (size_t)old_heap->current) {
if ((size_t)old_heap->begin <= ptr_value && ptr_value <= (size_t)old_heap->current) {
void *obj_ptr = (void *)heap.begin + ((void *)ptr_value - (void *)old_heap->begin);
void *new_addr =
(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));
*(void **)ptr = new_addr + content_offset;
#ifdef DEBUG_VERSION
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");
#endif
}
void update_references (memory_chunk *old_heap) {
#ifdef DEBUG_VERSION
fprintf(stderr, "GC update_references started\n");
#endif
heap_iterator it = heap_begin_iterator();
while (!heap_is_done_iterator(&it)) {
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
scan_and_fix_region_roots(old_heap);
// #ifndef DEBUG_VERSION
// fix pointers from static area
#ifdef LAMA_ENV
assert((void *)&__stop_custom_data >= (void *)&__start_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");
#endif
}
void physically_relocate (memory_chunk *old_heap) {
#ifdef DEBUG_VERSION
fprintf(stderr, "GC physically_relocate started\n");
#endif
heap_iterator from_iter = heap_begin_iterator();
while (!heap_is_done_iterator(&from_iter)) {
@ -431,7 +472,9 @@ void physically_relocate (memory_chunk *old_heap) {
}
from_iter = next_iter;
}
#ifdef DEBUG_VERSION
fprintf(stderr, "GC physically_relocate finished\n");
#endif
}
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) {
// fprintf(stderr, "Marking object with content address %p on the heap\n", obj);
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
@ -497,7 +539,7 @@ void scan_extra_roots (void) {
}
}
#ifndef DEBUG_VERSION
#ifdef LAMA_ENV
void scan_global_area (void) {
// __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) {
@ -507,30 +549,14 @@ void scan_global_area (void) {
#endif
extern void gc_test_and_mark_root (size_t **root) {
#ifdef DEBUG_VERSION
fprintf(stderr,
"\troot = %p (%p), stack addresses: [%p, %p)\n",
root,
*root,
(void *)__gc_stack_top + 4,
(void *)__gc_stack_bottom);
// if (is_valid_pointer(*root) && !is_valid_heap_pointer(*root)) {
// 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));
// }
// }
#endif
mark((void *)*root);
}
@ -554,7 +580,7 @@ extern void __init (void) {
extern void __shutdown (void) {
munmap(heap.begin, heap.size);
#ifdef DEBUG_VERSION
#ifdef FULL_INVARIANT_CHECKS
cur_id = 0;
#endif
heap.begin = NULL;
@ -572,7 +598,7 @@ void push_extra_root (void **p) {
perror("ERROR: push_extra_roots: extra_roots_pool overflow\n");
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.current_free++;
}
@ -591,8 +617,7 @@ void pop_extra_root (void **p) {
/* 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 *ids_ptr = (size_t *)object_ids_buf;
size_t i = 0;
@ -605,7 +630,9 @@ size_t objects_snapshot (int *object_ids_buf, size_t object_ids_buf_size) {
}
return i;
}
#endif
#ifdef DEBUG_VERSION
extern char *de_hash (int);
void dump_heap () {
@ -721,12 +748,11 @@ lama_type get_type_header_ptr (void *ptr) {
TAG(*header),
heap.size,
cur_id,
__gc_stack_top,
__gc_stack_bottom);
(void *)__gc_stack_top,
(void *)__gc_stack_bottom);
FILE *heap_before_compaction = print_objects_traversal("dump_kill", 1);
close(heap_before_compaction);
fclose(heap_before_compaction);
kill(getpid(), SIGSEGV);
#endif
exit(1);
}
@ -828,8 +854,10 @@ size_t get_header_size (lama_type type) {
void *alloc_string (int len) {
data *obj = alloc(string_size(len));
obj->data_header = STRING_TAG | (len << 3);
fprintf(stderr, "%p, [STRING] tag=%zu\n", obj, TAG(obj->data_header));
#ifdef DEBUG_VERSION
fprintf(stderr, "%p, [STRING] tag=%zu\n", obj, TAG(obj->data_header));
#endif
#ifdef FULL_INVARIANT_CHECKS
obj->id = cur_id;
#endif
obj->forward_address = 0;
@ -839,7 +867,9 @@ void *alloc_string (int len) {
void *alloc_array (int len) {
data *obj = alloc(array_size(len));
obj->data_header = ARRAY_TAG | (len << 3);
#ifdef DEBUG_VERSION
fprintf(stderr, "%p, [ARRAY] tag=%zu\n", obj, TAG(obj->data_header));
#endif
#ifdef FULL_INVARIANT_CHECKS
obj->id = cur_id;
#endif
@ -850,7 +880,9 @@ void *alloc_array (int len) {
void *alloc_sexp (int members) {
sexp *obj = alloc(sexp_size(members));
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));
#endif
#ifdef FULL_INVARIANT_CHECKS
obj->contents.id = cur_id;
#endif
@ -863,7 +895,9 @@ void *alloc_closure (int captured) {
data *obj = alloc(closure_size(captured));
obj->data_header = CLOSURE_TAG | (captured << 3);
#ifdef DEBUG_VERSION
fprintf(stderr, "%p, [CLOSURE] tag=%zu\n", obj, TAG(obj->data_header));
#endif
#ifdef FULL_INVARIANT_CHECKS
obj->id = cur_id;
#endif

9
runtime/gc.h
View file

@ -66,10 +66,10 @@ void mark (void *obj);
void mark_phase (void);
// written in ASM, scans stack for pointers to the heap and starts marking process
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
void scan_extra_roots (void);
#ifndef DEBUG_VERSION
#ifdef LAMA_ENV
// marks each valid pointer from global area
void scan_global_area (void);
#endif
@ -105,14 +105,15 @@ void pop_extra_root (void **p);
/* 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,
// 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_size is in WORDS, NOT BYTES
size_t objects_snapshot (int *object_ids_buf, size_t object_ids_buf_size);
#endif
#ifdef DEBUG_VERSION
// essential function to mock program stack
void set_stack (size_t stack_top, size_t stack_bottom);

341
runtime/runtime.c
View file

@ -12,8 +12,6 @@
# define alloc malloc
#endif
//# define DEBUG_PRINT 1
#ifdef __ENABLE_GC__
/* GC extern invariant for built-in functions */
@ -32,6 +30,24 @@ void __post_gc_subst () { }
#endif
/* 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) {
fprintf(stderr, "*** FAILURE: ");
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); \
while (0)
//extern void* alloc (size_t);
extern void *Bsexp (int n, ...);
extern int LtagHash (char *);
@ -92,14 +107,10 @@ extern int LcompareTags (void *p, void *q) {
qd = TO_DATA(q);
if (TAG(pd->data_header) == SEXP_TAG && TAG(qd->data_header) == SEXP_TAG) {
return
#ifndef DEBUG_PRINT
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
return BOX((TO_SEXP(p)->tag) - (TO_SEXP(q)->tag));
} else {
failure("not a sexpr in compareTags: %d, %d\n", TAG(pd->data_header), TAG(qd->data_header));
}
return 0; // never happens
}
@ -108,7 +119,7 @@ extern int LcompareTags (void *p, void *q) {
void *Ls__Infix_58 (void *p, void *q) {
void *res;
__pre_gc();
PRE_GC();
push_extra_root(&p);
push_extra_root(&q);
@ -116,7 +127,7 @@ void *Ls__Infix_58 (void *p, void *q) {
pop_extra_root(&q);
pop_extra_root(&p);
__post_gc();
POST_GC();
return res;
}
@ -257,34 +268,17 @@ extern int LtagHash (char *s) {
}
char *de_hash (int n) {
// static char *chars = (char*) BOX (NULL);
static char buf[6] = {0, 0, 0, 0, 0, 0};
char *p = (char *)BOX(NULL);
p = &buf[5];
#ifdef DEBUG_PRINT
indent++;
print_indent();
printf("de_hash: data_header: %d\n", n);
fflush(stdout);
#endif
*p-- = 0;
while (n != 0) {
#ifdef DEBUG_PRINT
print_indent();
printf("char: %c\n", chars[n & 0x003F]);
fflush(stdout);
#endif
*p-- = chars[n & 0x003F];
n = n >> 6;
}
#ifdef DEBUG_PRINT
indent--;
#endif
return ++p;
}
@ -480,7 +474,7 @@ extern void *Lsubstring (void *subj, int p, int l) {
if (pp + ll <= LEN(d->data_header)) {
data *r;
__pre_gc();
PRE_GC();
push_extra_root(&subj);
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);
__post_gc();
POST_GC();
return r->contents;
}
@ -537,63 +531,29 @@ void *Lclone (void *p) {
sexp *sobj;
void *res;
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;
else {
PRE_GC();
data *a = TO_DATA(p);
int t = TAG(a->data_header), l = LEN(a->data_header);
push_extra_root(&p);
switch (t) {
case STRING_TAG:
#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 STRING_TAG: res = Bstring(TO_DATA(p)->contents); break;
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);
memcpy(obj, TO_DATA(p), array_size(l));
res = (void *)obj->contents;
break;
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);
memcpy(obj, TO_DATA(p), closure_size(l));
res = (void *)(obj->contents);
break;
case SEXP_TAG:
#ifdef DEBUG_PRINT
print_indent();
printf("Lclone: sexp\n");
fflush(stdout);
#endif
sobj = (sexp *)alloc_sexp(l);
memcpy(sobj, TO_SEXP(p), sexp_size(l));
res = (void *)sobj->contents.contents;
@ -602,20 +562,8 @@ void *Lclone (void *p) {
default: failure("invalid data_header %d in clone *****\n", t);
}
pop_extra_root(&p);
}
#ifdef DEBUG_PRINT
print_indent();
printf("Lclone ends1\n");
fflush(stdout);
#endif
__post_gc();
#ifdef DEBUG_PRINT
print_indent();
printf("Lclone ends2\n");
fflush(stdout);
indent--;
#endif
POST_GC();
return res;
}
@ -654,11 +602,7 @@ int inner_hash (int depth, unsigned acc, void *p) {
case ARRAY_TAG: i = 0; break;
case SEXP_TAG: {
#ifndef DEBUG_PRINT
int ta = TO_SEXP(p)->tag;
#else
int ta = GET_SEXP_TAG(TO_SEXP(p)->data_header);
#endif
acc = HASH_APPEND(acc, ta);
i = 0;
break;
@ -728,12 +672,7 @@ extern int Lcompare (void *p, void *q) {
break;
case SEXP_TAG: {
#ifndef DEBUG_PRINT
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(la, lb);
i = 0;
@ -775,7 +714,7 @@ extern void *LmakeArray (int length) {
ASSERT_UNBOXED("makeArray:1", length);
__pre_gc();
PRE_GC();
n = UNBOX(length);
r = (data *)alloc_array(n);
@ -783,7 +722,7 @@ extern void *LmakeArray (int length) {
p = (int *)r->contents;
while (n--) *p++ = BOX(0);
__post_gc();
POST_GC();
return r->contents;
}
@ -794,11 +733,11 @@ extern void *LmakeString (int 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
__post_gc();
POST_GC();
return r->contents;
}
@ -807,42 +746,15 @@ extern void *Bstring (void *p) {
int n = strlen(p);
void *s = NULL;
__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
PRE_GC();
push_extra_root(&p);
s = LmakeString(BOX(n));
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
#ifdef DEBUG_PRINT
print_indent();
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);
}
POST_GC();
return s;
}
@ -851,7 +763,7 @@ extern void *Lstringcat (void *p) {
/* ASSERT_BOXED("stringcat", p); */
__pre_gc();
PRE_GC();
createStringBuf();
stringcat(p);
@ -862,7 +774,7 @@ extern void *Lstringcat (void *p) {
deleteStringBuf();
__post_gc();
POST_GC();
return s;
}
@ -870,7 +782,7 @@ extern void *Lstringcat (void *p) {
extern void *Lstring (void *p) {
void *s = (void *)BOX(NULL);
__pre_gc();
PRE_GC();
createStringBuf();
printValue(p);
@ -881,13 +793,12 @@ extern void *Lstring (void *p) {
deleteStringBuf();
__post_gc();
POST_GC();
return s;
}
extern void *Bclosure (int bn, void *entry, ...) {
void *before_frame = __builtin_frame_address(0);
va_list args;
int i, ai;
register int *ebp asm("ebp");
@ -895,21 +806,8 @@ extern void *Bclosure (int bn, void *entry, ...) {
data *r;
int n = UNBOX(bn);
if (before_frame != __builtin_frame_address(0)) {
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
PRE_GC();
argss = (ebp + 12);
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);
__post_gc();
POST_GC();
pop_extra_root(&r);
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;
}
extern void *Barray (int bn, ...) {
void *before_frame = __builtin_frame_address(0);
va_list args;
int i, ai;
data *r;
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);
va_start(args, bn);
@ -980,15 +851,7 @@ extern void *Barray (int bn, ...) {
va_end(args);
__post_gc();
#ifdef DEBUG_PRINT
indent--;
#endif
if (before_frame != __builtin_frame_address(0)) {
fprintf(stderr, "WARNING!!!!!!! stack pointer moved\n");
exit(1);
}
POST_GC();
return r->contents;
}
@ -997,7 +860,6 @@ extern memory_chunk heap;
#endif
extern void *Bsexp (int bn, ...) {
void *before_frame = __builtin_frame_address(0);
va_list args;
int i;
int ai;
@ -1006,22 +868,8 @@ extern void *Bsexp (int bn, ...) {
data *d;
int n = UNBOX(bn);
if (before_frame != __builtin_frame_address(0)) {
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);
}
PRE_GC();
#ifdef DEBUG_PRINT
indent++;
print_indent();
printf("Bsexp: allocate %zu!\n", sizeof(int) * (n + 1));
fflush(stdout);
#endif
int fields_cnt = n - 1;
r = (sexp *)alloc_sexp(fields_cnt);
d = &(r->contents);
@ -1032,32 +880,15 @@ extern void *Bsexp (int bn, ...) {
for (i = 0; i < n - 1; i++) {
ai = va_arg(args, int);
#ifdef DEBUG_VERSION
if (!UNBOXED(ai)) { assert(is_valid_heap_pointer((size_t *)ai)); }
#endif
p = (size_t *)ai;
((int *)d->contents)[i] = ai;
}
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);
__post_gc();
if (before_frame != __builtin_frame_address(0)) {
fprintf(stderr, "ERROR!!!!!!! stack pointer moved\n");
exit(1);
}
POST_GC();
return d->contents;
}
@ -1067,20 +898,12 @@ extern int Btag (void *d, int t, int n) {
if (UNBOXED(d)) return BOX(0);
else {
r = TO_DATA(d);
#ifndef DEBUG_PRINT
return BOX(TAG(r->data_header) == SEXP_TAG && TO_SEXP(d)->tag == UNBOX(t)
&& 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) {
// printf("%")
return TAG(d->data_header);
}
int get_tag (data *d) { return TAG(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);
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) {
if (UNBOXED(i)) {
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);
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);
db = TO_DATA(b);
__pre_gc();
PRE_GC();
push_extra_root(&a);
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 + LEN(da->data_header), db->contents, LEN(db->data_header));
d->contents[LEN(da->data_header) + LEN(db->data_header)] = 0;
__post_gc();
POST_GC();
return d->contents;
}
@ -1231,13 +1052,13 @@ extern void *Lsprintf (char *fmt, ...) {
vprintStringBuf(fmt, args);
__pre_gc();
PRE_GC();
push_extra_root((void **)&fmt);
s = Bstring(stringBuf.contents);
pop_extra_root((void **)&fmt);
__post_gc();
POST_GC();
deleteStringBuf();
@ -1248,13 +1069,13 @@ extern void *LgetEnv (char *var) {
char *e = getenv(var);
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);
__post_gc();
POST_GC();
return s;
}
@ -1373,9 +1194,9 @@ extern void *Lfexists (char *fname) {
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)); }
@ -1398,12 +1219,12 @@ extern int Lread () {
}
extern int Lbinoperror (void) {
/* fprintf(stderr, "ERROR: POINTER ARITHMETICS is forbidden; EXIT\n");
/* fprintf(stderr, "ERROR: POINTER ARITHMETICS is forbidden; EXIT\n");
exit(1);*/
}
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);*/
}
@ -1433,49 +1254,23 @@ extern int Ltime () {
extern void set_args (int argc, char *argv[]) {
data *a;
int n = argc, *p = NULL;
int n = argc;
int *p = NULL;
int i;
__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
PRE_GC();
p = LmakeArray(BOX(n));
push_extra_root((void **)&p);
for (i = 0; i < n; 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
}
for (i = 0; i < n; i++) { ((int *)p)[i] = (int)Bstring(argv[i]); }
pop_extra_root((void **)&p);
__post_gc();
POST_GC();
global_sysargs = p;
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 */