Changeset 11650


Ignore:
Timestamp:
02/09/09 21:53:11 (12 years ago)
Author:
ehuelsmann
Message:

Generate Symbol-typed fields if we expect to be loading off one.
Also: generate uniquely prefixed symbols, aiding debugging.

File:
1 edited

Legend:

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

    r11649 r11650  
    20712071    (setf g (if *compile-file-truename*
    20722072          (declare-object-as-string symbol)
    2073           (declare-object symbol))))
     2073          (declare-object symbol +lisp-symbol+))))
    20742074   (t
    20752075    (let ((*code* *static-code*)
    20762076    (s (sanitize symbol)))
    2077       (setf g (symbol-name (gensym)))
     2077      (setf g (symbol-name (gensym "SYM")))
    20782078      (when s
    20792079        (setf g (concatenate 'string g "_" s)))
     
    20932093   symbol *declared-symbols* ht g
    20942094   (let ((*code* *static-code*))
    2095      (setf g (symbol-name (gensym)))
     2095     (setf g (symbol-name (gensym "KEY")))
    20962096     (declare-field g +lisp-symbol+)
    20972097     (emit 'ldc (pool-string (symbol-name symbol)))
     
    21072107  (declare-with-hashtable
    21082108   symbol *declared-functions* ht f
    2109    (setf f (symbol-name (gensym)))
     2109   (setf f (symbol-name (gensym "FUN")))
    21102110   (let ((s (sanitize symbol)))
    21112111     (when s
     
    21602160  (declare-with-hashtable
    21612161   local-function *declared-functions* ht g
    2162    (setf g (symbol-name (gensym)))
     2162   (setf g (symbol-name (gensym "LFUN")))
    21632163   (let* ((pathname (class-file-pathname (local-function-class-file local-function)))
    21642164    (*code* *static-code*))
     
    22502250(defknown declare-character (t) string)
    22512251(defun declare-character (c)
    2252   (let ((g (symbol-name (gensym)))
     2252  (let ((g (symbol-name (gensym "CHAR")))
    22532253        (n (char-code c))
    22542254        (*code* *static-code*))
     
    22672267    g))
    22682268
    2269 (defknown declare-object-as-string (t) string)
    2270 (defun declare-object-as-string (obj)
    2271   (let* ((g (symbol-name (gensym)))
     2269(defknown declare-object-as-string (t &optional t) string)
     2270(defun declare-object-as-string (obj &optional (obj-class +lisp-object+))
     2271  (let* ((g (symbol-name (gensym "OBJSTR")))
    22722272         (s (with-output-to-string (stream) (dump-form obj stream)))
    22732273         (*code* *static-code*))
    2274     (declare-field g +lisp-object+)
     2274    (declare-field g obj-class)
    22752275    (emit 'ldc (pool-string s))
    22762276    (emit-invokestatic +lisp-class+ "readObjectFromString"
    22772277                       (list +java-string+) +lisp-object+)
    2278     (emit 'putstatic *this-class* g +lisp-object+)
     2278    (when (string/= obj-class +lisp-object+)
     2279      (emit 'checkcast obj-class))
     2280    (emit 'putstatic *this-class* g obj-class)
    22792281    (setf *static-code* *code*)
    22802282    g))
    22812283
    22822284(defun declare-load-time-value (obj)
    2283   (let* ((g (symbol-name (gensym)))
     2285  (let* ((g (symbol-name (gensym "LTV")))
    22842286         (s (with-output-to-string (stream) (dump-form obj stream)))
    22852287         (*code* *static-code*))
     
    22992301  (aver (or (structure-object-p obj) (standard-object-p obj)
    23002302            (java:java-object-p obj)))
    2301   (let* ((g (symbol-name (gensym)))
     2303  (let* ((g (symbol-name (gensym "INSTANCE")))
    23022304         (s (with-output-to-string (stream) (dump-form obj stream)))
    23032305         (*code* *static-code*))
     
    23132315
    23142316(defun declare-package (obj)
    2315   (let* ((g (symbol-name (gensym)))
     2317  (let* ((g (symbol-name (gensym "PKG")))
    23162318         (*print-level* nil)
    23172319         (*print-length* nil)
     
    23262328    g))
    23272329
    2328 (declaim (ftype (function (t) string) declare-object))
    2329 (defun declare-object (obj)
    2330   (let ((key (symbol-name (gensym))))
     2330(declaim (ftype (function (t &optional t) string) declare-object))
     2331(defun declare-object (obj &optional (obj-class +lisp-object+))
     2332  (let ((key (symbol-name (gensym "OBJ"))))
    23312333    (remember key obj)
    23322334    (let* ((g1 (declare-string key))
    2333            (g2 (symbol-name (gensym)))
     2335           (g2 (symbol-name (gensym "O2BJ"))))
     2336      (let* (
    23342337           (*code* *static-code*))
    2335       (declare-field g2 +lisp-object+)
     2338      (declare-field g2 obj-class)
    23362339      (emit 'getstatic *this-class* g1 +lisp-simple-string+)
    23372340      (emit-invokestatic +lisp-class+ "recall"
    23382341                         (list +lisp-simple-string+) +lisp-object+)
    2339       (emit 'putstatic *this-class* g2 +lisp-object+)
     2342      (when (string/= obj-class +lisp-object+)
     2343        (emit 'checkcast obj-class))
     2344      (emit 'putstatic *this-class* g2 obj-class)
    23402345      (setf *static-code* *code*)
    2341       g2)))
     2346      g2))))
    23422347
    23432348(defun declare-lambda (obj)
    2344   (let* ((g (symbol-name (gensym)))
     2349  (let* ((g (symbol-name (gensym "LAMBDA")))
    23452350         (*print-level* nil)
    23462351         (*print-length* nil)
     
    23622367   string *declared-strings* ht g
    23632368   (let ((*code* *static-code*))
    2364         (setf g (symbol-name (gensym)))
     2369        (setf g (symbol-name (gensym "STR")))
    23652370        (declare-field g +lisp-simple-string+)
    23662371        (emit 'new +lisp-simple-string-class+)
Note: See TracChangeset for help on using the changeset viewer.