mirror of
https://github.com/janet-lang/janet
synced 2025-02-23 03:30:02 +00:00
Use dedent in jpm create-executable.
This commit is contained in:
parent
ce7d51f9be
commit
0fe5c672a6
130
jpm
130
jpm
@ -434,68 +434,11 @@
|
|||||||
[path]
|
[path]
|
||||||
(string (string/slice path 0 (- -1 (length modext))) statext))
|
(string (string/slice path 0 (- -1 (length modext))) statext))
|
||||||
|
|
||||||
(defn- create-executable
|
(defn- make-bin-source
|
||||||
"Links an image with libjanet.a (or .lib) to produce an
|
[declarations lookup-into-invocations]
|
||||||
executable. Also will try to link native modules into the
|
(dedent
|
||||||
final executable as well."
|
```
|
||||||
[opts source dest]
|
```
|
||||||
|
|
||||||
# Create executable's janet image
|
|
||||||
(def cimage_dest (string dest ".c"))
|
|
||||||
(rule dest [source]
|
|
||||||
(check-cc)
|
|
||||||
(print "generating executable c source...")
|
|
||||||
(create-dirs dest)
|
|
||||||
# Load entry environment and get main function.
|
|
||||||
(def entry-env (dofile source))
|
|
||||||
(def main ((entry-env 'main) :value))
|
|
||||||
(def dep-lflags @[])
|
|
||||||
|
|
||||||
# Create marshalling dictionary
|
|
||||||
(def mdict (invert (env-lookup root-env)))
|
|
||||||
# Load all native modules
|
|
||||||
(def prefixes @{})
|
|
||||||
(def static-libs @[])
|
|
||||||
(loop [[name m] :pairs module/cache
|
|
||||||
:let [n (m :native)]
|
|
||||||
:when n
|
|
||||||
:let [prefix (gensym)]]
|
|
||||||
(print "found native " n "...")
|
|
||||||
(put prefixes prefix n)
|
|
||||||
(array/push static-libs (modpath-to-static n))
|
|
||||||
(def oldproto (table/getproto m))
|
|
||||||
(table/setproto m nil)
|
|
||||||
(loop [[sym value] :pairs (env-lookup m)]
|
|
||||||
(put mdict value (symbol prefix sym)))
|
|
||||||
(table/setproto m oldproto))
|
|
||||||
|
|
||||||
# Find static modules
|
|
||||||
(def declarations @"")
|
|
||||||
(def lookup-into-invocations @"")
|
|
||||||
(loop [[prefix name] :pairs prefixes]
|
|
||||||
(def meta (eval-string (slurp (modpath-to-meta name))))
|
|
||||||
(buffer/push-string lookup-into-invocations
|
|
||||||
" temptab = janet_table(0);\n"
|
|
||||||
" temptab->proto = env;\n"
|
|
||||||
" " (meta :static-entry) "(temptab);\n"
|
|
||||||
" janet_env_lookup_into(lookup, temptab, \""
|
|
||||||
prefix
|
|
||||||
"\", 0);\n\n")
|
|
||||||
(when-let [lfs (meta :lflags)]
|
|
||||||
(array/concat dep-lflags lfs))
|
|
||||||
(buffer/push-string declarations
|
|
||||||
"extern void "
|
|
||||||
(meta :static-entry)
|
|
||||||
"(JanetTable *);\n"))
|
|
||||||
|
|
||||||
|
|
||||||
# Build image
|
|
||||||
(def image (marshal main mdict))
|
|
||||||
# Make image byte buffer
|
|
||||||
(create-buffer-c-impl image cimage_dest "janet_payload_image")
|
|
||||||
# Append main function
|
|
||||||
(spit cimage_dest (string
|
|
||||||
"\n"
|
|
||||||
declarations
|
declarations
|
||||||
```
|
```
|
||||||
|
|
||||||
@ -560,8 +503,69 @@ int main(int argc, const char **argv) {
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
```) :ab)
|
```))
|
||||||
|
|
||||||
|
(defn- create-executable
|
||||||
|
"Links an image with libjanet.a (or .lib) to produce an
|
||||||
|
executable. Also will try to link native modules into the
|
||||||
|
final executable as well."
|
||||||
|
[opts source dest]
|
||||||
|
|
||||||
|
# Create executable's janet image
|
||||||
|
(def cimage_dest (string dest ".c"))
|
||||||
|
(rule dest [source]
|
||||||
|
(check-cc)
|
||||||
|
(print "generating executable c source...")
|
||||||
|
(create-dirs dest)
|
||||||
|
# Load entry environment and get main function.
|
||||||
|
(def entry-env (dofile source))
|
||||||
|
(def main ((entry-env 'main) :value))
|
||||||
|
(def dep-lflags @[])
|
||||||
|
|
||||||
|
# Create marshalling dictionary
|
||||||
|
(def mdict (invert (env-lookup root-env)))
|
||||||
|
# Load all native modules
|
||||||
|
(def prefixes @{})
|
||||||
|
(def static-libs @[])
|
||||||
|
(loop [[name m] :pairs module/cache
|
||||||
|
:let [n (m :native)]
|
||||||
|
:when n
|
||||||
|
:let [prefix (gensym)]]
|
||||||
|
(print "found native " n "...")
|
||||||
|
(put prefixes prefix n)
|
||||||
|
(array/push static-libs (modpath-to-static n))
|
||||||
|
(def oldproto (table/getproto m))
|
||||||
|
(table/setproto m nil)
|
||||||
|
(loop [[sym value] :pairs (env-lookup m)]
|
||||||
|
(put mdict value (symbol prefix sym)))
|
||||||
|
(table/setproto m oldproto))
|
||||||
|
|
||||||
|
# Find static modules
|
||||||
|
(def declarations @"")
|
||||||
|
(def lookup-into-invocations @"")
|
||||||
|
(loop [[prefix name] :pairs prefixes]
|
||||||
|
(def meta (eval-string (slurp (modpath-to-meta name))))
|
||||||
|
(buffer/push-string lookup-into-invocations
|
||||||
|
" temptab = janet_table(0);\n"
|
||||||
|
" temptab->proto = env;\n"
|
||||||
|
" " (meta :static-entry) "(temptab);\n"
|
||||||
|
" janet_env_lookup_into(lookup, temptab, \""
|
||||||
|
prefix
|
||||||
|
"\", 0);\n\n")
|
||||||
|
(when-let [lfs (meta :lflags)]
|
||||||
|
(array/concat dep-lflags lfs))
|
||||||
|
(buffer/push-string declarations
|
||||||
|
"extern void "
|
||||||
|
(meta :static-entry)
|
||||||
|
"(JanetTable *);\n"))
|
||||||
|
|
||||||
|
|
||||||
|
# Build image
|
||||||
|
(def image (marshal main mdict))
|
||||||
|
# Make image byte buffer
|
||||||
|
(create-buffer-c-impl image cimage_dest "janet_payload_image")
|
||||||
|
# Append main function
|
||||||
|
(spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab)
|
||||||
# Compile and link final exectable
|
# Compile and link final exectable
|
||||||
(do
|
(do
|
||||||
(def extra-lflags (case (os/which)
|
(def extra-lflags (case (os/which)
|
||||||
|
Loading…
x
Reference in New Issue
Block a user