Changeset 4663
- Timestamp:
- 11/07/03 16:17:24 (19 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/j/src/org/armedbear/lisp/jvm.lisp
r4661 r4663 2 2 ;;; 3 3 ;;; Copyright (C) 2003 Peter Graves 4 ;;; $Id: jvm.lisp,v 1.1 2 2003-11-06 17:14:50piso Exp $4 ;;; $Id: jvm.lisp,v 1.13 2003-11-07 16:17:24 piso Exp $ 5 5 ;;; 6 6 ;;; This program is free software; you can redistribute it and/or … … 2023 2023 (install-handler '- 'compile-minus) 2024 2024 2025 #+nil 2025 (defun process-optimization-declarations (forms) 2026 (let (alist ()) 2027 (dolist (form forms) 2028 (unless (and (consp form) (eq (car form) 'declare)) 2029 (return)) 2030 (let ((decl (cadr form))) 2031 (when (eq (car decl) 'optimize) 2032 (dolist (spec (cdr decl)) 2033 (let ((val 3) 2034 (quantity spec)) 2035 (if (consp spec) 2036 (setq quantity (car spec) val (cadr spec))) 2037 (if (and (fixnump val) (<= 0 val 3) (memq quantity '(debug speed space safety compilation-speed))) 2038 (push (cons quantity val) alist))))))) 2039 alist)) 2040 2026 2041 (defun compile (name &optional definition) 2027 (jvm:jvm-compile name definition)) 2042 (if (consp name) 2043 (return-from compile (values name nil nil))) 2044 (if (and name (fboundp name) (typep (symbol-function name) 'generic-function)) 2045 (return-from compile (values name nil nil))) 2046 (unless definition 2047 (setq definition (or (and (symbolp name) (macro-function name)) 2048 (fdefinition name)))) 2049 (let ((expr (get-lambda-to-compile definition)) 2050 (speed nil)) 2051 (when (eq (car expr) 'lambda) 2052 (let ((decls (process-optimization-declarations (cddr expr)))) 2053 (setf speed (cdr (assoc 'speed decls))))) 2054 (if (eql speed 3) 2055 (progn 2056 (c::%compile name definition) 2057 (jvm-compile name definition)) 2058 (progn 2059 (c::%compile name definition) 2060 )))) 2028 2061 2029 2062 (defmacro defun (name lambda-list &rest body) 2030 2063 `(progn 2031 2064 (sys::%defun ',name ',lambda-list ',body) 2032 (compiler::%compile ',name) 2033 (when *auto-compile* 2034 (jvm-compile ',name)) 2065 (compile ',name) 2035 2066 ',name)) 2036 2067
Note: See TracChangeset
for help on using the changeset viewer.