Simplify naming; guarantee that nonces are present in all exported
authorChris Hanson <org/chris-hanson/cph>
Mon, 14 May 2007 16:49:16 +0000 (16:49 +0000)
committerChris Hanson <org/chris-hanson/cph>
Mon, 14 May 2007 16:49:16 +0000 (16:49 +0000)
symbols.

v7/src/compiler/machines/C/compiler.pkg
v7/src/compiler/machines/C/cout.scm

index d7ae693ada88fb13a5c8091343336db2b34abc07..1cfdd036bcaf5e4d4ee7a68517a2472035e5c2f1 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.26 2007/05/09 02:05:44 cph Exp $
+$Id: compiler.pkg,v 1.27 2007/05/14 16:49:15 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -696,8 +696,6 @@ USA.
         "machines/C/stackops"          ;denser object construction
         )
   (parent (compiler))
-  (export ()
-         *C-procedure-name*)
   (export (compiler)
          available-machine-registers
          lap-generator/match-rtl-instruction
index aed8c967afcb6debdd8c4dd0ba00a24ea24a820a..aa61f2ad079f101e736c7e8b45f4e9fb91b25204 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: cout.scm,v 1.39 2007/04/17 06:02:06 cph Exp $
+$Id: cout.scm,v 1.40 2007/05/14 16:49:16 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -50,7 +50,6 @@ USA.
 \f
 (define *use-stackify?* #t)
 (define *disable-nonces?* #f)
-(define *C-procedure-name* 'DEFAULT)
 
 (define *subblocks*)                   ;referenced by stackify
 
@@ -116,40 +115,29 @@ USA.
   ;; returns <code-name data-name ntags symbol-table code proxy>
   (let ((top-level? (string-null? suffix)))
 
-    (define (canonicalize-name name full?)
-      (if full?
-         (canonicalize-label-name name)
-         (C-quotify-string name)))
-
     (define (gen-code-name nonce)
-      (choose-name #t "code" "" nonce))
+      (choose-name #f "code" "" nonce))
 
     (define (gen-data-name nonce)
-      (choose-name #t "data" "_data" nonce))
+      (choose-name #f "data" "_data" nonce))
 
     (define (gen-handle-name nonce)
-      (choose-name #f "" "" nonce))
-
-    (define (choose-name full? default midfix nonce)
-      (cond ((not *C-procedure-name*)
-            (string-append default suffix "_" nonce))
-           ((not (eq? *C-procedure-name* 'DEFAULT))
-            (string-append *C-procedure-name*
-                           midfix
-                           suffix))
-           ((not info-output-pathname)
-            (string-append default suffix "_" nonce))
-           ((or top-level? *disable-nonces?*)
-            (string-append (canonicalize-name (default-file-handle) full?)
-                           midfix
-                           suffix))
-           (else
-            (string-append (canonicalize-name (default-file-handle) full?)
-                           "_"
-                           default
-                           suffix
-                           "_"
-                           nonce))))
+      (choose-name #t "" "" nonce))
+
+    (define (choose-name handle? default midfix nonce)
+      (let ((nsuffix
+            (if (or *disable-nonces?* (and handle? top-level?))
+                ""
+                (string-append "_" nonce))))
+       (if info-output-pathname
+           (string-append (let ((name (default-file-handle)))
+                            (if handle?
+                                (C-quotify-string name)
+                                (canonicalize-label-name name)))
+                          (if top-level?
+                              (string-append midfix nsuffix)
+                              (string-append "_" default suffix)))
+           (string-append default suffix nsuffix))))
 
     (define (subroutine-information)
       (let*/mv (((decls-1 code-1) (subroutine-information-1))