racocs exe: fill in implementation

This commit is contained in:
Matthew Flatt 2018-10-17 12:55:53 -06:00
parent 703deedb66
commit b1dfb61223
4 changed files with 37 additions and 6 deletions

View File

@ -237,6 +237,11 @@
[dll-dir (find-framework fw-name)]) [dll-dir (find-framework fw-name)])
(copy-file* (build-path dll-dir fw-name) (copy-file* (build-path dll-dir fw-name)
(build-path lib-dir fw-name)) (build-path lib-dir fw-name))
(let ([boot-src (build-path dll-dir sub-dir "boot")])
(when (directory-exists? boot-src)
(copy-directory/files*
boot-src
(build-path lib-dir sub-dir "boot"))))
(let ([rsrc-src (build-path dll-dir sub-dir "Resources")]) (let ([rsrc-src (build-path dll-dir sub-dir "Resources")])
(when (directory-exists? rsrc-src) (when (directory-exists? rsrc-src)
(copy-directory/files* (copy-directory/files*

View File

@ -484,7 +484,10 @@
(let ([code (or ready-code (let ([code (or ready-code
(get-module-code just-filename (get-module-code just-filename
#:submodule-path submod-path #:submodule-path submod-path
"compiled" (let ([l (use-compiled-file-paths)])
(if (pair? l)
(car l)
"compiled"))
compiler compiler
(if on-extension (if on-extension
(lambda (f l?) (lambda (f l?)

View File

@ -32,8 +32,8 @@
sha-1)))))] sha-1)))))]
[(equal? tag (char->integer #\D)) [(equal? tag (char->integer #\D))
(unless initial? (unless initial?
(raise-argument-error 'read-compiled-linklet (raise-arguments-error 'read-compiled-linklet
"expected a linklet bundle")) "expected a linklet bundle"))
(read-bundle-directory in start-pos)] (read-bundle-directory in start-pos)]
[else [else
(raise-arguments-error 'read-compiled-linklet (raise-arguments-error 'read-compiled-linklet
@ -69,7 +69,7 @@
(let ([bundle (let ([bundle
(cond (cond
[(equal? '#vu8(35 126) bstr) [(equal? '#vu8(35 126) bstr)
(read-compiled-linklet in)] (read-compiled-linklet-or-directory in #f)]
[(equal? '#vu8(35 102) bstr) [(equal? '#vu8(35 102) bstr)
#f] #f]
[else [else

View File

@ -21,6 +21,7 @@
load load
dynamic-require dynamic-require
namespace-require namespace-require
embedded-load
module-declared? module-declared?
module->language-info module->language-info
module-path-index-join module-path-index-join
@ -283,6 +284,28 @@
(eval (read (open-input-string expr)))) (eval (read (open-input-string expr))))
loads)) loads))
(flags-loop rest-args (see saw 'non-config)))] (flags-loop rest-args (see saw 'non-config)))]
[("-k")
(let*-values ([(n rest-args) (next-arg "starting and ending offsets" arg within-arg args)]
[(m rest-args) (next-arg "first ending offset" arg within-arg (cons "-k" rest-args))]
[(p rest-args) (next-arg "second ending offset" arg within-arg (cons "-k" rest-args))])
(let* ([add-segment-offset
(lambda (s what)
(let ([n (#%string->number s)])
(unless (exact-integer? n)
(raise-user-error 'racket "bad ~a: ~a" what s))
(#%number->string (+ n segment-offset))))]
[n (add-segment-offset n "starting offset")]
[m (add-segment-offset m "first ending offset")]
[p (add-segment-offset p "second ending offset")])
(set! loads
(cons
(lambda ()
;; (register-embedded-load n m)
(embedded-load n m #f #t)
(embedded-load m p #f #f))
loads)))
(no-init! saw)
(flags-loop rest-args (see saw 'non-config)))]
[("-m" "--main") [("-m" "--main")
(set! loads (set! loads
(cons (cons