Add vector-length primitive.

compiler.rkt

@@ -139,7 +139,7 @@
   (and (list? x)
     (member (first x)
       '(add1 sub1 integer->char char->integer zero? integer? boolean?
-        pair? + - * = < car cdr make-vector vector?))))
+        pair? + - * = < car cdr make-vector vector-length vector?))))
 
 (define (primcall-op x) (first x))
 (define (primcall-operand1 x) (second x))
@@ -259,7 +259,11 @@
      (emit-expr (primcall-operand1 x) si env)
      (mov (offset (- word-size 1) scratch) scratch))]
     [(make-vector) (list
-     (emit-vector x si env))]))
+     (emit-vector x si env))]
+    [(vector-length) (list
+     (emit-vector-length x si env))]
+    [(vector-ref) (list
+     )]))
 
 ; todo: memcpy, duh
 (define (zerofill n dest)
@@ -289,6 +293,16 @@
     (align-to-dword scratch-2)
     (add scratch-2 heap-register)))
 
+(define (emit-vector-length x si env)
+  (list
+    (emit-expr (primcall-operand1 x) si env)
+    (fail-if-not-type vector-tag heap-mask)
+    (and! (bitwise-not heap-mask) scratch)
+    (mov (offset 0 scratch) scratch)))
+
+(define (fail-if-not-type tag mask)
+  (void))
+
 (define (data-ref label-name)
   (if (equal? (arch-name current-arch) "x86")
     (format "~a" label-name)

input.rkt

@@ -1 +1 @@
-"hello, world!"
+(vector-length (make-vector 5))

test-cases.rkt

@@ -127,8 +127,8 @@
 (test-case
   "Cons"
 
-  (check-prog '(cons 10 20) "(10 . 20)"))
-  (check-prog '(cons 10 (cons 20 30)) "(10 . (20 . 30))")
+  (check-prog '(cons 10 20) "(10 . 20)")
+  (check-prog '(cons 10 (cons 20 30)) "(10 . (20 . 30))"))
 
 (test-case
   "Car/Cdr"
@@ -145,7 +145,9 @@
   (check-prog '(make-vector 1) "#(0)")
   (check-prog '(vector? (make-vector 1)) "#t")
   (check-prog '(vector? #f) "#f")
-  (check-prog '(vector? 5) "#f"))
+  (check-prog '(vector? 5) "#f")
+
+  (check-prog '(vector-length (make-vector 30)) "30"))
 
 (test-case
   "Strings"