Changeset 8300


Ignore:
Timestamp:
12/27/04 02:30:18 (17 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

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

    r8299 r8300  
    22;;;
    33;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.317 2004-12-27 00:27:16 piso Exp $
     4;;; $Id: jvm.lisp,v 1.318 2004-12-27 02:30:18 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    405405  (list 'SETQ (second form) (p1 (third form))))
    406406
     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;; )
    407414(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 )
     415  (dformat t "p1-the form = ~S~%" form)
     416  (let ((type (second form))
     417        (expr (third form)))
     418    (cond
     419     ((and (listp type) (eq (car type) 'VALUES))
     420      ;; FIXME
     421      (p1 expr))
     422     ((= *safety* 3)
     423      (dformat t "p1-the expr = ~S~%" expr)
     424      (let* ((sym (gensym))
     425             (new-expr
     426              `(let ((,sym ,expr))
     427                 (sys::require-type ,sym ',type)
     428                 ,sym)))
     429        (dformat t "p1-the new-expr = ~S~%" new-expr)
     430        (p1 new-expr)))
     431     (t
     432      (dformat t "p1-the t case expr = ~S~%" expr)
     433      (p1 expr)))))
    414434
    415435(defun p1-default (form)
     
    24662486
    24672487(defun compile-function-call (form target representation)
    2468   (let ((new-form (rewrite-function-call form)))
    2469     (when (neq new-form form)
    2470       (return-from compile-function-call (compile-form new-form :target target))))
     2488;;   (let ((new-form (rewrite-function-call form)))
     2489;;     (when (neq new-form form)
     2490;;       (return-from compile-function-call (compile-form new-form :target target))))
    24712491  (let ((fun (car form))
    24722492        (args (cdr form)))
     
    40864106        ((arg-is-fixnum-p arg1)
    40874107         (dformat t "compile-plus case 6~%")
     4108         (emit-push-int arg1)
    40884109         (compile-form arg2 :target :stack)
    40894110         (maybe-emit-clear-values arg2)
    4090          (emit-push-int arg1)
     4111         (emit 'swap)
    40914112         (emit-invokevirtual +lisp-object-class+
    40924113                             "add"
     
    44094430
    44104431(defun p2-the (form &key (target *val*) representation)
    4411 ;;   (dformat t "p2-the form = ~S~%" form)
    4412   (let ((type (second form))
    4413         (expr (third form)))
    4414   (cond
    4415    ((and (listp type) (eq (car type) 'VALUES))
    4416     ;; FIXME
    4417     (compile-form expr :target target :representation representation))
    4418    ((= *safety* 3)
    4419     (let* ((sym (gensym))
    4420            (new-expr
    4421             `(let ((,sym ,expr))
    4422                (sys::require-type ,sym ',type)
    4423                ,sym)))
    4424 ;;       (dformat t "new-expr = ~S~%" new-expr)
    4425       (compile-form (p1 new-expr) :target target :representation representation)))
    4426    (t
    4427     (compile-form expr :target target :representation representation)))))
     4432  (dformat t "p2-the form = ~S~%" form)
     4433;;   (let ((type (second form))
     4434;;         (expr (third form)))
     4435;;   (cond
     4436;;    ((and (listp type) (eq (car type) 'VALUES))
     4437;;     ;; FIXME
     4438;;     (compile-form expr :target target :representation representation))
     4439;;    ((= *safety* 3)
     4440;;     (let* ((sym (gensym))
     4441;;            (new-expr
     4442;;             `(let ((,sym ,expr))
     4443;;                (sys::require-type ,sym ',type)
     4444;;                ,sym)))
     4445;; ;;       (dformat t "new-expr = ~S~%" new-expr)
     4446;;       (compile-form (p1 new-expr) :target target :representation representation)))
     4447;;    (t
     4448;;     (compile-form expr :target target :representation representation)))))
     4449  (compile-form (third form) :target target :representation representation))
    44284450
    44294451(defun compile-catch (form &key (target *val*) representation)
     
    47284750  (let ((*current-compiland* compiland)
    47294751        (precompiled-form (compiland-lambda-expression compiland))
    4730         (classfile (compiland-classfile compiland)))
     4752        (classfile (compiland-classfile compiland))
     4753        (*speed* *speed*)
     4754        (*safety* *safety*)
     4755        (*debug* *debug*)
     4756        )
     4757    (process-optimization-declarations (cddr precompiled-form))
    47314758    ;; Pass 1.
    47324759    (setf precompiled-form (p1 precompiled-form))
    47334760    ;; Pass 2.
    4734     (let* ((*speed* *speed*)
    4735            (*safety* *safety*)
    4736            (*debug* *debug*)
     4761    (let* (
     4762;;            (*speed* *speed*)
     4763;;            (*safety* *safety*)
     4764;;            (*debug* *debug*)
    47374765           (*declared-symbols* (make-hash-table :test 'eq))
    47384766           (*declared-functions* (make-hash-table :test 'equal))
     
    49074935                 (setf (variable-index variable) nil)))))
    49084936
    4909       (process-optimization-declarations body)
     4937;;       (process-optimization-declarations body)
    49104938
    49114939      (compile-progn-body body :stack)
     
    51255153        (return))
    51265154      (let ((decl (cadr form)))
    5127         (when (eq (car decl) 'optimize)
     5155        (when (eq (car decl) 'OPTIMIZE)
    51285156          (dolist (spec (cdr decl))
    51295157            (let ((val 3)
Note: See TracChangeset for help on using the changeset viewer.