From: Nathan Froyd Date: Fri, 19 Aug 2005 22:21:02 +0000 (+0000) Subject: 0.9.3.69: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=481348f2f96f364374f669786f9fc61348decabc;p=sbcl.git 0.9.3.69: THS patch-mania (from sbcl-devel, title and date as noted): * "Fix race condition for initial thread startup", 16 August 2005; * "Make internal startup functions in thread.c static", 16 August 2005; * "Minor MIPS code improvements", 16 August 2005; * "MIPS C runtime fixes", 19 August 2005 * "Support stack-allocated closures on MIPS", 19 August 2005; * "Assorted minor (non-)changes", 19 August 2005. --- diff --git a/src/assembly/mips/array.lisp b/src/assembly/mips/array.lisp index 8399f2f..3c53f1e 100644 --- a/src/assembly/mips/array.lisp +++ b/src/assembly/mips/array.lisp @@ -27,11 +27,11 @@ (: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) diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 5b97d54..9a42a0c 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -463,4 +463,4 @@ (error 'undefined-alien-function-error)) (defun memory-fault-error () - (error 'memory-fault-error)) \ No newline at end of file + (error 'memory-fault-error)) diff --git a/src/code/mips-vm.lisp b/src/code/mips-vm.lisp index 257ed24..a378b89 100644 --- a/src/code/mips-vm.lisp +++ b/src/code/mips-vm.lisp @@ -1,6 +1,8 @@ (in-package "SB!VM") + (define-alien-type os-context-t (struct os-context-t-struct)) + ;;;; MACHINE-TYPE and MACHINE-VERSION @@ -12,6 +14,7 @@ (defun get-machine-version () #!+little-endian "little-endian" #!-little-endian "big-endian") + ;;;; FIXUP-CODE-OBJECT @@ -100,36 +103,23 @@ (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)))))) diff --git a/src/compiler/mips/alloc.lisp b/src/compiler/mips/alloc.lisp index 55ef4a7..697ba4c 100644 --- a/src/compiler/mips/alloc.lisp +++ b/src/compiler/mips/alloc.lisp @@ -112,23 +112,31 @@ (: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)))) diff --git a/src/compiler/mips/arith.lisp b/src/compiler/mips/arith.lisp index 2c71158..89f14b5 100644 --- a/src/compiler/mips/arith.lisp +++ b/src/compiler/mips/arith.lisp @@ -937,7 +937,7 @@ (: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))))) diff --git a/src/compiler/mips/call.lisp b/src/compiler/mips/call.lisp index da5a322..d3a2472 100644 --- a/src/compiler/mips/call.lisp +++ b/src/compiler/mips/call.lisp @@ -140,7 +140,7 @@ (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. @@ -365,23 +365,25 @@ default-value-8 (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)) @@ -1091,7 +1093,7 @@ default-value-8 ;; 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)))) diff --git a/src/compiler/mips/insts.lisp b/src/compiler/mips/insts.lisp index 2f1b723..594e834 100644 --- a/src/compiler/mips/insts.lisp +++ b/src/compiler/mips/insts.lisp @@ -1143,7 +1143,7 @@ (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) @@ -1164,7 +1164,7 @@ 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) diff --git a/src/compiler/mips/macros.lisp b/src/compiler/mips/macros.lisp index 7a8a296..dd32fdc 100644 --- a/src/compiler/mips/macros.lisp +++ b/src/compiler/mips/macros.lisp @@ -114,6 +114,7 @@ (sc-case stack ((control-stack) (loadw reg cfp-tn offset)))))) + (defmacro store-stack-tn (stack reg) `(let ((stack ,stack) (reg ,reg)) diff --git a/src/compiler/mips/sap.lisp b/src/compiler/mips/sap.lisp index 98efa7a..89527cb 100644 --- a/src/compiler/mips/sap.lisp +++ b/src/compiler/mips/sap.lisp @@ -15,9 +15,9 @@ ;;; 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))) @@ -26,27 +26,26 @@ ;;; 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 @@ -55,13 +54,14 @@ (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 @@ -72,7 +72,7 @@ (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)) @@ -323,31 +323,37 @@ (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))))) - diff --git a/src/compiler/mips/vm.lisp b/src/compiler/mips/vm.lisp index 9d0188b..cc2d844 100644 --- a/src/compiler/mips/vm.lisp +++ b/src/compiler/mips/vm.lisp @@ -341,7 +341,7 @@ ;;; 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) diff --git a/src/runtime/cheneygc.c b/src/runtime/cheneygc.c index a18d878..6679f11 100644 --- a/src/runtime/cheneygc.c +++ b/src/runtime/cheneygc.c @@ -48,7 +48,6 @@ lispobj *new_space_free_pointer; 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; @@ -125,8 +124,7 @@ collect_garbage(unsigned ignore) 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 diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index e82a8cd..8bc1e8b 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -630,13 +630,15 @@ low_level_interrupt_handle_now(int signal, siginfo_t *info, void *void_context) { 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 */ @@ -649,7 +651,8 @@ low_level_maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context) { 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 diff --git a/src/runtime/linux-nm b/src/runtime/linux-nm index 70ea4ea..11d4243 100755 --- a/src/runtime/linux-nm +++ b/src/runtime/linux-nm @@ -3,5 +3,7 @@ # " 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?-] " diff --git a/src/runtime/mips-arch.c b/src/runtime/mips-arch.c index 1d64f76..0e7483d 100644 --- a/src/runtime/mips-arch.c +++ b/src/runtime/mips-arch.c @@ -35,9 +35,30 @@ arch_get_bad_addr(int signam, siginfo_t *siginfo, os_context_t *context) /* 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) { @@ -46,64 +67,69 @@ 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 */ @@ -112,7 +138,10 @@ emulate_branch(os_context_t *context, unsigned int inst) 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; @@ -122,33 +151,23 @@ void 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 @@ -161,8 +180,29 @@ unsigned long 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)); @@ -184,10 +224,9 @@ static sigset_t orig_sigmask; 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)); @@ -196,8 +235,7 @@ arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst) if (os_context_bd_cause(context)) { break_pc = pc+1; next_inst = *pc; - } - else { + } else { break_pc = pc; next_inst = orig_inst; } @@ -207,11 +245,7 @@ arch_do_displaced_inst(os_context_t *context, unsigned int 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); } @@ -229,9 +263,7 @@ static void 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: @@ -245,7 +277,7 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context) 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: @@ -253,8 +285,9 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context) 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: @@ -284,13 +317,13 @@ sigfpe_handler(int signal, siginfo_t *info, void *void_context) 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; @@ -303,50 +336,43 @@ sigfpe_handler(int signal, siginfo_t *info, void *void_context) 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 diff --git a/src/runtime/mips-assem.S b/src/runtime/mips-assem.S index c723b30..1c8a923 100644 --- a/src/runtime/mips-assem.S +++ b/src/runtime/mips-assem.S @@ -358,19 +358,33 @@ lra: .word RETURN_PC_HEADER_WIDETAG .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 */ @@ -387,7 +401,7 @@ lra: .word RETURN_PC_HEADER_WIDETAG /* * Function-end breakpoint magic. */ - .align 3 + .align 2 LEAF(fun_end_breakpoint_guts) .set noreorder .word RETURN_PC_HEADER_WIDETAG diff --git a/src/runtime/mips-linux-os.c b/src/runtime/mips-linux-os.c index 9fee95e..1968c2a 100644 --- a/src/runtime/mips-linux-os.c +++ b/src/runtime/mips-linux-os.c @@ -37,6 +37,9 @@ /* for cacheflush() */ #include +/* for BD_CAUSE */ +#include + #include "validate.h" size_t os_vm_page_size; @@ -82,6 +85,7 @@ unsigned int os_context_fp_control(os_context_t *context) { /* FIXME: Probably do something. */ + return 0; } void @@ -101,12 +105,34 @@ os_context_bd_cause(os_context_t *context) loop" where a (BREAK 16) not in a branch delay slot would have CAUSEF_BD filled. So, we comment - #include - 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; } diff --git a/src/runtime/mips-lispregs.h b/src/runtime/mips-lispregs.h index d5616d8..a5341c5 100644 --- a/src/runtime/mips-lispregs.h +++ b/src/runtime/mips-lispregs.h @@ -51,6 +51,3 @@ 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) diff --git a/src/runtime/thread.c b/src/runtime/thread.c index cedf3de..9e1b7a6 100644 --- a/src/runtime/thread.c +++ b/src/runtime/thread.c @@ -75,7 +75,7 @@ void check_sig_stop_for_gc_can_arrive_or_lose() 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; @@ -256,7 +256,8 @@ struct thread * create_thread_struct(lispobj initial_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; diff --git a/version.lisp-expr b/version.lisp-expr index 4b91345..53b5d97 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; 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"