Changeset 13737


Ignore:
Timestamp:
May 24, 2010, 7:49:19 PM (9 years ago)
Author:
gb
Message:

Get the kernel to compile/link/run on ARM Linux; remove some PPC-isms and
add some ARM-isms, though there's likely more of the latter to be done
to support exceptions/GC.

Raise subprim addresses to start at #x9000, since some distributions
set vm.mmap_min_addr to #x8000 and others act as if they do. This means
that some subprims (whose addresses are above #x10000) will be spaced 1K
apart; maybe not so bad for keyword handling/FFI/some other things.

Re-partition UUOs, so that those that require direct action from a kernel
handler are easier to distinguish from lisp-level errors.

Location:
branches/arm/lisp-kernel
Files:
18 edited

Legend:

Unmodified
Added
Removed
  • branches/arm/lisp-kernel/albt.c

    r13718 r13737  
    152152    spname = "unknown ?";
    153153#ifndef STATIC
    154     if (dladdr((void *)ptr_from_lispobj(pc), &info)) {
     154    if (dladdr((void *)ptr_from_lispobj(rpc), &info)) {
    155155      spname = (char *)(info.dli_sname);
    156156#ifdef DARWIN
     
    170170     
    171171      if ((rpc >= (code_vector+misc_data_offset)) &&
    172           (pc < ((code_vector+misc_data_offset)+(header_element_count(header_of(code_vector))<<2)))) {
     172          (rpc < ((code_vector+misc_data_offset)+(header_element_count(header_of(code_vector))<<2)))) {
    173173        delta = (rpc - (code_vector+misc_data_offset));
    174174      }
  • branches/arm/lisp-kernel/arm-asmutils.s

    r13725 r13737  
    2323
    2424/* Force data from r0 to r1 into the icache */       
    25 _exportfn(C(_make_data_executable))
     25_exportfn(C(flush_cache_lines))
    2626        __(mov r2,#0)           /* options.  Pass as 0 until we know better */
    2727        __(mov r12,r7)          /* preserve r7 ;  r12 saved by syscall */
     
    3232        __(bx lr)
    3333
     34_exportfn(C(touch_page))
     35        __(str r0,[r0,#0])
     36        __(mov r1,#0)
     37        __(str r1,[r0,#0])
     38        __(mov r0,#1)
     39        .globl C(touch_page_end)
     40C(touch_page_end):     
     41        __(bx lr)
     42_endfn       
    3443                               
    3544_exportfn(C(current_stack_pointer))
     
    134143        __endif
    135144       
    136        
     145_exportfn(save_fp_context)
     146_endfn         
     147_exportfn(restore_fp_context)
     148_endfn         
     149_exportfn(put_vector_registers)
     150_endfn         
     151_exportfn(get_vector_registers)
     152_endfn         
    137153
     154       
    138155
    139156        _endfile
  • branches/arm/lisp-kernel/arm-constants.h

    r13717 r13737  
    264264} xframe_list;
    265265
     266
     267#define fixnum_bitmask(n)  (1<<((n)+fixnumshift))
     268
    266269#include "lisp-errors.h"
    267270
     
    287290  struct area *cs_area;         /* cstack area pointer */
    288291  struct area *vs_area;         /* vstack area pointer */
    289   struct area *ts_area;         /* tstack area pointer */
     292  lisp_frame *last_lisp_frame;  /* when in foreign code */
    290293  LispObj cs_limit;             /* stack overflow limit */
    291294  unsigned long long bytes_allocated;
     
    331334#define STATIC_BASE_ADDRESS 0x0ffff000
    332335
    333 
    334 
     336#define PSR_N_MASK (1<<31)
     337#define PSR_Z_MASK (1<<30)
     338#define PSR_C_MASK (1<<29)
     339#define PSR_V_MASK (1<<28)
  • branches/arm/lisp-kernel/arm-constants.s

    r13724 r13737  
    591591         _node(cs_area)         /* cstack area pointer */
    592592         _node(vs_area)         /* vstack area pointer */
    593          _node(ts_area)         /* tstack area pointer */
     593         _node(last_lisp_frame) /* when in foreign code */
    594594         _node(cs_limit)        /* cstack overflow limit */
    595595         _node(bytes_consed_high)
     
    760760                       
    761761INTERRUPT_LEVEL_BINDING_INDEX = fixnumone
     762VOID_ALLOCPTR = 0xfffffff8
  • branches/arm/lisp-kernel/arm-exceptions.c

    r13716 r13737  
    11/*
    2    Copyright (C) 2009 Clozure Associates
    3    Copyright (C) 1994-2001 Digitool, Inc
     2   Copyright (C) 2010 Clozure Associates
    43   This file is part of Clozure CL. 
    54
     
    3534#ifdef DARWIN
    3635#include <sys/mman.h>
    37 #define _FPU_RESERVED 0xffffff00
    3836#ifndef SA_NODEFER
    3937#define SA_NODEFER 0
     
    112110{
    113111  pc program_counter = xpPC(xp);
    114   opcode instr = *program_counter, prev_instr = *(program_counter-1);
    115 
    116   if (instr == ALLOC_TRAP_INSTRUCTION) {
    117     if (match_instr(prev_instr,
    118                     XO_MASK | RT_MASK | RB_MASK,
    119                     XO(major_opcode_X31,minor_opcode_SUBF, 0, 0) |
    120                     RT(allocptr) |
    121                     RB(allocptr))) {
    122       return ((signed_natural) xpGPR(xp, RA_field(prev_instr)));
    123     }
    124     if (match_instr(prev_instr,
    125                     OP_MASK | RT_MASK | RA_MASK,
    126                     OP(major_opcode_ADDI) |
    127                     RT(allocptr) |
    128                     RA(allocptr))) {
    129       return (signed_natural) -((short) prev_instr);
     112  opcode instr = *program_counter, prev_instr;
     113
     114  if (IS_ALLOC_TRAP(instr)) {
     115    /* The alloc trap must have been preceded by a cmp and a
     116       load from tcr.allocbase. */
     117    prev_instr = program_counter[-3];
     118
     119    if (IS_SUB_RM_FROM_ALLOCPTR(prev_instr)) {
     120      return -((signed_natural)xpGPR(xp,RM_field(prev_instr)));
     121    }
     122   
     123    if (IS_SUB_LO_FROM_ALLOCPTR(prev_instr)) {
     124      return -((signed_natural)(prev_instr & 0xff));
     125    }
     126
     127    if (IS_SUB_FROM_ALLOCPTR(prev_instr)) {
     128      natural disp = ror(prev_instr&0xff,(prev_instr&0xf00)>>7);
     129
     130      instr = program_counter[-4];
     131      if (IS_SUB_LOW_FROM_ALLOCPTR(instr)) {
     132        return -((signed_natural)(disp | (instr & 0xff)));
     133      }
    130134    }
    131135    Bug(xp, "Can't determine allocation displacement");
     
    158162    instr = *program_counter++;
    159163
    160     if (instr == UNTAG_ALLOCPTR_INSTRUCTION) {
     164    if (IS_CLR_ALLOCPTR_TAG(instr)) {
    161165      xpGPR(xp, allocptr) = untag(cur_allocptr);
    162166      xpPC(xp) = program_counter;
    163167      return;
    164     }
    165    
    166     switch (instr & STORE_CXR_ALLOCPTR_MASK) {
    167     case STORE_CAR_ALLOCPTR_INSTRUCTION:
    168       c->car = xpGPR(xp,RT_field(instr));
    169       break;
    170     case STORE_CDR_ALLOCPTR_INSTRUCTION:
    171       c->cdr = xpGPR(xp,RT_field(instr));
    172       break;
    173     default:
    174       /* Assume that this is an assignment: {rt/ra} <- allocptr.
    175          There are several equivalent instruction forms
    176          that might have that effect; just assign to target here.
    177       */
    178       if (major_opcode_p(instr,major_opcode_X31)) {
    179         target_reg = RA_field(instr);
    180       } else {
    181         target_reg = RT_field(instr);
    182       }
    183       xpGPR(xp,target_reg) = cur_allocptr;
    184       break;
     168    } else if (IS_SET_ALLOCPTR_CAR_RD(instr)) {
     169      c->car = xpGPR(xp,RD_field(instr));
     170    } else if (IS_SET_ALLOCPTR_CDR_RD(instr)) {
     171      c->cdr = xpGPR(xp,RD_field(instr));
     172    } else {
     173      /* assert(IS_SET_ALLOCPTR_RESULT_RD(instr)) */
     174      xpGPR(xp,RD_field(instr)) = cur_allocptr;
    185175    }
    186176  }
     
    205195  while (1) {
    206196    instr = *program_counter++;
    207     if (instr == UNTAG_ALLOCPTR_INSTRUCTION) {
     197    if (IS_CLR_ALLOCPTR_TAG(instr)) {
    208198      xpGPR(xp, allocptr) = untag(cur_allocptr);
    209199      xpPC(xp) = program_counter;
    210200      return;
    211201    }
    212     if ((instr &  STORE_HEADER_ALLOCPTR_MASK) ==
    213         STORE_HEADER_ALLOCPTR_INSTRUCTION) {
    214       header_of(cur_allocptr) = xpGPR(xp, RT_field(instr));
     202    if (IS_SET_ALLOCPTR_HEADER_RD(instr)) {
     203      header_of(cur_allocptr) == xpGPR(xp,RD_field(instr));
     204    } else if (IS_SET_ALLOCPTR_RESULT_RD(instr)) {
     205      xpGPR(xp,RD_field(instr)) = cur_allocptr;
    215206    } else {
    216       /* assume that this is an assignment */
    217 
    218       if (major_opcode_p(instr,major_opcode_X31)) {
    219         target_reg = RA_field(instr);
    220       } else {
    221         target_reg = RT_field(instr);
    222       }
    223       xpGPR(xp,target_reg) = cur_allocptr;
     207      Bug(xp, "Unexpected instruction following alloc trap at " LISP ":",program_counter);
    224208    }
    225209  }
     
    247231  if (new_heap_segment(xp, bytes_needed, false, tcr)) {
    248232    xpGPR(xp, allocptr) += disp_from_allocptr;
    249 #ifdef DEBUG
    250     fprintf(dbgout, "New heap segment for #x%x, no GC: #x%x/#x%x, vsp = #x%x\n",
    251             tcr,xpGPR(xp,allocbase),tcr->last_allocptr, xpGPR(xp,vsp));
    252 #endif
    253233    return true;
    254234  }
     
    266246  if (new_heap_segment(xp, bytes_needed, true, tcr)) {
    267247    xpGPR(xp, allocptr) += disp_from_allocptr;
    268 #ifdef DEBUG
    269     fprintf(dbgout, "New heap segment for #x%x after GC: #x%x/#x%x\n",
    270             tcr,xpGPR(xp,allocbase),tcr->last_allocptr);
    271 #endif
    272248    return true;
    273249  }
     
    300276  */
    301277  xpGPR(xp,allocptr) = xpGPR(xp,allocbase) = VOID_ALLOCPTR;
    302   handle_error(xp, bytes_needed < (128<<10) ? XNOMEM : error_alloc_failed, 0, 0,  xpPC(xp));
     278  handle_error(xp, bytes_needed < (128<<10) ? XNOMEM : error_alloc_failed,0);
    303279}
    304280
     
    370346
    371347  case fulltag_misc:
    372     if (match_instr(prev_instr,
    373                     XO_MASK | RT_MASK | RB_MASK,
    374                     XO(major_opcode_X31,minor_opcode_SUBF, 0, 0) |
    375                     RT(allocptr) |
    376                     RB(allocptr))) {
    377       disp = -((signed_natural) xpGPR(xp, RA_field(prev_instr)));
    378     } else if (match_instr(prev_instr,
    379                            OP_MASK | RT_MASK | RA_MASK,
    380                            OP(major_opcode_ADDI) |
    381                            RT(allocptr) |
    382                            RA(allocptr))) {
    383       disp = (signed_natural) ((short) prev_instr);
    384     }
    385     if (disp) {
    386       bytes_needed = (-disp) + fulltag_misc;
    387       break;
    388     }
     348    disp = allocptr_displacement(xp);
     349    bytes_needed = (-disp) + fulltag_misc;
     350    break;
     351
    389352    /* else fall thru */
    390353  default:
     
    564527  lisp_global(CS_OVERFLOW_LIMIT) = CS_OVERFLOW_FORCE_LIMIT; /* force unsigned traps to fail */
    565528#endif
    566   handle_error(xp, error_stack_overflow, reg, 0,  xpPC(xp));
     529  handle_error(xp, error_stack_overflow, reg);
    567530}
    568531
     
    593556
    594557  switch (stkreg) {
    595   case sp:
     558  case Rsp:
    596559    a = tcr->cs_area;
    597560    if ((a->softlimit - 4096) > (a->hardlimit + 16384)) {
     
    604567    adjust_soft_protection_limit(a);
    605568    break;
    606   case tsp:
    607     a = tcr->ts_area;
    608     adjust_soft_protection_limit(a);
    609569  }
    610570}
     
    619579
    620580  tcr->save_allocptr = (void *) ptr_from_lispobj(xpGPR(xp, allocptr));
    621   tcr->save_allocbase = (void *) ptr_from_lispobj(xpGPR(xp, allocbase));
    622581
    623582  tcr->save_vsp = (LispObj *) ptr_from_lispobj(((lisp_frame *)ptr_from_lispobj(last_catch->csp))->savevsp);
    624   tcr->save_tsp = (LispObj *) ptr_from_lispobj((LispObj) ptr_to_lispobj(last_catch)) - (2*node_size); /* account for TSP header */
    625583
    626584  start_lisp(tcr, 1);
     
    665623  tcr->last_allocptr = (void *)newlimit;
    666624  xpGPR(xp,allocptr) = (LispObj) newlimit;
    667   xpGPR(xp,allocbase) = (LispObj) oldlimit;
     625  tcr->save_allocbase = (void*) oldlimit;
    668626
    669627  return true;
     
    699657  }
    700658  if (xp) {
    701     bp = (LispObj *) xpGPR(xp, sp);
     659    bp = (LispObj *) xpGPR(xp, Rsp);
    702660  }
    703661  return bp;
     
    718676      }
    719677    }
    720     update_area_active((area **)&tcr->cs_area, (BytePtr) ptr_from_lispobj(xpGPR(xp, sp)));
     678    update_area_active((area **)&tcr->cs_area, (BytePtr) ptr_from_lispobj(xpGPR(xp, Rsp)));
    721679    update_area_active((area **)&tcr->vs_area, (BytePtr) ptr_from_lispobj(xpGPR(xp, vsp)));
    722     update_area_active((area **)&tcr->ts_area, (BytePtr) ptr_from_lispobj(xpGPR(xp, tsp)));
    723 #ifdef DEBUG
    724     fprintf(dbgout, "TCR 0x%x in lisp code, vsp = 0x%lx, tsp = 0x%lx\n",
    725             tcr, xpGPR(xp, vsp), xpGPR(xp, tsp));
    726     fprintf(dbgout, "TCR 0x%x, allocbase/allocptr were 0x%x/0x%x at #x%x\n",
    727             tcr,
    728             xpGPR(xp, allocbase),
    729             xpGPR(xp, allocptr),
    730             xpPC(xp));
    731     fprintf(dbgout, "TCR 0x%x, exception context = 0x%x\n",
    732             tcr,
    733             tcr->pending_exception_context);
    734 #endif
    735680  } else {
    736681    /* In ff-call.  No need to update cs_area */
    737682    cur_allocptr = (void *) (tcr->save_allocptr);
    738 #ifdef DEBUG
    739     fprintf(dbgout, "TCR 0x%x in foreign code, vsp = 0x%lx, tsp = 0x%lx\n",
    740             tcr, tcr->save_vsp, tcr->save_tsp);
    741     fprintf(dbgout, "TCR 0x%x, save_allocbase/save_allocptr were 0x%x/0x%x at #x%x\n",
    742             tcr,
    743             tcr->save_allocbase,
    744             tcr->save_allocptr,
    745             xpPC(xp));
    746 
    747 #endif
    748683    update_area_active((area **)&tcr->vs_area, (BytePtr) tcr->save_vsp);
    749     update_area_active((area **)&tcr->ts_area, (BytePtr) tcr->save_tsp);
    750684  }
    751685
     
    756690    if (freeptr) {
    757691      xpGPR(xp, allocptr) = VOID_ALLOCPTR;
    758       xpGPR(xp, allocbase) = VOID_ALLOCPTR;
    759692    }
    760693  }
     
    791724
    792725  xpGPR(xp, allocptr) = VOID_ALLOCPTR;
    793   xpGPR(xp, allocbase) = VOID_ALLOCPTR;
    794726
    795727  normalize_tcr(xp, tcr, false);
     
    839771  BytePtr oldend, newend;
    840772
    841 #ifdef DEBUG
    842   fprintf(dbgout, "Start GC  in 0x%lx\n", tcr);
    843 #endif
    844773  a = active_dynamic_area;
    845774  oldend = a->high;
     
    895824is_write_fault(ExceptionInformation *xp, siginfo_t *info)
    896825{
    897   /* use the siginfo if it's available.  Some versions of Linux
    898      don't propagate the DSISR and TRAP fields correctly from
    899      64- to 32-bit handlers.
    900   */
    901   if (info) {
    902     /*
    903        To confuse matters still further, the value of SEGV_ACCERR
    904        varies quite a bit among LinuxPPC variants (the value defined
    905        in the header files varies, and the value actually set by
    906        the kernel also varies.  So far, we're only looking at the
    907        siginfo under Linux and Linux always seems to generate
    908        SIGSEGV, so check for SIGSEGV and check the low 16 bits
    909        of the si_code.
    910     */
    911     return ((info->si_signo == SIGSEGV) &&
    912             ((info->si_code & 0xff) == (SEGV_ACCERR & 0xff)));
    913   }
    914   return(((xpDSISR(xp) & (1 << 25)) != 0) &&
    915          (xpTRAP(xp) ==
    916826#ifdef LINUX
    917 0x0300
    918 #endif
    919 #ifdef DARWIN
    920 0x0300/0x100
    921 #endif
    922 )
    923          );
    924 #if 0
    925   /* Maybe worth keeping around; not sure if it's an exhaustive
    926      list of PPC instructions that could cause a WP fault */
    927   /* Some OSes lose track of the DSISR and DSR SPRs, or don't provide
    928      valid values of those SPRs in the context they provide to
    929      exception handlers.  Look at the opcode of the offending
    930      instruction & recognize 32-bit store operations */
    931   opcode instr = *(xpPC(xp));
    932 
    933   if (xp->regs->trap != 0x300) {
    934     return 0;
    935   }
    936   switch (instr >> 26) {
    937   case 47:                      /* STMW */
    938   case 36:                      /* STW */
    939   case 37:                      /* STWU */
    940     return 1;
    941   case 31:
    942     switch ((instr >> 1) & 1023) {
    943     case 151:                   /* STWX */
    944     case 183:                   /* STWUX */
    945       return 1;
    946     default:
    947       return 0;
    948     }
    949   default:
    950     return 0;
    951   }
     827  /* Based on experiments with a small sample size; need to R TFM. */
     828  return ((xp->uc_mcontext.trap_no == 0xe) &&
     829          (xp->uc_mcontext.error_code == 0x817));
    952830#endif
    953831}
     
    965843    addr = (BytePtr)(info->si_addr);
    966844  } else {
    967     addr = (BytePtr) ((natural) (xpDAR(xp)));
     845    addr = (BytePtr) ((natural) (xpFaultAddress(xp)));
    968846  }
    969847
     
    997875  }
    998876  if (old_valence == TCR_STATE_LISP) {
    999     callback_for_trap(nrs_CMAIN.vcell, xp, (pc)xpPC(xp), SIGBUS, (natural)addr, is_write_fault(xp,info));
     877    callback_for_trap(nrs_CMAIN.vcell, xp, is_write_fault(xp,info)?SIGBUS:SIGSEGV, (natural)addr);
    1000878  }
    1001879  return -1;
     
    1022900allocate_tstack(natural useable);       /* This is in "pmcl-kernel.c" */
    1023901
    1024 #ifdef EXTEND_VSTACK
    1025 Boolean
    1026 catch_frame_p(lisp_frame *spPtr)
    1027 {
    1028   catch_frame* catch = (catch_frame *) untag(lisp_global(CATCH_TOP));
    1029 
    1030   for (; catch; catch = (catch_frame *) untag(catch->link)) {
    1031     if (spPtr == ((lisp_frame *) catch->csp)) {
    1032       return true;
    1033     }
    1034   }
    1035   return false;
    1036 }
    1037 #endif
    1038 
    1039 Boolean
    1040 unwind_protect_cleanup_frame_p(lisp_frame *spPtr)
    1041 {
    1042   if ((spPtr->savevsp == (LispObj)NULL) ||  /* The frame to where the unwind-protect will return */
    1043       (((spPtr->backlink)->savevsp) == (LispObj)NULL)) {  /* The frame that returns to the kernel  from the cleanup form */
    1044     return true;
    1045   } else {
    1046     return false;
    1047   }
    1048 }
    1049 
    1050 Boolean
    1051 lexpr_entry_frame_p(lisp_frame *spPtr)
    1052 {
    1053   LispObj savelr = spPtr->savelr;
    1054   LispObj lexpr_return = (LispObj) lisp_global(LEXPR_RETURN);
    1055   LispObj lexpr_return1v = (LispObj) lisp_global(LEXPR_RETURN1V);
    1056   LispObj ret1valn = (LispObj) lisp_global(RET1VALN);
    1057 
    1058   return
    1059     (savelr == lexpr_return1v) ||
    1060     (savelr == lexpr_return) ||
    1061     ((savelr == ret1valn) &&
    1062      (((spPtr->backlink)->savelr) == lexpr_return));
    1063 }
     902
     903
     904
     905
    1064906
    1065907Boolean
    1066908lisp_frame_p(lisp_frame *spPtr)
    1067909{
    1068   LispObj savefn;
    1069   /* We can't just look at the size of the stack frame under the EABI
    1070      calling sequence, but that's the first thing to check. */
    1071   if (((lisp_frame *) spPtr->backlink) != (spPtr+1)) {
    1072     return false;
    1073   }
    1074   savefn = spPtr->savefn;
    1075   return (savefn == 0) || (fulltag_of(savefn) == fulltag_misc);
    1076  
     910  return (spPtr->marker == lisp_frame_marker);
    1077911}
    1078912
     
    1080914int ffcall_overflow_count = 0;
    1081915
    1082 /* Find a frame that is neither a catch frame nor one of the
    1083    lexpr_entry frames We don't check for non-lisp frames here because
    1084    we'll always stop before we get there due to a dummy lisp frame
    1085    pushed by .SPcallback that masks out the foreign frames.  The one
    1086    exception is that there is a non-lisp frame without a valid VSP
    1087    while in the process of ppc-ff-call. We recognize that because its
    1088    savelr is NIL.  If the saved VSP itself is 0 or the savevsp in the
    1089    next frame is 0, then we're executing an unwind-protect cleanup
    1090    form, and the top stack frame belongs to its (no longer extant)
    1091    catch frame.  */
    1092 
    1093 #ifdef EXTEND_VSTACK
    1094 lisp_frame *
    1095 find_non_catch_frame_from_xp (ExceptionInformation *xp)
    1096 {
    1097   lisp_frame *spPtr = (lisp_frame *) xpGPR(xp, sp);
    1098   if ((((natural) spPtr) + sizeof(lisp_frame)) != ((natural) (spPtr->backlink))) {
    1099     ffcall_overflow_count++;          /* This is mostly so I can breakpoint here */
    1100   }
    1101   for (; !lisp_frame_p(spPtr)  || /* In the process of ppc-ff-call */
    1102          unwind_protect_cleanup_frame_p(spPtr) ||
    1103          catch_frame_p(spPtr) ||
    1104          lexpr_entry_frame_p(spPtr) ; ) {
    1105      spPtr = spPtr->backlink;
    1106      };
    1107   return spPtr;
    1108 }
    1109 #endif
    1110 
    1111 #ifdef EXTEND_VSTACK
    1112 Boolean
    1113 db_link_chain_in_area_p (area *a)
    1114 {
    1115   LispObj *db = (LispObj *) lisp_global(DB_LINK),
    1116           *high = (LispObj *) a->high,
    1117           *low = (LispObj *) a->low;
    1118   for (; db; db = (LispObj *) *db) {
    1119     if ((db >= low) && (db < high)) return true;
    1120   };
    1121   return false;
    1122 }
    1123 #endif
     916
    1124917
    1125918
     
    1141934
    1142935
    1143 OSStatus
    1144 do_tsp_overflow (ExceptionInformation *xp, BytePtr addr)
    1145 {
    1146   TCR* tcr = TCR_FROM_TSD(xpGPR(xp, rcontext));
    1147   area *a = tcr->ts_area;
    1148   protected_area_ptr tsp_soft = a->softprot;
    1149   unprotect_area(tsp_soft);
    1150   signal_stack_soft_overflow(xp,tsp);
    1151   return 0;
    1152 }
    1153936
    1154937OSStatus
     
    1159942     signal an error_stack_overflow condition.
    1160943      */
    1161   lisp_protection_kind which = prot_area->why;
    1162   Boolean on_TSP = (which == kTSPsoftguard);
    1163 
    1164   if (on_TSP) {
    1165     return do_tsp_overflow(xp, addr);
    1166    } else {
    1167     return do_vsp_overflow(xp, addr);
    1168    }
     944  do_vsp_overflow(xp,addr);
    1169945}
    1170946
     
    1179955
    1180956
    1181 /*
    1182   We have a couple of choices here.  We can simply unprotect the page
    1183   and let the store happen on return, or we can try to emulate writes
    1184   that we know will involve an intergenerational reference.  Both are
    1185   correct as far as EGC constraints go, but the latter approach is
    1186   probably more efficient.  (This only matters in the case where the
    1187   GC runs after this exception handler returns but before the write
    1188   actually happens.  If we didn't emulate node stores here, the EGC
    1189   would scan the newly-writen page, find nothing interesting, and
    1190   run to completion.  This thread will try the write again afer it
    1191   resumes, the page'll be re-protected, and we'll have taken this
    1192   fault twice.  The whole scenario shouldn't happen very often, but
    1193   (having already taken a fault and committed to an mprotect syscall)
    1194   we might as well emulate stores involving intergenerational references,
    1195   since they're pretty easy to identify.
    1196 
    1197   Note that cases involving two or more threads writing to the same
    1198   page (before either of them can run this handler) is benign: one
    1199   invocation of the handler will just unprotect an unprotected page in
    1200   that case.
    1201 
    1202   If there are GCs (or any other suspensions of the thread between
    1203   the time that the write fault was detected and the time that the
    1204   exception lock is obtained) none of this stuff happens.
    1205 */
    1206 
    1207 /*
    1208   Return true (and emulate the instruction) iff:
    1209   a) the fault was caused by an "stw rs,d(ra)" or "stwx rs,ra.rb"
    1210      instruction.
    1211   b) RS is a node register (>= fn)
    1212   c) RS is tagged as a cons or vector
    1213   d) RS is in some ephemeral generation.
    1214   This is slightly conservative, since RS may be no younger than the
    1215   EA being written to.
    1216 */
    1217 Boolean
    1218 is_ephemeral_node_store(ExceptionInformation *xp, BytePtr ea)
    1219 {
    1220   if (((ptr_to_lispobj(ea)) & 3) == 0) {
    1221     opcode instr = *xpPC(xp);
    1222    
    1223     if (X_opcode_p(instr,major_opcode_X31,minor_opcode_STWX) ||
    1224         major_opcode_p(instr, major_opcode_STW)) {
    1225       LispObj
    1226         rs = RS_field(instr),
    1227         rsval = xpGPR(xp,rs),
    1228         tag = fulltag_of(rsval);
    1229      
    1230       if (rs >= fn) {
    1231         if ((tag == fulltag_misc) || (tag == fulltag_cons)) {
    1232           if (((BytePtr)ptr_from_lispobj(rsval) > tenured_area->high) &&
    1233               ((BytePtr)ptr_from_lispobj(rsval) < active_dynamic_area->high)) {
    1234             *(LispObj *)ea = rsval;
    1235             return true;
    1236           }
    1237         }
    1238       }
    1239     }
    1240   }
    1241   return false;
    1242 }
     957
    1243958
    1244959     
     
    1251966handle_sigfpe(ExceptionInformation *xp, TCR *tcr)
    1252967{
    1253   (void) zero_fpscr(tcr);
    1254   enable_fp_exceptions();
    1255 
    1256 
    1257   tcr->lisp_fpscr.words.l =  xpFPSCR(xp) & ~_FPU_RESERVED;
     968
     969
    1258970
    1259971  /* 'handle_fpux_binop' scans back from the specified PC until it finds an FPU
     
    1264976
    1265977   
    1266 int
    1267 altivec_present = 1;
    1268978
    1269979
     
    1277987                                 TCR *tcr)
    1278988{
    1279   (void) zero_fpscr(tcr);
    1280   enable_fp_exceptions();
    1281   /* the rc bit (bit 0 in the instruction) is supposed to cause
    1282      some FPSCR bits to be copied to CR1.  Clozure CL doesn't generate
    1283      fsqrt. or fsqrts.
    1284   */
    1285   if (((major_opcode_p(instruction,major_opcode_FPU_DOUBLE)) ||
    1286        (major_opcode_p(instruction,major_opcode_FPU_SINGLE))) &&
    1287       ((instruction & ((1 << 6) -2)) == (22<<1))) {
    1288     double b, d, sqrt(double);
    1289 
    1290     b = xpFPR(xp,RB_field(instruction));
    1291     d = sqrt(b);
    1292     xpFPSCR(xp) = ((xpFPSCR(xp) & ~_FPU_RESERVED) |
    1293                    (get_fpscr() & _FPU_RESERVED));
    1294     xpFPR(xp,RT_field(instruction)) = d;
    1295     adjust_exception_pc(xp,4);
    1296     return 0;
    1297   }
    1298989
    1299990  return -1;
     
    13181009  }
    13191010
    1320   if (instruction == ALLOC_TRAP_INSTRUCTION) {
     1011  if (IS_ALLOC_TRAP(instruction)) {
    13211012    status = handle_alloc_trap(xp, tcr);
    13221013  } else if ((xnum == SIGSEGV) ||
     
    13251016  } else if (xnum == SIGFPE) {
    13261017    status = handle_sigfpe(xp, tcr);
    1327   } else if ((xnum == SIGILL) || (xnum == SIGTRAP)) {
    1328     if (instruction == GC_TRAP_INSTRUCTION) {
     1018  } else if ((xnum == SIGILL)) {
     1019    if (IS_GC_TRAP(instruction)) {
    13291020      status = handle_gc_trap(xp, tcr);
    13301021    } else if (IS_UUO(instruction)) {
    1331       status = handle_uuo(xp, instruction, program_counter);
    1332     } else if (is_conditional_trap(instruction)) {
    1333       status = handle_trap(xp, instruction, program_counter, info);
     1022      status = handle_uuo(xp, instruction);
    13341023    } else {
    13351024      status = handle_unimplemented_instruction(xp,instruction,tcr);
     
    13371026  } else if (xnum == SIGNAL_FOR_PROCESS_INTERRUPT) {
    13381027    tcr->interrupt_pending = 0;
    1339     callback_for_trap(nrs_CMAIN.vcell, xp, 0, TRI_instruction(TO_GT,nargs,0),0, 0);
     1028    callback_for_trap(nrs_CMAIN.vcell, xp, xnum, 0);
    13401029    status = 0;
    13411030  }
     
    13591048handle_fpux_binop(ExceptionInformation *xp, pc where)
    13601049{
    1361   OSStatus err;
     1050  OSStatus err = -1;
    13621051  opcode *there = (opcode *) where, instr, errnum = 0;
    1363   int i = TRAP_LOOKUP_TRIES, delta = 0;
    1364  
    1365   while (i--) {
    1366     instr = *--there;
    1367     delta -= 4;
    1368     if (codevec_hdr_p(instr)) {
    1369       return -1;
    1370     }
    1371     if (major_opcode_p(instr, major_opcode_FPU_DOUBLE)) {
    1372       errnum = error_FPU_exception_double;
    1373       break;
    1374     }
    1375 
    1376     if (major_opcode_p(instr, major_opcode_FPU_SINGLE)) {
    1377       errnum = error_FPU_exception_short;
    1378       break;
    1379     }
    1380   }
    1381  
    1382   err = handle_error(xp, errnum, rcontext, 0,  there);
    1383   /* Yeah, we said "non-continuable".  In case we ever change that ... */
    1384  
    1385   adjust_exception_pc(xp, delta);
    1386   xpFPSCR(xp)  &=  0x03fff;
    1387  
    13881052  return err;
    1389 
    13901053}
    13911054
    13921055OSStatus
    1393 handle_uuo(ExceptionInformation *xp, opcode the_uuo, pc where)
    1394 {
    1395 #ifdef SUPPORT_PRAGMA_UNUSED
    1396 #pragma unused(where)
    1397 #endif
     1056handle_uuo(ExceptionInformation *xp, opcode the_uuo)
     1057{
    13981058  unsigned
    1399     minor = UUO_MINOR(the_uuo),
    1400     rb = 0x1f & (the_uuo >> 11),
    1401     errnum = 0x3ff & (the_uuo >> 16);
    1402 
     1059    format = UUO_FORMAT(the_uuo);
    14031060  OSStatus status = -1;
    1404 
    14051061  int bump = 4;
    1406 
    1407   switch (minor) {
    1408 
    1409   case UUO_ZERO_FPSCR:
    1410     status = 0;
    1411     xpFPSCR(xp) = 0;
    1412     break;
    1413 
    1414 
    1415   case UUO_INTERR:
     1062  TCR *tcr = get_tcr(true);
     1063
     1064  switch (format) {
     1065  case uuo_format_kernel_service:
    14161066    {
    14171067      TCR * target = (TCR *)xpGPR(xp,arg_z);
     1068      int service = UUO_UNARY_field(the_uuo);
     1069
    14181070      status = 0;
    1419       switch (errnum) {
     1071      switch (service) {
    14201072      case error_propagate_suspend:
    1421         break;
     1073        break;
    14221074      case error_interrupt:
    1423         xpGPR(xp,imm0) = (LispObj) raise_thread_interrupt(target);
    1424         break;
     1075        xpGPR(xp,imm0) = (LispObj) raise_thread_interrupt(target);
     1076        break;
    14251077      case error_suspend:
    1426         xpGPR(xp,imm0) = (LispObj) lisp_suspend_tcr(target);
    1427         break;
     1078        xpGPR(xp,imm0) = (LispObj) lisp_suspend_tcr(target);
     1079        break;
    14281080      case error_suspend_all:
    1429         lisp_suspend_other_threads();
    1430         break;
     1081        lisp_suspend_other_threads();
     1082        break;
    14311083      case error_resume:
    1432         xpGPR(xp,imm0) = (LispObj) lisp_resume_tcr(target);
    1433         break;
     1084        xpGPR(xp,imm0) = (LispObj) lisp_resume_tcr(target);
     1085        break;
    14341086      case error_resume_all:
    1435         lisp_resume_other_threads();
    1436         break;
     1087        lisp_resume_other_threads();
     1088        break;
    14371089      case error_kill:
    1438         xpGPR(xp,imm0) = (LispObj)kill_tcr(target);
    1439         break;
     1090        xpGPR(xp,imm0) = (LispObj)kill_tcr(target);
     1091        break;
    14401092      case error_allocate_list:
    1441         allocate_list(xp,get_tcr(true));
     1093        allocate_list(xp,tcr);
    14421094        break;
    14431095      default:
    1444         status = handle_error(xp, errnum, rb, 0,  where);
    1445         break;
     1096        status = -1;
     1097        break;
    14461098      }
    14471099    }
     1100
     1101  case uuo_format_unary:
     1102    switch(UUO_UNARY_field(the_uuo)) {
     1103    case 3:
     1104      if (extend_tcr_tlb(tcr,xp,UUOA_field(the_uuo))) {
     1105        status = 0;
     1106        bump = 4;
     1107        break;
     1108      }
     1109      /* fall in */
     1110    default:
     1111      status = -1;
     1112      break;
     1113
     1114    }
    14481115    break;
    14491116
    1450   case UUO_INTCERR:
    1451     status = handle_error(xp, errnum, rb, 1,  where);
    1452     if (errnum == error_udf_call) {
    1453       /* If lisp's returned from a continuable undefined-function call,
    1454          it's put a code vector in the xp's PC.  Don't advance the
    1455          PC ... */
    1456       bump = 0;
    1457     }
    1458     break;
    1459 
    1460   case UUO_FPUX_BINOP:
    1461     status = handle_fpux_binop(xp, where);
    1462     bump = 0;
     1117  case uuo_format_nullary:
     1118    switch (UUOA_field(the_uuo)) {
     1119    case 4:
     1120      tcr->interrupt_pending = 0;
     1121      callback_for_trap(nrs_CMAIN.vcell, xp, SIGNAL_FOR_PROCESS_INTERRUPT, 0);
     1122      break;
     1123    }
     1124
     1125  case uuo_format_error_lisptag:
     1126  case uuo_format_error_fulltag:
     1127  case uuo_format_error_xtype:
     1128  case uuo_format_nullary_error:
     1129  case uuo_format_unary_error:
     1130  case uuo_format_binary_error:
     1131    bump = handle_error(xp,0,the_uuo);
     1132    if (bump >= 0) {
     1133      status = 0;
     1134    }
    14631135    break;
    14641136
     
    14811153  if ((fulltag_of(lisp_function) == fulltag_misc) &&
    14821154      (header_subtag(header_of(lisp_function)) == subtag_function)) {
    1483     code_vector = deref(lisp_function, 1);
     1155    code_vector = deref(lisp_function, 2);
    14841156    size = header_element_count(header_of(code_vector)) << 2;
    14851157    if ((untag(code_vector) < (natural)where) &&
     
    14911163}
    14921164
    1493 /* Callback to lisp to handle a trap. Need to translate the
    1494    PC (where) into one of two forms of pairs:
    1495 
    1496    1. If PC is in fn or nfn's code vector, use the register number
    1497       of fn or nfn and the index into that function's code vector.
    1498    2. Otherwise use 0 and the pc itself
    1499 */
    1500 void
    1501 callback_for_trap (LispObj callback_macptr, ExceptionInformation *xp, pc where,
    1502                    natural arg1, natural arg2, natural arg3)
    1503 {
    1504   natural code_vector = register_codevector_contains_pc(xpGPR(xp, fn), where);
    1505   unsigned register_number = fn;
    1506   natural index = (natural)where;
    1507 
    1508   if (code_vector == 0) {
    1509     register_number = nfn;
    1510     code_vector = register_codevector_contains_pc(xpGPR(xp, nfn), where);
    1511   }
    1512   if (code_vector == 0)
    1513     register_number = 0;
    1514   else
    1515     index = ((natural)where - (code_vector + misc_data_offset)) >> 2;
    1516   callback_to_lisp(callback_macptr, xp, register_number, index, arg1, arg2, arg3);
    1517 }
    1518 
    1519 void
     1165int
     1166callback_for_trap (LispObj callback_macptr, ExceptionInformation *xp, natural info,natural arg)
     1167{
     1168  return callback_to_lisp(callback_macptr, xp, info,arg);
     1169}
     1170
     1171int
    15201172callback_to_lisp (LispObj callback_macptr, ExceptionInformation *xp,
    1521                   natural arg1, natural arg2, natural arg3, natural arg4, natural arg5)
     1173                  natural arg1, natural arg2)
    15221174{
    15231175  natural  callback_ptr;
    15241176  area *a;
     1177  natural fnreg = fn,  codevector, offset;
     1178  pc where = xpPC(xp);
     1179
     1180  codevector = register_codevector_contains_pc(xpGPR(xp,fnreg), where);
     1181  if (codevector == 0) {
     1182    fnreg = nfn;
     1183    codevector = register_codevector_contains_pc(xpGPR(xp,fnreg), where);
     1184  }
     1185  offset = (natural)where - codevector;
     1186                                                 
     1187                                               
    15251188
    15261189  TCR *tcr = TCR_FROM_TSD(xpGPR(xp, rcontext));
     
    15281191  /* Put the active stack pointer where .SPcallback expects it */
    15291192  a = tcr->cs_area;
    1530   a->active = (BytePtr) ptr_from_lispobj(xpGPR(xp, sp));
     1193  a->active = (BytePtr) ptr_from_lispobj(xpGPR(xp, Rsp));
    15311194
    15321195  /* Copy globals from the exception frame to tcr */
    15331196  tcr->save_allocptr = (void *)ptr_from_lispobj(xpGPR(xp, allocptr));
    1534   tcr->save_allocbase = (void *)ptr_from_lispobj(xpGPR(xp, allocbase));
    15351197  tcr->save_vsp = (LispObj*) ptr_from_lispobj(xpGPR(xp, vsp));
    1536   tcr->save_tsp = (LispObj*) ptr_from_lispobj(xpGPR(xp, tsp));
    15371198
    15381199
     
    15431204  */
    15441205  callback_ptr = ((macptr *)ptr_from_lispobj(untag(callback_macptr)))->address;
    1545 #ifdef DEBUG
    1546   fprintf(dbgout, "0x%x releasing exception lock for callback\n", tcr);
    1547 #endif
    15481206  UNLOCK(lisp_global(EXCEPTION_LOCK), tcr);
    1549   ((void (*)())callback_ptr) (xp, arg1, arg2, arg3, arg4, arg5);
     1207  ((void (*)())callback_ptr) (xp, arg1, arg2, fnreg, offset);
    15501208  LOCK(lisp_global(EXCEPTION_LOCK), tcr);
    1551 #ifdef DEBUG
    1552   fprintf(dbgout, "0x%x acquired exception lock after callback\n", tcr);
    1553 #endif
    15541209
    15551210
    15561211
    15571212  /* Copy GC registers back into exception frame */
    1558   xpGPR(xp, allocbase) = (LispObj) ptr_to_lispobj(tcr->save_allocbase);
    15591213  xpGPR(xp, allocptr) = (LispObj) ptr_to_lispobj(tcr->save_allocptr);
    15601214}
     
    15841238  TCR *tcr = TCR_FROM_TSD(xpGPR(xp, rcontext));
    15851239
    1586   /* If we got here, "the_trap" is either a TRI or a TR instruction.
    1587      It's a TRI instruction iff its major opcode is major_opcode_TRI. */
    1588 
    1589   /* If it's a "trllt" instruction where RA == sp, it's a failed
    1590      control stack overflow check.  In that case:
    1591      
    1592      a) We're in "yellow zone" mode if the value of the
    1593      lisp_global(CS_OVERFLOW_LIMIT) is CS_OVERFLOW_FORCE_LIMIT.  If
    1594      we're not already in yellow zone mode, attempt to create a new
    1595      thread and continue execution on its stack. If that fails, call
    1596      signal_stack_soft_overflow to enter yellow zone mode and signal
    1597      the condition to lisp.
    1598      
    1599      b) If we're already in "yellow zone" mode, then:
    1600      
    1601      1) if the SP is past the current control-stack area's hard
    1602      overflow limit, signal a "hard" stack overflow error (e.g., throw
    1603      to toplevel as quickly as possible. If we aren't in "yellow zone"
    1604      mode, attempt to continue on another thread first.
    1605      
    1606      2) if SP is "well" (> 4K) below its soft overflow limit, set
    1607      lisp_global(CS_OVERFLOW_LIMIT) to its "real" value.  We're out of
    1608      "yellow zone mode" in this case.
    1609      
    1610      3) Otherwise, do nothing.  We'll continue to trap every time
    1611      something gets pushed on the control stack, so we should try to
    1612      detect and handle all of these cases fairly quickly.  Of course,
    1613      the trap overhead is going to slow things down quite a bit.
    1614      */
    1615 
    1616   if (X_opcode_p(the_trap,major_opcode_X31,minor_opcode_TR) &&
    1617       (RA_field(the_trap) == sp) &&
    1618       (TO_field(the_trap) == TO_LO)) {
    1619     area
    1620       *CS_area = tcr->cs_area,
    1621       *VS_area = tcr->vs_area;
    1622      
    1623     natural
    1624       current_SP = xpGPR(xp,sp),
    1625       current_VSP = xpGPR(xp,vsp);
    1626 
    1627     if (current_SP  < (natural) (CS_area->hardlimit)) {
    1628       /* If we're not in soft overflow mode yet, assume that the
    1629          user has set the soft overflow size very small and try to
    1630          continue on another thread before throwing to toplevel */
    1631       if ((tcr->cs_limit == CS_OVERFLOW_FORCE_LIMIT)) {
    1632         reset_lisp_process(xp);
    1633       }
    1634     } else {
    1635       if (tcr->cs_limit == CS_OVERFLOW_FORCE_LIMIT) {
    1636         /* If the control stack pointer is at least 4K away from its soft limit
    1637            and the value stack pointer is at least 4K away from its soft limit,
    1638            stop trapping.  Else keep trapping. */
    1639         if ((current_SP > (natural) ((CS_area->softlimit)+4096)) &&
    1640             (current_VSP > (natural) ((VS_area->softlimit)+4096))) {
    1641           protected_area_ptr vs_soft = VS_area->softprot;
    1642           if (vs_soft->nprot == 0) {
    1643             protect_area(vs_soft);
    1644           }
    1645           tcr->cs_limit = ptr_to_lispobj(CS_area->softlimit);
    1646         }
    1647       } else {
    1648         tcr->cs_limit = ptr_to_lispobj(CS_area->hardlimit);       
    1649         signal_stack_soft_overflow(xp, sp);
    1650       }
    1651     }
    1652    
    1653     adjust_exception_pc(xp, 4);
    1654     return noErr;
    1655   } else {
    1656     if (the_trap == LISP_BREAK_INSTRUCTION) {
    1657       char *message =  (char *) ptr_from_lispobj(xpGPR(xp,3));
    1658       set_xpPC(xp, xpLR(xp));
    1659       if (message == NULL) {
    1660         message = "Lisp Breakpoint";
    1661       }
    1662       lisp_Debugger(xp, info, debug_entry_dbg, false, message);
    1663       return noErr;
    1664     }
    1665     if (the_trap == QUIET_LISP_BREAK_INSTRUCTION) {
    1666       adjust_exception_pc(xp,4);
    1667       lisp_Debugger(xp, info, debug_entry_dbg, false, "Lisp Breakpoint");
    1668       return noErr;
    1669     }
    1670     /*
    1671       twlle ra,rb is used to detect tlb overflow, where RA = current
    1672       limit and RB = index to use.
    1673     */
    1674     if ((X_opcode_p(the_trap, 31, minor_opcode_TR)) &&
    1675         (TO_field(the_trap) == (TO_LO|TO_EQ))) {
    1676       if (extend_tcr_tlb(tcr, xp, RA_field(the_trap), RB_field(the_trap))) {
    1677         return noErr;
    1678       }
    1679       return -1;
    1680     }
    1681 
    1682     if ((fulltag_of(cmain) == fulltag_misc) &&
    1683         (header_subtag(header_of(cmain)) == subtag_macptr)) {
    1684       if (the_trap == TRI_instruction(TO_GT,nargs,0)) {
    1685         /* reset interrup_level, interrupt_pending */
    1686         TCR_INTERRUPT_LEVEL(tcr) = 0;
    1687         tcr->interrupt_pending = 0;
    1688       }
    1689 #if 0
    1690       fprintf(dbgout, "About to do trap callback in 0x%x\n",tcr);
    1691 #endif
    1692       callback_for_trap(cmain, xp,  where, (natural) the_trap,  0, 0);
    1693       adjust_exception_pc(xp, 4);
    1694       return(noErr);
    1695     }
    1696     return -1;
    1697   }
    1698 }
    1699 
    1700 
    1701 /* Look at up to TRAP_LOOKUP_TRIES instrs before trap instr for a pattern.
    1702    Stop if subtag_code_vector is encountered. */
    1703 unsigned
    1704 scan_for_instr( unsigned target, unsigned mask, pc where )
    1705 {
    1706   int i = TRAP_LOOKUP_TRIES;
    1707 
    1708   while( i-- ) {
    1709     unsigned instr = *(--where);
    1710     if ( codevec_hdr_p(instr) ) {
    1711       return 0;
    1712     } else if ( match_instr(instr, mask, target) ) {
    1713       return instr;
    1714     }
    1715   }
    1716   return 0;
    1717 }
     1240}
     1241
     1242
    17181243
    17191244
     
    17261251/* The main opcode.  */
    17271252
    1728 int
    1729 is_conditional_trap(opcode instr)
    1730 {
    1731   unsigned to = TO_field(instr);
    1732   int is_tr = X_opcode_p(instr,major_opcode_X31,minor_opcode_TR);
    1733 
    1734 #ifndef MACOS
    1735   if ((instr == LISP_BREAK_INSTRUCTION) ||
    1736       (instr == QUIET_LISP_BREAK_INSTRUCTION)) {
    1737     return 1;
    1738   }
    1739 #endif
    1740   if (is_tr || major_opcode_p(instr,major_opcode_TRI)) {
    1741     /* A "tw/td" or "twi/tdi" instruction.  To be unconditional, the
    1742        EQ bit must be set in the TO mask and either the register
    1743        operands (if "tw") are the same or either both of the signed or
    1744        both of the unsigned inequality bits must be set. */
    1745     if (! (to & TO_EQ)) {
    1746       return 1;                 /* Won't trap on EQ: conditional */
    1747     }
    1748     if (is_tr && (RA_field(instr) == RB_field(instr))) {
    1749       return 0;                 /* Will trap on EQ, same regs: unconditional */
    1750     }
    1751     if (((to & (TO_LO|TO_HI)) == (TO_LO|TO_HI)) ||
    1752         ((to & (TO_LT|TO_GT)) == (TO_LT|TO_GT))) {
    1753       return 0;                 /* Will trap on EQ and either (LT|GT) or (LO|HI) : unconditional */
    1754     }
    1755     return 1;                   /* must be conditional */
    1756   }
    1757   return 0;                     /* Not "tw/td" or "twi/tdi".  Let
    1758                                    debugger have it */
    1759 }
    1760 
    1761 OSStatus
    1762 handle_error(ExceptionInformation *xp, unsigned errnum, unsigned rb, unsigned continuable, pc where)
     1253
     1254int
     1255handle_error(ExceptionInformation *xp, unsigned arg1, unsigned arg2)
    17631256{
    17641257  LispObj   errdisp = nrs_ERRDISP.vcell;
     
    17671260      (header_subtag(header_of(errdisp)) == subtag_macptr)) {
    17681261    /* errdisp is a macptr, we can call back to lisp */
    1769     callback_for_trap(errdisp, xp, where, errnum, rb, continuable);
    1770     return(0);
     1262    return callback_for_trap(errdisp, xp, arg1, arg2);
    17711263    }
    17721264
     
    18001292
    18011293  LOCK(lisp_global(EXCEPTION_LOCK), tcr);
    1802 #ifdef DEBUG
    1803   fprintf(dbgout, "0x%x has exception lock\n", tcr);
    1804 #endif
    18051294  xf->curr = context;
    18061295  xf->prev = tcr->xframe;
     
    18161305  tcr->xframe = tcr->xframe->prev;
    18171306  tcr->valence = TCR_STATE_EXCEPTION_RETURN;
    1818 #ifdef DEBUG
    1819   fprintf(dbgout, "0x%x releasing exception lock\n", tcr);
    1820 #endif
    18211307  UNLOCK(lisp_global(EXCEPTION_LOCK),tcr);
    18221308}
     
    19311417  pc program_counter = xpPC(xp);
    19321418  opcode instr = *program_counter;
    1933   lisp_frame *frame = (lisp_frame *)ptr_from_lispobj(xpGPR(xp,sp));
     1419  lisp_frame *frame = (lisp_frame *)ptr_from_lispobj(xpGPR(xp,Rsp));
    19341420  LispObj cur_allocptr = xpGPR(xp, allocptr);
    19351421  int allocptr_tag = fulltag_of(cur_allocptr);
     
    19461432      if ((program_counter < &egc_set_hash_key_conditional_test) ||
    19471433          ((program_counter == &egc_set_hash_key_conditional_test) &&
    1948            (! (xpCCR(xp) & 0x20000000)))) {
     1434           (! (xpPSR(xp) & PSR_Z_MASK)))) {
    19491435        return;
    19501436      }
     
    19561442      if ((program_counter < &egc_store_node_conditional_test) ||
    19571443          ((program_counter == &egc_store_node_conditional_test) &&
    1958            (! (xpCCR(xp) & 0x20000000)))) {
     1444           (! (xpPSR(xp) & PSR_Z_MASK)))) {
    19591445        /* The conditional store either hasn't been attempted yet, or
    19601446           has failed.  No need to adjust the PC, or do memoization. */
    19611447        return;
    19621448      }
    1963       ea = (LispObj*)(xpGPR(xp,arg_x) + xpGPR(xp,imm4));
     1449      ea = (LispObj*)(xpGPR(xp,arg_x) + xpGPR(xp,imm0));
    19641450      xpGPR(xp,arg_z) = t_value;
    19651451      need_store = false;
     
    19931479      }
    19941480    }
    1995     set_xpPC(xp, xpLR(xp));
     1481    xpPC(xp) = xpLR(xp);
    19961482    return;
    19971483  }
    19981484
    19991485
    2000   if (instr == MARK_TSP_FRAME_INSTRUCTION) {
    2001     LispObj tsp_val = xpGPR(xp,tsp);
    2002    
    2003     ((LispObj *)ptr_from_lispobj(tsp_val))[1] = tsp_val;
    2004     adjust_exception_pc(xp, 4);
    2005     return;
    2006   }
    20071486 
    2008   if (frame->backlink == (frame+1)) {
    2009     if (
    2010 #ifdef PPC64
    2011         (major_opcode_p(instr, major_opcode_DS_STORE64)) &&
    2012         (DS_VARIANT_FIELD(instr) == DS_STORE64_VARIANT_STD) &&
    2013 #else
    2014         (major_opcode_p(instr, major_opcode_STW)) &&
    2015 #endif
    2016         (RA_field(instr) == sp) &&
    2017         /* There are a few places in the runtime that store into
    2018            a previously-allocated frame atop the stack when
    2019            throwing values around.  We only care about the case
    2020            where the frame was newly allocated, in which case
    2021            there must have been a CREATE_LISP_FRAME_INSTRUCTION
    2022            a few instructions before the current program counter.
    2023            (The whole point here is that a newly allocated frame
    2024            might contain random values that we don't want the
    2025            GC to see; a previously allocated frame should already
    2026            be completely initialized.)
    2027         */
    2028         ((program_counter[-1] == CREATE_LISP_FRAME_INSTRUCTION) ||
    2029          (program_counter[-2] == CREATE_LISP_FRAME_INSTRUCTION) ||
    2030          (program_counter[-3] == CREATE_LISP_FRAME_INSTRUCTION)))  {
    2031 #ifdef PPC64
    2032       int disp = DS_field(instr);
    2033 #else     
    2034       int disp = D_field(instr);
    2035 #endif
    2036 
    2037 
    2038       if (disp < (4*node_size)) {
    2039 #if 0
    2040         fprintf(dbgout, "pc-luser: finish SP frame in 0x%x, disp = %d\n",tcr, disp);
    2041 #endif
    2042         frame->savevsp = 0;
    2043         if (disp < (3*node_size)) {
    2044           frame->savelr = 0;
    2045           if (disp == node_size) {
    2046             frame->savefn = 0;
    2047           }
    2048         }
    2049       }
    2050       return;
    2051     }
    2052   }
    2053 
    20541487  if (allocptr_tag != tag_fixnum) {
    20551488    signed_natural disp = allocptr_displacement(xp);
     
    20881521      } else {
    20891522        update_bytes_allocated(tcr, (void *) ptr_from_lispobj(cur_allocptr + disp));
    2090         xpGPR(xp, allocbase) = VOID_ALLOCPTR;
    20911523        xpGPR(xp, allocptr) = VOID_ALLOCPTR - disp;
    20921524      }
    20931525    } else {
    2094 #ifdef DEBUG
    2095       fprintf(dbgout, "tcr 0x%x is past alloc trap, finishing alloc at 0x%x\n", tcr, xpGPR(xp,allocptr));
    2096 #endif
    20971526      /* If we're already past the alloc_trap, finish allocating
    20981527         the object. */
    20991528      if (allocptr_tag == fulltag_cons) {
    21001529        finish_allocating_cons(xp);
    2101 #ifdef DEBUG
    2102           fprintf(dbgout, "finish allocating cons in TCR = #x%x\n",
    2103                   tcr);
    2104 #endif
    21051530      } else {
    21061531        if (allocptr_tag == fulltag_misc) {
    2107 #ifdef DEBUG
    2108           fprintf(dbgout, "finish allocating uvector in TCR = #x%x\n",
    2109                   tcr);
    2110 #endif
    21111532          finish_allocating_uvector(xp);
    21121533        } else {
     
    21161537      /* Whatever we finished allocating, reset allocptr/allocbase to
    21171538         VOID_ALLOCPTR */
    2118       xpGPR(xp,allocptr) = xpGPR(xp,allocbase) = VOID_ALLOCPTR;
     1539      xpGPR(xp,allocptr) = VOID_ALLOCPTR;
    21191540    }
    21201541    return;
    21211542  }
    2122 
    2123   if ((instr & INIT_CATCH_FRAME_MASK) == INIT_CATCH_FRAME_INSTRUCTION) {
    2124     LispObj *frame = ptr_from_lispobj(untag(xpGPR(xp, nargs)));
    2125     int idx = ((int)((short)(D_field(instr))+fulltag_misc))>>fixnumshift;
    2126 #if 0
    2127         fprintf(dbgout, "pc-luser: CATCH frame in 0x%x, idx = %d\n",tcr, idx);
    2128 #endif
    2129 
    2130     for (;idx < sizeof(catch_frame)/sizeof(LispObj); idx++) {
    2131       deref(frame,idx) = 0;
    2132     }
    2133     ((LispObj *)(xpGPR(xp, tsp)))[1] = 0;
    2134     return;
    2135   }
    2136 
    2137 #ifndef PC64
    2138   if ((major_opcode_p(instr, 47)) && /* 47 = stmw */
    2139       (RA_field(instr) == vsp)) {
    2140     int r;
    2141     LispObj *vspptr = ptr_from_lispobj(xpGPR(xp,vsp));
    2142    
    2143     for (r = RS_field(instr); r <= 31; r++) {
    2144       *vspptr++ = xpGPR(xp,r);
    2145     }
    2146     adjust_exception_pc(xp, 4);
    2147   }
    2148 #endif
    21491543}
    21501544
     
    21801574          old_valence = prepare_to_wait_for_exception_lock(tcr, context);
    21811575          wait_for_exception_lock_in_handler(tcr, context, &xframe_link);
    2182 #ifdef DEBUG
    2183           fprintf(dbgout, "[0x%x acquired exception lock for interrupt]\n",tcr);
    2184 #endif
    21851576          PMCL_exception_handler(signum, context, tcr, info, old_valence);
    21861577          if (disp) {
     
    21881579          }
    21891580          unlock_exception_lock_in_handler(tcr);
    2190 #ifdef DEBUG
    2191           fprintf(dbgout, "[0x%x released exception lock for interrupt]\n",tcr);
    2192 #endif
    21931581          exit_signal_handler(tcr, old_valence);
    21941582        }
     
    22131601    0 /* SA_RESTART */
    22141602    | SA_SIGINFO
    2215 #ifdef DARWIN
    2216 #ifdef PPC64
    2217     | SA_64REGSET
    2218 #endif
    2219 #endif
    22201603    ;
    22211604
     
    22651648    tcr->valence = TCR_STATE_FOREIGN;
    22661649    a = tcr->vs_area;
    2267     if (a) {
    2268       a->active = a->high;
    2269     }
    2270     a = tcr->ts_area;
    22711650    if (a) {
    22721651      a->active = a->high;
     
    23181697extend_tcr_tlb(TCR *tcr,
    23191698               ExceptionInformation *xp,
    2320                unsigned limit_regno,
    23211699               unsigned idx_regno)
    23221700{
     
    23431721  tcr->tlb_pointer = new_tlb;
    23441722  tcr->tlb_limit = new_limit;
    2345   xpGPR(xp, limit_regno) = new_limit;
    23461723  return true;
    23471724}
     
    24441821*/
    24451822
    2446 #ifdef PPC64
    2447 #define C_REDZONE_LEN           320
    2448 #define C_STK_ALIGN             32
    2449 #else
    2450 #define C_REDZONE_LEN           224
    2451 #define C_STK_ALIGN             16
    2452 #endif
    2453 #define C_PARAMSAVE_LEN         64
    2454 #define C_LINKAGE_LEN           48
    24551823
    24561824#define TRUNC_DOWN(a,b,c)  (((((natural)a)-(b))/(c)) * (c))
     
    24701838  /* Set the thread's FP state from the pseudosigcontext */
    24711839  kret = thread_set_state(thread,
    2472                           PPC_FLOAT_STATE,
     1840                          ARM_FLOAT_STATE,
    24731841                          (thread_state_t)&(mc->__fs),
    2474                           PPC_FLOAT_STATE_COUNT);
     1842                          ARM_FLOAT_STATE_COUNT);
    24751843
    24761844  MACH_CHECK_ERROR("setting thread FP state", kret);
    24771845
    24781846  /* The thread'll be as good as new ... */
    2479 #ifdef PPC64
    2480   kret = thread_set_state(thread,
    2481                           PPC_THREAD_STATE64,
    2482                           (thread_state_t)&(mc->__ss),
    2483                           PPC_THREAD_STATE64_COUNT);
    2484 #else
    24851847  kret = thread_set_state(thread,
    24861848                          MACHINE_THREAD_STATE,
    24871849                          (thread_state_t)&(mc->__ss),
    24881850                          MACHINE_THREAD_STATE_COUNT);
    2489 #endif
    24901851  MACH_CHECK_ERROR("setting thread state", kret);
    24911852
     
    25281889                            natural *new_stack_top)
    25291890{
    2530 #ifdef PPC64
    2531   ppc_thread_state64_t ts;
    2532 #else
    2533   ppc_thread_state_t ts;
    2534 #endif
     1891  arm_thread_state_t ts;
    25351892  mach_msg_type_number_t thread_state_count;
    25361893  kern_return_t result;
     
    25391896  natural stackp, backlink;
    25401897
    2541 #ifdef PPC64
    2542   thread_state_count = PPC_THREAD_STATE64_COUNT;
    2543   result = thread_get_state(thread,
    2544                             PPC_THREAD_STATE64,
     1898  thread_state_count = MACHINE_THREAD_STATE_COUNT;
     1899  result = thread_get_state(thread,
     1900                            ARM_THREAD_STATE,   /* GPRs, some SPRs  */
    25451901                            (thread_state_t)&ts,
    25461902                            &thread_state_count);
    2547 #else
    2548   thread_state_count = MACHINE_THREAD_STATE_COUNT;
    2549   result = thread_get_state(thread,
    2550                             PPC_THREAD_STATE,   /* GPRs, some SPRs  */
    2551                             (thread_state_t)&ts,
    2552                             &thread_state_count);
    2553 #endif
    25541903 
    25551904  if (result != KERN_SUCCESS) {
  • branches/arm/lisp-kernel/arm-exceptions.h

    r13716 r13737  
    11/*
    2    Copyright (C) 2009 Clozure Associates
    3    Copyright (C) 1994-2001 Digitool, Inc
     2   Copyright (C) 2010 Clozure Associates
    43   This file is part of Clozure CL. 
    54
     
    1514   http://opensource.franz.com/preamble.html
    1615*/
    17 #define UUO_MASK 0xfc00000f
     16#define UUO_MASK 0x0ff000f0
    1817
    19 #define IS_UUO(i) (((i) & UUO_MASK) == 0xb)
    20 /* If an instruction is a UUO, the minor opcode is in bits 21:27 */
    21 #define UUO_MINOR(u) (((u) >> 4) & 0x7f)
     18#define IS_UUO(i) (((i) & UUO_MASK) == 0x07f000f0)
     19/* If an instruction is a UUO its format is determined by the low 4 bits */
     20#define UUO_FORMAT(i) ((i)&0xf)
     21
     22#define UUO_UNARY_field(uuo) (((uuo)>>12)&0xff)
     23#define UUOA_field(uuo)      (((uuo)>>8) &0x0f)
     24
     25#define uuo_format_nullary          0 /* 12 bits of code */
     26#define uuo_format_unary            1 /* 8 bits of info - NOT type info - 4-bit reg */
     27#define uuo_format_error_lisptag    2 /* 2 bits of lisptag info, 4-bit reg */
     28#define uuo_format_error_fulltag    3 /* 3 bits of fulltag info, 4 bit reg */
     29
     30#define uuo_format_error_xtype      4 /* 8 bits of extended type/subtag info, 4 bit reg */
     31#define uuo_format_binary           7 /* 4 bits of code, r1, r0 */
     32#define uuo_format_nullary_error    8 /* nullary, call out to lisp */
     33#define uuo_format_unary_error      9 /* like unary, but call out to lisp */
     34#define uuo_format_cerror_lisptag  10 /* continuable, lisptag, reg */
     35#define uuo_format_cerror_fulltag  11 /* continuable, fulltag, reg */
     36#define uuo_format_cerror_xtype    12 /* continuable, xtype, reg */ 
     37#define uuo_format_kernel_service  13 /* 8 bits of info */     
     38#define uuo_format_binary_error    15 /* binary format, call out to lisp */
     39
     40
     41
    2242
    2343typedef u_int32_t opcode, *pc;
    2444
    2545OSStatus
    26 handle_uuo(ExceptionInformation *, opcode, pc);
     46handle_uuo(ExceptionInformation *, opcode);
    2747
    2848
    2949
    30 /*
    31   Unconditional traps (tw, twi instructions) are used by the
    32   operating system.  We use conditional traps.
    33   */
    34 
    3550int
    36 is_conditional_trap(opcode);
    37 
    38 #define kNameBufLen 256
    39 #define TRAP_LOOKUP_TRIES 5   /* # instrs to scan before trap instr */
    40 
    41 void
    42 callback_for_trap (LispObj, ExceptionInformation *, pc, natural, natural, natural);
     51callback_for_trap (LispObj, ExceptionInformation *, natural, natural);
    4352
    4453natural
    4554register_codevector_contains_pc (natural, pc);
    4655
    47 void
    48 callback_to_lisp (LispObj, ExceptionInformation *, natural, natural, natural, natural, natural);
     56int
     57callback_to_lisp (LispObj, ExceptionInformation *, natural, natural);
    4958
    5059OSStatus
    5160handle_trap(ExceptionInformation *, opcode, pc, siginfo_t *);
    5261
    53 unsigned
    54 scan_for_instr( unsigned, unsigned, pc );
     62
     63/* */
     64
     65#define RN_field(i) (((i)>>16)&0xf)
     66#define RD_field(i) (((i)>>12)&0xf)
     67#define RM_field(i) ((i)&0xf)
     68
     69#define IS_SUB_RM_FROM_ALLOCPTR(i)   (((i)&0x0ffff000) == 0x004cc000)
     70#define IS_SUB_FROM_ALLOCPTR(i)      (((i)&0x0fffff00) == 0x024cc000)
     71#define IS_SUB_LO_FROM_ALLOCPTR(i)   (((i)&0x0fffff00) == 0x024cc000)
     72#define IS_SUB_HI_FROM_ALLOCPTR(i)   (IS_SUB_FROM_ALLOCPTR(i) && \
     73                                     !(IS_SUB_LOW_FROM_ALLOCPTR(i)))
     74#define IS_LOAD_RD_FROM_ALLOCBASE(i) (((i)&0x0fff0fff) == \
     75                                      ( 0x05930000 | offsetof(tcr,allocbase)))
     76#define IS_COMPARE_ALLOCPTR_TO_RM(i) (((i)&0x0fffff0) == 0x0140c000)
     77#define IS_ALLOC_TRAP(i) (((i)&0x0fffffff) == 0x07f000f0)
     78#define IS_SET_ALLOCPTR_HEADER_RD(i) (((i)&0x0fff0fff) == \
     79                                      (0x050c0000 | (- misc_header_offset)))
     80/* The 1 here - and the 3 in the following definition - are based on
     81   the tagged offsets of cars and cdrs.  Fix these definitions of that ever
     82   changes ... */
     83#define IS_SET_ALLOCPTR_CDR_RD(i)    (((i)&0x0fff0fff) == 0x050c0001)
     84#define IS_SET_ALLOCPTR_CAR_RD(i)    (((i)&0x0fff0fff) == 0x058c0003)
     85#define IS_SET_ALLOCPTR_RESULT_RD(i) (((i)&0x0fff0fff) == 0x01a0000c)
     86#define IS_CLR_ALLOCPTR_TAG(i)       (((i)&0x0fffffff) == 0x03ccc007)
    5587
    5688
    57 
    58 #define UUO_INTERR (11)
    59 #define UUO_INTCERR (12)
    60 #define UUO_INTERR2 (13)
    61 #define UUO_INTCERR2 (14)
    62 
    63 #define UUO_FPUX_BINOP (22)
    64 #define UUO_ZERO_FPSCR (25)
     89#define IS_GC_TRAP(i)                (((i)*0x0fffffff) == 0x07f001f0)
     90#define IS_DEBUG_TRAP(i)             (((i)*0x0fffffff) == 0x07f002f0)
     91#define IS_DEFERRED_INTERRUPT(i)     (((i)*0x0fffffff) == 0x07f004f0)
     92#define IS_DEFERRED_SUSPEND(i)       (((i)*0x0fffffff) == 0x07f005f0)
    6593
    6694
    67 /* PPC instructions */
    68 #define match_instr(instr, mask, target)   (((instr) & (mask)) == (target))
    69 #define RS_field(instr)  (((instr) >> 21) & 0x1f)
    70 #define RT_field(instr)  (RS_field(instr))
    71 #define TO_field(instr)  (RT_field(instr))
    72 #define RA_field(instr)  (((instr) >> 16) & 0x1f)
    73 #define RB_field(instr)  (((instr) >> 11) & 0x1f)
    74 #define D_field(instr)   ((instr) & 0xffff)
    75 #define DS_field(instr)  ((instr) & 0xfffc)
    76 #define DS_VARIANT_FIELD(instr) ((instr) & 3)
    77 
    78 #define RT(val) ((val & 0x1f) << 21)
    79 #define RS(val) (RT(val))
    80 #define RA(val) ((val & 0x1f) << 16)
    81 #define RB(val) ((val & 0x1f) << 11)
    82 #define D(val) (val & 0xffff)
    83 
    84 #define RS_MASK RS(-1)
    85 #define RT_MASK RS_MASK
    86 #define TO_MASK RS_MASK
    87 #define RA_MASK RA(-1)
    88 #define RB_MASK RB(-1)
    89 #define D_MASK  D(-1)
    90 
    91 
    92 
    93 #define OP(x) (((x) & 0x3f) << 26)
    94 #define OP_MASK OP (0x3f)
    95 
    96 /* Main opcode + TO field of a D form instruction */
    97 #define OPTO(x,to) (OP(x) | (((to) & 0x1f) << 21))
    98 #define OPTO_MASK (OP_MASK | TO_MASK)
    99 #define OPTORA(x,to,ra) (OPTO(x,to) | RA(ra))
    100 #define OPTORA_MASK (OP_TO_MASK | RA_MASK)
    101 
    102 
    103 
    104 
    105 /* An X form instruction.  */
    106 #define X(op, xop) (OP (op) | (((xop) & 0x3ff) << 1))
    107 
    108 /* An X form instruction with the RC bit specified.  */
    109 #define XRC(op, xop, rc) (X ((op), (xop)) | ((rc) & 1))
    110 
    111 /* The mask for an X form instruction.  */
    112 #define X_MASK XRC(0x3f, 0x3ff, 1)
    113 
    114 /* An XO form instruction */
    115 #define XO(op, xop, oe, rc) \
    116   (OP (op) | ((((unsigned long)(xop)) & 0x1ff) << 1) | ((((unsigned long)(oe)) & 1) << 10) | (((unsigned long)(rc)) & 1))
    117 #define XO_MASK XO (0x3f, 0x1ff, 1, 1)
    118 
    119 
    120 
    121 /* The bits in the TO field of a TW or TWI instruction */
    122 #define TO_LT (1<<4)            /* signed < */
    123 #define TO_GT (1<<3)            /* signed > */
    124 #define TO_EQ (1<<2)            /* = */
    125 #define TO_LO (1<<1)            /* unsigned < */
    126 #define TO_HI (1<<0)            /* unsigned > */
    127 #define TO_NE (TO_LT|TO_GT)
    128 
    129 /* True if major opcode of "instr" is "op" */
    130 #define major_opcode_p(instr, op) match_instr((instr),OP_MASK,OP(op))
    131 
    132 /* True if "instr" is an X form instruction with major opcode "major"
    133    and minor opcode "minor" */
    134 #define X_opcode_p(instr,major,minor) match_instr((instr),X_MASK,X(major,minor))
    135 
    136 #define major_opcode_TDI 2
    137 #define major_opcode_TWI 3
    138 #ifdef PPC64
    139 #define major_opcode_TRI major_opcode_TDI
    140 #else
    141 #define major_opcode_TRI major_opcode_TWI
    142 #endif
    143 #define major_opcode_ADDI 14
    144 #define major_opcode_RLWINM 21
    145 #define major_opcode_X31 31             /* an "X" form instruction; see minor opcode */
    146 #define major_opcode_LWZ 32
    147 #define major_opcode_LBZ 34
    148 #define major_opcode_STW 36
    149 #define major_opcode_STWU 37
    150 #define major_opcode_LD_LDU_LWA 58
    151 #define major_opcode_FPU_SINGLE 59
    152 #define major_opcode_FPU_DOUBLE 63
    153 
    154 #define minor_opcode_TW 4
    155 #define minor_opcode_TD 68
    156 #ifdef PPC64
    157 #define minor_opcode_TR minor_opcode_TD
    158 #else
    159 #define minor_opcode_TR minor_opcode_TW
    160 #endif
    161 #define minor_opcode_SUBF 40
    162 #define minor_opcode_STWX 151
    163 #define minor_opcode_STWUX 183
    164 
    165 #define major_opcode_DS_LOAD64 58
    166 #define DS_LOAD64_VARIANT_LD 0
    167 
    168 #define major_opcode_DS_STORE64 62
    169 #define DS_STORE64_VARIANT_STD 0
    170 
    171 
    172 
    173 #define D_instruction(major,rt,ra,imm) (OP(major)|((rt)<<21)|((ra)<<16)|((imm)&D_MASK))
    174 #define DS_instruction(major,rt,ra,imm,minor) (OP(major)|((rt)<<21)|((ra)<<16)|(((imm)&D_MASK)&~3)|((minor)&3))
    175 #define TRI_instruction(rt,ra,imm)     D_instruction(major_opcode_TRI,rt,ra,imm)
    176 #define LBZ_instruction(rt,ra,imm)     D_instruction(major_opcode_LBZ,rt,ra,imm)
    177 #define LWZ_instruction(rt,ra,imm)     D_instruction(major_opcode_LWZ,rt,ra,imm)
    178 #define LD_instruction(rt,ra,imm)      DS_instruction(58,rt,ra,imm,0)
    179 
    180 #define D_RT_IMM_MASK                  (OP_MASK|RT_MASK|D_MASK)
    181 #define D_RA_IMM_MASK                  (OP_MASK|RA_MASK|D_MASK)
    182 
    183 #define X_instruction(major,minor,rt,ra,rb) (X(major,minor)|((rt)<<21)|((ra)<<16)|((rb)<<11))
    184 
    185 #define unmasked_register              0
    186 
    187 #define LISP_BREAK_INSTRUCTION 0x7f810808
    188 #define QUIET_LISP_BREAK_INSTRUCTION 0x7c800008
    189 
    190 #ifdef PPC64
    191 /* Have to use signed comparisons on PPC64; if we decrememt
    192    allocptr and it "wraps around" address 0, that's an
    193    attempt to allocate a large object.  Note that this
    194    means that valid heap addresses can't have the high
    195    bit set. */
    196 /* tdlt allocptr,allocbase */
    197 #define ALLOC_TRAP_INSTRUCTION 0x7e095088
    198 #else
    199 /* On PPC32, we can use an unsigned comparison, as long
    200    as  HEAP_IMAGE_BASE+PURESPACE_RESERVE is greater than
    201    the maximum possible allocation (around 27 bits).
    202    Decrementing allocptr may cause it to wrap around
    203    #x80000000, but it should never wrap around 0. */
    204 /* twllt allocptr,allocbase */
    205 #define ALLOC_TRAP_INSTRUCTION 0x7c495008
    206 #endif
    207 
    208 #ifdef PPC64
    209 /* tdlgei allocptr,0 */
    210 #define GC_TRAP_INSTRUCTION 0x08a90000
    211 #else
    212 /* twlgei allocptr,0 */
    213 #define GC_TRAP_INSTRUCTION 0x0ca90000
    214 #endif
    215 
    216 #ifdef PPC64
    217 /* clrrdi allocptr,allocptr,4 */
    218 #define UNTAG_ALLOCPTR_INSTRUCTION 0x792906e4
    219 #else
    220 /* clrrwi allocptr,allocptr,3 */
    221 #define UNTAG_ALLOCPTR_INSTRUCTION 0x55290038
    222 #endif
    223 
    224 #ifdef PPC64
    225 /* std rX,misc_header_offset(allocptr) */
    226 #define STORE_HEADER_ALLOCPTR_INSTRUCTION 0xf809fff4
    227 #else
    228 /* stw rX,misc_header_offset(allocptr) */
    229 #define STORE_HEADER_ALLOCPTR_INSTRUCTION 0x9009fffa
    230 #endif
    231 #define STORE_HEADER_ALLOCPTR_MASK D_RA_IMM_MASK
    232 
    233 #ifdef PPC64
    234 /* std rX,cons.cXr(allocptr) */
    235 #define STORE_CAR_ALLOCPTR_INSTRUCTION 0xf8090004
    236 #define STORE_CDR_ALLOCPTR_INSTRUCTION 0xf809fffc
    237 #else
    238 /* stw rX,cons.cXr(allocptr) */
    239 #define STORE_CAR_ALLOCPTR_INSTRUCTION 0x90090003
    240 #define STORE_CDR_ALLOCPTR_INSTRUCTION 0x9009ffff
    241 #endif
    242 #define STORE_CXR_ALLOCPTR_MASK D_RA_IMM_MASK
    243 
    244 
    245 #ifdef PPC64
    246 /* stdu sp,-32(sp) */
    247 #define CREATE_LISP_FRAME_INSTRUCTION 0xf821ffe1
    248 #else
    249 /* stwu sp,-16(sp) */
    250 #define CREATE_LISP_FRAME_INSTRUCTION 0x9421fff0
    251 #endif
    252 
    253 #ifdef PPC64
    254 /* std tsp,tsp_frame.type(tsp) */
    255 #define MARK_TSP_FRAME_INSTRUCTION 0xf98c0008
    256 #else
    257 /* stw tsp,tsp_frame.type(tsp) */
    258 #define MARK_TSP_FRAME_INSTRUCTION 0x918c0004
    259 #endif
    260 
    261 #ifdef PPC64
    262 #define INIT_CATCH_FRAME_INSTRUCTION (0xf8000000 | RA(nargs))
    263 #define INIT_CATCH_FRAME_MASK (OP_MASK | RA_MASK)
    264 #else
    265 #define INIT_CATCH_FRAME_INSTRUCTION (0x90000000 | RA(nargs))
    266 #define INIT_CATCH_FRAME_MASK (OP_MASK | RA_MASK)
    267 #endif
    268 
    26995OSStatus
    270 handle_error(ExceptionInformation *, unsigned, unsigned, unsigned, pc);
     96handle_error(ExceptionInformation *, unsigned, unsigned);
    27197
    27298typedef char* vector_buf;
     
    286112#endif
    287113
    288 /* Yet another way to look at a branch instruction ... */
    289 typedef union {
    290   struct {unsigned op:6, li:24, aa:1, lk:1;} b;
    291   unsigned opcode;
    292 } branch_instruction;
    293 
    294 
    295 
    296   /* Enable exceptions (at least, enable another thread's attempts to
    297      suspend this one) by restoring the signal mask.
    298   */
    299 
    300114
    301115
     
    308122
    309123
    310 #ifdef LINUX
    311 register void *current_r2 __asm__("r2");
    312 #endif
    313124
    314125Boolean
    315 extend_tcr_tlb(TCR *, ExceptionInformation *, unsigned, unsigned);
     126extend_tcr_tlb(TCR *, ExceptionInformation *, unsigned);
    316127
    317128void
    318129pc_luser_xp(ExceptionInformation *, TCR *, signed_natural *);
    319130
     131#define codevec_hdr_p(value) ((value) == 0)
    320132
    321 #ifdef PPC64
    322 #define codevec_hdr_p(value) ((value) == (('C'<<24)|('O'<<16)|('D'<<8)|'E'))
     133#ifdef __GNUC__
     134static __inline__ natural
     135ror(natural val, natural count) __attribute__((always_inline));
     136
     137static __inline__ natural
     138ror(natural val,natural count)
     139{
     140  natural result;
     141  __asm__ __volatile__("ror %[result],%[val],%[count]"
     142                       :[result] "=r" (result)
     143                       :[val] "r" (val),
     144                        [count] "r" (count));
     145  return result;
     146}
    323147#else
    324 /* top 6 bits will be zero, subtag will be subtag_code_vector */
    325 #define CV_HDR_MASK     (OP_MASK | subtagmask)
    326 #define CV_HDR_VALUE    subtag_code_vector
    327 #define codevec_hdr_p(value)    (((value) & CV_HDR_MASK) == CV_HDR_VALUE)
     148extern natural ror(natural, natural);
    328149#endif
    329 
    330 
  • branches/arm/lisp-kernel/arm-gc.c

    r13716 r13737  
    4141
    4242
    43 #ifdef PPC64
    44   case fulltag_imm_0:
    45   case fulltag_imm_1:
    46   case fulltag_imm_2:
    47   case fulltag_imm_3:
    48 #else
    4943  case fulltag_imm:
    50 #endif
    5144
    5245
    5346    return;
    5447
    55 #ifndef PPC64
    5648  case fulltag_nil:
    5749    if (n != lisp_nil) {
     
    5951    }
    6052    return;
    61 #endif
    62 
    63 
    64 #ifdef PPC64
    65   case fulltag_nodeheader_0:
    66   case fulltag_nodeheader_1:
    67   case fulltag_nodeheader_2:
    68   case fulltag_nodeheader_3:
    69   case fulltag_immheader_0:
    70   case fulltag_immheader_1:
    71   case fulltag_immheader_2:
    72   case fulltag_immheader_3:
    73 #else
     53
     54
    7455  case fulltag_nodeheader:
    7556  case fulltag_immheader:
    76 #endif
    7757
    7858
     
    253233
    254234
    255 #ifdef PPC64
    256     if ((nodeheader_tag_p(tag_n)) ||
    257         (tag_n == ivector_class_64_bit)) {
    258       total_size_in_bytes = 8 + (element_count<<3);
    259     } else if (tag_n == ivector_class_8_bit) {
    260       total_size_in_bytes = 8 + element_count;
    261     } else if (tag_n == ivector_class_32_bit) {
    262       total_size_in_bytes = 8 + (element_count<<2);
    263     } else {
    264       /* ivector_class_other_bit contains 16-bit arrays & bitvector */
    265       if (subtag == subtag_bit_vector) {
    266         total_size_in_bytes = 8 + ((element_count+7)>>3);
    267       } else {
    268         total_size_in_bytes = 8 + (element_count<<1);
    269       }
    270     }
    271 #else
    272235    if ((tag_n == fulltag_nodeheader) ||
    273236        (subtag <= max_32_bit_ivector_subtag)) {
     
    282245      total_size_in_bytes = 4 + ((element_count+7)>>3);
    283246    }
    284 #endif
    285 
    286247
    287248
     
    365326 
    366327
    367 #ifdef PPC64
    368 /* Any register (srr0, the lr or ctr) or stack location that
    369    we're calling this on should have its low 2 bits clear; it'll
    370    be tagged as a "primary" object, but the pc/lr/ctr should
    371    never point to a tagged object or contain a fixnum.
    372    
    373    If the "pc" appears to be pointing into a heap-allocated
    374    code vector that's not yet marked, back up until we find
    375    the code-vector's prefix (the 32-bit word containing the
    376    value 'CODE' whic precedes the code-vector's first instruction)
    377    and mark the entire code-vector.
    378 */
    379 void
    380 mark_pc_root(LispObj xpc)
    381 {
    382   if ((xpc & 3) != 0) {
    383     Bug(NULL, "Bad PC locative!");
    384   } else {
    385     natural dnode = gc_area_dnode(xpc);
    386     if ((dnode < GCndnodes_in_area) &&
    387         !ref_bit(GCmarkbits,dnode)) {
    388       LispObj
    389         *headerP,
    390         header;
    391       opcode *program_counter;
    392 
    393       for(program_counter=(opcode *)ptr_from_lispobj(xpc & ~7);
    394           (LispObj)program_counter >= GCarealow;
    395           program_counter-=2) {
    396         if (*program_counter == PPC64_CODE_VECTOR_PREFIX) {
    397           headerP = ((LispObj *)program_counter)-1;
    398           header = *headerP;
    399           dnode = gc_area_dnode(headerP);
    400           set_n_bits(GCmarkbits, dnode, (8+(header_element_count(header)<<2)+(dnode_size-1))>>dnode_shift);
    401           return;
    402         }
    403       }
    404       /*
    405         Expected to have found a header by now, but didn't.
    406         That's a bug.
    407         */
    408       Bug(NULL, "code_vector header not found!");
    409     }
    410   }
    411 }
    412 #else /* PPC64 */
    413328/*
    414   Some objects (saved LRs on the control stack, the LR, PC, and CTR
     329  Some objects (saved LRs on the control stack, the LR,
    415330  in exception frames) may be tagged as fixnums but are really
    416331  locatives into code_vectors.
     
    435350        header;
    436351
    437       for(headerP = (LispObj*)ptr_from_lispobj(untag(pc));
    438           dnode < GCndnodes_in_area;
    439           headerP-=2, --dnode) {
     352      for(headerP = (LispObj*)(pc);
     353          gc_area_dnode(headerP) < GCndnodes_in_area;
     354          headerP++) {
    440355        header = *headerP;
    441 
    442         if ((header & code_header_mask) == subtag_code_vector) {
    443           set_n_bits(GCmarkbits, dnode, (2+header_element_count(header))>>1);
    444           return;
     356        if (header == 0) {      /* start of constant pool or end of function */
     357          headerP++;
     358          headerP -=  *headerP;
     359          header = *headerP;
     360          if (header_subtag(header) == subtag_code_vector) {
     361            set_n_bits(GCmarkbits, dnode, (2+header_element_count(header))>>1);
     362            return;
     363          }
     364          break;
    445365        }
    446366      }
     
    453373  }
    454374}
    455 #endif /* PPC64 */
    456 
    457 
    458 
    459 #ifdef PPC64
    460 #define RMARK_PREV_ROOT fulltag_imm_3
    461 #define RMARK_PREV_CAR fulltag_misc
    462 #else
     375
     376
    463377#define RMARK_PREV_ROOT fulltag_imm
    464378#define RMARK_PREV_CAR fulltag_nil
    465 #endif
    466379
    467380
     
    508421        suffix_dnodes;
    509422      tag_n = fulltag_of(header);
    510 #ifdef PPC64
    511       if ((nodeheader_tag_p(tag_n)) ||
    512           (tag_n == ivector_class_64_bit)) {
    513         total_size_in_bytes = 8 + (element_count<<3);
    514       } else if (tag_n == ivector_class_8_bit) {
    515         total_size_in_bytes = 8 + element_count;
    516       } else if (tag_n == ivector_class_32_bit) {
    517         total_size_in_bytes = 8 + (element_count<<2);
    518       } else {
    519         /* ivector_class_other_bit contains 16-bit arrays & bitvector */
    520         if (subtag == subtag_bit_vector) {
    521           total_size_in_bytes = 8 + ((element_count+7)>>3);
    522         } else {
    523           total_size_in_bytes = 8 + (element_count<<1);
    524         }
    525       }
    526 #else
    527423      if ((tag_n == fulltag_nodeheader) ||
    528424          (subtag <= max_32_bit_ivector_subtag)) {
     
    537433        total_size_in_bytes = 4 + ((element_count+7)>>3);
    538434      }
    539 #endif
    540435
    541436
     
    702597      tag_n = fulltag_of(header);
    703598
    704 #ifdef PPC64
    705       if ((nodeheader_tag_p(tag_n)) ||
    706           (tag_n == ivector_class_64_bit)) {
    707         total_size_in_bytes = 8 + (element_count<<3);
    708       } else if (tag_n == ivector_class_8_bit) {
    709         total_size_in_bytes = 8 + element_count;
    710       } else if (tag_n == ivector_class_32_bit) {
    711         total_size_in_bytes = 8 + (element_count<<2);
    712       } else {
    713         /* ivector_class_other_bit contains 16-bit arrays & bitvector */
    714         if (subtag == subtag_bit_vector) {
    715           total_size_in_bytes = 8 + ((element_count+7)>>3);
    716         } else {
    717           total_size_in_bytes = 8 + (element_count<<1);
    718         }
    719       }
    720 #else
    721599      if ((tag_n == fulltag_nodeheader) ||
    722600          (subtag <= max_32_bit_ivector_subtag)) {
     
    731609        total_size_in_bytes = 4 + ((element_count+7)>>3);
    732610      }
    733 #endif
    734611
    735612
     
    810687    nbytes;
    811688
    812 #ifdef PPC64
    813   switch (fulltag_of(header)) {
    814   case ivector_class_64_bit:
    815     nbytes = element_count << 3;
    816     break;
    817   case ivector_class_32_bit:
    818     nbytes = element_count << 2;
    819     break;
    820   case ivector_class_8_bit:
    821     nbytes = element_count;
    822     break;
    823   case ivector_class_other_bit:
    824   default:
    825     if (subtag == subtag_bit_vector) {
    826       nbytes = (element_count+7)>>3;
    827     } else {
    828       nbytes = element_count << 1;
    829     }
    830   }
    831   return ptr_from_lispobj(start+(~15 & (nbytes + 8 + 15)));
    832 #else
    833689  if (subtag <= max_32_bit_ivector_subtag) {
    834690    nbytes = element_count << 2;
     
    843699  }
    844700  return ptr_from_lispobj(start+(~7 & (nbytes + 4 + 7)));
    845 #endif
    846 
    847 
    848 
    849701}
    850702
     
    11791031  natural *regs = (natural *) xpGPRvector(xp);
    11801032
    1181 #ifdef PPC
    11821033  int r;
    11831034  /* registers >= fn should be tagged and marked as roots.
     
    11911042     */
    11921043
    1193   for (r = fn; r < 32; r++) {
     1044  for (r = arg_z; r <= fn; r++) {
    11941045    mark_root((regs[r]));
    11951046  }
     
    11971048
    11981049
    1199   mark_pc_root((regs[loc_pc]));
    12001050  mark_pc_root(ptr_to_lispobj(xpPC(xp)));
    12011051  mark_pc_root(ptr_to_lispobj(xpLR(xp)));
    1202   mark_pc_root(ptr_to_lispobj(xpCTR(xp)));
    1203 #endif /* PPC */
     1052
    12041053
    12051054}
     
    12501099}
    12511100
    1252 #ifdef PPC64
    1253 LispObj
    1254 dnode_forwarding_address(natural dnode, int tag_n)
    1255 {
    1256   natural pagelet, nbits;
    1257   unsigned int near_bits;
    1258   LispObj new;
    1259 
    1260   if (GCDebug) {
    1261     if (! ref_bit(GCdynamic_markbits, dnode)) {
    1262       Bug(NULL, "unmarked object being forwarded!\n");
    1263     }
    1264   }
    1265 
    1266   pagelet = dnode >> bitmap_shift;
    1267   nbits = dnode & bitmap_shift_count_mask;
    1268   near_bits = ((unsigned int *)GCdynamic_markbits)[dnode>>(dnode_shift+1)];
    1269 
    1270   if (nbits < 32) {
    1271     new = GCrelocptr[pagelet] + tag_n;;
    1272     /* Increment "new" by the count of 1 bits which precede the dnode */
    1273     if (near_bits == 0xffffffff) {
    1274       return (new + (nbits << 4));
    1275     } else {
    1276       near_bits &= (0xffffffff00000000 >> nbits);
    1277       if (nbits > 15) {
    1278         new += one_bits(near_bits & 0xffff);
    1279       }
    1280       return (new + (one_bits(near_bits >> 16)));
    1281     }
    1282   } else {
    1283     new = GCrelocptr[pagelet+1] + tag_n;
    1284     nbits = 64-nbits;
    1285 
    1286     if (near_bits == 0xffffffff) {
    1287       return (new - (nbits << 4));
    1288     } else {
    1289       near_bits &= (1<<nbits)-1;
    1290       if (nbits > 15) {
    1291         new -= one_bits(near_bits >> 16);
    1292       }
    1293       return (new -  one_bits(near_bits & 0xffff));
    1294     }
    1295   }
    1296 }
    1297 #else
    12981101LispObj
    12991102dnode_forwarding_address(natural dnode, int tag_n)
     
    13401143  }
    13411144}
    1342 #endif
    13431145
    13441146
     
    13501152
    13511153
    1352 #ifdef PPC
     1154
    13531155  /* Locatives can be tagged as conses, "fulltag_misc"
    13541156     objects, or as fixnums.  Immediates, headers, and nil
    13551157     shouldn't be "forwarded".  Nil never will be, but it
    13561158     doesn't hurt to check ... */
    1357 #ifdef PPC64
    1358   if ((tag_n & lowtag_mask) != lowtag_primary) {
    1359     return obj;
    1360   }
    1361 #else
    13621159  if ((1<<tag_n) & ((1<<fulltag_immheader) |
    13631160                    (1<<fulltag_nodeheader) |
     
    13661163    return obj;
    13671164  }
    1368 #endif
    1369 #endif
    13701165
    13711166  dnode = gc_dynamic_area_dnode(obj);
     
    15161311
    15171312  /* registers >= fn should be tagged and forwarded as roots.
    1518      the PC, LR, loc_pc, and CTR should be treated as "locatives".
     1313     the PC and LR should be treated as "locatives".
    15191314     */
    15201315
    1521   for (r = fn; r < 32; r++) {
     1316  for (r = arg_z; r <= fn; r++) {
    15221317    update_noderef((LispObj*) (&(regs[r])));
    15231318  }
    15241319
    1525   update_locref((LispObj*) (&(regs[loc_pc])));
    15261320
    15271321  update_locref((LispObj*) (&(xpPC(xp))));
    15281322  update_locref((LispObj*) (&(xpLR(xp))));
    1529   update_locref((LispObj*) (&(xpCTR(xp))));
    15301323
    15311324}
     
    16601453          tag = header_subtag(node);
    16611454
    1662 #ifdef PPC
    1663 #ifdef PPC64
    1664           switch(fulltag_of(tag)) {
    1665           case ivector_class_64_bit:
    1666             imm_dnodes = ((elements+1)+1)>>1;
    1667             break;
    1668           case ivector_class_32_bit:
    1669             if (tag == subtag_code_vector) {
    1670               GCrelocated_code_vector = true;
    1671             }
    1672             imm_dnodes = (((elements+2)+3)>>2);
    1673             break;
    1674           case ivector_class_8_bit:
    1675             imm_dnodes = (((elements+8)+15)>>4);
    1676             break;
    1677           case ivector_class_other_bit:
    1678             if (tag == subtag_bit_vector) {
    1679               imm_dnodes = (((elements+64)+127)>>7);
    1680             } else {
    1681               imm_dnodes = (((elements+4)+7)>>3);
    1682             }
    1683           }
    1684 #else
    16851455          if (tag <= max_32_bit_ivector_subtag) {
    16861456            if (tag == subtag_code_vector) {
     
    16971467            imm_dnodes = elements+1;
    16981468          }
    1699 #endif
    1700 #endif
    1701 
    17021469          dnode += imm_dnodes;
    17031470          while (--imm_dnodes) {
     
    17541521          subtag = header_subtag(header);
    17551522
    1756 #ifdef PPC64
    1757           switch(fulltag_of(header)) {
    1758           case ivector_class_64_bit:
    1759             bytes = 8 + (elements<<3);
    1760             break;
    1761           case ivector_class_32_bit:
    1762             bytes = 8 + (elements<<2);
    1763             break;
    1764           case ivector_class_8_bit:
    1765             bytes = 8 + elements;
    1766             break;
    1767           case ivector_class_other_bit:
    1768           default:
    1769             if (subtag == subtag_bit_vector) {
    1770               bytes = 8 + ((elements+7)>>3);
    1771             } else {
    1772               bytes = 8 + (elements<<1);
    1773             }
    1774           }
    1775 #else
    17761523          if (subtag <= max_32_bit_ivector_subtag) {
    17771524            bytes = 4 + (elements<<2);
     
    17851532            bytes = 4 + ((elements+7)>>3);
    17861533          }
    1787 #endif
    17881534
    17891535
     
    18781624purify_locref(LispObj *locaddr, BytePtr low, BytePtr high, area *to)
    18791625{
    1880 #ifdef PPC
    18811626  LispObj
    18821627    loc = *locaddr,
     
    18951640    case fulltag_even_fixnum:
    18961641    case fulltag_odd_fixnum:
    1897 #ifdef PPC64
    1898     case fulltag_cons:
    1899     case fulltag_misc:
    1900 #endif
    19011642      if (*headerP == forward_marker) {
    19021643        *locaddr = (headerP[1]+tag);
     
    19071648        p = (opcode *)headerP;
    19081649        do {
    1909           p -= 2;
    1910           tag += 8;
     1650          p += 1;
    19111651          insn = *p;
    1912 #ifdef PPC64
    1913         } while (insn != PPC64_CODE_VECTOR_PREFIX);
    1914         headerP = ((LispObj*)p)-1;
    1915         *locaddr = purify_displaced_object(((LispObj)headerP), to, tag);
    1916 #else
    1917       } while ((insn & code_header_mask) != subtag_code_vector);
    1918       *locaddr = purify_displaced_object(ptr_to_lispobj(p), to, tag);
    1919 #endif
    1920     }
    1921     break;
    1922 
    1923 #ifndef PPC64
    1924   case fulltag_misc:
    1925     copy_ivector_reference(locaddr, low, high, to);
    1926     break;
    1927 #endif
    1928   }
    1929 }
    1930 #endif
     1652        } while (insn);
     1653        p++;
     1654        p -= *p;
     1655        Bug(NULL, "funky code in purfiy_locref()");
     1656        *locaddr = purify_displaced_object(ptr_to_lispobj(p), to, tag);
     1657      }
     1658      break;
     1659    }
     1660  }
    19311661}
    19321662
     
    20241754  int r;
    20251755
    2026   /* registers >= fn should be treated as roots.
    2027      The PC, LR, loc_pc, and CTR should be treated as "locatives".
     1756  /* Node registers should be treated as roots.
     1757     The PC and LR should be treated as "locatives".
    20281758   */
    20291759
    2030   for (r = fn; r < 32; r++) {
     1760  for (r = arg_z; r <= fn; r++) {
    20311761    copy_ivector_reference((LispObj*) (&(regs[r])), low, high, to);
    20321762  };
    20331763
    2034   purify_locref((LispObj*) (&(regs[loc_pc])), low, high, to);
    2035 
    20361764  purify_locref((LispObj*) (&(xpPC(xp))), low, high, to);
    20371765  purify_locref((LispObj*) (&(xpLR(xp))), low, high, to);
    2038   purify_locref((LispObj*) (&(xpCTR(xp))), low, high, to);
    20391766}
    20401767
  • branches/arm/lisp-kernel/arm-spentry.s

    r13694 r13737  
    2222
    2323local_label(start):
    24         .set sporg,0       
     24        .set delta,256
     25        .set spnum,0
     26        .set sporg,0
    2527define(`_spentry',`ifdef(`__func_name',`_endfn',`')
    2628        .org sporg
     29        .set sporg,sporg+delta
     30        .set spnum,spnum+1
     31        .if spnum >= 112
     32        .set delta,1024
     33        .endif
    2734        _exportfn(_SP$1)
    28         .set sporg,sporg+256       
    2935        .line  __line__
    3036')
     
    4652')
    4753
     54/* Set the _function.entrypoint locative in nfn - which pointed here -
     55   to the address of the first instruction in the _function.codevector.
     56   This must be the first ARM subprim. */
     57
     58_spentry(fix_nfn_entrypoint)
     59        __(build_lisp_frame(imm0))
     60        __(vpush1(arg_z))
     61        __(ldr arg_z,[nfn,#_function.codevector])
     62        __(add lr,arg_z,#misc_data_offset)
     63        __(str lr,[nfn,#_function.entrypoint])
     64        __(vpop1(arg_z))
     65        __(restore_lisp_frame(imm0))
     66        __(jump_nfn())
     67       
    4868_spentry(builtin_plus)
    4969        __(test_two_fixnums(arg_y,arg_z,imm0))
     
    290310        __(unbox_fixnum(imm2,arg_z))
    291311        __(mov imm0,imm0,asl imm2)
    292         __(b _SPmake64)
     312        __(b _SPmakes64)
    2933139: 
    294314        __(jump_builtin(_builtin_ash,2))
     
    864884dnl /* the store, record the address of the hash-table vector in the refmap,  */
    865885dnl /* as well. */
    866 dnl         .globl C(egc_set_hash_key)       
     886        .globl C(egc_set_hash_key)       
    867887dnl _spentry(set_hash_key)
    868 dnl C(egc_set_hash_key):
     888C(egc_set_hash_key):
    869889dnl         __(cmplr(cr2,arg_z,arg_x))
    870890dnl         __(la imm0,misc_data_offset(arg_y))
     
    929949dnl */
    930950dnl
    931 dnl         .globl C(egc_store_node_conditional)
    932 dnl         .globl C(egc_write_barrier_end)
     951            .globl C(egc_store_node_conditional)
     952            .globl C(egc_write_barrier_end)
    933953dnl _spentry(store_node_conditional)
    934 dnl C(egc_store_node_conditional):
     954C(egc_store_node_conditional):
    935955dnl         __(cmplr(cr2,arg_z,arg_x))
    936956dnl         __(vpop(temp0))
     
    940960dnl         __(bne cr1,5f)
    941961dnl         __(strcx(arg_z,arg_x,imm4))
    942 dnl  .globl C(egc_store_node_conditional_test)
    943 dnl C(egc_store_node_conditional_test):
     962           .globl C(egc_store_node_conditional_test)
     963C(egc_store_node_conditional_test):
    944964dnl         __(bne 1b)
    945965dnl         __(isync)
     
    969989dnl    we have to do more work to actually do the memoization.*/
    970990dnl _spentry(set_hash_key_conditional)
    971 dnl  .globl C(egc_set_hash_key_conditional)
    972 dnl C(egc_set_hash_key_conditional):
     991        .globl C(egc_set_hash_key_conditional)
     992C(egc_set_hash_key_conditional):
    973993dnl  __(cmplr(cr2,arg_z,arg_x))
    974994dnl  __(vpop(imm4))
     
    978998dnl  __(bne cr1,5f)
    979999dnl  __(strcx(arg_z,arg_x,imm4))
    980 dnl  .globl C(egc_set_hash_key_conditional_test)
    981 dnl C(egc_set_hash_key_conditional_test):
     1000        .globl C(egc_set_hash_key_conditional_test)
     1001C(egc_set_hash_key_conditional_test):
    9821002dnl  __(bne 1b)
    9831003dnl  __(isync)
     
    10171037dnl         __(bne- 3b)
    10181038dnl         __(isync)
    1019 dnl C(egc_write_barrier_end):
     1039C(egc_write_barrier_end):
    10201040dnl 4: __(mov arg_z,#t_value)
    10211041dnl  __(bx lr)
     
    36703690        __(extract_subtag(imm2,arg_z))
    36713691        __(cmp imm2,#subtag_double_float)
    3672         __(bne local_label(misc_set_bad))
     3692        __(bne local_label(set_bad))
    36733693        __(ldrd imm0,imm1,[arg_z,#misc_dfloat_offset])
    36743694        __(mov imm2,arg_y,lsl #1)
  • branches/arm/lisp-kernel/arm-subprims.s

    r13716 r13737  
    1414
    1515
    16 
     16        .syntax unified
     17        .arm
     18       
    1719        include(lisp.s)
    1820        _beginfile
     
    2224
    2325
    24 /* This is called from a c-style context and calls a lisp function. */
     26/* This is called from a lisp-style context and calls a lisp function. */
    2527/* This does the moral equivalent of */
    2628/*   (loop  */
     
    3234
    3335_exportfn(toplevel_loop)
    34         __(mflr imm0)
    35         __ifdef(`POWEROPENABI')
    36          __(str(imm0,c_frame.savelr(sp)))
    37         __else
    38          __(str(imm0,eabi_c_frame.savelr(sp)))
    39         __endif
     36        __(build_lisp_frame(imm0))
    4037        __(b local_label(test))
    4138local_label(loop):
    4239        __(ref_nrs_value(arg_z,toplcatch))
    43         __(bl _SPmkcatch1v)
    44         __(b local_label(test))                 /* cleanup address, not really a branch */
    45 
     40        __(bl _SPmkcatch1v)     /* preserves nfn, at the moment */
     41        __(b local_label(test)) /* cleanup address, not really a branch */
    4642        __(set_nargs(0))
    47         __(bl _SPfuncall)
    48         __(li arg_z,nil_value)
    49         __(li imm0,fixnum_one)
     43        __(funcall_nfn())
     44        __(mov arg_z,#nil_value)
     45        __(mov imm0,fixnum_one)
    5046        __(bl _SPnthrow1value)
    5147local_label(test):
    52         __(ldr(temp0,0(vsp)))
    53         __(cmpri(cr0,temp0,nil_value))
    54         __(bne cr0,local_label(loop))
    55 local_label(back_to_c):
    56         __ifdef(`POWEROPENABI')
    57          __(ldr(imm0,c_frame.savelr(sp)))
    58         __else
    59          __(ldr(imm0,eabi_c_frame.savelr(sp)))
    60         __endif
    61         __(mtlr imm0)
    62         __(blr)
     48        __(ldr nfn,[vsp,#0])
     49        __(cmp nfn,#nil_value)
     50        __(bne local_label(loop))
     51        __(return_lisp_frame(imm0))
    6352        _endfn
    6453
    6554
    66 /* This sucker gets called with R3 pointing to the current TCR. */
     55/* This gets called with R3 pointing to the current TCR. */
    6756/* r4 is 0 if we want to start the whole thing rolling, */
    6857/* non-zero if we want to reset the current process */
     
    7160        .globl _SPreset
    7261_exportfn(C(start_lisp))
    73         __(mflr r0)
    74         __ifdef(`POWEROPENABI')
    75          __(str(r0,c_frame.savelr(sp)))
    76          __ifdef(`rTOC')
    77           __(str(rTOC,c_frame.savetoc(sp)))
    78          __endif
    79          __(stru(sp,-(stack_align(c_frame.minsiz+(32*node_size)))(sp)))
    80          __(str(r13,c_frame.minsiz+(0*node_size)(sp)))
    81          __(str(r14,c_frame.minsiz+(1*node_size)(sp)))
    82          __(str(r15,c_frame.minsiz+(2*node_size)(sp)))
    83          __(str(r16,c_frame.minsiz+(3*node_size)(sp)))
    84          __(str(r17,c_frame.minsiz+(4*node_size)(sp)))
    85          __(str(r18,c_frame.minsiz+(5*node_size)(sp)))
    86          __(str(r19,c_frame.minsiz+(6*node_size)(sp)))
    87          __(str(r20,c_frame.minsiz+(7*node_size)(sp)))
    88          __(str(r21,c_frame.minsiz+(8*node_size)(sp)))
    89          __(str(r22,c_frame.minsiz+(9*node_size)(sp)))
    90          __(str(r23,c_frame.minsiz+(10*node_size)(sp)))
    91          __(str(r24,c_frame.minsiz+(11*node_size)(sp)))
    92          __(str(r25,c_frame.minsiz+(12*node_size)(sp)))
    93          __(str(r26,c_frame.minsiz+(13*node_size)(sp)))
    94          __(str(r27,c_frame.minsiz+(14*node_size)(sp)))
    95          __(str(r28,c_frame.minsiz+(15*node_size)(sp)))
    96          __(str(r29,c_frame.minsiz+(16*node_size)(sp)))
    97          __(str(r30,c_frame.minsiz+(17*node_size)(sp)))
    98          __(str(r31,c_frame.minsiz+(18*node_size)(sp)))
    99          __(stfd fp_s32conv,c_frame.minsiz+(22*node_size)(sp))
    100         __else
    101          __(str(r0,eabi_c_frame.savelr(sp)))
    102          __(stru(sp,-(eabi_c_frame.minsiz+(32*node_size))(sp)))
    103          __(str(r13,eabi_c_frame.minsiz+(0*node_size)(sp)))
    104          __(str(r14,eabi_c_frame.minsiz+(1*node_size)(sp)))
    105          __(str(r15,eabi_c_frame.minsiz+(2*node_size)(sp)))
    106          __(str(r16,eabi_c_frame.minsiz+(3*node_size)(sp)))
    107          __(str(r17,eabi_c_frame.minsiz+(4*node_size)(sp)))
    108          __(str(r18,eabi_c_frame.minsiz+(5*node_size)(sp)))
    109          __(str(r19,eabi_c_frame.minsiz+(6*node_size)(sp)))
    110          __(str(r20,eabi_c_frame.minsiz+(7*node_size)(sp)))
    111          __(str(r21,eabi_c_frame.minsiz+(8*node_size)(sp)))
    112          __(str(r22,eabi_c_frame.minsiz+(9*node_size)(sp)))
    113          __(str(r23,eabi_c_frame.minsiz+(10*node_size)(sp)))
    114          __(str(r24,eabi_c_frame.minsiz+(11*node_size)(sp)))
    115          __(str(r25,eabi_c_frame.minsiz+(12*node_size)(sp)))
    116          __(str(r26,eabi_c_frame.minsiz+(13*node_size)(sp)))
    117          __(str(r27,eabi_c_frame.minsiz+(14*node_size)(sp)))
    118          __(str(r28,eabi_c_frame.minsiz+(15*node_size)(sp)))
    119          __(str(r29,eabi_c_frame.minsiz+(16*node_size)(sp)))
    120          __(str(r30,eabi_c_frame.minsiz+(17*node_size)(sp)))
    121          __(str(r31,eabi_c_frame.minsiz+(18*node_size)(sp)))
    122          __(stfd fp_s32conv,eabi_c_frame.minsiz+(22*node_size)(sp))
    123         __endif
    124         __(mr rcontext,r3)
    125         __(lwi(r30,0x43300000))
    126         __(lwi(r31,0x80000000))
    127         __ifdef(`POWEROPENABI')
    128          __(stw r30,c_frame.minsiz+(20*node_size)(sp))
    129          __(stw r31,c_frame.minsiz+(20*node_size)+4(sp))
    130          __(lfd fp_s32conv,c_frame.minsiz+(20*node_size)(sp))
    131          __(stfd fp_zero,c_frame.minsiz+(20*node_size)(sp))
    132         __else               
    133          __(stw r30,eabi_c_frame.minsiz+(20*node_size)(sp))
    134          __(stw r31,eabi_c_frame.minsiz+(20*node_size)+4(sp))
    135          __(lfd fp_s32conv,eabi_c_frame.minsiz+(20*node_size)(sp))
    136          __(stfd fp_zero,eabi_c_frame.minsiz+(20*node_size)(sp))
    137         __endif
    138         __(lfs fp_zero,lisp_globals.short_float_zero(0))
    139         __(lfd f0,tcr.lisp_fpscr(rcontext))
    140         __(mtfsf 0xff,f0)
    141         __(li rzero,0)
    142         __(mr save0,rzero)
    143         __(mr save1,rzero)
    144         __(mr save2,rzero)
    145         __(mr save3,rzero)
    146         __(mr save4,rzero)
    147         __(mr save5,rzero)
    148         __(mr save6,rzero)
    149         __(mr save7,rzero)
    150         __(mr arg_z,rzero)
    151         __(mr arg_y,rzero)
    152         __(mr arg_x,rzero)
    153         __(mr temp0,rzero)
    154         __(mr temp1,rzero)
    155         __(mr temp2,rzero)
    156         __(mr temp3,rzero)
    157         __(li loc_pc,0)
    158         __(li fn,0)
    159         __(cmpri(cr0,r4,0))
    160         __(mtxer rzero)  /* start lisp with the overflow bit clear */
    161         __(ldr(vsp,tcr.save_vsp(rcontext)))
    162         __(ldr(tsp,tcr.save_tsp(rcontext)))
    163         __(ldr(allocptr,tcr.save_allocptr(rcontext)))
    164         __(ldr(allocbase,tcr.save_allocbase(rcontext)))
    165         __(li imm0,TCR_STATE_LISP)
    166         __(str(imm0,tcr.valence(rcontext)))
    167         __(bne cr0,1f)
    168         __(bl toplevel_loop)
    169         __(b 2f)
    170 1:
    171         __(bl _SPreset)
    172 2:
    173         __(str(allocptr,tcr.save_allocptr(rcontext)))
    174         __(str(allocbase,tcr.save_allocbase(rcontext)))
    175         __(str(tsp,tcr.save_tsp(rcontext)))
    176         __(str(vsp,tcr.save_vsp(rcontext)))
    177         __(li imm0,TCR_STATE_FOREIGN)
    178         __(str(imm0,tcr.valence(rcontext)))
    179         __ifdef(`POWEROPENABI')
    180          __(ldr(r13,c_frame.minsiz+(0*node_size)(sp)))
    181          __(ldr(r14,c_frame.minsiz+(1*node_size)(sp)))
    182          __(ldr(r15,c_frame.minsiz+(2*node_size)(sp)))
    183          __(ldr(r16,c_frame.minsiz+(3*node_size)(sp)))
    184          __(ldr(r17,c_frame.minsiz+(4*node_size)(sp)))
    185          __(ldr(r18,c_frame.minsiz+(5*node_size)(sp)))
    186          __(ldr(r19,c_frame.minsiz+(6*node_size)(sp)))
    187          __(ldr(r20,c_frame.minsiz+(7*node_size)(sp)))
    188          __(ldr(r21,c_frame.minsiz+(8*node_size)(sp)))
    189          __(ldr(r22,c_frame.minsiz+(9*node_size)(sp)))
    190          __(ldr(r23,c_frame.minsiz+(10*node_size)(sp)))
    191          __(ldr(r24,c_frame.minsiz+(11*node_size)(sp)))
    192          __(ldr(r25,c_frame.minsiz+(12*node_size)(sp)))
    193          __(ldr(r26,c_frame.minsiz+(13*node_size)(sp)))
    194          __(ldr(r27,c_frame.minsiz+(14*node_size)(sp)))
    195          __(ldr(r28,c_frame.minsiz+(15*node_size)(sp)))
    196          __(ldr(r29,c_frame.minsiz+(16*node_size)(sp)))
    197          __(ldr(r30,c_frame.minsiz+(17*node_size)(sp)))
    198          __(ldr(r31,c_frame.minsiz+(18*node_size)(sp)))
    199         __else
    200          __(ldr(r13,eabi_c_frame.minsiz+(0*node_size)(sp)))
    201          __(ldr(r14,eabi_c_frame.minsiz+(1*node_size)(sp)))
    202          __(ldr(r15,eabi_c_frame.minsiz+(2*node_size)(sp)))
    203          __(ldr(r16,eabi_c_frame.minsiz+(3*node_size)(sp)))
    204          __(ldr(r17,eabi_c_frame.minsiz+(4*node_size)(sp)))
    205          __(ldr(r18,eabi_c_frame.minsiz+(5*node_size)(sp)))
    206          __(ldr(r19,eabi_c_frame.minsiz+(6*node_size)(sp)))
    207          __(ldr(r20,eabi_c_frame.minsiz+(7*node_size)(sp)))
    208          __(ldr(r21,eabi_c_frame.minsiz+(8*node_size)(sp)))
    209          __(ldr(r22,eabi_c_frame.minsiz+(9*node_size)(sp)))
    210          __(ldr(r23,eabi_c_frame.minsiz+(10*node_size)(sp)))
    211          __(ldr(r24,eabi_c_frame.minsiz+(11*node_size)(sp)))
    212          __(ldr(r25,eabi_c_frame.minsiz+(12*node_size)(sp)))
    213          __(ldr(r26,eabi_c_frame.minsiz+(13*node_size)(sp)))
    214          __(ldr(r27,eabi_c_frame.minsiz+(14*node_size)(sp)))
    215          __(ldr(r28,eabi_c_frame.minsiz+(15*node_size)(sp)))
    216          __(ldr(r29,eabi_c_frame.minsiz+(16*node_size)(sp)))
    217          __(ldr(r30,eabi_c_frame.minsiz+(17*node_size)(sp)))
    218          __(ldr(r31,eabi_c_frame.minsiz+(18*node_size)(sp)))
    219         __endif
    220         __(li r3,nil_value)
    221         __ifdef(`POWEROPENABI')
    222          __(lfd fp_zero,c_frame.minsiz+(20*node_size)(sp))
    223          __(lfd fp_s32conv,c_frame.minsiz+(22*node_size)(sp))
    224          __(ldr(r0,((stack_align(c_frame.minsiz+(32*node_size)))+c_frame.savelr)(sp)))
    225         __else
    226          __(lfd fp_zero,eabi_c_frame.minsiz+(20*4)(sp))
    227          __(lfd fp_s32conv,eabi_c_frame.minsiz+(22*4)(sp))
    228          __(ldr(r0,(eabi_c_frame.minsiz+(32*node_size)+eabi_c_frame.savelr)(sp)))
    229         __endif
    230         __(mtlr r0)
    231         __(ldr(sp,0(sp)))
    232          __ifdef(`rTOC')
    233           __(ld rTOC,c_frame.savetoc(sp))
    234          __endif
    235         __(blr)
     62        __(stm sp!,{r4,r5,r6,r7,r8,r9,r10,r11,r12,lr})
     63        __(mov rcontext,r0)
     64        __(mov arg_z,#0)
     65        __(mov arg_y,#0)
     66        __(mov arg_x,#0)
     67        __(mov temp0,#0)
     68        __(mov temp1,#0)
     69        __(mov temp2,#0)
     70        __(mov allocptr,#VOID_ALLOCPTR)
     71        __(mov fn,#0)
     72        __(ldr vsp,[rcontext,#tcr.save_vsp])
     73        __(ldr imm2,[rcontext,#tcr.last_lisp_frame])
     74        __(sub imm0,imm2,sp)
     75        __(add imm0,imm0,#node_size)
     76        __(mov imm0,imm0,lsl #num_subtag_bits-word_shift)
     77        __(orr imm0,imm0,#subtag_u32_vector)
     78        __(stm sp!,{imm0,imm2})
     79        __(mov imm0,#TCR_STATE_LISP)
     80        __(str imm0,[rcontext,#tcr.valence])
     81        __(ldr allocptr,[rcontext,#tcr.save_allocptr])
     82        __(bl toplevel_loop)
     83        __(ldr imm1,[sp,#4])
     84        __(mov imm0,#TCR_STATE_FOREIGN)
     85        __(str imm1,[rcontext,#tcr.last_lisp_frame])
     86        __(str imm0,[rcontext,#tcr.valence])
     87        __(mov imm0,#nil_value)
     88        __(ldmia sp!,{r4,r5,r6,r7,r8,r9,r10,r11,r12,lr})
     89        __(bx lr)
    23690
    23791_exportfn(_SPsp_end)
    238         nop
     92        __(nop)
    23993        _endfile
    24094
  • branches/arm/lisp-kernel/arm-uuo.s

    r13721 r13737  
    3838uuo_format_error_fulltag = 3    /* 3 bits of fulltag info, 4 bit reg */
    3939
    40 uuo_format_error_xtype = 4   /* 8 bits of extended type/subtag info, 4 bit reg */
     40uuo_format_error_xtype = 4      /* 8 bits of extended type/subtag info, 4 bit reg */
     41uuo_format_binary = 7           /* 4 bits of code, r1, r0 */
     42uuo_format_nullary_error = 8    /* nullary, call out to lisp */
     43uuo_format_unary_error = 9      /* like unary, but call out to lisp */
    4144uuo_format_cerror_lisptag = 10 /* continuable, lisptag, reg */
    4245uuo_format_cerror_fulltag = 11 /* continuable, fulltag, reg */
    43 uuo_format_cerror_xtype = 12   /* continuable, xtype, reg */       
    44 uuo_format_binary = 15        /* 4 bits of code, r1, r0 */
     46uuo_format_cerror_xtype = 12   /* continuable, xtype, reg */
     47uuo_format_kernel_service = 13 /* 8 bits of info */       
     48uuo_format_binary_error = 15    /* binary format, call out to lisp */
    4549
    4650/* Encode a UUO with cond = $1, format = $2, info = $3 */
     
    4953')
    5054/* Nullary UUO with cond = $1, info = $2 */       
    51 define(`nullaryUUO',`UUO($1,uuo_format_nullary,$2)')     
     55define(`nullaryUUO',`UUO($1,uuo_format_nullary,$2)')
     56define(`nullary_errorUUO',`UUO($1,uuo_format_nullary_error,$2)')
    5257/* Simple (non-TYPE) unary uuo with cond = $1, reg = $2, info = $3 */
    5358define(`unaryUUO',`UUO($1,uuo_format_unary,($2|($3<<4)))')
     59define(`unary_errorUUO',`UUO($1,uuo_format_unary_error,($2|($3<<4)))')
    5460
    5561define(`binaryUUO',`UUO($1,uuo_format_binary,($2|($3<<4)|($4<<8)))')
     62define(`binary_errorUUO',`UUO($1,uuo_format_binary_error,($2|($3<<4)|($4<<8)))')
    5663
    5764/* Simple type error (reg not lisptag), cond = $1, reg = $2, lisptag = $3 */
     
    7077/*  'al' (always). $1=cond, $2=8-bit-code */
    7178define(`uuo_alloc_trap',`nullaryUUO($1,0)')
    72 define(`uuo_error_wrong_nargs',`nullaryUUO($1,1)') /* can use CC field */
     79define(`uuo_error_wrong_nargs',`nullary_errorUUO($1,1)') /* can use CC field */
    7380define(`uuo_gc_trap',`nullaryUUO($1,2)') /* probably unconditional */
    7481define(`uuo_debug_trap',`nullaryUUO($1,3)')
     
    7784
    7885/* Unary UUOs */
    79 define(`uuo_error_unbound',`unaryUUO($1,$2,0)')
    80 define(`uuo_cerror_unbound',`unaryUUO($1,$2,1)')
    81 define(`uuo_error_not_callable',`unaryUUO($1,$2,2)')
     86define(`uuo_error_unbound',`unary_errorUUO($1,$2,0)')
     87define(`uuo_cerror_unbound',`unary_errorUUO($1,$2,1)')
     88define(`uuo_error_not_callable',`unary_errorUUO($1,$2,2)')
    8289define(`uuo_tlb_too_small',`unaryUUO($1,$2,3)')
    83 define(`uuo_error_no_throw_tag',`unaryUUO($1,$2,4)')
     90define(`uuo_error_no_throw_tag',`unary_errorUUO($1,$2,4)')
     91define(`uuo_error_udf_call',`unary_errorUUO($1,$2,4)')       
    8492
    8593/* Binary UUOs */
    86 define(`uuo_error_vector_bounds',`binaryUUO($1,$2,$3,0)')
    87 define(`uuo_error_array_bounds',`binaryUUO($1,$2,$3,1)')
     94define(`uuo_error_vector_bounds',`binary_errorUUO($1,$2,$3,0)')
     95define(`uuo_error_array_bounds',`binary_errorUUO($1,$2,$3,1)')
     96define(`uuo_error_integer_divide_by_zero','`binary_errorUUO($1,$2,$3,2)')
     97               
    8898
  • branches/arm/lisp-kernel/gc.h

    r13296 r13737  
    5757#endif
    5858
     59#ifdef ARM
     60#define is_node_fulltag(f)  ((1<<(f))&((1<<fulltag_cons)|(1<<fulltag_misc)))
     61#endif
    5962
    6063extern void zero_memory_range(BytePtr,BytePtr);
  • branches/arm/lisp-kernel/linuxarm/Makefile

    r13733 r13737  
    4141endif
    4242
    43 # The only version of GCC I have that supports both ppc32 and ppc64
    44 # compilation uses the -m32 option to target ppc32.  This may not be
    45 # definitive; there seem to be a bewildering array of similar options
    46 # in other GCC versions.  It's assumed here that if "-m32" is recognized,
    47 # it's required as well.
    48 
    49 PPC32 = $(shell ($(CC) --help -v 2>&1 | grep -q -e "-m32 ") && /bin/echo "-m32")
    5043
    5144# Likewise, some versions of GAS may need a "-a32" flag, to force the
     
    5750        $(M4) $(M4FLAGS) -I../ $< | $(AS) $(A32) $(ASFLAGS) -o $@
    5851.c.o:
    59         $(CC) -include ../$(PLATFORM_H) -c $< $(CDEFINES) $(CDEBUG) $(COPT) $(WFORMAT) $(PPC32) -o $@
     52        $(CC) -include ../$(PLATFORM_H) -c $< $(CDEFINES) $(CDEBUG) $(COPT) $(WFORMAT) -o $@
    6053
    6154SPOBJ = pad.o  arm-spentry.o arm-subprims.o
     
    9083
    9184../../armcl:    $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ)
    92         $(CC) $(PPC32) $(CDEBUG)  -Wl,--export-dynamic $(HASH_STYLE) -o $@ -T ./elf32ppclinux.x $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ) $(OSLIBS)
     85        $(CC)  $(CDEBUG)  -Wl,--export-dynamic $(HASH_STYLE) -o $@ -T ./armlinux.x $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ) $(OSLIBS)
    9386
    9487
  • branches/arm/lisp-kernel/linuxarm/armlinux.x

    r13665 r13737  
    88{
    99  /* Read-only sections, merged into text segment: */
    10   PROVIDE (__executable_start = 0x00003000); . = 0x00003000 + SIZEOF_HEADERS;
     10  PROVIDE (__executable_start = 0x00008000); . = 0x00008000 + SIZEOF_HEADERS;
    1111  .pad : { pad.o(.text) }
    1212  .subprims ALIGN(0x1000) :
  • branches/arm/lisp-kernel/lisp-exceptions.h

    r13067 r13737  
    151151#endif
    152152
     153#ifdef ARM
     154#include "arm-exceptions.h"
     155#endif
     156
    153157void suspend_other_threads(Boolean);
    154158void resume_other_threads(Boolean);
  • branches/arm/lisp-kernel/macros.h

    r13589 r13737  
    7979#endif
    8080
     81#ifdef ARM
     82#define nodeheader_tag_p(tag) (tag == fulltag_nodeheader)
     83#define immheader_tag_p(tag) (tag == fulltag_immheader)
     84#endif
     85
    8186#ifdef VC
    8287#define inline
  • branches/arm/lisp-kernel/platform-linuxarm.h

    r13732 r13737  
    3535#define xpGPRvector(x) ((natural *)&((x)->uc_mcontext.arm_r0))
    3636#define xpGPR(x,gprno) (xpGPRvector(x))[gprno]
    37 #define xpPC(x) xpGPR(x,15)
     37#define xpPC(x) (*((pc*)(&(xpGPR(x,15)))))
     38#define xpLR(x) (*((pc*)(&(xpGPR(x,14)))))
    3839#define xpPSR(x) xpGPR(x,16)
    3940#define xpFaultAddress(x) xpGPR(x,17)
  • branches/arm/lisp-kernel/pmcl-kernel.c

    r13727 r13737  
    15061506    tcr->vs_area->active = tcr->vs_area->high - node_size;
    15071507    tcr->save_vsp = (LispObj *)(tcr->vs_area->active);
     1508#ifndef ARM
    15081509    tcr->ts_area->active = tcr->ts_area->high;
    15091510    tcr->save_tsp = (LispObj *)(tcr->ts_area->active);
     1511#endif
    15101512    tcr->catch_top = 0;
    15111513    tcr->db_link = 0;
  • branches/arm/lisp-kernel/thread_manager.c

    r13731 r13737  
    13421342  a->owner = tcr;
    13431343  tcr->save_vsp = (LispObj *) a->active; 
     1344#ifndef ARM
    13441345  a = allocate_tstack_holding_area_lock(tstack_size);
     1346#endif
    13451347  UNLOCK(lisp_global(TCR_AREA_LOCK),tcr);
     1348#ifndef ARM
    13461349  tcr->ts_area = a;
    13471350  a->owner = tcr;
    13481351  tcr->save_tsp = (LispObj *) a->active;
     1352#endif
    13491353#ifdef X86
    13501354  tcr->next_tsp = tcr->save_tsp;
     
    14051409    vs = tcr->vs_area;
    14061410    tcr->vs_area = NULL;
     1411#ifndef ARM
    14071412    ts = tcr->ts_area;
    14081413    tcr->ts_area = NULL;
     1414#endif
    14091415    cs = tcr->cs_area;
    14101416    tcr->cs_area = NULL;
     
    14121418      condemn_area_holding_area_lock(vs);
    14131419    }
     1420#ifndef ARM
    14141421    if (ts) {
    14151422      condemn_area_holding_area_lock(ts);
    14161423    }
     1424#endif
    14171425    if (cs) {
    14181426      condemn_area_holding_area_lock(cs);
     
    14611469    a->active = a->high;
    14621470  }
     1471#ifndef ARM
    14631472  a = tcr->ts_area;
    14641473  if (a) {
    14651474    a->active = a->high;
    14661475  }
     1476#endif
    14671477  a = tcr->cs_area;
    14681478  if (a) {
     
    22392249  }
    22402250
     2251#ifndef ARM
    22412252  a = tcr->ts_area;
    22422253  if (a) {
    22432254    a->active = a->high;
    22442255  }
     2256#endif
    22452257
    22462258  a = tcr->cs_area;
Note: See TracChangeset for help on using the changeset viewer.