/[cmucl]/src/compiler/tn.lisp
ViewVC logotype

Diff of /src/compiler/tn.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by ram, Mon Jul 23 15:10:31 1990 UTC revision 1.8 by ram, Thu Aug 16 16:33:07 1990 UTC
# Line 50  Line 50 
50                 `(let ((prev nil))                 `(let ((prev nil))
51                    (do ((tn ,name (tn-next tn)))                    (do ((tn ,name (tn-next tn)))
52                        ((null tn))                        ((null tn))
53                      (cond ((or (not (eq (tn-kind tn) :normal))                      (cond ((or (tn-reads tn)
54                                 (tn-reads tn)                                 (tn-writes tn)
55                                 (tn-writes tn))                                 (member (tn-kind tn)
56                                           '(:component :specified-save)))
57                             (setq prev tn))                             (setq prev tn))
58                            (t                            (t
59                             (if prev                             (if prev
# Line 62  Line 63 
63      (let ((2comp (component-info component)))      (let ((2comp (component-info component)))
64        (frob (ir2-component-normal-tns 2comp))        (frob (ir2-component-normal-tns 2comp))
65        (frob (ir2-component-restricted-tns 2comp))        (frob (ir2-component-restricted-tns 2comp))
66        (frob (ir2-component-wired-tns 2comp))))        (frob (ir2-component-wired-tns 2comp))
67          (frob (ir2-component-alias-tns 2comp))))
68    (undefined-value))    (undefined-value))
69    
   
70    
71  ;;;; TN Creation:  ;;;; TN Creation:
72    
# Line 129  Line 130 
130      res))      res))
131    
132    
133  ;;; Environment-Live-TN  --  Interface  ;;; ENVIRONMENT-LIVE-TN, ENVIRONMENT-DEBUG-LIVE-TN  --  Interface
134  ;;;  ;;;
135  ;;;    Make TN be live throughout environment.  TN must be referenced only in  ;;;    Make TN be live throughout environment.  Return TN.  In the DEBUG case,
136  ;;; Env.  Return TN.  ;;; the TN is treated normally in blocks in the environment which reference the
137    ;;; TN, allowing targeting to/from the TN.  This results in move efficient
138    ;;; code, but may result in the TN sometimes not being live when you want it.
139  ;;;  ;;;
140  (defun environment-live-tn (tn env)  (defun environment-live-tn (tn env)
141    (declare (type tn tn) (type environment env))    (declare (type tn tn) (type environment env))
142    (assert (eq (tn-kind tn) :normal))    (assert (eq (tn-kind tn) :normal))
143    (setf (tn-kind tn) :environment)    (setf (tn-kind tn) :environment)
144      (setf (tn-environment tn) env)
145    (push tn (ir2-environment-live-tns (environment-info env)))    (push tn (ir2-environment-live-tns (environment-info env)))
146    tn)    tn)
147    ;;;
148    (defun environment-debug-live-tn (tn env)
149      (declare (type tn tn) (type environment env))
150      (assert (eq (tn-kind tn) :normal))
151      (setf (tn-kind tn) :debug-environment)
152      (setf (tn-environment tn) env)
153      (push tn (ir2-environment-debug-live-tns (environment-info env)))
154      tn)
155    
156    
157  ;;; Component-Live-TN  --  Interface  ;;; Component-Live-TN  --  Interface
# Line 154  Line 166 
166    tn)    tn)
167    
168    
169    ;;; SPECIFY-SAVE-TN  --  Interface
170    ;;;
171    ;;;    Specify that Save be used as the save location for TN.  TN is returned.
172    ;;;
173    (defun specify-save-tn (tn save)
174      (declare (type tn tn save))
175      (assert (eq (tn-kind save) :normal))
176      (assert (and (not (tn-save-tn tn)) (not (tn-save-tn save))))
177      (setf (tn-kind save) :specified-save)
178      (setf (tn-save-tn tn) save)
179      (setf (tn-save-tn save) tn)
180      (push save
181            (ir2-component-specified-save-tns
182             (component-info *compile-component*)))
183      tn)
184    
185    
186  ;;; Make-Constant-TN  --  Interface  ;;; Make-Constant-TN  --  Interface
187  ;;;  ;;;
188  ;;;    Create a constant TN.  The implementation dependent  ;;;    Create a constant TN.  The implementation dependent
# Line 175  Line 204 
204      res))      res))
205    
206    
207    ;;; MAKE-ALIAS-TN  --  Interface
208    ;;;
209    ;;;    Make a TN that aliases TN for use in local call argument passing.
210    ;;;
211    (defun make-alias-tn (tn)
212      (declare (type tn tn))
213      (let* ((component (component-info *compile-component*))
214             (res (make-tn (incf (ir2-component-global-tn-counter component))
215                           :alias (tn-primitive-type tn) nil)))
216        (setf (tn-save-tn res) tn)
217        (push-in tn-next res
218                 (ir2-component-alias-tns component))
219        res))
220    
221    
222  ;;; Make-Load-Time-Constant-TN  --  Internal  ;;; Make-Load-Time-Constant-TN  --  Internal
223  ;;;  ;;;
224  ;;;    Return a load-time constant TN with the specified Kind and Info.  If the  ;;;    Return a load-time constant TN with the specified Kind and Info.  If the

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

  ViewVC Help
Powered by ViewVC 1.1.5