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(1024, 8); // ------------------ // environments // ------------------ Bucket_Allocator environment_memory(1024, 8); // ------------------ // strings // ------------------ int string_memory_size; // = 4096 * 1024; // == 98304kb == 96mb // free_spots_in_string_memory is an arraylist of pointers into // the string_memory, where dead String objects live (which give // information about their size) Array_List free_spots_in_string_memory; String* string_memory; String* next_free_spot_in_string_memory; // ------------------ // immutables // ------------------ Lisp_Object* nil = nullptr; Lisp_Object* t = nullptr; Lisp_Object* _if = nullptr; Lisp_Object* _define = nullptr; Lisp_Object* _begin = 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); } inline proc get_type(Lisp_Object* node) -> Lisp_Object_Type { // the type is in the bits 0 to 5 (including) return (Lisp_Object_Type) ((u64)node->flags & (u64)0b11111); } inline proc set_type(Lisp_Object* node, Lisp_Object_Type type) { // the type is in the bits 0 to 5 (including) u64 bitmask = (u64)-1; bitmask -= 0b11111; bitmask += (u64) type; node->flags = (u64)(node->flags) | bitmask; } proc hash(String* str) -> u64 { // TODO(Felix): When parsing symbols or keywords, compute the // hash while reading them in. u64 value = str->data << 7; for (int i = 1; i < str->length; ++i) { char c = ((char*)&str->data)[i]; value = (1000003 * value) ^ c; } value ^= str->length; return value; } proc create_string(const char* str, int len) -> String* { // TODO(Felix): check the holes first, not just always append // at the end String* ret = next_free_spot_in_string_memory; ret->length = len; strcpy(&ret->data, str); // now update the next_free_spot_in_string_memory pointer: // overstrep the counter and the first char (thik of it as if // we were overstepping the last ('\0') char) and then we only // need to overstep 'len' more chars next_free_spot_in_string_memory += 1; // overstep the other chars next_free_spot_in_string_memory = ((String*)((char*)next_free_spot_in_string_memory)+len); return ret; } proc delete_string(String* str) { free_spots_in_string_memory.append((void*)str); } proc duplicate_string(String* str) -> String* { return create_string(get_c_str(str), str->length); } proc create_string (const char* str) -> String* { return create_string(str, (int)strlen(str)); } proc create_lisp_object() -> Lisp_Object* { Lisp_Object* object = object_memory.allocate(); object->flags = 0; object->sourceCodeLocation = nullptr; object->userType = nullptr; object->docstring = nullptr; return object; } proc free_everything() -> void { free(string_memory); object_memory.for_each([](Lisp_Object* lo){ lo->~Lisp_Object(); }); environment_memory.for_each([](Environment* env){ env->parents.dealloc(); env->~Environment(); }); // free the exe dir: free(Globals::load_path.data[0]); Globals::load_path.dealloc(); // Globals::Current_Execution::call_stack.dealloc(); Globals::Current_Execution::envi_stack.dealloc(); Globals::Current_Execution::cs.dealloc(); Globals::Current_Execution::ams.dealloc(); Globals::Current_Execution::pcs.dealloc(); } proc create_child_environment(Environment* parent) -> Environment* { Environment* env = environment_memory.allocate(); // inject a new array list; env->parents.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; } proc init(int sms) -> void { profile_this(); char* exe_path = get_exe_dir(); // don't free exe path because it will be used until end of time Globals::load_path.alloc(); // Globals::Current_Execution::call_stack.alloc(); Globals::Current_Execution::envi_stack.alloc(); Globals::Current_Execution::cs.alloc(); Globals::Current_Execution::pcs.alloc(); Globals::Current_Execution::ams.alloc(); add_to_load_path(exe_path); add_to_load_path("../bin/"); string_memory_size = sms; string_memory = (String*)malloc(string_memory_size * sizeof(char)); next_free_spot_in_string_memory = string_memory; // init nil try_void nil = create_lisp_object(); set_type(nil, Lisp_Object_Type::Nil); // init t try_void t = create_lisp_object(); set_type(t, 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); Environment* user_env; try_void user_env = Memory::create_child_environment(env); push_environment(user_env); try_void _if = lookup_symbol(get_symbol("if"), env); try_void _define = lookup_symbol(get_symbol("define"), env); try_void _begin = lookup_symbol(get_symbol("begin"), env); } proc reset() -> void { profile_this(); free_spots_in_string_memory.next_index = 0; global_symbol_table.~Hash_Map(); global_keyword_table.~Hash_Map(); file_to_env_map.~Hash_Map(); new(&global_symbol_table) Hash_Map; new(&global_keyword_table) Hash_Map; new(&file_to_env_map) Hash_Map; try_void Parser::standard_in = create_string("stdin"); object_memory.for_each([](Lisp_Object* lo){ lo->~Lisp_Object(); }); environment_memory.for_each([](Environment* env){ env->~Environment(); }); object_memory.~Bucket_Allocator(); environment_memory.~Bucket_Allocator(); new(&object_memory) Bucket_Allocator(1024, 8); new(&environment_memory) Bucket_Allocator(1024, 8); next_free_spot_in_string_memory = string_memory; // init nil try_void nil = create_lisp_object(); set_type(nil, Lisp_Object_Type::Nil); // init t try_void t = create_lisp_object(); set_type(t, Lisp_Object_Type::T); Globals::Current_Execution::envi_stack.next_index = 0; Environment* env; try_void env = create_built_ins_environment(); push_environment(env); Environment* user_env; try_void user_env = Memory::create_child_environment(env); push_environment(user_env); try_void _if = lookup_symbol(get_symbol("if"), env); try_void _define = lookup_symbol(get_symbol("define"), env); try_void _begin = lookup_symbol(get_symbol("begin"), env); } proc create_lisp_object(void* ptr) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); set_type(node, 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(); set_type(node, Lisp_Object_Type::HashMap); node->value.hashMap = new Hash_Map; return node; } proc create_lisp_object(double number) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); set_type(node, 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(); set_type(node, 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(); set_type(node, Lisp_Object_Type::String); node->value.string = create_string(str); return node; } proc allocate_vector(int 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(int length, Lisp_Object* element_list) -> Lisp_Object* { try assert_type(element_list, Lisp_Object_Type::Pair); Lisp_Object* node; try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Vector); node->value.vector.length = length; try node->value.vector.data = allocate_vector(length); Lisp_Object* head = element_list; int 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(); set_type(node, 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(); set_type(node, 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(); set_type(node, 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; } proc get_symbol(String* identifier) -> Lisp_Object* { Lisp_Object* node = global_symbol_table.get_object(get_c_str(identifier)); if (node) return (Lisp_Object*)node; try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Symbol); node->value.symbol = identifier; global_symbol_table.set_object(get_c_str(identifier), node); return node; } proc get_symbol(const char* identifier) -> Lisp_Object* { if (auto ret = global_symbol_table.get_object((char*)identifier)) return (Lisp_Object*)ret; else { String* str; try str = Memory::create_string(identifier); return get_symbol(str); } } proc get_keyword(String* keyword) -> Lisp_Object* { Lisp_Object* node = global_keyword_table.get_object(get_c_str(keyword)); if (node) return (Lisp_Object*)node; try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Keyword); node->value.symbol = keyword; global_keyword_table.set_object(get_c_str(keyword), node); return node; } proc get_keyword(const char* keyword) -> Lisp_Object* { if (auto ret = global_keyword_table.get_object((char*)keyword)) return (Lisp_Object*)ret; else { String* str; try str = Memory::create_string(keyword); return get_keyword(str); } } proc create_lisp_object_cfunction(C_Function_Type type) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); set_type(node, 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(); Memory::set_type(func, 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(); set_type(node, Lisp_Object_Type::Pair); // node->value.pair = new(Pair); node->value.pair.first = first; node->value.pair.rest = rest; return node; } proc copy_lisp_object(Lisp_Object* n) -> Lisp_Object* { // TODO(Felix): If argument is a list (pair), do a FULL copy, // we don't copy singleton objects if (n == Memory::nil || n == Memory::t || Memory::get_type(n) == Lisp_Object_Type::Symbol || Memory::get_type(n) == Lisp_Object_Type::Keyword || Memory::get_type(n) == Lisp_Object_Type::Function) { return n; } Lisp_Object* target; try target = create_lisp_object(); *target = *n; return target; } proc copy_lisp_object_except_pairs(Lisp_Object* n) -> Lisp_Object* { if (get_type(n) == 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(); try built_in_load(Memory::create_string("pre.slime")); 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; } }