(:temp pa-flag non-descriptor-reg nl4-offset))
;; This is kinda sleezy, changing words like this. But we can because
;; the vop thinks it is temporary.
- (inst addu words (+ (1- (ash 1 n-lowtag-bits))
+ (inst addu words (+ lowtag-mask
(* vector-data-offset n-word-bytes)))
- (inst li ndescr (lognot lowtag-mask))
- (inst and words ndescr)
(inst srl ndescr type word-shift)
+ (inst srl words n-lowtag-bits)
+ (inst sll words n-lowtag-bits)
(pseudo-atomic (pa-flag)
(inst or result alloc-tn other-pointer-lowtag)
(error 'undefined-alien-function-error))
(defun memory-fault-error ()
- (error 'memory-fault-error))
\ No newline at end of file
+ (error 'memory-fault-error))
(in-package "SB!VM")
+
\f
(define-alien-type os-context-t (struct os-context-t-struct))
+
\f
;;;; MACHINE-TYPE and MACHINE-VERSION
(defun get-machine-version ()
#!+little-endian "little-endian"
#!-little-endian "big-endian")
+
\f
;;;; FIXUP-CODE-OBJECT
(let ((pc (context-pc context))
(cause (context-bd-cause-int context)))
(declare (type system-area-pointer pc))
- (/show0 "got PC=..")
- (/hexstr (sap-int pc))
;; KLUDGE: This exposure of the branch delay mechanism hurts.
(when (logbitp 31 cause)
(setf pc (sap+ pc 4)))
- (when (= (sap-ref-8 pc 4) 255)
- (setf pc (sap+ pc 1)))
- (/show0 "now PC=..")
- (/hexstr (sap-int pc))
- (let* ((length (sap-ref-8 pc 4))
- (vector (make-array length :element-type '(unsigned-byte 8))))
- (declare (type (unsigned-byte 8) length)
- (type (simple-array (unsigned-byte 8) (*)) vector))
- (/show0 "LENGTH,VECTOR,ERROR-NUMBER=..")
- (/hexstr length)
- (/hexstr vector)
- (copy-ub8-from-system-area pc 5 vector 0 length)
- (let* ((index 0)
- (error-number (sb!c:read-var-integer vector index)))
- (/hexstr error-number)
- (collect ((sc-offsets))
- (loop
- (/show0 "INDEX=..")
- (/hexstr index)
- (when (>= index length)
- (return))
- (sc-offsets (sb!c:read-var-integer vector index)))
- (values error-number (sc-offsets)))))))
-
-
-
-
-
+ (args-for-unimp-inst pc)))
+
+(defun args-for-unimp-inst (pc)
+ (declare (type system-area-pointer pc))
+ (let* ((length (sap-ref-8 pc 4))
+ (vector (make-array length :element-type '(unsigned-byte 8))))
+ (declare (type (unsigned-byte 8) length)
+ (type (simple-array (unsigned-byte 8) (*)) vector))
+ (copy-ub8-from-system-area pc 5 vector 0 length)
+ (let* ((index 0)
+ (error-number (sb!c:read-var-integer vector index)))
+ (collect ((sc-offsets))
+ (loop
+ (when (>= index length)
+ (return))
+ (sc-offsets (sb!c:read-var-integer vector index)))
+ (values error-number (sc-offsets))))))
(:results (result :scs (descriptor-reg) :from :argument))
(:generator 37
(with-fixed-allocation (result pa-flag temp fdefn-widetag fdefn-size)
+ (inst li temp (make-fixup "undefined_tramp" :foreign))
(storew name result fdefn-name-slot other-pointer-lowtag)
(storew null-tn result fdefn-fun-slot other-pointer-lowtag)
- (inst li temp (make-fixup "undefined_tramp" :foreign))
(storew temp result fdefn-raw-addr-slot other-pointer-lowtag))))
(define-vop (make-closure)
(:args (function :to :save :scs (descriptor-reg)))
(:info length stack-allocate-p)
- (:ignore stack-allocate-p)
(:temporary (:scs (non-descriptor-reg)) temp)
(:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
(:results (result :scs (descriptor-reg)))
(:generator 10
- (let ((size (+ length closure-info-offset)))
- (inst li temp (logior (ash (1- size) n-widetag-bits) closure-header-widetag))
- (pseudo-atomic (pa-flag :extra (pad-data-block size))
- (inst or result alloc-tn fun-pointer-lowtag)
+ (let* ((size (+ length closure-info-offset))
+ (alloc-size (pad-data-block size)))
+ (pseudo-atomic (pa-flag :extra (if stack-allocate-p 0 alloc-size))
+ (cond (stack-allocate-p
+ (align-csp result)
+ (inst srl result csp-tn n-lowtag-bits)
+ (inst addu csp-tn alloc-size))
+ (t
+ (inst srl result alloc-tn n-lowtag-bits)))
+ (inst sll result n-lowtag-bits)
+ (inst or result fun-pointer-lowtag)
+ (inst li temp (logior (ash (1- size) n-widetag-bits)
+ closure-header-widetag))
(storew temp result 0 fun-pointer-lowtag))
(storew result result closure-self-slot fun-pointer-lowtag)
(storew function result closure-fun-slot fun-pointer-lowtag))))
(:generator 1
(sc-case res
(any-reg
- (inst sll res digit 2))
+ (inst sll res digit n-fixnum-tag-bits))
(signed-reg
(move res digit)))))
(trace-table-entry trace-table-fun-prologue)
(emit-label start-lab)
;; Allocate function header.
- (inst fun-header-word)
+ (inst simple-fun-header-word)
(dotimes (i (1- simple-fun-code-offset))
(inst word 0))
;; The start of the actual code.
(when lra-label
(inst compute-code-from-lra code-tn code-tn lra-label temp))
(inst addu csp-tn csp-tn 4)
- (storew (first register-arg-tns) csp-tn -1)
+ (storew (first *register-arg-tns*) csp-tn -1)
(inst addu start csp-tn -4)
(inst li count (fixnumize 1))
(emit-label done)
(assemble (*elsewhere*)
+ (trace-table-entry trace-table-fun-prologue)
(emit-label variable-values)
(when lra-label
(inst compute-code-from-lra code-tn code-tn lra-label temp))
- (do ((arg register-arg-tns (rest arg))
+ (do ((arg *register-arg-tns* (rest arg))
(i 0 (1+ i)))
((null arg))
(storew (first arg) args i))
(move start args)
(inst b done)
- (move count nargs t)))
+ (move count nargs t)
+ (trace-table-entry trace-table-normal)))
(values))
;; Is this the last one?
(inst beq count done)
;; Store it relative to the pointer saved at the start.
- (storew (nth i register-arg-tns) result (- i fixed))
+ (storew (nth i *register-arg-tns*) result (- i fixed))
;; Decrement count.
(inst subu count (fixnumize 1))))
(emit-label done))))
(ash (+ posn (component-header-length))
(- n-widetag-bits word-shift)))))))
-(define-instruction fun-header-word (segment)
+(define-instruction simple-fun-header-word (segment)
:pinned
(:cost 0)
(:delay 0)
segment 12 3
#'(lambda (segment posn delta-if-after)
(let ((delta (funcall calc label posn delta-if-after)))
- (when (<= (- (ash 1 15)) delta (1- (ash 1 15)))
+ (when (typep delta '(signed-byte 16))
(emit-back-patch segment 4
#'(lambda (segment posn)
(assemble (segment vop)
(sc-case stack
((control-stack)
(loadw reg cfp-tn offset))))))
+
(defmacro store-stack-tn (stack reg)
`(let ((stack ,stack)
(reg ,reg))
;;; Move a tagged SAP to an untagged representation.
(define-vop (move-to-sap)
- (:args (x :scs (descriptor-reg)))
+ (:args (x :scs (any-reg descriptor-reg)))
(:results (y :scs (sap-reg)))
- (:note "system area pointer indirection")
+ (:note "pointer to SAP coercion")
(:generator 1
(loadw y x sap-pointer-slot other-pointer-lowtag)))
;;; Move an untagged SAP to a tagged representation.
(define-vop (move-from-sap)
- (:args (x :scs (sap-reg) :target sap))
- (:temporary (:scs (sap-reg) :from (:argument 0)) sap)
+ (:args (sap :scs (sap-reg) :to :save))
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
- (:results (y :scs (descriptor-reg)))
- (:note "system area pointer allocation")
+ (:results (res :scs (descriptor-reg)))
+ (:note "SAP to pointer coercion")
(:generator 20
- (move sap x)
- (with-fixed-allocation (y pa-flag ndescr sap-widetag sap-size)
- (storew sap y sap-pointer-slot other-pointer-lowtag))))
+ (with-fixed-allocation (res pa-flag ndescr sap-widetag sap-size)
+ (storew sap res sap-pointer-slot other-pointer-lowtag))))
(define-move-vop move-from-sap :move
(sap-reg) (descriptor-reg))
-;;; Move untagged sap values.
+;;; Move untagged SAP values.
(define-vop (sap-move)
(:args (x :target y
:scs (sap-reg)
:load-if (not (location= x y))))
(:results (y :scs (sap-reg)
:load-if (not (location= x y))))
+ (:note "SAP move")
(:effects)
(:affected)
(:generator 0
(define-move-vop sap-move :move
(sap-reg) (sap-reg))
-;;; Move untagged sap arguments/return-values.
+;;; Move untagged SAP arguments/return-values.
(define-vop (move-sap-arg)
(:args (x :target y
:scs (sap-reg))
(fp :scs (any-reg)
:load-if (not (sc-is y sap-reg))))
(:results (y))
+ (:note "SAP argument move")
(:generator 0
(sc-case y
(sap-reg
(define-move-vop move-sap-arg :move-arg
(descriptor-reg sap-reg) (sap-reg))
-;;; Use standard MOVE-ARG + coercion to move an untagged sap to a
+;;; Use standard MOVE-ARG + coercion to move an untagged SAP to a
;;; descriptor passing location.
(define-move-vop move-arg :move-arg
(sap-reg) (descriptor-reg))
(deftransform sap-ref-64 ((sap offset) (* *))
'(logior (sap-ref-32 sap offset)
(ash (sap-ref-32 sap (+ offset 4)) 32)))
+
(deftransform signed-sap-ref-64 ((sap offset) (* *))
'(logior (sap-ref-32 sap offset)
(ash (signed-sap-ref-32 sap (+ offset 4)) 32)))
+
(deftransform %set-sap-ref-64 ((sap offset value) (* * *))
'(progn
(%set-sap-ref-32 sap offset (logand value #xffffffff))
(%set-sap-ref-32 sap (+ offset 4) (ash value -32))))
+
(deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *))
'(progn
(%set-sap-ref-32 sap offset (logand value #xffffffff))
(%set-signed-sap-ref-32 sap (+ offset 4) (ash value -32)))))
+
#!-little-endian
(progn
(deftransform sap-ref-64 ((sap offset) (* *))
'(logior (ash (sap-ref-32 sap offset) 32)
(sap-ref-32 sap (+ offset 4))))
+
(deftransform signed-sap-ref-64 ((sap offset) (* *))
'(logior (ash (signed-sap-ref-32 sap offset) 32)
(sap-ref-32 sap (+ 4 offset))))
+
(deftransform %set-sap-ref-64 ((sap offset value) (* * *))
'(progn
(%set-sap-ref-32 sap offset (ash value -32))
(%set-sap-ref-32 sap (+ offset 4) (logand value #xffffffff))))
+
(deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *))
'(progn
(%set-signed-sap-ref-32 sap offset (ash value -32))
(%set-sap-ref-32 sap (+ 4 offset) (logand value #xffffffff)))))
-
;;; A list of TN's describing the register arguments.
;;;
-(defparameter register-arg-tns
+(defparameter *register-arg-tns*
(mapcar #'(lambda (n)
(make-random-tn :kind :normal
:sc (sc-or-lose 'descriptor-reg)
static void scavenge_newspace(void);
static void scavenge_interrupt_contexts(void);
-extern struct interrupt_data * global_interrupt_data;
extern unsigned long bytes_consed_between_gcs;
unsigned long control_stack_size, binding_stack_size;
sigset_t tmp, old;
struct thread *th=arch_os_get_current_thread();
- struct interrupt_data *data=
- th ? th->interrupt_data : global_interrupt_data;
+ struct interrupt_data *data=th->interrupt_data;
#ifdef PRINTNOISE
{
os_context_t *context = (os_context_t*)void_context;
struct thread *thread=arch_os_get_current_thread();
+ struct interrupt_data *data=
+ thread ? thread->interrupt_data : global_interrupt_data;
#ifdef LISP_FEATURE_LINUX
os_restore_fp_control(context);
#endif
check_blockables_blocked_or_lose();
check_interrupts_enabled_or_lose(context);
- (*thread->interrupt_data->interrupt_low_level_handlers[signal])
+ (*data->interrupt_low_level_handlers[signal])
(signal, info, void_context);
#ifdef LISP_FEATURE_DARWIN
/* Work around G5 bug */
{
os_context_t *context = arch_os_get_context(&void_context);
struct thread *thread=arch_os_get_current_thread();
- struct interrupt_data *data=thread->interrupt_data;
+ struct interrupt_data *data=
+ thread ? thread->interrupt_data : global_interrupt_data;
#ifdef LISP_FEATURE_LINUX
os_restore_fp_control(context);
#endif
# " A " used to be in the set of removed symbols, but it turns out
# that the alpha implementation of closure_tramp and undefined_tramp
# is as an A. Whatever that is. CSR, 2005-06-12.
+# " A " is a global absolute symbol, that is a symbol with a fixed
+# assembly time value (which is used for offset calculations).
nm -p "$@" | grep -v " [abcdgIiNnrstUuvw?-] "
/* Classic CMUCL comment:
Finding the bad address on the mips is easy. */
- return (os_vm_address_t) siginfo->si_addr;
+ return (os_vm_address_t)siginfo->si_addr;
}
+static inline unsigned int
+os_context_register(os_context_t *context, int offset)
+{
+ return (unsigned int)(*os_context_register_addr(context, offset));
+}
+
+static inline unsigned int
+os_context_pc(os_context_t *context)
+{
+ return (unsigned int)(*os_context_pc_addr(context));
+}
+
+static inline unsigned int
+os_context_insn(os_context_t *context)
+{
+ return *(unsigned int *)(os_context_pc(context));
+}
+
+/* This function is somewhat misnamed, it actually just jumps to the
+ correct target address without attempting to execute the delay slot.
+ For other instructions it just increments the returned PC value. */
static unsigned int
emulate_branch(os_context_t *context, unsigned int inst)
{
unsigned int r2 = (inst >> 16) & 0x1f;
unsigned int r3 = (inst >> 11) & 0x1f;
unsigned int disp = ((inst&(1<<15)) ? inst | (-1 << 16) : inst&0x7fff) << 2;
- unsigned int jtgt = (*os_context_pc_addr(context) & ~0x0fffffff) | (inst&0x3ffffff) << 2;
- unsigned int tgt = *os_context_pc_addr(context);
+ unsigned int jtgt = (os_context_pc(context) & ~0x0fffffff) | (inst&0x3ffffff) << 2;
+ unsigned int tgt = os_context_pc(context);
switch(opcode) {
case 0x0: /* jr, jalr */
switch(inst & 0x3f) {
case 0x08: /* jr */
- tgt = *os_context_register_addr(context, r1);
+ tgt = os_context_register(context, r1);
break;
case 0x09: /* jalr */
- tgt = *os_context_register_addr(context, r1);
+ tgt = os_context_register(context, r1);
*os_context_register_addr(context, r3)
- = *os_context_pc_addr(context) + 4;
+ = os_context_pc(context) + 4;
+ break;
+ default:
+ tgt += 4;
break;
}
break;
case 0x1: /* bltz, bgez, bltzal, bgezal */
switch((inst >> 16) & 0x1f) {
case 0x00: /* bltz */
- if(*os_context_register_addr(context, r1) < 0)
+ if(os_context_register(context, r1) < 0)
tgt += disp;
break;
case 0x01: /* bgez */
- if(*os_context_register_addr(context, r1) >= 0)
+ if(os_context_register(context, r1) >= 0)
tgt += disp;
break;
case 0x10: /* bltzal */
- if(*os_context_register_addr(context, r1) < 0)
+ if(os_context_register(context, r1) < 0)
tgt += disp;
*os_context_register_addr(context, 31)
- = *os_context_pc_addr(context) + 4;
+ = os_context_pc(context) + 4;
break;
case 0x11: /* bgezal */
- if(*os_context_register_addr(context, r1) >= 0)
+ if(os_context_register(context, r1) >= 0)
tgt += disp;
*os_context_register_addr(context, 31)
- = *os_context_pc_addr(context) + 4;
+ = os_context_pc(context) + 4;
+ break;
+ default: /* conditional branches/traps for > MIPS I, ignore for now. */
break;
}
break;
case 0x4: /* beq */
- if(*os_context_register_addr(context, r1)
- == *os_context_register_addr(context, r2))
+ if(os_context_register(context, r1)
+ == os_context_register(context, r2))
tgt += disp;
break;
case 0x5: /* bne */
- if(*os_context_register_addr(context, r1)
- != *os_context_register_addr(context, r2))
+ if(os_context_register(context, r1)
+ != os_context_register(context, r2))
tgt += disp;
break;
case 0x6: /* blez */
- if(*os_context_register_addr(context, r1)
- <= *os_context_register_addr(context, r2))
+ if(os_context_register(context, r1)
+ <= os_context_register(context, r2))
tgt += disp;
break;
case 0x7: /* bgtz */
- if(*os_context_register_addr(context, r1)
- > *os_context_register_addr(context, r2))
+ if(os_context_register(context, r1)
+ > os_context_register(context, r2))
tgt += disp;
break;
case 0x2: /* j */
case 0x3: /* jal */
tgt = jtgt;
*os_context_register_addr(context, 31)
- = *os_context_pc_addr(context) + 4;
+ = os_context_pc(context) + 4;
+ break;
+ default:
+ tgt += 4;
break;
}
return tgt;
arch_skip_instruction(os_context_t *context)
{
/* Skip the offending instruction */
- if (os_context_bd_cause(context)) {
- /* Currently, we never get here, because Linux' support for
- bd_cause seems not terribly solid (c.f os_context_bd_cause
- in mips-linux-os.c). If a port to Irix comes along, this
- code will be executed, because presumably Irix' support is
- better (it can hardly be worse). We lose() to remind the
- porter to review this code. -- CSR, 2002-09-06 */
- lose("bd_cause branch taken; review code for new OS?\n");
- *os_context_pc_addr(context)
- = emulate_branch(context, *os_context_pc_addr(context));
- } else
- *os_context_pc_addr(context) += 4;
+ *os_context_pc_addr(context)
+ = emulate_branch(context, os_context_insn(context));
}
unsigned char *
arch_internal_error_arguments(os_context_t *context)
{
if (os_context_bd_cause(context))
- return (unsigned char *)(*os_context_pc_addr(context) + 8);
+ return (unsigned char *)(os_context_pc(context) + 8);
else
- return (unsigned char *)(*os_context_pc_addr(context) + 4);
+ return (unsigned char *)(os_context_pc(context) + 4);
}
boolean
arch_pseudo_atomic_atomic(os_context_t *context)
{
- return *os_context_register_addr(context, reg_ALLOC) & 1;
+ return os_context_register(context, reg_ALLOC) & 1;
}
void
arch_install_breakpoint(void *pc)
{
unsigned int *ptr = (unsigned int *)pc;
- unsigned long result = (unsigned long) *ptr;
+ unsigned long result;
+
+ /* Don't install over a branch/jump. */
+ switch (*ptr >> 26) {
+ case 0x0: /* immediate jumps */
+ switch (*ptr & 0x3f) {
+ case 0x08:
+ case 0x09:
+ ptr++;
+ }
+ break;
+ /* branches and register jumps */
+ case 0x1:
+ case 0x2:
+ case 0x3:
+ case 0x4:
+ case 0x5:
+ case 0x6:
+ case 0x7:
+ ptr++;
+ }
+ result = (unsigned long) *ptr;
*ptr = (trap_Breakpoint << 16) | 0xd;
os_flush_icache((os_vm_address_t)ptr, sizeof(unsigned int));
void
arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst)
{
- unsigned int *pc = (unsigned int *)*os_context_pc_addr(context);
+ unsigned int *pc = (unsigned int *)os_context_pc(context);
unsigned int *break_pc, *next_pc;
unsigned int next_inst;
- int opcode;
orig_sigmask = *os_context_sigmask_addr(context);
sigaddset_blockable(os_context_sigmask_addr(context));
if (os_context_bd_cause(context)) {
break_pc = pc+1;
next_inst = *pc;
- }
- else {
+ } else {
break_pc = pc;
next_inst = orig_inst;
}
skipped_break_addr = break_pc;
/* Figure out where it goes. */
- opcode = next_inst >> 26;
- if (opcode == 1 || ((opcode & 0x3c) == 0x4) || ((next_inst & 0xf00e0000) == 0x80000000))
- next_pc = (unsigned int *)emulate_branch(context, next_inst);
- else
- next_pc = pc+1;
+ next_pc = (unsigned int *)emulate_branch(context, next_inst);
displaced_after_inst = arch_install_breakpoint(next_pc);
}
sigtrap_handler(int signal, siginfo_t *info, void *void_context)
{
os_context_t *context = arch_os_get_context(&void_context);
- unsigned int code;
-
- code = ((*(int *) (*os_context_pc_addr(context))) >> 16) & 0x1f;
+ unsigned int code = (os_context_insn(context) >> 16) & 0x1f;
switch (code) {
case trap_Halt:
case trap_Error:
case trap_Cerror:
- interrupt_internal_error(signal, info, context, code==trap_Cerror);
+ interrupt_internal_error(signal, info, context, code == trap_Cerror);
break;
case trap_Breakpoint:
break;
case trap_FunEndBreakpoint:
- *os_context_pc_addr(context) = (int)handle_fun_end_breakpoint(signal, info, context);
- os_flush_icache((os_vm_address_t)*os_context_pc_addr(context), sizeof(unsigned int));
+ *os_context_pc_addr(context)
+ = (os_context_register_t)(unsigned int)
+ handle_fun_end_breakpoint(signal, info, context);
break;
case trap_AfterBreakpoint:
unsigned int bad_inst;
unsigned int op, rs, rt, rd, funct, dest = 32;
int immed;
- unsigned int result;
+ int result;
os_context_t *context = arch_os_get_context(&void_context);
if (os_context_bd_cause(context))
- bad_inst = *(unsigned int *)(*os_context_pc_addr(context) + 4);
+ bad_inst = *(unsigned int *)(os_context_pc(context) + 4);
else
- bad_inst = *(unsigned int *)(*os_context_pc_addr(context));
+ bad_inst = os_context_insn(context);
op = (bad_inst >> 26) & 0x3f;
rs = (bad_inst >> 21) & 0x1f;
case 0x0: /* SPECIAL */
switch (funct) {
case 0x20: /* ADD */
- /* FIXME: Hopefully, this whole section can just go away,
- with the rewrite of pseudo-atomic and the deletion of
- overflow VOPs */
- /* Check to see if this is really a pa_interrupted hit */
- if (rs == reg_ALLOC && rt == reg_NL4) {
- *os_context_register_addr(context, reg_ALLOC)
- += *os_context_register_addr(context, reg_NL4) &= ~(-1LL<<31);
- arch_skip_instruction(context);
- interrupt_handle_pending(context);
- return;
- }
- result = FIXNUM_VALUE(*os_context_register_addr(context, rs))
- + FIXNUM_VALUE(*os_context_register_addr(context, rt));
+ result = FIXNUM_VALUE(os_context_register(context, rs))
+ + FIXNUM_VALUE(os_context_register(context, rt));
dest = rd;
break;
case 0x22: /* SUB */
- result = FIXNUM_VALUE(*os_context_register_addr(context, rs))
- - FIXNUM_VALUE(*os_context_register_addr(context, rt));
+ result = FIXNUM_VALUE(os_context_register(context, rs))
+ - FIXNUM_VALUE(os_context_register(context, rt));
dest = rd;
break;
+
+ default:
+ interrupt_handle_now(signal, info, context);
+ return;
}
break;
case 0x8: /* ADDI */
- result = FIXNUM_VALUE(*os_context_register_addr(context,rs)) + (immed>>2);
+ result = FIXNUM_VALUE(os_context_register(context,rs))
+ + (immed >> N_FIXNUM_TAG_BITS);
dest = rt;
break;
- }
- if (dest < 32) {
- dynamic_space_free_pointer =
- (lispobj *) *os_context_register_addr(context,reg_ALLOC);
+ default:
+ interrupt_handle_now(signal, info, context);
+ return;
+ }
- *os_context_register_addr(context,dest) = alloc_number(result);
+ dynamic_space_free_pointer =
+ (lispobj *)(unsigned int)*os_context_register_addr(context,reg_ALLOC);
- *os_context_register_addr(context, reg_ALLOC) =
- (unsigned int) dynamic_space_free_pointer;
+ *os_context_register_addr(context,dest) = alloc_number(result);
- arch_skip_instruction(context);
+ *os_context_register_addr(context, reg_ALLOC) =
+ (unsigned int) dynamic_space_free_pointer;
- }
- else
- interrupt_handle_now(signal, info, context);
+ arch_skip_instruction(context);
}
void
.word NIL /* arglist */
.word NIL /* type */
LEAF(undefined_tramp)
- break trap_Error
- .byte 4
- .byte UNDEFINED_FUN_ERROR
- .byte 254
- .byte (0xc0 + sc_DescriptorReg)
- .byte 1
+ .set noreorder
+ /* Continuable errors break here for some reason.
+ b 1f
+ break trap_Cerror */
+ break trap_Error
+ /* Error data length. */
+ .byte 4
+ /* Error number. */
+ .byte UNDEFINED_FUN_ERROR
+ /* Magic value 254 means a 16bit little endian value follows.
+ See interr.c:describe_internal_error. */
+ .byte 254
+ /* reg_FDEFN is #14. */
+ .byte ((14 << 5) + sc_DescriptorReg) % 0x100
+ .byte ((14 << 5) + sc_DescriptorReg) / 0x100
.align 2
+ .set reorder
+1: lw reg_LIP, FDEFN_RAW_ADDR_OFFSET(reg_FDEFN)
+ jr reg_LIP
END(undefined_tramp)
/*
* The closure trampoline.
*/
- .align 2
+ .align 5 /* common MIPS cacheline size */
+ .word 0 /* pad 1 */
+ .word 0 /* pad 2 */
.word SIMPLE_FUN_HEADER_WIDETAG /* header */
.word closure_tramp - SIMPLE_FUN_CODE_OFFSET /* self */
.word NIL /* next */
/*
* Function-end breakpoint magic.
*/
- .align 3
+ .align 2
LEAF(fun_end_breakpoint_guts)
.set noreorder
.word RETURN_PC_HEADER_WIDETAG
/* for cacheflush() */
#include <sys/cachectl.h>
+/* for BD_CAUSE */
+#include <asm/mipsregs.h>
+
#include "validate.h"
size_t os_vm_page_size;
os_context_fp_control(os_context_t *context)
{
/* FIXME: Probably do something. */
+ return 0;
}
void
loop" where a (BREAK 16) not in a branch delay slot would have
CAUSEF_BD filled. So, we comment
- #include <asm/mipsregs.h>
-
return (((struct sigcontext *) &(context->uc_mcontext))->sc_cause
& CAUSEF_BD);
out and return 0 always. -- CSR, 2002-09-02 */
+ /* Unfortunately, returning 0 fails for taken branches because
+ os_context_bd_cause is also used to find out if a branch
+ emulation is needed. We work around that by checking if the
+ current instruction is a jump or a branch. */
+ unsigned int inst = *((unsigned int *)(unsigned int)(*os_context_pc_addr(context)));
+
+ switch (inst >> 26) {
+ case 0x0: /* immediate jumps */
+ switch (inst & 0x3f) {
+ case 0x08:
+ case 0x09:
+ return CAUSEF_BD;
+ }
+ break;
+ /* branches and register jumps */
+ case 0x1:
+ case 0x2:
+ case 0x3:
+ case 0x4:
+ case 0x5:
+ case 0x6:
+ case 0x7:
+ return CAUSEF_BD;
+ }
return 0;
}
reg_A0, reg_A1, reg_A2, reg_A3, reg_A4, reg_A5, reg_FDEFN, reg_LEXENV, \
reg_NFP, reg_OCFP, reg_LRA, reg_L0, reg_L1, reg_CODE \
}
-
-#define SC_REG(sc, n) ((sc)->sc_regs[n])
-#define SC_PC(sc) ((sc)->sc_pc)
extern lispobj call_into_lisp_first_time(lispobj fun, lispobj *args, int nargs);
#endif
-int
+static int
initial_thread_trampoline(struct thread *th)
{
lispobj function;
return th;
}
-void link_thread(struct thread *th,os_thread_t kid_tid)
+static void
+link_thread(struct thread *th,os_thread_t kid_tid)
{
if (all_threads) all_threads->prev=th;
th->next=all_threads;
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.3.68"
+"0.9.3.69"
projects / sbcl.git / commitdiff