Changeset 8515


Ignore:
Timestamp:
02/10/05 01:43:09 (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

    r8510 r8515  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.394 2005-02-09 18:33:07 piso Exp $
     4;;; $Id: jvm.lisp,v 1.395 2005-02-10 01:43:09 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    24472447(define-binary-operator ' =                  "IS_E")
    24482448(define-binary-operator '/=                  "IS_NE")
    2449 (define-binary-operator 'mod                 "MOD")
    24502449(define-binary-operator 'ash                 "ash")
    24512450(define-binary-operator 'logand              "logand")
     
    42324231  (compile-function-call form target representation))
    42334232
     4233(defun p2-mod (form &key (target :stack) representation)
     4234  (unless (check-arg-count form 2)
     4235    (compile-function-call form target representation)
     4236    (return-from p2-mod))
     4237  (let* ((args (cdr form))
     4238         (arg1 (car args))
     4239         (arg2 (cadr args)))
     4240    (cond ((fixnump arg2)
     4241           (compile-form arg1 :target :stack)
     4242           (maybe-emit-clear-values arg1)
     4243           (emit-push-constant-int arg2)
     4244           (emit-invokevirtual +lisp-object-class+ "MOD" '("I") +lisp-object+))
     4245          (t
     4246           (compile-form arg1 :target :stack)
     4247           (compile-form arg2 :target :stack)
     4248           (unless (and (single-valued-p arg1)
     4249                        (single-valued-p arg2))
     4250             (emit-clear-values))
     4251           (emit-invokevirtual +lisp-object-class+ "MOD" (list +lisp-object+) +lisp-object+)))
     4252    (when (eq representation :unboxed-fixnum)
     4253      (emit-unbox-fixnum))
     4254    (emit-move-from-stack target representation)))
     4255
    42344256(defun p2-zerop (form &key (target :stack) representation)
    42354257  (unless (check-arg-count form 1)
     
    43304352                       (emit 'iadd))
    43314353                      (t
    4332 ;;                        (emit 'iload (variable-register var1))
    4333 ;;                        (emit 'i2l)
    43344354                       (emit-push-long var1)
    4335 ;;                        (emit 'iload (variable-register var2))
    4336 ;;                        (emit 'i2l)
    43374355                       (emit-push-long var2)
    43384356                       (emit 'ladd)
     
    43474365                     (emit 'iadd))
    43484366                    (t
    4349 ;;                      (emit-push-int var1)
    4350 ;;                      (emit 'i2l)
    43514367                     (emit-push-long var1)
    4352 ;;                      (emit-push-int arg2)
    4353 ;;                      (emit 'i2l)
    43544368                     (emit-push-long arg2)
    43554369                     (emit 'ladd)
     
    43644378                     (emit 'iadd))
    43654379                    (t
    4366 ;;                      (emit-push-int arg1)
    4367 ;;                      (emit 'i2l)
    43684380                     (emit-push-long arg1)
    4369 ;;                      (emit-push-int var2)
    4370 ;;                      (emit 'i2l)
    43714381                     (emit-push-long var2)
    43724382                     (emit 'ladd)
     
    45694579    (emit-clear-values))
    45704580  (emit-invokevirtual +lisp-object-class+ "AREF" '("I") +lisp-object+)
    4571   (emit-move-from-stack target))
     4581  (when (eq representation :unboxed-fixnum)
     4582    (emit-unbox-fixnum))
     4583  (emit-move-from-stack target representation))
    45724584
    45734585(defun p2-not/null (form &key (target :stack) representation)
     
    47074719        form)))
    47084720
    4709 (defun compile-setq (form &key (target :stack) representation)
    4710 ;;   (dformat t "compile-setq form = ~S target = ~S representation = ~S~%"
     4721(defun p2-setq (form &key (target :stack) representation)
     4722;;   (dformat t "p2-setq form = ~S target = ~S representation = ~S~%"
    47114723;;            form target representation)
    47124724  (unless (= (length form) 3)
    4713     (return-from compile-setq (compile-form (precompiler::precompile-setq form)
     4725    (return-from p2-setq (compile-form (precompiler::precompile-setq form)
    47144726                                            :target target)))
    47154727  (let ((expansion (macroexpand (second form))))
    47164728    (unless (eq expansion (second form))
    47174729      (compile-form (list 'SETF expansion (third form)))
    4718       (return-from compile-setq)))
     4730      (return-from p2-setq)))
    47194731  (let* ((name (second form))
    47204732         (value-form (third form))
     
    47244736           (let ((new-form (rewrite-setq form)))
    47254737             (when (neq new-form form)
    4726                (return-from compile-setq
     4738               (return-from p2-setq
    47274739                            (compile-form (p1 new-form) :target target))))
    47284740           (emit-push-current-thread)
     
    47374749                    (equal value-form (list '+ (variable-name variable) 1))
    47384750                    (equal value-form (list '+ 1 (variable-name variable)))))
    4739            (dformat t "compile-setq incf unboxed-fixnum case~%")
     4751           (dformat t "p2-setq incf unboxed-fixnum case~%")
    47404752           (emit 'iinc (variable-register variable) 1)
    47414753           (when target
    4742              (dformat t "compile-setq constructing boxed fixnum for ~S~%"
     4754             (dformat t "p2-setq constructing boxed fixnum for ~S~%"
    47434755                      (variable-name variable))
    47444756             (emit 'new +lisp-fixnum-class+)
     
    47494761             (emit-move-from-stack target)))
    47504762          ((eq (variable-representation variable) :unboxed-fixnum)
    4751            (dformat t "compile-setq unboxed-fixnum case value-form = ~S~%"
     4763           (dformat t "p2-setq unboxed-fixnum case value-form = ~S~%"
    47524764                    value-form)
    4753            (compile-form value-form :target :stack)
     4765           (compile-form value-form :target :stack :representation :unboxed-fixnum)
    47544766           (maybe-emit-clear-values value-form)
    47554767           (when target
    47564768             (emit 'dup))
    4757            (emit-unbox-fixnum)
    47584769           (emit 'istore (variable-register variable))
    47594770           (when target
    4760              (emit-move-from-stack target)))
     4771             ;; int on stack here
     4772             (unless (eq representation :unboxed-fixnum)
     4773               ;; need to box int
     4774               (emit 'new +lisp-fixnum-class+) ; stack: int new-fixnum
     4775               (emit 'dup_x1)                  ; stack: new-fixnum int new-fixnum
     4776               (emit 'swap)                    ; stack: new-fixnum new-fixnum int
     4777               (emit-invokespecial-init +lisp-fixnum-class+ '("I")) ; stack: fixnum
     4778             (emit-move-from-stack target representation))))
    47614779          (t
    47624780           (compile-form value-form :target :stack)
     
    47684786             (when (eq representation :unboxed-fixnum)
    47694787               (emit-unbox-fixnum))
    4770              (emit-move-from-stack target))))))
     4788             (emit-move-from-stack target representation))))))
    47714789
    47724790(defun p2-the (form &key (target :stack) representation)
     
    57825800                             progn
    57835801                             quote
    5784                              setq
    57855802                             throw
    57865803                             values))
     
    58065823(install-p2-handler 'length         'p2-length)
    58075824(install-p2-handler 'logand         'p2-logand)
     5825(install-p2-handler 'mod            'p2-mod)
    58085826(install-p2-handler 'not            'p2-not/null)
    58095827(install-p2-handler 'null           'p2-not/null)
     
    58115829(install-p2-handler 'rplacd         'p2-rplacd)
    58125830(install-p2-handler 'schar          'p2-schar)
     5831(install-p2-handler 'setq           'p2-setq)
    58135832(install-p2-handler 'the            'p2-the)
    58145833(install-p2-handler 'zerop          'p2-zerop)
Note: See TracChangeset for help on using the changeset viewer.