From fcf8bc3d72b2426d9cc87eeceafb29f3add542d9 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Sat, 8 Dec 2012 00:35:04 +0100
Subject: [PATCH] Local variables are now created with the name of the lisp
 variable they come from

---
 src/cmp/cmplam.lsp |  2 +-
 src/cmp/cmplet.lsp |  8 +++-----
 src/cmp/cmploc.lsp | 11 ++++++-----
 src/cmp/cmpmac.lsp |  6 +++++-
 src/cmp/cmptop.lsp |  4 ++--
 src/cmp/cmpvar.lsp |  4 ++--
 6 files changed, 19 insertions(+), 16 deletions(-)

diff --git a/src/cmp/cmplam.lsp b/src/cmp/cmplam.lsp
index 40ce99494..535b23acf 100644
--- a/src/cmp/cmplam.lsp
+++ b/src/cmp/cmplam.lsp
@@ -375,7 +375,7 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts."
   ;; The bind step later will assign to such variable.
   (let ((required-lcls (mapcar #'(lambda (x) (next-lcl)) requireds)))
     (labels ((wt-decl (var)
-	       (let ((lcl (next-lcl)))
+	       (let ((lcl (next-lcl (var-name var))))
 		 (wt-nl)
 		 (wt *volatile* (rep-type-name (var-rep-type var)) " " lcl ";")
 		 lcl))
diff --git a/src/cmp/cmplet.lsp b/src/cmp/cmplet.lsp
index cff9d1a32..3eff51941 100644
--- a/src/cmp/cmplet.lsp
+++ b/src/cmp/cmplet.lsp
@@ -264,12 +264,10 @@
   ;; Emit C definitions of local variables
   (loop for var in vars
      for kind = (local var)
-     when kind
-     do (progn
+     do (when kind
 	  (maybe-open-inline-block)
-	  (bind (next-lcl) var)
-	  (wt-nl *volatile* (rep-type-name kind) " " var ";")
-	  (wt-comment (var-name var))))
+	  (bind (next-lcl (var-name var)) var)
+	  (wt-nl *volatile* (rep-type-name kind) " " var ";")))
 
   ;; Create closure bindings for closed-over variables
   (when (some #'var-ref-ccb vars)
diff --git a/src/cmp/cmploc.lsp b/src/cmp/cmploc.lsp
index a7de41b6e..74504f3b2 100644
--- a/src/cmp/cmploc.lsp
+++ b/src/cmp/cmploc.lsp
@@ -159,12 +159,13 @@
           '(RETURN RETURN-FIXNUM RETURN-CHARACTER RETURN-SINGLE-FLOAT
             RETURN-DOUBLE-FLOAT RETURN-LONG-FLOAT RETURN-OBJECT)))
 
-(defun lcl-name (lcl) (format nil "V~D" lcl))
+(defun wt-lcl (lcl)
+  (unless (numberp lcl) (baboon))
+  (wt "V" lcl))
 
-(defun wt-lcl (lcl) (unless (numberp lcl) (baboon)) (wt "V" lcl))
-
-(defun wt-lcl-loc (lcl &optional type)
-  (wt-lcl lcl))
+(defun wt-lcl-loc (lcl &optional type name)
+  (unless (numberp lcl) (baboon))
+  (wt "V" lcl name))
 
 (defun wt-temp (temp)
   (wt "T" temp))
diff --git a/src/cmp/cmpmac.lsp b/src/cmp/cmpmac.lsp
index 0559f7cdd..abfc43ec9 100644
--- a/src/cmp/cmpmac.lsp
+++ b/src/cmp/cmpmac.lsp
@@ -91,7 +91,11 @@
      ,@body
      (maybe-wt-label ,label)))
 
-(defun next-lcl () (list 'LCL (incf *lcl*)))
+(defun next-lcl (&optional name)
+  (list 'LCL (incf *lcl*) T
+	(if (and name (symbol-package name))
+	    (lisp-to-c-name name)
+	    "")))
 
 (defun next-cfun (&optional (prefix "L~D~A") (lisp-name nil))
   (let ((code (incf *next-cfun*)))
diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp
index 03504e320..13cfcd901 100644
--- a/src/cmp/cmptop.lsp
+++ b/src/cmp/cmptop.lsp
@@ -618,7 +618,7 @@
           when (and code (consp loc) (eq (first loc) 'LCL))
           do (progn
                (push (cons name code) filtered-codes)
-               (push (second loc) filtered-locations)))
+               (push loc filtered-locations)))
     ;; Generate two tables, a static one with information about the
     ;; variables, including name and type, and dynamic one, which is
     ;; a vector of pointer to the variables.
@@ -633,7 +633,7 @@
       (wt-nl (if first "(cl_index)(ECL_NIL)," "(cl_index)(_ecl_debug_env),")
              "(cl_index)(_ecl_descriptors)")
       (loop for var-loc in filtered-locations
-            do (wt ",(cl_index)(&" (lcl-name var-loc) ")"))
+            do (wt ",(cl_index)(&" var-loc ")"))
       (wt "};")
       (wt-nl "ecl_def_ct_vector(_ecl_debug_env,ecl_aet_index,_ecl_debug_info_raw,"
              (+ 2 (length filtered-locations))
diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp
index f51ca9e9b..e33c1ddce 100644
--- a/src/cmp/cmpvar.lsp
+++ b/src/cmp/cmpvar.lsp
@@ -311,8 +311,8 @@
 
 (defun wt-lex (lex)
   (if (consp lex)
-    (wt "lex" (car lex) "[" (cdr lex) "]")
-    (wt-lcl lex)))
+      (wt "lex" (car lex) "[" (cdr lex) "]")
+      (wt-lcl lex)))
 
 ;;; reference to variable of inner closure.
 (defun wt-env (clv) (wt "ECL_CONS_CAR(CLV" clv ")"))