Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
cmucl
cmucl
Commits
6dedd93e
Commit
6dedd93e
authored
Apr 19, 2010
by
rtoy
Browse files
Remove _N"" reader macro from docstrings when possible.
parent
927503b4
Changes
23
Expand all
Hide whitespace changes
Inline
Side-by-side
compiler/backend.lisp
View file @
6dedd93e
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/backend.lisp,v 1.3
3
2010/0
3
/19 15:
19:0
0 rtoy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/backend.lisp,v 1.3
4
2010/0
4
/19 15:
08:2
0 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
)))
...
...
compiler/codegen.lisp
View file @
6dedd93e
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/codegen.lisp,v 1.2
5
2010/0
3
/19 15:
19:0
0 rtoy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/codegen.lisp,v 1.2
6
2010/0
4
/19 15:
08:2
0 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."
)
...
...
compiler/debug-dump.lisp
View file @
6dedd93e
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug-dump.lisp,v 1.5
0
2010/0
3
/19 15:
19:0
0 rtoy
Exp
$"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug-dump.lisp,v 1.5
1
2010/0
4
/19 15:
08:2
0 rtoy
Rel
$"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -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
))
...
...
compiler/debug.lisp
View file @
6dedd93e
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug.lisp,v 1.3
8
2010/0
3
/19 15:
19:0
0 rtoy
Exp
$"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug.lisp,v 1.3
9
2010/0
4
/19 15:
08:2
0 rtoy
Rel
$"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -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
)))
...
...
compiler/disassem.lisp
View file @
6dedd93e
This diff is collapsed.
Click to expand it.
compiler/eval.lisp
View file @
6dedd93e
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/eval.lisp,v 1.3
7
2010/0
3
/19 15:
19:0
0 rtoy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/eval.lisp,v 1.3
8
2010/0
4
/19 15:
08:2
0 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*
)
...
...
compiler/float-tran.lisp
View file @
6dedd93e
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.13
7
2010/0
3
/19 15:
19:0
0 rtoy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.13
8
2010/0
4
/19 15:
08:2
0 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
)))
...
...
compiler/globaldb.lisp
View file @
6dedd93e
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.5
4
2010/0
3
/19 15:
19:0
0 rtoy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.5
5
2010/0
4
/19 15:
08:2
0 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
))
...
...
compiler/ir1opt.lisp
View file @
6dedd93e
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1opt.lisp,v 1.8
8
2010/0
3
/19 15:
19:0
0 rtoy
Exp
$"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1opt.lisp,v 1.8
9
2010/0
4
/19 15:
08:2
0 rtoy
Rel
$"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -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
...
...
compiler/ir1tran.lisp
View file @
6dedd93e
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.17
4
2010/0
3
/19 15:
19:0
0 rtoy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.17
5
2010/0
4
/19 15:
08:2
0 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}*