Commit 4d665523 authored by Arjan Oortgiese's avatar Arjan Oortgiese

Merged MacOS and common version of graph_to_string_and_descriptors

parent c193f0c2
......@@ -35,6 +35,15 @@ int is_using_desc_relative_to_array()
#endif
}
int size_element_descriptor_currying()
{
#if defined (MACH_O64)
return 16;
#else
return 8;
#endif
}
extern void *INT_descriptor,*CHAR,*BOOL,*REAL,*__STRING__,*__ARRAY__;
/*inline*/
......
......@@ -20,6 +20,24 @@ copy_to_string g = code {
.o 1 0
}
get_array_D :: !{#Int} -> Int;
get_array_D a = code {
pushD_a 0
pop_a 1
}
// The c function is_using_desc_relative_to_array is defined in copy_graph_to_string.c
// the function returns 1 if positions are relative to _ARRAY_ and 0 when not.
is_using_desc_relative_to_array :: Int;
is_using_desc_relative_to_array = code {
ccall is_using_desc_relative_to_array ":I"
}
size_element_descriptor_currying :: Int;
size_element_descriptor_currying = code {
ccall size_element_descriptor_currying ":I"
}
get_D_from_string s i :== IF_INT_64_OR_32 (get_D_from_string_64 s i) (get_D_from_string_32 s i);
get_D_from_string_32 :: !{#Char} !Int -> Int;
......@@ -113,7 +131,10 @@ get_D_name d = code {
.o 1 0
}
get_D_cons_module d :== IF_INT_64_OR_32 (get_D_cons_module_64 d) (get_D_cons_module_32 d);
isMacOS :: Bool;
isMacOS = size_element_descriptor_currying == 16;
get_D_cons_module d :== IF_INT_64_OR_32 (get_D_cons_module_64_platform d) (get_D_cons_module_32 d);
get_D_cons_module_32 :: !Int -> Int;
get_D_cons_module_32 d = code {
......@@ -123,6 +144,9 @@ get_D_cons_module_32 d = code {
load_i 6
}
get_D_cons_module_64_platform :: !Int -> Int;
get_D_cons_module_64_platform d = if (not isMacOS) (get_D_cons_module_64 d) (get_D_cons_module_64_MacOS d);
get_D_cons_module_64 :: !Int -> Int;
get_D_cons_module_64 d = code {
push_b 0
......@@ -131,18 +155,42 @@ get_D_cons_module_64 d = code {
load_si32 6
}
get_D_record_module d :== IF_INT_64_OR_32 (get_D_record_module_64 d) (get_D_record_module_32 d);
get_D_cons_module_64_MacOS :: !Int -> Int;
get_D_cons_module_64_MacOS d = code {
push_b 0
load_si16 0
addI
push_b 0
load_si32 6
addI
pushI 6
addI
}
get_D_record_module d :== IF_INT_64_OR_32 (get_D_record_module_64_platform d) (get_D_record_module_32 d);
get_D_record_module_32 :: !Int -> Int;
get_D_record_module_32 d = code {
load_i -10
}
get_D_record_module_64_platform :: !Int -> Int;
get_D_record_module_64_platform d = if (not isMacOS) (get_D_record_module_64 d) (get_D_record_module_64_MacOS d);
get_D_record_module_64 :: !Int -> Int;
get_D_record_module_64 d = code {
load_si32 -10
}
get_D_record_module_64_MacOS :: !Int -> Int;
get_D_record_module_64_MacOS d = code {
push_b 0
load_si32 -10
addI
pushI -10
addI
}
get_module_name_size a :== IF_INT_64_OR_32 (get_module_name_size_64 a) (get_module_name_size_32 a);
get_module_name_size_32 :: !Int -> Int;
......@@ -218,8 +266,8 @@ get_module_name :: !Int -> {#Char};
get_module_name m
= {get_module_name_char m i\\i<-[0..get_module_name_size m-1]};
get_n_non_pointers_and_array_elem_desc :: !Int !a !Int -> (!Int,!Int);
get_n_non_pointers_and_array_elem_desc d v offset
get_n_non_pointers_and_array_elem_desc :: !Int !a !Int !Int -> (!Int,!Int);
get_n_non_pointers_and_array_elem_desc d v offset array_desc
# arity = get_D_node_arity d;
| arity==0
| is_Int_D d || is_Char_D d || is_Bool_D d
......@@ -230,6 +278,7 @@ get_n_non_pointers_and_array_elem_desc d v offset
# ed=get_array_elem_D v offset;
| ed==0
= (2,ed);
# ed=ed+array_desc;
| is_Int_D ed
= (2+get_array_size v offset,ed);
| is_Real_D ed
......@@ -257,7 +306,7 @@ get_module d
| arity < 256
| is__Cons_D d
= 0;
| is__Tuple_D (d-arity*8)
| is__Tuple_D (d-arity*size_element_descriptor_currying)
= 0;
= get_D_cons_module d;
= get_D_record_module d;
......@@ -321,22 +370,23 @@ count_unboxed_records_in_record desc
= count_unboxed_records_in_record desc (i+1) (n_unboxed_records+1);
}
replace_descs_by_desc_numbers_and_build_desc_tree :: !Int !*{#Char} !Int !DescOrModTree -> (!*{#Char},!Int,!DescOrModTree);
replace_descs_by_desc_numbers_and_build_desc_tree i s n_descs desc_tree
replace_descs_by_desc_numbers_and_build_desc_tree :: !Int !*{#Char} !Int !Int !DescOrModTree -> (!*{#Char},!Int,!DescOrModTree);
replace_descs_by_desc_numbers_and_build_desc_tree i s n_descs array_desc desc_tree
| i>=size s
= (s,n_descs,desc_tree);
#! desc=get_D_from_string s i;
#! desc=desc+array_desc;
| desc bitand 1<>0
= replace_descs_by_desc_numbers_and_build_desc_tree (i+IF_INT_64_OR_32 8 4) s n_descs desc_tree;
= replace_descs_by_desc_numbers_and_build_desc_tree (i+IF_INT_64_OR_32 8 4) s n_descs array_desc desc_tree;
| desc bitand 2==0
= abort ("unevaluated node in replace_descs_by_desc_numbers_and_build_desc_tree "+++toString desc);
#! a=cast_string_to_a s;
# (d,array_elem_desc) = get_n_non_pointers_and_array_elem_desc desc a (i+IF_INT_64_OR_32 16 8);
# (d,array_elem_desc) = get_n_non_pointers_and_array_elem_desc desc a (i+IF_INT_64_OR_32 16 8) array_desc;
# (s,n_descs,desc_tree) = store_desc_n_and_add_desc desc i s n_descs desc_tree;
| array_elem_desc==0
= replace_descs_by_desc_numbers_and_build_desc_tree (i+IF_INT_64_OR_32 8 4+(d<<(IF_INT_64_OR_32 3 2))) s n_descs desc_tree;
= replace_descs_by_desc_numbers_and_build_desc_tree (i+IF_INT_64_OR_32 8 4+(d<<(IF_INT_64_OR_32 3 2))) s n_descs array_desc desc_tree;
# (s,n_descs,desc_tree) = store_desc_n_and_add_desc array_elem_desc (i+IF_INT_64_OR_32 16 8) s n_descs desc_tree;
= replace_descs_by_desc_numbers_and_build_desc_tree (i+IF_INT_64_OR_32 8 4+(d<<(IF_INT_64_OR_32 3 2))) s n_descs desc_tree;
= replace_descs_by_desc_numbers_and_build_desc_tree (i+IF_INT_64_OR_32 8 4+(d<<(IF_INT_64_OR_32 3 2))) s n_descs array_desc desc_tree;
{}{
store_desc_n_and_add_desc :: Int Int !*{#Char} !Int !DescOrModTree -> (!*{#Char},!Int,!DescOrModTree);
store_desc_n_and_add_desc desc i s n_descs desc_tree
......@@ -462,7 +512,7 @@ info_of_desc_and_mod {desc,desc_mod_n} desc_tree
| arity < 256
| is__Cons_D desc
= ":";
| is__Tuple_D (desc-arity*8)
| is__Tuple_D (desc-arity*size_element_descriptor_currying)
= {'t',arity_to_char arity};
= {'C',arity_to_char arity,arity_to_char (get_D_arity desc),toChar (desc_mod_n),toChar (desc_mod_n>>8)}
+++get_D_name desc+++"\0";
......@@ -516,7 +566,8 @@ graph_to_string_with_descriptor_and_module_table :: !a -> (!{#Char},!{#{#Char}},
graph_to_string_with_descriptor_and_module_table g
# g = eval_all_nodes g;
# s = copy_to_string g;
# (s,n_descs,desc_tree) = replace_descs_by_desc_numbers_and_build_desc_tree 0 s 0 EmptyDescOrModTree;
# array_desc = if (is_using_desc_relative_to_array == 1) (get_array_D {} - 2) 0;
# (s,n_descs,desc_tree) = replace_descs_by_desc_numbers_and_build_desc_tree 0 s 0 array_desc EmptyDescOrModTree
# desc_a = make_desc_array n_descs desc_tree;
# (desc_a,n_mods,mod_tree) = make_module_tree desc_a;
# mod_a = make_mod_array n_mods mod_tree;
......
definition module graph_to_string_and_descriptors;
// includes unboxed record descriptors
graph_to_string_with_descriptors :: !a -> {#Char};
graph_to_string_with_descriptor_and_module_table :: !a -> (!{#Char},!{#{#Char}},!{#{#Char}});
// (graph,descriptor_table,module_table)
This diff is collapsed.
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