Verified Commit a75c7750 authored by Camil Staps's avatar Camil Staps 🚀

More complete string-to-graph implementation

parent df071753
Pipeline #15359 failed with stage
in 1 minute and 19 seconds
......@@ -60,7 +60,6 @@ serialize_for_interpretation graph thisexe bcfile w
}
= (rec, w)
import Debug.Trace, StdDebug
deserialize :: !SerializedGraph !FilePath !*World -> *(a, !*World)
deserialize {graph,descinfo,modules,bytecode} thisexe w
# (host_syms,w) = accFiles (read_symbols thisexe) w
......@@ -84,7 +83,6 @@ deserialize {graph,descinfo,modules,bytecode} thisexe w
asp bsp csp heap
# graph_node = string_to_interpreter graph ie_settings
#! (ie,_) = make_finalizer ie_settings
#! (ie,graph_node,w) = trace_stdout (ie,graph_node,w)
# ie = {ie_finalizer=ie, ie_snode_ptr=0, ie_snodes=unsafeCreate 1}
= (interpret ie (Finalizer 0 0 graph_node), w)
where
......
......@@ -7,4 +7,5 @@ Start w
# (val,w) = deserialize graph "./GraphTest" w
= val
graph = 37
import StdInt, StdList
graph = map ((+) 100) [37,42,47]
......@@ -79,8 +79,55 @@ BC_WORD *build_start_node(struct interpretation_environment *ie) {
BC_WORD *string_to_interpreter(void **clean_string, struct interpretation_environment *ie) {
int len = *(int*)clean_string;
memcpy(ie->hp, &clean_string[1], len);
void **s = &clean_string[1];
BC_WORD *node = ie->hp;
BC_WORD **ptr_stack = (BC_WORD**) ie->asp;
int16_t *a_size_stack = (int16_t*) ie->csp;
BC_WORD dummy;
*++ptr_stack = &dummy;
*--a_size_stack = 1;
/* TODO check heap & stack space */
for (int i=0; i<len/IF_INT_64_OR_32(8,4); i++) {
if (a_size_stack[0] == 0) {
i--;
a_size_stack++;
} else {
a_size_stack[0]--;
BC_WORD desc=(BC_WORD) s[i];
s[i] = ie->hp;
if (desc & 1) { /* redirection */
**ptr_stack-- = (BC_WORD) s[i+(desc-1)/IF_INT_64_OR_32(8,4)];
continue;
}
**ptr_stack-- = (BC_WORD) ie->hp;
*ie->hp++ = desc;
int16_t a_arity = ((int16_t*)desc)[-1];
int16_t b_arity = 0;
if (desc == (BC_WORD) &dINT+2) { /* TODO more special cases */
b_arity = 1;
} if (a_arity > 256) { /* record */
a_arity = ((int16_t*)desc)[0];
b_arity = ((int16_t*)desc)[-1] - 256 - a_arity;
}
/* TODO: HNFs should be split */
for (int a=0; a<a_arity; a++)
*++ptr_stack = ie->hp + a_arity-a-1;
ie->hp += a_arity;
for (int b=0; b<b_arity; b++)
*ie->hp++ = (BC_WORD) s[++i];
*--a_size_stack = a_arity;
}
}
ie->hp += len;
return node;
}
......@@ -197,7 +244,7 @@ BC_WORD copy_to_host(struct InterpretationEnvironment *clean_ie, BC_WORD *node)
if (args_needed != 0 && ((void**)(node[0]-2))[host_address_offset] != &__Tuple) {
#if DEBUG_CLEAN_LINKS > 1
fprintf(stderr,"\tstill %d argument(s) needed\n",args_needed);
fprintf(stderr,"\tstill %d argument(s) needed (%d present)\n",args_needed,a_arity);
#endif
if (host_heap_free < 3 + args_needed + FINALIZER_SIZE_ON_HEAP)
return -2;
......
--- a/graph_copy_with_names.icl
+++ b/graph_copy_with_names.icl
@@ -61,7 +61,7 @@ get_thunk_arity_32 a = code {
get_thunk_arity_64 :: !Int -> Int;
get_thunk_arity_64 a = code {
- load_si32 -4
+ load_si16 -4
}
get_thunk_descriptor a :== IF_INT_64_OR_32 (get_thunk_descriptor_64_platform a) (get_thunk_descriptor_32_platform a);
@@ -721,7 +721,7 @@ lookup_symbol_value {di_prefix_arity_and_mod,di_name} mod_a symbols
| symbol_value== -1
= abort ("lookup_desc_info not found "+++symbol_name);
# arity = prefix_n - PREFIX_D;
- = symbol_value+(arity*size_element_descriptor_currying)+2;
+ = symbol_value+(arity*size_element_descriptor_currying*2)+2;
lookup_symbol_values desc_info_a mod_a symbols
= {#lookup_symbol_value desc_info mod_a symbols \\ desc_info <-: desc_info_a};
@@ -773,12 +773,14 @@ replace_desc_numbers_by_descs i s symbol_a symbol_offset array_desc
= replace_desc_numbers_by_descs (i+(IF_INT_64_OR_32 24 12)+l) s symbol_a symbol_offset array_desc;
= abort (toString l+++" "+++toString d);
......
......@@ -449,7 +449,6 @@ int main(int argc, char **argv) {
#ifdef DEBUG_CURSES
close_debugger();
return 0;
#endif
free_program(state.program);
......
......@@ -505,6 +505,16 @@ int parse_program(struct parser *state, struct char_provider *cp) {
state->program->symbol_table[state->ptr].offset *= 2;
# endif
state->program->symbol_table[state->ptr].offset += (BC_WORD) state->program->code;
# ifdef LINK_CLEAN_RUNTIME
if (state->program->symbol_table[state->ptr].name[0]) {
/* Descriptor has a _hnf code address */
struct host_symbol *host_sym = find_host_symbol_by_name(state->program, state->program->symbol_table[state->ptr].name);
if (host_sym != NULL) {
host_sym->interpreter_location = (BC_WORD*) state->program->symbol_table[state->ptr].offset;
}
}
# endif
}
#endif
#ifdef LINKER
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment