diff --git a/src/new-cmp/cmpenv.lsp b/src/new-cmp/cmpenv.lsp index b3d757f7a..046bc4005 100644 --- a/src/new-cmp/cmpenv.lsp +++ b/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) diff --git a/src/new-cmp/cmpmain.lsp b/src/new-cmp/cmpmain.lsp index 71e2426f5..6d85ada7f 100644 --- a/src/new-cmp/cmpmain.lsp +++ b/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)) diff --git a/src/new-cmp/cmpname.lsp b/src/new-cmp/cmpname.lsp index c7253e5ad..26f2be8e0 100644 --- a/src/new-cmp/cmpname.lsp +++ b/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) diff --git a/src/new-cmp/cmppackage.lsp b/src/new-cmp/cmppackage.lsp index c23454a17..3711b877b 100644 --- a/src/new-cmp/cmppackage.lsp +++ b/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" diff --git a/src/new-cmp/cmptranslate.lsp b/src/new-cmp/cmptranslate.lsp index 40c2295a9..9f0270604 100644 --- a/src/new-cmp/cmptranslate.lsp +++ b/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 ;;;