blob: 8dbd89cc9b10e28f38406fbc880a37926fc17682 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
(define-library (csc encoding)
(export encode)
(import (scheme base)
(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 (right-shift n1 n2)
(floor-quotient n1 (expt 2 n2))) ; Yikes.
(define (low-byte n)
(modulo n #x100))
(define (64->le-bytes n)
(list
(low-byte n)
(low-byte (right-shift n 8))
(low-byte (right-shift n 16))
(low-byte (right-shift n 24))
(low-byte (right-shift n 32))
(low-byte (right-shift n 40))
(low-byte (right-shift n 48))
(low-byte (right-shift n 56))))
(define (opcode-switch opcode)
(match opcode
(('const n) (append (64->le-bytes 1010) (64->le-bytes n)))
('add (64->le-bytes 1020))
('sub (64->le-bytes 1030))
('mul (64->le-bytes 1040))
('div (64->le-bytes 1050))
('mod (64->le-bytes 1060))
('alloc (64->le-bytes 2010))
(('peek n) (append (64->le-bytes 2020) (list n)))
(('poke n) (append (64->le-bytes 2030) (list n)))
('peekbyte (64->le-bytes 2040))
('pokebyte (64->le-bytes 2050))
('pop (64->le-bytes 3010))
(('local n) (append (64->le-bytes 3020) (list n)))
(('if n) (append (64->le-bytes 4010) (64->le-bytes n)))
(('call n) (append (64->le-bytes 4020) (list n)))
('ret (64->le-bytes 4030))
('exit (64->le-bytes 4040))
('putc (64->le-bytes 5010))
('getc (64->le-bytes 5020))
(_ (error "invalid opcode" opcode))))
(define (encode program)
(apply append (map opcode-switch program)))))
|
