implementation module link_library_instance; // StdLib import StdMaybe; // Linkers import dus_label; import DLState; import ObjectToMem; import pdObjectToMem; from SearchObject import add_module2, add_library2; import lib; import ReadObject; import CollectTypes; import check_types; import DLState; import link_switches; import DynID; // ? import ExtFile; // StdDynamicEnv from DynamicLinkerInterface import ::TypeReference(..), ::LibraryID(..); // compiler import utilities; from predef import UnderscoreSystemDynamicModule_String, DynamicRepresentation_String; from selectively_import_and_mark_labels import replace_section_label_by_label2; import Directory; initialize_internal_type_equivalence_classes library_instance_i dl_client_state io // linker administration must be loaded #! (li_library_initialized,dl_client_state) = dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_library_initialized; | not li_library_initialized = abort "initialize_internal_type_equivalence_classes2; internal error; should have initialized"; // only first initialization #! (li_have_internal_type_equivalent_class_been_fixed,dl_client_state) = dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_have_internal_type_equivalent_class_been_fixed; | li_have_internal_type_equivalent_class_been_fixed = ([],dl_client_state,io); #! dl_client_state = { dl_client_state & cs_library_instances.lis_library_instances.[library_instance_i].li_have_internal_type_equivalent_class_been_fixed = True }; // # msg // = "start - initializing internal type equivalence for library " +++ toString library_instance_i; // | False <<- msg // = undef; #! (type_table_i,dl_client_state) = dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i; #! (tis_equivalent_type_definitions,dl_client_state) = dl_client_state!cs_type_tables.[type_table_i].tt_type_io_state.tis_equivalent_type_definitions; #! (partition_types,dl_client_state,io) = foldlNonUniqueArraySt (enter_equally_named_type_equivalences type_table_i) tis_equivalent_type_definitions ([],dl_client_state,io) # (labels_implementing_partitions,dl_client_state) = foldSt generate_partition_labels partition_types ([],dl_client_state); with { generate_partition_labels partition_type (labels,dl_client_state) #! (type_name,_,more_labels,dl_client_state) = get_type_label_names partition_type type_table_i dl_client_state; = (labels ++ more_labels,dl_client_state); }; // # msg // = "end - initializing internal type equivalence for " +++ toString library_instance_i; // | False <<- ("ICI",msg,partition_types,'\n',labels_implementing_partitions) // = undef; = (labels_implementing_partitions,dl_client_state,io); where { enter_equally_named_type_equivalences type_table_i {type_name,partitions} (partition_types,dl_client_state,io) #! (partition_types,dl_client_state,io) = foldlNonUniqueArraySt enter_type_equivalent_class partitions (partition_types,dl_client_state,io); = (partition_types,dl_client_state,io); where { enter_type_equivalent_class partition (partition_types,dl_client_state,io) | size partition < 2 = abort "enter_type_equivalent_class; internal error; type equivalent class must contain at least two elements"; #! (x,dl_client_state,io) = enter_type_equation_new [LIT_TypeReference (LibRef library_instance_i) tio_type_ref \\ tio_type_ref <-: partition ] dl_client_state io; | isNothing x = (partition_types,dl_client_state,io); #! (Just (ref,_)) = x; #! (maybe_implemented_partition,dl_client_state) = dl_client_state!cs_type_implementation_table.teit_type_implementations_a.[ref].tei_chosen_type_implementation; #! implemented_partition = isJust maybe_implemented_partition; | implemented_partition = (partition_types,dl_client_state,io); // partition not implemented. Use current library. #! current_lib_ref = LibRef library_instance_i; #! type_implementation_for_class = (LIT_TypeReference current_lib_ref partition.[0]); #! dl_client_state = replaceType type_implementation_for_class (tl [ LIT_TypeReference current_lib_ref p \\ p <-: partition ]) dl_client_state; = ([partition.[0]:partition_types],dl_client_state,io); }; }; initialize_library_instance :: !Int !*DLClientState *f -> (!Bool,!*DLClientState,!*f) | FileEnv f; initialize_library_instance library_instance_i dl_client_state io #! (li_library_initialized,dl_client_state) = dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_library_initialized; | li_library_initialized = (False,dl_client_state,io); #! msg = " begin initialize_library_instance " +++ toString library_instance_i; #! dl_client_state = AddMessage (Verbose msg) dl_client_state; # (li_library_name,dl_client_state) = dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_library_name; # li_library_name = fromJust li_library_name; #! (type_table_i,dl_client_state) = dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i; #! (state,dl_client_state) = get_state dl_client_state; #! (Just main_library_instance_i,dl_client_state) = dl_client_state!cs_main_library_instance_i; #! (do_dump_dynamic,dl_client_state) = dl_client_state!do_dump_dynamic; #! is_dump_dynamic_main_library = library_instance_i == main_library_instance_i && do_dump_dynamic; #! is_main_library_instance = library_instance_i == main_library_instance_i; #! (share_runtime_system,dl_client_state) = dl_client_state!cs_share_runtime_system; #! dl_client_state = { dl_client_state & cs_share_runtime_system = True }; # dl_client_state = case share_runtime_system of { False -> { dl_client_state & cs_main_library_instance_i = Just library_instance_i }; _ -> dl_client_state; }; // load library # ({rti_n_libraries=n_libraries,rti_n_library_symbols=n_library_symbols,rti_library_list=library_list},dl_client_state) = dl_client_state!cs_type_tables.[type_table_i].tt_rti; // mark library instance i as initialized #! dl_client_state = { dl_client_state & cs_library_instances.lis_library_instances.[library_instance_i].li_library_initialized = True }; #! (n_old_libraries,state) = state!n_libraries; // import DLL symbols #! (symbol_n,library_n,names_table) = ImportDynamicLibrarySymbols library_list 0 (~(n_libraries + n_old_libraries)) create_names_table; | symbol_n <> n_library_symbols || library_n <> (~n_old_libraries) = abort "LoadCodeLibraryInstance: internal error; .typ-file corrupt"; // LibraryList #! state = add_library2 n_libraries n_library_symbols library_list state; // load code library *without* run-time system which is shared with the main library // instance. # (do_dump_dynamic,dl_client_state) = dl_client_state!do_dump_dynamic; # (rs,dl_client_state) = case share_runtime_system of { False -> (default_redirection_state,dl_client_state); _ # (cs_main_library_instance_i,dl_client_state) = dl_client_state!cs_main_library_instance_i; # main_library_instance_i = fromJust cs_main_library_instance_i; # library_name = (snd (ExtractPathAndFile li_library_name)); # library_name = "_" +++ (library_name % (0,size library_name - 2)) +++ "_options.o"; # rts_objects = ["_startup0.o",library_name,"_startup1.o","_startup2.o","_startup1Profile.o","_startup1Trace.o","_system.o"]; #! (names_table,dl_client_state) = acc_names_table main_library_instance_i dl_client_state; # rs = { default_redirection_state & rs_main_names_table = names_table , rs_rts_modules = rts_objects }; -> (rs,dl_client_state); }; # (n_xcoff_files,state) = state!n_xcoff_files; # code_lib_name = ADD_CODE_LIBRARY_EXTENSION li_library_name; # (s_names_table,names_table) = usize names_table; # ((errors, xcoff_l, names_table, _,rs),io) = accFiles (read_code_library2 (n_xcoff_files) [] code_lib_name names_table rs) io; // restore name table # dl_client_state = case share_runtime_system of { False -> dl_client_state; _ # (cs_main_library_instance_i,dl_client_state) = dl_client_state!cs_main_library_instance_i; # main_library_instance_i = fromJust cs_main_library_instance_i; # dl_client_state = { dl_client_state & cs_library_instances.lis_library_instances.[main_library_instance_i].li_names_table = rs.rs_main_names_table }; -> dl_client_state; }; #! state = { state & namestable = names_table , library_list = library_list }; // add_module #! state = foldSt add_module2 xcoff_l state; // ------------------------ // A lazy dynamic is marked by a BUILD_BLOCK_LABEL or a BUILD_LAZY_BLOCK_LABEL. Each library also defines these // two labels. Without precautions, these copies would also be put in the image, making the conversion routines // much more complex. Therefore the copy of the main library instance is taken and references of other library // instance are redirected to those of the main library instance. // backup namestable from state #! (names_table,state) = select_namestable state; #! dl_client_state = { dl_client_state & cs_library_instances.lis_library_instances.[library_instance_i].li_names_table = names_table }; // body ... #! (state,dl_client_state) = case share_runtime_system of { False -> (state,dl_client_state); True // backup state #! dl_client_state = { dl_client_state & app_linker_state = state }; // replace BUILD_BLOCK_LABEL #! (Just main_library_instance_i,dl_client_state) = dl_client_state!cs_main_library_instance_i; #! (Just (build_block_file_n,build_block_symbol_n),dl_client_state) = findLabel BUILD_BLOCK_LABEL main_library_instance_i dl_client_state; //1 #! dl_client_state //1 = replaceLabel BUILD_BLOCK_LABEL library_instance_i build_block_file_n build_block_symbol_n BUILD_BLOCK_LABEL dl_client_state; // replace BUILD_LAZY_BLOCK_LABEL #! (Just (build_lazy_block_file_n,build_lazy_block_symbol_n),dl_client_state) = findLabel BUILD_LAZY_BLOCK_LABEL main_library_instance_i dl_client_state; //1 #! dl_client_state //1 = replaceLabel BUILD_LAZY_BLOCK_LABEL library_instance_i build_lazy_block_file_n build_lazy_block_symbol_n BUILD_LAZY_BLOCK_LABEL dl_client_state; //1... #! dl_client_state = case (do_dump_dynamic) of { True -> dl_client_state; _ #! dl_client_state = replaceLabel BUILD_BLOCK_LABEL library_instance_i build_block_file_n build_block_symbol_n BUILD_BLOCK_LABEL dl_client_state; #! dl_client_state = replaceLabel BUILD_LAZY_BLOCK_LABEL library_instance_i build_lazy_block_file_n build_lazy_block_symbol_n BUILD_LAZY_BLOCK_LABEL dl_client_state; -> dl_client_state; }; //...1 // extract state #! (state,dl_client_state) = acc_state (\state -> (state,EmptyState)) dl_client_state; -> (state,dl_client_state); }; // ... body // restore namestable in state # dl_client_state = { dl_client_state & app_linker_state = state , cs_library_instances.lis_library_instances.[library_instance_i].li_library_list = library_list }; = (share_runtime_system,dl_client_state,io); where { read_code_library2 file_n module_to_be_removed code_lib_name names_table rs files #! ((ok,code_lib_name_p),files) = pd_StringToPath code_lib_name files; #! ((dir_error,_),files) = getFileInfo code_lib_name_p files; | not ok || dir_error <> NoDirError = abort ("Error opening library file '" +++ code_lib_name +++ "'"); # (errors, xcoff_l, _, names_table, file_n, files,_,rs) = read_static_lib_files_new module_to_be_removed [code_lib_name] [] names_table file_n [] files default_rsl_state rs; = ((errors, xcoff_l, names_table, file_n,rs), files); } // loads both the code library assumes type table has already been loaded. The redirections to be made are derived from the // type table and imposed on the code. load_code_library_instance :: (Maybe [.DusLabel]) !.Int !*DLClientState !*f -> (!Int,[Int],!*DLClientState,!*f) | FileEnv f; load_code_library_instance (Just []) library_instance_i dl_client_state io = (0,[],dl_client_state,io); load_code_library_instance non_main_library library_instance_i dl_client_state io #! (_,dl_client_state,io) = initialize_library_instance library_instance_i dl_client_state io; #! (labels_implementing_partitions,dl_client_state,io) = initialize_internal_type_equivalence_classes library_instance_i dl_client_state io; #! (library_list,dl_client_state) = dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_library_list; #! dl_client_state = { dl_client_state & app_linker_state.library_list = library_list }; #! (names_table,dl_client_state) = acc_names_table library_instance_i dl_client_state; #! (state,dl_client_state) = acc_state (\s -> (s,EmptyState)) dl_client_state; #! state = { state & namestable = names_table , library_list = library_list }; #! (main_symbols,dl_client_state) = case non_main_library of { Nothing // # (type_table_i,dl_client_state) = dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i; # types = [ // , (T_ypeObjectTypeRepresentation_String,UnderscoreSystemDynamicModule_String) ] # (labels,dl_client_state) = collect_type_labels types type_table_i dl_client_state; #! main_symbol = sel_platform "_mainCRTStartup" "main"; #! main_symbols = [ SymbolUnknown "" main_symbol , SymbolUnknown "" BUILD_BLOCK_LABEL , SymbolUnknown "" BUILD_LAZY_BLOCK_LABEL ] ++ [ SymbolUnknown UnderscoreSystemDynamicModule_String label_name \\ label_name <- labels ]; #! (teit_n_type_implementations,dl_client_state) = dl_client_state!cs_type_implementation_table.teit_n_type_implementations; -> (main_symbols,dl_client_state); (Just dus_labels) // exclude label which already have been linked by other library instances #! labels = [ SymbolUnknown "" dusl_label_name \\ {dusl_label_name,dusl_linked} <- dus_labels | not dusl_linked]; -> (labels,dl_client_state); }; #! main_symbols = main_symbols ++ [ SymbolUnknown "" label \\ label <- labels_implementing_partitions ]; /* ** The preliminary temp solution above ensures that the RunTimeID-constructor is allocated into ** library space and not lazily allocated in space for the graph_to_string-conversion function ** which is not a library instance and therefore not included in the table which is sent to the ** application and contains start/end addresses for each library instance. ** In the future the RunTimeID constructor of the context library should be used. */ #! ((wii,p=:[start_addr:_],state,dl_client_state),io) = LinkUnknownSymbols main_symbols state library_instance_i dl_client_state io; // LibraryList #! (names_table,state) = select_namestable state; #! (library_list,state) = state!library_list; #! dl_client_state = case wii of { Nothing -> dl_client_state; Just {wii_code_start,wii_code_end,wii_data_start,wii_data_end} #! (li_memory_areas,dl_client_state) = dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_memory_areas; #! li_memory_areas = [{ma_begin=wii_data_start,ma_end=wii_data_end},{ma_begin=wii_code_start,ma_end=wii_code_end}:li_memory_areas]; #! dl_client_state = { dl_client_state & cs_library_instances.lis_library_instances.[library_instance_i].li_memory_areas = li_memory_areas }; -> dl_client_state; }; // update #! dl_client_state = { dl_client_state & cs_library_instances.lis_library_instances.[library_instance_i].li_library_initialized = True , cs_library_instances.lis_library_instances.[library_instance_i].li_library_list = library_list , cs_library_instances.lis_library_instances.[library_instance_i].li_names_table = names_table , app_linker_state = state } | False <<- ("end - load_code_library_instance") = undef; = (start_addr,p,dl_client_state,io); replaceType :: !.LibraryInstanceTypeReference ![.LibraryInstanceTypeReference] !*DLClientState -> *DLClientState; replaceType implemented_type type_implementations_to_redirect dl_client_state = redirect_type_implementation_equivalent_class implemented_type type_implementations_to_redirect dl_client_state; redirect_type_implementation_equivalent_class :: !.LibraryInstanceTypeReference ![.LibraryInstanceTypeReference] !*DLClientState -> *DLClientState; redirect_type_implementation_equivalent_class (LIT_TypeReference (LibRef chosen_library_instance_i) chosen_tio_type_reference) type_implementations_to_redirect dl_client_state // get label names which implementent the chosen type implementation #! (li_chosen_type_table_i,dl_client_state) = dl_client_state!cs_library_instances.lis_library_instances.[chosen_library_instance_i].li_type_table_i; #! (chosen_type_name,_,labels_implementing_chosen_type,dl_client_state) = get_type_label_names chosen_tio_type_reference li_chosen_type_table_i dl_client_state; #! (labels_implementing_chosen_type,dl_client_state) = mapSt (lookup_file_n_symbol_n_for_each_label chosen_library_instance_i) labels_implementing_chosen_type dl_client_state; | False <<- (chosen_type_name, labels_implementing_chosen_type,labels_implementing_chosen_type) = undef; // #! dl_client_state // = AddMessage (Verbose ("Patching NamesTable for '" +++ chosen_type_name +++ "'")) dl_client_state; // get labels for type_implementations_to_redirect #! (_,dl_client_state) = foldSt (redirect_type chosen_library_instance_i) type_implementations_to_redirect (labels_implementing_chosen_type,dl_client_state); = dl_client_state; where { lookup_file_n_symbol_n_for_each_label chosen_library_instance_i type_label_name dl_client_state #! (maybe_file_n_symbol_n,dl_client_state) = findLabel type_label_name chosen_library_instance_i dl_client_state; | isNothing maybe_file_n_symbol_n = abort ("alal " +++ type_label_name); #! (file_n,symbol_n) = fromJust maybe_file_n_symbol_n; = ((file_n,symbol_n,type_label_name),dl_client_state); }; redirect_type chosen_library_instance_i (LIT_TypeReference (LibRef library_instance_i) tio_type_reference) (labels_implementing_chosen_type,dl_client_state) #! (li_type_table_i,dl_client_state) = dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i; #! (_,_,labels_implementing_type,dl_client_state) = get_type_label_names tio_type_reference li_type_table_i dl_client_state; #! dl_client_state = fold2St redirect_type_label labels_implementing_type labels_implementing_chosen_type dl_client_state; = (labels_implementing_chosen_type,dl_client_state); where { redirect_type_label refering_label chosen_label=:(file_n,symbol_n,chosen_label_name) dl_client_state // #! msg // = "> redirect '" +++ refering_label +++ "'<" +++ toString library_instance_i +++ "> to '" // +++ chosen_label_name +++ "'<" +++ toString chosen_library_instance_i +++ ">"; // #! dl_client_state // = AddMessage (Verbose msg) dl_client_state; #! dl_client_state = replaceLabel refering_label library_instance_i file_n symbol_n chosen_label_name dl_client_state; = dl_client_state; }; // redirect_type redirect_type chosen_library_instance_i _ s = s; collect_type_labels :: [(!String,!String)] !Int *DLClientState -> *(![String],*DLClientState); collect_type_labels types type_table_i dl_client_state # (type_tables,dl_client_state) = get_type_tables dl_client_state; // collect types # (types,type_tables) = foldSt convert_type_name_into_tio_type_ref types ([],type_tables); | False //<<- ("types", types) = undef; # dl_client_state = { dl_client_state & cs_type_tables = type_tables }; // collect labels # (labels,dl_client_state) = foldSt (collect_labels_implementing_a_type type_table_i) types ([],dl_client_state) = (labels,dl_client_state); where { convert_type_name_into_tio_type_ref (type_name,module_name) (types,type_tables) # (maybe_tio_type_reference,type_tables) = findTypeUsingTypeName type_name module_name type_table_i type_tables; | isNothing maybe_tio_type_reference = abort ("convert_type_name_into_tio_type_ref: internal error; unknown type " +++ type_name); # type = TypeTableTypeReference type_table_i (fromJust maybe_tio_type_reference); # (cts=:{cts_type_dependencies,cts_type_tables=type_tables}) = collect_types type type {default_collect_types_state & cts_type_tables = type_tables}; = (cts_type_dependencies ++ types,type_tables); collect_labels_implementing_a_type type_table_i (tio_type_ref,_) (labels,dl_client_state) #! (type_name,_,labels_implementing_type,dl_client_state) = get_type_label_names tio_type_ref type_table_i dl_client_state; | False <<- ("<>", type_name,labels_implementing_type) = undef; = (labels_implementing_type ++ labels,dl_client_state); } LoadTypeTable :: .Int *DLClientState *a -> *(*DLClientState,*a) | FileEnv a; LoadTypeTable type_table_i dl_client_state io # (tt_loaded,dl_client_state) = dl_client_state!cs_type_tables.[type_table_i].tt_loaded; | tt_loaded = (dl_client_state,io); // load type table # (tt_name,dl_client_state) = dl_client_state!cs_type_tables.[type_table_i].tt_name; # ((ok,rti,tio_common_defs,type_io_state,_),io) = accFiles (read_type_library_new False tt_name) io; | not ok #! msg = "Loaded type table " +++ toString type_table_i +++ ": " +++ tt_name; #! dl_client_state = AddMessage (LinkerError msg) dl_client_state; = (dl_client_state,io); # tt_pattern_matches = mapASt remove_types_without_definitions tio_common_defs [] // create new type table # new_type_table = { default_type_table & tt_type_io_state = type_io_state , tt_tio_common_defs = { x \\ x <-: tio_common_defs } , tt_n_tio_common_defs = size tio_common_defs , tt_rti = rti , tt_pattern_matches = { tt_pattern_match \\ tt_pattern_match <- tt_pattern_matches } }; # dl_client_state = AddTypeTable type_table_i new_type_table dl_client_state; // print that type library has been loaded #! dl_client_state = AddMessage (Verbose ("Loaded type table " +++ toString type_table_i +++ ": " +++ tt_name)) dl_client_state; = (dl_client_state,io); where { remove_types_without_definitions {tio_pattern_matches} s = remove_type_without_definition tio_pattern_matches s; where { remove_type_without_definition [] s = s; remove_type_without_definition [{tio_type_name_ref}:xs] s | isTypeWithoutDefinition tio_type_name_ref = s = remove_type_without_definition xs [tio_type_name_ref:s] }; // old behaviour = create_new_names_table set to True read_type_library_new :: !Bool !String *Files -> *(*(Bool,RTI,.{#TIO_CommonDefs},*TypeIOState,*{!NamesTableElement}),*Files); read_type_library_new create_new_names_table ls_main_code_type_lib files | create_new_names_table # (ok,rti,tio_common_defs,type_io_state,names_table,files) = read_type_information (ADD_TYPE_LIBRARY_EXTENSION ls_main_code_type_lib) create_names_table files; = ((ok,rti,tio_common_defs,type_io_state,names_table),files); // to prevent a names table being created and filled # (ok,rti,tio_common_defs,type_io_state,names_table,files) = read_type_information_new create_new_names_table (ADD_TYPE_LIBRARY_EXTENSION ls_main_code_type_lib) {} files; = ((ok,rti,tio_common_defs,type_io_state,names_table),files); };