diff --git a/compiler.rkt b/compiler.rkt index dd23e93..6d2d39d 100644 --- a/compiler.rkt +++ b/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) diff --git a/input.rkt b/input.rkt index 92fc2c8..a0b3c1d 100644 --- a/input.rkt +++ b/input.rkt @@ -1 +1 @@ -"hello, world!" +(vector-length (make-vector 5)) diff --git a/test-cases.rkt b/test-cases.rkt index 120b930..8775dd5 100644 --- a/test-cases.rkt +++ b/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"