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
RevLine 
[3404]1;;; fixme.lisp
2;;;
[8426]3;;; Copyright (C) 2003-2005 Peter Graves
4;;; $Id: fixme.lisp,v 1.27 2005-01-31 17:21:27 piso Exp $
[3404]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
[4003]20(in-package "SYSTEM")
21
[4461]22(defmacro declaim (&rest decls)
[7178]23`(eval-when (:compile-toplevel :load-toplevel :execute)
24   ,@(mapcar (lambda (decl) `(proclaim ',decl))
25             decls)))
[3404]26
[5582]27(defun proclaim (declaration-specifier)
[7178]28  (case (car declaration-specifier)
29    (SPECIAL
[7251]30     (dolist (name (cdr declaration-specifier))
31       (%defvar name)))
[7178]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
[7385]45              (setf jvm::*safety* val))
46             (DEBUG
47              (setf jvm::*debug* val)))))))
[7254]48    ((INLINE NOTINLINE)
[7251]49     (dolist (name (cdr declaration-specifier))
50       (when (symbolp name) ; FIXME Need to support non-symbol function names.
[7254]51         (setf (get name 'jvm::%inline) (car declaration-specifier)))))))
[3404]52
[5997]53(defun disassemble (fn)
[6319]54  (%format t "; DISASSEMBLE is not implemented.")
55  (values))
[6053]56
[6319]57(defun translate-pathname (&rest args)
58  (error "TRANSLATE-PATHNAME is not implemented."))
Note: See TracBrowser for help on using the repository browser.