[Wisp-cvs] wisp/modules/format as.wim,1.7,1.8

[<di...@us...>]

Update of /cvsroot/wisp/wisp/modules/format
In directory usw-pr-cvs1:/tmp/cvs-serv28473/modules/format

Modified Files:
	as.wim 
Log Message:
Converted sys.nasm to sys.wth and death.c to death.wth .

Index: as.wim
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/format/as.wim,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- as.wim	26 Aug 2002 16:18:19 -0000	1.7
+++ as.wim	4 Sep 2002 14:26:24 -0000	1.8
@@ -15,6 +15,37 @@
 
 (define basectr (make-counter))
 
+; Note: we don't take double-width into account here.
+; If /seplen/ is an integer, a list of lists is returned; if it is
+; a string, a list of strings is returned.
+(define (wrap-text items (width 72) (seplen 1))
+  (my sep #f
+    (case seplen
+      (string? (set! sep seplen)
+               (set! seplen (string-length sep)))
+      (char? (set! sep seplen)
+             (set! seplen 1)))
+    (collect
+      (lambda (emit)
+        (my emit (if sep
+                   (serial (cut string-join <> sep) emit)
+                   emit)
+          (if (not (null? items))
+            (let ((rcurrent-line (list (car items)))
+                  (column (string-length (car items))))
+              (for-each (lambda (item)
+                          (my new-column (+ column seplen (string-length item))
+                            (if (<= new-column width)
+                              (begin
+                                (cons! rcurrent-line item)
+                                (set! column new-column))
+                              (begin
+                                (emit (reverse rcurrent-line))
+                                (set! rcurrent-line (list item))
+                                (set! column (string-length item))))))
+                        (cdr items))
+              (emit (reverse rcurrent-line)))))))))
+
 ; FIXME: this assumes 32-bit architecture currently
 (define (write-as-code codeblock output-port)
   (my (code labels) codeblock
@@ -30,13 +61,14 @@
         (lambda (item)
           (cond
             ((string? item)
-              (print output-port ".byte ")
-              (print output-port (string-join
-                                   (map (serial char->integer
+              (for-each (lambda (line)
+                          (print output-port
+                                 ".byte $,[line]\n"))
+                        (wrap-text (map (serial char->integer
                                                 integer->string)
                                         (string->list item))
-                                   #\,))
-              (newline output-port))
+                                   (- 72 (string-length ".byte "))
+                                   #\,)))
             ((cons? item)
               (case (car item)
                 ((reltetra)
@@ -58,7 +90,8 @@
       (for-each
         (lambda (labelrec)
           (my (name . delta) labelrec
-            (if (not (eq? name base-name))
+            (if (not (or (eq? name base-name)
+                         (char=? (symbol-ref name 0) #\.)))
               (print output-port
                      ".equiv $[name], $,[base-name] + $,[delta]\n"))))
         labels))))