Changeset 8304


Ignore:
Timestamp:
12/27/04 17:43:05 (17 years ago)
Author:
piso
Message:

COMPILE-PLUS: MISC.504, MISC.505, MISC.506, MISC.507

File:
1 edited

Legend:

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

    r8303 r8304  
    22;;;
    33;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.321 2004-12-27 15:38:08 piso Exp $
     4;;; $Id: jvm.lisp,v 1.322 2004-12-27 17:43:05 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    29062906
    29072907(defun compile-if (form &key (target *val*) representation)
     2908  (dformat t "compile-if form = ~S~%" form)
    29082909  (let* ((test (second form))
    29092910         (consequent (third form))
     
    29122913         (LABEL2 (gensym)))
    29132914    (cond ((eq test t)
    2914            (compile-form consequent :target target))
     2915           (compile-form consequent :target target :representation representation))
     2916          ((null test)
     2917           (compile-form alternate :target target :representation representation))
     2918          ((numberp test)
     2919           (compile-form consequent :target target :representation representation))
    29152920          (t
    29162921           (emit (compile-test test nil) LABEL1)
     
    40544059        ((and var1 var2)
    40554060         (dformat t "compile-plus case 1~%")
     4061         (dformat t "target = ~S representation = ~S~%" target representation)
    40564062         (aver (variable-register var1))
    40574063         (aver (variable-register var2))
    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)
    4069            (emit-box-long))
    4070           (emit-move-from-stack target representation)))
     4064         (when target
     4065           (cond
     4066            ((eq representation :unboxed-fixnum)
     4067             (emit-push-int var1)
     4068             (emit-push-int arg2)
     4069             (emit 'iadd))
     4070            (t
     4071             (emit 'iload (variable-register var1))
     4072             (emit 'i2l)
     4073             (emit 'iload (variable-register var2))
     4074             (emit 'i2l)
     4075             (emit 'ladd)
     4076             (emit-box-long)))
     4077           (emit-move-from-stack target representation)))
    40714078        ((and var1 (fixnump arg2))
    40724079         (dformat t "compile-plus case 2~%")
     
    41704177         (aver (variable-register var1))
    41714178         (aver (variable-register var2))
    4172          (cond
    4173           ((eq representation :unboxed-fixnum)
    4174            (emit 'iload (variable-register var1))
    4175            (emit 'iload (variable-register var2))
    4176            (emit 'isub))
    4177           (t
    4178            (emit 'iload (variable-register var1))
    4179            (emit 'i2l)
    4180            (emit 'iload (variable-register var2))
    4181            (emit 'i2l)
    4182            (emit 'lsub)
    4183            (emit-box-long)))
    4184          (emit-move-from-stack target representation))
     4179         (when target
     4180           (cond
     4181            ((eq representation :unboxed-fixnum)
     4182             (emit 'iload (variable-register var1))
     4183             (emit 'iload (variable-register var2))
     4184             (emit 'isub))
     4185            (t
     4186             (emit 'iload (variable-register var1))
     4187             (emit 'i2l)
     4188             (emit 'iload (variable-register var2))
     4189             (emit 'i2l)
     4190             (emit 'lsub)
     4191             (emit-box-long)))
     4192           (emit-move-from-stack target representation)))
    41854193        ((and var1 (fixnump arg2))
    41864194         (dformat t "compile-minus case 2~%")
Note: See TracChangeset for help on using the changeset viewer.