[armedbear-cvs] r12748 - in trunk/abcl: . examples examples/google-app-engine examples/gui examples/java-exception examples/java-interface examples/java-to-lisp-1 examples/java-to-lisp-2 examples/jsr-223 examples/lisp-to-java examples/misc nbproject src/org/armedbear/lisp src/org/armedbear/lisp/java src/org/armedbear/lisp/java/swing src/org/armedbear/lisp/scripting
Mark Evenson
mevenson at common-lisp.net
Wed Jun 9 11:17:18 UTC 2010
Author: mevenson
Date: Wed Jun 9 07:17:17 2010
New Revision: 12748
Log:
Include 'examples' in release source distribution.
Reported by Mario Lang.
Added:
trunk/abcl/examples/.abclrc
- copied unchanged from r12742, /trunk/abcl/examples/misc/dotabclrc
trunk/abcl/examples/complete.lisp
trunk/abcl/examples/hello.java
- copied unchanged from r12742, /trunk/abcl/examples/misc/hello.java
trunk/abcl/examples/init.lisp
trunk/abcl/examples/key-pressed.lisp
trunk/abcl/examples/update-check-enabled.lisp
- copied unchanged from r12742, /trunk/abcl/examples/misc/update-check-enabled.lisp
trunk/abcl/src/org/armedbear/lisp/java/DialogPromptStream.java
- copied, changed from r12742, /trunk/abcl/examples/gui/abcl/DialogPromptStream.java
trunk/abcl/src/org/armedbear/lisp/java/swing/SwingDialogPromptStream.java
- copied, changed from r12742, /trunk/abcl/examples/gui/swing/SwingDialogPromptStream.java
Removed:
trunk/abcl/examples/README
trunk/abcl/examples/google-app-engine/
trunk/abcl/examples/gui/
trunk/abcl/examples/java-exception/
trunk/abcl/examples/java-interface/
trunk/abcl/examples/java-to-lisp-1/
trunk/abcl/examples/java-to-lisp-2/
trunk/abcl/examples/jsr-223/
trunk/abcl/examples/lisp-to-java/
trunk/abcl/examples/misc/
trunk/abcl/src/org/armedbear/lisp/FaslClassLoader.java
trunk/abcl/src/org/armedbear/lisp/java/swing/REPLConsole.java
Modified:
trunk/abcl/build.xml
trunk/abcl/nbproject/build-impl.xml
trunk/abcl/nbproject/genfiles.properties
trunk/abcl/src/org/armedbear/lisp/Autoload.java
trunk/abcl/src/org/armedbear/lisp/Function.java
trunk/abcl/src/org/armedbear/lisp/Interpreter.java
trunk/abcl/src/org/armedbear/lisp/Lisp.java
trunk/abcl/src/org/armedbear/lisp/Load.java
trunk/abcl/src/org/armedbear/lisp/Readtable.java
trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java
trunk/abcl/src/org/armedbear/lisp/StandardClass.java
trunk/abcl/src/org/armedbear/lisp/Stream.java
trunk/abcl/src/org/armedbear/lisp/Symbol.java
trunk/abcl/src/org/armedbear/lisp/clos.lisp
trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
trunk/abcl/src/org/armedbear/lisp/disassemble.lisp
trunk/abcl/src/org/armedbear/lisp/gui.lisp
trunk/abcl/src/org/armedbear/lisp/load.lisp
trunk/abcl/src/org/armedbear/lisp/precompiler.lisp
trunk/abcl/src/org/armedbear/lisp/proclaim.lisp
trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java
trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java
Modified: trunk/abcl/build.xml
==============================================================================
--- trunk/abcl/build.xml (original)
+++ trunk/abcl/build.xml Wed Jun 9 07:17:17 2010
@@ -464,6 +464,8 @@
<include name="abcl.in"/>
<include name="abcl.bat.in"/>
+ <include name="examples/**"/>
+
<!-- The remainder of these files are used by the Lisp hosted
build in 'build-abcl.lisp' but not used by Ant, so include
them in the source distribution. -->
Added: trunk/abcl/examples/complete.lisp
==============================================================================
--- (empty file)
+++ trunk/abcl/examples/complete.lisp Wed Jun 9 07:17:17 2010
@@ -0,0 +1,88 @@
+;;; complete.lisp
+;;;
+;;; Copyright (C) 2004 Peter Graves
+;;; $Id: complete.lisp,v 1.2 2004-09-05 00:12:25 piso Exp $
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "J")
+
+(export 'complete)
+
+(defvar *prefix* nil)
+(defvar *completions* ())
+(defvar *completion-index* 0)
+
+(defun compound-prefix-match (prefix target)
+ (let ((tlen (length target))
+ (tpos 0))
+ (dotimes (i (length prefix))
+ (when (>= tpos tlen)
+ (return-from compound-prefix-match nil))
+ (let ((ch (schar prefix i)))
+ (if (char= ch #\-)
+ (unless (setf tpos (position #\- target :start tpos))
+ (return-from compound-prefix-match nil))
+ (unless (char-equal ch (schar target tpos))
+ (return-from compound-prefix-match nil)))
+ (incf tpos)))
+ t))
+
+(defun completion-set (prefix)
+ (let ((result ()))
+ (do-external-symbols (symbol "CL")
+ (let ((name (symbol-name symbol)))
+ (when (compound-prefix-match prefix name)
+ (push symbol result))))
+ result))
+
+(defun completion-prefix ()
+ (let* ((string (line-chars (current-line)))
+ (end (mark-charpos (current-point))))
+ (do ((start (1- end) (1- start)))
+ ((< start 0) (subseq string 0 end))
+ (let ((ch (schar string start)))
+ (when (or (eql ch #\space) (eql ch #\())
+ (incf start)
+ (return-from completion-prefix (subseq string start end)))))))
+
+(defun complete ()
+ (cond ((eq *last-command* 'complete)
+ (unless (> (length *completions*) 1)
+ (return-from complete))
+ (undo)
+ (incf *completion-index*)
+ (when (> *completion-index* (1- (length *completions*)))
+ (setf *completion-index* 0)))
+ (t
+ (setf *prefix* (completion-prefix)
+ *completions* nil
+ *completion-index* 0)
+ (when *prefix*
+ (setf *completions* (completion-set *prefix*)))))
+ (when *completions*
+ (let ((completion (string-downcase (nth *completion-index* *completions*)))
+ (point (current-point)))
+ (with-single-undo
+ (goto-char (make-mark (mark-line point)
+ (- (mark-charpos point) (length *prefix*))))
+ (set-mark point)
+ (delete-region)
+ (insert completion)))
+ (setf *current-command* 'complete))
+ (values))
+
+(map-key-for-mode "Ctrl Space" "(complete)" "Lisp")
+(map-key-for-mode "Ctrl Space" "(complete)" "Lisp Shell")
Added: trunk/abcl/examples/init.lisp
==============================================================================
--- (empty file)
+++ trunk/abcl/examples/init.lisp Wed Jun 9 07:17:17 2010
@@ -0,0 +1,112 @@
+;;; init.lisp
+;;; $Id: init.lisp,v 1.36 2007-03-04 19:08:11 piso Exp $
+
+;;; ~/.j/init.lisp (if it exists) is loaded automatically when j starts up.
+
+(defun java-version ()
+ (jstatic "getProperty" "java.lang.System" "java.version"))
+
+(defun adjust-appearance ()
+ (when (member (subseq (java-version) 0 5)
+ '("1.4.0" "1.4.1" "1.4.2" "1.5.0" "1.6.0" "1.7.0")
+ :test #'string=)
+ (set-global-property "adjustAscent" -2)
+ (set-global-property "adjustLeading" -2)
+ (reset-display)))
+
+;; Do it now!
+(adjust-appearance)
+
+;; Turn off the remove-trailing-whitespace preference for files in the
+;; directory ~/gcl/ansi-tests.
+(defun my-open-file-hook (buf)
+ (let ((pathname (buffer-pathname buf)))
+ (when (and pathname
+ (string= (directory-namestring pathname)
+ "/home/peter/gcl/ansi-tests/"))
+ (set-buffer-property "removeTrailingWhitespace" nil))))
+
+(add-hook 'open-file-hook 'my-open-file-hook)
+
+;; Helper function for MY-BUFFER-ACTIVATED-HOOK.
+(defun sub-p (namestring dirname)
+ "Returns T if NAMESTRING is in DIRNAME or one of its subdirectories"
+ (let ((dirname-length (length dirname)))
+ (and (> (length namestring) dirname-length)
+ (string= (subseq namestring 0 dirname-length) dirname))))
+
+(defun my-buffer-activated-hook (buf)
+ (let ((pathname (buffer-pathname buf)))
+ ;; PATHNAME might be NIL (not all buffers have associated files).
+ (when pathname
+ (let ((type (pathname-type pathname)))
+ ;; We only care about Lisp and Java buffers.
+ (cond ((string= type "el")
+ (set-buffer-property
+ "tagPath"
+ "/home/peter/emacs-21.3/lisp:/home/peter/emacs-21.3/lisp/emacs-lisp"))
+ ((member type '("lisp" "lsp" "cl" "java") :test 'string=)
+ (let* ((namestring (namestring pathname))
+ (tagpath
+ (cond ((sub-p namestring "/home/peter/cmucl/src/")
+ "/home/peter/cmucl/src/code:/home/peter/cmucl/src/compiler:/home/peter/cmucl/src/pcl")
+ ((sub-p namestring "/home/peter/cl-bench/")
+ "/home/peter/cl-bench:/home/peter/cl-bench/files:/home/peter/depot/j/src/org/armedbear/lisp")
+ ((sub-p namestring "/home/peter/gcl/ansi-tests/")
+ "/home/peter/gcl/ansi-tests:/home/peter/depot/j/src/org/armedbear/lisp")
+ ((sub-p namestring "/home/peter/phemlock")
+ "/home/peter/phemlock/src/core:/home/peter/phemlock/src/user")
+ ((sub-p namestring "/home/peter/sbcl")
+ "/home/peter/sbcl/src/code:/home/peter/sbcl/src/compiler")
+ (t ; default case: no change
+ nil))))
+ ;; If we end up here with a non-NIL TAGPATH, use it to set the
+ ;; buffer-specific value of the TAG-PATH preference for the current
+ ;; buffer.
+ (when tagpath
+ (set-buffer-property "tagPath" tagpath)))))))))
+
+;; Install our hook function.
+(add-hook 'buffer-activated-hook 'my-buffer-activated-hook)
+
+;; Call ADJUST-APPEARANCE after saving ~/.j/prefs.
+(defun my-after-save-hook (buf)
+ (let ((pathname (buffer-pathname buf)))
+ (when (equal pathname #p"/home/peter/.j/prefs")
+ (adjust-appearance))))
+
+(add-hook 'after-save-hook 'my-after-save-hook)
+
+(defun reset-incoming-filters ()
+ (jstatic "resetIncomingFilters" "org.armedbear.j.mail.IncomingFilter"))
+
+(defun add-incoming-filter (mailbox pattern action parameter)
+ (jstatic "addIncomingFilter" "org.armedbear.j.mail.IncomingFilter"
+ mailbox pattern action parameter))
+
+(add-hook 'mailbox-mode-hook
+ (lambda ()
+ (reset-incoming-filters)
+ (add-incoming-filter "inbox"
+ "~C linux-kernel"
+ "move"
+ "mail/linux-kernel")
+ (add-incoming-filter "inbox"
+ "~C ix.netcom.com"
+ "move"
+ "mail/netcom")))
+
+(defun maybe-load (pathname)
+ (when (probe-file pathname)
+ (load pathname)))
+
+(maybe-load "/home/peter/.j/key-pressed.lisp")
+(maybe-load "/home/peter/.j/update-check-enabled.lisp")
+
+(maybe-load #+windows "c:/cygwin/home/peter/j/build-abcl.lisp"
+ #-windows "/home/peter/j/build-abcl.lisp")
+
+(map-key-for-mode ")" "electricCloseParen" "Lisp Shell")
+
+(map-key-for-mode "[" "insertParentheses" "Lisp")
+(map-key-for-mode "]" "movePastCloseAndReindent" "Lisp")
Added: trunk/abcl/examples/key-pressed.lisp
==============================================================================
--- (empty file)
+++ trunk/abcl/examples/key-pressed.lisp Wed Jun 9 07:17:17 2010
@@ -0,0 +1,169 @@
+;;; key-pressed.lisp
+;;;
+;;; Copyright (C) 2003-2005 Peter Graves
+;;; $Id: key-pressed.lisp,v 1.8 2005-11-18 01:47:25 piso Exp $
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(unless (find-package "KEY-PRESSED")
+ (make-package "KEY-PRESSED" :nicknames '("KP") :use '("CL" "J")))
+
+(in-package "KEY-PRESSED")
+
+;; No exports.
+
+(defcommand open-file)
+(defcommand open-file-in-other-window)
+(defcommand open-file-in-other-frame)
+;; (defcommand new-buffer)
+(defcommand recent-files)
+(defcommand save)
+(defcommand save-as)
+(defcommand save-copy)
+(defcommand save-all)
+(defcommand kill-buffer)
+(defcommand properties)
+(defcommand next-buffer)
+(defcommand prev-buffer)
+(defcommand new-frame)
+;; (defcommand execute-command "executeCommand")
+;; (defcommand j-print "print")
+(defcommand save-all-exit)
+(defcommand quit)
+(defcommand jump-to-line)
+(defcommand jump-to-column)
+(defcommand j-find "find")
+(defcommand incremental-find)
+(defcommand list-occurrences)
+(defcommand find-in-files)
+(defcommand list-files)
+(defcommand sidebar-list-tags)
+(defcommand j-replace "replace")
+(defcommand replace-in-files)
+(defcommand dir)
+(defcommand goto-bookmark)
+(defcommand help)
+(defcommand describe-key)
+(defcommand next-frame)
+(defcommand select-word)
+(defcommand kill-frame)
+(defcommand toggle-sidebar)
+(defcommand sidebar-list-buffers)
+(defcommand split-window)
+(defcommand unsplit-window)
+(defcommand other-window)
+(defcommand shell)
+
+;;; Incremental find needs special handling.
+(defun invoke-incremental-find ()
+ (location-bar-cancel-input)
+ (restore-focus)
+ (invoke-later 'incremental-find))
+
+(defvar *table* (make-hash-table :test #'equalp))
+
+;;; Object can be a symbol or a function.
+(defun assign-key (key object)
+ (setf (gethash key *table*) object))
+
+;;; The hook function.
+(defun key-pressed (&rest args)
+ (let* ((key (car args))
+ (value (gethash key *table*)))
+ (when (and value
+ (or (functionp value)
+ (and (symbolp value) (fboundp value))))
+ (funcall value))))
+
+;;; Key assignments.
+(assign-key "Ctrl O"
+ #'(lambda ()
+ (location-bar-cancel-input)
+ (update-location-bar)
+ (open-file)))
+(assign-key "Ctrl Alt O"
+ #'(lambda () (open-file-in-other-window) (update-location-bar)))
+(assign-key "Ctrl Shift O" 'open-file-in-other-frame)
+;; Ctrl N is used for history in textfields.
+;; (assign-key "Ctrl N" 'new-buffer)
+(assign-key "Alt R" 'recent-files)
+(assign-key "Ctrl S" 'save)
+(assign-key "Ctrl Shift S" 'save-as)
+(assign-key "Ctrl Alt S" 'save-copy)
+(assign-key "F2" 'save-all)
+(assign-key "Ctrl F4" 'kill-buffer)
+(assign-key "Ctrl W" 'kill-buffer)
+(assign-key "Alt P" 'properties)
+(assign-key "Alt NumPad Right"
+ #'(lambda () (restore-focus) (next-buffer)))
+(assign-key "Alt Right"
+ #'(lambda () (restore-focus) (next-buffer)))
+(assign-key "Alt NumPad Left"
+ #'(lambda () (restore-focus) (prev-buffer)))
+(assign-key "Alt Left"
+ #'(lambda () (restore-focus) (prev-buffer)))
+(assign-key "Ctrl Shift N" 'new-frame)
+(assign-key "Alt X" 'execute-command)
+;; Ctrl P is used for history in textfields.
+;; (assign-key "Ctrl P" 'j-print)
+(assign-key "Ctrl Shift Q" 'save-all-exit)
+(assign-key "Ctrl Q" 'quit)
+(assign-key "Ctrl J" 'jump-to-line)
+(assign-key "Ctrl Shift J" 'jump-to-column)
+(assign-key "Alt F3"
+ #'(lambda () (location-bar-cancel-input) (restore-focus) (j-find)))
+(assign-key "Ctrl F" 'invoke-incremental-find)
+(assign-key "Alt L" 'list-occurrences)
+(assign-key "F6" 'find-in-files)
+(assign-key "Ctrl Shift F" 'find-in-files)
+(assign-key "Ctrl L" 'list-files)
+(assign-key "Ctrl Shift L" 'sidebar-list-tags)
+(assign-key "Ctrl R" 'j-replace)
+(assign-key "Ctrl Shift R" 'replace-in-files)
+(assign-key "Ctrl D" 'dir)
+(assign-key "Ctrl 0" 'goto-bookmark)
+(assign-key "Ctrl 1" 'goto-bookmark)
+(assign-key "Ctrl 2" 'goto-bookmark)
+(assign-key "Ctrl 3" 'goto-bookmark)
+(assign-key "Ctrl 4" 'goto-bookmark)
+(assign-key "Ctrl 5" 'goto-bookmark)
+(assign-key "Ctrl 6" 'goto-bookmark)
+(assign-key "Ctrl 7" 'goto-bookmark)
+(assign-key "Ctrl 8" 'goto-bookmark)
+(assign-key "Ctrl 9" 'goto-bookmark)
+(assign-key "F1" 'help)
+(assign-key "Alt K" 'describe-key)
+(assign-key "Alt N" 'next-frame)
+(assign-key "Alt W" 'select-word)
+(assign-key "Ctrl Shift W" 'kill-frame)
+(assign-key "Alt =" 'toggle-sidebar)
+(assign-key "Alt B" 'sidebar-list-buffers)
+(assign-key "F10" 'split-window)
+(assign-key "Shift F10" 'unsplit-window)
+(assign-key "Alt O" 'other-window)
+(assign-key "Alt F9"
+ #'(lambda () (restore-focus) (shell)))
+
+;;; Enable the hook.
+(add-hook 'key-pressed-hook 'key-pressed)
+(set-global-property "enableKeyPressedHook" t)
+
+;; NOTE: ENABLE-KEY-PRESSED-HOOK will be reset to its default value (NIL) when
+;; preferences are reloaded (which happens automatically when you edit your
+;; preferences file). To prevent this (and keep the key-pressed hook working
+;; properly across preference file edits), add this line to ~/.j/prefs:
+;;
+;; enableKeyPressedHook = true
+;;
Modified: trunk/abcl/nbproject/build-impl.xml
==============================================================================
--- trunk/abcl/nbproject/build-impl.xml (original)
+++ trunk/abcl/nbproject/build-impl.xml Wed Jun 9 07:17:17 2010
@@ -20,13 +20,6 @@
-->
<project xmlns:j2seproject1="http://www.netbeans.org/ns/j2se-project/1" xmlns:j2seproject3="http://www.netbeans.org/ns/j2se-project/3" xmlns:jaxrpc="http://www.netbeans.org/ns/j2se-project/jax-rpc" basedir=".." default="default" name="abcl-impl">
- <fail message="Please build using Ant 1.7.1 or higher.">
- <condition>
- <not>
- <antversion atleast="1.7.1"/>
- </not>
- </condition>
- </fail>
<target depends="test,jar,javadoc" description="Build and test whole project." name="default"/>
<!--
======================
@@ -55,52 +48,21 @@
</target>
<target depends="-pre-init,-init-private,-init-user,-init-project,-init-macrodef-property" name="-do-init">
<available file="${manifest.file}" property="manifest.available"/>
- <condition property="main.class.available">
- <and>
- <isset property="main.class"/>
- <not>
- <equals arg1="${main.class}" arg2="" trim="true"/>
- </not>
- </and>
- </condition>
<condition property="manifest.available+main.class">
<and>
<isset property="manifest.available"/>
- <isset property="main.class.available"/>
- </and>
- </condition>
- <condition property="do.mkdist">
- <and>
- <isset property="libs.CopyLibs.classpath"/>
+ <isset property="main.class"/>
<not>
- <istrue value="${mkdist.disabled}"/>
+ <equals arg1="${main.class}" arg2="" trim="true"/>
</not>
</and>
</condition>
<condition property="manifest.available+main.class+mkdist.available">
<and>
<istrue value="${manifest.available+main.class}"/>
- <isset property="do.mkdist"/>
- </and>
- </condition>
- <condition property="manifest.available+mkdist.available">
- <and>
- <istrue value="${manifest.available}"/>
- <isset property="do.mkdist"/>
+ <isset property="libs.CopyLibs.classpath"/>
</and>
</condition>
- <condition property="manifest.available-mkdist.available">
- <or>
- <istrue value="${manifest.available}"/>
- <isset property="do.mkdist"/>
- </or>
- </condition>
- <condition property="manifest.available+main.class-mkdist.available">
- <or>
- <istrue value="${manifest.available+main.class}"/>
- <isset property="do.mkdist"/>
- </or>
- </condition>
<condition property="have.tests">
<or>
<available file="${test.src.dir}"/>
@@ -135,7 +97,6 @@
<property name="javadoc.preview" value="true"/>
<property name="application.args" value=""/>
<property name="source.encoding" value="${file.encoding}"/>
- <property name="runtime.encoding" value="${source.encoding}"/>
<condition property="javadoc.encoding.used" value="${javadoc.encoding}">
<and>
<isset property="javadoc.encoding"/>
@@ -151,11 +112,12 @@
<condition property="do.depend.true">
<istrue value="${do.depend}"/>
</condition>
- <path id="endorsed.classpath.path" path="${endorsed.classpath}"/>
- <condition else="" property="endorsed.classpath.cmd.line.arg" value="-Xbootclasspath/p:'${toString:endorsed.classpath.path}'">
- <length length="0" string="${endorsed.classpath}" when="greater"/>
+ <condition else="" property="javac.compilerargs.jaxws" value="-Djava.endorsed.dirs='${jaxws.endorsed.dir}'">
+ <and>
+ <isset property="jaxws.endorsed.dir"/>
+ <available file="nbproject/jaxws-build.xml"/>
+ </and>
</condition>
- <property name="javac.fork" value="false"/>
</target>
<target name="-post-init">
<!-- Empty placeholder for easier customization. -->
@@ -190,23 +152,14 @@
<attribute default="${includes}" name="includes"/>
<attribute default="${excludes}" name="excludes"/>
<attribute default="${javac.debug}" name="debug"/>
- <attribute default="${empty.dir}" name="sourcepath"/>
- <attribute default="${empty.dir}" name="gensrcdir"/>
+ <attribute default="/does/not/exist" name="sourcepath"/>
<element name="customize" optional="true"/>
<sequential>
- <property location="${build.dir}/empty" name="empty.dir"/>
- <mkdir dir="${empty.dir}"/>
- <javac debug="@{debug}" deprecation="${javac.deprecation}" destdir="@{destdir}" encoding="${source.encoding}" excludes="@{excludes}" fork="${javac.fork}" includeantruntime="false" includes="@{includes}" source="${javac.source}" sourcepath="@{sourcepath}" srcdir="@{srcdir}" target="${javac.target}" tempdir="${java.io.tmpdir}">
- <src>
- <dirset dir="@{gensrcdir}" erroronmissingdir="false">
- <include name="*"/>
- </dirset>
- </src>
+ <javac debug="@{debug}" deprecation="${javac.deprecation}" destdir="@{destdir}" encoding="${source.encoding}" excludes="@{excludes}" includeantruntime="false" includes="@{includes}" source="${javac.source}" sourcepath="@{sourcepath}" srcdir="@{srcdir}" target="${javac.target}">
<classpath>
<path path="@{classpath}"/>
</classpath>
- <compilerarg line="${endorsed.classpath.cmd.line.arg}"/>
- <compilerarg line="${javac.compilerargs}"/>
+ <compilerarg line="${javac.compilerargs} ${javac.compilerargs.jaxws}"/>
<customize/>
</javac>
</sequential>
@@ -245,7 +198,7 @@
<attribute default="${excludes}" name="excludes"/>
<attribute default="**" name="testincludes"/>
<sequential>
- <junit dir="${work.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" showoutput="true" tempdir="${build.dir}">
+ <junit dir="${work.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" showoutput="true">
<batchtest todir="${build.test.results.dir}">
<fileset dir="${test.src.dir}" excludes="@{excludes},${excludes}" includes="@{includes}">
<filename name="@{testincludes}"/>
@@ -260,7 +213,6 @@
</syspropertyset>
<formatter type="brief" usefile="false"/>
<formatter type="xml"/>
- <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
<jvmarg line="${run.jvmargs}"/>
</junit>
</sequential>
@@ -317,11 +269,8 @@
<element name="customize" optional="true"/>
<sequential>
<java classname="@{classname}" dir="${work.dir}" fork="true">
- <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
<jvmarg line="${debug-args-line}"/>
<jvmarg value="-Xrunjdwp:transport=${debug-transport},address=${jpda.address}"/>
- <jvmarg value="-Dfile.encoding=${runtime.encoding}"/>
- <redirector errorencoding="${runtime.encoding}" inputencoding="${runtime.encoding}" outputencoding="${runtime.encoding}"/>
<jvmarg line="${run.jvmargs}"/>
<classpath>
<path path="@{classpath}"/>
@@ -338,16 +287,12 @@
<target name="-init-macrodef-java">
<macrodef name="java" uri="http://www.netbeans.org/ns/j2se-project/1">
<attribute default="${main.class}" name="classname"/>
- <attribute default="${run.classpath}" name="classpath"/>
<element name="customize" optional="true"/>
<sequential>
<java classname="@{classname}" dir="${work.dir}" fork="true">
- <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
- <jvmarg value="-Dfile.encoding=${runtime.encoding}"/>
- <redirector errorencoding="${runtime.encoding}" inputencoding="${runtime.encoding}" outputencoding="${runtime.encoding}"/>
<jvmarg line="${run.jvmargs}"/>
<classpath>
- <path path="@{classpath}"/>
+ <path path="${run.classpath}"/>
</classpath>
<syspropertyset>
<propertyref prefix="run-sys-prop."/>
@@ -371,22 +316,7 @@
COMPILATION SECTION
===================
-->
- <target name="-deps-jar-init" unless="built-jar.properties">
- <property location="${build.dir}/built-jar.properties" name="built-jar.properties"/>
- <delete file="${built-jar.properties}" quiet="true"/>
- </target>
- <target if="already.built.jar.${basedir}" name="-warn-already-built-jar">
- <echo level="warn" message="Cycle detected: abcl was already built"/>
- </target>
- <target depends="init,-deps-jar-init" name="deps-jar" unless="no.deps">
- <mkdir dir="${build.dir}"/>
- <touch file="${built-jar.properties}" verbose="false"/>
- <property file="${built-jar.properties}" prefix="already.built.jar."/>
- <antcall target="-warn-already-built-jar"/>
- <propertyfile file="${built-jar.properties}">
- <entry key="${basedir}" value=""/>
- </propertyfile>
- </target>
+ <target depends="init" name="deps-jar" unless="no.deps"/>
<target depends="init,-check-automatic-build,-clean-after-automatic-build" name="-verify-automatic-build"/>
<target depends="init" name="-check-automatic-build">
<available file="${build.classes.dir}/.netbeans_automatic_build" property="netbeans.automatic.build"/>
@@ -402,15 +332,10 @@
<!-- You can override this target in the ../build.xml file. -->
</target>
<target if="do.depend.true" name="-compile-depend">
- <pathconvert property="build.generated.subdirs">
- <dirset dir="${build.generated.sources.dir}" erroronmissingdir="false">
- <include name="*"/>
- </dirset>
- </pathconvert>
- <j2seproject3:depend srcdir="${src.dir}:${build.generated.subdirs}"/>
+ <j2seproject3:depend/>
</target>
<target depends="init,deps-jar,-pre-pre-compile,-pre-compile,-compile-depend" if="have.sources" name="-do-compile">
- <j2seproject3:javac gensrcdir="${build.generated.sources.dir}"/>
+ <j2seproject3:javac/>
<copy todir="${build.classes.dir}">
<fileset dir="${src.dir}" excludes="${build.classes.excludes},${excludes}" includes="${includes}"/>
</copy>
@@ -427,7 +352,7 @@
<target depends="init,deps-jar,-pre-pre-compile" name="-do-compile-single">
<fail unless="javac.includes">Must select some files in the IDE or set javac.includes</fail>
<j2seproject3:force-recompile/>
- <j2seproject3:javac excludes="" gensrcdir="${build.generated.sources.dir}" includes="${javac.includes}" sourcepath="${src.dir}"/>
+ <j2seproject3:javac excludes="" includes="${javac.includes}" sourcepath="${src.dir}"/>
</target>
<target name="-post-compile-single">
<!-- Empty placeholder for easier customization. -->
@@ -447,10 +372,10 @@
<!-- Empty placeholder for easier customization. -->
<!-- You can override this target in the ../build.xml file. -->
</target>
- <target depends="init,compile,-pre-pre-jar,-pre-jar" name="-do-jar-without-manifest" unless="manifest.available-mkdist.available">
+ <target depends="init,compile,-pre-pre-jar,-pre-jar" name="-do-jar-without-manifest" unless="manifest.available">
<j2seproject1:jar/>
</target>
- <target depends="init,compile,-pre-pre-jar,-pre-jar" if="manifest.available" name="-do-jar-with-manifest" unless="manifest.available+main.class-mkdist.available">
+ <target depends="init,compile,-pre-pre-jar,-pre-jar" if="manifest.available" name="-do-jar-with-manifest" unless="manifest.available+main.class">
<j2seproject1:jar manifest="${manifest.file}"/>
</target>
<target depends="init,compile,-pre-pre-jar,-pre-jar" if="manifest.available+main.class" name="-do-jar-with-mainclass" unless="manifest.available+main.class+mkdist.available">
@@ -493,53 +418,11 @@
<property location="${dist.jar}" name="dist.jar.resolved"/>
<echo>java -jar "${dist.jar.resolved}"</echo>
</target>
- <target depends="init,compile,-pre-pre-jar,-pre-jar" if="manifest.available+mkdist.available" name="-do-jar-with-libraries-without-mainclass" unless="main.class.available">
- <property location="${build.classes.dir}" name="build.classes.dir.resolved"/>
- <pathconvert property="run.classpath.without.build.classes.dir">
- <path path="${run.classpath}"/>
- <map from="${build.classes.dir.resolved}" to=""/>
- </pathconvert>
- <pathconvert pathsep=" " property="jar.classpath">
- <path path="${run.classpath.without.build.classes.dir}"/>
- <chainedmapper>
- <flattenmapper/>
- <globmapper from="*" to="lib/*"/>
- </chainedmapper>
- </pathconvert>
- <taskdef classname="org.netbeans.modules.java.j2seproject.copylibstask.CopyLibs" classpath="${libs.CopyLibs.classpath}" name="copylibs"/>
- <copylibs compress="${jar.compress}" jarfile="${dist.jar}" manifest="${manifest.file}" runtimeclasspath="${run.classpath.without.build.classes.dir}">
- <fileset dir="${build.classes.dir}"/>
- <manifest>
- <attribute name="Class-Path" value="${jar.classpath}"/>
- </manifest>
- </copylibs>
- </target>
- <target depends="init,compile,-pre-pre-jar,-pre-jar" if="do.mkdist" name="-do-jar-with-libraries-without-manifest" unless="manifest.available">
- <property location="${build.classes.dir}" name="build.classes.dir.resolved"/>
- <pathconvert property="run.classpath.without.build.classes.dir">
- <path path="${run.classpath}"/>
- <map from="${build.classes.dir.resolved}" to=""/>
- </pathconvert>
- <pathconvert pathsep=" " property="jar.classpath">
- <path path="${run.classpath.without.build.classes.dir}"/>
- <chainedmapper>
- <flattenmapper/>
- <globmapper from="*" to="lib/*"/>
- </chainedmapper>
- </pathconvert>
- <taskdef classname="org.netbeans.modules.java.j2seproject.copylibstask.CopyLibs" classpath="${libs.CopyLibs.classpath}" name="copylibs"/>
- <copylibs compress="${jar.compress}" jarfile="${dist.jar}" runtimeclasspath="${run.classpath.without.build.classes.dir}">
- <fileset dir="${build.classes.dir}"/>
- <manifest>
- <attribute name="Class-Path" value="${jar.classpath}"/>
- </manifest>
- </copylibs>
- </target>
<target name="-post-jar">
<!-- Empty placeholder for easier customization. -->
<!-- You can override this target in the ../build.xml file. -->
</target>
- <target depends="init,compile,-pre-jar,-do-jar-with-manifest,-do-jar-without-manifest,-do-jar-with-mainclass,-do-jar-with-libraries,-do-jar-with-libraries-without-mainclass,-do-jar-with-libraries-without-manifest,-post-jar" description="Build JAR." name="jar"/>
+ <target depends="init,compile,-pre-jar,-do-jar-with-manifest,-do-jar-without-manifest,-do-jar-with-mainclass,-do-jar-with-libraries,-post-jar" description="Build JAR." name="jar"/>
<!--
=================
EXECUTION SECTION
@@ -555,14 +438,10 @@
<target name="-do-not-recompile">
<property name="javac.includes.binary" value=""/>
</target>
- <target depends="init,compile-single" name="run-single">
+ <target depends="init,-do-not-recompile,compile-single" name="run-single">
<fail unless="run.class">Must select one file in the IDE or set run.class</fail>
<j2seproject1:java classname="${run.class}"/>
</target>
- <target depends="init,compile-test-single" name="run-test-with-main">
- <fail unless="run.class">Must select one file in the IDE or set run.class</fail>
- <j2seproject1:java classname="${run.class}" classpath="${run.test.classpath}"/>
- </target>
<!--
=================
DEBUGGING SECTION
@@ -571,9 +450,6 @@
<target depends="init" if="netbeans.home" name="-debug-start-debugger">
<j2seproject1:nbjpdastart name="${debug.class}"/>
</target>
- <target depends="init" if="netbeans.home" name="-debug-start-debugger-main-test">
- <j2seproject1:nbjpdastart classpath="${debug.test.classpath}" name="${debug.class}"/>
- </target>
<target depends="init,compile" name="-debug-start-debuggee">
<j2seproject3:debug>
<customize>
@@ -590,12 +466,7 @@
<fail unless="debug.class">Must select one file in the IDE or set debug.class</fail>
<j2seproject3:debug classname="${debug.class}"/>
</target>
- <target depends="init,compile-single,-debug-start-debugger,-debug-start-debuggee-single" if="netbeans.home" name="debug-single"/>
- <target depends="init,compile-test-single" if="netbeans.home" name="-debug-start-debuggee-main-test">
- <fail unless="debug.class">Must select one file in the IDE or set debug.class</fail>
- <j2seproject3:debug classname="${debug.class}" classpath="${debug.test.classpath}"/>
- </target>
- <target depends="init,compile-test-single,-debug-start-debugger-main-test,-debug-start-debuggee-main-test" if="netbeans.home" name="debug-test-with-main"/>
+ <target depends="init,-do-not-recompile,compile-single,-debug-start-debugger,-debug-start-debuggee-single" if="netbeans.home" name="debug-single"/>
<target depends="init" name="-pre-debug-fix">
<fail unless="fix.includes">Must set fix.includes</fail>
<property name="javac.includes" value="${fix.includes}.java"/>
@@ -618,9 +489,6 @@
<fileset dir="${src.dir}" excludes="${excludes}" includes="${includes}">
<filename name="**/*.java"/>
</fileset>
- <fileset dir="${build.generated.sources.dir}" erroronmissingdir="false">
- <include name="**/*.java"/>
- </fileset>
</javadoc>
</target>
<target depends="init,-javadoc-build" if="netbeans.home" name="-javadoc-browse" unless="no.javadoc.preview">
@@ -682,7 +550,7 @@
<j2seproject3:junit testincludes="**/*Test.java"/>
</target>
<target depends="init,compile-test,-pre-test-run,-do-test-run" if="have.tests" name="-post-test-run">
- <fail if="tests.failed" unless="ignore.failing.tests">Some tests failed; see details above.</fail>
+ <fail if="tests.failed">Some tests failed; see details above.</fail>
</target>
<target depends="init" if="have.tests" name="test-report"/>
<target depends="init" if="netbeans.home+have.tests" name="-test-browse"/>
@@ -695,9 +563,9 @@
<j2seproject3:junit excludes="" includes="${test.includes}"/>
</target>
<target depends="init,compile-test-single,-pre-test-run-single,-do-test-run-single" if="have.tests" name="-post-test-run-single">
- <fail if="tests.failed" unless="ignore.failing.tests">Some tests failed; see details above.</fail>
+ <fail if="tests.failed">Some tests failed; see details above.</fail>
</target>
- <target depends="init,compile-test-single,-pre-test-run-single,-do-test-run-single,-post-test-run-single" description="Run single unit test." name="test-single"/>
+ <target depends="init,-do-not-recompile,compile-test-single,-pre-test-run-single,-do-test-run-single,-post-test-run-single" description="Run single unit test." name="test-single"/>
<!--
=======================
JUNIT DEBUGGING SECTION
@@ -724,7 +592,7 @@
<target depends="init,compile-test" if="netbeans.home+have.tests" name="-debug-start-debugger-test">
<j2seproject1:nbjpdastart classpath="${debug.test.classpath}" name="${test.class}"/>
</target>
- <target depends="init,compile-test-single,-debug-start-debugger-test,-debug-start-debuggee-test" name="debug-test"/>
+ <target depends="init,-do-not-recompile,compile-test-single,-debug-start-debugger-test,-debug-start-debuggee-test" name="debug-test"/>
<target depends="init,-pre-debug-fix,compile-test-single" if="netbeans.home" name="-do-debug-fix-test">
<j2seproject1:nbjpdareload dir="${build.test.classes.dir}"/>
</target>
@@ -761,45 +629,14 @@
CLEANUP SECTION
===============
-->
- <target name="-deps-clean-init" unless="built-clean.properties">
- <property location="${build.dir}/built-clean.properties" name="built-clean.properties"/>
- <delete file="${built-clean.properties}" quiet="true"/>
- </target>
- <target if="already.built.clean.${basedir}" name="-warn-already-built-clean">
- <echo level="warn" message="Cycle detected: abcl was already built"/>
- </target>
- <target depends="init,-deps-clean-init" name="deps-clean" unless="no.deps">
- <mkdir dir="${build.dir}"/>
- <touch file="${built-clean.properties}" verbose="false"/>
- <property file="${built-clean.properties}" prefix="already.built.clean."/>
- <antcall target="-warn-already-built-clean"/>
- <propertyfile file="${built-clean.properties}">
- <entry key="${basedir}" value=""/>
- </propertyfile>
- </target>
+ <target depends="init" name="deps-clean" unless="no.deps"/>
<target depends="init" name="-do-clean">
<delete dir="${build.dir}"/>
- <delete dir="${dist.dir}" followsymlinks="false" includeemptydirs="true"/>
+ <delete dir="${dist.dir}"/>
</target>
<target name="-post-clean">
<!-- Empty placeholder for easier customization. -->
<!-- You can override this target in the ../build.xml file. -->
</target>
<target depends="init,deps-clean,-do-clean,-post-clean" description="Clean build products." name="clean"/>
- <target name="-check-call-dep">
- <property file="${call.built.properties}" prefix="already.built."/>
- <condition property="should.call.dep">
- <not>
- <isset property="already.built.${call.subproject}"/>
- </not>
- </condition>
- </target>
- <target depends="-check-call-dep" if="should.call.dep" name="-maybe-call-dep">
- <ant antfile="${call.script}" inheritall="false" target="${call.target}">
- <propertyset>
- <propertyref prefix="transfer."/>
- <mapper from="transfer.*" to="*" type="glob"/>
- </propertyset>
- </ant>
- </target>
</project>
Modified: trunk/abcl/nbproject/genfiles.properties
==============================================================================
--- trunk/abcl/nbproject/genfiles.properties (original)
+++ trunk/abcl/nbproject/genfiles.properties Wed Jun 9 07:17:17 2010
@@ -4,8 +4,8 @@
# This file is used by a NetBeans-based IDE to track changes in generated files such as build-impl.xml.
# Do not edit this file. You may delete it but then the IDE will never regenerate such files for you.
nbproject/build-impl.xml.data.CRC32=742204ce
-nbproject/build-impl.xml.script.CRC32=29122cc4
-nbproject/build-impl.xml.stylesheet.CRC32=576378a2 at 1.32.1.45
+nbproject/build-impl.xml.script.CRC32=b7bf05a5
+nbproject/build-impl.xml.stylesheet.CRC32=65b8de21
nbproject/profiler-build-impl.xml.data.CRC32=71623fcd
nbproject/profiler-build-impl.xml.script.CRC32=abda56ed
nbproject/profiler-build-impl.xml.stylesheet.CRC32=42cb6bcf
Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Autoload.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Autoload.java Wed Jun 9 07:17:17 2010
@@ -97,7 +97,7 @@
symbol.setSymbolFunction(new Autoload(symbol, null,
"org.armedbear.lisp.".concat(className)));
}
-
+
public void load()
{
if (className != null) {
@@ -684,9 +684,6 @@
autoload(Symbol.COPY_LIST, "copy_list");
- autoload(PACKAGE_SYS, "make-fasl-class-loader", "FaslClassLoader", false);
- autoload(PACKAGE_SYS, "get-fasl-function", "FaslClassLoader", false);
-
autoload(Symbol.SET_CHAR, "StringFunctions");
autoload(Symbol.SET_SCHAR, "StringFunctions");
Modified: trunk/abcl/src/org/armedbear/lisp/Function.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Function.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Function.java Wed Jun 9 07:17:17 2010
@@ -175,51 +175,23 @@
new JavaObject(bytes));
}
- public final LispObject getClassBytes() {
- LispObject o = getf(propertyList, Symbol.CLASS_BYTES, NIL);
- if(o != NIL) {
- return o;
- } else {
- ClassLoader c = getClass().getClassLoader();
- if(c instanceof FaslClassLoader) {
- return new JavaObject(((FaslClassLoader) c).getFunctionClassBytes(this));
- } else {
- return NIL;
- }
- }
- }
-
- public static final Primitive FUNCTION_CLASS_BYTES = new pf_function_class_bytes();
- public static final class pf_function_class_bytes extends Primitive {
- public pf_function_class_bytes() {
- super("function-class-bytes", PACKAGE_SYS, false, "function");
- }
- @Override
- public LispObject execute(LispObject arg) {
- if (arg instanceof Function) {
- return ((Function) arg).getClassBytes();
- }
- return type_error(arg, Symbol.FUNCTION);
- }
- }
-
@Override
public LispObject execute()
{
- return error(new WrongNumberOfArgumentsException(this, 0));
+ return error(new WrongNumberOfArgumentsException(this));
}
@Override
public LispObject execute(LispObject arg)
{
- return error(new WrongNumberOfArgumentsException(this, 1));
+ return error(new WrongNumberOfArgumentsException(this));
}
@Override
public LispObject execute(LispObject first, LispObject second)
{
- return error(new WrongNumberOfArgumentsException(this, 2));
+ return error(new WrongNumberOfArgumentsException(this));
}
@Override
@@ -227,7 +199,7 @@
LispObject third)
{
- return error(new WrongNumberOfArgumentsException(this, 3));
+ return error(new WrongNumberOfArgumentsException(this));
}
@Override
@@ -235,7 +207,7 @@
LispObject third, LispObject fourth)
{
- return error(new WrongNumberOfArgumentsException(this, 4));
+ return error(new WrongNumberOfArgumentsException(this));
}
@Override
@@ -244,7 +216,7 @@
LispObject fifth)
{
- return error(new WrongNumberOfArgumentsException(this, 5));
+ return error(new WrongNumberOfArgumentsException(this));
}
@Override
@@ -253,7 +225,7 @@
LispObject fifth, LispObject sixth)
{
- return error(new WrongNumberOfArgumentsException(this, 6));
+ return error(new WrongNumberOfArgumentsException(this));
}
@Override
@@ -263,7 +235,7 @@
LispObject seventh)
{
- return error(new WrongNumberOfArgumentsException(this, 7));
+ return error(new WrongNumberOfArgumentsException(this));
}
@Override
@@ -273,7 +245,7 @@
LispObject seventh, LispObject eighth)
{
- return error(new WrongNumberOfArgumentsException(this, 8));
+ return error(new WrongNumberOfArgumentsException(this));
}
@Override
Modified: trunk/abcl/src/org/armedbear/lisp/Interpreter.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Interpreter.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Interpreter.java Wed Jun 9 07:17:17 2010
@@ -177,7 +177,7 @@
}
catch (ClassNotFoundException e) { } // FIXME: what to do?
- Load.loadSystemFile("j.lisp", false); // not being autoloaded
+ Load.loadSystemFile("j.lisp");
initialized = true;
}
@@ -217,7 +217,7 @@
private static synchronized void initializeSystem()
{
- Load.loadSystemFile("system", false); // not being autoloaded
+ Load.loadSystemFile("system");
}
// Check for --noinit; verify that arguments are supplied for --load and
@@ -308,7 +308,7 @@
false, false, true);
else
- Load.loadSystemFile(args[i + 1], false); // not being autoloaded
+ Load.loadSystemFile(args[i + 1]);
++i;
} else {
// Shouldn't happen.
Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Lisp.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Lisp.java Wed Jun 9 07:17:17 2010
@@ -43,6 +43,8 @@
import java.net.URL;
import java.net.URLDecoder;
import java.util.Hashtable;
+import java.util.zip.ZipEntry;
+import java.util.zip.ZipFile;
public final class Lisp
{
@@ -699,8 +701,9 @@
*
* This version is used by the interpreter.
*/
- static final LispObject nonLocalGo(Binding binding,
- LispObject tag)
+ public static final LispObject nonLocalGo(Binding binding,
+ LispObject tag)
+
{
if (binding.env.inactive)
return error(new ControlError("Unmatched tag "
@@ -735,9 +738,10 @@
*
* This version is used by the interpreter.
*/
- static final LispObject nonLocalReturn(Binding binding,
- Symbol block,
- LispObject result)
+ public static final LispObject nonLocalReturn(Binding binding,
+ Symbol block,
+ LispObject result)
+
{
if (binding == null)
{
@@ -1264,7 +1268,6 @@
url = Lisp.class.getResource(name.getNamestring());
input = url.openStream();
} catch (IOException e) {
- System.err.println("Failed to read class bytes from boot class " + url);
error(new LispError("Failed to read class bytes from boot class " + url));
}
}
@@ -2384,10 +2387,6 @@
public static final Symbol _LOAD_STREAM_ =
internSpecial("*LOAD-STREAM*", PACKAGE_SYS, NIL);
- // ### *fasl-loader*
- public static final Symbol _FASL_LOADER_ =
- exportSpecial("*FASL-LOADER*", PACKAGE_SYS, NIL);
-
// ### *source*
// internal symbol
public static final Symbol _SOURCE_ =
@@ -2761,16 +2760,4 @@
Symbol.DEBUG_IO.initializeSpecial(new TwoWayStream(stdin, stdout, true));
}
- private static final SpecialOperator WITH_INLINE_CODE = new with_inline_code();
- private static class with_inline_code extends SpecialOperator {
- with_inline_code() {
- super("with-inline-code", PACKAGE_JVM, true, "(&optional target repr) &body body");
- }
- @Override
- public LispObject execute(LispObject args, Environment env)
- {
- return error(new SimpleError("This is a placeholder. It should only be called in compiled code, and tranformed by the compiler using special form handlers."));
- }
- }
-
}
Modified: trunk/abcl/src/org/armedbear/lisp/Load.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Load.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Load.java Wed Jun 9 07:17:17 2010
@@ -216,6 +216,16 @@
}
}
+ public static final LispObject loadSystemFile(String filename)
+
+ {
+ final LispThread thread = LispThread.currentThread();
+ return loadSystemFile(filename,
+ Symbol.LOAD_VERBOSE.symbolValue(thread) != NIL,
+ Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
+ false);
+ }
+
public static final LispObject loadSystemFile(String filename, boolean auto)
{
@@ -242,7 +252,6 @@
}
}
- private static final Symbol FASL_LOADER = PACKAGE_SYS.intern("*FASL-LOADER*");
static final LispObject COMPILE_FILE_INIT_FASL_TYPE = new SimpleString("_");
public static final LispObject loadSystemFile(final String filename,
@@ -269,7 +278,7 @@
String path = pathname.asEntryPath();
url = Lisp.class.getResource(path);
if (url == null || url.toString().endsWith("/")) {
- url = Lisp.class.getResource(path.replace('-', '_') + ".abcl");
+ url = Lisp.class.getResource(path + ".abcl");
if (url == null) {
url = Lisp.class.getResource(path + ".lisp");
}
@@ -323,7 +332,6 @@
final LispThread thread = LispThread.currentThread();
final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(_WARN_ON_REDEFINITION_, NIL);
- thread.bindSpecial(FASL_LOADER, NIL);
try {
Stream stream = new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER);
return loadFileFromStream(pathname, truename, stream,
@@ -432,12 +440,6 @@
in, verbose, print, auto, false);
}
- private static Symbol[] savedSpecials =
- new Symbol[] { // CLHS Specified
- Symbol.CURRENT_READTABLE, Symbol._PACKAGE_,
- // Compiler policy
- _SPEED_, _SPACE_, _SAFETY_, _DEBUG_, _EXPLAIN_ };
-
// A nil TRUENAME signals a load from stream which has no possible path
private static final LispObject loadFileFromStream(LispObject pathname,
LispObject truename,
@@ -451,12 +453,18 @@
long start = System.currentTimeMillis();
final LispThread thread = LispThread.currentThread();
final SpecialBindingsMark mark = thread.markSpecialBindings();
-
- for (Symbol special : savedSpecials)
- thread.bindSpecialToCurrentValue(special);
-
+ // "LOAD binds *READTABLE* and *PACKAGE* to the values they held before
+ // loading the file."
+ thread.bindSpecialToCurrentValue(Symbol.CURRENT_READTABLE);
+ thread.bindSpecialToCurrentValue(Symbol._PACKAGE_);
int loadDepth = Fixnum.getValue(_LOAD_DEPTH_.symbolValue(thread));
thread.bindSpecial(_LOAD_DEPTH_, Fixnum.getInstance(++loadDepth));
+ // Compiler policy.
+ thread.bindSpecialToCurrentValue(_SPEED_);
+ thread.bindSpecialToCurrentValue(_SPACE_);
+ thread.bindSpecialToCurrentValue(_SAFETY_);
+ thread.bindSpecialToCurrentValue(_DEBUG_);
+ thread.bindSpecialToCurrentValue(_EXPLAIN_);
final String prefix = getLoadVerbosePrefix(loadDepth);
try {
thread.bindSpecial(Symbol.LOAD_PATHNAME, pathname);
@@ -553,6 +561,12 @@
}
private static final LispObject loadStream(Stream in, boolean print,
+ LispThread thread)
+ {
+ return loadStream(in, print, thread, false);
+ }
+
+ private static final LispObject loadStream(Stream in, boolean print,
LispThread thread, boolean returnLastResult)
{
@@ -569,7 +583,7 @@
thread, Stream.currentReadtable);
if (obj == EOF)
break;
- result = eval(obj, env, thread);
+ result = eval(obj, env, thread);
if (print) {
Stream out =
checkCharacterOutputStream(Symbol.STANDARD_OUTPUT.symbolValue(thread));
Modified: trunk/abcl/src/org/armedbear/lisp/Readtable.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Readtable.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Readtable.java Wed Jun 9 07:17:17 2010
@@ -171,19 +171,19 @@
}
@Override
- public final LispObject typeOf()
+ public LispObject typeOf()
{
return Symbol.READTABLE;
}
@Override
- public final LispObject classOf()
+ public LispObject classOf()
{
return BuiltInClass.READTABLE;
}
@Override
- public final LispObject typep(LispObject type)
+ public LispObject typep(LispObject type)
{
if (type == Symbol.READTABLE)
return T;
@@ -193,27 +193,27 @@
}
@Override
- public final String toString()
+ public String toString()
{
return unreadableString("READTABLE");
}
- public final LispObject getReadtableCase()
+ public LispObject getReadtableCase()
{
return readtableCase;
}
- public final boolean isWhitespace(char c)
+ public boolean isWhitespace(char c)
{
return getSyntaxType(c) == SYNTAX_TYPE_WHITESPACE;
}
- public final byte getSyntaxType(char c)
+ public byte getSyntaxType(char c)
{
return syntax.get(c);
}
- public final boolean isInvalid(char c)
+ public boolean isInvalid(char c)
{
switch (c)
{
@@ -230,7 +230,7 @@
}
}
- public final void checkInvalid(char c, Stream stream)
+ public void checkInvalid(char c, Stream stream)
{
// "... no mechanism is provided for changing the constituent trait of a
// character." (2.1.4.2)
@@ -247,12 +247,12 @@
}
}
- public final LispObject getReaderMacroFunction(char c)
+ public LispObject getReaderMacroFunction(char c)
{
return readerMacroFunctions.get(c);
}
- final LispObject getMacroCharacter(char c)
+ LispObject getMacroCharacter(char c)
{
LispObject function = getReaderMacroFunction(c);
LispObject non_terminating_p;
@@ -271,7 +271,7 @@
return LispThread.currentThread().setValues(function, non_terminating_p);
}
- final void makeDispatchMacroCharacter(char dispChar, LispObject non_terminating_p)
+ void makeDispatchMacroCharacter(char dispChar, LispObject non_terminating_p)
{
byte syntaxType;
if (non_terminating_p != NIL)
@@ -284,7 +284,7 @@
dispatchTables.put(dispChar, new DispatchTable());
}
- public final LispObject getDispatchMacroCharacter(char dispChar, char subChar)
+ public LispObject getDispatchMacroCharacter(char dispChar, char subChar)
{
DispatchTable dispatchTable = dispatchTables.get(dispChar);
@@ -299,7 +299,7 @@
return (function != null) ? function : NIL;
}
- public final void setDispatchMacroCharacter(char dispChar, char subChar,
+ public void setDispatchMacroCharacter(char dispChar, char subChar,
LispObject function)
{
Modified: trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java Wed Jun 9 07:17:17 2010
@@ -44,12 +44,6 @@
slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = NIL;
}
- public SlotDefinition(StandardClass clazz)
- {
- super(clazz, clazz.getClassLayout().getLength());
- slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = NIL;
- }
-
public SlotDefinition(LispObject name, LispObject readers)
{
this();
@@ -119,20 +113,15 @@
return unreadableString(sb.toString());
}
- // ### make-slot-definition &optional class
+ // ### make-slot-definition
private static final Primitive MAKE_SLOT_DEFINITION =
- new Primitive("make-slot-definition", PACKAGE_SYS, true, "&optional class")
+ new Primitive("make-slot-definition", PACKAGE_SYS, true, "")
{
@Override
public LispObject execute()
{
return new SlotDefinition();
}
- @Override
- public LispObject execute(LispObject slotDefinitionClass)
- {
- return new SlotDefinition((StandardClass) slotDefinitionClass);
- }
};
// ### %slot-definition-name
Modified: trunk/abcl/src/org/armedbear/lisp/StandardClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardClass.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/StandardClass.java Wed Jun 9 07:17:17 2010
@@ -384,11 +384,6 @@
STANDARD_CLASS.setDirectSlotDefinitions(standardClassSlotDefinitions());
}
- public static final StandardClass DIRECT_SLOT_DEFINITION =
- addStandardClass(Symbol.DIRECT_SLOT_DEFINITION, list(SLOT_DEFINITION));
- public static final StandardClass EFFECTIVE_SLOT_DEFINITION =
- addStandardClass(Symbol.EFFECTIVE_SLOT_DEFINITION, list(SLOT_DEFINITION));
-
// BuiltInClass.FUNCTION is also null here (see previous comment).
public static final StandardClass GENERIC_FUNCTION =
addStandardClass(Symbol.GENERIC_FUNCTION, list(BuiltInClass.FUNCTION,
@@ -726,13 +721,6 @@
// There are no inherited slots.
SLOT_DEFINITION.setSlotDefinitions(SLOT_DEFINITION.getDirectSlotDefinitions());
- DIRECT_SLOT_DEFINITION.setCPL(DIRECT_SLOT_DEFINITION, SLOT_DEFINITION,
- STANDARD_OBJECT, BuiltInClass.CLASS_T);
- DIRECT_SLOT_DEFINITION.finalizeClass();
- EFFECTIVE_SLOT_DEFINITION.setCPL(EFFECTIVE_SLOT_DEFINITION, SLOT_DEFINITION,
- STANDARD_OBJECT, BuiltInClass.CLASS_T);
- EFFECTIVE_SLOT_DEFINITION.finalizeClass();
-
// STANDARD-METHOD
Debug.assertTrue(STANDARD_METHOD.isFinalized());
STANDARD_METHOD.setCPL(STANDARD_METHOD, METHOD, STANDARD_OBJECT,
Modified: trunk/abcl/src/org/armedbear/lisp/Stream.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Stream.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Stream.java Wed Jun 9 07:17:17 2010
@@ -1138,7 +1138,8 @@
sb.setLength(0);
sb.append(readMultipleEscape(rt));
flags = new BitSet(sb.length());
- flags.set(0, sb.length());
+ for (int i = sb.length(); i-- > 0;)
+ flags.set(i);
} else if (rt.isInvalid(c)) {
rt.checkInvalid(c, this); // Signals a reader-error.
} else if (readtableCase == Keyword.UPCASE) {
@@ -1179,7 +1180,8 @@
int end = sb.length();
if (flags == null)
flags = new BitSet(sb.length());
- flags.set(begin, end);
+ for (int i = begin; i < end; i++)
+ flags.set(i);
continue;
}
if (readtableCase == Keyword.UPCASE)
Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java Wed Jun 9 07:17:17 2010
@@ -2943,10 +2943,6 @@
PACKAGE_MOP.addInternalSymbol("CLASS-PRECEDENCE-LIST");
public static final Symbol STANDARD_READER_METHOD =
PACKAGE_MOP.addExternalSymbol("STANDARD-READER-METHOD");
- public static final Symbol DIRECT_SLOT_DEFINITION =
- PACKAGE_MOP.addExternalSymbol("DIRECT-SLOT-DEFINITION");
- public static final Symbol EFFECTIVE_SLOT_DEFINITION =
- PACKAGE_MOP.addExternalSymbol("EFFECTIVE-SLOT-DEFINITION");
// Java interface.
public static final Symbol JAVA_EXCEPTION =
Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp Wed Jun 9 07:17:17 2010
@@ -60,8 +60,6 @@
(defconstant +the-standard-generic-function-class+
(find-class 'standard-generic-function))
(defconstant +the-T-class+ (find-class 'T))
-(defconstant +the-direct-slot-definition-class+ (find-class 'direct-slot-definition))
-(defconstant +the-effective-slot-definition-class+ (find-class 'effective-slot-definition))
;; Don't use DEFVAR, because that disallows loading clos.lisp
;; after compiling it: the binding won't get assigned to T anymore
@@ -261,45 +259,40 @@
(defun make-initfunction (initform)
`(function (lambda () ,initform)))
-(defun init-slot-definition (slot &key name
- (initargs ())
- (initform nil)
- (initfunction nil)
- (readers ())
- (writers ())
- (allocation :instance)
- (allocation-class nil)
- &allow-other-keys)
- (set-slot-definition-name slot name)
- (set-slot-definition-initargs slot initargs)
- (set-slot-definition-initform slot initform)
- (set-slot-definition-initfunction slot initfunction)
- (set-slot-definition-readers slot readers)
- (set-slot-definition-writers slot writers)
- (set-slot-definition-allocation slot allocation)
- (set-slot-definition-allocation-class slot allocation-class)
- slot)
-
-(defun make-direct-slot-definition (class &rest args)
- (let ((slot-class (direct-slot-definition-class class)))
- (if (eq slot-class +the-direct-slot-definition-class+)
- (let ((slot (make-slot-definition +the-direct-slot-definition-class+)))
- (apply #'init-slot-definition slot :allocation-class class args)
- slot)
- (progn
- (let ((slot (apply #'make-instance slot-class :allocation-class class
- args)))
- slot)))))
-
-(defun make-effective-slot-definition (class &rest args)
- (let ((slot-class (effective-slot-definition-class class)))
- (if (eq slot-class +the-effective-slot-definition-class+)
- (let ((slot (make-slot-definition +the-effective-slot-definition-class+)))
- (apply #'init-slot-definition slot args)
- slot)
- (progn
- (let ((slot (apply #'make-instance slot-class args)))
- slot)))))
+(defun make-direct-slot-definition (class &key name
+ (initargs ())
+ (initform nil)
+ (initfunction nil)
+ (readers ())
+ (writers ())
+ (allocation :instance)
+ &allow-other-keys)
+ (let ((slot (make-slot-definition)))
+ (set-slot-definition-name slot name)
+ (set-slot-definition-initargs slot initargs)
+ (set-slot-definition-initform slot initform)
+ (set-slot-definition-initfunction slot initfunction)
+ (set-slot-definition-readers slot readers)
+ (set-slot-definition-writers slot writers)
+ (set-slot-definition-allocation slot allocation)
+ (set-slot-definition-allocation-class slot class)
+ slot))
+
+(defun make-effective-slot-definition (&key name
+ (initargs ())
+ (initform nil)
+ (initfunction nil)
+ (allocation :instance)
+ (allocation-class nil)
+ &allow-other-keys)
+ (let ((slot (make-slot-definition)))
+ (set-slot-definition-name slot name)
+ (set-slot-definition-initargs slot initargs)
+ (set-slot-definition-initform slot initform)
+ (set-slot-definition-initfunction slot initfunction)
+ (set-slot-definition-allocation slot allocation)
+ (set-slot-definition-allocation-class slot allocation-class)
+ slot))
;;; finalize-inheritance
@@ -462,10 +455,10 @@
all-names)))
(defun std-compute-effective-slot-definition (class direct-slots)
+ (declare (ignore class))
(let ((initer (find-if-not #'null direct-slots
:key #'%slot-definition-initfunction)))
(make-effective-slot-definition
- class
:name (%slot-definition-name (car direct-slots))
:initform (if initer
(%slot-definition-initform initer)
@@ -566,12 +559,6 @@
:direct-default-initargs direct-default-initargs)
class))
-;(defun convert-to-direct-slot-definition (class canonicalized-slot)
-; (apply #'make-instance
-; (apply #'direct-slot-definition-class
-; class canonicalized-slot)
-; canonicalized-slot))
-
(defun std-after-initialization-for-classes (class
&key direct-superclasses direct-slots
direct-default-initargs
@@ -1912,17 +1899,7 @@
(redefine-class-forwarder class-direct-default-initargs direct-default-initargs)
(redefine-class-forwarder (setf class-direct-default-initargs) direct-default-initargs)
-(defgeneric direct-slot-definition-class (class &rest initargs))
-
-(defmethod direct-slot-definition-class ((class class) &rest initargs)
- (declare (ignore initargs))
- +the-direct-slot-definition-class+)
-
-(defgeneric effective-slot-definition-class (class &rest initargs))
-(defmethod effective-slot-definition-class ((class class) &rest initargs)
- (declare (ignore initargs))
- +the-effective-slot-definition-class+)
(fmakunbound 'documentation)
(defgeneric documentation (x doc-type))
@@ -2235,17 +2212,6 @@
(defmethod shared-initialize ((instance standard-object) slot-names &rest initargs)
(std-shared-initialize instance slot-names initargs))
-(defmethod shared-initialize ((slot slot-definition) slot-names
- &rest initargs
- &key name initargs initform initfunction
- readers writers allocation
- &allow-other-keys)
- ;;Keyword args are duplicated from init-slot-definition only to have
- ;;them checked.
- (declare (ignore slot-names)) ;;TODO?
- (declare (ignore name initargs initform initfunction readers writers allocation))
- (apply #'init-slot-definition slot initargs))
-
;;; change-class
(defgeneric change-class (instance new-class &key))
Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-file.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/compile-file.lisp Wed Jun 9 07:17:17 2010
@@ -40,33 +40,17 @@
(defvar *output-file-pathname*)
-(defun base-classname (&optional (output-file-pathname *output-file-pathname*))
- (sanitize-class-name (pathname-name output-file-pathname)))
-
-(defun fasl-loader-classname (&optional (output-file-pathname *output-file-pathname*))
- (%format nil "~A_0" (base-classname output-file-pathname)))
-
(declaim (ftype (function (t) t) compute-classfile-name))
(defun compute-classfile-name (n &optional (output-file-pathname
*output-file-pathname*))
"Computes the name of the class file associated with number `n'."
(let ((name
- (sanitize-class-name
- (%format nil "~A_~D" (pathname-name output-file-pathname) n))))
+ (%format nil "~A-~D"
+ (substitute #\_ #\.
+ (pathname-name output-file-pathname)) n)))
(namestring (merge-pathnames (make-pathname :name name :type "cls")
output-file-pathname))))
-(defun sanitize-class-name (name)
- (let ((name (copy-seq name)))
- (dotimes (i (length name))
- (declare (type fixnum i))
- (when (or (char= (char name i) #\-)
- (char= (char name i) #\.)
- (char= (char name i) #\Space))
- (setf (char name i) #\_)))
- name))
-
-
(declaim (ftype (function () t) next-classfile-name))
(defun next-classfile-name ()
(compute-classfile-name (incf *class-number*)))
@@ -85,14 +69,12 @@
(declaim (ftype (function (t) t) verify-load))
(defun verify-load (classfile)
- #|(if (> *safety* 0)
- (and classfile
+ (if (> *safety* 0)
+ (and classfile
(let ((*load-truename* *output-file-pathname*))
(report-error
(load-compiled-function classfile))))
- t)|#
- (declare (ignore classfile))
- t)
+ t))
(declaim (ftype (function (t) t) process-defconstant))
(defun process-defconstant (form)
@@ -162,7 +144,6 @@
(parse-body body)
(let* ((expr `(lambda ,lambda-list
, at decls (block ,block-name , at body)))
- (saved-class-number *class-number*)
(classfile (next-classfile-name))
(internal-compiler-errors nil)
(result (with-open-file
@@ -187,8 +168,7 @@
compiled-function)
(setf form
`(fset ',name
- (sys::get-fasl-function *fasl-loader*
- ,saved-class-number)
+ (proxy-preloaded-function ',name ,(file-namestring classfile))
,*source-position*
',lambda-list
,doc))
@@ -245,7 +225,6 @@
(let ((name (second form)))
(eval form)
(let* ((expr (function-lambda-expression (macro-function name)))
- (saved-class-number *class-number*)
(classfile (next-classfile-name)))
(with-open-file
(f classfile
@@ -262,10 +241,14 @@
(if (special-operator-p name)
`(put ',name 'macroexpand-macro
(make-macro ',name
- (sys::get-fasl-function *fasl-loader* ,saved-class-number)))
+ (proxy-preloaded-function
+ '(macro-function ,name)
+ ,(file-namestring classfile))))
`(fset ',name
(make-macro ',name
- (sys::get-fasl-function *fasl-loader* ,saved-class-number))
+ (proxy-preloaded-function
+ '(macro-function ,name)
+ ,(file-namestring classfile)))
,*source-position*
',(third form)))))))))
(DEFTYPE
@@ -365,12 +348,8 @@
;; to load the compiled functions. Note that this trickery
;; was already used in verify-load before I used it,
;; however, binding *load-truename* isn't fully compliant, I think.
- (when compile-time-too
- (let ((*load-truename* *output-file-pathname*)
- (*fasl-loader* (make-fasl-class-loader
- *class-number*
- (concatenate 'string "org.armedbear.lisp." (base-classname))
- nil)))
+ (let ((*load-truename* *output-file-pathname*))
+ (when compile-time-too
(eval form))))
(declaim (ftype (function (t) t) convert-ensure-method))
@@ -387,8 +366,7 @@
(eq (%car function-form) 'FUNCTION))
(let ((lambda-expression (cadr function-form)))
(jvm::with-saved-compiler-policy
- (let* ((saved-class-number *class-number*)
- (classfile (next-classfile-name))
+ (let* ((classfile (next-classfile-name))
(result
(with-open-file
(f classfile
@@ -401,8 +379,7 @@
(declare (ignore result))
(cond (compiled-function
(setf (getf tail key)
- `(sys::get-fasl-function *fasl-loader* ,saved-class-number)))
-;; `(load-compiled-function ,(file-namestring classfile))))
+ `(load-compiled-function ,(file-namestring classfile))))
(t
;; FIXME This should be a warning or error of some sort...
(format *error-output* "; Unable to compile method~%")))))))))
@@ -435,7 +412,6 @@
(return-from convert-toplevel-form
(precompiler:precompile-form form nil *compile-file-environment*)))
(let* ((expr `(lambda () ,form))
- (saved-class-number *class-number*)
(classfile (next-classfile-name))
(result
(with-open-file
@@ -449,7 +425,7 @@
(declare (ignore result))
(setf form
(if compiled-function
- `(funcall (sys::get-fasl-function *fasl-loader* ,saved-class-number))
+ `(funcall (load-compiled-function ,(file-namestring classfile)))
(precompiler:precompile-form form nil *compile-file-environment*)))))
@@ -596,22 +572,25 @@
(write (list 'setq '*source* *compile-file-truename*)
:stream out)
(%stream-terpri out)
- ;; Note: Beyond this point, you can't use DUMP-FORM,
- ;; because the list of uninterned symbols has been fixed now.
- (when *fasl-uninterned-symbols*
- (write (list 'setq '*fasl-uninterned-symbols*
- (coerce (mapcar #'car
- (nreverse *fasl-uninterned-symbols*))
- 'vector))
- :stream out))
- (%stream-terpri out)
-
- (when (> *class-number* 0)
- (generate-loader-function)
- (write (list 'setq '*fasl-loader*
- `(sys::make-fasl-class-loader
- ,*class-number*
- ,(concatenate 'string "org.armedbear.lisp." (base-classname)))) :stream out))
+ ;; Note: Beyond this point, you can't use DUMP-FORM,
+ ;; because the list of uninterned symbols has been fixed now.
+ (when *fasl-uninterned-symbols*
+ (write (list 'setq '*fasl-uninterned-symbols*
+ (coerce (mapcar #'car
+ (nreverse *fasl-uninterned-symbols*))
+ 'vector))
+ :stream out))
+ (%stream-terpri out)
+ ;; we work with a fixed variable name here to work around the
+ ;; lack of availability of the circle reader in the fasl reader
+ ;; but it's a toplevel form anyway
+ (write `(dotimes (i ,*class-number*)
+ (function-preload
+ (%format nil "~A-~D.cls"
+ ,(substitute #\_ #\. (pathname-name output-file))
+ (1+ i))))
+ :stream out
+ :circle t)
(%stream-terpri out))
@@ -630,11 +609,7 @@
(zipfile (namestring
(merge-pathnames (make-pathname :type type)
output-file)))
- (pathnames nil)
- (fasl-loader (namestring (merge-pathnames (make-pathname :name (fasl-loader-classname) :type "cls")
- output-file))))
- (when (probe-file fasl-loader)
- (push fasl-loader pathnames))
+ (pathnames ()))
(dotimes (i *class-number*)
(let* ((pathname (compute-classfile-name (1+ i))))
(when (probe-file pathname)
@@ -657,55 +632,6 @@
(namestring output-file) elapsed))))
(values (truename output-file) warnings-p failure-p)))
-(defmacro ncase (expr min max &rest clauses)
- "A CASE where all test clauses are numbers ranging from a minimum to a maximum."
- ;;Expr is subject to multiple evaluation, but since we only use ncase for
- ;;fn-index below, let's ignore it.
- (let* ((half (floor (/ (- max min) 2)))
- (middle (+ min half)))
- (if (> (- max min) 10)
- `(if (< ,expr ,middle)
- (ncase ,expr ,min ,middle ,@(subseq clauses 0 half))
- (ncase ,expr ,middle ,max ,@(subseq clauses half)))
- `(case ,expr , at clauses))))
-
-(defun generate-loader-function ()
- (let* ((basename (base-classname))
- (expr `(lambda (fasl-loader fn-index)
- (identity fasl-loader) ;;to avoid unused arg
- (ncase fn-index 0 ,(1- *class-number*)
- ,@(loop
- :for i :from 1 :to *class-number*
- :collect
- (let ((class (%format nil "org/armedbear/lisp/~A_~A" basename i)))
- `(,(1- i)
- (jvm::with-inline-code ()
- (jvm::emit 'jvm::aload 1)
- (jvm::emit-invokevirtual jvm::+lisp-object-class+ "javaInstance"
- nil jvm::+java-object+)
- (jvm::emit 'jvm::checkcast "org/armedbear/lisp/FaslClassLoader")
- (jvm::emit 'jvm::dup)
- (jvm::emit-push-constant-int ,(1- i))
- (jvm::emit 'jvm::new ,class)
- (jvm::emit 'jvm::dup)
- (jvm::emit-invokespecial-init ,class '())
- (jvm::emit-invokevirtual "org/armedbear/lisp/FaslClassLoader" "putFunction"
- (list "I" jvm::+lisp-object+) jvm::+lisp-object+)
- (jvm::emit 'jvm::pop))
- t))))))
- (classname (fasl-loader-classname))
- (classfile (namestring (merge-pathnames (make-pathname :name classname :type "cls")
- *output-file-pathname*))))
- (jvm::with-saved-compiler-policy
- (jvm::with-file-compilation
- (with-open-file
- (f classfile
- :direction :output
- :element-type '(unsigned-byte 8)
- :if-exists :supersede)
- (jvm:compile-defun nil expr nil
- classfile f nil))))))
-
(defun compile-file-if-needed (input-file &rest allargs &key force-compile
&allow-other-keys)
(setf input-file (truename input-file))
Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp Wed Jun 9 07:17:17 2010
@@ -1298,7 +1298,7 @@
(format t "; inlining call to local function ~S~%" op)))
(return-from p1-function-call
(let ((*inline-declarations*
- (remove op *inline-declarations* :key #'car :test #'equal)))
+ (remove op *inline-declarations* :key #'car)))
(p1 expansion))))))
;; FIXME
@@ -1432,8 +1432,7 @@
(TRULY-THE p1-truly-the)
(UNWIND-PROTECT p1-unwind-protect)
(THREADS:SYNCHRONIZED-ON
- p1-threads-synchronized-on)
- (JVM::WITH-INLINE-CODE identity)))
+ p1-threads-synchronized-on)))
(install-p1-handler (%car pair) (%cadr pair))))
(initialize-p1-handlers)
Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Wed Jun 9 07:17:17 2010
@@ -198,8 +198,6 @@
(u2 (if (< n 0) (1+ (logxor (- n) #xFFFF))
n)))
-(defconstant +fasl-loader-class+
- "org/armedbear/lisp/FaslClassLoader")
(defconstant +java-string+ "Ljava/lang/String;")
(defconstant +java-object+ "Ljava/lang/Object;")
(defconstant +lisp-class+ "org/armedbear/lisp/Lisp")
@@ -2269,22 +2267,12 @@
local-function *declared-functions* ht g
(setf g (symbol-name (gensym "LFUN")))
(let* ((pathname (abcl-class-file-pathname (local-function-class-file local-function)))
- (class-name (concatenate 'string "org/armedbear/lisp/" (pathname-name pathname)))
(*code* *static-code*))
;; fixme *declare-inline*
- (declare-field g +lisp-object+ +field-access-private+)
- (emit 'new class-name)
- (emit 'dup)
- (emit-invokespecial-init class-name '())
-
- ;(emit 'ldc (pool-string (pathname-name pathname)))
- ;(emit-invokestatic +fasl-loader-class+ "faslLoadFunction"
- ;(list +java-string+) +lisp-object+)
-
-; (emit 'ldc (pool-string (file-namestring pathname)))
-
-; (emit-invokestatic +lisp-function-proxy-class+ "loadPreloadedFunction"
-; (list +java-string+) +lisp-object+)
+ (declare-field g +lisp-object+ +field-access-default+)
+ (emit 'ldc (pool-string (file-namestring pathname)))
+ (emit-invokestatic +lisp-function-proxy-class+ "loadPreloadedFunction"
+ (list +java-string+) +lisp-object+)
(emit 'putstatic *this-class* g +lisp-object+)
(setf *static-code* *code*)
(setf (gethash local-function ht) g))))
@@ -2433,6 +2421,10 @@
(packagep form)
(pathnamep form)
(vectorp form)
+ (stringp form)
+ (packagep form)
+ (pathnamep form)
+ (vectorp form)
(structure-object-p form)
(standard-object-p form)
(java:java-object-p form))
@@ -5106,8 +5098,7 @@
(local-function-function local-function)))))
(emit 'getstatic *this-class*
g +lisp-object+))))) ; Stack: template-function
- ((and (member name *functions-defined-in-current-file* :test #'equal)
- (not (notinline-p name)))
+ ((member name *functions-defined-in-current-file* :test #'equal)
(emit 'getstatic *this-class*
(declare-setf-function name) +lisp-object+)
(emit-move-from-stack target))
@@ -7557,32 +7548,6 @@
;; delay resolving the method to run-time; it's unavailable now
(compile-function-call form target representation))))
-#|(defknown p2-java-jcall (t t t) t)
-(define-inlined-function p2-java-jcall (form target representation)
- ((and (> *speed* *safety*)
- (< 1 (length form))
- (eq 'jmethod (car (cadr form)))
- (every #'stringp (cdr (cadr form)))))
- (let ((m (ignore-errors (eval (cadr form)))))
- (if m
- (let ((must-clear-values nil)
- (arg-types (raw-arg-types (jmethod-params m))))
- (declare (type boolean must-clear-values))
- (dolist (arg (cddr form))
- (compile-form arg 'stack nil)
- (unless must-clear-values
- (unless (single-valued-p arg)
- (setf must-clear-values t))))
- (when must-clear-values
- (emit-clear-values))
- (dotimes (i (jarray-length raw-arg-types))
- (push (jarray-ref raw-arg-types i) arg-types))
- (emit-invokevirtual (jclass-name (jmethod-declaring-class m))
- (jmethod-name m)
- (nreverse arg-types)
- (jmethod-return-type m)))
- ;; delay resolving the method to run-time; it's unavailable now
- (compile-function-call form target representation))))|#
(defknown p2-char= (t t t) t)
(defun p2-char= (form target representation)
@@ -8259,13 +8224,6 @@
(setf (method-handlers execute-method) (nreverse *handlers*)))
t)
-(defun p2-with-inline-code (form target representation)
- ;;form = (with-inline-code (&optional target-var repr-var) ...body...)
- (destructuring-bind (&optional target-var repr-var) (cadr form)
- (eval `(let (,@(when target-var `((,target-var ,target)))
- ,@(when repr-var `((,repr-var ,representation))))
- ,@(cddr form)))))
-
(defun compile-1 (compiland stream)
(let ((*all-variables* nil)
(*closure-variables* nil)
@@ -8558,7 +8516,6 @@
(install-p2-handler 'java:jclass 'p2-java-jclass)
(install-p2-handler 'java:jconstructor 'p2-java-jconstructor)
(install-p2-handler 'java:jmethod 'p2-java-jmethod)
-; (install-p2-handler 'java:jcall 'p2-java-jcall)
(install-p2-handler 'char= 'p2-char=)
(install-p2-handler 'characterp 'p2-characterp)
(install-p2-handler 'coerce-to-function 'p2-coerce-to-function)
@@ -8643,7 +8600,6 @@
(install-p2-handler 'vector-push-extend 'p2-vector-push-extend)
(install-p2-handler 'write-8-bits 'p2-write-8-bits)
(install-p2-handler 'zerop 'p2-zerop)
- (install-p2-handler 'with-inline-code 'p2-with-inline-code)
t)
(initialize-p2-handlers)
Modified: trunk/abcl/src/org/armedbear/lisp/disassemble.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/disassemble.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/disassemble.lisp Wed Jun 9 07:17:17 2010
@@ -47,15 +47,14 @@
(when (functionp function)
(unless (compiled-function-p function)
(setf function (compile nil function)))
- (let ((class-bytes (function-class-bytes function)))
- (when class-bytes
- (with-input-from-string
- (stream (disassemble-class-bytes class-bytes))
- (loop
- (let ((line (read-line stream nil)))
- (unless line (return))
- (write-string "; ")
- (write-string line)
- (terpri))))
- (return-from disassemble)))
- (%format t "; Disassembly is not available.~%"))))
+ (when (getf (function-plist function) 'class-bytes)
+ (with-input-from-string
+ (stream (disassemble-class-bytes (getf (function-plist function) 'class-bytes)))
+ (loop
+ (let ((line (read-line stream nil)))
+ (unless line (return))
+ (write-string "; ")
+ (write-string line)
+ (terpri))))
+ (return-from disassemble)))
+ (%format t "; Disassembly is not available.~%")))
Modified: trunk/abcl/src/org/armedbear/lisp/gui.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/gui.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/gui.lisp Wed Jun 9 07:17:17 2010
@@ -1,7 +1,5 @@
(in-package :extensions)
-(require :java)
-
(defvar *gui-backend* :swing)
(defun init-gui ()
Copied: trunk/abcl/src/org/armedbear/lisp/java/DialogPromptStream.java (from r12742, /trunk/abcl/examples/gui/abcl/DialogPromptStream.java)
==============================================================================
--- /trunk/abcl/examples/gui/abcl/DialogPromptStream.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/java/DialogPromptStream.java Wed Jun 9 07:17:17 2010
@@ -1,4 +1,4 @@
-package abcl;
+package org.armedbear.lisp.java;
import java.io.IOException;
import java.io.Reader;
@@ -6,17 +6,12 @@
import java.io.StringWriter;
import org.armedbear.lisp.Stream;
-
/**
- * A bidirectional stream that captures input from a modal dialog. The
- * dialog reports a label (prompt line) which shows to the user
- * everything that has been printed to the stream up to the moment
- * when the dialog became visible. It is usable as a drop-in
- * replacement for e.g. *debug-io*.<br /> This is an abstract class
- * that does not depend on any GUI library. Subclasses are expected to
- * provide the actual code to show the dialog and read input from the
- * user.
- *
+ * A bidirectional stream that captures input from a modal dialog. The dialog reports a label (prompt line)
+ * which shows to the user everything that has been printed to the stream up to the moment when the dialog
+ * became visible. It is usable as a drop-in replacement for e.g. *debug-io*.<br />
+ * This is an abstract class that does not depend on any GUI library. Subclasses are expected to provide
+ * the actual code to show the dialog and read input from the user.
* @author Alessio Stalla
*
*/
Copied: trunk/abcl/src/org/armedbear/lisp/java/swing/SwingDialogPromptStream.java (from r12742, /trunk/abcl/examples/gui/swing/SwingDialogPromptStream.java)
==============================================================================
--- /trunk/abcl/examples/gui/swing/SwingDialogPromptStream.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/java/swing/SwingDialogPromptStream.java Wed Jun 9 07:17:17 2010
@@ -1,4 +1,4 @@
-package swing;
+package org.armedbear.lisp.java.swing;
import java.awt.BorderLayout;
import java.awt.FlowLayout;
@@ -12,7 +12,7 @@
import javax.swing.JPanel;
import javax.swing.JTextField;
-import abcl.DialogPromptStream;
+import org.armedbear.lisp.java.DialogPromptStream;
public class SwingDialogPromptStream extends DialogPromptStream {
Modified: trunk/abcl/src/org/armedbear/lisp/load.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/load.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/load.lisp Wed Jun 9 07:17:17 2010
@@ -38,11 +38,10 @@
(if-does-not-exist t)
(external-format :default))
(declare (ignore external-format)) ; FIXME
- (let (*fasl-loader*)
- (%load (if (streamp filespec)
- filespec
- (merge-pathnames (pathname filespec)))
- verbose print if-does-not-exist)))
+ (%load (if (streamp filespec)
+ filespec
+ (merge-pathnames (pathname filespec)))
+ verbose print if-does-not-exist))
(defun load-returning-last-result (filespec
&key
@@ -51,8 +50,7 @@
(if-does-not-exist t)
(external-format :default))
(declare (ignore external-format)) ; FIXME
- (let (*fasl-loader*)
- (%load-returning-last-result (if (streamp filespec)
- filespec
- (merge-pathnames (pathname filespec)))
- verbose print if-does-not-exist)))
\ No newline at end of file
+ (%load-returning-last-result (if (streamp filespec)
+ filespec
+ (merge-pathnames (pathname filespec)))
+ verbose print if-does-not-exist))
\ No newline at end of file
Modified: trunk/abcl/src/org/armedbear/lisp/precompiler.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/precompiler.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/precompiler.lisp Wed Jun 9 07:17:17 2010
@@ -32,10 +32,13 @@
(in-package "SYSTEM")
-(export '(process-optimization-declarations
+(export '(*inline-declarations*
+ process-optimization-declarations
inline-p notinline-p inline-expansion expand-inline
*defined-functions* *undefined-functions* note-name-defined))
+(defvar *inline-declarations* nil)
+
(declaim (ftype (function (t) t) process-optimization-declarations))
(defun process-optimization-declarations (forms)
(dolist (form forms)
@@ -83,7 +86,7 @@
(declaim (ftype (function (t) t) inline-p))
(defun inline-p (name)
(declare (optimize speed))
- (let ((entry (assoc name *inline-declarations* :test #'equal)))
+ (let ((entry (assoc name *inline-declarations*)))
(if entry
(eq (cdr entry) 'INLINE)
(and (symbolp name) (eq (get name '%inline) 'INLINE)))))
@@ -91,7 +94,7 @@
(declaim (ftype (function (t) t) notinline-p))
(defun notinline-p (name)
(declare (optimize speed))
- (let ((entry (assoc name *inline-declarations* :test #'equal)))
+ (let ((entry (assoc name *inline-declarations*)))
(if entry
(eq (cdr entry) 'NOTINLINE)
(and (symbolp name) (eq (get name '%inline) 'NOTINLINE)))))
@@ -958,8 +961,7 @@
(symbol-name symbol))
'precompiler))))
(unless (and handler (fboundp handler))
- (error "No handler for ~S." (let ((*package* (find-package :keyword)))
- (format nil "~S" symbol))))
+ (error "No handler for ~S." symbol))
(setf (get symbol 'precompile-handler) handler)))
(defun install-handlers ()
@@ -1022,9 +1024,7 @@
(TRULY-THE precompile-truly-the)
(THREADS:SYNCHRONIZED-ON
- precompile-threads-synchronized-on)
-
- (JVM::WITH-INLINE-CODE precompile-identity)))
+ precompile-threads-synchronized-on)))
(install-handler (first pair) (second pair))))
(install-handlers)
Modified: trunk/abcl/src/org/armedbear/lisp/proclaim.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/proclaim.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/proclaim.lisp Wed Jun 9 07:17:17 2010
@@ -31,7 +31,7 @@
(in-package #:system)
-(export '(check-declaration-type proclaimed-type proclaimed-ftype ftype-result-type *inline-declarations*))
+(export '(check-declaration-type proclaimed-type proclaimed-ftype ftype-result-type))
(defmacro declaim (&rest decls)
`(eval-when (:compile-toplevel :load-toplevel :execute)
@@ -43,7 +43,6 @@
:format-control "The symbol ~S cannot be both the name of a type and the name of a declaration."
:format-arguments (list name)))
-(defvar *inline-declarations* nil)
(defvar *declaration-types* (make-hash-table :test 'eq))
;; "A symbol cannot be both the name of a type and the name of a declaration.
@@ -92,9 +91,8 @@
(apply 'proclaim-type (cdr declaration-specifier)))
((INLINE NOTINLINE)
(dolist (name (cdr declaration-specifier))
- (if (symbolp name)
- (setf (get name '%inline) (car declaration-specifier))
- (push (cons name (car declaration-specifier)) *inline-declarations*))))
+ (when (symbolp name) ; FIXME Need to support non-symbol function names.
+ (setf (get name '%inline) (car declaration-specifier)))))
(DECLARATION
(dolist (name (cdr declaration-specifier))
(when (or (get name 'deftype-definition)
Modified: trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java Wed Jun 9 07:17:17 2010
@@ -278,6 +278,7 @@
return new AbclScriptEngineFactory();
}
+ @Override
public <T> T getInterface(Class<T> clasz) {
try {
return getInterface(eval("(cl:find-package '#:ABCL-SCRIPT-USER)"), clasz);
@@ -287,12 +288,14 @@
}
@SuppressWarnings("unchecked")
+ @Override
public <T> T getInterface(Object thiz, Class<T> clasz) {
Symbol s = findSymbol("jmake-proxy", "JAVA");
JavaObject iface = new JavaObject(clasz);
return (T) ((JavaObject) s.execute(iface, (LispObject) thiz)).javaInstance();
}
+ @Override
public Object invokeFunction(String name, Object... args) throws ScriptException, NoSuchMethodException {
Symbol s;
if(name.indexOf(':') >= 0) {
@@ -317,6 +320,7 @@
}
}
+ @Override
public Object invokeMethod(Object thiz, String name, Object... args) throws ScriptException, NoSuchMethodException {
throw new UnsupportedOperationException("Common Lisp does not have methods in the Java sense. Use invokeFunction instead.");
}
Modified: trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java Wed Jun 9 07:17:17 2010
@@ -31,92 +31,104 @@
private static final AbclScriptEngine THE_ONLY_ONE_ENGINE = new AbclScriptEngine();
- public String getEngineName() {
- return "ABCL Script";
- }
-
- public String getEngineVersion() {
- return "0.1";
- }
-
- public List<String> getExtensions() {
- List<String> extensions = new ArrayList<String>(1);
- extensions.add("lisp");
- return Collections.unmodifiableList(extensions);
- }
-
- public String getLanguageName() {
- return "ANSI Common Lisp";
- }
-
- public String getLanguageVersion() {
- return "ANSI X3.226:1994";
- }
-
- public static String escape(String raw) {
- StringBuilder sb = new StringBuilder();
- int len = raw.length();
- char c;
- for(int i = 0; i < len; ++i) {
- c = raw.charAt(i);
- if(c != '"') {
- sb.append(c);
- } else {
- sb.append("\\\"");
- }
+ @Override
+ public String getEngineName() {
+ return "ABCL Script";
+ }
+
+ @Override
+ public String getEngineVersion() {
+ return "0.1";
+ }
+
+ @Override
+ public List<String> getExtensions() {
+ List<String> extensions = new ArrayList<String>(1);
+ extensions.add("lisp");
+ return Collections.unmodifiableList(extensions);
+ }
+
+ @Override
+ public String getLanguageName() {
+ return "ANSI Common Lisp";
+ }
+
+ @Override
+ public String getLanguageVersion() {
+ return "ANSI X3.226:1994";
+ }
+
+ public static String escape(String raw) {
+ StringBuilder sb = new StringBuilder();
+ int len = raw.length();
+ char c;
+ for(int i = 0; i < len; ++i) {
+ c = raw.charAt(i);
+ if(c != '"') {
+ sb.append(c);
+ } else {
+ sb.append("\\\"");
+ }
+ }
+ return sb.toString();
}
- return sb.toString();
- }
- public String getMethodCallSyntax(String obj, String method, String... args) {
- StringBuilder sb = new StringBuilder();
- sb.append("(jcall \"");
- sb.append(method);
- sb.append("\" ");
- sb.append(obj);
- for(String arg : args) {
- sb.append(" ");
- sb.append(arg);
- }
- sb.append(")");
- return sb.toString();
- }
-
- public List<String> getMimeTypes() {
- return Collections.unmodifiableList(new ArrayList<String>());
- }
-
- public List<String> getNames() {
- List<String> names = new ArrayList<String>(1);
- names.add("ABCL");
- names.add("cl");
- names.add("Lisp");
- names.add("Common Lisp");
- return Collections.unmodifiableList(names);
- }
-
- public String getOutputStatement(String str) {
- return "(cl:print \"" + str + "\")";
- }
-
- public Object getParameter(String key) {
- // TODO Auto-generated method stub
- return null;
- }
-
- public String getProgram(String... statements) {
- StringBuilder sb = new StringBuilder();
- sb.append("(cl:progn");
- for(String stmt : statements) {
- sb.append("\n\t");
- sb.append(stmt);
- }
- sb.append(")");
- return sb.toString();
- }
-
- public ScriptEngine getScriptEngine() {
- return THE_ONLY_ONE_ENGINE;
- }
+ @Override
+ public String getMethodCallSyntax(String obj, String method, String... args) {
+ StringBuilder sb = new StringBuilder();
+ sb.append("(jcall \"");
+ sb.append(method);
+ sb.append("\" ");
+ sb.append(obj);
+ for(String arg : args) {
+ sb.append(" ");
+ sb.append(arg);
+ }
+ sb.append(")");
+ return sb.toString();
+ }
+
+ @Override
+ public List<String> getMimeTypes() {
+ return Collections.unmodifiableList(new ArrayList<String>());
+ }
+
+ @Override
+ public List<String> getNames() {
+ List<String> names = new ArrayList<String>(1);
+ names.add("ABCL");
+ names.add("cl");
+ names.add("Lisp");
+ names.add("Common Lisp");
+ return Collections.unmodifiableList(names);
+ }
+
+ @Override
+ public String getOutputStatement(String str) {
+ return "(cl:print \"" + str + "\")";
+ }
+
+ @Override
+ public Object getParameter(String key) {
+ // TODO Auto-generated method stub
+ return null;
+ }
+
+ @Override
+ public String getProgram(String... statements) {
+ StringBuilder sb = new StringBuilder();
+ sb.append("(cl:progn");
+ for(String stmt : statements) {
+ sb.append("\n\t");
+ sb.append(stmt);
+ }
+ sb.append(")");
+ return sb.toString();
+ }
+
+ @Override
+ public ScriptEngine getScriptEngine() {
+ return THE_ONLY_ONE_ENGINE;
+ }
}
More information about the armedbear-cvs
mailing list