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 |
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) |
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)) |
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 |
|
|