added GC_PROTECT to protect ret1 and mv_vec

cig/cig.scm

@@ -646,7 +646,6 @@
   (destructure (( (#f scheme-name (c-name . params) . return-reps) form ))
     (let* ((c-name (stringify c-name))
 	   (reps (map car params))
-	   
 	   (no-declare? (and (pair? return-reps)
 			     (eq? 'no-declare (car return-reps))))
 	   (return-reps (if no-declare? (cdr return-reps)
@@ -659,6 +658,9 @@
 	   (ret-infos1 (parse-return-reps return-reps
 					  (lambda (x) x)))
 	   (ignore? (string? ret-infos1))
+	   (gc-protected-vars (if ignore?  ; maybe extended by mv_vec
+				  '() 
+				  '("ret1")))
 
 	   (ret-infos2 (if (not ignore?)	; Flatten them out.
 			   (apply append ret-infos1))) 
@@ -681,7 +683,22 @@
 				;; Is major ret val non-immediate
 				(not (retrep:immediate
 				      (caar ret-infos1))))))
-
+	   (gc-protected-vars (if mv-return? 
+				  (cons "mv_vec" gc-protected-vars)
+				  gc-protected-vars))
+	   (gc_declare (if (> (length gc-protected-vars) 0) 
+			   (format #f "~%    S48_DECLARE_GC_PROTECT(~d);" 
+			       (length gc-protected-vars))
+			   ""))
+	   (gc_protect (if (> (length gc-protected-vars) 0)
+			   (format #f "~%    S48_GC_PROTECT_~d(~a);"
+			       (length gc-protected-vars)
+			       (if (null? (cdr gc-protected-vars))
+				   (car gc-protected-vars)
+				   (string-append (car gc-protected-vars)
+						  ","
+						  (cadr gc-protected-vars))))
+			   ""))
 	   (nargs (length reps))
 	   (stub-nargs (if mv-return? (+ nargs 1) nargs))
 	   (other-retvals (if ignore? '() (cdr ret-infos3)))
@@ -743,17 +760,19 @@
 	   (mv-assigns (if ignore? ""
 			   (make-mv-assigns (cons "r1" ret-vars)
 					    ret-infos1)))
-
+	   (gc_unprotect (if (> (length gc-protected-vars) 0)
+			     "\n    S48_GC_UNPROTECT();"
+			     ""))
 	   (return-stmt (format #f "~%    return ~a;"
 				(if ignore? "S48_FALSE" "ret1")))
 
 	   ;; Do the call, release the free-vars, do the mv-return
 	   ;; assignments, then return.
 	   (epilog (if ignore?
-		       (string-append c-call ";" post-C-val-processing return-stmt)
-		       (string-append "r1 = " c-call ";"
+		       (string-append  c-call ";" post-C-val-processing return-stmt)
+		       (string-append  gc_protect "\n    r1 = " c-call ";"
 				      post-C-val-processing
-				      mv-assigns return-stmt))))
+				      mv-assigns gc_unprotect return-stmt))))
 ;     (breakpoint)
       (format #f cfun-boilerplate
 	      c-name
@@ -765,6 +784,7 @@
 	      ; Frank: end
 	      c-fun-decl
 	      (if ignore? "" ret1-decl)
+	      gc_declare
 	      primary-retvar-decl ret-var-decls pc-var-decls
 	      pc-var-assigns
 	      epilog))))
@@ -773,7 +793,7 @@
 (define cfun-boilerplate
   "s48_value df_~a(~a)
 {
-    ~a~a~a~a~a
+    ~a~a~a~a~a~a
 
     ~a
     ~a
@@ -904,29 +924,6 @@ step 4
 		    (lp (append c-names (define-foreign-process-form form oport))))))))))))
 ; Frank: end
 
-; JMG: stolen from various places 
-(define (file-name-nondirectory fname)
-  (cond ((rindex fname #\/) =>
-	 (lambda (rslash)
-	   (if (last-non-slash fname)
-	       (substring fname (+ 1 rslash) (string-length fname))
-	       fname)))	; Posix strangeness: solid slashes are root.
-	(else fname)))
-
-(define (rindex str c ) ;removed optional argument
-  (let* ((len (string-length str))
-	 (start len))
-    (do ((i (- start 1) (- i 1)))
-	((or (< i 0)
-	     (char=? c (string-ref str i)))
-	 (and (>= i 0) i)))))
-
-(define (last-non-slash str)
-  (let lp ((i (- (string-length str) 1)))
-    (and (>= i 0)
-	 (if (char=? #\/ (string-ref str i))
-	     (lp (- i 1))
-	     i))))
 
 (define (cig-standalone-toplevel f-and-init-name) ; ignore your args no
   (process-define-foreign-stream (current-input-port)