Changeset 7296


Ignore:
Timestamp:
Sep 26, 2007, 2:57:14 AM (12 years ago)
Author:
gb
Message:

Start to recover changes for "heap freezing", lost in a disk crash.

Location:
branches/working-0709/ccl
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0709/ccl/compiler/arch.lisp

    r7027 r7296  
    330330(defconstant gc-trap-function-configure-egc 64)
    331331(defconstant gc-trap-function-set-hons-area-size 128)
     332(defconstant gc-trap-function-freeze 129)
     333(defconstant gc-trap-function-thaw 130)
     334
    332335
    333336
  • branches/working-0709/ccl/level-0/X86/x86-utils.lisp

    r6483 r7296  
    443443  (single-value-return))
    444444
     445(defx86lapfunction freeze ()
     446  "Do a full GC, then consider all heap-allocated objects which survive to be non-relocatable."
     447  (movq ($ arch::gc-trap-function-freeze) (% imm0))
     448  (uuo-gc-trap)
     449  (jmp-subprim .SPmakeu64))
     450
     451 
     452 
    445453
    446454
  • branches/working-0709/ccl/lisp-kernel/gc.h

    r4579 r7296  
    118118#define GC_TRAP_FUNCTION_EGC_CONTROL 32
    119119#define GC_TRAP_FUNCTION_CONFIGURE_EGC 64
    120 #define GC_TRAP_FUNCTION_SET_HONS_AREA_SIZE 128
     120#define GC_TRAP_FUNCTION_SET_HONS_AREA_SIZE 128 /* deprecated */
     121#define GC_TRAP_FUNCTION_FREEZE 129
     122#define GC_TRAP_FUNCTION_THAW 130
     123
    121124#endif                          /* __GC_H__ */
  • branches/working-0709/ccl/lisp-kernel/x86-exceptions.c

    r7025 r7296  
    237237      fatal_oserr(": save_application", err);
    238238    }
    239     if (selector == GC_TRAP_FUNCTION_SET_HONS_AREA_SIZE) {
    240       LispObj aligned_arg = align_to_power_of_2(arg, log2_nbits_in_word);
    241       signed_natural
    242         delta_dnodes = ((signed_natural) aligned_arg) -
    243         ((signed_natural) tenured_area->static_dnodes);
    244       change_hons_area_size_from_xp(xp, delta_dnodes*dnode_size);
    245       xpGPR(xp, Iimm0) = tenured_area->static_dnodes;
     239    switch {salector) {
     240    case GC_TRAP_FUNCTION_SET_HONS_AREA_SIZE:
     241      xpGPR(xp, Iimm0) = 0;
     242      break;
     243    case GC_TRAP_FUNCTION_FREEZE:
     244      a->active = (BytePtr) align_to_power_of_2(a->active, log2_page_size);
     245      static_area->static_dnodes = area_dnode(a->active, a->low);
     246      xpGPR(xp, Iimm0) = static_area->static_dnodes;
     247      break;
     248    default:
     249      break;
    246250    }
    247251    if (egc_was_enabled) {
  • branches/working-0709/ccl/lisp-kernel/x86-gc.c

    r7202 r7296  
    34883488  return -1;
    34893489}
    3490 
    3491 
    3492 void
    3493 adjust_locref(LispObj *loc, LispObj base, LispObj limit, signed_natural delta)
    3494 {
    3495   LispObj p = *loc;
    3496  
    3497   if (area_dnode(p, base) < limit) {
    3498     *loc = p+delta;
    3499   }
    3500 }
    3501 
    3502 /* like adjust_locref() above, but only changes the contents of LOC if it's
    3503    a tagged lisp pointer */
    3504 void
    3505 adjust_noderef(LispObj *loc, LispObj base, LispObj limit, signed_natural delta)
    3506 {
    3507   LispObj p = *loc;
    3508   int tag_n = fulltag_of(p);
    3509 
    3510   if (is_node_fulltag(tag_n)) {
    3511     if (area_dnode(p, base) < limit) {
    3512       *loc = p+delta;
    3513     }
    3514   }
    3515 }
    3516 
    3517 /*
    3518    If *loc is a tagged pointer into the address range denoted by BASE and LIMIT,
    3519    nuke it (set it to NIL.)
    3520 */
    3521 void
    3522 nuke_noderef(LispObj *loc, LispObj base, LispObj limit)
    3523 {
    3524   LispObj p = *loc;
    3525   int tag_n = fulltag_of(p);
    3526 
    3527   if (is_node_fulltag(tag_n)) {
    3528     if (area_dnode(p, base) < limit) {
    3529       *loc = lisp_nil;
    3530     }
    3531   }
    3532 }
    3533 
    3534 
    3535 void
    3536 adjust_pointers_in_xp(ExceptionInformation *xp,
    3537                       LispObj base,
    3538                       LispObj limit,
    3539                       signed_natural delta)
    3540 {
    3541   natural *regs = (natural *) xpGPRvector(xp);
    3542 
    3543   adjust_noderef((LispObj *) (&(regs[Iarg_z])),base,limit,delta);
    3544   adjust_noderef((LispObj *) (&(regs[Iarg_y])),base,limit,delta);
    3545   adjust_noderef((LispObj *) (&(regs[Iarg_x])),base,limit,delta);
    3546   adjust_noderef((LispObj *) (&(regs[Isave3])),base,limit,delta);
    3547   adjust_noderef((LispObj *) (&(regs[Isave2])),base,limit,delta);
    3548   adjust_noderef((LispObj *) (&(regs[Isave1])),base,limit,delta);
    3549   adjust_noderef((LispObj *) (&(regs[Isave0])),base,limit,delta);
    3550   adjust_noderef((LispObj *) (&(regs[Ifn])),base,limit,delta);
    3551   adjust_noderef((LispObj *) (&(regs[Itemp0])),base,limit,delta);
    3552   adjust_noderef((LispObj *) (&(regs[Itemp1])),base,limit,delta);
    3553   adjust_noderef((LispObj *) (&(regs[Itemp2])),base,limit,delta);
    3554   adjust_locref((LispObj *) (&(xpPC(xp))),base,limit,delta);
    3555 }
    3556 
    3557 void
    3558 nuke_pointers_in_xp(ExceptionInformation *xp,
    3559                       LispObj base,
    3560                       LispObj limit)
    3561 {
    3562   natural *regs = (natural *) xpGPRvector(xp);
    3563 
    3564   nuke_noderef((LispObj *) (&(regs[Iarg_z])),base,limit);
    3565   nuke_noderef((LispObj *) (&(regs[Iarg_y])),base,limit);
    3566   nuke_noderef((LispObj *) (&(regs[Iarg_x])),base,limit);
    3567   nuke_noderef((LispObj *) (&(regs[Isave3])),base,limit);
    3568   nuke_noderef((LispObj *) (&(regs[Isave2])),base,limit);
    3569   nuke_noderef((LispObj *) (&(regs[Isave1])),base,limit);
    3570   nuke_noderef((LispObj *) (&(regs[Isave0])),base,limit);
    3571   nuke_noderef((LispObj *) (&(regs[Ifn])),base,limit);
    3572   nuke_noderef((LispObj *) (&(regs[Itemp0])),base,limit);
    3573   nuke_noderef((LispObj *) (&(regs[Itemp1])),base,limit);
    3574   nuke_noderef((LispObj *) (&(regs[Itemp2])),base,limit);
    3575 
    3576 }
    3577 
    3578 void
    3579 adjust_pointers_in_headerless_range(LispObj *range_start,
    3580                                     LispObj *range_end,
    3581                                     LispObj base,
    3582                                     LispObj limit,
    3583                                     signed_natural delta)
    3584 {
    3585   LispObj *p = range_start;
    3586 
    3587   while (p < range_end) {
    3588     adjust_noderef(p, base, limit, delta);
    3589     p++;
    3590   }
    3591 }
    3592 
    3593 
    3594 void
    3595 adjust_pointers_in_range(LispObj *range_start,
    3596                          LispObj *range_end,
    3597                          LispObj base,
    3598                          LispObj limit,
    3599                          signed_natural delta)
    3600 {
    3601   LispObj *p = range_start, node, new;
    3602   int tag_n;
    3603   natural nwords;
    3604   hash_table_vector_header *hashp;
    3605 
    3606   while (p < range_end) {
    3607     node = *p;
    3608     tag_n = fulltag_of(node);
    3609     if (immheader_tag_p(tag_n)) {
    3610       p = (LispObj *) skip_over_ivector((natural) p, node);
    3611     } else if (nodeheader_tag_p(tag_n)) {
    3612       nwords = header_element_count(node);
    3613       nwords += (1 - (nwords&1));
    3614       if ((header_subtag(node) == subtag_hash_vector) &&
    3615           ((((hash_table_vector_header *)p)->flags) & nhash_track_keys_mask)) {
    3616         hashp = (hash_table_vector_header *) p;
    3617         hashp->flags |= nhash_key_moved_mask;
    3618       } else if (header_subtag(node) == subtag_function) {
    3619         int skip = (int)(p[1]);
    3620         p += skip;
    3621         nwords -= skip;
    3622       }
    3623       p++;
    3624       while (nwords--) {
    3625         adjust_noderef(p, base, limit, delta);
    3626         p++;
    3627       }
    3628     } else {
    3629       /* just a cons */
    3630       adjust_noderef(p, base, limit, delta);
    3631       p++;
    3632       adjust_noderef(p, base, limit, delta);
    3633       p++;
    3634     }
    3635   }
    3636 }
    3637 
    3638 void
    3639 nuke_pointers_in_headerless_range(LispObj *range_start,
    3640                                   LispObj *range_end,
    3641                                   LispObj base,
    3642                                   LispObj limit)
    3643 {
    3644   LispObj *p = range_start;
    3645 
    3646   while (p < range_end) {
    3647     nuke_noderef(p, base, limit);
    3648     p++;
    3649   }
    3650 }
    3651 
    3652 
    3653 void
    3654 nuke_pointers_in_range(LispObj *range_start,
    3655                          LispObj *range_end,
    3656                          LispObj base,
    3657                          LispObj limit)
    3658 {
    3659   LispObj *p = range_start, node, new;
    3660   int tag_n;
    3661   natural nwords;
    3662 
    3663   while (p < range_end) {
    3664     node = *p;
    3665     tag_n = fulltag_of(node);
    3666     if (immheader_tag_p(tag_n)) {
    3667       p = (LispObj *) skip_over_ivector((natural) p, node);
    3668     } else if (nodeheader_tag_p(tag_n)) {
    3669       nwords = header_element_count(node);
    3670       nwords += (1 - (nwords&1));
    3671       if (header_subtag(node) == subtag_function) {
    3672         int skip = (int)(p[1]);
    3673         p += skip;
    3674         nwords -= skip;
    3675       }
    3676       p++;
    3677       while (nwords--) {
    3678         nuke_noderef(p, base, limit);
    3679         p++;
    3680       }
    3681     } else {
    3682       /* just a cons */
    3683       nuke_noderef(p, base, limit);
    3684       p++;
    3685       nuke_noderef(p, base, limit);
    3686       p++;
    3687     }
    3688   }
    3689 }
    3690 
    3691 void
    3692 adjust_pointers_in_tstack_area(area *a,
    3693                                LispObj base,
    3694                                LispObj limit,
    3695                                LispObj delta)
    3696 {
    3697   LispObj
    3698     *current,
    3699     *next,
    3700     *start = (LispObj *) a->active,
    3701     *end = start,
    3702     *area_limit = (LispObj *) (a->high);
    3703 
    3704   for (current = start;
    3705        end != area_limit;
    3706        current = next) {
    3707     next = ptr_from_lispobj(*current);
    3708     end = ((next >= start) && (next < area_limit)) ? next : area_limit;
    3709     adjust_pointers_in_range(current+2, end, base, limit, delta);
    3710   }
    3711 }
    3712 
    3713 void
    3714 nuke_pointers_in_tstack_area(area *a,
    3715                              LispObj base,
    3716                              LispObj limit)
    3717 {
    3718   LispObj
    3719     *current,
    3720     *next,
    3721     *start = (LispObj *) a->active,
    3722     *end = start,
    3723     *area_limit = (LispObj *) (a->high);
    3724 
    3725   for (current = start;
    3726        end != area_limit;
    3727        current = next) {
    3728     next = ptr_from_lispobj(*current);
    3729     end = ((next >= start) && (next < area_limit)) ? next : area_limit;
    3730     if (current[1] == 0) {
    3731       nuke_pointers_in_range(current+2, end, base, limit);
    3732     }
    3733   }
    3734 }
    3735 
    3736 void
    3737 adjust_pointers_in_vstack_area(area *a,
    3738                                LispObj base,
    3739                                LispObj limit,
    3740                                LispObj delta)
    3741 {
    3742   LispObj
    3743     *p = (LispObj *) a->active,
    3744     *q = (LispObj *) a->high;
    3745 
    3746   adjust_pointers_in_headerless_range(p, q, base, limit, delta);
    3747 }
    3748 
    3749 void
    3750 nuke_pointers_in_vstack_area(area *a,
    3751                              LispObj base,
    3752                              LispObj limit)
    3753 {
    3754   LispObj
    3755     *p = (LispObj *) a->active,
    3756     *q = (LispObj *) a->high;
    3757 
    3758   nuke_pointers_in_headerless_range(p, q, base, limit);
    3759 }
    3760 
    3761 #ifdef PPC
    3762 void
    3763 adjust_pointers_in_cstack_area(area *a,
    3764                                LispObj base,
    3765                                LispObj limit,
    3766                                LispObj delta)
    3767 {
    3768   BytePtr
    3769     current,
    3770     next,
    3771     area_limit = a->high,
    3772     low = a->low;
    3773 
    3774   for (current = a->active; (current >= low) && (current < area_limit); current = next) {
    3775     next = *((BytePtr *)current);
    3776     if (next == NULL) break;
    3777     if (((next - current) == sizeof(lisp_frame)) &&
    3778         (((((lisp_frame *)current)->savefn) == 0) ||
    3779          (fulltag_of(((lisp_frame *)current)->savefn) == fulltag_misc))) {
    3780       adjust_noderef(&((lisp_frame *) current)->savefn, base, limit, delta);
    3781       adjust_locref(&((lisp_frame *) current)->savelr, base, limit, delta);
    3782     }
    3783   }
    3784 }
    3785 #endif
    3786 
    3787 
    3788 
    3789 void
    3790 adjust_pointers_in_tcrs(TCR *current, LispObj base, LispObj limit, signed_natural delta)
    3791 {
    3792   TCR *tcr = current;
    3793   xframe_list *xframes;
    3794   LispObj *tlb_start, *tlb_end;
    3795   ExceptionInformation *xp;
    3796 
    3797   do {
    3798     xp = tcr->gc_context;
    3799     if (xp) {
    3800       adjust_pointers_in_xp(xp, base, limit, delta);
    3801     }
    3802     for (xframes = (xframe_list *) tcr->xframe;
    3803          xframes;
    3804          xframes = xframes->prev) {
    3805       adjust_pointers_in_xp(xframes->curr, base, limit, delta);
    3806     }
    3807     adjust_pointers_in_range(tcr->tlb_pointer,
    3808                              (LispObj *) ((BytePtr)tcr->tlb_pointer+tcr->tlb_limit),
    3809                              base,
    3810                              limit,
    3811                              delta);
    3812     tcr = tcr->next;
    3813   } while (tcr != current);
    3814 }
    3815 
    3816 void
    3817 nuke_pointers_in_tcrs(TCR *current, LispObj base, LispObj limit)
    3818 {
    3819   TCR *tcr = current;
    3820   xframe_list *xframes;
    3821   LispObj *tlb_start, *tlb_end;
    3822   ExceptionInformation *xp;
    3823 
    3824   do {
    3825     xp = tcr->gc_context;
    3826     if (xp) {
    3827       nuke_pointers_in_xp(xp, base, limit);
    3828     }
    3829     for (xframes = (xframe_list *) tcr->xframe;
    3830          xframes;
    3831          xframes = xframes->prev) {
    3832       nuke_pointers_in_xp(xframes->curr, base, limit);
    3833     }
    3834     nuke_pointers_in_range(tcr->tlb_pointer,
    3835                            (LispObj *) ((BytePtr)tcr->tlb_pointer+tcr->tlb_limit),
    3836                            base,
    3837                            limit);
    3838     tcr = tcr->next;
    3839   } while (tcr != current);
    3840 }
    3841 
    3842 void
    3843 adjust_gcable_ptrs(LispObj base, LispObj limit, signed_natural delta)
    3844 {
    3845   /* These need to be special-cased, because xmacptrs are immediate
    3846      objects that contain (in their "link" fields") tagged pointers
    3847      to other xmacptrs */
    3848   LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next;
    3849 
    3850   while ((next = *prev) != (LispObj)NULL) {
    3851     adjust_noderef(prev, base, limit, delta);
    3852     if (delta < 0) {
    3853       /* Assume that we've already moved things */
    3854       next = *prev;
    3855     }
    3856     prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link);
    3857   }
    3858 }
    3859    
    3860 
    3861 void
    3862 adjust_pointers_in_dynamic_area(area *a,
    3863                                 LispObj base,
    3864                                 LispObj limit,
    3865                                 signed_natural delta)
    3866 {
    3867   natural
    3868     nstatic = static_dnodes_for_area(a),
    3869     nstatic_bitmap_words = nstatic >> bitmap_shift;
    3870   LispObj
    3871     *low = (LispObj *) (a->low),
    3872     *active = (LispObj *) (a->active),
    3873     *dynamic_low = low + (2 * nstatic);
    3874 
    3875   adjust_pointers_in_range(dynamic_low, active, base, limit, delta);
    3876 
    3877   if (nstatic && (nstatic <= a->ndnodes)) {
    3878     cons *pagelet_start = (cons *) a->low, *work;
    3879     bitvector usedbits = tenured_area->static_used;
    3880     natural used, i;
    3881    
    3882     while (nstatic_bitmap_words--) {
    3883       used = *usedbits++;
    3884 
    3885       while (used) {
    3886         i = count_leading_zeros(used);
    3887         used &= ~(BIT0_MASK >> i);
    3888         work = pagelet_start+i;
    3889         adjust_noderef(&(work->cdr), base, limit, delta);
    3890         adjust_noderef(&(work->car), base, limit, delta);
    3891       }
    3892       pagelet_start += nbits_in_word;
    3893     }
    3894   }
    3895 }
    3896 
    3897 void
    3898 nuke_pointers_in_dynamic_area(area *a,
    3899                               LispObj base,
    3900                               LispObj limit)
    3901 {
    3902   natural
    3903     nstatic = static_dnodes_for_area(a),
    3904     nstatic_bitmap_words = nstatic >> bitmap_shift;
    3905   LispObj
    3906     *low = (LispObj *) (a->low),
    3907     *active = (LispObj *) (a->active),
    3908     *dynamic_low = low + (2 * nstatic);
    3909 
    3910   nuke_pointers_in_range(dynamic_low, active, base, limit);
    3911 
    3912   if (nstatic && (nstatic <= a->ndnodes)) {
    3913     cons *pagelet_start = (cons *) a->low, *work;
    3914     bitvector usedbits = tenured_area->static_used;
    3915     natural used, i;
    3916    
    3917     while (nstatic_bitmap_words--) {
    3918       used = *usedbits++;
    3919 
    3920       while (used) {
    3921         i = count_leading_zeros(used);
    3922         used &= ~(BIT0_MASK >> i);
    3923         work = pagelet_start+i;
    3924         nuke_noderef(&(work->cdr), base, limit);
    3925         nuke_noderef(&(work->car), base, limit);
    3926       }
    3927       pagelet_start += nbits_in_word;
    3928     }
    3929   }
    3930 }
    3931 
    3932    
    3933 void
    3934 adjust_all_pointers(LispObj base, LispObj limit, signed_natural delta)
    3935 {
    3936   area *next_area;
    3937   area_code code;
    3938 
    3939   for (next_area = active_dynamic_area;
    3940        (code = next_area->code) != AREA_VOID;
    3941        next_area = next_area->succ) {
    3942     switch (code) {
    3943     case AREA_TSTACK:
    3944       adjust_pointers_in_tstack_area(next_area, base, limit, delta);
    3945       break;
    3946      
    3947     case AREA_VSTACK:
    3948       adjust_pointers_in_vstack_area(next_area, base, limit, delta);
    3949       break;
    3950 
    3951     case AREA_CSTACK:
    3952 #ifndef X86
    3953       adjust_pointers_in_cstack_area(next_area, base, limit, delta);
    3954 #endif
    3955       break;
    3956 
    3957     case AREA_STATIC:
    3958     case AREA_MANAGED_STATIC:
    3959       adjust_pointers_in_range((LispObj *) (next_area->low),
    3960                                (LispObj *) (next_area->active),
    3961                                base,
    3962                                limit,
    3963                                delta);
    3964       break;
    3965 
    3966     case AREA_DYNAMIC:
    3967       adjust_pointers_in_dynamic_area(next_area, base, limit, delta);
    3968       break;
    3969     }
    3970   }
    3971   adjust_pointers_in_tcrs(get_tcr(false), base, limit, delta);
    3972   adjust_gcable_ptrs(base, limit, delta);
    3973 }
    3974 
    3975 void
    3976 nuke_all_pointers(LispObj base, LispObj limit)
    3977 {
    3978   area *next_area;
    3979   area_code code;
    3980 
    3981   for (next_area = active_dynamic_area;
    3982        (code = next_area->code) != AREA_VOID;
    3983        next_area = next_area->succ) {
    3984     switch (code) {
    3985     case AREA_TSTACK:
    3986       nuke_pointers_in_tstack_area(next_area, base, limit);
    3987       break;
    3988      
    3989     case AREA_VSTACK:
    3990       nuke_pointers_in_vstack_area(next_area, base, limit);
    3991       break;
    3992 
    3993     case AREA_CSTACK:
    3994       /* There aren't any "nukable" pointers in a cstack area */
    3995       break;
    3996 
    3997     case AREA_STATIC:
    3998     case AREA_MANAGED_STATIC:
    3999       nuke_pointers_in_range((LispObj *) (next_area->low),
    4000                                (LispObj *) (next_area->active),
    4001                                base,
    4002                                limit);
    4003       break;
    4004 
    4005     case AREA_DYNAMIC:
    4006       nuke_pointers_in_dynamic_area(next_area, base, limit);
    4007       break;
    4008     }
    4009   }
    4010   nuke_pointers_in_tcrs(get_tcr(false), base, limit);
    4011 }
    4012 
    4013 #ifndef MREMAP_MAYMOVE
    4014 #define MREMAP_MAYMOVE 1
    4015 #endif
    4016 
    4017 #if defined(FREEBSD) || defined(SOLARIS)
    4018 void *
    4019 freebsd_mremap(void *old_address,
    4020                size_t old_size,
    4021                size_t new_size,
    4022                unsigned long flags)
    4023 {
    4024   return old_address;
    4025 }
    4026 #define mremap freebsd_mremap
    4027 
    4028 #endif
    4029 
    4030 #ifdef DARWIN
    4031 void *
    4032 darwin_mremap(void *old_address,
    4033               size_t old_size,
    4034               size_t new_size,
    4035               unsigned long flags)
    4036 {
    4037   void *end = (void *) ((char *)old_address+old_size);
    4038 
    4039   if (old_size == new_size) {
    4040     return old_address;
    4041   }
    4042   if (new_size < old_size) {
    4043     munmap(end, old_size-new_size);
    4044     return old_address;
    4045   }
    4046   {
    4047     void * new_address = mmap(NULL,
    4048                               new_size,
    4049                               PROT_READ|PROT_WRITE,
    4050                               MAP_PRIVATE | MAP_ANON,
    4051                               -1,
    4052                               0);
    4053     if (new_address !=  MAP_FAILED) {
    4054       vm_copy(mach_task_self(),
    4055               (vm_address_t)old_address,
    4056               old_size,
    4057               (vm_address_t)new_address);
    4058       munmap(old_address, old_size);
    4059     }
    4060     return new_address;
    4061   }
    4062 }
    4063 
    4064 #define mremap darwin_mremap
    4065 #endif
    4066 
    4067 Boolean
    4068 resize_used_bitvector(natural new_dnodes, bitvector *newbits)
    4069 {
    4070   natural
    4071     old_dnodes = tenured_area->static_dnodes,
    4072     old_page_aligned_size =
    4073     (align_to_power_of_2((align_to_power_of_2(old_dnodes, log2_nbits_in_word)>>3),
    4074                          log2_page_size)),
    4075     new_page_aligned_size =
    4076     (align_to_power_of_2((align_to_power_of_2(new_dnodes, log2_nbits_in_word)>>3),
    4077                          log2_page_size));
    4078   bitvector old_used = tenured_area->static_used, new_used = NULL;
    4079 
    4080   if (old_page_aligned_size == new_page_aligned_size) {
    4081     *newbits = old_used;
    4082     return true;
    4083   }
    4084 
    4085   if (old_used == NULL) {
    4086     new_used = (bitvector)mmap(NULL,
    4087                                new_page_aligned_size,
    4088                                PROT_READ|PROT_WRITE,
    4089                                MAP_PRIVATE | MAP_ANON,
    4090                                -1,
    4091                                0);
    4092     if (new_used == MAP_FAILED) {
    4093       *newbits = NULL;
    4094       return false;
    4095     } else {
    4096       *newbits = new_used;
    4097       return true;
    4098     }
    4099   }
    4100   if (new_page_aligned_size == 0) {
    4101     munmap((void *)old_used, old_page_aligned_size);
    4102     *newbits = NULL;
    4103     return true;
    4104   }
    4105    
    4106   /* Have to try to remap the old bitmap.  That's implementation-dependent,
    4107      and (naturally) Mach sucks, but no one understands how.
    4108   */
    4109   new_used = mremap(old_used,
    4110                     old_page_aligned_size,
    4111                     new_page_aligned_size,
    4112                     MREMAP_MAYMOVE);
    4113   if (new_used == MAP_FAILED) {
    4114     *newbits = NULL;
    4115     return false;
    4116   }
    4117   *newbits = new_used;
    4118   return true;
    4119 }
    4120 
    4121  
    4122 int
    4123 grow_hons_area(signed_natural delta_in_bytes)
    4124 {
    4125   bitvector new_used;
    4126   area *ada = active_dynamic_area;
    4127   natural
    4128     delta_in_dnodes = delta_in_bytes >> dnode_shift,
    4129     current_static_dnodes = tenured_area->static_dnodes,
    4130     new_static_dnodes;
    4131    
    4132   delta_in_dnodes = align_to_power_of_2(delta_in_dnodes,log2_nbits_in_word);
    4133   new_static_dnodes = current_static_dnodes+delta_in_dnodes;
    4134   delta_in_bytes = delta_in_dnodes << dnode_shift;
    4135   if (grow_dynamic_area((natural) delta_in_bytes)) {
    4136     LispObj
    4137       base = (LispObj) (ada->low + (current_static_dnodes*dnode_size)),
    4138       oldactive = (LispObj) ada->active,
    4139       limit = area_dnode(oldactive, base);
    4140     if (!resize_used_bitvector(new_static_dnodes, &new_used)) {
    4141       shrink_dynamic_area(delta_in_bytes);
    4142       return -1;
    4143     }
    4144     tenured_area->static_used = new_used;
    4145     adjust_all_pointers(base, limit, delta_in_bytes);
    4146     memmove((void *)(base+delta_in_bytes),(void *)base,oldactive-base);
    4147     ada->ndnodes = area_dnode(ada->high, ada->low);
    4148     ada->active += delta_in_bytes;
    4149     {
    4150       LispObj *p;
    4151       natural i;
    4152       for (p = (LispObj *)(tenured_area->low + (current_static_dnodes << dnode_shift)), i = 0;
    4153            i< delta_in_dnodes;
    4154            i++ ) {
    4155         *p++ = undefined;
    4156         *p++ = undefined;
    4157       }
    4158       tenured_area->static_dnodes += delta_in_dnodes;
    4159          
    4160     }
    4161     return 0;
    4162   }
    4163   return -1;
    4164 }
    4165 
    4166 int
    4167 shrink_hons_area(signed_natural delta_in_bytes)
    4168 {
    4169   area *ada = active_dynamic_area;
    4170   signed_natural
    4171     delta_in_dnodes = delta_in_bytes >> dnode_shift;
    4172   natural
    4173     current_static_dnodes = tenured_area->static_dnodes,
    4174     new_static_dnodes;
    4175   LispObj base, limit, oldactive;
    4176   bitvector newbits;
    4177 
    4178    
    4179   delta_in_dnodes = -align_to_power_of_2(-delta_in_dnodes,log2_nbits_in_word);
    4180   new_static_dnodes = current_static_dnodes+delta_in_dnodes;
    4181   delta_in_bytes = delta_in_dnodes << dnode_shift;
    4182   oldactive = (LispObj) (ada->active);
    4183 
    4184   resize_used_bitvector(new_static_dnodes, &newbits);
    4185   tenured_area->static_used = newbits; /* redundant */
    4186 
    4187   memmove(ada->low+(new_static_dnodes << dnode_shift),
    4188           ada->low+(current_static_dnodes << dnode_shift),
    4189           oldactive-(natural)(ada->low+(current_static_dnodes << dnode_shift)));
    4190   tenured_area->static_dnodes = new_static_dnodes;
    4191   ada->active -= -delta_in_bytes; /* delta_in_bytes is negative */
    4192   shrink_dynamic_area(-delta_in_bytes);
    4193 
    4194   base = (LispObj) (tenured_area->low +
    4195                     (new_static_dnodes << dnode_shift));
    4196   limit = area_dnode(tenured_area->low +
    4197                      (current_static_dnodes << dnode_shift), base);
    4198   nuke_all_pointers(base, limit);
    4199 
    4200   base = (LispObj) (tenured_area->low +
    4201                     (current_static_dnodes << dnode_shift));
    4202   limit = area_dnode(oldactive, base);
    4203   adjust_all_pointers(base, limit, delta_in_bytes);
    4204 
    4205   xMakeDataExecutable(tenured_area->low+(tenured_area->static_dnodes<<dnode_shift),
    4206                       ada->active-(tenured_area->low+(tenured_area->static_dnodes<<dnode_shift)));
    4207   return 0;
    4208 }
    4209 
    4210 int
    4211 change_hons_area_size(TCR *tcr, signed_natural delta_in_bytes)
    4212 {
    4213   if (delta_in_bytes > 0) {
    4214     return grow_hons_area(delta_in_bytes);
    4215   }
    4216   if (delta_in_bytes < 0) {
    4217     return shrink_hons_area(delta_in_bytes);
    4218   }
    4219   return 0;
    4220 }
    4221 
Note: See TracChangeset for help on using the changeset viewer.