Ignore:
Timestamp:
May 23, 2011, 12:25:45 PM (9 years ago)
Author:
gb
Message:

Define and export the functions ALLOW-HEAP-ALLOCATION and
HEAP-ALLOCATION-ALLOWED-P and the condition type ALLOCATION-DISABLED.

(ALLOW-HEAP-ALLOCATION arg) : when ARG is NIL, causes any subsequent
attempts to heap-allocate lisp memory to signal (as if by CERROR)
an ALLOCATION-DISABLED condition. (Allocaton is enabled globally at
the point where the error is signaled.) Continuing from the CERROR
restarts the allocation attempt.

This is intended to help verify that code that's not expected to
cons doesn't do so.

(This is only implemented on the ARM at the moment, but the intent
is that it be supported on all platforms.)

Note that calling (ALLOW-HEAP-ALLOCATION NIL) in the REPL CERRORs
immediately, since the REPL will cons to create the new value of CL:/.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lisp-kernel/arm-exceptions.c

    r14791 r14807  
    7878extern Boolean grow_dynamic_area(natural);
    7979
    80 
     80Boolean allocation_enabled = true;
    8181
    8282
     
    326326  unsigned allocptr_tag;
    327327
     328  if (!allocation_enabled) {
     329    /* Back up before the alloc_trap, then let pc_luser_xp() back
     330       up some more. */
     331    xpPC(xp)-=1;
     332    pc_luser_xp(xp,tcr, NULL);
     333    allocation_enabled = true;
     334    tcr->save_allocbase = (void *)VOID_ALLOCPTR;
     335    handle_error(xp, error_allocation_disabled,0,NULL);
     336    return true;
     337  }
     338
    328339  cur_allocptr = xpGPR(xp,allocptr);
    329340
     
    427438    break;
    428439
     440  case GC_TRAP_FUNCTION_ALLOCATION_CONTROL:
     441    switch(arg) {
     442    case 0: /* disable if allocation enabled */
     443      xpGPR(xp, arg_z) = lisp_nil;
     444      if (allocation_enabled) {
     445        TCR *other_tcr;
     446        ExceptionInformation *other_context;
     447        suspend_other_threads(true);
     448        normalize_tcr(xp,tcr,false);
     449        for (other_tcr=tcr->next; other_tcr != tcr; other_tcr = other_tcr->next) {
     450          other_context = other_tcr->pending_exception_context;
     451          if (other_context == NULL) {
     452            other_context = other_tcr->suspend_context;
     453          }
     454          normalize_tcr(other_context, other_tcr, true);
     455        }
     456        allocation_enabled = false;
     457        xpGPR(xp, arg_z) = t_value;
     458        resume_other_threads(true);
     459      }
     460      break;
     461
     462    case 1:                     /* enable if disabled */
     463      xpGPR(xp, arg_z) = lisp_nil;
     464      if (!allocation_enabled) {
     465        allocation_enabled = true;
     466        xpGPR(xp, arg_z) = t_value;
     467      }
     468      break;
     469
     470    default:
     471      xpGPR(xp, arg_z) = lisp_nil;
     472      if (allocation_enabled) {
     473        xpGPR(xp, arg_z) = t_value;
     474      }
     475      break;
     476    }
     477    break;
     478
     479       
    429480  default:
    430481    update_bytes_allocated(tcr, (void *) ptr_from_lispobj(xpGPR(xp, allocptr)));
     
    648699void
    649700normalize_tcr(ExceptionInformation *xp, TCR *tcr, Boolean is_other_tcr)
     701
    650702{
    651703  void *cur_allocptr = NULL;
     
    16541706      if (alloc_disp) {
    16551707        *alloc_disp = disp;
    1656         xpGPR(xp,allocptr) += disp;
     1708        xpGPR(xp,allocptr) -= disp;
    16571709        /* Leave the PC at the alloc trap.  When the interrupt
    16581710           handler returns, it'll decrement allocptr by disp
     
    16611713      } else {
    16621714        Boolean ok = false;
    1663         update_bytes_allocated(tcr, (void *) ptr_from_lispobj(cur_allocptr + disp));
     1715        update_bytes_allocated(tcr, (void *) ptr_from_lispobj(cur_allocptr - disp));
    16641716        xpGPR(xp, allocptr) = VOID_ALLOCPTR + disp;
    16651717        instr = program_counter[-1];
     
    16721724        }
    16731725        if (ok) {
    1674         /* Clear the carry bit, so that the trap will be taken. */
    1675         xpPSR(xp) &= ~PSR_C_MASK;
     1726          /* Clear the carry bit, so that the trap will be taken. */
     1727          xpPSR(xp) &= ~PSR_C_MASK;
    16761728        } else {
    16771729          Bug(NULL, "unexpected instruction preceding alloc trap.");
Note: See TracChangeset for help on using the changeset viewer.