namespace Memory { // ------------------ // global symbol / keyword table // ------------------ String_Hash_Map* global_symbol_table; String_Hash_Map* global_keyword_table; // ------------------ // lisp_objects // ------------------ int object_memory_size; Int_Array_List free_spots_in_object_memory; Lisp_Object* object_memory; int next_index_in_object_memory = 0; // ------------------ // environments // ------------------ int environment_memory_size; Environment_Array_List free_spots_in_environment_memory; Environment* environment_memory; int next_index_in_environment_memory = 0; // ------------------ // 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) Void_Ptr_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; 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) { append_to_array_list(&free_spots_in_string_memory, (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_string_formatted (const char* format, ...) -> String* { // // HACK(Felix): the length of all strings is 200!!!!!!!!!! // // HACK(Felix): the length of all strings is 200!!!!!!!!!! // int length = 200; // String* ret = create_string("", length); // int written_length; // va_list args; // va_start(args, format); // written_length = vsnprintf(&ret->data, length, format, args); // va_end(args); // ret->length = written_length; // return ret; // } proc create_lisp_object() -> Lisp_Object* { int index; // if we have no free spots then append at the end if (free_spots_in_object_memory.next_index == 0) { // if we still have space if (object_memory_size == next_index_in_object_memory) { create_out_of_memory_error( "There is not enough space in the lisp object " "memory to allocate additional lisp objects. " "Maybe try increasing the Memory size when " "calling Memory::init()"); return nullptr; } index = next_index_in_object_memory++; } else { // else fill a free spot, and remove the free spot index = free_spots_in_object_memory.data[free_spots_in_object_memory.next_index--]; } Lisp_Object* object = object_memory+index; object->flags = 0; object->sourceCodeLocation = nullptr; object->userType = nullptr; object->docstring = nullptr; return object; } proc free_everything() { free(global_symbol_table); free(global_keyword_table); free(object_memory); free(environment_memory); free(string_memory); } proc init(int oms, int ems, int sms) { global_symbol_table = create_String_hashmap(); global_keyword_table = create_String_hashmap(); object_memory_size = oms; environment_memory_size = ems; string_memory_size = sms; free_spots_in_object_memory = create_Int_array_list(); free_spots_in_environment_memory = create_Environment_array_list(); free_spots_in_string_memory = create_Void_Ptr_array_list(); object_memory = (Lisp_Object*)malloc(object_memory_size * sizeof(Lisp_Object)); environment_memory = (Environment*)malloc(environment_memory_size * sizeof(Environment)); 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; push_environment(create_built_ins_environment()); } proc reset() -> void { free_spots_in_object_memory.next_index = 0; free_spots_in_environment_memory.next_index = 0; free_spots_in_string_memory.next_index = 0; global_symbol_table = create_String_hashmap(); global_keyword_table = create_String_hashmap(); try_void Parser::standard_in = create_string("stdin"); // because t and nil are always there we start the index at 2 next_index_in_object_memory = 2; next_index_in_environment_memory = 0; next_free_spot_in_string_memory = string_memory; Globals::Current_Execution::envi_stack.next_index = 0; push_environment(create_built_ins_environment()); } proc create_lisp_object_pointer(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 = create_Lisp_Obj_hashmap(); return node; } proc create_lisp_object_number(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(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_string(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* { // NOTE(Felix): Vectors are now only allocated at the back of // the memory, we don't check the free list at all right now if (object_memory_size - next_index_in_object_memory < size) { create_out_of_memory_error( "There is not enough space in the lisp object " "memory to allocate additional lisp objects. " "Maybe try increasing the Memory size when " "calling Memory::init()"); return nullptr; } int start = next_index_in_object_memory; next_index_in_object_memory += size; return object_memory+start; } 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_new_lisp_object_symbol(String* identifier) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Symbol); node->value.symbol.identifier = identifier; node->value.symbol.hash = hash(identifier); hm_set(global_symbol_table, get_c_str(identifier), node); return node; } proc create_new_lisp_object_keyword(String* keyword) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Keyword); node->value.symbol.identifier = keyword; node->value.symbol.hash = hash(keyword); hm_set(global_keyword_table, get_c_str(keyword), node); return node; } proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* { if (auto ret = hm_get_object(global_symbol_table, get_c_str(identifier))) return (Lisp_Object*)ret; else return create_new_lisp_object_symbol(identifier); } proc get_or_create_lisp_object_symbol(const char* identifier) -> Lisp_Object* { if (auto ret = hm_get_object(global_symbol_table, (char*)identifier)) return (Lisp_Object*)ret; else { String* str; try str = Memory::create_string(identifier); return create_new_lisp_object_symbol(str); } } proc get_or_create_lisp_object_keyword(String* keyword) -> Lisp_Object* { if (auto ret = hm_get_object(global_keyword_table, get_c_str(keyword))) return (Lisp_Object*)ret; else return create_new_lisp_object_keyword(keyword); } proc get_or_create_lisp_object_keyword(const char* keyword) -> Lisp_Object* { if (auto ret = hm_get_object(global_keyword_table, (char*)keyword)) return (Lisp_Object*)ret; else { String* str; try str = Memory::create_string(keyword); return create_new_lisp_object_keyword(str); } } proc create_lisp_object_cfunction(bool is_special) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); set_type(node, Lisp_Object_Type::CFunction); // node->value.lambdaWrapper = new Lambda_Wrapper(function); node->value.cFunction = new(cFunction); node->value.cFunction->args = {}; node->value.cFunction->is_special_form = is_special; return node; } 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) { 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_child_environment(Environment* parent) -> Environment* { Environment* env; // if we have no free spots then append at the end if (free_spots_in_environment_memory.next_index == 0) { int index; // if we still have space if (environment_memory_size == next_index_in_environment_memory) { create_out_of_memory_error( "There is not enough space in the environment " "memory to allocate additional environments. " "Maybe try increasing the Memory size when " "calling Memory::init()"); return nullptr; } index = next_index_in_environment_memory++; env = environment_memory+index; } else { // else fill a free spot, and remove the free spot env = free_spots_in_environment_memory.data[--free_spots_in_environment_memory.next_index]; } int start_capacity = 16; env->parents = create_Environment_array_list(); if (parent) append_to_array_list(&env->parents, parent); env->hm = create_Void_Ptr_hashmap(); return env; } proc create_empty_environment() -> Environment* { Environment* ret; try ret = create_child_environment(nullptr); return ret; } proc create_built_ins_environment() -> Environment* { Environment* ret; try ret = create_empty_environment(); push_environment(ret); defer { pop_environment(); }; load_built_ins_into_environment(); // save the current working directory //char* cwd = get_cwd(); //defer { // change_cwd(cwd); // free(cwd); //}; //// get the direction of the exe //char* exe_path = get_exe_dir(); //change_cwd(exe_path); //free(exe_path); 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; } }