From mevenson at common-lisp.net Sun Feb 1 09:15:52 2009 From: mevenson at common-lisp.net (Mark Evenson) Date: Sun, 01 Feb 2009 09:15:52 +0000 Subject: [armedbear-cvs] r11615 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: mevenson Date: Sun Feb 1 09:15:49 2009 New Revision: 11615 Log: Revert publishing of "internal" version back to 0.13.0-dev. Modified: trunk/abcl/src/org/armedbear/lisp/Version.java Modified: trunk/abcl/src/org/armedbear/lisp/Version.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Version.java (original) +++ trunk/abcl/src/org/armedbear/lisp/Version.java Sun Feb 1 09:15:49 2009 @@ -41,6 +41,6 @@ public static String getVersion() { - return "0.12.37"; + return "0.13.0-dev"; } } From vvoutilainen at common-lisp.net Sun Feb 1 19:24:16 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Sun, 01 Feb 2009 19:24:16 +0000 Subject: [armedbear-cvs] r11616 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: vvoutilainen Date: Sun Feb 1 19:24:13 2009 New Revision: 11616 Log: Better matching in directory listing. There are still cases where I can break it with my own trees, but it doesn't list superfluous entries with this patch. Modified: trunk/abcl/src/org/armedbear/lisp/directory.lisp Modified: trunk/abcl/src/org/armedbear/lisp/directory.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/directory.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/directory.lisp Sun Feb 1 19:24:13 2009 @@ -44,11 +44,11 @@ (defun list-directories-with-wildcards (pathname) (let* ((directory (pathname-directory pathname)) (first-wild (position-if #'wild-p directory)) - (wild (and first-wild (nthcdr first-wild directory))) - (non-wild (or (and first-wild - (nbutlast directory - (- (length directory) first-wild)) - directory))) + (wild (when first-wild (nthcdr first-wild directory))) + (non-wild (if first-wild + (nbutlast directory + (- (length directory) first-wild)) + directory)) (newpath (make-pathname :directory non-wild :name nil :type nil :defaults pathname)) (entries (list-directory newpath))) @@ -57,12 +57,13 @@ (let* ((pathname (pathname entry)) (directory (pathname-directory pathname)) (rest-wild (cdr wild))) - (unless (file-namestring pathname) - (when rest-wild - (setf directory (nconc directory rest-wild))) - (list-directories-with-wildcards - (make-pathname :directory directory - :defaults newpath))))) + (unless (pathname-name pathname) + (when (pathname-match-p (first (last directory)) (if (eql (car wild) :wild) "*" (car wild))) + (when rest-wild + (setf directory (nconc directory rest-wild))) + (list-directories-with-wildcards + (make-pathname :directory directory + :defaults newpath)))))) entries)))) From ehuelsmann at common-lisp.net Sun Feb 1 22:15:46 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 01 Feb 2009 22:15:46 +0000 Subject: [armedbear-cvs] r11617 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Feb 1 22:15:32 2009 New Revision: 11617 Log: More CONVERT-REPRESENTATIONs. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Sun Feb 1 22:15:32 2009 @@ -7681,18 +7681,8 @@ (aver (variable-register variable)) (emit 'iinc (variable-register variable) 1) (when target - (case representation - (:int - (emit 'iload (variable-register variable))) - (:long - (emit 'iload (variable-register variable)) - (emit 'i2l)) - (t - (new-fixnum) - (aver (variable-register variable)) - (emit 'iload (variable-register variable)) - (emit-invokespecial-init +lisp-fixnum-class+ '("I")) - (fix-boxing representation nil))) + (emit 'iload (variable-register variable)) + (convert-representation :int representation) (emit-move-from-stack target representation)) (return-from p2-setq))) @@ -7704,15 +7694,7 @@ ;; this case once the new code is stable. (emit 'iinc (variable-register variable) 1) (when target - (cond ((eq representation :int) - (emit 'iload (variable-register variable))) - (t - (dformat t "p2-setq constructing boxed fixnum for ~S~%" - (variable-name variable)) - (new-fixnum) - (aver (variable-register variable)) - (emit 'iload (variable-register variable)) - (emit-invokespecial-init +lisp-fixnum-class+ '("I")))) + (convert-representation :int representation) (emit-move-from-stack target representation))) ((and (eq (variable-representation variable) :int) (or (equal value-form (list '1- (variable-name variable))) @@ -7720,15 +7702,7 @@ (dformat t "p2-setq decf :int case~%") (emit 'iinc (variable-register variable) -1) (when target - (cond ((eq representation :int) - (emit 'iload (variable-register variable))) - (t - (dformat t "p2-setq constructing boxed fixnum for ~S~%" - (variable-name variable)) - (new-fixnum) - (aver (variable-register variable)) - (emit 'iload (variable-register variable)) - (emit-invokespecial-init +lisp-fixnum-class+ '("I")))) + (convert-representation :int representation) (emit-move-from-stack target representation))) ((eq (variable-representation variable) :int) (dformat t "p2-setq :int case value-form = ~S~%" @@ -7739,16 +7713,7 @@ (emit 'istore (variable-register variable)) (when target ;; int on stack here - (case representation - (:int) - (:long - (emit 'i2l)) - (t - ;; need to box int - (emit 'new +lisp-fixnum-class+) ; stack: int new-fixnum - (emit 'dup_x1) ; stack: new-fixnum int new-fixnum - (emit 'swap) ; stack: new-fixnum new-fixnum int - (emit-invokespecial-init +lisp-fixnum-class+ '("I")))) ; stack: fixnum + (convert-representation :int representation) (emit-move-from-stack target representation))) ((eq (variable-representation variable) :char) (dformat t "p2-setq :char case~%") @@ -7758,13 +7723,8 @@ (emit 'istore (variable-register variable)) (when target ;; char on stack here - (when (null representation) - ;; need to box char - (emit 'new +lisp-character-class+) ; stack: char new-character - (emit 'dup_x1) ; stack: new-character char new-character - (emit 'swap) ; stack: new-character new-character char - (emit-invokespecial-init +lisp-character-class+ '("C")) ; stack: character - (emit-move-from-stack target representation)))) + (convert-representation :char representation) + (emit-move-from-stack target representation))) ((eq (variable-representation variable) :long) (compile-forms-and-maybe-emit-clear-values value-form 'stack :long) (when target @@ -7772,12 +7732,7 @@ (emit 'lstore (variable-register variable)) (when target ;; long on stack here - (case representation - (:int - (emit 'l2i)) - (:long) - (t - (convert-representation :long nil))) + (convert-representation :long representation) (emit-move-from-stack target representation))) ((eq (variable-representation variable) :boolean) (compile-forms-and-maybe-emit-clear-values value-form 'stack :boolean) @@ -7786,10 +7741,7 @@ (emit 'istore (variable-register variable)) (when target ;; int on stack here - (case representation - (:boolean) - (t - (convert-representation :boolean nil))) + (convert-representation :boolean representation) (emit-move-from-stack target representation))) (t (compile-forms-and-maybe-emit-clear-values value-form 'stack nil) From astalla at common-lisp.net Mon Feb 2 22:40:58 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Mon, 02 Feb 2009 22:40:58 +0000 Subject: [armedbear-cvs] r11618 - in trunk/abcl/src/org/armedbear/lisp/scripting: . lisp Message-ID: Author: astalla Date: Mon Feb 2 22:40:56 2009 New Revision: 11618 Log: Added support for a configuration file in the CLASSPATH for ABCL when loaded through JSR-223. Added: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp Modified: trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp trunk/abcl/src/org/armedbear/lisp/scripting/lisp/packages.lisp 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 Mon Feb 2 22:40:56 2009 @@ -27,36 +27,11 @@ import java.io.StringWriter; import java.math.BigInteger; import java.util.Map; +import java.util.Properties; -import javax.script.AbstractScriptEngine; -import javax.script.Bindings; -import javax.script.Compilable; -import javax.script.CompiledScript; -import javax.script.Invocable; -import javax.script.ScriptContext; -import javax.script.ScriptEngine; -import javax.script.ScriptEngineFactory; -import javax.script.ScriptException; -import javax.script.SimpleBindings; - -import org.armedbear.lisp.Bignum; -import org.armedbear.lisp.ConditionThrowable; -import org.armedbear.lisp.Cons; -import org.armedbear.lisp.DoubleFloat; -import org.armedbear.lisp.Fixnum; -import org.armedbear.lisp.Function; -import org.armedbear.lisp.Interpreter; -import org.armedbear.lisp.JavaObject; -import org.armedbear.lisp.Keyword; -import org.armedbear.lisp.Lisp; -import org.armedbear.lisp.LispCharacter; -import org.armedbear.lisp.LispObject; -import org.armedbear.lisp.LispThread; -import org.armedbear.lisp.SimpleString; -import org.armedbear.lisp.SimpleVector; -import org.armedbear.lisp.SingleFloat; -import org.armedbear.lisp.Stream; -import org.armedbear.lisp.Symbol; +import javax.script.*; + +import org.armedbear.lisp.*; import org.armedbear.lisp.scripting.util.ReaderInputStream; import org.armedbear.lisp.scripting.util.WriterOutputStream; @@ -68,43 +43,44 @@ private Function evalScript; private Function compileScript; private Function evalCompiledScript; + private boolean configured = false; - public AbclScriptEngine(Interpreter interpreter, boolean enableThrowingDebugger) { - - this.interpreter = interpreter; - Interpreter.initializeLisp(); - final LispThread thread = LispThread.currentThread(); - this.nonThrowingDebugHook = Symbol.DEBUGGER_HOOK.getSymbolValue(); + public AbclScriptEngine(boolean enableThrowingDebugger) { + this(); if (enableThrowingDebugger) { try { - installThrowingDebuggerHook(thread); + installThrowingDebuggerHook(LispThread.currentThread()); } catch (ConditionThrowable e) { throw new InternalError("Can't set throwing debugger hook!"); } } + } + + public AbclScriptEngine() { + interpreter = Interpreter.createInstance(); + interpreter.initializeLisp(); + this.nonThrowingDebugHook = Symbol.DEBUGGER_HOOK.getSymbolValue(); try { loadFromClasspath("/org/armedbear/lisp/scripting/lisp/packages.lisp"); loadFromClasspath("/org/armedbear/lisp/scripting/lisp/abcl-script.lisp"); + loadFromClasspath("/org/armedbear/lisp/scripting/lisp/config.lisp"); + if(getClass().getResource("/abcl-script-config.lisp") != null) { + System.out.println("ABCL: loading configuration from " + getClass().getResource("/abcl-script-config.lisp")); + loadFromClasspath("/abcl-script-config.lisp"); + } + interpreter.eval("(abcl-script:configure-abcl)"); evalScript = (Function) this.findSymbol("EVAL-SCRIPT", "ABCL-SCRIPT").getSymbolFunction(); compileScript = (Function) this.findSymbol("COMPILE-SCRIPT", "ABCL-SCRIPT").getSymbolFunction(); evalCompiledScript = (Function) this.findSymbol("EVAL-COMPILED-SCRIPT", "ABCL-SCRIPT").getSymbolFunction(); } catch (ConditionThrowable e) { - throw new Error(e); + throw new RuntimeException(e); } } - - public AbclScriptEngine(Interpreter interpreter) { - this(interpreter, false); - } - - public AbclScriptEngine(boolean enableThrowingDebugger) { - this(Interpreter.createInstance(), enableThrowingDebugger); - } - - public AbclScriptEngine() { - this(Interpreter.createInstance(), true); + + public boolean isConfigured() { + return configured; } - + public Interpreter getInterpreter() { return interpreter; } Modified: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp Mon Feb 2 22:40:56 2009 @@ -15,6 +15,18 @@ ;;; 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. +;;; +;;; As a special exception, the copyright holders of this library give you +;;; permission to link this library with independent modules to produce an +;;; executable, regardless of the license terms of these independent +;;; modules, and to copy and distribute the resulting executable under +;;; terms of your choice, provided that you also meet, for each linked +;;; independent module, the terms and conditions of the license of that +;;; module. An independent module is a module which is not derived from +;;; or based on this library. If you modify this library, you may extend +;;; this exception to your version of the library, but you are not +;;; obligated to do so. If you do not wish to do so, delete this +;;; exception statement from your version. (in-package :abcl-script) @@ -107,4 +119,7 @@ (defun define-java-interface-implementation (interface implementation &optional lisp-this) (register-java-interface-implementation interface - (jmake-proxy interface implementation lisp-this))) \ No newline at end of file + (jmake-proxy interface implementation lisp-this))) + +;Let's load it so asdf package is already defined when loading config.lisp +(require 'asdf) \ No newline at end of file Added: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp ============================================================================== --- (empty file) +++ trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp Mon Feb 2 22:40:56 2009 @@ -0,0 +1,60 @@ +;;; config.lisp +;;; +;;; Copyright (C) 2008 Alessio Stalla +;;; +;;; 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. +;;; +;;; As a special exception, the copyright holders of this library give you +;;; permission to link this library with independent modules to produce an +;;; executable, regardless of the license terms of these independent +;;; modules, and to copy and distribute the resulting executable under +;;; terms of your choice, provided that you also meet, for each linked +;;; independent module, the terms and conditions of the license of that +;;; module. An independent module is a module which is not derived from +;;; or based on this library. If you modify this library, you may extend +;;; this exception to your version of the library, but you are not +;;; obligated to do so. If you do not wish to do so, delete this +;;; exception statement from your version. + + +(in-package :abcl-script) + +(defparameter *abcl-debug* nil) + +(defparameter *swank-dir* nil) + +(defparameter *swank-port* 4005) + +(defparameter *use-throwing-debugger* t) + +(defparameter *compile-using-temp-files* nil) + +(defconstant +standard-debugger-hook+ *debugger-hook*) + +(defun configure-abcl () + (setq *debugger-hook* + (if *use-throwing-debugger* + #'sys::%debugger-hook-function + +standard-debugger-hook+)) + (when *abcl-debug* + (unless *swank-dir* + (error "Swank directory not specified, please set *swank-dir*")) + (pushnew *swank-dir* asdf:*central-registry* :test #'equal) + (asdf:oos 'asdf:load-op :swank) + (ext:make-thread (lambda () (funcall (find-symbol + (symbol-name '#:create-server) + :swank) + :port *swank-port*)) + :name "ABCL script - Swank thread"))) \ No newline at end of file Modified: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/packages.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/scripting/lisp/packages.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/scripting/lisp/packages.lisp Mon Feb 2 22:40:56 2009 @@ -15,16 +15,36 @@ ;;; 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. +;;; +;;; As a special exception, the copyright holders of this library give you +;;; permission to link this library with independent modules to produce an +;;; executable, regardless of the license terms of these independent +;;; modules, and to copy and distribute the resulting executable under +;;; terms of your choice, provided that you also meet, for each linked +;;; independent module, the terms and conditions of the license of that +;;; module. An independent module is a module which is not derived from +;;; or based on this library. If you modify this library, you may extend +;;; this exception to your version of the library, but you are not +;;; obligated to do so. If you do not wish to do so, delete this +;;; exception statement from your version. (defpackage :abcl-script (:use :cl :java) - (:export #:eval-script - #:compile-script - #:eval-compiled-script - #:define-java-interface-implementation - #:find-java-interface-implementation - #:register-java-interface-implementation - #:remove-java-interface-implementation)) - + (:export + #:*abcl-debug* + #:eval-script + #:compile-script + #:*compile-using-temp-files* + #:configure-abcl + #:eval-compiled-script + #:define-java-interface-implementation + #:find-java-interface-implementation + #:register-java-interface-implementation + #:remove-java-interface-implementation + #:+standard-debugger-hook+ + #:*swank-dir* + #:*swank-port* + #:*use-throwing-debugger*)) + (defpackage :abcl-script-user (:use :cl :ext :java :abcl-script)) \ No newline at end of file From ehuelsmann at common-lisp.net Tue Feb 3 08:23:34 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Tue, 03 Feb 2009 08:23:34 +0000 Subject: [armedbear-cvs] r11619 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Tue Feb 3 08:23:31 2009 New Revision: 11619 Log: Reduce code duplication: move variable representation deduction to DERIVE-VARIABLE-REPRESENTATION. Also: introduce EMIT-MOVE-TO-VARIABLE to move values off the stack to a variable slot, another source for code duplication. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Tue Feb 3 08:23:31 2009 @@ -523,6 +523,11 @@ (compiler-subtypep the-type (make-compiler-type type))) (return-from type-representation (caar types)))))) +(defun representation-size (representation) + (ecase representation + ((NIL :int :boolean :float :char) 1) + ((:long :double) 2))) + ;; source type / ;; targets :boolean :char :int :long :float :double (defvar rep-conversion '((:boolean . #( NIL :err :err :err :err :err)) @@ -4186,6 +4191,83 @@ (dolist (variable removed) (setf (block-vars block) (remove variable (block-vars block))))))) +(defun derive-variable-representation (variable block + &key (type nil type-supplied-p)) + (when (not (null (variable-representation variable))) + ;; representation already derived + (return-from derive-variable-representation)) + (when type-supplied-p + (setf (variable-declared-type variable) type)) + (let ((type (variable-declared-type variable))) + (when (and (eq (variable-declared-type variable) :none) + (eql (variable-writes variable) 0)) + (setf type (variable-derived-type variable))) + (cond ((neq type :none) + (setf (variable-representation variable) + (type-representation type)) + (unless (memq (variable-representation variable) '(:int :long)) + ;; We don't support unboxed variables other than INT and LONG (yet) + (setf (variable-representation variable) NIL))) + ((zerop (variable-writes variable)) + (when (eq :none (variable-derived-type variable)) + (setf (variable-derived-type variable) + (derive-compiler-type (variable-initform variable)))) + (let ((derived-type (variable-derived-type variable))) + (setf (variable-derived-type variable) derived-type) + (setf (variable-representation variable) + (type-representation derived-type)) + (unless (memq (variable-representation variable) '(:int :long)) + ;; We don't support unboxed variables other than INT and LONG (yet) + (setf (variable-representation variable) NIL)))) + ((and block + (get (variable-name variable) 'sys::dotimes-index-variable-p)) + ;; DOTIMES index variable. + (let* ((name (get (variable-name variable) + 'sys::dotimes-limit-variable-name)) + (limit-variable (and name + (or (find-variable name + (block-vars block)) + (find-visible-variable name))))) + (derive-variable-representation limit-variable block) + (setf (variable-representation variable) + (variable-representation limit-variable))))))) + +(defun allocate-variable-register (variable) + (setf (variable-register variable) + (if (= 2 (representation-size (variable-representation variable))) + (allocate-register-pair) + (allocate-register)))) + +(defun emit-move-to-variable (variable) + (flet ((emit-array-store (representation) + (emit (or (case representation + ((:int :boolean :char) + 'iastore) + (:long 'lastore) + (:float 'fastore) + (:double 'dastore)) + 'aastore)))) + (cond ((variable-register variable) + (emit (or (case (variable-representation variable) + ((:int :boolean :char) + 'istore) + (:long 'lstore) + (:float 'fstore) + (:double 'dstore)) + 'astore) + (variable-register variable))) + ((variable-index variable) + (aload (compiland-argument-register *current-compiland*)) + (emit-push-constant-int (variable-index variable)) + (emit-array-store (variable-representation variable))) + ((variable-closure-index variable) + (aload (compiland-closure-register *current-compiland*)) + (emit-push-constant-int (variable-closure-index variable)) + (emit-array-store (variable-representation variable))) + (t ;;###FIXME: We might want to address the "temp-register" case too. + (assert nil))))) + + (defknown p2-let-bindings (t) t) (defun p2-let-bindings (block) (dolist (variable (block-vars block)) @@ -4212,40 +4294,9 @@ (t (cond (initform (when (eq (variable-register variable) t) - (let ((declared-type (variable-declared-type variable))) - (cond ((neq declared-type :none) - (cond ((fixnum-type-p declared-type) - (setf (variable-representation variable) :int)) - ((java-long-type-p declared-type) - (setf (variable-representation variable) :long)))) - ((zerop (variable-writes variable)) - (let ((derived-type (derive-compiler-type initform))) - (setf (variable-derived-type variable) derived-type) - (cond ((fixnum-type-p derived-type) - (setf (variable-representation variable) :int)) - ((java-long-type-p derived-type) - (setf (variable-representation variable) :long))))) - ((get (variable-name variable) 'sys::dotimes-index-variable-p) - ;; DOTIMES index variable. - (let* ((name (get (variable-name variable) 'sys::dotimes-limit-variable-name)) - (limit-variable (and name - (or (find-variable name (block-vars block)) - (find-visible-variable name))))) - (when limit-variable - (let ((type (variable-derived-type limit-variable))) - (when (eq type :none) - (setf type (variable-declared-type limit-variable))) - (cond ((fixnum-type-p type) - (setf (variable-representation variable) :int -;; (variable-derived-type variable) 'FIXNUM - (variable-derived-type variable) type - )) - ((java-long-type-p type) - (setf (variable-representation variable) :long -;; (variable-derived-type variable) 'JAVA-LONG - (variable-derived-type variable) type - )))))))))) - (compile-form initform 'stack (variable-representation variable)) + (derive-variable-representation variable block)) + (compile-form initform 'stack + (variable-representation variable)) (unless must-clear-values (unless (single-valued-p initform) (setf must-clear-values t)))) @@ -4254,19 +4305,11 @@ (emit-push-nil))) (when (eq (variable-register variable) t) ;; Now allocate the register. - (setf (variable-register variable) - (case (variable-representation variable) - (:long - ;; We need two registers for a long. - (allocate-register-pair)) - (t - (allocate-register))))) + (allocate-variable-register variable)) (cond ((variable-special-p variable) (emit-move-from-stack (setf (variable-temp-register variable) (allocate-register)))) - ((eq (variable-representation variable) :int) - (emit 'istore (variable-register variable))) - ((eq (variable-representation variable) :long) - (emit 'lstore (variable-register variable))) + ((variable-representation variable) + (emit-move-to-variable variable)) (t (compile-binding variable))))))) (when must-clear-values @@ -4327,76 +4370,29 @@ (t (emit-push-nil)))) (t - (cond (unused-p - (compile-form initform nil nil) ; for effect - (update-must-clear-values) - (setf boundp t)) - ((and (null (variable-closure-index variable)) - (not (variable-special-p variable))) - (let ((declared-type (variable-declared-type variable))) - (cond ((and (neq declared-type :none) - (fixnum-type-p declared-type)) - (setf (variable-representation variable) :int) - (compile-form initform 'stack :int) - (update-must-clear-values) - (setf (variable-register variable) (allocate-register)) - (emit 'istore (variable-register variable)) - (setf boundp t)) - ((and (neq declared-type :none) - (java-long-type-p declared-type)) - (setf (variable-representation variable) :long) - (compile-form initform 'stack :long) - (update-must-clear-values) - (setf (variable-register variable) - ;; We need two registers for a long. - (allocate-register-pair)) - (emit 'lstore (variable-register variable)) - (setf boundp t)) - ((and (neq declared-type :none) - (eq declared-type 'BOOLEAN)) - (setf (variable-representation variable) :boolean) - (compile-form initform 'stack :boolean) - (update-must-clear-values) - (setf (variable-register variable) (allocate-register)) - (emit 'istore (variable-register variable)) - (setf boundp t)) - ((eql (variable-writes variable) 0) - (let ((type (derive-compiler-type initform))) - (setf (variable-derived-type variable) type) - (cond ((fixnum-type-p type) - (setf (variable-representation variable) :int) - (setf (variable-register variable) (allocate-register)) - (compile-form initform 'stack :int) - (update-must-clear-values) - (emit 'istore (variable-register variable)) - (setf boundp t)) - ((java-long-type-p type) - (setf (variable-representation variable) :long) - (setf (variable-register variable) - ;; We need two registers for a long. - (allocate-register-pair)) - (compile-form initform 'stack :long) - (update-must-clear-values) - (emit 'lstore (variable-register variable)) - (setf boundp t)) - ((eq type 'CHARACTER) - (setf (variable-representation variable) :char) - (setf (variable-register variable) (allocate-register)) - (compile-form initform 'stack :char) - (update-must-clear-values) - (emit 'istore (variable-register variable)) - (setf boundp t)) - (t - (compile-form initform 'stack nil) - (update-must-clear-values))))) - (t - (compile-form initform 'stack nil) - (update-must-clear-values))))) - (t - (compile-form initform 'stack nil) - (update-must-clear-values)))))) + (cond (unused-p + (compile-form initform nil nil) ; for effect + (update-must-clear-values) + (setf boundp t)) + ((and (null (variable-closure-index variable)) + (not (variable-special-p variable))) + (when (and (eq (variable-declared-type variable) :none) + (eql (variable-writes variable) 0)) + (setf (variable-derived-type variable) + (derive-compiler-type initform))) + (derive-variable-representation variable block) + (allocate-variable-register variable) + (compile-form initform 'stack + (variable-representation variable)) + (update-must-clear-values) + (emit-move-to-variable variable) + (setf boundp t)) + (t + (compile-form initform 'stack nil) + (update-must-clear-values)))))) (unless (or boundp (variable-special-p variable)) - (unless (or (variable-closure-index variable) (variable-register variable)) + (unless (or (variable-closure-index variable) + (variable-register variable)) (setf (variable-register variable) (allocate-register)))) (push variable *visible-variables*) (unless boundp From ehuelsmann at common-lisp.net Tue Feb 3 22:07:09 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Tue, 03 Feb 2009 22:07:09 +0000 Subject: [armedbear-cvs] r11620 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Tue Feb 3 22:07:06 2009 New Revision: 11620 Log: Kill long code repetitions in COMPILE-VAR-REF and P2-SETQ - making the resulting ones more generic. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Tue Feb 3 22:07:06 2009 @@ -411,6 +411,34 @@ (1.0d0 (emit 'dconst_1)) (t (emit 'ldc2_w (pool-double n))))) +(defknown emit-dup (symbol) t) +(defun emit-dup (representation) + (ecase (representation-size representation) + (1 (emit 'dup)) + (2 (emit 'dup2)))) + +(defknown emit-swap (symbol symbol) t) +(defun emit-swap (rep1 rep2) + "Swaps 2 values on the stack, +the top-most value's representation being 'rep1'." + (let ((r1-size (representation-size rep1)) + (r2-size (representation-size rep2))) + (cond ((and (= 1 r1-size) + (= 1 r2-size)) + (emit 'swap)) + ((and (= 1 r1-size) + (= 2 r2-size)) + (emit 'dup2_x1) + (emit 'pop2)) + ((and (= 2 r1-size) + (= 1 r2-size)) + (emit 'dup_x2) + (emit 'pop)) + ((and (= 2 r1-size) + (= 2 r2-size)) + (emit 'dup2_x2) + (emit 'pop2))))) + (declaim (ftype (function (t t) cons) make-descriptor-info)) (defun make-descriptor-info (arg-types return-type) (let ((descriptor (with-standard-io-syntax @@ -528,9 +556,29 @@ ((NIL :int :boolean :float :char) 1) ((:long :double) 2))) + +(defknown emit-unbox-boolean () t) +(defun emit-unbox-boolean () + (emit 'instanceof +lisp-nil-class+) + (emit 'iconst_1) + (emit 'ixor)) ;; 1 -> 0 && 0 -> 1: in other words, negate the low bit + +(defknown emit-unbox-character () t) +(defun emit-unbox-character () + (cond ((> *safety* 0) + (emit-invokestatic +lisp-character-class+ "getValue" + (lisp-object-arg-types 1) "C")) + (t + (emit 'checkcast +lisp-character-class+) + (emit 'getfield +lisp-character-class+ "value" "C")))) + ;; source type / ;; targets :boolean :char :int :long :float :double -(defvar rep-conversion '((:boolean . #( NIL :err :err :err :err :err)) +(defvar rep-conversion `((NIL . #( ,#'emit-unbox-boolean + ,#'emit-unbox-character + "intValue" "longValue" + "floatValue" "doubleValue")) + (:boolean . #( NIL :err :err :err :err :err)) (:char . #( 1 NIL :err :err :err :err)) (:int . #( 1 :err NIL i2l i2f i2d)) (:long . #( 1 :err l2i NIL l2f l2d)) @@ -576,11 +624,16 @@ (when op ;; Convert from one internal representation into another (assert (neq op :err)) - (if (eql op 1) - (progn - (emit-move-from-stack nil in) - (emit 'iconst_1)) - (emit op))))) + (cond ((eql op 1) + (emit-move-from-stack nil in) + (emit 'iconst_1)) + ((functionp op) + (funcall op)) + ((stringp op) + (emit-invokevirtual +lisp-object-class+ op nil + (cdr (assoc out rep-arg-chars)))) + (t + (emit op)))))) (defvar common-representations '((:int :long :long) (:int :float :double) @@ -858,15 +911,6 @@ (emit 'checkcast +lisp-fixnum-class+) (emit 'getfield +lisp-fixnum-class+ "value" "I")))) -(defknown emit-unbox-character () t) -(defun emit-unbox-character () - (cond ((> *safety* 0) - (emit-invokestatic +lisp-character-class+ "getValue" - (lisp-object-arg-types 1) "C")) - (t - (emit 'checkcast +lisp-character-class+) - (emit 'getfield +lisp-character-class+ "value" "C")))) - (defknown emit-unbox-long () t) (defun emit-unbox-long () (emit-invokestatic +lisp-bignum-class+ "longValue" @@ -892,12 +936,6 @@ (emit 'checkcast +lisp-double-float-class+) (emit 'getfield +lisp-double-float-class+ "value" "D")))) -(defknown emit-unbox-boolean () t) -(defun emit-unbox-boolean () - (emit 'instanceof +lisp-nil-class+) - (emit 'iconst_1) - (emit 'ixor)) ;; 1 -> 0 && 0 -> 1: in other words, negate the low bit - (defknown fix-boxing (t t) t) (defun fix-boxing (required-representation derived-type) "Generate code to convert a boxed LispObject on the stack to the specified @@ -4239,22 +4277,57 @@ (allocate-register)))) (defun emit-move-to-variable (variable) + (let ((representation (variable-representation variable))) + (flet ((emit-array-store (representation) + (emit (or (case representation + ((:int :boolean :char) + 'iastore) + (:long 'lastore) + (:float 'fastore) + (:double 'dastore)) + 'aastore)))) + (cond ((variable-register variable) + (emit (or (case (variable-representation variable) + ((:int :boolean :char) + 'istore) + (:long 'lstore) + (:float 'fstore) + (:double 'dstore)) + 'astore) + (variable-register variable))) + ((variable-index variable) + (aload (compiland-argument-register *current-compiland*)) + (emit-swap representation nil) + (emit-push-constant-int (variable-index variable)) + (emit-swap representation :int) + (emit-array-store (variable-representation variable))) + ((variable-closure-index variable) + (aload (compiland-closure-register *current-compiland*)) + (emit-swap representation nil) + (emit-push-constant-int (variable-closure-index variable)) + (emit-swap representation :int) + (emit-array-store (variable-representation variable))) + (t + ;;###FIXME: We might want to address the "temp-register" case too. + (assert nil)))))) + +(defun emit-push-variable (variable) (flet ((emit-array-store (representation) (emit (or (case representation ((:int :boolean :char) - 'iastore) - (:long 'lastore) - (:float 'fastore) - (:double 'dastore)) - 'aastore)))) + 'iaload) + (:long 'laload) + (:float 'faload) + (:double 'daload)) + 'aaload)))) (cond ((variable-register variable) (emit (or (case (variable-representation variable) ((:int :boolean :char) - 'istore) - (:long 'lstore) - (:float 'fstore) - (:double 'dstore)) - 'astore) + 'iload) + (:long 'lload) + (:float 'fload) + (:double 'dload)) + 'aload) (variable-register variable))) ((variable-index variable) (aload (compiland-argument-register *current-compiland*)) @@ -7536,44 +7609,13 @@ (let ((variable (var-ref-variable ref))) (cond ((variable-special-p variable) (compile-special-reference (variable-name variable) target representation)) - ((eq (variable-representation variable) :int) - (aver (variable-register variable)) - (emit 'iload (variable-register variable)) - (convert-representation :int representation) - (emit-move-from-stack target representation)) - ((eq (variable-representation variable) :char) - (aver (variable-register variable)) - (emit 'iload (variable-register variable)) - (convert-representation :char representation) - (emit-move-from-stack target representation)) - ((eq (variable-representation variable) :long) - (aver (variable-register variable)) - (emit 'lload (variable-register variable)) - (convert-representation :long representation) - (emit-move-from-stack target representation)) - ((eq (variable-representation variable) :boolean) - (aver (variable-register variable)) - (aver (or (null representation) (eq representation :boolean))) - (emit 'iload (variable-register variable)) - (convert-representation :boolean representation) - (emit-move-from-stack target representation)) - ((variable-register variable) - (aload (variable-register variable)) - (fix-boxing representation (variable-derived-type variable)) - (emit-move-from-stack target representation)) - ((variable-closure-index variable) - (aver (not (null (compiland-closure-register *current-compiland*)))) - (aload (compiland-closure-register *current-compiland*)) - (emit-push-constant-int (variable-closure-index variable)) - (emit 'aaload) - (fix-boxing representation (derive-type ref)) - (emit-move-from-stack target representation)) - ((variable-index variable) - (aver (not (null (compiland-argument-register *current-compiland*)))) - (aload (compiland-argument-register *current-compiland*)) - (emit-push-constant-int (variable-index variable)) - (emit 'aaload) - (fix-boxing representation (variable-derived-type variable)) + ((or (variable-representation variable) + (variable-register variable) + (variable-closure-index variable) + (variable-index variable)) + (emit-push-variable variable) + (convert-representation (variable-representation variable) + representation) (emit-move-from-stack target representation)) (t (sys::%format t "compile-var-ref general case~%") @@ -7700,53 +7742,16 @@ (when target (convert-representation :int representation) (emit-move-from-stack target representation))) - ((eq (variable-representation variable) :int) - (dformat t "p2-setq :int case value-form = ~S~%" - value-form) - (compile-forms-and-maybe-emit-clear-values value-form 'stack :int) - (when target - (emit 'dup)) - (emit 'istore (variable-register variable)) - (when target - ;; int on stack here - (convert-representation :int representation) - (emit-move-from-stack target representation))) - ((eq (variable-representation variable) :char) - (dformat t "p2-setq :char case~%") - (compile-forms-and-maybe-emit-clear-values value-form 'stack :char) - (when target - (emit 'dup)) - (emit 'istore (variable-register variable)) - (when target - ;; char on stack here - (convert-representation :char representation) - (emit-move-from-stack target representation))) - ((eq (variable-representation variable) :long) - (compile-forms-and-maybe-emit-clear-values value-form 'stack :long) - (when target - (emit 'dup2)) - (emit 'lstore (variable-register variable)) - (when target - ;; long on stack here - (convert-representation :long representation) - (emit-move-from-stack target representation))) - ((eq (variable-representation variable) :boolean) - (compile-forms-and-maybe-emit-clear-values value-form 'stack :boolean) - (when target - (emit 'dup)) - (emit 'istore (variable-register variable)) - (when target - ;; int on stack here - (convert-representation :boolean representation) - (emit-move-from-stack target representation))) (t - (compile-forms-and-maybe-emit-clear-values value-form 'stack nil) - (when target - (emit 'dup)) - (emit 'var-set variable) - (when target - (fix-boxing representation nil) - (emit-move-from-stack target representation)))))) + (let ((rep (variable-representation variable))) + (dformat t "p2-setq ~A case value-form = ~S~%" rep value-form) + (compile-forms-and-maybe-emit-clear-values value-form 'stack rep) + (when target + (emit-dup rep)) + (emit-move-to-variable variable) + (when target + (convert-representation rep representation) + (emit-move-from-stack target representation))))))) (defun p2-sxhash (form target representation) (cond ((check-arg-count form 1) From ehuelsmann at common-lisp.net Wed Feb 4 20:14:02 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Wed, 04 Feb 2009 20:14:02 +0000 Subject: [armedbear-cvs] r11621 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Wed Feb 4 20:13:59 2009 New Revision: 11621 Log: Implement P2-COMPILAND-UNBOX-VARIABLE in terms of new primitives. Replace the last occurrance of (EMIT 'VAR-SET ...) with (EMIT-MOVE-TO-VARIABLE ...); removes the need to 'RESOLVE-VARIABLES': eliminate it and the VAR-SET artificial opcode. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp trunk/abcl/src/org/armedbear/lisp/opcodes.lisp 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 Feb 4 20:13:59 2009 @@ -1473,36 +1473,6 @@ ;; (print-code)) max-stack))) -(defun resolve-variables () - (let ((code (nreverse *code*))) - (setf *code* nil) - (dolist (instruction code) - (case (instruction-opcode instruction) - (207 ; VAR-SET - (let ((variable (car (instruction-args instruction)))) - (aver (variable-p variable)) - (aver (not (variable-special-p variable))) - (cond ((variable-register variable) - (dformat t "register = ~S~%" (variable-register variable)) - (astore (variable-register variable))) - ((variable-closure-index variable) - (dformat t "closure-index = ~S~%" (variable-closure-index variable)) - (aver (not (null (compiland-closure-register *current-compiland*)))) - (aload (compiland-closure-register *current-compiland*)) - (emit 'swap) ; array value - (emit-push-constant-int (variable-closure-index variable)) - (emit 'swap) ; array index value - (emit 'aastore)) - (t - (dformat t "var-set fall-through case~%") - (aver (not (null (compiland-argument-register *current-compiland*)))) - (aload (compiland-argument-register *current-compiland*)) ; Stack: value array - (emit 'swap) ; array value - (emit-push-constant-int (variable-index variable)) ; array value index - (emit 'swap) ; array index value - (emit 'aastore))))) - (t - (push instruction *code*)))))) (defun finalize-code () (setf *code* (nreverse (coerce *code* 'vector)))) @@ -5034,7 +5004,7 @@ (emit-invokestatic +lisp-class+ "makeCompiledClosure" (list +lisp-object+ +lisp-object-array+) +lisp-object+))) - (emit 'var-set (local-function-variable local-function))) + (emit-move-to-variable (local-function-variable local-function))) (defmacro with-temp-class-file (pathname class-file lambda-list &body body) `(let* ((,pathname (make-temp-file)) @@ -8348,24 +8318,12 @@ (not (variable-special-p variable)) (not (variable-used-non-locally-p variable)) (zerop (compiland-children *current-compiland*))) - (let ((type (variable-declared-type variable))) - (cond ((fixnum-type-p type) - (aload register) - (emit-unbox-fixnum) - (emit 'istore register) - (setf (variable-representation variable) :int)) - ((java-long-type-p type) - (let ((new-register (allocate-register-pair))) - (aload register) - (emit-invokevirtual +lisp-object-class+ "longValue" nil "J") - (emit 'lstore new-register) - (setf (variable-register variable) new-register) - (setf (variable-representation variable) :long))) - ((eq type 'CHARACTER) - (aload register) - (emit-unbox-character) - (emit 'istore register) - (setf (variable-representation variable) :char)))))) + (emit-push-variable variable) + (derive-variable-representation variable nil) ;; nil == no block + (when (< 1 (representation-size (variable-representation variable))) + (allocate-variable-register variable)) + (convert-representation nil (variable-representation variable)) + (emit-move-to-variable variable))) t) (defknown p2-compiland (t) t) @@ -8602,8 +8560,6 @@ (emit 'areturn) - (resolve-variables) - ;; Warn if any unused args. (Is this the right place?) (check-for-unused-variables (compiland-arg-vars compiland)) Modified: trunk/abcl/src/org/armedbear/lisp/opcodes.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/opcodes.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/opcodes.lisp Wed Feb 4 20:13:59 2009 @@ -259,9 +259,8 @@ ;; (define-opcode store-value 204 nil -1) (define-opcode clear-values 205 0 0) ;;(define-opcode var-ref 206 0 0) -(define-opcode var-set 207 0 0) -(defparameter *last-opcode* 207) +(defparameter *last-opcode* 206) (declaim (ftype (function (t) t) opcode-name)) (defun opcode-name (opcode-number) From ehuelsmann at common-lisp.net Wed Feb 4 21:07:47 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Wed, 04 Feb 2009 21:07:47 +0000 Subject: [armedbear-cvs] r11622 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Wed Feb 4 21:07:44 2009 New Revision: 11622 Log: Eliminate NEW-FIXNUM and EMIT-FIXNUM-INIT in favor of CONVERT-REPRESENTATION. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Feb 4 21:07:44 2009 @@ -2160,11 +2160,6 @@ (setf *static-code* *code*) (setf (gethash local-function ht) g)))) -(defun new-fixnum (&optional (test-val t)) - (when test-val - (emit 'new +lisp-fixnum-class+) - (emit 'dup))) - (defknown declare-fixnum (fixnum) string) (defun declare-fixnum (n) (declare (type fixnum n)) @@ -2180,9 +2175,8 @@ (emit-push-constant-int n) (emit 'aaload)) (t - (new-fixnum) (emit-push-constant-int n) - (emit-invokespecial-init +lisp-fixnum-class+ '("I")))) + (convert-representation :int nil))) (emit 'putstatic *this-class* g +lisp-fixnum+) (setf *static-code* *code*) (setf (gethash n ht) g)))) @@ -5231,14 +5225,6 @@ (t (compiler-unsupported "p2-function: unsupported case: ~S" form))))) -(defun emit-fixnum-init (representation) - (case representation - (:int) - (:long - (emit 'i2l)) - (t - (emit-invokespecial-init +lisp-fixnum-class+ '("I"))))) - (defknown p2-ash (t t t) t) (define-inlined-function p2-ash (form target representation) ((check-arg-count form 2)) @@ -5262,7 +5248,6 @@ (<= -31 constant-shift 31) (fixnum-type-p type1) (fixnum-type-p result-type)) - (new-fixnum (null representation)) (compile-form arg1 'stack :int) (cond ((plusp constant-shift) (compile-form arg2 'stack :int) @@ -5278,7 +5263,7 @@ (emit 'ishr)) ((zerop constant-shift) (compile-form arg2 nil nil))) ; for effect - (emit-fixnum-init representation) + (convert-representation :int representation) (emit-move-from-stack target representation)) ((and constant-shift ;; lshl/lshr only use the low six bits of the mask. @@ -5304,12 +5289,11 @@ (emit-move-from-stack target representation)) ((and (fixnum-type-p type1) low2 high2 (<= -31 low2 high2 0)) ; Negative shift. - (new-fixnum (null representation)) (compile-forms-and-maybe-emit-clear-values arg1 'stack :int arg2 'stack :int) (emit 'ineg) (emit 'ishr) - (emit-fixnum-init representation) + (convert-representation :int representation) (emit-move-from-stack target representation)) ((fixnum-type-p type2) (cond ((and low2 high2 (<= 0 low2 high2 63) ; Non-negative shift. @@ -5374,22 +5358,20 @@ ((and (fixnum-type-p type1) (fixnum-type-p type2)) ;; (format t "p2-logand fixnum case~%") ;; Both arguments are fixnums. - (new-fixnum (null representation)) (compile-forms-and-maybe-emit-clear-values arg1 'stack :int arg2 'stack :int) (emit 'iand) - (emit-fixnum-init representation) + (convert-representation :int representation) (emit-move-from-stack target representation)) ((or (and (fixnum-type-p type1) (compiler-subtypep type1 'unsigned-byte)) (and (fixnum-type-p type2) (compiler-subtypep type2 'unsigned-byte))) ;; One of the arguments is a positive fixnum. - (new-fixnum (null representation)) (compile-forms-and-maybe-emit-clear-values arg1 'stack :int arg2 'stack :int) (emit 'iand) - (emit-fixnum-init representation) + (convert-representation :int representation) (emit-move-from-stack target representation)) ((and (java-long-type-p type1) (java-long-type-p type2)) ;; Both arguments are longs. @@ -5465,11 +5447,10 @@ (fixnum-constant-value type2)) target representation)) ((and (fixnum-type-p type1) (fixnum-type-p type2)) - (new-fixnum (null representation)) (compile-forms-and-maybe-emit-clear-values arg1 'stack :int arg2 'stack :int) (emit 'ior) - (emit-fixnum-init representation) + (convert-representation :int representation) (emit-move-from-stack target representation)) ((and (eql (fixnum-constant-value type1) 0) (< *safety* 3)) (compile-forms-and-maybe-emit-clear-values arg1 nil nil @@ -5540,11 +5521,10 @@ (emit 'ixor)) ((and (fixnum-type-p type1) (fixnum-type-p type2)) ;; (format t "p2-logxor case 2~%") - (new-fixnum (null representation)) (compile-forms-and-maybe-emit-clear-values arg1 'stack :int arg2 'stack :int) (emit 'ixor) - (emit-fixnum-init representation)) + (convert-representation :int representation)) ((and (java-long-type-p type1) (java-long-type-p type2)) (compile-forms-and-maybe-emit-clear-values arg1 'stack :long arg2 'stack :long) @@ -5572,11 +5552,10 @@ ((check-arg-count form 1)) (cond ((and (fixnum-type-p (derive-compiler-type form))) (let ((arg (%cadr form))) - (new-fixnum (null representation)) (compile-forms-and-maybe-emit-clear-values arg 'stack :int) (emit 'iconst_m1) (emit 'ixor) - (emit-fixnum-init representation) + (convert-representation :int representation) (emit-move-from-stack target representation))) (t (let ((arg (%cadr form))) @@ -5607,7 +5586,6 @@ (compile-constant 0 target representation)) ((and size position) (cond ((<= (+ position size) 31) - (new-fixnum (null representation)) (compile-forms-and-maybe-emit-clear-values size-arg nil nil position-arg nil nil arg3 'stack :int) @@ -5616,10 +5594,9 @@ (emit 'ishr)) (emit-push-constant-int (1- (expt 2 size))) ; mask (emit 'iand) - (emit-fixnum-init representation) + (convert-representation :int representation) (emit-move-from-stack target representation)) ((<= (+ position size) 63) - (new-fixnum (and (null representation) (<= size 31))) (compile-forms-and-maybe-emit-clear-values size-arg nil nil position-arg nil nil arg3 'stack :long) @@ -5630,7 +5607,7 @@ (emit 'l2i) (emit-push-constant-int (1- (expt 2 size))) (emit 'iand) - (emit-fixnum-init representation)) + (convert-representation :int representation)) (t (emit-push-constant-long (1- (expt 2 size))) ; mask (emit 'land) @@ -6825,29 +6802,28 @@ (let ((type1 (derive-compiler-type arg1)) (type2 (derive-compiler-type arg2))) (cond ((and (fixnum-type-p type1) (fixnum-type-p type2)) - (new-fixnum (null representation)) - (compile-form arg1 'stack :int) - (emit 'dup) - (compile-form arg2 'stack :int) + (compile-form arg1 'stack :int) + (emit 'dup) + (compile-form arg2 'stack :int) (emit 'dup_x1) (let ((LABEL1 (gensym))) (emit (if (eq op 'max) 'if_icmpge 'if_icmple) LABEL1) (emit 'swap) ;; The lower stack value is greater-or-equal - (label LABEL1) + (label LABEL1) (emit 'pop)) ;; Throw away the lower stack value - (emit-fixnum-init representation) + (convert-representation :int representation) (emit-move-from-stack target representation)) ((and (java-long-type-p type1) (java-long-type-p type2)) - (compile-form arg1 'stack :long) - (emit 'dup2) - (compile-form arg2 'stack :long) + (compile-form arg1 'stack :long) + (emit 'dup2) + (compile-form arg2 'stack :long) (emit 'dup2_x2) - (emit 'lcmp) + (emit 'lcmp) (let ((LABEL1 (gensym))) (emit (if (eq op 'max) 'ifge 'ifle) LABEL1) (emit 'dup2_x2) ;; pour-mans swap2 (emit 'pop2) - (label LABEL1) + (label LABEL1) (emit 'pop2)) (convert-representation :long representation) (emit-move-from-stack target representation)) @@ -7090,12 +7066,8 @@ (maybe-emit-clear-values arg1 arg2 arg3) (emit-invokevirtual class "setCharAt" '("I" "C") nil) (when target - (new-fixnum (null representation)) (emit 'iload value-register) - (case representation - (:char) - (t - (emit-invokespecial-init +lisp-fixnum-class+ '("I")))) + (convert-representation :char representation) (emit-move-from-stack target representation)))) (t ;; (format t "p2-set-char/schar not optimized~%") @@ -7270,9 +7242,8 @@ (emit-invokevirtual +lisp-object-class+ "aset" (list "I" +lisp-object+) nil))) (when value-register (cond ((fixnum-type-p type3) - (new-fixnum (null representation)) (emit 'iload value-register) - (emit-fixnum-init representation)) + (convert-representation :int representation)) (t (aload value-register) (fix-boxing representation type3))) @@ -7726,13 +7697,9 @@ (defun p2-sxhash (form target representation) (cond ((check-arg-count form 1) (let ((arg (%cadr form))) - (unless (eq representation :int) - (new-fixnum)) (compile-forms-and-maybe-emit-clear-values arg 'stack nil) (emit-invokevirtual +lisp-object-class+ "sxhash" nil "I") - (unless (eq representation :int) - (emit-invokespecial-init +lisp-fixnum-class+ '("I")) - (fix-boxing representation 'fixnum)) + (convert-representation :int representation) (emit-move-from-stack target representation))) (t (compile-function-call form target representation)))) @@ -7846,9 +7813,10 @@ (compile-constant (char-code arg) target representation)) ((and (< *safety* 3) (eq (derive-compiler-type arg) 'character)) - (new-fixnum (null representation)) (compile-form arg 'stack :char) - (emit-fixnum-init representation) + ;; we change the representation between the above and here + ;; ON PURPOSE! + (convert-representation :int representation) (emit-move-from-stack target representation)) (t (compile-function-call form target representation))))) @@ -8318,12 +8286,16 @@ (not (variable-special-p variable)) (not (variable-used-non-locally-p variable)) (zerop (compiland-children *current-compiland*))) - (emit-push-variable variable) - (derive-variable-representation variable nil) ;; nil == no block - (when (< 1 (representation-size (variable-representation variable))) - (allocate-variable-register variable)) - (convert-representation nil (variable-representation variable)) - (emit-move-to-variable variable))) + (when (memq (type-representation (variable-declared-type variable)) + '(:int :long)) + (emit-push-variable variable) +;; (sys::%format t "declared type: ~S~%" (variable-declared-type variable)) + (derive-variable-representation variable nil) +;; (sys::%format t "representation: ~S~%" (variable-representation variable)) + (when (< 1 (representation-size (variable-representation variable))) + (allocate-variable-register variable)) + (convert-representation nil (variable-representation variable)) + (emit-move-to-variable variable)))) t) (defknown p2-compiland (t) t) From astalla at common-lisp.net Wed Feb 4 21:58:28 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Wed, 04 Feb 2009 21:58:28 +0000 Subject: [armedbear-cvs] r11623 - in trunk/abcl: examples/abcl/jsr-223 src/org/armedbear/lisp/scripting src/org/armedbear/lisp/scripting/lisp Message-ID: Author: astalla Date: Wed Feb 4 21:58:25 2009 New Revision: 11623 Log: Perfectioned ABCL auto-configuration when using JSR-223; added option to compile scripts using temp files (default) or using the run-time compiler; added example of usage of ABCL with JSR-223. Added: trunk/abcl/examples/abcl/jsr-223/ trunk/abcl/examples/abcl/jsr-223/JSR223Example.java Modified: trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp Added: trunk/abcl/examples/abcl/jsr-223/JSR223Example.java ============================================================================== --- (empty file) +++ trunk/abcl/examples/abcl/jsr-223/JSR223Example.java Wed Feb 4 21:58:25 2009 @@ -0,0 +1,58 @@ +import javax.script.*; + +public class JSR223Example { + + public static void main(String[] args) { + //Script Engine instantiation + ScriptEngine lispEngine = new ScriptEngineManager().getEngineByExtension("lisp"); + + //Accessing variables + System.out.println(); + System.out.println("*package* = " + lispEngine.get("*package*")); + Object someValue = new Object(); + lispEngine.put("someVariable", someValue); + System.out.println("someVariable = " + lispEngine.get("someVariable")); + try { + //Interpretation (also from streams) + lispEngine.eval("(defun hello (arg) (print (list arg someVariable)) (terpri))"); + + //Direct function invocation + ((Invocable) lispEngine).invokeFunction("hello", "world"); + + //Implementing a Java interface in Lisp + lispEngine.eval("(defun compare-to (&rest args) 42)"); + Comparable c = ((Invocable) lispEngine).getInterface(java.lang.Comparable.class); + System.out.println("compareTo: " + c.compareTo(null)); + + //Compilation! + lispEngine.eval("(defmacro slow-compiling-macro (arg) (dotimes (i 1000000) (incf i)) `(print ,arg))"); + + long millis = System.currentTimeMillis(); + lispEngine.eval("(slow-compiling-macro 42)"); + millis = System.currentTimeMillis() - millis; + System.out.println("interpretation took " + millis); + + millis = System.currentTimeMillis(); + CompiledScript cs = ((Compilable) lispEngine).compile("(slow-compiling-macro 42)"); + millis = System.currentTimeMillis() - millis; + System.out.println("compilation took " + millis); + + millis = System.currentTimeMillis(); + cs.eval(); + millis = System.currentTimeMillis() - millis; + System.out.println("evaluation took " + millis); + + millis = System.currentTimeMillis(); + cs.eval(); + millis = System.currentTimeMillis() - millis; + System.out.println("evaluation took " + millis); + + //Ecc. ecc. + } catch (NoSuchMethodException e) { + e.printStackTrace(); + } catch (ScriptException e) { + e.printStackTrace(); + } + } + +} 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 Feb 4 21:58:25 2009 @@ -43,18 +43,6 @@ private Function evalScript; private Function compileScript; private Function evalCompiledScript; - private boolean configured = false; - - public AbclScriptEngine(boolean enableThrowingDebugger) { - this(); - if (enableThrowingDebugger) { - try { - installThrowingDebuggerHook(LispThread.currentThread()); - } catch (ConditionThrowable e) { - throw new InternalError("Can't set throwing debugger hook!"); - } - } - } public AbclScriptEngine() { interpreter = Interpreter.createInstance(); @@ -76,11 +64,7 @@ throw new RuntimeException(e); } } - - public boolean isConfigured() { - return configured; - } - + public Interpreter getInterpreter() { return interpreter; } 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 Feb 4 21:58:25 2009 @@ -28,7 +28,7 @@ public class AbclScriptEngineFactory implements ScriptEngineFactory { - private static final AbclScriptEngine THE_ONLY_ONE_ENGINE = new AbclScriptEngine(true); + private static final AbclScriptEngine THE_ONLY_ONE_ENGINE = new AbclScriptEngine(); @Override public String getEngineName() { Modified: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp Wed Feb 4 21:58:25 2009 @@ -95,13 +95,28 @@ `((funcall ,function)))) (defun compile-script (code-string) - (eval - `(compile - nil - (lambda () - ,@(let ((*package* (find-package :abcl-script-user))) - (read-from-string (concatenate 'string "(" code-string ")"))))))) - + (if *compile-using-temp-files* + (let* ((tmp-file (jstatic (jmethod "java.io.File" "createTempFile" "java.lang.String" "java.lang.String") + nil "abcl-src-file-" ".lisp")) + (tmp-file-path (jcall (jmethod "java.io.File" "getAbsolutePath") tmp-file))) + (jcall (jmethod "java.io.File" "deleteOnExit") tmp-file) ;to be really-really-really sure... + (unwind-protect + (progn + (with-open-file (stream tmp-file-path :direction :output :if-exists :overwrite) + (prin1 code-string stream) + (finish-output stream)) + (let ((compiled-file (compile-file tmp-file-path))) + (jcall (jmethod "java.io.File" "deleteOnExit") + (jnew (jconstructor "java.io.File" "java.lang.String") + (namestring compiled-file))) + (lambda () (load compiled-file)))) + (delete-file tmp-file-path))) + (eval + `(compile + nil + (lambda () + ,@(let ((*package* (find-package :abcl-script-user))) + (read-from-string (concatenate 'string "(" code-string ")")))))))) ;;Java interface implementation Modified: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp Wed Feb 4 21:58:25 2009 @@ -31,7 +31,7 @@ (in-package :abcl-script) -(defparameter *abcl-debug* nil) +(defparameter *launch-swank-at-startup* nil) (defparameter *swank-dir* nil) @@ -39,7 +39,9 @@ (defparameter *use-throwing-debugger* t) -(defparameter *compile-using-temp-files* nil) +(defparameter *compile-using-temp-files* t) + +;(defparameter *compiler-temp-dir* #P".abcl.d/tmp/") (defconstant +standard-debugger-hook+ *debugger-hook*) @@ -48,7 +50,7 @@ (if *use-throwing-debugger* #'sys::%debugger-hook-function +standard-debugger-hook+)) - (when *abcl-debug* + (when *launch-swank-at-startup* (unless *swank-dir* (error "Swank directory not specified, please set *swank-dir*")) (pushnew *swank-dir* asdf:*central-registry* :test #'equal) @@ -57,4 +59,4 @@ (symbol-name '#:create-server) :swank) :port *swank-port*)) - :name "ABCL script - Swank thread"))) \ No newline at end of file + :name "ABCL script - Swank thread"))) From ehuelsmann at common-lisp.net Wed Feb 4 22:22:31 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Wed, 04 Feb 2009 22:22:31 +0000 Subject: [armedbear-cvs] r11624 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Wed Feb 4 22:22:29 2009 New Revision: 11624 Log: Wider use of CONVERT-REPRESENTATION shows an issue: LispInteger.getInstance() returns a LispInteger. Store Fixnum and Bignum values in fields of type LispInteger to resolve it. Additionally, simplify DECLARE-BIGNUM. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Feb 4 22:22:29 2009 @@ -1892,7 +1892,8 @@ (emit-push-nil))) (defun make-constructor (super lambda-name args) - (let* ((*compiler-debug* nil) ; We don't normally need to see debugging output for constructors. + (let* ((*compiler-debug* nil) + ;; We don't normally need to see debugging output for constructors. (constructor (make-method :name "" :descriptor "()V")) (*code* ()) @@ -2169,7 +2170,7 @@ (setf g (format nil "FIXNUM_~A~D" (if (minusp n) "MINUS_" "") (abs n))) - (declare-field g +lisp-fixnum+) + (declare-field g +lisp-integer+) (cond ((<= 0 n 255) (emit 'getstatic +lisp-fixnum-class+ "constants" +lisp-fixnum-array+) (emit-push-constant-int n) @@ -2177,7 +2178,7 @@ (t (emit-push-constant-int n) (convert-representation :int nil))) - (emit 'putstatic *this-class* g +lisp-fixnum+) + (emit 'putstatic *this-class* g +lisp-integer+) (setf *static-code* *code*) (setf (gethash n ht) g)))) @@ -2185,31 +2186,26 @@ (defun declare-bignum (n) (declare-with-hashtable n *declared-integers* ht g - (cond ((<= most-negative-java-long n most-positive-java-long) - (let ((*code* *static-code*)) - (setf g (format nil "BIGNUM_~A~D" - (if (minusp n) "MINUS_" "") - (abs n))) - (declare-field g +lisp-bignum+) - (emit 'new +lisp-bignum-class+) - (emit 'dup) + (setf g (concatenate 'string "BIGNUM_" (symbol-name (gensym)))) + (let ((*code* *static-code*)) + (declare-field g +lisp-integer+) + (emit 'new +lisp-bignum-class+) + (emit 'dup) + (cond ((<= most-negative-java-long n most-positive-java-long) +;; (setf g (format nil "BIGNUM_~A~D" +;; (if (minusp n) "MINUS_" "") +;; (abs n))) (emit 'ldc2_w (pool-long n)) - (emit-invokespecial-init +lisp-bignum-class+ '("J")) - (emit 'putstatic *this-class* g +lisp-bignum+) - (setf *static-code* *code*))) + (emit-invokespecial-init +lisp-bignum-class+ '("J"))) (t (let* ((*print-base* 10) - (s (with-output-to-string (stream) (dump-form n stream))) - (*code* *static-code*)) - (setf g (concatenate 'string "BIGNUM_" (symbol-name (gensym)))) - (declare-field g +lisp-bignum+) - (emit 'new +lisp-bignum-class+) - (emit 'dup) + (s (with-output-to-string (stream) (dump-form n stream)))) (emit 'ldc (pool-string s)) (emit-push-constant-int 10) - (emit-invokespecial-init +lisp-bignum-class+ (list +java-string+ "I")) - (emit 'putstatic *this-class* g +lisp-bignum+) - (setf *static-code* *code*)))) + (emit-invokespecial-init +lisp-bignum-class+ + (list +java-string+ "I"))))) + (emit 'putstatic *this-class* g +lisp-integer+) + (setf *static-code* *code*)) (setf (gethash n ht) g))) (defknown declare-float (single-float) string) @@ -2375,7 +2371,7 @@ (cond ((fixnump form) (emit-push-constant-int form)) ((integerp form) - (emit 'getstatic *this-class* (declare-bignum form) +lisp-bignum+) + (emit 'getstatic *this-class* (declare-bignum form) +lisp-integer+) (emit-invokevirtual +lisp-object-class+ "intValue" nil "I")) (t (sys::%format t "compile-constant int representation~%") @@ -2386,7 +2382,7 @@ (cond ((<= most-negative-java-long form most-positive-java-long) (emit-push-constant-long form)) ((integerp form) - (emit 'getstatic *this-class* (declare-bignum form) +lisp-bignum+) + (emit 'getstatic *this-class* (declare-bignum form) +lisp-integer+) (emit-invokevirtual +lisp-object-class+ "longValue" nil "J")) (t (sys::%format t "compile-constant long representation~%") @@ -2438,10 +2434,11 @@ (-1 "MINUS_ONE")))) (if translation (emit 'getstatic +lisp-fixnum-class+ translation +lisp-fixnum+) - (emit 'getstatic *this-class* (declare-fixnum form) +lisp-fixnum+)))) + (emit 'getstatic *this-class* (declare-fixnum form) + +lisp-integer+)))) ((integerp form) ;; A bignum. - (emit 'getstatic *this-class* (declare-bignum form) +lisp-bignum+)) + (emit 'getstatic *this-class* (declare-bignum form) +lisp-integer+)) ((typep form 'single-float) (emit 'getstatic *this-class* (declare-float form) +lisp-single-float+)) From ehuelsmann at common-lisp.net Thu Feb 5 08:46:09 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Thu, 05 Feb 2009 08:46:09 +0000 Subject: [armedbear-cvs] r11625 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Feb 5 08:46:06 2009 New Revision: 11625 Log: Fix COERCE.20 (a regression since 0.12). Modified: trunk/abcl/src/org/armedbear/lisp/format.lisp Modified: trunk/abcl/src/org/armedbear/lisp/format.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/format.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/format.lisp Thu Feb 5 08:46:06 2009 @@ -255,6 +255,7 @@ (eval-when (:compile-toplevel :execute) ;; the code below needs to its floats to be read as long-floats + (defvar *saved-default-float-format* *read-default-float-format*) (setf *read-default-float-format* 'double-float)) (defun scale-exponent (original-x) @@ -2872,4 +2873,9 @@ (setf sys::*simple-format-function* #'format) +(eval-when (:compile-toplevel :execute) + ;; the code below needs to its floats to be read as long-floats + (setf *read-default-float-format* *saved-default-float-format*)) + + (provide 'format) From ehuelsmann at common-lisp.net Thu Feb 5 19:40:16 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Thu, 05 Feb 2009 19:40:16 +0000 Subject: [armedbear-cvs] r11626 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Feb 5 19:40:13 2009 New Revision: 11626 Log: Final and last fix for COERCE.20 and the issue with printing double floats. Modified: trunk/abcl/src/org/armedbear/lisp/format.lisp Modified: trunk/abcl/src/org/armedbear/lisp/format.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/format.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/format.lisp Thu Feb 5 19:40:13 2009 @@ -253,33 +253,28 @@ (concatenate 'string (subseq s 0 index) "." (subseq s index)))))) -(eval-when (:compile-toplevel :execute) - ;; the code below needs to its floats to be read as long-floats - (defvar *saved-default-float-format* *read-default-float-format*) - (setf *read-default-float-format* 'double-float)) - (defun scale-exponent (original-x) (let* ((x (coerce original-x 'long-float))) (multiple-value-bind (sig exponent) (decode-float x) (declare (ignore sig)) - (if (= x 0.0e0) - (values (float 0.0e0 original-x) 1) + (if (= x 0.0l0) + (values (float 0.0l0 original-x) 1) (let* ((ex (locally (declare (optimize (safety 0))) (the fixnum - (round (* exponent (log 2e0 10)))))) + (round (* exponent (log 2l0 10)))))) (x (if (minusp ex) (if (float-denormalized-p x) - (* x 1.0e16 (expt 10.0e0 (- (- ex) 16))) - (* x 10.0e0 (expt 10.0e0 (- (- ex) 1)))) - (/ x 10.0e0 (expt 10.0e0 (1- ex)))))) - (do ((d 10.0e0 (* d 10.0e0)) + (* x 1.0l16 (expt 10.0l0 (- (- ex) 16))) + (* x 10.0l0 (expt 10.0l0 (- (- ex) 1)))) + (/ x 10.0l0 (expt 10.0l0 (1- ex)))))) + (do ((d 10.0l0 (* d 10.0l0)) (y x (/ x d)) (ex ex (1+ ex))) - ((< y 1.0e0) - (do ((m 10.0e0 (* m 10.0e0)) + ((< y 1.0l0) + (do ((m 10.0l0 (* m 10.0l0)) (z y (* y m)) (ex ex (1- ex))) - ((>= z 0.1e0) + ((>= z 0.1l0) (values (float z original-x) ex)) (declare (long-float m) (integer ex)))) (declare (long-float d)))))))) @@ -2873,9 +2868,5 @@ (setf sys::*simple-format-function* #'format) -(eval-when (:compile-toplevel :execute) - ;; the code below needs to its floats to be read as long-floats - (setf *read-default-float-format* *saved-default-float-format*)) - (provide 'format) From ehuelsmann at common-lisp.net Thu Feb 5 20:13:28 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Thu, 05 Feb 2009 20:13:28 +0000 Subject: [armedbear-cvs] r11627 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Feb 5 20:13:27 2009 New Revision: 11627 Log: Make TRACE protect *TRACE-DEPTH* from non-local returns (such as RETURN to TOP-LEVEL restarts). Also make TRACE no longer invoke CLOS (and thus the compiler, making it possible to trace the compiler now, instead of getting a stack overflow.) Modified: trunk/abcl/src/org/armedbear/lisp/trace.lisp Modified: trunk/abcl/src/org/armedbear/lisp/trace.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/trace.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/trace.lisp Thu Feb 5 20:13:27 2009 @@ -35,14 +35,14 @@ (require "FORMAT") -(require "CLOS") +;;(require "CLOS") (defvar *trace-info-hashtable* (make-hash-table :test #'equal)) (defstruct trace-info name untraced-function breakp) -(defmethod make-load-form ((object trace-info) &optional environment) - (make-load-form-saving-slots object :environment environment)) +;;(defmethod make-load-form ((object trace-info) &optional environment) +;; (make-load-form-saving-slots object :environment environment)) (defvar *trace-depth* 0) @@ -89,21 +89,23 @@ (with-standard-io-syntax (let ((*print-readably* nil) (*print-structure* nil)) - (format *trace-output* (indent "~D: ~S~%") *trace-depth* + (%format *trace-output* (indent "~D: ~S~%") *trace-depth* (cons name args)))) (when breakp (break)) (incf *trace-depth*) - (let ((results (multiple-value-list (apply untraced-function args)))) - (decf *trace-depth*) + (let ((results (multiple-value-list + (unwind-protect + (apply untraced-function args) + (decf *trace-depth*))))) (with-standard-io-syntax (let ((*print-readably* nil) (*print-structure* nil)) - (format *trace-output* (indent "~D: ~A returned") *trace-depth* name) + (%format *trace-output* (indent "~D: ~A returned") *trace-depth* name) (if results (dolist (result results) - (format *trace-output* " ~S" result)) - (format *trace-output* " no values")) + (%format *trace-output* " ~S" result)) + (%format *trace-output* " no values")) (terpri *trace-output*))) (values-list results))))) From ehuelsmann at common-lisp.net Thu Feb 5 20:14:11 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Thu, 05 Feb 2009 20:14:11 +0000 Subject: [armedbear-cvs] r11628 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Feb 5 20:14:10 2009 New Revision: 11628 Log: Remove commented-out lines. Modified: trunk/abcl/src/org/armedbear/lisp/trace.lisp Modified: trunk/abcl/src/org/armedbear/lisp/trace.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/trace.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/trace.lisp Thu Feb 5 20:14:10 2009 @@ -35,15 +35,10 @@ (require "FORMAT") -;;(require "CLOS") - (defvar *trace-info-hashtable* (make-hash-table :test #'equal)) (defstruct trace-info name untraced-function breakp) -;;(defmethod make-load-form ((object trace-info) &optional environment) -;; (make-load-form-saving-slots object :environment environment)) - (defvar *trace-depth* 0) (defun list-traced-functions () From astalla at common-lisp.net Thu Feb 5 21:22:04 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Thu, 05 Feb 2009 21:22:04 +0000 Subject: [armedbear-cvs] r11629 - in trunk/abcl/src/org/armedbear/lisp/scripting: . lisp Message-ID: Author: astalla Date: Thu Feb 5 21:22:03 2009 New Revision: 11629 Log: fixed exported symbol list for package :abcl-script. Modified: trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp trunk/abcl/src/org/armedbear/lisp/scripting/lisp/packages.lisp 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 Thu Feb 5 21:22:03 2009 @@ -57,6 +57,7 @@ loadFromClasspath("/abcl-script-config.lisp"); } interpreter.eval("(abcl-script:configure-abcl)"); + System.out.println("ABCL: configured"); evalScript = (Function) this.findSymbol("EVAL-SCRIPT", "ABCL-SCRIPT").getSymbolFunction(); compileScript = (Function) this.findSymbol("COMPILE-SCRIPT", "ABCL-SCRIPT").getSymbolFunction(); evalCompiledScript = (Function) this.findSymbol("EVAL-COMPILED-SCRIPT", "ABCL-SCRIPT").getSymbolFunction(); Modified: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp Thu Feb 5 21:22:03 2009 @@ -41,8 +41,6 @@ (defparameter *compile-using-temp-files* t) -;(defparameter *compiler-temp-dir* #P".abcl.d/tmp/") - (defconstant +standard-debugger-hook+ *debugger-hook*) (defun configure-abcl () Modified: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/packages.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/scripting/lisp/packages.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/scripting/lisp/packages.lisp Thu Feb 5 21:22:03 2009 @@ -31,7 +31,6 @@ (defpackage :abcl-script (:use :cl :java) (:export - #:*abcl-debug* #:eval-script #:compile-script #:*compile-using-temp-files* @@ -39,6 +38,7 @@ #:eval-compiled-script #:define-java-interface-implementation #:find-java-interface-implementation + #:*launch-swank-at-startup* #:register-java-interface-implementation #:remove-java-interface-implementation #:+standard-debugger-hook+ From ehuelsmann at common-lisp.net Thu Feb 5 21:39:13 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Thu, 05 Feb 2009 21:39:13 +0000 Subject: [armedbear-cvs] r11630 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Feb 5 21:39:12 2009 New Revision: 11630 Log: Optimize (and fix) CONVERT-REPRESENTATION for the case of 2 eql arguments (fixes CONVERT-REPRESENTATION for the (NIL NIL) argument case). Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Thu Feb 5 21:39:12 2009 @@ -610,6 +610,9 @@ (defun convert-representation (in out) "Converts the value on the stack in the `in' representation to a value on the stack in the `out' representation." + (when (eql in out) + ;; no-op + (return-from convert-representation)) (when (null out) ;; Convert back to a lisp object (when in From ehuelsmann at common-lisp.net Thu Feb 5 21:44:28 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Thu, 05 Feb 2009 21:44:28 +0000 Subject: [armedbear-cvs] r11631 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Feb 5 21:44:27 2009 New Revision: 11631 Log: Fix DERIVE-VARIABLE-REPRESENTATION in case the LIMIT-VARIABLE resolves to NIL (as happens to be the case in DOTIMES.25). Follow up to r11619. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Thu Feb 5 21:44:27 2009 @@ -4230,9 +4230,10 @@ (or (find-variable name (block-vars block)) (find-visible-variable name))))) - (derive-variable-representation limit-variable block) - (setf (variable-representation variable) - (variable-representation limit-variable))))))) + (when limit-variable + (derive-variable-representation limit-variable block) + (setf (variable-representation variable) + (variable-representation limit-variable)))))))) (defun allocate-variable-register (variable) (setf (variable-register variable) From ehuelsmann at common-lisp.net Thu Feb 5 21:47:35 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Thu, 05 Feb 2009 21:47:35 +0000 Subject: [armedbear-cvs] r11632 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Feb 5 21:47:34 2009 New Revision: 11632 Log: Make our (static) fields FINAL, as we only write to them once: during object construction. Found by: dmiles. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Thu Feb 5 21:47:34 2009 @@ -2023,7 +2023,8 @@ (defknown declare-field (t t) t) (defun declare-field (name descriptor) (let ((field (make-field name descriptor))) - (setf (field-access-flags field) (logior #x8 #x2)) ; private static + ;; final private static + (setf (field-access-flags field) (logior #x10 #x8 #x2)) (setf (field-name-index field) (pool-name (field-name field))) (setf (field-descriptor-index field) (pool-name (field-descriptor field))) (push field *fields*))) From ehuelsmann at common-lisp.net Fri Feb 6 20:51:37 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Fri, 06 Feb 2009 20:51:37 +0000 Subject: [armedbear-cvs] r11633 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Fri Feb 6 20:51:34 2009 New Revision: 11633 Log: Clean up DERIVE-TYPE-{MIN,MAX,ASH} using the new DERIVE-TYPE-NUMERIC-OP infrastructure. This eliminates the need for WHEN-ARGS-INTEGER (sorry, Ville)... Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Fri Feb 6 20:51:34 2009 @@ -6206,36 +6206,6 @@ (return-from derive-type-%ldb (list 'INTEGER 0 (1- (expt 2 size-arg))))))) (list 'INTEGER 0 '*)) -(defmacro when-args-integer (args typenames decls &body body) - "Checks types of the args provided, if all args are -integer, splits them into high/low bytes and invokes the body. - -args contains the arguments for which the type check is done. -typenames contains names of variables to which the type, low byte -and high byte of the provided arg is stored, to be used in -the body. -decls contains declarations used in the body, similar to let. -body is the body to invoke. " - (labels ((build-let-when (body args typenames) - (when args - (let ((type (third typenames)) - (low (second typenames)) - (high (first typenames))) - (setf body - `(let ((,type (derive-compiler-type ,(first args)))) - (when (integer-type-p ,type) - (let ((,low (integer-type-low ,type)) - (,high (integer-type-high ,type))) - ,body))))) - (let ((tmpbody - (build-let-when body (cdr args) (cdddr typenames)))) - (if tmpbody - tmpbody - body))))) - (build-let-when - `(let (, at decls) , at body) - (reverse args) (reverse typenames)))) - (defmacro define-int-bounds-derivation (name (low1 high1 low2 high2) &body body) @@ -6246,7 +6216,6 @@ (declare (ignorable ,low1 ,high1 ,low2 ,high2)) , at body))) - (defun derive-integer-type (op type1 type2) "Derives the composed integer type of operation `op' given integer types `type1' and `type2'." @@ -6279,6 +6248,8 @@ (single-float double-float double-float) (double-float integer double-float) (double-float single-float double-float)) + ((ash) + (integer integer ,#'derive-integer-type)) ((min max) (integer integer ,#'derive-integer-type) (integer single-float single-float) @@ -6385,27 +6356,21 @@ (declaim (ftype (function (t) t) derive-type-max)) (defun derive-type-max (form) - (dolist (arg (cdr form) (make-compiler-type 'FIXNUM)) - (unless (fixnum-type-p (derive-compiler-type arg)) - (return t)))) + (let ((op (car form)) + (args (cdr form))) + (flet ((combine (x y) + (derive-type-numeric-op op x y))) + (reduce #'combine (cdr args) + :initial-value (car args))))) (defknown derive-type-min (t) t) (defun derive-type-min (form) - (let ((args (cdr form)) - (result-type t)) - (when (= (length form) 3) - (when-args-integer - ((%car args) (%cadr args)) - (type1 low1 high1 type2 low2 high2) - (low high) - (setf low (if (and low1 low2) - (min low1 low2) - nil) - high (if (and high1 high2) - (min high1 high2) - nil)) - (setf result-type (%make-integer-type low high)))) - result-type)) + (let ((op (car form)) + (args (cdr form))) + (flet ((combine (x y) + (derive-type-numeric-op op x y))) + (reduce #'combine (cdr args) + :initial-value (car args))))) ;; read-char &optional input-stream eof-error-p eof-value recursive-p => char (declaim (ftype (function (t) t) derive-type-read-char)) @@ -6414,40 +6379,26 @@ 'CHARACTER t)) + +(define-int-bounds-derivation ash (low1 high1 low2 high2) + (when (and low1 high1 low2 high2) + (cond + ((and (>= low1 0) (>= high1 0) (>= low2 0) (>= high2 0)) + ;; Everything is non-negative. + (values (ash low1 low2) + (unless (<= 64 high2) + (ash high1 high2)))) + ((and (>= low1 0) (>= high1 0) (<= low2 0) (<= high2 0)) + ;; Negative (or zero) second argument. + (values (ash low1 low2) + (ash high1 high2)))))) + ;; ash integer count => shifted-integer (defknown derive-type-ash (t) t) (defun derive-type-ash (form) - (let* ((args (cdr form)) - (arg1 (first args)) - (arg2 (second args)) - (result-type 'INTEGER)) - (when-args-integer - (arg1 arg2) - (type1 low1 high1 type2 low2 high2) - () - (when (and low1 high1 low2 high2) - (cond ((fixnum-constant-value type2) - (setf arg2 (fixnum-constant-value type2)) - (cond ((<= -64 arg2 64) - (setf result-type - (list 'INTEGER (ash low1 arg2) (ash high1 arg2)))) - ((minusp arg2) - (setf result-type - (list 'INTEGER - (if (minusp low1) -1 0) - (if (minusp high1) -1 0)))))) - ((and (>= low1 0) (>= high1 0) (>= low2 0) (>= high2 0)) - ;; Everything is non-negative. - (setf result-type (list 'INTEGER - (ash low1 low2) - (if (<= 64 high2) - '* (ash high1 high2))))) - ((and (>= low1 0) (>= high1 0) (<= low2 0) (<= high2 0)) - ;; Negative (or zero) second argument. - (setf result-type (list 'INTEGER - (ash low1 low2) - (ash high1 high2))))))) - (make-compiler-type result-type))) + (derive-type-numeric-op (car form) + (derive-compiler-type (cadr form)) + (derive-compiler-type (caddr form)))) (defknown derive-type (t) t) (defun derive-type (form) From ehuelsmann at common-lisp.net Fri Feb 6 21:00:47 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Fri, 06 Feb 2009 21:00:47 +0000 Subject: [armedbear-cvs] r11634 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Fri Feb 6 21:00:45 2009 New Revision: 11634 Log: Better in-lining compilation of MIN and MAX. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Fri Feb 6 21:00:45 2009 @@ -6740,65 +6740,68 @@ (defknown p2-min/max (t t t) t) (defun p2-min/max (form target representation) - (cond ((= (length form) 3) - (let* ((op (%car form)) - (args (%cdr form)) - (arg1 (%car args)) - (arg2 (%cadr args))) - (when (null target) - (compile-forms-and-maybe-emit-clear-values arg1 nil nil - arg2 nil nil) - (return-from p2-min/max)) - (when (notinline-p op) - (compile-function-call form target representation) - (return-from p2-min/max)) - (let ((type1 (derive-compiler-type arg1)) - (type2 (derive-compiler-type arg2))) - (cond ((and (fixnum-type-p type1) (fixnum-type-p type2)) - (compile-form arg1 'stack :int) - (emit 'dup) - (compile-form arg2 'stack :int) - (emit 'dup_x1) - (let ((LABEL1 (gensym))) - (emit (if (eq op 'max) 'if_icmpge 'if_icmple) LABEL1) - (emit 'swap) ;; The lower stack value is greater-or-equal - (label LABEL1) - (emit 'pop)) ;; Throw away the lower stack value - (convert-representation :int representation) - (emit-move-from-stack target representation)) - ((and (java-long-type-p type1) (java-long-type-p type2)) - (compile-form arg1 'stack :long) - (emit 'dup2) - (compile-form arg2 'stack :long) - (emit 'dup2_x2) - (emit 'lcmp) - (let ((LABEL1 (gensym))) - (emit (if (eq op 'max) 'ifge 'ifle) LABEL1) - (emit 'dup2_x2) ;; pour-mans swap2 - (emit 'pop2) - (label LABEL1) - (emit 'pop2)) - (convert-representation :long representation) - (emit-move-from-stack target representation)) - (t - (compile-form arg1 'stack nil) - (emit 'dup) - (compile-form arg2 'stack nil) - (emit 'dup_x1) - (emit-invokevirtual +lisp-object-class+ - (if (eq op 'max) - "isLessThanOrEqualTo" - "isGreaterThanOrEqualTo") - (lisp-object-arg-types 1) "Z") - (let ((LABEL1 (gensym))) - (emit 'ifeq LABEL1) - (emit 'swap) - (label LABEL1) - (emit 'pop)) - (fix-boxing representation nil) - (emit-move-from-stack target representation)))))) - (t - (compile-function-call form target representation)))) + (case (length form) + (1 (error 'program-error "Wrong number of arguments for ~A." (car form))) + (2 (compile-form (cadr form) target representation)) + (3 (let* ((op (%car form)) + (args (%cdr form)) + (arg1 (%car args)) + (arg2 (%cadr args))) + (when (null target) + (compile-forms-and-maybe-emit-clear-values arg1 nil nil + arg2 nil nil) + (return-from p2-min/max)) + (when (notinline-p op) + (compile-function-call form target representation) + (return-from p2-min/max)) + (let ((type1 (derive-compiler-type arg1)) + (type2 (derive-compiler-type arg2))) + (cond ((and (fixnum-type-p type1) (fixnum-type-p type2)) + (compile-form arg1 'stack :int) + (emit 'dup) + (compile-form arg2 'stack :int) + (emit 'dup_x1) + (let ((LABEL1 (gensym))) + (emit (if (eq op 'max) 'if_icmpge 'if_icmple) LABEL1) + (emit 'swap) ;; The lower stack value is greater-or-equal + (label LABEL1) + (emit 'pop)) ;; Throw away the lower stack value + (convert-representation :int representation) + (emit-move-from-stack target representation)) + ((and (java-long-type-p type1) (java-long-type-p type2)) + (compile-form arg1 'stack :long) + (emit 'dup2) + (compile-form arg2 'stack :long) + (emit 'dup2_x2) + (emit 'lcmp) + (let ((LABEL1 (gensym))) + (emit (if (eq op 'max) 'ifge 'ifle) LABEL1) + (emit 'dup2_x2) ;; pour-mans swap2 + (emit 'pop2) + (label LABEL1) + (emit 'pop2)) + (convert-representation :long representation) + (emit-move-from-stack target representation)) + (t + (compile-form arg1 'stack nil) + (emit 'dup) + (compile-form arg2 'stack nil) + (emit 'dup_x1) + (emit-invokevirtual +lisp-object-class+ + (if (eq op 'max) + "isLessThanOrEqualTo" + "isGreaterThanOrEqualTo") + (lisp-object-arg-types 1) "Z") + (let ((LABEL1 (gensym))) + (emit 'ifeq LABEL1) + (emit 'swap) + (label LABEL1) + (emit 'pop)) + (fix-boxing representation nil) + (emit-move-from-stack target representation)))))) + (t + (p2-min/max `(,(car form) (,(car form) (second form) (third form)) + ,@(nthcdr 3 form)) target representation)))) (defun p2-plus (form target representation) (case (length form) From ehuelsmann at common-lisp.net Fri Feb 6 22:58:50 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Fri, 06 Feb 2009 22:58:50 +0000 Subject: [armedbear-cvs] r11635 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Fri Feb 6 22:58:48 2009 New Revision: 11635 Log: Adjust stack effect of dcmpX: pop off 2 2-sized operands, put 1 int (1-sized) element back: results in -3 stack effect. Modified: trunk/abcl/src/org/armedbear/lisp/opcodes.lisp Modified: trunk/abcl/src/org/armedbear/lisp/opcodes.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/opcodes.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/opcodes.lisp Fri Feb 6 22:58:48 2009 @@ -203,8 +203,8 @@ (define-opcode lcmp 148 1 -3) (define-opcode fcmpl 149 1 -1) (define-opcode fcmpg 150 1 -1) -(define-opcode dcmpl 151 1 -2) -(define-opcode dcmpg 152 1 -2) +(define-opcode dcmpl 151 1 -3) +(define-opcode dcmpg 152 1 -3) (define-opcode ifeq 153 3 -1) (define-opcode ifne 154 3 -1) (define-opcode iflt 155 3 -1) From ehuelsmann at common-lisp.net Fri Feb 6 23:02:00 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Fri, 06 Feb 2009 23:02:00 +0000 Subject: [armedbear-cvs] r11636 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Fri Feb 6 23:01:59 2009 New Revision: 11636 Log: Generalize code generation paths for :INT/:LONG representations in P2-MIN/MAX into 1 path. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Fri Feb 6 23:01:59 2009 @@ -3193,6 +3193,16 @@ given a specific common representation.") +(defun emit-numeric-comparison (op representation false-LABEL) + (let* ((pos (position op comparison-ops)) + (ops-table (cdr (assoc representation comparison-ins))) + (ops (aref ops-table pos))) + (if (listp ops) + (progn + (emit (car ops)) + (emit (cadr ops) false-LABEL)) + (emit ops false-LABEL)))) + ;; Note that /= is not transitive, so we don't handle it here. (defknown p2-numeric-comparison (t t t) t) (defun p2-numeric-comparison (form target representation) @@ -3220,14 +3230,7 @@ (compile-forms-and-maybe-emit-clear-values arg1 'stack common-rep arg2 'stack common-rep) - (let* ((pos (position op comparison-ops)) - (ops-table (cdr (assoc common-rep comparison-ins))) - (ops (aref ops-table pos))) - (if (listp ops) - (progn - (emit (car ops)) - (emit (cadr ops) LABEL1)) - (emit ops LABEL1))) + (emit-numeric-comparison op common-rep LABEL1) (emit-push-true representation) (emit 'goto LABEL2) (label LABEL1) @@ -6756,32 +6759,23 @@ (return-from p2-min/max)) (let ((type1 (derive-compiler-type arg1)) (type2 (derive-compiler-type arg2))) - (cond ((and (fixnum-type-p type1) (fixnum-type-p type2)) - (compile-form arg1 'stack :int) - (emit 'dup) - (compile-form arg2 'stack :int) - (emit 'dup_x1) - (let ((LABEL1 (gensym))) - (emit (if (eq op 'max) 'if_icmpge 'if_icmple) LABEL1) - (emit 'swap) ;; The lower stack value is greater-or-equal + (cond ((and (java-long-type-p type1) (java-long-type-p type2)) + (let ((common-rep (if (and (fixnum-type-p type1) + (fixnum-type-p type2)) + :int :long)) + (LABEL1 (gensym))) + (compile-form arg1 'stack common-rep) + (emit-dup common-rep) + (compile-form arg2 'stack common-rep) + (emit (if (eq common-rep :long) + 'dup2_x2 'dup_x1)) + (emit-numeric-comparison (if (eq op 'max) '<= '>=) + common-rep LABEL1) + (emit-swap common-rep common-rep) (label LABEL1) - (emit 'pop)) ;; Throw away the lower stack value - (convert-representation :int representation) - (emit-move-from-stack target representation)) - ((and (java-long-type-p type1) (java-long-type-p type2)) - (compile-form arg1 'stack :long) - (emit 'dup2) - (compile-form arg2 'stack :long) - (emit 'dup2_x2) - (emit 'lcmp) - (let ((LABEL1 (gensym))) - (emit (if (eq op 'max) 'ifge 'ifle) LABEL1) - (emit 'dup2_x2) ;; pour-mans swap2 - (emit 'pop2) - (label LABEL1) - (emit 'pop2)) - (convert-representation :long representation) - (emit-move-from-stack target representation)) + (emit-move-from-stack nil common-rep) + (convert-representation common-rep representation) + (emit-move-from-stack target representation))) (t (compile-form arg1 'stack nil) (emit 'dup) From ehuelsmann at common-lisp.net Fri Feb 6 23:22:53 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Fri, 06 Feb 2009 23:22:53 +0000 Subject: [armedbear-cvs] r11637 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Fri Feb 6 23:22:51 2009 New Revision: 11637 Log: Extend EMIT-DUP to be able to duplicate past the top-most stack value. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Fri Feb 6 23:22:51 2009 @@ -412,10 +412,18 @@ (t (emit 'ldc2_w (pool-double n))))) (defknown emit-dup (symbol) t) -(defun emit-dup (representation) - (ecase (representation-size representation) - (1 (emit 'dup)) - (2 (emit 'dup2)))) +(defun emit-dup (representation &key (past nil past-supplied-p)) + "Emits the 'dup' instruction required to duplicate `representation'. + +If `past' is specified, the newly duplicated value is inserted on the +stack past the top-most value, which is assumed to be of the representation +passed in `past'." + (emit + (nth (if past-supplied-p + (representation-size past) 0) + (ecase (representation-size representation) + (1 '(dup dup_x1 dup_x2)) + (2 '(dup2 dup2_x1 dup2_x2)))))) (defknown emit-swap (symbol symbol) t) (defun emit-swap (rep1 rep2) @@ -4964,7 +4972,7 @@ (compile-form (%car args) 'stack nil) (compile-form (%cadr args) 'stack nil) (when target - (emit 'dup_x1)) + (emit-dup nil :past nil)) (emit-invokevirtual +lisp-object-class+ (if (eq op 'sys:set-car) "setCar" "setCdr") (lisp-object-arg-types 1) @@ -5630,7 +5638,7 @@ (compile-forms-and-maybe-emit-clear-values size-arg 'stack :int position-arg 'stack :int arg3 'stack nil) - (emit 'dup_x2) + (emit 'dup_x2) ;; use not supported by emit-dup: 3 values involved (emit 'pop) (emit-invokevirtual +lisp-object-class+ "LDB" '("I" "I") +lisp-object+) (fix-boxing representation nil) @@ -6767,8 +6775,7 @@ (compile-form arg1 'stack common-rep) (emit-dup common-rep) (compile-form arg2 'stack common-rep) - (emit (if (eq common-rep :long) - 'dup2_x2 'dup_x1)) + (emit-dup common-rep :past common-rep) (emit-numeric-comparison (if (eq op 'max) '<= '>=) common-rep LABEL1) (emit-swap common-rep common-rep) @@ -6778,9 +6785,9 @@ (emit-move-from-stack target representation))) (t (compile-form arg1 'stack nil) - (emit 'dup) + (emit-dup nil) (compile-form arg2 'stack nil) - (emit 'dup_x1) + (emit-dup nil :past nil) (emit-invokevirtual +lisp-object-class+ (if (eq op 'max) "isLessThanOrEqualTo" From ehuelsmann at common-lisp.net Sat Feb 7 21:42:08 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sat, 07 Feb 2009 21:42:08 +0000 Subject: [armedbear-cvs] r11638 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Feb 7 21:42:05 2009 New Revision: 11638 Log: Fix P2-MIN/MAX backquoting/unquoting error. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Sat Feb 7 21:42:05 2009 @@ -6801,7 +6801,7 @@ (fix-boxing representation nil) (emit-move-from-stack target representation)))))) (t - (p2-min/max `(,(car form) (,(car form) (second form) (third form)) + (p2-min/max `(,(car form) (,(car form) ,(second form) ,(third form)) ,@(nthcdr 3 form)) target representation)))) (defun p2-plus (form target representation) From ehuelsmann at common-lisp.net Sun Feb 8 08:43:48 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 08 Feb 2009 08:43:48 +0000 Subject: [armedbear-cvs] r11639 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Feb 8 08:43:46 2009 New Revision: 11639 Log: Add stack effect of used instruction. Modified: trunk/abcl/src/org/armedbear/lisp/opcodes.lisp Modified: trunk/abcl/src/org/armedbear/lisp/opcodes.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/opcodes.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/opcodes.lisp Sun Feb 8 08:43:46 2009 @@ -189,7 +189,7 @@ (define-opcode i2f 134 1 0) (define-opcode i2d 135 1 1) (define-opcode l2i 136 1 -1) -(define-opcode l2f 137 1 nil) +(define-opcode l2f 137 1 -1) (define-opcode l2d 138 1 0) (define-opcode f2i 139 1 nil) (define-opcode f2l 140 1 nil) From ehuelsmann at common-lisp.net Sun Feb 8 08:49:00 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 08 Feb 2009 08:49:00 +0000 Subject: [armedbear-cvs] r11640 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Feb 8 08:48:58 2009 New Revision: 11640 Log: Type derivation for multi-argument +/-/*; Fixed type-arguments for DERIVE-TYPE-MIN, DERIVE-TYPE-MAX; Generation of inline code for multi-argument #'*. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Sun Feb 8 08:48:58 2009 @@ -1170,6 +1170,8 @@ 134 ; i2f 135 ; i2d 136 ; l2i + 137 ; l2f + 138 ; l2d 141 ; f2d 144 ; d2f 148 ; lcmp @@ -6309,20 +6311,16 @@ (defknown derive-type-minus (t) t) (defun derive-type-minus (form) - (let ((args (cdr form)) - (result-type t)) + (let ((op (car form)) + (args (cdr form))) (case (length args) - (1 - (setf result-type - (derive-type-numeric-op (car form) - zero-integer-type - (derive-compiler-type (%car args))))) - (2 - (setf result-type - (derive-type-numeric-op (car form) - (derive-compiler-type (car args)) - (derive-compiler-type (cadr args)))))) - result-type)) + (1 (derive-type-numeric-op (car form) + zero-integer-type + (derive-compiler-type (%car args)))) + (2 (flet ((combine (x y) + (derive-type-numeric-op op x y))) + (reduce #'combine (cdr args) :key #'derive-compiler-type + :initial-value (derive-compiler-type (car args)))))))) (define-int-bounds-derivation + (low1 high1 low2 high2) @@ -6331,14 +6329,12 @@ (defknown derive-type-plus (t) t) (defun derive-type-plus (form) - (let ((args (cdr form)) - (result-type t)) - (when (= (length args) 2) - (setf result-type - (derive-type-numeric-op (car form) - (derive-compiler-type (car args)) - (derive-compiler-type (cadr args))))) - result-type)) + (let ((op (car form)) + (args (cdr form))) + (flet ((combine (x y) + (derive-type-numeric-op op x y))) + (reduce #'combine (cdr args) :key #'derive-compiler-type + :initial-value (derive-compiler-type (car args)))))) (define-int-bounds-derivation * (low1 high1 low2 high2) (cond ((or (null low1) (null low2)) @@ -6356,14 +6352,12 @@ (values (* low1 low2) (* high1 high2))))) (defun derive-type-times (form) - (let ((args (cdr form)) - (result-type t)) - (when (= (length args) 2) - (setf result-type - (derive-type-numeric-op (car form) - (derive-compiler-type (car args)) - (derive-compiler-type (cadr args))))) - result-type)) + (let ((op (car form)) + (args (cdr form))) + (flet ((combine (x y) + (derive-type-numeric-op op x y))) + (reduce #'combine (cdr args) :key #'derive-compiler-type + :initial-value (derive-compiler-type (car args)))))) (declaim (ftype (function (t) t) derive-type-max)) (defun derive-type-max (form) @@ -6371,8 +6365,8 @@ (args (cdr form))) (flet ((combine (x y) (derive-type-numeric-op op x y))) - (reduce #'combine (cdr args) - :initial-value (car args))))) + (reduce #'combine (cdr args) :key #'derive-compiler-type + :initial-value (derive-compiler-type (car args)))))) (defknown derive-type-min (t) t) (defun derive-type-min (form) @@ -6380,8 +6374,8 @@ (args (cdr form))) (flet ((combine (x y) (derive-type-numeric-op op x y))) - (reduce #'combine (cdr args) - :initial-value (car args))))) + (reduce #'combine (cdr args) :key #'derive-compiler-type + :initial-value (derive-compiler-type (car args)))))) ;; read-char &optional input-stream eof-error-p eof-value recursive-p => char (declaim (ftype (function (t) t) derive-type-read-char)) @@ -6705,6 +6699,7 @@ (defun p2-times (form target representation) (case (length form) + (2 (compile-form (cadr form) target representation)) (3 (let* ((args (cdr form)) (arg1 (%car args)) @@ -6747,7 +6742,8 @@ (compile-binary-operation "multiplyBy" args target representation))))) (t (dformat t "p2-times case 5~%") - (compile-function-call form target representation)))) + (p2-times `(,(car form) (,(car form) ,(second form) ,(third form)) + ,@(nthcdr 3 form)) target representation)))) (defknown p2-min/max (t t t) t) (defun p2-min/max (form target representation) From ehuelsmann at common-lisp.net Sun Feb 8 10:06:20 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 08 Feb 2009 10:06:20 +0000 Subject: [armedbear-cvs] r11641 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Feb 8 10:06:19 2009 New Revision: 11641 Log: Integer bounds derivation for MIN and MAX. Compilation of (*) -> 1 (fixes ANSI test '*.1'). Better type derivation for (+). Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Sun Feb 8 10:06:19 2009 @@ -6303,7 +6303,7 @@ (defvar zero-integer-type (%make-integer-type 0 0) "Integer type representing the 0 (zero) -value for use with derive-type-minus.") +value for use with derive-type-minus and derive-type-plus.") (define-int-bounds-derivation - (low1 high1 low2 high2) (values (and low1 low2 (- low1 low2)) @@ -6331,10 +6331,12 @@ (defun derive-type-plus (form) (let ((op (car form)) (args (cdr form))) - (flet ((combine (x y) - (derive-type-numeric-op op x y))) - (reduce #'combine (cdr args) :key #'derive-compiler-type - :initial-value (derive-compiler-type (car args)))))) + (if (null args) + zero-integer-type + (flet ((combine (x y) + (derive-type-numeric-op op x y))) + (reduce #'combine (cdr args) :key #'derive-compiler-type + :initial-value (derive-compiler-type (car args))))))) (define-int-bounds-derivation * (low1 high1 low2 high2) (cond ((or (null low1) (null low2)) @@ -6351,13 +6353,23 @@ (t (values (* low1 low2) (* high1 high2))))) +(defvar one-integer-type (%make-integer-type 1 1) + "Integer type representing the value 1 (one) +for use with derive-type-times.") + (defun derive-type-times (form) (let ((op (car form)) (args (cdr form))) - (flet ((combine (x y) - (derive-type-numeric-op op x y))) - (reduce #'combine (cdr args) :key #'derive-compiler-type - :initial-value (derive-compiler-type (car args)))))) + (if (null args) + one-integer-type + (flet ((combine (x y) + (derive-type-numeric-op op x y))) + (reduce #'combine (cdr args) :key #'derive-compiler-type + :initial-value (derive-compiler-type (car args))))))) + +(define-int-bounds-derivation max (low1 low2 high1 high2) + (values (or (when (and low1 low2) (max low1 low2)) low1 low2) + (or (when (and high1 high2) (max high1 high2)) high1 high2))) (declaim (ftype (function (t) t) derive-type-max)) (defun derive-type-max (form) @@ -6368,6 +6380,10 @@ (reduce #'combine (cdr args) :key #'derive-compiler-type :initial-value (derive-compiler-type (car args)))))) +(define-int-bounds-derivation min (low1 high1 low2 high2) + (values (or (when (and low1 low2) (min low1 low2)) low1 low2) + (or (when (and high1 high2) (min high1 high2)) high1 hig2))) + (defknown derive-type-min (t) t) (defun derive-type-min (form) (let ((op (car form)) @@ -6699,6 +6715,7 @@ (defun p2-times (form target representation) (case (length form) + (1 (compile-constant 1 target representation)) (2 (compile-form (cadr form) target representation)) (3 (let* ((args (cdr form)) From ehuelsmann at common-lisp.net Sun Feb 8 11:06:09 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 08 Feb 2009 11:06:09 +0000 Subject: [armedbear-cvs] r11642 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Feb 8 11:06:08 2009 New Revision: 11642 Log: Remove commented-out code ("emit-unbox-*") which is superseeded by following FIX-BOXING. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Sun Feb 8 11:06:08 2009 @@ -6750,8 +6750,6 @@ (compile-forms-and-maybe-emit-clear-values arg1 'stack nil) (emit-push-int arg2) (emit-invokevirtual +lisp-object-class+ "multiplyBy" '("I") +lisp-object+) -;; (when (eq representation :int) -;; (emit-unbox-fixnum)) (fix-boxing representation result-type) (emit-move-from-stack target representation)) (t @@ -7097,8 +7095,6 @@ (compile-form arg1 'stack nil) (compile-form arg2 'stack nil) (emit-invokevirtual +lisp-object-class+ "truncate" (lisp-object-arg-types 1) +lisp-object+) -;; (when (eq representation :int) -;; (emit-unbox-fixnum)) (fix-boxing representation nil) ; FIXME use derived result type (emit-move-from-stack target representation))) @@ -7109,8 +7105,6 @@ (compile-form (second form) 'stack nil) (compile-form (third form) 'stack :int) (emit-invokevirtual +lisp-object-class+ "elt" '("I") +lisp-object+) -;; (when (eq representation :int) -;; (emit-unbox-fixnum)) (fix-boxing representation nil) ; FIXME use derived result type (emit-move-from-stack target representation)) (t @@ -7507,8 +7501,6 @@ (emit-push-current-thread) (emit-invokevirtual +lisp-symbol-class+ "symbolValue" (list +lisp-thread+) +lisp-object+))) -;; (when (eq representation :int) -;; (emit-unbox-fixnum)) (fix-boxing representation nil) (emit-move-from-stack target representation)) @@ -7710,8 +7702,6 @@ (emit-push-current-thread) (emit-invokevirtual +lisp-symbol-class+ "symbolValue" (list +lisp-thread+) +lisp-object+) -;; (when (eq representation :int) -;; (emit-unbox-fixnum)) (fix-boxing representation nil) (emit-move-from-stack target representation) (return-from p2-symbol-value)))) From vvoutilainen at common-lisp.net Sun Feb 8 13:14:22 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Sun, 08 Feb 2009 13:14:22 +0000 Subject: [armedbear-cvs] r11643 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: vvoutilainen Date: Sun Feb 8 13:14:20 2009 New Revision: 11643 Log: Remove duplication from p1-flet and p1-labels. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp 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 Sun Feb 8 13:14:20 2009 @@ -390,80 +390,78 @@ context (if (eq state '&optional) "optional" "keyword"))))))))) +(defmacro with-local-functions-for-flet/labels + (form local-functions-var lambda-name lambda-list-var name-var body-var body1 body2) + `(progn (incf (compiland-children *current-compiland*) (length (cadr ,form))) + (let ((*visible-variables* *visible-variables*) + (*local-functions* *local-functions*) + (*current-compiland* *current-compiland*) + (,local-functions-var '())) + (dolist (definition (cadr ,form)) + (let ((,name-var (car definition)) + (,lambda-list-var (cadr definition))) + (validate-name-and-lambda-list ,name-var ,lambda-list-var ,lambda-name) + + (let* ((,body-var (cddr definition)) + (compiland (make-compiland :name ,name-var + :parent *current-compiland*))) + , at body1))) + (setf ,local-functions-var (nreverse ,local-functions-var)) + , at body2))) + (defun p1-flet (form) - (incf (compiland-children *current-compiland*) (length (cadr form))) - (let ((*visible-variables* *visible-variables*) - (*local-functions* *local-functions*) - (*current-compiland* *current-compiland*) - (local-functions '())) - (dolist (definition (cadr form)) - (let ((name (car definition)) - (lambda-list (cadr definition))) - (validate-name-and-lambda-list name lambda-list 'FLET) - (let* ((body (cddr definition)) - (compiland (make-compiland :name name - :parent *current-compiland*)) - (local-function (make-local-function :name name - :compiland compiland))) - (multiple-value-bind (body decls) (parse-body body) - (let* ((block-name (fdefinition-block-name name)) - (lambda-expression - `(lambda ,lambda-list , at decls (block ,block-name , at body))) - (*visible-variables* *visible-variables*) - (*local-functions* *local-functions*) - (*current-compiland* compiland)) - (setf (compiland-lambda-expression compiland) lambda-expression) - (setf (local-function-inline-expansion local-function) - (generate-inline-expansion block-name lambda-list body)) - (p1-compiland compiland))) - (when *closure-variables* - (let ((variable (make-variable :name (gensym)))) - (setf (local-function-variable local-function) variable) - (push variable *all-variables*))) - (push local-function local-functions)))) - (setf local-functions (nreverse local-functions)) - ;; Make the local functions visible. - (dolist (local-function local-functions) - (push local-function *local-functions*) - (let ((variable (local-function-variable local-function))) - (when variable - (push variable *visible-variables*)))) - (with-saved-compiler-policy - (process-optimization-declarations (cddr form)) - (list* (car form) local-functions (p1-body (cddr form)))))) + (with-local-functions-for-flet/labels + form local-functions 'FLET lambda-list name body + ((let ((local-function (make-local-function :name name + :compiland compiland))) + (multiple-value-bind (body decls) (parse-body body) + (let* ((block-name (fdefinition-block-name name)) + (lambda-expression + `(lambda ,lambda-list , at decls (block ,block-name , at body))) + (*visible-variables* *visible-variables*) + (*local-functions* *local-functions*) + (*current-compiland* compiland)) + (setf (compiland-lambda-expression compiland) lambda-expression) + (setf (local-function-inline-expansion local-function) + (generate-inline-expansion block-name lambda-list body)) + (p1-compiland compiland))) + (when *closure-variables* + (let ((variable (make-variable :name (gensym)))) + (setf (local-function-variable local-function) variable) + (push variable *all-variables*))) + (push local-function local-functions))) + ;; Make the local functions visible. + ((dolist (local-function local-functions) + (push local-function *local-functions*) + (let ((variable (local-function-variable local-function))) + (when variable + (push variable *visible-variables*)))) + (with-saved-compiler-policy + (process-optimization-declarations (cddr form)) + (list* (car form) local-functions (p1-body (cddr form))))))) + (defun p1-labels (form) - (incf (compiland-children *current-compiland*) (length (cadr form))) - (let ((*visible-variables* *visible-variables*) - (*local-functions* *local-functions*) - (*current-compiland* *current-compiland*) - (local-functions '())) - (dolist (definition (cadr form)) - (let ((name (car definition)) - (lambda-list (cadr definition))) - (validate-name-and-lambda-list name lambda-list 'LABELS) - (let* ((body (cddr definition)) - (compiland (make-compiland :name name - :parent *current-compiland*)) - (variable (make-variable :name (gensym))) - (local-function (make-local-function :name name - :compiland compiland - :variable variable))) - (multiple-value-bind (body decls) (parse-body body) - (setf (compiland-lambda-expression compiland) - `(lambda ,lambda-list , at decls (block ,name , at body)))) - (push variable *all-variables*) - (push local-function local-functions)))) - (setf local-functions (nreverse local-functions)) - ;; Make the local functions visible. - (dolist (local-function local-functions) - (push local-function *local-functions*) - (push (local-function-variable local-function) *visible-variables*)) - (dolist (local-function local-functions) - (let ((*visible-variables* *visible-variables*) - (*current-compiland* (local-function-compiland local-function))) - (p1-compiland (local-function-compiland local-function)))) - (list* (car form) local-functions (p1-body (cddr form))))) + (with-local-functions-for-flet/labels + form local-functions 'LABELS lambda-list name body + ((let* ((variable (make-variable :name (gensym))) + (local-function (make-local-function :name name + :compiland compiland + :variable variable))) + (multiple-value-bind (body decls) (parse-body body) + (setf (compiland-lambda-expression compiland) + `(lambda ,lambda-list , at decls (block ,name , at body)))) + (push variable *all-variables*) + (push local-function local-functions))) + ;; Make the local functions visible. + ((dolist (local-function local-functions) + (push local-function *local-functions*) + (push (local-function-variable local-function) *visible-variables*)) + (dolist (local-function local-functions) + (let ((*visible-variables* *visible-variables*) + (*current-compiland* (local-function-compiland local-function))) + (p1-compiland (local-function-compiland local-function)))) + (list* (car form) local-functions (p1-body (cddr form)))))) (defknown p1-funcall (t) t) (defun p1-funcall (form) From vvoutilainen at common-lisp.net Sun Feb 8 14:00:05 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Sun, 08 Feb 2009 14:00:05 +0000 Subject: [armedbear-cvs] r11644 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: vvoutilainen Date: Sun Feb 8 14:00:03 2009 New Revision: 11644 Log: Further cleanup for p1-flet/labels. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp 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 Sun Feb 8 14:00:03 2009 @@ -407,6 +407,12 @@ :parent *current-compiland*))) , at body1))) (setf ,local-functions-var (nreverse ,local-functions-var)) + ;; Make the local functions visible. + (dolist (local-function ,local-functions-var) + (push local-function *local-functions*) + (let ((variable (local-function-variable local-function))) + (when variable + (push variable *visible-variables*)))) , at body2))) (defun p1-flet (form) @@ -430,13 +436,7 @@ (setf (local-function-variable local-function) variable) (push variable *all-variables*))) (push local-function local-functions))) - ;; Make the local functions visible. - ((dolist (local-function local-functions) - (push local-function *local-functions*) - (let ((variable (local-function-variable local-function))) - (when variable - (push variable *visible-variables*)))) - (with-saved-compiler-policy + ((with-saved-compiler-policy (process-optimization-declarations (cddr form)) (list* (car form) local-functions (p1-body (cddr form))))))) @@ -453,11 +453,7 @@ `(lambda ,lambda-list , at decls (block ,name , at body)))) (push variable *all-variables*) (push local-function local-functions))) - ;; Make the local functions visible. ((dolist (local-function local-functions) - (push local-function *local-functions*) - (push (local-function-variable local-function) *visible-variables*)) - (dolist (local-function local-functions) (let ((*visible-variables* *visible-variables*) (*current-compiland* (local-function-compiland local-function))) (p1-compiland (local-function-compiland local-function)))) From vvoutilainen at common-lisp.net Sun Feb 8 14:34:11 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Sun, 08 Feb 2009 14:34:11 +0000 Subject: [armedbear-cvs] r11645 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: vvoutilainen Date: Sun Feb 8 14:34:10 2009 New Revision: 11645 Log: Combine p2-let/let*-vars. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp 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 Sun Feb 8 14:34:10 2009 @@ -141,47 +141,48 @@ (t (p1-default form))))) + +(defmacro p1-let/let*-vars + (varlist variables-var var body1 body2) + (let ((varspec (gensym)) + (initform (gensym)) + (name (gensym))) + `(let ((,variables-var ())) + (dolist (,varspec ,varlist) + (cond ((consp ,varspec) + ;; FIXME Currently this error is signalled by the precompiler. + (unless (= (length ,varspec) 2) + (compiler-error "The LET/LET* binding specification ~S is invalid." + ,varspec)) + (let* ((,name (%car ,varspec)) + (,initform (p1 (%cadr ,varspec))) + (,var (make-variable :name (check-name ,name) :initform ,initform))) + (push ,var ,variables-var) + , at body1)) + (t + (let ((,var (make-variable :name (check-name ,varspec)))) + (push ,var ,variables-var) + , at body1)))) + , at body2))) + (defknown p1-let-vars (t) t) (defun p1-let-vars (varlist) - (let ((vars ())) - (dolist (varspec varlist) - (cond ((consp varspec) - ;; FIXME Currently this error is signalled by the precompiler. - (unless (= (length varspec) 2) - (compiler-error "The LET binding specification ~S is invalid." - varspec)) - (let ((name (check-name (%car varspec))) - (initform (p1 (%cadr varspec)))) - (push (make-variable :name name :initform initform) vars))) - (t - (push (make-variable :name (check-name varspec)) vars)))) - (setf vars (nreverse vars)) + (p1-let/let*-vars + varlist vars var + () + ((setf vars (nreverse vars)) (dolist (variable vars) (push variable *visible-variables*) (push variable *all-variables*)) - vars)) + vars))) (defknown p1-let*-vars (t) t) (defun p1-let*-vars (varlist) - (let ((vars ())) - (dolist (varspec varlist) - (cond ((consp varspec) - ;; FIXME Currently this error is signalled by the precompiler. - (unless (= (length varspec) 2) - (compiler-error "The LET* binding specification ~S is invalid." - varspec)) - (let* ((name (%car varspec)) - (initform (p1 (%cadr varspec))) - (var (make-variable :name (check-name name) :initform initform))) - (push var vars) - (push var *visible-variables*) - (push var *all-variables*))) - (t - (let ((var (make-variable :name (check-name varspec)))) - (push var vars) - (push var *visible-variables*) - (push var *all-variables*))))) - (nreverse vars))) + (p1-let/let*-vars + varlist vars var + ((push var *visible-variables*) + (push var *all-variables*)) + ((nreverse vars)))) (defun p1-let/let* (form) (declare (type cons form)) From ehuelsmann at common-lisp.net Sun Feb 8 21:00:30 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 08 Feb 2009 21:00:30 +0000 Subject: [armedbear-cvs] r11646 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Feb 8 21:00:27 2009 New Revision: 11646 Log: Fix compilation of Maxima: the wrong representation was returned. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Sun Feb 8 21:00:27 2009 @@ -6592,9 +6592,9 @@ (case representation (:int (emit-invokevirtual +lisp-object-class+ "length" nil "I")) - (:long + ((:long :float :double) (emit-invokevirtual +lisp-object-class+ "length" nil "I") - (emit 'i2l)) + (convert-representation :int representation)) (:boolean ;; FIXME We could optimize this all away in unsafe calls. (emit-invokevirtual +lisp-object-class+ "length" nil "I") @@ -7122,10 +7122,13 @@ (compile-forms-and-maybe-emit-clear-values arg1 'stack nil arg2 'stack :int) (emit-invokevirtual +lisp-object-class+ "aref" '("I") "I")) - (:long + ((:long :float :double) (compile-forms-and-maybe-emit-clear-values arg1 'stack nil arg2 'stack :int) - (emit-invokevirtual +lisp-object-class+ "aref_long" '("I") "J")) + (emit-invokevirtual +lisp-object-class+ "aref_long" '("I") "J") + (when (or (eq representation :float) + (eq representation :double)) + (convert-represenation :long representation))) (:char (cond ((compiler-subtypep type1 'string) (compile-form arg1 'stack nil) ; array From ehuelsmann at common-lisp.net Sun Feb 8 21:23:49 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 08 Feb 2009 21:23:49 +0000 Subject: [armedbear-cvs] r11647 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Feb 8 21:23:48 2009 New Revision: 11647 Log: Add support for java.lang.Long arguments based on Bignums. Found by: ayrnieu. Modified: trunk/abcl/src/org/armedbear/lisp/Bignum.java Modified: trunk/abcl/src/org/armedbear/lisp/Bignum.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Bignum.java (original) +++ trunk/abcl/src/org/armedbear/lisp/Bignum.java Sun Feb 8 21:23:48 2009 @@ -65,6 +65,21 @@ } @Override + public Object javaInstance(Class c) { + String cn = c.getName(); + if (cn.equals("java.lang.Byte") || cn.equals("byte")) + return Byte.valueOf((byte)value.intValue()); + if (cn.equals("java.lang.Short") || cn.equals("short")) + return Short.valueOf((short)value.intValue()); + if (cn.equals("java.lang.Integer") || cn.equals("int")) + return Integer.valueOf(value.intValue()); + if (cn.equals("java.lang.Long") || cn.equals("long")) + return Long.valueOf((long)value.longValue()); + return javaInstance(); + } + + + @Override public LispObject typeOf() { if (value.signum() > 0) From ehuelsmann at common-lisp.net Sun Feb 8 22:45:57 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 08 Feb 2009 22:45:57 +0000 Subject: [armedbear-cvs] r11648 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Feb 8 22:45:55 2009 New Revision: 11648 Log: Strict checking of representations delivered vs requested - inspired by Ville's find: r11646. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Sun Feb 8 22:45:55 2009 @@ -349,19 +349,19 @@ (defknown emit-push-false (t) t) (defun emit-push-false (representation) (declare (optimize speed (safety 0))) - (case representation + (ecase representation (:boolean (emit 'iconst_0)) - (t + ((nil) (emit-push-nil)))) (defknown emit-push-true (t) t) (defun emit-push-true (representation) (declare (optimize speed (safety 0))) - (case representation + (ecase representation (:boolean (emit 'iconst_1)) - (t + ((nil) (emit-push-t)))) (defknown emit-push-constant-int (fixnum) t) @@ -975,16 +975,16 @@ (defun emit-move-from-stack (target &optional representation) (declare (optimize speed)) (cond ((null target) - (case representation + (ecase representation ((:long :double) (emit 'pop2)) - (t + ((NIL :int :boolean :char :float) (emit 'pop)))) ((eq target 'stack)) ; Nothing to do. ((fixnump target) ;; A register. (emit - (case representation + (ecase representation ((:int :boolean :char) 'istore) (:long @@ -993,7 +993,7 @@ 'fstore) (:double 'dstore) - (t + ((nil) 'astore)) target)) (t @@ -2380,7 +2380,7 @@ (defun compile-constant (form target representation) (unless target (return-from compile-constant)) - (case representation + (ecase representation (:int (cond ((fixnump form) (emit-push-constant-int form)) @@ -2438,7 +2438,8 @@ (sys::%format t "compile-constant :double representation~%") (assert nil))) (emit-move-from-stack target representation) - (return-from compile-constant))) + (return-from compile-constant)) + ((NIL))) (cond ((fixnump form) (let ((translation (case form (0 "ZERO") @@ -2568,12 +2569,12 @@ (cond ((and boxed-method-name unboxed-method-name) (let ((arg (cadr form))) (compile-forms-and-maybe-emit-clear-values arg 'stack nil) - (case representation + (ecase representation (:boolean (emit-invokevirtual +lisp-object-class+ unboxed-method-name nil "Z")) - (t + ((NIL) (emit-invokevirtual +lisp-object-class+ boxed-method-name nil +lisp-object+))) @@ -2751,11 +2752,11 @@ (t (compile-forms-and-maybe-emit-clear-values arg1 'stack nil arg2 'stack nil) - (case representation + (ecase representation (:boolean (emit-invokevirtual +lisp-object-class+ "eql" (lisp-object-arg-types 1) "Z")) - (t + ((NIL) (emit-invokevirtual +lisp-object-class+ "EQL" (lisp-object-arg-types 1) +lisp-object+))))) (emit-move-from-stack target representation))) @@ -4258,21 +4259,21 @@ (defun emit-move-to-variable (variable) (let ((representation (variable-representation variable))) (flet ((emit-array-store (representation) - (emit (or (case representation - ((:int :boolean :char) - 'iastore) - (:long 'lastore) - (:float 'fastore) - (:double 'dastore)) - 'aastore)))) + (emit (ecase representation + ((:int :boolean :char) + 'iastore) + (:long 'lastore) + (:float 'fastore) + (:double 'dastore) + ((nil) 'aastore))))) (cond ((variable-register variable) - (emit (or (case (variable-representation variable) - ((:int :boolean :char) - 'istore) - (:long 'lstore) - (:float 'fstore) - (:double 'dstore)) - 'astore) + (emit (ecase (variable-representation variable) + ((:int :boolean :char) + 'istore) + (:long 'lstore) + (:float 'fstore) + (:double 'dstore) + ((nil) 'astore)) (variable-register variable))) ((variable-index variable) (aload (compiland-argument-register *current-compiland*)) @@ -4292,21 +4293,21 @@ (defun emit-push-variable (variable) (flet ((emit-array-store (representation) - (emit (or (case representation + (emit (ecase representation ((:int :boolean :char) 'iaload) (:long 'laload) (:float 'faload) - (:double 'daload)) - 'aaload)))) + (:double 'daload) + ((nil) 'aaload))))) (cond ((variable-register variable) - (emit (or (case (variable-representation variable) + (emit (ecase (variable-representation variable) ((:int :boolean :char) 'iload) (:long 'lload) (:float 'fload) - (:double 'dload)) - 'aload) + (:double 'dload) + ((nil) 'aload)) (variable-register variable))) ((variable-index variable) (aload (compiland-argument-register *current-compiland*)) @@ -4649,17 +4650,17 @@ (let ((LABEL1 (gensym)) (LABEL2 (gensym))) (emit 'ifeq LABEL1) - (case representation + (ecase representation (:boolean (emit 'iconst_0)) - (t + ((nil) (emit-push-nil))) (emit 'goto LABEL2) (label LABEL1) - (case representation + (ecase representation (:boolean (emit 'iconst_1)) - (t + ((nil) (emit-push-t))) (label LABEL2) (emit-move-from-stack target representation))) @@ -5718,17 +5719,17 @@ (let ((LABEL1 (gensym)) (LABEL2 (gensym))) (emit 'ifne LABEL1) - (case representation + (ecase representation (:boolean (emit 'iconst_1)) - (t + ((nil) (emit-push-t))) (emit 'goto LABEL2) (label LABEL1) - (case representation + (ecase representation (:boolean (emit 'iconst_0)) - (t + ((nil) (emit-push-nil))) (label LABEL2) (emit-move-from-stack target representation))) @@ -6589,7 +6590,7 @@ ((check-arg-count form 1)) (let ((arg (cadr form))) (compile-forms-and-maybe-emit-clear-values arg 'stack nil) - (case representation + (ecase representation (:int (emit-invokevirtual +lisp-object-class+ "length" nil "I")) ((:long :float :double) @@ -6603,7 +6604,7 @@ (:char (sys::%format t "p2-length: :char case~%") (aver nil)) - (t + ((nil) (emit-invokevirtual +lisp-object-class+ "LENGTH" nil +lisp-object+))) (emit-move-from-stack target representation))) @@ -7117,18 +7118,15 @@ (let* ((arg1 (%cadr form)) (arg2 (%caddr form)) (type1 (derive-compiler-type arg1))) - (case representation + (ecase representation (:int (compile-forms-and-maybe-emit-clear-values arg1 'stack nil arg2 'stack :int) (emit-invokevirtual +lisp-object-class+ "aref" '("I") "I")) - ((:long :float :double) + (:long (compile-forms-and-maybe-emit-clear-values arg1 'stack nil arg2 'stack :int) - (emit-invokevirtual +lisp-object-class+ "aref_long" '("I") "J") - (when (or (eq representation :float) - (eq representation :double)) - (convert-represenation :long representation))) + (emit-invokevirtual +lisp-object-class+ "aref_long" '("I") "J")) (:char (cond ((compiler-subtypep type1 'string) (compile-form arg1 'stack nil) ; array @@ -7142,11 +7140,13 @@ arg2 'stack :int) (emit-invokevirtual +lisp-object-class+ "AREF" '("I") +lisp-object+) (emit-unbox-character)))) - (t + ((nil :float :double :boolean) + ;;###FIXME for float and double, we probably want + ;; separate java methods to retrieve the values. (compile-forms-and-maybe-emit-clear-values arg1 'stack nil arg2 'stack :int) (emit-invokevirtual +lisp-object-class+ "AREF" '("I") +lisp-object+) - (fix-boxing representation nil))) + (convert-representation nil representation))) (emit-move-from-stack target representation))) (t (compile-function-call form target representation)))) @@ -7248,25 +7248,18 @@ ((fixnump arg2) (compile-forms-and-maybe-emit-clear-values arg1 'stack nil) (emit-push-constant-int arg2) - (case representation + (ecase representation (:int (emit-invokevirtual +lisp-object-class+ "getFixnumSlotValue" '("I") "I")) - (:long - (emit-invokevirtual +lisp-object-class+ "getSlotValue" - '("I") +lisp-object+) - (emit-invokevirtual +lisp-object-class+ "longValue" - nil "J")) - (:char + ((nil :char :long :float :double) (emit-invokevirtual +lisp-object-class+ "getSlotValue" '("I") +lisp-object+) - (emit-unbox-character)) + ;; (convert-representation NIL NIL) is a no-op + (convert-representation nil representation)) (:boolean (emit-invokevirtual +lisp-object-class+ "getSlotValueAsBoolean" - '("I") "Z")) - (t - (emit-invokevirtual +lisp-object-class+ "getSlotValue" - '("I") +lisp-object+))) + '("I") "Z"))) (emit-move-from-stack target representation)) (t (compile-function-call form target representation))))) @@ -7392,13 +7385,13 @@ (DONE (gensym))) (compile-forms-and-maybe-emit-clear-values arg1 'stack :boolean) (emit 'ifeq FAIL) - (case representation + (ecase representation (:boolean (compile-forms-and-maybe-emit-clear-values arg2 'stack :boolean) (emit 'goto DONE) (label FAIL) (emit 'iconst_0)) - (t + ((nil) (compile-form arg2 'stack nil) (emit 'goto DONE) (label FAIL) @@ -8011,10 +8004,10 @@ (emit-push-true representation) (emit-move-from-stack target representation)) ((keywordp form) - (case representation + (ecase representation (:boolean (emit 'iconst_1)) - (t + ((nil) (let ((name (lookup-known-keyword form))) (if name (emit 'getstatic "org/armedbear/lisp/Keyword" name +lisp-symbol+) From ehuelsmann at common-lisp.net Sun Feb 8 22:48:33 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 08 Feb 2009 22:48:33 +0000 Subject: [armedbear-cvs] r11649 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Feb 8 22:48:32 2009 New Revision: 11649 Log: Indentation: make opcode-enumerations look like elsewhere. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Sun Feb 8 22:48:32 2009 @@ -983,19 +983,14 @@ ((eq target 'stack)) ; Nothing to do. ((fixnump target) ;; A register. - (emit - (ecase representation - ((:int :boolean :char) - 'istore) - (:long - 'lstore) - (:float - 'fstore) - (:double - 'dstore) - ((nil) - 'astore)) - target)) + (emit (ecase representation + ((:int :boolean :char) + 'istore) + (:long 'lstore) + (:float 'fstore) + (:double 'dstore) + ((nil) 'astore)) + target)) (t (sys::%format t "emit-move-from-stack general case~%") (aver nil)))) From ehuelsmann at common-lisp.net Mon Feb 9 21:53:14 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 09 Feb 2009 21:53:14 +0000 Subject: [armedbear-cvs] r11650 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Mon Feb 9 21:53:11 2009 New Revision: 11650 Log: Generate Symbol-typed fields if we expect to be loading off one. Also: generate uniquely prefixed symbols, aiding debugging. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Mon Feb 9 21:53:11 2009 @@ -2070,11 +2070,11 @@ (cond ((null (symbol-package symbol)) (setf g (if *compile-file-truename* (declare-object-as-string symbol) - (declare-object symbol)))) + (declare-object symbol +lisp-symbol+)))) (t (let ((*code* *static-code*) (s (sanitize symbol))) - (setf g (symbol-name (gensym))) + (setf g (symbol-name (gensym "SYM"))) (when s (setf g (concatenate 'string g "_" s))) (declare-field g +lisp-symbol+) @@ -2092,7 +2092,7 @@ (declare-with-hashtable symbol *declared-symbols* ht g (let ((*code* *static-code*)) - (setf g (symbol-name (gensym))) + (setf g (symbol-name (gensym "KEY"))) (declare-field g +lisp-symbol+) (emit 'ldc (pool-string (symbol-name symbol))) (emit-invokestatic +lisp-class+ "internKeyword" @@ -2106,7 +2106,7 @@ (declare (type symbol symbol)) (declare-with-hashtable symbol *declared-functions* ht f - (setf f (symbol-name (gensym))) + (setf f (symbol-name (gensym "FUN"))) (let ((s (sanitize symbol))) (when s (setf f (concatenate 'string f "_" s)))) @@ -2159,7 +2159,7 @@ (defun declare-local-function (local-function) (declare-with-hashtable local-function *declared-functions* ht g - (setf g (symbol-name (gensym))) + (setf g (symbol-name (gensym "LFUN"))) (let* ((pathname (class-file-pathname (local-function-class-file local-function))) (*code* *static-code*)) (declare-field g +lisp-object+) @@ -2249,7 +2249,7 @@ (defknown declare-character (t) string) (defun declare-character (c) - (let ((g (symbol-name (gensym))) + (let ((g (symbol-name (gensym "CHAR"))) (n (char-code c)) (*code* *static-code*)) (declare-field g +lisp-character+) @@ -2266,21 +2266,23 @@ (setf *static-code* *code*) g)) -(defknown declare-object-as-string (t) string) -(defun declare-object-as-string (obj) - (let* ((g (symbol-name (gensym))) +(defknown declare-object-as-string (t &optional t) string) +(defun declare-object-as-string (obj &optional (obj-class +lisp-object+)) + (let* ((g (symbol-name (gensym "OBJSTR"))) (s (with-output-to-string (stream) (dump-form obj stream))) (*code* *static-code*)) - (declare-field g +lisp-object+) + (declare-field g obj-class) (emit 'ldc (pool-string s)) (emit-invokestatic +lisp-class+ "readObjectFromString" (list +java-string+) +lisp-object+) - (emit 'putstatic *this-class* g +lisp-object+) + (when (string/= obj-class +lisp-object+) + (emit 'checkcast obj-class)) + (emit 'putstatic *this-class* g obj-class) (setf *static-code* *code*) g)) (defun declare-load-time-value (obj) - (let* ((g (symbol-name (gensym))) + (let* ((g (symbol-name (gensym "LTV"))) (s (with-output-to-string (stream) (dump-form obj stream))) (*code* *static-code*)) (declare-field g +lisp-object+) @@ -2298,7 +2300,7 @@ (aver (not (null *compile-file-truename*))) (aver (or (structure-object-p obj) (standard-object-p obj) (java:java-object-p obj))) - (let* ((g (symbol-name (gensym))) + (let* ((g (symbol-name (gensym "INSTANCE"))) (s (with-output-to-string (stream) (dump-form obj stream))) (*code* *static-code*)) (declare-field g +lisp-object+) @@ -2312,7 +2314,7 @@ g)) (defun declare-package (obj) - (let* ((g (symbol-name (gensym))) + (let* ((g (symbol-name (gensym "PKG"))) (*print-level* nil) (*print-length* nil) (s (format nil "#.(FIND-PACKAGE ~S)" (package-name obj))) @@ -2325,23 +2327,26 @@ (setf *static-code* *code*) g)) -(declaim (ftype (function (t) string) declare-object)) -(defun declare-object (obj) - (let ((key (symbol-name (gensym)))) +(declaim (ftype (function (t &optional t) string) declare-object)) +(defun declare-object (obj &optional (obj-class +lisp-object+)) + (let ((key (symbol-name (gensym "OBJ")))) (remember key obj) (let* ((g1 (declare-string key)) - (g2 (symbol-name (gensym))) + (g2 (symbol-name (gensym "O2BJ")))) + (let* ( (*code* *static-code*)) - (declare-field g2 +lisp-object+) + (declare-field g2 obj-class) (emit 'getstatic *this-class* g1 +lisp-simple-string+) (emit-invokestatic +lisp-class+ "recall" (list +lisp-simple-string+) +lisp-object+) - (emit 'putstatic *this-class* g2 +lisp-object+) + (when (string/= obj-class +lisp-object+) + (emit 'checkcast obj-class)) + (emit 'putstatic *this-class* g2 obj-class) (setf *static-code* *code*) - g2))) + g2)))) (defun declare-lambda (obj) - (let* ((g (symbol-name (gensym))) + (let* ((g (symbol-name (gensym "LAMBDA"))) (*print-level* nil) (*print-length* nil) (s (format nil "~S" obj)) @@ -2361,7 +2366,7 @@ (declare-with-hashtable string *declared-strings* ht g (let ((*code* *static-code*)) - (setf g (symbol-name (gensym))) + (setf g (symbol-name (gensym "STR"))) (declare-field g +lisp-simple-string+) (emit 'new +lisp-simple-string-class+) (emit 'dup) From ehuelsmann at common-lisp.net Mon Feb 9 21:56:02 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 09 Feb 2009 21:56:02 +0000 Subject: [armedbear-cvs] r11651 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Mon Feb 9 21:56:01 2009 New Revision: 11651 Log: Followup from last commit: add the Symbol type to DECLARE-OBJECT-AS-STRING too. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Mon Feb 9 21:56:01 2009 @@ -2069,7 +2069,7 @@ symbol *declared-symbols* ht g (cond ((null (symbol-package symbol)) (setf g (if *compile-file-truename* - (declare-object-as-string symbol) + (declare-object-as-string symbol +lisp-symbol+) (declare-object symbol +lisp-symbol+)))) (t (let ((*code* *static-code*) From ehuelsmann at common-lisp.net Tue Feb 10 07:10:27 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Tue, 10 Feb 2009 07:10:27 +0000 Subject: [armedbear-cvs] r11652 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Tue Feb 10 07:10:23 2009 New Revision: 11652 Log: Check cast takes a class name as its argument, not a class reference. Found by: Robert Dodier. Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp 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 Tue Feb 10 07:10:23 2009 @@ -2069,8 +2069,10 @@ symbol *declared-symbols* ht g (cond ((null (symbol-package symbol)) (setf g (if *compile-file-truename* - (declare-object-as-string symbol +lisp-symbol+) - (declare-object symbol +lisp-symbol+)))) + (declare-object-as-string symbol +lisp-symbol+ + +lisp-symbol-class+) + (declare-object symbol +lisp-symbol+ + +lisp-symbol-class+)))) (t (let ((*code* *static-code*) (s (sanitize symbol))) @@ -2267,17 +2269,18 @@ g)) (defknown declare-object-as-string (t &optional t) string) -(defun declare-object-as-string (obj &optional (obj-class +lisp-object+)) +(defun declare-object-as-string (obj &optional (obj-ref +lisp-object+) + obj-class) (let* ((g (symbol-name (gensym "OBJSTR"))) (s (with-output-to-string (stream) (dump-form obj stream))) (*code* *static-code*)) - (declare-field g obj-class) + (declare-field g obj-ref) (emit 'ldc (pool-string s)) (emit-invokestatic +lisp-class+ "readObjectFromString" (list +java-string+) +lisp-object+) - (when (string/= obj-class +lisp-object+) + (when (and obj-class (string/= obj-class +lisp-object+)) (emit 'checkcast obj-class)) - (emit 'putstatic *this-class* g obj-class) + (emit 'putstatic *this-class* g obj-ref) (setf *static-code* *code*) g)) @@ -2328,20 +2331,21 @@ g)) (declaim (ftype (function (t &optional t) string) declare-object)) -(defun declare-object (obj &optional (obj-class +lisp-object+)) +(defun declare-object (obj &optional (obj-ref +lisp-object+) + obj-class) (let ((key (symbol-name (gensym "OBJ")))) (remember key obj) (let* ((g1 (declare-string key)) (g2 (symbol-name (gensym "O2BJ")))) (let* ( (*code* *static-code*)) - (declare-field g2 obj-class) + (declare-field g2 obj-ref) (emit 'getstatic *this-class* g1 +lisp-simple-string+) (emit-invokestatic +lisp-class+ "recall" (list +lisp-simple-string+) +lisp-object+) - (when (string/= obj-class +lisp-object+) + (when (and obj-class (string/= obj-class +lisp-object-class+)) (emit 'checkcast obj-class)) - (emit 'putstatic *this-class* g2 obj-class) + (emit 'putstatic *this-class* g2 obj-ref) (setf *static-code* *code*) g2)))) From mevenson at common-lisp.net Tue Feb 10 14:44:07 2009 From: mevenson at common-lisp.net (Mark Evenson) Date: Tue, 10 Feb 2009 14:44:07 +0000 Subject: [armedbear-cvs] r11653 - trunk/abcl Message-ID: Author: mevenson Date: Tue Feb 10 14:44:05 2009 New Revision: 11653 Log: If the either the Lisp or Java compilation fails, halt the Ant based build process. Modified: trunk/abcl/build.xml Modified: trunk/abcl/build.xml ============================================================================== --- trunk/abcl/build.xml (original) +++ trunk/abcl/build.xml Tue Feb 10 14:44:05 2009 @@ -161,7 +161,8 @@ + target="1.5" + failonerror="true"> @@ -204,6 +205,7 @@ unless="abcl.fasls.uptodate.p"> From mevenson at common-lisp.net Tue Feb 10 15:47:38 2009 From: mevenson at common-lisp.net (Mark Evenson) Date: Tue, 10 Feb 2009 15:47:38 +0000 Subject: [armedbear-cvs] r11654 - trunk/abcl Message-ID: Author: mevenson Date: Tue Feb 10 15:47:36 2009 New Revision: 11654 Log: Add a stock copy of the GPLv2 that ABCL licensing is based. Added: trunk/abcl/LICENSE Added: trunk/abcl/LICENSE ============================================================================== --- (empty file) +++ trunk/abcl/LICENSE Tue Feb 10 15:47:36 2009 @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + 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 + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19yy name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. From mevenson at common-lisp.net Tue Feb 10 15:48:09 2009 From: mevenson at common-lisp.net (Mark Evenson) Date: Tue, 10 Feb 2009 15:48:09 +0000 Subject: [armedbear-cvs] r11655 - trunk/abcl Message-ID: Author: mevenson Date: Tue Feb 10 15:48:08 2009 New Revision: 11655 Log: Change reference from COPYING to LICENSE. Modified: trunk/abcl/COPYING Modified: trunk/abcl/COPYING ============================================================================== --- trunk/abcl/COPYING (original) +++ trunk/abcl/COPYING Tue Feb 10 15:48:08 2009 @@ -2,7 +2,7 @@ License (with a special exception described below). A copy of GNU General Public License (GPL) is included in this distribution, in -the file COPYING. +the file LICENSE. Linking this software statically or dynamically with other modules is making a combined work based on this software. Thus, the terms and conditions of the GNU From ehuelsmann at common-lisp.net Wed Feb 11 19:48:19 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Wed, 11 Feb 2009 19:48:19 +0000 Subject: [armedbear-cvs] r11656 - branches/0.13.x Message-ID: Author: ehuelsmann Date: Wed Feb 11 19:48:16 2009 New Revision: 11656 Log: Branch for preparation of the 0.13 release series. Added: branches/0.13.x/ - copied from r11655, /trunk/ From ehuelsmann at common-lisp.net Wed Feb 11 19:52:04 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Wed, 11 Feb 2009 19:52:04 +0000 Subject: [armedbear-cvs] r11657 - branches/open-external-format Message-ID: Author: ehuelsmann Date: Wed Feb 11 19:52:03 2009 New Revision: 11657 Log: Delete branch which has been long merged to trunk. Removed: branches/open-external-format/ From vvoutilainen at common-lisp.net Sat Feb 14 12:52:34 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Sat, 14 Feb 2009 12:52:34 +0000 Subject: [armedbear-cvs] r11658 - trunk/abcl Message-ID: Author: vvoutilainen Date: Sat Feb 14 12:52:32 2009 New Revision: 11658 Log: Move GPLv2 text to COPYING, append Classpath exception to COPYING, delete LICENSE. Removed: trunk/abcl/LICENSE Modified: trunk/abcl/COPYING Modified: trunk/abcl/COPYING ============================================================================== --- trunk/abcl/COPYING (original) +++ trunk/abcl/COPYING Sat Feb 14 12:52:32 2009 @@ -1,12 +1,283 @@ -The software in this package is distributed under the GNU General Public -License (with a special exception described below). + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 -A copy of GNU General Public License (GPL) is included in this distribution, in -the file LICENSE. + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. -Linking this software statically or dynamically with other modules is making a -combined work based on this software. Thus, the terms and conditions of the GNU -General Public License cover the whole combination. + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + 13. Linking this library statically or dynamically with other modules is making a combined work based on this library. Thus, the terms and conditions of the GNU General Public License cover the whole combination. As a special exception, the copyright holders of this software give you permission to link this software with independent modules to produce an @@ -18,3 +289,60 @@ software, you may extend this exception to your version of the software, but you are not obligated to do so. If you do not wish to do so, delete this exception statement from your version. + + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + 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 + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19yy name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice From mevenson at common-lisp.net Sat Feb 14 16:00:53 2009 From: mevenson at common-lisp.net (Mark Evenson) Date: Sat, 14 Feb 2009 16:00:53 +0000 Subject: [armedbear-cvs] r11659 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: mevenson Date: Sat Feb 14 16:00:51 2009 New Revision: 11659 Log: Re-enable compilation of TRACE forms. Introduces a bug by including a reference to CLOS in the TRACE facility, which makes tracing of forms that access the compiler (FORMAT et. al.) problematic. Proposed solution to ship as 0.13.0. --Mark Modified: trunk/abcl/src/org/armedbear/lisp/trace.lisp Modified: trunk/abcl/src/org/armedbear/lisp/trace.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/trace.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/trace.lisp Sat Feb 14 16:00:51 2009 @@ -34,12 +34,18 @@ (export 'untraced-function) ;; For FIND-GENERIC-FUNCTION in clos.lisp. (require "FORMAT") +(require "CLOS") ;; XXX This eventually blows up in the compiler, but + ;; works for a while. (defvar *trace-info-hashtable* (make-hash-table :test #'equal)) (defstruct trace-info name untraced-function breakp) -(defvar *trace-depth* 0) +(defvar *trace-depth* 0 + "Current depth of stack push for use of TRACE facility.") +;; XXX How can we "punt" on this form ??? +(defmethod make-load-form ((object trace-info) &optional environment) + (make-load-form-saving-slots object :environment environment)) (defun list-traced-functions () (copy-list *traced-names*)) From ehuelsmann at common-lisp.net Sun Feb 15 21:25:37 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 15 Feb 2009 21:25:37 +0000 Subject: [armedbear-cvs] r11660 - trunk/abcl Message-ID: Author: ehuelsmann Date: Sun Feb 15 21:25:34 2009 New Revision: 11660 Log: Fix our lisp based build for CLISP 2.47 (and hopefully from there onwards). Modified: trunk/abcl/build-abcl.lisp Modified: trunk/abcl/build-abcl.lisp ============================================================================== --- trunk/abcl/build-abcl.lisp (original) +++ trunk/abcl/build-abcl.lisp Sun Feb 15 21:25:34 2009 @@ -106,7 +106,7 @@ (ext:cd old-directory))) (cond ((numberp status) status) - ((eq status t) + ((or (eq status t) (null status)) ;; clisp 2.47 returns NIL on success 0) (t -1)))) From mevenson at common-lisp.net Wed Feb 18 12:09:06 2009 From: mevenson at common-lisp.net (Mark Evenson) Date: Wed, 18 Feb 2009 12:09:06 +0000 Subject: [armedbear-cvs] r11661 - in branches/0.13.x/abcl: . doc scripts src/org/armedbear/lisp Message-ID: Author: mevenson Date: Wed Feb 18 12:09:02 2009 New Revision: 11661 Log: Restablish TRACE facility as per svn r11659. Start documentation for release. Mark as abcl-0.12.42. Added: branches/0.13.x/abcl/ChangeLog branches/0.13.x/abcl/doc/ABCL-SLIME branches/0.13.x/abcl/scripts/update-version - copied unchanged from r11456, /trunk/j/scripts/update-version Modified: branches/0.13.x/abcl/src/org/armedbear/lisp/trace.lisp Added: branches/0.13.x/abcl/ChangeLog ============================================================================== --- (empty file) +++ branches/0.13.x/abcl/ChangeLog Wed Feb 18 12:09:02 2009 @@ -0,0 +1,936 @@ +2009-02-10 mevenson + + * COPYING: + [svn r11655] Change reference from COPYING to LICENSE. + [adc9feb07f46] [tip] + +2009-02-10 mevenson + + * LICENSE: + [svn r11654] Add a stock copy of the GPLv2 that ABCL licensing is + based. + [a062c53b8952] + +2009-02-10 Mark Evenson + + * src/org/armedbear/lisp/Version.java: abcl-0.12.42. + +2009-02-10 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11652] Check cast takes a class name as its argument, not a + class reference. + + Found by: Robert Dodier. + [1a502d2774ed] [tip] + +2009-02-10 Mark Evenson + + * src/org/armedbear/lisp/Version.java: abcl-0.12.41. + +2009-02-09 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11651] Followup from last commit: add the Symbol type to + DECLARE-OBJECT-AS-STRING too. + [2ad74928e195] [tip] + +2009-02-09 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11650] Generate Symbol-typed fields if we expect to be loading + off one. Also: generate uniquely prefixed symbols, aiding debugging. + [4a323de64620] + +2009-02-08 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11649] Indentation: make opcode-enumerations look like + elsewhere. + [d94c404b0ae2] + +2009-02-08 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11648] Strict checking of representations delivered vs + requested - inspired by Ville's find: r11646. + [472bffe6b684] + +2009-02-08 ehuelsmann + + * src/org/armedbear/lisp/Bignum.java: + [svn r11647] Add support for java.lang.Long arguments based on + Bignums. + + Found by: ayrnieu. + [489984244e28] + +2009-02-08 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11646] Fix compilation of Maxima: the wrong representation was + returned. + + Found by: Ville Voutilainen + [4da5939df9bb] + +2009-02-08 vvoutilainen + + * src/org/armedbear/lisp/compiler-pass1.lisp: + [svn r11645] Combine p2-let/let*-vars. + [d1fafb5cab0d] + +2009-02-08 vvoutilainen + + * src/org/armedbear/lisp/compiler-pass1.lisp: + [svn r11644] Further cleanup for p1-flet/labels. + [1422d6917ce9] + +2009-02-08 vvoutilainen + + * src/org/armedbear/lisp/compiler-pass1.lisp: + [svn r11643] Remove duplication from p1-flet and p1-labels. + [cda7cee2e768] + +2009-02-08 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11642] Remove commented-out code ("emit-unbox-*") which is + superseeded by following FIX-BOXING. + [8354a7723878] + +2009-02-08 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11641] Integer bounds derivation for MIN and MAX. Compilation + of (*) -> 1 (fixes ANSI test '*.1'). Better type derivation for (+). + [ca0b19924f9d] + +2009-02-08 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11640] Type derivation for multi-argument +/-/*; Fixed type- + arguments for DERIVE-TYPE-MIN, DERIVE-TYPE-MAX; Generation of inline + code for multi-argument #'*. + [86774b5a6d08] + +2009-02-08 ehuelsmann + + * src/org/armedbear/lisp/opcodes.lisp: + [svn r11639] Add stack effect of used instruction. + [80e582a2d232] + +2009-02-07 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11638] Fix P2-MIN/MAX backquoting/unquoting error. + [560660457a92] + +2009-02-07 Mark Evenson + + * src/org/armedbear/lisp/Version.java: abcl-0.12.40 + +2009-02-07 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11637] Extend EMIT-DUP to be able to duplicate past the top- + most stack value. + [cde1938d07f5] [tip] + +2009-02-07 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11636] Generalize code generation paths for :INT/:LONG + representations in P2-MIN/MAX into 1 path. + [2b24360a8baa] + +2009-02-06 ehuelsmann + + * src/org/armedbear/lisp/opcodes.lisp: + [svn r11635] Adjust stack effect of dcmpX: pop off 2 2-sized + operands, put 1 int (1-sized) element back: results in -3 stack + effect. + [5033b4d52175] + +2009-02-06 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11634] Better in-lining compilation of MIN and MAX. + [d222b9097904] + +2009-02-06 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11633] Clean up DERIVE-TYPE-{MIN,MAX,ASH} using the new + DERIVE-TYPE-NUMERIC-OP infrastructure. This eliminates the need for + WHEN-ARGS-INTEGER (sorry, Ville)... + [aec94aeb6235] + +2009-02-05 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11632] Make our (static) fields FINAL, as we only write to + them once: during object construction. + + Found by: dmiles. + [a8781046a5e4] + +2009-02-05 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11631] Fix DERIVE-VARIABLE-REPRESENTATION in case the LIMIT- + VARIABLE resolves to NIL (as happens to be the case in DOTIMES.25). + + Follow up to r11619. + [a13806e8863e] + +2009-02-05 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11630] Optimize (and fix) CONVERT-REPRESENTATION for the case + of 2 eql arguments (fixes CONVERT-REPRESENTATION for the (NIL NIL) + argument case). + [1e51be903970] + +2009-02-05 astalla + + * src/org/armedbear/lisp/scripting/AbclScriptEngine.java, + src/org/armedbear/lisp/scripting/lisp/config.lisp, + src/org/armedbear/lisp/scripting/lisp/packages.lisp: + [svn r11629] fixed exported symbol list for package :abcl-script. + [308673074d9c] + +2009-02-05 ehuelsmann + + * src/org/armedbear/lisp/trace.lisp: + [svn r11628] Remove commented-out lines. + [f9a1e118fc75] + +2009-02-05 ehuelsmann + + * src/org/armedbear/lisp/trace.lisp: + [svn r11627] Make TRACE protect *TRACE-DEPTH* from non-local returns + (such as RETURN to TOP-LEVEL restarts). Also make TRACE no longer + invoke CLOS (and thus the compiler, making it possible to trace + the compiler now, instead of getting a stack overflow.) + [c2dc0bc77236] + +2009-02-05 ehuelsmann + + * src/org/armedbear/lisp/format.lisp: + [svn r11626] Final and last fix for COERCE.20 and the issue with + printing double floats. + [6666484df802] + +2009-02-05 ehuelsmann + + * src/org/armedbear/lisp/format.lisp: + [svn r11625] Fix COERCE.20 (a regression since 0.12). + [03f383897dc9] + +2009-02-04 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11624] Wider use of CONVERT-REPRESENTATION shows an issue: + LispInteger.getInstance() returns a LispInteger. Store Fixnum and + Bignum values in fields of type LispInteger to resolve it. + Additionally, simplify DECLARE-BIGNUM. + [8eb64c9a14f2] + +2009-02-04 astalla + + * examples/abcl/jsr-223/JSR223Example.java, + src/org/armedbear/lisp/scripting/AbclScriptEngine.java, + src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java, + src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp, + src/org/armedbear/lisp/scripting/lisp/config.lisp: + [svn r11623] Perfectioned ABCL auto-configuration when using + JSR-223; added option to compile scripts using temp files (default) + or using the run-time compiler; added example of usage of ABCL with + JSR-223. + [3f9b1e758720] + +2009-02-04 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11622] Eliminate NEW-FIXNUM and EMIT-FIXNUM-INIT in favor of + CONVERT-REPRESENTATION. + [de767d0ca6a1] + +2009-02-04 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp, + src/org/armedbear/lisp/opcodes.lisp: + [svn r11621] Implement P2-COMPILAND-UNBOX-VARIABLE in terms of new + primitives. Replace the last occurrance of (EMIT 'VAR-SET ...) with + (EMIT-MOVE-TO-VARIABLE ...); removes the need to 'RESOLVE- + VARIABLES': eliminate it and the VAR-SET artificial opcode. + [aa117d50a0ec] + +2009-02-03 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11620] Kill long code repetitions in COMPILE-VAR-REF and + P2-SETQ + - making the resulting ones more generic. + [aeb8dde03ec0] + +2009-02-03 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11619] Reduce code duplication: move variable representation + deduction to DERIVE-VARIABLE-REPRESENTATION. Also: introduce EMIT- + MOVE-TO-VARIABLE to move values off the stack to a variable slot, + another source for code duplication. + [87ff66f293ad] + +2009-02-03 Mark Evenson + + * src/org/armedbear/lisp/Version.java: abcl-0.13.39 + +2009-02-02 astalla + + * src/org/armedbear/lisp/scripting/AbclScriptEngine.java, + src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp, + src/org/armedbear/lisp/scripting/lisp/config.lisp, + src/org/armedbear/lisp/scripting/lisp/packages.lisp: + [svn r11618] Added support for a configuration file in the CLASSPATH + for ABCL when loaded through JSR-223. + [9dbd584f5a44] + +2009-02-02 Mark Evenson + + * src/org/armedbear/lisp/Version.java: abcl-0.12.38 + +2009-02-01 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11617] More CONVERT-REPRESENTATIONs. + [40b4bf5f5aaf] [tip] + +2009-02-01 vvoutilainen + + * src/org/armedbear/lisp/directory.lisp: + [svn r11616] Better matching in directory listing. There are still + cases where I can break it with my own trees, but it doesn't list + superfluous entries with this patch. + [99b1becf148a] + +2009-02-01 mevenson + + * src/org/armedbear/lisp/Version.java: + [svn r11615] Revert publishing of "internal" version back to + 0.13.0-dev. + [7f1ce311170d] + +2009-01-31 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11614] Inline all compiled subtractions instead of only the 2 + and 3 argument cases. + [d832d6818bd0] + +2009-01-31 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11613] Fix #'+ compilation with FEWER than 2 arguments. + [56a7241fc29a] + +2009-01-31 ehuelsmann + + * src/org/armedbear/lisp/Stream.java: + [svn r11612] Count linenumbers correctly again (they were double + counted before this commit). + [d8b66d03aab5] + +2009-01-31 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11611] Clean up COMPILE-CONSTANT: there's no reason to cast + from one type to another at runtime if you can do it compile time. + [7c70855efa12] + +2009-01-31 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp, + src/org/armedbear/lisp/opcodes.lisp: + [svn r11610] Add 2 used - but not enabled - opcodes. + [484f6c427f0a] + +2009-01-31 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11609] Don't enumerate representation conversion inline: we + have a generic routine for it now. + [db827465c215] + +2009-01-31 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp, + src/org/armedbear/lisp/opcodes.lisp: + [svn r11608] Support inline comparisons for many types of compiler + types (including single and double floats). + [9bd5ff717c68] + +2009-01-31 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11607] Implement inline float and double calculations for + P2-TIMES. Cleanup some functions which are now unused. + [419cfd6a9720] [tip] + +2009-01-30 Mark Evenson + + * src/org/armedbear/lisp/Version.java: 0.12.37 + +2009-01-30 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11604] Smarter type derivation: start *using* the float and + double storage types (in P2-PLUS and P2-MINUS, others to follow). + [16b708bac9ea] [tip] + +2009-01-29 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11603] Use generic representation conversions instead of + enumerating in line. + [b51ac8c60995] + +2009-01-29 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11602] Implement generic type-representation derivations and + conversions; shorten P2-MINUS and P2-PLUS implementations by using + them. + [e03949d060fa] + +2009-01-29 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11601] Only compile one or the other argument to an :int. + [044f281b5014] + +2009-01-29 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp, + src/org/armedbear/lisp/opcodes.lisp: + [svn r11600] Add more opcodes to the list; update stack effect + information. + [3f9ac9e65d17] + +2009-01-28 Mark Evenson + + * src/org/armedbear/lisp/Version.java: 0.12.36 + + * test/lisp/ansi/ansi-tests-compiled.lisp, test/lisp/ansi/ansi-tests- + interpreted.lisp, test/lisp/ansi/package.lisp: + [svn r11598] Added (somehow) missing GCL ANSI test ASDF loading + wrappers. + [93ffb994870c] [tip] + +2009-01-27 astalla + + * src/org/armedbear/lisp/Lisp.java: + [svn r11597] Fixed URL decoding bug in loadCompiledFunction using + java.net.URLDecoder. + [20f9d83efbc8] [svn.11597, tip] + +2009-01-27 mevenson + + * abcl.asd, build.xml, scripts/ansi-tests-compiled.lisp, scripts/ansi- + tests-interpreted.lisp, test/lisp/abcl/compiler-tests.lisp, + test/lisp/abcl/condition-tests.lisp, test/lisp/abcl/file-system- + tests.lisp, test/lisp/abcl/java-tests.lisp, test/lisp/abcl/math- + tests.lisp, test/lisp/abcl/misc-tests.lisp, test/lisp/abcl/pathname- + tests.lisp, test/lisp/ansi/package.lisp: + [svn r11596] Invocation of ASDF tests from Lisp via instructions at + top of 'abcl.asd' works. + + Optimized 'build.xml' run time for typical (repeated) usage + scenarios: o downloading of 'junit.jar' based on presence on + filesystem. o rebuilding of 'abcl.jar' based on explicit check + via Ant + + Removed automatic execution of ABCL-TESTS based on load. + + Ant 'abcl.test' target not working in all situations. Needs further + debugging. Workaround: use the Lisp-based ASDF test entry point for + now. + + ANSI-TESTS-COMPILED ANSI-TESTS-INTERPRETED need a sibling directory + containing the GCL ANSI tests from . They complain semi-intellibly if + not found. + [df74dda142da] [svn.11596] + +2009-01-26 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11594] Make DERIVE-TYPE support SINGLE-FLOAT and DOUBLE-FLOAT. + [8be2e867d289] [svn.11594] + +2009-01-26 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11593] Optimize unboxing of booleans. + [998d6ad5a021] [svn.11593] + +2009-01-26 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11592] Generic representation conversion (from one JVM type to + another) and boxing (JVM type to LispObject) support. + + Removes EMIT-BOX-* and CONVERT-* functions as they're now part of + the generic framework. + [494ad22faee4] [svn.11592] + +2009-01-26 ehuelsmann + + * src/org/armedbear/lisp/compiler-types.lisp: + [svn r11591] Make SINGLE-FLOAT and DOUBLE-FLOAT compiler types. + [c8475ab16375] [svn.11591] + +2009-01-26 Mark Evenson + + * (0.12.35): Mark version. + +2009-01-26 astalla + + * build.xml, src/META-INF/services/javax.script.ScriptEngineFactory, + src/org/armedbear/lisp/Autoload.java, + src/org/armedbear/lisp/JProxy.java, + src/org/armedbear/lisp/Java.java, + src/org/armedbear/lisp/JavaClass.java, + src/org/armedbear/lisp/JavaObject.java, + src/org/armedbear/lisp/LispObject.java, + src/org/armedbear/lisp/StandardClass.java, + src/org/armedbear/lisp/Symbol.java, + src/org/armedbear/lisp/autoloads.lisp, + src/org/armedbear/lisp/clos.lisp, src/org/armedbear/lisp/java.lisp, + src/org/armedbear/lisp/print-object.lisp, + src/org/armedbear/lisp/scripting/AbclScriptEngine.java, + src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java, + src/org/armedbear/lisp/scripting/lisp/packages.lisp, + src/org/armedbear/lisp/scripting/util/ReaderInputStream.java, + src/org/armedbear/lisp/scripting/util/WriterOutputStream.java: + [svn r11590] Merged the scripting branch, providing JSR-223 support + and other new features. JSR-233 is only built if the necessary + javax.script.* classes are found in the CLASSPATH. + [a53b64a117b2] + +2009-01-26 ehuelsmann + + * src/org/armedbear/lisp/opcodes.lisp: + [svn r11589] Add stack information for opcodes we'll start using + soon. + [4ea879c28e1b] + +2009-01-25 Mark Evenson + + * Merged svn r11588. + [f1949beae75b] + +2009-01-25 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp, + src/org/armedbear/lisp/opcodes.lisp: + [svn r11588] Optimize MIN/MAX inline calculations: with the right + stack use, we can avoid storing and reloading of values with shorter + execution paths and branches as a result. Also enable the + instructions pop2, dup2_x1 and dup2_x2. + [7f6ac45d2ac3] + +2009-01-25 Mark Evenson + + * build.xml, scripts/ansi-tests-compiled.lisp, scripts/ansi-tests- + interpreted.lisp, test/lisp/ansi/ansi-tests-compiled.lisp, + test/lisp/ansi/ansi-tests-interpreted.lisp, + test/lisp/ansi/package.lisp: + Incremental improvement to build.xml. + + 'abcl.jar.uptodate' saves more time in cases where abcl.jar does not + need to be updated by comparing timestamps on the filesystem. + + Move scripts to load ANSI tests under 'test/lisp'. + + Further information added to ANSI test logs. + [4f95ec16bb2f] + +2009-01-24 ehuelsmann + + * src/org/armedbear/lisp/BuiltInClass.java, + src/org/armedbear/lisp/SimpleString.java: + [svn r11587] Ofcourse, you need all components for a commit to + actually work... (Belongs to last commit.) + [bc97132a2b27] + +2009-01-24 ehuelsmann + + * src/org/armedbear/lisp/subtypep.lisp: + [svn r11586] Eliminate the pesky beeps in TYPE-OF.1; however + unfortunately, this breaks TYPE-OF.4 for the case of "". Now go and + search! + [890b1d383c9d] + +2009-01-24 ehuelsmann + + * src/org/armedbear/lisp/subtypep.lisp: + [svn r11585] Update type mapping table in agreement to our earlier + finding that in our lisp simple-strings are also base-strings. + [47c7d919475d] + +2009-01-24 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11584] Handle both 'long' as well as 'double' argument and + return types as types of size 2 regardless of whether we have those + types now (we will later on...) + [e67485cc6877] + +2009-01-24 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11583] Revert change to p2-minus: we can't do this without + adding a new LispObject primitive operation, which I tried, but + takes too long for now. + + Note: the operation required would be negateAndAdd(int/long), which + is easy except for that you need to add it to all number + primitives... + [139b96a2c9e1] + +2009-01-24 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp, + src/org/armedbear/lisp/opcodes.lisp: + [svn r11582] Use additional opcodes: don't store the "obvious" + constants in the constant pool. + [7f4a14ba4706] + +2009-01-24 vvoutilainen + + * src/org/armedbear/lisp/Pathname.java: + [svn r11581] Make directory listing tolerate invalid paths and + permission errors. Note: clisp raises errors on permission denied, + sbcl doesn't and returns NIL. This patch makes abcl mirror sbcl + behaviour, so it returns NIL instead of raising errors. + [58405b30645e] + +2009-01-24 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11580] Commit some of the changes required for FLOAT and + DOUBLE support (clean up my wc a bit) + + - Add debugging output before triggering an ASSERT or AVER. + - Add boxing/unboxing routines (for future use). + - Add a new type (also for future use). + [c85a8fbde89f] + +2009-01-24 ehuelsmann + + * src/org/armedbear/lisp/Bignum.java, + src/org/armedbear/lisp/DoubleFloat.java, + src/org/armedbear/lisp/Fixnum.java, + src/org/armedbear/lisp/LispObject.java, + src/org/armedbear/lisp/Ratio.java, + src/org/armedbear/lisp/SingleFloat.java: + [svn r11579] Add floatValue() and doubleValue() to LispObject and + all number classes which didn't have it yet. + [43e271f54498] + +2009-01-24 ehuelsmann + + * build.xml, src/org/armedbear/lisp/compiler-pass2.lisp, + test/lisp/ansi/package.lisp: + [svn r11578] Miscelanious: + - Merge [within p2-plus] (fixnum-type-p type2) case with (fixnum- + type-p type1) + - Add some cases handled by p2-plus to p2-minus too. + - Fix parenthetical error + [fe6c37b7c6fb] + +2009-01-23 vvoutilainen + + * src/org/armedbear/lisp/directory.lisp, + src/org/armedbear/lisp/pathnames.lisp: + [svn r11577] Support "partial" wildcards in DIRECTORY, like + "/path/somewh*re/foo*.txt". This also makes cl-bench report.lisp + work with either CL*.* (the form in report.lisp) or CL* (the form + which is the only one that clisp works with). + [c0a01ac6914e] + +2009-01-23 mevenson + + * abcl.asd, src/org/armedbear/lisp/tests/compiler-tests.lisp, + src/org/armedbear/lisp/tests/condition-tests.lisp, + src/org/armedbear/lisp/tests/file-system-tests.lisp, + src/org/armedbear/lisp/tests/java-tests.lisp, + src/org/armedbear/lisp/tests/jl-config.cl, + src/org/armedbear/lisp/tests/math-tests.lisp, + src/org/armedbear/lisp/tests/misc-tests.lisp, + src/org/armedbear/lisp/tests/pathname-tests.lisp, + src/org/armedbear/lisp/tests/rt-package.lisp, + src/org/armedbear/lisp/tests/rt.lisp, src/org/armedbear/lisp/tests + /test-utilities.lisp, test/lisp/abcl/compiler-tests.lisp, + test/lisp/abcl/condition-tests.lisp, test/lisp/abcl/file-system- + tests.lisp, test/lisp/abcl/java-tests.lisp, test/lisp/abcl/jl- + config.cl, test/lisp/abcl/math-tests.lisp, test/lisp/abcl/misc- + tests.lisp, test/lisp/abcl/pathname-tests.lisp, test/lisp/abcl/rt- + package.lisp, test/lisp/abcl/rt.lisp, test/lisp/abcl/test- + utilities.lisp: + [svn r11576] Move internal ABCL tests to proper hierarchy. + + Loading via ASDF not finished. + [d0d7c350e8c7] + +2009-01-22 ehuelsmann + + * src/org/armedbear/lisp/AbstractArray.java, + src/org/armedbear/lisp/AbstractBitVector.java: + [svn r11575] Eliminate the FastStringBuffer (from AbstractArray and + AbstractBitVector). + + Patch by: Philip Hudson + + Note: In this category, more patches are expected. + [88fc35410bc9] + +2009-01-21 ehuelsmann + + * src/org/armedbear/lisp/Bignum.java, + src/org/armedbear/lisp/Fixnum.java, + src/org/armedbear/lisp/LispInteger.java: + [svn r11574] Introduce LispInteger super-type to Bignum and Fixnum: + The LispInteger logically can return both Bignum as well as Fixnum + values for its getInstance() method. + [86f07368f547] + +2009-01-21 ehuelsmann + + * src/org/armedbear/lisp/Bignum.java, + src/org/armedbear/lisp/DoubleFloat.java, + src/org/armedbear/lisp/LispCharacter.java, + src/org/armedbear/lisp/LispObject.java, + src/org/armedbear/lisp/SingleFloat.java: + [svn r11573] Add a 'getInstance' static method to all lisp classes + which have a compiler primitive for (part of) their domain. + [90dffbf0a463] + +2009-01-21 ehuelsmann + + * abcl.asd, src/org/armedbear/lisp/FloatFunctions.java: + [svn r11572] Fix NO-EXTRA-SYMBOLS-EXPORTED-FROM-COMMON-LISP. + [65413c092a58] + +2009-01-19 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11571] Implement some building blocks for compilation of float + math to byte code: + - Constant compilation to specific representations + - Boxing/unboxing of float/double values + + See #41. + [f102229efef4] + +2009-01-19 mevenson + + * build.xml: + [svn r11570] Refactored Ant-based build to decrease compilation + time. + + targets are *always* invoked, so refactoring these out + them enables 'abcl.stamp' to not doubly invoke compile.lisp. + + Remove odd references to J. + + 'abcl.init' replaces 'abcl.pre-compile' for aesthetic reasons. + [aa2b8fa07dc7] + +2009-01-19 ehuelsmann + + * src/org/armedbear/lisp/FloatFunctions.java, src/org/armedbear/lisp + /compiler-pass2.lisp, src/org/armedbear/lisp/jvm.lisp: + [svn r11569] Eliminate float-serializing ambiguities: if you need a + float/double, store one (instead of reading it from a string). + [dcc790fe7c8e] + +2009-01-18 ehuelsmann + + * src/org/armedbear/lisp/compile-file.lisp: + [svn r11568] Restore *read-base* and *read-default-float-format* + after compiling a file. + + They could have been changed (and in our case the latter *is*) + during file compilation. + [59d579de8aaa] + +2009-01-18 ehuelsmann + + * src/org/armedbear/lisp/format.lisp: + [svn r11567] Use the same lines as in SBCL to make sure SCALE- + EXPONENT works for all float types. + [788946584195] + +2009-01-18 ehuelsmann + + * src/org/armedbear/lisp/dump-form.lisp: + [svn r11566] Make sure to dump all floats with exponent marker, + because when loaded, the default may differ. + [0e717d982566] + +2009-01-18 ehuelsmann + + * src/org/armedbear/lisp/inspect.lisp: + [svn r11565] Fix thinko: it's not "unless", it's "when" ext + :*inspector-hook* is bound to a non-NIL value. + [7117d04d7fe1] + +2009-01-18 ehuelsmann + + * src/org/armedbear/lisp/compiler-pass2.lisp: + [svn r11564] Fix compiler issue found by compiling AP5: Instead of + calculating the true upper bound (which may become a number as big + as 2^most-positive-fixnum), return '* as the upper bound instead. + The number won't fit into a fixnum anyway. + [b203572e0d37] + +2009-01-18 mevenson + + * test/lisp/cl-bench.asd, test/lisp/cl-bench/cl-bench.asd: + [svn r11563] Arrangin directory structure for Lisp-based test + suites. + [3dc469a8e724] + +2009-01-17 ehuelsmann + + * src/org/armedbear/lisp/AbstractArray.java, + src/org/armedbear/lisp/BasicVector_UnsignedByte16.java, + src/org/armedbear/lisp/BasicVector_UnsignedByte32.java, + src/org/armedbear/lisp/BasicVector_UnsignedByte8.java, + src/org/armedbear/lisp/ComplexArray.java, + src/org/armedbear/lisp/ComplexArray_UnsignedByte32.java, + src/org/armedbear/lisp/ComplexArray_UnsignedByte8.java, + src/org/armedbear/lisp/ComplexBitVector.java, + src/org/armedbear/lisp/ComplexString.java, + src/org/armedbear/lisp/ComplexVector.java, + src/org/armedbear/lisp/ComplexVector_UnsignedByte32.java, + src/org/armedbear/lisp/ComplexVector_UnsignedByte8.java, + src/org/armedbear/lisp/SimpleArray_T.java, + src/org/armedbear/lisp/SimpleArray_UnsignedByte16.java, + src/org/armedbear/lisp/SimpleArray_UnsignedByte32.java, + src/org/armedbear/lisp/SimpleArray_UnsignedByte8.java, + src/org/armedbear/lisp/SimpleBitVector.java, + src/org/armedbear/lisp/SimpleString.java, + src/org/armedbear/lisp/SimpleVector.java, + src/org/armedbear/lisp/ZeroRankArray.java, + src/org/armedbear/lisp/adjust_array.java: + [svn r11562] Change and document the internal adjustArray() + protocol: we can't use NIL as a marker for "absent initial + contents": It's valid for ZeroRankArray. + [ecfbf2a2085f] + +2009-01-17 Mark Evenson + + * (0.12.32): + + [svn r11561] Don't check the value of initialContent to see whether it was provided; it may be NIL. + [svn r11560] Followup to r11557: Fixes ADJUST-ARRAY for the special cases + [svn r11557] Fix ticket #28: Expressly adjustable array not adjustable. + [svn r11556] Fix the Lisp based build system to include with the new Java classes in src/org/armedbear/util. + [svn r11555] Remove unused variable. + +2009-01-14 Mark Evenson + + * (0.12.31): + + [svn r11553] Increase performance of LispThread.currentThread() by more than 50% (uncontended case). + [svn r11554] Followup to the introduction of compile-forms-and-maybe-emit-clear-values. + +2009-01-09 Mark Evenson + + * (0.12.30): + + [svn r11551] Change the return value of Environment.isDeclaredSpecial() to include the + [svn r11550] Silence compiler warnings about deleting "Unused function CALL-NEXT-METHOD": it's being added + [svn r11549] Silence compile warnings in SBCL by moving a function up. + [svn r11548] Remove bindArg duplication. + [svn r11547] For let, variable values must be bound after the let-forms. + [svn r11546] More fixes for the Ant target 'abcl.test'. + + +2009-01-09 Mark Evenson + + * (0.12.29): + + [svn r11535] Intermediate fix to remove double dupliation. + [svn r11536] Finished adding @Override annotations for Primitives.java. + [svn r11537] build.xml's target 'abcl.test' invokes the GCL ANSI-TEST interpreted tests by default. + [svn r11538] Added JUnit tests to Netbeans project. + [svn r11539] Empty statements cleanup + [svn r11540] Helper macro for defining inlining functions. + [svn r11541] Look, I can do conditionals in the middle of a + [svn r11542] Helper macro for declare-* functions that use hashtables. + [svn r11543] Little helper for p2-plus/minus/times. + [svn r11544] Add bounds checking and prepare for support for 'wide' instruction prefix. + [svn r11545] Another small helper for p2-plus/minus. + +2009-01-04 Mark Evenson + + * (0.12.28): + + [svn r11534] Helper function for creating a new fixnum and emitting + [svn r11533] Helper macro for p2-test-minusp/plusp/zerop/oddp/evenp. + [svn r11532] Helper function for p2-test-minusp/plusp/zerop. + [svn r11531] In preparation for further refactorings, a tiny change + [svn r11530] 'abcl.test' now invokes both Java and Lisp based tests. + +2009-01-03 Mark Evenson + + * (0.12.27): + + Manually re-merge inadvertly removed 'scripting' changes to the Java 5 codepath. + + * (0.12.26): + + [svn r11527] (Phil Hudson) Make FastStringBuffer an adapter to java-1.5's StringBuilder. + + * (0.12.25) + + [svn r11520] Make the compiler recognize subtypes while compiling THE forms. + [svn r11522] Helper function for p2-flet-process-compiland and + [svn r11523] Macro for temp files in p2-flet/labels-process-compiland. + [svn r11524] Tiny helper for checking that class file is loadable. + [svn r11525] Helper function for fixnum initializations. + [svn r11526] Make Throw.java do as Lisp.java and LispThread.java: create a human-readable tag for the + +2008-12-31 Mark Evenson + + * (0.12.24) + + [svn r11514] CompiledClosure should delegate to CTF.execute, not CTF._execute. + [svn r11515] Remove references to building 'j' in the 'abcl' build.xml. + [svn r11516] Documentation of variable-info fields. + [svn r11517] Replace Java type indicator with pre-existing constant with the same purpose. + [svn r11518] Eliminate dead code. + [svn r11519] Remove code repetition in the beginning of p2-compiland. + +2008-12-30 Mark Evenson + + * (0.12.23): added from svn:common-lisp:trunk: + + [svn r11513] Update ABCL<-->Java example instructions. + [svn r11512] Duplicate (clone) the ClosureTemplateFunction in + [svn r11511] Use replacement characters for unmappable and malformed + [svn r11510] Remove old build artifacts that no longer work or are referenced in maintable ways. + + * (0.12.22): added from svn:common-lisp:trunk: + + [svn r11509] Remove Cons special case from car/cdr, it doesn't seem + [svn r11508] Cleanup: `, -> (nothing); (EMIT 'LABEL ...) -> (LABEL ...) + [svn r11507] Emit the most efficient ALOAD and ASTORE instructions. + + Added: branches/0.13.x/abcl/doc/ABCL-SLIME ============================================================================== --- (empty file) +++ branches/0.13.x/abcl/doc/ABCL-SLIME Wed Feb 18 12:09:02 2009 @@ -0,0 +1,23 @@ +ABCL 0.13 runs against SLIME CVS HEAD of 2009-02-14 with the following +errata. + +[001] *standard-output* is not correctly bound to the appropiate + SLIME-OUTPUT-STREAM on the statup of the REPL. + + WORKAROUND: Evaluate a self-quoting numeric form in the + *inferior-lisp* buffer including the [RETURN] + character. The REPL returns the self-qoting form + establishing the correct bindings for the + CONNECTION. + + +#| +;; Swank started at port: 63344. +CL-USER> +WARNING: Test failed: (EVAL-WHEN (&ANY :COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) &BODY BODY) => "(eval-when (&any :compile-toplevel :load-toplevel :execute) &body + body)" + Expected: "(eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)" + + 42 [RETURN] + +|# \ No newline at end of file Modified: branches/0.13.x/abcl/src/org/armedbear/lisp/trace.lisp ============================================================================== --- branches/0.13.x/abcl/src/org/armedbear/lisp/trace.lisp (original) +++ branches/0.13.x/abcl/src/org/armedbear/lisp/trace.lisp Wed Feb 18 12:09:02 2009 @@ -34,12 +34,18 @@ (export 'untraced-function) ;; For FIND-GENERIC-FUNCTION in clos.lisp. (require "FORMAT") - (defvar *trace-info-hashtable* (make-hash-table :test #'equal)) (defstruct trace-info name untraced-function breakp) -(defvar *trace-depth* 0) +(defvar *trace-depth* 0 + "Current depth of stack push for use of TRACE facility.") + + +;;; XXX This eventually blows up in the compiler.How can we "punt" on this and MAKE-LOAD-FORM ??? +(require "CLOS") +(defmethod make-load-form ((object trace-info) &optional environment) + (make-load-form-saving-slots object :environment environment)) (defun list-traced-functions () (copy-list *traced-names*)) @@ -116,6 +122,18 @@ (let ((*traced-names* '())) (setf (fdefinition name) traced-function))))) +(defun untraced-function (name) + (let ((info (gethash name *trace-info-hashtable*))) + (and info (trace-info-untraced-function info)))) + +(defun trace-redefined-update (name untraced-function) + (when (and *traced-names* (find name *traced-names* :test #'equal)) + (let* ((info (gethash name *trace-info-hashtable*)) + (traced-function (traced-function name info untraced-function))) + (setf (trace-info-untraced-function info) untraced-function) + (let ((*traced-names* '())) + (setf (fdefinition name) traced-function))))) + (defun indent (string) (concatenate 'string (make-string (* (1+ *trace-depth*) 2) :initial-element #\space) From mevenson at common-lisp.net Wed Feb 18 12:10:41 2009 From: mevenson at common-lisp.net (Mark Evenson) Date: Wed, 18 Feb 2009 12:10:41 +0000 Subject: [armedbear-cvs] r11662 - in branches/0.13.x/abcl: doc src/org/armedbear/lisp Message-ID: Author: mevenson Date: Wed Feb 18 12:10:40 2009 New Revision: 11662 Log: Mark version as abcl-0.12.42. Update SLIME documentation. Modified: branches/0.13.x/abcl/doc/ABCL-SLIME branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java Modified: branches/0.13.x/abcl/doc/ABCL-SLIME ============================================================================== --- branches/0.13.x/abcl/doc/ABCL-SLIME (original) +++ branches/0.13.x/abcl/doc/ABCL-SLIME Wed Feb 18 12:10:40 2009 @@ -1,4 +1,4 @@ -ABCL 0.13 runs against SLIME CVS HEAD of 2009-02-14 with the following +ABCL 0.13 runs against SLIME CVS HEAD of 2009-02-17 with the following errata. [001] *standard-output* is not correctly bound to the appropiate @@ -10,6 +10,8 @@ establishing the correct bindings for the CONNECTION. + You should see a CL-USER> prompt appear in the + *inferior-lisp* buffer. #| ;; Swank started at port: 63344. Modified: branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java ============================================================================== --- branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java (original) +++ branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java Wed Feb 18 12:10:40 2009 @@ -41,6 +41,6 @@ public static String getVersion() { - return "0.13.0-dev"; + return "0.12.42"; } } From mevenson at common-lisp.net Wed Feb 18 12:12:21 2009 From: mevenson at common-lisp.net (Mark Evenson) Date: Wed, 18 Feb 2009 12:12:21 +0000 Subject: [armedbear-cvs] r11663 - branches/0.13.x/abcl Message-ID: Author: mevenson Date: Wed Feb 18 12:12:21 2009 New Revision: 11663 Log: Patch CLISP build as per http://trac.common-lisp.net/armedbear/changeset/11660. Modified: branches/0.13.x/abcl/build-abcl.lisp Modified: branches/0.13.x/abcl/build-abcl.lisp ============================================================================== --- branches/0.13.x/abcl/build-abcl.lisp (original) +++ branches/0.13.x/abcl/build-abcl.lisp Wed Feb 18 12:12:21 2009 @@ -106,7 +106,7 @@ (ext:cd old-directory))) (cond ((numberp status) status) - ((eq status t) + ((or (eq status t) (null status)) ;; clisp 2.47 returns NIL on success 0) (t -1)))) From vvoutilainen at common-lisp.net Wed Feb 18 19:24:50 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Wed, 18 Feb 2009 19:24:50 +0000 Subject: [armedbear-cvs] r11664 - branches/0.13.x/abcl Message-ID: Author: vvoutilainen Date: Wed Feb 18 19:24:48 2009 New Revision: 11664 Log: Make the same license text 'refactorings' as were made in trunk. This is not a license change, it just shuffles text around to places with which people are probably more familiar, in case of GPL. Removed: branches/0.13.x/abcl/LICENSE Modified: branches/0.13.x/abcl/COPYING Modified: branches/0.13.x/abcl/COPYING ============================================================================== --- branches/0.13.x/abcl/COPYING (original) +++ branches/0.13.x/abcl/COPYING Wed Feb 18 19:24:48 2009 @@ -1,12 +1,283 @@ -The software in this package is distributed under the GNU General Public -License (with a special exception described below). + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 -A copy of GNU General Public License (GPL) is included in this distribution, in -the file LICENSE. + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. -Linking this software statically or dynamically with other modules is making a -combined work based on this software. Thus, the terms and conditions of the GNU -General Public License cover the whole combination. + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + 13. Linking this library statically or dynamically with other modules is making a combined work based on this library. Thus, the terms and conditions of the GNU General Public License cover the whole combination. As a special exception, the copyright holders of this software give you permission to link this software with independent modules to produce an @@ -18,3 +289,60 @@ software, you may extend this exception to your version of the software, but you are not obligated to do so. If you do not wish to do so, delete this exception statement from your version. + + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + 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 + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19yy name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice From vvoutilainen at common-lisp.net Wed Feb 18 19:38:12 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Wed, 18 Feb 2009 19:38:12 +0000 Subject: [armedbear-cvs] r11665 - trunk/abcl Message-ID: Author: vvoutilainen Date: Wed Feb 18 19:38:10 2009 New Revision: 11665 Log: Add a mention about classpath exception in the beginning of the file. Modified: trunk/abcl/COPYING Modified: trunk/abcl/COPYING ============================================================================== --- trunk/abcl/COPYING (original) +++ trunk/abcl/COPYING Wed Feb 18 19:38:10 2009 @@ -1,3 +1,6 @@ +The software in this package is distributed under the GNU General Public +License (with a special exception described below as 13th term). + GNU GENERAL PUBLIC LICENSE Version 2, June 1991 From vvoutilainen at common-lisp.net Wed Feb 18 19:38:48 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Wed, 18 Feb 2009 19:38:48 +0000 Subject: [armedbear-cvs] r11666 - branches/0.13.x/abcl Message-ID: Author: vvoutilainen Date: Wed Feb 18 19:38:47 2009 New Revision: 11666 Log: Merge latest trunk modification. Modified: branches/0.13.x/abcl/COPYING Modified: branches/0.13.x/abcl/COPYING ============================================================================== --- branches/0.13.x/abcl/COPYING (original) +++ branches/0.13.x/abcl/COPYING Wed Feb 18 19:38:47 2009 @@ -1,3 +1,6 @@ +The software in this package is distributed under the GNU General Public +License (with a special exception described below as 13th term). + GNU GENERAL PUBLIC LICENSE Version 2, June 1991 From ehuelsmann at common-lisp.net Wed Feb 18 21:41:37 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Wed, 18 Feb 2009 21:41:37 +0000 Subject: [armedbear-cvs] r11667 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Wed Feb 18 21:41:34 2009 New Revision: 11667 Log: Move the binding of *PRINT-LENGTH* outside of the inner REPL-loop; now it only gets re-bound upon the TOP-LEVEL restart. Modified: trunk/abcl/src/org/armedbear/lisp/top-level.lisp Modified: trunk/abcl/src/org/armedbear/lisp/top-level.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/top-level.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/top-level.lisp Wed Feb 18 21:41:34 2009 @@ -401,13 +401,13 @@ (defparameter *repl-read-form-fun* #'repl-read-form-fun) (defun repl (&optional (in *standard-input*) (out *standard-output*)) - (loop - (let* ((form (funcall *repl-read-form-fun* in out)) - (results (multiple-value-list (sys:interactive-eval form))) - (*print-length* 10)) - (dolist (result results) - (fresh-line out) - (prin1 result out))))) + (let* ((*print-length* 10)) + (loop + (let* ((form (funcall *repl-read-form-fun* in out)) + (results (multiple-value-list (sys:interactive-eval form)))) + (dolist (result results) + (fresh-line out) + (prin1 result out)))))) (defun top-level-loop () (fresh-line) From ehuelsmann at common-lisp.net Thu Feb 19 07:29:23 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Thu, 19 Feb 2009 07:29:23 +0000 Subject: [armedbear-cvs] r11668 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Feb 19 07:29:20 2009 New Revision: 11668 Log: Prevent CLOS from kicking in on TRACE; makes sure the compiler doesn't get called to compile an effective-method-function. Enables TRACEing the compiler. Modified: trunk/abcl/src/org/armedbear/lisp/trace.lisp Modified: trunk/abcl/src/org/armedbear/lisp/trace.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/trace.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/trace.lisp Thu Feb 19 07:29:20 2009 @@ -34,8 +34,6 @@ (export 'untraced-function) ;; For FIND-GENERIC-FUNCTION in clos.lisp. (require "FORMAT") -(require "CLOS") ;; XXX This eventually blows up in the compiler, but - ;; works for a while. (defvar *trace-info-hashtable* (make-hash-table :test #'equal)) @@ -43,9 +41,6 @@ (defvar *trace-depth* 0 "Current depth of stack push for use of TRACE facility.") -;; XXX How can we "punt" on this form ??? -(defmethod make-load-form ((object trace-info) &optional environment) - (make-load-form-saving-slots object :environment environment)) (defun list-traced-functions () (copy-list *traced-names*)) @@ -63,9 +58,8 @@ (setf breakp (nth (1+ index) args)) (setf args (append (subseq args 0 index) (subseq args (+ index 2)))))) (dolist (arg args) - (let ((info (make-trace-info :name arg - :breakp breakp))) - (push `(trace-1 ',arg ,info) results))) + (push `(trace-1 ',arg (make-trace-info :name ',arg + :breakp ,breakp)) results)) `(list ,@(nreverse results)))) (defun trace-1 (name info) From mevenson at common-lisp.net Thu Feb 19 07:30:46 2009 From: mevenson at common-lisp.net (Mark Evenson) Date: Thu, 19 Feb 2009 07:30:46 +0000 Subject: [armedbear-cvs] r11669 - branches/0.13.x/abcl/src/org/armedbear/lisp Message-ID: Author: mevenson Date: Thu Feb 19 07:30:45 2009 New Revision: 11669 Log: Merged fix from r11667 for toplevel REPL bad interaction with *PRINT-LEVEL. Modified: branches/0.13.x/abcl/src/org/armedbear/lisp/top-level.lisp Modified: branches/0.13.x/abcl/src/org/armedbear/lisp/top-level.lisp ============================================================================== --- branches/0.13.x/abcl/src/org/armedbear/lisp/top-level.lisp (original) +++ branches/0.13.x/abcl/src/org/armedbear/lisp/top-level.lisp Thu Feb 19 07:30:45 2009 @@ -401,13 +401,13 @@ (defparameter *repl-read-form-fun* #'repl-read-form-fun) (defun repl (&optional (in *standard-input*) (out *standard-output*)) - (loop - (let* ((form (funcall *repl-read-form-fun* in out)) - (results (multiple-value-list (sys:interactive-eval form))) - (*print-length* 10)) - (dolist (result results) - (fresh-line out) - (prin1 result out))))) + (let* ((*print-length* 10)) + (loop + (let* ((form (funcall *repl-read-form-fun* in out)) + (results (multiple-value-list (sys:interactive-eval form)))) + (dolist (result results) + (fresh-line out) + (prin1 result out)))))) (defun top-level-loop () (fresh-line) From mevenson at common-lisp.net Thu Feb 19 07:55:55 2009 From: mevenson at common-lisp.net (Mark Evenson) Date: Thu, 19 Feb 2009 07:55:55 +0000 Subject: [armedbear-cvs] r11670 - in branches/0.13.x/abcl: . doc Message-ID: Author: mevenson Date: Thu Feb 19 07:55:54 2009 New Revision: 11670 Log: Continued iteration of documentation for release. Added: branches/0.13.x/abcl/NEWS branches/0.13.x/abcl/doc/TESTS Modified: branches/0.13.x/abcl/README Added: branches/0.13.x/abcl/NEWS ============================================================================== --- (empty file) +++ branches/0.13.x/abcl/NEWS Thu Feb 19 07:55:54 2009 @@ -0,0 +1,8 @@ +abcl-0.13 + + JSR-232 (aka scripting) support thanks to Alessio Stalla + (requires Java 6). + + [...] + + See ChangeLog for blow-by-blow. \ No newline at end of file Modified: branches/0.13.x/abcl/README ============================================================================== --- branches/0.13.x/abcl/README (original) +++ branches/0.13.x/abcl/README Thu Feb 19 07:55:54 2009 @@ -1,8 +1,9 @@ GENERAL INFORMATION =================== -Armed Bear Common Lisp is an implementation of ANSI Common Lisp that -runs in a Java virtual machine. It compiles its code to Java byte code. +ABCL (Armed Bear Common Lisp) is an implementation of ANSI Common Lisp +that runs in a Java virtual machine. It compiles its code to Java +byte code. LICENSE @@ -36,15 +37,15 @@ ======== If you want to build ABCL, you have 3 options. The first option -applies when you come from a lisp background. The second and thirds +applies when you come from a Lisp background. The second and thirds options are more appropriate when you come from Java development: - I) Bootstrap ABCL using a Common Lisp implementation - Supported implementations for this process: SBCL, CMUCL, OpenMCL, - Allegro CL, LispWorks or CLISP. + I) Bootstrap ABCL using a Common Lisp implementation Supported + implementations for this process: SBCL, CMUCL, OpenMCL, Allegro + CL, LispWorks or CLISP. II) Use the Ant make-like build tool for Java environments - The tested lowest working version is Ant 1.7.0. + The tested lowest working version is Ant 1.7.0. III) Use the Netbeans 6.x IDE to open ABCL as a project. @@ -107,11 +108,12 @@ BUGS ==== -A lot of (renewed) energy has been spent to make ABCL a compliant -and practically useable Common Lisp implementation. Because of this, -ABCL 0.0.11 now fails only 47 out of 21702 tests in the ANSI CL test -suite. Next to that, the fail count of the Maxima test suite has been -reduced from over 1400 in 0.0.10 to little more than 600 in 0.0.11. +A lot of (renewed) energy has been spent to make ABCL a compliant and +practically useable Common Lisp implementation. Because of this, ABCL +0.0.13 now fails only 50 out of 21702 tests in the ANSI CL test suite. +Next to that, the fail count of the Maxima test suite has been reduced +from over 1400 in 0.0.10 to little more than 600 in 0.0.11, to xxx in +0.13. ABCL's CLOS does not handle on-the-fly redefinition of classes correctly, and in any event is intolerably slow. There is no support @@ -132,4 +134,4 @@ On behalf of all ABCL development team and contributors, Erik Huelsmann -October 18, 2008 +Feburary 21, 2009 Added: branches/0.13.x/abcl/doc/TESTS ============================================================================== --- (empty file) +++ branches/0.13.x/abcl/doc/TESTS Thu Feb 19 07:55:54 2009 @@ -0,0 +1,28 @@ +# ABCL Tests + + +## Internal tests (shipped with ABCL) + +1. Java tests (based on Junit) + +2. Lisp tests (based on RT) + +[Instructions for how to run tests.] + + +## External tests + +1. ANSI GCL tests + +Create a sibling directory of 'abcl' called 'ansi-tests' containing +the [ANSI GCL tests][1]. + +Invoke via 'abcl.test' target in Ant or by :force t on the ASDF +'ANSI-COMPILED' or 'ANSI-INTERPRETED' systems. + +[1]: svn://common-lisp.net/project/ansi-test/svn/trunk/ansi-tests + +## Test results + +[Describe current status of test results.] + From mevenson at common-lisp.net Thu Feb 19 08:54:50 2009 From: mevenson at common-lisp.net (Mark Evenson) Date: Thu, 19 Feb 2009 08:54:50 +0000 Subject: [armedbear-cvs] r11671 - in branches/0.13.x/abcl: . src/org/armedbear/lisp Message-ID: Author: mevenson Date: Thu Feb 19 08:54:48 2009 New Revision: 11671 Log: Merge removal of CLOS from TRACE from trunk by Erik in r11668. Update ChangeLog. Bless as abcl-0.12.43. Modified: branches/0.13.x/abcl/ChangeLog branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java branches/0.13.x/abcl/src/org/armedbear/lisp/trace.lisp Modified: branches/0.13.x/abcl/ChangeLog ============================================================================== --- branches/0.13.x/abcl/ChangeLog (original) +++ branches/0.13.x/abcl/ChangeLog Thu Feb 19 08:54:48 2009 @@ -1,3 +1,82 @@ +2009-02-19 ehuelsmann + + * src/org/armedbear/lisp/trace.lisp: + [svn r11668] Prevent CLOS from kicking in on TRACE; makes sure the + compiler doesn't get called to compile an effective-method- + function. Enables TRACEing the compiler. + [ce9fac0d5de7] [tip] + +2009-02-18 ehuelsmann + + * src/org/armedbear/lisp/top-level.lisp: + [svn r11667] Move the binding of *PRINT-LENGTH* outside of the inner + REPL-loop; now it only gets re-bound upon the TOP-LEVEL restart. + [a33371702612] + +2009-02-18 vvoutilainen + + * COPYING: + [svn r11665] Add a mention about classpath exception in the + beginning of the file. + [c798d072e18a] + +2009-02-19 Mark + + * LICENSE, build-abcl.lisp, build.xml, + src/org/armedbear/lisp/trace.lisp: + Interrmediate checkin on path to candidate release for TRACE. + + Start of 'build-abcl.lisp' normalization. + + Merge through [svn r11660]. + [71a1ef1a6a2a] + +2009-02-15 ehuelsmann + + * build-abcl.lisp: + [svn r11660] Fix our lisp based build for CLISP 2.47 (and hopefully + from there onwards). + [f29f8cbf0e42] + +2009-02-14 mevenson + + * src/org/armedbear/lisp/trace.lisp: + [svn r11659] Re-enable compilation of TRACE forms. + + Introduces a bug by including a reference to CLOS in the TRACE + facility, which makes tracing of forms that access the compiler + (FORMAT et. al.) problematic. + + Proposed solution to ship as 0.13.0. --Mark + [3a1b97072c14] + +2009-02-14 vvoutilainen + + * COPYING, LICENSE: + [svn r11658] Move GPLv2 text to COPYING, append Classpath exception + to COPYING, delete LICENSE. + [ef6c55d91667] + +2009-02-12 Mark + + * bugs/trace-1.lisp, src/org/armedbear/lisp/trace.lisp: + Reverted first two fixes of r11627 to fix TRACE. + + Problems interacting with SLIME. + [aee2bfc511c4] + +2009-02-11 Mark + + * ChangeLog: + Merge through svn r11655. + [c848818df171] + +2009-02-10 mevenson + + * COPYING: + [svn r11655] Change reference from COPYING to LICENSE. + [adc9feb07f46] + 2009-02-10 mevenson * COPYING: Modified: branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java ============================================================================== --- branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java (original) +++ branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java Thu Feb 19 08:54:48 2009 @@ -41,6 +41,6 @@ public static String getVersion() { - return "0.12.42"; + return "0.12.43"; } } Modified: branches/0.13.x/abcl/src/org/armedbear/lisp/trace.lisp ============================================================================== --- branches/0.13.x/abcl/src/org/armedbear/lisp/trace.lisp (original) +++ branches/0.13.x/abcl/src/org/armedbear/lisp/trace.lisp Thu Feb 19 08:54:48 2009 @@ -34,6 +34,7 @@ (export 'untraced-function) ;; For FIND-GENERIC-FUNCTION in clos.lisp. (require "FORMAT") + (defvar *trace-info-hashtable* (make-hash-table :test #'equal)) (defstruct trace-info name untraced-function breakp) @@ -41,12 +42,6 @@ (defvar *trace-depth* 0 "Current depth of stack push for use of TRACE facility.") - -;;; XXX This eventually blows up in the compiler.How can we "punt" on this and MAKE-LOAD-FORM ??? -(require "CLOS") -(defmethod make-load-form ((object trace-info) &optional environment) - (make-load-form-saving-slots object :environment environment)) - (defun list-traced-functions () (copy-list *traced-names*)) @@ -63,9 +58,8 @@ (setf breakp (nth (1+ index) args)) (setf args (append (subseq args 0 index) (subseq args (+ index 2)))))) (dolist (arg args) - (let ((info (make-trace-info :name arg - :breakp breakp))) - (push `(trace-1 ',arg ,info) results))) + (push `(trace-1 ',arg (make-trace-info :name ',arg + :breakp ,breakp)) results)) `(list ,@(nreverse results)))) (defun trace-1 (name info) @@ -122,23 +116,13 @@ (let ((*traced-names* '())) (setf (fdefinition name) traced-function))))) -(defun untraced-function (name) - (let ((info (gethash name *trace-info-hashtable*))) - (and info (trace-info-untraced-function info)))) - -(defun trace-redefined-update (name untraced-function) - (when (and *traced-names* (find name *traced-names* :test #'equal)) - (let* ((info (gethash name *trace-info-hashtable*)) - (traced-function (traced-function name info untraced-function))) - (setf (trace-info-untraced-function info) untraced-function) - (let ((*traced-names* '())) - (setf (fdefinition name) traced-function))))) - (defun indent (string) (concatenate 'string (make-string (* (1+ *trace-depth*) 2) :initial-element #\space) string)) + + (defmacro untrace (&rest args) (cond ((null args) `(untrace-all)) From ehuelsmann at common-lisp.net Thu Feb 19 22:13:34 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Thu, 19 Feb 2009 22:13:34 +0000 Subject: [armedbear-cvs] r11672 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Feb 19 22:13:31 2009 New Revision: 11672 Log: Remove code duplication: use loadCompiledFunction(InputStream, int) instead of inlining code to the same extent. Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java 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 Thu Feb 19 22:13:31 2009 @@ -1010,39 +1010,8 @@ { long size = entry.getSize(); InputStream in = zipFile.getInputStream(entry); - byte[] bytes = new byte[(int)size]; - int bytesRemaining = (int) size; - int bytesRead = 0; - while (bytesRemaining > 0) - { - int n; - if (bytesRemaining >= 4096) - n = in.read(bytes, bytesRead, 4096); - else - n = in.read(bytes, bytesRead, bytesRemaining); - if (n < 0) - break; - bytesRead += n; - bytesRemaining -= n; - } - in.close(); - if (bytesRemaining > 0) - Debug.trace("bytesRemaining = " + bytesRemaining); - JavaClassLoader loader = new JavaClassLoader(); - Class c = - loader.loadClassFromByteArray(null, bytes, 0, bytes.length); - if (c != null) - { - Class[] parameterTypes = new Class[0]; - Constructor constructor = - c.getConstructor(parameterTypes); - Object[] initargs = new Object[0]; - LispObject obj = - (LispObject) constructor.newInstance(initargs); - if (obj instanceof Function) - ((Function)obj).setClassBytes(bytes); - return obj != null ? obj : NIL; - } + LispObject obj = loadCompiledFunction(in, (int) size); + return obj != null ? obj : NIL; } } finally From ehuelsmann at common-lisp.net Fri Feb 20 19:56:20 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Fri, 20 Feb 2009 19:56:20 +0000 Subject: [armedbear-cvs] r11673 - trunk/abcl Message-ID: Author: ehuelsmann Date: Fri Feb 20 19:56:16 2009 New Revision: 11673 Log: Trade with-current-directory macro for more lispy syntax. Modified: trunk/abcl/build-abcl.lisp Modified: trunk/abcl/build-abcl.lisp ============================================================================== --- trunk/abcl/build-abcl.lisp (original) +++ trunk/abcl/build-abcl.lisp Fri Feb 20 19:56:16 2009 @@ -53,17 +53,6 @@ (defparameter *path-separator-char* (if (eq *platform* :windows) #\; #\:)) -(defmacro with-current-directory ((directory) &body body) - `(let ((*default-pathname-defaults* ,directory) - #+clisp - (old-directory (ext:cd))) - #+clisp - (ext:cd ,directory) - (unwind-protect - (progn , at body) - #+clisp - (ext:cd old-directory) - ))) #+sbcl (defun run-shell-command (command &key directory (output *standard-output*)) @@ -256,10 +245,10 @@ (defun make-classes (force batch) (let* ((source-files - (append (with-current-directory (*abcl-dir*) - (directory "*.java")) - (with-current-directory ((merge-pathnames "util/" *abcl-dir*)) - (directory "*.java")))) + (mapcan #'(lambda (default) + (directory (merge-pathnames "*.java" default))) + (list *abcl-dir* + (merge-pathnames "util/" *abcl-dir*)))) (to-do ())) (if force (setf to-do source-files) @@ -437,15 +426,15 @@ (delete-file truename))))) (defun clean () - (with-current-directory (*build-root*) - (delete-files (list "abcl.jar"))) - (with-current-directory (*abcl-dir*) - (delete-files (directory "*.class")) - (delete-files (directory "*.abcl")) - (delete-files (directory "*.cls")) - (delete-files '("native.h" "libabcl.so" "build"))) - (with-current-directory ((merge-pathnames "java/awt/" *abcl-dir*)) - (delete-files (directory "*.class")))) + (dolist (f (list (list *build-root* "abcl.jar") + (list *abcl-dir* "*.class" "*.abcl" "*.cls" + "native.h" "libabcl.so" "build") + (list (merge-pathnames "java/awt/" *abcl-dir*) + "*.class"))) + (let ((default (car f))) + (delete-files (mapcan #'(lambda (name) + (directory (merge-pathnames name default))) + (cdr f)))))) (defun build-abcl (&key force (batch t) From ehuelsmann at common-lisp.net Fri Feb 20 20:17:16 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Fri, 20 Feb 2009 20:17:16 +0000 Subject: [armedbear-cvs] r11674 - trunk/abcl Message-ID: Author: ehuelsmann Date: Fri Feb 20 20:17:15 2009 New Revision: 11674 Log: More lispy MAKE-CLASSES. Modified: trunk/abcl/build-abcl.lisp Modified: trunk/abcl/build-abcl.lisp ============================================================================== --- trunk/abcl/build-abcl.lisp (original) +++ trunk/abcl/build-abcl.lisp Fri Feb 20 20:17:15 2009 @@ -245,25 +245,24 @@ (defun make-classes (force batch) (let* ((source-files - (mapcan #'(lambda (default) - (directory (merge-pathnames "*.java" default))) - (list *abcl-dir* - (merge-pathnames "util/" *abcl-dir*)))) - (to-do ())) - (if force - (setf to-do source-files) - (dolist (source-file source-files) - (let ((class-file (merge-pathnames (make-pathname :type "class" - :defaults source-file)))) - (when (or (null (probe-file class-file)) - (>= (file-write-date source-file) - (file-write-date class-file))) - (push source-file to-do))))) + (remove-if-not #'(lambda (name) + (let ((output-name + (make-pathname :type "class" + :defaults name))) + (or force + (null (probe-file output-name)) + (>= (file-write-date name) + (file-write-date output-name))))) + (mapcan #'(lambda (default) + (directory (merge-pathnames "*.java" + default))) + (list *abcl-dir* + (merge-pathnames "util/" *abcl-dir*)))))) (format t "~&JDK: ~A~%" *jdk*) (format t "Java compiler: ~A~%" *java-compiler*) (format t "Compiler options: ~A~%~%" (if *java-compiler-options* *java-compiler-options* "")) (finish-output) - (cond ((null to-do) + (cond ((null source-files) (format t "Classes are up to date.~%") (finish-output) t) @@ -272,7 +271,7 @@ (let* ((dir (pathname-directory *abcl-dir*)) (cmdline (with-output-to-string (s) (princ *java-compiler-command-line-prefix* s) - (dolist (source-file to-do) + (dolist (source-file source-files) (princ (if (equal (pathname-directory source-file) dir) (file-namestring source-file) @@ -282,7 +281,7 @@ (status (run-shell-command cmdline :directory *abcl-dir*))) (zerop status))) (t - (dolist (source-file to-do t) + (dolist (source-file source-files t) (unless (java-compile-file source-file) (format t "Build failed.~%") (return nil))))))))) From ehuelsmann at common-lisp.net Sat Feb 21 09:33:55 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sat, 21 Feb 2009 09:33:55 +0000 Subject: [armedbear-cvs] r11675 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Feb 21 09:33:53 2009 New Revision: 11675 Log: Support compiling the system to a different output path. COMPILE-FILE-IF-NEEDED needs to support other keywords (those applying to COMPILE-FILE) %COMPILE-SYSTEM adapted to merge the output path with the name of the file to compile. Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp trunk/abcl/src/org/armedbear/lisp/compile-system.lisp 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 Sat Feb 21 09:33:53 2009 @@ -478,7 +478,8 @@ (format t "~&; Wrote ~A (~A seconds)~%" (namestring output-file) elapsed)))) (values (truename output-file) warnings-p failure-p))) -(defun compile-file-if-needed (input-file &rest allargs &key force-compile) +(defun compile-file-if-needed (input-file &rest allargs &key force-compile + &allow-other-keys) (setf input-file (truename input-file)) (cond (force-compile (remf allargs :force-compile) Modified: trunk/abcl/src/org/armedbear/lisp/compile-system.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/compile-system.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/compile-system.lisp Sat Feb 21 09:33:53 2009 @@ -79,192 +79,201 @@ (dolist (file files) (grovel-java-definitions-in-file file stream)))))) -(defun %compile-system () +(defun %compile-system (&key output-path) (let ((*default-pathname-defaults* (pathname *lisp-home*)) - (*warn-on-redefinition* nil)) - (load (compile-file-if-needed "coerce.lisp")) - (load (compile-file-if-needed "open.lisp")) - (load (compile-file-if-needed "dump-form.lisp")) - (load (compile-file-if-needed "compiler-types.lisp")) - (load (compile-file-if-needed "compile-file.lisp")) - (load (compile-file-if-needed "precompiler.lisp")) - (load (compile-file-if-needed "compiler-pass1.lisp")) - (load (compile-file-if-needed "compiler-pass2.lisp")) - (load (compile-file-if-needed "jvm.lisp")) - (load (compile-file-if-needed "source-transform.lisp")) - (load (compile-file-if-needed "compiler-macro.lisp")) - (load (compile-file-if-needed "opcodes.lisp")) - (load (compile-file-if-needed "setf.lisp")) - (load (compile-file-if-needed "substitute.lisp")) - (load (compile-file-if-needed "clos.lisp")) - ;; Order matters for these files. - (mapc #'compile-file-if-needed '("collect.lisp" - "macros.lisp" - "loop.lisp")) - (load (compile-file-if-needed "backquote.lisp")) - (load (compile-file-if-needed "early-defuns.lisp")) - (load (compile-file-if-needed "typep.lisp")) - (load (compile-file-if-needed "subtypep.lisp")) - (load (compile-file-if-needed "find.lisp")) - (load (compile-file-if-needed "print.lisp")) - (load (compile-file-if-needed "pprint-dispatch.lisp")) - (load (compile-file-if-needed "pprint.lisp")) - (load (compile-file-if-needed "format.lisp")) - (load (compile-file-if-needed "delete.lisp")) - (load (compile-file-if-needed "concatenate.lisp")) - (load (compile-file-if-needed "ldb.lisp")) - (load (compile-file-if-needed "destructuring-bind.lisp")) - ;; But not for these. - (mapc #'compile-file-if-needed '("adjoin.lisp" - "and.lisp" - "apropos.lisp" - "arrays.lisp" - "asdf.lisp" - "assert.lisp" - "assoc.lisp" - "autoloads.lisp" - "aver.lisp" - "bit-array-ops.lisp" - "boole.lisp" - ;;"boot.lisp" - "butlast.lisp" - "byte-io.lisp" - "case.lisp" - "chars.lisp" - "check-type.lisp" - "compile-file-pathname.lisp" - "compile-system.lisp" - "compiler-error.lisp" - "cond.lisp" - "copy-seq.lisp" - "copy-symbol.lisp" - "count.lisp" - "debug.lisp" - "define-modify-macro.lisp" - "define-symbol-macro.lisp" - "defmacro.lisp" - "defpackage.lisp" - "defsetf.lisp" - "defstruct.lisp" - "deftype.lisp" - "delete-duplicates.lisp" - "deposit-field.lisp" - "describe.lisp" - "describe-compiler-policy.lisp" - "directory.lisp" - "disassemble.lisp" - "do-all-symbols.lisp" - "do-external-symbols.lisp" - "do-symbols.lisp" - "do.lisp" - "dolist.lisp" - "dotimes.lisp" - "dribble.lisp" - "dump-class.lisp" - "ed.lisp" - "enough-namestring.lisp" - "ensure-directories-exist.lisp" - "error.lisp" - "featurep.lisp" - "fdefinition.lisp" - "fill.lisp" - "find-all-symbols.lisp" - "gentemp.lisp" - "gray-streams.lisp" - "inline.lisp" - "inspect.lisp" - ;;"j.lisp" - "java.lisp" - "known-functions.lisp" - "known-symbols.lisp" - "late-setf.lisp" - "lcm.lisp" - "ldiff.lisp" - "list-length.lisp" - "list.lisp" - "load.lisp" - "make-hash-table.lisp" - "make-load-form-saving-slots.lisp" - "make-sequence.lisp" - "make-string-output-stream.lisp" - "make-string.lisp" - "map-into.lisp" - "map.lisp" - "map1.lisp" - "mask-field.lisp" - "member-if.lisp" - "mismatch.lisp" - "multiple-value-bind.lisp" - "multiple-value-list.lisp" - "multiple-value-setq.lisp" - "nsubstitute.lisp" - "nth-value.lisp" - "numbers.lisp" - "or.lisp" - "parse-integer.lisp" - "parse-lambda-list.lisp" - "pathnames.lisp" - "package.lisp" - "print-object.lisp" - "print-unreadable-object.lisp" - "proclaim.lisp" - "profiler.lisp" - "prog.lisp" - "psetf.lisp" - "query.lisp" - "read-conditional.lisp" - "read-from-string.lisp" - "read-sequence.lisp" - "reduce.lisp" - "remf.lisp" - "remove-duplicates.lisp" - "remove.lisp" - "replace.lisp" - "require.lisp" - "restart.lisp" - "revappend.lisp" - "rotatef.lisp" - "rt.lisp" - ;;"run-benchmarks.lisp" - "run-shell-command.lisp" - ;;"runtime-class.lisp" - "search.lisp" - "sequences.lisp" - "sets.lisp" - "shiftf.lisp" - "signal.lisp" - "socket.lisp" - "sort.lisp" - "step.lisp" - "strings.lisp" - "sublis.lisp" - "subst.lisp" - "tailp.lisp" - "time.lisp" - "top-level.lisp" - "trace.lisp" - "tree-equal.lisp" - "upgraded-complex-part-type.lisp" - "with-accessors.lisp" - "with-hash-table-iterator.lisp" - "with-input-from-string.lisp" - "with-mutex.lisp" - "with-open-file.lisp" - "with-output-to-string.lisp" - "with-package-iterator.lisp" - "with-slots.lisp" - "with-standard-io-syntax.lisp" - "with-thread-lock.lisp" - "write-sequence.lisp")) + (*warn-on-redefinition* nil)) + (unless output-path + (setf output-path *default-pathname-defaults*)) + (flet ((do-compile (file) + (print file) + (print output-path) + (let ((out (make-pathname :type "abcl" + :defaults (print (merge-pathnames + file output-path))))) + (compile-file-if-needed file :output-file out)))) + (load (do-compile "coerce.lisp")) + (load (do-compile "open.lisp")) + (load (do-compile "dump-form.lisp")) + (load (do-compile "compiler-types.lisp")) + (load (do-compile "compile-file.lisp")) + (load (do-compile "precompiler.lisp")) + (load (do-compile "compiler-pass1.lisp")) + (load (do-compile "compiler-pass2.lisp")) + (load (do-compile "jvm.lisp")) + (load (do-compile "source-transform.lisp")) + (load (do-compile "compiler-macro.lisp")) + (load (do-compile "opcodes.lisp")) + (load (do-compile "setf.lisp")) + (load (do-compile "substitute.lisp")) + (load (do-compile "clos.lisp")) + ;; Order matters for these files. + (mapc #'do-compile '("collect.lisp" + "macros.lisp" + "loop.lisp")) + (load (do-compile "backquote.lisp")) + (load (do-compile "early-defuns.lisp")) + (load (do-compile "typep.lisp")) + (load (do-compile "subtypep.lisp")) + (load (do-compile "find.lisp")) + (load (do-compile "print.lisp")) + (load (do-compile "pprint-dispatch.lisp")) + (load (do-compile "pprint.lisp")) + (load (do-compile "format.lisp")) + (load (do-compile "delete.lisp")) + (load (do-compile "concatenate.lisp")) + (load (do-compile "ldb.lisp")) + (load (do-compile "destructuring-bind.lisp")) + ;; But not for these. + (mapc #'do-compile '("adjoin.lisp" + "and.lisp" + "apropos.lisp" + "arrays.lisp" + "asdf.lisp" + "assert.lisp" + "assoc.lisp" + "autoloads.lisp" + "aver.lisp" + "bit-array-ops.lisp" + "boole.lisp" + ;;"boot.lisp" + "butlast.lisp" + "byte-io.lisp" + "case.lisp" + "chars.lisp" + "check-type.lisp" + "compile-file-pathname.lisp" + "compile-system.lisp" + "compiler-error.lisp" + "cond.lisp" + "copy-seq.lisp" + "copy-symbol.lisp" + "count.lisp" + "debug.lisp" + "define-modify-macro.lisp" + "define-symbol-macro.lisp" + "defmacro.lisp" + "defpackage.lisp" + "defsetf.lisp" + "defstruct.lisp" + "deftype.lisp" + "delete-duplicates.lisp" + "deposit-field.lisp" + "describe.lisp" + "describe-compiler-policy.lisp" + "directory.lisp" + "disassemble.lisp" + "do-all-symbols.lisp" + "do-external-symbols.lisp" + "do-symbols.lisp" + "do.lisp" + "dolist.lisp" + "dotimes.lisp" + "dribble.lisp" + "dump-class.lisp" + "ed.lisp" + "enough-namestring.lisp" + "ensure-directories-exist.lisp" + "error.lisp" + "featurep.lisp" + "fdefinition.lisp" + "fill.lisp" + "find-all-symbols.lisp" + "gentemp.lisp" + "gray-streams.lisp" + "inline.lisp" + "inspect.lisp" + ;;"j.lisp" + "java.lisp" + "known-functions.lisp" + "known-symbols.lisp" + "late-setf.lisp" + "lcm.lisp" + "ldiff.lisp" + "list-length.lisp" + "list.lisp" + "load.lisp" + "make-hash-table.lisp" + "make-load-form-saving-slots.lisp" + "make-sequence.lisp" + "make-string-output-stream.lisp" + "make-string.lisp" + "map-into.lisp" + "map.lisp" + "map1.lisp" + "mask-field.lisp" + "member-if.lisp" + "mismatch.lisp" + "multiple-value-bind.lisp" + "multiple-value-list.lisp" + "multiple-value-setq.lisp" + "nsubstitute.lisp" + "nth-value.lisp" + "numbers.lisp" + "or.lisp" + "parse-integer.lisp" + "parse-lambda-list.lisp" + "pathnames.lisp" + "package.lisp" + "print-object.lisp" + "print-unreadable-object.lisp" + "proclaim.lisp" + "profiler.lisp" + "prog.lisp" + "psetf.lisp" + "query.lisp" + "read-conditional.lisp" + "read-from-string.lisp" + "read-sequence.lisp" + "reduce.lisp" + "remf.lisp" + "remove-duplicates.lisp" + "remove.lisp" + "replace.lisp" + "require.lisp" + "restart.lisp" + "revappend.lisp" + "rotatef.lisp" + "rt.lisp" + ;;"run-benchmarks.lisp" + "run-shell-command.lisp" + ;;"runtime-class.lisp" + "search.lisp" + "sequences.lisp" + "sets.lisp" + "shiftf.lisp" + "signal.lisp" + "socket.lisp" + "sort.lisp" + "step.lisp" + "strings.lisp" + "sublis.lisp" + "subst.lisp" + "tailp.lisp" + "time.lisp" + "top-level.lisp" + "trace.lisp" + "tree-equal.lisp" + "upgraded-complex-part-type.lisp" + "with-accessors.lisp" + "with-hash-table-iterator.lisp" + "with-input-from-string.lisp" + "with-mutex.lisp" + "with-open-file.lisp" + "with-output-to-string.lisp" + "with-package-iterator.lisp" + "with-slots.lisp" + "with-standard-io-syntax.lisp" + "with-thread-lock.lisp" + "write-sequence.lisp"))) t)) -(defun compile-system (&key quit (zip t)) +(defun compile-system (&key quit (zip t) output-path) (let ((status -1)) (check-lisp-home) (time (with-compilation-unit () (let ((*compile-file-zip* zip)) - (%compile-system)) + (%compile-system :output-path output-path)) (when (zerop (+ jvm::*errors* jvm::*warnings*)) (setf status 0)))) (when quit From ehuelsmann at common-lisp.net Sat Feb 21 19:14:51 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sat, 21 Feb 2009 19:14:51 +0000 Subject: [armedbear-cvs] r11676 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Feb 21 19:14:48 2009 New Revision: 11676 Log: If we can't locate the lisp home location, fall back on a system property to specify it. Note: this change helps to implement out-of-tree Lisp-based builds. Modified: trunk/abcl/src/org/armedbear/lisp/Site.java Modified: trunk/abcl/src/org/armedbear/lisp/Site.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Site.java (original) +++ trunk/abcl/src/org/armedbear/lisp/Site.java Sat Feb 21 19:14:48 2009 @@ -56,7 +56,8 @@ } } } - } + } else + lispHome = System.getProperty("abcl.home"); LISP_HOME = lispHome; } From ehuelsmann at common-lisp.net Sat Feb 21 21:53:40 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sat, 21 Feb 2009 21:53:40 +0000 Subject: [armedbear-cvs] r11677 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Feb 21 21:53:38 2009 New Revision: 11677 Log: Remove accidentally committed debug PRINT forms. Modified: trunk/abcl/src/org/armedbear/lisp/compile-system.lisp Modified: trunk/abcl/src/org/armedbear/lisp/compile-system.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/compile-system.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/compile-system.lisp Sat Feb 21 21:53:38 2009 @@ -85,11 +85,9 @@ (unless output-path (setf output-path *default-pathname-defaults*)) (flet ((do-compile (file) - (print file) - (print output-path) (let ((out (make-pathname :type "abcl" - :defaults (print (merge-pathnames - file output-path))))) + :defaults (merge-pathnames + file output-path)))) (compile-file-if-needed file :output-file out)))) (load (do-compile "coerce.lisp")) (load (do-compile "open.lisp")) From ehuelsmann at common-lisp.net Sun Feb 22 15:13:47 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 22 Feb 2009 15:13:47 +0000 Subject: [armedbear-cvs] r11678 - trunk/abcl Message-ID: Author: ehuelsmann Date: Sun Feb 22 15:13:44 2009 New Revision: 11678 Log: Lisp builds store build-artifacts outside of the source tree (build/classes/) just like Ant. build-abcl.lisp: SUBSTITUTE-IN-STRING: replace multiple occurrences in 1 string. MAKE-CLASSES: Create output directories before using them; pass '-d' argument to javac for out-of-tree class file storage. MAKE-JAR: Create output directories before using them. DO-COMPILE-SYSTEM: Move platform specific bits into argument value calculation, one main code path remaining. Pass OUTPUT-PATH argument for out-of-tree *.cls/*.abcl storage. Create output directories before using them. MAKE-LAUNCH-SCRIPT: Don't point to source directory in the classpath; there are no *.class files anyway. Adjust for the fact that 'abcl.jar' is in dist/ now. CLEAN: Use a list of directories and file patterns. make-jar.bat.in, make-jar.in: Adapt for the fact that build artifacts are now in build/classes/. Modified: trunk/abcl/build-abcl.lisp trunk/abcl/make-jar.bat.in trunk/abcl/make-jar.in Modified: trunk/abcl/build-abcl.lisp ============================================================================== --- trunk/abcl/build-abcl.lisp (original) +++ trunk/abcl/build-abcl.lisp Sun Feb 22 15:13:44 2009 @@ -217,12 +217,15 @@ (defun substitute-in-string (string substitutions-alist) (dolist (entry substitutions-alist) - (let ((index (search (car entry) string :test #'string=))) - (when index - (setf string (concatenate 'string - (subseq string 0 index) - (cdr entry) - (subseq string (+ index (length (car entry))))))))) + (loop named replace + for index = (search (car entry) string :test #'string=) + do + (unless index + (return-from replace)) + (setf string (concatenate 'string + (subseq string 0 index) + (cdr entry) + (subseq string (+ index (length (car entry)))))))) string) (defun copy-with-substitutions (source-file target-file substitutions-alist) @@ -268,9 +271,14 @@ t) (t (cond (batch + (ensure-directories-exist (merge-pathnames "build/classes/" *build-root*)) (let* ((dir (pathname-directory *abcl-dir*)) (cmdline (with-output-to-string (s) (princ *java-compiler-command-line-prefix* s) + (princ " -d " s) + (princ (merge-pathnames "build/classes/" + *build-root*) s) + (princ #\Space s) (dolist (source-file source-files) (princ (if (equal (pathname-directory source-file) dir) @@ -281,6 +289,7 @@ (status (run-shell-command cmdline :directory *abcl-dir*))) (zerop status))) (t + (ensure-directories-exist (merge-pathnames "build/classes/" *build-root*)) (dolist (source-file source-files t) (unless (java-compile-file source-file) (format t "Build failed.~%") @@ -296,6 +305,7 @@ (target-file (if (eq *platform* :windows) "make-jar.bat" "make-jar")) (command (if (eq *platform* :windows) "make-jar.bat" "sh make-jar"))) (copy-with-substitutions source-file target-file substitutions-alist) + (ensure-directories-exist (merge-pathnames "dist/" *build-root*)) (let ((status (run-shell-command command :directory *build-root*))) (unless (zerop status) (format t "~A returned ~S~%" command status)) @@ -305,40 +315,30 @@ (terpri) (finish-output) (let* ((java-namestring (safe-namestring *java*)) - status) - (cond ((eq *platform* :windows) - (with-open-file (stream - (merge-pathnames "compile-system.bat" *build-root*) - :direction :output - :if-exists :supersede) - (princ java-namestring stream) - (write-string " -cp " stream) - (princ "src" stream) - (write-char #\space stream) - (write-string - (if zip - "org.armedbear.lisp.Main --eval \"(compile-system :zip t :quit t)\"" - "org.armedbear.lisp.Main --eval \"(compile-system :zip nil :quit t)\"") - stream) - (terpri stream)) - (setf status - (run-shell-command "compile-system.bat" - :directory *build-root*))) - (t ; Linux - (let ((cmdline - (with-output-to-string (s) - (princ java-namestring s) - (write-string " -cp " s) - (princ "src" s) - (write-char #\space s) - (write-string - (if zip - "org.armedbear.lisp.Main --eval \"(compile-system :zip t :quit t)\"" - "org.armedbear.lisp.Main --eval \"(compile-system :zip nil :quit t)\"") - s)))) - (setf status - (run-shell-command cmdline - :directory *build-root*))))) + status + (abcl-home (substitute-in-string + (namestring *abcl-dir*) + (when (eq *platform* :windows) + '(("\\" . "/") + ("/" . "\\\\"))))) + (output-path (substitute-in-string + (namestring + (merge-pathnames "build/classes/org/armedbear/lisp/" + *build-root*)) + (when (eq *platform* :windows) + '(("\\" . "/"))))) + (cmdline (format nil + "~A -cp build\\classes -Dabcl.home=\"~A\" ~ +org.armedbear.lisp.Main --noinit ~ +--eval \"(compile-system :zip ~A :quit t :output-path \\\"~A\\\")\"~%" + java-namestring + abcl-home + (not (not zip)) ;; because that ensures T or NIL + output-path))) + (ensure-directories-exist output-path) + (setf status + (run-shell-command cmdline + :directory *build-root*)) status)) (defun make-libabcl () @@ -376,10 +376,9 @@ (merge-pathnames "abcl.bat" *build-root*) :direction :output :if-exists :supersede) - (format s "~A -Xss4M -Xmx256M -cp \"~A;~A\" org.armedbear.lisp.Main %1 %2 %3 %4 %5 %6 %7 %8 %9~%" + (format s "~A -Xss4M -Xmx256M -cp \"~A\" org.armedbear.lisp.Main %1 %2 %3 %4 %5 %6 %7 %8 %9~%" (safe-namestring *java*) - (namestring (merge-pathnames "src" *build-root*)) - (namestring (merge-pathnames "abcl.jar" *build-root*))))) + (namestring (merge-pathnames "dist\\abcl.jar" *build-root*))))) (t (let ((pathname (merge-pathnames "abcl" *build-root*))) (with-open-file (s pathname :direction :output :if-exists :supersede) @@ -425,15 +424,27 @@ (delete-file truename))))) (defun clean () - (dolist (f (list (list *build-root* "abcl.jar") + (dolist (f (list (list *build-root* "abcl.jar" "abcl.bat" "make-jar.bat" + "compile-system.bat") (list *abcl-dir* "*.class" "*.abcl" "*.cls" "native.h" "libabcl.so" "build") - (list (merge-pathnames "java/awt/" *abcl-dir*) + (list (merge-pathnames "build/classes/org/armedbear/lisp/" + *build-root*) + "*.class" "*.abcl" "*.cls" + "native.h" "libabcl.so" "build") + (list (merge-pathnames + "build/classes/org/armedbear/lisp/util/" + *build-root*) + "*.class" "*.abcl" "*.cls") + (list (merge-pathnames "dist/" *build-root*) + "*.jar" "*.class" "*.abcl" "*.cls") + (list (merge-pathnames "java/awt/" *abcl-dir*) "*.class"))) (let ((default (car f))) - (delete-files (mapcan #'(lambda (name) - (directory (merge-pathnames name default))) - (cdr f)))))) + (when (probe-directory default) + (delete-files (mapcan #'(lambda (name) + (directory (merge-pathnames name default))) + (cdr f))))))) (defun build-abcl (&key force (batch t) Modified: trunk/abcl/make-jar.bat.in ============================================================================== --- trunk/abcl/make-jar.bat.in (original) +++ trunk/abcl/make-jar.bat.in Sun Feb 22 15:13:44 2009 @@ -1,7 +1,3 @@ -cd src - at JAR@ cmf manifest-abcl ..\abcl.jar org\armedbear\lisp\*.class - at JAR@ uf ..\abcl.jar org\armedbear\lisp\util\*.class - at JAR@ uf ..\abcl.jar org\armedbear\lisp\LICENSE - at JAR@ uf ..\abcl.jar org\armedbear\lisp\*.lisp - at JAR@ uf ..\abcl.jar org\armedbear\lisp\*.abcl - at JAR@ uf ..\abcl.jar org\armedbear\lisp\*.cls + at JAR@ cfm dist\abcl.jar src\manifest-abcl -C src org\armedbear\lisp\LICENSE -C src org\armedbear\lisp\boot.lisp + at JAR@ uf dist\abcl.jar -C build\classes . + Modified: trunk/abcl/make-jar.in ============================================================================== --- trunk/abcl/make-jar.in (original) +++ trunk/abcl/make-jar.in Sun Feb 22 15:13:44 2009 @@ -1,8 +1,5 @@ #!/bin/sh -cd src - at JAR@ cmf manifest-abcl ../abcl.jar org/armedbear/lisp/*.class - at JAR@ uf ../abcl.jar org/armedbear/lisp/LICENSE - at JAR@ uf ../abcl.jar org/armedbear/lisp/*.lisp - at JAR@ uf ../abcl.jar org/armedbear/lisp/*.abcl - at JAR@ uf ../abcl.jar org/armedbear/lisp/util/*.class -find . -name '*.cls' | xargs @JAR@ uf ../abcl.jar + + at JAR@ cfm dist/abcl.jar src/manifest-abcl -C src org/armedbear/lisp/LICENSE -C src org/armedbear/lisp/boot.lisp + at JAR@ uf dist/abcl.jar -C build/classes . + From ehuelsmann at common-lisp.net Sun Feb 22 15:35:07 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 22 Feb 2009 15:35:07 +0000 Subject: [armedbear-cvs] r11679 - trunk/abcl Message-ID: Author: ehuelsmann Date: Sun Feb 22 15:35:06 2009 New Revision: 11679 Log: Add some comments. Modified: trunk/abcl/build-abcl.lisp Modified: trunk/abcl/build-abcl.lisp ============================================================================== --- trunk/abcl/build-abcl.lisp (original) +++ trunk/abcl/build-abcl.lisp Sun Feb 22 15:35:06 2009 @@ -425,7 +425,9 @@ (defun clean () (dolist (f (list (list *build-root* "abcl.jar" "abcl.bat" "make-jar.bat" - "compile-system.bat") + "compile-system.bat") + ;; as of 0.14 'compile-system.bat' isn't created anymore + ;; as of 0.14 'abcl.jar' is always created in dist/ (list *abcl-dir* "*.class" "*.abcl" "*.cls" "native.h" "libabcl.so" "build") (list (merge-pathnames "build/classes/org/armedbear/lisp/" From ehuelsmann at common-lisp.net Sun Feb 22 15:49:55 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 22 Feb 2009 15:49:55 +0000 Subject: [armedbear-cvs] r11680 - trunk/abcl Message-ID: Author: ehuelsmann Date: Sun Feb 22 15:49:54 2009 New Revision: 11680 Log: Rename/ introduce variables for clarity. Modified: trunk/abcl/build-abcl.lisp Modified: trunk/abcl/build-abcl.lisp ============================================================================== --- trunk/abcl/build-abcl.lisp (original) +++ trunk/abcl/build-abcl.lisp Sun Feb 22 15:49:54 2009 @@ -146,15 +146,22 @@ (eql (char namestring (1- (length namestring))) *file-separator-char*) truename))) -(defparameter *build-root* +(defparameter *tree-root* (make-pathname :device (pathname-device *load-truename*) :directory (pathname-directory *load-truename*))) +(defparameter *build-root* + (merge-pathnames "build/classes/" *tree-root*)) +(defparameter *source-root* + (merge-pathnames "src/" *tree-root*)) +(defparameter *dist-root* + (merge-pathnames "dist/" *tree-root*)) + (defparameter *customizations-file* - (merge-pathnames "customizations.lisp" *build-root*)) + (merge-pathnames "customizations.lisp" *tree-root*)) (defparameter *abcl-dir* - (merge-pathnames "src/org/armedbear/lisp/" *build-root*)) + (merge-pathnames "src/org/armedbear/lisp/" *tree-root*)) (defparameter *jdk* nil) (defparameter *java-compiler* nil) @@ -190,7 +197,7 @@ "bin/jar.exe" "bin/jar") *jdk*))) - (let ((classpath-components (list (merge-pathnames "src" *build-root*) + (let ((classpath-components (list *source-root* (if (eq *platform* :darwin) #p"/System/Library/Frameworks/JavaVM.framework/Classes/classes.jar" (merge-pathnames "jre/lib/rt.jar" *jdk*))))) @@ -271,13 +278,12 @@ t) (t (cond (batch - (ensure-directories-exist (merge-pathnames "build/classes/" *build-root*)) + (ensure-directories-exist *build-root*) (let* ((dir (pathname-directory *abcl-dir*)) (cmdline (with-output-to-string (s) (princ *java-compiler-command-line-prefix* s) (princ " -d " s) - (princ (merge-pathnames "build/classes/" - *build-root*) s) + (princ *build-root* s) (princ #\Space s) (dolist (source-file source-files) (princ @@ -289,14 +295,14 @@ (status (run-shell-command cmdline :directory *abcl-dir*))) (zerop status))) (t - (ensure-directories-exist (merge-pathnames "build/classes/" *build-root*)) + (ensure-directories-exist *build-root*) (dolist (source-file source-files t) (unless (java-compile-file source-file) (format t "Build failed.~%") (return nil))))))))) (defun make-jar () - (let ((*default-pathname-defaults* *build-root*) + (let ((*default-pathname-defaults* *tree-root*) (jar-namestring (namestring *jar*))) (when (position #\space jar-namestring) (setf jar-namestring (concatenate 'string "\"" jar-namestring "\""))) @@ -305,8 +311,8 @@ (target-file (if (eq *platform* :windows) "make-jar.bat" "make-jar")) (command (if (eq *platform* :windows) "make-jar.bat" "sh make-jar"))) (copy-with-substitutions source-file target-file substitutions-alist) - (ensure-directories-exist (merge-pathnames "dist/" *build-root*)) - (let ((status (run-shell-command command :directory *build-root*))) + (ensure-directories-exist *dist-root*) + (let ((status (run-shell-command command :directory *tree-root*))) (unless (zerop status) (format t "~A returned ~S~%" command status)) status)))) @@ -324,7 +330,7 @@ (output-path (substitute-in-string (namestring (merge-pathnames "build/classes/org/armedbear/lisp/" - *build-root*)) + *tree-root*)) (when (eq *platform* :windows) '(("\\" . "/"))))) (cmdline (format nil @@ -338,7 +344,7 @@ (ensure-directories-exist output-path) (setf status (run-shell-command cmdline - :directory *build-root*)) + :directory *tree-root*)) status)) (defun make-libabcl () @@ -347,7 +353,7 @@ (format nil "~A -o org/armedbear/lisp/native.h org.armedbear.lisp.Native" javah-namestring)) (status - (run-shell-command command :directory (merge-pathnames "src/" *build-root*)))) + (run-shell-command command :directory *source-root*))) (unless (zerop status) (format t "~A returned ~S~%" command status)) (zerop status)) @@ -373,29 +379,29 @@ ;; used to build sbcl. (cond ((eq *platform* :windows) (with-open-file (s - (merge-pathnames "abcl.bat" *build-root*) + (merge-pathnames "abcl.bat" *tree-root*) :direction :output :if-exists :supersede) (format s "~A -Xss4M -Xmx256M -cp \"~A\" org.armedbear.lisp.Main %1 %2 %3 %4 %5 %6 %7 %8 %9~%" (safe-namestring *java*) - (namestring (merge-pathnames "dist\\abcl.jar" *build-root*))))) + (namestring (merge-pathnames "dist\\abcl.jar" *tree-root*))))) (t - (let ((pathname (merge-pathnames "abcl" *build-root*))) + (let ((pathname (merge-pathnames "abcl" *tree-root*))) (with-open-file (s pathname :direction :output :if-exists :supersede) (if (eq *platform* :linux) ;; On Linux, set java.library.path for libabcl.so. (format s "#!/bin/sh~%exec ~A -Xss4M -Xmx256M -Xrs -Djava.library.path=~A -cp ~A:~A org.armedbear.lisp.Main \"$@\"~%" (safe-namestring *java*) (safe-namestring *abcl-dir*) - (safe-namestring (merge-pathnames "src" *build-root*)) - (safe-namestring (merge-pathnames "abcl.jar" *build-root*))) + (safe-namestring *source-root*) + (safe-namestring (merge-pathnames "abcl.jar" *tree-root*))) ;; Not Linux. (format s "#!/bin/sh~%exec ~A -Xss4M -Xmx256M -cp ~A:~A org.armedbear.lisp.Main \"$@\"~%" (safe-namestring *java*) - (safe-namestring (merge-pathnames "src" *build-root*)) - (safe-namestring (merge-pathnames "abcl.jar" *build-root*))))) + (safe-namestring *source-root*) + (safe-namestring (merge-pathnames "abcl.jar" *tree-root*))))) (run-shell-command (format nil "chmod +x ~A" (safe-namestring pathname)) - :directory *build-root*))))) + :directory *tree-root*))))) (defun build-stamp () (multiple-value-bind @@ -424,22 +430,21 @@ (delete-file truename))))) (defun clean () - (dolist (f (list (list *build-root* "abcl.jar" "abcl.bat" "make-jar.bat" + (dolist (f (list (list *tree-root* "abcl.jar" "abcl.bat" "make-jar.bat" "compile-system.bat") ;; as of 0.14 'compile-system.bat' isn't created anymore ;; as of 0.14 'abcl.jar' is always created in dist/ (list *abcl-dir* "*.class" "*.abcl" "*.cls" "native.h" "libabcl.so" "build") (list (merge-pathnames "build/classes/org/armedbear/lisp/" - *build-root*) + *tree-root*) "*.class" "*.abcl" "*.cls" "native.h" "libabcl.so" "build") (list (merge-pathnames "build/classes/org/armedbear/lisp/util/" - *build-root*) + *tree-root*) "*.class" "*.abcl" "*.cls") - (list (merge-pathnames "dist/" *build-root*) - "*.jar" "*.class" "*.abcl" "*.cls") + (list *dist-root* "*.jar" "*.class" "*.abcl" "*.cls") (list (merge-pathnames "java/awt/" *abcl-dir*) "*.class"))) (let ((default (car f))) @@ -545,7 +550,7 @@ (let ((target-root (pathname (concatenate 'string "/var/tmp/" version-string "/")))) (when (probe-directory target-root) (error "Target directory ~S already exists." target-root)) - (let* ((source-dir *build-root*) + (let* ((source-dir *tree-root*) (target-dir target-root) (files (list "README" "COPYING" @@ -554,14 +559,13 @@ "make-jar.bat.in" "make-jar.in"))) (copy-files files source-dir target-dir)) - (let* ((source-dir (merge-pathnames "examples/" *build-root*)) + (let* ((source-dir (merge-pathnames "examples/" *tree-root*)) (target-dir (merge-pathnames "examples/" target-root)) (files '("hello.java"))) (copy-files files source-dir target-dir)) - (let* ((source-dir (merge-pathnames "src/" *build-root*)) - (target-dir (merge-pathnames "src/" target-root)) + (let* ((target-dir (merge-pathnames "src/" target-root)) (files '("manifest-abcl"))) - (copy-files files source-dir target-dir)) + (copy-files files *source-root* target-dir)) (let* ((source-dir *abcl-dir*) (target-dir (merge-pathnames "src/org/armedbear/lisp/" target-root)) (*default-pathname-defaults* source-dir) From ehuelsmann at common-lisp.net Sun Feb 22 19:42:22 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 22 Feb 2009 19:42:22 +0000 Subject: [armedbear-cvs] r11681 - trunk/abcl Message-ID: Author: ehuelsmann Date: Sun Feb 22 19:42:19 2009 New Revision: 11681 Log: *nix compilation fixes for Lisp based build. Modified: trunk/abcl/build-abcl.lisp Modified: trunk/abcl/build-abcl.lisp ============================================================================== --- trunk/abcl/build-abcl.lisp (original) +++ trunk/abcl/build-abcl.lisp Sun Feb 22 19:42:19 2009 @@ -334,7 +334,7 @@ (when (eq *platform* :windows) '(("\\" . "/"))))) (cmdline (format nil - "~A -cp build\\classes -Dabcl.home=\"~A\" ~ + "~A -cp build/classes -Dabcl.home=\"~A\" ~ org.armedbear.lisp.Main --noinit ~ --eval \"(compile-system :zip ~A :quit t :output-path \\\"~A\\\")\"~%" java-namestring @@ -390,16 +390,14 @@ (with-open-file (s pathname :direction :output :if-exists :supersede) (if (eq *platform* :linux) ;; On Linux, set java.library.path for libabcl.so. - (format s "#!/bin/sh~%exec ~A -Xss4M -Xmx256M -Xrs -Djava.library.path=~A -cp ~A:~A org.armedbear.lisp.Main \"$@\"~%" + (format s "#!/bin/sh~%exec ~A -Xss4M -Xmx256M -Xrs -Djava.library.path=~A -cp ~A org.armedbear.lisp.Main \"$@\"~%" (safe-namestring *java*) - (safe-namestring *abcl-dir*) - (safe-namestring *source-root*) - (safe-namestring (merge-pathnames "abcl.jar" *tree-root*))) + (safe-namestring (merge-pathnames "org/armedbear/lisp/" *build-root*)) + (safe-namestring (merge-pathnames "abcl.jar" *dist-root*))) ;; Not Linux. - (format s "#!/bin/sh~%exec ~A -Xss4M -Xmx256M -cp ~A:~A org.armedbear.lisp.Main \"$@\"~%" + (format s "#!/bin/sh~%exec ~A -Xss4M -Xmx256M -cp ~A org.armedbear.lisp.Main \"$@\"~%" (safe-namestring *java*) - (safe-namestring *source-root*) - (safe-namestring (merge-pathnames "abcl.jar" *tree-root*))))) + (safe-namestring (merge-pathnames "abcl.jar" *dist-root*))))) (run-shell-command (format nil "chmod +x ~A" (safe-namestring pathname)) :directory *tree-root*))))) From ehuelsmann at common-lisp.net Sun Feb 22 22:05:23 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 22 Feb 2009 22:05:23 +0000 Subject: [armedbear-cvs] r11682 - trunk/abcl Message-ID: Author: ehuelsmann Date: Sun Feb 22 22:05:22 2009 New Revision: 11682 Log: Fix ':BATCH NIL' build. Found by: Ville Modified: trunk/abcl/build-abcl.lisp Modified: trunk/abcl/build-abcl.lisp ============================================================================== --- trunk/abcl/build-abcl.lisp (original) +++ trunk/abcl/build-abcl.lisp Sun Feb 22 22:05:22 2009 @@ -247,6 +247,9 @@ (defun build-javac-command-line (source-file) (concatenate 'string *java-compiler-command-line-prefix* + " -d " + (princ-to-string *build-root*) + " " (namestring source-file))) (defun java-compile-file (source-file) From ehuelsmann at common-lisp.net Sun Feb 22 22:38:47 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 22 Feb 2009 22:38:47 +0000 Subject: [armedbear-cvs] r11683 - trunk/abcl Message-ID: Author: ehuelsmann Date: Sun Feb 22 22:38:45 2009 New Revision: 11683 Log: Some small tweaks and a fixme note. Modified: trunk/abcl/build-abcl.lisp Modified: trunk/abcl/build-abcl.lisp ============================================================================== --- trunk/abcl/build-abcl.lisp (original) +++ trunk/abcl/build-abcl.lisp Sun Feb 22 22:38:45 2009 @@ -248,7 +248,7 @@ (concatenate 'string *java-compiler-command-line-prefix* " -d " - (princ-to-string *build-root*) + (safe-namestring *build-root*) " " (namestring source-file))) @@ -261,7 +261,10 @@ (remove-if-not #'(lambda (name) (let ((output-name (make-pathname :type "class" - :defaults name))) +;; :name (pathname-name name) +;;###FIXME: we need defaults from *build-root*, +;; taking the bit of name which is below *abcl-dir* + :defaults name))) (or force (null (probe-file output-name)) (>= (file-write-date name) From ehuelsmann at common-lisp.net Sun Feb 22 23:17:20 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 22 Feb 2009 23:17:20 +0000 Subject: [armedbear-cvs] r11684 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Feb 22 23:17:19 2009 New Revision: 11684 Log: Since 0.13 was branched, trunk/ now is 0.14... Modified: trunk/abcl/src/org/armedbear/lisp/Version.java Modified: trunk/abcl/src/org/armedbear/lisp/Version.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Version.java (original) +++ trunk/abcl/src/org/armedbear/lisp/Version.java Sun Feb 22 23:17:19 2009 @@ -41,6 +41,6 @@ public static String getVersion() { - return "0.13.0-dev"; + return "0.14.0-dev"; } } From astalla at common-lisp.net Mon Feb 23 20:22:51 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Mon, 23 Feb 2009 20:22:51 +0000 Subject: [armedbear-cvs] r11685 - trunk/abcl/src/org/armedbear/lisp/scripting Message-ID: Author: astalla Date: Mon Feb 23 20:22:48 2009 New Revision: 11685 Log: Fixed interpreter creation. Modified: trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java 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 Mon Feb 23 20:22:48 2009 @@ -45,8 +45,10 @@ private Function evalCompiledScript; public AbclScriptEngine() { - interpreter = Interpreter.createInstance(); - interpreter.initializeLisp(); + interpreter = Interpreter.getInstance(); + if(interpreter == null) { + interpreter = Interpreter.createInstance(); + } this.nonThrowingDebugHook = Symbol.DEBUGGER_HOOK.getSymbolValue(); try { loadFromClasspath("/org/armedbear/lisp/scripting/lisp/packages.lisp"); From ehuelsmann at common-lisp.net Mon Feb 23 21:12:40 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 23 Feb 2009 21:12:40 +0000 Subject: [armedbear-cvs] r11686 - trunk/abcl Message-ID: Author: ehuelsmann Date: Mon Feb 23 21:12:39 2009 New Revision: 11686 Log: Fix 'newer' check: check the build-artifacts in the build root (instead of what's in the source tree). Clean build artifacts in the source tree src/.../lisp/util/ too. Add some helper routines. Modified: trunk/abcl/build-abcl.lisp Modified: trunk/abcl/build-abcl.lisp ============================================================================== --- trunk/abcl/build-abcl.lisp (original) +++ trunk/abcl/build-abcl.lisp Mon Feb 23 21:12:39 2009 @@ -20,6 +20,27 @@ string)) +(defun child-pathname (pathname parent) + "Returns `pathname' relative to `parent', assuming that it +is infact a child of it while being rooted at the same root as `parent'." + (let ((path-dir (pathname-directory pathname)) + (parent-dir (pathname-directory parent))) + (do ((p1 path-dir (cdr p1)) + (p2 parent-dir (cdr p2))) + ((or (endp p2) (not (equal (car p1) (car p2)))) + (when (endp p2) + (make-pathname :directory (cons :relative p1) + :defaults pathname)))))) + + +(defun file-newer (orig artifact) + "Compares file date/time of `orig' and `artifact', returning +`NIL' if `orig' is newer than `artifact'." + (or (null (probe-file artifact)) + (> (file-write-date orig) + (file-write-date artifact)))) + + ;; Platform detection. @@ -258,22 +279,21 @@ (defun make-classes (force batch) (let* ((source-files - (remove-if-not #'(lambda (name) - (let ((output-name - (make-pathname :type "class" -;; :name (pathname-name name) -;;###FIXME: we need defaults from *build-root*, -;; taking the bit of name which is below *abcl-dir* - :defaults name))) - (or force - (null (probe-file output-name)) - (>= (file-write-date name) - (file-write-date output-name))))) - (mapcan #'(lambda (default) - (directory (merge-pathnames "*.java" - default))) - (list *abcl-dir* - (merge-pathnames "util/" *abcl-dir*)))))) + (remove-if-not + #'(lambda (name) + (let ((output-name + (merge-pathnames + (make-pathname :type "class" + :defaults (child-pathname name + *source-root*)) + *build-root*))) + (or force + (file-newer name output-name)))) + (mapcan #'(lambda (default) + (directory (merge-pathnames "*.java" + default))) + (list *abcl-dir* + (merge-pathnames "util/" *abcl-dir*)))))) (format t "~&JDK: ~A~%" *jdk*) (format t "Java compiler: ~A~%" *java-compiler*) (format t "Compiler options: ~A~%~%" (if *java-compiler-options* *java-compiler-options* "")) @@ -440,6 +460,7 @@ ;; as of 0.14 'abcl.jar' is always created in dist/ (list *abcl-dir* "*.class" "*.abcl" "*.cls" "native.h" "libabcl.so" "build") + (list (merge-pathnames "util/" *abcl-dir*) "*.class") (list (merge-pathnames "build/classes/org/armedbear/lisp/" *tree-root*) "*.class" "*.abcl" "*.cls" From ehuelsmann at common-lisp.net Mon Feb 23 21:26:10 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 23 Feb 2009 21:26:10 +0000 Subject: [armedbear-cvs] r11687 - in trunk/abcl: . src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Mon Feb 23 21:26:09 2009 New Revision: 11687 Log: Remove libabcl.so, which is about setting a SIGINT signal handler. Note: NetBeans didn't find any usages of Native.java outside of Native.java (?!). Did this ever work?! Removed: trunk/abcl/src/org/armedbear/lisp/Native.java trunk/abcl/src/org/armedbear/lisp/native.c Modified: trunk/abcl/build-abcl.lisp Modified: trunk/abcl/build-abcl.lisp ============================================================================== --- trunk/abcl/build-abcl.lisp (original) +++ trunk/abcl/build-abcl.lisp Mon Feb 23 21:26:09 2009 @@ -373,31 +373,6 @@ :directory *tree-root*)) status)) -(defun make-libabcl () - (and (let* ((javah-namestring (namestring (probe-file (merge-pathnames "bin/javah" *jdk*)))) - (command - (format nil "~A -o org/armedbear/lisp/native.h org.armedbear.lisp.Native" - javah-namestring)) - (status - (run-shell-command command :directory *source-root*))) - (unless (zerop status) - (format t "~A returned ~S~%" command status)) - (zerop status)) - (let* ((jdk-namestring (namestring *jdk*)) - (command - (format nil "gcc -shared -o libabcl.so -O -D_REENTRANT -fpic -I~Ainclude -I~Ainclude/~A native.c" - jdk-namestring jdk-namestring - (cond ((eq *platform* :linux) - "linux") - ((search "SunOS" (software-type)) - "solaris") - ((search "FreeBSD" (software-type)) - "freebsd")))) - (status - (run-shell-command command :directory *abcl-dir*))) - (unless (zerop status) - (format t "~A returned ~S~%" command status)) - (zerop status)))) ;; abcl/abcl.bat (defun make-launch-script () @@ -414,16 +389,9 @@ (t (let ((pathname (merge-pathnames "abcl" *tree-root*))) (with-open-file (s pathname :direction :output :if-exists :supersede) - (if (eq *platform* :linux) - ;; On Linux, set java.library.path for libabcl.so. - (format s "#!/bin/sh~%exec ~A -Xss4M -Xmx256M -Xrs -Djava.library.path=~A -cp ~A org.armedbear.lisp.Main \"$@\"~%" - (safe-namestring *java*) - (safe-namestring (merge-pathnames "org/armedbear/lisp/" *build-root*)) - (safe-namestring (merge-pathnames "abcl.jar" *dist-root*))) - ;; Not Linux. - (format s "#!/bin/sh~%exec ~A -Xss4M -Xmx256M -cp ~A org.armedbear.lisp.Main \"$@\"~%" - (safe-namestring *java*) - (safe-namestring (merge-pathnames "abcl.jar" *dist-root*))))) + (format s "#!/bin/sh~%exec ~A -Xss4M -Xmx256M -cp ~A org.armedbear.lisp.Main \"$@\"~%" + (safe-namestring *java*) + (safe-namestring (merge-pathnames "abcl.jar" *dist-root*)))) (run-shell-command (format nil "chmod +x ~A" (safe-namestring pathname)) :directory *tree-root*))))) @@ -460,6 +428,7 @@ ;; as of 0.14 'abcl.jar' is always created in dist/ (list *abcl-dir* "*.class" "*.abcl" "*.cls" "native.h" "libabcl.so" "build") + ;; as of 0.14, native.h and libabcl.so have been removed (list (merge-pathnames "util/" *abcl-dir*) "*.class") (list (merge-pathnames "build/classes/org/armedbear/lisp/" *tree-root*) @@ -483,7 +452,6 @@ compile-system jar clean - libabcl full) (let ((start (get-internal-real-time))) @@ -519,13 +487,6 @@ (unless (zerop status) (format t "Build failed.~%") (return-from build-abcl nil)))) - ;; libabcl.so - (when (and (or full libabcl) - (or (eq *platform* :linux) - (search "SunOS" (software-type)) - (search "FreeBSD" (software-type)))) - ;; A failure here is not fatal. - (make-libabcl)) ;; abcl/abcl.bat (make-launch-script) (make-build-stamp) From ehuelsmann at common-lisp.net Sat Feb 28 11:05:13 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sat, 28 Feb 2009 11:05:13 +0000 Subject: [armedbear-cvs] r11688 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Feb 28 11:05:08 2009 New Revision: 11688 Log: Add list() with variadic arguments. Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java 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 Sat Feb 28 11:05:08 2009 @@ -591,6 +591,14 @@ env.bind(sym, value); } + public static final Cons list(LispObject... objects) + { + Cons theList = new Cons(objects[objects.length-1]); + for (int i = objects.length - 2; i >= 0; i--) + theList = new Cons(objects[i], theList); + return theList; + } + public static final Cons list1(LispObject obj1) { return new Cons(obj1); From ehuelsmann at common-lisp.net Sat Feb 28 13:39:45 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sat, 28 Feb 2009 13:39:45 +0000 Subject: [armedbear-cvs] r11689 - in tags/0.13.0: . abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Feb 28 13:39:43 2009 New Revision: 11689 Log: Tag 0.13.0. Added: tags/0.13.0/ - copied from r11688, /branches/0.13.x/ Modified: tags/0.13.0/abcl/src/org/armedbear/lisp/Version.java Modified: tags/0.13.0/abcl/src/org/armedbear/lisp/Version.java ============================================================================== --- /branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java (original) +++ tags/0.13.0/abcl/src/org/armedbear/lisp/Version.java Sat Feb 28 13:39:43 2009 @@ -41,6 +41,6 @@ public static String getVersion() { - return "0.12.43"; + return "0.13.0"; } } From ehuelsmann at common-lisp.net Sat Feb 28 13:40:19 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sat, 28 Feb 2009 13:40:19 +0000 Subject: [armedbear-cvs] r11690 - branches/0.13.x/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Feb 28 13:40:18 2009 New Revision: 11690 Log: Increase version number, after tagging 0.13.0. Modified: branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java Modified: branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java ============================================================================== --- branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java (original) +++ branches/0.13.x/abcl/src/org/armedbear/lisp/Version.java Sat Feb 28 13:40:18 2009 @@ -41,6 +41,6 @@ public static String getVersion() { - return "0.12.43"; + return "0.13.1-dev"; } }