Permalink
Browse files

Added return message

  • Loading branch information...
1 parent 9cba588 commit 358dba4b70714de5dfb19dbce43a9d18a93f9d82 @gnuvince gnuvince committed May 23, 2012
Showing with 22 additions and 11 deletions.
  1. +5 −0 gsc/_back.scm
  2. +12 −10 gsc/_t-univ.scm
  3. +2 −0 gsc/target_js.scm
  4. +3 −1 gsc/target_php.scm
View
@@ -106,6 +106,11 @@
;; in a GVM "switch" instruction.
;;
;; file-extension The file extension for generated files.
+;;
+;; generator Procedure (lambda (msg . args) ...).
+;; This procedure takes a message and some arguments and
+;; returns the proper instruction in the target language.
+;; See target_js.scm for the list of recognized messages.
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
View
@@ -384,12 +384,11 @@
(false (ifjump-false gvm-instr))
(adj (sp-adjust ctx (frame-size (gvm-instr-frame gvm-instr)) " ")))
(gen
+ adj
(targ-gen 'if
(prim-applic ctx test opnds #t)
- (gen adj
- "return " (translate-gvm-opnd ctx (make-lbl true)) ";")
- (gen adj
- "return " (translate-gvm-opnd ctx (make-lbl false)) ";"))
+ (targ-gen 'return (translate-gvm-opnd ctx (make-lbl true)))
+ (targ-gen 'return (translate-gvm-opnd ctx (make-lbl false))))
(targ-gen 'label-stop))))
@@ -408,16 +407,19 @@
;; test: (jump-poll? gvm-instr)
(gen (let ((nb-args (jump-nb-args gvm-instr)))
(if nb-args
- (gen
- (targ-gen 'var-name 'nargs)
- " = " nb-args ";\n")
+ (targ-gen 'copy
+ (targ-gen 'var-name 'nargs)
+ nb-args)
""))
(sp-adjust ctx (frame-size (gvm-instr-frame gvm-instr)) "\n")
(let ((opnd (jump-opnd gvm-instr)))
(if (jump-poll? gvm-instr)
- (gen "nextpc = " (translate-gvm-opnd ctx opnd) ";\n"
- "return null;\n")
- (gen "return " (translate-gvm-opnd ctx opnd) ";\n")))
+ (gen
+ (targ-gen 'copy
+ (targ-gen 'var-name 'nextpc)
+ (translate-gvm-opnd ctx opnd))
+ (targ-gen 'return (targ-gen 'void)))
+ (targ-gen 'return (translate-gvm-opnd ctx opnd))))
(targ-gen 'label-stop)))
(else
View
@@ -27,6 +27,7 @@
"} else {\n"
else_
"}\n"))
+ (define (return expr) (gen "return " expr ";\n"))
(let ((fn (case msg
((entry-point) entry-point)
@@ -47,6 +48,7 @@
((copy) copy)
((apply) apply_)
((if) if_)
+ ((return) return)
(else
(compiler-internal-error "unknown message" msg)))))
(apply fn args)))
View
@@ -8,7 +8,7 @@
(define (clo lval index) (gen lval "[" index "]"))
(define (lbl name) (gen "'" name "'"))
(define (adjust-sp offset) (gen "$sp += " offset ";\n"))
- (define (void) (gen "UNDEFINED"))
+ (define (void) (gen "null"))
(define (proc-obj proc) (gen "'" proc "'"))
(define (label-start name)
(gen
@@ -35,6 +35,7 @@
"} else {\n"
else_
"}\n"))
+ (define (return expr) (gen "return " expr ";\n"))
@@ -57,6 +58,7 @@
((copy) copy)
((apply) apply_)
((if) if_)
+ ((return) return)
(else
(compiler-internal-error "unknown message" msg)))))
(apply fn args)))

0 comments on commit 358dba4

Please sign in to comment.