Changeset 12790


Ignore:
Timestamp:
07/07/10 22:15:14 (13 years ago)
Author:
ehuelsmann
Message:

More CLASS-NAME integration.

Location:
branches/generic-class-file/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12789 r12790  
    211211(defconstant +lisp-fixnum+ "Lorg/armedbear/lisp/Fixnum;")
    212212(defconstant +lisp-fixnum-array+ "[Lorg/armedbear/lisp/Fixnum;")
    213 (defconstant +lisp-function-proxy-class+
    214   "org/armedbear/lisp/AutoloadedFunctionProxy")
     213;(defconstant +lisp-function-proxy-class+
     214;  "org/armedbear/lisp/AutoloadedFunctionProxy")
    215215(defconstant +lisp-bignum-class+ "org/armedbear/lisp/Bignum")
    216216(defconstant +lisp-bignum+ "Lorg/armedbear/lisp/Bignum;")
    … …  
    222222(defconstant +lisp-character+ "Lorg/armedbear/lisp/LispCharacter;")
    223223(defconstant +lisp-character-array+ "[Lorg/armedbear/lisp/LispCharacter;")
    224 (defconstant +lisp-abstract-bit-vector-class+ "org/armedbear/lisp/AbstractBitVector")
    225 (defconstant +lisp-abstract-vector-class+ "org/armedbear/lisp/AbstractVector")
    226 (defconstant +lisp-abstract-string-class+ "org/armedbear/lisp/AbstractString")
    227 (defconstant +lisp-abstract-string+ "Lorg/armedbear/lisp/AbstractString;")
    228 (defconstant +lisp-simple-vector-class+ "org/armedbear/lisp/SimpleVector")
    229 (defconstant +lisp-simple-string-class+ "org/armedbear/lisp/SimpleString")
    230 (defconstant +lisp-simple-string+ "Lorg/armedbear/lisp/SimpleString;")
    231 (defconstant +lisp-special-binding+ "Lorg/armedbear/lisp/SpecialBinding;")
    232 (defconstant +lisp-special-binding-class+ "org/armedbear/lisp/SpecialBinding")
    233 (defconstant +lisp-closure-parameter-class+ "org/armedbear/lisp/Closure$Parameter")
    234224(defconstant +lisp-closure-parameter-array+ "[Lorg/armedbear/lisp/Closure$Parameter;")
    235225
    … …  
    763753                            (FIXNUM     +lisp-fixnum-class+)
    764754                            (STREAM     +lisp-stream+)
    765                             (STRING     +lisp-abstract-string-class+)
    766                             (VECTOR     +lisp-abstract-vector-class+)))
     755                            (STRING     +lisp-abstract-string+)
     756                            (VECTOR     +lisp-abstract-vector+)))
    767757        (expected-type-java-symbol-name (case expected-type
    768758                                          (HASH-TABLE "HASH_TABLE")
    … …  
    12001190  (let* ((args (instruction-args instruction))
    12011191         (index (pool-field (!class-name (first args))
    1202                             (second args) (third args))))
     1192                            (second args) (!class-ref (third args)))))
    12031193    (inst (instruction-opcode instruction) (u2 index))))
    12041194
    … …  
    12431233  (let* ((args (instruction-args instruction))
    12441234         (index (pool-field (!class-name (first args))
    1245                             (second args) (third args))))
     1235                            (second args) (!class-ref (third args)))))
    12461236    (inst (instruction-opcode instruction) (u2 index))))
    12471237
    … …  
    18151805                 `(progn
    18161806                    (emit-push-constant-int (length ,params))
    1817                     (emit 'anewarray +lisp-closure-parameter-class+)
     1807                    (emit 'anewarray +lisp-closure-parameter+)
    18181808                    (astore (setf ,register (method-max-locals constructor)))
    18191809                    (incf (method-max-locals constructor))
    … …  
    18251815                      (aload ,register)
    18261816                      (emit-push-constant-int ,count-sym)
    1827                       (emit 'new +lisp-closure-parameter-class+)
     1817                      (emit 'new +lisp-closure-parameter+)
    18281818                      (emit 'dup)
    18291819                      ,@body
    … …  
    18321822          (parameters-to-array (ignore req req-params-register)
    18331823             (emit-push-t) ;; we don't need the actual symbol
    1834              (emit-invokespecial-init +lisp-closure-parameter-class+
     1824             (emit-invokespecial-init +lisp-closure-parameter+
    18351825                                      (list +lisp-symbol+)))
    18361826
    … …  
    18421832                 (emit-push-t)) ;; we don't need the actual supplied-p symbol
    18431833             (emit 'getstatic +lisp-closure+ "OPTIONAL" "I")
    1844              (emit-invokespecial-init +lisp-closure-parameter-class+
     1834             (emit-invokespecial-init +lisp-closure-parameter+
    18451835                                      (list +lisp-symbol+ +lisp-object+
    18461836                                            +lisp-object+ "I")))
    … …  
    18661856                 (emit-push-nil)
    18671857                 (emit-push-t)) ;; we don't need the actual supplied-p symbol
    1868              (emit-invokespecial-init +lisp-closure-parameter-class+
     1858             (emit-invokespecial-init +lisp-closure-parameter+
    18691859                                      (list +lisp-symbol+ +lisp-symbol+
    18701860                                            +lisp-object+ +lisp-object+))))))
    … …  
    19861976(defknown declare-field (t t t) t)
    19871977(defun declare-field (name descriptor access-flags)
    1988   (let ((field (make-field name descriptor)))
     1978  (let ((field (make-field name (!class-ref descriptor))))
    19891979    ;; final static <access-flags>
    19901980    (setf (field-access-flags field)
    … …  
    20802070(defun serialize-string (string)
    20812071  "Generate code to restore a serialized string."
    2082   (emit 'new +lisp-simple-string-class+)
     2072  (emit 'new +lisp-simple-string+)
    20832073  (emit 'dup)
    20842074  (emit 'ldc (pool-string string))
    2085   (emit-invokespecial-init +lisp-simple-string-class+ (list +java-string+)))
     2075  (emit-invokespecial-init +lisp-simple-string+ (list +java-string+)))
    20862076
    20872077(defun serialize-package (pkg)
    … …  
    21262116
    21272117(defvar serialization-table
    2128   `((integer "INT" ,#'eql ,#'serialize-integer ,+lisp-integer+)
    2129     (character "CHR" ,#'eql ,#'serialize-character ,+lisp-character+)
    2130     (single-float "FLT" ,#'eql ,#'serialize-float ,+lisp-single-float+)
    2131     (double-float "DBL" ,#'eql ,#'serialize-double ,+lisp-double-float+)
     2118  `((integer "INT" ,#'eql ,#'serialize-integer ,+!lisp-integer+)
     2119    (character "CHR" ,#'eql ,#'serialize-character ,+!lisp-character+)
     2120    (single-float "FLT" ,#'eql ,#'serialize-float ,+!lisp-single-float+)
     2121    (double-float "DBL" ,#'eql ,#'serialize-double ,+!lisp-double-float+)
    21322122    (string "STR" ,#'equal ,#'serialize-string
    21332123            ,+lisp-abstract-string+) ;; because of (not compile-file)
    2134     (package "PKG" ,#'eq ,#'serialize-package ,+lisp-object+)
    2135     (symbol "SYM" ,#'eq ,#'serialize-symbol ,+lisp-symbol+)
    2136     (T "OBJ" ,#'eq ,#'serialize-object ,+lisp-object+))
     2124    (package "PKG" ,#'eq ,#'serialize-package ,+!lisp-object+)
     2125    (symbol "SYM" ,#'eq ,#'serialize-symbol ,+!lisp-symbol+)
     2126    (T "OBJ" ,#'eq ,#'serialize-object ,+!lisp-object+))
    21372127  "A list of 5-element lists. The elements of the sublists mean:
    21382128
    … …  
    21872177           (emit-invokestatic +lisp+ "recall"
    21882178                              (list +java-string+) +lisp-object+)
    2189            (when (string/= field-type +lisp-object+)
    2190              (emit 'checkcast (subseq field-type 1 (1- (length field-type)))))
     2179           (when (not (eq field-type +!lisp-object+))
     2180             (emit 'checkcast field-type))
    21912181           (emit 'putstatic *this-class* field-name field-type)
    21922182           (setf *static-code* *code*)))
    … …  
    32973287
    32983288(defun p2-test-bit-vector-p (form)
    3299   (p2-test-instanceof-predicate form +lisp-abstract-bit-vector-class+))
     3289  (p2-test-instanceof-predicate form +lisp-abstract-bit-vector+))
    33003290
    33013291(defun p2-test-characterp (form)
    … …  
    33963386
    33973387(defun p2-test-stringp (form)
    3398   (p2-test-instanceof-predicate form +lisp-abstract-string-class+))
     3388  (p2-test-instanceof-predicate form +lisp-abstract-string+))
    33993389
    34003390(defun p2-test-vectorp (form)
    3401   (p2-test-instanceof-predicate form +lisp-abstract-vector-class+))
     3391  (p2-test-instanceof-predicate form +lisp-abstract-vector+))
    34023392
    34033393(defun p2-test-simple-vector-p (form)
    3404   (p2-test-instanceof-predicate form +lisp-simple-vector-class+))
     3394  (p2-test-instanceof-predicate form +lisp-simple-vector+))
    34053395
    34063396(defknown compile-test-form (t) t)
    … …  
    46184608
    46194609(defun p2-bit-vector-p (form target representation)
    4620   (p2-instanceof-predicate form target representation +lisp-abstract-bit-vector-class+))
     4610  (p2-instanceof-predicate form target representation +lisp-abstract-bit-vector+))
    46214611
    46224612(defun p2-characterp (form target representation)
    … …  
    46364626
    46374627(defun p2-simple-vector-p (form target representation)
    4638   (p2-instanceof-predicate form target representation +lisp-simple-vector-class+))
     4628  (p2-instanceof-predicate form target representation +lisp-simple-vector+))
    46394629
    46404630(defun p2-stringp (form target representation)
    4641   (p2-instanceof-predicate form target representation +lisp-abstract-string-class+))
     4631  (p2-instanceof-predicate form target representation +lisp-abstract-string+))
    46424632
    46434633(defun p2-symbolp (form target representation)
    … …  
    46454635
    46464636(defun p2-vectorp (form target representation)
    4647   (p2-instanceof-predicate form target representation +lisp-abstract-vector-class+))
     4637  (p2-instanceof-predicate form target representation +lisp-abstract-vector+))
    46484638
    46494639(define-inlined-function p2-coerce-to-function (form target representation)
    … …  
    56815671              (null representation))
    56825672         (let ((arg (second form)))
    5683            (emit 'new +lisp-simple-vector-class+)
     5673           (emit 'new +lisp-simple-vector+)
    56845674           (emit 'dup)
    56855675     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    5686            (emit-invokespecial-init +lisp-simple-vector-class+ '("I"))
     5676           (emit-invokespecial-init +lisp-simple-vector+ '("I"))
    56875677           (emit-move-from-stack target representation)))
    56885678        (t
    … …  
    57065696              (case result-type
    57075697                ((STRING SIMPLE-STRING)
    5708                  (setf class +lisp-simple-string-class+))
     5698                 (setf class +lisp-simple-string+))
    57095699                ((VECTOR SIMPLE-VECTOR)
    5710                  (setf class +lisp-simple-vector-class+)))))
     5700                 (setf class +lisp-simple-vector+)))))
    57115701        (when class
    57125702          (emit 'new class)
    … …  
    57255715              (null representation))
    57265716         (let ((arg (second form)))
    5727            (emit 'new +lisp-simple-string-class+)
     5717           (emit 'new +lisp-simple-string+)
    57285718           (emit 'dup)
    57295719     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    5730            (emit-invokespecial-init +lisp-simple-string-class+ '("I"))
     5720           (emit-invokespecial-init +lisp-simple-string+ '("I"))
    57315721           (emit-move-from-stack target representation)))
    57325722        (t
    … …  
    63966386               (compile-form arg1 'stack nil)
    63976387               (compile-form arg2 'stack nil)
    6398                (emit 'checkcast +lisp-abstract-vector-class+)
     6388               (emit 'checkcast +lisp-abstract-vector+)
    63996389               (maybe-emit-clear-values arg1 arg2)
    64006390               (emit 'swap)
    6401                (emit-invokevirtual +lisp-abstract-vector-class+
     6391               (emit-invokevirtual +lisp-abstract-vector+
    64026392                                   (if (eq test 'eq) "deleteEq" "deleteEql")
    64036393                                   (lisp-object-arg-types 1) +lisp-object+)
    … …  
    67296719                (zerop *safety*))
    67306720           (compile-form arg1 'stack nil)
    6731            (emit 'checkcast +lisp-abstract-string-class+)
     6721           (emit 'checkcast +lisp-abstract-string+)
    67326722           (compile-form arg2 'stack :int)
    67336723           (maybe-emit-clear-values arg1 arg2)
    6734            (emit-invokevirtual +lisp-abstract-string-class+ "charAt"
     6724           (emit-invokevirtual +lisp-abstract-string+ "charAt"
    67356725                               '("I") "C")
    67366726           (emit-move-from-stack target representation))
    … …  
    67406730                (fixnum-type-p type2))
    67416731           (compile-form arg1 'stack nil)
    6742            (emit 'checkcast +lisp-abstract-string-class+)
     6732           (emit 'checkcast +lisp-abstract-string+)
    67436733           (compile-form arg2 'stack :int)
    67446734           (maybe-emit-clear-values arg1 arg2)
    6745            (emit-invokevirtual +lisp-abstract-string-class+ "charAt"
     6735           (emit-invokevirtual +lisp-abstract-string+ "charAt"
    67466736                               '("I") "C")
    67476737           (emit-move-from-stack target representation))
    … …  
    67786768                  (value-register (when target (allocate-register)))
    67796769                  (class (if (eq op 'SCHAR)
    6780                              +lisp-simple-string-class+
    6781                              +lisp-abstract-string-class+)))
     6770                             +lisp-simple-string+
     6771                             +lisp-abstract-string+)))
    67826772             (compile-form arg1 'stack nil)
    67836773             (emit 'checkcast class)
    … …  
    68846874          (cond ((compiler-subtypep type1 'string)
    68856875                 (compile-form arg1 'stack nil) ; array
    6886                  (emit 'checkcast +lisp-abstract-string-class+)
     6876                 (emit 'checkcast +lisp-abstract-string+)
    68876877                 (compile-form arg2 'stack :int) ; index
    68886878                 (maybe-emit-clear-values arg1 arg2)
    6889                  (emit-invokevirtual +lisp-abstract-string-class+
     6879                 (emit-invokevirtual +lisp-abstract-string+
    68906880                                     "charAt" '("I") "C"))
    68916881                (t
    … …  
    72317221                      (variable-block variable))))
    72327222           (aload (variable-binding-register variable))
    7233            (emit 'getfield +lisp-special-binding-class+ "value"
     7223           (emit 'getfield +lisp-special-binding+ "value"
    72347224                 +lisp-object+))
    72357225          (t
    … …  
    73117301             (compile-forms-and-maybe-emit-clear-values value-form 'stack nil)
    73127302             (emit 'dup_x1) ;; copy past th
    7313              (emit 'putfield +lisp-special-binding-class+ "value"
     7303             (emit 'putfield +lisp-special-binding+ "value"
    73147304                   +lisp-object+))
    73157305            ((and (consp value-form)
    … …  
    74657455                            (FIXNUM     +lisp-fixnum-class+)
    74667456          (STREAM     +lisp-stream+)
    7467                             (STRING     +lisp-abstract-string-class+)
    7468                             (VECTOR     +lisp-abstract-vector-class+)))
     7457                            (STRING     +lisp-abstract-string+)
     7458                            (VECTOR     +lisp-abstract-vector+)))
    74697459        (expected-type-java-symbol-name (case expected-type
    74707460                                          (HASH-TABLE "HASH_TABLE")

  • branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

    r12789 r12790  
    106106(define-class-name +java-string+ "java.lang.String")
    107107(define-class-name +!lisp-object+ "org.armedbear.lisp.LispObject")
    108 (define-class-name +!lisp-simple-string+ "org.armedbear.lisp.SimpleString")
     108(define-class-name +lisp-simple-string+ "org.armedbear.lisp.SimpleString")
    109109(define-class-name +lisp+ "org.armedbear.lisp.Lisp")
    110110(define-class-name +lisp-nil+ "org.armedbear.lisp.Nil")
    … …  
    113113(define-class-name +lisp-thread+ "org.armedbear.lisp.LispThread")
    114114(define-class-name +lisp-closure-binding+ "org.armedbear.lisp.ClosureBinding")
    115 (define-class-name +!lisp-integer+ "org.armedbear.lisp.Integer")
     115(define-class-name +!lisp-integer+ "org.armedbear.lisp.LispInteger")
    116116(define-class-name +!lisp-fixnum+ "org.armedbear.lisp.Fixnum")
    117117(define-class-name +!lisp-bignum+ "org.armedbear.lisp.Bignum")
    … …  
    120120(define-class-name +lisp-cons+ "org.armedbear.lisp.Cons")
    121121(define-class-name +lisp-load+ "org.armedbear.lisp.Load")
    122 (define-class-name +!lisp-character+ "org.armedbear.lisp.Character")
     122(define-class-name +!lisp-character+ "org.armedbear.lisp.LispCharacter")
    123123(define-class-name +lisp-structure-object+ "org.armedbear.lisp.StructureObject")
    124 (define-class-name +!lisp-simple-vector+ "org.armedbear.lisp.SimpleVector")
    125 (define-class-name +!lisp-abstract-string+ "org.armedbear.lisp.AbstractString")
    126 (define-class-name +!lisp-abstract-vector+ "org.armedbear.lisp.AbstractVector")
    127 (define-class-name +!lisp-abstract-bit-vector+
     124(define-class-name +lisp-simple-vector+ "org.armedbear.lisp.SimpleVector")
     125(define-class-name +lisp-abstract-string+ "org.armedbear.lisp.AbstractString")
     126(define-class-name +lisp-abstract-vector+ "org.armedbear.lisp.AbstractVector")
     127(define-class-name +lisp-abstract-bit-vector+
    128128    "org.armedbear.lisp.AbstractBitVector")
    129129(define-class-name +lisp-environment+ "org.armedbear.lisp.Environment")
    130 (define-class-name +!lisp-special-binding+ "org.armedbear.lisp.SpecialBinding")
     130(define-class-name +lisp-special-binding+ "org.armedbear.lisp.SpecialBinding")
    131131(define-class-name +lisp-special-bindings-mark+
    132132    "org.armedbear.lisp.SpecialBindingsMark")
    … …  
    142142(define-class-name +lisp-closure+ "org.armedbear.lisp.Closure")
    143143(define-class-name +lisp-compiled-closure+ "org.armedbear.lisp.CompiledClosure")
    144 (define-class-name +!lisp-closure-parameter+
     144(define-class-name +lisp-closure-parameter+
    145145    "org.armedbear.lisp.Closure$Parameter")
    146146(define-class-name +!fasl-loader+ "org.armedbear.lisp.FaslClassLoader")
Note: See TracChangeset for help on using the changeset viewer.