felix/slime
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

profiling

Browse Source
This commit is contained in:
fumfar hiwi
2019-11-27 14:02:23 +01:00
parent 8639b5a155
commit 28ab850bee
21 changed files with 123 additions and 487 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+71 -3
View File
@@ -46,6 +46,7 @@ proc add_to_load_path(const char* path) -> void {
}
proc built_in_load(String* file_name) -> Lisp_Object* {
profile_this();
char* file_content;
char fullpath[4096];
sprintf(fullpath, "%s", Memory::get_c_str(file_name));
@@ -89,6 +90,7 @@ proc built_in_load(String* file_name) -> Lisp_Object* {
}
proc built_in_import(String* file_name) -> Lisp_Object* {
profile_this();
Environment* new_env;
new_env = Memory::file_to_env_map.get_object(Memory::get_c_str(file_name));
@@ -114,12 +116,15 @@ proc built_in_import(String* file_name) -> Lisp_Object* {
}
proc load_built_ins_into_environment() -> void* {
profile_this();
String* file_name_built_ins = Memory::create_string(__FILE__);
define((helper), "") {
profile_with_name("(helper)");
return Memory::create_lisp_object_number(101);
};
define((test (:k (helper))), "") {
profile_with_name("(test)");
fetch(k);
return k;
};
@@ -127,6 +132,7 @@ proc load_built_ins_into_environment() -> void* {
"Takes 0 or more arguments and returns =t= if all arguments are equal "
"and =()= otherwise.")
{
profile_with_name("(=)");
fetch(args);
if (args == Memory::nil)
@@ -143,6 +149,7 @@ proc load_built_ins_into_environment() -> void* {
};
define((> . args), "TODO")
{
profile_with_name("(>)");
fetch(args);
double last_number = strtod("Inf", NULL);
@@ -157,6 +164,7 @@ proc load_built_ins_into_environment() -> void* {
};
define((>= . args), "TODO")
{
profile_with_name("(>=)");
fetch(args);
double last_number = strtod("Inf", NULL);
@@ -171,6 +179,7 @@ proc load_built_ins_into_environment() -> void* {
};
define((< . args), "TODO")
{
profile_with_name("(<)");
fetch(args);
double last_number = strtod("-Inf", NULL);
@@ -185,6 +194,7 @@ proc load_built_ins_into_environment() -> void* {
};
define((<= . args), "TODO")
{
profile_with_name("(<=)");
fetch(args);
double last_number = strtod("-Inf", NULL);
@@ -199,6 +209,7 @@ proc load_built_ins_into_environment() -> void* {
};
define((+ . args), "TODO")
{
profile_with_name("(+)");
fetch(args);
double sum = 0;
@@ -211,6 +222,7 @@ proc load_built_ins_into_environment() -> void* {
};
define((- . args), "TODO")
{
profile_with_name("(-)");
fetch(args);
if (args == Memory::nil)
return Memory::create_lisp_object_number(0);
@@ -232,6 +244,7 @@ proc load_built_ins_into_environment() -> void* {
};
define((* . args), "TODO")
{
profile_with_name("(*)");
fetch(args);
if (args == Memory::nil) {
return Memory::create_lisp_object_number(1);
@@ -248,6 +261,7 @@ proc load_built_ins_into_environment() -> void* {
};
define((/ . args), "TODO")
{
profile_with_name("(/)");
fetch(args);
if (args == Memory::nil) {
@@ -266,6 +280,7 @@ proc load_built_ins_into_environment() -> void* {
return Memory::create_lisp_object_number(quotient);
};
define((** a b), "TODO") {
profile_with_name("(**)");
fetch(a, b);
try assert_type(a, Lisp_Object_Type::Number);
try assert_type(b, Lisp_Object_Type::Number);
@@ -273,6 +288,7 @@ proc load_built_ins_into_environment() -> void* {
b->value.number));
};
define((% a b), "TODO") {
profile_with_name("(%)");
fetch(a, b);
try assert_type(a, Lisp_Object_Type::Number);
try assert_type(b, Lisp_Object_Type::Number);
@@ -280,6 +296,7 @@ proc load_built_ins_into_environment() -> void* {
(int)b->value.number);
};
define((get-random-between a b), "TODO") {
profile_with_name("(get-random-between)");
fetch(a, b);
try assert_type(a, Lisp_Object_Type::Number);
try assert_type(b, Lisp_Object_Type::Number);
@@ -293,6 +310,7 @@ proc load_built_ins_into_environment() -> void* {
return Memory::create_lisp_object_number(x);
};
define_special((bound? var), "TODO") {
profile_with_name("(bound?)");
fetch(var);
try assert_type(var, Lisp_Object_Type::Symbol);
@@ -305,6 +323,7 @@ proc load_built_ins_into_environment() -> void* {
return Memory::nil;
};
define((assert test), "TODO") {
profile_with_name("(assert)");
fetch(test);
if (is_truthy(test))
@@ -314,6 +333,7 @@ proc load_built_ins_into_environment() -> void* {
return nullptr;
};
define_special((define-syntax form (:doc "") . body), "TODO") {
profile_with_name("(define-syntax)");
fetch(form, doc, body);
try assert_type(doc, Lisp_Object_Type::String);
@@ -350,6 +370,7 @@ proc load_built_ins_into_environment() -> void* {
return Memory::nil;
};
define_special((define definee (:doc "") . body), "TODO") {
profile_with_name("(define)");
fetch(definee, doc, body);
// print_hm(get_current_environment()->hm);
@@ -405,6 +426,7 @@ proc load_built_ins_into_environment() -> void* {
return Memory::nil;
};
define((mutate target source), "TODO") {
profile_with_name("(mutate)");
fetch(target, source);
if (target == Memory::nil ||
@@ -427,11 +449,13 @@ proc load_built_ins_into_environment() -> void* {
return target;
};
define((vector-length v), "TODO") {
profile_with_name("(vector-length)");
fetch(v);
try assert_type(v, Lisp_Object_Type::Vector);
return Memory::create_lisp_object_number((double)v->value.vector.length);
};
define((vector-ref vec idx), "TODO") {
profile_with_name("(vector-ref)");
fetch(vec, idx);
try assert_type(vec, Lisp_Object_Type::Vector);
@@ -445,6 +469,7 @@ proc load_built_ins_into_environment() -> void* {
return vec->value.vector.data+int_idx;
};
define((vector-set! vec idx val), "TODO") {
profile_with_name("(vector-set!)");
fetch(vec, idx, val);
try assert_type(vec, Lisp_Object_Type::Vector);
@@ -460,6 +485,7 @@ proc load_built_ins_into_environment() -> void* {
return val;
};
define_special((set! sym val), "TODO") {
profile_with_name("(set!)");
fetch(sym, val);
try assert_type(sym, Lisp_Object_Type::Symbol);
@@ -473,14 +499,13 @@ proc load_built_ins_into_environment() -> void* {
push_environment(target_env);
{
define_symbol(sym, val);
}
define_symbol(sym, val);
pop_environment();
return val;
};
define((set-car! target source), "TODO") {
profile_with_name("(set-car!)");
fetch(target, source);
try assert_type(target, Lisp_Object_Type::Pair);
@@ -489,6 +514,7 @@ proc load_built_ins_into_environment() -> void* {
return source;
};
define((set-cdr! target source), "TODO") {
profile_with_name("(set-cdr!)");
fetch(target, source);
try assert_type(target, Lisp_Object_Type::Pair);
@@ -497,6 +523,7 @@ proc load_built_ins_into_environment() -> void* {
return source;
};
define_special((if test then_part else_part), "TODO") {
profile_with_name("(if)");
fetch(test, then_part, else_part);
bool truthy;
@@ -511,10 +538,12 @@ proc load_built_ins_into_environment() -> void* {
return result;
};
define_special((quote datum), "TODO") {
profile_with_name("(quote)");
fetch(datum);
return datum;
};
define_special((quasiquote expr), "TODO") {
profile_with_name("(quasiquote)");
fetch(expr);
Lisp_Object* quasiquote_sym = Memory::get_or_create_lisp_object_symbol("quasiquote");
Lisp_Object* unquote_sym = Memory::get_or_create_lisp_object_symbol("unquote");
@@ -615,6 +644,7 @@ proc load_built_ins_into_environment() -> void* {
return expr;
};
define_special((and . args), "TODO") {
profile_with_name("(and)");
fetch(args);
bool result = true;
in_caller_env {
@@ -627,6 +657,7 @@ proc load_built_ins_into_environment() -> void* {
return Memory::t;
};
define_special((or . args), "TODO") {
profile_with_name("(or)");
fetch(args);
bool result = false;
in_caller_env {
@@ -639,6 +670,7 @@ proc load_built_ins_into_environment() -> void* {
return Memory::nil;
};
define_special((not test), "TODO") {
profile_with_name("(not)");
fetch(test);
bool truthy;
in_caller_env {
@@ -673,6 +705,7 @@ proc load_built_ins_into_environment() -> void* {
// // });
define_special((lambda args . body), "TODO") {
profile_with_name("(lambda)");
fetch(args, body);
// creating new lisp object and setting type
@@ -688,6 +721,7 @@ proc load_built_ins_into_environment() -> void* {
return func;
};
define((apply fun args), "TODO") {
profile_with_name("(apply)");
fetch(fun, args);
Lisp_Object* result;
@@ -696,6 +730,7 @@ proc load_built_ins_into_environment() -> void* {
return result;
};
define((eval expr), "TODO") {
profile_with_name("(eval)");
fetch(expr);
Lisp_Object* result;
@@ -706,6 +741,7 @@ proc load_built_ins_into_environment() -> void* {
return result;
};
define_special((begin . args), "TODO") {
profile_with_name("(begin)");
fetch(args);
Lisp_Object* result = Memory::nil;
in_caller_env {
@@ -716,10 +752,12 @@ proc load_built_ins_into_environment() -> void* {
return result;
};
define((list . args), "TODO") {
profile_with_name("(list)");
fetch(args);
return args;
};
define((hash-map . args), "TODO") {
profile_with_name("(hash-map)");
fetch(args);
Lisp_Object* ret;
try ret = Memory::create_lisp_object_hash_map();
@@ -732,6 +770,7 @@ proc load_built_ins_into_environment() -> void* {
return ret;
};
define((hash-map-get hm key), "TODO") {
profile_with_name("(hash-map-get)");
fetch(hm, key);
try assert_type(hm, Lisp_Object_Type::HashMap);
@@ -742,18 +781,21 @@ proc load_built_ins_into_environment() -> void* {
return ret;
};
define((hash-map-set! hm key value), "TODO") {
profile_with_name("(hash-map-set!)");
fetch(hm, key, value);
try assert_type(hm, Lisp_Object_Type::HashMap);
hm->value.hashMap->set_object(key, value);
return Memory::nil;
};
define((hash-map-delete! hm key), "TODO") {
profile_with_name("(hash-map-delete!)");
fetch(hm, key);
try assert_type(hm, Lisp_Object_Type::HashMap);
hm->value.hashMap->delete_object(key);
return Memory::nil;
};
define((vector . args), "TODO") {
profile_with_name("(vector)");
fetch(args);
Lisp_Object* ret;
int length = list_length(args);
@@ -761,6 +803,7 @@ proc load_built_ins_into_environment() -> void* {
return ret;
};
define((pair car cdr), "TODO") {
profile_with_name("(pair)");
fetch(car, cdr);
Lisp_Object* ret;
@@ -768,6 +811,7 @@ proc load_built_ins_into_environment() -> void* {
return ret;
};
define((first seq), "TODO") {
profile_with_name("(first)");
fetch(seq);
if (seq == Memory::nil)
return Memory::nil;
@@ -775,6 +819,7 @@ proc load_built_ins_into_environment() -> void* {
return seq->value.pair.first;
};
define((rest seq), "TODO") {
profile_with_name("(rest)");
fetch(seq);
if (seq == Memory::nil)
return Memory::nil;
@@ -782,17 +827,20 @@ proc load_built_ins_into_environment() -> void* {
return seq->value.pair.rest;
};
define((set-type! node new_type), "TODO") {
profile_with_name("(set-type!)");
fetch(node, new_type);
try assert_type(new_type, Lisp_Object_Type::Keyword);
node->userType = new_type;
return node;
};
define((delete-type! n), "TODO") {
profile_with_name("(delete-type!)");
fetch(n);
n->userType = nullptr;
return Memory::t;
};
define((type n), "TODO") {
profile_with_name("(type)");
fetch(n);
if (n->userType) {
@@ -828,6 +876,7 @@ proc load_built_ins_into_environment() -> void* {
return Memory::get_or_create_lisp_object_keyword("unknown");
};
define((mem-reset), "TODO") {
profile_with_name("(mem-reset)");
Memory::reset();
return Memory::nil;
};
@@ -837,6 +886,7 @@ proc load_built_ins_into_environment() -> void* {
// object. Otherwise (define k :doc "hallo" :keyword) would modify
// the global keyword
define_special((info n), "TODO") {
profile_with_name("(info)");
fetch(n);
print(n);
@@ -908,6 +958,7 @@ proc load_built_ins_into_environment() -> void* {
return Memory::nil;
};
define((show n), "TODO") {
profile_with_name("(show)");
fetch(n);
try assert_type(n, Lisp_Object_Type::Function);
@@ -920,11 +971,13 @@ proc load_built_ins_into_environment() -> void* {
return Memory::nil;
};
define((addr-of var), "TODO") {
profile_with_name("(addr-of-var)");
fetch(var);
return Memory::create_lisp_object_number(
(float)((u64)&(var)));
};
define((generate-docs file_name), "TODO") {
profile_with_name("(generate-docs)");
fetch(file_name);
try assert_type(file_name, Lisp_Object_Type::String);
in_caller_env {
@@ -933,6 +986,7 @@ proc load_built_ins_into_environment() -> void* {
return Memory::t;
};
define((print (:sep " ") (:end "\n") . things), "TODO") {
profile_with_name("(print)");
fetch(sep, end, things);
if (things != Memory::nil) {
@@ -948,6 +1002,7 @@ proc load_built_ins_into_environment() -> void* {
return Memory::nil;
};
define((read (:prompt ">")), "TODO") {
profile_with_name("(read)");
fetch(prompt);
print(prompt);
@@ -960,21 +1015,25 @@ proc load_built_ins_into_environment() -> void* {
return Memory::create_lisp_object_string(strLine);
};
define((exit (:code 0)), "TODO") {
profile_with_name("(exit)");
fetch(code);
try assert_type(code, Lisp_Object_Type::Number);
exit((int)code->value.number);
};
define((break), "TODO") {
profile_with_name("(break)");
in_caller_env {
print_environment(get_current_environment());
}
return Memory::nil;
};
define((memstat), "TODO") {
profile_with_name("(memstat)");
Memory::print_status();
return Memory::nil;
};
define_special((mytry try_part catch_part), "TODO") {
profile_with_name("(mytry)");
fetch(try_part, catch_part);
Lisp_Object* result;
@@ -993,6 +1052,7 @@ proc load_built_ins_into_environment() -> void* {
return result;
};
define((load file), "TODO") {
profile_with_name("(load)");
fetch(file);
try assert_type(file, Lisp_Object_Type::String);
@@ -1003,6 +1063,7 @@ proc load_built_ins_into_environment() -> void* {
return result;
};
define((import f), "TODO") {
profile_with_name("(import)");
fetch(f);
try assert_type(f, Lisp_Object_Type::String);
@@ -1014,12 +1075,14 @@ proc load_built_ins_into_environment() -> void* {
return Memory::t;
};
define((copy obj), "TODO") {
profile_with_name("(copy)");
fetch(obj);
// TODO(Felix): if we are copying string nodes, then
// shouldn't the string itself also get copied??
return Memory::copy_lisp_object(obj);
};
define((error type message), "TODO") {
profile_with_name("(error)");
fetch(type, message);
// TODO(Felix): make the error function useful
try assert_type(type, Lisp_Object_Type::Keyword);
@@ -1034,11 +1097,13 @@ proc load_built_ins_into_environment() -> void* {
return nullptr;
};
define((symbol->keyword sym), "TODO") {
profile_with_name("(symbol->keyword)");
fetch(sym);
try assert_type(sym, Lisp_Object_Type::Symbol);
return Memory::get_or_create_lisp_object_keyword(sym->value.symbol);
};
define((string->symbol str), "TODO") {
profile_with_name("(string->symbol)");
fetch(str);
// TODO(Felix): do some sanity checks on the string. For
// example, numbers are not valid symbols.
@@ -1048,6 +1113,7 @@ proc load_built_ins_into_environment() -> void* {
Memory::duplicate_string(str->value.string));
};
define((symbol->string sym), "TODO") {
profile_with_name("(symbol->string)");
fetch(sym);
try assert_type(sym, Lisp_Object_Type::Symbol);
@@ -1055,6 +1121,7 @@ proc load_built_ins_into_environment() -> void* {
Memory::duplicate_string(sym->value.symbol));
};
define((concat-strings . strings), "TODO") {
profile_with_name("(concat-strings)");
fetch(strings);
int resulting_string_len = 0;
@@ -1076,3 +1143,4 @@ proc load_built_ins_into_environment() -> void* {
};
return nullptr;
}
src/eval.cpp
+8 -6
View File
@@ -3,7 +3,7 @@ proc create_extended_environment_for_function_application(
Lisp_Object* function,
bool should_evaluate) -> Environment*
{
profile_this;
profile_this();
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
Environment* new_env;
Lisp_Object* arguments = unevaluated_arguments;
@@ -226,7 +226,7 @@ proc create_extended_environment_for_function_application(
}
proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* {
profile_this;
profile_this();
Environment* new_env;
Lisp_Object* result;
@@ -236,10 +236,12 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function,
pop_environment();
};
// if c function:
if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
// if c function:
try result = function->value.cFunction->body();
else // if lisp function
else
// if lisp function
try result = eval_expr(function->value.function->body);
return result;
@@ -357,7 +359,7 @@ proc copy_scl(Source_Code_Location*) -> Source_Code_Location* {
}
proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* {
profile_this;
profile_this();
// int my_out_arguments_length = 0;
if (arguments == Memory::nil) {
// *(out_arguments_length) = 0;
@@ -393,7 +395,7 @@ proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* {
}
proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
profile_this;
profile_this();
using namespace Globals::Current_Execution;
call_stack.append(node);
src/gc.cpp
+1 -1
View File
@@ -76,7 +76,7 @@ namespace GC {
}
proc garbage_collect() -> void {
profile_this;
profile_this();
++current_mark;
for (auto it : protected_environments) maybe_mark(it);
src/io.cpp
+1
View File
@@ -120,6 +120,7 @@ proc unescape_string(char* in) -> int {
}
proc read_entire_file(char* filename) -> char* {
profile_this();
char *fileContent = nullptr;
FILE *fp = fopen(filename, "r");
if (fp) {
src/memory.cpp
+3 -1
View File
@@ -161,6 +161,7 @@ namespace Memory {
}
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
add_to_load_path(exe_path);
@@ -192,8 +193,9 @@ namespace Memory {
}
proc reset() -> void {
free_spots_in_string_memory.next_index = 0;
profile_this();
free_spots_in_string_memory.next_index = 0;
global_symbol_table.~Hash_Map();
global_keyword_table.~Hash_Map();
src/parse2.cpp
+4 -1
View File
@@ -201,6 +201,7 @@ namespace Parser {
}
proc parse_atom(char* text, int* index_in_text) -> Lisp_Object* {
profile_this();
Lisp_Object* ret;
// numbers
if ((text[*index_in_text] <= 57 && // if number
@@ -231,7 +232,7 @@ namespace Parser {
proc parse_list(char* text, int* index_in_text) -> Lisp_Object* {
profile_this();
if (text[*index_in_text] != '(') {
create_parsing_error("a list cannot be parsed here");
return nullptr;
@@ -338,6 +339,7 @@ namespace Parser {
}
proc parse_expression(char* text, int* index_in_text) -> Lisp_Object* {
profile_this();
Lisp_Object* ret;
eat_until_code(text, index_in_text);
try ret = maybe_expand_short_form(text, index_in_text);
@@ -372,6 +374,7 @@ namespace Parser {
proc parse_program(String* file_name, char* text) -> Array_List<Lisp_Object*>* {
profile_this();
parser_file = file_name;
parser_line = 1;
parser_col = 0;