203 |
(let ((new (copy-seq str))) |
(let ((new (copy-seq str))) |
204 |
(dash-to-underscore-int new 0 (length new)))) |
(dash-to-underscore-int new 0 (length new)))) |
205 |
|
|
206 |
|
(defun init-name (p &optional sp (gp t) (dc t) (nt t)) |
207 |
|
|
208 |
|
(cond ((not sp) "code") |
209 |
|
((not (pathnamep p)) (init-name (pathname p) sp gp dc nt)) |
210 |
|
((not (string= (pathname-type p) "o")) |
211 |
|
(init-name (merge-pathnames (make-pathname :type "o") p) sp gp dc nt)) |
212 |
|
#-aosvs(dc (string-downcase (init-name p sp gp nil nt))) |
213 |
|
(gp (init-name (truename p) sp nil dc nt)) |
214 |
|
((and nt |
215 |
|
(let* ((pn (pathname-name p)) |
216 |
|
(pp (make-pathname :name pn))) |
217 |
|
(and (not (equal pp p)) |
218 |
|
(eql 4 (string<= "gcl_" pn)) |
219 |
|
(init-name pp sp gp dc nil))))) |
220 |
|
((dash-to-underscore (namestring p))))) |
221 |
|
|
222 |
;; FIXME consider making this a macro |
;; FIXME consider making this a macro |
223 |
(defun c-function-name (prefix num fname) |
(defun c-function-name (prefix num fname) |
224 |
(let ((fname (string fname))) |
#-gprof(declare (ignore fname)) |
225 |
(si::string-concatenate |
(si::string-concatenate |
226 |
(string prefix) |
(string prefix) |
227 |
(write-to-string num) |
(write-to-string num) |
228 |
#+gprof(si::string-concatenate |
#+gprof(let ((fname (string fname))) |
229 |
|
(si::string-concatenate |
230 |
"__" |
"__" |
231 |
(dash-to-underscore fname) |
(dash-to-underscore fname) |
232 |
"__" |
"__" |
233 |
(if *compiler-input* |
(if (boundp '*compiler-input*) |
234 |
(dash-to-underscore (namestring *compiler-input*)) |
(subseq (init-name *compiler-input* t) 4) |
235 |
""))))) |
""))))) |
236 |
|
|
237 |
(defun t1expr (form &aux (*current-form* form) (*first-error* t)) |
(defun t1expr (form &aux (*current-form* form) (*first-error* t)) |