Changeset 8400


Ignore:
Timestamp:
01/25/05 02:06:59 (16 years ago)
Author:
piso
Message:

Work in progress (tested).

File:
1 edited

Legend:

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

    r8398 r8400  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.369 2005-01-24 18:58:57 piso Exp $
     4;;; $Id: jvm.lisp,v 1.370 2005-01-25 02:06:59 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    48154815           (get-descriptor (list +lisp-object-array+) +lisp-object+)))))
    48164816
    4817 (defun write-class-file (args execute-method class-file)
     4817(defun write-class-file (class-file)
    48184818  (let* ((super (class-file-superclass class-file))
    48194819         (this-index (pool-class *this-class*))
    48204820         (super-index (pool-class super))
    4821          (constructor (make-constructor super args)))
     4821         (constructor (make-constructor super
     4822                                        (class-file-lambda-list class-file))))
    48224823    (pool-name "Code") ; Must be in pool!
    48234824
     
    48454846      (write-u2 2 stream)
    48464847      ;; methods
    4847       (write-method execute-method stream)
     4848      (aver (= (length (class-file-methods class-file)) 1))
     4849      (let ((execute-method (car (class-file-methods class-file))))
     4850        (write-method execute-method stream)
     4851        )
    48484852      (write-method constructor stream)
    48494853      ;; attributes count
     
    49184922         (*declared-strings* (make-hash-table :test 'eq))
    49194923         (*declared-fixnums* (make-hash-table :test 'eql))
    4920          (filespec (class-file-pathname (compiland-class-file compiland)))
    4921          (*this-class* (class-name-from-filespec filespec))
     4924         (class-file (compiland-class-file compiland))
     4925         (*this-class* (class-name-from-filespec (class-file-pathname class-file)))
    49224926         (args (cadr p1-result))
    49234927         (body (cddr p1-result))
     
    49884992                 (index 0))
    49894993             (dolist (arg args)
    4990 ;;                (aver (= index (length (context-vars *context*))))
    49914994               (let ((variable (find-visible-variable arg)))
    49924995                 (when (null variable)
     
    49985001                 (setf (variable-index variable) index)
    49995002                 (push variable parameters)
    5000 ;;                  (add-variable-to-context variable)
    50015003                 (incf register)
    50025004                 (incf index))))))
     
    51975199    (setf (method-handlers execute-method) (nreverse *handlers*))
    51985200
    5199     (setf (class-file-superclass (compiland-class-file compiland))
     5201    (setf (class-file-superclass class-file)
    52005202          (cond (*child-p*
    52015203                 (if *closure-variables*
     
    52095211                 +lisp-primitive-class+)))
    52105212
    5211     (write-class-file args execute-method (compiland-class-file compiland))
     5213    (setf (class-file-lambda-list class-file) args)
     5214
     5215    (push execute-method (class-file-methods class-file))
     5216
     5217    (write-class-file (compiland-class-file compiland))
    52125218    (dformat t "leaving p2-compiland ~S~%" (compiland-name compiland))))
    52135219
Note: See TracChangeset for help on using the changeset viewer.