implementation module ReadState

import
	StdEnv,
	State,
	ReadWriteState
//	Common,
//	FileUtilities

// NEEEEWWWWW
from ExtFile import CompareFileTimes, FetchFileTime, ExtractPathFileAndExtension;

	
FromStringToInt :: !String -> !Int
FromStringToInt array=:{[0]=v0, [1]=v1, [2]=v2, [3]=v3}
	= (toInt v0)+(toInt v1<<8)+(toInt v2<<16)+(toInt v3<<24);
		
FReadInt :: !*File -> !(!Int,!*File)
FReadInt input 
	#! (i_s, input)
		= freads input 4
	= (FromStringToInt i_s,input)

ReadXCoffArray :: !Int !Int !String !{#*Xcoff} !*File -> (!{#*Xcoff},!*File)
ReadXCoffArray i limit file_name1 xcoff_a input
	| i == limit
		= (xcoff_a,input)
	
		#! (xcoff,input)
			= ReadXCoff input
		#! xcoff
			= { xcoff & file_name = file_name1 }
		= ReadXCoffArray (inc i) limit file_name1 {xcoff_a & [i] = xcoff} input
		

/*
** Oud
ReadXCoffArray :: !Int !Int !String !{#*Xcoff} !*File -> (!{#*Xcoff},!*File)
ReadXCoffArray i limit file_name1 xcoff_a input
	| i == limit
		= (xcoff_a,input)
		
		#! (xcoff_size,input)
			= FReadInt input
		#! (xcoff_s,input)
			= freads input xcoff_size
		#! xcoff
			= { (FromString xcoff_s) &
				file_name = file_name1
			} 
		= ReadXCoffArray (inc i) limit file_name1 {xcoff_a & [i] = xcoff } input
*/
	
// -------------------------------------------------------------------------------	
class 
	FromString .a :: {#Char} -> .a
	
DecodeString s index :== (4 + length,string)
where
	stripped_string 
		= s % (index, (size s) - 1)
	length 
		= FromStringToInt stripped_string
	string
		= stripped_string % (4, 4 + length - 1)	
		
DecodeInt s index :== (index +4, (FromStringToInt stripped_string))
where
	stripped_string 
			= s % (index, (size s) - 1)
			
DecodeChar s index :== (index + 1, (toInt s.[index]) )
		
DecodeDataType s index :== (index + index1, data) //abort (s % (index + index1, size s - 1)) //abort ((toString index1) +++ " = " +++ (toString (size s))) //(index1,data) //abort string //(  (s_new % (4,length+4 - 1)) +++ "!!" )//(index1,data)
where
	(index1, string)
		= DecodeString s index
		
	data
		= FromString string	
	
tail_string s index :== tail
where
	rest_of_string
		= (s % (index, size s-1))
	tail
		= FromString rest_of_string	
		
// -------------------------------------------------------------------------------
// *SXcoff

ReadXCoff :: !*File -> (!*SXcoff,!*File)
ReadXCoff input
	#! (file_name,input)
		= freadline input
	#! (_,n_symbols,input)
		= freadi input
	#! (symbol_table,input)
		= ReadSymbolTable n_symbols input
	= ({ empty_xcoff & 
		file_name = (file_name % (0, (size file_name) - 2)),
		symbol_table = symbol_table,
		n_symbols = n_symbols }, input)

instance FromString (*SXcoff)
where
	FromString s 
		#! (index,file_name)
			= DecodeString s 0
		#! (index, symbol_table)
			= DecodeDataType s index
		#! (index, n_symbols)
			= DecodeInt s index
		= { empty_xcoff &
			file_name = file_name,
			symbol_table = symbol_table,
			n_symbols = n_symbols }
		
// -------------------------------------------------------------------------------
// *SSymbolTable
//	#! (symbol_table,input)
//		= ReadSymbolTable n_symbols input

ReadSymbolTable :: !Int !*File -> (!*SSymbolTable,!*File)
ReadSymbolTable n_symbols input
	#! (text_symbols,input)
		= ReadSymbolIndexList input
	#! (data_symbols,input)
		= ReadSymbolIndexList input
	#! (bss_symbols,input)
		= ReadSymbolIndexList input
	#! (imported_symbols,input)
		= ReadSymbolIndexList input
	#! (section_symbol_ns,input)
		= ReadIntArray input
	#! (symbols,input)
		= ReadSymbolArray n_symbols input
		
	= ({ SSymbolTable |
			text_symbols = text_symbols,
			data_symbols = data_symbols,
			bss_symbols = bss_symbols,
			imported_symbols = imported_symbols,
			section_symbol_ns = section_symbol_ns,
			symbols = symbols
		},input)
	where 
		ReadSymbolIndexList input
			#! (_,n_symbols,input)
				= freadi input
			= read_symbol_index_list n_symbols input
		where
			read_symbol_index_list i input
				| i == 0
					= (EmptySymbolIndex,input)
					
					#! (_,j,input) 
						= freadi input
					#! (sil,input)
						= read_symbol_index_list (dec i) input
					= (SymbolIndex j sil, input)
					
		ReadIntArray :: !*File -> (*{#Int},!*File)	
		ReadIntArray input
			#! (_,n_ints,input)
				= freadi input
			= read_int_array 0 n_ints (createArray n_ints 0) input
		where
			read_int_array i limit array input
				| i == limit
					= (array,input)
					
					#! (_,j,input)
						= freadi input
					= read_int_array (inc i) limit {array & [i] = j} input
					
		ReadSymbolArray :: !Int !*File -> (*{!Symbol},!*File)
		ReadSymbolArray limit input
			= read_symbol_array 0 limit (createArray limit EmptySymbol) input
		where
			read_symbol_array i limit array input
				| i == limit
					= (array,input)
					
					#! (symbol,input)
						= ReadSymbol input
					= read_symbol_array (inc i) limit {array & [i] = symbol} input
					
		
						
		/*
			#! (symbols,input)
		= ReadSymbolArray n_symbols input	
		*/
	


instance FromString (*SSymbolTable)
where
	FromString s
		#! (index, text_symbols)
			= DecodeDataType s 0
		#! (index, data_symbols)
			= DecodeDataType s index
		#! (index, bss_symbols)
			= DecodeDataType s index
		#! (index, imported_symbols)
			= DecodeDataType s index
		#! (index, section_symbol_ns)
			= DecodeDataType s index
		#! (index, symbols)
			= DecodeDataType s index
		= { SSymbolTable |
			text_symbols = text_symbols,
			data_symbols = data_symbols,
			bss_symbols = bss_symbols,
			imported_symbols = imported_symbols,
			section_symbol_ns = section_symbol_ns,
			symbols = symbols
		}

// -------------------------------------------------------------------------------
// *{!Symbol}
instance FromString (*{!Symbol})
where
	FromString s 
		#! (index, n_symbols)
			= DecodeInt s 0
		#! symbols_a
			= createArray n_symbols EmptySymbol
		#! symbols_a 
			//= from_string s_without_int symbols_a 0  0 
			= from_string s symbols_a 4 0 
		= symbols_a
	where
		from_string :: !String *{!Symbol} !Int !Int -> *{!Symbol}
		from_string s symbols_a old_index i
			| size symbols_a == i
				= symbols_a
				
				#! (new_index, symbol)
					= DecodeDataType s old_index 
				= from_string s { symbols_a & [i] = symbol} new_index (inc i)
// -------------------------------------------------------------------------------
// *{#Int}
instance FromString (*{#Int})
where
	FromString s
		#! (_,string)
			= DecodeString s 0
		#! int_a
			= createArray ((size string / 4) ) 0
		#! int_a	
			= from_string string int_a 0
		= int_a
	where
		from_string :: !String !*{#Int} !Int -> !*{#Int}
		from_string s int_a old_index
			| size s == old_index 
				= int_a
				
				#! (new_index, i)
					= DecodeInt s old_index
				= from_string s { int_a & [old_index / 4 ] = i} new_index

// -------------------------------------------------------------------------------
// SymbolIndexList
instance FromString SymbolIndexList
where
	FromString s
		| (size s) == 0
			= EmptySymbolIndex
			
			#! (index,i)
				= DecodeInt s 0
			= SymbolIndex i (tail_string s index)

// -------------------------------------------------------------------------------
// Symbol

ReadSymbol :: !*File -> (!Symbol,!*File)
ReadSymbol input
	#! (_,symbol_kind, input)
		= freadc input
	= case (toInt symbol_kind) of
		MODULE_SYMBOL
			#! (_,i0,input)
				= freadi input
			#! (_,i1,input)
				= freadi input		
			#! (_,i2,input)
				= freadi input
			#! (_,i3,input)
				= freadi input	
			#! (_,i4,input)
				= freadi input
			#! (_,i5,input)
				= freadi input	
			#! (_,s_size,input)
				= freadi input
			#! (s,input)
				= freads input s_size
			-> (Module i0 i1 i2 i3 i4 i5 s, input)
			
		LABEL_SYMBOL
			#! (_,i0,input)
				= freadi input
			#! (_,i1,input)
				= freadi input		
			#! (_,i2,input)
				= freadi input
			-> (Label i0 i1 i2, input)
			
		SECTIONLABEL_SYMBOL
			#! (_,i0,input)
				= freadi input
			#! (_,i1,input)
				= freadi input	
			-> (SectionLabel i0 i1, input)
		
		IMPORTLABEL_SYMBOL
			#! (_,s_size,input)
				= freadi input
			#! (s,input)
				= freads input s_size
			-> (ImportLabel s, input)
			
		IMPORTEDLABEL_SYMBOL
			#! (_,i0,input)
				= freadi input
			#! (_,i1,input)
				= freadi input	
			-> (ImportedLabel i0 i1, input)	
		
		IMPORTEDLABELPLUSOFFSET_SYMBOL
			#! (_,i0,input)
				= freadi input
			#! (_,i1,input)
				= freadi input		
			#! (_,i2,input)
				= freadi input
			-> (ImportedLabelPlusOffset i0 i1 i2, input)
			
		IMPORTEDFUNCTIONDESCRIPTOR_SYMBOL 
			#! (_,i0,input)
				= freadi input
			#! (_,i1,input)
				= freadi input	
			-> (ImportedFunctionDescriptor i0 i1, input)
			
		EMPTYSYMBOL_SYMBOL
			-> (EmptySymbol, input)	
/*	
	
				
			IMPORTEDFUNCTIONDESCRIPTOR_SYMBOL 
				#! (index, i0)
					= DecodeInt s index
				#! (index, i1)
					= DecodeInt s index
				-> (ImportedFunctionDescriptor i0 i1)
				
			EMPTYSYMBOL_SYMBOL
				-> EmptySymbol
*/

instance FromString Symbol
where
	FromString s
		#! (index, symbol_kind)
			= DecodeChar s 0
		= case (symbol_kind) of
			MODULE_SYMBOL
				#! (index, i0)
					= DecodeInt s index
				#! (index, i1)
					= DecodeInt s index
				#! (index, i2)
					= DecodeInt s index
				#! (index, i3)
					= DecodeInt s index
				#! (index, i4)
					= DecodeInt s index
				#! (index, i5)
					= DecodeInt s index
				#! (index, s)
					= DecodeString s index
				-> (Module i0 i1 i2 i3 i4 i5 s)
				
			LABEL_SYMBOL
				#! (index, i0)
					= DecodeInt s index
				#! (index, i1)
					= DecodeInt s index
				#! (index, i2)
					= DecodeInt s index
				-> (Label i0 i1 i2)
			
			SECTIONLABEL_SYMBOL
				#! (index, i0)
					= DecodeInt s index
				#! (index, i1)
					= DecodeInt s index
				-> (SectionLabel i0 i1)
				
			IMPORTLABEL_SYMBOL	
				#! (index, s)
					= DecodeString s index
				-> (ImportLabel s)
				
			IMPORTEDLABEL_SYMBOL
				#! (index, i0)
					= DecodeInt s index
				#! (index, i1)
					= DecodeInt s index
				-> (ImportedLabel i0 i1)
				
			IMPORTEDLABELPLUSOFFSET_SYMBOL
				#! (index, i0)
					= DecodeInt s index
				#! (index, i1)
					= DecodeInt s index
				#! (index, i2)
					= DecodeInt s index
				-> (ImportedLabelPlusOffset i0 i1 i2)
				
			IMPORTEDFUNCTIONDESCRIPTOR_SYMBOL 
				#! (index, i0)
					= DecodeInt s index
				#! (index, i1)
					= DecodeInt s index
				-> (ImportedFunctionDescriptor i0 i1)
				
			EMPTYSYMBOL_SYMBOL
				-> EmptySymbol
				
// -------------------------------------------------------------------------------
// LibraryList
instance FromString !LibraryList
where
	FromString s
		| (size s) == 0
			= EmptyLibraryList
			
			#! (index,string)
		 		= DecodeString s 0
		 	#! (index,i0)
		 		= DecodeInt s index
			#! (index, library_symbols_list)
		 		= DecodeDataType s index 		
		 	#! (index,i1)
		 		= DecodeInt s index
		 	#! library_list 
		 		= Library string i0 library_symbols_list i1 (tail_string s index)
			= library_list
			
instance FromString !LibrarySymbolsList
where
	FromString s
		| (size s) == 0
			= EmptyLibrarySymbolsList
		= LibrarySymbol symbol_s (tail_string s index)
	where
		(index,symbol_s)
			= DecodeString s 0
		rest_of_library_symbols_list_string
			= (s % (index, size s-1))
		tail_library_symbols_list
			= FromString rest_of_library_symbols_list_string

/*
** ReadNamesTable
*/
ReadNamesTable :: !*NamesTable !*File -> (!*NamesTable,!*File)
ReadNamesTable namestable input 
	= read_names_table_elements 0 /* n_names_table_elements*/ 1 namestable input	
	where 
		read_names_table_elements i limit namestable input
			#! (end,input)
				= fend input
			| end
				= (namestable,input)
				
				/*
				** Read NamesTableElement from input
				*/
				#! (s,input)
					= freadline input
				#! (_,i0,input)
					= freadi input
				#! (_,i1,input)
					= freadi input
				#! namestable
					= insert_symbol_in_symbol_table (s % (0, size s - 2)) i0 i1 namestable
				
				= read_names_table_elements (inc i) limit namestable input
				
/*
	insert_names_table_elements :: !NamesTableElement !NamesTable -> NamesTable
	insert_names_table_elements EmptyNamesTableElement namestable
		= namestable
	
	insert_names_table_elements (NamesTableElement s i0 i1 nte) namestable
		= insert_names_table_elements nte (insert_symbol_in_symbol_table s i0 i1 namestable)
*/

// -------------------------------------------------------------------------------
isComplementUpToDate :: !String -> (!Bool,!Bool);
isComplementUpToDate file_name
	= (True,True);
/*
	# file_name_without_extension
		= fst (ExtractPathFileAndExtension file_name);
	# (found,time_low,time_high)
		= FetchFileTime (file_name_without_extension +++ ".exe");
	# (found2,time_low2,time_high2)
		= FetchFileTime (file_name_without_extension +++ ".dat");
	#! result
		= CompareFileTimes time_low2 time_high2 time_low time_high;
				
	// .dat: just as old or newer as .exe 
	= (found2,result >  (-1));
*/
/*
E :: !.a .b -> .b;
E a b
	= b;
	
F :: !String .b -> .b;
F s b
	= E (fwrites s stderr) b;
*/
import DebugUtilities;

ReadState :: !String !*Files -> (!Bool,!*State,!*Files)
ReadState file_name files
	
	| F "ReadState begin" True
	= (True,EmptyState,files);
	
	#! (exists_dat_file,is_it_up_to_date)
		= isComplementUpToDate file_name
	| exists_dat_file && (not is_it_up_to_date) 
		= abort "ERROR (ReadState): complement does not exist or is not up-to-date";
		
	| not exists_dat_file
		= (False,EmptyState,files);
		
	#! (ok, input, files)
		= fopen file_name FReadData files
	| F file_name not ok
		= (ok,EmptyState,files)
	
	/*
	** Set filepointer to start
	*/
	#! (_,object_size,input)
		= freadi input //FReadInt input
	
	#! (ok, input)
		= fseek input (object_size+4) FSeekSet
	| not ok
		= abort "ReadState: fseek failed"

	/*
	** Read counters
	*/
	#! (_,n_libraries,input)
		= freadi input		
	#! (_,n_xcoff_files,input)
		= freadi input //FReadInt input
	#! (_,n_xcoff_symbols,input)
		= freadi input //FReadInt input
	#! (_,n_library_symbols,input)
		= freadi input //FReadInt input
			
	#! (library_list,input)
		= ReadLibraryList n_libraries EmptyLibraryList input
			
	/*
	** Read marked_bool_a 
	*/
	#! (marked_bool_a_size,input)
		= FReadInt input
	#! (marked_bool_a_s,input)
		= freads input marked_bool_a_size
	#! marked_bool_a
		= { check_bool c \\  c <-: marked_bool_a_s }
		
	/*
	** Read marked_offset_a
	*/
	#! (marked_offset_a_size,input)
		= FReadInt input
	#! marked_offset_a
		= createArray marked_offset_a_size 0
	#! (marked_offset_a,input)
		= f 0 marked_offset_a_size marked_offset_a input

	/*
	** Read module_offset_a
	*/
	#! (module_offset_a_size,input)
		= FReadInt input
	# module_offset_a
		= /*createArray module_offset_a_size 0;*/ { 0 \\ i <- [1..module_offset_a_size] }; //createArray module_offset_a_size 0

	
	#! (module_offset_a,input)
		= f 0 module_offset_a_size module_offset_a input
	
	/*
	** Read xcoff_a
	*/	
	#! xcoff_a
		= { empty_xcoff \\ i <- [1..n_xcoff_files] }
	#! (xcoff_a,input)
		= ReadXCoffArray 0 n_xcoff_files file_name xcoff_a input

//	| True
//		= abort (toString module_offset_a_size);
				
	//  Read NamesTable
	#! (namestable,input)
		= ReadNamesTable create_names_table input	
		 	
	#! (ok, files)
		= fclose input files
//	= (True,EmptyState,files);
//	| True
//		= abort (toString (size module_offset_a));
	=  F "ReadState end" (True,{ EmptyState &
			n_libraries = F "n_libraries" n_libraries

		,	n_xcoff_files = n_xcoff_files
		,	n_xcoff_symbols = n_xcoff_symbols
		,	n_library_symbols = n_library_symbols
		,	library_list = library_list

		,	marked_bool_a = F "marked_bool_a" marked_bool_a
		,	marked_offset_a = F "marked_offset_a" marked_offset_a
		,	module_offset_a = F ( "module_offset_a") module_offset_a
		,	xcoff_a = xcoff_a
		,	namestable = namestable	
		},files)
where
	check_bool bool_c
		= case bool_c of
			'T'
				-> True
			'F'	
				-> False 
			_
				-> abort "error"
				
	f i limit marked_offset_a input
		
		| i == limit
			= (marked_offset_a,input)
			
			#! (data,input)
				= FReadInt input
			= f (inc i) limit {marked_offset_a & [i] = data} input
			
		
/*	
	insert_names_table_elements :: !NamesTableElement !NamesTable -> NamesTable
	insert_names_table_elements EmptyNamesTableElement namestable
		= namestable
	
	insert_names_table_elements (NamesTableElement s i0 i1 nte) namestable
		= insert_names_table_elements nte (insert_symbol_in_symbol_table s i0 i1 namestable)
*/

ReadLibraryList :: !Int !LibraryList !*File -> (!LibraryList,!*File)
ReadLibraryList n_libraries ll input
	| n_libraries == 0
		= (ll,input)
	
		#! (s,input)
			= freadline input
		#! (_,i0,input)
			= freadi input
		#! (lsl,input)
			= ReadLibrarySymbolsList input
		#! (_,i1,input)
			= freadi input
		= ReadLibraryList (dec n_libraries) (Library (s % (0, size s - 2)) i0 lsl i1 ll) input
where
	ReadLibrarySymbolsList input
		#! (_,n_library_symbols,input)
			= freadi input
		#! (lsl,input)
			= read_library_symbols_list n_library_symbols EmptyLibrarySymbolsList input
		= (lsl,input)
	where
		read_library_symbols_list n_library_symbols lsl input
			| n_library_symbols == 0
				= (lsl,input)
	
				#! (s,input)
					= freadline input 
				= read_library_symbols_list (dec n_library_symbols) (LibrarySymbol (s % (0, size s - 2)) lsl) input