home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / comp / back_end / fix.t < prev    next >
Encoding:
Text File  |  1990-07-31  |  3.6 KB  |  112 lines
  1. (herald fix)
  2.  
  3.  
  4.  
  5. (define (generate-move ref1 ref2)
  6.   (if (neq? ref1 ref2)
  7.       (cond ((and (pair? ref1) (null? (cdr ref1)))
  8.          (generate-move-address (car ref1) ref2))
  9.         ((register? ref2)
  10.          (cond ((register? ref1)
  11.             (emit risc/add ref1 zero ref2))
  12.            ((and (pair? ref1)
  13.              (eq? (car ref1) 'lit))
  14.             (move-small-number (cdr ref1) ref2))
  15.            (else
  16.             (emit-load ref1 ref2))))
  17.         ((register? ref1)
  18.          (emit-store ref1 ref2))
  19.         (else
  20.          (if (and (pair? ref1) (eq? (car ref1) 'lit))
  21.          (move-small-number (cdr ref1) extra)
  22.          (emit-load ref1 extra))
  23.          (emit-store extra ref2)))))
  24.  
  25. (define (emit-load ro reg)
  26.   (cond ((or (atom? ro) (13bit? (cdr ro)))
  27.      (emit risc/load 'l ro reg))
  28.     (else
  29.      (move-big-constant (cdr ro) ass-reg)
  30.      (emit risc/load 'l (reg-reg (car ro) ass-reg) reg))))
  31.  
  32. (define (emit-store reg ro)
  33.   (cond ((or (atom? ro) (13bit? (cdr ro)))
  34.      (emit risc/store 'l reg ro))
  35.     (else
  36.      (move-big-constant (cdr ro) ass-reg)
  37.      (emit risc/store 'l reg (reg-reg (car ro) ass-reg)))))
  38.  
  39.      
  40. (define (generate-move-address from to)
  41.   (cond ((register? to)
  42.          (if (or (atom? from)
  43.                  (neq? (car from) to)
  44.                  (neq? (cdr from) 0))
  45.          (cond ((13bit? (cdr from))
  46.             (emit risc/add (machine-num (cdr from)) (car from) to))
  47.            (else
  48.             (move-big-constant (cdr from) ass-reg)
  49.             (emit risc/add ass-reg (car from) to)))))
  50.         ((13bit? (cdr from))
  51.      (emit risc/add (machine-num (cdr from)) (car from) extra)
  52.          (emit risc/store 'l extra to))
  53.     (else
  54.      (move-big-constant (cdr from) ass-reg)
  55.      (emit risc/add ass-reg (car from) extra)
  56.          (emit risc/store 'l extra to))))
  57.  
  58. (define (move-big-constant num reg)
  59.   (emit sparc/sethi (unsigned-num
  60.              (fixnum-logand #x3fffff (fixnum-ashr num 10))) reg)
  61.   (emit risc/or
  62.     (unsigned-num (fixnum-logand #x3ff num))
  63.     reg reg))
  64.  
  65. (define (reg-reg r1 r2)
  66.   (list 'reg-reg r1 r2))
  67.  
  68. (define risc/load
  69.   (object (lambda (bv i size ro d)
  70.         (cond ((eq? (car ro) 'reg-reg)
  71.            (load-store-indexed bv i (load-op size) (rnum (cadr ro))
  72.                        (rnum (caddr ro)) (rnum d)))
  73.           (else
  74.            (receive (base offset) (get-reg-and-offset ro)
  75.                 (load-store-type bv i (load-op size) (rnum base) (rnum d) offset)))))
  76.       ((instruction-as-string self i size ro d)
  77.        (cond ((eq? (car ro) 'reg-reg)
  78.           (format nil "~a (~a:~a),~a" (load-op-name size)
  79.               (rname (cadr ro)) (rname (caddr ro)) (rname d)))
  80.          (else
  81.           (receive (base offset) (get-reg-and-offset ro)       
  82.                (format nil "~a ~d(~a),~a" (load-op-name size) offset
  83.                    (rname base) (rname d))))))
  84.       ((identification self) "load")))      
  85.  
  86. (define risc/store
  87.   (object (lambda (bv i size d ro)
  88.         (cond ((eq? (car ro) 'reg-reg)
  89.            (load-store-indexed bv i (load-op size) (rnum (cadr ro))
  90.                        (rnum (caddr ro)) (rnum d)))
  91.           (else
  92.            (receive (base offset) (get-reg-and-offset ro)
  93.                 (load-store-type bv i (store-op size) (rnum base) (rnum d) offset)))))
  94.       ((instruction-as-string self i size d ro)
  95.        (cond ((eq? (car ro) 'reg-reg)
  96.           (format nil "~a ~a,(~a:~a)" (load-op-name size)
  97.                (rname d) (rname (cadr ro)) (rname (caddr ro))))
  98.          (else
  99.           (receive (base offset) (get-reg-and-offset ro)       
  100.                (format nil "~a ~a,~d(~a)" (store-op-name size) (rname d)
  101.                    offset (rname base))))))
  102.       ((identification self) "store")))
  103.  
  104. (define (load-store-indexed bv i op3 rs1 rs2 rd)
  105.   (set-16 bv i
  106.        (fx-ior (fixnum-ashl 3 14)    ;3 for load-store
  107.            (fx-ior (fixnum-ashl rd 9)
  108.                (fx-ior (fixnum-ashl op3 3)
  109.                    (fixnum-ashr rs1 2))))) ;high 3 of rs1
  110.   (set-16 bv (fx+ i 2)
  111.       (fx-ior (fixnum-ashl (fixnum-logand 3 rs1) 14) ;low 2 of sr1
  112.           rs2)))