mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 23:32:17 -08:00
Code Issues Projects Releases Packages Wiki Activity

cmp: cosmetic changes

Browse source
This commit is contained in:
Daniel Kochmański 2023-11-10 08:54:25 +01:00
parent be68897012
commit fa9a985b08
4 changed files with 27 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/cmp/cmpbackend-cxx/cmpc-opt-inl.lsp
View file

@ -51,7 +51,7 @@
(let ((var (c1form-arg 0 form))
(value-type (c1form-primary-type form)))
(if (var-changed-in-form-list var rest-forms)
(let* ((temp (make-inline-temp-var value-type (var-rep-type var))))
(let ((temp (make-inline-temp-var value-type (var-rep-type var))))
(let ((*destination* temp)) (set-loc var))
(list value-type temp))
(list value-type var))))

3
src/cmp/cmpbackend-cxx/cmpc-util.lsp
View file

@ -149,6 +149,9 @@
(let ((code (incf *next-cfun*)))
(format nil prefix code (lisp-to-c-name lisp-name))))
;;; (CAR label) is a an unique id of the label in the compilation unit.
;;; (CDR label) is a flag signaling whether the label is referenced.
(defun next-label ()
(cons (incf *last-label*) nil))

44
src/cmp/cmpbackend-cxx/cmppass2-top.lsp
View file

@ -114,7 +114,7 @@
(wt-nl-h "#define ECL_DEFINE_SETF_FUNCTIONS ")
(loop for (name setf-vv name-vv) in *setf-definitions*
do (wt-h #\\ #\Newline setf-vv "=ecl_setf_definition(" name-vv ",ECL_T);"))
do (wt-h #\\ #\Newline setf-vv "=ecl_setf_definition(" name-vv ",ECL_T);"))
(wt-nl-h "#ifdef __cplusplus")
(wt-nl-h "}")
@ -226,21 +226,24 @@
(defun t2load-time-value (c1form vv-loc form)
(declare (ignore c1form))
(let* ((*exit* (next-label)) (*unwind-exit* (list *exit*))
(let* ((*exit* (next-label))
(*unwind-exit* (list *exit*))
(*destination* vv-loc))
(c2expr form)
(wt-label *exit*)))
(defun t2make-form (c1form vv-loc form)
(declare (ignore c1form))
(let* ((*exit* (next-label)) (*unwind-exit* (list *exit*))
(let* ((*exit* (next-label))
(*unwind-exit* (list *exit*))
(*destination* vv-loc))
(c2expr form)
(wt-label *exit*)))
(defun t2init-form (c1form vv-loc form)
(declare (ignore c1form vv-loc))
(let* ((*exit* (next-label)) (*unwind-exit* (list *exit*))
(let* ((*exit* (next-label))
(*unwind-exit* (list *exit*))
(*destination* 'TRASH))
(c2expr form)
(wt-label *exit*)))
@ -265,21 +268,20 @@
#-:msvc ;; FIXME! Problem with initialization of statically defined vectors
(let* ((filtered-locations '())
(filtered-codes '()))
;; Filter out variables that we know how to store in the
;; debug information table. This excludes among other things
;; closures and special variables.
;; Filter out variables that we know how to store in the debug information
;; table. This excludes among other things closures and special variables.
(loop for var in var-locations
for name = (let ((*package* (find-package "KEYWORD")))
(format nil "\"~S\"" (var-name var)))
for code = (locative-type-from-var-kind (var-kind var))
for loc = (var-loc var)
when (and code (consp loc) (eq (first loc) 'LCL))
do (progn
(push (cons name code) filtered-codes)
(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.
do (progn
(push (cons name code) filtered-codes)
(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.
(when filtered-codes
(setf *ihs-used-p* t)
(wt-nl "static const struct ecl_var_debug_info _ecl_descriptors[]={")
@ -345,8 +347,8 @@
(defun t3local-fun-body (fun)
(let ((string (make-array 2048 :element-type 'character
:adjustable t
:fill-pointer 0)))
:adjustable t
:fill-pointer 0)))
(with-output-to-string (*compiler-output1* string)
(let ((lambda-expr (fun-lambda fun)))
(c2lambda-expr (c1form-arg 0 lambda-expr)
@ -375,9 +377,9 @@
(volatile (c1form-volatile* lambda-expr))
(lambda-list (c1form-arg 0 lambda-expr))
(requireds (loop
repeat si::c-arguments-limit
for arg in (car lambda-list)
collect (next-lcl (var-name arg))))
repeat si::c-arguments-limit
for arg in (car lambda-list)
collect (next-lcl (var-name arg))))
(narg (fun-needs-narg fun)))
(let ((cmp-env (c1form-env lambda-expr)))
(wt-comment-nl "optimize speed ~D, debug ~D, space ~D, safety ~D "
@ -401,9 +403,9 @@
(wt comma "volatile cl_object *lex" n)
(setf comma ", "))
(loop for lcl in (setf (fun-required-lcls fun) requireds)
do (wt-h comma "cl_object " volatile)
(wt comma "cl_object " volatile lcl)
(setf comma ", "))
do (wt-h comma "cl_object " volatile)
(wt comma "cl_object " volatile lcl)
(setf comma ", "))
(when narg
(wt-h ", ...")
(wt ", ..."))

26
src/cmp/cmpvar.lsp
View file

@ -27,22 +27,6 @@
(baboon :format-control "In REPLACEABLE, variable ~A not found. Form:~%~A"
:format-arguments (list (var-name var) *current-form*))))
#+not-used
(defun discarded (var form body &aux last)
(labels ((last-form (x &aux (args (c1form-args x)))
(case (c1form-name x)
(PROGN
(last-form (car (last (first args)))))
((LET LET* FLET LABELS BLOCK CATCH)
(last-form (car (last args))))
(VARIABLE (c1form-arg 0 x))
(t x))))
(and (not (c1form-side-effects form))
(or (< (var-ref var) 1)
(and (= (var-ref var) 1)
(eq var (last-form body))
(eq 'TRASH *destination*))))))
(defun nsubst-var (var form)
(when (var-set-nodes var)
(baboon :format-control "Cannot replace a variable that is to be changed"))
@ -56,16 +40,6 @@
(c1form-replace-with where form))
(setf (var-ignorable var) 0))
#+not-used
(defun member-var (var list)
(let ((kind (var-kind var)))
(if (member kind '(SPECIAL GLOBAL))
(member var list :test
#'(lambda (v1 v2)
(and (member (var-kind v2) '(SPECIAL GLOBAL))
(eql (var-name v1) (var-name v2)))))
(member var list))))
;;;
(defun make-var (&rest args)