Commit 3327b6aa authored by rtoy's avatar rtoy
Browse files

Merge from snapshot-2008-09.

parent d58d0463
Loading
Loading
Loading
Loading
+9 −6
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/char.lisp,v 1.15.18.3 2008/06/23 16:09:29 rtoy Exp $")
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/char.lisp,v 1.15.18.4 2008/09/03 16:34:30 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -60,6 +60,9 @@
  "This is the alist of (character-name . character) for characters with
  long names.  The first name in this list for a given character is used
  on typeout and is the preferred form for input."))))
  ;; Note: the char-name listed here should be what string-capitalize
  ;; would produce.  This is needed to match what format ~:C would
  ;; produce.
  (frob ((#x00 ("Null" "^@" "NUL"))
	 (#x01 ("^A" "SOH"))
	 (#x02 ("^B" "STX"))
@@ -71,7 +74,7 @@
	 (#x08 ("Backspace" "^h" "BS"))
	 (#x09 ("Tab" "^i" "HT"))
	 (#x0A ("Newline" "Linefeed" "^j" "LF" "NL" ))
	 (#x0B ("VT" "^k"))
	 (#x0B ("Vt" "^k"))
	 (#x0C ("Page" "^l" "Form" "Formfeed" "FF" "NP"))
	 (#x0D ("Return" "^m" "RET" "CR"))
	 (#x0E ("^N" "SO"))
@@ -88,10 +91,10 @@
	 (#x19 ("^Y" "EM" "EOM"))
	 (#x1A ("^Z" "SUB"))
	 (#x1B ("Escape" "^[" "Altmode" "ESC" "Alt"))
	 (#x1C ("IS4" "FS" "^\\"))
	 (#x1D ("IS3" "GS" "^]"))
	 (#x1E ("IS2" "RS" "^^"))
	 (#x1F ("IS1" "US" "^_"))
	 (#x1C ("Is4" "FS" "^\\"))
	 (#x1D ("Is3" "GS" "^]"))
	 (#x1E ("Is2" "RS" "^^"))
	 (#x1F ("Is1" "US" "^_"))
	 (#x20 ("Space" "SP" "SPC"))
	 (#x7f ("Rubout" "Delete" "DEL")))))

+3 −3
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.133 2008/01/03 11:41:51 cshapiro Exp $")
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.133.4.1 2008/09/03 16:34:31 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -1179,7 +1179,7 @@
	      frame)))))


#+(or sparc (and (or x86 amd64) linux))
#+(or sparc (and x86 darwin) (and (or x86 amd64) linux))
(defun find-foreign-function-name (address)
  "Return a string describing the foreign function near ADDRESS"
  (let ((addr (sys:sap-int address)))
@@ -1202,7 +1202,7 @@
		       (alien:slot info 'filename)
		       )))))))

#-(or sparc (and (or x86 amd64) linux))
#-(or sparc (and x86 darwin) (and (or x86 amd64) linux))
(defun find-foreign-function-name (ra)
  (declare (ignore ra))
  "Foreign function call land")
+44 −4
Original line number Diff line number Diff line
@@ -6,7 +6,7 @@
;;;

(ext:file-comment
 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/env-access.lisp,v 1.4 2007/11/14 10:04:33 cshapiro Exp $")
 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/env-access.lisp,v 1.4.4.1 2008/09/03 16:34:31 rtoy Exp $")

;;;
;;; **********************************************************************
@@ -26,9 +26,16 @@
(in-package "C")

(defun variable-information (var &optional env)
  "Return three values. The first indicates a binding kind of VAR; the
second is True if there is a local binding of VAR; the third is an
alist of declarations that apply to the apparent binding of VAR."
  "Returns information about the symbol VAR in the lexical environment ENV.
Three values are returned:
  1) Type or binding of VAR.
     NIL           No definition or binding
     :special      VAR is special
     :lexical      VAR is lexical
     :symbol-macro VAR refers to a SYMBOL-MACROLET binding
     :constant     VAR refers to a named constant or VAR is a keyword
  2) non-NIL if there is a local binding
  3) An a-list containing information about any declarations that apply."
  (let* ((*lexical-environment* (or env (make-null-environment)))
         (info (lexenv-find var variables)))
    (etypecase info
@@ -67,6 +74,16 @@ alist of declarations that apply to the apparent binding of VAR."
			   (info variable type var)))))))))

(defun declaration-information (declaration-name &optional env)
  "Returns information about declarations named by the symbol DECLARATION-NAME.
Supported DECLARATION-NAMES are
  1) OPTIMIZE
     A list whose entries are of the form (QUALITY VALUE) is returned,
     where QUALITY and VALUE are standard optimization qualities and
     values.
  2) EXT:OPTIMIZE-INTERFACE
     Like OPTIMIZE, but for the EXT:OPTIMIZE-INTERFACE declaration.
  3) DECLARATION.
     A list of the declaration names the have been proclaimed as valid."
  (let ((lexenv (or env (make-null-environment))))
    (case declaration-name
      (optimize
@@ -107,6 +124,11 @@ alist of declarations that apply to the apparent binding of VAR."
      (t (error "Unsupported declaration ~S." declaration-name)))))

(defun parse-macro (name lambda-list body &optional env)
  "Process a macro in the same way that DEFMACRO or MACROLET would.
Three values are returned:
  1) A lambda-expression that accepts two arguments
  2) A form
  3) An environment"
  (declare (ignore env))
  (let ((whole (gensym "WHOLE-"))
	(environment (gensym "ENVIRONMENT-")))
@@ -119,6 +141,15 @@ alist of declarations that apply to the apparent binding of VAR."
         ,body))))

(defun function-information (function &optional env)
  "Returns information about the function name FUNCTION in the lexical environment ENV.
Three values are returned:
  1) Type of definition or binding:
     NIL          No apparent definition
    :function    FUNCTION refers to a function
    :macro        FUNCTION refers to a macro
    :special-form FUNCTION is a special form
  2) non-NIL if definition is local
  3) An a-list containing information about the declarations that apply."
  (flet ((inlinealist (i)
	   (ecase i
	     (:inline
@@ -186,6 +217,15 @@ alist of declarations that apply to the apparent binding of VAR."
  `(quote ,env))

(defun augment-environment (env &key variable symbol-macro function macro declare)
  "Return a new environment containing information in ENV that is augmented
by the specified parameters:
  :VARIABLE     a list of symbols visible as bound variables in the new
                environemnt
  :SYMBOL-MACRO a list of symbol macro definitions
  :FUNCTION     a list of function names that will be visible as local
                functions
  :MACRO        a list of local macro definitions
  :DECLARE      a list of declaration specifiers"
  (when (or macro symbol-macro)
    (setq env (copy-structure env)))
  (when macro
+5 −1
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.267.2.3 2008/06/19 03:30:43 rtoy Exp $")
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.267.2.4 2008/09/03 16:34:31 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -1280,6 +1280,7 @@
             "COMPACT-INFO-ENVIRONMENT" "COMPILE-FROM-STREAM" "COMPILEDP"
             "COMPLETE-FILE" "CONCAT-PNAMES" "CONNECT-TO-INET-SOCKET"
             "CONSTANT" "CONSTANT-ARGUMENT" "CONSTANT-FUNCTION"
	     "BIND-INET-SOCKET"
             "CREATE-INET-LISTENER" "CREATE-INET-SOCKET" "CREATE-UNIX-LISTENER"
	     "DEF-SOURCE-CONTEXT"
             "DEFAULT-CLX-EVENT-HANDLER" "DEFAULT-DIRECTORY"
@@ -1408,7 +1409,10 @@

	     "*TRUST-DYNAMIC-EXTENT-DECLARATIONS*"

	     ;; From internet.lisp
	     "ACCEPT-NETWORK-STREAM"
	     "INET-RECVFROM" "INET-SENDTO" "INET-SHUTDOWN"
	     "OPEN-NETWORK-STREAM"
	     "SHUT-RD" "SHUT-WR" "SHUT-RDWR"

	     "BINARY-TEXT-STREAM" "READ-VECTOR" "WRITE-VECTOR"
+461 −459
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.86.2.2 2008/06/27 17:24:13 rtoy Exp $")
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.86.2.3 2008/09/03 16:34:31 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -900,6 +900,9 @@
;; See http://en.wikipedia.org/wiki/Names_of_large_numbers and also
;; http://home.hetnet.nl/~vanadovv/BignumbyN.html.  This list comes
;; from the latter link.
;;
;; Leading spaces are required to get everything printed out
;; correctly.
(defconstant cardinal-periods
  #("" " thousand" " million" " billion" " trillion" " quadrillion"
    " quintillion" " sextillion" " septillion" " octillion" " nonillion"
@@ -1409,7 +1412,6 @@
      (unless (zerop beyond)
	(write-char #\space stream))
      (format-print-small-cardinal stream here)
      (write-char #\space stream)
      (write-string (svref cardinal-periods period) stream))))

(defun format-print-ordinal (stream n)
Loading