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))))
|
