Commit 9833c71c authored by Arjan Oortgiese's avatar Arjan Oortgiese

graph_copy_with_names added support for MacOS.

parent b5c393a3
...@@ -64,12 +64,25 @@ get_thunk_arity_64 a = code { ...@@ -64,12 +64,25 @@ get_thunk_arity_64 a = code {
load_si32 -4 load_si32 -4
} }
get_thunk_descriptor a :== IF_INT_64_OR_32 (get_thunk_descriptor_64 a) (get_thunk_descriptor_32 a); get_thunk_descriptor a :== IF_INT_64_OR_32 (get_thunk_descriptor_64_platform a) (get_thunk_descriptor_32 a);
get_thunk_descriptor_64_platform :: !Int -> Int;
get_thunk_descriptor_64_platform a = if (not isMacOS) (get_thunk_descriptor_64 a) (get_thunk_descriptor_64_MacOS a);
get_thunk_descriptor_64 :: !Int -> Int; get_thunk_descriptor_64 :: !Int -> Int;
get_thunk_descriptor_64 a = code { get_thunk_descriptor_64 a = code {
load_si32 -8 load_si32 -8
} }
get_thunk_descriptor_64_MacOS :: !Int -> Int;
get_thunk_descriptor_64_MacOS a = code {
push_b 0
load_si32 -8
addI
pushI -8
addI
}
get_thunk_descriptor_32 :: !Int -> Int; get_thunk_descriptor_32 :: !Int -> Int;
get_thunk_descriptor_32 a = code { get_thunk_descriptor_32 a = code {
load_i -8 load_i -8
...@@ -117,6 +130,14 @@ is_using_desc_relative_to_array = code { ...@@ -117,6 +130,14 @@ is_using_desc_relative_to_array = code {
ccall is_using_desc_relative_to_array ":I" ccall is_using_desc_relative_to_array ":I"
} }
size_element_descriptor_currying :: Int;
size_element_descriptor_currying = code {
ccall size_element_descriptor_currying ":I"
}
isMacOS :: Bool;
isMacOS = size_element_descriptor_currying == 16;
get_array_D :: !{#Int} -> Int; get_array_D :: !{#Int} -> Int;
get_array_D a = code { get_array_D a = code {
pushD_a 0 pushD_a 0
...@@ -136,7 +157,7 @@ get_D_name d = code { ...@@ -136,7 +157,7 @@ get_D_name d = code {
.o 1 0 .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); 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 :: !Int -> Int;
get_D_cons_module_32 d = code { get_D_cons_module_32 d = code {
...@@ -146,6 +167,9 @@ get_D_cons_module_32 d = code { ...@@ -146,6 +167,9 @@ get_D_cons_module_32 d = code {
load_i 6 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 :: !Int -> Int;
get_D_cons_module_64 d = code { get_D_cons_module_64 d = code {
push_b 0 push_b 0
...@@ -154,6 +178,18 @@ get_D_cons_module_64 d = code { ...@@ -154,6 +178,18 @@ get_D_cons_module_64 d = code {
load_si32 6 load_si32 6
} }
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_cons_flag d :== IF_INT_64_OR_32 (get_D_cons_flag_64 d) (get_D_cons_flag_32 d); get_D_cons_flag d :== IF_INT_64_OR_32 (get_D_cons_flag_64 d) (get_D_cons_flag_32 d);
get_D_cons_flag_32 :: !Int -> Int; get_D_cons_flag_32 :: !Int -> Int;
...@@ -178,18 +214,30 @@ get_record_type_char a i = code { ...@@ -178,18 +214,30 @@ get_record_type_char a i = code {
load_ui8 2 load_ui8 2
} }
get_D_record_module d :== IF_INT_64_OR_32 (get_D_record_module_64 d) (get_D_record_module_32 d); 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 :: !Int -> Int;
get_D_record_module_32 d = code { get_D_record_module_32 d = code {
load_i -10 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 :: !Int -> Int;
get_D_record_module_64 d = code { get_D_record_module_64 d = code {
load_si32 -10 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 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; get_module_name_size_32 :: !Int -> Int;
...@@ -659,7 +707,7 @@ lookup_symbol_value {di_prefix_arity_and_mod,di_name} mod_a symbols ...@@ -659,7 +707,7 @@ lookup_symbol_value {di_prefix_arity_and_mod,di_name} mod_a symbols
| symbol_value== -1 | symbol_value== -1
= abort ("lookup_desc_info not found "+++symbol_name); = abort ("lookup_desc_info not found "+++symbol_name);
# arity = prefix_n - PREFIX_D; # arity = prefix_n - PREFIX_D;
= symbol_value+(arity<<3)+2; = symbol_value+(arity*size_element_descriptor_currying)+2;
lookup_symbol_values desc_info_a mod_a symbols lookup_symbol_values desc_info_a mod_a symbols
= {#lookup_symbol_value desc_info mod_a symbols \\ desc_info <-: desc_info_a}; = {#lookup_symbol_value desc_info mod_a symbols \\ desc_info <-: desc_info_a};
......
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