mirror of
https://github.com/janet-lang/janet
synced 2025-10-28 22:27:41 +00:00
Compare commits
699 Commits
repl-compl
...
windows-ev
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
964a800d51 | ||
|
|
2e944931b3 | ||
|
|
db67538311 | ||
|
|
307c7e00e2 | ||
|
|
45feb55483 | ||
|
|
0a1d902f46 | ||
|
|
959a577b5f | ||
|
|
b91fe8be5a | ||
|
|
d1f0a13ddc | ||
|
|
c455bdad11 | ||
|
|
bc1ef813c2 | ||
|
|
603791c0ba | ||
|
|
8091b1289f | ||
|
|
cc0035b1d7 | ||
|
|
ceba1ba4ee | ||
|
|
468e13501c | ||
|
|
32bf70571a | ||
|
|
95f4bd8e23 | ||
|
|
4c9624db64 | ||
|
|
2cbf4d8ad1 | ||
|
|
524c9b50d4 | ||
|
|
d3147b661b | ||
|
|
d3182dce51 | ||
|
|
8763df1cd0 | ||
|
|
15e05b692c | ||
|
|
2bf5e341d3 | ||
|
|
b53890ddae | ||
|
|
93602ad9ea | ||
|
|
191d0001f4 | ||
|
|
1a04ce33f1 | ||
|
|
babfe50550 | ||
|
|
ff57b3eb72 | ||
|
|
1837e89fe4 | ||
|
|
24b8b0e382 | ||
|
|
321a758ab9 | ||
|
|
1a9c14acde | ||
|
|
e8734c77b4 | ||
|
|
1eb00a9f74 | ||
|
|
922a21d359 | ||
|
|
4a4f314768 | ||
|
|
3c64596ea1 | ||
|
|
33283b1b6e | ||
|
|
2f89bdc672 | ||
|
|
2d275c4782 | ||
|
|
25156eb83e | ||
|
|
39032b45c9 | ||
|
|
821a8dca3b | ||
|
|
0145b133a1 | ||
|
|
b0b137d7f0 | ||
|
|
b0c09153c2 | ||
|
|
0485078c6c | ||
|
|
7079cc43c9 | ||
|
|
e7fca0051e | ||
|
|
6273e56886 | ||
|
|
8b9ad2dce8 | ||
|
|
301cbb0e68 | ||
|
|
5313963baf | ||
|
|
f60348eee4 | ||
|
|
a31e079f93 | ||
|
|
556edc9f0d | ||
|
|
17d0b7a985 | ||
|
|
86e00e865e | ||
|
|
5dda83dc73 | ||
|
|
28439d822a | ||
|
|
b1d8ee19ca | ||
|
|
f7c556ed8d | ||
|
|
5377e10532 | ||
|
|
30522bbf7d | ||
|
|
58374623b7 | ||
|
|
7e7498350f | ||
|
|
06c268c274 | ||
|
|
9b36e2b145 | ||
|
|
ca75f8dc20 | ||
|
|
6f2f3fdb68 | ||
|
|
c903e49a4f | ||
|
|
9121feb44f | ||
|
|
7b42ed66f2 | ||
|
|
fb26c9b2c4 | ||
|
|
78ffb63429 | ||
|
|
1213990b7d | ||
|
|
c3af30d520 | ||
|
|
2598123140 | ||
|
|
40627191f3 | ||
|
|
38dc844e85 | ||
|
|
abc4405a76 | ||
|
|
243c66442d | ||
|
|
9afcec77f6 | ||
|
|
70ad98cc6f | ||
|
|
76cfbde933 | ||
|
|
f200bd9594 | ||
|
|
4d4ca7bb36 | ||
|
|
78c3c6dafa | ||
|
|
6d859dec67 | ||
|
|
3563e7e1aa | ||
|
|
cb898fabf4 | ||
|
|
5899671d96 | ||
|
|
8c1eb23aa1 | ||
|
|
b564087db0 | ||
|
|
1748e8510e | ||
|
|
742c5bb639 | ||
|
|
297de01d95 | ||
|
|
fb31c3b46d | ||
|
|
ba2beffcd8 | ||
|
|
2eb2dddb59 | ||
|
|
0601d851d0 | ||
|
|
b731f6ab03 | ||
|
|
0403e306ed | ||
|
|
d393fbf360 | ||
|
|
4cc680965c | ||
|
|
ba08e487cb | ||
|
|
d37eda4e9b | ||
|
|
3960d0f6de | ||
|
|
5be5e5b58f | ||
|
|
04ac9b8e32 | ||
|
|
409a8a3a43 | ||
|
|
1ba3f72e4c | ||
|
|
3e5e9e57e9 | ||
|
|
02e5e49de2 | ||
|
|
43438d3824 | ||
|
|
8f82d19fd1 | ||
|
|
ee450bcd77 | ||
|
|
553b4d9428 | ||
|
|
df145f4bc9 | ||
|
|
fa55283f62 | ||
|
|
9e163db491 | ||
|
|
286230f477 | ||
|
|
3ba2c7e7e8 | ||
|
|
b4f5e5bc00 | ||
|
|
f580d2e41a | ||
|
|
cd197e8be3 | ||
|
|
51cf6465ff | ||
|
|
a1feb32a2f | ||
|
|
7478ad115f | ||
|
|
9d8e338a11 | ||
|
|
ed4163cfde | ||
|
|
bd95f742c0 | ||
|
|
463e6d9316 | ||
|
|
3358811788 | ||
|
|
a45509d28e | ||
|
|
9ba94d2c6b | ||
|
|
a4de83b3a3 | ||
|
|
68a12d1d17 | ||
|
|
c97d3cf359 | ||
|
|
4721337c7c | ||
|
|
2b36ed967c | ||
|
|
3bb8f1ac8d | ||
|
|
617ec7f565 | ||
|
|
dc259b9f8e | ||
|
|
7b31a87b3c | ||
|
|
37a430c97c | ||
|
|
f264cb0b18 | ||
|
|
6ea530cc48 | ||
|
|
a0abf307b4 | ||
|
|
55cf9f5e1c | ||
|
|
b89f0fac7b | ||
|
|
8b3b3182bd | ||
|
|
97c64f27ff | ||
|
|
e548e1f6e0 | ||
|
|
7ea1c7d85a | ||
|
|
e08235b575 | ||
|
|
783c672130 | ||
|
|
5351a6b2ed | ||
|
|
a110b103e8 | ||
|
|
c26f573620 | ||
|
|
f06e9ae30c | ||
|
|
f5d208d5d6 | ||
|
|
7fb8c4a68d | ||
|
|
647fc56d47 | ||
|
|
597d84e263 | ||
|
|
977b0c3c0c | ||
|
|
1b0d6de735 | ||
|
|
2f5bb7774e | ||
|
|
5565f02dbd | ||
|
|
17a131ac21 | ||
|
|
9a5cfe9f75 | ||
|
|
cc936d9977 | ||
|
|
e9911fee4d | ||
|
|
aefde67aa2 | ||
|
|
a1ea62a923 | ||
|
|
7209ced446 | ||
|
|
db63d352a2 | ||
|
|
289de840fd | ||
|
|
cb34a8b620 | ||
|
|
95c633914f | ||
|
|
d033412b1f | ||
|
|
9c5e97144d | ||
|
|
8b96289e2f | ||
|
|
51ff43e2f2 | ||
|
|
1e30f4f973 | ||
|
|
36f66661f7 | ||
|
|
de27fc15b6 | ||
|
|
f9f90ba1d6 | ||
|
|
51bf8a3538 | ||
|
|
7b033a48a3 | ||
|
|
1b420f69aa | ||
|
|
6a187a384b | ||
|
|
ac5de1f96e | ||
|
|
6c917f686a | ||
|
|
328ee94412 | ||
|
|
de9951594e | ||
|
|
561fc15ae9 | ||
|
|
d65814c53f | ||
|
|
803f17aa90 | ||
|
|
08a3687eb5 | ||
|
|
c4035b2273 | ||
|
|
5c364e0f7c | ||
|
|
9cfc3d9d37 | ||
|
|
b5fdd30b77 | ||
|
|
280292d3f5 | ||
|
|
c593d864be | ||
|
|
6d17348c72 | ||
|
|
536648ec19 | ||
|
|
b5e32a9ce5 | ||
|
|
4077822e37 | ||
|
|
e2d8750625 | ||
|
|
79f5751375 | ||
|
|
106437bd45 | ||
|
|
b7cd13bb0b | ||
|
|
be1ec1b973 | ||
|
|
1bddb87a0c | ||
|
|
fbe23d8c33 | ||
|
|
f435bb24ab | ||
|
|
853b33b67c | ||
|
|
19f3568e18 | ||
|
|
911c2cbe58 | ||
|
|
17bdfbb08b | ||
|
|
80f29ae859 | ||
|
|
0b114d680e | ||
|
|
c87a0910d0 | ||
|
|
b1a4f05b5a | ||
|
|
ce2079104a | ||
|
|
86e12369b6 | ||
|
|
6d096551f0 | ||
|
|
2595c8a853 | ||
|
|
2a9923999b | ||
|
|
03cbeac1ea | ||
|
|
d64e9b6263 | ||
|
|
9824a34d76 | ||
|
|
76c3436377 | ||
|
|
a4178d4b3c | ||
|
|
3e423722c6 | ||
|
|
01837f2bb6 | ||
|
|
411c5da6d3 | ||
|
|
7658ea8335 | ||
|
|
81d301a42b | ||
|
|
0b500730e0 | ||
|
|
123710078d | ||
|
|
6c08dbab0e | ||
|
|
ec0d0ba368 | ||
|
|
bed02c2f95 | ||
|
|
75bc69ba2f | ||
|
|
3f434f2a44 | ||
|
|
71d8e6b4cd | ||
|
|
a78af0a7fb | ||
|
|
eb9f74a273 | ||
|
|
117ae196fd | ||
|
|
4c211c8dce | ||
|
|
4056b94e01 | ||
|
|
ee94828355 | ||
|
|
c10d9b9d9d | ||
|
|
fff66649aa | ||
|
|
b68b0a256e | ||
|
|
b33fdc1674 | ||
|
|
6909d9c9c9 | ||
|
|
0d5d820f4f | ||
|
|
6fbca3416a | ||
|
|
466d9b31ce | ||
|
|
b6fdaaac41 | ||
|
|
c19bbfce78 | ||
|
|
e9fdbe0c89 | ||
|
|
f2299eab8f | ||
|
|
e220f44953 | ||
|
|
b750a84ab1 | ||
|
|
41f8be2c53 | ||
|
|
c3e4cbe950 | ||
|
|
50df5000c2 | ||
|
|
3c8930b72b | ||
|
|
f0572c4d5f | ||
|
|
057ba8a4e1 | ||
|
|
677737d345 | ||
|
|
930ac9c57d | ||
|
|
5caa0371c4 | ||
|
|
e6e1cb1b43 | ||
|
|
164ed0b325 | ||
|
|
8263789602 | ||
|
|
a99906c6f0 | ||
|
|
617338457d | ||
|
|
1026d2173b | ||
|
|
ca9c9ee807 | ||
|
|
bef51fe9ff | ||
|
|
b72845609f | ||
|
|
ccd8b71c4b | ||
|
|
e623690295 | ||
|
|
070baea3c4 | ||
|
|
0e828792ae | ||
|
|
31a8dfa063 | ||
|
|
338ef8f2e4 | ||
|
|
737fee94d0 | ||
|
|
4a2d770066 | ||
|
|
b7cfc08fc5 | ||
|
|
92f0e1719b | ||
|
|
9e5f203302 | ||
|
|
17cb0c1aee | ||
|
|
df32cd0aca | ||
|
|
ae5dc8c45b | ||
|
|
b1ed5b0707 | ||
|
|
eefdb3f156 | ||
|
|
e9a5cfaddd | ||
|
|
f5f2997cc2 | ||
|
|
43d2ba6275 | ||
|
|
8b98b331cc | ||
|
|
e0130e7fd7 | ||
|
|
fb491f0d7c | ||
|
|
33b5d9651f | ||
|
|
9109e369ff | ||
|
|
b97e011715 | ||
|
|
1bb9a9368b | ||
|
|
ca3dac7e87 | ||
|
|
59302d4f42 | ||
|
|
fabb722c8d | ||
|
|
657fae490c | ||
|
|
e9acebe0e8 | ||
|
|
7a84fc4742 | ||
|
|
4be3d66a32 | ||
|
|
92df01b99d | ||
|
|
5c9c738913 | ||
|
|
83c357d9d1 | ||
|
|
3bb3adefbb | ||
|
|
cf670153f9 | ||
|
|
d6cd69e659 | ||
|
|
48d31ad7bc | ||
|
|
20aa258f0e | ||
|
|
45a60956a6 | ||
|
|
4ae372262b | ||
|
|
02167a15d1 | ||
|
|
b50a4669d2 | ||
|
|
c947bda604 | ||
|
|
00451777fe | ||
|
|
a65386e925 | ||
|
|
2d7d154ffc | ||
|
|
3100080a50 | ||
|
|
7275370ae5 | ||
|
|
e013381e72 | ||
|
|
d05bb1c125 | ||
|
|
273d1ff2d0 | ||
|
|
235605bfa4 | ||
|
|
e8b3587946 | ||
|
|
9040ac6a0c | ||
|
|
a73ba56ebb | ||
|
|
1168f47768 | ||
|
|
73dba691b1 | ||
|
|
b1f76139a7 | ||
|
|
6b986fecb0 | ||
|
|
535ab8302b | ||
|
|
7125b3430c | ||
|
|
0615d09b7a | ||
|
|
1add0c7d43 | ||
|
|
8194f5ccaf | ||
|
|
057486cf56 | ||
|
|
f94e726271 | ||
|
|
95660002e1 | ||
|
|
95c669389b | ||
|
|
084fc9776d | ||
|
|
1498fdb7b0 | ||
|
|
79c3139748 | ||
|
|
bdd64f5656 | ||
|
|
dc3e9fb77c | ||
|
|
4b417c0e9d | ||
|
|
06c28f3a4d | ||
|
|
688fe6db5e | ||
|
|
9aefb59afe | ||
|
|
e3862b86b5 | ||
|
|
125cd222bb | ||
|
|
a0f351c9fa | ||
|
|
f7b49a2c91 | ||
|
|
fd70b47768 | ||
|
|
5d1fd390a6 | ||
|
|
8b5663e385 | ||
|
|
8b5bcaee3c | ||
|
|
ca845aa256 | ||
|
|
761ea65d81 | ||
|
|
1dc32d5e3d | ||
|
|
1c0a015cc8 | ||
|
|
bee415217d | ||
|
|
73989f5cc7 | ||
|
|
dd458c8ab5 | ||
|
|
63e9790123 | ||
|
|
70e1f3ac81 | ||
|
|
67f1872f4a | ||
|
|
8bbb7907d6 | ||
|
|
c98e1f3cae | ||
|
|
6b0f93ce8a | ||
|
|
80f19a0ab7 | ||
|
|
41894eb285 | ||
|
|
3535efd977 | ||
|
|
f6bd41ada7 | ||
|
|
7b5f40772f | ||
|
|
d2ebf4b52d | ||
|
|
0fe5c672a6 | ||
|
|
ce7d51f9be | ||
|
|
cc1f84d1d3 | ||
|
|
74126d9f24 | ||
|
|
69eb9531da | ||
|
|
da4d8254fa | ||
|
|
57332c5ccf | ||
|
|
9bc5ac05c4 | ||
|
|
0a4d58468e | ||
|
|
8ce092da68 | ||
|
|
fce1529bf2 | ||
|
|
61edf22a45 | ||
|
|
84974d6c56 | ||
|
|
da438a93e0 | ||
|
|
a87015598c | ||
|
|
c335bf5dc5 | ||
|
|
c6a782c0ce | ||
|
|
d148e14aa2 | ||
|
|
748a5d41c1 | ||
|
|
c876e63010 | ||
|
|
23b811243f | ||
|
|
99d9c57154 | ||
|
|
13559baecc | ||
|
|
481647ed5d | ||
|
|
5c162ce588 | ||
|
|
e1b6175efd | ||
|
|
ea46f096c2 | ||
|
|
da88dd8cfa | ||
|
|
9b5c6112e5 | ||
|
|
ea1341a129 | ||
|
|
343cb779d2 | ||
|
|
b0af01a762 | ||
|
|
d8617514f8 | ||
|
|
e579d1d89f | ||
|
|
63812c9f80 | ||
|
|
676a0afe4c | ||
|
|
42c257d0fc | ||
|
|
d5e5c98dc8 | ||
|
|
12d21dcb85 | ||
|
|
5054eb4276 | ||
|
|
122c77dbf6 | ||
|
|
3c66cab4e7 | ||
|
|
738fd479b3 | ||
|
|
5c612095a1 | ||
|
|
3e60e82529 | ||
|
|
60f8dd0bfc | ||
|
|
2a7008a82c | ||
|
|
0d3c6abee8 | ||
|
|
4a693222b4 | ||
|
|
82e052f2ec | ||
|
|
0745c15d7b | ||
|
|
2904c19ed9 | ||
|
|
16fe0a301c | ||
|
|
aebb8010d4 | ||
|
|
4ac382e553 | ||
|
|
596111c988 | ||
|
|
e202d30835 | ||
|
|
fbe903b277 | ||
|
|
8a89e50c13 | ||
|
|
6cb0e0dcea | ||
|
|
a147ea3e80 | ||
|
|
557988e530 | ||
|
|
67fb2c212f | ||
|
|
3765b08cca | ||
|
|
3eb84fcb13 | ||
|
|
bea76e8e08 | ||
|
|
f5433dcaa4 | ||
|
|
ef3b953a42 | ||
|
|
605a205008 | ||
|
|
058f63b440 | ||
|
|
71882475d6 | ||
|
|
a3d29a15df | ||
|
|
a09112404d | ||
|
|
93fc11ea21 | ||
|
|
4faa129b8e | ||
|
|
6c4ed0409d | ||
|
|
ea2811f14f | ||
|
|
8bc2987a71 | ||
|
|
1d13095d19 | ||
|
|
5ed76f197a | ||
|
|
e1f4cadf41 | ||
|
|
3b0e6357ad | ||
|
|
02f17bd4e4 | ||
|
|
b63a0796fd | ||
|
|
e6d4e729fb | ||
|
|
b75a22b753 | ||
|
|
72beeeeaaa | ||
|
|
c3c42ef56f | ||
|
|
a3c55681b2 | ||
|
|
cc70388846 | ||
|
|
fcc610f539 | ||
|
|
5bbd507858 | ||
|
|
45156c0c47 | ||
|
|
553e38ffd6 | ||
|
|
c4ca0490ee | ||
|
|
b145d47863 | ||
|
|
095827a261 | ||
|
|
87ecdb8112 | ||
|
|
98b2fa4d64 | ||
|
|
810ef7401c | ||
|
|
ae70a03383 | ||
|
|
081d132538 | ||
|
|
bb5c478704 | ||
|
|
ff6601f29e | ||
|
|
320c6c6f05 | ||
|
|
6b89da4bb2 | ||
|
|
5b82b9e101 | ||
|
|
1d0e862129 | ||
|
|
f089b2001f | ||
|
|
9f8420bf50 | ||
|
|
8275da63fb | ||
|
|
72696600d8 | ||
|
|
1aeb317863 | ||
|
|
b49b510732 | ||
|
|
a0d61e45d5 | ||
|
|
95f1ef7561 | ||
|
|
edb2fab64c | ||
|
|
464fb73d83 | ||
|
|
6a4e63a17d | ||
|
|
168f94d29a | ||
|
|
3c2b1baff2 | ||
|
|
f2815d7068 | ||
|
|
f48d9465f5 | ||
|
|
6b1d5c6d7b | ||
|
|
789ef3608b | ||
|
|
57b08a57a0 | ||
|
|
5b6b9f1597 | ||
|
|
47f246ba66 | ||
|
|
b6b70d54ef | ||
|
|
417d9a14cc | ||
|
|
244566ccd4 | ||
|
|
ca4a35c90a | ||
|
|
e4ea8bc867 | ||
|
|
5d840b944b | ||
|
|
1e28876494 | ||
|
|
a40b2767c5 | ||
|
|
279b536646 | ||
|
|
ff163a5ae4 | ||
|
|
65379741f7 | ||
|
|
3eb0927a2b | ||
|
|
a3a45511e5 | ||
|
|
a20ea702e2 | ||
|
|
d2d0300c7e | ||
|
|
6e8aac984f | ||
|
|
6721c70b9e | ||
|
|
b8c1c1c144 | ||
|
|
e380c01dd1 | ||
|
|
655633ef34 | ||
|
|
3d1de237f6 | ||
|
|
6a63b13d69 | ||
|
|
3aca5502dc | ||
|
|
665f4bf248 | ||
|
|
b76ff3bdfc | ||
|
|
00450cd9db | ||
|
|
c344a543b0 | ||
|
|
554202f6e8 | ||
|
|
7590cfc610 | ||
|
|
eee8338064 | ||
|
|
3b5183a74e | ||
|
|
3ee43c3abb | ||
|
|
efdb13f0c7 | ||
|
|
f013c6e48d | ||
|
|
6e67899401 | ||
|
|
381dd1ce98 | ||
|
|
b0d8369534 | ||
|
|
4a7b18d841 | ||
|
|
7c4ffe9b9a | ||
|
|
de4f8f9aaf | ||
|
|
6554cc4a8d | ||
|
|
fac47e8ecb | ||
|
|
7443305039 | ||
|
|
635ae3a523 | ||
|
|
4a05b4556e | ||
|
|
c074615550 | ||
|
|
bac2b74b3d | ||
|
|
a3aaa6634d | ||
|
|
6a3a983f43 | ||
|
|
7996edfef9 | ||
|
|
0600b32908 | ||
|
|
77343e02e9 | ||
|
|
a3d4ecddba | ||
|
|
65403ec9fe | ||
|
|
3d3d314fb7 | ||
|
|
90b3730a0a | ||
|
|
3f3b756b61 | ||
|
|
d3b9b8d452 | ||
|
|
390c042027 | ||
|
|
c864828735 | ||
|
|
e0c9910d85 | ||
|
|
e62f12426b | ||
|
|
d3af50e4cc | ||
|
|
cbdb700edf | ||
|
|
6010b95fca | ||
|
|
e351dde651 | ||
|
|
714bd61d56 | ||
|
|
f9e9c70b6c | ||
|
|
6123c41f13 | ||
|
|
1aaa5618de | ||
|
|
16202216b2 | ||
|
|
8f1527712e | ||
|
|
fbe8998ca8 | ||
|
|
47e8f669f5 | ||
|
|
d804ee3c07 | ||
|
|
06a78d90d9 | ||
|
|
bc2ebce086 | ||
|
|
a07de921d0 | ||
|
|
6bc67b70a6 | ||
|
|
f06addfe06 | ||
|
|
7c2c50ee16 | ||
|
|
8580d3c27e | ||
|
|
951e10f272 | ||
|
|
2349ea9405 | ||
|
|
b17bf259f7 | ||
|
|
6b093bdcca | ||
|
|
10ec319c32 | ||
|
|
8cb63cebbe | ||
|
|
7d26de6697 | ||
|
|
8262290bff | ||
|
|
2779037f13 | ||
|
|
734c85d7ef | ||
|
|
05bd5767de | ||
|
|
59d288c429 | ||
|
|
8c41c0b6a7 | ||
|
|
f5f3858da1 | ||
|
|
738490e674 | ||
|
|
6a13703e32 | ||
|
|
20d5d560f3 | ||
|
|
aaabca6fc7 | ||
|
|
4b440618d6 | ||
|
|
01a79dc965 | ||
|
|
0df220780a | ||
|
|
a360cb7922 | ||
|
|
b9a2bb8104 | ||
|
|
f4a46ba6ea | ||
|
|
79bb9e54d5 | ||
|
|
135aff9e17 | ||
|
|
8ae6ae65a1 | ||
|
|
f4d7fd97f6 | ||
|
|
031a9894b0 | ||
|
|
fcc09d7ea9 | ||
|
|
7f1f684b21 | ||
|
|
d8d482e433 | ||
|
|
3fdc053d6c | ||
|
|
8be3ce18aa | ||
|
|
eda61455d3 | ||
|
|
00107c092c | ||
|
|
c5907258c3 | ||
|
|
64e1961193 | ||
|
|
f7ee8bd30d | ||
|
|
c0d2140d14 | ||
|
|
1bdde9c4f7 | ||
|
|
333ae7c4f8 | ||
|
|
f7b7c83264 | ||
|
|
6f9c9879ca | ||
|
|
b8df47e063 | ||
|
|
9dad8bf56d | ||
|
|
689f2dcbb4 | ||
|
|
163e2a5b22 | ||
|
|
e36334e14b | ||
|
|
60304c7e27 | ||
|
|
28d41039b8 | ||
|
|
b8d530da36 | ||
|
|
4fad0714e7 | ||
|
|
ca17eb4a2b | ||
|
|
4fe005e3c3 | ||
|
|
2f9ed8a572 | ||
|
|
688e18a891 | ||
|
|
8162c64ca3 | ||
|
|
e179f26d50 | ||
|
|
8db68c04c4 | ||
|
|
7c92c64730 | ||
|
|
01c6ffe1d5 | ||
|
|
46f57f5c38 | ||
|
|
1ec2e08f21 | ||
|
|
77742dec11 | ||
|
|
3cb947b37e | ||
|
|
62cf407f0c | ||
|
|
bbed72f39f | ||
|
|
99c94a78d6 | ||
|
|
2dd852da54 | ||
|
|
3c87d89df3 | ||
|
|
f4ad627b54 | ||
|
|
68a5667a1a | ||
|
|
693c6d63d4 | ||
|
|
f18c3323ea | ||
|
|
f74e19e673 | ||
|
|
da70807292 | ||
|
|
9f8bc6bb8a | ||
|
|
64b9482602 | ||
|
|
8fbcae6029 | ||
|
|
064475cb8d | ||
|
|
f4077b678a | ||
|
|
51678c1aba | ||
|
|
17a2fdbf1b | ||
|
|
65d7c3eed1 | ||
|
|
41bb8c543b | ||
|
|
bbd7355313 | ||
|
|
772916593b | ||
|
|
9d8af7355f | ||
|
|
521a29446f | ||
|
|
344f0b743d |
@@ -1,11 +0,0 @@
|
||||
image: freebsd/latest
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
sudo gmake install
|
||||
gmake test-install
|
||||
gmake test-amalg
|
||||
@@ -1,11 +0,0 @@
|
||||
image: openbsd/6.5
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
doas gmake install
|
||||
gmake test-install
|
||||
gmake test-amalg
|
||||
12
.builds/freebsd.yml
Normal file
12
.builds/freebsd.yml
Normal file
@@ -0,0 +1,12 @@
|
||||
image: freebsd/12.x
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
sudo gmake install
|
||||
gmake test-install
|
||||
14
.builds/meson.yml
Normal file
14
.builds/meson.yml
Normal file
@@ -0,0 +1,14 @@
|
||||
image: openbsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- meson
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
meson setup build --buildtype=release
|
||||
cd build
|
||||
ninja
|
||||
ninja test
|
||||
doas ninja install
|
||||
doas jpm --verbose install circlet
|
||||
15
.builds/meson2.yml
Normal file
15
.builds/meson2.yml
Normal file
@@ -0,0 +1,15 @@
|
||||
image: openbsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- meson
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
meson setup build --buildtype=release
|
||||
cd build
|
||||
meson configure -Dprf=true
|
||||
ninja
|
||||
ninja test
|
||||
doas ninja install
|
||||
doas jpm --verbose install circlet
|
||||
22
.builds/meson_min.yml
Normal file
22
.builds/meson_min.yml
Normal file
@@ -0,0 +1,22 @@
|
||||
image: openbsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- meson
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
meson setup build --buildtype=release
|
||||
cd build
|
||||
meson configure -Dsingle_threaded=true
|
||||
meson configure -Dnanbox=false
|
||||
meson configure -Ddynamic_modules=false
|
||||
meson configure -Ddocstrings=false
|
||||
meson configure -Dnet=false
|
||||
meson configure -Dsourcemaps=false
|
||||
meson configure -Dpeg=false
|
||||
meson configure -Dassembler=false
|
||||
meson configure -Dint_types=false
|
||||
meson configure -Dtyped_array=false
|
||||
meson configure -Dreduced_os=true
|
||||
ninja # will not pass tests but should build
|
||||
12
.builds/openbsd.yml
Normal file
12
.builds/openbsd.yml
Normal file
@@ -0,0 +1,12 @@
|
||||
image: openbsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
doas gmake install
|
||||
gmake test-install
|
||||
10
.gitattributes
vendored
10
.gitattributes
vendored
@@ -0,0 +1,10 @@
|
||||
*.janet linguist-language=Clojure
|
||||
|
||||
*.janet text eol=lf
|
||||
*.c text eol=lf
|
||||
*.h text eol=lf
|
||||
*.md text eol=lf
|
||||
*.yml text eol=lf
|
||||
*.build text eol=lf
|
||||
*.txt text eol=lf
|
||||
*.sh text eol=lf
|
||||
|
||||
12
.gitignore
vendored
12
.gitignore
vendored
@@ -13,6 +13,9 @@ janet
|
||||
janet-*.tar.gz
|
||||
dist
|
||||
|
||||
# jpm lockfile
|
||||
lockfile.janet
|
||||
|
||||
# Kakoune (fzf via fd)
|
||||
.fdignore
|
||||
|
||||
@@ -29,6 +32,9 @@ dist
|
||||
# Local directory for testing
|
||||
local
|
||||
|
||||
# Common test file I use.
|
||||
temp.janet
|
||||
|
||||
# Emscripten
|
||||
*.bc
|
||||
janet.js
|
||||
@@ -40,6 +46,7 @@ janet.wasm
|
||||
|
||||
# Generate test files
|
||||
*.out
|
||||
.orig
|
||||
|
||||
# Tools
|
||||
xxd
|
||||
@@ -47,6 +54,7 @@ xxd.exe
|
||||
|
||||
# VSCode
|
||||
.vs
|
||||
.clangd
|
||||
|
||||
# Swap files
|
||||
*.swp
|
||||
@@ -58,6 +66,10 @@ tags
|
||||
vgcore.*
|
||||
*.out.*
|
||||
|
||||
# Wix artifacts
|
||||
*.msi
|
||||
*.wixpdb
|
||||
|
||||
# Created by https://www.gitignore.io/api/c
|
||||
|
||||
### C ###
|
||||
|
||||
@@ -4,7 +4,6 @@ script:
|
||||
- make test
|
||||
- sudo make install
|
||||
- make test-install
|
||||
- make test-amalg
|
||||
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||
compiler:
|
||||
- clang
|
||||
|
||||
189
CHANGELOG.md
189
CHANGELOG.md
@@ -1,7 +1,183 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
### Unreleased
|
||||
## Unreleased - ???
|
||||
- Add integer parsing forms to pegs. This makes parsing many binary protocols easier.
|
||||
|
||||
## 1.12.2 - 2020-09-20
|
||||
- Add janet\_try and janet\_restore to C API.
|
||||
- Fix `os/execute` regression on windows.
|
||||
- Add :pipe option to `os/spawn`.
|
||||
- Fix docstring typos.
|
||||
|
||||
## 1.12.1 - 2020-09-07
|
||||
- Make `zero?`, `one?`, `pos?`, and `neg?` polymorphic.
|
||||
- Add C++ support to jpm and improve C++ interop in janet.h.
|
||||
- Add `%t` formatter to `printf`, `string/format`, and other formatter functions.
|
||||
- Expose `janet_cfuns_prefix` in C API.
|
||||
- Add `os/proc-wait` and `os/proc-kill` for interacting with processes.
|
||||
- Add `janet_getjfile` to C API.
|
||||
- Allow redirection of stdin, stdout, and stderr by passing keywords in the env table in `os/spawn` and `os/execute`.
|
||||
- Add `os/spawn` to get a core/process back instead of an exit code as in `os/execute`.
|
||||
When called like this, `os/execute` returns immediately.
|
||||
- Add `:x` flag to os/execute to raise error when exit code is non-zero.
|
||||
- Don't run `main` when flychecking.
|
||||
- Add `:n` flag to `file/open` to raise an error if file cannot be opened.
|
||||
- Fix import macro to not try and coerce everything to a string.
|
||||
- Allow passing a second argument to `disasm`.
|
||||
- Add `cancel`. Resumes a fiber but makes it immediately error at the yield point.
|
||||
- Allow multi-line paste into built in repl.
|
||||
- Add `(curenv)`.
|
||||
- Change `net/read`, `net/chunk`, and `net/write` to raise errors in the case of failures.
|
||||
- Add `janet_continue_signal` to C API. This indirectly enables C functions that yield to the event loop
|
||||
to raise errors or other signals.
|
||||
- Update meson build script to fix bug on Debian's version of meson
|
||||
- Add `xprint`, `xprin`, `xprintf`, and `xprinf`.
|
||||
- `net/write` now raises an error message if write fails.
|
||||
- Fix issue with SIGPIPE on macOS and BSDs.
|
||||
|
||||
## 1.11.3 - 2020-08-03
|
||||
- Add `JANET_HASHSEED` environment variable when `JANET_PRF` is enabled.
|
||||
- Expose `janet_cryptorand` in C API.
|
||||
- Properly initialize PRF in default janet program
|
||||
- Add `index-of` to core library.
|
||||
- Add `-fPIC` back to core CFLAGS (non-optional when compiling default client with Makefile)
|
||||
- Fix defaults on Windows for ARM
|
||||
- Fix defaults on NetBSD.
|
||||
|
||||
## 1.11.1 - 2020-07-25
|
||||
- Fix jpm and git with multiple git installs on Windows
|
||||
- Fix importing a .so file in the current directory
|
||||
- Allow passing byte sequence types directly to typed-array constructors.
|
||||
- Fix bug sending files between threads.
|
||||
- Disable PRF by default.
|
||||
- Update the soname.
|
||||
|
||||
## 1.11.0 - 2020-07-18
|
||||
- Add `forever` macro.
|
||||
- Add `any?` predicate to core.
|
||||
- Add `jpm list-pkgs` subcommand to see which package aliases are in the listing.
|
||||
- Add `jpm list-installed` subcommand to see which packages are installed.
|
||||
- Add `math/int-min`, `math/int-max`, `math/int32-min`, and `math/int32-max` for getting integer limits.
|
||||
- The gc interval is now autotuned, to prevent very bad gc behavior.
|
||||
- Improvements to the bytecode compiler, Janet will now generate more efficient bytecode.
|
||||
- Add `peg/find`, `peg/find-all`, `peg/replace`, and `peg/replace-all`
|
||||
- Add `math/nan`
|
||||
- Add `forv` macro
|
||||
- Add `symbol/slice`
|
||||
- Add `keyword/slice`
|
||||
- Allow cross compilation with Makefile.
|
||||
- Change `compare-primitve` to `cmp` and make it more efficient.
|
||||
- Add `reverse!` for reversing an array or buffer in place.
|
||||
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
|
||||
- Add `repeat` macro for iterating something n times.
|
||||
- Add `eachy` (each yield) macro for iterating a fiber.
|
||||
- Fix `:generate` verb in loop macro to accept non symbols as bindings.
|
||||
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexidecimal digits.
|
||||
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
|
||||
|
||||
## 1.10.1 - 2020-06-18
|
||||
- Expose `janet_table_clear` in API.
|
||||
- Respect `JANET_NO_PROCESSES` define when building
|
||||
- Fix `jpm` rules having multiple copies of the same dependency.
|
||||
- Fix `jpm` install in some cases.
|
||||
- Add `array/trim` and `buffer/trim` to shrink the backing capacity of these types
|
||||
to their current length.
|
||||
|
||||
## 1.10.0 - 2020-06-14
|
||||
- Hardcode default jpm paths on install so env variables are needed in fewer cases.
|
||||
- Add `:no-compile` to `create-executable` option for jpm.
|
||||
- Fix bug with the `trace` function.
|
||||
- Add `:h`, `:a`, and `:c` flags to `thread/new` for creating new kinds of threads.
|
||||
By default, threads will now consume much less memory per thread, but sending data between
|
||||
threads may cost more.
|
||||
- Fix flychecking when using the `use` macro.
|
||||
- CTRL-C no longer exits the repl, and instead cancels the current form.
|
||||
- Various small bug fixes
|
||||
- New MSI installer instead of NSIS based installer.
|
||||
- Make `os/realpath` work on windows.
|
||||
- Add polymorphic `compare` functions for comparing numbers.
|
||||
- Add `to` and `thru` peg combinators.
|
||||
- Add `JANET_GIT` environment variable to jpm to use a specific git binary (useful mainly on windows).
|
||||
- `asm` and `disasm` functions now use keywords instead of macros for keys. Also
|
||||
some slight changes to the way constants are encoded (remove wrapping `quote` in some cases).
|
||||
- Expose current macro form inside macros as (dyn :macro-form)
|
||||
- Add `tracev` macro.
|
||||
- Fix compiler bug that emitted incorrect code in some cases for while loops that create closures.
|
||||
- Add `:fresh` option to `(import ...)` to overwrite the module cache.
|
||||
- `(range x y 0)` will return an empty array instead of hanging forever.
|
||||
- Rename `jpm repl` to `jpm debug-repl`.
|
||||
|
||||
## 1.9.1 - 2020-05-12
|
||||
- Add :prefix option to declare-source
|
||||
- Re-enable minimal builds with the debugger.
|
||||
- Add several flags for configuring Janet on different platforms.
|
||||
- Fix broken meson build from 1.9.0 and add meson to CI.
|
||||
- Fix compilation issue when nanboxing is disabled.
|
||||
|
||||
## 1.9.0 - 2020-05-10
|
||||
- Add `:ldflags` option to many jpm declare functions.
|
||||
- Add `errorf` to core.
|
||||
- Add `lenprefix` combinator to PEGs.
|
||||
- Add `%M`, `%m`, `%N`, and `%n` formatters to formatting functions. These are the
|
||||
same as `%Q`, `%q`, `%P`, and `%p`, but will not truncate long values.
|
||||
- Add `fiber/root`.
|
||||
- Add beta `net/` module to core for socket based networking.
|
||||
- Add the `parse` function to parse strings of source code more conveniently.
|
||||
- Add `jpm rule-tree` subcommand.
|
||||
- Add `--offline` flag to jpm to force use of the cache.
|
||||
- Allow sending pointers and C functions across threads via `thread/send`.
|
||||
- Fix bug in `getline`.
|
||||
- Add `sh-rule` and `sh-phony` to jpm's dialect of Janet.
|
||||
- Change C api's `janet_formatb` -> `janet_formatbv`, and add new function `janet_formatb` to C api.
|
||||
- Add `edefer` macro to core.
|
||||
- A struct/table literal/constructor with duplicate keys will use the last value given.
|
||||
Previously, this was inconsistent between tables and structs, literals and constructor functions.
|
||||
- Add debugger to core. The debugger functions are only available
|
||||
in a debug repl, and are prefixed by a `.`.
|
||||
- Add `sort-by` and `sorted-by` to core.
|
||||
- Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`.
|
||||
- Add `math/erf`
|
||||
- Add `math/erfc`
|
||||
- Add `math/log1p`
|
||||
- Add `math/next`
|
||||
- Add os/umask
|
||||
- Add os/perm-int
|
||||
- Add os/perm-string
|
||||
- Add :int-permissions option for os/stat.
|
||||
- Add `jpm repl` subcommand, as well as `post-deps` macro in project.janet files.
|
||||
- Various bug fixes.
|
||||
|
||||
## 1.8.1 - 2020-03-31
|
||||
- Fix bugs for big endian systems
|
||||
- Fix 1.8.0 regression on BSDs
|
||||
|
||||
## 1.8.0 - 2020-03-29
|
||||
- Add `reduce2`, `accumulate`, and `accumulate2`.
|
||||
- Add lockfiles to `jpm` via `jpm make-lockfile` and `jpm load-lockfile`.
|
||||
- Add `os/realpath` (Not supported on windows).
|
||||
- Add `os/chmod`.
|
||||
- Add `chr` macro.
|
||||
- Allow `_` in the `match` macro to match anything without creating a binding
|
||||
or doing unification. Also change behavior of matching nil.
|
||||
- Add `:range-to` and `:down-to` verbs in the `loop` macro.
|
||||
- Fix `and` and `or` macros returning nil instead of false in some cases.
|
||||
- Allow matching successfully against nil values in the `match` macro.
|
||||
- Improve `janet_formatc` and `janet_panicf` formatters to be more like `string/format`.
|
||||
This makes it easier to make nice error messages from C.
|
||||
- Add `signal`
|
||||
- Add `fiber/can-resume?`
|
||||
- Allow fiber functions to accept arguments that are passed in via `resume`.
|
||||
- Make flychecking slightly less strict but more useful
|
||||
- Correct arity for `next`
|
||||
- Correct arity for `marshal`
|
||||
- Add `flush` and `eflush`
|
||||
- Add `prompt` and `return` on top of signal for user friendly delimited continuations.
|
||||
- Fix bug in buffer/blit when using the offset-src argument.
|
||||
- Fix segfault with malformed pegs.
|
||||
|
||||
## 1.7.0 - 2020-02-01
|
||||
- Remove `file/fileno` and `file/fdopen`.
|
||||
- Remove `==`, `not==`, `order<`, `order>`, `order<=`, and `order>=`. Instead, use the normal
|
||||
comparison and equality functions.
|
||||
- Let abstract types define a hash function and comparison/equality semantics. This lets
|
||||
@@ -9,20 +185,29 @@ All notable changes to this project will be documented in this file.
|
||||
will generate warnings when compiled against other versions.
|
||||
- Remove Emscripten build. Instead, use the amalgamated source code with a custom toolchain.
|
||||
- Update documentation.
|
||||
- Add `var-`
|
||||
- Add `module/add-paths`
|
||||
- Add `file/temp`
|
||||
- Add `mod` function to core.
|
||||
- Small bug fixes
|
||||
- Allow signaling from C functions (yielding) via janet\_signalv. This
|
||||
makes it easy to write C functions that work with event loops, such as
|
||||
in libuv or embedded in a game.
|
||||
- Add '%j' formatting option to the format family of functions.
|
||||
- Add `defer`
|
||||
- Add `assert`
|
||||
- Add `when-with`
|
||||
- Add `if-with`
|
||||
- Add completion to the default repl based on currently defined bindings. Also generally improve
|
||||
the repl keybindings.
|
||||
- Add `eachk`
|
||||
- Add `eachp`
|
||||
- Improve functionality of the `next` function. `next` now works on many different
|
||||
types, not just tables and structs. This allows for more generic data processing.
|
||||
- Fix thread module issue where sometimes decoding a message failed.
|
||||
- Fix segfault regression when macros are called with bad arity.
|
||||
|
||||
### 1.6.0 - 2019-12-22
|
||||
## 1.6.0 - 2019-12-22
|
||||
- Add `thread/` module to the core.
|
||||
- Allow seeding RNGs with any sequence of bytes. This provides
|
||||
a wider key space for the RNG. Exposed in C as `janet_rng_longseed`.
|
||||
|
||||
@@ -35,8 +35,9 @@ may require changes before being merged.
|
||||
[astyle](http://astyle.sourceforge.net/astyle.html). You will probably need
|
||||
to install this, but it can be installed with most package managers.
|
||||
|
||||
For janet code, the use lisp indentation with 2 spaces. One can use janet.vim to
|
||||
do this indentation, or approximate as close as possible.
|
||||
For janet code, use lisp indentation with 2 spaces. One can use janet.vim to
|
||||
do this indentation, or approximate as close as possible. There is a janet formatter
|
||||
in [spork](https://github.com/janet-lang/spork.git) that can be used to format code as well.
|
||||
|
||||
## C style
|
||||
|
||||
|
||||
233
Makefile
233
Makefile
@@ -27,19 +27,26 @@ PREFIX?=/usr/local
|
||||
INCLUDEDIR?=$(PREFIX)/include
|
||||
BINDIR?=$(PREFIX)/bin
|
||||
LIBDIR?=$(PREFIX)/lib
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || 'local')\""
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || echo local)\""
|
||||
CLIBS=-lm -lpthread
|
||||
JANET_TARGET=build/janet
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||
JANET_PATH?=$(LIBDIR)/janet
|
||||
MANPATH?=$(PREFIX)/share/man/man1/
|
||||
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
JANET_MANPATH?=$(PREFIX)/share/man/man1/
|
||||
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
DEBUGGER=gdb
|
||||
SONAME_SETTER=-Wl,-soname,
|
||||
|
||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden -march=native \
|
||||
-DJANET_BUILD=$(JANET_BUILD)
|
||||
LDFLAGS=-rdynamic
|
||||
# For cross compilation
|
||||
HOSTCC?=$(CC)
|
||||
HOSTAR?=$(AR)
|
||||
CFLAGS?=-O2
|
||||
LDFLAGS?=-rdynamic
|
||||
|
||||
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 -g $(COMMON_CFLAGS)
|
||||
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
||||
|
||||
# For installation
|
||||
LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
@@ -48,13 +55,14 @@ LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
UNAME:=$(shell uname -s)
|
||||
ifeq ($(UNAME), Darwin)
|
||||
CLIBS:=$(CLIBS) -ldl
|
||||
LDCONFIG:=
|
||||
SONAME_SETTER:=-Wl,-install_name,
|
||||
LDCONFIG:=true
|
||||
else ifeq ($(UNAME), Linux)
|
||||
CLIBS:=$(CLIBS) -lrt -ldl
|
||||
endif
|
||||
# For other unix likes, add flags here!
|
||||
ifeq ($(UNAME), Haiku)
|
||||
LDCONFIG:=
|
||||
LDCONFIG:=true
|
||||
LDFLAGS=-Wl,--export-dynamic
|
||||
endif
|
||||
|
||||
@@ -89,12 +97,14 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/corelib.c \
|
||||
src/core/debug.c \
|
||||
src/core/emit.c \
|
||||
src/core/ev.c \
|
||||
src/core/fiber.c \
|
||||
src/core/gc.c \
|
||||
src/core/inttypes.c \
|
||||
src/core/io.c \
|
||||
src/core/marsh.c \
|
||||
src/core/math.c \
|
||||
src/core/net.c \
|
||||
src/core/os.c \
|
||||
src/core/parse.c \
|
||||
src/core/peg.c \
|
||||
@@ -124,83 +134,33 @@ JANET_BOOT_SOURCES=src/boot/array_test.c \
|
||||
src/boot/table_test.c
|
||||
JANET_BOOT_HEADERS=src/boot/tests.h
|
||||
|
||||
JANET_MAINCLIENT_SOURCES=src/mainclient/line.c src/mainclient/main.c
|
||||
JANET_MAINCLIENT_HEADERS=src/mainclient/line.h
|
||||
##########################################################
|
||||
##### The bootstrap interpreter that creates janet.c #####
|
||||
##########################################################
|
||||
|
||||
JANET_WEBCLIENT_SOURCES=src/webclient/main.c
|
||||
|
||||
##################################################################
|
||||
##### The bootstrap interpreter that compiles the core image #####
|
||||
##################################################################
|
||||
|
||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) \
|
||||
build/boot.gen.o
|
||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
|
||||
|
||||
$(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
|
||||
|
||||
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $<
|
||||
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
|
||||
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
|
||||
|
||||
build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $^ $(CLIBS)
|
||||
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/core_image.c: build/janet_boot
|
||||
build/janet_boot $@ JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet'
|
||||
|
||||
##########################################################
|
||||
##### The main interpreter program and shared object #####
|
||||
##########################################################
|
||||
|
||||
JANET_CORE_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_CORE_SOURCES)) build/core_image.o
|
||||
JANET_MAINCLIENT_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_MAINCLIENT_SOURCES))
|
||||
|
||||
$(JANET_MAINCLIENT_OBJECTS): $(JANET_MAINCLIENT_HEADERS)
|
||||
|
||||
# Compile the core image generated by the bootstrap build
|
||||
build/core_image.o: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
$(CC) $(CFLAGS) -o $@ -c $<
|
||||
|
||||
build/%.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
$(CC) $(CFLAGS) -o $@ -c $<
|
||||
|
||||
$(JANET_TARGET): $(JANET_CORE_OBJECTS) $(JANET_MAINCLIENT_OBJECTS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||
$(AR) rcs $@ $^
|
||||
|
||||
#############################
|
||||
##### Generated C files #####
|
||||
#############################
|
||||
|
||||
%.gen.o: %.gen.c
|
||||
$(CC) $(CFLAGS) -o $@ -c $<
|
||||
|
||||
build/xxd: tools/xxd.c
|
||||
$(CC) $< -o $@
|
||||
|
||||
build/webinit.gen.c: src/webclient/webinit.janet build/xxd
|
||||
build/xxd $< $@ janet_gen_webinit
|
||||
build/boot.gen.c: src/boot/boot.janet build/xxd
|
||||
build/xxd $< $@ janet_gen_boot
|
||||
build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
|
||||
cksum $@
|
||||
|
||||
########################
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
amalg: build/shell.c build/janet.c build/janet.h build/core_image.c build/janetconf.h
|
||||
SONAME=libjanet.so.1.12
|
||||
|
||||
AMALG_SOURCE=$(JANET_LOCAL_HEADERS) $(JANET_CORE_SOURCES) build/core_image.c
|
||||
build/janet.c: $(AMALG_SOURCE) tools/amalg.janet $(JANET_TARGET)
|
||||
$(JANET_TARGET) tools/amalg.janet $(AMALG_SOURCE) > $@
|
||||
|
||||
AMALG_SHELL_SOURCE=src/mainclient/line.h src/mainclient/line.c src/mainclient/main.c
|
||||
build/shell.c: $(JANET_TARGET) tools/amalg.janet $(AMALG_SHELL_SOURCE)
|
||||
$(JANET_TARGET) tools/amalg.janet $(AMALG_SHELL_SOURCE) > $@
|
||||
build/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
|
||||
build/janet.h: src/include/janet.h
|
||||
cp $< $@
|
||||
@@ -208,10 +168,27 @@ build/janet.h: src/include/janet.h
|
||||
build/janetconf.h: src/conf/janetconf.h
|
||||
cp $< $@
|
||||
|
||||
build/janet.o: build/janet.c build/janet.h build/janetconf.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
|
||||
|
||||
build/shell.o: build/shell.c build/janet.h build/janetconf.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
|
||||
|
||||
$(JANET_TARGET): build/janet.o build/shell.o
|
||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_LIBRARY): build/janet.o build/shell.o
|
||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
|
||||
$(HOSTAR) rcs $@ $^
|
||||
|
||||
###################
|
||||
##### Testing #####
|
||||
###################
|
||||
|
||||
# Testing assumes HOSTCC=CC
|
||||
|
||||
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
||||
|
||||
repl: $(JANET_TARGET)
|
||||
@@ -228,12 +205,12 @@ valgrind: $(JANET_TARGET)
|
||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
||||
./$(JANET_TARGET) -k auxbin/jpm
|
||||
./$(JANET_TARGET) -k jpm
|
||||
|
||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k auxbin/jpm
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k jpm
|
||||
|
||||
callgrind: $(JANET_TARGET)
|
||||
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||
@@ -247,7 +224,7 @@ dist: build/janet-dist.tar.gz
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
src/include/janet.h src/conf/janetconf.h \
|
||||
jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
build/doc.html README.md build/janet.c build/shell.c auxbin/jpm
|
||||
build/doc.html README.md build/janet.c build/shell.c jpm
|
||||
$(eval JANET_DIST_DIR = "janet-$(shell basename $*)")
|
||||
mkdir -p build/$(JANET_DIST_DIR)
|
||||
cp -r $^ build/$(JANET_DIST_DIR)/
|
||||
@@ -266,9 +243,11 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
##### Installation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1
|
||||
build/jpm: jpm $(JANET_TARGET)
|
||||
$(JANET_TARGET) tools/patch-jpm.janet jpm build/jpm "--libpath=$(LIBDIR)" "--headerpath=$(INCLUDEDIR)/janet" "--binpath=$(BINDIR)"
|
||||
chmod +x build/jpm
|
||||
|
||||
.PHONY: build/janet.pc
|
||||
.INTERMEDIATE: build/janet.pc
|
||||
build/janet.pc: $(JANET_TARGET)
|
||||
echo 'prefix=$(PREFIX)' > $@
|
||||
echo 'exec_prefix=$${prefix}' >> $@
|
||||
@@ -280,37 +259,37 @@ build/janet.pc: $(JANET_TARGET)
|
||||
echo "Description: Library for the Janet programming language." >> $@
|
||||
$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
|
||||
echo 'Cflags: -I$${includedir}' >> $@
|
||||
echo 'Libs: -L$${libdir} -ljanet $(LDFLAGS)' >> $@
|
||||
echo 'Libs: -L$${libdir} -ljanet' >> $@
|
||||
echo 'Libs.private: $(CLIBS)' >> $@
|
||||
|
||||
install: $(JANET_TARGET) build/janet.pc
|
||||
mkdir -p '$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(BINDIR)/janet'
|
||||
mkdir -p '$(INCLUDEDIR)/janet'
|
||||
cp -rf $(JANET_HEADERS) '$(INCLUDEDIR)/janet'
|
||||
mkdir -p '$(JANET_PATH)'
|
||||
mkdir -p '$(LIBDIR)'
|
||||
cp $(JANET_LIBRARY) '$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
|
||||
cp $(JANET_STATIC_LIBRARY) '$(LIBDIR)/libjanet.a'
|
||||
ln -sf $(SONAME) '$(LIBDIR)/libjanet.so'
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
|
||||
cp -rf auxbin/* '$(BINDIR)'
|
||||
mkdir -p '$(MANPATH)'
|
||||
cp janet.1 '$(MANPATH)'
|
||||
cp jpm.1 '$(MANPATH)'
|
||||
mkdir -p '$(PKG_CONFIG_PATH)'
|
||||
cp build/janet.pc '$(PKG_CONFIG_PATH)/janet.pc'
|
||||
-$(LDCONFIG)
|
||||
install: $(JANET_TARGET) build/janet.pc build/jpm
|
||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
cp -rf $(JANET_HEADERS) '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
||||
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
||||
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
|
||||
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
|
||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
|
||||
cp -rf build/jpm '$(DESTDIR)$(BINDIR)'
|
||||
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
|
||||
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
|
||||
cp jpm.1 '$(DESTDIR)$(JANET_MANPATH)'
|
||||
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
|
||||
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
|
||||
|
||||
uninstall:
|
||||
-rm '$(BINDIR)/janet'
|
||||
-rm '$(BINDIR)/jpm'
|
||||
-rm -rf '$(INCLUDEDIR)/janet'
|
||||
-rm -rf '$(LIBDIR)'/libjanet.*
|
||||
-rm '$(PKG_CONFIG_PATH)/janet.pc'
|
||||
-rm '$(MANPATH)/janet.1'
|
||||
-rm '$(MANPATH)/jpm.1'
|
||||
# -rm -rf '$(JANET_PATH)'/* - err on the side of correctness here
|
||||
-rm '$(DESTDIR)$(BINDIR)/janet'
|
||||
-rm '$(DESTDIR)$(BINDIR)/jpm'
|
||||
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
|
||||
-rm '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||
-rm '$(DESTDIR)$(JANET_MANPATH)/janet.1'
|
||||
-rm '$(DESTDIR)$(JANET_MANPATH)/jpm.1'
|
||||
# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
|
||||
|
||||
#################
|
||||
##### Other #####
|
||||
@@ -323,8 +302,13 @@ grammar: build/janet.tmLanguage
|
||||
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
$(JANET_TARGET) $< > $@
|
||||
|
||||
compile-commands:
|
||||
# Requires pip install copmiledb
|
||||
compiledb make
|
||||
|
||||
clean:
|
||||
-rm -rf build vgcore.* callgrind.*
|
||||
-rm -rf test/install/build test/install/modpath
|
||||
|
||||
test-install:
|
||||
cd test/install \
|
||||
@@ -334,20 +318,33 @@ test-install:
|
||||
&& build/testexec \
|
||||
&& jpm --verbose quickbin testexec.janet build/testexec2 \
|
||||
&& build/testexec2 \
|
||||
&& jpm --verbose --testdeps --modpath=. install https://github.com/janet-lang/json.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/jhydro.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
|
||||
&& mkdir -p modpath \
|
||||
&& jpm --verbose --testdeps --modpath=./modpath install https://github.com/janet-lang/json.git
|
||||
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/jhydro.git
|
||||
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/path.git
|
||||
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/argparse.git
|
||||
|
||||
build/embed_janet.o: build/janet.c $(JANET_HEADERS)
|
||||
$(CC) $(CFLAGS) -c $< -o $@
|
||||
build/embed_main.o: test/amalg/main.c $(JANET_HEADERS)
|
||||
$(CC) $(CFLAGS) -c $< -o $@
|
||||
build/embed_test: build/embed_janet.o build/embed_main.o
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
help:
|
||||
@echo
|
||||
@echo 'Janet: A Dynamic Language & Bytecode VM'
|
||||
@echo
|
||||
@echo Usage:
|
||||
@echo ' make Build Janet'
|
||||
@echo ' make repl Start a REPL from a built Janet'
|
||||
@echo
|
||||
@echo ' make test Test a built Janet'
|
||||
@echo ' make valgrind Assess Janet with Valgrind'
|
||||
@echo ' make callgrind Assess Janet with Valgrind, using Callgrind'
|
||||
@echo ' make valtest Run the test suite with Valgrind to check for memory leaks'
|
||||
@echo ' make dist Create a distribution tarball'
|
||||
@echo ' make docs Generate documentation'
|
||||
@echo ' make debug Run janet with GDB or LLDB'
|
||||
@echo ' make install Install into the current filesystem'
|
||||
@echo ' make uninstall Uninstall from the current filesystem'
|
||||
@echo ' make clean Clean intermediate build artifacts'
|
||||
@echo " make format Format Janet's own source files"
|
||||
@echo ' make grammar Generate a TextMate language grammar'
|
||||
@echo
|
||||
|
||||
test-amalg: build/embed_test
|
||||
./build/embed_test
|
||||
|
||||
.PHONY: clean install repl debug valgrind test amalg \
|
||||
valtest emscripten dist uninstall docs grammar format
|
||||
.PHONY: clean install repl debug valgrind test \
|
||||
valtest dist uninstall docs grammar format help compile-commands
|
||||
|
||||
90
README.md
90
README.md
@@ -2,26 +2,30 @@
|
||||
|
||||
[](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
|
||||
[](https://travis-ci.org/janet-lang/janet)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml?)
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
|
||||
modern lisp, but lists are replaced
|
||||
by other data structures with better utility and performance (arrays, tables, structs, tuples).
|
||||
lisp-like language, but lists are replaced
|
||||
by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
|
||||
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||
|
||||
There is a repl for trying out the language, as well as the ability
|
||||
to run script files. This client program is separate from the core runtime, so
|
||||
janet could be embedded into other programs. Try janet in your browser at
|
||||
Janet can be embedded into other programs. Try Janet in your browser at
|
||||
[https://janet-lang.org](https://janet-lang.org).
|
||||
|
||||
<br>
|
||||
|
||||
## Use Cases
|
||||
|
||||
Janet makes a good system scripting language, or a language to embed in other programs, like Lua or Guile.
|
||||
Janet makes a good system scripting language, or a language to embed in other programs.
|
||||
It's like Lua and Guile in that regard. It has more built-in functionality and a richer core language than
|
||||
Lua, but smaller than GNU Guile or Python.
|
||||
|
||||
## Features
|
||||
|
||||
@@ -33,7 +37,7 @@ Janet makes a good system scripting language, or a language to embed in other pr
|
||||
* Mutable and immutable arrays (array/tuple)
|
||||
* Mutable and immutable hashtables (table/struct)
|
||||
* Mutable and immutable strings (buffer/string)
|
||||
* Lisp Macros
|
||||
* Macros
|
||||
* Byte code interpreter with an assembly interface, as well as bytecode verification
|
||||
* Tailcall Optimization
|
||||
* Direct interop with C via abstract types and C functions
|
||||
@@ -43,7 +47,7 @@ Janet makes a good system scripting language, or a language to embed in other pr
|
||||
* Imperative programming as well as functional
|
||||
* REPL
|
||||
* Parsing Expression Grammars built in to the core library
|
||||
* 300+ functions and macros in the core library
|
||||
* 400+ functions and macros in the core library
|
||||
* Embedding Janet in other programs
|
||||
* Interactive environment with detailed stack traces
|
||||
|
||||
@@ -61,7 +65,9 @@ documentation for symbols in the core library. For example,
|
||||
Shows documentation for the doc macro.
|
||||
|
||||
To get a list of all bindings in the default
|
||||
environment, use the `(all-bindings)` function.
|
||||
environment, use the `(all-bindings)` function. You
|
||||
can also use the `(doc)` macro with no arguments if you are in the repl
|
||||
to show bound symbols.
|
||||
|
||||
## Source
|
||||
|
||||
@@ -71,7 +77,7 @@ the SourceHut mirror is actively maintained.
|
||||
|
||||
## Building
|
||||
|
||||
### macos and Unix-like
|
||||
### macOS and Unix-like
|
||||
|
||||
The Makefile is non-portable and requires GNU-flavored make.
|
||||
|
||||
@@ -82,6 +88,8 @@ make test
|
||||
make repl
|
||||
```
|
||||
|
||||
Find out more about the available make targets by running `make help`.
|
||||
|
||||
### 32-bit Haiku
|
||||
|
||||
32-bit Haiku build instructions are the same as the unix-like build instructions,
|
||||
@@ -107,6 +115,11 @@ gmake test
|
||||
gmake repl
|
||||
```
|
||||
|
||||
### NetBSD
|
||||
|
||||
NetBSD build instructions are the same as the FreeBSD build instuctions.
|
||||
Alternatively, install directly from packages, using `pkgin install janet`.
|
||||
|
||||
### Windows
|
||||
|
||||
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
|
||||
@@ -114,6 +127,13 @@ gmake repl
|
||||
3. Run `build_win` to compile janet.
|
||||
4. Run `build_win test` to make sure everything is working.
|
||||
|
||||
To build an `.msi` installer executable, in addition to the above steps, you will have to:
|
||||
|
||||
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases)
|
||||
6. run `build_win dist`
|
||||
|
||||
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
|
||||
|
||||
### Meson
|
||||
|
||||
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
|
||||
@@ -122,7 +142,7 @@ is maybe more convenient and flexible for integrating into existing pipelines.
|
||||
Meson also provides much better IDE integration than Make or batch files, as well as support
|
||||
for cross compilation.
|
||||
|
||||
For the impatient, building with Meson is as simple as follows. The options provided to
|
||||
For the impatient, building with Meson is as follows. The options provided to
|
||||
`meson setup` below emulate Janet's Makefile.
|
||||
|
||||
```sh
|
||||
@@ -131,6 +151,7 @@ cd janet
|
||||
meson setup build \
|
||||
--buildtype release \
|
||||
--optimization 2 \
|
||||
--libdir /usr/local/lib \
|
||||
-Dgit_hash=$(git log --pretty=format:'%h' -n 1)
|
||||
ninja -C build
|
||||
|
||||
@@ -152,7 +173,7 @@ Emacs, and Atom will have syntax packages for the Janet language, though.
|
||||
## Installation
|
||||
|
||||
See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
|
||||
to try out the language, you don't need to install anything. You can also simply move the `janet` executable wherever you want on your system and run it.
|
||||
to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it.
|
||||
|
||||
## Usage
|
||||
|
||||
@@ -163,43 +184,48 @@ If you are looking to explore, you can print a list of all available macros, fun
|
||||
by entering the command `(all-bindings)` into the repl.
|
||||
|
||||
```
|
||||
$ ./janet
|
||||
Janet 0.0.0 alpha Copyright (C) 2017-2018 Calvin Rose
|
||||
$ janet
|
||||
Janet 1.7.1-dev-951e10f Copyright (C) 2017-2020 Calvin Rose
|
||||
janet:1:> (+ 1 2 3)
|
||||
6
|
||||
janet:2:> (print "Hello, World!")
|
||||
Hello, World!
|
||||
nil
|
||||
janet:3:> (os/exit)
|
||||
$ ./janet -h
|
||||
usage: ./janet [options] scripts...
|
||||
$ janet -h
|
||||
usage: build/janet [options] script args...
|
||||
Options are:
|
||||
-h Show this help
|
||||
-v Print the version string
|
||||
-s Use raw stdin instead of getline like functionality
|
||||
-e Execute a string of janet
|
||||
-r Enter the repl after running all scripts
|
||||
-p Keep on executing if there is a top level error (persistent)
|
||||
-- Stop handling option
|
||||
$
|
||||
-h : Show this help
|
||||
-v : Print the version string
|
||||
-s : Use raw stdin instead of getline like functionality
|
||||
-e code : Execute a string of janet
|
||||
-r : Enter the repl after running all scripts
|
||||
-p : Keep on executing if there is a top level error (persistent)
|
||||
-q : Hide prompt, logo, and repl output (quiet)
|
||||
-k : Compile scripts but do not execute (flycheck)
|
||||
-m syspath : Set system path for loading global modules
|
||||
-c source output : Compile janet source code into an image
|
||||
-n : Disable ANSI color output in the repl
|
||||
-l path : Execute code in a file before running the main script
|
||||
-- : Stop handling options
|
||||
```
|
||||
|
||||
If installed, you can also run `man janet` to get usage information.
|
||||
If installed, you can also run `man janet` and `man jpm` to get usage information.
|
||||
|
||||
## Embedding
|
||||
|
||||
The C API for Janet is not yet documented but coming soon.
|
||||
|
||||
Janet can be embedded in a host program very easily. There is a make target
|
||||
`make amalg` which creates the file `build/janet.c`, which is a single C file
|
||||
Janet can be embedded in a host program very easily. The normal build
|
||||
will create a file `build/janet.c`, which is a single C file
|
||||
that contains all the source to Janet. This file, along with
|
||||
`src/include/janet.h` and `src/include/janetconf.h` can dragged into any C
|
||||
`src/include/janet.h` and `src/conf/janetconf.h` can be dragged into any C
|
||||
project and compiled into the project. Janet should be compiled with `-std=c99`
|
||||
on most compilers, and will need to be linked to the math library, `-lm`, and
|
||||
the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
|
||||
there is no need for dynamic modules, add the define
|
||||
`-DJANET_NO_DYNAMIC_MODULES` to the compiler options.
|
||||
|
||||
See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the website for more information.
|
||||
|
||||
## Examples
|
||||
|
||||
See the examples directory for some example janet code.
|
||||
@@ -211,10 +237,10 @@ Alternatively, check out [the #janet channel on Freenode](https://webchat.freeno
|
||||
|
||||
## FAQ
|
||||
|
||||
### Why is my terminal is spitting out junk when I run the repl?
|
||||
### Why is my terminal spitting out junk when I run the repl?
|
||||
|
||||
Make sure your terminal supports ANSI escape codes. Most modern terminals will
|
||||
support these, but some older terminals, windows consoles, or embedded terminals
|
||||
support these, but some older terminals, Windows consoles, or embedded terminals
|
||||
will not. If your terminal does not support ANSI escape codes, run the repl with
|
||||
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||
ensue.
|
||||
|
||||
10
appveyor.yml
10
appveyor.yml
@@ -4,7 +4,6 @@ image:
|
||||
- Visual Studio 2019
|
||||
configuration:
|
||||
- Release
|
||||
- Debug
|
||||
platform:
|
||||
- x64
|
||||
- x86
|
||||
@@ -20,17 +19,13 @@ init:
|
||||
|
||||
install:
|
||||
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
|
||||
- choco install nsis -y -pre --version 3.05
|
||||
# Replace makensis.exe and files with special long string build. This should
|
||||
# prevent issues when setting PATH during installation.
|
||||
- 7z e "tools\nsis-3.05-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
|
||||
- build_win all
|
||||
- refreshenv
|
||||
# We need to reload vcvars after refreshing
|
||||
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
|
||||
- build_win test-install
|
||||
- set janet_outname=%appveyor_repo_tag_name%
|
||||
- if "%janet_outname%"=="" set janet_outname=v1.6.1
|
||||
- if "%janet_outname%"=="" set /P janet_outname=<build\version.txt
|
||||
build: off
|
||||
|
||||
artifacts:
|
||||
@@ -49,8 +44,7 @@ artifacts:
|
||||
- name: "janet-$(janet_outname)-windows-%platform%"
|
||||
path: dist
|
||||
type: Zip
|
||||
- path: "janet-$(janet_outname)-windows-installer.exe"
|
||||
name: "janet-$(janet_outname)-windows-%platform%-installer.exe"
|
||||
- path: "janet-$(janet_outname)-windows-%platform%-installer.msi"
|
||||
type: File
|
||||
|
||||
deploy:
|
||||
|
||||
@@ -33,20 +33,6 @@ mkdir build\core
|
||||
mkdir build\mainclient
|
||||
mkdir build\boot
|
||||
|
||||
@rem Build the xxd tool for generating sources
|
||||
cl /nologo /c tools/xxd.c /Fobuild\xxd.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
link /nologo /out:build\xxd.exe build\xxd.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Generate the embedded sources
|
||||
build\xxd.exe src\boot\boot.janet build\boot.gen.c janet_gen_boot
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the generated sources
|
||||
%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the bootstrap interpreter
|
||||
for %%f in (src\core\*.c) do (
|
||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||
@@ -58,48 +44,25 @@ for %%f in (src\boot\*.c) do (
|
||||
)
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
build\janet_boot build\core_image.c
|
||||
|
||||
@rem Build the core image
|
||||
%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
build\janet_boot . > build\janet.c
|
||||
|
||||
@rem Build the sources
|
||||
for %%f in (src\core\*.c) do (
|
||||
%JANET_COMPILE% /Fobuild\core\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
)
|
||||
%JANET_COMPILE% /Fobuild\janet.obj build\janet.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the resources
|
||||
rc /nologo /fobuild\janet_win.res janet_win.rc
|
||||
|
||||
@rem Build the main client
|
||||
for %%f in (src\mainclient\*.c) do (
|
||||
%JANET_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
)
|
||||
|
||||
@rem Link everything to main client
|
||||
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj build\janet_win.res
|
||||
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build static library (libjanet.a)
|
||||
%JANET_LINK_STATIC% /out:build\libjanet.lib build\core\*.obj build\core_image.obj
|
||||
%JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Gen amlag
|
||||
setlocal enabledelayedexpansion
|
||||
set "amalg_files="
|
||||
for %%f in (src\core\*.c) do (
|
||||
set "amalg_files=!amalg_files! %%f"
|
||||
)
|
||||
janet.exe tools\amalg.janet src\core\features.h src\core\util.h src\core\state.h src\core\gc.h src\core\vector.h src\core\fiber.h src\core\regalloc.h src\core\compile.h src\core\emit.h src\core\symcache.h %amalg_files% build\core_image.c > build\janet.c
|
||||
janet.exe tools\removecr.janet build\janet.c
|
||||
|
||||
@rem Gen shell.c
|
||||
janet.exe tools\amalg.janet src\mainclient\line.h src\mainclient\line.c src\mainclient\main.c > build\shell.c
|
||||
janet.exe tools\removecr.janet build\shell.c
|
||||
|
||||
echo === Successfully built janet.exe for Windows ===
|
||||
echo === Run 'build_win test' to run tests. ==
|
||||
echo === Run 'build_win clean' to delete build artifacts. ===
|
||||
@@ -139,9 +102,10 @@ exit /b 0
|
||||
mkdir dist
|
||||
janet.exe tools\gendoc.janet > dist\doc.html
|
||||
janet.exe tools\removecr.janet dist\doc.html
|
||||
janet.exe tools\removecr.janet build\janet.c
|
||||
|
||||
copy build\janet.c dist\janet.c
|
||||
copy build\shell.c dist\shell.c
|
||||
copy src\mainclient\shell.c dist\shell.c
|
||||
copy janet.exe dist\janet.exe
|
||||
copy LICENSE dist\LICENSE
|
||||
copy README.md dist\README.md
|
||||
@@ -153,23 +117,34 @@ copy src\include\janet.h dist\janet.h
|
||||
copy src\conf\janetconf.h dist\janetconf.h
|
||||
copy build\libjanet.lib dist\libjanet.lib
|
||||
|
||||
copy auxbin\jpm dist\jpm
|
||||
copy .\jpm dist\jpm
|
||||
copy tools\jpm.bat dist\jpm.bat
|
||||
|
||||
@rem Create installer
|
||||
janet.exe -e "(->> janet/version (peg/match ''(* :d+ `.` :d+ `.` :d+)) first print)" > build\version.txt
|
||||
janet.exe -e "(print (= (os/arch) :x64))" > build\64bit.txt
|
||||
janet.exe -e "(print (os/arch))" > build\arch.txt
|
||||
set /p JANET_VERSION= < build\version.txt
|
||||
set /p SIXTYFOUR= < build\64bit.txt
|
||||
set /p BUILDARCH= < build\arch.txt
|
||||
echo "JANET_VERSION is %JANET_VERSION%"
|
||||
"C:\Program Files (x86)\NSIS\makensis.exe" /DVERSION=%JANET_VERSION% /DSIXTYFOUR=%SIXTYFOUR% janet-installer.nsi
|
||||
if defined APPVEYOR_REPO_TAG_NAME (
|
||||
set RELEASE_VERSION=%APPVEYOR_REPO_TAG_NAME%
|
||||
) else (
|
||||
set RELEASE_VERSION=%JANET_VERSION%
|
||||
)
|
||||
if defined CI (
|
||||
set WIXBIN="c:\Program Files (x86)\WiX Toolset v3.11\bin\"
|
||||
) else (
|
||||
set WIXBIN=
|
||||
)
|
||||
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %BUILDARCH% -out build\
|
||||
%WIXBIN%light.exe "-sice:ICE38" -b tools\msi -ext WixUIExtension build\janet.wixobj -out janet-%RELEASE_VERSION%-windows-%BUILDARCH%-installer.msi
|
||||
exit /b 0
|
||||
|
||||
@rem Run the installer. (Installs to the local user with default settings)
|
||||
:INSTALL
|
||||
@echo Running Installer...
|
||||
FOR %%a in (janet-*-windows-installer.exe) DO (
|
||||
%%a /S /CurrentUser
|
||||
FOR %%a in (janet-*-windows-*-installer.msi) DO (
|
||||
@echo Running Installer %%a...
|
||||
%%a /QN
|
||||
)
|
||||
exit /b 0
|
||||
|
||||
|
||||
15
examples/channel.janet
Normal file
15
examples/channel.janet
Normal file
@@ -0,0 +1,15 @@
|
||||
(def c (ev/chan 4))
|
||||
|
||||
(defn writer []
|
||||
(for i 0 10
|
||||
(ev/sleep 0.1)
|
||||
(print "writer giving item " i "...")
|
||||
(ev/give c (string "item " i))))
|
||||
|
||||
(defn reader [name]
|
||||
(forever
|
||||
(print "reader " name " got " (ev/take c))))
|
||||
|
||||
(ev/call writer)
|
||||
(each letter [:a :b :c :d :e :f :g]
|
||||
(ev/call reader letter))
|
||||
@@ -1,20 +1,18 @@
|
||||
###
|
||||
### A useful debugger library for Janet. Should be used
|
||||
### inside a debug repl.
|
||||
### inside a debug repl. This has been moved into the core.
|
||||
###
|
||||
|
||||
(defn .fiber
|
||||
"Get the current fiber being debugged."
|
||||
[]
|
||||
(if-let [entry (dyn '_fiber)]
|
||||
(entry :value)
|
||||
(dyn :fiber)))
|
||||
(dyn :fiber))
|
||||
|
||||
(defn .stack
|
||||
"Print the current fiber stack"
|
||||
[]
|
||||
(print)
|
||||
(debug/stacktrace (.fiber) "")
|
||||
(with-dyns [:err-color false] (debug/stacktrace (.fiber) ""))
|
||||
(print))
|
||||
|
||||
(defn .frame
|
||||
|
||||
12
examples/evsleep.janet
Normal file
12
examples/evsleep.janet
Normal file
@@ -0,0 +1,12 @@
|
||||
(defn worker
|
||||
"Run for a number of iterations."
|
||||
[name iterations]
|
||||
(for i 0 iterations
|
||||
(ev/sleep 1)
|
||||
(print "worker " name " iteration " i)))
|
||||
|
||||
(ev/call worker :a 10)
|
||||
(ev/sleep 0.2)
|
||||
(ev/call worker :b 5)
|
||||
(ev/sleep 0.3)
|
||||
(ev/call worker :c 12)
|
||||
@@ -23,7 +23,7 @@ static int num_array_gc(void *p, size_t s) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
Janet num_array_get(void *p, Janet key);
|
||||
int num_array_get(void *p, Janet key, Janet *out);
|
||||
void num_array_put(void *p, Janet key, Janet value);
|
||||
|
||||
static const JanetAbstractType num_array_type = {
|
||||
@@ -31,7 +31,8 @@ static const JanetAbstractType num_array_type = {
|
||||
num_array_gc,
|
||||
NULL,
|
||||
num_array_get,
|
||||
num_array_put
|
||||
num_array_put,
|
||||
JANET_ATEND_PUT
|
||||
};
|
||||
|
||||
static Janet num_array_new(int32_t argc, Janet *argv) {
|
||||
@@ -81,21 +82,20 @@ static const JanetMethod methods[] = {
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
Janet num_array_get(void *p, Janet key) {
|
||||
int num_array_get(void *p, Janet key, Janet *out) {
|
||||
size_t index;
|
||||
Janet value;
|
||||
num_array *array = (num_array *)p;
|
||||
if (janet_checktype(key, JANET_KEYWORD))
|
||||
return janet_getmethod(janet_unwrap_keyword(key), methods);
|
||||
return janet_getmethod(janet_unwrap_keyword(key), methods, out);
|
||||
if (!janet_checkint(key))
|
||||
janet_panic("expected integer key");
|
||||
index = (size_t)janet_unwrap_integer(key);
|
||||
if (index >= array->size) {
|
||||
value = janet_wrap_nil();
|
||||
return 0;
|
||||
} else {
|
||||
value = janet_wrap_number(array->data[index]);
|
||||
*out = janet_wrap_number(array->data[index]);
|
||||
}
|
||||
return value;
|
||||
return 1;
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
|
||||
7
examples/numarray/project.janet
Normal file
7
examples/numarray/project.janet
Normal file
@@ -0,0 +1,7 @@
|
||||
(declare-project
|
||||
:name "numarray"
|
||||
:description "Example c lib with abstract type")
|
||||
|
||||
(declare-native
|
||||
:name "numarray"
|
||||
:source @["numarray.c"])
|
||||
@@ -1,10 +1,4 @@
|
||||
(import cook)
|
||||
|
||||
(cook/make-native
|
||||
:name "numarray"
|
||||
:source @["numarray.c"])
|
||||
|
||||
(import build/numarray :as numarray)
|
||||
(import build/numarray)
|
||||
|
||||
(def a (numarray/new 30))
|
||||
(print (get a 20))
|
||||
23
examples/select.janet
Normal file
23
examples/select.janet
Normal file
@@ -0,0 +1,23 @@
|
||||
(def channels
|
||||
(seq [:repeat 5] (ev/chan 4)))
|
||||
|
||||
(defn writer [c]
|
||||
(for i 0 3
|
||||
(def item (string i ":" (hash c)))
|
||||
(ev/sleep 0.1)
|
||||
(print "writer giving item " item " to " c "...")
|
||||
(ev/give c item))
|
||||
(print "Done!"))
|
||||
|
||||
(defn reader [name]
|
||||
(forever
|
||||
(def c (ev/select ;channels))
|
||||
(print "reader " name " got " (ev/take c) " from " c)))
|
||||
|
||||
# Readers
|
||||
(each letter [:a :b :c :d :e :f :g]
|
||||
(ev/call reader letter))
|
||||
|
||||
# Writers
|
||||
(each c channels
|
||||
(ev/call writer c))
|
||||
6
examples/tcpclient.janet
Normal file
6
examples/tcpclient.janet
Normal file
@@ -0,0 +1,6 @@
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(printf "Connected to %q!" conn)
|
||||
(:write conn "Echo...")
|
||||
(print "Wrote to connection...")
|
||||
(def res (:read conn 1024))
|
||||
(pp res))
|
||||
20
examples/tcpserver.janet
Normal file
20
examples/tcpserver.janet
Normal file
@@ -0,0 +1,20 @@
|
||||
(defn handler
|
||||
"Simple handler for connections."
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(def id (gensym))
|
||||
(def b @"")
|
||||
(print "Connection " id "!")
|
||||
(while (:read stream 1024 b)
|
||||
(repeat 10 (print "work for " id " ...") (ev/sleep 1))
|
||||
(:write stream b)
|
||||
(buffer/clear b))
|
||||
(printf "Done %v!" id)))
|
||||
|
||||
# Run server.
|
||||
(let [server (net/server "127.0.0.1" "8000")]
|
||||
(print "Starting echo server on 127.0.0.1:8000")
|
||||
(forever
|
||||
(if-let [conn (:accept server)]
|
||||
(ev/call handler conn)
|
||||
(print "no new connections"))))
|
||||
5
examples/udpclient.janet
Normal file
5
examples/udpclient.janet
Normal file
@@ -0,0 +1,5 @@
|
||||
(def conn (net/connect "127.0.0.1" "8009" :datagram))
|
||||
(:write conn (string/format "%q" (os/cryptorand 16)))
|
||||
(def x (:read conn 1024))
|
||||
(pp x)
|
||||
|
||||
6
examples/udpserver.janet
Normal file
6
examples/udpserver.janet
Normal file
@@ -0,0 +1,6 @@
|
||||
(def server (net/server "127.0.0.1" "8009" nil :datagram))
|
||||
(while true
|
||||
(def buf @"")
|
||||
(def who (:recv-from server 1024 buf))
|
||||
(printf "got %q from %v, echoing!" buf who)
|
||||
(:send-to server who buf))
|
||||
@@ -1,210 +0,0 @@
|
||||
Unicode True
|
||||
|
||||
!echo "Program Files: ${PROGRAMFILES}"
|
||||
!addplugindir "tools\"
|
||||
|
||||
# Version
|
||||
!define PRODUCT_VERSION "${VERSION}.0"
|
||||
VIProductVersion "${PRODUCT_VERSION}"
|
||||
VIFileVersion "${PRODUCT_VERSION}"
|
||||
|
||||
# Use the modern UI
|
||||
!define MULTIUSER_EXECUTIONLEVEL Highest
|
||||
!define MULTIUSER_MUI
|
||||
!define MULTIUSER_INSTALLMODE_COMMANDLINE
|
||||
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_KEY "Software\Janet\${VERSION}"
|
||||
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_VALUENAME ""
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_KEY "Software\Janet\${VERSION}"
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_VALUENAME ""
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR "Janet-${VERSION}"
|
||||
|
||||
!if ${SIXTYFOUR} == "true"
|
||||
!define MULTIUSER_USE_PROGRAMFILES64
|
||||
!endif
|
||||
|
||||
# Includes
|
||||
!include "MultiUser.nsh"
|
||||
!include "MUI2.nsh"
|
||||
!include "LogicLib.nsh"
|
||||
|
||||
# Basics
|
||||
Name "Janet"
|
||||
|
||||
# Do some NSIS-fu to figure out at compile time if we are in appveyor
|
||||
!define OUTNAME $%APPVEYOR_REPO_TAG_NAME%
|
||||
!define "CHECK_${OUTNAME}"
|
||||
!define DOLLAR "$"
|
||||
!ifdef CHECK_${DOLLAR}%APPVEYOR_REPO_TAG_NAME%
|
||||
# We are not in the appveyor environment, use version name
|
||||
!define OUTNAME_PART v${VERSION}
|
||||
!else
|
||||
# We are in appveyor, use git tag name for installer
|
||||
!define OUTNAME_PART ${OUTNAME}
|
||||
!endif
|
||||
OutFile "janet-${OUTNAME_PART}-windows-installer.exe"
|
||||
|
||||
# Some Configuration
|
||||
!define APPNAME "Janet"
|
||||
!define DESCRIPTION "The Janet Programming Language"
|
||||
!define HELPURL "http://janet-lang.org"
|
||||
BrandingText "The Janet Programming Language"
|
||||
|
||||
# Macros for setting registry values
|
||||
!define UNINST_KEY "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet-${VERSION}"
|
||||
!macro WriteEnv key value
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}" "${value}"
|
||||
${Else}
|
||||
WriteRegExpandStr HKCU "Environment" "${key}" "${value}"
|
||||
${EndIf}
|
||||
!macroend
|
||||
!macro DelEnv key
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}"
|
||||
${Else}
|
||||
DeleteRegValue HKCU "Environment" "${key}"
|
||||
${EndIf}
|
||||
!macroend
|
||||
|
||||
# MUI Configuration
|
||||
!define MUI_ICON "assets\icon.ico"
|
||||
!define MUI_UNICON "assets\icon.ico"
|
||||
!define MUI_HEADERIMAGE
|
||||
!define MUI_HEADERIMAGE_BITMAP "assets\janet-w200.png"
|
||||
!define MUI_HEADERIMAGE_RIGHT
|
||||
!define MUI_ABORTWARNING
|
||||
|
||||
# Show a welcome page first
|
||||
!insertmacro MUI_PAGE_WELCOME
|
||||
!insertmacro MUI_PAGE_LICENSE "LICENSE"
|
||||
|
||||
# Pick Install Directory
|
||||
!insertmacro MULTIUSER_PAGE_INSTALLMODE
|
||||
!insertmacro MUI_PAGE_DIRECTORY
|
||||
!insertmacro MUI_PAGE_INSTFILES
|
||||
|
||||
# Done
|
||||
!insertmacro MUI_PAGE_FINISH
|
||||
|
||||
# Need to set a language.
|
||||
!insertmacro MUI_LANGUAGE "English"
|
||||
|
||||
function .onInit
|
||||
!insertmacro MULTIUSER_INIT
|
||||
functionEnd
|
||||
|
||||
section "Janet" BfWSection
|
||||
|
||||
createDirectory "$INSTDIR\Library"
|
||||
createDirectory "$INSTDIR\C"
|
||||
createDirectory "$INSTDIR\bin"
|
||||
createDirectory "$INSTDIR\docs"
|
||||
setOutPath "$INSTDIR"
|
||||
|
||||
# Bin files
|
||||
file /oname=bin\janet.exe dist\janet.exe
|
||||
file /oname=logo.ico assets\icon.ico
|
||||
file /oname=bin\jpm.janet auxbin\jpm
|
||||
file /oname=bin\jpm.bat tools\jpm.bat
|
||||
|
||||
# C headers and library files
|
||||
file /oname=C\janet.h dist\janet.h
|
||||
file /oname=C\janetconf.h dist\janetconf.h
|
||||
file /oname=C\janet.lib dist\janet.lib
|
||||
file /oname=C\janet.exp dist\janet.exp
|
||||
file /oname=C\janet.c dist\janet.c
|
||||
file /oname=C\libjanet.lib dist\libjanet.lib
|
||||
|
||||
# Documentation
|
||||
file /oname=docs\docs.html dist\doc.html
|
||||
|
||||
# Other
|
||||
file README.md
|
||||
file LICENSE
|
||||
|
||||
# Uninstaller - See function un.onInit and section "uninstall" for configuration
|
||||
writeUninstaller "$INSTDIR\uninstall.exe"
|
||||
|
||||
# Start Menu
|
||||
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
|
||||
|
||||
# Update path
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
EnVar::SetHKLM
|
||||
${Else}
|
||||
EnVar::SetHKCU
|
||||
${EndIf}
|
||||
EnVar::AddValue "PATH" "$INSTDIR\bin"
|
||||
Pop $0
|
||||
|
||||
# Set up Environment variables
|
||||
!insertmacro WriteEnv JANET_PATH "$INSTDIR\Library"
|
||||
!insertmacro WriteEnv JANET_HEADERPATH "$INSTDIR\C"
|
||||
!insertmacro WriteEnv JANET_LIBPATH "$INSTDIR\C"
|
||||
!insertmacro WriteEnv JANET_BINPATH "$INSTDIR\bin"
|
||||
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
# Registry information for add/remove programs
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayName" "Janet"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "InstallLocation" "$INSTDIR"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayIcon" "$INSTDIR\logo.ico"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "Publisher" "Janet-Lang.org"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "HelpLink" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "URLUpdateInfo" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "URLInfoAbout" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayVersion" "${VERSION}"
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoModify" 1
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoRepair" 1
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "EstimatedSize" 1000
|
||||
# Add uninstall
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "UninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "QuietUninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode /S"
|
||||
|
||||
sectionEnd
|
||||
|
||||
# Uninstaller
|
||||
|
||||
function un.onInit
|
||||
!insertmacro MULTIUSER_UNINIT
|
||||
functionEnd
|
||||
|
||||
section "uninstall"
|
||||
|
||||
# Remove Start Menu launcher
|
||||
delete "$SMPROGRAMS\Janet.lnk"
|
||||
|
||||
# Remove files
|
||||
delete "$INSTDIR\logo.ico"
|
||||
delete "$INSTDIR\README.md"
|
||||
delete "$INSTDIR\LICENSE"
|
||||
rmdir /r "$INSTDIR\Library"
|
||||
rmdir /r "$INSTDIR\bin"
|
||||
rmdir /r "$INSTDIR\C"
|
||||
rmdir /r "$INSTDIR\docs"
|
||||
|
||||
# Remove env vars
|
||||
!insertmacro DelEnv JANET_PATH
|
||||
!insertmacro DelEnv JANET_HEADERPATH
|
||||
!insertmacro DelEnv JANET_LIBPATH
|
||||
!insertmacro DelEnv JANET_BINPATH
|
||||
|
||||
# Unset PATH
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
EnVar::SetHKLM
|
||||
${Else}
|
||||
EnVar::SetHKCU
|
||||
${EndIf}
|
||||
EnVar::DeleteValue "PATH" "$INSTDIR\bin"
|
||||
Pop $0
|
||||
|
||||
# make sure windows knows about the change
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
# Always delete uninstaller as the last action
|
||||
delete "$INSTDIR\uninstall.exe"
|
||||
|
||||
# Remove uninstaller information from the registry
|
||||
DeleteRegKey SHCTX "${UNINST_KEY}"
|
||||
|
||||
sectionEnd
|
||||
132
janet.1
132
janet.1
@@ -9,12 +9,12 @@ janet \- run the Janet language abstract machine
|
||||
[\fB\-m\fR \fIPATH\fR]
|
||||
[\fB\-c\fR \fIMODULE JIMAGE\fR]
|
||||
[\fB\-\-\fR]
|
||||
.IR script
|
||||
.IR args ...
|
||||
.BR script
|
||||
.BR args ...
|
||||
.SH DESCRIPTION
|
||||
Janet is a functional and imperative programming language and bytecode interpreter.
|
||||
It is a modern lisp, but lists are replaced by other data structures with better utility
|
||||
and performance (arrays, tables, structs, tuples). The language also features bridging
|
||||
It is a Lisp-like language, but lists are replaced by other data structures
|
||||
(arrays, tables, structs, tuples). The language also features bridging
|
||||
to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||
|
||||
There is a repl for trying out the language, as well as the ability to run script files.
|
||||
@@ -25,6 +25,110 @@ Implemented in mostly standard C99, Janet runs on Windows, Linux and macOS.
|
||||
The few features that are not standard C99 (dynamic library loading, compiler
|
||||
specific optimizations), are fairly straight forward. Janet can be easily ported to
|
||||
most new platforms.
|
||||
|
||||
.SH REPL KEY-BINDINGS
|
||||
|
||||
.TP 16
|
||||
.BR Home
|
||||
Move cursor to the beginning of input line.
|
||||
|
||||
.TP 16
|
||||
.BR End
|
||||
Move cursor to the end of input line.
|
||||
|
||||
.TP 16
|
||||
.BR Left/Right
|
||||
Move cursor in input line.
|
||||
|
||||
.TP 16
|
||||
.BR Up/Down
|
||||
Go backwards and forwards through history.
|
||||
|
||||
.TP 16
|
||||
.BR Tab
|
||||
Complete current symbol, or show available completions.
|
||||
|
||||
.TP 16
|
||||
.BR Delete
|
||||
Delete one character after the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Backspace
|
||||
Delete one character before the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-A
|
||||
Move cursor to the beginning of input line.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-B
|
||||
Move cursor one character to the left.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-E
|
||||
Move cursor to the end of input line.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-F
|
||||
Move cursor one character to the right.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-H
|
||||
Delete one character before the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-K
|
||||
Delete everything after the cursor on the input line.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-L
|
||||
Clear the screen.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-N/Ctrl\-P
|
||||
Go forwards and backwards through history.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-U
|
||||
Delete everything before the cursor on the input line.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-W
|
||||
Delete one word before the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-G
|
||||
Show documentation for the current symbol under the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-B/Alt\-F
|
||||
Move cursor backwards and forwards one word.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-D
|
||||
Delete one word after the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-,
|
||||
Go to earliest item in history.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-.
|
||||
Go to last item in history.
|
||||
|
||||
.LP
|
||||
|
||||
The repl keybindings are loosely based on a subset of GNU readline, although
|
||||
Janet does not use GNU readline internally for the repl. It is a limited
|
||||
substitute for GNU readline, and does not handle
|
||||
utf-8 input or other mutlibyte input well.
|
||||
|
||||
To disable the built-in repl input handling, pass the \fB\-s\fR option to Janet, and
|
||||
use a program like rlwrap with Janet to provide input.
|
||||
|
||||
For key bindings that operate on words, a word is considered to be a sequence
|
||||
of characters that does not contain whitespace.
|
||||
|
||||
.SH DOCUMENTATION
|
||||
|
||||
For more complete API documentation, run a REPL (Read Eval Print Loop), and use the doc macro to
|
||||
@@ -48,6 +152,12 @@ Read raw input from stdin and forgo prompt history and other readline-like featu
|
||||
Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
|
||||
arguments are executed before later ones.
|
||||
|
||||
.TP
|
||||
.BR \-d
|
||||
Enable debug mode. On all terminating signals as well the debug signal, this will
|
||||
cause the debugger to come up in the REPL. Same as calling (setdyn :debug true) in a
|
||||
default repl.
|
||||
|
||||
.TP
|
||||
.BR \-n
|
||||
Disable ANSI colors in the repl. Has no effect if no repl is run.
|
||||
@@ -65,7 +175,7 @@ after an error. Persistent mode can be good for debugging and testing.
|
||||
|
||||
.TP
|
||||
.BR \-q
|
||||
Quiet output. Don't print a repl prompt or expression results to stdout.
|
||||
Hide the logo in the repl.
|
||||
|
||||
.TP
|
||||
.BR \-k
|
||||
@@ -84,8 +194,8 @@ Source should be a path to the Janet module to compile, and output should be the
|
||||
resulting image. Output should usually end with the .jimage extension.
|
||||
|
||||
.TP
|
||||
.BR \-l\ path
|
||||
Load a Janet file before running a script or repl. Multiple files can be loaded
|
||||
.BR \-l\ lib
|
||||
Import a Janet module before running a script or repl. Multiple files can be loaded
|
||||
in this manner, and exports from each file will be made available to the script
|
||||
or repl.
|
||||
|
||||
@@ -103,5 +213,13 @@ find native and source code modules. If no JANET_PATH is set, Janet will look in
|
||||
the default location set at compile time.
|
||||
.RE
|
||||
|
||||
.B JANET_HASHSEED
|
||||
.RS
|
||||
To disable randomization of Janet's PRF on start up, one can set this variable. This can have the
|
||||
effect of making programs deterministic that otherwise would depend on the random seed chosen at program start.
|
||||
This variable does nothing in the default configuration of Janet, as PRF is disabled by default. Also, JANET_REDUCED_OS
|
||||
cannot be defined for this variable to have an effect.
|
||||
.RE
|
||||
|
||||
.SH AUTHOR
|
||||
Written by Calvin Rose <calsrose@gmail.com>
|
||||
|
||||
1212
auxbin/jpm → jpm
1212
auxbin/jpm → jpm
File diff suppressed because it is too large
Load Diff
82
jpm.1
82
jpm.1
@@ -24,6 +24,10 @@ More interesting are the local commands. For more information on jpm usage, see
|
||||
|
||||
.SH FLAGS
|
||||
|
||||
.TP
|
||||
.BR \-\-nocolor
|
||||
Disable color in the jpm debug repl.
|
||||
|
||||
.TP
|
||||
.BR \-\-verbose
|
||||
Print detailed messages of what jpm is doing, including compilation commands and other shell commands.
|
||||
@@ -32,6 +36,12 @@ Print detailed messages of what jpm is doing, including compilation commands and
|
||||
.BR \-\-test
|
||||
If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies.
|
||||
|
||||
.TP
|
||||
.BR \-\-offline
|
||||
Prevents jpm from going to network to get dependencies - all dependencies should be in the cache or this command will fail.
|
||||
Use this flag with the deps and update-pkgs subcommands. This is not a surefire way to prevent a build script from accessing
|
||||
the network, for example, a build script that invokes curl will still have network access.
|
||||
|
||||
.SH OPTIONS
|
||||
|
||||
.TP
|
||||
@@ -61,9 +71,14 @@ $JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more.
|
||||
|
||||
.TP
|
||||
.BR \-\-compiler=$CC
|
||||
Sets the compiler used for compiling native modules and standalone executables. Defaults
|
||||
Sets the C compiler used for compiling native modules and standalone executables. Defaults
|
||||
to cc.
|
||||
|
||||
.TP
|
||||
.BR \-\-cpp\-compiler=$CXX
|
||||
Sets the C++ compiler used for compiling native modules and standalone executables. Defaults
|
||||
to c++..
|
||||
|
||||
.TP
|
||||
.BR \-\-linker
|
||||
Sets the linker used to create native modules and executables. Only used on windows, where
|
||||
@@ -90,19 +105,19 @@ Builds all artifacts specified in the project.janet file in the current director
|
||||
be created in the ./build/ directory.
|
||||
|
||||
.TP
|
||||
.BR install\ [\fBrepo\fR]
|
||||
|
||||
.BR install\ [\fBrepo...\fR]
|
||||
When run with no arguments, installs all installable artifacts in the current project to
|
||||
the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also
|
||||
take an optional git repository URL and will install all artifacts in that repository instead.
|
||||
When run with an argument, install does not need to be run from a jpm project directory.
|
||||
When run with an argument, install does not need to be run from a jpm project directory. Will also
|
||||
install multiple dependencies in one command.
|
||||
|
||||
.TP
|
||||
.BR uninstall\ [\fBname\fR]
|
||||
.BR uninstall\ [\fBname...\fR]
|
||||
Uninstall a project installed with install. uninstall expects the name of the project, not the
|
||||
repository url, path to installed file or executable name. The name of the project must be specified
|
||||
repository url, path to installed file, or executable name. The name of the project must be specified
|
||||
at the top of the project.janet file in the declare-project form. If no name is given, uninstalls
|
||||
the current project if installed.
|
||||
the current project if installed. Will also uninstall multiple packages in one command.
|
||||
|
||||
.TP
|
||||
.BR clean
|
||||
@@ -128,6 +143,23 @@ date or too large, clear-cache will remove the cache and jpm will rebuild it
|
||||
when needed. clear-cache is a global command, so a project.janet is not
|
||||
required.
|
||||
|
||||
.TP
|
||||
.BR list-installed
|
||||
List all installed packages in the current syspath.
|
||||
|
||||
.TP
|
||||
.BR list-pkgs\ [\fBsearch\fR]
|
||||
List all package aliases in the current package listing that contain the given search string.
|
||||
If no search string is given, prints the entire listing.
|
||||
|
||||
.TP
|
||||
.BR clear-manifest
|
||||
jpm creates a manifest directory that contains a list of all installed files.
|
||||
By deleting this directory, jpm will think that nothing is installed and will
|
||||
try reinstalling everything on the jpm deps or jpm load-lockfile commands. Be careful with
|
||||
this command, as it may leave extra files on your system and shouldn't be needed
|
||||
most of the time in a healthy install.
|
||||
|
||||
.TP
|
||||
.BR run\ [\fBrule\fR]
|
||||
Run a given rule defined in project.janet. Project definitions files (project.janet) usually
|
||||
@@ -139,6 +171,12 @@ like make. run will run a single rule or build a single file.
|
||||
.BR rules
|
||||
List all rules that can be run via run. This is useful for exploring rules in the project.
|
||||
|
||||
.TP
|
||||
.BR rule-tree\ [\fBroot\fR]\ [\fBdepth\fR]
|
||||
Show rule dependency tree in a pretty format. Optionally provide a rule to use as the tree
|
||||
root, as well as a max depth to print. By default, prints the full tree for all rules. This
|
||||
can be quite long, so it is recommended to give a root rule.
|
||||
|
||||
.TP
|
||||
.BR show-paths
|
||||
Show all of the paths used when installing and building artifacts.
|
||||
@@ -148,12 +186,29 @@ Show all of the paths used when installing and building artifacts.
|
||||
Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs
|
||||
|
||||
.TP
|
||||
.BR quickbin [\fBentry\fR] [\fBexecutable\fR]
|
||||
.BR quickbin\ [\fBentry\fR]\ [\fBexecutable\fR]
|
||||
Create a standalone, statically linked executable from a Janet source file that contains a main function.
|
||||
The main function is the entry point of the program and will receive command line arguments
|
||||
as function arguments. The entry file can import other modules, including native C modules, and
|
||||
jpm will attempt to include the dependencies into the generated executable.
|
||||
|
||||
.TP
|
||||
.BR debug-repl
|
||||
Load the current project.janet file and start a repl in it's environment. This lets a user better
|
||||
debug the project file, as well as run rules manually.
|
||||
|
||||
.TP
|
||||
.BR make-lockfile\ [\fBfilename\fR]
|
||||
Create a lockfile. A lockfile is a record that describes what dependencies were installed at the
|
||||
time of the lockfile's creation, including exact versions. A lockfile can then be later used
|
||||
to set up that environment on a different machine via load-lockfile. By default, the lockfile
|
||||
is created at lockfile.jdn, although any path can be used.
|
||||
|
||||
.TP
|
||||
.BR load-lockfile\ [\fBfilename\fR]
|
||||
Install dependencies from a lockfile previously created with make-lockfile. By default, will look
|
||||
for a lockfile at lockfile.jdn, although any path can be used.
|
||||
|
||||
.SH ENVIRONMENT
|
||||
|
||||
.B JANET_PATH
|
||||
@@ -167,7 +222,7 @@ the default location set at compile time, which can be determined with (dyn :sys
|
||||
.RS
|
||||
The location that jpm will use to install libraries to. Defaults to JANET_PATH, but you could
|
||||
set this to a different directory if you want to. Doing so would let you import Janet modules
|
||||
on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install
|
||||
on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install.
|
||||
This variable is overwritten by the --modpath=/some/path if it is provided.
|
||||
.RE
|
||||
|
||||
@@ -183,7 +238,7 @@ variable.
|
||||
.B JANET_LIBPATH
|
||||
.RS
|
||||
Similar to JANET_HEADERPATH, this path is where jpm will look for
|
||||
libjanet.a for creating standalong executables. This does not need to be
|
||||
libjanet.a for creating standalone executables. This does not need to be
|
||||
set on a normal install.
|
||||
If not provided, this will default to <jpm script location>/../lib.
|
||||
The --libpath=/some/path option will override this variable.
|
||||
@@ -202,6 +257,13 @@ The --binpath=/some/path will override this variable.
|
||||
The git repository URL that contains a listing of packages. This allows installing packages with shortnames, which
|
||||
is mostly a convenience. However, package dependencies can use short names, package listings
|
||||
can be used to choose a particular set of dependency versions for a whole project.
|
||||
.RE
|
||||
|
||||
.B JANET_GIT
|
||||
.RS
|
||||
An optional path to a git executable to use to clone git dependencies. By default, uses "git" on the current $PATH. You shouldn't need to set this
|
||||
if you have a normal install of git.
|
||||
.RE
|
||||
|
||||
.SH AUTHOR
|
||||
Written by Calvin Rose <calsrose@gmail.com>
|
||||
|
||||
129
meson.build
129
meson.build
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.6.1-dev')
|
||||
version : '1.13.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -59,14 +59,20 @@ conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings'))
|
||||
conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
|
||||
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
|
||||
conf.set('JANET_NO_PEG', not get_option('peg'))
|
||||
conf.set('JANET_NO_NET', not get_option('net'))
|
||||
conf.set('JANET_NO_EV', not get_option('ev'))
|
||||
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
|
||||
conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
|
||||
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
|
||||
conf.set('JANET_NO_PRF', not get_option('prf'))
|
||||
conf.set('JANET_PRF', get_option('prf'))
|
||||
conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
|
||||
conf.set('JANET_MAX_PROTO_DEPTH', get_option('max_proto_depth'))
|
||||
conf.set('JANET_MAX_MACRO_EXPAND', get_option('max_macro_expand'))
|
||||
conf.set('JANET_STACK_MAX', get_option('stack_max'))
|
||||
conf.set('JANET_NO_UMASK', not get_option('umask'))
|
||||
conf.set('JANET_NO_REALPATH', not get_option('realpath'))
|
||||
conf.set('JANET_NO_PROCESSES', not get_option('processes'))
|
||||
conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
|
||||
if get_option('os_name') != ''
|
||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
||||
endif
|
||||
@@ -79,13 +85,6 @@ jconf = configure_file(output : 'janetconf.h',
|
||||
# Include directories
|
||||
incdir = include_directories(['src/include', '.'])
|
||||
|
||||
# Building generated sources
|
||||
xxd = executable('xxd', 'tools/xxd.c', native : true)
|
||||
gen = generator(xxd,
|
||||
output : '@BASENAME@.gen.c',
|
||||
arguments : ['@INPUT@', '@OUTPUT@', '@EXTRA_ARGS@'])
|
||||
boot_gen = gen.process('src/boot/boot.janet', extra_args: 'janet_gen_boot')
|
||||
|
||||
# Order is important here, as some headers
|
||||
# depend on other headers for the amalg target
|
||||
core_headers = [
|
||||
@@ -113,12 +112,14 @@ core_src = [
|
||||
'src/core/corelib.c',
|
||||
'src/core/debug.c',
|
||||
'src/core/emit.c',
|
||||
'src/core/ev.c',
|
||||
'src/core/fiber.c',
|
||||
'src/core/gc.c',
|
||||
'src/core/inttypes.c',
|
||||
'src/core/io.c',
|
||||
'src/core/marsh.c',
|
||||
'src/core/math.c',
|
||||
'src/core/net.c',
|
||||
'src/core/os.c',
|
||||
'src/core/parse.c',
|
||||
'src/core/peg.c',
|
||||
@@ -151,54 +152,57 @@ boot_src = [
|
||||
]
|
||||
|
||||
mainclient_src = [
|
||||
'src/mainclient/line.c',
|
||||
'src/mainclient/main.c'
|
||||
'src/mainclient/shell.c'
|
||||
]
|
||||
|
||||
# Build boot binary
|
||||
janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
|
||||
janet_boot = executable('janet-boot', core_src, boot_src,
|
||||
include_directories : incdir,
|
||||
c_args : '-DJANET_BOOTSTRAP',
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
native : true)
|
||||
|
||||
# Build core image
|
||||
core_image = custom_target('core_image',
|
||||
# Build janet.c
|
||||
janetc = custom_target('janetc',
|
||||
input : [janet_boot],
|
||||
output : 'core_image.gen.c',
|
||||
command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path])
|
||||
output : 'janet.c',
|
||||
capture : true,
|
||||
command : [
|
||||
janet_boot, meson.current_source_dir(),
|
||||
'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
|
||||
])
|
||||
|
||||
libjanet = library('janet', core_src, core_image,
|
||||
libjanet = library('janet', janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
version: meson.project_version(),
|
||||
soversion: version_parts[0] + '.' + version_parts[1],
|
||||
install : true)
|
||||
|
||||
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
|
||||
# shaves off about 10k on linux x64, likely similar on other platforms.
|
||||
native_cc = meson.get_compiler('c', native: true)
|
||||
cross_cc = meson.get_compiler('c', native: false)
|
||||
if native_cc.has_argument('-fvisibility=hidden')
|
||||
extra_native_cflags = ['-fvisibility=hidden']
|
||||
if cc.has_argument('-fvisibility=hidden')
|
||||
extra_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
extra_native_cflags = []
|
||||
extra_cflags = []
|
||||
endif
|
||||
if cross_cc.has_argument('-fvisibility=hidden')
|
||||
extra_cross_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
extra_cross_cflags = []
|
||||
endif
|
||||
|
||||
janet_mainclient = executable('janet', core_src, core_image, mainclient_src,
|
||||
janet_mainclient = executable('janet', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
c_args : extra_native_cflags,
|
||||
c_args : extra_cflags,
|
||||
install : true)
|
||||
|
||||
if meson.is_cross_build()
|
||||
janet_nativeclient = executable('janet-native', core_src, core_image, mainclient_src,
|
||||
native_cc = meson.get_compiler('c', native: true)
|
||||
if native_cc.has_argument('-fvisibility=hidden')
|
||||
extra_native_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
extra_native_cflags = []
|
||||
endif
|
||||
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
c_args : extra_cross_cflags,
|
||||
c_args : extra_native_cflags,
|
||||
native : true)
|
||||
else
|
||||
janet_nativeclient = janet_mainclient
|
||||
@@ -211,35 +215,19 @@ docs = custom_target('docs',
|
||||
capture : true,
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
|
||||
# Amalgamated source
|
||||
amalg = custom_target('amalg',
|
||||
input : ['tools/amalg.janet', core_headers, core_src, core_image],
|
||||
output : ['janet.c'],
|
||||
capture : true,
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
amalg_shell = custom_target('amalg-shell',
|
||||
input : ['tools/amalg.janet', 'src/mainclient/line.h',
|
||||
'src/mainclient/line.c', 'src/mainclient/main.c'],
|
||||
output : ['shell.c'],
|
||||
capture : true,
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
|
||||
# Amalgamated client
|
||||
janet_amalgclient = executable('janet-amalg', amalg, amalg_shell,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
build_by_default : false)
|
||||
|
||||
# Tests
|
||||
test_files = [
|
||||
'test/suite0.janet',
|
||||
'test/suite1.janet',
|
||||
'test/suite2.janet',
|
||||
'test/suite3.janet',
|
||||
'test/suite4.janet',
|
||||
'test/suite5.janet',
|
||||
'test/suite6.janet',
|
||||
'test/suite7.janet'
|
||||
'test/suite0000.janet',
|
||||
'test/suite0001.janet',
|
||||
'test/suite0002.janet',
|
||||
'test/suite0003.janet',
|
||||
'test/suite0004.janet',
|
||||
'test/suite0005.janet',
|
||||
'test/suite0006.janet',
|
||||
'test/suite0007.janet',
|
||||
'test/suite0008.janet',
|
||||
'test/suite0009.janet',
|
||||
'test/suite0010.janet'
|
||||
]
|
||||
foreach t : test_files
|
||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
@@ -252,12 +240,25 @@ run_target('repl', command : [janet_nativeclient])
|
||||
janet_dep = declare_dependency(include_directories : incdir,
|
||||
link_with : libjanet)
|
||||
|
||||
# pkgconfig
|
||||
pkg = import('pkgconfig')
|
||||
pkg.generate(libjanet,
|
||||
description: 'Library for the Janet programming language.')
|
||||
|
||||
# Installation
|
||||
install_man('janet.1')
|
||||
install_man('jpm.1')
|
||||
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
|
||||
janet_binscripts = [
|
||||
'auxbin/jpm'
|
||||
]
|
||||
install_data(sources : janet_binscripts, install_dir : get_option('bindir'))
|
||||
install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet'))
|
||||
if get_option('peg') and not get_option('reduced_os') and get_option('processes')
|
||||
install_man('jpm.1')
|
||||
patched_jpm = custom_target('patched-jpm',
|
||||
input : ['tools/patch-jpm.janet', 'jpm'],
|
||||
install : true,
|
||||
install_dir : get_option('bindir'),
|
||||
build_by_default : true,
|
||||
output : ['jpm'],
|
||||
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@',
|
||||
'--binpath=' + join_paths(get_option('prefix'), get_option('bindir')),
|
||||
'--libpath=' + join_paths(get_option('prefix'), get_option('libdir')),
|
||||
'--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))])
|
||||
endif
|
||||
|
||||
@@ -10,7 +10,13 @@ option('assembler', type : 'boolean', value : true)
|
||||
option('peg', type : 'boolean', value : true)
|
||||
option('typed_array', type : 'boolean', value : true)
|
||||
option('int_types', type : 'boolean', value : true)
|
||||
option('prf', type : 'boolean', value : true)
|
||||
option('prf', type : 'boolean', value : false)
|
||||
option('net', type : 'boolean', value : true)
|
||||
option('ev', type : 'boolean', value : true)
|
||||
option('processes', type : 'boolean', value : true)
|
||||
option('umask', type : 'boolean', value : true)
|
||||
option('realpath', type : 'boolean', value : true)
|
||||
option('simple_getline', type : 'boolean', value : false)
|
||||
|
||||
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
||||
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
||||
|
||||
@@ -23,6 +23,13 @@
|
||||
#include <janet.h>
|
||||
#include "tests.h"
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <direct.h>
|
||||
#define chdir(x) _chdir(x)
|
||||
#else
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
|
||||
extern const unsigned char *janet_gen_boot;
|
||||
extern int32_t janet_gen_boot_size;
|
||||
|
||||
@@ -63,13 +70,42 @@ int main(int argc, const char **argv) {
|
||||
janet_def(env, "boot/config", janet_wrap_table(opts), "Boot options");
|
||||
|
||||
/* Run bootstrap script to generate core image */
|
||||
const char *boot_file;
|
||||
const char *boot_filename;
|
||||
#ifdef JANET_NO_SOURCEMAPS
|
||||
boot_file = NULL;
|
||||
boot_filename = NULL;
|
||||
#else
|
||||
boot_file = "boot.janet";
|
||||
boot_filename = "boot.janet";
|
||||
#endif
|
||||
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, boot_file, NULL);
|
||||
|
||||
int chdir_status = chdir(argv[1]);
|
||||
if (chdir_status) {
|
||||
fprintf(stderr, "Could not change to directory %s\n", argv[1]);
|
||||
exit(1);
|
||||
}
|
||||
|
||||
FILE *boot_file = fopen("src/boot/boot.janet", "rb");
|
||||
if (NULL == boot_file) {
|
||||
fprintf(stderr, "Could not open src/boot/boot.janet\n");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
/* Slurp file into buffer */
|
||||
fseek(boot_file, 0, SEEK_END);
|
||||
size_t boot_size = ftell(boot_file);
|
||||
fseek(boot_file, 0, SEEK_SET);
|
||||
unsigned char *boot_buffer = malloc(boot_size);
|
||||
if (NULL == boot_buffer) {
|
||||
fprintf(stderr, "Failed to allocate boot buffer\n");
|
||||
exit(1);
|
||||
}
|
||||
if (!fread(boot_buffer, 1, boot_size, boot_file)) {
|
||||
fprintf(stderr, "Failed to read into boot buffer\n");
|
||||
exit(1);
|
||||
}
|
||||
fclose(boot_file);
|
||||
|
||||
status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL);
|
||||
free(boot_buffer);
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
|
||||
1360
src/boot/boot.janet
1360
src/boot/boot.janet
File diff suppressed because it is too large
Load Diff
@@ -23,6 +23,7 @@
|
||||
#include <janet.h>
|
||||
#include <assert.h>
|
||||
#include <stdio.h>
|
||||
#include <math.h>
|
||||
|
||||
#include "tests.h"
|
||||
|
||||
@@ -44,11 +45,31 @@ int system_test() {
|
||||
assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN)));
|
||||
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
|
||||
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
|
||||
#ifdef NAN
|
||||
assert(janet_checktype(janet_wrap_number(NAN), JANET_NUMBER));
|
||||
#else
|
||||
assert(janet_checktype(janet_wrap_number(0.0 / 0.0), JANET_NUMBER));
|
||||
#endif
|
||||
|
||||
assert(NULL != &janet_wrap_nil);
|
||||
|
||||
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
||||
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
||||
|
||||
Janet *t1 = janet_tuple_begin(3);
|
||||
t1[0] = janet_wrap_nil();
|
||||
t1[1] = janet_wrap_integer(4);
|
||||
t1[2] = janet_cstringv("hi");
|
||||
Janet tuple1 = janet_wrap_tuple(janet_tuple_end(t1));
|
||||
|
||||
Janet *t2 = janet_tuple_begin(3);
|
||||
t2[0] = janet_wrap_nil();
|
||||
t2[1] = janet_wrap_integer(4);
|
||||
t2[2] = janet_cstringv("hi");
|
||||
Janet tuple2 = janet_wrap_tuple(janet_tuple_end(t2));
|
||||
|
||||
assert(janet_equals(tuple1, tuple2));
|
||||
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -61,5 +61,11 @@ int table_test() {
|
||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
|
||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
|
||||
|
||||
assert(t2->count == 4);
|
||||
assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
|
||||
assert(t2->count == 3);
|
||||
assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
|
||||
assert(t2->count == 2);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -27,10 +27,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 6
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_MINOR 13
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.6.1-dev"
|
||||
#define JANET_VERSION "1.13.0-dev"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -41,23 +41,38 @@
|
||||
/* #define JANET_API __attribute__((visibility ("default"))) */
|
||||
|
||||
/* These settings should be specified before amalgamation is
|
||||
* built. */
|
||||
* built. Any build with these set should be considered non-standard, and
|
||||
* certain Janet libraries should be expected not to work. */
|
||||
/* #define JANET_NO_DOCSTRINGS */
|
||||
/* #define JANET_NO_SOURCEMAPS */
|
||||
/* #define JANET_REDUCED_OS */
|
||||
|
||||
/* Other settings */
|
||||
/* #define JANET_NO_PROCESSES */
|
||||
/* #define JANET_NO_ASSEMBLER */
|
||||
/* #define JANET_NO_PEG */
|
||||
/* #define JANET_NO_NET */
|
||||
/* #define JANET_NO_TYPED_ARRAY */
|
||||
/* #define JANET_NO_INT_TYPES */
|
||||
/* #define JANET_NO_PRF */
|
||||
/* #define JANET_NO_EV */
|
||||
/* #define JANET_NO_REALPATH */
|
||||
/* #define JANET_NO_SYMLINKS */
|
||||
/* #define JANET_NO_UMASK */
|
||||
|
||||
/* Other settings */
|
||||
/* #define JANET_DEBUG */
|
||||
/* #define JANET_PRF */
|
||||
/* #define JANET_NO_UTC_MKTIME */
|
||||
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
||||
/* #define JANET_EXIT(msg) do { printf("C assert failed executing janet: %s\n", msg); exit(1); } while (0) */
|
||||
/* #define JANET_TOP_LEVEL_SIGNAL(msg) call_my_function((msg), stderr) */
|
||||
/* #define JANET_RECURSION_GUARD 1024 */
|
||||
/* #define JANET_MAX_PROTO_DEPTH 200 */
|
||||
/* #define JANET_MAX_MACRO_EXPAND 200 */
|
||||
/* #define JANET_STACK_MAX 16384 */
|
||||
/* #define JANET_OS_NAME my-custom-os */
|
||||
/* #define JANET_ARCH_NAME pdp-8 */
|
||||
/* #define JANET_EV_EPOLL */
|
||||
|
||||
/* Main client settings, does not affect library code */
|
||||
/* #define JANET_SIMPLE_GETLINE */
|
||||
|
||||
#endif /* end of include guard: JANETCONF_H */
|
||||
|
||||
@@ -56,7 +56,7 @@ JanetArray *janet_array_n(const Janet *elements, int32_t n) {
|
||||
if (!array->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(array->data, elements, sizeof(Janet) * n);
|
||||
safe_memcpy(array->data, elements, sizeof(Janet) * n);
|
||||
return array;
|
||||
}
|
||||
|
||||
@@ -235,10 +235,12 @@ static Janet cfun_array_insert(int32_t argc, Janet *argv) {
|
||||
janet_panic("array overflow");
|
||||
}
|
||||
janet_array_ensure(array, array->count + argc - 2, 2);
|
||||
memmove(array->data + at + argc - 2,
|
||||
array->data + at,
|
||||
restsize);
|
||||
memcpy(array->data + at, argv + 2, chunksize);
|
||||
if (restsize) {
|
||||
memmove(array->data + at + argc - 2,
|
||||
array->data + at,
|
||||
restsize);
|
||||
}
|
||||
safe_memcpy(array->data + at, argv + 2, chunksize);
|
||||
array->count += (argc - 2);
|
||||
return argv[0];
|
||||
}
|
||||
@@ -268,6 +270,26 @@ static Janet cfun_array_remove(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_array_trim(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
if (array->count) {
|
||||
if (array->count < array->capacity) {
|
||||
Janet *newData = realloc(array->data, array->count * sizeof(Janet));
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
array->data = newData;
|
||||
array->capacity = array->count;
|
||||
}
|
||||
} else {
|
||||
array->capacity = 0;
|
||||
free(array->data);
|
||||
array->data = NULL;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{
|
||||
"array/new", cfun_array_new,
|
||||
@@ -322,16 +344,16 @@ static const JanetReg array_cfuns[] = {
|
||||
{
|
||||
"array/concat", cfun_array_concat,
|
||||
JDOC("(array/concat arr & parts)\n\n"
|
||||
"Concatenates a variadic number of arrays (and tuples) into the first argument "
|
||||
"which must an array. If any of the parts are arrays or tuples, their elements will "
|
||||
"Concatenates a variable number of arrays (and tuples) into the first argument "
|
||||
"which must be an array. If any of the parts are arrays or tuples, their elements will "
|
||||
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
|
||||
"Return the modified array arr.")
|
||||
},
|
||||
{
|
||||
"array/insert", cfun_array_insert,
|
||||
JDOC("(array/insert arr at & xs)\n\n"
|
||||
"Insert all of xs into array arr at index at. at should be an integer "
|
||||
"0 and the length of the array. A negative value for at will index from "
|
||||
"Insert all xs into array arr at index at. at should be an integer between "
|
||||
"0 and the length of the array. A negative value for at will index backwards from "
|
||||
"the end of the array, such that inserting at -1 appends to the array. "
|
||||
"Returns the array.")
|
||||
},
|
||||
@@ -343,6 +365,11 @@ static const JanetReg array_cfuns[] = {
|
||||
"By default, n is 1. "
|
||||
"Returns the array.")
|
||||
},
|
||||
{
|
||||
"array/trim", cfun_array_trim,
|
||||
JDOC("(array/trim arr)\n\n"
|
||||
"Set the backing capacity of an array to its current length. Returns the modified array.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
264
src/core/asm.c
264
src/core/asm.c
@@ -53,7 +53,6 @@ struct JanetAssembler {
|
||||
|
||||
Janet name;
|
||||
JanetTable labels; /* keyword -> bytecode index */
|
||||
JanetTable constants; /* symbol -> constant index */
|
||||
JanetTable slots; /* symbol -> slot index */
|
||||
JanetTable envs; /* symbol -> environment index */
|
||||
JanetTable defs; /* symbol -> funcdefs index */
|
||||
@@ -74,6 +73,7 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"call", JOP_CALL},
|
||||
{"clo", JOP_CLOSURE},
|
||||
{"cmp", JOP_COMPARE},
|
||||
{"cncl", JOP_CANCEL},
|
||||
{"div", JOP_DIVIDE},
|
||||
{"divim", JOP_DIVIDE_IMMEDIATE},
|
||||
{"eq", JOP_EQUALS},
|
||||
@@ -87,6 +87,8 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"in", JOP_IN},
|
||||
{"jmp", JOP_JUMP},
|
||||
{"jmpif", JOP_JUMP_IF},
|
||||
{"jmpni", JOP_JUMP_IF_NIL},
|
||||
{"jmpnn", JOP_JUMP_IF_NOT_NIL},
|
||||
{"jmpno", JOP_JUMP_IF_NOT},
|
||||
{"ldc", JOP_LOAD_CONSTANT},
|
||||
{"ldf", JOP_LOAD_FALSE},
|
||||
@@ -106,10 +108,14 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"mkstu", JOP_MAKE_STRUCT},
|
||||
{"mktab", JOP_MAKE_TABLE},
|
||||
{"mktup", JOP_MAKE_TUPLE},
|
||||
{"mod", JOP_MODULO},
|
||||
{"movf", JOP_MOVE_FAR},
|
||||
{"movn", JOP_MOVE_NEAR},
|
||||
{"mul", JOP_MULTIPLY},
|
||||
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
||||
{"neq", JOP_NOT_EQUALS},
|
||||
{"neqim", JOP_NOT_EQUALS_IMMEDIATE},
|
||||
{"next", JOP_NEXT},
|
||||
{"noop", JOP_NOOP},
|
||||
{"prop", JOP_PROPAGATE},
|
||||
{"push", JOP_PUSH},
|
||||
@@ -118,6 +124,7 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"pusha", JOP_PUSH_ARRAY},
|
||||
{"put", JOP_PUT},
|
||||
{"puti", JOP_PUT_INDEX},
|
||||
{"rem", JOP_REMAINDER},
|
||||
{"res", JOP_RESUME},
|
||||
{"ret", JOP_RETURN},
|
||||
{"retn", JOP_RETURN_NIL},
|
||||
@@ -167,7 +174,6 @@ static void janet_asm_deinit(JanetAssembler *a) {
|
||||
janet_table_deinit(&a->slots);
|
||||
janet_table_deinit(&a->labels);
|
||||
janet_table_deinit(&a->envs);
|
||||
janet_table_deinit(&a->constants);
|
||||
janet_table_deinit(&a->defs);
|
||||
}
|
||||
|
||||
@@ -247,9 +253,6 @@ static int32_t doarg_1(
|
||||
case JANET_OAT_ENVIRONMENT:
|
||||
c = &a->envs;
|
||||
break;
|
||||
case JANET_OAT_CONSTANT:
|
||||
c = &a->constants;
|
||||
break;
|
||||
case JANET_OAT_LABEL:
|
||||
c = &a->labels;
|
||||
break;
|
||||
@@ -501,7 +504,6 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
a.defs_capacity = 0;
|
||||
a.name = janet_wrap_nil();
|
||||
janet_table_init(&a.labels, 0);
|
||||
janet_table_init(&a.constants, 0);
|
||||
janet_table_init(&a.slots, 0);
|
||||
janet_table_init(&a.envs, 0);
|
||||
janet_table_init(&a.defs, 0);
|
||||
@@ -529,34 +531,34 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
"expected struct or table for assembly source");
|
||||
|
||||
/* Check for function name */
|
||||
a.name = janet_get1(s, janet_csymbolv("name"));
|
||||
a.name = janet_get1(s, janet_ckeywordv("name"));
|
||||
if (!janet_checktype(a.name, JANET_NIL)) {
|
||||
def->name = janet_to_string(a.name);
|
||||
}
|
||||
|
||||
/* Set function arity */
|
||||
x = janet_get1(s, janet_csymbolv("arity"));
|
||||
x = janet_get1(s, janet_ckeywordv("arity"));
|
||||
def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0;
|
||||
janet_asm_assert(&a, def->arity >= 0, "arity must be non-negative");
|
||||
|
||||
x = janet_get1(s, janet_csymbolv("max-arity"));
|
||||
x = janet_get1(s, janet_ckeywordv("max-arity"));
|
||||
def->max_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
|
||||
janet_asm_assert(&a, def->max_arity >= def->arity, "max-arity must be greater than or equal to arity");
|
||||
|
||||
x = janet_get1(s, janet_csymbolv("min-arity"));
|
||||
x = janet_get1(s, janet_ckeywordv("min-arity"));
|
||||
def->min_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
|
||||
janet_asm_assert(&a, def->min_arity <= def->arity, "min-arity must be less than or equal to arity");
|
||||
|
||||
/* Check vararg */
|
||||
x = janet_get1(s, janet_csymbolv("vararg"));
|
||||
x = janet_get1(s, janet_ckeywordv("vararg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
|
||||
/* Check source */
|
||||
x = janet_get1(s, janet_csymbolv("source"));
|
||||
x = janet_get1(s, janet_ckeywordv("source"));
|
||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||
|
||||
/* Create slot aliases */
|
||||
x = janet_get1(s, janet_csymbolv("slots"));
|
||||
x = janet_get1(s, janet_ckeywordv("slots"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
for (i = 0; i < count; i++) {
|
||||
Janet v = arr[i];
|
||||
@@ -577,7 +579,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
|
||||
/* Parse constants */
|
||||
x = janet_get1(s, janet_csymbolv("constants"));
|
||||
x = janet_get1(s, janet_ckeywordv("constants"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
def->constants_length = count;
|
||||
def->constants = malloc(sizeof(Janet) * (size_t) count);
|
||||
@@ -586,25 +588,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
for (i = 0; i < count; i++) {
|
||||
Janet ct = arr[i];
|
||||
if (janet_checktype(ct, JANET_TUPLE) &&
|
||||
janet_tuple_length(janet_unwrap_tuple(ct)) > 1 &&
|
||||
janet_checktype(janet_unwrap_tuple(ct)[0], JANET_SYMBOL)) {
|
||||
const Janet *t = janet_unwrap_tuple(ct);
|
||||
int32_t tcount = janet_tuple_length(t);
|
||||
const uint8_t *macro = janet_unwrap_symbol(t[0]);
|
||||
if (0 == janet_cstrcmp(macro, "quote")) {
|
||||
def->constants[i] = t[1];
|
||||
} else if (tcount == 3 &&
|
||||
janet_checktype(t[1], JANET_SYMBOL) &&
|
||||
0 == janet_cstrcmp(macro, "def")) {
|
||||
def->constants[i] = t[2];
|
||||
janet_table_put(&a.constants, t[1], janet_wrap_integer(i));
|
||||
} else {
|
||||
janet_asm_errorv(&a, janet_formatc("could not parse constant \"%v\"", ct));
|
||||
}
|
||||
} else {
|
||||
def->constants[i] = ct;
|
||||
}
|
||||
def->constants[i] = ct;
|
||||
}
|
||||
} else {
|
||||
def->constants = NULL;
|
||||
@@ -612,7 +596,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
|
||||
/* Parse sub funcdefs */
|
||||
x = janet_get1(s, janet_csymbolv("closures"));
|
||||
x = janet_get1(s, janet_ckeywordv("closures"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
int32_t i;
|
||||
for (i = 0; i < count; i++) {
|
||||
@@ -623,7 +607,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
if (subres.status != JANET_ASSEMBLE_OK) {
|
||||
janet_asm_errorv(&a, subres.error);
|
||||
}
|
||||
subname = janet_get1(arr[i], janet_csymbolv("name"));
|
||||
subname = janet_get1(arr[i], janet_ckeywordv("name"));
|
||||
if (!janet_checktype(subname, JANET_NIL)) {
|
||||
janet_table_put(&a.defs, subname, janet_wrap_integer(def->defs_length));
|
||||
}
|
||||
@@ -642,7 +626,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
|
||||
/* Parse bytecode and labels */
|
||||
x = janet_get1(s, janet_csymbolv("bytecode"));
|
||||
x = janet_get1(s, janet_ckeywordv("bytecode"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
/* Do labels and find length */
|
||||
int32_t blength = 0;
|
||||
@@ -698,10 +682,13 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
a.errindex = -1;
|
||||
|
||||
/* Check for source mapping */
|
||||
x = janet_get1(s, janet_csymbolv("sourcemap"));
|
||||
x = janet_get1(s, janet_ckeywordv("sourcemap"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) count);
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (i = 0; i < count; i++) {
|
||||
const Janet *tup;
|
||||
Janet entry = arr[i];
|
||||
@@ -725,12 +712,18 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
/* Set environments */
|
||||
def->environments =
|
||||
realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
if (NULL == def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
/* Verify the func def */
|
||||
if (janet_verify(def)) {
|
||||
janet_asm_error(&a, "invalid assembly");
|
||||
}
|
||||
|
||||
/* Add final flags */
|
||||
janet_def_addflags(def);
|
||||
|
||||
/* Finish everything and return funcdef */
|
||||
janet_asm_deinit(&a);
|
||||
result.error = NULL;
|
||||
@@ -848,92 +841,110 @@ Janet janet_asm_decode_instruction(uint32_t instr) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
Janet janet_disasm(JanetFuncDef *def) {
|
||||
int32_t i;
|
||||
/*
|
||||
* Disasm sections
|
||||
*/
|
||||
|
||||
static Janet janet_disasm_arity(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->arity);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_min_arity(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->min_arity);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_max_arity(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->max_arity);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_slotcount(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->slotcount);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
|
||||
JanetArray *bcode = janet_array(def->bytecode_length);
|
||||
JanetArray *constants;
|
||||
JanetTable *ret = janet_table(10);
|
||||
janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity));
|
||||
janet_table_put(ret, janet_csymbolv("min-arity"), janet_wrap_integer(def->min_arity));
|
||||
janet_table_put(ret, janet_csymbolv("max-arity"), janet_wrap_integer(def->max_arity));
|
||||
janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode));
|
||||
if (NULL != def->source) {
|
||||
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
|
||||
}
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
|
||||
}
|
||||
if (NULL != def->name) {
|
||||
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
|
||||
}
|
||||
|
||||
/* Add constants */
|
||||
if (def->constants_length > 0) {
|
||||
constants = janet_array(def->constants_length);
|
||||
janet_table_put(ret, janet_csymbolv("constants"), janet_wrap_array(constants));
|
||||
for (i = 0; i < def->constants_length; i++) {
|
||||
Janet src = def->constants[i];
|
||||
Janet dest;
|
||||
if (janet_checktype(src, JANET_TUPLE)) {
|
||||
dest = janet_wrap_tuple(tup2(janet_csymbolv("quote"), src));
|
||||
} else {
|
||||
dest = src;
|
||||
}
|
||||
constants->data[i] = dest;
|
||||
}
|
||||
constants->count = def->constants_length;
|
||||
}
|
||||
|
||||
/* Add bytecode */
|
||||
for (i = 0; i < def->bytecode_length; i++) {
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
bcode->data[i] = janet_asm_decode_instruction(def->bytecode[i]);
|
||||
}
|
||||
bcode->count = def->bytecode_length;
|
||||
return janet_wrap_array(bcode);
|
||||
}
|
||||
|
||||
/* Add source map */
|
||||
if (NULL != def->sourcemap) {
|
||||
JanetArray *sourcemap = janet_array(def->bytecode_length);
|
||||
for (i = 0; i < def->bytecode_length; i++) {
|
||||
Janet *t = janet_tuple_begin(2);
|
||||
JanetSourceMapping mapping = def->sourcemap[i];
|
||||
t[0] = janet_wrap_integer(mapping.line);
|
||||
t[1] = janet_wrap_integer(mapping.column);
|
||||
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
||||
}
|
||||
sourcemap->count = def->bytecode_length;
|
||||
janet_table_put(ret, janet_csymbolv("sourcemap"), janet_wrap_array(sourcemap));
|
||||
static Janet janet_disasm_source(JanetFuncDef *def) {
|
||||
if (def->source != NULL) return janet_wrap_string(def->source);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_disasm_name(JanetFuncDef *def) {
|
||||
if (def->name != NULL) return janet_wrap_string(def->name);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_disasm_vararg(JanetFuncDef *def) {
|
||||
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_constants(JanetFuncDef *def) {
|
||||
JanetArray *constants = janet_array(def->constants_length);
|
||||
for (int32_t i = 0; i < def->constants_length; i++) {
|
||||
constants->data[i] = def->constants[i];
|
||||
}
|
||||
constants->count = def->constants_length;
|
||||
return janet_wrap_array(constants);
|
||||
}
|
||||
|
||||
/* Add environments */
|
||||
if (NULL != def->environments) {
|
||||
JanetArray *envs = janet_array(def->environments_length);
|
||||
for (i = 0; i < def->environments_length; i++) {
|
||||
envs->data[i] = janet_wrap_integer(def->environments[i]);
|
||||
}
|
||||
envs->count = def->environments_length;
|
||||
janet_table_put(ret, janet_csymbolv("environments"), janet_wrap_array(envs));
|
||||
static Janet janet_disasm_sourcemap(JanetFuncDef *def) {
|
||||
if (NULL == def->sourcemap) return janet_wrap_nil();
|
||||
JanetArray *sourcemap = janet_array(def->bytecode_length);
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
Janet *t = janet_tuple_begin(2);
|
||||
JanetSourceMapping mapping = def->sourcemap[i];
|
||||
t[0] = janet_wrap_integer(mapping.line);
|
||||
t[1] = janet_wrap_integer(mapping.column);
|
||||
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
||||
}
|
||||
sourcemap->count = def->bytecode_length;
|
||||
return janet_wrap_array(sourcemap);
|
||||
}
|
||||
|
||||
/* Add closures */
|
||||
/* Funcdefs cannot be recursive */
|
||||
if (NULL != def->defs) {
|
||||
JanetArray *defs = janet_array(def->defs_length);
|
||||
for (i = 0; i < def->defs_length; i++) {
|
||||
defs->data[i] = janet_disasm(def->defs[i]);
|
||||
}
|
||||
defs->count = def->defs_length;
|
||||
janet_table_put(ret, janet_csymbolv("defs"), janet_wrap_array(defs));
|
||||
static Janet janet_disasm_environments(JanetFuncDef *def) {
|
||||
JanetArray *envs = janet_array(def->environments_length);
|
||||
for (int32_t i = 0; i < def->environments_length; i++) {
|
||||
envs->data[i] = janet_wrap_integer(def->environments[i]);
|
||||
}
|
||||
envs->count = def->environments_length;
|
||||
return janet_wrap_array(envs);
|
||||
}
|
||||
|
||||
/* Add slotcount */
|
||||
janet_table_put(ret, janet_csymbolv("slotcount"), janet_wrap_integer(def->slotcount));
|
||||
static Janet janet_disasm_defs(JanetFuncDef *def) {
|
||||
JanetArray *defs = janet_array(def->defs_length);
|
||||
for (int32_t i = 0; i < def->defs_length; i++) {
|
||||
defs->data[i] = janet_disasm(def->defs[i]);
|
||||
}
|
||||
defs->count = def->defs_length;
|
||||
return janet_wrap_array(defs);
|
||||
}
|
||||
|
||||
Janet janet_disasm(JanetFuncDef *def) {
|
||||
JanetTable *ret = janet_table(10);
|
||||
janet_table_put(ret, janet_ckeywordv("arity"), janet_disasm_arity(def));
|
||||
janet_table_put(ret, janet_ckeywordv("min-arity"), janet_disasm_min_arity(def));
|
||||
janet_table_put(ret, janet_ckeywordv("max-arity"), janet_disasm_max_arity(def));
|
||||
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_disasm_bytecode(def));
|
||||
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
|
||||
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
|
||||
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
|
||||
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
|
||||
janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def));
|
||||
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_disasm_sourcemap(def));
|
||||
janet_table_put(ret, janet_ckeywordv("environments"), janet_disasm_environments(def));
|
||||
janet_table_put(ret, janet_ckeywordv("defs"), janet_disasm_defs(def));
|
||||
return janet_wrap_struct(janet_table_to_struct(ret));
|
||||
}
|
||||
|
||||
/* C Function for assembly */
|
||||
static Janet cfun_asm(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 1);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetAssembleResult res;
|
||||
res = janet_asm(argv[0], 0);
|
||||
if (res.status != JANET_ASSEMBLE_OK) {
|
||||
@@ -943,9 +954,26 @@ static Janet cfun_asm(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_disasm(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 1);
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *f = janet_getfunction(argv, 0);
|
||||
return janet_disasm(f->def);
|
||||
if (argc == 2) {
|
||||
JanetKeyword kw = janet_getkeyword(argv, 1);
|
||||
if (!janet_cstrcmp(kw, "arity")) return janet_disasm_arity(f->def);
|
||||
if (!janet_cstrcmp(kw, "min-arity")) return janet_disasm_min_arity(f->def);
|
||||
if (!janet_cstrcmp(kw, "max-arity")) return janet_disasm_max_arity(f->def);
|
||||
if (!janet_cstrcmp(kw, "bytecode")) return janet_disasm_bytecode(f->def);
|
||||
if (!janet_cstrcmp(kw, "source")) return janet_disasm_source(f->def);
|
||||
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
|
||||
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
|
||||
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
|
||||
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
|
||||
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
|
||||
if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def);
|
||||
if (!janet_cstrcmp(kw, "defs")) return janet_disasm_defs(f->def);
|
||||
janet_panicf("unknown disasm key %v", argv[1]);
|
||||
} else {
|
||||
return janet_disasm(f->def);
|
||||
}
|
||||
}
|
||||
|
||||
static const JanetReg asm_cfuns[] = {
|
||||
@@ -953,15 +981,29 @@ static const JanetReg asm_cfuns[] = {
|
||||
"asm", cfun_asm,
|
||||
JDOC("(asm assembly)\n\n"
|
||||
"Returns a new function that is the compiled result of the assembly.\n"
|
||||
"The syntax for the assembly can be found on the janet wiki. Will throw an\n"
|
||||
"The syntax for the assembly can be found on the Janet website, and should correspond\n"
|
||||
"to the return value of disasm. Will throw an\n"
|
||||
"error on invalid assembly.")
|
||||
},
|
||||
{
|
||||
"disasm", cfun_disasm,
|
||||
JDOC("(disasm func)\n\n"
|
||||
JDOC("(disasm func &opt field)\n\n"
|
||||
"Returns assembly that could be used be compile the given function.\n"
|
||||
"func must be a function, not a c function. Will throw on error on a badly\n"
|
||||
"typed argument.")
|
||||
"typed argument. If given a field name, will only return that part of the function assembly.\n"
|
||||
"Possible fields are:\n\n"
|
||||
"\t:arity - number of required and optional arguments.\n"
|
||||
"\t:min-arity - minimum number of arguments function can be called with.\n"
|
||||
"\t:max-arity - maximum number of arguments function can be called with.\n"
|
||||
"\t:vararg - true if function can take a variable number of arguments.\n"
|
||||
"\t:bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n"
|
||||
"\t:source - name of source file that this function was compiled from.\n"
|
||||
"\t:name - name of function.\n"
|
||||
"\t:slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n"
|
||||
"\t:constants - an array of constants referenced by this function.\n"
|
||||
"\t:sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
|
||||
"\t:environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
|
||||
"\t:defs - other function definitions that this function may instantiate.\n")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -32,7 +32,7 @@
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
uint8_t *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_vm_next_collection += capacity;
|
||||
janet_gcpressure(capacity);
|
||||
data = malloc(sizeof(uint8_t) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -62,7 +62,7 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
||||
if (capacity <= buffer->capacity) return;
|
||||
int64_t big_capacity = ((int64_t) capacity) * growth;
|
||||
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||
janet_vm_next_collection += capacity - buffer->capacity;
|
||||
janet_gcpressure(capacity - buffer->capacity);
|
||||
new_data = realloc(old, (size_t) capacity * sizeof(uint8_t));
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -94,7 +94,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
if (new_size > buffer->capacity) {
|
||||
int32_t new_capacity = new_size * 2;
|
||||
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||
janet_vm_next_collection += new_capacity - buffer->capacity;
|
||||
janet_gcpressure(new_capacity - buffer->capacity);
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -112,6 +112,7 @@ void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
||||
|
||||
/* Push multiple bytes into the buffer */
|
||||
void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) {
|
||||
if (0 == length) return;
|
||||
janet_buffer_extra(buffer, length);
|
||||
memcpy(buffer->data + buffer->count, string, length);
|
||||
buffer->count += length;
|
||||
@@ -196,6 +197,26 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
if (buffer->count) {
|
||||
if (buffer->count < buffer->capacity) {
|
||||
uint8_t *newData = realloc(buffer->data, buffer->count);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
buffer->data = newData;
|
||||
buffer->capacity = buffer->count;
|
||||
}
|
||||
} else {
|
||||
buffer->capacity = 0;
|
||||
free(buffer->data);
|
||||
buffer->data = NULL;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
@@ -333,16 +354,20 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||
} else {
|
||||
length_src = src.len - offset_src;
|
||||
}
|
||||
int64_t last = ((int64_t) offset_dest - offset_src) + length_src;
|
||||
int64_t last = (int64_t) offset_dest + length_src;
|
||||
if (last > INT32_MAX)
|
||||
janet_panic("buffer blit out of range");
|
||||
janet_buffer_ensure(dest, (int32_t) last, 2);
|
||||
if (last > dest->count) dest->count = (int32_t) last;
|
||||
if (same_buf) {
|
||||
src.bytes = dest->data;
|
||||
memmove(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
} else {
|
||||
memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
int32_t last32 = (int32_t) last;
|
||||
janet_buffer_ensure(dest, last32, 2);
|
||||
if (last32 > dest->count) dest->count = last32;
|
||||
if (length_src) {
|
||||
if (same_buf) {
|
||||
/* janet_buffer_ensure may have invalidated src */
|
||||
src.bytes = dest->data;
|
||||
memmove(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
} else {
|
||||
memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
}
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
@@ -374,6 +399,12 @@ static const JanetReg buffer_cfuns[] = {
|
||||
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
|
||||
"Returns the modified buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/trim", cfun_buffer_trim,
|
||||
JDOC("(buffer/trim buffer)\n\n"
|
||||
"Set the backing capacity of the buffer to the current length of the buffer. Returns the "
|
||||
"modified buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/push-byte", cfun_buffer_u8,
|
||||
JDOC("(buffer/push-byte buffer x)\n\n"
|
||||
@@ -384,7 +415,7 @@ static const JanetReg buffer_cfuns[] = {
|
||||
"buffer/push-word", cfun_buffer_word,
|
||||
JDOC("(buffer/push-word buffer x)\n\n"
|
||||
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
|
||||
"in twos complement, big endian order, unsigned. Returns the modified buffer. Will "
|
||||
"in twos complement, little endian order, unsigned. Returns the modified buffer. Will "
|
||||
"throw an error if the buffer overflows.")
|
||||
},
|
||||
{
|
||||
@@ -435,7 +466,7 @@ static const JanetReg buffer_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"buffer/blit", cfun_buffer_blit,
|
||||
JDOC("(buffer/blit dest src & opt dest-start src-start src-end)\n\n"
|
||||
JDOC("(buffer/blit dest src &opt dest-start src-start src-end)\n\n"
|
||||
"Insert the contents of src into dest. Can optionally take indices that "
|
||||
"indicate which part of src to copy into which part of dest. Indices can be "
|
||||
"negative to index from the end of src or dest. Returns dest.")
|
||||
|
||||
@@ -41,6 +41,8 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_SSS, /* JOP_MULTIPLY, */
|
||||
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_DIVIDE, */
|
||||
JINT_SSS, /* JOP_MODULO, */
|
||||
JINT_SSS, /* JOP_REMAINDER, */
|
||||
JINT_SSS, /* JOP_BAND, */
|
||||
JINT_SSS, /* JOP_BOR, */
|
||||
JINT_SSS, /* JOP_BXOR, */
|
||||
@@ -56,6 +58,8 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_L, /* JOP_JUMP, */
|
||||
JINT_SL, /* JOP_JUMP_IF, */
|
||||
JINT_SL, /* JOP_JUMP_IF_NOT, */
|
||||
JINT_SL, /* JOP_JUMP_IF_NIL, */
|
||||
JINT_SL, /* JOP_JUMP_IF_NOT_NIL, */
|
||||
JINT_SSS, /* JOP_GREATER_THAN, */
|
||||
JINT_SSI, /* JOP_GREATER_THAN_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_LESS_THAN, */
|
||||
@@ -95,11 +99,15 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_S, /* JOP_MAKE_TUPLE */
|
||||
JINT_S, /* JOP_MAKE_BRACKET_TUPLE */
|
||||
JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
|
||||
JINT_SSS /* JOP_LESS_THAN_EQUAL */
|
||||
JINT_SSS, /* JOP_LESS_THAN_EQUAL */
|
||||
JINT_SSS, /* JOP_NEXT */
|
||||
JINT_SSS, /* JOP_NOT_EQUALS, */
|
||||
JINT_SSI, /* JOP_NOT_EQUALS_IMMEDIATE, */
|
||||
JINT_SSS /* JOP_CANCEL, */
|
||||
};
|
||||
|
||||
/* Verify some bytecode */
|
||||
int32_t janet_verify(JanetFuncDef *def) {
|
||||
int janet_verify(JanetFuncDef *def) {
|
||||
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
||||
int32_t i;
|
||||
int32_t maxslot = def->arity + vargs;
|
||||
@@ -207,6 +215,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
|
||||
def->environments = NULL;
|
||||
def->constants = NULL;
|
||||
def->bytecode = NULL;
|
||||
def->closure_bitset = NULL;
|
||||
def->flags = 0;
|
||||
def->slotcount = 0;
|
||||
def->arity = 0;
|
||||
|
||||
@@ -27,6 +27,29 @@
|
||||
#include "fiber.h"
|
||||
#endif
|
||||
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <pthread.h>
|
||||
#else
|
||||
#include <windows.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
|
||||
#ifdef JANET_TOP_LEVEL_SIGNAL
|
||||
JANET_TOP_LEVEL_SIGNAL(msg);
|
||||
#else
|
||||
fputs(msg, stdout);
|
||||
# ifdef JANET_SINGLE_THREADED
|
||||
exit(-1);
|
||||
# elif defined(JANET_WINDOWS)
|
||||
ExitThread(-1);
|
||||
# else
|
||||
pthread_exit(NULL);
|
||||
# endif
|
||||
#endif
|
||||
}
|
||||
|
||||
void janet_signalv(JanetSignal sig, Janet message) {
|
||||
if (janet_vm_return_reg != NULL) {
|
||||
*janet_vm_return_reg = message;
|
||||
@@ -37,8 +60,8 @@ void janet_signalv(JanetSignal sig, Janet message) {
|
||||
longjmp(*janet_vm_jmp_buf, sig);
|
||||
#endif
|
||||
} else {
|
||||
fputs((const char *)janet_formatc("janet top level signal - %v\n", message), stdout);
|
||||
exit(1);
|
||||
const char *str = (const char *)janet_formatc("janet top level signal - %v\n", message);
|
||||
janet_top_level_signal(str);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -54,7 +77,7 @@ void janet_panicf(const char *format, ...) {
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
janet_formatb(&buffer, format, args);
|
||||
janet_formatbv(&buffer, format, args);
|
||||
va_end(args);
|
||||
ret = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
@@ -235,18 +258,20 @@ size_t janet_getsize(const Janet *argv, int32_t n) {
|
||||
|
||||
int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||
int32_t raw = janet_getinteger(argv, n);
|
||||
if (raw < 0) raw += length + 1;
|
||||
if (raw < 0 || raw > length)
|
||||
janet_panicf("%s index %d out of range [0,%d]", which, raw, length);
|
||||
return raw;
|
||||
int32_t not_raw = raw;
|
||||
if (not_raw < 0) not_raw += length + 1;
|
||||
if (not_raw < 0 || not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
|
||||
return not_raw;
|
||||
}
|
||||
|
||||
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||
int32_t raw = janet_getinteger(argv, n);
|
||||
if (raw < 0) raw += length;
|
||||
if (raw < 0 || raw > length)
|
||||
janet_panicf("%s index %d out of range [0,%d)", which, raw, length);
|
||||
return raw;
|
||||
int32_t not_raw = raw;
|
||||
if (not_raw < 0) not_raw += length;
|
||||
if (not_raw < 0 || not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length);
|
||||
return not_raw;
|
||||
}
|
||||
|
||||
JanetView janet_getindexed(const Janet *argv, int32_t n) {
|
||||
@@ -314,7 +339,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
||||
}
|
||||
|
||||
Janet janet_dyn(const char *name) {
|
||||
if (!janet_vm_fiber) return janet_wrap_nil();
|
||||
if (!janet_vm_fiber) {
|
||||
if (!janet_vm_top_dyns) return janet_wrap_nil();
|
||||
return janet_table_get(janet_vm_top_dyns, janet_ckeywordv(name));
|
||||
}
|
||||
if (janet_vm_fiber->env) {
|
||||
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
|
||||
} else {
|
||||
@@ -323,11 +351,15 @@ Janet janet_dyn(const char *name) {
|
||||
}
|
||||
|
||||
void janet_setdyn(const char *name, Janet value) {
|
||||
if (!janet_vm_fiber) return;
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(1);
|
||||
if (!janet_vm_fiber) {
|
||||
if (!janet_vm_top_dyns) janet_vm_top_dyns = janet_table(10);
|
||||
janet_table_put(janet_vm_top_dyns, janet_ckeywordv(name), value);
|
||||
} else {
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(1);
|
||||
}
|
||||
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
|
||||
}
|
||||
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
|
||||
}
|
||||
|
||||
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {
|
||||
|
||||
171
src/core/cfuns.c
171
src/core/cfuns.c
@@ -28,6 +28,16 @@
|
||||
#include "vector.h"
|
||||
#endif
|
||||
|
||||
static int arity1or2(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
int32_t arity = janet_v_count(args);
|
||||
return arity == 1 || arity == 2;
|
||||
}
|
||||
static int arity2or3(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
int32_t arity = janet_v_count(args);
|
||||
return arity == 2 || arity == 3;
|
||||
}
|
||||
static int fixarity1(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
return janet_v_count(args) == 1;
|
||||
@@ -63,34 +73,89 @@ static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
|
||||
return target;
|
||||
}
|
||||
|
||||
/* Emit an insruction that implements a form by itself. */
|
||||
static JanetSlot opfunction(
|
||||
JanetFopts opts,
|
||||
JanetSlot *args,
|
||||
int op,
|
||||
Janet defaultArg2) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
int32_t len;
|
||||
len = janet_v_count(args);
|
||||
JanetSlot t;
|
||||
if (len == 1) {
|
||||
t = janetc_gettarget(opts);
|
||||
janetc_emit_sss(c, op, t, args[0], janetc_cslot(defaultArg2), 1);
|
||||
return t;
|
||||
} else {
|
||||
/* len == 2 */
|
||||
t = janetc_gettarget(opts);
|
||||
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
/* Check if a value can be coerced to an immediate value */
|
||||
static int can_be_imm(Janet x, int8_t *out) {
|
||||
if (!janet_checkint(x)) return 0;
|
||||
int32_t integer = janet_unwrap_integer(x);
|
||||
if (integer > 127 || integer < -127) return 0;
|
||||
*out = (int8_t) integer;
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Check if a slot can be coerced to an immediate value */
|
||||
static int can_slot_be_imm(JanetSlot s, int8_t *out) {
|
||||
if (!(s.flags & JANET_SLOT_CONSTANT)) return 0;
|
||||
return can_be_imm(s.constant, out);
|
||||
}
|
||||
|
||||
/* Emit a series of instructions instead of a function call to a math op */
|
||||
static JanetSlot opreduce(
|
||||
JanetFopts opts,
|
||||
JanetSlot *args,
|
||||
int op,
|
||||
int opim,
|
||||
Janet nullary) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
int32_t i, len;
|
||||
int8_t imm = 0;
|
||||
int neg = opim < 0;
|
||||
if (opim < 0) opim = -opim;
|
||||
len = janet_v_count(args);
|
||||
JanetSlot t;
|
||||
if (len == 0) {
|
||||
return janetc_cslot(nullary);
|
||||
} else if (len == 1) {
|
||||
t = janetc_gettarget(opts);
|
||||
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
|
||||
/* Special case subtract to be times -1 */
|
||||
if (op == JOP_SUBTRACT) {
|
||||
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
t = janetc_gettarget(opts);
|
||||
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
||||
for (i = 2; i < len; i++)
|
||||
janetc_emit_sss(c, op, t, t, args[i], 1);
|
||||
if (opim && can_slot_be_imm(args[1], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
||||
}
|
||||
for (i = 2; i < len; i++) {
|
||||
if (opim && can_slot_be_imm(args[i], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, t, args[i], 1);
|
||||
}
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
/* Function optimizers */
|
||||
|
||||
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_PROPAGATE, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
||||
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
||||
@@ -107,10 +172,40 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
|
||||
return t;
|
||||
}
|
||||
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_IN, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
||||
if (janet_v_count(args) == 3) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
JanetSlot t = janetc_gettarget(opts);
|
||||
int target_is_default = janetc_sequal(t, args[2]);
|
||||
JanetSlot dflt_slot = args[2];
|
||||
if (target_is_default) {
|
||||
dflt_slot = janetc_farslot(c);
|
||||
janetc_copy(c, dflt_slot, t);
|
||||
}
|
||||
janetc_emit_sss(c, JOP_GET, t, args[0], args[1], 1);
|
||||
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT_NIL, t, 0, 0);
|
||||
janetc_copy(c, t, dflt_slot);
|
||||
if (target_is_default) janetc_freeslot(c, dflt_slot);
|
||||
int32_t current = janet_v_count(c->buffer);
|
||||
c->buffer[label] |= (current - label) << 16;
|
||||
return t;
|
||||
} else {
|
||||
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
|
||||
}
|
||||
}
|
||||
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
|
||||
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||
if (opts.flags & JANET_FOPTS_DROP) {
|
||||
@@ -134,7 +229,10 @@ static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
|
||||
}
|
||||
}
|
||||
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_RESUME, janet_wrap_nil());
|
||||
return opfunction(opts, args, JOP_RESUME, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_cancel(JanetFopts opts, JanetSlot *args) {
|
||||
return opfunction(opts, args, JOP_CANCEL, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
||||
/* Push phase */
|
||||
@@ -164,34 +262,34 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
||||
/* Variadic operators specialization */
|
||||
|
||||
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_ADD, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SUBTRACT, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MULTIPLY, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_DIVIDE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BAND, janet_wrap_integer(-1));
|
||||
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
|
||||
}
|
||||
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BOR, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BXOR, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_LEFT, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
|
||||
return genericSS(opts, JOP_BNOT, args[0]);
|
||||
@@ -202,9 +300,11 @@ static JanetSlot compreduce(
|
||||
JanetFopts opts,
|
||||
JanetSlot *args,
|
||||
int op,
|
||||
int opim,
|
||||
int invert) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
int32_t i, len;
|
||||
int8_t imm = 0;
|
||||
len = janet_v_count(args);
|
||||
int32_t *labels = NULL;
|
||||
JanetSlot t;
|
||||
@@ -215,19 +315,17 @@ static JanetSlot compreduce(
|
||||
}
|
||||
t = janetc_gettarget(opts);
|
||||
for (i = 1; i < len; i++) {
|
||||
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
|
||||
if (opim && can_slot_be_imm(args[i], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, args[i - 1], imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
|
||||
}
|
||||
if (i != (len - 1)) {
|
||||
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT, t, 0, 1);
|
||||
int32_t label = janetc_emit_si(c, invert ? JOP_JUMP_IF : JOP_JUMP_IF_NOT, t, 0, 1);
|
||||
janet_v_push(labels, label);
|
||||
}
|
||||
}
|
||||
int32_t end = janet_v_count(c->buffer);
|
||||
if (invert) {
|
||||
janetc_emit_si(c, JOP_JUMP_IF, t, 3, 0);
|
||||
janetc_emit_s(c, JOP_LOAD_TRUE, t, 1);
|
||||
janetc_emit(c, JOP_JUMP | (2 << 8));
|
||||
janetc_emit_s(c, JOP_LOAD_FALSE, t, 1);
|
||||
}
|
||||
for (i = 0; i < janet_v_count(labels); i++) {
|
||||
int32_t label = labels[i];
|
||||
c->buffer[label] |= ((end - label) << 16);
|
||||
@@ -237,22 +335,22 @@ static JanetSlot compreduce(
|
||||
}
|
||||
|
||||
static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_GREATER_THAN, 0);
|
||||
return compreduce(opts, args, JOP_GREATER_THAN, JOP_GREATER_THAN_IMMEDIATE, 0);
|
||||
}
|
||||
static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_LESS_THAN, 0);
|
||||
return compreduce(opts, args, JOP_LESS_THAN, JOP_LESS_THAN_IMMEDIATE, 0);
|
||||
}
|
||||
static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0);
|
||||
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0, 0);
|
||||
}
|
||||
static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0);
|
||||
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0, 0);
|
||||
}
|
||||
static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_EQUALS, 0);
|
||||
return compreduce(opts, args, JOP_EQUALS, JOP_EQUALS_IMMEDIATE, 0);
|
||||
}
|
||||
static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_EQUALS, 1);
|
||||
return compreduce(opts, args, JOP_NOT_EQUALS, JOP_NOT_EQUALS_IMMEDIATE, 1);
|
||||
}
|
||||
|
||||
/* Arranged by tag */
|
||||
@@ -261,7 +359,7 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{fixarity1, do_error},
|
||||
{minarity2, do_apply},
|
||||
{maxarity1, do_yield},
|
||||
{fixarity2, do_resume},
|
||||
{arity1or2, do_resume},
|
||||
{fixarity2, do_in},
|
||||
{fixarity3, do_put},
|
||||
{fixarity1, do_length},
|
||||
@@ -283,7 +381,12 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{NULL, do_eq},
|
||||
{NULL, do_neq},
|
||||
{fixarity2, do_propagate},
|
||||
{fixarity2, do_get}
|
||||
{arity2or3, do_get},
|
||||
{arity1or2, do_next},
|
||||
{fixarity2, do_modulo},
|
||||
{fixarity2, do_remainder},
|
||||
{fixarity2, do_cmp},
|
||||
{fixarity2, do_cancel},
|
||||
};
|
||||
|
||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||
|
||||
@@ -102,6 +102,7 @@ void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name)
|
||||
scope.bytecode_start = janet_v_count(c->buffer);
|
||||
scope.flags = flags;
|
||||
scope.parent = c->scope;
|
||||
janetc_regalloc_init(&scope.ua);
|
||||
/* Inherit slots */
|
||||
if ((!(flags & JANET_SCOPE_FUNCTION)) && c->scope) {
|
||||
janetc_regalloc_clone(&scope.ra, &(c->scope->ra));
|
||||
@@ -149,6 +150,7 @@ void janetc_popscope(JanetCompiler *c) {
|
||||
janet_v_free(oldscope->envs);
|
||||
janet_v_free(oldscope->defs);
|
||||
janetc_regalloc_deinit(&oldscope->ra);
|
||||
janetc_regalloc_deinit(&oldscope->ua);
|
||||
/* Update pointer */
|
||||
if (newscope)
|
||||
newscope->child = NULL;
|
||||
@@ -202,7 +204,7 @@ JanetSlot janetc_resolve(
|
||||
switch (btype) {
|
||||
default:
|
||||
case JANET_BINDING_NONE:
|
||||
janetc_error(c, janet_formatc("unknown symbol %q", sym));
|
||||
janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym)));
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
case JANET_BINDING_DEF:
|
||||
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
||||
@@ -236,6 +238,11 @@ found:
|
||||
scope = scope->parent;
|
||||
janet_assert(scope, "invalid scopes");
|
||||
scope->flags |= JANET_SCOPE_ENV;
|
||||
|
||||
/* In the function scope, allocate the slot as an upvalue */
|
||||
janetc_regalloc_touch(&scope->ua, ret.index);
|
||||
|
||||
/* Iterate through child scopes and make sure environment is propagated */
|
||||
scope = scope->child;
|
||||
|
||||
/* Propagate env up to current scope */
|
||||
@@ -455,6 +462,7 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
||||
break;
|
||||
case JANET_CFUNCTION:
|
||||
case JANET_ABSTRACT:
|
||||
case JANET_NIL:
|
||||
break;
|
||||
case JANET_KEYWORD:
|
||||
if (min_arity == 0) {
|
||||
@@ -588,8 +596,11 @@ static int macroexpand1(
|
||||
/* Set env */
|
||||
fiberp->env = c->env;
|
||||
int lock = janet_gclock();
|
||||
Janet mf_kw = janet_ckeywordv("macro-form");
|
||||
janet_table_put(c->env, mf_kw, x);
|
||||
Janet tempOut;
|
||||
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
|
||||
janet_table_put(c->env, mf_kw, janet_wrap_nil());
|
||||
janet_gcunlock(lock);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
const uint8_t *es = janet_formatc("(macro) %V", tempOut);
|
||||
@@ -687,7 +698,32 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Add function flags to janet functions */
|
||||
void janet_def_addflags(JanetFuncDef *def) {
|
||||
int32_t set_flags = 0;
|
||||
int32_t unset_flags = 0;
|
||||
/* pos checks */
|
||||
if (def->name) set_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (def->source) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (def->defs) set_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (def->environments) set_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (def->sourcemap) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
if (def->closure_bitset) set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||
/* negative checks */
|
||||
if (!def->name) unset_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (!def->source) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (!def->defs) unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (!def->environments) unset_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (!def->sourcemap) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||
/* Update flags */
|
||||
def->flags |= set_flags;
|
||||
def->flags &= ~unset_flags;
|
||||
}
|
||||
|
||||
/* Compile a funcdef */
|
||||
/* Once the various other settings of the FuncDef have been tweaked,
|
||||
* call janet_def_addflags to set the proper flags for the funcdef */
|
||||
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
JanetScope *scope = c->scope;
|
||||
JanetFuncDef *def = janet_funcdef_alloc();
|
||||
@@ -713,7 +749,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
if (NULL == def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
|
||||
safe_memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
|
||||
janet_v__cnt(c->buffer) = scope->bytecode_start;
|
||||
if (NULL != c->mapbuffer && c->source) {
|
||||
size_t s = sizeof(JanetSourceMapping) * (size_t) def->bytecode_length;
|
||||
@@ -721,7 +757,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s);
|
||||
safe_memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s);
|
||||
janet_v__cnt(c->mapbuffer) = scope->bytecode_start;
|
||||
}
|
||||
}
|
||||
@@ -736,6 +772,22 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
|
||||
}
|
||||
|
||||
/* Copy upvalue bitset */
|
||||
if (scope->ua.count) {
|
||||
/* Number of u32s we need to create a bitmask for all slots */
|
||||
int32_t slotchunks = (def->slotcount + 31) >> 5;
|
||||
/* numchunks is min of slotchunks and scope->ua.count */
|
||||
int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
|
||||
uint32_t *chunks = calloc(sizeof(uint32_t), slotchunks);
|
||||
if (NULL == chunks) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(chunks, scope->ua.chunks, sizeof(uint32_t) * numchunks);
|
||||
/* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
|
||||
if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
|
||||
def->closure_bitset = chunks;
|
||||
}
|
||||
|
||||
/* Pop the scope */
|
||||
janetc_popscope(c);
|
||||
|
||||
@@ -790,6 +842,7 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
||||
if (c.result.status == JANET_COMPILE_OK) {
|
||||
JanetFuncDef *def = janetc_pop_funcdef(&c);
|
||||
def->name = janet_cstring("_thunk");
|
||||
janet_def_addflags(def);
|
||||
c.result.funcdef = def;
|
||||
} else {
|
||||
c.result.error_mapping = c.current_mapping;
|
||||
@@ -832,10 +885,10 @@ static const JanetReg compile_cfuns[] = {
|
||||
{
|
||||
"compile", cfun,
|
||||
JDOC("(compile ast &opt env source)\n\n"
|
||||
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
||||
"Compiles an Abstract Syntax Tree (ast) into a function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||
"error if the ast cannot be compiled.")
|
||||
"eval. Returns a new function and does not modify ast. Returns an error "
|
||||
"struct with keys :line, :column, and :error if compilation fails.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -57,6 +57,11 @@
|
||||
#define JANET_FUN_NEQ 25
|
||||
#define JANET_FUN_PROP 26
|
||||
#define JANET_FUN_GET 27
|
||||
#define JANET_FUN_NEXT 28
|
||||
#define JANET_FUN_MODULO 29
|
||||
#define JANET_FUN_REMAINDER 30
|
||||
#define JANET_FUN_CMP 31
|
||||
#define JANET_FUN_CANCEL 32
|
||||
|
||||
/* Compiler typedefs */
|
||||
typedef struct JanetCompiler JanetCompiler;
|
||||
@@ -124,7 +129,10 @@ struct JanetScope {
|
||||
/* Regsiter allocator */
|
||||
JanetcRegisterAllocator ra;
|
||||
|
||||
/* Referenced closure environents. The values at each index correspond
|
||||
/* Upvalue allocator */
|
||||
JanetcRegisterAllocator ua;
|
||||
|
||||
/* Referenced closure environments. The values at each index correspond
|
||||
* to which index to get the environment from in the parent. The environment
|
||||
* that corresponds to the direct parent's stack will always have value 0. */
|
||||
int32_t *envs;
|
||||
|
||||
@@ -63,10 +63,29 @@ typedef void *Clib;
|
||||
#define error_clib() dlerror()
|
||||
#endif
|
||||
|
||||
static char *get_processed_name(const char *name) {
|
||||
if (name[0] == '.') return (char *) name;
|
||||
const char *c;
|
||||
for (c = name; *c; c++) {
|
||||
if (*c == '/') return (char *) name;
|
||||
}
|
||||
size_t l = (size_t)(c - name);
|
||||
char *ret = malloc(l + 3);
|
||||
if (NULL == ret) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
ret[0] = '.';
|
||||
ret[1] = '/';
|
||||
memcpy(ret + 2, name, l + 1);
|
||||
return ret;
|
||||
}
|
||||
|
||||
JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
Clib lib = load_clib(name);
|
||||
char *processed_name = get_processed_name(name);
|
||||
Clib lib = load_clib(processed_name);
|
||||
JanetModule init;
|
||||
JanetModconf getter;
|
||||
if (name != processed_name) free(processed_name);
|
||||
if (!lib) {
|
||||
*error = janet_cstring(error_clib());
|
||||
return NULL;
|
||||
@@ -346,7 +365,7 @@ static Janet janet_core_tuple(int32_t argc, Janet *argv) {
|
||||
static Janet janet_core_array(int32_t argc, Janet *argv) {
|
||||
JanetArray *array = janet_array(argc);
|
||||
array->count = argc;
|
||||
memcpy(array->data, argv, argc * sizeof(Janet));
|
||||
safe_memcpy(array->data, argv, argc * sizeof(Janet));
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
@@ -404,9 +423,11 @@ static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
size_t s = janet_getsize(argv, 0);
|
||||
/* limit interval to 48 bits */
|
||||
if (s > 0xFFFFFFFFFFFFUl) {
|
||||
#ifdef JANET_64
|
||||
if (s >> 48) {
|
||||
janet_panic("interval too large");
|
||||
}
|
||||
#endif
|
||||
janet_vm_gc_interval = s;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
@@ -427,20 +448,6 @@ static Janet janet_core_type(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet janet_core_next(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetDictView view = janet_getdictionary(argv, 0);
|
||||
const JanetKV *end = view.kvs + view.cap;
|
||||
const JanetKV *kv = janet_checktype(argv[1], JANET_NIL)
|
||||
? view.kvs
|
||||
: janet_dict_find(view.kvs, view.cap, argv[1]) + 1;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) return kv->key;
|
||||
kv++;
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_number(janet_hash(argv[0]));
|
||||
@@ -449,7 +456,7 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
||||
static Janet janet_core_getline(int32_t argc, Janet *argv) {
|
||||
FILE *in = janet_dynfile("in", stdin);
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
janet_arity(argc, 0, 2);
|
||||
janet_arity(argc, 0, 3);
|
||||
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||
if (argc >= 1) {
|
||||
const char *prompt = (const char *) janet_getstring(argv, 0);
|
||||
@@ -503,6 +510,31 @@ ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
static Janet janet_core_signal(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
int sig;
|
||||
if (janet_checkint(argv[0])) {
|
||||
int32_t s = janet_unwrap_integer(argv[0]);
|
||||
if (s < 0 || s > 9) {
|
||||
janet_panicf("expected user signal between 0 and 9, got %d", s);
|
||||
}
|
||||
sig = JANET_SIGNAL_USER0 + s;
|
||||
} else {
|
||||
JanetKeyword kw = janet_getkeyword(argv, 0);
|
||||
if (!janet_cstrcmp(kw, "yield")) {
|
||||
sig = JANET_SIGNAL_YIELD;
|
||||
} else if (!janet_cstrcmp(kw, "error")) {
|
||||
sig = JANET_SIGNAL_ERROR;
|
||||
} else if (!janet_cstrcmp(kw, "debug")) {
|
||||
sig = JANET_SIGNAL_DEBUG;
|
||||
} else {
|
||||
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
|
||||
}
|
||||
}
|
||||
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||
janet_signalv(sig, payload);
|
||||
}
|
||||
|
||||
static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"native", janet_core_native,
|
||||
@@ -613,11 +645,10 @@ static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"type", janet_core_type,
|
||||
JDOC("(type x)\n\n"
|
||||
"Returns the type of x as a keyword symbol. x is one of\n"
|
||||
"Returns the type of x as a keyword. x is one of\n"
|
||||
"\t:nil\n"
|
||||
"\t:boolean\n"
|
||||
"\t:integer\n"
|
||||
"\t:real\n"
|
||||
"\t:number\n"
|
||||
"\t:array\n"
|
||||
"\t:tuple\n"
|
||||
"\t:table\n"
|
||||
@@ -628,28 +659,21 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"\t:keyword\n"
|
||||
"\t:function\n"
|
||||
"\t:cfunction\n\n"
|
||||
"or another symbol for an abstract type.")
|
||||
},
|
||||
{
|
||||
"next", janet_core_next,
|
||||
JDOC("(next dict &opt key)\n\n"
|
||||
"Gets the next key in a struct or table. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if they data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"returns nil, there are no more keys to iterate through. ")
|
||||
"or another keyword for an abstract type.")
|
||||
},
|
||||
{
|
||||
"hash", janet_core_hash,
|
||||
JDOC("(hash value)\n\n"
|
||||
"Gets a hash value for any janet value. The hash is an integer can be used "
|
||||
"as a cheap hash function for all janet objects. If two values are strictly equal, "
|
||||
"Gets a hash for any value. The hash is an integer can be used "
|
||||
"as a cheap hash function for all values. If two values are strictly equal, "
|
||||
"then they will have the same hash value.")
|
||||
},
|
||||
{
|
||||
"getline", janet_core_getline,
|
||||
JDOC("(getline &opt prompt buf)\n\n"
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. Returns the modified buffer. "
|
||||
JDOC("(getline &opt prompt buf env)\n\n"
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. "
|
||||
"An optional environment table can be provided for auto-complete. "
|
||||
"Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.")
|
||||
},
|
||||
{
|
||||
@@ -682,9 +706,9 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"\t:all:\tthe value of path verbatim\n"
|
||||
"\t:cur:\tthe current file, or (dyn :current-file)\n"
|
||||
"\t:dir:\tthe directory containing the current file\n"
|
||||
"\t:name:\tthe filename component of path, with extenion if given\n"
|
||||
"\t:name:\tthe name component of path, with extension if given\n"
|
||||
"\t:native:\tthe extension used to load natives, .so or .dll\n"
|
||||
"\t:sys:\tthe system path, or (syn :syspath)")
|
||||
"\t:sys:\tthe system path, or (dyn :syspath)")
|
||||
},
|
||||
{
|
||||
"int?", janet_core_check_int,
|
||||
@@ -699,7 +723,12 @@ static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"slice", janet_core_slice,
|
||||
JDOC("(slice x &opt start end)\n\n"
|
||||
"Extract a sub-range of an indexed data strutrue or byte sequence.")
|
||||
"Extract a sub-range of an indexed data structure or byte sequence.")
|
||||
},
|
||||
{
|
||||
"signal", janet_core_signal,
|
||||
JDOC("(signal what x)\n\n"
|
||||
"Raise a signal with payload x. ")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
@@ -731,10 +760,11 @@ static void janet_quick_asm(
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(def->bytecode, bytecode, bytecode_size);
|
||||
janet_def_addflags(def);
|
||||
janet_def(env, name, janet_wrap_function(janet_thunk(def)), doc);
|
||||
}
|
||||
|
||||
/* Macros for easier inline janet assembly */
|
||||
/* Macros for easier inline assembly */
|
||||
#define SSS(op, a, b, c) ((op) | ((a) << 8) | ((b) << 16) | ((c) << 24))
|
||||
#define SS(op, a, b) ((op) | ((a) << 8) | ((b) << 16))
|
||||
#define SSI(op, a, b, I) ((op) | ((a) << 8) | ((b) << 16) | ((uint32_t)(I) << 24))
|
||||
@@ -916,6 +946,10 @@ static const uint32_t resume_asm[] = {
|
||||
JOP_RESUME | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t cancel_asm[] = {
|
||||
JOP_CANCEL | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t in_asm[] = {
|
||||
JOP_IN | (1 << 24),
|
||||
JOP_LOAD_NIL | (3 << 8),
|
||||
@@ -948,6 +982,22 @@ static const uint32_t propagate_asm[] = {
|
||||
JOP_PROPAGATE | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t next_asm[] = {
|
||||
JOP_NEXT | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t modulo_asm[] = {
|
||||
JOP_MODULO | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t remainder_asm[] = {
|
||||
JOP_REMAINDER | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t cmp_asm[] = {
|
||||
JOP_COMPARE | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
#endif /* ifdef JANET_BOOTSTRAP */
|
||||
|
||||
/*
|
||||
@@ -984,19 +1034,47 @@ static void janet_load_libs(JanetTable *env) {
|
||||
#ifdef JANET_THREADS
|
||||
janet_lib_thread(env);
|
||||
#endif
|
||||
#ifdef JANET_EV
|
||||
janet_lib_ev(env);
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
janet_lib_net(env);
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
|
||||
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
|
||||
janet_quick_asm(env, JANET_FUN_MODULO,
|
||||
"mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
|
||||
JDOC("(mod dividend divisor)\n\n"
|
||||
"Returns the modulo of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_REMAINDER,
|
||||
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_CMP,
|
||||
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
|
||||
JDOC("(cmp x y)\n\n"
|
||||
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
|
||||
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
|
||||
janet_quick_asm(env, JANET_FUN_NEXT,
|
||||
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
|
||||
JDOC("(next ds &opt key)\n\n"
|
||||
"Gets the next key in a data structure. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if they data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"returns nil, there are no more keys to iterate through."));
|
||||
janet_quick_asm(env, JANET_FUN_PROP,
|
||||
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
|
||||
JDOC("(propagate x fiber)\n\n"
|
||||
"Propagate a signal from a fiber to the current fiber. The resulting "
|
||||
"stack trace from the current fiber will include frames from fiber. If "
|
||||
"fiber is in a state that can be resumed, resuming the current fiber will "
|
||||
"first resume fiber."));
|
||||
"first resume fiber. This function can be used to re-raise an error without "
|
||||
"losing the original stack trace."));
|
||||
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
|
||||
JDOC("(debug &opt x)\n\n"
|
||||
@@ -1012,6 +1090,11 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||
"return the value that was passed to resume."));
|
||||
janet_quick_asm(env, JANET_FUN_CANCEL,
|
||||
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
|
||||
JDOC("(cancel fiber err)\n\n"
|
||||
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
|
||||
"Returns the same result as resume."));
|
||||
janet_quick_asm(env, JANET_FUN_RESUME,
|
||||
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
|
||||
JDOC("(resume fiber &opt x)\n\n"
|
||||
@@ -1068,7 +1151,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JDOC("(/ & xs)\n\n"
|
||||
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values. Division by two integers uses truncating division."));
|
||||
"values."));
|
||||
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
|
||||
JDOC("(band & xs)\n\n"
|
||||
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
|
||||
@@ -1095,22 +1178,22 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
/* Variadic comparators */
|
||||
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN,
|
||||
JDOC("(> & xs)\n\n"
|
||||
"Check if xs is in numerically descending order. Returns a boolean."));
|
||||
"Check if xs is in descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN,
|
||||
JDOC("(< & xs)\n\n"
|
||||
"Check if xs is in numerically ascending order. Returns a boolean."));
|
||||
"Check if xs is in ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL,
|
||||
JDOC("(>= & xs)\n\n"
|
||||
"Check if xs is in numerically non-ascending order. Returns a boolean."));
|
||||
"Check if xs is in non-ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL,
|
||||
JDOC("(<= & xs)\n\n"
|
||||
"Check if xs is in numerically non-descending order. Returns a boolean."));
|
||||
"Check if xs is in non-descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS,
|
||||
JDOC("(= & xs)\n\n"
|
||||
"Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean."));
|
||||
"Check if all values in xs are equal. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS,
|
||||
JDOC("(not= & xs)\n\n"
|
||||
"Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean."));
|
||||
"Check if any values in xs are not equal. Returns a boolean."));
|
||||
|
||||
/* Platform detection */
|
||||
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
|
||||
@@ -1138,7 +1221,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
}
|
||||
|
||||
/* Load core cfunctions (and some built in janet assembly functions) */
|
||||
JanetTable *dict = janet_table(300);
|
||||
JanetTable *dict = janet_table(512);
|
||||
janet_load_libs(dict);
|
||||
|
||||
/* Add replacements */
|
||||
|
||||
@@ -275,7 +275,7 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
}
|
||||
/* Add stack arguments */
|
||||
slots = janet_array(def->slotcount);
|
||||
memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
||||
safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
||||
slots->count = def->slotcount;
|
||||
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
|
||||
}
|
||||
|
||||
@@ -37,7 +37,7 @@ int32_t janetc_allocfar(JanetCompiler *c) {
|
||||
return reg;
|
||||
}
|
||||
|
||||
/* Get a register less than 256 */
|
||||
/* Get a register less than 256 for temporary use. */
|
||||
int32_t janetc_allocnear(JanetCompiler *c, JanetcRegisterTemp tag) {
|
||||
return janetc_regalloc_temp(&c->scope->ra, tag);
|
||||
}
|
||||
@@ -205,7 +205,7 @@ static int32_t janetc_regnear(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp
|
||||
}
|
||||
|
||||
/* Check if two slots are equal */
|
||||
static int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
|
||||
int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
|
||||
if ((lhs.flags & ~JANET_SLOTTYPE_ANY) == (rhs.flags & ~JANET_SLOTTYPE_ANY) &&
|
||||
lhs.index == rhs.index &&
|
||||
lhs.envindex == rhs.envindex) {
|
||||
@@ -245,8 +245,8 @@ void janetc_copy(
|
||||
janetc_moveback(c, dest, nearreg);
|
||||
/* Cleanup */
|
||||
janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
|
||||
|
||||
}
|
||||
|
||||
/* Instruction templated emitters */
|
||||
|
||||
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
|
||||
|
||||
@@ -42,6 +42,9 @@ int32_t janetc_emit_ssi(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2
|
||||
int32_t janetc_emit_ssu(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, uint8_t immediate, int wr);
|
||||
int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, JanetSlot s3, int wr);
|
||||
|
||||
/* Check if two slots are equivalent */
|
||||
int janetc_sequal(JanetSlot x, JanetSlot y);
|
||||
|
||||
/* Move value from one slot to another. Cannot copy to constant slots. */
|
||||
void janetc_copy(JanetCompiler *c, JanetSlot dest, JanetSlot src);
|
||||
|
||||
|
||||
1131
src/core/ev.c
Normal file
1131
src/core/ev.c
Normal file
File diff suppressed because it is too large
Load Diff
@@ -25,8 +25,31 @@
|
||||
#ifndef JANET_FEATURES_H_defined
|
||||
#define JANET_FEATURES_H_defined
|
||||
|
||||
#ifndef _POSIX_C_SOURCE
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \
|
||||
|| defined(__bsdi__) || defined(__DragonFly__)
|
||||
/* Use BSD soucre on any BSD systems, include OSX */
|
||||
# define _BSD_SOURCE
|
||||
#else
|
||||
/* Use POSIX feature flags */
|
||||
# ifndef _POSIX_C_SOURCE
|
||||
# define _POSIX_C_SOURCE 200809L
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#if defined(WIN32) || defined(_WIN32)
|
||||
#define WIN32_LEAN_AND_MEAN
|
||||
#endif
|
||||
|
||||
/* Needed for realpath on linux */
|
||||
#if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__))
|
||||
#define _XOPEN_SOURCE 500
|
||||
#endif
|
||||
|
||||
/* Needed for timegm and other extensions when building with -std=c99.
|
||||
* It also defines realpath, etc, which would normally require
|
||||
* _XOPEN_SOURCE >= 500. */
|
||||
#if !defined(_NETBSD_SOURCE) && defined(__NetBSD__)
|
||||
#define _NETBSD_SOURCE
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
163
src/core/fiber.c
163
src/core/fiber.c
@@ -37,6 +37,11 @@ static void fiber_reset(JanetFiber *fiber) {
|
||||
fiber->child = NULL;
|
||||
fiber->flags = JANET_FIBER_MASK_YIELD | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
||||
fiber->env = NULL;
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->timeout_index = -1;
|
||||
fiber->sched_id = 0;
|
||||
#endif
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
}
|
||||
|
||||
@@ -65,11 +70,19 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
|
||||
if (newstacktop >= fiber->capacity) {
|
||||
janet_fiber_setcapacity(fiber, 2 * newstacktop);
|
||||
}
|
||||
memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
|
||||
if (argv) {
|
||||
memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
|
||||
} else {
|
||||
/* If argv not given, fill with nil */
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
fiber->data[fiber->stacktop + i] = janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
fiber->stacktop = newstacktop;
|
||||
}
|
||||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||
fiber->waiting = NULL;
|
||||
return fiber;
|
||||
}
|
||||
|
||||
@@ -78,6 +91,22 @@ JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, c
|
||||
return janet_fiber_reset(fiber_alloc(capacity), callee, argc, argv);
|
||||
}
|
||||
|
||||
#ifdef JANET_DEBUG
|
||||
/* Test for memory issues by reallocating fiber every time we push a stack frame */
|
||||
static void janet_fiber_refresh_memory(JanetFiber *fiber) {
|
||||
int32_t n = fiber->capacity;
|
||||
if (n) {
|
||||
Janet *newData = malloc(sizeof(Janet) * n);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet));
|
||||
free(fiber->data);
|
||||
fiber->data = newData;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Ensure that the fiber has enough extra capacity */
|
||||
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
||||
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
|
||||
@@ -135,7 +164,7 @@ void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
|
||||
if (newtop > fiber->capacity) {
|
||||
janet_fiber_grow(fiber, newtop);
|
||||
}
|
||||
memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
|
||||
safe_memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
|
||||
fiber->stacktop = newtop;
|
||||
}
|
||||
|
||||
@@ -166,6 +195,10 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
#ifdef JANET_DEBUG
|
||||
} else {
|
||||
janet_fiber_refresh_memory(fiber);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Nil unset stack arguments (Needed for gc correctness) */
|
||||
@@ -211,18 +244,79 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
static void janet_env_detach(JanetFuncEnv *env) {
|
||||
/* Check for closure environment */
|
||||
if (env) {
|
||||
size_t s = sizeof(Janet) * (size_t) env->length;
|
||||
janet_env_valid(env);
|
||||
int32_t len = env->length;
|
||||
size_t s = sizeof(Janet) * (size_t) len;
|
||||
Janet *vmem = malloc(s);
|
||||
janet_vm_next_collection += (uint32_t) s;
|
||||
if (NULL == vmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(vmem, env->as.fiber->data + env->offset, s);
|
||||
Janet *values = env->as.fiber->data + env->offset;
|
||||
safe_memcpy(vmem, values, s);
|
||||
uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset;
|
||||
if (bitset) {
|
||||
/* Clear unneeded references in closure environment */
|
||||
for (int32_t i = 0; i < len; i += 32) {
|
||||
uint32_t mask = ~(bitset[i >> 5]);
|
||||
int32_t maxj = i + 32 > len ? len : i + 32;
|
||||
for (int32_t j = i; j < maxj; j++) {
|
||||
if (mask & 1) vmem[j] = janet_wrap_nil();
|
||||
mask >>= 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
env->offset = 0;
|
||||
env->as.values = vmem;
|
||||
}
|
||||
}
|
||||
|
||||
/* Validate potentially untrusted func env (unmarshalled envs are difficult to verify) */
|
||||
int janet_env_valid(JanetFuncEnv *env) {
|
||||
if (env->offset < 0) {
|
||||
int32_t real_offset = -(env->offset);
|
||||
JanetFiber *fiber = env->as.fiber;
|
||||
int32_t i = fiber->frame;
|
||||
while (i > 0) {
|
||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||
if (real_offset == i &&
|
||||
frame->env == env &&
|
||||
frame->func &&
|
||||
frame->func->def->slotcount == env->length) {
|
||||
env->offset = real_offset;
|
||||
return 1;
|
||||
}
|
||||
i = frame->prevframe;
|
||||
}
|
||||
/* Invalid, set to empty off-stack variant. */
|
||||
env->offset = 0;
|
||||
env->length = 0;
|
||||
env->as.values = NULL;
|
||||
return 0;
|
||||
} else {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* Detach a fiber from the env if the target fiber has stopped mutating */
|
||||
void janet_env_maybe_detach(JanetFuncEnv *env) {
|
||||
/* Check for detachable closure envs */
|
||||
janet_env_valid(env);
|
||||
if (env->offset > 0) {
|
||||
JanetFiberStatus s = janet_fiber_status(env->as.fiber);
|
||||
int isFinished = s == JANET_STATUS_DEAD ||
|
||||
s == JANET_STATUS_ERROR ||
|
||||
s == JANET_STATUS_USER0 ||
|
||||
s == JANET_STATUS_USER1 ||
|
||||
s == JANET_STATUS_USER2 ||
|
||||
s == JANET_STATUS_USER3 ||
|
||||
s == JANET_STATUS_USER4;
|
||||
if (isFinished) {
|
||||
janet_env_detach(env);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Create a tail frame for a function */
|
||||
int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
int32_t i;
|
||||
@@ -237,6 +331,10 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
#ifdef JANET_DEBUG
|
||||
} else {
|
||||
janet_fiber_refresh_memory(fiber);
|
||||
#endif
|
||||
}
|
||||
|
||||
Janet *stack = fiber->data + fiber->frame;
|
||||
@@ -299,6 +397,10 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
#ifdef JANET_DEBUG
|
||||
} else {
|
||||
janet_fiber_refresh_memory(fiber);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Set the next frame */
|
||||
@@ -337,6 +439,10 @@ JanetFiber *janet_current_fiber(void) {
|
||||
return janet_vm_fiber;
|
||||
}
|
||||
|
||||
JanetFiber *janet_root_fiber(void) {
|
||||
return janet_vm_root_fiber;
|
||||
}
|
||||
|
||||
/* CFuns */
|
||||
|
||||
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
|
||||
@@ -362,10 +468,10 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
JanetFiber *fiber;
|
||||
if (func->def->min_arity != 0) {
|
||||
janet_panic("expected nullary function in fiber constructor");
|
||||
if (func->def->min_arity > 1) {
|
||||
janet_panicf("fiber function must accept 0 or 1 arguments");
|
||||
}
|
||||
fiber = janet_fiber(func, 64, 0, NULL);
|
||||
fiber = janet_fiber(func, 64, func->def->min_arity, NULL);
|
||||
if (argc == 2) {
|
||||
int32_t i;
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
@@ -377,7 +483,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
} else {
|
||||
switch (view.bytes[i]) {
|
||||
default:
|
||||
janet_panicf("invalid flag %c, expected a, d, e, u, or y", view.bytes[i]);
|
||||
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]);
|
||||
break;
|
||||
case 'a':
|
||||
fiber->flags |=
|
||||
@@ -386,6 +492,15 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
JANET_FIBER_MASK_USER |
|
||||
JANET_FIBER_MASK_YIELD;
|
||||
break;
|
||||
case 't':
|
||||
fiber->flags |=
|
||||
JANET_FIBER_MASK_ERROR |
|
||||
JANET_FIBER_MASK_USER0 |
|
||||
JANET_FIBER_MASK_USER1 |
|
||||
JANET_FIBER_MASK_USER2 |
|
||||
JANET_FIBER_MASK_USER3 |
|
||||
JANET_FIBER_MASK_USER4;
|
||||
break;
|
||||
case 'd':
|
||||
fiber->flags |= JANET_FIBER_MASK_DEBUG;
|
||||
break;
|
||||
@@ -431,6 +546,12 @@ static Janet cfun_fiber_current(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_fiber(janet_vm_fiber);
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_root(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_fiber(janet_vm_root_fiber);
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
@@ -448,6 +569,20 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetFiberStatus s = janet_fiber_status(fiber);
|
||||
int isFinished = s == JANET_STATUS_DEAD ||
|
||||
s == JANET_STATUS_ERROR ||
|
||||
s == JANET_STATUS_USER0 ||
|
||||
s == JANET_STATUS_USER1 ||
|
||||
s == JANET_STATUS_USER2 ||
|
||||
s == JANET_STATUS_USER3 ||
|
||||
s == JANET_STATUS_USER4;
|
||||
return janet_wrap_boolean(!isFinished);
|
||||
}
|
||||
|
||||
static const JanetReg fiber_cfuns[] = {
|
||||
{
|
||||
"fiber/new", cfun_fiber_new,
|
||||
@@ -463,6 +598,7 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"\ta - block all signals\n"
|
||||
"\td - block debug signals\n"
|
||||
"\te - block error signals\n"
|
||||
"\tt - block termination signals: error + user[0-4]\n"
|
||||
"\tu - block user signals\n"
|
||||
"\ty - block yield signals\n"
|
||||
"\t0-9 - block a specific user signal\n\n"
|
||||
@@ -483,6 +619,12 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"\t:alive - the fiber is currently running and cannot be resumed\n"
|
||||
"\t:new - the fiber has just been created and not yet run")
|
||||
},
|
||||
{
|
||||
"fiber/root", cfun_fiber_root,
|
||||
JDOC("(fiber/root)\n\n"
|
||||
"Returns the current root fiber. The root fiber is the oldest ancestor "
|
||||
"that does not have a parent.")
|
||||
},
|
||||
{
|
||||
"fiber/current", cfun_fiber_current,
|
||||
JDOC("(fiber/current)\n\n"
|
||||
@@ -513,6 +655,11 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"Sets the environment table for a fiber. Set to nil to remove the current "
|
||||
"environment.")
|
||||
},
|
||||
{
|
||||
"fiber/can-resume?", cfun_fiber_can_resume,
|
||||
JDOC("(fiber/can-resume? fiber)\n\n"
|
||||
"Check if a fiber is finished and cannot be resumed.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -46,7 +46,9 @@
|
||||
#define JANET_FIBER_MASK_USERN(N) (16 << (N))
|
||||
#define JANET_FIBER_MASK_USER 0x3FF0
|
||||
|
||||
#define JANET_FIBER_STATUS_MASK 0xFF0000
|
||||
#define JANET_FIBER_STATUS_MASK 0x3F0000
|
||||
#define JANET_FIBER_FLAG_SCHEDULED 0x800000
|
||||
#define JANET_FIBER_RESUME_SIGNAL 0x400000
|
||||
#define JANET_FIBER_STATUS_OFFSET 16
|
||||
|
||||
#define JANET_FIBER_BREAKPOINT 0x1000000
|
||||
@@ -73,5 +75,11 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func);
|
||||
int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func);
|
||||
void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun);
|
||||
void janet_fiber_popframe(JanetFiber *fiber);
|
||||
void janet_env_maybe_detach(JanetFuncEnv *env);
|
||||
int janet_env_valid(JanetFuncEnv *env);
|
||||
|
||||
#ifdef JANET_EV
|
||||
void janet_fiber_did_resume(JanetFiber *fiber);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@@ -27,12 +27,20 @@
|
||||
#include "symcache.h"
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include "fiber.h"
|
||||
#include "vector.h"
|
||||
#endif
|
||||
|
||||
struct JanetScratch {
|
||||
JanetScratchFinalizer finalize;
|
||||
long long mem[]; /* for proper alignment */
|
||||
};
|
||||
|
||||
/* GC State */
|
||||
JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_next_collection;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_block_count;
|
||||
JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0;
|
||||
|
||||
/* Roots */
|
||||
@@ -41,14 +49,7 @@ JANET_THREAD_LOCAL size_t janet_vm_root_count;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
|
||||
|
||||
/* Scratch Memory */
|
||||
#ifdef JANET_64
|
||||
#define SCRATCH_HDR_SIZE 16 /* smalloc must guarantee 16 byte alignment. */
|
||||
#elif JANET_32
|
||||
#define SCRATCH_HDR_SIZE 8 /* smalloc must guarantee 8 byte alignment. */
|
||||
#else
|
||||
#error "unknown scratch alignment"
|
||||
#endif
|
||||
JANET_THREAD_LOCAL void **janet_scratch_mem;
|
||||
JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
|
||||
JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
|
||||
@@ -69,6 +70,11 @@ static void janet_mark_abstract(void *adata);
|
||||
static JANET_THREAD_LOCAL uint32_t depth = JANET_RECURSION_GUARD;
|
||||
static JANET_THREAD_LOCAL size_t orig_rootcount;
|
||||
|
||||
/* Hint to the GC that we may need to collect */
|
||||
void janet_gcpressure(size_t s) {
|
||||
janet_vm_next_collection += s;
|
||||
}
|
||||
|
||||
/* Mark a value */
|
||||
void janet_mark(Janet x) {
|
||||
if (depth) {
|
||||
@@ -186,7 +192,10 @@ static void janet_mark_funcenv(JanetFuncEnv *env) {
|
||||
if (janet_gc_reachable(env))
|
||||
return;
|
||||
janet_gc_mark(env);
|
||||
if (env->offset) {
|
||||
/* If closure env references a dead fiber, we can just copy out the stack frame we need so
|
||||
* we don't need to keep around the whole dead fiber. */
|
||||
janet_env_maybe_detach(env);
|
||||
if (env->offset > 0) {
|
||||
/* On stack */
|
||||
janet_mark_fiber(env->as.fiber);
|
||||
} else {
|
||||
@@ -302,6 +311,7 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
free(def->constants);
|
||||
free(def->bytecode);
|
||||
free(def->sourcemap);
|
||||
free(def->closure_bitset);
|
||||
}
|
||||
break;
|
||||
}
|
||||
@@ -319,6 +329,7 @@ void janet_sweep() {
|
||||
previous = current;
|
||||
current->flags &= ~JANET_MEM_REACHABLE;
|
||||
} else {
|
||||
janet_vm_block_count--;
|
||||
janet_deinit_block(current);
|
||||
if (NULL != previous) {
|
||||
previous->next = next;
|
||||
@@ -351,15 +362,16 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
janet_vm_next_collection += size;
|
||||
mem->next = janet_vm_blocks;
|
||||
janet_vm_blocks = mem;
|
||||
janet_vm_block_count++;
|
||||
|
||||
return (void *)mem;
|
||||
}
|
||||
|
||||
static void free_one_scratch(void *mem) {
|
||||
ScratchFinalizer finalize = *(ScratchFinalizer *)mem;
|
||||
if (finalize)
|
||||
finalize((char *)mem + SCRATCH_HDR_SIZE);
|
||||
free(mem);
|
||||
static void free_one_scratch(JanetScratch *s) {
|
||||
if (NULL != s->finalize) {
|
||||
s->finalize((char *) s->mem);
|
||||
}
|
||||
free(s);
|
||||
}
|
||||
|
||||
/* Free all allocated scratch memory */
|
||||
@@ -370,12 +382,28 @@ static void janet_free_all_scratch(void) {
|
||||
janet_scratch_len = 0;
|
||||
}
|
||||
|
||||
static JanetScratch *janet_mem2scratch(void *mem) {
|
||||
JanetScratch *s = (JanetScratch *)mem;
|
||||
return s - 1;
|
||||
}
|
||||
|
||||
/* Run garbage collection */
|
||||
void janet_collect(void) {
|
||||
uint32_t i;
|
||||
if (janet_vm_gc_suspend) return;
|
||||
depth = JANET_RECURSION_GUARD;
|
||||
/* Try and prevent many major collections back to back.
|
||||
* A full collection will take O(janet_vm_block_count) time.
|
||||
* If we have a large heap, make sure our interval is not too
|
||||
* small so we won't make many collections over it. This is just a
|
||||
* heuristic for automatically changing the gc interval */
|
||||
if (janet_vm_block_count * 8 > janet_vm_gc_interval) {
|
||||
janet_vm_gc_interval = janet_vm_block_count * sizeof(JanetGCObject);
|
||||
}
|
||||
orig_rootcount = janet_vm_root_count;
|
||||
#ifdef JANET_EV
|
||||
janet_ev_mark();
|
||||
#endif
|
||||
for (i = 0; i < orig_rootcount; i++)
|
||||
janet_mark(janet_vm_roots[i]);
|
||||
while (orig_rootcount < janet_vm_root_count) {
|
||||
@@ -473,26 +501,26 @@ void janet_gcunlock(int handle) {
|
||||
/* Scratch memory API */
|
||||
|
||||
void *janet_smalloc(size_t size) {
|
||||
void *mem = malloc(SCRATCH_HDR_SIZE + size);
|
||||
if (NULL == mem) {
|
||||
JanetScratch *s = malloc(sizeof(JanetScratch) + size);
|
||||
if (NULL == s) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
*(ScratchFinalizer *)mem = NULL;
|
||||
s->finalize = NULL;
|
||||
if (janet_scratch_len == janet_scratch_cap) {
|
||||
size_t newcap = 2 * janet_scratch_cap + 2;
|
||||
void **newmem = (void **) realloc(janet_scratch_mem, newcap * sizeof(void *));
|
||||
JanetScratch **newmem = (JanetScratch **) realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
|
||||
if (NULL == newmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_scratch_cap = newcap;
|
||||
janet_scratch_mem = newmem;
|
||||
}
|
||||
janet_scratch_mem[janet_scratch_len++] = mem;
|
||||
return (char *)mem + SCRATCH_HDR_SIZE;
|
||||
janet_scratch_mem[janet_scratch_len++] = s;
|
||||
return (char *)(s->mem);
|
||||
}
|
||||
|
||||
void *janet_scalloc(size_t nmemb, size_t size) {
|
||||
if (nmemb && size > (size_t) -1 / size) {
|
||||
if (nmemb && size > SIZE_MAX / nmemb) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
size_t n = nmemb * size;
|
||||
@@ -503,40 +531,40 @@ void *janet_scalloc(size_t nmemb, size_t size) {
|
||||
|
||||
void *janet_srealloc(void *mem, size_t size) {
|
||||
if (NULL == mem) return janet_smalloc(size);
|
||||
mem = (char *)mem - SCRATCH_HDR_SIZE;
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == mem) {
|
||||
void *newmem = realloc(mem, size + SCRATCH_HDR_SIZE);
|
||||
if (NULL == newmem) {
|
||||
if (janet_scratch_mem[i] == s) {
|
||||
JanetScratch *news = realloc(s, size + sizeof(JanetScratch));
|
||||
if (NULL == news) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_scratch_mem[i] = newmem;
|
||||
return (char *)newmem + SCRATCH_HDR_SIZE;
|
||||
janet_scratch_mem[i] = news;
|
||||
return (char *)(news->mem);
|
||||
}
|
||||
if (i == 0) break;
|
||||
}
|
||||
}
|
||||
janet_exit("invalid janet_srealloc");
|
||||
JANET_EXIT("invalid janet_srealloc");
|
||||
}
|
||||
|
||||
void janet_sfinalizer(void *mem, ScratchFinalizer finalizer) {
|
||||
mem = (char *)mem - SCRATCH_HDR_SIZE;
|
||||
*(ScratchFinalizer *)mem = finalizer;
|
||||
void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
s->finalize = finalizer;
|
||||
}
|
||||
|
||||
void janet_sfree(void *mem) {
|
||||
if (NULL == mem) return;
|
||||
mem = (char *)mem - SCRATCH_HDR_SIZE;
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == mem) {
|
||||
if (janet_scratch_mem[i] == s) {
|
||||
janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
|
||||
free_one_scratch(mem);
|
||||
free_one_scratch(s);
|
||||
return;
|
||||
}
|
||||
if (i == 0) break;
|
||||
}
|
||||
}
|
||||
janet_exit("invalid janet_sfree");
|
||||
JANET_EXIT("invalid janet_sfree");
|
||||
}
|
||||
|
||||
@@ -20,18 +20,18 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <errno.h>
|
||||
#include <stdlib.h>
|
||||
#include <limits.h>
|
||||
#include <inttypes.h>
|
||||
#include <math.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <errno.h>
|
||||
#include <stdlib.h>
|
||||
#include <limits.h>
|
||||
#include <inttypes.h>
|
||||
#include <math.h>
|
||||
|
||||
/* Conditional compilation */
|
||||
#ifdef JANET_INT_TYPES
|
||||
|
||||
@@ -81,7 +81,7 @@ static void it_u64_tostring(void *p, JanetBuffer *buffer) {
|
||||
janet_buffer_push_cstring(buffer, str);
|
||||
}
|
||||
|
||||
static const JanetAbstractType it_s64_type = {
|
||||
const JanetAbstractType janet_s64_type = {
|
||||
"core/s64",
|
||||
NULL,
|
||||
NULL,
|
||||
@@ -91,10 +91,11 @@ static const JanetAbstractType it_s64_type = {
|
||||
int64_unmarshal,
|
||||
it_s64_tostring,
|
||||
janet_int64_compare,
|
||||
janet_int64_hash
|
||||
janet_int64_hash,
|
||||
JANET_ATEND_HASH
|
||||
};
|
||||
|
||||
static const JanetAbstractType it_u64_type = {
|
||||
const JanetAbstractType janet_u64_type = {
|
||||
"core/u64",
|
||||
NULL,
|
||||
NULL,
|
||||
@@ -104,7 +105,8 @@ static const JanetAbstractType it_u64_type = {
|
||||
int64_unmarshal,
|
||||
it_u64_tostring,
|
||||
janet_uint64_compare,
|
||||
janet_int64_hash
|
||||
janet_int64_hash,
|
||||
JANET_ATEND_HASH
|
||||
};
|
||||
|
||||
int64_t janet_unwrap_s64(Janet x) {
|
||||
@@ -126,8 +128,8 @@ int64_t janet_unwrap_s64(Janet x) {
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abst) == &it_s64_type ||
|
||||
(janet_abstract_type(abst) == &it_u64_type))
|
||||
if (janet_abstract_type(abst) == &janet_s64_type ||
|
||||
(janet_abstract_type(abst) == &janet_u64_type))
|
||||
return *(int64_t *)abst;
|
||||
break;
|
||||
}
|
||||
@@ -155,8 +157,8 @@ uint64_t janet_unwrap_u64(Janet x) {
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abst) == &it_s64_type ||
|
||||
(janet_abstract_type(abst) == &it_u64_type))
|
||||
if (janet_abstract_type(abst) == &janet_s64_type ||
|
||||
(janet_abstract_type(abst) == &janet_u64_type))
|
||||
return *(uint64_t *)abst;
|
||||
break;
|
||||
}
|
||||
@@ -168,19 +170,19 @@ uint64_t janet_unwrap_u64(Janet x) {
|
||||
JanetIntType janet_is_int(Janet x) {
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_INT_NONE;
|
||||
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
|
||||
return (at == &it_s64_type) ? JANET_INT_S64 :
|
||||
((at == &it_u64_type) ? JANET_INT_U64 :
|
||||
return (at == &janet_s64_type) ? JANET_INT_S64 :
|
||||
((at == &janet_u64_type) ? JANET_INT_U64 :
|
||||
JANET_INT_NONE);
|
||||
}
|
||||
|
||||
Janet janet_wrap_s64(int64_t x) {
|
||||
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
*box = (int64_t)x;
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
Janet janet_wrap_u64(uint64_t x) {
|
||||
uint64_t *box = janet_abstract(&it_u64_type, sizeof(uint64_t));
|
||||
uint64_t *box = janet_abstract(&janet_u64_type, sizeof(uint64_t));
|
||||
*box = (uint64_t)x;
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
@@ -195,54 +197,171 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
||||
}
|
||||
|
||||
// Code to support polymorphic comparison.
|
||||
//
|
||||
// int/u64 and int/s64 support a "compare" method that allows
|
||||
// comparison to each other, and to Janet numbers, using the
|
||||
// "compare" "compare<" ... functions.
|
||||
//
|
||||
// In the following code explicit casts are sometimes used to help
|
||||
// make it clear when int/float conversions are happening.
|
||||
//
|
||||
static int compare_double_double(double x, double y) {
|
||||
return (x < y) ? -1 : ((x > y) ? 1 : 0);
|
||||
}
|
||||
|
||||
static int compare_int64_double(int64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) INT64_MAX)) {
|
||||
return -1;
|
||||
} else if (y < ((double) INT64_MIN)) {
|
||||
return 1;
|
||||
} else {
|
||||
int64_t yi = (int64_t) y;
|
||||
return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
|
||||
}
|
||||
}
|
||||
|
||||
static int compare_uint64_double(uint64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
} else if (y < 0) {
|
||||
return 1;
|
||||
} else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) UINT64_MAX)) {
|
||||
return -1;
|
||||
} else {
|
||||
uint64_t yi = (uint64_t) y;
|
||||
return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_S64)
|
||||
janet_panic("compare method requires int/s64 as first argument");
|
||||
int64_t x = janet_unwrap_s64(argv[0]);
|
||||
switch (janet_type(argv[1])) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double y = janet_unwrap_number(argv[1]);
|
||||
return janet_wrap_number(compare_int64_double(x, y));
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(argv[1]);
|
||||
if (janet_abstract_type(abst) == &janet_s64_type) {
|
||||
int64_t y = *(int64_t *)abst;
|
||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||
} else if (janet_abstract_type(abst) == &janet_u64_type) {
|
||||
// comparing signed to unsigned -- be careful!
|
||||
uint64_t y = *(uint64_t *)abst;
|
||||
if (x < 0) {
|
||||
return janet_wrap_number(-1);
|
||||
} else if (y > INT64_MAX) {
|
||||
return janet_wrap_number(-1);
|
||||
} else {
|
||||
int64_t y2 = (int64_t) y;
|
||||
return janet_wrap_number((x < y2) ? -1 : (x > y2 ? 1 : 0));
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_U64) // is this needed?
|
||||
janet_panic("compare method requires int/u64 as first argument");
|
||||
uint64_t x = janet_unwrap_u64(argv[0]);
|
||||
switch (janet_type(argv[1])) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double y = janet_unwrap_number(argv[1]);
|
||||
return janet_wrap_number(compare_uint64_double(x, y));
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(argv[1]);
|
||||
if (janet_abstract_type(abst) == &janet_u64_type) {
|
||||
uint64_t y = *(uint64_t *)abst;
|
||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||
} else if (janet_abstract_type(abst) == &janet_s64_type) {
|
||||
// comparing unsigned to signed -- be careful!
|
||||
int64_t y = *(int64_t *)abst;
|
||||
if (y < 0) {
|
||||
return janet_wrap_number(1);
|
||||
} else if (x > INT64_MAX) {
|
||||
return janet_wrap_number(1);
|
||||
} else {
|
||||
int64_t x2 = (int64_t) x;
|
||||
return janet_wrap_number((x2 < y) ? -1 : (x2 > y ? 1 : 0));
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#define OPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int i = 1; i < argc; i++) \
|
||||
for (int32_t i = 1; i < argc; i++) \
|
||||
*box oper##= janet_unwrap_##type(argv[i]); \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
\
|
||||
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||
for (int i = 1; i < argc; i++) \
|
||||
*box oper##= janet_unwrap_##type(argv[i]); \
|
||||
|
||||
#define OPMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
*box oper##= janet_unwrap_##type(argv[0]); \
|
||||
return janet_wrap_abstract(box); \
|
||||
}
|
||||
} \
|
||||
|
||||
#define DIVMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
\
|
||||
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
}
|
||||
} \
|
||||
|
||||
#define DIVMETHOD_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
@@ -250,126 +369,129 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
\
|
||||
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
*box = janet_unwrap_s64(argv[0]);
|
||||
for (int32_t i = 1; i < argc; i++) {
|
||||
int64_t value = janet_unwrap_s64(argv[i]);
|
||||
if (value == 0) janet_panic("division by zero");
|
||||
int64_t x = *box % value;
|
||||
if (x < 0) {
|
||||
x = (*box < 0) ? x - *box : x + *box;
|
||||
}
|
||||
*box = x;
|
||||
}
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
#define COMPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T v1 = janet_unwrap_##type(argv[0]); \
|
||||
T v2 = janet_unwrap_##type(argv[1]); \
|
||||
return janet_wrap_boolean(v1 oper v2); \
|
||||
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
||||
int64_t x = op1 % op2;
|
||||
if (x < 0) {
|
||||
x = (op1 < 0) ? x - op1 : x + op1;
|
||||
}
|
||||
*box = x;
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
OPMETHOD(int64_t, s64, add, +)
|
||||
OPMETHOD(int64_t, s64, sub, -)
|
||||
OPMETHODINVERT(int64_t, s64, subi, -)
|
||||
OPMETHOD(int64_t, s64, mul, *)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, mod, %)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
|
||||
OPMETHOD(int64_t, s64, and, &)
|
||||
OPMETHOD(int64_t, s64, or, |)
|
||||
OPMETHOD(int64_t, s64, xor, ^)
|
||||
OPMETHOD(int64_t, s64, lshift, <<)
|
||||
OPMETHOD(int64_t, s64, rshift, >>)
|
||||
COMPMETHOD(int64_t, s64, lt, <)
|
||||
COMPMETHOD(int64_t, s64, gt, >)
|
||||
COMPMETHOD(int64_t, s64, le, <=)
|
||||
COMPMETHOD(int64_t, s64, ge, >=)
|
||||
COMPMETHOD(int64_t, s64, eq, ==)
|
||||
COMPMETHOD(int64_t, s64, ne, !=)
|
||||
|
||||
OPMETHOD(uint64_t, u64, add, +)
|
||||
OPMETHOD(uint64_t, u64, sub, -)
|
||||
OPMETHODINVERT(uint64_t, u64, subi, -)
|
||||
OPMETHOD(uint64_t, u64, mul, *)
|
||||
DIVMETHOD(uint64_t, u64, div, /)
|
||||
DIVMETHOD(uint64_t, u64, mod, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, divi, /)
|
||||
DIVMETHODINVERT(uint64_t, u64, modi, %)
|
||||
OPMETHOD(uint64_t, u64, and, &)
|
||||
OPMETHOD(uint64_t, u64, or, |)
|
||||
OPMETHOD(uint64_t, u64, xor, ^)
|
||||
OPMETHOD(uint64_t, u64, lshift, <<)
|
||||
OPMETHOD(uint64_t, u64, rshift, >>)
|
||||
COMPMETHOD(uint64_t, u64, lt, <)
|
||||
COMPMETHOD(uint64_t, u64, gt, >)
|
||||
COMPMETHOD(uint64_t, u64, le, <=)
|
||||
COMPMETHOD(uint64_t, u64, ge, >=)
|
||||
COMPMETHOD(uint64_t, u64, eq, ==)
|
||||
COMPMETHOD(uint64_t, u64, ne, !=)
|
||||
|
||||
#undef OPMETHOD
|
||||
#undef DIVMETHOD
|
||||
#undef DIVMETHOD_SIGNED
|
||||
#undef COMPMETHOD
|
||||
|
||||
|
||||
static JanetMethod it_s64_methods[] = {
|
||||
{"+", cfun_it_s64_add},
|
||||
{"r+", cfun_it_s64_add},
|
||||
{"-", cfun_it_s64_sub},
|
||||
{"r-", cfun_it_s64_subi},
|
||||
{"*", cfun_it_s64_mul},
|
||||
{"r*", cfun_it_s64_mul},
|
||||
{"/", cfun_it_s64_div},
|
||||
{"%", cfun_it_s64_mod},
|
||||
{"<", cfun_it_s64_lt},
|
||||
{">", cfun_it_s64_gt},
|
||||
{"<=", cfun_it_s64_le},
|
||||
{">=", cfun_it_s64_ge},
|
||||
{"=", cfun_it_s64_eq},
|
||||
{"!=", cfun_it_s64_ne},
|
||||
{"r/", cfun_it_s64_divi},
|
||||
{"mod", cfun_it_s64_mod},
|
||||
{"rmod", cfun_it_s64_modi},
|
||||
{"%", cfun_it_s64_rem},
|
||||
{"r%", cfun_it_s64_remi},
|
||||
{"&", cfun_it_s64_and},
|
||||
{"r&", cfun_it_s64_and},
|
||||
{"|", cfun_it_s64_or},
|
||||
{"r|", cfun_it_s64_or},
|
||||
{"^", cfun_it_s64_xor},
|
||||
{"r^", cfun_it_s64_xor},
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
|
||||
{"+!", cfun_it_s64_add_mut},
|
||||
{"-!", cfun_it_s64_sub_mut},
|
||||
{"*!", cfun_it_s64_mul_mut},
|
||||
{"/!", cfun_it_s64_div_mut},
|
||||
{"%!", cfun_it_s64_mod_mut},
|
||||
{"&!", cfun_it_s64_and_mut},
|
||||
{"|!", cfun_it_s64_or_mut},
|
||||
{"^!", cfun_it_s64_xor_mut},
|
||||
{"<<!", cfun_it_s64_lshift_mut},
|
||||
{">>!", cfun_it_s64_rshift_mut},
|
||||
{"compare", cfun_it_s64_compare},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static JanetMethod it_u64_methods[] = {
|
||||
{"+", cfun_it_u64_add},
|
||||
{"r+", cfun_it_u64_add},
|
||||
{"-", cfun_it_u64_sub},
|
||||
{"r-", cfun_it_u64_subi},
|
||||
{"*", cfun_it_u64_mul},
|
||||
{"r*", cfun_it_u64_mul},
|
||||
{"/", cfun_it_u64_div},
|
||||
{"r/", cfun_it_u64_divi},
|
||||
{"mod", cfun_it_u64_mod},
|
||||
{"rmod", cfun_it_u64_modi},
|
||||
{"%", cfun_it_u64_mod},
|
||||
{"<", cfun_it_u64_lt},
|
||||
{">", cfun_it_u64_gt},
|
||||
{"<=", cfun_it_u64_le},
|
||||
{">=", cfun_it_u64_ge},
|
||||
{"=", cfun_it_u64_eq},
|
||||
{"!=", cfun_it_u64_ne},
|
||||
{"r%", cfun_it_u64_modi},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"r&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
{"r|", cfun_it_u64_or},
|
||||
{"^", cfun_it_u64_xor},
|
||||
{"r^", cfun_it_u64_xor},
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
|
||||
{"+!", cfun_it_u64_add_mut},
|
||||
{"-!", cfun_it_u64_sub_mut},
|
||||
{"*!", cfun_it_u64_mul_mut},
|
||||
{"/!", cfun_it_u64_div_mut},
|
||||
{"%!", cfun_it_u64_mod_mut},
|
||||
{"&!", cfun_it_u64_and_mut},
|
||||
{"|!", cfun_it_u64_or_mut},
|
||||
{"^!", cfun_it_u64_xor_mut},
|
||||
{"<<!", cfun_it_u64_lshift_mut},
|
||||
{">>!", cfun_it_u64_rshift_mut},
|
||||
{"compare", cfun_it_u64_compare},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
@@ -405,8 +527,8 @@ static const JanetReg it_cfuns[] = {
|
||||
/* Module entry point */
|
||||
void janet_lib_inttypes(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, it_cfuns);
|
||||
janet_register_abstract_type(&it_s64_type);
|
||||
janet_register_abstract_type(&it_u64_type);
|
||||
janet_register_abstract_type(&janet_s64_type);
|
||||
janet_register_abstract_type(&janet_u64_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
405
src/core/io.c
405
src/core/io.c
@@ -30,38 +30,34 @@
|
||||
#include <errno.h>
|
||||
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <fcntl.h>
|
||||
#include <sys/wait.h>
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
|
||||
typedef struct IOFile IOFile;
|
||||
struct IOFile {
|
||||
FILE *file;
|
||||
int flags;
|
||||
};
|
||||
|
||||
static int cfun_io_gc(void *p, size_t len);
|
||||
static int io_file_get(void *p, Janet key, Janet *out);
|
||||
static void io_file_marshal(void *p, JanetMarshalContext *ctx);
|
||||
static void *io_file_unmarshal(JanetMarshalContext *ctx);
|
||||
|
||||
JanetAbstractType cfun_io_filetype = {
|
||||
const JanetAbstractType janet_file_type = {
|
||||
"core/file",
|
||||
cfun_io_gc,
|
||||
NULL,
|
||||
io_file_get,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
io_file_marshal,
|
||||
io_file_unmarshal,
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
/* Check arguments to fopen */
|
||||
static int checkflags(const uint8_t *str) {
|
||||
int flags = 0;
|
||||
static int32_t checkflags(const uint8_t *str) {
|
||||
int32_t flags = 0;
|
||||
int32_t i;
|
||||
int32_t len = janet_string_length(str);
|
||||
if (!len || len > 3)
|
||||
janet_panic("file mode must have a length between 1 and 3");
|
||||
if (!len || len > 10)
|
||||
janet_panic("file mode must have a length between 1 and 10");
|
||||
switch (*str) {
|
||||
default:
|
||||
janet_panicf("invalid flag %c, expected w, a, or r", *str);
|
||||
@@ -79,7 +75,7 @@ static int checkflags(const uint8_t *str) {
|
||||
for (i = 1; i < len; i++) {
|
||||
switch (str[i]) {
|
||||
default:
|
||||
janet_panicf("invalid flag %c, expected + or b", str[i]);
|
||||
janet_panicf("invalid flag %c, expected +, b, or n", str[i]);
|
||||
break;
|
||||
case '+':
|
||||
if (flags & JANET_FILE_UPDATE) return -1;
|
||||
@@ -89,39 +85,42 @@ static int checkflags(const uint8_t *str) {
|
||||
if (flags & JANET_FILE_BINARY) return -1;
|
||||
flags |= JANET_FILE_BINARY;
|
||||
break;
|
||||
case 'n':
|
||||
if (flags & JANET_FILE_NONIL) return -1;
|
||||
flags |= JANET_FILE_NONIL;
|
||||
break;
|
||||
}
|
||||
}
|
||||
return flags;
|
||||
}
|
||||
|
||||
static Janet makef(FILE *f, int flags) {
|
||||
IOFile *iof = (IOFile *) janet_abstract(&cfun_io_filetype, sizeof(IOFile));
|
||||
static void *makef(FILE *f, int32_t flags) {
|
||||
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
|
||||
iof->file = f;
|
||||
iof->flags = flags;
|
||||
return janet_wrap_abstract(iof);
|
||||
#ifndef JANET_WINDOWS
|
||||
/* While we would like fopen to set cloexec by default (like O_CLOEXEC) with the e flag, that is
|
||||
* not standard. */
|
||||
if (!(flags & JANET_FILE_NOT_CLOSEABLE))
|
||||
fcntl(fileno(f), F_SETFD, FD_CLOEXEC);
|
||||
#endif
|
||||
return iof;
|
||||
}
|
||||
|
||||
/* Open a process */
|
||||
#ifdef __EMSCRIPTEN__
|
||||
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("not implemented on this platform");
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
#else
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode = NULL;
|
||||
int flags;
|
||||
int32_t flags;
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
if (janet_string_length(fmode) != 1 ||
|
||||
!(fmode[0] == 'r' || fmode[0] == 'w')) {
|
||||
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
|
||||
flags = JANET_FILE_PIPED | checkflags(fmode);
|
||||
if (flags & (JANET_FILE_UPDATE | JANET_FILE_BINARY | JANET_FILE_APPEND)) {
|
||||
janet_panicf("invalid popen file mode :%S, expected :r or :w", fmode);
|
||||
}
|
||||
flags = JANET_FILE_PIPED | (fmode[0] == 'r' ? JANET_FILE_READ : JANET_FILE_WRITE);
|
||||
fmode = (const uint8_t *)((fmode[0] == 'r') ? "r" : "w");
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
flags = JANET_FILE_PIPED | JANET_FILE_READ;
|
||||
@@ -131,15 +130,18 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
#endif
|
||||
FILE *f = popen((const char *)fname, (const char *)fmode);
|
||||
if (!f) {
|
||||
if (flags & JANET_FILE_NONIL)
|
||||
janet_panicf("failed to popen %s: %s", fname, strerror(errno));
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
return makef(f, flags);
|
||||
return janet_makefile(f, flags);
|
||||
}
|
||||
#endif
|
||||
|
||||
static Janet cfun_io_temp(int32_t argc, Janet *argv) {
|
||||
(void)argv;
|
||||
janet_fixarity(argc, 0);
|
||||
// XXX use mkostemp when we can to avoid CLOEXEC race.
|
||||
FILE *tmp = tmpfile();
|
||||
if (!tmp)
|
||||
janet_panicf("unable to create temporary file - %s", strerror(errno));
|
||||
@@ -150,7 +152,7 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode;
|
||||
int flags;
|
||||
int32_t flags;
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
flags = checkflags(fmode);
|
||||
@@ -159,41 +161,13 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
flags = JANET_FILE_READ;
|
||||
}
|
||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_fdopen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const int fd = janet_getinteger(argv, 0);
|
||||
const uint8_t *fmode;
|
||||
int flags;
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
flags = checkflags(fmode);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
flags = JANET_FILE_READ;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
#define fdopen _fdopen
|
||||
#endif
|
||||
FILE *f = fdopen(fd, (const char *)fmode);
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_fileno(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
#ifdef JANET_WINDOWS
|
||||
#define fileno _fileno
|
||||
#endif
|
||||
return janet_wrap_integer(fileno(iof->file));
|
||||
return f ? janet_makefile(f, flags)
|
||||
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Read up to n bytes into buffer. */
|
||||
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
if (!(iof->flags & (JANET_FILE_READ | JANET_FILE_UPDATE)))
|
||||
janet_panic("file is not readable");
|
||||
janet_buffer_extra(buffer, nBytesMax);
|
||||
@@ -207,7 +181,7 @@ static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
/* Read a certain number of bytes into memory */
|
||||
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
|
||||
JanetBuffer *buffer;
|
||||
if (argc == 2) {
|
||||
@@ -247,7 +221,7 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
/* Write bytes to a file */
|
||||
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||
@@ -270,7 +244,7 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||
/* Flush the bytes in the file */
|
||||
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||
@@ -280,12 +254,24 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#define WEXITSTATUS(x) x
|
||||
#endif
|
||||
|
||||
/* Cleanup a file */
|
||||
static int cfun_io_gc(void *p, size_t len) {
|
||||
(void) len;
|
||||
IOFile *iof = (IOFile *)p;
|
||||
JanetFile *iof = (JanetFile *)p;
|
||||
if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
||||
return fclose(iof->file);
|
||||
/* We can't panic inside a gc, so just ignore bad statuses here */
|
||||
if (iof->flags & JANET_FILE_PIPED) {
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
pclose(iof->file);
|
||||
#endif
|
||||
} else {
|
||||
fclose(iof->file);
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -293,31 +279,34 @@ static int cfun_io_gc(void *p, size_t len) {
|
||||
/* Close a file */
|
||||
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
return janet_wrap_nil();
|
||||
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
|
||||
janet_panic("file not closable");
|
||||
if (iof->flags & JANET_FILE_PIPED) {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#define WEXITSTATUS(x) x
|
||||
#endif
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
int status = pclose(iof->file);
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
if (status == -1) janet_panic("could not close file");
|
||||
return janet_wrap_integer(WEXITSTATUS(status));
|
||||
} else {
|
||||
if (fclose(iof->file)) janet_panic("could not close file");
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
#else
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
} else {
|
||||
if (fclose(iof->file)) {
|
||||
iof->flags |= JANET_FILE_NOT_CLOSEABLE;
|
||||
janet_panic("could not close file");
|
||||
}
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Seek a file */
|
||||
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
long int offset = 0;
|
||||
@@ -343,7 +332,6 @@ static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||
|
||||
static JanetMethod io_file_methods[] = {
|
||||
{"close", cfun_io_fclose},
|
||||
{"fileno", cfun_io_fileno},
|
||||
{"flush", cfun_io_fflush},
|
||||
{"read", cfun_io_fread},
|
||||
{"seek", cfun_io_fseek},
|
||||
@@ -358,27 +346,69 @@ static int io_file_get(void *p, Janet key, Janet *out) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods, out);
|
||||
}
|
||||
|
||||
static void io_file_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetFile *iof = (JanetFile *)p;
|
||||
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
|
||||
janet_marshal_abstract(ctx, p);
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_marshal_int(ctx, _fileno(iof->file));
|
||||
#else
|
||||
janet_marshal_int(ctx, fileno(iof->file));
|
||||
#endif
|
||||
janet_marshal_int(ctx, iof->flags);
|
||||
} else {
|
||||
janet_panic("cannot marshal file in safe mode");
|
||||
}
|
||||
}
|
||||
|
||||
static void *io_file_unmarshal(JanetMarshalContext *ctx) {
|
||||
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
|
||||
JanetFile *iof = janet_unmarshal_abstract(ctx, sizeof(JanetFile));
|
||||
int32_t fd = janet_unmarshal_int(ctx);
|
||||
int32_t flags = janet_unmarshal_int(ctx);
|
||||
char fmt[4] = {0};
|
||||
int index = 0;
|
||||
if (flags & JANET_FILE_READ) fmt[index++] = 'r';
|
||||
if (flags & JANET_FILE_APPEND) {
|
||||
fmt[index++] = 'a';
|
||||
} else if (flags & JANET_FILE_WRITE) {
|
||||
fmt[index++] = 'w';
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
iof->file = _fdopen(fd, fmt);
|
||||
#else
|
||||
iof->file = fdopen(fd, fmt);
|
||||
#endif
|
||||
if (iof->file == NULL) {
|
||||
iof->flags = JANET_FILE_CLOSED;
|
||||
} else {
|
||||
iof->flags = flags;
|
||||
}
|
||||
return iof;
|
||||
} else {
|
||||
janet_panic("cannot unmarshal file in safe mode");
|
||||
}
|
||||
}
|
||||
|
||||
FILE *janet_dynfile(const char *name, FILE *def) {
|
||||
Janet x = janet_dyn(name);
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return def;
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype) return def;
|
||||
IOFile *iofile = abstract;
|
||||
if (janet_abstract_type(abstract) != &janet_file_type) return def;
|
||||
JanetFile *iofile = abstract;
|
||||
return iofile->file;
|
||||
}
|
||||
|
||||
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
int newline, const char *name, FILE *dflt_file) {
|
||||
static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
FILE *dflt_file, int32_t offset, Janet x) {
|
||||
FILE *f;
|
||||
Janet x = janet_dyn(name);
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
/* Other values simply do nothing */
|
||||
return janet_wrap_nil();
|
||||
janet_panicf("cannot print to %v", x);
|
||||
case JANET_BUFFER: {
|
||||
/* Special case buffer */
|
||||
JanetBuffer *buf = janet_unwrap_buffer(x);
|
||||
for (int32_t i = 0; i < argc; ++i) {
|
||||
for (int32_t i = offset; i < argc; ++i) {
|
||||
janet_to_string_b(buf, argv[i]);
|
||||
}
|
||||
if (newline)
|
||||
@@ -387,17 +417,18 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
}
|
||||
case JANET_NIL:
|
||||
f = dflt_file;
|
||||
if (f == NULL) janet_panic("cannot print to nil");
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype)
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
return janet_wrap_nil();
|
||||
IOFile *iofile = abstract;
|
||||
JanetFile *iofile = abstract;
|
||||
f = iofile->file;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (int32_t i = 0; i < argc; ++i) {
|
||||
for (int32_t i = offset; i < argc; ++i) {
|
||||
int32_t len;
|
||||
const uint8_t *vstr;
|
||||
if (janet_checktype(argv[i], JANET_BUFFER)) {
|
||||
@@ -410,7 +441,11 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
}
|
||||
if (len) {
|
||||
if (1 != fwrite(vstr, len, 1, f)) {
|
||||
janet_panicf("could not print %d bytes to (dyn :%s)", len, name);
|
||||
if (f == dflt_file) {
|
||||
janet_panicf("cannot print %d bytes", len);
|
||||
} else {
|
||||
janet_panicf("cannot print %d bytes to %v", len, x);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -419,6 +454,13 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
|
||||
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
int newline, const char *name, FILE *dflt_file) {
|
||||
Janet x = janet_dyn(name);
|
||||
return cfun_io_print_impl_x(argc, argv, newline, dflt_file, 0, x);
|
||||
}
|
||||
|
||||
static Janet cfun_io_print(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
|
||||
}
|
||||
@@ -435,41 +477,49 @@ static Janet cfun_io_eprin(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
const char *name, FILE *dflt_file) {
|
||||
FILE *f;
|
||||
static Janet cfun_io_xprint(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
const char *fmt = janet_getcstring(argv, 0);
|
||||
Janet x = janet_dyn(name);
|
||||
return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
static Janet cfun_io_xprin(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
FILE *dflt_file, int32_t offset, Janet x) {
|
||||
FILE *f;
|
||||
const char *fmt = janet_getcstring(argv, offset);
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
/* Other values simply do nothing */
|
||||
return janet_wrap_nil();
|
||||
janet_panicf("cannot print to %v", x);
|
||||
case JANET_BUFFER: {
|
||||
/* Special case buffer */
|
||||
JanetBuffer *buf = janet_unwrap_buffer(x);
|
||||
janet_buffer_format(buf, fmt, 0, argc, argv);
|
||||
janet_buffer_format(buf, fmt, offset, argc, argv);
|
||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
case JANET_NIL:
|
||||
f = dflt_file;
|
||||
if (f == NULL) janet_panic("cannot print to nil");
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype)
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
return janet_wrap_nil();
|
||||
IOFile *iofile = abstract;
|
||||
JanetFile *iofile = abstract;
|
||||
f = iofile->file;
|
||||
break;
|
||||
}
|
||||
}
|
||||
JanetBuffer *buf = janet_buffer(10);
|
||||
janet_buffer_format(buf, fmt, 0, argc, argv);
|
||||
janet_buffer_format(buf, fmt, offset, argc, argv);
|
||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||
if (buf->count) {
|
||||
if (1 != fwrite(buf->data, buf->count, 1, f)) {
|
||||
janet_panicf("could not print %d bytes to file", buf->count, name);
|
||||
janet_panicf("could not print %d bytes to file", buf->count);
|
||||
}
|
||||
}
|
||||
/* Clear buffer to make things easier for GC */
|
||||
@@ -480,6 +530,14 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
const char *name, FILE *dflt_file) {
|
||||
janet_arity(argc, 1, -1);
|
||||
Janet x = janet_dyn(name);
|
||||
return cfun_io_printf_impl_x(argc, argv, newline, dflt_file, 0, x);
|
||||
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
|
||||
}
|
||||
@@ -496,6 +554,48 @@ static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
static Janet cfun_io_xprintf(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
static Janet cfun_io_xprinf(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
static void janet_flusher(const char *name, FILE *dflt_file) {
|
||||
Janet x = janet_dyn(name);
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NIL:
|
||||
fflush(dflt_file);
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &janet_file_type) break;
|
||||
JanetFile *iofile = abstract;
|
||||
fflush(iofile->file);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_io_flush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
janet_flusher("out", stdout);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_eflush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
janet_flusher("err", stderr);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
|
||||
va_list args;
|
||||
va_start(args, format);
|
||||
@@ -512,12 +612,12 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
janet_formatb(&buffer, format, args);
|
||||
janet_formatbv(&buffer, format, args);
|
||||
if (xtype == JANET_ABSTRACT) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype)
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
break;
|
||||
IOFile *iofile = abstract;
|
||||
JanetFile *iofile = abstract;
|
||||
f = iofile->file;
|
||||
}
|
||||
fwrite(buffer.data, buffer.count, 1, f);
|
||||
@@ -525,7 +625,7 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER:
|
||||
janet_formatb(janet_unwrap_buffer(x), format, args);
|
||||
janet_formatbv(janet_unwrap_buffer(x), format, args);
|
||||
break;
|
||||
}
|
||||
va_end(args);
|
||||
@@ -577,6 +677,39 @@ static const JanetReg io_cfuns[] = {
|
||||
JDOC("(eprinf fmt & xs)\n\n"
|
||||
"Like eprintf but with no trailing newline.")
|
||||
},
|
||||
{
|
||||
"xprint", cfun_io_xprint,
|
||||
JDOC("(xprint to & xs)\n\n"
|
||||
"Print to a file or other value explicitly (no dynamic bindings) with a trailing "
|
||||
"newline character. The value to print "
|
||||
"to is the first argument, and is otherwise the same as print. Returns nil.")
|
||||
},
|
||||
{
|
||||
"xprin", cfun_io_xprin,
|
||||
JDOC("(xprin to & xs)\n\n"
|
||||
"Print to a file or other value explicitly (no dynamic bindings). The value to print "
|
||||
"to is the first argument, and is otherwise the same as prin. Returns nil.")
|
||||
},
|
||||
{
|
||||
"xprintf", cfun_io_xprintf,
|
||||
JDOC("(xprint to fmt & xs)\n\n"
|
||||
"Like printf but prints to an explicit file or value to. Returns nil.")
|
||||
},
|
||||
{
|
||||
"xprinf", cfun_io_xprinf,
|
||||
JDOC("(xprin to fmt & xs)\n\n"
|
||||
"Like prinf but prints to an explicit file or value to. Returns nil.")
|
||||
},
|
||||
{
|
||||
"flush", cfun_io_flush,
|
||||
JDOC("(flush)\n\n"
|
||||
"Flush (dyn :out stdout) if it is a file, otherwise do nothing.")
|
||||
},
|
||||
{
|
||||
"eflush", cfun_io_eflush,
|
||||
JDOC("(eflush)\n\n"
|
||||
"Flush (dyn :err stderr) if it is a file, otherwise do nothing.")
|
||||
},
|
||||
{
|
||||
"file/temp", cfun_io_temp,
|
||||
JDOC("(file/temp)\n\n"
|
||||
@@ -595,27 +728,8 @@ static const JanetReg io_cfuns[] = {
|
||||
"\tw - allow writing to the file\n"
|
||||
"\ta - append to the file\n"
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it")
|
||||
},
|
||||
{
|
||||
"file/fdopen", cfun_io_fdopen,
|
||||
JDOC("(file/fdopen fd &opt mode)\n\n"
|
||||
"Create a file from an fd. fd is a platform specific file descriptor, and "
|
||||
"mode is a set of flags indicating the mode to open the file in. "
|
||||
"mode is a keyword where each character represents a flag. If the file "
|
||||
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
||||
"Mode flags:\n\n"
|
||||
"\tr - allow reading from the file\n"
|
||||
"\tw - allow writing to the file\n"
|
||||
"\ta - append to the file\n"
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it")
|
||||
},
|
||||
{
|
||||
"file/fileno", cfun_io_fileno,
|
||||
JDOC("(file/fileno f)\n\n"
|
||||
"Return the underlying file descriptor for the file as a number."
|
||||
"The meaning of this number is platform specific.")
|
||||
"\t+ - append to the file instead of overwriting it\n"
|
||||
"\tn - error if the file cannot be opened instead of returning nil")
|
||||
},
|
||||
{
|
||||
"file/close", cfun_io_fclose,
|
||||
@@ -660,6 +774,7 @@ static const JanetReg io_cfuns[] = {
|
||||
"for the relative number of bytes to seek in the file. n may be a real "
|
||||
"number to handle large files of more the 4GB. Returns the file handle.")
|
||||
},
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
{
|
||||
"file/popen", cfun_io_popen,
|
||||
JDOC("(file/popen path &opt mode)\n\n"
|
||||
@@ -668,27 +783,36 @@ static const JanetReg io_cfuns[] = {
|
||||
"process can be read from the file. In :w mode, the stdin of the process "
|
||||
"can be written to. Returns the new file.")
|
||||
},
|
||||
#endif
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* C API */
|
||||
|
||||
JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &janet_file_type);
|
||||
}
|
||||
|
||||
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
|
||||
IOFile *iof = janet_getabstract(argv, n, &cfun_io_filetype);
|
||||
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
|
||||
if (NULL != flags) *flags = iof->flags;
|
||||
return iof->file;
|
||||
}
|
||||
|
||||
Janet janet_makefile(FILE *f, int flags) {
|
||||
JanetFile *janet_makejfile(FILE *f, int flags) {
|
||||
return makef(f, flags);
|
||||
}
|
||||
|
||||
Janet janet_makefile(FILE *f, int flags) {
|
||||
return janet_wrap_abstract(makef(f, flags));
|
||||
}
|
||||
|
||||
JanetAbstract janet_checkfile(Janet j) {
|
||||
return janet_checkabstract(j, &cfun_io_filetype);
|
||||
return janet_checkabstract(j, &janet_file_type);
|
||||
}
|
||||
|
||||
FILE *janet_unwrapfile(Janet j, int *flags) {
|
||||
IOFile *iof = janet_unwrap_abstract(j);
|
||||
JanetFile *iof = janet_unwrap_abstract(j);
|
||||
if (NULL != flags) *flags = iof->flags;
|
||||
return iof->file;
|
||||
}
|
||||
@@ -696,18 +820,19 @@ FILE *janet_unwrapfile(Janet j, int *flags) {
|
||||
/* Module entry point */
|
||||
void janet_lib_io(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, io_cfuns);
|
||||
|
||||
janet_register_abstract_type(&janet_file_type);
|
||||
int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE;
|
||||
/* stdout */
|
||||
janet_core_def(env, "stdout",
|
||||
makef(stdout, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
janet_makefile(stdout, JANET_FILE_APPEND | default_flags),
|
||||
JDOC("The standard output file."));
|
||||
/* stderr */
|
||||
janet_core_def(env, "stderr",
|
||||
makef(stderr, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
janet_makefile(stderr, JANET_FILE_APPEND | default_flags),
|
||||
JDOC("The standard error file."));
|
||||
/* stdin */
|
||||
janet_core_def(env, "stdin",
|
||||
makef(stdin, JANET_FILE_READ | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
janet_makefile(stdin, JANET_FILE_READ | default_flags),
|
||||
JDOC("The standard input file."));
|
||||
|
||||
}
|
||||
|
||||
354
src/core/marsh.c
354
src/core/marsh.c
@@ -42,26 +42,28 @@ typedef struct {
|
||||
/* Lead bytes in marshaling protocol */
|
||||
enum {
|
||||
LB_REAL = 200,
|
||||
LB_NIL,
|
||||
LB_FALSE,
|
||||
LB_TRUE,
|
||||
LB_FIBER,
|
||||
LB_INTEGER,
|
||||
LB_STRING,
|
||||
LB_SYMBOL,
|
||||
LB_KEYWORD,
|
||||
LB_ARRAY,
|
||||
LB_TUPLE,
|
||||
LB_TABLE,
|
||||
LB_TABLE_PROTO,
|
||||
LB_STRUCT,
|
||||
LB_BUFFER,
|
||||
LB_FUNCTION,
|
||||
LB_REGISTRY,
|
||||
LB_ABSTRACT,
|
||||
LB_REFERENCE,
|
||||
LB_FUNCENV_REF,
|
||||
LB_FUNCDEF_REF
|
||||
LB_NIL, /* 201 */
|
||||
LB_FALSE, /* 202 */
|
||||
LB_TRUE, /* 203 */
|
||||
LB_FIBER, /* 204 */
|
||||
LB_INTEGER, /* 205 */
|
||||
LB_STRING, /* 206 */
|
||||
LB_SYMBOL, /* 207 */
|
||||
LB_KEYWORD, /* 208 */
|
||||
LB_ARRAY, /* 209 */
|
||||
LB_TUPLE, /* 210 */
|
||||
LB_TABLE, /* 211 */
|
||||
LB_TABLE_PROTO, /* 212 */
|
||||
LB_STRUCT, /* 213 */
|
||||
LB_BUFFER, /* 214 */
|
||||
LB_FUNCTION, /* 215 */
|
||||
LB_REGISTRY, /* 216 */
|
||||
LB_ABSTRACT, /* 217 */
|
||||
LB_REFERENCE, /* 218 */
|
||||
LB_FUNCENV_REF, /* 219 */
|
||||
LB_FUNCDEF_REF, /* 220 */
|
||||
LB_UNSAFE_CFUNCTION, /* 221 */
|
||||
LB_UNSAFE_POINTER /* 222 */
|
||||
} LeadBytes;
|
||||
|
||||
/* Helper to look inside an entry in an environment */
|
||||
@@ -95,8 +97,8 @@ void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix
|
||||
const uint8_t *oldsym = janet_unwrap_symbol(env->data[i].key);
|
||||
int32_t oldlen = janet_string_length(oldsym);
|
||||
uint8_t *symbuf = janet_smalloc(prelen + oldlen);
|
||||
memcpy(symbuf, prefix, prelen);
|
||||
memcpy(symbuf + prelen, oldsym, oldlen);
|
||||
safe_memcpy(symbuf, prefix, prelen);
|
||||
safe_memcpy(symbuf + prelen, oldsym, oldlen);
|
||||
Janet s = janet_symbolv(symbuf, prelen + oldlen);
|
||||
janet_sfree(symbuf);
|
||||
janet_table_put(renv, s, entry_getval(env->data[i].value));
|
||||
@@ -183,26 +185,43 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||
return;
|
||||
}
|
||||
}
|
||||
janet_env_valid(env);
|
||||
janet_v_push(st->seen_envs, env);
|
||||
pushint(st, env->offset);
|
||||
pushint(st, env->length);
|
||||
if (env->offset) {
|
||||
/* On stack variant */
|
||||
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
|
||||
if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
|
||||
pushint(st, 0);
|
||||
pushint(st, env->length);
|
||||
Janet *values = env->as.fiber->data + env->offset;
|
||||
uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset;
|
||||
for (int32_t i = 0; i < env->length; i++) {
|
||||
if (1 & (bitset[i >> 5] >> (i & 0x1F))) {
|
||||
marshal_one(st, values[i], flags + 1);
|
||||
} else {
|
||||
pushbyte(st, LB_NIL);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
/* Off stack variant */
|
||||
for (int32_t i = 0; i < env->length; i++)
|
||||
marshal_one(st, env->as.values[i], flags + 1);
|
||||
janet_env_maybe_detach(env);
|
||||
pushint(st, env->offset);
|
||||
pushint(st, env->length);
|
||||
if (env->offset > 0) {
|
||||
/* On stack variant */
|
||||
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
|
||||
} else {
|
||||
/* Off stack variant */
|
||||
for (int32_t i = 0; i < env->length; i++)
|
||||
marshal_one(st, env->as.values[i], flags + 1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Add function flags to janet functions */
|
||||
static void janet_func_addflags(JanetFuncDef *def) {
|
||||
if (def->name) def->flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (def->source) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (def->defs) def->flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (def->environments) def->flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (def->sourcemap) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
/* Marshal a sequence of u32s */
|
||||
static void janet_marshal_u32s(MarshalState *st, const uint32_t *u32s, int32_t n) {
|
||||
for (int32_t i = 0; i < n; i++) {
|
||||
pushbyte(st, u32s[i] & 0xFF);
|
||||
pushbyte(st, (u32s[i] >> 8) & 0xFF);
|
||||
pushbyte(st, (u32s[i] >> 16) & 0xFF);
|
||||
pushbyte(st, (u32s[i] >> 24) & 0xFF);
|
||||
}
|
||||
}
|
||||
|
||||
/* Marshal a function def */
|
||||
@@ -215,7 +234,6 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
return;
|
||||
}
|
||||
}
|
||||
janet_func_addflags(def);
|
||||
/* Add to lookup */
|
||||
janet_v_push(st->seen_defs, def);
|
||||
pushint(st, def->flags);
|
||||
@@ -239,12 +257,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
marshal_one(st, def->constants[i], flags);
|
||||
|
||||
/* marshal the bytecode */
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
pushbyte(st, def->bytecode[i] & 0xFF);
|
||||
pushbyte(st, (def->bytecode[i] >> 8) & 0xFF);
|
||||
pushbyte(st, (def->bytecode[i] >> 16) & 0xFF);
|
||||
pushbyte(st, (def->bytecode[i] >> 24) & 0xFF);
|
||||
}
|
||||
janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
|
||||
|
||||
/* marshal the environments if needed */
|
||||
for (int32_t i = 0; i < def->environments_length; i++)
|
||||
@@ -264,11 +277,16 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
current = map.line;
|
||||
}
|
||||
}
|
||||
|
||||
/* Marshal closure bitset, if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
|
||||
janet_marshal_u32s(st, def->closure_bitset, ((def->slotcount + 31) >> 5));
|
||||
}
|
||||
}
|
||||
|
||||
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
|
||||
#define JANET_FIBER_FLAG_HASENV (1 << 28)
|
||||
#define JANET_STACKFRAME_HASENV (1 << 30)
|
||||
#define JANET_FIBER_FLAG_HASENV (1 << 30)
|
||||
#define JANET_STACKFRAME_HASENV (1 << 31)
|
||||
|
||||
/* Marshal a fiber */
|
||||
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
@@ -537,9 +555,25 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
marshal_one_fiber(st, janet_unwrap_fiber(x), flags + 1);
|
||||
return;
|
||||
}
|
||||
case JANET_CFUNCTION: {
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
|
||||
MARK_SEEN();
|
||||
pushbyte(st, LB_UNSAFE_CFUNCTION);
|
||||
JanetCFunction cfn = janet_unwrap_cfunction(x);
|
||||
pushbytes(st, (uint8_t *) &cfn, sizeof(JanetCFunction));
|
||||
return;
|
||||
}
|
||||
case JANET_POINTER: {
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
|
||||
MARK_SEEN();
|
||||
pushbyte(st, LB_UNSAFE_POINTER);
|
||||
void *ptr = janet_unwrap_pointer(x);
|
||||
pushbytes(st, (uint8_t *) &ptr, sizeof(void *));
|
||||
return;
|
||||
}
|
||||
no_registry:
|
||||
default: {
|
||||
janet_panicf("no registry value and cannot marshal %p", x);
|
||||
return;
|
||||
}
|
||||
}
|
||||
#undef MARK_SEEN
|
||||
@@ -609,6 +643,15 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Helper to read a natural number (int >= 0). */
|
||||
static int32_t readnat(UnmarshalState *st, const uint8_t **atdata) {
|
||||
int32_t ret = readint(st, atdata);
|
||||
if (ret < 0) {
|
||||
janet_panicf("expected integer >= 0, got %d", ret);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Helper to read a size_t (up to 8 bytes unsigned). */
|
||||
static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
|
||||
uint64_t ret;
|
||||
@@ -677,36 +720,51 @@ static const uint8_t *unmarshal_one_env(
|
||||
JanetFuncEnv *env = janet_gcalloc(JANET_MEMORY_FUNCENV, sizeof(JanetFuncEnv));
|
||||
env->length = 0;
|
||||
env->offset = 0;
|
||||
env->as.values = NULL;
|
||||
janet_v_push(st->lookup_envs, env);
|
||||
int32_t offset = readint(st, &data);
|
||||
int32_t length = readint(st, &data);
|
||||
if (offset) {
|
||||
int32_t offset = readnat(st, &data);
|
||||
int32_t length = readnat(st, &data);
|
||||
if (offset > 0) {
|
||||
Janet fiberv;
|
||||
/* On stack variant */
|
||||
data = unmarshal_one(st, data, &fiberv, flags);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
env->as.fiber = janet_unwrap_fiber(fiberv);
|
||||
/* Unmarshalling fiber may set values */
|
||||
if (env->offset != 0 && env->offset != offset)
|
||||
janet_panic("invalid funcenv offset");
|
||||
if (env->length != 0 && env->length != length)
|
||||
janet_panic("invalid funcenv length");
|
||||
/* Negative offset indicates untrusted input */
|
||||
env->offset = -offset;
|
||||
} else {
|
||||
/* Off stack variant */
|
||||
if (length == 0) {
|
||||
janet_panic("invalid funcenv length");
|
||||
}
|
||||
env->as.values = malloc(sizeof(Janet) * (size_t) length);
|
||||
if (!env->as.values) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
env->offset = 0;
|
||||
for (int32_t i = 0; i < length; i++)
|
||||
data = unmarshal_one(st, data, env->as.values + i, flags);
|
||||
}
|
||||
env->offset = offset;
|
||||
env->length = length;
|
||||
*out = env;
|
||||
}
|
||||
return data;
|
||||
}
|
||||
|
||||
/* Unmarshal a series of u32s */
|
||||
static const uint8_t *janet_unmarshal_u32s(UnmarshalState *st, const uint8_t *data, uint32_t *into, int32_t n) {
|
||||
for (int32_t i = 0; i < n; i++) {
|
||||
MARSH_EOS(st, data + 3);
|
||||
into[i] =
|
||||
(uint32_t)(data[0]) |
|
||||
((uint32_t)(data[1]) << 8) |
|
||||
((uint32_t)(data[2]) << 16) |
|
||||
((uint32_t)(data[3]) << 24);
|
||||
data += 4;
|
||||
}
|
||||
return data;
|
||||
}
|
||||
|
||||
/* Unmarshal a funcdef */
|
||||
static const uint8_t *unmarshal_one_def(
|
||||
UnmarshalState *st,
|
||||
@@ -730,6 +788,12 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->bytecode_length = 0;
|
||||
def->name = NULL;
|
||||
def->source = NULL;
|
||||
def->closure_bitset = NULL;
|
||||
def->defs = NULL;
|
||||
def->environments = NULL;
|
||||
def->constants = NULL;
|
||||
def->bytecode = NULL;
|
||||
def->sourcemap = NULL;
|
||||
janet_v_push(st->lookup_defs, def);
|
||||
|
||||
/* Set default lengths to zero */
|
||||
@@ -740,18 +804,18 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Read flags and other fixed values */
|
||||
def->flags = readint(st, &data);
|
||||
def->slotcount = readint(st, &data);
|
||||
def->arity = readint(st, &data);
|
||||
def->min_arity = readint(st, &data);
|
||||
def->max_arity = readint(st, &data);
|
||||
def->slotcount = readnat(st, &data);
|
||||
def->arity = readnat(st, &data);
|
||||
def->min_arity = readnat(st, &data);
|
||||
def->max_arity = readnat(st, &data);
|
||||
|
||||
/* Read some lengths */
|
||||
constants_length = readint(st, &data);
|
||||
bytecode_length = readint(st, &data);
|
||||
constants_length = readnat(st, &data);
|
||||
bytecode_length = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
|
||||
environments_length = readint(st, &data);
|
||||
environments_length = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||
defs_length = readint(st, &data);
|
||||
defs_length = readnat(st, &data);
|
||||
|
||||
/* Check name and source (optional) */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
|
||||
@@ -785,15 +849,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
if (!def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (int32_t i = 0; i < bytecode_length; i++) {
|
||||
MARSH_EOS(st, data + 3);
|
||||
def->bytecode[i] =
|
||||
(uint32_t)(data[0]) |
|
||||
((uint32_t)(data[1]) << 8) |
|
||||
((uint32_t)(data[2]) << 16) |
|
||||
((uint32_t)(data[3]) << 24);
|
||||
data += 4;
|
||||
}
|
||||
data = janet_unmarshal_u32s(st, data, def->bytecode, bytecode_length);
|
||||
def->bytecode_length = bytecode_length;
|
||||
|
||||
/* Unmarshal environments */
|
||||
@@ -840,6 +896,16 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->sourcemap = NULL;
|
||||
}
|
||||
|
||||
/* Unmarshal closure bitset if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
|
||||
int32_t n = (def->slotcount + 31) >> 5;
|
||||
def->closure_bitset = malloc(sizeof(uint32_t) * (size_t) n);
|
||||
if (NULL == def->closure_bitset) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
data = janet_unmarshal_u32s(st, data, def->closure_bitset, n);
|
||||
}
|
||||
|
||||
/* Validate */
|
||||
if (janet_verify(def))
|
||||
janet_panic("funcdef has invalid bytecode");
|
||||
@@ -857,7 +923,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
JanetFiber **out,
|
||||
int flags) {
|
||||
|
||||
/* Initialize a new fiber */
|
||||
/* Initialize a new fiber with gc friendly defaults */
|
||||
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
|
||||
fiber->flags = 0;
|
||||
fiber->frame = 0;
|
||||
@@ -868,46 +934,47 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->data = NULL;
|
||||
fiber->child = NULL;
|
||||
fiber->env = NULL;
|
||||
fiber->waiting = NULL;
|
||||
fiber->timeout_index = -1;
|
||||
|
||||
/* Push fiber to seen stack */
|
||||
janet_v_push(st->lookup, janet_wrap_fiber(fiber));
|
||||
|
||||
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
|
||||
int32_t frame = 0;
|
||||
int32_t stack = 0;
|
||||
int32_t stacktop = 0;
|
||||
|
||||
/* Read ints */
|
||||
fiber->flags = readint(st, &data);
|
||||
frame = readint(st, &data);
|
||||
fiber->stackstart = readint(st, &data);
|
||||
fiber->stacktop = readint(st, &data);
|
||||
fiber->maxstack = readint(st, &data);
|
||||
int32_t fiber_flags = readint(st, &data);
|
||||
int32_t frame = readnat(st, &data);
|
||||
int32_t fiber_stackstart = readnat(st, &data);
|
||||
int32_t fiber_stacktop = readnat(st, &data);
|
||||
int32_t fiber_maxstack = readnat(st, &data);
|
||||
JanetTable *fiber_env = NULL;
|
||||
|
||||
/* Check for bad flags and ints */
|
||||
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart ||
|
||||
fiber->stackstart > fiber->stacktop ||
|
||||
fiber->stacktop > fiber->maxstack) {
|
||||
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber_stackstart ||
|
||||
fiber_stackstart > fiber_stacktop ||
|
||||
fiber_stacktop > fiber_maxstack) {
|
||||
janet_panic("fiber has incorrect stack setup");
|
||||
}
|
||||
|
||||
/* Allocate stack memory */
|
||||
fiber->capacity = fiber->stacktop + 10;
|
||||
fiber->capacity = fiber_stacktop + 10;
|
||||
fiber->data = malloc(sizeof(Janet) * fiber->capacity);
|
||||
if (!fiber->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (int32_t i = 0; i < fiber->capacity; i++) {
|
||||
fiber->data[i] = janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* get frames */
|
||||
stack = frame;
|
||||
stacktop = fiber->stackstart - JANET_FRAME_SIZE;
|
||||
int32_t stack = frame;
|
||||
int32_t stacktop = fiber_stackstart - JANET_FRAME_SIZE;
|
||||
while (stack > 0) {
|
||||
JanetFunction *func = NULL;
|
||||
JanetFuncDef *def = NULL;
|
||||
JanetFuncEnv *env = NULL;
|
||||
int32_t frameflags = readint(st, &data);
|
||||
int32_t prevframe = readint(st, &data);
|
||||
int32_t pcdiff = readint(st, &data);
|
||||
int32_t prevframe = readnat(st, &data);
|
||||
int32_t pcdiff = readnat(st, &data);
|
||||
|
||||
/* Get frame items */
|
||||
Janet *framestack = fiber->data + stack;
|
||||
@@ -923,15 +990,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
/* Check env */
|
||||
if (frameflags & JANET_STACKFRAME_HASENV) {
|
||||
frameflags &= ~JANET_STACKFRAME_HASENV;
|
||||
int32_t offset = stack;
|
||||
int32_t length = stacktop - stack;
|
||||
data = unmarshal_one_env(st, data, &env, flags + 1);
|
||||
if (env->offset != 0 && env->offset != offset)
|
||||
janet_panic("funcenv offset does not match fiber frame");
|
||||
if (env->length != 0 && env->length != length)
|
||||
janet_panic("funcenv length does not match fiber frame");
|
||||
env->offset = offset;
|
||||
env->length = length;
|
||||
}
|
||||
|
||||
/* Error checking */
|
||||
@@ -939,11 +998,11 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
if (expected_framesize != stacktop - stack) {
|
||||
janet_panic("fiber stackframe size mismatch");
|
||||
}
|
||||
if (pcdiff < 0 || pcdiff >= def->bytecode_length) {
|
||||
if (pcdiff >= def->bytecode_length) {
|
||||
janet_panic("fiber stackframe has invalid pc");
|
||||
}
|
||||
if ((int32_t)(prevframe + JANET_FRAME_SIZE) > stack) {
|
||||
janet_panic("fibre stackframe does not align with previous frame");
|
||||
janet_panic("fiber stackframe does not align with previous frame");
|
||||
}
|
||||
|
||||
/* Get stack items */
|
||||
@@ -966,25 +1025,37 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
}
|
||||
|
||||
/* Check for fiber env */
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASENV) {
|
||||
if (fiber_flags & JANET_FIBER_FLAG_HASENV) {
|
||||
Janet envv;
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
data = unmarshal_one(st, data, &envv, flags + 1);
|
||||
janet_asserttype(envv, JANET_TABLE);
|
||||
fiber->env = janet_unwrap_table(envv);
|
||||
fiber_env = janet_unwrap_table(envv);
|
||||
}
|
||||
|
||||
/* Check for child fiber */
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) {
|
||||
if (fiber_flags & JANET_FIBER_FLAG_HASCHILD) {
|
||||
Janet fiberv;
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
||||
data = unmarshal_one(st, data, &fiberv, flags + 1);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
fiber->child = janet_unwrap_fiber(fiberv);
|
||||
}
|
||||
|
||||
/* Return data */
|
||||
/* We have valid fiber, finally construct remaining fields. */
|
||||
fiber->frame = frame;
|
||||
fiber->flags = fiber_flags;
|
||||
fiber->stackstart = fiber_stackstart;
|
||||
fiber->stacktop = fiber_stacktop;
|
||||
fiber->maxstack = fiber_maxstack;
|
||||
fiber->env = fiber_env;
|
||||
|
||||
int status = janet_fiber_status(fiber);
|
||||
if (status < 0 || status > JANET_STATUS_ALIVE) {
|
||||
janet_panic("invalid fiber status");
|
||||
}
|
||||
|
||||
/* Return data */
|
||||
*out = fiber;
|
||||
return data;
|
||||
}
|
||||
@@ -1017,7 +1088,7 @@ uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
|
||||
void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
MARSH_EOS(st, ctx->data + len - 1);
|
||||
memcpy(dest, ctx->data, len);
|
||||
safe_memcpy(dest, ctx->data, len);
|
||||
ctx->data += len;
|
||||
}
|
||||
|
||||
@@ -1043,7 +1114,7 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
||||
Janet key;
|
||||
data = unmarshal_one(st, data, &key, flags + 1);
|
||||
const JanetAbstractType *at = janet_get_abstract_type(key);
|
||||
if (at == NULL) return NULL;
|
||||
if (at == NULL) goto oops;
|
||||
if (at->unmarshal) {
|
||||
JanetMarshalContext context = {NULL, st, flags, data, at};
|
||||
*out = janet_wrap_abstract(at->unmarshal(&context));
|
||||
@@ -1052,7 +1123,8 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
||||
}
|
||||
return context.data;
|
||||
}
|
||||
return NULL;
|
||||
oops:
|
||||
janet_panic("invalid abstract type");
|
||||
}
|
||||
|
||||
static const uint8_t *unmarshal_one(
|
||||
@@ -1064,7 +1136,7 @@ static const uint8_t *unmarshal_one(
|
||||
MARSH_STACKCHECK;
|
||||
MARSH_EOS(st, data);
|
||||
lead = data[0];
|
||||
if (lead < 200) {
|
||||
if (lead < LB_REAL) {
|
||||
*out = janet_wrap_integer(readint(st, &data));
|
||||
return data;
|
||||
}
|
||||
@@ -1100,7 +1172,7 @@ static const uint8_t *unmarshal_one(
|
||||
u.bytes[0] = data[8];
|
||||
u.bytes[1] = data[7];
|
||||
u.bytes[2] = data[6];
|
||||
u.bytes[5] = data[5];
|
||||
u.bytes[3] = data[5];
|
||||
u.bytes[4] = data[4];
|
||||
u.bytes[5] = data[3];
|
||||
u.bytes[6] = data[2];
|
||||
@@ -1118,7 +1190,7 @@ static const uint8_t *unmarshal_one(
|
||||
case LB_KEYWORD:
|
||||
case LB_REGISTRY: {
|
||||
data++;
|
||||
int32_t len = readint(st, &data);
|
||||
int32_t len = readnat(st, &data);
|
||||
MARSH_EOS(st, data - 1 + len);
|
||||
if (lead == LB_STRING) {
|
||||
const uint8_t *str = janet_string(data, len);
|
||||
@@ -1139,7 +1211,7 @@ static const uint8_t *unmarshal_one(
|
||||
} else { /* (lead == LB_BUFFER) */
|
||||
JanetBuffer *buffer = janet_buffer(len);
|
||||
buffer->count = len;
|
||||
memcpy(buffer->data, data, len);
|
||||
safe_memcpy(buffer->data, data, len);
|
||||
*out = janet_wrap_buffer(buffer);
|
||||
}
|
||||
janet_v_push(st->lookup, *out);
|
||||
@@ -1178,7 +1250,11 @@ static const uint8_t *unmarshal_one(
|
||||
/* Things that open with integers */
|
||||
{
|
||||
data++;
|
||||
int32_t len = readint(st, &data);
|
||||
int32_t len = readnat(st, &data);
|
||||
/* DOS check */
|
||||
if (lead != LB_REFERENCE) {
|
||||
MARSH_EOS(st, data - 1 + len);
|
||||
}
|
||||
if (lead == LB_ARRAY) {
|
||||
/* Array */
|
||||
JanetArray *array = janet_array(len);
|
||||
@@ -1210,7 +1286,7 @@ static const uint8_t *unmarshal_one(
|
||||
*out = janet_wrap_struct(janet_struct_end(struct_));
|
||||
janet_v_push(st->lookup, *out);
|
||||
} else if (lead == LB_REFERENCE) {
|
||||
if (len < 0 || len >= janet_v_count(st->lookup))
|
||||
if (len >= janet_v_count(st->lookup))
|
||||
janet_panicf("invalid reference %d", len);
|
||||
*out = st->lookup[len];
|
||||
} else {
|
||||
@@ -1233,6 +1309,42 @@ static const uint8_t *unmarshal_one(
|
||||
}
|
||||
return data;
|
||||
}
|
||||
case LB_UNSAFE_POINTER: {
|
||||
MARSH_EOS(st, data + sizeof(void *));
|
||||
data++;
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panicf("unsafe flag not given, "
|
||||
"will not unmarshal raw pointer at index %d",
|
||||
(int)(data - st->start));
|
||||
}
|
||||
union {
|
||||
void *ptr;
|
||||
uint8_t bytes[sizeof(void *)];
|
||||
} u;
|
||||
memcpy(u.bytes, data, sizeof(void *));
|
||||
data += sizeof(void *);
|
||||
*out = janet_wrap_pointer(u.ptr);
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
case LB_UNSAFE_CFUNCTION: {
|
||||
MARSH_EOS(st, data + sizeof(JanetCFunction));
|
||||
data++;
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panicf("unsafe flag not given, "
|
||||
"will not unmarshal function pointer at index %d",
|
||||
(int)(data - st->start));
|
||||
}
|
||||
union {
|
||||
JanetCFunction ptr;
|
||||
uint8_t bytes[sizeof(JanetCFunction)];
|
||||
} u;
|
||||
memcpy(u.bytes, data, sizeof(JanetCFunction));
|
||||
data += sizeof(JanetCFunction);
|
||||
*out = janet_wrap_cfunction(u.ptr);
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
default: {
|
||||
janet_panicf("unknown byte %x at index %d",
|
||||
*data,
|
||||
@@ -1274,7 +1386,7 @@ static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_marshal(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetBuffer *buffer;
|
||||
JanetTable *rreg = NULL;
|
||||
if (argc > 1) {
|
||||
@@ -1303,17 +1415,17 @@ static const JanetReg marsh_cfuns[] = {
|
||||
{
|
||||
"marshal", cfun_marshal,
|
||||
JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
|
||||
"Marshal a janet value into a buffer and return the buffer. The buffer "
|
||||
"Marshal a value into a buffer and return the buffer. The buffer "
|
||||
"can the later be unmarshalled to reconstruct the initial value. "
|
||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||
"aliased values that are found in the table. Then a forward"
|
||||
"lookup table can be used to recover the original janet value when "
|
||||
"lookup table can be used to recover the original value when "
|
||||
"unmarshalling.")
|
||||
},
|
||||
{
|
||||
"unmarshal", cfun_unmarshal,
|
||||
JDOC("(unmarshal buffer &opt lookup)\n\n"
|
||||
"Unmarshal a janet value from a buffer. An optional lookup table "
|
||||
"Unmarshal a value from a buffer. An optional lookup table "
|
||||
"can be provided to allow for aliases to be resolved. Returns the value "
|
||||
"unmarshalled from the buffer.")
|
||||
},
|
||||
|
||||
@@ -52,7 +52,7 @@ static void *janet_rng_unmarshal(JanetMarshalContext *ctx) {
|
||||
return rng;
|
||||
}
|
||||
|
||||
static JanetAbstractType JanetRNG_type = {
|
||||
const JanetAbstractType janet_rng_type = {
|
||||
"core/rng",
|
||||
NULL,
|
||||
NULL,
|
||||
@@ -60,9 +60,7 @@ static JanetAbstractType JanetRNG_type = {
|
||||
NULL,
|
||||
janet_rng_marshal,
|
||||
janet_rng_unmarshal,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
JanetRNG *janet_default_rng(void) {
|
||||
@@ -117,7 +115,7 @@ double janet_rng_double(JanetRNG *rng) {
|
||||
|
||||
static Janet cfun_rng_make(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
JanetRNG *rng = janet_abstract(&JanetRNG_type, sizeof(JanetRNG));
|
||||
JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG));
|
||||
if (argc == 1) {
|
||||
if (janet_checkint(argv[0])) {
|
||||
uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
|
||||
@@ -134,13 +132,13 @@ static Janet cfun_rng_make(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_rng_uniform(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
return janet_wrap_number(janet_rng_double(rng));
|
||||
}
|
||||
|
||||
static Janet cfun_rng_int(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
if (argc == 1) {
|
||||
uint32_t word = janet_rng_u32(rng) >> 1;
|
||||
return janet_wrap_integer(word);
|
||||
@@ -168,7 +166,7 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
|
||||
|
||||
static Janet cfun_rng_buffer(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, n);
|
||||
|
||||
@@ -225,13 +223,6 @@ static Janet janet_srand(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_remainder(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
double x = janet_getnumber(argv, 0);
|
||||
double y = janet_getnumber(argv, 1);
|
||||
return janet_wrap_number(fmod(x, y));
|
||||
}
|
||||
|
||||
#define JANET_DEFINE_MATHOP(name, fop)\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
janet_fixarity(argc, 1); \
|
||||
@@ -264,6 +255,10 @@ JANET_DEFINE_MATHOP(fabs, fabs)
|
||||
JANET_DEFINE_MATHOP(floor, floor)
|
||||
JANET_DEFINE_MATHOP(trunc, trunc)
|
||||
JANET_DEFINE_MATHOP(round, round)
|
||||
JANET_DEFINE_MATHOP(gamma, lgamma)
|
||||
JANET_DEFINE_MATHOP(log1p, log1p)
|
||||
JANET_DEFINE_MATHOP(erf, erf)
|
||||
JANET_DEFINE_MATHOP(erfc, erfc)
|
||||
|
||||
#define JANET_DEFINE_MATH2OP(name, fop)\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
@@ -276,6 +271,7 @@ static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
JANET_DEFINE_MATH2OP(atan2, atan2)
|
||||
JANET_DEFINE_MATH2OP(pow, pow)
|
||||
JANET_DEFINE_MATH2OP(hypot, hypot)
|
||||
JANET_DEFINE_MATH2OP(nextafter, nextafter)
|
||||
|
||||
static Janet janet_not(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
@@ -283,11 +279,6 @@ static Janet janet_not(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static const JanetReg math_cfuns[] = {
|
||||
{
|
||||
"%", janet_remainder,
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor.")
|
||||
},
|
||||
{
|
||||
"not", janet_not,
|
||||
JDOC("(not x)\n\nReturns the boolean inverse of x.")
|
||||
@@ -422,7 +413,7 @@ static const JanetReg math_cfuns[] = {
|
||||
"math/rng", cfun_rng_make,
|
||||
JDOC("(math/rng &opt seed)\n\n"
|
||||
"Creates a Psuedo-Random number generator, with an optional seed. "
|
||||
"The seed should be an unsigned 32 bit integer. "
|
||||
"The seed should be an unsigned 32 bit integer or a buffer. "
|
||||
"Do not use this for cryptography. Returns a core/rng abstract type.")
|
||||
},
|
||||
{
|
||||
@@ -452,6 +443,26 @@ static const JanetReg math_cfuns[] = {
|
||||
JDOC("(math/exp2 x)\n\n"
|
||||
"Returns 2 to the power of x.")
|
||||
},
|
||||
{
|
||||
"math/log1p", janet_log1p,
|
||||
JDOC("(math/log1p x)\n\n"
|
||||
"Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
|
||||
},
|
||||
{
|
||||
"math/gamma", janet_gamma,
|
||||
JDOC("(math/gamma x)\n\n"
|
||||
"Returns gamma(x).")
|
||||
},
|
||||
{
|
||||
"math/erfc", janet_erfc,
|
||||
JDOC("(math/erfc x)\n\n"
|
||||
"Returns the complementary error function of x.")
|
||||
},
|
||||
{
|
||||
"math/erf", janet_erf,
|
||||
JDOC("(math/erf x)\n\n"
|
||||
"Returns the error function of x.")
|
||||
},
|
||||
{
|
||||
"math/expm1", janet_expm1,
|
||||
JDOC("(math/expm1 x)\n\n"
|
||||
@@ -467,13 +478,18 @@ static const JanetReg math_cfuns[] = {
|
||||
JDOC("(math/round x)\n\n"
|
||||
"Returns the integer nearest to x.")
|
||||
},
|
||||
{
|
||||
"math/next", janet_nextafter,
|
||||
JDOC("(math/next x y)\n\n"
|
||||
"Returns the next representable floating point value after x in the direction of y.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_math(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, math_cfuns);
|
||||
janet_register_abstract_type(&JanetRNG_type);
|
||||
janet_register_abstract_type(&janet_rng_type);
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
||||
JDOC("The value pi."));
|
||||
@@ -483,5 +499,19 @@ void janet_lib_math(JanetTable *env) {
|
||||
JDOC("The number representing positive infinity"));
|
||||
janet_def(env, "math/-inf", janet_wrap_number(-INFINITY),
|
||||
JDOC("The number representing negative infinity"));
|
||||
janet_def(env, "math/int32-min", janet_wrap_number(INT32_MIN),
|
||||
JDOC("The maximum contiguous integer representable by a 32 bit signed integer"));
|
||||
janet_def(env, "math/int32-max", janet_wrap_number(INT32_MAX),
|
||||
JDOC("The minimum contiguous integer represtenable by a 32 bit signed integer"));
|
||||
janet_def(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
|
||||
JDOC("The maximum contiguous integer representable by a double (2^53)"));
|
||||
janet_def(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
|
||||
JDOC("The minimum contiguous integer represtenable by a double (-(2^53))"));
|
||||
#ifdef NAN
|
||||
janet_def(env, "math/nan", janet_wrap_number(NAN),
|
||||
#else
|
||||
janet_def(env, "math/nan", janet_wrap_number(0.0 / 0.0),
|
||||
#endif
|
||||
JDOC("Not a number (IEEE-754 NaN)"));
|
||||
#endif
|
||||
}
|
||||
|
||||
961
src/core/net.c
Normal file
961
src/core/net.c
Normal file
@@ -0,0 +1,961 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_NET
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <winsock2.h>
|
||||
#include <windows.h>
|
||||
#include <ws2tcpip.h>
|
||||
#pragma comment (lib, "Ws2_32.lib")
|
||||
#pragma comment (lib, "Mswsock.lib")
|
||||
#pragma comment (lib, "Advapi32.lib")
|
||||
#else
|
||||
#include <unistd.h>
|
||||
#include <signal.h>
|
||||
#include <sys/ioctl.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/socket.h>
|
||||
#include <sys/un.h>
|
||||
#include <netinet/tcp.h>
|
||||
#include <netdb.h>
|
||||
#include <fcntl.h>
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Streams - simple abstract type that wraps a pollable + extra flags
|
||||
*/
|
||||
|
||||
#define JANET_STREAM_READABLE 0x200
|
||||
#define JANET_STREAM_WRITABLE 0x400
|
||||
#define JANET_STREAM_ACCEPTABLE 0x800
|
||||
#define JANET_STREAM_UDPSERVER 0x1000
|
||||
|
||||
static int janet_stream_close(void *p, size_t s);
|
||||
static int janet_stream_mark(void *p, size_t s);
|
||||
static int janet_stream_getter(void *p, Janet key, Janet *out);
|
||||
static const JanetAbstractType StreamAT = {
|
||||
"core/stream",
|
||||
janet_stream_close,
|
||||
janet_stream_mark,
|
||||
janet_stream_getter,
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
typedef JanetPollable JanetStream;
|
||||
|
||||
static const JanetAbstractType AddressAT = {
|
||||
"core/socket-address",
|
||||
JANET_ATEND_NAME
|
||||
};
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#define JSOCKCLOSE(x) closesocket((SOCKET) x)
|
||||
#define JSOCKDEFAULT INVALID_SOCKET
|
||||
#define JLASTERR WSAGetLastError()
|
||||
#define JSOCKVALID(x) ((x) != INVALID_SOCKET)
|
||||
#define JEINTR WSAEINTR
|
||||
#define JEWOULDBLOCK WSAEWOULDBLOCK
|
||||
#define JEAGAIN WSAEWOULDBLOCK
|
||||
#define JPOLL WSAPoll
|
||||
#define JSock SOCKET
|
||||
#define JReadInt long
|
||||
#define JSOCKFLAGS 0
|
||||
static JanetStream *make_stream(SOCKET fd, uint32_t flags) {
|
||||
u_long iMode = 0;
|
||||
JanetStream *stream = janet_abstract(&StreamAT, sizeof(JanetStream));
|
||||
janet_pollable_init(stream, (JanetHandle) fd);
|
||||
ioctlsocket(fd, FIONBIO, &iMode);
|
||||
stream->flags = flags;
|
||||
return stream;
|
||||
}
|
||||
#else
|
||||
#define JSOCKCLOSE(x) close(x)
|
||||
#define JSOCKDEFAULT 0
|
||||
#define JLASTERR errno
|
||||
#define JSOCKVALID(x) ((x) >= 0)
|
||||
#define JEINTR EINTR
|
||||
#define JEWOULDBLOCK EWOULDBLOCK
|
||||
#define JEAGAIN EAGAIN
|
||||
#define JPOLL poll
|
||||
#define JSock int
|
||||
#define JReadInt ssize_t
|
||||
#ifdef SOCK_CLOEXEC
|
||||
#define JSOCKFLAGS SOCK_CLOEXEC
|
||||
#else
|
||||
#define JSOCKFLAGS 0
|
||||
#endif
|
||||
static JanetStream *make_stream(int fd, uint32_t flags) {
|
||||
JanetStream *stream = janet_abstract(&StreamAT, sizeof(JanetStream));
|
||||
janet_pollable_init(stream, fd);
|
||||
#if !defined(SOCK_CLOEXEC) && defined(O_CLOEXEC)
|
||||
int extra = O_CLOEXEC;
|
||||
#else
|
||||
int extra = 0;
|
||||
#endif
|
||||
fcntl(fd, F_SETFL, fcntl(fd, F_GETFL, 0) | O_NONBLOCK | extra);
|
||||
stream->flags = flags;
|
||||
return stream;
|
||||
}
|
||||
#endif
|
||||
|
||||
/* We pass this flag to all send calls to prevent sigpipe */
|
||||
#ifndef MSG_NOSIGNAL
|
||||
#define MSG_NOSIGNAL 0
|
||||
#endif
|
||||
|
||||
static int janet_stream_close(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetStream *stream = p;
|
||||
if (!(stream->flags & JANET_POLL_FLAG_CLOSED)) {
|
||||
JSOCKCLOSE(stream->handle);
|
||||
janet_pollable_deinit(stream);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void nosigpipe(JSock s) {
|
||||
#ifdef SO_NOSIGPIPE
|
||||
int enable = 1;
|
||||
if (setsockopt(s, SOL_SOCKET, SO_NOSIGPIPE, &enable, sizeof(int)) < 0) {
|
||||
JSOCKCLOSE(s);
|
||||
janet_panic("setsockopt(SO_NOSIGPIPE) failed");
|
||||
}
|
||||
#else
|
||||
(void) s;
|
||||
#endif
|
||||
}
|
||||
|
||||
static int janet_stream_mark(void *p, size_t s) {
|
||||
(void) s;
|
||||
janet_pollable_mark((JanetPollable *) p);
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* State machine for read
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
JanetListenerState head;
|
||||
int32_t bytes_left;
|
||||
JanetBuffer *buf;
|
||||
int is_chunk;
|
||||
int is_recv_from;
|
||||
#ifdef JANET_WINDOWS
|
||||
WSAOVERLAPPED overlapped;
|
||||
uint8_t chunk_buf[2048];
|
||||
#endif
|
||||
} NetStateRead;
|
||||
|
||||
JanetAsyncStatus net_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
NetStateRead *state = (NetStateRead *) s;
|
||||
switch (event) {
|
||||
default:
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_MARK:
|
||||
janet_mark(janet_wrap_buffer(state->buf));
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_cancel(s->fiber, janet_cstringv("stream closed"));
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
#ifdef JANET_WINDOWS
|
||||
case JANET_ASYNC_EVENT_COMPLETE: {
|
||||
/* Called when read finished */
|
||||
}
|
||||
break;
|
||||
#else
|
||||
case JANET_ASYNC_EVENT_READ:
|
||||
/* Read in bytes */
|
||||
{
|
||||
JanetBuffer *buffer = state->buf;
|
||||
int32_t bytes_left = state->bytes_left;
|
||||
janet_buffer_extra(buffer, bytes_left);
|
||||
JReadInt nread;
|
||||
char saddr[256];
|
||||
socklen_t socklen = sizeof(saddr);
|
||||
do {
|
||||
if (state->is_recv_from) {
|
||||
nread = recvfrom(s->pollable->handle, buffer->data + buffer->count, bytes_left, 0,
|
||||
(struct sockaddr *)&saddr, &socklen);
|
||||
} else {
|
||||
nread = recv(s->pollable->handle, buffer->data + buffer->count, bytes_left, 0);
|
||||
}
|
||||
} while (nread == -1 && JLASTERR == JEINTR);
|
||||
if (JLASTERR == JEAGAIN || JLASTERR == JEWOULDBLOCK) {
|
||||
break;
|
||||
}
|
||||
|
||||
/* Increment buffer counts */
|
||||
if (nread > 0) {
|
||||
buffer->count += nread;
|
||||
bytes_left -= nread;
|
||||
} else {
|
||||
bytes_left = 0;
|
||||
}
|
||||
state->bytes_left = bytes_left;
|
||||
|
||||
/* Resume if done */
|
||||
if (!state->is_chunk || bytes_left == 0) {
|
||||
JanetSignal sig = JANET_SIGNAL_OK;
|
||||
Janet resume_val;
|
||||
if (state->is_recv_from) {
|
||||
void *abst = janet_abstract(&AddressAT, socklen);
|
||||
memcpy(abst, &saddr, socklen);
|
||||
resume_val = janet_wrap_abstract(abst);
|
||||
} else {
|
||||
if (nread > 0) {
|
||||
resume_val = janet_wrap_buffer(buffer);
|
||||
} else {
|
||||
sig = JANET_SIGNAL_ERROR;
|
||||
resume_val = (nread == -1)
|
||||
? janet_cstringv(strerror(JLASTERR))
|
||||
: janet_cstringv("could not read");
|
||||
}
|
||||
}
|
||||
janet_schedule_signal(s->fiber, resume_val, sig);
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
}
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
}
|
||||
return JANET_ASYNC_STATUS_NOT_DONE;
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes) {
|
||||
NetStateRead *state = (NetStateRead *) janet_listen(stream, net_machine_read,
|
||||
JANET_ASYNC_LISTEN_READ, sizeof(NetStateRead), NULL);
|
||||
state->is_chunk = 0;
|
||||
state->buf = buf;
|
||||
state->bytes_left = nbytes;
|
||||
state->is_recv_from = 0;
|
||||
#ifdef JANET_WINDOWS
|
||||
WSARecv((SOCKET) stream->handle,
|
||||
|
||||
#endif
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_chunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes) {
|
||||
NetStateRead *state = (NetStateRead *) janet_listen(stream, net_machine_read,
|
||||
JANET_ASYNC_LISTEN_READ, sizeof(NetStateRead), NULL);
|
||||
state->is_chunk = 1;
|
||||
state->buf = buf;
|
||||
state->bytes_left = nbytes;
|
||||
state->is_recv_from = 0;
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_recv_from(JanetStream *stream, JanetBuffer *buf, int32_t nbytes) {
|
||||
NetStateRead *state = (NetStateRead *) janet_listen(stream, net_machine_read,
|
||||
JANET_ASYNC_LISTEN_READ, sizeof(NetStateRead), NULL);
|
||||
state->is_chunk = 0;
|
||||
state->buf = buf;
|
||||
state->bytes_left = nbytes;
|
||||
state->is_recv_from = 1;
|
||||
janet_await();
|
||||
}
|
||||
|
||||
/*
|
||||
* State machine for write/send-to
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
JanetListenerState head;
|
||||
union {
|
||||
JanetBuffer *buf;
|
||||
const uint8_t *str;
|
||||
} src;
|
||||
int32_t start;
|
||||
int is_buffer;
|
||||
void *dest_abst;
|
||||
} NetStateWrite;
|
||||
|
||||
JanetAsyncStatus net_machine_write(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
NetStateWrite *state = (NetStateWrite *) s;
|
||||
switch (event) {
|
||||
default:
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_MARK:
|
||||
janet_mark(state->is_buffer
|
||||
? janet_wrap_buffer(state->src.buf)
|
||||
: janet_wrap_string(state->src.str));
|
||||
if (state->dest_abst != NULL) {
|
||||
janet_mark(janet_wrap_abstract(state->dest_abst));
|
||||
}
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_cancel(s->fiber, janet_cstringv("stream closed"));
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
#ifdef JANET_WINDOWS
|
||||
case JANET_ASYNC_EVENT_INIT: {
|
||||
/* Begin write */
|
||||
}
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_COMPLETE: {
|
||||
|
||||
/* Called when write finished */
|
||||
}
|
||||
break;
|
||||
#else
|
||||
case JANET_ASYNC_EVENT_WRITE: {
|
||||
int32_t start, len;
|
||||
const uint8_t *bytes;
|
||||
start = state->start;
|
||||
if (state->is_buffer) {
|
||||
JanetBuffer *buffer = state->src.buf;
|
||||
bytes = buffer->data;
|
||||
len = buffer->count;
|
||||
} else {
|
||||
bytes = state->src.str;
|
||||
len = janet_string_length(bytes);
|
||||
}
|
||||
JReadInt nwrote = 0;
|
||||
if (start < len) {
|
||||
int32_t nbytes = len - start;
|
||||
do {
|
||||
void *dest_abst = state->dest_abst;
|
||||
if (dest_abst) {
|
||||
nwrote = sendto(s->pollable->handle, bytes + start, nbytes, 0,
|
||||
(struct sockaddr *) dest_abst, janet_abstract_size(dest_abst));
|
||||
} else {
|
||||
nwrote = send(s->pollable->handle, bytes + start, nbytes, MSG_NOSIGNAL);
|
||||
}
|
||||
} while (nwrote == -1 && JLASTERR == JEINTR);
|
||||
if (nwrote > 0) {
|
||||
start += nwrote;
|
||||
} else {
|
||||
start = len;
|
||||
}
|
||||
}
|
||||
state->start = start;
|
||||
if (start >= len) {
|
||||
if (nwrote > 0) {
|
||||
janet_schedule(s->fiber, janet_wrap_nil());
|
||||
} else if (nwrote == 0) {
|
||||
janet_cancel(s->fiber, janet_cstringv("could not write"));
|
||||
} else {
|
||||
janet_cancel(s->fiber, janet_cstringv(strerror(JLASTERR)));
|
||||
}
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
}
|
||||
break;
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
}
|
||||
return JANET_ASYNC_STATUS_NOT_DONE;
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_write_buffer(JanetStream *stream, JanetBuffer *buf, void *dest_abst) {
|
||||
NetStateWrite *state = (NetStateWrite *) janet_listen(stream, net_machine_write,
|
||||
JANET_ASYNC_LISTEN_WRITE, sizeof(NetStateWrite), NULL);
|
||||
state->is_buffer = 1;
|
||||
state->start = 0;
|
||||
state->src.buf = buf;
|
||||
state->dest_abst = dest_abst;
|
||||
janet_await();
|
||||
}
|
||||
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_write_stringlike(JanetStream *stream, const uint8_t *str, void *dest_abst) {
|
||||
NetStateWrite *state = (NetStateWrite *) janet_listen(stream, net_machine_write,
|
||||
JANET_ASYNC_LISTEN_WRITE, sizeof(NetStateWrite), NULL);
|
||||
state->is_buffer = 0;
|
||||
state->start = 0;
|
||||
state->src.str = str;
|
||||
state->dest_abst = dest_abst;
|
||||
janet_await();
|
||||
}
|
||||
|
||||
/*
|
||||
* State machine for simple server
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
JanetListenerState head;
|
||||
JanetFunction *function;
|
||||
} NetStateSimpleServer;
|
||||
|
||||
JanetAsyncStatus net_machine_simple_server(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
NetStateSimpleServer *state = (NetStateSimpleServer *) s;
|
||||
switch (event) {
|
||||
default:
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_INIT:
|
||||
/* We know the pollable will be a stream */
|
||||
janet_gcroot(janet_wrap_abstract(s->pollable));
|
||||
#ifdef JANET_WINDOWS
|
||||
/* requires some more setup code */
|
||||
#endif
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_MARK:
|
||||
janet_mark(janet_wrap_function(state->function));
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_gcunroot(janet_wrap_abstract(s->pollable));
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
#ifdef JANET_WINDOWS
|
||||
case JANET_ASYNC_EVENT_COMPLETE: {
|
||||
/* Called when ever we get an IOCP event */
|
||||
}
|
||||
break;
|
||||
#else
|
||||
case JANET_ASYNC_EVENT_READ: {
|
||||
JSock connfd = accept(s->pollable->handle, NULL, NULL);
|
||||
if (JSOCKVALID(connfd)) {
|
||||
/* Made a new connection socket */
|
||||
nosigpipe(connfd);
|
||||
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
Janet streamv = janet_wrap_abstract(stream);
|
||||
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
}
|
||||
break;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
return JANET_ASYNC_STATUS_NOT_DONE;
|
||||
}
|
||||
|
||||
/* State machine for accepting connections. */
|
||||
|
||||
typedef struct {
|
||||
JanetListenerState head;
|
||||
} NetStateAccept;
|
||||
|
||||
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
switch (event) {
|
||||
default:
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_cancel(s->fiber, janet_cstringv("stream closed"));
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
#ifdef JANET_WINDOWS
|
||||
case JANET_ASYNC_EVENT_INIT: {
|
||||
|
||||
}
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_COMPLETE: {
|
||||
|
||||
}
|
||||
break;
|
||||
#else
|
||||
case JANET_ASYNC_EVENT_READ: {
|
||||
JSock connfd = accept(s->pollable->handle, NULL, NULL);
|
||||
if (JSOCKVALID(connfd)) {
|
||||
nosigpipe(connfd);
|
||||
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
Janet streamv = janet_wrap_abstract(stream);
|
||||
janet_schedule(s->fiber, streamv);
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
}
|
||||
break;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
return JANET_ASYNC_STATUS_NOT_DONE;
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream) {
|
||||
janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
|
||||
janet_await();
|
||||
}
|
||||
|
||||
/* Adress info */
|
||||
|
||||
static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
|
||||
JanetKeyword stype = janet_optkeyword(argv, argc, n, NULL);
|
||||
int socktype = SOCK_DGRAM;
|
||||
if ((NULL == stype) || !janet_cstrcmp(stype, "stream")) {
|
||||
socktype = SOCK_STREAM;
|
||||
} else if (janet_cstrcmp(stype, "datagram")) {
|
||||
janet_panicf("expected socket type as :stream or :datagram, got %v", argv[n]);
|
||||
}
|
||||
return socktype;
|
||||
}
|
||||
|
||||
/* Needs argc >= offset + 2 */
|
||||
/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1, otherwise 0 */
|
||||
static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix) {
|
||||
/* Unix socket support - not yet supported on windows. */
|
||||
#ifndef JANET_WINDOWS
|
||||
if (janet_keyeq(argv[offset], "unix")) {
|
||||
const char *path = janet_getcstring(argv, offset + 1);
|
||||
struct sockaddr_un *saddr = malloc(sizeof(struct sockaddr_un));
|
||||
if (saddr == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
saddr->sun_family = AF_UNIX;
|
||||
snprintf(saddr->sun_path, 108, "%s", path);
|
||||
*is_unix = 1;
|
||||
return (struct addrinfo *) saddr;
|
||||
}
|
||||
#endif
|
||||
/* Get host and port */
|
||||
const char *host = janet_getcstring(argv, offset);
|
||||
const char *port;
|
||||
if (janet_checkint(argv[offset + 1])) {
|
||||
port = (const char *)janet_to_string(argv[offset + 1]);
|
||||
} else {
|
||||
port = janet_optcstring(argv, offset + 2, offset + 1, NULL);
|
||||
}
|
||||
/* getaddrinfo */
|
||||
struct addrinfo *ai = NULL;
|
||||
struct addrinfo hints;
|
||||
memset(&hints, 0, sizeof(hints));
|
||||
hints.ai_family = AF_UNSPEC;
|
||||
hints.ai_socktype = socktype;
|
||||
hints.ai_flags = passive ? AI_PASSIVE : 0;
|
||||
int status = getaddrinfo(host, port, &hints, &ai);
|
||||
if (status) {
|
||||
janet_panicf("could not get address info: %s", gai_strerror(status));
|
||||
}
|
||||
*is_unix = 0;
|
||||
return ai;
|
||||
}
|
||||
|
||||
/*
|
||||
* C Funs
|
||||
*/
|
||||
|
||||
static Janet cfun_net_sockaddr(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 4);
|
||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||
int is_unix = 0;
|
||||
int make_arr = (argc >= 3 && janet_truthy(argv[3]));
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
|
||||
#ifndef JANET_WINDOWS
|
||||
/* no unix domain socket support on windows yet */
|
||||
if (is_unix) {
|
||||
void *abst = janet_abstract(&AddressAT, sizeof(struct sockaddr_un));
|
||||
memcpy(abst, ai, sizeof(struct sockaddr_un));
|
||||
Janet ret = janet_wrap_abstract(abst);
|
||||
return make_arr ? janet_wrap_array(janet_array_n(&ret, 1)) : ret;
|
||||
}
|
||||
#endif
|
||||
if (make_arr) {
|
||||
/* Select all */
|
||||
JanetArray *arr = janet_array(10);
|
||||
struct addrinfo *iter = ai;
|
||||
while (NULL != iter) {
|
||||
void *abst = janet_abstract(&AddressAT, iter->ai_addrlen);
|
||||
memcpy(abst, iter->ai_addr, iter->ai_addrlen);
|
||||
janet_array_push(arr, janet_wrap_abstract(abst));
|
||||
iter = iter->ai_next;
|
||||
}
|
||||
freeaddrinfo(ai);
|
||||
return janet_wrap_array(arr);
|
||||
} else {
|
||||
/* Select first */
|
||||
if (NULL == ai) {
|
||||
janet_panic("no data for given address");
|
||||
}
|
||||
void *abst = janet_abstract(&AddressAT, ai->ai_addrlen);
|
||||
memcpy(abst, ai->ai_addr, ai->ai_addrlen);
|
||||
freeaddrinfo(ai);
|
||||
return janet_wrap_abstract(abst);
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_net_connect(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
|
||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||
int is_unix = 0;
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
|
||||
|
||||
/* Create socket */
|
||||
JSock sock = JSOCKDEFAULT;
|
||||
void *addr = NULL;
|
||||
socklen_t addrlen;
|
||||
#ifndef JANET_WINDOWS
|
||||
if (is_unix) {
|
||||
sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
|
||||
if (!JSOCKVALID(sock)) {
|
||||
janet_panic("could not create socket");
|
||||
}
|
||||
addr = (void *) ai;
|
||||
addrlen = sizeof(struct sockaddr_un);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
struct addrinfo *rp = NULL;
|
||||
for (rp = ai; rp != NULL; rp = rp->ai_next) {
|
||||
sock = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
|
||||
if (JSOCKVALID(sock)) {
|
||||
addr = rp->ai_addr;
|
||||
addrlen = (socklen_t) rp->ai_addrlen;
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (NULL == addr) {
|
||||
freeaddrinfo(ai);
|
||||
janet_panic("could not create socket");
|
||||
}
|
||||
}
|
||||
|
||||
/* Connect to socket */
|
||||
int status = connect(sock, addr, addrlen);
|
||||
if (is_unix) {
|
||||
free(ai);
|
||||
} else {
|
||||
freeaddrinfo(ai);
|
||||
}
|
||||
|
||||
if (status == -1) {
|
||||
JSOCKCLOSE(sock);
|
||||
janet_panic("could not connect to socket");
|
||||
}
|
||||
|
||||
nosigpipe(sock);
|
||||
|
||||
/* Wrap socket in abstract type JanetStream */
|
||||
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
return janet_wrap_abstract(stream);
|
||||
}
|
||||
|
||||
static const char *serverify_socket(JSock sfd) {
|
||||
/* Set various socket options */
|
||||
int enable = 1;
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
|
||||
return "setsockopt(SO_REUSEADDR) failed";
|
||||
}
|
||||
#ifdef SO_REUSEPORT
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
|
||||
return "setsockopt(SO_REUSEPORT) failed";
|
||||
}
|
||||
#endif
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static Janet cfun_net_server(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 4);
|
||||
|
||||
/* Get host, port, and handler*/
|
||||
JanetFunction *fun = janet_optfunction(argv, argc, 2, NULL);
|
||||
|
||||
int socktype = janet_get_sockettype(argv, argc, 3);
|
||||
int is_unix = 0;
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix);
|
||||
|
||||
JSock sfd = JSOCKDEFAULT;
|
||||
#ifndef JANET_WINDOWS
|
||||
if (is_unix) {
|
||||
sfd = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
|
||||
if (!JSOCKVALID(sfd)) {
|
||||
free(ai);
|
||||
janet_panic("could not create socket");
|
||||
}
|
||||
const char *err = serverify_socket(sfd);
|
||||
if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) {
|
||||
JSOCKCLOSE(sfd);
|
||||
free(ai);
|
||||
janet_panic(err ? err : "could not bind socket");
|
||||
}
|
||||
free(ai);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
/* Check all addrinfos in a loop for the first that we can bind to. */
|
||||
struct addrinfo *rp = NULL;
|
||||
for (rp = ai; rp != NULL; rp = rp->ai_next) {
|
||||
sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
|
||||
if (!JSOCKVALID(sfd)) continue;
|
||||
const char *err = serverify_socket(sfd);
|
||||
if (NULL != err) {
|
||||
JSOCKCLOSE(sfd);
|
||||
continue;
|
||||
}
|
||||
/* Bind */
|
||||
if (bind(sfd, rp->ai_addr, (int) rp->ai_addrlen) == 0) break;
|
||||
JSOCKCLOSE(sfd);
|
||||
}
|
||||
freeaddrinfo(ai);
|
||||
if (NULL == rp) {
|
||||
janet_panic("could not bind to any sockets");
|
||||
}
|
||||
}
|
||||
|
||||
nosigpipe(sfd);
|
||||
|
||||
if (socktype == SOCK_DGRAM) {
|
||||
/* Datagram server (UDP) */
|
||||
|
||||
if (NULL == fun) {
|
||||
/* Server no handler */
|
||||
JanetStream *stream = make_stream(sfd, JANET_STREAM_UDPSERVER | JANET_STREAM_READABLE);
|
||||
return janet_wrap_abstract(stream);
|
||||
} else {
|
||||
/* Server with handler */
|
||||
janet_panic("handler must be nil for datagram server");
|
||||
}
|
||||
} else {
|
||||
/* Stream server (TCP) */
|
||||
|
||||
/* listen */
|
||||
int status = listen(sfd, 1024);
|
||||
if (status) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_panic("could not listen on file descriptor");
|
||||
}
|
||||
|
||||
/* Put sfd on our loop */
|
||||
if (NULL == fun) {
|
||||
JanetStream *stream = make_stream(sfd, JANET_STREAM_ACCEPTABLE);
|
||||
return janet_wrap_abstract(stream);
|
||||
} else {
|
||||
/* Server with handler */
|
||||
JanetStream *stream = make_stream(sfd, 0);
|
||||
NetStateSimpleServer *ss = (NetStateSimpleServer *) janet_listen(stream, net_machine_simple_server,
|
||||
JANET_ASYNC_LISTEN_READ | JANET_ASYNC_LISTEN_SPAWNER, sizeof(NetStateSimpleServer), NULL);
|
||||
ss->function = fun;
|
||||
return janet_wrap_abstract(stream);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static void check_stream_flag(JanetStream *stream, int flag) {
|
||||
if (!(stream->flags & flag) || (stream->flags & JANET_POLL_FLAG_CLOSED)) {
|
||||
const char *msg = "";
|
||||
if (flag == JANET_STREAM_READABLE) msg = "readable";
|
||||
if (flag == JANET_STREAM_WRITABLE) msg = "writable";
|
||||
if (flag == JANET_STREAM_ACCEPTABLE) msg = "server";
|
||||
if (flag == JANET_STREAM_UDPSERVER) msg = "datagram server";
|
||||
janet_panicf("bad stream, expected %s stream", msg);
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_stream_accept(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
check_stream_flag(stream, JANET_STREAM_ACCEPTABLE);
|
||||
double to = janet_optnumber(argv, argc, 1, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_sched_accept(stream);
|
||||
}
|
||||
|
||||
static Janet cfun_stream_read(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
check_stream_flag(stream, JANET_STREAM_READABLE);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_sched_read(stream, buffer, n);
|
||||
}
|
||||
|
||||
static Janet cfun_stream_chunk(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
check_stream_flag(stream, JANET_STREAM_READABLE);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_sched_chunk(stream, buffer, n);
|
||||
}
|
||||
|
||||
static Janet cfun_stream_recv_from(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 3, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
check_stream_flag(stream, JANET_STREAM_UDPSERVER);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 2);
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_sched_recv_from(stream, buffer, n);
|
||||
}
|
||||
|
||||
static Janet cfun_stream_close(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
janet_stream_close(stream, 0);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_stream_write(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
check_stream_flag(stream, JANET_STREAM_WRITABLE);
|
||||
double to = janet_optnumber(argv, argc, 2, INFINITY);
|
||||
if (janet_checktype(argv[1], JANET_BUFFER)) {
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_sched_write_buffer(stream, janet_getbuffer(argv, 1), NULL);
|
||||
} else {
|
||||
JanetByteView bytes = janet_getbytes(argv, 1);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_sched_write_stringlike(stream, bytes.bytes, NULL);
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_stream_send_to(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 3, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
check_stream_flag(stream, JANET_STREAM_UDPSERVER);
|
||||
void *dest = janet_getabstract(argv, 1, &AddressAT);
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (janet_checktype(argv[2], JANET_BUFFER)) {
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_sched_write_buffer(stream, janet_getbuffer(argv, 2), dest);
|
||||
} else {
|
||||
JanetByteView bytes = janet_getbytes(argv, 2);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_sched_write_stringlike(stream, bytes.bytes, dest);
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_stream_flush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
check_stream_flag(stream, JANET_STREAM_WRITABLE);
|
||||
/* Toggle no delay flag */
|
||||
int flag = 1;
|
||||
setsockopt((JSock) stream->handle, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int));
|
||||
flag = 0;
|
||||
setsockopt((JSock) stream->handle, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int));
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetMethod stream_methods[] = {
|
||||
{"chunk", cfun_stream_chunk},
|
||||
{"close", cfun_stream_close},
|
||||
{"read", cfun_stream_read},
|
||||
{"write", cfun_stream_write},
|
||||
{"flush", cfun_stream_flush},
|
||||
{"accept", cfun_stream_accept},
|
||||
{"send-to", cfun_stream_send_to},
|
||||
{"recv-from", cfun_stream_recv_from},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static int janet_stream_getter(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), stream_methods, out);
|
||||
}
|
||||
|
||||
static const JanetReg net_cfuns[] = {
|
||||
{
|
||||
"net/address", cfun_net_sockaddr,
|
||||
JDOC("(net/address host port &opt type)\n\n"
|
||||
"Look up the connection information for a given hostname, port, and connection type. Returns "
|
||||
"a handle that can be used to send datagrams over network without establishing a connection.")
|
||||
},
|
||||
{
|
||||
"net/server", cfun_net_server,
|
||||
JDOC("(net/server host port &opt handler type)\n\n"
|
||||
"Start a TCP server. handler is a function that will be called with a stream "
|
||||
"on each connection to the server. Returns a new stream that is neither readable nor "
|
||||
"writeable. If handler is nil or not provided, net/accept must be used to get the next connection "
|
||||
"to the server. The type parameter specifies the type of network connection, either "
|
||||
"a stream (usually tcp), or datagram (usually udp). If not specified, the default is "
|
||||
"stream.")
|
||||
},
|
||||
{
|
||||
"net/accept", cfun_stream_accept,
|
||||
JDOC("(net/accept stream &opt timeout)\n\n"
|
||||
"Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. "
|
||||
"Takes an optional timeout in seconds, after which will return nil. "
|
||||
"Returns a new duplex stream which represents a connection to the client.")
|
||||
},
|
||||
{
|
||||
"net/read", cfun_stream_read,
|
||||
JDOC("(net/read stream nbytes &opt buf timeout)\n\n"
|
||||
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
|
||||
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
|
||||
"Takes an optional timeout in seconds, after which will return nil. "
|
||||
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.")
|
||||
},
|
||||
{
|
||||
"net/chunk", cfun_stream_chunk,
|
||||
JDOC("(net/chunk stream nbytes &opt buf timeout)\n\n"
|
||||
"Same a net/read, but will wait for all n bytes to arrive rather than return early. "
|
||||
"Takes an optional timeout in seconds, after which will return nil.")
|
||||
},
|
||||
{
|
||||
"net/write", cfun_stream_write,
|
||||
JDOC("(net/write stream data &opt timeout)\n\n"
|
||||
"Write data to a stream, suspending the current fiber until the write "
|
||||
"completes. Takes an optional timeout in seconds, after which will return nil. "
|
||||
"Returns nil, or raises an error if the write failed.")
|
||||
},
|
||||
{
|
||||
"net/send-to", cfun_stream_send_to,
|
||||
JDOC("(net/send-to stream dest data &opt timeout)\n\n"
|
||||
"Writes a datagram to a server stream. dest is a the destination address of the packet. "
|
||||
"Takes an optional timeout in seconds, after which will return nil. "
|
||||
"Returns stream.")
|
||||
},
|
||||
{
|
||||
"net/recv-from", cfun_stream_recv_from,
|
||||
JDOC("(net/recv-from stream nbytes buf &opt timoeut)\n\n"
|
||||
"Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
|
||||
"packet came from. Takes an optional timeout in seconds, after which will return nil.")
|
||||
},
|
||||
{
|
||||
"net/flush", cfun_stream_flush,
|
||||
JDOC("(net/flush stream)\n\n"
|
||||
"Make sure that a stream is not buffering any data. This temporarily disables Nagle's algorithm. "
|
||||
"Use this to make sure data is sent without delay. Returns stream.")
|
||||
},
|
||||
{
|
||||
"net/close", cfun_stream_close,
|
||||
JDOC("(net/close stream)\n\n"
|
||||
"Close a stream so that no further communication can occur.")
|
||||
},
|
||||
{
|
||||
"net/connect", cfun_net_connect,
|
||||
JDOC("(net/connect host porti &opt type)\n\n"
|
||||
"Open a connection to communicate with a server. Returns a duplex stream "
|
||||
"that can be used to communicate with the server. Type is an optional keyword "
|
||||
"to specify a connection type, either :stream or :datagram. The default is :stream. ")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
void janet_lib_net(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, net_cfuns);
|
||||
}
|
||||
|
||||
void janet_net_init(void) {
|
||||
#ifdef JANET_WINDOWS
|
||||
WSADATA wsaData;
|
||||
janet_assert(!WSAStartup(MAKEWORD(2, 2), &wsaData), "could not start winsock");
|
||||
#endif
|
||||
}
|
||||
|
||||
void janet_net_deinit(void) {
|
||||
#ifdef JANET_WINDOWS
|
||||
WSACleanup();
|
||||
#endif
|
||||
}
|
||||
|
||||
#endif
|
||||
1026
src/core/os.c
1026
src/core/os.c
File diff suppressed because it is too large
Load Diff
179
src/core/parse.c
179
src/core/parse.c
@@ -26,6 +26,9 @@
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#define JANET_PARSER_DEAD 0x1
|
||||
#define JANET_PARSER_GENERATED_ERROR 0x2
|
||||
|
||||
/* Check if a character is whitespace */
|
||||
static int is_whitespace(uint8_t c) {
|
||||
return c == ' '
|
||||
@@ -164,12 +167,12 @@ static void popstate(JanetParser *p, Janet val) {
|
||||
for (;;) {
|
||||
JanetParseState top = p->states[--p->statecount];
|
||||
JanetParseState *newtop = p->states + p->statecount - 1;
|
||||
/* Source mapping info */
|
||||
if (janet_checktype(val, JANET_TUPLE)) {
|
||||
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.line;
|
||||
janet_tuple_sm_column(janet_unwrap_tuple(val)) = (int32_t) top.column;
|
||||
}
|
||||
if (newtop->flags & PFLAG_CONTAINER) {
|
||||
/* Source mapping info */
|
||||
if (janet_checktype(val, JANET_TUPLE)) {
|
||||
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.line;
|
||||
janet_tuple_sm_column(janet_unwrap_tuple(val)) = (int32_t) top.column;
|
||||
}
|
||||
newtop->argn++;
|
||||
/* Keep track of number of values in the root state */
|
||||
if (p->statecount == 1) p->pending++;
|
||||
@@ -201,6 +204,8 @@ static int checkescape(uint8_t c) {
|
||||
default:
|
||||
return -1;
|
||||
case 'x':
|
||||
case 'u':
|
||||
case 'U':
|
||||
return 1;
|
||||
case 'n':
|
||||
return '\n';
|
||||
@@ -228,6 +233,24 @@ static int checkescape(uint8_t c) {
|
||||
/* Forward declare */
|
||||
static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||
|
||||
static void write_codepoint(JanetParser *p, int32_t codepoint) {
|
||||
if (codepoint <= 0x7F) {
|
||||
push_buf(p, (uint8_t) codepoint);
|
||||
} else if (codepoint <= 0x7FF) {
|
||||
push_buf(p, (uint8_t)((codepoint >> 6) & 0x1F) | 0xC0);
|
||||
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
|
||||
} else if (codepoint <= 0xFFFF) {
|
||||
push_buf(p, (uint8_t)((codepoint >> 12) & 0x0F) | 0xE0);
|
||||
push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80);
|
||||
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
|
||||
} else {
|
||||
push_buf(p, (uint8_t)((codepoint >> 18) & 0x07) | 0xF0);
|
||||
push_buf(p, (uint8_t)((codepoint >> 12) & 0x3F) | 0x80);
|
||||
push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80);
|
||||
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
|
||||
}
|
||||
}
|
||||
|
||||
static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
int digit = to_hex(c);
|
||||
if (digit < 0) {
|
||||
@@ -237,7 +260,27 @@ static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
state->argn = (state->argn << 4) + digit;
|
||||
state->counter--;
|
||||
if (!state->counter) {
|
||||
push_buf(p, (state->argn & 0xFF));
|
||||
push_buf(p, (uint8_t)(state->argn & 0xFF));
|
||||
state->argn = 0;
|
||||
state->consumer = stringchar;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int escapeu(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
int digit = to_hex(c);
|
||||
if (digit < 0) {
|
||||
p->error = "invalid hex digit in unicode escape";
|
||||
return 1;
|
||||
}
|
||||
state->argn = (state->argn << 4) + digit;
|
||||
state->counter--;
|
||||
if (!state->counter) {
|
||||
if (state->argn > 0x10FFFF) {
|
||||
p->error = "invalid unicode codepoint";
|
||||
return 1;
|
||||
}
|
||||
write_codepoint(p, state->argn);
|
||||
state->argn = 0;
|
||||
state->consumer = stringchar;
|
||||
}
|
||||
@@ -254,6 +297,10 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
state->counter = 2;
|
||||
state->argn = 0;
|
||||
state->consumer = escapeh;
|
||||
} else if (c == 'u' || c == 'U') {
|
||||
state->counter = c == 'u' ? 4 : 6;
|
||||
state->argn = 0;
|
||||
state->consumer = escapeu;
|
||||
} else {
|
||||
push_buf(p, (uint8_t) e);
|
||||
state->consumer = stringchar;
|
||||
@@ -393,21 +440,23 @@ static Janet close_array(JanetParser *p, JanetParseState *state) {
|
||||
|
||||
static Janet close_struct(JanetParser *p, JanetParseState *state) {
|
||||
JanetKV *st = janet_struct_begin(state->argn >> 1);
|
||||
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) {
|
||||
Janet key = p->args[i];
|
||||
Janet value = p->args[i + 1];
|
||||
janet_struct_put(st, key, value);
|
||||
}
|
||||
p->argcount -= state->argn;
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
static Janet close_table(JanetParser *p, JanetParseState *state) {
|
||||
JanetTable *table = janet_table(state->argn >> 1);
|
||||
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) {
|
||||
Janet key = p->args[i];
|
||||
Janet value = p->args[i + 1];
|
||||
janet_table_put(table, key, value);
|
||||
}
|
||||
p->argcount -= state->argn;
|
||||
return janet_wrap_table(table);
|
||||
}
|
||||
|
||||
@@ -591,11 +640,30 @@ void janet_parser_eof(JanetParser *parser) {
|
||||
size_t oldline = parser->line;
|
||||
janet_parser_consume(parser, '\n');
|
||||
if (parser->statecount > 1) {
|
||||
parser->error = "unexpected end of source";
|
||||
JanetParseState *s = parser->states + (parser->statecount - 1);
|
||||
JanetBuffer *buffer = janet_buffer(40);
|
||||
janet_buffer_push_cstring(buffer, "unexpected end of source, ");
|
||||
if (s->flags & PFLAG_PARENS) {
|
||||
janet_buffer_push_u8(buffer, '(');
|
||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '[');
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '{');
|
||||
} else if (s->flags & PFLAG_STRING) {
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||
int32_t i;
|
||||
for (i = 0; i < s->argn; i++) {
|
||||
janet_buffer_push_u8(buffer, '`');
|
||||
}
|
||||
}
|
||||
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
|
||||
parser->error = (const char *) janet_string(buffer->data, buffer->count);
|
||||
parser->flag |= JANET_PARSER_GENERATED_ERROR;
|
||||
}
|
||||
parser->line = oldline;
|
||||
parser->column = oldcolumn;
|
||||
parser->flag = 1;
|
||||
parser->flag |= JANET_PARSER_DEAD;
|
||||
}
|
||||
|
||||
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
|
||||
@@ -617,6 +685,7 @@ const char *janet_parser_error(JanetParser *parser) {
|
||||
if (status == JANET_PARSE_ERROR) {
|
||||
const char *e = parser->error;
|
||||
parser->error = NULL;
|
||||
parser->flag &= ~JANET_PARSER_GENERATED_ERROR;
|
||||
janet_parser_flush(parser);
|
||||
return e;
|
||||
}
|
||||
@@ -688,20 +757,19 @@ void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
|
||||
if (dest->bufcap) {
|
||||
dest->buf = malloc(dest->bufcap);
|
||||
if (!dest->buf) goto nomem;
|
||||
memcpy(dest->buf, src->buf, dest->bufcap);
|
||||
}
|
||||
if (dest->argcap) {
|
||||
dest->args = malloc(sizeof(Janet) * dest->argcap);
|
||||
if (!dest->args) goto nomem;
|
||||
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
|
||||
}
|
||||
if (dest->statecap) {
|
||||
dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
|
||||
if (!dest->states) goto nomem;
|
||||
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
|
||||
}
|
||||
|
||||
memcpy(dest->buf, src->buf, dest->bufcap);
|
||||
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
|
||||
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
|
||||
|
||||
return;
|
||||
|
||||
nomem:
|
||||
@@ -721,6 +789,9 @@ static int parsermark(void *p, size_t size) {
|
||||
for (i = 0; i < parser->argcount; i++) {
|
||||
janet_mark(parser->args[i]);
|
||||
}
|
||||
if (parser->flag & JANET_PARSER_GENERATED_ERROR) {
|
||||
janet_mark(janet_wrap_string((const uint8_t *) parser->error));
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -733,31 +804,26 @@ static int parsergc(void *p, size_t size) {
|
||||
|
||||
static int parserget(void *p, Janet key, Janet *out);
|
||||
|
||||
static JanetAbstractType janet_parse_parsertype = {
|
||||
const JanetAbstractType janet_parser_type = {
|
||||
"core/parser",
|
||||
parsergc,
|
||||
parsermark,
|
||||
parserget,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
/* C Function parser */
|
||||
static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||
JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
janet_parser_init(p);
|
||||
return janet_wrap_abstract(p);
|
||||
}
|
||||
|
||||
static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
if (argc == 3) {
|
||||
int32_t offset = janet_getinteger(argv, 2);
|
||||
@@ -782,14 +848,14 @@ static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_parse_eof(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
janet_parser_eof(p);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetParseState *s = p->states + p->statecount - 1;
|
||||
if (s->consumer == tokenchar) {
|
||||
janet_parser_consume(p, ' ');
|
||||
@@ -813,7 +879,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
}
|
||||
p->bufcap = newcap;
|
||||
}
|
||||
memcpy(p->buf + p->bufcount, str, slen);
|
||||
safe_memcpy(p->buf + p->bufcount, str, slen);
|
||||
p->bufcount = newcount;
|
||||
} else {
|
||||
janet_panic("cannot insert value into parser");
|
||||
@@ -823,13 +889,13 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_parse_has_more(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
return janet_wrap_boolean(janet_parser_has_more(p));
|
||||
}
|
||||
|
||||
static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
int32_t i = janet_getinteger(argv, 1);
|
||||
janet_parser_consume(p, 0xFF & i);
|
||||
return argv[0];
|
||||
@@ -837,7 +903,7 @@ static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_parse_status(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
const char *stat = NULL;
|
||||
switch (janet_parser_status(p)) {
|
||||
case JANET_PARSE_PENDING:
|
||||
@@ -858,28 +924,32 @@ static Janet cfun_parse_status(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
const char *err = janet_parser_error(p);
|
||||
if (err) return janet_cstringv(err);
|
||||
if (err) {
|
||||
return (p->flag & JANET_PARSER_GENERATED_ERROR)
|
||||
? janet_wrap_string((const uint8_t *) err)
|
||||
: janet_cstringv(err);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
return janet_parser_produce(p);
|
||||
}
|
||||
|
||||
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
janet_parser_flush(p);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
Janet *tup = janet_tuple_begin(2);
|
||||
tup[0] = janet_wrap_integer(p->line);
|
||||
tup[1] = janet_wrap_integer(p->column);
|
||||
@@ -896,7 +966,7 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
|
||||
if (s->flags & PFLAG_CONTAINER) {
|
||||
JanetArray *container_args = janet_array(s->argn);
|
||||
container_args->count = s->argn;
|
||||
memcpy(container_args->data, args, sizeof(args[0])*s->argn);
|
||||
safe_memcpy(container_args->data, args, sizeof(args[0])*s->argn);
|
||||
janet_table_put(state, janet_ckeywordv("args"),
|
||||
janet_wrap_array(container_args));
|
||||
}
|
||||
@@ -959,31 +1029,30 @@ struct ParserStateGetter {
|
||||
};
|
||||
|
||||
static Janet parser_state_delimiters(const JanetParser *_p) {
|
||||
JanetParser *clone = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||
janet_parser_clone(_p, clone);
|
||||
JanetParser *p = (JanetParser *)_p;
|
||||
size_t i;
|
||||
const uint8_t *str;
|
||||
size_t oldcount;
|
||||
oldcount = clone->bufcount;
|
||||
for (i = 0; i < clone->statecount; i++) {
|
||||
JanetParseState *s = clone->states + i;
|
||||
oldcount = p->bufcount;
|
||||
for (i = 0; i < p->statecount; i++) {
|
||||
JanetParseState *s = p->states + i;
|
||||
if (s->flags & PFLAG_PARENS) {
|
||||
push_buf(clone, '(');
|
||||
push_buf(p, '(');
|
||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||
push_buf(clone, '[');
|
||||
push_buf(p, '[');
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
push_buf(clone, '{');
|
||||
push_buf(p, '{');
|
||||
} else if (s->flags & PFLAG_STRING) {
|
||||
push_buf(clone, '"');
|
||||
push_buf(p, '"');
|
||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||
int32_t i;
|
||||
for (i = 0; i < s->argn; i++) {
|
||||
push_buf(clone, '`');
|
||||
push_buf(p, '`');
|
||||
}
|
||||
}
|
||||
}
|
||||
str = janet_string(clone->buf + oldcount, (int32_t)(clone->bufcount - oldcount));
|
||||
clone->bufcount = oldcount;
|
||||
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
||||
p->bufcount = oldcount;
|
||||
return janet_wrap_string(str);
|
||||
}
|
||||
|
||||
@@ -1010,7 +1079,7 @@ static const struct ParserStateGetter parser_state_getters[] = {
|
||||
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *key = NULL;
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
if (argc == 2) {
|
||||
key = janet_getkeyword(argv, 1);
|
||||
}
|
||||
@@ -1037,8 +1106,8 @@ static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *src = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *dest = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||
JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
janet_parser_clone(src, dest);
|
||||
return janet_wrap_abstract(dest);
|
||||
}
|
||||
@@ -1070,7 +1139,7 @@ static const JanetReg parse_cfuns[] = {
|
||||
"parser/new", cfun_parse_parser,
|
||||
JDOC("(parser/new)\n\n"
|
||||
"Creates and returns a new parser object. Parsers are state machines "
|
||||
"that can receive bytes, and generate a stream of janet values.")
|
||||
"that can receive bytes, and generate a stream of values.")
|
||||
},
|
||||
{
|
||||
"parser/clone", cfun_parse_clone,
|
||||
|
||||
439
src/core/peg.c
439
src/core/peg.c
@@ -35,34 +35,6 @@
|
||||
* Runtime
|
||||
*/
|
||||
|
||||
/* opcodes for peg vm */
|
||||
typedef enum {
|
||||
RULE_LITERAL, /* [len, bytes...] */
|
||||
RULE_NCHAR, /* [n] */
|
||||
RULE_NOTNCHAR, /* [n] */
|
||||
RULE_RANGE, /* [lo | hi << 16 (1 word)] */
|
||||
RULE_SET, /* [bitmap (8 words)] */
|
||||
RULE_LOOK, /* [offset, rule] */
|
||||
RULE_CHOICE, /* [len, rules...] */
|
||||
RULE_SEQUENCE, /* [len, rules...] */
|
||||
RULE_IF, /* [rule_a, rule_b (b if a)] */
|
||||
RULE_IFNOT, /* [rule_a, rule_b (b if not a)] */
|
||||
RULE_NOT, /* [rule] */
|
||||
RULE_BETWEEN, /* [lo, hi, rule] */
|
||||
RULE_GETTAG, /* [searchtag, tag] */
|
||||
RULE_CAPTURE, /* [rule, tag] */
|
||||
RULE_POSITION, /* [tag] */
|
||||
RULE_ARGUMENT, /* [argument-index, tag] */
|
||||
RULE_CONSTANT, /* [constant, tag] */
|
||||
RULE_ACCUMULATE, /* [rule, tag] */
|
||||
RULE_GROUP, /* [rule, tag] */
|
||||
RULE_REPLACE, /* [rule, constant, tag] */
|
||||
RULE_MATCHTIME, /* [rule, constant, tag] */
|
||||
RULE_ERROR, /* [rule] */
|
||||
RULE_DROP, /* [rule] */
|
||||
RULE_BACKMATCH, /* [tag] */
|
||||
} Opcode;
|
||||
|
||||
/* Hold captured patterns and match state */
|
||||
typedef struct {
|
||||
const uint8_t *text_start;
|
||||
@@ -115,6 +87,12 @@ static void pushcap(PegState *s, Janet capture, uint32_t tag) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Convert a uint64_t to a int64_t by wrapping to a maximum number of bytes */
|
||||
static int64_t peg_convert_u64_s64(uint64_t from, int width) {
|
||||
int shift = 8 * (8 - width);
|
||||
return ((int64_t)(from << shift)) >> shift;
|
||||
}
|
||||
|
||||
/* Prevent stack overflow */
|
||||
#define down1(s) do { \
|
||||
if (0 == --((s)->depth)) janet_panic("peg/match recursed too deeply"); \
|
||||
@@ -178,6 +156,7 @@ tail:
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text);
|
||||
up1(s);
|
||||
text -= ((int32_t *)rule)[1];
|
||||
return result ? text : NULL;
|
||||
}
|
||||
|
||||
@@ -233,6 +212,29 @@ tail:
|
||||
return (result) ? NULL : text;
|
||||
}
|
||||
|
||||
case RULE_THRU:
|
||||
case RULE_TO: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
const uint8_t *next_text;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
while (text < s->text_end) {
|
||||
CapState cs2 = cap_save(s);
|
||||
next_text = peg_rule(s, rule_a, text);
|
||||
if (next_text) {
|
||||
if (rule[0] == RULE_TO) cap_load(s, cs2);
|
||||
break;
|
||||
}
|
||||
text++;
|
||||
}
|
||||
up1(s);
|
||||
if (text >= s->text_end) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
return rule[0] == RULE_TO ? text : next_text;
|
||||
}
|
||||
|
||||
case RULE_BETWEEN: {
|
||||
uint32_t lo = rule[1];
|
||||
uint32_t hi = rule[2];
|
||||
@@ -348,9 +350,9 @@ tail:
|
||||
if (!result) return NULL;
|
||||
int32_t num_sub_captures = s->captures->count - cs.cap;
|
||||
JanetArray *sub_captures = janet_array(num_sub_captures);
|
||||
memcpy(sub_captures->data,
|
||||
s->captures->data + cs.cap,
|
||||
sizeof(Janet) * num_sub_captures);
|
||||
safe_memcpy(sub_captures->data,
|
||||
s->captures->data + cs.cap,
|
||||
sizeof(Janet) * num_sub_captures);
|
||||
sub_captures->count = num_sub_captures;
|
||||
cap_load(s, cs);
|
||||
pushcap(s, janet_wrap_array(sub_captures), tag);
|
||||
@@ -369,19 +371,23 @@ tail:
|
||||
s->mode = oldmode;
|
||||
if (!result) return NULL;
|
||||
|
||||
Janet cap;
|
||||
Janet cap = janet_wrap_nil();
|
||||
Janet constant = s->constants[rule[2]];
|
||||
switch (janet_type(constant)) {
|
||||
default:
|
||||
cap = constant;
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
cap = janet_struct_get(janet_unwrap_struct(constant),
|
||||
s->captures->data[s->captures->count - 1]);
|
||||
if (s->captures->count) {
|
||||
cap = janet_struct_get(janet_unwrap_struct(constant),
|
||||
s->captures->data[s->captures->count - 1]);
|
||||
}
|
||||
break;
|
||||
case JANET_TABLE:
|
||||
cap = janet_table_get(janet_unwrap_table(constant),
|
||||
s->captures->data[s->captures->count - 1]);
|
||||
if (s->captures->count) {
|
||||
cap = janet_table_get(janet_unwrap_table(constant),
|
||||
s->captures->data[s->captures->count - 1]);
|
||||
}
|
||||
break;
|
||||
case JANET_CFUNCTION:
|
||||
cap = janet_unwrap_cfunction(constant)(s->captures->count - cs.cap,
|
||||
@@ -437,6 +443,79 @@ tail:
|
||||
return NULL;
|
||||
}
|
||||
|
||||
case RULE_LENPREFIX: {
|
||||
int oldmode = s->mode;
|
||||
s->mode = PEG_MODE_NORMAL;
|
||||
const uint8_t *next_text;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
next_text = peg_rule(s, s->bytecode + rule[1], text);
|
||||
up1(s);
|
||||
if (NULL == next_text) return NULL;
|
||||
s->mode = oldmode;
|
||||
int32_t num_sub_captures = s->captures->count - cs.cap;
|
||||
Janet lencap;
|
||||
if (num_sub_captures <= 0 ||
|
||||
(lencap = s->captures->data[cs.cap], !janet_checkint(lencap))) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
int32_t nrep = janet_unwrap_integer(lencap);
|
||||
/* drop captures from len pattern */
|
||||
cap_load(s, cs);
|
||||
for (int32_t i = 0; i < nrep; i++) {
|
||||
down1(s);
|
||||
next_text = peg_rule(s, s->bytecode + rule[2], next_text);
|
||||
up1(s);
|
||||
if (NULL == next_text) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
return next_text;
|
||||
}
|
||||
|
||||
case RULE_READINT: {
|
||||
uint32_t tag = rule[2];
|
||||
uint32_t signedness = rule[1] & 0x10;
|
||||
uint32_t endianess = rule[1] & 0x20;
|
||||
int width = (int)(rule[1] & 0xF);
|
||||
if (text + width > s->text_end) return NULL;
|
||||
uint64_t accum = 0;
|
||||
if (endianess) {
|
||||
/* BE */
|
||||
for (int i = 0; i < width; i++) accum = (accum << 8) | text[i];
|
||||
} else {
|
||||
/* LE */
|
||||
for (int i = width - 1; i >= 0; i--) accum = (accum << 8) | text[i];
|
||||
}
|
||||
|
||||
Janet capture_value;
|
||||
/* We can only parse integeres of greater than 6 bytes reliable if int-types are enabled.
|
||||
* Otherwise, we may lose precision, so 6 is the maximum size when int-types are disabled. */
|
||||
#ifdef JANET_INT_TYPES
|
||||
if (width > 6) {
|
||||
if (signedness) {
|
||||
capture_value = janet_wrap_s64(peg_convert_u64_s64(accum, width));
|
||||
} else {
|
||||
capture_value = janet_wrap_u64(accum);
|
||||
}
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
double double_value;
|
||||
if (signedness) {
|
||||
double_value = (double)(peg_convert_u64_s64(accum, width));
|
||||
} else {
|
||||
double_value = (double)accum;
|
||||
}
|
||||
capture_value = janet_wrap_number(double_value);
|
||||
}
|
||||
|
||||
pushcap(s, capture_value, tag);
|
||||
return text + width;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
@@ -476,7 +555,7 @@ JANET_NO_RETURN static void peg_panic(Builder *b, const char *msg) {
|
||||
|
||||
static void peg_fixarity(Builder *b, int32_t argc, int32_t arity) {
|
||||
if (argc != arity) {
|
||||
peg_panicf(b, "expected %d argument%s, got %d%",
|
||||
peg_panicf(b, "expected %d argument%s, got %d",
|
||||
arity,
|
||||
arity == 1 ? "" : "s",
|
||||
argc);
|
||||
@@ -681,6 +760,9 @@ static void spec_if(Builder *b, int32_t argc, const Janet *argv) {
|
||||
static void spec_ifnot(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_branch(b, argc, argv, RULE_IFNOT);
|
||||
}
|
||||
static void spec_lenprefix(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_branch(b, argc, argv, RULE_LENPREFIX);
|
||||
}
|
||||
|
||||
static void spec_between(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_fixarity(b, argc, 3);
|
||||
@@ -753,6 +835,12 @@ static void spec_error(Builder *b, int32_t argc, const Janet *argv) {
|
||||
static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_DROP);
|
||||
}
|
||||
static void spec_to(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_TO);
|
||||
}
|
||||
static void spec_thru(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_THRU);
|
||||
}
|
||||
|
||||
/* Rule of the form [rule, tag] */
|
||||
static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
|
||||
@@ -835,6 +923,36 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
|
||||
emit_3(r, RULE_MATCHTIME, subrule, cindex, tag);
|
||||
}
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
#define JANET_MAX_READINT_WIDTH 8
|
||||
#else
|
||||
#define JANET_MAX_READINT_WIDTH 6
|
||||
#endif
|
||||
|
||||
static void spec_readint(Builder *b, int32_t argc, const Janet *argv, uint32_t mask) {
|
||||
peg_arity(b, argc, 1, 2);
|
||||
Reserve r = reserve(b, 3);
|
||||
uint32_t tag = (argc == 2) ? emit_tag(b, argv[3]) : 0;
|
||||
int32_t width = peg_getnat(b, argv[0]);
|
||||
if ((width < 0) || (width > JANET_MAX_READINT_WIDTH)) {
|
||||
peg_panicf(b, "width must be between 0 and %d, got %d", JANET_MAX_READINT_WIDTH, width);
|
||||
}
|
||||
emit_2(r, RULE_READINT, mask | ((uint32_t) width), tag);
|
||||
}
|
||||
|
||||
static void spec_uint_le(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_readint(b, argc, argv, 0x0u);
|
||||
}
|
||||
static void spec_int_le(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_readint(b, argc, argv, 0x10u);
|
||||
}
|
||||
static void spec_uint_be(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_readint(b, argc, argv, 0x20u);
|
||||
}
|
||||
static void spec_int_be(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_readint(b, argc, argv, 0x30u);
|
||||
}
|
||||
|
||||
/* Special compiler form */
|
||||
typedef void (*Special)(Builder *b, int32_t argc, const Janet *argv);
|
||||
typedef struct {
|
||||
@@ -871,6 +989,9 @@ static const SpecialPair peg_specials[] = {
|
||||
{"group", spec_group},
|
||||
{"if", spec_if},
|
||||
{"if-not", spec_ifnot},
|
||||
{"int", spec_int_le},
|
||||
{"int-be", spec_int_be},
|
||||
{"lenprefix", spec_lenprefix},
|
||||
{"look", spec_look},
|
||||
{"not", spec_not},
|
||||
{"opt", spec_opt},
|
||||
@@ -882,6 +1003,10 @@ static const SpecialPair peg_specials[] = {
|
||||
{"sequence", spec_sequence},
|
||||
{"set", spec_set},
|
||||
{"some", spec_some},
|
||||
{"thru", spec_thru},
|
||||
{"to", spec_to},
|
||||
{"uint", spec_uint_le},
|
||||
{"uint-be", spec_uint_be},
|
||||
};
|
||||
|
||||
/* Compile a janet value into a rule and return the rule index. */
|
||||
@@ -984,6 +1109,14 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
const Janet *tup = janet_unwrap_tuple(peg);
|
||||
int32_t len = janet_tuple_length(tup);
|
||||
if (len == 0) peg_panic(b, "tuple in grammar must have non-zero length");
|
||||
if (janet_checkint(tup[0])) {
|
||||
int32_t n = janet_unwrap_integer(tup[0]);
|
||||
if (n < 0) {
|
||||
peg_panicf(b, "expected non-negative integer, got %d", n);
|
||||
}
|
||||
spec_repeat(b, len, tup);
|
||||
break;
|
||||
}
|
||||
if (!janet_checktype(tup[0], JANET_SYMBOL))
|
||||
peg_panicf(b, "expected grammar command, found %v", tup[0]);
|
||||
const uint8_t *sym = janet_unwrap_symbol(tup[0]);
|
||||
@@ -1012,16 +1145,9 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
* Post-Compilation
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
uint32_t *bytecode;
|
||||
Janet *constants;
|
||||
size_t bytecode_len;
|
||||
uint32_t num_constants;
|
||||
} Peg;
|
||||
|
||||
static int peg_mark(void *p, size_t size) {
|
||||
(void) size;
|
||||
Peg *peg = (Peg *)p;
|
||||
JanetPeg *peg = (JanetPeg *)p;
|
||||
if (NULL != peg->constants)
|
||||
for (uint32_t i = 0; i < peg->num_constants; i++)
|
||||
janet_mark(peg->constants[i]);
|
||||
@@ -1029,7 +1155,7 @@ static int peg_mark(void *p, size_t size) {
|
||||
}
|
||||
|
||||
static void peg_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
Peg *peg = (Peg *)p;
|
||||
JanetPeg *peg = (JanetPeg *)p;
|
||||
janet_marshal_size(ctx, peg->bytecode_len);
|
||||
janet_marshal_int(ctx, (int32_t)peg->num_constants);
|
||||
janet_marshal_abstract(ctx, p);
|
||||
@@ -1051,7 +1177,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
uint32_t num_constants = (uint32_t) janet_unmarshal_int(ctx);
|
||||
|
||||
/* Calculate offsets. Should match those in make_peg */
|
||||
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
|
||||
size_t bytecode_start = size_padded(sizeof(JanetPeg), sizeof(uint32_t));
|
||||
size_t bytecode_size = bytecode_len * sizeof(uint32_t);
|
||||
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
|
||||
size_t total_size = constants_start + sizeof(Janet) * (size_t) num_constants;
|
||||
@@ -1061,7 +1187,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
|
||||
/* Allocate PEG */
|
||||
char *mem = janet_unmarshal_abstract(ctx, total_size);
|
||||
Peg *peg = (Peg *)mem;
|
||||
JanetPeg *peg = (JanetPeg *)mem;
|
||||
uint32_t *bytecode = (uint32_t *)(mem + bytecode_start);
|
||||
Janet *constants = (Janet *)(mem + constants_start);
|
||||
peg->bytecode = NULL;
|
||||
@@ -1131,6 +1257,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
break;
|
||||
case RULE_IF:
|
||||
case RULE_IFNOT:
|
||||
case RULE_LENPREFIX:
|
||||
/* [rule_a, rule_b (b if not a)] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
if (rule[2] >= blen) goto bad;
|
||||
@@ -1173,11 +1300,18 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
case RULE_ERROR:
|
||||
case RULE_DROP:
|
||||
case RULE_NOT:
|
||||
case RULE_TO:
|
||||
case RULE_THRU:
|
||||
/* [rule] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
i += 2;
|
||||
break;
|
||||
case RULE_READINT:
|
||||
/* [ width | (endianess << 5) | (signedness << 6), tag ] */
|
||||
if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
|
||||
i += 3;
|
||||
break;
|
||||
default:
|
||||
goto bad;
|
||||
}
|
||||
@@ -1204,7 +1338,7 @@ bad:
|
||||
|
||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out);
|
||||
|
||||
static const JanetAbstractType peg_type = {
|
||||
const JanetAbstractType janet_peg_type = {
|
||||
"core/peg",
|
||||
NULL,
|
||||
peg_mark,
|
||||
@@ -1212,31 +1346,29 @@ static const JanetAbstractType peg_type = {
|
||||
NULL,
|
||||
peg_marshal,
|
||||
peg_unmarshal,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
/* Convert Builder to Peg (Janet Abstract Value) */
|
||||
static Peg *make_peg(Builder *b) {
|
||||
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
|
||||
/* Convert Builder to JanetPeg (Janet Abstract Value) */
|
||||
static JanetPeg *make_peg(Builder *b) {
|
||||
size_t bytecode_start = size_padded(sizeof(JanetPeg), sizeof(uint32_t));
|
||||
size_t bytecode_size = janet_v_count(b->bytecode) * sizeof(uint32_t);
|
||||
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
|
||||
size_t constants_size = janet_v_count(b->constants) * sizeof(Janet);
|
||||
size_t total_size = constants_start + constants_size;
|
||||
char *mem = janet_abstract(&peg_type, total_size);
|
||||
Peg *peg = (Peg *)mem;
|
||||
char *mem = janet_abstract(&janet_peg_type, total_size);
|
||||
JanetPeg *peg = (JanetPeg *)mem;
|
||||
peg->bytecode = (uint32_t *)(mem + bytecode_start);
|
||||
peg->constants = (Janet *)(mem + constants_start);
|
||||
peg->num_constants = janet_v_count(b->constants);
|
||||
memcpy(peg->bytecode, b->bytecode, bytecode_size);
|
||||
memcpy(peg->constants, b->constants, constants_size);
|
||||
safe_memcpy(peg->bytecode, b->bytecode, bytecode_size);
|
||||
safe_memcpy(peg->constants, b->constants, constants_size);
|
||||
peg->bytecode_len = janet_v_count(b->bytecode);
|
||||
return peg;
|
||||
}
|
||||
|
||||
/* Compiler entry point */
|
||||
static Peg *compile_peg(Janet x) {
|
||||
static JanetPeg *compile_peg(Janet x) {
|
||||
Builder builder;
|
||||
builder.grammar = janet_table(0);
|
||||
builder.default_grammar = janet_get_core_table("default-peg-grammar");
|
||||
@@ -1247,7 +1379,7 @@ static Peg *compile_peg(Janet x) {
|
||||
builder.form = x;
|
||||
builder.depth = JANET_RECURSION_GUARD;
|
||||
peg_compile1(&builder, x);
|
||||
Peg *peg = make_peg(&builder);
|
||||
JanetPeg *peg = make_peg(&builder);
|
||||
builder_cleanup(&builder);
|
||||
return peg;
|
||||
}
|
||||
@@ -1258,51 +1390,140 @@ static Peg *compile_peg(Janet x) {
|
||||
|
||||
static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
Peg *peg = compile_peg(argv[0]);
|
||||
JanetPeg *peg = compile_peg(argv[0]);
|
||||
return janet_wrap_abstract(peg);
|
||||
}
|
||||
|
||||
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
Peg *peg;
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
|
||||
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &peg_type) {
|
||||
peg = janet_unwrap_abstract(argv[0]);
|
||||
} else {
|
||||
peg = compile_peg(argv[0]);
|
||||
}
|
||||
JanetByteView bytes = janet_getbytes(argv, 1);
|
||||
int32_t start;
|
||||
/* Common data for peg cfunctions */
|
||||
typedef struct {
|
||||
JanetPeg *peg;
|
||||
PegState s;
|
||||
if (argc > 2) {
|
||||
start = janet_gethalfrange(argv, 2, bytes.len, "offset");
|
||||
s.extrac = argc - 3;
|
||||
s.extrav = janet_tuple_n(argv + 3, argc - 3);
|
||||
JanetByteView bytes;
|
||||
JanetByteView repl;
|
||||
int32_t start;
|
||||
} PegCall;
|
||||
|
||||
/* Initialize state for peg cfunctions */
|
||||
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
||||
PegCall ret;
|
||||
int32_t min = get_replace ? 3 : 2;
|
||||
janet_arity(argc, get_replace, -1);
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
|
||||
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
|
||||
ret.peg = janet_unwrap_abstract(argv[0]);
|
||||
} else {
|
||||
start = 0;
|
||||
s.extrac = 0;
|
||||
s.extrav = NULL;
|
||||
ret.peg = compile_peg(argv[0]);
|
||||
}
|
||||
s.mode = PEG_MODE_NORMAL;
|
||||
s.text_start = bytes.bytes;
|
||||
s.text_end = bytes.bytes + bytes.len;
|
||||
s.depth = JANET_RECURSION_GUARD;
|
||||
s.captures = janet_array(0);
|
||||
s.scratch = janet_buffer(10);
|
||||
s.tags = janet_buffer(10);
|
||||
s.constants = peg->constants;
|
||||
s.bytecode = peg->bytecode;
|
||||
const uint8_t *result = peg_rule(&s, s.bytecode, bytes.bytes + start);
|
||||
return result ? janet_wrap_array(s.captures) : janet_wrap_nil();
|
||||
if (get_replace) {
|
||||
ret.repl = janet_getbytes(argv, 1);
|
||||
ret.bytes = janet_getbytes(argv, 2);
|
||||
} else {
|
||||
ret.bytes = janet_getbytes(argv, 1);
|
||||
}
|
||||
if (argc > min) {
|
||||
ret.start = janet_gethalfrange(argv, min, ret.bytes.len, "offset");
|
||||
ret.s.extrac = argc - min - 1;
|
||||
ret.s.extrav = janet_tuple_n(argv + min + 1, argc - min - 1);
|
||||
} else {
|
||||
ret.start = 0;
|
||||
ret.s.extrac = 0;
|
||||
ret.s.extrav = NULL;
|
||||
}
|
||||
ret.s.mode = PEG_MODE_NORMAL;
|
||||
ret.s.text_start = ret.bytes.bytes;
|
||||
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
|
||||
ret.s.depth = JANET_RECURSION_GUARD;
|
||||
ret.s.captures = janet_array(0);
|
||||
ret.s.scratch = janet_buffer(10);
|
||||
ret.s.tags = janet_buffer(10);
|
||||
ret.s.constants = ret.peg->constants;
|
||||
ret.s.bytecode = ret.peg->bytecode;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static void peg_call_reset(PegCall *c) {
|
||||
c->s.captures->count = 0;
|
||||
c->s.scratch->count = 0;
|
||||
c->s.tags->count = 0;
|
||||
}
|
||||
|
||||
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + c.start);
|
||||
return result ? janet_wrap_array(c.s.captures) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_peg_find(int32_t argc, Janet *argv) {
|
||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||
peg_call_reset(&c);
|
||||
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
|
||||
return janet_wrap_integer(i);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_peg_find_all(int32_t argc, Janet *argv) {
|
||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||
JanetArray *ret = janet_array(0);
|
||||
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||
peg_call_reset(&c);
|
||||
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
|
||||
janet_array_push(ret, janet_wrap_integer(i));
|
||||
}
|
||||
return janet_wrap_array(ret);
|
||||
}
|
||||
|
||||
static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
|
||||
PegCall c = peg_cfun_init(argc, argv, 1);
|
||||
JanetBuffer *ret = janet_buffer(0);
|
||||
int32_t trail = 0;
|
||||
for (int32_t i = c.start; i < c.bytes.len;) {
|
||||
peg_call_reset(&c);
|
||||
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i);
|
||||
if (NULL != result) {
|
||||
if (trail < i) {
|
||||
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (i - trail));
|
||||
trail = i;
|
||||
}
|
||||
int32_t nexti = (int32_t)(result - c.bytes.bytes);
|
||||
janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len);
|
||||
trail = nexti;
|
||||
if (nexti == i) nexti++;
|
||||
i = nexti;
|
||||
if (only_one) break;
|
||||
} else {
|
||||
i++;
|
||||
}
|
||||
}
|
||||
if (trail < c.bytes.len) {
|
||||
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (c.bytes.len - trail));
|
||||
}
|
||||
return janet_wrap_buffer(ret);
|
||||
}
|
||||
|
||||
static Janet cfun_peg_replace_all(int32_t argc, Janet *argv) {
|
||||
return cfun_peg_replace_generic(argc, argv, 0);
|
||||
}
|
||||
|
||||
static Janet cfun_peg_replace(int32_t argc, Janet *argv) {
|
||||
return cfun_peg_replace_generic(argc, argv, 1);
|
||||
}
|
||||
|
||||
static JanetMethod peg_methods[] = {
|
||||
{"match", cfun_peg_match},
|
||||
{"find", cfun_peg_find},
|
||||
{"find-all", cfun_peg_find_all},
|
||||
{"replace", cfun_peg_replace},
|
||||
{"replace-all", cfun_peg_replace_all},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
|
||||
(void) a;
|
||||
if (janet_keyeq(key, "match")) {
|
||||
*out = janet_wrap_cfunction(cfun_peg_match);
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
if (!janet_checktype(key, JANET_KEYWORD))
|
||||
return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), peg_methods, out);
|
||||
}
|
||||
|
||||
static const JanetReg peg_cfuns[] = {
|
||||
@@ -1316,8 +1537,28 @@ static const JanetReg peg_cfuns[] = {
|
||||
"peg/match", cfun_peg_match,
|
||||
JDOC("(peg/match peg text &opt start & args)\n\n"
|
||||
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
|
||||
"Returns nil if text does not match the language defined by peg. The syntax of PEGs are very "
|
||||
"similar to those defined by LPeg, and have similar capabilities.")
|
||||
"Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.")
|
||||
},
|
||||
{
|
||||
"peg/find", cfun_peg_find,
|
||||
JDOC("(peg/find peg text &opt start & args)\n\n"
|
||||
"Find first index where the peg matches in text. Returns an integer, or nil if not found.")
|
||||
},
|
||||
{
|
||||
"peg/find-all", cfun_peg_find_all,
|
||||
JDOC("(peg/find-all peg text &opt start & args)\n\n"
|
||||
"Find all indexes where the peg matches in text. Returns an array of integers.")
|
||||
},
|
||||
{
|
||||
"peg/replace", cfun_peg_replace,
|
||||
JDOC("(peg/replace peg repl text &opt start & args)\n\n"
|
||||
"Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. "
|
||||
"If no matches are found, returns the input string in a new buffer.")
|
||||
},
|
||||
{
|
||||
"peg/replace-all", cfun_peg_replace_all,
|
||||
JDOC("(peg/replace-all peg repl text &opt start & args)\n\n"
|
||||
"Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
@@ -1325,7 +1566,7 @@ static const JanetReg peg_cfuns[] = {
|
||||
/* Load the peg module */
|
||||
void janet_lib_peg(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, peg_cfuns);
|
||||
janet_register_abstract_type(&peg_type);
|
||||
janet_register_abstract_type(&janet_peg_type);
|
||||
}
|
||||
|
||||
#endif /* ifdef JANET_PEG */
|
||||
|
||||
436
src/core/pp.c
436
src/core/pp.c
@@ -39,11 +39,9 @@
|
||||
|
||||
static void number_to_string_b(JanetBuffer *buffer, double x) {
|
||||
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
|
||||
/* Use int32_t range for valid integers because that is the
|
||||
* range most integer-expecting functions in the C api use. */
|
||||
const char *fmt = (x == floor(x) &&
|
||||
x <= ((double) INT32_MAX) &&
|
||||
x >= ((double) INT32_MIN)) ? "%.0f" : "%g";
|
||||
x <= JANET_INTMAX_DOUBLE &&
|
||||
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g";
|
||||
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, fmt, x);
|
||||
buffer->count += count;
|
||||
}
|
||||
@@ -123,9 +121,6 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
|
||||
#undef POINTSIZE
|
||||
}
|
||||
|
||||
#undef HEX
|
||||
#undef BUFSIZE
|
||||
|
||||
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
for (int32_t i = 0; i < len; ++i) {
|
||||
@@ -155,8 +150,11 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
|
||||
case '\\':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
|
||||
break;
|
||||
case '\t':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\t", 2);
|
||||
break;
|
||||
default:
|
||||
if (c < 32 || c > 127) {
|
||||
if (c < 32 || c > 126) {
|
||||
uint8_t buf[4];
|
||||
buf[0] = '\\';
|
||||
buf[1] = 'x';
|
||||
@@ -177,6 +175,10 @@ static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) {
|
||||
}
|
||||
|
||||
static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
|
||||
if (bx == buffer) {
|
||||
/* Ensures buffer won't resize while escaping */
|
||||
janet_buffer_ensure(bx, bx->count + 5 * bx->count + 3, 1);
|
||||
}
|
||||
janet_buffer_push_u8(buffer, '@');
|
||||
janet_escape_string_impl(buffer, bx->data, bx->count);
|
||||
}
|
||||
@@ -184,7 +186,7 @@ static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
|
||||
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
janet_buffer_push_cstring(buffer, "nil");
|
||||
janet_buffer_push_cstring(buffer, "");
|
||||
break;
|
||||
case JANET_BOOLEAN:
|
||||
janet_buffer_push_cstring(buffer,
|
||||
@@ -248,11 +250,34 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
}
|
||||
}
|
||||
|
||||
/* See parse.c for full table */
|
||||
|
||||
static const uint32_t pp_symchars[8] = {
|
||||
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x07fffffe,
|
||||
0x00000000, 0x00000000, 0x00000000, 0x00000000
|
||||
};
|
||||
|
||||
static int pp_is_symbol_char(uint8_t c) {
|
||||
return pp_symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
|
||||
}
|
||||
|
||||
/* Check if a symbol or keyword contains no symbol characters */
|
||||
static int contains_bad_chars(const uint8_t *sym, int issym) {
|
||||
int32_t len = janet_string_length(sym);
|
||||
if (len && issym && sym[0] >= '0' && sym[0] <= '9') return 1;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
if (!pp_is_symbol_char(sym[i])) return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NIL:
|
||||
janet_buffer_push_cstring(buffer, "nil");
|
||||
return;
|
||||
case JANET_KEYWORD:
|
||||
janet_buffer_push_u8(buffer, ':');
|
||||
break;
|
||||
@@ -261,10 +286,6 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||
return;
|
||||
case JANET_BUFFER: {
|
||||
JanetBuffer *b = janet_unwrap_buffer(x);
|
||||
if (b == buffer) {
|
||||
/* Ensures buffer won't resize while escaping */
|
||||
janet_buffer_ensure(b, 5 * b->count + 3, 1);
|
||||
}
|
||||
janet_escape_buffer_b(buffer, b);
|
||||
return;
|
||||
}
|
||||
@@ -326,6 +347,87 @@ struct pretty {
|
||||
JanetTable seen;
|
||||
};
|
||||
|
||||
/* Print jdn format */
|
||||
static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
||||
if (depth == 0) return 1;
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
case JANET_BOOLEAN:
|
||||
case JANET_BUFFER:
|
||||
case JANET_STRING:
|
||||
janet_description_b(S->buffer, x);
|
||||
break;
|
||||
case JANET_NUMBER:
|
||||
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
|
||||
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
|
||||
S->buffer->count += count;
|
||||
break;
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1;
|
||||
janet_description_b(S->buffer, x);
|
||||
break;
|
||||
case JANET_TUPLE: {
|
||||
JanetTuple t = janet_unwrap_tuple(x);
|
||||
int isb = janet_tuple_flag(t) & JANET_TUPLE_FLAG_BRACKETCTOR;
|
||||
janet_buffer_push_u8(S->buffer, isb ? '[' : '(');
|
||||
for (int32_t i = 0; i < janet_tuple_length(t); i++) {
|
||||
if (i) janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, t[i], depth - 1)) return 1;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, isb ? ']' : ')');
|
||||
}
|
||||
break;
|
||||
case JANET_ARRAY: {
|
||||
janet_table_put(&S->seen, x, janet_wrap_true());
|
||||
JanetArray *a = janet_unwrap_array(x);
|
||||
janet_buffer_push_cstring(S->buffer, "@[");
|
||||
for (int32_t i = 0; i < a->count; i++) {
|
||||
if (i) janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, a->data[i], depth - 1)) return 1;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, ']');
|
||||
}
|
||||
break;
|
||||
case JANET_TABLE: {
|
||||
janet_table_put(&S->seen, x, janet_wrap_true());
|
||||
JanetTable *tab = janet_unwrap_table(x);
|
||||
janet_buffer_push_cstring(S->buffer, "@{");
|
||||
int isFirst = 1;
|
||||
for (int32_t i = 0; i < tab->capacity; i++) {
|
||||
const JanetKV *kv = tab->data + i;
|
||||
if (janet_checktype(kv->key, JANET_NIL)) continue;
|
||||
if (!isFirst) janet_buffer_push_u8(S->buffer, ' ');
|
||||
isFirst = 0;
|
||||
if (print_jdn_one(S, kv->key, depth - 1)) return 1;
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, kv->value, depth - 1)) return 1;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, '}');
|
||||
}
|
||||
break;
|
||||
case JANET_STRUCT: {
|
||||
JanetStruct st = janet_unwrap_struct(x);
|
||||
janet_buffer_push_u8(S->buffer, '{');
|
||||
int isFirst = 1;
|
||||
for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||
const JanetKV *kv = st + i;
|
||||
if (janet_checktype(kv->key, JANET_NIL)) continue;
|
||||
if (!isFirst) janet_buffer_push_u8(S->buffer, ' ');
|
||||
isFirst = 0;
|
||||
if (print_jdn_one(S, kv->key, depth - 1)) return 1;
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, kv->value, depth - 1)) return 1;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, '}');
|
||||
}
|
||||
break;
|
||||
default:
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void print_newline(struct pretty *S, int just_a_space) {
|
||||
int i;
|
||||
if (just_a_space || (S->flags & JANET_PRETTY_ONELINE)) {
|
||||
@@ -352,7 +454,7 @@ static const char *janet_pretty_colors[] = {
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m"
|
||||
"\x1B[36m",
|
||||
"\x1B[35m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
@@ -362,8 +464,8 @@ static const char *janet_pretty_colors[] = {
|
||||
|
||||
#define JANET_PRETTY_DICT_ONELINE 4
|
||||
#define JANET_PRETTY_IND_ONELINE 10
|
||||
#define JANET_PRETTY_DICT_LIMIT 16
|
||||
#define JANET_PRETTY_ARRAY_LIMIT 16
|
||||
#define JANET_PRETTY_DICT_LIMIT 30
|
||||
#define JANET_PRETTY_ARRAY_LIMIT 160
|
||||
|
||||
/* Helper for pretty printing */
|
||||
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
@@ -430,7 +532,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
|
||||
if (len > JANET_PRETTY_ARRAY_LIMIT) {
|
||||
if (len > JANET_PRETTY_ARRAY_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
|
||||
for (i = 0; i < 3; i++) {
|
||||
if (i) print_newline(S, 0);
|
||||
janet_pretty_one(S, arr[i], 0);
|
||||
@@ -494,6 +596,11 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
|
||||
for (i = 0; i < cap; i++) {
|
||||
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
|
||||
if (counter == JANET_PRETTY_DICT_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
|
||||
print_newline(S, 0);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
break;
|
||||
}
|
||||
if (first_kv_pair) {
|
||||
first_kv_pair = 0;
|
||||
} else {
|
||||
@@ -503,11 +610,6 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
janet_pretty_one(S, kvs[i].value, 1);
|
||||
counter++;
|
||||
if (counter == 10) {
|
||||
print_newline(S, 0);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -544,6 +646,29 @@ JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
|
||||
return janet_pretty_(buffer, depth, flags, x, buffer ? buffer->count : 0);
|
||||
}
|
||||
|
||||
static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t startlen) {
|
||||
struct pretty S;
|
||||
if (NULL == buffer) {
|
||||
buffer = janet_buffer(0);
|
||||
}
|
||||
S.buffer = buffer;
|
||||
S.depth = depth;
|
||||
S.indent = 0;
|
||||
S.flags = 0;
|
||||
S.bufstartlen = startlen;
|
||||
janet_table_init(&S.seen, 10);
|
||||
int res = print_jdn_one(&S, x, depth);
|
||||
janet_table_deinit(&S.seen);
|
||||
if (res) {
|
||||
janet_panic("could not print to jdn format");
|
||||
}
|
||||
return S.buffer;
|
||||
}
|
||||
|
||||
JanetBuffer *janet_jdn(JanetBuffer *buffer, int depth, Janet x) {
|
||||
return janet_jdn_(buffer, depth, x, buffer ? buffer->count : 0);
|
||||
}
|
||||
|
||||
static const char *typestr(Janet x) {
|
||||
JanetType t = janet_type(x);
|
||||
return (t == JANET_ABSTRACT)
|
||||
@@ -568,96 +693,6 @@ static void pushtypes(JanetBuffer *buffer, int types) {
|
||||
}
|
||||
}
|
||||
|
||||
void janet_formatb(JanetBuffer *bufp, const char *format, va_list args) {
|
||||
for (const char *c = format; *c; c++) {
|
||||
switch (*c) {
|
||||
default:
|
||||
janet_buffer_push_u8(bufp, *c);
|
||||
break;
|
||||
case '%': {
|
||||
if (c[1] == '\0')
|
||||
break;
|
||||
switch (*++c) {
|
||||
default:
|
||||
janet_buffer_push_u8(bufp, *c);
|
||||
break;
|
||||
case 'f':
|
||||
number_to_string_b(bufp, va_arg(args, double));
|
||||
break;
|
||||
case 'd':
|
||||
integer_to_string_b(bufp, va_arg(args, long));
|
||||
break;
|
||||
case 'S': {
|
||||
const uint8_t *str = va_arg(args, const uint8_t *);
|
||||
janet_buffer_push_bytes(bufp, str, janet_string_length(str));
|
||||
break;
|
||||
}
|
||||
case 's':
|
||||
janet_buffer_push_cstring(bufp, va_arg(args, const char *));
|
||||
break;
|
||||
case 'c':
|
||||
janet_buffer_push_u8(bufp, (uint8_t) va_arg(args, long));
|
||||
break;
|
||||
case 'q': {
|
||||
const uint8_t *str = va_arg(args, const uint8_t *);
|
||||
janet_escape_string_b(bufp, str);
|
||||
break;
|
||||
}
|
||||
case 't': {
|
||||
janet_buffer_push_cstring(bufp, typestr(va_arg(args, Janet)));
|
||||
break;
|
||||
}
|
||||
case 'T': {
|
||||
int types = va_arg(args, long);
|
||||
pushtypes(bufp, types);
|
||||
break;
|
||||
}
|
||||
case 'V': {
|
||||
janet_to_string_b(bufp, va_arg(args, Janet));
|
||||
break;
|
||||
}
|
||||
case 'v': {
|
||||
janet_description_b(bufp, va_arg(args, Janet));
|
||||
break;
|
||||
}
|
||||
case 'p': {
|
||||
janet_pretty(bufp, 4, 0, va_arg(args, Janet));
|
||||
break;
|
||||
}
|
||||
case 'P': {
|
||||
janet_pretty(bufp, 4, JANET_PRETTY_COLOR, va_arg(args, Janet));
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Helper function for formatting strings. Useful for generating error messages and the like.
|
||||
* Similar to printf, but specialized for operating with janet. */
|
||||
const uint8_t *janet_formatc(const char *format, ...) {
|
||||
va_list args;
|
||||
const uint8_t *ret;
|
||||
JanetBuffer buffer;
|
||||
int32_t len = 0;
|
||||
|
||||
/* Calculate length, init buffer and args */
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
|
||||
/* Run format */
|
||||
janet_formatb(&buffer, format, args);
|
||||
|
||||
/* Iterate length */
|
||||
va_end(args);
|
||||
|
||||
ret = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
return ret;
|
||||
}
|
||||
|
||||
/*
|
||||
* code adapted from lua/lstrlib.c http://lua.org
|
||||
*/
|
||||
@@ -698,6 +733,154 @@ static const char *scanformat(
|
||||
return p;
|
||||
}
|
||||
|
||||
void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
const char *format_end = format + strlen(format);
|
||||
const char *c = format;
|
||||
int32_t startlen = b->count;
|
||||
while (c < format_end) {
|
||||
if (*c != '%') {
|
||||
janet_buffer_push_u8(b, (uint8_t) *c++);
|
||||
} else if (*++c == '%') {
|
||||
janet_buffer_push_u8(b, (uint8_t) *c++);
|
||||
} else {
|
||||
char form[MAX_FORMAT], item[MAX_ITEM];
|
||||
char width[3], precision[3];
|
||||
int nb = 0; /* number of bytes in added item */
|
||||
c = scanformat(c, form, width, precision);
|
||||
switch (*c++) {
|
||||
case 'c': {
|
||||
int n = va_arg(args, long);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = va_arg(args, long);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
case 'a':
|
||||
case 'A':
|
||||
case 'e':
|
||||
case 'E':
|
||||
case 'f':
|
||||
case 'g':
|
||||
case 'G': {
|
||||
double d = va_arg(args, double);
|
||||
nb = snprintf(item, MAX_ITEM, form, d);
|
||||
break;
|
||||
}
|
||||
case 's':
|
||||
case 'S': {
|
||||
const char *str = va_arg(args, const char *);
|
||||
int32_t len = c[-1] == 's'
|
||||
? (int32_t) strlen(str)
|
||||
: janet_string_length((JanetString) str);
|
||||
if (form[2] == '\0')
|
||||
janet_buffer_push_bytes(b, (const uint8_t *) str, len);
|
||||
else {
|
||||
if (len != (int32_t) strlen((const char *) str))
|
||||
janet_panic("string contains zeros");
|
||||
if (!strchr(form, '.') && len >= 100) {
|
||||
janet_panic("no precision and string is too long to be formatted");
|
||||
} else {
|
||||
nb = snprintf(item, MAX_ITEM, form, str);
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
case 'V':
|
||||
janet_to_string_b(b, va_arg(args, Janet));
|
||||
break;
|
||||
case 'v':
|
||||
janet_description_b(b, va_arg(args, Janet));
|
||||
break;
|
||||
case 't':
|
||||
janet_buffer_push_cstring(b, typestr(va_arg(args, Janet)));
|
||||
break;
|
||||
case 'T': {
|
||||
int types = va_arg(args, long);
|
||||
pushtypes(b, types);
|
||||
break;
|
||||
}
|
||||
case 'M':
|
||||
case 'm':
|
||||
case 'N':
|
||||
case 'n':
|
||||
case 'Q':
|
||||
case 'q':
|
||||
case 'P':
|
||||
case 'p': { /* janet pretty , precision = depth */
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1) depth = 4;
|
||||
char d = c[-1];
|
||||
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
|
||||
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
|
||||
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
|
||||
int flags = 0;
|
||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
||||
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
|
||||
janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen);
|
||||
break;
|
||||
}
|
||||
case 'j': {
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1)
|
||||
depth = JANET_RECURSION_GUARD;
|
||||
janet_jdn_(b, depth, va_arg(args, Janet), startlen);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
/* also treat cases 'nLlh' */
|
||||
janet_panicf("invalid conversion '%s' to 'format'",
|
||||
form);
|
||||
}
|
||||
}
|
||||
if (nb >= MAX_ITEM)
|
||||
janet_panicf("format buffer overflow", form);
|
||||
if (nb > 0)
|
||||
janet_buffer_push_bytes(b, (uint8_t *) item, nb);
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
/* Helper function for formatting strings. Useful for generating error messages and the like.
|
||||
* Similar to printf, but specialized for operating with janet. */
|
||||
const uint8_t *janet_formatc(const char *format, ...) {
|
||||
va_list args;
|
||||
const uint8_t *ret;
|
||||
JanetBuffer buffer;
|
||||
int32_t len = 0;
|
||||
|
||||
/* Calculate length, init buffer and args */
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
|
||||
/* Run format */
|
||||
janet_formatbv(&buffer, format, args);
|
||||
|
||||
/* Iterate length */
|
||||
va_end(args);
|
||||
|
||||
ret = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
return ret;
|
||||
}
|
||||
|
||||
JanetBuffer *janet_formatb(JanetBuffer *buffer, const char *format, ...) {
|
||||
va_list args;
|
||||
va_start(args, format);
|
||||
janet_formatbv(buffer, format, args);
|
||||
va_end(args);
|
||||
return buffer;
|
||||
}
|
||||
|
||||
/* Shared implementation between string/format and
|
||||
* buffer/format */
|
||||
void janet_buffer_format(
|
||||
@@ -731,7 +914,6 @@ void janet_buffer_format(
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'u':
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = janet_getinteger(argv, arg);
|
||||
@@ -773,22 +955,37 @@ void janet_buffer_format(
|
||||
janet_description_b(b, argv[arg]);
|
||||
break;
|
||||
}
|
||||
case 't':
|
||||
janet_buffer_push_cstring(b, typestr(argv[arg]));
|
||||
break;
|
||||
case 'M':
|
||||
case 'm':
|
||||
case 'N':
|
||||
case 'n':
|
||||
case 'Q':
|
||||
case 'q':
|
||||
case 'P':
|
||||
case 'p': { /* janet pretty , precision = depth */
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1)
|
||||
depth = 4;
|
||||
char c = strfrmt[-1];
|
||||
int has_color = (c == 'P') || (c == 'Q');
|
||||
int has_oneline = (c == 'Q') || (c == 'q');
|
||||
if (depth < 1) depth = 4;
|
||||
char d = strfrmt[-1];
|
||||
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
|
||||
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
|
||||
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
|
||||
int flags = 0;
|
||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
||||
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
|
||||
janet_pretty_(b, depth, flags, argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
case 'j': {
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1)
|
||||
depth = JANET_RECURSION_GUARD;
|
||||
janet_jdn_(b, depth, argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
/* also treat cases 'nLlh' */
|
||||
janet_panicf("invalid conversion '%s' to 'format'",
|
||||
@@ -802,3 +999,6 @@ void janet_buffer_format(
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#undef HEX
|
||||
#undef BUFSIZE
|
||||
|
||||
@@ -145,7 +145,7 @@ void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg) {
|
||||
int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth) {
|
||||
int32_t oldmax = ra->max;
|
||||
if (ra->regtemps & (1 << nth)) {
|
||||
janet_exit("regtemp already allocated");
|
||||
JANET_EXIT("regtemp already allocated");
|
||||
}
|
||||
ra->regtemps |= 1 << nth;
|
||||
int32_t reg = janetc_regalloc_1(ra);
|
||||
|
||||
@@ -23,7 +23,6 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
/* Run a string */
|
||||
@@ -50,15 +49,16 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||
fiber->env = env;
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace(fiber, ret);
|
||||
errflags |= 0x01;
|
||||
done = 1;
|
||||
}
|
||||
} else {
|
||||
ret = janet_wrap_string(cres.error);
|
||||
if (cres.macrofiber) {
|
||||
janet_eprintf("compile error in %s: ", sourcePath);
|
||||
janet_stacktrace(cres.macrofiber, janet_wrap_string(cres.error));
|
||||
janet_stacktrace(cres.macrofiber, ret);
|
||||
} else {
|
||||
janet_eprintf("compile error in %s: %s\n", sourcePath,
|
||||
(const char *)cres.error);
|
||||
@@ -68,25 +68,23 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
}
|
||||
}
|
||||
|
||||
if (done) break;
|
||||
|
||||
/* Dispatch based on parse state */
|
||||
switch (janet_parser_status(&parser)) {
|
||||
case JANET_PARSE_DEAD:
|
||||
done = 1;
|
||||
break;
|
||||
case JANET_PARSE_ERROR:
|
||||
case JANET_PARSE_ERROR: {
|
||||
const char *e = janet_parser_error(&parser);
|
||||
errflags |= 0x04;
|
||||
janet_eprintf("parse error in %s: %s\n",
|
||||
sourcePath, janet_parser_error(&parser));
|
||||
ret = janet_cstringv(e);
|
||||
janet_eprintf("parse error in %s: %s\n", sourcePath, e);
|
||||
done = 1;
|
||||
break;
|
||||
case JANET_PARSE_PENDING:
|
||||
if (index == len) {
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
janet_parser_consume(&parser, bytes[index++]);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_PARSE_ROOT:
|
||||
case JANET_PARSE_PENDING:
|
||||
if (index >= len) {
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
|
||||
@@ -538,6 +538,20 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
}
|
||||
}
|
||||
|
||||
/* Check if a form matches the pattern (not= nil _) */
|
||||
static int janetc_check_notnil_form(Janet x, Janet *capture) {
|
||||
if (!janet_checktype(x, JANET_TUPLE)) return 0;
|
||||
JanetTuple tup = janet_unwrap_tuple(x);
|
||||
if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0;
|
||||
if (3 != janet_tuple_length(tup)) return 0;
|
||||
JanetFunction *fun = janet_unwrap_function(tup[0]);
|
||||
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
|
||||
if (tag != JANET_FUN_NEQ) return 0;
|
||||
if (!janet_checktype(tup[1], JANET_NIL)) return 0;
|
||||
*capture = tup[2];
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* :whiletop
|
||||
* ...
|
||||
@@ -554,6 +568,9 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
JanetScope tempscope;
|
||||
int32_t labelwt, labeld, labeljt, labelc, i;
|
||||
int infinite = 0;
|
||||
int is_notnil_form = 0;
|
||||
uint8_t ifjmp = JOP_JUMP_IF;
|
||||
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
|
||||
|
||||
if (argn < 2) {
|
||||
janetc_cerror(c, "expected at least 2 arguments");
|
||||
@@ -564,13 +581,26 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
|
||||
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
|
||||
|
||||
/* Check for `(not= nil _)` in condition, and if so, use the
|
||||
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
|
||||
* more efficiently. */
|
||||
Janet condform = argv[0];
|
||||
if (janetc_check_notnil_form(condform, &condform)) {
|
||||
is_notnil_form = 1;
|
||||
ifjmp = JOP_JUMP_IF_NOT_NIL;
|
||||
ifnjmp = JOP_JUMP_IF_NIL;
|
||||
}
|
||||
|
||||
/* Compile condition */
|
||||
cond = janetc_value(subopts, argv[0]);
|
||||
cond = janetc_value(subopts, condform);
|
||||
|
||||
/* Check for constant condition */
|
||||
if (cond.flags & JANET_SLOT_CONSTANT) {
|
||||
/* Loop never executes */
|
||||
if (!janet_truthy(cond.constant)) {
|
||||
int never_executes = is_notnil_form
|
||||
? janet_checktype(cond.constant, JANET_NIL)
|
||||
: !janet_truthy(cond.constant);
|
||||
if (never_executes) {
|
||||
janetc_popscope(c);
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
@@ -581,7 +611,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Infinite loop does not need to check condition */
|
||||
labelc = infinite
|
||||
? 0
|
||||
: janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
|
||||
: janetc_emit_si(c, ifnjmp, cond, 0, 0);
|
||||
|
||||
/* Compile body */
|
||||
for (i = 1; i < argn; i++) {
|
||||
@@ -592,18 +622,19 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Check if closure created in while scope. If so,
|
||||
* recompile in a function scope. */
|
||||
if (tempscope.flags & JANET_SCOPE_CLOSURE) {
|
||||
subopts = janetc_fopts_default(c);
|
||||
tempscope.flags |= JANET_SCOPE_UNUSED;
|
||||
janetc_popscope(c);
|
||||
janet_v__cnt(c->buffer) = labelwt;
|
||||
janet_v__cnt(c->mapbuffer) = labelwt;
|
||||
if (c->buffer) janet_v__cnt(c->buffer) = labelwt;
|
||||
if (c->mapbuffer) janet_v__cnt(c->mapbuffer) = labelwt;
|
||||
|
||||
janetc_scope(&tempscope, c, JANET_SCOPE_FUNCTION, "while-iife");
|
||||
|
||||
/* Recompile in the function scope */
|
||||
cond = janetc_value(subopts, argv[0]);
|
||||
cond = janetc_value(subopts, condform);
|
||||
if (!(cond.flags & JANET_SLOT_CONSTANT)) {
|
||||
/* If not an infinite loop, return nil when condition false */
|
||||
janetc_emit_si(c, JOP_JUMP_IF, cond, 2, 0);
|
||||
janetc_emit_si(c, ifjmp, cond, 2, 0);
|
||||
janetc_emit(c, JOP_RETURN_NIL);
|
||||
}
|
||||
for (i = 1; i < argn; i++) {
|
||||
@@ -618,6 +649,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Compile function */
|
||||
JanetFuncDef *def = janetc_pop_funcdef(c);
|
||||
def->name = janet_cstring("_while");
|
||||
janet_def_addflags(def);
|
||||
int32_t defindex = janetc_addfuncdef(c, def);
|
||||
/* And then load the closure and call it. */
|
||||
int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0);
|
||||
@@ -792,6 +824,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
|
||||
if (selfref) def->name = janet_unwrap_symbol(head);
|
||||
janet_def_addflags(def);
|
||||
defindex = janetc_addfuncdef(c, def);
|
||||
|
||||
/* Ensure enough slots for vararg function. */
|
||||
|
||||
@@ -32,6 +32,11 @@
|
||||
* be in it. However, thread local global variables for interpreter
|
||||
* state should allow easy multi-threading. */
|
||||
|
||||
typedef struct JanetScratch JanetScratch;
|
||||
|
||||
/* Top level dynamic bindings */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
|
||||
|
||||
/* Cache the core environment */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
|
||||
|
||||
@@ -41,6 +46,7 @@ extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
||||
/* The current running fiber on the current thread.
|
||||
* Set and unset by janet_run. */
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_root_fiber;
|
||||
|
||||
/* The current pointer to the inner most jmp_buf. The current
|
||||
* return point for panics. */
|
||||
@@ -51,6 +57,10 @@ extern JANET_THREAD_LOCAL Janet *janet_vm_return_reg;
|
||||
* along with otherwise bare c function pointers. */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||
|
||||
/* Registry for abstract abstract types that can be marshalled.
|
||||
* We need this to look up the constructors when unmarshalling. */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
|
||||
|
||||
/* Immutable value cache */
|
||||
extern JANET_THREAD_LOCAL const uint8_t **janet_vm_cache;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity;
|
||||
@@ -61,6 +71,7 @@ extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
|
||||
extern JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_next_collection;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_block_count;
|
||||
extern JANET_THREAD_LOCAL int janet_vm_gc_suspend;
|
||||
|
||||
/* GC roots */
|
||||
@@ -69,14 +80,35 @@ extern JANET_THREAD_LOCAL size_t janet_vm_root_count;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
|
||||
|
||||
/* Scratch memory */
|
||||
extern JANET_THREAD_LOCAL void **janet_scratch_mem;
|
||||
extern JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
|
||||
/* Recursionless traversal of data structures */
|
||||
typedef struct {
|
||||
JanetGCObject *self;
|
||||
JanetGCObject *other;
|
||||
int32_t index;
|
||||
int32_t index2;
|
||||
} JanetTraversalNode;
|
||||
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal;
|
||||
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top;
|
||||
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base;
|
||||
|
||||
/* Setup / teardown */
|
||||
#ifdef JANET_THREADS
|
||||
void janet_threads_init(void);
|
||||
void janet_threads_deinit(void);
|
||||
#endif
|
||||
|
||||
#ifdef JANET_NET
|
||||
void janet_net_init(void);
|
||||
void janet_net_deinit(void);
|
||||
#endif
|
||||
|
||||
#ifdef JANET_EV
|
||||
void janet_ev_init(void);
|
||||
void janet_ev_deinit(void);
|
||||
#endif
|
||||
|
||||
#endif /* JANET_STATE_H_defined */
|
||||
|
||||
@@ -51,7 +51,7 @@ const uint8_t *janet_string(const uint8_t *buf, int32_t len) {
|
||||
head->length = len;
|
||||
head->hash = janet_string_calchash(buf, len);
|
||||
uint8_t *data = (uint8_t *)head->data;
|
||||
memcpy(data, buf, len);
|
||||
safe_memcpy(data, buf, len);
|
||||
data[len] = 0;
|
||||
return data;
|
||||
}
|
||||
@@ -62,7 +62,7 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) {
|
||||
int32_t ylen = janet_string_length(rhs);
|
||||
int32_t len = xlen > ylen ? ylen : xlen;
|
||||
int res = memcmp(lhs, rhs, len);
|
||||
if (res) return res;
|
||||
if (res) return res > 0 ? 1 : -1;
|
||||
if (xlen == ylen) return 0;
|
||||
return xlen < ylen ? -1 : 1;
|
||||
}
|
||||
@@ -176,6 +176,18 @@ static Janet cfun_string_slice(int32_t argc, Janet *argv) {
|
||||
return janet_stringv(view.bytes + range.start, range.end - range.start);
|
||||
}
|
||||
|
||||
static Janet cfun_symbol_slice(int32_t argc, Janet *argv) {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_symbolv(view.bytes + range.start, range.end - range.start);
|
||||
}
|
||||
|
||||
static Janet cfun_keyword_slice(int32_t argc, Janet *argv) {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_keywordv(view.bytes + range.start, range.end - range.start);
|
||||
}
|
||||
|
||||
static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
@@ -187,7 +199,7 @@ static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
|
||||
uint8_t *newbuf = janet_string_begin((int32_t) mulres);
|
||||
uint8_t *end = newbuf + mulres;
|
||||
for (uint8_t *p = newbuf; p < end; p += view.len) {
|
||||
memcpy(p, view.bytes, view.len);
|
||||
safe_memcpy(p, view.bytes, view.len);
|
||||
}
|
||||
return janet_wrap_string(janet_string_end(newbuf));
|
||||
}
|
||||
@@ -343,11 +355,11 @@ static Janet cfun_string_replace(int32_t argc, Janet *argv) {
|
||||
return janet_stringv(s.kmp.text, s.kmp.textlen);
|
||||
}
|
||||
buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + s.substlen);
|
||||
memcpy(buf, s.kmp.text, result);
|
||||
memcpy(buf + result, s.subst, s.substlen);
|
||||
memcpy(buf + result + s.substlen,
|
||||
s.kmp.text + result + s.kmp.patlen,
|
||||
s.kmp.textlen - result - s.kmp.patlen);
|
||||
safe_memcpy(buf, s.kmp.text, result);
|
||||
safe_memcpy(buf + result, s.subst, s.substlen);
|
||||
safe_memcpy(buf + result + s.substlen,
|
||||
s.kmp.text + result + s.kmp.patlen,
|
||||
s.kmp.textlen - result - s.kmp.patlen);
|
||||
kmp_deinit(&s.kmp);
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
@@ -445,11 +457,11 @@ static Janet cfun_string_join(int32_t argc, Janet *argv) {
|
||||
const uint8_t *chunk = NULL;
|
||||
int32_t chunklen = 0;
|
||||
if (i) {
|
||||
memcpy(out, joiner.bytes, joiner.len);
|
||||
safe_memcpy(out, joiner.bytes, joiner.len);
|
||||
out += joiner.len;
|
||||
}
|
||||
janet_bytes_view(parts.items[i], &chunk, &chunklen);
|
||||
memcpy(out, chunk, chunklen);
|
||||
safe_memcpy(out, chunk, chunklen);
|
||||
out += chunklen;
|
||||
}
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
@@ -529,6 +541,16 @@ static const JanetReg string_cfuns[] = {
|
||||
"from the end of the string. Note that index -1 is synonymous with "
|
||||
"index (length bytes) to allow a full negative slice range. ")
|
||||
},
|
||||
{
|
||||
"keyword/slice", cfun_keyword_slice,
|
||||
JDOC("(keyword/slice bytes &opt start end)\n\n"
|
||||
"Same a string/slice, but returns a keyword.")
|
||||
},
|
||||
{
|
||||
"symbol/slice", cfun_symbol_slice,
|
||||
JDOC("(symbol/slice bytes &opt start end)\n\n"
|
||||
"Same a string/slice, but returns a symbol.")
|
||||
},
|
||||
{
|
||||
"string/repeat", cfun_string_repeat,
|
||||
JDOC("(string/repeat bytes n)\n\n"
|
||||
@@ -542,7 +564,7 @@ static const JanetReg string_cfuns[] = {
|
||||
{
|
||||
"string/from-bytes", cfun_string_frombytes,
|
||||
JDOC("(string/from-bytes & byte-vals)\n\n"
|
||||
"Creates a string from integer params with byte values. All integers "
|
||||
"Creates a string from integer parameters with byte values. All integers "
|
||||
"will be coerced to the range of 1 byte 0-255.")
|
||||
},
|
||||
{
|
||||
@@ -573,7 +595,7 @@ static const JanetReg string_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"string/find-all", cfun_string_findall,
|
||||
JDOC("(string/find patt str)\n\n"
|
||||
JDOC("(string/find-all patt str)\n\n"
|
||||
"Searches for all instances of pattern patt in string "
|
||||
"str. Returns an array of all indices of found patterns. Overlapping "
|
||||
"instances of the pattern are not counted, meaning a byte in string "
|
||||
@@ -627,7 +649,7 @@ static const JanetReg string_cfuns[] = {
|
||||
{
|
||||
"string/format", cfun_string_format,
|
||||
JDOC("(string/format format & values)\n\n"
|
||||
"Similar to snprintf, but specialized for operating with janet. Returns "
|
||||
"Similar to snprintf, but specialized for operating with Janet values. Returns "
|
||||
"a new string.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -208,9 +208,9 @@ static double convert(
|
||||
|
||||
/* Approximate exponent in base 2 of mant and exponent. This should get us a good estimate of the final size of the
|
||||
* number, within * 2^32 or so. */
|
||||
int32_t mant_exp2_approx = mant->n * 32 + 16;
|
||||
int32_t exp_exp2_approx = (int32_t)(floor(log2(base) * exponent));
|
||||
int32_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
|
||||
int64_t mant_exp2_approx = mant->n * 32 + 16;
|
||||
int64_t exp_exp2_approx = (int64_t)(floor(log2(base) * exponent));
|
||||
int64_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
|
||||
|
||||
/* Short circuit zero, huge, and small numbers. We use the exponent range of valid IEEE754 doubles (-1022, 1023)
|
||||
* with a healthy buffer to allow for inaccuracies in the approximation and denormailzed numbers. */
|
||||
@@ -447,12 +447,16 @@ int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out) {
|
||||
int neg;
|
||||
uint64_t bi;
|
||||
if (scan_uint64(str, len, &bi, &neg)) {
|
||||
if (neg && bi <= 0x8000000000000000ULL) {
|
||||
*out = -((int64_t) bi);
|
||||
if (neg && bi <= (UINT64_MAX / 2)) {
|
||||
if (bi > INT64_MAX) {
|
||||
*out = INT64_MIN;
|
||||
} else {
|
||||
*out = -((int64_t) bi);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
if (!neg && bi <= 0x7FFFFFFFFFFFFFFFULL) {
|
||||
*out = bi;
|
||||
if (!neg && bi <= INT64_MAX) {
|
||||
*out = (int64_t) bi;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -123,7 +123,8 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||
dist = otherdist;
|
||||
hash = otherhash;
|
||||
} else if (status == 0) {
|
||||
/* A key was added to the struct more than once */
|
||||
/* A key was added to the struct more than once - replace old value */
|
||||
kv->value = value;
|
||||
return;
|
||||
}
|
||||
}
|
||||
@@ -166,51 +167,3 @@ JanetTable *janet_struct_to_table(const JanetKV *st) {
|
||||
}
|
||||
return table;
|
||||
}
|
||||
|
||||
/* Check if two structs are equal */
|
||||
int janet_struct_equal(const JanetKV *lhs, const JanetKV *rhs) {
|
||||
int32_t index;
|
||||
int32_t llen = janet_struct_capacity(lhs);
|
||||
int32_t rlen = janet_struct_capacity(rhs);
|
||||
int32_t lhash = janet_struct_hash(lhs);
|
||||
int32_t rhash = janet_struct_hash(rhs);
|
||||
if (llen != rlen)
|
||||
return 0;
|
||||
if (lhash != rhash)
|
||||
return 0;
|
||||
for (index = 0; index < llen; index++) {
|
||||
const JanetKV *l = lhs + index;
|
||||
const JanetKV *r = rhs + index;
|
||||
if (!janet_equals(l->key, r->key))
|
||||
return 0;
|
||||
if (!janet_equals(l->value, r->value))
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Compare structs */
|
||||
int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs) {
|
||||
int32_t i;
|
||||
int32_t lhash = janet_struct_hash(lhs);
|
||||
int32_t rhash = janet_struct_hash(rhs);
|
||||
int32_t llen = janet_struct_capacity(lhs);
|
||||
int32_t rlen = janet_struct_capacity(rhs);
|
||||
if (llen < rlen)
|
||||
return -1;
|
||||
if (llen > rlen)
|
||||
return 1;
|
||||
if (lhash < rhash)
|
||||
return -1;
|
||||
if (lhash > rhash)
|
||||
return 1;
|
||||
for (i = 0; i < llen; ++i) {
|
||||
const JanetKV *l = lhs + i;
|
||||
const JanetKV *r = rhs + i;
|
||||
int comp = janet_compare(l->key, r->key);
|
||||
if (comp != 0) return comp;
|
||||
comp = janet_compare(l->value, r->value);
|
||||
if (comp != 0) return comp;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -183,7 +183,7 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
||||
head->hash = hash;
|
||||
head->length = len;
|
||||
newstr = (uint8_t *)(head->data);
|
||||
memcpy(newstr, str, len);
|
||||
safe_memcpy(newstr, str, len);
|
||||
newstr[len] = 0;
|
||||
janet_symcache_put((const uint8_t *)newstr, bucket);
|
||||
return newstr;
|
||||
|
||||
@@ -173,7 +173,7 @@ Janet janet_table_rawget(JanetTable *t, Janet key) {
|
||||
Janet janet_table_remove(JanetTable *t, Janet key) {
|
||||
JanetKV *bucket = janet_table_find(t, key);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
|
||||
Janet ret = bucket->key;
|
||||
Janet ret = bucket->value;
|
||||
t->count--;
|
||||
t->deleted++;
|
||||
bucket->key = janet_wrap_nil();
|
||||
|
||||
@@ -51,10 +51,6 @@ struct JanetMailbox {
|
||||
pthread_cond_t cond;
|
||||
#endif
|
||||
|
||||
/* Setup procedure - requires a parent mailbox
|
||||
* to receive thunk from */
|
||||
JanetMailbox *parent;
|
||||
|
||||
/* Memory management - reference counting */
|
||||
int refCount;
|
||||
int closed;
|
||||
@@ -70,6 +66,17 @@ struct JanetMailbox {
|
||||
JanetBuffer messages[];
|
||||
};
|
||||
|
||||
#define JANET_THREAD_HEAVYWEIGHT 0x1
|
||||
#define JANET_THREAD_ABSTRACTS 0x2
|
||||
#define JANET_THREAD_CFUNCTIONS 0x4
|
||||
static const char janet_thread_flags[] = "hac";
|
||||
|
||||
typedef struct {
|
||||
JanetMailbox *original;
|
||||
JanetMailbox *newbox;
|
||||
uint64_t flags;
|
||||
} JanetMailboxPair;
|
||||
|
||||
static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
|
||||
static JANET_THREAD_LOCAL JanetThread *janet_vm_thread_current = NULL;
|
||||
static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL;
|
||||
@@ -82,7 +89,7 @@ static JanetTable *janet_thread_get_decode(void) {
|
||||
return janet_vm_thread_decode;
|
||||
}
|
||||
|
||||
static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, uint16_t capacity) {
|
||||
static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) {
|
||||
JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
|
||||
if (NULL == mailbox) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -96,7 +103,6 @@ static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, ui
|
||||
#endif
|
||||
mailbox->refCount = refCount;
|
||||
mailbox->closed = 0;
|
||||
mailbox->parent = parent;
|
||||
mailbox->messageCount = 0;
|
||||
mailbox->messageCapacity = capacity;
|
||||
mailbox->messageFirst = 0;
|
||||
@@ -175,6 +181,24 @@ static int thread_mark(void *p, size_t size) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
|
||||
JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
|
||||
if (NULL == pair) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
pair->original = original;
|
||||
janet_mailbox_ref(original, 1);
|
||||
pair->newbox = janet_mailbox_create(1, 16);
|
||||
pair->flags = flags;
|
||||
return pair;
|
||||
}
|
||||
|
||||
static void destroy_mailbox_pair(JanetMailboxPair *pair) {
|
||||
janet_mailbox_ref(pair->original, -1);
|
||||
janet_mailbox_ref(pair->newbox, -1);
|
||||
free(pair);
|
||||
}
|
||||
|
||||
/* Abstract waiting for timeout across windows/posix */
|
||||
typedef struct {
|
||||
int timedwait;
|
||||
@@ -210,7 +234,7 @@ static void janet_waiter_init(JanetWaiter *waiter, double sec) {
|
||||
if (waiter->timedwait) {
|
||||
/* N seconds -> timespec of (now + sec) */
|
||||
struct timespec now;
|
||||
clock_gettime(CLOCK_REALTIME, &now);
|
||||
janet_gettime(&now);
|
||||
time_t tvsec = (time_t) floor(sec);
|
||||
long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
|
||||
tvsec += now.tv_sec;
|
||||
@@ -312,7 +336,7 @@ int janet_thread_send(JanetThread *thread, Janet msg, double timeout) {
|
||||
msgbuf->count = 0;
|
||||
|
||||
/* Start panic zone */
|
||||
janet_marshal(msgbuf, msg, thread->encode, 0);
|
||||
janet_marshal(msgbuf, msg, thread->encode, JANET_MARSHAL_UNSAFE);
|
||||
/* End panic zone */
|
||||
|
||||
mailbox->messageNext = (mailbox->messageNext + 1) % mailbox->messageCapacity;
|
||||
@@ -351,8 +375,12 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
|
||||
/* Handle errors */
|
||||
if (setjmp(buf)) {
|
||||
/* Cleanup jmp_buf, keep lock */
|
||||
/* Cleanup jmp_buf, return error.
|
||||
* Do not ignore bad messages as before. */
|
||||
janet_vm_jmp_buf = old_buf;
|
||||
*msg_out = *janet_vm_return_reg;
|
||||
janet_mailbox_unlock(mailbox);
|
||||
return 2;
|
||||
} else {
|
||||
JanetBuffer *msgbuf = mailbox->messages + mailbox->messageFirst;
|
||||
mailbox->messageCount--;
|
||||
@@ -362,7 +390,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
const uint8_t *nextItem = NULL;
|
||||
Janet item = janet_unmarshal(
|
||||
msgbuf->data, msgbuf->count,
|
||||
0, janet_thread_get_decode(), &nextItem);
|
||||
JANET_MARSHAL_UNSAFE, janet_thread_get_decode(), &nextItem);
|
||||
*msg_out = item;
|
||||
|
||||
/* Cleanup */
|
||||
@@ -387,59 +415,81 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
static int janet_thread_getter(void *p, Janet key, Janet *out);
|
||||
|
||||
static JanetAbstractType Thread_AT = {
|
||||
const JanetAbstractType janet_thread_type = {
|
||||
"core/thread",
|
||||
thread_gc,
|
||||
thread_mark,
|
||||
janet_thread_getter,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
|
||||
JanetThread *thread = janet_abstract(&Thread_AT, sizeof(JanetThread));
|
||||
JanetThread *thread = janet_abstract(&janet_thread_type, sizeof(JanetThread));
|
||||
janet_mailbox_ref(mailbox, 1);
|
||||
thread->mailbox = mailbox;
|
||||
thread->encode = encode;
|
||||
return thread;
|
||||
}
|
||||
|
||||
JanetThread *janet_getthread(const Janet *argv, int32_t n) {
|
||||
return (JanetThread *) janet_getabstract(argv, n, &Thread_AT);
|
||||
return (JanetThread *) janet_getabstract(argv, n, &janet_thread_type);
|
||||
}
|
||||
|
||||
/* Runs in new thread */
|
||||
static int thread_worker(JanetMailbox *mailbox) {
|
||||
static int thread_worker(JanetMailboxPair *pair) {
|
||||
JanetFiber *fiber = NULL;
|
||||
Janet out;
|
||||
|
||||
/* Use the mailbox we were given */
|
||||
janet_vm_mailbox = mailbox;
|
||||
janet_vm_mailbox = pair->newbox;
|
||||
janet_mailbox_ref(pair->newbox, 1);
|
||||
|
||||
/* Init VM */
|
||||
janet_init();
|
||||
|
||||
/* Get dictionaries for default encode/decode */
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
JanetTable *encode;
|
||||
if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
|
||||
encode = janet_get_core_table("make-image-dict");
|
||||
} else {
|
||||
encode = NULL;
|
||||
janet_vm_thread_decode = janet_table(0);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
|
||||
}
|
||||
|
||||
/* Create parent thread */
|
||||
JanetThread *parent = janet_make_thread(mailbox->parent, encode);
|
||||
janet_mailbox_ref(mailbox->parent, -1);
|
||||
mailbox->parent = NULL; /* only used to create the thread */
|
||||
JanetThread *parent = janet_make_thread(pair->original, encode);
|
||||
Janet parentv = janet_wrap_abstract(parent);
|
||||
|
||||
/* Unmarshal the abstract registry */
|
||||
if (pair->flags & JANET_THREAD_ABSTRACTS) {
|
||||
Janet reg;
|
||||
int status = janet_thread_receive(®, INFINITY);
|
||||
if (status) goto error;
|
||||
if (!janet_checktype(reg, JANET_TABLE)) goto error;
|
||||
janet_gcunroot(janet_wrap_table(janet_vm_abstract_registry));
|
||||
janet_vm_abstract_registry = janet_unwrap_table(reg);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
|
||||
}
|
||||
|
||||
/* Unmarshal the normal registry */
|
||||
if (pair->flags & JANET_THREAD_CFUNCTIONS) {
|
||||
Janet reg;
|
||||
int status = janet_thread_receive(®, INFINITY);
|
||||
if (status) goto error;
|
||||
if (!janet_checktype(reg, JANET_TABLE)) goto error;
|
||||
janet_gcunroot(janet_wrap_table(janet_vm_registry));
|
||||
janet_vm_registry = janet_unwrap_table(reg);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
||||
}
|
||||
|
||||
/* Unmarshal the function */
|
||||
Janet funcv;
|
||||
int status = janet_thread_receive(&funcv, INFINITY);
|
||||
|
||||
if (status) goto error;
|
||||
if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
|
||||
JanetFunction *func = janet_unwrap_function(funcv);
|
||||
@@ -452,18 +502,28 @@ static int thread_worker(JanetMailbox *mailbox) {
|
||||
/* Call function */
|
||||
Janet argv[1] = { parentv };
|
||||
fiber = janet_fiber(func, 64, 1, argv);
|
||||
if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
|
||||
fiber->env = janet_table(0);
|
||||
fiber->env->proto = janet_core_env(NULL);
|
||||
}
|
||||
JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (sig != JANET_SIGNAL_OK) {
|
||||
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(mailbox, encode)));
|
||||
if (sig != JANET_SIGNAL_OK && sig < JANET_SIGNAL_USER0) {
|
||||
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
#ifdef JANET_NET
|
||||
janet_loop();
|
||||
#endif
|
||||
|
||||
/* Normal exit */
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_deinit();
|
||||
return 0;
|
||||
|
||||
/* Fail to set something up */
|
||||
error:
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_eprintf("\nthread failed to start\n");
|
||||
janet_deinit();
|
||||
return 1;
|
||||
@@ -472,12 +532,12 @@ error:
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) {
|
||||
thread_worker((JanetMailbox *)param);
|
||||
thread_worker((JanetMailboxPair *)param);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int janet_thread_start_child(JanetThread *thread) {
|
||||
HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, thread->mailbox, 0, NULL);
|
||||
static int janet_thread_start_child(JanetMailboxPair *pair) {
|
||||
HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, pair, 0, NULL);
|
||||
int ret = NULL == handle;
|
||||
/* Does not kill thread, simply detatches */
|
||||
if (!ret) CloseHandle(handle);
|
||||
@@ -487,13 +547,13 @@ static int janet_thread_start_child(JanetThread *thread) {
|
||||
#else
|
||||
|
||||
static void *janet_pthread_wrapper(void *param) {
|
||||
thread_worker((JanetMailbox *)param);
|
||||
thread_worker((JanetMailboxPair *)param);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static int janet_thread_start_child(JanetThread *thread) {
|
||||
static int janet_thread_start_child(JanetMailboxPair *pair) {
|
||||
pthread_t handle;
|
||||
int error = pthread_create(&handle, NULL, janet_pthread_wrapper, thread->mailbox);
|
||||
int error = pthread_create(&handle, NULL, janet_pthread_wrapper, pair);
|
||||
if (error) {
|
||||
return 1;
|
||||
} else {
|
||||
@@ -510,7 +570,7 @@ static int janet_thread_start_child(JanetThread *thread) {
|
||||
|
||||
void janet_threads_init(void) {
|
||||
if (NULL == janet_vm_mailbox) {
|
||||
janet_vm_mailbox = janet_mailbox_create(NULL, 1, 10);
|
||||
janet_vm_mailbox = janet_mailbox_create(1, 10);
|
||||
}
|
||||
janet_vm_thread_decode = NULL;
|
||||
janet_vm_thread_current = NULL;
|
||||
@@ -534,33 +594,46 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
if (NULL == janet_vm_thread_current) {
|
||||
janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
|
||||
janet_mailbox_ref(janet_vm_mailbox, 1);
|
||||
janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
|
||||
}
|
||||
return janet_wrap_abstract(janet_vm_thread_current);
|
||||
}
|
||||
|
||||
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
janet_arity(argc, 1, 3);
|
||||
/* Just type checking */
|
||||
janet_getfunction(argv, 0);
|
||||
int32_t cap = janet_optinteger(argv, argc, 1, 10);
|
||||
if (cap < 1 || cap > UINT16_MAX) {
|
||||
janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
|
||||
}
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
JanetMailbox *mailbox = janet_mailbox_create(janet_vm_mailbox, 2, (uint16_t) cap);
|
||||
uint64_t flags = argc >= 3 ? janet_getflags(argv, 2, janet_thread_flags) : JANET_THREAD_ABSTRACTS;
|
||||
JanetTable *encode;
|
||||
if (flags & JANET_THREAD_HEAVYWEIGHT) {
|
||||
encode = janet_get_core_table("make-image-dict");
|
||||
} else {
|
||||
encode = NULL;
|
||||
}
|
||||
|
||||
/* one for created thread, one for ->parent reference in new mailbox */
|
||||
janet_mailbox_ref(janet_vm_mailbox, 2);
|
||||
|
||||
JanetThread *thread = janet_make_thread(mailbox, encode);
|
||||
if (janet_thread_start_child(thread)) {
|
||||
janet_mailbox_ref(mailbox, -1); /* mailbox reference */
|
||||
janet_mailbox_ref(janet_vm_mailbox, -1); /* ->parent reference */
|
||||
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox, flags);
|
||||
JanetThread *thread = janet_make_thread(pair->newbox, encode);
|
||||
if (janet_thread_start_child(pair)) {
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_panic("could not start thread");
|
||||
}
|
||||
|
||||
if (flags & JANET_THREAD_ABSTRACTS) {
|
||||
if (janet_thread_send(thread, janet_wrap_table(janet_vm_abstract_registry), INFINITY)) {
|
||||
janet_panic("could not send abstract registry to thread");
|
||||
}
|
||||
}
|
||||
|
||||
if (flags & JANET_THREAD_CFUNCTIONS) {
|
||||
if (janet_thread_send(thread, janet_wrap_table(janet_vm_registry), INFINITY)) {
|
||||
janet_panic("could not send registry to thread");
|
||||
}
|
||||
}
|
||||
|
||||
/* If thread started, send the worker function. */
|
||||
if (janet_thread_send(thread, argv[0], INFINITY)) {
|
||||
janet_panicf("could not send worker function %v to thread", argv[0]);
|
||||
@@ -594,6 +667,8 @@ static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
|
||||
break;
|
||||
case 1:
|
||||
janet_panicf("timeout after %f seconds", wait);
|
||||
case 2:
|
||||
janet_panicf("failed to receive message: %v", out);
|
||||
}
|
||||
return out;
|
||||
}
|
||||
@@ -605,6 +680,18 @@ static Janet cfun_thread_close(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_thread_exit(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_arity(argc, 0, 1);
|
||||
#if defined(JANET_WINDOWS)
|
||||
int32_t flag = janet_optinteger(argv, argc, 0, 0);
|
||||
ExitThread(flag);
|
||||
#else
|
||||
pthread_exit(NULL);
|
||||
#endif
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static const JanetMethod janet_thread_methods[] = {
|
||||
{"send", cfun_thread_send},
|
||||
{"close", cfun_thread_close},
|
||||
@@ -625,23 +712,30 @@ static const JanetReg threadlib_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"thread/new", cfun_thread_new,
|
||||
JDOC("(thread/new func &opt capacity)\n\n"
|
||||
JDOC("(thread/new func &opt capacity flags)\n\n"
|
||||
"Start a new thread that will start immediately. "
|
||||
"If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
|
||||
"The capacity must be between 1 and 65535 inclusive, and defaults to 10. "
|
||||
"Can optionally provide flags to the new thread - supported flags are:\n"
|
||||
"\t:h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n"
|
||||
"\t:a - Allow sending over registered abstract types to the new thread\n"
|
||||
"\t:c - Send over cfunction information to the new thread.\n"
|
||||
"Returns a handle to the new thread.")
|
||||
},
|
||||
{
|
||||
"thread/send", cfun_thread_send,
|
||||
JDOC("(thread/send thread msg)\n\n"
|
||||
"Send a message to the thread. This will never block and returns thread immediately. "
|
||||
JDOC("(thread/send thread msgi &opt timeout)\n\n"
|
||||
"Send a message to the thread. By default, the timeout is 1 second, but an optional timeout "
|
||||
"in seconds can be provided. Use math/inf for no timeout. "
|
||||
"Will throw an error if there is a problem sending the message.")
|
||||
},
|
||||
{
|
||||
"thread/receive", cfun_thread_receive,
|
||||
JDOC("(thread/receive &opt timeout)\n\n"
|
||||
"Get a message sent to this thread. If timeout is provided, an error will be thrown after the timeout has elapsed but "
|
||||
"no messages are received.")
|
||||
"Get a message sent to this thread. If timeout (in seconds) is provided, an error "
|
||||
"will be thrown after the timeout has elapsed but "
|
||||
"no messages are received. The default timeout is 1 second, and math/inf cam be passed to "
|
||||
"turn off the timeout.")
|
||||
},
|
||||
{
|
||||
"thread/close", cfun_thread_close,
|
||||
@@ -649,13 +743,19 @@ static const JanetReg threadlib_cfuns[] = {
|
||||
"Close a thread, unblocking it and ending communication with it. Note that closing "
|
||||
"a thread is idempotent and does not cancel the thread's operation. Returns nil.")
|
||||
},
|
||||
{
|
||||
"thread/exit", cfun_thread_exit,
|
||||
JDOC("(thread/exit &opt code)\n\n"
|
||||
"Exit from the current thread. If no more threads are running, ends the process, but otherwise does "
|
||||
"not end the current process.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_thread(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, threadlib_cfuns);
|
||||
janet_register_abstract_type(&Thread_AT);
|
||||
janet_register_abstract_type(&janet_thread_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -49,49 +49,10 @@ const Janet *janet_tuple_end(Janet *tuple) {
|
||||
/* Build a tuple with n values */
|
||||
const Janet *janet_tuple_n(const Janet *values, int32_t n) {
|
||||
Janet *t = janet_tuple_begin(n);
|
||||
memcpy(t, values, sizeof(Janet) * n);
|
||||
safe_memcpy(t, values, sizeof(Janet) * n);
|
||||
return janet_tuple_end(t);
|
||||
}
|
||||
|
||||
/* Check if two tuples are equal */
|
||||
int janet_tuple_equal(const Janet *lhs, const Janet *rhs) {
|
||||
int32_t index;
|
||||
int32_t llen = janet_tuple_length(lhs);
|
||||
int32_t rlen = janet_tuple_length(rhs);
|
||||
int32_t lhash = janet_tuple_hash(lhs);
|
||||
int32_t rhash = janet_tuple_hash(rhs);
|
||||
if (lhash == 0)
|
||||
lhash = janet_tuple_hash(lhs) = janet_array_calchash(lhs, llen);
|
||||
if (rhash == 0)
|
||||
rhash = janet_tuple_hash(rhs) = janet_array_calchash(rhs, rlen);
|
||||
if (lhash != rhash)
|
||||
return 0;
|
||||
if (llen != rlen)
|
||||
return 0;
|
||||
for (index = 0; index < llen; index++) {
|
||||
if (!janet_equals(lhs[index], rhs[index]))
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Compare tuples */
|
||||
int janet_tuple_compare(const Janet *lhs, const Janet *rhs) {
|
||||
int32_t i;
|
||||
int32_t llen = janet_tuple_length(lhs);
|
||||
int32_t rlen = janet_tuple_length(rhs);
|
||||
int32_t count = llen < rlen ? llen : rlen;
|
||||
for (i = 0; i < count; ++i) {
|
||||
int comp = janet_compare(lhs[i], rhs[i]);
|
||||
if (comp != 0) return comp;
|
||||
}
|
||||
if (llen < rlen)
|
||||
return -1;
|
||||
else if (llen > rlen)
|
||||
return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) {
|
||||
|
||||
@@ -111,7 +111,7 @@ static void *ta_buffer_unmarshal(JanetMarshalContext *ctx) {
|
||||
return buf;
|
||||
}
|
||||
|
||||
static const JanetAbstractType ta_buffer_type = {
|
||||
const JanetAbstractType janet_ta_buffer_type = {
|
||||
"ta/buffer",
|
||||
ta_buffer_gc,
|
||||
NULL,
|
||||
@@ -119,9 +119,7 @@ static const JanetAbstractType ta_buffer_type = {
|
||||
NULL,
|
||||
ta_buffer_marshal,
|
||||
ta_buffer_unmarshal,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
static int ta_mark(void *p, size_t s) {
|
||||
@@ -156,7 +154,7 @@ static void *ta_view_unmarshal(JanetMarshalContext *ctx) {
|
||||
offset = janet_unmarshal_size(ctx);
|
||||
buffer = janet_unmarshal_janet(ctx);
|
||||
if (!janet_checktype(buffer, JANET_ABSTRACT) ||
|
||||
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &ta_buffer_type)) {
|
||||
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &janet_ta_buffer_type)) {
|
||||
janet_panicf("expected typed array buffer");
|
||||
}
|
||||
view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
|
||||
@@ -277,7 +275,25 @@ static void ta_setter(void *p, Janet key, Janet value) {
|
||||
}
|
||||
}
|
||||
|
||||
static const JanetAbstractType ta_view_type = {
|
||||
static Janet ta_view_next(void *p, Janet key) {
|
||||
JanetTArrayView *view = p;
|
||||
if (janet_checktype(key, JANET_NIL)) {
|
||||
if (view->size > 0) {
|
||||
return janet_wrap_number(0);
|
||||
} else {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||
size_t index = (size_t) janet_unwrap_number(key);
|
||||
index++;
|
||||
if (index < view->size) {
|
||||
return janet_wrap_number((double) index);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_ta_view_type = {
|
||||
"ta/view",
|
||||
NULL,
|
||||
ta_mark,
|
||||
@@ -287,11 +303,13 @@ static const JanetAbstractType ta_view_type = {
|
||||
ta_view_unmarshal,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
NULL,
|
||||
ta_view_next,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
|
||||
JanetTArrayBuffer *buf = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
JanetTArrayBuffer *buf = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buf, size);
|
||||
return buf;
|
||||
}
|
||||
@@ -303,13 +321,13 @@ JanetTArrayView *janet_tarray_view(
|
||||
size_t offset,
|
||||
JanetTArrayBuffer *buffer) {
|
||||
|
||||
JanetTArrayView *view = janet_abstract(&ta_view_type, sizeof(JanetTArrayView));
|
||||
JanetTArrayView *view = janet_abstract(&janet_ta_view_type, sizeof(JanetTArrayView));
|
||||
|
||||
if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0");
|
||||
size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1);
|
||||
|
||||
if (NULL == buffer) {
|
||||
buffer = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buffer, buf_size);
|
||||
}
|
||||
|
||||
@@ -329,15 +347,15 @@ JanetTArrayView *janet_tarray_view(
|
||||
}
|
||||
|
||||
JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &ta_buffer_type);
|
||||
return janet_getabstract(argv, n, &janet_ta_buffer_type);
|
||||
}
|
||||
|
||||
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &ta_view_type);
|
||||
return janet_getabstract(argv, n, &janet_ta_view_type);
|
||||
}
|
||||
|
||||
JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
|
||||
JanetTArrayView *view = janet_getabstract(argv, n, &ta_view_type);
|
||||
JanetTArrayView *view = janet_getabstract(argv, n, &janet_ta_view_type);
|
||||
if (view->type != type) {
|
||||
janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
|
||||
n, ta_type_names[type], argv[n]);
|
||||
@@ -358,18 +376,29 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||
if (argc > 3)
|
||||
offset = janet_getsize(argv, 3);
|
||||
if (argc > 4) {
|
||||
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
}
|
||||
void *p = janet_unwrap_abstract(argv[4]);
|
||||
if (janet_abstract_type(p) == &ta_view_type) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
|
||||
stride *= view->stride;
|
||||
buffer = view->buffer;
|
||||
int32_t blen;
|
||||
const uint8_t *bytes;
|
||||
if (janet_bytes_view(argv[4], &bytes, &blen)) {
|
||||
buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buffer, (size_t) blen);
|
||||
memcpy(buffer->data, bytes, blen);
|
||||
} else {
|
||||
buffer = p;
|
||||
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
}
|
||||
void *p = janet_unwrap_abstract(argv[4]);
|
||||
if (janet_abstract_type(p) == &janet_ta_view_type) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
|
||||
stride *= view->stride;
|
||||
buffer = view->buffer;
|
||||
} else if (janet_abstract_type(p) == &janet_ta_buffer_type) {
|
||||
buffer = p;
|
||||
} else {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
}
|
||||
}
|
||||
}
|
||||
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
|
||||
@@ -379,7 +408,7 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||
static JanetTArrayView *ta_is_view(Janet x) {
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abst) != &ta_view_type) return NULL;
|
||||
if (janet_abstract_type(abst) != &janet_ta_view_type) return NULL;
|
||||
return (JanetTArrayView *)abst;
|
||||
}
|
||||
|
||||
@@ -400,7 +429,7 @@ static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
|
||||
if ((view = ta_is_view(argv[0]))) {
|
||||
return janet_wrap_number((double) view->size);
|
||||
}
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type);
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &janet_ta_buffer_type);
|
||||
return janet_wrap_number((double) buf->size);
|
||||
}
|
||||
|
||||
@@ -437,7 +466,7 @@ static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
|
||||
JanetRange range;
|
||||
int32_t length = (int32_t)src->size;
|
||||
if (argc == 1) {
|
||||
@@ -465,9 +494,9 @@ static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 4, 5);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
|
||||
size_t index_src = janet_getsize(argv, 1);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
|
||||
size_t index_dst = janet_getsize(argv, 3);
|
||||
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
|
||||
size_t src_atom_size = ta_type_sizes[src->type];
|
||||
@@ -492,9 +521,9 @@ static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 4, 5);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
|
||||
size_t index_src = janet_getsize(argv, 1);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
|
||||
size_t index_dst = janet_getsize(argv, 3);
|
||||
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
|
||||
size_t src_atom_size = ta_type_sizes[src->type];
|
||||
@@ -578,8 +607,8 @@ static JanetMethod tarray_view_methods[] = {
|
||||
/* Module entry point */
|
||||
void janet_lib_typed_array(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, ta_cfuns);
|
||||
janet_register_abstract_type(&ta_buffer_type);
|
||||
janet_register_abstract_type(&ta_view_type);
|
||||
janet_register_abstract_type(&janet_ta_buffer_type);
|
||||
janet_register_abstract_type(&janet_ta_view_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
174
src/core/util.c
174
src/core/util.c
@@ -26,6 +26,14 @@
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#else
|
||||
#include <unistd.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#include <fcntl.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#include <inttypes.h>
|
||||
@@ -94,7 +102,7 @@ const char *const janet_status_names[16] = {
|
||||
"alive"
|
||||
};
|
||||
|
||||
#ifdef JANET_NO_PRF
|
||||
#ifndef JANET_PRF
|
||||
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
const uint8_t *end = str + len;
|
||||
@@ -200,9 +208,9 @@ static uint32_t halfsiphash(const uint8_t *in, const size_t inlen, const uint8_t
|
||||
}
|
||||
/* end of siphash */
|
||||
|
||||
static uint8_t hash_key[16] = {0};
|
||||
static uint8_t hash_key[JANET_HASH_KEY_SIZE] = {0};
|
||||
|
||||
void janet_init_hash_key(uint8_t new_key[16]) {
|
||||
void janet_init_hash_key(uint8_t new_key[JANET_HASH_KEY_SIZE]) {
|
||||
memcpy(hash_key, new_key, sizeof(hash_key));
|
||||
}
|
||||
|
||||
@@ -248,6 +256,12 @@ int32_t janet_tablen(int32_t n) {
|
||||
return n + 1;
|
||||
}
|
||||
|
||||
/* Avoid some undefined behavior that was common in the code base. */
|
||||
void safe_memcpy(void *dest, const void *src, size_t len) {
|
||||
if (!len) return;
|
||||
memcpy(dest, src, len);
|
||||
}
|
||||
|
||||
/* Helper to find a value in a Janet struct or table. Returns the bucket
|
||||
* containing the key, or the first empty bucket if there is no such key. */
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
|
||||
@@ -374,7 +388,7 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
}
|
||||
|
||||
/* Load many cfunctions at once */
|
||||
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns, int defprefix) {
|
||||
uint8_t *longname_buffer = NULL;
|
||||
size_t prefixlen = 0;
|
||||
size_t bufsize = 0;
|
||||
@@ -385,7 +399,7 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
if (NULL == longname_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(longname_buffer, regprefix, prefixlen);
|
||||
safe_memcpy(longname_buffer, regprefix, prefixlen);
|
||||
longname_buffer[prefixlen] = '/';
|
||||
prefixlen++;
|
||||
}
|
||||
@@ -402,61 +416,52 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
memcpy(longname_buffer + prefixlen, cfuns->name, nmlen);
|
||||
safe_memcpy(longname_buffer + prefixlen, cfuns->name, nmlen);
|
||||
name = janet_wrap_symbol(janet_symbol(longname_buffer, totallen));
|
||||
} else {
|
||||
name = janet_csymbolv(cfuns->name);
|
||||
}
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
if (defprefix) {
|
||||
JanetTable *subt = janet_table(2);
|
||||
janet_table_put(subt, janet_ckeywordv("value"), fun);
|
||||
if (cfuns->documentation)
|
||||
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(cfuns->documentation));
|
||||
janet_table_put(env, name, janet_wrap_table(subt));
|
||||
} else {
|
||||
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
}
|
||||
janet_table_put(janet_vm_registry, fun, name);
|
||||
cfuns++;
|
||||
}
|
||||
free(longname_buffer);
|
||||
}
|
||||
|
||||
void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
_janet_cfuns_prefix(env, regprefix, cfuns, 1);
|
||||
}
|
||||
|
||||
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
_janet_cfuns_prefix(env, regprefix, cfuns, 0);
|
||||
}
|
||||
|
||||
/* Abstract type introspection */
|
||||
|
||||
static const JanetAbstractType type_wrap = {
|
||||
"core/type-info",
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
};
|
||||
|
||||
typedef struct {
|
||||
const JanetAbstractType *at;
|
||||
} JanetAbstractTypeWrap;
|
||||
|
||||
void janet_register_abstract_type(const JanetAbstractType *at) {
|
||||
JanetAbstractTypeWrap *abstract = (JanetAbstractTypeWrap *)
|
||||
janet_abstract(&type_wrap, sizeof(JanetAbstractTypeWrap));
|
||||
abstract->at = at;
|
||||
Janet sym = janet_csymbolv(at->name);
|
||||
if (!(janet_checktype(janet_table_get(janet_vm_registry, sym), JANET_NIL))) {
|
||||
if (!(janet_checktype(janet_table_get(janet_vm_abstract_registry, sym), JANET_NIL))) {
|
||||
janet_panicf("cannot register abstract type %s, "
|
||||
"a type with the same name exists", at->name);
|
||||
}
|
||||
janet_table_put(janet_vm_registry, sym, janet_wrap_abstract(abstract));
|
||||
janet_table_put(janet_vm_abstract_registry, sym, janet_wrap_pointer((void *) at));
|
||||
}
|
||||
|
||||
const JanetAbstractType *janet_get_abstract_type(Janet key) {
|
||||
Janet twrap = janet_table_get(janet_vm_registry, key);
|
||||
if (janet_checktype(twrap, JANET_NIL)) {
|
||||
Janet wrapped = janet_table_get(janet_vm_abstract_registry, key);
|
||||
if (janet_checktype(wrapped, JANET_NIL)) {
|
||||
return NULL;
|
||||
}
|
||||
if (!janet_checktype(twrap, JANET_ABSTRACT) ||
|
||||
(janet_abstract_type(janet_unwrap_abstract(twrap)) != &type_wrap)) {
|
||||
janet_panic("expected abstract type");
|
||||
}
|
||||
JanetAbstractTypeWrap *w = (JanetAbstractTypeWrap *)janet_unwrap_abstract(twrap);
|
||||
return w->at;
|
||||
return (JanetAbstractType *)(janet_unwrap_pointer(wrapped));
|
||||
}
|
||||
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
@@ -577,8 +582,12 @@ int janet_checksize(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return dval == (double)((size_t) dval) &&
|
||||
dval <= SIZE_MAX;
|
||||
if (dval != (double)((size_t) dval)) return 0;
|
||||
if (SIZE_MAX > JANET_INTMAX_INT64) {
|
||||
return dval <= JANET_INTMAX_INT64;
|
||||
} else {
|
||||
return dval <= SIZE_MAX;
|
||||
}
|
||||
}
|
||||
|
||||
JanetTable *janet_get_core_table(const char *name) {
|
||||
@@ -589,3 +598,90 @@ JanetTable *janet_get_core_table(const char *name) {
|
||||
if (!janet_checktype(out, JANET_TABLE)) return NULL;
|
||||
return janet_unwrap_table(out);
|
||||
}
|
||||
|
||||
/* Clock shims for various platforms */
|
||||
#ifdef JANET_GETTIME
|
||||
/* For macos */
|
||||
#ifdef __MACH__
|
||||
#include <mach/clock.h>
|
||||
#include <mach/mach.h>
|
||||
#endif
|
||||
#ifdef JANET_WINDOWS
|
||||
int janet_gettime(struct timespec *spec) {
|
||||
FILETIME ftime;
|
||||
GetSystemTimeAsFileTime(&ftime);
|
||||
int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
|
||||
/* Windows epoch is January 1, 1601 apparently */
|
||||
wintime -= 116444736000000000LL;
|
||||
spec->tv_sec = wintime / 10000000LL;
|
||||
/* Resolution is 100 nanoseconds. */
|
||||
spec->tv_nsec = wintime % 10000000LL * 100;
|
||||
return 0;
|
||||
}
|
||||
#elif defined(__MACH__)
|
||||
int janet_gettime(struct timespec *spec) {
|
||||
clock_serv_t cclock;
|
||||
mach_timespec_t mts;
|
||||
host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
|
||||
clock_get_time(cclock, &mts);
|
||||
mach_port_deallocate(mach_task_self(), cclock);
|
||||
spec->tv_sec = mts.tv_sec;
|
||||
spec->tv_nsec = mts.tv_nsec;
|
||||
return 0;
|
||||
}
|
||||
#else
|
||||
int janet_gettime(struct timespec *spec) {
|
||||
return clock_gettime(CLOCK_REALTIME, spec);
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Setting C99 standard makes this not available, but it should
|
||||
* work/link properly if we detect a BSD */
|
||||
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||
void arc4random_buf(void *buf, size_t nbytes);
|
||||
#endif
|
||||
|
||||
int janet_cryptorand(uint8_t *out, size_t n) {
|
||||
#ifdef JANET_WINDOWS
|
||||
for (size_t i = 0; i < n; i += sizeof(unsigned int)) {
|
||||
unsigned int v;
|
||||
if (rand_s(&v))
|
||||
return -1;
|
||||
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < n); j++) {
|
||||
out[i + j] = v & 0xff;
|
||||
v = v >> 8;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
|
||||
/* We should be able to call getrandom on linux, but it doesn't seem
|
||||
to be uniformly supported on linux distros.
|
||||
On Mac, arc4random_buf wasn't available on until 10.7.
|
||||
In these cases, use this fallback path for now... */
|
||||
int rc;
|
||||
int randfd;
|
||||
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
|
||||
if (randfd < 0)
|
||||
return -1;
|
||||
while (n > 0) {
|
||||
ssize_t nread;
|
||||
RETRY_EINTR(nread, read(randfd, out, n));
|
||||
if (nread <= 0) {
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
return -1;
|
||||
}
|
||||
out += nread;
|
||||
n -= nread;
|
||||
}
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
return 0;
|
||||
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||
arc4random_buf(out, n);
|
||||
return 0;
|
||||
#else
|
||||
(void) n;
|
||||
(void) out;
|
||||
return -1;
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -31,11 +31,16 @@
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
|
||||
#if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
|
||||
#include <time.h>
|
||||
#define JANET_GETTIME
|
||||
#endif
|
||||
|
||||
/* Handle runtime errors */
|
||||
#ifndef janet_exit
|
||||
#ifndef JANET_EXIT
|
||||
#include <stdio.h>
|
||||
#define janet_exit(m) do { \
|
||||
printf("C runtime error at line %d in file %s: %s\n",\
|
||||
#define JANET_EXIT(m) do { \
|
||||
fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\
|
||||
__LINE__,\
|
||||
__FILE__,\
|
||||
(m));\
|
||||
@@ -44,13 +49,13 @@
|
||||
#endif
|
||||
|
||||
#define janet_assert(c, m) do { \
|
||||
if (!(c)) janet_exit((m)); \
|
||||
if (!(c)) JANET_EXIT((m)); \
|
||||
} while (0)
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
||||
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
/* Omit docstrings in some builds */
|
||||
@@ -68,12 +73,13 @@ int32_t janet_array_calchash(const Janet *array, int32_t len);
|
||||
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len);
|
||||
int32_t janet_tablen(int32_t n);
|
||||
void safe_memcpy(void *dest, const void *src, size_t len);
|
||||
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
void janet_memempty(JanetKV *mem, int32_t count);
|
||||
void *janet_memalloc_empty(int32_t count);
|
||||
JanetTable *janet_get_core_table(const char *name);
|
||||
void janet_def_addflags(JanetFuncDef *def);
|
||||
const void *janet_strbinsearch(
|
||||
const void *tab,
|
||||
size_t tabcount,
|
||||
@@ -96,6 +102,13 @@ void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p);
|
||||
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||
#endif
|
||||
|
||||
/* Clock gettime */
|
||||
#ifdef JANET_GETTIME
|
||||
int janet_gettime(struct timespec *spec);
|
||||
#endif
|
||||
|
||||
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
||||
|
||||
/* Initialize builtin libraries */
|
||||
void janet_lib_io(JanetTable *env);
|
||||
void janet_lib_math(JanetTable *env);
|
||||
@@ -125,5 +138,12 @@ void janet_lib_inttypes(JanetTable *env);
|
||||
#ifdef JANET_THREADS
|
||||
void janet_lib_thread(JanetTable *env);
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
void janet_lib_net(JanetTable *env);
|
||||
#endif
|
||||
#ifdef JANET_EV
|
||||
void janet_lib_ev(JanetTable *env);
|
||||
void janet_ev_mark(void);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
285
src/core/value.c
285
src/core/value.c
@@ -22,13 +22,163 @@
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal = NULL;
|
||||
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top = NULL;
|
||||
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base = NULL;
|
||||
|
||||
static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
|
||||
JanetTraversalNode node;
|
||||
node.self = (JanetGCObject *) lhs;
|
||||
node.other = (JanetGCObject *) rhs;
|
||||
node.index = 0;
|
||||
node.index2 = index2;
|
||||
if (janet_vm_traversal + 1 >= janet_vm_traversal_top) {
|
||||
size_t oldsize = janet_vm_traversal - janet_vm_traversal_base;
|
||||
size_t newsize = 2 * oldsize + 1;
|
||||
if (newsize < 128) {
|
||||
newsize = 128;
|
||||
}
|
||||
JanetTraversalNode *tn = realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
|
||||
if (tn == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm_traversal_base = tn;
|
||||
janet_vm_traversal_top = janet_vm_traversal_base + newsize;
|
||||
janet_vm_traversal = janet_vm_traversal_base + oldsize;
|
||||
}
|
||||
*(++janet_vm_traversal) = node;
|
||||
}
|
||||
|
||||
/*
|
||||
* Used for travsersing structs and tuples without recursion
|
||||
* Returns:
|
||||
* 0 - next node found
|
||||
* 1 - early stop - lhs < rhs
|
||||
* 2 - no next node found
|
||||
* 3 - early stop - lhs > rhs
|
||||
*/
|
||||
static int traversal_next(Janet *x, Janet *y) {
|
||||
JanetTraversalNode *t = janet_vm_traversal;
|
||||
while (t && t > janet_vm_traversal_base) {
|
||||
JanetGCObject *self = t->self;
|
||||
JanetTupleHead *tself = (JanetTupleHead *)self;
|
||||
JanetStructHead *sself = (JanetStructHead *)self;
|
||||
JanetGCObject *other = t->other;
|
||||
JanetTupleHead *tother = (JanetTupleHead *)other;
|
||||
JanetStructHead *sother = (JanetStructHead *)other;
|
||||
if ((self->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_TUPLE) {
|
||||
/* Node is a tuple at index t->index */
|
||||
if (t->index < tself->length && t->index < tother->length) {
|
||||
int32_t index = t->index++;
|
||||
*x = tself->data[index];
|
||||
*y = tother->data[index];
|
||||
janet_vm_traversal = t;
|
||||
return 0;
|
||||
}
|
||||
if (t->index2 && tself->length != tother->length) {
|
||||
return tself->length > tother->length ? 3 : 1;
|
||||
}
|
||||
} else {
|
||||
/* Node is a struct at index t->index: if t->index2 is true, we should return the values. */
|
||||
if (t->index2) {
|
||||
t->index2 = 0;
|
||||
int32_t index = t->index++;
|
||||
*x = sself->data[index].value;
|
||||
*y = sother->data[index].value;
|
||||
janet_vm_traversal = t;
|
||||
return 0;
|
||||
}
|
||||
for (int32_t i = t->index; i < sself->capacity; i++) {
|
||||
t->index2 = 1;
|
||||
*x = sself->data[t->index].key;
|
||||
*y = sother->data[t->index].key;
|
||||
janet_vm_traversal = t;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
t--;
|
||||
}
|
||||
janet_vm_traversal = t;
|
||||
return 2;
|
||||
}
|
||||
|
||||
/*
|
||||
* Define a number of functions that can be used internally on ANY Janet.
|
||||
*/
|
||||
|
||||
Janet janet_next(Janet ds, Janet key) {
|
||||
JanetType t = janet_type(ds);
|
||||
switch (t) {
|
||||
default:
|
||||
janet_panicf("expected iterable type, got %v", ds);
|
||||
case JANET_TABLE:
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *start;
|
||||
int32_t cap;
|
||||
if (t == JANET_TABLE) {
|
||||
JanetTable *tab = janet_unwrap_table(ds);
|
||||
cap = tab->capacity;
|
||||
start = tab->data;
|
||||
} else {
|
||||
JanetStruct st = janet_unwrap_struct(ds);
|
||||
cap = janet_struct_capacity(st);
|
||||
start = st;
|
||||
}
|
||||
const JanetKV *end = start + cap;
|
||||
const JanetKV *kv = janet_checktype(key, JANET_NIL)
|
||||
? start
|
||||
: janet_dict_find(start, cap, key) + 1;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) return kv->key;
|
||||
kv++;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_KEYWORD:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_BUFFER:
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
int32_t i;
|
||||
if (janet_checktype(key, JANET_NIL)) {
|
||||
i = 0;
|
||||
} else if (janet_checkint(key)) {
|
||||
i = janet_unwrap_integer(key) + 1;
|
||||
} else {
|
||||
break;
|
||||
}
|
||||
int32_t len;
|
||||
if (t == JANET_BUFFER) {
|
||||
len = janet_unwrap_buffer(ds)->count;
|
||||
} else if (t == JANET_ARRAY) {
|
||||
len = janet_unwrap_array(ds)->count;
|
||||
} else if (t == JANET_TUPLE) {
|
||||
len = janet_tuple_length(janet_unwrap_tuple(ds));
|
||||
} else {
|
||||
len = janet_string_length(janet_unwrap_string(ds));
|
||||
}
|
||||
if (i < len && i >= 0) {
|
||||
return janet_wrap_integer(i);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
JanetAbstract abst = janet_unwrap_abstract(ds);
|
||||
const JanetAbstractType *at = janet_abstract_type(abst);
|
||||
if (NULL == at->next) break;
|
||||
return at->next(abst, key);
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Compare two abstract values */
|
||||
static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) {
|
||||
if (xx == yy) return 0;
|
||||
@@ -43,41 +193,51 @@ static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) {
|
||||
return xt->compare(xx, yy);
|
||||
}
|
||||
|
||||
/* Check if two values are equal. This is strict equality with no conversion. */
|
||||
int janet_equals(Janet x, Janet y) {
|
||||
int result = 0;
|
||||
if (janet_type(x) != janet_type(y)) {
|
||||
result = 0;
|
||||
} else {
|
||||
janet_vm_traversal = janet_vm_traversal_base;
|
||||
do {
|
||||
if (janet_type(x) != janet_type(y)) return 0;
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
result = 1;
|
||||
break;
|
||||
case JANET_BOOLEAN:
|
||||
result = (janet_unwrap_boolean(x) == janet_unwrap_boolean(y));
|
||||
if (janet_unwrap_boolean(x) != janet_unwrap_boolean(y)) return 0;
|
||||
break;
|
||||
case JANET_NUMBER:
|
||||
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
|
||||
if (janet_unwrap_number(x) != janet_unwrap_number(y)) return 0;
|
||||
break;
|
||||
case JANET_STRING:
|
||||
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||
break;
|
||||
case JANET_TUPLE:
|
||||
result = janet_tuple_equal(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y));
|
||||
if (!janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y))) return 0;
|
||||
break;
|
||||
case JANET_ABSTRACT:
|
||||
result = !janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
|
||||
if (janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y))) return 0;
|
||||
break;
|
||||
default:
|
||||
/* compare pointers */
|
||||
result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y));
|
||||
if (janet_unwrap_pointer(x) != janet_unwrap_pointer(y)) return 0;
|
||||
break;
|
||||
case JANET_TUPLE: {
|
||||
const Janet *t1 = janet_unwrap_tuple(x);
|
||||
const Janet *t2 = janet_unwrap_tuple(y);
|
||||
if (t1 == t2) break;
|
||||
if (janet_tuple_hash(t1) != janet_tuple_hash(t2)) return 0;
|
||||
if (janet_tuple_length(t1) != janet_tuple_length(t2)) return 0;
|
||||
push_traversal_node(janet_tuple_head(t1), janet_tuple_head(t2), 0);
|
||||
break;
|
||||
}
|
||||
break;
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *s1 = janet_unwrap_struct(x);
|
||||
const JanetKV *s2 = janet_unwrap_struct(y);
|
||||
if (s1 == s2) break;
|
||||
if (janet_struct_hash(s1) != janet_struct_hash(s2)) return 0;
|
||||
if (janet_struct_length(s1) != janet_struct_length(s2)) return 0;
|
||||
push_traversal_node(janet_struct_head(s1), janet_struct_head(s2), 0);
|
||||
break;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return result;
|
||||
} while (!traversal_next(&x, &y));
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Computes a hash value for a function */
|
||||
@@ -111,14 +271,12 @@ int32_t janet_hash(Janet x) {
|
||||
}
|
||||
/* fallthrough */
|
||||
default:
|
||||
/* TODO - test performance with different hash functions */
|
||||
if (sizeof(double) == sizeof(void *)) {
|
||||
/* Assuming 8 byte pointer */
|
||||
uint64_t i = janet_u64(x);
|
||||
hash = (int32_t)(i & 0xFFFFFFFF);
|
||||
/* Get a bit more entropy by shifting the low bits out */
|
||||
hash >>= 3;
|
||||
hash ^= (int32_t)(i >> 32);
|
||||
uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
|
||||
uint32_t hi = (uint32_t)(i >> 32);
|
||||
hash = (int32_t)(hi ^ (lo >> 3));
|
||||
} else {
|
||||
/* Assuming 4 byte pointer (or smaller) */
|
||||
hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0);
|
||||
@@ -133,38 +291,71 @@ int32_t janet_hash(Janet x) {
|
||||
* If y is less, returns 1. All types are comparable
|
||||
* and should have strict ordering, excepts NaNs. */
|
||||
int janet_compare(Janet x, Janet y) {
|
||||
if (janet_type(x) == janet_type(y)) {
|
||||
switch (janet_type(x)) {
|
||||
janet_vm_traversal = janet_vm_traversal_base;
|
||||
int status;
|
||||
do {
|
||||
JanetType tx = janet_type(x);
|
||||
JanetType ty = janet_type(y);
|
||||
if (tx != ty) return tx < ty ? -1 : 1;
|
||||
switch (tx) {
|
||||
case JANET_NIL:
|
||||
return 0;
|
||||
case JANET_BOOLEAN:
|
||||
return janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
|
||||
break;
|
||||
case JANET_BOOLEAN: {
|
||||
int diff = janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
|
||||
if (diff) return diff;
|
||||
break;
|
||||
}
|
||||
case JANET_NUMBER: {
|
||||
double xx = janet_unwrap_number(x);
|
||||
double yy = janet_unwrap_number(y);
|
||||
return xx == yy
|
||||
? 0
|
||||
: (xx < yy) ? -1 : 1;
|
||||
if (xx == yy) {
|
||||
break;
|
||||
} else {
|
||||
return (xx < yy) ? -1 : 1;
|
||||
}
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
return janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||
case JANET_TUPLE:
|
||||
return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
||||
case JANET_STRUCT:
|
||||
return janet_struct_compare(janet_unwrap_struct(x), janet_unwrap_struct(y));
|
||||
case JANET_ABSTRACT:
|
||||
return janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
|
||||
default:
|
||||
if (janet_unwrap_string(x) == janet_unwrap_string(y)) {
|
||||
return 0;
|
||||
case JANET_KEYWORD: {
|
||||
int diff = janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||
if (diff) return diff;
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
int diff = janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
|
||||
if (diff) return diff;
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
if (janet_unwrap_pointer(x) == janet_unwrap_pointer(y)) {
|
||||
break;
|
||||
} else {
|
||||
return janet_unwrap_string(x) > janet_unwrap_string(y) ? 1 : -1;
|
||||
return janet_unwrap_pointer(x) > janet_unwrap_pointer(y) ? 1 : -1;
|
||||
}
|
||||
}
|
||||
case JANET_TUPLE: {
|
||||
const Janet *lhs = janet_unwrap_tuple(x);
|
||||
const Janet *rhs = janet_unwrap_tuple(y);
|
||||
push_traversal_node(janet_tuple_head(lhs), janet_tuple_head(rhs), 1);
|
||||
break;
|
||||
}
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *lhs = janet_unwrap_struct(x);
|
||||
const JanetKV *rhs = janet_unwrap_struct(y);
|
||||
int32_t llen = janet_struct_capacity(lhs);
|
||||
int32_t rlen = janet_struct_capacity(rhs);
|
||||
int32_t lhash = janet_struct_hash(lhs);
|
||||
int32_t rhash = janet_struct_hash(rhs);
|
||||
if (llen < rlen) return -1;
|
||||
if (llen > rlen) return 1;
|
||||
if (lhash < rhash) return -1;
|
||||
if (lhash > rhash) return 1;
|
||||
push_traversal_node(janet_struct_head(lhs), janet_struct_head(rhs), 0);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
return (janet_type(x) < janet_type(y)) ? -1 : 1;
|
||||
} while (!(status = traversal_next(&x, &y)));
|
||||
return status - 2;
|
||||
}
|
||||
|
||||
static int32_t getter_checkint(Janet key, int32_t max) {
|
||||
|
||||
@@ -45,7 +45,7 @@ void *janet_v_flattenmem(void *v, int32_t itemsize) {
|
||||
size_t size = (size_t) itemsize * janet_v__cnt(v);
|
||||
p = malloc(size);
|
||||
if (NULL != p) {
|
||||
memcpy(p, v, size);
|
||||
safe_memcpy(p, v, size);
|
||||
return p;
|
||||
} else {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
|
||||
482
src/core/vm.c
482
src/core/vm.c
@@ -30,11 +30,16 @@
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <math.h>
|
||||
|
||||
/* VM state */
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
|
||||
JANET_THREAD_LOCAL int janet_vm_stackn = 0;
|
||||
JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL;
|
||||
JANET_THREAD_LOCAL JanetFiber *janet_vm_root_fiber = NULL;
|
||||
JANET_THREAD_LOCAL Janet *janet_vm_return_reg = NULL;
|
||||
JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
|
||||
@@ -86,7 +91,11 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
func = janet_stack_frame(stack)->func; \
|
||||
} while (0)
|
||||
#define vm_return(sig, val) do { \
|
||||
janet_vm_return_reg[0] = (val); \
|
||||
vm_commit(); \
|
||||
return (sig); \
|
||||
} while (0)
|
||||
#define vm_return_no_restore(sig, val) do { \
|
||||
janet_vm_return_reg[0] = (val); \
|
||||
return (sig); \
|
||||
} while (0)
|
||||
@@ -104,13 +113,13 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
#define vm_assert_type(X, T) do { \
|
||||
if (!(janet_checktype((X), (T)))) { \
|
||||
vm_commit(); \
|
||||
janet_panicf("expected %T, got %t", (1 << (T)), (X)); \
|
||||
janet_panicf("expected %T, got %v", (1 << (T)), (X)); \
|
||||
} \
|
||||
} while (0)
|
||||
#define vm_assert_types(X, TS) do { \
|
||||
if (!(janet_checktypes((X), (TS)))) { \
|
||||
vm_commit(); \
|
||||
janet_panicf("expected %T, got %t", (TS), (X)); \
|
||||
janet_panicf("expected %T, got %v", (TS), (X)); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
@@ -118,12 +127,11 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
#define vm_binop_immediate(op)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_pcnext();\
|
||||
vm_checkgc_pcnext();\
|
||||
} else {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
stack[A] = janet_wrap_number(x1 op CS);\
|
||||
@@ -133,10 +141,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
#define _vm_bitop_immediate(op, type1)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
stack[A] = janet_wrap_integer(x1 op CS);\
|
||||
vm_pcnext();\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_checkgc_pcnext();\
|
||||
} else {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
stack[A] = janet_wrap_integer(x1 op CS);\
|
||||
vm_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
|
||||
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
|
||||
@@ -144,17 +158,15 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, op2 };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_assert_type(op2, JANET_NUMBER);\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
double x2 = janet_unwrap_number(op2);\
|
||||
stack[A] = wrap(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
|
||||
@@ -162,12 +174,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
vm_assert_type(op2, JANET_NUMBER);\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
int32_t x2 = janet_unwrap_integer(op2);\
|
||||
stack[A] = janet_wrap_integer(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
int32_t x2 = janet_unwrap_integer(op2);\
|
||||
stack[A] = janet_wrap_integer(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop(op) _vm_bitop(op, int32_t)
|
||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
|
||||
@@ -175,53 +191,77 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
if (!janet_checktype(op1, JANET_NUMBER) || !janet_checktype(op2, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
double x2 = janet_unwrap_number(op2);\
|
||||
stack[A] = janet_wrap_boolean(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
|
||||
/* Trace a function call */
|
||||
static void vm_do_trace(JanetFunction *func) {
|
||||
Janet *stack = janet_vm_fiber->data + janet_vm_fiber->stackstart;
|
||||
int32_t start = janet_vm_fiber->stackstart;
|
||||
int32_t end = janet_vm_fiber->stacktop;
|
||||
int32_t argc = end - start;
|
||||
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
|
||||
if (func->def->name) {
|
||||
janet_printf("trace (%S", func->def->name);
|
||||
} else {
|
||||
janet_printf("trace (%p", janet_wrap_function(func));
|
||||
}
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
janet_printf(" %p", stack[i]);
|
||||
janet_printf(" %p", argv[i]);
|
||||
}
|
||||
printf(")\n");
|
||||
janet_printf(")\n");
|
||||
}
|
||||
|
||||
/* Call a non function type */
|
||||
/* Invoke a method once we have looked it up */
|
||||
static Janet janet_method_invoke(Janet method, int32_t argc, Janet *argv) {
|
||||
switch (janet_type(method)) {
|
||||
case JANET_CFUNCTION:
|
||||
return (janet_unwrap_cfunction(method))(argc, argv);
|
||||
case JANET_FUNCTION: {
|
||||
JanetFunction *fun = janet_unwrap_function(method);
|
||||
return janet_call(fun, argc, argv);
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
JanetAbstract abst = janet_unwrap_abstract(method);
|
||||
const JanetAbstractType *at = janet_abstract_type(abst);
|
||||
if (NULL != at->call) {
|
||||
return at->call(abst, argc, argv);
|
||||
}
|
||||
}
|
||||
/* fallthrough */
|
||||
case JANET_STRING:
|
||||
case JANET_BUFFER:
|
||||
case JANET_TABLE:
|
||||
case JANET_STRUCT:
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
if (argc != 1) {
|
||||
janet_panicf("%v called with %d arguments, possibly expected 1", method, argc);
|
||||
}
|
||||
return janet_in(method, argv[0]);
|
||||
}
|
||||
default: {
|
||||
if (argc != 1) {
|
||||
janet_panicf("%v called with %d arguments, possibly expected 1", method, argc);
|
||||
}
|
||||
return janet_in(argv[0], method);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Call a non function type from a JOP_CALL or JOP_TAILCALL instruction.
|
||||
* Assumes that the arguments are on the fiber stack. */
|
||||
static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||
int32_t argn = fiber->stacktop - fiber->stackstart;
|
||||
Janet ds, key;
|
||||
if (argn != 1) janet_panicf("%v called with %d arguments, possibly expected 1", callee, argn);
|
||||
if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY |
|
||||
JANET_TFLAG_STRING | JANET_TFLAG_BUFFER | JANET_TFLAG_ABSTRACT)) {
|
||||
ds = callee;
|
||||
key = fiber->data[fiber->stackstart];
|
||||
} else {
|
||||
ds = fiber->data[fiber->stackstart];
|
||||
key = callee;
|
||||
}
|
||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||
fiber->stacktop = fiber->stackstart;
|
||||
return janet_in(ds, key);
|
||||
return janet_method_invoke(callee, argc, fiber->data + fiber->stacktop);
|
||||
}
|
||||
|
||||
/* Get a callable from a keyword method name and check ensure that it is valid. */
|
||||
/* Get a callable from a keyword method name and ensure that it is valid. */
|
||||
static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||
if (argc < 1) janet_panicf("method call (%v) takes at least 1 argument, got 0", name);
|
||||
@@ -231,6 +271,35 @@ static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
||||
return callee;
|
||||
}
|
||||
|
||||
/* Lookup method on value x */
|
||||
static Janet janet_method_lookup(Janet x, const char *name) {
|
||||
Janet kname = janet_ckeywordv(name);
|
||||
return janet_get(x, kname);
|
||||
}
|
||||
|
||||
/* Call a method first on the righthand side, and then on the left hand side with a prefix */
|
||||
static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
|
||||
Janet lm = janet_method_lookup(lhs, lmethod);
|
||||
if (janet_checktype(lm, JANET_NIL)) {
|
||||
/* Invert order for rmethod */
|
||||
Janet lr = janet_method_lookup(rhs, rmethod);
|
||||
Janet argv[2] = { rhs, lhs };
|
||||
if (janet_checktype(lr, JANET_NIL)) {
|
||||
janet_panicf("could not find method :%s for %v, or :%s for %v",
|
||||
lmethod, lhs,
|
||||
rmethod, rhs);
|
||||
}
|
||||
return janet_method_invoke(lr, 2, argv);
|
||||
} else {
|
||||
Janet argv[2] = { lhs, rhs };
|
||||
return janet_method_invoke(lm, 2, argv);
|
||||
}
|
||||
}
|
||||
|
||||
/* Forward declaration */
|
||||
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out);
|
||||
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out);
|
||||
|
||||
/* Interpreter main loop */
|
||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
@@ -249,6 +318,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
&&label_JOP_MULTIPLY,
|
||||
&&label_JOP_DIVIDE_IMMEDIATE,
|
||||
&&label_JOP_DIVIDE,
|
||||
&&label_JOP_MODULO,
|
||||
&&label_JOP_REMAINDER,
|
||||
&&label_JOP_BAND,
|
||||
&&label_JOP_BOR,
|
||||
&&label_JOP_BXOR,
|
||||
@@ -264,6 +335,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
&&label_JOP_JUMP,
|
||||
&&label_JOP_JUMP_IF,
|
||||
&&label_JOP_JUMP_IF_NOT,
|
||||
&&label_JOP_JUMP_IF_NIL,
|
||||
&&label_JOP_JUMP_IF_NOT_NIL,
|
||||
&&label_JOP_GREATER_THAN,
|
||||
&&label_JOP_GREATER_THAN_IMMEDIATE,
|
||||
&&label_JOP_LESS_THAN,
|
||||
@@ -304,14 +377,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
&&label_JOP_MAKE_BRACKET_TUPLE,
|
||||
&&label_JOP_GREATER_THAN_EQUAL,
|
||||
&&label_JOP_LESS_THAN_EQUAL,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_JOP_NEXT,
|
||||
&&label_JOP_NOT_EQUALS,
|
||||
&&label_JOP_NOT_EQUALS_IMMEDIATE,
|
||||
&&label_JOP_CANCEL,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
@@ -499,6 +568,15 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
register Janet *stack;
|
||||
register uint32_t *pc;
|
||||
register JanetFunction *func;
|
||||
|
||||
if (fiber->flags & JANET_FIBER_RESUME_SIGNAL) {
|
||||
JanetSignal sig = (fiber->gc.flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
|
||||
fiber->gc.flags &= ~JANET_FIBER_STATUS_MASK;
|
||||
fiber->flags &= ~(JANET_FIBER_RESUME_SIGNAL | JANET_FIBER_FLAG_MASK);
|
||||
janet_vm_return_reg[0] = in;
|
||||
return sig;
|
||||
}
|
||||
|
||||
vm_restore();
|
||||
|
||||
if (fiber->flags & JANET_FIBER_DID_LONGJUMP) {
|
||||
@@ -549,7 +627,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
Janet retval = stack[D];
|
||||
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
|
||||
janet_fiber_popframe(fiber);
|
||||
if (entrance_frame) vm_return(JANET_SIGNAL_OK, retval);
|
||||
if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
|
||||
vm_restore();
|
||||
stack[A] = retval;
|
||||
vm_checkgc_pcnext();
|
||||
@@ -559,7 +637,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
Janet retval = janet_wrap_nil();
|
||||
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
|
||||
janet_fiber_popframe(fiber);
|
||||
if (entrance_frame) vm_return(JANET_SIGNAL_OK, retval);
|
||||
if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
|
||||
vm_restore();
|
||||
stack[A] = retval;
|
||||
vm_checkgc_pcnext();
|
||||
@@ -586,6 +664,37 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
VM_OP(JOP_DIVIDE)
|
||||
vm_binop( /);
|
||||
|
||||
VM_OP(JOP_MODULO) {
|
||||
Janet op1 = stack[B];
|
||||
Janet op2 = stack[C];
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
|
||||
double x1 = janet_unwrap_number(op1);
|
||||
double x2 = janet_unwrap_number(op2);
|
||||
double intres = x2 * floor(x1 / x2);
|
||||
stack[A] = janet_wrap_number(x1 - intres);
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
stack[A] = janet_binop_call("mod", "rmod", op1, op2);
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
}
|
||||
|
||||
VM_OP(JOP_REMAINDER) {
|
||||
Janet op1 = stack[B];
|
||||
Janet op2 = stack[C];
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
|
||||
double x1 = janet_unwrap_number(op1);
|
||||
double x2 = janet_unwrap_number(op2);
|
||||
stack[A] = janet_wrap_number(fmod(x1, x2));
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
stack[A] = janet_binop_call("%", "r%", op1, op2);
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
}
|
||||
|
||||
VM_OP(JOP_BAND)
|
||||
vm_bitop(&);
|
||||
|
||||
@@ -648,6 +757,22 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF_NIL)
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
pc += ES;
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF_NOT_NIL)
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
pc++;
|
||||
} else {
|
||||
pc += ES;
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_LESS_THAN)
|
||||
vm_compop( <);
|
||||
|
||||
@@ -676,10 +801,23 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) == CS);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NOT_EQUALS)
|
||||
stack[A] = janet_wrap_boolean(!janet_equals(stack[B], stack[C]));
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) != CS);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_COMPARE)
|
||||
stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NEXT)
|
||||
vm_commit();
|
||||
stack[A] = janet_next(stack[B], stack[C]);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_LOAD_NIL)
|
||||
stack[D] = janet_wrap_nil();
|
||||
vm_pcnext();
|
||||
@@ -714,7 +852,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_assert(func->def->environments_length > eindex, "invalid upvalue environment");
|
||||
env = func->envs[eindex];
|
||||
vm_assert(env->length > vindex, "invalid upvalue index");
|
||||
if (env->offset) {
|
||||
vm_assert(janet_env_valid(env), "invalid upvalue environment");
|
||||
if (env->offset > 0) {
|
||||
/* On stack */
|
||||
stack[A] = env->as.fiber->data[env->offset + vindex];
|
||||
} else {
|
||||
@@ -731,7 +870,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_assert(func->def->environments_length > eindex, "invalid upvalue environment");
|
||||
env = func->envs[eindex];
|
||||
vm_assert(env->length > vindex, "invalid upvalue index");
|
||||
if (env->offset) {
|
||||
vm_assert(janet_env_valid(env), "invalid upvalue environment");
|
||||
if (env->offset > 0) {
|
||||
env->as.fiber->data[env->offset + vindex] = stack[A];
|
||||
} else {
|
||||
env->as.values[vindex] = stack[A];
|
||||
@@ -794,7 +934,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (janet_indexed_view(stack[D], &vals, &len)) {
|
||||
janet_fiber_pushn(fiber, vals, len);
|
||||
} else {
|
||||
janet_panicf("expected %T, got %t", JANET_TFLAG_INDEXED, stack[D]);
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_INDEXED, stack[D]);
|
||||
}
|
||||
}
|
||||
stack = fiber->data + fiber->frame;
|
||||
@@ -811,7 +951,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
}
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
|
||||
}
|
||||
janet_stack_frame(stack)->pc = pc;
|
||||
if (janet_fiber_funcframe(fiber, func)) {
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
@@ -848,7 +990,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
}
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
|
||||
}
|
||||
if (janet_fiber_funcframe_tail(fiber, func)) {
|
||||
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
@@ -871,8 +1015,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
retreg = call_nonfn(fiber, callee);
|
||||
}
|
||||
janet_fiber_popframe(fiber);
|
||||
if (entrance_frame)
|
||||
vm_return(JANET_SIGNAL_OK, retreg);
|
||||
if (entrance_frame) {
|
||||
vm_return_no_restore(JANET_SIGNAL_OK, retreg);
|
||||
}
|
||||
vm_restore();
|
||||
stack[A] = retreg;
|
||||
vm_checkgc_pcnext();
|
||||
@@ -883,8 +1028,12 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
Janet retreg;
|
||||
vm_assert_type(stack[B], JANET_FIBER);
|
||||
JanetFiber *child = janet_unwrap_fiber(stack[B]);
|
||||
if (janet_check_can_resume(child, &retreg)) {
|
||||
vm_commit();
|
||||
janet_panicv(retreg);
|
||||
}
|
||||
fiber->child = child;
|
||||
JanetSignal sig = janet_continue(child, stack[C], &retreg);
|
||||
JanetSignal sig = janet_continue_no_check(child, stack[C], &retreg);
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
||||
vm_return(sig, retreg);
|
||||
}
|
||||
@@ -915,6 +1064,25 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_return((int) sub_status, stack[B]);
|
||||
}
|
||||
|
||||
VM_OP(JOP_CANCEL) {
|
||||
Janet retreg;
|
||||
vm_assert_type(stack[B], JANET_FIBER);
|
||||
JanetFiber *child = janet_unwrap_fiber(stack[B]);
|
||||
if (janet_check_can_resume(child, &retreg)) {
|
||||
vm_commit();
|
||||
janet_panicv(retreg);
|
||||
}
|
||||
fiber->child = child;
|
||||
JanetSignal sig = janet_continue_signal(child, stack[C], &retreg, JANET_SIGNAL_ERROR);
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
||||
vm_return(sig, retreg);
|
||||
}
|
||||
fiber->child = NULL;
|
||||
stack = fiber->data + fiber->frame;
|
||||
stack[A] = retreg;
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
|
||||
VM_OP(JOP_PUT)
|
||||
vm_commit();
|
||||
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
|
||||
@@ -1096,6 +1264,11 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
if (janet_vm_stackn >= JANET_RECURSION_GUARD)
|
||||
janet_panic("C stack recursed too deeply");
|
||||
|
||||
/* Tracing */
|
||||
if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(fun, argc, argv);
|
||||
}
|
||||
|
||||
/* Push frame */
|
||||
janet_fiber_pushn(janet_vm_fiber, argv, argc);
|
||||
if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
|
||||
@@ -1115,15 +1288,14 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
janet_vm_stackn = oldn;
|
||||
janet_gcunlock(handle);
|
||||
|
||||
if (signal != JANET_SIGNAL_OK) janet_panicv(*janet_vm_return_reg);
|
||||
if (signal != JANET_SIGNAL_OK) {
|
||||
janet_panicv(*janet_vm_return_reg);
|
||||
}
|
||||
|
||||
return *janet_vm_return_reg;
|
||||
}
|
||||
|
||||
/* Enter the main vm loop */
|
||||
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
jmp_buf buf;
|
||||
|
||||
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
|
||||
/* Check conditions */
|
||||
JanetFiberStatus old_status = janet_fiber_status(fiber);
|
||||
if (janet_vm_stackn >= JANET_RECURSION_GUARD) {
|
||||
@@ -1133,19 +1305,50 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
}
|
||||
if (old_status == JANET_STATUS_ALIVE ||
|
||||
old_status == JANET_STATUS_DEAD ||
|
||||
(old_status >= JANET_STATUS_USER0 && old_status <= JANET_STATUS_USER4) ||
|
||||
old_status == JANET_STATUS_ERROR) {
|
||||
const uint8_t *str = janet_formatc("cannot resume fiber with status :%s",
|
||||
janet_status_names[old_status]);
|
||||
*out = janet_wrap_string(str);
|
||||
return JANET_SIGNAL_ERROR;
|
||||
}
|
||||
return JANET_SIGNAL_OK;
|
||||
}
|
||||
|
||||
void janet_try_init(JanetTryState *state) {
|
||||
state->stackn = janet_vm_stackn++;
|
||||
state->gc_handle = janet_vm_gc_suspend;
|
||||
state->vm_fiber = janet_vm_fiber;
|
||||
state->vm_jmp_buf = janet_vm_jmp_buf;
|
||||
state->vm_return_reg = janet_vm_return_reg;
|
||||
janet_vm_return_reg = &(state->payload);
|
||||
janet_vm_jmp_buf = &(state->buf);
|
||||
}
|
||||
|
||||
void janet_restore(JanetTryState *state) {
|
||||
janet_vm_stackn = state->stackn;
|
||||
janet_vm_gc_suspend = state->gc_handle;
|
||||
janet_vm_fiber = state->vm_fiber;
|
||||
janet_vm_jmp_buf = state->vm_jmp_buf;
|
||||
janet_vm_return_reg = state->vm_return_reg;
|
||||
}
|
||||
|
||||
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
|
||||
JanetFiberStatus old_status = janet_fiber_status(fiber);
|
||||
|
||||
#ifdef JANET_EV
|
||||
janet_fiber_did_resume(fiber);
|
||||
#endif
|
||||
|
||||
/* Continue child fiber if it exists */
|
||||
if (fiber->child) {
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
JanetFiber *child = fiber->child;
|
||||
janet_vm_stackn++;
|
||||
JanetSignal sig = janet_continue(child, in, &in);
|
||||
janet_vm_stackn--;
|
||||
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
||||
*out = in;
|
||||
return sig;
|
||||
@@ -1153,48 +1356,63 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
fiber->child = NULL;
|
||||
}
|
||||
|
||||
/* Handle new fibers being resumed with a non-nil value */
|
||||
if (old_status == JANET_STATUS_NEW && !janet_checktype(in, JANET_NIL)) {
|
||||
Janet *stack = fiber->data + fiber->frame;
|
||||
JanetFunction *func = janet_stack_frame(stack)->func;
|
||||
if (func) {
|
||||
if (func->def->arity > 0) {
|
||||
stack[0] = in;
|
||||
} else if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||
stack[0] = janet_wrap_tuple(janet_tuple_n(&in, 1));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Save global state */
|
||||
int32_t oldn = janet_vm_stackn++;
|
||||
int handle = janet_vm_gc_suspend;
|
||||
JanetFiber *old_vm_fiber = janet_vm_fiber;
|
||||
jmp_buf *old_vm_jmp_buf = janet_vm_jmp_buf;
|
||||
Janet *old_vm_return_reg = janet_vm_return_reg;
|
||||
|
||||
/* Setup fiber */
|
||||
janet_vm_fiber = fiber;
|
||||
janet_gcroot(janet_wrap_fiber(fiber));
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
|
||||
janet_vm_return_reg = out;
|
||||
janet_vm_jmp_buf = &buf;
|
||||
|
||||
/* Run loop */
|
||||
JanetSignal signal;
|
||||
int jmpsig;
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
jmpsig = _setjmp(buf);
|
||||
#else
|
||||
jmpsig = setjmp(buf);
|
||||
#endif
|
||||
if (jmpsig) {
|
||||
signal = (JanetSignal) jmpsig;
|
||||
} else {
|
||||
JanetTryState tstate;
|
||||
JanetSignal signal = janet_try(&tstate);
|
||||
if (!signal) {
|
||||
/* Normal setup */
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
janet_vm_fiber = fiber;
|
||||
janet_gcroot(janet_wrap_fiber(fiber));
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
|
||||
signal = run_vm(fiber, in);
|
||||
}
|
||||
|
||||
/* Tear down fiber */
|
||||
/* Restore */
|
||||
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
|
||||
janet_fiber_set_status(fiber, signal);
|
||||
janet_gcunroot(janet_wrap_fiber(fiber));
|
||||
|
||||
/* Restore global state */
|
||||
janet_vm_gc_suspend = handle;
|
||||
janet_vm_fiber = old_vm_fiber;
|
||||
janet_vm_stackn = oldn;
|
||||
janet_vm_return_reg = old_vm_return_reg;
|
||||
janet_vm_jmp_buf = old_vm_jmp_buf;
|
||||
janet_restore(&tstate);
|
||||
*out = tstate.payload;
|
||||
|
||||
return signal;
|
||||
}
|
||||
|
||||
/* Enter the main vm loop */
|
||||
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
/* Check conditions */
|
||||
JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
|
||||
if (tmp_signal) return tmp_signal;
|
||||
return janet_continue_no_check(fiber, in, out);
|
||||
}
|
||||
|
||||
/* Enter the main vm loop but immediately raise a signal */
|
||||
JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig) {
|
||||
JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
|
||||
if (tmp_signal) return tmp_signal;
|
||||
if (sig != JANET_SIGNAL_OK) {
|
||||
JanetFiber *child = fiber;
|
||||
while (child->child) child = child->child;
|
||||
child->gc.flags &= ~JANET_FIBER_STATUS_MASK;
|
||||
child->gc.flags |= sig << JANET_FIBER_STATUS_OFFSET;
|
||||
child->flags |= JANET_FIBER_RESUME_SIGNAL;
|
||||
}
|
||||
return janet_continue_no_check(fiber, in, out);
|
||||
}
|
||||
|
||||
JanetSignal janet_pcall(
|
||||
JanetFunction *fun,
|
||||
int32_t argc,
|
||||
@@ -1219,30 +1437,12 @@ Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
|
||||
/* At least 1 argument */
|
||||
if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
|
||||
/* Find method */
|
||||
Janet method;
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT)) {
|
||||
void *abst = janet_unwrap_abstract(argv[0]);
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
|
||||
if (!type->get || !(type->get)(abst, janet_ckeywordv(name), &method))
|
||||
janet_panicf("abstract value %v does not implement :%s", argv[0], name);
|
||||
} else if (janet_checktype(argv[0], JANET_TABLE)) {
|
||||
JanetTable *table = janet_unwrap_table(argv[0]);
|
||||
method = janet_table_get(table, janet_ckeywordv(name));
|
||||
} else if (janet_checktype(argv[0], JANET_STRUCT)) {
|
||||
const JanetKV *st = janet_unwrap_struct(argv[0]);
|
||||
method = janet_struct_get(st, janet_ckeywordv(name));
|
||||
} else {
|
||||
Janet method = janet_method_lookup(argv[0], name);
|
||||
if (janet_checktype(method, JANET_NIL)) {
|
||||
janet_panicf("could not find method :%s for %v", name, argv[0]);
|
||||
}
|
||||
/* Invoke method */
|
||||
if (janet_checktype(method, JANET_CFUNCTION)) {
|
||||
return (janet_unwrap_cfunction(method))(argc, argv);
|
||||
} else if (janet_checktype(method, JANET_FUNCTION)) {
|
||||
JanetFunction *fun = janet_unwrap_function(method);
|
||||
return janet_call(fun, argc, argv);
|
||||
} else {
|
||||
janet_panicf("method %s has unexpected value %v", name, method);
|
||||
}
|
||||
return janet_method_invoke(method, argc, argv);
|
||||
}
|
||||
|
||||
/* Setup VM */
|
||||
@@ -1250,11 +1450,8 @@ int janet_init(void) {
|
||||
/* Garbage collection */
|
||||
janet_vm_blocks = NULL;
|
||||
janet_vm_next_collection = 0;
|
||||
/* Setting memoryInterval to zero forces
|
||||
* a collection pretty much every cycle, which is
|
||||
* incredibly horrible for performance, but can help ensure
|
||||
* there are no memory bugs during development */
|
||||
janet_vm_gc_interval = 0x10000;
|
||||
janet_vm_gc_interval = 0x400000;
|
||||
janet_vm_block_count = 0;
|
||||
janet_symcache_init();
|
||||
/* Initialize gc roots */
|
||||
janet_vm_roots = NULL;
|
||||
@@ -1266,14 +1463,32 @@ int janet_init(void) {
|
||||
janet_scratch_cap = 0;
|
||||
/* Initialize registry */
|
||||
janet_vm_registry = janet_table(0);
|
||||
janet_vm_abstract_registry = janet_table(0);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
||||
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
|
||||
/* Traversal */
|
||||
janet_vm_traversal = NULL;
|
||||
janet_vm_traversal_base = NULL;
|
||||
janet_vm_traversal_top = NULL;
|
||||
/* Core env */
|
||||
janet_vm_core_env = NULL;
|
||||
/* Dynamic bindings */
|
||||
janet_vm_top_dyns = NULL;
|
||||
/* Seed RNG */
|
||||
janet_rng_seed(janet_default_rng(), 0);
|
||||
/* Fibers */
|
||||
janet_vm_fiber = NULL;
|
||||
janet_vm_root_fiber = NULL;
|
||||
janet_vm_stackn = 0;
|
||||
/* Threads */
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_init();
|
||||
#endif
|
||||
#ifdef JANET_EV
|
||||
janet_ev_init();
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
janet_net_init();
|
||||
#endif
|
||||
return 0;
|
||||
}
|
||||
@@ -1287,8 +1502,19 @@ void janet_deinit(void) {
|
||||
janet_vm_root_count = 0;
|
||||
janet_vm_root_capacity = 0;
|
||||
janet_vm_registry = NULL;
|
||||
janet_vm_abstract_registry = NULL;
|
||||
janet_vm_core_env = NULL;
|
||||
janet_vm_top_dyns = NULL;
|
||||
free(janet_vm_traversal_base);
|
||||
janet_vm_fiber = NULL;
|
||||
janet_vm_root_fiber = NULL;
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_deinit();
|
||||
#endif
|
||||
#ifdef JANET_EV
|
||||
janet_ev_deinit();
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
janet_net_deinit();
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -27,6 +27,12 @@
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
/* Variable length arrays are ok */
|
||||
#ifdef _MSC_VER
|
||||
#pragma warning( push )
|
||||
#pragma warning( disable : 4200 )
|
||||
#endif
|
||||
|
||||
/***** START SECTION CONFIG *****/
|
||||
|
||||
#include "janetconf.h"
|
||||
@@ -97,7 +103,14 @@ extern "C" {
|
||||
#endif
|
||||
|
||||
/* Check big endian */
|
||||
#if defined(__MIPSEB__) /* MIPS 32-bit */ \
|
||||
#if defined(__LITTLE_ENDIAN__) || \
|
||||
(defined(__BYTE_ORDER__) && (__BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__))
|
||||
/* If we know the target is LE, always use that - e.g. ppc64 little endian
|
||||
* defines the __LITTLE_ENDIAN__ macro in the ABI spec, so we can rely
|
||||
* on that and if that's not defined, fall back to big endian assumption
|
||||
*/
|
||||
#define JANET_LITTLE_ENDIAN 1
|
||||
#elif defined(__MIPSEB__) /* MIPS 32-bit */ \
|
||||
|| defined(__ppc__) || defined(__PPC__) /* CPU(PPC) - PowerPC 32-bit */ \
|
||||
|| defined(__powerpc__) || defined(__powerpc) || defined(__POWERPC__) \
|
||||
|| defined(_M_PPC) || defined(__PPC) \
|
||||
@@ -114,9 +127,21 @@ extern "C" {
|
||||
#define JANET_LITTLE_ENDIAN 1
|
||||
#endif
|
||||
|
||||
/* Limits for converting doubles to 64 bit integers */
|
||||
#define JANET_INTMAX_DOUBLE 9007199254740992.0
|
||||
#define JANET_INTMIN_DOUBLE (-9007199254740992.0)
|
||||
#define JANET_INTMAX_INT64 9007199254740992
|
||||
#define JANET_INTMIN_INT64 (-9007199254740992)
|
||||
|
||||
/* Check emscripten */
|
||||
#ifdef __EMSCRIPTEN__
|
||||
#define JANET_NO_DYNAMIC_MODULES
|
||||
#define JANET_NO_PROCESSES
|
||||
#endif
|
||||
|
||||
/* Check sun */
|
||||
#ifdef __sun
|
||||
#define JANET_NO_UTC_MKTIME
|
||||
#endif
|
||||
|
||||
/* Define how global janet state is declared */
|
||||
@@ -152,6 +177,16 @@ extern "C" {
|
||||
#define JANET_TYPED_ARRAY
|
||||
#endif
|
||||
|
||||
/* Enable or disable event loop */
|
||||
#if !defined(JANET_NO_EV) && !defined(__EMSCRIPTEN__)
|
||||
#define JANET_EV
|
||||
#endif
|
||||
|
||||
/* Enable or disable networking */
|
||||
#if defined(JANET_EV) && !defined(JANET_NO_NET) && !defined(__EMSCRIPTEN__)
|
||||
#define JANET_NET
|
||||
#endif
|
||||
|
||||
/* Enable or disable large int types (for now 64 bit, maybe 128 / 256 bit integer types) */
|
||||
#ifndef JANET_NO_INT_TYPES
|
||||
#define JANET_INT_TYPES
|
||||
@@ -171,7 +206,7 @@ extern "C" {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define JANET_NO_RETURN __declspec(noreturn)
|
||||
#else
|
||||
#define JANET_NO_RETURN __attribute__ ((noreturn))
|
||||
#define JANET_NO_RETURN __attribute__((noreturn))
|
||||
#endif
|
||||
#endif
|
||||
|
||||
@@ -195,6 +230,11 @@ extern "C" {
|
||||
* To turn of nanboxing, for debugging purposes or for certain
|
||||
* architectures (Nanboxing only tested on x86 and x64), comment out
|
||||
* the JANET_NANBOX define.*/
|
||||
|
||||
#if defined(_M_ARM64) || defined(_M_ARM) || defined(__aarch64__)
|
||||
#define JANET_NO_NANBOX
|
||||
#endif
|
||||
|
||||
#ifndef JANET_NO_NANBOX
|
||||
#ifdef JANET_32
|
||||
#define JANET_NANBOX_32
|
||||
@@ -232,11 +272,22 @@ typedef struct {
|
||||
} JanetBuildConfig;
|
||||
|
||||
/* Get config of current compilation unit. */
|
||||
#ifdef __cplusplus
|
||||
/* C++11 syntax */
|
||||
#define janet_config_current() (JanetBuildConfig { \
|
||||
JANET_VERSION_MAJOR, \
|
||||
JANET_VERSION_MINOR, \
|
||||
JANET_VERSION_PATCH, \
|
||||
JANET_CURRENT_CONFIG_BITS })
|
||||
#else
|
||||
/* C99 syntax */
|
||||
#define janet_config_current() ((JanetBuildConfig){ \
|
||||
JANET_VERSION_MAJOR, \
|
||||
JANET_VERSION_MINOR, \
|
||||
JANET_VERSION_PATCH, \
|
||||
JANET_CURRENT_CONFIG_BITS })
|
||||
#endif
|
||||
|
||||
|
||||
/***** END SECTION CONFIG *****/
|
||||
|
||||
@@ -264,6 +315,15 @@ JANET_API extern const char *const janet_type_names[16];
|
||||
JANET_API extern const char *const janet_signal_names[14];
|
||||
JANET_API extern const char *const janet_status_names[16];
|
||||
|
||||
/* For various IO routines, we want to use an int on posix and HANDLE on windows */
|
||||
#ifdef JANET_WINDOWS
|
||||
typedef void *JanetHandle;
|
||||
#define JANET_HANDLE_NONE NULL
|
||||
#else
|
||||
typedef int JanetHandle;
|
||||
#define JANET_HANDLE_NONE (-1)
|
||||
#endif
|
||||
|
||||
/* Fiber signals */
|
||||
typedef enum {
|
||||
JANET_SIGNAL_OK,
|
||||
@@ -282,6 +342,8 @@ typedef enum {
|
||||
JANET_SIGNAL_USER9
|
||||
} JanetSignal;
|
||||
|
||||
#define JANET_SIGNAL_EVENT JANET_SIGNAL_USER9
|
||||
|
||||
/* Fiber statuses - mostly corresponds to signals. */
|
||||
typedef enum {
|
||||
JANET_STATUS_DEAD,
|
||||
@@ -302,14 +364,6 @@ typedef enum {
|
||||
JANET_STATUS_ALIVE
|
||||
} JanetFiberStatus;
|
||||
|
||||
#ifdef JANET_NANBOX_64
|
||||
typedef union Janet Janet;
|
||||
#elif defined(JANET_NANBOX_32)
|
||||
typedef union Janet Janet;
|
||||
#else
|
||||
typedef struct Janet Janet;
|
||||
#endif
|
||||
|
||||
/* Use type punning for GC objects */
|
||||
typedef struct JanetGCObject JanetGCObject;
|
||||
|
||||
@@ -340,15 +394,6 @@ typedef struct JanetByteView JanetByteView;
|
||||
typedef struct JanetDictView JanetDictView;
|
||||
typedef struct JanetRange JanetRange;
|
||||
typedef struct JanetRNG JanetRNG;
|
||||
typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
|
||||
|
||||
/* String and other aliased pointer types */
|
||||
typedef const uint8_t *JanetString;
|
||||
typedef const uint8_t *JanetSymbol;
|
||||
typedef const uint8_t *JanetKeyword;
|
||||
typedef const Janet *JanetTuple;
|
||||
typedef const JanetKV *JanetStruct;
|
||||
typedef void *JanetAbstract;
|
||||
|
||||
/* Basic types for all Janet Values */
|
||||
typedef enum JanetType {
|
||||
@@ -370,6 +415,61 @@ typedef enum JanetType {
|
||||
JANET_POINTER
|
||||
} JanetType;
|
||||
|
||||
/* Recursive type (Janet) */
|
||||
#ifdef JANET_NANBOX_64
|
||||
typedef union Janet Janet;
|
||||
union Janet {
|
||||
uint64_t u64;
|
||||
int64_t i64;
|
||||
double number;
|
||||
void *pointer;
|
||||
};
|
||||
#elif defined(JANET_NANBOX_32)
|
||||
typedef union Janet Janet;
|
||||
union Janet {
|
||||
struct {
|
||||
#ifdef JANET_BIG_ENDIAN
|
||||
uint32_t type;
|
||||
union {
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
} payload;
|
||||
#else
|
||||
union {
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
} payload;
|
||||
uint32_t type;
|
||||
#endif
|
||||
} tagged;
|
||||
double number;
|
||||
uint64_t u64;
|
||||
};
|
||||
#else
|
||||
typedef struct Janet Janet;
|
||||
struct Janet {
|
||||
union {
|
||||
uint64_t u64;
|
||||
double number;
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
const void *cpointer;
|
||||
} as;
|
||||
JanetType type;
|
||||
};
|
||||
#endif
|
||||
|
||||
/* C functions */
|
||||
typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
|
||||
|
||||
/* String and other aliased pointer types */
|
||||
typedef const uint8_t *JanetString;
|
||||
typedef const uint8_t *JanetSymbol;
|
||||
typedef const uint8_t *JanetKeyword;
|
||||
typedef const Janet *JanetTuple;
|
||||
typedef const JanetKV *JanetStruct;
|
||||
typedef void *JanetAbstract;
|
||||
|
||||
#define JANET_COUNT_TYPES (JANET_POINTER + 1)
|
||||
|
||||
/* Type flags */
|
||||
@@ -397,6 +497,62 @@ typedef enum JanetType {
|
||||
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION | \
|
||||
JANET_TFLAG_LENGTHABLE | JANET_TFLAG_ABSTRACT)
|
||||
|
||||
/* Event Loop Types */
|
||||
#ifdef JANET_EV
|
||||
#define JANET_POLL_FLAG_CLOSED 0x1
|
||||
#define JANET_POLL_FLAG_SOCKET 0x2
|
||||
|
||||
typedef enum {
|
||||
JANET_ASYNC_EVENT_INIT,
|
||||
JANET_ASYNC_EVENT_MARK,
|
||||
JANET_ASYNC_EVENT_DEINIT,
|
||||
JANET_ASYNC_EVENT_CLOSE,
|
||||
JANET_ASYNC_EVENT_READ,
|
||||
JANET_ASYNC_EVENT_WRITE,
|
||||
JANET_ASYNC_EVENT_TIMEOUT,
|
||||
JANET_ASYNC_EVENT_COMPLETE /* Used on windows for IOCP */
|
||||
} JanetAsyncEvent;
|
||||
|
||||
#define JANET_ASYNC_LISTEN_READ (1 << JANET_ASYNC_EVENT_READ)
|
||||
#define JANET_ASYNC_LISTEN_WRITE (1 << JANET_ASYNC_EVENT_WRITE)
|
||||
#define JANET_ASYNC_LISTEN_SPAWNER 0x1000
|
||||
|
||||
typedef enum {
|
||||
JANET_ASYNC_STATUS_NOT_DONE,
|
||||
JANET_ASYNC_STATUS_DONE
|
||||
} JanetAsyncStatus;
|
||||
|
||||
/* Typedefs */
|
||||
typedef struct JanetListenerState JanetListenerState;
|
||||
typedef struct JanetPollable JanetPollable;
|
||||
typedef JanetAsyncStatus(*JanetListener)(JanetListenerState *state, JanetAsyncEvent event);
|
||||
|
||||
/* Wrapper around file descriptors and HANDLEs that can be polled. */
|
||||
struct JanetPollable {
|
||||
JanetHandle handle;
|
||||
uint32_t flags;
|
||||
/* Linked list of all in-flight IO routines for this pollable */
|
||||
JanetListenerState *state;
|
||||
/* internal - used to disallow multiple concurrent reads / writes on the same pollable.
|
||||
* this constraint may be lifted later but allowing such would require more internal book keeping
|
||||
* for some implementations. You can read and write at the same time on the same pollable, though. */
|
||||
int _mask;
|
||||
};
|
||||
|
||||
/* Interface for state machine based event loop */
|
||||
struct JanetListenerState {
|
||||
JanetListener machine;
|
||||
JanetFiber *fiber;
|
||||
JanetPollable *pollable;
|
||||
void *event; /* Used to pass data from asynchronous IO event. Contents depend on both
|
||||
implementation of the event loop and the particular event. */
|
||||
/* internal */
|
||||
int _index; /* not used in all implementations */
|
||||
int _mask;
|
||||
JanetListenerState *_next;
|
||||
};
|
||||
#endif
|
||||
|
||||
/* We provide three possible implementations of Janets. The preferred
|
||||
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
|
||||
* application must interact through exposed interface. */
|
||||
@@ -478,13 +634,6 @@ JANET_API Janet janet_wrap_integer(int32_t x);
|
||||
|
||||
#include <math.h>
|
||||
|
||||
/* 64 Nanboxed Janet value */
|
||||
union Janet {
|
||||
uint64_t u64;
|
||||
int64_t i64;
|
||||
double number;
|
||||
void *pointer;
|
||||
};
|
||||
#define janet_u64(x) ((x).u64)
|
||||
|
||||
#define JANET_NANBOX_TAGBITS 0xFFFF800000000000llu
|
||||
@@ -493,14 +642,14 @@ union Janet {
|
||||
#define janet_nanbox_tag(type) (janet_nanbox_lowtag(type) << 47)
|
||||
#define janet_type(x) \
|
||||
(isnan((x).number) \
|
||||
? (((x).u64 >> 47) & 0xF) \
|
||||
? (JanetType) (((x).u64 >> 47) & 0xF) \
|
||||
: JANET_NUMBER)
|
||||
|
||||
#define janet_nanbox_checkauxtype(x, type) \
|
||||
(((x).u64 & JANET_NANBOX_TAGBITS) == janet_nanbox_tag((type)))
|
||||
|
||||
#define janet_nanbox_isnumber(x) \
|
||||
(!isnan((x).number) || janet_nanbox_checkauxtype((x), JANET_NUMBER))
|
||||
(!isnan((x).number) || ((((x).u64 >> 47) & 0xF) == JANET_NUMBER))
|
||||
|
||||
#define janet_checktype(x, t) \
|
||||
(((t) == JANET_NUMBER) \
|
||||
@@ -569,31 +718,10 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
|
||||
#elif defined(JANET_NANBOX_32)
|
||||
|
||||
/* 32 bit nanboxed janet */
|
||||
union Janet {
|
||||
struct {
|
||||
#ifdef JANET_BIG_ENDIAN
|
||||
uint32_t type;
|
||||
union {
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
} payload;
|
||||
#else
|
||||
union {
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
} payload;
|
||||
uint32_t type;
|
||||
#endif
|
||||
} tagged;
|
||||
double number;
|
||||
uint64_t u64;
|
||||
};
|
||||
|
||||
#define JANET_DOUBLE_OFFSET 0xFFFF
|
||||
|
||||
#define janet_u64(x) ((x).u64)
|
||||
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (x).tagged.type : JANET_NUMBER)
|
||||
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (JanetType)((x).tagged.type) : JANET_NUMBER)
|
||||
#define janet_checktype(x, t) ((t) == JANET_NUMBER \
|
||||
? (x).tagged.type >= JANET_DOUBLE_OFFSET \
|
||||
: (x).tagged.type == (t))
|
||||
@@ -640,23 +768,11 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
|
||||
#else
|
||||
|
||||
/* A general janet value type for more standard C */
|
||||
struct Janet {
|
||||
union {
|
||||
uint64_t u64;
|
||||
double number;
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
const void *cpointer;
|
||||
} as;
|
||||
JanetType type;
|
||||
};
|
||||
|
||||
#define janet_u64(x) ((x).as.u64)
|
||||
#define janet_type(x) ((x).type)
|
||||
#define janet_checktype(x, t) ((x).type == (t))
|
||||
#define janet_truthy(x) \
|
||||
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.integer & 0x1)))
|
||||
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1)))
|
||||
|
||||
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
|
||||
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
|
||||
@@ -681,8 +797,8 @@ JANET_API int janet_checkint(Janet x);
|
||||
JANET_API int janet_checkint64(Janet x);
|
||||
JANET_API int janet_checksize(Janet x);
|
||||
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
|
||||
#define janet_checkintrange(x) ((x) == (int32_t)(x))
|
||||
#define janet_checkint64range(x) ((x) == (int64_t)(x))
|
||||
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
|
||||
#define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
|
||||
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
|
||||
|
||||
@@ -704,11 +820,16 @@ struct JanetFiber {
|
||||
int32_t frame; /* Index of the stack frame */
|
||||
int32_t stackstart; /* Beginning of next args */
|
||||
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
|
||||
int32_t capacity;
|
||||
int32_t capacity; /* How big is the stack memory */
|
||||
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
|
||||
JanetTable *env; /* Dynamic bindings table (usually current environment). */
|
||||
Janet *data;
|
||||
Janet *data; /* Dynamically resized stack memory */
|
||||
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
|
||||
#ifdef JANET_EV
|
||||
JanetListenerState *waiting;
|
||||
int32_t timeout_index;
|
||||
uint32_t sched_id; /* Increment everytime fiber is scheduled by event loop */
|
||||
#endif
|
||||
};
|
||||
|
||||
/* Mark if a stack frame is a tail call for debugging */
|
||||
@@ -726,8 +847,9 @@ struct JanetStackFrame {
|
||||
int32_t flags;
|
||||
};
|
||||
|
||||
/* Number of Janets a frame takes up in the stack */
|
||||
#define JANET_FRAME_SIZE ((sizeof(JanetStackFrame) + sizeof(Janet) - 1) / sizeof(Janet))
|
||||
/* Number of Janets a frame takes up in the stack
|
||||
* Should be constant across architectures */
|
||||
#define JANET_FRAME_SIZE 4
|
||||
|
||||
/* A dynamic array type. */
|
||||
struct JanetArray {
|
||||
@@ -805,6 +927,7 @@ struct JanetAbstractHead {
|
||||
#define JANET_FUNCDEF_FLAG_HASENVS 0x400000
|
||||
#define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
|
||||
#define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000
|
||||
#define JANET_FUNCDEF_FLAG_HASCLOBITSET 0x2000000
|
||||
#define JANET_FUNCDEF_FLAG_TAG 0xFFFF
|
||||
|
||||
/* Source mapping structure for a bytecode instruction */
|
||||
@@ -820,6 +943,7 @@ struct JanetFuncDef {
|
||||
Janet *constants;
|
||||
JanetFuncDef **defs;
|
||||
uint32_t *bytecode;
|
||||
uint32_t *closure_bitset; /* Bit set indicating which slots can be referenced by closures. */
|
||||
|
||||
/* Various debug information */
|
||||
JanetSourceMapping *sourcemap;
|
||||
@@ -887,8 +1011,9 @@ struct JanetParser {
|
||||
int flag;
|
||||
};
|
||||
|
||||
/* A context for marshaling and unmarshaling abstract types */
|
||||
typedef struct {
|
||||
void *m_state; /* void* to not expose MarshalState ?*/
|
||||
void *m_state;
|
||||
void *u_state;
|
||||
int flags;
|
||||
const uint8_t *data;
|
||||
@@ -907,8 +1032,27 @@ struct JanetAbstractType {
|
||||
void (*tostring)(void *p, JanetBuffer *buffer);
|
||||
int (*compare)(void *lhs, void *rhs);
|
||||
int32_t (*hash)(void *p, size_t len);
|
||||
Janet(*next)(void *p, Janet key);
|
||||
Janet(*call)(void *p, int32_t argc, Janet *argv);
|
||||
};
|
||||
|
||||
/* Some macros to let us add extra types to JanetAbstract types without
|
||||
* needing to changing native modules that declare them as static const
|
||||
* structures. If more fields are added, these macros are modified to include
|
||||
* default values (usually NULL). This silences missing field warnings. */
|
||||
#define JANET_ATEND_NAME NULL,JANET_ATEND_GC
|
||||
#define JANET_ATEND_GC NULL,JANET_ATEND_GCMARK
|
||||
#define JANET_ATEND_GCMARK NULL,JANET_ATEND_GET
|
||||
#define JANET_ATEND_GET NULL,JANET_ATEND_PUT
|
||||
#define JANET_ATEND_PUT NULL,JANET_ATEND_MARSHAL
|
||||
#define JANET_ATEND_MARSHAL NULL,JANET_ATEND_UNMARSHAL
|
||||
#define JANET_ATEND_UNMARSHAL NULL,JANET_ATEND_TOSTRING
|
||||
#define JANET_ATEND_TOSTRING NULL,JANET_ATEND_COMPARE
|
||||
#define JANET_ATEND_COMPARE NULL,JANET_ATEND_HASH
|
||||
#define JANET_ATEND_HASH NULL,JANET_ATEND_NEXT
|
||||
#define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL
|
||||
#define JANET_ATEND_CALL
|
||||
|
||||
struct JanetReg {
|
||||
const char *name;
|
||||
JanetCFunction cfun;
|
||||
@@ -946,6 +1090,25 @@ struct JanetRNG {
|
||||
uint32_t counter;
|
||||
};
|
||||
|
||||
typedef struct JanetFile JanetFile;
|
||||
struct JanetFile {
|
||||
FILE *file;
|
||||
int32_t flags;
|
||||
};
|
||||
|
||||
/* For janet_try and janet_restore */
|
||||
typedef struct {
|
||||
/* old state */
|
||||
int32_t stackn;
|
||||
int gc_handle;
|
||||
JanetFiber *vm_fiber;
|
||||
jmp_buf *vm_jmp_buf;
|
||||
Janet *vm_return_reg;
|
||||
/* new state */
|
||||
jmp_buf buf;
|
||||
Janet payload;
|
||||
} JanetTryState;
|
||||
|
||||
/* Thread types */
|
||||
#ifdef JANET_THREADS
|
||||
typedef struct JanetThread JanetThread;
|
||||
@@ -1005,6 +1168,8 @@ enum JanetOpCode {
|
||||
JOP_MULTIPLY,
|
||||
JOP_DIVIDE_IMMEDIATE,
|
||||
JOP_DIVIDE,
|
||||
JOP_MODULO,
|
||||
JOP_REMAINDER,
|
||||
JOP_BAND,
|
||||
JOP_BOR,
|
||||
JOP_BXOR,
|
||||
@@ -1020,6 +1185,8 @@ enum JanetOpCode {
|
||||
JOP_JUMP,
|
||||
JOP_JUMP_IF,
|
||||
JOP_JUMP_IF_NOT,
|
||||
JOP_JUMP_IF_NIL,
|
||||
JOP_JUMP_IF_NOT_NIL,
|
||||
JOP_GREATER_THAN,
|
||||
JOP_GREATER_THAN_IMMEDIATE,
|
||||
JOP_LESS_THAN,
|
||||
@@ -1060,6 +1227,10 @@ enum JanetOpCode {
|
||||
JOP_MAKE_BRACKET_TUPLE,
|
||||
JOP_GREATER_THAN_EQUAL,
|
||||
JOP_LESS_THAN_EQUAL,
|
||||
JOP_NEXT,
|
||||
JOP_NOT_EQUALS,
|
||||
JOP_NOT_EQUALS_IMMEDIATE,
|
||||
JOP_CANCEL,
|
||||
JOP_INSTRUCTION_COUNT
|
||||
};
|
||||
|
||||
@@ -1070,7 +1241,35 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
|
||||
|
||||
/***** START SECTION MAIN *****/
|
||||
|
||||
#ifdef JANET_EV
|
||||
|
||||
/* Run the event loop */
|
||||
JANET_API void janet_loop(void);
|
||||
|
||||
/* Wrapper around pollables */
|
||||
JANET_API void janet_pollable_init(JanetPollable *pollable, JanetHandle handle);
|
||||
JANET_API void janet_pollable_mark(JanetPollable *pollable);
|
||||
JANET_API void janet_pollable_deinit(JanetPollable *pollable);
|
||||
|
||||
/* Queue a fiber to run on the event loop */
|
||||
JANET_API void janet_schedule(JanetFiber *fiber, Janet value);
|
||||
JANET_API void janet_cancel(JanetFiber *fiber, Janet value);
|
||||
JANET_API void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig);
|
||||
|
||||
/* Start a state machine listening for events from a pollable */
|
||||
JANET_API JanetListenerState *janet_listen(JanetPollable *pollable, JanetListener behavior, int mask, size_t size, void *user);
|
||||
|
||||
/* Shorthand for yielding to event loop in C */
|
||||
JANET_NO_RETURN JANET_API void janet_await(void);
|
||||
|
||||
/* For use inside listeners - adds a timeout to the current fiber, such that
|
||||
* it will be resumed after sec seconds if no other event schedules the current fiber. */
|
||||
void janet_addtimeout(double sec);
|
||||
|
||||
#endif
|
||||
|
||||
/* Parsing */
|
||||
extern JANET_API const JanetAbstractType janet_parser_type;
|
||||
JANET_API void janet_parser_init(JanetParser *parser);
|
||||
JANET_API void janet_parser_deinit(JanetParser *parser);
|
||||
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
|
||||
@@ -1132,6 +1331,7 @@ JANET_API void janet_debug_find(
|
||||
JanetString source, int32_t line, int32_t column);
|
||||
|
||||
/* RNG */
|
||||
extern JANET_API const JanetAbstractType janet_rng_type;
|
||||
JANET_API JanetRNG *janet_default_rng(void);
|
||||
JANET_API void janet_rng_seed(JanetRNG *rng, uint32_t seed);
|
||||
JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len);
|
||||
@@ -1166,6 +1366,7 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
|
||||
|
||||
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_from_head(gcobject) ((const Janet *)((char *)gcobject + offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
|
||||
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
|
||||
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
|
||||
@@ -1174,8 +1375,6 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
JANET_API Janet *janet_tuple_begin(int32_t length);
|
||||
JANET_API JanetTuple janet_tuple_end(Janet *tuple);
|
||||
JANET_API JanetTuple janet_tuple_n(const Janet *values, int32_t n);
|
||||
JANET_API int janet_tuple_equal(JanetTuple lhs, JanetTuple rhs);
|
||||
JANET_API int janet_tuple_compare(JanetTuple lhs, JanetTuple rhs);
|
||||
|
||||
/* String/Symbol functions */
|
||||
#define janet_string_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
|
||||
@@ -1195,7 +1394,8 @@ JANET_API void janet_description_b(JanetBuffer *buffer, Janet x);
|
||||
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
|
||||
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
|
||||
JANET_API JanetString janet_formatc(const char *format, ...);
|
||||
JANET_API void janet_formatb(JanetBuffer *bufp, const char *format, va_list args);
|
||||
JANET_API JanetBuffer *janet_formatb(JanetBuffer *bufp, const char *format, ...);
|
||||
JANET_API void janet_formatbv(JanetBuffer *bufp, const char *format, va_list args);
|
||||
|
||||
/* Symbol functions */
|
||||
JANET_API JanetSymbol janet_symbol(const uint8_t *str, int32_t len);
|
||||
@@ -1212,6 +1412,7 @@ JANET_API JanetSymbol janet_symbol_gen(void);
|
||||
|
||||
/* Structs */
|
||||
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_from_head(t) ((const JanetKV *)((char *)gcobject + offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_length(t) (janet_struct_head(t)->length)
|
||||
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
|
||||
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
|
||||
@@ -1220,8 +1421,6 @@ JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
|
||||
JANET_API JanetStruct janet_struct_end(JanetKV *st);
|
||||
JANET_API Janet janet_struct_get(JanetStruct st, Janet key);
|
||||
JANET_API JanetTable *janet_struct_to_table(JanetStruct st);
|
||||
JANET_API int janet_struct_equal(JanetStruct lhs, JanetStruct rhs);
|
||||
JANET_API int janet_struct_compare(JanetStruct lhs, JanetStruct rhs);
|
||||
JANET_API const JanetKV *janet_struct_find(JanetStruct st, Janet key);
|
||||
|
||||
/* Table functions */
|
||||
@@ -1238,12 +1437,14 @@ JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
|
||||
JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
|
||||
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
|
||||
JANET_API JanetTable *janet_table_clone(JanetTable *table);
|
||||
JANET_API void janet_table_clear(JanetTable *table);
|
||||
|
||||
/* Fiber */
|
||||
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
|
||||
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
|
||||
JANET_API JanetFiberStatus janet_fiber_status(JanetFiber *fiber);
|
||||
JANET_API JanetFiber *janet_current_fiber(void);
|
||||
JANET_API JanetFiber *janet_root_fiber(void);
|
||||
|
||||
/* Treat similar types through uniform interfaces for iteration */
|
||||
JANET_API int janet_indexed_view(Janet seq, const Janet **data, int32_t *len);
|
||||
@@ -1254,6 +1455,7 @@ JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap,
|
||||
|
||||
/* Abstract */
|
||||
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
||||
#define janet_abstract_from_head(gcobject) ((JanetAbstract)((char *)gcobject + offsetof(JanetAbstractHead, data)))
|
||||
#define janet_abstract_type(u) (janet_abstract_head(u)->type)
|
||||
#define janet_abstract_size(u) (janet_abstract_head(u)->size)
|
||||
JANET_API void *janet_abstract_begin(const JanetAbstractType *type, size_t size);
|
||||
@@ -1266,6 +1468,8 @@ typedef JanetBuildConfig(*JanetModconf)(void);
|
||||
JANET_API JanetModule janet_native(const char *name, JanetString *error);
|
||||
|
||||
/* Marshaling */
|
||||
#define JANET_MARSHAL_UNSAFE 0x20000
|
||||
|
||||
JANET_API void janet_marshal(
|
||||
JanetBuffer *buf,
|
||||
Janet x,
|
||||
@@ -1290,6 +1494,7 @@ JANET_API int janet_gcunroot(Janet root);
|
||||
JANET_API int janet_gcunrootall(Janet root);
|
||||
JANET_API int janet_gclock(void);
|
||||
JANET_API void janet_gcunlock(int handle);
|
||||
JANET_API void janet_gcpressure(size_t s);
|
||||
|
||||
/* Functions */
|
||||
JANET_API JanetFuncDef *janet_funcdef_alloc(void);
|
||||
@@ -1299,18 +1504,28 @@ JANET_API int janet_verify(JanetFuncDef *def);
|
||||
/* Pretty printing */
|
||||
#define JANET_PRETTY_COLOR 1
|
||||
#define JANET_PRETTY_ONELINE 2
|
||||
#define JANET_PRETTY_NOTRUNC 4
|
||||
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
|
||||
|
||||
/* Misc */
|
||||
#ifndef JANET_NO_PRF
|
||||
JANET_API void janet_init_hash_key(uint8_t key[16]);
|
||||
#ifdef JANET_PRF
|
||||
#define JANET_HASH_KEY_SIZE 16
|
||||
JANET_API void janet_init_hash_key(uint8_t key[JANET_HASH_KEY_SIZE]);
|
||||
#endif
|
||||
JANET_API void janet_try_init(JanetTryState *state);
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
#define janet_try(state) (janet_try_init(state), (JanetSignal) _setjmp((state)->buf))
|
||||
#else
|
||||
#define janet_try(state) (janet_try_init(state), (JanetSignal) setjmp((state)->buf))
|
||||
#endif
|
||||
JANET_API void janet_restore(JanetTryState *state);
|
||||
JANET_API int janet_equals(Janet x, Janet y);
|
||||
JANET_API int32_t janet_hash(Janet x);
|
||||
JANET_API int janet_compare(Janet x, Janet y);
|
||||
JANET_API int janet_cstrcmp(JanetString str, const char *other);
|
||||
JANET_API Janet janet_in(Janet ds, Janet key);
|
||||
JANET_API Janet janet_get(Janet ds, Janet key);
|
||||
JANET_API Janet janet_next(Janet ds, Janet key);
|
||||
JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
||||
JANET_API int32_t janet_length(Janet x);
|
||||
JANET_API Janet janet_lengthv(Janet x);
|
||||
@@ -1326,6 +1541,7 @@ JANET_API int janet_symeq(Janet x, const char *cstring);
|
||||
JANET_API int janet_init(void);
|
||||
JANET_API void janet_deinit(void);
|
||||
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
||||
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
|
||||
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
||||
JANET_API JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out);
|
||||
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
|
||||
@@ -1333,11 +1549,12 @@ JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
|
||||
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
|
||||
|
||||
/* Scratch Memory API */
|
||||
typedef void (*ScratchFinalizer)(void *);
|
||||
typedef void (*JanetScratchFinalizer)(void *);
|
||||
|
||||
JANET_API void *janet_smalloc(size_t size);
|
||||
JANET_API void *janet_srealloc(void *mem, size_t size);
|
||||
JANET_API void *janet_scalloc(size_t nmemb, size_t size);
|
||||
JANET_API void janet_sfinalizer(void *mem, ScratchFinalizer finalizer);
|
||||
JANET_API void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer);
|
||||
JANET_API void janet_sfree(void *mem);
|
||||
|
||||
/* C Library helpers */
|
||||
@@ -1350,6 +1567,7 @@ typedef enum {
|
||||
JANET_API void janet_def(JanetTable *env, const char *name, Janet val, const char *documentation);
|
||||
JANET_API void janet_var(JanetTable *env, const char *name, Janet val, const char *documentation);
|
||||
JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||
JANET_API void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||
JANET_API JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out);
|
||||
JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
|
||||
@@ -1359,14 +1577,19 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
/* New C API */
|
||||
|
||||
/* Allow setting entry name for static libraries */
|
||||
#ifdef __cplusplus
|
||||
#define JANET_MODULE_PREFIX extern "C"
|
||||
#else
|
||||
#define JANET_MODULE_PREFIX
|
||||
#endif
|
||||
#ifndef JANET_ENTRY_NAME
|
||||
#define JANET_MODULE_ENTRY \
|
||||
JANET_API JanetBuildConfig _janet_mod_config(void) { \
|
||||
JANET_MODULE_PREFIX JANET_API JanetBuildConfig _janet_mod_config(void) { \
|
||||
return janet_config_current(); \
|
||||
} \
|
||||
JANET_API void _janet_init
|
||||
JANET_MODULE_PREFIX JANET_API void _janet_init
|
||||
#else
|
||||
#define JANET_MODULE_ENTRY JANET_API void JANET_ENTRY_NAME
|
||||
#define JANET_MODULE_ENTRY JANET_MODULE_PREFIX JANET_API void JANET_ENTRY_NAME
|
||||
#endif
|
||||
|
||||
JANET_NO_RETURN JANET_API void janet_signalv(JanetSignal signal, Janet message);
|
||||
@@ -1440,6 +1663,8 @@ JANET_API JanetArray *janet_optarray(const Janet *argv, int32_t argc, int32_t n,
|
||||
JANET_API Janet janet_dyn(const char *name);
|
||||
JANET_API void janet_setdyn(const char *name, Janet value);
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_file_type;
|
||||
|
||||
#define JANET_FILE_WRITE 1
|
||||
#define JANET_FILE_READ 2
|
||||
#define JANET_FILE_APPEND 4
|
||||
@@ -1449,12 +1674,17 @@ JANET_API void janet_setdyn(const char *name, Janet value);
|
||||
#define JANET_FILE_BINARY 64
|
||||
#define JANET_FILE_SERIALIZABLE 128
|
||||
#define JANET_FILE_PIPED 256
|
||||
#define JANET_FILE_NONIL 512
|
||||
|
||||
JANET_API Janet janet_makefile(FILE *f, int flags);
|
||||
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
|
||||
JANET_API Janet janet_makefile(FILE *f, int32_t flags);
|
||||
JANET_API JanetFile *janet_makejfile(FILE *f, int32_t flags);
|
||||
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags);
|
||||
JANET_API FILE *janet_dynfile(const char *name, FILE *def);
|
||||
JANET_API JanetFile *janet_getjfile(const Janet *argv, int32_t n);
|
||||
JANET_API JanetAbstract janet_checkfile(Janet j);
|
||||
JANET_API FILE *janet_unwrapfile(Janet j, int *flags);
|
||||
JANET_API FILE *janet_unwrapfile(Janet j, int32_t *flags);
|
||||
|
||||
JANET_API int janet_cryptorand(uint8_t *out, size_t n);
|
||||
|
||||
/* Marshal API */
|
||||
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
|
||||
@@ -1477,8 +1707,56 @@ JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_
|
||||
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
|
||||
JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
|
||||
|
||||
#ifdef JANET_PEG
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_peg_type;
|
||||
|
||||
/* opcodes for peg vm */
|
||||
typedef enum {
|
||||
RULE_LITERAL, /* [len, bytes...] */
|
||||
RULE_NCHAR, /* [n] */
|
||||
RULE_NOTNCHAR, /* [n] */
|
||||
RULE_RANGE, /* [lo | hi << 16 (1 word)] */
|
||||
RULE_SET, /* [bitmap (8 words)] */
|
||||
RULE_LOOK, /* [offset, rule] */
|
||||
RULE_CHOICE, /* [len, rules...] */
|
||||
RULE_SEQUENCE, /* [len, rules...] */
|
||||
RULE_IF, /* [rule_a, rule_b (b if a)] */
|
||||
RULE_IFNOT, /* [rule_a, rule_b (b if not a)] */
|
||||
RULE_NOT, /* [rule] */
|
||||
RULE_BETWEEN, /* [lo, hi, rule] */
|
||||
RULE_GETTAG, /* [searchtag, tag] */
|
||||
RULE_CAPTURE, /* [rule, tag] */
|
||||
RULE_POSITION, /* [tag] */
|
||||
RULE_ARGUMENT, /* [argument-index, tag] */
|
||||
RULE_CONSTANT, /* [constant, tag] */
|
||||
RULE_ACCUMULATE, /* [rule, tag] */
|
||||
RULE_GROUP, /* [rule, tag] */
|
||||
RULE_REPLACE, /* [rule, constant, tag] */
|
||||
RULE_MATCHTIME, /* [rule, constant, tag] */
|
||||
RULE_ERROR, /* [rule] */
|
||||
RULE_DROP, /* [rule] */
|
||||
RULE_BACKMATCH, /* [tag] */
|
||||
RULE_TO, /* [rule] */
|
||||
RULE_THRU, /* [rule] */
|
||||
RULE_LENPREFIX, /* [rule_a, rule_b (repeat rule_b rule_a times)] */
|
||||
RULE_READINT, /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
|
||||
} JanetPegOpcode;
|
||||
|
||||
typedef struct {
|
||||
uint32_t *bytecode;
|
||||
Janet *constants;
|
||||
size_t bytecode_len;
|
||||
uint32_t num_constants;
|
||||
} JanetPeg;
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_ta_view_type;
|
||||
extern JANET_API const JanetAbstractType janet_ta_buffer_type;
|
||||
|
||||
typedef enum {
|
||||
JANET_TARRAY_TYPE_U8,
|
||||
JANET_TARRAY_TYPE_S8,
|
||||
@@ -1529,6 +1807,9 @@ JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n);
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_s64_type;
|
||||
extern JANET_API const JanetAbstractType janet_u64_type;
|
||||
|
||||
typedef enum {
|
||||
JANET_INT_NONE,
|
||||
JANET_INT_S64,
|
||||
@@ -1545,8 +1826,22 @@ JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef JANET_THREADS
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_thread_type;
|
||||
|
||||
JANET_API int janet_thread_receive(Janet *msg_out, double timeout);
|
||||
JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout);
|
||||
|
||||
#endif
|
||||
|
||||
/***** END SECTION MAIN *****/
|
||||
|
||||
/* Re-enable popped variable length array warnings */
|
||||
#ifdef _MSC_VER
|
||||
#pragma warning( pop )
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
@@ -1,90 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#if !defined(_POSIX_C_SOURCE)
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "line.h"
|
||||
#endif
|
||||
|
||||
#ifdef _WIN32
|
||||
#include <windows.h>
|
||||
#include <shlwapi.h>
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||
#endif
|
||||
#endif
|
||||
|
||||
int main(int argc, char **argv) {
|
||||
int i, status;
|
||||
JanetArray *args;
|
||||
JanetTable *env;
|
||||
|
||||
#ifdef _WIN32
|
||||
/* Enable color console on windows 10 console and utf8 output. */
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
SetConsoleOutputCP(65001);
|
||||
#endif
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
|
||||
/* Replace original getline with new line getter */
|
||||
JanetTable *replacements = janet_table(0);
|
||||
janet_table_put(replacements, janet_csymbolv("getline"), janet_wrap_cfunction(janet_line_getter));
|
||||
janet_line_init();
|
||||
|
||||
/* Get core env */
|
||||
env = janet_core_env(replacements);
|
||||
|
||||
/* Create args tuple */
|
||||
args = janet_array(argc);
|
||||
for (i = 1; i < argc; i++)
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
|
||||
/* Save current executable path to (dyn :executable) */
|
||||
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
|
||||
|
||||
/* Run startup script */
|
||||
Janet mainfun, out;
|
||||
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
|
||||
Janet mainargs[1] = { janet_wrap_array(args) };
|
||||
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
|
||||
fiber->env = env;
|
||||
status = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
janet_line_deinit();
|
||||
|
||||
return status;
|
||||
}
|
||||
@@ -24,9 +24,27 @@
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "line.h"
|
||||
#include <janet.h>
|
||||
|
||||
#ifdef _WIN32
|
||||
#include <windows.h>
|
||||
#include <shlwapi.h>
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||
#endif
|
||||
#endif
|
||||
|
||||
void janet_line_init();
|
||||
void janet_line_deinit();
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer);
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv);
|
||||
|
||||
static JANET_THREAD_LOCAL int gbl_cancel_current_repl_form = 0;
|
||||
|
||||
/*
|
||||
* Line Editing
|
||||
*/
|
||||
|
||||
static JANET_THREAD_LOCAL JanetTable *gbl_complete_env;
|
||||
|
||||
@@ -38,7 +56,17 @@ Janet janet_line_getter(int32_t argc, Janet *argv) {
|
||||
gbl_complete_env = (argc >= 3) ? janet_gettable(argv, 2) : NULL;
|
||||
janet_line_get(str, buf);
|
||||
gbl_complete_env = NULL;
|
||||
return janet_wrap_buffer(buf);
|
||||
|
||||
Janet result;
|
||||
if (gbl_cancel_current_repl_form) {
|
||||
gbl_cancel_current_repl_form = 0;
|
||||
|
||||
/* Signal that the user bailed out of the current form */
|
||||
result = janet_ckeywordv("cancel");
|
||||
} else {
|
||||
result = janet_wrap_buffer(buf);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
static void simpleline(JanetBuffer *buffer) {
|
||||
@@ -56,7 +84,7 @@ static void simpleline(JanetBuffer *buffer) {
|
||||
}
|
||||
|
||||
/* Windows */
|
||||
#ifdef JANET_WINDOWS
|
||||
#if defined(JANET_WINDOWS) || defined(JANET_SIMPLE_GETLINE)
|
||||
|
||||
void janet_line_init() {
|
||||
;
|
||||
@@ -67,7 +95,7 @@ void janet_line_deinit() {
|
||||
}
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
FILE *out = janet_dynfile("err", stderr);
|
||||
fputs(p, out);
|
||||
fflush(out);
|
||||
simpleline(buffer);
|
||||
@@ -80,8 +108,6 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
https://github.com/antirez/linenoise/blob/master/linenoise.c
|
||||
*/
|
||||
|
||||
#include <janet.h>
|
||||
|
||||
#include <termios.h>
|
||||
#include <unistd.h>
|
||||
#include <stdlib.h>
|
||||
@@ -100,20 +126,28 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
|
||||
#define JANET_LINE_MAX 1024
|
||||
#define JANET_MATCH_MAX 256
|
||||
#define JANET_HISTORY_MAX 100
|
||||
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
|
||||
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
|
||||
static JANET_THREAD_LOCAL int gbl_plen = 2;
|
||||
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_len = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_pos = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_cols = 80;
|
||||
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_history_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
|
||||
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
|
||||
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_match_count = 0;
|
||||
static int gbl_israwmode = 0;
|
||||
static const char *gbl_prompt = "> ";
|
||||
static int gbl_plen = 2;
|
||||
static char gbl_buf[JANET_LINE_MAX];
|
||||
static int gbl_len = 0;
|
||||
static int gbl_pos = 0;
|
||||
static int gbl_cols = 80;
|
||||
static char *gbl_history[JANET_HISTORY_MAX];
|
||||
static int gbl_history_count = 0;
|
||||
static int gbl_historyi = 0;
|
||||
static int gbl_sigint_flag = 0;
|
||||
static struct termios gbl_termios_start;
|
||||
static JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static int gbl_match_count = 0;
|
||||
static int gbl_lines_below = 0;
|
||||
|
||||
/* Put a lock around this global state so we don't screw up
|
||||
* the terminal in a multithreaded situation */
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
#include <pthread.h>
|
||||
static pthread_mutex_t gbl_lock = PTHREAD_MUTEX_INITIALIZER;
|
||||
#endif
|
||||
|
||||
/* Unsupported terminal list from linenoise */
|
||||
static const char *badterms[] = {
|
||||
@@ -135,6 +169,9 @@ static char *sdup(const char *s) {
|
||||
/* Ansi terminal raw mode */
|
||||
static int rawmode(void) {
|
||||
struct termios t;
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
pthread_mutex_lock(&gbl_lock);
|
||||
#endif
|
||||
if (!isatty(STDIN_FILENO)) goto fatal;
|
||||
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
|
||||
t = gbl_termios_start;
|
||||
@@ -143,18 +180,24 @@ static int rawmode(void) {
|
||||
t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
|
||||
t.c_cc[VMIN] = 1;
|
||||
t.c_cc[VTIME] = 0;
|
||||
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
|
||||
if (tcsetattr(STDIN_FILENO, TCSADRAIN, &t) < 0) goto fatal;
|
||||
gbl_israwmode = 1;
|
||||
return 0;
|
||||
fatal:
|
||||
errno = ENOTTY;
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
pthread_mutex_unlock(&gbl_lock);
|
||||
#endif
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* Disable raw mode */
|
||||
static void norawmode(void) {
|
||||
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
|
||||
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSADRAIN, &gbl_termios_start) != -1)
|
||||
gbl_israwmode = 0;
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
pthread_mutex_unlock(&gbl_lock);
|
||||
#endif
|
||||
}
|
||||
|
||||
static int curpos(void) {
|
||||
@@ -236,6 +279,17 @@ static void refresh(void) {
|
||||
janet_buffer_deinit(&b);
|
||||
}
|
||||
|
||||
static void clearlines(void) {
|
||||
for (int i = 0; i < gbl_lines_below; i++) {
|
||||
fprintf(stderr, "\x1b[1B\x1b[999D\x1b[K");
|
||||
}
|
||||
if (gbl_lines_below) {
|
||||
fprintf(stderr, "\x1b[%dA\x1b[999D", gbl_lines_below);
|
||||
fflush(stderr);
|
||||
gbl_lines_below = 0;
|
||||
}
|
||||
}
|
||||
|
||||
static int insert(char c, int draw) {
|
||||
if (gbl_len < JANET_LINE_MAX - 1) {
|
||||
if (gbl_len == gbl_pos) {
|
||||
@@ -268,10 +322,8 @@ static void historymove(int delta) {
|
||||
gbl_historyi += delta;
|
||||
if (gbl_historyi < 0) {
|
||||
gbl_historyi = 0;
|
||||
return;
|
||||
} else if (gbl_historyi >= gbl_history_count) {
|
||||
gbl_historyi = gbl_history_count - 1;
|
||||
return;
|
||||
}
|
||||
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
|
||||
gbl_pos = gbl_len = strlen(gbl_buf);
|
||||
@@ -299,10 +351,20 @@ static void addhistory(void) {
|
||||
}
|
||||
|
||||
static void replacehistory(void) {
|
||||
char *newline = sdup(gbl_buf);
|
||||
if (!newline) return;
|
||||
free(gbl_history[0]);
|
||||
gbl_history[0] = newline;
|
||||
/* History count is always > 0 here */
|
||||
if (gbl_len == 0 || (gbl_history_count > 1 && !strcmp(gbl_buf, gbl_history[1]))) {
|
||||
/* Delete history */
|
||||
free(gbl_history[0]);
|
||||
for (int i = 1; i < gbl_history_count; i++) {
|
||||
gbl_history[i - 1] = gbl_history[i];
|
||||
}
|
||||
gbl_history_count--;
|
||||
} else {
|
||||
char *newline = sdup(gbl_buf);
|
||||
if (!newline) return;
|
||||
free(gbl_history[0]);
|
||||
gbl_history[0] = newline;
|
||||
}
|
||||
}
|
||||
|
||||
static void kleft(void) {
|
||||
@@ -312,6 +374,16 @@ static void kleft(void) {
|
||||
}
|
||||
}
|
||||
|
||||
static void kleftw(void) {
|
||||
while (gbl_pos > 0 && isspace(gbl_buf[gbl_pos - 1])) {
|
||||
gbl_pos--;
|
||||
}
|
||||
while (gbl_pos > 0 && !isspace(gbl_buf[gbl_pos - 1])) {
|
||||
gbl_pos--;
|
||||
}
|
||||
refresh();
|
||||
}
|
||||
|
||||
static void kright(void) {
|
||||
if (gbl_pos != gbl_len) {
|
||||
gbl_pos++;
|
||||
@@ -319,23 +391,54 @@ static void kright(void) {
|
||||
}
|
||||
}
|
||||
|
||||
static void kbackspace(void) {
|
||||
static void krightw(void) {
|
||||
while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
|
||||
gbl_pos++;
|
||||
}
|
||||
while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
|
||||
gbl_pos++;
|
||||
}
|
||||
refresh();
|
||||
}
|
||||
|
||||
static void kbackspace(int draw) {
|
||||
if (gbl_pos > 0) {
|
||||
memmove(gbl_buf + gbl_pos - 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
||||
gbl_pos--;
|
||||
gbl_buf[--gbl_len] = '\0';
|
||||
refresh();
|
||||
if (draw) refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void kdelete(void) {
|
||||
static void kdelete(int draw) {
|
||||
if (gbl_pos != gbl_len) {
|
||||
memmove(gbl_buf + gbl_pos, gbl_buf + gbl_pos + 1, gbl_len - gbl_pos);
|
||||
gbl_buf[--gbl_len] = '\0';
|
||||
refresh();
|
||||
if (draw) refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void kbackspacew(void) {
|
||||
while (gbl_pos && isspace(gbl_buf[gbl_pos - 1])) {
|
||||
kbackspace(0);
|
||||
}
|
||||
while (gbl_pos && !isspace(gbl_buf[gbl_pos - 1])) {
|
||||
kbackspace(0);
|
||||
}
|
||||
refresh();
|
||||
}
|
||||
|
||||
static void kdeletew(void) {
|
||||
while (gbl_pos < gbl_len && isspace(gbl_buf[gbl_pos])) {
|
||||
kdelete(0);
|
||||
}
|
||||
while (gbl_pos < gbl_len && !isspace(gbl_buf[gbl_pos])) {
|
||||
kdelete(0);
|
||||
}
|
||||
refresh();
|
||||
}
|
||||
|
||||
|
||||
/* See tools/symchargen.c */
|
||||
static int is_symbol_char_gen(uint8_t c) {
|
||||
if (c & 0x80) return 1;
|
||||
@@ -440,19 +543,110 @@ static void check_specials(JanetByteView src) {
|
||||
check_cmatch(src, "while");
|
||||
}
|
||||
|
||||
/* TODO - check against special forms and print in alphabetical order */
|
||||
static void kshowcomp(void) {
|
||||
JanetTable *env = gbl_complete_env;
|
||||
if (env == NULL) {
|
||||
insert(' ', 0);
|
||||
insert(' ', 0);
|
||||
return;
|
||||
static void resolve_format(JanetTable *entry) {
|
||||
int is_macro = janet_truthy(janet_table_get(entry, janet_ckeywordv("macro")));
|
||||
Janet refv = janet_table_get(entry, janet_ckeywordv("ref"));
|
||||
int is_ref = janet_checktype(refv, JANET_ARRAY);
|
||||
Janet value = janet_wrap_nil();
|
||||
if (is_ref) {
|
||||
JanetArray *a = janet_unwrap_array(refv);
|
||||
if (a->count) value = a->data[0];
|
||||
} else {
|
||||
value = janet_table_get(entry, janet_ckeywordv("value"));
|
||||
}
|
||||
if (is_macro) {
|
||||
fprintf(stderr, " macro\n");
|
||||
gbl_lines_below++;
|
||||
} else if (is_ref) {
|
||||
janet_eprintf(" var (%t)\n", value);
|
||||
gbl_lines_below++;
|
||||
} else {
|
||||
janet_eprintf(" %t\n", value);
|
||||
gbl_lines_below++;
|
||||
}
|
||||
Janet sm = janet_table_get(entry, janet_ckeywordv("source-map"));
|
||||
Janet path = janet_get(sm, janet_wrap_integer(0));
|
||||
Janet line = janet_get(sm, janet_wrap_integer(1));
|
||||
Janet col = janet_get(sm, janet_wrap_integer(2));
|
||||
if (janet_checktype(path, JANET_STRING) && janet_truthy(line) && janet_truthy(col)) {
|
||||
janet_eprintf(" %S on line %v, column %v\n", janet_unwrap_string(path), line, col);
|
||||
gbl_lines_below++;
|
||||
}
|
||||
}
|
||||
|
||||
JanetByteView prefix = get_symprefix();
|
||||
if (prefix.len == 0) return;
|
||||
static void doc_format(JanetString doc, int32_t width) {
|
||||
int32_t maxcol = width - 8;
|
||||
uint8_t wordbuf[256] = {0};
|
||||
int32_t wordp = 0;
|
||||
int32_t current = 0;
|
||||
if (maxcol > 200) maxcol = 200;
|
||||
fprintf(stderr, " ");
|
||||
for (int32_t i = 0; i < janet_string_length(doc); i++) {
|
||||
uint8_t b = doc[i];
|
||||
switch (b) {
|
||||
default: {
|
||||
if (maxcol <= current + wordp + 1) {
|
||||
if (!current) {
|
||||
fwrite(wordbuf, wordp, 1, stderr);
|
||||
wordp = 0;
|
||||
}
|
||||
fprintf(stderr, "\n ");
|
||||
gbl_lines_below++;
|
||||
current = 0;
|
||||
}
|
||||
wordbuf[wordp++] = b;
|
||||
break;
|
||||
}
|
||||
case '\t': {
|
||||
if (maxcol <= current + wordp + 2) {
|
||||
if (!current) {
|
||||
fwrite(wordbuf, wordp, 1, stderr);
|
||||
wordp = 0;
|
||||
}
|
||||
fprintf(stderr, "\n ");
|
||||
gbl_lines_below++;
|
||||
current = 0;
|
||||
}
|
||||
wordbuf[wordp++] = ' ';
|
||||
wordbuf[wordp++] = ' ';
|
||||
break;
|
||||
}
|
||||
case '\n':
|
||||
case ' ': {
|
||||
if (wordp) {
|
||||
int32_t oldcur = current;
|
||||
int spacer = maxcol > current + wordp + 1;
|
||||
if (spacer) current++;
|
||||
else current = 0;
|
||||
current += wordp;
|
||||
if (oldcur) fprintf(stderr, spacer ? " " : "\n ");
|
||||
if (oldcur && !spacer) gbl_lines_below++;
|
||||
fwrite(wordbuf, wordp, 1, stderr);
|
||||
wordp = 0;
|
||||
}
|
||||
if (b == '\n') {
|
||||
fprintf(stderr, "\n ");
|
||||
gbl_lines_below++;
|
||||
current = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (wordp) {
|
||||
int32_t oldcur = current;
|
||||
int spacer = maxcol > current + wordp + 1;
|
||||
if (spacer) current++;
|
||||
else current = 0;
|
||||
current += wordp + 1;
|
||||
if (oldcur) fprintf(stderr, spacer ? " " : "\n ");
|
||||
if (oldcur && !spacer) gbl_lines_below++;
|
||||
fwrite(wordbuf, wordp, 1, stderr);
|
||||
wordp = 0;
|
||||
}
|
||||
}
|
||||
|
||||
/* Find all matches */
|
||||
static void find_matches(JanetByteView prefix) {
|
||||
JanetTable *env = gbl_complete_env;
|
||||
gbl_match_count = 0;
|
||||
while (NULL != env) {
|
||||
JanetKV *kvend = env->data + env->capacity;
|
||||
@@ -463,6 +657,49 @@ static void kshowcomp(void) {
|
||||
}
|
||||
env = env->proto;
|
||||
}
|
||||
}
|
||||
|
||||
static void kshowdoc(void) {
|
||||
if (!gbl_complete_env) return;
|
||||
while (is_symbol_char_gen(gbl_buf[gbl_pos])) gbl_pos++;
|
||||
JanetByteView prefix = get_symprefix();
|
||||
Janet symbol = janet_symbolv(prefix.bytes, prefix.len);
|
||||
Janet entry = janet_table_get(gbl_complete_env, symbol);
|
||||
if (!janet_checktype(entry, JANET_TABLE)) return;
|
||||
Janet doc = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("doc"));
|
||||
if (!janet_checktype(doc, JANET_STRING)) return;
|
||||
JanetString docs = janet_unwrap_string(doc);
|
||||
int num_cols = getcols();
|
||||
clearlines();
|
||||
fprintf(stderr, "\n\n\n");
|
||||
gbl_lines_below += 3;
|
||||
resolve_format(janet_unwrap_table(entry));
|
||||
fprintf(stderr, "\n");
|
||||
gbl_lines_below += 1;
|
||||
doc_format(docs, num_cols);
|
||||
fprintf(stderr, "\n\n");
|
||||
gbl_lines_below += 2;
|
||||
/* Go up to original line (zsh-like autocompletion) */
|
||||
fprintf(stderr, "\x1B[%dA", gbl_lines_below);
|
||||
fflush(stderr);
|
||||
}
|
||||
|
||||
static void kshowcomp(void) {
|
||||
JanetTable *env = gbl_complete_env;
|
||||
if (env == NULL) {
|
||||
insert(' ', 0);
|
||||
insert(' ', 0);
|
||||
return;
|
||||
}
|
||||
|
||||
/* Advance while on symbol char */
|
||||
while (is_symbol_char_gen(gbl_buf[gbl_pos]))
|
||||
gbl_pos++;
|
||||
|
||||
JanetByteView prefix = get_symprefix();
|
||||
if (prefix.len == 0) return;
|
||||
|
||||
find_matches(prefix);
|
||||
|
||||
check_specials(prefix);
|
||||
|
||||
@@ -471,29 +708,39 @@ static void kshowcomp(void) {
|
||||
insert(lcp.bytes[i], 0);
|
||||
}
|
||||
|
||||
if (!gbl_lines_below && prefix.len != lcp.len) return;
|
||||
|
||||
int32_t maxlen = 0;
|
||||
for (int i = 0; i < gbl_match_count; i++)
|
||||
if (gbl_matches[i].len > maxlen)
|
||||
maxlen = gbl_matches[i].len;
|
||||
|
||||
int num_cols = getcols();
|
||||
clearlines();
|
||||
if (gbl_match_count >= 2) {
|
||||
|
||||
norawmode();
|
||||
|
||||
/* Second pass, print */
|
||||
int col_width = maxlen + 4;
|
||||
int cols = num_cols / col_width;
|
||||
if (cols == 0) cols = 1;
|
||||
int current_col = 0;
|
||||
for (int i = 0; i < gbl_match_count; i++) {
|
||||
if (current_col == 0) printf("\n");
|
||||
printf("%-*s", col_width, (const char *) gbl_matches[i].bytes);
|
||||
if (current_col == 0) {
|
||||
putc('\n', stderr);
|
||||
gbl_lines_below++;
|
||||
}
|
||||
JanetByteView s = gbl_matches[i];
|
||||
fprintf(stderr, "%s", (const char *) s.bytes);
|
||||
for (int j = s.len; j < col_width; j++) {
|
||||
putc(' ', stderr);
|
||||
}
|
||||
current_col = (current_col + 1) % cols;
|
||||
}
|
||||
printf("\n");
|
||||
|
||||
rawmode();
|
||||
/* Go up to original line (zsh-like autocompletion) */
|
||||
fprintf(stderr, "\x1B[%dA", gbl_lines_below);
|
||||
|
||||
fflush(stderr);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -510,32 +757,15 @@ static int line() {
|
||||
if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
|
||||
for (;;) {
|
||||
char c;
|
||||
int nread;
|
||||
char seq[3];
|
||||
|
||||
nread = read(STDIN_FILENO, &c, 1);
|
||||
if (nread <= 0) return -1;
|
||||
if (read(STDIN_FILENO, &c, 1) <= 0) return -1;
|
||||
|
||||
switch (c) {
|
||||
default:
|
||||
if ((unsigned char) c < 0x20) break;
|
||||
if (insert(c, 1)) return -1;
|
||||
break;
|
||||
case 9: /* tab */
|
||||
kshowcomp();
|
||||
refresh();
|
||||
break;
|
||||
case 13: /* enter */
|
||||
return 0;
|
||||
case 3: /* ctrl-c */
|
||||
errno = EAGAIN;
|
||||
gbl_sigint_flag = 1;
|
||||
return -1;
|
||||
case 127: /* backspace */
|
||||
case 8: /* ctrl-h */
|
||||
kbackspace();
|
||||
break;
|
||||
case 4: /* ctrl-d, eof */
|
||||
return -1;
|
||||
case 1: /* ctrl-a */
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
@@ -543,6 +773,17 @@ static int line() {
|
||||
case 2: /* ctrl-b */
|
||||
kleft();
|
||||
break;
|
||||
case 3: /* ctrl-c */
|
||||
gbl_cancel_current_repl_form = 1;
|
||||
clearlines();
|
||||
return -1;
|
||||
case 4: /* ctrl-d, eof */
|
||||
if (gbl_len == 0) { /* quit on empty line */
|
||||
clearlines();
|
||||
return -1;
|
||||
}
|
||||
kdelete(1);
|
||||
break;
|
||||
case 5: /* ctrl-e */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
@@ -550,48 +791,104 @@ static int line() {
|
||||
case 6: /* ctrl-f */
|
||||
kright();
|
||||
break;
|
||||
case 21:
|
||||
gbl_buf[0] = '\0';
|
||||
gbl_pos = gbl_len = 0;
|
||||
case 7: /* ctrl-g */
|
||||
kshowdoc();
|
||||
refresh();
|
||||
break;
|
||||
case 127: /* backspace */
|
||||
case 8: /* ctrl-h */
|
||||
kbackspace(1);
|
||||
break;
|
||||
case 9: /* tab */
|
||||
kshowcomp();
|
||||
refresh();
|
||||
break;
|
||||
case 11: /* ctrl-k */
|
||||
gbl_buf[gbl_pos] = '\0';
|
||||
gbl_len = gbl_pos;
|
||||
refresh();
|
||||
break;
|
||||
case 12: /* ctrl-l */
|
||||
clear();
|
||||
refresh();
|
||||
break;
|
||||
case 13: /* enter */
|
||||
clearlines();
|
||||
return 0;
|
||||
case 14: /* ctrl-n */
|
||||
historymove(-1);
|
||||
break;
|
||||
case 16: /* ctrl-p */
|
||||
historymove(1);
|
||||
break;
|
||||
case 21: { /* ctrl-u */
|
||||
memmove(gbl_buf, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
||||
gbl_len -= gbl_pos;
|
||||
gbl_buf[gbl_len] = '\0';
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
case 23: /* ctrl-w */
|
||||
kbackspacew();
|
||||
break;
|
||||
case 26: /* ctrl-z */
|
||||
norawmode();
|
||||
kill(getpid(), SIGSTOP);
|
||||
rawmode();
|
||||
refresh();
|
||||
break;
|
||||
case 12:
|
||||
clear();
|
||||
refresh();
|
||||
break;
|
||||
case 27: /* escape sequence */
|
||||
/* Read the next two bytes representing the escape sequence.
|
||||
* Use two calls to handle slow terminals returning the two
|
||||
* chars at different times. */
|
||||
if (read(STDIN_FILENO, seq, 1) == -1) break;
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
/* Esc[ = Control Sequence Introducer (CSI) */
|
||||
if (seq[0] == '[') {
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
if (seq[1] >= '0' && seq[1] <= '9') {
|
||||
/* Extended escape, read additional byte. */
|
||||
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
|
||||
if (seq[2] == '~') {
|
||||
switch (seq[1]) {
|
||||
case '1': /* Home */
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case '3': /* delete */
|
||||
kdelete();
|
||||
kdelete(1);
|
||||
break;
|
||||
case '4': /* End */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
} else if (seq[0] == 'O') {
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
switch (seq[1]) {
|
||||
default:
|
||||
break;
|
||||
case 'A':
|
||||
case 'H': /* Home (some keyboards) */
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 'F': /* End (some keyboards) */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
} else {
|
||||
switch (seq[1]) {
|
||||
/* Single escape sequences */
|
||||
default:
|
||||
break;
|
||||
case 'A': /* Up */
|
||||
historymove(1);
|
||||
break;
|
||||
case 'B':
|
||||
case 'B': /* Down */
|
||||
historymove(-1);
|
||||
break;
|
||||
case 'C': /* Right */
|
||||
@@ -600,27 +897,38 @@ static int line() {
|
||||
case 'D': /* Left */
|
||||
kleft();
|
||||
break;
|
||||
case 'H':
|
||||
case 'H': /* Home */
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 'F':
|
||||
case 'F': /* End */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else if (seq[0] == 'O') {
|
||||
switch (seq[1]) {
|
||||
} else {
|
||||
/* Check alt-(shift) bindings */
|
||||
switch (seq[0]) {
|
||||
default:
|
||||
break;
|
||||
case 'H':
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
case 'd': /* Alt-d */
|
||||
kdeletew();
|
||||
break;
|
||||
case 'F':
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
case 'b': /* Alt-b */
|
||||
kleftw();
|
||||
break;
|
||||
case 'f': /* Alt-f */
|
||||
krightw();
|
||||
break;
|
||||
case ',': /* Alt-, */
|
||||
historymove(JANET_HISTORY_MAX);
|
||||
break;
|
||||
case '.': /* Alt-. */
|
||||
historymove(-JANET_HISTORY_MAX);
|
||||
break;
|
||||
case 127: /* Alt-backspace */
|
||||
kbackspacew();
|
||||
break;
|
||||
}
|
||||
}
|
||||
@@ -655,7 +963,7 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
gbl_prompt = p;
|
||||
buffer->count = 0;
|
||||
gbl_historyi = 0;
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
FILE *out = janet_dynfile("err", stderr);
|
||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||
simpleline(buffer);
|
||||
return;
|
||||
@@ -684,3 +992,86 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Entry
|
||||
*/
|
||||
|
||||
int main(int argc, char **argv) {
|
||||
int i, status;
|
||||
JanetArray *args;
|
||||
JanetTable *env;
|
||||
|
||||
#ifdef _WIN32
|
||||
/* Enable color console on windows 10 console and utf8 output. */
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
SetConsoleOutputCP(65001);
|
||||
#endif
|
||||
|
||||
#if !defined(JANET_WINDOWS) && !defined(JANET_SIMPLE_GETLINE)
|
||||
/* Try and not leave the terminal in a bad state */
|
||||
atexit(norawmode);
|
||||
#endif
|
||||
|
||||
#if defined(JANET_PRF)
|
||||
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1];
|
||||
#ifdef JANET_REDUCED_OS
|
||||
char *envvar = NULL;
|
||||
#else
|
||||
char *envvar = getenv("JANET_HASHSEED");
|
||||
#endif
|
||||
if (NULL != envvar) {
|
||||
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
|
||||
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
|
||||
fputs("unable to initialize janet PRF hash function.\n", stderr);
|
||||
return 1;
|
||||
}
|
||||
janet_init_hash_key(hash_key);
|
||||
#endif
|
||||
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
|
||||
/* Replace original getline with new line getter */
|
||||
JanetTable *replacements = janet_table(0);
|
||||
janet_table_put(replacements, janet_csymbolv("getline"), janet_wrap_cfunction(janet_line_getter));
|
||||
janet_line_init();
|
||||
|
||||
/* Get core env */
|
||||
env = janet_core_env(replacements);
|
||||
|
||||
/* Create args tuple */
|
||||
args = janet_array(argc);
|
||||
for (i = 1; i < argc; i++)
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
|
||||
/* Save current executable path to (dyn :executable) */
|
||||
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
|
||||
|
||||
/* Run startup script */
|
||||
Janet mainfun, out;
|
||||
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
|
||||
Janet mainargs[1] = { janet_wrap_array(args) };
|
||||
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
|
||||
fiber->env = env;
|
||||
status = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
status = JANET_SIGNAL_OK;
|
||||
janet_loop();
|
||||
#endif
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
janet_line_deinit();
|
||||
|
||||
return status;
|
||||
}
|
||||
45
test/fuzzers/fuzz_dostring.c
Normal file
45
test/fuzzers/fuzz_dostring.c
Normal file
@@ -0,0 +1,45 @@
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
#include <janet.h>
|
||||
|
||||
int LLVMFuzzerTestOneInput(const uint8_t *data, size_t size) {
|
||||
|
||||
/* init Janet */
|
||||
janet_init();
|
||||
|
||||
/* fuzz the parser */
|
||||
JanetParser parser;
|
||||
janet_parser_init(&parser);
|
||||
for (int i = 0, done = 0; i < size; i++) {
|
||||
switch (janet_parser_status(&parser)) {
|
||||
case JANET_PARSE_DEAD:
|
||||
case JANET_PARSE_ERROR:
|
||||
done = 1;
|
||||
break;
|
||||
case JANET_PARSE_PENDING:
|
||||
if (i == size) {
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
janet_parser_consume(&parser, data[i]);
|
||||
}
|
||||
break;
|
||||
case JANET_PARSE_ROOT:
|
||||
if (i >= size) {
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
janet_parser_consume(&parser, data[i]);
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
if (done == 1)
|
||||
break;
|
||||
}
|
||||
janet_parser_deinit(&parser);
|
||||
|
||||
/* cleanup Janet */
|
||||
janet_deinit();
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -3,25 +3,20 @@
|
||||
(var num-tests-passed 0)
|
||||
(var num-tests-run 0)
|
||||
(var suite-num 0)
|
||||
(var numchecks 0)
|
||||
(var start-time 0)
|
||||
|
||||
(defn assert
|
||||
"Override's the default assert with some nice error handling."
|
||||
[x e]
|
||||
[x &opt e]
|
||||
(default e "assert error")
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(def str (string e))
|
||||
(def truncated
|
||||
(if (> (length e) 40) (string (string/slice e 0 35) "...") (string e)))
|
||||
(if x
|
||||
(do
|
||||
(when (= numchecks 25)
|
||||
(set numchecks 0)
|
||||
(print))
|
||||
(++ numchecks)
|
||||
(file/write stdout "\e[32m✔\e[0m"))
|
||||
(do
|
||||
(file/write stdout "\n\e[31m✘\e[0m ")
|
||||
(set numchecks 0)
|
||||
(print e)))
|
||||
(xprintf stdout "\e[32m✔\e[0m %s: %v" truncated x)
|
||||
(xprintf stdout "\n\e[31m✘\e[0m %s: %v" truncated x))
|
||||
x)
|
||||
|
||||
(defmacro assert-error
|
||||
|
||||
1
test/install/.gitignore
vendored
1
test/install/.gitignore
vendored
@@ -1,4 +1,5 @@
|
||||
/build
|
||||
/modpath
|
||||
.cache
|
||||
.manifests
|
||||
json.*
|
||||
|
||||
@@ -9,6 +9,14 @@
|
||||
:name "testmod2"
|
||||
:source @["testmod2.c"])
|
||||
|
||||
(declare-native
|
||||
:name "testmod3"
|
||||
:source @["testmod3.cpp"])
|
||||
|
||||
(declare-native
|
||||
:name "test-mod-4"
|
||||
:source @["testmod4.c"])
|
||||
|
||||
(declare-executable
|
||||
:name "testexec"
|
||||
:entry "testexec.janet")
|
||||
|
||||
@@ -1,6 +1,8 @@
|
||||
(use build/testmod)
|
||||
(use build/testmod2)
|
||||
(use build/testmod3)
|
||||
(use build/test-mod-4)
|
||||
|
||||
(defn main [&]
|
||||
(print "Hello from executable!")
|
||||
(print (+ (get5) (get6))))
|
||||
(print (+ (get5) (get6) (get7) (get8))))
|
||||
|
||||
42
test/install/testmod3.cpp
Normal file
42
test/install/testmod3.cpp
Normal file
@@ -0,0 +1,42 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose and contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* A very simple native module */
|
||||
|
||||
#include <janet.h>
|
||||
#include <iostream>
|
||||
|
||||
static Janet cfun_get_seven(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
std::cout << "Hello!" << std::endl;
|
||||
return janet_wrap_number(7.0);
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{"get7", cfun_get_seven, NULL},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, array_cfuns);
|
||||
}
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose and contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,21 +20,21 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_LINE_H_defined
|
||||
#define JANET_LINE_H_defined
|
||||
/* A very simple native module */
|
||||
|
||||
#if !defined(_POSIX_C_SOURCE)
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
void janet_line_init();
|
||||
void janet_line_deinit();
|
||||
static Janet cfun_get_eight(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_number(8.0);
|
||||
}
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer);
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv);
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{"get8", cfun_get_eight, NULL},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
#endif
|
||||
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, array_cfuns);
|
||||
}
|
||||
@@ -206,6 +206,10 @@
|
||||
(def 🐮 :cow)
|
||||
(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
|
||||
(assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa")
|
||||
(assert (= "\U01F637" "😷") "unicode escape 1")
|
||||
(assert (= "\u2623" "\U002623" "☣") "unicode escape 2")
|
||||
(assert (= "\u24c2" "\U0024c2" "Ⓜ") "unicode escape 3")
|
||||
(assert (= "\u0061" "a") "unicode escape 4")
|
||||
|
||||
# Symbols with @ character
|
||||
|
||||
@@ -250,6 +254,11 @@
|
||||
(assert (apply <= (merge @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3")
|
||||
(assert (apply <= (merge '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4")
|
||||
|
||||
(assert (deep= @[1 2 3 4 5] (sort @[5 3 4 1 2])) "sort 1")
|
||||
(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sort-by |($ :a) @[{:a 4} {:a 7} {:a 1}])) "sort 2")
|
||||
(assert (deep= @[1 2 3 4 5] (sorted [5 3 4 1 2])) "sort 3")
|
||||
(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sorted-by |($ :a) [{:a 4} {:a 7} {:a 1}])) "sort 4")
|
||||
|
||||
# Gensym tests
|
||||
|
||||
(assert (not= (gensym) (gensym)) "two gensyms not equal")
|
||||
@@ -319,5 +328,94 @@
|
||||
(assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values")
|
||||
(assert (= false ;(map truthy? [nil false])) "non-truthy values")
|
||||
|
||||
# Struct and Table duplicate elements
|
||||
(assert (= {:a 3 :b 2} {:a 1 :b 2 :a 3}) "struct literal duplicate keys")
|
||||
(assert (= {:a 3 :b 2} (struct :a 1 :b 2 :a 3)) "struct constructor duplicate keys")
|
||||
(assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys")
|
||||
(assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3)) "table constructor duplicate keys")
|
||||
|
||||
## Polymorphic comparison -- Issue #272
|
||||
|
||||
# confirm polymorphic comparison delegation to primitive comparators:
|
||||
(assert (= 0 (cmp 3 3)) "compare-primitive integers (1)")
|
||||
(assert (= -1 (cmp 3 5)) "compare-primitive integers (2)")
|
||||
(assert (= 1 (cmp "foo" "bar")) "compare-primitive strings")
|
||||
(assert (= 0 (compare 1 1)) "compare integers (1)")
|
||||
(assert (= -1 (compare 1 2)) "compare integers (2)")
|
||||
(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
|
||||
|
||||
(assert (compare< 1 2 3 4 5 6) "compare less than integers")
|
||||
(assert (not (compare> 1 2 3 4 5 6)) "compare not greater than integers")
|
||||
(assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
|
||||
(assert (compare> 6 5 4 3 2 1) "compare greater than integers")
|
||||
(assert (compare> 6.0 5.0 4.0 3.0 2.0 1.0) "compare greater than reals")
|
||||
(assert (not (compare< 6.0 5.0 4.0 3.0 2.0 1.0)) "compare less than reals")
|
||||
(assert (compare<= 1 2 3 3 4 5 6) "compare less than or equal to integers")
|
||||
(assert (compare<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "compare less than or equal to reals")
|
||||
(assert (compare>= 6 5 4 4 3 2 1) "compare greater than or equal to integers")
|
||||
(assert (compare>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "compare greater than or equal to reals")
|
||||
(assert (compare< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
"hi"
|
||||
(quote hello)
|
||||
:hello
|
||||
(array 1 2 3)
|
||||
(tuple 1 2 3)
|
||||
(table "a" "b" "c" "d")
|
||||
(struct 1 2 3 4)
|
||||
(buffer "hi")
|
||||
(fn [x] (+ x x))
|
||||
print) "compare type ordering")
|
||||
|
||||
# test polymorphic compare with 'objects' (table/setproto)
|
||||
(def mynum
|
||||
@{:type :mynum :v 0 :compare
|
||||
(fn [self other]
|
||||
(case (type other)
|
||||
:number (cmp (self :v) other)
|
||||
:table (when (= (get other :type) :mynum)
|
||||
(cmp (self :v) (other :v)))))})
|
||||
|
||||
(let [n3 (table/setproto @{:v 3} mynum)]
|
||||
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
|
||||
(assert (= -1 (compare n3 4)) "compare object to num (2)")
|
||||
(assert (= 1 (compare (table/setproto @{:v 4} mynum) n3)) "compare object to object")
|
||||
(assert (compare< 2 n3 4) "compare< poly")
|
||||
(assert (compare> 4 n3 2) "compare> poly")
|
||||
(assert (compare<= 2 3 n3 4) "compare<= poly")
|
||||
(assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
|
||||
(assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
|
||||
|
||||
(let [MAX_INT_64_STRING "9223372036854775807"
|
||||
MAX_UINT_64_STRING "18446744073709551615"
|
||||
MAX_INT_IN_DBL_STRING "9007199254740991"
|
||||
NAN (math/log -1)
|
||||
INF (/ 1 0)
|
||||
MINUS_INF (/ -1 0)
|
||||
compare-poly-tests
|
||||
[[(int/s64 3) (int/u64 3) 0]
|
||||
[(int/s64 -3) (int/u64 3) -1]
|
||||
[(int/s64 3) (int/u64 2) 1]
|
||||
[(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
|
||||
[(int/u64 3) 3 0] [(int/u64 3) 4 -1] [(int/u64 3) -9 1]
|
||||
[3 (int/s64 3) 0] [3 (int/s64 4) -1] [3 (int/s64 -5) 1]
|
||||
[3 (int/u64 3) 0] [3 (int/u64 4) -1] [3 (int/u64 2) 1]
|
||||
[(int/s64 MAX_INT_64_STRING) (int/u64 MAX_UINT_64_STRING) -1]
|
||||
[(int/s64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
|
||||
[(int/u64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
|
||||
[(+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING) 1]
|
||||
[(int/s64 0) INF -1] [(int/u64 0) INF -1]
|
||||
[MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
|
||||
[(int/s64 1) NAN 0] [NAN (int/u64 1) 0]]]
|
||||
(each [x y c] compare-poly-tests
|
||||
(assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c))))
|
||||
|
||||
(assert (= nil (any? [])) "any? 1")
|
||||
(assert (= nil (any? [false nil])) "any? 2")
|
||||
(assert (= nil (any? [nil false])) "any? 3")
|
||||
(assert (= 1 (any? [1])) "any? 4")
|
||||
(assert (nan? (any? [nil math/nan nil])) "any? 5")
|
||||
(assert (= true (any? [nil nil false nil nil true nil nil nil nil false :a nil])) "any? 6")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -212,13 +212,17 @@
|
||||
|
||||
(assert (= 7 (case :a :b 5 :c 6 :u 10 7)) "case with default")
|
||||
|
||||
# Testing the loop and for macros
|
||||
# Testing the loop and seq macros
|
||||
(def xs (apply tuple (seq [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
|
||||
(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "seq macro 1")
|
||||
|
||||
(def xs (apply tuple (seq [x :down [8 -2] :when (even? x)] (tuple (/ x 2) x))))
|
||||
(assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
|
||||
|
||||
# :range-to and :down-to
|
||||
(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x)) "loop :range-to")
|
||||
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x)) "loop :down-to")
|
||||
|
||||
# Some testing for not=
|
||||
(assert (not= 1 1 0) "not= 1")
|
||||
(assert (not= 0 1 1) "not= 2")
|
||||
@@ -255,4 +259,26 @@
|
||||
(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
|
||||
(assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
|
||||
|
||||
# Even and odd
|
||||
|
||||
(assert (odd? 9) "odd? 1")
|
||||
(assert (odd? -9) "odd? 2")
|
||||
(assert (not (odd? 10)) "odd? 3")
|
||||
(assert (not (odd? 0)) "odd? 4")
|
||||
(assert (not (odd? -10)) "odd? 5")
|
||||
(assert (not (odd? 1.1)) "odd? 6")
|
||||
(assert (not (odd? -0.1)) "odd? 7")
|
||||
(assert (not (odd? -1.1)) "odd? 8")
|
||||
(assert (not (odd? -1.6)) "odd? 9")
|
||||
|
||||
(assert (even? 10) "even? 1")
|
||||
(assert (even? -10) "even? 2")
|
||||
(assert (even? 0) "even? 3")
|
||||
(assert (not (even? 9)) "even? 4")
|
||||
(assert (not (even? -9)) "even? 5")
|
||||
(assert (not (even? 0.1)) "even? 6")
|
||||
(assert (not (even? -0.1)) "even? 7")
|
||||
(assert (not (even? -10.1)) "even? 8")
|
||||
(assert (not (even? -10.6)) "even? 9")
|
||||
|
||||
(end-suite)
|
||||
@@ -91,8 +91,8 @@
|
||||
# Assembly test
|
||||
# Fibonacci sequence, implemented with naive recursion.
|
||||
(def fibasm (asm '{
|
||||
arity 1
|
||||
bytecode [
|
||||
:arity 1
|
||||
:bytecode [
|
||||
(ltim 1 0 0x2) # $1 = $0 < 2
|
||||
(jmpif 1 :done) # if ($1) goto :done
|
||||
(lds 1) # $1 = self
|
||||
@@ -443,4 +443,26 @@
|
||||
(check-match redef-b "aabeef" false)
|
||||
(check-match redef-b "aaaaaa" false)
|
||||
|
||||
# Integer parsing
|
||||
|
||||
(check-deep '(int 1) "a" @[(chr "a")])
|
||||
(check-deep '(uint 1) "a" @[(chr "a")])
|
||||
(check-deep '(int-be 1) "a" @[(chr "a")])
|
||||
(check-deep '(uint-be 1) "a" @[(chr "a")])
|
||||
(check-deep '(int 1) "\xFF" @[-1])
|
||||
(check-deep '(uint 1) "\xFF" @[255])
|
||||
(check-deep '(int-be 1) "\xFF" @[-1])
|
||||
(check-deep '(uint-be 1) "\xFF" @[255])
|
||||
(check-deep '(int 2) "\xFF\x7f" @[0x7fff])
|
||||
(check-deep '(int-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint 2) "\xff\x7f" @[0x7fff])
|
||||
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
|
||||
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
|
||||
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
|
||||
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
|
||||
|
||||
(check-deep '(* (int 2) -1) "123" nil)
|
||||
|
||||
(end-suite)
|
||||
@@ -48,7 +48,9 @@
|
||||
(defn check-image
|
||||
"Run a marshaling test using the make-image and load-image functions."
|
||||
[x msg]
|
||||
(assert-no-error msg (load-image (make-image x))))
|
||||
(def im (make-image x))
|
||||
# (printf "\nimage-hash: %d" (-> im string hash))
|
||||
(assert-no-error msg (load-image im)))
|
||||
|
||||
(check-image (fn [] (fn [] 1)) "marshal nested functions")
|
||||
(check-image (fiber/new (fn [] (fn [] 1))) "marshal nested functions in fiber")
|
||||
@@ -58,6 +58,17 @@
|
||||
|
||||
(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
|
||||
|
||||
# Issue 408
|
||||
(assert-error :invalid-type (tarray/new :int32 10 1 0 (int/u64 7)) "tarray/new should only allow tarray or buffer for last argument")
|
||||
(def ta (tarray/new :int32 10))
|
||||
(assert (= (next a nil) 0) "tarray next 1")
|
||||
(assert (= (next a 0) 1) "tarray next 2")
|
||||
(assert (= (next a 8) 9) "tarray next 3")
|
||||
(assert (nil? (next a 9)) "tarray next 4")
|
||||
(put ta 3 7)
|
||||
(put ta 9 7)
|
||||
(assert (= 2 (count |(= $ 7) ta)) "tarray count")
|
||||
|
||||
# Array remove
|
||||
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
|
||||
@@ -72,9 +72,6 @@
|
||||
"trap INT64_MIN / -1"
|
||||
(:/ (int/s64 "-0x8000_0000_0000_0000") -1))
|
||||
|
||||
# in place operators
|
||||
(assert (let [a (u64 1e10)] (:+! a 1000000 "1000000" "0xffff") (:= a 10002065535)) "in place operators")
|
||||
|
||||
# int64 typed arrays
|
||||
(assert (let [t (tarray/new :int64 10)
|
||||
b (i64 1000)]
|
||||
@@ -167,6 +164,11 @@
|
||||
(defn test-expand [path temp]
|
||||
(string (module/expand-path path temp)))
|
||||
|
||||
# Right hand operators
|
||||
(assert (= (int/s64 (sum (range 10))) (sum (map int/s64 (range 10)))) "right hand operators 1")
|
||||
(assert (= (int/s64 (product (range 1 10))) (product (map int/s64 (range 1 10)))) "right hand operators 2")
|
||||
(assert (= (int/s64 15) (bor 10 (int/s64 5)) (bor (int/s64 10) 5)) "right hand operators 3")
|
||||
|
||||
(assert (= (test-expand "abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 1")
|
||||
(assert (= (test-expand "./abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 2")
|
||||
(assert (= (test-expand "abc/def.txt" ":cur:/:name:") "some-dir/def.txt") "module/expand-path 3")
|
||||
@@ -23,7 +23,6 @@
|
||||
|
||||
# Using a large test grammar
|
||||
|
||||
(def- core-env (table/getproto (fiber/getenv (fiber/current))))
|
||||
(def- specials {'fn true
|
||||
'var true
|
||||
'do true
|
||||
@@ -41,7 +40,7 @@
|
||||
(defn capture-sym
|
||||
[text]
|
||||
(def sym (symbol text))
|
||||
[(if (or (core-env sym) (specials sym)) :coresym :symbol) text])
|
||||
[(if (or (root-env sym) (specials sym)) :coresym :symbol) text])
|
||||
|
||||
(def grammar
|
||||
~{:ws (set " \v\t\r\f\n\0")
|
||||
@@ -226,6 +225,23 @@
|
||||
:week-day 3}
|
||||
(os/date 1388608200)) "os/date")
|
||||
|
||||
# OS mktime test
|
||||
|
||||
(assert (= 1388608200 (os/mktime {:year-day 0
|
||||
:minutes 30
|
||||
:month 0
|
||||
:dst false
|
||||
:seconds 0
|
||||
:year 2014
|
||||
:month-day 0
|
||||
:hours 20
|
||||
:week-day 3})) "os/mktime")
|
||||
|
||||
(def now (os/time))
|
||||
(assert (= (os/mktime (os/date now)) now) "UTC os/mktime")
|
||||
(assert (= (os/mktime (os/date now true) true) now) "local os/mktime")
|
||||
(assert (= (os/mktime {:year 1970}) 0) "os/mktime default values")
|
||||
|
||||
# Appending buffer to self
|
||||
|
||||
(with-dyns [:out @""]
|
||||
@@ -299,4 +315,9 @@
|
||||
|
||||
(assert (= 40 counter) "if-with 1")
|
||||
|
||||
(def a @[])
|
||||
(eachk x [:a :b :c :d]
|
||||
(array/push a x))
|
||||
(assert (deep= (range 4) a) "eachk 1")
|
||||
|
||||
(end-suite)
|
||||
352
test/suite0008.janet
Normal file
352
test/suite0008.janet
Normal file
@@ -0,0 +1,352 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
# sell copies of the Software, and to permit persons to whom the Software is
|
||||
# furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 8)
|
||||
|
||||
###
|
||||
### Compiling brainfuck to Janet.
|
||||
###
|
||||
|
||||
(def- bf-peg
|
||||
"Peg for compiling brainfuck into a Janet source ast."
|
||||
(peg/compile
|
||||
~{:+ (/ '(some "+") ,(fn [x] ~(+= (DATA POS) ,(length x))))
|
||||
:- (/ '(some "-") ,(fn [x] ~(-= (DATA POS) ,(length x))))
|
||||
:> (/ '(some ">") ,(fn [x] ~(+= POS ,(length x))))
|
||||
:< (/ '(some "<") ,(fn [x] ~(-= POS ,(length x))))
|
||||
:. (* "." (constant (prinf "%c" (get DATA POS))))
|
||||
:loop (/ (* "[" :main "]") ,(fn [& captures]
|
||||
~(while (not= (get DATA POS) 0)
|
||||
,;captures)))
|
||||
:main (any (+ :s :loop :+ :- :> :< :.))}))
|
||||
|
||||
(defn bf
|
||||
"Run brainfuck."
|
||||
[text]
|
||||
(eval
|
||||
~(let [DATA (array/new-filled 100 0)]
|
||||
(var POS 50)
|
||||
,;(peg/match bf-peg text))))
|
||||
|
||||
(defn test-bf
|
||||
"Test some bf for expected output."
|
||||
[input output]
|
||||
(def b @"")
|
||||
(with-dyns [:out b]
|
||||
(bf input))
|
||||
(assert (= (string output) (string b))
|
||||
(string "bf input '"
|
||||
input
|
||||
"' failed, expected "
|
||||
(describe output)
|
||||
", got "
|
||||
(describe (string b))
|
||||
".")))
|
||||
|
||||
(test-bf "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++." "Hello World!\n")
|
||||
|
||||
(test-bf ">++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>->
|
||||
+++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+."
|
||||
"Hello World!\n")
|
||||
|
||||
(test-bf "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---.>>.>.+++.------.>-.>>--."
|
||||
"Hello, World!")
|
||||
|
||||
# Prompts and Labels
|
||||
|
||||
(assert (= 10 (label a (for i 0 10 (if (= i 5) (return a 10))))) "label 1")
|
||||
|
||||
(defn recur
|
||||
[lab x y]
|
||||
(when (= x y) (return lab :done))
|
||||
(def res (label newlab (recur (or lab newlab) (+ x 1) y)))
|
||||
(if lab :oops res))
|
||||
(assert (= :done (recur nil 0 10)) "label 2")
|
||||
|
||||
(assert (= 10 (prompt :a (for i 0 10 (if (= i 5) (return :a 10))))) "prompt 1")
|
||||
|
||||
(defn- inner-loop
|
||||
[i]
|
||||
(if (= i 5)
|
||||
(return :a 10)))
|
||||
|
||||
(assert (= 10 (prompt :a (for i 0 10 (inner-loop i)))) "prompt 2")
|
||||
|
||||
(defn- inner-loop2
|
||||
[i]
|
||||
(try
|
||||
(if (= i 5)
|
||||
(error 10))
|
||||
([err] (return :a err))))
|
||||
|
||||
(assert (= 10 (prompt :a (for i 0 10 (inner-loop2 i)))) "prompt 3")
|
||||
|
||||
# Match checks
|
||||
|
||||
(assert (= :hi (match nil nil :hi)) "match 1")
|
||||
(assert (= :hi (match {:a :hi} {:a a} a)) "match 2")
|
||||
(assert (= nil (match {:a :hi} {:a a :b b} a)) "match 3")
|
||||
(assert (= nil (match [1 2] [a b c] a)) "match 4")
|
||||
(assert (= 2 (match [1 2] [a b] b)) "match 5")
|
||||
|
||||
# And/or checks
|
||||
|
||||
(assert (= false (and false false)) "and 1")
|
||||
(assert (= false (or false false)) "or 1")
|
||||
|
||||
# #300 Regression test
|
||||
|
||||
# Just don't segfault
|
||||
(assert (peg/match '{:main (replace "S" {"S" :spade})} "S7") "regression #300")
|
||||
|
||||
# Test cases for #293
|
||||
(assert (= :yes (match [1 2 3] [_ a _] :yes :no)) "match wildcard 1")
|
||||
(assert (= :no (match [1 2 3] [__ a __] :yes :no)) "match wildcard 2")
|
||||
(assert (= :yes (match [1 2 [1 2 3]] [_ a [_ _ _]] :yes :no)) "match wildcard 3")
|
||||
(assert (= :yes (match [1 2 3] (_ (even? 2)) :yes :no)) "match wildcard 4")
|
||||
(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
|
||||
(assert (= false (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} false :no)) "match wildcard 6")
|
||||
(assert (= nil (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} nil :no)) "match wildcard 7")
|
||||
|
||||
# Regression #301
|
||||
(def b (buffer/new-filled 128 0x78))
|
||||
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
|
||||
|
||||
(def a @"abcdefghijklm")
|
||||
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
|
||||
(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3")
|
||||
(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4")
|
||||
(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5")
|
||||
|
||||
# chr
|
||||
(assert (= (chr "a") 97) "chr 1")
|
||||
|
||||
# Detaching closure over non resumable fiber.
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(error [f1 f2]))
|
||||
(def [_ [f1 f2]] (protect (f1 @[0])))
|
||||
# At time of writing, mark phase can detach closure envs.
|
||||
(gccollect)
|
||||
(assert (= 1 (f1)) "detach-non-resumable-closure 1")
|
||||
(assert (= 2 (f2)) "detach-non-resumable-closure 2"))
|
||||
|
||||
# Marshal closure over non resumable fiber.
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(error [f1 f2]))
|
||||
(def [_ tup] (protect (f1 @[0])))
|
||||
(def [f1 f2] (unmarshal (marshal tup make-image-dict) load-image-dict))
|
||||
(assert (= 1 (f1)) "marshal-non-resumable-closure 1")
|
||||
(assert (= 2 (f2)) "marshal-non-resumable-closure 2"))
|
||||
|
||||
# Marshal closure over currently alive fiber.
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(marshal [f1 f2] make-image-dict))
|
||||
(def [f1 f2] (unmarshal (f1 @[0]) load-image-dict))
|
||||
(assert (= 1 (f1)) "marshal-live-closure 1")
|
||||
(assert (= 2 (f2)) "marshal-live-closure 2"))
|
||||
|
||||
(do
|
||||
(var a 1)
|
||||
(defn b [x] (+ a x))
|
||||
(def c (unmarshal (marshal b)))
|
||||
(assert (= 2 (c 1)) "marshal-on-stack-closure 1"))
|
||||
|
||||
# Reduce2
|
||||
|
||||
(assert (= (reduce + 0 (range 1 10)) (reduce2 + (range 10))) "reduce2 1")
|
||||
(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2 2")
|
||||
(assert (= nil (reduce2 * [])) "reduce2 3")
|
||||
|
||||
# Accumulate
|
||||
|
||||
(assert (deep= (accumulate + 0 (range 5)) @[0 1 3 6 10]) "accumulate 1")
|
||||
(assert (deep= (accumulate2 + (range 5)) @[0 1 3 6 10]) "accumulate2 1")
|
||||
(assert (deep= @[] (accumulate2 + [])) "accumulate2 2")
|
||||
(assert (deep= @[] (accumulate 0 + [])) "accumulate 2")
|
||||
|
||||
# Perm strings
|
||||
|
||||
(assert (= (os/perm-int "rwxrwxrwx") 8r777) "perm 1")
|
||||
(assert (= (os/perm-int "rwxr-xr-x") 8r755) "perm 2")
|
||||
(assert (= (os/perm-int "rw-r--r--") 8r644) "perm 3")
|
||||
|
||||
(assert (= (band (os/perm-int "rwxrwxrwx") 8r077) 8r077) "perm 4")
|
||||
(assert (= (band (os/perm-int "rwxr-xr-x") 8r077) 8r055) "perm 5")
|
||||
(assert (= (band (os/perm-int "rw-r--r--") 8r077) 8r044) "perm 6")
|
||||
|
||||
(assert (= (os/perm-string 8r777) "rwxrwxrwx") "perm 7")
|
||||
(assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8")
|
||||
(assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9")
|
||||
|
||||
# Issue #336 cases - don't segfault
|
||||
|
||||
(assert-error "unmarshal errors 1" (unmarshal @"\xd6\xb9\xb9"))
|
||||
(assert-error "unmarshal errors 2" (unmarshal @"\xd7bc"))
|
||||
(assert-error "unmarshal errors 3" (unmarshal "\xd3\x01\xd9\x01\x62\xcf\x03\x78\x79\x7a" load-image-dict))
|
||||
(assert-error "unmarshal errors 4"
|
||||
(unmarshal
|
||||
@"\xD7\xCD\0e/p\x98\0\0\x03\x01\x01\x01\x02\0\0\x04\0\xCEe/p../tools
|
||||
\0\0\0/afl\0\0\x01\0erate\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE
|
||||
\xA8\xDE\xDE\xDE\xDE\xDE\xDE\0\0\0\xDE\xDE_unmarshal_testcase3.ja
|
||||
neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
\0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict))
|
||||
|
||||
# No segfault, valgrind clean.
|
||||
|
||||
(def x @"\xCC\xCD.nd\x80\0\r\x1C\xCDg!\0\x07\xCC\xCD\r\x1Ce\x10\0\r;\xCDb\x04\xFF9\xFF\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04uu\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04}\x04\x04\x04\x04\x04\x04\x04\x04#\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x01\0\0\x03\x04\x04\x04\xE2\x03\x04\x04\x04\x04\x04\x04\x04\x04\x04\x14\x1A\x04\x04\x04\x04\x04\x18\x04\x04!\x04\xE2\x03\x04\x04\x04\x04\x04\x04$\x04\x04\x04\x04\x04\x04\x04\x04\x04\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04A\0\0\0\x03\0\0!\xBF\xFF")
|
||||
(assert-error "bad fiber status" (unmarshal x load-image-dict))
|
||||
(gccollect)
|
||||
(marshal x make-image-dict)
|
||||
|
||||
(def b @"\xCC\xCD\0\x03\0\x08\x04\rm\xCD\x7F\xFF\xFF\xFF\x02\0\x02\xD7\xCD\0\x98\0\0\x05\x01\x01\x01\x01\x08\xCE\x01f\xCE../tools/afl/generate_unmarshal_testcases.janet\xCE\x012,\x01\0\0&\x03\0\06\x02\x03\x03)\x03\x01\0*\x04\0\00\x03\x04\0>\x03\0\0\x03\x03\0\0*\x05\0\x11\0\x11\0\x05\0\x05\0\x05\0\x05\0\x05\xC9\xDA\x04\xC9\xC9\xC9")
|
||||
(unmarshal b load-image-dict)
|
||||
(gccollect)
|
||||
|
||||
(def v (unmarshal
|
||||
@"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
|
||||
load-image-dict))
|
||||
(gccollect)
|
||||
|
||||
# in vs get regression
|
||||
(assert (nil? (first @"")) "in vs get 1")
|
||||
(assert (nil? (last @"")) "in vs get 1")
|
||||
|
||||
# For undefined behavior sanitizer
|
||||
0xf&1fffFFFF
|
||||
|
||||
# Tuple comparison
|
||||
(assert (< [1 2 3] [2 2 3]) "tuple comparison 1")
|
||||
(assert (< [1 2 3] [2 2]) "tuple comparison 2")
|
||||
(assert (< [1 2 3] [2 2 3 4]) "tuple comparison 3")
|
||||
(assert (< [1 2 3] [1 2 3 4]) "tuple comparison 4")
|
||||
(assert (< [1 2 3] [1 2 3 -1]) "tuple comparison 5")
|
||||
(assert (> [1 2 3] [1 2]) "tuple comparison 6")
|
||||
|
||||
# Lenprefix rule
|
||||
|
||||
(def peg (peg/compile ~(* (lenprefix (/ (* '(any (if-not ":" 1)) ":") ,scan-number) 1) -1)))
|
||||
|
||||
(assert (peg/match peg "5:abcde") "lenprefix 1")
|
||||
(assert (not (peg/match peg "5:abcdef")) "lenprefix 2")
|
||||
(assert (not (peg/match peg "5:abcd")) "lenprefix 3")
|
||||
|
||||
# Packet capture
|
||||
|
||||
(def peg2
|
||||
(peg/compile
|
||||
~{# capture packet length in tag :header-len
|
||||
:packet-header (* (/ ':d+ ,scan-number :header-len) ":")
|
||||
|
||||
# capture n bytes from a backref :header-len
|
||||
:packet-body '(lenprefix (-> :header-len) 1)
|
||||
|
||||
# header, followed by body, and drop the :header-len capture
|
||||
:packet (/ (* :packet-header :packet-body) ,|$1)
|
||||
|
||||
# any exact seqence of packets (no extra characters)
|
||||
:main (* (any :packet) -1)}))
|
||||
|
||||
(assert (deep= @["a" "bb" "ccc"] (peg/match peg2 "1:a2:bb3:ccc")) "lenprefix 4")
|
||||
(assert (deep= @["a" "bb" "cccccc"] (peg/match peg2 "1:a2:bb6:cccccc")) "lenprefix 5")
|
||||
(assert (= nil (peg/match peg2 "1:a2:bb:5:cccccc")) "lenprefix 6")
|
||||
(assert (= nil (peg/match peg2 "1:a2:bb:7:cccccc")) "lenprefix 7")
|
||||
|
||||
# Regression #400
|
||||
(assert (= nil (while (and false false) (fn []) (error "should not happen"))) "strangeloop 1")
|
||||
(assert (= nil (while (not= nil nil) (fn []) (error "should not happen"))) "strangeloop 2")
|
||||
|
||||
# Issue #412
|
||||
(assert (peg/match '(* "a" (> -1 "a") "b") "abc") "lookhead does not move cursor")
|
||||
|
||||
(def peg3
|
||||
~{:main (* "(" (thru ")"))})
|
||||
|
||||
(def peg4 (peg/compile ~(* (thru "(") '(to ")"))))
|
||||
|
||||
(assert (peg/match peg3 "(12345)") "peg thru 1")
|
||||
(assert (not (peg/match peg3 " (12345)")) "peg thru 2")
|
||||
(assert (not (peg/match peg3 "(12345")) "peg thru 3")
|
||||
|
||||
(assert (= "abc" (0 (peg/match peg4 "123(abc)"))) "peg thru/to 1")
|
||||
(assert (= "abc" (0 (peg/match peg4 "(abc)"))) "peg thru/to 2")
|
||||
(assert (not (peg/match peg4 "123(abc")) "peg thru/to 3")
|
||||
|
||||
(def peg5 (peg/compile [3 "abc"]))
|
||||
|
||||
(assert (:match peg5 "abcabcabc") "repeat alias 1")
|
||||
(assert (:match peg5 "abcabcabcac") "repeat alias 2")
|
||||
(assert (not (:match peg5 "abcabc")) "repeat alias 3")
|
||||
|
||||
(defn check-jdn [x]
|
||||
(assert (deep= (parse (string/format "%j" x)) x) "round trip jdn"))
|
||||
|
||||
(check-jdn 0)
|
||||
(check-jdn nil)
|
||||
(check-jdn [])
|
||||
(check-jdn @[[] [] 1231 9.123123 -123123 0.1231231230001])
|
||||
(check-jdn -0.123123123123)
|
||||
(check-jdn 12837192371923)
|
||||
(check-jdn "a string")
|
||||
(check-jdn @"a buffer")
|
||||
|
||||
# Issue 428
|
||||
(var result nil)
|
||||
(defn f [] (yield {:a :ok}))
|
||||
(assert-no-error "issue 428 1" (loop [{:a x} :generate (fiber/new f)] (set result x)))
|
||||
(assert (= result :ok) "issue 428 2")
|
||||
|
||||
# Inline 3 argument get
|
||||
(assert (= 10 (do (var a 10) (set a (get '{} :a a)))) "inline get 1")
|
||||
|
||||
# Keyword and Symbol slice
|
||||
(assert (= :keyword (keyword/slice "some_keyword_slice" 5 12)) "keyword slice")
|
||||
(assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice")
|
||||
|
||||
# Peg find and find-all
|
||||
(def p "/usr/local/bin/janet")
|
||||
(assert (= (peg/find '"n/" p) 13) "peg find 1")
|
||||
(assert (not (peg/find '"t/" p)) "peg find 2")
|
||||
(assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all")
|
||||
|
||||
# Peg replace and replace-all
|
||||
(var ti 0)
|
||||
(defn check-replacer
|
||||
[x y z]
|
||||
(assert (= (string/replace x y z) (string (peg/replace x y z))) "replacer test replace")
|
||||
(assert (= (string/replace-all x y z) (string (peg/replace-all x y z))) "replacer test replace-all"))
|
||||
(check-replacer "abc" "Z" "abcabcabcabasciabsabc")
|
||||
(check-replacer "abc" "Z" "")
|
||||
(check-replacer "aba" "ZZZZZZ" "ababababababa")
|
||||
(check-replacer "aba" "" "ababababababa")
|
||||
|
||||
(end-suite)
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user