Changeset 12714


Ignore:
Timestamp:
05/21/10 20:55:58 (12 years ago)
Author:
vvoutilainen
Message:

Remove commented-out code.

File:
1 edited

Legend:

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

    r12711 r12714  
    479479  (let* ((block-name (fdefinition-block-name name))
    480480         (expansion (generate-inline-expansion block-name lambda-list body)))
    481 ;;     (format t "expansion = ~S~%" expansion)
    482481    `(progn
    483482       (%defun ',name (lambda ,lambda-list (block ,block-name ,@body)))
     
    905904  (dolist (form forms)
    906905    (unless (single-valued-p form)
    907 ;;       (let ((*print-structure* nil))
    908 ;;         (format t "Not single-valued: ~S~%" form))
    909906      (ensure-thread-var-initialized)
    910907      (emit 'clear-values)
     
    12421239;; ldc2_w
    12431240(define-resolver 20 (instruction)
    1244 ;;   (format t "resolving ldc2_w...~%")
    12451241  (let* ((args (instruction-args instruction)))
    1246 ;;     (format t "args = ~S~%" args)
    12471242    (unless (= (length args) 1)
    12481243      (error "Wrong number of args for LDC2_W."))
    1249 ;;     (if (> (car args) 255)
    1250 ;;         (inst 19 (u2 (car args))) ; LDC_W
    1251 ;;         (inst 18 args))))
    12521244    (inst 20 (u2 (car args)))))
    12531245
     
    12981290          (t
    12991291           (vector-push-extend (resolve-instruction instruction) vector)))))))
    1300 
    1301 ;; (defconstant +branch-opcodes+
    1302 ;;   '(153 ; IFEQ
    1303 ;;     154 ; IFNE
    1304 ;;     155 ; IFLT
    1305 ;;     156 ; IFGE
    1306 ;;     157 ; IFGT
    1307 ;;     158 ; IFLE
    1308 ;;     159 ; IF_ICMPEQ
    1309 ;;     160 ; IF_ICMPNE
    1310 ;;     161 ; IF_ICMPLT
    1311 ;;     162 ; IF_ICMPGE
    1312 ;;     163 ; IF_ICMPGT
    1313 ;;     164 ; IF_ICMPLE
    1314 ;;     165 ; IF_ACMPEQ
    1315 ;;     166 ; IF_ACMPNE
    1316 ;;     167 ; GOTO
    1317 ;;     168 ; JSR
    1318 ;;     198 ; IFNULL
    1319 ;;     ))
    13201292
    13211293(declaim (ftype (function (t) t) branch-opcode-p))
     
    13931365          (when instruction-depth
    13941366            (setf max-stack (max max-stack (the fixnum instruction-depth))))))
    1395 ;;       (when *compiler-debug*
    1396 ;;         (sys::%format t "compiland name = ~S~%" (compiland-name *current-compiland*))
    1397 ;;         (sys::%format t "max-stack = ~D~%" max-stack)
    1398 ;;         (sys::%format t "----- after stack analysis -----~%")
    1399 ;;         (print-code))
    14001367      max-stack)))
    14011368
     
    14281395(declaim (ftype (function (t) boolean) label-p))
    14291396(defun label-p (instruction)
    1430 ;;   (declare (optimize safety))
    1431 ;;   (declare (type instruction instruction))
    14321397  (and instruction
    14331398       (= (the fixnum (instruction-opcode (the instruction instruction))) 202)))
     
    14351400(declaim (ftype (function (t) t) instruction-label))
    14361401(defun instruction-label (instruction)
    1437 ;;   (declare (optimize safety))
    14381402  (and instruction
    14391403       (= (instruction-opcode (the instruction instruction)) 202)
     
    14931457                            (setf (aref code j) nil)
    14941458                            (setf changed t))
    1495                            (;;(equal next-instruction instruction)
    1496                             (eq (car (instruction-args next-instruction))
     1459                           ((eq (car (instruction-args next-instruction))
    14971460                                (car (instruction-args instruction)))
    14981461                            ;; We've reached another GOTO to the same destination.
     
    19391902    (emit 'return)
    19401903    (finalize-code)
    1941     ;;(optimize-code)
    19421904    (setf *code* (resolve-instructions *code*))
    19431905    (setf (method-max-stack constructor) (analyze-stack))
     
    22362198         (funcall dispatch-fn object)
    22372199         (emit 'putstatic *this-class* field-name field-type))
    2238         (t ;; *file-compilation* and (not *declare-inline*)
     2200        (t
    22392201         (let ((*code* *static-code*))
    22402202           (funcall dispatch-fn object)
     
    30453007         form)))
    30463008
    3047 ;; (define-source-transform min (&whole form &rest args)
    3048 ;;   (cond ((= (length args) 2)
    3049 ;;          (let* ((arg1 (%car args))
    3050 ;;                 (arg2 (%cadr args))
    3051 ;;                 (sym1 (gensym))
    3052 ;;                 (sym2 (gensym)))
    3053 ;;            `(let ((,sym1 ,arg1)
    3054 ;;                   (,sym2 ,arg2))
    3055 ;;               (if (<= ,sym1 ,sym2) ,sym1 ,sym2))))
    3056 ;;         (t
    3057 ;;          form)))
    3058 
    3059 ;; (define-source-transform max (&whole form &rest args)
    3060 ;;   (cond ((= (length args) 2)
    3061 ;;          (let* ((arg1 (%car args))
    3062 ;;                 (arg2 (%cadr args))
    3063 ;;                 (sym1 (gensym))
    3064 ;;                 (sym2 (gensym)))
    3065 ;;            `(let ((,sym1 ,arg1)
    3066 ;;                   (,sym2 ,arg2))
    3067 ;;               (if (>= ,sym1 ,sym2) ,sym1 ,sym2))))
    3068 ;;         (t
    3069 ;;          form)))
    3070 
    30713009(defknown p2-funcall (t t t) t)
    30723010(defun p2-funcall (form target representation)
     
    30793017  (compile-forms-and-maybe-emit-clear-values (cadr form) 'stack nil)
    30803018  (compile-call (cddr form))
    3081 ;;   (case representation
    3082 ;;     (:int (emit-unbox-fixnum))
    3083 ;;     (:char (emit-unbox-character)))
    30843019  (fix-boxing representation nil)
    30853020  (emit-move-from-stack target))
     
    32943229  (let ((ht (make-hash-table :test 'eq)))
    32953230    (dolist (pair '(
    3296 ;;                     (CHAR= p2-test-char=)
    32973231                    (/=                 p2-test-/=)
    32983232                    (<                  p2-test-numeric-comparison)
     
    35893523
    35903524(defun p2-test-equality (form)
    3591 ;;   (format t "p2-test-equality ~S~%" (%car form))
    35923525  (when (check-arg-count form 2)
    35933526    (let* ((op (%car form))
    35943527           (translated-op (ecase op
    3595 ;;                             (EQL    "eql")
    35963528                            (EQUAL  "equal")
    35973529                            (EQUALP "equalp")))
     
    37983730        (t
    37993731         (dolist (arg args)
    3800 ;;            (let ((type (derive-compiler-type arg)))
    3801 ;;              (cond
    3802 ;;               ((eq type 'BOOLEAN)
    38033732     (compile-forms-and-maybe-emit-clear-values arg 'stack :boolean)
    38043733     (emit 'ifeq LABEL1)
    3805 ;;                )
    3806 ;;                    (t
    3807 ;;                     (compile-form arg 'stack nil)
    3808 ;;                     (maybe-emit-clear-values arg)
    3809 ;;                     (emit-push-nil)
    3810 ;;                     (emit 'if_acmpeq LABEL1))
    3811 ;;                    )
    3812 ;;              )
    38133734           )
    38143735         (compile-form consequent target representation)
     
    38203741(defknown p2-if-not-and (t t t) t)
    38213742(defun p2-if-not-and (form target representation)
    3822 ;;   (format t "p2-if-not-and~%")
    3823 ;;   (aver (eq (first form) 'IF))
    3824 ;;   (aver (consp (second form)))
    3825 ;;   (aver (memq (first (second form)) '(NOT NULL)))
    3826 ;;   (aver (eq (first (second (second form))) 'AND))
    38273743  (let* ((inverted-test (second (second form)))
    38283744         (consequent (third form))
     
    38303746         (LABEL1 (gensym))
    38313747         (LABEL2 (gensym)))
    3832 ;;     (aver (and (consp inverted-test) (eq (car inverted-test) 'AND)))
    38333748    (let* ((args (cdr inverted-test)))
    38343749      (case (length args)
     
    40073922(declaim (ftype (function (t) t) compile-binding))
    40083923(defun compile-binding (variable)
    4009 ;;  (dump-1-variable variable)
    40103924  (cond ((variable-register variable)
    40113925         (astore (variable-register variable)))
     
    40563970   (emit-push-current-thread)
    40573971   (aload register)
    4058 ;;   (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
    4059 ;;  +lisp-special-binding+)
    40603972   (emit-invokevirtual +lisp-thread-class+ "resetSpecialBindings"
    40613973                       (list +lisp-special-bindings-mark+) nil)
     
    40643976(defun save-dynamic-environment (register)
    40653977   (emit-push-current-thread)
    4066 ;;   (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
    4067 ;;  +lisp-special-binding+)
    40683978   (emit-invokevirtual +lisp-thread-class+ "markSpecialBindings"
    40693979                       nil +lisp-special-bindings-mark+)
     
    45764486             (unless must-clear-values
    45774487               (unless (single-valued-p subform)
    4578 ;;                  (let ((*print-structure* nil))
    4579 ;;                    (format t "not single-valued: ~S~%" subform))
    45804488                 (setf must-clear-values t))))))
    45814489    (label END-BLOCK)
     
    48204728        (unless (enclosed-by-protected-block-p block)
    48214729          (unless (compiland-single-valued-p *current-compiland*)
    4822 ;;               (format t "compiland not single-valued: ~S~%"
    4823 ;;                       (compiland-name *current-compiland*))
    48244730            (emit-clear-values))
    48254731          (compile-form result-form (block-target block) nil)
     
    52265132         (constant-shift (fixnum-constant-value type2))
    52275133         (result-type (derive-compiler-type form)))
    5228 ;;     (format t "~&p2-ash type1 = ~S~%" type1)
    5229 ;;     (format t "p2-ash type2 = ~S~%" type2)
    5230 ;;     (format t "p2-ash result-type = ~S~%" result-type)
    5231 ;;     (format t "p2-ash representation = ~S~%" representation)
    52325134    (cond ((and (integerp arg1) (integerp arg2))
    52335135           (compile-constant (ash arg1 arg2) target representation))
     
    53015203                  (convert-representation :long representation))
    53025204                 (t
    5303 ;;                   (format t "p2-ash call to LispObject.ash(int)~%")
    5304 ;;                   (format t "p2-ash type1 = ~S type2 = ~S~%" type1 type2)
    5305 ;;                   (format t "p2-ash result-type = ~S~%" result-type)
    53065205      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    53075206                   arg2 'stack :int)
     
    53105209           (emit-move-from-stack target representation))
    53115210          (t
    5312 ;;            (format t "p2-ash full call~%")
    53135211           (compile-function-call form target representation)))))
    53145212
    53155213(defknown p2-logand (t t t) t)
    53165214(defun p2-logand (form target representation)
    5317   (let* ((args (cdr form))
    5318 ;;          (len (length args))
    5319          )
    5320 ;;     (cond ((= len 2)
     5215  (let* ((args (cdr form)))
    53215216    (case (length args)
    53225217      (2
     
    53265221              (type2 (derive-compiler-type arg2))
    53275222              (result-type (derive-compiler-type form)))
    5328          ;;              (let ((*print-structure* nil))
    5329          ;;                (format t "~&p2-logand arg1 = ~S~%" arg1)
    5330          ;;                (format t "p2-logand arg2 = ~S~%" arg2))
    5331          ;;              (format t "~&p2-logand type1 = ~S~%" type1)
    5332          ;;              (format t "p2-logand type2 = ~S~%" type2)
    5333          ;;              (format t "p2-logand result-type = ~S~%" result-type)
    5334          ;;              (format t "p2-logand representation = ~S~%" representation)
    53355223         (cond ((and (integerp arg1) (integerp arg2))
    53365224                (compile-constant (logand arg1 arg2) target representation))
     
    53455233                 arg2 nil nil))
    53465234               ((and (fixnum-type-p type1) (fixnum-type-p type2))
    5347                 ;;                     (format t "p2-logand fixnum case~%")
    53485235                ;; Both arguments are fixnums.
    53495236    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     
    53805267                (emit-move-from-stack target representation))
    53815268               ((fixnum-type-p type2)
    5382                 ;;                     (format t "p2-logand LispObject.LOGAND(int) 1~%")
    53835269    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    53845270                 arg2 'stack :int)
     
    53875273                (emit-move-from-stack target representation))
    53885274               ((fixnum-type-p type1)
    5389                 ;;                     (format t "p2-logand LispObject.LOGAND(int) 2~%")
    53905275                ;; arg1 is a fixnum, but arg2 is not
    53915276    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     
    53975282                (emit-move-from-stack target representation))
    53985283               (t
    5399                 ;;                     (format t "p2-logand LispObject.LOGAND(LispObject)~%")
    54005284    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    54015285                 arg2 'stack nil)
     
    55095393                (emit 'ixor))
    55105394               ((and (fixnum-type-p type1) (fixnum-type-p type2))
    5511 ;;                 (format t "p2-logxor case 2~%")
    55125395    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    55135396                 arg2 'stack :int)
     
    56515534           (emit-move-from-stack target representation)))))
    56525535
    5653 ;; (defknown p2-integerp (t t t) t)
    5654 ;; (defun p2-integerp (form target representation)
    5655 ;;   (unless (check-arg-count form 1)
    5656 ;;     (compile-function-call form target representation)
    5657 ;;     (return-from p2-integerp))
    5658 ;;   (let ((arg (cadr form)))
    5659 ;;     (compile-form arg 'stack nil)
    5660 ;;     (maybe-emit-clear-values arg)
    5661 ;;     (case representation
    5662 ;;       (:boolean
    5663 ;;        (emit-invokevirtual +lisp-object-class+ "integerp" nil "Z"))
    5664 ;;       (t
    5665 ;;        (emit-invokevirtual +lisp-object-class+ "INTEGERP" nil +lisp-object+)))
    5666 ;;     (emit-move-from-stack target representation)))
    5667 
    5668 ;; (defknown p2-listp (t t t) t)
    5669 ;; (defun p2-listp (form target representation)
    5670 ;;   (unless (check-arg-count form 1)
    5671 ;;     (compile-function-call form target representation)
    5672 ;;     (return-from p2-listp))
    5673 ;;   (let ((arg (cadr form)))
    5674 ;;     (compile-form arg 'stack nil)
    5675 ;;     (maybe-emit-clear-values arg)
    5676 ;;     (case representation
    5677 ;;       (:boolean
    5678 ;;        (emit-invokevirtual +lisp-object-class+ "listp" nil "Z"))
    5679 ;;       (t
    5680 ;;        (emit-invokevirtual +lisp-object-class+ "LISTP" nil +lisp-object+)))
    5681 ;;     (emit-move-from-stack target representation)))
    5682 
    56835536(defknown p2-zerop (t t t) t)
    56845537(define-inlined-function p2-zerop (form target representation)
     
    59695822
    59705823(defun p2-read-line (form target representation)
    5971 ;;   (format t "p2-read-line~%")
    59725824  (let* ((args (cdr form))
    59735825         (len (length args)))
     
    59775829              (type1 (derive-compiler-type arg1)))
    59785830         (cond ((compiler-subtypep type1 'stream)
    5979 ;;                 (format t "p2-read-line optimized case 1~%")
    59805831    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    59815832                (emit 'checkcast +lisp-stream-class+)
     
    59925843              (arg2 (%cadr args)))
    59935844         (cond ((and (compiler-subtypep type1 'stream) (null arg2))
    5994 ;;                 (format t "p2-read-line optimized case 2~%")
    59955845    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    59965846                (emit 'checkcast +lisp-stream-class+)
     
    60985948                (setf result-high (if (and high1 high2)
    60995949                                      (min high1 high2)
    6100                                       (or high1 high2)))
    6101 ;;                 (setf result-type (make-integer-type (list 'INTEGER result-low result-high)))
    6102                 )
     5950                                      (or high1 high2))))
    61035951               ((and low1 (>= low1 0))
    61045952                ;; arg1 is non-negative
    61055953                (dformat t "arg1 is non-negative~%")
    61065954                (setf result-low 0)
    6107                 (setf result-high high1)
    6108 ;;                 (setf result-type (make-integer-type (list 'INTEGER 0 high1)))
    6109                 )
     5955                (setf result-high high1))
    61105956               ((and low2 (>= low2 0))
    61115957                ;; arg2 is non-negative
    61125958                (dformat t "arg2 is non-negative~%")
    61135959                (setf result-low 0)
    6114                 (setf result-high high2)
    6115 ;;                 (setf result-type (make-integer-type (list 'INTEGER 0 high2)))
    6116                 ))
     5960                (setf result-high high2)))
    61175961         (dformat t "result-low = ~S~%" result-low)
    61185962         (dformat t "result-high = ~S~%" result-high)
     
    64396283                 (READ-CHAR
    64406284                  (derive-type-read-char form))
    6441 ;;                  (SETQ
    6442 ;;                   (if (= (length form) 3)
    6443 ;;                       (derive-type (third form))
    6444 ;;                       t))
    64456285                 ((THE TRULY-THE)
    64466286                  (second form))
     
    66716511        (emit-move-from-stack target representation))
    66726512             ((fixnump arg2)
    6673 ;;               (format t "p2-times case 3~%")
    66746513        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    66756514              (emit-push-int arg2)
     
    67546593            (result-type (derive-compiler-type form))
    67556594            (result-rep (type-representation result-type)))
    6756 ;;         (let ((*print-structure* nil))
    6757 ;;           (format t "~&p2-plus arg1 = ~S~%" arg1)
    6758 ;;           (format t "p2-plus arg2 = ~S~%" arg2))
    6759 ;;         (format t "~&p2-plus type1 = ~S~%" type1)
    6760 ;;         (format t "p2-plus type2 = ~S~%" type2)
    6761 ;;         (format t "p2-plus result-type = ~S~%" result-type)
    6762 ;;         (format t "p2-plus result-rep = ~S~%" result-rep)
    6763 ;;         (format t "p2-plus representation = ~S~%" representation)
    67646595       (cond ((and (numberp arg1) (numberp arg2))
    67656596              (compile-constant (+ arg1 arg2) target representation))
     
    69366767         (type2 (derive-compiler-type arg2))
    69376768         (type3 (derive-compiler-type arg3)))
    6938 ;;     (format t "p2-set-char/schar type1 = ~S~%" type1)
    6939 ;;     (format t "p2-set-char/schar type2 = ~S~%" type2)
    6940 ;;     (format t "p2-set-char/schar type3 = ~S~%" type3)
    69416769    (cond ((and (< *safety* 3)
    69426770                (or (null representation) (eq representation :char))
     
    69636791               (emit-move-from-stack target representation))))
    69646792          (t
    6965 ;;            (format t "p2-set-char/schar not optimized~%")
    69666793           (compile-function-call form target representation)))))
    69676794
     
    70846911                (type3 (derive-compiler-type arg3))
    70856912                (*register* *register*)
    7086                 (value-register (unless (null target) (allocate-register)))
    7087 ;;                 (array-derived-type t)
    7088                 )
    7089 
    7090 ;;            (format t "p2-aset type3 = ~S~%" type3)
    7091 
    7092 ;;            (when (symbolp arg1)
    7093 ;;              (let ((variable (find-visible-variable (second form))))
    7094 ;;                (when variable
    7095 ;;                  (setf array-derived-type (derive-type variable)))))
     6913                (value-register (unless (null target) (allocate-register))))
    70966914           ;; array
    70976915           (compile-form arg1 'stack nil)
     
    70996917           (compile-form arg2 'stack :int)
    71006918           ;; value
    7101 ;;            (cond ((subtypep array-derived-type '(array (unsigned-byte 8)))
    7102 ;;                   (compile-form (fourth form) 'stack :int)
    7103 ;;                   (when value-register
    7104 ;;                     (emit 'dup)
    7105 ;;                     (emit-move-from-stack value-register :int)))
    7106 ;;                  (t
    7107 ;;                   (compile-form (fourth form) 'stack nil)
    7108 ;;                   (when value-register
    7109 ;;                     (emit 'dup)
    7110 ;;                     (emit-move-from-stack value-register nil))))
    71116919           (cond ((fixnum-type-p type3)
    71126920                  (compile-form arg3 'stack :int)
     
    71196927                    (emit 'dup)
    71206928                    (emit-move-from-stack value-register nil))))
    7121 
    7122 ;;            (unless (and (single-valued-p (second form))
    7123 ;;                         (single-valued-p (third form))
    7124 ;;                         (single-valued-p (fourth form)))
    7125 ;;              (emit-clear-values))
    71266929           (maybe-emit-clear-values arg1 arg2 arg3)
    7127 
    7128            (cond (;;(subtypep array-derived-type '(array (unsigned-byte 8)))
    7129                   (fixnum-type-p type3)
     6930           (cond ((fixnum-type-p type3)
    71306931                  (emit-invokevirtual +lisp-object-class+ "aset" '("I" "I") nil))
    71316932                 (t
     
    74997300          (return-from p2-setq (compile-form (p1 new-form) target representation))))
    75007301      ;; We're setting a special variable.
    7501 ;;       (let ((*print-structure* nil))
    7502 ;;         (format t "p2-setq name = ~S value-form = ~S~%" name value-form))
    75037302      (cond ((and variable
    75047303                  (variable-binding-register variable)
     
    75167315                  (var-ref-p (third value-form))
    75177316                  (eq (variable-name (var-ref-variable (third value-form))) name))
    7518              ;; (push thing *special*) => (setq *special* (cons thing *special*))
    7519 ;;              (format t "compiling pushSpecial~%")
    75207317             (emit-push-current-thread)
    75217318             (emit-load-externalized-object name)
     
    76907487  (let ((type-form (second form))
    76917488        (value-form (third form)))
    7692 ;;     (let ((*print-structure* nil))
    7693 ;;       (format t "p2-the type-form = ~S value-form = ~S~%" type-form value-form))
    76947489    (cond ((and (subtypep type-form 'FIXNUM)
    76957490                (consp value-form)
     
    81867981                  '(:int :long))
    81877982        (emit-push-variable variable)
    8188 ;;        (sys::%format t "declared type: ~S~%" (variable-declared-type variable))
    81897983        (derive-variable-representation variable nil)
    8190 ;;        (sys::%format t "representation: ~S~%" (variable-representation variable))
    81917984        (when (< 1 (representation-size (variable-representation variable)))
    81927985          (allocate-variable-register variable))
     
    81977990(defknown p2-compiland (t) t)
    81987991(defun p2-compiland (compiland)
    8199 ;;   (format t "p2-compiland name = ~S~%" (compiland-name compiland))
    82007992  (let* ((p1-result (compiland-p1-result compiland))
    82017993         (class-file (compiland-class-file compiland))
Note: See TracChangeset for help on using the changeset viewer.