home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / comp / assembler / be_mipsis.t next >
Encoding:
Text File  |  1989-06-30  |  2.5 KB  |  85 lines
  1. (herald be_mipsis)
  2.  
  3. (define (set-16 bv i val)
  4.   (set (bref bv (fx+ i 1)) (fixnum-logand #xff val))
  5.   (set (bref bv i) (fixnum-logand #xff (fixnum-ashr val 8))))
  6.  
  7. (define (set-24 bv i val)
  8.   (set (bref bv (fx+ i 2)) (fixnum-logand #xff val))
  9.   (set (bref bv (fx+ i 1)) (fixnum-logand #xff (fixnum-ashr val 8)))
  10.   (set (bref bv i) (fixnum-logand #xff (fixnum-ashr val 16))))
  11.  
  12.  
  13.  
  14. ;| annotation offsetSHI | handler offset |
  15. ;|           code vector offset          |    
  16. ;|      pointer       | nargs |?template | 
  17.  
  18. (define (template1 bv i l h)
  19.   (set-16 bv (fx+ i 2)
  20.        (if h
  21.        (fx- (address-of h) (fx+ i 10)) ;this template is at i+10
  22.        0))
  23.   (set-16 bv i
  24.        (get-template-annotation l)))
  25.  
  26. (define (template2 bv i)
  27.   (set (bref bv i) 0)
  28.   (set-24 bv (fx+ i 1) (fx+ i 8)))
  29.  
  30. (define (template3 bv i l)
  31.   (set-16 bv i (get-template-cells l))
  32.   (set (bref-8-u bv (fx+ i 2)) (get-template-nargs l))
  33.   (set (bref-8-u bv (fx+ i 3))
  34.        (if (template-nary l) (fx+ header/template 128) header/template)))
  35.        
  36. (define (stemplate1 bv i l)
  37.   (set-16 bv (fx+ i 2) 0)    ;handler offset
  38.   (set-16 bv i
  39.        (if (not l) 0 (get-template-annotation l))))
  40.  
  41. (define (stemplate3 bv i l encloser)
  42.   (set-16 bv i
  43.        (let ((n (lambda-max-temps encloser)))
  44.      (if (fx= n 1) 0 (fx+ (fx- n *real-registers*) 1))))
  45.   (set (bref-8-u bv (fx+ i 2)) (if (not l) -2 (get-template-nargs l)))
  46.   (set (bref-8-u bv (fx+ i 3))
  47.        (if (and l (template-nary l))
  48.        (fx+ header/template 128) header/template)))
  49.        
  50. (define (laptemplate3 bv i pointer nargs nary?)
  51.   (set-16 bv i pointer)
  52.   (set (bref-8-u bv (fx+ i 2)) nargs)
  53.   (set (bref-8-u bv (fx+ i 3))
  54.        (if nary? (fx+ header/template 128) header/template)))
  55.  
  56.  
  57.   
  58. (define (r-type bv i op rs rt rd shamt funct)
  59.   (set-16 bv i
  60.        (fx-ior (fixnum-ashl op 10)
  61.            (fx-ior (fixnum-ashl rs 5)
  62.                 rt)))
  63.   (set-16 bv (fx+ i 2)
  64.        (fx-ior (fixnum-ashl rd 11)
  65.            (fx-ior (fixnum-ashl shamt 6)
  66.                funct))))
  67.  
  68. (define (i-type bv i op rs rt immediate)
  69.   (set-16 bv i
  70.        (fx-ior (fixnum-ashl op 10)
  71.            (fx-ior (fixnum-ashl rs 5)
  72.                 rt)))
  73.   (set-16 bv (fx+ i 2) immediate))
  74.  
  75. (define (write-i-bytes bv i)
  76.   (let ((write-byte
  77.      (lambda (byte)
  78.        (writec (terminal-output) (digit->char (fx-ashr byte 4) 16))  
  79.        (writec (terminal-output) (digit->char (fx-and byte 15) 16)))))
  80.     (write-byte (bref-8-u bv (fx+ i 0)))
  81.     (write-byte (bref-8-u bv (fx+ i 1)))
  82.     (write-byte (bref-8-u bv (fx+ i 2)))
  83.     (write-byte (bref-8-u bv (fx+ i 3)))))
  84.  
  85.