X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsparc-vm.lisp;h=1ef6009e1d18a5077e1e746f07d7c401a59e38c9;hb=dae76a317682df7472ee85d1a0f6a0248801a6ae;hp=c7f39f240a4d8f3f7b91e329412c90e763b68fa6;hpb=68fd2d2dd6f265669a8957accd8a33e62786a97e;p=sbcl.git diff --git a/src/code/sparc-vm.lisp b/src/code/sparc-vm.lisp index c7f39f2..1ef6009 100644 --- a/src/code/sparc-vm.lisp +++ b/src/code/sparc-vm.lisp @@ -9,13 +9,9 @@ ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. (in-package "SB!VM") - - ;;; See x86-vm.lisp for a description of this. (define-alien-type os-context-t (struct os-context-t-struct)) - - ;;;; MACHINE-TYPE and MACHINE-VERSION @@ -23,10 +19,9 @@ "Returns a string describing the type of the local machine." "SPARC") -(defun machine-version () - "Returns a string describing the version of the local machine." - "SPARC") - +;;; support for CL:MACHINE-VERSION defined OAOO elsewhere +(defun get-machine-version () + nil) (defun fixup-code-object (code offset fixup kind) (declare (type index offset)) @@ -95,23 +90,18 @@ ;;; Given a signal context, return the floating point modes word in ;;; the same format as returned by FLOATING-POINT-MODES. + +;;; Under SunOS, we have a straightforward implementation in C: +#!+sunos +(define-alien-routine ("os_context_fp_control" context-floating-point-modes) + (sb!alien:unsigned 32) + (context (* os-context-t))) + +;;; Under Linux, we have to contend with utterly broken signal handling. +#!+linux (defun context-floating-point-modes (context) - ;; FIXME: As of sbcl-0.6.7 and the big rewrite of signal handling for - ;; POSIXness and (at the Lisp level) opaque signal contexts, - ;; this is stubified. It needs to be rewritten as an - ;; alien function. + (declare (ignore context)) (warn "stub CONTEXT-FLOATING-POINT-MODES") - ;; old code for Linux: - #+nil - (let ((cw (slot (deref (slot context 'fpstate) 0) 'cw)) - (sw (slot (deref (slot context 'fpstate) 0) 'sw))) - ;;(format t "cw = ~4X~%sw = ~4X~%" cw sw) - ;; NOT TESTED -- Clear sticky bits to clear interrupt condition. - (setf (slot (deref (slot context 'fpstate) 0) 'sw) (logandc2 sw #x3f)) - ;;(format t "new sw = ~X~%" (slot (deref (slot context 'fpstate) 0) 'sw)) - ;; Simulate floating-point-modes VOP. - (logior (ash (logand sw #xffff) 16) (logxor (logand cw #xffff) #x3f))) - 0) ;;;; INTERNAL-ERROR-ARGS. @@ -153,12 +143,12 @@ vector-data-offset) (* length n-byte-bits)) (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (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))) + (sc-offsets (sb!c:read-var-integer vector index))) (values error-number (sc-offsets)))))) (defun args-for-tagged-add-inst (context bad-inst) @@ -192,10 +182,3 @@ #.(error-number-or-lose 'unknown-error))) (list (sb!c::make-sc-offset descriptor-reg-sc-number reg))))) - -;;; Do whatever is necessary to make the given code component -;;; executable. On the sparc, we don't need to do anything, because -;;; the i and d caches are unified. -(defun sanctify-for-execution (component) - (declare (ignore component)) - nil)