Changeset 12964 for trunk/abcl/src/org


Ignore:
Timestamp:
10/09/10 20:40:53 (11 years ago)
Author:
ehuelsmann
Message:

Don't inline constructors, from where I stand - and without reference
to why they were introduced - these can't make a measurable impact
on our performance.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12932 r12964  
    45614561      (fix-boxing representation nil)
    45624562      (emit-move-from-stack target representation))))
    4563 
    4564 (defun p2-make-array (form target representation)
    4565   ;; In safe code, we want to make sure the requested length does not exceed
    4566   ;; ARRAY-DIMENSION-LIMIT.
    4567   (cond ((and (< *safety* 3)
    4568               (= (length form) 2)
    4569               (fixnum-type-p (derive-compiler-type (second form)))
    4570               (null representation))
    4571          (let ((arg (second form)))
    4572            (emit-new +lisp-simple-vector+)
    4573            (emit 'dup)
    4574      (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    4575            (emit-invokespecial-init +lisp-simple-vector+ '(:int))
    4576            (emit-move-from-stack target representation)))
    4577         (t
    4578          (compile-function-call form target representation))))
    4579 
    4580 ;; make-sequence result-type size &key initial-element => sequence
    4581 (define-inlined-function p2-make-sequence (form target representation)
    4582   ;; In safe code, we want to make sure the requested length does not exceed
    4583   ;; ARRAY-DIMENSION-LIMIT.
    4584   ((and (< *safety* 3)
    4585                (= (length form) 3)
    4586                (null representation)))
    4587   (let* ((args (cdr form))
    4588          (arg1 (first args))
    4589          (arg2 (second args)))
    4590     (when (and (consp arg1)
    4591                (= (length arg1) 2)
    4592                (eq (first arg1) 'QUOTE))
    4593       (let* ((result-type (second arg1))
    4594              (class
    4595               (case result-type
    4596                 ((STRING SIMPLE-STRING)
    4597                  (setf class +lisp-simple-string+))
    4598                 ((VECTOR SIMPLE-VECTOR)
    4599                  (setf class +lisp-simple-vector+)))))
    4600         (when class
    4601           (emit-new class)
    4602           (emit 'dup)
    4603     (compile-forms-and-maybe-emit-clear-values arg2 'stack :int)
    4604           (emit-invokespecial-init class '(:int))
    4605           (emit-move-from-stack target representation)
    4606           (return-from p2-make-sequence)))))
    4607   (compile-function-call form target representation))
    4608 
    4609 (defun p2-make-string (form target representation)
    4610   ;; In safe code, we want to make sure the requested length does not exceed
    4611   ;; ARRAY-DIMENSION-LIMIT.
    4612   (cond ((and (< *safety* 3)
    4613               (= (length form) 2)
    4614               (null representation))
    4615          (let ((arg (second form)))
    4616            (emit-new +lisp-simple-string+)
    4617            (emit 'dup)
    4618      (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    4619            (emit-invokespecial-init +lisp-simple-string+ '(:int))
    4620            (emit-move-from-stack target representation)))
    4621         (t
    4622          (compile-function-call form target representation))))
    4623 
    4624 (defun p2-%make-structure (form target representation)
    4625   (cond ((and (check-arg-count form 2)
    4626               (eq (derive-type (%cadr form)) 'SYMBOL))
    4627          (emit-new +lisp-structure-object+)
    4628          (emit 'dup)
    4629          (compile-form (%cadr form) 'stack nil)
    4630          (emit-checkcast +lisp-symbol+)
    4631          (compile-form (%caddr form) 'stack nil)
    4632          (maybe-emit-clear-values (%cadr form) (%caddr form))
    4633          (emit-invokevirtual +lisp-object+ "copyToArray"
    4634                              nil +lisp-object-array+)
    4635          (emit-invokespecial-init +lisp-structure-object+
    4636                                   (list +lisp-symbol+ +lisp-object-array+))
    4637          (emit-move-from-stack target representation))
    4638         (t
    4639          (compile-function-call form target representation))))
    4640 
    4641 (defun p2-make-structure (form target representation)
    4642   (let* ((args (cdr form))
    4643          (slot-forms (cdr args))
    4644          (slot-count (length slot-forms)))
    4645     (cond ((and (<= 1 slot-count 6)
    4646                 (eq (derive-type (%car args)) 'SYMBOL))
    4647            (emit-new +lisp-structure-object+)
    4648            (emit 'dup)
    4649            (compile-form (%car args) 'stack nil)
    4650            (emit-checkcast +lisp-symbol+)
    4651            (dolist (slot-form slot-forms)
    4652              (compile-form slot-form 'stack nil))
    4653            (apply 'maybe-emit-clear-values args)
    4654            (emit-invokespecial-init +lisp-structure-object+
    4655                                     (append (list +lisp-symbol+)
    4656                                             (make-list slot-count :initial-element +lisp-object+)))
    4657            (emit-move-from-stack target representation))
    4658           (t
    4659            (compile-function-call form target representation)))))
    4660 
    4661 (defun p2-make-hash-table (form target representation)
    4662   (cond ((= (length form) 1) ; no args
    4663          (emit-new +lisp-eql-hash-table+)
    4664          (emit 'dup)
    4665          (emit-invokespecial-init +lisp-eql-hash-table+ nil)
    4666          (fix-boxing representation nil)
    4667          (emit-move-from-stack target representation))
    4668         (t
    4669          (compile-function-call form target representation))))
    46704563
    46714564(defknown p2-stream-element-type (t t t) t)
     
    73437236                               progn))
    73447237  (install-p2-handler '%ldb                'p2-%ldb)
    7345   (install-p2-handler '%make-structure     'p2-%make-structure)
    73467238  (install-p2-handler '*                   'p2-times)
    73477239  (install-p2-handler '+                   'p2-plus)
     
    73987290  (install-p2-handler 'lognot              'p2-lognot)
    73997291  (install-p2-handler 'logxor              'p2-logxor)
    7400   (install-p2-handler 'make-array          'p2-make-array)
    7401   (install-p2-handler 'make-hash-table     'p2-make-hash-table)
    7402   (install-p2-handler 'make-sequence       'p2-make-sequence)
    7403   (install-p2-handler 'make-string         'p2-make-string)
    7404   (install-p2-handler 'make-structure      'p2-make-structure)
    74057292  (install-p2-handler 'max                 'p2-min/max)
    74067293  (install-p2-handler 'memq                'p2-memq)
Note: See TracChangeset for help on using the changeset viewer.