implementation module compute_graph;

import cg_name_mangling;
ALLOW_NESTED_DYNAMICS :== True;

import StdEnv;
import dynamics;
import read_dynamic;
import memory;
import ddState;
import ExtInt;
import ExtSystem;
import ExtList;
import RWSDebugChoice;
import ExtArray;
import pdExtInt;
import StdDynamicLowLevelInterface;
import BitSet;
import StdDynamicTypes;

import DebugUtilities;
G a b :== b;

:: *Prefixes = {
		prefix_kind_set	:: !Int
	,	base_addresses	:: !*{#Int}
	};
	
DefaultPrefix :: *Prefixes;
DefaultPrefix
	= { Prefixes |
		prefix_kind_set	= 0
	,	base_addresses	= createArray N_PREFIXES (-1)
	};
	
:: *DescriptorAddressTableEntry = {
		descriptor_name						:: !String
	,	module_name							:: !String
	,	prefixes							::  Prefixes //{Prefix}
	,	date_library_instance_nr_on_disk	:: !Int
	};
	
DefaultDescriptorAddressTableEntry :: DescriptorAddressTableEntry;
DefaultDescriptorAddressTableEntry
	= { DescriptorAddressTableEntry |
		descriptor_name	= ""
	,	module_name		= ""
	,	prefixes		= DefaultPrefix
	,	date_library_instance_nr_on_disk	= -1
	};
	
:: *DescriptorAddressTable
	= {
		desc_addr_table		:: !*{DescriptorAddressTableEntry}
	,	expanded_desc_table	:: !*{#Int}									// maps an expanded offset to its base index 
	,	indices_array		:: !*{{#Int}	}								// for each block indices in desc_addr_table
	,	root_nodes			:: !{(Int,Int)}									// (start_node_i,end_node_i)
	};
	
DefaultDescriptorAddressTable n_desc_entries
	# desc_table
		= { 
			desc_addr_table	= { DefaultDescriptorAddressTableEntry \\ i <- [1..n_desc_entries] }
		,	expanded_desc_table = {}
		,	indices_array	= {}
		,	root_nodes		= {}
		};
	= desc_table;
	
usize_desc_addr_table :: !*DescriptorAddressTable -> (!Int,*DescriptorAddressTable);
usize_desc_addr_table desc_table=:{desc_addr_table}
	#! (s_desc_table,desc_addr_table)
		= usize desc_addr_table;
	= (s_desc_table,{desc_table & desc_addr_table = desc_addr_table});


BuildDescriptorAddressTable :: !BinaryDynamic -> (!Int,!Int,!DescriptorAddressTable);
BuildDescriptorAddressTable dynamic_info=:{descriptor_usage_table}
	#! n_desc_entries
		= size descriptor_usage_table;
	#! desc_table
		= DefaultDescriptorAddressTable n_desc_entries
	#! n_prefix_per_base_a
		= createArray n_desc_entries (0,0);
		
	#! (max_desc_name,max_mod_name,desc_table,n_prefix_per_base_a,s_expanded_desc_table)
		= build 0 n_desc_entries desc_table 0 0 n_prefix_per_base_a 0;
		
	// build expanded descriptor offset array
	#! expanded_desc_table
		= createArray s_expanded_desc_table 0  
	#! expanded_desc_table
		= build_expanded_array 0 n_desc_entries 0 n_prefix_per_base_a expanded_desc_table
		
	#! desc_table
		= { desc_table &
			expanded_desc_table = expanded_desc_table
		};
	= (max_desc_name,max_mod_name,desc_table)
where {
	(binary_dynamic=:{stringtable})
		= dynamic_info;
		
	build_expanded_array :: !Int !.Int Int {(Int,Int)} !*{#Int} -> *{#Int};
	build_expanded_array i limit j n_prefix_per_base_a expanded_desc_table
		| i == limit
			= expanded_desc_table;
			
			#! ((base,n_prefixes_for_this_base),n_prefix_per_base_a)
				= n_prefix_per_base_a![i];
				
			#! (j,expanded_desc_table)
				= fill j n_prefixes_for_this_base base expanded_desc_table
			= build_expanded_array (inc i) limit j n_prefix_per_base_a expanded_desc_table;
	where {
		fill j 0 base expanded_desc_table
			= (j,expanded_desc_table);
		fill j n_prefixes_for_this_base base expanded_desc_table
			= fill (inc j) (dec n_prefixes_for_this_base) base {expanded_desc_table & [j] = base};
	} // build_expanded_array

	build i limit desc_table max_desc_name max_mod_name n_prefix_per_base_a s_expanded_desc_table
		| i == limit
			= (max_desc_name,max_mod_name,desc_table,n_prefix_per_base_a,s_expanded_desc_table)
		
		// retrieve info
		#! (_,string_offset, prefix_kind_set)
			= determine_prefixes3 descriptor_usage_table.[i].prefix_set_and_string_ptr;
			
		#! n_prefixes_for_this_base
			= set_length prefix_kind_set
		#! (prefix_kind_set,s_expanded_desc_table)
			= case n_prefixes_for_this_base of {
				0	-> abort "BuildDescriptorAddressTable; |prefix_kind_set| = 0 corrupt dynamic";
				_ 	-> (prefix_kind_set,s_expanded_desc_table + n_prefixes_for_this_base);
			};
		#! (descriptor_name,module_name)
			= get_descriptor_and_module_name2 string_offset	stringtable;
		
		// compute lengths
		#! max_desc_name	= max ((size descriptor_name) + count_length_of_expanded_string 0 (size descriptor_name) descriptor_name 0) max_desc_name;
		#! max_mod_name		= max ((size module_name) + count_length_of_expanded_string 0 (size module_name) module_name 0) max_mod_name;
			
		// build entry
		#! d
			= DefaultDescriptorAddressTableEntry;
		#! desc_entry
			= { d &
				descriptor_name						= descriptor_name
			,	module_name							= module_name
			,	prefixes							= { d.prefixes & prefix_kind_set = prefix_kind_set }
			,	date_library_instance_nr_on_disk	= descriptor_usage_table.[i].dus_library_instance_nr_on_disk
			};	
			
		#! n_prefix_per_base_a
			= { n_prefix_per_base_a & [i] = (i,n_prefixes_for_this_base) }
		= build (inc i) limit {desc_table & desc_addr_table.[i] = desc_entry} max_desc_name max_mod_name n_prefix_per_base_a s_expanded_desc_table
} // BuildDescriptorAddressTable

:: ArrayElement
	= IntElem
	| BoolElem
	| CharElem
	| RealElem
	| RecordElem !Int !Int !String
	
	// boxed array
	| BoxedElem
	;
	
:: *Nodes a
	= {
		node_i			:: !Int
	,	nodes 			:: !*{#Node a}
	};

:: Node a
	= {
		children	:: ![Child] 		//![Int]
	,	info		:: a
	,	graph_index	:: !Int
	};
	
:: Child 
	= Internal !Bool !Int				// ok? ref to definition node
	| External !Bool !Int				// ok? before fixup: NodeIndex see StdDynamicLowLevelInterface, afterwards: ref to definition node
	;
	
get_definition_node node_i :== get_definition_node node_i
where {
	get_definition_node (Internal True node_i)	= (True,node_i);		// (is_internal,node_i)
	get_definition_node (External True node_i)	= (False,node_i);
};

DefaultNode :: (Node a) | ToInfo a;	
DefaultNode 
	= { Node |
		children	= []
	,	info		= default_info
	,	graph_index	= 0
	};
		
DefaultNodes :: !Int -> *(Nodes a) | ToInfo a;
DefaultNodes n_nodes
	= { Nodes |
		node_i			= 0
	,	nodes			= let { n d = { d \\ i <- [1..n_nodes] }; } in n DefaultNode
	};

class ToInfo a
where {

	default_info :: a;
	is_definition_node :: a -> Bool;
	more_info ::  !Int a -> Bool;
	get_more_info :: !Int a !String -> String;

	int_to_info :: !Int !*{#Char} -> (a,!*{#Char});	
	char_to_info :: !Int !*{#Char} -> (a,!*{#Char});
	real_to_info :: !Int !*{#Char} -> (a,!*{#Char});
	bool_to_info :: !Int !*{#Char} -> (a,!*{#Char});
	closure_to_info :: !ClosureInfo !Int !*{#Char} -> (a,!*{#Char});
	indirection_to_info :: !Int !*{#Char} -> (a,!*{#Char});
	record_to_info :: !RecordInfo !Int !Int !String !Int !*{#Char} -> (a,!*{#Char});
	string_to_info :: !Int !Int !*{#Char} -> (a,!*{#Char});
	dynamic_to_info :: !Int !Int !Int !String !Int !*{#Char} -> (a,!*{#Char});
	array_to_info :: !ArrayInfo !Int !Int !ArrayElement !Int !*{#Char} -> (a,!*{#Char})
};

:: NodeKind
	= NK
	| IntLeaf !Int !BasicValue									// graph_i of associated Int
	| CharLeaf !Int !BasicValue									// graph_i of associated Char
	| RealLeaf !Int !BasicValue									// graph_i of associated Real
	| BoolLeaf !Int	!BasicValue									// graph_i of associated Bool
	| Closure !Int !ClosureInfo 								// n_boxed_args (superfluous = length of children
	| Indirection !Int											// node_i
	| Record !Int !Int !String !Int	!RecordInfo					// n_boxed_args (superfluous = length of children) size_of_unboxed_args (REAL takes two words) type_string (for each unboxed argument) graph_i (of first unboxed value)
	| StringLeaf !Int !Int !StringInfo							// length stringP of string info
	| Dynamic !Int !Int !Int !String !Int						// n_boxed_args (superfluous = length of children) size_of_extra_info size_of_unboxed_args (REAL takes two words) type_string (for each unboxed argument) graph_i (of first unboxed value)
	| ArrayNode !Int !Int !ArrayElement !Int !ArrayInfo 		// array_size elem_size element array_elem_start(graph_i)
	;
	
get_real_from_graph graph_i graph
	#! l
		= FromStringToInt graph graph_i;
	#! h
		= FromStringToInt graph (graph_i + 4);
	= (ints_to_real (l,h),graph);
	
get_char_from_graph graph_i graph
	= graph![graph_i];	
	
instance ToInfo NodeKind
where {
	default_info
		= NK;

	is_definition_node NK						= abort "is_definition; NK!";
	is_definition_node (Indirection _)			= False;
	is_definition_node _						= True;

	// index (1st arg of more_info) is the node *following* the descriptor
	// The descriptor has already been processed. more_info should deliver true for the complete node 
	// minus descriptor. i Is an index into the node
	more_info _ NK								= abort "more_info; NK";
	more_info 0 (IntLeaf _ _)						= True;
	more_info i (StringLeaf string_length _ _)
		/* layout
		** 0: length
		** 1: rest of string 
		*/
		#! i_max
			= (roundup_to_multiple string_length 4) >> 2;
		= not (i > i_max);
	more_info 0 (CharLeaf _ _)								= True;
	more_info i (RealLeaf _ _)								= (i == 0) || (i == 1);
	more_info 0 (BoolLeaf _ _)								= True;
	more_info i (Record _ s_unboxed_args _ _ _)				= abort "aa"; //i < s_unboxed_args;
	more_info i (Dynamic _ s_extra_info s_unboxed_args _ _)	= i < (s_extra_info + s_unboxed_args);
	
	more_info i (ArrayNode array_size elem_size elem _ _)
		#! array_size_in_bytes
			= ARRAY_DESC_ELEMS - 4 + (roundup_to_multiple (array_size * elem_size) 4) ;
		// note the -4!
		#! array_size_in_words
			= array_size_in_bytes >> 2;
		= if (elem == BoxedElem) 
			(i < ((ARRAY_DESC_ELEMS - 4) >> 2) )
			 (i < array_size_in_words);
	more_info _ _											= False;
	
	get_more_info _ (IntLeaf graph_i _) graph	
		= toString (FromStringToInt graph graph_i);
	get_more_info _ (CharLeaf graph_i _) graph
		= "'" +++ toString (toChar (FromStringToInt graph graph_i)) +++ "'";
	get_more_info i (RealLeaf graph_i _) graph
		| i == 0
			// little endian
			#! l
				= FromStringToInt graph graph_i;
			#! h
				= FromStringToInt graph (graph_i + 4);
			= toString (ints_to_real (l,h));
			= "skip";

	get_more_info _ (BoolLeaf graph_i _) graph	
		| FromStringToInt graph graph_i <> 0
			= "True";
			= "False";
	get_more_info i (StringLeaf string_length string_start _) graph
		| i == 0
			= "length: " +++ toString string_length;
		| i == 1
			#! s
				= get_chars i
			= "\"" +++ s +++ (if (size s <= 4) "\"" "");
			
		#! last_i
			= (roundup_to_multiple string_length 4) >> 2
		| i == last_i
			= get_chars i +++ "\""
			= get_chars i;
	where {
		get_chars i
			#! n_characters_consumed
				= (dec i) * 4;
			#! n_characters_present
				= min 4 (string_length - n_characters_consumed);
			#! s
				= graph % (string_start + n_characters_consumed,string_start + n_characters_consumed + (dec n_characters_present))
			= s;
	}

	get_more_info i (Dynamic n_boxed_args s_extra_info s_unboxed_args type_string graph_i) graph
		#! s 
			= case i of {
				0	
					#! offset_to_dynamic_end
						= FromStringToInt graph graph_i;
					-> ("value at " +++ hex_int_without_prefixed_zeroes (graph_i + offset_to_dynamic_end));
				1	
					#! offset_to_type_part
						= FromStringToInt graph (graph_i + 4);

					-> ("type at " +++ hex_int_without_prefixed_zeroes (graph_i + offset_to_type_part));
				i	
					-> "get_more_info i (Dynamic";
			};
		= s; 
	
	get_more_info i (Record n_boxed_args s_unboxed_args type_string graph_i _) graph
		#! (type_index,get_more_info_i)
			= determine_type 0 0 i type_string 
		#! graph_i
			= graph_i + i << 2;
		| type_string.[type_index] == 'b'
			#! s 
				= get_more_info get_more_info_i (BoolLeaf graph_i default_elem) graph;
			= s +++ " (Bool)";
		| type_string.[type_index] == 'r'
			#! s 
				= get_more_info get_more_info_i (RealLeaf graph_i default_elem) graph;
			= s +++ " (Real)";
		| type_string.[type_index] == 'i'
			#! s 
				= get_more_info get_more_info_i (IntLeaf graph_i default_elem) graph;
			= s +++ " (Int)";
		| type_string.[type_index] == 'c'
			#! s 
				= get_more_info get_more_info_i (CharLeaf graph_i default_elem) graph;
			= s +++ " (Char)";
	
		= abort ("more info <" +++ toString type_string.[type_index]);

	where {
		determine_type type_string_i j i type_string
			| type_string_i == (size type_string)
				= abort "q (internal error) too far";
				
			// type_string_i < i
			#! relative_limit
				= case type_string.[type_string_i] of {
					'r'	-> 2;
					'b'	-> 1;
					'i'	-> 1;
					'c'	-> 1;
				};
			#! (found,j,r)
				= w 0 relative_limit j i
			| found
				// i's associated type is at index type_string_i of type_string and its relative position for
				// get_more_info is r
				= (type_string_i,r)
				//abort ("ok i=" +++ toString i +++ " current type_string_i: " +++ toString type_string_i +++ " r=" +++ toString r);
			#! s
				= toString type_string_i +++ " - " +++ toString j +++ " - " +++ toString i;
			= determine_type (inc type_string_i) j i type_string;
		where {
			w r relative_limit j i
				| r == relative_limit
					= (False,j,999);
					
				| j == i
					= (True,j,r);
				= w (inc r) relative_limit (inc j) i;	
		}
	} // get_more_info i (Record ...
	
	get_more_info i (ArrayNode s_array s_elem elem  array_element_start_graph_i _) graph
		| G (toString i) i == 0
			= toString s_array +++ " elements";
		| i == 1
			= toString elem;
		
		// i offset
		#! offset
			= (i - 2) << 2;
		#! on_elem_boundary
			= s_elem < 4 /* for bools/chars */ || (offset rem s_elem == 0)
		| on_elem_boundary && elem == IntElem
			= "#" +++ (get_more_info 0 (IntLeaf (array_element_start_graph_i + offset) default_elem) graph);
		| on_elem_boundary && elem == RealElem
			= "#" +++ (get_more_info 0 (RealLeaf (array_element_start_graph_i + offset) default_elem) graph);
		| elem == BoolElem
			#! elem_offset
				= array_element_start_graph_i + offset;
			#! base_index
				= offset;
				
			#! d
				= extract_D_from_ABCD graph elem_offset;
			#! d_string
				= get_more_info 0 (BoolLeaf 0 default_elem) (FromIntToString d);
				
			#! c
				= extract_C_from_ABCD graph elem_offset
			#! c_string
				= get_more_info 0 (BoolLeaf 0 default_elem) (FromIntToString c);
			#! c_string2
				= if ((base_index + 1) < s_array) (" " +++ c_string) "";
						
			#! b
				= extract_B_from_ABCD graph elem_offset
			#! b_string
				= get_more_info 0 (BoolLeaf 0 default_elem) (FromIntToString b);
			#! b_string2
				= if ((base_index + 2) < s_array) (" " +++ b_string) "";
				
			#! a
				= extract_A_from_ABCD graph elem_offset
			#! a_string
				= get_more_info 0 (BoolLeaf 0 default_elem) (FromIntToString a);
			#! a_string2
				= if ((base_index + 2) < s_array) (" " +++ a_string) "";
			= "#" +++ d_string +++ c_string2 +++ b_string2 +++ a_string2;
		| elem == RecordElem 0 0 ""
			//  n_boxed_args s_unboxed_args type_string
			# (RecordElem n_boxed_args s_unboxed_args type_string)
				= elem;
			# record_elem
				= Record n_boxed_args s_unboxed_args type_string (array_element_start_graph_i + offset) default_elem;
			= "#" +++ (get_more_info 0 record_elem graph);
		| elem == BoxedElem
			= "boxed";
			= "";
				
	int_to_info int_i graph
		#! intje
			= FromStringToInt graph int_i;
		#! intje
			= BV_Int intje;
		= (IntLeaf int_i intje,graph);
	char_to_info char_i graph
		# (c,graph)
			= get_char_from_graph char_i graph;
	
		= (CharLeaf char_i (BV_Char c),graph);
	real_to_info char_i graph
		#! (realtje,graph)
			= get_real_from_graph char_i graph
		= (RealLeaf char_i (BV_Real realtje),graph);
		
	bool_to_info char_i graph
		#! bool_info
			= (FromStringToInt graph char_i) ;
		#! bool_info
			= BV_Bool (bool_info <> 0);
		= (BoolLeaf char_i bool_info,graph);
				
	closure_to_info closure_info n_boxed_args graph
		= (Closure  n_boxed_args closure_info,graph);
	indirection_to_info node_i graph
		= (Indirection node_i,graph);
	record_to_info record_info n_boxed_args s_unboxed_args type_string graph_i graph 
		= (Record n_boxed_args s_unboxed_args type_string graph_i record_info,graph);
	string_to_info string_length string_offset graph
		#! str
			= graph % (string_offset,dec string_offset + string_length);
		= (StringLeaf string_length string_offset {default_elem & si_string = str},graph);
	dynamic_to_info n_boxed_args s_extra_info s_unboxed_args type_string graph_i graph
		= (Dynamic n_boxed_args s_extra_info s_unboxed_args type_string graph_i,graph);
		
	array_to_info array_info s_array s_elem elem array_element_start_graph_i graph
		= (ArrayNode s_array s_elem elem  array_element_start_graph_i array_info,graph);
};

NewNode :: !Int !*(Nodes a) -> (!Int,!*(Nodes a));
NewNode graph_i nodes=:{node_i,nodes=nodes1}
	#! (s_nodes,nodes1)
		= usize nodes1;
	| node_i == s_nodes
		= abort ("NewNode: out of memory; node_i:" +++ toString node_i +++ " - s_nodes: " +++ toString s_nodes);
	= (node_i,{nodes & node_i = inc node_i, nodes = { nodes1 & [node_i].graph_index = graph_i}       });
	
GetNextFreeNode :: !*(Nodes a) -> (!Int,!*(Nodes a));
GetNextFreeNode nodes=:{node_i}
	= (node_i,nodes);
	
AddChild :: !Int !Int !Child !*(Nodes a) -> *(Nodes a);
AddChild parent offset child nodes
	#! (children,nodes)
		= nodes!nodes.[parent].children;
	= { nodes & 
		nodes.[parent].children = [child:children]
	};
where {
	get_node (Internal True n)	= n;
	get_node (External True n)	= n;
	get_node _					= abort "get_node; internal error";
};	
	
set_node_info :: (*{#Char} -> (a,!*{#Char})) !Int !*{#Char} (Nodes a) -> (Nodes a,!*{#Char}) | ToInfo a;
set_node_info f node_i graph nodes
	// set node info
	#! (node_info,graph)
		= f graph;
	#! nodes
		= { nodes & nodes.[node_i].Node.info = node_info  };	
	= (nodes,graph);

fxx :: !*{{#Int}	} -> *{{#Int}	};
fxx i = i;

fx2 :: !*{(Int,Int)} -> *{(Int,Int)};
fx2 i = i;

compute_nodes :: !*DescriptorAddressTable !BinaryDynamic !*DDState -> *(!*Nodes NodeKind,!*DescriptorAddressTable,!*DDState);
compute_nodes desc_table dynamic_info=:{header,descriptor_usage_table,block_table} ddstate //=:{project_name}
	| not (DYNAMIC_CONTAINS_BLOCKTABLE header)
		#! id = 0;
		#! nodes
			= DefaultNodes (inc (n_nodes ));
		#! (_,_,nodes,desc_table,ddstate,_,_)
			= compute_nodes2 id 0 {} nodes desc_table dynamic_info ddstate;
		= (nodes,desc_table,ddstate);
	
	// with block table
	#! n_nodes2
		= (n_nodes + (size block_table));
	#! nodes
		= DefaultNodes n_nodes2;
	#! indices_arrays
		= fxx { {} \\ i <- [1..size block_table] };
	#! root_nodes
		= fx2 (createArray (size block_table) (0,0));
	#! entry_node_fixup_table
		= { {} \\ i <- [1..size block_table] };
		
		
	#! s_block_table
		= size block_table;

	#! id = 0;
	#! (nodes,desc_table,ddstate,indices_arrays,root_nodes,entry_node_fixup_table)
		= loop 0 s_block_table id indices_arrays nodes desc_table ddstate root_nodes entry_node_fixup_table;		
		
	// fixup external nodes
	#! (nodes_array,nodes)
		= get_nodes nodes;
	#! nodes_array
		= fixup_external_references_in_nodes 0 n_nodes2 nodes_array entry_node_fixup_table;
	#! nodes 
		= { nodes &
			nodes	= nodes_array
		};
	
	// end
	#! desc_table
		= { desc_table & 
			indices_array = indices_arrays
		,	root_nodes 		= root_nodes
		};
	= (nodes,desc_table,ddstate);
where {	
	fixup_external_references_in_nodes :: !Int !Int !*{#Node NodeKind} !{#{#Int}} -> *{#Node NodeKind};	
	fixup_external_references_in_nodes i limit nodes_array entry_node_fixup_table
		| i == limit
			= nodes_array;
			
			# (node,nodes_array)
				= nodes_array![i];
			
			#! (children_with_external_refs,node_contains_external_references)
				= mapSt f node.children False;
			| node_contains_external_references
				#! nodes_array
					= { nodes_array & [i].children = children_with_external_refs};

				= fixup_external_references_in_nodes (inc i) limit nodes_array entry_node_fixup_table;

				= fixup_external_references_in_nodes (inc i) limit nodes_array entry_node_fixup_table;
	where {
		f node=:(External True node_index) node_contains_external_references
			# block_i
				= get_block_i node_index;
			# en_node_i
				= get_en_node_i node_index;
			# node_id
				= entry_node_fixup_table.[block_i,en_node_i];
			= (External True node_id,True);
		f node node_contains_external_references
			= (node,node_contains_external_references);
	} // fixup_external_references_in_nodes

	loop i limit id indices_arrays nodes desc_table ddstate root_nodes entry_node_fixup_table
		| i == limit
			= (nodes,desc_table,ddstate,indices_arrays,root_nodes,entry_node_fixup_table);

		| False <<- ("Block_i: ", i)
			= undef;

		#! (id,node_i,nodes,desc_table,ddstate,indices_arrays,to_node_id)
			= compute_nodes2 id i indices_arrays nodes desc_table dynamic_info ddstate;
				
		#! entry_node_fixup_table
			= { entry_node_fixup_table & [i] = to_node_id };
		#! (end_node_i,nodes)
			= GetNextFreeNode nodes;

		| False <<- ("block_i: ", i, " loop; start-node: ", inc node_i, "end-node: ",dec end_node_i)	
			= undef;

		= loop (inc i) limit id indices_arrays nodes desc_table ddstate 
			 { root_nodes & [i] = (inc node_i,dec end_node_i)} 
			entry_node_fixup_table;

	(binary_dynamic=:{header={n_nodes,graph_s,graph_i,stringtable_i,stringtable_s,descriptortable_i,descriptortable_s},stringtable,descriptortable,graph})
		= dynamic_info;
}

get_nodes :: !*(Nodes a) -> *(.{#Node a},*Nodes b);
get_nodes nodes=:{nodes=nodes1}
	= (nodes1,{nodes & nodes = {}});

from utilities import foldSt;

compute_nodes2 :: !Int !Int !*{{#Int}} !*(Nodes .NodeKind) !*DescriptorAddressTable !BinaryDynamic !*DDState ->
 *(!Int,!Int,!*Nodes NodeKind,!*DescriptorAddressTable,!*DDState,!*{{#Int}},!*{#Int});
compute_nodes2 id block_i indices_arrays nodes desc_table dynamic_info=:{header,descriptor_usage_table,block_table} ddstate //=:{project_name}
	
	// update desc_table with required addresses
	#! (id,addresses,ddstate)
		= get_label_addresses block_i id ddstate;

	| G ("size addresses: " +++ toString (size addresses)) size addresses < 0
		= abort "<0";		
	#! index_in_desc_addr_table
		= if (DYNAMIC_CONTAINS_BLOCKTABLE header) (createArray ((size addresses) >> 2) 0) {};

	#! (s_desc_table,desc_table)
		= usize_desc_addr_table desc_table;

	#! (desc_table,index_in_desc_addr_table)
		= store_label_addresses 0 s_desc_table desc_table 0 addresses index_in_desc_addr_table descriptor_usage_table block_i;

	#! (indices_arrays,graph,en_node_offsets,to_node_id)
		= case (DYNAMIC_CONTAINS_BLOCKTABLE header) of {
			True
				#! indices_arrays
					= { indices_arrays & [block_i] = index_in_desc_addr_table};
					
				#! bk_offset
					= block_table.[block_i].bk_offset;
				#! bk_size
					= block_table.[block_i].bk_size;
				#! bk_n_node_entries
					= block_table.[block_i].bk_n_node_entries;

				// BlockTable
				#! offset_and_block_id_list
					= if (bk_n_node_entries == 0) 
						[(0,0)]
						([ (block_table.[block_i].bk_entries.[index] - bk_offset ,index) \\ index <- [0..dec (size block_table.[block_i].bk_entries)] ]); // ++ [(0,0)])
				
				#! en_node_offsets
					= sortBy (\(offset1,_) (offset2,_) -> offset1 < offset2) 
						offset_and_block_id_list;
				#! to_node_id
					= createArray (length en_node_offsets) 0;
						
				#! (binary_dynamic=:{graph})
					= dynamic_info;
				#! graph
					= graph % (bk_offset, bk_offset + bk_size - 1);
					
				-> (indices_arrays,graph,en_node_offsets,to_node_id);
			False
				#! 	(binary_dynamic=:{graph})
					= dynamic_info;
				-> (indices_arrays,graph,[],{});
		};
	
	// compute nodes
	#! graph_u
		= {	c \\ c <-: graph };								// make graph unique
	#! (node_i,nodes)
		= NewNode (-1) (nodes);
		
		// BlockTable
	#! (bk_entries,block_table)
		= block_table![block_i].bk_entries;
		
	#! graph_u
		= foldSt (foo graph) [0.. dec ((size graph) >> 2)] graph_u;

	// decode graph
	#! (stringP,nodes,desc_table,ddstate,dynamics,graph_u,en_node_offsets,to_node_id)
		= case (size bk_entries) of {
			0	
				-> c 0 graph_u [node_i] nodes desc_table ddstate [] index_in_desc_addr_table en_node_offsets to_node_id;
			_	
				| False <<- ("MULTIPLE ENTRY NODES (" +++ toString (size bk_entries)+++ ")")
					->undef;
					-> mapASt (new_entry_node block_i node_i index_in_desc_addr_table) 
						bk_entries
						(0,nodes,desc_table,ddstate,[],graph_u,en_node_offsets,to_node_id);
		}; 

	| not (isEmpty en_node_offsets)
		// not all entry nodes of the current block have been used.
		= abort ("compute_nodes2; internal error; not all entry nodes of the current block have been used");
	| stringP <> bk_size
		= abort "compute_nodes2; wrong block size";	
	
	= (id,node_i,nodes,desc_table,ddstate,indices_arrays,to_node_id);
where {
	i :: {#Int} -> {#Int};
	i r
		= r;
		
	foo graph i graph_u
		#! (w,graph_u)
			= FromStringToIntU graph_u (i * 4)
		| False <<- (hex_int (bk_offset + i * 4), hex_int w)
			= undef;
		= graph_u;
		
	new_entry_node block_i node_i index_in_desc_addr_table entry_node_offset s=:(stringP,nodes,desc_table,ddstate=:{current_dynamic={block_table}},dynamics,graph_u,en_node_offsets,to_node_id)
		| stringP == block_table.[block_i].bk_size <<- ("new_entry_node",stringP)
			= s;
			= entry_node node_i index_in_desc_addr_table entry_node_offset s;
	
	entry_node node_i index_in_desc_addr_table entry_node_offset (stringP,nodes,desc_table,ddstate,dynamics,graph_u,en_node_offsets,to_node_id)

		| stringP <> entry_node_offset - bk_offset <<- ("entry_node",node_i,hex_int entry_node_offset)
			= abort ("!entry_node; wrong start of entry node; " 
			+++ toString stringP +++ " - " +++ toString (entry_node_offset - bk_offset) +++ " block_i: " +++ toString block_i 
				+++ "\nentry_node_offset: " +++ toString entry_node_offset 
				+++ "\nbk_offset: " +++ toString bk_offset);
				
		#! (s_graph_u,graph_u)
			= usize graph_u;
		#! (x,graph_u)
			= FromStringToIntU graph_u 0;
				
		| False <<- ("voor",stringP, s_graph_u, hex_int x)
			= undef;

		#! (stringP,nodes,desc_table,ddstate,dynamics,graph_u,en_node_offsets,to_node_id)
			= c stringP graph_u [node_i] nodes desc_table ddstate [] index_in_desc_addr_table en_node_offsets to_node_id;

		| False <<- ("na",stringP)
			= undef;

		= (stringP,nodes,desc_table,ddstate,dynamics,graph_u,en_node_offsets,to_node_id);

	({bk_size,bk_offset})
		= block_table.[block_i];
};

check_reference descP block_table
	| is_external_reference descP
		#! external_block_i
			= get_block_i descP;
		| not (between 0 external_block_i (dec s_block_table))
			#! msg 
				= "block " +++ toString external_block_i +++ " not between 0 and " +++ toString (dec s_block_table);
			= (False,Just msg);
			
			#! external_en_node_i
				= get_en_node_i descP;
			#! n_node_entries
				= inc (block_table.[external_block_i].bk_n_node_entries);
			| not (between 0 external_en_node_i n_node_entries)
				#! msg 
					= "en-node " +++ toString external_en_node_i +++ " of block " +++ toString external_block_i +++ " not between 0 and " +++ toString (dec n_node_entries);
				= (False,Just "");
				= (True,Nothing);
	| is_internal_reference descP <<- ("check_reference does NOT yet check internal reference")
		// should be checked
		= (True,Nothing)
				
where {
	s_block_table
		= size block_table;
};
		
c :: Int *{#Char} ![Int] *(Nodes NodeKind) *DescriptorAddressTable *DDState .a {#Int} [(Int,Int)] *{#Int} -> *(Int,*Nodes NodeKind,*DescriptorAddressTable,*DDState,.a,.{#Char},[(Int,Int)],.{#Int});
c stringP graph [] nodes desc_table ddstate dynamics _ en_node_offsets to_node_id
	= G "stop!"  (stringP,nodes,desc_table,ddstate,dynamics,graph,en_node_offsets,to_node_id);
c stringP graph temp=:[root_node:ns] nodes desc_table ddstate=:{current_dynamic={block_table}} dynamics index_in_desc_addr_table en_node_offsets to_node_id
	// check
	#! (s_graph,graph)
		= usize graph
	| G (toString stringP) stringP >= s_graph //<<- ("NEW_NODE -----------------------\n")
		| True <<- ("c",temp)
		
		#! s
			= toString stringP +++ " " +++ toString s_graph;
		= abort ("too big " +++ s +++ " " +++ toString ((length ns) + 1) +++ " <> " +++ toString (root_node));
		= abort "cannot match";
	// get descriptor
	#! (descP,graph)
		= FromStringToIntU graph stringP;

	#! q
		= " (" +++ toString (1 + length ns) +++ ") ";

	// 
	| isIndirection descP <<- (hex_int stringP +++ ": " +++ (hex_int descP) +++ q)
		#! (reference_ok,_)
			= check_reference descP block_table;
		| is_external_reference descP
			| False <<- ("EXTERNAL INDIRECTION", get_block_i descP, get_en_node_i descP)
				= undef;
			
			#! nodes
				= AddChild root_node stringP (External reference_ok descP) nodes;
			= G ("(external) indirection" ) c (stringP + 4) graph ns nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;
		| False <<- ("INTERNAL INDIRECTION")
			= undef;
		
		#! descP1 
			= (stringP - (get_offset_from_internal_reference descP));
		| False <<- ("stringP", stringP)
			= undef; 
		#! (node_i,graph)
			= case (descP1 < 0) of {
				True	-> (0,graph);
				_		-> FromStringToIntU3 graph descP1;
			};
		#! nodes
	  		= AddChild root_node stringP (Internal reference_ok node_i) nodes;

		= c (stringP + 4) graph ns nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;
		
	| descP == 0
		= abort "NULL descriptor";
	#! (j,descP,desc_table)
		= decode_descriptor descP desc_table index_in_desc_addr_table;
	| False <<- ("decode_descriptor", j, hex_int descP, "is closure", isClosure descP)
		= undef;
			
	// copy_descriptor
	#! (node_i,nodes)
		= NewNode stringP nodes;	// stringP relative w.r.t. block begin
	#! (l,en_node_offsets)
		= case ((isEmpty en_node_offsets) ) of {
			True
				-> (to_node_id,en_node_offsets);
			False
				# (offset,node_entry_i)
					= hd en_node_offsets;
				| offset == stringP
					// a definition of an entry node found
					#! to_node_id
						= { to_node_id & [node_entry_i] = node_i } <<- ("entry node found",node_i);
					-> (to_node_id,tl en_node_offsets);
					-> (to_node_id,en_node_offsets);
		}
	#! to_node_id
		= bug13 l; 
		
	#! nodes
		= AddChild root_node stringP (Internal True node_i) nodes;	
		
	#! graph
		= WriteLong graph stringP node_i;							// for indirections

	// test
	#! (descriptor_name,desc_table)
		= desc_table!desc_addr_table.[j].descriptor_name;
		
	| False <<- ("!!!",descriptor_name,stringP)
		= undef;


	| isClosure descP
		#! (arity,ddstate)
			= accMemClosure (readWord (descP - 4)) ddstate;

			
		#! temp_arity
			= arity
		#! arity
			= if (arity < 0) 1 arity		// neg. arities count as arity 1 (bug fix by John)
		
		| arity >= 256 <<- ("ARITY", arity)
			// unboxed closure
			#! n_unboxed_args
				= (arity >> 8) bitand 0x000000ff;
			#! arity
				= arity bitand 255;		
			#! n_boxed_args
				= arity - (arity bitand 255);
				
				
			#! (x,graph)
				= mapSt f [1..n_unboxed_args] graph;
			with {
				f ith_unboxed_arg graph
					#! (i,graph)
						= FromStringToIntU graph (stringP + (ith_unboxed_arg << 2));
					= (i,graph);
			
			};
			#! (a,stringP3,graph)
				= ({ BV_Unknown i \\ i <- x },stringP + 4 + (n_unboxed_args << 2),graph)
				
			#! closure_info
				= { default_elem &
					ci_closure_name			= descriptor_name
				,	ci_is_build_lazy_block	= NoLazyBlock
				,	ci_args					= { default_elem & 
												rai_unboxed_args	= a
											,	rai_n_boxed_args	= n_boxed_args
											}
				};
			#! (nodes,graph)
				= set_node_info (closure_to_info closure_info arity) node_i graph nodes;
				
			#! args
				= prepend_with_constants n_boxed_args node_i ns;
			= c stringP3 graph args nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;
							
			// boxed closure
			#! (build_lazy_block_label,ddstate)
				= ddstate!build_lazy_block_label;
			#! (stringP,arity,args,closure_info,graph)
				= case (descP == build_lazy_block_label) of {
					True
						// update node
						#! (node_index,graph)
							= FromStringToIntU graph (stringP + 4 + BUILD_LAZY_DYNAMIC_ON_DISK__NODE_INDEX);
						#! (dynamic_index,graph)
							= FromStringToIntU graph (stringP + 4 + BUILD_LAZY_DYNAMIC_ON_DISK__DYNAMIC_ID);
							
						
						#! closure_info
							= { default_elem &
								ci_closure_name = descriptor_name
							,	ci_is_build_lazy_block	= BuildLazyBlock node_index dynamic_index
							};
						#! arity
							= SHARING_ACROSS_CONVERSIONS 1 0;
						-> (stringP + BUILD_LAZY_DYNAMIC_ON_DISK__BSIZE,arity,prepend_with_constants arity node_i ns,closure_info,graph);

					_
						// update node
						#! closure_info
							= { default_elem &
								ci_closure_name = descriptor_name
							};
						-> (stringP,arity,prepend_with_constants arity node_i ns,closure_info,graph);
				};

			#! (nodes,graph)
				= set_node_info (closure_to_info closure_info arity) node_i graph nodes;
			= c (stringP + 4) graph args nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;

	| ddstate.int_descP + 2 == descP
		| False <<- ("INT")
			= undef;
			
		// update node
		#! (nodes,graph)
			= set_node_info (int_to_info (stringP + 4)) node_i graph nodes;
		= G "int" c (stringP + 8) graph ns nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;
	| ddstate.char_descP + 2 == descP
		// update node
		#! (nodes,graph)
			= set_node_info (char_to_info (stringP + 4)) node_i graph nodes;
		= G "char" c (stringP + 8) graph ns nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;
	| ddstate.bool_descP + 2 == descP
		// update node
		#! (nodes,graph)
			= set_node_info (bool_to_info (stringP + 4)) node_i graph nodes;
		= G "bool" c (stringP + 8) graph ns nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;
	| ddstate.real_descP + 2 == descP
		// update node
		#! (nodes,graph)
			= set_node_info (real_to_info (stringP + 4)) node_i graph nodes;
		= G "real" c (stringP + 12) graph ns nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;
	| ddstate.string_descP + 2 == descP
		#! (string_length,graph)
			= FromStringToIntU2 graph (stringP + 4);

		// update node
		#! (nodes,graph)
			= set_node_info (string_to_info string_length (stringP + 8)) node_i graph nodes;			
		= G "string" c (stringP + 8 + (roundup_to_multiple string_length 4)) graph ns nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;

	| ddstate.array_descP + 2 == descP
		// get descriptor
		#! (size,graph)
			= FromStringToIntU2 graph (stringP + ARRAY_DESC_SIZE);
		#! (elem_descP,graph)
			= FromStringToIntU2 graph (stringP + ARRAY_DESC_ELEM_DESCP);
		| elem_descP == ARRAY_DESC_BOXED_DESCP
			#! args
				= prepend_with_constants size node_i ns;
				
			// update node
			#! array_info
				= { default_elem &
					ai_element_descriptor	= AED_Boxed
				,	ai_n_elements			= size
				};
			#! (nodes,graph)
				= set_node_info (array_to_info array_info size 0 BoxedElem (stringP + ARRAY_DESC_ELEMS)) node_i graph nodes;
				
			= c (stringP + ARRAY_DESC_ELEMS) graph args nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;
				
		// convert encoded descP to real descP
		#! (j,elem_descP,desc_table)
			=  decode_descriptor elem_descP desc_table index_in_desc_addr_table;

		// get its name
		#! (descriptor_name,desc_table)
			= desc_table!desc_addr_table.[j].descriptor_name;
			
		| ddstate.int_descP + 2 == elem_descP	
			#! (array_info,stringP,graph)
				= CollectUnboxedArray BVK_Int size True (stringP + ARRAY_DESC_ELEMS) graph;
			#! (nodes,graph)
				= set_node_info (array_to_info array_info size 0 BoxedElem (stringP + ARRAY_DESC_ELEMS)) node_i graph nodes;
			= c stringP graph ns nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;

		| ddstate.char_descP + 2 == elem_descP
			= abort "char array";
		| ddstate.bool_descP + 2 == elem_descP
			#! (array_info,stringP,graph)
				= CollectUnboxedArray BVK_Bool size True (stringP + ARRAY_DESC_ELEMS) graph;
			#! (nodes,graph)
				= set_node_info (array_to_info array_info size 0 BoxedElem (stringP + ARRAY_DESC_ELEMS)) node_i graph nodes;
			= c stringP graph ns nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;

		| ddstate.real_descP + 2 == elem_descP
			#! (array_info,stringP,graph)
				= CollectUnboxedArray BVK_Real size True (stringP + ARRAY_DESC_ELEMS) graph;
			#! (nodes,graph)
				= set_node_info (array_to_info array_info size 0 BoxedElem (stringP + ARRAY_DESC_ELEMS)) node_i graph nodes;
			= c stringP graph ns nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;

			// UNBOXED RECORD ARRAY
			#! stringP
				= stringP + ARRAY_DESC_ELEMS;

			// {#Record}
			// -------------
			// unboxed args
			// ------------
			// boxed args
			#! (n_boxed_args,s_unboxed_args,type_string,ddstate)
				= decode_record_descriptor elem_descP ddstate;
			#! boxed_args_startP
				= stringP + ((s_unboxed_args << 2) * size);

			#! ai_record_args_info
				= { default_elem \\ _ <- [1..size] };
				
			#! (ai_record_args_info,stringP,type_string,graph)
				= loopAst collect_unboxed_record_arguments (ai_record_args_info,stringP,type_string,graph) size;
			| stringP <> boxed_args_startP
				= abort "internal error";
				
			// update node
			#! array_info
				= { default_elem &
					ai_element_descriptor	= AED_Record descriptor_name
				,	ai_n_elements			= size
				,	ai_record_args_info		= ai_record_args_info
				};
			
			| True <<- ("unboxed record", node_i, "size: ",size)
			#! (nodes,graph)
				= set_node_info (array_to_info array_info size 0 BoxedElem (stringP + ARRAY_DESC_ELEMS)) node_i graph nodes;

			#! ns
				= prepend_with_constants (n_boxed_args * size) node_i ns;
			#! stringP
				= boxed_args_startP;		
			= c stringP graph ns nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;

			= abort "unreachable";

		// RECORDS ----------------------------------------------------------------------------------------------------------------
		#! (n_boxed_args,s_unboxed_args,type_string,ddstate)
			=
				(case (ddstate.type_cons_symbol_label + 2 == descP) of {
					True 	-> (1,4,"i",ddstate);
					_		-> decode_record_descriptor_with_type_string descP ddstate;
				})

				;
		| True <<- ("RECORD; n_boxed_args: ", n_boxed_args, "s_unboxed_args: ", s_unboxed_args,descriptor_name)


		#! (a,stringP3,graph)
			= collect_unboxed_arguments type_string (stringP + 4) graph;
		#! record_args_info
			= { default_elem &
				rai_unboxed_args = a
			};
		#! record_info
			= { default_elem &
				ri_descriptor_name	= descriptor_name
			,	ri_args				= record_args_info
			};
				
		#! (nodes,graph)
			= set_node_info (record_to_info record_info n_boxed_args s_unboxed_args type_string (stringP + 4)) node_i graph nodes;


		#! ns
			= prepend_with_constants (n_boxed_args) node_i ns;
		=  c stringP3 graph ns nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;
where {
	collect_unboxed_record_arguments ith_record_args_info (ai_record_args_info,stringP,type_string,graph)
		#! (basic_value_a,stringP,graph)
			= collect_unboxed_arguments type_string stringP graph;
		#! ai_record_args_info
			= { ai_record_args_info & [ith_record_args_info] = { default_elem & rai_unboxed_args = basic_value_a } };
		= (ai_record_args_info,stringP,type_string,graph);
};

collect_boxed_elements _ (args,stringP,graph)
	#! i
		= FromStringToInt graph stringP;
	= ([i:args],stringP,graph);

CollectUnboxedArray basic_value_kind size is_unboxed_record stringP graph
	#! type_string
		= case basic_value_kind of {
			BVK_Int
				-> createArray size 'i';
			BVK_Bool
				-> createArray size 'b';
			BVK_Real
				-> createArray size 'r';
		};
		
	#! (a,stringP,graph)
		= collect_unboxed_arguments2 is_unboxed_record type_string stringP graph;
		
	#! record_args_info
		= { default_elem &
			rai_unboxed_args = a
		};

	#! array_info
		= { default_elem &
			ai_element_descriptor	= AED_BasicValue basic_value_kind
		,	ai_n_elements			= size
		,	ai_record_args_info		= {record_args_info}
		};
	= (array_info,stringP,graph);

import runtime_system;

collect_unboxed_arguments type_string stringP graph 
	:== collect_unboxed_arguments2 False type_string stringP graph;

collect_unboxed_arguments2 :: !Bool !{#Char} .Int !u:{#Char} -> ({BasicValue},Int,!v:{#Char}), [u <= v];
collect_unboxed_arguments2 is_unboxed_value_record type_string stringP graph
	| False <<- type_string
		= undef;
	#! rai_n_unboxed_args
		= n_unboxed_arguments type_string;
	| rai_n_unboxed_args == 0
		= ({},stringP,graph);
		
	#! rai_unboxed_args
		= createArray rai_n_unboxed_args BV_Invalid;
	#! (_,stringP,rai_unboxed_args,graph)
		= mapASt collect_unboxed_argument type_string (0,stringP,rai_unboxed_args,graph);
		
	#! stringP
		= if is_unboxed_value_record (roundup_to_multiple stringP ALIGNMENT) stringP;
	= (rai_unboxed_args,stringP,graph);
where {
	collect_unboxed_argument 'i' (ith_unboxed_arg,stringP,rai_unboxed_args,graph)
		#! int_value
			= FromStringToInt graph stringP;
		#! rai_unboxed_args
			= { rai_unboxed_args & [ith_unboxed_arg] = BV_Int int_value };
		= (inc ith_unboxed_arg,stringP + 4,rai_unboxed_args,graph);

	collect_unboxed_argument 'b' (ith_unboxed_arg,stringP,rai_unboxed_args,graph)
		| is_unboxed_value_record
			#! bool_value
				= toInt (graph.[stringP]) <> 0;
			#! rai_unboxed_args
				= { rai_unboxed_args & [ith_unboxed_arg] = BV_Bool bool_value };
			= (inc ith_unboxed_arg,stringP + 1,rai_unboxed_args,graph);
			
			// unboxed records:
			#! bool_value
				= FromStringToInt graph stringP <> 0;
			#! rai_unboxed_args
				= { rai_unboxed_args & [ith_unboxed_arg] = BV_Bool bool_value };
			= (inc ith_unboxed_arg,stringP + 4,rai_unboxed_args,graph);

	collect_unboxed_argument 'c' (ith_unboxed_arg,stringP,rai_unboxed_args,graph)
		| is_unboxed_value_record
			#! (char_value,graph)
				= get_char_from_graph stringP graph;
			#! rai_unboxed_args
				= { rai_unboxed_args & [ith_unboxed_arg] = BV_Char char_value };
			= (inc ith_unboxed_arg,stringP + 1,rai_unboxed_args,graph);
			
	
			// unboxed records:
			#! (char_value,graph)
				= get_char_from_graph stringP graph; 
			#! rai_unboxed_args
				= { rai_unboxed_args & [ith_unboxed_arg] = BV_Char char_value };
			= (inc ith_unboxed_arg,stringP + 4,rai_unboxed_args,graph);
			
	collect_unboxed_argument 'r' (ith_unboxed_arg,stringP,rai_unboxed_args,graph)
		#! (real_value,graph)
			= get_real_from_graph stringP graph;
		#! rai_unboxed_args
			= { rai_unboxed_args & [ith_unboxed_arg] = BV_Real real_value };
		= (inc ith_unboxed_arg,stringP + 8,rai_unboxed_args,graph);
	
	collect_unboxed_argument 'd' s
		= s;
	collect_unboxed_argument 'a' s
		= s;
	collect_unboxed_argument 'l' s
		= s;
		
	collect_unboxed_argument q s
		= abort ("collect_unboxed_argument" +++ toString q);
};



do_record n_boxed_args s_unboxed_args type_string descriptor_name stringP graph node_i nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id
	| True <<- ("do_record", descriptor_name)
	// unboxed part
	#! (a,_,graph)
		= collect_unboxed_arguments type_string (stringP + 4) graph;
		
	#! record_args_info
		= { default_elem &
			rai_unboxed_args = a
		};

	#! record_info
		= { default_elem &
			ri_descriptor_name	= descriptor_name
		,	ri_args				= record_args_info
		};
			
	#! (nodes,graph)
		= set_node_info (record_to_info record_info n_boxed_args s_unboxed_args type_string (stringP + 4)) node_i graph nodes;

	// boxed_part
	# new_stringP
		= (stringP + 4 /* skip descp */ + (s_unboxed_args << 2));
		
	# (new_stringP2,graph,nodes,desc_table,ddstate,dynamics,index_in_desc_addr_table,en_node_offsets,to_node_id)
		= foldSt (do_boxed_record_fields node_i) [1..n_boxed_args] 
		(new_stringP,graph,nodes,desc_table,ddstate,dynamics,index_in_desc_addr_table,en_node_offsets,to_node_id);

 	= (dynamics,[],"record",s_unboxed_args,nodes,graph /*added */ ,new_stringP2, desc_table, ddstate, index_in_desc_addr_table,en_node_offsets,to_node_id);
where {
	do_boxed_record_fields parent_node_i _ (stringP,graph,nodes,desc_table,ddstate,dynamics,index_in_desc_addr_table,en_node_offsets,to_node_id)
		| True <<- ("do_boxed_record_fields", stringP)
		#! (stringP,nodes,desc_table,ddstate,dynamics,graph,en_node_offsets,to_node_id)
			= c stringP graph [parent_node_i] nodes desc_table ddstate dynamics index_in_desc_addr_table en_node_offsets to_node_id;
		= (stringP,graph,nodes,desc_table,ddstate,dynamics,index_in_desc_addr_table,en_node_offsets,to_node_id);
};
		
	// work-around for a type-bug in 1.3
bug13 :: *{#Int} -> *{#Int};
bug13 i
	= i;
		
accMem3 :: (*Mem -> (!x,*Mem)) !DDState -> (!x,!DDState);
accMem3 f ddState=:{mem}
	#! (x,mem)
		= f mem;
	= (x,{ ddState & mem = mem }); 
	
accMemClosure f ddState=:{mem}
	#! (x,mem)
		= f mem;
	= (x,{ ddState & mem = mem }); 

prepend_with_constants :: !Int a [a] -> [a];
prepend_with_constants n_constants n list
	| n_constants < 0 
		= abort ("ff" +++ toString n_constants)
	| n_constants == 0 <<- ("prepend_with_constants", n_constants)
		= list;
	= prepend_with_constants (dec n_constants) n [n:list];

decode_descriptor :: !Int !DescriptorAddressTable {#Int} -> (!Int,!Int,!DescriptorAddressTable);
decode_descriptor prefix_set_and_desc_ptr desc_table index_in_desc_addr_table
	// decode descriptor
	#! encoded_descriptor
		= get_encoded_descriptor prefix_set_and_desc_ptr;
	| is_boxed encoded_descriptor <<- ("!!!",convert_to_descriptor_usage_entry encoded_descriptor, size index_in_desc_addr_table)
		= (abort "decode_descriptor; offset is 0");		
	#! offset
		= (index_in_desc_addr_table.[convert_to_descriptor_usage_entry encoded_descriptor]);
		
	#! (prefix_kind_set,desc_table)
		= desc_table!desc_addr_table.[offset].prefixes.prefix_kind_set;
	#! (descriptor_name,desc_table)
			= desc_table!desc_addr_table.[offset].descriptor_name;
			
	| False <<- ("decode_descriptor",descriptor_name, offset)
		= undef;

	// new
	#! bit_n
		= (prefix_set_and_desc_ptr >> (32 - 3)) bitand 7;

	| is_closure_prefix prefix_set_and_desc_ptr
		#! bit_n
			= G (fwrites (" bit_n: " +++ toString bit_n) stderr) bit_n;
		
		#! desc_table
			= check prefix_set_and_desc_ptr offset bit_n desc_table;
		#! (descP,desc_table)
			= desc_table!desc_addr_table.[offset].prefixes.base_addresses.[bit_n];
			
		= (offset,descP,desc_table);
		
		#! partial_arity
			= (prefix_set_and_desc_ptr >> 24) bitand 0x0000001f;
		#! desc_table
 			= check prefix_set_and_desc_ptr offset bit_n desc_table;
		#! (descP,desc_table)
			= desc_table!desc_addr_table.[offset].prefixes.base_addresses.[bit_n];
		
		#! descP2
			= descP + 2 + (partial_arity << 3);			
		= G (fwrites (" * " +++ hex_int descP +++ " ") stderr) (offset,descP2,desc_table);		
where {
	is_closure_prefix descP
		#! descP
			= descP bitand 0xe0000000;
		= (descP == NPREFIX_VALUE) || (descP == CPREFIX_VALUE);
}

decode_descriptor prefix_set_and_desc_ptr desc_table index_in_desc_addr_table
	= abort "rule mismatch";
		
isIndirection :: !Int -> Bool;
isIndirection descP 
		= is_reference descP;
	
isClosure :: !Int -> Bool;
isClosure descP
	#! is_closure 
		= descP bitand 2 == 0;
	= is_closure;
	
check descP offset bit_n desc_table
	#! (prefix_kind_set,desc_table)
		= desc_table!desc_addr_table.[offset].prefixes.prefix_kind_set;
	| prefix_kind_set bitand (1 << bit_n) == 0
		#! s
			="check: prefix not in set (bit_n)=" +++ toString bit_n +++ " prefix_kind_set= " +++ toString prefix_kind_set +++ " descP=" +++ hex_int descP;
		#! (descriptor_name,desc_table)
			= desc_table!desc_addr_table.[offset].descriptor_name;

		#! s
			= s +++ descriptor_name;
		= abort s;
		#! s
			= toString prefix_kind_set
		= desc_table;
	
store_label_addresses i limit desc_table j addresses index_in_desc_addr_table descriptor_usage_table block_i
	| i == limit
		= (desc_table,index_in_desc_addr_table);

	// has a block table 
	#! (is_element,_)
		= isBitSetMember descriptor_usage_table.[i].bitset block_i;
	| not is_element
		= store_label_addresses (inc i) limit desc_table j addresses index_in_desc_addr_table descriptor_usage_table block_i;

		// copy from above ...
		#! (prefix_kind_set,desc_table)
			= desc_table!desc_addr_table.[i].prefixes.prefix_kind_set
		#! (prefix_found,first_prefix_bit_n,j,desc_table,index_in_desc_addr_table)
			= store_address_for_each_prefix (dec N_PREFIXES) prefix_kind_set j desc_table index_in_desc_addr_table;
		= store_label_addresses (inc i) limit desc_table j addresses index_in_desc_addr_table descriptor_usage_table block_i;
		// ... copy from above
where {
	store_address_for_each_prefix bit_n prefix_kind_set j desc_table index_in_desc_addr_table
		#! (prefix_found,bit_n)
			= find_prefix bit_n prefix_kind_set;
		| not prefix_found
			= (False,-1,j,desc_table,index_in_desc_addr_table);
						
			#! (mouse_name,desc_table)
				= desc_table!desc_addr_table.[i].descriptor_name;
			#! mouse
				= FromStringToInt addresses j;
			| True <<- (mouse_name +++ " - "  +++ toString mouse +++ "j= " +++ toString j ) 
			
			#! desc_table
				= { desc_table & desc_addr_table.[i].prefixes.base_addresses.[bit_n] = mouse };
			#! index_in_desc_addr_table
				= { index_in_desc_addr_table & [j>>2] = i };
				
			= store_address_for_each_prefix (dec bit_n) prefix_kind_set (j + 4) desc_table index_in_desc_addr_table;
}

get_label_addresses :: !Int !Int !*DDState -> (!Int,!String,!*DDState);
get_label_addresses block_i id ddstate=:{first_time,project_name}
	| not (replace_command_line ("\"" +++ project_name +++ "\""))
		= abort "get_label_address; internal error";

	// send paths
	#! (msg,ddstate)
		= case first_time of {
			True
				// link project
				#! msg
					= doreqS ("DumpDynamic\n");
				| msg <> msg
					-> abort "get_label_addresses: (internal error)";
					
				#! msg = "";
				-> (msg,ddstate);
			False
				-> ("",ddstate);
		};
				
	| msg == msg
		# (file_name,ddstate)
			= ddstate!DDState.file_name;
			
		# is_initialization
			= (block_i == 0);
		# (id,_,s_adr)
			= LinkBlock file_name is_initialization id block_i;
		| is_initialization && (s_adr == s_adr)
			// get standard descriptors
			#! msg
				= "GetLabelAddressesINT\nCHAR\nBOOL\nREAL\n__STRING__\n__ARRAY__\ne____SystemDynamic__rDynamicTemp\n" 
					+++ BUILD_BLOCK_LABEL +++ "\n" +++ BUILD_LAZY_BLOCK_LABEL +++ "\n";
			#! addresses
				= doreqS msg;
			
			// update ddstate
			#! ddstate
				= { ddstate &
					first_time 		= False
				,	int_descP		= FromStringToInt addresses 0
				,	char_descP		= FromStringToInt addresses 4
				,	bool_descP		= FromStringToInt addresses 8
				,	real_descP		= FromStringToInt addresses 12
				,	string_descP	= FromStringToInt addresses 16
				,	array_descP		= FromStringToInt addresses 20
				,	e__StdDynamic__rDynamicTemp = FromStringToInt addresses 24
				,	build_block_label			= FromStringToInt addresses 28
				,	build_lazy_block_label		= FromStringToInt addresses 32
				};
				
			// strip 'garbage'
			= (id,s_adr,ddstate);			 
		= (id,s_adr,ddstate);
		
doreqS :: !String -> String;
doreqS s = 
	code { 
		ccall DoReqS "S-S"
	}

instance toString ArrayElement
where {
	toString IntElem	= "Unboxed INT";
	toString CharElem	= "Unboxed CHAR";
	toString BoolElem	= "Unboxed BOOL";
	toString RealElem	= "unboxed REAL";
	toString BoxedElem	= "Boxed elements";
	toString (RecordElem	_ _ _) = "Record element";
};

instance == ArrayElement
where {
	(==) IntElem IntElem		= True;
	(==) CharElem CharElem		= True;
	(==) BoolElem BoolElem 		= True;
	(==) RealElem RealElem		= True;
	(==) BoxedElem BoxedElem	= True;
	(==) (RecordElem _ _ _) (RecordElem	_ _ _) = True;
	(==) _ _ 					= False;
};

// decode_array_elem_descP element_descriptor ddstate -> (is_unboxed,Array Element)
decode_array_elem_descP elem_descP ddstate
	// boxed array
	| 0 == elem_descP
		= (False,BoxedElem,4,ddstate);

	// unboxed array
	| ddstate.int_descP + 2 == elem_descP
		= (True,IntElem,4,ddstate);
	| ddstate.bool_descP + 2 == elem_descP
		= (True,BoolElem,1,ddstate);
	| ddstate.real_descP + 2 == elem_descP
		= (True,RealElem,8,ddstate);
		
	// unboxed record array
	#! (record_descriptor_size,ddstate)
		= size_of elem_descP ddstate
	#! (n_boxed_args,s_unboxed_args,type_string,ddstate)
		= decode_record_descriptor elem_descP ddstate;

	= (True,RecordElem n_boxed_args s_unboxed_args type_string,record_descriptor_size,ddstate);
	
size_of descP ddstate
	| ddstate.int_descP + 2 == descP
		= abort "size_of int";
	| ddstate.char_descP + 2 == descP
		= abort "size_of char";
	| ddstate.bool_descP + 2 == descP
		= abort "size_of bool";
	| ddstate.real_descP + 2 == descP
		= abort "size_of real";
	| descP == 0
		= abort "size_of boxed";

		// record descriptor
		# (n_boxed_args,s_unboxed_args,type_string,ddstate)
			= decode_record_descriptor descP ddstate
		# record_descriptor_size
			= (s_unboxed_args + n_boxed_args) * 4
		= (record_descriptor_size,ddstate);

// Utility
set_length :: !Int -> Int;
set_length index
	| index < 0 || index > 255
		= abort "set_length: index out of range";
	= set.[index];
where {
	set :: {#Int};
	set =>
    {
	/*   0-15  */	0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4,
	/*  16-31  */	1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
	/*  32-47  */	1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
	/*  48-63  */	2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
	/*  64-79  */	1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
	/*  80-95  */	2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
	/*  96-111 */	2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
	/* 112-127 */	3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
	/* 128-143 */	1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
	/* 144-159 */	2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
	/* 160-175 */	2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
	/* 176-191 */	3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
	/* 192-207 */	2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
	/* 208-223 */	3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
	/* 224-239 */	3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
	/* 240-255 */	4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8
    };
 }
 
// 
FromStringToIntU2 :: !*{#Char} !Int -> (!Int,!*{#Char});
FromStringToIntU2 array i	
	#! (v0,array)
		= array![i];
	#! (v1,array)
		= array![i+1];
	#! (v2,array)
		= array![i+2];
	#! (v3,array)
		= array![i+3];
	#! i
		= (toInt v0)+(toInt v1<<8)+(toInt v2<<16)+(toInt v3<<24);
	= (i,array);
	
FromStringToIntU3 :: !*{#Char} !Int -> (!Int,!*{#Char});
FromStringToIntU3 array i	
	| False <<- i
		= undef;
		
		# i = 
			i - 10;
		# i = 
			i + 10;
	#! (v0,array)
		= array![i];
	#! (v1,array)
		= array![i+1];
	#! (v2,array)
		= array![i+2];
	#! (v3,array)
		= array![i+3];
	#! i 
		= (toInt v0)+(toInt v1<<8)+(toInt v2<<16)+(toInt v3<<24);
	= (i,array);
	
accMem1 :: (*Mem -> (!x,*Mem)) !DDState -> (!x,!DDState);
accMem1 f ddState=:{mem}
	#! (x,mem)
		= f mem;
	= (x,{ ddState & mem = mem }); 
		
decode_record_descriptor_with_type_string :: !Int !*DDState -> (!Int,!Int,!String,!*DDState);
decode_record_descriptor_with_type_string descP ddstate
	#! (arity,ddstate)
		= accMem1 (readHalfWord (descP - 2)) ddstate;

	| True <<- ("decode_record_descriptor_with_type_string ", arity)

	#! (n_boxed_args,s_unboxed_args,type_string,ddstate)
		= case (arity >= 256) of {
			True
				| True <<- ("DECODE_RECORD_DESCRIPTOR")
				#! (n_boxed_args,ddstate)
					= accMem2 (readHalfWord descP) ddstate;
				#! n_unboxed_args
					= (arity - 256) - n_boxed_args;
				// note: |type_string| need not equal n_unboxed_args because reals take two bytes
				#! (type_string,ddstate)
					= get_type_string (descP + 2) ddstate;
				-> (n_boxed_args,n_unboxed_args,type_string,ddstate);
			False
				-> (arity,0,"",ddstate);
		};
	= (n_boxed_args,s_unboxed_args,type_string,ddstate);
where {
	get_type_string pointer ddstate
		#! (s_type_string,ddstate)
			= type_string_size pointer ddstate 0;
		#! (_,type_string,ddstate)
			= loopAst collect_type_string (pointer,createArray s_type_string ' ',ddstate) s_type_string;
		= (type_string,ddstate);
	where {
		type_string_size pointer ddstate size1
			#! (c,ddstate)
				= accMem2 (readByte pointer) ddstate;
			| (toChar c) <> '\0'
				= type_string_size (inc pointer) ddstate (inc size1);
				= (size1,ddstate);
				
		collect_type_string i (pointer,type_string,ddstate)
			#! (c,ddstate)
				= accMem2 (readByte pointer) ddstate;
			#! type_string 
				= { type_string & [i] = toChar c };
			= (inc pointer,type_string,ddstate);
	};
};

decode_record_descriptor :: !Int !*DDState -> (!Int,!Int,!String,!*DDState);
decode_record_descriptor descP ddstate
	= decode_record_descriptor_with_type_string descP ddstate;

decode_record_descriptor_old :: !Int !*DDState -> (!Int,!Int,!String,!*DDState);
decode_record_descriptor_old descP ddstate
	#! (arity,ddstate)
		= accMem1 (readHalfWord (descP - 2)) ddstate;
	#! (n_boxed_args,s_unboxed_args,type_string,ddstate)
		= case (arity >= 256) of {
			True
				#! (n_boxed_args,ddstate)
					= accMem2 (readHalfWord descP) ddstate;
				#! n_unboxed_args
					= (arity - 256) - n_boxed_args;
				// note: |type_string| need not equal n_unboxed_args because reals take two bytes
				#! (type_string,ddstate)
					= case (n_unboxed_args == 0) of { //(n_unboxed_args == 0) of {
						True 	-> ("compute_graph; line 865",ddstate);
						False	-> F ("** " +++ toString n_boxed_args) types_of_unboxed_fields (descP + 2) ddstate;
					};
				-> (n_boxed_args,n_unboxed_args,type_string,ddstate);
			False
				-> (arity,0,"",ddstate);
		};
	= (n_boxed_args,s_unboxed_args,type_string,ddstate);
where {
	// assumption: at least one unboxed arguments 
	types_of_unboxed_fields type_string_p1 ddstate
		#! (type_string_pstart,ddstate)
			= skip_d_and_boxed_args type_string_p1 ddstate;
		#! (type_string_pend,ddstate)
			= type_string_length type_string_pstart ddstate;
		#! type_string_length
			= type_string_pend - type_string_pstart;
			
		#! (type_string,ddstate)
			= collect_type_info 0 type_string_length type_string_pstart (createArray type_string_length ' ') ddstate;
		= (type_string,ddstate);
	where {
		skip_d_and_boxed_args type_string_p ddstate
			#! (c,ddstate)
				= accMem2 (readByte type_string_p) ddstate;
			#! c
				= toChar c;
			| c == 'd' || c == 'a'
				= skip_d_and_boxed_args (inc type_string_p) ddstate;
				= (type_string_p,ddstate);				
				
		type_string_length type_string_p ddstate
			#! (c,ddstate)
				= accMem2 (readByte type_string_p) ddstate;
			#! c
				= toChar c;
			| c == '\0'
				= ( type_string_p,ddstate);
				= type_string_length (inc type_string_p) ddstate;
		
		collect_type_info i limit type_string_p type_string ddstate
			| i == limit
				= (type_string,ddstate);

			#! (c,ddstate)
				= accMem2 (readByte type_string_p) ddstate;
			= collect_type_info (inc i) limit (inc type_string_p) {type_string & [i] = toChar c} ddstate;
	} // types_of_unboxed_fields
}

accMem2 f ddState=:{mem}
	#! (x,mem)
		= f mem;
	= (x,{ ddState & mem = mem }); 

// RunTime graph
:: RunTimeGraph
	= BasicValueInfo !Int
	| RecordInfo !RecordInfo
	;

:: BasicValue
	= BV_Invalid
	| BV_Char !Char
	| BV_Int !Int
	| BV_Bool !Bool
	| BV_Real !Real
	| BV_Unknown !Int
	;
	
		
instance DefaultElem BasicValue
where {
	default_elem 
		= BV_Invalid;
};

			
:: NodeRefInfo 
	= EntryNode !Int
	| NodeRef !Int
	;
		
:: RecordInfo
	= {
		ri_descriptor_name	:: !String
	,	ri_args				:: !RecordArgsInfo
	};
	
:: RecordArgsInfo
	= {
		rai_unboxed_args	:: {BasicValue}
	,	rai_n_boxed_args	:: !Int
	};
	
instance DefaultElem RecordArgsInfo
where {
	default_elem 
		= {
			rai_unboxed_args	= {}
		,	rai_n_boxed_args		= 0
		};
};

	
instance DefaultElem RecordInfo
where {
	default_elem
		= {
		ri_descriptor_name	= ""
	,	ri_args				= default_elem
	};
};	

:: ClosureInfo 
	= { 
		ci_closure_name			:: !String
	,	ci_is_build_lazy_block	:: !BuildLazyBlock
	,	ci_args					:: !RecordArgsInfo
	};
	
:: BuildLazyBlock
	= NoLazyBlock
	| BuildLazyBlock !Int !Int 		// NodeIndex (Dynamic ID)
	;

isBuildLazyBlock :: !BuildLazyBlock -> (!Bool,!Int,!Int);
isBuildLazyBlock (BuildLazyBlock node_index dynamic_index)	= (True,node_index,dynamic_index);
isBuildLazyBlock _	= (False,0,0);
	
instance DefaultElem ClosureInfo
where {
	default_elem
		= {
			ci_closure_name = "" 
		,	ci_is_build_lazy_block	= NoLazyBlock
		,	ci_args = default_elem
		};
};

:: StringInfo
	= {
		si_string			:: !String
	};

instance DefaultElem StringInfo
where {
	default_elem
		= { si_string = "" };
};		

:: ArrayInfo
	= { 
		ai_element_descriptor	:: !ArrayElementDescriptor
	,	ai_n_elements			:: !Int
	,	ai_record_args_info		:: !{#RecordArgsInfo}
	};

	
:: ArrayElementDescriptor
	= AED_Invalid
	| AED_BasicValue BasicValueKind
	| AED_Record !String
	| AED_Boxed
	;
	
:: BasicValueKind
	= BVK_Int
	| BVK_Char
	| BVK_Real
	| BVK_Bool
	;
		
instance DefaultElem ArrayInfo
where {
	default_elem
		= { 
			ai_element_descriptor	= AED_Invalid
		,	ai_n_elements			= 0
		,	ai_record_args_info		= {}
		};
};