/[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.2 by camm, Fri Jul 12 22:00:48 2002 UTC revision 1.3 by camm, Sat Jul 20 07:10:55 2002 UTC
# Line 227  Line 227 
227    (setq *top-level-forms* (reverse *top-level-forms*))    (setq *top-level-forms* (reverse *top-level-forms*))
228    
229    ;;; Initialization function.    ;;; Initialization function.
230    (wt-nl1     "init_" name "(){"    (wt-nl1     "void init_" name "(){"
231                #+sgi3d "Init_Links ();"                #+sgi3d "Init_Links ();"
232                 "do_init(VV);"                 "do_init(VV);"
233                "}")                "}")
# Line 266  Line 266 
266             )             )
267    #+sgi3d    #+sgi3d
268    (progn    (progn
269      (wt-nl1 "" "static Init_Links () {")      (wt-nl1 "" "static void Init_Links () {")
270      (dolist* (x *function-links*)      (dolist* (x *function-links*)
271               (let ((num (second x)))               (let ((num (second x)))
272                 (wt-nl "Lnk" num " = LnkT" num ";")))                 (wt-nl "Lnk" num " = LnkT" num ";")))
273      (wt-nl1 "}"))      (wt-nl1 "}"))
274    
275    ;;; Declarations in h-file.    ;;; Declarations in h-file.
276    (dolist* (fun *closures*) (wt-h "static LC" (fun-cfun fun) "();"))    (dolist* (fun *closures*) (wt-h "static void LC" (fun-cfun fun) "();"))
277    (dolist* (x *reservations*)    (dolist* (x *reservations*)
278             (wt-h "#define VM" (car x) " " (cdr x)))             (wt-h "#define VM" (car x) " " (cdr x)))
279    
# Line 315  Line 315 
315                    (t                    (t
316                     (setq type (if type (Rep-type type) ""))))                     (setq type (if type (Rep-type type) ""))))
317    
318              (wt-h "static " type " LnkT" num "() ;") ;initial function.              (wt-h "static " (if (equal type "") "void" type) " LnkT" num "() ;") ;initial function.
319     #-sgi3d    (wt-h "static "  type " (*Lnk" num ")() = LnkT" num ";")     #-sgi3d    (wt-h "static "  (if (equal type "") "void" type) " (*Lnk" num ")() = LnkT" num ";")
320     #+sgi3d    (wt-h "static "  type " (*Lnk" num ")();")))     #+sgi3d    (wt-h "static "  (if (equal type "") "void" type) " (*Lnk" num ")();")))
321    )    )
322    
323    
# Line 620  Line 620 
620                                         (maxargs (lambda-list lambda-expr))))                                         (maxargs (lambda-list lambda-expr))))
621                     ))))                     ))))
622          ((numberp cfun)          ((numberp cfun)
623           (wt-h "static L" cfun "();")           (wt-h "static void L" cfun "();")
624           (add-init `(si::mf ',fname ,(add-address "L" cfun)) ))           (add-init `(si::mf ',fname ,(add-address "L" cfun)) ))
625          (t (wt-h cfun "();")          (t (wt-h cfun "();")
626             (add-init `(si::mf ',fname ,(add-address "" cfun )) )))             (add-init `(si::mf ',fname ,(add-address "" cfun )) )))
# Line 713  Line 713 
713                (when *compiler-push-events* (wt-nl "ihs_check;"))                (when *compiler-push-events* (wt-nl "ihs_check;"))
714                (when *tail-recursion-info*                (when *tail-recursion-info*
715                      (push 'tail-recursion-mark *unwind-exit*)                      (push 'tail-recursion-mark *unwind-exit*)
716                      (wt-nl1 "TTL:;"))                      (wt-nl1 "goto TTL;") (wt-nl1 "TTL:;"))
717                (dolist                (dolist
718                  (v specials)                  (v specials)
719                    (wt-nl "bds_bind(VV[" (cdr v)"],V" (var-loc (car v))");")                    (wt-nl "bds_bind(VV[" (cdr v)"],V" (var-loc (car v))");")
# Line 722  Line 722 
722                    (setf (var-loc (car v)) (cdr v)))                    (setf (var-loc (car v)) (cdr v)))
723                (c2expr (caddr (cddr lambda-expr)))                (c2expr (caddr (cddr lambda-expr)))
724                                
725    ;;; Use base if defined for lint
726                  (if (and (zerop *max-vs*) (not *sup-used*) (not *base-used*)) t (wt-nl "base[0]=base[0];"))
727    
728    ;;; Make sure to return object if necessary
729                  (if (equal "object " (rep-type (caddr inline-info))) (wt-nl "return Cnil;"))
730    
731                (wt-nl1 "}")                (wt-nl1 "}")
732                (wt-V*-macros cm (caddr inline-info))                (wt-V*-macros cm (caddr inline-info))
733           ))           ))
# Line 811  Line 817 
817                      (when (cadddr kwd) (do-decl (cadddr kwd))))                      (when (cadddr kwd) (do-decl (cadddr kwd))))
818            )            )
819    
820      ;;; Use Vcs for lint
821        (if *vararg-use-vs* t (progn (wt-nl "Vcs[0]=Vcs[0];")))
822    
823      ;;; start va_list at beginning
824        (if (or (ll-optionals ll) (ll-rest ll) (ll-keywords-p ll))
825            (unless va-start (setq va-start t) (wt-nl "va_start(ap);")))
826          
827    ;;; Check arguments.    ;;; Check arguments.
828      (when (and (or *safe-compile* *compiler-check-args*) (car ll))      (when (and (or *safe-compile* *compiler-check-args*) (car ll))
829            (wt-nl "if(narg <" (length (car ll))            (wt-nl "if(narg <" (length (car ll))
# Line 834  Line 847 
847           (vl (car ll) (cdr vl)))           (vl (car ll) (cdr vl)))
848          ((null v))          ((null v))
849          (c2bind-loc (car vl) (car v)))          (c2bind-loc (car vl) (car v)))
850     (when (ll-optionals ll)      (when (ll-optionals ll)
851           (let ((*clink* *clink*)        (let ((*clink* *clink*)
852                 (*unwind-exit* *unwind-exit*)              (*unwind-exit* *unwind-exit*)
853                 (*ccb-vs* *ccb-vs*))              (*ccb-vs* *ccb-vs*))
854             (wt-nl "narg = narg - " (length reqs) ";")          (wt-nl "narg = narg - " (length reqs) ";")
855      (dolist** (opt (ll-optionals ll))          (dolist** (opt (ll-optionals ll))
856       (push (next-label) labels)                    (push (next-label) labels)
857       (wt-nl "if (" (if (cdr labels) "--" "") "narg <= 0) ")                    (wt-nl "if (" (if (cdr labels) "--" "") "narg <= 0) ")
858       (wt-go (car labels))                    (wt-go (car labels))
859       (wt-nl "else {" )                    (wt-nl "else {" )
860       (unless va-start (setq va-start t) (wt-nl "va_start(ap);"))                    (unless va-start (setq va-start t) (wt-nl "va_start(ap);"))
861       (c2bind-loc (car opt) (list 'next-var-arg))                    (c2bind-loc (car opt) (list 'next-var-arg))
862       (wt "}")                    (wt "}")
863       (when (caddr opt) (c2bind-loc (caddr opt) t))))                    (when (caddr opt) (c2bind-loc (caddr opt) t))))
864           (setq labels (nreverse labels))        (setq labels (nreverse labels))
865          
866      (let ((label (next-label)))        (let ((label (next-label)))
867               (wt-nl "--narg; ")          (wt-nl "--narg; ")
868               (wt-go label)          (wt-go label)
869            
870               ;;; Bind unspecified optional parameters.               ;;; Bind unspecified optional parameters.
871            
872               (dolist** (opt (ll-optionals ll))          (dolist** (opt (ll-optionals ll))
873                         (wt-label (car labels))                    (wt-label (car labels))
874                         (pop labels)                    (pop labels)
875                         (c2bind-init (car opt) (cadr opt))                    (c2bind-init (car opt) (cadr opt))
876                         (when (caddr opt) (c2bind-loc (caddr opt) nil)))                    (when (caddr opt) (c2bind-loc (caddr opt) nil)))
877  ;            (if (or (ll-rest ll)(ll-keywords-p ll))(wt-nl "narg=0;"))                                          ;            (if (or (ll-rest ll)(ll-keywords-p ll))(wt-nl "narg=0;"))
878            
879               (wt-label label)          (wt-label label)
880               ))          ))
881     (if (ll-rest ll)      (if (ll-rest ll)
882         (progn          (progn
883           (setq rest-var (cs-push))            (setq rest-var (cs-push))
884           (cond ((ll-optionals ll))            (cond ((ll-optionals ll))
885                 (t (wt-nl "narg= narg - " (length (car ll)) ";")))                  (t (wt-nl "narg= narg - " (length (car ll)) ";")))
886           (unless va-start (setq va-start t) (wt-nl "va_start(ap);"))            (unless va-start (setq va-start t) (wt-nl "va_start(ap);"))
887           (wt-nl "V" rest-var " = ")            (wt-nl "V" rest-var " = ")
888                      
889           (let ((*rest-on-stack*            (let ((*rest-on-stack*
890                  (or (eq (var-type (ll-rest ll)) :dynamic-extent)                   (or (eq (var-type (ll-rest ll)) :dynamic-extent)
891                      *rest-on-stack*)))                       *rest-on-stack*)))
892             (if (ll-keywords-p ll)              (if (ll-keywords-p ll)
893               (cond (*rest-on-stack*                  (cond (*rest-on-stack*
894                      (wt "(ALLOCA_CONS(narg),ON_STACK_MAKE_LIST(narg));"))                         (wt "(ALLOCA_CONS(narg),ON_STACK_MAKE_LIST(narg));"))
895                     (t (wt "make_list(narg);")))                        (t (wt "make_list(narg);")))
896               (cond (*rest-on-stack*                (cond (*rest-on-stack*
897                      (wt "(ALLOCA_CONS(narg),ON_STACK_LIST_VECTOR(narg,ap));"                       (wt "(ALLOCA_CONS(narg),ON_STACK_LIST_VECTOR(narg,ap));"
898                          ))                           ))
899                     (t  (wt "list_vector(narg,ap);"))))                      (t  (wt "list_vector(narg,ap);"))))
900             (c2bind-loc (ll-rest ll) (list 'cvar rest-var)))))              (c2bind-loc (ll-rest ll) (list 'cvar rest-var)))))
901     (when (ll-keywords-p ll)      (when (ll-keywords-p ll)
902           (cond ((ll-rest ll))        (cond ((ll-rest ll))
903                 ((ll-optionals ll))              ((ll-optionals ll))
904                 (t (wt-nl "narg= narg - " (length (car ll)) ";")))              (t (wt-nl "narg= narg - " (length (car ll)) ";")))
905                          
906           (unless va-start (setq va-start t) (wt-nl "va_start(ap);"))        (unless va-start (setq va-start t) (wt-nl "va_start(ap);"))
907           (setq deflt (mapcar 'caddr (ll-keywords ll)))        (setq deflt (mapcar 'caddr (ll-keywords ll)))
908           (let ((vkdefaults nil)        (let ((vkdefaults nil)
909                 (n (length (ll-keywords ll))))              (n (length (ll-keywords ll))))
910           (do* ((v deflt (cdr v))          (do* ((v deflt (cdr v))
911                (kwds (ll-keywords ll) (cdr kwds))                (kwds (ll-keywords ll) (cdr kwds))
912                (kwd (car kwds) (car kwds)))                (kwd (car kwds) (car kwds)))
913               ((null v))               ((null v))
914               (unless (and (eq (caar v)  'location)               (unless (and (eq (caar v)  'location)
915                            (eq (third (car v)) nil))                            (eq (third (car v)) nil))
916                       (setq vkdefaults t))                 (setq vkdefaults t))
917               (when (or (not (and (eq (caar v) 'location)               (when (or (not (and (eq (caar v) 'location)
918                                   (let ((tem (third (car v))))                                   (let ((tem (third (car v))))
919                                     (or (eq tem nil)                                     (or (eq tem nil)
# Line 910  Line 923 
923                                              )))))                                              )))))
924                         ;; the supplied-p variable is not there                         ;; the supplied-p variable is not there
925                         (not (eq (var-kind (cadddr kwd)) 'DUMMY)))                         (not (eq (var-kind (cadddr kwd)) 'DUMMY)))
926                     (setf Vkdefaults t)                 (setf Vkdefaults t)
927                     (setf (car v) 0)))                 (setf (car v) 0)))
928           (if (> (length deflt) 15) (setq vkdefaults t))          (if (> (length deflt) 15) (setq vkdefaults t))
929            
930           (wt-nl "{")          (wt-nl "{")
931           (inc-inline-blocks)          (inc-inline-blocks)
932           (let ((*compiler-output1* *compiler-output2*))          (let ((*compiler-output1* *compiler-output2*))
933             (when vkdefaults            (when vkdefaults
934                   (terpri *compiler-output2*)              (terpri *compiler-output2*)
935                   (wt "static object VK" cfun              (wt "static object VK" cfun
936                          "defaults[" (length deflt) "]={")                  "defaults[" (length deflt) "]={")
937                   (do ((v deflt(cdr v))(tem))              (do ((v deflt(cdr v))(tem))
938                       ((null v))                  ((null v))
939                      (wt "(void *)")                  (wt "(void *)")
940                       (cond ((eql (car v) 0)                  (cond ((eql (car v) 0)
941                              (wt "-1"))                         (wt "-1"))
942                             ;; must be location                        ;; must be location
943                             ((and (eq (setq tem (third (car v))) nil))                        ((and (eq (setq tem (third (car v))) nil))
944                              (wt "-2"))                         (wt "-2"))
945                             ((and (consp tem) (eq (car tem) 'vv))                        ((and (consp tem) (eq (car tem) 'vv))
946                              (wt  (second tem) ))                         (wt  (second tem) ))
947                             ((and (consp tem) (eq (car tem) 'fixnum-value))                        ((and (consp tem) (eq (car tem) 'fixnum-value))
948                              (wt (add-object(third tem)) ))                         (wt (add-object(third tem)) ))
949                             (t (baboon)))                        (t (baboon)))
                                 
                      (if (cdr v) (wt ",")))  
                  (wt "};"))  
            (terpri *compiler-output2*)  
            (wt "static struct { short n,allow_other_keys;"  
                   "object *defaults;")  
            (wt-nl " KEYTYPE keys[" (max n 1) "];")  
            (wt "} LI"cfun "key=")  
950                                    
951             (wt "{" (length (ll-keywords ll)) ","                  (if (cdr v) (wt ",")))
952                 (if (ll-allow-other-keys ll) 1 0)              (wt "};"))
953                 ",")            (terpri *compiler-output2*)
954             (if vkdefaults (wt "VK" cfun "defaults")            (wt "static struct { short n,allow_other_keys;"
955               (wt "Cstd_key_defaults"))                "object *defaults;")
956             (when (ll-keywords ll)            (wt-nl " KEYTYPE keys[" (max n 1) "];")
957                   (wt ",{")            (wt "} LI"cfun "key=")
958                   (do ((v (reverse (ll-keywords ll)) (cdr v)))            
959                       ((null v))            (wt "{" (length (ll-keywords ll)) ","
960                       ;; We write this list backwards for convenience                (if (ll-allow-other-keys ll) 1 0)
961                       ;; in stepping through it in parse_key                ",")
962                       (wt "(void *)")            (if vkdefaults (wt "VK" cfun "defaults")
963                       (wt  (add-symbol (caar v))  )              (wt "Cstd_key_defaults"))
964                       (if (cdr v) (wt ",")))            (when (ll-keywords ll)
965                   (wt "}"))              (wt ",{")
966             (wt "};")              (do ((v (reverse (ll-keywords ll)) (cdr v)))
967             )                  ((null v))
968           (cond ((ll-rest ll)                  ;; We write this list backwards for convenience
969                  (wt-nl "parse_key_rest(" (list 'cvar rest-var) ","))                  ;; in stepping through it in parse_key
970                 (t (wt-nl "parse_key_new(")))                  (wt "(void *)")
971           (if (eql 0 *cs*)(setq *cs* 1))                  (wt  (add-symbol (caar v))  )
972           (wt "narg," (if *vararg-use-vs* "base " "Vcs ")                  (if (cdr v) (wt ",")))
973               "+" key-offset",&LI" cfun "key,ap);")              (wt "}"))
974                    (wt "};")
975         ))            )
976            (cond ((ll-rest ll)
977                   (wt-nl "parse_key_rest(" (list 'cvar rest-var) ","))
978                  (t (wt-nl "parse_key_new(")))
979     ;; bind keywords          (if (eql 0 *cs*)(setq *cs* 1))
980            (wt "narg," (if *vararg-use-vs* "base " "Vcs ")
981                "+" key-offset",(struct key *)&LI" cfun "key,ap);")
982            
983            ))
984        
985        
986        
987        ;; bind keywords
988        
989        (dolist** (kwd (ll-keywords ll))
990                  (cond ((not (eql 0 (pop deflt)))
991                         ;; keyword default bound by parse_key.. and no supplied-p
992                         (c2bind (cadr kwd)))
993                        (t
994                         (wt-nl "if(") (wt-vs (var-ref (cadr kwd))) (wt "==0){")
995                         (let ((*clink* *clink*)
996                               (*unwind-exit* *unwind-exit*)
997                               (*ccb-vs* *ccb-vs*))
998                           (c2bind-init (cadr kwd) (caddr kwd)))
999                         (unless (eq (var-kind (cadddr kwd)) 'DUMMY) (c2bind-loc (cadddr kwd) nil))
1000                        
1001                         (wt-nl "}else{")
1002                         (c2bind (cadr kwd))
1003                         (unless (eq (var-kind (cadddr kwd)) 'DUMMY) (c2bind-loc (cadddr kwd)
1004                                                                                 t))
1005                        
1006                         (wt "}")))
1007                  
1008                  
1009                  
1010                  )
1011    
1012     (dolist** (kwd (ll-keywords ll))      (when *tail-recursion-info*
1013      (cond ((not (eql 0 (pop deflt)))        (push 'tail-recursion-mark *unwind-exit*)
1014             ;; keyword default bound by parse_key.. and no supplied-p        (wt-nl1 "goto TTL;") (wt-nl1 "TTL:;"))
1015             (c2bind (cadr kwd)))      (c2expr (caddr (cddr lambda-expr)))
1016            (t      
1017             (wt-nl "if(") (wt-vs (var-ref (cadr kwd))) (wt "==0){")      ;;; End va_list at function end
            (let ((*clink* *clink*)  
                  (*unwind-exit* *unwind-exit*)  
                  (*ccb-vs* *ccb-vs*))  
                 (c2bind-init (cadr kwd) (caddr kwd)))  
            (unless (eq (var-kind (cadddr kwd)) 'DUMMY) (c2bind-loc (cadddr kwd) nil))  
   
            (wt-nl "}else{")  
            (c2bind (cadr kwd))  
            (unless (eq (var-kind (cadddr kwd)) 'DUMMY) (c2bind-loc (cadddr kwd)  
                                                                    t))  
1018    
1019             (wt "}")))      (when va-start (setq va-start nil) (wt-nl "va_end(ap);"))
1020    
1021    ;;; Use base if defined for lint
1022        (if (and (zerop *max-vs*) (not *sup-used*) (not *base-used*)) t (wt-nl "base[0]=base[0];"))
1023    
1024    ;;; Need to ensure return of type object
1025        (wt-nl "return Cnil;")
1026    
1027     )      (wt "}")
1028     (when *tail-recursion-info*      (when block-p (wt-nl "}"))
1029           (push 'tail-recursion-mark *unwind-exit*)      (close-inline-blocks)
1030           (wt-nl1 "TTL:;"))      (wt-V*-macros cm (get fname 'proclaimed-return-type))
1031     (c2expr (caddr (cddr lambda-expr)))      ))
                   
   (wt "}")  
   (when block-p (wt-nl "}"))  
   (close-inline-blocks)  
   (wt-V*-macros cm (get fname 'proclaimed-return-type))  
               ))  
1032    
1033  (defun t3defun-normal (fname cfun lambda-expr sp)  (defun t3defun-normal (fname cfun lambda-expr sp)
1034           (wt-comment "function definition for " fname)           (wt-comment "function definition for " fname)
1035           (if (numberp cfun)           (if (numberp cfun)
1036               (wt-nl1 "static L" cfun "()")               (wt-nl1 "static void L" cfun "()")
1037               (wt-nl1 cfun "()"))               (wt-nl1 cfun "()"))
1038           (wt-nl1 "{" "register object *"  *volatile*"base=vs_base;")           (wt-nl1 "{" "register object *"  *volatile*"base=vs_base;")
1039           (assign-down-vars (info-referred-vars (cadr lambda-expr)) cfun           (assign-down-vars (info-referred-vars (cadr lambda-expr)) cfun
# Line 1164  Line 1188 
1188  (defun wt-global-entry (fname cfun arg-types return-type)  (defun wt-global-entry (fname cfun arg-types return-type)
1189      (cond ((get fname 'no-global-entry)(return-from wt-global-entry nil)))      (cond ((get fname 'no-global-entry)(return-from wt-global-entry nil)))
1190      (wt-comment "global entry for the function " fname)      (wt-comment "global entry for the function " fname)
1191      (wt-nl1 "static L" cfun "()")      (wt-nl1 "static void L" cfun "()")
1192      (wt-nl1 "{  register object *base=vs_base;")      (wt-nl1 "{  register object *base=vs_base;")
1193      (when (or *safe-compile* *compiler-check-args*)      (when (or *safe-compile* *compiler-check-args*)
1194            (wt-nl "check_arg(" (length arg-types) ");"))            (wt-nl "check_arg(" (length arg-types) ");"))
# Line 1230  Line 1254 
1254    (when doc (add-init `(si::putprop ',fname ,doc 'si::function-documentation) ))    (when doc (add-init `(si::putprop ',fname ,doc 'si::function-documentation) ))
1255    (when ppn    (when ppn
1256          (add-init `(si::putprop ',fname ',ppn 'si::pretty-print-format) ))          (add-init `(si::putprop ',fname ',ppn 'si::pretty-print-format) ))
1257    (wt-h "static L" cfun "();")    (wt-h "static void L" cfun "();")
1258    (add-init `(si::MM ',fname ,(add-address "L" cfun)) )    (add-init `(si::MM ',fname ,(add-address "L" cfun)) )
1259    )    )
1260    
# Line 1241  Line 1265 
1265    (let-pass3    (let-pass3
1266     ((*exit* 'return))     ((*exit* 'return))
1267     (wt-comment "macro definition for " fname)     (wt-comment "macro definition for " fname)
1268     (wt-nl1 "static L" cfun "()")     (wt-nl1 "static void L" cfun "()")
1269     (wt-nl1 "{register object *" *volatile* "base=vs_base;")     (wt-nl1 "{register object *" *volatile* "base=vs_base;")
1270     (assign-down-vars (info-referred-vars (nth 4 macro-lambda)) cfun ;*dm-info*     (assign-down-vars (info-referred-vars (nth 4 macro-lambda)) cfun ;*dm-info*
1271                       't3defun)                       't3defun)
# Line 1480  Line 1504 
1504    
1505  (defun t2defentry (fname cfun arg-types type cname)  (defun t2defentry (fname cfun arg-types type cname)
1506    (declare (ignore arg-types type cname))    (declare (ignore arg-types type cname))
1507    (wt-h "static L" cfun "();")    (wt-h "static void L" cfun "();")
1508    (add-init `(si::mf ',fname ,(add-address "L" cfun)) )    (add-init `(si::mf ',fname ,(add-address "L" cfun)) )
1509    )    )
1510    
1511  (defun t3defentry (fname cfun arg-types type cname)  (defun t3defentry (fname cfun arg-types type cname)
1512    (wt-comment "function definition for " fname)    (wt-comment "function definition for " fname)
1513    (wt-nl1 "static L" cfun "()")    (wt-nl1 "static void L" cfun "()")
1514    (wt-nl1 "{    object *old_base=vs_base;")    (wt-nl1 "{    object *old_base=vs_base;")
1515    (case type    (case type
1516      (void)      (void)
# Line 1555  Line 1579 
1579               *downward-closures*               *downward-closures*
1580               (requireds (caaddr lambda-expr)))               (requireds (caaddr lambda-expr)))
1581    (wt-comment "local dc function " (if (fun-name fun) (fun-name fun) nil))    (wt-comment "local dc function " (if (fun-name fun) (fun-name fun) nil))
1582    (wt-nl1 "static " (if closure-p "LC" "L") (fun-cfun fun) "(")    (wt-nl1 "static void " (if closure-p "LC" "L") (fun-cfun fun) "(")
1583    (wt "base0" (if requireds "," ""))    (wt "base0" (if requireds "," ""))
1584    (analyze-regs (info-referred-vars (cadr lambda-expr)) 2)    (analyze-regs (info-referred-vars (cadr lambda-expr)) 2)
1585    (wt-requireds (caaddr lambda-expr) nil) ;;nil = arg types all t    (wt-requireds (caaddr lambda-expr) nil) ;;nil = arg types all t
# Line 1572  Line 1596 
1596          (when *compiler-push-events* (wt-nl "ihs_check;"))          (when *compiler-push-events* (wt-nl "ihs_check;"))
1597          (c2expr (caddr (cddr lambda-expr)))          (c2expr (caddr (cddr lambda-expr)))
1598          ;(c2lambda-expr (lambda-list lambda-expr) (caddr (cddr lambda-expr)))          ;(c2lambda-expr (lambda-list lambda-expr) (caddr (cddr lambda-expr)))
1599    ;;; Use base if defined for lint
1600            (if (and (zerop *max-vs*) (not *sup-used*) (not *base-used*)) t (wt-nl "base[0]=base[0];"))
1601          (wt-nl1 "}")          (wt-nl1 "}")
1602          (wt-V*-macros cm t)          (wt-V*-macros cm t)
1603          (wt-downward-closure-macro (fun-cfun fun))          (wt-downward-closure-macro (fun-cfun fun))
# Line 1587  Line 1613 
1613        (return-from t3local-fun        (return-from t3local-fun
1614                     (t3local-dcfun closure-p clink ccb-vs fun lambda-expr)))                     (t3local-dcfun closure-p clink ccb-vs fun lambda-expr)))
1615    (wt-comment "local function " (if (fun-name fun) (fun-name fun) nil))    (wt-comment "local function " (if (fun-name fun) (fun-name fun) nil))
1616    (wt-h   "static " (if closure-p "LC" "L") (fun-cfun fun) "();")    (wt-h   "static void " (if closure-p "LC" "L") (fun-cfun fun) "();")
1617    (wt-nl1 "static " (if closure-p "LC" "L") (fun-cfun fun) "(")    (wt-nl1 "static void " (if closure-p "LC" "L") (fun-cfun fun) "(")
1618    (dotimes* (n level (wt "base" n ")")) (wt "base" n ","))    (dotimes* (n level (wt "base" n ")")) (wt "base" n ","))
1619    (wt-nl1  "register object ")    (wt-nl1  "register object ")
1620    (dotimes* (n level (wt "*"*volatile*"base" n ";"))    (dotimes* (n level (wt "*"*volatile*"base" n ";"))
# Line 1634  Line 1660 
1660         ))         ))
1661   (and *c-vars* (format *compiler-output2* ";"))   (and *c-vars* (format *compiler-output2* ";"))
1662   (unless (eql *cs* 0)   (unless (eql *cs* 0)
1663    ;        (format *compiler-output2* " object Vcs[~a]={Cnil" *cs*)
1664    ;        (dotimes (temp (- *cs* 1) t) (format *compiler-output2* ",Cnil"))
1665    ;        (format *compiler-output2* "};"))
1666           (format *compiler-output2* " object Vcs[~a];" *cs*))           (format *compiler-output2* " object Vcs[~a];" *cs*))
1667    )    )
1668    

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

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