Permalink
Browse files

Extend universal backend with minimal FFI functionality for JavaScript

  • Loading branch information...
1 parent 49a2971 commit 815cf3d9f936f1199fab4f4b6a1019a62445a2a4 @feeley feeley committed Feb 18, 2014
Showing with 131 additions and 2 deletions.
  1. +129 −0 gsc/_t-univ.scm
  2. +2 −2 include/stamp.h
View
@@ -2741,6 +2741,7 @@ EOF
(^call-prim
(^global-prim-function (^prefix (univ-use-rtlib ctx 'tostr)))
(^getreg 1))))
+ (^setreg 1 (^void))
(^return (^getreg 0))))
"\n"
@@ -2933,6 +2934,128 @@ EOF
(compiler-internal-error
"univ-rtlib-feature, unknown target")))))
+ ((ffi)
+ (case (target-name (ctx-target ctx))
+
+ ((js)
+ (^
+
+#<<EOF
+function Gambit_js2scm(obj) {
+ if (obj === void 0) {
+ return obj;
+ } else if (typeof obj === "boolean") {
+ return obj;
+ } else if (obj === null) {
+ return obj;
+ } else if (typeof obj === "number") {
+ if ((obj|0) === obj && obj>=-536870912 && obj<=536870911)
+ return obj
+ else
+ return new Gambit_Flonum(obj);
+ } else if (typeof obj === "function") {
+ return function () { return Gambit_scm2js_call(obj); };
+ } else if (typeof obj === "string") {
+ return new Gambit_String(Gambit_strtocodes(obj));
+ } else if (typeof obj === "object") {
+ if (obj instanceof Array) {
+ return obj.map(Gambit_js2scm);
+ } else {
+ throw "Gambit_js2scm error";
+ }
+ } else {
+ throw "Gambit_js2scm error";
+ }
+}
+
+function Gambit_scm2js(obj) {
+ if (obj === void 0) {
+ return obj;
+ } else if (typeof obj === "boolean") {
+ return obj;
+ } else if (obj === null) {
+ return obj;
+ } else if (typeof obj === "number") {
+ return obj
+ } else if (typeof obj === "function") {
+ return function () { return Gambit_js2scm_call(obj, arguments); };
+ } else if (typeof obj === "object") {
+ if (obj instanceof Array) {
+ return obj.map(Gambit_scm2js);
+ } else if (obj instanceof Gambit_String) {
+ return obj.toString();
+ } else if (obj instanceof Gambit_Flonum) {
+ return obj.val;
+ } else {
+ throw "Gambit_scm2js error";
+ }
+ } else {
+ throw "Gambit_scm2js error";
+ }
+}
+
+function Gambit_scm2js_call(fn) {
+
+ var dest = Gambit_r0;
+
+ if (Gambit_nargs > 0) {
+ Gambit_stack[++Gambit_sp] = Gambit_r1;
+ if (Gambit_nargs > 1) {
+ Gambit_stack[++Gambit_sp] = Gambit_r2;
+ if (Gambit_nargs > 2) {
+ Gambit_stack[++Gambit_sp] = Gambit_r3;
+ }
+ }
+ }
+
+ var args = Gambit_stack.slice(Gambit_sp+1-Gambit_nargs, Gambit_sp+1);
+
+ Gambit_sp -= Gambit_nargs;
+
+ Gambit_r1 = Gambit_js2scm(fn.apply(null, args.map(Gambit_scm2js)));
+
+ return dest;
+}
+
+function Gambit_js2scm_call(proc, args) {
+
+ var pc = proc;
+ var call_done = false;
+
+ Gambit_nargs = args.length;
+
+ for (var i=0; i<Gambit_nargs; i++) {
+ Gambit_stack[++Gambit_sp] = Gambit_js2scm(args[i]);
+ }
+
+ if (Gambit_nargs > 0) {
+ if (Gambit_nargs > 1) {
+ if (Gambit_nargs > 2) {
+ Gambit_r3 = Gambit_stack[Gambit_sp];
+ --Gambit_sp;
+ }
+ Gambit_r2 = Gambit_stack[Gambit_sp];
+ --Gambit_sp;
+ }
+ Gambit_r1 = Gambit_stack[Gambit_sp];
+ --Gambit_sp;
+ }
+
+ Gambit_r0 = function () { call_done = true; return false; };
+
+ while (!call_done) {
+ pc = pc();
+ }
+
+ return Gambit_scm2js(Gambit_r1);
+}
+
+EOF
+))
+
+ (else
+ (^))))
+
(else
(compiler-internal-error
"univ-rtlib-feature, unknown runtime library function" feature))))
@@ -2953,6 +3076,12 @@ EOF
(let ((c (univ-rtlib-feature ctx feature)))
(set! code (^ code c "\n"))))))
+ ;;TODO: make inclusion of these features optional
+ (need-feature 'strtocodes)
+ (need-feature 'String)
+ (need-feature 'Flonum)
+ (need-feature 'ffi)
+
(for-each need-feature
(resource-set->list (ctx-rtlib-features-used ctx)))
View
@@ -2,5 +2,5 @@
* Time stamp of last source code repository commit.
*/
-#define ___STAMP_YMD 20140214
-#define ___STAMP_HMS 214032
+#define ___STAMP_YMD 20140218
+#define ___STAMP_HMS 152752

0 comments on commit 815cf3d

Please sign in to comment.