home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / rt / values.lisp < prev    next >
Encoding:
Text File  |  1991-12-22  |  3.0 KB  |  103 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: values.lisp,v 1.3 91/12/21 23:05:29 ram Exp $
  11. ;;;
  12. ;;; This file contains the implementation of unknown-values VOPs.
  13. ;;;
  14. ;;; Written by Rob MacLachlan
  15. ;;;
  16. ;;; Converted for IBM RT by Bill Chiles.
  17. ;;;
  18.  
  19. (in-package "RT")
  20.  
  21.  
  22.  
  23. (define-vop (reset-stack-pointer)
  24.   (:args (ptr :scs (word-pointer-reg)))
  25.   (:generator 1
  26.     (move csp-tn ptr)))
  27.  
  28. ;;; PUSH-VALUES -- VOP.
  29. ;;;
  30. ;;; Push some values onto the stack, returning the start and number of values
  31. ;;; pushed as results.  It is assumed that the Vals are wired to the standard
  32. ;;; argument locations.  Nvals is the number of values to push.
  33. ;;;
  34. ;;; The generator cost is pseudo-random.  We could get it right by defining a
  35. ;;; bogus SC that reflects the costs of the memory-to-memory moves for each
  36. ;;; operand, but this seems unworthwhile.
  37. ;;;
  38. (define-vop (push-values)
  39.   (:args
  40.    (vals :more t))
  41.   (:results
  42.    (start :scs (word-pointer-reg))
  43.    (count :scs (any-reg)))
  44.   (:info nvals)
  45.   (:temporary (:scs (descriptor-reg)) temp)
  46.   (:temporary (:scs (descriptor-reg)
  47.            :to (:result 0)
  48.            :target start)
  49.           start-temp)
  50.   (:generator 20
  51.     (move start-temp csp-tn)
  52.     (inst cal csp-tn csp-tn (* nvals word-bytes))
  53.     (do ((val vals (tn-ref-across val))
  54.      (i 0 (1+ i)))
  55.     ((null val))
  56.       (let ((tn (tn-ref-tn val)))
  57.     (sc-case tn
  58.       (descriptor-reg
  59.        (storew tn start-temp i))
  60.       (control-stack
  61.        (load-stack-tn temp tn)
  62.        (storew temp start-temp i)))))
  63.     (move start start-temp)
  64.     (inst li count (fixnum nvals))))
  65.  
  66.  
  67. ;;; VALUES-LIST -- VOP.
  68. ;;;
  69. ;;; Push a list of values on the stack, returning Start and Count as used in
  70. ;;; unknown values continuations.
  71. ;;;
  72. (define-vop (values-list)
  73.   (:args (arg :scs (descriptor-reg) :target list))
  74.   (:arg-types list)
  75.   (:policy :fast-safe)
  76.   (:results (start :scs (word-pointer-reg))
  77.         (count :scs (any-reg)))
  78.   (:temporary (:scs (descriptor-reg) :type list :from (:argument 0)) list)
  79.   (:temporary (:scs (descriptor-reg)) temp)
  80.   (:temporary (:scs (non-descriptor-reg) :type random) ndescr)
  81.   (:vop-var vop)
  82.   (:save-p :compute-only)
  83.   (:generator 0
  84.     (let ((loop (gen-label))
  85.       (done (gen-label)))
  86.  
  87.       (move list arg)
  88.       (move start csp-tn)
  89.  
  90.       (emit-label loop)
  91.       (inst c list null-tn)
  92.       (inst bcx :eq done)
  93.       (loadw temp list cons-car-slot list-pointer-type)
  94.       (loadw list list cons-cdr-slot list-pointer-type)
  95.       (inst cal csp-tn csp-tn word-bytes)
  96.       (storew temp csp-tn -1)
  97.       (test-type list ndescr loop nil list-pointer-type)
  98.       (error-call vop bogus-argument-to-values-list-error list)
  99.  
  100.       (emit-label done)
  101.       (move count csp-tn)
  102.       (inst s count start))))
  103.