compile `list' and `vector' to their associated opcodes
authorAndy Wingo <wingo@pobox.com>
Wed, 20 May 2009 11:33:44 +0000 (13:33 +0200)
committerAndy Wingo <wingo@pobox.com>
Wed, 20 May 2009 11:33:44 +0000 (13:33 +0200)
* module/language/glil/compile-assembly.scm (glil->assembly): Check the
  length when emitting calls to variable-argument stack instructions.
  Allow two-byte lengths -- allows e.g. calls to `list' with more than
  256 arguments.

* module/language/tree-il/compile-glil.scm: Add primcall associations for
  `list' and `vector', with any number of arguments. Necessary because
  syncase's quasiquote expansions will produce calls to `list' with many
  arguments.

* module/language/tree-il/optimize.scm (*interesting-primitive-names*):
  Add `list' and `vector' to the set of primitives to resolve.

module/language/glil/compile-assembly.scm
module/language/tree-il/compile-glil.scm
module/language/tree-il/optimize.scm

index 73b2cd1..4c92e0f 100644 (file)
          (error "Unknown instruction:" inst))
      (let ((pops (instruction-pops inst)))
        (cond ((< pops 0)
-              (emit-code `((,inst ,nargs))))
+              (case (instruction-length inst)
+                ((1) (emit-code `((,inst ,nargs))))
+                ((2) (emit-code `((,inst ,(quotient nargs 256)
+                                         ,(modulo nargs 256)))))
+                (else (error "Unknown length for variable-arg instruction:"
+                             inst (instruction-length inst)))))
              ((= pops nargs)
               (emit-code `((,inst))))
              (else
index 78e2d1e..17592d2 100644 (file)
@@ -79,7 +79,9 @@
    ((set-car! . 2) . set-car!)
    ((set-cdr! . 2) . set-cdr!)
    ((null? . 1) . null?)
-   ((list? . 1) . list?)))
+   ((list? . 1) . list?)
+   (list . list)
+   (vector . vector)))
 
 (define (make-label) (gensym ":L"))
 
                    (emit-code src (make-glil-call 'drop 1)))))
 
         ((and (primitive-ref? proc)
-              (hash-ref *primcall-ops*
-                        (cons (primitive-ref-name proc) (length args))))
+              (or (hash-ref *primcall-ops*
+                            (cons (primitive-ref-name proc) (length args)))
+                  (hash-ref *primcall-ops* (primitive-ref-name proc))))
          => (lambda (op)
               (for-each comp-push args)
               (emit-code src (make-glil-call op (length args)))
index 03193b2..57755ea 100644 (file)
@@ -53,6 +53,8 @@
     not
     pair? null? list? acons cons cons*
 
+    list vector
+
     car cdr
     set-car! set-cdr!