Ignore:
Timestamp:
12/27/04 14:20:04 (17 years ago)
Author:
piso
Message:

COMPILE-PLUS, COMPILE-MINUS

File:
1 edited

Legend:

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

    r8300 r8301  
    22;;;
    33;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.318 2004-12-27 02:30:18 piso Exp $
     4;;; $Id: jvm.lisp,v 1.319 2004-12-27 14:20:04 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    40374037
    40384038(defun compile-plus (form &key (target *val*) representation)
    4039   (let ((new-form (rewrite-function-call form)))
    4040     (when (neq new-form form)
    4041       (return-from compile-plus (compile-form new-form :target target))))
     4039;;   (let ((new-form (rewrite-function-call form)))
     4040;;     (when (neq new-form form)
     4041;;       (return-from compile-plus (compile-form new-form :target target))))
    40424042  (case (length form)
    40434043    (3
     
    40494049       (cond
    40504050        ((and (numberp arg1) (numberp arg2))
    4051          (compile-constant (+ arg1 arg2) :target target))
     4051         (compile-constant (+ arg1 arg2)
     4052                           :target target
     4053                           :representation representation))
    40524054        ((and var1 var2)
    40534055         (dformat t "compile-plus case 1~%")
    40544056         (aver (variable-register var1))
    4055          (emit 'iload (variable-register var1))
    4056          (emit 'i2l)
    40574057         (aver (variable-register var2))
    4058          (emit 'iload (variable-register var2))
    4059          (emit 'i2l)
    4060          (emit 'ladd)
    4061          (when (null representation)
     4058         (cond
     4059          ((eq representation :unboxed-fixnum)
     4060           (emit-push-int var1)
     4061           (emit-push-int arg2)
     4062           (emit 'iadd))
     4063          (t
     4064           (emit 'iload (variable-register var1))
     4065           (emit 'i2l)
     4066           (emit 'iload (variable-register var2))
     4067           (emit 'i2l)
     4068           (emit 'ladd)
    40624069           (emit-box-long))
    4063          (emit-move-from-stack target representation))
     4070          (emit-move-from-stack target representation)))
    40644071        ((and var1 (fixnump arg2))
    40654072         (dformat t "compile-plus case 2~%")
     
    41024109         (dformat t "compile-plus case 5~%")
    41034110         (compile-form arg1 :target :stack)
    4104          (maybe-emit-clear-values arg2)
     4111         (maybe-emit-clear-values arg1)
    41054112         (emit-invoke-method "incr" target representation))
    41064113        ((arg-is-fixnum-p arg1)
     
    41374144
    41384145(defun compile-minus (form &key (target *val*) representation)
    4139   (let ((new-form (rewrite-function-call form)))
    4140     (when (neq new-form form)
    4141       (return-from compile-minus (compile-form new-form :target target))))
    4142   (let* ((args (cdr form))
    4143          (len (length args)))
    4144     (case len
    4145       (2
    4146        (let ((first (first args))
    4147              (second (second args)))
     4146;;   (let ((new-form (rewrite-function-call form)))
     4147;;     (when (neq new-form form)
     4148;;       (return-from compile-minus (compile-form new-form :target target))))
     4149  (case (length form)
     4150    (3
     4151     (let* ((args (cdr form))
     4152            (arg1 (first args))
     4153            (arg2 (second args))
     4154            (var1 (unboxed-fixnum-variable arg1))
     4155            (var2 (unboxed-fixnum-variable arg2)))
     4156       (cond
     4157        ((and (numberp arg1) (numberp arg2))
     4158         (compile-constant (- arg1 arg2)
     4159                           :target target
     4160                           :representation representation))
     4161        ((and var1 var2)
     4162         (dformat t "compile-minus case 1~%")
     4163         (aver (variable-register var1))
     4164         (aver (variable-register var2))
    41484165         (cond
    4149           ((and (numberp first) (numberp second))
    4150            (compile-constant (- first second) :target target))
    4151           ((eql second 1)
    4152            (cond
    4153             ((unboxed-fixnum-variable-p first)
    4154              (aver (variable-register (find-visible-variable first)))
    4155              (emit 'iload (variable-register (find-visible-variable first)))
    4156              (emit 'i2l)
    4157              (emit 'iconst_1)
    4158              (emit 'i2l)
    4159              (emit 'lsub)
    4160              (emit-box-long)
    4161              (emit-move-from-stack target))
    4162             (t
    4163              (compile-form first :target :stack)
    4164              (emit-invoke-method "decr" target representation))))
    4165           ((fixnump second)
    4166            (dformat t "compile-minus fixnump second case~%")
    4167            (cond
    4168             ((unboxed-fixnum-variable-p first)
    4169              (dformat t "unboxed-fixnum-variable-p first case~%")
    4170              (aver (variable-register (find-visible-variable first)))
    4171              (emit 'iload (variable-register (find-visible-variable first)))
    4172              (emit 'i2l)
    4173              (emit-push-constant-int second)
    4174              (emit 'i2l)
    4175              (emit 'lsub)
    4176              (emit-box-long)
    4177              (emit-move-from-stack target))
    4178             (t
    4179              (compile-form first :target :stack)
    4180              (maybe-emit-clear-values first)
    4181              (emit-push-constant-int second)
    4182              (emit-invokevirtual +lisp-object-class+
    4183                                  "subtract"
    4184                                  "(I)Lorg/armedbear/lisp/LispObject;"
    4185                                  -1)
    4186              (when (eq representation :unboxed-fixnum)
    4187                (emit-unbox-fixnum))
    4188              (emit-move-from-stack target representation))))
     4166          ((eq representation :unboxed-fixnum)
     4167           (emit 'iload (variable-register var1))
     4168           (emit 'iload (variable-register var2))
     4169           (emit 'isub))
    41894170          (t
    4190            (compile-binary-operation "subtract" args target representation)))))
    4191       (t
    4192        (compile-function-call form target representation)))))
     4171           (emit 'iload (variable-register var1))
     4172           (emit 'i2l)
     4173           (emit 'iload (variable-register var2))
     4174           (emit 'i2l)
     4175           (emit 'lsub)
     4176           (emit-box-long)))
     4177         (emit-move-from-stack target representation))
     4178        ((and var1 (fixnump arg2))
     4179         (dformat t "compile-minus case 2~%")
     4180         (aver (variable-register var1))
     4181         (cond
     4182          ((eq representation :unboxed-fixnum)
     4183           (emit-push-int var1)
     4184           (emit-push-int arg2)
     4185           (emit 'isub))
     4186          (t
     4187           (emit-push-int var1)
     4188           (emit 'i2l)
     4189           (emit-push-int arg2)
     4190           (emit 'i2l)
     4191           (emit 'lsub)
     4192           (emit-box-long)))
     4193         (emit-move-from-stack target representation))
     4194        ((and (fixnump arg1) var2)
     4195         (dformat t "compile-minus case 3~%")
     4196         (aver (variable-register var2))
     4197         (cond
     4198          ((eq representation :unboxed-fixnum)
     4199           (emit-push-int arg1)
     4200           (emit-push-int var2)
     4201           (emit 'isub))
     4202          (t
     4203           (emit-push-int arg1)
     4204           (emit 'i2l)
     4205           (emit-push-int var2)
     4206           (emit 'i2l)
     4207           (emit 'lsub)
     4208           (emit-box-long)))
     4209         (emit-move-from-stack target representation))
     4210        ((eql arg2 1)
     4211         (dformat t "compile-minus case 5~%")
     4212         (compile-form arg1 :target :stack)
     4213         (maybe-emit-clear-values arg2)
     4214         (emit-invoke-method "decr" target representation))
     4215        ((arg-is-fixnum-p arg2)
     4216         (dformat t "compile-minus case 7~%")
     4217         (compile-form arg1 :target :stack)
     4218         (maybe-emit-clear-values arg1)
     4219         (emit-push-int arg2)
     4220         (emit-invokevirtual +lisp-object-class+
     4221                             "subtract"
     4222                             "(I)Lorg/armedbear/lisp/LispObject;"
     4223                             -1)
     4224         (when (eq representation :unboxed-fixnum)
     4225           (emit-unbox-fixnum))
     4226         (emit-move-from-stack target representation))
     4227        (t
     4228         (dformat t "compile-minus case 8~%")
     4229         (compile-binary-operation "subtract" args target representation)))))
     4230    (t
     4231     (dformat t "compile-minus case 9~%")
     4232     (compile-function-call form target representation))))
    41934233
    41944234(defun compile-schar (form &key (target *val*) representation)
Note: See TracChangeset for help on using the changeset viewer.