Changeset 12807
- Timestamp:
- Sep 10, 2009, 5:06:33 PM (10 years ago)
- Location:
- trunk/source/lisp-kernel
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/lisp-kernel/memory.c
r12806 r12807 290 290 return VirtualAlloc(addr, nbytes, MEM_RESERVE|MEM_COMMIT, MEMPROTECT_RWX); 291 291 #else 292 return mmap(addr, nbytes, protection, MAP_PRIVATE|MAP_ANON|MAP_FIXED, -1, 0); 292 { 293 int flags = MAP_PRIVATE|MAP_ANON; 294 295 if (addr > 0) flags |= MAP_FIXED; 296 return mmap(addr, nbytes, protection, flags, -1, 0); 297 } 293 298 #endif 294 299 } -
trunk/source/lisp-kernel/x86-exceptions.c
r12770 r12807 499 499 return true; 500 500 } 501 update_bytes_allocated(tcr, (void *) (void *)tcr->save_allocptr);501 update_bytes_allocated(tcr, (void *)tcr->save_allocptr); 502 502 if (allocate_object(xp,bytes_needed,bytes_needed-fulltag_cons,tcr)) { 503 503 tcr->save_allocptr -= fulltag_cons; … … 803 803 xpPC(xp) = xpGPR(xp,Ira0); 804 804 return true; 805 } else { 805 } 806 807 { 806 808 protected_area *a = find_protected_area(addr); 807 809 protection_handler *handler; … … 810 812 handler = protection_handlers[a->why]; 811 813 return handler(xp, a, addr); 812 } else {813 if ((addr >= readonly_area->low) &&814 (addr < readonly_area->active)) {815 UnProtectMemory((LogicalAddress)(truncate_to_power_of_2(addr,log2_page_size)),816 page_size);817 return true;818 }819 814 } 820 815 } 821 } 816 817 if ((addr >= readonly_area->low) && 818 (addr < readonly_area->active)) { 819 UnProtectMemory((LogicalAddress)(truncate_to_power_of_2(addr,log2_page_size)), 820 page_size); 821 return true; 822 } 823 824 { 825 area *a = area_containing(addr); 826 827 if (a && a->code == AREA_WATCHED && addr < a->high) { 828 /* caught a write to a watched object */ 829 LispObj cmain = nrs_CMAIN.vcell; 830 LispObj object = (LispObj)a->low + fulltag_misc; /* always uvectors */ 831 832 if ((fulltag_of(cmain) == fulltag_misc) && 833 (header_subtag(header_of(cmain)) == subtag_macptr)) { 834 LispObj xcf = create_exception_callback_frame(xp, tcr); 835 int skip; 836 LispObj addr = (LispObj)a->low; 837 838 /* The magic 2 means this was a write to a watchd object */ 839 skip = callback_to_lisp(tcr, cmain, xp, xcf, SIGSEGV, 2, object, 0); 840 xpPC(xp) += skip; 841 return true; 842 } 843 } 844 } 845 } 846 822 847 if (old_valence == TCR_STATE_LISP) { 823 848 LispObj cmain = nrs_CMAIN.vcell, … … 993 1018 } 994 1019 break; 995 1020 case UUO_WATCH_TRAP: 1021 /* add or remove watched object */ 1022 if (handle_watch_trap(context, tcr)) { 1023 xpPC(context) += 2; 1024 return true; 1025 } 1026 break; 996 1027 case UUO_DEBUG_TRAP: 997 1028 xpPC(context) = (natural) (program_counter+1); … … 3585 3616 3586 3617 #endif 3618 3619 /* watchpoint stuff */ 3620 3621 area * 3622 new_watched_area(natural size) 3623 { 3624 void *p; 3625 3626 p = MapMemory(NULL, size, MEMPROTECT_RWX); 3627 if ((signed_natural)p == -1) { 3628 allocation_failure(true, size); 3629 } 3630 return new_area(p, p + size, AREA_WATCHED); 3631 } 3632 3633 void 3634 delete_watched_area(area *a, TCR *tcr) 3635 { 3636 natural nbytes = a->high - a->low; 3637 char *base = a->low; 3638 3639 condemn_area_holding_area_lock(a); 3640 3641 if (nbytes) { 3642 int err = munmap(base, nbytes); 3643 if (err < 0) 3644 Fatal("munmap in delete_watched_area: ", strerror(errno)); 3645 } 3646 } 3647 3648 natural 3649 uvector_total_size_in_bytes(LispObj *u) 3650 { 3651 LispObj header = header_of(u); 3652 natural header_tag = fulltag_of(header); 3653 natural subtag = header_subtag(header); 3654 natural element_count = header_element_count(header); 3655 natural nbytes = 0; 3656 3657 #ifdef X8632 3658 if ((nodeheader_tag_p(header_tag)) || 3659 (subtag <= max_32_bit_ivector_subtag)) { 3660 nbytes = element_count << 2; 3661 } else if (subtag <= max_8_bit_ivector_subtag) { 3662 nbytes = element_count; 3663 } else if (subtag <= max_16_bit_ivector_subtag) { 3664 nbytes = element_count << 1; 3665 } else if (subtag == subtag_double_float_vector) { 3666 nbytes = element_count << 3; 3667 } else { 3668 nbytes = (element_count + 7) >> 3; 3669 } 3670 /* add 4 byte header and round up to multiple of 8 bytes */ 3671 return ~7 & (4 + nbytes + 7); 3672 #endif 3673 #ifdef X8664 3674 if ((nodeheader_tag_p(header_tag)) || (header_tag == ivector_class_64_bit)) { 3675 nbytes = element_count << 3; 3676 } else if (header_tag == ivector_class_32_bit) { 3677 nbytes = element_count << 2; 3678 } else { 3679 /* ivector_class_other_bit contains 8, 16-bit arrays & bit vector */ 3680 if (subtag == subtag_bit_vector) { 3681 nbytes = (element_count + 7) >> 3; 3682 } else if (subtag >= min_8_bit_ivector_subtag) { 3683 nbytes = element_count; 3684 } else { 3685 nbytes = element_count << 1; 3686 } 3687 } 3688 /* add 8 byte header and round up to multiple of 16 bytes */ 3689 return ~15 & (8 + nbytes + 15); 3690 #endif 3691 } 3692 3693 extern void wp_update_references(TCR *, LispObj, LispObj); 3694 3695 /* 3696 * Other threads are suspended and pc-lusered. 3697 * 3698 * param contains a tagged pointer to a uvector. 3699 */ 3700 signed_natural 3701 watch_object(TCR *tcr, signed_natural param) 3702 { 3703 TCR *other_tcr; 3704 LispObj uvector = (LispObj)param; 3705 LispObj *noderef = (LispObj *)untag(uvector); 3706 natural size = uvector_total_size_in_bytes(noderef); 3707 area *uvector_area = area_containing((BytePtr)noderef); 3708 3709 if (uvector_area && uvector_area->code != AREA_WATCHED) { 3710 area *a = new_watched_area(size); 3711 LispObj old = uvector; 3712 LispObj new = (LispObj)((natural)a->low + fulltag_misc); 3713 3714 add_area_holding_area_lock(a); 3715 3716 /* move object to watched area */ 3717 bcopy(noderef, a->low, size); 3718 ProtectMemory(a->low, size); 3719 bzero(noderef, size); 3720 wp_update_references(tcr, old, new); 3721 check_all_areas(tcr); 3722 } 3723 return 0; 3724 } 3725 3726 signed_natural 3727 unwatch_object(TCR *tcr, signed_natural param) 3728 { 3729 TCR *other_tcr; 3730 LispObj uvector = (LispObj)param; 3731 LispObj *noderef = (LispObj *)untag(uvector); 3732 LispObj old = uvector; 3733 LispObj new; 3734 natural size = uvector_total_size_in_bytes(noderef); 3735 area *a = area_containing((BytePtr)noderef); 3736 ExceptionInformation *xp = tcr->xframe->curr; 3737 3738 if (a && a->code == AREA_WATCHED) { 3739 update_bytes_allocated(tcr, (void *)tcr->save_allocptr); 3740 if (allocate_object(xp, size, size - fulltag_misc, tcr)) { 3741 new = (LispObj)tcr->save_allocptr; 3742 tcr->save_allocptr -= fulltag_misc; 3743 } else { 3744 lisp_allocation_failure(xp, tcr, size); 3745 } 3746 3747 bcopy(noderef, tcr->save_allocptr, size); 3748 delete_watched_area(a, tcr); 3749 wp_update_references(tcr, old, new); 3750 check_all_areas(tcr); 3751 } 3752 return 0; 3753 } 3754 3755 Boolean 3756 handle_watch_trap(ExceptionInformation *xp, TCR *tcr) 3757 { 3758 LispObj selector = xpGPR(xp,Iimm0); 3759 LispObj uvector = xpGPR(xp, Iarg_z); 3760 3761 switch (selector) { 3762 case WATCH_TRAP_FUNCTION_WATCH: 3763 gc_like_from_xp(xp, watch_object, uvector); 3764 break; 3765 case WATCH_TRAP_FUNCTION_UNWATCH: 3766 gc_like_from_xp(xp, unwatch_object, uvector); 3767 break; 3768 default: 3769 break; 3770 } 3771 return true; 3772 } 3773 -
trunk/source/lisp-kernel/x86-exceptions.h
r11896 r12807 138 138 #define UUO_DEBUG_TRAP 0xca 139 139 #define UUO_DEBUG_TRAP_WITH_STRING 0xcd 140 #define UUO_WATCH_TRAP 0xce 141 #define WATCH_TRAP_FUNCTION_WATCH 0 142 #define WATCH_TRAP_FUNCTION_UNWATCH 1 140 143 141 144 #define XUUO_OPCODE_0 0x0f -
trunk/source/lisp-kernel/x86-gc.c
r12374 r12807 26 26 #include <sys/time.h> 27 27 28 #ifdef X8632 29 static inline natural 30 imm_word_count(LispObj fn) 31 { 32 natural w = ((unsigned short *)fn)[-1]; 33 34 if (w & 0x8000) { 35 /* 36 * The low 15 bits encode the number of contants. 37 * Compute and return the immediate word count. 38 */ 39 LispObj header = header_of(fn); 40 natural element_count = header_element_count(header); 41 42 return element_count - (w & 0x7fff); 43 } else { 44 /* The immediate word count is encoded directly. */ 45 return w; 46 } 47 } 48 #endif 28 49 29 50 /* Heap sanity checking. */ … … 318 339 switch (code) { 319 340 case AREA_DYNAMIC: 341 case AREA_WATCHED: 320 342 case AREA_STATIC: 321 343 case AREA_MANAGED_STATIC: … … 959 981 header = *(natural *)base; 960 982 subtag = header_subtag(header); 961 boundary = base + (unsigned short)base[1]; 962 963 /* XXX bootstrapping */ 964 { 965 natural word_count = (unsigned short)base[1]; 966 natural element_count = header_element_count(header); 967 968 if (word_count & 0x8000) 969 boundary = base + element_count - (word_count & 0x7fff); 970 } 983 boundary = base + imm_word_count(fn); 971 984 972 985 /* … … 991 1004 subtag = header_subtag(header); 992 1005 if (subtag == subtag_function) { 993 boundary = base + (unsigned short)base[1]; 994 /* XXX bootstrapping */ 995 { 996 natural word_count = (unsigned short)base[1]; 997 natural element_count = header_element_count(header); 998 999 if (word_count & 0x8000) 1000 boundary = base + element_count - (word_count & 0x7fff); 1001 } 1006 boundary = base + imm_word_count(this); 1002 1007 1003 1008 *((int *)boundary) &= 0xff; … … 1902 1907 LispObj fn = fulltag_misc + (LispObj)node; 1903 1908 unsigned char *p = (unsigned char *)node; 1904 natural i, offset; 1905 LispObj header = *node; 1906 1907 i = ((unsigned short *)node)[2]; 1909 natural i = imm_word_count(fn); 1910 1908 1911 if (i) { 1909 /* XXX bootstrapping for new scheme */ 1910 if (i & 0x8000) { 1911 i = header_element_count(header) - (i & 0x7fff); 1912 } 1913 offset = node[--i]; 1912 natural offset = node[--i]; 1914 1913 1915 1914 while (offset) { … … 1983 1982 if (header_subtag(node) == subtag_function) { 1984 1983 #ifdef X8632 1985 int skip = *((unsigned short *)src);1986 1984 LispObj *f = dest; 1987 1988 /* XXX bootstrapping for new scheme */ 1989 if (skip & 0x8000) 1990 skip = elements - (skip & 0x7fff); 1985 int skip = imm_word_count(fulltag_misc + (LispObj)current); 1991 1986 #else 1992 1987 int skip = *((int *)src); … … 2811 2806 return -1; 2812 2807 } 2808 2809 /* 2810 * This stuff is all adapted from the forward_xxx functions for use by 2811 * the watchpoint code. It's a lot of duplicated code, and it would 2812 * be nice to generalize it somehow. 2813 */ 2814 2815 static inline void 2816 wp_maybe_update(LispObj *p, LispObj old, LispObj new) 2817 { 2818 if (*p == old) { 2819 *p = new; 2820 } 2821 } 2822 2823 static void 2824 wp_update_headerless_range(LispObj *start, LispObj *end, 2825 LispObj old, LispObj new) 2826 { 2827 LispObj *p = start; 2828 2829 while (p < end) { 2830 wp_maybe_update(p, old, new); 2831 p++; 2832 } 2833 } 2834 2835 static void 2836 wp_update_range(LispObj *start, LispObj *end, LispObj old, LispObj new) 2837 { 2838 LispObj *p = start, node; 2839 int tag_n; 2840 natural nwords; 2841 2842 while (p < end) { 2843 node = *p; 2844 tag_n = fulltag_of(node); 2845 2846 if (immheader_tag_p(tag_n)) { 2847 p = (LispObj *)skip_over_ivector(ptr_to_lispobj(p), node); 2848 } else if (nodeheader_tag_p(tag_n)) { 2849 nwords = header_element_count(node); 2850 2851 nwords += 1 - (nwords & 1); 2852 2853 if ((header_subtag(node) == subtag_hash_vector) && 2854 ((((hash_table_vector_header *)p)->flags) & nhash_track_keys_mask)) { 2855 natural skip = hash_table_vector_header_count - 1; 2856 hash_table_vector_header *hashp = (hash_table_vector_header *)p; 2857 2858 p++; 2859 nwords -= skip; 2860 while(skip--) { 2861 if (*p == old) *p = new; 2862 p++; 2863 } 2864 /* "nwords" is odd at this point: there are (floor nwords 2) 2865 key/value pairs to look at, and then an extra word for 2866 alignment. Process them two at a time, then bump "p" 2867 past the alignment word. */ 2868 nwords >>= 1; 2869 while(nwords--) { 2870 if (*p == old && hashp) { 2871 *p = new; 2872 hashp->flags |= nhash_key_moved_mask; 2873 hashp = NULL; 2874 } 2875 p++; 2876 if (*p == old) *p = new; 2877 p++; 2878 } 2879 *p++ = 0; 2880 } else { 2881 if (header_subtag(node) == subtag_function) { 2882 #ifdef X8632 2883 int skip = (unsigned short)(p[1]); 2884 2885 /* XXX bootstrapping */ 2886 if (skip & 0x8000) 2887 skip = header_element_count(node) - (skip & 0x7fff); 2888 2889 #else 2890 int skip = (int)(p[1]); 2891 #endif 2892 p += skip; 2893 nwords -= skip; 2894 } 2895 p++; 2896 while(nwords--) { 2897 wp_maybe_update(p, old, new); 2898 p++; 2899 } 2900 } 2901 } else { 2902 /* a cons cell */ 2903 wp_maybe_update(p, old, new); 2904 p++; 2905 wp_maybe_update(p, old, new); 2906 p++; 2907 } 2908 } 2909 } 2910 2911 static void 2912 wp_update_xp(ExceptionInformation *xp, LispObj old, LispObj new) 2913 { 2914 natural *regs = (natural *)xpGPRvector(xp); 2915 2916 #ifdef X8664 2917 wp_maybe_update(®s[Iarg_z], old, new); 2918 wp_maybe_update(®s[Iarg_y], old, new); 2919 wp_maybe_update(®s[Iarg_x], old, new); 2920 wp_maybe_update(®s[Isave3], old, new); 2921 wp_maybe_update(®s[Isave2], old, new); 2922 wp_maybe_update(®s[Isave1], old, new); 2923 wp_maybe_update(®s[Isave0], old, new); 2924 wp_maybe_update(®s[Ifn], old, new); 2925 wp_maybe_update(®s[Itemp0], old, new); 2926 wp_maybe_update(®s[Itemp1], old, new); 2927 wp_maybe_update(®s[Itemp2], old, new); 2928 #endif 2929 2930 #if 0 2931 /* 2932 * We don't allow watching functions, so this presumably doesn't 2933 * matter. 2934 */ 2935 update_locref(&(regs[Iip])); 2936 #endif 2937 2938 } 2939 2940 static void 2941 wp_update_tcr_xframes(TCR *tcr, LispObj old, LispObj new) 2942 { 2943 xframe_list *xframes; 2944 ExceptionInformation *xp; 2945 2946 #ifdef X8664 2947 xp = tcr->gc_context; 2948 if (xp) { 2949 wp_update_xp(xp, old, new); 2950 } 2951 for (xframes = tcr->xframe; xframes; xframes = xframes->prev) { 2952 wp_update_xp(xframes->curr, old, new); 2953 } 2954 #endif 2955 } 2956 2957 /* 2958 * Scan all pointer-bearing areas, updating all references to 2959 * "old" to "new". 2960 */ 2961 static void 2962 wp_update_all_areas(LispObj old, LispObj new) 2963 { 2964 area *a = active_dynamic_area; 2965 natural code = a->code; 2966 2967 while (code != AREA_VOID) { 2968 switch (code) { 2969 case AREA_DYNAMIC: 2970 case AREA_STATIC: 2971 case AREA_MANAGED_STATIC: 2972 case AREA_WATCHED: 2973 wp_update_range((LispObj *)a->low, (LispObj *)a->active, old, new); 2974 break; 2975 case AREA_VSTACK: 2976 { 2977 LispObj *low = (LispObj *)a->active; 2978 LispObj *high = (LispObj *)a->high; 2979 2980 wp_update_headerless_range(low, high, old, new); 2981 } 2982 break; 2983 case AREA_TSTACK: 2984 { 2985 LispObj *current, *next; 2986 LispObj *start = (LispObj *)a->active, *end = start; 2987 LispObj *limit = (LispObj *)a->high; 2988 2989 for (current = start; end != limit; current = next) { 2990 next = ptr_from_lispobj(*current); 2991 end = ((next >= start) && (next < limit)) ? next : limit; 2992 wp_update_range(current+2, end, old, new); 2993 } 2994 break; 2995 } 2996 default: 2997 break; 2998 } 2999 a = a->succ; 3000 code = a->code; 3001 } 3002 } 3003 3004 static void 3005 wp_update_tcr_tlb(TCR *tcr, LispObj old, LispObj new) 3006 { 3007 natural n = tcr->tlb_limit; 3008 LispObj *start = tcr->tlb_pointer; 3009 LispObj *end = start + (n >> fixnumshift); 3010 3011 while (start < end) { 3012 wp_maybe_update(start, old, new); 3013 start++; 3014 } 3015 } 3016 3017 void 3018 wp_update_references(TCR *tcr, LispObj old, LispObj new) 3019 { 3020 TCR *other_tcr = tcr; 3021 3022 do { 3023 wp_update_tcr_xframes(other_tcr, old, new); 3024 wp_update_tcr_tlb(other_tcr, old, new); 3025 other_tcr = other_tcr->next; 3026 } while (other_tcr != tcr); 3027 wp_update_all_areas(old, new); 3028 }
Note: See TracChangeset
for help on using the changeset viewer.