CMUCL commit: src/compiler (23 files)
Raymond Toy
rtoy at common-lisp.net
Mon Apr 19 17:08:21 CEST 2010
Date: Monday, April 19, 2010 @ 11:08:21
Author: rtoy
Path: /project/cmucl/cvsroot/src/compiler
Modified: backend.lisp codegen.lisp debug-dump.lisp debug.lisp disassem.lisp
eval.lisp float-tran.lisp globaldb.lisp ir1opt.lisp ir1tran.lisp
ir1util.lisp ltn.lisp ltv.lisp macros.lisp main.lisp
meta-vmdef.lisp new-assem.lisp proclaim.lisp seqtran.lisp
srctran.lisp tn.lisp typetran.lisp vmdef.lisp
Remove _N"" reader macro from docstrings when possible.
-----------------+
backend.lisp | 16 ++---
codegen.lisp | 14 ++--
debug-dump.lisp | 4 -
debug.lisp | 10 +--
disassem.lisp | 162 +++++++++++++++++++++++++++---------------------------
eval.lisp | 8 +-
float-tran.lisp | 30 +++++-----
globaldb.lisp | 16 ++---
ir1opt.lisp | 8 +-
ir1tran.lisp | 58 +++++++++----------
ir1util.lisp | 26 ++++----
ltn.lisp | 6 +-
ltv.lisp | 4 -
macros.lisp | 68 +++++++++++-----------
main.lisp | 38 ++++++------
meta-vmdef.lisp | 34 +++++------
new-assem.lisp | 32 +++++-----
proclaim.lisp | 4 -
seqtran.lisp | 14 ++--
srctran.lisp | 64 ++++++++++-----------
tn.lisp | 4 -
typetran.lisp | 4 -
vmdef.lisp | 6 +-
23 files changed, 316 insertions(+), 314 deletions(-)
Index: src/compiler/backend.lisp
diff -u src/compiler/backend.lisp:1.33 src/compiler/backend.lisp:1.34
--- src/compiler/backend.lisp:1.33 Fri Mar 19 11:19:00 2010
+++ src/compiler/backend.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/backend.lisp,v 1.33 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/backend.lisp,v 1.34 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -234,11 +234,11 @@
(defvar *native-backend* (make-backend)
- _N"The backend for the machine we are running on. Do not change this.")
+ "The backend for the machine we are running on. Do not change this.")
(defvar *target-backend* *native-backend*
- _N"The backend we are attempting to compile.")
+ "The backend we are attempting to compile.")
(defvar *backend* *native-backend*
- _N"The backend we are using to compile with.")
+ "The backend we are using to compile with.")
@@ -247,23 +247,23 @@
(export '(backend-features target-featurep backend-featurep native-featurep))
(defun backend-features (backend)
- _N"Compute the *FEATURES* list to use with BACKEND."
+ "Compute the *FEATURES* list to use with BACKEND."
(union (backend-%features backend)
(set-difference *features*
(backend-misfeatures backend))))
(defun target-featurep (feature)
- _N"Same as EXT:FEATUREP, except use the features found in *TARGET-BACKEND*."
+ "Same as EXT:FEATUREP, except use the features found in *TARGET-BACKEND*."
(let ((*features* (backend-features *target-backend*)))
(featurep feature)))
(defun backend-featurep (feature)
- _N"Same as EXT:FEATUREP, except use the features found in *BACKEND*."
+ "Same as EXT:FEATUREP, except use the features found in *BACKEND*."
(let ((*features* (backend-features *backend*)))
(featurep feature)))
(defun native-featurep (feature)
- _N"Same as EXT:FEATUREP, except use the features found in *NATIVE-BACKEND*."
+ "Same as EXT:FEATUREP, except use the features found in *NATIVE-BACKEND*."
(let ((*features* (backend-features *native-backend*)))
(featurep feature)))
Index: src/compiler/codegen.lisp
diff -u src/compiler/codegen.lisp:1.25 src/compiler/codegen.lisp:1.26
--- src/compiler/codegen.lisp:1.25 Fri Mar 19 11:19:00 2010
+++ src/compiler/codegen.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/codegen.lisp,v 1.25 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/codegen.lisp,v 1.26 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -34,7 +34,7 @@
;;; Component-Header-Length -- Interface
;;;
(defun component-header-length (&optional (component *compile-component*))
- _N"Returns the number of bytes used by the code object header."
+ "Returns the number of bytes used by the code object header."
(let* ((2comp (component-info component))
(constants (ir2-component-constants 2comp))
(num-consts (length constants)))
@@ -43,7 +43,7 @@
;;; SB-Allocated-Size -- Interface
;;;
(defun sb-allocated-size (name)
- _N"The size of the Name'd SB in the currently compiled component. Useful
+ "The size of the Name'd SB in the currently compiled component. Useful
mainly for finding the size for allocating stack frames."
(finite-sb-current-size (sb-or-lose name *backend*)))
@@ -51,7 +51,7 @@
;;; Current-NFP-TN -- Interface
;;;
(defun current-nfp-tn (vop)
- _N"Return the TN that is used to hold the number stack frame-pointer in VOP's
+ "Return the TN that is used to hold the number stack frame-pointer in VOP's
function. Returns NIL if no number stack frame was allocated."
(unless (zerop (sb-allocated-size 'non-descriptor-stack))
(let ((block (ir2-block-block (vop-block vop))))
@@ -63,7 +63,7 @@
;;; CALLEE-NFP-TN -- Interface
;;;
(defun callee-nfp-tn (2env)
- _N"Return the TN that is used to hold the number stack frame-pointer in the
+ "Return the TN that is used to hold the number stack frame-pointer in the
function designated by 2env. Returns NIL if no number stack frame was
allocated."
(unless (zerop (sb-allocated-size 'non-descriptor-stack))
@@ -74,7 +74,7 @@
;;; CALLEE-RETURN-PC-TN -- Interface
;;;
(defun callee-return-pc-tn (2env)
- _N"Return the TN used for passing the return PC in a local call to the function
+ "Return the TN used for passing the return PC in a local call to the function
designated by 2env."
(ir2-environment-return-pc-pass 2env))
@@ -126,7 +126,7 @@
(defvar *elsewhere-label* nil)
(defvar *assembly-optimize* t
- _N"Set to NIL to inhibit assembly-level optimization. For compiler debugging,
+ "Set to NIL to inhibit assembly-level optimization. For compiler debugging,
rather than policy control.")
Index: src/compiler/debug-dump.lisp
diff -u src/compiler/debug-dump.lisp:1.50 src/compiler/debug-dump.lisp:1.51
--- src/compiler/debug-dump.lisp:1.50 Fri Mar 19 11:19:00 2010
+++ src/compiler/debug-dump.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/debug-dump.lisp,v 1.50 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/debug-dump.lisp,v 1.51 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -282,7 +282,7 @@
(defun namestring-for-debug-source (file-info)
- _N"Extract the namestring from FILE-INFO for the DEBUG-SOURCE.
+ "Extract the namestring from FILE-INFO for the DEBUG-SOURCE.
Return FILE-INFO's untruename (e.g., target:foo) if it is absolute;
otherwise the truename."
(let* ((untruename (file-info-untruename file-info))
Index: src/compiler/debug.lisp
diff -u src/compiler/debug.lisp:1.38 src/compiler/debug.lisp:1.39
--- src/compiler/debug.lisp:1.38 Fri Mar 19 11:19:00 2010
+++ src/compiler/debug.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/debug.lisp,v 1.38 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/debug.lisp,v 1.39 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -21,7 +21,7 @@
(defvar *args* ()
- _N"This variable is bound to the format arguments when an error is signalled
+ "This variable is bound to the format arguments when an error is signalled
by Barf or Burp.")
(defvar *ignored-errors* (make-hash-table :test #'equal))
@@ -43,7 +43,7 @@
(setf (gethash string *ignored-errors*) t)))))
(defvar *burp-action* :warn
- _N"Action taken by the Burp function when a possible compiler bug is detected.
+ "Action taken by the Burp function when a possible compiler bug is detected.
One of :Warn, :Error or :None.")
(declaim (type (member :warn :error :none) *burp-action*))
@@ -1314,7 +1314,7 @@
;;; List-Conflicts -- Interface
;;;
(defun list-conflicts (tn)
- _N"Return a list of a the TNs that conflict with TN. Sort of, kind of. For
+ "Return a list of a the TNs that conflict with TN. Sort of, kind of. For
debugging use only. Probably doesn't work on :COMPONENT TNs."
(assert (member (tn-kind tn) '(:normal :environment :debug-environment)))
(let ((confs (tn-global-conflicts tn)))
@@ -1357,7 +1357,7 @@
;;; Nth-VOP -- Interface
;;;
(defun nth-vop (thing n)
- _N"Return the Nth VOP in the IR2-Block pointed to by Thing."
+ "Return the Nth VOP in the IR2-Block pointed to by Thing."
(let ((block (block-info (block-or-lose thing))))
(do ((i 0 (1+ i))
(vop (ir2-block-start-vop block) (vop-next vop)))
Index: src/compiler/disassem.lisp
diff -u src/compiler/disassem.lisp:1.56 src/compiler/disassem.lisp:1.57
--- src/compiler/disassem.lisp:1.56 Fri Mar 19 11:19:00 2010
+++ src/compiler/disassem.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/disassem.lisp,v 1.56 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/disassem.lisp,v 1.57 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -99,11 +99,11 @@
;;; ----------------------------------------------------------------
(defvar *opcode-column-width* nil
- _N"The width of the column in which instruction-names are printed.
+ "The width of the column in which instruction-names are printed.
NIL means use the default. A value of zero gives the effect of not
aligning the arguments at all.")
(defvar *note-column* 45
- _N"The column in which end-of-line comments for notes are started.")
+ "The column in which end-of-line comments for notes are started.")
(defconstant default-opcode-column-width 6)
(defconstant default-location-column-width 8)
@@ -129,7 +129,7 @@
;;; ----------------------------------------------------------------
(defmacro set-disassem-params (&rest args)
- _N"Specify global disassembler params for C:*TARGET-BACKEND*.
+ "Specify global disassembler params for C:*TARGET-BACKEND*.
Keyword arguments include:
:INSTRUCTION-ALIGNMENT number
@@ -144,7 +144,7 @@
(gen-preamble-form args))
(defmacro define-argument-type (name &rest args)
- _N"DEFINE-ARGUMENT-TYPE Name {Key Value}*
+ "DEFINE-ARGUMENT-TYPE Name {Key Value}*
Define a disassembler argument type NAME (which can then be referenced in
another argument definition using the :TYPE keyword argument). Keyword
arguments are:
@@ -173,7 +173,7 @@
(gen-arg-type-def-form name args))
(defmacro define-instruction-format (header &rest fields)
- _N"DEFINE-INSTRUCTION-FORMAT (Name Length {Format-Key Value}*) Arg-Def*
+ "DEFINE-INSTRUCTION-FORMAT (Name Length {Format-Key Value}*) Arg-Def*
Define an instruction format NAME for the disassembler's use. LENGTH is
the length of the format in bits.
Possible FORMAT-KEYs:
@@ -256,13 +256,13 @@
int))
(defun aligned-p (address size)
- _N"Returns non-NIL if ADDRESS is aligned on a SIZE byte boundary."
+ "Returns non-NIL if ADDRESS is aligned on a SIZE byte boundary."
(declare (type address address)
(type alignment size))
(zerop (logand (1- size) address)))
(defun align (address size)
- _N"Return ADDRESS aligned *upward* to a SIZE byte boundary."
+ "Return ADDRESS aligned *upward* to a SIZE byte boundary."
(declare (type address address)
(type alignment size))
(logandc1 (1- size) (+ (1- size) address)))
@@ -292,14 +292,14 @@
;;; recursively filtering things that usually don't change.
(defun sharing-cons (old-cons car cdr)
- _N"If CAR is eq to the car of OLD-CONS and CDR is eq to the CDR, return
+ "If CAR is eq to the car of OLD-CONS and CDR is eq to the CDR, return
OLD-CONS, otherwise return (cons CAR CDR)."
(if (and (eq car (car old-cons)) (eq cdr (cdr old-cons)))
old-cons
(cons car cdr)))
(defun sharing-mapcar (fun list)
- _N"A simple (one list arg) mapcar that avoids consing up a new list
+ "A simple (one list arg) mapcar that avoids consing up a new list
as long as the results of calling FUN on the elements of LIST are
eq to the original."
(and list
@@ -861,7 +861,7 @@
;;; ----------------------------------------------------------------
(defun find-first-field-name (tree)
- _N"Returns the first non-keyword symbol in a depth-first search of TREE."
+ "Returns the first non-keyword symbol in a depth-first search of TREE."
(cond ((null tree)
nil)
((and (symbolp tree) (not (keywordp tree)))
@@ -1134,7 +1134,7 @@
printer)))))
(defun preprocess-printer (printer args)
- _N"Returns a version of the disassembly-template PRINTER with compile-time
+ "Returns a version of the disassembly-template PRINTER with compile-time
tests (e.g. :constant without a value), and any :CHOOSE operators resolved
properly for the args ARGS. (:CHOOSE Sub*) simply returns the first Sub in
which every field reference refers to a valid arg."
@@ -1416,7 +1416,7 @@
;;; ----------------------------------------------------------------
(defun gen-preamble-form (args)
- _N"Generate a form to specify global disassembler params. See the
+ "Generate a form to specify global disassembler params. See the
documentation for SET-DISASSEM-PARAMS for more info."
(destructuring-bind
(&key instruction-alignment
@@ -1469,7 +1469,7 @@
',descrip-forms))))
(defun gen-arg-type-def-form (name args &optional (evalp t))
- _N"Generate a form to define a disassembler argument type. See
+ "Generate a form to define a disassembler argument type. See
DEFINE-ARGUMENT-TYPE for more info."
(multiple-value-bind (args wrapper-defs)
(munge-fun-refs args evalp t name)
@@ -1505,7 +1505,7 @@
,',arg-val-form))))))
(defun gen-format-def-form (header descrips &optional (evalp t))
- _N"Generate a form to define an instruction format. See
+ "Generate a form to define an instruction format. See
DEFINE-INSTRUCTION-FORMAT for more info."
(when (atom header)
(setf header (list header)))
@@ -1646,7 +1646,7 @@
;;; combining instructions where one specializes another
(defun inst-specializes-p (special general)
- _N"Returns non-NIL if the instruction SPECIAL is a more specific version of
+ "Returns non-NIL if the instruction SPECIAL is a more specific version of
GENERAL (i.e., the same instruction, but with more constraints)."
(declare (type instruction special general))
(let ((smask (inst-mask special))
@@ -1657,12 +1657,12 @@
;;; a bit arbitrary, but should work ok...
(defun specializer-rank (inst)
- _N"Returns an integer corresponding to the specifivity of the instruction INST."
+ "Returns an integer corresponding to the specifivity of the instruction INST."
(declare (type instruction inst))
(* (dchunk-count-bits (inst-mask inst)) 4))
(defun order-specializers (insts)
- _N"Order the list of instructions INSTS with more specific (more constant
+ "Order the list of instructions INSTS with more specific (more constant
bits, or same-as argument constains) ones first. Returns the ordered list."
(declare (type list insts))
(sort insts
@@ -1673,7 +1673,7 @@
(error _"Instructions either aren't related or conflict in some way:~% ~s" insts))
(defun try-specializing (insts)
- _N"Given a list of instructions INSTS, Sees if one of these instructions is a
+ "Given a list of instructions INSTS, Sees if one of these instructions is a
more general form of all the others, in which case they are put into its
specializers list, and it is returned. Otherwise an error is signaled."
(declare (type list insts))
@@ -1701,13 +1701,13 @@
(declaim (inline inst-matches-p choose-inst-specialization))
(defun inst-matches-p (inst chunk)
- _N"Returns non-NIL if all constant-bits in INST match CHUNK."
+ "Returns non-NIL if all constant-bits in INST match CHUNK."
(declare (type instruction inst)
(type dchunk chunk))
(dchunk= (dchunk-and (inst-mask inst) chunk) (inst-id inst)))
(defun choose-inst-specialization (inst chunk)
- _N"Given an instruction object, INST, and a bit-pattern, CHUNK, picks the
+ "Given an instruction object, INST, and a bit-pattern, CHUNK, picks the
most specific instruction on INST's specializer list who's constraints are
met by CHUNK. If none do, then INST is returned."
(declare (type instruction inst)
@@ -1740,7 +1740,7 @@
;;; searching for an instruction in instruction space
(defun find-inst (chunk inst-space)
- _N"Returns the instruction object within INST-SPACE corresponding to the
+ "Returns the instruction object within INST-SPACE corresponding to the
bit-pattern CHUNK, or NIL if there isn't one."
(declare (type dchunk chunk)
(type (or null inst-space instruction) inst-space))
@@ -1763,7 +1763,7 @@
;;; building the instruction space
(defun build-inst-space (insts &optional (initial-mask dchunk-one))
- _N"Returns an instruction-space object corresponding to the list of
+ "Returns an instruction-space object corresponding to the list of
instructions INSTS. If the optional parameter INITIAL-MASK is supplied, only
bits it has set are used."
;; This is done by finding any set of bits that's common to
@@ -1831,7 +1831,7 @@
(bytes-to-bits (inst-length inst))))
(defun print-inst-space (inst-space &optional (indent 0))
- _N"Prints a nicely formatted version of INST-SPACE."
+ "Prints a nicely formatted version of INST-SPACE."
(etypecase inst-space
(null)
(instruction
@@ -1858,7 +1858,7 @@
(ispace-choices inst-space)))))
(defun print-backend-inst-space (&optional (backend c:*target-backend*))
- _N"Print the inst space for the specified backend"
+ "Print the inst space for the specified backend"
(let ((ext:*gc-verbose* nil))
(print-inst-space (get-inst-space (c:backend-disassem-params backend)))))
@@ -1898,13 +1898,13 @@
(eval-when (eval load compile) ; used in a defconstant
(defun words-to-bytes (num)
- _N"Converts a word-offset NUM to a byte-offset."
+ "Converts a word-offset NUM to a byte-offset."
(declare (type offset num))
(ash num vm:word-shift))
)
(defun bytes-to-words (num)
- _N"Converts a byte-offset NUM to a word-offset."
+ "Converts a byte-offset NUM to a word-offset."
(declare (type offset num))
(ash num (- vm:word-shift)))
@@ -1995,16 +1995,16 @@
(format stream "+~d~@[ in ~s~]" (dstate-cur-offs dstate) (dstate-segment dstate))))
(defmacro dstate-get-prop (dstate name)
- _N"Get the value of the property called NAME in DSTATE. Also setf'able."
+ "Get the value of the property called NAME in DSTATE. Also setf'able."
`(getf (dstate-properties ,dstate) ,name))
(defun dstate-cur-addr (dstate)
- _N"Returns the absolute address of the current instruction in DSTATE."
+ "Returns the absolute address of the current instruction in DSTATE."
(the address (+ (seg-virtual-location (dstate-segment dstate))
(dstate-cur-offs dstate))))
(defun dstate-next-addr (dstate)
- _N"Returns the absolute address of the next instruction in DSTATE."
+ "Returns the absolute address of the next instruction in DSTATE."
(the address (+ (seg-virtual-location (dstate-segment dstate))
(dstate-next-offs dstate))))
@@ -2034,13 +2034,13 @@
(fun-address (kernel:funcallable-instance-function function)))))
(defun fun-insts-offset (function)
- _N"Offset of FUNCTION from the start of its code-component's instruction area."
+ "Offset of FUNCTION from the start of its code-component's instruction area."
(declare (type compiled-function function))
(- (fun-address function)
(system:sap-int (kernel:code-instructions (fun-code function)))))
(defun fun-offset (function)
- _N"Offset of FUNCTION from the start of its code-component."
+ "Offset of FUNCTION from the start of its code-component."
(declare (type compiled-function function))
(words-to-bytes (kernel:get-closure-length function)))
@@ -2049,17 +2049,17 @@
;;; one or more functions).
(defun code-inst-area-length (code-component)
- _N"Returns the length of the instruction area in CODE-COMPONENT."
+ "Returns the length of the instruction area in CODE-COMPONENT."
(declare (type kernel:code-component code-component))
(kernel:code-header-ref code-component vm:code-trace-table-offset-slot))
(defun code-inst-area-address (code-component)
- _N"Returns the address of the instruction area in CODE-COMPONENT."
+ "Returns the address of the instruction area in CODE-COMPONENT."
(declare (type kernel:code-component code-component))
(system:sap-int (kernel:code-instructions code-component)))
(defun code-first-function (code-component)
- _N"Returns the first function in CODE-COMPONENT."
+ "Returns the first function in CODE-COMPONENT."
(declare (type kernel:code-component code-component))
(kernel:code-header-ref code-component vm:code-trace-table-offset-slot))
@@ -2114,7 +2114,7 @@
nil)
(defun fun-header-hook (stream dstate)
- _N"Print the function-header (entry-point) pseudo-instruction at the current
+ "Print the function-header (entry-point) pseudo-instruction at the current
location in DSTATE to STREAM."
(declare (type (or null stream) stream)
(type disassem-state dstate))
@@ -2214,7 +2214,7 @@
(incf (dstate-next-offs dstate) alignment)))
(defun map-segment-instructions (function segment dstate &optional stream)
- _N"Iterate through the instructions in SEGMENT, calling FUNCTION
+ "Iterate through the instructions in SEGMENT, calling FUNCTION
for each instruction, with arguments of CHUNK, STREAM, and DSTATE."
(declare (type function function)
(type segment segment)
@@ -2281,7 +2281,7 @@
;;; ----------------------------------------------------------------
(defun add-segment-labels (segment dstate)
- _N"Make an initial non-printing disassembly pass through DSTATE, noting any
+ "Make an initial non-printing disassembly pass through DSTATE, noting any
addresses that are referenced by instructions in this segment."
;; add labels at the beginning with a label-number of nil; we'll notice
;; later and fill them in (and sort them)
@@ -2300,7 +2300,7 @@
(setf (dstate-notes dstate) nil)))
(defun number-labels (dstate)
- _N"If any labels in DSTATE have been added since the last call to this
+ "If any labels in DSTATE have been added since the last call to this
function, give them label-numbers, enter them in the hash-table, and make
sure the label list is in sorted order."
(let ((labels (dstate-labels dstate)))
@@ -2323,7 +2323,7 @@
;;; ----------------------------------------------------------------
(defun get-inst-space (params)
- _N"Get the instruction-space from PARAMS, creating it if necessary."
+ "Get the instruction-space from PARAMS, creating it if necessary."
(declare (type params params))
(let ((ispace (params-inst-space params)))
(when (null ispace)
@@ -2381,7 +2381,7 @@
(ceiling (integer-length (logxor from (+ from length))) 4)))
(defun print-current-address (stream dstate)
- _N"Print the current address in DSTATE to STREAM, plus any labels that
+ "Print the current address in DSTATE to STREAM, plus any labels that
correspond to it, and leave the cursor in the instruction column."
(declare (type stream stream)
(type disassem-state dstate))
@@ -2440,7 +2440,7 @@
, at body))
(defun print-notes-and-newline (stream dstate)
- _N"Print a newline to STREAM, inserting any pending notes in DSTATE as
+ "Print a newline to STREAM, inserting any pending notes in DSTATE as
end-of-line comments. If there is more than one note, a separate line
will be used for each one."
(declare (type stream stream)
@@ -2459,7 +2459,7 @@
(setf (dstate-notes dstate) nil)))
(defun print-bytes (num stream dstate)
- _N"Disassemble NUM bytes to STREAM as simple `BYTE' instructions"
+ "Disassemble NUM bytes to STREAM as simple `BYTE' instructions"
(declare (type offset num)
(type stream stream)
(type disassem-state dstate))
@@ -2472,7 +2472,7 @@
(format stream "#x~2,'0x" (system:sap-ref-8 sap (+ offs start-offs))))))
(defun print-words (num stream dstate)
- _N"Disassemble NUM machine-words to STREAM as simple `WORD' instructions"
+ "Disassemble NUM machine-words to STREAM as simple `WORD' instructions"
(declare (type offset num)
(type stream stream)
(type disassem-state dstate))
@@ -2501,7 +2501,7 @@
(defvar *default-dstate-hooks* (list #'lra-hook))
(defun make-dstate (params &optional (fun-hooks *default-dstate-hooks*))
- _N"Make a disassembler-state object."
+ "Make a disassembler-state object."
(declare (type params params))
(let ((sap
;; a random address
@@ -2581,7 +2581,7 @@
code virtual-location
debug-function source-form-cache
hooks)
- _N"Return a memory segment located at the system-area-pointer returned by
+ "Return a memory segment located at the system-area-pointer returned by
SAP-MAKER and LENGTH bytes long in the disassem-state object DSTATE.
Optional keyword arguments include :VIRTUAL-LOCATION (by default the same as
the address), :DEBUG-FUNCTION, :SOURCE-FORM-CACHE (a source-form-cache
@@ -2769,12 +2769,12 @@
)
(defun dstate-debug-variables (dstate)
- _N"Return the vector of debug-variables currently associated with DSTATE."
+ "Return the vector of debug-variables currently associated with DSTATE."
(declare (type disassem-state dstate))
(storage-info-debug-variables (seg-storage-info (dstate-segment dstate))))
(defun find-valid-storage-location (offset lg-name dstate)
- _N"Given the OFFSET of a location within the location-group called LG-NAME,
+ "Given the OFFSET of a location within the location-group called LG-NAME,
see if there's a current mapping to a source variable in DSTATE, and if so,
return the offset of that variable in the current debug-variable vector."
(declare (type offset offset)
@@ -2820,7 +2820,7 @@
))))))))
(defun grow-vector (vec new-len &optional initial-element)
- _N"Return a new vector which has the same contents as the old one VEC, plus
+ "Return a new vector which has the same contents as the old one VEC, plus
new cells (for a total size of NEW-LEN). The additional elements are
initailized to INITIAL-ELEMENT."
(declare (type vector vec)
@@ -2834,7 +2834,7 @@
new))
(defun storage-info-for-debug-function (debug-function)
- _N"Returns a STORAGE-INFO struction describing the object-to-source
+ "Returns a STORAGE-INFO struction describing the object-to-source
variable mappings from DEBUG-FUNCTION."
(declare (type di:debug-function debug-function))
(let ((sc-vec (c::backend-sc-numbers c:*native-backend*))
@@ -2902,7 +2902,7 @@
:block-boundary))))
(defun add-source-tracking-hooks (segment debug-function &optional sfcache)
- _N"Add hooks to track to track the source code in SEGMENT during
+ "Add hooks to track to track the source code in SEGMENT during
disassembly. SFCACHE can be either NIL or it can be a SOURCE-FORM-CACHE
structure, in which case it is used to cache forms from files."
(declare (type segment segment)
@@ -3008,7 +3008,7 @@
;;; ----------------------------------------------------------------
(defun fun-header-pc (function)
- _N"Return the PC of FUNCTION's header."
+ "Return the PC of FUNCTION's header."
(declare (type compiled-function function))
(let ((code (fun-code function)))
(* (- (kernel:function-word-offset function)
@@ -3016,10 +3016,10 @@
vm:word-bytes)))
(defvar *disassemble-flets* t
- _N"If non-NIL, disassemble flets/labels too")
+ "If non-NIL, disassemble flets/labels too")
(defun get-function-segments (function)
- _N"Returns a list of the segments of memory containing machine code
+ "Returns a list of the segments of memory containing machine code
instructions for FUNCTION."
(declare (type compiled-function function))
(let* ((code (fun-code function))
@@ -3098,7 +3098,7 @@
&optional
(start-offs 0)
(length (code-inst-area-length code)))
- _N"Returns a list of the segments of memory containing machine code
+ "Returns a list of the segments of memory containing machine code
instructions for the code-component CODE. If START-OFFS and/or LENGTH is
supplied, only that part of the code-segment is used (but these are
constrained to lie within the code-segment)."
@@ -3171,7 +3171,7 @@
;;; ----------------------------------------------------------------
(defun segment-overflow (segment dstate)
- _N"Returns two values: the amount by which the last instruction in the
+ "Returns two values: the amount by which the last instruction in the
segment goes past the end of the segment, and the offset of the end of the
segment from the beginning of that instruction. If all instructions fit
perfectly, this will return 0 and 0."
@@ -3188,7 +3188,7 @@
(- seglen last-start))))
(defun label-segments (seglist dstate)
- _N"Computes labels for all the memory segments in SEGLIST and adds them to
+ "Computes labels for all the memory segments in SEGLIST and adds them to
DSTATE. It's important to call this function with all the segments you're
interested in, so it can find references from one to another."
(declare (type list seglist)
@@ -3208,7 +3208,7 @@
(dstate-labels dstate))))
(defun disassemble-segment (segment stream dstate)
- _N"Disassemble the machine code instructions in SEGMENT to STREAM."
+ "Disassemble the machine code instructions in SEGMENT to STREAM."
(declare (type segment segment)
(type stream stream)
(type disassem-state dstate))
@@ -3225,7 +3225,7 @@
stream)))
(defun disassemble-segments (segments stream dstate)
- _N"Disassemble the machine code instructions in each memory segment in
+ "Disassemble the machine code instructions in each memory segment in
SEGMENTS in turn to STREAM."
(declare (type list segments)
(type stream stream)
@@ -3258,7 +3258,7 @@
(defun disassemble-function (function &key (stream *standard-output*)
(use-labels t)
(backend c:*native-backend*))
- _N"Disassemble the machine code instructions for FUNCTION."
+ "Disassemble the machine code instructions for FUNCTION."
(declare (type compiled-function function)
(type stream stream)
(type (member t nil) use-labels)
@@ -3299,7 +3299,7 @@
(defun disassemble (object &key (stream *standard-output*)
(use-labels t)
(backend c:*native-backend*))
- _N"Disassemble the machine code associated with OBJECT, which can be a
+ "Disassemble the machine code associated with OBJECT, which can be a
function, a lambda expression, or a symbol with a function definition. If
it is not already compiled, the compiler is called to produce something to
disassemble."
@@ -3324,7 +3324,7 @@
code-component
(use-labels t)
(backend c:*backend*))
- _N"Disassembles the given area of memory starting at ADDRESS and LENGTH long.
+ "Disassembles the given area of memory starting at ADDRESS and LENGTH long.
Note that if CODE-COMPONENT is NIL and this memory could move during a GC,
you'd better disable it around the call to this function."
(declare (type (or address system:system-area-pointer) address)
@@ -3358,7 +3358,7 @@
(stream *standard-output*)
(use-labels t)
(backend c:*native-backend*))
- _N"Disassemble the machine code instructions associated with
+ "Disassemble the machine code instructions associated with
CODE-COMPONENT (this may include multiple entry points)."
(declare (type (or null kernel:code-component compiled-function)
code-component)
@@ -3486,7 +3486,7 @@
(sort disassem-segments #'< :key #'seg-virtual-location)))
(defun disassemble-assem-segment (assem-segment stream backend)
- _N"Disassemble the machine code instructions associated with
+ "Disassemble the machine code instructions associated with
ASSEM-SEGMENT (of type new-assem:segment)."
(declare (type new-assem:segment assem-segment)
(type stream stream)
@@ -3508,11 +3508,11 @@
(,vm:symbol-package-slot . symbol-package))
#'<
:key #'car)
- _N"An alist of (SYMBOL-SLOT-OFFSET . ACCESS-FUNCTION-NAME) for slots in a
+ "An alist of (SYMBOL-SLOT-OFFSET . ACCESS-FUNCTION-NAME) for slots in a
symbol object that we know about.")
(defun grok-symbol-slot-ref (address)
- _N"Given ADDRESS, try and figure out if which slot of which symbol is being
+ "Given ADDRESS, try and figure out if which slot of which symbol is being
refered to. Of course we can just give up, so it's not a big deal...
Returns two values, the symbol and the name of the access function of the
slot."
@@ -3534,19 +3534,19 @@
(defconstant nil-addr (kernel:get-lisp-obj-address nil))
(defun grok-nil-indexed-symbol-slot-ref (byte-offset)
- _N"Given a BYTE-OFFSET from NIL, try and figure out if which slot of which
+ "Given a BYTE-OFFSET from NIL, try and figure out if which slot of which
symbol is being refered to. Of course we can just give up, so it's not a big
deal... Returns two values, the symbol and the access function."
(declare (type offset byte-offset))
(grok-symbol-slot-ref (+ nil-addr byte-offset)))
(defun get-nil-indexed-object (byte-offset)
- _N"Returns the lisp object located BYTE-OFFSET from NIL."
+ "Returns the lisp object located BYTE-OFFSET from NIL."
(declare (type offset byte-offset))
(kernel:make-lisp-obj (+ nil-addr byte-offset)))
(defun get-code-constant (byte-offset dstate)
- _N"Returns two values; the lisp-object located at BYTE-OFFSET in the constant
+ "Returns two values; the lisp-object located at BYTE-OFFSET in the constant
area of the code-object in the current segment and T, or NIL and NIL if
there is no code-object in the current segment."
(declare (type offset byte-offset)
@@ -3583,14 +3583,14 @@
(defvar *foreign-symbols-by-addr* nil)
(defun invert-address-hash (htable &optional (addr-hash (make-hash-table)))
- _N"Build an address-name hash-table from the name-address hash"
+ "Build an address-name hash-table from the name-address hash"
(maphash #'(lambda (name address)
(setf (gethash address addr-hash) name))
htable)
addr-hash)
(defun find-assembler-routine (address)
- _N"Returns the name of the primitive lisp assembler routine or foreign
+ "Returns the name of the primitive lisp assembler routine or foreign
symbol located at ADDRESS, or NIL if there isn't one."
(declare (type address address))
(when (null *assembler-routines-by-addr*)
@@ -3652,7 +3652,7 @@
;;; optional routines to make notes about code
(defun note (note dstate)
- _N"Store NOTE (which can be either a string or a function with a single
+ "Store NOTE (which can be either a string or a function with a single
stream argument) to be printed as an end-of-line comment after the current
instruction is disassembled."
(declare (type (or string function) note)
@@ -3669,7 +3669,7 @@
(prin1-short `',thing stream)))
(defun note-code-constant (byte-offset dstate)
- _N"Store a note about the lisp constant located BYTE-OFFSET bytes from the
+ "Store a note about the lisp constant located BYTE-OFFSET bytes from the
current code-component, to be printed as an end-of-line comment after the
current instruction is disassembled."
(declare (type offset byte-offset)
@@ -3683,7 +3683,7 @@
const))
(defun note-code-constant-absolute (addr dstate)
- _N"Store a note about the lisp constant located at ADDR in the
+ "Store a note about the lisp constant located at ADDR in the
current code-component, to be printed as an end-of-line comment after the
current instruction is disassembled."
(declare (type address addr)
@@ -3697,7 +3697,7 @@
(values const valid)))
(defun maybe-note-nil-indexed-symbol-slot-ref (nil-byte-offset dstate)
- _N"If the memory address located NIL-BYTE-OFFSET bytes from the constant NIL
+ "If the memory address located NIL-BYTE-OFFSET bytes from the constant NIL
is a valid slot in a symbol, store a note describing which symbol and slot,
to be printed as an end-of-line comment after the current instruction is
disassembled. Returns non-NIL iff a note was recorded."
@@ -3715,7 +3715,7 @@
access-fun))
(defun maybe-note-nil-indexed-object (nil-byte-offset dstate)
- _N"If the memory address located NIL-BYTE-OFFSET bytes from the constant NIL
+ "If the memory address located NIL-BYTE-OFFSET bytes from the constant NIL
is a valid lisp object, store a note describing which symbol and slot, to
be printed as an end-of-line comment after the current instruction is
disassembled. Returns non-NIL iff a note was recorded."
@@ -3728,7 +3728,7 @@
t))
(defun maybe-note-assembler-routine (address note-address-p dstate)
- _N"If ADDRESS is the address of a primitive assembler routine or
+ "If ADDRESS is the address of a primitive assembler routine or
foreign symbol, store a note describing which one, to be printed as
an end-of-line comment after the current instruction is disassembled.
Returns non-NIL iff a note was recorded. If NOTE-ADDRESS-P is non-NIL, a
@@ -3748,7 +3748,7 @@
name))
(defun maybe-note-static-function (nil-byte-offset dstate)
- _N"If NIL-BYTE-OFFSET is the offset of static function, store a note
+ "If NIL-BYTE-OFFSET is the offset of static function, store a note
describing which one, to be printed as an end-of-line comment after
the current instruction is disassembled. Returns non-NIL iff a note
was recorded."
@@ -3762,7 +3762,7 @@
sym))
(defun maybe-note-single-storage-ref (offset sc-name dstate)
- _N"If there's a valid mapping from OFFSET in the storage class SC-NAME to a
+ "If there's a valid mapping from OFFSET in the storage class SC-NAME to a
source variable, make a note of the source-variable name, to be printed as
an end-of-line comment after the current instruction is disassembled.
Returns non-NIL iff a note was recorded."
@@ -3782,7 +3782,7 @@
t)))
(defun maybe-note-associated-storage-ref (offset sb-name assoc-with dstate)
- _N"If there's a valid mapping from OFFSET in the storage-base called SB-NAME
+ "If there's a valid mapping from OFFSET in the storage-base called SB-NAME
to a source variable, make a note equating ASSOC-WITH with the
source-variable name, to be printed as an end-of-line comment after the
current instruction is disassembled. Returns non-NIL iff a note was
@@ -3819,7 +3819,7 @@
;;; ----------------------------------------------------------------
(defun handle-break-args (error-parse-fun stream dstate)
- _N"When called from an error break instruction's :DISASSEM-CONTROL (or
+ "When called from an error break instruction's :DISASSEM-CONTROL (or
:DISASSEM-PRINTER) function, will correctly deal with printing the
arguments to the break.
Index: src/compiler/eval.lisp
diff -u src/compiler/eval.lisp:1.37 src/compiler/eval.lisp:1.38
--- src/compiler/eval.lisp:1.37 Fri Mar 19 11:19:00 2010
+++ src/compiler/eval.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/eval.lisp,v 1.37 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/eval.lisp,v 1.38 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -129,12 +129,12 @@
;;;; Interpreted functions:
(defvar *interpreted-function-cache-minimum-size* 25
- _N"If the interpreted function cache has more functions than this come GC time,
+ "If the interpreted function cache has more functions than this come GC time,
then attempt to prune it according to
*INTERPRETED-FUNCTION-CACHE-THRESHOLD*.")
(defvar *interpreted-function-cache-threshold* 3
- _N"If an interpreted function goes uncalled for more than this many GCs, then
+ "If an interpreted function goes uncalled for more than this many GCs, then
it is eligible for flushing from the cache.")
(declaim (type c::index
@@ -279,7 +279,7 @@
;;; FLUSH-INTERPRETED-FUNCTION-CACHE -- Interface
;;;
(defun flush-interpreted-function-cache ()
- _N"Clear all entries in the eval function cache. This allows the internal
+ "Clear all entries in the eval function cache. This allows the internal
representation of the functions to be reclaimed, and also lazily forces
macroexpansions to be recomputed."
(dolist (fun *interpreted-function-cache*)
Index: src/compiler/float-tran.lisp
diff -u src/compiler/float-tran.lisp:1.137 src/compiler/float-tran.lisp:1.138
--- src/compiler/float-tran.lisp:1.137 Fri Mar 19 11:19:00 2010
+++ src/compiler/float-tran.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/float-tran.lisp,v 1.137 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/float-tran.lisp,v 1.138 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -1818,7 +1818,7 @@
(declaim (inline quick-two-sum))
(defun quick-two-sum (a b)
- _N"Computes fl(a+b) and err(a+b), assuming |a| >= |b|"
+ "Computes fl(a+b) and err(a+b), assuming |a| >= |b|"
(declare (double-float a b))
(let* ((s (+ a b))
(e (- b (- s a))))
@@ -1826,7 +1826,7 @@
(declaim (inline two-sum))
(defun two-sum (a b)
- _N"Computes fl(a+b) and err(a+b)"
+ "Computes fl(a+b) and err(a+b)"
(declare (double-float a b))
(let* ((s (+ a b))
(v (- s a))
@@ -1838,7 +1838,7 @@
(declaim (maybe-inline add-dd))
(defun add-dd (a0 a1 b0 b1)
- _N"Add the double-double A0,A1 to the double-double B0,B1"
+ "Add the double-double A0,A1 to the double-double B0,B1"
(declare (double-float a0 a1 b0 b1)
(optimize (speed 3)
(inhibit-warnings 3)))
@@ -1873,14 +1873,14 @@
(declaim (inline quick-two-diff))
(defun quick-two-diff (a b)
- _N"Compute fl(a-b) and err(a-b), assuming |a| >= |b|"
+ "Compute fl(a-b) and err(a-b), assuming |a| >= |b|"
(declare (double-float a b))
(let ((s (- a b)))
(values s (- (- a s) b))))
(declaim (inline two-diff))
(defun two-diff (a b)
- _N"Compute fl(a-b) and err(a-b)"
+ "Compute fl(a-b) and err(a-b)"
(declare (double-float a b))
(let* ((s (- a b))
(v (- s a))
@@ -1892,7 +1892,7 @@
(declaim (maybe-inline sub-dd))
(defun sub-dd (a0 a1 b0 b1)
- _N"Subtract the double-double B0,B1 from A0,A1"
+ "Subtract the double-double B0,B1 from A0,A1"
(declare (double-float a0 a1 b0 b1)
(optimize (speed 3)
(inhibit-warnings 3)))
@@ -1917,7 +1917,7 @@
(declaim (maybe-inline sub-d-dd))
(defun sub-d-dd (a b0 b1)
- _N"Compute double-double = double - double-double"
+ "Compute double-double = double - double-double"
(declare (double-float a b0 b1)
(optimize (speed 3) (safety 0)
(inhibit-warnings 3)))
@@ -1935,7 +1935,7 @@
(declaim (maybe-inline sub-dd-d))
(defun sub-dd-d (a0 a1 b)
- _N"Subtract the double B from the double-double A0,A1"
+ "Subtract the double B from the double-double A0,A1"
(declare (double-float a0 a1 b)
(optimize (speed 3) (safety 0)
(inhibit-warnings 3)))
@@ -1993,7 +1993,7 @@
;; printing algorithm, or even divide 1w308 by 10.
#+nil
(defun split (a)
- _N"Split the double-float number a into a-hi and a-lo such that a =
+ "Split the double-float number a into a-hi and a-lo such that a =
a-hi + a-lo and a-hi contains the upper 26 significant bits of a and
a-lo contains the lower 26 bits."
(declare (double-float a))
@@ -2012,7 +2012,7 @@
(scale-float (/ (float (1+ (expt 2 27)) 1d0)) 1024))
(defun split (a)
- _N"Split the double-float number a into a-hi and a-lo such that a =
+ "Split the double-float number a into a-hi and a-lo such that a =
a-hi + a-lo and a-hi contains the upper 26 significant bits of a and
a-lo contains the lower 26 bits."
(declare (double-float a)
@@ -2120,7 +2120,7 @@
(declaim (maybe-inline mul-dd))
(defun mul-dd (a0 a1 b0 b1)
- _N"Multiply the double-double A0,A1 with B0,B1"
+ "Multiply the double-double A0,A1 with B0,B1"
(declare (double-float a0 a1 b0 b1)
(optimize (speed 3)
(inhibit-warnings 3)))
@@ -2139,7 +2139,7 @@
(declaim (maybe-inline add-dd-d))
(defun add-dd-d (a0 a1 b)
- _N"Add the double-double A0,A1 to the double B"
+ "Add the double-double A0,A1 to the double B"
(declare (double-float a0 a1 b)
(optimize (speed 3)
(inhibit-warnings 3)))
@@ -2234,7 +2234,7 @@
(declaim (maybe-inline div-dd))
(defun div-dd (a0 a1 b0 b1)
- _N"Divide the double-double A0,A1 by B0,B1"
+ "Divide the double-double A0,A1 by B0,B1"
(declare (double-float a0 a1 b0 b1)
(optimize (speed 3)
(inhibit-warnings 3))
@@ -2300,7 +2300,7 @@
(declaim (inline sqr-d))
(defun sqr-d (a)
- _N"Square"
+ "Square"
(declare (double-float a)
(optimize (speed 3)
(inhibit-warnings 3)))
Index: src/compiler/globaldb.lisp
diff -u src/compiler/globaldb.lisp:1.54 src/compiler/globaldb.lisp:1.55
--- src/compiler/globaldb.lisp:1.54 Fri Mar 19 11:19:00 2010
+++ src/compiler/globaldb.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/globaldb.lisp,v 1.54 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/globaldb.lisp,v 1.55 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -152,7 +152,7 @@
;;; running compiler.
;;;
(defmacro define-info-class (class)
- _N"Define-Info-Class Class
+ "Define-Info-Class Class
Define a new class of global information."
`(progn
(eval-when (compile load eval)
@@ -187,7 +187,7 @@
;;; %DEFINE-INFO-TYPE must use the same type number.
;;;
(defmacro define-info-type (class type type-spec &optional default)
- _N"Define-Info-Type Class Type default Type-Spec
+ "Define-Info-Type Class Type default Type-Spec
Define a new type of global information for Class. Type is the symbol name
of the type, Default is the value for that type when it hasn't been set, and
Type-Spec is a type-specifier which values of the type must satisfy. The
@@ -317,7 +317,7 @@
;;; type is constant.
;;;
(defmacro info (class type name &optional env-list)
- _N"Return the information of the specified Type and Class for Name.
+ "Return the information of the specified Type and Class for Name.
The second value is true if there is any such information recorded. If
there is no information, the first value is the default and the second value
is NIL."
@@ -331,7 +331,7 @@
,@(when env-list `(,env-list))))))
;;;
(define-setf-expander info (class type name &optional env-list)
- _N"Set the global information for Name."
+ "Set the global information for Name."
(let* ((n-name (gensym))
(n-env-list (if env-list (gensym)))
(n-value (gensym))
@@ -355,7 +355,7 @@
(defmacro do-info ((env &key (name (gensym)) (class (gensym)) (type (gensym))
(type-number (gensym)) (value (gensym)) known-volatile)
&body body)
- _N"DO-INFO (Env &Key Name Class Type Value) Form*
+ "DO-INFO (Env &Key Name Class Type Value) Form*
Iterate over all the values stored in the Info-Env Env. Name is bound to
the entry's name, Class and Type are bound to the class and type
(represented as strings), and Value is bound to the entry's value."
@@ -649,7 +649,7 @@
;;; randomizing with the original hash function.
;;;
(defun compact-info-environment (env &key (name (info-env-name env)))
- _N"Return a new compact info environment that holds the same information as
+ "Return a new compact info environment that holds the same information as
Env."
(let ((name-count 0)
(prev-name 0)
@@ -889,7 +889,7 @@
;;; CLEAR-INFO -- Public
;;;
(defmacro clear-info (class type name)
- _N"Clear the information of the specified Type and Class for Name in the
+ "Clear the information of the specified Type and Class for Name in the
current environment, allowing any inherited info to become visible. We
return true if there was any info."
(let* ((class (symbol-name class))
Index: src/compiler/ir1opt.lisp
diff -u src/compiler/ir1opt.lisp:1.88 src/compiler/ir1opt.lisp:1.89
--- src/compiler/ir1opt.lisp:1.88 Fri Mar 19 11:19:00 2010
+++ src/compiler/ir1opt.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/ir1opt.lisp,v 1.88 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/ir1opt.lisp,v 1.89 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -1116,7 +1116,7 @@
;;; Just throw the severity and args...
;;;
(defun give-up (&rest args)
- _N"This function is used to throw out of an IR1 transform, aborting this
+ "This function is used to throw out of an IR1 transform, aborting this
attempt to transform the call, but admitting the possibility that this or
some other transform will later suceed. If arguments are supplied, they are
format arguments for an efficiency note."
@@ -1124,7 +1124,7 @@
(throw 'give-up (values :failure args)))
;;;
(defun abort-transform (&rest args)
- _N"This function is used to throw out of an IR1 transform and force a normal
+ "This function is used to throw out of an IR1 transform and force a normal
call to the function at run time. No further optimizations will be
attempted."
(throw 'give-up (values :aborted args)))
@@ -1134,7 +1134,7 @@
;;; delay-transform -- Interface
;;;
(defun delay-transform (node &rest reasons)
- _N"This function is used to throw out of an IR1 transform, and delay the
+ "This function is used to throw out of an IR1 transform, and delay the
transform on the node until later. The reasons specifies when the transform
will be later retried. The :optimize reason causes the transform to be
delayed until after the current IR1 optimization pass. The :constraint
Index: src/compiler/ir1tran.lisp
diff -u src/compiler/ir1tran.lisp:1.174 src/compiler/ir1tran.lisp:1.175
--- src/compiler/ir1tran.lisp:1.174 Fri Mar 19 11:19:00 2010
+++ src/compiler/ir1tran.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/ir1tran.lisp,v 1.174 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/ir1tran.lisp,v 1.175 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -118,7 +118,7 @@
(defvar *current-function-names* ())
(defvar *derive-function-types* t
- _N"If true, argument and result type information derived from compilation of
+ "If true, argument and result type information derived from compilation of
DEFUNs is used when compiling calls to that function. If false, only
information from FTYPE proclamations will be used.")
@@ -157,7 +157,7 @@
;;;; Dynamic-Extent
(defvar *trust-dynamic-extent-declarations* nil
- _N"If NIL, never trust dynamic-extent declarations.
+ "If NIL, never trust dynamic-extent declarations.
If T, always trust dynamic-extent declarations.
@@ -1333,7 +1333,7 @@
(undefined-value))
(defvar *suppress-values-declaration* nil
- _N"If true, processing of the VALUES declaration is inhibited.")
+ "If true, processing of the VALUES declaration is inhibited.")
;;; PROCESS-1-DECLARATION -- Internal
;;;
@@ -2320,13 +2320,13 @@
;;;; Control special forms:
(def-ir1-translator progn ((&rest forms) start cont)
- _N"Progn Form*
+ "Progn Form*
Evaluates each Form in order, returing the values of the last form. With no
forms, returns NIL."
(ir1-convert-progn-body start cont forms))
(def-ir1-translator if ((test then &optional else) start cont)
- _N"If Predicate Then [Else]
+ "If Predicate Then [Else]
If Predicate evaluates to non-null, evaluate Then and returns its values,
otherwise evaluate Else and return its values. Else defaults to NIL."
(let* ((pred (make-continuation))
@@ -2366,7 +2366,7 @@
;;; done later, the block would be in the wrong environment.
;;;
(def-ir1-translator block ((name &rest forms) start cont)
- _N"Block Name Form*
+ "Block Name Form*
Evaluate the Forms as a PROGN. Within the lexical scope of the body,
(RETURN-FROM Name Value-Form) can be used to exit the form, returning the
result of Value-Form."
@@ -2393,7 +2393,7 @@
;;;
(def-ir1-translator return-from ((name &optional value)
start cont)
- _N"Return-From Block-Name Value-Form
+ "Return-From Block-Name Value-Form
Evaluate the Value-Form, returning its values from the lexically enclosing
BLOCK Block-Name. This is constrained to be used only within the dynamic
extent of the BLOCK."
@@ -2446,7 +2446,7 @@
;;; each segment with the precomputed Start and Cont values.
;;;
(def-ir1-translator tagbody ((&rest statements) start cont)
- _N"Tagbody {Tag | Statement}*
+ "Tagbody {Tag | Statement}*
Define tags for used with GO. The Statements are evaluated in order
(skipping Tags) and NIL is returned. If a statement contains a GO to a
defined Tag within the lexical scope of the form, then control is transferred
@@ -2488,7 +2488,7 @@
;;; Emit an Exit node without any value.
;;;
(def-ir1-translator go ((tag) start cont)
- _N"Go Tag
+ "Go Tag
Transfer control to the named Tag in the lexically enclosing TAGBODY. This
is constrained to be used only within the dynamic extent of the TAGBODY."
(continuation-starts-block cont)
@@ -2555,7 +2555,7 @@
(funcall fun '(nil)))))
(def-ir1-translator eval-when ((situations &rest body) start cont)
- _N"EVAL-WHEN (Situation*) Form*
+ "EVAL-WHEN (Situation*) Form*
Evaluate the Forms in the specified Situations, any of :COMPILE-TOPLEVEL,
:LOAD-TOPLEVEL, :EXECUTE."
(do-eval-when-stuff situations body
@@ -2628,7 +2628,7 @@
(def-ir1-translator macrolet ((definitions &parse-body (body decls)) start cont)
- _N"MACROLET ({(Name Lambda-List Form*)}*) Body-Form*
+ "MACROLET ({(Name Lambda-List Form*)}*) Body-Form*
Evaluate the Body-Forms in an environment with the specified local macros
defined. Name is the local macro name, Lambda-List is the DEFMACRO style
destructuring lambda list, and the Forms evaluate to the expansion."
@@ -2642,7 +2642,7 @@
;;; COMPILER-OPTION-BIND
;;;
(def-ir1-translator compiler-option-bind ((bindings &body body) start cont)
- _N"Compiler-Option-Bind ({(Name Value-Form)}*) Body-Form*
+ "Compiler-Option-Bind ({(Name Value-Form)}*) Body-Form*
Establish the specified compiler options for the (lexical) duration of
the body. The Value-Forms are evaluated at compile time."
(let ((*lexical-environment*
@@ -2739,13 +2739,13 @@
;;;; Quote and Function:
(def-ir1-translator quote ((thing) start cont)
- _N"QUOTE Value
+ "QUOTE Value
Return Value without evaluating it."
(reference-constant start cont thing))
(def-ir1-translator function ((thing) start cont)
- _N"FUNCTION Name
+ "FUNCTION Name
Return the lexically apparent definition of the function Name. Name may also
be a lambda."
(flet ((reference-it ()
@@ -2816,7 +2816,7 @@
(def-ir1-translator symbol-macrolet ((specs &parse-body (body decls))
start cont)
- _N"SYMBOL-MACROLET ({(Name Expansion)}*) Decl* Form*
+ "SYMBOL-MACROLET ({(Name Expansion)}*) Decl* Form*
Define the Names as symbol macros with the given Expansions. Within the
body, references to a Name will effectively be replaced with the Expansion."
(collect ((res))
@@ -3106,7 +3106,7 @@
(def-ir1-translator let ((bindings &parse-body (body decls))
start cont)
- _N"LET ({(Var [Value]) | Var}*) Declaration* Form*
+ "LET ({(Var [Value]) | Var}*) Declaration* Form*
During evaluation of the Forms, Bind the Vars to the result of evaluating the
Value forms. The variables are bound in parallel after all of the Values are
evaluated."
@@ -3126,7 +3126,7 @@
(def-ir1-translator locally ((&parse-body (body decls))
start cont)
- _N"LOCALLY Declaration* Form*
+ "LOCALLY Declaration* Form*
Sequentially evaluates a body of Form's in a lexical environment
where the given Declaration's have effect."
(let* ((*lexical-environment* (process-declarations decls nil nil cont)))
@@ -3134,7 +3134,7 @@
(def-ir1-translator let* ((bindings &parse-body (body decls))
start cont)
- _N"LET* ({(Var [Value]) | Var}*) Declaration* Form*
+ "LET* ({(Var [Value]) | Var}*) Declaration* Form*
Similar to LET, but the variables are bound sequentially, allowing each Value
form to reference any of the previous Vars."
(multiple-value-bind (vars values)
@@ -3187,7 +3187,7 @@
(def-ir1-translator flet ((definitions &parse-body (body decls))
start cont)
- _N"FLET ({(Name Lambda-List Declaration* Form*)}*) Declaration* Body-Form*
+ "FLET ({(Name Lambda-List Declaration* Form*)}*) Declaration* Body-Form*
Evaluate the Body-Forms with some local function definitions. The bindings
do not enclose the definitions; any use of Name in the Forms will refer to
the lexically apparent function definition in the enclosing environment."
@@ -3214,7 +3214,7 @@
;;; used for inline expansion we will get the right functions.
;;;
(def-ir1-translator labels ((definitions &parse-body (body decls)) start cont)
- _N"LABELS ({(Name Lambda-List Declaration* Form*)}*) Declaration* Body-Form*
+ "LABELS ({(Name Lambda-List Declaration* Form*)}*) Declaration* Body-Form*
Evaluate the Body-Forms with some local function definitions. The bindings
enclose the new definitions, so the defined functions can call themselves or
each other."
@@ -3303,7 +3303,7 @@
;;; expected behavior.
;;;
(def-ir1-translator the ((type value) start cont)
- _N"THE Type Form
+ "THE Type Form
Assert that Form evaluates to the specified type (which may be a VALUES
type.)"
(let ((ctype (values-specifier-type type)))
@@ -3329,7 +3329,7 @@
;;; with the uses's Derived-Type.
;;;
(def-ir1-translator truly-the ((type value) start cont)
- _N"Truly-The Type Value
+ "Truly-The Type Value
Like the THE special form, except that it believes whatever you tell it. It
will never generate a type check, but will cause a warning if the compiler
can prove the assertion is wrong."
@@ -3349,7 +3349,7 @@
;;; out.
(def-ir1-translator setq ((&whole source &rest things) start cont)
- _N"SETQ {Var Value}*
+ "SETQ {Var Value}*
Set the variables to the values. If more than one pair is supplied, the
assignments are done sequentially. If Var names a symbol macro, SETF the
expansion."
@@ -3415,7 +3415,7 @@
;;; than receiving multiple-values.
;;;
(def-ir1-translator throw ((tag result) start cont)
- _N"Throw Tag Form
+ "Throw Tag Form
Do a non-local exit, return the values of Form from the CATCH whose tag
evaluates to the same thing as Tag."
(ir1-convert start cont
@@ -3480,7 +3480,7 @@
;;; using %within-cleanup.
;;;
(def-ir1-translator catch ((tag &body body) start cont)
- _N"Catch Tag Form*
+ "Catch Tag Form*
Evaluates Tag and instantiates it as a catcher while the body forms are
evaluated in an implicit PROGN. If a THROW is done to Tag within the dynamic
scope of the body, then control will be transferred to the end of the body
@@ -3504,7 +3504,7 @@
;;; doesn't cause creation of an XEP.
;;;
(def-ir1-translator unwind-protect ((protected &body cleanup) start cont)
- _N"Unwind-Protect Protected Cleanup*
+ "Unwind-Protect Protected Cleanup*
Evaluate the form Protected, returning its values. The cleanup forms are
evaluated whenever the dynamic scope of the Protected form is exited (either
due to normal completion or a non-local exit such as THROW)."
@@ -3540,7 +3540,7 @@
;;; compilation of MV-Combinations.
;;;
(def-ir1-translator multiple-value-call ((fun &rest args) start cont)
- _N"MULTIPLE-VALUE-CALL Function Values-Form*
+ "MULTIPLE-VALUE-CALL Function Values-Form*
Call Function, passing all the values of each Values-Form as arguments,
values from the first Values-Form making up the first argument, etc."
(let* ((fun-cont (make-continuation))
@@ -3595,7 +3595,7 @@
;;; whose block is the true control destination.
;;;
(def-ir1-translator multiple-value-prog1 ((result &rest forms) start cont)
- _N"MULTIPLE-VALUE-PROG1 Values-Form Form*
+ "MULTIPLE-VALUE-PROG1 Values-Form Form*
Evaluate Values-Form and then the Forms, but return all the values of
Values-Form."
(continuation-starts-block cont)
Index: src/compiler/ir1util.lisp
diff -u src/compiler/ir1util.lisp:1.111 src/compiler/ir1util.lisp:1.112
--- src/compiler/ir1util.lisp:1.111 Fri Mar 19 11:19:00 2010
+++ src/compiler/ir1util.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/ir1util.lisp,v 1.111 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/ir1util.lisp,v 1.112 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -447,17 +447,17 @@
form)
(defun encode-form-numbers (tlf-number form-number)
- _N"Return the TLF-NUMBER and FORM-NUMBER encoded as fixnum."
+ "Return the TLF-NUMBER and FORM-NUMBER encoded as fixnum."
(declare (type (unsigned-byte 14) tlf-number form-number))
(logior tlf-number (ash form-number 14)))
(defun decode-form-numbers (fixnum)
- _N"Return the tlf-number and form-number from an encoded FIXNUM."
+ "Return the tlf-number and form-number from an encoded FIXNUM."
(values (ldb (byte 14 0) fixnum)
(ldb (byte 14 14) fixnum)))
(defun source-location ()
- _N"Return a source-location for the call site."
+ "Return a source-location for the call site."
nil)
(define-compiler-macro source-location ()
@@ -1404,7 +1404,7 @@
;;; with the correct number of arguments.
;;;
(defun extract-function-args (cont fun num-args)
- _N"If CONT is a call to FUN with NUM-ARGS args, change those arguments
+ "If CONT is a call to FUN with NUM-ARGS args, change those arguments
to feed directly to the continuation-dest of CONT, which must be
a combination."
(declare (type continuation cont)
@@ -1618,7 +1618,7 @@
(defvar *inline-expansion-limit* 400
- _N"An upper limit on the number of inline function calls that will be expanded
+ "An upper limit on the number of inline function calls that will be expanded
in any given code object (single function or block compilation.)")
@@ -1654,14 +1654,14 @@
*error-print-length* *error-print-lines*))
(defvar *error-print-level* 3
- _N"The value for *Print-Level* when printing compiler error messages.")
+ "The value for *Print-Level* when printing compiler error messages.")
(defvar *error-print-length* 5
- _N"The value for *Print-Length* when printing compiler error messages.")
+ "The value for *Print-Length* when printing compiler error messages.")
(defvar *error-print-lines* 5
- _N"The value for *Print-Lines* when printing compiler error messages.")
+ "The value for *Print-Lines* when printing compiler error messages.")
(defvar *enclosing-source-cutoff* 1
- _N"The maximum number of enclosing non-original source forms (i.e. from
+ "The maximum number of enclosing non-original source forms (i.e. from
macroexpansion) that we print in full. For additional enclosing forms, we
print only the CAR.")
(declaim (type unsigned-byte *enclosing-source-cutoff*))
@@ -1722,7 +1722,7 @@
;;; DEF-SOURCE-CONTEXT -- Public
;;;
(defmacro def-source-context (name ll &body body)
- _N"DEF-SOURCE-CONTEXT Name Lambda-List Form*
+ "DEF-SOURCE-CONTEXT Name Lambda-List Form*
This macro defines how to extract an abbreviated source context from the
Named form when it appears in the compiler input. Lambda-List is a DEFMACRO
style lambda-list used to parse the arguments. The Body should return a
@@ -1908,7 +1908,7 @@
(declaim (type index *last-message-count*))
(defvar *compiler-notification-function* nil
- _N"This is the function called by the compiler to specially note a
+ "This is the function called by the compiler to specially note a
warning, comment, or error. The function must take five arguments: the
severity, a string describing the nature of the notification, a string
for context, the file namestring, and the file position. The severity
@@ -2200,7 +2200,7 @@
(defvar *undefined-warning-limit* 3
- _N"If non-null, then an upper limit on the number of unknown function or type
+ "If non-null, then an upper limit on the number of unknown function or type
warnings that the compiler will print for any given name in a single
compilation. This prevents excessive amounts of output when there really is
a missing definition (as opposed to a typo in the use.)")
Index: src/compiler/ltn.lisp
diff -u src/compiler/ltn.lisp:1.44 src/compiler/ltn.lisp:1.45
--- src/compiler/ltn.lisp:1.44 Fri Mar 19 11:19:00 2010
+++ src/compiler/ltn.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/ltn.lisp,v 1.44 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/ltn.lisp,v 1.45 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -794,12 +794,12 @@
(defvar *efficiency-note-limit* 2
- _N"This is the maximum number of possible optimization alternatives will be
+ "This is the maximum number of possible optimization alternatives will be
mentioned in a particular efficiency note. NIL means no limit.")
(declaim (type (or index null) *efficiency-note-limit*))
(defvar *efficiency-note-cost-threshold* 5
- _N"This is the minumum cost difference between the chosen implementation and
+ "This is the minumum cost difference between the chosen implementation and
the next alternative that justifies an efficiency note.")
(declaim (type index *efficiency-note-cost-threshold*))
Index: src/compiler/ltv.lisp
diff -u src/compiler/ltv.lisp:1.3 src/compiler/ltv.lisp:1.4
--- src/compiler/ltv.lisp:1.3 Fri Mar 19 11:19:00 2010
+++ src/compiler/ltv.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/ltv.lisp,v 1.3 2010-03-19 15:19:00 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/ltv.lisp,v 1.4 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -25,7 +25,7 @@
(defknown %load-time-value (t) t (flushable movable))
(def-ir1-translator load-time-value ((form &optional read-only-p) start cont)
- _N"Arrange for FORM to be evaluated at load-time and use the value produced
+ "Arrange for FORM to be evaluated at load-time and use the value produced
as if it were a constant. If READ-ONLY-P is non-NIL, then the resultant
object is guaranteed to never be modified, so it can be put in read-only
storage."
Index: src/compiler/macros.lisp
diff -u src/compiler/macros.lisp:1.57 src/compiler/macros.lisp:1.58
--- src/compiler/macros.lisp:1.57 Fri Mar 19 11:19:01 2010
+++ src/compiler/macros.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/macros.lisp,v 1.57 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/macros.lisp,v 1.58 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -75,7 +75,7 @@
;;; the compiler policy parameters.
;;;
(defmacro policy (node &rest conditions)
- _N"Policy Node Condition*
+ "Policy Node Condition*
Test whether some conditions apply to the current compiler policy for Node.
Each condition is a predicate form which accesses the policy values by
referring to them as the variables SPEED, SPACE, SAFETY, CSPEED, BREVITY and
@@ -151,7 +151,7 @@
(defmacro def-ir1-translator (name (lambda-list start-var cont-var
&key (kind :special-form))
&body body)
- _N"Def-IR1-Translator Name (Lambda-List Start-Var Cont-Var {Key Value}*)
+ "Def-IR1-Translator Name (Lambda-List Start-Var Cont-Var {Key Value}*)
[Doc-String] Form*
Define a function that converts a Special-Form or other magical thing into
IR1. Lambda-List is a defmacro style lambda list. Start-Var and Cont-Var
@@ -168,6 +168,8 @@
:doc-string-allowed t
:environment n-env
:error-fun 'convert-condition-into-compiler-error)
+ (when doc
+ (intl::note-translatable intl::*default-domain* doc))
`(progn
(declaim (function ,fn-name (continuation continuation t) void))
(defun ,fn-name (,start-var ,cont-var ,n-form)
@@ -198,7 +200,7 @@
;;; invalid.
;;;
(defmacro def-source-transform (name lambda-list &body body)
- _N"Def-Source-Transform Name Lambda-List Form*
+ "Def-Source-Transform Name Lambda-List Form*
Define a macro-like source-to-source transformation for the function Name.
A source transform may \"pass\" by returning a non-nil second value. If the
transform passes, then the form is converted as a normal function call. If
@@ -239,7 +241,7 @@
(defmacro def-primitive-translator (name lambda-list &body body)
- _N"Def-Primitive-Translator Name Lambda-List Form*
+ "Def-Primitive-Translator Name Lambda-List Form*
Define a function that converts a use of (%PRIMITIVE Name ...) into Lisp
code. Lambda-List is a defmacro style lambda list."
(let ((fn-name (symbolicate "PRIMITIVE-TRANSLATE-" name))
@@ -353,7 +355,7 @@
&key result policy node defun-only
eval-name important (when :native))
&parse-body (body decls doc))
- _N"Deftransform Name (Lambda-List [Arg-Types] [Result-Type] {Key Value}*)
+ "Deftransform Name (Lambda-List [Arg-Types] [Result-Type] {Key Value}*)
Declaration* [Doc-String] Form*
Define an IR1 transformation for Name. An IR1 transformation computes a
lambda that replaces the function variable reference for the call. A
@@ -461,7 +463,7 @@
;;;
(defmacro defknown (name arg-types result-type &optional (attributes '(any))
&rest keys)
- _N"Defknown Name Arg-Types Result-Type [Attributes] {Key Value}*
+ "Defknown Name Arg-Types Result-Type [Attributes] {Key Value}*
Declare the function Name to be a known function. We construct a type
specifier for the function by wrapping (FUNCTION ...) around the Arg-Types
and Result-Type. Attributes is a an unevaluated list of the boolean
@@ -527,7 +529,7 @@
(defmacro defoptimizer (what (lambda-list &optional (n-node (gensym))
&rest vars)
&body body)
- _N"Defoptimizer (Function Kind) (Lambda-List [Node-Var] Var*)
+ "Defoptimizer (Function Kind) (Lambda-List [Node-Var] Var*)
Declaration* Form*
Define some Kind of optimizer for the named Function. Function must be a
known function. Lambda-List is used to parse the arguments to the
@@ -566,7 +568,7 @@
;;; Do-Blocks, Do-Blocks-Backwards -- Interface
;;;
(defmacro do-blocks ((block-var component &optional ends result) &body body)
- _N"Do-Blocks (Block-Var Component [Ends] [Result-Form]) {Declaration}* {Form}*
+ "Do-Blocks (Block-Var Component [Ends] [Result-Form]) {Declaration}* {Form}*
Iterate over the blocks in a component, binding Block-Var to each block in
turn. The value of Ends determines whether to iterate over dummy head and
tail blocks:
@@ -592,7 +594,7 @@
, at body))))
;;;
(defmacro do-blocks-backwards ((block-var component &optional ends result) &body body)
- _N"Do-Blocks-Backwards (Block-Var Component [Ends] [Result-Form]) {Declaration}* {Form}*
+ "Do-Blocks-Backwards (Block-Var Component [Ends] [Result-Form]) {Declaration}* {Form}*
Like Do-Blocks, only iterate over the blocks in reverse order."
(unless (member ends '(nil :head :tail :both))
(error _"Losing Ends value: ~S." ends))
@@ -615,7 +617,7 @@
;;; Could change it not to replicate the code someday perhaps...
;;;
(defmacro do-uses ((node-var continuation &optional result) &body body)
- _N"Do-Uses (Node-Var Continuation [Result]) {Declaration}* {Form}*
+ "Do-Uses (Node-Var Continuation [Result]) {Declaration}* {Form}*
Iterate over the uses of Continuation, binding Node to each one succesively."
(once-only ((n-cont continuation))
`(ecase (continuation-kind ,n-cont)
@@ -648,7 +650,7 @@
;;; BLOCK-LAST each time.
;;;
(defmacro do-nodes ((node-var cont-var block &key restart-p) &body body)
- _N"Do-Nodes (Node-Var Cont-Var Block {Key Value}*) {Declaration}* {Form}*
+ "Do-Nodes (Node-Var Cont-Var Block {Key Value}*) {Declaration}* {Form}*
Iterate over the nodes in Block, binding Node-Var to the each node and
Cont-Var to the node's Cont. The only keyword option is Restart-P, which
causes iteration to be restarted when a node is deleted out from under us (if
@@ -680,7 +682,7 @@
(return nil))))))
;;;
(defmacro do-nodes-backwards ((node-var cont-var block) &body body)
- _N"Do-Nodes-Backwards (Node-Var Cont-Var Block) {Declaration}* {Form}*
+ "Do-Nodes-Backwards (Node-Var Cont-Var Block) {Declaration}* {Form}*
Like Do-Nodes, only iterates in reverse order."
(let ((n-block (gensym))
(n-start (gensym))
@@ -704,7 +706,7 @@
;;; The lexical environment is presumably already null...
;;;
(defmacro with-ir1-environment (node &rest forms)
- _N"With-IR1-Environment Node Form*
+ "With-IR1-Environment Node Form*
Bind the IR1 context variables so that IR1 conversion can be done after the
main conversion pass has finished."
(let ((n-node (gensym)))
@@ -735,7 +737,7 @@
;;; LEXENV-FIND -- Interface
;;;
(defmacro lexenv-find (name slot &key test)
- _N"LEXENV-FIND Name Slot {Key Value}*
+ "LEXENV-FIND Name Slot {Key Value}*
Look up Name in the lexical environment namespace designated by Slot,
returning the <value, T>, or <NIL, NIL> if no entry. The :TEST keyword
may be used to determine the name equality predicate."
@@ -782,7 +784,7 @@
;;;; The Defprinter macro:
(defvar *defprint-pretty* nil
- _N"If true, defprinter print functions print each slot on a separate line.")
+ "If true, defprinter print functions print each slot on a separate line.")
;;; Defprinter-Prin1, Defprinter-Princ -- Internal
@@ -809,7 +811,7 @@
(princ value stream))
(defmacro defprinter (name &rest slots)
- _N"Defprinter Name Slot-Desc*
+ "Defprinter Name Slot-Desc*
Define some kind of reasonable defstruct structure-print function. Name
is the name of the structure. We define a function %PRINT-name which
prints the slots in the structure in the way described by the Slot-Descs.
@@ -916,7 +918,7 @@
;;; Parse the specification and generate some accessor macros.
;;;
(defmacro def-boolean-attribute (name &rest attribute-names)
- _N"Def-Boolean-Attribute Name Attribute-Name*
+ "Def-Boolean-Attribute Name Attribute-Name*
Define a new class of boolean attributes, with the attributes havin the
specified Attribute-Names. Name is the name of the class, which is used to
generate some macros to manipulate sets of the attributes:
@@ -979,13 +981,13 @@
;;; And now for some gratuitous pseudo-abstraction...
;;;
(defmacro attributes-union (&rest attributes)
- _N"Returns the union of all the sets of boolean attributes which are its
+ "Returns the union of all the sets of boolean attributes which are its
arguments."
`(the attributes
(logior ,@(mapcar #'(lambda (x) `(the attributes ,x)) attributes))))
;;;
(defmacro attributes-intersection (&rest attributes)
- _N"Returns the intersection of all the sets of boolean attributes which are its
+ "Returns the intersection of all the sets of boolean attributes which are its
arguments."
`(the attributes
(logand ,@(mapcar #'(lambda (x) `(the attributes ,x)) attributes))))
@@ -993,7 +995,7 @@
(declaim (inline attributes=))
(defun attributes= (attr1 attr2)
(declare (type attributes attr1 attr2))
- _N"Returns true if the attributes present in Attr1 are indentical to those in
+ "Returns true if the attributes present in Attr1 are indentical to those in
Attr2."
(eql attr1 attr2))
@@ -1045,12 +1047,12 @@
;;; Event-Count, Event-Action, Event-Level -- Interface
;;;
(defun event-count (name)
- _N"Return the number of times that Event has happened."
+ "Return the number of times that Event has happened."
(declare (symbol name) (values fixnum))
(event-info-count (event-info-or-lose name)))
;;;
(defun event-action (name)
- _N"Return the function that is called when Event happens. If this is null,
+ "Return the function that is called when Event happens. If this is null,
there is no action. The function is passed the node to which the event
happened, or NIL if there is no relevant node. This may be set with SETF."
(declare (symbol name) (values (or function null)))
@@ -1065,7 +1067,7 @@
(defsetf event-action %set-event-action)
;;;
(defun event-level (name)
- _N"Return the non-negative integer which represents the level of significance
+ "Return the non-negative integer which represents the level of significance
of the event Name. This is used to determine whether to print a message when
the event happens. This may be set with SETF."
(declare (symbol name) (values unsigned-byte))
@@ -1086,7 +1088,7 @@
;;; it quickly.
;;;
(defmacro defevent (name description &optional (level 0))
- _N"Defevent Name Description
+ "Defevent Name Description
Define a new kind of event. Name is a symbol which names the event and
Description is a string which describes the event. Level (default 0) is the
level of significance associated with this event; it is used to determine
@@ -1101,7 +1103,7 @@
(declaim (type unsigned-byte *event-note-threshold*))
(defvar *event-note-threshold* 1
- _N"This variable is a non-negative integer specifying the lowest level of
+ "This variable is a non-negative integer specifying the lowest level of
event that will print a Note when it occurs.")
;;; Event -- Interface
@@ -1110,7 +1112,7 @@
;;; policy indicates.
;;;
(defmacro event (name &optional node)
- _N"Event Name Node
+ "Event Name Node
Note that the event with the specified Name has happened. Node is evaluated
to determine the node to which the event happened."
`(%event ,(event-info-var (event-info-or-lose name)) ,node))
@@ -1120,7 +1122,7 @@
;;;
(defun event-statistics (&optional (min-count 1) (stream *standard-output*))
(declare (type unsigned-byte min-count) (stream stream) (values))
- _N"Print a listing of events and their counts, sorted by the count. Events
+ "Print a listing of events and their counts, sorted by the count. Events
that happened fewer than Min-Count times will not be printed. Stream is the
stream to write to."
(collect ((info))
@@ -1151,7 +1153,7 @@
;;;
(defun find-in (next element list &key (key #'identity)
(test #'eql test-p) (test-not nil not-p))
- _N"Find Element in a null-terminated List linked by the accessor function
+ "Find Element in a null-terminated List linked by the accessor function
Next. Key, Test and Test-Not are the same as for generic sequence
functions."
(when (and test-p not-p)
@@ -1170,7 +1172,7 @@
;;;
(defun position-in (next element list &key (key #'identity)
(test #'eql test-p) (test-not nil not-p))
- _N"Return the position of Element (or NIL if absent) in a null-terminated List
+ "Return the position of Element (or NIL if absent) in a null-terminated List
linked by the accessor function Next. Key, Test and Test-Not are the same as
for generic sequence functions."
(when (and test-p not-p)
@@ -1191,7 +1193,7 @@
;;; Map-In -- Interface
;;;
(defun map-in (next function list)
- _N"Map Function over the elements in a null-terminated List linked by the
+ "Map Function over the elements in a null-terminated List linked by the
accessor function Next, returning a list of the results."
(collect ((res))
(do ((current list (funcall next current)))
@@ -1203,7 +1205,7 @@
;;; Deletef-In -- Interface
;;;
(defmacro deletef-in (next place item &environment env)
- _N"Deletef-In Next Place Item
+ "Deletef-In Next Place Item
Delete Item from a null-terminated list linked by the accessor function Next
that is stored in Place. Item must appear exactly once in the list."
(multiple-value-bind
@@ -1231,7 +1233,7 @@
;;; Push-In -- Interface
;;;
(defmacro push-in (next item place &environment env)
- _N"Push Item onto a list linked by the accessor function Next that is stored in
+ "Push Item onto a list linked by the accessor function Next that is stored in
Place."
(multiple-value-bind
(temps vals stores store access)
Index: src/compiler/main.lisp
diff -u src/compiler/main.lisp:1.154 src/compiler/main.lisp:1.155
--- src/compiler/main.lisp:1.154 Sat Apr 3 14:40:48 2010
+++ src/compiler/main.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/main.lisp,v 1.154 2010-04-03 18:40:48 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/main.lisp,v 1.155 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -44,22 +44,22 @@
;;; Exported:
(defvar *block-compile-default* :specified
- _N"The default value for the :Block-Compile argument to COMPILE-FILE.")
+ "The default value for the :Block-Compile argument to COMPILE-FILE.")
(declaim (type (member t nil :specified) *block-compile-default*))
;;; Exported:
(defvar *byte-compile-default* :maybe
- _N"The default value for the :Byte-Compile argument to COMPILE-FILE.")
+ "The default value for the :Byte-Compile argument to COMPILE-FILE.")
;;; Exported:
(defvar *byte-compile-top-level* t
- _N"Similar to *BYTE-COMPILE-DEFAULT*, but controls the compilation of top-level
+ "Similar to *BYTE-COMPILE-DEFAULT*, but controls the compilation of top-level
forms (evaluated at load-time) when the :BYTE-COMPILE argument is :MAYBE
(the default.) When true, we decide to byte-compile.")
;;; Exported:
(defvar *loop-analyze* nil
- _N"Whether loop analysis should be done or not.")
+ "Whether loop analysis should be done or not.")
;;; Value of the :byte-compile argument to the compiler.
(defvar *byte-compile* :maybe)
@@ -82,7 +82,7 @@
(defvar *check-consistency* nil)
(defvar *record-xref-info* nil
- _N"Whether the compiler should record cross-reference information.")
+ "Whether the compiler should record cross-reference information.")
(defvar *all-components*)
@@ -109,17 +109,17 @@
(declaim (list *top-level-lambdas*))
(defvar *compile-verbose* t
- _N"The default for the :VERBOSE argument to COMPILE-FILE.")
+ "The default for the :VERBOSE argument to COMPILE-FILE.")
(defvar *compile-print* t
- _N"The default for the :PRINT argument to COMPILE-FILE.")
+ "The default for the :PRINT argument to COMPILE-FILE.")
(defvar *compile-progress* nil
- _N"The default for the :PROGRESS argument to COMPILE-FILE.")
+ "The default for the :PROGRESS argument to COMPILE-FILE.")
(defvar *compile-file-pathname* nil
- _N"The defaulted pathname of the file currently being compiled, or NIL if not
+ "The defaulted pathname of the file currently being compiled, or NIL if not
compiling.")
(defvar *compile-file-truename* nil
- _N"The TRUENAME of the file currently being compiled, or NIL if not
+ "The TRUENAME of the file currently being compiled, or NIL if not
compiling.")
(declaim (type (or pathname null) *compile-file-pathname*
@@ -138,7 +138,7 @@
(defvar *source-info* nil)
(defvar *user-source-info* nil
- _N"The user supplied source-info for the current compilation.
+ "The user supplied source-info for the current compilation.
This is the :source-info argument to COMPILE-FROM-STREAM and will be
stored in the INFO slot of the DEBUG-SOURCE in code components and
in the user USER-INFO slot of STREAM-SOURCE-LOCATIONs.")
@@ -162,7 +162,7 @@
;;;; Component compilation:
(defparameter max-optimize-iterations 6
- _N"The upper limit on the number of times that we will consecutively do IR1
+ "The upper limit on the number of times that we will consecutively do IR1
optimization that doesn't introduce any new code. A finite limit is
necessary, since type inference may take arbitrarily long to converge.")
@@ -217,7 +217,7 @@
(defparameter *reoptimize-after-type-check-max* 10)
(defevent reoptimize-maxed-out
- _N"*REOPTIMIZE-AFTER-TYPE-CHECK-MAX* exceeded.")
+ "*REOPTIMIZE-AFTER-TYPE-CHECK-MAX* exceeded.")
;;; DFO-AS-NEEDED -- Internal
@@ -1663,7 +1663,7 @@
((:byte-compile *byte-compile*) *byte-compile-default*)
source-info
(language :lisp))
- _N"Similar to COMPILE-FILE, but compiles text from Stream into the current lisp
+ "Similar to COMPILE-FILE, but compiles text from Stream into the current lisp
environment. Stream is closed when compilation is complete. These keywords
are supported:
@@ -1753,7 +1753,7 @@
*byte-compile-default*)
((:xref *record-xref-info*)
*record-xref-info*))
- _N"Compiles Source, producing a corresponding .FASL file. Source may be a list
+ "Compiles Source, producing a corresponding .FASL file. Source may be a list
of files, in which case the files are compiled as a unit, producing a single
.FASL file. The output file names are defaulted from the first (or only)
input file name. Other options available via keywords:
@@ -1937,7 +1937,7 @@
;;;
(defun compile (name &optional (definition (or (macro-function name)
(fdefinition name))))
- _N"Compiles the function (or macro-function) whose name is NAME. If
+ "Compiles the function (or macro-function) whose name is NAME. If
DEFINITION is supplied, it should be a lambda expression which will
be compiled. IF NAME names a macro, then the compiled expression
replaces the existing macro-function. If NAME names a function, the
@@ -2036,7 +2036,7 @@
;;; UNCOMPILE -- Public
;;;
(defun uncompile (name)
- _N"Attempt to replace Name's definition with an interpreted version of that
+ "Attempt to replace Name's definition with an interpreted version of that
definition. If no interpreted definition is to be found, then signal an
error."
(let ((def (fdefinition name)))
@@ -2069,7 +2069,7 @@
(byte-compile *byte-compile-default*)
(output-file t output-file-supplied-p)
&allow-other-keys)
- _N"Return a pathname describing what file COMPILE-FILE would write to given
+ "Return a pathname describing what file COMPILE-FILE would write to given
these arguments."
(declare (type (or string pathname stream) input-file)
(type (or string pathname stream (member t)) output-file)
Index: src/compiler/meta-vmdef.lisp
diff -u src/compiler/meta-vmdef.lisp:1.10 src/compiler/meta-vmdef.lisp:1.11
--- src/compiler/meta-vmdef.lisp:1.10 Fri Mar 19 11:19:01 2010
+++ src/compiler/meta-vmdef.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/meta-vmdef.lisp,v 1.10 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/meta-vmdef.lisp,v 1.11 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -38,7 +38,7 @@
;;; missing slots at load time.
;;;
(defmacro define-storage-base (name kind &key size)
- _N"Define-Storage-Base Name Kind {Key Value}*
+ "Define-Storage-Base Name Kind {Key Value}*
Define a storage base having the specified Name. Kind may be :Finite,
:Unbounded or :Non-Packed. The following keywords are legal:
@@ -88,7 +88,7 @@
(defmacro define-storage-class (name number sb-name &key (element-size '1)
(alignment '1) locations reserve-locations
save-p alternate-scs constant-scs)
- _N"Define-Storage-Class Name Number Storage-Base {Key Value}*
+ "Define-Storage-Class Name Number Storage-Base {Key Value}*
Define a storage class Name that uses the named Storage-Base. Number is a
small, non-negative integer that is used as an alias. The following
keywords are defined:
@@ -215,7 +215,7 @@
;;; DEFINE-MOVE-FUNCTION -- Public
;;;
(defmacro define-move-function ((name cost) lambda-list scs &body body)
- _N"Define-Move-Function (Name Cost) lambda-list ({(From-SC*) (To-SC*)}*) form*
+ "Define-Move-Function (Name Cost) lambda-list ({(From-SC*) (To-SC*)}*) form*
Define the function Name and note it as the function used for moving operands
from the From-SCs to the To-SCs. Cost is the cost of this move operation.
The function is called with three arguments: the VOP (for context), and the
@@ -247,7 +247,7 @@
;;; (including implicit loading).
;;;
(defmacro define-move-vop (name kind &rest scs)
- _N"Define-Move-VOP Name {:Move | :Move-Argument} {(From-SC*) (To-SC*)}*
+ "Define-Move-VOP Name {:Move | :Move-Argument} {(From-SC*) (To-SC*)}*
Make Name be the VOP used to move values in the specified From-SCs to the
representation of the To-SCs. If kind is :Move-Argument, then the VOP takes
an extra argument, which is the frame pointer of the frame to move into."
@@ -294,7 +294,7 @@
;;; break the running compiler.
;;;
(defmacro def-primitive-type (name scs &key (type name))
- _N"Def-Primitive-Type Name (SC*) {Key Value}*
+ "Def-Primitive-Type Name (SC*) {Key Value}*
Define a primitive type Name. Each SC specifies a Storage Class that values
of this type may be allocated in. The following keyword options are
defined:
@@ -333,7 +333,7 @@
;;; Just record the translation.
;;;
(defmacro def-primitive-type-alias (name result)
- _N"DEF-PRIMITIVE-TYPE-ALIAS Name Result
+ "DEF-PRIMITIVE-TYPE-ALIAS Name Result
Define name to be an alias for Result in VOP operand type restrictions."
`(eval-when (compile load eval)
(setf (gethash ',name (backend-primitive-type-aliases *target-backend*))
@@ -346,7 +346,7 @@
;;; Primitive-Type-Vop -- Public
;;;
(defmacro primitive-type-vop (vop kinds &rest types)
- _N"Primitive-Type-VOP Vop (Kind*) Type*
+ "Primitive-Type-VOP Vop (Kind*) Type*
Annotate all the specified primitive Types with the named VOP under each of
the specified kinds:
@@ -1626,7 +1626,7 @@
;;; inheritance by copying the VOP-Parse structure for the inherited structure.
;;;
(defmacro define-vop ((name &optional inherits) &rest specs)
- _N"Define-VOP (Name [Inherits]) Spec*
+ "Define-VOP (Name [Inherits]) Spec*
Define the symbol Name to be a Virtual OPeration in the compiler. If
specified, Inherits is the name of a VOP that we default unspecified
information from. Each Spec is a list beginning with a keyword indicating
@@ -1842,7 +1842,7 @@
;;; Emit-Template -- Interface
;;;
(defmacro emit-template (node block template args results &optional info)
- _N"Emit-Template Node Block Template Args Results [Info]
+ "Emit-Template Node Block Template Args Results [Info]
Call the emit function for Template, linking the result in at the end of
Block."
(let ((n-first (gensym))
@@ -1861,7 +1861,7 @@
;;; VOP -- Interface
;;;
(defmacro vop (name node block &rest operands)
- _N"VOP Name Node Block Arg* Info* Result*
+ "VOP Name Node Block Arg* Info* Result*
Emit the VOP (or other template) Name at the end of the IR2-Block Block,
using Node for the source context. The interpretation of the remaining
arguments depends on the number of operands of various kinds that are
@@ -1920,7 +1920,7 @@
;;; VOP* -- Interface
;;;
(defmacro vop* (name node block args results &rest info)
- _N"VOP* Name Node Block (Arg* More-Args) (Result* More-Results) Info*
+ "VOP* Name Node Block (Arg* More-Args) (Result* More-Results) Info*
Like VOP, but allows for emission of templates with arbitrary numbers of
arguments, and for emission of templates using already-created TN-Ref lists.
@@ -1978,7 +1978,7 @@
;;; SC-Case -- Public
;;;
(defmacro sc-case (tn &rest forms)
- _N"SC-Case TN {({(SC-Name*) | SC-Name | T} Form*)}*
+ "SC-Case TN {({(SC-Name*) | SC-Name | T} Form*)}*
Case off of TN's SC. The first clause containing TN's SC is evaulated,
returning the values of the last form. A clause beginning with T specifies a
default. If it appears, it must be last. If no default is specified, and no
@@ -2013,7 +2013,7 @@
;;; SC-Is -- Interface
;;;
(defmacro sc-is (tn &rest scs)
- _N"SC-Is TN SC*
+ "SC-Is TN SC*
Returns true if TNs SC is any of the named SCs, false otherwise."
(once-only ((n-sc `(sc-number (tn-sc ,tn))))
`(or ,@(mapcar #'(lambda (x)
@@ -2024,7 +2024,7 @@
;;;
(defmacro do-ir2-blocks ((block-var component &optional result)
&body forms)
- _N"Do-IR2-Blocks (Block-Var Component [Result]) Form*
+ "Do-IR2-Blocks (Block-Var Component [Result]) Form*
Iterate over the IR2 blocks in component, in emission order."
`(do ((,block-var (block-info (component-head ,component))
(ir2-block-next ,block-var)))
@@ -2035,7 +2035,7 @@
;;; DO-LIVE-TNS -- Interface
;;;
(defmacro do-live-tns ((tn-var live block &optional result) &body body)
- _N"DO-LIVE-TNS (TN-Var Live Block [Result]) Form*
+ "DO-LIVE-TNS (TN-Var Live Block [Result]) Form*
Iterate over all the TNs live at some point, with the live set represented by
a local conflicts bit-vector and the IR2-Block containing the location."
(let ((n-conf (gensym))
@@ -2078,7 +2078,7 @@
;;;
(defmacro do-environment-ir2-blocks ((block-var env &optional result)
&body body)
- _N"DO-ENVIRONMENT-IR2-BLOCKS (Block-Var Env [Result]) Form*
+ "DO-ENVIRONMENT-IR2-BLOCKS (Block-Var Env [Result]) Form*
Iterate over all the IR2 blocks in the environment Env, in emit order."
(once-only ((n-env env))
(once-only ((n-first `(node-block
Index: src/compiler/new-assem.lisp
diff -u src/compiler/new-assem.lisp:1.35 src/compiler/new-assem.lisp:1.36
--- src/compiler/new-assem.lisp:1.35 Fri Mar 19 11:19:01 2010
+++ src/compiler/new-assem.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/new-assem.lisp,v 1.35 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/new-assem.lisp,v 1.36 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -50,7 +50,7 @@
;;; DEF-ASSEMBLER-PARAMS -- Interface.
;;;
(defmacro def-assembler-params (&rest options)
- _N"Set up the assembler."
+ "Set up the assembler."
`(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (c:backend-assembler-params c:*target-backend*)
(make-assem-params :backend c:*target-backend*
@@ -310,7 +310,7 @@
;;;
(defmacro without-scheduling ((&optional (segment '(%%current-segment%%)))
&body body)
- _N"Execute BODY (as a progn) without scheduling any of the instructions
+ "Execute BODY (as a progn) without scheduling any of the instructions
generated inside it. DO NOT throw or return-from out of it."
(let ((var (gensym))
(seg (gensym)))
@@ -919,7 +919,7 @@
;;;
(declaim (inline emit-byte))
(defun emit-byte (segment byte)
- _N"Emit BYTE to SEGMENT."
+ "Emit BYTE to SEGMENT."
(declare (type segment segment)
(type (or assembly-unit (signed-byte #.assembly-unit-bits)) byte))
(let* ((orig-ptr (segment-fill-pointer segment))
@@ -935,7 +935,7 @@
;;; EMIT-SKIP -- interface.
;;;
(defun emit-skip (segment amount &optional (fill-byte 0))
- _N"Output AMOUNT zeros (in bytes) to SEGMENT."
+ "Output AMOUNT zeros (in bytes) to SEGMENT."
(declare (type segment segment)
(type index amount))
(dotimes (i amount)
@@ -966,7 +966,7 @@
;;; EMIT-BACK-PATCH -- interface.
;;;
(defun emit-back-patch (segment size function)
- _N"Note that the instruction stream has to be back-patched when label positions
+ "Note that the instruction stream has to be back-patched when label positions
are finally known. SIZE bytes are reserved in SEGMENT, and function will
be called with two arguments: the segment and the position. The function
should look at the position and the position of any labels it wants to
@@ -979,7 +979,7 @@
;;; EMIT-CHOOSER -- interface.
;;;
(defun emit-chooser (segment size alignment maybe-shrink worst-case-fun)
- _N"Note that the instruction stream here depends on the actual positions of
+ "Note that the instruction stream here depends on the actual positions of
various labels, so can't be output until label positions are known. Space
is made in SEGMENT for at least SIZE bytes. When all output has been
generated, the MAYBE-SHRINK functions for all choosers are called with
@@ -1338,7 +1338,7 @@
;;; does anything like that...
(defmacro assemble ((&optional segment vop &key labels) &body body
&environment env)
- _N"Execute BODY (as a progn) with SEGMENT as the current segment."
+ "Execute BODY (as a progn) with SEGMENT as the current segment."
(flet ((label-name-p (thing)
(and thing (symbolp thing))))
(let* ((seg-var (gensym "SEGMENT-"))
@@ -1380,7 +1380,7 @@
;;; INST -- interface.
;;;
(defmacro inst (&whole whole instruction &rest args &environment env)
- _N"Emit the specified instruction to the current segment."
+ "Emit the specified instruction to the current segment."
(let ((inst (gethash (symbol-name instruction)
(assem-params-instructions
(c:backend-assembler-params c:*target-backend*)))))
@@ -1397,7 +1397,7 @@
;;; and %%CURRENT-VOP%% prevents this from being an ordinary function
;;; (likewise for EMIT-POSTIT and ALIGN, below).
(defmacro emit-label (label)
- _N"Emit LABEL at this location in the current segment."
+ "Emit LABEL at this location in the current segment."
`(%emit-label (%%current-segment%%) (%%current-vop%%) ,label))
;;; EMIT-POSTIT -- interface.
@@ -1408,13 +1408,13 @@
;;; ALIGN -- interface.
;;;
(defmacro align (bits &optional (fill-byte 0))
- _N"Emit an alignment restriction to the current segment."
+ "Emit an alignment restriction to the current segment."
`(emit-alignment (%%current-segment%%) (%%current-vop%%) ,bits ,fill-byte))
;;; LABEL-POSITION -- interface.
;;;
(defun label-position (label &optional if-after delta)
- _N"Return the current position for LABEL. Chooser maybe-shrink functions
+ "Return the current position for LABEL. Chooser maybe-shrink functions
should supply IF-AFTER and DELTA to assure correct results."
(let ((posn (label-posn label)))
(if (and if-after (> posn if-after))
@@ -1424,7 +1424,7 @@
;;; APPEND-SEGMENT -- interface.
;;;
(defun append-segment (segment other-segment)
- _N"Append OTHER-SEGMENT to the end of SEGMENT. Don't use OTHER-SEGMENT
+ "Append OTHER-SEGMENT to the end of SEGMENT. Don't use OTHER-SEGMENT
for anything after this."
(when (segment-run-scheduler segment)
(schedule-pending-instructions segment))
@@ -1471,7 +1471,7 @@
;;; FINALIZE-SEGMENT -- interface.
;;;
(defun finalize-segment (segment)
- _N"Does any final processing of SEGMENT and returns the total number of bytes
+ "Does any final processing of SEGMENT and returns the total number of bytes
covered by this segment."
(when (segment-run-scheduler segment)
(schedule-pending-instructions segment))
@@ -1491,7 +1491,7 @@
;;; SEGMENT-MAP-OUTPUT -- interface.
;;;
(defun segment-map-output (segment function)
- _N"Call FUNCTION on all the output accumulated in SEGMENT. FUNCTION is called
+ "Call FUNCTION on all the output accumulated in SEGMENT. FUNCTION is called
zero or more times with two arguments: a SAP and a number of bytes."
(let ((old-index 0)
(blocks (segment-output-blocks segment))
@@ -1528,7 +1528,7 @@
;;; RELEASE-SEGMENT -- interface.
;;;
(defun release-segment (segment)
- _N"Releases any output buffers held on to by segment."
+ "Releases any output buffers held on to by segment."
(let ((blocks (segment-output-blocks segment)))
(loop
for block across blocks
Index: src/compiler/proclaim.lisp
diff -u src/compiler/proclaim.lisp:1.46 src/compiler/proclaim.lisp:1.47
--- src/compiler/proclaim.lisp:1.46 Fri Mar 19 11:19:01 2010
+++ src/compiler/proclaim.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/proclaim.lisp,v 1.46 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/proclaim.lisp,v 1.47 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -323,7 +323,7 @@
;;;
(defmacro declaim (&rest specs)
- _N"DECLAIM Declaration*
+ "DECLAIM Declaration*
Do a declaration for the global environment."
`(progn
(eval-when (:load-toplevel :execute)
Index: src/compiler/seqtran.lisp
diff -u src/compiler/seqtran.lisp:1.34 src/compiler/seqtran.lisp:1.35
--- src/compiler/seqtran.lisp:1.34 Fri Mar 19 11:19:01 2010
+++ src/compiler/seqtran.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/seqtran.lisp,v 1.34 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/seqtran.lisp,v 1.35 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -78,7 +78,7 @@
(deftransform map-into ((result fun &rest seqs)
(vector * &rest *)
*)
- _N"open code"
+ "open code"
(let ((seqs-names (mapcar (lambda (x)
(declare (ignore x))
(gensym))
@@ -143,7 +143,7 @@
(destructuring-bind (fun eq-fun) x
(deftransform fun ((item list &key test) '(t list &rest t) '*
:eval-name t)
- _N"convert to EQ test"
+ "convert to EQ test"
(cond (test
(unless (continuation-function-is test '(eq))
(give-up)))
@@ -153,7 +153,7 @@
`(,eq-fun item list))))
(deftransform delete-if ((pred list) (t list))
- _N"inline expand"
+ "inline expand"
'(do ((x list (cdr x))
(splice '()))
((endp x) list)
@@ -165,14 +165,14 @@
(deftransform fill ((seq item &key (start 0) (end (length seq)))
(simple-array t &key (:start t) (:end index)))
- _N"open code"
+ "open code"
'(do ((i start (1+ i)))
((= i end) seq)
(declare (type index i))
(setf (aref seq i) item)))
(deftransform position ((item list &key (test #'eql)) (t list))
- _N"open code"
+ "open code"
'(do ((i 0 (1+ i))
(l list (cdr l)))
((endp l) nil)
@@ -182,7 +182,7 @@
(deftransform position ((item vec &key (test #'eql) (start 0)
(end (length vec)))
(t simple-array &key (:start t) (:end index)))
- _N"open code"
+ "open code"
'(do ((i start (1+ i)))
((= i end) nil)
(declare (type index i))
Index: src/compiler/srctran.lisp
diff -u src/compiler/srctran.lisp:1.171 src/compiler/srctran.lisp:1.172
--- src/compiler/srctran.lisp:1.171 Fri Mar 19 11:19:01 2010
+++ src/compiler/srctran.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/srctran.lisp,v 1.171 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/srctran.lisp,v 1.172 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -68,7 +68,7 @@
;;; things out.
;;;
(deftransform complement ((fun) * * :node node :when :both)
- _N"open code"
+ "open code"
(multiple-value-bind (min max)
(function-type-nargs (continuation-type fun))
(cond
@@ -149,7 +149,7 @@
(defvar *extreme-nthcdr-open-code-limit* 20)
(deftransform nthcdr ((n l) (unsigned-byte t) * :node node)
- _N"convert NTHCDR to CAxxR"
+ "convert NTHCDR to CAxxR"
(unless (constant-continuation-p n) (give-up))
(let ((n (continuation-value n)))
(when (> n
@@ -2862,7 +2862,7 @@
(deftransform %ldb ((size posn int)
(fixnum fixnum integer)
(unsigned-byte #.vm:word-bits))
- _N"convert to inline logical ops"
+ "convert to inline logical ops"
;; Try to help out the compiler by precomputing things if SIZE or
;; POSN are constants. This helps out modular arithmetic in some
;; cases. (I think it's a deficiency in modular arithmetic that it
@@ -2882,7 +2882,7 @@
(deftransform %mask-field ((size posn int)
(fixnum fixnum integer)
(unsigned-byte #.vm:word-bits))
- _N"convert to inline logical ops"
+ "convert to inline logical ops"
`(logand int
(ash (ash ,(1- (ash 1 vm:word-bits))
(- size ,vm:word-bits))
@@ -2896,7 +2896,7 @@
(deftransform %dpb ((new size posn int)
*
(unsigned-byte #.vm:word-bits))
- _N"convert to inline logical ops"
+ "convert to inline logical ops"
`(let ((mask (ldb (byte size 0) -1)))
(logior (ash (logand new mask) posn)
(logand int (lognot (ash mask posn))))))
@@ -2904,7 +2904,7 @@
(deftransform %dpb ((new size posn int)
*
(signed-byte #.vm:word-bits))
- _N"convert to inline logical ops"
+ "convert to inline logical ops"
`(let ((mask (ldb (byte size 0) -1)))
(logior (ash (logand new mask) posn)
(logand int (lognot (ash mask posn))))))
@@ -2912,7 +2912,7 @@
(deftransform %deposit-field ((new size posn int)
*
(unsigned-byte #.vm:word-bits))
- _N"convert to inline logical ops"
+ "convert to inline logical ops"
`(let ((mask (ash (ldb (byte size 0) -1) posn)))
(logior (logand new mask)
(logand int (lognot mask)))))
@@ -2920,7 +2920,7 @@
(deftransform %deposit-field ((new size posn int)
*
(signed-byte #.vm:word-bits))
- _N"convert to inline logical ops"
+ "convert to inline logical ops"
`(let ((mask (ash (ldb (byte size 0) -1) posn)))
(logior (logand new mask)
(logand int (lognot mask)))))
@@ -2948,7 +2948,7 @@
;;; Handle the case of a constant boole-code.
;;;
(deftransform boole ((op x y) * * :when :both)
- _N"convert to inline logical ops"
+ "convert to inline logical ops"
(unless (constant-continuation-p op)
(give-up _"BOOLE code is not a constant."))
(let ((control (continuation-value op)))
@@ -2978,7 +2978,7 @@
;;; If arg is a constant power of two, turn * into a shift.
;;;
(deftransform * ((x y) (integer integer) * :when :both)
- _N"convert x*2^k to shift"
+ "convert x*2^k to shift"
(unless (constant-continuation-p y) (give-up))
(let* ((y (continuation-value y))
(y-abs (abs y))
@@ -3012,17 +3012,17 @@
`(values (ash x ,shift)
(- (logand x ,mask) ,delta))))))))
(deftransform floor ((x y) (integer integer) *)
- _N"convert division by 2^k to shift"
+ "convert division by 2^k to shift"
(frob y nil))
(deftransform ceiling ((x y) (integer integer) *)
- _N"convert division by 2^k to shift"
+ "convert division by 2^k to shift"
(frob y t)))
;;; Do the same for mod.
;;;
(deftransform mod ((x y) (integer integer) * :when :both)
- _N"convert remainder mod 2^k to LOGAND"
+ "convert remainder mod 2^k to LOGAND"
(unless (constant-continuation-p y) (give-up))
(let* ((y (continuation-value y))
(y-abs (abs y))
@@ -3039,7 +3039,7 @@
;;; If arg is a constant power of two, turn truncate into a shift and mask.
;;;
(deftransform truncate ((x y) (integer integer))
- _N"convert division by 2^k to shift"
+ "convert division by 2^k to shift"
(unless (constant-continuation-p y) (give-up))
(let* ((y (continuation-value y))
(y-abs (abs y))
@@ -3062,7 +3062,7 @@
;;; And the same for rem.
;;;
(deftransform rem ((x y) (integer integer) * :when :both)
- _N"convert remainder mod 2^k to LOGAND"
+ "convert remainder mod 2^k to LOGAND"
(unless (constant-continuation-p y) (give-up))
(let* ((y (continuation-value y))
(y-abs (abs y))
@@ -3092,11 +3092,11 @@
(destructuring-bind (name identity result) stuff
(deftransform name ((x y) `(* (constant-argument (member ,identity))) '*
:eval-name t :when :both)
- _N"fold identity operations"
+ "fold identity operations"
result)))
(deftransform logand ((x y) (* (constant-argument t)) *)
- _N"fold identity operation"
+ "fold identity operation"
(let ((y (continuation-value y)))
(unless (and (plusp y)
(= y (1- (ash 1 (integer-length y)))))
@@ -3112,14 +3112,14 @@
;;;
(deftransform - ((x y) ((constant-argument (member 0)) rational) *
:when :both)
- _N"convert (- 0 x) to negate"
+ "convert (- 0 x) to negate"
'(%negate y))
;;; Restricted to rationals, because (* 0 -4.0) is -0.0.
;;;
(deftransform * ((x y) (rational (constant-argument (member 0))) *
:when :both)
- _N"convert (* x 0) to 0."
+ "convert (* x 0) to 0."
0)
;;; Fold (+ x 0).
@@ -3128,7 +3128,7 @@
;;;
(deftransform + ((x y) (rational (constant-argument (member 0))) *
:when :both)
- _N"fold zero arg"
+ "fold zero arg"
'x)
@@ -3187,7 +3187,7 @@
;;; float -0.0 then give up because (- -0.0 -0.0) is 0.0, not -0.0.
;;;
(deftransform - ((x y) (t (constant-argument number)) * :when :both)
- _N"fold zero arg"
+ "fold zero arg"
(let ((val (continuation-value y)))
(unless (and (zerop val)
(not (and (floatp val) (minusp (float-sign val))))
@@ -3203,7 +3203,7 @@
(destructuring-bind (name result minus-result) stuff
(deftransform name ((x y) '(t (constant-argument real)) '* :eval-name t
:when :both)
- _N"fold identity operations"
+ "fold identity operations"
(let ((val (continuation-value y)))
(unless (and (= (abs val) 1)
(not-more-contagious y x))
@@ -3214,7 +3214,7 @@
;;; N; convert (expt x 1/2) to sqrt.
;;;
(deftransform expt ((x y) (t (constant-argument real)) *)
- _N"recode as multiplication or sqrt"
+ "recode as multiplication or sqrt"
(let ((val (continuation-value y)))
;; If Y would cause the result to be promoted to the same type as
;; Y, we give up. If not, then the result will be the same type
@@ -3245,13 +3245,13 @@
(dolist (name '(ash /))
(deftransform name ((x y) '((constant-argument (integer 0 0)) integer) '*
:eval-name t :when :both)
- _N"fold zero arg"
+ "fold zero arg"
0))
(dolist (name '(truncate round floor ceiling))
(deftransform name ((x y) '((constant-argument (integer 0 0)) integer) '*
:eval-name t :when :both)
- _N"fold zero arg"
+ "fold zero arg"
'(values 0 0)))
@@ -3259,7 +3259,7 @@
;;;; Character operations:
(deftransform char-equal ((a b) (base-char base-char))
- _N"open code"
+ "open code"
#-(and unicode (not unicode-bootstrap))
'(let* ((ac (char-code a))
(bc (char-code b))
@@ -3284,7 +3284,7 @@
(lisp::equal-char-code b)))))
(deftransform char-upcase ((x) (base-char))
- _N"open code"
+ "open code"
#-(and unicode (not unicode-bootstrap))
'(if (lower-case-p x)
(code-char (- (char-code x) 32))
@@ -3296,7 +3296,7 @@
(t x))))
(deftransform char-downcase ((x) (base-char))
- _N"open code"
+ "open code"
#-(and unicode (not unicode-bootstrap))
'(if (upper-case-p x)
(code-char (+ (char-code x) 32))
@@ -3360,7 +3360,7 @@
;;; that case, otherwise give an efficency note.
;;;
(deftransform eql ((x y) * * :when :both)
- _N"convert to simpler equality predicate"
+ "convert to simpler equality predicate"
(let ((x-type (continuation-type x))
(y-type (continuation-type y))
(char-type (specifier-type 'character))
@@ -3390,7 +3390,7 @@
;;; and the same for both.
;;;
(deftransform = ((x y) * * :when :both)
- _N"open code"
+ "open code"
(let ((x-type (continuation-type x))
(y-type (continuation-type y)))
(if (and (csubtypep x-type (specifier-type 'number))
@@ -3959,7 +3959,7 @@
)))))))
(defvar *enable-modular-arithmetic* t
- _N"When non-NIL, the compiler will generate code utilizing modular
+ "When non-NIL, the compiler will generate code utilizing modular
arithmetic. Set to NIL to disable this, if you don't want modular
arithmetic in some cases.")
Index: src/compiler/tn.lisp
diff -u src/compiler/tn.lisp:1.21 src/compiler/tn.lisp:1.22
--- src/compiler/tn.lisp:1.21 Fri Mar 19 11:19:01 2010
+++ src/compiler/tn.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/tn.lisp,v 1.21 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/tn.lisp,v 1.22 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -34,7 +34,7 @@
;;; Do-Packed-TNs -- Interface
;;;
(defmacro do-packed-tns ((tn component &optional result) &body body)
- _N"Do-Packed-TNs (TN-Var Component [Result]) Declaration* Form*
+ "Do-Packed-TNs (TN-Var Component [Result]) Declaration* Form*
Iterate over all packed TNs allocated in Component."
(let ((n-component (gensym)))
`(let ((,n-component (component-info ,component)))
Index: src/compiler/typetran.lisp
diff -u src/compiler/typetran.lisp:1.46 src/compiler/typetran.lisp:1.47
--- src/compiler/typetran.lisp:1.46 Fri Mar 19 11:19:01 2010
+++ src/compiler/typetran.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/typetran.lisp,v 1.46 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/typetran.lisp,v 1.47 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -42,7 +42,7 @@
;;; Define-Type-Predicate -- Interface
;;;
(defmacro define-type-predicate (name type)
- _N"Define-Type-Predicate Name Type
+ "Define-Type-Predicate Name Type
Establish an association between the type predicate Name and the
corresponding Type. This causes the type predicate to be recognized for
purposes of optimization."
Index: src/compiler/vmdef.lisp
diff -u src/compiler/vmdef.lisp:1.50 src/compiler/vmdef.lisp:1.51
--- src/compiler/vmdef.lisp:1.50 Fri Mar 19 11:19:01 2010
+++ src/compiler/vmdef.lisp Mon Apr 19 11:08:20 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/vmdef.lisp,v 1.50 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/vmdef.lisp,v 1.51 2010-04-19 15:08:20 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -278,7 +278,7 @@
;;; NOTE-THIS-LOCATION -- Interface
;;;
(defun note-this-location (vop kind)
- _N"NOTE-THIS-LOCATION VOP Kind
+ "NOTE-THIS-LOCATION VOP Kind
Note that the current code location is an interesting (to the debugger)
location of the specified Kind. VOP is the VOP responsible for this code.
This VOP must specify some non-null :SAVE-P value (perhaps :COMPUTE-ONLY) so
@@ -290,7 +290,7 @@
;;; NOTE-NEXT-INSTRUCTION -- interface.
;;;
(defun note-next-instruction (vop kind)
- _N"NOTE-NEXT-INSTRUCTION VOP Kind
+ "NOTE-NEXT-INSTRUCTION VOP Kind
Similar to NOTE-THIS-LOCATION, except the use the location of the next
instruction for the code location, wherever the scheduler decided to put
it."
More information about the cmucl-commit
mailing list