namespace Slime::Memory { // ------------------ // global symbol / keyword table // ------------------ Hash_Map global_symbol_table; Hash_Map global_keyword_table; Hash_Map file_to_env_map; // ------------------ // lisp_objects // ------------------ Bucket_Allocator object_memory; // ------------------ // environments // ------------------ Bucket_Allocator environment_memory; // NOTE(Felix): we are doing hashmaps separately so we don't have // to malloc them every time, and if two lisp objects have the // same hashmap, it will not cause double free problems when // freeing all at the end. It also plays nice with garbage // collection // ------------------ // Hashmaps // ------------------ Bucket_Allocator> hashmap_memory; // ------------------ // immutables // ------------------ Lisp_Object* nil = nullptr; Lisp_Object* t = nullptr; proc print_status() { // printf("Memory Status:\n" // " - %f%% of the object_memory is used\n" // " - %d of %d total Lisp_Objects are in use\n" // " - %d holes in used memory (fragmentation)\n", // (1.0*next_index_in_object_memory - free_spots_in_object_memory.next_index)/object_memory_size, // next_index_in_object_memory - free_spots_in_object_memory.next_index, object_memory_size, // free_spots_in_object_memory.next_index); // printf("Memory Status:\n" // " - %f%% of the string_memory is used\n" // " - %d holes in used memory (fragmentation)\n", // (1.0*(size_t)next_free_spot_in_string_memory - (size_t)string_memory)/string_memory_size, // free_spots_in_string_memory.next_index); } inline proc get_c_str(String str) -> char* { return str.data; } inline proc get_c_str(Lisp_Object* str) -> char* { assert_type(str, Lisp_Object_Type::String); return get_c_str(str->value.string); } proc hash(String str) -> u64 { // TODO(Felix): When parsing symbols or keywords, compute the // hash while reading them in. u64 value = str.data[0] << 7; for (u32 i = 1; i < str.length; ++i) { char c = str.data[i]; value = (1000003 * value) ^ c; } value ^= str.length; return value; } proc create_string(const char* str, u32 len) -> String { String s = { len, (char*)malloc(sizeof(char) * len + 1) }; strcpy(s.data, str); return s; } proc create_string (const char* str) -> String { return create_string(str, (u32)strlen(str)); } proc duplicate_string(String str) -> String { return create_string(str.data, str.length); } proc create_lisp_object() -> Lisp_Object* { Lisp_Object* object = object_memory.allocate(); object->type = Lisp_Object_Type::Invalid_Under_Construction; return object; } proc free_everything() -> void { object_memory.for_each([](Lisp_Object* lo){ switch (lo->type) { case Lisp_Object_Type::Function: { lo->value.function->args.positional.symbols.dealloc(); lo->value.function->args.keyword.keywords.dealloc(); lo->value.function->args.keyword.values.dealloc(); free(lo->value.function); } break; case Lisp_Object_Type::Symbol: case Lisp_Object_Type::Keyword: case Lisp_Object_Type::String: { free(lo->value.string.data); } break; default: break; } }); environment_memory.for_each([](Environment* env){ env->parents.dealloc(); env->hm.dealloc(); }); hashmap_memory.for_each([](Hash_Map* hm){ hm->dealloc(); }); for_hash_map(Globals::docs) { free(value); } // free paths in load path for (u32 i = 0; i < Globals::load_path.next_index; ++i) { free(Globals::load_path.data[i]); } Globals::load_path.dealloc(); Globals::user_types.dealloc(); Globals::docs.dealloc(); Globals::Current_Execution.envi_stack.dealloc(); Globals::Current_Execution.cs.dealloc(); Globals::Current_Execution.ams.dealloc(); Globals::Current_Execution.pcs.dealloc(); Globals::Current_Execution.nass.dealloc(); Globals::Current_Execution.ats.dealloc(); Globals::Current_Execution.mes.dealloc(); free(Parser::standard_in.data); object_memory.dealloc(); environment_memory.dealloc(); hashmap_memory.dealloc(); global_symbol_table.dealloc(); global_keyword_table.dealloc(); file_to_env_map.dealloc(); } proc create_child_environment(Environment* parent) -> Environment* { Environment* env = environment_memory.allocate(); // inject a new array list; env->parents.alloc(); env->hm.alloc(); if (parent) env->parents.append(parent); new(&env->hm) Hash_Map; return env; } proc create_empty_environment() -> Environment* { Environment* ret; try ret = create_child_environment(nullptr); return ret; } inline proc load_pre() -> void { String file_name = Memory::create_string("pre.slime"); defer_free(file_name.data); try_void built_in_load(file_name); } inline proc push_user_environment() -> void { // NOTE(Felix): We create a user environment, so when the user // imports stuff, they don't import in the root env, because // that leads to a parent-cycle Environment* env; try_void env = create_child_environment(get_current_environment()); push_environment(env); } proc init() -> void { profile_this(); object_memory.alloc(1024, 8); environment_memory.alloc(1024, 8); hashmap_memory.alloc(256, 8); path_char* exe_path = get_exe_dir(); global_symbol_table.alloc(); global_keyword_table.alloc(); file_to_env_map.alloc(); Globals::Current_Execution.envi_stack.alloc(); Globals::Current_Execution.cs.alloc(); Globals::Current_Execution.nass.alloc(); Globals::Current_Execution.pcs.alloc(); Globals::Current_Execution.ams.alloc(); Globals::Current_Execution.ats.alloc(); Globals::Current_Execution.mes.alloc(); Globals::docs.alloc(); Globals::user_types.alloc(); Globals::load_path.alloc(); add_to_load_path(exe_path); add_to_load_path((path_char*)char_to_path_char("../bin/")); // init nil try_void nil = create_lisp_object(); nil->type = Lisp_Object_Type::Nil; // init t try_void t = create_lisp_object(); t->type = Lisp_Object_Type::T; try_void Parser::standard_in = create_string("stdin"); Globals::Current_Execution.envi_stack.next_index = 0; Environment* env; try_void env = create_built_ins_environment(); push_environment(env); } proc create_lisp_object(void* ptr) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Pointer; node->value.pointer = ptr; return node; } proc create_lisp_object_hash_map() -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::HashMap; node->value.hashMap = hashmap_memory.allocate(); node->value.hashMap->alloc(); return node; } proc create_lisp_object(f64 number) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Number; node->value.number = number; return node; } proc create_lisp_object(String str) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::String; node->value.string = str; return node; } proc create_lisp_object(const char* str) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::String; node->value.string = create_string(str); return node; } proc create_lisp_object_continuation() -> Lisp_Object* { using Globals::Current_Execution; Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Continuation; node->value.continuation = (Continuation*)malloc(sizeof(Continuation)); node->value.continuation->cs = Current_Execution.cs.clone(); node->value.continuation->pcs = Current_Execution.pcs.clone(); node->value.continuation->ams = Current_Execution.ams.clone(); node->value.continuation->ats = Current_Execution.ats.clone(); node->value.continuation->mes = Current_Execution.mes.clone(); node->value.continuation->envi_stack = Current_Execution.envi_stack.clone(); node->value.continuation->nass = Current_Execution.nass.clone(); for (u32 i = 0; i < node->value.continuation->nass.next_index; ++i) { node->value.continuation->nass.data[i] = node->value.continuation->nass.data[i].clone(); } return node; } proc allocate_vector(u32 size) -> Lisp_Object* { Lisp_Object* ret = object_memory.allocate(size); if (!ret) { create_out_of_memory_error("The vector is too big to fit in a memory bucket."); return nullptr; } return ret; } proc create_lisp_object_vector(u32 length, Lisp_Object* element_list) -> Lisp_Object* { try assert_type(element_list, Lisp_Object_Type::Pair); Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Vector; node->value.vector.length = length; try node->value.vector.data = allocate_vector(length); Lisp_Object* head = element_list; u32 i = 0; while (head != Memory::nil) { node->value.vector.data[i] = *head->value.pair.first; head = head->value.pair.rest; ++i; } return node; } proc create_lisp_object_vector(Lisp_Object* e1) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Vector; node->value.vector.length = 1; try node->value.vector.data = allocate_vector(1); node->value.vector.data[0] = *e1; return node; } proc create_lisp_object_vector(Lisp_Object* e1, Lisp_Object* e2) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Vector; node->value.vector.length = 2; try node->value.vector.data = allocate_vector(2); node->value.vector.data[0] = *e1; node->value.vector.data[1] = *e2; return node; } proc create_lisp_object_vector(Lisp_Object* e1, Lisp_Object* e2, Lisp_Object* e3) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Vector; node->value.vector.length = 3; try node->value.vector.data = allocate_vector(3); node->value.vector.data[0] = *e1; node->value.vector.data[1] = *e2; node->value.vector.data[2] = *e3; return node; } inline proc _create_symbol(char* identifier) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Symbol; node->value.symbol = create_string(identifier); global_symbol_table.set_object((char*)node->value.symbol.data, node); return node; } inline proc get_symbol(String identifier) -> Lisp_Object* { return get_symbol(identifier.data); } inline proc get_symbol(const char* identifier) -> Lisp_Object* { if (Lisp_Object* ret = global_symbol_table.get_object((char*)identifier)) return (Lisp_Object*)ret; return _create_symbol((char*)identifier); } inline proc _create_keyword(char* identifier) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Keyword; node->value.symbol = create_string(identifier); global_keyword_table.set_object((char*)node->value.symbol.data, node); return node; } inline proc get_keyword(String identifier) -> Lisp_Object* { return get_keyword(identifier.data); } inline proc get_keyword(const char* identifier) -> Lisp_Object* { if (Lisp_Object* ret = global_keyword_table.get_object((char*)identifier)) return ret; return _create_keyword((char*)identifier); } proc create_lisp_object_cfunction(C_Function_Type type) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Function; node->value.function = (Function*)malloc(sizeof(Function)); node->value.function->type.c_function_type = type; node->value.function->args.keyword.keywords.alloc(); node->value.function->args.keyword.values.alloc(); node->value.function->args.positional.symbols.alloc(); node->value.function->is_c = true; return node; } proc create_lisp_object_function(Lisp_Function_Type ft) -> Lisp_Object* { Lisp_Object* func; try func = Memory::create_lisp_object(); func->type = Lisp_Object_Type::Function; func->value.function = (Function*)malloc(sizeof(Function)); func->value.function->args.keyword.keywords.alloc(); func->value.function->args.keyword.values.alloc(); func->value.function->args.positional.symbols.alloc(); func->value.function->type.lisp_function_type = ft; func->value.function->is_c = false; return func; } proc create_lisp_object_pair(Lisp_Object* first, Lisp_Object* rest) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Pair; node->value.pair.first = first; node->value.pair.rest = rest; return node; } proc copy_lisp_object(Lisp_Object* n) -> Lisp_Object* { // QUESTION(Felix): If argument is a list (cons), should we do // a full copy? // we don't copy singleton objects if (n == Memory::nil || n == Memory::t) { return n; } else { Lisp_Object_Type type = n->type; if (type == Lisp_Object_Type::Symbol || type == Lisp_Object_Type::Keyword || type == Lisp_Object_Type::Function) { return n; } else if (type == Lisp_Object_Type::String) { Lisp_Object* target; try target = create_lisp_object(); *target = *n; target->value.string = create_string(target->value.string.data); return target; } else { Lisp_Object* target; try target = create_lisp_object(); *target = *n; return target; } } } proc copy_lisp_object_except_pairs(Lisp_Object* n) -> Lisp_Object* { if (n->type == Lisp_Object_Type::Pair) return n; return copy_lisp_object(n); } proc create_built_ins_environment() -> Environment* { Environment* ret; try ret = create_empty_environment(); push_environment(ret); defer { pop_environment(); }; try load_built_ins_into_environment(); return ret; } inline proc create_list(Lisp_Object* o1) -> Lisp_Object* { Lisp_Object* ret; try ret = create_lisp_object_pair(o1, nil); return ret; } inline proc create_list(Lisp_Object* o1, Lisp_Object* o2) -> Lisp_Object* { Lisp_Object* ret; try ret = create_lisp_object_pair(o1, create_list(o2)); return ret; } inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3) -> Lisp_Object* { Lisp_Object* ret; try ret = create_lisp_object_pair(o1, create_list(o2, o3)); return ret; } inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3, Lisp_Object* o4) -> Lisp_Object* { Lisp_Object* ret; try ret = create_lisp_object_pair(o1, create_list(o2, o3, o4)); return ret; } inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3, Lisp_Object* o4, Lisp_Object* o5) -> Lisp_Object* { Lisp_Object* ret; try ret = create_lisp_object_pair(o1, create_list(o2, o3, o4, o5)); return ret; } inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3, Lisp_Object* o4, Lisp_Object* o5, Lisp_Object* o6) -> Lisp_Object* { Lisp_Object* ret; try ret = create_lisp_object_pair(o1, create_list(o2, o3, o4, o5, o6)); return ret; } }