Permalink
Browse files

Added more custom binding business to spidermonkey-bindings.lisp

  • Loading branch information...
1 parent 2feca7d commit 24941abf632237d752ec84c4cfb5c79b84f20ef2 @gonzojive committed Jul 1, 2010
Showing with 301 additions and 85 deletions.
  1. +3 −1 src/c/compile.sh
  2. +9 −0 src/c/grovel.c
  3. +2 −0 src/c/run-grovel.sh
  4. +133 −0 src/demo.lisp
  5. +128 −1 src/spidermonkey-bindings.lisp
  6. +26 −83 src/util.lisp
View
4 src/c/compile.sh 100644 → 100755
@@ -1 +1,3 @@
-gcc -I ../../include/ -l js -L ../../lib/ example.c -o example
+#!/bin/sh
+#gcc -I ../../include/ -l js -L ../../lib/ example.c -o example
+gcc -I ../../include/ -l js -L ../../lib/ grovel.c -o cl-spidermonkey-grovel
View
@@ -0,0 +1,9 @@
+#define XP_UNIX
+#include "jsapi.h"
+
+int main(int argc, const char *argv[])
+{
+ printf("(defconstant +jsval-void+ %lu)\n", JSVAL_VOID);
+
+ return 0;
+}
View
@@ -0,0 +1,2 @@
+#!/bin/sh
+LD_LIBRARY_PATH=../../lib ./cl-spidermonkey-grovel
View
@@ -0,0 +1,133 @@
+(in-package :cl-spidermonkey)
+
+(cffi:defcallback my-report-error :void ((context smlib:js-context)
+ (message :string)
+ (report smlib:js-error-report))
+ (format t "My report error: ~A" message))
+
+#+nil
+(cffi:load-foreign-library "libjs.so" :search-path "/git/cl-spidermonkey/lib/")
+
+(defparameter *rt* nil)
+(defparameter *js-context* nil)
+(defparameter *js-global-class* nil)
+(defparameter *global* nil)
+
+(defun demo()
+ (defparameter *rt* (smlib:js-init (* 1024 1024 8)))
+ (defparameter *js-context* (smlib:js-new-context *rt* (* 1024 1024 8)))
+
+ (smlib:js-set-options *js-context* smlib:+jsoption-var-obj-fix+)
+ (smlib:js-set-version *js-context* :jsversion-latest)
+
+
+ (smlib:js-set-error-reporter *js-context* (cffi:callback my-report-error))
+
+ (defparameter *js-global-class* (smlib:js-malloc *js-context*
+ (cffi:foreign-type-size 'smlib:js-class)))
+
+ (make-js-class *js-global-class*)
+
+ (defparameter *global*
+ (smlib:js-new-object *js-context* *js-global-class*
+ (cffi:null-pointer)
+ (cffi:null-pointer)))
+
+ (with-float-traps-masked ()
+ (smlib:js-init-standard-classes *js-context* *global*))
+
+ (when nil
+ (smlib:js-destroy-context *js-context*)
+ (smlib:js-finish *rt*)
+ #+nil
+ (smlib:js-shut-down)))
+
+(defun evaluate-js-arith (&optional (code "5 + 5"))
+ (cffi:with-foreign-strings ((js code)
+ (filename "string.js"))
+ (cffi:with-foreign-object (rval 'smlib:jsval)
+ (when (not (eql 0
+ (smlib:js-evaluate-script *js-context* *global*
+ js
+ (length code)
+ filename
+ 20
+ rval)))
+ (cffi:with-foreign-object (d :double)
+ (smlib:js-value-to-number *js-context*
+ (cffi:mem-ref rval 'smlib:jsval)
+ d)
+
+ (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 (
+ (cffi:with-foreign-object (d :double)
+ (smlib:js-value-to-number *js-context*
+ (cffi:mem-ref rval 'smlib:jsval)
+ d)
+
+ (cffi:mem-ref d :double))
+
+(defun make-js-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))
+
+
+
@@ -597,10 +597,59 @@
"JS-CONTEXT"
"JS-BOOL"
"JS-INTN"
+ ;;;; Custom exports
"+JSOPTION-STRICT+"
"+JSOPTION-VAR-OBJ-FIX+"
"+JSCLASS-GLOBAL-FLAGS+"
- "+JSCLASS-HAS-PRIVATE+"))
+ "+JSCLASS-HAS-PRIVATE+"
+
+
+ ;; JSVAL specific types
+ "+JSVAL-BOOLEAN+"
+ "+JSVAL-DOUBLE+"
+ "+JSVAL-INT+"
+ "+JSVAL-OBJECT+"
+ "+JSVAL-STRING+"
+
+ ;; JSVAL constant values
+ "+JSVAL-NULL+"
+ "+JSVAL-VOID+"
+ "+JSVAL-ZERO+"
+ "+JSVAL-TRUE+"
+ "+JSVAL-FALSE+"
+
+ "+JSVAL-INT-MAX+"
+ "+JSVAL-INT-MIN+"
+ "+JSVAL-INT-BITS+"
+
+ "+JSVAL-TAGBITS+"
+ "+JSVAL-TAGMASK+"
+
+ ;; JSVAL functions
+ "JSVAL-BOOLEANP"
+ "JSVAL-DOUBLEP"
+ "JSVAL-INTP"
+ "JSVAL-NULLP"
+ "JSVAL-OBJECTP"
+ "JSVAL-VOIDP"
+
+ "JSVAL-FOR-INT"
+ "JSVAL-TAG"
+ "JSVAL-TO-INT"
+
+ "JSVAL-TO-BOOLEAN"
+
+ ))
+
+#+nil
+(let ((syms nil)) (do-symbols (x :smlib) (push x syms))
+ (setf syms (mapcar #'string syms))
+ (setf syms (sort syms #'string-lessp))
+ (setf syms (remove-if #'(lambda (x)
+ (not (eql (length "+JSVAL")
+ (mismatch "+JSVAL" x))))
+ syms))
+ syms)
(cl:in-package :spidermonkey-bindings)
@@ -649,6 +698,83 @@
(jsclass-has-reserved-slots
(cffi:foreign-enum-value 'smlib:js-proto-key :js-proto-limit))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;; jsval business
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(cl:defconstant +jsval-object+ 0)
+(cl:defconstant +jsval-int+ 1)
+(cl:defconstant +jsval-double+ 2)
+(cl:defconstant +jsval-string+ 4)
+(cl:defconstant +jsval-boolean+ 6)
+
+
+(cl:defconstant +jsval-null+ 0)
+
+
+(cl:defconstant +jsval-tagbits+ 3)
+(cl:defconstant +jsval-tagmask+ (js-bitmask +jsval-tagbits+))
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+ (cl:defun jsval-tag (jsval)
+ (cl:logand jsval +jsval-tagmask+))
+
+ ;; jsval integer stuff
+ (cl:defconstant +jsval-int-bits+ 31)
+ (cl:defconstant +jsval-int-min+ (cl:- 1 (cl:ash 1 30)))
+ (cl:defconstant +jsval-int-max+ (cl:- (cl:ash 1 30) 1))
+
+ (cl:defun int-fits-in-jsval? (int)
+ (cl:declare (cl:type cl:integer int))
+ (cl:<= +jsval-int-min+ int +jsval-int-max+))
+
+ (cl:defun jsval-for-int (int)
+ (cl:declare (cl:type cl:integer int))
+ (cl:logior (cl:ash int 1) 1))
+
+
+ (cl:defun jsval-intp (jsval)
+ (cl:and (cl:= +jsval-int+ (jsval-tag jsval))
+ (cl:not (cl:= jsval +jsval-void+))))
+
+ (cl:defun jsval-to-int (jsval)
+ (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-for-boolean (t-or-nil)
+ (cl:let ((x (cl:if t-or-nil 1 0)))
+ (cl:logior (cl:ash x +jsval-tagbits+)
+ +jsval-boolean+)))
+
+ ;;; predicates for jsval types
+ (cl:defun jsval-voidp (jsval)
+ (cl:= jsval +jsval-void+))
+
+ (cl:defun jsval-objectp (jsval)
+ (cl:= +jsval-object+ (jsval-tag jsval)))
+
+ (cl:defun jsval-doublep (jsval)
+ (cl:= +jsval-double+ (jsval-tag jsval)))
+
+ (cl:defun jsval-booleanp (jsval)
+ (cl:= +jsval-boolean+ (jsval-tag jsval)))
+
+ (cl:defun jsval-nullp (jsval)
+ (cl:= jsval +jsval-null+))
+
+
+
+ (cl:defconstant smlib::+jsval-zero+ (jsval-for-int 0))
+ (cl:defconstant smlib::+jsval-one+ (jsval-for-int 1))
+
+ (cl:defconstant smlib::+jsval-false+ (jsval-for-boolean cl:nil))
+ (cl:defconstant smlib::+jsval-true+ (jsval-for-boolean cl:t)))
+
+
+
+
+
+
(cl:defun vtable-lookup (pobj indx coff)
@@ -2375,6 +2501,7 @@
(cffi:defcfun ("_ZN7JSClassC1ERKS_" js-class-constructor) :void (this :pointer)
(arg1 js-class))
+#+nil
(cl:defun js-class-new ()
(cl:let ((instance (cffi:foreign-alloc 'js-class)))
(js-class-constructor instance)
Oops, something went wrong.

0 comments on commit 24941ab

Please sign in to comment.