home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / rt / print.lisp < prev    next >
Encoding:
Text File  |  1991-11-06  |  1.6 KB  |  48 lines
  1. ;;; -*- Package: RT -*-
  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
  6. ;;; domain.  If you want to use this code or any part of CMU Common
  7. ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU)
  8. ;;; **********************************************************************
  9. ;;;
  10. ;;; $Header: print.lisp,v 1.2 91/10/02 23:05:52 ram Exp $
  11. ;;;
  12. ;;; This file contains temporary printing utilities and similar noise.
  13. ;;;
  14. ;;; Written by William Lott.
  15. ;;;
  16.  
  17. (in-package "RT")
  18.  
  19.  
  20. (define-vop (print)
  21.   (:args (object :scs (descriptor-reg)))
  22.   (:results (result :scs (descriptor-reg)))
  23.   (:save-p t)
  24.   (:temporary (:sc any-reg :offset nl0-offset) nl0)
  25.   (:temporary (:sc any-reg :offset lra-offset) lra)
  26.   (:temporary (:scs (sap-reg)) temp)
  27.   (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
  28.   (:vop-var vop)
  29.   (:generator 0
  30.     (let ((lra-label (gen-label))
  31.       (cur-nfp (current-nfp-tn vop)))
  32.       (when cur-nfp
  33.     (store-stack-tn cur-nfp nfp-save))
  34.       (inst cal nsp-tn nsp-tn -16)
  35.       (storew object nsp-tn)
  36.       (inst compute-lra-from-code lra code-tn lra-label)
  37.       (inst cai nl0 (make-fixup "_debug_print" :foreign))
  38.       (inst cai temp (make-fixup "call_into_c" :foreign))
  39.       (inst b temp)
  40.  
  41.       (align vm:lowtag-bits)
  42.       (emit-label lra-label)
  43.       (inst lra-header-word)
  44.       (inst cal nsp-tn nsp-tn 16)
  45.       (when cur-nfp
  46.     (load-stack-tn cur-nfp nfp-save))
  47.       (move result nl0))))
  48.