diff --git a/whalesong/selfhost/base64.rkt b/whalesong/selfhost/base64.rkt new file mode 100644 index 0000000..fc79bd6 --- /dev/null +++ b/whalesong/selfhost/base64.rkt @@ -0,0 +1,74 @@ +#lang whalesong +(require whalesong/lang/for) + +; Implements http://en.wikipedia.org/wiki/Base64 + +(provide base64-encode) ; string -> string + +(define (bytes-ref bs i) + (define c (string-ref bs i)) + (char->integer c)) + +(define (string->bytes s) + (for/list ([c (in-string s)]) + (char->integer c))) + +; +(define ranges '(["AZ" 0] ; 0 to 25 + ["az" 26] ; 16 to 51 + ["09" 52] ; 52 to 61 + ["++" 62] ; 62 + ["//" 63])) ; 63 + +; > (vector-ref base64-digit (char->integer #\A)) +; 0 +; > (vector-ref digit-base64 0) +; 65 (which is #\A) + +(define-values (base64-digit digit-base64) + (let ([bd (make-vector 256 #f)] + [db (make-vector 64 #f)]) + (for ([r ranges] #:when #t + [i (in-range (bytes-ref (car r) 0) (add1 (bytes-ref (car r) 1)))] + [n (in-naturals (cadr r))]) + (vector-set! bd i n) + (vector-set! db n i)) + (values bd db))) + +(define (3bytes->24bit a b c) + ; convert 3 bytes into a single 24 bit number + (+ (* a 65536) (* b 256) c)) + +(define (24bit->base64 n) + ; convert a 24 bit number into base 64 + (define a (remainder n 64)) + (define n1 (quotient n 64)) + (define b (remainder n1 64)) + (define n2 (quotient n1 64)) + (define c (remainder n2 64)) + (define d (quotient n2 64)) + (list d c b a)) + +(define =byte (bytes-ref "=" 0)) + +(define (base64-encode s) + (define sn (string-length s)) + (define (encode s) + (define n sn) + (define ds + (for/list ([i (in-range 0 n 3)]) + (define a (bytes-ref s i)) + (define b (bytes-ref s (+ i 1))) + (define c (bytes-ref s (+ i 2))) + (for/list ([digit (24bit->base64 (3bytes->24bit a b c))]) + (integer->char (vector-ref digit-base64 digit))))) + (define padding (case (remainder sn 3) [(0) 0] [(1) 2] [(2) 1])) + (define padding= (case (remainder sn 3) [(0) '()] [(1) (list #\= #\=)] [(2) (list #\=)])) + (define ds* (apply append ds)) + (list->string (reverse (append padding= (drop (reverse ds*) padding))))) + + (case (remainder sn 3) + [(0) (encode s)] + [(1) (encode (string-append s (string (integer->char 0) (integer->char 0))))] + [(2) (encode (string-append s (string (integer->char 0))))])) + diff --git a/whalesong/selfhost/js-assembler/assemble-structs.rkt b/whalesong/selfhost/js-assembler/assemble-structs.rkt new file mode 100644 index 0000000..124baa7 --- /dev/null +++ b/whalesong/selfhost/js-assembler/assemble-structs.rkt @@ -0,0 +1,21 @@ +#lang whalesong (require "../selfhost-lang.rkt") +; #lang typed/racket/base + +(provide (all-defined-out)) + + +(require "../compiler/il-structs.rkt") + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Assembly + +(define-struct: BasicBlock ([name : Symbol] + [stmts : (Listof UnlabeledStatement)]) + #:transparent) + + + +;; Represents a hashtable from symbols to basic blocks +(define-type Blockht (HashTable Symbol BasicBlock)) diff --git a/whalesong/selfhost/selfhost-lang.rkt b/whalesong/selfhost/selfhost-lang.rkt index c2d0145..ea68ba6 100644 --- a/whalesong/selfhost/selfhost-lang.rkt +++ b/whalesong/selfhost/selfhost-lang.rkt @@ -15,6 +15,7 @@ path? sort natural? + vector-copy ; no-ops : log-debug @@ -73,4 +74,15 @@ (define (log-debug . _) (void)) -(define (natural? o) (and (number? o) (integer? o) (not (negative? o)))) \ No newline at end of file +(define (natural? o) (and (number? o) (integer? o) (not (negative? o)))) + +(require whalesong/lang/for) + +(define (vector-copy vec [start 0] [end (vector-length vec)]) + (define n (- end start)) + (define v (make-vector n #\space)) + (for ([i (in-range start end)] + [j (in-range 0 n)]) + (vector-set! v j (vector-ref vec i))) + v) +