cte.scm

   1 (define (predefine-var id type addresses)
   2   (let* ((value
   3           ;; adrs is the list of addresses this variable is stored at
   4           (new-value (map (lambda (x) (make-byte-cell (byte-cell-next-id) x
   5                                                       (new-empty-set) (new-empty-set)))
   6                           addresses)))
   7          (ast
   8           (new-def-variable '() id '() type value '())))
   9     ast))
  10
  11 (define (predefine-fun id type param-defs adr)
  12   (let* ((value
  13           (cond ((eq? type 'byte) ;; TODO have the other types, or make this generic (this is not actually used anyway)
  14                  (new-value (list (make-byte-cell (byte-cell-next-id)
  15                                                   WREG
  16                                                   (new-empty-set)
  17                                                   (new-empty-set)))))
  18                 ((eq? type 'void)
  19                  (new-value '()))
  20                 (else
  21                  (error "unknown return type"))))
  22          (params
  23           (map (lambda (x)
  24                  ;; parameters don't need names here
  25                  ;; TODO support other types
  26                  (predefine-var 'foo (car x) (list (cdr x))))
  27                param-defs))
  28          (ast
  29           (new-def-procedure '() id '() type value params))
  30          (entry
  31           (asm-make-label id adr)))
  32     (multi-link-parent! params ast)
  33     (def-procedure-entry-set! ast entry)
  34     ast))
  35
  36 (define predefined-routines '())
  37
  38 ;; as predefine-fun, but represented as bbs, not as preloaded machine code
  39 ;; the body of the procedure (as a cfg) will be generated during the generation
  40 ;; of the main cfg
  41 (define (predefine-routine id type param-defs)
  42   (let ((params
  43          (map (lambda (type) ; parameters are passed like this: (type type ...)
  44                 ;; parameters don't need names here
  45                 (new-def-variable '() 'foo '() type (alloc-value type) '()))
  46               param-defs)))
  47     (set! predefined-routines (cons id predefined-routines))
  48     (new-def-procedure '() id '() type (alloc-value type) params)))
  49
  50 (define initial-cte
  51   (list
  52    (predefine-var 'X 'byte '(5))
  53    (predefine-var 'Y 'byte '(6))
  54    (predefine-var 'Z 'byte '(7))
  55
  56    (predefine-fun 'FLASH_execute_erase 'void '() #x1EE)
  57    (predefine-fun 'FLASH_execute_write 'void '() #x1F0)
  58    (predefine-fun 'led_set 'void (list (cons 'byte WREG)) #x1F2)
  59    (predefine-fun 'irda_tx_wake_up 'void '() #x1F4)
  60    (predefine-fun 'irda_tx_raw 'void (list (cons 'byte WREG)) #x1F6)
  61    (predefine-fun 'irda_rx_raw 'byte '() #x1F8)
  62    (predefine-fun 'sleep_mode 'void '() #x1FA)
  63    (predefine-fun 'exec_client 'void '() #x1FC)
  64
  65    ;; special variables
  66    (predefine-var 'SIXPIC_FSR0 'int16 (list FSR0L FSR0H))
  67    (predefine-var 'SIXPIC_FSR1 'int16 (list FSR1L FSR1H))
  68    (predefine-var 'SIXPIC_FSR2 'int16 (list FSR2L FSR2H))
  69
  70    ;; TODO have the equivalent of FSR variabes pour TBLPTR
  71    (predefine-routine 'rom_get  'int8  '(int16)) ;; TODO actually, 21 bits of address
  72
  73    (predefine-routine 'mul8_8   'int8  '(int8  int8))
  74    (predefine-routine 'mul16_8  'int16 '(int16 int8)) ;; TODO since multiplication arguments are not padded, these asymetric operations are used, they are more efficient, but padding would mean fewer necessary routines
  75    (predefine-routine 'mul16_16 'int16 '(int16 int16))
  76    (predefine-routine 'mul32_16 'int32 '(int32 int16))
  77
  78    (predefine-routine 'shl8  'int8  '(int8  int8))
  79    (predefine-routine 'shl16 'int16 '(int16 int8))
  80    (predefine-routine 'shl32 'int32 '(int32 int8))
  81    (predefine-routine 'shr8  'int8  '(int8  int8))
  82    (predefine-routine 'shr16 'int16 '(int16 int8))
  83    (predefine-routine 'shr32 'int32 '(int32 int8))
  84    ))
  85
  86 (define (cte-extend cte bindings)
  87   (append bindings cte))
  88
  89 (define (cte-lookup cte id)
  90   (cond ((null? cte)
  91          (error "undefined identifier" id))
  92         ((eq? (def-id (car cte)) id)
  93          (car cte))
  94         (else
  95          (cte-lookup (cdr cte) id))))