conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

precompile library.scm

This commit is contained in:
Yuichi Nishiwaki 2017-04-25 22:51:55 +09:00
parent 4ceee54fa7
commit 4618afec94
3 changed files with 20 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -51,7 +51,7 @@ picrin: $(PICRIN_OBJS) $(CONTRIB_OBJS) ext lib/libpicrin.a
$(CC) $(CFLAGS) -o $@ $(PICRIN_OBJS) $(CONTRIB_OBJS) lib/libpicrin.a $(LDFLAGS)
src/init_lib.c: piclib/library.scm
cat piclib/library.scm | bin/picrin-bootstrap tools/mklib.scm > src/init_lib.c
bin/picrin-bootstrap -c lib_rom piclib/library.scm | bin/picrin-bootstrap tools/mklib.scm > src/init_lib.c
src/load_piclib.c: $(CONTRIB_LIBS)
perl tools/mkloader.pl $(CONTRIB_LIBS) > $@

8
lib/serialize.c
View File

@ -80,6 +80,9 @@ dump_obj(pic_state *pic, pic_value obj, pic_value port)
}
dump1(pic, 0x03, port);
dump_irep(pic, proc_ptr(pic, obj)->u.irep, port);
} else if (pic_char_p(pic, obj)) {
dump1(pic, 0x04, port);
dump1(pic, pic_char(pic, obj), port);
} else {
pic_error(pic, "dump: unsupported object", 1, obj);
}
@ -160,7 +163,7 @@ load_obj(pic_state *pic, pic_value port)
{
int type, len;
pic_value obj;
char *buf;
char *buf, c;
struct irep *irep;
struct proc *proc;
type = load1(pic, port);
@ -187,6 +190,9 @@ load_obj(pic_state *pic, pic_value port)
proc->u.irep = irep;
proc->env = NULL;
return obj_value(pic, proc);
case 0x04:
c = load1(pic, port);
return pic_char_value(pic, c);
default:
pic_error(pic, "load: unsupported object", 1, pic_int_value(pic, type));
}

67
tools/mklib.scm
View File

@ -1,64 +1,21 @@
(define (generate-rom)
(define open-output-string open-output-bytevector)
(define (get-output-string port)
(list->string (map integer->char (bytevector->list (get-output-bytevector port)))))
(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 (read)))))
(define (escape-string s)
(with-output-to-string
(lambda ()
(string-for-each
(lambda (c)
(case c
((#\\) (display "\\\\"))
((#\") (display "\\\""))
((#\newline) (display "\\n"))
(else (display 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
display
`("#include \"picrin.h\"\n"
"#include \"picrin/extra.h\"\n"
"\n"
"static const char lib_rom[][80] = {\n"
,(generate-rom)
"};\n"
"\n"
"static "))
(let loop ()
(let ((c (read-u8)))
(unless (eof-object? c)
(write-u8 c)
(loop))))
(for-each
display
`("\n"
"void\n"
"pic_init_lib(pic_state *PIC_UNUSED(pic))\n"
"{\n"
" pic_value port;\n"
" port = pic_fmemopen(pic, &lib_rom[0][0], strlen(&lib_rom[0][0]), \"r\");\n"
" pic_funcall(pic, \"eval\", 1, pic_funcall(pic, \"read\", 1, port));\n"
" pic_call(pic, pic_deserialize(pic, pic_blob_value(pic, lib_rom, sizeof lib_rom)), 0);\n"
"}\n"))