home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / comp / assembler / mipslap.t < prev    next >
Encoding:
Text File  |  1990-04-10  |  3.2 KB  |  119 lines
  1. (herald mipslap)
  2.  
  3. (define lap-pseudo-ops (make-table 'lap-pseudo-ops))
  4. (define lap-instructions (make-table 'lap-instruction))
  5.  
  6. (define-local-syntax (define-lap-instruction n1 n2)
  7.   `(set (table-entry lap-instructions ',n1) ,n2))
  8.  
  9.  
  10. (define-local-syntax (define-lap-syntax pattern . body)
  11.   `(set (table-entry lap-pseudo-ops ',(car pattern))
  12.     (object (lambda ,(cdr pattern) ,@body)
  13.       ((identification self) ',(car pattern)))))
  14.  
  15. (define-local-syntax (define-j-syntax j)
  16.   `(define-lap-syntax (,j arg1 arg2 label)
  17.      (*jlap ,(concatenate-symbol 'jump-op/ j) arg1 arg2 label)))
  18.  
  19. (define-local-syntax (define-arith-syntax op)
  20.   `(define-lap-syntax (,op arg1 arg2 . arg3)
  21.      (*arithlap ,(concatenate-symbol 'risc/ op) arg1 arg2
  22.         (if arg3 (car arg3) arg2))))
  23.  
  24. (define-j-syntax j=)
  25. (define-j-syntax jn=)
  26. (define-j-syntax j<)
  27. (define-j-syntax j<=)
  28. (define-j-syntax j>)
  29. (define-j-syntax j>=)
  30. (define-j-syntax uj<)
  31. (define-j-syntax uj>)
  32. (define-j-syntax uj<=)
  33. (define-j-syntax uj>=)
  34.  
  35. (define-lap-syntax (jbr lab)
  36.   (emit-jump lab))
  37.  
  38. (define-lap-syntax (jl lab)
  39.   (emit-branch-and-link lab))
  40.  
  41. (define (*jlap jop arg1 arg2 label)
  42.   (let ((next (cons label nil)))
  43.     (emit-compare jop (lap-eval arg1) (lap-eval arg2) label next)
  44.     (emit-tag next)))
  45.  
  46. (define (*arithlap inst arg1 arg2 arg3)
  47.   (emit inst (lap-eval arg1) (lap-eval arg2) (lap-eval arg3)))
  48.  
  49. (define-lap-syntax (move a b)
  50.   (emit risc/add (lap-eval a) zero (lap-eval b)))
  51.  
  52. (import t-implementation-env bignum?)
  53.  
  54. (define-lap-syntax (movec a b)
  55.   (let ((num (eval a orbit-env))
  56.     (tar (lap-eval b)))
  57.     (xcond ((bignum? num)
  58.         (emit mips/lui (unsigned-num
  59.                 (bignum-bit-field num 16 16)) tar)
  60.         (emit risc/or
  61.           (unsigned-num (bignum-bit-field num 0 16))
  62.           tar tar))
  63.            ((16bit? num)
  64.         (emit risc/add (machine-num num) zero tar))
  65.        ((fixnum? num)
  66.         (emit mips/lui (unsigned-num
  67.                 (fixnum-logand #xffff (fixnum-ashr num 16))) tar)
  68.         (emit risc/or
  69.           (unsigned-num (fixnum-logand #xffff num))
  70.           tar tar)))))
  71.  
  72. (define-lap-syntax (template pointer nargs nary?)
  73.   (asemit stemplate1 '(()))
  74.   (asemit template2 '())
  75.   (asemit laptemplate3 (list pointer nargs nary?)))
  76.  
  77. (define-lap-syntax (movea lab reg)
  78.   (emit-branch-and-link 8)
  79.   (emit risc/add (label-offset lab) link-reg (lap-eval reg)))
  80.  
  81. (define-lap-syntax (clear size mem)
  82.   (emit risc/store size zero (lap-eval mem)))
  83.  
  84. (define-lap-syntax (store size reg mem)
  85.     (emit risc/store size (lap-eval reg) (lap-eval mem)))
  86.  
  87. (define-lap-syntax (load size mem reg)
  88.     (emit risc/load size (lap-eval mem) (lap-eval reg)))
  89.  
  90. (define-lap-syntax (jalr reg)
  91.   (emit mips/jalr (lap-eval reg) link-reg))
  92.  
  93. (define-lap-syntax (jump-to-template reg)
  94.   (emit risc/add (machine-num 2) (lap-eval reg) (lap-eval reg))
  95.   (emit mips/jr (lap-eval reg)))
  96.  
  97. (define-arith-syntax add)
  98. (define-arith-syntax sub)
  99. (define-arith-syntax or)
  100. (define-arith-syntax and)
  101. (define-arith-syntax xor)
  102. (define-arith-syntax sra)
  103. (define-arith-syntax srl)
  104. (define-arith-syntax sll)
  105. (define-lap-instruction lui mips/lui)
  106. (define-lap-instruction jr mips/jr)
  107. (define-lap-instruction noop mips/noop)
  108.  
  109. (set (table-entry lap-pseudo-ops 'mask)
  110.      (table-entry lap-pseudo-ops 'and))
  111.  
  112. (define %%car 1)
  113. (define %%cdr -3)
  114.        
  115.           
  116.  
  117.  
  118.  
  119.