[armedbear-cvs] r11540 - trunk/abcl/src/org/armedbear/lisp
Ville Voutilainen
vvoutilainen at common-lisp.net
Sun Jan 4 16:44:21 UTC 2009
Author: vvoutilainen
Date: Sun Jan 4 16:44:21 2009
New Revision: 11540
Log:
Helper macro for defining inlining functions.
Modified:
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Sun Jan 4 16:44:21 2009
@@ -2121,6 +2121,7 @@
(setf (gethash string ht) g)))
g))
+
(defknown compile-constant (t t t) t)
(defun compile-constant (form target representation)
(unless target
@@ -2272,11 +2273,20 @@
(setf (gethash name *predicates*) (cons boxed-method-name unboxed-method-name))
(install-p2-handler name 'p2-predicate))
+(defmacro define-inlined-function (name params preamble-and-test &body body)
+ (let* ((test (second preamble-and-test))
+ (preamble (and test (first preamble-and-test)))
+ (test (or test (first preamble-and-test))))
+ `(defun ,name ,params
+ ,preamble
+ (unless ,test
+ (compile-function-call , at params)
+ (return-from ,name))
+ , at body)))
+
(defknown p2-predicate (t t t) t)
-(defun p2-predicate (form target representation)
- (unless (= (length form) 2)
- (compile-function-call form target representation)
- (return-from p2-predicate))
+(define-inlined-function p2-predicate (form target representation)
+ ((= (length form) 2))
(let* ((op (car form))
(info (gethash op *predicates*))
(boxed-method-name (car info))
@@ -2400,11 +2410,9 @@
(emit 'i2l)))))
(defknown p2-eq/neq (t t t) t)
-(defun p2-eq/neq (form target representation)
- (aver (or (null representation) (eq representation :boolean)))
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-eq/neq))
+(define-inlined-function p2-eq/neq (form target representation)
+ ((aver (or (null representation) (eq representation :boolean)))
+ (check-arg-count form 2))
(let* ((op (%car form))
(args (%cdr form))
(arg1 (%car args))
@@ -2437,11 +2445,9 @@
(label label2)))))
(defknown p2-eql (t t t) t)
-(defun p2-eql (form target representation)
- (aver (or (null representation) (eq representation :boolean)))
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-eql))
+(define-inlined-function p2-eql (form target representation)
+ ((aver (or (null representation) (eq representation :boolean)))
+ (check-arg-count form 2))
(let* ((arg1 (%cadr form))
(arg2 (%caddr form))
(type1 (derive-compiler-type arg1))
@@ -2489,11 +2495,8 @@
(emit-move-from-stack target representation)))
(defknown p2-memq (t t t) t)
-(defun p2-memq (form target representation)
-;; (format t "p2-memq representation = ~S~%" representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-memq))
+(define-inlined-function p2-memq (form target representation)
+ ((check-arg-count form 2))
(cond ((eq representation :boolean)
(let* ((args (cdr form))
(arg1 (first args))
@@ -2507,10 +2510,8 @@
(compile-function-call form target representation))))
(defknown p2-memql (t t t) t)
-(defun p2-memql (form target representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-memql))
+(define-inlined-function p2-memql (form target representation)
+ ((check-arg-count form 2))
(cond ((eq representation :boolean)
(let* ((args (cdr form))
(arg1 (first args))
@@ -4356,11 +4357,9 @@
(emit-move-from-stack target))))
(defknown p2-atom (t t t) t)
-(defun p2-atom (form target representation)
- (aver (or (null representation) (eq representation :boolean)))
- (unless (check-arg-count form 1)
- (compile-function-call form target representation)
- (return-from p2-atom))
+(define-inlined-function p2-atom (form target representation)
+ ((aver (or (null representation) (eq representation :boolean)))
+ (check-arg-count form 1))
(compile-forms-and-maybe-emit-clear-values (cadr form) 'stack nil)
(emit 'instanceof +lisp-cons-class+)
(let ((LABEL1 (gensym))
@@ -4438,10 +4437,8 @@
(defun p2-vectorp (form target representation)
(p2-instanceof-predicate form target representation +lisp-abstract-vector-class+))
-(defun p2-coerce-to-function (form target representation)
- (unless (check-arg-count form 1)
- (compile-function-call form target representation)
- (return-from p2-coerce-to-function))
+(define-inlined-function p2-coerce-to-function (form target representation)
+ ((check-arg-count form 1))
(compile-forms-and-maybe-emit-clear-values (%cadr form) 'stack nil)
(emit-invokestatic +lisp-class+ "coerceToFunction"
(lisp-object-arg-types 1) +lisp-object+)
@@ -4566,10 +4563,8 @@
(compile-forms-and-maybe-emit-clear-values arg 'stack nil)
(emit-invoke-method field target representation))
-(defun p2-car (form target representation)
- (unless (check-arg-count form 1)
- (compile-function-call form target representation)
- (return-from p2-car))
+(define-inlined-function p2-car (form target representation)
+ ((check-arg-count form 1))
(let ((arg (%cadr form)))
(cond ((and (null target) (< *safety* 3))
(compile-form arg target nil))
@@ -4579,17 +4574,13 @@
(t
(emit-car/cdr arg target representation "car")))))
-(defun p2-cdr (form target representation)
- (unless (check-arg-count form 1)
- (compile-function-call form target representation)
- (return-from p2-cdr))
+(define-inlined-function p2-cdr (form target representation)
+ ((check-arg-count form 1))
(let ((arg (%cadr form)))
(emit-car/cdr arg target representation "cdr")))
-(defun p2-cons (form target representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-cons))
+(define-inlined-function p2-cons (form target representation)
+ ((check-arg-count form 2))
(emit 'new +lisp-cons-class+)
(emit 'dup)
(let* ((args (%cdr form))
@@ -4687,10 +4678,8 @@
(t
(compiler-unsupported "COMPILE-QUOTE: unsupported case: ~S" form)))))
-(defun p2-rplacd (form target representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-rplacd))
+(define-inlined-function p2-rplacd (form target representation)
+ ((check-arg-count form 2))
(let ((args (cdr form)))
(compile-form (first args) 'stack nil)
(when target
@@ -4704,10 +4693,8 @@
(fix-boxing representation nil)
(emit-move-from-stack target representation))))
-(defun p2-set-car/cdr (form target representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-set-car/cdr))
+(define-inlined-function p2-set-car/cdr (form target representation)
+ ((check-arg-count form 2))
(let ((op (%car form))
(args (%cdr form)))
(compile-form (%car args) 'stack nil)
@@ -4988,10 +4975,8 @@
(emit-invokespecial-init +lisp-fixnum-class+ '("I")))))
(defknown p2-ash (t t t) t)
-(defun p2-ash (form target representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-ash))
+(define-inlined-function p2-ash (form target representation)
+ ((check-arg-count form 2))
(let* ((args (%cdr form))
(arg1 (%car args))
(arg2 (%cadr args))
@@ -5328,10 +5313,8 @@
(p2-logxor new-form target representation))))))
(defknown p2-lognot (t t t) t)
-(defun p2-lognot (form target representation)
- (unless (check-arg-count form 1)
- (compile-function-call form target representation)
- (return-from p2-lognot))
+(define-inlined-function p2-lognot (form target representation)
+ ((check-arg-count form 1))
(cond ((and (fixnum-type-p (derive-compiler-type form)))
(let ((arg (%cadr form)))
(new-fixnum (null representation))
@@ -5349,11 +5332,8 @@
;; %ldb size position integer => byte
(defknown p2-%ldb (t t t) t)
-(defun p2-%ldb (form target representation)
-;; (format t "~&p2-%ldb~%")
- (unless (check-arg-count form 3)
- (compile-function-call form target representation)
- (return-from p2-%ldb))
+(define-inlined-function p2-%ldb (form target representation)
+ ((check-arg-count form 3))
(let* ((args (cdr form))
(size-arg (%car args))
(position-arg (%cadr args))
@@ -5422,10 +5402,8 @@
(compile-function-call form target representation)))))
(defknown p2-mod (t t t) t)
-(defun p2-mod (form target representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-mod))
+(define-inlined-function p2-mod (form target representation)
+ ((check-arg-count form 2))
(let* ((args (cdr form))
(arg1 (%car args))
(arg2 (%cadr args))
@@ -5483,11 +5461,9 @@
;; (emit-move-from-stack target representation)))
(defknown p2-zerop (t t t) t)
-(defun p2-zerop (form target representation)
- (aver (or (null representation) (eq representation :boolean)))
- (unless (check-arg-count form 1)
- (compile-function-call form target representation)
- (return-from p2-zerop))
+(define-inlined-function p2-zerop (form target representation)
+ ((aver (or (null representation) (eq representation :boolean)))
+ (check-arg-count form 1))
(let* ((arg (cadr form))
(type (derive-compiler-type arg)))
(cond ((fixnum-type-p type)
@@ -5585,10 +5561,8 @@
(compile-function-call form target representation)))))
(defknown p2-std-slot-value (t t t) t)
-(defun p2-std-slot-value (form target representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-std-slot-value))
+(define-inlined-function p2-std-slot-value (form target representation)
+ ((check-arg-count form 2))
(let* ((args (cdr form))
(arg1 (first args))
(arg2 (second args)))
@@ -5601,10 +5575,8 @@
;; set-std-slot-value instance slot-name new-value => new-value
(defknown p2-set-std-slot-value (t t t) t)
-(defun p2-set-std-slot-value (form target representation)
- (unless (check-arg-count form 3)
- (compile-function-call form target representation)
- (return-from p2-set-std-slot-value))
+(define-inlined-function p2-set-std-slot-value (form target representation)
+ ((check-arg-count form 3))
(let* ((args (cdr form))
(arg1 (first args))
(arg2 (second args))
@@ -5641,14 +5613,12 @@
(compile-function-call form target representation))))
;; make-sequence result-type size &key initial-element => sequence
-(defun p2-make-sequence (form target representation)
+(define-inlined-function p2-make-sequence (form target representation)
;; In safe code, we want to make sure the requested length does not exceed
;; ARRAY-DIMENSION-LIMIT.
- (unless (and (< *safety* 3)
+ ((and (< *safety* 3)
(= (length form) 3)
- (null representation))
- (compile-function-call form target representation)
- (return-from p2-make-sequence))
+ (null representation)))
(let* ((args (cdr form))
(arg1 (first args))
(arg2 (second args)))
@@ -5734,10 +5704,8 @@
(compile-function-call form target representation))))
(defknown p2-stream-element-type (t t t) t)
-(defun p2-stream-element-type (form target representation)
- (unless (check-arg-count form 1)
- (compile-function-call form target representation)
- (return-from p2-stream-element-type))
+(define-inlined-function p2-stream-element-type (form target representation)
+ ((check-arg-count form 1))
(let ((arg (%cadr form)))
(cond ((eq (derive-compiler-type arg) 'STREAM)
(compile-forms-and-maybe-emit-clear-values arg 'stack nil)
@@ -5750,10 +5718,8 @@
;; write-8-bits byte stream => nil
(defknown p2-write-8-bits (t t t) t)
-(defun p2-write-8-bits (form target representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-write-8-bits))
+(define-inlined-function p2-write-8-bits (form target representation)
+ ((check-arg-count form 2))
(let* ((arg1 (%cadr form))
(arg2 (%caddr form))
(type1 (derive-compiler-type arg1))
@@ -6325,10 +6291,8 @@
(setf (car form) (if (eq test 'eq) 'delete-eq 'delete-eql)))))))
(compile-function-call form target representation))
-(defun p2-length (form target representation)
- (unless (check-arg-count form 1)
- (compile-function-call form target representation)
- (return-from p2-length))
+(define-inlined-function p2-length (form target representation)
+ ((check-arg-count form 1))
(let ((arg (cadr form)))
(compile-forms-and-maybe-emit-clear-values arg 'stack nil)
(case representation
@@ -6443,10 +6407,8 @@
(t
(compile-function-call form target representation)))))
-(defun compile-nth (form target representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from compile-nth))
+(define-inlined-function compile-nth (form target representation)
+ ((check-arg-count form 2))
(let ((index-form (second form))
(list-form (third form)))
(compile-forms-and-maybe-emit-clear-values index-form 'stack :int
@@ -6783,10 +6745,8 @@
;; char/schar string index => character
(defknown p2-char/schar (t t t) t)
-(defun p2-char/schar (form target representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-char/schar))
+(define-inlined-function p2-char/schar (form target representation)
+ ((check-arg-count form 2))
(let* ((op (%car form))
(args (%cdr form))
(arg1 (%car args))
@@ -6827,11 +6787,8 @@
;; set-char/schar string index character => character
(defknown p2-set-char/schar (t t t) t)
-(defun p2-set-char/schar (form target representation)
-;; (format t "p2-set-char/schar~%")
- (unless (check-arg-count form 3)
- (compile-function-call form target representation)
- (return-from p2-set-char/schar))
+(define-inlined-function p2-set-char/schar (form target representation)
+ ((check-arg-count form 3))
(let* ((op (%car form))
(args (%cdr form))
(arg1 (first args))
@@ -7054,10 +7011,8 @@
(compile-function-call form target representation))))
(defknown p2-structure-ref (t t t) t)
-(defun p2-structure-ref (form target representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-structure-ref))
+(define-inlined-function p2-structure-ref (form target representation)
+ ((check-arg-count form 2))
(let* ((args (cdr form))
(arg1 (first args))
(arg2 (second args)))
@@ -7109,10 +7064,8 @@
(compile-function-call form target representation)))))
(defknown p2-structure-set (t t t) t)
-(defun p2-structure-set (form target representation)
- (unless (check-arg-count form 3)
- (compile-function-call form target representation)
- (return-from p2-structure-set))
+(define-inlined-function p2-structure-set (form target representation)
+ ((check-arg-count form 3))
(let* ((args (cdr form))
(arg1 (first args))
(arg2 (second args))
@@ -7153,11 +7106,9 @@
(compile-function-call form target representation)))))
-(defun p2-not/null (form target representation)
- (aver (or (null representation) (eq representation :boolean)))
- (unless (check-arg-count form 1)
- (compile-function-call form target representation)
- (return-from p2-not/null))
+(define-inlined-function p2-not/null (form target representation)
+ ((aver (or (null representation) (eq representation :boolean)))
+ (check-arg-count form 1))
(let ((arg (second form)))
(cond ((null arg)
(emit-push-true representation))
@@ -7202,10 +7153,8 @@
(label LABEL2)))))
(emit-move-from-stack target representation))
-(defun p2-nthcdr (form target representation)
- (unless (check-arg-count form 2)
- (compile-function-call form target representation)
- (return-from p2-nthcdr))
+(define-inlined-function p2-nthcdr (form target representation)
+ ((check-arg-count form 2))
(let* ((args (%cdr form))
(arg1 (%car args))
(arg2 (%cadr args)))
@@ -7669,10 +7618,8 @@
(compile-function-call form target representation))))
(defknown p2-symbol-name (t t t) t)
-(defun p2-symbol-name (form target representation)
- (unless (check-arg-count form 1)
- (compile-function-call form target representation)
- (return-from p2-symbol-name))
+(define-inlined-function p2-symbol-name (form target representation)
+ ((check-arg-count form 1))
(let ((arg (%cadr form)))
(cond ((and (eq (derive-compiler-type arg) 'SYMBOL) (< *safety* 3))
(compile-forms-and-maybe-emit-clear-values arg 'stack nil)
@@ -7683,10 +7630,8 @@
(compile-function-call form target representation)))))
(defknown p2-symbol-package (t t t) t)
-(defun p2-symbol-package (form target representation)
- (unless (check-arg-count form 1)
- (compile-function-call form target representation)
- (return-from p2-symbol-package))
+(define-inlined-function p2-symbol-package (form target representation)
+ ((check-arg-count form 1))
(let ((arg (%cadr form)))
(cond ((and (eq (derive-compiler-type arg) 'SYMBOL) (< *safety* 3))
(compile-forms-and-maybe-emit-clear-values arg 'stack nil)
@@ -7774,10 +7719,8 @@
(compile-form (third form) target representation))
(defknown p2-char-code (t t t) t)
-(defun p2-char-code (form target representation)
- (unless (check-arg-count form 1)
- (compile-function-call form target representation)
- (return-from p2-char-code))
+(define-inlined-function p2-char-code (form target representation)
+ ((check-arg-count form 1))
(let ((arg (second form)))
(cond ((characterp arg)
(compile-constant (char-code arg) target representation))
@@ -7791,33 +7734,27 @@
(compile-function-call form target representation)))))
(defknown p2-java-jclass (t t t) t)
-(defun p2-java-jclass (form target representation)
- (unless (and (= 2 (length form))
- (stringp (cadr form)))
- (compile-function-call form target representation)
- (return-from p2-java-jclass))
+(define-inlined-function p2-java-jclass (form target representation)
+ ((and (= 2 (length form))
+ (stringp (cadr form))))
(let ((c (ignore-errors (java:jclass (cadr form)))))
(if c (compile-constant c target representation)
;; delay resolving the method to run-time; it's unavailable now
(compile-function-call form target representation))))
(defknown p2-java-jconstructor (t t t) t)
-(defun p2-java-jconstructor (form target representation)
- (unless (and (< 1 (length form))
- (every #'stringp (cdr form)))
- (compile-function-call form target representation)
- (return-from p2-java-jconstructor))
+(define-inlined-function p2-java-jconstructor (form target representation)
+ ((and (< 1 (length form))
+ (every #'stringp (cdr form))))
(let ((c (ignore-errors (apply #'java:jconstructor (cdr form)))))
(if c (compile-constant c target representation)
;; delay resolving the method to run-time; it's unavailable now
(compile-function-call form target representation))))
(defknown p2-java-jmethod (t t t) t)
-(defun p2-java-jmethod (form target representation)
- (unless (and (< 1 (length form))
- (every #'stringp (cdr form)))
- (compile-function-call form target representation)
- (return-from p2-java-jmethod))
+(define-inlined-function p2-java-jmethod (form target representation)
+ ((and (< 1 (length form))
+ (every #'stringp (cdr form))))
(let ((m (ignore-errors (apply #'java:jmethod (cdr form)))))
(if m (compile-constant m target representation)
;; delay resolving the method to run-time; it's unavailable now
More information about the armedbear-cvs
mailing list