X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-misc.lisp;h=7b07e83a263f72fc6009e48da5321aaf8030373e;hb=dde834ef75cb12b8cdda23472b3365de72d9422a;hp=205148632c10bf2969ab43953a03454bd2d0dac5;hpb=6498af7fdc48d9bf5df33e75d7e4d385893feb06;p=sbcl.git

diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp
index 2051486..7b07e83 100644
--- a/src/code/target-misc.lisp
+++ b/src/code/target-misc.lisp
@@ -35,6 +35,9 @@
                  (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
@@ -140,6 +151,24 @@
   "Return a string with the long form of the site name, or NIL if not known."
   *long-site-name*)
 
+;;;; ED
+(defvar *ed-functions* nil
+  "See function documentation for ED.")
+
+(defun ed (&optional x)
+  "Starts the editor (on a file or a function if named).  Functions
+from the list *ED-FUNCTIONS* are called in order with X as an argument
+until one of them returns non-NIL; these functions are responsible for
+signalling a FILE-ERROR to indicate failure to perform an operation on
+the file system."
+  (dolist (fun *ed-functions*
+	   (error 'extension-failure
+		  :format-control "Don't know how to ~S ~A"
+		  :format-arguments (list 'ed x)
+		  :references (list '(:sbcl :variable *ed-functions*))))
+    (when (funcall fun x)
+      (return t))))
+
 ;;;; dribble stuff
 
 ;;; Each time we start dribbling to a new stream, we put it in