cmp: all baboon have now error message

This is useful for identification, where the problem occured. Also add some
indent and line wrap fixes which are estetic. Comment out unused variable.

src/cmp/cmpbind.lsp

@@ -46,7 +46,7 @@
        (wt-nl) (wt-lex var-loc) (wt " = ")
        (wt-coerce-loc :object loc)
        (wt ";"))
-       (wt-comment (var-name var)))
+     (wt-comment (var-name var)))
     ((SPECIAL GLOBAL)
      (bds-bind loc var))
     (t
@@ -61,8 +61,8 @@
             ;; set location for lambda list requireds
             (setf (var-loc var) loc))
            (t
-            (baboon)))
-         )))
+            (baboon :format-control "bind: unexpected var-kind (~s) and loc (~s)."
+                    :format-arguments (list (var-kind var) loc)))))))
 
 ;;; Used by let*, defmacro and lambda's &aux, &optional, &rest, &keyword
 (defun bind-init (form var)

src/cmp/cmpblock.lsp

@@ -60,8 +60,7 @@
           (wt-nl "cl_object " blk-var ";"))
         (when (env-grows (blk-ref-ccb blk))
           (let ((env-lvl *env-lvl*))
-            (wt-nl "cl_object " *volatile* "env" (incf *env-lvl*)
-                   " = env" env-lvl ";")))
+            (wt-nl "cl_object " *volatile* "env" (incf *env-lvl*) " = env" env-lvl ";")))
         (bind "ECL_NEW_FRAME_ID(cl_env_copy)" blk-var)
         (wt-nl "if (ecl_frs_push(cl_env_copy," blk-var ")!=0) {")
         (let ((*unwind-exit* (cons 'FRAME *unwind-exit*)))
@@ -74,14 +73,14 @@
       (progn
         (setf (blk-exit blk) *exit*)
         (setf (blk-destination blk) *destination*)
-        (c2expr body)))
-  )
+        (c2expr body))))
 
 (defun c1return-from (args)
   (check-args-number 'RETURN-FROM args 1 2)
   (let ((name (first args)))
     (unless (symbolp name)
       (cmperr "The block name ~s is not a symbol." name))
+    ;; XXX: fixme here
     (multiple-value-bind (blk ccb clb unw)
         (cmp-env-search-block name)
       (unless blk
@@ -117,5 +116,4 @@
      (wt-nl "cl_return_from(" (blk-var blk) ",ECL_NIL);"))
     (T (let ((*destination* (blk-destination blk))
              (*exit* (blk-exit blk)))
-         (c2expr val))))
-  )
+         (c2expr val)))))

src/cmp/cmpexit.lsp

@@ -214,12 +214,13 @@
 ;;;        enclosed in a closure, and CATCH),
 
 (defun tail-recursion-possible ()
-  (dolist (ue *unwind-exit* (baboon))
+  (dolist (ue *unwind-exit*
+           (baboon :format-control "tail-recursion-possible: should never return."))
     (cond ((eq ue 'TAIL-RECURSION-MARK) (return t))
           ((or (numberp ue) (eq ue 'BDS-BIND) (eq ue 'FRAME))
            (return nil))
           ((or (consp ue) (eq ue 'JUMP) (eq ue 'IHS-ENV)))
-          (t (baboon)))))
+          (t (baboon :format-control "tail-recursion-possible: unexpected situation.")))))
 
 (defun c2try-tail-recursive-call (fun args)
   (when (and *tail-recursion-info*

src/cmp/cmpform.lsp

@@ -48,7 +48,8 @@
         ((endp l))
       (let ((key (first l)))
         (cond ((not (keywordp key))
-               (baboon))
+               (baboon :format-control "make-c1form*: ~s is not a keyword."
+                       :format-arguments (list key)))
               ((eq key ':args)
                (setf form-args (rest l))
                (return))

src/cmp/cmpglobals.lsp

@@ -24,7 +24,8 @@
 ;;;
 ;;; Empty info struct
 ;;;
-(defvar *info* (make-info))
+;; (defvar *info* (make-info)) ;unused
+
 (defvar *inline-blocks* 0)
 (defvar *opened-c-braces* 0)
 ;;; *inline-blocks* holds the number of C blocks opened for declaring

src/cmp/cmploc.lsp

@@ -162,11 +162,13 @@
             RETURN-DOUBLE-FLOAT RETURN-LONG-FLOAT RETURN-OBJECT)))
 
 (defun wt-lcl (lcl)
-  (unless (numberp lcl) (baboon))
+  (unless (numberp lcl) (baboon :format-control "wt-lcl: ~s NaN"
+                                :format-arguments (list lcl)))
   (wt "v" lcl))
 
 (defun wt-lcl-loc (lcl &optional type name)
-  (unless (numberp lcl) (baboon))
+  (unless (numberp lcl) (baboon :format-control "wt-lcl-loc: ~s NaN"
+                                :format-arguments (list lcl)))
   (wt "v" lcl name))
 
 (defun wt-temp (temp)

src/cmp/cmpspecial.lsp

@@ -97,7 +97,8 @@
     (GLOBAL
      (unwind-exit (list 'FDEFINITION fun)))
     (CLOSURE
-     (baboon)
+     ;; XXX: we have some code after baboon – is CLOSURE legal or not?
+     (baboon :format-control "c2function: c1form is of unexpected kind.")
      (new-local fun)
      (unwind-exit `(MAKE-CCLOSURE ,fun)))))
 
@@ -185,7 +186,7 @@
                (environment-accessor fun)
                ",Cblock)"))
           ((eq closure 'LEXICAL)
-           (baboon))
+           (baboon :format-control "wt-make-closure: lexical closure detected."))
           ((setf narg (fun-fixed-narg fun)) ; empty environment fixed number of args
            (wt "ecl_make_cfun((cl_objectfn_fixed)" cfun ",ECL_NIL,Cblock," narg ")"))
           (t ; empty environment variable number of args

src/cmp/cmpvar.lsp

@@ -235,18 +235,19 @@
                                    :type (or (si:get-sysprop name 'CMP-TYPE) t)))
           ((not (var-p var))
            ;; symbol-macrolet
-           (baboon))
+           (baboon :format-control "c1vref: ~s is not a variable."
+                   :format-arguments (list name)))
           (t
            (case (var-kind var)
              ((SPECIAL GLOBAL))
              ((CLOSURE))
              ((LEXICAL)
               (cond (ccb (setf (var-ref-clb var) nil ; replace a previous 'CLB
-                              (var-ref-ccb var) t
-                              (var-kind var) 'CLOSURE
-                              (var-loc var) 'OBJECT))
-                   (clb (setf (var-ref-clb var) t
-                              (var-loc var) 'OBJECT))))
+                               (var-ref-ccb var) t
+                               (var-kind var) 'CLOSURE
+                               (var-loc var) 'OBJECT))
+                    (clb (setf (var-ref-clb var) t
+                               (var-loc var) 'OBJECT))))
              (t
               (when (or clb ccb)
                 (cmperr "Variable ~A declared of C type cannot be referenced across function boundaries."
@@ -298,7 +299,8 @@
 
 (defun set-var (loc var &aux (var-loc (var-loc var))) ;  ccb
   (unless (var-p var)
-    (baboon))
+    (baboon :format-control "set-var: ~s is not a vairable."
+            :format-arguments (list var)))
   (case (var-kind var)
     (CLOSURE
      (wt-nl)(wt-env var-loc)(wt " = ")