[Openmcl-cvs-notifications] r11088 - in /trunk/source: compiler/ compiler/X86/ lib/
gz at clozure.com
gz at clozure.com
Tue Oct 14 13:22:57 EDT 2008
Author: gz
Date: Tue Oct 14 13:22:57 2008
New Revision: 11088
Log:
Trivial tweaks, mostly indentation and comments, to simplify merging with w=
orking-0711 branch
Modified:
trunk/source/compiler/X86/x86-arch.lisp
trunk/source/compiler/X86/x86-disassemble.lisp
trunk/source/compiler/X86/x86-lapmacros.lisp
trunk/source/compiler/X86/x862.lisp
trunk/source/compiler/nx-basic.lisp
trunk/source/compiler/nx.lisp
trunk/source/compiler/nx0.lisp
trunk/source/compiler/nx1.lisp
trunk/source/compiler/optimizers.lisp
trunk/source/lib/macros.lisp
Modified: trunk/source/compiler/X86/x86-arch.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/X86/x86-arch.lisp (original)
+++ trunk/source/compiler/X86/x86-arch.lisp Tue Oct 14 13:22:57 2008
@@ -53,7 +53,7 @@
heap-start ; start of lisp heap
heap-end ; end of lisp heap
statically-linked ; true if the lisp kernel is stati=
cally linked
- stack-size ; weak gc policy/algorithm.
+ stack-size ; value of --stack-size arg
objc-2-begin-catch ; objc_begin_catch
bad-funcall ; pseudo-target for funcall
all-areas ; doubly-linked area list
Modified: trunk/source/compiler/X86/x86-disassemble.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/X86/x86-disassemble.lisp (original)
+++ trunk/source/compiler/X86/x86-disassemble.lisp Tue Oct 14 13:22:57 2008
@@ -2722,8 +2722,6 @@
usual)))
=
=
- =
- =
(defun x86-print-disassembled-instruction (ds instruction seq)
(let* ((addr (x86-di-address instruction))
(entry (x86-ds-entry-point ds)))
@@ -2798,7 +2796,8 @@
(setq seq (funcall collect-function ds instruction seq)))))))
=
#+x8664-target
-(defun x8664-xdisassemble (function &optional (collect-function #'x86-prin=
t-disassembled-instruction ))
+(defun x8664-xdisassemble (function
+ &optional (collect-function #'x86-print-disasse=
mbled-instruction))
(let* ((fv (%function-to-function-vector function))
(function-size-in-words (uvsize fv))
(code-words (%function-code-words function))
@@ -2813,7 +2812,8 @@
(do* ((k code-words (1+ k))
(j 1 (1+ j)))
((=3D k function-size-in-words)
- (x8664-disassemble-xfunction xfunction :collect-function collect=
-function))
+ (x8664-disassemble-xfunction xfunction
+ :collect-function collect-function))
(declare (fixnum j k))
(setf (uvref xfunction j) (uvref fv k)))))
=
Modified: trunk/source/compiler/X86/x86-lapmacros.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/X86/x86-lapmacros.lisp (original)
+++ trunk/source/compiler/X86/x86-lapmacros.lisp Tue Oct 14 13:22:57 2008
@@ -31,7 +31,6 @@
(defx86lapmacro set-nargs (n)
(cond ((=3D n 0) `(xorl (% nargs) (% nargs)))
(t `(movl ($ ',n) (% nargs)))))
- =
=
(defx86lapmacro anchored-uuo (form)
`(progn
@@ -140,7 +139,6 @@
(defx86lapmacro trap-unless-typecode=3D (node tag &optional (immreg 'imm0))
(let* ((bad (gensym))
(anchor (gensym)))
- =
`(progn
,anchor
(extract-typecode ,node ,immreg)
@@ -412,8 +410,7 @@
(movq (% rbp) (@ ,(* (1+ nstackargs) x8664::node-size) (% rsp)))
(leaq (@ ,(* (1+ nstackargs) x8664::node-size) (% rsp)) (% rbp))
(popq (@ x8632::node-size (% rbp)))))))
- =
- =
+
(defx86lapmacro save-frame-variable-arg-count ()
(let* ((push (gensym))
(done (gensym)))
Modified: trunk/source/compiler/X86/x862.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/X86/x862.lisp (original)
+++ trunk/source/compiler/X86/x862.lisp Tue Oct 14 13:22:57 2008
@@ -473,8 +473,7 @@
(dolist (a (afunc-inner-functions afunc))
(unless (afunc-lfun a)
(x862-compile a =
- (if lambda-form =
- (afunc-lambdaform a)) =
+ (if lambda-form (afunc-lambdaform a))
*x862-record-symbols*))) ; always compile inner guys
(let* ((*x862-cur-afunc* afunc)
(*x862-returning-values* nil)
@@ -656,7 +655,7 @@
(setf (vinsn-label-info lab) (emit-x86-lap-label =
frag-list lab))
(let* ((val (single-float-bits sfloat)))
(x86-lap-directive frag-list :long val)))))
- (target-arch-case
+ (target-arch-case
(:x8632
(x86-lap-directive frag-list :align 2)
;; start of self reference table
@@ -671,7 +670,7 @@
(:x8664
(x86-lap-directive frag-list :align 3)
(x86-lap-directive frag-list :quad x8664::function-boundary-marker)=
))
- =
+
(emit-x86-lap-label frag-list end-code-tag)
=
(dolist (c (reverse *x862-constant-alist*))
@@ -686,7 +685,7 @@
(x86-lap-directive frag-list :long 0))
(:x8664
(x86-lap-directive frag-list :quad 0)))))
- =
+
(if (logbitp $fbitnonnullenv (the fixnum (afunc-bits af=
unc)))
(setq bits (+ bits (ash 1 $lfbits-nonnullenv-bit))))
(let* ((function-debugging-info (afunc-lfun-info afunc)=
))
@@ -724,8 +723,8 @@
(when fname
(x86-lap-directive frag-list :quad 0))
(x86-lap-directive frag-list :quad 0)))
- =
- (relax-frag-list frag-list)
+
+ (relax-frag-list frag-list)
(apply-relocs frag-list)
(fill-for-alignment frag-list)
(target-arch-case
@@ -742,15 +741,15 @@
(incf srt-index 4)))))
;;(show-frag-bytes frag-list)
))
- =
- (x862-lap-process-regsave-info frag-list regsave-label regsave-mask=
regsave-addr)
- (setf (afunc-lfun afunc)
- #+x86-target
- (if (eq *host-backend* *target-backend*)
- (create-x86-function fname frag-list *x862-constant-alist* bits de=
bug-info)
- (cross-create-x86-function fname frag-list *x862-constant-alist* b=
its debug-info))
- #-x86-target
- (cross-create-x86-function fname frag-list *x862-constant-alist* bit=
s debug-info)))
+
+ (x862-lap-process-regsave-info frag-list regsave-labe=
l regsave-mask regsave-addr)
+ (setf (afunc-lfun afunc)
+ #+x86-target
+ (if (eq *host-backend* *target-backend*)
+ (create-x86-function fname frag-list *x862-co=
nstant-alist* bits debug-info)
+ (cross-create-x86-function fname frag-list *x=
862-constant-alist* bits debug-info))
+ #-x86-target
+ (cross-create-x86-function fname frag-list *x86=
2-constant-alist* bits debug-info)))
(x862-digest-symbols)))))
(backend-remove-labels))))
afunc))
@@ -767,8 +766,8 @@
(let ((fwd-refs (afunc-fwd-refs afunc)))
(when fwd-refs
(let* ((native-x86-functions #-x86-target nil
- #+x86-target (eq *target-backend*
- *host-backend*))
+ #+x86-target (eq *target-backend*
+ *host-backend*))
(v (if native-x86-functions
(function-to-function-vector (afunc-lfun afunc))
(afunc-lfun afunc)))
@@ -786,8 +785,21 @@
(if (eq (%svref v i) ref)
(setf (%svref v i) ref-fun)))))))))
=
+(defun x862-vinsn-note-label-address (note &optional start-p sym)
+ (-
+ (let* ((label (vinsn-note-label note))
+ (lap-label (if label (vinsn-label-info label))))
+ (if lap-label
+ (x86-lap-label-address lap-label)
+ (compiler-bug "Missing or bad ~s label~@[: ~s~]"
+ (if start-p 'start 'end)
+ sym)))
+ (target-arch-case
+ (:x8632 x8632::fulltag-misc) ;xxx?
+ (:x8664 x8664::fulltag-function))))
+
(defun x862-digest-symbols ()
- (if *x862-recorded-symbols*
+ (when *x862-recorded-symbols*
(let* ((symlist *x862-recorded-symbols*)
(len (length symlist))
(syms (make-array len))
@@ -797,26 +809,16 @@
(declare (fixnum i j))
(dolist (info symlist (progn (%rplaca symlist syms)
(%rplacd symlist ptrs)))
- (flet ((label-address (note start-p sym)
- (-
- (let* ((label (vinsn-note-label note))
- (lap-label (if label (vinsn-label-info label))))
- (if lap-label
- (x86-lap-label-address lap-label)
- (compiler-bug "Missing or bad ~s label: ~s" =
- (if start-p 'start 'end) sym)))
- (target-arch-case
- (:x8632 x8632::fulltag-misc) ;xxx?
- (:x8664 x8664::fulltag-function)))))
- (destructuring-bind (var sym startlab endlab) info
- (let* ((ea (var-ea var))
- (ea-val (ldb (byte 16 0) ea)))
- (setf (aref ptrs (incf i)) (if (memory-spec-p ea)
- (logior (ash ea-val 6) #o77)
- ea-val)))
- (setf (aref syms (incf j)) sym)
- (setf (aref ptrs (incf i)) (label-address startlab t sym))
- (setf (aref ptrs (incf i)) (label-address endlab nil sym))))))=
))
+ (destructuring-bind (var sym startlab endlab) info
+ (let* ((ea (var-ea var))
+ (ea-val (ldb (byte 16 0) ea)))
+ (setf (aref ptrs (incf i)) (if (memory-spec-p ea)
+ (logior (ash ea-val 6) #o77)
+ ea-val)))
+ (setf (aref syms (incf j)) sym)
+ (setf (aref ptrs (incf i)) (x862-vinsn-note-label-address startl=
ab t sym))
+ (setf (aref ptrs (incf i)) (x862-vinsn-note-label-address endlab=
nil sym))))
+ *x862-recorded-symbols*)))
=
(defun x862-decls (decls)
(if (fixnump decls)
@@ -911,7 +913,7 @@
(if (>=3D (the fixnum (cdr c)) 3) (push c maybe)))
(do* ((things (%sort-list-no-key maybe #'%x862-bigger-cdr-than) (cdr=
things))
(n 0 (1+ n))
- (registers (target-arch-case =
+ (registers (target-arch-case
(:x8632 (error "no nvrs on x8632"))
(:x8664
(if (=3D (backend-lisp-context-register *target-b=
ackend*) x8664::save3)
@@ -1691,8 +1693,8 @@
(x862-box-u32 seg target temp)))
(:x8664
(! box-fixnum target temp)))))))))
- (with-imm-target () idx-reg
- (if index-known-fixnum
+ (with-imm-target () idx-reg
+ (if index-known-fixnum
(x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offse=
t arch) (ash index-known-fixnum 2)))
(! scale-32bit-misc-index idx-reg unscaled-idx))
(cond ((eq type-keyword :single-float-vector)
@@ -2498,8 +2500,7 @@
(! nset-variable-bit-to-variable-value src scaled-idx val-reg))))))=
)))))
(when (and vreg val-reg) (<- val-reg))
(^))))
- =
- =
+
=
(defun x862-vset (seg vreg xfer type-keyword vector index value safe)
(with-x86-local-vinsn-macros (seg)
@@ -5800,7 +5801,7 @@
(parsed-ops (make-list (length op-vals)))
(tail parsed-ops))
(declare (dynamic-extent parsed-ops)
- (cons parsed-ops tail))
+ (list parsed-ops tail))
(dolist (op op-vals
(if for-pred
(apply (car valform) parsed-ops)
@@ -6016,7 +6017,7 @@
(x862-allocate-global-registers *x862-fcells* *x862-vcells* (afu=
nc-all-vars afunc) no-regs))
(@ (backend-get-next-label)) ; generic self-reference label, shoul=
d be label #1
(! establish-fn)
- (@ (backend-get-next-label)) ; self-call label
+ (@ (backend-get-next-label)) ; self-call label
(unless next-method-p
(setq method-var nil))
=
@@ -8030,7 +8031,7 @@
(x862-one-targeted-reg-form seg ptr src-reg)
(if (node-reg-p vreg)
(! mem-ref-c-bit-fixnum vreg src-reg offval)
- (with-imm-target () ;OK if src-reg & dest overlap
+ (with-imm-target () ;OK if src-reg & dest overlap
(dest :u8)
(! mem-ref-c-bit dest src-reg offval)
(<- dest))))
@@ -9844,7 +9845,7 @@
(defx862 x862-%foreign-stack-pointer %foreign-stack-pointer (seg vreg xfer)
(when vreg
(ensuring-node-target (target vreg)
- (! %foreign-stack-pointer target)))
+ (! %foreign-stack-pointer target)))
(^))
=
=
@@ -10017,7 +10018,7 @@
(make-acode (%nx1-operator immediate)
'%short-float)
(list nil (list arg))))))))
- =
+
=
(defx862 x862-%new-ptr %new-ptr (seg vreg xfer size clear-p )
(x862-call-fn seg
@@ -10074,13 +10075,7 @@
(backend-target-foreign-type-data backend)
*target-ftd*)))
(multiple-value-bind (xlfun warnings)
- (compile-named-function def nil
- nil
- nil
- nil
- nil
- nil
- target)
+ (compile-named-function def :target target)
(signal-or-defer-warnings warnings nil)
(when disassemble
(let ((*target-backend* backend))
Modified: trunk/source/compiler/nx-basic.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/nx-basic.lisp (original)
+++ trunk/source/compiler/nx-basic.lisp Tue Oct 14 13:22:57 2008
@@ -20,7 +20,7 @@
=
(in-package :ccl)
=
-#| Note: when MCL-AppGen 4.0 is built, the following form will need to be =
included in it:
+#|| Note: when MCL-AppGen 4.0 is built, the following form will need to be=
included in it:
; for compiler-special-form-p, called by cheap-eval-in-environment
(defparameter *nx1-compiler-special-forms*
`(%DEFUN %FUNCTION %NEW-PTR %NEWGOTAG %PRIMITIVE %VREFLET BLOCK CATCH CO=
MPILER-LET DEBIND
@@ -29,7 +29,7 @@
MULTIPLE-VALUE-LIST MULTIPLE-VALUE-PROG1 NEW-LAP NEW-LAP-INLINE NFUNCT=
ION OLD-LAP
OLD-LAP-INLINE OR PROG1 PROGN PROGV QUOTE RETURN-FROM SETQ STRUCT-REF =
STRUCT-SET
SYMBOL-MACROLET TAGBODY THE THROW UNWIND-PROTECT WITH-STACK-DOUBLE-FLO=
ATS WITHOUT-INTERRUPTS))
-|#
+||#
=
(eval-when (:compile-toplevel)
(require 'nxenv))
@@ -405,14 +405,14 @@
(error "Invalid lambda-expression ~S." lambda-expression))
(%make-function nil lambda-expression env))
=
-#| Might be nicer to do %declaim
+#|| Might be nicer to do %declaim
(defmacro declaim (&rest decl-specs &environment env)
`(progn
(eval-when (:load-toplevel :execute)
(proclaim ', at decl-specs))
(eval-when (:compile-toplevel)
(%declaim ', at decl-specs ,env))))
-|#
+||#
=
(defmacro declaim (&environment env &rest decl-specs)
"DECLAIM Declaration*
@@ -446,8 +446,7 @@
warnings))
=
;;; This is called by, e.g., note-function-info & so can't be -too- funky =
...
-;;; don't call proclaimed-inline-p or proclaimed-notinline-p with
-;;; alphatized crap
+;;; don't call proclaimed-inline-p or proclaimed-notinline-p with alphatiz=
ed crap
=
(defun nx-declared-inline-p (sym env)
(setq sym (maybe-setf-function-name sym))
Modified: trunk/source/compiler/nx.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/nx.lisp (original)
+++ trunk/source/compiler/nx.lisp Tue Oct 14 13:22:57 2008
@@ -185,16 +185,11 @@
afunc
(funcall (backend-p2-compile *target-backend*)
afunc
- ; will also bind *nx-lexical-environment*
+ ;; will also bind *nx-lexical-environment*
(if keep-lambda (if (lambda-expression-p keep-lambda) keep-lam=
bda def))
keep-symbols)))))
(values (afunc-lfun def) (afunc-warnings def)))
)
-
-
- =
-
-
=
=
(defparameter *compiler-whining-conditions*
Modified: trunk/source/compiler/nx0.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/nx0.lisp (original)
+++ trunk/source/compiler/nx0.lisp Tue Oct 14 13:22:57 2008
@@ -303,8 +303,6 @@
=
(defun nx-allow-transforms (env)
(nx-apply-env-hook policy.allow-transforms env))
-
-
=
(defun nx-force-boundp-checks (var env)
(or (eq (safety-optimize-quantity env) 3)
@@ -1254,7 +1252,7 @@
(%ilsl $vbitsetq 1) =
(ash -1 $vbitspecial)
(%ilsl $vbitclosed 1)) varbits))
- (error "Bug-o-rama - \"punted\" var had bogus bits.
+ (error "Bug-o-rama - \"punted\" var had bogus bits. ~
Or something. Right? ~s ~s" var varbits))
(let* ((varcount (%ilogand $vrefmask varbits)) =
(boundtocount (%ilogand $vrefmask boundtobits)))
@@ -1374,15 +1372,11 @@
(and (consp form)
(consp (setq form (%cdr form))) =
(eq (caar form) '&method)))
- =
-
-
-
=
=
(defun nx1-lambda (ll body decls &aux (l ll) methvar)
- (let ((old-env *nx-lexical-environment*)
- (*nx-bound-vars* *nx-bound-vars*))
+ (let* ((old-env *nx-lexical-environment*)
+ (*nx-bound-vars* *nx-bound-vars*))
(with-nx-declarations (pending)
(let* ((*nx-parsing-lambda-decls* t))
(nx-process-declarations pending decls))
@@ -1392,7 +1386,7 @@
(unless (setq bits (encode-lambda-list (%cdr l)))
(nx-error "invalid lambda-list - ~s" l)))
(return-from nx1-lambda
- (list
+ (make-acode
(%nx1-operator lambda-list)
(list (cons '&lap bits))
nil
Modified: trunk/source/compiler/nx1.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/nx1.lisp (original)
+++ trunk/source/compiler/nx1.lisp Tue Oct 14 13:22:57 2008
@@ -1084,9 +1084,9 @@
;;; in a null lexical environment.
=
(defnx1 nx1-load-time-value (load-time-value) (&environment env form &opti=
onal read-only-p)
- ; Validate the "read-only-p" argument
+ ;; Validate the "read-only-p" argument
(if (and read-only-p (neq read-only-p t)) (require-type read-only-p '(me=
mber t nil)))
- ; Then ignore it.
+ ;; Then ignore it.
(if *nx-load-time-eval-token*
(multiple-value-bind (function warnings)
(compile-named-function =
@@ -1370,7 +1370,7 @@
(:linuxppc32 (%nx1-operator eabi-syscall))
((:darwinppc32 :darwinppc64 :linuxppc64)
(%nx1-operator poweropen-syscall))
- (:darwinx8632 :linuxx632 :win32 (%nx1-operator i386-syscall))
+ ((:darwinx8632 :linuxx632 :win32) (%nx1-operator i386-syscall))
((:linuxx8664 :freebsdx8664 :darwinx8664 :solarisx8664 :win64=
) (%nx1-operator syscall))))))
=
(defun nx1-ff-call-internal (address-expression arg-specs-and-result-spec =
operator )
@@ -1894,7 +1894,7 @@
arglist (%cdr arglist))))
(if arglist
(when (and (not keys) (not rest))
- (nx-error "Extra args ~s for (LAMBDA ~s ,,,)" args lambda-=
list))
+ (nx-error "Extra args ~s for (LAMBDA ~s ...)" args lambda-=
list))
(when rest
(push rest vars*) (push *nx-nil* vals*)
(nx1-punt-bindings (cons rest nil) (cons *nx-nil* nil))
Modified: trunk/source/compiler/optimizers.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/optimizers.lisp (original)
+++ trunk/source/compiler/optimizers.lisp Tue Oct 14 13:22:57 2008
@@ -2438,4 +2438,3 @@
=
=
(provide "OPTIMIZERS")
-
Modified: trunk/source/lib/macros.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/macros.lisp (original)
+++ trunk/source/lib/macros.lisp Tue Oct 14 13:22:57 2008
@@ -1716,7 +1716,7 @@
=
(defmacro defmethod (name &rest args &environment env)
(multiple-value-bind (function-form specializers-form qualifiers lambda-=
list documentation specializers)
- (parse-defmethod name args env) =
+ (parse-defmethod name args env)
`(progn
(eval-when (:compile-toplevel)
(record-function-info ',(maybe-setf-function-name name)
@@ -1999,20 +1999,20 @@
(t (%badarg (car rest) '(or (and null symbol) list)))))
=
(defmacro defgeneric (function-name lambda-list &rest options-and-methods =
&environment env)
- (fboundp function-name) ; type-check
+ (fboundp function-name) ; type-check
(multiple-value-bind (method-combination generic-function-class options =
methods)
(parse-defgeneric function-name t lambda-list options-and-methods)
(let ((gf (gensym)))
`(progn
- (eval-when (:compile-toplevel)
- (record-function-info ',(maybe-setf-function-name function-name)
+ (eval-when (:compile-toplevel)
+ (record-function-info ',(maybe-setf-function-name function-name)
',(%cons-def-info 'defgeneric (encode-gf-=
lambda-list lambda-list))
,env))
- (let ((,gf (%defgeneric
- ',function-name ',lambda-list ',method-combination ',g=
eneric-function-class =
- ',(apply #'append options))))
- (%set-defgeneric-methods ,gf , at methods)
- ,gf)))))
+ (let ((,gf (%defgeneric
+ ',function-name ',lambda-list ',method-combination ',=
generic-function-class =
+ ',(apply #'append options))))
+ (%set-defgeneric-methods ,gf , at methods)
+ ,gf)))))
=
=
=
@@ -2027,7 +2027,8 @@
(let ((keyword (car o))
(defmethod (if global-p 'defmethod 'anonymous-method)))
(if (eq keyword :method)
- (push `(,defmethod ,function-name ,@(%cdr o)) methods)
+ (let ((defn `(,defmethod ,function-name ,@(%cdr o))))
+ (push defn methods))
(cond ((and (not (eq keyword 'declare))
(memq keyword (prog1 option-keywords (push keyword option-keywords)))) =
=
(signal-program-error "Duplicate option: ~s to ~s" keyw=
ord 'defgeneric))
@@ -2136,10 +2137,6 @@
`(progn
(defclass ,name ,(or supers '(condition)) ,slots , at classopts)
, at reporter
- ;; defclass will record name as a class, we only want
- #+new-record-source
- (remove-definition-source 'class ',name)
- (record-source-file ',name 'condition)
',name)))
=
(defmacro with-condition-restarts (&environment env condition restarts &bo=
dy body)
@@ -2660,7 +2657,7 @@
(let* ((val (gensym)))
`(do* ((,val ,place ,place))
((typep ,val ',typespec))
- (setf ,place (%check-type ,val ',typespec ',place ,string)))))
+ (setf ,place (%check-type ,val ',typespec ',place ,string)))))
=
=
=
More information about the Openmcl-cvs-notifications
mailing list