Changeset 8312


Ignore:
Timestamp:
12/29/04 01:26:15 (17 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

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

    r8310 r8312  
    22;;;
    33;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.326 2004-12-28 12:29:21 piso Exp $
     4;;; $Id: jvm.lisp,v 1.327 2004-12-29 01:26:15 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    599599(defun u2 (n)
    600600  (declare (optimize speed))
     601  (declare (type fixnum n))
    601602  (list (logand (ash n -8) #xff)
    602603        (logand n #xff)))
     
    969970             101 ; LSUB
    970971             116 ; INEG
     972             120 ; ISHL
    971973             121 ; LSHL
     974             122 ; ISHR
    972975             123 ; LSHR
     976             126 ; IAND
    973977             132 ; IINC
    974978             133 ; I2L
     
    24842488
    24852489(defun compile-function-call (form target representation)
    2486 ;;   (let ((new-form (rewrite-function-call form)))
    2487 ;;     (when (neq new-form form)
    2488 ;;       (return-from compile-function-call (compile-form new-form :target target))))
    24892490  (let ((op (car form))
    24902491        (args (cdr form)))
     
    39633964(defun p2-ash (form &key (target *val*) representation)
    39643965  (dformat t "p2-ash form = ~S~%" form)
    3965 ;;   (let ((new-form (rewrite-function-call form)))
    3966 ;;     (when (neq new-form form)
    3967 ;;       (return-from compile-ash (compile-form new-form :target target))))
    39683966  (require-args form 2)
    39693967  (let* ((args (cdr form))
    39703968         (len (length args))
    3971          (first (first args))
    3972          (var (unboxed-fixnum-variable first))
    3973          (second (second args)))
     3969         (arg1 (first args))
     3970         (arg2 (second args))
     3971         (var1 (unboxed-fixnum-variable arg1))
     3972         (var2 (unboxed-fixnum-variable arg2))
     3973         )
    39743974    (cond
    3975      ((and var (fixnump second) (< 0 second 32))
     3975     ((and (numberp arg1) (numberp arg2))
    39763976      (dformat t "p2-ash case 1~%")
    3977       (emit-push-int var)
     3977      (compile-constant (ash arg1 arg2)
     3978                        :target target
     3979                        :representation representation))
     3980     ((and var1 (fixnump arg2) (< 0 arg2 32))
     3981      (dformat t "p2-ash case 2~%")
     3982      (emit-push-int var1)
    39783983      (emit 'i2l)
    3979       (emit-push-constant-int second)
     3984      (emit-push-constant-int arg2)
    39803985      (emit 'lshl)
    39813986      (emit-box-long)
    39823987      (emit-move-from-stack target))
    3983      ((and var (fixnump second) (< -32 second 0))
    3984       (dformat t "p2-ash case 2~%")
    3985       (emit-push-int var)
    3986       (emit 'i2l)
    3987       (emit-push-constant-int second)
    3988       (emit 'ineg)
    3989       (emit 'lshr)
    3990       (emit-box-long)
     3988     ((and var1 (fixnump arg2) (< -32 arg2 0))
     3989      (dformat t "p2-ash case 3~%")
     3990      (emit 'new +lisp-fixnum-class+)
     3991      (emit 'dup)
     3992      (emit-push-int var1)
     3993      (emit-push-constant-int (- arg2))
     3994      (emit 'ishr)
     3995      (emit-invokespecial +lisp-fixnum-class+ "<init>" "(I)V" -2)
    39913996      (emit-move-from-stack target))
    3992      ((fixnump second)
    3993       (dformat t "p2-ash case 3~%")
    3994       (compile-form first :target :stack)
    3995       (maybe-emit-clear-values first)
    3996       (emit-push-constant-int second)
     3997     (var2
     3998      (dformat t "p2-ash case 4~%")
     3999      (compile-form arg1 :target :stack)
     4000      (maybe-emit-clear-values arg1)
     4001      (emit 'iload (variable-register var2))
     4002      (emit-invokevirtual +lisp-object-class+
     4003                          "ash"
     4004                          "(I)Lorg/armedbear/lisp/LispObject;"
     4005                          -1)
     4006      (emit-move-from-stack target))
     4007     ((fixnump arg2)
     4008      (dformat t "p2-ash case 5~%")
     4009      (compile-form arg1 :target :stack)
     4010      (maybe-emit-clear-values arg1)
     4011      (emit-push-constant-int arg2)
    39974012      (emit-invokevirtual +lisp-object-class+
    39984013                          "ash"
     
    40014016      (emit-move-from-stack target))
    40024017     (t
    4003       (dformat t "p2-ash case 4~%")
     4018      (dformat t "p2-ash case 6~%")
    40044019      (compile-function-call form target representation)))))
    40054020
    4006 (defun compile-logand (form &key (target *val*) representation)
    4007 ;;   (let ((new-form (rewrite-function-call form)))
    4008 ;;     (when (neq new-form form)
    4009 ;;       (return-from compile-logand (compile-form new-form :target target))))
     4021(defun p2-logand (form &key (target *val*) representation)
    40104022  (let* ((args (cdr form))
    40114023         (len (length args)))
    40124024    (when (= len 2)
    4013       (let ((first (first args))
    4014             (second (second args)))
    4015         (when (fixnump second)
    4016           (compile-form first :target :stack)
    4017           (maybe-emit-clear-values first)
    4018           (emit-push-constant-int second)
     4025      (let* ((arg1 (first args))
     4026             (arg2 (second args))
     4027             (var1 (unboxed-fixnum-variable arg1)))
     4028        (cond
     4029         ((and var1 (fixnump arg2))
     4030          (unless (eq representation :unboxed-fixnum)
     4031            (emit 'new +lisp-fixnum-class+)
     4032            (emit 'dup))
     4033          (emit 'iload (variable-register var1))
     4034          (emit-push-constant-int arg2)
     4035          (emit 'iand)
     4036          (unless (eq representation :unboxed-fixnum)
     4037            (emit-invokespecial +lisp-fixnum-class+ "<init>" "(I)V" -2))
     4038          (emit-move-from-stack target representation)
     4039          (return-from p2-logand t))
     4040         ((fixnump arg2)
     4041          (compile-form arg1 :target :stack)
     4042          (maybe-emit-clear-values arg1)
     4043          (emit-push-constant-int arg2)
    40194044          (emit-invokevirtual +lisp-object-class+
    40204045                              "logand"
     
    40224047                              -1)
    40234048          (emit-move-from-stack target)
    4024           (return-from compile-logand t)))))
     4049          (return-from p2-logand t))))))
    40254050  (compile-function-call form target representation))
    40264051
    40274052(defun compile-length (form &key (target *val*) representation)
    4028   (unless (= (length form) 2)
    4029     (error 'simple-program-error
    4030            :format-control "Wrong number of arguments for LENGTH."))
     4053  (require-args form 1)
    40314054  (let ((arg (cadr form)))
    40324055    (compile-form arg :target :stack)
     
    40464069
    40474070(defun compile-nth (form &key (target *val*) representation)
    4048   (unless (= (length form) 3)
    4049     (error 'program-error
    4050            :format-control "Wrong number of arguments for NTH."))
     4071  (require-args form 2)
    40514072  (let ((index-form (second form))
    40524073        (list-form (third form)))
     
    40664087
    40674088(defun compile-plus (form &key (target *val*) representation)
    4068 ;;   (let ((new-form (rewrite-function-call form)))
    4069 ;;     (when (neq new-form form)
    4070 ;;       (return-from compile-plus (compile-form new-form :target target))))
    40714089  (case (length form)
    40724090    (3
     
    41824200
    41834201(defun compile-minus (form &key (target *val*) representation)
    4184 ;;   (let ((new-form (rewrite-function-call form)))
    4185 ;;     (when (neq new-form form)
    4186 ;;       (return-from compile-minus (compile-form new-form :target target))))
    41874202  (case (length form)
    41884203    (3
     
    43494364
    43504365(defun compile-values (form &key (target *val*) representation)
    4351 ;;   (let ((new-form (rewrite-function-call form)))
    4352 ;;     (when (neq new-form form)
    4353 ;;       (return-from compile-values (compile-form new-form :target target))))
    43544366  (let ((args (cdr form)))
    43554367    (case (length args)
     
    52085220                             length
    52095221                             locally
    5210                              logand
    52115222                             multiple-value-bind
    52125223                             multiple-value-call
     
    52345245(install-p2-handler 'ash    'p2-ash)
    52355246(install-p2-handler 'eql    'p2-eql)
     5247(install-p2-handler 'logand 'p2-logand)
    52365248(install-p2-handler 'not    'compile-not/null)
    52375249(install-p2-handler 'null   'compile-not/null)
Note: See TracChangeset for help on using the changeset viewer.