home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / comp / assembler / splap.t < prev    next >
Encoding:
Text File  |  1990-04-10  |  4.3 KB  |  181 lines
  1. (herald splap)
  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 sparc/sethi (unsigned-num
  59.                 (bignum-bit-field num 10 22)) tar)
  60.         (emit risc/or
  61.           (unsigned-num (bignum-bit-field num 0 10))
  62.           tar tar))
  63.            ((13bit? num)
  64.         (emit risc/add (machine-num num) zero tar))
  65.        ((fixnum? num)
  66.         (emit sparc/sethi (unsigned-num
  67.                 (fixnum-logand #x3fffff (fixnum-ashr num 10))) tar)
  68.         (emit risc/or
  69.           (unsigned-num (fixnum-logand #x3ff 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 sparc/jmpl (lap-eval reg) link-reg))
  92.  
  93. (define-lap-syntax (jr reg)
  94.   (emit sparc/jmpl (lap-eval reg) zero))
  95.  
  96. (define-lap-syntax (restore)
  97.   (emit sparc/restore zero (machine-num 0) zero))
  98. |#
  99. (define-lap-syntax (jalr reg)
  100.   (emit sparc/jmpl (lap-eval `(d@r ,reg 0)) link-reg))
  101.  
  102. (define-lap-syntax (jr reg)
  103.   (emit sparc/jmpl (lap-eval `(d@r ,reg 0)) zero))
  104.  
  105.  
  106. (define-arith-syntax add)
  107. (define-arith-syntax sub)
  108. (define-arith-syntax or)
  109. (define-arith-syntax and)
  110. (define-arith-syntax xor)
  111. (define-arith-syntax sra)
  112. (define-arith-syntax srl)
  113. (define-arith-syntax sll)
  114. (define-lap-instruction sethi sparc/sethi)
  115. (define-lap-instruction noop sparc/noop)
  116. (define-lap-instruction save sparc/save)
  117. (define-lap-instruction restore sparc/restore)
  118. (define-lap-instruction iflush sparc/iflush)
  119. (define-lap-instruction jmpl sparc/jmpl)
  120.  
  121. (set (table-entry lap-pseudo-ops 'mask)
  122.      (table-entry lap-pseudo-ops 'and))
  123.  
  124. (define %%car 1)
  125. (define %%cdr -3)
  126.        
  127. (define native-registers 
  128.   '((%g0 . 0)
  129.     (%g1 . 1)
  130.     (%g2 . 2)
  131.     (%g3 . 3)
  132.     (%g4 . 4)
  133.     (%g5 . 5)
  134.     (%g6 . 6)
  135.     (%g7 . 7)
  136.     (%o0 . 8)
  137.     (%o1 . 9)
  138.     (%o2 . 10)
  139.     (%o3 . 11)
  140.     (%o4 . 12)
  141.     (%o5 . 13)
  142.     (%sp . 14)
  143.     (%o7 . 15)
  144.     (%l0 . 16)
  145.     (%l1 . 17)
  146.     (%l2 . 18)
  147.     (%l3 . 19)
  148.     (%l4 . 20)
  149.     (%l5 . 21)
  150.     (%l6 . 22)
  151.     (%l7 . 23)
  152.     (%i0 . 24)
  153.     (%i1 . 25)
  154.     (%i2 . 26)
  155.     (%i3 . 27)
  156.     (%i4 . 28)
  157.     (%i5 . 29)
  158.     (%fp . 30)
  159.     (%i7 . 31)))
  160.  
  161. (walk (lambda (pair)
  162.     (*define orbit-env (car pair) (car pair)))
  163.       native-registers)
  164.  
  165.  
  166. (define %o0 ass-reg)
  167. (define %o1 extra-args)
  168. (define %o2 extra)  
  169. (define %o3 parassign-extra)  
  170. (define %o4 vector)  
  171. (define %o5 scratch)  
  172.  
  173. (define %i0 a8)
  174. (define %i1 a9)
  175. (define %i2 a10)
  176. (define %i3 A11)
  177. (define %i4 AN)
  178. (define %i5 AN+1)
  179. (define %i7 crit-reg)
  180.  
  181.