Index: s7.c =================================================================== --- s7.c (revision 804) +++ s7.c (working copy) @@ -1503,12 +1503,23 @@ sc->block_lists[BLOCK_LIST] = p; } +static void **permanant_alloc_blocks; +static int permanant_alloc_k=0; + +static void *permanant_alloc(size_t len) { + const int k = permanant_alloc_k; + permanant_alloc_k += 1; + permanant_alloc_blocks = Realloc(permanant_alloc_blocks, sizeof(void *) * permanant_alloc_k); + permanant_alloc_blocks[k] = Malloc(len); + return permanant_alloc_blocks[k]; +} + static void fill_block_list(s7_scheme *sc) { int32_t i; block_t *b; #define BLOCK_MALLOC_SIZE 256 - b = (block_t *)Malloc(BLOCK_MALLOC_SIZE * sizeof(block_t)); /* batch alloc means blocks in this batch can't be freed, only returned to the list */ + b = (block_t *)permanant_alloc(BLOCK_MALLOC_SIZE * sizeof(block_t)); /* batch alloc means blocks in this batch can't be freed, only returned to the list */ sc->block_lists[BLOCK_LIST] = b; for (i = 0; i < BLOCK_MALLOC_SIZE - 1; i++) { @@ -1541,9 +1552,9 @@ if (next_k > ALLOC_STRING_SIZE) { if (len >= ALLOC_MAX_STRING) - return((char *)Malloc(len)); + return((char *)permanant_alloc(len)); /* this needs to be coordinated with mallocate so we can free this memory later, ALLOC_STRING_SIZE < 1<alloc_string_cells = (char *)Malloc(ALLOC_STRING_SIZE); /* get a new block */ + sc->alloc_string_cells = (char *)permanant_alloc(ALLOC_STRING_SIZE); /* get a new block */ sc->alloc_string_k = 0; next_k = len; } @@ -3510,7 +3521,8 @@ static s7_pointer make_permanent_integer_unchecked(s7_int i) { s7_pointer p; - p = (s7_pointer)Calloc(1, sizeof(s7_cell)); + p = (s7_pointer)permanant_alloc(sizeof(s7_cell)); + memset(p, 0, sizeof(s7_cell)); set_type_bit(p, T_IMMUTABLE | T_INTEGER | T_UNHEAP); integer(p) = i; return(p); @@ -3525,8 +3537,11 @@ #if (NUM_SMALL_INTS < NUM_CHARS) error /* g_char_to_integer assumes this is at least NUM_CHARS */ #endif #endif -static s7_pointer *small_ints = NULL; +static s7_pointer *small_ints; +static s7_cell *small_int_cells; +static s7_cell *extra_number_cells; + #if S7_DEBUGGING #define small_int(N) small_int_1(N, __func__, __LINE__) static s7_pointer small_int_1(s7_int n, const char *func, int line) @@ -3550,14 +3565,13 @@ static void init_small_ints(void) { const char *ones[10] = {"0", "1", "2", "3", "4", "5", "6", "7", "8", "9"}; - s7_cell *cells; int32_t i; small_ints = (s7_pointer *)malloc(NUM_SMALL_INTS * sizeof(s7_pointer)); - cells = (s7_cell *)calloc((NUM_SMALL_INTS), sizeof(s7_cell)); + small_int_cells = (s7_cell *)calloc((NUM_SMALL_INTS), sizeof(s7_cell)); for (i = 0; i < NUM_SMALL_INTS; i++) { s7_pointer p; - small_ints[i] = &cells[i]; + small_ints[i] = &small_int_cells[i]; p = small_ints[i]; set_type_bit(p, T_IMMUTABLE | T_INTEGER | T_UNHEAP); integer(p) = i; @@ -3567,25 +3581,25 @@ /* setup a few other numbers while we're here */ #define EXTRA_NUMBERS 10 - cells = (s7_cell *)calloc(EXTRA_NUMBERS, sizeof(s7_cell)); + extra_number_cells = (s7_cell *)calloc(EXTRA_NUMBERS, sizeof(s7_cell)); #define init_real(Ptr, Num, Name, Name_Len) \ do {set_type(Ptr, T_REAL | T_IMMUTABLE | T_UNHEAP); set_real(Ptr, Num); if (Name) set_number_name(Ptr, Name, Name_Len);} while (0) - real_zero = &cells[0]; init_real(real_zero, 0.0, "0.0", 3); - real_one = &cells[1]; init_real(real_one, 1.0, "1.0", 3); - real_NaN = &cells[2]; init_real(real_NaN, NAN, "+nan.0", 6); - real_infinity = &cells[3]; init_real(real_infinity, INFINITY, "+inf.0", 6); - real_minus_infinity = &cells[4]; init_real(real_minus_infinity, -INFINITY, "-inf.0", 6); - real_pi = &cells[5]; init_real(real_pi, 3.1415926535897932384626433832795029L, NULL, 0); + real_zero = &extra_number_cells[0]; init_real(real_zero, 0.0, "0.0", 3); + real_one = &extra_number_cells[1]; init_real(real_one, 1.0, "1.0", 3); + real_NaN = &extra_number_cells[2]; init_real(real_NaN, NAN, "+nan.0", 6); + real_infinity = &extra_number_cells[3]; init_real(real_infinity, INFINITY, "+inf.0", 6); + real_minus_infinity = &extra_number_cells[4]; init_real(real_minus_infinity, -INFINITY, "-inf.0", 6); + real_pi = &extra_number_cells[5]; init_real(real_pi, 3.1415926535897932384626433832795029L, NULL, 0); #define init_integer(Ptr, Num, Name, Name_Len) \ do {set_type(Ptr, T_INTEGER | T_IMMUTABLE | T_UNHEAP); set_integer(Ptr, Num); if (Name) set_number_name(Ptr, Name, Name_Len);} while (0) - arity_not_set = &cells[6]; init_integer(arity_not_set, CLOSURE_ARITY_NOT_SET, NULL, 0); - max_arity = &cells[7]; init_integer(max_arity, MAX_ARITY, NULL, 0); - minus_one = &cells[8]; init_integer(minus_one, -1, "-1", 2); - minus_two = &cells[9]; init_integer(minus_two, -2, "-2", 2); + arity_not_set = &extra_number_cells[6]; init_integer(arity_not_set, CLOSURE_ARITY_NOT_SET, NULL, 0); + max_arity = &extra_number_cells[7]; init_integer(max_arity, MAX_ARITY, NULL, 0); + minus_one = &extra_number_cells[8]; init_integer(minus_one, -1, "-1", 2); + minus_two = &extra_number_cells[9]; init_integer(minus_two, -2, "-2", 2); small_zero = small_ints[0]; small_one = small_ints[1]; small_two = small_ints[2]; @@ -3762,7 +3776,7 @@ fprintf(stderr, "%s[%d]: len: %" print_s7_int ", str: %s\n", __func__, __LINE__, len, str); #endif if (len > (1LL << 48)) return(NULL); /* squelch an idiotic warning */ - newstr = (char *)Malloc(len + 1); + newstr = (char *)permanant_alloc(len + 1); if (len != 0) memcpy((void *)newstr, (void *)str, len); newstr[len] = '\0'; @@ -6275,7 +6289,8 @@ if (sc->alloc_pointer_k == ALLOC_POINTER_SIZE) /* if either no current block or the block is used up, make a new block */ { sc->permanent_cells += ALLOC_POINTER_SIZE; - sc->alloc_pointer_cells = (s7_cell *)Calloc(ALLOC_POINTER_SIZE, sizeof(s7_cell)); + sc->alloc_pointer_cells = (s7_cell *)permanant_alloc(ALLOC_POINTER_SIZE * sizeof(s7_cell)); + memset(sc->alloc_pointer_cells, 0, ALLOC_POINTER_SIZE * sizeof(s7_cell)); sc->alloc_pointer_k = 0; } return(&(sc->alloc_pointer_cells[sc->alloc_pointer_k++])); @@ -6288,7 +6303,8 @@ if (sc->alloc_big_pointer_k == ALLOC_BIG_POINTER_SIZE) { sc->permanent_cells += ALLOC_BIG_POINTER_SIZE; - sc->alloc_big_pointer_cells = (s7_big_cell *)Calloc(ALLOC_BIG_POINTER_SIZE, sizeof(s7_big_cell)); + sc->alloc_big_pointer_cells = (s7_big_cell *)permanant_alloc(ALLOC_BIG_POINTER_SIZE * sizeof(s7_big_cell)); + memset(sc->alloc_big_pointer_cells, 0, ALLOC_BIG_POINTER_SIZE * sizeof(s7_big_cell)); sc->alloc_big_pointer_k = 0; } p = (&(sc->alloc_big_pointer_cells[sc->alloc_big_pointer_k++])); @@ -6789,7 +6805,7 @@ if (sc->alloc_symbol_k == ALLOC_SYMBOL_SIZE) { - sc->alloc_symbol_cells = (uint8_t *)Malloc(ALLOC_SYMBOL_SIZE); + sc->alloc_symbol_cells = (uint8_t *)permanant_alloc(ALLOC_SYMBOL_SIZE); sc->alloc_symbol_k = 0; } result = &(sc->alloc_symbol_cells[sc->alloc_symbol_k]); @@ -25260,8 +25276,9 @@ s7_cell *cells; int32_t i; - chars = (s7_pointer *)malloc((NUM_CHARS + 1) * sizeof(s7_pointer)); /* chars is declared far above */ - cells = (s7_cell *)calloc(NUM_CHARS + 1, sizeof(s7_cell)); + chars = (s7_pointer *)permanant_alloc((NUM_CHARS + 1) * sizeof(s7_pointer)); /* chars is declared far above */ + cells = (s7_cell *)permanant_alloc((NUM_CHARS + 1) * sizeof(s7_cell)); + memset(cells, 0, (NUM_CHARS + 1) * sizeof(s7_cell)); chars[0] = &cells[0]; eof_object = chars[0]; @@ -26153,7 +26170,8 @@ s7_pointer x; s7_int len; - x = (s7_pointer)calloc(1, sizeof(s7_cell)); + x = (s7_pointer)permanant_alloc(sizeof(s7_cell)); + memset(x, 0, sizeof(s7_cell)); set_type(x, T_STRING | T_IMMUTABLE | T_UNHEAP); len = safe_strlen(str); string_length(x) = len; @@ -46495,7 +46513,7 @@ #define ALLOC_FUNCTION_SIZE 128 if (sc->alloc_function_k == ALLOC_FUNCTION_SIZE) { - sc->alloc_function_cells = (c_proc_t *)malloc(ALLOC_FUNCTION_SIZE * sizeof(c_proc_t)); + sc->alloc_function_cells = (c_proc_t *)permanant_alloc(ALLOC_FUNCTION_SIZE * sizeof(c_proc_t)); sc->alloc_function_k = 0; } return(&(sc->alloc_function_cells[sc->alloc_function_k++])); @@ -47746,7 +47764,7 @@ if (!name) return(sc->F); len = 16 + safe_strlen(name); - internal_set_name = (char *)Malloc(len); + internal_set_name = (char *)permanant_alloc(len); internal_set_name[0] = '\0'; catstrs_direct(internal_set_name, "[set-", name, "]", NULL); @@ -60818,7 +60836,7 @@ { if (sc->alloc_opt_func_k == ALLOC_FUNCTION_SIZE) { - sc->alloc_opt_func_cells = (opt_funcs *)malloc(ALLOC_FUNCTION_SIZE * sizeof(opt_funcs)); + sc->alloc_opt_func_cells = (opt_funcs *)permanant_alloc(ALLOC_FUNCTION_SIZE * sizeof(opt_funcs)); sc->alloc_opt_func_k = 0; } return(&(sc->alloc_opt_func_cells[sc->alloc_opt_func_k++])); @@ -98075,7 +98093,7 @@ sc->previous_free_heap_top = sc->free_heap_top; { s7_cell *cells; - cells = (s7_cell *)calloc(INITIAL_HEAP_SIZE, sizeof(s7_cell)); /* calloc to make sure type=0 at start? (for gc/valgrind) */ + cells = (s7_cell *)permanant_alloc(INITIAL_HEAP_SIZE * sizeof(s7_cell)); /* calloc to make sure type=0 at start? (for gc/valgrind) */ for (i = 0; i < INITIAL_HEAP_SIZE; i++) /* LOOP_4 here is slower! */ { sc->heap[i] = &cells[i]; @@ -98457,7 +98475,124 @@ return(sc); } +void s7_cleanup(s7_scheme *sc) { + free(sc->strings->list); + free(sc->strings); + free(sc->gensyms->list); + free(sc->gensyms); + free(sc->unknowns->list); + free(sc->unknowns); + free(sc->vectors->list); + free(sc->vectors); + free(sc->multivectors->list); + free(sc->multivectors); + free(sc->hash_tables->list); + free(sc->hash_tables); + free(sc->input_ports->list); + free(sc->input_ports); + free(sc->input_string_ports->list); + free(sc->input_string_ports); + free(sc->output_ports->list); + free(sc->output_ports); + free(sc->continuations->list); + free(sc->continuations); + free(sc->c_objects->list); + free(sc->c_objects); + free(sc->lambdas->list); + free(sc->lambdas); + free(sc->weak_refs->list); + free(sc->weak_refs); + free(sc->lamlets->list); + free(sc->lamlets); + free(sc->weak_hash_iterators->list); + free(sc->weak_hash_iterators); +#if WITH_GMP + free(sc->big_integers->list); + free(sc->big_integers); + free(sc->big_ratios->list); + free(sc->big_ratios); + free(sc->big_reals->list); + free(sc->big_reals); + free(sc->complexes->list); + free(sc->complexes); + free(sc->random_states->list); + free(sc->random_states); +#endif + free(sc->setters); + free(sc->singletons); + free(sc->strbuf); + free(sc->input_port_stack); + free(sc->heap); + free(sc->free_heap); + while (sc->heap_blocks != NULL) { + heap_block_t *t = sc->heap_blocks; + sc->heap_blocks = sc->heap_blocks->next; + free(t); + } + free(sc->gpofl); + free(sc->op_stack); + + free(vector_elements(sc->symbol_table)); + free(sc->symbol_table); + free(sc->circle_info->objs); + free(sc->circle_info->refs); + free(sc->circle_info->defined); + free(sc->circle_info); + + free(sc->integer_wrapper1); + free(sc->integer_wrapper2); + free(sc->integer_wrapper3); + free(sc->real_wrapper1); + free(sc->real_wrapper2); + free(sc->real_wrapper3); + free(sc->real_wrapper4); + + for (int i = 0; i < NUM_STRING_WRAPPERS; i++) { + free(sc->string_wrappers[i]); + } + free(sc->string_wrappers); + + free(sc->opts[0]); + + free(sc->tree_pointers); + + free(sc->unlet); + free(sc->file_names); + free(sc->fdats); + free(sc->unentry); + + free(port_port(sc->standard_output)); + free(port_port(sc->standard_error)); + free(port_port(sc->standard_input)); + free(sc); +} + +void s7_cleanup_global(void) { + int32_t i; + + for (i = 2; i < 17; i++) /* radix between 2 and 16 */ + free(pepow[i]); + free(pepow); + + free(exponent_table); + free(slashify_table); + free(char_ok_in_a_name); + white_space--; + free(white_space); + free(number_table); + free(symbol_slashify_table); + free(digits); + free(small_ints); + free(small_int_cells); + free(extra_number_cells); + + for (i = 0; i < permanant_alloc_k; i++) { + free(permanant_alloc_blocks[i]); + } + free(permanant_alloc_blocks); +} + /* -------------------------------- repl -------------------------------- */ #ifndef USE_SND Index: s7.h =================================================================== --- s7.h (revision 804) +++ s7.h (working copy) @@ -29,6 +29,8 @@ typedef struct s7_cell *s7_pointer; s7_scheme *s7_init(void); +void s7_cleanup(s7_scheme *); +void s7_cleanup_global(void); /* s7_scheme is our interpreter * s7_pointer is a Scheme object of any (Scheme) type