bitwise operations

villain/ast.rkt

@@ -47,10 +47,10 @@
 ;;           | 'write-byte | 'eof-object?
 ;;           | 'box | 'car | 'cdr | 'unbox
 ;;           | 'string-length | 'string? | make-string    
-;;           | 'empty?  |'vector? |'vector-length |list?
+;;           | 'empty?  |'vector? |'vector-length |list? | 'bitwise-not
 ;; type Op2  = '+ | '- | * | quotient| remainder
 ;;           | 'eq? | 'cons | 'string-ref | 'make-vector 
-;;           | 'vector-ref |'vector-set!
+;;           | 'vector-ref |'vector-set! | 'bitwise-and | 'bitwise-ior | 'bitwise-xor
 ;; type Op3  = 'string-set!
 ;; type Op4  = 'vector-cas!
 ;; type Pat  = (Wild)

villain/bignums.c

@@ -72,6 +72,23 @@ int64_t add_or_sub1(int64_t val, int64_t heap, int64_t delta) { // rdi, rsi, rdx
   }
 }
 
+int64_t bitwise_not(int64_t val1, int64_t heap) { // rdi, rsi, rdx
+
+  int64_t ret;
+  mpz_t integ1;
+  mpz_init(integ1);
+
+  load_any_to_bignum(integ1, val1); // load value
+
+  mpz_com(integ1, integ1);
+
+  ret = return_bignum_maybe_fixnum(integ1, heap);
+
+  mpz_clear(integ1);
+  return ret;
+
+}
+
 int64_t integer_g(int64_t val1, int64_t val2) { // rdi, rsi
   return integer_comparison(val1, val2, 1);
 }
@@ -378,6 +395,63 @@ int64_t integer_remainder(int64_t val1, int64_t val2, int64_t heap) { // rdi, rs
 
 }
 
+int64_t bitwise_and(int64_t val1, int64_t val2, int64_t heap) { // rdi, rsi, rdx
+
+  int64_t ret;
+  mpz_t integ1, integ2;
+  mpz_init(integ1); mpz_init(integ2);
+
+  load_any_to_bignum(integ1, val1); // load value
+  load_any_to_bignum(integ2, val2); // load value
+
+  mpz_and(integ1, integ1, integ2);
+
+  ret = return_bignum_maybe_fixnum(integ1, heap);
+
+  mpz_clear(integ1);
+  mpz_clear(integ2);
+  return ret;
+
+}
+
+int64_t bitwise_ior(int64_t val1, int64_t val2, int64_t heap) { // rdi, rsi, rdx
+
+  int64_t ret;
+  mpz_t integ1, integ2;
+  mpz_init(integ1); mpz_init(integ2);
+
+  load_any_to_bignum(integ1, val1); // load value
+  load_any_to_bignum(integ2, val2); // load value
+
+  mpz_ior(integ1, integ1, integ2);
+
+  ret = return_bignum_maybe_fixnum(integ1, heap);
+
+  mpz_clear(integ1);
+  mpz_clear(integ2);
+  return ret;
+
+}
+
+int64_t bitwise_xor(int64_t val1, int64_t val2, int64_t heap) { // rdi, rsi, rdx
+
+  int64_t ret;
+  mpz_t integ1, integ2;
+  mpz_init(integ1); mpz_init(integ2);
+
+  load_any_to_bignum(integ1, val1); // load value
+  load_any_to_bignum(integ2, val2); // load value
+
+  mpz_xor(integ1, integ1, integ2);
+
+  ret = return_bignum_maybe_fixnum(integ1, heap);
+
+  mpz_clear(integ1);
+  mpz_clear(integ2);
+  return ret;
+
+}
+
 void load_any_to_bignum(mpz_t integ, int64_t val) {
   if (int_type_tag == (int_type_mask & val)) {
     val = val >> int_shift;

villain/compile.rkt

@@ -152,7 +152,11 @@
        (Extern 'integer_add)
        (Extern 'integer_sub)
        (Extern 'integer_quotient)
-       (Extern 'integer_remainder)))
+       (Extern 'integer_remainder)
+       (Extern 'bitwise_not)
+       (Extern 'bitwise_and)
+       (Extern 'bitwise_ior)
+       (Extern 'bitwise_xor)))
 
 ;; [Listof Id] -> Asm
 (define (compile-module-provides ls)
@@ -952,7 +956,31 @@
                 (Xor rax r8)
                 (Bsr rax rax)
                 (Sal rax int-shift)
-                (Label end)))] 
+                (Label end)))]
+         ['bitwise-not
+          (let ((end (gensym))
+                (pos-bignum (gensym)))
+            (seq (assert-integer/bignum rax c)
+               (pad-stack c)
+               (Mov rdi rax)
+               (Mov rsi rbx)
+               (Call 'bitwise_not)
+               (unpad-stack c)
+               (Mov r9 rax)         ; first check if return value is fixnum
+               (And r9 mask-int)
+               (Xor r9 type-int)
+               (Cmp r9 0)
+               (Je end)             ; if not fixnum, we should adjust rbx
+               (Mov r9 (Offset rbx 0))
+               (Cmp r9 -1)
+               (Jg pos-bignum)      ; get absolute value of length
+               (Mov r8 0)
+               (Sub r8 r9)
+               (Mov r9 r8)
+               (Label pos-bignum)
+               (Sar r9 (- int-shift imm-shift))
+               (Add rbx r9)
+               (Label end)))]
          ['char?
           (let ((l1 (gensym)))
             (seq (And rax mask-char)
@@ -1233,6 +1261,87 @@
                (Sar r9 (- int-shift imm-shift))
                (Add rbx r9)
                (Label end)))]
+         ['bitwise-and 
+          (let ((end (gensym))
+                (pos-bignum (gensym))) 
+            (seq (Pop r8)
+               (assert-integer/bignum r8 c)
+               (assert-integer/bignum rax c)
+               (pad-stack c)
+               (Mov rdi r8)
+               (Mov rsi rax)
+               (Mov rdx rbx)
+               (Call 'bitwise_and)
+               (unpad-stack c)
+               (Mov r9 rax)         ; first check if return value is fixnum
+               (And r9 mask-int)
+               (Xor r9 type-int)
+               (Cmp r9 0)
+               (Je end)             ; if not fixnum, we should adjust rbx
+               (Mov r9 (Offset rbx 0))
+               (Cmp r9 -1)
+               (Jg pos-bignum)      ; get absolute value of length
+               (Mov r8 0)
+               (Sub r8 r9)
+               (Mov r9 r8)
+               (Label pos-bignum)
+               (Sar r9 (- int-shift imm-shift))
+               (Add rbx r9)
+               (Label end)))]
+         ['bitwise-ior 
+          (let ((end (gensym))
+                (pos-bignum (gensym))) 
+            (seq (Pop r8)
+               (assert-integer/bignum r8 c)
+               (assert-integer/bignum rax c)
+               (pad-stack c)
+               (Mov rdi r8)
+               (Mov rsi rax)
+               (Mov rdx rbx)
+               (Call 'bitwise_ior)
+               (unpad-stack c)
+               (Mov r9 rax)         ; first check if return value is fixnum
+               (And r9 mask-int)
+               (Xor r9 type-int)
+               (Cmp r9 0)
+               (Je end)             ; if not fixnum, we should adjust rbx
+               (Mov r9 (Offset rbx 0))
+               (Cmp r9 -1)
+               (Jg pos-bignum)      ; get absolute value of length
+               (Mov r8 0)
+               (Sub r8 r9)
+               (Mov r9 r8)
+               (Label pos-bignum)
+               (Sar r9 (- int-shift imm-shift))
+               (Add rbx r9)
+               (Label end)))]
+         ['bitwise-xor 
+          (let ((end (gensym))
+                (pos-bignum (gensym))) 
+            (seq (Pop r8)
+               (assert-integer/bignum r8 c)
+               (assert-integer/bignum rax c)
+               (pad-stack c)
+               (Mov rdi r8)
+               (Mov rsi rax)
+               (Mov rdx rbx)
+               (Call 'bitwise_xor)
+               (unpad-stack c)
+               (Mov r9 rax)         ; first check if return value is fixnum
+               (And r9 mask-int)
+               (Xor r9 type-int)
+               (Cmp r9 0)
+               (Je end)             ; if not fixnum, we should adjust rbx
+               (Mov r9 (Offset rbx 0))
+               (Cmp r9 -1)
+               (Jg pos-bignum)      ; get absolute value of length
+               (Mov r8 0)
+               (Sub r8 r9)
+               (Mov r9 r8)
+               (Label pos-bignum)
+               (Sar r9 (- int-shift imm-shift))
+               (Add rbx r9)
+               (Label end)))]
          ['> 
             (seq (Pop r8)
                  (assert-integer/bignum r8 c)

villain/interp-prims.rkt

@@ -41,6 +41,7 @@
     [(list 'flonum? v)                    (flonum? v)]
     [(list 'vector? v)                    (vector? v)]
     [(list 'vector-length v)              (vector-length v)]
+    [(list 'bitwise-not v)                (bitwise-not v)]
     [_                                    'err]))
 
 ;; Op2 Value Value -> Answer
@@ -72,7 +73,10 @@
     [(list 'vector-ref
            (? vector?) (? integer?)) (if (<= 0 v2 (sub1 (vector-length v1)))
                                          (vector-ref v1 v2)
-                                         'err)]           
+                                         'err)]
+    [(list 'bitwise-and (? integer?) (? integer?)) (bitwise-and v1 v2)]    
+    [(list 'bitwise-ior (? integer?) (? integer?)) (bitwise-ior v1 v2)]   
+    [(list 'bitwise-xor (? integer?) (? integer?)) (bitwise-xor v1 v2)]          
     [_                                    'err]))
 
 ;; Op3 Value Value Value -> Answer

villain/main.c

@@ -62,7 +62,6 @@ void print_result(vl_val x)
     printf(")");
     break;
   case VL_STR:
-    printf("test");
     putchar('"');
     print_str(vl_unwrap_str(x));
     putchar('"');

villain/parse.rkt

@@ -162,13 +162,15 @@
          symbol->string string->symbol symbol?
          vector? vector-length
          string-length string?
-         close-input-port open-input-file port? read-byte peek-byte))
+         close-input-port open-input-file port? read-byte peek-byte 
+         bitwise-not))
 
 (define op2
   '(+ - quotient remainder eq? cons string-ref make-string 
       > < <= >=
       make-vector vector-ref
-      fl+ fl- fl<= fl=))
+      fl+ fl- fl<= fl=
+      bitwise-and bitwise-ior bitwise-xor))
 
 (define op3
   '(string-set!  vector-set!))  

villain/test/test-runner.rkt

@@ -820,6 +820,23 @@
   (check-equal? (run '(let ((z 0)) (apply (λ x z) (cons 1 '())))) 0)
   (check-equal? (run '(let ((z 7)) (apply (λ x z) '()))) 7)
 
+;; bitwise operations
+  (check-equal? (run '(bitwise-not 0)) (bitwise-not 0))
+  (check-equal? (run '(bitwise-not 4)) (bitwise-not 4))
+  (check-equal? (run '(bitwise-not -11111111111111111111111)) (bitwise-not -11111111111111111111111))
+
+  (check-equal? (run '(bitwise-and 7 3)) (bitwise-and 7 3))
+  (check-equal? (run '(bitwise-and 7 -1000000000000000000000)) (bitwise-and 7 -1000000000000000000000))
+  (check-equal? (run '(bitwise-and -11111111111111111111111 -1000000000000000000000)) (bitwise-and -11111111111111111111111 -1000000000000000000000))
+
+  (check-equal? (run '(bitwise-ior 7 3)) (bitwise-ior 7 3))
+  (check-equal? (run '(bitwise-ior 7 -1000000000000000000000)) (bitwise-ior 7 -1000000000000000000000))
+  (check-equal? (run '(bitwise-ior -11111111111111111111111 -1000000000000000000000)) (bitwise-ior -11111111111111111111111 -1000000000000000000000))
+
+  (check-equal? (run '(bitwise-xor 7 3)) (bitwise-xor 7 3))
+  (check-equal? (run '(bitwise-xor 7 -1000000000000000000000)) (bitwise-xor 7 -1000000000000000000000))
+  (check-equal? (run '(bitwise-xor -11111111111111111111111 -1000000000000000000000)) (bitwise-xor -11111111111111111111111 -1000000000000000000000))
+
  ) 
 
 ;; Variable