andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

mescc: Fix dumping of strings > M1_STRING_MAX. 

* module/mes/M1.mes (object->M1): Skip opening quote.
This commit is contained in:
Jan Nieuwenhuizen 2018-05-02 15:53:37 +02:00
parent 6d3fee91b9
commit f8eaebf713
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
1 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
module/mes/M1.mes
View File

@ -158,20 +158,26 @@
(string-append "&" label))))))
(let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
(string->label (car o))))
(string? (string-prefix? "_string" label))
(foo (if (not (eq? (car (string->list label)) #\_))
(display (string-append " :" label "\n") (current-error-port))))
(data (cdr o))
(data (filter-map labelize data))
(len (length data))
(string-max (or (and=> (getenv "M1_STRING_MAX") string->number) 80)))
(string-max (or (and=> (getenv "M1_STRING_MAX") string->number) 256))
(string-data (and string? (list-head data (1- (length data))))))
(display (string-append "\n:" label "\n"))
(cond ((and (< len string-max)
(char? (car data))
(eq? (last data) #\nul)
(not (find (cut memq <> '(#\nul #\backspace #\return #\" #\')) (list-head data (1- (length data)))))
(not (any (lambda (ch) (>= (char->integer ch) #x80)) data)))
(display (string-append "\"" (list->string (list-head data (1- (length data)))) "\"")))
(else (display-join (map text->M1 data) " ")))
(if (and string-data
(< len string-max)
(char? (car data))
(eq? (last data) #\nul)
(not (find (cut memq <> '(#\")) string-data))
(not (any (lambda (ch)
(or (and (not (memq ch '(#\tab #\newline)))
(< (char->integer ch) #x20))
(>= (char->integer ch) #x80))) string-data)))
(display (string-append "\"" (list->string string-data) "\""))
(display-join (map text->M1 data) " "))
(newline)))
(display "M1: functions\n" (current-error-port))
(for-each write-function (filter cdr functions))