Changeset 11839 for trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp

Timestamp:

05/07/09 22:01:52 (14 years ago)

Author:

astalla

Message:

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.

File:

• trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp (modified) (8 diffs)

trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp

@@ -58 +58 @@
        ,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)))
@@ -65 +66 @@
      (*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
@@ -82 +83 @@
            ,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 ")"))))
@@ -92 +93 @@
 (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))))
 
@@ -103 +104 @@
   (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)))
@@ -110 +112 @@
       (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 
@@ -117 +121 @@
    (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))
@@ -126 +131 @@
   (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)