blob: 21ee88f2ececfb62d41fdd75a187cd05274ad1d5 (
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
|
(define-library (csc encoding)
(export encode)
(import (scheme base)
(only (csc match) match))
(begin
(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)))))
|
