diff options
| author | Rose Hogenson <rhogenson@posteo.net> | 2022-08-01 19:35:19 -0700 |
|---|---|---|
| committer | Rose Hogenson <rhogenson@posteo.net> | 2022-08-01 19:35:19 -0700 |
| commit | acc561366f3fe6ec0377103f52ef0f7e923711c9 (patch) | |
| tree | d7a19cfbad78a69ebea71b27302e708c0655863d /csc/encoding.csc | |
| parent | 99ce19a8053a93457885f32ec54c1c5b7c1961c1 (diff) | |
| download | chromatopelma-acc561366f3fe6ec0377103f52ef0f7e923711c9.tar.zst | |
Modify the project structure.
Now the lib directory contains what will eventually end up on the
user's /usr/lib/csc. When I write make install, it will copy all of
the .csc files from lib into the destination lib directory. This means I
can start working on the standard library in lib/scheme.
Diffstat (limited to 'csc/encoding.csc')
| -rw-r--r-- | csc/encoding.csc | 184 |
1 files changed, 0 insertions, 184 deletions
diff --git a/csc/encoding.csc b/csc/encoding.csc deleted file mode 100644 index 9afa40f..0000000 --- a/csc/encoding.csc +++ /dev/null @@ -1,184 +0,0 @@ -(define-library (csc encoding) - (export encode) - (import (scheme base) - (only (csc loop) - loop - return) - (only (csc match) match)) - (begin - ; I'm only going to say this once, so pay attention. - ; The format of unboxed constants is described in bytecocde/src/data.rs. - ; Boxed values are represented by a pointer to an array on the heap. The - ; first position in the array is an integer code indicating what type the - ; object is. Vectors have code 0, codes for other types are not stable. - ; Vectors are represented as an array, the first element of which is the - ; integer 0 (the type code), the second element is the vector length, and - ; the remaining slots hold the array values. - - - (define (low-byte w n) - (write-u8 (remainder n #x100) w)) - - - (define (64->le-bytes w n) - (low-byte w n) - (low-byte w (quotient n #x100)) - (low-byte w (quotient n #x10000)) - (low-byte w (quotient n #x1000000)) - (low-byte w (quotient n #x100000000)) - (low-byte w (quotient n #x10000000000)) - (low-byte w (quotient n #x1000000000000)) - (low-byte w (quotient n #x100000000000000))) - - - ; Bitwise-negates a 63-bit unsigned integer. - (define (bitwise-not n) - (loop with n* = 0 - for i from 1 to 63 - for n = n then (quotient n 2) - for digit = 1 then (* 2 digit) - if (even? n) - do (set! n* (+ n* digit)) - finally (return n*))) - - - (define (int->le-bytes w n) - (when (or (>= n #x4000000000000000) - (< n #x-4000000000000000)) - (error "int constant too large" n)) - (when (negative? n) - (set! n (remainder - (+ 1 (bitwise-not (- n))) - #x8000000000000000))) - (64->le-bytes w (+ 1 (* 2 n)))) - - - (define (bool->le-bytes w b) - (if b - (64->le-bytes w #xa) - (64->le-bytes w #x2))) - - - (define (const->le-bytes w x) - (cond - ((integer? x) - (int->le-bytes w x)) - ((boolean? x) - (bool->le-bytes w x)) - ((null? x) - (64->le-bytes w #x12)) - (else (error "unexpected type in const->le-bytes" x)))) - - - (define (make-opcode w code arg1-const arg2-const) - (when (>= code #x40) - (error "code is more than 6 bits" code)) - (define arg1-bit (if arg1-const - 2 - 0)) - (define arg2-bit (if arg2-const - 1 - 0)) - (write-u8 (+ (* 4 code) arg1-bit arg2-bit) w)) - - - (define (arg->le-bytes w atom) - (match atom - (('const val) (const->le-bytes w val)) - (('local i) - (when (>= i #x100) - (error "local index is out of range" i)) - (write-u8 i w)) - (_ (error "unexpected form in arg->le-bytes" atom)))) - - - (define (is-const? atom) - (match atom - (('const _) #t) - (_ #f))) - - - (define (opcode-switch w opcode) - (match opcode - (('mov dest src) - (make-opcode w 0 (is-const? src) #f) - (arg->le-bytes w dest) - (arg->le-bytes w src)) - (('jmpif test dest) - (make-opcode w 1 (is-const? test) (is-const? dest)) - (arg->le-bytes w test) - (arg->le-bytes w dest)) - (('jmp dest) - (make-opcode w 2 (is-const? dest) #f) - (arg->le-bytes w dest)) - (('alloc dest size) - (make-opcode w 3 (is-const? size) #f) - (arg->le-bytes w dest) - (arg->le-bytes w size)) - (('peek dest ptr offset) - (make-opcode w 4 (is-const? ptr) (is-const? offset)) ; ptr will likely never be constant. - (arg->le-bytes w dest) - (arg->le-bytes w ptr) - (arg->le-bytes w offset)) - (('poke word ('local ptr) offset) - ; We only have 2 bits to store whether the arguments are const, but - ; it's actually true that a pointer can never be a constant. So we - ; only track whether the word and offset arguments are constant, and - ; assume ptr will always be a one-byte register name. - (make-opcode w 5 (is-const? word) (is-const? offset)) - (arg->le-bytes w word) - (arg->le-bytes w (list 'local ptr)) - (arg->le-bytes w offset)) - (('add dest x y) - (make-opcode w 6 (is-const? x) (is-const? y)) - (arg->le-bytes w dest) - (arg->le-bytes w x) - (arg->le-bytes w y)) - (('sub dest x y) - (make-opcode w 7 (is-const? x) (is-const? y)) - (arg->le-bytes w dest) - (arg->le-bytes w x) - (arg->le-bytes w y)) - (('mul dest x y) - (make-opcode w 8 (is-const? x) (is-const? y)) - (arg->le-bytes w dest) - (arg->le-bytes w x) - (arg->le-bytes w y)) - (('div dest x y) - (make-opcode w 9 (is-const? x) (is-const? y)) - (arg->le-bytes w dest) - (arg->le-bytes w x) - (arg->le-bytes w y)) - (('mod dest x y) - (make-opcode w 10 (is-const? x) (is-const? y)) - (arg->le-bytes w dest) - (arg->le-bytes w x) - (arg->le-bytes w y)) - (('peekbyte dest ptr offset) - (make-opcode w 11 (is-const? ptr) (is-const? offset)) - (arg->le-bytes w dest) - (arg->le-bytes w ptr) - (arg->le-bytes w offset)) - (('pokebyte word ('local ptr) offset) - (make-opcode w 12 (is-const? word) (is-const? offset)) - (arg->le-bytes w word) - (arg->le-bytes w (list 'local ptr)) - (arg->le-bytes w offset)) - (('exit code) - (make-opcode w 13 (is-const? code) #f) - (arg->le-bytes w code)) - (('alloc-bytevector dest size) - (make-opcode w 14 (is-const? size) #f) - (arg->le-bytes w dest) - (arg->le-bytes w size)) - (('typeof dest x) - (make-opcode w 15 (is-const? x) #f) - (arg->le-bytes w dest) - (arg->le-bytes w x)) - (_ (error "invalid opcode" opcode)))) - - - (define (encode program) - (define out (open-output-bytevector)) - (map (lambda (op) (opcode-switch out op)) program) - (get-output-bytevector out)))) |
