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

Diff of /gcl/cmpnew/cmptop.lsp

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

revision 1.9 by camm, Tue Jul 15 18:03:36 2003 UTC revision 1.10 by camm, Tue Sep 2 20:32:43 2003 UTC
# Line 230  Line 230 
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    
# Line 245  Line 245 
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    
# Line 252  Line 253 
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    
# Line 262  Line 264 
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 () {")
# Line 857  Line 861 
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))
# Line 1018  Line 1022 
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          ))          ))
# Line 1100  Line 1104 
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))
# Line 1700  Line 1705 
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* "};"))

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

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