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