X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-misc.lisp;h=8c798e2947391e4f95bcc645bb5947399d5d8d02;hb=e5e1b41799b814bca18e5f6e5c10b12d06c35c46;hp=a021148b4ace68ad0b187667c6526e64fff84326;hpb=e8b69b1dd5564a4237b1bdc1060820c3b820cde2;p=sbcl.git diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp index a021148..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). @@ -65,8 +67,7 @@ (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). @@ -120,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