[armedbear-cvs] r11839 - in trunk/abcl/src/org/armedbear/lisp/scripting: . lisp
Alessio Stalla
astalla at common-lisp.net
Thu May 7 22:01:55 UTC 2009
Author: astalla
Date: Thu May 7 18:01:52 2009
New Revision: 11839
Log:
Fixed compilation with temp files with JSR-223. Refactoring of AbclScriptEngine
(mostly elimination of dead code). Changed policy of use of #'sys::%debugger-hook-function
in an attempt to have the throwing debugger cover more cases; it still doesn't
work always.
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/config.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 May 7 18:01:52 2009
@@ -38,84 +38,63 @@
public class AbclScriptEngine extends AbstractScriptEngine implements Invocable, Compilable {
- private Interpreter interpreter;
- private LispObject nonThrowingDebugHook;
- private Function evalScript;
- private Function compileScript;
- private Function evalCompiledScript;
-
- public AbclScriptEngine() {
- interpreter = Interpreter.getInstance();
- if(interpreter == null) {
- interpreter = Interpreter.createInstance();
- }
- 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)");
- 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();
- } catch (ConditionThrowable e) {
- throw new RuntimeException(e);
- }
- }
-
- public Interpreter getInterpreter() {
- return interpreter;
- }
-
- public void installNonThrowingDebugHook() {
- installNonThrowingDebugHook(LispThread.currentThread());
- }
-
- public void installNonThrowingDebugHook(LispThread thread) {
- thread.setSpecialVariable(Symbol.DEBUGGER_HOOK, this.nonThrowingDebugHook);
- }
-
- public void installThrowingDebuggerHook(LispThread thread) throws ConditionThrowable {
- Symbol dbgrhkfunSym;
- dbgrhkfunSym = Lisp.PACKAGE_SYS.findAccessibleSymbol("%DEBUGGER-HOOK-FUNCTION");
- LispObject throwingDebugHook = dbgrhkfunSym.getSymbolFunction();
- thread.setSpecialVariable(Symbol.DEBUGGER_HOOK, throwingDebugHook);
- }
-
- public void installThrowingDebuggerHook() throws ConditionThrowable {
- installThrowingDebuggerHook(LispThread.currentThread());
- }
-
- public void setStandardInput(InputStream stream, LispThread thread) {
- thread.setSpecialVariable(Symbol.STANDARD_INPUT, new Stream(stream, Symbol.CHARACTER, true));
- }
-
- public void setStandardInput(InputStream stream) {
- setStandardInput(stream, LispThread.currentThread());
- }
-
- public void setInterpreter(Interpreter interpreter) {
- this.interpreter = interpreter;
- }
-
- public static String escape(String s) {
- StringBuffer b = new StringBuffer();
- int len = s.length();
- char c;
- for (int i = 0; i < len; ++i) {
- c = s.charAt(i);
- if (c == '\\' || c == '"') {
- b.append('\\');
- }
- b.append(c);
- }
- return b.toString();
+ private Interpreter interpreter;
+ private Function evalScript;
+ private Function compileScript;
+ private Function evalCompiledScript;
+
+ protected AbclScriptEngine() {
+ interpreter = Interpreter.getInstance();
+ if(interpreter == null) {
+ interpreter = Interpreter.createInstance();
+ }
+ 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");
+ }
+ ((Function) interpreter.eval("#'abcl-script:configure-abcl")).execute(new JavaObject(this));
+ 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();
+ } catch (ConditionThrowable e) {
+ throw new RuntimeException(e);
+ }
+ }
+
+ public Interpreter getInterpreter() {
+ return interpreter;
+ }
+
+ public void setStandardInput(InputStream stream, LispThread thread) {
+ thread.setSpecialVariable(Symbol.STANDARD_INPUT, new Stream(stream, Symbol.CHARACTER, true));
+ }
+
+ public void setStandardInput(InputStream stream) {
+ setStandardInput(stream, LispThread.currentThread());
+ }
+
+ public void setInterpreter(Interpreter interpreter) {
+ this.interpreter = interpreter;
+ }
+
+ public static String escape(String s) {
+ StringBuffer b = new StringBuffer();
+ int len = s.length();
+ char c;
+ for (int i = 0; i < len; ++i) {
+ c = s.charAt(i);
+ if (c == '\\' || c == '"') {
+ b.append('\\');
+ }
+ b.append(c);
}
+ return b.toString();
+ }
public LispObject loadFromClasspath(String classpathResource) throws ConditionThrowable {
InputStream istream = getClass().getResourceAsStream(classpathResource);
@@ -244,26 +223,27 @@
return super.getContext();
}
- private Object eval(Function evaluator, LispObject code, ScriptContext ctx) throws ScriptException {
- ReaderInputStream in = null;
- WriterOutputStream out = null;
- LispObject retVal = null;
- try {
- in = new ReaderInputStream(ctx.getReader());
- out = new WriterOutputStream(ctx.getWriter());
- Stream outStream = new Stream(out, Symbol.CHARACTER);
- Stream inStream = new Stream(in, Symbol.CHARACTER);
- retVal = evaluator.execute(makeBindings(ctx.getBindings(ScriptContext.GLOBAL_SCOPE)),
- makeBindings(ctx.getBindings(ScriptContext.ENGINE_SCOPE)),
- inStream, outStream,
- code, new JavaObject(ctx));
- return toJava(retVal);
- } catch (ConditionThrowable e) {
- throw new ScriptException(new Exception(e));
- } catch (IOException e) {
- throw new ScriptException(e);
- }
+ private Object eval(Function evaluator, LispObject code, ScriptContext ctx) throws ScriptException {
+ ReaderInputStream in = null;
+ WriterOutputStream out = null;
+ LispObject retVal = null;
+ try {
+ in = new ReaderInputStream(ctx.getReader());
+ out = new WriterOutputStream(ctx.getWriter());
+ Stream outStream = new Stream(out, Symbol.CHARACTER);
+ Stream inStream = new Stream(in, Symbol.CHARACTER);
+
+ retVal = evaluator.execute(makeBindings(ctx.getBindings(ScriptContext.GLOBAL_SCOPE)),
+ makeBindings(ctx.getBindings(ScriptContext.ENGINE_SCOPE)),
+ inStream, outStream,
+ code, new JavaObject(ctx));
+ return toJava(retVal);
+ } catch (ConditionThrowable e) {
+ throw new ScriptException(new Exception(e));
+ } catch (IOException e) {
+ throw new ScriptException(e);
}
+ }
@Override
public Object eval(String code, ScriptContext ctx) throws ScriptException {
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 Thu May 7 18:01:52 2009
@@ -57,19 +57,20 @@
:collect `(jcall +put-binding+
,java-bindings ,(car jbinding) ,(car binding))))
-(defmacro with-script-context ((global-bindings engine-bindings stdin stdout script-context)
- body)
+(defmacro eval-in-script-context ((global-bindings engine-bindings stdin stdout script-context)
+ body)
+ "Sets up an environment in which to evaluate a piece of code coming from Java through the JSR-223 methods."
(let ((actual-global-bindings (gensym))
(actual-engine-bindings (gensym)))
`(let ((*package* (find-package :abcl-script-user))
(*standard-input* ,stdin)
(*standard-output* ,stdout)
+ (*debugger-hook* (if *use-throwing-debugger*
+ #'sys::%debugger-hook-function
+ *debugger-hook*))
(,actual-global-bindings (generate-bindings ,global-bindings))
(,actual-engine-bindings (generate-bindings ,engine-bindings)))
- (eval `(let ((*standard-input* ,,stdin)
- (*standard-output* ,,stdout)
- (*package* (find-package :abcl-script-user)))
- (let (,@,actual-global-bindings)
+ (eval `(let (,@,actual-global-bindings)
(let (,@,actual-engine-bindings)
(prog1
(progn ,@,body)
@@ -81,17 +82,17 @@
,@(generate-java-bindings
,engine-bindings
,actual-engine-bindings
- (jcall +get-bindings+ ,script-context +engine-scope+))))))))))
+ (jcall +get-bindings+ ,script-context +engine-scope+)))))))))
(defun eval-script (global-bindings engine-bindings stdin stdout
code-string script-context)
- (with-script-context (global-bindings engine-bindings stdin stdout script-context)
+ (eval-in-script-context (global-bindings engine-bindings stdin stdout script-context)
(read-from-string
(concatenate 'string "(" code-string ")"))))
(defun eval-compiled-script (global-bindings engine-bindings stdin stdout
function script-context)
- (with-script-context (global-bindings engine-bindings stdin stdout script-context)
+ (eval-in-script-context (global-bindings engine-bindings stdin stdout script-context)
`((funcall ,function))))
(defun compile-script (code-string)
@@ -102,39 +103,39 @@
(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)
+ (with-open-file (stream tmp-file-path :direction :output)
+ (princ "(in-package :abcl-script-user)" stream)
+ (princ 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))))
+ (lambda ()
+ (let ((*package* (find-package :abcl-script-user)))
+ (load compiled-file :verbose t :print t)))))
(delete-file tmp-file-path)))
(eval
`(compile
nil
(lambda ()
,@(let ((*package* (find-package :abcl-script-user)))
- (read-from-string (concatenate 'string "(" code-string ")"))))))))
+ (read-from-string
+ (concatenate 'string "(" code-string " cl:t)")))))))) ;return T in conformity of what LOAD does.
-;;Java interface implementation
+;;Java interface implementation - TODO
(defvar *interface-implementation-map* (make-hash-table :test #'equal))
(defun find-java-interface-implementation (interface)
(gethash interface *interface-implementation-map*))
-(defun register-java-interface-implementation (interface impl)
- (setf (gethash interface *interface-implementation-map*) impl))
+(defun register-java-interface-implementation (interface implementation &optional lisp-this)
+ (setf (gethash interface *interface-implementation-map*)
+ (jmake-proxy interface implementation lisp-this)))
(defun remove-java-interface-implementation (interface)
(remhash interface *interface-implementation-map*))
-(defun define-java-interface-implementation (interface implementation &optional lisp-this)
- (register-java-interface-implementation
- interface
- (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
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 May 7 18:01:52 2009
@@ -41,16 +41,12 @@
(defparameter *compile-using-temp-files* t)
-(defconstant +standard-debugger-hook+ *debugger-hook*)
-
-(defun configure-abcl ()
- (setq *debugger-hook*
- (if *use-throwing-debugger*
- #'sys::%debugger-hook-function
- +standard-debugger-hook+))
+(defun configure-abcl (abcl-script-engine)
(when *launch-swank-at-startup*
(unless *swank-dir*
(error "Swank directory not specified, please set *swank-dir*"))
+ (when *use-throwing-debugger*
+ (setf *debugger-hook* #'sys::%debugger-hook-function))
(pushnew *swank-dir* asdf:*central-registry* :test #'equal)
(asdf:oos 'asdf:load-op :swank)
(ext:make-thread (lambda () (funcall (find-symbol
More information about the armedbear-cvs
mailing list