Changeset 4703


Ignore:
Timestamp:
11/11/03 20:13:03 (18 years ago)
Author:
piso
Message:

Handlers now take second argument FOR-EFFECT.

File:
1 edited

Legend:

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

    r4698 r4703  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.23 2003-11-11 19:32:43 piso Exp $
     4;;; $Id: jvm.lisp,v 1.24 2003-11-11 20:13:03 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    15221522  'if_acmpeq)
    15231523
    1524 (defun compile-if (form)
     1524(defun compile-if (form for-effect)
    15251525  (let* ((test (second form))
    15261526         (consequent (third form))
     
    15371537    (emit 'label `,label2)))
    15381538
    1539 (defun compile-multiple-value-list (form)
     1539(defun compile-multiple-value-list (form for-effect)
    15401540  (compile-form (second form))
    15411541  (unless (remove-store-value)
     
    15471547  (emit-store-value))
    15481548
    1549 (defun compile-let/let* (form)
     1549(defun compile-let/let* (form for-effect)
    15501550  (let* ((saved-fp (fill-pointer *locals*))
    15511551         (varlist (second form))
     
    16801680      (tag-label (aref *tags* index)))))
    16811681
    1682 (defun compile-tagbody (form)
     1682(defun compile-tagbody (form for-effect)
    16831683  (let ((saved-fp (fill-pointer *tags*))
    16841684        (body (cdr form)))
     
    17021702  (emit-store-value))
    17031703
    1704 (defun compile-go (form)
     1704(defun compile-go (form for-effect)
    17051705  (let* ((name (cadr form))
    17061706         (label (label-for-tag name)))
     
    17091709  (emit 'goto label)))
    17101710
    1711 (defun compile-block (form)
     1711(defun compile-block (form for-effect)
    17121712   (let* ((rest (cdr form))
    17131713          (block-label (car rest))
     
    17191719     (emit 'label `,block-exit)))
    17201720
    1721 (defun compile-progn (form)
     1721(defun compile-progn (form for-effect)
    17221722  (do ((forms (cdr form) (cdr forms)))
    17231723      ((null forms))
    17241724    (compile-form (car forms) (cdr forms))))
    17251725
    1726 (defun compile-setq (form)
     1726(defun compile-setq (form for-effect)
    17271727  (unless (= (length form) 3)
    17281728    (error "COMPILE-SETQ too many args for SETQ"))
     
    17651765      (emit-store-value))))
    17661766
    1767 (defun compile-quote (form)
     1767(defun compile-quote (form for-effect)
    17681768   (let ((obj (second form)))
    17691769     (cond ((null obj)
     
    17911791            (error "COMPILE-QUOTE: unsupported case: ~S" form)))))
    17921792
    1793 (defun compile-declare (form)
     1793(defun compile-declare (form for-effect)
    17941794  ;; Nothing to do.
    17951795  )
    17961796
    1797 (defun compile-function (form)
     1797(defun compile-function (form for-effect)
    17981798   (let ((obj (second form)))
    17991799     (cond ((symbolp obj)
     
    18251825            (error "COMPILE-FUNCTION: unsupported case: ~S" form)))))
    18261826
    1827 (defun compile-return-from (form)
     1827(defun compile-return-from (form for-effect)
    18281828   (let* ((rest (cdr form))
    18291829          (block-label (car rest))
     
    18351835     (emit 'goto `,block-exit)))
    18361836
    1837 (defun compile-plus (form)
     1837(defun compile-plus (form for-effect)
    18381838  (let* ((args (cdr form))
    18391839         (len (length args)))
     
    18541854       (compile-function-call '+ args)))))
    18551855
    1856 (defun compile-minus (form)
     1856(defun compile-minus (form for-effect)
    18571857  (let* ((args (cdr form))
    18581858         (len (length args)))
     
    19071907  (cond
    19081908   ((consp form)
    1909     (let ((first (first form))
    1910           (rest (rest form)))
    1911       (when (macro-function first)
     1909    (let ((op (car form))
     1910          (args (cdr form)))
     1911      (when (macro-function op)
    19121912        (compile-form (macroexpand form))
    19131913        (return-from compile-form))
    1914       (when (symbolp first)
    1915         (let ((handler (get first 'jvm-compile)))
     1914      (when (symbolp op)
     1915        (let ((handler (get op 'jvm-compile-handler)))
    19161916          (when handler
    1917             (funcall handler form)
     1917            (funcall handler form for-effect)
    19181918            (return-from compile-form))))
    19191919      (cond
    1920        ((special-operator-p first)
    1921         (error "COMPILE-FORM unhandled special operator ~S" first))
     1920       ((special-operator-p op)
     1921        (error "COMPILE-FORM unhandled special operator ~S" op))
    19221922       (t ; Function call.
    1923         (compile-function-call first rest for-effect)))))
     1923        (compile-function-call op args for-effect)))))
    19241924   ((eq form '())
    19251925    (unless for-effect
     
    21562156    (unless (and handler (fboundp handler))
    21572157      (error "no handler for ~S" fun))
    2158     (setf (get fun 'jvm-compile) handler)))
     2158    (setf (get fun 'jvm-compile-handler) handler)))
    21592159
    21602160(mapc #'install-handler '(block
Note: See TracChangeset for help on using the changeset viewer.