void* simon_gc_malloc(size_t n)
{
gc_lock();
void* ptr = memory_heap_allocate(young, n);
if (!ptr)
{
gc_collect();
ptr = memory_heap_allocate(young, n);
}
gc_unlock();
return ptr;
}
void* gc_alloc(ObjectType type, int size) {
if (heap_num == heap_max) gc_collect();
ObjectHeader* head = malloc(sizeof(ObjectHeader)+size);
debug("gc_alloc %p\n", head);
head->type = type;
head->next = heap_list;
heap_list = head;
head->marked = 0;
head->size=size;
heap_num++;
return &head[1];
}
void test() {
void* frame[2];
static void* start_ptr = &&end; goto *start_ptr; start:;
printf("frame[1]=%p\n", frame);
frame[0] = gc_alloc(OBJ_BOXED_ARRAY,sizeof(long)*2);
lbl1:;
assert(heap_num==1);
gc_collect();
assert(heap_num==1);
lbl2:;
gc_collect();
assert(heap_num==1);
lbl3:;
gc_collect();
assert(heap_num==0);
return;
end:;
static int bitmap[] = {1,1};
static Frame frames[] = {
{&&lbl1,1,&bitmap[0]},
{&&lbl2,1,&bitmap[1]},
void test_record() {
ENTER_FRAME(frame,2);
// レコード
enum {RECORD_SIZE=3,RECORD_BITMAP=BIT(1)|BIT(2)};
Object* A = pool(gc_alloc_record(RECORD_SIZE));
A->longs[RECORD_SIZE] = RECORD_BITMAP;// レコードのビットマップ(cpuビット数分でアラインする。ビットマップもcpu bit数)
A->longs[0] = 10; // undata
A->field[1] = gc_alloc_int(20);
A->field[2] = test_int(30);
assert(vm->heap_num==3);
gc_collect();
assert(vm->heap_num==3);
LEAVE_FRAME(frame);
}
void test() {
void* frame[2];
static void* start_ptr = &&end; goto *start_ptr; start:;
printf("frame[1]=%p\n", frame);
assert(heap_num==0);
frame[0] = gc_alloc(OBJ_BOXED_ARRAY,sizeof(long)*2);
assert(heap_num==1);
gc_collect();
assert(heap_num==1);
return;
end:;
static StackMap f = {3, (void*)test,&&end, NULL};
gc_add_stack_map(&f); start_ptr=&&start; goto start;
}
void *gc_alloc(value *desc, unsigned size, value *sp) {
unsigned alloc_size;
word *p = NULL;
header *h;
if (debug['z']) gc_collect(sp);
size = round_up(size+4, BYTES_PER_WORD);
if (size <= MAX_SMALL_BYTES) {
/* Try to allocate from the appropriate pool */
unsigned index = pool_map(size);
alloc_size = pool_size(index);
ASSERT(alloc_size >= size);
if (free_count[index] == 0) {
while (pool_total + pool_block(index) > heap_size
&& free_count[index] == 0)
scavenge(sp, pool_block(index));
if (free_count[index] == 0)
add_block(index);
}
p = (word *) free_ptr[index];
free_ptr[index] += alloc_size;
free_count[index]--;
} else {
/* Allocate whole pages */
alloc_size = round_up(size, GC_PAGESIZE);
while (pool_total + alloc_size > heap_size)
scavenge(sp, alloc_size);
h = find_block(alloc_size, alloc_size);
insert(block_pool[n_sizes], h);
pool_total += alloc_size;
p = (word *) h->h_memory;
}
alloc_since_gc += alloc_size;
DEBUG_PRINT('c', ("[Alloc %d %p]", size, p));
*p = (word) desc;
return p+1;
}
void test_record() {
enum {A, DUMMY, SIZE};
Object* frame[SIZE];
static void* start_ptr = &&end; goto *start_ptr; start:;
// レコード
enum {RECORD_SIZE=3,RECORD_BITMAP=BIT(1)|BIT(2)};
frame[A] = gc_alloc_record(RECORD_SIZE);
frame[A]->longs[0] = 10; // undata
frame[A]->field[1] = gc_alloc_int(20);
frame[A]->field[2] = test_int(30);
frame[A]->longs[RECORD_SIZE] = RECORD_BITMAP;// レコードのビットマップ(cpuビット数分でアラインする。ビットマップもcpu bit数)
assert(heap_num==3);
gc_collect();
assert(heap_num==3);
return;
end:;
static StackMap f = {SIZE, (void*)test_record,&&end, NULL};
gc_add_stack_map(&f); start_ptr=&&start; goto *start_ptr;
}
void test3() {
enum {A, B, unboxed, DUMMY, SIZE};
Object* frame[SIZE];
static void* start_ptr = &&end; goto *start_ptr; start:;
printf("test frame=%p\n", frame);
// ペア
frame[A] = gc_alloc_pair();
frame[A]->pair.fst = gc_alloc_int(10);
frame[A]->pair.snd = gc_alloc_int(20);
// オブジェクト配列
frame[B] = gc_alloc_boxed_array(2);
frame[B]->field[0] = gc_alloc_int(30);
frame[B]->field[1] = gc_alloc_int(40);
// int配列
frame[unboxed] = gc_alloc_unboxed_array(sizeof(int)*2);
frame[unboxed]->ints[0] = 50;
frame[unboxed]->ints[1] = 60;
printf("data1 = %p %d\n", frame[A]->pair.fst, frame[A]->pair.fst->intv);
printf("data2 = %p %d\n", frame[A]->pair.snd, frame[A]->pair.snd->intv);
printf("data3 = %p %d\n", frame[B]->field[0], frame[B]->field[0]->intv);
printf("data4 = %p %d\n", frame[B]->field[1], frame[B]->field[1]->intv);
printf("data5 = %p %d\n", &frame[unboxed]->ints[0], frame[unboxed]->ints[0]);
printf("data6 = %p %d\n", &frame[unboxed]->ints[1], frame[unboxed]->ints[1]);
assert(heap_num==7);
gc_collect();
assert(heap_num==7);
return;
end:;
static StackMap f = {SIZE, (void*)test3,&&end, NULL};
gc_add_stack_map(&f); start_ptr=&&start; goto start;
}
void
gc_collect_garbage()
{
int i;
for (i = 0; i < NUM_CELLS; i++) {
gc_header(cells[i])->marked = 0;
}
gc_mark(_stack);
gc_mark(_environ);
gc_mark(_control);
gc_mark(_dump);
gc_mark(_work);
gc_mark(_true);
gc_mark(_false);
gc_mark(_nil);
gc_collect();
if (ff == NULL) {
printf("out of memory: %s", __func__);
exit(-1);
}
}
int main(int argc, char** argv) {
GarbageCollector gc = gc_create(10,sizeof(struct node),node_mark,NULL,NULL);
Node head = NULL;
gc_protect(gc,&head); /* protect the list from garbage collection */
/* populate the list */
head = node(gc,head,1);
head = node(gc,head,2);
head = node(gc,head,3);
/* force collect */
gc_collect(gc);
/* check whether list still exists */
Node cur;
for (cur = head; cur ; cur = cur->next)
printf("%d\n",cur->value);
gc_free(&gc);
return 0;
}
/*
* GC should collect?
*/
static inline void gc_maybe_collect(uint32_t size)
{
gc_alloc_size += size;
if (gc_alloc_size >= gc_trigger_size)
{
if (!gc_enabled)
return;
gc_collect();
size_t gc_scan_size = 0;
size_t stacksize = gc_stackbottom - gc_stacktop();
gc_scan_size += 2*stacksize;
gc_root_t root = gc_roots;
while (root != NULL)
{
gc_scan_size += (*root->sizeptr)*root->elemsize;
root = root->next;
}
gc_scan_size += 2*gc_used_size;
gc_trigger_size = (size_t)(gc_scan_size / GC_SPACE_FACTOR);
gc_trigger_size = (gc_trigger_size < GC_MIN_TRIGGER? GC_MIN_TRIGGER:
gc_trigger_size);
gc_alloc_size = size;
}
}
void simon_gc_collect()
{
gc_lock();
gc_collect();
gc_unlock();
}
void gc_free() {
gc_collect();
assert(heap_num==0);
}
// parses, compiles and executes the code in the lexer
// frees the lexer before returning
bool parse_compile_execute(mp_lexer_t *lex, mp_parse_input_kind_t input_kind, bool is_repl) {
mp_parse_error_kind_t parse_error_kind;
mp_parse_node_t pn = mp_parse(lex, input_kind, &parse_error_kind);
qstr source_name = mp_lexer_source_name(lex);
if (pn == MP_PARSE_NODE_NULL) {
// parse error
mp_parse_show_exception(lex, parse_error_kind);
mp_lexer_free(lex);
return false;
}
mp_lexer_free(lex);
mp_obj_t module_fun = mp_compile(pn, source_name, MP_EMIT_OPT_NONE, is_repl);
if (mp_obj_is_exception_instance(module_fun)) {
mp_obj_print_exception(module_fun);
return false;
}
nlr_buf_t nlr;
bool ret;
uint32_t start = HAL_GetTick();
if (nlr_push(&nlr) == 0) {
usb_vcp_set_interrupt_char(VCP_CHAR_CTRL_C); // allow ctrl-C to interrupt us
mp_call_function_0(module_fun);
usb_vcp_set_interrupt_char(VCP_CHAR_NONE); // disable interrupt
nlr_pop();
ret = true;
} else {
// uncaught exception
// FIXME it could be that an interrupt happens just before we disable it here
usb_vcp_set_interrupt_char(VCP_CHAR_NONE); // disable interrupt
mp_obj_print_exception((mp_obj_t)nlr.ret_val);
ret = false;
}
// display debugging info if wanted
if (is_repl && repl_display_debugging_info) {
uint32_t ticks = HAL_GetTick() - start; // TODO implement a function that does this properly
printf("took %lu ms\n", ticks);
gc_collect();
// qstr info
{
mp_uint_t n_pool, n_qstr, n_str_data_bytes, n_total_bytes;
qstr_pool_info(&n_pool, &n_qstr, &n_str_data_bytes, &n_total_bytes);
printf("qstr:\n n_pool=" UINT_FMT "\n n_qstr=" UINT_FMT "\n n_str_data_bytes=" UINT_FMT "\n n_total_bytes=" UINT_FMT "\n", n_pool, n_qstr, n_str_data_bytes, n_total_bytes);
}
// GC info
{
gc_info_t info;
gc_info(&info);
printf("GC:\n");
printf(" " UINT_FMT " total\n", info.total);
printf(" " UINT_FMT " : " UINT_FMT "\n", info.used, info.free);
printf(" 1=" UINT_FMT " 2=" UINT_FMT " m=" UINT_FMT "\n", info.num_1block, info.num_2block, info.max_block);
}
}
return ret;
}
// parses, compiles and executes the code in the lexer
// frees the lexer before returning
// EXEC_FLAG_PRINT_EOF prints 2 EOF chars: 1 after normal output, 1 after exception output
// EXEC_FLAG_ALLOW_DEBUGGING allows debugging info to be printed after executing the code
// EXEC_FLAG_IS_REPL is used for REPL inputs (flag passed on to mp_compile)
STATIC int parse_compile_execute(mp_lexer_t *lex, mp_parse_input_kind_t input_kind, int exec_flags) {
int ret = 0;
uint32_t start = 0;
nlr_buf_t nlr;
if (nlr_push(&nlr) == 0) {
// parse and compile the script
qstr source_name = lex->source_name;
mp_parse_node_t pn = mp_parse(lex, input_kind);
mp_obj_t module_fun = mp_compile(pn, source_name, MP_EMIT_OPT_NONE, exec_flags & EXEC_FLAG_IS_REPL);
// execute code
mp_hal_set_interrupt_char(CHAR_CTRL_C); // allow ctrl-C to interrupt us
start = HAL_GetTick();
mp_call_function_0(module_fun);
mp_hal_set_interrupt_char(-1); // disable interrupt
nlr_pop();
ret = 1;
if (exec_flags & EXEC_FLAG_PRINT_EOF) {
mp_hal_stdout_tx_strn("\x04", 1);
}
} else {
// uncaught exception
// FIXME it could be that an interrupt happens just before we disable it here
mp_hal_set_interrupt_char(-1); // disable interrupt
// print EOF after normal output
if (exec_flags & EXEC_FLAG_PRINT_EOF) {
mp_hal_stdout_tx_strn("\x04", 1);
}
// check for SystemExit
if (mp_obj_is_subclass_fast(mp_obj_get_type((mp_obj_t)nlr.ret_val), &mp_type_SystemExit)) {
// at the moment, the value of SystemExit is unused
ret = PYEXEC_FORCED_EXIT;
} else {
mp_obj_print_exception(printf_wrapper, NULL, (mp_obj_t)nlr.ret_val);
ret = 0;
}
}
// display debugging info if wanted
if ((exec_flags & EXEC_FLAG_ALLOW_DEBUGGING) && repl_display_debugging_info) {
mp_uint_t ticks = HAL_GetTick() - start; // TODO implement a function that does this properly
printf("took " UINT_FMT " ms\n", ticks);
gc_collect();
// qstr info
{
mp_uint_t n_pool, n_qstr, n_str_data_bytes, n_total_bytes;
qstr_pool_info(&n_pool, &n_qstr, &n_str_data_bytes, &n_total_bytes);
printf("qstr:\n n_pool=" UINT_FMT "\n n_qstr=" UINT_FMT "\n n_str_data_bytes=" UINT_FMT "\n n_total_bytes=" UINT_FMT "\n", n_pool, n_qstr, n_str_data_bytes, n_total_bytes);
}
// GC info
gc_dump_info();
}
if (exec_flags & EXEC_FLAG_PRINT_EOF) {
mp_hal_stdout_tx_strn("\x04", 1);
}
return ret;
}
int main( int argc, char *argv[] ){
int ret = 0;
signed char option;
int i = 0;
int lastopt = 0;
bool interactive = false;
bool load_libs = true;
bool set_a_gc_profile = false;
unsigned new_gc_profile = 0;
stack_frame_t *global_frame;
if ( argc < 2 ){
// By default, go into an REPL
interactive = true;
} else {
// otherwise parse options
lastopt = 1;
for ( i = 1; i < argc && argv[i][0] == '-'; i++ ){
option = argv[i][1];
switch ( option ){
case 'i':
interactive = true;
break;
case 'h':
print_help( );
exit( 0 );
break;
case 'L':
load_libs = false;
break;
case 'g':
{
char *profile = argv[++i];
set_a_gc_profile = true;
if ( strcmp( profile, "fast" ) == 0 ){
new_gc_profile = GC_PROFILE_FAST;
} else if ( strcmp( profile, "balanced" ) == 0 ){
new_gc_profile = GC_PROFILE_BALANCED;
} else if ( strcmp( profile, "lowmem" ) == 0 ){
new_gc_profile = GC_PROFILE_LOWMEM;
} else {
printf( "Unknown garbage collector profile \"%s\", "
"using \"balanced\" instead...\n", profile );
new_gc_profile = GC_PROFILE_BALANCED;
}
}
case 'v':
break;
default:
print_help( );
exit( 1 );
break;
}
/* This keeps track of where the argument after the current argument is,
in order to find the filenames after option parsing is done. */
lastopt = i + 1;
}
}
// print some info about the interpreter going into a REPL
if ( interactive ){
printf( "%s\n", GOJIRA_BUILD_NAME );
}
// Initialize the global interpreter state
global_frame = frame_create( NULL, NULL, MAKE_ENV );
init_global_frame( global_frame );
if ( set_a_gc_profile ){
gc_set_profile( get_current_gc( global_frame ), new_gc_profile );
}
// Load the 'base' library for needed primatives
if ( load_libs ){
evaluate_file( global_frame, BASE_LIB );
}
make_argument_var( global_frame, lastopt, argc, argv );
if ( lastopt ){
evaluate_file( global_frame, argv[lastopt] );
}
// Go into the REPL if the interpreter flag is set
if ( interactive ){
read_eval_print( global_frame );
}
// Clean up the global frame, and free all tokens left in the token cache
gc_collect( get_current_gc( global_frame ));
destroy_token_cache( );
return ret;
}
static pobject collect(pobject env, pobject params)
{
gc_collect(env);
return NIL;
}
void *gc_alloc(machine_uint_t n_bytes, bool has_finaliser) {
machine_uint_t n_blocks = ((n_bytes + BYTES_PER_BLOCK - 1) & (~(BYTES_PER_BLOCK - 1))) / BYTES_PER_BLOCK;
DEBUG_printf("gc_alloc(" UINT_FMT " bytes -> " UINT_FMT " blocks)\n", n_bytes, n_blocks);
// check if GC is locked
if (gc_lock_depth > 0) {
return NULL;
}
// check for 0 allocation
if (n_blocks == 0) {
return NULL;
}
machine_uint_t i;
machine_uint_t end_block;
machine_uint_t start_block;
machine_uint_t n_free = 0;
int collected = 0;
for (;;) {
// look for a run of n_blocks available blocks
for (i = 0; i < gc_alloc_table_byte_len; i++) {
byte a = gc_alloc_table_start[i];
if (ATB_0_IS_FREE(a)) { if (++n_free >= n_blocks) { i = i * BLOCKS_PER_ATB + 0; goto found; } } else { n_free = 0; }
if (ATB_1_IS_FREE(a)) { if (++n_free >= n_blocks) { i = i * BLOCKS_PER_ATB + 1; goto found; } } else { n_free = 0; }
if (ATB_2_IS_FREE(a)) { if (++n_free >= n_blocks) { i = i * BLOCKS_PER_ATB + 2; goto found; } } else { n_free = 0; }
if (ATB_3_IS_FREE(a)) { if (++n_free >= n_blocks) { i = i * BLOCKS_PER_ATB + 3; goto found; } } else { n_free = 0; }
}
// nothing found!
if (collected) {
return NULL;
}
DEBUG_printf("gc_alloc(" UINT_FMT "): no free mem, triggering GC\n", n_bytes);
gc_collect();
collected = 1;
}
// found, ending at block i inclusive
found:
// get starting and end blocks, both inclusive
end_block = i;
start_block = i - n_free + 1;
// mark first block as used head
ATB_FREE_TO_HEAD(start_block);
// mark rest of blocks as used tail
// TODO for a run of many blocks can make this more efficient
for (machine_uint_t bl = start_block + 1; bl <= end_block; bl++) {
ATB_FREE_TO_TAIL(bl);
}
// get pointer to first block
void *ret_ptr = (void*)(gc_pool_start + start_block * WORDS_PER_BLOCK);
DEBUG_printf("gc_alloc(%p)\n", ret_ptr);
// zero out the additional bytes of the newly allocated blocks
// This is needed because the blocks may have previously held pointers
// to the heap and will not be set to something else if the caller
// doesn't actually use the entire block. As such they will continue
// to point to the heap and may prevent other blocks from being reclaimed.
memset((byte*)ret_ptr + n_bytes, 0, (end_block - start_block + 1) * BYTES_PER_BLOCK - n_bytes);
#if MICROPY_ENABLE_FINALISER
if (has_finaliser) {
// clear type pointer in case it is never set
((mp_obj_base_t*)ret_ptr)->type = MP_OBJ_NULL;
// set mp_obj flag only if it has a finaliser
FTB_SET(start_block);
}
#endif
return ret_ptr;
}
static obj_ptr _gc(obj_ptr env)
{
gc_collect();
return MKBOOL(1);
}
void gc_free() {
gc_collect();
assert(vm->heap_num==0);
free(vm);
}
ats_ptr_type
ATS_2d0_2e2_2e10_2ccomp_2runtime_2GCATS1_2gcats1_2esats__gc_freeitmlst_generate (ats_int_type arg0) {
/* local vardec */
ATSlocal (ats_ptr_type, tmp13) ;
// ATSlocal_void (tmp14) ;
// ATSlocal_void (tmp15) ;
ATSlocal (ats_ptr_type, tmp16) ;
ATSlocal (ats_ptr_type, tmp17) ;
ATSlocal (ats_bool_type, tmp18) ;
// ATSlocal_void (tmp19) ;
// ATSlocal_void (tmp20) ;
// ATSlocal_void (tmp21) ;
// ATSlocal_void (tmp22) ;
// ATSlocal_void (tmp23) ;
ATSlocal (ats_ptr_type, tmp24) ;
ATSlocal (ats_bool_type, tmp25) ;
// ATSlocal_void (tmp26) ;
ATSlocal (ats_bool_type, tmp27) ;
ATSlocal (ats_int_type, tmp28) ;
// ATSlocal_void (tmp29) ;
// ATSlocal_void (tmp30) ;
// ATSlocal_void (tmp31) ;
// ATSlocal_void (tmp32) ;
// ATSlocal_void (tmp33) ;
// ATSlocal_void (tmp34) ;
// ATSlocal_void (tmp35) ;
// ATSlocal_void (tmp36) ;
// ATSlocal_void (tmp37) ;
// ATSlocal_void (tmp38) ;
// ATSlocal_void (tmp39) ;
// ATSlocal_void (tmp40) ;
// ATSlocal_void (tmp41) ;
// ATSlocal_void (tmp42) ;
ATSlocal (ats_ptr_type, tmp43) ;
ATSlocal (ats_bool_type, tmp44) ;
// ATSlocal_void (tmp45) ;
ATSlocal (ats_int_type, tmp46) ;
ATSlocal (ats_ptr_type, tmp47) ;
// ATSlocal_void (tmp48) ;
// ATSlocal_void (tmp49) ;
ATSlocal (ats_ptr_type, tmp50) ;
ATSlocal (ats_bool_type, tmp51) ;
// ATSlocal_void (tmp52) ;
// ATSlocal_void (tmp53) ;
// ATSlocal_void (tmp54) ;
__ats_lab_ATS_2d0_2e2_2e10_2ccomp_2runtime_2GCATS1_2gcats1_2esats__gc_freeitmlst_generate:
#line 110 "gcats1_collecting.dats"
/* tmp14 = */ the_sweeplst_lock_acquire_one (arg0) ;
#line 110 "gcats1_collecting.dats"
/* tmp15 = ats_selsin_mac(tmp14, atslab_1) */ ;
#line 111 "gcats1_collecting.dats"
tmp16 = the_sweeplst_array_get (arg0) ;
#line 113 "gcats1_collecting.dats"
tmp18 = chunklst_is_cons (tmp16) ;
#line 113 "gcats1_collecting.dats"
if (tmp18) {
#line 113 "gcats1_collecting.dats"
tmp17 = tmp16 ;
} else {
#line 114 "gcats1_collecting.dats"
/* tmp19 = */ the_sweeplst_lock_release_one (arg0) ;
#line 115 "gcats1_collecting.dats"
/* tmp20 = */ gc_main_lock_acquire () ;
#line 115 "gcats1_collecting.dats"
/* tmp21 = ats_selsin_mac(tmp20, atslab_1) */ ;
#line 116 "gcats1_collecting.dats"
/* tmp22 = */ the_sweeplst_lock_acquire_one (arg0) ;
#line 116 "gcats1_collecting.dats"
/* tmp23 = ats_selsin_mac(tmp22, atslab_1) */ ;
#line 118 "gcats1_collecting.dats"
tmp24 = the_sweeplst_array_get (arg0) ;
#line 120 "gcats1_collecting.dats"
tmp25 = chunklst_is_cons (tmp24) ;
#line 120 "gcats1_collecting.dats"
if (tmp25) {
#line 121 "gcats1_collecting.dats"
/* tmp26 = */ gc_main_lock_release () ;
#line 121 "gcats1_collecting.dats"
tmp17 = tmp24 ;
} else {
#line 124 "gcats1_collecting.dats"
tmp27 = the_chunk_count_limit_is_not_reached () ;
#line 126 "gcats1_collecting.dats"
if (tmp27) {
#line 127 "gcats1_collecting.dats"
tmp28 = atspre_asl_int_int1 (1, arg0) ;
#line 127 "gcats1_collecting.dats"
tmp17 = chunklst_create_release (arg0, tmp28) ;
} else {
#line 129 "gcats1_collecting.dats"
/* tmp29 = */ the_globalentrylst_lock_acquire () ;
#line 129 "gcats1_collecting.dats"
/* tmp30 = ats_selsin_mac(tmp29, atslab_1) */ ;
#line 130 "gcats1_collecting.dats"
/* tmp31 = */ the_manmemlst_lock_acquire () ;
#line 130 "gcats1_collecting.dats"
/* tmp32 = ats_selsin_mac(tmp31, atslab_1) */ ;
#line 131 "gcats1_collecting.dats"
/* tmp33 = */ the_threadinfolst_lock_acquire () ;
#line 131 "gcats1_collecting.dats"
/* tmp34 = ats_selsin_mac(tmp33, atslab_1) */ ;
#line 133 "gcats1_collecting.dats"
/* tmp35 = */ the_sweeplst_lock_acquire_rest (arg0) ;
#line 132 "gcats1_collecting.dats"
/* tmp36 = ats_selsin_mac(tmp35, atslab_1) */ ;
#line 135 "gcats1_collecting.dats"
/* tmp37 = */ gc_collect () ;
#line 139 "gcats1_collecting.dats"
/* tmp38 = */ the_sweeplst_lock_release_rest (arg0) ;
#line 138 "gcats1_collecting.dats"
/* tmp39 = ats_selsin_mac(tmp38, atslab_1) */ ;
#line 142 "gcats1_collecting.dats"
/* tmp40 = */ the_threadinfolst_lock_release () ;
#line 143 "gcats1_collecting.dats"
/* tmp41 = */ the_manmemlst_lock_release () ;
#line 144 "gcats1_collecting.dats"
/* tmp42 = */ the_globalentrylst_lock_release () ;
#line 145 "gcats1_collecting.dats"
tmp43 = the_sweeplst_array_get (arg0) ;
#line 152 "gcats1_collecting.dats"
tmp44 = chunklst_is_cons (tmp43) ;
#line 152 "gcats1_collecting.dats"
if (tmp44) {
#line 153 "gcats1_collecting.dats"
/* tmp45 = */ gc_main_lock_release () ;
#line 153 "gcats1_collecting.dats"
tmp17 = tmp43 ;
} else {
#line 155 "gcats1_collecting.dats"
tmp46 = atspre_asl_int_int1 (1, arg0) ;
#line 155 "gcats1_collecting.dats"
tmp17 = chunklst_create_release (arg0, tmp46) ;
} /* end of [if] */
} /* end of [if] */
} /* end of [if] */
} /* end of [if] */
#line 166 "gcats1_collecting.dats"
tmp47 = chunklst_sweep_next_get (tmp17) ;
#line 167 "gcats1_collecting.dats"
/* tmp48 = */ the_sweeplst_array_set (arg0, tmp47) ;
#line 168 "gcats1_collecting.dats"
/* tmp49 = */ the_sweeplst_lock_release_one (arg0) ;
#line 169 "gcats1_collecting.dats"
tmp50 = gc_chunk_threading (tmp17) ;
#line 176 "gcats1_collecting.dats"
tmp51 = freeitmlst_is_nil (tmp50) ;
#line 176 "gcats1_collecting.dats"
if (tmp51) {
#line 177 "gcats1_collecting.dats"
/* tmp52 = */ atspre_prerr_string (ATSstrcst("GC: Fatal Error")) ;
#line 178 "gcats1_collecting.dats"
/* tmp53 = */ atspre_prerr_string (ATSstrcst(": [gc_freeitmlst_generate]: the generated freeitmlst is nil")) ;
#line 179 "gcats1_collecting.dats"
/* tmp54 = */ atspre_prerr_newline () ;
#line 180 "gcats1_collecting.dats"
/* tmp13 = */ ats_exit (1) ;
} else {
#line 182 "gcats1_collecting.dats"
tmp13 = tmp50 ;
} /* end of [if] */
return (tmp13) ;
} /* end of [ATS_2d0_2e2_2e10_2ccomp_2runtime_2GCATS1_2gcats1_2esats__gc_freeitmlst_generate] */
// parses, compiles and executes the code in the lexer
// frees the lexer before returning
// EXEC_FLAG_PRINT_EOF prints 2 EOF chars: 1 after normal output, 1 after exception output
// EXEC_FLAG_ALLOW_DEBUGGING allows debugging info to be printed after executing the code
// EXEC_FLAG_IS_REPL is used for REPL inputs (flag passed on to mp_compile)
STATIC int parse_compile_execute(const void *source, mp_parse_input_kind_t input_kind, int exec_flags) {
int ret = 0;
uint32_t start = 0;
// by default a SystemExit exception returns 0
pyexec_system_exit = 0;
nlr_buf_t nlr;
if (nlr_push(&nlr) == 0) {
mp_obj_t module_fun;
#if MICROPY_MODULE_FROZEN_MPY
if (exec_flags & EXEC_FLAG_SOURCE_IS_RAW_CODE) {
// source is a raw_code object, create the function
module_fun = mp_make_function_from_raw_code(source, MP_OBJ_NULL, MP_OBJ_NULL);
} else
#endif
{
#if MICROPY_ENABLE_COMPILER
mp_lexer_t *lex;
if (exec_flags & EXEC_FLAG_SOURCE_IS_VSTR) {
const vstr_t *vstr = source;
lex = mp_lexer_new_from_str_len(MP_QSTR__lt_stdin_gt_, vstr->buf, vstr->len, 0);
} else if (exec_flags & EXEC_FLAG_SOURCE_IS_FILENAME) {
lex = mp_lexer_new_from_file(source);
} else {
lex = (mp_lexer_t*)source;
}
// source is a lexer, parse and compile the script
qstr source_name = lex->source_name;
mp_parse_tree_t parse_tree = mp_parse(lex, input_kind);
module_fun = mp_compile(&parse_tree, source_name, MP_EMIT_OPT_NONE, exec_flags & EXEC_FLAG_IS_REPL);
#else
mp_raise_msg(&mp_type_RuntimeError, "script compilation not supported");
#endif
}
// execute code
mp_hal_set_interrupt_char(CHAR_CTRL_C); // allow ctrl-C to interrupt us
start = mp_hal_ticks_ms();
mp_call_function_0(module_fun);
mp_hal_set_interrupt_char(-1); // disable interrupt
nlr_pop();
ret = 1;
if (exec_flags & EXEC_FLAG_PRINT_EOF) {
mp_hal_stdout_tx_strn("\x04", 1);
}
} else {
// uncaught exception
// FIXME it could be that an interrupt happens just before we disable it here
mp_hal_set_interrupt_char(-1); // disable interrupt
// print EOF after normal output
if (exec_flags & EXEC_FLAG_PRINT_EOF) {
mp_hal_stdout_tx_strn("\x04", 1);
}
// check for SystemExit
if (mp_obj_is_subclass_fast(mp_obj_get_type((mp_obj_t)nlr.ret_val), &mp_type_SystemExit)) {
// at the moment, the value of SystemExit is unused
ret = pyexec_system_exit;
} else {
mp_obj_print_exception(&mp_plat_print, (mp_obj_t)nlr.ret_val);
ret = 0;
}
}
// display debugging info if wanted
if ((exec_flags & EXEC_FLAG_ALLOW_DEBUGGING) && repl_display_debugging_info) {
mp_uint_t ticks = mp_hal_ticks_ms() - start; // TODO implement a function that does this properly
printf("took " UINT_FMT " ms\n", ticks);
// qstr info
{
size_t n_pool, n_qstr, n_str_data_bytes, n_total_bytes;
qstr_pool_info(&n_pool, &n_qstr, &n_str_data_bytes, &n_total_bytes);
printf("qstr:\n n_pool=" UINT_FMT "\n n_qstr=" UINT_FMT "\n "
"n_str_data_bytes=" UINT_FMT "\n n_total_bytes=" UINT_FMT "\n",
(unsigned)n_pool, (unsigned)n_qstr, (unsigned)n_str_data_bytes, (unsigned)n_total_bytes);
}
#if MICROPY_ENABLE_GC
// run collection and print GC info
gc_collect();
gc_dump_info();
#endif
}
if (exec_flags & EXEC_FLAG_PRINT_EOF) {
mp_hal_stdout_tx_strn("\x04", 1);
}
return ret;
}
/* Here we don't know the size of the frame that overflowed. If the
frame is larger than the nursery then we will loop forever. This can
be fixed, but that large a frame (or small a nursery) is not realistic.
*/
static void stack_overflow( young_heap_t *heap )
{
gc_collect( heap->collector, 0, 0, GCTYPE_EVACUATE );
}
static void collect_if_no_room( young_heap_t *heap, int room )
{
room = roundup_balign( room );
if (free_space( heap ) < room)
gc_collect( heap->collector, 0, room, GCTYPE_EVACUATE );
}
void *gc_alloc(size_t n_bytes, bool has_finaliser) {
size_t n_blocks = ((n_bytes + BYTES_PER_BLOCK - 1) & (~(BYTES_PER_BLOCK - 1))) / BYTES_PER_BLOCK;
DEBUG_printf("gc_alloc(" UINT_FMT " bytes -> " UINT_FMT " blocks)\n", n_bytes, n_blocks);
// check if GC is locked
if (MP_STATE_MEM(gc_lock_depth) > 0) {
return NULL;
}
// check for 0 allocation
if (n_blocks == 0) {
return NULL;
}
size_t i;
size_t end_block;
size_t start_block;
size_t n_free = 0;
int collected = !MP_STATE_MEM(gc_auto_collect_enabled);
for (;;) {
// look for a run of n_blocks available blocks
for (i = MP_STATE_MEM(gc_last_free_atb_index); i < MP_STATE_MEM(gc_alloc_table_byte_len); i++) {
byte a = MP_STATE_MEM(gc_alloc_table_start)[i];
if (ATB_0_IS_FREE(a)) { if (++n_free >= n_blocks) { i = i * BLOCKS_PER_ATB + 0; goto found; } } else { n_free = 0; }
if (ATB_1_IS_FREE(a)) { if (++n_free >= n_blocks) { i = i * BLOCKS_PER_ATB + 1; goto found; } } else { n_free = 0; }
if (ATB_2_IS_FREE(a)) { if (++n_free >= n_blocks) { i = i * BLOCKS_PER_ATB + 2; goto found; } } else { n_free = 0; }
if (ATB_3_IS_FREE(a)) { if (++n_free >= n_blocks) { i = i * BLOCKS_PER_ATB + 3; goto found; } } else { n_free = 0; }
}
// nothing found!
if (collected) {
return NULL;
}
DEBUG_printf("gc_alloc(" UINT_FMT "): no free mem, triggering GC\n", n_bytes);
gc_collect();
collected = 1;
}
// found, ending at block i inclusive
found:
// get starting and end blocks, both inclusive
end_block = i;
start_block = i - n_free + 1;
// Set last free ATB index to block after last block we found, for start of
// next scan. To reduce fragmentation, we only do this if we were looking
// for a single free block, which guarantees that there are no free blocks
// before this one. Also, whenever we free or shink a block we must check
// if this index needs adjusting (see gc_realloc and gc_free).
if (n_free == 1) {
MP_STATE_MEM(gc_last_free_atb_index) = (i + 1) / BLOCKS_PER_ATB;
}
// mark first block as used head
ATB_FREE_TO_HEAD(start_block);
// mark rest of blocks as used tail
// TODO for a run of many blocks can make this more efficient
for (size_t bl = start_block + 1; bl <= end_block; bl++) {
ATB_FREE_TO_TAIL(bl);
}
// get pointer to first block
void *ret_ptr = (void*)(MP_STATE_MEM(gc_pool_start) + start_block * BYTES_PER_BLOCK);
DEBUG_printf("gc_alloc(%p)\n", ret_ptr);
// Zero out all the bytes of the newly allocated blocks.
// This is needed because the blocks may have previously held pointers
// to the heap and will not be set to something else if the caller
// doesn't actually use the entire block. As such they will continue
// to point to the heap and may prevent other blocks from being reclaimed.
memset((byte*)ret_ptr, 0, (end_block - start_block + 1) * BYTES_PER_BLOCK);
#if MICROPY_ENABLE_FINALISER
if (has_finaliser) {
// clear type pointer in case it is never set
((mp_obj_base_t*)ret_ptr)->type = NULL;
// set mp_obj flag only if it has a finaliser
FTB_SET(start_block);
}
#else
(void)has_finaliser;
#endif
#if EXTENSIVE_HEAP_PROFILING
gc_dump_alloc_table();
#endif
return ret_ptr;
}
void irom_close(void *stream_data) {
pb_context_t *ctx = (pb_context_t *)stream_data;
m_del_obj(pb_context_t, ctx);
gc_collect();
}
// TODO: this doesn't belong here
STATIC mp_obj_t pyb_gc(void) {
gc_collect();
return mp_const_none;
}
// parses, compiles and executes the code in the lexer
// frees the lexer before returning
// EXEC_FLAG_PRINT_EOF prints 2 EOF chars: 1 after normal output, 1 after exception output
// EXEC_FLAG_ALLOW_DEBUGGING allows debugging info to be printed after executing the code
// EXEC_FLAG_IS_REPL is used for REPL inputs (flag passed on to mp_compile)
STATIC int parse_compile_execute(mp_lexer_t *lex, mp_parse_input_kind_t input_kind, int exec_flags) {
int ret = 0;
mp_parse_error_kind_t parse_error_kind;
mp_parse_node_t pn = mp_parse(lex, input_kind, &parse_error_kind);
qstr source_name = mp_lexer_source_name(lex);
// check for parse error
if (pn == MP_PARSE_NODE_NULL) {
if (exec_flags & EXEC_FLAG_PRINT_EOF) {
stdout_tx_strn("\x04", 1);
}
mp_parse_show_exception(lex, parse_error_kind);
mp_lexer_free(lex);
goto finish;
}
mp_lexer_free(lex);
mp_obj_t module_fun = mp_compile(pn, source_name, MP_EMIT_OPT_NONE, exec_flags & EXEC_FLAG_IS_REPL);
// check for compile error
if (mp_obj_is_exception_instance(module_fun)) {
if (exec_flags & EXEC_FLAG_PRINT_EOF) {
stdout_tx_strn("\x04", 1);
}
mp_obj_print_exception(module_fun);
goto finish;
}
// execute code
nlr_buf_t nlr;
uint32_t start = HAL_GetTick();
if (nlr_push(&nlr) == 0) {
mp_hal_set_interrupt_char(CHAR_CTRL_C); // allow ctrl-C to interrupt us
mp_call_function_0(module_fun);
mp_hal_set_interrupt_char(-1); // disable interrupt
nlr_pop();
ret = 1;
if (exec_flags & EXEC_FLAG_PRINT_EOF) {
stdout_tx_strn("\x04", 1);
}
} else {
// uncaught exception
// FIXME it could be that an interrupt happens just before we disable it here
mp_hal_set_interrupt_char(-1); // disable interrupt
// print EOF after normal output
if (exec_flags & EXEC_FLAG_PRINT_EOF) {
stdout_tx_strn("\x04", 1);
}
// check for SystemExit
if (mp_obj_is_subclass_fast(mp_obj_get_type((mp_obj_t)nlr.ret_val), &mp_type_SystemExit)) {
// at the moment, the value of SystemExit is unused
ret = PYEXEC_FORCED_EXIT;
} else {
mp_obj_print_exception((mp_obj_t)nlr.ret_val);
ret = 0;
}
}
// display debugging info if wanted
if ((exec_flags & EXEC_FLAG_ALLOW_DEBUGGING) && repl_display_debugging_info) {
mp_uint_t ticks = HAL_GetTick() - start; // TODO implement a function that does this properly
printf("took " UINT_FMT " ms\n", ticks);
gc_collect();
// qstr info
{
mp_uint_t n_pool, n_qstr, n_str_data_bytes, n_total_bytes;
qstr_pool_info(&n_pool, &n_qstr, &n_str_data_bytes, &n_total_bytes);
printf("qstr:\n n_pool=" UINT_FMT "\n n_qstr=" UINT_FMT "\n n_str_data_bytes=" UINT_FMT "\n n_total_bytes=" UINT_FMT "\n", n_pool, n_qstr, n_str_data_bytes, n_total_bytes);
}
// GC info
{
gc_info_t info;
gc_info(&info);
printf("GC:\n");
printf(" " UINT_FMT " total\n", info.total);
printf(" " UINT_FMT " : " UINT_FMT "\n", info.used, info.free);
printf(" 1=" UINT_FMT " 2=" UINT_FMT " m=" UINT_FMT "\n", info.num_1block, info.num_2block, info.max_block);
}
}
finish:
if (exec_flags & EXEC_FLAG_PRINT_EOF) {
stdout_tx_strn("\x04", 1);
}
return ret;
}
sexpr_t* eval(sexpr_t* sexpr, sexpr_t** env, sexpr_list_t* roots, error_t** error)
{
if(sexpr == NULL) {
return interp.nil_sym;
}
/* printf("[eval]\n"); */
/* print_sexpr(sexpr); */
/* printf("\n"); */
roots = cons_to_roots_list(roots, sexpr);
gc_collect(roots);
if(ATOM(sexpr)) {
if(SYM(sexpr)) {
if(interp.t_sym == sexpr) {
return interp.t_sym;
}
if(interp.nil_sym == sexpr) {
return interp.nil_sym;
}
sexpr_t* val = assoc(sexpr, *env);
if(val == NULL) {
*error = mk_error("Undefined symbol", SYM_VAL(sexpr));
}
return val;
}
if(INT(sexpr)) {
return sexpr;
}
} else if(ATOM(CAR(sexpr))) {
if(SYM(CAR(sexpr))) {
// quote
if(interp.quote_sym == CAR(sexpr)) {
if(CDR(sexpr) == NULL) {
*error = mk_error("Missing quote argument", "");
return NULL;
}
if(CDR(CDR(sexpr)) != NULL) {
*error = mk_error("Too many arguments for quote", "");
return NULL;
}
return CAR(CDR(sexpr));
}
// atom
if(interp.atom_sym == CAR(sexpr)) {
if(ATOM(eval(CAR(CDR(sexpr)), env, roots, error))) {
return interp.t_sym;
}
return interp.nil_sym;
}
// eq
if(interp.eq_sym == CAR(sexpr)) {
// TODO check nb args
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
roots = cons_to_roots_list(roots, e1);
sexpr_t* e2 = eval(CAR(CDR(CDR(sexpr))), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(INT(e1) && INT(e2)) {
if(INT_VAL(e1) == INT_VAL(e2)) {
return interp.t_sym;
}
return interp.nil_sym;
}
if(e1 == e2) {
return interp.t_sym;
}
return interp.nil_sym;
}
// if
if(interp.if_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(e1 == interp.nil_sym) {
return eval(CAR(CDR(CDR(CDR(sexpr)))), env, roots, error);
} else {
return eval(CAR(CDR(CDR(sexpr))), env, roots, error);
}
}
// car
if(interp.car_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(e1 == interp.nil_sym) {
return interp.nil_sym;
}
return CAR(e1);
}
// cdr
if(interp.cdr_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(e1 == interp.nil_sym) {
return interp.nil_sym;
}
sexpr_t *res = CDR(e1);
if(res == NULL) {
return interp.nil_sym;
}
return res;
}
// +
if(interp.plus_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
roots = cons_to_roots_list(roots, e1);
sexpr_t* e2 = eval(CAR(CDR(CDR(sexpr))), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(INT(e1) && INT(e2)) {
return mk_int(INT_VAL(e1) + INT_VAL(e2));
}
*error = mk_error("Arguments for '+' are not integers", "");
return NULL;
}
// -
if(interp.minus_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
roots = cons_to_roots_list(roots, e1);
sexpr_t* e2 = eval(CAR(CDR(CDR(sexpr))), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(INT(e1) && INT(e2)) {
return mk_int(INT_VAL(e1) - INT_VAL(e2));
}
*error = mk_error("Arguments for '-' are not integers", "");
return NULL;
}
if(interp.mul_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
roots = cons_to_roots_list(roots, sexpr);
sexpr_t* e2 = eval(CAR(CDR(CDR(sexpr))), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(INT(e1) && INT(e2)) {
return mk_int(INT_VAL(e1) * INT_VAL(e2));
}
*error = mk_error("Arguments for '*' are not integers", "");
return NULL;
}
// cons
if(interp.cons_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
roots = cons_to_roots_list(roots, e1);
sexpr_t* e2 = eval(CAR(CDR(CDR(sexpr))), env, roots, error);
if(*error != NULL) {
return NULL;
}
return mk_cons(e1 == interp.nil_sym ? NULL : e1, e2 == interp.nil_sym ? NULL : e2);
}
// def
if(interp.def_sym == CAR(sexpr)) {
sexpr_t* arg = CAR(CDR(CDR(sexpr)));
roots = cons_to_roots_list(roots, arg);
sexpr_t* val = eval(arg, env, roots, error);
if(*error != NULL) {
return NULL;
}
*env = mk_cons(mk_cons(intern(SYM_VAL(CAR(CDR(sexpr)))), val), *env);
return val;
}
// print
if(interp.print_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
print_sexpr(e1);
printf("\n");
return e1;
}
// fn
if(interp.fn_sym == CAR(sexpr)) {
return mk_fn(sexpr, *env);
}
// macro
if(interp.macro_sym == CAR(sexpr)) {
return mk_macro(sexpr);
}
//eval
if(interp.eval_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
roots = cons_to_roots_list(roots, e1);
return eval(e1, env, roots, error);
}
// else resolves first variable
sexpr_t* fn = eval(CAR(sexpr), env, roots, error);
if(*error != NULL) {
return NULL;
}
// eval fn
if(FN(fn)) {
sexpr_t* fn_code = CAR(CDR(CDR(CAR(fn))));
sexpr_t* captured_env = CDR(fn);
sexpr_t* arguments = eval_list(CDR(sexpr), env, roots, error);
if(*error != NULL) {
return NULL;
}
sexpr_t* pairs = pair(CAR(CDR(CAR(fn))), arguments);
sexpr_t* eval_env = append(pairs, captured_env);
// append the function itself to the env, roots, for recursive calls
eval_env = mk_cons(mk_cons(CAR(sexpr), fn), eval_env);
/* printf("fn code=\n"); */
/* print_sexpr(fn_code); */
/* printf("\n"); */
roots = cons_to_roots_list(roots, eval_env);
return eval(fn_code, &eval_env, roots, error);
}
// eval macro
if(MACRO(fn)) {
sexpr_t* macro_code = CAR(CDR(CDR(CAR(fn))));
sexpr_t* pairs = pair(CAR(CDR(CAR(fn))), CDR(sexpr));
sexpr_t* eval_env = append(pairs, *env);
roots = cons_to_roots_list(roots, eval_env);
sexpr_t* transformed_code = eval(macro_code, &eval_env, roots, error);
if(*error != NULL) {
return NULL;
}
return eval(transformed_code, env, roots, error);
}
// else primitives
sexpr_t* arguments = eval_list(CDR(sexpr), env, roots, error);
if(*error != NULL) {
return NULL;
}
sexpr_t* to_eval = mk_cons(fn, arguments);
return eval(to_eval, env, roots, error);
}
} else if(CAR(CAR(sexpr)) == interp.fn_sym) {
// executes an anonymous function
sexpr_t* fn = CAR(sexpr);
sexpr_t* fn_code = CAR(CDR(CDR(fn)));
sexpr_t* arguments = eval_list(CDR(sexpr), env, roots, error);
if(*error != NULL) {
return NULL;
}
sexpr_t* l = pair(CAR(CDR(fn)), arguments);
l = append(l, *env);
roots = cons_to_roots_list(roots, l);
return eval(fn_code, &l, roots, error);
}
print_sexpr(sexpr);
printf("\n");
*error = mk_error("Invalid expression", "");
return NULL;
}
void _System_fullGC(pVMObject object, pVMFrame frame) {
SEND(frame, pop);
gc_collect();
SEND(frame, push, true_object);
}