From fa9a985b08b6fa8c2a0ed2fed7e5c011e3b5944e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Fri, 10 Nov 2023 08:54:25 +0100 Subject: [PATCH] cmp: cosmetic changes --- src/cmp/cmpbackend-cxx/cmpc-opt-inl.lsp | 2 +- src/cmp/cmpbackend-cxx/cmpc-util.lsp | 3 ++ src/cmp/cmpbackend-cxx/cmppass2-top.lsp | 44 +++++++++++++------------ src/cmp/cmpvar.lsp | 26 --------------- 4 files changed, 27 insertions(+), 48 deletions(-) diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-inl.lsp index 7174e3613..5dfa12ce5 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-opt-inl.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-opt-inl.lsp @@ -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)))) diff --git a/src/cmp/cmpbackend-cxx/cmpc-util.lsp b/src/cmp/cmpbackend-cxx/cmpc-util.lsp index b976064bd..aeff11dd6 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-util.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-util.lsp @@ -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)) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-top.lsp b/src/cmp/cmpbackend-cxx/cmppass2-top.lsp index 14c555f41..6171f4beb 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-top.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-top.lsp @@ -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 ", ...")) diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp index f7bbfc09a..323bc0d25 100644 --- a/src/cmp/cmpvar.lsp +++ b/src/cmp/cmpvar.lsp @@ -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)