home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / sparc / system.lisp < prev    next >
Encoding:
Text File  |  1992-02-25  |  6.3 KB  |  225 lines
  1. ;;; -*- Package: SPARC -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: system.lisp,v 1.7 92/02/25 07:13:02 wlott Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;;    MIPS VM definitions of various system hacking operations.
  15. ;;;
  16. ;;; Written by Rob MacLachlan
  17. ;;;
  18. ;;; Mips conversion by William Lott and Christopher Hoover.
  19. ;;;
  20. (in-package "SPARC")
  21.  
  22.  
  23.  
  24. ;;;; Type frobbing VOPs
  25.  
  26. (define-vop (get-lowtag)
  27.   (:translate get-lowtag)
  28.   (:policy :fast-safe)
  29.   (:args (object :scs (any-reg descriptor-reg)))
  30.   (:results (result :scs (unsigned-reg)))
  31.   (:result-types positive-fixnum)
  32.   (:generator 1
  33.     (inst and result object vm:lowtag-mask)))
  34.  
  35. (define-vop (get-type)
  36.   (:translate get-type)
  37.   (:policy :fast-safe)
  38.   (:args (object :scs (descriptor-reg)))
  39.   (:temporary (:scs (non-descriptor-reg)) ndescr)
  40.   (:results (result :scs (unsigned-reg)))
  41.   (:result-types positive-fixnum)
  42.   (:generator 6
  43.     (let ((other-ptr (gen-label))
  44.       (function-ptr (gen-label))
  45.       (done (gen-label)))
  46.       (test-type object ndescr other-ptr nil vm:other-pointer-type)
  47.       (test-type object ndescr function-ptr nil vm:function-pointer-type)
  48.       (inst andcc result object
  49.         (logand vm:other-immediate-0-type vm:other-immediate-1-type))
  50.       (inst b :eq done)
  51.       (inst nop)
  52.  
  53.       (inst b done)
  54.       (inst and result object vm:type-mask)
  55.  
  56.       (emit-label function-ptr)
  57.       (load-type result object (- vm:function-pointer-type))
  58.       (inst b done)
  59.       (inst nop)
  60.  
  61.       (emit-label other-ptr)
  62.       (load-type result object (- vm:other-pointer-type))
  63.       (inst nop)
  64.       
  65.       (emit-label done))))
  66.  
  67. (define-vop (get-header-data)
  68.   (:translate get-header-data)
  69.   (:policy :fast-safe)
  70.   (:args (x :scs (descriptor-reg)))
  71.   (:results (res :scs (unsigned-reg)))
  72.   (:result-types positive-fixnum)
  73.   (:generator 6
  74.     (loadw res x 0 vm:other-pointer-type)
  75.     (inst srl res res vm:type-bits)))
  76.  
  77. (define-vop (get-closure-length)
  78.   (:translate get-closure-length)
  79.   (:policy :fast-safe)
  80.   (:args (x :scs (descriptor-reg)))
  81.   (:results (res :scs (unsigned-reg)))
  82.   (:result-types positive-fixnum)
  83.   (:generator 6
  84.     (loadw res x 0 vm:function-pointer-type)
  85.     (inst srl res res vm:type-bits)))
  86.  
  87. (define-vop (set-header-data)
  88.   (:translate set-header-data)
  89.   (:policy :fast-safe)
  90.   (:args (x :scs (descriptor-reg) :target res)
  91.      (data :scs (any-reg immediate zero)))
  92.   (:arg-types * positive-fixnum)
  93.   (:results (res :scs (descriptor-reg)))
  94.   (:temporary (:scs (non-descriptor-reg) :type random) t1 t2)
  95.   (:generator 6
  96.     (loadw t1 x 0 vm:other-pointer-type)
  97.     (inst and t1 vm:type-mask)
  98.     (sc-case data
  99.       (any-reg
  100.        (inst sll t2 data (- vm:type-bits 2))
  101.        (inst or t1 t2))
  102.       (immediate
  103.        (inst or t1 (ash (tn-value data) vm:type-bits)))
  104.       (zero))
  105.     (storew t1 x 0 vm:other-pointer-type)
  106.     (move res x)))
  107.  
  108.  
  109. (define-vop (make-fixnum)
  110.   (:args (ptr :scs (any-reg descriptor-reg)))
  111.   (:results (res :scs (any-reg descriptor-reg)))
  112.   (:generator 1
  113.     ;;
  114.     ;; Some code (the hash table code) depends on this returning a
  115.     ;; positive number so make sure it does.
  116.     (inst sll res ptr 3)
  117.     (inst srl res res 1)))
  118.  
  119. (define-vop (make-other-immediate-type)
  120.   (:args (val :scs (any-reg descriptor-reg))
  121.      (type :scs (any-reg descriptor-reg immediate)
  122.            :target temp))
  123.   (:results (res :scs (any-reg descriptor-reg)))
  124.   (:temporary (:type random  :scs (non-descriptor-reg)) temp)
  125.   (:generator 2
  126.     (sc-case type
  127.       (immediate
  128.        (inst sll temp val vm:type-bits)
  129.        (inst or res temp (tn-value type)))
  130.       (t
  131.        (inst sra temp type 2)
  132.        (inst sll res val (- vm:type-bits 2))
  133.        (inst or res res temp)))))
  134.  
  135.  
  136. ;;;; Allocation
  137.  
  138. (define-vop (dynamic-space-free-pointer)
  139.   (:results (int :scs (sap-reg)))
  140.   (:result-types system-area-pointer)
  141.   (:translate dynamic-space-free-pointer)
  142.   (:policy :fast-safe)
  143.   (:generator 1
  144.     (move int alloc-tn)))
  145.  
  146. (define-vop (binding-stack-pointer-sap)
  147.   (:results (int :scs (sap-reg)))
  148.   (:result-types system-area-pointer)
  149.   (:translate binding-stack-pointer-sap)
  150.   (:policy :fast-safe)
  151.   (:generator 1
  152.     (move int bsp-tn)))
  153.  
  154. (define-vop (control-stack-pointer-sap)
  155.   (:results (int :scs (sap-reg)))
  156.   (:result-types system-area-pointer)
  157.   (:translate control-stack-pointer-sap)
  158.   (:policy :fast-safe)
  159.   (:generator 1
  160.     (move int csp-tn)))
  161.  
  162.  
  163. ;;;; Code object frobbing.
  164.  
  165. (define-vop (code-instructions)
  166.   (:translate code-instructions)
  167.   (:policy :fast-safe)
  168.   (:args (code :scs (descriptor-reg)))
  169.   (:temporary (:scs (non-descriptor-reg)) ndescr)
  170.   (:results (sap :scs (sap-reg)))
  171.   (:result-types system-area-pointer)
  172.   (:generator 10
  173.     (loadw ndescr code 0 vm:other-pointer-type)
  174.     (inst srl ndescr vm:type-bits)
  175.     (inst sll ndescr vm:word-shift)
  176.     (inst sub ndescr vm:other-pointer-type)
  177.     (inst add sap code ndescr)))
  178.  
  179. (define-vop (compute-function)
  180.   (:args (code :scs (descriptor-reg))
  181.      (offset :scs (signed-reg unsigned-reg)))
  182.   (:arg-types * positive-fixnum)
  183.   (:results (func :scs (descriptor-reg)))
  184.   (:temporary (:scs (non-descriptor-reg)) ndescr)
  185.   (:generator 10
  186.     (loadw ndescr code 0 vm:other-pointer-type)
  187.     (inst srl ndescr vm:type-bits)
  188.     (inst sll ndescr vm:word-shift)
  189.     (inst add ndescr offset)
  190.     (inst add ndescr (- vm:function-pointer-type vm:other-pointer-type))
  191.     (inst add func code ndescr)))
  192.  
  193.  
  194.  
  195. ;;;; Other random VOPs.
  196.  
  197.  
  198. (defknown unix::do-pending-interrupt () (values))
  199. (define-vop (unix::do-pending-interrupt)
  200.   (:policy :fast-safe)
  201.   (:translate unix::do-pending-interrupt)
  202.   (:generator 1
  203.     (inst unimp pending-interrupt-trap)))
  204.  
  205.  
  206. (define-vop (halt)
  207.   (:generator 1
  208.     (inst unimp halt-trap)))
  209.  
  210.  
  211.  
  212. ;;;; Dynamic vop count collection support
  213.  
  214. (define-vop (count-me)
  215.   (:args (count-vector :scs (descriptor-reg)))
  216.   (:info index)
  217.   (:temporary (:scs (non-descriptor-reg)) count)
  218.   (:generator 1
  219.     (let ((offset
  220.        (- (* (+ index vector-data-offset) word-bytes) other-pointer-type)))
  221.       (assert (typep offset '(signed-byte 13)))
  222.       (inst ld count count-vector offset)
  223.       (inst add count 1)
  224.       (inst st count count-vector offset))))
  225.