#include "global_registers.c" #define stringP source #define root_nodeP nodeP #include "stack1.c" #include "string_descriptors.c" .MACRO _copy_argument_block_without_reserve l1 /* ** stackP points to beginning of reserved stack frame */ \l1: movl heapP,(stackP) addl $4,stackP addl $4,heapP loop \l1 .ENDM .MACRO _copy_argument_block_nodeP t l1 l2 #define t_heapP nodeP leal -4(heapP),t_heapP subl arity,free js garbage_collection movl stackP,\t subl stackTop,\t // temp = stackP - stackTop shrl $2,\t cmpl \t,arity // arity < temp jbe \l1 // enough space between stackTop and stackP // arity > temp // arity = arity - temp subl \t,arity // arity - available space between stackTop and stackP subl arity,free // free -= rest of arity js garbage_collection addl \t,arity // restore arity incl heapP // mark heapP to indicate that stackP must be copied to stackTOp \l1: leal (t_heapP,arity,4),\t subl $4,stackP movl \t,(stackP) addl $4,heapP loop \l1 // addl $4,heapP // heapP points to free space testl $1,heapP jz \l2 decl heapP movl stackP,stackTop \l2: #undef t_heapP .ENDM .MACRO _copy_block_to_heapP subl arity,free // enough free js garbage_collection cld // copy rep movsl .ENDM .MACRO _terminate reg movl \reg,%ecx movl esp_backup,%esp popl %esi movl old_heap_pointer,heapP ret .ENDM .data .align 4 graph_string_backup: .long 0 graph_string_length: .long 0 esp_backup: .long 0 old_heap_pointer: .long 0 initfree: .long 0 #define COPY_GRAPH_TO_STRING2 #ifdef COPY_GRAPH_TO_STRING2 string_table: .long 0 #endif .text #ifdef COPY_GRAPH_TO_STRING2 .globl copy__string__to__graph2 /* ** WARNING: ** If this function is used. The calling convention in Clean is: ** 1. the string of pointers to descriptors (returned by the ** dynamic linker) ** 2. the coded graph in string */ #define coded_graph %ecx #define descriptor_pointers %edx copy__string__to__graph2: //jmp copy__string__to__graph2 #define stringtable %eax movl 8(coded_graph),stringtable leal 8(coded_graph,stringtable),stringtable // pointer to string table in coded graph movl stringtable,string_table pushl coded_graph // backup coded graph movl 4(descriptor_pointers),arity // arity = # descriptor pointers shrl $2,arity // artiy /= 4 addl $8,descriptor_pointers jecxz copy__string__to__graph2__end__loop pushl source #define length source copy__string__to__graph2__loop: #define temp %ebx /* ** replace descriptor name by its address (returned by the dynamic linker) */ movl (stringtable),length movl (descriptor_pointers),temp // get the address of the descriptor movl temp,(stringtable) // store it in the string table addl $4,descriptor_pointers // next descriptor addl $7,length shrl $2,length leal (stringtable,length,4),stringtable // stringtable points to module name length /* ** skip module name */ movl (stringtable),length // get descriptor name length testl length,length // set status bits accordingly jns copy__string__to__graph2__skip__module__name addl $4,stringtable jmp copy__string__to__graph2__end__loop copy__string__to__graph2__skip__module__name: addl $7,length shrl $2,length leal (stringtable,length,4),stringtable // stringtable points to next descriptor name length copy__string__to__graph2__end__loop: loop copy__string__to__graph2__loop #undef temp #undef length popl source popl coded_graph #undef descriptor_pointers #undef stringtable /* ** compute descriptors ** ** Reason for doing this seperately (from copy_next_node): ** - when the garbage collector is called, that part of the string in which ** the descriptor pointers have been replaced by pointers to actual nodes, ** needs to be restored. ** Computing descriptors in situ */ #define stringP_end nodeP #define stringtable stackP compute_descriptors: jmp compute_descriptors leal 12(coded_graph),stringP // address of first descriptor in string movl 4(coded_graph),stringP_end // get length of coded graph leal 8(coded_graph,stringP_end),stringP_end // stringP_end = address of end string pushl coded_graph movl string_table,stringtable // stringtable = string_table compute_next_descriptor: cmpl stringP_end,stringP // stringP == stringP_end je compute_descriptors_done movl (stringP),descP // get descriptor offset (in stringtable) addl $4,stringP // testl $1,descP // indirection? // jne ??????? // testl $2,descP // hnf? // je compute_closure_descriptor /* ** compute right descriptor address */ movl descP,arity andl $0x00ffffff,descP // get offset in string_table movl -4(stringtable,descP),descP // get descriptor pointer andl $0xff000000,arity // get partial arity + 1 jnz compute_next_descriptor_partial_arity movzwl -6(descP),arity // arity = total arity jmp compute_next_descp compute_next_descriptor_partial_arity: decl arity // arity = partial arity compute_next_descp: leal 2(descP,arity,8),descP // real descriptor address for this application movl descP,-4(stringP) // instead of the offset in the stringtable, the computed descp is stored cmpl $INT+2,descP je compute_skip_integer cmpl $CHAR+2,descP je copy_ compute_skip_ compute_descriptors_done: popl coded_graph #undef stringP_end #undef stringtable #undef coded_graph #endif .globl copy__string__to__graph copy__string__to__graph: //jmp copy__string__to__graph // Backup movl %ecx,graph_string_backup // backup pointer pushl %esi movl %esp,esp_backup movl heapP,old_heap_pointer #define temp nodeP movl 4(%ecx),temp movl temp,graph_string_length // backup length #undef temp movl end_heap,stackP movl stackP,stackTop movl stackP,free subl heapP,free shrl $2,free movl free,initfree //movl $4,free // HACK: /* Old without offset to stringtable leal 4(%ecx),stringP _pushl1 stringP copy_next_node1 addl $4,stringP // stringP points to 1st descriptor */ leal 8(%ecx),stringP _pushl1 stringP copy_next_node1 addl $4,stringP copy_next_node: _stack_empty copy_done nop nop movl (stringP),descP // get descriptor addl $4,stringP subl $1,free js garbage_collection _popl1 root_nodeP testl $1,descP // indirection? jne copy_indirection // yes, copy indirection testl $2,descP // in hnf? je copy_closure // yes, copy closure copy_descriptor: movl descP,(heapP) // store descriptor //#define root_nodeP nodeP //_popl1 root_nodeP movl heapP,(root_nodeP) // root node points to currently being created node //#undef root_nodeP movl heapP,-4(stringP) // make indirection UNCOMMENT ME!!! addl $4,heapP // move to arguments part of node cmpl $INT+2,descP je copy_integer cmpl $CHAR+2,descP je copy_char cmpl $BOOL+2,descP je copy_bool cmpl $REAL+2,descP je copy_real cmpl $__STRING__+2,descP je copy_string cmpl $__ARRAY__+2,descP je copy_array nop nop nop /* ** copy_argument_pointers */ copy_argument_pointers: movzwl -2(descP),arity cmpl $0,arity // arity == 0 je copy_zero_argument_pointers cmpl $1,arity // arity == 1 je copy_one_argument_pointer cmpl $2,arity // arity == 2 je copy_two_argument_pointers cmpl $256,arity // arity == 256 jae copy_record copy_more_arguments_between_2_and_256: subl $2,free js garbage_collection pushl heapP // backup nodeP #define nodeP_for_rest_arguments nodeP leal 8(heapP),nodeP_for_rest_arguments movl nodeP_for_rest_arguments,4(heapP) // 2nd argument of node is pointer to rest arguments movl nodeP_for_rest_arguments,heapP // heapP += 8 #undef nodeP_for_rest_arguments decl arity _copy_argument_block_nodeP descP copy_more_arguments_between_2_and_256a copy_more_arguments_between_2_and_256b #define temp nodeP popl temp // restore heapP to first argument _pushl1 temp copy_more_arguments_between_2_and_256c #undef temp jmp copy_next_node copy_zero_argument_pointers: //jmp copy_zero_argument_pointers addl $1,free // undo descriptor subl $4,heapP #define temp arity leal -14(descP),temp movl temp,(root_nodeP) movl temp,-4(stringP) // set correct address for indirections #undef temp jmp copy_next_node copy_one_argument_pointer: subl $1,free js garbage_collection _pushl1 heapP copy_one_argument_pointer1 addl $4,heapP jmp copy_next_node copy_two_argument_pointers: subl $2,free js garbage_collection #define temp arity leal 4(heapP),temp _pushl1 temp copy_two_argument_pointers1 #undef temp _pushl1 heapP copy_two_argument_pointers2 addl $8,heapP jmp copy_next_node /* ** copy_integer */ #define base descP copy_integer: movl $small_integers,base copy_integer_or_char: #define value arity movl (stringP),value addl $4,stringP cmpl $32,value // 0 <= value <= 32 jbe copy_small_integer_or_char // use predefined node copy_value: subl $1,free js garbage_collection movl value,(heapP) addl $4,heapP jmp copy_next_node copy_small_integer_or_char: addl $1,free // undo node for integer subl $4,heapP #define small_integers_base descP leal (base,value,8),value movl value,(root_nodeP) movl value,-8(stringP) // set indirection jmp copy_next_node /* ** copy_char */ copy_char: movl $static_characters,base jmp copy_integer_or_char #undef base /* ** copy_bool */ copy_bool: movl (stringP),value addl $4,stringP jmp copy_value /* ** copy_real */ copy_real: subl $2,free js garbage_collection movl (stringP),value movl value,(heapP) movl 4(stringP),value movl value,4(heapP) addl $8,heapP addl $8,stringP jmp copy_next_node #undef value /* ** copy_indirection */ copy_indirection: decl descP #define node_pointer arity leal -4(stringP),node_pointer subl descP,node_pointer // heap_address = stringP - descP movl (node_pointer),node_pointer // get node pointer earlier stored in string movl node_pointer,(root_nodeP) #undef node_pointer jmp copy_next_node #undef node_pointer /* ** copy_record */ #define nrPointers nodeP #define recordSize descP copy_record: movzwl (descP),nrPointers // nrPointers = # boxed arguments subl $256,arity // arity -= 256 subl arity,free // free < arity for heap nodes js garbage_collection cmpl $0,arity je copy_next_node movl $4,recordSize cmpl $1,arity je copy_record_with_one_cell cmpl $2,arity je copy_record_with_two_cells subl $1,free // free < arity js garbage_collection pushl heapP // nodeP of first argument pushl nrPointers // backup nrPointers #define temp descP leal 8(heapP),temp movl temp,4(heapP) // nodeP of rest arguments movl temp,heapP // heapP += 8 #undef temp #define nrUnboxed descP movl arity,nrUnboxed subl nrPointers,nrUnboxed // nrUnboxed = #unboxed arguments cmpl $0,nrPointers // arity - 1 arguments are to be copied je only_unboxed_args decl nrPointers jmp copy_boxed_args only_unboxed_args: decl nrUnboxed copy_boxed_args: movl nrPointers,arity // nrPointers == 0 jecxz copy_unboxed_args // no boxed arguments in rest arguments pushl nrPointers pushl nrUnboxed _copy_argument_block_nodeP nrUnboxed copy_boxed_args1 copy_boxed_args2 popl nrUnboxed popl nrPointers copy_unboxed_args: movl nrUnboxed,arity // nrUnboxed == 0 jecxz copy_first_argument // no unboxed arguments in rest arguments subl arity,free js garbage_collection cld rep movsl // copy boxed arguments copy_first_argument: popl nrPointers #define t_heapP descP popl t_heapP // first argument nodeP cmpl $0,nrPointers jne copy_first_boxed_argument #define temp nodeP movl (stringP),temp // first argument is unboxed movl temp,(t_heapP) #undef temp addl $4,stringP jmp copy_next_node copy_first_boxed_argument: _pushl1 t_heapP copy_first_boxed_argument1 jmp copy_next_node /* ** copy_record_with_two_cells */ copy_record_with_two_cells: //jmp copy_record_with_two_cells movl $8,recordSize cmpl $1,nrPointers ja copy_record_with_cells_boxed #define value arity movl (stringP),value addl $4,stringP movl value,4(heapP) // store unboxed in second argument nodeP #undef value jmp copy_record_with_one_cell copy_record_with_cells_boxed: #define temp arity leal 4(heapP),temp _pushl1 temp copy_record_with_cells_boxed1 // push nodeP of 2nd argument #undef temp /* ** copy_record_with_one_cell */ copy_record_with_one_cell: cmpl $0,nrPointers jne copy_record_with_one_cell_boxed #define temp arity movl (stringP),temp // get unboxed argument addl $4,stringP movl temp,(heapP) // store it #undef temp addl recordSize,heapP jmp copy_next_node copy_record_with_one_cell_boxed: _pushl1 heapP copy_record_with_one_cell_boxed1 addl recordSize,heapP jmp copy_next_node #undef nrUnboxed #undef nrPointers /* ** copy_string */ #define length arity copy_string: movl (stringP),length cmpl $0,length je copy_zero_length_string addl $7,length shrl $2,length _copy_block_to_heapP jmp copy_next_node copy_zero_length_string: subl $1,free js garbage_collection addl $4,stringP movl length,(heapP) addl $4,heapP jmp copy_next_node #undef length /* ** copy_array */ #define size arity copy_array: subl $2,free js garbage_collection movl (stringP),size // copy size movl size,(heapP) movl 4(stringP),descP // copy descP movl descP,4(heapP) addl $8,heapP addl $8,stringP // stringP += 8 cmpl $0,size je copy_next_node cmpl $0,descP je copy_array_pointers cmpl $INT+2,descP je copy_int_array // copy unboxed array of integers/chars cmpl $BOOL+2,descP je copy_bool_array cmpl $REAL+2,descP je copy_real_array /* ** copy_record_array */ #define nrBoxedFields nodeP copy_record_array: // jmp copy_record_array movzwl (descP),nrBoxedFields // #boxed fields cmpl $0,nrBoxedFields je copy_boxed_record_array pushl nodeP pushl stackP mull size popl stackP // %eax = #boxed fields * array size pushl size movl %eax,size #define temp nodeP N_reserve_stack_block temp copy_record_array1 copy_record_array2 #undef temp popl size popl nodeP #define s_UnboxedFields descP movzwl -2(descP),s_UnboxedFields // s_UnboxedFields = total size of record (array element) subl $256,s_UnboxedFields subl nrBoxedFields,s_UnboxedFields // s_UnboxedFields = size of unboxed part of record pushl stackP // backup stackP copy_record_fields: pushl size copy_boxed_record_fields: movl nrBoxedFields,arity // arity = # boxed fields to copy _copy_argument_block_without_reserve copy_record_array3 copy_unboxed_record_fields: movl s_UnboxedFields,arity // arity = size of unboxed fields to copy _copy_block_to_heapP popl size loop copy_record_fields popl stackP // restore stackP jmp copy_next_node #undef s_UnboxedFields #define s_UnboxedFields nodeP copy_boxed_record_array: movzwl -2(descP),s_UnboxedFields // s_UnboxedFields = total size of record (array element) subl $256,s_UnboxedFields pushl stackP mull size movl %eax,size popl stackP _copy_block_to_heapP jmp copy_next_node #undef s_UnboxedFields copy_bool_array: addl $3,size shrl $2,size copy_int_array: _copy_block_to_heapP jmp copy_next_node copy_real_array: shll $1,size jmp copy_int_array copy_array_pointers: //jmp copy_array_pointers _copy_argument_block_nodeP descP copy_array_pointers1 copy_array_pointers2 jmp copy_next_node /* ** copy_closure */ // moet er niet ook een pointer in stringP opgeslagen worden die wijst // naar de aangemaakte knoop? copy_closure: //jmp copy_closure movl descP,(heapP) // store descriptor pointer movl heapP,(root_nodeP) // make root node point to closure movl heapP,-4(stringP) // store pointer for indirections addl $4,heapP // heapP += 4 movl -4(descP),arity // get closure arity cmpl $0,arity jl copy_closure_arity_1 // arity < 0, then copy closure of arity 1 je copy_closure_arity_0 cmpl $1,arity je copy_closure_arity_1 cmpl $256,arity jae copy_unboxed_closure _copy_argument_block_nodeP descP copy_clsoure1 copy_closure2 jmp copy_next_node copy_closure_arity_0: subl $2,free js garbage_collection addl $8,heapP jmp copy_next_node copy_closure_arity_1: subl $2,free js garbage_collection _pushl1 heapP copy_closure_arity2 addl $8,heapP jmp copy_next_node #define nrUnboxed nodeP #define nrUnboxedL %al #define nrPointers arity #define nrPointersH %ch #define temp %ebx copy_unboxed_closure: //jmp copy_unboxed_closure xorl nrUnboxed,nrUnboxed movb nrPointersH,nrUnboxedL andl $255,arity cmpl $0,arity je copy_unboxed_closure_arity0 cmpl $1,arity je copy_unboxed_closure_arity1 sub nrUnboxed,arity // arity = # boxed arguments pushl nrUnboxed jecxz copy_unboxed_closure_heapP _copy_argument_block_nodeP descP copy_unboxed_closure1 copy_unboxed_closure2 copy_unboxed_closure_heapP: popl arity _copy_block_to_heapP jmp copy_next_node copy_unboxed_closure_arity0: subl $2,free js garbage_collection addl $8,heapP jmp copy_next_node copy_unboxed_closure_arity1: subl $2,free js garbage_collection cmpl $0,nrUnboxed jne copy_unboxed_closure_arity1_value /* ** komt hier nooit dan zou het een record geweest ** moeten zijn */ _pushl1 heapP copy_unboxed_closure_arity1_1 addl $8,heapP jmp copy_next_node copy_unboxed_closure_arity1_value: movl (stringP),temp // get value movl temp,(heapP) // store it addl $4,stringP addl $8,heapP jmp copy_next_node #undef nrUnboxed #undef nrUnboxedL #undef nrPointers #undef nrPointersH #undef temp /* ** copy_done */ #define graph_string nodeP copy_done: movl esp_backup,%esp popl %esi movl graph_string_backup,graph_string movl 4(graph_string),%ecx #define temp descP movl graph_string_length,descP movl descP,4(graph_string) #undef temp ret #undef graph_string /* ** garbage_collection */ #define stringP2 nodeP garbage_collection: movl graph_string_backup,stringP2 leal 12(stringP2),stringP2 /* leal 8(stringP2),stringP2 // stringP2 at first descriptor pointer */ pushl free restore_next_descP: cmpl stringP,stringP2 // stringP2 => stringP jae start_over #define indirection descP movl (stringP2),indirection // get description pointer or indirection offset within string testl $1,indirection // indirection? jne skip_indirection // yes, skip indirection movl (indirection),descP // use indirection to get descriptor pointer movl descP,(stringP2) // restore descriptor pointer addl $4,stringP2 // advance in string testl $2,descP // in hnf? je restore_closure // no, restore closure #undef indirection cmpl $INT+2,descP je skip_integer cmpl $CHAR+2,descP je skip_integer cmpl $BOOL+2,descP je skip_integer cmpl $REAL+2,descP je skip_real cmpl $__STRING__+2,descP je skip_string cmpl $__ARRAY__+2,descP je skip_array movzwl -2(descP),arity subl $256,arity // arity < 256, only boxed arguments which take no string space jb restore_next_descP /* ** restore_boxed_record */ #define nrPointers free #define nrUnboxed arity restore_boxed_record: movzwl (descP),nrPointers subl nrPointers,nrUnboxed // nrUnboxed = arity - nrPointers leal (stringP2,nrUnboxed,4),stringP2 // stringP2 += nrUnboxed * 4 jmp restore_next_descP #undef nrPointers #undef nrUnboxed /* ** restore_closure */ restore_closure: movl -4(descP),arity cmpl $256,arity // arity < 256 jb restore_next_descP #define nrUnboxed descP #define nrUnboxedL %bl #define nrPointers arity #define nrPointersH %ch xorl nrUnboxed,nrUnboxed movb nrPointersH,nrUnboxedL // nrUnboxed = # unboxed arguments leal (stringP2,nrUnboxed,4),stringP2 // stringP2 += nrUnboxed * 4 jmp restore_next_descP #undef nrUnboxed #undef nrUnboxedL #undef nrPointers #undef nrPointersH /* ** skip_integer/skip_indirection */ skip_integer: skip_indirection: addl $4,stringP2 // skip integer jmp restore_next_descP /* ** skip_real */ skip_real: addl $8,stringP2 // skip real (two longs) jmp restore_next_descP /* ** skip_string */ #define size arity skip_string: movl (stringP2),size // get string size addl $7,size shrl $2,size // round up to allocated longs leal (stringP2,size,4),stringP2 // stringP2 = stringP2 + (# longs) * 4, skip string jmp restore_next_descP #undef size /* ** skip_array */ #define size arity skip_array: movl (stringP2),size // get size movl 4(stringP2),descP // get descP addl $8,stringP2 // stringP2 += 8 cmpl $0,size // size == 0 je restore_next_descP // nothing to skip cmpl $0,descP je restore_next_descP // only boxed arguments, nothing to skip cmpl $INT+2,descP je skip_int_array cmpl $BOOL+2,descP je skip_bool_array cmpl $REAL+2,descP je skip_real_array /* ** skip_record_array */ #define nrPointers free movzwl (descP),nrPointers // nrPointers = # boxed arguments pushl nodeP #define nrUnboxed nodeP movzwl -2(descP),nrUnboxed // nrUnboxed = total size of record (array element) subl $256,nrUnboxed subl nrPointers,nrUnboxed // nrUnboxed = size of unboxed part of record mull size movl %eax,size popl nodeP leal (stringP2,size,4),stringP2 // stringP2 += (nrUnboxed * size) * 4 jmp restore_next_descP #undef nrUnboxed #undef nrPointers skip_int_array: leal (stringP2,size,4),stringP2 // stringP2 += size * 4 jmp restore_next_descP skip_bool_array: addl $3,size shrl $2,size leal (stringP2,size,4),stringP2 // stringP2 = stringP2 + (# longs) * 4 jmp restore_next_descP skip_real_array: leal (stringP2,size,8),stringP2 // stringP2 += size * 8 jmp restore_next_descP #undef size #undef stringP2 /* ** start_over */ start_over: popl free movl graph_string_backup,%ecx #define temp nodeP movl graph_string_length,temp // restore length of string encoding the graph movl temp,4(%ecx) #undef temp movl esp_backup,%esp // restore B/C-stack popl %esi // restore A-stack movl old_heap_pointer,heapP // restore heap pointer #define usedCells nodeP movl initfree,usedCells subl free,usedCells // usedCells = # required cells leal -32(heapP,usedCells,4),free // compute new heap pointer #undef usedCells call collect_1l // try to garbage collect the required amount jmp copy__string__to__graph // enough memory, try again