suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

don't use stdout for cstartup generation

Browse Source 
svn: r17772
This commit is contained in:
Kevin Tew 2010-01-22 21:17:21 +00:00
parent 3e4221b410
commit e0fff18e68
2 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/mzscheme/Makefile.in
View File

@ -221,8 +221,7 @@ $(collectsdir)/scheme/private/kernstruct.ss: $(srcdir)/src/makeexn
$(srcdir)/src/$(CSTARTUPDEST): $(srcdir)/src/startup.ss $(srcdir)/src/schvers.h $(srcdir)/src/schminc.h
./mzscheme@CGC@ -cqu $(srcdir)/src/sstoinc.ss $(CSTARTUPEXTRA) < $(srcdir)/src/startup.ss > $(srcdir)/src/$(CSTARTUPDEST)
./mzscheme@CGC@ -cqu $(srcdir)/src/sstoinc.ss $(CSTARTUPEXTRA) $(srcdir)/src/$(CSTARTUPDEST) < $(srcdir)/src/startup.ss
$(srcdir)/src/mzmark.c: $(srcdir)/src/mzmarksrc.c $(srcdir)/src/mkmark.ss
mzscheme -cu $(srcdir)/src/mkmark.ss < $(srcdir)/src/mzmarksrc.c > $(srcdir)/src/mzmark.c

15
src/mzscheme/src/sstoinc.ss
View File

@ -7,6 +7,9 @@
(namespace-require ''#%kernel)
(call-with-output-file (vector-ref (current-command-line-arguments) 0) #:exists 'replace
(lambda (outfile)
(let loop ()
(let ([expr (read)])
(unless (eof-object? expr)
@ -14,17 +17,17 @@
[p (open-output-bytes)])
(write c p)
(let ([s (get-output-bytes p)])
(printf " {~n SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {")
(fprintf outfile " {~n SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {")
(let loop ([chars (bytes->list s)][pos 0])
(unless (null? chars)
(let ([char (car chars)])
(printf "~a," char))
(fprintf outfile "~a," char))
(loop (cdr chars)
(if (= pos DIGS-PER-LINE)
(begin
(newline)
(newline outfile)
0)
(add1 pos)))))
(printf "0};~n EVAL_ONE_SIZED_STR((char *)expr, ~a);~n" (bytes-length s))
(printf " }~n")))
(loop))))
(fprintf outfile "0};~n EVAL_ONE_SIZED_STR((char *)expr, ~a);~n" (bytes-length s))
(fprintf outfile " }~n")))
(loop))))))