230 |
def |
def |
231 |
(*function-links* nil) *c-vars* (*volatile* " VOL ") |
(*function-links* nil) *c-vars* (*volatile* " VOL ") |
232 |
*vaddress-list* (*vind* 0) *inits* |
*vaddress-list* (*vind* 0) *inits* |
233 |
*current-form*) |
*current-form* *vcs-used*) |
234 |
(declare (special *current-form*)) |
(declare (special *current-form* *vcs-used*)) |
235 |
|
|
236 |
(setq *top-level-forms* (reverse *top-level-forms*)) |
(setq *top-level-forms* (reverse *top-level-forms*)) |
237 |
|
|
245 |
;; write all the inits. |
;; write all the inits. |
246 |
(dolist* (*current-form* *top-level-forms*) |
(dolist* (*current-form* *top-level-forms*) |
247 |
(setq *first-error* t) |
(setq *first-error* t) |
248 |
|
(setq *vcs-used* nil) |
249 |
(when (setq def (get (car *current-form*) 't2)) |
(when (setq def (get (car *current-form*) 't2)) |
250 |
(apply def (cdr *current-form*)))) |
(apply def (cdr *current-form*)))) |
251 |
|
|
253 |
;;; C function definitions. |
;;; C function definitions. |
254 |
(dolist* (*current-form* *top-level-forms*) |
(dolist* (*current-form* *top-level-forms*) |
255 |
(setq *first-error* t) |
(setq *first-error* t) |
256 |
|
(setq *vcs-used* nil) |
257 |
(when (setq def (get (car *current-form*) 't3)) |
(when (setq def (get (car *current-form*) 't3)) |
258 |
(apply def (cdr *current-form*)))) |
(apply def (cdr *current-form*)))) |
259 |
|
|
264 |
(when (endp *local-funs*) (return-from local-fun-process)) |
(when (endp *local-funs*) (return-from local-fun-process)) |
265 |
(setq lf (car *local-funs*)) |
(setq lf (car *local-funs*)) |
266 |
(pop *local-funs*) |
(pop *local-funs*) |
267 |
|
(setq *vcs-used* nil) |
268 |
(apply 't3local-fun lf)))) |
(apply 't3local-fun lf)))) |
269 |
|
|
270 |
;;; Global entries for directly called functions. |
;;; Global entries for directly called functions. |
271 |
|
|
272 |
(dolist* (x *global-entries*) |
(dolist* (x *global-entries*) |
273 |
|
(setq *vcs-used* nil) |
274 |
(apply 'wt-global-entry x)) |
(apply 'wt-global-entry x)) |
275 |
|
|
276 |
;;; Fastlinks |
;;; Fastlinks |
277 |
(dolist* (x *function-links*) |
(dolist* (x *function-links*) |
278 |
(wt-function-link x) |
(setq *vcs-used* nil) |
279 |
) |
(wt-function-link x)) |
280 |
#+sgi3d |
#+sgi3d |
281 |
(progn |
(progn |
282 |
(wt-nl1 "" "static void Init_Links () {") |
(wt-nl1 "" "static void Init_Links () {") |
861 |
) |
) |
862 |
|
|
863 |
;;; Use Vcs for lint |
;;; Use Vcs for lint |
864 |
(if *vararg-use-vs* t (progn (wt-nl "Vcs[0]=Vcs[0];"))) |
; (if *vararg-use-vs* t (progn (wt-nl "Vcs[0]=Vcs[0];"))) |
865 |
|
|
866 |
;;; start va_list at beginning |
;;; start va_list at beginning |
867 |
(if (or (ll-optionals ll) (ll-rest ll) (ll-keywords-p ll)) |
(if (or (ll-optionals ll) (ll-rest ll) (ll-keywords-p ll)) |
1022 |
(wt-nl "parse_key_rest_new(" (list 'cvar rest-var) ",")) |
(wt-nl "parse_key_rest_new(" (list 'cvar rest-var) ",")) |
1023 |
(t (wt-nl "parse_key_new_new("))) |
(t (wt-nl "parse_key_new_new("))) |
1024 |
(if (eql 0 *cs*)(setq *cs* 1)) |
(if (eql 0 *cs*)(setq *cs* 1)) |
1025 |
(wt "narg," (if *vararg-use-vs* "base " "Vcs ") |
(wt "narg," (if *vararg-use-vs* "base " (progn (setq *vcs-used* t) "Vcs ")) |
1026 |
"+" key-offset",(struct key *)(void *)&LI" cfun "key,first,ap);") |
"+" key-offset",(struct key *)(void *)&LI" cfun "key,first,ap);") |
1027 |
|
|
1028 |
)) |
)) |
1104 |
;;Macros for conditionally writing vs_base ..preamble, and for setting |
;;Macros for conditionally writing vs_base ..preamble, and for setting |
1105 |
;;up the return. |
;;up the return. |
1106 |
(defun wt-V*-macros (cm return-type) |
(defun wt-V*-macros (cm return-type) |
1107 |
|
(declare (ignore return-type)) |
1108 |
(push (cons cm *max-vs*) *reservations*) |
(push (cons cm *max-vs*) *reservations*) |
1109 |
(if (and (zerop *max-vs*) (not *sup-used*) (not *base-used*)) |
(if (and (zerop *max-vs*) (not *sup-used*) (not *base-used*)) |
1110 |
;;note if (proclaim '(function foo () t)) |
;;note if (proclaim '(function foo () t)) |
1705 |
)) |
)) |
1706 |
)) |
)) |
1707 |
(and *c-vars* (format *compiler-output2* ";")) |
(and *c-vars* (format *compiler-output2* ";")) |
1708 |
(unless (eql *cs* 0) |
(unless (or (not *vcs-used*) (eql *cs* 0)) |
1709 |
; (format *compiler-output2* " object Vcs[~a]={Cnil" *cs*) |
; (format *compiler-output2* " object Vcs[~a]={Cnil" *cs*) |
1710 |
; (dotimes (temp (- *cs* 1) t) (format *compiler-output2* ",Cnil")) |
; (dotimes (temp (- *cs* 1) t) (format *compiler-output2* ",Cnil")) |
1711 |
; (format *compiler-output2* "};")) |
; (format *compiler-output2* "};")) |