diff options
| -rw-r--r-- | icompact.s | 2192 | ||||
| -rw-r--r-- | icopy.s | 1024 | ||||
| -rw-r--r-- | ifileIO3.s | 744 | ||||
| -rw-r--r-- | imark.s | 1880 | ||||
| -rw-r--r-- | scon.c | 843 | ||||
| -rw-r--r-- | scon.h | 14 | ||||
| -rw-r--r-- | uwrite_heap.c | 109 |
7 files changed, 6806 insertions, 0 deletions
diff --git a/icompact.s b/icompact.s new file mode 100644 index 0000000..895aa73 --- /dev/null +++ b/icompact.s @@ -0,0 +1,2192 @@ +/ mark used nodes and pointers in argument parts and link backward pointers + + movl heap_size_33,d0 + shl $5,d0 + movl d0,heap_size_32_33 + + movl caf_list,d0 + test d0,d0 + je end_mark_cafs + +mark_cafs_lp: + pushl -4(d0) + lea 4(d0),a2 + movl (d0),d0 + lea (a2,d0,4),a0 + movl a0,end_vector + + call mark_stack_nodes + + popl d0 + test d0,d0 + jne mark_cafs_lp + +end_mark_cafs: + movl stack_p,a2 + + movl stack_top,a0 + movl a0,end_vector + call mark_stack_nodes + +#ifdef MEASURE_GC + call add_mark_compact_garbage_collect_time +#endif + + jmp compact_heap + +mark_record: + subl $258,a2 + je mark_record_2 + jb mark_record_1 + +mark_record_3: + movzwl -2+2(d0),a2 + subl $1,a2 + jb mark_record_3_bb + je mark_record_3_ab + dec a2 + je mark_record_3_aab + jmp mark_hnf_3 + +mark_record_3_bb: + movl 8-4(a0),a1 + subl $4,a0 + + movl neg_heap_p3,d0 + addl a1,d0 + +#ifdef NO_BIT_INSTRUCTIONS + movl d0,a2 + andl $31*4,d0 + shrl $7,a2 + movl bit_set_table(d0),d0 + orl d0,(a4,a2,4) +#else + shrl $2,d0 + bts d0,(a4) +#endif + + cmpl a0,a1 + ja mark_next_node + +#ifdef NO_BIT_INSTRUCTIONS + add d0,d0 + jne bit_in_same_word1 + inc a2 + mov $1,d0 +bit_in_same_word1: + testl (a4,a2,4),d0 + je not_yet_linked_bb +#else + inc d0 + bts d0,(a4) + jnc not_yet_linked_bb +#endif + movl neg_heap_p3,d0 + addl a0,d0 + +#ifdef NO_BIT_INSTRUCTIONS + addl $2*4,d0 + movl d0,a2 + andl $31*4,d0 + shrl $7,a2 + movl bit_set_table(d0),d0 + orl d0,(a4,a2,4) +#else + shrl $2,d0 + addl $2,d0 + bts d0,(a4) +not_yet_linked_bb: +#endif + movl (a1),a2 + lea 8+2+1(a0),d0 + movl a2,8(a0) + movl d0,(a1) + jmp mark_next_node + +#ifdef NO_BIT_INSTRUCTIONS +not_yet_linked_bb: + orl d0,(a4,a2,4) + movl (a1),a2 + lea 8+2+1(a0),d0 + movl a2,8(a0) + movl d0,(a1) + jmp mark_next_node +#endif + +mark_record_3_ab: + movl 4(a0),a1 + + movl neg_heap_p3,d0 + addl a1,d0 + +#ifdef NO_BIT_INSTRUCTIONS + movl d0,a2 + andl $31*4,d0 + shrl $7,a2 + movl bit_set_table(d0),d0 + orl d0,(a4,a2,4) +#else + shr $2,d0 + bts d0,(a4) +#endif + cmpl a0,a1 + ja mark_hnf_1 + +#ifdef NO_BIT_INSTRUCTIONS + add d0,d0 + jne bit_in_same_word2 + inc a2 + mov $1,d0 +bit_in_same_word2: + testl (a4,a2,4),d0 + je not_yet_linked_ab +#else + inc d0 + bts d0,(a4) + jnc not_yet_linked_ab +#endif + + movl neg_heap_p3,d0 + addl a0,d0 + +#ifdef NO_BIT_INSTRUCTIONS + addl $4,d0 + movl d0,a2 + andl $31*4,d0 + shrl $7,a2 + movl bit_set_table(d0),d0 + orl d0,(a4,a2,4) +#else + shr $2,d0 + inc d0 + bts d0,(a4) +not_yet_linked_ab: +#endif + + movl (a1),a2 + lea 4+2+1(a0),d0 + movl a2,4(a0) + movl d0,(a1) + jmp mark_hnf_1 + +#ifdef NO_BIT_INSTRUCTIONS +not_yet_linked_ab: + orl d0,(a4,a2,4) + movl (a1),a2 + lea 4+2+1(a0),d0 + movl a2,4(a0) + movl d0,(a1) + jmp mark_hnf_1 +#endif + +mark_record_3_aab: + movl 4(a0),a1 + + movl neg_heap_p3,d0 + addl a1,d0 + +#ifdef NO_BIT_INSTRUCTIONS + movl d0,a2 + andl $31*4,d0 + shrl $7,a2 + movl bit_set_table(d0),d0 + testl (a4,a2,4),d0 + jne shared_argument_part + orl d0,(a4,a2,4) +#else + shr $2,d0 + bts d0,(a4) + jc shared_argument_part +#endif + addl $2,(a0) + movl a3,4(a0) + addl $4,a0 + + movl (a1),a3 + movl a0,(a1) + movl a3,a0 + lea 1(a1),a3 + jmp mark_node + +mark_record_2: +/ movzwl -2+2(d0),a2 +/ cmp $1,a2 + cmpw $1,-2+2(d0) + ja mark_hnf_2 + je mark_hnf_1 + subl $4,a0 + jmp mark_next_node + +mark_record_1: +/ movzwl -2+2(d0),a2 +/ test a2,a2 + cmpw $0,-2+2(d0) + jne mark_hnf_1 + subl $4,a0 + jmp mark_next_node + +mark_stack_nodes3: + pop a2 + + movl a0,-4(a2) + jmp mark_stack_nodes + +mark_stack_nodes2: + pop a2 + +mark_stack_nodes1: + movl (a0),d1 + leal 1-4(a2),d0 + movl d1,-4(a2) + movl d0,(a0) + +mark_stack_nodes: + cmpl end_vector,a2 + je end_mark_nodes + + movl (a2),a0 + addl $4,a2 + + movl neg_heap_p3,d0 + addl a0,d0 +#ifdef SHARE_CHAR_INT + cmpl heap_size_32_33,d0 + jnc mark_stack_nodes +#endif + +#ifdef NO_BIT_INSTRUCTIONS + movl d0,d1 + andl $31*4,d0 + + shrl $7,d1 + + movl bit_set_table(d0),d0 + + movl (a4,d1,4),a3 + + test d0,a3 + jne mark_stack_nodes1 + + orl d0,a3 + push a2 + + movl a3,(a4,d1,4) +#else + shrl $2,d0 + bts d0,(a4) + jc mark_stack_nodes1 + push a2 +#endif + + movl $1,a3 + +mark_arguments: + movl (a0),d0 + testb $2,d0 + je mark_lazy_node + + movzwl -2(d0),a2 + test a2,a2 + je mark_hnf_0 + + addl $4,a0 + + cmp $256,a2 + jae mark_record + + subl $2,a2 + je mark_hnf_2 + + jc mark_hnf_1 + +mark_hnf_3: + movl 4(a0),a1 + + movl neg_heap_p3,d0 + addl a1,d0 + +#ifdef NO_BIT_INSTRUCTIONS + movl d0,d1 + andl $31*4,d0 + + shrl $7,d1 + + movl bit_set_table(d0),d0 + + test (a4,d1,4),d0 + jne shared_argument_part + + orl d0,(a4,d1,4) +#else + shrl $2,d0 + bts d0,(a4) + jc shared_argument_part +#endif + +no_shared_argument_part: + orl $2,(a0) + movl a3,4(a0) + addl $4,a0 + + orl $1,(a1) + leal (a1,a2,4),a1 + + movl (a1),a2 + movl a0,(a1) + movl a1,a3 + movl a2,a0 + jmp mark_node + +shared_argument_part: + cmpl a0,a1 + ja mark_hnf_1 + + movl (a1),d1 + leal 4+2+1(a0),d0 + movl d0,(a1) + movl d1,4(a0) + jmp mark_hnf_1 + +mark_lazy_node_1: +/ selectors: + jne mark_selector_node_1 + +mark_hnf_1: + movl (a0),a2 + movl a3,(a0) + + leal 2(a0),a3 + movl a2,a0 + jmp mark_node + +/ selectors +mark_indirection_node: + movl neg_heap_p3,d1 + leal -4(a0,d1),d1 + +#ifdef NO_BIT_INSTRUCTIONS + movl d1,d0 + andl $31*4,d0 + shrl $7,d1 + movl bit_clear_table(d0),d0 + andl d0,(a4,d1,4) +#else + shrl $2,d1 + btr d1,(a4) +#endif + movl (a0),a0 + jmp mark_node + +mark_selector_node_1: + addl $3,a2 + je mark_indirection_node + + movl (a0),a1 + + movl neg_heap_p3,d1 + addl a1,d1 + shrl $2,d1 + + addl $1,a2 + jle mark_record_selector_node_1 + +#ifdef NO_BIT_INSTRUCTIONS + push d0 + movl d1,d0 + + shrl $5,d1 + andl $31,d0 + + movl bit_set_table(,d0,4),d0 + movl (a4,d1,4),d1 + + andl d0,d1 + + pop d0 + jne mark_hnf_1 +#else + bt d1,(a4) + jc mark_hnf_1 +#endif + movl (a1),d1 + testb $2,d1 + je mark_hnf_1 + + cmpw $2,-2(d1) + jbe small_tuple_or_record + +large_tuple_or_record: + movl 8(a1),d1 + addl neg_heap_p3,d1 + shrl $2,d1 + +#ifdef NO_BIT_INSTRUCTIONS + push d0 + movl d1,d0 + + shrl $5,d1 + andl $31,d0 + + movl bit_set_table(,d0,4),d0 + movl (a4,d1,4),d1 + + andl d0,d1 + + pop d0 + jne mark_hnf_1 +#else + bt d1,(a4) + jc mark_hnf_1 +#endif +small_tuple_or_record: + movl neg_heap_p3,d1 + + lea -4(a0,d1),d1 + + push a0 + +#ifdef NO_BIT_INSTRUCTIONS + movl d1,a0 + andl $31*4,a0 + shrl $7,d1 + movl bit_clear_table(a0),a0 + andl a0,(a4,d1,4) +#else + shrl $2,d1 + btr d1,(a4) +#endif + + movl -8(d0),d0 + + movl a1,a0 + push a2 + call *4(d0) + pop a2 + pop a1 + + movl $__indirection,-4(a1) + movl a0,(a1) + + jmp mark_node + +mark_record_selector_node_1: + je mark_strict_record_selector_node_1 + +#ifdef NO_BIT_INSTRUCTIONS + push d0 + movl d1,d0 + + shrl $5,d1 + andl $31,d0 + + movl bit_set_table(,d0,4),d0 + movl (a4,d1,4),d1 + + andl d0,d1 + + pop d0 + jne mark_hnf_1 +#else + bt d1,(a4) + jc mark_hnf_1 +#endif + movl (a1),d1 + testb $2,d1 + je mark_hnf_1 + + cmpw $258,-2(d1) + jbe small_tuple_or_record + jmp large_tuple_or_record + +mark_strict_record_selector_node_1: +#ifdef NO_BIT_INSTRUCTIONS + push d0 + movl d1,d0 + + shrl $5,d1 + andl $31,d0 + + movl bit_set_table(,d0,4),d0 + movl (a4,d1,4),d1 + + andl d0,d1 + + pop d0 + jne mark_hnf_1 +#else + bt d1,(a4) + jc mark_hnf_1 +#endif + movl (a1),d1 + testb $2,d1 + je mark_hnf_1 + + cmpw $258,-2(d1) + jbe select_from_small_record + + movl 8(a1),d1 + addl neg_heap_p3,d1 +#ifdef NO_BIT_INSTRUCTIONS + push d0 + movl d1,d0 + + shrl $7,d1 + andl $31*4,d0 + + movl bit_set_table(d0),d0 + movl (a4,d1,4),d1 + + andl d0,d1 + + pop d0 + jne mark_hnf_1 +#else + shrl $2,d1 + bt d1,(a4) + jc mark_hnf_1 +#endif + +select_from_small_record: +/ changed 24-1-97 + movl -8(d0),d0 + subl $4,a0 + + call *4(d0) + + jmp mark_next_node + +mark_hnf_2: + orl $2,(a0) + movl 4(a0),a2 + movl a3,4(a0) + leal 4(a0),a3 + movl a2,a0 + +mark_node: + movl neg_heap_p3,d0 + + addl a0,d0 + +#ifdef SHARE_CHAR_INT + cmpl heap_size_32_33,d0 + jnc mark_next_node_after_static +#endif + +#ifdef NO_BIT_INSTRUCTIONS + movl d0,d1 + andl $31*4,d0 + + shrl $7,d1 + + movl bit_set_table(d0),d0 + + movl (a4,d1,4),a2 + + test d0,a2 + jne mark_next_node + + orl d0,a2 + movl a2,(a4,d1,4) + jmp mark_arguments +#else + shrl $2,d0 + bts d0,(a4) + jnc mark_arguments +#endif + +/ a2,d1: free + +mark_next_node: + test $3,a3 + jne mark_parent + + movl -4(a3),a2 + movl $3,d1 + + andl a2,d1 + subl $4,a3 + + cmpl $3,d1 + je argument_part_cycle1 + + movl 4(a3),a1 + movl a1,K6_0(a3) + +c_argument_part_cycle1: + cmpl a3,a0 + ja no_reverse_1 + + movl (a0),a1 + leal 4+1(a3),d0 + movl a1,4(a3) + movl d0,(a0) + + orl d1,a3 + movl a2,a0 + xorl d1,a0 + jmp mark_node + +no_reverse_1: + movl a0,4(a3) + movl a2,a0 + orl d1,a3 + xorl d1,a0 + jmp mark_node + +mark_lazy_node: + movl -4(d0),a2 + test a2,a2 + je mark_next_node + + addl $4,a0 + + subl $1,a2 + jle mark_lazy_node_1 + + cmpl $255,a2 + jge mark_closure_with_unboxed_arguments + +mark_closure_with_unboxed_arguments_: + orl $2,(a0) + leal (a0,a2,4),a0 + + movl (a0),a2 + movl a3,(a0) + movl a0,a3 + movl a2,a0 + jmp mark_node + +mark_closure_with_unboxed_arguments: +/ (a_size+b_size)+(b_size<<8) +/ addl $1,a2 + movl a2,d0 + andl $255,a2 + shrl $8,d0 + subl d0,a2 +/ subl $1,a2 + jg mark_closure_with_unboxed_arguments_ + je mark_hnf_1 + subl $4,a0 + jmp mark_next_node + +mark_hnf_0: +#ifdef SHARE_CHAR_INT + cmpl $INT+2,d0 + je mark_int_3 + + cmpl $CHAR+2,d0 + je mark_char_3 + + jb no_normal_hnf_0 + + movl neg_heap_p3,d1 + addl a0,d1 +#ifdef NO_BIT_INSTRUCTIONS + movl d1,a0 + andl $31*4,a0 + shrl $7,d1 + movl bit_clear_table(a0),a0 + andl a0,(a4,d1,4) +#else + shrl $2,d1 + btr d1,(a4) +#endif + lea -2+ZERO_ARITY_DESCRIPTOR_OFFSET(d0),a0 + jmp mark_next_node_after_static + +mark_int_3: + movl 4(a0),a2 + cmpl $33,a2 + jnc mark_next_node + + movl neg_heap_p3,d1 + addl a0,d1 + +#ifdef NO_BIT_INSTRUCTIONS + movl d1,a0 + andl $31*4,a0 + shrl $7,d1 + movl bit_clear_table(a0),a0 + andl a0,(a4,d1,4) +#else + shrl $2,d1 + btr d1,(a4) +#endif + lea small_integers(,a2,8),a0 + jmp mark_next_node_after_static + +mark_char_3: + movl neg_heap_p3,d1 + + movzbl 4(a0),d0 + addl a0,d1 + +#ifdef NO_BIT_INSTRUCTIONS + movl d1,a2 + andl $31*4,a2 + shrl $7,d1 + movl bit_clear_table(a2),a2 + andl a2,(a4,d1,4) +#else + shrl $2,d1 + btr d1,(a4) +#endif + + lea static_characters(,d0,8),a0 + jmp mark_next_node_after_static + +no_normal_hnf_0: +#endif + + cmpl $__ARRAY__+2,d0 + jne mark_next_node + + movl 8(a0),d0 + test d0,d0 + je mark_lazy_array + + movzwl -2+2(d0),d1 + test d1,d1 + je mark_b_record_array + + movzwl -2(d0),d0 + test d0,d0 + je mark_b_record_array + + subl $256,d0 + cmpl d0,d1 + je mark_a_record_array + +mark_ab_record_array: + movl 4(a0),a1 + addl $8,a0 + pushl a0 + + imull d0,a1 + shl $2,a1 + + subl d1,d0 + addl $4,a0 + addl a0,a1 + call reorder + + popl a0 + movl d1,d0 + imull -4(a0),d0 + jmp mark_lr_array + +mark_b_record_array: + movl neg_heap_p3,d0 + addl a0,d0 +#ifdef NO_BIT_INSTRUCTIONS + addl $4,d0 + movl d0,a2 + andl $31*4,d0 + shrl $7,a2 + movl bit_set_table(d0),d0 + orl d0,(a4,a2,4) +#else + shrl $2,d0 + inc d0 + bts d0,(a4) +#endif + jmp mark_next_node + +mark_a_record_array: + movl 4(a0),d0 + addl $8,a0 + cmpl $2,d1 + jb mark_lr_array + + imull d1,d0 + jmp mark_lr_array + +mark_lazy_array: + movl 4(a0),d0 + addl $8,a0 + +mark_lr_array: + movl neg_heap_p3,d1 + addl a0,d1 + shrl $2,d1 + addl d0,d1 + +#ifdef NO_BIT_INSTRUCTIONS + movl d1,a1 + andl $31,d1 + shrl $5,a1 + movl bit_set_table(,d1,4),d1 + orl d1,(a4,a1,4) +#else + bts d1,(a4) +#endif + cmpl $1,d0 + jbe mark_array_length_0_1 + + movl a0,a1 + lea (a0,d0,4),a0 + + movl (a0),d0 + movl (a1),d1 + movl d0,(a1) + movl d1,(a0) + + movl -4(a0),d0 + subl $4,a0 + addl $2,d0 + movl -4(a1),d1 + subl $4,a1 + movl d1,(a0) + movl d0,(a1) + + movl -4(a0),d0 + subl $4,a0 + movl a3,(a0) + movl a0,a3 + movl d0,a0 + jmp mark_node + +mark_array_length_0_1: + lea -8(a0),a0 + jb mark_next_node + + movl 12(a0),d1 + movl 8(a0),a2 + movl a2,12(a0) + movl 4(a0),a2 + movl a2,8(a0) + movl d1,4(a0) + addl $4,a0 + jmp mark_hnf_1 + +/ a2: free + +mark_parent: + movl a3,d1 + andl $3,d1 + +/ xorl d1,a3 +/ test a3,a3 + + andl $-4,a3 + je mark_stack_nodes2 + + subl $1,d1 + je argument_part_parent + + movl K6_0(a3),a2 + + cmpl a3,a0 + ja no_reverse_2 + + movl a0,a1 + leal 1(a3),d0 + movl (a1),a0 + movl d0,(a1) + +no_reverse_2: + movl a0,K6_0(a3) + leal -4(a3),a0 + movl a2,a3 + jmp mark_next_node + + +argument_part_parent: + movl K6_0(a3),a2 + + movl a3,a1 + movl a0,a3 + movl a1,a0 + +/ movl (a1),a2 +skip_upward_pointers: + movl a2,d0 + andl $3,d0 + cmpl $3,d0 + jne no_upward_pointer + + leal -3(a2),a1 +/ movl (a1),a2 + movl -3(a2),a2 + jmp skip_upward_pointers + +no_upward_pointer: + cmpl a0,a3 + ja no_reverse_3 + + movl a3,d1 + movl K6_0(a3),a3 + leal 1(a0),d0 + movl d0,(d1) + +no_reverse_3: + movl a3,(a1) + lea -4(a2),a3 + + andl $-4,a3 + + movl a3,a1 + movl $3,d1 + + movl K6_0(a3),a2 + + andl a2,d1 + movl 4(a1),d0 + + orl d1,a3 + movl d0,(a1) + + cmpl a1,a0 + ja no_reverse_4 + + movl (a0),d0 + movl d0,4(a1) + leal 4+2+1(a1),d0 + movl d0,(a0) + movl a2,a0 + andl $-4,a0 + jmp mark_node + +no_reverse_4: + movl a0,4(a1) + movl a2,a0 + andl $-4,a0 + jmp mark_node + +argument_part_cycle1: + movl 4(a3),d0 + push a1 + +skip_pointer_list1: + movl a2,a1 + andl $-4,a1 + movl (a1),a2 + movl $3,d1 + andl a2,d1 + cmpl $3,d1 + je skip_pointer_list1 + + movl d0,(a1) + pop a1 + jmp c_argument_part_cycle1 + +#ifdef SHARE_CHAR_INT +mark_next_node_after_static: + test $3,a3 + jne mark_parent_after_static + + movl -4(a3),a2 + movl $3,d1 + + andl a2,d1 + subl $4,a3 + + cmpl $3,d1 + je argument_part_cycle2 + + movl 4(a3),d0 + movl d0,K6_0(a3) + +c_argument_part_cycle2: + movl a0,4(a3) + movl a2,a0 + orl d1,a3 + xorl d1,a0 + jmp mark_node + +mark_parent_after_static: + movl a3,d1 + andl $3,d1 + +/ xorl d1,a3 +/ test a3,a3 + + andl $-4,a3 + je mark_stack_nodes3 + + subl $1,d1 + je argument_part_parent_after_static + + movl K6_0(a3),a2 + movl a0,K6_0(a3) + leal -4(a3),a0 + movl a2,a3 + jmp mark_next_node + +argument_part_parent_after_static: + movl K6_0(a3),a2 + + movl a3,a1 + movl a0,a3 + movl a1,a0 + +/ movl (a1),a2 +skip_upward_pointers_2: + movl a2,d0 + andl $3,d0 + cmpl $3,d0 + jne no_reverse_3 + +/ movl a2,a1 +/ andl $-4,a1 +/ movl (a1),a2 + lea -3(a2),a1 + movl -3(a2),a2 + jmp skip_upward_pointers_2 + +argument_part_cycle2: + movl 4(a3),d0 + push a1 + +skip_pointer_list2: + movl a2,a1 + andl $-4,a1 + movl (a1),a2 + movl $3,d1 + andl a2,d1 + cmpl $3,d1 + je skip_pointer_list2 + + movl d0,(a1) + pop a1 + jmp c_argument_part_cycle2 +#endif + +end_mark_nodes: + ret + +/ compact the heap + +compact_heap: + movl heap_size_33,d0 + movl d0,d1 + shl $5,d1 +#ifdef SHARE_CHAR_INT + addl heap_p3,d1 +#endif + movl d1,end_heap_p3 + + addl $3,d0 + shr $2,d0 + + movl heap_vector,a0 + + lea 4(a0),d1 + negl d1 + movl d1,neg_heap_vector_plus_4 + + movl heap_p3,a4 + xorl a3,a3 + jmp skip_zeros + +move_record: + subl $258,d1 + jb move_record_1 + je move_record_2 + +move_record_3: + movzwl -2+2(d0),d1 + subl $1,d1 + ja move_hnf_3 + + movl (a0),a1 + lea 4(a0),a0 + jb move_record_3_1b + +move_record_3_1a: + cmpl a0,a1 + jb move_record_3_1b +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jae move_record_3_1b +#endif + lea 1(a4),d0 + movl (a1),d1 + movl d0,(a1) + movl d1,a1 +move_record_3_1b: + movl a1,(a4) + addl $4,a4 + + movl (a0),a1 + addl $4,a0 + cmpl a0,a1 + jb move_record_3_2 +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jae move_record_3_2 +#endif + movl neg_heap_p3,d0 +#ifdef NO_BIT_INSTRUCTIONS + pushl a2 +#endif + addl a1,d0 + +#ifdef NO_BIT_INSTRUCTIONS + movl heap_vector,d1 + addl $4,d0 + movl d0,a2 + andl $31*4,a2 + shrl $7,d0 + movl bit_set_table(a2),a2 + testl (d1,d0,4),a2 + je not_linked_record_argument_part_3_b +#else + shr $2,d0 + inc d0 + + movl heap_vector,d1 + bts d0,(d1) + jnc not_linked_record_argument_part_3_b +#endif + + movl neg_heap_p3,d0 + addl a4,d0 + +#ifdef NO_BIT_INSTRUCTIONS + movl d0,a2 + andl $31*4,a2 + shrl $7,d0 + movl bit_set_table(a2),a2 + orl a2,(d1,d0,4) + popl a2 +#else + shr $2,d0 + bts d0,(d1) +#endif + jmp linked_record_argument_part_3_b + +not_linked_record_argument_part_3_b: +#ifdef NO_BIT_INSTRUCTIONS + orl a2,(d1,d0,4) +#endif + movl neg_heap_p3,d0 + addl a4,d0 + +#ifdef NO_BIT_INSTRUCTIONS + movl d0,a2 + andl $31*4,a2 + shrl $7,d0 + movl bit_clear_table(a2),a2 + andl a2,(d1,d0,4) + popl a2 +#else + shr $2,d0 + btr d0,(d1) +#endif + +linked_record_argument_part_3_b: + movl (a1),d1 + lea 2+1(a4),d0 + movl d0,(a1) + movl d1,a1 +move_record_3_2: + movl a1,(a4) + addl $4,a4 + + movl neg_heap_p3,d1 + addl a0,d1 + shr $2,d1 + dec d1 + andl $31,d1 + cmp $2,d1 + jb bit_in_next_word + +#ifdef NO_BIT_INSTRUCTIONS + andl bit_clear_table(,d1,4),a3 +#else + btr d1,a3 +#endif + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +bit_in_next_word: + movl vector_counter,d0 + movl vector_p,a0 + dec d0 + movl (a0),a3 + addl $4,a0 + +#ifdef NO_BIT_INSTRUCTIONS + andl bit_clear_table(,d1,4),a3 +#else + btr d1,a3 +#endif + testl a3,a3 + je skip_zeros + jmp end_skip_zeros + +move_record_2: + cmpw $1,-2+2(d0) + ja move_hnf_2 + jb move_real_or_file + +move_record_2_ab: + movl (a0),a1 + addl $4,a0 + cmpl a0,a1 + jb move_record_2_1 +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jae move_record_2_1 +#endif + lea 1(a4),d0 + movl (a1),d1 + movl d0,(a1) + movl d1,a1 +move_record_2_1: + movl a1,(a4) + movl (a0),d1 + addl $4,a0 + movl d1,4(a4) + addl $8,a4 + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_record_1: + movzwl -2+2(d0),d1 + test d1,d1 + jne move_hnf_1 + jmp move_int_bool_or_char + +/ d0,a0,a2: free +find_non_zero_long: + movl vector_counter,d0 + movl vector_p,a0 +skip_zeros: + subl $1,d0 + jc end_copy + movl (a0),a3 + addl $4,a0 + testl a3,a3 + je skip_zeros +/ a2: free +end_skip_zeros: + movl neg_heap_vector_plus_4,a2 + movl d0,vector_counter + + addl a0,a2 + movl a0,vector_p + + shl $5,a2 + addl heap_p3,a2 + +#ifdef NO_BIT_INSTRUCTIONS +bsf_and_copy_nodes: + movl a3,d0 + movl a3,a0 + andl $0xff,d0 + jne found_bit1 + andl $0xff00,a0 + jne found_bit2 + movl a3,d0 + movl a3,a0 + andl $0xff0000,d0 + jne found_bit3 + shrl $24,a0 + movzbl first_one_bit_table(,a0,1),d1 + addl $24,d1 + jmp copy_nodes + +found_bit3: + shrl $16,d0 + movzbl first_one_bit_table(,d0,1),d1 + addl $16,d1 + jmp copy_nodes + +found_bit2: + shrl $8,a0 + movzbl first_one_bit_table(,a0,1),d1 + addl $8,d1 + jmp copy_nodes + +found_bit1: + movzbl first_one_bit_table(,d0,1),d1 +#else + bsf a3,d1 +#endif + +copy_nodes: + movl (a2,d1,4),d0 +#ifdef NO_BIT_INSTRUCTIONS + andl bit_clear_table(,d1,4),a3 +#else + btr d1,a3 +#endif + leal 4(a2,d1,4),a0 + dec d0 + + test $2,d0 + je begin_update_list_2 + + movl -10(d0),d1 + subl $2,d0 + + test $1,d1 + je end_list_2 +find_descriptor_2: + andl $-4,d1 + movl (d1),d1 + test $1,d1 + jne find_descriptor_2 + +end_list_2: + movl d1,a1 + movzwl -2(d1),d1 + cmpl $256,d1 + jb no_record_arguments + + movzwl -2+2(a1),a1 + subl $2,a1 + jae copy_record_arguments_aa + + subl $256+3,d1 + +copy_record_arguments_all_b: + pushl d1 + movl heap_vector,d1 + +update_up_list_1r: + movl d0,a1 + addl neg_heap_p3,d0 + +#ifdef NO_BIT_INSTRUCTIONS + push a0 + movl d0,a0 + + shrl $7,d0 + andl $31*4,a0 + + movl bit_set_table(,a0,1),a0 + movl (d1,d0,4),d0 + + andl a0,d0 + + pop a0 + je copy_argument_part_1r +#else + shrl $2,d0 + bt d0,(d1) + jnc copy_argument_part_1r +#endif + movl (a1),d0 + movl a4,(a1) + subl $3,d0 + jmp update_up_list_1r + +copy_argument_part_1r: + movl (a1),d0 + movl a4,(a1) + movl d0,(a4) + addl $4,a4 + + movl neg_heap_p3,d0 + addl a0,d0 + shr $2,d0 + + mov d0,d1 + andl $31,d1 + cmp $1,d1 + jae bit_in_this_word + + movl vector_counter,d0 + movl vector_p,a1 + dec d0 + movl (a1),a3 + addl $4,a1 + + movl neg_heap_vector_plus_4,a2 + addl a1,a2 + shl $5,a2 + addl heap_p3,a2 + + movl a1,vector_p + movl d0,vector_counter + +bit_in_this_word: +#ifdef NO_BIT_INSTRUCTIONS + andl bit_clear_table(,d1,4),a3 +#else + btr d1,a3 +#endif + popl d1 + +copy_b_record_argument_part_arguments: + movl (a0),d0 + addl $4,a0 + movl d0,(a4) + addl $4,a4 + subl $1,d1 + jnc copy_b_record_argument_part_arguments + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +copy_record_arguments_aa: + subl $256+2,d1 + subl a1,d1 + + pushl d1 + pushl a1 + +update_up_list_2r: + movl d0,a1 + movl (a1),d0 + movl $3,d1 + andl d0,d1 + subl $3,d1 + jne copy_argument_part_2r + + movl a4,(a1) + subl $3,d0 + jmp update_up_list_2r + +copy_argument_part_2r: + movl a4,(a1) + cmpl a0,d0 + jb copy_record_argument_2 +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,d0 + jae copy_record_argument_2 +#endif + movl d0,a1 + movl (a1),d0 + lea 1(a4),d1 + movl d1,(a1) +copy_record_argument_2: + movl d0,(a4) + addl $4,a4 + + popl d1 + subl $1,d1 + jc no_pointers_in_record + +copy_record_pointers: + movl (a0),a1 + addl $4,a0 + cmpl a0,a1 + jb copy_record_pointers_2 +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jae copy_record_pointers_2 +#endif + movl (a1),d0 + inc a4 + movl a4,(a1) + dec a4 + movl d0,a1 +copy_record_pointers_2: + movl a1,(a4) + addl $4,a4 + subl $1,d1 + jnc copy_record_pointers + +no_pointers_in_record: + popl d1 + + subl $1,d1 + jc no_non_pointers_in_record + +copy_non_pointers_in_record: + movl (a0),d0 + addl $4,a0 + movl d0,(a4) + addl $4,a4 + subl $1,d1 + jnc copy_non_pointers_in_record + +no_non_pointers_in_record: +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +no_record_arguments: + subl $3,d1 +update_up_list_2: + movl d0,a1 + movl (d0),d0 + inc d0 + movl a4,(a1) + testb $3,d0 + jne copy_argument_part_2 + + subl $4,d0 + jmp update_up_list_2 + +copy_argument_part_2: + dec d0 + cmpl a0,d0 + jc copy_arguments_1 +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,d0 + jnc copy_arguments_1 +#endif + movl d0,a1 + movl (d0),d0 + inc a4 + movl a4,(a1) + dec a4 +copy_arguments_1: + movl d0,(a4) + addl $4,a4 + +copy_argument_part_arguments: + movl (a0),a1 + addl $4,a0 + cmpl a0,a1 + jc copy_arguments_2 +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jnc copy_arguments_2 +#endif + movl (a1),d0 + inc a4 + movl a4,(a1) + dec a4 + movl d0,a1 +copy_arguments_2: + movl a1,(a4) + addl $4,a4 + subl $1,d1 + jnc copy_argument_part_arguments + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +update_list_2_: + dec d0 +update_list_2: + movl a4,(a1) +begin_update_list_2: + movl d0,a1 + movl (d0),d0 +update_list__2: + test $1,d0 + jz end_update_list_2 + test $2,d0 + jz update_list_2_ + lea -3(d0),a1 + movl -3(d0),d0 + jmp update_list__2 + +end_update_list_2: + movl a4,(a1) + + movl d0,(a4) + addl $4,a4 + + testb $2,d0 + je move_lazy_node + + movzwl -2(d0),d1 + testl d1,d1 + je move_hnf_0 + + cmp $256,d1 + jae move_record + + subl $2,d1 + jc move_hnf_1 + je move_hnf_2 + +move_hnf_3: + movl (a0),a1 + addl $4,a0 + cmpl a0,a1 + jc move_hnf_3_1 +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jnc move_hnf_3_1 +#endif + lea 1(a4),d0 + movl (a1),d1 + movl d0,(a1) + movl d1,a1 +move_hnf_3_1: + movl a1,(a4) + + movl (a0),a1 + addl $4,a0 + cmpl a0,a1 + jc move_hnf_3_2 +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jnc move_hnf_3_2 +#endif + lea 4+2+1(a4),d0 + movl (a1),d1 + movl d0,(a1) + movl d1,a1 +move_hnf_3_2: + movl a1,4(a4) + addl $8,a4 + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_hnf_2: + movl (a0),a1 + addl $4,a0 + cmpl a0,a1 + jc move_hnf_2_1 +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jnc move_hnf_2_1 +#endif + lea 1(a4),d0 + movl (a1),d1 + movl d0,(a1) + movl d1,a1 +move_hnf_2_1: + movl a1,(a4) + + movl (a0),a1 + addl $4,a0 + cmpl a0,a1 + jc move_hnf_2_2 +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jnc move_hnf_2_2 +#endif + lea 4+1(a4),d0 + movl (a1),d1 + movl d0,(a1) + movl d1,a1 +move_hnf_2_2: + movl a1,4(a4) + addl $8,a4 + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_hnf_1: + movl (a0),a1 + addl $4,a0 + cmpl a0,a1 + jc move_hnf_1_ +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jnc move_hnf_1_ +#endif + lea 1(a4),d0 + movl (a1),d1 + movl d0,(a1) + movl d1,a1 +move_hnf_1_: + movl a1,(a4) + addl $4,a4 + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_real_or_file: + movl (a0),d0 + addl $4,a0 + movl d0,(a4) + addl $4,a4 +move_int_bool_or_char: + movl (a0),d0 + addl $4,a0 + movl d0,(a4) + addl $4,a4 +copy_normal_hnf_0: +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_hnf_0: + cmpl $INT+2,d0 + jb move_real_file_string_or_array + cmpl $CHAR+2,d0 + jbe move_int_bool_or_char +#ifdef DLL +move_normal_hnf_0: +#endif + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_real_file_string_or_array: + cmpl $__STRING__+2,d0 + ja move_real_or_file + jne move_array + + movl (a0),d0 + addl $3,d0 + shr $2,d0 + +cp_s_arg_lp3: + movl (a0),d1 + addl $4,a0 + movl d1,(a4) + addl $4,a4 + subl $1,d0 + jnc cp_s_arg_lp3 + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_array: +#ifdef DLL + cmpl $__ARRAY__+2,d0 + jb move_normal_hnf_0 +#endif +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_end_array_bit +#else + bsf a3,d1 + jne end_array_bit +#endif + pushl a0 + + movl vector_counter,d0 + movl vector_p,a0 + +skip_zeros_a: + subl $1,d0 + movl (a0),a3 + addl $4,a0 + testl a3,a3 + je skip_zeros_a + + movl neg_heap_vector_plus_4,a2 + addl a0,a2 + movl d0,vector_counter + + shl $5,a2 + movl a0,vector_p + + addl heap_p3,a2 + popl a0 + +#ifdef NO_BIT_INSTRUCTIONS +bsf_and_end_array_bit: + movl a3,d0 + movl a3,a1 + andl $0xff,d0 + jne a_found_bit1 + andl $0xff00,a1 + jne a_found_bit2 + movl a3,d0 + movl a3,a1 + andl $0xff0000,d0 + jne a_found_bit3 + shrl $24,a1 + movzbl first_one_bit_table(,a1,1),d1 + addl $24,d1 + jmp end_array_bit +a_found_bit3: + shrl $16,d0 + movzbl first_one_bit_table(,d0,1),d1 + addl $16,d1 + jmp end_array_bit +a_found_bit2: + shrl $8,a1 + movzbl first_one_bit_table(,a1,1),d1 + addl $8,d1 + jmp end_array_bit +a_found_bit1: + movzbl first_one_bit_table(,d0,1),d1 + +#else + bsf a3,d1 +#endif + +end_array_bit: +#ifdef NO_BIT_INSTRUCTIONS + andl bit_clear_table(,d1,4),a3 +#else + btr d1,a3 +#endif + leal (a2,d1,4),d1 + + cmpl d1,a0 + jne move_a_array + +move_b_array: + movl (a0),a1 + movl a1,(a4) + movl 4(a0),d1 + addl $4,a0 + movzwl -2(d1),d0 + addl $4,a4 + test d0,d0 + je move_strict_basic_array + + subl $256,d0 + imull d0,a1 + movl a1,d0 + jmp cp_s_arg_lp3 + +move_strict_basic_array: + movl a1,d0 + cmpl $INT+2,d1 + je cp_s_arg_lp3 + + cmpl $BOOL+2,d1 + je move_bool_array + + addl d0,d0 + jmp cp_s_arg_lp3 + +move_bool_array: + addl $3,d0 + shr $2,d0 + jmp cp_s_arg_lp3 + +move_a_array: + movl d1,a1 + subl a0,d1 + shr $2,d1 + + pushl a3 + + subl $1,d1 + jb end_array + + movl (a0),a3 + movl -4(a1),d0 + movl a3,-4(a1) + movl d0,(a4) + movl (a1),d0 + movl 4(a0),a3 + addl $8,a0 + movl a3,(a1) + movl d0,4(a4) + addl $8,a4 + test d0,d0 + je st_move_array_lp + + movzwl -2+2(d0),a3 + movzwl -2(d0),d0 + subl $256,d0 + cmpl a3,d0 + je st_move_array_lp + +move_array_ab: + pushl a0 + + movl -8(a4),a1 + movl a3,d1 + imull d0,a1 + shl $2,a1 + + subl d1,d0 + addl a0,a1 + call reorder + + popl a0 + subl $1,d1 + subl $1,d0 + + pushl d1 + pushl d0 + pushl -8(a4) + jmp st_move_array_lp_ab + +move_array_ab_lp1: + movl 8(sp),d0 +move_array_ab_a_elements: + movl (a0),d1 + addl $4,a0 + cmpl a0,d1 + jb move_array_element_ab +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,d1 + jnc move_array_element_ab +#endif + movl d1,a1 + movl (a1),d1 + inc a4 + movl a4,(a1) + dec a4 +move_array_element_ab: + movl d1,(a4) + addl $4,a4 + subl $1,d0 + jnc move_array_ab_a_elements + + movl 4(sp),d0 +move_array_ab_b_elements: + movl (a0),d1 + addl $4,a0 + movl d1,(a4) + addl $4,a4 + subl $1,d0 + jnc move_array_ab_b_elements + +st_move_array_lp_ab: + subl $1,(sp) + jnc move_array_ab_lp1 + + addl $12,sp + jmp end_array + +move_array_lp1: + movl (a0),d0 + addl $4,a0 + addl $4,a4 + cmpl a0,d0 + jb move_array_element +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,d0 + jnc move_array_element +#endif + movl (d0),a3 + movl d0,a1 + movl a3,-4(a4) + leal -4+1(a4),d0 + movl d0,(a1) + + subl $1,d1 + jnc move_array_lp1 + + jmp end_array + +move_array_element: + movl d0,-4(a4) +st_move_array_lp: + subl $1,d1 + jnc move_array_lp1 + +end_array: + popl a3 + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_lazy_node: + movl d0,a1 + movl -4(a1),d1 + test d1,d1 + je move_lazy_node_0 + + subl $1,d1 + jle move_lazy_node_1 + + cmpl $256,d1 + jge move_closure_with_unboxed_arguments + +move_lazy_node_arguments: + movl (a0),a1 + addl $4,a0 + cmpl a0,a1 + jc move_lazy_node_arguments_ +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jnc move_lazy_node_arguments_ +#endif + movl (a1),d0 + movl d0,(a4) + lea 1(a4),d0 + addl $4,a4 + movl d0,(a1) + subl $1,d1 + jnc move_lazy_node_arguments + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_lazy_node_arguments_: + movl a1,(a4) + addl $4,a4 + subl $1,d1 + jnc move_lazy_node_arguments + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_lazy_node_1: + movl (a0),a1 + addl $4,a0 + cmpl a0,a1 + jc move_lazy_node_1_ +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jnc move_lazy_node_1_ +#endif + lea 1(a4),d0 + movl (a1),d1 + movl d0,(a1) + movl d1,a1 +move_lazy_node_1_: + movl a1,(a4) + addl $8,a4 + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_lazy_node_0: + addl $8,a4 + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_closure_with_unboxed_arguments: + je move_closure_with_unboxed_arguments_1 + addl $1,d1 + movl d1,d0 + andl $255,d1 + shrl $8,d0 + subl d0,d1 + je move_non_pointers_of_closure + + pushl d0 + +move_closure_with_unboxed_arguments_lp: + movl (a0),a1 + addl $4,a0 + cmpl a0,a1 + jc move_closure_with_unboxed_arguments_ +#ifdef SHARE_CHAR_INT + cmpl end_heap_p3,a1 + jnc move_closure_with_unboxed_arguments_ +#endif + movl (a1),d0 + movl d0,(a4) + lea 1(a4),d0 + addl $4,a4 + movl d0,(a1) + subl $1,d1 + jne move_closure_with_unboxed_arguments_lp + + popl d0 + jmp move_non_pointers_of_closure + +move_closure_with_unboxed_arguments_: + movl a1,(a4) + addl $4,a4 + subl $1,d1 + jne move_closure_with_unboxed_arguments_lp + + popl d0 + +move_non_pointers_of_closure: + movl (a0),d1 + addl $4,a0 + movl d1,(a4) + addl $4,a4 + subl $1,d0 + jne move_non_pointers_of_closure + +#ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +#else + bsf a3,d1 + jne copy_nodes +#endif + jmp find_non_zero_long + +move_closure_with_unboxed_arguments_1: + movl (a0),d0 + movl d0,(a4) + addl $8,a4 +# ifdef NO_BIT_INSTRUCTIONS + test a3,a3 + jne bsf_and_copy_nodes +# else + bsf a3,d1 + jne copy_nodes +# endif + jmp find_non_zero_long + +end_copy: @@ -0,0 +1,1024 @@ + + push a3 + + mov heap_p2,a4 + + mov heap_size_129,d0 + shl $6,d0 + + mov d0,semi_space_size + lea (a4,d0),a3 + +#ifdef WRITE_HEAP + movl a3,heap2_begin_and_end+4 +#endif + + movl caf_list,d0 + test d0,d0 + je end_copy_cafs + +copy_cafs_lp: + pushl -4(d0) + + lea 4(d0),a2 + movl (d0),d1 + subl $1,d1 + call copy_lp2 + + popl d0 + test d0,d0 + jne copy_cafs_lp + +end_copy_cafs: + movl (sp),d1 + mov stack_p,a2 + sub a2,d1 + shr $2,d1 + + sub $1,d1 + jb end_copy0 + call copy_lp2 +end_copy0: + mov heap_p2,a2 + + jmp copy_lp1 +/ +/ Copy all referenced nodes to the other semi space +/ + +in_hnf_1_2: + dec d1 +copy_lp2_lp1: + call copy_lp2 +copy_lp1: + cmp a4,a2 + jae end_copy1 + + mov (a2),d0 + add $4,a2 + testb $2,d0 + je not_in_hnf_1 +in_hnf_1: + movzwl -2(d0),d1 + + test d1,d1 +#ifdef NO_COPY_TO_END + je skip_hnf_0 +#endif + je copy_array_21 + + cmp $2,d1 + jbe in_hnf_1_2 + + cmp $256,d1 + jae copy_record_21 + + mov 4(a2),d0 + + testb $1,d0 + + jne node_without_arguments_part + + push d1 + xorl d1,d1 + + call copy_lp2 + + pop d1 + add $4,a2 + + sub $2,d1 + jmp copy_lp2_lp1 + +#ifdef NO_COPY_TO_END +skip_hnf_0: + add $4,a2 + cmp $INT+2,d0 + jae copy_lp1 +skip_real_file_or_string: + add $4,a2 + jmp copy_lp1 +#endif + +node_without_arguments_part: + dec d0 + xorl d1,d1 + + mov d0,4(a2) + call copy_lp2 + + add $4,a2 + jmp copy_lp1 + +copy_record_21: + subl $258,d1 + ja copy_record_arguments_3 + + movzwl -2+2(d0),d1 + jb copy_record_arguments_1 + + subl $1,d1 + ja copy_lp2_lp1 + je copy_node_arity1 + addl $8,a2 + jmp copy_lp1 + +copy_record_arguments_1: + dec d1 + je copy_lp2_lp1 + addl $4,a2 + jmp copy_lp1 + +copy_record_arguments_3: + testb $1,4(a2) + jne record_node_without_arguments_part + + movzwl -2+2(d0),a1 + test a1,a1 + je copy_record_arguments_3b + subl $1,a1 + je copy_record_arguments_3abb + + lea 3*4(a2,d1,4),a0 + pushl a0 + pushl a1 + + sub d1,d1 + call copy_lp2 + + addl $4,a2 + popl d1 + dec d1 + call copy_lp2 + + popl a2 + jmp copy_lp1 + +copy_record_arguments_3abb: + pushl d1 + sub d1,d1 + + call copy_lp2 + + popl d1 + + lea 2*4(a2,d1,4),a2 + jmp copy_lp1 + +copy_record_arguments_3b: + lea 3*4(a2,d1,4),a2 + jmp copy_lp1 + +record_node_without_arguments_part: + andl $-2,4(a2) + + cmpw $0,-2+2(d0) + je record_node_without_arguments_part_3b + + sub d1,d1 + call copy_lp2 + + addl $4,a2 + jmp copy_lp1 + +record_node_without_arguments_part_3b: + addl $8,a2 + jmp copy_lp1 + +not_in_hnf_1: + mov -4(d0),d1 + cmpl $257,d1 + jge copy_unboxed_closure_arguments + sub $1,d1 + jg copy_lp2_lp1 + +copy_node_arity1: +#ifdef NO_COPY_TO_END + jb skip_node_arity0 +#endif + xorl d1,d1 + call copy_lp2 + + add $4,a2 + jmp copy_lp1 + +#ifdef NO_COPY_TO_END +skip_node_arity0: + add $8,a2 + jmp copy_lp1 +#endif + +copy_unboxed_closure_arguments: + je copy_unboxed_closure_arguments1 + + xorl d0,d0 + movb d1hb,d0lb + andl $255,d1 + sub d0,d1 + + subl $1,d1 + jl copy_unboxed_closure_arguments_without_pointers + + pushl d0 + call copy_lp2 + popl d0 + +copy_unboxed_closure_arguments_without_pointers: + lea (a2,d0,4),a2 + jmp copy_lp1 + +copy_unboxed_closure_arguments1: + addl $8,a2 + jmp copy_lp1 + +copy_array_21: + movl 4(a2),d1 + addl $8,a2 + test d1,d1 + je copy_array_21_a + + movzwl -2(d1),d0 + movzwl -2+2(d1),d1 + subl $256,d0 + test d1,d1 + je copy_array_21_b + + cmpl d0,d1 + je copy_array_21_r_a + +copy_array_21_ab: + cmpl $0,-8(a2) + je copy_lp1 + + subl d1,d0 + shl $2,d0 + subl $1,d1 + + pushl d1 + pushl d0 + movl -8(a2),d1 + subl $1,d1 + pushl d1 + +copy_array_21_lp_ab: + movl 8(sp),d1 + call copy_lp2 + + addl 4(sp),a2 + subl $1,(sp) + jnc copy_array_21_lp_ab + + addl $12,sp + jmp copy_lp1 + +copy_array_21_b: + movl -8(a2),d1 + imull d0,d1 + lea (a2,d1,4),a2 + jmp copy_lp1 + +copy_array_21_r_a: + movl -8(a2),d1 + imull d0,d1 + subl $1,d1 + jc copy_lp1 + jmp copy_lp2_lp1 + +copy_array_21_a: + movl -8(a2),d1 + subl $1,d1 + jc copy_lp1 + jmp copy_lp2_lp1 + +/ +/ Copy nodes to the other semi-space +/ + +copy_lp2: + movl (a2),a1 + +/ selectors: +continue_after_selector_2: + movl (a1),a0 + testb $2,a0 + je not_in_hnf_2 + +in_hnf_2: + movzwl -2(a0),d0 + test d0,d0 + je copy_arity_0_node2 + + cmp $256,d0 + jae copy_record_2 + + sub $2,d0 + mov a4,(a2) + + lea 4(a2),a2 + ja copy_hnf_node2_3 + + mov a0,(a4) + jb copy_hnf_node2_1 + + inc a4 + mov 4(a1),a0 + + mov a4,(a1) + mov 8(a1),d0 + + sub $1,d1 + mov a0,4-1(a4) + + mov d0,8-1(a4) + lea 12-1(a4),a4 + + jae copy_lp2 + ret + +copy_hnf_node2_1: + inc a4 + mov 4(a1),d0 + + sub $1,d1 + mov a4,(a1) + + mov d0,4-1(a4) + lea 8-1(a4),a4 + + jae copy_lp2 + ret + +copy_hnf_node2_3: + mov a0,(a4) + inc a4 + + mov a4,(a1) + mov 4(a1),a0 + + mov a0,4-1(a4) + mov 8(a1),a0 + + add $12-1,a4 + mov (a0),a1 + + testb $1,a1 + jne arguments_already_copied_2 + + mov a4,-4(a4) + add $4,a0 + + mov a1,(a4) + inc a4 + + mov a4,-4(a0) + add $4-1,a4 + +cp_hnf_arg_lp2: + mov (a0),a1 + add $4,a0 + + mov a1,(a4) + add $4,a4 + + dec d0 + jne cp_hnf_arg_lp2 + + sub $1,d1 + jae copy_lp2 + ret + +arguments_already_copied_2: + mov a1,-4(a4) + + sub $1,d1 + jae copy_lp2 + ret + +copy_arity_0_node2: + cmp $INT+2,a0 + jb copy_real_file_or_string_2 + + cmp $CHAR+2,a0 + ja copy_normal_hnf_0_2 + +copy_int_bool_or_char_2: +#ifdef SHARE_CHAR_INT + mov 4(a1),d0 + je copy_char_2 + + cmp $INT+2,a0 + jne no_small_int_or_char_2 + +copy_int_2: + cmp $33,d0 + jae no_small_int_or_char_2 + + shl $3,d0 + add $4,a2 + + add $small_integers,d0 + sub $1,d1 + + mov d0,-4(a2) + jae copy_lp2 + + ret + +copy_char_2: + andl $255,d0 + + shl $3,d0 + add $4,a2 + + add $static_characters,d0 + sub $1,d1 + + mov d0,-4(a2) + jae copy_lp2 + ret + +no_small_int_or_char_2: +#else +no_small_int_or_char_2: + mov 4(a1),d0 +#endif + +#ifdef NO_COPY_TO_END + mov a0,(a4) + mov d0,4(a4) + mov a4,(a2) + inc a4 + mov a4,(a1) + add $7,a4 + add $4,a2 +#else + mov a0,-8(a3) + add $4,a2 + + mov d0,-4(a3) + sub $7,a3 + + mov a3,(a1) + dec a3 + + mov a3,-4(a2) +#endif + + sub $1,d1 + jae copy_lp2 + ret + +copy_normal_hnf_0_2: +#ifdef SHARE_CHAR_INT + sub $2-ZERO_ARITY_DESCRIPTOR_OFFSET,a0 + sub $1,d1 + + mov a0,(a2) + lea 4(a2),a2 +#else + mov a0,-4(a3) + sub $3,a3 + mov a3,(a1) + dec a3 + mov a3,(a2) + add $4,a2 + sub $1,d1 +#endif + jae copy_lp2 + ret + +copy_real_file_or_string_2: + cmpl $__STRING__+2,a0 + jbe copy_string_or_array_2 + +copy_real_or_file_2: +#ifdef NO_COPY_TO_END + mov a0,(a4) + mov a4,(a2) + inc a4 + mov a4,(a1) + mov 4(a1),d0 + mov 8(a1),a0 + add $4,a2 + mov d0,4-1(a4) + mov a0,8-1(a4) + add $11,a4 + sub $1,d1 +#else + mov a0,-12(a3) + sub $12-1,a3 + + mov a3,(a1) + dec a3 + + mov 4(a1),d0 + mov 8(a1),a0 + + mov a3,(a2) + add $4,a2 + + mov d0,4(a3) + sub $1,d1 + + mov a0,8(a3) +#endif + jae copy_lp2 + ret + +already_copied_2: + dec a0 + sub $1,d1 + + mov a0,(a2) + lea 4(a2),a2 + + jae copy_lp2 + ret + +copy_record_2: + subl $258,d0 + ja copy_record_node2_3 + + movl a4,(a2) + movl a0,(a4) + + lea 1(a4),a0 + movl 4(a1),d0 + + movl a0,(a1) + jb copy_record_node2_1 + + movl d0,4(a4) + movl 8(a1),d0 + + addl $4,a2 + movl d0,8(a4) + + addl $12,a4 + sub $1,d1 + jae copy_lp2 + ret + +copy_record_node2_1: + addl $4,a2 + movl d0,4(a4) + + addl $8,a4 + sub $1,d1 + jae copy_lp2 + ret + +copy_record_node2_3: + pushl d0 + lea 1(a4),d0 + + movl d0,(a1) + movl 8(a1),d0 + + movl a0,(a4) + movl 4(a1),a1 + + movl d0,a0 + subl heap_p1,d0 + + shr $3,d0 + movl a1,4(a4) + + mov d0,a1 + and $31,d0 + + shr $3,a1 + movl a4,(a2) + + andl $-4,a1 + mov bit_set_table(,d0,4),d0 + + addl heap_copied_vector,a1 + addl $4,a2 + + test (a1),d0 + jne record_arguments_already_copied_2 + + or d0,(a1) + lea 12(a4),a1 + + popl d0 + movl a1,8(a4) + + addl $13,a4 + movl (a0),a1 + + movl a4,(a0) + addl $4,a0 + + movl a1,-1(a4) + addl $3,a4 + +cp_record_arg_lp2: + movl (a0),a1 + addl $4,a0 + + movl a1,(a4) + addl $4,a4 + + subl $1,d0 + jne cp_record_arg_lp2 + + subl $1,d1 + jae copy_lp2 + ret + +record_arguments_already_copied_2: + movl (a0),a1 + popl d0 + + movl a1,8(a4) + addl $12,a4 + + subl $1,d1 + jae copy_lp2 + ret + +not_in_hnf_2: + testb $1,a0 + jne already_copied_2 + + mov -4(a0),d0 + test d0,d0 + jle copy_arity_0_node2_ + +copy_node2_1_: + andl $255,d0 + sub $2,d0 + jl copy_arity_1_node2 +copy_node2_3: + mov a4,(a2) + add $4,a2 + mov a0,(a4) + inc a4 + mov a4,(a1) + mov 4(a1),a0 + add $8,a1 + mov a0,4-1(a4) + add $8-1,a4 + +cp_arg_lp2: + mov (a1),a0 + add $4,a1 + mov a0,(a4) + add $4,a4 + sub $1,d0 + jae cp_arg_lp2 + + sub $1,d1 + jae copy_lp2 + ret + +copy_arity_1_node2: +copy_arity_1_node2_: + mov a4,(a2) + inc a4 + + add $4,a2 + mov a4,(a1) + + mov 4(a1),d0 + mov a0,-1(a4) + + mov d0,4-1(a4) + add $12-1,a4 + + sub $1,d1 + jae copy_lp2 + ret + +copy_indirection_2: + mov a1,d0 + mov 4(a1),a1 + + mov (a1),a0 + testb $2,a0 + jne in_hnf_2 + + testb $1,a0 + jne already_copied_2 + + cmp $-2,-4(a0) + je skip_indirections_2 + + mov -4(a0),d0 + test d0,d0 + jle copy_arity_0_node2_ + jmp copy_node2_1_ + +skip_indirections_2: + mov 4(a1),a1 + + mov (a1),a0 + testb $2,a0 + jne update_indirection_list_2 + testb $1,a0 + jne update_indirection_list_2 + + cmp $-2,-4(a0) + je skip_indirections_2 + +update_indirection_list_2: + lea 4(d0),a0 + mov 4(d0),d0 + mov a1,(a0) + cmp d0,a1 + jne update_indirection_list_2 + + jmp continue_after_selector_2 + +copy_selector_2: + add $2,d0 + je copy_indirection_2 + jl copy_record_selector_2 + + mov 4(a1),d0 + + mov (d0),d0 + testb $2,d0 + je copy_arity_1_node2_ + + cmpw $2,-2(d0) + jbe copy_selector_2_ + + mov 4(a1),d0 + mov 8(d0),d0 + testb $1,(d0) + jne copy_arity_1_node2_ + +copy_selector_2_: + mov -8(a0),d0 + + mov 4(a1),a0 + push a1 + push a2 + call *4(d0) + pop a2 + pop a1 + + movl $__indirection,(a1) + mov a0,4(a1) + + mov a0,a1 + jmp continue_after_selector_2 + +copy_record_selector_2: + addl $1,d0 + movl 4(a1),d0 + movl (d0),d0 + je copy_strict_record_selector_2 + + testb $2,d0 + je copy_arity_1_node2_ + + cmpw $258,-2(d0) + jbe copy_selector_2_ + + movl 4(a1),d0 + pushl a1 + + movl 8(d0),d0 + + subl heap_p1,d0 + + mov d0,a1 + and $31*8,d0 + + shr $6,a1 + + shr $1,d0 + andl $-4,a1 + + addl heap_copied_vector,a1 + + mov bit_set_table(d0),d0 + + andl (a1),d0 + popl a1 + + jne copy_arity_1_node2_ + + jmp copy_selector_2_ + +copy_strict_record_selector_2: + testb $2,d0 + je copy_arity_1_node2_ + + cmpw $258,-2(d0) + jbe copy_strict_record_selector_2_ + + movl 4(a1),d0 + pushl a1 + + movl 8(d0),d0 + + subl heap_p1,d0 + + mov d0,a1 + and $31*8,d0 + + shr $6,a1 + + shr $1,d0 + andl $-4,a1 + + addl heap_copied_vector,a1 + + mov bit_set_table(d0),d0 + + and (a1),d0 + popl a1 + + jne copy_arity_1_node2_ + +copy_strict_record_selector_2_: + mov -8(a0),d0 + + movl a1,a0 + movl 4(a1),a1 + + push a2 + call *4(d0) + pop a2 + + movl a0,a1 + movl (a0),a0 + testb $2,a0 + jne in_hnf_2 + hlt + +copy_arity_0_node2_: + jl copy_selector_2 +#ifdef NO_COPY_TO_END + mov a0,(a4) + mov a4,(a2) + lea 1(a4),d0 + add $12,a4 +#else + mov a0,-12(a3) + sub $12,a3 + mov a3,(a2) + lea 1(a3),d0 +#endif + add $4,a2 + mov d0,(a1) + + sub $1,d1 + jae copy_lp2 + ret + + +copy_string_or_array_2: +#ifdef NO_COPY_TO_END + jmp halt +#endif +#ifdef DLL + je copy_string_2 + cmpl $__ARRAY__+2,a0 + jb copy_normal_hnf_0_2 + movl a1,a0 + jmp copy_array_2 +copy_string_2: + movl a1,a0 + mov a1,d0 +#else + movl a1,a0 + jne copy_array_2 + mov a0,d0 +#endif + + sub heap_p1,d0 + cmp semi_space_size,d0 + jae copy_string_constant + + mov 4(a0),a1 + add $4,a2 + + add $3,a1 + push d1 + + mov a1,d0 + and $-4,a1 + + shr $2,d0 + sub a1,a3 + + mov (a0),d1 + add $4,a0 + + mov d1,-8(a3) + sub $8,a3 + + mov a3,-4(a2) + lea 1(a3),a1 + + mov a1,-4(a0) + lea 4(a3),a1 + +cp_s_arg_lp2: + mov (a0),d1 + add $4,a0 + + mov d1,(a1) + add $4,a1 + + subl $1,d0 + jge cp_s_arg_lp2 + + pop d1 + sub $1,d1 + jae copy_lp2 + ret + +copy_string_constant: + movl a1,(a2) + add $4,a2 + + sub $1,d1 + jae copy_lp2 + ret + +copy_array_2: + push d1 + + movl 8(a0),d0 + test d0,d0 + je copy_array_a2 + + movzwl -2(d0),d1 + + test d1,d1 + je copy_strict_basic_array_2 + + subl $256,d1 + imull 4(a0),d1 + jmp copy_array_a3 + +copy_array_a2: + movl 4(a0),d1 +copy_array_a3: + movl a4,a1 + lea 12(a4,d1,4),a4 + + movl a1,(a2) + movl (a0),d0 + + addl $4,a2 + movl d0,(a1) + + lea 1(a1),d0 + addl $4,a1 + + movl d0,(a0) + addl $4,a0 + + lea 1(d1),d0 + jmp cp_s_arg_lp2 + +copy_strict_basic_array_2: + movl 4(a0),d1 + cmpl $INT+2,d0 + je copy_int_array_2 + + cmpl $BOOL+2,d0 + je copy_bool_array_2 + + addl d1,d1 +copy_int_array_2: + shl $2,d1 + lea -12(a3),a1 + + subl d1,a1 + movl (a0),d0 + + shr $2,d1 + movl a1,(a2) + + addl $4,a2 + movl a1,a3 + + movl d0,(a1) + lea 1(a1),d0 + + addl $4,a1 + movl d0,(a0) + + addl $4,a0 + lea 1(d1),d0 + jmp cp_s_arg_lp2 + +copy_bool_array_2: + lea 3(d1),d0 + shr $2,d0 + jmp copy_int_array_2 + +end_copy1: + mov a3,heap_end_after_gc + lea -32(a3),a2 + movl a2,end_heap + diff --git a/ifileIO3.s b/ifileIO3.s new file mode 100644 index 0000000..5ffc0aa --- /dev/null +++ b/ifileIO3.s @@ -0,0 +1,744 @@ + +#define d0 %eax +#define d1 %ebx +#define a0 %ecx +#define a1 %edx +#define a2 %ebp +#define a3 %esi +#define a4 %edi +#define a5 %esp +#define sp %esp + +// # saved registers: %ebx %esi %edi %ebp +// # d1 a3 a4 a2 + + .data +#if defined (DOS) || defined (_WINDOWS_) || defined (ELF) + .align 8 +#else + .align 3 +#endif + +tmp_real: .double 0 +freadstring_error: + .ascii "Error in freadsubstring parameters." + .byte 10,0 + .byte 0,0,0 +fwritestring_error: + .ascii "Error in fwritesubstring parameters." + .byte 10,0 + .byte 0,0 + .text + + .globl stdioF + .globl stderrF + .globl openF + .globl closeF + .globl reopenF + .globl readFC + .globl readFI + .globl readFR + .globl readFS +#ifndef LINUX + .globl readFString +#endif + .globl readLineF + .globl writeFC + .globl writeFI + .globl writeFR + .globl writeFS +#ifndef LINUX + .globl writeFString +#endif + .globl endF + .globl errorF + .globl positionF + .globl seekF + .globl shareF + + .globl openSF + .globl readSFC + .globl readSFI + .globl readSFR + .globl readSFS + .globl readLineSF + .globl endSF + .globl positionSF + .globl seekSF + +// # imports + + .globl @open_file + .globl @open_stdio + .globl @open_stderr + .globl @re_open_file + .globl @close_file + .globl @file_read_char + .globl @file_read_int + .globl @file_read_real +#ifdef LINUX + .globl @file_read_string +#else + .globl @file_read_characters +#endif + .globl @file_read_line + .globl @file_write_char + .globl @file_write_int + .globl @file_write_real +#ifdef LINUX + .globl @file_write_string +#else + .globl @file_write_characters +#endif + .globl @file_end + .globl @file_error + .globl @file_position + .globl @file_seek + .globl @file_share + + .globl @open_s_file + .globl @file_read_s_char + .globl @file_read_s_int + .globl @file_read_s_real + .globl @file_read_s_string + .globl @file_read_s_line + .globl @file_s_end + .globl @file_s_position + .globl @file_s_seek + + .globl collect_0 + .globl collect_1 + + .globl __STRING__ + +stdioF: call @open_stdio + movl d0,d1 + movl $-1,d0 + ret + +stderrF: call @open_stderr + movl d0,d1 + movl $-1,d0 + ret + +openF: pushl d0 + addl $4,a0 + pushl a0 + call @open_file + addl $8,sp + + xorl d1,d1 + testl d0,d0 + setns %bl + movl (sp),a2 + movl $-1,(sp) + jmp *a2 + +closeF: pushl d1 + call @close_file + addl $4,sp + ret + +reopenF: +// # popl d0 +// # pushl d0 + pushl d1 + call @re_open_file + addl $8,sp + + xchg d0,d1 + + movl (sp),a2 + movl $-1,(sp) + jmp *a2 + +readFC: + pushl d1 + + pushl d1 + call @file_read_char + addl $4,sp + + movl 4(sp),a2 + movl $-1,4(sp) + + cmpl $-1,d0 + je readFC_eof + + movl $1,d1 + jmp *a2 + +readFC_eof: + xorl d0,d0 + xorl d1,d1 + jmp *a2 + +readFI: + pushl d1 + + subl $8,sp + lea 4(sp),a2 + movl a2,(sp) + pushl d1 + call @file_read_int + addl $8,sp + + movl d0,d1 + popl d0 + + movl 4(sp),a2 + movl $-1,4(sp) + jmp *a2 + +readFR: + pushl $tmp_real + pushl d1 + finit + call @file_read_real + addl $8,sp + + fldl tmp_real + fstp %st(1) + + xchg d0,d1 + + movl (sp),a2 + movl $-1,(sp) + jmp *a2 + +#ifndef LINUX +readFString: + movl 4(a0),a2 + cmpl a2,d1 + jae readFString_error + + subl d1,a2 + cmpl a2,d0 + ja readFString_error + + movl (sp),a1 + pushl a0 + + pushl d0 + movl sp,a2 + lea 8(a0,d1),a0 + + pushl a0 + pushl a2 + pushl a1 + call @file_read_characters + addl $12+4,sp + + popl a0 + + movl d0,d1 + popl d0 + + addl $4,sp + popl a2 + pushl $-1 + jmp *a2 + +readFString_error: + movl $freadstring_error,a2 + jmp print_error +#endif + +readFS: popl a1 + lea 3(a1),a2 + andl $-4,a2 + lea -32+8(a4,a2),a2 + cmpl end_heap,a2 + ja readFS_gc +readFS_r_gc: + +#ifdef LINUX + movl $__STRING__+2,(a4) + addl $4,a4 + + pushl a4 + pushl a1 + pushl d1 + call @file_read_string + addl $12,sp +#else + movl $__STRING__+2,(a4) + + lea 8(a4),a2 + addl $4,a4 + + pushl a2 + movl a1,(a4) + pushl a4 + pushl d1 + call @file_read_characters + addl $12,sp +#endif +readFS_end: + lea -4(a4),a0 + + addl $3,d0 + andl $-4,d0 + lea 4(a4,d0),a4 + + movl $-1,d0 + ret + +readFS_gc: pushl a1 + call collect_0l + popl a1 + jmp readFS_r_gc + +readLineF: + lea -32+(4*(32+2))(a4),a2 + cmpl end_heap,a2 + ja readLineF_gc + +readLineF_r_gc: + movl $__STRING__+2,(a4) + lea 8(a4),a0 + addl $4,a4 + + pushl a0 + movl end_heap,a1 + addl $32-4,a1 + subl a4,a1 + pushl a1 + pushl d1 + call @file_read_line + addl $12,sp + + movl d0,(a4) + + testl d0,d0 + jns readFS_end + + lea -4(a4),a0 + +readLineF_again: + movl end_heap,a1 + addl $32,a1 + lea -8(a1),d0 + subl a0,d0 + movl d0,4(a0) + movl a1,a4 + + lea -32+4*(32+2)(a4,d0),a2 + call collect_1l + + movl 4(a0),d0 + lea 8(a0),a1 + + pushl a4 + + movl $__STRING__+2,(a4) + + lea 3(d0),a0 + shr $2,a0 + + movl d0,4(a4) + addl $8,a4 + jmp st_copy_string1 + +copy_st_lp1: + movl (a1),a2 + addl $4,a1 + movl a2,(a4) + addl $4,a4 +st_copy_string1: + subl $1,a0 + jnc copy_st_lp1 + + pushl a4 + movl end_heap,a2 + addl $32,a2 + subl a4,a2 + pushl a2 + pushl d1 + call @file_read_line + addl $12,sp + + popl a0 + + testl d0,d0 + js readLineF_again + + addl d0,4(a0) + addl $3,d0 + andl $-4,d0 + addl d0,a4 + + movl $-1,d0 + ret + +readLineF_gc: + call collect_0l + jmp readLineF_r_gc + +writeFC: + movl d0,(sp) + pushl d1 + movl d0,d1 + call @file_write_char + addl $8,sp + + movl $-1,d0 + ret + +writeFI: + movl d0,(sp) + pushl d1 + movl d0,d1 + call @file_write_int + addl $8,sp + + movl $-1,d0 + ret + +writeFR: + pushl d1 + subl $8,sp + fstpl (sp) + finit + call @file_write_real + addl $12,sp + + movl $-1,d0 + ret + +writeFS: + pushl d1 +#ifdef LINUX + addl $4,a0 + pushl a0 + call @file_write_string + addl $8,sp +#else + pushl 4(a0) + addl $8,a0 + pushl a0 + call @file_write_characters + addl $12,sp +#endif + movl $-1,d0 + ret + +#ifndef LINUX +writeFString: + movl 4(a0),a2 + cmpl a2,d1 + jae writeFString_error + + subl d1,a2 + cmpl a2,d0 + ja writeFString_error + + lea 8(a0,d1),a0 + movl (sp),d1 + + pushl d0 + pushl a0 + call @file_write_characters + addl $12+4,sp + + movl $-1,d0 + + ret + +writeFString_error: + movl $fwritestring_error,a2 + jmp print_error +#endif + +endF: + pushl d1 + call @file_end + addl $4,sp + + xchg d0,d1 + + movl (sp),a2 + movl $-1,(sp) + jmp *a2 + +errorF: + pushl d1 + call @file_error + addl $4,sp + + xchg d0,d1 + + movl (sp),a2 + movl $-1,(sp) + jmp *a2 + +positionF: + pushl d1 + call @file_position + addl $4,sp + + xchg d0,d1 + + movl (sp),a2 + movl $-1,(sp) + jmp *a2 + +seekF: + pushl d1 + call @file_seek + addl $12,sp + + xchg d0,d1 + + movl (sp),a2 + movl $-1,(sp) + jmp *a2 + +shareF: + pushl d1 + call @file_share + addl $4,sp + + movl $-1,d0 + ret + +openSF: pushl d0 + addl $4,a0 + pushl a0 + call @open_s_file + addl $8,sp + + xorl d1,d1 + testl d0,d0 + setns %bl + + movl (sp),a2 + movl $0,(sp) + jmp *a2 + +readSFC: + pushl d0 + movl sp,a2 + pushl a2 + pushl d1 + call @file_read_s_char + addl $8,sp + + popl a0 + popl a2 + + pushl a0 + pushl d1 + + cmpl $-1,d0 + je readSFC_eof + + movl $1,d1 + jmp *a2 + +readSFC_eof: + xorl d0,d0 + xorl d1,d1 + jmp *a2 + +readSFI: + pushl d0 + movl sp,a2 + subl $4,sp + pushl a2 + subl $4,a2 + pushl a2 + pushl d1 + call @file_read_s_int + addl $12,sp + + popl a0 + popl a1 + popl a2 + + pushl a1 + pushl d1 + movl d0,d1 + movl a0,d0 + jmp *a2 + +readSFR: + pushl d0 + movl sp,a2 + pushl a2 + pushl $tmp_real + pushl d1 + finit + call @file_read_s_real + addl $12,sp + + fldl tmp_real + xchg d0,d1 + fstp %st(1) + + popl a0 + movl (sp),a2 + movl a0,(sp) + jmp *a2 + +readSFS: + popl a1 + lea 3(a1),a2 + andl $-4,a2 + lea -32+8(a4,a2),a2 + cmpl end_heap,a2 + ja readSFS_gc + +readSFS_r_gc: + movl $__STRING__+2,(a4) + addl $4,a4 + + pushl d0 + movl sp,a2 + pushl a2 + pushl a4 + pushl a1 + pushl d1 + call @file_read_s_string + addl $16,sp + +readSFS_end: + lea -4(a4),a0 + + addl $3,d0 + andl $-4,d0 + lea 4(a4,d0),a4 + + popl d0 + ret + +readSFS_gc: pushl a1 + call collect_0l + popl a1 + jmp readSFS_r_gc + +readLineSF: + lea -32+(4*(32+2))(a4),a2 + cmpl end_heap,a2 + ja readLineSF_gc + +readLineSF_r_gc: + movl $__STRING__+2,(a4) + lea 8(a4),a0 + addl $4,a4 + + pushl d0 + movl sp,a2 + pushl a2 + pushl a0 + movl end_heap,a1 + addl $32-4,a1 + subl a4,a1 + pushl a1 + pushl d1 + call @file_read_s_line + addl $16,sp + + movl d0,(a4) + + testl d0,d0 + jns readSFS_end + + lea -4(a4),a0 + +readLineSF_again: + movl end_heap,a1 + addl $32,a1 + lea -8(a1),d0 + subl a0,d0 + movl d0,(a4) + movl a1,a4 + + lea -32+4*(32+2)(a4,d0),a2 + call collect_1l + + movl 4(a0),d0 + lea 8(a0),a1 + + pushl a4 + + movl $__STRING__+2,(a4) + + lea 3(d0),a0 + shr $2,a0 + + movl d0,4(a4) + addl $8,a4 + jmp st_copy_string2 + +copy_st_lp2: + movl (a1),a2 + addl $4,a1 + movl a2,(a4) + addl $4,a4 +st_copy_string2: + subl $1,a0 + jnc copy_st_lp2 + + lea 4(sp),a2 + pushl a2 + pushl a4 + movl end_heap,a2 + addl $32,a2 + subl a4,a2 + pushl a2 + pushl d1 + call @file_read_s_line + addl $16,sp + + popl a0 + + testl d0,d0 + js readLineSF_again + + addl d0,4(a0) + addl $3,d0 + andl $-4,d0 + addl d0,a4 + + popl d0 + ret + +readLineSF_gc: + call collect_0l + jmp readLineSF_r_gc + +endSF: + pushl d0 + pushl d1 + call @file_s_end + addl $8,sp + ret + +positionSF: + pushl d0 + pushl d1 + call @file_s_position + addl $8,sp + ret + +seekSF: + popl a1 + popl a0 + + pushl d0 + movl sp,a2 + pushl a2 + pushl a0 + pushl a1 + pushl d1 + call @file_s_seek + addl $16,sp + + popl a0 + + xchg d0,d1 + + movl (sp),a2 + movl a0,(sp) + jmp *a2 @@ -0,0 +1,1880 @@ + +#define d0 %eax +#define d1 %ebx +#define a0 %ecx +#define a1 %edx +#define a2 %ebp +#define a3 %esi +#define a4 %edi +#define sp %esp + +#undef COUNT_GARBAGE_COLLECTIONS +#undef MARK_USING_REVERSAL +#undef COMPARE_HEAP_AFTER_MARK +#undef DEBUG_MARK_COLLECT + +#ifdef COMPARE_HEAP_AFTER_MARK + .data +heap_copy: .long 0 + .text + pushl d0 + pushl d1 + pushl a0 + pushl a1 + pushl a2 + pushl a3 + pushl a4 + + movl heap_size_33,d0 + shl $5,d0 + pushl d0 + call @allocate_memory + addl $4,sp + + movl d0,heap_copy + + testl d0,d0 + je no_copy + + movl heap_p3,a0 + movl heap_size_33,d1 + shl $3,d1 + jmp start_copy + +copy_heap_lp: + movl (a0),a2 + addl $4,a0 + movl a2,(d0) + addl $4,d0 +start_copy: + subl $1,d1 + jge copy_heap_lp + +no_copy: + popl a4 + popl a3 + popl a2 + popl a1 + popl a0 + popl d1 + popl a0 +#endif + + movl heap_size_33,d0 + xorl d1,d1 + + movl d1,n_marked_words + shl $5,d0 + + movl d0,heap_size_32_33 + movl d1,lazy_array_list + + lea -2000(sp),a3 + + movl caf_list,d0 + + movl a3,end_stack + + test d0,d0 + je _end_mark_cafs + +_mark_cafs_lp: + movl (d0),d1 + movl -4(d0),a2 + + pushl a2 + lea 4(d0),a2 + lea 4(d0,d1,4),d0 + movl d0,end_vector + + call _mark_stack_nodes + + popl d0 + test d0,d0 + jne _mark_cafs_lp + +_end_mark_cafs: + movl stack_top,a3 + movl stack_p,a2 + + movl a3,end_vector + call _mark_stack_nodes + + movl lazy_array_list,a0 + + test a0,a0 + je end_restore_arrays + +restore_arrays: + movl (a0),d1 + movl $__ARRAY__+2,(a0) + + cmpl $1,d1 + je restore_array_size_1 + + lea (a0,d1,4),a1 + movl 8(a1),d0 + test d0,d0 + je restore_lazy_array + + movl d0,a2 + push a1 + + xorl a1,a1 + movl d1,d0 + movzwl -2+2(a2),d1 + + div d1 + movl d0,d1 + + pop a1 + movl a2,d0 + +restore_lazy_array: + movl 8(a0),a4 + movl 4(a0),a2 + movl d1,4(a0) + movl 4(a1),a3 + movl d0,8(a0) + movl a2,4(a1) + movl a4,8(a1) + + test d0,d0 + je no_reorder_array + + movzwl -2(d0),a1 + subl $256,a1 + movzwl -2+2(d0),a2 + cmpl a1,a2 + je no_reorder_array + + addl $12,a0 + imull a1,d1 + movl a1,d0 + lea (a0,d1,4),a1 + movl a2,d1 + subl a2,d0 + + call reorder + +no_reorder_array: + movl a3,a0 + testl a0,a0 + jne restore_arrays + + jmp end_restore_arrays + +restore_array_size_1: + movl 4(a0),a2 + movl 8(a0),a1 + movl d1,4(a0) + movl 12(a0),d0 + movl a2,12(a0) + movl d0,8(a0) + + movl a1,a0 + testl a0,a0 + jne restore_arrays + +end_restore_arrays: + call add_garbage_collect_time + + +#ifdef COMPARE_HEAP_AFTER_MARK + pushl d0 + pushl d1 + pushl a0 + pushl a1 + pushl a2 + pushl a3 + pushl a4 + + movl heap_copy,d0 + + testl d0,d0 + je no_compare + + movl heap_p3,a0 + movl heap_size_33,d1 + shl $3,d1 + jmp start_compare + +compare_heap_lp: + movl (a0),a2 + cmpl a2,(d0) + je no_change + nop +no_change: + addl $4,a0 + addl $4,d0 +start_compare: + subl $1,d1 + jge compare_heap_lp + + pushl heap_copy + call @free_memory + addl $4,sp + +no_compare: + + popl a4 + popl a3 + popl a2 + popl a1 + popl a0 + popl d1 + popl a0 +#endif + + +#ifdef ADJUST_HEAP_SIZE + movl bit_vector_size,d0 +#else + movl heap_size_33,d0 + shl $3,d0 +#endif + +#ifdef ADJUST_HEAP_SIZE + movl n_allocated_words,a4 + addl n_marked_words,a4 + shl $2,a4 + + movl d0,a3 + shl $2,a3 + + push a1 + push d0 + + movl a4,d0 + mull @heap_size_multiple + shrd $8,a1,d0 + shrl $8,a1 + + movl d0,d1 + testl a1,a1 + + pop d0 + pop a1 + + je not_largest_heap + + movl heap_size_33,d1 + shl $5,d1 + +not_largest_heap: + cmpl a3,d1 + jbe no_larger_heap + + movl heap_size_33,a3 + shl $5,a3 + cmpl a3,d1 + jbe not_larger_then_heap + movl a3,d1 +not_larger_then_heap: + movl d1,d0 + shr $2,d0 + movl d0,bit_vector_size +no_larger_heap: +#endif + movl d0,a2 + + movl heap_vector,a4 + + shrl $5,a2 + + testb $31,d0 + je no_extra_word + + movl $0,(a4,a2,4) + +no_extra_word: + subl n_marked_words,d0 + shl $2,d0 + movl d0,n_last_heap_free_bytes + +#ifdef COUNT_GARBAGE_COLLECTIONS + addl $1,n_garbage_collections +#endif +#ifdef MEASURE_GC + movl n_marked_words,d0 + shl $2,d0 + addl d0,total_gc_bytes_lo + jnc no_total_gc_bytes_carry2 + incl total_gc_bytes_hi +no_total_gc_bytes_carry2: +#endif + + testl $2,@flags + je _no_heap_use_message2 + + pushl $marked_gc_string_1 + call @ew_print_string + addl $4,sp + + movl n_marked_words,d0 + shll $2,d0 + pushl d0 + call @ew_print_int + addl $4,sp + + pushl $heap_use_after_gc_string_2 + call @ew_print_string + addl $4,sp + +_no_heap_use_message2: + movl n_allocated_words,a3 + xorl d1,d1 + + movl a4,a0 + movl d1,n_free_words_after_mark + +_scan_bits: + cmpl (a0),d1 + je _zero_bits + movl d1,(a0) + addl $4,a0 + subl $1,a2 + jne _scan_bits + + jmp _end_scan + +_zero_bits: + lea 4(a0),a1 + addl $4,a0 + subl $1,a2 + jne _skip_zero_bits_lp1 + jmp _end_bits + +_skip_zero_bits_lp: + test d0,d0 + jne _end_zero_bits +_skip_zero_bits_lp1: + movl (a0),d0 + addl $4,a0 + subl $1,a2 + jne _skip_zero_bits_lp + + test d0,d0 + je _end_bits + movl a0,d0 + movl d1,-4(a0) + subl a1,d0 + jmp _end_bits2 + +_end_zero_bits: + movl a0,d0 + subl a1,d0 + shl $3,d0 + addl d0,n_free_words_after_mark + movl d1,-4(a0) + + cmpl a3,d0 + jb _scan_bits + +_found_free_memory: + movl a2,bit_counter + movl a0,bit_vector_p + + lea -4(a1),d1 + subl a4,d1 + shl $5,d1 + movl heap_p3,a4 + addl d1,a4 + + movl stack_top,a3 + + lea (a4,d0,4),d1 + movl d1,heap_end_after_gc + subl $32,d1 + movl d1,end_heap + + pop d1 + pop d0 + ret + +_end_bits: + movl a0,d0 + subl a1,d0 + addl $4,d0 +_end_bits2: + shl $3,d0 + addl d0,n_free_words_after_mark + cmpl a3,d0 + jae _found_free_memory + +_end_scan: + movl a2,bit_counter + jmp compact_gc + +/ a2: pointer to stack element +/ a4: heap_vector +/ d0,d1,a0,a1,a3: free + +_mark_stack_nodes: + cmpl end_vector,a2 + je _end_mark_nodes +_mark_stack_nodes_: + movl (a2),a0 + movl neg_heap_p3,a1 + + addl $4,a2 + addl a0,a1 +#ifdef SHARE_CHAR_INT + cmpl heap_size_32_33,a1 + jnc _mark_stack_nodes +#endif + movl a1,d1 + andl $31*4,a1 + shrl $7,d1 + movl bit_set_table(a1),a3 + + testl (a4,d1,4),a3 + jne _mark_stack_nodes + + pushl a2 + +#ifdef MARK_USING_REVERSAL + movl $1,a3 + jmp __mark_node + +__end_mark_using_reversal: + popl a2 + movl a0,-4(a2) + jmp _mark_stack_nodes +#else + pushl $0 + + jmp _mark_arguments + +_mark_hnf_2: + cmpl $0x20000000,a3 + jbe fits_in_word_6 + orl $1,4(a4,d1,4) +fits_in_word_6: + addl $3,n_marked_words + +_mark_record_2_c: + movl 4(a0),d1 + push d1 + + cmpl end_stack,sp + jb __mark_using_reversal + +_mark_node2: +_shared_argument_part: + movl (a0),a0 + +_mark_node: + movl neg_heap_p3,a1 +# ifdef SHARE_CHAR_INT + movl heap_size_32_33,d1 +# endif + addl a0,a1 +# ifdef SHARE_CHAR_INT + cmpl d1,a1 + jnc _mark_next_node +# endif + movl a1,d1 + andl $31*4,a1 + shrl $7,d1 + movl bit_set_table(a1),a3 + + testl (a4,d1,4),a3 + jne _mark_next_node + +_mark_arguments: + movl (a0),d0 + test $2,d0 + je _mark_lazy_node + + movzwl -2(d0),a2 + + test a2,a2 + je _mark_hnf_0 + + orl a3,(a4,d1,4) + addl $4,a0 + + cmpl $256,a2 + jae _mark_record + + subl $2,a2 + je _mark_hnf_2 + jb _mark_hnf_1 + +_mark_hnf_3: + movl 4(a0),a1 + + cmpl $0x20000000,a3 + jbe fits_in_word_1 + orl $1,4(a4,d1,4) +fits_in_word_1: + + movl neg_heap_p3,d0 + movl n_marked_words,a3 + addl a1,d0 + addl $3,a3 + movl d0,d1 + andl $31*4,d0 + + shrl $7,d1 + movl a3,n_marked_words + + movl bit_set_table(d0),a3 + + testl (a4,d1,4),a3 + jne _shared_argument_part + +_no_shared_argument_part: + orl a3,(a4,d1,4) + addl $1,a2 + + addl a2,n_marked_words + lea (d0,a2,4),d0 + lea -4(a1,a2,4),a1 + + cmpl $32*4,d0 + jbe fits_in_word_2 + orl $1,4(a4,d1,4) +fits_in_word_2: + + movl (a1),d1 + subl $2,a2 + pushl d1 + +_push_hnf_args: + movl -4(a1),d1 + subl $4,a1 + pushl d1 + subl $1,a2 + jge _push_hnf_args + + cmpl end_stack,sp + jae _mark_node2 + + jmp __mark_using_reversal + +_mark_hnf_1: + cmpl $0x40000000,a3 + jbe fits_in_word_4 + orl $1,4(a4,d1,4) +fits_in_word_4: + addl $2,n_marked_words + movl (a0),a0 + jmp _mark_node + +_mark_lazy_node_1: + addl $4,a0 + orl a3,(a4,d1,4) + cmpl $0x20000000,a3 + jbe fits_in_word_3 + orl $1,4(a4,d1,4) +fits_in_word_3: + addl $3,n_marked_words + + cmpl $1,a2 + je _mark_node2 + +_mark_selector_node_1: + addl $2,a2 + movl (a0),a1 + je _mark_indirection_node + + movl neg_heap_p3,a3 + addl a1,a3 + movl a3,d1 + + shrl $7,d1 + andl $31*4,a3 + + addl $1,a2 + + movl bit_set_table(a3),a3 + jle _mark_record_selector_node_1 + + testl (a4,d1,4),a3 + jne _mark_node3 + + movl (a1),a2 + testl $2,a2 + je _mark_node3 + + cmpw $2,-2(a2) + jbe _small_tuple_or_record + +_large_tuple_or_record: + movl 8(a1),a2 + addl neg_heap_p3,a2 + movl a2,d1 + andl $31*4,a2 + shrl $7,d1 + movl bit_set_table(a2),a2 + testl (a4,d1,4),a2 + jne _mark_node3 + +_small_tuple_or_record: + movl -8(d0),d0 + pushl a0 + movl a1,a0 + call *4(d0) + popl a1 + + movl $__indirection,-4(a1) + movl a0,(a1) + jmp _mark_node + +_mark_record_selector_node_1: + je _mark_strict_record_selector_node_1 + + testl (a4,d1,4),a3 + jne _mark_node3 + + movl (a1),a2 + testl $2,a2 + je _mark_node3 + + cmpw $258,-2(a2) + jbe _small_tuple_or_record + jmp _large_tuple_or_record + +_mark_strict_record_selector_node_1: + testl (a4,d1,4),a3 + jne _mark_node3 + + movl (a1),a2 + testl $2,a2 + je _mark_node3 + + cmpw $258,-2(a2) + jbe _select_from_small_record + + movl 8(a1),a2 + addl neg_heap_p3,a2 + movl a2,d1 + andl $31*4,a2 + shrl $7,d1 + movl bit_set_table(a2),a2 + testl (a4,d1,4),a2 + jne _mark_node3 + +_select_from_small_record: + movl -8(d0),d0 + subl $4,a0 + + call *4(d0) + + jmp _mark_next_node + +_mark_indirection_node: +_mark_node3: + movl a1,a0 + jmp _mark_node + +_mark_next_node: + popl a0 + test a0,a0 + jne _mark_node + + popl a2 + cmpl end_vector,a2 + jne _mark_stack_nodes_ + +_end_mark_nodes: + ret + +_mark_lazy_node: + movl -4(d0),a2 + test a2,a2 + je _mark_real_or_file + + cmpl $1,a2 + jle _mark_lazy_node_1 + + cmpl $256,a2 + jge _mark_closure_with_unboxed_arguments + incl a2 + orl a3,(a4,d1,4) + + addl a2,n_marked_words + lea (a1,a2,4),a1 + lea (a0,a2,4),a0 + + cmpl $32*4,a1 + jbe fits_in_word_7 + orl $1,4(a4,d1,4) +fits_in_word_7: + subl $3,a2 +_push_lazy_args: + movl -4(a0),d1 + subl $4,a0 + push d1 + subl $1,a2 + jge _push_lazy_args + + subl $4,a0 + + cmpl end_stack,sp + jae _mark_node2 + + jmp __mark_using_reversal + +_mark_closure_with_unboxed_arguments: + movl a2,d0 + andl $255,a2 + subl $1,a2 + je _mark_real_or_file + + shrl $8,d0 + addl $2,a2 + + orl a3,(a4,d1,4) + addl a2,n_marked_words + lea (a1,a2,4),a1 + + subl d0,a2 + + cmpl $32*4,a1 + jbe fits_in_word_7_ + orl $1,4(a4,d1,4) +fits_in_word_7_: + subl $2,a2 + jl _mark_next_node + + lea 8(a0,a2,4),a0 + jne _push_lazy_args + +_mark_closure_with_one_boxed_argument: + movl -4(a0),a0 + jmp _mark_node + +_mark_hnf_0: + cmpl $INT+2,d0 + jb _mark_real_file_or_string + + orl a3,(a4,d1,4) + + cmpl $CHAR+2,d0 + ja _mark_normal_hnf_0 + +_mark_bool: + addl $2,n_marked_words + + cmpl $0x40000000,a3 + jbe _mark_next_node + + orl $1,4(a4,d1,4) + jmp _mark_next_node + +_mark_normal_hnf_0: + incl n_marked_words + jmp _mark_next_node + +_mark_real_file_or_string: + cmpl $__STRING__+2,d0 + jbe _mark_string_or_array + +_mark_real_or_file: + orl a3,(a4,d1,4) + addl $3,n_marked_words + + cmpl $0x20000000,a3 + jbe _mark_next_node + + orl $1,4(a4,d1,4) + jmp _mark_next_node + +_mark_record: + subl $258,a2 + je _mark_record_2 + jl _mark_record_1 + +_mark_record_3: + addl $3,n_marked_words + + cmpl $0x20000000,a3 + jbe fits_in_word_13 + orl $1,4(a4,d1,4) +fits_in_word_13: + movl 4(a0),a1 + movl neg_heap_p3,a3 + + movzwl -2+2(d0),d1 + addl a1,a3 + + movl a3,d0 + andl $31*4,a3 + + shrl $7,d0 + subl $1,d1 + + movl bit_set_table(a3),a1 + jb _mark_record_3_bb + + testl (a4,d0,4),a1 + jne _mark_node2 + + addl $1,a2 + orl a1,(a4,d0,4) + addl a2,n_marked_words + lea (a3,a2,4),a3 + + cmpl $32*4,a3 + jbe _push_record_arguments + orl $1,4(a4,d0,4) +_push_record_arguments: + movl 4(a0),a1 + movl d1,a2 + shl $2,d1 + addl d1,a1 + subl $1,a2 + jge _push_hnf_args + + jmp _mark_node2 + +_mark_record_3_bb: + testl (a4,d0,4),a1 + jne _mark_next_node + + addl $1,a2 + orl a1,(a4,d0,4) + addl a2,n_marked_words + lea (a3,a2,4),a3 + + cmpl $32*4,a3 + jbe _mark_next_node + + orl $1,4(a4,d0,4) + jmp _mark_next_node + +_mark_record_2: + cmpl $0x20000000,a3 + jbe fits_in_word_12 + orl $1,4(a4,d1,4) +fits_in_word_12: + addl $3,n_marked_words + + cmpw $1,-2+2(d0) + ja _mark_record_2_c + je _mark_node2 + jmp _mark_next_node + +_mark_record_1: + cmpw $0,-2+2(d0) + jne _mark_hnf_1 + + jmp _mark_bool + +_mark_string_or_array: + je _mark_string_ + +_mark_array: + movl 8(a0),a2 + test a2,a2 + je _mark_lazy_array + + movzwl -2(a2),d0 + + testl d0,d0 + je _mark_strict_basic_array + + movzwl -2+2(a2),a2 + testl a2,a2 + je _mark_b_record_array + + cmpl end_stack,sp + jb _mark_array_using_reversal + + subl $256,d0 + cmpl a2,d0 + je _mark_a_record_array + +_mark_ab_record_array: + orl a3,(a4,d1,4) + movl 4(a0),a2 + + imull a2,d0 + addl $3,d0 + + addl d0,n_marked_words + lea -4(a0,d0,4),d0 + + addl neg_heap_p3,d0 + shrl $7,d0 + + cmpl d0,d1 + jae _end_set_ab_array_bits + + incl d1 + movl $1,a2 + cmpl d0,d1 + jae _last_ab_array_bits + +_mark_ab_array_lp: + orl a2,(a4,d1,4) + incl d1 + cmpl d0,d1 + jb _mark_ab_array_lp + +_last_ab_array_bits: + orl a2,(a4,d1,4) + +_end_set_ab_array_bits: + movl 4(a0),d0 + movl 8(a0),a1 + movzwl -2+2(a1),d1 + movzwl -2(a1),a1 + shll $2,d1 + lea -1024(,a1,4),a1 + pushl d1 + pushl a1 + lea 12(a0),a2 + pushl end_vector + jmp _mark_ab_array_begin + +_mark_ab_array: + movl 8(sp),d1 + pushl d0 + pushl a2 + lea (a2,d1),d0 + + movl d0,end_vector + call _mark_stack_nodes + + movl 4+8(sp),d1 + popl a2 + popl d0 + addl d1,a2 +_mark_ab_array_begin: + subl $1,d0 + jnc _mark_ab_array + + popl end_vector + addl $8,sp + jmp _mark_next_node + +_mark_a_record_array: + orl a3,(a4,d1,4) + movl 4(a0),a2 + + imull a2,d0 + pushl d0 + + addl $3,d0 + + addl d0,n_marked_words + lea -4(a0,d0,4),d0 + + addl neg_heap_p3,d0 + shrl $7,d0 + + cmpl d0,d1 + jae _end_set_a_array_bits + + incl d1 + movl $1,a2 + cmpl d0,d1 + jae _last_a_array_bits + +_mark_a_array_lp: + orl a2,(a4,d1,4) + incl d1 + cmpl d0,d1 + jb _mark_a_array_lp + +_last_a_array_bits: + orl a2,(a4,d1,4) + +_end_set_a_array_bits: + popl d0 + lea 12(a0),a2 + + pushl end_vector + lea 12(a0,d0,4),d0 + + movl d0,end_vector + call _mark_stack_nodes + + popl end_vector + jmp _mark_next_node + +_mark_lazy_array: + cmpl end_stack,sp + jb _mark_array_using_reversal + + orl a3,(a4,d1,4) + movl 4(a0),d0 + + addl $3,d0 + + addl d0,n_marked_words + lea -4(a0,d0,4),d0 + + addl neg_heap_p3,d0 + shrl $7,d0 + + cmpl d0,d1 + jae _end_set_lazy_array_bits + + incl d1 + movl $1,a2 + cmpl d0,d1 + jae _last_lazy_array_bits + +_mark_lazy_array_lp: + orl a2,(a4,d1,4) + incl d1 + cmpl d0,d1 + jb _mark_lazy_array_lp + +_last_lazy_array_bits: + orl a2,(a4,d1,4) + +_end_set_lazy_array_bits: + movl 4(a0),d0 + lea 12(a0),a2 + + pushl end_vector + lea 12(a0,d0,4),d0 + + movl d0,end_vector + call _mark_stack_nodes + + popl end_vector + jmp _mark_next_node + +_mark_array_using_reversal: + pushl $0 + movl $1,a3 + jmp __mark_node + +_mark_strict_basic_array: + movl 4(a0),d0 + cmpl $INT+2,a2 + je _mark_strict_int_array + cmpl $BOOL+2,a2 + je _mark_strict_bool_array +_mark_strict_real_array: + addl d0,d0 +_mark_strict_int_array: + addl $3,d0 + jmp _mark_basic_array_ +_mark_strict_bool_array: + addl $12+3,d0 + shrl $2,d0 + jmp _mark_basic_array_ + +_mark_b_record_array: + movl 4(a0),a2 + subl $256,d0 + imull a2,d0 + addl $3,d0 + jmp _mark_basic_array_ + +_mark_string_: + movl 4(a0),d0 + addl $8+3,d0 + shrl $2,d0 + +_mark_basic_array_: + orl a3,(a4,d1,4) + + addl d0,n_marked_words + lea -4(a0,d0,4),d0 + + addl neg_heap_p3,d0 + shrl $7,d0 + + cmpl d0,d1 + jae _mark_next_node + + incl d1 + movl $1,a2 + cmpl d0,d1 + jae _last_string_bits + +_mark_string_lp: + orl a2,(a4,d1,4) + incl d1 + cmpl d0,d1 + jb _mark_string_lp + +_last_string_bits: + orl a2,(a4,d1,4) + jmp _mark_next_node + +__end_mark_using_reversal: + popl a1 + test a1,a1 + je _mark_next_node + movl a0,(a1) + jmp _mark_next_node +#endif + +__mark_using_reversal: + pushl a0 + movl $1,a3 + movl (a0),a0 + jmp __mark_node + +__mark_arguments: + movl (a0),d0 + testb $2,d0 + je __mark_lazy_node + + movzwl -2(d0),a2 + testl a2,a2 + je __mark_hnf_0 + + addl $4,a0 + + cmpl $256,a2 + jae __mark__record + + subl $2,a2 + je __mark_hnf_2 + jb __mark_hnf_1 + +__mark_hnf_3: + movl bit_set_table(a1),a1 + addl $3,n_marked_words + + orl a1,(a4,d1,4) + + cmpl $0x20000000,a1 + + movl neg_heap_p3,d0 + + jbe fits__in__word__1 + orl $1,4(a4,d1,4) +fits__in__word__1: + addl 4(a0),d0 + + movl d0,d1 + andl $31*4,d0 + + shrl $7,d1 + + movl bit_set_table(d0),a1 + testl (a4,d1,4),a1 + jne __shared_argument_part + +__no_shared_argument_part: + orl a1,(a4,d1,4) + movl 4(a0),a1 + + addl $1,a2 + movl a3,4(a0) + + addl a2,n_marked_words + addl $4,a0 + + shl $2,a2 + orl $1,(a1) + + addl a2,d0 + addl a2,a1 + + cmpl $32*4,d0 + jbe fits__in__word__2 + orl $1,4(a4,d1,4) +fits__in__word__2: + + movl -4(a1),a2 + movl a0,-4(a1) + lea -4(a1),a3 + movl a2,a0 + jmp __mark_node + +__mark_hnf_1: + movl bit_set_table(a1),a1 + addl $2,n_marked_words + orl a1,(a4,d1,4) + cmpl $0x40000000,a1 + jbe __shared_argument_part + orl $1,4(a4,d1,4) +__shared_argument_part: + movl (a0),a2 + movl a3,(a0) + lea 2(a0),a3 + movl a2,a0 + jmp __mark_node + +__mark_no_selector_2: + popl d1 +__mark_no_selector_1: + movl bit_set_table(a1),a1 + addl $3,n_marked_words + orl a1,(a4,d1,4) + cmpl $0x20000000,a1 + jbe __shared_argument_part + + orl $1,4(a4,d1,4) + jmp __shared_argument_part + +__mark_lazy_node_1: +#ifdef COMPARE_HEAP_AFTER_MARK + jmp __mark_no_selector_1 +#endif + je __mark_no_selector_1 + +__mark_selector_node_1: + addl $2,a2 + je __mark_indirection_node + + addl $1,a2 + + pushl d1 + movl (a0),a2 + pushl d0 + movl neg_heap_p3,d0 + + jle __mark_record_selector_node_1 + + addl a2,d0 + movl d0,d1 + andl $31*4,d0 + shrl $7,d1 + movl bit_set_table(d0),d0 + testl (a4,d1,4),d0 + popl d0 + jne __mark_no_selector_2 + + movl (a2),d1 + testb $2,d1 + je __mark_no_selector_2 + + cmpw $2,-2(d1) + jbe __small_tuple_or_record + +__large_tuple_or_record: + movl 8(a2),a2 + movl neg_heap_p3,d1 + addl d1,a2 + movl a2,d1 + andl $31*4,a2 + shrl $7,d1 + movl bit_set_table(a2),a2 + testl (a4,d1,4),a2 + jne __mark_no_selector_2 + +__small_tuple_or_record: + movl -8(d0),d0 + popl d1 + + pushl a0 + movl (a0),a0 + call *4(d0) + popl a1 + + movl $__indirection,-4(a1) + movl a0,(a1) + jmp __mark_node + +__mark_record_selector_node_1: + je __mark_strict_record_selector_node_1 + + addl a2,d0 + movl d0,d1 + andl $31*4,d0 + shrl $7,d1 + movl bit_set_table(d0),d0 + testl (a4,d1,4),d0 + popl d0 + jne __mark_no_selector_2 + + movl (a2),d1 + testb $2,d1 + je __mark_no_selector_2 + + cmpw $258,-2(d1) + jbe __small_tuple_or_record + jmp __large_tuple_or_record + +__mark_strict_record_selector_node_1: + addl a2,d0 + movl d0,d1 + andl $31*4,d0 + shrl $7,d1 + movl bit_set_table(d0),d0 + testl (a4,d1,4),d0 + popl d0 + jne __mark_no_selector_2 + + movl (a2),d1 + testb $2,d1 + je __mark_no_selector_2 + + cmpw $258,-2(d1) + jle __select_from_small_record + + movl 8(a2),a2 + movl neg_heap_p3,d1 + addl d1,a2 + movl a2,d1 + andl $31*4,a2 + shrl $7,d1 + movl bit_set_table(a2),a2 + testl (a4,d1,4),a2 + jne __mark_no_selector_2 + +__select_from_small_record: + movl -8(d0),d0 + popl d1 + movl (a0),a1 + subl $4,a0 + call *4(d0) + jmp __mark_node + +__mark_indirection_node: + movl (a0),a0 + jmp __mark_node + +__mark_hnf_2: + movl bit_set_table(a1),a1 + addl $3,n_marked_words + orl a1,(a4,d1,4) + cmpl $0x20000000,a1 + jbe fits__in__word__6 + orl $1,4(a4,d1,4) +fits__in__word__6: + +__mark_record_2_c: + movl (a0),d0 + movl 4(a0),a2 + orl $2,d0 + movl a3,4(a0) + movl d0,(a0) + lea 4(a0),a3 + movl a2,a0 + +__mark_node: +#ifdef DEBUG_MARK_COLLECT + testl $3,a0 + je no_error_in_gc1 + call error_in_gc +no_error_in_gc1: +#endif + + movl neg_heap_p3,a1 +#ifdef SHARE_CHAR_INT + movl heap_size_32_33,d1 +#endif + addl a0,a1 +#ifdef SHARE_CHAR_INT + cmpl d1,a1 + jae __mark_next_node +#endif + movl a1,d1 + andl $31*4,a1 + shrl $7,d1 + movl bit_set_table(a1),a2 + testl (a4,d1,4),a2 + je __mark_arguments + +__mark_next_node: + testl $3,a3 + jne __mark_parent + + movl -4(a3),a2 + movl K6_0(a3),a1 + movl a0,K6_0(a3) + movl a1,-4(a3) + subl $4,a3 + + movl a2,a0 + andl $3,a2 + andl $-4,a0 + orl a2,a3 + jmp __mark_node + +__mark_parent: + movl a3,d1 + andl $-4,a3 + je __end_mark_using_reversal + + andl $3,d1 + movl K6_0(a3),a2 + movl a0,K6_0(a3) + + subl $1,d1 + je __argument_part_parent + +#ifdef DEBUG_MARK_COLLECT + cmpl $1,d1 + je no_error_in_gc2 + call error_in_gc +no_error_in_gc2: +#endif + + lea -4(a3),a0 + movl a2,a3 + jmp __mark_next_node + +__argument_part_parent: + andl $-4,a2 + movl a3,a1 + movl -4(a2),a0 + movl (a2),d1 + movl d1,-4(a2) + movl a1,(a2) + lea (-4)+2(a2),a3 + jmp __mark_node + +__mark_lazy_node: + movl -4(d0),a2 + testl a2,a2 + je __mark_real_or_file + + addl $4,a0 + cmpl $1,a2 + jle __mark_lazy_node_1 + cmpl $256,a2 + jge __mark_closure_with_unboxed_arguments + + addl $1,a2 + movl a1,d0 + movl bit_set_table(a1),a1 + addl a2,n_marked_words + + lea (d0,a2,4),d0 + subl $2,a2 + + orl a1,(a4,d1,4) + + cmpl $32*4,d0 + jbe fits__in__word__7 + orl $1,4(a4,d1,4) +fits__in__word__7: +__mark_closure_with_unboxed_arguments__2: + lea (a0,a2,4),a1 + movl (a0),d0 + orl $2,d0 + movl d0,(a0) + movl (a1),a0 + movl a3,(a1) + movl a1,a3 + jmp __mark_node + +__mark_closure_with_unboxed_arguments: + movl a2,d0 + andl $255,a2 + + subl $1,a2 + je __mark_closure_1_with_unboxed_argument + addl $2,a2 + + shrl $8,d0 + addl a2,n_marked_words + + pushl a0 + lea (a1,a2,4),a0 + + movl bit_set_table(a1),a1 + subl d0,a2 + + orl a1,(a4,d1,4) + cmpl $32*4,a0 + jbe fits__in_word_7_ + orl $1,4(a4,d1,4) +fits__in_word_7_: + popl a0 + subl $2,a2 + jg __mark_closure_with_unboxed_arguments__2 + je __shared_argument_part + subl $4,a0 + jmp __mark_next_node + +__mark_closure_1_with_unboxed_argument: + subl $4,a0 + jmp __mark_real_or_file + +__mark_hnf_0: + cmpl $INT+2,d0 + jne __no_int_3 + + movl 4(a0),a2 + cmpl $33,a2 +#ifdef COMPARE_HEAP_AFTER_MARK + jmp __mark_bool_or_small_string +#endif + jb ____small_int + +__mark_bool_or_small_string: + movl bit_set_table(a1),a1 + addl $2,n_marked_words + orl a1,(a4,d1,4) + cmpl $0x40000000,a1 + jbe __mark_next_node + orl $1,4(a4,d1,4) + jmp __mark_next_node + +____small_int: + lea small_integers(,a2,8),a0 + jmp __mark_next_node + +__no_int_3: + jb __mark_real_file_or_string + + cmpl $CHAR+2,d0 + jne __no_char_3 +#ifdef COMPARE_HEAP_AFTER_MARK + jmp __mark_bool_or_small_string +#endif + movzbl 4(a0),a2 + lea static_characters(,a2,8),a0 + jmp __mark_next_node + +__no_char_3: + jb __mark_bool_or_small_string + +#ifdef COMPARE_HEAP_AFTER_MARK + movl bit_set_table(a1),a1 + incl n_marked_words + orl a1,(a4,d1,4) + jmp __mark_next_node +#endif + + lea -2+ZERO_ARITY_DESCRIPTOR_OFFSET(d0),a0 + jmp __mark_next_node + +__mark_real_file_or_string: + cmpl $__STRING__+2,d0 + jbe __mark_string_or_array + +__mark_real_or_file: + movl bit_set_table(a1),a1 + addl $3,n_marked_words + + orl a1,(a4,d1,4) + + cmpl $0x20000000,a1 + jbe __mark_next_node + + orl $1,4(a4,d1,4) + jmp __mark_next_node + +__mark__record: + subl $258,a2 + je __mark_record_2 + jl __mark_record_1 + +__mark_record_3: + movl bit_set_table(a1),a1 + addl $3,n_marked_words + orl a1,(a4,d1,4) + cmpl $0x20000000,a1 + jbe fits__in__word__13 + orl $1,4(a4,d1,4) +fits__in__word__13: + movzwl -2+2(d0),d1 + + movl neg_heap_p3,d0 + movl 4(a0),a1 + addl d0,a1 + movl a1,d0 + andl $31*4,a1 + shrl $7,d0 + + pushl a3 + + movl bit_set_table(a1),a3 + testl (a4,d0,4),a3 + jne __shared_record_argument_part + + addl $1,a2 + orl a3,(a4,d0,4) + + lea (a1,a2,4),a1 + addl a2,n_marked_words + + popl a3 + + cmpl $32*4,a1 + jbe fits__in__word__14 + orl $1,4(a4,d0,4) +fits__in__word__14: + subl $1,d1 + movl 4(a0),a1 + jl __mark_record_3_bb + je __shared_argument_part + + movl a3,4(a0) + addl $4,a0 + + subl $1,d1 + je __mark_record_3_aab + + lea (a1,d1,4),a3 + movl (a1),d0 + orl $1,d0 + movl K6_0(a3),a2 + movl d0,(a1) + movl a0,K6_0(a3) + movl a2,a0 + jmp __mark_node + +__mark_record_3_bb: + subl $4,a0 + jmp __mark_next_node + +__mark_record_3_aab: + movl (a1),a2 + movl a0,(a1) + lea 1(a1),a3 + movl a2,a0 + jmp __mark_node + +__shared_record_argument_part: + movl 4(a0),a1 + + popl a3 + + test d1,d1 + jne __shared_argument_part + subl $4,a0 + jmp __mark_next_node + +__mark_record_2: + movl bit_set_table(a1),a1 + addl $3,n_marked_words + orl a1,(a4,d1,4) + cmpl $0x20000000,a1 + jbe fits__in__word_12 + orl $1,4(a4,d1,4) +fits__in__word_12: + cmpw $1,-2+2(d0) + ja __mark_record_2_c + je __shared_argument_part + subl $4,a0 + jmp __mark_next_node + +__mark_record_1: + cmpw $0,-2+2(d0) + jne __mark_hnf_1 + subl $4,a0 + jmp __mark_bool_or_small_string + +__mark_string_or_array: + je __mark_string_ + +__mark_array: + movl 8(a0),a2 + test a2,a2 + je __mark_lazy_array + + movzwl -2(a2),d0 + test d0,d0 + je __mark_strict_basic_array + + movzwl -2+2(a2),a2 + test a2,a2 + je __mark_b_record_array + + subl $256,d0 + cmpl a2,d0 + je __mark_a_record_array + +__mark__ab__record__array: + pushl a1 + pushl d1 + movl a2,d1 + + movl 4(a0),a2 + addl $8,a0 + pushl a0 + + shl $2,a2 + movl d0,a1 + imull a2,a1 + + subl d1,d0 + addl $4,a0 + addl a0,a1 + + call reorder + + popl a0 + + xchg d1,d0 + movl -4(a0),a2 + imull a2,d0 + imull a2,d1 + addl d1,n_marked_words + addl d0,d1 + + movl neg_heap_p3,a2 + shl $2,d1 + addl a0,a2 + addl d1,a2 + + popl d1 + popl a1 + + movl bit_set_table(a1),a1 + orl a1,(a4,d1,4) + + lea (a0,d0,4),a1 + jmp __mark_r_array + +__mark_a_record_array: + imull 4(a0),d0 + addl $8,a0 + jmp __mark_lr_array + +__mark_lazy_array: + movl 4(a0),d0 + addl $8,a0 + +__mark_lr_array: + movl bit_set_table(a1),a1 + movl neg_heap_p3,a2 + orl a1,(a4,d1,4) + lea (a0,d0,4),a1 + addl a1,a2 +__mark_r_array: + shrl $7,a2 + + cmpl a2,d1 + jae __skip_mark_lazy_array_bits + + inc d1 + +__mark_lazy_array_bits: + orl $1,(a4,d1,4) + inc d1 + cmpl a2,d1 + jbe __mark_lazy_array_bits + +__skip_mark_lazy_array_bits: + movl n_marked_words,a2 + addl $3,a2 + addl d0,a2 + + cmpl $1,d0 + movl a2,n_marked_words + jbe __mark_array_length_0_1 + + movl (a1),a2 + movl (a0),d1 + movl d1,(a1) + movl a2,(a0) + + movl -4(a1),a2 + subl $4,a1 + movl lazy_array_list,d1 + addl $2,a2 + movl d1,(a1) + movl a2,-4(a0) + movl d0,-8(a0) + subl $8,a0 + movl a0,lazy_array_list + + movl -4(a1),a0 + movl a3,-4(a1) + lea -4(a1),a3 + jmp __mark_node + +__mark_array_length_0_1: + lea -8(a0),a0 + jb __mark_next_node + + movl 12(a0),d1 + movl 8(a0),a2 + movl lazy_array_list,a1 + movl a2,12(a0) + movl a1,8(a0) + movl d0,(a0) + movl a0,lazy_array_list + movl d1,4(a0) + addl $4,a0 + + movl (a0),a2 + movl a3,(a0) + lea 2(a0),a3 + movl a2,a0 + jmp __mark_node + +__mark_b_record_array: + movl 4(a0),a2 + subl $256,d0 + imull a2,d0 + addl $3,d0 + jmp __mark_basic_array + +__mark_strict_basic_array: + movl 4(a0),d0 + cmpl $INT+2,a2 + je __mark__strict__int__array + cmpl $BOOL+2,a2 + je __mark__strict__bool__array +__mark__strict__real__array: + addl d0,d0 +__mark__strict__int__array: + addl $3,d0 + jmp __mark_basic_array +__mark__strict__bool__array: + addl $12+3,d0 + shrl $2,d0 + jmp __mark_basic_array + +__mark_string_: + movl 4(a0),d0 + addl $8+3,d0 + shr $2,d0 + +__mark_basic_array: + movl bit_set_table(a1),a1 + addl d0,n_marked_words + +#ifdef DEBUG_MARK_COLLECT + cmpl $100000,d0 + jc no_error_in_gc4 + call error_in_gc +no_error_in_gc4: +#endif + + orl a1,(a4,d1,4) + lea -4(a0,d0,4),d0 + + addl neg_heap_p3,d0 + shrl $7,d0 + + cmpl d0,d1 + jae __mark_next_node + + incl d1 + movl $1,a2 + + cmpl d0,d1 + jae __last__string__bits + +__mark_string_lp: + orl a2,(a4,d1,4) + incl d1 + cmpl d0,d1 + jb __mark_string_lp + +__last__string__bits: + orl a2,(a4,d1,4) + jmp __mark_next_node + +#ifdef DEBUG_MARK_COLLECT +error_in_gc: + pushl d0 + pushl d1 + pushl a0 + pushl a1 + pushl $error_in_gc_string + call @ew_print_string + addl $4,sp + popl a1 + popl a0 + popl d1 + popl d0 + ret + +error_in_gc_string: + .ascii "Error in marking gc" + .byte 0 + +#endif @@ -0,0 +1,843 @@ +/* + File: scon.c + Author: John van Groningen + At: University of Nijmegen +*/ + +#include <stdlib.h> +#include <stdio.h> +#include <string.h> +#include <sys/types.h> +#include <sys/time.h> +#ifdef SOLARIS +# include <unistd.h> +#endif + +#define GC_FLAGS +#ifndef SOLARIS +# define MARKING_GC +#endif +#define STACK_OVERFLOW_EXCEPTION_HANDLER +#define USE_CR2 + +#ifdef STACK_OVERFLOW_EXCEPTION_HANDLER +# include <signal.h> +# ifdef LINUX +# include <sys/resource.h> +# endif +# ifdef SOLARIS +# include <ucontext.h> +# include <procfs.h> +# endif +# include <fcntl.h> +# include <sys/mman.h> +#endif + +long min_write_heap_size; + +#define MY_PATH_MAX 1025 + +char appl_path[MY_PATH_MAX]; +char home_path[MY_PATH_MAX]; + +void set_home_and_appl_path (char *command) +{ + char *p; + int r; + + realpath (getenv ("HOME"),home_path); + +#if 1 +# ifdef SOLARIS + p=getexecname(); + if (p!=NULL){ + realpath (p,appl_path); + *strrchr (appl_path,'/')='\0'; + } else + appl_path[0]='\0'; +# else + r=readlink ("/proc/self/exe",appl_path,MY_PATH_MAX-1); + if (r>=0){ + appl_path[r]='\0'; + + p=strrchr (appl_path,'/'); + if (p!=NULL) + *p='\0'; + } else + appl_path[0]='\0'; +# endif +#else + p=strchr (command,'/'); + + if (p!=NULL){ + realpath (command,appl_path); + *strrchr (appl_path,'/')='\0'; + } else { + char *path,*file_found_p; + int colon_i; + + path=(char *)getenv("PATH"); + + file_found_p=NULL; + + while (path!=NULL && file_found_p==NULL){ + char *next,try_path[MY_PATH_MAX]; + + next=strchr (path,':'); + if (next==NULL) + colon_i=strlen(path); + else + colon_i=next-path; + + strncpy (try_path,path,colon_i); + try_path[colon_i]='\0'; + + strcat (try_path,"/"); + strcat (try_path,command); + + file_found_p=(char *)realpath (try_path,appl_path); + + path=next; + if (path!=NULL) + ++path; + } + + if (file_found_p==NULL) + *appl_path='\0'; + else + *strrchr(appl_path,'/')='\0'; + } +#endif +} + +#if defined (SOLARIS) || defined (I486) +extern long ab_stack_size,heap_size,flags; +#else +extern long stack_size,heap_size,flags; +#endif + +/* +extern long ab_stack_size=512*1024,heap_size=2048*1024,flags=8; +*/ +#ifdef MARKING_GC +extern long heap_size_multiple,initial_heap_size; +#endif + +#ifdef STACK_OVERFLOW_EXCEPTION_HANDLER +struct sigaction old_sa; + +extern int stack_overflow (void); +extern int *halt_sp; + +# ifdef LINUX +extern int *a_stack_guard_page; +int *below_stack_page; + +void *allocate_memory_with_guard_page_at_end (int size) +{ + int alloc_size; + char *p,*end_p; + + alloc_size=(size+4096+4095) & -4096; + + p=malloc (alloc_size); + if (p==NULL) + return p; + + end_p=(char*)(((int)p+size+4095) & -4096); + mprotect (end_p,4096,PROT_NONE); + + return p; +} + +# ifdef USE_CR2 +static void clean_exception_handler (int s,struct sigcontext sigcontext) +{ + if ( + (((int)sigcontext.cr2 ^ (int)below_stack_page) & -4096)==0 || + (((int)sigcontext.cr2 ^ (int)a_stack_guard_page) & -4096)==0) + { + sigcontext.eip=(int)&stack_overflow; + sigcontext.esp=(int)halt_sp; + } else { + sigaction (SIGSEGV,&old_sa,NULL); + /* + if (old_sa.sa_handler==SIG_DFL || old_sa.sa_handler==SIG_IGN) + sigaction (SIGSEGV,&old_sa,NULL); + else + old_sa.sa_sigaction (s,sigcontext); + */ + } +} +# else +static void clean_exception_handler_info (int s,struct siginfo *siginfo_p,void *p); + +static void clean_exception_handler_context (int s,struct sigcontext sigcontext) +{ + struct sigaction sa; + + sigcontext.eip=(int)&stack_overflow; + sigcontext.esp=(int)halt_sp; + + sigemptyset (&sa.sa_mask); + sa.sa_sigaction=&clean_exception_handler_info; + sa.sa_flags= SA_ONSTACK | SA_RESTART | SA_SIGINFO; + + sigaction (SIGSEGV,&sa,NULL); +} + +static void clean_exception_handler_info (int s,struct siginfo *siginfo_p,void *p) +{ + struct sigaction sa; + + if ( + (((int)siginfo_p->si_addr ^ (int)below_stack_page) & -4096)==0 || + (((int)siginfo_p->si_addr ^ (int)a_stack_guard_page) & -4096)==0) + { + struct sigaction sa; + + sigemptyset (&sa.sa_mask); + sa.sa_handler=&clean_exception_handler_context; + sa.sa_flags= SA_ONSTACK | SA_RESTART; + + sigaction (SIGSEGV,&sa,NULL); + } else { + if (old_sa.sa_handler==SIG_DFL || old_sa.sa_handler==SIG_IGN) + sigaction (SIGSEGV,&old_sa,NULL); + else + old_sa.sa_sigaction (s,siginfo_p,p); + } +} +# endif + +static void install_clean_exception_handler (void) +{ + char proc_map_file_name[64]; + int proc_map_fd,a; + struct sigaction sa; + stack_t sig_s; + int *sig_stack; + + sprintf (proc_map_file_name,"/proc/%d/maps",getpid()); + + proc_map_fd=open (proc_map_file_name,O_RDONLY); + + if (proc_map_fd<0) + return; + + for (;;){ + static char m[17]; + unsigned int b,e; + + if (read (proc_map_fd,m,17)==17 && m[8]=='-'){ + int i; + + b=0; + e=0; + for (i=0; i<8; ++i){ + int c; + + c=m[i]; + b=b<<4; + if ((unsigned)(c-'0')<10) + b+=c-'0'; + else if ((unsigned)((c & ~32)-'A')<26) + b+=(c & ~32)-('A'-10); + else + break; + + c=m[9+i]; + e=e<<4; + if ((unsigned)(c-'0')<10) + e+=c-'0'; + else if ((unsigned)((c & ~32)-'A')<26) + e+=(c & ~32)-('A'-10); + else + break; + } + + if (i==8){ + if ((unsigned)&a - (unsigned)b < (unsigned)(e-b)){ + struct rlimit rlimit; + + if (getrlimit (RLIMIT_STACK,&rlimit)==0){ + below_stack_page=(int*)((int)e-rlimit.rlim_cur-4096); + break; + } + } + continue; + } + } + + { + char c; + + c='\0'; + while (read (proc_map_fd,&c,1)==1 && c!='\n') + ; + + if (c=='\n') + continue; + } + + close (proc_map_fd); + return; + } + + close (proc_map_fd); + + sig_stack=malloc (MINSIGSTKSZ); + + if (sig_stack==NULL) + return; + + sig_s.ss_flags=0; + sig_s.ss_size=MINSIGSTKSZ; + sig_s.ss_sp=sig_stack; + + sigaltstack (&sig_s,NULL); + + sigemptyset (&sa.sa_mask); +# ifdef USE_CR2 + sa.sa_sigaction=&clean_exception_handler; + sa.sa_flags= SA_ONSTACK | SA_RESTART; +# else + sa.sa_sigaction=&clean_exception_handler_info; + sa.sa_flags= SA_ONSTACK | SA_RESTART | SA_SIGINFO; +# endif + + sigaction (SIGSEGV,&sa,&old_sa); +} +# else +# ifdef DETECT_SYSTEM_STACK_OVERFLOW +int *below_stack_page; +# endif +int *stack_guard_page; + +void *allocate_stack (int size) +{ + int alloc_size,size_a8192; + char *p,*end_p; + + size=(size+3) & -4; + size_a8192=(size+8191) & -8192; + alloc_size=8192+(size_a8192<<1)+8192; + + p=malloc (alloc_size); + if (p==NULL) + return NULL; + + end_p=(char*)(((int)p+size+8191) & -8192); + + mprotect (end_p,8192,PROT_NONE); + + stack_guard_page=(int*)end_p; + + return (void*)stack_guard_page; +} + +void clean_exception_handler (int s,struct siginfo *siginfo_p,ucontext_t *ucontext_p) +{ + struct sigaction sa; + mcontext_t *mcontext_p; + + if ( +# ifdef DETECT_SYSTEM_STACK_OVERFLOW + (((int)siginfo_p->si_addr ^ (int)below_stack_page) & -8192)==0 || +# endif + (((int)siginfo_p->si_addr ^ (int)stack_guard_page) & -8192)==0) + { + mcontext_p=&ucontext_p->uc_mcontext; +# ifdef DETECT_SYSTEM_STACK_OVERFLOW + if (mcontext_p->gwins!=NULL){ + int wi,wo,n_windows; + + n_windows=mcontext_p->gwins->wbcnt; + wo=0; + for (wi=0; wi<n_windows; ++wi){ + int *register_window_p; + + register_window_p=mcontext_p->gwins->spbuf[wi]; + if (((((int)register_window_p ^ (int)below_stack_page)) & -8192) != 0){ + /* + struct rwindow *rwindow_p; + int i; + + rwindow_p=&mcontext_p->gwins->wbuf[wi]; + for (i=0; i<8; ++i){ + register_window_p[i]=rwindow_p->rw_local[i]; + register_window_p[8+i]=rwindow_p->rw_in[i]; + } + */ + if (wi!=wo) + mcontext_p->gwins->wbuf[wo]=mcontext_p->gwins->wbuf[wi]; + ++wo; + } + } + mcontext_p->gwins->wbcnt=wo; + } +# endif + + mcontext_p->gregs[REG_PC]=(int)&stack_overflow; + mcontext_p->gregs[REG_nPC]=(int)&stack_overflow+4; + mcontext_p->gregs[REG_G5]=(int)halt_sp; + } else { + if (old_sa.sa_sigaction==SIG_DFL || old_sa.sa_sigaction==SIG_IGN) + sigaction (SIGSEGV,&old_sa,NULL); + else + old_sa.sa_sigaction (s,siginfo_p,ucontext_p); + } +} + +static void install_clean_exception_handler (void) +{ + struct sigaction sa; +# ifdef DETECT_SYSTEM_STACK_OVERFLOW + char proc_map_file_name[64]; + struct prmap prmap; + stack_t sig_s; + int proc_map_fd,a,*sig_stack; + + sprintf (proc_map_file_name,"/proc/%d/rmap",getpid()); + + proc_map_fd=open (proc_map_file_name,O_RDONLY); + + if (proc_map_fd<0) + return; + + do { + if (read (proc_map_fd,&prmap,sizeof (prmap))!=sizeof (prmap)){ + close (proc_map_fd); + return; + } + } while (! ((unsigned)&a - (unsigned)prmap.pr_vaddr < (unsigned)prmap.pr_size)); + + close (proc_map_fd); + + below_stack_page=(int*)((int)prmap.pr_vaddr-8192); + + sig_stack=malloc (MINSIGSTKSZ); + + if (sig_stack==NULL) + return; + + sig_s.ss_flags=0; + sig_s.ss_size=MINSIGSTKSZ; + sig_s.ss_sp=sig_stack; + + sigaltstack (&sig_s,NULL); +# endif + + sigemptyset (&sa.sa_mask); + sa.sa_sigaction=&clean_exception_handler; +# ifdef DETECT_SYSTEM_STACK_OVERFLOW + sa.sa_flags= SA_ONSTACK | SA_RESTART | SA_SIGINFO; +# else + sa.sa_flags= SA_RESTART | SA_SIGINFO; +# endif + + sigaction (SIGSEGV,&sa,&old_sa); +} +# endif +#endif + +void w_print_char (char c) +{ + putchar (c); +} + +void w_print_text (register char *s,unsigned long length) +{ + register int l; + + l=length; + if (l) + do { + putchar (*s); + ++s; + } while (--l); +} + +void ew_print_char (char c) +{ + putc (c,stderr); +} + +void ew_print_text (register char *s,unsigned long length) +{ + register int l; + + l=length; + if (l) + do { + putc (*s,stderr); + ++s; + } while (--l); +} + +int w_get_char() +{ + return getchar(); +} + +#define is_digit(n) ((unsigned)((n)-'0')<(unsigned)10) + +int w_get_int (int *i_p) +{ + int c,negative; + unsigned int i; + + c=getchar(); + while (c==' ' || c=='\t' || c=='\n') + c=getchar(); + + negative=0; + if (c=='+') + c=getchar(); + else + if (c=='-'){ + c=getchar(); + negative=1; + } + + if (!is_digit (c)){ + if (c!=EOF) + ungetc (c,stdin); + + *i_p=0; + return 0; + } + + i=c-'0'; + while (c=getchar(),is_digit (c)){ + i+=i<<2; + i+=i; + i+=c-'0'; + }; + + if (negative) + i=-i; + + if (c!=EOF) + ungetc (c,stdin); + + *i_p=i; + return -1; +} + +int w_get_real (double *r_p) +{ + char s[256+1]; + int c,dot,digits,result,n; + + n=0; + + c=getchar(); + while (c==' ' || c=='\t' || c=='\n') + c=getchar(); + + if (c=='+') + c=getchar(); + else + if (c=='-'){ + s[n++]=c; + c=getchar(); + } + + dot=0; + digits=0; + + while (is_digit (c) || c=='.'){ + if (c=='.'){ + if (dot){ + dot=2; + break; + } + dot=1; + } else + digits=-1; + if (n<256) + s[n++]=c; + c=getchar(); + } + + result=0; + if (digits) + if (dot==2 || ! (c=='e' || c=='E')) + result=-1; + else { + if (n<256) + s[n++]=c; + c=getchar(); + + if (c=='+') + c=getchar(); + else + if (c=='-'){ + if (n<256) + s[n++]=c; + c=getchar(); + } + + if (is_digit (c)){ + do { + if (n<256) + s[n++]=c; + c=getchar(); + } while (is_digit (c)); + + result=-1; + } + } + + if (n>=256) + result=0; + + if (c!=EOF) + ungetc (c,stdin); + + *r_p=0.0; + + if (result){ + s[n]='\0'; + if (sscanf (s,"%lg",r_p)!=1) + result=0; + } + + return result; +} + +unsigned long w_get_text (register char *string,unsigned long max_length) +{ + register int length; + + fgets (string,(int)max_length,stdin); + + for (length=0; length<max_length; ++length) + if (string[length]=='\0') + break; + + return length; +} + +void w_print_string (char *s) +{ + fputs (s,stdout); +} + +void ew_print_string (char *s) +{ + fputs (s,stderr); +} + +void w_print_int (int n) +{ + printf ("%d",n); +} + +void ew_print_int (int n) +{ + fprintf (stderr,"%d",n); +} + +void w_print_real (double r) +{ + printf ("%.15g",r); +} + +void ew_print_real (double r) +{ + fprintf (stderr,"%.15g",r); +} + +static long parse_size (register char *s) +{ + register int c; + register long n; + + c=*s++; + if (c<'0' || c>'9'){ + printf ("Digit expected in argument\n"); + exit (-1); + } + + n=c-'0'; + + while (c=*s++,c>='0' && c<='9') + n=n*10+(c-'0'); + + if (c=='k' || c=='K'){ + c=*s++; + n<<=10; + } else if (c=='m' || c=='M'){ + c=*s++; + n<<=20; + } + + if (c!='\0'){ + printf ("Error in argument\n"); + exit (-1); + } + + return n; +} + +#ifdef MARKING_GC +static long parse_integer (register char *s) +{ + register int c; + register long n; + + c=*s++; + if (c<'0' || c>'9'){ + printf ("Digit expected in argument\n"); + exit (-1); + } + + n=c-'0'; + + while (c=*s++,c>='0' && c<='9') + n=n*10+(c-'0'); + + if (c!='\0'){ + printf ("Error in integer"); + exit (-1); + } + + return n; +} +#endif + +int global_argc; +char **global_argv; + +#ifdef TIME_PROFILE +char time_profile_file_name_suffix[]=" Time Profile.pcl"; + +void create_profile_file_name (unsigned char *profile_file_name_string) +{ + char *profile_file_name; + int r; + + profile_file_name=&profile_file_name_string[8]; + + r=readlink ("/proc/self/exe",profile_file_name,MY_PATH_MAX-1); + if (r>=0){ + int length_file_name,size_time_profile_file_name_suffix; + + profile_file_name[r]='\0'; + + size_time_profile_file_name_suffix=sizeof (time_profile_file_name_suffix); + length_file_name=0; + while (profile_file_name[length_file_name]!='\0') + ++length_file_name; + + if (length_file_name+size_time_profile_file_name_suffix>MY_PATH_MAX) + length_file_name=MY_PATH_MAX-size_time_profile_file_name_suffix; + + strcat (&profile_file_name[length_file_name],time_profile_file_name_suffix); + *(unsigned int*)&profile_file_name_string[4] = length_file_name+size_time_profile_file_name_suffix-1; + } else { + strcpy (profile_file_name,&time_profile_file_name_suffix[1]); + *(unsigned int*)&profile_file_name_string[4] = sizeof (time_profile_file_name_suffix)-1; + } +} +#endif + +int execution_aborted; +int return_code; + +int main (int argc,char **argv) +{ + int arg_n; + + execution_aborted=0; + return_code=0; + +#ifdef STACK_OVERFLOW_EXCEPTION_HANDLER + install_clean_exception_handler(); +#endif + + set_home_and_appl_path (argv[0]); + + for (arg_n=1; arg_n<argc; ++arg_n){ + char *s; + + s=argv[arg_n]; + if (*s!='-') + break; + + ++s; + if (!strcmp (s,"h")){ + ++arg_n; + if (arg_n>=argc){ + printf ("Heapsize missing\n"); + return -1; + } + heap_size=parse_size (argv[arg_n]); + } else if (!strcmp (s,"s")){ + ++arg_n; + if (arg_n>=argc){ + printf ("Stacksize missing\n"); + return -1; + } +#if defined (SOLARIS) || defined (I486) + ab_stack_size=parse_size (argv[arg_n]); +#else + stack_size=parse_size (argv[arg_n]); +#endif + } else if (!strcmp (s,"b")) + flags |= 1; + else if (!strcmp (s,"sc")) + flags &= ~1; + else if (!strcmp (s,"t")) + flags |= 8; + else if (!strcmp (s,"nt")) + flags &= ~8; + else if (!strcmp (s,"gc")) + flags |= 2; + else if (!strcmp (s,"ngc")) + flags &= ~2; + else if (!strcmp (s,"st")) + flags |= 4; + else if (!strcmp (s,"nst")) + flags &= ~4; + else if (!strcmp (s,"nr")) + flags |= 16; +#ifdef MARKING_GC + else if (!strcmp (s,"gcm")) + flags |= 64; + else if (!strcmp (s,"gcc")) + flags &= ~64; + else if (!strcmp (s,"gci")){ + ++arg_n; + if (arg_n>=argc){ + printf ("Initial heap size missing\n"); + exit (-1); + } + initial_heap_size=parse_size (argv[arg_n]); + } else if (!strcmp (s,"gcf")){ + ++arg_n; + if (arg_n>=argc){ + printf ("Next heap size factor missing\n"); + exit (-1); + } + heap_size_multiple=parse_integer (argv[arg_n])<<8; + } +#endif + else + break; + } + + --arg_n; + argv[arg_n]=argv[0]; + global_argv=&argv[arg_n]; + global_argc=argc-arg_n; + + abc_main(); + + if (return_code==0 && execution_aborted!=0) + return_code= -1; + + return return_code; +} @@ -0,0 +1,14 @@ +extern int w_get_char(); +extern int w_get_int (int *i_p); +extern int w_get_real (double *r_p); +extern unsigned long w_get_text (char *string,unsigned long max_length); +extern void w_print_char (char c); +extern void w_print_int (int i); +extern void w_print_real (double r); +extern void w_print_string (char *s); +extern void w_print_text (char *s,unsigned long length); +extern void ew_print_char (char c); +extern void ew_print_int (int i); +extern void ew_print_real (double r); +extern void ew_print_string (char *s); +extern void ew_print_text (char *s,unsigned long length); diff --git a/uwrite_heap.c b/uwrite_heap.c new file mode 100644 index 0000000..9055515 --- /dev/null +++ b/uwrite_heap.c @@ -0,0 +1,109 @@ + +#include <stdio.h> + +struct heap_info { + int *heap1_begin; + int *heap1_end; + int *heap2_begin; + int *heap2_end; + int *stack_begin; + int *stack_end; + int *text_begin; + int *data_begin; + int *small_integers; + int *characters; + int int_descriptor; + int char_descriptor; + int real_descriptor; + int bool_descriptor; + int string_descriptor; + int array_descriptor; +}; + +static int heap_written_count=0; + +#define MAX_N_HEAPS 10 + +#define MAX_PATH_LENGTH 256 + +void write_heap (struct heap_info *h) +{ + static char heap_profile_file_name_suffix[]=" Heap Profile0.hcl"; + char heap_profile_file_name[MAX_PATH_LENGTH+1]; + FILE *heap_file; + int length_application_name,file_ok; + + if (heap_written_count >= MAX_N_HEAPS) + return; + + length_application_name=readlink ("/proc/self/exe",heap_profile_file_name,MAX_PATH_LENGTH); + if (length_application_name>=0){ + int length_file_name,size_heap_profile_file_name_suffix; + + heap_profile_file_name[length_application_name]='\0'; + + size_heap_profile_file_name_suffix=sizeof (heap_profile_file_name_suffix); + length_file_name=0; + while (heap_profile_file_name[length_file_name]!='\0') + ++length_file_name; + + if (length_file_name+size_heap_profile_file_name_suffix>MAX_PATH_LENGTH){ + ++heap_written_count; + ew_print_string( "Heap file could not be created because the file name is too long.\n" ); + return; + } + + strcat (&heap_profile_file_name[length_file_name],heap_profile_file_name_suffix); + + heap_profile_file_name[length_file_name+size_heap_profile_file_name_suffix-6]='0'+heap_written_count; + } else { + ++heap_written_count; + ew_print_string( "Heap file could not be created because /proc/self/exe could not be read\n"); + return; + } + + ++heap_written_count; + + heap_file = fopen (heap_profile_file_name,"w"); + if (heap_file==NULL){ + heap_written_count = MAX_N_HEAPS; + + ew_print_string ("Heap file '"); + ew_print_string (heap_profile_file_name); + ew_print_string ("' could not be created.\n"); + + return; + } + + /* save application name */ + file_ok = fwrite (&length_application_name,sizeof (int),1,heap_file)==1; + if (file_ok) + file_ok = fwrite (heap_profile_file_name,1,length_application_name,heap_file)==length_application_name; + + /* write heap_info-structure */ + if (file_ok) + file_ok = fwrite (h,sizeof (struct heap_info),1,heap_file)==1; + + /* write stack */ + if (file_ok) + file_ok = fwrite (h->stack_begin,(int)(h->stack_end) - (int)(h->stack_begin),1,heap_file)==1; + + /* write heap1 */ + if (file_ok) + file_ok = fwrite (h->heap1_begin,(int)(h->heap1_end) - (int)(h->heap1_begin),1,heap_file)==1; + + /* write heap2 */ + if (file_ok) + file_ok = fwrite (h->heap2_begin,(int)(h->heap2_end) - (int)(h->heap2_begin),1,heap_file)==1; + + if (!file_ok){ + heap_written_count = MAX_N_HEAPS; + + ew_print_string ("Heap file '"); + ew_print_string (heap_profile_file_name); + ew_print_string ("' could not be written.\n"); + } + + fclose (heap_file); +} + |