/[gcl]/gcl/cmpnew/gcl_cmploc.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmploc.lsp

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

revision 1.4 by camm, Fri Jun 11 03:08:21 2004 UTC revision 1.5 by camm, Thu Sep 16 21:08:18 2004 UTC
# Line 22  Line 22 
22  (in-package 'compiler)  (in-package 'compiler)
23    
24  (defvar *value-to-go*)  (defvar *value-to-go*)
25    (defvar *values-to-go* nil)
26    (defvar *multiple-value-exit-label* nil)
27    
28  ;;; Valid locations are:  ;;; Valid locations are:
29  ;;;     NIL  ;;;     NIL
# Line 104  Line 106 
106  (defun wt-next-var-arg ()  (defun wt-next-var-arg ()
107    (wt "va_arg(ap,object)"))    (wt "va_arg(ap,object)"))
108    
109    (defun multiple-values-p ()
110      (and (consp *value-to-go*) (consp (car *value-to-go*))))
111    
112  (defun set-loc (loc &aux fd)  (defun set-loc (loc &aux fd)
113    (cond ((eq *value-to-go* 'return) (set-return loc))    (cond ((eq *value-to-go* 'return) (set-return loc))
114          ((eq *value-to-go* 'trash)          ((eq *value-to-go* 'trash)
# Line 119  Line 124 
124                  (wt-nl "(void)" loc ";"))))                  (wt-nl "(void)" loc ";"))))
125          ((eq *value-to-go* 'top)          ((eq *value-to-go* 'top)
126           (unless (eq loc 'fun-val) (set-top loc)))           (unless (eq loc 'fun-val) (set-top loc)))
127            ((multiple-values-p)
128             (unless (eq loc 'fun-val)
129               (let ((*values-to-go* *value-to-go*))
130                 (do ((loc loc nil)) ((null *values-to-go*))
131                   (let ((*value-to-go* (pop *values-to-go*)))
132                     (set-loc loc)))
133                 (wt-nl)(reset-top)(wt-go *multiple-value-exit-label*))))
134          ((eq *value-to-go* 'return-fixnum) (set-return-fixnum loc))          ((eq *value-to-go* 'return-fixnum) (set-return-fixnum loc))
135          ((eq *value-to-go* 'return-character) (set-return-character loc))          ((eq *value-to-go* 'return-character) (set-return-character loc))
136          ((eq *value-to-go* 'return-long-float) (set-return-long-float loc))          ((eq *value-to-go* 'return-long-float) (set-return-long-float loc))
# Line 161  Line 173 
173    )    )
174    
175  (defun set-top (loc)  (defun set-top (loc)
176   (let ((*vs* *vs*))    (let ((vs-mark *vs*) (*vs* *vs*))
177        (wt-nl) (wt-vs (vs-push)) (wt "= " loc ";")      (wt-nl) (wt-vs (vs-push)) (wt "= " loc ";")
178        (wt-nl "vs_top=(vs_base=base+" (1- *vs*) ")+1;")      (wt-nl "vs_top=(vs_base=base+" vs-mark ")+" (- *vs* vs-mark) ";")
179        (base-used)))      (base-used)))))
180    
181  (defun wt-vs-base (offset) (wt "vs_base[" offset "]"))  (defun wt-vs-base (offset) (wt "vs_base[" offset "]"))
182    

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26