X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-misc.lisp;h=8c798e2947391e4f95bcc645bb5947399d5d8d02;hb=a22dd643fb599880f4c0856e1a85bffe4358aea8;hp=64d4fb31c38477fe65246e36276635b552fb5c62;hpb=cd176690400f8b6fa23faa4dc6fa8494bcbce480;p=sbcl.git diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp index 64d4fb3..8c798e2 100644 --- a/src/code/target-misc.lisp +++ b/src/code/target-misc.lisp @@ -32,9 +32,12 @@ (let ((source (first (sb!c::compiled-debug-info-source info)))) (cond ((and (eq (sb!c::debug-source-from source) :lisp) (eq (sb!c::debug-source-info source) fun)) - (values (second (svref (sb!c::debug-source-name source) 0)) + (values (svref (sb!c::debug-source-name source) 0) nil name)) + ;; FIXME: shouldn't these two clauses be the other way + ;; round? Using VALID-FUNCTION-NAME-P to see if we + ;; want to find an inline-expansion? ((stringp name) (values nil t name)) (t @@ -51,8 +54,7 @@ (case (widetag-of fun) (#.sb!vm:closure-header-widetag (%simple-fun-name (%closure-fun fun))) - ((#.sb!vm:simple-fun-header-widetag - #.sb!vm:closure-fun-header-widetag) + (#.sb!vm:simple-fun-header-widetag ;; KLUDGE: The pun that %SIMPLE-FUN-NAME is used for closure ;; functions is left over from CMU CL (modulo various renaming ;; that's gone on since the fork). @@ -62,10 +64,10 @@ (funcallable-instance-fun fun))))) (defun (setf %fun-name) (new-name fun) + (aver nil) ; since this is unsafe 'til bug 137 is fixed (let ((widetag (widetag-of fun))) (case widetag - ((#.sb!vm:simple-fun-header-widetag - #.sb!vm:closure-fun-header-widetag) + (#.sb!vm:simple-fun-header-widetag ;; KLUDGE: The pun that %SIMPLE-FUN-NAME is used for closure ;; functions is left over from CMU CL (modulo various renaming ;; that's gone on since the fork). @@ -119,6 +121,16 @@ "Return a string giving the name of the local machine." (sb!unix:unix-gethostname)) +(defvar *machine-version*) + +(defun machine-version () + #!+sb-doc + "Return a string describing the version of the computer hardware we +are running on, or NIL if we can't find any useful information." + (unless (boundp '*machine-version*) + (setf *machine-version* (get-machine-version))) + *machine-version*) + ;;; FIXME: Don't forget to set these in a sample site-init file. ;;; FIXME: Perhaps the functions could be SETFable instead of having the ;;; interface be through special variables? As far as I can tell