Local variables are now created with the name of the lisp variable they come from

This commit is contained in:
Juan Jose Garcia Ripoll 2012-12-08 00:35:04 +01:00
parent c9f47f2090
commit fcf8bc3d72
6 changed files with 19 additions and 16 deletions

View file

@ -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))

View file

@ -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)

View file

@ -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))

View file

@ -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*)))

View file

@ -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))

View file

@ -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 ")"))