Ignore:
Timestamp:
Apr 4, 2006, 4:38:03 AM (14 years ago)
Author:
gb
Message:

A little more infrastructure, so that we can actually call the GC.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/lisp-kernel/x86-exceptions.c

    r3996 r4011  
    4040
    4141
    42 
    43 
    44 int
    45 gc_from_xp(ExceptionInformation *xp, signed_natural param)
    46 {
    47   Bug(xp, "GC ?  Not yet ...");
    48 
    49 }
    50 
    5142void
    5243update_bytes_allocated(TCR* tcr, void *cur_allocptr)
     
    5546    last = (BytePtr) tcr->last_allocptr,
    5647    current = (BytePtr) cur_allocptr;
    57   if (last && (cur_allocptr != ((void *)VOID_ALLOCPTR))) {
     48  if (last && (tcr->save_allocbase != ((void *)VOID_ALLOCPTR))) {
    5849    tcr->bytes_allocated += last-current;
    5950  }
     
    146137
    147138Boolean
     139handle_gc_trap(ExceptionInformation *xp, TCR *tcr)
     140{
     141  LispObj
     142    selector = xpGPR(xp,Iimm0),
     143    arg = xpGPR(xp,Iimm1);
     144  area *a = active_dynamic_area;
     145  Boolean egc_was_enabled = (a->older != NULL);
     146
     147  switch (selector) {
     148  case GC_TRAP_FUNCTION_EGC_CONTROL:
     149    egc_control(arg != 0, a->active);
     150    xpGPR(xp,Iarg_z) = lisp_nil + (egc_was_enabled ? t_offset : 0);
     151    break;
     152
     153  case GC_TRAP_FUNCTION_CONFIGURE_EGC:
     154    a->threshold = unbox_fixnum(xpGPR(xp, Iarg_x));
     155    g1_area->threshold = unbox_fixnum(xpGPR(xp, Iarg_y));
     156    g2_area->threshold = unbox_fixnum(xpGPR(xp, Iarg_z));
     157    xpGPR(xp,Iarg_z) = lisp_nil+t_offset;
     158    break;
     159
     160  case GC_TRAP_FUNCTION_SET_LISP_HEAP_THRESHOLD:
     161    if (((signed_natural) arg) > 0) {
     162      lisp_heap_gc_threshold =
     163        align_to_power_of_2((arg-1) +
     164                            (heap_segment_size - 1),
     165                            log2_heap_segment_size);
     166    }
     167    /* fall through */
     168  case GC_TRAP_FUNCTION_GET_LISP_HEAP_THRESHOLD:
     169    xpGPR(xp, Iimm0) = lisp_heap_gc_threshold;
     170    break;
     171
     172  case GC_TRAP_FUNCTION_USE_LISP_HEAP_THRESHOLD:
     173    /*  Try to put the current threshold in effect.  This may
     174        need to disable/reenable the EGC. */
     175    untenure_from_area(tenured_area);
     176    resize_dynamic_heap(a->active,lisp_heap_gc_threshold);
     177    if (egc_was_enabled) {
     178      if ((a->high - a->active) >= a->threshold) {
     179        tenure_to_area(tenured_area);
     180      }
     181    }
     182    xpGPR(xp, Iimm0) = lisp_heap_gc_threshold;
     183    break;
     184
     185  default:
     186    update_bytes_allocated(tcr, (void *) ptr_from_lispobj(xpGPR(xp, Iallocptr)));
     187
     188    if (selector == GC_TRAP_FUNCTION_IMMEDIATE_GC) {
     189      gc_from_xp(xp, 0L);
     190      break;
     191    }
     192   
     193    if (egc_was_enabled) {
     194      egc_control(false, (BytePtr) a->active);
     195    }
     196    gc_from_xp(xp, 0L);
     197    if (selector & GC_TRAP_FUNCTION_PURIFY) {
     198      purify_from_xp(xp, 0L);
     199      gc_from_xp(xp, 0L);
     200    }
     201    if (selector & GC_TRAP_FUNCTION_SAVE_APPLICATION) {
     202      OSErr err;
     203      extern OSErr save_application(unsigned);
     204      area *vsarea = tcr->vs_area;
     205       
     206      nrs_TOPLFUNC.vcell = *((LispObj *)(vsarea->high)-1);
     207      err = save_application(arg);
     208      if (err == noErr) {
     209        exit(0);
     210      }
     211      fatal_oserr(": save_application", err);
     212    }
     213    if (selector == GC_TRAP_FUNCTION_SET_HONS_AREA_SIZE) {
     214      LispObj aligned_arg = align_to_power_of_2(arg, log2_nbits_in_word);
     215      signed_natural
     216        delta_dnodes = ((signed_natural) aligned_arg) -
     217        ((signed_natural) tenured_area->static_dnodes);
     218      change_hons_area_size_from_xp(xp, delta_dnodes*dnode_size);
     219      xpGPR(xp, Iimm0) = tenured_area->static_dnodes;
     220    }
     221    if (egc_was_enabled) {
     222      egc_control(true, NULL);
     223    }
     224    break;
     225  }
     226  return true;
     227}
     228
     229 
     230Boolean
    148231handle_alloc_trap(ExceptionInformation *xp, TCR *tcr)
    149232{
     
    178261      /* Something mapped to SIGSEGV that has nothing to do with
    179262         a memory fault */
    180       if (*program_counter == 0xcd) {   /* an int instruction */
     263      if (*program_counter == INTN_OPCODE) {
    181264        program_counter++;
    182         if (*program_counter == 0xc5) {
     265        switch (*program_counter) {
     266        case UUO_ALLOC_TRAP:
    183267          if (handle_alloc_trap(context, tcr)) {
    184             xpPC(context) = (natural) (program_counter+1);
     268            xpPC(context) += 2; /* we might have GCed. */
    185269            return true;
    186270          }
    187         }
    188         if (*program_counter == 0xca) {
     271          break;
     272        case UUO_GC_TRAP:
     273          if (handle_gc_trap(context, tcr)) {
     274            xpPC(context) += 2;
     275            return true;
     276          }
     277          break;
     278         
     279        case UUO_DEBUG_TRAP:
    189280          lisp_Debugger(context, info, debug_entry_dbg, "Lisp Breakpoint");
    190             xpPC(context) = (natural) (program_counter+1);
    191             return true;
     281          xpPC(context) = (natural) (program_counter+1);
     282          return true;
     283
    192284        }
    193285      }
     
    195287  }
    196288  return false;
     289}
     290
     291
     292/*
     293   Current thread has all signals masked.  Before unmasking them,
     294   make it appear that the current thread has been suspended.
     295   (This is to handle the case where another thread is trying
     296   to GC before this thread is able to seize the exception lock.)
     297*/
     298int
     299prepare_to_wait_for_exception_lock(TCR *tcr, ExceptionInformation *context)
     300{
     301  int old_valence = tcr->valence;
     302
     303  tcr->pending_exception_context = context;
     304  tcr->valence = TCR_STATE_EXCEPTION_WAIT;
     305
     306  ALLOW_EXCEPTIONS(context);
     307  return old_valence;
     308
     309
     310void
     311wait_for_exception_lock_in_handler(TCR *tcr,
     312                                   ExceptionInformation *context,
     313                                   xframe_list *xf)
     314{
     315
     316  LOCK(lisp_global(EXCEPTION_LOCK), tcr);
     317#if 0
     318  fprintf(stderr, "0x%x has exception lock\n", tcr);
     319#endif
     320  xf->curr = context;
     321  xf->prev = tcr->xframe;
     322  tcr->xframe =  xf;
     323  tcr->pending_exception_context = NULL;
     324  tcr->valence = TCR_STATE_FOREIGN;
     325}
     326
     327void
     328unlock_exception_lock_in_handler(TCR *tcr)
     329{
     330  tcr->pending_exception_context = tcr->xframe->curr;
     331  tcr->xframe = tcr->xframe->prev;
     332  tcr->valence = TCR_STATE_EXCEPTION_RETURN;
     333  UNLOCK(lisp_global(EXCEPTION_LOCK),tcr);
     334#if 0
     335  fprintf(stderr, "0x%x released exception lock\n", tcr);
     336#endif
     337}
     338
     339/*
     340   If an interrupt is pending on exception exit, try to ensure
     341   that the thread sees it as soon as it's able to run.
     342*/
     343void
     344raise_pending_interrupt(TCR *tcr)
     345{
     346  if (TCR_INTERRUPT_LEVEL(tcr) > 0) {
     347    pthread_kill((pthread_t)ptr_from_lispobj(tcr->osid), SIGNAL_FOR_PROCESS_INTERRUPT);
     348  }
     349}
     350
     351void
     352exit_signal_handler(TCR *tcr, int old_valence)
     353{
     354  sigset_t mask;
     355  sigfillset(&mask);
     356 
     357  pthread_sigmask(SIG_SETMASK,&mask, NULL);
     358  tcr->valence = old_valence;
     359  tcr->pending_exception_context = NULL;
    197360}
    198361
     
    204367  TCR* tcr = get_tcr(false);
    205368
     369  old_valence = prepare_to_wait_for_exception_lock(tcr, context);
     370  wait_for_exception_lock_in_handler(tcr,context, &xframe_link);
     371
     372
    206373  if (! handle_exception(signum, info, context, tcr)) {
    207374    char msg[512];
     375    sigset_t mask;
     376
     377    sigemptyset(&mask);
     378    sigaddset(&mask,SIGINT);
     379    pthread_sigmask(SIG_BLOCK, &mask, NULL);
     380
    208381    snprintf(msg, sizeof(msg), "Unhandled exception %d at 0x%lx, context->regs at #x%lx", signum, xpPC(context), (natural)xpGPRvector(context));
     382   
    209383    if (lisp_Debugger(context, info, signum, msg)) {
    210384      SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PROPAGATE_EXCEPTION);
    211385    }
    212386  }
     387  unlock_exception_lock_in_handler(tcr);
     388  exit_signal_handler(tcr, old_valence);
     389  /* raise_pending_interrupt(tcr); */
    213390}
    214391
     
    411588  sigaltstack(&stack, NULL);
    412589}
     590
     591void
     592pc_luser_xp(ExceptionInformation *xp, TCR *tcr)
     593{
     594  if (fulltag_of((LispObj)(tcr->save_allocptr)) != 0) {
     595    /* Not handled yet */
     596    Bug(NULL, "Other thread suspended during memory allocation");
     597  }
     598}
     599
     600void
     601normalize_tcr(ExceptionInformation *xp, TCR *tcr, Boolean is_other_tcr)
     602{
     603  void *cur_allocptr = (void *)(tcr->save_allocptr);
     604  LispObj lisprsp, lisptsp;
     605  area *a;
     606
     607  if (xp) {
     608    if (is_other_tcr) {
     609      pc_luser_xp(xp, tcr);
     610    }
     611    tcr->save_allocptr = tcr->save_allocbase = (void *)VOID_ALLOCPTR;
     612    a = tcr->vs_area;
     613    lisprsp = xpGPR(xp, Isp);
     614    if (((BytePtr)lisprsp >= a->low) &&
     615        ((BytePtr)lisprsp < a->high)) {
     616      a->active = (BytePtr)lisprsp;
     617    } else {
     618      a->active = (BytePtr) tcr->save_vsp;
     619    }
     620    a = tcr->ts_area;
     621    a->active = (BytePtr) xpMMXreg(xp, Itsp);
     622  } else {
     623    /* In ff-call; get area active pointers from tcr */
     624    tcr->vs_area->active = (BytePtr) tcr->save_vsp;
     625    tcr->ts_area->active = (BytePtr) tcr->save_tsp;
     626  }
     627  if (cur_allocptr) {
     628    update_bytes_allocated(tcr, cur_allocptr);
     629  }
     630}
     631
     632
     633/* Suspend and "normalize" other tcrs, then call a gc-like function
     634   in that context.  Resume the other tcrs, then return what the
     635   function returned */
     636
     637int
     638gc_like_from_xp(ExceptionInformation *xp,
     639                int(*fun)(TCR *, signed_natural),
     640                signed_natural param)
     641{
     642  TCR *tcr = get_tcr(false), *other_tcr;
     643  ExceptionInformation* other_xp;
     644  int result;
     645  signed_natural inhibit;
     646
     647  suspend_other_threads(true);
     648  inhibit = (signed_natural)(lisp_global(GC_INHIBIT_COUNT));
     649  if (inhibit != 0) {
     650    if (inhibit > 0) {
     651      lisp_global(GC_INHIBIT_COUNT) = (LispObj)(-inhibit);
     652    }
     653    resume_other_threads(true);
     654    return 0;
     655  }
     656
     657  xpGPR(xp, Iallocptr) = VOID_ALLOCPTR;
     658
     659  normalize_tcr(xp, tcr, false);
     660
     661
     662  for (other_tcr = tcr->next; other_tcr != tcr; other_tcr = other_tcr->next) {
     663    if (other_tcr->pending_exception_context) {
     664      other_tcr->gc_context = other_tcr->pending_exception_context;
     665    } else if (other_tcr->valence == TCR_STATE_LISP) {
     666      other_tcr->gc_context = other_tcr->suspend_context;
     667    } else {
     668      /* no pending exception, didn't suspend in lisp state:
     669         must have executed a synchronous ff-call.
     670      */
     671      other_tcr->gc_context = NULL;
     672    }
     673    normalize_tcr(other_tcr->gc_context, other_tcr, true);
     674  }
     675   
     676
     677
     678  result = fun(tcr, param);
     679
     680  other_tcr = tcr;
     681  do {
     682    other_tcr->gc_context = NULL;
     683    other_tcr = other_tcr->next;
     684  } while (other_tcr != tcr);
     685
     686  resume_other_threads(true);
     687
     688  return result;
     689
     690}
     691
     692int
     693change_hons_area_size_from_xp(ExceptionInformation *xp, signed_natural delta_in_bytes)
     694{
     695  return gc_like_from_xp(xp, change_hons_area_size, delta_in_bytes);
     696}
     697
     698int
     699purify_from_xp(ExceptionInformation *xp, signed_natural param)
     700{
     701  return gc_like_from_xp(xp, purify, param);
     702}
     703
     704int
     705impurify_from_xp(ExceptionInformation *xp, signed_natural param)
     706{
     707  return gc_like_from_xp(xp, impurify, param);
     708}
     709
     710/* Returns #bytes freed by invoking GC */
     711
     712int
     713gc_from_tcr(TCR *tcr, signed_natural param)
     714{
     715  area *a;
     716  BytePtr oldfree, newfree;
     717  BytePtr oldend, newend;
     718
     719#if 0
     720  fprintf(stderr, "Start GC  in 0x%lx\n", tcr);
     721#endif
     722  a = active_dynamic_area;
     723  oldend = a->high;
     724  oldfree = a->active;
     725  gc(tcr, param);
     726  newfree = a->active;
     727  newend = a->high;
     728#if 0
     729  fprintf(stderr, "End GC  in 0x%lx\n", tcr);
     730#endif
     731  return ((oldfree-newfree)+(newend-oldend));
     732}
     733
     734int
     735gc_from_xp(ExceptionInformation *xp, signed_natural param)
     736{
     737  int status = gc_like_from_xp(xp, gc_from_tcr, param);
     738
     739  freeGCptrs();
     740  return status;
     741}
Note: See TracChangeset for help on using the changeset viewer.