Changeset 8307


Ignore:
Timestamp:
12/28/04 02:10:52 (17 years ago)
Author:
piso
Message:

Work in progress (fixed MISC.510).

File:
1 edited

Legend:

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

    r8305 r8307  
    22;;;
    33;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.323 2004-12-27 18:14:09 piso Exp $
     4;;; $Id: jvm.lisp,v 1.324 2004-12-28 02:10:52 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    155155;; returns variable or nil
    156156(defun unboxed-fixnum-variable (obj)
    157   (cond ((symbolp obj)
    158          (let ((variable (find-visible-variable obj)))
    159            (if (and variable
    160                     (eq (variable-representation variable) :unboxed-fixnum))
    161                variable
    162                nil)))
    163         ((variable-p obj)
    164          (if (eq (variable-representation obj) :unboxed-fixnum)
    165              obj
    166              nil))
    167         (t
    168          nil)))
     157  (cond
     158   ((symbolp obj)
     159    (let ((variable (find-visible-variable obj)))
     160      (if (and variable
     161               (eq (variable-representation variable) :unboxed-fixnum))
     162          variable
     163          nil)))
     164   ((variable-p obj)
     165    (if (eq (variable-representation obj) :unboxed-fixnum)
     166        obj
     167        nil))
     168   (t
     169    nil)))
    169170
    170171(defun arg-is-fixnum-p (arg)
     
    405406  (list 'SETQ (second form) (p1 (third form))))
    406407
    407 ;; (defun p1-the (form)
    408 ;; ;;   (dformat t "p1-the form = ~S~%" form)
    409 ;; ;;   (if (= *safety* 3)
    410 ;;       (list 'THE (second form) (p1 (third form)))
    411 ;; ;;       (p1 (third form))
    412 ;; ;;       )
    413 ;; )
    414408(defun p1-the (form)
    415409  (dformat t "p1-the form = ~S~%" form)
     
    457451(defun p1 (form)
    458452  (cond
    459 ;;    ((and (symbolp form) (constantp form)) ; a DEFCONSTANT
    460 ;;     (let ((value (symbol-value form)))
    461 ;;       (if (numberp value)
    462 ;;           value
    463 ;;           form)))
    464453   ((symbolp form)
    465454    (cond
     
    528517(install-p1-handler 'multiple-value-list  'p1-default)
    529518(install-p1-handler 'multiple-value-prog1 'p1-default)
    530 (install-p1-handler 'multiple-value-setq  'p1-lambda)
    531519(install-p1-handler 'progn                'p1-default)
    532520(install-p1-handler 'progv                'identity)
     
    936924  (emit-move-from-stack target representation))
    937925
     926(defun require-args (form n)
     927  (declare (type fixnum n))
     928  (unless (= (length form) (1+ n))
     929    (error 'program-error
     930           :format-control "Wrong number of arguments for ~A."
     931           :format-arguments (list (car form)))))
     932
    938933(defparameter *resolvers* (make-hash-table :test #'eql))
    939934
     
    973968             97 ; LADD
    974969             101 ; LSUB
     970             116 ; INEG
     971             121 ; LSHL
     972             123 ; LSHR
    975973             132 ; IINC
    976974             133 ; I2L
     
    29142912
    29152913(defun compile-if (form &key (target *val*) representation)
    2916   (dformat t "compile-if form = ~S~%" form)
     2914;;   (dformat t "compile-if form = ~S~%" form)
    29172915  (let* ((test (second form))
    29182916         (consequent (third form))
     
    39673965           (error "COMPILE-FUNCTION: unsupported case: ~S" form)))))
    39683966
    3969 (defun compile-ash (form &key (target *val*) representation)
    3970   (let ((new-form (rewrite-function-call form)))
    3971     (when (neq new-form form)
    3972       (return-from compile-ash (compile-form new-form :target target))))
     3967(defun p2-ash (form &key (target *val*) representation)
     3968  (dformat t "p2-ash form = ~S~%" form)
     3969;;   (let ((new-form (rewrite-function-call form)))
     3970;;     (when (neq new-form form)
     3971;;       (return-from compile-ash (compile-form new-form :target target))))
     3972  (require-args form 2)
    39733973  (let* ((args (cdr form))
    3974          (len (length args)))
    3975     (when (= len 2)
    3976       (let ((first (first args))
    3977             (second (second args)))
    3978         (when (fixnump second)
    3979           (compile-form first :target :stack)
    3980           (maybe-emit-clear-values first)
    3981           (emit-push-constant-int second)
    3982           (emit-invokevirtual +lisp-object-class+
    3983                               "ash"
    3984                               "(I)Lorg/armedbear/lisp/LispObject;"
    3985                               -1)
    3986           (emit-move-from-stack target)
    3987           (return-from compile-ash t)))))
    3988   (compile-function-call form target representation))
     3974         (len (length args))
     3975         (first (first args))
     3976         (var (unboxed-fixnum-variable first))
     3977         (second (second args)))
     3978    (cond
     3979     ((and var (fixnump second) (< 0 second 32))
     3980      (dformat t "p2-ash case 1~%")
     3981      (emit-push-int var)
     3982      (emit 'i2l)
     3983      (emit-push-constant-int second)
     3984      (emit 'lshl)
     3985      (emit-box-long)
     3986      (emit-move-from-stack target))
     3987     ((and var (fixnump second) (< -32 second 0))
     3988      (dformat t "p2-ash case 2~%")
     3989      (emit-push-int var)
     3990      (emit 'i2l)
     3991      (emit-push-constant-int second)
     3992      (emit 'ineg)
     3993      (emit 'lshr)
     3994      (emit-box-long)
     3995      (emit-move-from-stack target))
     3996     ((fixnump second)
     3997      (dformat t "p2-ash case 3~%")
     3998      (compile-form first :target :stack)
     3999      (maybe-emit-clear-values first)
     4000      (emit-push-constant-int second)
     4001      (emit-invokevirtual +lisp-object-class+
     4002                          "ash"
     4003                          "(I)Lorg/armedbear/lisp/LispObject;"
     4004                          -1)
     4005      (emit-move-from-stack target))
     4006     (t
     4007      (dformat t "p2-ash case 4~%")
     4008      (compile-function-call form target representation)))))
    39894009
    39904010(defun compile-logand (form &key (target *val*) representation)
    3991   (let ((new-form (rewrite-function-call form)))
    3992     (when (neq new-form form)
    3993       (return-from compile-logand (compile-form new-form :target target))))
     4011;;   (let ((new-form (rewrite-function-call form)))
     4012;;     (when (neq new-form form)
     4013;;       (return-from compile-logand (compile-form new-form :target target))))
    39944014  (let* ((args (cdr form))
    39954015         (len (length args)))
     
    47064726                                       :representation representation))
    47074727                        ((special-operator-p op)
     4728                         (dformat t "form = ~S~%" form)
    47084729                         (error "COMPILE-FORM: unsupported special operator ~S" op))
    47094730                        (t
     
    51755196
    51765197(mapc #'install-p2-handler '(aref
    5177                              ash
    51785198                             atom
    51795199                             block
     
    52135233(install-p2-handler '+      'compile-plus)
    52145234(install-p2-handler '-      'compile-minus)
     5235(install-p2-handler 'ash    'p2-ash)
    52155236(install-p2-handler 'eql    'p2-eql)
    52165237(install-p2-handler 'not    'compile-not/null)
Note: See TracChangeset for help on using the changeset viewer.