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 "dummy"
   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                                                   "dummy"
  17                                                   (new-empty-set)
  18                                                   (new-empty-set)))))
  19                 ((eq? type 'void)
  20                  (new-value '()))
  21                 (else
  22                  (error "unknown return type"))))
  23          (params
  24           (map (lambda (x)
  25                  ;; parameters don't need names here
  26                  ;; TODO support other types
  27                  (predefine-var 'foo (car x) (list (cdr x))))
  28                param-defs))
  29          (ast
  30           (new-def-procedure '() id '() type value params))
  31          (entry
  32           (asm-make-label id adr)))
  33     (multi-link-parent! params ast)
  34     (def-procedure-entry-set! ast entry)
  35     ast))
  36
  37 (define predefined-routines '())
  38
  39 ;; as predefine-fun, but represented as bbs, not as preloaded machine code
  40 ;; the body of the procedure (as a cfg) will be generated during the generation
  41 ;; of the main cfg
  42 (define (predefine-routine id type param-defs)
  43   (let ((params
  44          (map
  45           (lambda (type) ; parameters are passed like this: (type type ...)
  46             ;; parameters don't need names here
  47             (new-def-variable '() 'foo '() type (alloc-value type 'foo) '()))
  48           param-defs)))
  49     (set! predefined-routines (cons id predefined-routines))
  50     (new-def-procedure '() id '() type (alloc-value type id) params)))
  51
  52 (define initial-cte
  53   (list
  54    (predefine-var 'X 'byte '(5))
  55    (predefine-var 'Y 'byte '(6))
  56    (predefine-var 'Z 'byte '(7))
  57
  58    (predefine-fun 'FLASH_execute_erase 'void '() #x1EE)
  59    (predefine-fun 'FLASH_execute_write 'void '() #x1F0)
  60    (predefine-fun 'led_set 'void (list (cons 'byte WREG)) #x1F2)
  61    (predefine-fun 'irda_tx_wake_up 'void '() #x1F4)
  62    (predefine-fun 'irda_tx_raw 'void (list (cons 'byte WREG)) #x1F6)
  63    (predefine-fun 'irda_rx_raw 'byte '() #x1F8)
  64    (predefine-fun 'sleep_mode 'void '() #x1FA)
  65    (predefine-fun 'exec_client 'void '() #x1FC)
  66
  67    ;; special variables
  68    (predefine-var 'SIXPIC_FSR0 'int16 (list FSR0L FSR0H))
  69    (predefine-var 'SIXPIC_FSR1 'int16 (list FSR1L FSR1H))
  70    (predefine-var 'SIXPIC_FSR2 'int16 (list FSR2L FSR2H))
  71
  72    ;; TODO have the equivalent of FSR variabes pour TBLPTR
  73    (predefine-routine 'rom_get  'int8  '(int16)) ;; TODO actually, 21 bits of address
  74
  75    (predefine-routine '__mul8_8   'int8  '(int8  int8))
  76    (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
  77    (predefine-routine '__mul16_16 'int16 '(int16 int16))
  78    (predefine-routine '__mul32_16 'int32 '(int32 int16))
  79
  80    (predefine-routine '__shl8  'int8  '(int8  int8))
  81    (predefine-routine '__shl16 'int16 '(int16 int8))
  82    (predefine-routine '__shl32 'int32 '(int32 int8))
  83    (predefine-routine '__shr8  'int8  '(int8  int8))
  84    (predefine-routine '__shr16 'int16 '(int16 int8))
  85    (predefine-routine '__shr32 'int32 '(int32 int8))
  86    ))
  87
  88 (define (cte-extend cte bindings)
  89   (append bindings cte))
  90
  91 (define (cte-lookup cte id)
  92   (cond ((null? cte)
  93          (error "undefined identifier" id))
  94         ((eq? (def-id (car cte)) id)
  95          (car cte))
  96         (else
  97          (cte-lookup (cdr cte) id))))