Changeset 8390


Ignore:
Timestamp:
01/24/05 02:39:14 (17 years ago)
Author:
piso
Message:

Work in progress (tested).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r8389 r8390  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.366 2005-01-23 19:07:02 piso Exp $
     4;;; $Id: jvm.lisp,v 1.367 2005-01-24 02:39:14 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    7575  pathname ; pathname of output file
    7676  class
     77  superclass
    7778  methods)
    7879
     
    8283  arg-vars
    8384  p1-result
    84 ;;   classfile ; the filename of the class-file
    8585  parent
    8686  (children 0) ; Number of local functions defined with FLET or LABELS.
     
    9696(defvar *pool-entries* nil)
    9797
    98 ;; (defvar *stream* nil)
    9998(defvar *this-class* nil)
    10099
     
    37883787                         (%format nil "local-~D.class" *child-count*)
    37893788                         (incf *child-count*))))
    3790 ;;     (setf (compiland-classfile compiland) pathname)
    37913789
    37923790    (setf class-file (make-class-file :pathname pathname))
     
    38143812                   +lisp-object+)
    38153813             (emit 'var-set (local-function-variable local-function))))
    3816           (t (push (make-local-function :name name
    3817                                         :function function
    3818                                         :class-file class-file)
    3819                    *local-functions*)))))
     3814          (t
     3815           (push (make-local-function :name name
     3816                                      :function function
     3817                                      :class-file class-file)
     3818                 *local-functions*)))))
    38203819
    38213820(defun p2-flet (form &key (target *val*) representation)
     
    38873886    (cond (*compile-file-truename*
    38883887
    3889 ;;            (setf (compiland-classfile compiland) (sys::next-classfile-name))
    3890 
    38913888           (aver (null (compiland-class-file compiland)))
    38923889           (setf (compiland-class-file compiland)
     
    39013898
    39023899           (let* ((local-function
    3903 ;;                    (make-local-function :classfile (compiland-classfile compiland))
    3904                    (make-local-function :class-file (compiland-class-file compiland))
    3905                    )
     3900                   (make-local-function :class-file (compiland-class-file compiland)))
    39063901                  (g (declare-local-function local-function)))
    39073902             (emit 'getstatic *this-class* g +lisp-object+)))
    39083903          (t
    39093904           (aver (null (compiland-class-file compiland)))
    3910 ;;            (setf (compiland-classfile compiland)
    3911 ;;                  (prog1
    3912 ;;                     (%format nil "local-~D.class" *child-count*)
    3913 ;;                     (incf *child-count*)))
    39143905           (setf (compiland-class-file compiland)
    39153906                 (make-class-file :pathname
     
    39243915             (p2-compiland compiland)
    39253916             (setf compiled-function
    3926 ;;                    (sys:load-compiled-function (compiland-classfile compiland))
    3927                    (sys:load-compiled-function (class-file-pathname (compiland-class-file compiland)))
    3928                    )
     3917                   (sys:load-compiled-function
     3918                    (class-file-pathname (compiland-class-file compiland))))
    39293919             (emit 'getstatic *this-class*
    39303920                   (declare-object compiled-function) +lisp-object+))))
     
    48644854           (get-descriptor (list +lisp-object-array+) +lisp-object+)))))
    48654855
    4866 (defun write-class-file (args execute-method filespec)
    4867   (dformat t "write-class-file ~S~%" filespec)
     4856(defun write-class-file (args execute-method class-file)
    48684857  (let* ((super (cond (*child-p*
    48694858                       (if *closure-variables*
     
    48844873
    48854874    ;; Write out the class file.
    4886     (with-open-file (stream filespec
     4875    (with-open-file (stream (class-file-pathname class-file)
    48874876                            :direction :output
    48884877                            :element-type '(unsigned-byte 8)
     
    49664955                (list* 'LAMBDA lambda-list (mapcar #'p1 body))))))))
    49674956
     4957(defun class-name-from-filespec (filespec)
     4958  (let* ((name (pathname-name filespec)))
     4959    (dotimes (i (length name))
     4960      (when (eql (char name i) #\-)
     4961        (setf (char name i) #\_)))
     4962    (concatenate 'string "org/armedbear/lisp/" name)))
     4963 
    49684964(defun p2-compiland (compiland)
    49694965  (dformat t "p2-compiland ~S~%" (compiland-name compiland))
     
    49744970         (*declared-fixnums* (make-hash-table :test 'eql))
    49754971         (filespec (class-file-pathname (compiland-class-file compiland)))
    4976          (class-name (let* ((name (pathname-name filespec)))
    4977                        (dotimes (i (length name))
    4978                          (when (eql (char name i) #\-)
    4979                            (setf (char name i) #\_)))
    4980                        name))
    4981          (*this-class*
    4982           (concatenate 'string "org/armedbear/lisp/" class-name))
     4972         (*this-class* (class-name-from-filespec filespec))
    49834973         (args (cadr p1-result))
    49844974         (body (cddr p1-result))
     
    52575247    (setf (method-max-locals execute-method) *registers-allocated*)
    52585248    (setf (method-handlers execute-method) (nreverse *handlers*))
    5259     (write-class-file args execute-method filespec)
    5260     (dformat t "leaving p2-compiland ~S~%" (compiland-name compiland))
    5261     filespec))
     5249    (write-class-file args execute-method (compiland-class-file compiland))
     5250    (dformat t "leaving p2-compiland ~S~%" (compiland-name compiland))))
    52625251
    52635252(defun compile-1 (compiland)
     
    52885277
    52895278    ;; Pass 2.
    5290     (prog1
    5291      (p2-compiland compiland)
    5292      (dformat t "*all-variables* = ~S~%" (mapcar #'variable-name *all-variables*)))
    5293     ))
     5279    (p2-compiland compiland)
     5280    (dformat t "*all-variables* = ~S~%" (mapcar #'variable-name *all-variables*))
     5281    (class-file-pathname (compiland-class-file compiland))))
    52945282
    52955283(defun compile-defun (name form environment &optional (filespec "out.class"))
     
    53015289      (compile-1 (make-compiland :name name
    53025290                                 :lambda-expression (precompile-form form t)
    5303 ;;                                  :classfile filespec
    53045291                                 :class-file (make-class-file :pathname filespec)
    53055292                                 :parent *current-compiland*))))
Note: See TracChangeset for help on using the changeset viewer.