// PASS: COPY GRAPH
// 
// Interface:
//
// #define ML(x)				x##id e.g. _1
// #define ENTRY_LABEL			copy_next_node					*
// #define ENTRY_LABEL_NODEP	copy_next_node_in_nodeP			*
// #define EXIT_LABEL			copy_done
// #include "gts_copy.c"
// #undef EXIT_LABEL
//
// COPY PASS: COPY_PASS

#ifdef COPY_PASS 
# ifdef SHARE_PREFIXES
#  error "COPY_PASS and SHARE_PREFIXES cannot be used together"
# endif
#endif

#ifdef UNFIXED_STACK
# define PUSHL2					_pushl_gc
# define RESERVE_STACK_BLOCK	_reserve_stack_block_gc
# define COPY_STACK_BLOCK		_copy_stack_block_gc
#else
# define PUSHL2					_pushl_no_gc
# define RESERVE_STACK_BLOCK	_reserve_stack_block_no_gc
# define COPY_STACK_BLOCK		_copy_stack_block_no_gc
#endif

#ifdef GTS_COPY_ONLY_ENCODE_MACRO
# undef GTS_COPY_ONLY_ENCODE_MACRO
	/*
	// pre-conditions: 
	// - t1 contains to the encoded descP e.g. movl (stringP),t1
	// - stringP points to the encoded descriptor
	// - t1 is not an indirection
	//
	// post condition:
	// - (stringP) is changed
	// - stringP is advanced with 4
	//
	// identical code in:
	// adjust_offset_per_block
	*/ 
	.macro ML(_adapt_encoded_graph) t12
# define stringP	source

# define t0	descP	// %ebx
# define t2	nodeP	// %eax
		pushl	t2
		movl	t0,tijdelijk
		
		movl	\t12,t2
	
		andl	$0x00ffffff,\t12
		movl	stackTop,t0
		subl	\t12,t0						// t0 = stackTop - offset
		
		movl	4(t0),\t12					// t12 = virtual base offset
		
		cmpl	$0,\t12
		jnz		9f							// \virtual_base_offset_already_computed
	
		// The virtual base offset should already have been computed but it isn't if control
		// reaches this point. How come?
		int3
		
		popl	%eax	
		movl	tijdelijk,%ebx	

		movl	virtual_base_offset,\t12	// compute virtual base offset
		movl	\t12,4(t0)
		
		// determine bitset size
		movl	(t0),t2
	
		// MAKE OFFSET DESCRIPTOR TABLE ..
		subl	$1,free
		js		undo_handler			// gap between the string table and the intermediate data structure

		movl	t2,(heapP)
		leal	4(heapP),heapP
		// .. MAKE OFFSET DESCRIPTOR TABLE 
	
		andl	$0xff000000,t2
		shrl	$24,t2
		
		addl	$n_bits,t2
		movzbl	(t2),t2						// t2 = #bitset
	
		leal	(\t12,t2,4),t2
		movl	t2,virtual_base_offset		// advance virtual base offset with #bitset * 4
		
		movl	(stringP),t2
		
	9:	// virtual base offset has already been computed
		andl	$0xff000000,t2
		shrl	$29,t2						// t2 = prefix kind of encoded node
		
		addl	$n_possible_prefixes_before_prefix,t2
		movzbl	(t2),t2						// t2 = set of prefixes which *can* occur before the desired prefix
		
		movl	(t0),t0
		andl	$0xff000000,t0
		shrl	$24,t0						// t0 = set of needed prefixes
	
		andl	t2,t0						// t0 = set of needed prefixes which *occur* before the desired prefix
	
		addl	$n_bits,t0
		movzbl	(t0),t0						// t0 = #needed prefixes which *occur* before the desired prefix
		
		leal	(\t12,t0,4),t0				// t0 = virtual_base_offset + (#needed prefixes * 4)
		andl	$0x00ffffff,t0				
		
		movl	(stringP),\t12
		andl	$0xff000000,\t12			// get prefix kind and arity
		orl		t0,\t12
		movl	\t12,(stringP)				// update encoded graph with just computed virtual offset for the prefix kind
		
		popl	t2
# undef t0
# undef t2
				
		/*
		// precondition: stringP always points at a descP in the encoded graph
		//
		// Adapt the lower 24 bits to hold the virtual offset in the descriptor address table. The descriptor address
		// table is generated by the linker at run-time. The order is important. Only the first four bytes of the 
		// intermediate structure are stored.
		//
		*/
		leal	4(stringP),stringP			// descriptor has been modified to point to the proper prefix
	// .. ADAPT ENCODED GRAPH
	.endm
#else // GTS_COPY_ONLY_ENCODE_MACRO 

// mutally exclusive options
# include "gts_shared_macros.c"
	
// Macros:
# ifndef GTS_COPY_DEFINE_ONLY_ONCE
# endif

	// _copy_heap_block:
	//
	// call by:
	//
	// -	source
	//	the source address
	// -    arity
	//	number of longs to copy 	
# define COPY_HEAP_BLOCK			ML(_copy_heap_block)
	.macro ML(_copy_heap_block)
		subl 	arity,free					// free < length
		js 		undo_handler
		
		cld
		rep
		movsl
	.endm
	
// Code:
# ifdef COPY_PASS
ENTRY_LABEL:
 	_try_popl nodeP EXIT_LABEL				//ML(copy_done)
 	
ENTRY_LABEL_NODEP:
	movl 	(nodeP),descP					// get descriptor pointer
#  ifdef COLOUR_GRAPH
	cmpl	heapP,descP						// descP <= heapP
	jbe		ML(copy_indirection)
	
	// descP > heapP i.e. descP points in shared nodes table
	decl	descP
	
#   ifdef COPY_BLOCK_PASS
#    ifdef EXTRAATJE
#     define temp %ecx
	movl	SN_COLOUR(descP),temp							// get colour of node
	andl	$ ENSN_COLOUR_GET_COLOUR,temp
	cmpl	temp,current_colour
	je		8f

	movl	EN_NODE_INDEX(descP),temp
	
	// store encoded external reference (identical to earlier case)
	subl	$1,free
	js		undo_handler
	orl		$3,temp
	movl	temp,(heapP)
	addl	$4,heapP

	jmp		ENTRY_LABEL
	
8:
	movl	SN_COLOUR(descP),temp							// get colour of node
	testl	$ ENSN_COLOUR_SET_EN_BIT,temp
 	jz		ML(copy_non_shared_node)						// marked, ignore reference
 
 	orl		$ ENSN_COLOUR_ALREADY_VISITED_MASK,SN_COLOUR(descP)	// mark entry node as copied
	
	movl	heapP,temp										// set EN-node offset
	subl	old_heap_pointer,temp

	movl	temp,EN_BLOCK_OFFSET(descP)

	movl	nodeP,EN_NODE(descP)							// also done in gts_delete (next pass)

	jmp		ML(copy_non_shared_node)
#     undef temp
#    endif

	cmpl	nodeP,mark_en_current_en_node
	je		ML(copy_non_shared_node)
#   endif

#   define temp %ecx
	movl	SN_COLOUR(descP),temp			// get colour of node

#   ifdef COPY_BLOCK_PASS
	testl	$ ENSN_COLOUR_SET_EN_BIT,temp
	jz		ML(copy_non_shared_node)

#   endif 

#   ifndef COPY_BLOCK_PASS
	andl	$ ENSN_COLOUR_GET_COLOUR,temp
	cmpl	current_colour,temp				// node_colour == current_colour
	je		ML(copy_possible_entry_node)

	incl	n_references_to_entry_nodes		// amount of external references	

	// create external reference
	movl	SN_COLOUR(descP),temp			// get colour of node
	testl	$ ENSN_COLOUR_SET_EN_BIT,temp
	jnz		2f								// non first reference

	ML(_build_external_reference)			// first reference to entry node
	jmp		3f
2:
#   endif 
	movl	EN_NODE_INDEX(descP),temp		// at least the second reference
#   ifndef COPY_BLOCK_PASS 
3:
	movl	temp,ML(external_ref)
#   endif 
		
	// encode external reference
	subl	$1,free
	js		undo_handler
	orl		$3,temp
	movl	temp,(heapP)
	addl	$4,heapP

#   ifdef COPY_BLOCK_PASS 
	jmp		ENTRY_LABEL
#    undef temp
#   else
	// look if node has already been marked as an entry node
	movl	SN_COLOUR(descP),temp			// get colour of node
	testl	$ ENSN_COLOUR_SET_EN_BIT,temp
 	jnz		ENTRY_LABEL						// marked, ignore reference
#    undef temp
// #else

	ML(_create_entry_node)

	// notice that the EN-node has not yet been copied in the string
#    define entry_node %ecx
#    define temp descP
	leal	1(entry_node),temp				
	movl	temp,(nodeP)					// change descP of node to the created entry node
#    undef temp
#    undef entry_node	

	pushl	nodeP							// visit different coloured node later

	jmp		ENTRY_LABEL
	
ML(copy_possible_entry_node):
	testl	$ ENSN_COLOUR_SET_EN_BIT,SN_COLOUR(descP)
	jz		ML(copy_non_shared_node)		// a non-entry node
	
	// an entry node is being encoded, store its address (for now)
	// Later this should be the offset
#    define temp %ecx
	movl	heapP,temp
	subl	old_heap_pointer,temp
	movl	temp,EN_BLOCK_OFFSET(descP)
#    undef temp
#   endif // COPY_BLOCK_PASS

ML(copy_non_shared_node):
#  endif // COLOUR_GRAPH

#  ifndef COLOUR_GRAPH
	testl 	$1,descP						// test bit#0 for indirection					
	jne 	ML(copy_indirection)			// if set then copy the indirection
#  endif // COLOUR_GRAPH
	
	// copy descriptor and make indirection
	subl 	$1,free							// free < 1
	js		undo_handler

	leal 	1(heapP),%ecx					// indirection (%ecx) = heapP (heapP) + 1
	movl 	%ecx,(nodeP)					// update descriptor entry of node *in graph*

	movl 	descP,(heapP)					// descP (descP) at location heapP *in string being encoded*
	addl 	$4,heapP						// reserve space for descP

#  ifdef COLOUR_GRAPH
	// also for arrays
	movl	SN_DESCP(descP),descP
#  endif // COLOUR_GRAPH

// HIER STOND HIJ #   endif // COPY_BLOCK_PASS

# endif // COPY_PASS
	testl 	$2,descP						// test if in hnf (bit#1)?
	je		ML(copy_closure)				// no, copy closure

	// node in hnf
	movzwl	-2(descP),arity					// get arity (%cx) of descriptor	
	testl	arity,arity
	jne		ML(copy_argument_pointers)		// if not zero, the copy argument pointer

	cmpl	$INT+2,descP
	je		ML(copy_integer)
	cmpl	$CHAR+2,descP
	je		ML(copy_integer)
	cmpl	$BOOL+2,descP
	je		ML(copy_integer)
	cmpl 	$REAL+2,descP
	je 		ML(copy_real)
	cmpl 	$__STRING__+2,descP
	je		ML(copy_string)
	cmpl 	$__ARRAY__+2,descP
	je 		ML(copy_array)

	jmp		ENTRY_LABEL

# ifdef COPY_PASS
#  define temp	%eax
ML(copy_indirection):
	// An indirection means that a certain node is referenced at least twice. All second
	// or later references to a particular node end up here.
	//	descP - 1		: pointer to an already encoded shared node in the string
	//					  being built.
	//  heapP			: pointer in the being built string which will contain the
	//					  offset back to the node.
	decl	descP
	
#  ifdef COLOUR_GRAPH
	// descP -1			: contains a shared node pointer
	incl	n_references_to_entry_nodes
	
#   define sh_entry temp
	movl	descP,sh_entry
	movl	(sh_entry),sh_entry				// pointer to shared entry
	
#   define node_colour %ecx
	movl	SN_COLOUR(sh_entry),node_colour	// get node colour
		
	// REF NAAR CURRENT EN-NODE MOET ALS INTERNE INDIRECTIE GECODEERD WORDEN
#   ifdef COPY_BLOCK_PASS
//	pushl	node_colour
//	andl	$0x000000ff,node_colour
//	cmpl	$7,node_colour
//	jne		hh
//	
//	int3
//hh:
//	popl	node_colour
	
//2 ...
	pushl	node_colour
	andl	$ ENSN_COLOUR_GET_COLOUR,node_colour
	cmpl	current_colour,node_colour		// current_colour <> node_colour i.e. external reference
	je		ML(copy_internal_indirection)
	popl	node_colour
//2 ...

	testl	$ ENSN_COLOUR_SET_EN_BIT,node_colour
	jnz		ML(copy_external_indirection)
#    else 
	andl	$ ENSN_COLOUR_GET_COLOUR,node_colour
	cmpl	current_colour,node_colour		// current_colour <> node_colour i.e. external reference
	jne		ML(copy_external_indirection)
#    undef sh_entry
#   endif // COPY_BLOCK_PASS

#  endif // COLOUR_GRAPH

//2 ...
ML(copy_internal_indirection):
//2 ...
	subl 	$1,free							// free < 1
	js		undo_handler

#  ifdef COLOUR_GRAPH	
	// internal references or indirections are difficult because the encoding
	// of a certain component may not occupy succesive space. This should be
	// compensated. Either by some additional administration or by implementing
	// the construction of the entry node tree	
	movl	heapP,temp
	subl	descP,temp						// offset = heapP - descP
	shll	$2,temp 
	orl		$1,temp							// internal indirection
#  else	
	leal 	1(heapP),temp					// offset = heapP - descP + 1
	subl 	descP,temp						// heapP - descP + 1
#  endif // COLOUR_GRAPH

	movl 	temp,(heapP)
	addl 	$4,heapP
	jmp 	ENTRY_LABEL
# undef temp

#  ifdef COLOUR_GRAPH
ML(copy_external_indirection):
#   ifdef COPY_BLOCK_PASS
	movl	%ebx,ML(old_heapP)					// backup old heap position
		
	movl	SN_COLOUR(%eax),%ebx
	testl	$ ENSN_COLOUR_SET_EN_BIT,%ebx
	jz		ML(copy_indirection_unmarked)
#   endif // COPY_BLOCK_PASS

	// An entry node
	movl	EN_NODE_INDEX(%eax),%ebx
	
	subl	$1,free
	js		undo_handler
	orl		$3,%ebx
	movl	%ebx,(heapP)
	addl	$4,heapP
	
	jmp		ENTRY_LABEL
	
ML(copy_indirection_unmarked):
	// at old_heapP is the SN-pointer to be replaced.
	pushl	%eax
	movl	ML(old_heapP),%eax
	popl	%eax
	
	// an unmarked entry node i.e. a sn-node has been discovered. Notice that %ecx
	// contains the node colour.	
	// create external reference (similar to earlier case)
#   define temp %ecx
	ML(_build_external_reference)
	
	movl	temp,ML(external_ref)					// reference backup
	
	// store encoded external reference (identical to earlier case)
	subl	$1,free
	js		undo_handler
	orl		$3,temp
	movl	temp,(heapP)
	addl	$4,heapP
#   undef temp

	movl	%eax,descP								// SN-pointer

	ML(_create_entry_node)							// replace and initialise EN-pointer in node
	
	// EN_BLOCK_OFFSET berekenen	
#   define temp %eax
	movl	ML(old_heapP),temp
	
	movl	%ecx,(temp)								// replace SN-node by equivalent EN-node
	

	subl	old_heap_pointer,temp
	
	movl	temp,EN_BLOCK_OFFSET(%ecx)
#   undef temp
	jmp		ENTRY_LABEL
#  endif // COLOUR_GRAPH

# endif // COPY_PASS

# define temp %ebx
ML(copy_argument_pointers):
	cmpl 	$1,arity
	je		ML(push_first_argument_pointer)
	cmpl 	$2,arity
	je		ML(push_second_and_first)
	cmpl 	$256,arity
	jae 	ML(copy_record)

	// 2 < arity < 256
	// (nodeP)		descP
	// 4(nodeP)		ptr to first arg
	// 8(nodeP)		ptr to arg block
# ifdef SHARE_PREFIXES
	pushl	stringP							// backup stringP
# endif

	movl	8(nodeP),source	
	decl	arity

	COPY_STACK_BLOCK temp

# ifdef SHARE_PREFIXES
	popl	stringP							// restore stringP
# endif	
	jmp 	ML(push_first_argument_pointer)
# undef	temp

# define	temp	%ebx
ML(push_second_and_first):
	movl	8(nodeP),temp
	PUSHL2	temp
# undef temp

ML(push_first_argument_pointer):
	movl	4(nodeP),nodeP
	jmp		ENTRY_LABEL_NODEP
				
	// INT
	// (nodeP)		descP to INT
	// 4(nodeP)		integer value
# define temp	%ecx
ML(copy_integer):
# ifdef SHARE_PREFIXES
	leal	4(stringP),stringP
# endif

# ifdef COPY_PASS
	subl 	$1,free							// free < 1
	js		undo_handler
			
	movl 	4(nodeP),temp
	movl 	temp,(heapP)
	
	addl 	$4,heapP
# endif 

	jmp 	ENTRY_LABEL
# undef temp

	// REAL
	// (nodeP)		descP to REAL
	// 4(nodeP)		least significant part of real
	// 8(nodeP)		most significant part of real
	// encoding processor specific
# define temp	%ecx
ML(copy_real):
# ifdef SHARE_PREFIXES
	leal	8(stringP),stringP
# endif 

# ifdef COPY_PASS
	subl 	$2,free							// free < 2			
	js		undo_handler
	
	movl 	4(nodeP),temp
	movl 	temp,(heapP)
	movl 	8(nodeP),temp
	movl 	temp,4(heapP)
	
	addl 	$8,heapP
# endif
	jmp 	ENTRY_LABEL
# undef temp

	// CLOSURE
	// -8(descP)	descP
	// -4(descP)	arity of closure
	// descP		text ptr to code
# define temp	%ebx
ML(copy_closure):	
	movl	-4(descP),arity
	cmpl	$0,arity
	jl		ML(copy_closure1)
	je		ENTRY_LABEL
	
	cmpl 	$256,arity						// arity >= 256
	jae 	ML(copy_unboxed_closure)

# ifdef LAZY_DYNAMICS
#  ifdef OLD_COPY_PASS
#	ifdef CONVERT_BUILD_LAZY_BLOCKS
	// build_lazy_block
	// ----------------
	cmpl	$ CLEAN_nbuild_lazy_block,descP
	jne 	ML(no22)

// store NodeIndex
	movl	BUILD_DYNAMIC_NODE__INDEX_PTR(nodeP),temp	// temp is an INT-node
	movl	4(temp),temp							// get node-index

	movl	temp,BUILD_LAZY_DYNAMIC_ON_DISK__NODE_INDEX(heapP)

	call	MAKE_ID_FDS(lb_alloc_entry)
		
	movl	8(nodeP),%ebx
	movl	4(%ebx),%ebx
		
	pushl	%ebx

	jmp		ML(convert_run_time_id)
ML(no22):
#   endif

	// build_block
	// -----------
	cmpl	$ CLEAN_nbuild_block,descP
#   ifdef LAZY_DYNAMICS_3
	jne 	ML(continue)

	subl 	$2,free							// free < 2			
	js		undo_handler
	
	// store NodeIndex
	movl	BUILD_DYNAMIC_NODE__INDEX_PTR(nodeP),temp	// temp is an INT-node
	movl	4(temp),temp							// get node-index
	movl	temp,BUILD_LAZY_DYNAMIC_ON_DISK__NODE_INDEX(heapP)
	
	// store Dynamic
	// sharing equal pointer is not done.
#    ifdef DYNAMIC_STRINGS
	movl	BUILD_DYNAMIC_GDID__PTR(nodeP),temp
	testl	$2,(temp)
	jnz		ML(no_closure)
	
	movl	4(temp),temp								// argument of closure is GlobalDynamicInfo
ML(no_closure):
	pushl	temp
	movl	4(temp),temp
	
	cmpl	$__STRING__+2,(temp)
	je 		ML(a_string)
	// not a string. how to get the dynamic string?
	
	popl	temp

ML(a_string):
	call	MAKE_ID_FDS(lb_alloc_entry)

	// get run-time id
	popl	temp
	 	
	movl	8(temp),temp			// arg block ptr

#     ifdef SHARING_ACROSS_CONVERSIONS
	pushl	temp
#     endif

	movl	GDI_ID(temp),temp		// get ID

	pushl	temp					// backup dynamic ID

#    ifdef CONVERT_BUILD_LAZY_BLOCKS
ML(convert_run_time_id):
#    endif
	movl	$ INVALID_DYNAMIC_ID,LDR_ID(%ecx)	
	pushl	%ecx
	
	call	convert_dynamic_id_into_build_lazy_block_id
	
	popl	%ecx
	
	movl	%ebx,LDR_LAZY_DYNAMIC_INDEX(%ecx)
	movl	%ebx,BUILD_LAZY_DYNAMIC_ON_DISK__DYNAMIC_ID(heapP)
		
	popl	temp					// restore dynamic ID
	movl	temp,LDR_ID(%ecx)		// field will be put in ldr_id	
#    endif // DYNAMIC_STRINGS	
	
	addl	$ BUILD_LAZY_DYNAMIC_ON_DISK__BSIZE,heapP

#     ifdef SHARING_ACROSS_CONVERSIONS
	popl	nodeP
	movl	GDI_GRAPH_POINTERS(nodeP),nodeP
	jmp		ENTRY_LABEL_NODEP		
#     else
	jmp		ENTRY_LABEL	
#     endif

ML(continue):
#    else // LAZY_DYNAMICS_3
	jne 	ML(no_build_block)
	
#    define temp2 descP
	movl	(nodeP),temp2
	decl	temp2
	movl	(temp2),temp2
	movl	$ CLEAN_nbuild_lazy_block,SN_DESCP(temp2)
#    undef temp2
	
	jmp		ENTRY_LABEL
ML(no_build_block):
#   endif // LAZY_DYNAMICS_3
#  endif // OLD_COPY_PASS

#  ifdef SHARE_PREFIXES2
#    ifdef LAZY_DYNAMICS_3
#     ifdef CONVERT_BUILD_LAZY_BLOCKS
	cmpl	$ CLEAN_nbuild_lazy_block,descP
	je		ML(build_lazy_block)
#    endif

	cmpl	$ CLEAN_nbuild_block,descP
	jne		ML(continue2)

#    ifdef CONVERT_BUILD_LAZY_BLOCKS
ML(build_lazy_block):
#    endif

	addl	$8,stringP
	
#     ifdef SHARING_ACROSS_CONVERSIONS
	movl	BUILD_DYNAMIC_GDID__PTR(nodeP),nodeP
	testl	$2,(nodeP)
	jnz		ML(no_closure)
	
	movl	4(nodeP),nodeP								// argument of closure is GlobalDynamicInfo
ML(no_closure):	
	
	movl	8(nodeP),nodeP
	movl	GDI_GRAPH_POINTERS(nodeP),nodeP
	
	jmp		ENTRY_LABEL_NODEP		
#	  endif

	jmp		ENTRY_LABEL
ML(continue2):
#    else // not LAZY_DYNAMICS_3
	cmpl	$ CLEAN_nbuild_lazy_block,descP
	jne 	ML(doe)
	nop
	int3
	nop
	jmp		ENTRY_LABEL

ML(doe):
#   endif // not LAZY_DYNAMICS_3
#  endif // SHARE_PREFIXES2
# endif // LAZY_DYNAMICS
	
# ifdef SHARE_PREFIXES
	pushl	stringP							// backup stringP
# endif

	leal	4(nodeP),source
	COPY_STACK_BLOCK temp
	
#  ifdef SHARE_PREFIXES
	popl	stringP							// restore stringP
#  endif
	
	jmp 	ENTRY_LABEL
	
ML(copy_closure1):
	movl	4(nodeP),nodeP
	jmp		ENTRY_LABEL_NODEP
#  undef temp		

	// UNBOXED CLOSURE
	// (descP)		high byte, number of unboxed args
	// 				low_bytes, number of args
	// arity < 2:
	// 4(nodeP)		1st arg
	// 8(nodeP)		2nd arg if any
	//
	// arity > 2:
	// 4(nodeP)		1st arg
	// 8(nodeP)		ptr to arg block
	//
	// Boxed args block if any precede unboxed args block
#  define nrUnboxed	nodeP
#  define nrUnboxedL	%al
#  define nrPointers	arity
#  define nrPointersH	%ch
#  define temp		%ebx

ML(copy_unboxed_closure):
#   ifdef SHARE_PREFIXES
	pushl	stringP							// backup stringP
#   endif
	leal	4(nodeP),source					// set source

	xorl 	nrUnboxed,nrUnboxed
	movb	nrPointersH,nrUnboxedL
	andl	$255,arity
	sub		nrUnboxed,arity					// arity = # boxed arguments

	COPY_STACK_BLOCK temp
	
#  ifdef COPY_PASS
	movl	nrUnboxed,arity					// arity = # unboxed arguments
	
	COPY_HEAP_BLOCK
#  endif

#  ifdef SHARE_PREFIXES
	popl	stringP							// restore stringP
	leal	(stringP,nrUnboxed,4),stringP	// increase it with number of unboxed arguments
#  endif
	jmp		ENTRY_LABEL
# undef nrUnboxed
# undef nrUnboxedL
# undef nrPointers
# undef nrPointersH
# undef temp

	// RECORD
	// -2(descP)	arity
	// (descP)		# boxed args (ptrs)
ML(copy_record):
	// temporary register assignments
#  ifdef COPY_PASS
#  define nrPointers	%esi
#  endif // COPY_PASS

#  ifdef SHARE_PREFIXES
#  define nrPointers	descP
#  endif

	movzwl 	(descP),nrPointers				// nrPointers (boxed arguments)
	subl 	$256,arity						// arity -= 256 (real arity)
		
#  ifdef COPY_PASS
#  define nrUnboxed		%ebx
	movl 	arity,nrUnboxed
	subl 	nrPointers,nrUnboxed			// nrUnboxed = arity - nrPointers
#  endif // COPY_PASS
	
	cmpl 	$0,arity
	je		ENTRY_LABEL						// arity == 0
	cmpl 	$1,arity
	je		ML(record_with_one_cell)		// arity == 1
	cmpl	$2,arity
	je		ML(record_with_two_cells)		// arity == 2
	
#  ifdef SHARE_PREFIXES
#  define nrUnboxed		arity
	subl	nrPointers,nrUnboxed
#  endif // SHARE_PREFIXES

	pushl	nrPointers
		
	// arity contains total arity
	cmpl	$0,nrPointers					// nrPointers == 0
	je		ML(only_unboxed_args)
	
	decl	nrPointers						// 4(nodeP) is a boxed	 
	jmp		ML(copy_args)					// argument
ML(only_unboxed_args):
	decl	nrUnboxed						// only unboxed, decrement
											// count			
ML(copy_args):
#  ifdef COPY_PASS
	movl	nrPointers,arity				// #boxed arguments in 8(nodeP)
	movl	8(nodeP),source					// set source						

	testl	%ecx,%ecx
	je  	ML(copy_unboxed_args)

	pushl	nrUnboxed
	
#  define temp %ebx
	COPY_STACK_BLOCK temp
#  undef temp
	popl	nrUnboxed

ML(copy_unboxed_args):
	movl	nrUnboxed,arity					// #unboxed arguments in 8(nodeP)
	testl	%ecx,%ecx
	je  	ML(copy_first_arg)
	
	COPY_HEAP_BLOCK
#  endif // COPY_PASS

#  ifdef SHARE_PREFIXES
	xchgl	nrPointers,nrUnboxed			// %ecx = nrPointers
	cmpl	$0,%ecx
	je		ML(copy_first_arg)

	pushl	source							// backup stringP

	movl	8(nodeP),source					// set source
#  define temp descP
	pushl	temp
	COPY_STACK_BLOCK temp
	popl	temp
#  undef temp 

	popl	source							// restore stringP
#  endif // SHARE_PREFIXES			
				
ML(copy_first_arg):
#  ifdef SHARE_PREFIXES
	leal	(stringP,%ebx,4),stringP
#  endif

	popl 	nrPointers
	jmp		ML(record_with_one_cell)
# undef nrUnboxed	

	// RECORD with two elements
ML(record_with_two_cells):
	cmpl 	$1,nrPointers					
	ja		ML(second_is_pointer)			// nrPointers > 1
	
#  ifdef COPY_PASS
	// copy unboxed args
	subl	$1,free							// free < 1
	js		undo_handler

#  define temp	%ebx		
	movl 	8(nodeP),temp
	movl 	temp,(heapP)
	
	addl 	$4,heapP
#  endif // COPY_PASS

#  ifdef SHARE_PREFIXES
	leal	4(stringP),stringP
#  endif 
	jmp 	ML(record_with_one_cell)
	
	// two boxed args
ML(second_is_pointer):
#  ifdef SHARE_PREFIXES
#  define temp arity
#  endif // SHARE_PREFIXES
	movl 	8(nodeP),temp
	PUSHL2 temp
# undef temp
	
ML(record_with_one_cell):
	cmpl 	$0,nrPointers				
	jne		ML(first_arg_is_pointer)
		
	// one unboxed arg
#  ifdef COPY_PASS
	subl 	$1,free							// free < 1
	js		undo_handler	

#  define temp	%ebx	
	movl 	4(nodeP),temp
	movl 	temp,(heapP)
#  undef temp
	
	addl 	$4,heapP
#  endif // COPY_PASS

#  ifdef SHARE_PREFIXES
	leal	4(stringP),stringP
#  endif // SHARE_PREFIXES
	jmp 	ENTRY_LABEL
	
ML(first_arg_is_pointer):
	movl 	4(nodeP),nodeP
	jmp 	ENTRY_LABEL_NODEP
# undef nrPointers

	// STRING
	// (nodeP)		descP to STRING
	// 4(nodeP)		length
	// 8(nodeP)		string
# define temp	%ebx
# define length	arity
ML(copy_string):
	movl 	4(nodeP),length
	
#  ifdef COPY_PASS
	test 	length,length
	je 		ML(string_length_zero)
#  endif // COPY_PASS
	
	addl 	$7,length						// length = 4 + 4(nodeP) + 3
	shrl 	$2,length						// length in longs	
	
#  ifdef COPY_PASS
	leal	4(nodeP),source					// set source
	
	COPY_HEAP_BLOCK
#  endif // COPY_PASS

#  ifdef SHARE_PREFIXES
	leal	(stringP,length,4),stringP
#  endif // SHARE_PREFIXES
	jmp 	ENTRY_LABEL
	
#  ifdef COPY_PASS
ML(string_length_zero):
	subl	$1,free			
	js		undo_handler
	
	movl	length,(heapP)
	addl	$4,heapP
	
	jmp 	ENTRY_LABEL
#  undef temp
#  undef length
#  endif // COPY_PASS

	// ARRAY
	// (nodeP)		descP to ARRAY
	// 4(nodeP)		size
	// 8(nodeP)		0, boxed array
	//				otherwise, element descP
	// 12(nodeP)	element block
ML(copy_array):
#  ifdef COPY_PASS
#  define size	arity
	subl	$2,free				
	js		undo_handler
	
	movl	8(nodeP),descP	
	movl 	descP,4(heapP)						// store descriptor in string
	
#   ifdef COLOUR_GRAPH

#   endif

	cmpl	$1,descP							// indirection or boxed array? descP <= 1
	jbe		ML(copy_array2)				

	// indirection; no boxed or already existing indirection	
#  define temp arity
	leal	5(heapP),temp
	movl	temp,8(nodeP)
#  undef	temp
#  endif // COPY_PASS

#  ifdef SHARE_PREFIXES
	movl	8(nodeP),descP						// get element descP
	
#  define t1 arity
	cmpl	$0,descP
	je		ML(share_prefixes_in_array2)
	
	leal	4(stringP),stringP					// advance stringP
	movl	(stringP),t1
	ML(_adapt_encoded_graph) t1
#  undef t1

	movl	8(nodeP),descP						// restore element descP

	jmp		ML(copy_array2)
ML(share_prefixes_in_array2):
	leal	8(stringP),stringP					// advance stringP
#  define size arity
#  endif // SHARE_PREFIXES


ML(copy_array2):
	movl	4(nodeP),size

#  ifdef COPY_PASS
	movl	size,(heapP)
	addl	$8,heapP
#  endif // COPY_PASS

	cmpl	$0,size								
	je		ENTRY_LABEL							// array size == 0

#  ifdef COPY_PASS
	leal	12(nodeP),source					// set source
#  endif // COPY_PASS
	
	cmpl	$0,descP	
	je		ML(copy_array_pointers)				// copy boxed array elements
	cmpl 	$INT+2,descP
	je		ML(copy_int_array)					// copy unboxed array of integers/chars
	cmpl	$BOOL+2,descP
	je		ML(copy_bool_array)					// copy unboxed array of booleans
#  ifdef SHARE_PREFIXES
	cmpl	$CHAR+2,descP
	je 		ML(copy_bool_array)
#  endif
	cmpl	$REAL+2,descP				
	je		ML(copy_real_array)					// copy unboxed array of reals
	
	jmp 	ML(copy_record_array)				// copy array with records elements
			
# define temp	%ebx
ML(copy_array_pointers):
#  ifdef SHARE_PREFIXES
	pushl	stringP
	leal	12(nodeP),source
#  endif

	COPY_STACK_BLOCK temp 

#  ifdef SHARE_PREFIXES
	popl	stringP
#  endif
	jmp		ENTRY_LABEL
# undef temp

ML(copy_int_array):
#  ifdef SHARE_PREFIXES
	leal	(stringP,size,4),stringP
#  endif // SHARE_PREFIXES

#  ifdef COPY_PASS 
	COPY_HEAP_BLOCK								// copy size, elem. descriptor and elements
#  endif // COPY_PASS
	jmp 	ENTRY_LABEL
	
ML(copy_bool_array):
	addl 	$3,size								// size = size + 3					
	shrl  	$2,size								// size /= 4 (in longs)
#  ifdef COPY_PASS
	jmp		ML(copy_int_array)
#  endif // COPY_PASS

#  ifdef SHARE_PREFIXES
	leal	(stringP,size,4),stringP
	jmp		ENTRY_LABEL
#  endif // SHARE_PREFIXES
	
ML(copy_real_array):
#  ifdef COPY_PASS
	shll	$1,size								// size *= 2	
	jmp		ML(copy_int_array)
#  endif

#  ifdef SHARE_PREFIXES
	leal	(stringP,size,8),stringP
	jmp		ENTRY_LABEL
#  endif
		
	// RECORD ARRAY
	// (nodeP)		descP to ARRAY
	// 4(nodeP)		size
	// 8(nodeP)		record element descP
	// 12(nodeP)	record elements block
	// 
	// -2(descP)	#longs which is the recordsize
	// (descP)		#a-fields in record (word,0)
	//
 	// Purpose:
 	// Copies an array containing records with at least one unboxed field. Other
 	// records are handled by copy_record. If the record element type are unboxed
 	// the copy_unboxed_record_array is called.
	.data
	.align 4
ML(t_stackP):	
	.long 0	
ML(unboxed_fields_size):
	.long 0
	
	// copy indirection
ML(old_heapP):
	.long	0

 	.text
ML(copy_record_array):
#   ifdef SHARE_PREFIXES
	pushl	stringP							// backup stringP
#   endif // SHARE_PREFIXES

	// compute boxed size part of the array and reserve stack memory
	movl	stackP,ML(t_stackP)				// backup stackP
			
#  define	temp		nodeP
#  define t_nodeP		arity
#  define temp2		source					// was: %esi 
	movl	nodeP,t_nodeP
	
	movzwl	(descP),temp					// #boxed fields per records
	cmpl	$0,temp							// any boxed arguments?
	je		ML(copy_unboxed_record_array)	// ok, copy only boxed
	
	mull	4(t_nodeP)						// temp = size of boxed part of array (in longs) 
	xchg	nodeP,arity
	
	movl	ML(t_stackP),stackP				// restore stackP	

#   ifdef SHARE_PREFIXES
	pushl	stringP
#   endif // SHARE_PREFIXES

	nop
	RESERVE_STACK_BLOCK temp2

#   ifdef SHARE_PREFIXES
	popl	stringP
#   endif // SHARE_PREFIXES

#  undef	temp
#  undef 	t_nodeP
#  undef	temp2

#   ifdef COPY_PASS
	// compute unboxed size part of the array and reserve heap memory
	movl	stackP,ML(t_stackP)				// backup stackP
	
#   define	temp	nodeP
#   define temp2	stackP
#   define t_nodeP	arity

	movl	nodeP,t_nodeP
		
	movzwl	(descP),temp2
	movzwl	-2(descP),temp					// total record size in bytes
	subl	$256,temp		
	subl	temp2,temp						// temp = total record size - nrFieldPointers
	movl	temp,ML(unboxed_fields_size)
	mull	4(t_nodeP)
	
	subl	%eax,free						// free < unboxed record size
	js		undo_handler
	
	movl	t_nodeP,nodeP
#   undef temp
#   undef temp2

	movl 	ML(t_stackP),stackP				// restore stackP
	
	// assumption: amount of boxed and unboxed args is at least one
#   define nrBoxedFields	%ebx
	movzwl	(descP),nrBoxedFields			// #boxed fields
	
	pushl	free							// backup free
#   define nrUnboxedFields	free
	movl	ML(unboxed_fields_size),nrUnboxedFields		// #unboxed fields

	leal	12(nodeP),source				// set source
	cld
	
#   define count	nodeP
	movl	4(nodeP),count
	
	pushl	stackP							// backup tos
	
ML(copy_boxed_fields):
	xchg	heapP,stackP					// exchange heapP and stackP

	movl	nrBoxedFields,arity				// amount of boxed fields to copy

	cld
	rep
	movsl
	
	xchg 	heapP,stackP					// exchange

ML(copy_unboxed_fields):
	movl	nrUnboxedFields,arity			// amount of unboxed fields to copy
	
	cld
	rep
	movsl
	
ML(copied_one_array_record):
	decl	count
	jne		ML(copy_boxed_fields)
	
	popl	stackP
	popl	free
	
	jmp 	ENTRY_LABEL

ML(copy_unboxed_record_array):
	leal	12(t_nodeP),source					// set source
	
#   define	s_unboxed_record_array	%eax
	movzwl	-2(descP),s_unboxed_record_array	// total record size (in longs)
	subl	$256,s_unboxed_record_array
	mull	4(t_nodeP)							// get array size
	movl	ML(t_stackP),stackP					// restore stackP
					
	movl	s_unboxed_record_array,arity		// set arity
#   undef s_unboxed_record_array
	
	COPY_HEAP_BLOCK
	
	jmp		ENTRY_LABEL
#   undef record_size
#   undef nrPointers
#   undef t_nodeP	

#  endif // COPY_PASS

#  ifdef SHARE_PREFIXES
	// Copy the boxed part of the record array to stack
	leal	12(nodeP),source				// set source
	
	pushl	free
#  define nrPointers free					
	movzwl	(descP),nrPointers				// boxed size of record
	
#  define s_unboxed_arguments descP
	movzwl	-2(descP),s_unboxed_arguments			// total record size
	subl	$256,s_unboxed_arguments
	subl	nrPointers,s_unboxed_arguments			// s_unboxed_arguments = size of unboxed fields	
	shll	$2,s_unboxed_arguments				// s_unboxed_arguments *= 4 (in bytes)
	
#  define count	nodeP
	movl	4(nodeP),count					// get array size
	
	pushl	heapP
	movl	stackP,heapP					// set destination to stack start
	
	pushl	count
ML(share_prefixes_in_record_array2):
	movl	nrPointers,arity				// set arity to # boxed fields
	
	cld
	rep
	movsl
	
	addl	s_unboxed_arguments,source		// NEW!!!
	decl	count
	jne		ML(share_prefixes_in_record_array2)
	
	popl	count
	
	popl	heapP
	popl	free
	
	// %ebx = unboxed record size 		(s_unboxed_arguments)
	// %eax = #array elements			(count)	
	pushl	%edx
	mull	%ebx
	popl	%edx
	
	popl	stringP
	leal	(stringP,%eax),stringP
	
	jmp		ENTRY_LABEL 					//share_next_prefix
#  undef nrPointers
#  undef s_unboxed_arguments
#  undef count

ML(copy_unboxed_record_array):
	popl	stringP
	
#  define temp %edx
	pushl	temp
	movl	4(arity),temp
	
#  define s_unboxed_arguments nodeP
	movzwl	-2(descP),s_unboxed_arguments		// total record size
	subl	$256,s_unboxed_arguments
	shll	$2,s_unboxed_arguments				// s_unboxed_arguments *= 4 (in bytes)
	mull	temp

	popl	temp
	
	leal	(stringP,%eax),stringP

	jmp		ENTRY_LABEL
#  undef s_unboxed_arguments
#  undef temp

# endif // SHARE_PREFIXES

# ifndef GTS_COPY_DEFINE_ONLY_ONCE
#  define	GTS_COPY_DEFINE_ONLY_ONCE
	.data
	.align	4
// order r t c k d n

//	To compute the proper offset from the virtual base offset, it is necessary
//	to known what prefixes preceded the desired prefix e.g. suppose the offset
//	for k-prefix is desired,

n_possible_prefixes_before_prefix:
	.byte	32+16+8+4+2		// n-prefix; 00|111110
	.byte	32+16+8+4		// d-prefix; 00|111100
	.byte	32+16+8			// k_prefix; 00|111000
	.byte	32+16			// c_prefix; 00|110000
	.byte	32				// t_prefix; 00|100000 
	.byte	0				// r_prefix; 00|000000
n_references_to_entry_nodes:
	.long	0						// kan weg
# endif 	
	.text
	.align	4
	
# undef ML

#endif // GTS_COPY_ONLY_ENCODE_MACRO

#undef ENTRY_LABEL
#undef ENTRY_LABEL_NODEP
#undef COPY_STACK_BLOCK
#undef RESERVE_STACK_BLOCK
#undef PUSHL2
#undef COPY_HEAP_BLOCK
#ifdef COPY_PASS
# undef COPY_PASS
#endif
#ifdef OLD_COPY_PASS
# undef OLD_COPY_PASS
#endif
#ifdef SHARE_PREFIXES2
# undef SHARE_PREFIXES2
#endif
#ifdef UNFIXED_STACK
# undef UNFIXED_STACK
#endif
