C1CLEANUP-FORMS back to cmptranslate wrapping around C-ENV:CMP-ENV-CLEANUPS. GUESS-KIND is no longer used in C-TAGS.

src/new-cmp/cmpenv.lsp

@@ -418,7 +418,7 @@
 (defmacro cmp-env-functions (&optional (env '*cmp-env*))
   `(cdr ,env))
 
-(defun c1cleanup-forms (env)
+(defun cmp-env-cleanups (env)
   (loop with specials = '()
 	with end = (cmp-env-variables env)
 	with cleanup-forms = '()
@@ -435,9 +435,8 @@
 	finally (progn
 		  (unless (eq records-list end)
 		    (error "Inconsistency in environment."))
-		  (return-from c1cleanup-forms
-		    (nconc (c1unbind specials nil)
-			   (apply #'nconc (mapcar #'copy-list cleanup-forms)))))))
+		  (return (values specials
+                                  (apply #'nconc (mapcar #'copy-list cleanup-forms)))))))
 
 (defun cmp-env-register-var (var &optional (env *cmp-env*) (boundp t))
   (push (list (var-name var)

src/new-cmp/cmpmain.lsp

@@ -342,7 +342,7 @@ output = cl_safe_eval(c_string_to_object(lisp_code), Cnil, OBJNULL);
 				  :object :c))
 	     (error "C::BUILDER does not accept a file ~s of kind ~s" item kind))
 	   (let* ((path (parse-namestring item))
-		  (init-fn (guess-init-name path))
+		  (init-fn (guess-init-name path target))
 		  (flags (guess-ld-flags path)))
 	     ;; We should give a warning that we cannot link this module in
 	     (when flags (push flags ld-flags))

src/new-cmp/cmpname.lsp

@@ -97,14 +97,14 @@ the function name it precedes."
       (subseq name (length prefix) nil)
       name))
 
-(defun guess-init-name (pathname &key (kind (guess-kind pathname)))
+(defun guess-init-name (pathname &key kind)
   (if (eq kind :object)
     (or (and (probe-file pathname)
 	     (find-init-name pathname))
 	(error "Cannot find out entry point for binary file ~A" pathname))
     (compute-init-name pathname :kind kind)))
 
-(defun compute-init-name (pathname &key (kind (guess-kind pathname)))
+(defun compute-init-name (pathname &key kind)
   (let ((filename (pathname-name pathname)))
     (case kind
       ((:object :c)

src/new-cmp/cmppackage.lsp

@@ -133,8 +133,7 @@
    "CMP-ENV-REGISTER-FUNCTOIN" "CMP-ENV-REGISTER-MACRO"
    "CMP-ENV-REGISTER-FTYPE" "CMP-ENV-REGISTER-SYMBOL-MACRO"
    "CMP-ENV-REGISTER-BLOCK" "CMP-ENV-REGISTER-TAG"
-   "CMP-ENV-REGISTER-CLEANUP"
-   "C1CLEANUM-FORMS"
+   "CMP-ENV-REGISTER-CLEANUP" "CMP-ENV-CLEANUPS"
    "CMP-ENV-SEARCH-FUNCTION" "CMP-ENV-SEARCH-VARIABLES"
    "CMP-ENV-SEARCH-BLOCK" "CMP-ENV-SEARCH-TAG"
    "CMP-ENV-SEARCH-SYMBOL-MACRO" "CMP-ENV-SEARCH-VAR"
@@ -176,6 +175,7 @@
   (:export "TYPE-AND"
            "TYPE-OR"
            "TYPE>="
+           "TYPE-FILTER"
            "VALUES-TYPE-PRIMARY-TYPE"
            "VALUES-TYPE-TO-N-TYPES"
            "DEFAULT-INIT"
@@ -186,7 +186,7 @@
            "OPTIONAL-CHECK-TYPE"))
 
 (defpackage "C-TAGS"
-  (:use "CL")
+  (:use "CL" "C-LOG" "C-DATA")
   (:export "GUESS-INIT-NAME"
            "COMPUTE-INIT-NAME"
            "INIT-NAME-TAG"

src/new-cmp/cmptranslate.lsp

@@ -143,6 +143,15 @@
                                 (c1unbind (list temp-var))))))
      ,@body))
 
+;;;
+;;; CLEANUP STATEMENTS
+;;;
+
+(defun c1cleanup-forms (env)
+  (multiple-value-bind (specials other-statements)
+      (cmp-env-cleanups env)
+    (nconc (c1unbind specials nil) other-statements)))
+
 ;;;
 ;;; VARIABLE BINDINGS
 ;;;