cmp: data segment: add function names with ADD-FNAME

Instead of ADD-SYMBOL. The latter now asserts that the argument is a symbol. The
function name on the other hand may be a SYMBOL or (SETF SYMBOL).

src/cmp/cmpbackend-cxx/cmppass2-call.lsp

@@ -258,7 +258,7 @@
     (if (and (symbolp fname)
              (not (eql (symbol-package fname) 
                        (find-package "CL"))))
-        (setf loc (add-symbol fname)
+        (setf loc (add-fname fname)
               function-p nil)
         (setf loc (list 'FDEFINITION fname)
               function-p t)))

src/cmp/cmpbackend-cxx/cmppass2-fun.lsp

@@ -185,7 +185,7 @@
     (push 'IHS *unwind-exit*)
     (when (policy-debug-variable-bindings)
       (build-debug-lexical-env (reverse requireds) t))
-    (wt-nl "ecl_ihs_push(cl_env_copy,&ihs," (add-symbol (or description fname))
+    (wt-nl "ecl_ihs_push(cl_env_copy,&ihs," (add-fname (or description fname))
            ",_ecl_debug_env);"))
 
   ;; Bind optional parameters as long as there remain arguments.

src/cmp/cmpbackend-cxx/cmppass2-loc.lsp

@@ -120,7 +120,8 @@
     (dolist (arg args)
       (wt ", " arg))
     (wt ")")
-    (when fname (wt-comment fname))))
+    (when fname
+      (wt-comment fname))))
 
 (defun wt-call-stack (loc fname)
   (wt "ecl_apply_from_stack_frame(_ecl_inner_frame," loc ")")
@@ -167,23 +168,23 @@
                             (eq package (find-package "SI")))
                         (fboundp fun-name)
                         (functionp (fdefinition fun-name))))))
-    (if (eq name fun-name)
-        ;; #'symbol
-        (let ((vv (add-symbol name)))
-          (if safe
-              (wt "(" vv "->symbol.gfdef)")
-              (wt "ecl_fdefinition(" vv ")")))
-        ;; #'(SETF symbol)
-        (if safe
-            (let ((set-loc (assoc name *setf-definitions*)))
-              (unless set-loc
-                (let* ((setf-vv (data-empty-loc))
-                       (name-vv (add-symbol name)))
-                  (setf set-loc (list name setf-vv name-vv))
-                  (push set-loc *setf-definitions*)))
-              (wt "ECL_CONS_CAR(" (second set-loc) ")"))
-            (let ((vv (add-symbol fun-name)))
-              (wt "ecl_fdefinition(" vv ")"))))))
+    (cond
+      ((not safe)
+       (let ((vv (add-fname fun-name)))
+         (wt "ecl_fdefinition(" vv ")")))
+      ((eq name fun-name)
+       ;; #'symbol
+       (let ((vv (add-fname name)))
+         (wt "(" vv "->symbol.gfdef)")))
+      (t
+       ;; #'(SETF symbol)
+       (let ((set-loc (assoc name *setf-definitions*)))
+         (unless set-loc
+           (let* ((setf-vv (data-empty-loc))
+                  (name-vv (add-symbol name)))
+             (setf set-loc (list name setf-vv name-vv))
+             (push set-loc *setf-definitions*)))
+         (wt "ECL_CONS_CAR(" (second set-loc) ")"))))))
 
 (defun environment-accessor (fun)
   (let* ((env-var (env-var-name *env-lvl*))

src/cmp/cmppass1-data.lsp

@@ -146,7 +146,12 @@
       (setf (vv-used-p vv) t))
     vv))
 
+(defun add-fname (fname)
+  (check-type fname function-name)
+  (add-object fname :duplicate nil :permanent t))
+
 (defun add-symbol (symbol)
+  (check-type symbol symbol)
   (add-object symbol :duplicate nil :permanent t))
 
 (defun add-keywords (keywords)