source: trunk/j/src/org/armedbear/lisp/fixme.lisp @ 8426

Last change on this file since 8426 was 8426, checked in by piso, 17 years ago

WITH-COMPILATION-UNIT is now implemented in jvm.lisp.

File size: 2.0 KB
Line 
1;;; fixme.lisp
2;;;
3;;; Copyright (C) 2003-2005 Peter Graves
4;;; $Id: fixme.lisp,v 1.27 2005-01-31 17:21:27 piso Exp $
5;;;
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19
20(in-package "SYSTEM")
21
22(defmacro declaim (&rest decls)
23`(eval-when (:compile-toplevel :load-toplevel :execute)
24   ,@(mapcar (lambda (decl) `(proclaim ',decl))
25             decls)))
26
27(defun proclaim (declaration-specifier)
28  (case (car declaration-specifier)
29    (SPECIAL
30     (dolist (name (cdr declaration-specifier))
31       (%defvar name)))
32    (OPTIMIZE
33     (dolist (spec (cdr declaration-specifier))
34       (let ((val 3)
35             (quantity spec))
36         (when (consp spec)
37           (setf quantity (car spec)
38                 val (cadr spec)))
39         (when (and (fixnump val)
40                    (<= 0 val 3))
41           (case quantity
42             (SPEED
43              (setf jvm::*speed* val))
44             (SAFETY
45              (setf jvm::*safety* val))
46             (DEBUG
47              (setf jvm::*debug* val)))))))
48    ((INLINE NOTINLINE)
49     (dolist (name (cdr declaration-specifier))
50       (when (symbolp name) ; FIXME Need to support non-symbol function names.
51         (setf (get name 'jvm::%inline) (car declaration-specifier)))))))
52
53(defun disassemble (fn)
54  (%format t "; DISASSEMBLE is not implemented.")
55  (values))
56
57(defun translate-pathname (&rest args)
58  (error "TRANSLATE-PATHNAME is not implemented."))
Note: See TracBrowser for help on using the repository browser.