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