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