Changeset 10389


Ignore:
Timestamp:
Aug 8, 2008, 4:07:32 AM (11 years ago)
Author:
gb
Message:

(Mostly) sync with trunk as of r10388. Differences include:

  • ABI versions in image.h
  • address of NIL/T/lisp globals/nil-relative symbols
  • some options in platform-specific Makefiles.
Location:
branches/working-0711/ccl/lisp-kernel
Files:
26 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lisp-kernel/Threads.h

    r9954 r10389  
    2626#include <errno.h>
    2727#include <limits.h>
     28
     29#ifdef SOLARIS
     30#include <sys/syscall.h>
     31#include <sys/lwp.h>
     32#endif
    2833
    2934#undef USE_MACH_SEMAPHORES
     
    207212
    208213
    209 #ifdef SIGRTMIN
     214#if defined(SIGRTMIN) && !defined(SOLARIS)
    210215#define SIG_SUSPEND_THREAD (SIGRTMIN+6)
    211 #define SIG_RESUME_THREAD (SIG_SUSPEND_THREAD+1)
    212216#else
    213217#define SIG_SUSPEND_THREAD SIGUSR2
  • branches/working-0711/ccl/lisp-kernel/area.h

    r9955 r10389  
    161161#endif
    162162#ifdef SOLARIS
    163 #define IMAGE_BASE_ADDRESS 0xfffffc7fff000000L
     163#define IMAGE_BASE_ADDRESS 0x300000000000L
    164164#endif
    165165#ifdef DARWIN
    166166#ifdef X8664
    167167#define IMAGE_BASE_ADDRESS 0x300000000000L
     168#else
     169#define IMAGE_BASE_ADDRESS 0x04000000
    168170#endif
    169171#endif
  • branches/working-0711/ccl/lisp-kernel/bits.h

    r9956 r10389  
    125125  register natural _sp __asm__("%rsp");
    126126#endif
     127#ifdef X8632
     128  register natural _sp __asm__("%esp");
     129#endif
    127130  return _sp;
    128131}
  • branches/working-0711/ccl/lisp-kernel/gc-common.c

    r9958 r10389  
    603603  xp = tcr->gc_context;
    604604  if (xp) {
     605#ifndef X8632
    605606    mark_xp(xp);
    606   }
     607#else
     608    mark_xp(xp, tcr->node_regs_mask);
     609#endif
     610  }
     611#ifdef X8632
     612  mark_root(tcr->save0);
     613  mark_root(tcr->save1);
     614  mark_root(tcr->save2);
     615  mark_root(tcr->save3);
     616  mark_root(tcr->next_method_context);
     617#endif
    607618 
    608619  for (xframes = (xframe_list *) tcr->xframe;
    609620       xframes;
    610621       xframes = xframes->prev) {
     622#ifndef X8632
    611623      mark_xp(xframes->curr);
     624#else
     625      mark_xp(xframes->curr, xframes->node_regs_mask);
     626#endif
    612627  }
    613628}
     
    886901        *p = new;
    887902        if (memo_dnode < hash_dnode_limit) {
     903          /* If this code is reached, 'hashp' is non-NULL and pointing
     904             at the header of a hash_table_vector, and 'memo_dnode' identifies
     905             a pair of words inside the hash_table_vector.  It may be
     906             hard for program analysis tools to recognize that, but I
     907             believe that warnings about 'hashp' being NULL here can
     908             be safely ignored. */
    888909          hashp->flags |= nhash_key_moved_mask;
    889910          hash_dnode_limit = 0;
  • branches/working-0711/ccl/lisp-kernel/gc.h

    r9959 r10389  
    5050                                       (1<<fulltag_function)))
    5151#else
     52#define is_node_fulltag(f)  ((1<<(f))&((1<<fulltag_cons) | \
     53                                       (1<<fulltag_misc) | \
     54                                       (1<<fulltag_tra)))
    5255#endif
    5356#endif
     
    100103#define gc_dynamic_area_dnode(w) area_dnode(w,GCareadynamiclow)
    101104
    102 #ifdef PPC64
     105#if defined(PPC64) || defined(X8632)
    103106#define forward_marker subtag_forward_marker
    104107#else
     
    198201void mark_root(LispObj);
    199202void rmark(LispObj);
     203#ifdef X8632
     204void mark_xp(ExceptionInformation *, natural);
     205#else
    200206void mark_xp(ExceptionInformation *);
     207#endif
    201208LispObj dnode_forwarding_address(natural, int);
    202209LispObj locative_forwarding_address(LispObj);
  • branches/working-0711/ccl/lisp-kernel/image.c

    r9960 r10389  
    2929
    3030
    31 #ifdef PPC64
     31#if defined(PPC64) || defined(X8632)
    3232#define RELOCATABLE_FULLTAG_MASK \
    3333  ((1<<fulltag_cons)|(1<<fulltag_misc))
     
    291291#endif
    292292#endif
     293#ifdef X86
    293294#ifdef X8664
    294295        image_nil = (LispObj)(a->low) + (1024*4) + fulltag_nil;
     296#else
     297        image_nil = (LispObj)(a->low) + (1024*4) + fulltag_cons;
     298#endif
    295299#endif
    296300        set_nil(image_nil);
  • branches/working-0711/ccl/lisp-kernel/lisp-debug.c

    r9962 r10389  
    8181  if (dladdr((void *)addr, &info)) {
    8282    ret = (char *)info.dli_sname;
    83     *delta = ((natural)addr - (natural)info.dli_saddr);
     83    if (delta) {
     84      *delta = ((natural)addr - (natural)info.dli_saddr);
     85    }
    8486  }
    8587#endif
     
    147149#endif
    148150
     151#ifdef X8632
     152#ifdef DARWIN
     153char *Iregnames[] = {"eax", "ebx", "ecx", "edx", "edi", "esi",
     154                     "ebp", "???", "efl", "eip"};
     155#endif
     156#endif
     157
     158#ifdef X8632
     159int bit_for_regnum(int r)
     160{
     161  switch (r) {
     162  case REG_EAX: return 1<<0;
     163  case REG_ECX: return 1<<1;
     164  case REG_EDX: return 1<<2;
     165  case REG_EBX: return 1<<3;
     166  case REG_ESP: return 1<<4;
     167  case REG_EBP: return 1<<5;
     168  case REG_ESI: return 1<<6;
     169  case REG_EDI: return 1<<7;
     170  }
     171}
     172#endif
     173
    149174void
    150175show_lisp_register(ExceptionInformation *xp, char *label, int r)
     
    156181  fprintf(stderr, "r%02d (%s) = %s\n", r, label, print_lisp_object(val));
    157182#endif
    158 #ifdef X86
     183#ifdef X8664
    159184  fprintf(stderr, "%%%s (%s) = %s\n",Iregnames[r], label, print_lisp_object(val));
     185#endif
     186#ifdef X8632
     187  {
     188    TCR *tcr = get_tcr(false);
     189    char *s;
     190
     191    if (r == REG_EDX && (xpGPR(xp, REG_EFL) & EFL_DF))
     192      s = "marked as unboxed (DF set)";
     193    else if (tcr && (tcr->node_regs_mask & bit_for_regnum(r)) == 0)
     194      s = "marked as unboxed (node_regs_mask)";
     195    else
     196      s = print_lisp_object(val);
     197
     198    fprintf(stderr, "%%%s (%s) = %s\n", Iregnames[r], label, s);
     199  }
    160200#endif
    161201
     
    432472#endif
    433473  }
     474
     475#ifdef X8632
     476  show_lisp_register(xp, "arg_z", Iarg_z);
     477  show_lisp_register(xp, "arg_y", Iarg_y);
     478  fprintf(stderr,"------\n");
     479  show_lisp_register(xp, "fn", Ifn);
     480  fprintf(stderr,"------\n");
     481  show_lisp_register(xp, "temp0", Itemp0);
     482  show_lisp_register(xp, "temp1", Itemp1);
     483  fprintf(stderr,"------\n");
     484  if (tag_of(xpGPR(xp,Inargs)) == tag_fixnum) {
     485    fprintf(stderr,"%%edx (nargs) = %d (maybe)\n", unbox_fixnum(xpGPR(xp,Inargs)));
     486  }
     487#endif
     488 
    434489  return debug_continue;
    435490}
     
    630685          xpGPR(xp, Iip), xpGPR(xp, Iflags));
    631686#endif
     687
     688#ifdef X8632
     689  fprintf(stderr, "%%eax = 0x%08X\n", xpGPR(xp, REG_EAX));
     690  fprintf(stderr, "%%ecx = 0x%08X\n", xpGPR(xp, REG_ECX));
     691  fprintf(stderr, "%%edx = 0x%08X\n", xpGPR(xp, REG_EDX));
     692  fprintf(stderr, "%%ebx = 0x%08X\n", xpGPR(xp, REG_EBX));
     693  fprintf(stderr, "%%esp = 0x%08X\n", xpGPR(xp, REG_ESP));
     694  fprintf(stderr, "%%ebp = 0x%08X\n", xpGPR(xp, REG_EBP));
     695  fprintf(stderr, "%%esi = 0x%08X\n", xpGPR(xp, REG_ESI));
     696  fprintf(stderr, "%%edi = 0x%08X\n", xpGPR(xp, REG_EDI));
     697  fprintf(stderr, "%%eip = 0x%08X\n", xpGPR(xp, REG_EIP));
     698  fprintf(stderr, "%%eflags = 0x%08X\n", xpGPR(xp, REG_EFL));
     699#endif
     700
    632701  return debug_continue;
    633702}
     
    666735  struct xmmacc *xmmp = xpXMMregs(xp);
    667736#endif
     737#ifdef SOLARIS
     738  upad128_t *xmmp = xpXMMregs(xp);
     739#endif
    668740  float *sp;
    669741
     
    685757          (((struct savefpu *)(&(xp)->uc_mcontext.mc_fpstate))->sv_env.en_mxcsr)
    686758#endif
     759#ifdef SOLARIS
     760          xp->uc_mcontext.fpregs.fp_reg_set.fpchip_state.xstatus
     761#endif
    687762#ifdef WINDOWS
    688763          0 /* XXX: get from somewhere */
     
    690765          );
    691766#endif 
     767#ifdef X8632
     768#ifdef DARWIN
     769  struct xmm {
     770    char fpdata[8];
     771  };
     772  struct xmm *xmmp = (struct xmm *)(xpFPRvector(xp));
     773
     774  for (i = 0; i < 8; i++, xmmp++) {
     775    float *sp = (float *)xmmp;
     776    dp = (double *)xmmp;
     777    np = (int *)xmmp;
     778    fprintf(stderr, "f%1d: 0x%08x (%e), 0x%08x%08x (%e)\n", i, *np,
     779            (double)(*sp), np[1], np[0], *dp);
     780  }
     781  fprintf(stderr, "mxcsr = 0x%08x\n", UC_MCONTEXT(xp)->__fs.__fpu_mxcsr);
     782#endif
     783#endif
     784
    692785  return debug_continue;
    693786}
     
    9361029    abort();
    9371030  }
     1031#ifdef DARWIN
     1032#ifdef X8664
     1033  if (xp) {
     1034    extern void *_sigtramp();
     1035    extern int os_major_version;
     1036
     1037    if (xpPC(xp) == (natural)_sigtramp) {
     1038      xp = (ExceptionInformation *) xpGPR(xp, REG_R8);
     1039      fprintf(stderr, "Exception raised at _sigtramp; using context passed to _sigtramp.  Raw register values (R) may be more interesting then lisp values or lisp backtrace\n");
     1040    }
     1041  }
     1042#endif
     1043#endif
     1044
     1045
    9381046  if (xp) {
    9391047    if (why > debug_entry_exception) {
  • branches/working-0711/ccl/lisp-kernel/lisp-exceptions.h

    r9964 r10389  
    140140exception_fn_name( ExceptionInformation *, int, char *, size_t );
    141141
    142 /* Need to define this here */
    143 #ifdef DARWIN
    144 #define USE_MACH_EXCEPTION_LOCK 0
    145 #endif
    146142
    147143
  • branches/working-0711/ccl/lisp-kernel/lisp_globals.h

    r9966 r10389  
    8787#endif
    8888
     89#ifdef X8632
     90#define lisp_global(g) (((LispObj *) 0x13000)[(g)])
     91#define nrs_symbol(s) (((lispsymbol *) 0x13008)[(s)])
     92#endif
    8993
    9094#define nrs_T                           (nrs_symbol(0))         /* t */
  • branches/working-0711/ccl/lisp-kernel/lisptypes.h

    r9967 r10389  
    139139#endif /* _STRUCT_MCONTEXT64 */
    140140#endif /* X86_64 */
     141
     142#ifdef X8632
     143/* Assume rational <i386/ucontext.h> */
     144#define UC_MCONTEXT(UC) UC->uc_mcontext
     145typedef mcontext_t MCONTEXT_T;
     146typedef ucontext_t ExceptionInformation;
     147#endif
     148
    141149#endif /* #ifdef DARWIN */
    142150
  • branches/working-0711/ccl/lisp-kernel/macros.h

    r9969 r10389  
    7272
    7373#define immheader_tag_p(tag) ((1<<(tag)) & IMMHEADER_MASK)
     74#else
     75#define nodeheader_tag_p(tag) (tag == fulltag_nodeheader)
     76#define immheader_tag_p(tag) (tag == fulltag_immheader)
    7477#endif
    7578#endif
  • branches/working-0711/ccl/lisp-kernel/pmcl-kernel.c

    r9974 r10389  
    9393Boolean running_under_rosetta = false;
    9494
    95 #if WORD_SIZE == 64
     95#if WORD_SIZE == 64 || defined(X8632)
    9696/* Assume that if the OS is new enough to support PPC64/X8664, it has
    9797   a reasonable dlfcn.h
     
    351351#endif
    352352#ifdef SOLARIS
    353 #define MAXIMUM_MAPPABLE_MEMORY (1024L<<30L)
     353#define MAXIMUM_MAPPABLE_MEMORY (128L<<30L)
    354354#endif
    355355#ifdef LINUX
     
    681681  fixed_map_ok = true;
    682682#endif
    683   raise_limit();
     683  raise_limit();                /* From Andi Kleen: observe rlimits */
    684684  start = mmap((void *)want,
    685685               totalsize + heap_segment_size,
     
    17611761xGetSharedLibrary(char *path, int *resultType)
    17621762{
    1763 #if WORD_SIZE == 32
     1763#if defined(PPC) && (WORD_SIZE == 32)
    17641764  NSObjectFileImageReturnCode code;
    17651765  NSObjectFileImage              moduleImage;
     
    19591959xFindSymbol(void* handle, char *name)
    19601960{
    1961 #if defined(LINUX) || defined(FREEBSD)
     1961#if defined(LINUX) || defined(FREEBSD) || defined(SOLARIS)
    19621962  return dlsym(handle, name);
    19631963#endif
    19641964#ifdef DARWIN
    1965 #if defined(PPC64) || defined(X8664)
    1966   if (handle == NULL) {
     1965#if defined(PPC64) || defined(X86)
     1966  if ((handle == NULL) || (handle == ((void *) -1))) {
    19671967    handle = RTLD_DEFAULT;
    19681968  }   
     
    19741974  natural address = 0;
    19751975
    1976   if (handle == NULL) {
     1976  if ((handle == NULL) ||
     1977      (handle == (void *)-1) ||
     1978      (handle == (void *)-2)){
    19771979    if (NSIsSymbolNameDefined(name)) { /* Keep dyld_lookup from crashing */
    19781980      _dyld_lookup_and_bind(name, (void *) &address, (void*) NULL);
     
    19881990get_r_debug()
    19891991{
    1990 #if defined(LINUX) || defined(FREEBSD)
     1992#if defined(LINUX) || defined(FREEBSD) || defined(SOLARIS)
    19911993#if WORD_SIZE == 64
    19921994  extern Elf64_Dyn _DYNAMIC[];
  • branches/working-0711/ccl/lisp-kernel/ppc-constants32.h

    r9976 r10389  
    333333  LispObj cache_key;            /* value of last cached key */
    334334  LispObj cache_value;          /* last cached value */
    335 #ifdef NOTYET
    336335  LispObj size;                 /* number of entries in table */
    337336  LispObj size_reciprocal;      /* shifted reciprocal of size */
    338 #endif
    339337} hash_table_vector_header;
    340338
  • branches/working-0711/ccl/lisp-kernel/ppc-constants64.h

    r9977 r10389  
    312312  LispObj cache_key;            /* value of last cached key */
    313313  LispObj cache_value;          /* last cached value */
    314 #ifdef NOTYET
    315314  LispObj size;                 /* number of entries in table */
    316315  LispObj size_reciprocal;      /* shifted reciprocal of size */
    317 #endif
    318316} hash_table_vector_header;
    319317
  • branches/working-0711/ccl/lisp-kernel/ppc-exceptions.c

    r9978 r10389  
    22672267
    22682268
    2269 #if USE_MACH_EXCEPTION_LOCK
    2270 pthread_mutex_t _mach_exception_lock, *mach_exception_lock;
    2271 #endif
    22722269
    22732270#define LISP_EXCEPTIONS_HANDLED_MASK \
     
    26932690#endif
    26942691
    2695   if (
    2696 #if USE_MACH_EXCEPTION_LOCK
    2697     pthread_mutex_trylock(mach_exception_lock) == 0
    2698 #else
    2699     1
    2700 #endif
    2701     ) {
    2702     if (tcr->flags & (1<<TCR_FLAG_BIT_PENDING_EXCEPTION)) {
    2703       CLR_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_EXCEPTION);
    2704     }
    2705     if ((exception == EXC_BAD_INSTRUCTION) &&
    2706         (code_vector[0] == EXC_PPC_UNIPL_INST) &&
    2707         (((code1 = code_vector[1]) == (int)pseudo_sigreturn) ||
    2708          (code1 == (int)enable_fp_exceptions) ||
    2709          (code1 == (int)disable_fp_exceptions))) {
    2710       if (code1 == (int)pseudo_sigreturn) {
    2711         kret = do_pseudo_sigreturn(thread, tcr);
     2692  if (tcr->flags & (1<<TCR_FLAG_BIT_PENDING_EXCEPTION)) {
     2693    CLR_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_EXCEPTION);
     2694  }
     2695  if ((exception == EXC_BAD_INSTRUCTION) &&
     2696      (code_vector[0] == EXC_PPC_UNIPL_INST) &&
     2697      (((code1 = code_vector[1]) == (int)pseudo_sigreturn) ||
     2698       (code1 == (int)enable_fp_exceptions) ||
     2699       (code1 == (int)disable_fp_exceptions))) {
     2700    if (code1 == (int)pseudo_sigreturn) {
     2701      kret = do_pseudo_sigreturn(thread, tcr);
    27122702#if 0
    27132703      fprintf(stderr, "Exception return in 0x%x\n",tcr);
    27142704#endif
    27152705       
    2716       } else if (code1 == (int)enable_fp_exceptions) {
    2717         kret = thread_set_fp_exceptions_enabled(thread, true);
    2718       } else kret =  thread_set_fp_exceptions_enabled(thread, false);
    2719     } else if (tcr->flags & (1<<TCR_FLAG_BIT_PROPAGATE_EXCEPTION)) {
    2720       CLR_TCR_FLAG(tcr,TCR_FLAG_BIT_PROPAGATE_EXCEPTION);
    2721       kret = 17;
    2722     } else {
    2723       switch (exception) {
    2724       case EXC_BAD_ACCESS:
    2725         signum = SIGSEGV;
    2726         break;
     2706    } else if (code1 == (int)enable_fp_exceptions) {
     2707      kret = thread_set_fp_exceptions_enabled(thread, true);
     2708    } else kret =  thread_set_fp_exceptions_enabled(thread, false);
     2709  } else if (tcr->flags & (1<<TCR_FLAG_BIT_PROPAGATE_EXCEPTION)) {
     2710    CLR_TCR_FLAG(tcr,TCR_FLAG_BIT_PROPAGATE_EXCEPTION);
     2711    kret = 17;
     2712  } else {
     2713    switch (exception) {
     2714    case EXC_BAD_ACCESS:
     2715      signum = SIGSEGV;
     2716      break;
    27272717       
    2728       case EXC_BAD_INSTRUCTION:
    2729         signum = SIGILL;
    2730         break;
     2718    case EXC_BAD_INSTRUCTION:
     2719      signum = SIGILL;
     2720      break;
    27312721     
    2732       case EXC_SOFTWARE:
    2733         if (code == EXC_PPC_TRAP) {
    2734           signum = SIGTRAP;
    2735         }
    2736         break;
     2722    case EXC_SOFTWARE:
     2723      if (code == EXC_PPC_TRAP) {
     2724        signum = SIGTRAP;
     2725      }
     2726      break;
    27372727     
    2738       case EXC_ARITHMETIC:
    2739         signum = SIGFPE;
    2740         break;
    2741 
    2742       default:
    2743         break;
    2744       }
    2745       if (signum) {
    2746         kret = setup_signal_frame(thread,
    2747                                   (void *)pseudo_signal_handler,
    2748                                   signum,
    2749                                   code,
    2750                                   tcr);
     2728    case EXC_ARITHMETIC:
     2729      signum = SIGFPE;
     2730      break;
     2731
     2732    default:
     2733      break;
     2734    }
     2735    if (signum) {
     2736      kret = setup_signal_frame(thread,
     2737                                (void *)pseudo_signal_handler,
     2738                                signum,
     2739                                code,
     2740                                tcr);
    27512741#if 0
    27522742      fprintf(stderr, "Setup pseudosignal handling in 0x%x\n",tcr);
    27532743#endif
    27542744
    2755       } else {
    2756         kret = 17;
    2757       }
    2758     }
    2759 #if USE_MACH_EXCEPTION_LOCK
    2760 #ifdef DEBUG_MACH_EXCEPTIONS
    2761     fprintf(stderr, "releasing Mach exception lock in exception thread\n");
    2762 #endif
    2763     pthread_mutex_unlock(mach_exception_lock);
    2764 #endif
    2765   } else {
    2766     SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_EXCEPTION);
    2767 #if 0
    2768     fprintf(stderr, "deferring pending exception in 0x%x\n", tcr);
    2769 #endif
    2770     kret = 0;
    2771     if (tcr == gc_tcr) {
    2772       int i;
    2773       write(1, "exception in GC thread. Sleeping for 60 seconds\n",sizeof("exception in GC thread.  Sleeping for 60 seconds\n"));
    2774       for (i = 0; i < 60; i++) {
    2775         sleep(1);
    2776       }
    2777       _exit(EX_SOFTWARE);
    2778     }
    2779   }
     2745    } else {
     2746      kret = 17;
     2747    }
     2748  }
     2749
    27802750  return kret;
    27812751}
     
    28542824  kern_return_t kret; 
    28552825  if (__exception_port_set == MACH_PORT_NULL) {
    2856 #if USE_MACH_EXCEPTION_LOCK
    2857     mach_exception_lock = &_mach_exception_lock;
    2858     pthread_mutex_init(mach_exception_lock, NULL);
    2859 #endif
    28602826    kret = mach_port_allocate(mach_task_self(),
    28612827                              MACH_PORT_RIGHT_PORT_SET,
     
    31313097
    31323098  LOCK(lisp_global(TCR_AREA_LOCK), current);
    3133 #if USE_MACH_EXCEPTION_LOCK
    3134   pthread_mutex_lock(mach_exception_lock);
    3135 #endif
    31363099
    31373100  if (suspend_mach_thread(mach_thread)) {
     
    31613124   
    31623125  }
    3163 #if USE_MACH_EXCEPTION_LOCK
    3164   pthread_mutex_unlock(mach_exception_lock);
    3165 #endif
    31663126  UNLOCK(lisp_global(TCR_AREA_LOCK), current);
    31673127  return 0;
  • branches/working-0711/ccl/lisp-kernel/ppc-exceptions.h

    r9979 r10389  
    388388#include <mach/machine/thread_status.h>
    389389
    390 #if USE_MACH_EXCEPTION_LOCK
    391 pthread_mutex_t *mach_exception_lock;
    392 #endif
    393390#endif
    394391
  • branches/working-0711/ccl/lisp-kernel/ppc-gc.c

    r9980 r10389  
    392392      opcode *program_counter;
    393393
    394       for(program_counter=(opcode *)ptr_from_lispobj(xpc & ~4);
    395           dnode < GCndnodes_in_area;
    396           program_counter-=2, --dnode) {
     394      for(program_counter=(opcode *)ptr_from_lispobj(xpc & ~7);
     395          (LispObj)program_counter >= GCarealow;
     396          program_counter-=2) {
    397397        if (*program_counter == PPC64_CODE_VECTOR_PREFIX) {
    398398          headerP = ((LispObj *)program_counter)-1;
    399399          header = *headerP;
    400           set_n_bits(GCmarkbits, dnode, (2+header_element_count(header))>>1);
     400          dnode = gc_area_dnode(headerP);
     401          set_n_bits(GCmarkbits, dnode, (8+(header_element_count(header)<<2)+(dnode_size-1))>>dnode_shift);
    401402          return;
    402403        }
  • branches/working-0711/ccl/lisp-kernel/thread_manager.c

    r10179 r10389  
    1818#include "Threads.h"
    1919
    20 /*
    21    If we suspend via signals - and if the "suspend" signal is maked
    22    in the handler for that signal - then it's not possible to suspend
    23    a thread that's still waiting to be resumed (which is what
    24    WAIT_FOR_RESUME_ACK is all about.)
    25 */
    26 #define WAIT_FOR_RESUME_ACK 0
    27 #define RESUME_VIA_RESUME_SEMAPHORE 1
    28 #define SUSPEND_RESUME_VERBOSE 0
    2920
    3021typedef struct {
     
    427418}
    428419 
    429   void
     420void
    430421suspend_resume_handler(int signo, siginfo_t *info, ExceptionInformation *context)
    431422{
     
    438429    SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_SUSPEND);
    439430  } else {
    440     if (signo == thread_suspend_signal) {
    441 #if 0
    442       sigset_t wait_for;
    443 #endif
    444 
    445       tcr->suspend_context = context;
    446 #if 0
    447       sigfillset(&wait_for);
    448 #endif
    449       SEM_RAISE(tcr->suspend);
    450 #if 0
    451       sigdelset(&wait_for, thread_resume_signal);
    452 #endif
    453 #if 1
    454 #if RESUME_VIA_RESUME_SEMAPHORE
    455       SEM_WAIT_FOREVER(tcr->resume);
    456 #if SUSPEND_RESUME_VERBOSE
    457       fprintf(stderr, "got  resume in 0x%x\n",tcr);
    458 #endif
    459       tcr->suspend_context = NULL;
    460 #else
    461       sigsuspend(&wait_for);
    462 #endif
    463 #else
    464     do {
    465       sigsuspend(&wait_for);
    466     } while (tcr->suspend_context);
    467 #endif 
    468     } else {
    469       tcr->suspend_context = NULL;
    470 #if SUSEPEND_RESUME_VERBOSE
    471       fprintf(stderr,"got  resume in in 0x%x\n",tcr);
    472 #endif
    473     }
    474 #if WAIT_FOR_RESUME_ACK
     431    tcr->suspend_context = context;
    475432    SEM_RAISE(tcr->suspend);
    476 #endif
     433    SEM_WAIT_FOREVER(tcr->resume);
     434    tcr->suspend_context = NULL;
    477435  }
    478436#ifdef DARWIN_GS_HACK
     
    530488  *size = temp_size;
    531489#endif
    532 
     490#ifdef SOLARIS
     491  stack_t st;
     492 
     493  thr_stksegment(&st);
     494  *size = st.ss_size;
     495  *base = st.ss_sp;
     496 
     497#endif
    533498}
    534499#endif
     
    718683  /* darwin_set_x8664_fs_reg(tcr); */
    719684#endif
    720 }
    721 
    722 #endif
    723 
    724 
     685#ifdef SOLARIS
     686  /* Chris Curtis found this and suggested the use of syscall here */
     687  syscall(SYS_lwp_private,_LWP_SETPRIVATE, _LWP_GSBASE, tcr);
     688#endif
     689}
     690
     691#endif
     692
     693#ifdef X8632
     694#ifdef DARWIN
     695#include <architecture/i386/table.h>
     696#include <architecture/i386/sel.h>
     697#include <i386/user_ldt.h>
     698
     699void setup_tcr_extra_segment(TCR *tcr)
     700{
     701    uintptr_t addr = (uintptr_t)tcr;
     702    unsigned int size = sizeof(*tcr);
     703    ldt_entry_t desc;
     704    sel_t sel;
     705    int i;
     706
     707    desc.data.limit00 = (size - 1) & 0xffff;
     708    desc.data.limit16 = ((size - 1) >> 16) & 0xf;
     709    desc.data.base00 = addr & 0xffff;
     710    desc.data.base16 = (addr >> 16) & 0xff;
     711    desc.data.base24 = (addr >> 24) & 0xff;
     712    desc.data.type = DESC_DATA_WRITE;
     713    desc.data.dpl = USER_PRIV;
     714    desc.data.present = 1;
     715    desc.data.stksz = DESC_CODE_32B;
     716    desc.data.granular = DESC_GRAN_BYTE;
     717   
     718    i = i386_set_ldt(LDT_AUTO_ALLOC, &desc, 1);
     719
     720    if (i < 0) {
     721        perror("i386_set_ldt");
     722    } else {
     723        sel.index = i;
     724        sel.rpl = USER_PRIV;
     725        sel.ti = SEL_LDT;
     726        tcr->ldt_selector = sel;
     727    }
     728}
     729
     730void free_tcr_extra_segment(TCR *tcr)
     731{
     732  /* load %fs with null segement selector */
     733  __asm__ volatile ("mov %0,%%fs" : : "r"(0));
     734  if (i386_set_ldt(tcr->ldt_selector.index, NULL, 1) < 0)
     735    perror("i386_set_ldt");
     736  tcr->ldt_selector = NULL_SEL;
     737}
     738#endif
     739#endif
    725740
    726741/*
     
    747762#ifdef HAVE_TLS
    748763  TCR *tcr = &current_tcr;
    749 #else
     764#else /* no TLS */
    750765  TCR *tcr = allocate_tcr();
    751 #endif
    752 
    753 #ifdef X8664
     766#ifdef X8632
     767  setup_tcr_extra_segment(tcr);
     768#endif
     769#endif
     770
     771#ifdef X86
    754772  setup_tcr_extra_segment(tcr);
    755773  tcr->linear = tcr;
     774#ifdef X8632
     775  tcr->node_regs_mask = X8632_DEFAULT_NODE_REGS_MASK;
     776#endif
    756777#endif
    757778
     
    853874    dequeue_tcr(tcr);
    854875#endif
     876#ifdef DARWIN
     877#ifdef X8632
     878    free_tcr_extra_segment(tcr);
     879#endif
     880#endif
    855881    UNLOCK(lisp_global(TCR_AREA_LOCK),tcr);
    856882    if (termination_semaphore) {
     
    12541280#define NSAVEREGS 4
    12551281#endif
     1282#ifdef X8632
     1283#define NSAVEREGS 0
     1284#endif
    12561285    for (i = 0; i < NSAVEREGS; i++) {
    12571286      *(--current->save_vsp) = 0;
     
    12831312  pthread_t thread;
    12841313  if (suspend_count == 1) {
    1285 #if SUSPEND_RESUME_VERBOSE
    1286     fprintf(stderr,"Suspending 0x%x\n", tcr);
    1287 #endif
    1288 #ifdef DARWIN_nope
    1289     if (mach_suspend_tcr(tcr)) {
    1290       SET_TCR_FLAG(tcr,TCR_FLAG_BIT_ALT_SUSPEND);
    1291       return true;
    1292     }
    1293 #endif
    12941314    thread = (pthread_t)(tcr->osid);
    12951315    if ((thread != (pthread_t) 0) &&
     
    13181338    SEM_WAIT_FOREVER(tcr->suspend);
    13191339    tcr->flags &= ~(1<<TCR_FLAG_BIT_SUSPEND_ACK_PENDING);
    1320 #if SUSPEND_RESUME_VERBOSE
    1321     fprintf(stderr,"Suspend ack from 0x%x\n", tcr);
    1322 #endif
    1323 
    13241340  }
    13251341  return true;
     
    13361352 
    13371353  LOCK(lisp_global(TCR_AREA_LOCK),current);
    1338 #ifdef DARWIN
    1339 #if USE_MACH_EXCEPTION_LOCK
    1340   if (use_mach_exception_handling) {
    1341     pthread_mutex_lock(mach_exception_lock);
    1342   }
    1343 #endif
    1344 #endif
    13451354  suspended = suspend_tcr(tcr);
    13461355  if (suspended) {
    13471356    while (!tcr_suspend_ack(tcr));
    13481357  }
    1349 #ifdef DARWIN
    1350 #if USE_MACH_EXCEPTION_LOCK
    1351   if (use_mach_exception_handling) {
    1352     pthread_mutex_unlock(mach_exception_lock);
    1353   }
    1354 #endif
    1355 #endif
    13561358  UNLOCK(lisp_global(TCR_AREA_LOCK),current);
    13571359  return suspended;
     
    13641366  int suspend_count = atomic_decf(&(tcr->suspend_count));
    13651367  if (suspend_count == 0) {
    1366 #ifdef DARWIN
    1367     if (tcr->flags & (1<<TCR_FLAG_BIT_ALT_SUSPEND)) {
    1368 #if SUSPEND_RESUME_VERBOSE
    1369     fprintf(stderr,"Mach resume to 0x%x\n", tcr);
    1370 #endif
    1371       mach_resume_tcr(tcr);
     1368    void *s = (tcr->resume);
     1369    if (s != NULL) {
     1370      SEM_RAISE(s);
    13721371      return true;
    13731372    }
    1374 #endif
    1375 #if RESUME_VIA_RESUME_SEMAPHORE
    1376     SEM_RAISE(tcr->resume);
    1377 #else
    1378     if ((err = (pthread_kill((pthread_t)(tcr->osid), thread_resume_signal))) != 0) {
    1379       Bug(NULL, "pthread_kill returned %d on thread #x%x", err, tcr->osid);
    1380     }
    1381 #endif
    1382 #if SUSPEND_RESUME_VERBOSE
    1383     fprintf(stderr, "Sent resume to 0x%x\n", tcr);
    1384 #endif
    1385     return true;
    13861373  }
    13871374  return false;
    13881375}
    13891376
    1390 void
    1391 wait_for_resumption(TCR *tcr)
    1392 {
    1393   if (tcr->suspend_count == 0) {
    1394 #ifdef DARWIN
    1395     if (tcr->flags & (1<<TCR_FLAG_BIT_ALT_SUSPEND)) {
    1396       tcr->flags &= ~(1<<TCR_FLAG_BIT_ALT_SUSPEND);
    1397       return;
    1398   }
    1399 #endif
    1400 #if WAIT_FOR_RESUME_ACK
    1401 #if SUSPEND_RESUME_VERBOSE
    1402     fprintf(stderr, "waiting for resume in 0x%x\n",tcr);
    1403 #endif
    1404     SEM_WAIT_FOREVER(tcr->suspend);
    1405 #endif
    1406   }
    1407 }
    14081377   
    14091378
     
    14171386  LOCK(lisp_global(TCR_AREA_LOCK),current);
    14181387  resumed = resume_tcr(tcr);
    1419   wait_for_resumption(tcr);
    14201388  UNLOCK(lisp_global(TCR_AREA_LOCK), current);
    14211389  return resumed;
     
    14831451
    14841452  LOCK(lisp_global(TCR_AREA_LOCK), current);
    1485 #ifdef DARWIN
    1486 #if USE_MACH_EXCEPTION_LOCK
    1487   if (for_gc && use_mach_exception_handling) {
    1488 #if SUSPEND_RESUME_VERBOSE
    1489     fprintf(stderr, "obtaining Mach exception lock in GC thread 0x%x\n", current);
    1490 #endif
    1491     pthread_mutex_lock(mach_exception_lock);
    1492   }
    1493 #endif
    1494 #endif
    14951453  for (other = current->next; other != current; other = other->next) {
    14961454    if ((other->osid != 0)) {
     
    15331491lisp_suspend_other_threads()
    15341492{
    1535   TCR *current = get_tcr(true);
    1536   LOCK(lisp_global(TCR_AREA_LOCK),current);
    15371493  suspend_other_threads(false);
    15381494}
     
    15471503    }
    15481504  }
    1549   for (other = current->next; other != current; other = other->next) {
    1550     if ((other->osid != 0)) {
    1551       wait_for_resumption(other);
    1552     }
    1553   }
    15541505  free_freed_tcrs();
    1555 #ifdef DARWIN
    1556 #if USE_MACH_EXCEPTION_LOCK
    1557   if (for_gc && use_mach_exception_handling) {
    1558 #if SUSPEND_RESUME_VERBOSE
    1559     fprintf(stderr, "releasing Mach exception lock in GC thread 0x%x\n", current);
    1560 #endif
    1561     pthread_mutex_unlock(mach_exception_lock);
    1562   }
    1563 #endif
    1564 #endif
    1565 
    15661506  UNLOCK(lisp_global(TCR_AREA_LOCK), current);
    15671507}
     
    15701510lisp_resume_other_threads()
    15711511{
    1572   TCR *current = get_tcr(true);
    15731512  resume_other_threads(false);
    1574   UNLOCK(lisp_global(TCR_AREA_LOCK),current);
    15751513}
    15761514
  • branches/working-0711/ccl/lisp-kernel/x86-constants.s

    r6906 r10389  
    4949])                                             
    5050
    51 /* registers, as used in destrucuring-bind/macro-bind   */
    52 
     51/* registers, as used in destructuring-bind/macro-bind   */
     52ifdef([X8664],[
    5353define([whole_reg],[temp1])
    5454define([arg_reg],[temp0])
    5555define([keyvect_reg],[arg_x])
     56],[
     57define([arg_reg],[temp1])
     58define([arg_reg_b],[temp1_b])
     59define([keyvect_reg],[arg_y])
     60])
     61
    5662define([initopt_bit],[24])
    5763define([keyp_bit],[25]) /*  note that keyp can be true even when 0 keys.   */
  • branches/working-0711/ccl/lisp-kernel/x86-exceptions.c

    r9988 r10389  
    152152handle_gc_trap(ExceptionInformation *xp, TCR *tcr)
    153153{
    154   LispObj
    155     selector = xpGPR(xp,Iimm0),
    156     arg = xpGPR(xp,Iimm1);
     154  LispObj selector = xpGPR(xp,Iimm0);
     155#ifdef X8664
     156  LispObj arg = xpGPR(xp,Iimm1);
     157#else
     158  LispObj arg = xpMMXreg(xp,Imm0);
     159#endif
    157160  area *a = active_dynamic_area;
    158161  Boolean egc_was_enabled = (a->older != NULL);
     
    167170
    168171  case GC_TRAP_FUNCTION_CONFIGURE_EGC:
     172#ifdef X8664
    169173    a->threshold = unbox_fixnum(xpGPR(xp, Iarg_x));
     174#else
     175    a->threshold = unbox_fixnum(xpGPR(xp, Itemp0));
     176#endif
    170177    g1_area->threshold = unbox_fixnum(xpGPR(xp, Iarg_y));
    171178    g2_area->threshold = unbox_fixnum(xpGPR(xp, Iarg_z));
     
    283290finish_function_entry(ExceptionInformation *xp)
    284291{
     292#ifdef X8664
    285293  natural nargs = (xpGPR(xp,Inargs)&0xffff)>> fixnumshift;
    286   signed_natural disp = nargs-3;
     294#else
     295  natural nargs = xpGPR(xp,Inargs)>>fixnumshift;
     296#endif
     297  signed_natural disp;
    287298  LispObj *vsp =  (LispObj *) xpGPR(xp,Isp), ra = *vsp++;
    288299   
    289300  xpGPR(xp,Isp) = (LispObj) vsp;
    290301
     302#ifdef X8664
     303  disp = nargs - 3;
     304#endif
     305#ifdef X8632
     306  disp = nargs - 2;
     307#endif
     308
     309#ifdef X8664
    291310  if (disp > 0) {               /* implies that nargs > 3 */
    292311    vsp[disp] = xpGPR(xp,Irbp);
     
    310329    }
    311330  }
     331#endif
     332#ifdef X8632
     333  if (disp > 0) {               /* implies that nargs > 2 */
     334    vsp[disp] = xpGPR(xp,Iebp);
     335    vsp[disp+1] = ra;
     336    xpGPR(xp,Iebp) = (LispObj)(vsp+disp);
     337    xpGPR(xp,Isp) = (LispObj)vsp;
     338    push_on_lisp_stack(xp,xpGPR(xp,Iarg_y));
     339    push_on_lisp_stack(xp,xpGPR(xp,Iarg_z));
     340  } else {
     341    push_on_lisp_stack(xp,ra);
     342    push_on_lisp_stack(xp,xpGPR(xp,Iebp));
     343    xpGPR(xp,Iebp) = xpGPR(xp,Isp);
     344    if (nargs == 2) {
     345      push_on_lisp_stack(xp,xpGPR(xp,Iarg_y));
     346    }
     347    if (nargs >= 1) {
     348      push_on_lisp_stack(xp,xpGPR(xp,Iarg_z));
     349    }
     350  }
     351#endif
    312352}
    313353
     
    335375  f = xpGPR(xp,Ifn);
    336376  tra = *(LispObj*)(xpGPR(xp,Isp));
     377
     378#ifdef X8664
    337379  if (tag_of(tra) == tag_tra) {
    338380    if ((*((unsigned short *)tra) == RECOVER_FN_FROM_RIP_WORD0) &&
     
    347389    tra = 0;
    348390  }
     391#endif
     392#ifdef X8632
     393  if (fulltag_of(tra) == fulltag_tra) {
     394    if (*(unsigned char *)tra == RECOVER_FN_OPCODE) {
     395      tra_f = (LispObj)*(LispObj *)(tra + 1);
     396    }
     397    if (tra_f && header_subtag(header_of(tra_f)) != subtag_function) {
     398      tra_f = 0;
     399    }
     400  } else {
     401    tra = 0;
     402  }
     403#endif
    349404
    350405  abs_pc = (LispObj)xpPC(xp);
    351406
     407#ifdef X8664
    352408  if (fulltag_of(f) == fulltag_function) {
     409#else
     410  if (fulltag_of(f) == fulltag_misc &&
     411      header_subtag(header_of(f)) == subtag_function) {
     412#endif
    353413    nominal_function = f;
    354414  } else {
     
    389449  push_on_lisp_stack(xp,nominal_function);
    390450  push_on_lisp_stack(xp,0);
     451#ifdef X8664
    391452  push_on_lisp_stack(xp,xpGPR(xp,Irbp));
    392453  xpGPR(xp,Irbp) = xpGPR(xp,Isp);
     454#else
     455  push_on_lisp_stack(xp,xpGPR(xp,Iebp));
     456  xpGPR(xp,Iebp) = xpGPR(xp,Isp);
     457#endif
    393458  return xpGPR(xp,Isp);
    394459}
     
    408473  allocptr_tag = fulltag_of(cur_allocptr);
    409474  if (allocptr_tag == fulltag_misc) {
     475#ifdef X8664
    410476    disp = xpGPR(xp,Iimm1);
     477#else
     478    disp = xpGPR(xp,Iimm0);
     479#endif
    411480  } else {
    412481    disp = dnode_size-fulltag_cons;
     
    442511  int delta;
    443512  unsigned old_mxcsr = get_mxcsr();
     513#ifdef X8632
     514  natural saved_node_regs_mask = tcr->node_regs_mask;
     515  LispObj *vsp = (LispObj *)xpGPR(xp, Isp);
     516#endif
    444517
    445518  set_mxcsr(0x1f80);
    446519
    447520  /* Put the active stack pointers where .SPcallback expects them */
     521#ifdef X8664
    448522  tcr->save_vsp = (LispObj *) xpGPR(xp, Isp);
    449523  tcr->save_rbp = (LispObj *) xpGPR(xp, Irbp);
    450 
     524#else
     525  tcr->node_regs_mask = X8632_DEFAULT_NODE_REGS_MASK;
     526
     527  *--vsp = tcr->save0;
     528  *--vsp = tcr->save1;
     529  *--vsp = tcr->save2;
     530  *--vsp = tcr->save3;
     531  *--vsp = tcr->next_method_context;
     532  xpGPR(xp, Isp) = (LispObj)vsp;
     533
     534  tcr->save_vsp = (LispObj *)xpGPR(xp, Isp);
     535  tcr->save_ebp = (LispObj *)xpGPR(xp, Iebp);
     536#endif
    451537
    452538  /* Call back.  The caller of this function may have modified stack/frame
     
    457543  delta = ((int (*)())callback_ptr) (xp, arg1, arg2, arg3, arg4, arg5);
    458544  LOCK(lisp_global(EXCEPTION_LOCK), tcr);
     545
     546#ifdef X8632
     547  tcr->next_method_context = *vsp++;
     548  tcr->save3 = *vsp++;
     549  tcr->save2 = *vsp++;
     550  tcr->save1 = *vsp++;
     551  tcr->save0 = *vsp++;
     552  xpGPR(xp, Isp) = (LispObj)vsp;
     553
     554  tcr->node_regs_mask = saved_node_regs_mask;
     555#endif
    459556  set_mxcsr(old_mxcsr);
    460557  return delta;
     
    464561callback_for_interrupt(TCR *tcr, ExceptionInformation *xp)
    465562{
    466   LispObj save_rbp = xpGPR(xp,Irbp),
    467     *save_vsp = (LispObj *)xpGPR(xp,Isp),
     563  LispObj *save_vsp = (LispObj *)xpGPR(xp,Isp),
    468564    word_beyond_vsp = save_vsp[-1],
     565#ifdef X8664
     566    save_rbp = xpGPR(xp,Irbp),
     567#else
     568    save_ebp = xpGPR(xp,Iebp),
     569#endif
    469570    xcf = create_exception_callback_frame(xp, tcr);
    470571  int save_errno = errno;
    471  
     572
    472573  callback_to_lisp(tcr, nrs_CMAIN.vcell,xp, xcf, 0, 0, 0, 0);
     574#ifdef X8664
    473575  xpGPR(xp,Irbp) = save_rbp;
     576#else
     577  xpGPR(xp,Iebp) = save_ebp;
     578#endif
    474579  xpGPR(xp,Isp) = (LispObj)save_vsp;
    475580  save_vsp[-1] = word_beyond_vsp;
     
    483588  unsigned char op0 = program_counter[0], op1 = program_counter[1];
    484589  LispObj rpc, errdisp = nrs_ERRDISP.vcell,
    485     save_rbp = xpGPR(xp,Irbp), save_vsp = xpGPR(xp,Isp), xcf0;
     590    save_vsp = xpGPR(xp,Isp), xcf0;
     591#ifdef X8664
     592  LispObj save_rbp = xpGPR(xp,Irbp);
     593#else
     594  LispObj save_ebp = xpGPR(xp,Iebp);
     595#endif
    486596  int skip;
    487597
     
    507617      skip = 0;
    508618    }
     619#ifdef X8664
    509620    xpGPR(xp,Irbp) = save_rbp;
     621#else
     622    xpGPR(xp,Iebp) = save_ebp;
     623#endif
    510624    xpGPR(xp,Isp) = save_vsp;
    511625    if ((op0 == 0xcd) && (op1 == 0xc7)) {
     
    521635      */
    522636      LispObj *vsp =(LispObj *)save_vsp, ra = *vsp;
     637#ifdef X8664
    523638      int nargs = (xpGPR(xp, Inargs) & 0xffff)>>fixnumshift;
    524      
     639#else
     640      int nargs = xpGPR(xp, Inargs)>>fixnumshift;
     641#endif
     642
     643#ifdef X8664
    525644      if (nargs > 3) {
    526645        xpGPR(xp,Isp)=(LispObj) (vsp + (1 + 2 + (nargs - 3)));
    527646        push_on_lisp_stack(xp,ra);
    528647      }
     648#else
     649      if (nargs > 2) {
     650        xpGPR(xp,Isp)=(LispObj) (vsp + (1 + 2 + (nargs - 2)));
     651        push_on_lisp_stack(xp,ra);
     652      }
     653#endif
    529654      xpPC(xp) = xpGPR(xp,Ifn);
    530655      xpGPR(xp,Inargs) = 1<<fixnumshift;
     
    582707  lisp_protection_kind which = prot_area->why;
    583708  Boolean on_TSP = (which == kTSPsoftguard);
    584   LispObj save_rbp = xpGPR(xp,Irbp),
    585     save_vsp = xpGPR(xp,Isp),
     709#ifdef X8664
     710  LispObj save_rbp = xpGPR(xp,Irbp);
     711#else
     712  LispObj save_ebp = xpGPR(xp,Iebp);
     713#endif
     714  LispObj save_vsp = xpGPR(xp,Isp),
    586715    xcf,
    587716    cmain = nrs_CMAIN.vcell;
     
    602731    xcf = create_exception_callback_frame(xp, tcr);
    603732    skip = callback_to_lisp(tcr, nrs_CMAIN.vcell, xp, xcf, SIGSEGV, on_TSP, 0, 0);
     733#ifdef X8664
    604734    xpGPR(xp,Irbp) = save_rbp;
     735#else
     736    xpGPR(xp,Iebp) = save_ebp;
     737#endif
    605738    xpGPR(xp,Isp) = save_vsp;
    606739    xpPC(xp) += skip;
     
    614747{
    615748#ifdef DARWIN
     749#ifdef X8664
    616750  return (UC_MCONTEXT(xp)->__es.__err & 0x2) != 0;
    617 #endif
    618 #ifdef LINUX
     751#else
     752  return (xp->uc_mcontext->__es.__err & 0x2) != 0;
     753#endif
     754#endif
     755#if defined(LINUX) || defined(SOLARIS)
    619756  return (xpGPR(xp,REG_ERR) & 0x2) != 0;
    620757#endif
     
    635772}
    636773#else
    637 #ifdef BOOTSTRAP
    638 void
    639 bootstrap_fix_lowmem_ref(BytePtr addr, pc where, ExceptionInformation *xp)
    640 {
    641 }
    642 #endif
    643774Boolean
    644775handle_fault(TCR *tcr, ExceptionInformation *xp, siginfo_t *info, int old_valence)
     
    648779#else
    649780  BytePtr addr = (BytePtr) info->si_addr;
    650 #endif
    651 
    652 #ifdef BOOTSTRAP
    653   if ((addr >= (BytePtr)0x2000) &&
    654       (addr <  (BytePtr)(0x2000+0x2000))) {
    655     bootstrap_fix_lowmem_ref(addr,(pc)xpPC(xp), xp);
    656     return true;
    657   }
    658781#endif
    659782
     
    695818  int code = info->si_code, skip;
    696819  LispObj  xcf, cmain = nrs_CMAIN.vcell,
    697 
    698     save_rbp = xpGPR(xp,Irbp), save_vsp = xpGPR(xp,Isp);
     820    save_vsp = xpGPR(xp,Isp);
     821#ifdef X8664
     822  LispObj save_rbp = xpGPR(xp,Irbp);
     823#else
     824  LispObj save_ebp = xpGPR(xp,Iebp);
     825#endif
    699826
    700827  if ((fulltag_of(cmain) == fulltag_misc) &&
     
    703830    skip = callback_to_lisp(tcr, cmain, xp, xcf, SIGFPE, code, 0, 0);
    704831    xpPC(xp) += skip;
     832#ifdef X8664
    705833    xpGPR(xp,Irbp) = save_rbp;
     834#else
     835    xpGPR(xp,Iebp) = save_ebp;
     836#endif
    706837    xpGPR(xp,Isp) = save_vsp;
    707838    return true;
     
    832963         course that has nothing to do with accessing protected
    833964         memory; of course, most Unices act as if it did.*/
    834       if (*program_counter == INTN_OPCODE) {
    835         program_counter++;
    836         switch (*program_counter) {
    837         case UUO_ALLOC_TRAP:
    838           if (handle_alloc_trap(context, tcr)) {
    839             xpPC(context) += 2; /* we might have GCed. */
    840             return true;
    841           }
    842           break;
    843         case UUO_GC_TRAP:
    844           if (handle_gc_trap(context, tcr)) {
    845             xpPC(context) += 2;
    846             return true;
    847           }
    848           break;
    849          
    850         case UUO_DEBUG_TRAP:
    851           xpPC(context) = (natural) (program_counter+1);
    852           lisp_Debugger(context, info, debug_entry_dbg, false, "Lisp Breakpoint");
    853           return true;
    854 
    855         case UUO_DEBUG_TRAP_WITH_STRING:
    856           xpPC(context) = (natural) (program_counter+1);
     965      if ((program_counter != NULL) &&
     966          (*program_counter == INTN_OPCODE)) {
     967        program_counter++;
     968        switch (*program_counter) {
     969        case UUO_ALLOC_TRAP:
     970          if (handle_alloc_trap(context, tcr)) {
     971            xpPC(context) += 2; /* we might have GCed. */
     972            return true;
     973          }
     974          break;
     975        case UUO_GC_TRAP:
     976          if (handle_gc_trap(context, tcr)) {
     977            xpPC(context) += 2;
     978            return true;
     979          }
     980          break;
     981           
     982        case UUO_DEBUG_TRAP:
     983          xpPC(context) = (natural) (program_counter+1);
     984          lisp_Debugger(context, info, debug_entry_dbg, false, "Lisp Breakpoint");
     985          return true;
     986           
     987        case UUO_DEBUG_TRAP_WITH_STRING:
     988          xpPC(context) = (natural) (program_counter+1);
    857989          {
    858990            char msg[512];
    859 
     991             
    860992            get_lisp_string(xpGPR(context,Iarg_z),msg, sizeof(msg)-1);
    861993            lisp_Debugger(context, info, debug_entry_dbg, false, msg);
    862994          }
    863           return true;
    864          
     995          return true;
     996           
    865997        default:
    866998          return handle_error(tcr, context);
     
    10001132#endif
    10011133  xf->curr = context;
     1134#ifdef X8632
     1135  xf->node_regs_mask = tcr->node_regs_mask;
     1136#endif
    10021137  xf->prev = tcr->xframe;
    10031138  tcr->xframe =  xf;
     
    10101145{
    10111146  tcr->pending_exception_context = tcr->xframe->curr;
     1147#ifdef X8632
     1148  tcr->node_regs_mask = tcr->xframe->node_regs_mask;
     1149#endif
    10121150  tcr->xframe = tcr->xframe->prev;
    10131151  tcr->valence = TCR_STATE_EXCEPTION_RETURN;
     
    13361474        (tcr->unwinding != 0) ||
    13371475        ! stack_pointer_on_vstack_p(xpGPR(context,Isp), tcr) ||
     1476#ifdef X8664
    13381477        ! stack_pointer_on_vstack_p(xpGPR(context,Irbp), tcr)) {
     1478#else
     1479        ! stack_pointer_on_vstack_p(xpGPR(context,Iebp), tcr)) {
     1480#endif
    13391481      tcr->interrupt_pending = (1L << (nbits_in_word - 1L));
    13401482    } else {
     
    17841926*/
    17851927
     1928#ifdef X8664
    17861929opcode load_allocptr_reg_from_tcr_save_allocptr_instruction[] =
    17871930  {0x65,0x48,0x8b,0x1c,0x25,0xd8,0x00,0x00,0x00};
     
    17971940  {0x48,0x89,0x43,0xf3};
    17981941
    1799 
    18001942alloc_instruction_id
    18011943recognize_alloc_instruction(pc program_counter)
     
    18171959  return ID_unrecognized_alloc_instruction;
    18181960}
    1819      
     1961#endif
     1962#ifdef X8632
     1963opcode load_allocptr_reg_from_tcr_save_allocptr_instruction[] =
     1964  {0x64,0x8b,0x0d,0x84,0x00,0x00,0x00};
     1965opcode compare_allocptr_reg_to_tcr_save_allocbase_instruction[] =
     1966  {0x64,0x3b,0x0d,0x88,0x00,0x00,0x00};
     1967opcode branch_around_alloc_trap_instruction[] =
     1968  {0x7f,0x02};
     1969opcode alloc_trap_instruction[] =
     1970  {0xcd,0xc5};
     1971opcode clear_tcr_save_allocptr_tag_instruction[] =
     1972  {0x64,0x80,0x25,0x84,0x00,0x00,0x00,0xf8};
     1973opcode set_allocptr_header_instruction[] =
     1974  {0x0f,0x7e,0x41,0xfa};
     1975
     1976alloc_instruction_id
     1977recognize_alloc_instruction(pc program_counter)
     1978{
     1979  switch(program_counter[0]) {
     1980  case 0xcd: return ID_alloc_trap_instruction;
     1981  case 0x7f: return ID_branch_around_alloc_trap_instruction;
     1982  case 0x0f: return ID_set_allocptr_header_instruction;
     1983  case 0x64:
     1984    switch(program_counter[1]) {
     1985    case 0x80: return ID_clear_tcr_save_allocptr_tag_instruction;
     1986    case 0x3b: return ID_compare_allocptr_reg_to_tcr_save_allocbase_instruction;
     1987    case 0x8b: return ID_load_allocptr_reg_from_tcr_save_allocptr_instruction;
     1988    }
     1989  }
     1990  return ID_unrecognized_alloc_instruction;
     1991}
     1992#endif     
    18201993#ifdef WINDOWS 
    18211994void
     
    18322005  if (allocptr_tag != 0) {
    18332006    alloc_instruction_id state = recognize_alloc_instruction(program_counter);
     2007#ifdef X8664
    18342008    signed_natural
    18352009      disp = (allocptr_tag == fulltag_cons) ?
    18362010      sizeof(cons) - fulltag_cons :
    18372011      xpGPR(xp,Iimm1);
     2012#else
     2013      signed_natural disp = (allocptr_tag == fulltag_cons) ?
     2014      sizeof(cons) - fulltag_cons :
     2015      xpMMXreg(xp,Imm0);
     2016#endif
    18382017    LispObj new_vector;
    18392018
     
    18452024    switch(state) {
    18462025    case ID_set_allocptr_header_instruction:
    1847       /* We were consing a vector and we won.  Set the header of the new vector
    1848          (in the allocptr register) to the header in %rax and skip over this
    1849          instruction, then fall into the next case. */
     2026      /* We were consing a vector and we won.  Set the header of the
     2027         new vector (in the allocptr register) to the header in
     2028         %eax/%rax and skip over this instruction, then fall into the
     2029         next case. */
    18502030      new_vector = xpGPR(xp,Iallocptr);
    18512031      deref(new_vector,0) = xpGPR(xp,Iimm0);
     
    18772057      break;
    18782058    case ID_branch_around_alloc_trap_instruction:
    1879       /* If we'd take the branch - which is a 'jg" - around the alloc trap,
     2059      /* If we'd take the branch - which is a "jg" - around the alloc trap,
    18802060         we might as well finish the allocation.  Otherwise, back out of the
    18812061         attempt. */
     
    19422122      /* The conditional store succeeded.  Set the refbit, return to ra0 */
    19432123      val = xpGPR(xp,Iarg_z);
     2124#ifdef X8664
    19442125      ea = (LispObj*)(xpGPR(xp,Iarg_x) + (unbox_fixnum((signed_natural)
    19452126                                                       xpGPR(xp,Itemp0))));
     2127#else
     2128      ea = (LispObj *)(misc_data_offset + xpGPR(xp,Itemp1) + xpGPR(xp,Itemp0));
     2129#endif
    19462130      xpGPR(xp,Iarg_z) = t_value;
    19472131      need_store = false;
    19482132    } else if (program_counter >= &egc_set_hash_key) {
     2133#ifdef X8664
    19492134      root = xpGPR(xp,Iarg_x);
     2135#else
     2136      root = xpGPR(xp,Itemp0);
     2137#endif
    19502138      ea = (LispObj *) (root+xpGPR(xp,Iarg_y)+misc_data_offset);
    19512139      val = xpGPR(xp,Iarg_z);
    19522140      need_memoize_root = true;
    19532141    } else if (program_counter >= &egc_gvset) {
     2142#ifdef X8664
    19542143      ea = (LispObj *) (xpGPR(xp,Iarg_x)+xpGPR(xp,Iarg_y)+misc_data_offset);
     2144#else
     2145      ea = (LispObj *) (xpGPR(xp,Itemp0)+xpGPR(xp,Iarg_y)+misc_data_offset);
     2146#endif
    19552147      val = xpGPR(xp,Iarg_z);
    19562148    } else if (program_counter >= &egc_rplacd) {
     
    19792171         to pop the return address off the stack and set
    19802172         the PC there. */
    1981       LispObj *rsp = (LispObj *)xpGPR(xp,Isp), ra = *rsp++;
     2173      LispObj *sp = (LispObj *)xpGPR(xp,Isp), ra = *sp++;
    19822174      xpPC(xp) = ra;
    1983       xpGPR(xp,Isp)=(LispObj)rsp;
     2175      xpGPR(xp,Isp)=(LispObj)sp;
    19842176    }
    19852177    return;
     
    21472339#define TCR_TO_EXCEPTION_PORT(tcr) ((mach_port_t)((natural)(tcr)))
    21482340
    2149 #if USE_MACH_EXCEPTION_LOCK
    2150 pthread_mutex_t _mach_exception_lock, *mach_exception_lock;
    2151 #endif
    21522341extern void pseudo_sigreturn(void);
    21532342
     
    22562445  MCONTEXT_T mc = UC_MCONTEXT(pseudosigcontext);
    22572446#else
    2258   struct mcontext * mc = UC_MCONTEXT(pseudosigcontext);
     2447  mcontext_t mc = UC_MCONTEXT(pseudosigcontext);
    22592448#endif
    22602449
    22612450  /* Set the thread's FP state from the pseudosigcontext */
     2451#if WORD_SIZE == 64
    22622452  kret = thread_set_state(thread,
    22632453                          x86_FLOAT_STATE64,
    22642454                          (thread_state_t)&(mc->__fs),
    22652455                          x86_FLOAT_STATE64_COUNT);
    2266 
     2456#else
     2457  kret = thread_set_state(thread,
     2458                          x86_FLOAT_STATE32,
     2459                          (thread_state_t)&(mc->__fs),
     2460                          x86_FLOAT_STATE32_COUNT);
     2461#endif
    22672462  MACH_CHECK_ERROR("setting thread FP state", kret);
    22682463
     
    23232518                            x86_thread_state64_t *ts
    23242519#else
    2325                             x86_thread_state_t *ts
     2520                            x86_thread_state32_t *ts
    23262521#endif
    23272522                            )
     
    23322527  MCONTEXT_T mc;
    23332528#else
    2334   struct mcontext *mc;
     2529  mcontext_t mc;
    23352530#endif
    23362531  natural stackp;
    23372532
    2338  
     2533#ifdef X8664 
    23392534  stackp = (LispObj) find_foreign_rsp(ts->__rsp,tcr->cs_area,tcr);
    23402535  stackp = TRUNC_DOWN(stackp, C_REDZONE_LEN, C_STK_ALIGN);
     2536#else
     2537  stackp = (LispObj) find_foreign_rsp(ts->__esp, tcr->cs_area, tcr);
     2538#endif
    23412539  stackp = TRUNC_DOWN(stackp, sizeof(siginfo_t), C_STK_ALIGN);
    23422540  if (info_ptr) {
     
    23472545
    23482546  stackp = TRUNC_DOWN(stackp, sizeof(*mc), C_STK_ALIGN);
    2349 #ifdef X8664
    23502547  mc = (MCONTEXT_T) ptr_from_lispobj(stackp);
    2351 #else
    2352   mc = (struct mcontext *) ptr_from_lispobj(stackp);
    2353 #endif
    23542548 
    23552549  memmove(&(mc->__ss),ts,sizeof(*ts));
    23562550
     2551#ifdef X8664
    23572552  thread_state_count = x86_FLOAT_STATE64_COUNT;
    23582553  thread_get_state(thread,
     
    23612556                   &thread_state_count);
    23622557
    2363 
    2364 #ifdef X8664
    23652558  thread_state_count = x86_EXCEPTION_STATE64_COUNT;
    2366 #else
    2367   thread_state_count = x86_EXCEPTION_STATE_COUNT;
    2368 #endif
    23692559  thread_get_state(thread,
    2370 #ifdef X8664
    23712560                   x86_EXCEPTION_STATE64,
    2372 #else
    2373                    x86_EXCEPTION_STATE,
    2374 #endif
    23752561                   (thread_state_t)&(mc->__es),
    23762562                   &thread_state_count);
     2563#else
     2564  thread_state_count = x86_FLOAT_STATE32_COUNT;
     2565  thread_get_state(thread,
     2566                   x86_FLOAT_STATE32,
     2567                   (thread_state_t)&(mc->__fs),
     2568                   &thread_state_count);
     2569
     2570  thread_state_count = x86_EXCEPTION_STATE32_COUNT;
     2571  thread_get_state(thread,
     2572                   x86_EXCEPTION_STATE32,
     2573                   (thread_state_t)&(mc->__es),
     2574                   &thread_state_count);
     2575#endif
    23772576
    23782577
     
    24102609                   x86_thread_state64_t *ts
    24112610#else
    2412                    x86_thread_state_t *ts
     2611                   x86_thread_state32_t *ts
    24132612#endif
    24142613                   )
     
    24172616  x86_thread_state64_t new_ts;
    24182617#else
    2419   x86_thread_state_t new_ts;
     2618  x86_thread_state32_t new_ts;
    24202619#endif
    24212620  ExceptionInformation *pseudosigcontext;
     
    24492648  */
    24502649
     2650#ifdef X8664
    24512651  new_ts.__rip = (natural) handler_address;
    24522652  stackpp = (natural *)stackp;
     
    24602660  new_ts.__rsp = stackp;
    24612661  new_ts.__rflags = ts->__rflags;
    2462 
     2662#else
     2663#define USER_CS 0x17
     2664#define USER_DS 0x1f
     2665  bzero(&new_ts, sizeof(new_ts));
     2666  new_ts.__cs = ts->__cs;
     2667  new_ts.__ss = ts->__ss;
     2668  new_ts.__ds = ts->__ds;
     2669  new_ts.__es = ts->__es;
     2670  new_ts.__fs = ts->__fs;
     2671  new_ts.__gs = ts->__gs;
     2672
     2673  new_ts.__eip = (natural)handler_address;
     2674  stackpp = (natural *)stackp;
     2675  *--stackpp = 0;               /* alignment */
     2676  *--stackpp = 0;
     2677  *--stackpp = 0;
     2678  *--stackpp = (natural)old_valence;
     2679  *--stackpp = (natural)tcr;
     2680  *--stackpp = (natural)pseudosigcontext;
     2681  *--stackpp = (natural)info;
     2682  *--stackpp = (natural)signum;
     2683  *--stackpp = (natural)pseudo_sigreturn;
     2684  stackp = (natural)stackpp;
     2685  new_ts.__esp = stackp;
     2686  new_ts.__eflags = ts->__eflags;
     2687#endif
    24632688
    24642689#ifdef X8664
     
    24692694#else
    24702695  thread_set_state(thread,
    2471                    x86_THREAD_STATE,
     2696                   x86_THREAD_STATE32,
    24722697                   (thread_state_t)&new_ts,
    2473                    x86_THREAD_STATE_COUNT);
     2698                   x86_THREAD_STATE32_COUNT);
    24742699#endif
    24752700#ifdef DEBUG_MACH_EXCEPTIONS
     
    25122737#define ts_pc(t) t.__rip
    25132738#else
    2514 #define ts_pc(t) t.eip
     2739#define ts_pc(t) t.__eip
    25152740#endif
    25162741
     
    25362761  x86_thread_state64_t ts;
    25372762#else
    2538   x86_thread_state_t ts;
     2763  x86_thread_state32_t ts;
    25392764#endif
    25402765  mach_msg_type_number_t thread_state_count;
     
    25472772
    25482773
    2549   if (
    2550 #if USE_MACH_EXCEPTION_LOCK
    2551       pthread_mutex_trylock(mach_exception_lock) == 0
    2552 #else
    2553       1
    2554 #endif
    2555       ) {
     2774  if (1) {
    25562775#ifdef X8664
    25572776    do {
     
    25642783  MACH_CHECK_ERROR("getting thread state",call_kret);
    25652784#else
    2566     thread_state_count = x86_THREAD_STATE_COUNT;
    2567     thread_get_state(thread,
    2568                      x86_THREAD_STATE,
    2569                      (thread_state_t)&ts,
    2570                      &thread_state_count);
     2785    thread_state_count = x86_THREAD_STATE32_COUNT;
     2786    call_kret = thread_get_state(thread,
     2787                                 x86_THREAD_STATE32,
     2788                                 (thread_state_t)&ts,
     2789                                 &thread_state_count);
     2790    MACH_CHECK_ERROR("getting thread state",call_kret);
    25712791#endif
    25722792    if (tcr->flags & (1<<TCR_FLAG_BIT_PENDING_EXCEPTION)) {
     
    26262846      }
    26272847    }
    2628 #if USE_MACH_EXCEPTION_LOCK
    2629 #ifdef DEBUG_MACH_EXCEPTIONS
    2630     fprintf(stderr, "releasing Mach exception lock in exception thread\n");
    2631 #endif
    2632     pthread_mutex_unlock(mach_exception_lock);
    2633 #endif
    2634   } else {
    2635     SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_EXCEPTION);
    2636      
    2637 #if 0
    2638     fprintf(stderr, "deferring pending exception in 0x%x\n", tcr);
    2639 #endif
    2640     kret = KERN_SUCCESS;
    2641     if (tcr == gc_tcr) {
    2642       int i;
    2643       write(1, "exception in GC thread. Sleeping for 60 seconds\n",sizeof("exception in GC thread.  Sleeping for 60 seconds\n"));
    2644       for (i = 0; i < 60; i++) {
    2645         sleep(1);
    2646       }
    2647       _exit(EX_SOFTWARE);
    2648     }
    26492848  }
    26502849  return kret;
     
    26942893  kern_return_t kret; 
    26952894  if (__exception_port_set == MACH_PORT_NULL) {
    2696 #if USE_MACH_EXCEPTION_LOCK
    2697     mach_exception_lock = &_mach_exception_lock;
    2698     pthread_mutex_init(mach_exception_lock, NULL);
    2699 #endif
    27002895
    27012896    kret = mach_port_allocate(mach_task_self(),
     
    29223117                     &thread_state_count);
    29233118#else
    2924     x86_thread_state_t ts;
     3119    x86_thread_state32_t ts;
    29253120    thread_state_count = x86_THREAD_STATE_COUNT;
    29263121    thread_get_state(mach_thread,
  • branches/working-0711/ccl/lisp-kernel/x86-exceptions.h

    r9989 r10389  
    3838#define xpFPRvector(x) ((natural *)(&(UC_MCONTEXT(x)->__fs.__fpu_xmm0)))
    3939#define xpMMXreg(x,n)  (xpFPRvector(x)[n])
     40#else /* X8632 */
     41#define xpGPRvector(x) ((natural *)(&((x)->uc_mcontext->__ss.__eax)))
     42#define xpGPR(x,gprno) (xpGPRvector(x)[gprno])
     43#define set_xpGPR(x,gpr,new) xpGPR((x),(gpr)) = (natural)(new)
     44#define xpPC(x) (xpGPR(x,Iip))
     45#define xpFPRvector(x) ((natural *)(&((x)->uc_mcontext->__fs.__fpu_xmm0)))
     46/* are you ready for this? */
     47#define xpMMXreg(x,n) *((natural *)&((&((x)->uc_mcontext->__fs.__fpu_stmm0))[n]))
    4048#endif
    4149#include <mach/mach.h>
     
    6674#define set_xpGPR(x,gpr,new) xpGPR((x),(gpr)) = (natural)(new)
    6775#define xpPC(x) xpGPR(x,Iip)
    68 #define xpMMXreg(x,n)  *((natural *)(&(x)->uc_mcontext.fpregs.fp_reg_set.fpchip_state.st[n]))
     76#define xpXMMregs(x)(&((x)->uc_mcontext.fpregs.fp_reg_set.fpchip_state.xmm[0]))
    6977#endif
    7078#endif
     
    8694#endif
    8795#ifdef SOLARIS
    88 #define SIGNAL_FOR_PROCESS_INTERRUPT SIGEMT
     96#define SIGNAL_FOR_PROCESS_INTERRUPT SIGUSR1
    8997#endif
    9098
     
    146154#endif
    147155
     156#ifdef SOLARIS
     157#define SIGNUM_FOR_INTN_TRAP SIGSEGV
     158#define IS_MAYBE_INT_TRAP(info,xp) ((xpGPR(xp,REG_TRAPNO)==0xd)&&((xpGPR(xp,REG_ERR)&7)==2))
     159#define SIGRETURN(context) setcontext(context)
     160#endif
     161
    148162/* Please go away. */
    149163#ifdef DARWIN_GS_HACK
     
    179193extern natural get_mxcsr();
    180194extern void set_mxcsr(natural);
     195
     196#ifdef X8632
     197/* The 32-bit immediate value in the instruction
     198 * "(mov ($ 0x12345678) (% fn))" at a tagged return address
     199 * refers to the associated function.
     200 */
     201#define RECOVER_FN_OPCODE 0xbf
     202#define RECOVER_FN_LENGTH 5
     203#endif
  • branches/working-0711/ccl/lisp-kernel/x86-gc.c

    r10187 r10389  
    4343  case fulltag_even_fixnum:
    4444  case fulltag_odd_fixnum:
     45#ifdef X8632
     46  case fulltag_imm:
     47#endif
     48#ifdef X8664
    4549  case fulltag_imm_0:
    4650  case fulltag_imm_1:
     51#endif
    4752    return;
    4853
     54#ifdef X8664
    4955  case fulltag_nil:
    5056    if (n != lisp_nil) {
     
    5258    }
    5359    return;
    54 
    55 
     60#endif
     61
     62#ifdef X8632
     63  case fulltag_nodeheader:
     64  case fulltag_immheader:
     65#endif
     66#ifdef X8664
    5667  case fulltag_nodeheader_0:
    5768  case fulltag_nodeheader_1:
     
    5970  case fulltag_immheader_1:
    6071  case fulltag_immheader_2:
     72#endif
    6173    Bug(NULL, "Header not expected : 0x%lx", n);
    6274    return;
    6375
     76#ifdef X8632
     77  case fulltag_tra:
     78#endif
     79#ifdef X8664
    6480  case fulltag_tra_0:
    6581  case fulltag_tra_1:
     82#endif
    6683    a = heap_area_containing((BytePtr)ptr_from_lispobj(n));
    6784    if (a == NULL) {
     
    7693       check the function it (should) identify.
    7794    */
     95#ifdef X8632
     96    {
     97      LispObj fun = 0;
     98
     99      if (*(unsigned char *)n == RECOVER_FN_OPCODE)
     100        fun = *(LispObj *)(n + 1);
     101      if (fun == 0 ||
     102         (header_subtag(header_of(fun)) != subtag_function) ||
     103         (heap_area_containing((BytePtr)ptr_from_lispobj(fun)) != a)) {
     104        Bug(NULL, "TRA at 0x%x has bad function address 0x%x\n", n, fun);
     105      }
     106      n = fun;
     107    }
     108#endif
     109#ifdef X8664
    78110    {
    79111      int disp = 0;
     
    91123      }
    92124    }
     125#endif
    93126    /* Otherwise, fall through and check the header on the function
    94127       that the tra references */
     
    96129  case fulltag_misc:
    97130  case fulltag_cons:
     131#ifdef X8664
    98132  case fulltag_symbol:
    99133  case fulltag_function:
     134#endif
    100135    a = heap_area_containing((BytePtr)ptr_from_lispobj(n));
    101136   
     
    163198      elements = header_element_count(node) | 1;
    164199      if (header_subtag(node) == subtag_function) {
     200#ifdef X8632
     201        int skip = *(unsigned short *)current;
     202#else
    165203        int skip = *(int *)current;
     204#endif
    166205        current += skip;
    167206        elements -= skip;
     
    250289  }
    251290
     291#ifdef X8632
     292  if (tag_n == fulltag_tra) {
     293    if (*(unsigned char *)n == RECOVER_FN_OPCODE) {
     294      n = *(LispObj *)(n + 1);
     295      tag_n = fulltag_misc;
     296    } else
     297      return;
     298  }
     299#endif
     300#ifdef X8664
    252301  if (tag_of(n) == tag_tra) {
    253302    if ((*((unsigned short *)n) == RECOVER_FN_FROM_RIP_WORD0) &&
     
    261310    }
    262311  }
     312#endif
    263313
    264314
     
    292342    tag_n = fulltag_of(header);
    293343
    294 
     344#ifdef X8664
    295345    if ((nodeheader_tag_p(tag_n)) ||
    296346        (tag_n == ivector_class_64_bit)) {
     
    308358      }
    309359    }
     360#endif
     361#ifdef X8632
     362    if ((tag_n == fulltag_nodeheader) ||
     363        (subtag <= max_32_bit_ivector_subtag)) {
     364      total_size_in_bytes = 4 + (element_count<<2);
     365    } else if (subtag <= max_8_bit_ivector_subtag) {
     366      total_size_in_bytes = 4 + element_count;
     367    } else if (subtag <= max_16_bit_ivector_subtag) {
     368      total_size_in_bytes = 4 + (element_count<<1);
     369    } else if (subtag == subtag_double_float_vector) {
     370      total_size_in_bytes = 8 + (element_count<<3);
     371    } else {
     372      total_size_in_bytes = 4 + ((element_count+7)>>3);
     373    }
     374#endif
     375
    310376
    311377    suffix_dnodes = ((total_size_in_bytes+(dnode_size-1))>>dnode_shift) -1;
     
    344410
    345411      if (subtag == subtag_function) {
     412#ifdef X8632
     413        prefix_nodes = (natural) ((unsigned short) deref(base,1));
     414#else
    346415        prefix_nodes = (natural) ((int) deref(base,1));
     416#endif
    347417        if (prefix_nodes > element_count) {
    348418          Bug(NULL, "Function 0x%lx trashed",n);
     
    397467#ifdef X8664
    398468#define RMARK_PREV_ROOT fulltag_imm_1 /* fulltag of 'undefined' value */
    399 #define RMARK_PREV_CAR fulltag_nil /* fulltag_nil + node_size. Coincidence ? I think not. */
     469#define RMARK_PREV_CAR fulltag_nil /* fulltag_cons + node_size. Coincidence ? I think not. */
    400470#else
    401 #endif
    402 
     471#define RMARK_PREV_ROOT fulltag_imm /* fulltag of 'undefined' value */
     472#define RMARK_PREV_CAR fulltag_odd_fixnum
     473#endif
    403474
    404475
     
    419490  }
    420491
     492#ifdef X8632
     493  if (tag_n == fulltag_tra) {
     494    if (*(unsigned char *)n == RECOVER_FN_OPCODE) {
     495      n = *(LispObj *)(n + 1);
     496      tag_n = fulltag_misc;
     497    } else {
     498      return;
     499    }
     500  }
     501#endif
     502#ifdef X8664
    421503  if (tag_of(n) == tag_tra) {
    422504    if ((*((unsigned short *)n) == RECOVER_FN_FROM_RIP_WORD0) &&
     
    429511    }
    430512  }
     513#endif
    431514
    432515  dnode = gc_area_dnode(n);
     
    456539      tag_n = fulltag_of(header);
    457540
     541#ifdef X8664
    458542      if ((nodeheader_tag_p(tag_n)) ||
    459543          (tag_n == ivector_class_64_bit)) {
     
    471555        }
    472556      }
     557#else
     558      if ((tag_n == fulltag_nodeheader) ||
     559          (subtag <= max_32_bit_ivector_subtag)) {
     560        total_size_in_bytes = 4 + (element_count<<2);
     561      } else if (subtag <= max_8_bit_ivector_subtag) {
     562        total_size_in_bytes = 4 + element_count;
     563      } else if (subtag <= max_16_bit_ivector_subtag) {
     564        total_size_in_bytes = 4 + (element_count<<1);
     565      } else if (subtag == subtag_double_float_vector) {
     566        total_size_in_bytes = 8 + (element_count<<3);
     567      } else {
     568        total_size_in_bytes = 4 + ((element_count+7)>>3);
     569      }
     570#endif
     571
    473572      suffix_dnodes = ((total_size_in_bytes+(dnode_size-1))>>dnode_shift)-1;
    474573
     
    513612
    514613      if (subtag == subtag_function) {
    515         if ((int)base[1] >= nmark) {
     614#ifdef X8664
     615        int code_words = (int)base[1];
     616#else
     617        int code_words = (unsigned short)base[1];
     618#endif
     619        if (code_words >= nmark) {
    516620          Bug(NULL,"Bad function at 0x%lx",n);
    517621        }
    518         nmark -= (int)base[1];
     622        nmark -= code_words;
    519623      }
    520624
     
    531635    }
    532636  } else {
    533 
    534637    /* This is all a bit more complicated than the PPC version:
    535638
     
    618721    case tag_misc:
    619722    case fulltag_misc:
     723#ifdef X8664
    620724    case tag_symbol:
    621725    case fulltag_symbol:
    622726    case tag_function:
    623727    case fulltag_function:
     728#endif
    624729      goto ClimbVector;
    625730
     
    633738      goto ClimbCar;
    634739
    635       /* default: abort() */
     740    default: abort();
    636741    }
    637742
     
    642747  MarkCons:
    643748    next = deref(this,1);
     749#ifdef X8632
     750    this += (RMARK_PREV_CAR-fulltag_cons);
     751#else
    644752    this += node_size;
     753#endif
    645754    tag_n = fulltag_of(next);
    646755    if (!is_node_fulltag(tag_n)) goto MarkCdr;
     
    660769  MarkCdr:
    661770    next = deref(this, 0);
     771#ifdef X8632
     772    this -= (RMARK_PREV_CAR-fulltag_cons);
     773#else
    662774    this -= node_size;
     775#endif
    663776    tag_n = fulltag_of(next);
    664777    if (!is_node_fulltag(tag_n)) goto Climb;
     
    677790
    678791  MarkVector:
     792#ifdef X8664
    679793    if ((tag_n == fulltag_tra_0) ||
    680794        (tag_n == fulltag_tra_1)) {
     
    717831      }
    718832    }
     833#else
     834    if (tag_n == fulltag_tra) {
     835      LispObj fn = *(LispObj *)(n + 1);
     836
     837      base = (LispObj *)untag(fn);
     838      header = *(natural *)base;
     839      subtag = header_subtag(header);
     840      boundary = base + (unsigned short)base[1];
     841      /*
     842       * On x8632, the upper 24 bits of the boundary word are zero.
     843       * Functions on x8632 can be no more than 2^16 words (or 2^24
     844       * bytes) long (including the self-reference table but excluding
     845       * any constants).  Therefore, we can do the same basic thing
     846       * that the x8664 port does: namely, we keep the byte
     847       * displacement from the address of the object (tagged tra or
     848       * fulltag_misc) that references the function to the address of
     849       * the boundary marker in those 24 bits, recovering it when
     850       * we've finished marking the function vector.
     851       */
     852      *((int *)boundary) &= 0xff;
     853      *((int *)boundary) |= ((this-(LispObj)boundary) << 8);
     854      this = (LispObj)(base)+fulltag_misc;
     855      dnode = gc_area_dnode(this);
     856      set_bit(markbits,dnode);
     857    } else {
     858      base = (LispObj *) ptr_from_lispobj(untag(this));
     859      header = *((natural *) base);
     860      subtag = header_subtag(header);
     861      if (subtag == subtag_function) {
     862        boundary = base + (unsigned short)base[1];
     863        *((int *)boundary) &= 0xff;
     864        *((int *)boundary) |= ((this-((LispObj)boundary)) << 8);
     865      }
     866    }
     867    element_count = header_element_count(header);
     868    tag_n = fulltag_of(header);
     869
     870    if ((tag_n == fulltag_nodeheader) ||
     871        (subtag <= max_32_bit_ivector_subtag)) {
     872      total_size_in_bytes = 4 + (element_count<<2);
     873    } else if (subtag <= max_8_bit_ivector_subtag) {
     874      total_size_in_bytes = 4 + element_count;
     875    } else if (subtag <= max_16_bit_ivector_subtag) {
     876      total_size_in_bytes = 4 + (element_count<<1);
     877    } else if (subtag == subtag_double_float_vector) {
     878      total_size_in_bytes = 8 + (element_count<<3);
     879    } else {
     880      total_size_in_bytes = 4 + ((element_count+7)>>3);
     881    }
     882#endif
     883
    719884    suffix_dnodes = ((total_size_in_bytes+(dnode_size-1))>>dnode_shift)-1;
    720885   
     
    759924    this -= node_size;
    760925    next = indirect_node(this);
     926#ifdef X8664
    761927    if ((tag_of(this) == tag_function) &&
    762928        (header_subtag(next) == function_boundary_marker)) goto MarkFunctionDone;
     929#else
     930    if ((tag_of(this) == tag_misc) &&
     931        (header_subtag(next) == function_boundary_marker)) goto MarkFunctionDone;
     932#endif
     933
    763934    tag_n = fulltag_of(next);
    764935    if (nodeheader_tag_p(tag_n)) goto MarkVectorDone;
     
    786957  MarkFunctionDone:
    787958    boundary = (LispObj *)(node_aligned(this));
     959#ifdef X8664
    788960    this = ((LispObj)boundary) + (((int *)boundary)[1]);
    789961    (((int *)boundary)[1]) = 0;
     962#else
     963    this = ((LispObj)boundary) + ((*((int *)boundary)) >> 8);
     964    ((int *)boundary)[0] &= 0xff;
     965#endif
    790966    goto Climb;
    791967  }
     
    801977
    802978
    803 
     979#ifdef X8664
    804980  switch (fulltag_of(header)) {
    805981  case ivector_class_64_bit:
     
    820996  }
    821997  return ptr_from_lispobj(start+(~15 & (nbytes + 8 + 15)));
    822 
     998#else
     999  if (subtag <= max_32_bit_ivector_subtag) {
     1000    nbytes = element_count << 2;
     1001  } else if (subtag <= max_8_bit_ivector_subtag) {
     1002    nbytes = element_count;
     1003  } else if (subtag <= max_16_bit_ivector_subtag) {
     1004    nbytes = element_count << 1;
     1005  } else if (subtag == subtag_double_float_vector) {
     1006    nbytes = 4 + (element_count << 3);
     1007  } else {
     1008    nbytes = (element_count+7) >> 3;
     1009  }
     1010  return ptr_from_lispobj(start+(~7 & (nbytes + 4 + 7)));
     1011#endif
    8231012}
    8241013
     
    8401029    } else {
    8411030      if (header_subtag(x1) == subtag_function) {
     1031#ifdef X8632
     1032        int skip = (unsigned short)deref(start,1);
     1033#else
    8421034        int skip = (int) deref(start,1);
     1035#endif
    8431036        start += ((1+skip)&~1);
    8441037        x1 = *start;
     
    10151208      base = start + element_count + 1;
    10161209      if (subtag == subtag_function) {
     1210#ifdef X8632
     1211        element_count -= (unsigned short)start[1];
     1212#else
    10171213        element_count -= (int)start[1];
     1214#endif
    10181215      }
    10191216      while(element_count--) {
     
    10761273
    10771274/* Mark the lisp objects in an exception frame */
     1275#ifdef X8664
    10781276void
    10791277mark_xp(ExceptionInformation *xp)
     
    11141312  }
    11151313}
    1116 
    1117 
    1118      
    1119 
    1120 
    1121 
    1122 
     1314#else
     1315void
     1316mark_xp(ExceptionInformation *xp, natural node_regs_mask)
     1317{
     1318  natural *regs = (natural *) xpGPRvector(xp), dnode;
     1319  LispObj eip;
     1320  int i;
     1321
     1322  if (node_regs_mask & (1<<0)) mark_root(regs[REG_EAX]);
     1323  if (node_regs_mask & (1<<1)) mark_root(regs[REG_EBX]);
     1324  if (node_regs_mask & (1<<2)) mark_root(regs[REG_ECX]);
     1325
     1326  if (regs[REG_EFL] & EFL_DF) {
     1327    /* DF set means EDX should be treated as an imm reg */
     1328    ;
     1329  } else
     1330    if (node_regs_mask & (1<<3)) mark_root(regs[REG_EDX]);
     1331
     1332  if (node_regs_mask & (1<<4)) mark_root(regs[REG_ESP]);
     1333  if (node_regs_mask & (1<<5)) mark_root(regs[REG_EBP]);
     1334  if (node_regs_mask & (1<<6)) mark_root(regs[REG_ESI]);
     1335  if (node_regs_mask & (1<<7)) mark_root(regs[REG_EDI]);
     1336
     1337  /* If the EIP isn't pointing into a marked function, we're probably
     1338     in trouble.  We can -maybe- recover from that if it's tagged as a
     1339     TRA. */
     1340  eip = regs[Ieip];
     1341  dnode = gc_area_dnode(eip);
     1342  if ((dnode < GCndnodes_in_area) &&
     1343      (! ref_bit(GCmarkbits,dnode))) {
     1344    if (fulltag_of(eip) == fulltag_tra) {
     1345      mark_root(eip);
     1346    } else if ((fulltag_of(eip) == fulltag_misc) &&
     1347               (header_subtag(header_of(eip)) == subtag_function) &&
     1348               (*(unsigned char *)eip == RECOVER_FN_OPCODE) &&
     1349               (*(LispObj *)(eip + 1)) == eip) {
     1350      mark_root(eip);
     1351    } else {
     1352      Bug(NULL, "Can't find function for eip 0x%4x", eip);
     1353    }
     1354  }
     1355}
     1356#endif
    11231357
    11241358/* A "pagelet" contains 32 doublewords.  The relocation table contains
     
    12181452}
    12191453#else
    1220 
     1454#ifdef X8664
    12211455/* Quicker, dirtier */
    12221456LispObj
     
    12441478  return new;
    12451479}
     1480#endif
     1481#ifdef X8632
     1482LispObj
     1483dnode_forwarding_address(natural dnode, int tag_n)
     1484{
     1485  natural pagelet, nbits;
     1486  unsigned short near_bits;
     1487  LispObj new;
     1488
     1489  if (GCDebug) {
     1490    if (! ref_bit(GCdynamic_markbits, dnode)) {
     1491      Bug(NULL, "unmarked object being forwarded!\n");
     1492    }
     1493  }
     1494
     1495  pagelet = dnode >> 5;
     1496  nbits = dnode & 0x1f;
     1497  /* On little-endian x86, we have to flip the low bit of dnode>>4 to
     1498     get the near_bits from the appropriate half-word. */
     1499  near_bits = ((unsigned short *)GCdynamic_markbits)[(dnode>>4)^1];
     1500
     1501  if (nbits < 16) {
     1502    new = GCrelocptr[pagelet] + tag_n;;
     1503    /* Increment "new" by the count of 1 bits which precede the dnode */
     1504    if (near_bits == 0xffff) {
     1505      return (new + (nbits << 3));
     1506    } else {
     1507      near_bits &= (0xffff0000 >> nbits);
     1508      if (nbits > 7) {
     1509        new += one_bits(near_bits & 0xff);
     1510      }
     1511      return (new + (one_bits(near_bits >> 8)));
     1512    }
     1513  } else {
     1514    new = GCrelocptr[pagelet+1] + tag_n;
     1515    nbits = 32-nbits;
     1516
     1517    if (near_bits == 0xffff) {
     1518      return (new - (nbits << 3));
     1519    } else {
     1520      near_bits &= (1<<nbits)-1;
     1521      if (nbits > 7) {
     1522        new -= one_bits(near_bits >> 8);
     1523      }
     1524      return (new - one_bits(near_bits & 0xff));
     1525    }
     1526  }
     1527}
     1528#endif
    12461529#endif
    12471530
     
    13161599      } else {
    13171600        if (header_subtag(node) == subtag_function) {
     1601#ifdef X8632
     1602          int skip = (unsigned short)(p[1]);
     1603#else
    13181604          int skip = (int)(p[1]);
     1605#endif
    13191606          p += skip;
    13201607          nwords -= skip;
     
    13801667}
    13811668
    1382 
     1669#ifdef X8664
    13831670void
    13841671forward_xp(ExceptionInformation *xp)
     
    13991686  update_locref(&(regs[Iip]));
    14001687}
     1688#else
     1689void
     1690forward_xp(ExceptionInformation *xp, natural node_regs_mask)
     1691{
     1692  natural *regs = (natural *) xpGPRvector(xp);
     1693
     1694  if (node_regs_mask & (1<<0)) update_noderef(&regs[REG_EAX]);
     1695  if (node_regs_mask & (1<<1)) update_noderef(&regs[REG_EBX]);
     1696  if (node_regs_mask & (1<<2)) update_noderef(&regs[REG_ECX]);
     1697
     1698  if (regs[REG_EFL] & EFL_DF) {
     1699    /* then EDX is an imm reg */
     1700    ;
     1701  } else
     1702    if (node_regs_mask & (1<<3)) update_noderef(&regs[REG_EDX]);
     1703
     1704  if (node_regs_mask & (1<<4)) update_noderef(&regs[REG_ESP]);
     1705  if (node_regs_mask & (1<<5)) update_noderef(&regs[REG_EBP]);
     1706  if (node_regs_mask & (1<<6)) update_noderef(&regs[REG_ESI]);
     1707  if (node_regs_mask & (1<<7)) update_noderef(&regs[REG_EDI]);
     1708
     1709  update_locref(&(regs[Iip]));
     1710}
     1711#endif
    14011712
    14021713
     
    14091720  xp = tcr->gc_context;
    14101721  if (xp) {
     1722#ifdef X8664
    14111723    forward_xp(xp);
     1724#else
     1725    forward_xp(xp, tcr->node_regs_mask);
     1726
     1727    update_noderef(&tcr->save0);
     1728    update_noderef(&tcr->save1);
     1729    update_noderef(&tcr->save2);
     1730    update_noderef(&tcr->save3);
     1731    update_noderef(&tcr->next_method_context);
     1732#endif
    14121733  }
    14131734  for (xframes = tcr->xframe; xframes; xframes = xframes->prev) {
     1735#ifdef X8664
    14141736    forward_xp(xframes->curr);
    1415   }
    1416 }
    1417 
    1418 
    1419 
     1737#else
     1738    forward_xp(xframes->curr, xframes->node_regs_mask);
     1739#endif
     1740  }
     1741}
     1742
     1743
     1744#ifdef X8632
     1745void
     1746update_self_references(LispObj *node)
     1747{
     1748  LispObj fn = fulltag_misc + (LispObj)node;
     1749  unsigned char *p = (unsigned char *)node;
     1750  natural i, offset;
     1751
     1752  i = ((unsigned short *)node)[2];
     1753  offset = node[--i];
     1754  while (offset) {
     1755    *(LispObj *)(p + offset) = fn;
     1756    offset = node[--i];
     1757  }   
     1758}
     1759#endif
    14201760
    14211761/*
     
    14801820          dnode += node_dnodes;
    14811821          if (header_subtag(node) == subtag_function) {
     1822#ifdef X8632
     1823            int skip = *((unsigned short *)src);
     1824            LispObj *f = dest;
     1825#else
    14821826            int skip = *((int *)src);
     1827#endif
    14831828            *dest++ = node;
    14841829            elements -= skip;
     
    14861831              *dest++ = *src++;
    14871832            }
     1833#ifdef X8632
     1834            update_self_references(f);
     1835#endif
    14881836            while(elements--) {
    14891837              *dest++ = node_forwarding_address(*src++);
     
    15411889          tag = header_subtag(node);
    15421890
    1543 
     1891#ifdef X8664
    15441892          switch(fulltag_of(tag)) {
    15451893          case ivector_class_64_bit:
     
    15581906            }
    15591907          }
     1908#endif
     1909#ifdef X8632
     1910          if (tag <= max_32_bit_ivector_subtag) {
     1911            imm_dnodes = (((elements+1)+1)>>1);
     1912          } else if (tag <= max_8_bit_ivector_subtag) {
     1913            imm_dnodes = (((elements+4)+7)>>3);
     1914          } else if (tag <= max_16_bit_ivector_subtag) {
     1915            imm_dnodes = (((elements+2)+3)>>2);
     1916          } else if (tag == subtag_bit_vector) {
     1917            imm_dnodes = (((elements+32)+63)>>6);
     1918          } else {
     1919            imm_dnodes = elements+1;
     1920          }
     1921#endif
     1922
    15601923          dnode += imm_dnodes;
    15611924          while (--imm_dnodes) {
     
    15721935        }
    15731936      }
    1574  
    1575     }
    1576 
     1937    }
    15771938  }
    15781939  return ptr_to_lispobj(dest);
     
    16071968        subtag = header_subtag(header);
    16081969
     1970#ifdef X8664
    16091971        switch(fulltag_of(header)) {
    16101972        case ivector_class_64_bit:
     
    16241986          }
    16251987        }
     1988#endif
     1989#ifdef X8632
     1990          if (subtag <= max_32_bit_ivector_subtag) {
     1991            bytes = 4 + (elements<<2);
     1992          } else if (subtag <= max_8_bit_ivector_subtag) {
     1993            bytes = 4 + elements;
     1994          } else if (subtag <= max_16_bit_ivector_subtag) {
     1995            bytes = 4 + (elements<<1);
     1996          } else if (subtag == subtag_double_float_vector) {
     1997            bytes = 8 + (elements<<3);
     1998          } else {
     1999            bytes = 4 + ((elements+7)>>3);
     2000          }
     2001#endif
     2002
    16262003        bytes = (bytes+dnode_size-1) & ~(dnode_size-1);
    16272004        total += bytes;
     
    17852162        } else {
    17862163          if (header_subtag(header) == subtag_function) {
     2164#ifdef X8632
     2165            int skip = (unsigned short)(start[1]);
     2166#else
    17872167            int skip = (int)(start[1]);
     2168#endif
    17882169            start += skip;
    17892170            nwords -= skip;
  • branches/working-0711/ccl/lisp-kernel/x86-macros.s

    r9991 r10389  
    4141
    4242define([box_fixnum],[
    43         __(imulq [$]fixnumone,$1,$2)
     43        __(imul [$]fixnumone,$1,$2)
    4444])     
    4545
     
    4747/* box_fixnum, with no effect on flags */
    4848define([box_fixnum_no_flags],[
    49         __(leaq (,$1,8),$2)
    50 ])
    51                                
     49        __(lea (,$1,fixnumone),$2)
     50])
     51
    5252
    5353/* Zero $3 bytes worth of dnodes, starting at offset $2 relative  */
     
    5858        .macro zero_dnodes
    5959        .if $2
     60        ifdef([X8664],[
    6061        __(movapd %fpzero,$1($0))
     62        ],[
     63        __(movsd %fpzero,$1($0))
     64        ])
    6165        __(zero_dnodes $0,$1+dnode_size,$2-dnode_size)
    6266        .endif
     
    6569        .macro zero_dnodes base,disp,nbytes
    6670        .ifgt \nbytes
     71        ifdef([X8664],[
    6772        movapd %fpzero,\disp(\base)
     73        ],[
     74        movsd %fpzero,\disp(\base)
     75        ])
    6876        zero_dnodes \base,"\disp+dnode_size","\nbytes-dnode_size"
    6977        .endif
     
    7482/* Allocate $1+dnode_size zeroed bytes on the tstack, using $2 as a temp  */
    7583/* reg.  */
    76        
     84
     85ifdef([X8632],[
     86define([TSP_Alloc_Fixed],[
     87        define([TSP_Alloc_Size],[((($1+node_size) & ~(dnode_size-1))+dnode_size)])
     88        __(subl [$]TSP_Alloc_Size,rcontext(tcr.next_tsp))
     89        __(movd rcontext(tcr.save_tsp),%stack_temp)
     90        __(movl rcontext(tcr.next_tsp),$2)
     91        zero_dnodes $2,0,TSP_Alloc_Size
     92        __(movd %stack_temp,($2))
     93        __(movl %ebp,tsp_frame.save_ebp($2))
     94        __(movl $2,rcontext(tcr.save_tsp))
     95        undefine([TSP_Alloc_Size])
     96])],[
    7797define([TSP_Alloc_Fixed],[
    7898        define([TSP_Alloc_Size],[((($1+node_size) & ~(dnode_size-1))+dnode_size)])
     
    85105        __(movq $2,rcontext(tcr.save_tsp))
    86106        undefine([TSP_Alloc_Size])
    87 ])
     107])])
    88108
    89109/* $1 = size (dnode-aligned, including tsp overhead, $2 scratch.  */
    90110/* Modifies both $1 and $2; on exit, $2 = new_tsp+tsp_overhead, $1 = old tsp  */
    91        
     111
     112ifdef([X8632],[
     113define([TSP_Alloc_Var],[
     114        new_macro_labels()
     115        __(subl $1,rcontext(tcr.next_tsp))
     116        __(movd rcontext(tcr.save_tsp),%stack_temp)
     117        __(movl rcontext(tcr.next_tsp),$2)
     118        __(jmp macro_label(test))
     119macro_label(loop):
     120        __(movsd %fpzero,0($2))
     121        __(addl $dnode_size,$2)
     122macro_label(test):
     123        __(subl $dnode_size,$1)
     124        __(jge macro_label(loop))
     125        __(movl rcontext(tcr.next_tsp),$2)
     126        __(movd %stack_temp,$1)
     127        __(movl $1,($2))
     128        __(movl %ebp,tsp_frame.save_ebp($2))
     129        __(movl $2,rcontext(tcr.save_tsp))
     130        __(addl $dnode_size,$2)
     131])],[
    92132define([TSP_Alloc_Var],[
    93133        new_macro_labels()
     
    108148        __(movq $2,rcontext(tcr.save_tsp))
    109149        __(addq $dnode_size,$2)
    110 ])
    111        
    112        
    113 
     150])])
     151       
     152       
     153ifdef([X8632],[
     154define([Allocate_Catch_Frame],[
     155        TSP_Alloc_Fixed(catch_frame.size,$1)
     156        __(movl [$](catch_frame.element_count<<subtag_shift)|subtag_catch_frame,dnode_size($1))
     157        __(addl [$]dnode_size+fulltag_misc,$1)
     158])],[
    114159define([Allocate_Catch_Frame],[
    115160        TSP_Alloc_Fixed(catch_frame.size,$1)
    116161        __(movq [$](catch_frame.element_count<<subtag_shift)|subtag_catch_frame,dnode_size($1))
    117162        __(addq [$]dnode_size+fulltag_misc,$1)
    118 ])
     163])])
    119164
    120165/* %arg_z = tag,  %xfn = pc, $1 = mvflag          */
    121        
     166
     167ifdef([X8632],[
     168define([Make_Catch],[
     169        Allocate_Catch_Frame(%imm0)
     170        __(movd rcontext(tcr.catch_top),%mm0)
     171        __(movd rcontext(tcr.db_link),%mm1)
     172        __(movl %arg_z,catch_frame.catch_tag(%imm0))
     173        __(movd %mm0,catch_frame.link(%imm0))
     174        __(movl [$]$1,catch_frame.mvflag(%imm0))
     175        __(movd rcontext(tcr.xframe),%mm0)
     176        __(movl %esp,catch_frame.esp(%imm0))
     177        __(movl %ebp,catch_frame.ebp(%imm0))
     178        __(movd rcontext(tcr.foreign_sp),%stack_temp)
     179        __(movd %stack_temp,catch_frame.foreign_sp(%imm0))
     180        __(movd %mm1,catch_frame.db_link(%imm0))
     181        __(movd %mm0,catch_frame.xframe(%imm0))
     182        __(movl %xfn,catch_frame.pc(%imm0))
     183        __(movl %imm0,rcontext(tcr.catch_top))
     184])],[
    122185define([Make_Catch],[
    123186        Allocate_Catch_Frame(%imm2)
     
    142205        __(movq %xfn,catch_frame.pc(%imm2))
    143206        __(movq %imm2,rcontext(tcr.catch_top))
    144 ])     
    145 
     207])])   
     208
     209ifdef([X8632],[
     210define([nMake_Catch],[
     211        Allocate_Catch_Frame(%imm0)
     212        __(movd rcontext(tcr.catch_top),%mm0)
     213        __(movd rcontext(tcr.db_link),%mm1)
     214        __(movl %arg_z,catch_frame.catch_tag(%imm0))
     215        __(movd %mm0,catch_frame.link(%imm0))
     216        __(movl %esp,catch_frame.esp(%imm0))
     217        __(addl $node_size,catch_frame.esp(%imm0))
     218        __(movl [$]$1,catch_frame.mvflag(%imm0))
     219        __(movd rcontext(tcr.xframe),%mm0)
     220        __(movl %ebp,catch_frame.ebp(%imm0))
     221        __(movd rcontext(tcr.foreign_sp),%stack_temp)
     222        __(movd %mm1,catch_frame.db_link(%imm0))
     223        __(movd %mm0,catch_frame.xframe(%imm0))
     224        __(movd %stack_temp,catch_frame.foreign_sp(%imm0))
     225        __(movl %xfn,catch_frame.pc(%imm0))
     226        __(movl %imm0,rcontext(tcr.catch_top))
     227])],[   
    146228define([nMake_Catch],[
    147229        Allocate_Catch_Frame(%imm2)
     
    167249        __(movq %xfn,catch_frame.pc(%imm2))
    168250        __(movq %imm2,rcontext(tcr.catch_top))
    169 ])     
     251])])   
    170252               
    171253       
     
    182264
    183265/* $1=new_car,$2=new_cdr,$3=dest   */
     266
     267ifdef([X8632],[
     268define([Cons],[
     269        new_macro_labels()
     270/* The instructions where tcr.save_allocptr is tagged are difficult  */
     271/* to interrupt; the interrupting code has to recognize and possibly  */
     272/* emulate the instructions in between   */
     273        __(subl $cons.size-fulltag_cons,rcontext(tcr.save_allocptr))
     274        __(movl rcontext(tcr.save_allocptr),%allocptr)
     275        __(rcmpl(%allocptr,rcontext(tcr.save_allocbase)))
     276        __(jg macro_label(no_trap))
     277        uuo_alloc()
     278macro_label(no_trap):
     279        __(andb $~fulltagmask,rcontext(tcr.save_allocptr))
     280/* Easy to interrupt now that tcr.save_allocptr isn't tagged as a cons    */
     281        __(movl $2,cons.cdr(%allocptr))
     282        __(movl $1,cons.car(%allocptr))
     283        ifelse($3,[],[],[
     284         __(movl %allocptr,$3)
     285        ])
     286])],[
     287
    184288define([Cons],[
    185289        new_macro_labels()
     
    200304         __(movq %allocptr,$3)
    201305        ])
    202 ])
    203 
    204 /* The header has to be in %imm0, and the physical size in bytes has  */
    205 /*  to be in %imm1. We bash %imm1.   */
    206 
     306])])
     307
     308ifdef([X8632],[
     309/* Header in %mm0, size in bytes in %imm0.  We bash %imm0. */
     310define([Misc_Alloc],[
     311        __(sub [$]fulltag_misc,%imm0)
     312        Misc_Alloc_Internal($1)
     313])],[
     314/* Header in %imm0, size in bytes in %imm1.  We bash %imm1. */
    207315define([Misc_Alloc],[
    208316        __(subq [$]fulltag_misc,%imm1)
    209317        Misc_Alloc_Internal($1)
    210 ])
    211 
    212 define([Misc_Alloc_Internal],[                 
     318])])
     319
    213320/* Here Be Monsters: we have to treat some/all of this instruction   */
    214321/* sequence atomically, as soon as tcr.save_allocptr becomes tagged.  */
    215322               
     323ifdef([X8632],[
     324define([Misc_Alloc_Internal],[                 
     325        new_macro_labels()
     326        __(subl %imm0,rcontext(tcr.save_allocptr))
     327        __(movl rcontext(tcr.save_allocptr),%allocptr)
     328        __(cmpl rcontext(tcr.save_allocbase),%allocptr)
     329        __(jg macro_label(no_trap))
     330        uuo_alloc()
     331macro_label(no_trap):   
     332        __(movd %mm0,misc_header_offset(%allocptr))
     333        __(andb $~fulltagmask,rcontext(tcr.save_allocptr))
     334/* Now that tcr.save_allocptr is untagged, it's easier to be interrupted   */
     335        ifelse($1,[],[],[
     336         __(mov %allocptr,$1)
     337        ])
     338])],[   
     339define([Misc_Alloc_Internal],[                 
    216340        new_macro_labels()
    217341        __(subq %imm1,rcontext(tcr.save_allocptr))
     
    227351         __(mov %allocptr,$1)
    228352        ])
    229 ])
    230        
     353])])
     354
     355ifdef([X8632],[
     356define([Misc_Alloc_Fixed],[
     357        __(mov [$]$2-fulltag_misc,%imm0)
     358        Misc_Alloc_Internal($1)
     359])],[
    231360define([Misc_Alloc_Fixed],[
    232361        __(movq [$]$2-fulltag_misc,%imm1)
    233362        Misc_Alloc_Internal($1)
    234 ])                                     
     363])])                                   
    235364
    236365define([vrefr],[
     
    239368
    240369define([jump_fn],[
    241         __(jmpq *%fn)
     370        __(jmp *%fn)
    242371])
    243372                       
     
    246375        jump_fn()
    247376])     
    248        
     377
     378ifdef([X8632],[
     379define([set_nargs],[
     380        __(xorl %nargs,%nargs)
     381        __(addl [$]$1<<fixnumshift,%nargs)
     382])],[
    249383define([set_nargs],[
    250384        ifelse(eval($1>15),1,[
     
    255389        __(addl [$]$1<<fixnumshift,%nargs)
    256390        ])])])
    257        
    258 
     391])
    259392
    260393/* $1 = ndigits.  Assumes 4-byte digits           */
     
    263396
    264397define([_car],[
    265         __(movq cons.car($1),$2)
     398        __(mov cons.car($1),$2)
    266399])     
    267400
    268401define([_rplaca],[
    269         __(movq $2,cons.car($1))
     402        __(mov $2,cons.car($1))
    270403])     
    271404               
    272405define([_cdr],[
    273         __(movq cons.cdr($1),$2)
     406        __(mov cons.cdr($1),$2)
    274407])
    275408
    276409define([_rplacd],[
    277         __(movq $2,cons.cdr($1))
     410        __(mov $2,cons.cdr($1))
    278411])     
    279412               
    280413       
    281414       
     415ifdef([X8632],[
     416define([tra],[
     417        .p2align 3
     418        .long 0
     419        .byte 0
     420$1:     
     421])],[
    282422define([tra],[
    283423        .p2align 3
     
    288428        ])
    289429$1:     
    290 ])
    291                                
     430])])
     431
     432ifdef([X8632],[
     433define([do_funcall],[
     434        new_macro_labels()
     435        extract_fulltag(%temp0,%imm0)
     436        __(cmpb $fulltag_misc,%imm0_b)
     437        __(jne macro_label(bad))
     438        __(cmpb $subtag_function,misc_subtag_offset(%temp0))
     439        __(jne macro_label(maybe_symbol))
     440        __(mov %temp0,%fn)
     441        __(jmp *%fn)
     442macro_label(maybe_symbol):
     443        __(cmpb $subtag_symbol,misc_subtag_offset(%temp0))
     444        __(jne macro_label(bad))
     445        /* %fname == %temp0 */
     446        __(mov symbol.fcell(%fname),%fn)
     447        __(jmp *%fn)
     448macro_label(bad):
     449        __(uuo_error_not_callable)
     450])],[
    292451define([do_funcall],[
    293452        new_macro_labels()
     
    302461macro_label(bad):               
    303462        __(uuo_error_not_callable)
    304 ])
     463])])
    305464
    306465define([getvheader],[
    307         __(movq misc_header_offset($1),$2)
     466        __(mov misc_header_offset($1),$2)
    308467])
    309468
     
    311470/*    both be immediate registers   */
    312471define([header_size],[
    313         __(movq $1,$2)
     472        __(mov $1,$2)
    314473        __(shr $num_subtag_bits,$2)
    315474])
     
    317476/* $2 (length) is fixnum element-count.   */
    318477define([header_length],[
    319         __(movq $~255,$2)
    320         __(andq $1,$2)
     478        __(mov $~255,$2)
     479        __(and $1,$2)
    321480        __(shr $num_subtag_bits-fixnumshift,$2)
    322481])
     
    324483/* $1 = vector, $2 = header, $3 = dest   */
    325484define([vector_size],[                                 
    326         getvheader($1,$2)
    327         header_size($2,$3)
     485        __(getvheader($1,$2))
     486        __(header_size($2,$3))
    328487])
    329488
    330489/* $1 = vector, $2 = dest   */
    331490define([vector_length],[                                 
    332         __(movq $~255,$2)
    333         __(andq misc_header_offset($1),$2)
     491        __(mov $~255,$2)
     492        __(and misc_header_offset($1),$2)
    334493        __(shr $num_subtag_bits-fixnumshift,$2)
    335494])
     
    359518])
    360519
     520ifdef([X8632],[
     521define([compare_reg_to_nil],[
     522        __(cmp $nil_value,$1)
     523])],[
    361524define([compare_reg_to_nil],[
    362525        __(cmpb $fulltag_nil,$1_b)
    363 ])             
    364        
     526])])
     527
     528ifdef([X8632],[
     529define([extract_lisptag],[
     530        __(movl $1,$2)
     531        __(and [$]tagmask,$2)
     532])],[
    365533define([extract_lisptag],[
    366534        __(movzbl $1_b,$2_l)
    367535        __(andb [$]tagmask,$2_b)
    368 ])
     536])])
    369537
    370538                                                               
     
    378546])
    379547
     548ifdef([X8632],[
     549define([extract_typecode],[
     550        new_macro_labels()
     551        __(mov $1,$2)
     552        __(andl $tagmask,$2)
     553        __(cmpb $tag_misc,$2_b)
     554        __(jne macro_label(done))
     555        __(movb misc_subtag_offset($1),$2_b)
     556macro_label(done):
     557])],[
    380558define([extract_typecode],[
    381559        new_macro_labels()
     
    385563        __(jne macro_label(done))
    386564        __(movb misc_subtag_offset($1),$2_b)
    387 macro_label(done):     
    388 ])
     565macro_label(done):
     566])])
    389567
    390568/* dnode_align(src,delta,dest)  */
    391569
    392         define([dnode_align],[
     570define([dnode_align],[
    393571        __(lea ($2+(dnode_size-1))($1),$3)
    394572        __(andb $~(dnode_size-1),$3_b)
    395573])
    396        
     574
     575ifdef([X8632],[
     576define([push_argregs],[
     577        new_macro_labels()
     578        /* xxx hack alert: when the compiler calls a keyword subprim */
     579        /* (SPsimple_keywords, SPkeyword_args, SP_keyword_bind) */
     580        /* it puts some flags in the upper half of %temp1, which
     581        /* is %nargs.  We use the cmpw here to avoid seeing those flags. */
     582        __(cmpw [$]1*node_size,%nargs_w)
     583        __(jb macro_label(done))
     584        __(je macro_label(z))
     585        __(push %arg_y)
     586macro_label(z):
     587        __(push %arg_z)
     588macro_label(done):
     589])],[
    397590define([push_argregs],[
    398591        new_macro_labels()
     
    408601        __(push %arg_z)
    409602macro_label(done):
    410 ])     
     603])])   
    411604
    412605
     
    415608
    416609define([discard_temp_frame],[
    417         __(movq rcontext(tcr.save_tsp),$1)
    418         __(movq ($1),$1)
    419         __(movq $1,rcontext(tcr.save_tsp))
    420         __(movq $1,rcontext(tcr.next_tsp))
    421 
    422 ])     
    423 
     610        __(mov rcontext(tcr.save_tsp),$1)
     611        __(mov ($1),$1)
     612        __(mov $1,rcontext(tcr.save_tsp))
     613        __(mov $1,rcontext(tcr.next_tsp))
     614])
     615
     616ifdef([X8632],[
     617define([check_pending_enabled_interrupt],[
     618        __(btrl [$]31,rcontext(tcr.interrupt_pending))
     619        __(jnc $1)
     620        interrupt_now()
     621])],[
    424622define([check_pending_enabled_interrupt],[
    425623        __(btrq [$]63,rcontext(tcr.interrupt_pending))
    426         __(jnc,pt $1)
     624        __(jnc $1)
    427625        interrupt_now()
    428 ])
     626])])
    429627       
    430628/* $1 = scratch register, used to access tcr.tlb_pointer.  An interrupt  */
     
    435633define([check_pending_interrupt],[
    436634        new_macro_labels()
    437         __(movq rcontext(tcr.tlb_pointer),$1)
    438         __(cmpq [$]0,INTERRUPT_LEVEL_BINDING_INDEX($1))
    439         __(js,pt macro_label(done))
     635        __(mov rcontext(tcr.tlb_pointer),$1)
     636        __(cmp [$]0,INTERRUPT_LEVEL_BINDING_INDEX($1))
     637        __(js macro_label(done))
    440638        check_pending_enabled_interrupt(macro_label(done))
    441639macro_label(done):
     
    480678        __(ret)
    481679])
    482                                
    483        
     680
     681ifdef([X8632],[
     682define([regnum],[ifelse($1, [%eax], [0],
     683       $1, [%ecx], [1],
     684       $1, [%edx], [2],
     685       $1, [%ebx], [3],
     686       $1, [%esp], [4],
     687       $1, [%ebp], [5],
     688       $1, [%esi], [6],
     689       $1, [%edi], [7],
     690        "unknown register")dnl
     691])
     692
     693define([mark_as_node], [
     694        __(xorl $1,$1)
     695        __(orb [$](1<<regnum($1)), rcontext(tcr.node_regs_mask))
     696])
     697
     698define([mark_as_imm],[
     699        __(andb [$]~(1<<regnum($1)), rcontext(tcr.node_regs_mask))
     700])
     701])
     702
  • branches/working-0711/ccl/lisp-kernel/x86-spentry64.s

    r9992 r10389  
    7070        __(sarq $fixnumshift,%imm1)
    7171        __(cmpq %imm1,%imm0)
    72         __(jz,pt 0f)
     72        __(jz 0f)
    7373        __(movd %imm0,%mm0)
    7474        __(movq $two_digit_bignum_header,%imm0)
     
    15401540        __(movq symbol.binding_index(%arg_y),%temp0)
    15411541        __(cmpq rcontext(tcr.tlb_limit),%temp0)
    1542         __(jb,pt 0f)
     1542        __(jb 0f)
    15431543        __(push %temp0)
    15441544        __(tlb_too_small())
     
    15651565        __(movq symbol.binding_index(%arg_z),%temp0)
    15661566        __(cmpq rcontext(tcr.tlb_limit),%temp0)
    1567         __(jb,pt 0f)
     1567        __(jb 0f)
    15681568        __(push %temp0)
    15691569        __(tlb_too_small())
     
    15941594        __(movq symbol.binding_index(%arg_z),%temp0)
    15951595        __(cmpq rcontext(tcr.tlb_limit),%temp0)
    1596         __(jb,pt 0f)
     1596        __(jb 0f)
    15971597        __(push %temp0)
    15981598        __(tlb_too_small())
     
    16151615        __(movq symbol.binding_index(%arg_z),%temp0)
    16161616        __(cmpq rcontext(tcr.tlb_limit),%temp0)
    1617         __(jb,pt 0f)
     1617        __(jb 0f)
    16181618        __(push %temp0)
    16191619        __(tlb_too_small())
     
    19561956        __(movq symbol.binding_index(%arg_x),%arg_x)
    19571957        __(cmp rcontext(tcr.tlb_limit),%arg_x)
    1958         __(jb,pt 4f)
     1958        __(jb 4f)
    19591959        __(push %arg_x)
    19601960        __(tlb_too_small())
     
    23262326        __(discard_temp_frame(%imm0))
    23272327        __(btq $keyword_flags_unknown_keys_bit,%temp1)
    2328         __(jnc,pt 9f)
     2328        __(jnc 9f)
    23292329        __(btq $keyword_flags_aok_bit,%temp1)
    2330         __(jc,pt 9f)
     2330        __(jc 9f)
    23312331        /* Signal an "unknown keywords" error   */
    23322332        __(movq %imm1,%nargs_q)
     
    34273427        __(movq %rsp,rcontext(tcr.db_link))
    34283428        __(movq $0,INTERRUPT_LEVEL_BINDING_INDEX(%temp1))
    3429         __(js,pn 1f)
     3429        __(js 1f)
    343034300:      __(jmp *%ra0)
    34313431        /* Interrupt level was negative; interrupt may be pending   */
     
    34763476        __(movq %temp0,INTERRUPT_LEVEL_BINDING_INDEX(%arg_x))
    34773477        __(movq %imm1,rcontext(tcr.db_link))
    3478         __(js,pn 3f)
     3478        __(js 3f)
    347934792:      __(repret)
    348034803:      __(testq %temp0,%temp0)
     
    35133513        __(jne 1f)
    35143514        __(addq %arg_y,%arg_z)
    3515         __(jo,pn C(fix_one_bit_overflow))
     3515        __(jo C(fix_one_bit_overflow))
    35163516        __(repret)
    351735171:      __(jump_builtin(_builtin_plus,2))
     
    35283528        __(xchgq %arg_y,%arg_z)
    35293529        __(subq %arg_y,%arg_z)
    3530         __(jo,pn C(fix_one_bit_overflow))
     3530        __(jo C(fix_one_bit_overflow))
    35313531        __(repret)
    353235321:      __(jump_builtin(_builtin_minus,2))
     
    38073807        __(jne 1f)
    38083808        __(negq %arg_z)
    3809         __(jo,pn C(fix_one_bit_overflow))
     3809        __(jo C(fix_one_bit_overflow))
    38103810        __(repret)
    381138111:             
     
    40374037        __ifdef([DARWIN])
    40384038        __(btrq $TCR_FLAG_BIT_FOREIGN_EXCEPTION,rcontext(tcr.flags))
    4039         __(jc,pn 0f)
     4039        __(jc 0f)
    40404040        __endif
    40414041        __(ret)
     
    42544254        __ifdef([DARWIN])
    42554255        __(btrq $TCR_FLAG_BIT_FOREIGN_EXCEPTION,rcontext(tcr.flags))
    4256         __(jc,pn 0f)
     4256        __(jc 0f)
    42574257        __endif
    42584258        __(ret)
     
    47664766        __(lea (%nargs_q,%imm0),%imm1)
    47674767        __(cmpl $nargregs<<fixnumshift,%imm1_l)
    4768         __(jna,pt local_label(regs_only))
     4768        __(jna local_label(regs_only))
    47694769        __(pop %ra0)
    47704770        __(cmpl $nargregs<<fixnumshift,%nargs)
    4771         __(jna,pt local_label(no_insert))
     4771        __(jna local_label(no_insert))
    47724772       
    47734773/* Some arguments have already been pushed.  Push imm0's worth   */
  • branches/working-0711/ccl/lisp-kernel/x86_print.c

    r9994 r10389  
    266266}
    267267
     268#ifdef X8632
     269LispObj
     270nth_immediate(LispObj o, unsigned n)
     271{
     272  u16_t imm_word_count = *(u16_t *)(o + misc_data_offset);
     273  natural *constants = (natural *)((char *)o + misc_data_offset + (imm_word_count << 2));
     274  LispObj result = (LispObj)(constants[n-1]);
     275
     276  return result;
     277}
     278#endif
     279
    268280void
    269281sprint_function(LispObj o, int depth)
     
    303315      sprint_specializers_list(method_specializers, depth);
    304316      add_char(' ');
     317    } else if (lfbits & lfbits_gfn_mask) {
     318      LispObj gf_slots;
     319      LispObj gf_name;
     320
     321      add_c_string("Generic Function ");
     322
     323#ifdef X8632
     324      gf_slots = nth_immediate(o, 2);
     325      gf_name = deref(gf_slots, 2);
     326      sprint_lisp_object(gf_name, depth);
     327      add_char(' ');
     328#endif
    305329    } else {
    306330      add_c_string("Function ");
     
    316340sprint_tra(LispObj o, int depth)
    317341{
     342#ifdef X8664
    318343  signed sdisp;
    319344  unsigned disp = 0;
     
    336361    sprint_unsigned_hex(o);
    337362  }
     363#else
     364  LispObj f = 0;
     365  unsigned disp = 0;
     366
     367  if (*(unsigned char *)o == RECOVER_FN_OPCODE) {
     368    f = (LispObj)(*((natural *)(o + 1)));
     369    disp = o - f;
     370  }
     371
     372  if (f && header_subtag(header_of(f)) == subtag_function) {
     373    add_c_string("tagged return address: ");
     374    sprint_function(f, depth);
     375    add_c_string(" + ");
     376    sprint_unsigned_decimal(disp);
     377  } else {
     378    add_c_string("(tra ?) : ");
     379    sprint_unsigned_hex(o);
     380  }
     381#endif
    338382}
    339383               
     
    473517    case fulltag_nodeheader_1:
    474518#else
     519    case fulltag_immheader:
     520    case fulltag_nodeheader:
    475521#endif     
    476522      add_c_string("#<header ? ");
     
    483529    case fulltag_imm_1:
    484530#else
     531    case fulltag_imm:
    485532#endif
    486533      if (o == unbound) {
     
    493540            add_char(c);
    494541          } else {
    495             sprintf(numbuf, "%o", c);
     542            sprintf(numbuf, "%#o", c);
    496543            add_c_string(numbuf);
    497544          }
     
    511558      }
    512559      break;
    513    
     560
     561#ifdef X8664
    514562    case fulltag_nil:
     563#endif
    515564    case fulltag_cons:
    516565      sprint_list(o, depth);
     
    521570      break;
    522571
     572#ifdef X8664
    523573    case fulltag_symbol:
    524574      sprint_symbol(o);
     
    528578      sprint_function(o, depth);
    529579      break;
    530 
     580#endif
     581
     582#ifdef X8664
    531583    case fulltag_tra_0:
    532584    case fulltag_tra_1:
     585#else
     586    case fulltag_tra:
     587#endif
    533588      sprint_tra(o,depth);
    534589      break;
  • branches/working-0711/ccl/lisp-kernel/xlbt.c

    r9995 r10389  
    2929    pc = frame->xtra;
    3030  }
     31#ifdef X8632
     32  if (fulltag_of(pc) == fulltag_tra) {
     33    if (*((unsigned char *)pc) == RECOVER_FN_OPCODE) {
     34      natural n = *((natural *)(pc + 1));
     35      fun = (LispObj)n;
     36    }
     37    if (fun && header_subtag(header_of(fun)) == subtag_function) {
     38      delta = pc - fun;
     39      Dprintf("(#x%08X) #x%08X : %s + %d", frame, pc, print_lisp_object(fun), delta);
     40      return;
     41    }
     42  }
     43  if (pc == 0) {
     44    fun = ((xcf *)frame)->nominal_function;
     45    Dprintf("(#x%08X) #x%08X : %s + ??", frame, pc, print_lisp_object(fun));
     46    return;
     47  }
     48#else
    3149  if (tag_of(pc) == tag_tra) {
    3250    if ((*((unsigned short *)pc) == RECOVER_FN_FROM_RIP_WORD0) &&
     
    4664    return;
    4765  }
     66#endif
    4867}
    4968
     
    5978    }
    6079
     80#ifdef X8632
     81    if (fulltag_of(ra) == fulltag_tra) {
     82#else
    6183    if (tag_of(ra) == tag_tra) {
     84#endif
    6285      return true;
    6386    } else if ((ra == lisp_global(LEXPR_RETURN)) ||
     
    126149    if ((((LispObj) ptr_to_lispobj(vs_area->low)) > currentRBP) ||
    127150        (((LispObj) ptr_to_lispobj(vs_area->high)) < currentRBP)) {
     151#ifdef X8664
    128152      currentRBP = (LispObj) (tcr->save_rbp);
     153#else
     154      currentRBP = (LispObj) (tcr->save_ebp);
     155#endif
    129156    }
    130157    if ((((LispObj) ptr_to_lispobj(vs_area->low)) > currentRBP) ||
     
    143170plbt(ExceptionInformation *xp)
    144171{
     172#ifdef X8632
     173  plbt_sp(xpGPR(xp,Iebp));
     174#else
    145175  plbt_sp(xpGPR(xp,Irbp));
     176#endif
    146177}
Note: See TracChangeset for help on using the changeset viewer.