picrin/tools/mkboot.scm

69 lines
1.6 KiB
Scheme
Raw Normal View History

2017-03-28 19:20:02 -04:00
(import (scheme base)
(scheme read)
(scheme write))
2017-03-23 09:47:55 -04:00
(define (with-output-to-string thunk)
(let ((port (open-output-string)))
(parameterize ((current-output-port port))
(thunk)
(let ((s (get-output-string port)))
(close-port port)
s))))
(define exprs
(let loop ((acc '()))
(let ((e (read)))
(if (eof-object? e)
(reverse acc)
(loop (cons e acc))))))
(define text
(with-output-to-string
(lambda ()
(for-each
(lambda (e)
(write e)
(write-string " "))
exprs))))
(define (escape-string s)
(with-output-to-string
(lambda ()
(string-for-each
(lambda (c)
(case c
((#\\) (write-string "\\\\"))
((#\") (write-string "\\\""))
((#\newline) (write-string "\\n"))
(else (write-char c))))
s))))
(define (group-string i s)
(let loop ((t s) (n (string-length s)) (acc '()))
(if (= n 0)
(reverse acc)
(if (< n i)
(loop "" 0 (cons t acc))
(loop (string-copy t i) (- n i) (cons (string-copy t 0 i) acc))))))
(define lines (map escape-string (group-string 80 text)))
(for-each
(lambda (s) (display s) (newline))
`("#include \"picrin.h\""
"#include \"picrin/extra.h\""
""
"static const char boot_rom[][80] = {"
,@(let loop ((lines lines) (acc '()))
(if (null? lines)
(reverse acc)
(loop (cdr lines) (cons (string-append "\"" (car lines) "\",") acc))))
"};"
""
"void"
"pic_boot(pic_state *pic)"
"{"
" pic_load_cstr(pic, &boot_rom[0][0]);"
"}"))