adding paired labels so I can do some limited dynamic jumps

assemble.rkt

@@ -68,31 +68,59 @@ EOF
             [(null? stmts)
              (reverse (cons (make-BasicBlock name (reverse acc))
                             basic-blocks))]
-            [(symbol? (car stmts))
-             (cond
-               [(member (car stmts) jump-targets)
-                (loop (car stmts)
-                      '()
-                      (cons (make-BasicBlock name  
-                                             (if last-stmt-goto? 
-                                                 (reverse acc)
-                                                 (reverse (append `(,(make-GotoStatement (make-Label (car stmts))))
-                                                                  acc))))
-                            basic-blocks)
-                      (cdr stmts)
-                      last-stmt-goto?)]
-               [else
-                (loop name
-                      acc
-                      basic-blocks
-                      (cdr stmts)
-                      last-stmt-goto?)])]
             [else
-             (loop name
+             (let ([first-stmt (car stmts)])
-                   (cons (car stmts) acc)
+               (cond
-                   basic-blocks
+                 
-                   (cdr stmts)
+                 [(symbol? first-stmt)
-                   (GotoStatement? (car stmts)))]))))
+                  (cond
+                    [(member first-stmt jump-targets)
+                     (loop first-stmt
+                           '()
+                           (cons (make-BasicBlock 
+                                  name  
+                                  (if last-stmt-goto? 
+                                      (reverse acc)
+                                      (reverse (append `(,(make-GotoStatement (make-Label first-stmt)))
+                                                       acc))))
+                                 basic-blocks)
+                           (cdr stmts)
+                           last-stmt-goto?)]
+                    [else
+                     (loop name
+                           acc
+                           basic-blocks
+                           (cdr stmts)
+                           last-stmt-goto?)])]
+                 
+                 [(PairedLabel? first-stmt)
+                  (cond
+                    [(member (PairedLabel-label first-stmt) jump-targets)
+                     (loop (PairedLabel-label first-stmt)
+                           '()
+                           (cons (make-BasicBlock 
+                                  name  
+                                  (if last-stmt-goto? 
+                                      (reverse acc)
+                                      (reverse (append `(,(make-GotoStatement 
+                                                           (make-Label (PairedLabel-label first-stmt))))
+                                                       acc))))
+                                 basic-blocks)
+                           (cdr stmts)
+                           last-stmt-goto?)]
+                    [else
+                     (loop name
+                           acc
+                           basic-blocks
+                           (cdr stmts)
+                           last-stmt-goto?)])]
+                 
+                 [else
+                  (loop name
+                        (cons first-stmt acc)
+                        basic-blocks
+                        (cdr stmts)
+                        (GotoStatement? first-stmt))]))]))))
 
 
 
@@ -176,6 +204,8 @@ EOF
                   (append (cond
                             [(symbol? stmt)
                              empty]
+                            [(PairedLabel? stmt)
+                             (list (PairedLabel-previous stmt))]
                             [(AssignImmediateStatement? stmt)
                              (let: ([v : OpArg (AssignImmediateStatement-value stmt)])
                                    (cond 

il-structs.rkt

@@ -52,6 +52,9 @@
 
 
 
+  
+
+
 ;; instruction sequences
 (define-type UnlabeledStatement (U 
                                  
@@ -73,6 +76,7 @@
 
 (define-type Statement (U UnlabeledStatement
                           Symbol  ;; label
+                          PairedLabel
                           ))
 
 (define-struct: AssignImmediateStatement ([target : Target]
@@ -292,6 +296,24 @@
 
 
 
+;; A PairedLabel is like a regular label, but it knows about
+;; a previous label as well.  Used for efficient implementation 
+;; of multiple return values.
+(define-struct: PairedLabel ([label : Symbol]
+                             [previous : Symbol]))
+
+
+
+(: make-paired-labels (Symbol -> (values Symbol PairedLabel)))
+(define (make-paired-labels name)
+  (let* ([first-label (make-label name)]
+         [second-label (make-label name)])
+  (values first-label (make-PairedLabel second-label first-label))))
+
+
+
+
+
 
 ;; Linkage
 (define-struct: NextLinkage ())

simulator.rkt

@@ -61,6 +61,8 @@
                           (let: ([stmt : Statement (vector-ref (machine-text m) i)])
                                 (when (symbol? stmt)
                                   (hash-set! (machine-jump-table m) stmt i))
+                                (when (PairedLabel? stmt)
+                                  (hash-set! (machine-jump-table m) (PairedLabel-label stmt) i))
                                 (loop (add1 i)))))
                   m))]))
 
@@ -88,6 +90,8 @@
                   (cond
                     [(symbol? i)
                      'ok]
+                    [(PairedLabel? i)
+                     'ok]
                     [(AssignImmediateStatement? i)
                      (step-assign-immediate! m i)]
                     [(AssignPrimOpStatement? i)