home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / rt / debug.lisp < prev    next >
Encoding:
Text File  |  1992-03-10  |  4.7 KB  |  150 lines
  1. ;;; -*- Package: RT; Log: C.Log -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the Spice 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 Spice Lisp, please contact
  7. ;;; Scott Fahlman (FAHLMAN@CMUC). 
  8. ;;; **********************************************************************
  9. ;;;
  10. ;;; $Header: debug.lisp,v 1.4 92/03/10 09:20:19 wlott Exp $
  11. ;;;
  12. ;;; Compiler support for the new whizzy debugger.
  13. ;;;
  14. ;;; Written by William Lott.
  15. ;;; Converted to RT by Bill Chiles.
  16. ;;;
  17.  
  18. (in-package "RT")
  19.  
  20.  
  21. (defknown di::current-sp () system-area-pointer (movable flushable))
  22. (defknown di::current-fp () system-area-pointer (movable flushable))
  23. (defknown di::stack-ref (system-area-pointer index) t (flushable))
  24. (defknown di::%set-stack-ref (system-area-pointer index t) t (unsafe))
  25. (defknown di::lra-code-header (t) t (movable flushable))
  26. (defknown di::function-code-header (t) t (movable flushable))
  27. (defknown di::make-lisp-obj ((unsigned-byte 32)) t (movable flushable))
  28. (defknown di::get-lisp-obj-address (t) (unsigned-byte 32) (movable flushable))
  29.  
  30. (define-vop (debug-cur-sp)
  31.   (:translate di::current-sp)
  32.   (:policy :fast-safe)
  33.   (:results (res :scs (sap-reg)))
  34.   (:result-types system-area-pointer)
  35.   (:generator 1
  36.     (move res csp-tn)))
  37.  
  38. (define-vop (debug-cur-fp)
  39.   (:translate di::current-fp)
  40.   (:policy :fast-safe)
  41.   (:results (res :scs (sap-reg)))
  42.   (:result-types system-area-pointer)
  43.   (:generator 1
  44.     (move res cfp-tn)))
  45.  
  46.  
  47. (define-vop (read-control-stack-c)
  48.   (:policy :fast-safe)
  49.   (:translate di::stack-ref)
  50.   (:args (base :scs (sap-reg)))
  51.   (:results (result :scs (descriptor-reg)))
  52.   (:result-types *)
  53.   (:arg-types system-area-pointer (:constant (unsigned-byte 13)))
  54.   (:info offset)
  55.   (:generator 5
  56.     (inst l result base (* offset word-bytes))))
  57.  
  58. (define-vop (read-control-stack)
  59.   (:policy :fast-safe)
  60.   (:translate di::stack-ref)
  61.   (:args (object :scs (sap-reg) :target base)
  62.      (offset :scs (any-reg)))
  63.   (:results (result :scs (descriptor-reg)))
  64.   (:arg-types system-area-pointer positive-fixnum)
  65.   (:result-types *)
  66.   (:temporary (:scs (sap-reg) :from (:argument 0) :to :eval) base)
  67.   (:generator 7
  68.     (move base object)
  69.     (inst a base offset)
  70.     (inst l result base 0)))
  71.  
  72. (define-vop (write-control-stack-c)
  73.   (:policy :fast-safe)
  74.   (:translate di::%set-stack-ref)
  75.   (:args (base :scs (sap-reg))
  76.      (data :scs (descriptor-reg) :target result :to (:result 0)))
  77.   (:arg-types system-area-pointer (:constant (unsigned-byte 13)) *)
  78.   (:results (result :scs (descriptor-reg)))
  79.   (:result-types *)
  80.   (:info offset)
  81.   (:generator 5
  82.     (inst st data base (* offset word-bytes))
  83.     (move result data)))
  84.  
  85. (define-vop (write-control-stack)
  86.   (:policy :fast-safe)
  87.   (:translate di::%set-stack-ref)
  88.   (:args (object :scs (sap-reg) :target base)
  89.      (offset :scs (any-reg))
  90.      (data :scs (descriptor-reg) :target result))
  91.   (:arg-types system-area-pointer positive-fixnum *)
  92.   (:temporary (:scs (sap-reg) :from (:argument 0) :to :eval) base)
  93.   (:results (result :scs (descriptor-reg)))
  94.   (:result-types *)
  95.   (:generator 7
  96.     (move base object)
  97.     (inst cas base base offset)
  98.     (inst st data base 0)
  99.     (move result data)))
  100.  
  101.  
  102. (define-vop (code-from-mumble)
  103.   (:policy :fast-safe)
  104.   (:args (thing :scs (descriptor-reg) :target code))
  105.   (:results (code :scs (descriptor-reg)))
  106.   (:temporary (:scs (sap-reg)) temp)
  107.   (:variant-vars lowtag)
  108.   (:generator 5
  109.     (let ((bogus (gen-label))
  110.       (done (gen-label)))
  111.       (loadw temp thing 0 lowtag)
  112.       (inst sr temp vm:type-bits)
  113.       (inst bc :eq bogus)
  114.       (inst sl temp (1- (integer-length vm:word-bytes)))
  115.       (unless (= lowtag vm:other-pointer-type)
  116.     (inst cal temp temp (- lowtag vm:other-pointer-type)))
  117.       (move code thing)
  118.       (inst s code temp)
  119.       (emit-label done)
  120.       (assemble (*elsewhere*)
  121.     (emit-label bogus)
  122.     (inst bx done)
  123.     (move code null-tn)))))
  124.  
  125. (define-vop (code-from-lra code-from-mumble)
  126.   (:translate di::lra-code-header)
  127.   (:variant vm:other-pointer-type))
  128.  
  129. (define-vop (code-from-function code-from-mumble)
  130.   (:translate di::function-code-header)
  131.   (:variant vm:function-pointer-type))
  132.  
  133. (define-vop (di::make-lisp-obj)
  134.   (:policy :fast-safe)
  135.   (:translate di::make-lisp-obj)
  136.   (:args (value :scs (unsigned-reg) :target result))
  137.   (:arg-types unsigned-num)
  138.   (:results (result :scs (descriptor-reg)))
  139.   (:generator 1
  140.     (move result value)))
  141.  
  142. (define-vop (di::get-lisp-obj-address)
  143.   (:policy :fast-safe)
  144.   (:translate di::get-lisp-obj-address)
  145.   (:args (thing :scs (descriptor-reg) :target result))
  146.   (:results (result :scs (unsigned-reg)))
  147.   (:result-types unsigned-num)
  148.   (:generator 1
  149.     (move result thing)))
  150.