Fixed a bug with literals as first arguments of operators. It now
[sixpic.git] / cte.scm
blobfd3736f8ca7eb1d143a93fb16e0a34bddf140dcb
1 (define (predefine-var id type adr)
2   (let* ((value
3           (new-value (list (make-byte-cell adr '() '()))))
4          (ast
5           (new-def-variable '() id '() type value '())))
6     ast))
8 (define (predefine-fun id type param-defs adr)
9   (let* ((value
10           (cond ((eq? type 'byte) ;; TODO have the others, or make this generic (this is not actually used anyway)
11                  (new-value (list (make-byte-cell WREG '() '()))))
12                 ((eq? type 'void)
13                  (new-value '()))
14                 (else
15                  (error "unknown return type"))))
16          (params
17           (map (lambda (x)
18                  ;; parameters don't need names here
19                  (predefine-var 'foo (car x) (cdr x)))
20                param-defs))
21          (ast
22           (new-def-procedure '() id '() type value params))
23          (entry
24           (asm-make-label id adr)))
25     (multi-link-parent! params ast)
26     (def-procedure-entry-set! ast entry)
27     ast))
29 (define predefined-routines '())
31 ;; as predefine-fun, but represented as bbs, not as preloaded machine code
32 ;; the body of the procedure (as a cfg) will be generated during the generation
33 ;; of the main cfg
34 (define (predefine-routine id type param-defs)
35   (let ((params
36          (map (lambda (type) ; parameters are passed like this: (type type ...)
37                 ;; parameters don't need names here
38                 (new-def-variable '() 'foo '() type (alloc-value type) '()))
39               param-defs)))
40     (set! predefined-routines (cons id predefined-routines))
41     (new-def-procedure '() id '() type (alloc-value type) params)))
43 (define initial-cte ;; TODO clean this up
44   (list (predefine-var 'X 'byte 5)
45         (predefine-var 'Y 'byte 6)
46         (predefine-var 'Z 'byte 7)
47         (predefine-fun 'FLASH_execute_erase
48                        'void
49                        '()
50                        #x1EE)
51         (predefine-fun 'FLASH_execute_write
52                        'void
53                        '()
54                        #x1F0)
55         (predefine-fun 'led_set
56                        'void
57                        (list (cons 'byte WREG))
58                        #x1F2)
59         (predefine-fun 'irda_tx_wake_up
60                        'void
61                        '()
62                        #x1F4)
63         (predefine-fun 'irda_tx_raw
64                        'void
65                        (list (cons 'byte WREG))
66                        #x1F6)
67         (predefine-fun 'irda_rx_raw
68                        'byte
69                        '()
70                        #x1F8)
71         (predefine-fun 'sleep_mode
72                        'void
73                        '()
74                        #x1FA)
75         (predefine-fun 'exec_client
76                        'void
77                        '()
78                        #x1FC)
80         ;; TODO maybe use some for the fsr variables ? and have the address be the fsr registers
81         
82         ;; for multiplication
83         (predefine-routine 'mul8_8   'int16 '(byte  byte))
84         (predefine-routine 'mul16_8  'int24 '(int16 byte))
85         (predefine-routine 'mul16_16 'int32 '(int16 int16))
86         ;; TODO maybe use predefine fun and have jump to a function already in rom ? then have some kind of linking to see if it's used, and if so, put the code in
87         ))
89 (define (cte-extend cte bindings)
90   (append bindings cte))
92 (define (cte-lookup cte id)
93   (cond ((null? cte)
94          (error "undefined identifier" id))
95         ((eq? (def-id (car cte)) id)
96          (car cte))
97         (else
98          (cte-lookup (cdr cte) id))))