implementation module State; import StdEnv; import SymbolTable, /*PmDynamic,*/ pdState, LinkerMessages; import DebugUtilities; :: *State = { // misc one_pass_link :: !Bool , normal_static_link :: !Bool , linker_messages_state:: !LinkerMessagesState // linker tables , application_name :: !String , n_libraries :: !Int , n_xcoff_files :: !Int , n_xcoff_symbols :: !Int , n_library_symbols :: !Int , marked_bool_a :: !*{#Bool} , marked_offset_a :: !*{#Int} , module_offset_a :: !*{#Int} , xcoff_a :: !{#*Xcoff} , namestable :: !*NamesTable // dynamic libraries , library_list :: !LibraryList , library_file_names :: ![!String] , pd_state :: !*PDState }; EmptyState :: !*State; EmptyState = { one_pass_link = True , normal_static_link = True , linker_messages_state= DefaultLinkerMessages // linker tables , application_name = "" , n_libraries = 0 , n_xcoff_files = 0 , n_xcoff_symbols = 0 , n_library_symbols = 0 , marked_bool_a = {} , marked_offset_a = {} , module_offset_a = {} , xcoff_a = {} , namestable = create_names_table // dynamic libraries , library_list = EmptyLibraryList , library_file_names = [] , pd_state = DefaultPDState }; // xcoff_a access app_xcoff_a :: (!{#*Xcoff} -> !{#*Xcoff}) !*State -> !*State; app_xcoff_a f state=:{xcoff_a} #! xcoff_a = f xcoff_a; = { state & xcoff_a = xcoff_a }; acc_xcoff_a :: (!{#*Xcoff} -> (!.x,!{#*Xcoff})) !*State -> (!.x,!*State); acc_xcoff_a f state=:{xcoff_a} #! (x,xcoff_a) = f xcoff_a; = (x,{ state & xcoff_a = xcoff_a }); selacc_xcoff :: !Int (!*Xcoff -> (!.x,!*Xcoff)) !*State -> (.x,!*State); selacc_xcoff i f state=:{xcoff_a} #! (xcoff,xcoff_a) = replace xcoff_a i empty_xcoff; #! (x,xcoff) = f xcoff; = (x,{state & xcoff_a = {xcoff_a & [i] = xcoff}}); selapp_xcoff :: !Int (!*Xcoff -> !*Xcoff) !*State -> !*State; selapp_xcoff i f state=:{xcoff_a} #! (xcoff,xcoff_a) = replace xcoff_a i empty_xcoff; = {state & xcoff_a = {xcoff_a & [i] = f xcoff}}; /* selapp_xcoff :: !Int (*Xcoff -> *Xcoff) !*State -> !*State; selapp_xcoff i f state=:{xcoff_a} # (xcoff,xcoff_a) = replace xcoff_a i empty_xcoff; = {state & xcoff_a = {xcoff_a & [i] = f xcoff}}; */ // xcoff_a; symbol_table access selacc_symbol_table :: !Int (!*SymbolTable -> (!.x,!*SymbolTable)) !*State -> (!.x,!*State); selacc_symbol_table i f state #! (x,state) = selacc_xcoff i w1 state; = (x,state); where { w1 :: !*Xcoff -> (!_,!*Xcoff); w1 xcoff=:{symbol_table} #! (x,symbol_table) = f symbol_table; = (x, {xcoff & symbol_table = symbol_table}) } selapp_symbol_table :: !Int (!*SymbolTable -> !*SymbolTable) !*State -> !*State; selapp_symbol_table i f state = selapp_xcoff i w1 state; where { w1 :: !*Xcoff -> !*Xcoff; w1 xcoff=:{symbol_table} = {xcoff & symbol_table = f symbol_table}; } // symbols selacc_symbols :: !Int (!*SymbolArray -> (!.x,!*SymbolArray)) !*State -> (!.x,!*State); selacc_symbols file_n f state #! (x,state) = selacc_symbol_table file_n w2 state; = (x,state); where { w2 :: !*SymbolTable -> (!_,!*SymbolTable); w2 symbol_table=:{symbols} #! (x,symbols) = f symbols; = (x, {symbol_table & symbols = symbols} ); } selapp_symbols :: !Int (!*SymbolArray -> *SymbolArray) !*State -> !*State; selapp_symbols file_n f state = selapp_symbol_table file_n w3 state; where { w3 :: !*SymbolTable -> !*SymbolTable; w3 symbol_table=:{symbols} = {symbol_table & symbols = f symbols}; } // xcoff_a; symbol access sel_symbol :: !Int !Int !*State -> (!Symbol,!*State); sel_symbol file_n symbol_n state = selacc_symbols file_n (\symbols=:{[symbol_n] = symbol} -> (symbol,symbols)) state; update_symbol :: !Symbol !Int !Int !State -> !State; update_symbol symbol file_n symbol_n state=:{xcoff_a} | file_n < 0 = abort "update_symbol: not a dll"; = selapp_symbols file_n (\symbols -> {symbols & [symbol_n] = symbol}) state; /* update_symbol :: !Symbol !Int !Int !State -> !State; update_symbol symbol file_n symbol_n state=:{xcoff_a} | file_n < 0 = abort "update_symbol: not a dll"; = {state & xcoff_a = update1 xcoff_a}; { update1 :: {#*Xcoff} -> {#*Xcoff}; update1 xcoff_a = { xcoffs & [file_n] = xcoff1 }; { (xcoff,xcoffs) = replace xcoff_a file_n empty_xcoff; xcoff1 = update2 xcoff; update2 :: Xcoff -> Xcoff; update2 xcoff=:{symbol_table} = { xcoff & symbol_table = symbol_table1 }; { symbol_table1 = update3 symbol_table; update3 :: *SymbolTable -> *SymbolTable; update3 symboltable=:{symbols} = { symboltable & symbols = {symbols & [symbol_n] = symbol } }; } } } */ // marked_bool_a access acc_marked_bool_a :: (!*{#Bool} -> (!.x,!*{#Bool})) !*State -> (!.x,!*State); acc_marked_bool_a f state=:{marked_bool_a} #! (x,marked_bool_a) = f marked_bool_a; = (x,{state & marked_bool_a = marked_bool_a}); selacc_marked_bool_a :: !Int !*State -> (!Bool,!*State); selacc_marked_bool_a i state = acc_marked_bool_a (\marked_bool_a=:{[i] = bool} -> (bool,marked_bool_a)) state; // module_offset_a access acc_module_offset_a :: (!*{#Int} -> (!.x,!*{#Int})) !*State -> (!.x,!*State); acc_module_offset_a f state=:{module_offset_a} #! (x,module_offset_a) = f module_offset_a; = (x,{state & module_offset_a = module_offset_a}); app_module_offset_a :: (!*{#Int} -> !*{#Int}) !*State -> !*State; app_module_offset_a f state=:{module_offset_a} = { state & module_offset_a = f module_offset_a }; selacc_module_offset_a :: !Int !*State -> (!Int,!*State); selacc_module_offset_a i state = acc_module_offset_a (\module_offset_a=:{[i] = index} -> (index,module_offset_a)) state; // marked_offset_a access acc_marked_offset_a :: (!*{#Int} -> (!.x,!*{#Int})) !*State -> (!.x,!*State); acc_marked_offset_a f state=:{marked_offset_a} #! (x,marked_offset_a) = f marked_offset_a; = (x,{state & marked_offset_a = marked_offset_a}); selacc_marked_offset_a :: !Int !*State -> (!Int,!*State); selacc_marked_offset_a i state = acc_marked_offset_a (\marked_offset_a=:{[i] = index} -> (index,marked_offset_a)) state; selacc_so_marked_offset_a :: !Int !*State -> (!Int,!*State); selacc_so_marked_offset_a file_n state | file_n >= 0 = abort ("selacc_so_marked_offset_a: i should be negative to indicate a shared library (or dll): "); #! (s_marked_offset_a,state) = acc_marked_offset_a usize state; = selacc_marked_offset_a (file_n + s_marked_offset_a) state; // namestable access app_namestable :: (!*NamesTable -> !*NamesTable) !*State -> !*State; app_namestable f state=:{namestable} = { state & namestable = (f namestable) }; acc_namestable :: (!*NamesTable -> (!.x,!*NamesTable)) !*State -> (!.x,!*State); acc_namestable f state=:{namestable} #! (x,namestable) = f namestable; = (x, { state & namestable = namestable } ); // General select_namestable state :== acc_namestable (\namestable -> (namestable,{})) state; update_namestable :: NamesTable !State -> State; update_namestable namestable state = {state & namestable = namestable}; select_marked_bool_a :: !State -> (!*{#Bool},!State); select_marked_bool_a state=:{marked_bool_a} = (marked_bool_a,{state & marked_bool_a = {}}); select_marked_offset_a :: !State -> (!*{#Int},!State); select_marked_offset_a state=:{marked_offset_a} = (marked_offset_a,{state & marked_offset_a = {}}); select_module_offset_a :: !State -> (!*{#Int},!State); select_module_offset_a state=:{module_offset_a} = (module_offset_a,{state & module_offset_a = {}}); select_xcoff_a :: !State -> (!{#*Xcoff},!State); select_xcoff_a state=:{xcoff_a} = (xcoff_a,{state & xcoff_a = {}}); update_state_with_xcoff :: !*Xcoff !State -> !State; update_state_with_xcoff xcoff state=:{xcoff_a,n_xcoff_files} = {state & xcoff_a = fill_xcoff_array xcoff 0 n_xcoff_files xcoff_a (xcoff_array (n_xcoff_files+1)) }; { xcoff_array :: !Int -> !*{#*Xcoff}; xcoff_array n = {empty_xcoff \\ i<-[0..dec n]}; fill_xcoff_array :: *Xcoff !Int !Int !*{#*Xcoff} !*{#*Xcoff} -> !*{#*Xcoff}; fill_xcoff_array xcoff i n_xcoff_files old_xcoff_a new_xcoff_a | i == n_xcoff_files = {new_xcoff_a & [n_xcoff_files] = xcoff}; #! (old_xcoff,old_xcoff_a1) = replace old_xcoff_a i empty_xcoff; = fill_xcoff_array xcoff (inc i) n_xcoff_files old_xcoff_a1 {new_xcoff_a & [i] = old_xcoff}; } find_name :: !String !State -> (!Int,!Int,!State); find_name name state #! (namestable,state) = select_namestable state; #! (names_table_element,namestable) = find_symbol_in_symbol_table name namestable #! state = update_namestable namestable state; = case names_table_element of { (NamesTableElement _ symbol_n file_n _) -> (file_n,symbol_n,state); _ -> abort ("find_name: name not found" +++ name ); } address_of_label2 :: !Int !Int !State -> (!Int,!State); address_of_label2 file_n symbol_n state #! (first_symbol_n,state1) = selacc_marked_offset_a file_n state1; #! (marked,state1) = selacc_marked_bool_a (first_symbol_n+symbol_n) state1; | not marked = (0,state1); // #! (label_symbol,state) // = sel_symbol file_n symbol_n state; | isLabel label_symbol #! module_n = getLabel_module_n label_symbol; #! offset = getLabel_offset label_symbol; #! (module_symbol,state1) = sel_symbol file_n module_n state1; | isModule module_symbol #! virtual_label_offset = getModule_virtual_label_offset module_symbol; #! (first_symbol_n,state1) = selacc_marked_offset_a file_n state1; #! (real_module_offset,state1) = selacc_module_offset_a (first_symbol_n + module_n) state1; = (real_module_offset+offset-virtual_label_offset,state1); = abort "address_of_label2: internal error (isModule)"; | isModule label_symbol = (sel_platform address_of_label2_pc address_of_label2_mac) state1; = abort "address_of_label2: not a {label,module}-symbol"; where { (label_symbol,state1) = sel_symbol file_n symbol_n state; address_of_label2_pc state #! module_n = symbol_n; #! module_symbol = label_symbol; #! virtual_label_offset = getModule_virtual_label_offset module_symbol; #! (first_symbol_n,state) = selacc_marked_offset_a file_n state; #! (real_module_offset,state) = selacc_module_offset_a (first_symbol_n + module_n) state; #! q = real_module_offset-virtual_label_offset; = (q,state); address_of_label2_mac state #! module_n = symbol_n; #! module_symbol = label_symbol; #! (first_symbol_n,state) = selacc_marked_offset_a file_n state; #! (real_module_offset,state) = selacc_module_offset_a (first_symbol_n + module_n) state; = (real_module_offset,state); } // address_of_label2 find_address_of_label :: !String !State -> !(!Bool,!Int,!State); find_address_of_label label state #! (ok,file_n,label_n,state) = find_name2 label state; | not ok = (False,0,state); #! (addr,state) = address_of_label2 file_n label_n state; = (True,addr,state); where { /* = case label_symbol of { Label _ offset module_n #! (module_symbol,state) = sel_symbol file_n module_n state; -> case module_symbol of { Module _ virtual_label_offset _ _ _ _ _ #! (first_symbol_n,state) = selacc_marked_offset_a file_n state; #! (real_module_offset,state) = selacc_module_offset_a (first_symbol_n + module_n) state; -> (real_module_offset+offset-virtual_label_offset,state); _ -> abort "address of label2: error"; } } */ find_name2 :: !String !State -> (!Bool,!Int,!Int,!State); find_name2 name state #! (namestable,state) = select_namestable state; #! (names_table_element,namestable) = find_symbol_in_symbol_table name namestable #! state = update_namestable namestable state; = case names_table_element of { (NamesTableElement _ symbol_n file_n _) -> (True,file_n,symbol_n,state); _ -> (False,0,0,state); } } // find_address_of_label // General select_file_name file_n state :== sel_platform (selacc_xcoff file_n (\xcoff=:{file_name} -> (file_name,xcoff)) state) (selacc_xcoff file_n sel_file_name state) ; select_module_name file_n state :== (selacc_xcoff file_n (\xcoff=:{module_name} -> (module_name,xcoff)) state); // (\xcoff=:{header={file_name}} -> (file_name,xcoff)) /// winos specific select_n_symbols file_n state :== sel_platform (selacc_xcoff file_n (\xcoff=:{n_symbols} -> (n_symbols,xcoff)) state) (abort "select_n_symbols (state): macOS"); selacc_bss_symbols file_n state :== sel_platform (selacc_symbol_table file_n (\symbol_table=:{bss_symbols} -> (bss_symbols,symbol_table)) state) (selacc_symbol_table file_n (\symbol_table=:{bss_symbols} -> (bss_symbols,symbol_table)) state) ; // (abort "selacc_bss_symbols (state): macOS"); selacc_data_symbols file_n state :== sel_platform (selacc_symbol_table file_n (\symbol_table=:{data_symbols} -> (data_symbols,symbol_table)) state) (selacc_symbol_table file_n (\symbol_table=:{data_symbols} -> (data_symbols,symbol_table)) state); selacc_text_symbols file_n state :== sel_platform (selacc_symbol_table file_n (\symbol_table=:{text_symbols} -> (text_symbols,symbol_table)) state) (selacc_symbol_table file_n (\symbol_table=:{text_symbols} -> (text_symbols,symbol_table)) state); // PC dummies; should be removed //select_marked_offset index state :== selacc_marked_offset_a index state; //select_dll_marked_offset file_n state :== selacc_so_marked_offset_a file_n state; //select_module_offset index state :== selacc_module_offset_a index state; //select_marked_bool index state :== selacc_marked_bool_a index state; // macOS specific // for xcoff: selacc_text_relocations file_n state :== sel_platform (abort "selacc_text_relocations (state): winOS") (selacc_xcoff file_n get_text_relocations state); selacc_data_relocations file_n state :== sel_platform (abort "selacc_data_relocations (state): winOS") (selacc_xcoff file_n get_data_relocations state); selacc_header file_n state :== sel_platform (abort "selacc_header (state): winOS") (selacc_xcoff file_n get_header state); selacc_n_symbols file_n state :== sel_platform (abort "selacc_n_symbols (state): winOS") (selacc_xcoff file_n get_n_symbols state); selacc_text_v_address file_n state :== sel_platform (abort "selacc_text_v_address (state): winOS") (selacc_xcoff file_n get_text_v_address state); selacc_data_v_address file_n state :== sel_platform (abort "selacc_data_v_address (state): winOS") (selacc_xcoff file_n get_data_v_address state); selacc_toc0_symbols file_n state :== sel_platform (abort "selacc_toc0_symbols (state): winOS") (selacc_symbol_table file_n get_toc0_symbols state); selacc_toc_symbols file_n state :== sel_platform (abort "selacc_toc_symbols (state): winOS") (selacc_symbol_table file_n get_toc_symbols state); /* //selacc_text_relocations file_n state :== selacc_xcoff file_n (\xcoff=:{text_relocations} -> (text_relocations,xcoff)) state; selacc_data_relocations file_n state :== selacc_xcoff file_n (\xcoff=:{data_relocations} -> (data_relocations,xcoff)) state; selacc_header file_n state :== selacc_xcoff file_n (\xcoff=:{header} -> (header,xcoff)) state; selacc_n_symbols file_n state :== selacc_xcoff file_n (\xcoff=:{n_symbols} -> (n_symbols,xcoff)) state; // for xcoff_header: selacc_text_v_address file_n state :== selacc_xcoff file_n (\xcoff=:{header={text_v_address}} -> (text_v_address,xcoff)) state; selacc_data_v_address file_n state :== selacc_xcoff file_n (\xcoff=:{header={data_v_address}} -> (data_v_address,xcoff)) state; // for symbol_table: selacc_toc0_symbols file_n state :== selacc_symbol_table file_n (\symbol_table=:{toc0_symbol} -> (toc0_symbol,symbol_table)) state; selacc_toc_symbols file_n state :== selacc_symbol_table file_n (\symbol_table=:{toc_symbols} -> (toc_symbols,symbol_table)) state; */ /* // accessors get_text_relocations :== (\xcoff=:{text_relocations} -> (text_relocations,xcoff)); get_data_relocations :== (\xcoff=:{data_relocations} -> (data_relocations,xcoff)); get_header :== (\xcoff=:{header} -> (header,xcoff)); get_n_symbols :== (\xcoff=:{n_symbols} -> (n_symbols,xcoff)); get_text_v_address :== (\xcoff=:{header={text_v_address}} -> (text_v_address,xcoff)); get_data_v_address :== (\xcoff=:{header={data_v_address}} -> (data_v_address,xcoff)); get_toc0_symbols :== (\symbol_table=:{toc0_symbol} -> (toc0_symbol,symbol_table)); get_toc_symbols :== (\symbol_table=:{toc_symbols} -> (toc_symbols,symbol_table)); */ is_defined_symbol :: !String !*State -> !(!Bool,!Int,!Int,!*State); is_defined_symbol symbol_name state #! (namestable,state) = select_namestable state; #! (names_table_element,namestable) = find_symbol_in_symbol_table symbol_name namestable; #! state = update_namestable namestable state; = case names_table_element of { NamesTableElement _ symbol_n file_n _ -> (True,file_n,symbol_n,state); _ -> (False,0,0,state); }; // ADDED instance AddMessage State where { AddMessage linker_message state=:{linker_messages_state} # linker_messages_state = addLinkerMessage linker_message linker_messages_state; = {state & linker_messages_state = linker_messages_state}; IsErrorOccured state=:{linker_messages_state} #! (ok,linker_messages_state) = isLinkerErrorOccured linker_messages_state; = (ok,state); GetLinkerMessages state=:{linker_messages_state} #! messages = get_LinkerMessages linker_messages_state; = (messages,state); SetLinkerMessages messages state=:{linker_messages_state} #! linker_messages_state = setLinkerMessages messages linker_messages_state; = {state & linker_messages_state = linker_messages_state}; }; /* // xcoff_a access app_xcoff_a :: ({#*Xcoff} -> {#*Xcoff}) !*State -> !*State; app_xcoff_a f state=:{xcoff_a} # xcoff_a = f xcoff_a; = { state & xcoff_a = xcoff_a }; acc_xcoff_a :: ({#*Xcoff} -> (.x,{#*Xcoff})) !*State -> (!.x,!*State); acc_xcoff_a f state=:{xcoff_a} # (x,xcoff_a) = f xcoff_a; = (x,{ state & xcoff_a = xcoff_a }); */ app_pdstate :: (!*PDState -> !*PDState) !*State -> !*State; app_pdstate f state=:{pd_state} #! pd_state = f pd_state; = { state & pd_state = pd_state }; acc_pdstate :: (!*PDState -> (!.x,!*PDState)) !*State -> (!.x,!*State); acc_pdstate f state=:{pd_state} #! (x,pd_state) = f pd_state; = (x,{ state & pd_state = pd_state});