picrin/tools/mkboot.scm

73 lines
1.7 KiB
Scheme

(import (scheme base)
(scheme read)
(scheme write)
(only (picrin base) compile))
(define (generate-rom)
(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 text
(with-output-to-string
(lambda ()
(write (compile (read))))))
(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)))
(let loop ((lines lines) (acc ""))
(if (null? lines)
acc
(loop (cdr lines) (string-append acc "\"" (car lines) "\",\n")))))
(for-each
(lambda (s) (display s) (newline))
`("#include \"picrin.h\""
"#include \"picrin/extra.h\""
""
"static const char boot_rom[][80] = {"
,(generate-rom)
"};"
""
"#if PIC_USE_LIBRARY"
"static const char boot_library_rom[][80] = {"
,(generate-rom)
"};"
"#endif"
""
"void"
"pic_boot(pic_state *pic)"
"{"
" pic_load_native(pic, &boot_rom[0][0]);"
"#if PIC_USE_LIBRARY"
" pic_load_native(pic, &boot_library_rom[0][0]);"
"#endif"
"}"))