Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

We actually have a real package now!

- test suite works
- no warnings during compilation
- asdf file is corrected
- setup-teardown for most of the vm maintenance facilities -- still need to use the thread-safe version in order for finalizer to work correctly
- improved/cleaned utilities in util.lisp, which should probably move to new files
  • Loading branch information...
commit 90edf4cd380f7acb8c8be599e83e4fe3ca9f22a5 1 parent af0f99f
@gonzojive authored
View
26 cl-spidermonkey.asd
@@ -1,20 +1,23 @@
-(defpackage org.iodb.cl-spidermonkey.system
+(defpackage :org.iodb.cl-spidermonkey.system
(:use :common-lisp :asdf))
-(in-package :org.iodb.cl-spidermonkey-system)
-(defsystem cl-spidermonkey
+(in-package :org.iodb.cl-spidermonkey.system)
+
+(defsystem :cl-spidermonkey
:description "."
- :version "0.2.1"
+ :version "0.0.1"
:author "Red Daly <reddaly at gmail>"
:license "MIT/X11 License. See LICENSE file"
:components ((:module "src"
:components
((:file "package")
- (:file "spidermonkey-bindings")
- (:file "port" :depends-on ("package"))))))
+ (:file "spidermonkey-bindings" :depends-on ("package"))
+ (:file "port" :depends-on ("package"))
+ (:file "util" :depends-on ("port" "setup-teardown"))
+ (:file "setup-teardown" :depends-on ("port" "spidermonkey-bindings")))))
+ :depends-on ("alexandria" "cffi" "anaphora" "trivial-garbage"))
-#+nil
-(defsystem cl-spidermonkey-tests
+(defsystem :cl-spidermonkey-tests
:name "cl-spidermonkey-tests"
:author "Red Daly <reddaly@gmail.com>"
:version "0.0.1"
@@ -23,7 +26,6 @@
:components ((:static-file "cl-spidermonkey.asd")
(:module "test"
:components
- ((:file "package")
- (:file "all-tests" :depends-on ("package"))
- (:parenscript-file "cl-spidermonkey-test" :depends-on ("package")))))
- :depends-on ("stefil" "cl-spidermonkey" "paren-test" "paren-util"))
+ ((:file "test-package")
+ (:file "jsval-tests" :depends-on ("test-package")))))
+ :depends-on ("cl-spidermonkey" "hu.dwim.stefil"))
View
16 src/demo.lisp
@@ -60,22 +60,6 @@
(cffi:mem-ref d :double))))))
-(defun evaluate-js (code)
- "Evaluates the Javascript code CODE and returns the jsval result."
- (cffi:with-foreign-strings ((js code)
- (filename "string.js"))
- (cffi:with-foreign-object (rval 'smlib:jsval)
- (if (not (eql 0
- (with-float-traps-masked ()
- (smlib:js-evaluate-script *js-context* *global*
- js
- (length code)
- filename
- 20
- rval))))
-
- (cffi:mem-ref rval 'smlib:jsval)
- (error "Error evaluating script.")))))
(defun jsval-to-lisp-number (
View
11 src/package.lisp
@@ -1,10 +1,17 @@
-(cl:in-package :cl-user
+(cl:in-package :cl-user)
(defpackage :cl-spidermonkey
+ (:nicknames :spidermonkey :sm)
(:use :cl))
+(in-package :cl-spidermonkey)
-How to generate bindings:
+(cffi:load-foreign-library "libjs.so"
+ :search-path (asdf:system-relative-pathname (asdf:find-system :cl-spidermonkey)
+ #P"lib/"))
+
+
+;;;How to generate bindings:
;;(verrazano:generate-binding (list :cffi
;; :package-name :spidermonkey-bindings
;; :input-files '("/git/cl-spidermonkey/include/jsapi.h")
View
146 src/setup-teardown.lisp
@@ -0,0 +1,146 @@
+(in-package :cl-spidermonkey)
+
+(defvar *js-runtime* nil
+ "The Spidermonkey runtime instance we are working with--probably
+ bound at top level.")
+
+(defvar *js-context* nil
+ "The current Javascript context, a Lisp class instance.")
+
+(defvar *js-global-class*
+ "The Spidermonkey classing being used as the global object class.")
+
+(defvar *js-global* nil
+ "The spidermonkey object being used as the global object. Probably
+ does not need to be a special variable.")
+
+(defvar *error-reporter 'default-error-reporter
+ "Function called with 3 args when there is a Javascript error:
+1 context
+2 message
+3 js-error-report")
+
+(defun default-error-reporter (context message report)
+ (declare (ignore report context))
+ (error "Javascript Error: ~A" message))
+
+(defclass js-context ()
+ ((sm-context :initarg :sm-context :reader foreign-context
+ :documentation "Foreign instance of the Javascript context.")
+ (gc :initarg :gc :initform nil :reader context-gc?))
+ (:documentation "Native class for representing a Javascript context,
+ mostly for the purpose of garbage collection."))
+
+(defmethod initialize-instance :after ((obj js-context) &rest initargs)
+ (declare (ignore initargs))
+ (let ((ptr (foreign-context obj)))
+ (when (context-gc? obj)
+ (trivial-garbage:finalize obj
+ #'(lambda ()
+ (format t "Destroying context ~A" ptr)
+ (smlib:js-destroy-context ptr))))))
+
+
+(cffi:defcallback my-report-error :void ((context smlib:js-context)
+ (message :string)
+ (report smlib:js-error-report))
+ (funcall *error-reporter context message report))
+
+(defun create-js-environment (&key (memory (* 1024 1024 48)))
+ "Initializes the js runtime if need be, and creates a Javascript
+context with a new global object and class. This will set special
+variables *js-runtime* *js-context* *js-global-class* and *js-global*,
+so if you don't want those overwritten make sure to rebind them first."
+
+ (let ((runtime (or *js-runtime* (smlib:js-init memory))))
+ (setf *js-runtime* runtime)
+
+ (multiple-value-bind (context)
+ (create-js-context :runtime runtime)
+ (setf *js-context* context)
+ context)))
+
+(defun create-js-context (&key (memory (* 1024 1024 16)) (runtime *js-runtime*))
+ "Initializes a js-context and returns it."
+ ;; MALLOC
+ (let* ((context (smlib:js-new-context runtime memory))
+ (lisp-context (make-instance 'js-context :sm-context context)))
+
+ (smlib:js-set-options context smlib:+jsoption-var-obj-fix+)
+ (smlib:js-set-version context :jsversion-latest)
+
+ (smlib:js-set-error-reporter context (cffi:callback my-report-error))
+
+ ;; MALLOC
+ (let* ((global-class (init-global-class
+ (smlib:js-malloc context
+ (cffi:foreign-type-size 'smlib:js-class))))
+ ;; MALLOC
+ (global-obj (smlib:js-new-object context global-class
+ (cffi:null-pointer)
+ (cffi:null-pointer))))
+
+ (with-float-traps-masked ()
+ (smlib:js-init-standard-classes context global-obj))
+
+ lisp-context)))
+
+(defmacro with-js-context ((var) &body body)
+ "Creates a new Javascript context and binds it to var, then evaluates body."
+ `(let ((*js-context* nil))
+ (create-js-environment)
+ (unwind-protect
+ (let ((,var *js-context*))
+ ,@body)
+ (destroy-foreign-context (foreign-context *js-context*)))))
+
+(defun init-global-class (class)
+ (cffi:with-foreign-slots ((smlib:name
+ smlib:flags
+ smlib:add-property
+ smlib:del-property
+ smlib:get-property
+ smlib:set-property
+ smlib:enumerate
+ smlib:resolve
+ smlib:convert
+ smlib:finalize
+ smlib:get-object-ops
+ smlib:check-access
+ smlib:call
+ smlib:construct
+ smlib:xdr-object
+ smlib:has-instance
+ smlib:mark
+ smlib:reserve-slots)
+ class
+ smlib:js-class)
+ (cffi:with-foreign-string (global-str "global")
+ (setf smlib:name global-str
+ smlib:flags smlib:+jsclass-global-flags+
+ smlib:add-property (cffi:foreign-symbol-pointer "JS_PropertyStub")
+ smlib:del-property (cffi:foreign-symbol-pointer "JS_PropertyStub")
+ smlib:get-property (cffi:foreign-symbol-pointer "JS_PropertyStub")
+ smlib:set-property (cffi:foreign-symbol-pointer "JS_PropertyStub")
+ smlib:enumerate (cffi:foreign-symbol-pointer "JS_EnumerateStub")
+ smlib:resolve (cffi:foreign-symbol-pointer "JS_ResolveStub")
+ smlib:convert (cffi:foreign-symbol-pointer "JS_ConvertStub")
+ smlib:finalize (cffi:foreign-symbol-pointer "JS_FinalizeStub")
+ smlib:get-object-ops (cffi:null-pointer)
+ smlib:check-access (cffi:null-pointer)
+ smlib:call (cffi:null-pointer)
+ smlib:construct (cffi:null-pointer)
+ smlib:xdr-object (cffi:null-pointer)
+ smlib:has-instance (cffi:null-pointer)
+ smlib:mark (cffi:null-pointer)
+ smlib:reserve-slots (cffi:null-pointer)))
+
+ class))
+
+(defun destroy-foreign-context (context)
+ (smlib:js-destroy-context context))
+
+(defun destroy-js-runtime (runtime)
+ (smlib:js-finish runtime)
+ #+nil
+ (smlib:js-shut-down))
View
19 src/spidermonkey-bindings.lisp
@@ -699,10 +699,6 @@
(cl:ash (cl:logand n +jsclass-reserved-slots-mask+)
+jsclass-reserved-slots-shift+)))
-(cl:defconstant +jsclass-global-flags+ (cl:logior +jsclass-is-global+
- (jsclass-has-reserved-slots
- (cffi:foreign-enum-value 'smlib:js-proto-key :js-proto-limit))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; jsval business
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -735,17 +731,18 @@
(cl:declare (cl:type cl:integer int))
(cl:logior (cl:ash int 1) 1))
-
- (cl:defun jsval-intp (jsval)
- (cl:and (cl:not (cl:= 0 (cl:logand jsval +jsval-int+)))
- (cl:not (cl:= jsval +jsval-void+))))
-
(cl:defun jsval-to-int (jsval)
+ #+nil
(cl:declare (cl:type (cl:satisfies jsval-intp) jsval))
(cl:ash jsval -1))
(cl:defconstant +jsval-void+ (jsval-for-int (cl:- 0 (cl:ash 1 30))))
+ (cl:defun jsval-intp (jsval)
+ (cl:and (cl:not (cl:= 0 (cl:logand jsval +jsval-int+)))
+ (cl:not (cl:= jsval +jsval-void+))))
+
+
(cl:defun jsval-for-boolean (t-or-nil)
(cl:let ((x (cl:if t-or-nil 1 0)))
(cl:logior (cl:ash x +jsval-tagbits+)
@@ -2435,6 +2432,10 @@
(:js-proto-no-such-method 32)
(:js-proto-limit 33))
+(cl:defconstant +jsclass-global-flags+ (cl:logior +jsclass-is-global+
+ (jsclass-has-reserved-slots
+ (cffi:foreign-enum-value 'smlib:js-proto-key :js-proto-limit))))
+
(cffi:defcfun ("JS_GetClassObject" js-get-class-object) js-bool (cx :pointer)
(obj :pointer)
(key js-proto-key)
View
25 src/util.lisp
@@ -1,23 +1,28 @@
(in-package :cl-spidermonkey)
-
-(defun evaluate-js (code)
+(defun evaluate-js-raw (code)
"Evaluates the Javascript code CODE and returns the jsval result."
(cffi:with-foreign-strings ((js code)
(filename "string.js"))
(cffi:with-foreign-object (rval 'smlib:jsval)
(if (not (eql 0
- (with-float-traps-masked ()
- (smlib:js-evaluate-script *js-context* *global*
- js
- (length code)
- filename
- 20
- rval))))
+ (let ((foreign-context (foreign-context *js-context*)))
+ (with-float-traps-masked ()
+ (smlib:js-evaluate-script foreign-context
+ (smlib:js-get-global-object foreign-context)
+ js
+ (length code)
+ filename
+ 20
+ rval)))))
(cffi:mem-ref rval 'smlib:jsval)
(error "Error evaluating script.")))))
+(defun evaluate-js (code)
+ "Evaluates the Javascript code CODE and returns the jsval result."
+ (evaluate-js-raw code))
+
(defun js-value-to-lisp (jsval)
"Given some rval, returns the lisp equivalent value if there is one,
otherwise returns the original value."
@@ -45,7 +50,7 @@ otherwise returns the original value."
(cond
((smlib:jsval-doublep jsval)
(cffi:with-foreign-object (d :double)
- (if (not (= 0 (smlib:js-value-to-number *js-context*
+ (if (not (= 0 (smlib:js-value-to-number (foreign-context *js-context*)
jsval
d)))
(cffi:mem-ref d :double)
View
76 test/jsval-tests.lisp
@@ -0,0 +1,76 @@
+(in-package :cl-spidermonkey-tests)
+
+(in-suite spidermonkey-tests)
+
+(deftest test-environment-is-sane? ()
+ (is t))
+
+(deftest can-setup-environment? ()
+ nil)
+
+(deftest can-evaluate? ()
+ (sm::with-js-context (context)
+ (is context)
+ (spidermonkey::evaluate-js-raw "true;")))
+
+(deftest bool-matches-evaluation? ()
+ (sm::with-js-context (context)
+ (is (eql smlib:+jsval-true+
+ (spidermonkey::evaluate-js-raw "true;")))
+ (is (eql smlib:+jsval-false+
+ (spidermonkey::evaluate-js-raw "false;")))))
+
+
+(deftest null-matches-evaluation? ()
+ (sm::with-js-context (context)
+ (is (eql smlib:+jsval-void+
+ (spidermonkey::evaluate-js-raw "undefined;")))
+ (is (eql smlib:+jsval-null+
+ (spidermonkey::evaluate-js-raw "null;")))))
+
+(deftest void-matches-evaluation? ()
+ (sm::with-js-context (context)
+ (is (eql smlib:+jsval-void+
+ (spidermonkey::evaluate-js-raw "undefined;")))
+
+(deftest constant-ints-match-evaluation? ()
+ (sm::with-js-context (context)
+ (is (eql smlib:+jsval-zero+
+ (spidermonkey::evaluate-js-raw "0;")))))
+
+(deftest basic-ints-match-evaluation? ()
+ (sm::with-js-context (context)
+ (is (eql (smlib:jsval-for-int 10)
+ (spidermonkey::evaluate-js-raw "10;")))
+ (is (eql (smlib:jsval-for-int 15)
+ (spidermonkey::evaluate-js-raw "5 + 10;")))
+ (is (eql (smlib:jsval-for-int -1)
+ (spidermonkey::evaluate-js-raw "-1;")))))
+
+(deftest test-jsval-predicates ()
+ (sm::with-js-context (context)
+ (let ((true (spidermonkey::evaluate-js-raw "true;"))
+ (zero (spidermonkey::evaluate-js-raw "0;"))
+ (d (spidermonkey::evaluate-js-raw "2.5;")))
+ (is (and (smlib:jsval-booleanp true)
+ (not (smlib:jsval-intp true))
+ (not (smlib:jsval-doublep true))
+ (not (smlib:jsval-objectp true))
+ (not (smlib:jsval-voidp true))
+ (not (smlib:jsval-stringp true))))
+
+ (let ((x zero))
+ (is (and (not (smlib:jsval-booleanp x))
+ (smlib:jsval-intp x)
+ (not (smlib:jsval-doublep x))
+ (not (smlib:jsval-objectp x))
+ (not (smlib:jsval-voidp x))
+ (not (smlib:jsval-stringp x)))))
+
+ (let ((x d))
+ (is (and (not (smlib:jsval-booleanp x))
+ (not (smlib:jsval-intp x))
+ (smlib:jsval-doublep x)
+ (not (smlib:jsval-objectp x))
+ (not (smlib:jsval-voidp x))
+ (not (smlib:jsval-stringp x))))))))
View
12 test/test-package.lisp
@@ -0,0 +1,12 @@
+(cl:in-package :cl-user)
+
+(defpackage :cl-spidermonkey-tests
+ (:nicknames :spidermonkey-tests)
+ (:use :cl :alexandria :anaphora :hu.dwim.stefil :cl-spidermonkey)
+ (:export #:spidermonkey-tests))
+
+(in-package :cl-spidermonkey-tests)
+
+(defsuite spidermonkey-tests)
+
+
View
20 vendor/install-spidermonkey.sh
@@ -0,0 +1,20 @@
+#!/bin/sh
+
+# ensure no errors
+set -e
+
+# download and untar
+wget http://ftp.mozilla.org/pub/mozilla.org/js/js-1.8.0-rc1.tar.gz
+tar -xzf js-1.8.0-rc1.tar.gz
+rm js-1.8.0-rc1.tar.gz
+
+# make
+cd js
+cd src/
+make -f Makefile.ref
+
+# install
+cp *.{h,tbl} ../../../include/
+cd Linux_All_DBG.OBJ/
+cp *.h ../../../../include/
+cp js ../../../../bin/
Please sign in to comment.
Something went wrong with that request. Please try again.