Changeset 8307
- Timestamp:
- 12/28/04 02:10:52 (18 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/j/src/org/armedbear/lisp/jvm.lisp
r8305 r8307 2 2 ;;; 3 3 ;;; Copyright (C) 2003-2004 Peter Graves 4 ;;; $Id: jvm.lisp,v 1.32 3 2004-12-27 18:14:09piso Exp $4 ;;; $Id: jvm.lisp,v 1.324 2004-12-28 02:10:52 piso Exp $ 5 5 ;;; 6 6 ;;; This program is free software; you can redistribute it and/or … … 155 155 ;; returns variable or nil 156 156 (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))) 169 170 170 171 (defun arg-is-fixnum-p (arg) … … 405 406 (list 'SETQ (second form) (p1 (third form)))) 406 407 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 ;; )414 408 (defun p1-the (form) 415 409 (dformat t "p1-the form = ~S~%" form) … … 457 451 (defun p1 (form) 458 452 (cond 459 ;; ((and (symbolp form) (constantp form)) ; a DEFCONSTANT460 ;; (let ((value (symbol-value form)))461 ;; (if (numberp value)462 ;; value463 ;; form)))464 453 ((symbolp form) 465 454 (cond … … 528 517 (install-p1-handler 'multiple-value-list 'p1-default) 529 518 (install-p1-handler 'multiple-value-prog1 'p1-default) 530 (install-p1-handler 'multiple-value-setq 'p1-lambda)531 519 (install-p1-handler 'progn 'p1-default) 532 520 (install-p1-handler 'progv 'identity) … … 936 924 (emit-move-from-stack target representation)) 937 925 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 938 933 (defparameter *resolvers* (make-hash-table :test #'eql)) 939 934 … … 973 968 97 ; LADD 974 969 101 ; LSUB 970 116 ; INEG 971 121 ; LSHL 972 123 ; LSHR 975 973 132 ; IINC 976 974 133 ; I2L … … 2914 2912 2915 2913 (defun compile-if (form &key (target *val*) representation) 2916 (dformat t "compile-if form = ~S~%" form)2914 ;; (dformat t "compile-if form = ~S~%" form) 2917 2915 (let* ((test (second form)) 2918 2916 (consequent (third form)) … … 3967 3965 (error "COMPILE-FUNCTION: unsupported case: ~S" form))))) 3968 3966 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) 3973 3973 (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))))) 3989 4009 3990 4010 (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)))) 3994 4014 (let* ((args (cdr form)) 3995 4015 (len (length args))) … … 4706 4726 :representation representation)) 4707 4727 ((special-operator-p op) 4728 (dformat t "form = ~S~%" form) 4708 4729 (error "COMPILE-FORM: unsupported special operator ~S" op)) 4709 4730 (t … … 5175 5196 5176 5197 (mapc #'install-p2-handler '(aref 5177 ash5178 5198 atom 5179 5199 block … … 5213 5233 (install-p2-handler '+ 'compile-plus) 5214 5234 (install-p2-handler '- 'compile-minus) 5235 (install-p2-handler 'ash 'p2-ash) 5215 5236 (install-p2-handler 'eql 'p2-eql) 5216 5237 (install-p2-handler 'not 'compile-not/null)
Note: See TracChangeset
for help on using the changeset viewer.