Changeset 12399


Ignore:
Timestamp:
01/24/10 22:26:29 (12 years ago)
Author:
ehuelsmann
Message:

Remove debugging cruft.

File:
1 edited

Legend:

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

    r12398 r12399  
    18451845              more-keys-p allow-other-keys-p
    18461846              keys-p key-p)
    1847         (when t
    1848           ;; process required args
    1849           (emit-push-constant-int (length req))
    1850           (emit 'anewarray +lisp-closure-parameter-class+)
    1851           (astore (setf req-params-register (method-max-locals constructor)))
    1852           (incf (method-max-locals constructor))
    1853           (do ((i 0 (1+ i))
    1854                (req req (cdr req)))
    1855               ((endp req))
    1856             (aload req-params-register)
    1857             (emit-push-constant-int i)
    1858             (emit 'new +lisp-closure-parameter-class+)
    1859             (emit 'dup)
    1860             (emit-push-t) ;; we don't need the actual symbol
    1861             (emit-invokespecial-init +lisp-closure-parameter-class+
    1862                                      (list +lisp-symbol+))
    1863             (emit 'aastore)))
    1864         (when t
    1865           ;; process optional args
    1866           (emit-push-constant-int (length opt))
    1867           (emit 'anewarray +lisp-closure-parameter-class+)
    1868           (astore (setf opt-params-register (method-max-locals constructor)))
    1869           (incf (method-max-locals constructor))
    1870           (do ((i 0 (1+ i))
    1871                (opt opt (cdr opt)))
    1872               ((endp opt))
    1873             (aload opt-params-register)
    1874             (emit-push-constant-int i)
    1875             (emit 'new +lisp-closure-parameter-class+)
    1876             (emit 'dup)
    1877             (emit-push-t) ;; we don't need the actual variable-symbol
    1878             (emit-read-from-string (second (car opt))) ;; initform
    1879             (if (null (third (car opt)))      ;;
    1880                 (emit-push-nil)
    1881                 (emit-push-t)) ;; we don't need the actual supplied-p symbol
    1882             (emit 'getstatic +lisp-closure-class+ "OPTIONAL" "I")
    1883             (emit-invokespecial-init +lisp-closure-parameter-class+
    1884                                      (list +lisp-symbol+ +lisp-object+
    1885                                            +lisp-object+ "I"))
    1886             (emit 'aastore)))
    1887         (when t
    1888           ;; process key args
    1889           (emit-push-constant-int (length key))
    1890           (emit 'anewarray +lisp-closure-parameter-class+)
    1891           (astore (setf key-params-register (method-max-locals constructor)))
    1892           (incf (method-max-locals constructor))
    1893           (do ((i 0 (1+ i))
    1894                (key key (cdr key)))
    1895               ((endp key))
    1896             (aload key-params-register)
    1897             (emit-push-constant-int i)
    1898             (emit 'new +lisp-closure-parameter-class+)
    1899             (emit 'dup)
    1900             (let ((keyword (fourth (car key))))
    1901               (if (keywordp keyword)
    1902                   (progn
    1903                     (emit 'ldc (pool-string (symbol-name keyword)))
    1904                     (emit-invokestatic +lisp-class+ "internKeyword"
    1905                                        (list +java-string+) +lisp-symbol+))
    1906                   ;; symbol is not really a keyword; yes, that's allowed!
    1907                   (progn
    1908                     (emit 'ldc (pool-string (symbol-name keyword)))
    1909                     (emit 'ldc (pool-string
    1910                                 (package-name (symbol-package keyword))))
    1911                     (emit-invokestatic +lisp-class+ "internInPackage"
    1912                                        (list +java-string+ +java-string+)
    1913                                        +lisp-symbol+))))
    1914             (emit-push-t) ;; we don't need the actual variable-symbol
    1915             (emit-read-from-string (second (car key)))
    1916             (if (null (third (car key)))
    1917                 (emit-push-nil)
    1918                 (emit-push-t)) ;; we don't need the actual supplied-p symbol
    1919             (emit-invokespecial-init +lisp-closure-parameter-class+
    1920                                      (list +lisp-symbol+ +lisp-symbol+
    1921                                            +lisp-object+ +lisp-object+))
    1922             (emit 'aastore)))
     1847        ;; process required args
     1848        (emit-push-constant-int (length req))
     1849        (emit 'anewarray +lisp-closure-parameter-class+)
     1850        (astore (setf req-params-register (method-max-locals constructor)))
     1851        (incf (method-max-locals constructor))
     1852        (do ((i 0 (1+ i))
     1853             (req req (cdr req)))
     1854            ((endp req))
     1855          (aload req-params-register)
     1856          (emit-push-constant-int i)
     1857          (emit 'new +lisp-closure-parameter-class+)
     1858          (emit 'dup)
     1859          (emit-push-t) ;; we don't need the actual symbol
     1860          (emit-invokespecial-init +lisp-closure-parameter-class+
     1861                                   (list +lisp-symbol+))
     1862          (emit 'aastore))
     1863
     1864        ;; process optional args
     1865        (emit-push-constant-int (length opt))
     1866        (emit 'anewarray +lisp-closure-parameter-class+)
     1867        (astore (setf opt-params-register (method-max-locals constructor)))
     1868        (incf (method-max-locals constructor))
     1869        (do ((i 0 (1+ i))
     1870             (opt opt (cdr opt)))
     1871            ((endp opt))
     1872          (aload opt-params-register)
     1873          (emit-push-constant-int i)
     1874          (emit 'new +lisp-closure-parameter-class+)
     1875          (emit 'dup)
     1876          (emit-push-t) ;; we don't need the actual variable-symbol
     1877          (emit-read-from-string (second (car opt))) ;; initform
     1878          (if (null (third (car opt)))               ;;
     1879              (emit-push-nil)
     1880              (emit-push-t)) ;; we don't need the actual supplied-p symbol
     1881          (emit 'getstatic +lisp-closure-class+ "OPTIONAL" "I")
     1882          (emit-invokespecial-init +lisp-closure-parameter-class+
     1883                                   (list +lisp-symbol+ +lisp-object+
     1884                                         +lisp-object+ "I"))
     1885          (emit 'aastore))
     1886
     1887        ;; process key args
     1888        (emit-push-constant-int (length key))
     1889        (emit 'anewarray +lisp-closure-parameter-class+)
     1890        (astore (setf key-params-register (method-max-locals constructor)))
     1891        (incf (method-max-locals constructor))
     1892        (do ((i 0 (1+ i))
     1893             (key key (cdr key)))
     1894            ((endp key))
     1895          (aload key-params-register)
     1896          (emit-push-constant-int i)
     1897          (emit 'new +lisp-closure-parameter-class+)
     1898          (emit 'dup)
     1899          (let ((keyword (fourth (car key))))
     1900            (if (keywordp keyword)
     1901                (progn
     1902                  (emit 'ldc (pool-string (symbol-name keyword)))
     1903                  (emit-invokestatic +lisp-class+ "internKeyword"
     1904                                     (list +java-string+) +lisp-symbol+))
     1905                ;; symbol is not really a keyword; yes, that's allowed!
     1906                (progn
     1907                  (emit 'ldc (pool-string (symbol-name keyword)))
     1908                  (emit 'ldc (pool-string
     1909                              (package-name (symbol-package keyword))))
     1910                  (emit-invokestatic +lisp-class+ "internInPackage"
     1911                                     (list +java-string+ +java-string+)
     1912                                     +lisp-symbol+))))
     1913          (emit-push-t) ;; we don't need the actual variable-symbol
     1914          (emit-read-from-string (second (car key)))
     1915          (if (null (third (car key)))
     1916              (emit-push-nil)
     1917              (emit-push-t)) ;; we don't need the actual supplied-p symbol
     1918          (emit-invokespecial-init +lisp-closure-parameter-class+
     1919                                   (list +lisp-symbol+ +lisp-symbol+
     1920                                         +lisp-object+ +lisp-object+))
     1921          (emit 'aastore))
    19231922
    19241923        ))
Note: See TracChangeset for help on using the changeset viewer.