Changeset 8453


Ignore:
Timestamp:
02/03/05 02:28:06 (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

    r8451 r8453  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.385 2005-02-02 21:42:04 piso Exp $
     4;;; $Id: jvm.lisp,v 1.386 2005-02-03 02:28:06 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    421421(defun p1-m-v-b (form)
    422422;;   (dformat t "p1-multiple-value-bind~%")
     423  (when (= (length (cadr form)) 1)
     424    (let ((new-form `(let ((,(caadr form) ,(caddr form))) ,@(cdddr form))))
     425      (dformat t "old form = ~S~%" form)
     426      (dformat t "new-form = ~S~%" new-form)
     427      (return-from p1-m-v-b (p1-let/let* new-form))))
    423428  (let* ((*visible-variables* *visible-variables*)
    424429         (block (make-block-node :name '(MULTIPLE-VALUE-BIND)))
     
    12961301             7 ; ICONST_4
    12971302             8 ; ICONST_5
     1303             9 ; LCONST_0
     1304             10 ; LCONST_1
    12981305             42 ; ALOAD_0
    12991306             43 ; ALOAD_1
     
    24782485            (emit 'iload (variable-register variable))
    24792486            (aver nil)))))
     2487
     2488(defun emit-push-long (arg)
     2489  (cond ((eql arg 0)
     2490         (emit 'lconst_0))
     2491        ((eql arg 1)
     2492         (emit 'lconst_1))
     2493        ((fixnump arg)
     2494         (emit-push-constant-int arg)
     2495         (emit 'i2l))
     2496        (t
     2497         (let ((variable (unboxed-fixnum-variable arg)))
     2498           (aver (not (null variable)))
     2499           (aver (not (null (variable-register variable))))
     2500           (emit 'iload (variable-register variable))
     2501           (emit 'i2l)))))
    24802502
    24812503(defun p2-eql (form &key (target :stack) representation)
     
    42344256                       (emit 'iadd))
    42354257                      (t
    4236                        (emit 'iload (variable-register var1))
    4237                        (emit 'i2l)
    4238                        (emit 'iload (variable-register var2))
    4239                        (emit 'i2l)
     4258;;                        (emit 'iload (variable-register var1))
     4259;;                        (emit 'i2l)
     4260                       (emit-push-long var1)
     4261;;                        (emit 'iload (variable-register var2))
     4262;;                        (emit 'i2l)
     4263                       (emit-push-long var2)
    42404264                       (emit 'ladd)
    42414265                       (emit-box-long)))
     
    42494273                     (emit 'iadd))
    42504274                    (t
    4251                      (emit-push-int var1)
    4252                      (emit 'i2l)
    4253                      (emit-push-int arg2)
    4254                      (emit 'i2l)
     4275;;                      (emit-push-int var1)
     4276;;                      (emit 'i2l)
     4277                     (emit-push-long var1)
     4278;;                      (emit-push-int arg2)
     4279;;                      (emit 'i2l)
     4280                     (emit-push-long arg2)
    42554281                     (emit 'ladd)
    42564282                     (emit-box-long)))
     
    42644290                     (emit 'iadd))
    42654291                    (t
    4266                      (emit-push-int arg1)
    4267                      (emit 'i2l)
    4268                      (emit-push-int var2)
    4269                      (emit 'i2l)
     4292;;                      (emit-push-int arg1)
     4293;;                      (emit 'i2l)
     4294                     (emit-push-long arg1)
     4295;;                      (emit-push-int var2)
     4296;;                      (emit 'i2l)
     4297                     (emit-push-long var2)
    42704298                     (emit 'ladd)
    42714299                     (emit-box-long)))
     
    42784306             ((eql arg2 1)
    42794307              (dformat t "p2-plus case 5~%")
    4280               (compile-form arg1 :target :stack)
    4281               (maybe-emit-clear-values arg1)
    4282               (emit-invoke-method "incr" target representation))
     4308              (cond ((and (eq representation :unboxed-fixnum)
     4309                          (subtypep (derive-type arg1) 'FIXNUM))
     4310                     (compile-form arg1 :target :stack :representation :unboxed-fixnum)
     4311                     (maybe-emit-clear-values arg1)
     4312                     (emit-push-int 1)
     4313                     (emit 'iadd)
     4314                     (emit-move-from-stack target representation))
     4315                    (t
     4316                     (compile-form arg1 :target :stack)
     4317                     (maybe-emit-clear-values arg1)
     4318                     (emit-invoke-method "incr" target representation))))
    42834319             ((arg-is-fixnum-p arg1)
    42844320              (dformat t "p2-plus case 6~%")
     
    43644400                  (emit 'isub))
    43654401                 (t
    4366                   (emit 'iload (variable-register var1))
    4367                   (emit 'i2l)
    4368                   (emit 'iload (variable-register var2))
    4369                   (emit 'i2l)
     4402;;                   (emit 'iload (variable-register var1))
     4403;;                   (emit 'i2l)
     4404                  (emit-push-long var1)
     4405;;                   (emit 'iload (variable-register var2))
     4406;;                   (emit 'i2l)
     4407                  (emit-push-long var2)
    43704408                  (emit 'lsub)
    43714409                  (emit-box-long)))
     
    43814419                    (t
    43824420                     (dformat t "p2-minus case 2 LSUB~%")
    4383                      (emit-push-int var1)
    4384                      (emit 'i2l)
    4385                      (emit-push-int arg2)
    4386                      (emit 'i2l)
     4421                     (emit-push-long var1)
     4422                     (emit-push-long arg2)
    43874423                     (emit 'lsub)
    43884424                     (emit-box-long)))
     
    43964432                     (emit 'isub))
    43974433                    (t
    4398                      (emit-push-int arg1)
    4399                      (emit 'i2l)
    4400                      (emit-push-int var2)
    4401                      (emit 'i2l)
     4434                     (emit-push-long arg1)
     4435                     (emit-push-long var2)
    44024436                     (emit 'lsub)
    44034437                     (emit-box-long)))
    44044438              (emit-move-from-stack target representation))
    44054439             ((eql arg2 1)
    4406               (dformat t "p2-minus case 5~%")
    4407               (compile-form arg1 :target :stack)
    4408               (maybe-emit-clear-values arg2)
    4409               (emit-invoke-method "decr" target representation))
     4440              (dformat t "p2-minus case 5 ~S~%" form)
     4441              (cond ((and (eq representation :unboxed-fixnum)
     4442                          (subtypep (derive-type arg1) 'FIXNUM))
     4443                     (compile-form arg1 :target :stack :representation :unboxed-fixnum)
     4444                     (maybe-emit-clear-values arg1)
     4445                     (emit-push-int 1)
     4446                     (emit 'isub)
     4447                     (emit-move-from-stack target representation))
     4448                    (t
     4449                     (compile-form arg1 :target :stack)
     4450                     (maybe-emit-clear-values arg1)
     4451                     (emit-invoke-method "decr" target representation))))
    44104452             ((arg-is-fixnum-p arg2)
    44114453              (dformat t "p2-minus case 7~%")
     
    46504692;;   (compile-form (third form) :target target :representation representation)
    46514693  (dformat t "p2-the ~S ~S ~S~%" form target representation)
    4652   (cond ((subtypep (second form) 'FIXNUM)
    4653          (dformat t "p2-the fixnum case~%")
    4654          (unless (eq representation :unboxed-fixnum)
    4655            (emit 'new +lisp-fixnum-class+)
    4656            (emit 'dup))
     4694  (cond ((and (eq representation :unboxed-fixnum) (subtypep (second form) 'FIXNUM))
    46574695         (compile-form (third form) :target :stack :representation :unboxed-fixnum)
    4658          (unless (eq representation :unboxed-fixnum)
    4659            (emit-invokespecial-init +lisp-fixnum-class+ '("I")))
    46604696         (emit-move-from-stack target representation))
     4697;;         ((subtypep (second form) 'FIXNUM)
     4698;;          (dformat t "p2-the fixnum case~%")
     4699;;          (unless (eq representation :unboxed-fixnum)
     4700;;            (emit 'new +lisp-fixnum-class+)
     4701;;            (emit 'dup))
     4702;;          (compile-form (third form) :target :stack :representation :unboxed-fixnum)
     4703;;          (unless (eq representation :unboxed-fixnum)
     4704;;            (emit-invokespecial-init +lisp-fixnum-class+ '("I")))
     4705;;          (emit-move-from-stack target representation))
    46614706        (t
    46624707         (compile-form (third form) :target target :representation representation))))
Note: See TracChangeset for help on using the changeset viewer.