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