GLIL and assembly support for prompt compilation

* module/language/glil/compile-assembly.scm (glil->assembly): Compile
  <glil-prompt> appropriately.

* module/language/assembly/disassemble.scm (code-annotation):
* module/language/assembly/decompile-bytecode.scm (decode-load-program):
* module/language/assembly/compile-bytecode.scm (write-bytecode):
  Assemble and disassemble `prompt' appropriately.

diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm
index e6fc5bc..f045148 100644 (file)
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -1,6 +1,6 @@
 ;;; Guile VM assembler
 
-;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -141,6 +141,8 @@
         ((br-if-nargs-lt ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l))
         ((br-if-nargs-gt ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l))
         ((mv-call ,n ,l) (write-byte n) (write-break l))
+        ((prompt ,inline-handler? ,escape-only? ,l)
+         (write-byte inline-handler?) (write-byte escape-only?) (write-break l))
         (else
          (cond
           ((< (instruction-length inst) 0)

diff --git a/module/language/assembly/decompile-bytecode.scm b/module/language/assembly/decompile-bytecode.scm
index 6d41da2..a021b57 100644 (file)
--- a/module/language/assembly/decompile-bytecode.scm
+++ b/module/language/assembly/decompile-bytecode.scm
@@ -1,6 +1,6 @@
 ;;; Guile VM code converters
 
-;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -90,6 +90,8 @@
                   (lp (cons `(,br ,hi ,lo ,(ensure-label rel1 rel2 rel3)) out)))
                  ((mv-call ,n ,rel1 ,rel2 ,rel3)
                   (lp (cons `(mv-call ,n ,(ensure-label rel1 rel2 rel3)) out)))
+                 ((prompt ,n0 ,n1 ,rel1 ,rel2 ,rel3)
+                  (lp (cons `(prompt ,n0 ,n1 ,(ensure-label rel1 rel2 rel3)) out)))
                  (else 
                   (lp (cons exp out))))))))))
 

diff --git a/module/language/assembly/disassemble.scm b/module/language/assembly/disassemble.scm
index d072d3b..e74be1b 100644 (file)
--- a/module/language/assembly/disassemble.scm
+++ b/module/language/assembly/disassemble.scm
@@ -150,6 +150,9 @@
                   (list "`~s'" v)))))
       ((mv-call)
        (list "MV -> ~A" (assq-ref labels (cadr args))))
+      ((prompt)
+       ;; the H is for handler
+       (list "H -> ~A" (assq-ref labels (caddr args))))
       (else
        (and=> (assembly->object code)
               (lambda (obj) (list "~s" obj)))))))

diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index 53c423d..95804ec 100644 (file)
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -512,7 +512,12 @@
               (error "Wrong number of stack arguments to instruction:" inst nargs)))))
 
     ((<glil-mv-call> nargs ra)
-     (emit-code `((mv-call ,nargs ,ra))))))
+     (emit-code `((mv-call ,nargs ,ra))))
+
+    ((<glil-prompt> label inline? escape-only?)
+     (emit-code `((prompt ,(if inline? 1 0)
+                          ,(if escape-only? 1 0)
+                          ,label))))))
 
 (define (dump-object x addr)
   (define (too-long x)