Changeset 11521


Ignore:
Timestamp:
Dec 15, 2008, 7:47:12 AM (11 years ago)
Author:
gb
Message:

x86 support for %ALLOCATE-LIST.

Location:
trunk/source
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/X86/X8632/x8632-utils.lisp

    r11363 r11521  
    386386  (jmp-subprim .SPmakeu32))
    387387
     388(defx8632lapfunction %allocate-list ((initial-element arg_y) (nconses arg_z))
     389  (check-nargs 2)
     390  (save-simple-frame)
     391  (ud2a)
     392  (:byte 10)
     393  (push (% arg_z))
     394  (push (% allocptr))
     395  (set-nargs 2)
     396  (jmp-subprim .SPnvalret))
     397
    388398;;; offset is a fixnum, one of the x8632::kernel-import-xxx constants.
    389399;;; Returns that kernel import, a fixnum.
  • trunk/source/level-0/X86/x86-utils.lisp

    r10959 r11521  
    439439  (jmp-subprim .SPmakeu64))
    440440
    441  
     441(defx86lapfunction %allocate-list ((initial-element arg_y) (nconses arg_z))
     442  (check-nargs 2)
     443  (save-simple-frame)
     444  (ud2a)
     445  (:byte 10)
     446  (push (% arg_z))
     447  (push (% allocptr))
     448  (set-nargs 2)
     449  (jmp-subprim .SPnvalret))
     450
    442451 
    443452
  • trunk/source/lisp-kernel/x86-exceptions.c

    r11508 r11521  
    418418
    419419#ifdef X8664
    420   if (fulltag_of(f) == fulltag_function) {
    421 #else
    422   if (fulltag_of(f) == fulltag_misc &&
    423       header_subtag(header_of(f)) == subtag_function) {
    424 #endif
    425     nominal_function = f;
    426   } else {
    427     if (tra_f) {
    428       nominal_function = tra_f;
    429     }
    430   }
     420  if (fulltag_of(f) == fulltag_function)
     421#else
     422    if (fulltag_of(f) == fulltag_misc &&
     423        header_subtag(header_of(f)) == subtag_function)
     424#endif
     425      {
     426        nominal_function = f;
     427      } else {
     428      if (tra_f) {
     429        nominal_function = tra_f;
     430      }
     431    }
    431432 
    432433  f = xpGPR(xp,Ifn);
     
    475476#endif
    476477
     478void
     479lisp_allocation_failure(ExceptionInformation *xp, TCR *tcr, natural bytes_needed )
     480{
     481  LispObj xcf = create_exception_callback_frame(xp, tcr),
     482    cmain = nrs_CMAIN.vcell;
     483  int skip;
     484   
     485  tcr->save_allocptr = tcr->save_allocbase = (void *)VOID_ALLOCPTR;
     486  xpGPR(xp,Iallocptr) = VOID_ALLOCPTR;
     487
     488  skip = callback_to_lisp(tcr, cmain, xp, xcf, -1, XMEMFULL, 0, 0);
     489  xpPC(xp) += skip;
     490}
     491
     492/*
     493  Allocate a large list, where "large" means "large enough to
     494  possibly trigger the EGC several times if this was done
     495  by individually allocating each CONS."  The number of
     496  ocnses in question is in arg_z; on successful return,
     497  the list will be in arg_z
     498*/
     499
     500Boolean
     501allocate_list(ExceptionInformation *xp, TCR *tcr)
     502{
     503  natural
     504    nconses = (unbox_fixnum(xpGPR(xp,Iarg_z))),
     505    bytes_needed = (nconses << dnode_shift);
     506  LispObj
     507    prev = lisp_nil,
     508    current,
     509    initial = xpGPR(xp,Iarg_y);
     510
     511  if (nconses == 0) {
     512    /* Silly case */
     513    xpGPR(xp,Iarg_z) = lisp_nil;
     514    xpGPR(xp,Iallocptr) = lisp_nil;
     515    return true;
     516  }
     517  update_bytes_allocated(tcr, (void *)(void *) tcr->save_allocptr);
     518  if (allocate_object(xp,bytes_needed,bytes_needed-fulltag_cons,tcr)) {
     519    tcr->save_allocptr -= fulltag_cons;
     520    for (current = xpGPR(xp,Iallocptr);
     521         nconses;
     522         prev = current, current+= dnode_size, nconses--) {
     523      deref(current,0) = prev;
     524      deref(current,1) = initial;
     525    }
     526    xpGPR(xp,Iarg_z) = prev;
     527  } else {
     528    lisp_allocation_failure(xp,tcr,bytes_needed);
     529  }
     530  return true;
     531}
     532
    477533Boolean
    478534handle_alloc_trap(ExceptionInformation *xp, TCR *tcr)
     
    500556  }
    501557 
    502   {
    503     LispObj xcf = create_exception_callback_frame(xp, tcr),
    504       cmain = nrs_CMAIN.vcell;
    505     int skip;
    506    
    507     tcr->save_allocptr = tcr->save_allocbase = (void *)VOID_ALLOCPTR;
    508     xpGPR(xp,Iallocptr) = VOID_ALLOCPTR;
    509 
    510     skip = callback_to_lisp(tcr, cmain, xp, xcf, -1, XMEMFULL, 0, 0);
    511     xpPC(xp) += skip;
    512   }
     558  lisp_allocation_failure(xp,tcr,bytes_needed);
    513559
    514560  return true;
     
    10861132      case XUUO_KILL:
    10871133        xpGPR(context,Iimm0) = (LispObj)kill_tcr(target);
     1134        xpPC(context)+=3;
     1135        return true;
     1136
     1137      case XUUO_ALLOCATE_LIST:
     1138        allocate_list(context,tcr);
    10881139        xpPC(context)+=3;
    10891140        return true;
  • trunk/source/lisp-kernel/x86-exceptions.h

    r11372 r11521  
    145145#define XUUO_RESUME_ALL 8
    146146#define XUUO_KILL 9
     147#define XUUO_ALLOCATE_LIST 10
    147148
    148149void
Note: See TracChangeset for help on using the changeset viewer.