mirror of
https://github.com/janet-lang/janet
synced 2025-11-21 17:54:49 +00:00
Compare commits
558 Commits
0.1.0
...
configchec
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
3c304ddc35 | ||
|
|
ce9cd4fcef | ||
|
|
698e89aba4 | ||
|
|
4c8dd4b96c | ||
|
|
11998b3913 | ||
|
|
840610facf | ||
|
|
0280deccae | ||
|
|
4d5a95784a | ||
|
|
b43d93cf55 | ||
|
|
3f137ed0b1 | ||
|
|
5deb13d73e | ||
|
|
82a1c8635e | ||
|
|
010e2e4652 | ||
|
|
ddedae6831 | ||
|
|
6c63c4f129 | ||
|
|
802686e3df | ||
|
|
3be79e8735 | ||
|
|
a303704a7d | ||
|
|
b5e6c0b8fc | ||
|
|
98c46fcfb1 | ||
|
|
409da697dd | ||
|
|
91c3685705 | ||
|
|
411fc77ecf | ||
|
|
0378ba78cc | ||
|
|
55d8e8b56b | ||
|
|
97ad4c4f89 | ||
|
|
8de999c8f7 | ||
|
|
f444bd25ef | ||
|
|
43c0db4b0e | ||
|
|
8f168c600d | ||
|
|
ec43afb426 | ||
|
|
880049c0ee | ||
|
|
2b7ac16784 | ||
|
|
56d903d75b | ||
|
|
7054e878fb | ||
|
|
dde5351d11 | ||
|
|
7d49e3e6f1 | ||
|
|
30cb01e2f0 | ||
|
|
018e836ef5 | ||
|
|
7b25125431 | ||
|
|
0aa2f68793 | ||
|
|
516e031f67 | ||
|
|
3331f2fa02 | ||
|
|
dd1a199ebd | ||
|
|
f35b5765d6 | ||
|
|
8359044408 | ||
|
|
9f3dde3cc7 | ||
|
|
ad0f7d9b0d | ||
|
|
f647ac5631 | ||
|
|
e4c5eb4c76 | ||
|
|
dc9fc9c3f5 | ||
|
|
3b6a51df24 | ||
|
|
f2313b9959 | ||
|
|
805b3bbb88 | ||
|
|
232ea22dc5 | ||
|
|
3388acd2db | ||
|
|
52ab9fb475 | ||
|
|
c7dc3611bc | ||
|
|
7a313f6038 | ||
|
|
bbcfaf1289 | ||
|
|
bfb0cb331e | ||
|
|
1759252071 | ||
|
|
fff60b053b | ||
|
|
65ac17986a | ||
|
|
ff720f1320 | ||
|
|
5a28d8d1fa | ||
|
|
ea25766374 | ||
|
|
88b8418253 | ||
|
|
4fa1b28cad | ||
|
|
c70d59edee | ||
|
|
5694998382 | ||
|
|
1cfc7b3b0d | ||
|
|
03e3ecb0a1 | ||
|
|
f8935b0692 | ||
|
|
702b50b7a1 | ||
|
|
e7baa2ae3d | ||
|
|
bfb354b469 | ||
|
|
3c0f12ea4d | ||
|
|
25a93ac4a6 | ||
|
|
0bad523913 | ||
|
|
5b36199aea | ||
|
|
a474a640be | ||
|
|
f10028d41a | ||
|
|
eb4684a64d | ||
|
|
73b81e0253 | ||
|
|
027f106a56 | ||
|
|
20e94adb61 | ||
|
|
9100794cea | ||
|
|
4ddf90e301 | ||
|
|
d1eca1cf52 | ||
|
|
7918add47d | ||
|
|
513d551df6 | ||
|
|
ddaa5e34e6 | ||
|
|
208eb7520a | ||
|
|
2d7df6b78e | ||
|
|
7527142549 | ||
|
|
4e6193b67e | ||
|
|
4ded5e10a2 | ||
|
|
1596511175 | ||
|
|
d514eab627 | ||
|
|
5287007cd6 | ||
|
|
e5a56174e2 | ||
|
|
6c68c7a35f | ||
|
|
675c1030fd | ||
|
|
ed65d04b81 | ||
|
|
fa1c5c85b5 | ||
|
|
59c69e6896 | ||
|
|
ee35786c8f | ||
|
|
ec6e2cfd62 | ||
|
|
7d48e7fd1f | ||
|
|
0063e3a69d | ||
|
|
cd6c009c03 | ||
|
|
b15cf193a0 | ||
|
|
429dc70374 | ||
|
|
e50e77e5f9 | ||
|
|
2fdd6aa0f7 | ||
|
|
cc55364b21 | ||
|
|
71526d1d9b | ||
|
|
e239980da7 | ||
|
|
1709bce77e | ||
|
|
d6ba2de888 | ||
|
|
61c0a4bc87 | ||
|
|
8af28d3fa5 | ||
|
|
970923d0e5 | ||
|
|
5d7dc0a57c | ||
|
|
c5090606a4 | ||
|
|
bf2d9ae634 | ||
|
|
871a58e1db | ||
|
|
53c7f2eedd | ||
|
|
bfd3845218 | ||
|
|
22d75d017f | ||
|
|
37e6ea0a23 | ||
|
|
10769f6f2e | ||
|
|
082639319e | ||
|
|
f20ad34c76 | ||
|
|
c045eadefa | ||
|
|
e2337b2ec4 | ||
|
|
90c5d12613 | ||
|
|
6016662807 | ||
|
|
2c9195b507 | ||
|
|
b47c48b59a | ||
|
|
98758b68ab | ||
|
|
7f1b5d4d70 | ||
|
|
25aa7a26c5 | ||
|
|
cb2caecbb3 | ||
|
|
1e299632e4 | ||
|
|
94a2084723 | ||
|
|
22e24fb47b | ||
|
|
93f0d5f626 | ||
|
|
bad040665f | ||
|
|
a07d76b264 | ||
|
|
1db6d0e0bc | ||
|
|
34849ea7b3 | ||
|
|
5a9f7c3a85 | ||
|
|
15c6300608 | ||
|
|
c6a4485623 | ||
|
|
090c6ac975 | ||
|
|
319575c864 | ||
|
|
42a0af3b1b | ||
|
|
9bc899ccf2 | ||
|
|
d29e3a1199 | ||
|
|
41bb6a9833 | ||
|
|
95e54c66b6 | ||
|
|
31e2415bbb | ||
|
|
2a5234b390 | ||
|
|
ad5b0a371e | ||
|
|
ba4dd9b5bb | ||
|
|
d42bdf2443 | ||
|
|
a246877c1e | ||
|
|
98e68a5cb4 | ||
|
|
e12aace02c | ||
|
|
51a9c7104d | ||
|
|
75dc08ff21 | ||
|
|
6fa60820a3 | ||
|
|
609a9621af | ||
|
|
8ba1121161 | ||
|
|
9a080197e7 | ||
|
|
e65375277a | ||
|
|
4a111b38b1 | ||
|
|
a363dce943 | ||
|
|
687a3c91f5 | ||
|
|
951aa0d8cd | ||
|
|
a61b59be87 | ||
|
|
91f3c17a5b | ||
|
|
0382dc976b | ||
|
|
69dcab2b55 | ||
|
|
c4f6f1d256 | ||
|
|
b57e530553 | ||
|
|
021b71ad62 | ||
|
|
0ee2ff1b05 | ||
|
|
adaa014d7c | ||
|
|
dc9dc98e80 | ||
|
|
4a2d4f52b5 | ||
|
|
8d37e544ab | ||
|
|
b07adce2b9 | ||
|
|
624be87c97 | ||
|
|
1b9591b5e3 | ||
|
|
a4cc23971f | ||
|
|
9ed1c35d30 | ||
|
|
6158ec0ce5 | ||
|
|
009bed158b | ||
|
|
402dc2a767 | ||
|
|
b5eb888af6 | ||
|
|
172261b89f | ||
|
|
8cc2c964c1 | ||
|
|
efbb704247 | ||
|
|
7fef5be3af | ||
|
|
1753f8bc18 | ||
|
|
235019ec39 | ||
|
|
7d17159ae4 | ||
|
|
56d7d4ef39 | ||
|
|
77c379faa8 | ||
|
|
3014a59c3e | ||
|
|
d70049dbb1 | ||
|
|
4713219317 | ||
|
|
36f92db61e | ||
|
|
59393fc73b | ||
|
|
3eb44f1f79 | ||
|
|
fb5119bf43 | ||
|
|
febfefa4b2 | ||
|
|
632b920e97 | ||
|
|
c81bf42f6b | ||
|
|
4147c0ce1f | ||
|
|
602e30a421 | ||
|
|
92a5567b4a | ||
|
|
9495be328c | ||
|
|
0eae75a5c2 | ||
|
|
8e0d7f2539 | ||
|
|
9c1c7fb384 | ||
|
|
af48912f11 | ||
|
|
327d2ed849 | ||
|
|
db64a682be | ||
|
|
4d3c655058 | ||
|
|
2becebce92 | ||
|
|
0cc6c6ff33 | ||
|
|
115bc6140b | ||
|
|
b14fcb068b | ||
|
|
2ea28f29b0 | ||
|
|
7cb1c7cef2 | ||
|
|
9d60e8b343 | ||
|
|
340a6c4d8d | ||
|
|
e5a4c6fc2b | ||
|
|
db9ac6dba5 | ||
|
|
d570aae817 | ||
|
|
59e4b15fad | ||
|
|
b3401381fa | ||
|
|
beed839d12 | ||
|
|
f4908ebc41 | ||
|
|
1147482e62 | ||
|
|
4d07176f1c | ||
|
|
8c67bf82f6 | ||
|
|
0823eb7327 | ||
|
|
8cff3dd2c3 | ||
|
|
df550efb6b | ||
|
|
00a47dc0cb | ||
|
|
811b1825cb | ||
|
|
2ca252bc0e | ||
|
|
6054858359 | ||
|
|
1d50fd9485 | ||
|
|
a982f351d7 | ||
|
|
27a274b686 | ||
|
|
cb002e7b84 | ||
|
|
c022a1cf1a | ||
|
|
9d4effc02e | ||
|
|
7c19ed8a48 | ||
|
|
ef5f80ad38 | ||
|
|
dbcbb4466d | ||
|
|
7927078b49 | ||
|
|
b61c9eb991 | ||
|
|
ed72dcf82d | ||
|
|
9480ad24cc | ||
|
|
a9574b692f | ||
|
|
8d9a88e759 | ||
|
|
732de8f88d | ||
|
|
6af5800d21 | ||
|
|
540b326c54 | ||
|
|
660a2b41ae | ||
|
|
d2d502b9ae | ||
|
|
3aae524964 | ||
|
|
07912f5ab2 | ||
|
|
ffc14f6019 | ||
|
|
1e70c97ef0 | ||
|
|
54227ebff1 | ||
|
|
33087fe9de | ||
|
|
6d5ff43de7 | ||
|
|
c715912ea3 | ||
|
|
3b6ff3c09a | ||
|
|
efab484fff | ||
|
|
4ba7fbb8bb | ||
|
|
53cc7ebd29 | ||
|
|
c6f032340a | ||
|
|
0ce5acec89 | ||
|
|
44e31cac5d | ||
|
|
029394db31 | ||
|
|
00020ba8ab | ||
|
|
1f91ee30fe | ||
|
|
0f0c415bcf | ||
|
|
a6f022a73d | ||
|
|
ec02d55145 | ||
|
|
cb1a773ca8 | ||
|
|
0dc1217d69 | ||
|
|
06f38d3380 | ||
|
|
2e1ec3700d | ||
|
|
9e6b1d1b16 | ||
|
|
bdf03b4706 | ||
|
|
4d96ba3ba9 | ||
|
|
f161002390 | ||
|
|
eb576d6caf | ||
|
|
e0d26629e0 | ||
|
|
17783c3c3e | ||
|
|
c64e92a5de | ||
|
|
291c13bafc | ||
|
|
c6672e62ac | ||
|
|
eb9bd38256 | ||
|
|
3ac6b2335a | ||
|
|
c6edf03ae8 | ||
|
|
5020a1bae9 | ||
|
|
86ba69c16b | ||
|
|
5f70024f87 | ||
|
|
9ff819a4a1 | ||
|
|
1244e2e93b | ||
|
|
b61d1a0a0e | ||
|
|
89ef4eb634 | ||
|
|
114a45306d | ||
|
|
fe27df528c | ||
|
|
8ab60e475a | ||
|
|
6321c30cb1 | ||
|
|
8343c9edd1 | ||
|
|
74e1a3273f | ||
|
|
1394dbbd57 | ||
|
|
f6a3853131 | ||
|
|
49465f71f3 | ||
|
|
960cf76eb5 | ||
|
|
1b735564fa | ||
|
|
7ae01d25dd | ||
|
|
cb5263d2d8 | ||
|
|
602092f6d5 | ||
|
|
d3a067a665 | ||
|
|
98a26f5ce3 | ||
|
|
09d9dca5f5 | ||
|
|
8a3f512746 | ||
|
|
19e59705b9 | ||
|
|
367c9da856 | ||
|
|
4bcf6565cd | ||
|
|
0c950d0846 | ||
|
|
7ba925c50a | ||
|
|
cb3b9dd76f | ||
|
|
f4fa55027b | ||
|
|
0fe11adb9c | ||
|
|
b138ee6e8e | ||
|
|
a66f19f636 | ||
|
|
c76f4e89d8 | ||
|
|
85a211b26b | ||
|
|
fe3620529f | ||
|
|
a7551e9b4e | ||
|
|
46c540b93e | ||
|
|
32c209ede9 | ||
|
|
0d293cd3f5 | ||
|
|
f284776490 | ||
|
|
38a7e4faf1 | ||
|
|
c333cbfa55 | ||
|
|
f72aa64f41 | ||
|
|
d85892edc8 | ||
|
|
56383b2ecc | ||
|
|
0d729eaab1 | ||
|
|
17ab654ccb | ||
|
|
872d03ae1d | ||
|
|
ee5fa54134 | ||
|
|
68e00cdb7a | ||
|
|
5bf9e4fc89 | ||
|
|
7350bf5dd9 | ||
|
|
e755f98300 | ||
|
|
8ee2f0a1d6 | ||
|
|
0726de34ff | ||
|
|
00301ad26b | ||
|
|
611543c48b | ||
|
|
4d81fbc238 | ||
|
|
c5012ca4c1 | ||
|
|
e68a889fa9 | ||
|
|
795e7a9de8 | ||
|
|
090a6a8c5c | ||
|
|
2bbf9fdcc5 | ||
|
|
0025f6ac87 | ||
|
|
737b2449f0 | ||
|
|
f7a0133eb1 | ||
|
|
48b179d67e | ||
|
|
d1a075b2a6 | ||
|
|
2bad24371d | ||
|
|
bf8d5da3dc | ||
|
|
4a6fcb5e23 | ||
|
|
5ba969f91d | ||
|
|
26818a5e5c | ||
|
|
b84b0e4828 | ||
|
|
b4934ceddc | ||
|
|
c4114fbcdb | ||
|
|
95f2bbe0a0 | ||
|
|
63137b8107 | ||
|
|
2c1b506213 | ||
|
|
612a245961 | ||
|
|
4b8edef58c | ||
|
|
82cddef5bb | ||
|
|
d0fc29338c | ||
|
|
4eeadd7463 | ||
|
|
f0fcdf6bc5 | ||
|
|
2a333f8359 | ||
|
|
0dd867d508 | ||
|
|
e3f902cb8a | ||
|
|
c651b6f67c | ||
|
|
3a9b50ea4a | ||
|
|
1304f9263b | ||
|
|
90313afd40 | ||
|
|
99f176f37b | ||
|
|
d0ec89c7c1 | ||
|
|
170e785b72 | ||
|
|
e53778d5d8 | ||
|
|
192705113e | ||
|
|
97a42ea17b | ||
|
|
2cd489b9d4 | ||
|
|
ff0d3a0081 | ||
|
|
282c02c475 | ||
|
|
798c88b4c8 | ||
|
|
83f4a11bf3 | ||
|
|
d7626f8c57 | ||
|
|
1efca2ebe7 | ||
|
|
40845b5c1b | ||
|
|
84fb07dd5a | ||
|
|
62cb3f81fe | ||
|
|
16ebb11181 | ||
|
|
115ed9cbb9 | ||
|
|
3ae6f64de5 | ||
|
|
ff3f7487a4 | ||
|
|
f0afb3c311 | ||
|
|
5b1a3b8208 | ||
|
|
b1e0849a2f | ||
|
|
67f26b7d72 | ||
|
|
d5bab72620 | ||
|
|
aa079e3145 | ||
|
|
d64a57297d | ||
|
|
be85196de8 | ||
|
|
eae4e0dede | ||
|
|
92e9e64945 | ||
|
|
63dd6d03f4 | ||
|
|
2a79d2e749 | ||
|
|
6f3bc3d577 | ||
|
|
ef5eed2c21 | ||
|
|
5865692401 | ||
|
|
b626e73d19 | ||
|
|
b535c91ee1 | ||
|
|
7b28032f5c | ||
|
|
0fdd404a71 | ||
|
|
1f98eff33a | ||
|
|
338b31f5a2 | ||
|
|
b60e3e302a | ||
|
|
5b62c8e6db | ||
|
|
cd6a7793e8 | ||
|
|
5afb00859a | ||
|
|
001917f8d9 | ||
|
|
b9c0fc8201 | ||
|
|
d8b0a5ed01 | ||
|
|
5fa96a6f8c | ||
|
|
dd3fc24a1e | ||
|
|
ddba0010b0 | ||
|
|
337a498edb | ||
|
|
5fff36d047 | ||
|
|
a679f60e07 | ||
|
|
58d480539c | ||
|
|
6afaacf2af | ||
|
|
e9c94598e6 | ||
|
|
29ec30c79f | ||
|
|
122312dbf6 | ||
|
|
618f8d6818 | ||
|
|
0d4ab7dee0 | ||
|
|
6b4824c2ab | ||
|
|
8dde89126e | ||
|
|
56927e1b81 | ||
|
|
9e6254bf56 | ||
|
|
fe22a8db39 | ||
|
|
d724c5b959 | ||
|
|
ca9c017ec4 | ||
|
|
65be318306 | ||
|
|
7c4671d98f | ||
|
|
7880d73201 | ||
|
|
00f0f628e8 | ||
|
|
21b7583a7c | ||
|
|
42c6aca526 | ||
|
|
52b8781684 | ||
|
|
5d39570ec9 | ||
|
|
28331ad6ab | ||
|
|
129ec1e3c5 | ||
|
|
bdcd3a3dbf | ||
|
|
6c8f49206d | ||
|
|
b06f7226c4 | ||
|
|
2bcedd5920 | ||
|
|
5c84f0f5d9 | ||
|
|
424073bbb8 | ||
|
|
e9a80d4e4a | ||
|
|
1ec7f04642 | ||
|
|
59f6c335ad | ||
|
|
6b95326d7c | ||
|
|
5a3190d471 | ||
|
|
e7a8958c63 | ||
|
|
017ee2b0d1 | ||
|
|
a7933f5f08 | ||
|
|
be7fc79b6f | ||
|
|
6c8da9fe5c | ||
|
|
17283241ab | ||
|
|
2c94aa1a6a | ||
|
|
e5d2752329 | ||
|
|
70b4c8ae84 | ||
|
|
876a68f620 | ||
|
|
6c91e5fae0 | ||
|
|
55c091e898 | ||
|
|
3f5ba64f30 | ||
|
|
3bd7787efa | ||
|
|
39198de60a | ||
|
|
9723ddb96b | ||
|
|
02673dd791 | ||
|
|
ac9935c95f | ||
|
|
cc5b4eac0a | ||
|
|
77ea11c603 | ||
|
|
003472354d | ||
|
|
131ee29190 | ||
|
|
05a957c524 | ||
|
|
99e14a9b70 | ||
|
|
03dbd79165 | ||
|
|
f7a25ecae3 | ||
|
|
22e49bc0fc | ||
|
|
696866ae51 | ||
|
|
8333c22e8a | ||
|
|
e286e82144 | ||
|
|
8a5ede21f7 | ||
|
|
a412eecd36 | ||
|
|
24b9ae7820 | ||
|
|
7484a396ac | ||
|
|
79184ab05d | ||
|
|
fb6dd2c83f | ||
|
|
b2146a4c1d | ||
|
|
df13a8b967 | ||
|
|
dfb771700a | ||
|
|
56e5c19aa9 | ||
|
|
e8c0dcd14e | ||
|
|
f444bdd052 | ||
|
|
090068c784 | ||
|
|
85a190b971 | ||
|
|
3437880c78 | ||
|
|
4b01409d2d | ||
|
|
f0e125b304 | ||
|
|
e4503df8b6 | ||
|
|
db0313b379 | ||
|
|
cd16888beb | ||
|
|
49dd75b0e5 | ||
|
|
2abd97d095 | ||
|
|
34a69d0318 | ||
|
|
a77ce76928 | ||
|
|
c971d8ab6e | ||
|
|
0a15539d7b | ||
|
|
21d4b8fe1f | ||
|
|
6f64b0c152 |
@@ -1,11 +1,12 @@
|
|||||||
image: freebsd
|
image: freebsd/latest
|
||||||
packages:
|
packages:
|
||||||
- gmake
|
- gmake
|
||||||
- gcc
|
- gcc
|
||||||
sources:
|
|
||||||
- https://github.com/bakpakin/janet.git
|
|
||||||
tasks:
|
tasks:
|
||||||
- build: |
|
- build: |
|
||||||
cd janet
|
cd janet
|
||||||
gmake CC=gcc
|
gmake CC=gcc
|
||||||
gmake test CC=gcc
|
gmake test CC=gcc
|
||||||
|
sudo gmake install CC=gcc
|
||||||
|
gmake test-install CC=gcc
|
||||||
|
gmake test-amalg CC=gcc
|
||||||
|
|||||||
11
.builds/.openbsd.yaml
Normal file
11
.builds/.openbsd.yaml
Normal file
@@ -0,0 +1,11 @@
|
|||||||
|
image: openbsd/6.5
|
||||||
|
packages:
|
||||||
|
- gmake
|
||||||
|
tasks:
|
||||||
|
- build: |
|
||||||
|
cd janet
|
||||||
|
gmake
|
||||||
|
gmake test
|
||||||
|
doas gmake install
|
||||||
|
gmake test-install
|
||||||
|
gmake test-amalg
|
||||||
2
.gitattributes
vendored
Normal file
2
.gitattributes
vendored
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
# Use an approximate language for syntax highlighting (clojure is pretty close)
|
||||||
|
*.janet linguist-language=clojure
|
||||||
13
.gitignore
vendored
13
.gitignore
vendored
@@ -4,12 +4,24 @@ dst
|
|||||||
janet
|
janet
|
||||||
!*/**/janet
|
!*/**/janet
|
||||||
/build
|
/build
|
||||||
|
/builddir
|
||||||
/Build
|
/Build
|
||||||
/Release
|
/Release
|
||||||
/Debug
|
/Debug
|
||||||
/Emscripten
|
/Emscripten
|
||||||
/src/include/generated/*.h
|
/src/include/generated/*.h
|
||||||
janet-*.tar.gz
|
janet-*.tar.gz
|
||||||
|
dist
|
||||||
|
|
||||||
|
# VSCode
|
||||||
|
.vscode
|
||||||
|
|
||||||
|
# Eclipse
|
||||||
|
.project
|
||||||
|
.cproject
|
||||||
|
|
||||||
|
# Local directory for testing
|
||||||
|
local
|
||||||
|
|
||||||
# Emscripten
|
# Emscripten
|
||||||
*.bc
|
*.bc
|
||||||
@@ -38,6 +50,7 @@ tags
|
|||||||
|
|
||||||
# Valgrind files
|
# Valgrind files
|
||||||
vgcore.*
|
vgcore.*
|
||||||
|
*.out.*
|
||||||
|
|
||||||
# Created by https://www.gitignore.io/api/c
|
# Created by https://www.gitignore.io/api/c
|
||||||
|
|
||||||
|
|||||||
@@ -2,7 +2,10 @@ language: c
|
|||||||
script:
|
script:
|
||||||
- make
|
- make
|
||||||
- make test
|
- make test
|
||||||
- make janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
- sudo make install
|
||||||
|
- make test-install
|
||||||
|
- make test-amalg
|
||||||
|
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||||
compiler:
|
compiler:
|
||||||
- clang
|
- clang
|
||||||
- gcc
|
- gcc
|
||||||
@@ -14,10 +17,10 @@ deploy:
|
|||||||
provider: releases
|
provider: releases
|
||||||
api_key:
|
api_key:
|
||||||
secure: JSqAOTH1jmfVlbOuPO3BbY1BhPq+ddiBNPCxuAyKHoVwfO4eNAmq9COI+UwCMWY3dg+YlspufRwkHj//B7QQ6hPbSsKu+Mapu6gr/CAE/jxbfO/E98LkIkUwbGjplwtzw2kiBkHN/Bu6J5X76cwo4D8nwQ1JIcV3nWtoG87t7H4W0R4AYQkbLGAPylgUFr11YMPx2cRBBqCdLAGIrny7kQ/0cRBfkN81R/gUJv/q3OjmUvY7sALXp7mFdZb75QPSilKIDuVUU5hLvPYTeRl6cWI/M+m5SmGZx1rjv5S9Qaw070XoNyt9JAADtbOUnADKvDguDZIP1FCuT1Gb+cnJPzrvk6+OBU9s8UjCTFtgV+LKlhmRZcwV5YQBE94PKRMJNC6VvIWM7UeQ8Zhm1jmQS6ONNWbuoUAlkZP57NtDQa2x0GT2wkubNSQKlaY+6/gwTD9KAJIzaZG7HYXH7b+4g7VbccCyhDAtDZtXgrOIS4WAkNc8rWezRO4H0qHMyON9aCEb0eTE8hWIufbx6ymG4gUxnYO+AkrEYMCwQvU6lS8BsevkaMTVtSShqlQtJ9FRlmJA3MA2ONyqzQXJENqRydyVbpFrKSv+0HbMyhEc5BoKbt0QcTh/slouNV4eASNar/GKN7aP8XKGUeMwIoCcRpP+3ehmwX9SUw7Ah5S42pA=
|
secure: JSqAOTH1jmfVlbOuPO3BbY1BhPq+ddiBNPCxuAyKHoVwfO4eNAmq9COI+UwCMWY3dg+YlspufRwkHj//B7QQ6hPbSsKu+Mapu6gr/CAE/jxbfO/E98LkIkUwbGjplwtzw2kiBkHN/Bu6J5X76cwo4D8nwQ1JIcV3nWtoG87t7H4W0R4AYQkbLGAPylgUFr11YMPx2cRBBqCdLAGIrny7kQ/0cRBfkN81R/gUJv/q3OjmUvY7sALXp7mFdZb75QPSilKIDuVUU5hLvPYTeRl6cWI/M+m5SmGZx1rjv5S9Qaw070XoNyt9JAADtbOUnADKvDguDZIP1FCuT1Gb+cnJPzrvk6+OBU9s8UjCTFtgV+LKlhmRZcwV5YQBE94PKRMJNC6VvIWM7UeQ8Zhm1jmQS6ONNWbuoUAlkZP57NtDQa2x0GT2wkubNSQKlaY+6/gwTD9KAJIzaZG7HYXH7b+4g7VbccCyhDAtDZtXgrOIS4WAkNc8rWezRO4H0qHMyON9aCEb0eTE8hWIufbx6ymG4gUxnYO+AkrEYMCwQvU6lS8BsevkaMTVtSShqlQtJ9FRlmJA3MA2ONyqzQXJENqRydyVbpFrKSv+0HbMyhEc5BoKbt0QcTh/slouNV4eASNar/GKN7aP8XKGUeMwIoCcRpP+3ehmwX9SUw7Ah5S42pA=
|
||||||
file: janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
file: build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||||
draft: true
|
draft: true
|
||||||
skip_cleanup: true
|
skip_cleanup: true
|
||||||
on:
|
on:
|
||||||
tags: true
|
tags: true
|
||||||
repo: bakpakin/janet
|
repo: janet-lang/janet
|
||||||
condition: "$CC = clang"
|
condition: "$CC = clang"
|
||||||
|
|||||||
88
CHANGELOG.md
Normal file
88
CHANGELOG.md
Normal file
@@ -0,0 +1,88 @@
|
|||||||
|
# Changelog
|
||||||
|
All notable changes to this project will be documented in this file.
|
||||||
|
|
||||||
|
## 1.0.0 - ??
|
||||||
|
|
||||||
|
- Add optional filters to `module/paths` to further refine import methods.
|
||||||
|
- Add keyword arguments via `&keys` in parameter list.
|
||||||
|
- Add `-k` flag for flychecking source.
|
||||||
|
- Change signature to `compile` function.
|
||||||
|
- Add `module/loaders` for custom loading functions.
|
||||||
|
- Add external unification to `match` macro.
|
||||||
|
- Add static library to main build.
|
||||||
|
- Add `janet/*headerpath*` and change location of installed headers.
|
||||||
|
- Let `partition` take strings.
|
||||||
|
- Haiku OS support
|
||||||
|
- Add `string/trim`, `string/trimr`, and `string/triml`.
|
||||||
|
- Add `dofile` function.
|
||||||
|
- Numbers require at least 1 significant digit.
|
||||||
|
- `file/read` will return nil on end of file.
|
||||||
|
- Fix various bugs.
|
||||||
|
|
||||||
|
## 0.5.0 - 2019-05-09
|
||||||
|
- Fix some bugs with buffers.
|
||||||
|
- Add `trace` and `untrace` to the core library.
|
||||||
|
- Add `string/has-prefix?` and `string/has-suffix?` to string module.
|
||||||
|
- Add simple debugger to repl that activates on errors or debug signal
|
||||||
|
- Remove `*env*` and `*doc-width*`.
|
||||||
|
- Add `fiber/getenv`, `fiber/setenv`, and `dyn`, and `setdyn`.
|
||||||
|
- Add support for dynamic bindings (via the `dyn` and `setdyn` functions).
|
||||||
|
- Change signatures of some functions like `eval` which no longer takes
|
||||||
|
an optional environment.
|
||||||
|
- Add printf function
|
||||||
|
- Make `pp` configurable with dynamic binding `:pretty-format`.
|
||||||
|
- Remove the `meta` function.
|
||||||
|
- Add `with-dyns` for blocks with dynamic bindings assigned.
|
||||||
|
- Allow leading and trailing newlines in backtick-delimited string (long strings).
|
||||||
|
These newlines will not be included in the actual string value.
|
||||||
|
|
||||||
|
## 0.4.1 - 2019-04-14
|
||||||
|
- Squash some bugs
|
||||||
|
- Peg patterns can now make captures in any position in a grammar.
|
||||||
|
- Add color to repl output
|
||||||
|
- Add array/remove function
|
||||||
|
- Add meson build support
|
||||||
|
- Add int module for int types
|
||||||
|
- Add meson build option
|
||||||
|
- Add (break) special form and improve loop macro
|
||||||
|
- Allow abstract types to specify custom tostring method
|
||||||
|
- Extend C API for marshalling abstract types and other values
|
||||||
|
- Add functions to `os` module.
|
||||||
|
|
||||||
|
## 0.4.0 - 2019-03-08
|
||||||
|
- Fix a number of smaller bugs
|
||||||
|
- Added :export option to import and require
|
||||||
|
- Added typed arrays
|
||||||
|
- Remove `callable?`.
|
||||||
|
- Remove `tuple/append` and `tuple/prepend`, which may have seemed like `O(1)`
|
||||||
|
operations. Instead, use the `splice` special to extend tuples.
|
||||||
|
- Add `-m` flag to main client to allow specifying where to load
|
||||||
|
system modules from.
|
||||||
|
- Add `-c` flag to main client to allow compiling Janet modules to images.
|
||||||
|
- Add `string/format` and `buffer/format`.
|
||||||
|
- Remove `string/pretty` and `string/number`.
|
||||||
|
- `make-image` function creates pre compiled images for janet. These images
|
||||||
|
link to the core library. They can be loaded via require or manually via
|
||||||
|
`load-image`.
|
||||||
|
- Add bracketed tuples as tuple constructor.
|
||||||
|
- Add partition function to core library.
|
||||||
|
- Pre-compile core library into an image for faster startup.
|
||||||
|
- Add methods to parser values that mirror the api.
|
||||||
|
- Add janet\_getmethod to CAPI for easier use of method like syntax.
|
||||||
|
- Add get/set to abstract types to allow them to behave more
|
||||||
|
like objects with methods.
|
||||||
|
- Add parser/insert to modify parser state programmatically
|
||||||
|
- Add debug/stacktrace for easy, pretty stacktraces
|
||||||
|
- Remove the status-pp function
|
||||||
|
- Update API to run-context to be much more sane
|
||||||
|
- Add :lflags option to cook/make-native
|
||||||
|
- Disallow NaNs as table or struct keys
|
||||||
|
- Update module resolution paths and format
|
||||||
|
|
||||||
|
## 0.3.0 - 2019-26-01
|
||||||
|
- Add amalgamated build to janet for easier embedding.
|
||||||
|
- Add os/date function
|
||||||
|
- Add slurp and spit to core library.
|
||||||
|
- Added this changelog.
|
||||||
|
- Added peg module (Parsing Expression Grammars)
|
||||||
|
- Move hand written documentation into website repository.
|
||||||
@@ -29,10 +29,42 @@ may require changes before being merged.
|
|||||||
run tests with `make test`. If you want to add a new test suite, simply add a file to
|
run tests with `make test`. If you want to add a new test suite, simply add a file to
|
||||||
the test folder and make sure it is run when`make test` is invoked.
|
the test folder and make sure it is run when`make test` is invoked.
|
||||||
* Be consistent with the style. For C this means follow the indentation and style in
|
* Be consistent with the style. For C this means follow the indentation and style in
|
||||||
other files (files have MIT license at top, 4 spaces indentation, no trailing whitespace, cuddled brackets, etc.)
|
other files (files have MIT license at top, 4 spaces indentation, no trailing
|
||||||
|
whitespace, cuddled brackets, etc.) Use `make format` to
|
||||||
|
automatically format your C code with
|
||||||
|
[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
|
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.
|
do this indentation, or approximate as close as possible.
|
||||||
|
|
||||||
|
## C style
|
||||||
|
|
||||||
|
For changes to the VM and Core code, you will probably need to know C. Janet is programmed with
|
||||||
|
a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following
|
||||||
|
omissions.
|
||||||
|
|
||||||
|
* No `restrict`
|
||||||
|
* Certain functions in the standard library are not always available
|
||||||
|
|
||||||
|
In practice, this means programming for both MSVC on one hand and everything else on the other.
|
||||||
|
The code must also build with emscripten, even if some features are not available, although
|
||||||
|
this is not a priority.
|
||||||
|
|
||||||
|
Code should compile warning free and run valgrind clean. I find that these two criteria are some
|
||||||
|
of the easiest ways to protect against a large number of bugs in an unsafe language like C. To check for
|
||||||
|
valgrind errors, run `make valtest` and check the output for undefined or flagged behavior.
|
||||||
|
|
||||||
|
### Formatting
|
||||||
|
|
||||||
|
Use [astyle](http://astyle.sourceforge.net/astyle.html) via `make format` to
|
||||||
|
ensure a consistent code style for C.
|
||||||
|
|
||||||
|
## Janet style
|
||||||
|
|
||||||
|
All janet code in the project should be formatted similar to the code in core.janet.
|
||||||
|
The auto formatting from janet.vim will work well.
|
||||||
|
|
||||||
## Suggesting Changes
|
## Suggesting Changes
|
||||||
|
|
||||||
To suggest changes, open an issue on GitHub. Check GitHub for other issues
|
To suggest changes, open an issue on GitHub. Check GitHub for other issues
|
||||||
|
|||||||
2
LICENSE
2
LICENSE
@@ -1,4 +1,4 @@
|
|||||||
Copyright (c) 2018 Calvin Rose
|
Copyright (c) 2019 Calvin Rose and contributors
|
||||||
|
|
||||||
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
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
|
this software and associated documentation files (the "Software"), to deal in
|
||||||
|
|||||||
332
Makefile
332
Makefile
@@ -1,4 +1,4 @@
|
|||||||
# Copyright (c) 2018 Calvin Rose
|
# Copyright (c) 2019 Calvin Rose
|
||||||
#
|
#
|
||||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
# of this software and associated documentation files (the "Software"), to
|
# of this software and associated documentation files (the "Software"), to
|
||||||
@@ -24,174 +24,318 @@
|
|||||||
|
|
||||||
PREFIX?=/usr/local
|
PREFIX?=/usr/local
|
||||||
|
|
||||||
INCLUDEDIR=$(PREFIX)/include/janet
|
INCLUDEDIR=$(PREFIX)/include
|
||||||
LIBDIR=$(PREFIX)/lib
|
|
||||||
BINDIR=$(PREFIX)/bin
|
BINDIR=$(PREFIX)/bin
|
||||||
|
LIBDIR=$(PREFIX)/lib
|
||||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
||||||
|
CLIBS=-lm
|
||||||
|
JANET_TARGET=build/janet
|
||||||
|
JANET_LIBRARY=build/libjanet.so
|
||||||
|
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||||
|
JANET_PATH?=$(PREFIX)/lib/janet
|
||||||
|
MANPATH?=$(PREFIX)/share/man/man1/
|
||||||
|
PKG_CONFIG_PATH?=$(PREFIX)/lib/pkgconfig
|
||||||
|
DEBUGGER=gdb
|
||||||
|
|
||||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \
|
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \
|
||||||
-DJANET_BUILD=$(JANET_BUILD)
|
-DJANET_BUILD=$(JANET_BUILD)
|
||||||
CLIBS=-lm -ldl
|
LDFLAGS=-rdynamic
|
||||||
JANET_TARGET=janet
|
|
||||||
JANET_LIBRARY=libjanet.so
|
|
||||||
JANET_PATH?=/usr/local/lib/janet
|
|
||||||
DEBUGGER=gdb
|
|
||||||
|
|
||||||
|
# Check OS
|
||||||
UNAME:=$(shell uname -s)
|
UNAME:=$(shell uname -s)
|
||||||
LDCONFIG:=ldconfig
|
|
||||||
ifeq ($(UNAME), Darwin)
|
ifeq ($(UNAME), Darwin)
|
||||||
# Add other macos/clang flags
|
CLIBS:=$(CLIBS) -ldl
|
||||||
LDCONFIG:=
|
else ifeq ($(UNAME), Linux)
|
||||||
else
|
CLIBS:=$(CLIBS) -lrt -ldl
|
||||||
CFLAGS:=$(CFLAGS) -rdynamic
|
endif
|
||||||
CLIBS:=$(CLIBS) -lrt
|
# For other unix likes, add flags here!
|
||||||
|
ifeq ($(UNAME),Haiku)
|
||||||
|
LDFLAGS=-Wl,--export-dynamic
|
||||||
endif
|
endif
|
||||||
|
|
||||||
# Source headers
|
$(shell mkdir -p build/core build/mainclient build/webclient build/boot)
|
||||||
JANET_HEADERS=$(sort $(wildcard src/include/janet/*.h))
|
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY)
|
||||||
JANET_LOCAL_HEADERS=$(sort $(wildcard src/*/*.h))
|
|
||||||
|
|
||||||
# Source files
|
######################
|
||||||
JANET_CORE_SOURCES=$(sort $(wildcard src/core/*.c)) src/core/core.gen.c
|
##### Name Files #####
|
||||||
JANET_MAINCLIENT_SOURCES=$(sort $(wildcard src/mainclient/*.c)) src/mainclient/init.gen.c
|
######################
|
||||||
JANET_WEBCLIENT_SOURCES=$(sort $(wildcard src/webclient/*.c)) src/webclient/webinit.gen.c
|
|
||||||
|
|
||||||
all: $(JANET_TARGET) $(JANET_LIBRARY)
|
JANET_HEADERS=src/include/janet.h src/include/janetconf.h
|
||||||
|
|
||||||
|
JANET_LOCAL_HEADERS=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
|
||||||
|
|
||||||
|
JANET_CORE_SOURCES=src/core/abstract.c \
|
||||||
|
src/core/array.c \
|
||||||
|
src/core/asm.c \
|
||||||
|
src/core/buffer.c \
|
||||||
|
src/core/bytecode.c \
|
||||||
|
src/core/capi.c \
|
||||||
|
src/core/cfuns.c \
|
||||||
|
src/core/compile.c \
|
||||||
|
src/core/corelib.c \
|
||||||
|
src/core/debug.c \
|
||||||
|
src/core/emit.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/os.c \
|
||||||
|
src/core/parse.c \
|
||||||
|
src/core/peg.c \
|
||||||
|
src/core/pp.c \
|
||||||
|
src/core/regalloc.c \
|
||||||
|
src/core/run.c \
|
||||||
|
src/core/specials.c \
|
||||||
|
src/core/string.c \
|
||||||
|
src/core/strtod.c \
|
||||||
|
src/core/struct.c \
|
||||||
|
src/core/symcache.c \
|
||||||
|
src/core/table.c \
|
||||||
|
src/core/tuple.c \
|
||||||
|
src/core/typedarray.c \
|
||||||
|
src/core/util.c \
|
||||||
|
src/core/value.c \
|
||||||
|
src/core/vector.c \
|
||||||
|
src/core/vm.c \
|
||||||
|
src/core/wrap.c
|
||||||
|
|
||||||
|
JANET_BOOT_SOURCES=src/boot/array_test.c \
|
||||||
|
src/boot/boot.c \
|
||||||
|
src/boot/buffer_test.c \
|
||||||
|
src/boot/number_test.c \
|
||||||
|
src/boot/system_test.c \
|
||||||
|
src/boot/table_test.c
|
||||||
|
|
||||||
|
JANET_MAINCLIENT_SOURCES=src/mainclient/line.c src/mainclient/main.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
|
||||||
|
|
||||||
|
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||||
|
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $<
|
||||||
|
|
||||||
|
build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||||
|
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $^ $(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 #####
|
##### The main interpreter program and shared object #####
|
||||||
##########################################################
|
##########################################################
|
||||||
|
|
||||||
JANET_ALL_SOURCES=$(JANET_CORE_SOURCES) \
|
JANET_CORE_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_CORE_SOURCES)) build/core_image.o
|
||||||
$(JANET_MAINCLIENT_SOURCES)
|
JANET_MAINCLIENT_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_MAINCLIENT_SOURCES)) build/init.gen.o
|
||||||
|
|
||||||
JANET_CORE_OBJECTS=$(patsubst %.c,%.o,$(JANET_CORE_SOURCES))
|
# Compile the core image generated by the bootstrap build
|
||||||
JANET_ALL_OBJECTS=$(patsubst %.c,%.o,$(JANET_ALL_SOURCES))
|
build/core_image.o: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||||
|
|
||||||
%.o: %.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
|
||||||
$(CC) $(CFLAGS) -o $@ -c $<
|
$(CC) $(CFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
$(JANET_TARGET): $(JANET_ALL_OBJECTS)
|
build/%.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||||
$(CC) $(CFLAGS) -o $@ $^ $(CLIBS)
|
$(CC) $(CFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
|
$(JANET_TARGET): $(JANET_CORE_OBJECTS) $(JANET_MAINCLIENT_OBJECTS)
|
||||||
|
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
|
$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||||
$(CC) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
|
$(JANET_STATIC_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||||
|
$(AR) rcs $@ $^
|
||||||
|
|
||||||
######################
|
######################
|
||||||
##### Emscripten #####
|
##### Emscripten #####
|
||||||
######################
|
######################
|
||||||
|
|
||||||
EMCC=emcc
|
EMCC=emcc
|
||||||
EMCCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -O2 \
|
EMCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -O2 \
|
||||||
-s EXTRA_EXPORTED_RUNTIME_METHODS='["cwrap"]' \
|
-s EXTRA_EXPORTED_RUNTIME_METHODS='["cwrap"]' \
|
||||||
-s ALLOW_MEMORY_GROWTH=1 \
|
-s ALLOW_MEMORY_GROWTH=1 \
|
||||||
-s AGGRESSIVE_VARIABLE_ELIMINATION=1 \
|
-s AGGRESSIVE_VARIABLE_ELIMINATION=1 \
|
||||||
-DJANET_BUILD=$(JANET_BUILD)
|
-DJANET_BUILD=$(JANET_BUILD)
|
||||||
JANET_EMTARGET=janet.js
|
JANET_EMTARGET=build/janet.js
|
||||||
JANET_WEB_SOURCES=$(JANET_CORE_SOURCES) $(JANET_WEBCLIENT_SOURCES)
|
JANET_WEB_SOURCES=$(JANET_CORE_SOURCES) $(JANET_WEBCLIENT_SOURCES)
|
||||||
JANET_EMOBJECTS=$(patsubst %.c,%.bc,$(JANET_WEB_SOURCES))
|
JANET_EMOBJECTS=$(patsubst src/%.c,build/%.bc,$(JANET_WEB_SOURCES)) \
|
||||||
|
build/webinit.gen.bc build/core_image.bc
|
||||||
|
|
||||||
%.bc: %.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
%.gen.bc: %.gen.c
|
||||||
$(EMCC) $(EMCCFLAGS) -o $@ -c $<
|
$(EMCC) $(EMCFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
|
build/core_image.bc: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||||
|
$(EMCC) $(EMCFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
|
build/%.bc: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||||
|
$(EMCC) $(EMCFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
$(JANET_EMTARGET): $(JANET_EMOBJECTS)
|
$(JANET_EMTARGET): $(JANET_EMOBJECTS)
|
||||||
$(EMCC) $(EMCCFLAGS) -shared -o $@ $^
|
$(EMCC) $(EMCFLAGS) -shared -o $@ $^
|
||||||
|
|
||||||
|
emscripten: $(JANET_EMTARGET)
|
||||||
|
|
||||||
#############################
|
#############################
|
||||||
##### Generated C files #####
|
##### Generated C files #####
|
||||||
#############################
|
#############################
|
||||||
|
|
||||||
xxd: src/tools/xxd.c
|
%.gen.o: %.gen.c
|
||||||
|
$(CC) $(CFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
|
build/xxd: tools/xxd.c
|
||||||
$(CC) $< -o $@
|
$(CC) $< -o $@
|
||||||
|
|
||||||
%.gen.c: %.janet xxd
|
build/init.gen.c: src/mainclient/init.janet build/xxd
|
||||||
./xxd $< $@ janet_gen_$(*F)
|
build/xxd $< $@ janet_gen_init
|
||||||
|
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
|
||||||
|
|
||||||
|
########################
|
||||||
|
##### Amalgamation #####
|
||||||
|
########################
|
||||||
|
|
||||||
|
amalg: build/janet.c build/janet.h build/core_image.c
|
||||||
|
|
||||||
|
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) > $@
|
||||||
|
|
||||||
|
build/janet.h: src/include/janet.h
|
||||||
|
cp $< $@
|
||||||
|
|
||||||
###################
|
###################
|
||||||
##### Testing #####
|
##### Testing #####
|
||||||
###################
|
###################
|
||||||
|
|
||||||
TEST_SOURCES=$(wildcard ctest/*.c)
|
|
||||||
TEST_OBJECTS=$(patsubst %.c,%.o,$(TEST_SOURCES))
|
|
||||||
TEST_PROGRAMS=$(patsubst %.c,%.out,$(TEST_SOURCES))
|
|
||||||
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
||||||
|
|
||||||
ctest/%.o: ctest/%.c $(JANET_HEADERS)
|
|
||||||
$(CC) $(CFLAGS) -o $@ -c $<
|
|
||||||
|
|
||||||
ctest/%.out: ctest/%.o $(JANET_CORE_OBJECTS)
|
|
||||||
$(CC) $(CFLAGS) -o $@ $^ $(CLIBS)
|
|
||||||
|
|
||||||
repl: $(JANET_TARGET)
|
repl: $(JANET_TARGET)
|
||||||
./$(JANET_TARGET)
|
./$(JANET_TARGET)
|
||||||
|
|
||||||
debug: $(JANET_TARGET)
|
debug: $(JANET_TARGET)
|
||||||
$(DEBUGGER) ./$(JANET_TARGET)
|
$(DEBUGGER) ./$(JANET_TARGET)
|
||||||
|
|
||||||
|
VALGRIND_COMMAND=valgrind --leak-check=full
|
||||||
|
|
||||||
valgrind: $(JANET_TARGET)
|
valgrind: $(JANET_TARGET)
|
||||||
valgrind --leak-check=full -v ./$(JANET_TARGET)
|
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
|
||||||
|
|
||||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||||
for f in ctest/*.out; do "$$f" || exit; done
|
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||||
for f in test/*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
|
||||||
|
|
||||||
VALGRIND_COMMAND=valgrind --leak-check=full -v
|
|
||||||
|
|
||||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||||
for f in ctest/*.out; do $(VALGRIND_COMMAND) "$$f" || exit; done
|
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||||
for f in test/*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
|
||||||
|
|
||||||
###################
|
callgrind: $(JANET_TARGET)
|
||||||
##### Natives #####
|
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||||
###################
|
|
||||||
|
|
||||||
natives: $(JANET_TARGET)
|
########################
|
||||||
$(MAKE) -C natives/json
|
##### Distribution #####
|
||||||
$(MAKE) -j 8 -C natives/sqlite3
|
########################
|
||||||
|
|
||||||
clean-natives:
|
dist: build/janet-dist.tar.gz
|
||||||
$(MAKE) -C natives/json clean
|
|
||||||
$(MAKE) -C natives/sqlite3 clean
|
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||||
|
src/include/janet.h src/include/janetconf.h \
|
||||||
|
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||||
|
build/doc.html README.md build/janet.c
|
||||||
|
tar -czvf $@ $^
|
||||||
|
|
||||||
|
#########################
|
||||||
|
##### Documentation #####
|
||||||
|
#########################
|
||||||
|
|
||||||
|
docs: build/doc.html
|
||||||
|
|
||||||
|
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||||
|
$(JANET_TARGET) tools/gendoc.janet > build/doc.html
|
||||||
|
|
||||||
|
########################
|
||||||
|
##### Installation #####
|
||||||
|
########################
|
||||||
|
|
||||||
|
SONAME=libjanet.so.1
|
||||||
|
|
||||||
|
.PHONY: $(PKG_CONFIG_PATH)/janet.pc
|
||||||
|
$(PKG_CONFIG_PATH)/janet.pc: $(JANET_TARGET)
|
||||||
|
mkdir -p $(PKG_CONFIG_PATH)
|
||||||
|
echo 'prefix=$(PREFIX)' > $@
|
||||||
|
echo 'exec_prefix=$${prefix}' >> $@
|
||||||
|
echo 'includedir=$(INCLUDEDIR)/janet' >> $@
|
||||||
|
echo 'libdir=$(LIBDIR)' >> $@
|
||||||
|
echo "" >> $@
|
||||||
|
echo "Name: janet" >> $@
|
||||||
|
echo "Url: https://janet-lang.org" >> $@
|
||||||
|
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.private: $(CLIBS)' >> $@
|
||||||
|
|
||||||
|
install: $(JANET_TARGET) $(PKG_CONFIG_PATH)/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 tools/cook.janet $(JANET_PATH)
|
||||||
|
cp tools/highlight.janet $(JANET_PATH)
|
||||||
|
cp tools/bars.janet $(JANET_PATH)
|
||||||
|
mkdir -p $(MANPATH)
|
||||||
|
cp janet.1 $(MANPATH)
|
||||||
|
-ldconfig $(LIBDIR)
|
||||||
|
|
||||||
#################
|
#################
|
||||||
##### Other #####
|
##### Other #####
|
||||||
#################
|
#################
|
||||||
|
|
||||||
dist: janet-dist.tar.gz
|
format:
|
||||||
|
tools/format.sh
|
||||||
|
|
||||||
janet-%.tar.gz: $(JANET_TARGET) src/include/janet/janet.h \
|
grammar: build/janet.tmLanguage
|
||||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) README.md
|
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||||
tar -czvf $@ $^
|
$(JANET_TARGET) $< > $@
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
-rm $(JANET_TARGET)
|
-rm -rf build vgcore.* callgrind.*
|
||||||
-rm $(JANET_LIBRARY)
|
|
||||||
-rm ctest/*.o ctest/*.out
|
|
||||||
-rm src/**/*.o src/**/*.bc vgcore.* *.js *.wasm *.html
|
|
||||||
-rm src/**/*.gen.c
|
|
||||||
-rm janet-*.tar.gz
|
|
||||||
|
|
||||||
install: $(JANET_TARGET)
|
test-install:
|
||||||
mkdir -p $(BINDIR)
|
cd test/install && rm -rf build && janet build && janet build
|
||||||
cp $(JANET_TARGET) $(BINDIR)/$(JANET_TARGET)
|
|
||||||
mkdir -p $(INCLUDEDIR)
|
|
||||||
cp $(JANET_HEADERS) $(INCLUDEDIR)
|
|
||||||
mkdir -p $(LIBDIR)
|
|
||||||
cp $(JANET_LIBRARY) $(LIBDIR)/$(JANET_LIBRARY)
|
|
||||||
cp janet.1 /usr/local/share/man/man1/
|
|
||||||
mandb
|
|
||||||
$(LDCONFIG)
|
|
||||||
|
|
||||||
install-libs: natives
|
build/embed_janet.o: build/janet.c $(JANET_HEADERS)
|
||||||
mkdir -p $(JANET_PATH)
|
$(CC) $(CFLAGS) -c $< -o $@
|
||||||
cp -r lib $(JANET_PATH)
|
build/embed_main.o: test/amalg/main.c $(JANET_HEADERS)
|
||||||
cp natives/*/*.so $(JANET_PATH)
|
$(CC) $(CFLAGS) -c $< -o $@
|
||||||
|
build/embed_test: build/embed_janet.o build/embed_main.o
|
||||||
|
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
|
test-amalg: build/embed_test
|
||||||
|
./build/embed_test
|
||||||
|
|
||||||
uninstall:
|
uninstall:
|
||||||
-rm $(BINDIR)/$(JANET_TARGET)
|
-rm $(BINDIR)/../$(JANET_TARGET)
|
||||||
-rm $(LIBDIR)/$(JANET_LIBRARY)
|
|
||||||
-rm -rf $(INCLUDEDIR)
|
-rm -rf $(INCLUDEDIR)
|
||||||
$(LDCONFIG)
|
|
||||||
|
|
||||||
.PHONY: clean install repl debug valgrind test valtest dist install uninstall \
|
.PHONY: clean install repl debug valgrind test amalg \
|
||||||
$(TEST_PROGRAM_PHONIES) $(TEST_PROGRAM_VALPHONIES)
|
valtest emscripten dist uninstall docs grammar format
|
||||||
|
|||||||
202
README.md
202
README.md
@@ -1,24 +1,23 @@
|
|||||||
# janet
|
[](https://gitter.im/janet-language/community)
|
||||||
|
|
||||||
|
[](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://travis-ci.org/bakpakin/janet)
|
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||||
[](https://ci.appveyor.com/project/bakpakin/janet)
|
|
||||||
|
|
||||||
Janet is a functional and imperative programming language and bytecode interpreter. It is a
|
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
|
||||||
modern lisp, but lists are replaced
|
modern lisp, but lists are replaced
|
||||||
by other data structures with better utility and performance (arrays, tables, structs, tuples).
|
by other data structures with better utility and performance (arrays, tables, structs, tuples).
|
||||||
The language also bridging bridging to native code written in C, meta-programming with macros, and bytecode assembly.
|
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
|
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
|
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 could be embedded into other programs. Try janet in your browser at
|
||||||
[https://janet-lang.org](https://janet-lang.org).
|
[https://janet-lang.org](https://janet-lang.org).
|
||||||
|
|
||||||
Implemented in mostly standard C99, janet runs on Windows, Linux and macOS.
|
<br>
|
||||||
The few features that are not standard C (dynamic library loading, compiler specific optimizations),
|
|
||||||
are fairly straight forward. Janet can be easily ported to new platforms.
|
|
||||||
|
|
||||||
For syntax highlighting, there is some preliminary vim syntax highlighting in [janet.vim](https://github.com/bakpakin/janet.vim).
|
|
||||||
Generic lisp syntax highlighting should, however, provide good results.
|
|
||||||
|
|
||||||
## Use Cases
|
## Use Cases
|
||||||
|
|
||||||
@@ -43,17 +42,19 @@ Janet makes a good system scripting language, or a language to embed in other pr
|
|||||||
* Lexical scoping
|
* Lexical scoping
|
||||||
* Imperative programming as well as functional
|
* Imperative programming as well as functional
|
||||||
* REPL
|
* REPL
|
||||||
|
* Parsing Expression Grammars built in to the core library
|
||||||
* 300+ functions and macros in the core library
|
* 300+ functions and macros in the core library
|
||||||
|
* Embedding Janet in other programs
|
||||||
* Interactive environment with detailed stack traces
|
* Interactive environment with detailed stack traces
|
||||||
|
|
||||||
## Documentation
|
## Documentation
|
||||||
|
|
||||||
API documentation and design documents can be found in the
|
* For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details.
|
||||||
[wiki](https://github.com/bakpakin/janet/wiki). There is an introduction
|
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html)
|
||||||
section in the wiki that contains a good overview of the language.
|
|
||||||
|
|
||||||
For individual bindings, use the `(doc symbol-name)` macro to get API
|
Documentation is also available locally in the repl.
|
||||||
documentation for the core library. For example,
|
Use the `(doc symbol-name)` macro to get API
|
||||||
|
documentation for symbols in the core library. For example,
|
||||||
```
|
```
|
||||||
(doc doc)
|
(doc doc)
|
||||||
```
|
```
|
||||||
@@ -62,11 +63,73 @@ Shows documentation for the doc macro.
|
|||||||
To get a list of all bindings in the default
|
To get a list of all bindings in the default
|
||||||
environment, use the `(all-symbols)` function.
|
environment, use the `(all-symbols)` function.
|
||||||
|
|
||||||
|
## Source
|
||||||
|
|
||||||
|
You can get the source on [GitHub](https://github.com/janet-lang/janet) or
|
||||||
|
[SourceHut](https://git.sr.ht/~bakpakin/janet). While the GitHub repo is the official repo,
|
||||||
|
the SourceHut mirror is actively maintained.
|
||||||
|
|
||||||
|
## Building
|
||||||
|
|
||||||
|
### macos and Unix-like
|
||||||
|
|
||||||
|
```
|
||||||
|
cd somewhere/my/projects/janet
|
||||||
|
make
|
||||||
|
make test
|
||||||
|
make repl
|
||||||
|
```
|
||||||
|
|
||||||
|
### 32-bit Haiku
|
||||||
|
|
||||||
|
32-bit Haiku build instructions are the same as the unix-like build instructions,
|
||||||
|
but you need to specify an alternative compiler, such as `gcc-x86`.
|
||||||
|
|
||||||
|
```
|
||||||
|
cd somewhere/my/projects/janet
|
||||||
|
make CC=gcc-x86
|
||||||
|
make test
|
||||||
|
make repl
|
||||||
|
```
|
||||||
|
|
||||||
|
### FreeBSD
|
||||||
|
|
||||||
|
FreeBSD build instructions are the same as the unix-like build instuctions,
|
||||||
|
but you need `gmake` to compile. Alternatively, install directly from
|
||||||
|
packages, using `pkg install lang/janet`.
|
||||||
|
|
||||||
|
```
|
||||||
|
cd somewhere/my/projects/janet
|
||||||
|
gmake
|
||||||
|
gmake test
|
||||||
|
gmake repl
|
||||||
|
```
|
||||||
|
|
||||||
|
### 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#)
|
||||||
|
2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet.
|
||||||
|
3. Run `build_win` to compile janet.
|
||||||
|
4. Run `build_win test` to make sure everything is working.
|
||||||
|
|
||||||
|
### Emscripten
|
||||||
|
|
||||||
|
To build janet for the web via [Emscripten](https://kripken.github.io/emscripten-site/), make sure you
|
||||||
|
have `emcc` installed and on your path. On a linux or macOS system, use `make emscripten` to build
|
||||||
|
`janet.js` and `janet.wasm` - both are needed to run janet in a browser or in node.
|
||||||
|
The JavaScript build is what runs the repl on the main website,
|
||||||
|
but really serves mainly as a proof of concept. Janet will run slower in a browser.
|
||||||
|
Building with emscripten on windows is currently unsupported.
|
||||||
|
|
||||||
|
### Meson
|
||||||
|
|
||||||
|
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
|
||||||
|
system. This is not currently the main supported build system, but should work on any
|
||||||
|
system that supports meson. Meson also provides much better IDE integration than Make or batch files.
|
||||||
|
|
||||||
## Installation
|
## Installation
|
||||||
|
|
||||||
Install a stable version of janet from the [releases page](https://github.com/bakpakin/janet/releases).
|
See [the Introduction](https://janet-lang.org/introduction.html) for more details.
|
||||||
Janet is prebuilt for a few systems, but if you want to develop janet, run janet on a non-x86 system, or
|
|
||||||
get the latest, you must build janet from source.
|
|
||||||
|
|
||||||
## Usage
|
## Usage
|
||||||
|
|
||||||
@@ -74,7 +137,7 @@ A repl is launched when the binary is invoked with no arguments. Pass the -h fla
|
|||||||
to display the usage information. Individual scripts can be run with `./janet myscript.janet`
|
to display the usage information. Individual scripts can be run with `./janet myscript.janet`
|
||||||
|
|
||||||
If you are looking to explore, you can print a list of all available macros, functions, and constants
|
If you are looking to explore, you can print a list of all available macros, functions, and constants
|
||||||
by entering the command `(all-symbols)` into the repl.
|
by entering the command `(all-bindings)` into the repl.
|
||||||
|
|
||||||
```
|
```
|
||||||
$ ./janet
|
$ ./janet
|
||||||
@@ -84,7 +147,7 @@ janet:1:> (+ 1 2 3)
|
|||||||
janet:2:> (print "Hello, World!")
|
janet:2:> (print "Hello, World!")
|
||||||
Hello, World!
|
Hello, World!
|
||||||
nil
|
nil
|
||||||
janet:3:> (os.exit)
|
janet:3:> (os/exit)
|
||||||
$ ./janet -h
|
$ ./janet -h
|
||||||
usage: ./janet [options] scripts...
|
usage: ./janet [options] scripts...
|
||||||
Options are:
|
Options are:
|
||||||
@@ -98,87 +161,44 @@ Options are:
|
|||||||
$
|
$
|
||||||
```
|
```
|
||||||
|
|
||||||
## Compiling and Running
|
If installed, you can also run `man janet` to get usage information.
|
||||||
|
|
||||||
Janet only uses Make and batch files to compile on Posix and windows
|
## Embedding
|
||||||
respectively. To configure janet, edit the header file src/include/janet/janet.h
|
|
||||||
before compilation.
|
|
||||||
|
|
||||||
### Unix-like
|
The C API for Janet is not yet documented but coming soon.
|
||||||
|
|
||||||
On most platforms, use Make to build janet.
|
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
|
||||||
```sh
|
that contains all the source to Janet. This file, along with
|
||||||
cd somewhere/my/projects/janet
|
`src/include/janet.h` and `src/include/janetconf.h` can dragged into any C
|
||||||
make
|
project and compiled into the project. Janet should be compiled with `-std=c99`
|
||||||
make test
|
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
|
||||||
After building, run `make install` to install the janet binary and libs.
|
`-DJANET_NO_DYNAMIC_MODULES` to the compiler options.
|
||||||
Will install in `/usr/local` by default, see the Makefile to customize.
|
|
||||||
|
|
||||||
It's also recommended to set the `JANET_PATH` variable in your profile.
|
|
||||||
This is where janet will look for imported libraries after the current directory.
|
|
||||||
|
|
||||||
### FreeBSD
|
|
||||||
|
|
||||||
FreeBSD build instructions are the same as the unix-like build instuctions,
|
|
||||||
but you need `gmake` and `gcc` to compile.
|
|
||||||
|
|
||||||
```
|
|
||||||
cd somewhere/my/projects/janet
|
|
||||||
gmake CC=gcc
|
|
||||||
gmake test CC=gcc
|
|
||||||
```
|
|
||||||
|
|
||||||
### 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#)
|
|
||||||
2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet.
|
|
||||||
3. Run `build_win` to compile janet.
|
|
||||||
4. Run `build_win test` to make sure everything is working.
|
|
||||||
|
|
||||||
### Emscripten
|
|
||||||
|
|
||||||
To build janet for the web via [Emscripten](https://kripken.github.io/emscripten-site/), make sure you
|
|
||||||
have `emcc` installed and on your path. On a linux or macOS system, use `make janet.js` to build
|
|
||||||
`janet.js` and `janet.wasm` - both are needed to run janet in a browser or in node.
|
|
||||||
The JavaScript build is what runs the repl on the main website,
|
|
||||||
but really serves mainly as a proof of concept. Janet will run much slower in a browser.
|
|
||||||
Building with emscripten on windows is currently unsupported.
|
|
||||||
|
|
||||||
## Examples
|
## Examples
|
||||||
|
|
||||||
See the examples directory for some example janet code.
|
See the examples directory for some example janet code.
|
||||||
|
|
||||||
## SQLite bindings
|
## Discussion
|
||||||
|
|
||||||
There are some sqlite3 bindings in the directory natives/sqlite3. They serve mostly as a
|
Feel free to ask questions and join discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
||||||
proof of concept external c library. To use, first compile the module with Make.
|
Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
|
||||||
|
|
||||||
```sh
|
## FAQ
|
||||||
make natives
|
|
||||||
```
|
|
||||||
|
|
||||||
Next, enter the repl and create a database and a table.
|
### Why is my terminal is spitting out junk when I run the repl?
|
||||||
|
|
||||||
```
|
Make sure your terminal supports ANSI escape codes. Most modern terminals will
|
||||||
janet:1:> (import natives/sqlite3 :as sql)
|
support these, but some older terminals, windows consoles, or embedded terminals
|
||||||
nil
|
will not. If your terminal does not support ANSI escape codes, run the repl with
|
||||||
janet:2:> (def db (sql/open "test.db"))
|
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||||
<sqlite3.connection 0x5561A138C470>
|
ensue.
|
||||||
janet:3:> (sql/eval db `CREATE TABLE customers(id INTEGER PRIMARY KEY, name TEXT);`)
|
|
||||||
@[]
|
|
||||||
janet:4:> (sql/eval db `INSERT INTO customers VALUES(:id, :name);` {:name "John" :id 12345})
|
|
||||||
@[]
|
|
||||||
janet:5:> (sql/eval db `SELECT * FROM customers;`)
|
|
||||||
@[{"id" 12345 "name" "John"}]
|
|
||||||
```
|
|
||||||
|
|
||||||
Finally, close the database connection when done with it.
|
## Why Janet
|
||||||
|
|
||||||
|
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
||||||
|
|
||||||
|
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left">
|
||||||
|
|
||||||
```
|
|
||||||
janet:6:> (sql/close db)
|
|
||||||
nil
|
|
||||||
```
|
|
||||||
|
|||||||
@@ -20,7 +20,10 @@ init:
|
|||||||
install:
|
install:
|
||||||
- build_win
|
- build_win
|
||||||
- build_win test
|
- build_win test
|
||||||
|
- choco install nsis -y -pre
|
||||||
|
- call "C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi
|
||||||
- build_win dist
|
- build_win dist
|
||||||
|
- copy janet-install.exe dist\install.exe
|
||||||
|
|
||||||
build: off
|
build: off
|
||||||
|
|
||||||
|
|||||||
BIN
assets/janet-big.png
Normal file
BIN
assets/janet-big.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 62 KiB |
BIN
assets/janet-the-good-place.gif
Normal file
BIN
assets/janet-the-good-place.gif
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 109 KiB |
BIN
assets/janet-w200.png
Normal file
BIN
assets/janet-w200.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 34 KiB |
@@ -22,23 +22,41 @@
|
|||||||
mkdir build
|
mkdir build
|
||||||
mkdir build\core
|
mkdir build\core
|
||||||
mkdir build\mainclient
|
mkdir build\mainclient
|
||||||
|
mkdir build\boot
|
||||||
|
|
||||||
@rem Build the xxd tool for generating sources
|
@rem Build the xxd tool for generating sources
|
||||||
@cl /nologo /c src/tools/xxd.c /Fobuild\xxd.obj
|
@cl /nologo /c tools/xxd.c /Fobuild\xxd.obj
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
@link /nologo /out:build\xxd.exe build\xxd.obj
|
@link /nologo /out:build\xxd.exe build\xxd.obj
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Generate the embedded sources
|
@rem Generate the embedded sources
|
||||||
@build\xxd.exe src\core\core.janet build\core\core.gen.c janet_gen_core
|
@build\xxd.exe src\mainclient\init.janet build\init.gen.c janet_gen_init
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
@build\xxd.exe src\mainclient\init.janet build\mainclient\init.gen.c janet_gen_init
|
@build\xxd.exe src\boot\boot.janet build\boot.gen.c janet_gen_boot
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Build the generated sources
|
@rem Build the generated sources
|
||||||
@%JANET_COMPILE% /Fobuild\core\core.gen.obj build\core\core.gen.c
|
@%JANET_COMPILE% /Fobuild\mainclient\init.gen.obj build\init.gen.c
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
@%JANET_COMPILE% /Fobuild\mainclient\init.gen.obj build\mainclient\init.gen.c
|
@%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
|
||||||
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
|
@rem Build the bootstrap interpretter
|
||||||
|
for %%f in (src\core\*.c) do (
|
||||||
|
@%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||||
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
)
|
||||||
|
for %%f in (src\boot\*.c) do (
|
||||||
|
@%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||||
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
)
|
||||||
|
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||||
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
build\janet_boot build\core_image.c JANET_PATH "C:/Janet/Library"
|
||||||
|
|
||||||
|
@rem Build the core image
|
||||||
|
@%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Build the sources
|
@rem Build the sources
|
||||||
@@ -54,9 +72,17 @@ for %%f in (src\mainclient\*.c) do (
|
|||||||
)
|
)
|
||||||
|
|
||||||
@rem Link everything to main client
|
@rem Link everything to main client
|
||||||
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj
|
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@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\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
|
||||||
|
|
||||||
echo === Successfully built janet.exe for Windows ===
|
echo === Successfully built janet.exe for Windows ===
|
||||||
echo === Run 'build_win test' to run tests. ==
|
echo === Run 'build_win test' to run tests. ==
|
||||||
echo === Run 'build_win clean' to delete build artifacts. ===
|
echo === Run 'build_win clean' to delete build artifacts. ===
|
||||||
@@ -70,7 +96,7 @@ exit /b 1
|
|||||||
@rem Show help
|
@rem Show help
|
||||||
:HELP
|
:HELP
|
||||||
@echo.
|
@echo.
|
||||||
@echo Usage: build_windows [subcommand=clean,help,test]
|
@echo Usage: build_windows [subcommand=clean,help,test,dist]
|
||||||
@echo.
|
@echo.
|
||||||
@echo Script to build janet on windows. Must be run from the Visual Studio
|
@echo Script to build janet on windows. Must be run from the Visual Studio
|
||||||
@echo command prompt.
|
@echo command prompt.
|
||||||
@@ -93,12 +119,18 @@ exit /b 0
|
|||||||
@rem Build a dist directory
|
@rem Build a dist directory
|
||||||
:DIST
|
:DIST
|
||||||
mkdir dist
|
mkdir dist
|
||||||
|
janet.exe tools\gendoc.janet > dist\doc.html
|
||||||
|
|
||||||
|
copy build\janet.c dist\janet.c
|
||||||
copy janet.exe dist\janet.exe
|
copy janet.exe dist\janet.exe
|
||||||
copy LICENSE dist\LICENSE
|
copy LICENSE dist\LICENSE
|
||||||
copy README.md dist\README.md
|
copy README.md dist\README.md
|
||||||
copy janet.lib dist\janet.lib
|
copy janet.lib dist\janet.lib
|
||||||
copy janet.exp dist\janet.exp
|
copy janet.exp dist\janet.exp
|
||||||
copy src\include\janet\janet.h dist\janet.h
|
copy src\include\janet.h dist\janet.h
|
||||||
|
copy src\include\janetconf.h dist\janetconf.h
|
||||||
|
copy tools\cook.janet dist\cook.janet
|
||||||
|
copy tools\highlight.janet dist\highlight.janet
|
||||||
exit /b 0
|
exit /b 0
|
||||||
|
|
||||||
:TESTFAIL
|
:TESTFAIL
|
||||||
|
|||||||
@@ -5,10 +5,14 @@
|
|||||||
(def solutions @{})
|
(def solutions @{})
|
||||||
(def len (length s))
|
(def len (length s))
|
||||||
(for k 0 len
|
(for k 0 len
|
||||||
(put tab s@k k))
|
(put tab (s k) k))
|
||||||
(for i 0 len
|
(for i 0 len
|
||||||
(for j 0 len
|
(for j 0 len
|
||||||
(def k (get tab (- 0 s@i s@j)))
|
(def k (get tab (- 0 (s i) (s j))))
|
||||||
(when (and k (not= k i) (not= k j) (not= i j))
|
(when (and k (not= k i) (not= k j) (not= i j))
|
||||||
(put solutions {i true j true k true} true))))
|
(put solutions {i true j true k true} true))))
|
||||||
(map keys (keys solution)))
|
(map keys (keys solutions)))
|
||||||
|
|
||||||
|
(def arr @[2 4 1 3 8 7 -3 -1 12 -5 -8])
|
||||||
|
(printf "3sum of %P: " arr)
|
||||||
|
(printf "%P\n" (sum3 arr))
|
||||||
|
|||||||
@@ -13,8 +13,16 @@
|
|||||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||||
(push 0) # push($0)
|
(push 0) # push($0)
|
||||||
(call 0 1) # $0 = call($1)
|
(call 0 1) # $0 = call($1)
|
||||||
(addi 0 0 2) # $0 = $0 + $2 (integers)
|
(add 0 0 2) # $0 = $0 + $2 (integers)
|
||||||
:done
|
:done
|
||||||
(ret 0) # return $0
|
(ret 0) # return $0
|
||||||
]
|
]
|
||||||
}))
|
}))
|
||||||
|
|
||||||
|
# Test it
|
||||||
|
|
||||||
|
(defn testn
|
||||||
|
[n]
|
||||||
|
(print "fibasm(" n ") = " (fibasm n)))
|
||||||
|
|
||||||
|
(for i 0 10 (testn i))
|
||||||
|
|||||||
@@ -35,7 +35,13 @@
|
|||||||
:bright-white 97
|
:bright-white 97
|
||||||
:bg-bright-white 107})
|
:bg-bright-white 107})
|
||||||
|
|
||||||
(loop [[name color] :in (pairs colormap)]
|
(defn color
|
||||||
(defglobal (string.slice name 1)
|
"Take a string made by concatenating xs and colorize it for an ANSI terminal."
|
||||||
(fn color-wrapper [& pieces]
|
[c & xs]
|
||||||
(string "\e[" color "m" (apply string pieces) "\e[0m"))))
|
(def code (get colormap c))
|
||||||
|
(if (not code) (error (string "color " c " unknown")))
|
||||||
|
(string "\e[" code "m" ;xs "\e[0m"))
|
||||||
|
|
||||||
|
# Print all colors
|
||||||
|
|
||||||
|
(loop [c :keys colormap] (print (color c c)))
|
||||||
@@ -18,12 +18,12 @@
|
|||||||
(if ,loaded
|
(if ,loaded
|
||||||
,state
|
,state
|
||||||
(do
|
(do
|
||||||
(:= ,loaded true)
|
(set ,loaded true)
|
||||||
(:= ,state (do ;forms)))))))
|
(set ,state (do ,;forms)))))))
|
||||||
|
|
||||||
# Use tuples instead of structs to save memory
|
# Use tuples instead of structs to save memory
|
||||||
(def HEAD :private 0)
|
(def- HEAD 0)
|
||||||
(def TAIL :private 1)
|
(def- TAIL 1)
|
||||||
|
|
||||||
(defn empty-seq
|
(defn empty-seq
|
||||||
"The empty sequence."
|
"The empty sequence."
|
||||||
@@ -52,7 +52,7 @@
|
|||||||
|
|
||||||
(defn lazy-range
|
(defn lazy-range
|
||||||
"Return a sequence of integers [start, end)."
|
"Return a sequence of integers [start, end)."
|
||||||
@[start end]
|
[start end &]
|
||||||
(if end
|
(if end
|
||||||
(if (< start end)
|
(if (< start end)
|
||||||
(delay (tuple start (lazy-range (+ 1 start) end)))
|
(delay (tuple start (lazy-range (+ 1 start) end)))
|
||||||
@@ -94,7 +94,7 @@
|
|||||||
(defn randseq
|
(defn randseq
|
||||||
"Return a sequence of random numbers."
|
"Return a sequence of random numbers."
|
||||||
[]
|
[]
|
||||||
(delay (tuple (math.random) (randseq))))
|
(delay (tuple (math/random) (randseq))))
|
||||||
|
|
||||||
(defn take-while
|
(defn take-while
|
||||||
"Returns a sequence of values until the predicate is false."
|
"Returns a sequence of values until the predicate is false."
|
||||||
@@ -4,11 +4,11 @@
|
|||||||
(seq [x :range [-1 2]
|
(seq [x :range [-1 2]
|
||||||
y :range [-1 2]
|
y :range [-1 2]
|
||||||
:when (not (and (zero? x) (zero? y)))]
|
:when (not (and (zero? x) (zero? y)))]
|
||||||
(tuple x y)))
|
[x y]))
|
||||||
|
|
||||||
(defn- neighbors
|
(defn- neighbors
|
||||||
[[x y]]
|
[[x y]]
|
||||||
(map (fn [[x1 y1]] (tuple (+ x x1) (+ y y1))) window))
|
(map (fn [[x1 y1]] [(+ x x1) (+ y y1)]) window))
|
||||||
|
|
||||||
(defn tick
|
(defn tick
|
||||||
"Get the next state in the Game Of Life."
|
"Get the next state in the Game Of Life."
|
||||||
@@ -16,7 +16,7 @@
|
|||||||
(def cell-set (frequencies state))
|
(def cell-set (frequencies state))
|
||||||
(def neighbor-set (frequencies (mapcat neighbors state)))
|
(def neighbor-set (frequencies (mapcat neighbors state)))
|
||||||
(seq [coord :keys neighbor-set
|
(seq [coord :keys neighbor-set
|
||||||
:let [count neighbor-set@coord]
|
:let [count (get neighbor-set coord)]
|
||||||
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
|
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
|
||||||
coord))
|
coord))
|
||||||
|
|
||||||
@@ -24,11 +24,11 @@
|
|||||||
"Draw cells in the game of life from (x1, y1) to (x2, y2)"
|
"Draw cells in the game of life from (x1, y1) to (x2, y2)"
|
||||||
[state x1 y1 x2 y2]
|
[state x1 y1 x2 y2]
|
||||||
(def cellset @{})
|
(def cellset @{})
|
||||||
(each cell state (:= cellset@cell true))
|
(each cell state (put cellset cell true))
|
||||||
(loop [x :range [x1 (+ 1 x2)]
|
(loop [x :range [x1 (+ 1 x2)]
|
||||||
:after (print)
|
:after (print)
|
||||||
y :range [y1 (+ 1 y2)]]
|
y :range [y1 (+ 1 y2)]]
|
||||||
(file/write stdout (if (get cellset (tuple x y)) "X " ". ")))
|
(file/write stdout (if (get cellset [x y]) "X " ". ")))
|
||||||
(print))
|
(print))
|
||||||
|
|
||||||
#
|
#
|
||||||
@@ -40,4 +40,4 @@
|
|||||||
(for i 0 20
|
(for i 0 20
|
||||||
(print "generation " i)
|
(print "generation " i)
|
||||||
(draw *state* -7 -7 7 7)
|
(draw *state* -7 -7 7 7)
|
||||||
(:= *state* (tick *state*)))
|
(set *state* (tick *state*)))
|
||||||
|
|||||||
@@ -2,10 +2,8 @@
|
|||||||
# of the triangle to the leaves of the triangle.
|
# of the triangle to the leaves of the triangle.
|
||||||
|
|
||||||
(defn myfold [xs ys]
|
(defn myfold [xs ys]
|
||||||
(let [xs1 (tuple/prepend xs 0)
|
(let [m1 (map + [;xs 0] ys)
|
||||||
xs2 (tuple/append xs 0)
|
m2 (map + [0 ;xs] ys)]
|
||||||
m1 (map + xs1 ys)
|
|
||||||
m2 (map + xs2 ys)]
|
|
||||||
(map max m1 m2)))
|
(map max m1 m2)))
|
||||||
|
|
||||||
(defn maxpath [t]
|
(defn maxpath [t]
|
||||||
|
|||||||
1
examples/numarray/.gitignore
vendored
Normal file
1
examples/numarray/.gitignore
vendored
Normal file
@@ -0,0 +1 @@
|
|||||||
|
/build
|
||||||
23
examples/numarray/build.janet
Normal file
23
examples/numarray/build.janet
Normal file
@@ -0,0 +1,23 @@
|
|||||||
|
(import cook)
|
||||||
|
|
||||||
|
(cook/make-native
|
||||||
|
:name "numarray"
|
||||||
|
:source @["numarray.c"])
|
||||||
|
|
||||||
|
(import build/numarray :as numarray)
|
||||||
|
|
||||||
|
(def a (numarray/new 30))
|
||||||
|
(print (get a 20))
|
||||||
|
(print (a 20))
|
||||||
|
|
||||||
|
(put a 5 3.14)
|
||||||
|
(print (a 5))
|
||||||
|
(set (a 5) 100)
|
||||||
|
(print (a 5))
|
||||||
|
|
||||||
|
# (numarray/scale a 5))
|
||||||
|
# ((a :scale) a 5)
|
||||||
|
(:scale a 5)
|
||||||
|
(for i 0 10 (print (a i)))
|
||||||
|
|
||||||
|
(print "sum=" (:sum a))
|
||||||
117
examples/numarray/numarray.c
Normal file
117
examples/numarray/numarray.c
Normal file
@@ -0,0 +1,117 @@
|
|||||||
|
#include <stdlib.h>
|
||||||
|
#include <janet.h>
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
double *data;
|
||||||
|
size_t size;
|
||||||
|
} num_array;
|
||||||
|
|
||||||
|
static num_array *num_array_init(num_array *array, size_t size) {
|
||||||
|
array->data = (double *)calloc(size, sizeof(double));
|
||||||
|
array->size = size;
|
||||||
|
return array;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void num_array_deinit(num_array *array) {
|
||||||
|
free(array->data);
|
||||||
|
}
|
||||||
|
|
||||||
|
static int num_array_gc(void *p, size_t s) {
|
||||||
|
(void) s;
|
||||||
|
num_array *array = (num_array *)p;
|
||||||
|
num_array_deinit(array);
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
Janet num_array_get(void *p, Janet key);
|
||||||
|
void num_array_put(void *p, Janet key, Janet value);
|
||||||
|
|
||||||
|
static const JanetAbstractType num_array_type = {
|
||||||
|
"numarray",
|
||||||
|
num_array_gc,
|
||||||
|
NULL,
|
||||||
|
num_array_get,
|
||||||
|
num_array_put
|
||||||
|
};
|
||||||
|
|
||||||
|
static Janet num_array_new(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
int32_t size = janet_getinteger(argv, 0);
|
||||||
|
num_array *array = (num_array *)janet_abstract(&num_array_type, sizeof(num_array));
|
||||||
|
num_array_init(array, size);
|
||||||
|
return janet_wrap_abstract(array);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet num_array_scale(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
|
||||||
|
double factor = janet_getnumber(argv, 1);
|
||||||
|
size_t i;
|
||||||
|
for (i = 0; i < array->size; i++) {
|
||||||
|
array->data[i] *= factor;
|
||||||
|
}
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet num_array_sum(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
|
||||||
|
double sum = 0;
|
||||||
|
for (size_t i = 0; i < array->size; i++) sum += array->data[i];
|
||||||
|
return janet_wrap_number(sum);
|
||||||
|
}
|
||||||
|
|
||||||
|
void num_array_put(void *p, Janet key, Janet value) {
|
||||||
|
size_t index;
|
||||||
|
num_array *array = (num_array *)p;
|
||||||
|
if (!janet_checkint(key))
|
||||||
|
janet_panic("expected integer key");
|
||||||
|
if (!janet_checktype(value, JANET_NUMBER))
|
||||||
|
janet_panic("expected number value");
|
||||||
|
|
||||||
|
index = (size_t)janet_unwrap_integer(key);
|
||||||
|
if (index < array->size) {
|
||||||
|
array->data[index] = janet_unwrap_number(value);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetMethod methods[] = {
|
||||||
|
{"scale", num_array_scale},
|
||||||
|
{"sum", num_array_sum},
|
||||||
|
{NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
Janet num_array_get(void *p, Janet key) {
|
||||||
|
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);
|
||||||
|
if (!janet_checkint(key))
|
||||||
|
janet_panic("expected integer key");
|
||||||
|
index = (size_t)janet_unwrap_integer(key);
|
||||||
|
if (index >= array->size) {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
value = janet_wrap_number(array->data[index]);
|
||||||
|
}
|
||||||
|
return value;
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg cfuns[] = {
|
||||||
|
{
|
||||||
|
"new", num_array_new,
|
||||||
|
"(numarray/new size)\n\n"
|
||||||
|
"Create new numarray"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"scale", num_array_scale,
|
||||||
|
"(numarray/scale numarray factor)\n\n"
|
||||||
|
"scale numarray by factor"
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||||
|
janet_cfuns(env, "numarray", cfuns);
|
||||||
|
}
|
||||||
@@ -9,6 +9,8 @@
|
|||||||
(def len (length list))
|
(def len (length list))
|
||||||
(for j 0 len
|
(for j 0 len
|
||||||
(def trial (get list j))
|
(def trial (get list j))
|
||||||
(if (zero? (% i trial)) (:= isprime? false)))
|
(if (zero? (% i trial)) (set isprime? false)))
|
||||||
(if isprime? (array/push list i)))
|
(if isprime? (array/push list i)))
|
||||||
list)
|
list)
|
||||||
|
|
||||||
|
(pp (primes 100))
|
||||||
|
|||||||
83
examples/tarray.janet
Normal file
83
examples/tarray.janet
Normal file
@@ -0,0 +1,83 @@
|
|||||||
|
# naive matrix implementation for testing typed array
|
||||||
|
|
||||||
|
(defmacro printf [& xs] ['print ['string/format (splice xs)]])
|
||||||
|
|
||||||
|
(defn matrix [nrow ncol] {:nrow nrow :ncol ncol :array (tarray/new :float64 (* nrow ncol))})
|
||||||
|
|
||||||
|
(defn matrix/row [mat i]
|
||||||
|
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||||
|
(tarray/new :float64 ncol 1 (* i ncol) array))
|
||||||
|
|
||||||
|
(defn matrix/column [mat j]
|
||||||
|
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||||
|
(tarray/new :float64 nrow ncol j array))
|
||||||
|
|
||||||
|
(defn matrix/set [mat i j value]
|
||||||
|
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||||
|
(set (array (+ (* i ncol) j)) value))
|
||||||
|
|
||||||
|
(defn matrix/get [mat i j value]
|
||||||
|
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||||
|
(array (+ (* i ncol) j)))
|
||||||
|
|
||||||
|
|
||||||
|
# other variants to test rows and cols views
|
||||||
|
|
||||||
|
(defn matrix/set* [mat i j value]
|
||||||
|
(set ((matrix/row mat i) j) value))
|
||||||
|
|
||||||
|
(defn matrix/set** [mat i j value]
|
||||||
|
(set ((matrix/column mat j) i) value))
|
||||||
|
|
||||||
|
|
||||||
|
(defn matrix/get* [mat i j value]
|
||||||
|
((matrix/row mat i) j))
|
||||||
|
|
||||||
|
(defn matrix/get** [mat i j value]
|
||||||
|
((matrix/column j) i))
|
||||||
|
|
||||||
|
|
||||||
|
(defn tarray/print [array]
|
||||||
|
(def size (tarray/length array))
|
||||||
|
(def buf @"")
|
||||||
|
(buffer/format buf "[%2i]" size)
|
||||||
|
(for i 0 size
|
||||||
|
(buffer/format buf " %+6.3f " (array i)))
|
||||||
|
(print buf))
|
||||||
|
|
||||||
|
(defn matrix/print [mat]
|
||||||
|
(def {:nrow nrow :ncol ncol :array tarray} mat)
|
||||||
|
(printf "matrix %iX%i %p" nrow ncol tarray)
|
||||||
|
(for i 0 nrow
|
||||||
|
(tarray/print (matrix/row mat i))))
|
||||||
|
|
||||||
|
|
||||||
|
(def nr 5)
|
||||||
|
(def nc 4)
|
||||||
|
(def A (matrix nr nc))
|
||||||
|
|
||||||
|
(loop (i :range (0 nr) j :range (0 nc))
|
||||||
|
(matrix/set A i j i))
|
||||||
|
(matrix/print A)
|
||||||
|
|
||||||
|
(loop (i :range (0 nr) j :range (0 nc))
|
||||||
|
(matrix/set* A i j i))
|
||||||
|
(matrix/print A)
|
||||||
|
|
||||||
|
(loop (i :range (0 nr) j :range (0 nc))
|
||||||
|
(matrix/set** A i j i))
|
||||||
|
(matrix/print A)
|
||||||
|
|
||||||
|
|
||||||
|
(printf "properties:\n%p" (tarray/properties (A :array)))
|
||||||
|
(for i 0 nr
|
||||||
|
(printf "row properties:[%i]\n%p" i (tarray/properties (matrix/row A i))))
|
||||||
|
(for i 0 nc
|
||||||
|
(printf "col properties:[%i]\n%p" i (tarray/properties (matrix/column A i))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
29
examples/urlloader.janet
Normal file
29
examples/urlloader.janet
Normal file
@@ -0,0 +1,29 @@
|
|||||||
|
# An example of using Janet's extensible module system
|
||||||
|
# to import files from URL. To try this, run `janet -l examples/urlloader.janet`
|
||||||
|
# from the repl, and then:
|
||||||
|
#
|
||||||
|
# (import https://raw.githubusercontent.com/janet-lang/janet/master/examples/colors.janet :as c)
|
||||||
|
#
|
||||||
|
# This will import a file using curl. You can then try
|
||||||
|
#
|
||||||
|
# (print (c/color :green "Hello!"))
|
||||||
|
#
|
||||||
|
# This is a bit of a toy example (it just shells out to curl), but it is very
|
||||||
|
# powerful and will work well in many cases.
|
||||||
|
|
||||||
|
(defn- load-url
|
||||||
|
[url args]
|
||||||
|
(def f (file/popen (string "curl " url)))
|
||||||
|
(def res (dofile f :source url ;args))
|
||||||
|
(try (file/close f) ([err] nil))
|
||||||
|
res)
|
||||||
|
|
||||||
|
(defn- check-http-url
|
||||||
|
[path]
|
||||||
|
(if (or (string/has-prefix? "http://" path)
|
||||||
|
(string/has-prefix? "https://" path))
|
||||||
|
path))
|
||||||
|
|
||||||
|
# Add the module loader and path tuple to right places
|
||||||
|
(array/push module/paths [check-http-url :janet-http])
|
||||||
|
(put module/loaders :janet-http load-url)
|
||||||
55
janet-installer.nsi
Normal file
55
janet-installer.nsi
Normal file
@@ -0,0 +1,55 @@
|
|||||||
|
!define MULTIUSER_EXECUTIONLEVEL Highest
|
||||||
|
!define MULTIUSER_MUI
|
||||||
|
!define MULTIUSER_INSTALLMODE_COMMANDLINE
|
||||||
|
!define MULTIUSER_INSTALLMODE_INSTDIR "janet"
|
||||||
|
!include "MultiUser.nsh"
|
||||||
|
!include "MUI2.nsh"
|
||||||
|
|
||||||
|
Name "Janet"
|
||||||
|
OutFile "janet-install.exe"
|
||||||
|
|
||||||
|
!define MUI_ABORTWARNING
|
||||||
|
|
||||||
|
!insertmacro MUI_PAGE_WELCOME
|
||||||
|
!insertmacro MUI_PAGE_LICENSE "LICENSE"
|
||||||
|
!insertmacro MUI_PAGE_COMPONENTS
|
||||||
|
!insertmacro MULTIUSER_PAGE_INSTALLMODE
|
||||||
|
!insertmacro MUI_PAGE_DIRECTORY
|
||||||
|
|
||||||
|
!insertmacro MUI_PAGE_INSTFILES
|
||||||
|
|
||||||
|
!insertmacro MUI_PAGE_FINISH
|
||||||
|
|
||||||
|
!insertmacro MUI_UNPAGE_CONFIRM
|
||||||
|
!insertmacro MUI_UNPAGE_INSTFILES
|
||||||
|
|
||||||
|
!insertmacro MUI_LANGUAGE "English"
|
||||||
|
|
||||||
|
Section "Janet" BfWSection
|
||||||
|
SetOutPath $INSTDIR
|
||||||
|
File "janet.exe"
|
||||||
|
WriteUninstaller "$INSTDIR\janet-uninstall.exe"
|
||||||
|
|
||||||
|
# Start Menu
|
||||||
|
CreateShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\janet.exe" "" ""
|
||||||
|
SectionEnd
|
||||||
|
|
||||||
|
Function .onInit
|
||||||
|
!insertmacro MULTIUSER_INIT
|
||||||
|
!insertmacro MUI_LANGDLL_DISPLAY
|
||||||
|
FunctionEnd
|
||||||
|
|
||||||
|
!insertmacro MUI_FUNCTION_DESCRIPTION_BEGIN
|
||||||
|
!insertmacro MUI_DESCRIPTION_TEXT ${BfWSection} "The Janet programming language."
|
||||||
|
!insertmacro MUI_FUNCTION_DESCRIPTION_END
|
||||||
|
|
||||||
|
Section "Uninstall"
|
||||||
|
Delete "$INSTDIR\janet.exe"
|
||||||
|
Delete "$INSTDIR\janet-uninstall.exe"
|
||||||
|
RMDir "$INSTDIR"
|
||||||
|
SectionEnd
|
||||||
|
|
||||||
|
Function un.onInit
|
||||||
|
!insertmacro MULTIUSER_UNINIT
|
||||||
|
!insertmacro MUI_UNGETLANGUAGE
|
||||||
|
FunctionEnd
|
||||||
73
janet.1
73
janet.1
@@ -1,12 +1,16 @@
|
|||||||
.TH JANET 1
|
.TH JANET 1
|
||||||
.SH NAME
|
.SH NAME
|
||||||
janet \- run the janet language abstract machine
|
janet \- run the Janet language abstract machine
|
||||||
.SH SYNOPSIS
|
.SH SYNOPSIS
|
||||||
.B janet
|
.B janet
|
||||||
[\fB\-hvsrp\fR]
|
[\fB\-hvsrpnqk\fR]
|
||||||
[\fB\-e\fR \fIJANET SOURCE\fR]
|
[\fB\-e\fR \fISOURCE\fR]
|
||||||
|
[\fB\-l\fR \fIMODULE\fR]
|
||||||
|
[\fB\-m\fR \fIPATH\fR]
|
||||||
|
[\fB\-c\fR \fIMODULE JIMAGE\fR]
|
||||||
[\fB\-\-\fR]
|
[\fB\-\-\fR]
|
||||||
.IR files ...
|
.IR script
|
||||||
|
.IR args ...
|
||||||
.SH DESCRIPTION
|
.SH DESCRIPTION
|
||||||
Janet is a functional and imperative programming language and bytecode interpreter.
|
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
|
It is a modern lisp, but lists are replaced by other data structures with better utility
|
||||||
@@ -14,10 +18,10 @@ and performance (arrays, tables, structs, tuples). The language also bridging br
|
|||||||
to native code written in C, meta-programming with macros, and bytecode assembly.
|
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.
|
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
|
This client program is separate from the core runtime, so Janet could be embedded
|
||||||
into other programs. Try janet in your browser at https://janet-lang.org.
|
into other programs. Try Janet in your browser at https://janet-lang.org.
|
||||||
|
|
||||||
Implemented in mostly standard C99, janet runs on Windows, Linux and macOS.
|
Implemented in mostly standard C99, Janet runs on Windows, Linux and macOS.
|
||||||
The few features that are not standard C99 (dynamic library loading, compiler
|
The few features that are not standard C99 (dynamic library loading, compiler
|
||||||
specific optimizations), are fairly straight forward. Janet can be easily ported to
|
specific optimizations), are fairly straight forward. Janet can be easily ported to
|
||||||
most new platforms.
|
most new platforms.
|
||||||
@@ -37,37 +41,66 @@ Shows the version text and exits immediately.
|
|||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-s
|
.BR \-s
|
||||||
Read raw input from stdin, such as from a pipe without printing a prompt.
|
Read raw input from stdin and forgo prompt history and other readline-like features.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-e\ code
|
||||||
|
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 \-n
|
||||||
|
Disable ANSI colors in the repl. Has no effect if no repl is run.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-r
|
.BR \-r
|
||||||
Open a REPL (Read Eval Print Loop) after executing all sources. By default, if janet is called with no
|
Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no
|
||||||
arguments, a REPL is opened.
|
arguments, a REPL is opened.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-p
|
.BR \-p
|
||||||
Turn on the persistent flag. By default, when janet is executing commands from a file and encounters an error,
|
Turn on the persistent flag. By default, when Janet is executing commands from a file and encounters an error,
|
||||||
it will immediately exit after printing the error message. In persistent mode, janet will keep executing commands
|
it will immediately exit after printing the error message. In persistent mode, Janet will keep executing commands
|
||||||
after an error. Persistent mode can be good for debugging and testing.
|
after an error. Persistent mode can be good for debugging and testing.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-e
|
.BR \-q
|
||||||
Execute a string of janet source. Source code is executed in the order it is encountered, so earlier
|
Quiet output. Don't print a repl prompt or expression results to stdout.
|
||||||
arguments are executed before later ones.
|
|
||||||
|
.TP
|
||||||
|
.BR \-k
|
||||||
|
Don't execute a script, only compile it to check for errors. Useful for linting scripts.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-m\ syspath
|
||||||
|
Set the variable module/*syspath* to the string syspath so that Janet will load system modules
|
||||||
|
from a directory different than the default. The default is set when Janet is built, and defaults to
|
||||||
|
/usr/local/lib/janet on Linux/Posix, and C:/Janet/Library on Windows. This option supersedes JANET_PATH.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-c\ source\ output
|
||||||
|
Precompiles Janet source code into an image, a binary dump that can be efficiently loaded later.
|
||||||
|
Source should be a path to the Janet module to compile, and output should be the file path of
|
||||||
|
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
|
||||||
|
in this manner, and exports from each file will be made available to the script
|
||||||
|
or repl.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-\-
|
.BR \-\-
|
||||||
Stop parsing command line arguments. All arguments after this one will be considered file names.
|
Stop parsing command line arguments. All arguments after this one will be considered file names
|
||||||
|
and then arguments to the script.
|
||||||
|
|
||||||
.SH ENVIRONMENT
|
.SH ENVIRONMENT
|
||||||
|
|
||||||
.B JANET_PATH
|
.B JANET_PATH
|
||||||
.RS
|
.RS
|
||||||
The location to look for janet libraries. This is the only environment variable janet needs to
|
The location to look for Janet libraries. This is the only environment variable Janet needs to
|
||||||
find native and source code modules. If no JANET_PATH is set, janet will look in
|
find native and source code modules. If no JANET_PATH is set, Janet will look in
|
||||||
/usr/local/lib/janet for modules.
|
the default location set at compile time.
|
||||||
To make janet search multiple locations, modify the module.paths
|
|
||||||
array in janet.
|
|
||||||
.RE
|
.RE
|
||||||
|
|
||||||
.SH AUTHOR
|
.SH AUTHOR
|
||||||
|
|||||||
179
meson.build
Normal file
179
meson.build
Normal file
@@ -0,0 +1,179 @@
|
|||||||
|
# Copyright (c) 2019 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.
|
||||||
|
|
||||||
|
project('janet', 'c', default_options : ['c_std=c99'])
|
||||||
|
|
||||||
|
# Global settings
|
||||||
|
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||||
|
header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet')
|
||||||
|
|
||||||
|
# Link math library on all systems
|
||||||
|
cc = meson.get_compiler('c')
|
||||||
|
m_dep = cc.find_library('m', required : false)
|
||||||
|
dl_dep = cc.find_library('dl', required : false)
|
||||||
|
|
||||||
|
# Some options
|
||||||
|
add_project_link_arguments('-rdynamic', language : 'c')
|
||||||
|
|
||||||
|
# Include directories
|
||||||
|
incdir = include_directories('src/include')
|
||||||
|
|
||||||
|
# Building generated sources
|
||||||
|
xxd = executable('xxd', 'tools/xxd.c')
|
||||||
|
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')
|
||||||
|
init_gen = gen.process('src/mainclient/init.janet', extra_args: 'janet_gen_init')
|
||||||
|
|
||||||
|
# Order is important here, as some headers
|
||||||
|
# depend on other headers for the amalg target
|
||||||
|
core_headers = [
|
||||||
|
'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'
|
||||||
|
]
|
||||||
|
|
||||||
|
core_src = [
|
||||||
|
'src/core/abstract.c',
|
||||||
|
'src/core/array.c',
|
||||||
|
'src/core/asm.c',
|
||||||
|
'src/core/buffer.c',
|
||||||
|
'src/core/bytecode.c',
|
||||||
|
'src/core/capi.c',
|
||||||
|
'src/core/cfuns.c',
|
||||||
|
'src/core/compile.c',
|
||||||
|
'src/core/corelib.c',
|
||||||
|
'src/core/debug.c',
|
||||||
|
'src/core/emit.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/os.c',
|
||||||
|
'src/core/parse.c',
|
||||||
|
'src/core/peg.c',
|
||||||
|
'src/core/pp.c',
|
||||||
|
'src/core/regalloc.c',
|
||||||
|
'src/core/run.c',
|
||||||
|
'src/core/specials.c',
|
||||||
|
'src/core/string.c',
|
||||||
|
'src/core/strtod.c',
|
||||||
|
'src/core/struct.c',
|
||||||
|
'src/core/symcache.c',
|
||||||
|
'src/core/table.c',
|
||||||
|
'src/core/tuple.c',
|
||||||
|
'src/core/typedarray.c',
|
||||||
|
'src/core/util.c',
|
||||||
|
'src/core/value.c',
|
||||||
|
'src/core/vector.c',
|
||||||
|
'src/core/vm.c',
|
||||||
|
'src/core/wrap.c'
|
||||||
|
]
|
||||||
|
|
||||||
|
boot_src = [
|
||||||
|
'src/boot/array_test.c',
|
||||||
|
'src/boot/boot.c',
|
||||||
|
'src/boot/buffer_test.c',
|
||||||
|
'src/boot/number_test.c',
|
||||||
|
'src/boot/system_test.c',
|
||||||
|
'src/boot/table_test.c',
|
||||||
|
]
|
||||||
|
|
||||||
|
mainclient_src = [
|
||||||
|
'src/mainclient/line.c',
|
||||||
|
'src/mainclient/main.c'
|
||||||
|
]
|
||||||
|
|
||||||
|
# Build boot binary
|
||||||
|
janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
|
||||||
|
include_directories : incdir,
|
||||||
|
c_args : '-DJANET_BOOTSTRAP',
|
||||||
|
dependencies : [m_dep, dl_dep])
|
||||||
|
|
||||||
|
# Build core image
|
||||||
|
core_image = custom_target('core_image',
|
||||||
|
input : [janet_boot],
|
||||||
|
output : 'core_image.gen.c',
|
||||||
|
command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path])
|
||||||
|
|
||||||
|
libjanet = shared_library('janet', core_src, core_image,
|
||||||
|
include_directories : incdir,
|
||||||
|
dependencies : [m_dep, dl_dep],
|
||||||
|
install : true)
|
||||||
|
janet_mainclient = executable('janet', core_src, core_image, init_gen, mainclient_src,
|
||||||
|
include_directories : incdir,
|
||||||
|
dependencies : [m_dep, dl_dep],
|
||||||
|
install : true)
|
||||||
|
|
||||||
|
# Documentation
|
||||||
|
docs = custom_target('docs',
|
||||||
|
input : ['tools/gendoc.janet'],
|
||||||
|
output : ['doc.html'],
|
||||||
|
capture : true,
|
||||||
|
command : [janet_mainclient, '@INPUT@'])
|
||||||
|
|
||||||
|
# Amalgamated source
|
||||||
|
amalg = custom_target('amalg',
|
||||||
|
input : ['tools/amalg.janet', core_headers, core_src, core_image],
|
||||||
|
output : ['janet.c'],
|
||||||
|
capture : true,
|
||||||
|
command : [janet_mainclient, '@INPUT@'])
|
||||||
|
|
||||||
|
# Amalgamated client
|
||||||
|
janet_amalgclient = executable('janet-amalg', amalg, init_gen, mainclient_src,
|
||||||
|
include_directories : incdir,
|
||||||
|
dependencies : [m_dep, dl_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'
|
||||||
|
]
|
||||||
|
foreach t : test_files
|
||||||
|
test(t, janet_mainclient, args : files([t]), workdir : meson.current_source_dir())
|
||||||
|
endforeach
|
||||||
|
|
||||||
|
# Repl
|
||||||
|
run_target('repl', command : [janet_mainclient])
|
||||||
|
|
||||||
|
# Installation
|
||||||
|
install_man('janet.1')
|
||||||
|
install_headers('src/include/janet.h', 'src/include/janetconf.h', subdir: 'janet')
|
||||||
|
janet_libs = [
|
||||||
|
'tools/bars.janet',
|
||||||
|
'tools/cook.janet',
|
||||||
|
'tools/highlight.janet'
|
||||||
|
]
|
||||||
|
install_data(sources : janet_libs, install_dir : janet_path)
|
||||||
@@ -1,44 +0,0 @@
|
|||||||
# Copyright (c) 2018 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.
|
|
||||||
|
|
||||||
CFLAGS:=-std=c99 -Wall -Wextra -O2 -shared -fpic
|
|
||||||
CFLAGS=-std=c99 -Wall -Wextra -I../../src/include -O2 -shared -fpic
|
|
||||||
OBJECTS:=json.o
|
|
||||||
TARGET:=json.so
|
|
||||||
|
|
||||||
# MacOS specifics
|
|
||||||
UNAME:=$(shell uname -s)
|
|
||||||
ifeq ($(UNAME), Darwin)
|
|
||||||
CFLAGS:=$(CFLAGS) -undefined dynamic_lookup
|
|
||||||
endif
|
|
||||||
|
|
||||||
all: $(TARGET)
|
|
||||||
|
|
||||||
%.o: %.c $(HEADERS)
|
|
||||||
$(CC) $(CFLAGS) -c $<
|
|
||||||
|
|
||||||
$(TARGET): $(OBJECTS)
|
|
||||||
$(CC) $(CFLAGS) -o $@ $^
|
|
||||||
|
|
||||||
clean:
|
|
||||||
rm $(OBJECTS)
|
|
||||||
rm $(TARGET)
|
|
||||||
|
|
||||||
.PHONY: all clean
|
|
||||||
@@ -1,25 +0,0 @@
|
|||||||
@rem Generated batch script, run in 'Visual Studio Developer Prompt'
|
|
||||||
|
|
||||||
@rem
|
|
||||||
|
|
||||||
@echo off
|
|
||||||
|
|
||||||
cl /nologo /I..\..\src\include /c /O2 /W3 json.c
|
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
|
||||||
|
|
||||||
link /nologo /dll ..\..\janet.lib /out:json.dll *.obj
|
|
||||||
if errorlevel 1 goto :BUILDFAIL
|
|
||||||
|
|
||||||
@echo .
|
|
||||||
@echo ======
|
|
||||||
@echo Build Succeeded.
|
|
||||||
@echo =====
|
|
||||||
exit /b 0
|
|
||||||
|
|
||||||
:BUILDFAIL
|
|
||||||
@echo .
|
|
||||||
@echo =====
|
|
||||||
@echo BUILD FAILED. See Output For Details.
|
|
||||||
@echo =====
|
|
||||||
@echo .
|
|
||||||
exit /b 1
|
|
||||||
@@ -1,605 +0,0 @@
|
|||||||
/*
|
|
||||||
* Copyright (c) 2018 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.
|
|
||||||
*/
|
|
||||||
|
|
||||||
#include <janet/janet.h>
|
|
||||||
#include <stdlib.h>
|
|
||||||
#include <errno.h>
|
|
||||||
|
|
||||||
/*****************/
|
|
||||||
/* JSON Decoding */
|
|
||||||
/*****************/
|
|
||||||
|
|
||||||
/* Check if a character is whitespace */
|
|
||||||
static int white(uint8_t c) {
|
|
||||||
return c == '\t' || c == '\n' || c == ' ' || c == '\r';
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Skip whitespace */
|
|
||||||
static void skipwhite(const char **p) {
|
|
||||||
const char *cp = *p;
|
|
||||||
for (;;) {
|
|
||||||
if (white(*cp))
|
|
||||||
cp++;
|
|
||||||
else
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
*p = cp;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Get a hex digit value */
|
|
||||||
static int hexdig(char dig) {
|
|
||||||
if (dig >= '0' && dig <= '9')
|
|
||||||
return dig - '0';
|
|
||||||
if (dig >= 'a' && dig <= 'f')
|
|
||||||
return 10 + dig - 'a';
|
|
||||||
if (dig >= 'A' && dig <= 'F')
|
|
||||||
return 10 + dig - 'A';
|
|
||||||
return -1;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Read the hex value for a unicode escape */
|
|
||||||
static const char *decode_utf16_escape(const char *p, uint32_t *outpoint) {
|
|
||||||
if (!p[0] || !p[1] || !p[2] || !p[3])
|
|
||||||
return "unexpected end of source";
|
|
||||||
int d1 = hexdig(p[0]);
|
|
||||||
int d2 = hexdig(p[1]);
|
|
||||||
int d3 = hexdig(p[2]);
|
|
||||||
int d4 = hexdig(p[3]);
|
|
||||||
if (d1 < 0 || d2 < 0 || d3 < 0 || d4 < 0)
|
|
||||||
return "invalid hex digit";
|
|
||||||
*outpoint = d4 | (d3 << 4) | (d2 << 8) | (d1 << 12);
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Parse a string. Also handles the conversion of utf-16 to
|
|
||||||
* utf-8. */
|
|
||||||
static const char *decode_string(const char **p, Janet *out) {
|
|
||||||
JanetBuffer *buffer = janet_buffer(0);
|
|
||||||
const char *cp = *p;
|
|
||||||
while (*cp != '"') {
|
|
||||||
uint8_t b = (uint8_t) *cp;
|
|
||||||
if (b < 32) return "invalid character in string";
|
|
||||||
if (b == '\\') {
|
|
||||||
cp++;
|
|
||||||
switch(*cp) {
|
|
||||||
default:
|
|
||||||
return "unknown string escape";
|
|
||||||
case 'b':
|
|
||||||
b = '\b';
|
|
||||||
break;
|
|
||||||
case 'f':
|
|
||||||
b = '\f';
|
|
||||||
break;
|
|
||||||
case 'n':
|
|
||||||
b = '\n';
|
|
||||||
break;
|
|
||||||
case 'r':
|
|
||||||
b = '\r';
|
|
||||||
break;
|
|
||||||
case 't':
|
|
||||||
b = '\t';
|
|
||||||
break;
|
|
||||||
case '"':
|
|
||||||
b = '"';
|
|
||||||
break;
|
|
||||||
case '\\':
|
|
||||||
b = '\\';
|
|
||||||
break;
|
|
||||||
case 'u':
|
|
||||||
{
|
|
||||||
/* Get codepoint and check for surrogate pair */
|
|
||||||
uint32_t codepoint;
|
|
||||||
const char *err = decode_utf16_escape(cp + 1, &codepoint);
|
|
||||||
if (err) return err;
|
|
||||||
if (codepoint >= 0xDC00 && codepoint <= 0xDFFF) {
|
|
||||||
return "unexpected utf-16 low surrogate";
|
|
||||||
} else if (codepoint >= 0xD800 && codepoint <= 0xDBFF) {
|
|
||||||
if (cp[5] != '\\') return "expected utf-16 low surrogate pair";
|
|
||||||
if (cp[6] != 'u') return "expected utf-16 low surrogate pair";
|
|
||||||
uint32_t lowsur;
|
|
||||||
const char *err = decode_utf16_escape(cp + 7, &lowsur);
|
|
||||||
if (err) return err;
|
|
||||||
if (lowsur < 0xDC00 || lowsur > 0xDFFF)
|
|
||||||
return "expected utf-16 low surrogate pair";
|
|
||||||
codepoint = ((codepoint - 0xD800) << 10) +
|
|
||||||
(lowsur - 0xDC00) + 0x10000;
|
|
||||||
cp += 11;
|
|
||||||
} else {
|
|
||||||
cp += 5;
|
|
||||||
}
|
|
||||||
/* Write codepoint */
|
|
||||||
if (codepoint <= 0x7F) {
|
|
||||||
janet_buffer_push_u8(buffer, codepoint);
|
|
||||||
} else if (codepoint <= 0x7FF) {
|
|
||||||
janet_buffer_push_u8(buffer, ((codepoint >> 6) & 0x1F) | 0xC0);
|
|
||||||
janet_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80);
|
|
||||||
} else if (codepoint <= 0xFFFF) {
|
|
||||||
janet_buffer_push_u8(buffer, ((codepoint >> 12) & 0x0F) | 0xE0);
|
|
||||||
janet_buffer_push_u8(buffer, ((codepoint >> 6) & 0x3F) | 0x80);
|
|
||||||
janet_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80);
|
|
||||||
} else {
|
|
||||||
janet_buffer_push_u8(buffer, ((codepoint >> 18) & 0x07) | 0xF0);
|
|
||||||
janet_buffer_push_u8(buffer, ((codepoint >> 12) & 0x3F) | 0x80);
|
|
||||||
janet_buffer_push_u8(buffer, ((codepoint >> 6) & 0x3F) | 0x80);
|
|
||||||
janet_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
continue;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
janet_buffer_push_u8(buffer, b);
|
|
||||||
cp++;
|
|
||||||
}
|
|
||||||
*out = janet_stringv(buffer->data, buffer->count);
|
|
||||||
*p = cp + 1;
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
static const char *decode_one(const char **p, Janet *out, int depth) {
|
|
||||||
|
|
||||||
/* Prevent stack overflow */
|
|
||||||
if (depth > JANET_RECURSION_GUARD) goto recurdepth;
|
|
||||||
|
|
||||||
/* Skip leading whitepspace */
|
|
||||||
skipwhite(p);
|
|
||||||
|
|
||||||
/* Main switch */
|
|
||||||
switch (**p) {
|
|
||||||
default:
|
|
||||||
goto badchar;
|
|
||||||
case '\0':
|
|
||||||
goto eos;
|
|
||||||
/* Numbers */
|
|
||||||
case '-': case '0': case '1' : case '2': case '3' : case '4':
|
|
||||||
case '5': case '6': case '7' : case '8': case '9':
|
|
||||||
{
|
|
||||||
errno = 0;
|
|
||||||
char *end = NULL;
|
|
||||||
double x = strtod(*p, &end);
|
|
||||||
if (end == *p) goto badnum;
|
|
||||||
*p = end;
|
|
||||||
*out = janet_wrap_real(x);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
/* false, null, true */
|
|
||||||
case 'f':
|
|
||||||
{
|
|
||||||
const char *cp = *p;
|
|
||||||
if (cp[1] != 'a' || cp[2] != 'l' || cp[3] != 's' || cp[4] != 'e')
|
|
||||||
goto badident;
|
|
||||||
*out = janet_wrap_false();
|
|
||||||
*p = cp + 5;
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case 'n':
|
|
||||||
{
|
|
||||||
const char *cp = *p;
|
|
||||||
|
|
||||||
if (cp[1] != 'u' || cp[2] != 'l' || cp[3] != 'l')
|
|
||||||
goto badident;
|
|
||||||
*out = janet_wrap_nil();
|
|
||||||
*p = cp + 4;
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case 't':
|
|
||||||
{
|
|
||||||
const char *cp = *p;
|
|
||||||
if (cp[1] != 'r' || cp[2] != 'u' || cp[3] != 'e')
|
|
||||||
goto badident;
|
|
||||||
*out = janet_wrap_true();
|
|
||||||
*p = cp + 4;
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
/* String */
|
|
||||||
case '"':
|
|
||||||
{
|
|
||||||
const char *cp = *p + 1;
|
|
||||||
const char *start = cp;
|
|
||||||
while (*cp >= 32 && *cp != '"' && *cp != '\\')
|
|
||||||
cp++;
|
|
||||||
/* Only use a buffer for strings with escapes, else just copy
|
|
||||||
* memory from source */
|
|
||||||
if (*cp == '\\') {
|
|
||||||
*p = *p + 1;
|
|
||||||
const char *err = decode_string(p, out);
|
|
||||||
if (err) return err;
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
if (*cp != '"') goto badchar;
|
|
||||||
*p = cp + 1;
|
|
||||||
*out = janet_stringv((const uint8_t *)start, cp - start);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
/* Array */
|
|
||||||
case '[':
|
|
||||||
{
|
|
||||||
*p = *p + 1;
|
|
||||||
JanetArray *array = janet_array(0);
|
|
||||||
const char *err;
|
|
||||||
Janet subval;
|
|
||||||
skipwhite(p);
|
|
||||||
while (**p != ']') {
|
|
||||||
err = decode_one(p, &subval, depth + 1);
|
|
||||||
if (err) return err;
|
|
||||||
janet_array_push(array, subval);
|
|
||||||
skipwhite(p);
|
|
||||||
if (**p == ']') break;
|
|
||||||
if (**p != ',') goto wantcomma;
|
|
||||||
*p = *p + 1;
|
|
||||||
}
|
|
||||||
*p = *p + 1;
|
|
||||||
*out = janet_wrap_array(array);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
/* Object */
|
|
||||||
case '{':
|
|
||||||
{
|
|
||||||
*p = *p + 1;
|
|
||||||
JanetTable *table = janet_table(0);
|
|
||||||
const char *err;
|
|
||||||
Janet subkey, subval;
|
|
||||||
skipwhite(p);
|
|
||||||
while (**p != '}') {
|
|
||||||
skipwhite(p);
|
|
||||||
if (**p != '"') goto wantstring;
|
|
||||||
err = decode_one(p, &subkey, depth + 1);
|
|
||||||
if (err) return err;
|
|
||||||
skipwhite(p);
|
|
||||||
if (**p != ':') goto wantcolon;
|
|
||||||
*p = *p + 1;
|
|
||||||
err = decode_one(p, &subval, depth + 1);
|
|
||||||
if (err) return err;
|
|
||||||
janet_table_put(table, subkey, subval);
|
|
||||||
skipwhite(p);
|
|
||||||
if (**p == '}') break;
|
|
||||||
if (**p != ',') goto wantcomma;
|
|
||||||
*p = *p + 1;
|
|
||||||
}
|
|
||||||
*p = *p + 1;
|
|
||||||
*out = janet_wrap_table(table);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Good return */
|
|
||||||
return NULL;
|
|
||||||
|
|
||||||
/* Errors */
|
|
||||||
recurdepth:
|
|
||||||
return "recured too deeply";
|
|
||||||
eos:
|
|
||||||
return "unexpected end of source";
|
|
||||||
badident:
|
|
||||||
return "bad identifier";
|
|
||||||
badnum:
|
|
||||||
return "bad number";
|
|
||||||
wantcomma:
|
|
||||||
return "expected comma";
|
|
||||||
wantcolon:
|
|
||||||
return "expected colon";
|
|
||||||
badchar:
|
|
||||||
return "unexpected character";
|
|
||||||
wantstring:
|
|
||||||
return "expected json string";
|
|
||||||
}
|
|
||||||
|
|
||||||
static int json_decode(JanetArgs args) {
|
|
||||||
Janet ret;
|
|
||||||
JANET_FIXARITY(args, 1);
|
|
||||||
const char *err;
|
|
||||||
const char *start;
|
|
||||||
const char *p;
|
|
||||||
if (janet_checktype(args.v[0], JANET_BUFFER)) {
|
|
||||||
JanetBuffer *buffer = janet_unwrap_buffer(args.v[0]);
|
|
||||||
/* Ensure 0 padded */
|
|
||||||
janet_buffer_push_u8(buffer, 0);
|
|
||||||
start = p = (const char *)buffer->data;
|
|
||||||
err = decode_one(&p, &ret, 0);
|
|
||||||
buffer->count--;
|
|
||||||
} else {
|
|
||||||
const uint8_t *bytes;
|
|
||||||
int32_t len;
|
|
||||||
JANET_ARG_BYTES(bytes, len, args, 0);
|
|
||||||
start = p = (const char *)bytes;
|
|
||||||
err = decode_one(&p, &ret, 0);
|
|
||||||
}
|
|
||||||
/* Check trailing values */
|
|
||||||
if (!err) {
|
|
||||||
skipwhite(&p);
|
|
||||||
if (*p)
|
|
||||||
err = "unexpected extra token";
|
|
||||||
}
|
|
||||||
if (err) {
|
|
||||||
JANET_THROWV(args, janet_wrap_string(janet_formatc(
|
|
||||||
"decode error at postion %d: %s",
|
|
||||||
p - start,
|
|
||||||
err)));
|
|
||||||
}
|
|
||||||
JANET_RETURN(args, ret);
|
|
||||||
}
|
|
||||||
|
|
||||||
/*****************/
|
|
||||||
/* JSON Encoding */
|
|
||||||
/*****************/
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
JanetBuffer *buffer;
|
|
||||||
int32_t indent;
|
|
||||||
const uint8_t *tab;
|
|
||||||
const uint8_t *newline;
|
|
||||||
int32_t tablen;
|
|
||||||
int32_t newlinelen;
|
|
||||||
} Encoder;
|
|
||||||
|
|
||||||
static const char *encode_newline(Encoder *e) {
|
|
||||||
if (janet_buffer_push_bytes(e->buffer, e->newline, e->newlinelen))
|
|
||||||
return "buffer overflow";
|
|
||||||
/* Skip loop if no tab string */
|
|
||||||
if (e->tablen) {
|
|
||||||
for (int32_t i = 0; i < e->indent; i++)
|
|
||||||
if (janet_buffer_push_bytes(e->buffer, e->tab, e->tablen))
|
|
||||||
return "buffer overflow";
|
|
||||||
}
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
static const char *encode_one(Encoder *e, Janet x, int depth) {
|
|
||||||
switch(janet_type(x)) {
|
|
||||||
default:
|
|
||||||
goto badtype;
|
|
||||||
case JANET_NIL:
|
|
||||||
{
|
|
||||||
if (janet_buffer_push_cstring(e->buffer, "null"))
|
|
||||||
goto overflow;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case JANET_FALSE:
|
|
||||||
{
|
|
||||||
if (janet_buffer_push_cstring(e->buffer, "false"))
|
|
||||||
goto overflow;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case JANET_TRUE:
|
|
||||||
{
|
|
||||||
if (janet_buffer_push_cstring(e->buffer, "true"))
|
|
||||||
goto overflow;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case JANET_INTEGER:
|
|
||||||
{
|
|
||||||
char cbuf[20];
|
|
||||||
sprintf(cbuf, "%d", janet_unwrap_integer(x));
|
|
||||||
if (janet_buffer_push_cstring(e->buffer, cbuf))
|
|
||||||
goto overflow;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case JANET_REAL:
|
|
||||||
{
|
|
||||||
char cbuf[25];
|
|
||||||
sprintf(cbuf, "%.17g", janet_unwrap_real(x));
|
|
||||||
if (janet_buffer_push_cstring(e->buffer, cbuf))
|
|
||||||
goto overflow;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case JANET_STRING:
|
|
||||||
case JANET_SYMBOL:
|
|
||||||
case JANET_BUFFER:
|
|
||||||
{
|
|
||||||
const uint8_t *bytes;
|
|
||||||
const uint8_t *c;
|
|
||||||
const uint8_t *end;
|
|
||||||
int32_t len;
|
|
||||||
janet_bytes_view(x, &bytes, &len);
|
|
||||||
if (janet_buffer_push_u8(e->buffer, '"')) goto overflow;
|
|
||||||
c = bytes;
|
|
||||||
end = bytes + len;
|
|
||||||
while (c < end) {
|
|
||||||
|
|
||||||
/* get codepoint */
|
|
||||||
uint32_t codepoint;
|
|
||||||
if (*c < 0x80) {
|
|
||||||
/* one byte */
|
|
||||||
codepoint = *c++;
|
|
||||||
} else if (*c < 0xE0) {
|
|
||||||
/* two bytes */
|
|
||||||
if (c + 2 > end) goto overflow;
|
|
||||||
codepoint = ((c[0] & 0x1F) << 6) |
|
|
||||||
(c[1] & 0x3F);
|
|
||||||
c += 2;
|
|
||||||
} else if (*c < 0xF0) {
|
|
||||||
/* three bytes */
|
|
||||||
if (c + 3 > end) goto overflow;
|
|
||||||
codepoint = ((c[0] & 0x0F) << 12) |
|
|
||||||
((c[1] & 0x3F) << 6) |
|
|
||||||
(c[2] & 0x3F);
|
|
||||||
c += 3;
|
|
||||||
} else if (*c < 0xF8) {
|
|
||||||
/* four bytes */
|
|
||||||
if (c + 4 > end) goto overflow;
|
|
||||||
codepoint = ((c[0] & 0x07) << 18) |
|
|
||||||
((c[1] & 0x3F) << 12) |
|
|
||||||
((c[3] & 0x3F) << 6) |
|
|
||||||
(c[3] & 0x3F);
|
|
||||||
c += 4;
|
|
||||||
} else {
|
|
||||||
/* invalid */
|
|
||||||
goto invalidutf8;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* write codepoint */
|
|
||||||
if (codepoint > 0x1F && codepoint < 0x80) {
|
|
||||||
/* Normal, no escape */
|
|
||||||
if (codepoint == '\\' || codepoint == '"')
|
|
||||||
if (janet_buffer_push_u8(e->buffer, '\\'))
|
|
||||||
goto overflow;
|
|
||||||
if (janet_buffer_push_u8(e->buffer, (uint8_t) codepoint))
|
|
||||||
goto overflow;
|
|
||||||
} else if (codepoint < 0x10000) {
|
|
||||||
/* One unicode escape */
|
|
||||||
uint8_t buf[6];
|
|
||||||
buf[0] = '\\';
|
|
||||||
buf[1] = 'u';
|
|
||||||
buf[2] = (codepoint >> 12) & 0xF;
|
|
||||||
buf[3] = (codepoint >> 8) & 0xF;
|
|
||||||
buf[4] = (codepoint >> 4) & 0xF;
|
|
||||||
buf[5] = codepoint & 0xF;
|
|
||||||
if (janet_buffer_push_bytes(e->buffer, buf, sizeof(buf)))
|
|
||||||
goto overflow;
|
|
||||||
} else {
|
|
||||||
/* Two unicode escapes (surrogate pair) */
|
|
||||||
uint32_t hi, lo;
|
|
||||||
uint8_t buf[12];
|
|
||||||
hi = ((codepoint - 0x10000) >> 10) + 0xD800;
|
|
||||||
lo = ((codepoint - 0x10000) & 0x3FF) + 0xDC00;
|
|
||||||
buf[0] = '\\';
|
|
||||||
buf[1] = 'u';
|
|
||||||
buf[2] = (hi >> 12) & 0xF;
|
|
||||||
buf[3] = (hi >> 8) & 0xF;
|
|
||||||
buf[4] = (hi >> 4) & 0xF;
|
|
||||||
buf[5] = hi & 0xF;
|
|
||||||
buf[6] = '\\';
|
|
||||||
buf[7] = 'u';
|
|
||||||
buf[8] = (lo >> 12) & 0xF;
|
|
||||||
buf[9] = (lo >> 8) & 0xF;
|
|
||||||
buf[10] = (lo >> 4) & 0xF;
|
|
||||||
buf[11] = lo & 0xF;
|
|
||||||
if (janet_buffer_push_bytes(e->buffer, buf, sizeof(buf)))
|
|
||||||
goto overflow;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (janet_buffer_push_u8(e->buffer, '"')) goto overflow;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case JANET_TUPLE:
|
|
||||||
case JANET_ARRAY:
|
|
||||||
{
|
|
||||||
const char *err;
|
|
||||||
const Janet *items;
|
|
||||||
int32_t len;
|
|
||||||
janet_indexed_view(x, &items, &len);
|
|
||||||
if (janet_buffer_push_u8(e->buffer, '[')) goto overflow;
|
|
||||||
e->indent++;
|
|
||||||
for (int32_t i = 0; i < len; i++) {
|
|
||||||
if ((err = encode_newline(e))) return err;
|
|
||||||
if ((err = encode_one(e, items[i], depth + 1)))
|
|
||||||
return err;
|
|
||||||
if (janet_buffer_push_u8(e->buffer, ','))
|
|
||||||
goto overflow;
|
|
||||||
}
|
|
||||||
e->indent--;
|
|
||||||
if (e->buffer->data[e->buffer->count - 1] == ',') {
|
|
||||||
e->buffer->count--;
|
|
||||||
if ((err = encode_newline(e))) return err;
|
|
||||||
}
|
|
||||||
if (janet_buffer_push_u8(e->buffer, ']')) goto overflow;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case JANET_TABLE:
|
|
||||||
case JANET_STRUCT:
|
|
||||||
{
|
|
||||||
const char *err;
|
|
||||||
const JanetKV *kvs;
|
|
||||||
int32_t count, capacity;
|
|
||||||
janet_dictionary_view(x, &kvs, &count, &capacity);
|
|
||||||
if (janet_buffer_push_u8(e->buffer, '{')) goto overflow;
|
|
||||||
e->indent++;
|
|
||||||
for (int32_t i = 0; i < capacity; i++) {
|
|
||||||
if (janet_checktype(kvs[i].key, JANET_NIL))
|
|
||||||
continue;
|
|
||||||
if (!janet_checktype(kvs[i].key, JANET_STRING))
|
|
||||||
return "only strings keys are allowed in objects";
|
|
||||||
if ((err = encode_newline(e))) return err;
|
|
||||||
if ((err = encode_one(e, kvs[i].key, depth + 1)))
|
|
||||||
return err;
|
|
||||||
const char *sep = e->tablen ? ": " : ":";
|
|
||||||
if (janet_buffer_push_cstring(e->buffer, sep))
|
|
||||||
goto overflow;
|
|
||||||
if ((err = encode_one(e, kvs[i].value, depth + 1)))
|
|
||||||
return err;
|
|
||||||
if (janet_buffer_push_u8(e->buffer, ','))
|
|
||||||
goto overflow;
|
|
||||||
}
|
|
||||||
e->indent--;
|
|
||||||
if (e->buffer->data[e->buffer->count - 1] == ',') {
|
|
||||||
e->buffer->count--;
|
|
||||||
if ((err = encode_newline(e))) return err;
|
|
||||||
}
|
|
||||||
if (janet_buffer_push_u8(e->buffer, '}')) goto overflow;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
return NULL;
|
|
||||||
|
|
||||||
/* Errors */
|
|
||||||
overflow:
|
|
||||||
return "buffer overflow";
|
|
||||||
badtype:
|
|
||||||
return "type not supported";
|
|
||||||
invalidutf8:
|
|
||||||
return "string contains invalid utf-8";
|
|
||||||
}
|
|
||||||
|
|
||||||
static int json_encode(JanetArgs args) {
|
|
||||||
JANET_MINARITY(args, 1);
|
|
||||||
JANET_MAXARITY(args, 3);
|
|
||||||
Encoder e;
|
|
||||||
e.indent = 0;
|
|
||||||
e.buffer = janet_buffer(10);
|
|
||||||
e.tab = NULL;
|
|
||||||
e.newline = NULL;
|
|
||||||
e.tablen = 0;
|
|
||||||
e.newlinelen = 0;
|
|
||||||
if (args.n >= 2) {
|
|
||||||
JANET_ARG_BYTES(e.tab, e.tablen, args, 1);
|
|
||||||
if (args.n >= 3) {
|
|
||||||
JANET_ARG_BYTES(e.newline, e.newlinelen, args, 2);
|
|
||||||
} else {
|
|
||||||
e.newline = (const uint8_t *)"\r\n";
|
|
||||||
e.newlinelen = 2;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
const char *err = encode_one(&e, args.v[0], 0);
|
|
||||||
if (err) JANET_THROW(args, err);
|
|
||||||
JANET_RETURN_BUFFER(args, e.buffer);
|
|
||||||
}
|
|
||||||
|
|
||||||
/****************/
|
|
||||||
/* Module Entry */
|
|
||||||
/****************/
|
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
|
||||||
{"encode", json_encode,
|
|
||||||
"(json/encode x)\n\n"
|
|
||||||
"Encodes a janet value in JSON (utf-8)."
|
|
||||||
},
|
|
||||||
{"decode", json_decode,
|
|
||||||
"(json/decode json-source)\n\n"
|
|
||||||
"Returns a janet object after parsing JSON."
|
|
||||||
},
|
|
||||||
{NULL, NULL, NULL}
|
|
||||||
};
|
|
||||||
|
|
||||||
JANET_MODULE_ENTRY(JanetArgs args) {
|
|
||||||
JanetTable *env = janet_env(args);
|
|
||||||
janet_cfuns(env, "json", cfuns);
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
62
natives/sqlite3/.gitignore
vendored
62
natives/sqlite3/.gitignore
vendored
@@ -1,62 +0,0 @@
|
|||||||
# Created by https://www.gitignore.io/api/c
|
|
||||||
|
|
||||||
### C ###
|
|
||||||
# Prerequisites
|
|
||||||
*.d
|
|
||||||
|
|
||||||
# Object files
|
|
||||||
*.o
|
|
||||||
*.ko
|
|
||||||
*.obj
|
|
||||||
*.elf
|
|
||||||
|
|
||||||
# Linker output
|
|
||||||
*.ilk
|
|
||||||
*.map
|
|
||||||
*.exp
|
|
||||||
|
|
||||||
# Precompiled Headers
|
|
||||||
*.gch
|
|
||||||
*.pch
|
|
||||||
|
|
||||||
# Libraries
|
|
||||||
*.lib
|
|
||||||
*.a
|
|
||||||
*.la
|
|
||||||
*.lo
|
|
||||||
|
|
||||||
# Shared objects (inc. Windows DLLs)
|
|
||||||
*.dll
|
|
||||||
*.so
|
|
||||||
*.so.*
|
|
||||||
*.dylib
|
|
||||||
|
|
||||||
# Executables
|
|
||||||
*.exe
|
|
||||||
*.out
|
|
||||||
*.app
|
|
||||||
*.i*86
|
|
||||||
*.x86_64
|
|
||||||
*.hex
|
|
||||||
|
|
||||||
# Debug files
|
|
||||||
*.dSYM/
|
|
||||||
*.su
|
|
||||||
*.idb
|
|
||||||
*.pdb
|
|
||||||
|
|
||||||
# Kernel Module Compile Results
|
|
||||||
*.mod*
|
|
||||||
*.cmd
|
|
||||||
.tmp_versions/
|
|
||||||
modules.order
|
|
||||||
Module.symvers
|
|
||||||
Mkfile.old
|
|
||||||
dkms.conf
|
|
||||||
|
|
||||||
|
|
||||||
# End of https://www.gitignore.io/api/c
|
|
||||||
|
|
||||||
sqlite3.c
|
|
||||||
sqlite3.h
|
|
||||||
sqlite-autoconf-3230100
|
|
||||||
@@ -1,60 +0,0 @@
|
|||||||
# Copyright (c) 2018 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.
|
|
||||||
|
|
||||||
CFLAGS=-std=c99 -Wall -Wextra -I../../src/include -O2 -shared -fpic \
|
|
||||||
-DSQLITE_THREADSAFE=0 \
|
|
||||||
-DSQLITE_OMIT_LOAD_EXTENSION
|
|
||||||
TARGET=sqlite3.so
|
|
||||||
|
|
||||||
# MacOS specifics
|
|
||||||
UNAME:=$(shell uname -s)
|
|
||||||
ifeq ($(UNAME), Darwin)
|
|
||||||
CFLAGS:=$(CFLAGS) -undefined dynamic_lookup
|
|
||||||
endif
|
|
||||||
|
|
||||||
# Default target
|
|
||||||
all: $(TARGET)
|
|
||||||
|
|
||||||
OBJECTS:=main.o sqlite3.o
|
|
||||||
$(TARGET): $(OBJECTS)
|
|
||||||
$(CC) $(CFLAGS) -o $@ $^
|
|
||||||
|
|
||||||
sqlite-autoconf-3230100/sqlite3.%:
|
|
||||||
curl https://www.sqlite.org/2018/sqlite-autoconf-3230100.tar.gz | tar -xvz
|
|
||||||
|
|
||||||
sqlite3.c: sqlite-autoconf-3230100/sqlite3.c
|
|
||||||
cp $< $@
|
|
||||||
sqlite3.h: sqlite-autoconf-3230100/sqlite3.h
|
|
||||||
cp $< $@
|
|
||||||
|
|
||||||
%.o: %.c sqlite3.h
|
|
||||||
$(CC) $(CFLAGS) -c $<
|
|
||||||
|
|
||||||
clean:
|
|
||||||
rm -rf sqlite-autoconf-3230100
|
|
||||||
rm *.o
|
|
||||||
rm sqlite3.c
|
|
||||||
rm sqlite3.h
|
|
||||||
rm $(TARGET)
|
|
||||||
|
|
||||||
install:
|
|
||||||
cp $(TARGET) $(DST_PATH)
|
|
||||||
|
|
||||||
.PHONY: clean all
|
|
||||||
@@ -1,428 +0,0 @@
|
|||||||
/*
|
|
||||||
* Copyright (c) 2018 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.
|
|
||||||
*/
|
|
||||||
|
|
||||||
#include "sqlite3.h"
|
|
||||||
#include <janet/janet.h>
|
|
||||||
|
|
||||||
#define FLAG_CLOSED 1
|
|
||||||
|
|
||||||
#define MSG_DB_CLOSED "database already closed"
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
sqlite3* handle;
|
|
||||||
int flags;
|
|
||||||
} Db;
|
|
||||||
|
|
||||||
/* Close a db, noop if already closed */
|
|
||||||
static void closedb(Db *db) {
|
|
||||||
if (!(db->flags & FLAG_CLOSED)) {
|
|
||||||
db->flags |= FLAG_CLOSED;
|
|
||||||
sqlite3_close_v2(db->handle);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Called to garbage collect a sqlite3 connection */
|
|
||||||
static int gcsqlite(void *p, size_t s) {
|
|
||||||
(void) s;
|
|
||||||
Db *db = (Db *)p;
|
|
||||||
closedb(db);
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
static const JanetAbstractType sql_conn_type = {
|
|
||||||
":sqlite3.connection",
|
|
||||||
gcsqlite,
|
|
||||||
NULL,
|
|
||||||
};
|
|
||||||
|
|
||||||
/* Open a new database connection */
|
|
||||||
static int sql_open(JanetArgs args) {
|
|
||||||
sqlite3 *conn;
|
|
||||||
const uint8_t *filename;
|
|
||||||
int status;
|
|
||||||
JANET_FIXARITY(args, 1);
|
|
||||||
JANET_ARG_STRING(filename, args, 0);
|
|
||||||
status = sqlite3_open((const char *)filename, &conn);
|
|
||||||
if (status == SQLITE_OK) {
|
|
||||||
Db *db = (Db *) janet_abstract(&sql_conn_type, sizeof(Db));
|
|
||||||
db->handle = conn;
|
|
||||||
db->flags = 0;
|
|
||||||
JANET_RETURN_ABSTRACT(args, db);
|
|
||||||
} else {
|
|
||||||
const char *err = sqlite3_errmsg(conn);
|
|
||||||
JANET_THROW(args, err);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Close a database connection */
|
|
||||||
static int sql_close(JanetArgs args) {
|
|
||||||
Db *db;
|
|
||||||
JANET_FIXARITY(args, 1);
|
|
||||||
JANET_ARG_ABSTRACT(db, args, 0, &sql_conn_type);
|
|
||||||
closedb(db);
|
|
||||||
JANET_RETURN_NIL(args);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Check for embedded NULL bytes */
|
|
||||||
static int has_null(const uint8_t *str, int32_t len) {
|
|
||||||
while (len--) {
|
|
||||||
if (!str[len])
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Bind a single parameter */
|
|
||||||
static const char *bind1(sqlite3_stmt *stmt, int index, Janet value) {
|
|
||||||
int res;
|
|
||||||
switch (janet_type(value)) {
|
|
||||||
default:
|
|
||||||
return "invalid sql value";
|
|
||||||
case JANET_NIL:
|
|
||||||
res = sqlite3_bind_null(stmt, index);
|
|
||||||
break;
|
|
||||||
case JANET_FALSE:
|
|
||||||
res = sqlite3_bind_int(stmt, index, 0);
|
|
||||||
break;
|
|
||||||
case JANET_TRUE:
|
|
||||||
res = sqlite3_bind_int(stmt, index, 1);
|
|
||||||
break;
|
|
||||||
case JANET_REAL:
|
|
||||||
res = sqlite3_bind_double(stmt, index, janet_unwrap_real(value));
|
|
||||||
break;
|
|
||||||
case JANET_INTEGER:
|
|
||||||
res = sqlite3_bind_int64(stmt, index, janet_unwrap_integer(value));
|
|
||||||
break;
|
|
||||||
case JANET_STRING:
|
|
||||||
case JANET_SYMBOL:
|
|
||||||
{
|
|
||||||
const uint8_t *str = janet_unwrap_string(value);
|
|
||||||
int32_t len = janet_string_length(str);
|
|
||||||
if (has_null(str, len)) {
|
|
||||||
return "cannot have embedded nulls in text values";
|
|
||||||
} else {
|
|
||||||
res = sqlite3_bind_text(stmt, index, (const char *)str, len + 1, SQLITE_STATIC);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case JANET_BUFFER:
|
|
||||||
{
|
|
||||||
JanetBuffer *buffer = janet_unwrap_buffer(value);
|
|
||||||
res = sqlite3_bind_blob(stmt, index, buffer->data, buffer->count, SQLITE_STATIC);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
if (res != SQLITE_OK) {
|
|
||||||
sqlite3 *db = sqlite3_db_handle(stmt);
|
|
||||||
return sqlite3_errmsg(db);
|
|
||||||
}
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Bind many parameters */
|
|
||||||
static const char *bindmany(sqlite3_stmt *stmt, Janet params) {
|
|
||||||
/* parameters */
|
|
||||||
const Janet *seq;
|
|
||||||
const JanetKV *kvs;
|
|
||||||
int32_t len, cap;
|
|
||||||
int limitindex = sqlite3_bind_parameter_count(stmt);
|
|
||||||
if (janet_indexed_view(params, &seq, &len)) {
|
|
||||||
if (len > limitindex + 1) {
|
|
||||||
return "invalid index in sql parameters";
|
|
||||||
}
|
|
||||||
for (int i = 0; i < len; i++) {
|
|
||||||
const char *err = bind1(stmt, i + 1, seq[i]);
|
|
||||||
if (err) {
|
|
||||||
return err;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else if (janet_dictionary_view(params, &kvs, &len, &cap)) {
|
|
||||||
for (int i = 0; i < cap; i++) {
|
|
||||||
int index = 0;
|
|
||||||
switch (janet_type(kvs[i].key)) {
|
|
||||||
default:
|
|
||||||
/* Will fail */
|
|
||||||
break;
|
|
||||||
case JANET_NIL:
|
|
||||||
/* Will skip as nil keys indicate empty hash table slot */
|
|
||||||
continue;
|
|
||||||
case JANET_INTEGER:
|
|
||||||
index = janet_unwrap_integer(kvs[i].key);
|
|
||||||
break;
|
|
||||||
case JANET_STRING:
|
|
||||||
case JANET_SYMBOL:
|
|
||||||
{
|
|
||||||
const uint8_t *s = janet_unwrap_string(kvs[i].key);
|
|
||||||
index = sqlite3_bind_parameter_index(
|
|
||||||
stmt,
|
|
||||||
(const char *)s);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
if (index <= 0 || index > limitindex) {
|
|
||||||
return "invalid index in sql parameters";
|
|
||||||
}
|
|
||||||
const char *err = bind1(stmt, index, kvs[i].value);
|
|
||||||
if (err) {
|
|
||||||
return err;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
return "invalid type for sql parameters";
|
|
||||||
}
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Execute a statement but don't collect results */
|
|
||||||
static const char *execute(sqlite3_stmt *stmt) {
|
|
||||||
int status;
|
|
||||||
const char *ret = NULL;
|
|
||||||
do {
|
|
||||||
status = sqlite3_step(stmt);
|
|
||||||
} while (status == SQLITE_ROW);
|
|
||||||
/* Check for errors */
|
|
||||||
if (status != SQLITE_DONE) {
|
|
||||||
sqlite3 *db = sqlite3_db_handle(stmt);
|
|
||||||
ret = sqlite3_errmsg(db);
|
|
||||||
}
|
|
||||||
return ret;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Execute and return values from prepared statement */
|
|
||||||
static const char *execute_collect(sqlite3_stmt *stmt, JanetArray *rows) {
|
|
||||||
/* Count number of columns in result */
|
|
||||||
int ncol = sqlite3_column_count(stmt);
|
|
||||||
int status;
|
|
||||||
const char *ret = NULL;
|
|
||||||
|
|
||||||
/* Get column names */
|
|
||||||
Janet *tupstart = janet_tuple_begin(ncol);
|
|
||||||
for (int i = 0; i < ncol; i++) {
|
|
||||||
tupstart[i] = janet_cstringv(sqlite3_column_name(stmt, i));
|
|
||||||
}
|
|
||||||
const Janet *colnames = janet_tuple_end(tupstart);
|
|
||||||
|
|
||||||
do {
|
|
||||||
status = sqlite3_step(stmt);
|
|
||||||
if (status == SQLITE_ROW) {
|
|
||||||
JanetKV *row = janet_struct_begin(ncol);
|
|
||||||
for (int i = 0; i < ncol; i++) {
|
|
||||||
int t = sqlite3_column_type(stmt, i);
|
|
||||||
Janet value;
|
|
||||||
switch (t) {
|
|
||||||
case SQLITE_NULL:
|
|
||||||
value = janet_wrap_nil();
|
|
||||||
break;
|
|
||||||
case SQLITE_INTEGER:
|
|
||||||
value = janet_wrap_integer(sqlite3_column_int(stmt, i));
|
|
||||||
break;
|
|
||||||
case SQLITE_FLOAT:
|
|
||||||
value = janet_wrap_real(sqlite3_column_double(stmt, i));
|
|
||||||
break;
|
|
||||||
case SQLITE_TEXT:
|
|
||||||
{
|
|
||||||
int nbytes = sqlite3_column_bytes(stmt, i);
|
|
||||||
uint8_t *str = janet_string_begin(nbytes);
|
|
||||||
memcpy(str, sqlite3_column_text(stmt, i), nbytes);
|
|
||||||
value = janet_wrap_string(janet_string_end(str));
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case SQLITE_BLOB:
|
|
||||||
{
|
|
||||||
int nbytes = sqlite3_column_bytes(stmt, i);
|
|
||||||
JanetBuffer *b = janet_buffer(nbytes);
|
|
||||||
memcpy(b->data, sqlite3_column_blob(stmt, i), nbytes);
|
|
||||||
b->count = nbytes;
|
|
||||||
value = janet_wrap_buffer(b);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
janet_struct_put(row, colnames[i], value);
|
|
||||||
}
|
|
||||||
janet_array_push(rows, janet_wrap_struct(janet_struct_end(row)));
|
|
||||||
}
|
|
||||||
} while (status == SQLITE_ROW);
|
|
||||||
|
|
||||||
/* Check for errors */
|
|
||||||
if (status != SQLITE_DONE) {
|
|
||||||
sqlite3 *db = sqlite3_db_handle(stmt);
|
|
||||||
ret = sqlite3_errmsg(db);
|
|
||||||
}
|
|
||||||
return ret;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Evaluate a string of sql */
|
|
||||||
static int sql_eval(JanetArgs args) {
|
|
||||||
const char *err;
|
|
||||||
sqlite3_stmt *stmt = NULL, *stmt_next = NULL;
|
|
||||||
const uint8_t *query;
|
|
||||||
|
|
||||||
JANET_MINARITY(args, 2);
|
|
||||||
JANET_MAXARITY(args, 3);
|
|
||||||
JANET_CHECKABSTRACT(args, 0, &sql_conn_type);
|
|
||||||
Db *db = (Db *)janet_unwrap_abstract(args.v[0]);
|
|
||||||
if (db->flags & FLAG_CLOSED) {
|
|
||||||
JANET_THROW(args, MSG_DB_CLOSED);
|
|
||||||
}
|
|
||||||
JANET_ARG_STRING(query, args, 1);
|
|
||||||
if (has_null(query, janet_string_length(query))) {
|
|
||||||
err = "cannot have embedded NULL in sql statememts";
|
|
||||||
goto error;
|
|
||||||
}
|
|
||||||
JanetArray *rows = janet_array(10);
|
|
||||||
const char *c = (const char *)query;
|
|
||||||
|
|
||||||
/* Evaluate all statements in a loop */
|
|
||||||
do {
|
|
||||||
/* Compile the next statement */
|
|
||||||
if (sqlite3_prepare_v2(db->handle, c, -1, &stmt_next, &c) != SQLITE_OK) {
|
|
||||||
err = sqlite3_errmsg(db->handle);
|
|
||||||
goto error;
|
|
||||||
}
|
|
||||||
/* Check if we have found last statement */
|
|
||||||
if (NULL == stmt_next) {
|
|
||||||
/* Execute current statement and collect results */
|
|
||||||
if (stmt) {
|
|
||||||
err = execute_collect(stmt, rows);
|
|
||||||
if (err) goto error;
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
/* Execute current statement but don't collect results. */
|
|
||||||
if (stmt) {
|
|
||||||
err = execute(stmt);
|
|
||||||
if (err) goto error;
|
|
||||||
}
|
|
||||||
/* Bind params to next statement*/
|
|
||||||
if (args.n == 3) {
|
|
||||||
/* parameters */
|
|
||||||
err = bindmany(stmt_next, args.v[2]);
|
|
||||||
if (err) goto error;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
/* rotate stmt and stmt_next */
|
|
||||||
if (stmt) sqlite3_finalize(stmt);
|
|
||||||
stmt = stmt_next;
|
|
||||||
stmt_next = NULL;
|
|
||||||
} while (NULL != stmt);
|
|
||||||
|
|
||||||
/* Good return path */
|
|
||||||
JANET_RETURN_ARRAY(args, rows);
|
|
||||||
|
|
||||||
error:
|
|
||||||
if (stmt) sqlite3_finalize(stmt);
|
|
||||||
if (stmt_next) sqlite3_finalize(stmt_next);
|
|
||||||
JANET_THROW(args, err);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Convert int64_t to a string */
|
|
||||||
static const uint8_t *coerce_int64(int64_t x) {
|
|
||||||
uint8_t bytes[40];
|
|
||||||
int i = 0;
|
|
||||||
/* Edge cases */
|
|
||||||
if (x == 0) return janet_cstring("0");
|
|
||||||
if (x == INT64_MIN) return janet_cstring("-9,223,372,036,854,775,808");
|
|
||||||
/* Negative becomes pos */
|
|
||||||
if (x < 0) {
|
|
||||||
bytes[i++] = '-';
|
|
||||||
x = -x;
|
|
||||||
}
|
|
||||||
while (x) {
|
|
||||||
bytes[i++] = x % 10;
|
|
||||||
x = x / 10;
|
|
||||||
}
|
|
||||||
bytes[i] = '\0';
|
|
||||||
return janet_string(bytes, i);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Gets the last inserted row id */
|
|
||||||
static int sql_last_insert_rowid(JanetArgs args) {
|
|
||||||
JANET_FIXARITY(args, 1);
|
|
||||||
JANET_CHECKABSTRACT(args, 0, &sql_conn_type);
|
|
||||||
Db *db = (Db *)janet_unwrap_abstract(args.v[0]);
|
|
||||||
if (db->flags & FLAG_CLOSED) {
|
|
||||||
JANET_THROW(args, MSG_DB_CLOSED);
|
|
||||||
}
|
|
||||||
sqlite3_int64 id = sqlite3_last_insert_rowid(db->handle);
|
|
||||||
if (id >= INT32_MIN && id <= INT32_MAX) {
|
|
||||||
JANET_RETURN_INTEGER(args, (int32_t) id);
|
|
||||||
}
|
|
||||||
/* Convert to string */
|
|
||||||
JANET_RETURN_STRING(args, coerce_int64(id));
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Get the sqlite3 errcode */
|
|
||||||
static int sql_error_code(JanetArgs args) {
|
|
||||||
JANET_FIXARITY(args, 1);
|
|
||||||
JANET_CHECKABSTRACT(args, 0, &sql_conn_type);
|
|
||||||
Db *db = (Db *)janet_unwrap_abstract(args.v[0]);
|
|
||||||
if (db->flags & FLAG_CLOSED) {
|
|
||||||
JANET_THROW(args, MSG_DB_CLOSED);
|
|
||||||
}
|
|
||||||
int errcode = sqlite3_errcode(db->handle);
|
|
||||||
JANET_RETURN_INTEGER(args, errcode);
|
|
||||||
}
|
|
||||||
|
|
||||||
/*****************************************************************************/
|
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
|
||||||
{"open", sql_open,
|
|
||||||
"(sqlite3/open path)\n\n"
|
|
||||||
"Opens a sqlite3 database on disk. Returns the database handle if the database was opened "
|
|
||||||
"successfully, and otheriwse throws an error."
|
|
||||||
},
|
|
||||||
{"close", sql_close,
|
|
||||||
"(sqlite3/close db)\n\n"
|
|
||||||
"Closes a database. Use this to free a database after use. Returns nil."
|
|
||||||
},
|
|
||||||
{"eval", sql_eval,
|
|
||||||
"(sqlite3/eval db sql [,params])\n\n"
|
|
||||||
"Evaluate sql in the context of database db. Multiple sql statements "
|
|
||||||
"can be changed together, and optionally parameters maybe passed in. "
|
|
||||||
"The optional parameters maybe either an indexed data type (tuple or array), or a dictionary "
|
|
||||||
"data type (struct or table). If params is a tuple or array, then sqlite "
|
|
||||||
"parameters are substituted using indices. For example:\n\n"
|
|
||||||
"\t(sqlite3/eval db `SELECT * FROM tab WHERE id = ?;` [123])\n\n"
|
|
||||||
"Will select rows from tab where id is equal to 123. Alternatively, "
|
|
||||||
"the programmer can use named parameters with tables or structs, like so:\n\n"
|
|
||||||
"\t(sqlite3/eval db `SELECT * FROM tab WHERE id = :id;` {:id 123})\n\n"
|
|
||||||
"Will return an array of rows, where each row contains a table where columns names "
|
|
||||||
"are keys for column values."
|
|
||||||
},
|
|
||||||
{"last-insert-rowid", sql_last_insert_rowid,
|
|
||||||
"(sqlite3/last-insert-rowid db)\n\n"
|
|
||||||
"Returns the id of the last inserted row. If the id will fit into a 32-bit"
|
|
||||||
"signed integer, will returned an integer, otherwise will return a string representation "
|
|
||||||
"of the id (an 8 bytes string containing a long integer)."
|
|
||||||
},
|
|
||||||
{"error-code", sql_error_code,
|
|
||||||
"(sqlite3/error-code db)\n\n"
|
|
||||||
"Returns the error number of the last sqlite3 command that threw an error. Cross "
|
|
||||||
"check these numbers with the SQLite documentation for more information."
|
|
||||||
},
|
|
||||||
{NULL, NULL, NULL}
|
|
||||||
};
|
|
||||||
|
|
||||||
JANET_MODULE_ENTRY(JanetArgs args) {
|
|
||||||
JanetTable *env = janet_env(args);
|
|
||||||
janet_cfuns(env, "sqlite3", cfuns);
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,16 +20,16 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
|
|
||||||
int main() {
|
#include "tests.h"
|
||||||
|
|
||||||
|
int array_test() {
|
||||||
|
|
||||||
int i;
|
int i;
|
||||||
JanetArray *array1, *array2;
|
JanetArray *array1, *array2;
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
array1 = janet_array(10);
|
array1 = janet_array(10);
|
||||||
array2 = janet_array(0);
|
array2 = janet_array(0);
|
||||||
|
|
||||||
@@ -62,7 +62,5 @@ int main() {
|
|||||||
|
|
||||||
assert(array1->count == 5);
|
assert(array1->count == 5);
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
62
src/boot/boot.c
Normal file
62
src/boot/boot.c
Normal file
@@ -0,0 +1,62 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 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.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include <janet.h>
|
||||||
|
#include "tests.h"
|
||||||
|
|
||||||
|
extern const unsigned char *janet_gen_boot;
|
||||||
|
extern int32_t janet_gen_boot_size;
|
||||||
|
|
||||||
|
int main(int argc, const char **argv) {
|
||||||
|
|
||||||
|
/* Init janet */
|
||||||
|
janet_init();
|
||||||
|
|
||||||
|
/* Run tests */
|
||||||
|
array_test();
|
||||||
|
buffer_test();
|
||||||
|
number_test();
|
||||||
|
system_test();
|
||||||
|
table_test();
|
||||||
|
|
||||||
|
/* C tests passed */
|
||||||
|
|
||||||
|
/* Set up VM */
|
||||||
|
int status;
|
||||||
|
JanetTable *env;
|
||||||
|
|
||||||
|
env = janet_core_env(NULL);
|
||||||
|
|
||||||
|
/* Create args tuple */
|
||||||
|
JanetArray *args = janet_array(argc);
|
||||||
|
for (int i = 0; i < argc; i++)
|
||||||
|
janet_array_push(args, janet_cstringv(argv[i]));
|
||||||
|
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
||||||
|
|
||||||
|
/* Run bootstrap script to generate core image */
|
||||||
|
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, "boot.janet", NULL);
|
||||||
|
|
||||||
|
/* Deinitialize vm */
|
||||||
|
janet_deinit();
|
||||||
|
|
||||||
|
return status;
|
||||||
|
}
|
||||||
1877
src/boot/boot.janet
Normal file
1877
src/boot/boot.janet
Normal file
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,16 +20,16 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
|
|
||||||
int main() {
|
#include "tests.h"
|
||||||
|
|
||||||
|
int buffer_test() {
|
||||||
|
|
||||||
int i;
|
int i;
|
||||||
JanetBuffer *buffer1, *buffer2;
|
JanetBuffer *buffer1, *buffer2;
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
buffer1 = janet_buffer(100);
|
buffer1 = janet_buffer(100);
|
||||||
buffer2 = janet_buffer(0);
|
buffer2 = janet_buffer(0);
|
||||||
|
|
||||||
@@ -58,7 +58,5 @@ int main() {
|
|||||||
assert(buffer1->data[i] == buffer2->data[i]);
|
assert(buffer1->data[i] == buffer2->data[i]);
|
||||||
}
|
}
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
67
src/boot/number_test.c
Normal file
67
src/boot/number_test.c
Normal file
@@ -0,0 +1,67 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 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.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include <janet.h>
|
||||||
|
#include <stdio.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include <assert.h>
|
||||||
|
|
||||||
|
#include "tests.h"
|
||||||
|
|
||||||
|
/* Check a subset of numbers against system implementation.
|
||||||
|
* Note that this depends on the system implementation being correct,
|
||||||
|
* which may not be the case for old or non compliant systems. Also,
|
||||||
|
* we cannot check against bases other 10. */
|
||||||
|
|
||||||
|
/* Compare valid c numbers to system implementation. */
|
||||||
|
static void test_valid_str(const char *str) {
|
||||||
|
int err;
|
||||||
|
double cnum, jnum;
|
||||||
|
jnum = 0.0;
|
||||||
|
cnum = atof(str);
|
||||||
|
err = janet_scan_number((const uint8_t *) str, (int32_t) strlen(str), &jnum);
|
||||||
|
assert(!err);
|
||||||
|
assert(cnum == jnum);
|
||||||
|
}
|
||||||
|
|
||||||
|
int number_test() {
|
||||||
|
|
||||||
|
test_valid_str("1.0");
|
||||||
|
test_valid_str("1");
|
||||||
|
test_valid_str("2.1");
|
||||||
|
test_valid_str("1e10");
|
||||||
|
test_valid_str("2e10");
|
||||||
|
test_valid_str("1e-10");
|
||||||
|
test_valid_str("2e-10");
|
||||||
|
test_valid_str("1.123123e10");
|
||||||
|
test_valid_str("1.123123e-10");
|
||||||
|
test_valid_str("-1.23e2");
|
||||||
|
test_valid_str("-4.5e15");
|
||||||
|
test_valid_str("-4.5e151");
|
||||||
|
test_valid_str("-4.5e200");
|
||||||
|
test_valid_str("-4.5e123");
|
||||||
|
test_valid_str("123123123123123123132123");
|
||||||
|
test_valid_str("0000000011111111111111111111111111");
|
||||||
|
test_valid_str(".112312333333323123123123123123123");
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
@@ -1,6 +1,5 @@
|
|||||||
|
|
||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -21,11 +20,13 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
|
|
||||||
int main() {
|
#include "tests.h"
|
||||||
|
|
||||||
|
int system_test() {
|
||||||
|
|
||||||
#ifdef JANET_32
|
#ifdef JANET_32
|
||||||
assert(sizeof(void *) == 4);
|
assert(sizeof(void *) == 4);
|
||||||
@@ -33,8 +34,6 @@ int main() {
|
|||||||
assert(sizeof(void *) == 8);
|
assert(sizeof(void *) == 8);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
/* Reflexive testing and nanbox testing */
|
/* Reflexive testing and nanbox testing */
|
||||||
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
|
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
|
||||||
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));
|
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));
|
||||||
@@ -43,13 +42,13 @@ int main() {
|
|||||||
assert(janet_equals(janet_wrap_integer(INT32_MAX), janet_wrap_integer(INT32_MAX)));
|
assert(janet_equals(janet_wrap_integer(INT32_MAX), janet_wrap_integer(INT32_MAX)));
|
||||||
assert(janet_equals(janet_wrap_integer(-2), janet_wrap_integer(-2)));
|
assert(janet_equals(janet_wrap_integer(-2), janet_wrap_integer(-2)));
|
||||||
assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN)));
|
assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN)));
|
||||||
assert(janet_equals(janet_wrap_real(1.4), janet_wrap_real(1.4)));
|
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
|
||||||
assert(janet_equals(janet_wrap_real(3.14159265), janet_wrap_real(3.14159265)));
|
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
|
||||||
|
|
||||||
|
assert(NULL != &janet_wrap_nil);
|
||||||
|
|
||||||
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
||||||
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,15 +20,15 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
|
|
||||||
int main() {
|
#include "tests.h"
|
||||||
|
|
||||||
|
int table_test() {
|
||||||
|
|
||||||
JanetTable *t1, *t2;
|
JanetTable *t1, *t2;
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
t1 = janet_table(10);
|
t1 = janet_table(10);
|
||||||
t2 = janet_table(0);
|
t2 = janet_table(0);
|
||||||
|
|
||||||
@@ -61,7 +61,5 @@ int main() {
|
|||||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
|
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(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
11
src/boot/tests.h
Normal file
11
src/boot/tests.h
Normal file
@@ -0,0 +1,11 @@
|
|||||||
|
#ifndef TESTS_H_DNMBUYYL
|
||||||
|
#define TESTS_H_DNMBUYYL
|
||||||
|
|
||||||
|
/* Tests */
|
||||||
|
extern int array_test();
|
||||||
|
extern int buffer_test();
|
||||||
|
extern int number_test();
|
||||||
|
extern int system_test();
|
||||||
|
extern int table_test();
|
||||||
|
|
||||||
|
#endif /* end of include guard: TESTS_H_DNMBUYYL */
|
||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,15 +20,16 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Create new userdata */
|
/* Create new userdata */
|
||||||
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
||||||
char *data = janet_gcalloc(JANET_MEMORY_ABSTRACT, sizeof(JanetAbstractHeader) + size);
|
JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_ABSTRACT,
|
||||||
JanetAbstractHeader *header = (JanetAbstractHeader *)data;
|
sizeof(JanetAbstractHead) + size);
|
||||||
void *a = data + sizeof(JanetAbstractHeader);
|
|
||||||
header->size = size;
|
header->size = size;
|
||||||
header->type = atype;
|
header->type = atype;
|
||||||
return a;
|
return (void *) & (header->data);
|
||||||
}
|
}
|
||||||
|
|||||||
262
src/core/array.c
262
src/core/array.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,8 +20,12 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
/* Initializes an array */
|
/* Initializes an array */
|
||||||
@@ -118,194 +122,190 @@ Janet janet_array_peek(JanetArray *array) {
|
|||||||
|
|
||||||
/* C Functions */
|
/* C Functions */
|
||||||
|
|
||||||
static int cfun_new(JanetArgs args) {
|
static Janet cfun_array_new(int32_t argc, Janet *argv) {
|
||||||
int32_t cap;
|
janet_fixarity(argc, 1);
|
||||||
JanetArray *array;
|
int32_t cap = janet_getinteger(argv, 0);
|
||||||
JANET_FIXARITY(args, 1);
|
JanetArray *array = janet_array(cap);
|
||||||
JANET_ARG_INTEGER(cap, args, 0);
|
return janet_wrap_array(array);
|
||||||
array = janet_array(cap);
|
|
||||||
JANET_RETURN_ARRAY(args, array);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_pop(JanetArgs args) {
|
static Janet cfun_array_pop(int32_t argc, Janet *argv) {
|
||||||
JanetArray *array;
|
janet_fixarity(argc, 1);
|
||||||
JANET_FIXARITY(args, 1);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
JANET_ARG_ARRAY(array, args, 0);
|
return janet_array_pop(array);
|
||||||
JANET_RETURN(args, janet_array_pop(array));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_peek(JanetArgs args) {
|
static Janet cfun_array_peek(int32_t argc, Janet *argv) {
|
||||||
JanetArray *array;
|
janet_fixarity(argc, 1);
|
||||||
JANET_FIXARITY(args, 1);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
JANET_ARG_ARRAY(array, args, 0);
|
return janet_array_peek(array);
|
||||||
JANET_RETURN(args, janet_array_peek(array));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_push(JanetArgs args) {
|
static Janet cfun_array_push(int32_t argc, Janet *argv) {
|
||||||
JanetArray *array;
|
janet_arity(argc, 1, -1);
|
||||||
int32_t newcount;
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
JANET_MINARITY(args, 1);
|
int32_t newcount = array->count - 1 + argc;
|
||||||
JANET_ARG_ARRAY(array, args, 0);
|
|
||||||
newcount = array->count - 1 + args.n;
|
|
||||||
janet_array_ensure(array, newcount, 2);
|
janet_array_ensure(array, newcount, 2);
|
||||||
if (args.n > 1) memcpy(array->data + array->count, args.v + 1, (args.n - 1) * sizeof(Janet));
|
if (argc > 1) memcpy(array->data + array->count, argv + 1, (argc - 1) * sizeof(Janet));
|
||||||
array->count = newcount;
|
array->count = newcount;
|
||||||
JANET_RETURN(args, args.v[0]);
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_ensure(JanetArgs args) {
|
static Janet cfun_array_ensure(int32_t argc, Janet *argv) {
|
||||||
JanetArray *array;
|
janet_fixarity(argc, 3);
|
||||||
int32_t newcount;
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
int32_t growth;
|
int32_t newcount = janet_getinteger(argv, 1);
|
||||||
JANET_FIXARITY(args, 3);
|
int32_t growth = janet_getinteger(argv, 2);
|
||||||
JANET_ARG_ARRAY(array, args, 0);
|
if (newcount < 1) janet_panic("expected positive integer");
|
||||||
JANET_ARG_INTEGER(newcount, args, 1);
|
|
||||||
JANET_ARG_INTEGER(growth, args, 2);
|
|
||||||
if (newcount < 0) JANET_THROW(args, "expected positive integer");
|
|
||||||
janet_array_ensure(array, newcount, growth);
|
janet_array_ensure(array, newcount, growth);
|
||||||
JANET_RETURN(args, args.v[0]);
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_slice(JanetArgs args) {
|
static Janet cfun_array_slice(int32_t argc, Janet *argv) {
|
||||||
const Janet *vals;
|
JanetRange range = janet_getslice(argc, argv);
|
||||||
int32_t len;
|
JanetView view = janet_getindexed(argv, 0);
|
||||||
JanetArray *ret;
|
JanetArray *array = janet_array(range.end - range.start);
|
||||||
int32_t start, end;
|
if (array->data)
|
||||||
JANET_MINARITY(args, 1);
|
memcpy(array->data, view.items + range.start, sizeof(Janet) * (range.end - range.start));
|
||||||
JANET_MAXARITY(args, 3);
|
array->count = range.end - range.start;
|
||||||
if (!janet_indexed_view(args.v[0], &vals, &len))
|
return janet_wrap_array(array);
|
||||||
JANET_THROW(args, "expected array|tuple");
|
|
||||||
/* Get start */
|
|
||||||
if (args.n < 2) {
|
|
||||||
start = 0;
|
|
||||||
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
|
|
||||||
start = janet_unwrap_integer(args.v[1]);
|
|
||||||
} else {
|
|
||||||
JANET_THROW(args, "expected integer");
|
|
||||||
}
|
|
||||||
/* Get end */
|
|
||||||
if (args.n < 3) {
|
|
||||||
end = -1;
|
|
||||||
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
|
|
||||||
end = janet_unwrap_integer(args.v[2]);
|
|
||||||
} else {
|
|
||||||
JANET_THROW(args, "expected integer");
|
|
||||||
}
|
|
||||||
if (start < 0) start = len + start;
|
|
||||||
if (end < 0) end = len + end + 1;
|
|
||||||
if (end < 0 || start < 0 || end > len || start > len)
|
|
||||||
JANET_THROW(args, "slice range out of bounds");
|
|
||||||
if (end >= start) {
|
|
||||||
ret = janet_array(end - start);
|
|
||||||
memcpy(ret->data, vals + start, sizeof(Janet) * (end - start));
|
|
||||||
ret->count = end - start;
|
|
||||||
} else {
|
|
||||||
ret = janet_array(0);
|
|
||||||
}
|
|
||||||
JANET_RETURN_ARRAY(args, ret);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_concat(JanetArgs args) {
|
static Janet cfun_array_concat(int32_t argc, Janet *argv) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
JanetArray *array;
|
janet_arity(argc, 1, -1);
|
||||||
JANET_MINARITY(args, 1);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
JANET_ARG_ARRAY(array, args, 0);
|
for (i = 1; i < argc; i++) {
|
||||||
for (i = 1; i < args.n; i++) {
|
switch (janet_type(argv[i])) {
|
||||||
switch (janet_type(args.v[i])) {
|
|
||||||
default:
|
default:
|
||||||
janet_array_push(array, args.v[i]);
|
janet_array_push(array, argv[i]);
|
||||||
break;
|
break;
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY:
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
int32_t j, len = 0;
|
||||||
int32_t j, len;
|
const Janet *vals = NULL;
|
||||||
const Janet *vals;
|
janet_indexed_view(argv[i], &vals, &len);
|
||||||
janet_indexed_view(args.v[i], &vals, &len);
|
|
||||||
for (j = 0; j < len; j++)
|
for (j = 0; j < len; j++)
|
||||||
janet_array_push(array, vals[j]);
|
janet_array_push(array, vals[j]);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
JANET_RETURN_ARRAY(args, array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_insert(JanetArgs args) {
|
static Janet cfun_array_insert(int32_t argc, Janet *argv) {
|
||||||
int32_t at;
|
|
||||||
size_t chunksize, restsize;
|
size_t chunksize, restsize;
|
||||||
JanetArray *array;
|
janet_arity(argc, 2, -1);
|
||||||
JANET_MINARITY(args, 2);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
JANET_ARG_ARRAY(array, args, 0);
|
int32_t at = janet_getinteger(argv, 1);
|
||||||
JANET_ARG_INTEGER(at, args, 1);
|
|
||||||
if (at < 0) {
|
if (at < 0) {
|
||||||
at = array->count + at + 1;
|
at = array->count + at + 1;
|
||||||
}
|
}
|
||||||
if (at < 0 || at > array->count)
|
if (at < 0 || at > array->count)
|
||||||
JANET_THROW(args, "insertion index out of bounds");
|
janet_panicf("insertion index %d out of range [0,%d]", at, array->count);
|
||||||
chunksize = (args.n - 2) * sizeof(Janet);
|
chunksize = (argc - 2) * sizeof(Janet);
|
||||||
restsize = (array->count - at) * sizeof(Janet);
|
restsize = (array->count - at) * sizeof(Janet);
|
||||||
janet_array_ensure(array, array->count + args.n - 2, 2);
|
janet_array_ensure(array, array->count + argc - 2, 2);
|
||||||
memmove(array->data + at + args.n - 2,
|
memmove(array->data + at + argc - 2,
|
||||||
array->data + at,
|
array->data + at,
|
||||||
restsize);
|
restsize);
|
||||||
memcpy(array->data + at, args.v + 2, chunksize);
|
memcpy(array->data + at, argv + 2, chunksize);
|
||||||
array->count += (args.n - 2);
|
array->count += (argc - 2);
|
||||||
JANET_RETURN_ARRAY(args, array);
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static Janet cfun_array_remove(int32_t argc, Janet *argv) {
|
||||||
{"array/new", cfun_new,
|
janet_arity(argc, 2, 3);
|
||||||
"(array/new capacity)\n\n"
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
"Creates a new empty array with a preallocated capacity. The same as "
|
int32_t at = janet_getinteger(argv, 1);
|
||||||
"(array) but can be more efficient if the maximum size of an array is known."
|
int32_t n = 1;
|
||||||
|
if (at < 0) {
|
||||||
|
at = array->count + at + 1;
|
||||||
|
}
|
||||||
|
if (at < 0 || at > array->count)
|
||||||
|
janet_panicf("removal index %d out of range [0,%d]", at, array->count);
|
||||||
|
if (argc == 3) {
|
||||||
|
n = janet_getinteger(argv, 2);
|
||||||
|
if (n < 0)
|
||||||
|
janet_panicf("expected non-negative integer for argument n, got %v", argv[2]);
|
||||||
|
}
|
||||||
|
if (at + n > array->count) {
|
||||||
|
n = array->count - at;
|
||||||
|
}
|
||||||
|
memmove(array->data + at,
|
||||||
|
array->data + at + n,
|
||||||
|
(array->count - at - n) * sizeof(Janet));
|
||||||
|
array->count -= n;
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg array_cfuns[] = {
|
||||||
|
{
|
||||||
|
"array/new", cfun_array_new,
|
||||||
|
JDOC("(array/new capacity)\n\n"
|
||||||
|
"Creates a new empty array with a pre-allocated capacity. The same as "
|
||||||
|
"(array) but can be more efficient if the maximum size of an array is known.")
|
||||||
},
|
},
|
||||||
{"array/pop", cfun_pop,
|
{
|
||||||
"(array/pop arr)\n\n"
|
"array/pop", cfun_array_pop,
|
||||||
|
JDOC("(array/pop arr)\n\n"
|
||||||
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
||||||
"the input array."
|
"the input array.")
|
||||||
},
|
},
|
||||||
{"array/peek", cfun_peek,
|
{
|
||||||
"(array/peek arr)\n\n"
|
"array/peek", cfun_array_peek,
|
||||||
"Returns the last element of the array. Does not modify the array."
|
JDOC("(array/peek arr)\n\n"
|
||||||
|
"Returns the last element of the array. Does not modify the array.")
|
||||||
},
|
},
|
||||||
{"array/push", cfun_push,
|
{
|
||||||
"(array/push arr x)\n\n"
|
"array/push", cfun_array_push,
|
||||||
"Insert an element in the end of an array. Modifies the input array and returns it."
|
JDOC("(array/push arr x)\n\n"
|
||||||
|
"Insert an element in the end of an array. Modifies the input array and returns it.")
|
||||||
},
|
},
|
||||||
{"array/ensure", cfun_ensure,
|
{
|
||||||
"(array/ensure arr capacity)\n\n"
|
"array/ensure", cfun_array_ensure,
|
||||||
"Ensures that the memory backing the array has enough memory for capacity "
|
JDOC("(array/ensure arr capacity)\n\n"
|
||||||
|
"Ensures that the memory backing the array is large enough for capacity "
|
||||||
"items. Capacity must be an integer. If the backing capacity is already enough, "
|
"items. Capacity must be an integer. If the backing capacity is already enough, "
|
||||||
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
||||||
"so that there is enough space."
|
"so that there is enough space.")
|
||||||
},
|
},
|
||||||
{"array/slice", cfun_slice,
|
{
|
||||||
"(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n"
|
"array/slice", cfun_array_slice,
|
||||||
|
JDOC("(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n"
|
||||||
"Takes a slice of array or tuple from start to end. The range is half open, "
|
"Takes a slice of array or tuple from start to end. The range is half open, "
|
||||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||||
"end of the array. By default, start is 0 and end is the length of the array. "
|
"end of the array. By default, start is 0 and end is the length of the array. "
|
||||||
"Returns a new array."
|
"Returns a new array.")
|
||||||
},
|
},
|
||||||
{"array/concat", cfun_concat,
|
{
|
||||||
"(array/concat arr & parts)\n\n"
|
"array/concat", cfun_array_concat,
|
||||||
|
JDOC("(array/concat arr & parts)\n\n"
|
||||||
"Concatenates a variadic number of arrays (and tuples) into the first argument "
|
"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 "
|
"which must 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. "
|
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
|
||||||
"Return the modified array arr."
|
"Return the modified array arr.")
|
||||||
},
|
},
|
||||||
{"array/insert", cfun_insert,
|
{
|
||||||
"(array/insert arr at & xs)\n\n"
|
"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 "
|
"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 "
|
"0 and the length of the array. A negative value for at will index from "
|
||||||
"the end of the array, such that inserting at -1 appends to the array. "
|
"the end of the array, such that inserting at -1 appends to the array. "
|
||||||
"Returns the array."
|
"Returns the array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/remove", cfun_array_remove,
|
||||||
|
JDOC("(array/remove arr at [, n=1])\n\n"
|
||||||
|
"Remove up to n elements starting at index at in array arr. at can index from "
|
||||||
|
"the end of the array with a negative index, and n must be a non-negative integer. "
|
||||||
|
"Returns the array.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Load the array module */
|
/* Load the array module */
|
||||||
int janet_lib_array(JanetArgs args) {
|
void janet_lib_array(JanetTable *env) {
|
||||||
JanetTable *env = janet_env(args);
|
janet_core_cfuns(env, NULL, array_cfuns);
|
||||||
janet_cfuns(env, NULL, cfuns);
|
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|||||||
269
src/core/asm.c
269
src/core/asm.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,9 +20,12 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <setjmp.h>
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#include <setjmp.h>
|
||||||
|
|
||||||
/* Conditionally compile this file */
|
/* Conditionally compile this file */
|
||||||
#ifdef JANET_ASSEMBLER
|
#ifdef JANET_ASSEMBLER
|
||||||
@@ -48,23 +51,21 @@ struct JanetAssembler {
|
|||||||
int32_t bytecode_count; /* Used for calculating labels */
|
int32_t bytecode_count; /* Used for calculating labels */
|
||||||
|
|
||||||
Janet name;
|
Janet name;
|
||||||
JanetTable labels; /* symbol -> bytecode index */
|
JanetTable labels; /* keyword -> bytecode index */
|
||||||
JanetTable constants; /* symbol -> constant index */
|
JanetTable constants; /* symbol -> constant index */
|
||||||
JanetTable slots; /* symbol -> slot index */
|
JanetTable slots; /* symbol -> slot index */
|
||||||
JanetTable envs; /* symbol -> environment index */
|
JanetTable envs; /* symbol -> environment index */
|
||||||
JanetTable defs; /* symbol -> funcdefs index */
|
JanetTable defs; /* symbol -> funcdefs index */
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Janet opcode descriptions in lexographic order. This
|
/* Janet opcode descriptions in lexicographic order. This
|
||||||
* allows a binary search over the elements to find the
|
* allows a binary search over the elements to find the
|
||||||
* correct opcode given a name. This works in reasonable
|
* correct opcode given a name. This works in reasonable
|
||||||
* time and is easier to setup statically than a hash table or
|
* time and is easier to setup statically than a hash table or
|
||||||
* prefix tree. */
|
* prefix tree. */
|
||||||
static const JanetInstructionDef janet_ops[] = {
|
static const JanetInstructionDef janet_ops[] = {
|
||||||
{"add", JOP_ADD},
|
{"add", JOP_ADD},
|
||||||
{"addi", JOP_ADD_INTEGER},
|
|
||||||
{"addim", JOP_ADD_IMMEDIATE},
|
{"addim", JOP_ADD_IMMEDIATE},
|
||||||
{"addr", JOP_ADD_REAL},
|
|
||||||
{"band", JOP_BAND},
|
{"band", JOP_BAND},
|
||||||
{"bnot", JOP_BNOT},
|
{"bnot", JOP_BNOT},
|
||||||
{"bor", JOP_BOR},
|
{"bor", JOP_BOR},
|
||||||
@@ -73,24 +74,17 @@ static const JanetInstructionDef janet_ops[] = {
|
|||||||
{"clo", JOP_CLOSURE},
|
{"clo", JOP_CLOSURE},
|
||||||
{"cmp", JOP_COMPARE},
|
{"cmp", JOP_COMPARE},
|
||||||
{"div", JOP_DIVIDE},
|
{"div", JOP_DIVIDE},
|
||||||
{"divi", JOP_DIVIDE_INTEGER},
|
|
||||||
{"divim", JOP_DIVIDE_IMMEDIATE},
|
{"divim", JOP_DIVIDE_IMMEDIATE},
|
||||||
{"divr", JOP_DIVIDE_REAL},
|
|
||||||
{"eq", JOP_EQUALS},
|
{"eq", JOP_EQUALS},
|
||||||
{"eqi", JOP_EQUALS_INTEGER},
|
|
||||||
{"eqim", JOP_EQUALS_IMMEDIATE},
|
{"eqim", JOP_EQUALS_IMMEDIATE},
|
||||||
{"eqn", JOP_NUMERIC_EQUAL},
|
{"eqn", JOP_NUMERIC_EQUAL},
|
||||||
{"eqr", JOP_EQUALS_REAL},
|
|
||||||
{"err", JOP_ERROR},
|
{"err", JOP_ERROR},
|
||||||
{"get", JOP_GET},
|
{"get", JOP_GET},
|
||||||
{"geti", JOP_GET_INDEX},
|
{"geti", JOP_GET_INDEX},
|
||||||
{"gt", JOP_GREATER_THAN},
|
{"gt", JOP_GREATER_THAN},
|
||||||
{"gti", JOP_GREATER_THAN_INTEGER},
|
{"gten", JOP_NUMERIC_GREATER_THAN_EQUAL},
|
||||||
{"gtim", JOP_GREATER_THAN_IMMEDIATE},
|
{"gtim", JOP_GREATER_THAN_IMMEDIATE},
|
||||||
{"gtn", JOP_NUMERIC_GREATER_THAN},
|
{"gtn", JOP_NUMERIC_GREATER_THAN},
|
||||||
{"gtr", JOP_GREATER_THAN_REAL},
|
|
||||||
{"gten", JOP_NUMERIC_GREATER_THAN_EQUAL},
|
|
||||||
{"gter", JOP_GREATER_THAN_EQUAL_REAL},
|
|
||||||
{"jmp", JOP_JUMP},
|
{"jmp", JOP_JUMP},
|
||||||
{"jmpif", JOP_JUMP_IF},
|
{"jmpif", JOP_JUMP_IF},
|
||||||
{"jmpno", JOP_JUMP_IF_NOT},
|
{"jmpno", JOP_JUMP_IF_NOT},
|
||||||
@@ -104,12 +98,10 @@ static const JanetInstructionDef janet_ops[] = {
|
|||||||
{"len", JOP_LENGTH},
|
{"len", JOP_LENGTH},
|
||||||
{"lt", JOP_LESS_THAN},
|
{"lt", JOP_LESS_THAN},
|
||||||
{"lten", JOP_NUMERIC_LESS_THAN_EQUAL},
|
{"lten", JOP_NUMERIC_LESS_THAN_EQUAL},
|
||||||
{"lter", JOP_LESS_THAN_EQUAL_REAL},
|
|
||||||
{"lti", JOP_LESS_THAN_INTEGER},
|
|
||||||
{"ltim", JOP_LESS_THAN_IMMEDIATE},
|
{"ltim", JOP_LESS_THAN_IMMEDIATE},
|
||||||
{"ltn", JOP_NUMERIC_LESS_THAN},
|
{"ltn", JOP_NUMERIC_LESS_THAN},
|
||||||
{"ltr", JOP_LESS_THAN_REAL},
|
|
||||||
{"mkarr", JOP_MAKE_ARRAY},
|
{"mkarr", JOP_MAKE_ARRAY},
|
||||||
|
{"mkbtp", JOP_MAKE_BRACKET_TUPLE},
|
||||||
{"mkbuf", JOP_MAKE_BUFFER},
|
{"mkbuf", JOP_MAKE_BUFFER},
|
||||||
{"mkstr", JOP_MAKE_STRING},
|
{"mkstr", JOP_MAKE_STRING},
|
||||||
{"mkstu", JOP_MAKE_STRUCT},
|
{"mkstu", JOP_MAKE_STRUCT},
|
||||||
@@ -118,9 +110,7 @@ static const JanetInstructionDef janet_ops[] = {
|
|||||||
{"movf", JOP_MOVE_FAR},
|
{"movf", JOP_MOVE_FAR},
|
||||||
{"movn", JOP_MOVE_NEAR},
|
{"movn", JOP_MOVE_NEAR},
|
||||||
{"mul", JOP_MULTIPLY},
|
{"mul", JOP_MULTIPLY},
|
||||||
{"muli", JOP_MULTIPLY_INTEGER},
|
|
||||||
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
||||||
{"mulr", JOP_MULTIPLY_REAL},
|
|
||||||
{"noop", JOP_NOOP},
|
{"noop", JOP_NOOP},
|
||||||
{"push", JOP_PUSH},
|
{"push", JOP_PUSH},
|
||||||
{"push2", JOP_PUSH_2},
|
{"push2", JOP_PUSH_2},
|
||||||
@@ -151,27 +141,25 @@ typedef struct TypeAlias {
|
|||||||
} TypeAlias;
|
} TypeAlias;
|
||||||
|
|
||||||
static const TypeAlias type_aliases[] = {
|
static const TypeAlias type_aliases[] = {
|
||||||
{":abstract", JANET_TFLAG_ABSTRACT},
|
{"abstract", JANET_TFLAG_ABSTRACT},
|
||||||
{":array", JANET_TFLAG_ARRAY},
|
{"array", JANET_TFLAG_ARRAY},
|
||||||
{":boolean", JANET_TFLAG_BOOLEAN},
|
{"boolean", JANET_TFLAG_BOOLEAN},
|
||||||
{":buffer", JANET_TFLAG_BUFFER},
|
{"buffer", JANET_TFLAG_BUFFER},
|
||||||
{":callable", JANET_TFLAG_CALLABLE},
|
{"callable", JANET_TFLAG_CALLABLE},
|
||||||
{":cfunction", JANET_TFLAG_CFUNCTION},
|
{"cfunction", JANET_TFLAG_CFUNCTION},
|
||||||
{":dictionary", JANET_TFLAG_DICTIONARY},
|
{"dictionary", JANET_TFLAG_DICTIONARY},
|
||||||
{":false", JANET_TFLAG_FALSE},
|
{"fiber", JANET_TFLAG_FIBER},
|
||||||
{":fiber", JANET_TFLAG_FIBER},
|
{"function", JANET_TFLAG_FUNCTION},
|
||||||
{":function", JANET_TFLAG_FUNCTION},
|
{"indexed", JANET_TFLAG_INDEXED},
|
||||||
{":indexed", JANET_TFLAG_INDEXED},
|
{"keyword", JANET_TFLAG_KEYWORD},
|
||||||
{":integer", JANET_TFLAG_INTEGER},
|
{"nil", JANET_TFLAG_NIL},
|
||||||
{":nil", JANET_TFLAG_NIL},
|
{"number", JANET_TFLAG_NUMBER},
|
||||||
{":number", JANET_TFLAG_NUMBER},
|
{"pointer", JANET_TFLAG_POINTER},
|
||||||
{":real", JANET_TFLAG_REAL},
|
{"string", JANET_TFLAG_STRING},
|
||||||
{":string", JANET_TFLAG_STRING},
|
{"struct", JANET_TFLAG_STRUCT},
|
||||||
{":struct", JANET_TFLAG_STRUCT},
|
{"symbol", JANET_TFLAG_SYMBOL},
|
||||||
{":symbol", JANET_TFLAG_SYMBOL},
|
{"table", JANET_TFLAG_TABLE},
|
||||||
{":table", JANET_TFLAG_BOOLEAN},
|
{"tuple", JANET_TFLAG_TUPLE}
|
||||||
{":true", JANET_TFLAG_TRUE},
|
|
||||||
{":tuple", JANET_TFLAG_BOOLEAN}
|
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Deinitialize an Assembler. Does not deinitialize the parents. */
|
/* Deinitialize an Assembler. Does not deinitialize the parents. */
|
||||||
@@ -210,8 +198,8 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
|
|||||||
}
|
}
|
||||||
/* Check for memoized value */
|
/* Check for memoized value */
|
||||||
check = janet_table_get(&a->envs, envname);
|
check = janet_table_get(&a->envs, envname);
|
||||||
if (janet_checktype(check, JANET_INTEGER)) {
|
if (janet_checktype(check, JANET_NUMBER)) {
|
||||||
return janet_unwrap_integer(check);
|
return (int32_t) janet_unwrap_number(check);
|
||||||
}
|
}
|
||||||
if (NULL == a->parent) return -2;
|
if (NULL == a->parent) return -2;
|
||||||
res = janet_asm_addenv(a->parent, envname);
|
res = janet_asm_addenv(a->parent, envname);
|
||||||
@@ -219,7 +207,7 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
|
|||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
envindex = def->environments_length;
|
envindex = def->environments_length;
|
||||||
janet_table_put(&a->envs, envname, janet_wrap_integer(envindex));
|
janet_table_put(&a->envs, envname, janet_wrap_number(envindex));
|
||||||
if (envindex >= a->environments_capacity) {
|
if (envindex >= a->environments_capacity) {
|
||||||
int32_t newcap = 2 * envindex;
|
int32_t newcap = 2 * envindex;
|
||||||
def->environments = realloc(def->environments, newcap * sizeof(int32_t));
|
def->environments = realloc(def->environments, newcap * sizeof(int32_t));
|
||||||
@@ -265,11 +253,16 @@ static int32_t doarg_1(
|
|||||||
default:
|
default:
|
||||||
goto error;
|
goto error;
|
||||||
break;
|
break;
|
||||||
case JANET_INTEGER:
|
case JANET_NUMBER: {
|
||||||
ret = janet_unwrap_integer(x);
|
double y = janet_unwrap_number(x);
|
||||||
|
if (janet_checkintrange(y)) {
|
||||||
|
ret = (int32_t) y;
|
||||||
|
} else {
|
||||||
|
goto error;
|
||||||
|
}
|
||||||
break;
|
break;
|
||||||
case JANET_TUPLE:
|
}
|
||||||
{
|
case JANET_TUPLE: {
|
||||||
const Janet *t = janet_unwrap_tuple(x);
|
const Janet *t = janet_unwrap_tuple(x);
|
||||||
if (argtype == JANET_OAT_TYPE) {
|
if (argtype == JANET_OAT_TYPE) {
|
||||||
int32_t i = 0;
|
int32_t i = 0;
|
||||||
@@ -282,25 +275,20 @@ static int32_t doarg_1(
|
|||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_SYMBOL:
|
case JANET_KEYWORD: {
|
||||||
{
|
if (NULL != c && argtype == JANET_OAT_LABEL) {
|
||||||
if (NULL != c) {
|
|
||||||
Janet result = janet_table_get(c, x);
|
Janet result = janet_table_get(c, x);
|
||||||
if (janet_checktype(result, JANET_INTEGER)) {
|
if (janet_checktype(result, JANET_NUMBER)) {
|
||||||
if (argtype == JANET_OAT_LABEL) {
|
|
||||||
ret = janet_unwrap_integer(result) - a->bytecode_count;
|
ret = janet_unwrap_integer(result) - a->bytecode_count;
|
||||||
} else {
|
} else {
|
||||||
ret = janet_unwrap_integer(result);
|
goto error;
|
||||||
}
|
|
||||||
} else {
|
|
||||||
janet_asm_errorv(a, janet_formatc("unknown name %v", x));
|
|
||||||
}
|
}
|
||||||
} else if (argtype == JANET_OAT_TYPE || argtype == JANET_OAT_SIMPLETYPE) {
|
} else if (argtype == JANET_OAT_TYPE || argtype == JANET_OAT_SIMPLETYPE) {
|
||||||
const TypeAlias *alias = janet_strbinsearch(
|
const TypeAlias *alias = janet_strbinsearch(
|
||||||
&type_aliases,
|
&type_aliases,
|
||||||
sizeof(type_aliases)/sizeof(TypeAlias),
|
sizeof(type_aliases) / sizeof(TypeAlias),
|
||||||
sizeof(TypeAlias),
|
sizeof(TypeAlias),
|
||||||
janet_unwrap_symbol(x));
|
janet_unwrap_keyword(x));
|
||||||
if (alias) {
|
if (alias) {
|
||||||
ret = alias->mask;
|
ret = alias->mask;
|
||||||
} else {
|
} else {
|
||||||
@@ -309,6 +297,19 @@ static int32_t doarg_1(
|
|||||||
} else {
|
} else {
|
||||||
goto error;
|
goto error;
|
||||||
}
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_SYMBOL: {
|
||||||
|
if (NULL != c) {
|
||||||
|
Janet result = janet_table_get(c, x);
|
||||||
|
if (janet_checktype(result, JANET_NUMBER)) {
|
||||||
|
ret = (int32_t) janet_unwrap_number(result);
|
||||||
|
} else {
|
||||||
|
janet_asm_errorv(a, janet_formatc("unknown name %v", x));
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
goto error;
|
||||||
|
}
|
||||||
if (argtype == JANET_OAT_ENVIRONMENT && ret == -1) {
|
if (argtype == JANET_OAT_ENVIRONMENT && ret == -1) {
|
||||||
/* Add a new env */
|
/* Add a new env */
|
||||||
ret = janet_asm_addenv(a, x);
|
ret = janet_asm_addenv(a, x);
|
||||||
@@ -323,7 +324,7 @@ static int32_t doarg_1(
|
|||||||
a->def->slotcount = (int32_t) ret + 1;
|
a->def->slotcount = (int32_t) ret + 1;
|
||||||
return ret;
|
return ret;
|
||||||
|
|
||||||
error:
|
error:
|
||||||
janet_asm_errorv(a, janet_formatc("error parsing instruction argument %v", x));
|
janet_asm_errorv(a, janet_formatc("error parsing instruction argument %v", x));
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -359,44 +360,38 @@ static uint32_t read_instruction(
|
|||||||
uint32_t instr = idef->opcode;
|
uint32_t instr = idef->opcode;
|
||||||
enum JanetInstructionType type = janet_instructions[idef->opcode];
|
enum JanetInstructionType type = janet_instructions[idef->opcode];
|
||||||
switch (type) {
|
switch (type) {
|
||||||
case JINT_0:
|
case JINT_0: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 1)
|
if (janet_tuple_length(argt) != 1)
|
||||||
janet_asm_error(a, "expected 0 arguments: (op)");
|
janet_asm_error(a, "expected 0 arguments: (op)");
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_S:
|
case JINT_S: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 2)
|
if (janet_tuple_length(argt) != 2)
|
||||||
janet_asm_error(a, "expected 1 argument: (op, slot)");
|
janet_asm_error(a, "expected 1 argument: (op, slot)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 2, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 2, 0, argt[1]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_L:
|
case JINT_L: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 2)
|
if (janet_tuple_length(argt) != 2)
|
||||||
janet_asm_error(a, "expected 1 argument: (op, label)");
|
janet_asm_error(a, "expected 1 argument: (op, label)");
|
||||||
instr |= doarg(a, JANET_OAT_LABEL, 1, 3, 1, argt[1]);
|
instr |= doarg(a, JANET_OAT_LABEL, 1, 3, 1, argt[1]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SS:
|
case JINT_SS: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, slot)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, slot)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 2, 2, 0, argt[2]);
|
instr |= doarg(a, JANET_OAT_SLOT, 2, 2, 0, argt[2]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SL:
|
case JINT_SL: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, label)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, label)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
instr |= doarg(a, JANET_OAT_LABEL, 2, 2, 1, argt[2]);
|
instr |= doarg(a, JANET_OAT_LABEL, 2, 2, 1, argt[2]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_ST:
|
case JINT_ST: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, type)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, type)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
@@ -404,24 +399,21 @@ static uint32_t read_instruction(
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SI:
|
case JINT_SI:
|
||||||
case JINT_SU:
|
case JINT_SU: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, integer)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, integer)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
instr |= doarg(a, JANET_OAT_INTEGER, 2, 2, type == JINT_SI, argt[2]);
|
instr |= doarg(a, JANET_OAT_INTEGER, 2, 2, type == JINT_SI, argt[2]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SD:
|
case JINT_SD: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, funcdef)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, funcdef)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
instr |= doarg(a, JANET_OAT_FUNCDEF, 2, 2, 0, argt[2]);
|
instr |= doarg(a, JANET_OAT_FUNCDEF, 2, 2, 0, argt[2]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SSS:
|
case JINT_SSS: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 4)
|
if (janet_tuple_length(argt) != 4)
|
||||||
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, slot)");
|
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, slot)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
@@ -430,8 +422,7 @@ static uint32_t read_instruction(
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SSI:
|
case JINT_SSI:
|
||||||
case JINT_SSU:
|
case JINT_SSU: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 4)
|
if (janet_tuple_length(argt) != 4)
|
||||||
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, integer)");
|
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, integer)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
@@ -439,8 +430,7 @@ static uint32_t read_instruction(
|
|||||||
instr |= doarg(a, JANET_OAT_INTEGER, 3, 1, type == JINT_SSI, argt[3]);
|
instr |= doarg(a, JANET_OAT_INTEGER, 3, 1, type == JINT_SSI, argt[3]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SES:
|
case JINT_SES: {
|
||||||
{
|
|
||||||
JanetAssembler *b = a;
|
JanetAssembler *b = a;
|
||||||
uint32_t env;
|
uint32_t env;
|
||||||
if (janet_tuple_length(argt) != 4)
|
if (janet_tuple_length(argt) != 4)
|
||||||
@@ -456,8 +446,7 @@ static uint32_t read_instruction(
|
|||||||
instr |= doarg(b, JANET_OAT_SLOT, 3, 1, 0, argt[3]);
|
instr |= doarg(b, JANET_OAT_SLOT, 3, 1, 0, argt[3]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SC:
|
case JINT_SC: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, constant)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, constant)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
@@ -469,7 +458,7 @@ static uint32_t read_instruction(
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Helper to get from a structure */
|
/* Helper to get from a structure */
|
||||||
static Janet janet_get(Janet ds, Janet key) {
|
static Janet janet_get1(Janet ds, Janet key) {
|
||||||
switch (janet_type(ds)) {
|
switch (janet_type(ds)) {
|
||||||
default:
|
default:
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
@@ -528,29 +517,34 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
"expected struct or table for assembly source");
|
"expected struct or table for assembly source");
|
||||||
|
|
||||||
/* Check for function name */
|
/* Check for function name */
|
||||||
a.name = janet_get(s, janet_csymbolv("name"));
|
a.name = janet_get1(s, janet_csymbolv("name"));
|
||||||
if (!janet_checktype(a.name, JANET_NIL)) {
|
if (!janet_checktype(a.name, JANET_NIL)) {
|
||||||
def->name = janet_to_string(a.name);
|
def->name = janet_to_string(a.name);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Set function arity */
|
/* Set function arity */
|
||||||
x = janet_get(s, janet_csymbolv("arity"));
|
x = janet_get1(s, janet_csymbolv("arity"));
|
||||||
def->arity = janet_checktype(x, JANET_INTEGER) ? janet_unwrap_integer(x) : 0;
|
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"));
|
||||||
|
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"));
|
||||||
|
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 */
|
/* Check vararg */
|
||||||
x = janet_get(s, janet_csymbolv("vararg"));
|
x = janet_get1(s, janet_csymbolv("vararg"));
|
||||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||||
|
|
||||||
/* Check strict arity */
|
|
||||||
x = janet_get(s, janet_csymbolv("fix-arity"));
|
|
||||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
|
|
||||||
|
|
||||||
/* Check source */
|
/* Check source */
|
||||||
x = janet_get(s, janet_csymbolv("source"));
|
x = janet_get1(s, janet_csymbolv("source"));
|
||||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||||
|
|
||||||
/* Create slot aliases */
|
/* Create slot aliases */
|
||||||
x = janet_get(s, janet_csymbolv("slots"));
|
x = janet_get1(s, janet_csymbolv("slots"));
|
||||||
if (janet_indexed_view(x, &arr, &count)) {
|
if (janet_indexed_view(x, &arr, &count)) {
|
||||||
for (i = 0; i < count; i++) {
|
for (i = 0; i < count; i++) {
|
||||||
Janet v = arr[i];
|
Janet v = arr[i];
|
||||||
@@ -571,7 +565,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Parse constants */
|
/* Parse constants */
|
||||||
x = janet_get(s, janet_csymbolv("constants"));
|
x = janet_get1(s, janet_csymbolv("constants"));
|
||||||
if (janet_indexed_view(x, &arr, &count)) {
|
if (janet_indexed_view(x, &arr, &count)) {
|
||||||
def->constants_length = count;
|
def->constants_length = count;
|
||||||
def->constants = malloc(sizeof(Janet) * count);
|
def->constants = malloc(sizeof(Janet) * count);
|
||||||
@@ -606,7 +600,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Parse sub funcdefs */
|
/* Parse sub funcdefs */
|
||||||
x = janet_get(s, janet_csymbolv("closures"));
|
x = janet_get1(s, janet_csymbolv("closures"));
|
||||||
if (janet_indexed_view(x, &arr, &count)) {
|
if (janet_indexed_view(x, &arr, &count)) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
for (i = 0; i < count; i++) {
|
for (i = 0; i < count; i++) {
|
||||||
@@ -617,7 +611,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
if (subres.status != JANET_ASSEMBLE_OK) {
|
if (subres.status != JANET_ASSEMBLE_OK) {
|
||||||
janet_asm_errorv(&a, subres.error);
|
janet_asm_errorv(&a, subres.error);
|
||||||
}
|
}
|
||||||
subname = janet_get(arr[i], janet_csymbolv("name"));
|
subname = janet_get1(arr[i], janet_csymbolv("name"));
|
||||||
if (!janet_checktype(subname, JANET_NIL)) {
|
if (!janet_checktype(subname, JANET_NIL)) {
|
||||||
janet_table_put(&a.defs, subname, janet_wrap_integer(def->defs_length));
|
janet_table_put(&a.defs, subname, janet_wrap_integer(def->defs_length));
|
||||||
}
|
}
|
||||||
@@ -636,13 +630,13 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Parse bytecode and labels */
|
/* Parse bytecode and labels */
|
||||||
x = janet_get(s, janet_csymbolv("bytecode"));
|
x = janet_get1(s, janet_csymbolv("bytecode"));
|
||||||
if (janet_indexed_view(x, &arr, &count)) {
|
if (janet_indexed_view(x, &arr, &count)) {
|
||||||
/* Do labels and find length */
|
/* Do labels and find length */
|
||||||
int32_t blength = 0;
|
int32_t blength = 0;
|
||||||
for (i = 0; i < count; ++i) {
|
for (i = 0; i < count; ++i) {
|
||||||
Janet instr = arr[i];
|
Janet instr = arr[i];
|
||||||
if (janet_checktype(instr, JANET_SYMBOL)) {
|
if (janet_checktype(instr, JANET_KEYWORD)) {
|
||||||
janet_table_put(&a.labels, instr, janet_wrap_integer(blength));
|
janet_table_put(&a.labels, instr, janet_wrap_integer(blength));
|
||||||
} else if (janet_checktype(instr, JANET_TUPLE)) {
|
} else if (janet_checktype(instr, JANET_TUPLE)) {
|
||||||
blength++;
|
blength++;
|
||||||
@@ -653,14 +647,14 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
}
|
}
|
||||||
/* Allocate bytecode array */
|
/* Allocate bytecode array */
|
||||||
def->bytecode_length = blength;
|
def->bytecode_length = blength;
|
||||||
def->bytecode = malloc(sizeof(int32_t) * blength);
|
def->bytecode = malloc(sizeof(uint32_t) * blength);
|
||||||
if (NULL == def->bytecode) {
|
if (NULL == def->bytecode) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
/* Do bytecode */
|
/* Do bytecode */
|
||||||
for (i = 0; i < count; ++i) {
|
for (i = 0; i < count; ++i) {
|
||||||
Janet instr = arr[i];
|
Janet instr = arr[i];
|
||||||
if (janet_checktype(instr, JANET_SYMBOL)) {
|
if (janet_checktype(instr, JANET_KEYWORD)) {
|
||||||
continue;
|
continue;
|
||||||
} else {
|
} else {
|
||||||
uint32_t op;
|
uint32_t op;
|
||||||
@@ -676,7 +670,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
"expected symbol in assembly instruction");
|
"expected symbol in assembly instruction");
|
||||||
idef = janet_strbinsearch(
|
idef = janet_strbinsearch(
|
||||||
&janet_ops,
|
&janet_ops,
|
||||||
sizeof(janet_ops)/sizeof(JanetInstructionDef),
|
sizeof(janet_ops) / sizeof(JanetInstructionDef),
|
||||||
sizeof(JanetInstructionDef),
|
sizeof(JanetInstructionDef),
|
||||||
janet_unwrap_symbol(t[0]));
|
janet_unwrap_symbol(t[0]));
|
||||||
if (NULL == idef)
|
if (NULL == idef)
|
||||||
@@ -692,7 +686,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
a.errindex = -1;
|
a.errindex = -1;
|
||||||
|
|
||||||
/* Check for source mapping */
|
/* Check for source mapping */
|
||||||
x = janet_get(s, janet_csymbolv("sourcemap"));
|
x = janet_get1(s, janet_csymbolv("sourcemap"));
|
||||||
if (janet_indexed_view(x, &arr, &count)) {
|
if (janet_indexed_view(x, &arr, &count)) {
|
||||||
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
|
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
|
||||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * count);
|
def->sourcemap = malloc(sizeof(JanetSourceMapping) * count);
|
||||||
@@ -704,14 +698,14 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
janet_asm_error(&a, "expected tuple");
|
janet_asm_error(&a, "expected tuple");
|
||||||
}
|
}
|
||||||
tup = janet_unwrap_tuple(entry);
|
tup = janet_unwrap_tuple(entry);
|
||||||
if (!janet_checktype(tup[0], JANET_INTEGER)) {
|
if (!janet_checkint(tup[0])) {
|
||||||
janet_asm_error(&a, "expected integer");
|
janet_asm_error(&a, "expected integer");
|
||||||
}
|
}
|
||||||
if (!janet_checktype(tup[1], JANET_INTEGER)) {
|
if (!janet_checkint(tup[1])) {
|
||||||
janet_asm_error(&a, "expected integer");
|
janet_asm_error(&a, "expected integer");
|
||||||
}
|
}
|
||||||
mapping.line = janet_unwrap_integer(tup[0]);
|
mapping.start = janet_unwrap_integer(tup[0]);
|
||||||
mapping.column = janet_unwrap_integer(tup[1]);
|
mapping.end = janet_unwrap_integer(tup[1]);
|
||||||
def->sourcemap[i] = mapping;
|
def->sourcemap[i] = mapping;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -740,12 +734,12 @@ JanetAssembleResult janet_asm(Janet source, int flags) {
|
|||||||
|
|
||||||
/* Disassembly */
|
/* Disassembly */
|
||||||
|
|
||||||
/* Find the deinfintion of an instruction given the instruction word. Return
|
/* Find the definition of an instruction given the instruction word. Return
|
||||||
* NULL if not found. */
|
* NULL if not found. */
|
||||||
static const JanetInstructionDef *janet_asm_reverse_lookup(uint32_t instr) {
|
static const JanetInstructionDef *janet_asm_reverse_lookup(uint32_t instr) {
|
||||||
size_t i;
|
size_t i;
|
||||||
uint32_t opcode = instr & 0x7F;
|
uint32_t opcode = instr & 0x7F;
|
||||||
for (i = 0; i < sizeof(janet_ops)/sizeof(JanetInstructionDef); i++) {
|
for (i = 0; i < sizeof(janet_ops) / sizeof(JanetInstructionDef); i++) {
|
||||||
const JanetInstructionDef *def = janet_ops + i;
|
const JanetInstructionDef *def = janet_ops + i;
|
||||||
if (def->opcode == opcode)
|
if (def->opcode == opcode)
|
||||||
return def;
|
return def;
|
||||||
@@ -781,7 +775,7 @@ static Janet tup4(Janet w, Janet x, Janet y, Janet z) {
|
|||||||
return janet_wrap_tuple(janet_tuple_end(tup));
|
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Given an argument, convert it to the appriate integer or symbol */
|
/* Given an argument, convert it to the appropriate integer or symbol */
|
||||||
Janet janet_asm_decode_instruction(uint32_t instr) {
|
Janet janet_asm_decode_instruction(uint32_t instr) {
|
||||||
const JanetInstructionDef *def = janet_asm_reverse_lookup(instr);
|
const JanetInstructionDef *def = janet_asm_reverse_lookup(instr);
|
||||||
Janet name;
|
Janet name;
|
||||||
@@ -833,6 +827,8 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
JanetArray *constants;
|
JanetArray *constants;
|
||||||
JanetTable *ret = janet_table(10);
|
JanetTable *ret = janet_table(10);
|
||||||
janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity));
|
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));
|
janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode));
|
||||||
if (NULL != def->source) {
|
if (NULL != def->source) {
|
||||||
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
|
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
|
||||||
@@ -840,9 +836,6 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||||
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
|
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
|
||||||
}
|
}
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
|
||||||
janet_table_put(ret, janet_csymbolv("fix-arity"), janet_wrap_true());
|
|
||||||
}
|
|
||||||
if (NULL != def->name) {
|
if (NULL != def->name) {
|
||||||
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
|
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
|
||||||
}
|
}
|
||||||
@@ -876,8 +869,8 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
for (i = 0; i < def->bytecode_length; i++) {
|
for (i = 0; i < def->bytecode_length; i++) {
|
||||||
Janet *t = janet_tuple_begin(2);
|
Janet *t = janet_tuple_begin(2);
|
||||||
JanetSourceMapping mapping = def->sourcemap[i];
|
JanetSourceMapping mapping = def->sourcemap[i];
|
||||||
t[0] = janet_wrap_integer(mapping.line);
|
t[0] = janet_wrap_integer(mapping.start);
|
||||||
t[1] = janet_wrap_integer(mapping.column);
|
t[1] = janet_wrap_integer(mapping.end);
|
||||||
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
||||||
}
|
}
|
||||||
sourcemap->count = def->bytecode_length;
|
sourcemap->count = def->bytecode_length;
|
||||||
@@ -912,45 +905,43 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* C Function for assembly */
|
/* C Function for assembly */
|
||||||
static int cfun_asm(JanetArgs args) {
|
static Janet cfun_asm(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 1);
|
||||||
JanetAssembleResult res;
|
JanetAssembleResult res;
|
||||||
JANET_FIXARITY(args, 1);
|
res = janet_asm(argv[0], 0);
|
||||||
res = janet_asm(args.v[0], 0);
|
if (res.status != JANET_ASSEMBLE_OK) {
|
||||||
if (res.status == JANET_ASSEMBLE_OK) {
|
janet_panics(res.error);
|
||||||
JANET_RETURN_FUNCTION(args, janet_thunk(res.funcdef));
|
|
||||||
} else {
|
|
||||||
JANET_THROWV(args, janet_wrap_string(res.error));
|
|
||||||
}
|
}
|
||||||
|
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_disasm(JanetArgs args) {
|
static Janet cfun_disasm(int32_t argc, Janet *argv) {
|
||||||
JanetFunction *f;
|
janet_arity(argc, 1, 1);
|
||||||
JANET_FIXARITY(args, 1);
|
JanetFunction *f = janet_getfunction(argv, 0);
|
||||||
JANET_ARG_FUNCTION(f, args, 0);
|
return janet_disasm(f->def);
|
||||||
JANET_RETURN(args, janet_disasm(f->def));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetReg asm_cfuns[] = {
|
||||||
{"asm", cfun_asm,
|
{
|
||||||
"(asm assembly)\n\n"
|
"asm", cfun_asm,
|
||||||
|
JDOC("(asm assembly)\n\n"
|
||||||
"Returns a new function that is the compiled result of the assembly.\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 wiki. Will throw an\n"
|
||||||
"error on invalid assembly."
|
"error on invalid assembly.")
|
||||||
},
|
},
|
||||||
{"disasm", cfun_disasm,
|
{
|
||||||
"(disasm func)\n\n"
|
"disasm", cfun_disasm,
|
||||||
|
JDOC("(disasm func)\n\n"
|
||||||
"Returns assembly that could be used be compile the given function.\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"
|
"func must be a function, not a c function. Will throw on error on a badly\n"
|
||||||
"typed argument."
|
"typed argument.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Load the library */
|
/* Load the library */
|
||||||
int janet_lib_asm(JanetArgs args) {
|
void janet_lib_asm(JanetTable *env) {
|
||||||
JanetTable *env = janet_env(args);
|
janet_core_cfuns(env, NULL, asm_cfuns);
|
||||||
janet_cfuns(env, NULL, cfuns);
|
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,8 +20,11 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Initialize a buffer */
|
/* Initialize a buffer */
|
||||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||||
@@ -54,7 +57,8 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
|||||||
uint8_t *new_data;
|
uint8_t *new_data;
|
||||||
uint8_t *old = buffer->data;
|
uint8_t *old = buffer->data;
|
||||||
if (capacity <= buffer->capacity) return;
|
if (capacity <= buffer->capacity) return;
|
||||||
capacity *= growth;
|
int64_t big_capacity = capacity * growth;
|
||||||
|
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||||
new_data = realloc(old, capacity * sizeof(uint8_t));
|
new_data = realloc(old, capacity * sizeof(uint8_t));
|
||||||
if (NULL == new_data) {
|
if (NULL == new_data) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
@@ -77,10 +81,10 @@ void janet_buffer_setcount(JanetBuffer *buffer, int32_t count) {
|
|||||||
|
|
||||||
/* Adds capacity for enough extra bytes to the buffer. Ensures that the
|
/* Adds capacity for enough extra bytes to the buffer. Ensures that the
|
||||||
* next n bytes pushed to the buffer will not cause a reallocation */
|
* next n bytes pushed to the buffer will not cause a reallocation */
|
||||||
int janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||||
/* Check for buffer overflow */
|
/* Check for buffer overflow */
|
||||||
if ((int64_t)n + buffer->count > INT32_MAX) {
|
if ((int64_t)n + buffer->count > INT32_MAX) {
|
||||||
return -1;
|
janet_panic("buffer overflow");
|
||||||
}
|
}
|
||||||
int32_t new_size = buffer->count + n;
|
int32_t new_size = buffer->count + n;
|
||||||
if (new_size > buffer->capacity) {
|
if (new_size > buffer->capacity) {
|
||||||
@@ -92,59 +96,54 @@ int janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
|||||||
buffer->data = new_data;
|
buffer->data = new_data;
|
||||||
buffer->capacity = new_capacity;
|
buffer->capacity = new_capacity;
|
||||||
}
|
}
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Push a cstring to buffer */
|
/* Push a cstring to buffer */
|
||||||
int janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
||||||
int32_t len = 0;
|
int32_t len = 0;
|
||||||
while (cstring[len]) ++len;
|
while (cstring[len]) ++len;
|
||||||
return janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
|
janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Push multiple bytes into the buffer */
|
/* Push multiple bytes into the buffer */
|
||||||
int janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) {
|
void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) {
|
||||||
if (janet_buffer_extra(buffer, length)) return -1;
|
janet_buffer_extra(buffer, length);
|
||||||
memcpy(buffer->data + buffer->count, string, length);
|
memcpy(buffer->data + buffer->count, string, length);
|
||||||
buffer->count += length;
|
buffer->count += length;
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
int janet_buffer_push_string(JanetBuffer *buffer, const uint8_t *string) {
|
void janet_buffer_push_string(JanetBuffer *buffer, const uint8_t *string) {
|
||||||
return janet_buffer_push_bytes(buffer, string, janet_string_length(string));
|
janet_buffer_push_bytes(buffer, string, janet_string_length(string));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Push a single byte to the buffer */
|
/* Push a single byte to the buffer */
|
||||||
int janet_buffer_push_u8(JanetBuffer *buffer, uint8_t byte) {
|
void janet_buffer_push_u8(JanetBuffer *buffer, uint8_t byte) {
|
||||||
if (janet_buffer_extra(buffer, 1)) return -1;
|
janet_buffer_extra(buffer, 1);
|
||||||
buffer->data[buffer->count] = byte;
|
buffer->data[buffer->count] = byte;
|
||||||
buffer->count++;
|
buffer->count++;
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Push a 16 bit unsigned integer to the buffer */
|
/* Push a 16 bit unsigned integer to the buffer */
|
||||||
int janet_buffer_push_u16(JanetBuffer *buffer, uint16_t x) {
|
void janet_buffer_push_u16(JanetBuffer *buffer, uint16_t x) {
|
||||||
if (janet_buffer_extra(buffer, 2)) return -1;
|
janet_buffer_extra(buffer, 2);
|
||||||
buffer->data[buffer->count] = x & 0xFF;
|
buffer->data[buffer->count] = x & 0xFF;
|
||||||
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
|
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
|
||||||
buffer->count += 2;
|
buffer->count += 2;
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Push a 32 bit unsigned integer to the buffer */
|
/* Push a 32 bit unsigned integer to the buffer */
|
||||||
int janet_buffer_push_u32(JanetBuffer *buffer, uint32_t x) {
|
void janet_buffer_push_u32(JanetBuffer *buffer, uint32_t x) {
|
||||||
if (janet_buffer_extra(buffer, 4)) return -1;
|
janet_buffer_extra(buffer, 4);
|
||||||
buffer->data[buffer->count] = x & 0xFF;
|
buffer->data[buffer->count] = x & 0xFF;
|
||||||
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
|
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
|
||||||
buffer->data[buffer->count + 2] = (x >> 16) & 0xFF;
|
buffer->data[buffer->count + 2] = (x >> 16) & 0xFF;
|
||||||
buffer->data[buffer->count + 3] = (x >> 24) & 0xFF;
|
buffer->data[buffer->count + 3] = (x >> 24) & 0xFF;
|
||||||
buffer->count += 4;
|
buffer->count += 4;
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Push a 64 bit unsigned integer to the buffer */
|
/* Push a 64 bit unsigned integer to the buffer */
|
||||||
int janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
||||||
if (janet_buffer_extra(buffer, 8)) return -1;
|
janet_buffer_extra(buffer, 8);
|
||||||
buffer->data[buffer->count] = x & 0xFF;
|
buffer->data[buffer->count] = x & 0xFF;
|
||||||
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
|
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
|
||||||
buffer->data[buffer->count + 2] = (x >> 16) & 0xFF;
|
buffer->data[buffer->count + 2] = (x >> 16) & 0xFF;
|
||||||
@@ -154,165 +153,278 @@ int janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
|||||||
buffer->data[buffer->count + 6] = (x >> 48) & 0xFF;
|
buffer->data[buffer->count + 6] = (x >> 48) & 0xFF;
|
||||||
buffer->data[buffer->count + 7] = (x >> 56) & 0xFF;
|
buffer->data[buffer->count + 7] = (x >> 56) & 0xFF;
|
||||||
buffer->count += 8;
|
buffer->count += 8;
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* C functions */
|
/* C functions */
|
||||||
|
|
||||||
static int cfun_new(JanetArgs args) {
|
static Janet cfun_buffer_new(int32_t argc, Janet *argv) {
|
||||||
int32_t cap;
|
janet_fixarity(argc, 1);
|
||||||
JanetBuffer *buffer;
|
int32_t cap = janet_getinteger(argv, 0);
|
||||||
JANET_FIXARITY(args, 1);
|
JanetBuffer *buffer = janet_buffer(cap);
|
||||||
JANET_ARG_INTEGER(cap, args, 0);
|
return janet_wrap_buffer(buffer);
|
||||||
buffer = janet_buffer(cap);
|
|
||||||
JANET_RETURN_BUFFER(args, buffer);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_u8(JanetArgs args) {
|
static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) {
|
||||||
int32_t i;
|
janet_arity(argc, 1, 2);
|
||||||
JanetBuffer *buffer;
|
int32_t count = janet_getinteger(argv, 0);
|
||||||
JANET_MINARITY(args, 1);
|
int32_t byte = 0;
|
||||||
JANET_ARG_BUFFER(buffer, args, 0);
|
if (argc == 2) {
|
||||||
for (i = 1; i < args.n; i++) {
|
byte = janet_getinteger(argv, 1) & 0xFF;
|
||||||
int32_t integer;
|
|
||||||
JANET_ARG_INTEGER(integer, args, i);
|
|
||||||
if (janet_buffer_push_u8(buffer, (uint8_t) (integer & 0xFF)))
|
|
||||||
JANET_THROW(args, "buffer overflow");
|
|
||||||
}
|
}
|
||||||
JANET_RETURN(args, args.v[0]);
|
JanetBuffer *buffer = janet_buffer(count);
|
||||||
|
if (buffer->data)
|
||||||
|
memset(buffer->data, byte, count);
|
||||||
|
buffer->count = count;
|
||||||
|
return janet_wrap_buffer(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_int(JanetArgs args) {
|
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
JanetBuffer *buffer;
|
janet_arity(argc, 1, -1);
|
||||||
JANET_MINARITY(args, 1);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
JANET_ARG_BUFFER(buffer, args, 0);
|
for (i = 1; i < argc; i++) {
|
||||||
for (i = 1; i < args.n; i++) {
|
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
|
||||||
int32_t integer;
|
|
||||||
JANET_ARG_INTEGER(integer, args, i);
|
|
||||||
if (janet_buffer_push_u32(buffer, (uint32_t) integer))
|
|
||||||
JANET_THROW(args, "buffer overflow");
|
|
||||||
}
|
}
|
||||||
JANET_RETURN(args, args.v[0]);
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_chars(JanetArgs args) {
|
static Janet cfun_buffer_word(int32_t argc, Janet *argv) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
JanetBuffer *buffer;
|
janet_arity(argc, 1, -1);
|
||||||
JANET_MINARITY(args, 1);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
JANET_ARG_BUFFER(buffer, args, 0);
|
for (i = 1; i < argc; i++) {
|
||||||
for (i = 1; i < args.n; i++) {
|
double number = janet_getnumber(argv, i);
|
||||||
int32_t len;
|
uint32_t word = (uint32_t) number;
|
||||||
const uint8_t *str;
|
if (word != number)
|
||||||
JANET_ARG_BYTES(str, len, args, i);
|
janet_panicf("cannot convert %v to machine word", argv[i]);
|
||||||
if (janet_buffer_push_bytes(buffer, str, len))
|
janet_buffer_push_u32(buffer, word);
|
||||||
JANET_THROW(args, "buffer overflow");
|
|
||||||
}
|
}
|
||||||
JANET_RETURN(args, args.v[0]);
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_clear(JanetArgs args) {
|
static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
|
||||||
JanetBuffer *buffer;
|
int32_t i;
|
||||||
JANET_FIXARITY(args, 1);
|
janet_arity(argc, 1, -1);
|
||||||
JANET_ARG_BUFFER(buffer, args, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
|
for (i = 1; i < argc; i++) {
|
||||||
|
JanetByteView view = janet_getbytes(argv, i);
|
||||||
|
if (view.bytes == buffer->data) {
|
||||||
|
janet_buffer_ensure(buffer, buffer->count + view.len, 2);
|
||||||
|
view.bytes = buffer->data;
|
||||||
|
}
|
||||||
|
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
||||||
|
}
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
buffer->count = 0;
|
buffer->count = 0;
|
||||||
JANET_RETURN(args, args.v[0]);
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_popn(JanetArgs args) {
|
static Janet cfun_buffer_popn(int32_t argc, Janet *argv) {
|
||||||
JanetBuffer *buffer;
|
janet_fixarity(argc, 2);
|
||||||
int32_t n;
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
JANET_FIXARITY(args, 2);
|
int32_t n = janet_getinteger(argv, 1);
|
||||||
JANET_ARG_BUFFER(buffer, args, 0);
|
if (n < 0) janet_panic("n must be non-negative");
|
||||||
JANET_ARG_INTEGER(n, args, 1);
|
|
||||||
if (n < 0) JANET_THROW(args, "n must be non-negative");
|
|
||||||
if (buffer->count < n) {
|
if (buffer->count < n) {
|
||||||
buffer->count = 0;
|
buffer->count = 0;
|
||||||
} else {
|
} else {
|
||||||
buffer->count -= n;
|
buffer->count -= n;
|
||||||
}
|
}
|
||||||
JANET_RETURN(args, args.v[0]);
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_slice(JanetArgs args) {
|
static Janet cfun_buffer_slice(int32_t argc, Janet *argv) {
|
||||||
const uint8_t *data;
|
JanetRange range = janet_getslice(argc, argv);
|
||||||
int32_t len, start, end;
|
JanetByteView view = janet_getbytes(argv, 0);
|
||||||
JanetBuffer *ret;
|
JanetBuffer *buffer = janet_buffer(range.end - range.start);
|
||||||
JANET_ARG_BYTES(data, len, args, 0);
|
if (buffer->data)
|
||||||
/* Get start */
|
memcpy(buffer->data, view.bytes + range.start, range.end - range.start);
|
||||||
if (args.n < 2) {
|
buffer->count = range.end - range.start;
|
||||||
start = 0;
|
return janet_wrap_buffer(buffer);
|
||||||
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
|
|
||||||
start = janet_unwrap_integer(args.v[1]);
|
|
||||||
} else {
|
|
||||||
JANET_THROW(args, "expected integer");
|
|
||||||
}
|
|
||||||
/* Get end */
|
|
||||||
if (args.n < 3) {
|
|
||||||
end = -1;
|
|
||||||
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
|
|
||||||
end = janet_unwrap_integer(args.v[2]);
|
|
||||||
} else {
|
|
||||||
JANET_THROW(args, "expected integer");
|
|
||||||
}
|
|
||||||
if (start < 0) start = len + start;
|
|
||||||
if (end < 0) end = len + end + 1;
|
|
||||||
if (end < 0 || start < 0 || end > len || start > len)
|
|
||||||
JANET_THROW(args, "slice range out of bounds");
|
|
||||||
if (end >= start) {
|
|
||||||
ret = janet_buffer(end - start);
|
|
||||||
memcpy(ret->data, data + start, end - start);
|
|
||||||
ret->count = end - start;
|
|
||||||
} else {
|
|
||||||
ret = janet_buffer(0);
|
|
||||||
}
|
|
||||||
JANET_RETURN_BUFFER(args, ret);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static void bitloc(int32_t argc, Janet *argv, JanetBuffer **b, int32_t *index, int *bit) {
|
||||||
{"buffer/new", cfun_new,
|
janet_fixarity(argc, 2);
|
||||||
"(buffer/new capacity)\n\n"
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
|
double x = janet_getnumber(argv, 1);
|
||||||
|
int64_t bitindex = (int64_t) x;
|
||||||
|
int64_t byteindex = bitindex >> 3;
|
||||||
|
int which_bit = bitindex & 7;
|
||||||
|
if (bitindex != x || bitindex < 0 || byteindex >= buffer->count)
|
||||||
|
janet_panicf("invalid bit index %v", argv[1]);
|
||||||
|
*b = buffer;
|
||||||
|
*index = (int32_t) byteindex;
|
||||||
|
*bit = which_bit;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_bitset(int32_t argc, Janet *argv) {
|
||||||
|
int bit;
|
||||||
|
int32_t index;
|
||||||
|
JanetBuffer *buffer;
|
||||||
|
bitloc(argc, argv, &buffer, &index, &bit);
|
||||||
|
buffer->data[index] |= 1 << bit;
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_bitclear(int32_t argc, Janet *argv) {
|
||||||
|
int bit;
|
||||||
|
int32_t index;
|
||||||
|
JanetBuffer *buffer;
|
||||||
|
bitloc(argc, argv, &buffer, &index, &bit);
|
||||||
|
buffer->data[index] &= ~(1 << bit);
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_bitget(int32_t argc, Janet *argv) {
|
||||||
|
int bit;
|
||||||
|
int32_t index;
|
||||||
|
JanetBuffer *buffer;
|
||||||
|
bitloc(argc, argv, &buffer, &index, &bit);
|
||||||
|
return janet_wrap_boolean(buffer->data[index] & (1 << bit));
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_bittoggle(int32_t argc, Janet *argv) {
|
||||||
|
int bit;
|
||||||
|
int32_t index;
|
||||||
|
JanetBuffer *buffer;
|
||||||
|
bitloc(argc, argv, &buffer, &index, &bit);
|
||||||
|
buffer->data[index] ^= (1 << bit);
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 2, 5);
|
||||||
|
JanetBuffer *dest = janet_getbuffer(argv, 0);
|
||||||
|
JanetByteView src = janet_getbytes(argv, 1);
|
||||||
|
int same_buf = src.bytes == dest->data;
|
||||||
|
int32_t offset_dest = 0;
|
||||||
|
int32_t offset_src = 0;
|
||||||
|
if (argc > 2)
|
||||||
|
offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start");
|
||||||
|
if (argc > 3)
|
||||||
|
offset_src = janet_gethalfrange(argv, 3, src.len, "src-start");
|
||||||
|
int32_t length_src;
|
||||||
|
if (argc > 4) {
|
||||||
|
int32_t src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
|
||||||
|
length_src = src_end - offset_src;
|
||||||
|
if (length_src < 0) length_src = 0;
|
||||||
|
} else {
|
||||||
|
length_src = src.len - offset_src;
|
||||||
|
}
|
||||||
|
int64_t last = ((int64_t) offset_dest - offset_src) + 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);
|
||||||
|
}
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_format(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 2, -1);
|
||||||
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
|
const char *strfrmt = (const char *) janet_getstring(argv, 1);
|
||||||
|
janet_buffer_format(buffer, strfrmt, 1, argc, argv);
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg buffer_cfuns[] = {
|
||||||
|
{
|
||||||
|
"buffer/new", cfun_buffer_new,
|
||||||
|
JDOC("(buffer/new capacity)\n\n"
|
||||||
"Creates a new, empty buffer with enough memory for capacity bytes. "
|
"Creates a new, empty buffer with enough memory for capacity bytes. "
|
||||||
"Returns a new buffer."
|
"Returns a new buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/push-byte", cfun_u8,
|
{
|
||||||
"(buffer/push-byte buffer x)\n\n"
|
"buffer/new-filled", cfun_buffer_new_filled,
|
||||||
|
JDOC("(buffer/new-filled count [, byte=0])\n\n"
|
||||||
|
"Creates a new buffer of length count filled with byte. "
|
||||||
|
"Returns the new buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/push-byte", cfun_buffer_u8,
|
||||||
|
JDOC("(buffer/push-byte buffer x)\n\n"
|
||||||
"Append a byte to a buffer. Will expand the buffer as necessary. "
|
"Append a byte to a buffer. Will expand the buffer as necessary. "
|
||||||
"Returns the modified buffer. Will throw an error if the buffer overflows."
|
"Returns the modified buffer. Will throw an error if the buffer overflows.")
|
||||||
},
|
},
|
||||||
{"buffer/push-integer", cfun_int,
|
{
|
||||||
"(buffer/push-integer buffer x)\n\n"
|
"buffer/push-word", cfun_buffer_word,
|
||||||
"Append an integer to a buffer. The 4 bytes of the integer are appended "
|
JDOC("(buffer/push-word buffer x)\n\n"
|
||||||
"in twos complement, big endian order. Returns the modified buffer. Will "
|
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
|
||||||
"throw an error if the buffer overflows."
|
"in twos complement, big endian order, unsigned. Returns the modified buffer. Will "
|
||||||
|
"throw an error if the buffer overflows.")
|
||||||
},
|
},
|
||||||
{"buffer/push-string", cfun_chars,
|
{
|
||||||
"(buffer/push-string buffer str)\n\n"
|
"buffer/push-string", cfun_buffer_chars,
|
||||||
|
JDOC("(buffer/push-string buffer str)\n\n"
|
||||||
"Push a string onto the end of a buffer. Non string values will be converted "
|
"Push a string onto the end of a buffer. Non string values will be converted "
|
||||||
"to strings before being pushed. Returns the modified buffer. "
|
"to strings before being pushed. Returns the modified buffer. "
|
||||||
"Will throw an error if the buffer overflows."
|
"Will throw an error if the buffer overflows.")
|
||||||
},
|
},
|
||||||
{"buffer/popn", cfun_popn,
|
{
|
||||||
"(buffer/popn buffer n)\n\n"
|
"buffer/popn", cfun_buffer_popn,
|
||||||
"Removes the last n bytes from the buffer. Returns the modified buffer."
|
JDOC("(buffer/popn buffer n)\n\n"
|
||||||
|
"Removes the last n bytes from the buffer. Returns the modified buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/clear", cfun_clear,
|
{
|
||||||
"(buffer/clear buffer)\n\n"
|
"buffer/clear", cfun_buffer_clear,
|
||||||
|
JDOC("(buffer/clear buffer)\n\n"
|
||||||
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
||||||
"its memory so it can be efficiently refilled. Returns the modified buffer."
|
"its memory so it can be efficiently refilled. Returns the modified buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/slice", cfun_slice,
|
{
|
||||||
"(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n"
|
"buffer/slice", cfun_buffer_slice,
|
||||||
|
JDOC("(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n"
|
||||||
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
||||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||||
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
||||||
"Returns a new buffer."
|
"Returns a new buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/bit-set", cfun_buffer_bitset,
|
||||||
|
JDOC("(buffer/bit-set buffer index)\n\n"
|
||||||
|
"Sets the bit at the given bit-index. Returns the buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/bit-clear", cfun_buffer_bitclear,
|
||||||
|
JDOC("(buffer/bit-clear buffer index)\n\n"
|
||||||
|
"Clears the bit at the given bit-index. Returns the buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/bit", cfun_buffer_bitget,
|
||||||
|
JDOC("(buffer/bit buffer index)\n\n"
|
||||||
|
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/bit-toggle", cfun_buffer_bittoggle,
|
||||||
|
JDOC("(buffer/bit-toggle buffer index)\n\n"
|
||||||
|
"Toggles the bit at the given bit index in buffer. Returns the buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/blit", cfun_buffer_blit,
|
||||||
|
JDOC("(buffer/blit dest src [, dest-start=0 [, src-start=0 [, src-end=-1]]])\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.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/format", cfun_buffer_format,
|
||||||
|
JDOC("(buffer/format buffer format & args)\n\n"
|
||||||
|
"Snprintf like functionality for printing values into a buffer. Returns "
|
||||||
|
" the modified buffer.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
int janet_lib_buffer(JanetArgs args) {
|
void janet_lib_buffer(JanetTable *env) {
|
||||||
JanetTable *env = janet_env(args);
|
janet_core_cfuns(env, NULL, buffer_cfuns);
|
||||||
janet_cfuns(env, NULL, cfuns);
|
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,8 +20,11 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Look up table for instructions */
|
/* Look up table for instructions */
|
||||||
enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||||
@@ -30,20 +33,12 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
|||||||
JINT_ST, /* JOP_TYPECHECK, */
|
JINT_ST, /* JOP_TYPECHECK, */
|
||||||
JINT_S, /* JOP_RETURN, */
|
JINT_S, /* JOP_RETURN, */
|
||||||
JINT_0, /* JOP_RETURN_NIL, */
|
JINT_0, /* JOP_RETURN_NIL, */
|
||||||
JINT_SSS, /* JOP_ADD_INTEGER, */
|
|
||||||
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
|
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
|
||||||
JINT_SSS, /* JOP_ADD_REAL, */
|
|
||||||
JINT_SSS, /* JOP_ADD, */
|
JINT_SSS, /* JOP_ADD, */
|
||||||
JINT_SSS, /* JOP_SUBTRACT_INTEGER, */
|
|
||||||
JINT_SSS, /* JOP_SUBTRACT_REAL, */
|
|
||||||
JINT_SSS, /* JOP_SUBTRACT, */
|
JINT_SSS, /* JOP_SUBTRACT, */
|
||||||
JINT_SSS, /* JOP_MULTIPLY_INTEGER, */
|
|
||||||
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
|
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
|
||||||
JINT_SSS, /* JOP_MULTIPLY_REAL, */
|
|
||||||
JINT_SSS, /* JOP_MULTIPLY, */
|
JINT_SSS, /* JOP_MULTIPLY, */
|
||||||
JINT_SSS, /* JOP_DIVIDE_INTEGER, */
|
|
||||||
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
|
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
|
||||||
JINT_SSS, /* JOP_DIVIDE_REAL, */
|
|
||||||
JINT_SSS, /* JOP_DIVIDE, */
|
JINT_SSS, /* JOP_DIVIDE, */
|
||||||
JINT_SSS, /* JOP_BAND, */
|
JINT_SSS, /* JOP_BAND, */
|
||||||
JINT_SSS, /* JOP_BOR, */
|
JINT_SSS, /* JOP_BOR, */
|
||||||
@@ -61,19 +56,11 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
|||||||
JINT_SL, /* JOP_JUMP_IF, */
|
JINT_SL, /* JOP_JUMP_IF, */
|
||||||
JINT_SL, /* JOP_JUMP_IF_NOT, */
|
JINT_SL, /* JOP_JUMP_IF_NOT, */
|
||||||
JINT_SSS, /* JOP_GREATER_THAN, */
|
JINT_SSS, /* JOP_GREATER_THAN, */
|
||||||
JINT_SSS, /* JOP_GREATER_THAN_INTEGER, */
|
|
||||||
JINT_SSI, /* JOP_GREATER_THAN_IMMEDIATE, */
|
JINT_SSI, /* JOP_GREATER_THAN_IMMEDIATE, */
|
||||||
JINT_SSS, /* JOP_GREATER_THAN_REAL, */
|
|
||||||
JINT_SSS, /* JOP_GREATER_THAN_EQUAL_REAL, */
|
|
||||||
JINT_SSS, /* JOP_LESS_THAN, */
|
JINT_SSS, /* JOP_LESS_THAN, */
|
||||||
JINT_SSS, /* JOP_LESS_THAN_INTEGER, */
|
|
||||||
JINT_SSI, /* JOP_LESS_THAN_IMMEDIATE, */
|
JINT_SSI, /* JOP_LESS_THAN_IMMEDIATE, */
|
||||||
JINT_SSS, /* JOP_LESS_THAN_REAL, */
|
|
||||||
JINT_SSS, /* JOP_LESS_THAN_EQUAL_REAL, */
|
|
||||||
JINT_SSS, /* JOP_EQUALS, */
|
JINT_SSS, /* JOP_EQUALS, */
|
||||||
JINT_SSS, /* JOP_EQUALS_INTEGER, */
|
|
||||||
JINT_SSI, /* JOP_EQUALS_IMMEDIATE, */
|
JINT_SSI, /* JOP_EQUALS_IMMEDIATE, */
|
||||||
JINT_SSS, /* JOP_EQUALS_REAL, */
|
|
||||||
JINT_SSS, /* JOP_COMPARE, */
|
JINT_SSS, /* JOP_COMPARE, */
|
||||||
JINT_S, /* JOP_LOAD_NIL, */
|
JINT_S, /* JOP_LOAD_NIL, */
|
||||||
JINT_S, /* JOP_LOAD_TRUE, */
|
JINT_S, /* JOP_LOAD_TRUE, */
|
||||||
@@ -99,10 +86,11 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
|||||||
JINT_SS, /* JOP_LENGTH */
|
JINT_SS, /* JOP_LENGTH */
|
||||||
JINT_S, /* JOP_MAKE_ARRAY */
|
JINT_S, /* JOP_MAKE_ARRAY */
|
||||||
JINT_S, /* JOP_MAKE_BUFFER */
|
JINT_S, /* JOP_MAKE_BUFFER */
|
||||||
JINT_S, /* JOP_MAKE_TUPLE */
|
JINT_S, /* JOP_MAKE_STRING */
|
||||||
JINT_S, /* JOP_MAKE_STRUCT */
|
JINT_S, /* JOP_MAKE_STRUCT */
|
||||||
JINT_S, /* JOP_MAKE_TABLE */
|
JINT_S, /* JOP_MAKE_TABLE */
|
||||||
JINT_S, /* JOP_MAKE_STRING */
|
JINT_S, /* JOP_MAKE_TUPLE */
|
||||||
|
JINT_S, /* JOP_MAKE_BRACKET_TUPLE */
|
||||||
JINT_SSS, /* JOP_NUMERIC_LESS_THAN */
|
JINT_SSS, /* JOP_NUMERIC_LESS_THAN */
|
||||||
JINT_SSS, /* JOP_NUMERIC_LESS_THAN_EQUAL */
|
JINT_SSS, /* JOP_NUMERIC_LESS_THAN_EQUAL */
|
||||||
JINT_SSS, /* JOP_NUMERIC_GREATER_THAN */
|
JINT_SSS, /* JOP_NUMERIC_GREATER_THAN */
|
||||||
@@ -125,72 +113,62 @@ int32_t janet_verify(JanetFuncDef *def) {
|
|||||||
for (i = 0; i < def->bytecode_length; i++) {
|
for (i = 0; i < def->bytecode_length; i++) {
|
||||||
uint32_t instr = def->bytecode[i];
|
uint32_t instr = def->bytecode[i];
|
||||||
/* Check for invalid instructions */
|
/* Check for invalid instructions */
|
||||||
if ((instr & 0xFF) >= JOP_INSTRUCTION_COUNT) {
|
if ((instr & 0x7F) >= JOP_INSTRUCTION_COUNT) {
|
||||||
return 3;
|
return 3;
|
||||||
}
|
}
|
||||||
enum JanetInstructionType type = janet_instructions[instr & 0xFF];
|
enum JanetInstructionType type = janet_instructions[instr & 0x7F];
|
||||||
switch (type) {
|
switch (type) {
|
||||||
case JINT_0:
|
case JINT_0:
|
||||||
continue;
|
continue;
|
||||||
case JINT_S:
|
case JINT_S: {
|
||||||
{
|
|
||||||
if ((int32_t)(instr >> 8) >= sc) return 4;
|
if ((int32_t)(instr >> 8) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SI:
|
case JINT_SI:
|
||||||
case JINT_SU:
|
case JINT_SU:
|
||||||
case JINT_ST:
|
case JINT_ST: {
|
||||||
{
|
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_L:
|
case JINT_L: {
|
||||||
{
|
|
||||||
int32_t jumpdest = i + (((int32_t)instr) >> 8);
|
int32_t jumpdest = i + (((int32_t)instr) >> 8);
|
||||||
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
|
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SS:
|
case JINT_SS: {
|
||||||
{
|
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
|
||||||
(int32_t)(instr >> 16) >= sc) return 4;
|
(int32_t)(instr >> 16) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SSI:
|
case JINT_SSI:
|
||||||
case JINT_SSU:
|
case JINT_SSU: {
|
||||||
{
|
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
|
||||||
(int32_t)((instr >> 16) & 0xFF) >= sc) return 4;
|
(int32_t)((instr >> 16) & 0xFF) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SL:
|
case JINT_SL: {
|
||||||
{
|
|
||||||
int32_t jumpdest = i + (((int32_t)instr) >> 16);
|
int32_t jumpdest = i + (((int32_t)instr) >> 16);
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
|
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SSS:
|
case JINT_SSS: {
|
||||||
{
|
|
||||||
if (((int32_t)(instr >> 8) & 0xFF) >= sc ||
|
if (((int32_t)(instr >> 8) & 0xFF) >= sc ||
|
||||||
((int32_t)(instr >> 16) & 0xFF) >= sc ||
|
((int32_t)(instr >> 16) & 0xFF) >= sc ||
|
||||||
((int32_t)(instr >> 24) & 0xFF) >= sc) return 4;
|
((int32_t)(instr >> 24) & 0xFF) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SD:
|
case JINT_SD: {
|
||||||
{
|
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
if ((int32_t)(instr >> 16) >= def->defs_length) return 6;
|
if ((int32_t)(instr >> 16) >= def->defs_length) return 6;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SC:
|
case JINT_SC: {
|
||||||
{
|
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
if ((int32_t)(instr >> 16) >= def->constants_length) return 7;
|
if ((int32_t)(instr >> 16) >= def->constants_length) return 7;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SES:
|
case JINT_SES: {
|
||||||
{
|
|
||||||
/* How can we check the last slot index? We need info parent funcdefs. Resort
|
/* How can we check the last slot index? We need info parent funcdefs. Resort
|
||||||
* to runtime checks for now. Maybe invalid upvalue references could be defaulted
|
* to runtime checks for now. Maybe invalid upvalue references could be defaulted
|
||||||
* to nil? (don't commit to this in the long term, though) */
|
* to nil? (don't commit to this in the long term, though) */
|
||||||
@@ -232,6 +210,8 @@ JanetFuncDef *janet_funcdef_alloc() {
|
|||||||
def->flags = 0;
|
def->flags = 0;
|
||||||
def->slotcount = 0;
|
def->slotcount = 0;
|
||||||
def->arity = 0;
|
def->arity = 0;
|
||||||
|
def->min_arity = 0;
|
||||||
|
def->max_arity = INT32_MAX;
|
||||||
def->source = NULL;
|
def->source = NULL;
|
||||||
def->sourcemap = NULL;
|
def->sourcemap = NULL;
|
||||||
def->name = NULL;
|
def->name = NULL;
|
||||||
|
|||||||
279
src/core/capi.c
Normal file
279
src/core/capi.c
Normal file
@@ -0,0 +1,279 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 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 <janet.h>
|
||||||
|
#include "state.h"
|
||||||
|
#include "fiber.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
|
static JanetBuildConfig *api_build_config = &(JanetBuildConfig){
|
||||||
|
.api_version = JANET_API_VERSION,
|
||||||
|
.single_threaded = JANET_SINGLE_THREADED_BIT,
|
||||||
|
.nanbox = JANET_NANBOX_BIT
|
||||||
|
};
|
||||||
|
|
||||||
|
const JanetBuildConfig *janet_build_config() {
|
||||||
|
return api_build_config;
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_panicv(Janet message) {
|
||||||
|
if (janet_vm_return_reg != NULL) {
|
||||||
|
*janet_vm_return_reg = message;
|
||||||
|
longjmp(*janet_vm_jmp_buf, 1);
|
||||||
|
} else {
|
||||||
|
fputs((const char *)janet_formatc("janet top level panic - %v\n", message), stdout);
|
||||||
|
exit(1);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_panicf(const char *format, ...) {
|
||||||
|
va_list args;
|
||||||
|
const uint8_t *ret;
|
||||||
|
JanetBuffer buffer;
|
||||||
|
int32_t len = 0;
|
||||||
|
while (format[len]) len++;
|
||||||
|
janet_buffer_init(&buffer, len);
|
||||||
|
va_start(args, format);
|
||||||
|
janet_formatb(&buffer, format, args);
|
||||||
|
va_end(args);
|
||||||
|
ret = janet_string(buffer.data, buffer.count);
|
||||||
|
janet_buffer_deinit(&buffer);
|
||||||
|
janet_panics(ret);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_printf(const char *format, ...) {
|
||||||
|
va_list args;
|
||||||
|
JanetBuffer buffer;
|
||||||
|
int32_t len = 0;
|
||||||
|
while (format[len]) len++;
|
||||||
|
janet_buffer_init(&buffer, len);
|
||||||
|
va_start(args, format);
|
||||||
|
janet_formatb(&buffer, format, args);
|
||||||
|
va_end(args);
|
||||||
|
fwrite(buffer.data, buffer.count, 1, stdout);
|
||||||
|
janet_buffer_deinit(&buffer);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_panic(const char *message) {
|
||||||
|
janet_panicv(janet_cstringv(message));
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_panics(const uint8_t *message) {
|
||||||
|
janet_panicv(janet_wrap_string(message));
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_panic_type(Janet x, int32_t n, int expected) {
|
||||||
|
janet_panicf("bad slot #%d, expected %T, got %v", n, expected, x);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType *at) {
|
||||||
|
janet_panicf("bad slot #%d, expected %s, got %v", n, at->name, x);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_fixarity(int32_t arity, int32_t fix) {
|
||||||
|
if (arity != fix)
|
||||||
|
janet_panicf("arity mismatch, expected %d, got %d", fix, arity);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_arity(int32_t arity, int32_t min, int32_t max) {
|
||||||
|
if (min >= 0 && arity < min)
|
||||||
|
janet_panicf("arity mismatch, expected at least %d, got %d", min, arity);
|
||||||
|
if (max >= 0 && arity > max)
|
||||||
|
janet_panicf("arity mismatch, expected at most %d, got %d", max, arity);
|
||||||
|
}
|
||||||
|
|
||||||
|
#define DEFINE_GETTER(name, NAME, type) \
|
||||||
|
type janet_get##name(const Janet *argv, int32_t n) { \
|
||||||
|
Janet x = argv[n]; \
|
||||||
|
if (!janet_checktype(x, JANET_##NAME)) { \
|
||||||
|
janet_panic_type(x, n, JANET_TFLAG_##NAME); \
|
||||||
|
} \
|
||||||
|
return janet_unwrap_##name(x); \
|
||||||
|
}
|
||||||
|
|
||||||
|
Janet janet_getmethod(const uint8_t *method, const JanetMethod *methods) {
|
||||||
|
while (methods->name) {
|
||||||
|
if (!janet_cstrcmp(method, methods->name))
|
||||||
|
return janet_wrap_cfunction(methods->cfun);
|
||||||
|
methods++;
|
||||||
|
}
|
||||||
|
janet_panicf("unknown method %S invoked", method);
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
DEFINE_GETTER(number, NUMBER, double)
|
||||||
|
DEFINE_GETTER(array, ARRAY, JanetArray *)
|
||||||
|
DEFINE_GETTER(tuple, TUPLE, const Janet *)
|
||||||
|
DEFINE_GETTER(table, TABLE, JanetTable *)
|
||||||
|
DEFINE_GETTER(struct, STRUCT, const JanetKV *)
|
||||||
|
DEFINE_GETTER(string, STRING, const uint8_t *)
|
||||||
|
DEFINE_GETTER(keyword, KEYWORD, const uint8_t *)
|
||||||
|
DEFINE_GETTER(symbol, SYMBOL, const uint8_t *)
|
||||||
|
DEFINE_GETTER(buffer, BUFFER, JanetBuffer *)
|
||||||
|
DEFINE_GETTER(fiber, FIBER, JanetFiber *)
|
||||||
|
DEFINE_GETTER(function, FUNCTION, JanetFunction *)
|
||||||
|
DEFINE_GETTER(cfunction, CFUNCTION, JanetCFunction)
|
||||||
|
DEFINE_GETTER(boolean, BOOLEAN, int)
|
||||||
|
DEFINE_GETTER(pointer, POINTER, void *)
|
||||||
|
|
||||||
|
const char *janet_getcstring(const Janet *argv, int32_t n) {
|
||||||
|
const uint8_t *jstr = janet_getstring(argv, n);
|
||||||
|
const char *cstr = (const char *)jstr;
|
||||||
|
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
|
||||||
|
janet_panicf("string %v contains embedded 0s");
|
||||||
|
}
|
||||||
|
return cstr;
|
||||||
|
}
|
||||||
|
|
||||||
|
int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||||
|
Janet x = argv[n];
|
||||||
|
if (!janet_checkint(x)) {
|
||||||
|
janet_panicf("bad slot #%d, expected integer, got %v", n, x);
|
||||||
|
}
|
||||||
|
return janet_unwrap_integer(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
||||||
|
Janet x = argv[n];
|
||||||
|
if (!janet_checkint64(x)) {
|
||||||
|
janet_panicf("bad slot #%d, expected 64 bit integer, got %v", n, x);
|
||||||
|
}
|
||||||
|
return (int64_t) janet_unwrap_number(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
size_t janet_getsize(const Janet *argv, int32_t n) {
|
||||||
|
Janet x = argv[n];
|
||||||
|
if (!janet_checksize(x)) {
|
||||||
|
janet_panicf("bad slot #%d, expected size, got %v", n, x);
|
||||||
|
}
|
||||||
|
return (size_t) janet_unwrap_number(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
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 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;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetView janet_getindexed(const Janet *argv, int32_t n) {
|
||||||
|
Janet x = argv[n];
|
||||||
|
JanetView view;
|
||||||
|
if (!janet_indexed_view(x, &view.items, &view.len)) {
|
||||||
|
janet_panic_type(x, n, JANET_TFLAG_INDEXED);
|
||||||
|
}
|
||||||
|
return view;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetByteView janet_getbytes(const Janet *argv, int32_t n) {
|
||||||
|
Janet x = argv[n];
|
||||||
|
JanetByteView view;
|
||||||
|
if (!janet_bytes_view(x, &view.bytes, &view.len)) {
|
||||||
|
janet_panic_type(x, n, JANET_TFLAG_BYTES);
|
||||||
|
}
|
||||||
|
return view;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetDictView janet_getdictionary(const Janet *argv, int32_t n) {
|
||||||
|
Janet x = argv[n];
|
||||||
|
JanetDictView view;
|
||||||
|
if (!janet_dictionary_view(x, &view.kvs, &view.len, &view.cap)) {
|
||||||
|
janet_panic_type(x, n, JANET_TFLAG_DICTIONARY);
|
||||||
|
}
|
||||||
|
return view;
|
||||||
|
}
|
||||||
|
|
||||||
|
void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at) {
|
||||||
|
Janet x = argv[n];
|
||||||
|
if (!janet_checktype(x, JANET_ABSTRACT)) {
|
||||||
|
janet_panic_abstract(x, n, at);
|
||||||
|
}
|
||||||
|
void *abstractx = janet_unwrap_abstract(x);
|
||||||
|
if (janet_abstract_type(abstractx) != at) {
|
||||||
|
janet_panic_abstract(x, n, at);
|
||||||
|
}
|
||||||
|
return abstractx;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 3);
|
||||||
|
JanetRange range;
|
||||||
|
int32_t length = janet_length(argv[0]);
|
||||||
|
if (argc == 1) {
|
||||||
|
range.start = 0;
|
||||||
|
range.end = length;
|
||||||
|
} else if (argc == 2) {
|
||||||
|
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||||
|
range.end = length;
|
||||||
|
} else {
|
||||||
|
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||||
|
range.end = janet_gethalfrange(argv, 2, length, "end");
|
||||||
|
if (range.end < range.start)
|
||||||
|
range.end = range.start;
|
||||||
|
}
|
||||||
|
return range;
|
||||||
|
}
|
||||||
|
|
||||||
|
Janet janet_dyn(const char *name) {
|
||||||
|
if (!janet_vm_fiber) return janet_wrap_nil();
|
||||||
|
if (janet_vm_fiber->env) {
|
||||||
|
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
|
||||||
|
} else {
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
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);
|
||||||
|
}
|
||||||
|
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Some definitions for function-like macros */
|
||||||
|
|
||||||
|
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
|
||||||
|
return janet_struct_head(st);
|
||||||
|
}
|
||||||
|
|
||||||
|
JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) {
|
||||||
|
return janet_abstract_head(abstract);
|
||||||
|
}
|
||||||
|
|
||||||
|
JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) {
|
||||||
|
return janet_string_head(s);
|
||||||
|
}
|
||||||
|
|
||||||
|
JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) {
|
||||||
|
return janet_tuple_head(tuple);
|
||||||
|
}
|
||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2017 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,10 +20,12 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
#include "emit.h"
|
#include "emit.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
static int fixarity0(JanetFopts opts, JanetSlot *args) {
|
static int fixarity0(JanetFopts opts, JanetSlot *args) {
|
||||||
(void) opts;
|
(void) opts;
|
||||||
@@ -46,14 +48,14 @@ static int fixarity3(JanetFopts opts, JanetSlot *args) {
|
|||||||
return janet_v_count(args) == 3;
|
return janet_v_count(args) == 3;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Generic hanldling for $A = op $B */
|
/* Generic handling for $A = op $B */
|
||||||
static JanetSlot genericSS(JanetFopts opts, int op, JanetSlot s) {
|
static JanetSlot genericSS(JanetFopts opts, int op, JanetSlot s) {
|
||||||
JanetSlot target = janetc_gettarget(opts);
|
JanetSlot target = janetc_gettarget(opts);
|
||||||
janetc_emit_ss(opts.compiler, op, target, s, 1);
|
janetc_emit_ss(opts.compiler, op, target, s, 1);
|
||||||
return target;
|
return target;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Generic hanldling for $A = $B op I */
|
/* Generic handling for $A = $B op I */
|
||||||
static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
|
static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
|
||||||
JanetSlot target = janetc_gettarget(opts);
|
JanetSlot target = janetc_gettarget(opts);
|
||||||
janetc_emit_ssi(opts.compiler, op, target, s, imm, 1);
|
janetc_emit_ssi(opts.compiler, op, target, s, imm, 1);
|
||||||
@@ -99,8 +101,15 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
|||||||
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||||
|
if (opts.flags & JANET_FOPTS_DROP) {
|
||||||
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
|
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
|
||||||
return args[0];
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
} else {
|
||||||
|
JanetSlot t = janetc_gettarget(opts);
|
||||||
|
janetc_copy(opts.compiler, t, args[0]);
|
||||||
|
janetc_emit_sss(opts.compiler, JOP_PUT, t, args[1], args[2], 0);
|
||||||
|
return t;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
static JanetSlot do_length(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_length(JanetFopts opts, JanetSlot *args) {
|
||||||
return genericSS(opts, JOP_LENGTH, args[0]);
|
return genericSS(opts, JOP_LENGTH, args[0]);
|
||||||
@@ -116,9 +125,9 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
|||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
int32_t i;
|
int32_t i;
|
||||||
for (i = 1; i < janet_v_count(args) - 3; i += 3)
|
for (i = 1; i < janet_v_count(args) - 3; i += 3)
|
||||||
janetc_emit_sss(c, JOP_PUSH_3, args[i], args[i+1], args[i+2], 0);
|
janetc_emit_sss(c, JOP_PUSH_3, args[i], args[i + 1], args[i + 2], 0);
|
||||||
if (i == janet_v_count(args) - 3)
|
if (i == janet_v_count(args) - 3)
|
||||||
janetc_emit_ss(c, JOP_PUSH_2, args[i], args[i+1], 0);
|
janetc_emit_ss(c, JOP_PUSH_2, args[i], args[i + 1], 0);
|
||||||
else if (i == janet_v_count(args) - 2)
|
else if (i == janet_v_count(args) - 2)
|
||||||
janetc_emit_s(c, JOP_PUSH, args[i], 0);
|
janetc_emit_s(c, JOP_PUSH, args[i], 0);
|
||||||
/* Push array phase */
|
/* Push array phase */
|
||||||
@@ -136,7 +145,7 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
|||||||
return target;
|
return target;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Varidadic operators specialization */
|
/* Variadic operators specialization */
|
||||||
|
|
||||||
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_ADD, janet_wrap_integer(0));
|
return opreduce(opts, args, JOP_ADD, janet_wrap_integer(0));
|
||||||
@@ -288,7 +297,7 @@ const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
|||||||
if (tag == 0)
|
if (tag == 0)
|
||||||
return NULL;
|
return NULL;
|
||||||
uint32_t index = tag - 1;
|
uint32_t index = tag - 1;
|
||||||
if (index >= (sizeof(optimizers)/sizeof(optimizers[0])))
|
if (index >= (sizeof(optimizers) / sizeof(optimizers[0])))
|
||||||
return NULL;
|
return NULL;
|
||||||
return optimizers + index;
|
return optimizers + index;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,10 +20,14 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
#include "emit.h"
|
#include "emit.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
|
#include "util.h"
|
||||||
|
#include "state.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
JanetFopts janetc_fopts_default(JanetCompiler *c) {
|
JanetFopts janetc_fopts_default(JanetCompiler *c) {
|
||||||
JanetFopts ret;
|
JanetFopts ret;
|
||||||
@@ -94,7 +98,6 @@ void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name)
|
|||||||
scope.syms = NULL;
|
scope.syms = NULL;
|
||||||
scope.envs = NULL;
|
scope.envs = NULL;
|
||||||
scope.defs = NULL;
|
scope.defs = NULL;
|
||||||
scope.selfconst = -1;
|
|
||||||
scope.bytecode_start = janet_v_count(c->buffer);
|
scope.bytecode_start = janet_v_count(c->buffer);
|
||||||
scope.flags = flags;
|
scope.flags = flags;
|
||||||
scope.parent = c->scope;
|
scope.parent = c->scope;
|
||||||
@@ -203,8 +206,7 @@ JanetSlot janetc_resolve(
|
|||||||
case JANET_BINDING_DEF:
|
case JANET_BINDING_DEF:
|
||||||
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
||||||
return janetc_cslot(check);
|
return janetc_cslot(check);
|
||||||
case JANET_BINDING_VAR:
|
case JANET_BINDING_VAR: {
|
||||||
{
|
|
||||||
JanetSlot ret = janetc_cslot(check);
|
JanetSlot ret = janetc_cslot(check);
|
||||||
/* TODO save type info */
|
/* TODO save type info */
|
||||||
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
|
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
|
||||||
@@ -215,7 +217,7 @@ JanetSlot janetc_resolve(
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Symbol was found */
|
/* Symbol was found */
|
||||||
found:
|
found:
|
||||||
|
|
||||||
/* Constants can be returned immediately (they are stateless) */
|
/* Constants can be returned immediately (they are stateless) */
|
||||||
if (ret.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF))
|
if (ret.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF))
|
||||||
@@ -235,7 +237,7 @@ JanetSlot janetc_resolve(
|
|||||||
scope->flags |= JANET_SCOPE_ENV;
|
scope->flags |= JANET_SCOPE_ENV;
|
||||||
scope = scope->child;
|
scope = scope->child;
|
||||||
|
|
||||||
/* Propogate env up to current scope */
|
/* Propagate env up to current scope */
|
||||||
int32_t envindex = -1;
|
int32_t envindex = -1;
|
||||||
while (scope) {
|
while (scope) {
|
||||||
if (scope->flags & JANET_SCOPE_FUNCTION) {
|
if (scope->flags & JANET_SCOPE_FUNCTION) {
|
||||||
@@ -308,9 +310,9 @@ JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
|
|||||||
JanetSlot *ret = NULL;
|
JanetSlot *ret = NULL;
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
const JanetKV *kvs = NULL;
|
const JanetKV *kvs = NULL;
|
||||||
int32_t cap, i, len;
|
int32_t cap = 0, len = 0;
|
||||||
janet_dictionary_view(ds, &kvs, &len, &cap);
|
janet_dictionary_view(ds, &kvs, &len, &cap);
|
||||||
for (i = 0; i < cap; i++) {
|
for (int32_t i = 0; i < cap; i++) {
|
||||||
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
||||||
janet_v_push(ret, janetc_value(subopts, kvs[i].key));
|
janet_v_push(ret, janetc_value(subopts, kvs[i].key));
|
||||||
janet_v_push(ret, janetc_value(subopts, kvs[i].value));
|
janet_v_push(ret, janetc_value(subopts, kvs[i].value));
|
||||||
@@ -331,17 +333,17 @@ void janetc_pushslots(JanetCompiler *c, JanetSlot *slots) {
|
|||||||
i++;
|
i++;
|
||||||
} else if (slots[i + 1].flags & JANET_SLOT_SPLICED) {
|
} else if (slots[i + 1].flags & JANET_SLOT_SPLICED) {
|
||||||
janetc_emit_s(c, JOP_PUSH, slots[i], 0);
|
janetc_emit_s(c, JOP_PUSH, slots[i], 0);
|
||||||
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i+1], 0);
|
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 1], 0);
|
||||||
i += 2;
|
i += 2;
|
||||||
} else if (i + 2 == count) {
|
} else if (i + 2 == count) {
|
||||||
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i+1], 0);
|
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0);
|
||||||
i += 2;
|
i += 2;
|
||||||
} else if (slots[i + 2].flags & JANET_SLOT_SPLICED) {
|
} else if (slots[i + 2].flags & JANET_SLOT_SPLICED) {
|
||||||
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i+1], 0);
|
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0);
|
||||||
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i+2], 0);
|
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 2], 0);
|
||||||
i += 3;
|
i += 3;
|
||||||
} else {
|
} else {
|
||||||
janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i+1], slots[i+2], 0);
|
janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i + 1], slots[i + 2], 0);
|
||||||
i += 3;
|
i += 3;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -402,7 +404,9 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
|||||||
}
|
}
|
||||||
if (!specialized) {
|
if (!specialized) {
|
||||||
janetc_pushslots(c, slots);
|
janetc_pushslots(c, slots);
|
||||||
if (opts.flags & JANET_FOPTS_TAIL) {
|
if ((opts.flags & JANET_FOPTS_TAIL) &&
|
||||||
|
/* Prevent top level tail calls for better errors */
|
||||||
|
!(c->scope->flags & JANET_SCOPE_TOP)) {
|
||||||
janetc_emit_s(c, JOP_TAILCALL, fun, 0);
|
janetc_emit_s(c, JOP_TAILCALL, fun, 0);
|
||||||
retslot = janetc_cslot(janet_wrap_nil());
|
retslot = janetc_cslot(janet_wrap_nil());
|
||||||
retslot.flags = JANET_SLOT_RETURNED;
|
retslot.flags = JANET_SLOT_RETURNED;
|
||||||
@@ -433,6 +437,14 @@ static JanetSlot janetc_array(JanetFopts opts, Janet x) {
|
|||||||
JOP_MAKE_ARRAY);
|
JOP_MAKE_ARRAY);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static JanetSlot janetc_tuple(JanetFopts opts, Janet x) {
|
||||||
|
JanetCompiler *c = opts.compiler;
|
||||||
|
const Janet *t = janet_unwrap_tuple(x);
|
||||||
|
return janetc_maker(opts,
|
||||||
|
janetc_toslots(c, t, janet_tuple_length(t)),
|
||||||
|
JOP_MAKE_TUPLE);
|
||||||
|
}
|
||||||
|
|
||||||
static JanetSlot janetc_tablector(JanetFopts opts, Janet x, int op) {
|
static JanetSlot janetc_tablector(JanetFopts opts, Janet x, int op) {
|
||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
return janetc_maker(opts,
|
return janetc_maker(opts,
|
||||||
@@ -462,10 +474,13 @@ static int macroexpand1(
|
|||||||
if (janet_tuple_length(form) == 0)
|
if (janet_tuple_length(form) == 0)
|
||||||
return 0;
|
return 0;
|
||||||
/* Source map - only set when we get a tuple */
|
/* Source map - only set when we get a tuple */
|
||||||
if (janet_tuple_sm_line(form) > 0) {
|
if (janet_tuple_sm_start(form) >= 0) {
|
||||||
c->current_mapping.line = janet_tuple_sm_line(form);
|
c->current_mapping.start = janet_tuple_sm_start(form);
|
||||||
c->current_mapping.column = janet_tuple_sm_col(form);
|
c->current_mapping.end = janet_tuple_sm_end(form);
|
||||||
}
|
}
|
||||||
|
/* Bracketed tuples are not specials or macros! */
|
||||||
|
if (janet_tuple_flag(form) & JANET_TUPLE_FLAG_BRACKETCTOR)
|
||||||
|
return 0;
|
||||||
if (!janet_checktype(form[0], JANET_SYMBOL))
|
if (!janet_checktype(form[0], JANET_SYMBOL))
|
||||||
return 0;
|
return 0;
|
||||||
const uint8_t *name = janet_unwrap_symbol(form[0]);
|
const uint8_t *name = janet_unwrap_symbol(form[0]);
|
||||||
@@ -480,12 +495,11 @@ static int macroexpand1(
|
|||||||
!janet_checktype(macroval, JANET_FUNCTION))
|
!janet_checktype(macroval, JANET_FUNCTION))
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
|
|
||||||
/* Evaluate macro */
|
/* Evaluate macro */
|
||||||
JanetFiber *fiberp;
|
JanetFiber *fiberp = NULL;
|
||||||
JanetFunction *macro = janet_unwrap_function(macroval);
|
JanetFunction *macro = janet_unwrap_function(macroval);
|
||||||
int lock = janet_gclock();
|
int lock = janet_gclock();
|
||||||
JanetSignal status = janet_call(
|
JanetSignal status = janet_pcall(
|
||||||
macro,
|
macro,
|
||||||
janet_tuple_length(form) - 1,
|
janet_tuple_length(form) - 1,
|
||||||
form + 1,
|
form + 1,
|
||||||
@@ -536,13 +550,14 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
|||||||
ret = spec->compile(opts, janet_tuple_length(tup) - 1, tup + 1);
|
ret = spec->compile(opts, janet_tuple_length(tup) - 1, tup + 1);
|
||||||
} else {
|
} else {
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
const Janet *tup = janet_unwrap_tuple(x);
|
const Janet *tup = janet_unwrap_tuple(x);
|
||||||
/* Empty tuple is tuple literal */
|
/* Empty tuple is tuple literal */
|
||||||
if (janet_tuple_length(tup) == 0) {
|
if (janet_tuple_length(tup) == 0) {
|
||||||
ret = janetc_cslot(x);
|
ret = janetc_cslot(x);
|
||||||
|
} else if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) { /* [] tuples are not function call */
|
||||||
|
ret = janetc_tuple(opts, x);
|
||||||
} else {
|
} else {
|
||||||
JanetSlot head = janetc_value(subopts, tup[0]);
|
JanetSlot head = janetc_value(subopts, tup[0]);
|
||||||
subopts.flags = JANET_FUNCTION | JANET_CFUNCTION;
|
subopts.flags = JANET_FUNCTION | JANET_CFUNCTION;
|
||||||
@@ -553,7 +568,7 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
|||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
ret = janetc_sym_rvalue(opts, janet_unwrap_symbol(x));
|
ret = janetc_resolve(c, janet_unwrap_symbol(x));
|
||||||
break;
|
break;
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY:
|
||||||
ret = janetc_array(opts, x);
|
ret = janetc_array(opts, x);
|
||||||
@@ -575,14 +590,14 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
|||||||
|
|
||||||
if (c->result.status == JANET_COMPILE_ERROR)
|
if (c->result.status == JANET_COMPILE_ERROR)
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
c->current_mapping = last_mapping;
|
|
||||||
if (opts.flags & JANET_FOPTS_TAIL)
|
if (opts.flags & JANET_FOPTS_TAIL)
|
||||||
ret = janetc_return(opts.compiler, ret);
|
ret = janetc_return(c, ret);
|
||||||
if (opts.flags & JANET_FOPTS_HINT) {
|
if (opts.flags & JANET_FOPTS_HINT) {
|
||||||
janetc_copy(opts.compiler, opts.hint, ret);
|
janetc_copy(c, opts.hint, ret);
|
||||||
ret = opts.hint;
|
ret = opts.hint;
|
||||||
}
|
}
|
||||||
opts.compiler->recursion_guard++;
|
c->current_mapping = last_mapping;
|
||||||
|
c->recursion_guard++;
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -629,6 +644,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
|||||||
def->source = c->source;
|
def->source = c->source;
|
||||||
|
|
||||||
def->arity = 0;
|
def->arity = 0;
|
||||||
|
def->min_arity = 0;
|
||||||
def->flags = 0;
|
def->flags = 0;
|
||||||
if (scope->flags & JANET_SCOPE_ENV) {
|
if (scope->flags & JANET_SCOPE_ENV) {
|
||||||
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
|
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
|
||||||
@@ -648,15 +664,15 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where)
|
|||||||
c->recursion_guard = JANET_RECURSION_GUARD;
|
c->recursion_guard = JANET_RECURSION_GUARD;
|
||||||
c->env = env;
|
c->env = env;
|
||||||
c->source = where;
|
c->source = where;
|
||||||
c->current_mapping.line = 0;
|
c->current_mapping.start = -1;
|
||||||
c->current_mapping.column = 0;
|
c->current_mapping.end = -1;
|
||||||
/* Init result */
|
/* Init result */
|
||||||
c->result.error = NULL;
|
c->result.error = NULL;
|
||||||
c->result.status = JANET_COMPILE_OK;
|
c->result.status = JANET_COMPILE_OK;
|
||||||
c->result.funcdef = NULL;
|
c->result.funcdef = NULL;
|
||||||
c->result.macrofiber = NULL;
|
c->result.macrofiber = NULL;
|
||||||
c->result.error_mapping.line = 0;
|
c->result.error_mapping.start = -1;
|
||||||
c->result.error_mapping.column = 0;
|
c->result.error_mapping.end = -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Deinitialize a compiler struct */
|
/* Deinitialize a compiler struct */
|
||||||
@@ -700,45 +716,44 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* C Function for compiling */
|
/* C Function for compiling */
|
||||||
static int cfun(JanetArgs args) {
|
static Janet cfun(int32_t argc, Janet *argv) {
|
||||||
JanetCompileResult res;
|
janet_arity(argc, 1, 3);
|
||||||
JanetTable *t;
|
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env;
|
||||||
JanetTable *env;
|
if (NULL == env) {
|
||||||
JANET_MINARITY(args, 2);
|
env = janet_table(0);
|
||||||
JANET_MAXARITY(args, 3);
|
janet_vm_fiber->env = env;
|
||||||
JANET_ARG_TABLE(env, args, 1);
|
}
|
||||||
const uint8_t *source = NULL;
|
const uint8_t *source = NULL;
|
||||||
if (args.n == 3) {
|
if (argc == 3) {
|
||||||
JANET_ARG_STRING(source, args, 2);
|
source = janet_getstring(argv, 2);
|
||||||
}
|
}
|
||||||
res = janet_compile(args.v[0], env, source);
|
JanetCompileResult res = janet_compile(argv[0], env, source);
|
||||||
if (res.status == JANET_COMPILE_OK) {
|
if (res.status == JANET_COMPILE_OK) {
|
||||||
JANET_RETURN_FUNCTION(args, janet_thunk(res.funcdef));
|
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||||
} else {
|
} else {
|
||||||
t = janet_table(4);
|
JanetTable *t = janet_table(4);
|
||||||
janet_table_put(t, janet_csymbolv(":error"), janet_wrap_string(res.error));
|
janet_table_put(t, janet_ckeywordv("error"), janet_wrap_string(res.error));
|
||||||
janet_table_put(t, janet_csymbolv(":line"), janet_wrap_integer(res.error_mapping.line));
|
janet_table_put(t, janet_ckeywordv("start"), janet_wrap_integer(res.error_mapping.start));
|
||||||
janet_table_put(t, janet_csymbolv(":column"), janet_wrap_integer(res.error_mapping.column));
|
janet_table_put(t, janet_ckeywordv("end"), janet_wrap_integer(res.error_mapping.end));
|
||||||
if (res.macrofiber) {
|
if (res.macrofiber) {
|
||||||
janet_table_put(t, janet_csymbolv(":fiber"), janet_wrap_fiber(res.macrofiber));
|
janet_table_put(t, janet_ckeywordv("fiber"), janet_wrap_fiber(res.macrofiber));
|
||||||
}
|
}
|
||||||
JANET_RETURN_TABLE(args, t);
|
return janet_wrap_table(t);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetReg compile_cfuns[] = {
|
||||||
{"compile", cfun,
|
{
|
||||||
"(compile ast env [, source])\n\n"
|
"compile", cfun,
|
||||||
"Compiles an Abstract Sytnax Tree (ast) into a janet function. "
|
JDOC("(compile ast &opt env source)\n\n"
|
||||||
|
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
||||||
"Pair the compile function with parsing functionality to implement "
|
"Pair the compile function with parsing functionality to implement "
|
||||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||||
"error if the ast cannot be compiled."
|
"error if the ast cannot be compiled.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
int janet_lib_compile(JanetArgs args) {
|
void janet_lib_compile(JanetTable *env) {
|
||||||
JanetTable *env = janet_env(args);
|
janet_core_cfuns(env, NULL, compile_cfuns);
|
||||||
janet_cfuns(env, NULL, cfuns);
|
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2017 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -23,8 +23,10 @@
|
|||||||
#ifndef JANET_COMPILE_H
|
#ifndef JANET_COMPILE_H
|
||||||
#define JANET_COMPILE_H
|
#define JANET_COMPILE_H
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "regalloc.h"
|
#include "regalloc.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Tags for some functions for the prepared inliner */
|
/* Tags for some functions for the prepared inliner */
|
||||||
#define JANET_FUN_DEBUG 1
|
#define JANET_FUN_DEBUG 1
|
||||||
@@ -94,6 +96,7 @@ struct JanetSlot {
|
|||||||
#define JANET_SCOPE_TOP 4
|
#define JANET_SCOPE_TOP 4
|
||||||
#define JANET_SCOPE_UNUSED 8
|
#define JANET_SCOPE_UNUSED 8
|
||||||
#define JANET_SCOPE_CLOSURE 16
|
#define JANET_SCOPE_CLOSURE 16
|
||||||
|
#define JANET_SCOPE_WHILE 32
|
||||||
|
|
||||||
/* A symbol and slot pair */
|
/* A symbol and slot pair */
|
||||||
typedef struct SymPair {
|
typedef struct SymPair {
|
||||||
@@ -129,9 +132,6 @@ struct JanetScope {
|
|||||||
* that corresponds to the direct parent's stack will always have value 0. */
|
* that corresponds to the direct parent's stack will always have value 0. */
|
||||||
int32_t *envs;
|
int32_t *envs;
|
||||||
|
|
||||||
/* Where to add reference to self in constants */
|
|
||||||
int32_t selfconst;
|
|
||||||
|
|
||||||
int32_t bytecode_start;
|
int32_t bytecode_start;
|
||||||
int flags;
|
int flags;
|
||||||
};
|
};
|
||||||
@@ -178,13 +178,13 @@ JanetFopts janetc_fopts_default(JanetCompiler *c);
|
|||||||
/* For optimizing builtin normal functions. */
|
/* For optimizing builtin normal functions. */
|
||||||
struct JanetFunOptimizer {
|
struct JanetFunOptimizer {
|
||||||
int (*can_optimize)(JanetFopts opts, JanetSlot *args);
|
int (*can_optimize)(JanetFopts opts, JanetSlot *args);
|
||||||
JanetSlot (*optimize)(JanetFopts opts, JanetSlot *args);
|
JanetSlot(*optimize)(JanetFopts opts, JanetSlot *args);
|
||||||
};
|
};
|
||||||
|
|
||||||
/* A grouping of a named special and the corresponding compiler fragment */
|
/* A grouping of a named special and the corresponding compiler fragment */
|
||||||
struct JanetSpecial {
|
struct JanetSpecial {
|
||||||
const char *name;
|
const char *name;
|
||||||
JanetSlot (*compile)(JanetFopts opts, int32_t argn, const Janet *argv);
|
JanetSlot(*compile)(JanetFopts opts, int32_t argn, const Janet *argv);
|
||||||
};
|
};
|
||||||
|
|
||||||
/****************************************************/
|
/****************************************************/
|
||||||
@@ -240,10 +240,4 @@ JanetSlot janetc_cslot(Janet x);
|
|||||||
/* Search for a symbol */
|
/* Search for a symbol */
|
||||||
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
||||||
|
|
||||||
/* Compile a symbol (or mutltisym) when used as an rvalue. */
|
|
||||||
JanetSlot janetc_sym_rvalue(JanetFopts opts, const uint8_t *sym);
|
|
||||||
|
|
||||||
/* Compile an assignment to a symbol (or multisym) */
|
|
||||||
JanetSlot janetc_sym_lvalue(JanetFopts opts, const uint8_t *sym, Janet value);
|
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
1527
src/core/core.janet
1527
src/core/core.janet
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
381
src/core/debug.c
Normal file
381
src/core/debug.c
Normal file
@@ -0,0 +1,381 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 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 <janet.h>
|
||||||
|
#include "gc.h"
|
||||||
|
#include "state.h"
|
||||||
|
#include "util.h"
|
||||||
|
#include "vector.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Implements functionality to build a debugger from within janet.
|
||||||
|
* The repl should also be able to serve as pretty featured debugger
|
||||||
|
* out of the box. */
|
||||||
|
|
||||||
|
/* Add a break point to a function */
|
||||||
|
void janet_debug_break(JanetFuncDef *def, int32_t pc) {
|
||||||
|
if (pc >= def->bytecode_length || pc < 0)
|
||||||
|
janet_panic("invalid bytecode offset");
|
||||||
|
def->bytecode[pc] |= 0x80;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Remove a break point from a function */
|
||||||
|
void janet_debug_unbreak(JanetFuncDef *def, int32_t pc) {
|
||||||
|
if (pc >= def->bytecode_length || pc < 0)
|
||||||
|
janet_panic("invalid bytecode offset");
|
||||||
|
def->bytecode[pc] &= ~((uint32_t)0x80);
|
||||||
|
}
|
||||||
|
|
||||||
|
/*
|
||||||
|
* Find a location for a breakpoint given a source file an
|
||||||
|
* location.
|
||||||
|
*/
|
||||||
|
void janet_debug_find(
|
||||||
|
JanetFuncDef **def_out, int32_t *pc_out,
|
||||||
|
const uint8_t *source, int32_t offset) {
|
||||||
|
/* Scan the heap for right func def */
|
||||||
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
|
/* Keep track of the best source mapping we have seen so far */
|
||||||
|
int32_t besti = -1;
|
||||||
|
int32_t best_range = INT32_MAX;
|
||||||
|
JanetFuncDef *best_def = NULL;
|
||||||
|
while (NULL != current) {
|
||||||
|
if ((current->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_FUNCDEF) {
|
||||||
|
JanetFuncDef *def = (JanetFuncDef *)(current + 1);
|
||||||
|
if (def->sourcemap &&
|
||||||
|
def->source &&
|
||||||
|
!janet_string_compare(source, def->source)) {
|
||||||
|
/* Correct source file, check mappings. The chosen
|
||||||
|
* pc index is the first match with the smallest range. */
|
||||||
|
int32_t i;
|
||||||
|
for (i = 0; i < def->bytecode_length; i++) {
|
||||||
|
int32_t start = def->sourcemap[i].start;
|
||||||
|
int32_t end = def->sourcemap[i].end;
|
||||||
|
if (end - start < best_range &&
|
||||||
|
start <= offset &&
|
||||||
|
end >= offset) {
|
||||||
|
best_range = end - start;
|
||||||
|
besti = i;
|
||||||
|
best_def = def;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
current = current->next;
|
||||||
|
}
|
||||||
|
if (best_def) {
|
||||||
|
*def_out = best_def;
|
||||||
|
*pc_out = besti;
|
||||||
|
} else {
|
||||||
|
janet_panic("could not find breakpoint");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Error reporting. This can be emulated from within Janet, but for
|
||||||
|
* consitency with the top level code it is defined once. */
|
||||||
|
void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||||
|
int32_t fi;
|
||||||
|
FILE *out = janet_dynfile("err", stderr);
|
||||||
|
const char *errstr = (const char *)janet_to_string(err);
|
||||||
|
JanetFiber **fibers = NULL;
|
||||||
|
int wrote_error = 0;
|
||||||
|
|
||||||
|
while (fiber) {
|
||||||
|
janet_v_push(fibers, fiber);
|
||||||
|
fiber = fiber->child;
|
||||||
|
}
|
||||||
|
|
||||||
|
for (fi = janet_v_count(fibers) - 1; fi >= 0; fi--) {
|
||||||
|
fiber = fibers[fi];
|
||||||
|
int32_t i = fiber->frame;
|
||||||
|
while (i > 0) {
|
||||||
|
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||||
|
JanetFuncDef *def = NULL;
|
||||||
|
i = frame->prevframe;
|
||||||
|
|
||||||
|
/* Print prelude to stack frame */
|
||||||
|
if (!wrote_error) {
|
||||||
|
JanetFiberStatus status = janet_fiber_status(fiber);
|
||||||
|
const char *prefix = status == JANET_STATUS_ERROR ? "" : "status ";
|
||||||
|
fprintf(out, "%s%s: %s\n",
|
||||||
|
prefix,
|
||||||
|
janet_status_names[status],
|
||||||
|
errstr);
|
||||||
|
wrote_error = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
fprintf(out, " in");
|
||||||
|
|
||||||
|
if (frame->func) {
|
||||||
|
def = frame->func->def;
|
||||||
|
fprintf(out, " %s", def->name ? (const char *)def->name : "<anonymous>");
|
||||||
|
if (def->source) {
|
||||||
|
fprintf(out, " [%s]", (const char *)def->source);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||||
|
if (cfun) {
|
||||||
|
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||||
|
if (!janet_checktype(name, JANET_NIL))
|
||||||
|
fprintf(out, " %s", (const char *)janet_to_string(name));
|
||||||
|
else
|
||||||
|
fprintf(out, " <cfunction>");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
||||||
|
fprintf(out, " (tailcall)");
|
||||||
|
if (frame->func && frame->pc) {
|
||||||
|
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
||||||
|
if (def->sourcemap) {
|
||||||
|
JanetSourceMapping mapping = def->sourcemap[off];
|
||||||
|
fprintf(out, " at (%d:%d)", mapping.start, mapping.end);
|
||||||
|
} else {
|
||||||
|
fprintf(out, " pc=%d", off);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
fprintf(out, "\n");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
janet_v_free(fibers);
|
||||||
|
}
|
||||||
|
|
||||||
|
/*
|
||||||
|
* CFuns
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
|
||||||
|
* Takes a source file name and byte offset. */
|
||||||
|
static void helper_find(int32_t argc, Janet *argv, JanetFuncDef **def, int32_t *bytecode_offset) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
const uint8_t *source = janet_getstring(argv, 0);
|
||||||
|
int32_t source_offset = janet_getinteger(argv, 1);
|
||||||
|
janet_debug_find(def, bytecode_offset, source, source_offset);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
|
||||||
|
* Takes a function and byte offset*/
|
||||||
|
static void helper_find_fun(int32_t argc, Janet *argv, JanetFuncDef **def, int32_t *bytecode_offset) {
|
||||||
|
janet_arity(argc, 1, 2);
|
||||||
|
JanetFunction *func = janet_getfunction(argv, 0);
|
||||||
|
int32_t offset = (argc == 2) ? janet_getinteger(argv, 1) : 0;
|
||||||
|
*def = func->def;
|
||||||
|
*bytecode_offset = offset;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_debug_break(int32_t argc, Janet *argv) {
|
||||||
|
JanetFuncDef *def;
|
||||||
|
int32_t offset;
|
||||||
|
helper_find(argc, argv, &def, &offset);
|
||||||
|
janet_debug_break(def, offset);
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
|
||||||
|
JanetFuncDef *def;
|
||||||
|
int32_t offset = 0;
|
||||||
|
helper_find(argc, argv, &def, &offset);
|
||||||
|
janet_debug_unbreak(def, offset);
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
|
||||||
|
JanetFuncDef *def;
|
||||||
|
int32_t offset = 0;
|
||||||
|
helper_find_fun(argc, argv, &def, &offset);
|
||||||
|
janet_debug_break(def, offset);
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_debug_unfbreak(int32_t argc, Janet *argv) {
|
||||||
|
JanetFuncDef *def;
|
||||||
|
int32_t offset;
|
||||||
|
helper_find_fun(argc, argv, &def, &offset);
|
||||||
|
janet_debug_unbreak(def, offset);
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_debug_lineage(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
|
JanetArray *array = janet_array(0);
|
||||||
|
while (fiber) {
|
||||||
|
janet_array_push(array, janet_wrap_fiber(fiber));
|
||||||
|
fiber = fiber->child;
|
||||||
|
}
|
||||||
|
return janet_wrap_array(array);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Extract info from one stack frame */
|
||||||
|
static Janet doframe(JanetStackFrame *frame) {
|
||||||
|
int32_t off;
|
||||||
|
JanetTable *t = janet_table(3);
|
||||||
|
JanetFuncDef *def = NULL;
|
||||||
|
if (frame->func) {
|
||||||
|
janet_table_put(t, janet_ckeywordv("function"), janet_wrap_function(frame->func));
|
||||||
|
def = frame->func->def;
|
||||||
|
if (def->name) {
|
||||||
|
janet_table_put(t, janet_ckeywordv("name"), janet_wrap_string(def->name));
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||||
|
if (cfun) {
|
||||||
|
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||||
|
if (!janet_checktype(name, JANET_NIL)) {
|
||||||
|
janet_table_put(t, janet_ckeywordv("name"), name);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_table_put(t, janet_ckeywordv("c"), janet_wrap_true());
|
||||||
|
}
|
||||||
|
if (frame->flags & JANET_STACKFRAME_TAILCALL) {
|
||||||
|
janet_table_put(t, janet_ckeywordv("tail"), janet_wrap_true());
|
||||||
|
}
|
||||||
|
if (frame->func && frame->pc) {
|
||||||
|
Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
|
||||||
|
JanetArray *slots;
|
||||||
|
off = (int32_t)(frame->pc - def->bytecode);
|
||||||
|
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
|
||||||
|
if (def->sourcemap) {
|
||||||
|
JanetSourceMapping mapping = def->sourcemap[off];
|
||||||
|
janet_table_put(t, janet_ckeywordv("source-start"), janet_wrap_integer(mapping.start));
|
||||||
|
janet_table_put(t, janet_ckeywordv("source-end"), janet_wrap_integer(mapping.end));
|
||||||
|
}
|
||||||
|
if (def->source) {
|
||||||
|
janet_table_put(t, janet_ckeywordv("source"), janet_wrap_string(def->source));
|
||||||
|
}
|
||||||
|
/* Add stack arguments */
|
||||||
|
slots = janet_array(def->slotcount);
|
||||||
|
memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
||||||
|
slots->count = def->slotcount;
|
||||||
|
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
|
||||||
|
}
|
||||||
|
return janet_wrap_table(t);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
|
JanetArray *array = janet_array(0);
|
||||||
|
{
|
||||||
|
int32_t i = fiber->frame;
|
||||||
|
JanetStackFrame *frame;
|
||||||
|
while (i > 0) {
|
||||||
|
frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||||
|
janet_array_push(array, doframe(frame));
|
||||||
|
i = frame->prevframe;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return janet_wrap_array(array);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
|
janet_stacktrace(fiber, argv[1]);
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
|
JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
|
||||||
|
memcpy(array->data, fiber->data + fiber->stackstart, array->capacity * sizeof(Janet));
|
||||||
|
array->count = array->capacity;
|
||||||
|
return janet_wrap_array(array);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg debug_cfuns[] = {
|
||||||
|
{
|
||||||
|
"debug/break", cfun_debug_break,
|
||||||
|
JDOC("(debug/break source byte-offset)\n\n"
|
||||||
|
"Sets a breakpoint with source a key at a given byte offset. An offset "
|
||||||
|
"of 0 is the first byte in a file. Will throw an error if the breakpoint location "
|
||||||
|
"cannot be found. For example\n\n"
|
||||||
|
"\t(debug/break \"core.janet\" 1000)\n\n"
|
||||||
|
"wil set a breakpoint at the 1000th byte of the file core.janet.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/unbreak", cfun_debug_unbreak,
|
||||||
|
JDOC("(debug/unbreak source byte-offset)\n\n"
|
||||||
|
"Remove a breakpoint with a source key at a given byte offset. An offset "
|
||||||
|
"of 0 is the first byte in a file. Will throw an error if the breakpoint "
|
||||||
|
"cannot be found.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/fbreak", cfun_debug_fbreak,
|
||||||
|
JDOC("(debug/fbreak fun [,pc=0])\n\n"
|
||||||
|
"Set a breakpoint in a given function. pc is an optional offset, which "
|
||||||
|
"is in bytecode instructions. fun is a function value. Will throw an error "
|
||||||
|
"if the offset is too large or negative.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/unfbreak", cfun_debug_unfbreak,
|
||||||
|
JDOC("(debug/unfbreak fun [,pc=0])\n\n"
|
||||||
|
"Unset a breakpoint set with debug/fbreak.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/arg-stack", cfun_debug_argstack,
|
||||||
|
JDOC("(debug/arg-stack fiber)\n\n"
|
||||||
|
"Gets all values currently on the fiber's argument stack. Normally, "
|
||||||
|
"this should be empty unless the fiber signals while pushing arguments "
|
||||||
|
"to make a function call. Returns a new array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/stack", cfun_debug_stack,
|
||||||
|
JDOC("(debug/stack fib)\n\n"
|
||||||
|
"Gets information about the stack as an array of tables. Each table "
|
||||||
|
"in the array contains information about a stack frame. The top most, current "
|
||||||
|
"stack frame is the first table in the array, and the bottom most stack frame "
|
||||||
|
"is the last value. Each stack frame contains some of the following attributes:\n\n"
|
||||||
|
"\t:c - true if the stack frame is a c function invocation\n"
|
||||||
|
"\t:column - the current source column of the stack frame\n"
|
||||||
|
"\t:function - the function that the stack frame represents\n"
|
||||||
|
"\t:line - the current source line of the stack frame\n"
|
||||||
|
"\t:name - the human friendly name of the function\n"
|
||||||
|
"\t:pc - integer indicating the location of the program counter\n"
|
||||||
|
"\t:source - string with the file path or other identifier for the source code\n"
|
||||||
|
"\t:slots - array of all values in each slot\n"
|
||||||
|
"\t:tail - boolean indicating a tail call")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/stacktrace", cfun_debug_stacktrace,
|
||||||
|
JDOC("(debug/stacktrace fiber err)\n\n"
|
||||||
|
"Prints a nice looking stacktrace for a fiber. The error message "
|
||||||
|
"err must be passed to the function as fiber's do not keep track of "
|
||||||
|
"the last error they have thrown. Returns the fiber.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/lineage", cfun_debug_lineage,
|
||||||
|
JDOC("(debug/lineage fib)\n\n"
|
||||||
|
"Returns an array of all child fibers from a root fiber. This function "
|
||||||
|
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
|
||||||
|
"the fiber handling the error can see which fiber raised the signal. This function should "
|
||||||
|
"be used mostly for debugging purposes.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
/* Module entry point */
|
||||||
|
void janet_lib_debug(JanetTable *env) {
|
||||||
|
janet_core_cfuns(env, NULL, debug_cfuns);
|
||||||
|
}
|
||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,10 +20,12 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "emit.h"
|
#include "emit.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
#include "regalloc.h"
|
#include "regalloc.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Get a register */
|
/* Get a register */
|
||||||
int32_t janetc_allocfar(JanetCompiler *c) {
|
int32_t janetc_allocfar(JanetCompiler *c) {
|
||||||
@@ -61,7 +63,7 @@ static int32_t janetc_const(JanetCompiler *c, Janet x) {
|
|||||||
if (janet_equals(x, scope->consts[i]))
|
if (janet_equals(x, scope->consts[i]))
|
||||||
return i;
|
return i;
|
||||||
}
|
}
|
||||||
/* Ensure not too many constsants. */
|
/* Ensure not too many constants. */
|
||||||
if (len >= 0xFFFF) {
|
if (len >= 0xFFFF) {
|
||||||
janetc_cerror(c, "too many constants");
|
janetc_cerror(c, "too many constants");
|
||||||
return 0;
|
return 0;
|
||||||
@@ -76,27 +78,26 @@ static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
|
|||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
janetc_emit(c, (reg << 8) | JOP_LOAD_NIL);
|
janetc_emit(c, (reg << 8) | JOP_LOAD_NIL);
|
||||||
break;
|
break;
|
||||||
case JANET_TRUE:
|
case JANET_BOOLEAN:
|
||||||
janetc_emit(c, (reg << 8) | JOP_LOAD_TRUE);
|
janetc_emit(c, (reg << 8) |
|
||||||
|
(janet_unwrap_boolean(k) ? JOP_LOAD_TRUE : JOP_LOAD_FALSE));
|
||||||
break;
|
break;
|
||||||
case JANET_FALSE:
|
case JANET_NUMBER: {
|
||||||
janetc_emit(c, (reg << 8) | JOP_LOAD_FALSE);
|
double dval = janet_unwrap_number(k);
|
||||||
break;
|
if (dval < INT16_MIN || dval > INT16_MAX)
|
||||||
case JANET_INTEGER:
|
goto do_constant;
|
||||||
{
|
int32_t i = (int32_t) dval;
|
||||||
int32_t i = janet_unwrap_integer(k);
|
if (dval != i)
|
||||||
if (i <= INT16_MAX && i >= INT16_MIN) {
|
goto do_constant;
|
||||||
|
uint32_t iu = (uint32_t)i;
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
(i << 16) |
|
(iu << 16) |
|
||||||
(reg << 8) |
|
(reg << 8) |
|
||||||
JOP_LOAD_INTEGER);
|
JOP_LOAD_INTEGER);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
goto do_constant;
|
|
||||||
}
|
|
||||||
default:
|
default:
|
||||||
do_constant:
|
do_constant: {
|
||||||
{
|
|
||||||
int32_t cindex = janetc_const(c, k);
|
int32_t cindex = janetc_const(c, k);
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
(cindex << 16) |
|
(cindex << 16) |
|
||||||
@@ -238,11 +239,11 @@ void janetc_copy(
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
/* Process: src -> near -> dest */
|
/* Process: src -> near -> dest */
|
||||||
int32_t near = janetc_allocnear(c, JANETC_REGTEMP_3);
|
int32_t nearreg = janetc_allocnear(c, JANETC_REGTEMP_3);
|
||||||
janetc_movenear(c, near, src);
|
janetc_movenear(c, nearreg, src);
|
||||||
janetc_moveback(c, dest, near);
|
janetc_moveback(c, dest, nearreg);
|
||||||
/* Cleanup */
|
/* Cleanup */
|
||||||
janetc_regalloc_freetemp(&c->scope->ra, near, JANETC_REGTEMP_3);
|
janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
|
||||||
|
|
||||||
}
|
}
|
||||||
/* Instruction templated emitters */
|
/* Instruction templated emitters */
|
||||||
@@ -250,7 +251,7 @@ void janetc_copy(
|
|||||||
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
|
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
|
||||||
int32_t reg = janetc_regnear(c, s, JANETC_REGTEMP_0);
|
int32_t reg = janetc_regnear(c, s, JANETC_REGTEMP_0);
|
||||||
int32_t label = janet_v_count(c->buffer);
|
int32_t label = janet_v_count(c->buffer);
|
||||||
janetc_emit(c, op | (reg << 8) | (rest << 16));
|
janetc_emit(c, op | (reg << 8) | ((uint32_t)rest << 16));
|
||||||
if (wr)
|
if (wr)
|
||||||
janetc_moveback(c, s, reg);
|
janetc_moveback(c, s, reg);
|
||||||
janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
|
janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
|
||||||
@@ -292,7 +293,7 @@ static int32_t emit2s(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2,
|
|||||||
int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
|
int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
|
||||||
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
|
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
|
||||||
int32_t label = janet_v_count(c->buffer);
|
int32_t label = janet_v_count(c->buffer);
|
||||||
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | (rest << 24));
|
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | ((uint32_t)rest << 24));
|
||||||
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
|
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
|
||||||
if (wr)
|
if (wr)
|
||||||
janetc_moveback(c, s1, reg1);
|
janetc_moveback(c, s1, reg1);
|
||||||
@@ -325,7 +326,7 @@ int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2
|
|||||||
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
|
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
|
||||||
int32_t reg3 = janetc_regnear(c, s3, JANETC_REGTEMP_2);
|
int32_t reg3 = janetc_regnear(c, s3, JANETC_REGTEMP_2);
|
||||||
int32_t label = janet_v_count(c->buffer);
|
int32_t label = janet_v_count(c->buffer);
|
||||||
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | (reg3 << 24));
|
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | ((uint32_t)reg3 << 24));
|
||||||
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
|
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
|
||||||
janetc_free_regnear(c, s3, reg3, JANETC_REGTEMP_2);
|
janetc_free_regnear(c, s3, reg3, JANETC_REGTEMP_2);
|
||||||
if (wr)
|
if (wr)
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -23,7 +23,9 @@
|
|||||||
#ifndef JANET_EMIT_H
|
#ifndef JANET_EMIT_H
|
||||||
#define JANET_EMIT_H
|
#define JANET_EMIT_H
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
void janetc_emit(JanetCompiler *c, uint32_t instr);
|
void janetc_emit(JanetCompiler *c, uint32_t instr);
|
||||||
|
|
||||||
|
|||||||
397
src/core/fiber.c
397
src/core/fiber.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,16 +20,30 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "fiber.h"
|
#include "fiber.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
static JanetFiber *make_fiber(int32_t capacity) {
|
static void fiber_reset(JanetFiber *fiber) {
|
||||||
|
fiber->maxstack = JANET_STACK_MAX;
|
||||||
|
fiber->frame = 0;
|
||||||
|
fiber->stackstart = JANET_FRAME_SIZE;
|
||||||
|
fiber->stacktop = JANET_FRAME_SIZE;
|
||||||
|
fiber->child = NULL;
|
||||||
|
fiber->flags = JANET_FIBER_MASK_YIELD;
|
||||||
|
fiber->env = NULL;
|
||||||
|
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||||
|
}
|
||||||
|
|
||||||
|
static JanetFiber *fiber_alloc(int32_t capacity) {
|
||||||
Janet *data;
|
Janet *data;
|
||||||
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
|
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
|
||||||
if (capacity < 16) {
|
if (capacity < 32) {
|
||||||
capacity = 16;
|
capacity = 32;
|
||||||
}
|
}
|
||||||
fiber->capacity = capacity;
|
fiber->capacity = capacity;
|
||||||
data = malloc(sizeof(Janet) * capacity);
|
data = malloc(sizeof(Janet) * capacity);
|
||||||
@@ -37,39 +51,31 @@ static JanetFiber *make_fiber(int32_t capacity) {
|
|||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
fiber->data = data;
|
fiber->data = data;
|
||||||
fiber->maxstack = JANET_STACK_MAX;
|
|
||||||
fiber->frame = 0;
|
|
||||||
fiber->stackstart = JANET_FRAME_SIZE;
|
|
||||||
fiber->stacktop = JANET_FRAME_SIZE;
|
|
||||||
fiber->child = NULL;
|
|
||||||
fiber->flags = JANET_FIBER_MASK_YIELD;
|
|
||||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
|
||||||
return fiber;
|
return fiber;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Initialize a new fiber */
|
/* Create a new fiber with argn values on the stack by reusing a fiber. */
|
||||||
JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity) {
|
JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv) {
|
||||||
JanetFiber *fiber = make_fiber(capacity);
|
|
||||||
if (janet_fiber_funcframe(fiber, callee))
|
|
||||||
janet_fiber_set_status(fiber, JANET_STATUS_ERROR);
|
|
||||||
return fiber;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Clear a fiber (reset it) with argn values on the stack. */
|
|
||||||
JanetFiber *janet_fiber_n(JanetFunction *callee, int32_t capacity, const Janet *argv, int32_t argn) {
|
|
||||||
int32_t newstacktop;
|
int32_t newstacktop;
|
||||||
JanetFiber *fiber = make_fiber(capacity);
|
fiber_reset(fiber);
|
||||||
newstacktop = fiber->stacktop + argn;
|
if (argc) {
|
||||||
|
newstacktop = fiber->stacktop + argc;
|
||||||
if (newstacktop >= fiber->capacity) {
|
if (newstacktop >= fiber->capacity) {
|
||||||
janet_fiber_setcapacity(fiber, 2 * newstacktop);
|
janet_fiber_setcapacity(fiber, 2 * newstacktop);
|
||||||
}
|
}
|
||||||
memcpy(fiber->data + fiber->stacktop, argv, argn * sizeof(Janet));
|
memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
|
||||||
fiber->stacktop = newstacktop;
|
fiber->stacktop = newstacktop;
|
||||||
if (janet_fiber_funcframe(fiber, callee))
|
}
|
||||||
janet_fiber_set_status(fiber, JANET_STATUS_ERROR);
|
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||||
|
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||||
return fiber;
|
return fiber;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Create a new fiber with argn values on the stack. */
|
||||||
|
JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv) {
|
||||||
|
return janet_fiber_reset(fiber_alloc(capacity), callee, argc, argv);
|
||||||
|
}
|
||||||
|
|
||||||
/* Ensure that the fiber has enough extra capacity */
|
/* Ensure that the fiber has enough extra capacity */
|
||||||
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
||||||
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
|
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
|
||||||
@@ -121,6 +127,16 @@ void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
|
|||||||
fiber->stacktop = newtop;
|
fiber->stacktop = newtop;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Create a struct with n values. If n is odd, the last value is ignored. */
|
||||||
|
static Janet make_struct_n(const Janet *args, int32_t n) {
|
||||||
|
int32_t i = 0;
|
||||||
|
JanetKV *st = janet_struct_begin(n & (~1));
|
||||||
|
for (; i < n; i += 2) {
|
||||||
|
janet_struct_put(st, args[i], args[i + 1]);
|
||||||
|
}
|
||||||
|
return janet_wrap_struct(janet_struct_end(st));
|
||||||
|
}
|
||||||
|
|
||||||
/* Push a stack frame to a fiber */
|
/* Push a stack frame to a fiber */
|
||||||
int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||||
JanetStackFrame *newframe;
|
JanetStackFrame *newframe;
|
||||||
@@ -132,6 +148,10 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
int32_t nextstacktop = nextframe + func->def->slotcount + JANET_FRAME_SIZE;
|
int32_t nextstacktop = nextframe + func->def->slotcount + JANET_FRAME_SIZE;
|
||||||
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
||||||
|
|
||||||
|
/* Check strict arity before messing with state */
|
||||||
|
if (next_arity < func->def->min_arity) return 1;
|
||||||
|
if (next_arity > func->def->max_arity) return 1;
|
||||||
|
|
||||||
if (fiber->capacity < nextstacktop) {
|
if (fiber->capacity < nextstacktop) {
|
||||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||||
}
|
}
|
||||||
@@ -154,22 +174,22 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
/* Check varargs */
|
/* Check varargs */
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||||
int32_t tuplehead = fiber->frame + func->def->arity;
|
int32_t tuplehead = fiber->frame + func->def->arity;
|
||||||
|
int st = func->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
if (tuplehead >= oldtop) {
|
if (tuplehead >= oldtop) {
|
||||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
fiber->data[tuplehead] = st
|
||||||
|
? make_struct_n(NULL, 0)
|
||||||
|
: janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||||
} else {
|
} else {
|
||||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
|
fiber->data[tuplehead] = st
|
||||||
|
? make_struct_n(
|
||||||
|
fiber->data + tuplehead,
|
||||||
|
oldtop - tuplehead)
|
||||||
|
: janet_wrap_tuple(janet_tuple_n(
|
||||||
fiber->data + tuplehead,
|
fiber->data + tuplehead,
|
||||||
oldtop - tuplehead));
|
oldtop - tuplehead));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Check strict arity AFTER getting fiber to valid state. */
|
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
|
||||||
if (func->def->arity != next_arity) {
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Good return */
|
/* Good return */
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -198,6 +218,10 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
||||||
int32_t stacksize;
|
int32_t stacksize;
|
||||||
|
|
||||||
|
/* Check strict arity before messing with state */
|
||||||
|
if (next_arity < func->def->min_arity) return 1;
|
||||||
|
if (next_arity > func->def->max_arity) return 1;
|
||||||
|
|
||||||
if (fiber->capacity < nextstacktop) {
|
if (fiber->capacity < nextstacktop) {
|
||||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||||
}
|
}
|
||||||
@@ -205,7 +229,7 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
Janet *stack = fiber->data + fiber->frame;
|
Janet *stack = fiber->data + fiber->frame;
|
||||||
Janet *args = fiber->data + fiber->stackstart;
|
Janet *args = fiber->data + fiber->stackstart;
|
||||||
|
|
||||||
/* Detatch old function */
|
/* Detach old function */
|
||||||
if (NULL != janet_fiber_frame(fiber)->func)
|
if (NULL != janet_fiber_frame(fiber)->func)
|
||||||
janet_env_detach(janet_fiber_frame(fiber)->env);
|
janet_env_detach(janet_fiber_frame(fiber)->env);
|
||||||
janet_fiber_frame(fiber)->env = NULL;
|
janet_fiber_frame(fiber)->env = NULL;
|
||||||
@@ -213,12 +237,19 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
/* Check varargs */
|
/* Check varargs */
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||||
int32_t tuplehead = fiber->stackstart + func->def->arity;
|
int32_t tuplehead = fiber->stackstart + func->def->arity;
|
||||||
|
int st = func->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
if (tuplehead >= fiber->stacktop) {
|
if (tuplehead >= fiber->stacktop) {
|
||||||
if (tuplehead >= fiber->capacity) janet_fiber_setcapacity(fiber, 2 * (tuplehead + 1));
|
if (tuplehead >= fiber->capacity) janet_fiber_setcapacity(fiber, 2 * (tuplehead + 1));
|
||||||
for (i = fiber->stacktop; i < tuplehead; ++i) fiber->data[i] = janet_wrap_nil();
|
for (i = fiber->stacktop; i < tuplehead; ++i) fiber->data[i] = janet_wrap_nil();
|
||||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
fiber->data[tuplehead] = st
|
||||||
|
? make_struct_n(NULL, 0)
|
||||||
|
: janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||||
} else {
|
} else {
|
||||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
|
fiber->data[tuplehead] = st
|
||||||
|
? make_struct_n(
|
||||||
|
fiber->data + tuplehead,
|
||||||
|
fiber->stacktop - tuplehead)
|
||||||
|
: janet_wrap_tuple(janet_tuple_n(
|
||||||
fiber->data + tuplehead,
|
fiber->data + tuplehead,
|
||||||
fiber->stacktop - tuplehead));
|
fiber->stacktop - tuplehead));
|
||||||
}
|
}
|
||||||
@@ -241,13 +272,6 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
janet_fiber_frame(fiber)->pc = func->def->bytecode;
|
janet_fiber_frame(fiber)->pc = func->def->bytecode;
|
||||||
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_TAILCALL;
|
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_TAILCALL;
|
||||||
|
|
||||||
/* Check strict arity AFTER getting fiber to valid state. */
|
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
|
||||||
if (func->def->arity != next_arity) {
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Good return */
|
/* Good return */
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -292,34 +316,55 @@ void janet_fiber_popframe(JanetFiber *fiber) {
|
|||||||
fiber->frame = frame->prevframe;
|
fiber->frame = frame->prevframe;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
JanetFiberStatus janet_fiber_status(JanetFiber *f) {
|
||||||
|
return ((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetFiber *janet_current_fiber(void) {
|
||||||
|
return janet_vm_fiber;
|
||||||
|
}
|
||||||
|
|
||||||
/* CFuns */
|
/* CFuns */
|
||||||
|
|
||||||
static int cfun_new(JanetArgs args) {
|
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
|
return fiber->env ?
|
||||||
|
janet_wrap_table(fiber->env) :
|
||||||
|
janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
|
if (janet_checktype(argv[1], JANET_NIL)) {
|
||||||
|
fiber->env = NULL;
|
||||||
|
} else {
|
||||||
|
fiber->env = janet_gettable(argv, 1);
|
||||||
|
}
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 2);
|
||||||
|
JanetFunction *func = janet_getfunction(argv, 0);
|
||||||
JanetFiber *fiber;
|
JanetFiber *fiber;
|
||||||
JanetFunction *func;
|
if (func->def->min_arity != 0) {
|
||||||
JANET_MINARITY(args, 1);
|
janet_panic("expected nullary function in fiber constructor");
|
||||||
JANET_MAXARITY(args, 2);
|
|
||||||
JANET_ARG_FUNCTION(func, args, 0);
|
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
|
||||||
if (func->def->arity != 0) {
|
|
||||||
JANET_THROW(args, "expected nullary function in fiber constructor");
|
|
||||||
}
|
}
|
||||||
}
|
fiber = janet_fiber(func, 64, 0, NULL);
|
||||||
fiber = janet_fiber(func, 64);
|
if (argc == 2) {
|
||||||
if (args.n == 2) {
|
int32_t i;
|
||||||
const uint8_t *flags;
|
JanetByteView view = janet_getbytes(argv, 1);
|
||||||
int32_t len, i;
|
|
||||||
JANET_ARG_BYTES(flags, len, args, 1);
|
|
||||||
fiber->flags = 0;
|
fiber->flags = 0;
|
||||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||||
for (i = 0; i < len; i++) {
|
for (i = 0; i < view.len; i++) {
|
||||||
if (flags[i] >= '0' && flags[i] <= '9') {
|
if (view.bytes[i] >= '0' && view.bytes[i] <= '9') {
|
||||||
fiber->flags |= JANET_FIBER_MASK_USERN(flags[i] - '0');
|
fiber->flags |= JANET_FIBER_MASK_USERN(view.bytes[i] - '0');
|
||||||
} else {
|
} else {
|
||||||
switch (flags[i]) {
|
switch (view.bytes[i]) {
|
||||||
default:
|
default:
|
||||||
JANET_THROW(args, "invalid flag, expected a, d, e, u, or y");
|
janet_panicf("invalid flag %c, expected a, d, e, u, or y", view.bytes[i]);
|
||||||
case ':':
|
|
||||||
break;
|
break;
|
||||||
case 'a':
|
case 'a':
|
||||||
fiber->flags |=
|
fiber->flags |=
|
||||||
@@ -340,143 +385,56 @@ static int cfun_new(JanetArgs args) {
|
|||||||
case 'y':
|
case 'y':
|
||||||
fiber->flags |= JANET_FIBER_MASK_YIELD;
|
fiber->flags |= JANET_FIBER_MASK_YIELD;
|
||||||
break;
|
break;
|
||||||
|
case 'i':
|
||||||
|
if (!janet_vm_fiber->env) {
|
||||||
|
janet_vm_fiber->env = janet_table(0);
|
||||||
|
}
|
||||||
|
fiber->env = janet_vm_fiber->env;
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
JANET_RETURN_FIBER(args, fiber);
|
return janet_wrap_fiber(fiber);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_status(JanetArgs args) {
|
static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
|
||||||
JanetFiber *fiber;
|
janet_fixarity(argc, 1);
|
||||||
const char *status = "";
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
JANET_FIXARITY(args, 1);
|
uint32_t s = janet_fiber_status(fiber);
|
||||||
JANET_ARG_FIBER(fiber, args, 0);
|
return janet_ckeywordv(janet_status_names[s]);
|
||||||
uint32_t s = (fiber->flags & JANET_FIBER_STATUS_MASK) >>
|
|
||||||
JANET_FIBER_STATUS_OFFSET;
|
|
||||||
switch (s) {
|
|
||||||
case JANET_STATUS_DEAD: status = ":dead"; break;
|
|
||||||
case JANET_STATUS_ERROR: status = ":error"; break;
|
|
||||||
case JANET_STATUS_DEBUG: status = ":debug"; break;
|
|
||||||
case JANET_STATUS_PENDING: status = ":pending"; break;
|
|
||||||
case JANET_STATUS_USER0: status = ":user0"; break;
|
|
||||||
case JANET_STATUS_USER1: status = ":user1"; break;
|
|
||||||
case JANET_STATUS_USER2: status = ":user2"; break;
|
|
||||||
case JANET_STATUS_USER3: status = ":user3"; break;
|
|
||||||
case JANET_STATUS_USER4: status = ":user4"; break;
|
|
||||||
case JANET_STATUS_USER5: status = ":user5"; break;
|
|
||||||
case JANET_STATUS_USER6: status = ":user6"; break;
|
|
||||||
case JANET_STATUS_USER7: status = ":user7"; break;
|
|
||||||
case JANET_STATUS_USER8: status = ":user8"; break;
|
|
||||||
case JANET_STATUS_USER9: status = ":user9"; break;
|
|
||||||
case JANET_STATUS_NEW: status = ":new"; break;
|
|
||||||
default:
|
|
||||||
case JANET_STATUS_ALIVE: status = ":alive"; break;
|
|
||||||
}
|
|
||||||
JANET_RETURN_CSYMBOL(args, status);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Extract info from one stack frame */
|
static Janet cfun_fiber_current(int32_t argc, Janet *argv) {
|
||||||
static Janet doframe(JanetStackFrame *frame) {
|
(void) argv;
|
||||||
int32_t off;
|
janet_fixarity(argc, 0);
|
||||||
JanetTable *t = janet_table(3);
|
return janet_wrap_fiber(janet_vm_fiber);
|
||||||
JanetFuncDef *def = NULL;
|
|
||||||
if (frame->func) {
|
|
||||||
janet_table_put(t, janet_csymbolv(":function"), janet_wrap_function(frame->func));
|
|
||||||
def = frame->func->def;
|
|
||||||
if (def->name) {
|
|
||||||
janet_table_put(t, janet_csymbolv(":name"), janet_wrap_string(def->name));
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
|
||||||
if (cfun) {
|
|
||||||
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
|
||||||
if (!janet_checktype(name, JANET_NIL)) {
|
|
||||||
janet_table_put(t, janet_csymbolv(":name"), name);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
janet_table_put(t, janet_csymbolv(":c"), janet_wrap_true());
|
|
||||||
}
|
|
||||||
if (frame->flags & JANET_STACKFRAME_TAILCALL) {
|
|
||||||
janet_table_put(t, janet_csymbolv(":tail"), janet_wrap_true());
|
|
||||||
}
|
|
||||||
if (frame->func && frame->pc) {
|
|
||||||
off = (int32_t) (frame->pc - def->bytecode);
|
|
||||||
janet_table_put(t, janet_csymbolv(":pc"), janet_wrap_integer(off));
|
|
||||||
if (def->sourcemap) {
|
|
||||||
JanetSourceMapping mapping = def->sourcemap[off];
|
|
||||||
janet_table_put(t, janet_csymbolv(":line"), janet_wrap_integer(mapping.line));
|
|
||||||
janet_table_put(t, janet_csymbolv(":column"), janet_wrap_integer(mapping.column));
|
|
||||||
}
|
|
||||||
if (def->source) {
|
|
||||||
janet_table_put(t, janet_csymbolv(":source"), janet_wrap_string(def->source));
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return janet_wrap_table(t);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_stack(JanetArgs args) {
|
static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) {
|
||||||
JanetFiber *fiber;
|
janet_fixarity(argc, 1);
|
||||||
JanetArray *array;
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
JANET_FIXARITY(args, 1);
|
return janet_wrap_integer(fiber->maxstack);
|
||||||
JANET_ARG_FIBER(fiber, args, 0);
|
|
||||||
array = janet_array(0);
|
|
||||||
{
|
|
||||||
int32_t i = fiber->frame;
|
|
||||||
JanetStackFrame *frame;
|
|
||||||
while (i > 0) {
|
|
||||||
frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
|
||||||
janet_array_push(array, doframe(frame));
|
|
||||||
i = frame->prevframe;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
JANET_RETURN_ARRAY(args, array);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_current(JanetArgs args) {
|
static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
|
||||||
JANET_FIXARITY(args, 0);
|
janet_fixarity(argc, 2);
|
||||||
JANET_RETURN_FIBER(args, janet_vm_fiber);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
}
|
int32_t maxs = janet_getinteger(argv, 1);
|
||||||
|
|
||||||
static int cfun_lineage(JanetArgs args) {
|
|
||||||
JanetFiber *fiber;
|
|
||||||
JanetArray *array;
|
|
||||||
JANET_FIXARITY(args, 1);
|
|
||||||
JANET_ARG_FIBER(fiber, args, 0);
|
|
||||||
array = janet_array(0);
|
|
||||||
while (fiber) {
|
|
||||||
janet_array_push(array, janet_wrap_fiber(fiber));
|
|
||||||
fiber = fiber->child;
|
|
||||||
}
|
|
||||||
JANET_RETURN_ARRAY(args, array);
|
|
||||||
}
|
|
||||||
|
|
||||||
static int cfun_maxstack(JanetArgs args) {
|
|
||||||
JanetFiber *fiber;
|
|
||||||
JANET_FIXARITY(args, 1);
|
|
||||||
JANET_ARG_FIBER(fiber, args, 0);
|
|
||||||
JANET_RETURN_INTEGER(args, fiber->maxstack);
|
|
||||||
}
|
|
||||||
|
|
||||||
static int cfun_setmaxstack(JanetArgs args) {
|
|
||||||
JanetFiber *fiber;
|
|
||||||
int32_t maxs;
|
|
||||||
JANET_FIXARITY(args, 2);
|
|
||||||
JANET_ARG_FIBER(fiber, args, 0);
|
|
||||||
JANET_ARG_INTEGER(maxs, args, 1);
|
|
||||||
if (maxs < 0) {
|
if (maxs < 0) {
|
||||||
JANET_THROW(args, "expected positive integer");
|
janet_panic("expected positive integer");
|
||||||
}
|
}
|
||||||
fiber->maxstack = maxs;
|
fiber->maxstack = maxs;
|
||||||
JANET_RETURN_FIBER(args, fiber);
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetReg fiber_cfuns[] = {
|
||||||
{"fiber/new", cfun_new,
|
{
|
||||||
"(fiber/new func [,sigmask])\n\n"
|
"fiber/new", cfun_fiber_new,
|
||||||
|
JDOC("(fiber/new func [,sigmask])\n\n"
|
||||||
"Create a new fiber with function body func. Can optionally "
|
"Create a new fiber with function body func. Can optionally "
|
||||||
"take a set of signals to block from the current parent fiber "
|
"take a set of signals to block from the current parent fiber "
|
||||||
"when called. The mask is specified as symbol where each character "
|
"when called. The mask is specified as a keyword where each character "
|
||||||
"is used to indicate a signal to block. The default sigmask is :y. "
|
"is used to indicate a signal to block. The default sigmask is :y. "
|
||||||
"For example, \n\n"
|
"For example, \n\n"
|
||||||
"\t(fiber/new myfun :e123)\n\n"
|
"\t(fiber/new myfun :e123)\n\n"
|
||||||
@@ -487,10 +445,12 @@ static const JanetReg cfuns[] = {
|
|||||||
"\te - block error signals\n"
|
"\te - block error signals\n"
|
||||||
"\tu - block user signals\n"
|
"\tu - block user signals\n"
|
||||||
"\ty - block yield signals\n"
|
"\ty - block yield signals\n"
|
||||||
"\t0-9 - block a specific user signal"
|
"\t0-9 - block a specific user signal\n"
|
||||||
|
"\ti - inherit the environment from the current fiber (not related to signals)")
|
||||||
},
|
},
|
||||||
{"fiber/status", cfun_status,
|
{
|
||||||
"(fiber/status fib)\n\n"
|
"fiber/status", cfun_fiber_status,
|
||||||
|
JDOC("(fiber/status fib)\n\n"
|
||||||
"Get the status of a fiber. The status will be one of:\n\n"
|
"Get the status of a fiber. The status will be one of:\n\n"
|
||||||
"\t:dead - the fiber has finished\n"
|
"\t:dead - the fiber has finished\n"
|
||||||
"\t:error - the fiber has errored out\n"
|
"\t:error - the fiber has errored out\n"
|
||||||
@@ -498,51 +458,42 @@ static const JanetReg cfuns[] = {
|
|||||||
"\t:pending - the fiber has been yielded\n"
|
"\t:pending - the fiber has been yielded\n"
|
||||||
"\t:user(0-9) - the fiber is suspended by a user signal\n"
|
"\t:user(0-9) - the fiber is suspended by a user signal\n"
|
||||||
"\t:alive - the fiber is currently running and cannot be resumed\n"
|
"\t:alive - the fiber is currently running and cannot be resumed\n"
|
||||||
"\t:new - the fiber has just been created and not yet run"
|
"\t:new - the fiber has just been created and not yet run")
|
||||||
},
|
},
|
||||||
{"fiber/stack", cfun_stack,
|
{
|
||||||
"(fiber/stack fib)\n\n"
|
"fiber/current", cfun_fiber_current,
|
||||||
"Gets information about the stack as an array of tables. Each table "
|
JDOC("(fiber/current)\n\n"
|
||||||
"in the array contains information about a stack frame. The top most, current "
|
"Returns the currently running fiber.")
|
||||||
"stack frame is the first table in the array, and the bottom most stack frame "
|
|
||||||
"is the last value. Each stack frame contains some of the following attributes:\n\n"
|
|
||||||
"\t:c - true if the stack frame is a c function invokation\n"
|
|
||||||
"\t:column - the current source column of the stack frame\n"
|
|
||||||
"\t:function - the function that the stack frame represents\n"
|
|
||||||
"\t:line - the current source line of the stack frame\n"
|
|
||||||
"\t:name - the human friendly name of the function\n"
|
|
||||||
"\t:pc - integer indicating the location of the program counter\n"
|
|
||||||
"\t:source - string with filename or other identifier for the source code\n"
|
|
||||||
"\t:tail - boolean indicating a tail call"
|
|
||||||
},
|
},
|
||||||
{"fiber/current", cfun_current,
|
{
|
||||||
"(fiber/current)\n\n"
|
"fiber/maxstack", cfun_fiber_maxstack,
|
||||||
"Returns the currently running fiber."
|
JDOC("(fiber/maxstack fib)\n\n"
|
||||||
},
|
|
||||||
{"fiber/lineage", cfun_lineage,
|
|
||||||
"(fiber/lineage fib)\n\n"
|
|
||||||
"Returns an array of all child fibers from a root fiber. This function "
|
|
||||||
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
|
|
||||||
"the fiber handling the error can see which fiber raised the signal. This function should "
|
|
||||||
"be used mostly for debugging purposes."
|
|
||||||
},
|
|
||||||
{"fiber/maxstack", cfun_maxstack,
|
|
||||||
"(fiber/maxstack fib)\n\n"
|
|
||||||
"Gets the maximum stack size in janet values allowed for a fiber. While memory for "
|
"Gets the maximum stack size in janet values allowed for a fiber. While memory for "
|
||||||
"the fiber's stack is not allocated up front, the fiber will not allocated more "
|
"the fiber's stack is not allocated up front, the fiber will not allocated more "
|
||||||
"than this amount and will throw a stackoverflow error if more memory is needed. "
|
"than this amount and will throw a stack-overflow error if more memory is needed. ")
|
||||||
},
|
},
|
||||||
{"fiber/setmaxstack", cfun_setmaxstack,
|
{
|
||||||
"(fiber/setmaxstack fib maxstack)\n\n"
|
"fiber/setmaxstack", cfun_fiber_setmaxstack,
|
||||||
|
JDOC("(fiber/setmaxstack fib maxstack)\n\n"
|
||||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||||
"maximum stacksize is usually 8192."
|
"maximum stack size is usually 8192.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"fiber/getenv", cfun_fiber_getenv,
|
||||||
|
JDOC("(fiber/getenv fiber)\n\n"
|
||||||
|
"Gets the environment for a fiber. Returns nil if no such table is "
|
||||||
|
"set yet.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"fiber/setenv", cfun_fiber_setenv,
|
||||||
|
JDOC("(fiber/setenv fiber table)\n\n"
|
||||||
|
"Sets the environment table for a fiber. Set to nil to remove the current "
|
||||||
|
"environment.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
int janet_lib_fiber(JanetArgs args) {
|
void janet_lib_fiber(JanetTable *env) {
|
||||||
JanetTable *env = janet_env(args);
|
janet_core_cfuns(env, NULL, fiber_cfuns);
|
||||||
janet_cfuns(env, NULL, cfuns);
|
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -23,7 +23,9 @@
|
|||||||
#ifndef JANET_FIBER_H_defined
|
#ifndef JANET_FIBER_H_defined
|
||||||
#define JANET_FIBER_H_defined
|
#define JANET_FIBER_H_defined
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||||
|
|
||||||
|
|||||||
149
src/core/gc.c
149
src/core/gc.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,10 +20,13 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "symcache.h"
|
#include "symcache.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* GC State */
|
/* GC State */
|
||||||
JANET_THREAD_LOCAL void *janet_vm_blocks;
|
JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||||
@@ -58,17 +61,37 @@ void janet_mark(Janet x) {
|
|||||||
if (depth) {
|
if (depth) {
|
||||||
depth--;
|
depth--;
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
default: break;
|
default:
|
||||||
|
break;
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
case JANET_SYMBOL: janet_mark_string(janet_unwrap_string(x)); break;
|
case JANET_KEYWORD:
|
||||||
case JANET_FUNCTION: janet_mark_function(janet_unwrap_function(x)); break;
|
case JANET_SYMBOL:
|
||||||
case JANET_ARRAY: janet_mark_array(janet_unwrap_array(x)); break;
|
janet_mark_string(janet_unwrap_string(x));
|
||||||
case JANET_TABLE: janet_mark_table(janet_unwrap_table(x)); break;
|
break;
|
||||||
case JANET_STRUCT: janet_mark_struct(janet_unwrap_struct(x)); break;
|
case JANET_FUNCTION:
|
||||||
case JANET_TUPLE: janet_mark_tuple(janet_unwrap_tuple(x)); break;
|
janet_mark_function(janet_unwrap_function(x));
|
||||||
case JANET_BUFFER: janet_mark_buffer(janet_unwrap_buffer(x)); break;
|
break;
|
||||||
case JANET_FIBER: janet_mark_fiber(janet_unwrap_fiber(x)); break;
|
case JANET_ARRAY:
|
||||||
case JANET_ABSTRACT: janet_mark_abstract(janet_unwrap_abstract(x)); break;
|
janet_mark_array(janet_unwrap_array(x));
|
||||||
|
break;
|
||||||
|
case JANET_TABLE:
|
||||||
|
janet_mark_table(janet_unwrap_table(x));
|
||||||
|
break;
|
||||||
|
case JANET_STRUCT:
|
||||||
|
janet_mark_struct(janet_unwrap_struct(x));
|
||||||
|
break;
|
||||||
|
case JANET_TUPLE:
|
||||||
|
janet_mark_tuple(janet_unwrap_tuple(x));
|
||||||
|
break;
|
||||||
|
case JANET_BUFFER:
|
||||||
|
janet_mark_buffer(janet_unwrap_buffer(x));
|
||||||
|
break;
|
||||||
|
case JANET_FIBER:
|
||||||
|
janet_mark_fiber(janet_unwrap_fiber(x));
|
||||||
|
break;
|
||||||
|
case JANET_ABSTRACT:
|
||||||
|
janet_mark_abstract(janet_unwrap_abstract(x));
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
depth++;
|
depth++;
|
||||||
} else {
|
} else {
|
||||||
@@ -77,7 +100,7 @@ void janet_mark(Janet x) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_string(const uint8_t *str) {
|
static void janet_mark_string(const uint8_t *str) {
|
||||||
janet_gc_mark(janet_string_raw(str));
|
janet_gc_mark(janet_string_head(str));
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_buffer(JanetBuffer *buffer) {
|
static void janet_mark_buffer(JanetBuffer *buffer) {
|
||||||
@@ -85,11 +108,11 @@ static void janet_mark_buffer(JanetBuffer *buffer) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_abstract(void *adata) {
|
static void janet_mark_abstract(void *adata) {
|
||||||
if (janet_gc_reachable(janet_abstract_header(adata)))
|
if (janet_gc_reachable(janet_abstract_head(adata)))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(janet_abstract_header(adata));
|
janet_gc_mark(janet_abstract_head(adata));
|
||||||
if (janet_abstract_header(adata)->type->gcmark) {
|
if (janet_abstract_head(adata)->type->gcmark) {
|
||||||
janet_abstract_header(adata)->type->gcmark(adata, janet_abstract_size(adata));
|
janet_abstract_head(adata)->type->gcmark(adata, janet_abstract_size(adata));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -120,7 +143,7 @@ static void janet_mark_array(JanetArray *array) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_table(JanetTable *table) {
|
static void janet_mark_table(JanetTable *table) {
|
||||||
recur: /* Manual tail recursion */
|
recur: /* Manual tail recursion */
|
||||||
if (janet_gc_reachable(table))
|
if (janet_gc_reachable(table))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(table);
|
janet_gc_mark(table);
|
||||||
@@ -132,16 +155,16 @@ static void janet_mark_table(JanetTable *table) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_struct(const JanetKV *st) {
|
static void janet_mark_struct(const JanetKV *st) {
|
||||||
if (janet_gc_reachable(janet_struct_raw(st)))
|
if (janet_gc_reachable(janet_struct_head(st)))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(janet_struct_raw(st));
|
janet_gc_mark(janet_struct_head(st));
|
||||||
janet_mark_kvs(st, janet_struct_capacity(st));
|
janet_mark_kvs(st, janet_struct_capacity(st));
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_tuple(const Janet *tuple) {
|
static void janet_mark_tuple(const Janet *tuple) {
|
||||||
if (janet_gc_reachable(janet_tuple_raw(tuple)))
|
if (janet_gc_reachable(janet_tuple_head(tuple)))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(janet_tuple_raw(tuple));
|
janet_gc_mark(janet_tuple_head(tuple));
|
||||||
janet_mark_many(tuple, janet_tuple_length(tuple));
|
janet_mark_many(tuple, janet_tuple_length(tuple));
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -195,6 +218,11 @@ recur:
|
|||||||
if (janet_gc_reachable(fiber))
|
if (janet_gc_reachable(fiber))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(fiber);
|
janet_gc_mark(fiber);
|
||||||
|
|
||||||
|
/* Mark values on the argument stack */
|
||||||
|
janet_mark_many(fiber->data + fiber->stackstart,
|
||||||
|
fiber->stacktop - fiber->stackstart);
|
||||||
|
|
||||||
i = fiber->frame;
|
i = fiber->frame;
|
||||||
j = fiber->stackstart - JANET_FRAME_SIZE;
|
j = fiber->stackstart - JANET_FRAME_SIZE;
|
||||||
while (i > 0) {
|
while (i > 0) {
|
||||||
@@ -209,6 +237,9 @@ recur:
|
|||||||
i = frame->prevframe;
|
i = frame->prevframe;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if (fiber->env)
|
||||||
|
janet_mark_table(fiber->env);
|
||||||
|
|
||||||
/* Explicit tail recursion */
|
/* Explicit tail recursion */
|
||||||
if (fiber->child) {
|
if (fiber->child) {
|
||||||
fiber = fiber->child;
|
fiber = fiber->child;
|
||||||
@@ -217,21 +248,19 @@ recur:
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Deinitialize a block of memory */
|
/* Deinitialize a block of memory */
|
||||||
static void janet_deinit_block(JanetGCMemoryHeader *block) {
|
static void janet_deinit_block(JanetGCObject *mem) {
|
||||||
void *mem = ((char *)(block + 1));
|
switch (mem->flags & JANET_MEM_TYPEBITS) {
|
||||||
JanetAbstractHeader *h = (JanetAbstractHeader *)mem;
|
|
||||||
switch (block->flags & JANET_MEM_TYPEBITS) {
|
|
||||||
default:
|
default:
|
||||||
case JANET_MEMORY_FUNCTION:
|
case JANET_MEMORY_FUNCTION:
|
||||||
break; /* Do nothing for non gc types */
|
break; /* Do nothing for non gc types */
|
||||||
case JANET_MEMORY_SYMBOL:
|
case JANET_MEMORY_SYMBOL:
|
||||||
janet_symbol_deinit((const uint8_t *)mem + 2 * sizeof(int32_t));
|
janet_symbol_deinit(((JanetStringHead *) mem)->data);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_ARRAY:
|
case JANET_MEMORY_ARRAY:
|
||||||
janet_array_deinit((JanetArray*) mem);
|
janet_array_deinit((JanetArray *) mem);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_TABLE:
|
case JANET_MEMORY_TABLE:
|
||||||
janet_table_deinit((JanetTable*) mem);
|
janet_table_deinit((JanetTable *) mem);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_FIBER:
|
case JANET_MEMORY_FIBER:
|
||||||
free(((JanetFiber *)mem)->data);
|
free(((JanetFiber *)mem)->data);
|
||||||
@@ -239,20 +268,20 @@ static void janet_deinit_block(JanetGCMemoryHeader *block) {
|
|||||||
case JANET_MEMORY_BUFFER:
|
case JANET_MEMORY_BUFFER:
|
||||||
janet_buffer_deinit((JanetBuffer *) mem);
|
janet_buffer_deinit((JanetBuffer *) mem);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_ABSTRACT:
|
case JANET_MEMORY_ABSTRACT: {
|
||||||
if (h->type->gc) {
|
JanetAbstractHead *head = (JanetAbstractHead *)mem;
|
||||||
janet_assert(!h->type->gc((void *)(h + 1), h->size), "finalizer failed");
|
if (head->type->gc) {
|
||||||
|
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||||
|
}
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_FUNCENV:
|
case JANET_MEMORY_FUNCENV: {
|
||||||
{
|
|
||||||
JanetFuncEnv *env = (JanetFuncEnv *)mem;
|
JanetFuncEnv *env = (JanetFuncEnv *)mem;
|
||||||
if (0 == env->offset)
|
if (0 == env->offset)
|
||||||
free(env->as.values);
|
free(env->as.values);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_FUNCDEF:
|
case JANET_MEMORY_FUNCDEF: {
|
||||||
{
|
|
||||||
JanetFuncDef *def = (JanetFuncDef *)mem;
|
JanetFuncDef *def = (JanetFuncDef *)mem;
|
||||||
/* TODO - get this all with one alloc and one free */
|
/* TODO - get this all with one alloc and one free */
|
||||||
free(def->defs);
|
free(def->defs);
|
||||||
@@ -268,9 +297,9 @@ static void janet_deinit_block(JanetGCMemoryHeader *block) {
|
|||||||
/* Iterate over all allocated memory, and free memory that is not
|
/* Iterate over all allocated memory, and free memory that is not
|
||||||
* marked as reachable. Flip the gc color flag for next sweep. */
|
* marked as reachable. Flip the gc color flag for next sweep. */
|
||||||
void janet_sweep() {
|
void janet_sweep() {
|
||||||
JanetGCMemoryHeader *previous = NULL;
|
JanetGCObject *previous = NULL;
|
||||||
JanetGCMemoryHeader *current = janet_vm_blocks;
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
JanetGCMemoryHeader *next;
|
JanetGCObject *next;
|
||||||
while (NULL != current) {
|
while (NULL != current) {
|
||||||
next = current->next;
|
next = current->next;
|
||||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
||||||
@@ -291,29 +320,26 @@ void janet_sweep() {
|
|||||||
|
|
||||||
/* Allocate some memory that is tracked for garbage collection */
|
/* Allocate some memory that is tracked for garbage collection */
|
||||||
void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||||
JanetGCMemoryHeader *mdata;
|
JanetGCObject *mem;
|
||||||
size_t total = size + sizeof(JanetGCMemoryHeader);
|
|
||||||
|
|
||||||
/* Make sure everything is inited */
|
/* Make sure everything is inited */
|
||||||
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
|
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
|
||||||
void *mem = malloc(total);
|
mem = malloc(size);
|
||||||
|
|
||||||
/* Check for bad malloc */
|
/* Check for bad malloc */
|
||||||
if (NULL == mem) {
|
if (NULL == mem) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
|
|
||||||
mdata = (JanetGCMemoryHeader *)mem;
|
|
||||||
|
|
||||||
/* Configure block */
|
/* Configure block */
|
||||||
mdata->flags = type;
|
mem->flags = type;
|
||||||
|
|
||||||
/* Prepend block to heap list */
|
/* Prepend block to heap list */
|
||||||
janet_vm_next_collection += (int32_t) size;
|
janet_vm_next_collection += (int32_t) size;
|
||||||
mdata->next = janet_vm_blocks;
|
mem->next = janet_vm_blocks;
|
||||||
janet_vm_blocks = mdata;
|
janet_vm_blocks = mem;
|
||||||
|
|
||||||
return (char *) mem + sizeof(JanetGCMemoryHeader);
|
return (void *)mem;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Run garbage collection */
|
/* Run garbage collection */
|
||||||
@@ -354,14 +380,11 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
|
|||||||
if (janet_type(lhs) != janet_type(rhs))
|
if (janet_type(lhs) != janet_type(rhs))
|
||||||
return 0;
|
return 0;
|
||||||
switch (janet_type(lhs)) {
|
switch (janet_type(lhs)) {
|
||||||
case JANET_TRUE:
|
case JANET_BOOLEAN:
|
||||||
case JANET_FALSE:
|
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
|
case JANET_NUMBER:
|
||||||
|
/* These values don't really matter to the gc so returning 1 all the time is fine. */
|
||||||
return 1;
|
return 1;
|
||||||
case JANET_INTEGER:
|
|
||||||
return janet_unwrap_integer(lhs) == janet_unwrap_integer(rhs);
|
|
||||||
case JANET_REAL:
|
|
||||||
return janet_unwrap_real(lhs) == janet_unwrap_real(rhs);
|
|
||||||
default:
|
default:
|
||||||
return janet_unwrap_pointer(lhs) == janet_unwrap_pointer(rhs);
|
return janet_unwrap_pointer(lhs) == janet_unwrap_pointer(rhs);
|
||||||
}
|
}
|
||||||
@@ -371,9 +394,8 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
|
|||||||
* a value and all its children. */
|
* a value and all its children. */
|
||||||
int janet_gcunroot(Janet root) {
|
int janet_gcunroot(Janet root) {
|
||||||
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
||||||
Janet *v = janet_vm_roots;
|
|
||||||
/* Search from top to bottom as access is most likely LIFO */
|
/* Search from top to bottom as access is most likely LIFO */
|
||||||
for (v = janet_vm_roots; v < vtop; v++) {
|
for (Janet *v = janet_vm_roots; v < vtop; v++) {
|
||||||
if (janet_gc_idequals(root, *v)) {
|
if (janet_gc_idequals(root, *v)) {
|
||||||
*v = janet_vm_roots[--janet_vm_root_count];
|
*v = janet_vm_roots[--janet_vm_root_count];
|
||||||
return 1;
|
return 1;
|
||||||
@@ -385,10 +407,9 @@ int janet_gcunroot(Janet root) {
|
|||||||
/* Remove a root value from the GC. This sets the effective reference count to 0. */
|
/* Remove a root value from the GC. This sets the effective reference count to 0. */
|
||||||
int janet_gcunrootall(Janet root) {
|
int janet_gcunrootall(Janet root) {
|
||||||
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
||||||
Janet *v = janet_vm_roots;
|
|
||||||
int ret = 0;
|
int ret = 0;
|
||||||
/* Search from top to bottom as access is most likely LIFO */
|
/* Search from top to bottom as access is most likely LIFO */
|
||||||
for (v = janet_vm_roots; v < vtop; v++) {
|
for (Janet *v = janet_vm_roots; v < vtop; v++) {
|
||||||
if (janet_gc_idequals(root, *v)) {
|
if (janet_gc_idequals(root, *v)) {
|
||||||
*v = janet_vm_roots[--janet_vm_root_count];
|
*v = janet_vm_roots[--janet_vm_root_count];
|
||||||
vtop--;
|
vtop--;
|
||||||
@@ -400,10 +421,10 @@ int janet_gcunrootall(Janet root) {
|
|||||||
|
|
||||||
/* Free all allocated memory */
|
/* Free all allocated memory */
|
||||||
void janet_clear_memory(void) {
|
void janet_clear_memory(void) {
|
||||||
JanetGCMemoryHeader *current = janet_vm_blocks;
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
while (NULL != current) {
|
while (NULL != current) {
|
||||||
janet_deinit_block(current);
|
janet_deinit_block(current);
|
||||||
JanetGCMemoryHeader *next = current->next;
|
JanetGCObject *next = current->next;
|
||||||
free(current);
|
free(current);
|
||||||
current = next;
|
current = next;
|
||||||
}
|
}
|
||||||
@@ -411,5 +432,9 @@ void janet_clear_memory(void) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Primitives for suspending GC. */
|
/* Primitives for suspending GC. */
|
||||||
int janet_gclock(void) { return janet_vm_gc_suspend++; }
|
int janet_gclock(void) {
|
||||||
void janet_gcunlock(int handle) { janet_vm_gc_suspend = handle; }
|
return janet_vm_gc_suspend++;
|
||||||
|
}
|
||||||
|
void janet_gcunlock(int handle) {
|
||||||
|
janet_vm_gc_suspend = handle;
|
||||||
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -23,10 +23,12 @@
|
|||||||
#ifndef JANET_GC_H
|
#ifndef JANET_GC_H
|
||||||
#define JANET_GC_H
|
#define JANET_GC_H
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/* The metadata header associated with an allocated block of memory */
|
/* The metadata header associated with an allocated block of memory */
|
||||||
#define janet_gc_header(mem) ((JanetGCMemoryHeader *)(mem) - 1)
|
#define janet_gc_header(mem) ((JanetGCObject *)(mem))
|
||||||
|
|
||||||
#define JANET_MEM_TYPEBITS 0xFF
|
#define JANET_MEM_TYPEBITS 0xFF
|
||||||
#define JANET_MEM_REACHABLE 0x100
|
#define JANET_MEM_REACHABLE 0x100
|
||||||
@@ -36,16 +38,8 @@
|
|||||||
#define janet_gc_type(m) (janet_gc_header(m)->flags & 0xFF)
|
#define janet_gc_type(m) (janet_gc_header(m)->flags & 0xFF)
|
||||||
|
|
||||||
#define janet_gc_mark(m) (janet_gc_header(m)->flags |= JANET_MEM_REACHABLE)
|
#define janet_gc_mark(m) (janet_gc_header(m)->flags |= JANET_MEM_REACHABLE)
|
||||||
#define janet_gc_unmark(m) (janet_gc_header(m)->flags &= ~JANET_MEM_COLOR)
|
|
||||||
#define janet_gc_reachable(m) (janet_gc_header(m)->flags & JANET_MEM_REACHABLE)
|
#define janet_gc_reachable(m) (janet_gc_header(m)->flags & JANET_MEM_REACHABLE)
|
||||||
|
|
||||||
/* Memory header struct. Node of a linked list of memory blocks. */
|
|
||||||
typedef struct JanetGCMemoryHeader JanetGCMemoryHeader;
|
|
||||||
struct JanetGCMemoryHeader {
|
|
||||||
JanetGCMemoryHeader *next;
|
|
||||||
uint32_t flags;
|
|
||||||
};
|
|
||||||
|
|
||||||
/* Memory types for the GC. Different from JanetType to include funcenv and funcdef. */
|
/* Memory types for the GC. Different from JanetType to include funcenv and funcdef. */
|
||||||
enum JanetMemoryType {
|
enum JanetMemoryType {
|
||||||
JANET_MEMORY_NONE,
|
JANET_MEMORY_NONE,
|
||||||
|
|||||||
386
src/core/inttypes.c
Normal file
386
src/core/inttypes.c
Normal file
@@ -0,0 +1,386 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 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.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include <errno.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
#include <limits.h>
|
||||||
|
#include <inttypes.h>
|
||||||
|
#include <math.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Conditional compilation */
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
|
||||||
|
#define MAX_INT_IN_DBL 9007199254740992ULL /* 2^53 */
|
||||||
|
|
||||||
|
static Janet it_s64_get(void *p, Janet key);
|
||||||
|
static Janet it_u64_get(void *p, Janet key);
|
||||||
|
|
||||||
|
static void int64_marshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
janet_marshal_int64(ctx, *((int64_t *)p));
|
||||||
|
}
|
||||||
|
|
||||||
|
static void int64_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
*((int64_t *)p) = janet_unmarshal_int64(ctx);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
|
||||||
|
char str[32];
|
||||||
|
sprintf(str, "<core/s64 %" PRId64 ">", *((int64_t *)p));
|
||||||
|
janet_buffer_push_cstring(buffer, str);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
|
||||||
|
char str[32];
|
||||||
|
sprintf(str, "<core/u64 %" PRIu64 ">", *((uint64_t *)p));
|
||||||
|
janet_buffer_push_cstring(buffer, str);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetAbstractType it_s64_type = {
|
||||||
|
"core/s64",
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
it_s64_get,
|
||||||
|
NULL,
|
||||||
|
int64_marshal,
|
||||||
|
int64_unmarshal,
|
||||||
|
it_s64_tostring
|
||||||
|
};
|
||||||
|
|
||||||
|
static const JanetAbstractType it_u64_type = {
|
||||||
|
"core/u64",
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
it_u64_get,
|
||||||
|
NULL,
|
||||||
|
int64_marshal,
|
||||||
|
int64_unmarshal,
|
||||||
|
it_u64_tostring
|
||||||
|
};
|
||||||
|
|
||||||
|
int64_t janet_unwrap_s64(Janet x) {
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
default:
|
||||||
|
break;
|
||||||
|
case JANET_NUMBER : {
|
||||||
|
double dbl = janet_unwrap_number(x);
|
||||||
|
if (fabs(dbl) <= MAX_INT_IN_DBL)
|
||||||
|
return (int64_t)dbl;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_STRING: {
|
||||||
|
int64_t value;
|
||||||
|
const uint8_t *str = janet_unwrap_string(x);
|
||||||
|
if (janet_scan_int64(str, janet_string_length(str), &value))
|
||||||
|
return value;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
void *abst = janet_unwrap_abstract(x);
|
||||||
|
if (janet_abstract_type(abst) == &it_s64_type ||
|
||||||
|
(janet_abstract_type(abst) == &it_u64_type))
|
||||||
|
return *(int64_t *)abst;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_panic("bad s64 initializer");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint64_t janet_unwrap_u64(Janet x) {
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
default:
|
||||||
|
break;
|
||||||
|
case JANET_NUMBER : {
|
||||||
|
double dbl = janet_unwrap_number(x);
|
||||||
|
if ((dbl >= 0) && (dbl <= MAX_INT_IN_DBL))
|
||||||
|
return (uint64_t)dbl;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_STRING: {
|
||||||
|
uint64_t value;
|
||||||
|
const uint8_t *str = janet_unwrap_string(x);
|
||||||
|
if (janet_scan_uint64(str, janet_string_length(str), &value))
|
||||||
|
return value;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
void *abst = janet_unwrap_abstract(x);
|
||||||
|
if (janet_abstract_type(abst) == &it_s64_type ||
|
||||||
|
(janet_abstract_type(abst) == &it_u64_type))
|
||||||
|
return *(uint64_t *)abst;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_panic("bad u64 initializer");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
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 :
|
||||||
|
JANET_INT_NONE);
|
||||||
|
}
|
||||||
|
|
||||||
|
Janet janet_wrap_s64(int64_t x) {
|
||||||
|
int64_t *box = janet_abstract(&it_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));
|
||||||
|
*box = (uint64_t)x;
|
||||||
|
return janet_wrap_abstract(box);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_it_s64_new(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
||||||
|
}
|
||||||
|
|
||||||
|
#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)); \
|
||||||
|
*box = janet_unwrap_##type(argv[0]); \
|
||||||
|
for (int 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]); \
|
||||||
|
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)); \
|
||||||
|
*box = janet_unwrap_##type(argv[0]); \
|
||||||
|
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; \
|
||||||
|
} \
|
||||||
|
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; \
|
||||||
|
} \
|
||||||
|
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)); \
|
||||||
|
*box = janet_unwrap_##type(argv[0]); \
|
||||||
|
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; \
|
||||||
|
} \
|
||||||
|
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; \
|
||||||
|
} \
|
||||||
|
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); \
|
||||||
|
}
|
||||||
|
|
||||||
|
OPMETHOD(int64_t, s64, add, +)
|
||||||
|
OPMETHOD(int64_t, s64, sub, -)
|
||||||
|
OPMETHOD(int64_t, s64, mul, *)
|
||||||
|
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
||||||
|
DIVMETHOD_SIGNED(int64_t, s64, mod, %)
|
||||||
|
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, -)
|
||||||
|
OPMETHOD(uint64_t, u64, mul, *)
|
||||||
|
DIVMETHOD(uint64_t, u64, div, /)
|
||||||
|
DIVMETHOD(uint64_t, u64, mod, %)
|
||||||
|
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},
|
||||||
|
{"-", cfun_it_s64_sub},
|
||||||
|
{"*", 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},
|
||||||
|
{"&", cfun_it_s64_and},
|
||||||
|
{"|", cfun_it_s64_or},
|
||||||
|
{"^", 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},
|
||||||
|
|
||||||
|
{NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
static JanetMethod it_u64_methods[] = {
|
||||||
|
{"+", cfun_it_u64_add},
|
||||||
|
{"-", cfun_it_u64_sub},
|
||||||
|
{"*", cfun_it_u64_mul},
|
||||||
|
{"/", cfun_it_u64_div},
|
||||||
|
{"%", 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},
|
||||||
|
{"&", cfun_it_u64_and},
|
||||||
|
{"|", cfun_it_u64_or},
|
||||||
|
{"^", 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},
|
||||||
|
|
||||||
|
{NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
static Janet it_s64_get(void *p, Janet key) {
|
||||||
|
(void) p;
|
||||||
|
if (!janet_checktype(key, JANET_KEYWORD))
|
||||||
|
janet_panicf("expected keyword, got %v", key);
|
||||||
|
return janet_getmethod(janet_unwrap_keyword(key), it_s64_methods);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet it_u64_get(void *p, Janet key) {
|
||||||
|
(void) p;
|
||||||
|
if (!janet_checktype(key, JANET_KEYWORD))
|
||||||
|
janet_panicf("expected keyword, got %v", key);
|
||||||
|
return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg it_cfuns[] = {
|
||||||
|
{
|
||||||
|
"int/s64", cfun_it_s64_new,
|
||||||
|
JDOC("(int/s64 value)\n\n"
|
||||||
|
"Create a boxed signed 64 bit integer from a string value.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"int/u64", cfun_it_u64_new,
|
||||||
|
JDOC("(int/u64 value)\n\n"
|
||||||
|
"Create a boxed unsigned 64 bit integer from a string value.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
/* 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);
|
||||||
|
}
|
||||||
|
|
||||||
|
#endif
|
||||||
476
src/core/io.c
476
src/core/io.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -25,9 +25,13 @@
|
|||||||
#define _BSD_SOURCE
|
#define _BSD_SOURCE
|
||||||
|
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
#include <janet/janet.h>
|
|
||||||
#include <errno.h>
|
#include <errno.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
#define IO_WRITE 1
|
#define IO_WRITE 1
|
||||||
#define IO_READ 2
|
#define IO_READ 2
|
||||||
#define IO_APPEND 4
|
#define IO_APPEND 4
|
||||||
@@ -44,22 +48,31 @@ struct IOFile {
|
|||||||
int flags;
|
int flags;
|
||||||
};
|
};
|
||||||
|
|
||||||
static int janet_io_gc(void *p, size_t len);
|
static int cfun_io_gc(void *p, size_t len);
|
||||||
|
static Janet io_file_get(void *p, Janet);
|
||||||
|
|
||||||
JanetAbstractType janet_io_filetype = {
|
JanetAbstractType cfun_io_filetype = {
|
||||||
":core.file",
|
"core/file",
|
||||||
janet_io_gc,
|
cfun_io_gc,
|
||||||
|
NULL,
|
||||||
|
io_file_get,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
NULL
|
NULL
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Check argupments to fopen */
|
/* Check arguments to fopen */
|
||||||
static int checkflags(const uint8_t *str, int32_t len) {
|
static int checkflags(const uint8_t *str) {
|
||||||
int flags = 0;
|
int flags = 0;
|
||||||
int32_t i;
|
int32_t i;
|
||||||
if (!len || len > 3) return -1;
|
int32_t len = janet_string_length(str);
|
||||||
|
if (!len || len > 3)
|
||||||
|
janet_panic("file mode must have a length between 1 and 3");
|
||||||
switch (*str) {
|
switch (*str) {
|
||||||
default:
|
default:
|
||||||
return -1;
|
janet_panicf("invalid flag %c, expected w, a, or r", *str);
|
||||||
|
break;
|
||||||
case 'w':
|
case 'w':
|
||||||
flags |= IO_WRITE;
|
flags |= IO_WRITE;
|
||||||
break;
|
break;
|
||||||
@@ -73,7 +86,8 @@ static int checkflags(const uint8_t *str, int32_t len) {
|
|||||||
for (i = 1; i < len; i++) {
|
for (i = 1; i < len; i++) {
|
||||||
switch (str[i]) {
|
switch (str[i]) {
|
||||||
default:
|
default:
|
||||||
return -1;
|
janet_panicf("invalid flag %c, expected + or b", str[i]);
|
||||||
|
break;
|
||||||
case '+':
|
case '+':
|
||||||
if (flags & IO_UPDATE) return -1;
|
if (flags & IO_UPDATE) return -1;
|
||||||
flags |= IO_UPDATE;
|
flags |= IO_UPDATE;
|
||||||
@@ -87,223 +101,171 @@ static int checkflags(const uint8_t *str, int32_t len) {
|
|||||||
return flags;
|
return flags;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Check file argument */
|
|
||||||
static IOFile *checkfile(JanetArgs args, int32_t n) {
|
|
||||||
IOFile *iof;
|
|
||||||
if (n >= args.n) {
|
|
||||||
*args.ret = janet_cstringv("expected core.file");
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
if (!janet_checktype(args.v[n], JANET_ABSTRACT)) {
|
|
||||||
*args.ret = janet_cstringv("expected core.file");
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
iof = (IOFile *) janet_unwrap_abstract(args.v[n]);
|
|
||||||
if (janet_abstract_type(iof) != &janet_io_filetype) {
|
|
||||||
*args.ret = janet_cstringv("expected core.file");
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
return iof;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Check buffer argument */
|
|
||||||
static JanetBuffer *checkbuffer(JanetArgs args, int32_t n, int optional) {
|
|
||||||
if (optional && n == args.n) {
|
|
||||||
return janet_buffer(0);
|
|
||||||
}
|
|
||||||
if (n >= args.n) {
|
|
||||||
*args.ret = janet_cstringv("expected buffer");
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
if (!janet_checktype(args.v[n], JANET_BUFFER)) {
|
|
||||||
*args.ret = janet_cstringv("expected buffer");
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
return janet_unwrap_abstract(args.v[n]);
|
|
||||||
}
|
|
||||||
|
|
||||||
static Janet makef(FILE *f, int flags) {
|
static Janet makef(FILE *f, int flags) {
|
||||||
IOFile *iof = (IOFile *) janet_abstract(&janet_io_filetype, sizeof(IOFile));
|
IOFile *iof = (IOFile *) janet_abstract(&cfun_io_filetype, sizeof(IOFile));
|
||||||
iof->file = f;
|
iof->file = f;
|
||||||
iof->flags = flags;
|
iof->flags = flags;
|
||||||
return janet_wrap_abstract(iof);
|
return janet_wrap_abstract(iof);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Open a process */
|
/* Open a process */
|
||||||
static int janet_io_popen(JanetArgs args) {
|
#ifdef __EMSCRIPTEN__
|
||||||
const uint8_t *fname, *fmode;
|
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||||
int32_t modelen;
|
(void) argc;
|
||||||
FILE *f;
|
(void) argv;
|
||||||
|
janet_panic("not implemented on this platform");
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
#else
|
||||||
|
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;
|
int flags;
|
||||||
JANET_MINARITY(args, 1);
|
if (argc == 2) {
|
||||||
JANET_MAXARITY(args, 2);
|
fmode = janet_getkeyword(argv, 1);
|
||||||
JANET_ARG_STRING(fname, args, 0);
|
if (janet_string_length(fmode) != 1 ||
|
||||||
if (args.n == 2) {
|
!(fmode[0] == 'r' || fmode[0] == 'w')) {
|
||||||
if (!janet_checktype(args.v[1], JANET_STRING) &&
|
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
|
||||||
!janet_checktype(args.v[1], JANET_SYMBOL))
|
}
|
||||||
JANET_THROW(args, "expected string mode");
|
flags = IO_PIPED | (fmode[0] == 'r' ? IO_READ : IO_WRITE);
|
||||||
fmode = janet_unwrap_string(args.v[1]);
|
|
||||||
modelen = janet_string_length(fmode);
|
|
||||||
} else {
|
} else {
|
||||||
fmode = (const uint8_t *)"r";
|
fmode = (const uint8_t *)"r";
|
||||||
modelen = 1;
|
flags = IO_PIPED | IO_READ;
|
||||||
}
|
}
|
||||||
if (fmode[0] == ':') {
|
|
||||||
fmode++;
|
|
||||||
modelen--;
|
|
||||||
}
|
|
||||||
if (modelen != 1 || !(fmode[0] == 'r' || fmode[0] == 'w')) {
|
|
||||||
JANET_THROW(args, "invalid file mode");
|
|
||||||
}
|
|
||||||
flags = (fmode[0] == 'r') ? IO_PIPED | IO_READ : IO_PIPED | IO_WRITE;
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
#define popen _popen
|
#define popen _popen
|
||||||
#endif
|
#endif
|
||||||
#ifdef __EMSCRIPTEN__
|
FILE *f = popen((const char *)fname, (const char *)fmode);
|
||||||
#define popen(A, B) (errno = 0, NULL)
|
|
||||||
#endif
|
|
||||||
f = popen((const char *)fname, (const char *)fmode);
|
|
||||||
if (!f) {
|
if (!f) {
|
||||||
if (errno == EMFILE) {
|
return janet_wrap_nil();
|
||||||
JANET_THROW(args, "too many streams are open");
|
|
||||||
}
|
}
|
||||||
JANET_THROW(args, "could not open file");
|
return makef(f, flags);
|
||||||
}
|
|
||||||
JANET_RETURN(args, makef(f, flags));
|
|
||||||
}
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Open a a file and return a userdata wrapper around the C file API. */
|
static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||||
static int janet_io_fopen(JanetArgs args) {
|
janet_arity(argc, 1, 2);
|
||||||
const uint8_t *fname, *fmode;
|
const uint8_t *fname = janet_getstring(argv, 0);
|
||||||
int32_t modelen;
|
const uint8_t *fmode;
|
||||||
FILE *f;
|
|
||||||
int flags;
|
int flags;
|
||||||
JANET_MINARITY(args, 1);
|
if (argc == 2) {
|
||||||
JANET_MAXARITY(args, 2);
|
fmode = janet_getkeyword(argv, 1);
|
||||||
JANET_ARG_STRING(fname, args, 0);
|
flags = checkflags(fmode);
|
||||||
if (args.n == 2) {
|
|
||||||
if (!janet_checktype(args.v[1], JANET_STRING) &&
|
|
||||||
!janet_checktype(args.v[1], JANET_SYMBOL))
|
|
||||||
JANET_THROW(args, "expected string mode");
|
|
||||||
fmode = janet_unwrap_string(args.v[1]);
|
|
||||||
modelen = janet_string_length(fmode);
|
|
||||||
} else {
|
} else {
|
||||||
fmode = (const uint8_t *)"r";
|
fmode = (const uint8_t *)"r";
|
||||||
modelen = 1;
|
flags = IO_READ;
|
||||||
}
|
}
|
||||||
if (fmode[0] == ':') {
|
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||||
fmode++;
|
return f ? makef(f, flags) : janet_wrap_nil();
|
||||||
modelen--;
|
|
||||||
}
|
|
||||||
if ((flags = checkflags(fmode, modelen)) < 0) {
|
|
||||||
JANET_THROW(args, "invalid file mode");
|
|
||||||
}
|
|
||||||
f = fopen((const char *)fname, (const char *)fmode);
|
|
||||||
JANET_RETURN(args, f ? makef(f, flags) : janet_wrap_nil());
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Read up to n bytes into buffer. Return error string if error. */
|
/* Read up to n bytes into buffer. */
|
||||||
static const char *read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||||
if (!(iof->flags & (IO_READ | IO_UPDATE)))
|
if (!(iof->flags & (IO_READ | IO_UPDATE)))
|
||||||
return "file is not readable";
|
janet_panic("file is not readable");
|
||||||
/* Ensure buffer size */
|
janet_buffer_extra(buffer, nBytesMax);
|
||||||
if (janet_buffer_extra(buffer, nBytesMax))
|
|
||||||
return "buffer overflow";
|
|
||||||
size_t ntoread = nBytesMax;
|
size_t ntoread = nBytesMax;
|
||||||
size_t nread = fread((char *)(buffer->data + buffer->count), 1, ntoread, iof->file);
|
size_t nread = fread((char *)(buffer->data + buffer->count), 1, ntoread, iof->file);
|
||||||
if (nread != ntoread && ferror(iof->file))
|
if (nread != ntoread && ferror(iof->file))
|
||||||
return "could not read file";
|
janet_panic("could not read file");
|
||||||
buffer->count += (int32_t) nread;
|
buffer->count += (int32_t) nread;
|
||||||
return NULL;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Read a certain number of bytes into memory */
|
/* Read a certain number of bytes into memory */
|
||||||
static int janet_io_fread(JanetArgs args) {
|
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||||
JanetBuffer *b;
|
janet_arity(argc, 2, 3);
|
||||||
IOFile *iof = checkfile(args, 0);
|
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||||
if (!iof) return 1;
|
if (iof->flags & IO_CLOSED) janet_panic("file is closed");
|
||||||
if (iof->flags & IO_CLOSED)
|
JanetBuffer *buffer;
|
||||||
JANET_THROW(args, "file is closed");
|
if (argc == 2) {
|
||||||
b = checkbuffer(args, 2, 1);
|
buffer = janet_buffer(0);
|
||||||
if (!b) return 1;
|
} else {
|
||||||
if (janet_checktype(args.v[1], JANET_SYMBOL)) {
|
buffer = janet_getbuffer(argv, 2);
|
||||||
const uint8_t *sym = janet_unwrap_symbol(args.v[1]);
|
}
|
||||||
if (!janet_cstrcmp(sym, ":all")) {
|
int32_t bufstart = buffer->count;
|
||||||
|
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||||
|
const uint8_t *sym = janet_unwrap_keyword(argv[1]);
|
||||||
|
if (!janet_cstrcmp(sym, "all")) {
|
||||||
/* Read whole file */
|
/* Read whole file */
|
||||||
int status = fseek(iof->file, 0, SEEK_SET);
|
int status = fseek(iof->file, 0, SEEK_SET);
|
||||||
if (status) {
|
if (status) {
|
||||||
/* backwards fseek did not work (stream like popen) */
|
/* backwards fseek did not work (stream like popen) */
|
||||||
int32_t sizeBefore;
|
int32_t sizeBefore;
|
||||||
do {
|
do {
|
||||||
sizeBefore = b->count;
|
sizeBefore = buffer->count;
|
||||||
const char *maybeErr = read_chunk(iof, b, 1024);
|
read_chunk(iof, buffer, 1024);
|
||||||
if (maybeErr) JANET_THROW(args, maybeErr);
|
} while (sizeBefore < buffer->count);
|
||||||
} while (sizeBefore < b->count);
|
|
||||||
} else {
|
} else {
|
||||||
fseek(iof->file, 0, SEEK_END);
|
fseek(iof->file, 0, SEEK_END);
|
||||||
long fsize = ftell(iof->file);
|
long fsize = ftell(iof->file);
|
||||||
fseek(iof->file, 0, SEEK_SET);
|
if (fsize < 0) {
|
||||||
if (fsize > INT32_MAX) JANET_THROW(args, "buffer overflow");
|
janet_panicf("could not get file size of %v", argv[0]);
|
||||||
const char *maybeErr = read_chunk(iof, b, (int32_t) fsize);;
|
|
||||||
if (maybeErr) JANET_THROW(args, maybeErr);
|
|
||||||
}
|
}
|
||||||
} else if (!janet_cstrcmp(sym, ":line")) {
|
if (fsize > (INT32_MAX)) {
|
||||||
|
janet_panic("file to large to read into buffer");
|
||||||
|
}
|
||||||
|
fseek(iof->file, 0, SEEK_SET);
|
||||||
|
read_chunk(iof, buffer, (int32_t) fsize);
|
||||||
|
}
|
||||||
|
/* Never return nil for :all */
|
||||||
|
return janet_wrap_buffer(buffer);
|
||||||
|
} else if (!janet_cstrcmp(sym, "line")) {
|
||||||
for (;;) {
|
for (;;) {
|
||||||
int x = fgetc(iof->file);
|
int x = fgetc(iof->file);
|
||||||
if (x != EOF && janet_buffer_push_u8(b, (uint8_t)x))
|
if (x != EOF) janet_buffer_push_u8(buffer, (uint8_t)x);
|
||||||
JANET_THROW(args, "buffer overflow");
|
|
||||||
if (x == EOF || x == '\n') break;
|
if (x == EOF || x == '\n') break;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
JANET_THROW(args, "expected one of :all, :line");
|
janet_panicf("expected one of :all, :line, got %v", argv[1]);
|
||||||
}
|
}
|
||||||
} else if (!janet_checktype(args.v[1], JANET_INTEGER)) {
|
|
||||||
JANET_THROW(args, "expected positive integer");
|
|
||||||
} else {
|
} else {
|
||||||
int32_t len = janet_unwrap_integer(args.v[1]);
|
int32_t len = janet_getinteger(argv, 1);
|
||||||
if (len < 0) JANET_THROW(args, "expected positive integer");
|
if (len < 0) janet_panic("expected positive integer");
|
||||||
const char *maybeErr = read_chunk(iof, b, len);
|
read_chunk(iof, buffer, len);
|
||||||
if (maybeErr) JANET_THROW(args, maybeErr);
|
|
||||||
}
|
}
|
||||||
JANET_RETURN(args, janet_wrap_buffer(b));
|
if (bufstart == buffer->count) return janet_wrap_nil();
|
||||||
|
return janet_wrap_buffer(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Write bytes to a file */
|
/* Write bytes to a file */
|
||||||
static int janet_io_fwrite(JanetArgs args) {
|
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||||
int32_t len, i;
|
janet_arity(argc, 1, -1);
|
||||||
const uint8_t *str;
|
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||||
IOFile *iof = checkfile(args, 0);
|
|
||||||
if (!iof) return 1;
|
|
||||||
if (iof->flags & IO_CLOSED)
|
if (iof->flags & IO_CLOSED)
|
||||||
JANET_THROW(args, "file is closed");
|
janet_panic("file is closed");
|
||||||
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
||||||
JANET_THROW(args, "file is not writeable");
|
janet_panic("file is not writeable");
|
||||||
for (i = 1; i < args.n; i++) {
|
int32_t i;
|
||||||
JANET_CHECKMANY(args, i, JANET_TFLAG_BYTES);
|
/* Verify all arguments before writing to file */
|
||||||
}
|
for (i = 1; i < argc; i++)
|
||||||
for (i = 1; i < args.n; i++) {
|
janet_getbytes(argv, i);
|
||||||
JANET_ARG_BYTES(str, len, args, i);
|
for (i = 1; i < argc; i++) {
|
||||||
if (len) {
|
JanetByteView view = janet_getbytes(argv, i);
|
||||||
if (!fwrite(str, len, 1, iof->file)) JANET_THROW(args, "error writing to file");
|
if (view.len) {
|
||||||
|
if (!fwrite(view.bytes, view.len, 1, iof->file)) {
|
||||||
|
janet_panic("error writing to file");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
JANET_RETURN(args, janet_wrap_abstract(iof));
|
}
|
||||||
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Flush the bytes in the file */
|
/* Flush the bytes in the file */
|
||||||
static int janet_io_fflush(JanetArgs args) {
|
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||||
IOFile *iof = checkfile(args, 0);
|
janet_fixarity(argc, 1);
|
||||||
if (!iof) return 1;
|
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||||
if (iof->flags & IO_CLOSED)
|
if (iof->flags & IO_CLOSED)
|
||||||
JANET_THROW(args, "file is closed");
|
janet_panic("file is closed");
|
||||||
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
||||||
JANET_THROW(args, "file is not flushable");
|
janet_panic("file is not writeable");
|
||||||
if (fflush(iof->file)) JANET_THROW(args, "could not flush file");
|
if (fflush(iof->file))
|
||||||
JANET_RETURN(args, janet_wrap_abstract(iof));
|
janet_panic("could not flush file");
|
||||||
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Cleanup a file */
|
/* Cleanup a file */
|
||||||
static int janet_io_gc(void *p, size_t len) {
|
static int cfun_io_gc(void *p, size_t len) {
|
||||||
(void) len;
|
(void) len;
|
||||||
IOFile *iof = (IOFile *)p;
|
IOFile *iof = (IOFile *)p;
|
||||||
if (!(iof->flags & (IO_NOT_CLOSEABLE | IO_CLOSED))) {
|
if (!(iof->flags & (IO_NOT_CLOSEABLE | IO_CLOSED))) {
|
||||||
@@ -313,139 +275,189 @@ static int janet_io_gc(void *p, size_t len) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Close a file */
|
/* Close a file */
|
||||||
static int janet_io_fclose(JanetArgs args) {
|
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||||
IOFile *iof = checkfile(args, 0);
|
janet_fixarity(argc, 1);
|
||||||
if (!iof) return 1;
|
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||||
if (iof->flags & (IO_CLOSED))
|
if (iof->flags & IO_CLOSED)
|
||||||
JANET_THROW(args, "file already closed");
|
janet_panic("file is closed");
|
||||||
if (iof->flags & (IO_NOT_CLOSEABLE))
|
if (iof->flags & (IO_NOT_CLOSEABLE))
|
||||||
JANET_THROW(args, "file not closable");
|
janet_panic("file not closable");
|
||||||
if (iof->flags & IO_PIPED) {
|
if (iof->flags & IO_PIPED) {
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
#define pclose _pclose
|
#define pclose _pclose
|
||||||
#endif
|
#endif
|
||||||
if (pclose(iof->file)) JANET_THROW(args, "could not close file");
|
if (pclose(iof->file)) janet_panic("could not close file");
|
||||||
} else {
|
} else {
|
||||||
if (fclose(iof->file)) JANET_THROW(args, "could not close file");
|
if (fclose(iof->file)) janet_panic("could not close file");
|
||||||
}
|
}
|
||||||
iof->flags |= IO_CLOSED;
|
iof->flags |= IO_CLOSED;
|
||||||
JANET_RETURN(args, janet_wrap_abstract(iof));
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Seek a file */
|
/* Seek a file */
|
||||||
static int janet_io_fseek(JanetArgs args) {
|
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 2, 3);
|
||||||
|
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||||
|
if (iof->flags & IO_CLOSED)
|
||||||
|
janet_panic("file is closed");
|
||||||
long int offset = 0;
|
long int offset = 0;
|
||||||
int whence = SEEK_CUR;
|
int whence = SEEK_CUR;
|
||||||
IOFile *iof = checkfile(args, 0);
|
if (argc >= 2) {
|
||||||
if (!iof) return 1;
|
const uint8_t *whence_sym = janet_getkeyword(argv, 1);
|
||||||
if (iof->flags & IO_CLOSED)
|
if (!janet_cstrcmp(whence_sym, "cur")) {
|
||||||
JANET_THROW(args, "file is closed");
|
|
||||||
if (args.n >= 2) {
|
|
||||||
const uint8_t *whence_sym;
|
|
||||||
if (!janet_checktype(args.v[1], JANET_SYMBOL))
|
|
||||||
JANET_THROW(args, "expected symbol");
|
|
||||||
whence_sym = janet_unwrap_symbol(args.v[1]);
|
|
||||||
if (!janet_cstrcmp(whence_sym, ":cur")) {
|
|
||||||
whence = SEEK_CUR;
|
whence = SEEK_CUR;
|
||||||
} else if (!janet_cstrcmp(whence_sym, ":set")) {
|
} else if (!janet_cstrcmp(whence_sym, "set")) {
|
||||||
whence = SEEK_SET;
|
whence = SEEK_SET;
|
||||||
} else if (!janet_cstrcmp(whence_sym, ":end")) {
|
} else if (!janet_cstrcmp(whence_sym, "end")) {
|
||||||
whence = SEEK_END;
|
whence = SEEK_END;
|
||||||
} else {
|
} else {
|
||||||
JANET_THROW(args, "expected one of :cur, :set, :end");
|
janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]);
|
||||||
}
|
}
|
||||||
if (args.n >= 3) {
|
if (argc == 3) {
|
||||||
double doffset;
|
offset = (long) janet_getinteger64(argv, 2);
|
||||||
JANET_ARG_NUMBER(doffset, args, 2);
|
|
||||||
offset = (long int)doffset;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (fseek(iof->file, offset, whence))
|
if (fseek(iof->file, offset, whence)) janet_panic("error seeking file");
|
||||||
JANET_THROW(args, "error seeking file");
|
return argv[0];
|
||||||
JANET_RETURN(args, args.v[0]);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static JanetMethod io_file_methods[] = {
|
||||||
{"file/open", janet_io_fopen,
|
{"close", cfun_io_fclose},
|
||||||
"(file/open path [,mode])\n\n"
|
{"read", cfun_io_fread},
|
||||||
"Open a file. path is files absolute or relative path, and "
|
{"write", cfun_io_fwrite},
|
||||||
|
{"flush", cfun_io_fflush},
|
||||||
|
{"seek", cfun_io_fseek},
|
||||||
|
{NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
static Janet io_file_get(void *p, Janet key) {
|
||||||
|
(void) p;
|
||||||
|
if (!janet_checktype(key, JANET_KEYWORD))
|
||||||
|
janet_panicf("expected keyword, got %v", key);
|
||||||
|
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods);
|
||||||
|
}
|
||||||
|
|
||||||
|
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;
|
||||||
|
return iofile->file;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_io_print(int32_t argc, Janet *argv) {
|
||||||
|
FILE *f = janet_dynfile("out", stdout);
|
||||||
|
for (int32_t i = 0; i < argc; ++i) {
|
||||||
|
int32_t j, len;
|
||||||
|
const uint8_t *vstr = janet_to_string(argv[i]);
|
||||||
|
len = janet_string_length(vstr);
|
||||||
|
for (j = 0; j < len; ++j) {
|
||||||
|
putc(vstr[j], f);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
putc('\n', f);
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg io_cfuns[] = {
|
||||||
|
{
|
||||||
|
"print", cfun_io_print,
|
||||||
|
JDOC("(print & xs)\n\n"
|
||||||
|
"Print values to the console (standard out). Value are converted "
|
||||||
|
"to strings if they are not already. After printing all values, a "
|
||||||
|
"newline character is printed. Returns nil.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"file/open", cfun_io_fopen,
|
||||||
|
JDOC("(file/open path [,mode])\n\n"
|
||||||
|
"Open a file. path is an absolute or relative path, and "
|
||||||
"mode is a set of flags indicating the mode to open the file in. "
|
"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 "
|
"mode is a keyword where each character represents a flag. If the file "
|
||||||
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
||||||
"Mode flags:\n\n"
|
"Mode flags:\n\n"
|
||||||
"\tr - allow reading from the file\n"
|
"\tr - allow reading from the file\n"
|
||||||
"\tw - allow witing to the file\n"
|
"\tw - allow writing to the file\n"
|
||||||
"\ta - append to the file\n"
|
"\ta - append to the file\n"
|
||||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||||
"\t+ - append to the file instead of overwriting it"
|
"\t+ - append to the file instead of overwriting it")
|
||||||
},
|
},
|
||||||
{"file/close", janet_io_fclose,
|
{
|
||||||
"(file/close f)\n\n"
|
"file/close", cfun_io_fclose,
|
||||||
|
JDOC("(file/close f)\n\n"
|
||||||
"Close a file and release all related resources. When you are "
|
"Close a file and release all related resources. When you are "
|
||||||
"done reading a file, close it to prevent a resource leak and let "
|
"done reading a file, close it to prevent a resource leak and let "
|
||||||
"other processes read the file."
|
"other processes read the file.")
|
||||||
},
|
},
|
||||||
{"file/read", janet_io_fread,
|
{
|
||||||
"(file/read f what [,buf])\n\n"
|
"file/read", cfun_io_fread,
|
||||||
|
JDOC("(file/read f what [,buf])\n\n"
|
||||||
"Read a number of bytes from a file into a buffer. A buffer can "
|
"Read a number of bytes from a file into a buffer. A buffer can "
|
||||||
"be provided as an optional fourth argument. otherwise a new buffer "
|
"be provided as an optional fourth argument, otherwise a new buffer "
|
||||||
"is created. 'what' can either be an integer or a keyword. Returns the "
|
"is created. 'what' can either be an integer or a keyword. Returns the "
|
||||||
"buffer with file contents. "
|
"buffer with file contents. "
|
||||||
"Values for 'what':\n\n"
|
"Values for 'what':\n\n"
|
||||||
"\t:all - read the whole file\n"
|
"\t:all - read the whole file\n"
|
||||||
"\t:line - read up to and including the next newline character\n"
|
"\t:line - read up to and including the next newline character\n"
|
||||||
"\tn (integer) - read up to n bytes from the file"
|
"\tn (integer) - read up to n bytes from the file")
|
||||||
},
|
},
|
||||||
{"file/write", janet_io_fwrite,
|
{
|
||||||
"(file/write f bytes)\n\n"
|
"file/write", cfun_io_fwrite,
|
||||||
|
JDOC("(file/write f bytes)\n\n"
|
||||||
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
||||||
"file"
|
"file.")
|
||||||
},
|
},
|
||||||
{"file/flush", janet_io_fflush,
|
{
|
||||||
"(file/flush f)\n\n"
|
"file/flush", cfun_io_fflush,
|
||||||
"Flush any buffered bytes to the filesystem. In most files, writes are "
|
JDOC("(file/flush f)\n\n"
|
||||||
"buffered for efficiency reasons. Returns the file handle."
|
"Flush any buffered bytes to the file system. In most files, writes are "
|
||||||
|
"buffered for efficiency reasons. Returns the file handle.")
|
||||||
},
|
},
|
||||||
{"file/seek", janet_io_fseek,
|
{
|
||||||
"(file/seek f [,whence [,n]])\n\n"
|
"file/seek", cfun_io_fseek,
|
||||||
|
JDOC("(file/seek f [,whence [,n]])\n\n"
|
||||||
"Jump to a relative location in the file. 'whence' must be one of\n\n"
|
"Jump to a relative location in the file. 'whence' must be one of\n\n"
|
||||||
"\t:cur - jump relative to the current file location\n"
|
"\t:cur - jump relative to the current file location\n"
|
||||||
"\t:set - jump relative to the beginning of the file\n"
|
"\t:set - jump relative to the beginning of the file\n"
|
||||||
"\t:end - jump relative to the end of the file\n\n"
|
"\t:end - jump relative to the end of the file\n\n"
|
||||||
"By default, 'whence' is :cur. Optionally a value n may be passed "
|
"By default, 'whence' is :cur. Optionally a value n may be passed "
|
||||||
"for the relative number of bytes to seek in the file. n may be a real "
|
"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."
|
"number to handle large files of more the 4GB. Returns the file handle.")
|
||||||
},
|
},
|
||||||
{"file/popen", janet_io_popen,
|
{
|
||||||
"(file/popen path [,mode])\n\n"
|
"file/popen", cfun_io_popen,
|
||||||
|
JDOC("(file/popen path [,mode])\n\n"
|
||||||
"Open a file that is backed by a process. The file must be opened in either "
|
"Open a file that is backed by a process. The file must be opened in either "
|
||||||
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
||||||
"process can be read from the file. In :w mode, the stdin of the process "
|
"process can be read from the file. In :w mode, the stdin of the process "
|
||||||
"can be written to. Returns the new file."
|
"can be written to. Returns the new file.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
/* C API */
|
||||||
|
|
||||||
|
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
|
||||||
|
IOFile *iof = janet_getabstract(argv, n, &cfun_io_filetype);
|
||||||
|
if (NULL != flags) *flags = iof->flags;
|
||||||
|
return iof->file;
|
||||||
|
}
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
int janet_lib_io(JanetArgs args) {
|
void janet_lib_io(JanetTable *env) {
|
||||||
JanetTable *env = janet_env(args);
|
janet_core_cfuns(env, NULL, io_cfuns);
|
||||||
janet_cfuns(env, NULL, cfuns);
|
|
||||||
|
|
||||||
/* stdout */
|
/* stdout */
|
||||||
janet_def(env, "stdout",
|
janet_core_def(env, "stdout",
|
||||||
makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||||
"The standard output file.");
|
JDOC("The standard output file."));
|
||||||
|
|
||||||
|
|
||||||
/* stderr */
|
/* stderr */
|
||||||
janet_def(env, "stderr",
|
janet_core_def(env, "stderr",
|
||||||
makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||||
"The standard error file.");
|
JDOC("The standard error file."));
|
||||||
|
|
||||||
/* stdin */
|
/* stdin */
|
||||||
janet_def(env, "stdin",
|
janet_core_def(env, "stdin",
|
||||||
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||||
"The standard input file.");
|
JDOC("The standard input file."));
|
||||||
|
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|||||||
722
src/core/marsh.c
722
src/core/marsh.c
File diff suppressed because it is too large
Load Diff
272
src/core/math.c
272
src/core/math.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,79 +20,41 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
|
||||||
#include <math.h>
|
#include <math.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Get a random number */
|
/* Get a random number */
|
||||||
int janet_rand(JanetArgs args) {
|
static Janet janet_rand(int32_t argc, Janet *argv) {
|
||||||
JANET_FIXARITY(args, 0);
|
(void) argv;
|
||||||
|
janet_fixarity(argc, 0);
|
||||||
double r = (rand() % RAND_MAX) / ((double) RAND_MAX);
|
double r = (rand() % RAND_MAX) / ((double) RAND_MAX);
|
||||||
JANET_RETURN_REAL(args, r);
|
return janet_wrap_number(r);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Seed the random number generator */
|
/* Seed the random number generator */
|
||||||
int janet_srand(JanetArgs args) {
|
static Janet janet_srand(int32_t argc, Janet *argv) {
|
||||||
int32_t x = 0;
|
janet_fixarity(argc, 1);
|
||||||
JANET_FIXARITY(args, 1);
|
int32_t x = janet_getinteger(argv, 0);
|
||||||
JANET_ARG_INTEGER(x, args, 0);
|
|
||||||
srand((unsigned) x);
|
srand((unsigned) x);
|
||||||
return 0;
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Convert a number to an integer */
|
static Janet janet_remainder(int32_t argc, Janet *argv) {
|
||||||
int janet_int(JanetArgs args) {
|
janet_fixarity(argc, 2);
|
||||||
JANET_FIXARITY(args, 1);
|
double x = janet_getnumber(argv, 0);
|
||||||
switch (janet_type(args.v[0])) {
|
double y = janet_getnumber(argv, 1);
|
||||||
default:
|
return janet_wrap_number(fmod(x, y));
|
||||||
JANET_THROW(args, "could not convert to integer");
|
|
||||||
case JANET_REAL:
|
|
||||||
*args.ret = janet_wrap_integer((int32_t) janet_unwrap_real(args.v[0]));
|
|
||||||
break;
|
|
||||||
case JANET_INTEGER:
|
|
||||||
*args.ret = args.v[0];
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Convert a number to a real number */
|
|
||||||
int janet_real(JanetArgs args) {
|
|
||||||
JANET_FIXARITY(args, 1);
|
|
||||||
switch (janet_type(args.v[0])) {
|
|
||||||
default:
|
|
||||||
JANET_THROW(args, "could not convert to real");
|
|
||||||
case JANET_REAL:
|
|
||||||
*args.ret = args.v[0];
|
|
||||||
break;
|
|
||||||
case JANET_INTEGER:
|
|
||||||
*args.ret = janet_wrap_real((double) janet_unwrap_integer(args.v[0]));
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
int janet_remainder(JanetArgs args) {
|
|
||||||
JANET_FIXARITY(args, 2);
|
|
||||||
if (janet_checktype(args.v[0], JANET_INTEGER) &&
|
|
||||||
janet_checktype(args.v[1], JANET_INTEGER)) {
|
|
||||||
int32_t x, y;
|
|
||||||
x = janet_unwrap_integer(args.v[0]);
|
|
||||||
y = janet_unwrap_integer(args.v[1]);
|
|
||||||
JANET_RETURN_INTEGER(args, x % y);
|
|
||||||
} else {
|
|
||||||
double x, y;
|
|
||||||
JANET_ARG_NUMBER(x, args, 0);
|
|
||||||
JANET_ARG_NUMBER(y, args, 1);
|
|
||||||
JANET_RETURN_REAL(args, fmod(x, y));
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#define JANET_DEFINE_MATHOP(name, fop)\
|
#define JANET_DEFINE_MATHOP(name, fop)\
|
||||||
int janet_##name(JanetArgs args) {\
|
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||||
double x;\
|
janet_fixarity(argc, 1); \
|
||||||
JANET_FIXARITY(args, 1);\
|
double x = janet_getnumber(argv, 0); \
|
||||||
JANET_ARG_NUMBER(x, args, 0);\
|
return janet_wrap_number(fop(x)); \
|
||||||
JANET_RETURN_REAL(args, fop(x));\
|
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_DEFINE_MATHOP(acos, acos)
|
JANET_DEFINE_MATHOP(acos, acos)
|
||||||
@@ -113,110 +75,144 @@ JANET_DEFINE_MATHOP(fabs, fabs)
|
|||||||
JANET_DEFINE_MATHOP(floor, floor)
|
JANET_DEFINE_MATHOP(floor, floor)
|
||||||
|
|
||||||
#define JANET_DEFINE_MATH2OP(name, fop)\
|
#define JANET_DEFINE_MATH2OP(name, fop)\
|
||||||
int janet_##name(JanetArgs args) {\
|
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||||
double lhs, rhs;\
|
janet_fixarity(argc, 2); \
|
||||||
JANET_FIXARITY(args, 2);\
|
double lhs = janet_getnumber(argv, 0); \
|
||||||
JANET_ARG_NUMBER(lhs, args, 0);\
|
double rhs = janet_getnumber(argv, 1); \
|
||||||
JANET_ARG_NUMBER(rhs, args, 1);\
|
return janet_wrap_number(fop(lhs, rhs)); \
|
||||||
JANET_RETURN_REAL(args, fop(lhs, rhs));\
|
|
||||||
}\
|
}\
|
||||||
|
|
||||||
JANET_DEFINE_MATH2OP(atan2, atan2)
|
JANET_DEFINE_MATH2OP(atan2, atan2)
|
||||||
JANET_DEFINE_MATH2OP(pow, pow)
|
JANET_DEFINE_MATH2OP(pow, pow)
|
||||||
|
|
||||||
static int janet_not(JanetArgs args) {
|
static Janet janet_not(int32_t argc, Janet *argv) {
|
||||||
JANET_FIXARITY(args, 1);
|
janet_fixarity(argc, 1);
|
||||||
JANET_RETURN_BOOLEAN(args, !janet_truthy(args.v[0]));
|
return janet_wrap_boolean(!janet_truthy(argv[0]));
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetReg math_cfuns[] = {
|
||||||
{"%", janet_remainder,
|
{
|
||||||
"(% dividend divisor)\n\n"
|
"%", janet_remainder,
|
||||||
"Returns the remainder of dividend / divisor."
|
JDOC("(% dividend divisor)\n\n"
|
||||||
|
"Returns the remainder of dividend / divisor.")
|
||||||
},
|
},
|
||||||
{"not", janet_not,
|
{
|
||||||
"(not x)\n\nReturns the boolen inverse of x."
|
"not", janet_not,
|
||||||
|
JDOC("(not x)\n\nReturns the boolean inverse of x.")
|
||||||
},
|
},
|
||||||
{"int", janet_int,
|
{
|
||||||
"(int x)\n\nCast a number x to an integer."
|
"math/random", janet_rand,
|
||||||
|
JDOC("(math/random)\n\n"
|
||||||
|
"Returns a uniformly distributed random number between 0 and 1.")
|
||||||
},
|
},
|
||||||
{"real", janet_real,
|
{
|
||||||
"(real x)\n\nCast a number x to a real number."
|
"math/seedrandom", janet_srand,
|
||||||
},
|
JDOC("(math/seedrandom seed)\n\n"
|
||||||
{"math/random", janet_rand,
|
|
||||||
"(math/random)\n\n"
|
|
||||||
"Returns a uniformly distrbuted random real number between 0 and 1."
|
|
||||||
},
|
|
||||||
{"math/seedrandom", janet_srand,
|
|
||||||
"(math/seedrandom seed)\n\n"
|
|
||||||
"Set the seed for the random number generator. 'seed' should be an "
|
"Set the seed for the random number generator. 'seed' should be an "
|
||||||
"an integer."
|
"an integer.")
|
||||||
},
|
},
|
||||||
{"math/cos", janet_cos,
|
{
|
||||||
"(math/cos x)\n\n"
|
"math/cos", janet_cos,
|
||||||
"Returns the cosine of x."
|
JDOC("(math/cos x)\n\n"
|
||||||
|
"Returns the cosine of x.")
|
||||||
},
|
},
|
||||||
{"math/sin", janet_sin,
|
{
|
||||||
"(math/sin x)\n\n"
|
"math/sin", janet_sin,
|
||||||
"Returns the sine of x."
|
JDOC("(math/sin x)\n\n"
|
||||||
|
"Returns the sine of x.")
|
||||||
},
|
},
|
||||||
{"math/tan", janet_tan,
|
{
|
||||||
"(math/tan x)\n\n"
|
"math/tan", janet_tan,
|
||||||
"Returns the tangent of x."
|
JDOC("(math/tan x)\n\n"
|
||||||
|
"Returns the tangent of x.")
|
||||||
},
|
},
|
||||||
{"math/acos", janet_acos,
|
{
|
||||||
"(math/acos x)\n\n"
|
"math/acos", janet_acos,
|
||||||
"Returns the arccosine of x."
|
JDOC("(math/acos x)\n\n"
|
||||||
|
"Returns the arccosine of x.")
|
||||||
},
|
},
|
||||||
{"math/asin", janet_asin,
|
{
|
||||||
"(math/asin x)\n\n"
|
"math/asin", janet_asin,
|
||||||
"Returns the arcsine of x."
|
JDOC("(math/asin x)\n\n"
|
||||||
|
"Returns the arcsine of x.")
|
||||||
},
|
},
|
||||||
{"math/atan", janet_atan,
|
{
|
||||||
"(math/atan x)\n\n"
|
"math/atan", janet_atan,
|
||||||
"Returns the arctangent of x."
|
JDOC("(math/atan x)\n\n"
|
||||||
|
"Returns the arctangent of x.")
|
||||||
},
|
},
|
||||||
{"math/exp", janet_exp,
|
{
|
||||||
"(math/exp x)\n\n"
|
"math/exp", janet_exp,
|
||||||
"Returns e to the power of x."
|
JDOC("(math/exp x)\n\n"
|
||||||
|
"Returns e to the power of x.")
|
||||||
},
|
},
|
||||||
{"math/log", janet_log,
|
{
|
||||||
"(math/log x)\n\n"
|
"math/log", janet_log,
|
||||||
"Returns log base 2 of x."
|
JDOC("(math/log x)\n\n"
|
||||||
|
"Returns log base 2 of x.")
|
||||||
},
|
},
|
||||||
{"math/log10", janet_log10,
|
{
|
||||||
"(math/log10 x)\n\n"
|
"math/log10", janet_log10,
|
||||||
"Returns log base 10 of x."
|
JDOC("(math/log10 x)\n\n"
|
||||||
|
"Returns log base 10 of x.")
|
||||||
},
|
},
|
||||||
{"math/sqrt", janet_sqrt,
|
{
|
||||||
"(math/sqrt x)\n\n"
|
"math/sqrt", janet_sqrt,
|
||||||
"Returns the square root of x."
|
JDOC("(math/sqrt x)\n\n"
|
||||||
|
"Returns the square root of x.")
|
||||||
},
|
},
|
||||||
{"math/floor", janet_floor,
|
{
|
||||||
"(math/floor x)\n\n"
|
"math/floor", janet_floor,
|
||||||
"Returns the largest integer value real number that is not greater than x."
|
JDOC("(math/floor x)\n\n"
|
||||||
|
"Returns the largest integer value number that is not greater than x.")
|
||||||
},
|
},
|
||||||
{"math/ceil", janet_ceil,
|
{
|
||||||
"(math/ceil x)\n\n"
|
"math/ceil", janet_ceil,
|
||||||
"Returns the smallest integer value real number that is not less than x."
|
JDOC("(math/ceil x)\n\n"
|
||||||
|
"Returns the smallest integer value number that is not less than x.")
|
||||||
},
|
},
|
||||||
{"math/pow", janet_pow,
|
{
|
||||||
"(math/pow a x)\n\n"
|
"math/pow", janet_pow,
|
||||||
"Return a to the power of x."
|
JDOC("(math/pow a x)\n\n"
|
||||||
|
"Return a to the power of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/abs", janet_fabs,
|
||||||
|
JDOC("(math/abs x)\n\n"
|
||||||
|
"Return the absolute value of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/sinh", janet_sinh,
|
||||||
|
JDOC("(math/sinh x)\n\n"
|
||||||
|
"Return the hyperbolic sine of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/cosh", janet_cosh,
|
||||||
|
JDOC("(math/cosh x)\n\n"
|
||||||
|
"Return the hyperbolic cosine of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/tanh", janet_tanh,
|
||||||
|
JDOC("(math/tanh x)\n\n"
|
||||||
|
"Return the hyperbolic tangent of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/atan2", janet_atan2,
|
||||||
|
JDOC("(math/atan2 y x)\n\n"
|
||||||
|
"Return the arctangent of y/x. Works even when x is 0.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
int janet_lib_math(JanetArgs args) {
|
void janet_lib_math(JanetTable *env) {
|
||||||
JanetTable *env = janet_env(args);
|
janet_core_cfuns(env, NULL, math_cfuns);
|
||||||
janet_cfuns(env, NULL, cfuns);
|
#ifdef JANET_BOOTSTRAP
|
||||||
|
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
||||||
janet_def(env, "math/pi", janet_wrap_real(3.1415926535897931),
|
JDOC("The value pi."));
|
||||||
"The value pi.");
|
janet_def(env, "math/e", janet_wrap_number(2.7182818284590451),
|
||||||
janet_def(env, "math/e", janet_wrap_real(2.7182818284590451),
|
JDOC("The base of the natural log."));
|
||||||
"The base of the natural log.");
|
janet_def(env, "math/inf", janet_wrap_number(INFINITY),
|
||||||
janet_def(env, "math/inf", janet_wrap_real(INFINITY),
|
JDOC("The number representing positive infinity"));
|
||||||
"The real number representing positive infinity");
|
#endif
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,111 +0,0 @@
|
|||||||
/*
|
|
||||||
* Copyright (c) 2018 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.
|
|
||||||
*/
|
|
||||||
|
|
||||||
#include <janet/janet.h>
|
|
||||||
#include "compile.h"
|
|
||||||
#include "emit.h"
|
|
||||||
#include "vector.h"
|
|
||||||
|
|
||||||
/* Parse a part of a symbol that can be used for building up code. */
|
|
||||||
static JanetSlot multisym_parse_part(JanetCompiler *c, const uint8_t *sympart, int32_t len) {
|
|
||||||
if (sympart[0] == ':') {
|
|
||||||
return janetc_cslot(janet_symbolv(sympart, len));
|
|
||||||
} else {
|
|
||||||
int err = 0;
|
|
||||||
int32_t num = janet_scan_integer(sympart + 1, len - 1, &err);
|
|
||||||
if (err) {
|
|
||||||
return janetc_resolve(c, janet_symbol(sympart + 1, len - 1));
|
|
||||||
} else {
|
|
||||||
return janetc_cslot(janet_wrap_integer(num));
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static JanetSlot multisym_do_parts(JanetFopts opts, int put, const uint8_t *sym, Janet rvalue) {
|
|
||||||
JanetSlot slot;
|
|
||||||
JanetFopts subopts = janetc_fopts_default(opts.compiler);
|
|
||||||
int i, j;
|
|
||||||
for (i = 1, j = 0; sym[i]; i++) {
|
|
||||||
if (sym[i] == ':' || sym[i] == '.') {
|
|
||||||
if (j) {
|
|
||||||
JanetSlot target = janetc_gettarget(subopts);
|
|
||||||
JanetSlot value = multisym_parse_part(opts.compiler, sym + j, i - j);
|
|
||||||
janetc_emit_sss(opts.compiler, JOP_GET, target, slot, value, 1);
|
|
||||||
slot = target;
|
|
||||||
} else {
|
|
||||||
const uint8_t *nextsym = janet_symbol(sym + j, i - j);
|
|
||||||
slot = janetc_resolve(opts.compiler, nextsym);
|
|
||||||
}
|
|
||||||
j = i;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
if (j) {
|
|
||||||
/* multisym (outermost get or put) */
|
|
||||||
JanetSlot target = janetc_gettarget(opts);
|
|
||||||
JanetSlot key = multisym_parse_part(opts.compiler, sym + j, i - j);
|
|
||||||
if (put) {
|
|
||||||
subopts.flags = JANET_FOPTS_HINT;
|
|
||||||
subopts.hint = target;
|
|
||||||
JanetSlot r_slot = janetc_value(subopts, rvalue);
|
|
||||||
janetc_emit_sss(opts.compiler, JOP_PUT, slot, key, r_slot, 0);
|
|
||||||
janetc_copy(opts.compiler, target, r_slot);
|
|
||||||
} else {
|
|
||||||
janetc_emit_sss(opts.compiler, JOP_GET, target, slot, key, 1);
|
|
||||||
}
|
|
||||||
return target;
|
|
||||||
} else {
|
|
||||||
/* normal symbol */
|
|
||||||
if (put) {
|
|
||||||
JanetSlot ret, dest;
|
|
||||||
dest = janetc_resolve(opts.compiler, sym);
|
|
||||||
if (!(dest.flags & JANET_SLOT_MUTABLE)) {
|
|
||||||
janetc_cerror(opts.compiler, "cannot set constant");
|
|
||||||
return janetc_cslot(janet_wrap_nil());
|
|
||||||
}
|
|
||||||
subopts.flags = JANET_FOPTS_HINT;
|
|
||||||
subopts.hint = dest;
|
|
||||||
ret = janetc_value(subopts, rvalue);
|
|
||||||
janetc_copy(opts.compiler, dest, ret);
|
|
||||||
return ret;
|
|
||||||
}
|
|
||||||
return janetc_resolve(opts.compiler, sym);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Check if a symbol is a multisym, and if so, transform
|
|
||||||
* it and emit the code for treating it as a bunch of nested
|
|
||||||
* gets. */
|
|
||||||
JanetSlot janetc_sym_rvalue(JanetFopts opts, const uint8_t *sym) {
|
|
||||||
if (janet_string_length(sym) && sym[0] != ':') {
|
|
||||||
return multisym_do_parts(opts, 0, sym, janet_wrap_nil());
|
|
||||||
} else {
|
|
||||||
/* keyword */
|
|
||||||
return janetc_cslot(janet_wrap_symbol(sym));
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Check if a symbol is a multisym, and if so, transform
|
|
||||||
* it into the correct 'put' expression. */
|
|
||||||
JanetSlot janetc_sym_lvalue(JanetFopts opts, const uint8_t *sym, Janet value) {
|
|
||||||
return multisym_do_parts(opts, 1, sym, value);
|
|
||||||
}
|
|
||||||
691
src/core/os.c
691
src/core/os.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,18 +20,33 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
|
|
||||||
|
#ifndef JANET_REDUCED_OS
|
||||||
|
|
||||||
#include <time.h>
|
#include <time.h>
|
||||||
|
#include <fcntl.h>
|
||||||
|
#include <errno.h>
|
||||||
|
#include <stdio.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include <sys/stat.h>
|
||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
#include <Windows.h>
|
#include <windows.h>
|
||||||
#include <direct.h>
|
#include <direct.h>
|
||||||
|
#include <sys/utime.h>
|
||||||
|
#include <io.h>
|
||||||
#else
|
#else
|
||||||
|
#include <utime.h>
|
||||||
#include <unistd.h>
|
#include <unistd.h>
|
||||||
|
#include <dirent.h>
|
||||||
#include <sys/types.h>
|
#include <sys/types.h>
|
||||||
#include <sys/wait.h>
|
#include <sys/wait.h>
|
||||||
#include <stdio.h>
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* For macos */
|
/* For macos */
|
||||||
@@ -40,27 +55,58 @@
|
|||||||
#include <mach/mach.h>
|
#include <mach/mach.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
static int os_which(JanetArgs args) {
|
#endif /* JANET_REDCUED_OS */
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
JANET_RETURN_CSYMBOL(args, ":windows");
|
/* Core OS functions */
|
||||||
#elif __APPLE__
|
|
||||||
JANET_RETURN_CSYMBOL(args, ":macos");
|
/* Full OS functions */
|
||||||
#elif defined(__EMSCRIPTEN__)
|
|
||||||
JANET_RETURN_CSYMBOL(args, ":web");
|
static Janet os_which(int32_t argc, Janet *argv) {
|
||||||
#else
|
janet_fixarity(argc, 0);
|
||||||
JANET_RETURN_CSYMBOL(args, ":posix");
|
(void) argv;
|
||||||
#endif
|
#ifdef JANET_WINDOWS
|
||||||
|
return janet_ckeywordv("windows");
|
||||||
|
#elif __APPLE__
|
||||||
|
return janet_ckeywordv("macos");
|
||||||
|
#elif defined(__EMSCRIPTEN__)
|
||||||
|
return janet_ckeywordv("web");
|
||||||
|
#else
|
||||||
|
return janet_ckeywordv("posix");
|
||||||
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet os_exit(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 0, 1);
|
||||||
|
if (argc == 0) {
|
||||||
|
exit(EXIT_SUCCESS);
|
||||||
|
} else if (janet_checkint(argv[0])) {
|
||||||
|
exit(janet_unwrap_integer(argv[0]));
|
||||||
|
} else {
|
||||||
|
exit(EXIT_FAILURE);
|
||||||
|
}
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef JANET_REDUCED_OS
|
||||||
|
/* Provide a dud os/getenv so init.janet works, but nothing else */
|
||||||
|
|
||||||
|
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||||
|
(void) argv;
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
#else
|
||||||
|
/* Provide full os functionality */
|
||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
static int os_execute(JanetArgs args) {
|
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||||
JANET_MINARITY(args, 1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetBuffer *buffer = janet_buffer(10);
|
JanetBuffer *buffer = janet_buffer(10);
|
||||||
for (int32_t i = 0; i < args.n; i++) {
|
for (int32_t i = 0; i < argc; i++) {
|
||||||
const uint8_t *argstring;
|
const uint8_t *argstring = janet_getstring(argv, i);
|
||||||
JANET_ARG_STRING(argstring, args, i);
|
|
||||||
janet_buffer_push_bytes(buffer, argstring, janet_string_length(argstring));
|
janet_buffer_push_bytes(buffer, argstring, janet_string_length(argstring));
|
||||||
if (i != args.n - 1) {
|
if (i != argc - 1) {
|
||||||
janet_buffer_push_u8(buffer, ' ');
|
janet_buffer_push_u8(buffer, ' ');
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -80,7 +126,7 @@ static int os_execute(JanetArgs args) {
|
|||||||
buffer->count);
|
buffer->count);
|
||||||
if (nwritten == 0) {
|
if (nwritten == 0) {
|
||||||
free(sys_str);
|
free(sys_str);
|
||||||
JANET_THROW(args, "could not create process");
|
janet_panic("could not create process");
|
||||||
}
|
}
|
||||||
|
|
||||||
STARTUPINFO si;
|
STARTUPINFO si;
|
||||||
@@ -91,7 +137,7 @@ static int os_execute(JanetArgs args) {
|
|||||||
ZeroMemory(&pi, sizeof(pi));
|
ZeroMemory(&pi, sizeof(pi));
|
||||||
|
|
||||||
// Start the child process.
|
// Start the child process.
|
||||||
if(!CreateProcess(NULL,
|
if (!CreateProcess(NULL,
|
||||||
(LPSTR) sys_str,
|
(LPSTR) sys_str,
|
||||||
NULL,
|
NULL,
|
||||||
NULL,
|
NULL,
|
||||||
@@ -102,7 +148,7 @@ static int os_execute(JanetArgs args) {
|
|||||||
&si,
|
&si,
|
||||||
&pi)) {
|
&pi)) {
|
||||||
free(sys_str);
|
free(sys_str);
|
||||||
JANET_THROW(args, "could not create process");
|
janet_panic("could not create process");
|
||||||
}
|
}
|
||||||
free(sys_str);
|
free(sys_str);
|
||||||
|
|
||||||
@@ -114,61 +160,58 @@ static int os_execute(JanetArgs args) {
|
|||||||
GetExitCodeProcess(pi.hProcess, (LPDWORD)&status);
|
GetExitCodeProcess(pi.hProcess, (LPDWORD)&status);
|
||||||
CloseHandle(pi.hProcess);
|
CloseHandle(pi.hProcess);
|
||||||
CloseHandle(pi.hThread);
|
CloseHandle(pi.hThread);
|
||||||
JANET_RETURN_INTEGER(args, (int32_t)status);
|
return janet_wrap_integer(status);
|
||||||
}
|
}
|
||||||
#else
|
#else
|
||||||
static int os_execute(JanetArgs args) {
|
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||||
JANET_MINARITY(args, 1);
|
janet_arity(argc, 1, -1);
|
||||||
const uint8_t **argv = malloc(sizeof(uint8_t *) * (args.n + 1));
|
const char **child_argv = malloc(sizeof(char *) * (argc + 1));
|
||||||
if (NULL == argv) {
|
int status = 0;
|
||||||
|
if (NULL == child_argv) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
for (int32_t i = 0; i < args.n; i++) {
|
for (int32_t i = 0; i < argc; i++) {
|
||||||
JANET_ARG_STRING(argv[i], args, i);
|
child_argv[i] = janet_getcstring(argv, i);
|
||||||
}
|
}
|
||||||
argv[args.n] = NULL;
|
child_argv[argc] = NULL;
|
||||||
|
|
||||||
/* Fork child process */
|
/* Fork child process */
|
||||||
pid_t pid = fork();
|
pid_t pid = fork();
|
||||||
if (pid < 0) {
|
if (pid < 0) {
|
||||||
JANET_THROW(args, "failed to execute");
|
janet_panic("failed to execute");
|
||||||
} else if (pid == 0) {
|
} else if (pid == 0) {
|
||||||
if (-1 == execve((const char *)argv[0], (char **)argv, NULL)) {
|
if (-1 == execve(child_argv[0], (char **)child_argv, NULL)) {
|
||||||
exit(1);
|
exit(1);
|
||||||
}
|
}
|
||||||
}
|
} else {
|
||||||
int status;
|
|
||||||
waitpid(pid, &status, 0);
|
waitpid(pid, &status, 0);
|
||||||
JANET_RETURN_INTEGER(args, status);
|
}
|
||||||
|
free(child_argv);
|
||||||
|
return janet_wrap_integer(status);
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
static int os_shell(JanetArgs args) {
|
static Janet os_shell(int32_t argc, Janet *argv) {
|
||||||
int nofirstarg = (args.n < 1 || !janet_checktype(args.v[0], JANET_STRING));
|
janet_arity(argc, 0, 1);
|
||||||
const char *cmd = nofirstarg
|
const char *cmd = argc
|
||||||
? NULL
|
? janet_getcstring(argv, 0)
|
||||||
: (const char *) janet_unwrap_string(args.v[0]);
|
: NULL;
|
||||||
int stat = system(cmd);
|
int stat = system(cmd);
|
||||||
JANET_RETURN(args, cmd
|
return argc
|
||||||
? janet_wrap_integer(stat)
|
? janet_wrap_integer(stat)
|
||||||
: janet_wrap_boolean(stat));
|
: janet_wrap_boolean(stat);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int os_getenv(JanetArgs args) {
|
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||||
const uint8_t *k;
|
janet_fixarity(argc, 1);
|
||||||
JANET_FIXARITY(args, 1);
|
const char *cstr = janet_getcstring(argv, 0);
|
||||||
JANET_ARG_STRING(k, args, 0);
|
|
||||||
const char *cstr = (const char *) k;
|
|
||||||
const char *res = getenv(cstr);
|
const char *res = getenv(cstr);
|
||||||
if (!res) {
|
return res
|
||||||
JANET_RETURN_NIL(args);
|
|
||||||
}
|
|
||||||
JANET_RETURN(args, cstr
|
|
||||||
? janet_cstringv(res)
|
? janet_cstringv(res)
|
||||||
: janet_wrap_nil());
|
: janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
static int os_setenv(JanetArgs args) {
|
static Janet os_setenv(int32_t argc, Janet *argv) {
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
#define SETENV(K,V) _putenv_s(K, V)
|
#define SETENV(K,V) _putenv_s(K, V)
|
||||||
#define UNSETENV(K) _putenv_s(K, "")
|
#define UNSETENV(K) _putenv_s(K, "")
|
||||||
@@ -176,46 +219,28 @@ static int os_setenv(JanetArgs args) {
|
|||||||
#define SETENV(K,V) setenv(K, V, 1)
|
#define SETENV(K,V) setenv(K, V, 1)
|
||||||
#define UNSETENV(K) unsetenv(K)
|
#define UNSETENV(K) unsetenv(K)
|
||||||
#endif
|
#endif
|
||||||
const uint8_t *k;
|
janet_arity(argc, 1, 2);
|
||||||
const char *ks;
|
const char *ks = janet_getcstring(argv, 0);
|
||||||
JANET_MAXARITY(args, 2);
|
if (argc == 1 || janet_checktype(argv[1], JANET_NIL)) {
|
||||||
JANET_MINARITY(args, 1);
|
|
||||||
JANET_ARG_STRING(k, args, 0);
|
|
||||||
ks = (const char *) k;
|
|
||||||
if (args.n == 1 || janet_checktype(args.v[1], JANET_NIL)) {
|
|
||||||
UNSETENV(ks);
|
UNSETENV(ks);
|
||||||
} else {
|
} else {
|
||||||
const uint8_t *v;
|
SETENV(ks, janet_getcstring(argv, 1));
|
||||||
JANET_ARG_STRING(v, args, 1);
|
|
||||||
const char *vc = (const char *) v;
|
|
||||||
SETENV(ks, vc);
|
|
||||||
}
|
}
|
||||||
return 0;
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
static int os_exit(JanetArgs args) {
|
static Janet os_time(int32_t argc, Janet *argv) {
|
||||||
JANET_MAXARITY(args, 1);
|
janet_fixarity(argc, 0);
|
||||||
if (args.n == 0) {
|
(void) argv;
|
||||||
exit(EXIT_SUCCESS);
|
|
||||||
} else if (janet_checktype(args.v[0], JANET_INTEGER)) {
|
|
||||||
exit(janet_unwrap_integer(args.v[0]));
|
|
||||||
} else {
|
|
||||||
exit(EXIT_FAILURE);
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
static int os_time(JanetArgs args) {
|
|
||||||
JANET_FIXARITY(args, 0);
|
|
||||||
double dtime = (double)(time(NULL));
|
double dtime = (double)(time(NULL));
|
||||||
JANET_RETURN_REAL(args, dtime);
|
return janet_wrap_number(dtime);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Clock shims */
|
/* Clock shims */
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
static int gettime(struct timespec *spec) {
|
static int gettime(struct timespec *spec) {
|
||||||
int64_t wintime = 0LL;
|
int64_t wintime = 0LL;
|
||||||
GetSystemTimeAsFileTime((FILETIME*)&wintime);
|
GetSystemTimeAsFileTime((FILETIME *)&wintime);
|
||||||
/* Windows epoch is January 1, 1601 apparently*/
|
/* Windows epoch is January 1, 1601 apparently*/
|
||||||
wintime -= 116444736000000000LL;
|
wintime -= 116444736000000000LL;
|
||||||
spec->tv_sec = wintime / 10000000LL;
|
spec->tv_sec = wintime / 10000000LL;
|
||||||
@@ -238,24 +263,21 @@ static int gettime(struct timespec *spec) {
|
|||||||
#define gettime(TV) clock_gettime(CLOCK_MONOTONIC, (TV))
|
#define gettime(TV) clock_gettime(CLOCK_MONOTONIC, (TV))
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
static int os_clock(JanetArgs args) {
|
static Janet os_clock(int32_t argc, Janet *argv) {
|
||||||
JANET_FIXARITY(args, 0);
|
janet_fixarity(argc, 0);
|
||||||
|
(void) argv;
|
||||||
struct timespec tv;
|
struct timespec tv;
|
||||||
if (gettime(&tv))
|
if (gettime(&tv)) janet_panic("could not get time");
|
||||||
JANET_THROW(args, "could not get time");
|
|
||||||
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
|
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
|
||||||
JANET_RETURN_REAL(args, dtime);
|
return janet_wrap_number(dtime);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int os_sleep(JanetArgs args) {
|
static Janet os_sleep(int32_t argc, Janet *argv) {
|
||||||
double delay;
|
janet_fixarity(argc, 1);
|
||||||
JANET_FIXARITY(args, 1);
|
double delay = janet_getnumber(argv, 0);
|
||||||
JANET_ARG_NUMBER(delay, args, 0);
|
if (delay < 0) janet_panic("invalid argument to sleep");
|
||||||
if (delay < 0) {
|
|
||||||
JANET_THROW(args, "invalid argument to sleep");
|
|
||||||
}
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
Sleep((DWORD) (delay * 1000));
|
Sleep((DWORD)(delay * 1000));
|
||||||
#else
|
#else
|
||||||
struct timespec ts;
|
struct timespec ts;
|
||||||
ts.tv_sec = (time_t) delay;
|
ts.tv_sec = (time_t) delay;
|
||||||
@@ -264,11 +286,12 @@ static int os_sleep(JanetArgs args) {
|
|||||||
: 0;
|
: 0;
|
||||||
nanosleep(&ts, NULL);
|
nanosleep(&ts, NULL);
|
||||||
#endif
|
#endif
|
||||||
return 0;
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
static int os_cwd(JanetArgs args) {
|
static Janet os_cwd(int32_t argc, Janet *argv) {
|
||||||
JANET_FIXARITY(args, 0);
|
janet_fixarity(argc, 0);
|
||||||
|
(void) argv;
|
||||||
char buf[FILENAME_MAX];
|
char buf[FILENAME_MAX];
|
||||||
char *ptr;
|
char *ptr;
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
@@ -276,68 +299,454 @@ static int os_cwd(JanetArgs args) {
|
|||||||
#else
|
#else
|
||||||
ptr = getcwd(buf, FILENAME_MAX);
|
ptr = getcwd(buf, FILENAME_MAX);
|
||||||
#endif
|
#endif
|
||||||
if (NULL == ptr) {
|
if (NULL == ptr) janet_panic("could not get current directory");
|
||||||
JANET_THROW(args, "could not get current directory");
|
return janet_cstringv(ptr);
|
||||||
}
|
|
||||||
JANET_RETURN_CSTRING(args, ptr);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static Janet os_date(int32_t argc, Janet *argv) {
|
||||||
{"os/which", os_which,
|
janet_arity(argc, 0, 1);
|
||||||
"(os/which)\n\n"
|
(void) argv;
|
||||||
|
time_t t;
|
||||||
|
struct tm *t_info;
|
||||||
|
if (argc) {
|
||||||
|
t = (time_t) janet_getinteger64(argv, 0);
|
||||||
|
} else {
|
||||||
|
time(&t);
|
||||||
|
}
|
||||||
|
t_info = localtime(&t);
|
||||||
|
JanetKV *st = janet_struct_begin(9);
|
||||||
|
janet_struct_put(st, janet_ckeywordv("seconds"), janet_wrap_number(t_info->tm_sec));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("minutes"), janet_wrap_number(t_info->tm_min));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("hours"), janet_wrap_number(t_info->tm_hour));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("month-day"), janet_wrap_number(t_info->tm_mday - 1));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("month"), janet_wrap_number(t_info->tm_mon));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("year"), janet_wrap_number(t_info->tm_year + 1900));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("week-day"), janet_wrap_number(t_info->tm_wday));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("year-day"), janet_wrap_number(t_info->tm_yday));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("dst"), janet_wrap_boolean(t_info->tm_isdst));
|
||||||
|
return janet_wrap_struct(janet_struct_end(st));
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_link(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 2, 3);
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
(void) argc;
|
||||||
|
(void) argv;
|
||||||
|
janet_panic("os/link not supported on Windows");
|
||||||
|
return janet_wrap_nil();
|
||||||
|
#else
|
||||||
|
const char *oldpath = janet_getcstring(argv, 0);
|
||||||
|
const char *newpath = janet_getcstring(argv, 1);
|
||||||
|
int res = ((argc == 3 && janet_getboolean(argv, 2)) ? symlink : link)(oldpath, newpath);
|
||||||
|
if (res == -1) janet_panic(strerror(errno));
|
||||||
|
return janet_wrap_integer(res);
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_mkdir(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
const char *path = janet_getcstring(argv, 0);
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
int res = _mkdir(path);
|
||||||
|
#else
|
||||||
|
int res = mkdir(path, S_IRUSR | S_IWUSR | S_IXUSR | S_IRGRP | S_IWGRP | S_IXGRP | S_IROTH | S_IXOTH);
|
||||||
|
#endif
|
||||||
|
return janet_wrap_boolean(res != -1);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_rmdir(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
const char *path = janet_getcstring(argv, 0);
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
int res = _rmdir(path);
|
||||||
|
#else
|
||||||
|
int res = rmdir(path);
|
||||||
|
#endif
|
||||||
|
if (res == -1) janet_panic(strerror(errno));
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_cd(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
const char *path = janet_getcstring(argv, 0);
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
int res = _chdir(path);
|
||||||
|
#else
|
||||||
|
int res = chdir(path);
|
||||||
|
#endif
|
||||||
|
if (res == -1) janet_panic(strerror(errno));
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_touch(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 3);
|
||||||
|
const char *path = janet_getcstring(argv, 0);
|
||||||
|
struct utimbuf timebuf, *bufp;
|
||||||
|
if (argc >= 2) {
|
||||||
|
bufp = &timebuf;
|
||||||
|
timebuf.actime = (time_t) janet_getnumber(argv, 1);
|
||||||
|
if (argc >= 3) {
|
||||||
|
timebuf.modtime = (time_t) janet_getnumber(argv, 2);
|
||||||
|
} else {
|
||||||
|
timebuf.modtime = timebuf.actime;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
bufp = NULL;
|
||||||
|
}
|
||||||
|
int res = utime(path, bufp);
|
||||||
|
if (-1 == res) janet_panic(strerror(errno));
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_remove(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
const char *path = janet_getcstring(argv, 0);
|
||||||
|
int status = remove(path);
|
||||||
|
if (-1 == status) janet_panic(strerror(errno));
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
static const uint8_t *janet_decode_permissions(unsigned short m) {
|
||||||
|
uint8_t flags[9] = {0};
|
||||||
|
flags[0] = flags[3] = flags[6] = (m & S_IREAD) ? 'r' : '-';
|
||||||
|
flags[1] = flags[4] = flags[7] = (m & S_IWRITE) ? 'w' : '-';
|
||||||
|
flags[2] = flags[5] = flags[8] = (m & S_IEXEC) ? 'x' : '-';
|
||||||
|
return janet_string(flags, sizeof(flags));
|
||||||
|
}
|
||||||
|
|
||||||
|
static const uint8_t *janet_decode_mode(unsigned short m) {
|
||||||
|
const char *str = "other";
|
||||||
|
if (m & _S_IFREG) str = "file";
|
||||||
|
else if (m & _S_IFDIR) str = "directory";
|
||||||
|
else if (m & _S_IFCHR) str = "character";
|
||||||
|
return janet_ckeyword(str);
|
||||||
|
}
|
||||||
|
#else
|
||||||
|
static const uint8_t *janet_decode_permissions(mode_t m) {
|
||||||
|
uint8_t flags[9] = {0};
|
||||||
|
flags[0] = (m & S_IRUSR) ? 'r' : '-';
|
||||||
|
flags[1] = (m & S_IWUSR) ? 'w' : '-';
|
||||||
|
flags[2] = (m & S_IXUSR) ? 'x' : '-';
|
||||||
|
flags[3] = (m & S_IRGRP) ? 'r' : '-';
|
||||||
|
flags[4] = (m & S_IWGRP) ? 'w' : '-';
|
||||||
|
flags[5] = (m & S_IXGRP) ? 'x' : '-';
|
||||||
|
flags[6] = (m & S_IROTH) ? 'r' : '-';
|
||||||
|
flags[7] = (m & S_IWOTH) ? 'w' : '-';
|
||||||
|
flags[8] = (m & S_IXOTH) ? 'x' : '-';
|
||||||
|
return janet_string(flags, sizeof(flags));
|
||||||
|
}
|
||||||
|
|
||||||
|
static const uint8_t *janet_decode_mode(mode_t m) {
|
||||||
|
const char *str = "other";
|
||||||
|
if (S_ISREG(m)) str = "file";
|
||||||
|
else if (S_ISDIR(m)) str = "directory";
|
||||||
|
else if (S_ISFIFO(m)) str = "fifo";
|
||||||
|
else if (S_ISBLK(m)) str = "block";
|
||||||
|
else if (S_ISSOCK(m)) str = "socket";
|
||||||
|
else if (S_ISLNK(m)) str = "link";
|
||||||
|
else if (S_ISCHR(m)) str = "character";
|
||||||
|
return janet_ckeyword(str);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Can we do this? */
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
#define stat _stat
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Getters */
|
||||||
|
static Janet os_stat_dev(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_dev);
|
||||||
|
}
|
||||||
|
static Janet os_stat_inode(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_ino);
|
||||||
|
}
|
||||||
|
static Janet os_stat_mode(struct stat *st) {
|
||||||
|
return janet_wrap_keyword(janet_decode_mode(st->st_mode));
|
||||||
|
}
|
||||||
|
static Janet os_stat_permissions(struct stat *st) {
|
||||||
|
return janet_wrap_string(janet_decode_permissions(st->st_mode));
|
||||||
|
}
|
||||||
|
static Janet os_stat_uid(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_uid);
|
||||||
|
}
|
||||||
|
static Janet os_stat_gid(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_gid);
|
||||||
|
}
|
||||||
|
static Janet os_stat_nlink(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_nlink);
|
||||||
|
}
|
||||||
|
static Janet os_stat_rdev(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_rdev);
|
||||||
|
}
|
||||||
|
static Janet os_stat_size(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_size);
|
||||||
|
}
|
||||||
|
static Janet os_stat_accessed(struct stat *st) {
|
||||||
|
return janet_wrap_number((double) st->st_atime);
|
||||||
|
}
|
||||||
|
static Janet os_stat_modified(struct stat *st) {
|
||||||
|
return janet_wrap_number((double) st->st_mtime);
|
||||||
|
}
|
||||||
|
static Janet os_stat_changed(struct stat *st) {
|
||||||
|
return janet_wrap_number((double) st->st_ctime);
|
||||||
|
}
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
static Janet os_stat_blocks(struct stat *st) {
|
||||||
|
return janet_wrap_number(0);
|
||||||
|
}
|
||||||
|
static Janet os_stat_blocksize(struct stat *st) {
|
||||||
|
return janet_wrap_number(0);
|
||||||
|
}
|
||||||
|
#else
|
||||||
|
static Janet os_stat_blocks(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_blocks);
|
||||||
|
}
|
||||||
|
static Janet os_stat_blocksize(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_blksize);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
struct OsStatGetter {
|
||||||
|
const char *name;
|
||||||
|
Janet(*fn)(struct stat *st);
|
||||||
|
};
|
||||||
|
|
||||||
|
static const struct OsStatGetter os_stat_getters[] = {
|
||||||
|
{"dev", os_stat_dev},
|
||||||
|
{"inode", os_stat_inode},
|
||||||
|
{"mode", os_stat_mode},
|
||||||
|
{"permissions", os_stat_permissions},
|
||||||
|
{"uid", os_stat_uid},
|
||||||
|
{"gid", os_stat_gid},
|
||||||
|
{"nlink", os_stat_nlink},
|
||||||
|
{"rdev", os_stat_rdev},
|
||||||
|
{"size", os_stat_size},
|
||||||
|
{"blocks", os_stat_blocks},
|
||||||
|
{"blocksize", os_stat_blocksize},
|
||||||
|
{"accessed", os_stat_accessed},
|
||||||
|
{"modified", os_stat_modified},
|
||||||
|
{"changed", os_stat_changed},
|
||||||
|
{NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
static Janet os_stat(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 2);
|
||||||
|
const char *path = janet_getcstring(argv, 0);
|
||||||
|
JanetTable *tab = NULL;
|
||||||
|
int getall = 1;
|
||||||
|
const uint8_t *key;
|
||||||
|
if (argc == 2) {
|
||||||
|
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||||
|
getall = 0;
|
||||||
|
key = janet_getkeyword(argv, 1);
|
||||||
|
} else {
|
||||||
|
tab = janet_gettable(argv, 1);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
tab = janet_table(0);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Build result */
|
||||||
|
struct stat st;
|
||||||
|
int res = stat(path, &st);
|
||||||
|
if (-1 == res) {
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
if (getall) {
|
||||||
|
/* Put results in table */
|
||||||
|
for (const struct OsStatGetter *sg = os_stat_getters; sg->name != NULL; sg++) {
|
||||||
|
janet_table_put(tab, janet_ckeywordv(sg->name), sg->fn(&st));
|
||||||
|
}
|
||||||
|
return janet_wrap_table(tab);
|
||||||
|
} else {
|
||||||
|
/* Get one result */
|
||||||
|
for (const struct OsStatGetter *sg = os_stat_getters; sg->name != NULL; sg++) {
|
||||||
|
if (janet_cstrcmp(key, sg->name)) continue;
|
||||||
|
return sg->fn(&st);
|
||||||
|
}
|
||||||
|
janet_panicf("unexpected keyword %v", janet_wrap_keyword(key));
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_dir(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 2);
|
||||||
|
const char *dir = janet_getcstring(argv, 0);
|
||||||
|
JanetArray *paths = (argc == 2) ? janet_getarray(argv, 1) : janet_array(0);
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
/* Read directory items with FindFirstFile / FindNextFile / FindClose */
|
||||||
|
struct _finddata_t afile;
|
||||||
|
char pattern[MAX_PATH + 1];
|
||||||
|
if (strlen(dir) > (sizeof(pattern) - 3))
|
||||||
|
janet_panicf("path too long: %s", dir);
|
||||||
|
sprintf(pattern, "%s/*", dir);
|
||||||
|
intptr_t res = _findfirst(pattern, &afile);
|
||||||
|
if (-1 == res) janet_panicv(janet_cstringv(strerror(errno)));
|
||||||
|
do {
|
||||||
|
if (strcmp(".", afile.name) && strcmp("..", afile.name)) {
|
||||||
|
janet_array_push(paths, janet_cstringv(afile.name));
|
||||||
|
}
|
||||||
|
} while (_findnext(res, &afile) != -1);
|
||||||
|
_findclose(res);
|
||||||
|
#else
|
||||||
|
/* Read directory items with opendir / readdir / closedir */
|
||||||
|
struct dirent *dp;
|
||||||
|
DIR *dfd = opendir(dir);
|
||||||
|
if (dfd == NULL) janet_panicf("cannot open directory %s", dir);
|
||||||
|
while ((dp = readdir(dfd)) != NULL) {
|
||||||
|
if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) {
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
janet_array_push(paths, janet_cstringv(dp->d_name));
|
||||||
|
}
|
||||||
|
closedir(dfd);
|
||||||
|
#endif
|
||||||
|
return janet_wrap_array(paths);
|
||||||
|
}
|
||||||
|
|
||||||
|
#endif /* JANET_REDUCED_OS */
|
||||||
|
|
||||||
|
static const JanetReg os_cfuns[] = {
|
||||||
|
{
|
||||||
|
"os/exit", os_exit,
|
||||||
|
JDOC("(os/exit x)\n\n"
|
||||||
|
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||||
|
"the exit with status equal the hash of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/which", os_which,
|
||||||
|
JDOC("(os/which)\n\n"
|
||||||
"Check the current operating system. Returns one of:\n\n"
|
"Check the current operating system. Returns one of:\n\n"
|
||||||
"\t:windows - Microsoft Windows\n"
|
"\t:windows - Microsoft Windows\n"
|
||||||
"\t:macos - Apple macos\n"
|
"\t:macos - Apple macos\n"
|
||||||
"\t:posix - A POSIX compatible system (default)"
|
"\t:posix - A POSIX compatible system (default)")
|
||||||
},
|
},
|
||||||
{"os/execute", os_execute,
|
{
|
||||||
"(os/execute program & args)\n\n"
|
"os/getenv", os_getenv,
|
||||||
|
JDOC("(os/getenv variable)\n\n"
|
||||||
|
"Get the string value of an environment variable.")
|
||||||
|
},
|
||||||
|
#ifndef JANET_REDUCED_OS
|
||||||
|
{
|
||||||
|
"os/dir", os_dir,
|
||||||
|
JDOC("(os/dir dir [, array])\n\n"
|
||||||
|
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
|
||||||
|
"with only the filename or directory name and no prefix.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/stat", os_stat,
|
||||||
|
JDOC("(os/stat path [, tab|key])\n\n"
|
||||||
|
"Gets information about a file or directory. Returns a table If the third argument is a keyword, returns "
|
||||||
|
" only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n"
|
||||||
|
"\t:dev - the device that the file is on\n"
|
||||||
|
"\t:mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n"
|
||||||
|
"\t:permissions - A unix permission string like \"rwx--x--x\"\n"
|
||||||
|
"\t:uid - File uid\n"
|
||||||
|
"\t:gid - File gid\n"
|
||||||
|
"\t:nlink - number of links to file\n"
|
||||||
|
"\t:rdev - Real device of file. 0 on windows.\n"
|
||||||
|
"\t:size - size of file in bytes\n"
|
||||||
|
"\t:blocks - number of blocks in file. 0 on windows\n"
|
||||||
|
"\t:blocksize - size of blocks in file. 0 on windows\n"
|
||||||
|
"\t:accessed - timestamp when file last accessed\n"
|
||||||
|
"\t:changed - timestamp when file last chnaged (permissions changed)\n"
|
||||||
|
"\t:modified - timestamp when file last modified (content changed)\n")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/touch", os_touch,
|
||||||
|
JDOC("(os/touch path [, actime [, modtime]])\n\n"
|
||||||
|
"Update the access time and modification times for a file. By default, sets "
|
||||||
|
"times to the current time.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/cd", os_cd,
|
||||||
|
JDOC("(os/cd path)\n\n"
|
||||||
|
"Change current directory to path. Returns true on success, false on failure.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/mkdir", os_mkdir,
|
||||||
|
JDOC("(os/mkdir path)\n\n"
|
||||||
|
"Create a new directory. The path will be relative to the current directory if relative, otherwise "
|
||||||
|
"it will be an absolute path.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/rmdir", os_rmdir,
|
||||||
|
JDOC("(os/rmdir path)\n\n"
|
||||||
|
"Delete a directory. The directory must be empty to succeed.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/rm", os_remove,
|
||||||
|
JDOC("(os/rm path)\n\n"
|
||||||
|
"Delete a file. Returns nil.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/link", os_link,
|
||||||
|
JDOC("(os/link oldpath newpath [, symlink])\n\n"
|
||||||
|
"Create a symlink from oldpath to newpath. The 3 optional paramater "
|
||||||
|
"enables a hard link over a soft link. Does not work on Windows.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/execute", os_execute,
|
||||||
|
JDOC("(os/execute program & args)\n\n"
|
||||||
"Execute a program on the system and pass it string arguments. Returns "
|
"Execute a program on the system and pass it string arguments. Returns "
|
||||||
"the exit status of the program."
|
"the exit status of the program.")
|
||||||
},
|
},
|
||||||
{"os/shell", os_shell,
|
{
|
||||||
"(os/shell str)\n\n"
|
"os/shell", os_shell,
|
||||||
"Pass a command string str directly to the system shell."
|
JDOC("(os/shell str)\n\n"
|
||||||
|
"Pass a command string str directly to the system shell.")
|
||||||
},
|
},
|
||||||
{"os/exit", os_exit,
|
{
|
||||||
"(os/exit x)\n\n"
|
"os/setenv", os_setenv,
|
||||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
JDOC("(os/setenv variable value)\n\n"
|
||||||
"the exit with status equal the hash of x."
|
"Set an environment variable.")
|
||||||
},
|
},
|
||||||
{"os/getenv", os_getenv,
|
{
|
||||||
"(os/getenv variable)\n\n"
|
"os/time", os_time,
|
||||||
"Get the string value of an environment variable."
|
JDOC("(os/time)\n\n"
|
||||||
},
|
|
||||||
{"os/setenv", os_setenv,
|
|
||||||
"(os/setenv variable value)\n\n"
|
|
||||||
"Set an environment variable."
|
|
||||||
},
|
|
||||||
{"os/time", os_time,
|
|
||||||
"(os/time)\n\n"
|
|
||||||
"Get the current time expressed as the number of seconds since "
|
"Get the current time expressed as the number of seconds since "
|
||||||
"January 1, 1970, the Unix epoch. Returns a real number."
|
"January 1, 1970, the Unix epoch. Returns a real number.")
|
||||||
},
|
},
|
||||||
{"os/clock", os_clock,
|
{
|
||||||
"(os/clock)\n\n"
|
"os/clock", os_clock,
|
||||||
|
JDOC("(os/clock)\n\n"
|
||||||
"Return the number of seconds since some fixed point in time. The clock "
|
"Return the number of seconds since some fixed point in time. The clock "
|
||||||
"is guaranteed to be non decreased in real time."
|
"is guaranteed to be non decreasing in real time.")
|
||||||
},
|
},
|
||||||
{"os/sleep", os_sleep,
|
{
|
||||||
"(os/sleep nsec)\n\n"
|
"os/sleep", os_sleep,
|
||||||
|
JDOC("(os/sleep nsec)\n\n"
|
||||||
"Suspend the program for nsec seconds. 'nsec' can be a real number. Returns "
|
"Suspend the program for nsec seconds. 'nsec' can be a real number. Returns "
|
||||||
"nil."
|
"nil.")
|
||||||
|
|
||||||
},
|
},
|
||||||
{"os/cwd", os_cwd,
|
{
|
||||||
"(os/cwd)\n\n"
|
"os/cwd", os_cwd,
|
||||||
"Returns the current working directory."
|
JDOC("(os/cwd)\n\n"
|
||||||
|
"Returns the current working directory.")
|
||||||
},
|
},
|
||||||
|
{
|
||||||
|
"os/date", os_date,
|
||||||
|
JDOC("(os/date [,time])\n\n"
|
||||||
|
"Returns the given time as a date struct, or the current time if no time is given. "
|
||||||
|
"Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
|
||||||
|
"\t:seconds - number of seconds [0-61]\n"
|
||||||
|
"\t:minutes - number of minutes [0-59]\n"
|
||||||
|
"\t:hours - number of hours [0-23]\n"
|
||||||
|
"\t:month-day - day of month [0-30]\n"
|
||||||
|
"\t:month - month of year [0, 11]\n"
|
||||||
|
"\t:year - years since year 0 (e.g. 2019)\n"
|
||||||
|
"\t:week-day - day of the week [0-6]\n"
|
||||||
|
"\t:year-day - day of the year [0-365]\n"
|
||||||
|
"\t:dst - If Day Light Savings is in effect")
|
||||||
|
},
|
||||||
|
#endif
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
int janet_lib_os(JanetArgs args) {
|
void janet_lib_os(JanetTable *env) {
|
||||||
JanetTable *env = janet_env(args);
|
janet_core_cfuns(env, NULL, os_cfuns);
|
||||||
janet_cfuns(env, NULL, cfuns);
|
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|||||||
580
src/core/parse.c
580
src/core/parse.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,7 +20,10 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Check if a character is whitespace */
|
/* Check if a character is whitespace */
|
||||||
static int is_whitespace(uint8_t c) {
|
static int is_whitespace(uint8_t c) {
|
||||||
@@ -29,6 +32,7 @@ static int is_whitespace(uint8_t c) {
|
|||||||
|| c == '\n'
|
|| c == '\n'
|
||||||
|| c == '\r'
|
|| c == '\r'
|
||||||
|| c == '\0'
|
|| c == '\0'
|
||||||
|
|| c == '\v'
|
||||||
|| c == '\f';
|
|| c == '\f';
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -45,11 +49,11 @@ static const uint32_t symchars[8] = {
|
|||||||
/* Check if a character is a valid symbol character
|
/* Check if a character is a valid symbol character
|
||||||
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_~| */
|
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_~| */
|
||||||
static int is_symbol_char(uint8_t c) {
|
static int is_symbol_char(uint8_t c) {
|
||||||
return symchars[c >> 5] & (1 << (c & 0x1F));
|
return symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Validate some utf8. Useful for identifiers. Only validates
|
/* Validate some utf8. Useful for identifiers. Only validates
|
||||||
* the encoding, does not check for valid codepoints (they
|
* the encoding, does not check for valid code points (they
|
||||||
* are less well defined than the encoding). */
|
* are less well defined than the encoding). */
|
||||||
static int valid_utf8(const uint8_t *str, int32_t len) {
|
static int valid_utf8(const uint8_t *str, int32_t len) {
|
||||||
int32_t i = 0;
|
int32_t i = 0;
|
||||||
@@ -74,7 +78,7 @@ static int valid_utf8(const uint8_t *str, int32_t len) {
|
|||||||
if ((str[j] >> 6) != 2) return 0;
|
if ((str[j] >> 6) != 2) return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Check for overlong encodings */
|
/* Check for overlong encoding */
|
||||||
if ((nexti == i + 2) && str[i] < 0xC2) return 0;
|
if ((nexti == i + 2) && str[i] < 0xC2) return 0;
|
||||||
if ((str[i] == 0xE0) && str[i + 1] < 0xA0) return 0;
|
if ((str[i] == 0xE0) && str[i + 1] < 0xA0) return 0;
|
||||||
if ((str[i] == 0xF0) && str[i + 1] < 0x90) return 0;
|
if ((str[i] == 0xF0) && str[i + 1] < 0x90) return 0;
|
||||||
@@ -102,8 +106,7 @@ struct JanetParseState {
|
|||||||
int32_t counter;
|
int32_t counter;
|
||||||
int32_t argn;
|
int32_t argn;
|
||||||
int flags;
|
int flags;
|
||||||
size_t start_line;
|
size_t start;
|
||||||
size_t start_col;
|
|
||||||
Consumer consumer;
|
Consumer consumer;
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -140,6 +143,7 @@ DEF_PARSER_STACK(_pushstate, JanetParseState, states, statecount, statecap)
|
|||||||
#define PFLAG_STRING 0x2000
|
#define PFLAG_STRING 0x2000
|
||||||
#define PFLAG_LONGSTRING 0x4000
|
#define PFLAG_LONGSTRING 0x4000
|
||||||
#define PFLAG_READERMAC 0x8000
|
#define PFLAG_READERMAC 0x8000
|
||||||
|
#define PFLAG_ATSYM 0x10000
|
||||||
|
|
||||||
static void pushstate(JanetParser *p, Consumer consumer, int flags) {
|
static void pushstate(JanetParser *p, Consumer consumer, int flags) {
|
||||||
JanetParseState s;
|
JanetParseState s;
|
||||||
@@ -147,8 +151,7 @@ static void pushstate(JanetParser *p, Consumer consumer, int flags) {
|
|||||||
s.argn = 0;
|
s.argn = 0;
|
||||||
s.flags = flags;
|
s.flags = flags;
|
||||||
s.consumer = consumer;
|
s.consumer = consumer;
|
||||||
s.start_line = p->line;
|
s.start = p->offset;
|
||||||
s.start_col = p->col;
|
|
||||||
_pushstate(p, s);
|
_pushstate(p, s);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -159,10 +162,12 @@ static void popstate(JanetParser *p, Janet val) {
|
|||||||
if (newtop->flags & PFLAG_CONTAINER) {
|
if (newtop->flags & PFLAG_CONTAINER) {
|
||||||
/* Source mapping info */
|
/* Source mapping info */
|
||||||
if (janet_checktype(val, JANET_TUPLE)) {
|
if (janet_checktype(val, JANET_TUPLE)) {
|
||||||
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.start_line;
|
janet_tuple_sm_start(janet_unwrap_tuple(val)) = (int32_t) top.start;
|
||||||
janet_tuple_sm_col(janet_unwrap_tuple(val)) = (int32_t) top.start_col;
|
janet_tuple_sm_end(janet_unwrap_tuple(val)) = (int32_t) p->offset;
|
||||||
}
|
}
|
||||||
newtop->argn++;
|
newtop->argn++;
|
||||||
|
/* Keep track of number of values in the root state */
|
||||||
|
if (p->statecount == 1) p->pending++;
|
||||||
push_arg(p, val);
|
push_arg(p, val);
|
||||||
return;
|
return;
|
||||||
} else if (newtop->flags & PFLAG_READERMAC) {
|
} else if (newtop->flags & PFLAG_READERMAC) {
|
||||||
@@ -176,8 +181,8 @@ static void popstate(JanetParser *p, Janet val) {
|
|||||||
t[0] = janet_csymbolv(which);
|
t[0] = janet_csymbolv(which);
|
||||||
t[1] = val;
|
t[1] = val;
|
||||||
/* Quote source mapping info */
|
/* Quote source mapping info */
|
||||||
janet_tuple_sm_line(t) = (int32_t) newtop->start_line;
|
janet_tuple_sm_start(t) = (int32_t) newtop->start;
|
||||||
janet_tuple_sm_col(t) = (int32_t) newtop->start_col;
|
janet_tuple_sm_end(t) = (int32_t) p->offset;
|
||||||
val = janet_wrap_tuple(janet_tuple_end(t));
|
val = janet_wrap_tuple(janet_tuple_end(t));
|
||||||
} else {
|
} else {
|
||||||
return;
|
return;
|
||||||
@@ -187,17 +192,30 @@ static void popstate(JanetParser *p, Janet val) {
|
|||||||
|
|
||||||
static int checkescape(uint8_t c) {
|
static int checkescape(uint8_t c) {
|
||||||
switch (c) {
|
switch (c) {
|
||||||
default: return -1;
|
default:
|
||||||
case 'x': return 1;
|
return -1;
|
||||||
case 'n': return '\n';
|
case 'x':
|
||||||
case 't': return '\t';
|
return 1;
|
||||||
case 'r': return '\r';
|
case 'n':
|
||||||
case '0': return '\0';
|
return '\n';
|
||||||
case 'z': return '\0';
|
case 't':
|
||||||
case 'f': return '\f';
|
return '\t';
|
||||||
case 'e': return 27;
|
case 'r':
|
||||||
case '"': return '"';
|
return '\r';
|
||||||
case '\\': return '\\';
|
case '0':
|
||||||
|
return '\0';
|
||||||
|
case 'z':
|
||||||
|
return '\0';
|
||||||
|
case 'f':
|
||||||
|
return '\f';
|
||||||
|
case 'v':
|
||||||
|
return '\v';
|
||||||
|
case 'e':
|
||||||
|
return 27;
|
||||||
|
case '"':
|
||||||
|
return '"';
|
||||||
|
case '\\':
|
||||||
|
return '\\';
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -239,12 +257,24 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
|
|
||||||
static int stringend(JanetParser *p, JanetParseState *state) {
|
static int stringend(JanetParser *p, JanetParseState *state) {
|
||||||
Janet ret;
|
Janet ret;
|
||||||
|
uint8_t *bufstart = p->buf;
|
||||||
|
int32_t buflen = (int32_t) p->bufcount;
|
||||||
|
if (state->flags & PFLAG_LONGSTRING) {
|
||||||
|
/* Check for leading newline character so we can remove it */
|
||||||
|
if (bufstart[0] == '\n') {
|
||||||
|
bufstart++;
|
||||||
|
buflen--;
|
||||||
|
}
|
||||||
|
if (buflen > 0 && bufstart[buflen - 1] == '\n') {
|
||||||
|
buflen--;
|
||||||
|
}
|
||||||
|
}
|
||||||
if (state->flags & PFLAG_BUFFER) {
|
if (state->flags & PFLAG_BUFFER) {
|
||||||
JanetBuffer *b = janet_buffer((int32_t)p->bufcount);
|
JanetBuffer *b = janet_buffer(buflen);
|
||||||
janet_buffer_push_bytes(b, p->buf, (int32_t)p->bufcount);
|
janet_buffer_push_bytes(b, bufstart, buflen);
|
||||||
ret = janet_wrap_buffer(b);
|
ret = janet_wrap_buffer(b);
|
||||||
} else {
|
} else {
|
||||||
ret = janet_wrap_string(janet_string(p->buf, (int32_t)p->bufcount));
|
ret = janet_wrap_string(janet_string(bufstart, buflen));
|
||||||
}
|
}
|
||||||
p->bufcount = 0;
|
p->bufcount = 0;
|
||||||
popstate(p, ret);
|
popstate(p, ret);
|
||||||
@@ -281,7 +311,8 @@ static int check_str_const(const char *cstr, const uint8_t *str, int32_t len) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||||
Janet numcheck, ret;
|
Janet ret;
|
||||||
|
double numval;
|
||||||
int32_t blen;
|
int32_t blen;
|
||||||
if (is_symbol_char(c)) {
|
if (is_symbol_char(c)) {
|
||||||
push_buf(p, (uint8_t) c);
|
push_buf(p, (uint8_t) c);
|
||||||
@@ -290,9 +321,12 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
}
|
}
|
||||||
/* Token finished */
|
/* Token finished */
|
||||||
blen = (int32_t) p->bufcount;
|
blen = (int32_t) p->bufcount;
|
||||||
numcheck = janet_scan_number(p->buf, blen);
|
int start_dig = p->buf[0] >= '0' && p->buf[0] <= '9';
|
||||||
if (!janet_checktype(numcheck, JANET_NIL)) {
|
int start_num = start_dig || p->buf[0] == '-' || p->buf[0] == '+' || p->buf[0] == '.';
|
||||||
ret = numcheck;
|
if (p->buf[0] == ':') {
|
||||||
|
ret = janet_keywordv(p->buf + 1, blen - 1);
|
||||||
|
} else if (start_num && !janet_scan_number(p->buf, blen, &numval)) {
|
||||||
|
ret = janet_wrap_number(numval);
|
||||||
} else if (!check_str_const("nil", p->buf, blen)) {
|
} else if (!check_str_const("nil", p->buf, blen)) {
|
||||||
ret = janet_wrap_nil();
|
ret = janet_wrap_nil();
|
||||||
} else if (!check_str_const("false", p->buf, blen)) {
|
} else if (!check_str_const("false", p->buf, blen)) {
|
||||||
@@ -300,11 +334,11 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
} else if (!check_str_const("true", p->buf, blen)) {
|
} else if (!check_str_const("true", p->buf, blen)) {
|
||||||
ret = janet_wrap_true();
|
ret = janet_wrap_true();
|
||||||
} else if (p->buf) {
|
} else if (p->buf) {
|
||||||
if (p->buf[0] >= '0' && p->buf[0] <= '9') {
|
if (start_dig) {
|
||||||
p->error = "symbol literal cannot start with a digit";
|
p->error = "symbol literal cannot start with a digit";
|
||||||
return 0;
|
return 0;
|
||||||
} else {
|
} else {
|
||||||
/* Don't do full utf8 check unless we have seen non ascii characters. */
|
/* Don't do full utf-8 check unless we have seen non ascii characters. */
|
||||||
int valid = (!state->argn) || valid_utf8(p->buf, blen);
|
int valid = (!state->argn) || valid_utf8(p->buf, blen);
|
||||||
if (!valid) {
|
if (!valid) {
|
||||||
p->error = "invalid utf-8 in symbol";
|
p->error = "invalid utf-8 in symbol";
|
||||||
@@ -327,78 +361,40 @@ static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Forward declaration */
|
static Janet close_tuple(JanetParser *p, JanetParseState *state, int32_t flag) {
|
||||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
|
||||||
|
|
||||||
static int dotuple(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|
||||||
if (state->flags & PFLAG_SQRBRACKETS
|
|
||||||
? c == ']'
|
|
||||||
: c == ')') {
|
|
||||||
int32_t i;
|
|
||||||
Janet *ret = janet_tuple_begin(state->argn);
|
Janet *ret = janet_tuple_begin(state->argn);
|
||||||
for (i = state->argn - 1; i >= 0; i--) {
|
janet_tuple_flag(ret) |= flag;
|
||||||
|
for (int32_t i = state->argn - 1; i >= 0; i--)
|
||||||
ret[i] = p->args[--p->argcount];
|
ret[i] = p->args[--p->argcount];
|
||||||
}
|
return janet_wrap_tuple(janet_tuple_end(ret));
|
||||||
popstate(p, janet_wrap_tuple(janet_tuple_end(ret)));
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
return root(p, state, c);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int doarray(JanetParser *p, JanetParseState *state, uint8_t c) {
|
static Janet close_array(JanetParser *p, JanetParseState *state) {
|
||||||
if (state->flags & PFLAG_SQRBRACKETS
|
|
||||||
? c == ']'
|
|
||||||
: c == ')') {
|
|
||||||
int32_t i;
|
|
||||||
JanetArray *array = janet_array(state->argn);
|
JanetArray *array = janet_array(state->argn);
|
||||||
for (i = state->argn - 1; i >= 0; i--) {
|
for (int32_t i = state->argn - 1; i >= 0; i--)
|
||||||
array->data[i] = p->args[--p->argcount];
|
array->data[i] = p->args[--p->argcount];
|
||||||
}
|
|
||||||
array->count = state->argn;
|
array->count = state->argn;
|
||||||
popstate(p, janet_wrap_array(array));
|
return janet_wrap_array(array);
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
return root(p, state, c);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int dostruct(JanetParser *p, JanetParseState *state, uint8_t c) {
|
static Janet close_struct(JanetParser *p, JanetParseState *state) {
|
||||||
if (c == '}') {
|
JanetKV *st = janet_struct_begin(state->argn >> 1);
|
||||||
int32_t i;
|
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||||
JanetKV *st;
|
|
||||||
if (state->argn & 1) {
|
|
||||||
p->error = "struct literal expects even number of arguments";
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
st = janet_struct_begin(state->argn >> 1);
|
|
||||||
for (i = state->argn; i > 0; i -= 2) {
|
|
||||||
Janet value = p->args[--p->argcount];
|
Janet value = p->args[--p->argcount];
|
||||||
Janet key = p->args[--p->argcount];
|
Janet key = p->args[--p->argcount];
|
||||||
janet_struct_put(st, key, value);
|
janet_struct_put(st, key, value);
|
||||||
}
|
}
|
||||||
popstate(p, janet_wrap_struct(janet_struct_end(st)));
|
return janet_wrap_struct(janet_struct_end(st));
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
return root(p, state, c);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int dotable(JanetParser *p, JanetParseState *state, uint8_t c) {
|
static Janet close_table(JanetParser *p, JanetParseState *state) {
|
||||||
if (c == '}') {
|
JanetTable *table = janet_table(state->argn >> 1);
|
||||||
int32_t i;
|
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||||
JanetTable *table;
|
|
||||||
if (state->argn & 1) {
|
|
||||||
p->error = "table literal expects even number of arguments";
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
table = janet_table(state->argn >> 1);
|
|
||||||
for (i = state->argn; i > 0; i -= 2) {
|
|
||||||
Janet value = p->args[--p->argcount];
|
Janet value = p->args[--p->argcount];
|
||||||
Janet key = p->args[--p->argcount];
|
Janet key = p->args[--p->argcount];
|
||||||
janet_table_put(table, key, value);
|
janet_table_put(table, key, value);
|
||||||
}
|
}
|
||||||
popstate(p, janet_wrap_table(table));
|
return janet_wrap_table(table);
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
return root(p, state, c);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#define PFLAG_INSTRING 0x100000
|
#define PFLAG_INSTRING 0x100000
|
||||||
@@ -445,12 +441,14 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||||
|
|
||||||
static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||||
(void) state;
|
(void) state;
|
||||||
p->statecount--;
|
p->statecount--;
|
||||||
switch (c) {
|
switch (c) {
|
||||||
case '{':
|
case '{':
|
||||||
pushstate(p, dotable, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS);
|
pushstate(p, root, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS | PFLAG_ATSYM);
|
||||||
return 1;
|
return 1;
|
||||||
case '"':
|
case '"':
|
||||||
pushstate(p, stringchar, PFLAG_BUFFER | PFLAG_STRING);
|
pushstate(p, stringchar, PFLAG_BUFFER | PFLAG_STRING);
|
||||||
@@ -459,10 +457,10 @@ static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
pushstate(p, longstring, PFLAG_BUFFER | PFLAG_LONGSTRING);
|
pushstate(p, longstring, PFLAG_BUFFER | PFLAG_LONGSTRING);
|
||||||
return 1;
|
return 1;
|
||||||
case '[':
|
case '[':
|
||||||
pushstate(p, doarray, PFLAG_CONTAINER | PFLAG_SQRBRACKETS);
|
pushstate(p, root, PFLAG_CONTAINER | PFLAG_SQRBRACKETS | PFLAG_ATSYM);
|
||||||
return 1;
|
return 1;
|
||||||
case '(':
|
case '(':
|
||||||
pushstate(p, doarray, PFLAG_CONTAINER | PFLAG_PARENS);
|
pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS | PFLAG_ATSYM);
|
||||||
return 1;
|
return 1;
|
||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
@@ -474,7 +472,6 @@ static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
|
|
||||||
/* The root state of the parser */
|
/* The root state of the parser */
|
||||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||||
(void) state;
|
|
||||||
switch (c) {
|
switch (c) {
|
||||||
default:
|
default:
|
||||||
if (is_whitespace(c)) return 1;
|
if (is_whitespace(c)) return 1;
|
||||||
@@ -504,42 +501,80 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
return 1;
|
return 1;
|
||||||
case ')':
|
case ')':
|
||||||
case ']':
|
case ']':
|
||||||
case '}':
|
case '}': {
|
||||||
|
Janet ds;
|
||||||
|
if (p->statecount == 1) {
|
||||||
|
p->error = "unexpected delimiter";
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
|
||||||
|
(c == ']' && (state->flags & PFLAG_SQRBRACKETS))) {
|
||||||
|
if (state->flags & PFLAG_ATSYM) {
|
||||||
|
ds = close_array(p, state);
|
||||||
|
} else {
|
||||||
|
ds = close_tuple(p, state, c == ']' ? JANET_TUPLE_FLAG_BRACKETCTOR : 0);
|
||||||
|
}
|
||||||
|
} else if (c == '}' && (state->flags & PFLAG_CURLYBRACKETS)) {
|
||||||
|
if (state->argn & 1) {
|
||||||
|
p->error = "struct and table literals expect even number of arguments";
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if (state->flags & PFLAG_ATSYM) {
|
||||||
|
ds = close_table(p, state);
|
||||||
|
} else {
|
||||||
|
ds = close_struct(p, state);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
p->error = "mismatched delimiter";
|
p->error = "mismatched delimiter";
|
||||||
return 1;
|
return 1;
|
||||||
|
}
|
||||||
|
popstate(p, ds);
|
||||||
|
}
|
||||||
|
return 1;
|
||||||
case '(':
|
case '(':
|
||||||
pushstate(p, dotuple, PFLAG_CONTAINER | PFLAG_PARENS);
|
pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS);
|
||||||
return 1;
|
return 1;
|
||||||
case '[':
|
case '[':
|
||||||
pushstate(p, dotuple, PFLAG_CONTAINER | PFLAG_SQRBRACKETS);
|
pushstate(p, root, PFLAG_CONTAINER | PFLAG_SQRBRACKETS);
|
||||||
return 1;
|
return 1;
|
||||||
case '{':
|
case '{':
|
||||||
pushstate(p, dostruct, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS);
|
pushstate(p, root, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS);
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
int janet_parser_consume(JanetParser *parser, uint8_t c) {
|
static void janet_parser_checkdead(JanetParser *parser) {
|
||||||
|
if (parser->flag) janet_panic("parser is dead, cannot consume");
|
||||||
|
if (parser->error) janet_panic("parser has unchecked error, cannot consume");
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Public API */
|
||||||
|
|
||||||
|
void janet_parser_consume(JanetParser *parser, uint8_t c) {
|
||||||
int consumed = 0;
|
int consumed = 0;
|
||||||
if (parser->error) return 0;
|
janet_parser_checkdead(parser);
|
||||||
if (c == '\n') {
|
parser->offset++;
|
||||||
parser->line++;
|
|
||||||
parser->col = 0;
|
|
||||||
} else if (c != '\r') {
|
|
||||||
parser->col++;
|
|
||||||
}
|
|
||||||
while (!consumed && !parser->error) {
|
while (!consumed && !parser->error) {
|
||||||
JanetParseState *state = parser->states + parser->statecount - 1;
|
JanetParseState *state = parser->states + parser->statecount - 1;
|
||||||
consumed = state->consumer(parser, state, c);
|
consumed = state->consumer(parser, state, c);
|
||||||
}
|
}
|
||||||
parser->lookback = c;
|
parser->lookback = c;
|
||||||
return 1;
|
}
|
||||||
|
|
||||||
|
void janet_parser_eof(JanetParser *parser) {
|
||||||
|
janet_parser_checkdead(parser);
|
||||||
|
janet_parser_consume(parser, '\n');
|
||||||
|
if (parser->statecount > 1) {
|
||||||
|
parser->error = "unexpected end of source";
|
||||||
|
}
|
||||||
|
parser->offset--;
|
||||||
|
parser->flag = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
|
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
|
||||||
if (parser->error) return JANET_PARSE_ERROR;
|
if (parser->error) return JANET_PARSE_ERROR;
|
||||||
|
if (parser->flag) return JANET_PARSE_DEAD;
|
||||||
if (parser->statecount > 1) return JANET_PARSE_PENDING;
|
if (parser->statecount > 1) return JANET_PARSE_PENDING;
|
||||||
if (parser->argcount) return JANET_PARSE_FULL;
|
|
||||||
return JANET_PARSE_ROOT;
|
return JANET_PARSE_ROOT;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -547,6 +582,7 @@ void janet_parser_flush(JanetParser *parser) {
|
|||||||
parser->argcount = 0;
|
parser->argcount = 0;
|
||||||
parser->statecount = 1;
|
parser->statecount = 1;
|
||||||
parser->bufcount = 0;
|
parser->bufcount = 0;
|
||||||
|
parser->pending = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
const char *janet_parser_error(JanetParser *parser) {
|
const char *janet_parser_error(JanetParser *parser) {
|
||||||
@@ -563,12 +599,12 @@ const char *janet_parser_error(JanetParser *parser) {
|
|||||||
Janet janet_parser_produce(JanetParser *parser) {
|
Janet janet_parser_produce(JanetParser *parser) {
|
||||||
Janet ret;
|
Janet ret;
|
||||||
size_t i;
|
size_t i;
|
||||||
enum JanetParserStatus status = janet_parser_status(parser);
|
if (parser->pending == 0) return janet_wrap_nil();
|
||||||
if (status != JANET_PARSE_FULL) return janet_wrap_nil();
|
|
||||||
ret = parser->args[0];
|
ret = parser->args[0];
|
||||||
for (i = 1; i < parser->argcount; i++) {
|
for (i = 1; i < parser->argcount; i++) {
|
||||||
parser->args[i - 1] = parser->args[i];
|
parser->args[i - 1] = parser->args[i];
|
||||||
}
|
}
|
||||||
|
parser->pending--;
|
||||||
parser->argcount--;
|
parser->argcount--;
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
@@ -584,9 +620,10 @@ void janet_parser_init(JanetParser *parser) {
|
|||||||
parser->statecount = 0;
|
parser->statecount = 0;
|
||||||
parser->statecap = 0;
|
parser->statecap = 0;
|
||||||
parser->error = NULL;
|
parser->error = NULL;
|
||||||
parser->line = 1;
|
|
||||||
parser->col = 0;
|
|
||||||
parser->lookback = -1;
|
parser->lookback = -1;
|
||||||
|
parser->offset = 0;
|
||||||
|
parser->pending = 0;
|
||||||
|
parser->flag = 0;
|
||||||
|
|
||||||
pushstate(parser, root, PFLAG_CONTAINER);
|
pushstate(parser, root, PFLAG_CONTAINER);
|
||||||
}
|
}
|
||||||
@@ -597,6 +634,10 @@ void janet_parser_deinit(JanetParser *parser) {
|
|||||||
free(parser->states);
|
free(parser->states);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
int janet_parser_has_more(JanetParser *parser) {
|
||||||
|
return !!parser->pending;
|
||||||
|
}
|
||||||
|
|
||||||
/* C functions */
|
/* C functions */
|
||||||
|
|
||||||
static int parsermark(void *p, size_t size) {
|
static int parsermark(void *p, size_t size) {
|
||||||
@@ -616,146 +657,161 @@ static int parsergc(void *p, size_t size) {
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet parserget(void *p, Janet key);
|
||||||
|
|
||||||
static JanetAbstractType janet_parse_parsertype = {
|
static JanetAbstractType janet_parse_parsertype = {
|
||||||
":core.parser",
|
"core/parser",
|
||||||
parsergc,
|
parsergc,
|
||||||
parsermark
|
parsermark,
|
||||||
|
parserget,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL
|
||||||
};
|
};
|
||||||
|
|
||||||
JanetParser *janet_check_parser(Janet x) {
|
|
||||||
if (!janet_checktype(x, JANET_ABSTRACT))
|
|
||||||
return NULL;
|
|
||||||
void *abstract = janet_unwrap_abstract(x);
|
|
||||||
if (janet_abstract_type(abstract) != &janet_parse_parsertype)
|
|
||||||
return NULL;
|
|
||||||
return (JanetParser *)abstract;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* C Function parser */
|
/* C Function parser */
|
||||||
static int cfun_parser(JanetArgs args) {
|
static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
|
||||||
JANET_FIXARITY(args, 0);
|
(void) argv;
|
||||||
|
janet_fixarity(argc, 0);
|
||||||
JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||||
janet_parser_init(p);
|
janet_parser_init(p);
|
||||||
JANET_RETURN_ABSTRACT(args, p);
|
return janet_wrap_abstract(p);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_consume(JanetArgs args) {
|
static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
|
||||||
const uint8_t *bytes;
|
janet_arity(argc, 2, 3);
|
||||||
int32_t len;
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
JanetParser *p;
|
JanetByteView view = janet_getbytes(argv, 1);
|
||||||
int32_t i;
|
if (argc == 3) {
|
||||||
JANET_MINARITY(args, 2);
|
int32_t offset = janet_getinteger(argv, 2);
|
||||||
JANET_MAXARITY(args, 3);
|
if (offset < 0 || offset > view.len)
|
||||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
janet_panicf("invalid offset %d out of range [0,%d]", offset, view.len);
|
||||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
view.len -= offset;
|
||||||
JANET_ARG_BYTES(bytes, len, args, 1);
|
view.bytes += offset;
|
||||||
if (args.n == 3) {
|
|
||||||
int32_t offset;
|
|
||||||
JANET_ARG_INTEGER(offset, args, 2);
|
|
||||||
if (offset < 0 || offset > len)
|
|
||||||
JANET_THROW(args, "invalid offset");
|
|
||||||
len -= offset;
|
|
||||||
bytes += offset;
|
|
||||||
}
|
}
|
||||||
for (i = 0; i < len; i++) {
|
int32_t i;
|
||||||
janet_parser_consume(p, bytes[i]);
|
for (i = 0; i < view.len; i++) {
|
||||||
|
janet_parser_consume(p, view.bytes[i]);
|
||||||
switch (janet_parser_status(p)) {
|
switch (janet_parser_status(p)) {
|
||||||
case JANET_PARSE_ROOT:
|
case JANET_PARSE_ROOT:
|
||||||
case JANET_PARSE_PENDING:
|
case JANET_PARSE_PENDING:
|
||||||
break;
|
break;
|
||||||
default:
|
default:
|
||||||
JANET_RETURN_INTEGER(args, i + 1);
|
return janet_wrap_integer(i + 1);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
JANET_RETURN_INTEGER(args, i);
|
return janet_wrap_integer(i);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_byte(JanetArgs args) {
|
static Janet cfun_parse_eof(int32_t argc, Janet *argv) {
|
||||||
int32_t i;
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p;
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
JANET_FIXARITY(args, 2);
|
janet_parser_eof(p);
|
||||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
return argv[0];
|
||||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
}
|
||||||
JANET_ARG_INTEGER(i, args, 1);
|
|
||||||
|
static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
|
JanetParseState *s = p->states + p->statecount - 1;
|
||||||
|
if (s->consumer == tokenchar) {
|
||||||
|
janet_parser_consume(p, ' ');
|
||||||
|
p->offset--;
|
||||||
|
s = p->states + p->statecount - 1;
|
||||||
|
}
|
||||||
|
if (s->flags & PFLAG_CONTAINER) {
|
||||||
|
s->argn++;
|
||||||
|
if (p->statecount == 1) p->pending++;
|
||||||
|
push_arg(p, argv[1]);
|
||||||
|
} else if (s->flags & (PFLAG_STRING | PFLAG_LONGSTRING)) {
|
||||||
|
const uint8_t *str = janet_to_string(argv[1]);
|
||||||
|
int32_t slen = janet_string_length(str);
|
||||||
|
size_t newcount = p->bufcount + slen;
|
||||||
|
if (p->bufcap < newcount) {
|
||||||
|
size_t newcap = 2 * newcount;
|
||||||
|
p->buf = realloc(p->buf, newcap);
|
||||||
|
if (p->buf == NULL) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
p->bufcap = newcap;
|
||||||
|
}
|
||||||
|
memcpy(p->buf + p->bufcount, str, slen);
|
||||||
|
p->bufcount = newcount;
|
||||||
|
} else {
|
||||||
|
janet_panic("cannot insert value into parser");
|
||||||
|
}
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_parse_has_more(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
|
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);
|
||||||
|
int32_t i = janet_getinteger(argv, 1);
|
||||||
janet_parser_consume(p, 0xFF & i);
|
janet_parser_consume(p, 0xFF & i);
|
||||||
JANET_RETURN(args, args.v[0]);
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_status(JanetArgs args) {
|
static Janet cfun_parse_status(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
const char *stat = NULL;
|
const char *stat = NULL;
|
||||||
JanetParser *p;
|
|
||||||
JANET_FIXARITY(args, 1);
|
|
||||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
|
||||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
|
||||||
switch (janet_parser_status(p)) {
|
switch (janet_parser_status(p)) {
|
||||||
case JANET_PARSE_FULL:
|
|
||||||
stat = ":full";
|
|
||||||
break;
|
|
||||||
case JANET_PARSE_PENDING:
|
case JANET_PARSE_PENDING:
|
||||||
stat = ":pending";
|
stat = "pending";
|
||||||
break;
|
break;
|
||||||
case JANET_PARSE_ERROR:
|
case JANET_PARSE_ERROR:
|
||||||
stat = ":error";
|
stat = "error";
|
||||||
break;
|
break;
|
||||||
case JANET_PARSE_ROOT:
|
case JANET_PARSE_ROOT:
|
||||||
stat = ":root";
|
stat = "root";
|
||||||
|
break;
|
||||||
|
case JANET_PARSE_DEAD:
|
||||||
|
stat = "dead";
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
JANET_RETURN_CSYMBOL(args, stat);
|
return janet_ckeywordv(stat);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_error(JanetArgs args) {
|
static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||||
const char *err;
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p;
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
JANET_FIXARITY(args, 1);
|
const char *err = janet_parser_error(p);
|
||||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
if (err) return janet_cstringv(err);
|
||||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
return janet_wrap_nil();
|
||||||
err = janet_parser_error(p);
|
|
||||||
if (err) {
|
|
||||||
JANET_RETURN_CSYMBOL(args, err);
|
|
||||||
} else {
|
|
||||||
JANET_RETURN_NIL(args);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_produce(JanetArgs args) {
|
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
|
||||||
Janet val;
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p;
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
JANET_FIXARITY(args, 1);
|
return janet_parser_produce(p);
|
||||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
|
||||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
|
||||||
val = janet_parser_produce(p);
|
|
||||||
JANET_RETURN(args, val);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_flush(JanetArgs args) {
|
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||||
JanetParser *p;
|
janet_fixarity(argc, 1);
|
||||||
JANET_FIXARITY(args, 1);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
|
||||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
|
||||||
janet_parser_flush(p);
|
janet_parser_flush(p);
|
||||||
JANET_RETURN(args, args.v[0]);
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_where(JanetArgs args) {
|
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||||
JanetParser *p;
|
janet_fixarity(argc, 1);
|
||||||
JANET_FIXARITY(args, 1);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
return janet_wrap_integer(p->offset);
|
||||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
|
||||||
Janet *tup = janet_tuple_begin(2);
|
|
||||||
tup[0] = janet_wrap_integer((int32_t)p->line);
|
|
||||||
tup[1] = janet_wrap_integer((int32_t)p->col);
|
|
||||||
JANET_RETURN_TUPLE(args, janet_tuple_end(tup));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_state(JanetArgs args) {
|
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||||
size_t i;
|
size_t i;
|
||||||
const uint8_t *str;
|
const uint8_t *str;
|
||||||
size_t oldcount;
|
size_t oldcount;
|
||||||
JanetParser *p;
|
janet_fixarity(argc, 1);
|
||||||
JANET_FIXARITY(args, 1);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
|
||||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
|
||||||
oldcount = p->bufcount;
|
oldcount = p->bufcount;
|
||||||
for (i = 0; i < p->statecount; i++) {
|
for (i = 0; i < p->statecount; i++) {
|
||||||
JanetParseState *s = p->states + i;
|
JanetParseState *s = p->states + i;
|
||||||
@@ -776,70 +832,116 @@ static int cfun_state(JanetArgs args) {
|
|||||||
}
|
}
|
||||||
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
||||||
p->bufcount = oldcount;
|
p->bufcount = oldcount;
|
||||||
JANET_RETURN_STRING(args, str);
|
return janet_wrap_string(str);
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetMethod parser_methods[] = {
|
||||||
{"parser/new", cfun_parser,
|
{"byte", cfun_parse_byte},
|
||||||
"(parser/new)\n\n"
|
{"consume", cfun_parse_consume},
|
||||||
|
{"error", cfun_parse_error},
|
||||||
|
{"flush", cfun_parse_flush},
|
||||||
|
{"has-more", cfun_parse_has_more},
|
||||||
|
{"insert", cfun_parse_insert},
|
||||||
|
{"produce", cfun_parse_produce},
|
||||||
|
{"state", cfun_parse_state},
|
||||||
|
{"status", cfun_parse_status},
|
||||||
|
{"where", cfun_parse_where},
|
||||||
|
{"eof", cfun_parse_eof},
|
||||||
|
{NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
static Janet parserget(void *p, Janet key) {
|
||||||
|
(void) p;
|
||||||
|
if (!janet_checktype(key, JANET_KEYWORD)) janet_panicf("expected keyword method");
|
||||||
|
return janet_getmethod(janet_unwrap_keyword(key), parser_methods);
|
||||||
|
}
|
||||||
|
|
||||||
|
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 "
|
"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 janet values. ")
|
||||||
},
|
},
|
||||||
{"parser/produce", cfun_produce,
|
{
|
||||||
"(parser/produce parser)\n\n"
|
"parser/has-more", cfun_parse_has_more,
|
||||||
|
JDOC("(parser/has-more parser)\n\n"
|
||||||
|
"Check if the parser has more values in the value queue.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/produce", cfun_parse_produce,
|
||||||
|
JDOC("(parser/produce parser)\n\n"
|
||||||
"Dequeue the next value in the parse queue. Will return nil if "
|
"Dequeue the next value in the parse queue. Will return nil if "
|
||||||
"no parsed values are in the queue, otherwise will dequeue the "
|
"no parsed values are in the queue, otherwise will dequeue the "
|
||||||
"next value."
|
"next value.")
|
||||||
},
|
},
|
||||||
{"parser/consume", cfun_consume,
|
{
|
||||||
"(parser/consume parser bytes [, index])\n\n"
|
"parser/consume", cfun_parse_consume,
|
||||||
|
JDOC("(parser/consume parser bytes [, index])\n\n"
|
||||||
"Input bytes into the parser and parse them. Will not throw errors "
|
"Input bytes into the parser and parse them. Will not throw errors "
|
||||||
"if there is a parse error. Starts at the byte index given by index. Returns "
|
"if there is a parse error. Starts at the byte index given by index. Returns "
|
||||||
"the number of bytes read."
|
"the number of bytes read.")
|
||||||
},
|
},
|
||||||
{"parser/byte", cfun_byte,
|
{
|
||||||
"(parser/byte parser b)\n\n"
|
"parser/byte", cfun_parse_byte,
|
||||||
"Input a single byte into the parser byte stream. Returns the parser."
|
JDOC("(parser/byte parser b)\n\n"
|
||||||
|
"Input a single byte into the parser byte stream. Returns the parser.")
|
||||||
},
|
},
|
||||||
{"parser/error", cfun_error,
|
{
|
||||||
"(parser/error parser)\n\n"
|
"parser/error", cfun_parse_error,
|
||||||
"If the parser is in the error state, returns the message asscoiated with "
|
JDOC("(parser/error parser)\n\n"
|
||||||
"that error. Otherwise, returns nil."
|
"If the parser is in the error state, returns the message associated with "
|
||||||
|
"that error. Otherwise, returns nil. Also flushes the parser state and parser "
|
||||||
|
"queue, so be sure to handle everything in the queue before calling "
|
||||||
|
"parser/error.")
|
||||||
},
|
},
|
||||||
{"parser/status", cfun_status,
|
{
|
||||||
"(parser/status parser)\n\n"
|
"parser/status", cfun_parse_status,
|
||||||
|
JDOC("(parser/status parser)\n\n"
|
||||||
"Gets the current status of the parser state machine. The status will "
|
"Gets the current status of the parser state machine. The status will "
|
||||||
"be one of:\n\n"
|
"be one of:\n\n"
|
||||||
"\t:full - there are values in the parse queue to be consumed.\n"
|
"\t:pending - a value is being parsed.\n"
|
||||||
"\t:pending - no values in the queue but a value is being parsed.\n"
|
|
||||||
"\t:error - a parsing error was encountered.\n"
|
"\t:error - a parsing error was encountered.\n"
|
||||||
"\t:root - the parser can either read more values or safely terminate."
|
"\t:root - the parser can either read more values or safely terminate.")
|
||||||
},
|
},
|
||||||
{"parser/flush", cfun_flush,
|
{
|
||||||
"(parser/flush parser)\n\n"
|
"parser/flush", cfun_parse_flush,
|
||||||
|
JDOC("(parser/flush parser)\n\n"
|
||||||
"Clears the parser state and parse queue. Can be used to reset the parser "
|
"Clears the parser state and parse queue. Can be used to reset the parser "
|
||||||
"if an error was encountered. Does not reset the line and column counter, so "
|
"if an error was encountered. Does not reset the line and column counter, so "
|
||||||
"to begin parsing in a new context, create a new parser."
|
"to begin parsing in a new context, create a new parser.")
|
||||||
},
|
},
|
||||||
{"parser/state", cfun_state,
|
{
|
||||||
"(parser/state parser)\n\n"
|
"parser/state", cfun_parse_state,
|
||||||
|
JDOC("(parser/state parser)\n\n"
|
||||||
"Returns a string representation of the internal state of the parser. "
|
"Returns a string representation of the internal state of the parser. "
|
||||||
"Each byte in the string represents a nested data structure. For example, "
|
"Each byte in the string represents a nested data structure. For example, "
|
||||||
"if the parser state is '([\"', then the parser is in the middle of parsing a "
|
"if the parser state is '([\"', then the parser is in the middle of parsing a "
|
||||||
"string inside of square brackets inside parens. Can be used to augment a repl prompt."
|
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.")
|
||||||
},
|
},
|
||||||
{"parser/where", cfun_where,
|
{
|
||||||
"(parser/where parser)\n\n"
|
"parser/where", cfun_parse_where,
|
||||||
|
JDOC("(parser/where parser)\n\n"
|
||||||
"Returns the current line number and column number of the parser's location "
|
"Returns the current line number and column number of the parser's location "
|
||||||
"in the byte stream as a tuple (line, column). Lines and columns are counted from "
|
"in the byte stream as a tuple (line, column). Lines and columns are counted from "
|
||||||
"1, (the first byte is line1, column 1) and a newline is considered ascii 0x0A."
|
"1, (the first byte is line 1, column 1) and a newline is considered ASCII 0x0A.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/eof", cfun_parse_eof,
|
||||||
|
JDOC("(parser/eof parser)\n\n"
|
||||||
|
"Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/insert", cfun_parse_insert,
|
||||||
|
JDOC("(parser/insert parser value)\n\n"
|
||||||
|
"Insert a value into the parser. This means that the parser state can be manipulated "
|
||||||
|
"in between chunks of bytes. This would allow a user to add extra elements to arrays "
|
||||||
|
"and tuples, for example. Returns the parser.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Load the library */
|
/* Load the library */
|
||||||
int janet_lib_parse(JanetArgs args) {
|
void janet_lib_parse(JanetTable *env) {
|
||||||
JanetTable *env = janet_env(args);
|
janet_core_cfuns(env, NULL, parse_cfuns);
|
||||||
janet_cfuns(env, NULL, cfuns);
|
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|||||||
1077
src/core/peg.c
Normal file
1077
src/core/peg.c
Normal file
File diff suppressed because it is too large
Load Diff
748
src/core/pp.c
Normal file
748
src/core/pp.c
Normal file
@@ -0,0 +1,748 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 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.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include <string.h>
|
||||||
|
#include <ctype.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#include "state.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Implements a pretty printer for Janet. The pretty printer
|
||||||
|
* is farily simple and not that flexible, but fast. */
|
||||||
|
|
||||||
|
/* Temporary buffer size */
|
||||||
|
#define BUFSIZE 64
|
||||||
|
|
||||||
|
static void number_to_string_b(JanetBuffer *buffer, double x) {
|
||||||
|
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
|
||||||
|
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%g", x);
|
||||||
|
buffer->count += count;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* expects non positive x */
|
||||||
|
static int count_dig10(int32_t x) {
|
||||||
|
int result = 1;
|
||||||
|
for (;;) {
|
||||||
|
if (x > -10) return result;
|
||||||
|
if (x > -100) return result + 1;
|
||||||
|
if (x > -1000) return result + 2;
|
||||||
|
if (x > -10000) return result + 3;
|
||||||
|
x /= 10000;
|
||||||
|
result += 4;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
|
||||||
|
janet_buffer_extra(buffer, BUFSIZE);
|
||||||
|
uint8_t *buf = buffer->data + buffer->count;
|
||||||
|
int32_t neg = 0;
|
||||||
|
int32_t len = 0;
|
||||||
|
if (x == 0) {
|
||||||
|
buf[0] = '0';
|
||||||
|
buffer->count++;
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
if (x > 0) {
|
||||||
|
x = -x;
|
||||||
|
} else {
|
||||||
|
neg = 1;
|
||||||
|
*buf++ = '-';
|
||||||
|
}
|
||||||
|
len = count_dig10(x);
|
||||||
|
buf += len;
|
||||||
|
while (x) {
|
||||||
|
uint8_t digit = (uint8_t) - (x % 10);
|
||||||
|
*(--buf) = '0' + digit;
|
||||||
|
x /= 10;
|
||||||
|
}
|
||||||
|
buffer->count += len + neg;
|
||||||
|
}
|
||||||
|
|
||||||
|
#define HEX(i) (((uint8_t *) janet_base64)[(i)])
|
||||||
|
|
||||||
|
/* Returns a string description for a pointer. Truncates
|
||||||
|
* title to 32 characters */
|
||||||
|
static void string_description_b(JanetBuffer *buffer, const char *title, void *pointer) {
|
||||||
|
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
|
||||||
|
uint8_t *c = buffer->data + buffer->count;
|
||||||
|
int32_t i;
|
||||||
|
union {
|
||||||
|
uint8_t bytes[sizeof(void *)];
|
||||||
|
void *p;
|
||||||
|
} pbuf;
|
||||||
|
|
||||||
|
pbuf.p = pointer;
|
||||||
|
*c++ = '<';
|
||||||
|
/* Maximum of 32 bytes for abstract type name */
|
||||||
|
for (i = 0; title[i] && i < 32; ++i)
|
||||||
|
*c++ = ((uint8_t *)title) [i];
|
||||||
|
*c++ = ' ';
|
||||||
|
*c++ = '0';
|
||||||
|
*c++ = 'x';
|
||||||
|
#if defined(JANET_64)
|
||||||
|
#define POINTSIZE 6
|
||||||
|
#else
|
||||||
|
#define POINTSIZE (sizeof(void *))
|
||||||
|
#endif
|
||||||
|
for (i = POINTSIZE; i > 0; --i) {
|
||||||
|
uint8_t byte = pbuf.bytes[i - 1];
|
||||||
|
*c++ = HEX(byte >> 4);
|
||||||
|
*c++ = HEX(byte & 0xF);
|
||||||
|
}
|
||||||
|
*c++ = '>';
|
||||||
|
buffer->count = (int32_t)(c - buffer->data);
|
||||||
|
#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) {
|
||||||
|
uint8_t c = str[i];
|
||||||
|
switch (c) {
|
||||||
|
case '"':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\"", 2);
|
||||||
|
break;
|
||||||
|
case '\n':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\n", 2);
|
||||||
|
break;
|
||||||
|
case '\r':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\r", 2);
|
||||||
|
break;
|
||||||
|
case '\0':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\0", 2);
|
||||||
|
break;
|
||||||
|
case '\f':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\f", 2);
|
||||||
|
break;
|
||||||
|
case '\v':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
|
||||||
|
break;
|
||||||
|
case 27:
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
|
||||||
|
break;
|
||||||
|
case '\\':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
if (c < 32 || c > 127) {
|
||||||
|
uint8_t buf[4];
|
||||||
|
buf[0] = '\\';
|
||||||
|
buf[1] = 'x';
|
||||||
|
buf[2] = janet_base64[(c >> 4) & 0xF];
|
||||||
|
buf[3] = janet_base64[c & 0xF];
|
||||||
|
janet_buffer_push_bytes(buffer, buf, 4);
|
||||||
|
} else {
|
||||||
|
janet_buffer_push_u8(buffer, c);
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_buffer_push_u8(buffer, '"');
|
||||||
|
}
|
||||||
|
|
||||||
|
static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) {
|
||||||
|
janet_escape_string_impl(buffer, str, janet_string_length(str));
|
||||||
|
}
|
||||||
|
|
||||||
|
static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
|
||||||
|
janet_buffer_push_u8(buffer, '@');
|
||||||
|
janet_escape_string_impl(buffer, bx->data, bx->count);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
case JANET_NIL:
|
||||||
|
janet_buffer_push_cstring(buffer, "nil");
|
||||||
|
return;
|
||||||
|
case JANET_BOOLEAN:
|
||||||
|
janet_buffer_push_cstring(buffer,
|
||||||
|
janet_unwrap_boolean(x) ? "true" : "false");
|
||||||
|
return;
|
||||||
|
case JANET_NUMBER:
|
||||||
|
number_to_string_b(buffer, janet_unwrap_number(x));
|
||||||
|
return;
|
||||||
|
case JANET_KEYWORD:
|
||||||
|
janet_buffer_push_u8(buffer, ':');
|
||||||
|
/* fallthrough */
|
||||||
|
case JANET_SYMBOL:
|
||||||
|
janet_buffer_push_bytes(buffer,
|
||||||
|
janet_unwrap_string(x),
|
||||||
|
janet_string_length(janet_unwrap_string(x)));
|
||||||
|
return;
|
||||||
|
case JANET_STRING:
|
||||||
|
janet_escape_string_b(buffer, janet_unwrap_string(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;
|
||||||
|
}
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
void *p = janet_unwrap_abstract(x);
|
||||||
|
const JanetAbstractType *at = janet_abstract_type(p);
|
||||||
|
if (at->tostring) {
|
||||||
|
at->tostring(p, buffer);
|
||||||
|
} else {
|
||||||
|
const char *n = at->name;
|
||||||
|
string_description_b(buffer, n, janet_unwrap_abstract(x));
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
case JANET_CFUNCTION: {
|
||||||
|
Janet check = janet_table_get(janet_vm_registry, x);
|
||||||
|
if (janet_checktype(check, JANET_SYMBOL)) {
|
||||||
|
janet_buffer_push_cstring(buffer, "<cfunction ");
|
||||||
|
janet_buffer_push_bytes(buffer,
|
||||||
|
janet_unwrap_symbol(check),
|
||||||
|
janet_string_length(janet_unwrap_symbol(check)));
|
||||||
|
janet_buffer_push_u8(buffer, '>');
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
goto fallthrough;
|
||||||
|
}
|
||||||
|
case JANET_FUNCTION: {
|
||||||
|
JanetFunction *fun = janet_unwrap_function(x);
|
||||||
|
JanetFuncDef *def = fun->def;
|
||||||
|
if (def->name) {
|
||||||
|
const uint8_t *n = def->name;
|
||||||
|
janet_buffer_push_cstring(buffer, "<function ");
|
||||||
|
janet_buffer_push_bytes(buffer, n, janet_string_length(n));
|
||||||
|
janet_buffer_push_u8(buffer, '>');
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
goto fallthrough;
|
||||||
|
}
|
||||||
|
fallthrough:
|
||||||
|
default:
|
||||||
|
string_description_b(buffer, janet_type_names[janet_type(x)], janet_unwrap_pointer(x));
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
default:
|
||||||
|
janet_description_b(buffer, x);
|
||||||
|
break;
|
||||||
|
case JANET_BUFFER:
|
||||||
|
janet_buffer_push_bytes(buffer,
|
||||||
|
janet_unwrap_buffer(x)->data,
|
||||||
|
janet_unwrap_buffer(x)->count);
|
||||||
|
break;
|
||||||
|
case JANET_STRING:
|
||||||
|
case JANET_SYMBOL:
|
||||||
|
case JANET_KEYWORD:
|
||||||
|
janet_buffer_push_bytes(buffer,
|
||||||
|
janet_unwrap_string(x),
|
||||||
|
janet_string_length(janet_unwrap_string(x)));
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
const uint8_t *janet_description(Janet x) {
|
||||||
|
JanetBuffer b;
|
||||||
|
janet_buffer_init(&b, 10);
|
||||||
|
janet_description_b(&b, x);
|
||||||
|
const uint8_t *ret = janet_string(b.data, b.count);
|
||||||
|
janet_buffer_deinit(&b);
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Convert any value to a janet string. Similar to description, but
|
||||||
|
* strings, symbols, and buffers will return their content. */
|
||||||
|
const uint8_t *janet_to_string(Janet x) {
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
default: {
|
||||||
|
JanetBuffer b;
|
||||||
|
janet_buffer_init(&b, 10);
|
||||||
|
janet_to_string_b(&b, x);
|
||||||
|
const uint8_t *ret = janet_string(b.data, b.count);
|
||||||
|
janet_buffer_deinit(&b);
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
case JANET_BUFFER:
|
||||||
|
return janet_string(janet_unwrap_buffer(x)->data, janet_unwrap_buffer(x)->count);
|
||||||
|
case JANET_STRING:
|
||||||
|
case JANET_SYMBOL:
|
||||||
|
case JANET_KEYWORD:
|
||||||
|
return janet_unwrap_string(x);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Hold state for pretty printer. */
|
||||||
|
struct pretty {
|
||||||
|
JanetBuffer *buffer;
|
||||||
|
int depth;
|
||||||
|
int indent;
|
||||||
|
int flags;
|
||||||
|
int32_t bufstartlen;
|
||||||
|
JanetTable seen;
|
||||||
|
};
|
||||||
|
|
||||||
|
static void print_newline(struct pretty *S, int just_a_space) {
|
||||||
|
int i;
|
||||||
|
if (just_a_space) {
|
||||||
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
janet_buffer_push_u8(S->buffer, '\n');
|
||||||
|
for (i = 0; i < S->indent; i++) {
|
||||||
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Color coding for types */
|
||||||
|
static const char janet_cycle_color[] = "\x1B[36m";
|
||||||
|
static const char *janet_pretty_colors[] = {
|
||||||
|
"\x1B[32m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[35m",
|
||||||
|
"\x1B[34m",
|
||||||
|
"\x1B[33m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m"
|
||||||
|
"\x1B[35m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m"
|
||||||
|
};
|
||||||
|
|
||||||
|
#define JANET_PRETTY_DICT_ONELINE 4
|
||||||
|
#define JANET_PRETTY_IND_ONELINE 10
|
||||||
|
|
||||||
|
/* Helper for pretty printing */
|
||||||
|
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||||
|
/* Add to seen */
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
case JANET_NIL:
|
||||||
|
case JANET_NUMBER:
|
||||||
|
case JANET_SYMBOL:
|
||||||
|
case JANET_BOOLEAN:
|
||||||
|
break;
|
||||||
|
default: {
|
||||||
|
Janet seenid = janet_table_get(&S->seen, x);
|
||||||
|
if (janet_checktype(seenid, JANET_NUMBER)) {
|
||||||
|
if (S->flags & JANET_PRETTY_COLOR) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, janet_cycle_color);
|
||||||
|
}
|
||||||
|
janet_buffer_push_cstring(S->buffer, "<cycle ");
|
||||||
|
integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
|
||||||
|
janet_buffer_push_u8(S->buffer, '>');
|
||||||
|
if (S->flags & JANET_PRETTY_COLOR) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
} else {
|
||||||
|
janet_table_put(&S->seen, x, janet_wrap_integer(S->seen.count));
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
default: {
|
||||||
|
const char *color = janet_pretty_colors[janet_type(x)];
|
||||||
|
if (color && (S->flags & JANET_PRETTY_COLOR)) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, color);
|
||||||
|
}
|
||||||
|
if (janet_checktype(x, JANET_BUFFER) && janet_unwrap_buffer(x) == S->buffer) {
|
||||||
|
janet_buffer_ensure(S->buffer, S->buffer->count + S->bufstartlen * 4 + 3, 1);
|
||||||
|
janet_buffer_push_u8(S->buffer, '@');
|
||||||
|
janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
|
||||||
|
} else {
|
||||||
|
janet_description_b(S->buffer, x);
|
||||||
|
}
|
||||||
|
if (color && (S->flags & JANET_PRETTY_COLOR)) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_ARRAY:
|
||||||
|
case JANET_TUPLE: {
|
||||||
|
int32_t i = 0, len = 0;
|
||||||
|
const Janet *arr = NULL;
|
||||||
|
int isarray = janet_checktype(x, JANET_ARRAY);
|
||||||
|
janet_indexed_view(x, &arr, &len);
|
||||||
|
int hasbrackets = !isarray && (janet_tuple_flag(arr) & JANET_TUPLE_FLAG_BRACKETCTOR);
|
||||||
|
const char *startstr = isarray ? "@[" : hasbrackets ? "[" : "(";
|
||||||
|
const char endchar = isarray ? ']' : hasbrackets ? ']' : ')';
|
||||||
|
janet_buffer_push_cstring(S->buffer, startstr);
|
||||||
|
S->depth--;
|
||||||
|
S->indent += 2;
|
||||||
|
if (S->depth == 0) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, "...");
|
||||||
|
} else {
|
||||||
|
if (!isarray && len >= JANET_PRETTY_IND_ONELINE)
|
||||||
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
|
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
|
||||||
|
for (i = 0; i < len; i++) {
|
||||||
|
if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE);
|
||||||
|
janet_pretty_one(S, arr[i], 0);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
S->indent -= 2;
|
||||||
|
S->depth++;
|
||||||
|
janet_buffer_push_u8(S->buffer, endchar);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_STRUCT:
|
||||||
|
case JANET_TABLE: {
|
||||||
|
int istable = janet_checktype(x, JANET_TABLE);
|
||||||
|
janet_buffer_push_cstring(S->buffer, istable ? "@" : "{");
|
||||||
|
|
||||||
|
/* For object-like tables, print class name */
|
||||||
|
if (istable) {
|
||||||
|
JanetTable *t = janet_unwrap_table(x);
|
||||||
|
JanetTable *proto = t->proto;
|
||||||
|
if (NULL != proto) {
|
||||||
|
Janet name = janet_table_get(proto, janet_csymbolv(":name"));
|
||||||
|
if (janet_checktype(name, JANET_SYMBOL)) {
|
||||||
|
const uint8_t *sym = janet_unwrap_symbol(name);
|
||||||
|
janet_buffer_push_bytes(S->buffer, sym, janet_string_length(sym));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_buffer_push_cstring(S->buffer, "{");
|
||||||
|
}
|
||||||
|
|
||||||
|
S->depth--;
|
||||||
|
S->indent += 2;
|
||||||
|
if (S->depth == 0) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, "...");
|
||||||
|
} else {
|
||||||
|
int32_t i = 0, len = 0, cap = 0;
|
||||||
|
int first_kv_pair = 1;
|
||||||
|
const JanetKV *kvs = NULL;
|
||||||
|
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||||
|
if (!istable && len >= JANET_PRETTY_DICT_ONELINE)
|
||||||
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
|
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 (first_kv_pair) {
|
||||||
|
first_kv_pair = 0;
|
||||||
|
} else {
|
||||||
|
print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
|
||||||
|
}
|
||||||
|
janet_pretty_one(S, kvs[i].key, 0);
|
||||||
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
|
janet_pretty_one(S, kvs[i].value, 1);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
S->indent -= 2;
|
||||||
|
S->depth++;
|
||||||
|
janet_buffer_push_u8(S->buffer, '}');
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
/* Remove from seen */
|
||||||
|
janet_table_remove(&S->seen, x);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, 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 = flags;
|
||||||
|
S.bufstartlen = startlen;
|
||||||
|
janet_table_init(&S.seen, 10);
|
||||||
|
janet_pretty_one(&S, x, 0);
|
||||||
|
janet_table_deinit(&S.seen);
|
||||||
|
return S.buffer;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Helper for printing a janet value in a pretty form. Not meant to be used
|
||||||
|
* for serialization or anything like that. */
|
||||||
|
JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
|
||||||
|
return janet_pretty_(buffer, depth, flags, x, buffer ? buffer->count : 0);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const char *typestr(Janet x) {
|
||||||
|
JanetType t = janet_type(x);
|
||||||
|
return (t == JANET_ABSTRACT)
|
||||||
|
? janet_abstract_type(janet_unwrap_abstract(x))->name
|
||||||
|
: janet_type_names[t];
|
||||||
|
}
|
||||||
|
|
||||||
|
static void pushtypes(JanetBuffer *buffer, int types) {
|
||||||
|
int first = 1;
|
||||||
|
int i = 0;
|
||||||
|
while (types) {
|
||||||
|
if (1 & types) {
|
||||||
|
if (first) {
|
||||||
|
first = 0;
|
||||||
|
} else {
|
||||||
|
janet_buffer_push_u8(buffer, '|');
|
||||||
|
}
|
||||||
|
janet_buffer_push_cstring(buffer, janet_type_names[i]);
|
||||||
|
}
|
||||||
|
i++;
|
||||||
|
types >>= 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
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
|
||||||
|
*/
|
||||||
|
|
||||||
|
#define MAX_ITEM 256
|
||||||
|
#define FMT_FLAGS "-+ #0"
|
||||||
|
#define MAX_FORMAT 32
|
||||||
|
|
||||||
|
static const char *scanformat(
|
||||||
|
const char *strfrmt,
|
||||||
|
char *form,
|
||||||
|
char width[3],
|
||||||
|
char precision[3]) {
|
||||||
|
const char *p = strfrmt;
|
||||||
|
memset(width, '\0', 3);
|
||||||
|
memset(precision, '\0', 3);
|
||||||
|
while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL)
|
||||||
|
p++; /* skip flags */
|
||||||
|
if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS) / sizeof(char))
|
||||||
|
janet_panic("invalid format (repeated flags)");
|
||||||
|
if (isdigit((int)(*p)))
|
||||||
|
width[0] = *p++; /* skip width */
|
||||||
|
if (isdigit((int)(*p)))
|
||||||
|
width[1] = *p++; /* (2 digits at most) */
|
||||||
|
if (*p == '.') {
|
||||||
|
p++;
|
||||||
|
if (isdigit((int)(*p)))
|
||||||
|
precision[0] = *p++; /* skip precision */
|
||||||
|
if (isdigit((int)(*p)))
|
||||||
|
precision[1] = *p++; /* (2 digits at most) */
|
||||||
|
}
|
||||||
|
if (isdigit((int)(*p)))
|
||||||
|
janet_panic("invalid format (width or precision too long)");
|
||||||
|
*(form++) = '%';
|
||||||
|
memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char));
|
||||||
|
form += (p - strfrmt) + 1;
|
||||||
|
*form = '\0';
|
||||||
|
return p;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Shared implementation between string/format and
|
||||||
|
* buffer/format */
|
||||||
|
void janet_buffer_format(
|
||||||
|
JanetBuffer *b,
|
||||||
|
const char *strfrmt,
|
||||||
|
int32_t argstart,
|
||||||
|
int32_t argc,
|
||||||
|
Janet *argv) {
|
||||||
|
size_t sfl = strlen(strfrmt);
|
||||||
|
const char *strfrmt_end = strfrmt + sfl;
|
||||||
|
int32_t arg = argstart;
|
||||||
|
int32_t startlen = b->count;
|
||||||
|
while (strfrmt < strfrmt_end) {
|
||||||
|
if (*strfrmt != '%')
|
||||||
|
janet_buffer_push_u8(b, (uint8_t) * strfrmt++);
|
||||||
|
else if (*++strfrmt == '%')
|
||||||
|
janet_buffer_push_u8(b, (uint8_t) * strfrmt++); /* %% */
|
||||||
|
else { /* format item */
|
||||||
|
char form[MAX_FORMAT], item[MAX_ITEM];
|
||||||
|
char width[3], precision[3];
|
||||||
|
int nb = 0; /* number of bytes in added item */
|
||||||
|
if (++arg >= argc)
|
||||||
|
janet_panic("not enough values for format");
|
||||||
|
strfrmt = scanformat(strfrmt, form, width, precision);
|
||||||
|
switch (*strfrmt++) {
|
||||||
|
case 'c': {
|
||||||
|
nb = snprintf(item, MAX_ITEM, form, (int)
|
||||||
|
janet_getinteger(argv, arg));
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 'd':
|
||||||
|
case 'i':
|
||||||
|
case 'o':
|
||||||
|
case 'u':
|
||||||
|
case 'x':
|
||||||
|
case 'X': {
|
||||||
|
int32_t n = janet_getinteger(argv, arg);
|
||||||
|
nb = snprintf(item, MAX_ITEM, form, n);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 'a':
|
||||||
|
case 'A':
|
||||||
|
case 'e':
|
||||||
|
case 'E':
|
||||||
|
case 'f':
|
||||||
|
case 'g':
|
||||||
|
case 'G': {
|
||||||
|
double d = janet_getnumber(argv, arg);
|
||||||
|
nb = snprintf(item, MAX_ITEM, form, d);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 's': {
|
||||||
|
const uint8_t *s = janet_getstring(argv, arg);
|
||||||
|
int32_t l = janet_string_length(s);
|
||||||
|
if (form[2] == '\0')
|
||||||
|
janet_buffer_push_bytes(b, s, l);
|
||||||
|
else {
|
||||||
|
if (l != (int32_t) strlen((const char *) s))
|
||||||
|
janet_panic("string contains zeros");
|
||||||
|
if (!strchr(form, '.') && l >= 100) {
|
||||||
|
janet_panic("no precision and string is too long to be formatted");
|
||||||
|
} else {
|
||||||
|
nb = snprintf(item, MAX_ITEM, form, s);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 'V': {
|
||||||
|
janet_to_string_b(b, argv[arg]);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 'v': {
|
||||||
|
janet_description_b(b, argv[arg]);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 'P':
|
||||||
|
case 'p': { /* janet pretty , precision = depth */
|
||||||
|
int depth = atoi(precision);
|
||||||
|
if (depth < 1)
|
||||||
|
depth = 4;
|
||||||
|
janet_pretty_(b, depth, (strfrmt[-1] == 'P') ? JANET_PRETTY_COLOR : 0, argv[arg], 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);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,8 +20,11 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "regalloc.h"
|
#include "regalloc.h"
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
||||||
ra->chunks = NULL;
|
ra->chunks = NULL;
|
||||||
@@ -57,19 +60,23 @@ static int32_t count_trailing_ones(uint32_t x) {
|
|||||||
/* Get N bits */
|
/* Get N bits */
|
||||||
#define nbits(N) (ithbit(N) - 1)
|
#define nbits(N) (ithbit(N) - 1)
|
||||||
|
|
||||||
/* Copy a regsiter allocator */
|
/* Copy a register allocator */
|
||||||
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src) {
|
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src) {
|
||||||
size_t size;
|
size_t size;
|
||||||
dest->count = src->count;
|
dest->count = src->count;
|
||||||
dest->capacity = src->capacity;
|
dest->capacity = src->capacity;
|
||||||
dest->max = src->max;
|
dest->max = src->max;
|
||||||
size = sizeof(uint32_t) * dest->capacity;
|
size = sizeof(uint32_t) * dest->capacity;
|
||||||
dest->chunks = malloc(size);
|
|
||||||
dest->regtemps = 0;
|
dest->regtemps = 0;
|
||||||
|
if (size) {
|
||||||
|
dest->chunks = malloc(size);
|
||||||
if (!dest->chunks) {
|
if (!dest->chunks) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
memcpy(dest->chunks, src->chunks, size);
|
memcpy(dest->chunks, src->chunks, size);
|
||||||
|
} else {
|
||||||
|
dest->chunks = NULL;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Allocate one more chunk in chunks */
|
/* Allocate one more chunk in chunks */
|
||||||
@@ -153,78 +160,3 @@ void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRe
|
|||||||
if (reg < 0xF0)
|
if (reg < 0xF0)
|
||||||
janetc_regalloc_free(ra, reg);
|
janetc_regalloc_free(ra, reg);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Disable multi-slot allocation for now. */
|
|
||||||
|
|
||||||
/*
|
|
||||||
static int32_t checkrange(JanetcRegisterAllocator *ra, int32_t start, int32_t end) {
|
|
||||||
int32_t startchunk = start / 32;
|
|
||||||
int32_t endchunk = end / 32;
|
|
||||||
for (int32_t chunk = startchunk; chunk <= endchunk; chunk++) {
|
|
||||||
while (ra->count <= chunk) pushchunk(ra);
|
|
||||||
uint32_t mask = 0xFFFFFFFF;
|
|
||||||
if (chunk == startchunk)
|
|
||||||
mask &= ~nbits(start & 0x1F);
|
|
||||||
if (chunk == endchunk)
|
|
||||||
mask &= nbits(end & 0x1F);
|
|
||||||
uint32_t block = ra->chunks[chunk];
|
|
||||||
uint32_t masking = mask & block;
|
|
||||||
if (masking) {
|
|
||||||
int32_t nextbit = (block == 0xFFFFFFFF)
|
|
||||||
? 32
|
|
||||||
: count_trailing_zeros(masking) + 1;
|
|
||||||
return chunk * 32 + nextbit;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return -1;
|
|
||||||
}
|
|
||||||
|
|
||||||
static void markrange(JanetcRegisterAllocator *ra, int32_t start, int32_t end) {
|
|
||||||
int32_t startchunk = start / 32;
|
|
||||||
int32_t endchunk = end / 32;
|
|
||||||
for (int32_t chunk = startchunk; chunk <= endchunk; chunk++) {
|
|
||||||
uint32_t mask = 0xFFFFFFFF;
|
|
||||||
if (chunk == startchunk)
|
|
||||||
mask &= ~nbits(start & 0x1F);
|
|
||||||
if (chunk == endchunk)
|
|
||||||
mask &= nbits(end & 0x1F);
|
|
||||||
ra->chunks[chunk] |= mask;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
void janetc_regalloc_freerange(JanetcRegisterAllocator *ra, int32_t start, int32_t n) {
|
|
||||||
int32_t end = start + n - 1;
|
|
||||||
int32_t startchunk = start / 32;
|
|
||||||
int32_t endchunk = end / 32;
|
|
||||||
for (int32_t chunk = startchunk; chunk <= endchunk; chunk++) {
|
|
||||||
uint32_t mask = 0;
|
|
||||||
if (chunk == startchunk)
|
|
||||||
mask |= nbits(start & 0x1F);
|
|
||||||
if (chunk == endchunk)
|
|
||||||
mask |= ~nbits(end & 0x1F);
|
|
||||||
ra->chunks[chunk] &= mask;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
int32_t janetc_regalloc_n(JanetcRegisterAllocator *ra, int32_t n) {
|
|
||||||
int32_t start = 0, end = 0, next = 0;
|
|
||||||
while (next >= 0) {
|
|
||||||
start = next;
|
|
||||||
end = start + n - 1;
|
|
||||||
next = checkrange(ra, start, end);
|
|
||||||
}
|
|
||||||
markrange(ra, start, end);
|
|
||||||
if (end > ra->max)
|
|
||||||
ra->max = end;
|
|
||||||
return start;
|
|
||||||
}
|
|
||||||
|
|
||||||
int32_t janetc_regalloc_call(JanetcRegisterAllocator *ra, int32_t callee, int32_t nargs) {
|
|
||||||
if (checkrange(ra, callee, callee + nargs) < 0) {
|
|
||||||
markrange(ra, callee + 1, callee + nargs);
|
|
||||||
return callee;
|
|
||||||
}
|
|
||||||
return janetc_regalloc_n(ra, nargs + 1);
|
|
||||||
}
|
|
||||||
|
|
||||||
*/
|
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -44,7 +44,7 @@ typedef struct {
|
|||||||
int32_t count; /* number of chunks in chunks */
|
int32_t count; /* number of chunks in chunks */
|
||||||
int32_t capacity; /* amount allocated for chunks */
|
int32_t capacity; /* amount allocated for chunks */
|
||||||
int32_t max; /* The maximum allocated register so far */
|
int32_t max; /* The maximum allocated register so far */
|
||||||
int32_t regtemps; /* Hold which tempregistered are alloced. */
|
int32_t regtemps; /* Hold which temp. registers are allocated. */
|
||||||
} JanetcRegisterAllocator;
|
} JanetcRegisterAllocator;
|
||||||
|
|
||||||
void janetc_regalloc_init(JanetcRegisterAllocator *ra);
|
void janetc_regalloc_init(JanetcRegisterAllocator *ra);
|
||||||
@@ -57,11 +57,4 @@ void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRe
|
|||||||
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src);
|
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src);
|
||||||
void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg);
|
void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg);
|
||||||
|
|
||||||
/* Mutli-slot allocation disabled */
|
|
||||||
/*
|
|
||||||
int32_t janetc_regalloc_n(JanetcRegisterAllocator *ra, int32_t n);
|
|
||||||
int32_t janetc_regalloc_call(JanetcRegisterAllocator *ra, int32_t callee, int32_t nargs);
|
|
||||||
void janetc_regalloc_freerange(JanetcRegisterAllocator *ra, int32_t regstart, int32_t n);
|
|
||||||
*/
|
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
110
src/core/run.c
110
src/core/run.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,122 +20,78 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "vector.h"
|
#endif
|
||||||
|
|
||||||
/* Error reporting */
|
|
||||||
void janet_stacktrace(JanetFiber *fiber, const char *errtype, Janet err) {
|
|
||||||
int32_t fi;
|
|
||||||
const char *errstr = (const char *)janet_to_string(err);
|
|
||||||
JanetFiber **fibers = NULL;
|
|
||||||
fprintf(stderr, "%s error: %s\n", errtype, errstr);
|
|
||||||
|
|
||||||
while (fiber) {
|
|
||||||
janet_v_push(fibers, fiber);
|
|
||||||
fiber = fiber->child;
|
|
||||||
}
|
|
||||||
|
|
||||||
for (fi = janet_v_count(fibers) - 1; fi >= 0; fi--) {
|
|
||||||
fiber = fibers[fi];
|
|
||||||
int32_t i = fiber->frame;
|
|
||||||
if (i > 0) fprintf(stderr, " (fiber)\n");
|
|
||||||
while (i > 0) {
|
|
||||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
|
||||||
JanetFuncDef *def = NULL;
|
|
||||||
i = frame->prevframe;
|
|
||||||
fprintf(stderr, " in");
|
|
||||||
if (frame->func) {
|
|
||||||
def = frame->func->def;
|
|
||||||
fprintf(stderr, " %s", def->name ? (const char *)def->name : "<anonymous>");
|
|
||||||
if (def->source) {
|
|
||||||
fprintf(stderr, " [%s]", (const char *)def->source);
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
|
||||||
if (cfun) {
|
|
||||||
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
|
||||||
if (!janet_checktype(name, JANET_NIL))
|
|
||||||
fprintf(stderr, " %s", (const char *)janet_to_string(name));
|
|
||||||
else
|
|
||||||
fprintf(stderr, " <cfunction>");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
|
||||||
fprintf(stderr, " (tailcall)");
|
|
||||||
if (frame->func && frame->pc) {
|
|
||||||
int32_t off = (int32_t) (frame->pc - def->bytecode);
|
|
||||||
if (def->sourcemap) {
|
|
||||||
JanetSourceMapping mapping = def->sourcemap[off];
|
|
||||||
fprintf(stderr, " on line %d, column %d", mapping.line, mapping.column);
|
|
||||||
} else {
|
|
||||||
fprintf(stderr, " pc=%d", off);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
fprintf(stderr, "\n");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Run a string */
|
/* Run a string */
|
||||||
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
||||||
JanetParser parser;
|
JanetParser parser;
|
||||||
int errflags = 0;
|
int errflags = 0, done = 0;
|
||||||
int32_t index = 0;
|
int32_t index = 0;
|
||||||
int dudeol = 0;
|
|
||||||
int done = 0;
|
|
||||||
Janet ret = janet_wrap_nil();
|
Janet ret = janet_wrap_nil();
|
||||||
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
|
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
|
||||||
|
|
||||||
if (where) janet_gcroot(janet_wrap_string(where));
|
if (where) janet_gcroot(janet_wrap_string(where));
|
||||||
|
if (NULL == sourcePath) sourcePath = "<unknown>";
|
||||||
janet_parser_init(&parser);
|
janet_parser_init(&parser);
|
||||||
|
|
||||||
while (!errflags && !done) {
|
/* While we haven't seen an error */
|
||||||
switch (janet_parser_status(&parser)) {
|
while (!done) {
|
||||||
case JANET_PARSE_FULL:
|
|
||||||
{
|
/* Evaluate parsed values */
|
||||||
|
while (janet_parser_has_more(&parser)) {
|
||||||
Janet form = janet_parser_produce(&parser);
|
Janet form = janet_parser_produce(&parser);
|
||||||
JanetCompileResult cres = janet_compile(form, env, where);
|
JanetCompileResult cres = janet_compile(form, env, where);
|
||||||
if (cres.status == JANET_COMPILE_OK) {
|
if (cres.status == JANET_COMPILE_OK) {
|
||||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||||
JanetFiber *fiber = janet_fiber(f, 64);
|
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||||
|
fiber->env = env;
|
||||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||||
if (status != JANET_SIGNAL_OK) {
|
if (status != JANET_SIGNAL_OK) {
|
||||||
janet_stacktrace(fiber, "runtime", ret);
|
janet_stacktrace(fiber, ret);
|
||||||
errflags |= 0x01;
|
errflags |= 0x01;
|
||||||
|
done = 1;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
janet_stacktrace(cres.macrofiber, "compile",
|
fprintf(stderr, "compile error in %s: %s\n", sourcePath,
|
||||||
janet_wrap_string(cres.error));
|
(const char *)cres.error);
|
||||||
errflags |= 0x02;
|
errflags |= 0x02;
|
||||||
|
done = 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Dispatch based on parse state */
|
||||||
|
switch (janet_parser_status(&parser)) {
|
||||||
|
case JANET_PARSE_DEAD:
|
||||||
|
done = 1;
|
||||||
break;
|
break;
|
||||||
case JANET_PARSE_ERROR:
|
case JANET_PARSE_ERROR:
|
||||||
errflags |= 0x04;
|
errflags |= 0x04;
|
||||||
fprintf(stderr, "parse error: %s\n", janet_parser_error(&parser));
|
fprintf(stderr, "parse error in %s: %s\n",
|
||||||
|
sourcePath, janet_parser_error(&parser));
|
||||||
|
done = 1;
|
||||||
break;
|
break;
|
||||||
case JANET_PARSE_PENDING:
|
case JANET_PARSE_PENDING:
|
||||||
if (index >= len) {
|
if (index == len) {
|
||||||
if (dudeol) {
|
janet_parser_eof(&parser);
|
||||||
errflags |= 0x04;
|
|
||||||
fprintf(stderr, "internal parse error: unexpected end of source\n");
|
|
||||||
} else {
|
|
||||||
dudeol = 1;
|
|
||||||
janet_parser_consume(&parser, '\n');
|
|
||||||
}
|
|
||||||
} else {
|
} else {
|
||||||
janet_parser_consume(&parser, bytes[index++]);
|
janet_parser_consume(&parser, bytes[index++]);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case JANET_PARSE_ROOT:
|
case JANET_PARSE_ROOT:
|
||||||
if (index >= len) {
|
if (index >= len) {
|
||||||
done = 1;
|
janet_parser_eof(&parser);
|
||||||
} else {
|
} else {
|
||||||
janet_parser_consume(&parser, bytes[index++]);
|
janet_parser_consume(&parser, bytes[index++]);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Clean up and return errors */
|
||||||
janet_parser_deinit(&parser);
|
janet_parser_deinit(&parser);
|
||||||
if (where) janet_gcunroot(janet_wrap_string(where));
|
if (where) janet_gcunroot(janet_wrap_string(where));
|
||||||
if (out) *out = ret;
|
if (out) *out = ret;
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,11 +20,13 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
#include "emit.h"
|
#include "emit.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
if (argn != 1) {
|
if (argn != 1) {
|
||||||
@@ -58,8 +60,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
|||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
default:
|
default:
|
||||||
return janetc_cslot(x);
|
return janetc_cslot(x);
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
|
||||||
int32_t i, len;
|
int32_t i, len;
|
||||||
const Janet *tup = janet_unwrap_tuple(x);
|
const Janet *tup = janet_unwrap_tuple(x);
|
||||||
len = janet_tuple_length(tup);
|
len = janet_tuple_length(tup);
|
||||||
@@ -70,10 +71,11 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
|||||||
}
|
}
|
||||||
for (i = 0; i < len; i++)
|
for (i = 0; i < len; i++)
|
||||||
janet_v_push(slots, quasiquote(opts, tup[i]));
|
janet_v_push(slots, quasiquote(opts, tup[i]));
|
||||||
return qq_slots(opts, slots, JOP_MAKE_TUPLE);
|
return qq_slots(opts, slots, (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR)
|
||||||
|
? JOP_MAKE_BRACKET_TUPLE
|
||||||
|
: JOP_MAKE_TUPLE);
|
||||||
}
|
}
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY: {
|
||||||
{
|
|
||||||
int32_t i;
|
int32_t i;
|
||||||
JanetArray *array = janet_unwrap_array(x);
|
JanetArray *array = janet_unwrap_array(x);
|
||||||
for (i = 0; i < array->count; i++)
|
for (i = 0; i < array->count; i++)
|
||||||
@@ -81,10 +83,9 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
|||||||
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
|
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
|
||||||
}
|
}
|
||||||
case JANET_TABLE:
|
case JANET_TABLE:
|
||||||
case JANET_STRUCT:
|
case JANET_STRUCT: {
|
||||||
{
|
|
||||||
const JanetKV *kv = NULL, *kvs = NULL;
|
const JanetKV *kv = NULL, *kvs = NULL;
|
||||||
int32_t len, cap;
|
int32_t len, cap = 0;
|
||||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||||
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
|
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
|
||||||
JanetSlot key = quasiquote(opts, kv->key);
|
JanetSlot key = quasiquote(opts, kv->key);
|
||||||
@@ -134,12 +135,11 @@ static int destructure(JanetCompiler *c,
|
|||||||
/* Leaf, assign right to left */
|
/* Leaf, assign right to left */
|
||||||
return leaf(c, janet_unwrap_symbol(left), right, attr);
|
return leaf(c, janet_unwrap_symbol(left), right, attr);
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE:
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY: {
|
||||||
{
|
int32_t len = 0;
|
||||||
int32_t i, len;
|
const Janet *values = NULL;
|
||||||
const Janet *values;
|
|
||||||
janet_indexed_view(left, &values, &len);
|
janet_indexed_view(left, &values, &len);
|
||||||
for (i = 0; i < len; i++) {
|
for (int32_t i = 0; i < len; i++) {
|
||||||
JanetSlot nextright = janetc_farslot(c);
|
JanetSlot nextright = janetc_farslot(c);
|
||||||
Janet subval = values[i];
|
Janet subval = values[i];
|
||||||
if (i < 0x100) {
|
if (i < 0x100) {
|
||||||
@@ -154,12 +154,11 @@ static int destructure(JanetCompiler *c,
|
|||||||
}
|
}
|
||||||
return 1;
|
return 1;
|
||||||
case JANET_TABLE:
|
case JANET_TABLE:
|
||||||
case JANET_STRUCT:
|
case JANET_STRUCT: {
|
||||||
{
|
|
||||||
const JanetKV *kvs = NULL;
|
const JanetKV *kvs = NULL;
|
||||||
int32_t i, cap, len;
|
int32_t cap = 0, len = 0;
|
||||||
janet_dictionary_view(left, &kvs, &len, &cap);
|
janet_dictionary_view(left, &kvs, &len, &cap);
|
||||||
for (i = 0; i < cap; i++) {
|
for (int32_t i = 0; i < cap; i++) {
|
||||||
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
||||||
JanetSlot nextright = janetc_farslot(c);
|
JanetSlot nextright = janetc_farslot(c);
|
||||||
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
|
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
|
||||||
@@ -172,20 +171,56 @@ static int destructure(JanetCompiler *c,
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Create a source map for definitions. */
|
||||||
|
static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
|
||||||
|
Janet *tup = janet_tuple_begin(3);
|
||||||
|
tup[0] = c->source ? janet_wrap_string(c->source) : janet_wrap_nil();
|
||||||
|
tup[1] = janet_wrap_integer(c->current_mapping.start);
|
||||||
|
tup[2] = janet_wrap_integer(c->current_mapping.end);
|
||||||
|
return janet_tuple_end(tup);
|
||||||
|
}
|
||||||
|
|
||||||
static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
/*JanetFopts subopts = janetc_fopts_default(opts.compiler);*/
|
|
||||||
/*JanetSlot ret, dest;*/
|
|
||||||
Janet head;
|
|
||||||
if (argn != 2) {
|
if (argn != 2) {
|
||||||
janetc_cerror(opts.compiler, "expected 2 arguments");
|
janetc_cerror(opts.compiler, "expected 2 arguments");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
head = argv[0];
|
JanetFopts subopts = janetc_fopts_default(opts.compiler);
|
||||||
if (!janet_checktype(head, JANET_SYMBOL)) {
|
if (janet_checktype(argv[0], JANET_SYMBOL)) {
|
||||||
janetc_cerror(opts.compiler, "expected symbol");
|
/* Normal var - (set a 1) */
|
||||||
|
const uint8_t *sym = janet_unwrap_symbol(argv[0]);
|
||||||
|
JanetSlot dest = janetc_resolve(opts.compiler, sym);
|
||||||
|
if (!(dest.flags & JANET_SLOT_MUTABLE)) {
|
||||||
|
janetc_cerror(opts.compiler, "cannot set constant");
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
}
|
||||||
|
subopts.flags = JANET_FOPTS_HINT;
|
||||||
|
subopts.hint = dest;
|
||||||
|
JanetSlot ret = janetc_value(subopts, argv[1]);
|
||||||
|
janetc_copy(opts.compiler, dest, ret);
|
||||||
|
return ret;
|
||||||
|
} else if (janet_checktype(argv[0], JANET_TUPLE)) {
|
||||||
|
/* Set a field (setf behavior) - (set (tab :key) 2) */
|
||||||
|
const Janet *tup = janet_unwrap_tuple(argv[0]);
|
||||||
|
/* Tuple must have 2 elements */
|
||||||
|
if (janet_tuple_length(tup) != 2) {
|
||||||
|
janetc_cerror(opts.compiler, "expected 2 element tuple for l-value to set");
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
}
|
||||||
|
JanetSlot ds = janetc_value(subopts, tup[0]);
|
||||||
|
JanetSlot key = janetc_value(subopts, tup[1]);
|
||||||
|
/* Can't be tail position because we will emit a PUT instruction afterwards */
|
||||||
|
/* Also can't drop either */
|
||||||
|
opts.flags &= ~(JANET_FOPTS_TAIL | JANET_FOPTS_DROP);
|
||||||
|
JanetSlot rvalue = janetc_value(opts, argv[1]);
|
||||||
|
/* Emit the PUT instruction */
|
||||||
|
janetc_emit_sss(opts.compiler, JOP_PUT, ds, key, rvalue, 0);
|
||||||
|
return rvalue;
|
||||||
|
} else {
|
||||||
|
/* Error */
|
||||||
|
janetc_cerror(opts.compiler, "expected symbol or tuple for l-value to set");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
return janetc_sym_lvalue(opts, janet_unwrap_symbol(head), argv[1]);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Add attributes to a global def or var table */
|
/* Add attributes to a global def or var table */
|
||||||
@@ -198,11 +233,11 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
|
|||||||
default:
|
default:
|
||||||
janetc_cerror(c, "could not add metadata to binding");
|
janetc_cerror(c, "could not add metadata to binding");
|
||||||
break;
|
break;
|
||||||
case JANET_SYMBOL:
|
case JANET_KEYWORD:
|
||||||
janet_table_put(tab, attr, janet_wrap_true());
|
janet_table_put(tab, attr, janet_wrap_true());
|
||||||
break;
|
break;
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
janet_table_put(tab, janet_csymbolv(":doc"), attr);
|
janet_table_put(tab, janet_ckeywordv("doc"), attr);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -251,7 +286,9 @@ static int varleaf(
|
|||||||
reftab->proto = attr;
|
reftab->proto = attr;
|
||||||
JanetArray *ref = janet_array(1);
|
JanetArray *ref = janet_array(1);
|
||||||
janet_array_push(ref, janet_wrap_nil());
|
janet_array_push(ref, janet_wrap_nil());
|
||||||
janet_table_put(reftab, janet_csymbolv(":ref"), janet_wrap_array(ref));
|
janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
||||||
|
janet_table_put(reftab, janet_ckeywordv("source-map"),
|
||||||
|
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||||
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(reftab));
|
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(reftab));
|
||||||
refslot = janetc_cslot(janet_wrap_array(ref));
|
refslot = janetc_cslot(janet_wrap_array(ref));
|
||||||
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
|
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
|
||||||
@@ -278,8 +315,10 @@ static int defleaf(
|
|||||||
JanetTable *attr) {
|
JanetTable *attr) {
|
||||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||||
JanetTable *tab = janet_table(2);
|
JanetTable *tab = janet_table(2);
|
||||||
|
janet_table_put(tab, janet_ckeywordv("source-map"),
|
||||||
|
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||||
tab->proto = attr;
|
tab->proto = attr;
|
||||||
JanetSlot valsym = janetc_cslot(janet_csymbolv(":value"));
|
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
||||||
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));
|
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));
|
||||||
|
|
||||||
/* Add env entry to env */
|
/* Add env entry to env */
|
||||||
@@ -356,8 +395,9 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
falsebody = truebody;
|
falsebody = truebody;
|
||||||
truebody = temp;
|
truebody = temp;
|
||||||
}
|
}
|
||||||
janetc_scope(&tempscope, c, 0, "if-body");
|
janetc_scope(&tempscope, c, 0, "if-true");
|
||||||
target = janetc_value(bodyopts, truebody);
|
right = janetc_value(bodyopts, truebody);
|
||||||
|
if (!drop && !tail) janetc_copy(c, target, right);
|
||||||
janetc_popscope(c);
|
janetc_popscope(c);
|
||||||
janetc_throwaway(bodyopts, falsebody);
|
janetc_throwaway(bodyopts, falsebody);
|
||||||
janetc_popscope(c);
|
janetc_popscope(c);
|
||||||
@@ -433,6 +473,61 @@ static int32_t janetc_addfuncdef(JanetCompiler *c, JanetFuncDef *def) {
|
|||||||
return janet_v_count(scope->defs) - 1;
|
return janet_v_count(scope->defs) - 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/*
|
||||||
|
* break
|
||||||
|
*
|
||||||
|
* jump :end or retn if in function
|
||||||
|
*/
|
||||||
|
static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
|
JanetCompiler *c = opts.compiler;
|
||||||
|
JanetScope *scope = c->scope;
|
||||||
|
if (argn > 1) {
|
||||||
|
janetc_cerror(c, "expected at most 1 argument");
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Find scope to break from */
|
||||||
|
while (scope) {
|
||||||
|
if (scope->flags & (JANET_SCOPE_FUNCTION | JANET_SCOPE_WHILE))
|
||||||
|
break;
|
||||||
|
scope = scope->parent;
|
||||||
|
}
|
||||||
|
if (NULL == scope) {
|
||||||
|
janetc_cerror(c, "break must occur in while loop or closure");
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Emit code to break from that scope */
|
||||||
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
|
if (scope->flags & JANET_SCOPE_FUNCTION) {
|
||||||
|
if (!(scope->flags & JANET_SCOPE_WHILE) && argn) {
|
||||||
|
/* Closure body with return argument */
|
||||||
|
subopts.flags |= JANET_FOPTS_TAIL;
|
||||||
|
JanetSlot ret = janetc_value(subopts, argv[0]);
|
||||||
|
ret.flags |= JANET_SLOT_RETURNED;
|
||||||
|
return ret;
|
||||||
|
} else {
|
||||||
|
/* while loop IIFE or no argument */
|
||||||
|
if (argn) {
|
||||||
|
subopts.flags |= JANET_FOPTS_DROP;
|
||||||
|
janetc_value(subopts, argv[0]);
|
||||||
|
}
|
||||||
|
janetc_emit(c, JOP_RETURN_NIL);
|
||||||
|
JanetSlot s = janetc_cslot(janet_wrap_nil());
|
||||||
|
s.flags |= JANET_SLOT_RETURNED;
|
||||||
|
return s;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
if (argn) {
|
||||||
|
subopts.flags |= JANET_FOPTS_DROP;
|
||||||
|
janetc_value(subopts, argv[0]);
|
||||||
|
}
|
||||||
|
/* Tag the instruction so the while special can turn it into a proper jump */
|
||||||
|
janetc_emit(c, 0x80 | JOP_JUMP);
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* :whiletop
|
* :whiletop
|
||||||
* ...
|
* ...
|
||||||
@@ -457,7 +552,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
|
|
||||||
labelwt = janet_v_count(c->buffer);
|
labelwt = janet_v_count(c->buffer);
|
||||||
|
|
||||||
janetc_scope(&tempscope, c, 0, "while");
|
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
|
||||||
|
|
||||||
/* Compile condition */
|
/* Compile condition */
|
||||||
cond = janetc_value(subopts, argv[0]);
|
cond = janetc_value(subopts, argv[0]);
|
||||||
@@ -497,7 +592,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
/* Recompile in the function scope */
|
/* Recompile in the function scope */
|
||||||
cond = janetc_value(subopts, argv[0]);
|
cond = janetc_value(subopts, argv[0]);
|
||||||
if (!(cond.flags & JANET_SLOT_CONSTANT)) {
|
if (!(cond.flags & JANET_SLOT_CONSTANT)) {
|
||||||
/* If not an infinte loop, return nil when condition false */
|
/* If not an infinite loop, return nil when condition false */
|
||||||
janetc_emit_si(c, JOP_JUMP_IF, cond, 2, 0);
|
janetc_emit_si(c, JOP_JUMP_IF, cond, 2, 0);
|
||||||
janetc_emit(c, JOP_RETURN_NIL);
|
janetc_emit(c, JOP_RETURN_NIL);
|
||||||
}
|
}
|
||||||
@@ -522,14 +617,21 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Compile jump to whiletop */
|
/* Compile jump to :whiletop */
|
||||||
labeljt = janet_v_count(c->buffer);
|
labeljt = janet_v_count(c->buffer);
|
||||||
janetc_emit(c, JOP_JUMP);
|
janetc_emit(c, JOP_JUMP);
|
||||||
|
|
||||||
/* Calculate jumps */
|
/* Calculate jumps */
|
||||||
labeld = janet_v_count(c->buffer);
|
labeld = janet_v_count(c->buffer);
|
||||||
if (!infinite) c->buffer[labelc] |= (labeld - labelc) << 16;
|
if (!infinite) c->buffer[labelc] |= (uint32_t)(labeld - labelc) << 16;
|
||||||
c->buffer[labeljt] |= (labelwt - labeljt) << 8;
|
c->buffer[labeljt] |= (uint32_t)(labelwt - labeljt) << 8;
|
||||||
|
|
||||||
|
/* Calculate breaks */
|
||||||
|
for (int32_t i = labelwt; i < labeld; i++) {
|
||||||
|
if (c->buffer[i] == (0x80 | JOP_JUMP)) {
|
||||||
|
c->buffer[i] = JOP_JUMP | ((labeld - i) << 8);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/* Pop scope and return nil slot */
|
/* Pop scope and return nil slot */
|
||||||
janetc_popscope(c);
|
janetc_popscope(c);
|
||||||
@@ -543,16 +645,18 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
JanetSlot ret;
|
JanetSlot ret;
|
||||||
Janet head;
|
Janet head;
|
||||||
JanetScope fnscope;
|
JanetScope fnscope;
|
||||||
int32_t paramcount, argi, parami, arity, defindex, i;
|
int32_t paramcount, argi, parami, arity, min_arity, max_arity, defindex, i;
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
const Janet *params;
|
const Janet *params;
|
||||||
const char *errmsg = NULL;
|
const char *errmsg = NULL;
|
||||||
|
|
||||||
/* Function flags */
|
/* Function flags */
|
||||||
int vararg = 0;
|
int vararg = 0;
|
||||||
int fixarity = 1;
|
int structarg = 0;
|
||||||
|
int allow_extra = 0;
|
||||||
int selfref = 0;
|
int selfref = 0;
|
||||||
int seenamp = 0;
|
int seenamp = 0;
|
||||||
|
int seenopt = 0;
|
||||||
|
|
||||||
/* Begin function */
|
/* Begin function */
|
||||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||||
@@ -583,19 +687,45 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
Janet param = params[i];
|
Janet param = params[i];
|
||||||
if (janet_checktype(param, JANET_SYMBOL)) {
|
if (janet_checktype(param, JANET_SYMBOL)) {
|
||||||
/* Check for varargs and unfixed arity */
|
/* Check for varargs and unfixed arity */
|
||||||
if ((!seenamp) &&
|
if (!janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
|
||||||
(0 == janet_cstrcmp(janet_unwrap_symbol(param), "&"))) {
|
if (seenamp) {
|
||||||
seenamp = 1;
|
errmsg = "& in unexpected location";
|
||||||
fixarity = 0;
|
goto error;
|
||||||
if (i == paramcount - 1) {
|
} else if (i == paramcount - 1) {
|
||||||
|
allow_extra = 1;
|
||||||
arity--;
|
arity--;
|
||||||
} else if (i == paramcount - 2) {
|
} else if (i == paramcount - 2) {
|
||||||
vararg = 1;
|
vararg = 1;
|
||||||
arity -= 2;
|
arity -= 2;
|
||||||
} else {
|
} else {
|
||||||
errmsg = "variable argument symbol in unexpected location";
|
errmsg = "& in unexpected location";
|
||||||
goto error;
|
goto error;
|
||||||
}
|
}
|
||||||
|
seenamp = 1;
|
||||||
|
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&opt")) {
|
||||||
|
if (seenopt) {
|
||||||
|
errmsg = "only one &opt allowed";
|
||||||
|
goto error;
|
||||||
|
} else if (i == paramcount - 1) {
|
||||||
|
errmsg = "&opt cannot be last item in parameter list";
|
||||||
|
goto error;
|
||||||
|
}
|
||||||
|
min_arity = i;
|
||||||
|
arity--;
|
||||||
|
seenopt = 1;
|
||||||
|
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&keys")) {
|
||||||
|
if (seenamp) {
|
||||||
|
errmsg = "&keys in unexpected location";
|
||||||
|
goto error;
|
||||||
|
} else if (i == paramcount - 2) {
|
||||||
|
vararg = 1;
|
||||||
|
structarg = 1;
|
||||||
|
arity -= 2;
|
||||||
|
} else {
|
||||||
|
errmsg = "&keys in unexpected location";
|
||||||
|
goto error;
|
||||||
|
}
|
||||||
|
seenamp = 1;
|
||||||
} else {
|
} else {
|
||||||
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
||||||
}
|
}
|
||||||
@@ -604,6 +734,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
||||||
|
if (!seenopt) min_arity = arity;
|
||||||
|
|
||||||
/* Check for self ref */
|
/* Check for self ref */
|
||||||
if (selfref) {
|
if (selfref) {
|
||||||
JanetSlot slot = janetc_farslot(c);
|
JanetSlot slot = janetc_farslot(c);
|
||||||
@@ -615,18 +748,22 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
/* Compile function body */
|
/* Compile function body */
|
||||||
if (parami + 1 == argn) {
|
if (parami + 1 == argn) {
|
||||||
janetc_emit(c, JOP_RETURN_NIL);
|
janetc_emit(c, JOP_RETURN_NIL);
|
||||||
} else for (argi = parami + 1; argi < argn; argi++) {
|
} else {
|
||||||
|
for (argi = parami + 1; argi < argn; argi++) {
|
||||||
subopts.flags = (argi == (argn - 1)) ? JANET_FOPTS_TAIL : JANET_FOPTS_DROP;
|
subopts.flags = (argi == (argn - 1)) ? JANET_FOPTS_TAIL : JANET_FOPTS_DROP;
|
||||||
janetc_value(subopts, argv[argi]);
|
janetc_value(subopts, argv[argi]);
|
||||||
if (c->result.status == JANET_COMPILE_ERROR)
|
if (c->result.status == JANET_COMPILE_ERROR)
|
||||||
goto error2;
|
goto error2;
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/* Build function */
|
/* Build function */
|
||||||
def = janetc_pop_funcdef(c);
|
def = janetc_pop_funcdef(c);
|
||||||
def->arity = arity;
|
def->arity = arity;
|
||||||
if (fixarity) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
|
def->min_arity = min_arity;
|
||||||
|
def->max_arity = max_arity;
|
||||||
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||||
|
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
|
|
||||||
if (selfref) def->name = janet_unwrap_symbol(head);
|
if (selfref) def->name = janet_unwrap_symbol(head);
|
||||||
defindex = janetc_addfuncdef(c, def);
|
defindex = janetc_addfuncdef(c, def);
|
||||||
@@ -648,16 +785,16 @@ error2:
|
|||||||
|
|
||||||
/* Keep in lexicographic order */
|
/* Keep in lexicographic order */
|
||||||
static const JanetSpecial janetc_specials[] = {
|
static const JanetSpecial janetc_specials[] = {
|
||||||
{":=", janetc_varset},
|
{"break", janetc_break},
|
||||||
{"def", janetc_def},
|
{"def", janetc_def},
|
||||||
{"do", janetc_do},
|
{"do", janetc_do},
|
||||||
{"fn", janetc_fn},
|
{"fn", janetc_fn},
|
||||||
{"if", janetc_if},
|
{"if", janetc_if},
|
||||||
{"quasiquote", janetc_quasiquote},
|
{"quasiquote", janetc_quasiquote},
|
||||||
{"quote", janetc_quote},
|
{"quote", janetc_quote},
|
||||||
|
{"set", janetc_varset},
|
||||||
{"splice", janetc_splice},
|
{"splice", janetc_splice},
|
||||||
{"unquote", janetc_unquote},
|
{"unquote", janetc_unquote},
|
||||||
{"unquote", janetc_unquote},
|
|
||||||
{"var", janetc_var},
|
{"var", janetc_var},
|
||||||
{"while", janetc_while}
|
{"while", janetc_while}
|
||||||
};
|
};
|
||||||
@@ -666,7 +803,7 @@ static const JanetSpecial janetc_specials[] = {
|
|||||||
const JanetSpecial *janetc_special(const uint8_t *name) {
|
const JanetSpecial *janetc_special(const uint8_t *name) {
|
||||||
return janet_strbinsearch(
|
return janet_strbinsearch(
|
||||||
&janetc_specials,
|
&janetc_specials,
|
||||||
sizeof(janetc_specials)/sizeof(JanetSpecial),
|
sizeof(janetc_specials) / sizeof(JanetSpecial),
|
||||||
sizeof(JanetSpecial),
|
sizeof(JanetSpecial),
|
||||||
name);
|
name);
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -27,10 +27,10 @@
|
|||||||
|
|
||||||
/* The VM state. Rather than a struct that is passed
|
/* The VM state. Rather than a struct that is passed
|
||||||
* around, the vm state is global for simplicity. If
|
* around, the vm state is global for simplicity. If
|
||||||
* at some point a a global state object, or context,
|
* at some point a global state object, or context,
|
||||||
* is required to be passed around, this is waht would
|
* is required to be passed around, this is what would
|
||||||
* be in it. However, thread local globals for interpreter
|
* be in it. However, thread local global variables for interpreter
|
||||||
* state should allow easy multithreading. */
|
* state should allow easy multi-threading. */
|
||||||
|
|
||||||
/* How many VM stacks have been entered */
|
/* How many VM stacks have been entered */
|
||||||
extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
||||||
@@ -39,7 +39,12 @@ extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
|||||||
* Set and unset by janet_run. */
|
* Set and unset by janet_run. */
|
||||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||||
|
|
||||||
/* The global registry for c functions. Used to store metadata
|
/* The current pointer to the inner most jmp_buf. The current
|
||||||
|
* return point for panics. */
|
||||||
|
extern JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf;
|
||||||
|
extern JANET_THREAD_LOCAL Janet *janet_vm_return_reg;
|
||||||
|
|
||||||
|
/* The global registry for c functions. Used to store meta-data
|
||||||
* along with otherwise bare c function pointers. */
|
* along with otherwise bare c function pointers. */
|
||||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||||
|
|
||||||
|
|||||||
1319
src/core/string.c
1319
src/core/string.c
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -21,142 +21,235 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
/* Use a custom double parser instead of libc's strtod for better portability
|
/* Use a custom double parser instead of libc's strtod for better portability
|
||||||
* and control. Also, uses a less strict rounding method than ieee to not incur
|
* and control.
|
||||||
* the cost of 4000 loc and dependence on arbitary precision arithmetic. There
|
|
||||||
* is no plan to use arbitrary precision arithmetic for parsing numbers, and a
|
|
||||||
* formal rounding mode has yet to be chosen (round towards 0 seems
|
|
||||||
* reasonable).
|
|
||||||
*
|
*
|
||||||
* This version has been modified for much greater flexibility in parsing, such
|
* This version has been modified for much greater flexibility in parsing, such
|
||||||
* as choosing the radix, supporting integer output, and returning Janets
|
* as choosing the radix and supporting scientific notation with any radix.
|
||||||
* directly.
|
|
||||||
*
|
*
|
||||||
* Numbers are of the form [-+]R[rR]I.F[eE&][-+]X where R is the radix, I is
|
* Numbers are of the form [-+]R[rR]I.F[eE&][-+]X in pseudo-regex form, where R
|
||||||
* the integer part, F is the fractional part, and X is the exponent. All
|
* is the radix, I is the integer part, F is the fractional part, and X is the
|
||||||
* signs, radix, decimal point, fractional part, and exponent can be ommited.
|
* exponent. All signs, radix, decimal point, fractional part, and exponent can
|
||||||
* The number will be considered and integer if the there is no decimal point
|
* be omitted. The radix is assumed to be 10 if omitted, and the E or e
|
||||||
* and no exponent. Any number greater the 2^32-1 or less than -(2^32) will be
|
|
||||||
* coerced to a double. If there is an error, the function janet_scan_number will
|
|
||||||
* return a janet nil. The radix is assumed to be 10 if omitted, and the E
|
|
||||||
* separator for the exponent can only be used when the radix is 10. This is
|
* separator for the exponent can only be used when the radix is 10. This is
|
||||||
* because E is a vaid digit in bases 15 or greater. For bases greater than 10,
|
* because E is a valid digit in bases 15 or greater. For bases greater than
|
||||||
* the letters are used as digitis. A through Z correspond to the digits 10
|
* 10, the letters are used as digits. A through Z correspond to the digits 10
|
||||||
* through 35, and the lowercase letters have the same values. The radix number
|
* through 35, and the lowercase letters have the same values. The radix number
|
||||||
* is always in base 10. For example, a hexidecimal number could be written
|
* is always in base 10. For example, a hexidecimal number could be written
|
||||||
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
|
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
|
||||||
* hexidecimal literals. The previous number could also be written
|
* hexidecimal literals. The previous number could also be written
|
||||||
* '0xdeadbeef'. Note that in this case, the number will actually be a double
|
* '0xdeadbeef'.
|
||||||
* as it will not fit in the range for a signed 32 bit integer. The string
|
*/
|
||||||
* '0xbeef' would parse to an integer as it is in the range of an int32_t. */
|
|
||||||
|
|
||||||
#include <janet/janet.h>
|
|
||||||
#include <math.h>
|
#include <math.h>
|
||||||
|
#include <string.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Lookup table for getting values of characters when parsing numbers. Handles
|
/* Lookup table for getting values of characters when parsing numbers. Handles
|
||||||
* digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */
|
* digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */
|
||||||
static uint8_t digit_lookup[128] = {
|
static uint8_t digit_lookup[128] = {
|
||||||
0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
|
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
|
||||||
0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
|
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
|
||||||
0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
|
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
|
||||||
0,1,2,3,4,5,6,7,8,9,0xff,0xff,0xff,0xff,0xff,0xff,
|
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
|
||||||
0xff,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
|
0xff, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
|
||||||
25,26,27,28,29,30,31,32,33,34,35,0xff,0xff,0xff,0xff,0xff,
|
25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 0xff, 0xff, 0xff, 0xff, 0xff,
|
||||||
0xff,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
|
0xff, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
|
||||||
25,26,27,28,29,30,31,32,33,34,35,0xff,0xff,0xff,0xff,0xff
|
25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 0xff, 0xff, 0xff, 0xff, 0xff
|
||||||
};
|
};
|
||||||
|
|
||||||
|
#define BIGNAT_NBIT 31
|
||||||
|
#define BIGNAT_BASE 0x80000000U
|
||||||
|
|
||||||
|
/* Allow for large mantissa. BigNat is a natural number. */
|
||||||
|
struct BigNat {
|
||||||
|
uint32_t first_digit; /* First digit so we don't need to allocate when not needed. */
|
||||||
|
int32_t n; /* n digits */
|
||||||
|
int32_t cap; /* allocated digit capacity */
|
||||||
|
uint32_t *digits; /* Each digit is base (2 ^ 31). Digits are least significant first. */
|
||||||
|
};
|
||||||
|
|
||||||
|
/* Initialize a bignat to 0 */
|
||||||
|
static void bignat_zero(struct BigNat *x) {
|
||||||
|
x->first_digit = 0;
|
||||||
|
x->n = 0;
|
||||||
|
x->cap = 0;
|
||||||
|
x->digits = NULL;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Allocate n more digits for mant. Return a pointer to these digits. */
|
||||||
|
static uint32_t *bignat_extra(struct BigNat *mant, int32_t n) {
|
||||||
|
int32_t oldn = mant->n;
|
||||||
|
int32_t newn = oldn + n;
|
||||||
|
if (mant->cap < newn) {
|
||||||
|
int32_t newcap = 2 * newn;
|
||||||
|
uint32_t *mem = realloc(mant->digits, newcap * sizeof(uint32_t));
|
||||||
|
if (NULL == mem) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
mant->cap = newcap;
|
||||||
|
mant->digits = mem;
|
||||||
|
}
|
||||||
|
mant->n = newn;
|
||||||
|
return mant->digits + oldn;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Append a digit */
|
||||||
|
static void bignat_append(struct BigNat *mant, uint32_t dig) {
|
||||||
|
bignat_extra(mant, 1)[0] = dig;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Multiply the mantissa mant by a factor and the add a term
|
||||||
|
* in one operation. factor will be between 2 and 36^4,
|
||||||
|
* term will be between 0 and 36. */
|
||||||
|
static void bignat_muladd(struct BigNat *mant, uint32_t factor, uint32_t term) {
|
||||||
|
int32_t i;
|
||||||
|
uint64_t carry = ((uint64_t) mant->first_digit) * factor + term;
|
||||||
|
mant->first_digit = carry % BIGNAT_BASE;
|
||||||
|
carry /= BIGNAT_BASE;
|
||||||
|
for (i = 0; i < mant->n; i++) {
|
||||||
|
carry += ((uint64_t) mant->digits[i]) * factor;
|
||||||
|
mant->digits[i] = carry % BIGNAT_BASE;
|
||||||
|
carry /= BIGNAT_BASE;
|
||||||
|
}
|
||||||
|
if (carry) bignat_append(mant, (uint32_t) carry);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Divide the mantissa mant by a factor. Drop the remainder. */
|
||||||
|
static void bignat_div(struct BigNat *mant, uint32_t divisor) {
|
||||||
|
int32_t i;
|
||||||
|
uint32_t quotient, remainder;
|
||||||
|
uint64_t dividend;
|
||||||
|
remainder = 0, quotient = 0;
|
||||||
|
for (i = mant->n - 1; i >= 0; i--) {
|
||||||
|
dividend = ((uint64_t)remainder * BIGNAT_BASE) + mant->digits[i];
|
||||||
|
if (i < mant->n - 1) mant->digits[i + 1] = quotient;
|
||||||
|
quotient = (uint32_t)(dividend / divisor);
|
||||||
|
remainder = (uint32_t)(dividend % divisor);
|
||||||
|
mant->digits[i] = remainder;
|
||||||
|
}
|
||||||
|
dividend = ((uint64_t)remainder * BIGNAT_BASE) + mant->first_digit;
|
||||||
|
if (mant->n && mant->digits[mant->n - 1] == 0) mant->n--;
|
||||||
|
mant->first_digit = (uint32_t)(dividend / divisor);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Shift left by a multiple of BIGNAT_NBIT */
|
||||||
|
static void bignat_lshift_n(struct BigNat *mant, int n) {
|
||||||
|
if (!n) return;
|
||||||
|
int32_t oldn = mant->n;
|
||||||
|
bignat_extra(mant, n);
|
||||||
|
memmove(mant->digits + n, mant->digits, sizeof(uint32_t) * oldn);
|
||||||
|
memset(mant->digits, 0, sizeof(uint32_t) * (n - 1));
|
||||||
|
mant->digits[n - 1] = mant->first_digit;
|
||||||
|
mant->first_digit = 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef __GNUC__
|
||||||
|
#define clz(x) __builtin_clz(x)
|
||||||
|
#else
|
||||||
|
static int clz(uint32_t x) {
|
||||||
|
int n = 0;
|
||||||
|
if (x <= 0x0000ffff) n += 16, x <<= 16;
|
||||||
|
if (x <= 0x00ffffff) n += 8, x <<= 8;
|
||||||
|
if (x <= 0x0fffffff) n += 4, x <<= 4;
|
||||||
|
if (x <= 0x3fffffff) n += 2, x <<= 2;
|
||||||
|
if (x <= 0x7fffffff) n ++;
|
||||||
|
return n;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Extract double value from mantissa */
|
||||||
|
static double bignat_extract(struct BigNat *mant, int32_t exponent2) {
|
||||||
|
uint64_t top53;
|
||||||
|
int32_t n = mant->n;
|
||||||
|
/* Get most significant 53 bits from mant. Bit 52 (0 indexed) should
|
||||||
|
* always be 1. This is essentially a large right shift on mant.*/
|
||||||
|
if (n) {
|
||||||
|
/* Two or more digits */
|
||||||
|
uint64_t d1 = mant->digits[n - 1]; /* MSD (non-zero) */
|
||||||
|
uint64_t d2 = (n == 1) ? mant->first_digit : mant->digits[n - 2];
|
||||||
|
uint64_t d3 = (n > 2) ? mant->digits[n - 3] : (n == 2) ? mant->first_digit : 0;
|
||||||
|
int lz = clz((uint32_t) d1);
|
||||||
|
int nbits = 32 - lz;
|
||||||
|
/* First get 54 bits */
|
||||||
|
top53 = (d2 << (54 - BIGNAT_NBIT)) + (d3 >> (2 * BIGNAT_NBIT - 54));
|
||||||
|
top53 >>= nbits;
|
||||||
|
top53 |= (d1 << (54 - nbits));
|
||||||
|
/* Rounding based on lowest bit of 54 */
|
||||||
|
if (top53 & 1) top53++;
|
||||||
|
top53 >>= 1;
|
||||||
|
if (top53 > 0x1FffffFFFFffffUL) {
|
||||||
|
top53 >>= 1;
|
||||||
|
exponent2++;
|
||||||
|
}
|
||||||
|
/* Correct exponent - to correct for large right shift to mantissa. */
|
||||||
|
exponent2 += (nbits - 53) + BIGNAT_NBIT * n;
|
||||||
|
} else {
|
||||||
|
/* One digit */
|
||||||
|
top53 = mant->first_digit;
|
||||||
|
}
|
||||||
|
return ldexp((double)top53, exponent2);
|
||||||
|
}
|
||||||
|
|
||||||
/* Read in a mantissa and exponent of a certain base, and give
|
/* Read in a mantissa and exponent of a certain base, and give
|
||||||
* back the double value. Should properly handle 0s, Inifinties, and
|
* back the double value. Should properly handle 0s, infinities, and
|
||||||
* denormalized numbers. (When the exponent values are too large) */
|
* denormalized numbers. (When the exponent values are too large) */
|
||||||
static double convert(
|
static double convert(
|
||||||
int negative,
|
int negative,
|
||||||
uint64_t mantissa,
|
struct BigNat *mant,
|
||||||
int32_t base,
|
int32_t base,
|
||||||
int32_t exponent) {
|
int32_t exponent) {
|
||||||
|
|
||||||
int32_t exponent2 = 0;
|
int32_t exponent2 = 0;
|
||||||
|
|
||||||
/* Short circuit zero and huge numbers */
|
/* Short circuit zero and huge numbers */
|
||||||
if (mantissa == 0)
|
if (mant->n == 0 && mant->first_digit == 0)
|
||||||
return 0.0;
|
return negative ? -0.0 : 0.0;
|
||||||
if (exponent > 1022)
|
if (exponent > 1023)
|
||||||
return negative ? -INFINITY : INFINITY;
|
return negative ? -INFINITY : INFINITY;
|
||||||
|
|
||||||
/* TODO add fast paths */
|
/* Final value is X = mant * base ^ exponent * 2 ^ exponent2
|
||||||
|
* Get exponent to zero while holding X constant. */
|
||||||
|
|
||||||
/* Convert exponent on the base into exponent2, the power of
|
/* Positive exponents are simple */
|
||||||
* 2 the will be used. Modify the mantissa as we convert. */
|
for (; exponent > 3; exponent -= 4) bignat_muladd(mant, base * base * base * base, 0);
|
||||||
if (exponent > 0) {
|
for (; exponent > 1; exponent -= 2) bignat_muladd(mant, base * base, 0);
|
||||||
/* Make the mantissa large enough so no precision is lost */
|
for (; exponent > 0; exponent -= 1) bignat_muladd(mant, base, 0);
|
||||||
while (mantissa <= 0x03ffffffffffffffULL && exponent > 0) {
|
|
||||||
mantissa *= base;
|
/* Negative exponents are tricky - we don't want to loose bits
|
||||||
exponent--;
|
* from integer division, so we need to premultiply. */
|
||||||
}
|
if (exponent < 0) {
|
||||||
while (exponent > 0) {
|
int32_t shamt = 5 - exponent / 4;
|
||||||
/* Allow 6 bits of room when multiplying. This is because
|
bignat_lshift_n(mant, shamt);
|
||||||
* the largest base is 36, which is 6 bits. The space of 6 should
|
exponent2 -= shamt * BIGNAT_NBIT;
|
||||||
* prevent overflow.*/
|
for (; exponent < -3; exponent += 4) bignat_div(mant, base * base * base * base);
|
||||||
mantissa >>= 1;
|
for (; exponent < -1; exponent += 2) bignat_div(mant, base * base);
|
||||||
exponent2++;
|
for (; exponent < 0; exponent += 1) bignat_div(mant, base);
|
||||||
if (mantissa <= 0x03ffffffffffffffULL) {
|
|
||||||
mantissa *= base;
|
|
||||||
exponent--;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
while (exponent < 0) {
|
|
||||||
mantissa <<= 1;
|
|
||||||
exponent2--;
|
|
||||||
/* Ensure that the last bit is set for minimum error
|
|
||||||
* before dividing by the base */
|
|
||||||
if (mantissa > 0x7fffffffffffffffULL) {
|
|
||||||
mantissa /= base;
|
|
||||||
exponent++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
return negative
|
return negative
|
||||||
? -ldexp((double) mantissa, exponent2)
|
? -bignat_extract(mant, exponent2)
|
||||||
: ldexp((double) mantissa, exponent2);
|
: bignat_extract(mant, exponent2);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Result of scanning a number source string. Will be further processed
|
/* Scan a real (double) from a string. If the string cannot be converted into
|
||||||
* depending on the desired resultant type. */
|
* and integer, set *err to 1 and return 0. */
|
||||||
struct JanetScanRes {
|
int janet_scan_number(
|
||||||
uint64_t mant;
|
|
||||||
int32_t ex;
|
|
||||||
int error;
|
|
||||||
int base;
|
|
||||||
int seenpoint;
|
|
||||||
int foundexp;
|
|
||||||
int neg;
|
|
||||||
};
|
|
||||||
|
|
||||||
/* Get the mantissa and exponent of decimal number. The
|
|
||||||
* mantissa will be stored in a 64 bit unsigned integer (always positive).
|
|
||||||
* The exponent will be in a signed 32 bit integer. Will also check if
|
|
||||||
* the decimal point has been seen. Returns -1 if there is an invalid
|
|
||||||
* number. */
|
|
||||||
static struct JanetScanRes janet_scan_impl(
|
|
||||||
const uint8_t *str,
|
const uint8_t *str,
|
||||||
int32_t len) {
|
int32_t len,
|
||||||
|
double *out) {
|
||||||
struct JanetScanRes res;
|
|
||||||
const uint8_t *end = str + len;
|
const uint8_t *end = str + len;
|
||||||
|
|
||||||
/* Initialize flags */
|
|
||||||
int seenadigit = 0;
|
int seenadigit = 0;
|
||||||
int gotradix = 0;
|
int ex = 0;
|
||||||
|
int base = 10;
|
||||||
/* Initialize result */
|
int seenpoint = 0;
|
||||||
res.mant = 0;
|
int foundexp = 0;
|
||||||
res.ex = 0;
|
int neg = 0;
|
||||||
res.error = 0;
|
struct BigNat mant;
|
||||||
res.base = 10;
|
bignat_zero(&mant);
|
||||||
res.seenpoint = 0;
|
|
||||||
res.foundexp = 0;
|
|
||||||
res.neg = 0;
|
|
||||||
|
|
||||||
/* Prevent some kinds of overflow bugs relating to the exponent
|
/* Prevent some kinds of overflow bugs relating to the exponent
|
||||||
* overflowing. For example, if a string was passed 2GB worth of 0s after
|
* overflowing. For example, if a string was passed 2GB worth of 0s after
|
||||||
@@ -168,57 +261,60 @@ static struct JanetScanRes janet_scan_impl(
|
|||||||
/* Get sign */
|
/* Get sign */
|
||||||
if (str >= end) goto error;
|
if (str >= end) goto error;
|
||||||
if (*str == '-') {
|
if (*str == '-') {
|
||||||
res.neg = 1;
|
neg = 1;
|
||||||
str++;
|
str++;
|
||||||
} else if (*str == '+') {
|
} else if (*str == '+') {
|
||||||
str++;
|
str++;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Check for leading 0x or digit digit r */
|
||||||
|
if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
|
||||||
|
base = 16;
|
||||||
|
str += 2;
|
||||||
|
} else if (str + 1 < end &&
|
||||||
|
str[0] >= '0' && str[0] <= '9' &&
|
||||||
|
str[1] == 'r') {
|
||||||
|
base = str[0] - '0';
|
||||||
|
str += 2;
|
||||||
|
} else if (str + 2 < end &&
|
||||||
|
str[0] >= '0' && str[0] <= '9' &&
|
||||||
|
str[1] >= '0' && str[1] <= '9' &&
|
||||||
|
str[2] == 'r') {
|
||||||
|
base = 10 * (str[0] - '0') + (str[1] - '0');
|
||||||
|
if (base < 2 || base > 36) goto error;
|
||||||
|
str += 3;
|
||||||
|
}
|
||||||
|
|
||||||
/* Skip leading zeros */
|
/* Skip leading zeros */
|
||||||
while (str < end && (*str == '0' || *str == '.')) {
|
while (str < end && (*str == '0' || *str == '.')) {
|
||||||
if (res.seenpoint) res.ex--;
|
if (seenpoint) ex--;
|
||||||
if (*str == '.') {
|
if (*str == '.') {
|
||||||
if (res.seenpoint) goto error;
|
if (seenpoint) goto error;
|
||||||
res.seenpoint = 1;
|
seenpoint = 1;
|
||||||
}
|
} else {
|
||||||
seenadigit = 1;
|
seenadigit = 1;
|
||||||
|
}
|
||||||
str++;
|
str++;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Parse significant digits */
|
/* Parse significant digits */
|
||||||
while (str < end) {
|
while (str < end) {
|
||||||
if (*str == '.') {
|
if (*str == '.') {
|
||||||
if (res.seenpoint) goto error;
|
if (seenpoint) goto error;
|
||||||
res.seenpoint = 1;
|
seenpoint = 1;
|
||||||
} else if (*str == '&') {
|
} else if (*str == '&') {
|
||||||
res.foundexp = 1;
|
foundexp = 1;
|
||||||
break;
|
break;
|
||||||
} else if (res.base == 10 && (*str == 'E' || *str == 'e')) {
|
} else if (base == 10 && (*str == 'E' || *str == 'e')) {
|
||||||
res.foundexp = 1;
|
foundexp = 1;
|
||||||
break;
|
break;
|
||||||
} else if (!gotradix && (*str == 'x' || *str == 'X')) {
|
} else if (*str == '_') {
|
||||||
if (!seenadigit) goto error;
|
if (!seenadigit) goto error;
|
||||||
if (res.seenpoint || res.mant > 0) goto error;
|
} else {
|
||||||
res.base = 16;
|
|
||||||
res.mant = 0;
|
|
||||||
seenadigit = 0;
|
|
||||||
gotradix = 1;
|
|
||||||
} else if (!gotradix && (*str == 'r' || *str == 'R')) {
|
|
||||||
if (res.seenpoint) goto error;
|
|
||||||
if (res.mant < 2 || res.mant > 36) goto error;
|
|
||||||
res.base = (int) res.mant;
|
|
||||||
res.mant = 0;
|
|
||||||
seenadigit = 0;
|
|
||||||
gotradix = 1;
|
|
||||||
} else if (*str != '_') {
|
|
||||||
/* underscores are ignored - can be used for separator */
|
|
||||||
int digit = digit_lookup[*str & 0x7F];
|
int digit = digit_lookup[*str & 0x7F];
|
||||||
if (*str > 127 || digit >= res.base) goto error;
|
if (*str > 127 || digit >= base) goto error;
|
||||||
if (res.seenpoint) res.ex--;
|
if (seenpoint) ex--;
|
||||||
if (res.mant > 0x00ffffffffffffff)
|
bignat_muladd(&mant, base, digit);
|
||||||
res.ex++;
|
|
||||||
else
|
|
||||||
res.mant = res.base * res.mant + digit;
|
|
||||||
seenadigit = 1;
|
seenadigit = 1;
|
||||||
}
|
}
|
||||||
str++;
|
str++;
|
||||||
@@ -228,7 +324,7 @@ static struct JanetScanRes janet_scan_impl(
|
|||||||
goto error;
|
goto error;
|
||||||
|
|
||||||
/* Read exponent */
|
/* Read exponent */
|
||||||
if (str < end && res.foundexp) {
|
if (str < end && foundexp) {
|
||||||
int eneg = 0;
|
int eneg = 0;
|
||||||
int ee = 0;
|
int ee = 0;
|
||||||
seenadigit = 0;
|
seenadigit = 0;
|
||||||
@@ -241,90 +337,126 @@ static struct JanetScanRes janet_scan_impl(
|
|||||||
str++;
|
str++;
|
||||||
}
|
}
|
||||||
/* Skip leading 0s in exponent */
|
/* Skip leading 0s in exponent */
|
||||||
while (str < end && *str == '0') str++;
|
while (str < end && *str == '0') {
|
||||||
while (str < end && ee < (INT32_MAX / 40)) {
|
|
||||||
int digit = digit_lookup[*str & 0x7F];
|
|
||||||
if (*str == '_') {
|
|
||||||
str++;
|
|
||||||
continue;
|
|
||||||
}
|
|
||||||
if (*str > 127 || digit >= res.base) goto error;
|
|
||||||
ee = res.base * ee + digit;
|
|
||||||
str++;
|
str++;
|
||||||
seenadigit = 1;
|
seenadigit = 1;
|
||||||
}
|
}
|
||||||
if (eneg) res.ex -= ee; else res.ex += ee;
|
while (str < end && ee < (INT32_MAX / 40)) {
|
||||||
|
int digit = digit_lookup[*str & 0x7F];
|
||||||
|
if (*str > 127 || digit >= base) goto error;
|
||||||
|
ee = base * ee + digit;
|
||||||
|
str++;
|
||||||
|
seenadigit = 1;
|
||||||
|
}
|
||||||
|
if (eneg) ex -= ee;
|
||||||
|
else ex += ee;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (!seenadigit)
|
if (!seenadigit)
|
||||||
goto error;
|
goto error;
|
||||||
|
|
||||||
return res;
|
*out = convert(neg, &mant, base, ex);
|
||||||
|
free(mant.digits);
|
||||||
|
return 0;
|
||||||
|
|
||||||
error:
|
error:
|
||||||
res.error = 1;
|
free(mant.digits);
|
||||||
return res;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Scan an integer from a string. If the string cannot be converted into
|
#ifdef JANET_INT_TYPES
|
||||||
* and integer, set *err to 1 and return 0. */
|
|
||||||
int32_t janet_scan_integer(
|
static int scan_uint64(
|
||||||
const uint8_t *str,
|
const uint8_t *str,
|
||||||
int32_t len,
|
int32_t len,
|
||||||
int *err) {
|
uint64_t *out,
|
||||||
struct JanetScanRes res = janet_scan_impl(str, len);
|
int *neg) {
|
||||||
int64_t i64;
|
const uint8_t *end = str + len;
|
||||||
if (res.error) goto error;
|
int seenadigit = 0;
|
||||||
if (res.seenpoint) goto error;
|
int base = 10;
|
||||||
if (res.ex < 0) goto error;
|
*neg = 0;
|
||||||
i64 = res.neg ? -(int64_t)res.mant : (int64_t)res.mant;
|
*out = 0;
|
||||||
while (res.ex > 0) {
|
uint64_t accum = 0;
|
||||||
i64 *= res.base;
|
/* len max is INT64_MAX in base 2 with _ between each bits */
|
||||||
if (i64 > INT32_MAX || i64 < INT32_MIN) goto error;
|
/* '2r' + 64 bits + 63 _ + sign = 130 => 150 for some leading */
|
||||||
res.ex--;
|
/* zeros */
|
||||||
|
if (len > 150) return 0;
|
||||||
|
/* Get sign */
|
||||||
|
if (str >= end) return 0;
|
||||||
|
if (*str == '-') {
|
||||||
|
*neg = 1;
|
||||||
|
str++;
|
||||||
|
} else if (*str == '+') {
|
||||||
|
str++;
|
||||||
|
}
|
||||||
|
/* Check for leading 0x or digit digit r */
|
||||||
|
if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
|
||||||
|
base = 16;
|
||||||
|
str += 2;
|
||||||
|
} else if (str + 1 < end &&
|
||||||
|
str[0] >= '0' && str[0] <= '9' &&
|
||||||
|
str[1] == 'r') {
|
||||||
|
base = str[0] - '0';
|
||||||
|
str += 2;
|
||||||
|
} else if (str + 2 < end &&
|
||||||
|
str[0] >= '0' && str[0] <= '9' &&
|
||||||
|
str[1] >= '0' && str[1] <= '9' &&
|
||||||
|
str[2] == 'r') {
|
||||||
|
base = 10 * (str[0] - '0') + (str[1] - '0');
|
||||||
|
if (base < 2 || base > 36) return 0;
|
||||||
|
str += 3;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Skip leading zeros */
|
||||||
|
while (str < end && *str == '0') {
|
||||||
|
seenadigit = 1;
|
||||||
|
str++;
|
||||||
|
}
|
||||||
|
/* Parse significant digits */
|
||||||
|
while (str < end) {
|
||||||
|
if (*str == '_') {
|
||||||
|
if (!seenadigit) return 0;
|
||||||
|
} else {
|
||||||
|
int digit = digit_lookup[*str & 0x7F];
|
||||||
|
if (*str > 127 || digit >= base) return 0;
|
||||||
|
if (accum > (UINT64_MAX - digit) / base) return 0;
|
||||||
|
accum = accum * base + digit;
|
||||||
|
seenadigit = 1;
|
||||||
|
}
|
||||||
|
str++;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (!seenadigit) return 0;
|
||||||
|
*out = accum;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
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);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if (!neg && bi <= 0x7FFFFFFFFFFFFFFFULL) {
|
||||||
|
*out = bi;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
if (i64 > INT32_MAX || i64 < INT32_MIN) goto error;
|
|
||||||
if (NULL != err)
|
|
||||||
*err = 0;
|
|
||||||
return (int32_t) i64;
|
|
||||||
error:
|
|
||||||
if (NULL != err)
|
|
||||||
*err = 1;
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Scan a real (double) from a string. If the string cannot be converted into
|
int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
|
||||||
* and integer, set *err to 1 and return 0. */
|
int neg;
|
||||||
double janet_scan_real(
|
uint64_t bi;
|
||||||
const uint8_t *str,
|
if (scan_uint64(str, len, &bi, &neg)) {
|
||||||
int32_t len,
|
if (!neg) {
|
||||||
int *err) {
|
*out = bi;
|
||||||
struct JanetScanRes res = janet_scan_impl(str, len);
|
return 1;
|
||||||
if (res.error) {
|
|
||||||
if (NULL != err)
|
|
||||||
*err = 1;
|
|
||||||
return 0.0;
|
|
||||||
} else {
|
|
||||||
if (NULL != err)
|
|
||||||
*err = 0;
|
|
||||||
}
|
}
|
||||||
return convert(res.neg, res.mant, res.base, res.ex);
|
}
|
||||||
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Scans a number from a string. Can return either an integer or a real if
|
#endif
|
||||||
* the number cannot be represented as an integer. Will return nil in case of
|
|
||||||
* an error. */
|
|
||||||
Janet janet_scan_number(
|
|
||||||
const uint8_t *str,
|
|
||||||
int32_t len) {
|
|
||||||
struct JanetScanRes res = janet_scan_impl(str, len);
|
|
||||||
if (res.error)
|
|
||||||
return janet_wrap_nil();
|
|
||||||
if (!res.foundexp && !res.seenpoint) {
|
|
||||||
int64_t i64 = res.neg ? -(int64_t)res.mant : (int64_t)res.mant;
|
|
||||||
if (i64 <= INT32_MAX && i64 >= INT32_MIN) {
|
|
||||||
return janet_wrap_integer((int32_t) i64);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return janet_wrap_real(convert(res.neg, res.mant, res.base, res.ex));
|
|
||||||
}
|
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,24 +20,27 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#include <math.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Begin creation of a struct */
|
/* Begin creation of a struct */
|
||||||
JanetKV *janet_struct_begin(int32_t count) {
|
JanetKV *janet_struct_begin(int32_t count) {
|
||||||
|
|
||||||
/* Calculate capacity as power of 2 after 2 * count. */
|
/* Calculate capacity as power of 2 after 2 * count. */
|
||||||
int32_t capacity = janet_tablen(2 * count);
|
int32_t capacity = janet_tablen(2 * count);
|
||||||
if (capacity < 0) capacity = janet_tablen(count + 1);
|
if (capacity < 0) capacity = janet_tablen(count + 1);
|
||||||
|
|
||||||
size_t s = sizeof(int32_t) * 4 + (capacity * sizeof(JanetKV));
|
size_t size = sizeof(JanetStructHead) + capacity * sizeof(JanetKV);
|
||||||
char *data = janet_gcalloc(JANET_MEMORY_STRUCT, s);
|
JanetStructHead *head = janet_gcalloc(JANET_MEMORY_STRUCT, size);
|
||||||
JanetKV *st = (JanetKV *) (data + 4 * sizeof(int32_t));
|
head->length = count;
|
||||||
|
head->capacity = capacity;
|
||||||
|
head->hash = 0;
|
||||||
|
|
||||||
|
JanetKV *st = (JanetKV *)(head->data);
|
||||||
janet_memempty(st, capacity);
|
janet_memempty(st, capacity);
|
||||||
janet_struct_length(st) = count;
|
|
||||||
janet_struct_capacity(st) = capacity;
|
|
||||||
janet_struct_hash(st) = 0;
|
|
||||||
return st;
|
return st;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -62,7 +65,7 @@ const JanetKV *janet_struct_find(const JanetKV *st, Janet key) {
|
|||||||
*
|
*
|
||||||
* Runs will be in sorted order, as the collisions resolver essentially
|
* Runs will be in sorted order, as the collisions resolver essentially
|
||||||
* preforms an in-place insertion sort. This ensures the internal structure of the
|
* preforms an in-place insertion sort. This ensures the internal structure of the
|
||||||
* hash map is independant of insertion order.
|
* hash map is independent of insertion order.
|
||||||
*/
|
*/
|
||||||
void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||||
int32_t cap = janet_struct_capacity(st);
|
int32_t cap = janet_struct_capacity(st);
|
||||||
@@ -71,6 +74,7 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
|||||||
int32_t i, j, dist;
|
int32_t i, j, dist;
|
||||||
int32_t bounds[4] = {index, cap, 0, index};
|
int32_t bounds[4] = {index, cap, 0, index};
|
||||||
if (janet_checktype(key, JANET_NIL) || janet_checktype(value, JANET_NIL)) return;
|
if (janet_checktype(key, JANET_NIL) || janet_checktype(value, JANET_NIL)) return;
|
||||||
|
if (janet_checktype(key, JANET_NUMBER) && isnan(janet_unwrap_number(key))) return;
|
||||||
/* Avoid extra items */
|
/* Avoid extra items */
|
||||||
if (janet_struct_hash(st) == janet_struct_length(st)) return;
|
if (janet_struct_hash(st) == janet_struct_length(st)) return;
|
||||||
for (dist = 0, j = 0; j < 4; j += 2)
|
for (dist = 0, j = 0; j < 4; j += 2)
|
||||||
@@ -89,7 +93,7 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
|||||||
}
|
}
|
||||||
/* Robinhood hashing - check if colliding kv pair
|
/* Robinhood hashing - check if colliding kv pair
|
||||||
* is closer to their source than current. We use robinhood
|
* is closer to their source than current. We use robinhood
|
||||||
* hashing to ensure that equivalent structs that are contsructed
|
* hashing to ensure that equivalent structs that are constructed
|
||||||
* with different order have the same internal layout, and therefor
|
* with different order have the same internal layout, and therefor
|
||||||
* will compare properly - i.e., {1 2 3 4} should equal {3 4 1 2}.
|
* will compare properly - i.e., {1 2 3 4} should equal {3 4 1 2}.
|
||||||
* Collisions are resolved via an insertion sort insertion. */
|
* Collisions are resolved via an insertion sort insertion. */
|
||||||
@@ -118,9 +122,7 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
|||||||
dist = otherdist;
|
dist = otherdist;
|
||||||
hash = otherhash;
|
hash = otherhash;
|
||||||
} else if (status == 0) {
|
} else if (status == 0) {
|
||||||
/* This should not happen - it means
|
/* A key was added to the struct more than once */
|
||||||
* than a key was added to the struct more than once */
|
|
||||||
janet_exit("struct double put fail");
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -132,15 +134,8 @@ const JanetKV *janet_struct_end(JanetKV *st) {
|
|||||||
/* Error building struct, probably duplicate values. We need to rebuild
|
/* Error building struct, probably duplicate values. We need to rebuild
|
||||||
* the struct using only the values that went in. The second creation should always
|
* the struct using only the values that went in. The second creation should always
|
||||||
* succeed. */
|
* succeed. */
|
||||||
int32_t i, realCount;
|
JanetKV *newst = janet_struct_begin(janet_struct_hash(st));
|
||||||
JanetKV *newst;
|
for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||||
realCount = 0;
|
|
||||||
for (i = 0; i < janet_struct_capacity(st); i++) {
|
|
||||||
JanetKV *kv = st + i;
|
|
||||||
realCount += janet_checktype(kv->key, JANET_NIL) ? 1 : 0;
|
|
||||||
}
|
|
||||||
newst = janet_struct_begin(realCount);
|
|
||||||
for (i = 0; i < janet_struct_capacity(st); i++) {
|
|
||||||
JanetKV *kv = st + i;
|
JanetKV *kv = st + i;
|
||||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||||
janet_struct_put(newst, kv->key, kv->value);
|
janet_struct_put(newst, kv->key, kv->value);
|
||||||
@@ -158,17 +153,6 @@ Janet janet_struct_get(const JanetKV *st, Janet key) {
|
|||||||
return kv ? kv->value : janet_wrap_nil();
|
return kv ? kv->value : janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Get the next key in a struct */
|
|
||||||
const JanetKV *janet_struct_next(const JanetKV *st, const JanetKV *kv) {
|
|
||||||
const JanetKV *end = st + janet_struct_capacity(st);
|
|
||||||
kv = (kv == NULL) ? st : kv + 1;
|
|
||||||
while (kv < end) {
|
|
||||||
if (!janet_checktype(kv->key, JANET_NIL)) return kv;
|
|
||||||
kv++;
|
|
||||||
}
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Convert struct to table */
|
/* Convert struct to table */
|
||||||
JanetTable *janet_struct_to_table(const JanetKV *st) {
|
JanetTable *janet_struct_to_table(const JanetKV *st) {
|
||||||
JanetTable *table = janet_table(janet_struct_capacity(st));
|
JanetTable *table = janet_table(janet_struct_capacity(st));
|
||||||
@@ -229,5 +213,3 @@ int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs) {
|
|||||||
}
|
}
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
#undef janet_maphash
|
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -25,10 +25,15 @@
|
|||||||
* checks, all symbols are interned so that there is a single copy of it in the
|
* checks, all symbols are interned so that there is a single copy of it in the
|
||||||
* whole program. Equality is then just a pointer check. */
|
* whole program. Equality is then just a pointer check. */
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <string.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#include "symcache.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Cache state */
|
/* Cache state */
|
||||||
JANET_THREAD_LOCAL const uint8_t **janet_vm_cache = NULL;
|
JANET_THREAD_LOCAL const uint8_t **janet_vm_cache = NULL;
|
||||||
@@ -39,7 +44,7 @@ JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted = 0;
|
|||||||
/* Initialize the cache (allocate cache memory) */
|
/* Initialize the cache (allocate cache memory) */
|
||||||
void janet_symcache_init() {
|
void janet_symcache_init() {
|
||||||
janet_vm_cache_capacity = 1024;
|
janet_vm_cache_capacity = 1024;
|
||||||
janet_vm_cache = calloc(1, janet_vm_cache_capacity * sizeof(const uint8_t **));
|
janet_vm_cache = calloc(1, janet_vm_cache_capacity * sizeof(const uint8_t *));
|
||||||
if (NULL == janet_vm_cache) {
|
if (NULL == janet_vm_cache) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -79,7 +84,7 @@ static const uint8_t **janet_symcache_findmem(
|
|||||||
bounds[2] = 0;
|
bounds[2] = 0;
|
||||||
bounds[3] = index;
|
bounds[3] = index;
|
||||||
for (j = 0; j < 4; j += 2)
|
for (j = 0; j < 4; j += 2)
|
||||||
for (i = bounds[j]; i < bounds[j+1]; ++i) {
|
for (i = bounds[j]; i < bounds[j + 1]; ++i) {
|
||||||
const uint8_t *test = janet_vm_cache[i];
|
const uint8_t *test = janet_vm_cache[i];
|
||||||
/* Check empty spots */
|
/* Check empty spots */
|
||||||
if (NULL == test) {
|
if (NULL == test) {
|
||||||
@@ -104,7 +109,7 @@ static const uint8_t **janet_symcache_findmem(
|
|||||||
return janet_vm_cache + i;
|
return janet_vm_cache + i;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
notfound:
|
notfound:
|
||||||
*success = 0;
|
*success = 0;
|
||||||
return firstEmpty;
|
return firstEmpty;
|
||||||
}
|
}
|
||||||
@@ -116,7 +121,7 @@ static const uint8_t **janet_symcache_findmem(
|
|||||||
static void janet_cache_resize(uint32_t newCapacity) {
|
static void janet_cache_resize(uint32_t newCapacity) {
|
||||||
uint32_t i, oldCapacity;
|
uint32_t i, oldCapacity;
|
||||||
const uint8_t **oldCache = janet_vm_cache;
|
const uint8_t **oldCache = janet_vm_cache;
|
||||||
const uint8_t **newCache = calloc(1, newCapacity * sizeof(const uint8_t **));
|
const uint8_t **newCache = calloc(1, newCapacity * sizeof(const uint8_t *));
|
||||||
if (newCache == NULL) {
|
if (newCache == NULL) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -173,10 +178,10 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
|||||||
const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success);
|
const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success);
|
||||||
if (success)
|
if (success)
|
||||||
return *bucket;
|
return *bucket;
|
||||||
newstr = (uint8_t *) janet_gcalloc(JANET_MEMORY_SYMBOL, 2 * sizeof(int32_t) + len + 1)
|
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + len + 1);
|
||||||
+ (2 * sizeof(int32_t));
|
head->hash = hash;
|
||||||
janet_string_hash(newstr) = hash;
|
head->length = len;
|
||||||
janet_string_length(newstr) = len;
|
newstr = (uint8_t *)(head->data);
|
||||||
memcpy(newstr, str, len);
|
memcpy(newstr, str, len);
|
||||||
newstr[len] = 0;
|
newstr[len] = 0;
|
||||||
janet_symcache_put((const uint8_t *)newstr, bucket);
|
janet_symcache_put((const uint8_t *)newstr, bucket);
|
||||||
@@ -185,20 +190,7 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
|||||||
|
|
||||||
/* Get a symbol from a cstring */
|
/* Get a symbol from a cstring */
|
||||||
const uint8_t *janet_csymbol(const char *cstr) {
|
const uint8_t *janet_csymbol(const char *cstr) {
|
||||||
int32_t len = 0;
|
return janet_symbol((const uint8_t *)cstr, (int32_t) strlen(cstr));
|
||||||
while (cstr[len]) len++;
|
|
||||||
return janet_symbol((const uint8_t *)cstr, len);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Convert a string to a symbol */
|
|
||||||
const uint8_t *janet_symbol_from_string(const uint8_t *str) {
|
|
||||||
int success = 0;
|
|
||||||
const uint8_t **bucket = janet_symcache_find(str, &success);
|
|
||||||
if (success)
|
|
||||||
return *bucket;
|
|
||||||
janet_symcache_put((const uint8_t *)str, bucket);
|
|
||||||
janet_gc_settype(janet_string_raw(str), JANET_MEMORY_SYMBOL);
|
|
||||||
return str;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Store counter for genysm to avoid quadratic behavior */
|
/* Store counter for genysm to avoid quadratic behavior */
|
||||||
@@ -242,13 +234,11 @@ const uint8_t *janet_symbol_gen(void) {
|
|||||||
hash,
|
hash,
|
||||||
&status);
|
&status);
|
||||||
} while (status && (inc_gensym(), 1));
|
} while (status && (inc_gensym(), 1));
|
||||||
sym = (uint8_t *) janet_gcalloc(
|
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + sizeof(gensym_counter));
|
||||||
JANET_MEMORY_SYMBOL,
|
head->length = sizeof(gensym_counter) - 1;
|
||||||
2 * sizeof(int32_t) + sizeof(gensym_counter)) +
|
head->hash = hash;
|
||||||
(2 * sizeof(int32_t));
|
sym = (uint8_t *)(head->data);
|
||||||
memcpy(sym, gensym_counter, sizeof(gensym_counter));
|
memcpy(sym, gensym_counter, sizeof(gensym_counter));
|
||||||
janet_string_length(sym) = sizeof(gensym_counter) - 1;
|
|
||||||
janet_string_hash(sym) = hash;
|
|
||||||
janet_symcache_put((const uint8_t *)sym, bucket);
|
janet_symcache_put((const uint8_t *)sym, bucket);
|
||||||
return (const uint8_t *)sym;
|
return (const uint8_t *)sym;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -23,7 +23,9 @@
|
|||||||
#ifndef JANET_SYMCACHE_H_defined
|
#ifndef JANET_SYMCACHE_H_defined
|
||||||
#define JANET_SYMCACHE_H_defined
|
#define JANET_SYMCACHE_H_defined
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Initialize the cache (allocate cache memory) */
|
/* Initialize the cache (allocate cache memory) */
|
||||||
void janet_symcache_init(void);
|
void janet_symcache_init(void);
|
||||||
|
|||||||
123
src/core/table.c
123
src/core/table.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,9 +20,12 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#include <math.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Initialize a table */
|
/* Initialize a table */
|
||||||
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
||||||
@@ -129,6 +132,7 @@ Janet janet_table_remove(JanetTable *t, Janet key) {
|
|||||||
/* Put a value into the object */
|
/* Put a value into the object */
|
||||||
void janet_table_put(JanetTable *t, Janet key, Janet value) {
|
void janet_table_put(JanetTable *t, Janet key, Janet value) {
|
||||||
if (janet_checktype(key, JANET_NIL)) return;
|
if (janet_checktype(key, JANET_NIL)) return;
|
||||||
|
if (janet_checktype(key, JANET_NUMBER) && isnan(janet_unwrap_number(key))) return;
|
||||||
if (janet_checktype(value, JANET_NIL)) {
|
if (janet_checktype(value, JANET_NIL)) {
|
||||||
janet_table_remove(t, key);
|
janet_table_remove(t, key);
|
||||||
} else {
|
} else {
|
||||||
@@ -140,7 +144,7 @@ void janet_table_put(JanetTable *t, Janet key, Janet value) {
|
|||||||
janet_table_rehash(t, janet_tablen(2 * t->count + 2));
|
janet_table_rehash(t, janet_tablen(2 * t->count + 2));
|
||||||
}
|
}
|
||||||
bucket = janet_table_find(t, key);
|
bucket = janet_table_find(t, key);
|
||||||
if (janet_checktype(bucket->value, JANET_FALSE))
|
if (janet_checktype(bucket->value, JANET_BOOLEAN))
|
||||||
--t->deleted;
|
--t->deleted;
|
||||||
bucket->key = key;
|
bucket->key = key;
|
||||||
bucket->value = value;
|
bucket->value = value;
|
||||||
@@ -158,18 +162,6 @@ void janet_table_clear(JanetTable *t) {
|
|||||||
t->deleted = 0;
|
t->deleted = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Find next key in an object. Returns NULL if no next key. */
|
|
||||||
const JanetKV *janet_table_next(JanetTable *t, const JanetKV *kv) {
|
|
||||||
JanetKV *end = t->data + t->capacity;
|
|
||||||
kv = (kv == NULL) ? t->data : kv + 1;
|
|
||||||
while (kv < end) {
|
|
||||||
if (!janet_checktype(kv->key, JANET_NIL))
|
|
||||||
return kv;
|
|
||||||
kv++;
|
|
||||||
}
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Convert table to struct */
|
/* Convert table to struct */
|
||||||
const JanetKV *janet_table_to_struct(JanetTable *t) {
|
const JanetKV *janet_table_to_struct(JanetTable *t) {
|
||||||
JanetKV *st = janet_struct_begin(t->count);
|
JanetKV *st = janet_struct_begin(t->count);
|
||||||
@@ -206,87 +198,80 @@ void janet_table_merge_struct(JanetTable *table, const JanetKV *other) {
|
|||||||
|
|
||||||
/* C Functions */
|
/* C Functions */
|
||||||
|
|
||||||
static int cfun_new(JanetArgs args) {
|
static Janet cfun_table_new(int32_t argc, Janet *argv) {
|
||||||
JanetTable *t;
|
janet_fixarity(argc, 1);
|
||||||
int32_t cap;
|
int32_t cap = janet_getinteger(argv, 0);
|
||||||
JANET_FIXARITY(args, 1);
|
return janet_wrap_table(janet_table(cap));
|
||||||
JANET_ARG_INTEGER(cap, args, 0);
|
|
||||||
t = janet_table(cap);
|
|
||||||
JANET_RETURN_TABLE(args, t);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_getproto(JanetArgs args) {
|
static Janet cfun_table_getproto(int32_t argc, Janet *argv) {
|
||||||
JanetTable *t;
|
janet_fixarity(argc, 1);
|
||||||
JANET_FIXARITY(args, 1);
|
JanetTable *t = janet_gettable(argv, 0);
|
||||||
JANET_ARG_TABLE(t, args, 0);
|
return t->proto
|
||||||
JANET_RETURN(args, t->proto
|
|
||||||
? janet_wrap_table(t->proto)
|
? janet_wrap_table(t->proto)
|
||||||
: janet_wrap_nil());
|
: janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_setproto(JanetArgs args) {
|
static Janet cfun_table_setproto(int32_t argc, Janet *argv) {
|
||||||
JanetTable *table, *proto;
|
janet_fixarity(argc, 2);
|
||||||
JANET_FIXARITY(args, 2);
|
JanetTable *table = janet_gettable(argv, 0);
|
||||||
JANET_ARG_TABLE(table, args, 0);
|
JanetTable *proto = NULL;
|
||||||
if (janet_checktype(args.v[1], JANET_NIL)) {
|
if (!janet_checktype(argv[1], JANET_NIL)) {
|
||||||
proto = NULL;
|
proto = janet_gettable(argv, 1);
|
||||||
} else {
|
|
||||||
JANET_ARG_TABLE(proto, args, 1);
|
|
||||||
}
|
}
|
||||||
table->proto = proto;
|
table->proto = proto;
|
||||||
JANET_RETURN_TABLE(args, table);
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_tostruct(JanetArgs args) {
|
static Janet cfun_table_tostruct(int32_t argc, Janet *argv) {
|
||||||
JanetTable *t;
|
janet_fixarity(argc, 1);
|
||||||
JANET_FIXARITY(args, 1);
|
JanetTable *t = janet_gettable(argv, 0);
|
||||||
JANET_ARG_TABLE(t, args, 0);
|
return janet_wrap_struct(janet_table_to_struct(t));
|
||||||
JANET_RETURN_STRUCT(args, janet_table_to_struct(t));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_rawget(JanetArgs args) {
|
static Janet cfun_table_rawget(int32_t argc, Janet *argv) {
|
||||||
JanetTable *table;
|
janet_fixarity(argc, 2);
|
||||||
JANET_FIXARITY(args, 2);
|
JanetTable *table = janet_gettable(argv, 0);
|
||||||
JANET_ARG_TABLE(table, args, 0);
|
return janet_table_rawget(table, argv[1]);
|
||||||
JANET_RETURN(args, janet_table_rawget(table, args.v[1]));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetReg table_cfuns[] = {
|
||||||
{"table/new", cfun_new,
|
{
|
||||||
"(table/new capacity)\n\n"
|
"table/new", cfun_table_new,
|
||||||
|
JDOC("(table/new capacity)\n\n"
|
||||||
"Creates a new empty table with pre-allocated memory "
|
"Creates a new empty table with pre-allocated memory "
|
||||||
"for capacity entries. This means that if one knows the number of "
|
"for capacity entries. This means that if one knows the number of "
|
||||||
"entries going to go in a table on creation, extra memory allocation "
|
"entries going to go in a table on creation, extra memory allocation "
|
||||||
"can be avoided. Returns the new table."
|
"can be avoided. Returns the new table.")
|
||||||
},
|
},
|
||||||
{"table/to-struct", cfun_tostruct,
|
{
|
||||||
"(table/to-struct tab)\n\n"
|
"table/to-struct", cfun_table_tostruct,
|
||||||
|
JDOC("(table/to-struct tab)\n\n"
|
||||||
"Convert a table to a struct. Returns a new struct. This function "
|
"Convert a table to a struct. Returns a new struct. This function "
|
||||||
"does not take into account prototype tables."
|
"does not take into account prototype tables.")
|
||||||
},
|
},
|
||||||
{"table/getproto", cfun_getproto,
|
{
|
||||||
"(table/getproto tab)\n\n"
|
"table/getproto", cfun_table_getproto,
|
||||||
|
JDOC("(table/getproto tab)\n\n"
|
||||||
"Get the prototype table of a table. Returns nil if a table "
|
"Get the prototype table of a table. Returns nil if a table "
|
||||||
"has no prototype, otherwise returns the prototype."
|
"has no prototype, otherwise returns the prototype.")
|
||||||
},
|
},
|
||||||
{"table/setproto", cfun_setproto,
|
{
|
||||||
"(table/setproto tab proto)\n\n"
|
"table/setproto", cfun_table_setproto,
|
||||||
"Set the prototype of a table. Returns the original table tab."
|
JDOC("(table/setproto tab proto)\n\n"
|
||||||
|
"Set the prototype of a table. Returns the original table tab.")
|
||||||
},
|
},
|
||||||
{"table/rawget", cfun_rawget,
|
{
|
||||||
"(table/rawget tab key)\n\n"
|
"table/rawget", cfun_table_rawget,
|
||||||
|
JDOC("(table/rawget tab key)\n\n"
|
||||||
"Gets a value from a table without looking at the prototype table. "
|
"Gets a value from a table without looking at the prototype table. "
|
||||||
"If a table tab does not contain t directly, the function will return "
|
"If a table tab does not contain t directly, the function will return "
|
||||||
"nil without checking the prototype. Returns the value in the table."
|
"nil without checking the prototype. Returns the value in the table.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Load the table module */
|
/* Load the table module */
|
||||||
int janet_lib_table(JanetArgs args) {
|
void janet_lib_table(JanetTable *env) {
|
||||||
JanetTable *env = janet_env(args);
|
janet_core_cfuns(env, NULL, table_cfuns);
|
||||||
janet_cfuns(env, NULL, cfuns);
|
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#undef janet_maphash
|
|
||||||
|
|||||||
157
src/core/tuple.c
157
src/core/tuple.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,21 +20,23 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "symcache.h"
|
#include "symcache.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Create a new empty tuple of the given size. This will return memory
|
/* Create a new empty tuple of the given size. This will return memory
|
||||||
* which should be filled with Janets. The memory will not be collected until
|
* which should be filled with Janets. The memory will not be collected until
|
||||||
* janet_tuple_end is called. */
|
* janet_tuple_end is called. */
|
||||||
Janet *janet_tuple_begin(int32_t length) {
|
Janet *janet_tuple_begin(int32_t length) {
|
||||||
char *data = janet_gcalloc(JANET_MEMORY_TUPLE, 4 * sizeof(int32_t) + length * sizeof(Janet));
|
size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet));
|
||||||
Janet *tuple = (Janet *)(data + (4 * sizeof(int32_t)));
|
JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
|
||||||
janet_tuple_length(tuple) = length;
|
head->sm_start = -1;
|
||||||
janet_tuple_sm_line(tuple) = 0;
|
head->sm_end = -1;
|
||||||
janet_tuple_sm_col(tuple) = 0;
|
head->length = length;
|
||||||
return tuple;
|
return (Janet *)(head->data);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Finish building a tuple */
|
/* Finish building a tuple */
|
||||||
@@ -91,95 +93,86 @@ int janet_tuple_compare(const Janet *lhs, const Janet *rhs) {
|
|||||||
|
|
||||||
/* C Functions */
|
/* C Functions */
|
||||||
|
|
||||||
static int cfun_slice(JanetArgs args) {
|
static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) {
|
||||||
const Janet *vals;
|
const Janet *tup = janet_tuple_n(argv, argc);
|
||||||
int32_t len;
|
janet_tuple_flag(tup) |= JANET_TUPLE_FLAG_BRACKETCTOR;
|
||||||
Janet *ret;
|
return janet_wrap_tuple(tup);
|
||||||
int32_t start, end;
|
|
||||||
JANET_MINARITY(args, 1);
|
|
||||||
if (!janet_indexed_view(args.v[0], &vals, &len)) JANET_THROW(args, "expected array/tuple");
|
|
||||||
/* Get start */
|
|
||||||
if (args.n < 2) {
|
|
||||||
start = 0;
|
|
||||||
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
|
|
||||||
start = janet_unwrap_integer(args.v[1]);
|
|
||||||
} else {
|
|
||||||
JANET_THROW(args, "expected integer");
|
|
||||||
}
|
|
||||||
/* Get end */
|
|
||||||
if (args.n < 3) {
|
|
||||||
end = -1;
|
|
||||||
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
|
|
||||||
end = janet_unwrap_integer(args.v[2]);
|
|
||||||
} else {
|
|
||||||
JANET_THROW(args, "expected integer");
|
|
||||||
}
|
|
||||||
if (start < 0) start = len + start;
|
|
||||||
if (end < 0) end = len + end + 1;
|
|
||||||
if (end < 0 || start < 0 || end > len || start > len)
|
|
||||||
JANET_THROW(args, "slice range out of bounds");
|
|
||||||
if (end >= start) {
|
|
||||||
ret = janet_tuple_begin(end - start);
|
|
||||||
memcpy(ret, vals + start, sizeof(Janet) * (end - start));
|
|
||||||
} else {
|
|
||||||
ret = janet_tuple_begin(0);
|
|
||||||
}
|
|
||||||
JANET_RETURN_TUPLE(args, janet_tuple_end(ret));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_prepend(JanetArgs args) {
|
static Janet cfun_tuple_slice(int32_t argc, Janet *argv) {
|
||||||
const Janet *t;
|
JanetRange range = janet_getslice(argc, argv);
|
||||||
int32_t len, i;
|
JanetView view = janet_getindexed(argv, 0);
|
||||||
Janet *n;
|
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
||||||
JANET_MINARITY(args, 1);
|
}
|
||||||
if (!janet_indexed_view(args.v[0], &t, &len))
|
|
||||||
JANET_THROW(args, "expected tuple/array");
|
static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
|
||||||
n = janet_tuple_begin(len - 1 + args.n);
|
janet_fixarity(argc, 1);
|
||||||
memcpy(n - 1 + args.n, t, sizeof(Janet) * len);
|
const Janet *tup = janet_gettuple(argv, 0);
|
||||||
for (i = 1; i < args.n; i++) {
|
if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) {
|
||||||
n[args.n - i - 1] = args.v[i];
|
return janet_ckeywordv("brackets");
|
||||||
|
} else {
|
||||||
|
return janet_ckeywordv("parens");
|
||||||
}
|
}
|
||||||
JANET_RETURN_TUPLE(args, janet_tuple_end(n));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int cfun_append(JanetArgs args) {
|
static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) {
|
||||||
const Janet *t;
|
janet_fixarity(argc, 1);
|
||||||
int32_t len;
|
const Janet *tup = janet_gettuple(argv, 0);
|
||||||
Janet *n;
|
Janet contents[2];
|
||||||
JANET_MINARITY(args, 1);
|
contents[0] = janet_wrap_integer(janet_tuple_head(tup)->sm_start);
|
||||||
if (!janet_indexed_view(args.v[0], &t, &len))
|
contents[1] = janet_wrap_integer(janet_tuple_head(tup)->sm_end);
|
||||||
JANET_THROW(args, "expected tuple/array");
|
return janet_wrap_tuple(janet_tuple_n(contents, 2));
|
||||||
n = janet_tuple_begin(len - 1 + args.n);
|
|
||||||
memcpy(n, t, sizeof(Janet) * len);
|
|
||||||
memcpy(n + len, args.v + 1, sizeof(Janet) * (args.n - 1));
|
|
||||||
JANET_RETURN_TUPLE(args, janet_tuple_end(n));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
|
||||||
{"tuple/slice", cfun_slice,
|
janet_fixarity(argc, 3);
|
||||||
"(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
|
const Janet *tup = janet_gettuple(argv, 0);
|
||||||
|
janet_tuple_head(tup)->sm_start = janet_getinteger(argv, 1);
|
||||||
|
janet_tuple_head(tup)->sm_end = janet_getinteger(argv, 2);
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg tuple_cfuns[] = {
|
||||||
|
{
|
||||||
|
"tuple/brackets", cfun_tuple_brackets,
|
||||||
|
JDOC("(tuple/brackets & xs)\n\n"
|
||||||
|
"Creates a new bracketed tuple containing the elements xs.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tuple/slice", cfun_tuple_slice,
|
||||||
|
JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
|
||||||
"Take a sub sequence of an array or tuple from index start "
|
"Take a sub sequence of an array or tuple from index start "
|
||||||
"inclusive to index end exclusive. If start or end are not provided, "
|
"inclusive to index end exclusive. If start or end are not provided, "
|
||||||
"they default to 0 and the length of arrtup respectively."
|
"they default to 0 and the length of arrtup respectively."
|
||||||
"Returns the new tuple."
|
"Returns the new tuple.")
|
||||||
},
|
},
|
||||||
{"tuple/append", cfun_append,
|
{
|
||||||
"(tuple/append tup & items)\n\n"
|
"tuple/type", cfun_tuple_type,
|
||||||
"Returns a new tuple that is the result of appending "
|
JDOC("(tuple/type tup)\n\n"
|
||||||
"each element in items to tup."
|
"Checks how the tuple was constructed. Will return the keyword "
|
||||||
|
":brackets if the tuple was parsed with brackets, and :parens "
|
||||||
|
"otherwise. The two types of tuples will behave the same most of "
|
||||||
|
"the time, but will print differently and be treated differently by "
|
||||||
|
"the compiler.")
|
||||||
},
|
},
|
||||||
{"tuple/prepend", cfun_prepend,
|
{
|
||||||
"(tuple/prepend tup & items)\n\n"
|
"tuple/sourcemap", cfun_tuple_sourcemap,
|
||||||
"Prepends each element in items to tuple and "
|
JDOC("(tuple/sourcemap tup)\n\n"
|
||||||
"returns a new tuple. Items are prepended such that the "
|
"Returns the sourcemap metadata attached to a tuple. "
|
||||||
"last element in items is the first element in the new tuple."
|
"The mapping is represented by a pair of byte offsets into the "
|
||||||
|
"the source code representing the start and end byte indices where "
|
||||||
|
"the tuple is. ")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tuple/setmap", cfun_tuple_setmap,
|
||||||
|
JDOC("(tuple/setmap tup start end)\n\n"
|
||||||
|
"Set the sourcemap metadata on a tuple. start and end should "
|
||||||
|
"be integers representing byte offsets into the file. Returns tup.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Load the tuple module */
|
/* Load the tuple module */
|
||||||
int janet_lib_tuple(JanetArgs args) {
|
void janet_lib_tuple(JanetTable *env) {
|
||||||
JanetTable *env = janet_env(args);
|
janet_core_cfuns(env, NULL, tuple_cfuns);
|
||||||
janet_cfuns(env, NULL, cfuns);
|
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|||||||
561
src/core/typedarray.c
Normal file
561
src/core/typedarray.c
Normal file
@@ -0,0 +1,561 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 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.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef JANET_TYPED_ARRAY
|
||||||
|
|
||||||
|
static char *ta_type_names[] = {
|
||||||
|
"uint8",
|
||||||
|
"int8",
|
||||||
|
"uint16",
|
||||||
|
"int16",
|
||||||
|
"uint32",
|
||||||
|
"int32",
|
||||||
|
"uint64",
|
||||||
|
"int64",
|
||||||
|
"float32",
|
||||||
|
"float64",
|
||||||
|
"?"
|
||||||
|
};
|
||||||
|
|
||||||
|
static size_t ta_type_sizes[] = {
|
||||||
|
sizeof(uint8_t),
|
||||||
|
sizeof(int8_t),
|
||||||
|
sizeof(uint16_t),
|
||||||
|
sizeof(int16_t),
|
||||||
|
sizeof(uint32_t),
|
||||||
|
sizeof(int32_t),
|
||||||
|
sizeof(uint64_t),
|
||||||
|
sizeof(int64_t),
|
||||||
|
sizeof(float),
|
||||||
|
sizeof(double),
|
||||||
|
0
|
||||||
|
};
|
||||||
|
|
||||||
|
#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_F64 + 1)
|
||||||
|
#define TA_ATOM_MAXSIZE 8
|
||||||
|
#define TA_FLAG_BIG_ENDIAN 1
|
||||||
|
|
||||||
|
static JanetTArrayType get_ta_type_by_name(const uint8_t *name) {
|
||||||
|
for (int i = 0; i < TA_COUNT_TYPES; i++) {
|
||||||
|
if (!janet_cstrcmp(name, ta_type_names[i]))
|
||||||
|
return i;
|
||||||
|
}
|
||||||
|
janet_panicf("invalid typed array type %S", name);
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static JanetTArrayBuffer *ta_buffer_init(JanetTArrayBuffer *buf, size_t size) {
|
||||||
|
buf->data = NULL;
|
||||||
|
if (size > 0) {
|
||||||
|
buf->data = (uint8_t *)calloc(size, sizeof(uint8_t));
|
||||||
|
if (buf->data == NULL) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
buf->size = size;
|
||||||
|
#ifdef JANET_BIG_ENDIAN
|
||||||
|
buf->flags = TA_FLAG_BIG_ENDIAN;
|
||||||
|
#else
|
||||||
|
buf->flags = 0;
|
||||||
|
#endif
|
||||||
|
return buf;
|
||||||
|
}
|
||||||
|
|
||||||
|
static int ta_buffer_gc(void *p, size_t s) {
|
||||||
|
(void) s;
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||||
|
free(buf->data);
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_buffer_marshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||||
|
janet_marshal_size(ctx, buf->size);
|
||||||
|
janet_marshal_int(ctx, buf->flags);
|
||||||
|
janet_marshal_bytes(ctx, buf->data, buf->size);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_buffer_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||||
|
size_t size = janet_unmarshal_size(ctx);
|
||||||
|
ta_buffer_init(buf, size);
|
||||||
|
buf->flags = janet_unmarshal_int(ctx);
|
||||||
|
janet_unmarshal_bytes(ctx, buf->data, size);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetAbstractType ta_buffer_type = {
|
||||||
|
"ta/buffer",
|
||||||
|
ta_buffer_gc,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
ta_buffer_marshal,
|
||||||
|
ta_buffer_unmarshal,
|
||||||
|
NULL
|
||||||
|
};
|
||||||
|
|
||||||
|
static int ta_mark(void *p, size_t s) {
|
||||||
|
(void) s;
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||||
|
janet_mark(janet_wrap_abstract(view->buffer));
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_view_marshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||||
|
size_t offset = (view->buffer->data - view->as.u8);
|
||||||
|
janet_marshal_size(ctx, view->size);
|
||||||
|
janet_marshal_size(ctx, view->stride);
|
||||||
|
janet_marshal_int(ctx, view->type);
|
||||||
|
janet_marshal_size(ctx, offset);
|
||||||
|
janet_marshal_janet(ctx, janet_wrap_abstract(view->buffer));
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_view_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||||
|
size_t offset;
|
||||||
|
int32_t atype;
|
||||||
|
Janet buffer;
|
||||||
|
view->size = janet_unmarshal_size(ctx);
|
||||||
|
view->stride = janet_unmarshal_size(ctx);
|
||||||
|
atype = janet_unmarshal_int(ctx);
|
||||||
|
if (atype < 0 || atype >= TA_COUNT_TYPES)
|
||||||
|
janet_panic("bad typed array type");
|
||||||
|
view->type = atype;
|
||||||
|
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_panicf("expected typed array buffer");
|
||||||
|
}
|
||||||
|
view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
|
||||||
|
size_t buf_need_size = offset + (ta_type_sizes[view->type]) * ((view->size - 1) * view->stride + 1);
|
||||||
|
if (view->buffer->size < buf_need_size)
|
||||||
|
janet_panic("bad typed array offset in marshalled data");
|
||||||
|
view->as.u8 = view->buffer->data + offset;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet ta_getter(void *p, Janet key) {
|
||||||
|
Janet value;
|
||||||
|
size_t index, i;
|
||||||
|
JanetTArrayView *array = p;
|
||||||
|
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||||
|
index = (size_t) janet_unwrap_number(key);
|
||||||
|
i = index * array->stride;
|
||||||
|
if (index >= array->size) {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
switch (array->type) {
|
||||||
|
case JANET_TARRAY_TYPE_U8:
|
||||||
|
value = janet_wrap_number(array->as.u8[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S8:
|
||||||
|
value = janet_wrap_number(array->as.s8[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_U16:
|
||||||
|
value = janet_wrap_number(array->as.u16[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S16:
|
||||||
|
value = janet_wrap_number(array->as.s16[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_U32:
|
||||||
|
value = janet_wrap_number(array->as.u32[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S32:
|
||||||
|
value = janet_wrap_number(array->as.s32[i]);
|
||||||
|
break;
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
case JANET_TARRAY_TYPE_U64:
|
||||||
|
value = janet_wrap_u64(array->as.u64[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S64:
|
||||||
|
value = janet_wrap_s64(array->as.s64[i]);
|
||||||
|
break;
|
||||||
|
#endif
|
||||||
|
case JANET_TARRAY_TYPE_F32:
|
||||||
|
value = janet_wrap_number(array->as.f32[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_F64:
|
||||||
|
value = janet_wrap_number(array->as.f64[i]);
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
janet_panicf("cannot get from typed array of type %s",
|
||||||
|
ta_type_names[array->type]);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return value;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_setter(void *p, Janet key, Janet value) {
|
||||||
|
size_t index, i;
|
||||||
|
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||||
|
index = (size_t) janet_unwrap_number(key);
|
||||||
|
JanetTArrayView *array = p;
|
||||||
|
i = index * array->stride;
|
||||||
|
if (index >= array->size) {
|
||||||
|
janet_panic("index out of bounds");
|
||||||
|
}
|
||||||
|
if (!janet_checktype(value, JANET_NUMBER) &&
|
||||||
|
array->type != JANET_TARRAY_TYPE_U64 &&
|
||||||
|
array->type != JANET_TARRAY_TYPE_S64) {
|
||||||
|
janet_panic("expected number value");
|
||||||
|
}
|
||||||
|
switch (array->type) {
|
||||||
|
case JANET_TARRAY_TYPE_U8:
|
||||||
|
array->as.u8[i] = (uint8_t) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S8:
|
||||||
|
array->as.s8[i] = (int8_t) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_U16:
|
||||||
|
array->as.u16[i] = (uint16_t) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S16:
|
||||||
|
array->as.s16[i] = (int16_t) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_U32:
|
||||||
|
array->as.u32[i] = (uint32_t) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S32:
|
||||||
|
array->as.s32[i] = (int32_t) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
case JANET_TARRAY_TYPE_U64:
|
||||||
|
array->as.u64[i] = janet_unwrap_u64(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S64:
|
||||||
|
array->as.s64[i] = janet_unwrap_s64(value);
|
||||||
|
break;
|
||||||
|
#endif
|
||||||
|
case JANET_TARRAY_TYPE_F32:
|
||||||
|
array->as.f32[i] = (float) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_F64:
|
||||||
|
array->as.f64[i] = janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
janet_panicf("cannot set typed array of type %s",
|
||||||
|
ta_type_names[array->type]);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetAbstractType ta_view_type = {
|
||||||
|
"ta/view",
|
||||||
|
NULL,
|
||||||
|
ta_mark,
|
||||||
|
ta_getter,
|
||||||
|
ta_setter,
|
||||||
|
ta_view_marshal,
|
||||||
|
ta_view_unmarshal,
|
||||||
|
NULL
|
||||||
|
};
|
||||||
|
|
||||||
|
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
|
||||||
|
JanetTArrayBuffer *buf = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||||
|
ta_buffer_init(buf, size);
|
||||||
|
return buf;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetTArrayView *janet_tarray_view(
|
||||||
|
JanetTArrayType type,
|
||||||
|
size_t size,
|
||||||
|
size_t stride,
|
||||||
|
size_t offset,
|
||||||
|
JanetTArrayBuffer *buffer) {
|
||||||
|
|
||||||
|
JanetTArrayView *view = janet_abstract(&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));
|
||||||
|
ta_buffer_init(buffer, buf_size);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (buffer->size < buf_size) {
|
||||||
|
janet_panicf("bad buffer size, %i bytes allocated < %i required",
|
||||||
|
buffer->size,
|
||||||
|
buf_size);
|
||||||
|
}
|
||||||
|
|
||||||
|
view->buffer = buffer;
|
||||||
|
view->stride = stride;
|
||||||
|
view->size = size;
|
||||||
|
view->as.u8 = buffer->data + offset;
|
||||||
|
view->type = type;
|
||||||
|
|
||||||
|
return view;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
|
||||||
|
return janet_getabstract(argv, n, &ta_buffer_type);
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
|
||||||
|
return janet_getabstract(argv, n, &ta_view_type);
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
|
||||||
|
JanetTArrayView *view = janet_getabstract(argv, n, &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]);
|
||||||
|
}
|
||||||
|
return view;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 2, 5);
|
||||||
|
size_t offset = 0;
|
||||||
|
size_t stride = 1;
|
||||||
|
JanetTArrayBuffer *buffer = NULL;
|
||||||
|
const uint8_t *keyw = janet_getkeyword(argv, 0);
|
||||||
|
JanetTArrayType type = get_ta_type_by_name(keyw);
|
||||||
|
size_t size = janet_getsize(argv, 1);
|
||||||
|
if (argc > 2)
|
||||||
|
stride = janet_getsize(argv, 2);
|
||||||
|
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;
|
||||||
|
} else {
|
||||||
|
buffer = p;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
|
||||||
|
return janet_wrap_abstract(view);
|
||||||
|
}
|
||||||
|
|
||||||
|
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;
|
||||||
|
return (JanetTArrayView *)abst;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetTArrayView *view;
|
||||||
|
if ((view = ta_is_view(argv[0]))) {
|
||||||
|
return janet_wrap_abstract(view->buffer);
|
||||||
|
}
|
||||||
|
size_t size = janet_getsize(argv, 0);
|
||||||
|
JanetTArrayBuffer *buf = janet_tarray_buffer(size);
|
||||||
|
return janet_wrap_abstract(buf);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetTArrayView *view;
|
||||||
|
if ((view = ta_is_view(argv[0]))) {
|
||||||
|
return janet_wrap_number((double) view->size);
|
||||||
|
}
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type);
|
||||||
|
return janet_wrap_number((double) buf->size);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetTArrayView *view;
|
||||||
|
if ((view = ta_is_view(argv[0]))) {
|
||||||
|
JanetTArrayView *view = janet_unwrap_abstract(argv[0]);
|
||||||
|
JanetKV *props = janet_struct_begin(6);
|
||||||
|
ptrdiff_t boffset = view->as.u8 - view->buffer->data;
|
||||||
|
janet_struct_put(props, janet_ckeywordv("size"),
|
||||||
|
janet_wrap_number((double) view->size));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("byte-offset"),
|
||||||
|
janet_wrap_number((double) boffset));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("stride"),
|
||||||
|
janet_wrap_number((double) view->stride));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("type"),
|
||||||
|
janet_ckeywordv(ta_type_names[view->type]));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("type-size"),
|
||||||
|
janet_wrap_number((double) ta_type_sizes[view->type]));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("buffer"),
|
||||||
|
janet_wrap_abstract(view->buffer));
|
||||||
|
return janet_wrap_struct(janet_struct_end(props));
|
||||||
|
} else {
|
||||||
|
JanetTArrayBuffer *buffer = janet_gettarray_buffer(argv, 0);
|
||||||
|
JanetKV *props = janet_struct_begin(2);
|
||||||
|
janet_struct_put(props, janet_ckeywordv("size"),
|
||||||
|
janet_wrap_number((double) buffer->size));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("big-endian"),
|
||||||
|
janet_wrap_boolean(buffer->flags & TA_FLAG_BIG_ENDIAN));
|
||||||
|
return janet_wrap_struct(janet_struct_end(props));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
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);
|
||||||
|
JanetRange range;
|
||||||
|
int32_t length = (int32_t)src->size;
|
||||||
|
if (argc == 1) {
|
||||||
|
range.start = 0;
|
||||||
|
range.end = length;
|
||||||
|
} else if (argc == 2) {
|
||||||
|
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||||
|
range.end = length;
|
||||||
|
} else {
|
||||||
|
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||||
|
range.end = janet_gethalfrange(argv, 2, length, "end");
|
||||||
|
if (range.end < range.start)
|
||||||
|
range.end = range.start;
|
||||||
|
}
|
||||||
|
JanetArray *array = janet_array(range.end - range.start);
|
||||||
|
if (array->data) {
|
||||||
|
for (int32_t i = range.start; i < range.end; i++) {
|
||||||
|
array->data[i - range.start] = ta_getter(src, janet_wrap_number(i));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
array->count = range.end - range.start;
|
||||||
|
return janet_wrap_array(array);
|
||||||
|
}
|
||||||
|
|
||||||
|
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);
|
||||||
|
size_t index_src = janet_getsize(argv, 1);
|
||||||
|
JanetTArrayView *dst = janet_getabstract(argv, 2, &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];
|
||||||
|
size_t dst_atom_size = ta_type_sizes[dst->type];
|
||||||
|
size_t step_src = src->stride * src_atom_size;
|
||||||
|
size_t step_dst = dst->stride * dst_atom_size;
|
||||||
|
size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
|
||||||
|
size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
|
||||||
|
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
|
||||||
|
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
|
||||||
|
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
|
||||||
|
for (size_t i = 0; i < count; i++) {
|
||||||
|
memmove(pd, ps, src_atom_size);
|
||||||
|
pd += step_dst;
|
||||||
|
ps += step_src;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
janet_panic("typed array copy out of bounds");
|
||||||
|
}
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
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);
|
||||||
|
size_t index_src = janet_getsize(argv, 1);
|
||||||
|
JanetTArrayView *dst = janet_getabstract(argv, 2, &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];
|
||||||
|
size_t dst_atom_size = ta_type_sizes[dst->type];
|
||||||
|
size_t step_src = src->stride * src_atom_size;
|
||||||
|
size_t step_dst = dst->stride * dst_atom_size;
|
||||||
|
size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
|
||||||
|
size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
|
||||||
|
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
|
||||||
|
uint8_t temp[TA_ATOM_MAXSIZE];
|
||||||
|
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
|
||||||
|
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
|
||||||
|
for (size_t i = 0; i < count; i++) {
|
||||||
|
memcpy(temp, ps, src_atom_size);
|
||||||
|
memcpy(ps, pd, src_atom_size);
|
||||||
|
memcpy(pd, temp, src_atom_size);
|
||||||
|
pd += step_dst;
|
||||||
|
ps += step_src;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
janet_panic("typed array swap out of bounds");
|
||||||
|
}
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg ta_cfuns[] = {
|
||||||
|
{
|
||||||
|
"tarray/new", cfun_typed_array_new,
|
||||||
|
JDOC("(tarray/new type size [stride = 1 [offset = 0 [tarray | buffer]]] )\n\n"
|
||||||
|
"Create new typed array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/buffer", cfun_typed_array_buffer,
|
||||||
|
JDOC("(tarray/buffer (array | size) )\n\n"
|
||||||
|
"Return typed array buffer or create a new buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/length", cfun_typed_array_size,
|
||||||
|
JDOC("(tarray/length (array | buffer) )\n\n"
|
||||||
|
"Return typed array or buffer size.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/properties", cfun_typed_array_properties,
|
||||||
|
JDOC("(tarray/properties array )\n\n"
|
||||||
|
"Return typed array properties as a struct.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/copy-bytes", cfun_typed_array_copy_bytes,
|
||||||
|
JDOC("(tarray/copy-bytes src sindex dst dindex [count=1])\n\n"
|
||||||
|
"Copy count elements of src array from index sindex "
|
||||||
|
"to dst array at position dindex "
|
||||||
|
"memory can overlap.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/swap-bytes", cfun_typed_array_swap_bytes,
|
||||||
|
JDOC("(tarray/swap-bytes src sindex dst dindex [count=1])\n\n"
|
||||||
|
"Swap count elements between src array from index sindex "
|
||||||
|
"and dst array at position dindex "
|
||||||
|
"memory can overlap.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/slice", cfun_typed_array_slice,
|
||||||
|
JDOC("(tarray/slice tarr [, start=0 [, end=(size tarr)]])\n\n"
|
||||||
|
"Takes a slice of a typed array from start to end. The range is half "
|
||||||
|
"open, [start, end). Indexes can also be negative, indicating indexing "
|
||||||
|
"from the end of the end of the typed array. By default, start is 0 and end is "
|
||||||
|
"the size of the typed array. Returns a new janet array.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
/* 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);
|
||||||
|
}
|
||||||
|
|
||||||
|
#endif
|
||||||
266
src/core/util.c
266
src/core/util.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,10 +20,14 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <inttypes.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Base 64 lookup table for digits */
|
/* Base 64 lookup table for digits */
|
||||||
const char janet_base64[65] =
|
const char janet_base64[65] =
|
||||||
@@ -35,22 +39,58 @@ const char janet_base64[65] =
|
|||||||
/* The JANET value types in order. These types can be used as
|
/* The JANET value types in order. These types can be used as
|
||||||
* mnemonics instead of a bit pattern for type checking */
|
* mnemonics instead of a bit pattern for type checking */
|
||||||
const char *const janet_type_names[16] = {
|
const char *const janet_type_names[16] = {
|
||||||
":nil",
|
"number",
|
||||||
":boolean",
|
"nil",
|
||||||
":boolean",
|
"boolean",
|
||||||
":fiber",
|
"fiber",
|
||||||
":integer",
|
"string",
|
||||||
":real",
|
"symbol",
|
||||||
":string",
|
"keyword",
|
||||||
":symbol",
|
"array",
|
||||||
":array",
|
"tuple",
|
||||||
":tuple",
|
"table",
|
||||||
":table",
|
"struct",
|
||||||
":struct",
|
"buffer",
|
||||||
":buffer",
|
"function",
|
||||||
":function",
|
"cfunction",
|
||||||
":cfunction",
|
"abstract",
|
||||||
":abstract"
|
"pointer"
|
||||||
|
};
|
||||||
|
|
||||||
|
const char *const janet_signal_names[14] = {
|
||||||
|
"ok",
|
||||||
|
"error",
|
||||||
|
"debug",
|
||||||
|
"yield",
|
||||||
|
"user0",
|
||||||
|
"user1",
|
||||||
|
"user2",
|
||||||
|
"user3",
|
||||||
|
"user4",
|
||||||
|
"user5",
|
||||||
|
"user6",
|
||||||
|
"user7",
|
||||||
|
"user8",
|
||||||
|
"user9"
|
||||||
|
};
|
||||||
|
|
||||||
|
const char *const janet_status_names[16] = {
|
||||||
|
"dead",
|
||||||
|
"error",
|
||||||
|
"debug",
|
||||||
|
"pending",
|
||||||
|
"user0",
|
||||||
|
"user1",
|
||||||
|
"user2",
|
||||||
|
"user3",
|
||||||
|
"user4",
|
||||||
|
"user5",
|
||||||
|
"user6",
|
||||||
|
"user7",
|
||||||
|
"user8",
|
||||||
|
"user9",
|
||||||
|
"new",
|
||||||
|
"alive"
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Calculate hash for string */
|
/* Calculate hash for string */
|
||||||
@@ -96,7 +136,7 @@ int32_t janet_tablen(int32_t n) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Helper to find a value in a Janet struct or table. Returns the bucket
|
/* Helper to find a value in a Janet struct or table. Returns the bucket
|
||||||
* containg the key, or the first empty bucket if there is no such key. */
|
* 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) {
|
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
|
||||||
int32_t index = janet_maphash(cap, janet_hash(key));
|
int32_t index = janet_maphash(cap, janet_hash(key));
|
||||||
int32_t i;
|
int32_t i;
|
||||||
@@ -151,7 +191,7 @@ const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const Jane
|
|||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Compare a janet string with a cstring. more efficient than loading
|
/* Compare a janet string with a cstring. More efficient than loading
|
||||||
* c string as a janet string. */
|
* c string as a janet string. */
|
||||||
int janet_cstrcmp(const uint8_t *str, const char *other) {
|
int janet_cstrcmp(const uint8_t *str, const char *other) {
|
||||||
int32_t len = janet_string_length(str);
|
int32_t len = janet_string_length(str);
|
||||||
@@ -168,7 +208,7 @@ int janet_cstrcmp(const uint8_t *str, const char *other) {
|
|||||||
|
|
||||||
/* Do a binary search on a static array of structs. Each struct must
|
/* Do a binary search on a static array of structs. Each struct must
|
||||||
* have a string as its first element, and the struct must be sorted
|
* have a string as its first element, and the struct must be sorted
|
||||||
* lexogrpahically by that element. */
|
* lexicographically by that element. */
|
||||||
const void *janet_strbinsearch(
|
const void *janet_strbinsearch(
|
||||||
const void *tab,
|
const void *tab,
|
||||||
size_t tabcount,
|
size_t tabcount,
|
||||||
@@ -203,9 +243,9 @@ void janet_register(const char *name, JanetCFunction cfun) {
|
|||||||
/* Add a def to an environment */
|
/* Add a def to an environment */
|
||||||
void janet_def(JanetTable *env, const char *name, Janet val, const char *doc) {
|
void janet_def(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||||
JanetTable *subt = janet_table(2);
|
JanetTable *subt = janet_table(2);
|
||||||
janet_table_put(subt, janet_csymbolv(":value"), val);
|
janet_table_put(subt, janet_ckeywordv("value"), val);
|
||||||
if (doc)
|
if (doc)
|
||||||
janet_table_put(subt, janet_csymbolv(":doc"), janet_cstringv(doc));
|
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc));
|
||||||
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
|
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -214,9 +254,9 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
|
|||||||
JanetArray *array = janet_array(1);
|
JanetArray *array = janet_array(1);
|
||||||
JanetTable *subt = janet_table(2);
|
JanetTable *subt = janet_table(2);
|
||||||
janet_array_push(array, val);
|
janet_array_push(array, val);
|
||||||
janet_table_put(subt, janet_csymbolv(":ref"), janet_wrap_array(array));
|
janet_table_put(subt, janet_ckeywordv("ref"), janet_wrap_array(array));
|
||||||
if (doc)
|
if (doc)
|
||||||
janet_table_put(subt, janet_csymbolv(":doc"), janet_cstringv(doc));
|
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc));
|
||||||
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
|
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -230,12 +270,13 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
|||||||
int32_t nmlen = 0;
|
int32_t nmlen = 0;
|
||||||
while (regprefix[reglen]) reglen++;
|
while (regprefix[reglen]) reglen++;
|
||||||
while (cfuns->name[nmlen]) nmlen++;
|
while (cfuns->name[nmlen]) nmlen++;
|
||||||
uint8_t *longname_buffer =
|
int32_t symlen = reglen + 1 + nmlen;
|
||||||
janet_string_begin(reglen + 1 + nmlen);
|
uint8_t *longname_buffer = malloc(symlen);
|
||||||
memcpy(longname_buffer, regprefix, reglen);
|
memcpy(longname_buffer, regprefix, reglen);
|
||||||
longname_buffer[reglen] = '.';
|
longname_buffer[reglen] = '/';
|
||||||
memcpy(longname_buffer + reglen + 1, cfuns->name, nmlen);
|
memcpy(longname_buffer + reglen + 1, cfuns->name, nmlen);
|
||||||
longname = janet_wrap_symbol(janet_string_end(longname_buffer));
|
longname = janet_wrap_symbol(janet_symbol(longname_buffer, symlen));
|
||||||
|
free(longname_buffer);
|
||||||
}
|
}
|
||||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||||
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||||
@@ -244,6 +285,77 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Abstract type introspection */
|
||||||
|
|
||||||
|
static const JanetAbstractType type_wrap = {
|
||||||
|
"core/type-info",
|
||||||
|
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))) {
|
||||||
|
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));
|
||||||
|
}
|
||||||
|
|
||||||
|
const JanetAbstractType *janet_get_abstract_type(Janet key) {
|
||||||
|
Janet twrap = janet_table_get(janet_vm_registry, key);
|
||||||
|
if (janet_checktype(twrap, 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;
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifndef JANET_BOOTSTRAP
|
||||||
|
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
|
||||||
|
(void) p;
|
||||||
|
Janet key = janet_csymbolv(name);
|
||||||
|
Janet value;
|
||||||
|
/* During init, allow replacing core library cfunctions with values from
|
||||||
|
* the env. */
|
||||||
|
Janet check = janet_table_get(env, key);
|
||||||
|
if (janet_checktype(check, JANET_NIL)) {
|
||||||
|
value = x;
|
||||||
|
} else {
|
||||||
|
value = check;
|
||||||
|
}
|
||||||
|
janet_table_put(env, key, value);
|
||||||
|
if (janet_checktype(value, JANET_CFUNCTION)) {
|
||||||
|
janet_table_put(janet_vm_registry, value, key);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||||
|
(void) regprefix;
|
||||||
|
while (cfuns->name) {
|
||||||
|
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||||
|
janet_core_def(env, cfuns->name, fun, cfuns->documentation);
|
||||||
|
cfuns++;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Resolve a symbol in the environment */
|
/* Resolve a symbol in the environment */
|
||||||
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
|
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
|
||||||
Janet ref;
|
Janet ref;
|
||||||
@@ -253,32 +365,20 @@ JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out)
|
|||||||
return JANET_BINDING_NONE;
|
return JANET_BINDING_NONE;
|
||||||
entry_table = janet_unwrap_table(entry);
|
entry_table = janet_unwrap_table(entry);
|
||||||
if (!janet_checktype(
|
if (!janet_checktype(
|
||||||
janet_table_get(entry_table, janet_csymbolv(":macro")),
|
janet_table_get(entry_table, janet_ckeywordv("macro")),
|
||||||
JANET_NIL)) {
|
JANET_NIL)) {
|
||||||
*out = janet_table_get(entry_table, janet_csymbolv(":value"));
|
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||||
return JANET_BINDING_MACRO;
|
return JANET_BINDING_MACRO;
|
||||||
}
|
}
|
||||||
ref = janet_table_get(entry_table, janet_csymbolv(":ref"));
|
ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
|
||||||
if (janet_checktype(ref, JANET_ARRAY)) {
|
if (janet_checktype(ref, JANET_ARRAY)) {
|
||||||
*out = ref;
|
*out = ref;
|
||||||
return JANET_BINDING_VAR;
|
return JANET_BINDING_VAR;
|
||||||
}
|
}
|
||||||
*out = janet_table_get(entry_table, janet_csymbolv(":value"));
|
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||||
return JANET_BINDING_DEF;
|
return JANET_BINDING_DEF;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Get module from the arguments passed to library */
|
|
||||||
JanetTable *janet_env(JanetArgs args) {
|
|
||||||
JanetTable *module;
|
|
||||||
if (args.n >= 1 && janet_checktype(args.v[0], JANET_TABLE)) {
|
|
||||||
module = janet_unwrap_table(args.v[0]);
|
|
||||||
} else {
|
|
||||||
module = janet_table(0);
|
|
||||||
}
|
|
||||||
*args.ret = janet_wrap_table(module);
|
|
||||||
return module;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Read both tuples and arrays as c pointers + int32_t length. Return 1 if the
|
/* Read both tuples and arrays as c pointers + int32_t length. Return 1 if the
|
||||||
* view can be constructed, 0 if an invalid type. */
|
* view can be constructed, 0 if an invalid type. */
|
||||||
int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
||||||
@@ -288,7 +388,7 @@ int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
|||||||
return 1;
|
return 1;
|
||||||
} else if (janet_checktype(seq, JANET_TUPLE)) {
|
} else if (janet_checktype(seq, JANET_TUPLE)) {
|
||||||
*data = janet_unwrap_tuple(seq);
|
*data = janet_unwrap_tuple(seq);
|
||||||
*len = janet_tuple_length(janet_unwrap_struct(seq));
|
*len = janet_tuple_length(janet_unwrap_tuple(seq));
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
return 0;
|
return 0;
|
||||||
@@ -297,7 +397,8 @@ int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
|||||||
/* Read both strings and buffer as unsigned character array + int32_t len.
|
/* Read both strings and buffer as unsigned character array + int32_t len.
|
||||||
* Returns 1 if the view can be constructed and 0 if the type is invalid. */
|
* Returns 1 if the view can be constructed and 0 if the type is invalid. */
|
||||||
int janet_bytes_view(Janet str, const uint8_t **data, int32_t *len) {
|
int janet_bytes_view(Janet str, const uint8_t **data, int32_t *len) {
|
||||||
if (janet_checktype(str, JANET_STRING) || janet_checktype(str, JANET_SYMBOL)) {
|
if (janet_checktype(str, JANET_STRING) || janet_checktype(str, JANET_SYMBOL) ||
|
||||||
|
janet_checktype(str, JANET_KEYWORD)) {
|
||||||
*data = janet_unwrap_string(str);
|
*data = janet_unwrap_string(str);
|
||||||
*len = janet_string_length(janet_unwrap_string(str));
|
*len = janet_string_length(janet_unwrap_string(str));
|
||||||
return 1;
|
return 1;
|
||||||
@@ -327,63 +428,24 @@ int janet_dictionary_view(Janet tab, const JanetKV **data, int32_t *len, int32_t
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Get actual type name of a value for debugging purposes */
|
int janet_checkint(Janet x) {
|
||||||
static const char *typestr(JanetArgs args, int32_t n) {
|
if (!janet_checktype(x, JANET_NUMBER))
|
||||||
JanetType actual = n < args.n ? janet_type(args.v[n]) : JANET_NIL;
|
return 0;
|
||||||
return ((actual == JANET_ABSTRACT)
|
double dval = janet_unwrap_number(x);
|
||||||
? janet_abstract_type(janet_unwrap_abstract(args.v[n]))->name
|
return janet_checkintrange(dval);
|
||||||
: janet_type_names[actual]) + 1;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
int janet_type_err(JanetArgs args, int32_t n, JanetType expected) {
|
int janet_checkint64(Janet x) {
|
||||||
const uint8_t *message = janet_formatc(
|
if (!janet_checktype(x, JANET_NUMBER))
|
||||||
"bad slot #%d, expected %t, got %s",
|
return 0;
|
||||||
n,
|
double dval = janet_unwrap_number(x);
|
||||||
expected,
|
return janet_checkint64range(dval);
|
||||||
typestr(args, n));
|
|
||||||
JANET_THROWV(args, janet_wrap_string(message));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_buffer_push_types(JanetBuffer *buffer, int types) {
|
int janet_checksize(Janet x) {
|
||||||
int first = 1;
|
if (!janet_checktype(x, JANET_NUMBER))
|
||||||
int i = 0;
|
return 0;
|
||||||
while (types) {
|
double dval = janet_unwrap_number(x);
|
||||||
if (1 & types) {
|
return dval == (double)((size_t) dval) &&
|
||||||
if (first) {
|
dval <= SIZE_MAX;
|
||||||
first = 0;
|
|
||||||
} else {
|
|
||||||
janet_buffer_push_u8(buffer, '|');
|
|
||||||
}
|
|
||||||
janet_buffer_push_cstring(buffer, janet_type_names[i] + 1);
|
|
||||||
}
|
|
||||||
i++;
|
|
||||||
types >>= 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
int janet_typemany_err(JanetArgs args, int32_t n, int expected) {
|
|
||||||
const uint8_t *message;
|
|
||||||
JanetBuffer buf;
|
|
||||||
janet_buffer_init(&buf, 20);
|
|
||||||
janet_buffer_push_string(&buf, janet_formatc("bad slot #%d, expected ", n));
|
|
||||||
janet_buffer_push_types(&buf, expected);
|
|
||||||
janet_buffer_push_cstring(&buf, ", got ");
|
|
||||||
janet_buffer_push_cstring(&buf, typestr(args, n));
|
|
||||||
message = janet_string(buf.data, buf.count);
|
|
||||||
janet_buffer_deinit(&buf);
|
|
||||||
JANET_THROWV(args, janet_wrap_string(message));
|
|
||||||
}
|
|
||||||
|
|
||||||
int janet_arity_err(JanetArgs args, int32_t n, const char *prefix) {
|
|
||||||
JANET_THROWV(args,
|
|
||||||
janet_wrap_string(janet_formatc(
|
|
||||||
"expected %s%d argument%s, got %d",
|
|
||||||
prefix, n, n == 1 ? "" : "s", args.n)));
|
|
||||||
}
|
|
||||||
|
|
||||||
int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstractType *at) {
|
|
||||||
JANET_THROWV(args,
|
|
||||||
janet_wrap_string(janet_formatc(
|
|
||||||
"bad slot #%d, expected %s, got %s",
|
|
||||||
n, at->name, typestr(args, n))));
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -23,7 +23,39 @@
|
|||||||
#ifndef JANET_UTIL_H_defined
|
#ifndef JANET_UTIL_H_defined
|
||||||
#define JANET_UTIL_H_defined
|
#define JANET_UTIL_H_defined
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Handle runtime errors */
|
||||||
|
#ifndef janet_exit
|
||||||
|
#include <stdio.h>
|
||||||
|
#define janet_exit(m) do { \
|
||||||
|
printf("C runtime error at line %d in file %s: %s\n",\
|
||||||
|
__LINE__,\
|
||||||
|
__FILE__,\
|
||||||
|
(m));\
|
||||||
|
exit(1);\
|
||||||
|
} while (0)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#define janet_assert(c, m) do { \
|
||||||
|
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)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Omit docstrings in some builds */
|
||||||
|
#ifndef JANET_BOOTSTRAP
|
||||||
|
#define JDOC(x) NULL
|
||||||
|
#define JANET_NO_BOOTSTRAP
|
||||||
|
#else
|
||||||
|
#define JDOC(x) x
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Utils */
|
/* Utils */
|
||||||
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
|
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
|
||||||
@@ -35,27 +67,55 @@ int32_t janet_tablen(int32_t n);
|
|||||||
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
||||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
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);
|
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);
|
||||||
const void *janet_strbinsearch(
|
const void *janet_strbinsearch(
|
||||||
const void *tab,
|
const void *tab,
|
||||||
size_t tabcount,
|
size_t tabcount,
|
||||||
size_t itemsize,
|
size_t itemsize,
|
||||||
const uint8_t *key);
|
const uint8_t *key);
|
||||||
|
void janet_buffer_format(
|
||||||
|
JanetBuffer *b,
|
||||||
|
const char *strfrmt,
|
||||||
|
int32_t argstart,
|
||||||
|
int32_t argc,
|
||||||
|
Janet *argv);
|
||||||
|
|
||||||
|
/* Inside the janet core, defining globals is different
|
||||||
|
* at bootstrap time and normal runtime */
|
||||||
|
#ifdef JANET_BOOTSTRAP
|
||||||
|
#define janet_core_def janet_def
|
||||||
|
#define janet_core_cfuns janet_cfuns
|
||||||
|
#else
|
||||||
|
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
|
||||||
|
|
||||||
/* Initialize builtin libraries */
|
/* Initialize builtin libraries */
|
||||||
int janet_lib_io(JanetArgs args);
|
void janet_lib_io(JanetTable *env);
|
||||||
int janet_lib_math(JanetArgs args);
|
void janet_lib_math(JanetTable *env);
|
||||||
int janet_lib_array(JanetArgs args);
|
void janet_lib_array(JanetTable *env);
|
||||||
int janet_lib_tuple(JanetArgs args);
|
void janet_lib_tuple(JanetTable *env);
|
||||||
int janet_lib_buffer(JanetArgs args);
|
void janet_lib_buffer(JanetTable *env);
|
||||||
int janet_lib_table(JanetArgs args);
|
void janet_lib_table(JanetTable *env);
|
||||||
int janet_lib_fiber(JanetArgs args);
|
void janet_lib_fiber(JanetTable *env);
|
||||||
int janet_lib_os(JanetArgs args);
|
void janet_lib_os(JanetTable *env);
|
||||||
int janet_lib_string(JanetArgs args);
|
void janet_lib_string(JanetTable *env);
|
||||||
int janet_lib_marsh(JanetArgs args);
|
void janet_lib_marsh(JanetTable *env);
|
||||||
int janet_lib_parse(JanetArgs args);
|
void janet_lib_parse(JanetTable *env);
|
||||||
#ifdef JANET_ASSEMBLER
|
#ifdef JANET_ASSEMBLER
|
||||||
int janet_lib_asm(JanetArgs args);
|
void janet_lib_asm(JanetTable *env);
|
||||||
|
#endif
|
||||||
|
void janet_lib_compile(JanetTable *env);
|
||||||
|
void janet_lib_debug(JanetTable *env);
|
||||||
|
#ifdef JANET_PEG
|
||||||
|
void janet_lib_peg(JanetTable *env);
|
||||||
|
#endif
|
||||||
|
#ifdef JANET_TYPED_ARRAY
|
||||||
|
void janet_lib_typed_array(JanetTable *env);
|
||||||
|
#endif
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
void janet_lib_inttypes(JanetTable *env);
|
||||||
#endif
|
#endif
|
||||||
int janet_lib_compile(JanetArgs args);
|
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
310
src/core/value.c
310
src/core/value.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,7 +20,9 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* Define a number of functions that can be used internally on ANY Janet.
|
* Define a number of functions that can be used internally on ANY Janet.
|
||||||
@@ -34,15 +36,13 @@ int janet_equals(Janet x, Janet y) {
|
|||||||
} else {
|
} else {
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
case JANET_TRUE:
|
|
||||||
case JANET_FALSE:
|
|
||||||
result = 1;
|
result = 1;
|
||||||
break;
|
break;
|
||||||
case JANET_REAL:
|
case JANET_BOOLEAN:
|
||||||
result = (janet_unwrap_real(x) == janet_unwrap_real(y));
|
result = (janet_unwrap_boolean(x) == janet_unwrap_boolean(y));
|
||||||
break;
|
break;
|
||||||
case JANET_INTEGER:
|
case JANET_NUMBER:
|
||||||
result = (janet_unwrap_integer(x) == janet_unwrap_integer(y));
|
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
|
||||||
break;
|
break;
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
|
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||||
@@ -69,14 +69,12 @@ int32_t janet_hash(Janet x) {
|
|||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
hash = 0;
|
hash = 0;
|
||||||
break;
|
break;
|
||||||
case JANET_FALSE:
|
case JANET_BOOLEAN:
|
||||||
hash = 1;
|
hash = janet_unwrap_boolean(x);
|
||||||
break;
|
|
||||||
case JANET_TRUE:
|
|
||||||
hash = 2;
|
|
||||||
break;
|
break;
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
|
case JANET_KEYWORD:
|
||||||
hash = janet_string_hash(janet_unwrap_string(x));
|
hash = janet_string_hash(janet_unwrap_string(x));
|
||||||
break;
|
break;
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE:
|
||||||
@@ -85,9 +83,6 @@ int32_t janet_hash(Janet x) {
|
|||||||
case JANET_STRUCT:
|
case JANET_STRUCT:
|
||||||
hash = janet_struct_hash(janet_unwrap_struct(x));
|
hash = janet_struct_hash(janet_unwrap_struct(x));
|
||||||
break;
|
break;
|
||||||
case JANET_INTEGER:
|
|
||||||
hash = janet_unwrap_integer(x);
|
|
||||||
break;
|
|
||||||
default:
|
default:
|
||||||
/* TODO - test performance with different hash functions */
|
/* TODO - test performance with different hash functions */
|
||||||
if (sizeof(double) == sizeof(void *)) {
|
if (sizeof(double) == sizeof(void *)) {
|
||||||
@@ -96,10 +91,10 @@ int32_t janet_hash(Janet x) {
|
|||||||
hash = (int32_t)(i & 0xFFFFFFFF);
|
hash = (int32_t)(i & 0xFFFFFFFF);
|
||||||
/* Get a bit more entropy by shifting the low bits out */
|
/* Get a bit more entropy by shifting the low bits out */
|
||||||
hash >>= 3;
|
hash >>= 3;
|
||||||
hash ^= (int32_t) (i >> 32);
|
hash ^= (int32_t)(i >> 32);
|
||||||
} else {
|
} else {
|
||||||
/* Assuming 4 byte pointer (or smaller) */
|
/* Assuming 4 byte pointer (or smaller) */
|
||||||
hash = (int32_t) ((char *)janet_unwrap_pointer(x) - (char *)0);
|
hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0);
|
||||||
hash >>= 2;
|
hash >>= 2;
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
@@ -107,38 +102,33 @@ int32_t janet_hash(Janet x) {
|
|||||||
return hash;
|
return hash;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Compares x to y. If they are equal retuns 0. If x is less, returns -1.
|
/* Compares x to y. If they are equal returns 0. If x is less, returns -1.
|
||||||
* If y is less, returns 1. All types are comparable
|
* If y is less, returns 1. All types are comparable
|
||||||
* and should have strict ordering. */
|
* and should have strict ordering. */
|
||||||
int janet_compare(Janet x, Janet y) {
|
int janet_compare(Janet x, Janet y) {
|
||||||
if (janet_type(x) == janet_type(y)) {
|
if (janet_type(x) == janet_type(y)) {
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
case JANET_FALSE:
|
|
||||||
case JANET_TRUE:
|
|
||||||
return 0;
|
return 0;
|
||||||
case JANET_REAL:
|
case JANET_BOOLEAN:
|
||||||
/* Check for nans to ensure total order */
|
return janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
|
||||||
if (janet_unwrap_real(x) != janet_unwrap_real(x))
|
case JANET_NUMBER:
|
||||||
return janet_unwrap_real(y) != janet_unwrap_real(y)
|
/* Check for NaNs to ensure total order */
|
||||||
|
if (janet_unwrap_number(x) != janet_unwrap_number(x))
|
||||||
|
return janet_unwrap_number(y) != janet_unwrap_number(y)
|
||||||
? 0
|
? 0
|
||||||
: -1;
|
: -1;
|
||||||
if (janet_unwrap_real(y) != janet_unwrap_real(y))
|
if (janet_unwrap_number(y) != janet_unwrap_number(y))
|
||||||
return 1;
|
return 1;
|
||||||
|
|
||||||
if (janet_unwrap_real(x) == janet_unwrap_real(y)) {
|
if (janet_unwrap_number(x) == janet_unwrap_number(y)) {
|
||||||
return 0;
|
return 0;
|
||||||
} else {
|
} else {
|
||||||
return janet_unwrap_real(x) > janet_unwrap_real(y) ? 1 : -1;
|
return janet_unwrap_number(x) > janet_unwrap_number(y) ? 1 : -1;
|
||||||
}
|
|
||||||
case JANET_INTEGER:
|
|
||||||
if (janet_unwrap_integer(x) == janet_unwrap_integer(y)) {
|
|
||||||
return 0;
|
|
||||||
} else {
|
|
||||||
return janet_unwrap_integer(x) > janet_unwrap_integer(y) ? 1 : -1;
|
|
||||||
}
|
}
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
|
case JANET_KEYWORD:
|
||||||
return janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
|
return janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE:
|
||||||
return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
||||||
@@ -154,3 +144,255 @@ int janet_compare(Janet x, Janet y) {
|
|||||||
}
|
}
|
||||||
return (janet_type(x) < janet_type(y)) ? -1 : 1;
|
return (janet_type(x) < janet_type(y)) ? -1 : 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Gets a value and returns. Can panic. */
|
||||||
|
Janet janet_get(Janet ds, Janet key) {
|
||||||
|
Janet value;
|
||||||
|
switch (janet_type(ds)) {
|
||||||
|
default:
|
||||||
|
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
break;
|
||||||
|
case JANET_STRUCT:
|
||||||
|
value = janet_struct_get(janet_unwrap_struct(ds), key);
|
||||||
|
break;
|
||||||
|
case JANET_TABLE:
|
||||||
|
value = janet_table_get(janet_unwrap_table(ds), key);
|
||||||
|
break;
|
||||||
|
case JANET_ARRAY: {
|
||||||
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
|
int32_t index;
|
||||||
|
if (!janet_checkint(key))
|
||||||
|
janet_panic("expected integer key");
|
||||||
|
index = janet_unwrap_integer(key);
|
||||||
|
if (index < 0 || index >= array->count) {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
value = array->data[index];
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_TUPLE: {
|
||||||
|
const Janet *tuple = janet_unwrap_tuple(ds);
|
||||||
|
int32_t index;
|
||||||
|
if (!janet_checkint(key))
|
||||||
|
janet_panic("expected integer key");
|
||||||
|
index = janet_unwrap_integer(key);
|
||||||
|
if (index < 0 || index >= janet_tuple_length(tuple)) {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
value = tuple[index];
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_BUFFER: {
|
||||||
|
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||||
|
int32_t index;
|
||||||
|
if (!janet_checkint(key))
|
||||||
|
janet_panic("expected integer key");
|
||||||
|
index = janet_unwrap_integer(key);
|
||||||
|
if (index < 0 || index >= buffer->count) {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
value = janet_wrap_integer(buffer->data[index]);
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_STRING:
|
||||||
|
case JANET_SYMBOL:
|
||||||
|
case JANET_KEYWORD: {
|
||||||
|
const uint8_t *str = janet_unwrap_string(ds);
|
||||||
|
int32_t index;
|
||||||
|
if (!janet_checkint(key))
|
||||||
|
janet_panic("expected integer key");
|
||||||
|
index = janet_unwrap_integer(key);
|
||||||
|
if (index < 0 || index >= janet_string_length(str)) {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
value = janet_wrap_integer(str[index]);
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||||
|
if (type->get) {
|
||||||
|
value = (type->get)(janet_unwrap_abstract(ds), key);
|
||||||
|
} else {
|
||||||
|
janet_panicf("no getter for %v ", ds);
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return value;
|
||||||
|
}
|
||||||
|
|
||||||
|
Janet janet_getindex(Janet ds, int32_t index) {
|
||||||
|
Janet value;
|
||||||
|
if (index < 0) janet_panic("expected non-negative index");
|
||||||
|
switch (janet_type(ds)) {
|
||||||
|
default:
|
||||||
|
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
break;
|
||||||
|
case JANET_STRING:
|
||||||
|
case JANET_SYMBOL:
|
||||||
|
case JANET_KEYWORD:
|
||||||
|
if (index >= janet_string_length(janet_unwrap_string(ds))) {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
value = janet_wrap_integer(janet_unwrap_string(ds)[index]);
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
case JANET_ARRAY:
|
||||||
|
if (index >= janet_unwrap_array(ds)->count) {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
value = janet_unwrap_array(ds)->data[index];
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
case JANET_BUFFER:
|
||||||
|
if (index >= janet_unwrap_buffer(ds)->count) {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
value = janet_wrap_integer(janet_unwrap_buffer(ds)->data[index]);
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
case JANET_TUPLE:
|
||||||
|
if (index >= janet_tuple_length(janet_unwrap_tuple(ds))) {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
value = janet_unwrap_tuple(ds)[index];
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
case JANET_TABLE:
|
||||||
|
value = janet_table_get(janet_unwrap_table(ds), janet_wrap_integer(index));
|
||||||
|
break;
|
||||||
|
case JANET_STRUCT:
|
||||||
|
value = janet_struct_get(janet_unwrap_struct(ds), janet_wrap_integer(index));
|
||||||
|
break;
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||||
|
if (type->get) {
|
||||||
|
value = (type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index));
|
||||||
|
} else {
|
||||||
|
janet_panicf("no getter for %v ", ds);
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return value;
|
||||||
|
}
|
||||||
|
|
||||||
|
int32_t janet_length(Janet x) {
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
default:
|
||||||
|
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
|
||||||
|
return 0;
|
||||||
|
case JANET_STRING:
|
||||||
|
case JANET_SYMBOL:
|
||||||
|
case JANET_KEYWORD:
|
||||||
|
return janet_string_length(janet_unwrap_string(x));
|
||||||
|
case JANET_ARRAY:
|
||||||
|
return janet_unwrap_array(x)->count;
|
||||||
|
case JANET_BUFFER:
|
||||||
|
return janet_unwrap_buffer(x)->count;
|
||||||
|
case JANET_TUPLE:
|
||||||
|
return janet_tuple_length(janet_unwrap_tuple(x));
|
||||||
|
case JANET_STRUCT:
|
||||||
|
return janet_struct_length(janet_unwrap_struct(x));
|
||||||
|
case JANET_TABLE:
|
||||||
|
return janet_unwrap_table(x)->count;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_putindex(Janet ds, int32_t index, Janet value) {
|
||||||
|
switch (janet_type(ds)) {
|
||||||
|
default:
|
||||||
|
janet_panicf("expected %T, got %v",
|
||||||
|
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||||
|
break;
|
||||||
|
case JANET_ARRAY: {
|
||||||
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
|
if (index >= array->count) {
|
||||||
|
janet_array_ensure(array, index + 1, 2);
|
||||||
|
array->count = index + 1;
|
||||||
|
}
|
||||||
|
array->data[index] = value;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_BUFFER: {
|
||||||
|
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||||
|
if (!janet_checkint(value))
|
||||||
|
janet_panicf("can only put integers in buffers, got %v", value);
|
||||||
|
if (index >= buffer->count) {
|
||||||
|
janet_buffer_ensure(buffer, index + 1, 2);
|
||||||
|
buffer->count = index + 1;
|
||||||
|
}
|
||||||
|
buffer->data[index] = janet_unwrap_integer(value);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_TABLE: {
|
||||||
|
JanetTable *table = janet_unwrap_table(ds);
|
||||||
|
janet_table_put(table, janet_wrap_integer(index), value);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||||
|
if (type->put) {
|
||||||
|
(type->put)(janet_unwrap_abstract(ds), janet_wrap_integer(index), value);
|
||||||
|
} else {
|
||||||
|
janet_panicf("no setter for %v ", ds);
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_put(Janet ds, Janet key, Janet value) {
|
||||||
|
switch (janet_type(ds)) {
|
||||||
|
default:
|
||||||
|
janet_panicf("expected %T, got %v",
|
||||||
|
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||||
|
break;
|
||||||
|
case JANET_ARRAY: {
|
||||||
|
int32_t index;
|
||||||
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
|
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
||||||
|
index = janet_unwrap_integer(key);
|
||||||
|
if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key);
|
||||||
|
if (index >= array->count) {
|
||||||
|
janet_array_setcount(array, index + 1);
|
||||||
|
}
|
||||||
|
array->data[index] = value;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_BUFFER: {
|
||||||
|
int32_t index;
|
||||||
|
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||||
|
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
||||||
|
index = janet_unwrap_integer(key);
|
||||||
|
if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key);
|
||||||
|
if (!janet_checkint(value))
|
||||||
|
janet_panicf("can only put integers in buffers, got %v", value);
|
||||||
|
if (index >= buffer->count) {
|
||||||
|
janet_buffer_setcount(buffer, index + 1);
|
||||||
|
}
|
||||||
|
buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_TABLE:
|
||||||
|
janet_table_put(janet_unwrap_table(ds), key, value);
|
||||||
|
break;
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||||
|
if (type->put) {
|
||||||
|
(type->put)(janet_unwrap_abstract(ds), key, value);
|
||||||
|
} else {
|
||||||
|
janet_panicf("no setter for %v ", ds);
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,14 +20,17 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Grow the buffer dynamically. Used for push operations. */
|
/* Grow the buffer dynamically. Used for push operations. */
|
||||||
void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
|
void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
|
||||||
int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0;
|
int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0;
|
||||||
int32_t min_needed = janet_v_count(v) + increment;
|
int32_t min_needed = janet_v_count(v) + increment;
|
||||||
int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed;
|
int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed;
|
||||||
int32_t *p = (int32_t *) realloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t)*2);
|
int32_t *p = (int32_t *) realloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t) * 2);
|
||||||
if (NULL != p) {
|
if (NULL != p) {
|
||||||
if (!v) p[1] = 0;
|
if (!v) p[1] = 0;
|
||||||
p[0] = m;
|
p[0] = m;
|
||||||
@@ -36,23 +39,7 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
|
|||||||
{
|
{
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
return (void *) (2 * sizeof(int32_t));
|
return (void *)(2 * sizeof(int32_t));
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Clone a buffer. */
|
|
||||||
void *janet_v_copymem(void *v, int32_t itemsize) {
|
|
||||||
int32_t *p;
|
|
||||||
if (NULL == v) return NULL;
|
|
||||||
p = malloc(2 * sizeof(int32_t) + itemsize * janet_v__cap(v));
|
|
||||||
if (NULL != p) {
|
|
||||||
memcpy(p, janet_v__raw(v), 2 * sizeof(int32_t) + itemsize * janet_v__cnt(v));
|
|
||||||
return p + 2;
|
|
||||||
} else {
|
|
||||||
{
|
|
||||||
JANET_OUT_OF_MEMORY;
|
|
||||||
}
|
|
||||||
return (void *) (2 * sizeof(int32_t));
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -23,7 +23,9 @@
|
|||||||
#ifndef JANET_VECTOR_H_defined
|
#ifndef JANET_VECTOR_H_defined
|
||||||
#define JANET_VECTOR_H_defined
|
#define JANET_VECTOR_H_defined
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* vector code modified from
|
* vector code modified from
|
||||||
@@ -38,7 +40,6 @@
|
|||||||
#define janet_v_push(v, x) (janet_v__maybegrow(v, 1), (v)[janet_v__cnt(v)++] = (x))
|
#define janet_v_push(v, x) (janet_v__maybegrow(v, 1), (v)[janet_v__cnt(v)++] = (x))
|
||||||
#define janet_v_pop(v) (janet_v_count(v) ? janet_v__cnt(v)-- : 0)
|
#define janet_v_pop(v) (janet_v_count(v) ? janet_v__cnt(v)-- : 0)
|
||||||
#define janet_v_count(v) (((v) != NULL) ? janet_v__cnt(v) : 0)
|
#define janet_v_count(v) (((v) != NULL) ? janet_v__cnt(v) : 0)
|
||||||
#define janet_v_add(v, n) (janet_v__maybegrow(v, n), janet_v_cnt(v) += (n), &(v)[janet_v__cnt(v) - (n)])
|
|
||||||
#define janet_v_last(v) ((v)[janet_v__cnt(v) - 1])
|
#define janet_v_last(v) ((v)[janet_v__cnt(v) - 1])
|
||||||
#define janet_v_empty(v) (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0)
|
#define janet_v_empty(v) (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0)
|
||||||
#define janet_v_copy(v) (janet_v_copymem((v), sizeof(*(v))))
|
#define janet_v_copy(v) (janet_v_copymem((v), sizeof(*(v))))
|
||||||
|
|||||||
1439
src/core/vm.c
1439
src/core/vm.c
File diff suppressed because it is too large
Load Diff
218
src/core/wrap.c
218
src/core/wrap.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,7 +20,165 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Macro fills */
|
||||||
|
|
||||||
|
JanetType(janet_type)(Janet x) {
|
||||||
|
return janet_type(x);
|
||||||
|
}
|
||||||
|
int (janet_checktype)(Janet x, JanetType type) {
|
||||||
|
return janet_checktype(x, type);
|
||||||
|
}
|
||||||
|
int (janet_checktypes)(Janet x, int typeflags) {
|
||||||
|
return janet_checktypes(x, typeflags);
|
||||||
|
}
|
||||||
|
int (janet_truthy)(Janet x) {
|
||||||
|
return janet_truthy(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
const JanetKV *(janet_unwrap_struct)(Janet x) {
|
||||||
|
return janet_unwrap_struct(x);
|
||||||
|
}
|
||||||
|
const Janet *(janet_unwrap_tuple)(Janet x) {
|
||||||
|
return janet_unwrap_tuple(x);
|
||||||
|
}
|
||||||
|
JanetFiber *(janet_unwrap_fiber)(Janet x) {
|
||||||
|
return janet_unwrap_fiber(x);
|
||||||
|
}
|
||||||
|
JanetArray *(janet_unwrap_array)(Janet x) {
|
||||||
|
return janet_unwrap_array(x);
|
||||||
|
}
|
||||||
|
JanetTable *(janet_unwrap_table)(Janet x) {
|
||||||
|
return janet_unwrap_table(x);
|
||||||
|
}
|
||||||
|
JanetBuffer *(janet_unwrap_buffer)(Janet x) {
|
||||||
|
return janet_unwrap_buffer(x);
|
||||||
|
}
|
||||||
|
const uint8_t *(janet_unwrap_string)(Janet x) {
|
||||||
|
return janet_unwrap_string(x);
|
||||||
|
}
|
||||||
|
const uint8_t *(janet_unwrap_symbol)(Janet x) {
|
||||||
|
return janet_unwrap_symbol(x);
|
||||||
|
}
|
||||||
|
const uint8_t *(janet_unwrap_keyword)(Janet x) {
|
||||||
|
return janet_unwrap_keyword(x);
|
||||||
|
}
|
||||||
|
void *(janet_unwrap_abstract)(Janet x) {
|
||||||
|
return janet_unwrap_abstract(x);
|
||||||
|
}
|
||||||
|
void *(janet_unwrap_pointer)(Janet x) {
|
||||||
|
return janet_unwrap_pointer(x);
|
||||||
|
}
|
||||||
|
JanetFunction *(janet_unwrap_function)(Janet x) {
|
||||||
|
return janet_unwrap_function(x);
|
||||||
|
}
|
||||||
|
JanetCFunction(janet_unwrap_cfunction)(Janet x) {
|
||||||
|
return janet_unwrap_cfunction(x);
|
||||||
|
}
|
||||||
|
int (janet_unwrap_boolean)(Janet x) {
|
||||||
|
return janet_unwrap_boolean(x);
|
||||||
|
}
|
||||||
|
int32_t (janet_unwrap_integer)(Janet x) {
|
||||||
|
return janet_unwrap_integer(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
#if defined(JANET_NANBOX_32) || defined(JANET_NANBOX_64)
|
||||||
|
Janet(janet_wrap_nil)(void) {
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_true)(void) {
|
||||||
|
return janet_wrap_true();
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_false)(void) {
|
||||||
|
return janet_wrap_false();
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_boolean)(int x) {
|
||||||
|
return janet_wrap_boolean(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_string)(const uint8_t *x) {
|
||||||
|
return janet_wrap_string(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_symbol)(const uint8_t *x) {
|
||||||
|
return janet_wrap_symbol(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_keyword)(const uint8_t *x) {
|
||||||
|
return janet_wrap_keyword(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_array)(JanetArray *x) {
|
||||||
|
return janet_wrap_array(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_tuple)(const Janet *x) {
|
||||||
|
return janet_wrap_tuple(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_struct)(const JanetKV *x) {
|
||||||
|
return janet_wrap_struct(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_fiber)(JanetFiber *x) {
|
||||||
|
return janet_wrap_fiber(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_buffer)(JanetBuffer *x) {
|
||||||
|
return janet_wrap_buffer(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_function)(JanetFunction *x) {
|
||||||
|
return janet_wrap_function(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_cfunction)(JanetCFunction x) {
|
||||||
|
return janet_wrap_cfunction(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_table)(JanetTable *x) {
|
||||||
|
return janet_wrap_table(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_abstract)(void *x) {
|
||||||
|
return janet_wrap_abstract(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_pointer)(void *x) {
|
||||||
|
return janet_wrap_pointer(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_integer)(int32_t x) {
|
||||||
|
return janet_wrap_integer(x);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifndef JANET_NANBOX_32
|
||||||
|
double (janet_unwrap_number)(Janet x) {
|
||||||
|
return janet_unwrap_number(x);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef JANET_NANBOX_64
|
||||||
|
Janet(janet_wrap_number)(double x) {
|
||||||
|
return janet_wrap_number(x);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/*****/
|
||||||
|
|
||||||
|
void *janet_memalloc_empty(int32_t count) {
|
||||||
|
int32_t i;
|
||||||
|
void *mem = malloc(count * sizeof(JanetKV));
|
||||||
|
if (NULL == mem) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
JanetKV *mmem = (JanetKV *)mem;
|
||||||
|
for (i = 0; i < count; i++) {
|
||||||
|
JanetKV *kv = mmem + i;
|
||||||
|
kv->key = janet_wrap_nil();
|
||||||
|
kv->value = janet_wrap_nil();
|
||||||
|
}
|
||||||
|
return mem;
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_memempty(JanetKV *mem, int32_t count) {
|
||||||
|
int32_t i;
|
||||||
|
for (i = 0; i < count; i++) {
|
||||||
|
mem[i].key = janet_wrap_nil();
|
||||||
|
mem[i].value = janet_wrap_nil();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
#ifdef JANET_NANBOX_64
|
#ifdef JANET_NANBOX_64
|
||||||
|
|
||||||
@@ -45,10 +203,7 @@ Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask) {
|
|||||||
|
|
||||||
Janet janet_nanbox_from_double(double d) {
|
Janet janet_nanbox_from_double(double d) {
|
||||||
Janet ret;
|
Janet ret;
|
||||||
ret.real = d;
|
ret.number = d;
|
||||||
/* Normalize NaNs */
|
|
||||||
if (d != d)
|
|
||||||
ret.u64 = janet_nanbox_tag(JANET_REAL);
|
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -58,31 +213,11 @@ Janet janet_nanbox_from_bits(uint64_t bits) {
|
|||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
void *janet_nanbox_memalloc_empty(int32_t count) {
|
|
||||||
int32_t i;
|
|
||||||
void *mem = malloc(count * sizeof(JanetKV));
|
|
||||||
JanetKV *mmem = (JanetKV *)mem;
|
|
||||||
for (i = 0; i < count; i++) {
|
|
||||||
JanetKV *kv = mmem + i;
|
|
||||||
kv->key = janet_wrap_nil();
|
|
||||||
kv->value = janet_wrap_nil();
|
|
||||||
}
|
|
||||||
return mem;
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_nanbox_memempty(JanetKV *mem, int32_t count) {
|
|
||||||
int32_t i;
|
|
||||||
for (i = 0; i < count; i++) {
|
|
||||||
mem[i].key = janet_wrap_nil();
|
|
||||||
mem[i].value = janet_wrap_nil();
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
#elif defined(JANET_NANBOX_32)
|
#elif defined(JANET_NANBOX_32)
|
||||||
|
|
||||||
Janet janet_wrap_real(double x) {
|
Janet janet_wrap_number(double x) {
|
||||||
Janet ret;
|
Janet ret;
|
||||||
ret.real = x;
|
ret.number = x;
|
||||||
ret.tagged.type += JANET_DOUBLE_OFFSET;
|
ret.tagged.type += JANET_DOUBLE_OFFSET;
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
@@ -101,20 +236,14 @@ Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer) {
|
|||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
double janet_unwrap_real(Janet x) {
|
double janet_unwrap_number(Janet x) {
|
||||||
x.tagged.type -= JANET_DOUBLE_OFFSET;
|
x.tagged.type -= JANET_DOUBLE_OFFSET;
|
||||||
return x.real;
|
return x.number;
|
||||||
}
|
}
|
||||||
|
|
||||||
#else
|
#else
|
||||||
|
|
||||||
/* Wrapper functions wrap a data type that is used from C into a
|
Janet janet_wrap_nil(void) {
|
||||||
* janet value, which can then be used in janet internal functions. Use
|
|
||||||
* these functions sparingly, as these function will let the programmer
|
|
||||||
* leak memory, where as the stack based API ensures that all values can
|
|
||||||
* be collected by the garbage collector. */
|
|
||||||
|
|
||||||
Janet janet_wrap_nil() {
|
|
||||||
Janet y;
|
Janet y;
|
||||||
y.type = JANET_NIL;
|
y.type = JANET_NIL;
|
||||||
y.as.u64 = 0;
|
y.as.u64 = 0;
|
||||||
@@ -123,22 +252,22 @@ Janet janet_wrap_nil() {
|
|||||||
|
|
||||||
Janet janet_wrap_true(void) {
|
Janet janet_wrap_true(void) {
|
||||||
Janet y;
|
Janet y;
|
||||||
y.type = JANET_TRUE;
|
y.type = JANET_BOOLEAN;
|
||||||
y.as.u64 = 0;
|
y.as.u64 = 1;
|
||||||
return y;
|
return y;
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_wrap_false(void) {
|
Janet janet_wrap_false(void) {
|
||||||
Janet y;
|
Janet y;
|
||||||
y.type = JANET_FALSE;
|
y.type = JANET_BOOLEAN;
|
||||||
y.as.u64 = 0;
|
y.as.u64 = 0;
|
||||||
return y;
|
return y;
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_wrap_boolean(int x) {
|
Janet janet_wrap_boolean(int x) {
|
||||||
Janet y;
|
Janet y;
|
||||||
y.type = x ? JANET_TRUE : JANET_FALSE;
|
y.type = JANET_BOOLEAN;
|
||||||
y.as.u64 = 0;
|
y.as.u64 = !!x;
|
||||||
return y;
|
return y;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -151,10 +280,10 @@ Janet janet_wrap_##NAME(TYPE x) {\
|
|||||||
return y;\
|
return y;\
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_WRAP_DEFINE(real, double, JANET_REAL, real)
|
JANET_WRAP_DEFINE(number, double, JANET_NUMBER, number)
|
||||||
JANET_WRAP_DEFINE(integer, int32_t, JANET_INTEGER, integer)
|
|
||||||
JANET_WRAP_DEFINE(string, const uint8_t *, JANET_STRING, cpointer)
|
JANET_WRAP_DEFINE(string, const uint8_t *, JANET_STRING, cpointer)
|
||||||
JANET_WRAP_DEFINE(symbol, const uint8_t *, JANET_SYMBOL, cpointer)
|
JANET_WRAP_DEFINE(symbol, const uint8_t *, JANET_SYMBOL, cpointer)
|
||||||
|
JANET_WRAP_DEFINE(keyword, const uint8_t *, JANET_KEYWORD, cpointer)
|
||||||
JANET_WRAP_DEFINE(array, JanetArray *, JANET_ARRAY, pointer)
|
JANET_WRAP_DEFINE(array, JanetArray *, JANET_ARRAY, pointer)
|
||||||
JANET_WRAP_DEFINE(tuple, const Janet *, JANET_TUPLE, cpointer)
|
JANET_WRAP_DEFINE(tuple, const Janet *, JANET_TUPLE, cpointer)
|
||||||
JANET_WRAP_DEFINE(struct, const JanetKV *, JANET_STRUCT, cpointer)
|
JANET_WRAP_DEFINE(struct, const JanetKV *, JANET_STRUCT, cpointer)
|
||||||
@@ -164,6 +293,7 @@ JANET_WRAP_DEFINE(function, JanetFunction *, JANET_FUNCTION, pointer)
|
|||||||
JANET_WRAP_DEFINE(cfunction, JanetCFunction, JANET_CFUNCTION, pointer)
|
JANET_WRAP_DEFINE(cfunction, JanetCFunction, JANET_CFUNCTION, pointer)
|
||||||
JANET_WRAP_DEFINE(table, JanetTable *, JANET_TABLE, pointer)
|
JANET_WRAP_DEFINE(table, JanetTable *, JANET_TABLE, pointer)
|
||||||
JANET_WRAP_DEFINE(abstract, void *, JANET_ABSTRACT, pointer)
|
JANET_WRAP_DEFINE(abstract, void *, JANET_ABSTRACT, pointer)
|
||||||
|
JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer)
|
||||||
|
|
||||||
#undef JANET_WRAP_DEFINE
|
#undef JANET_WRAP_DEFINE
|
||||||
|
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
46
src/include/janetconf.h
Normal file
46
src/include/janetconf.h
Normal file
@@ -0,0 +1,46 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 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.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* Configure Janet. Edit this file to customize the build */
|
||||||
|
|
||||||
|
#ifndef JANETCONF_H
|
||||||
|
#define JANETCONF_H
|
||||||
|
|
||||||
|
#define JANET_VERSION "1.0.0"
|
||||||
|
|
||||||
|
/* #define JANET_BUILD "local" */
|
||||||
|
/* #define JANET_SINGLE_THREADED */
|
||||||
|
/* #define JANET_NO_DYNAMIC_MODULES */
|
||||||
|
/* #define JANET_NO_ASSEMBLER */
|
||||||
|
/* #define JANET_NO_PEG */
|
||||||
|
/* #define JANET_NO_TYPED_ARRAY */
|
||||||
|
/* #define JANET_NO_INT_TYPES */
|
||||||
|
/* #define JANET_REDUCED_OS */
|
||||||
|
/* #define JANET_API __attribute__((visibility ("default"))) */
|
||||||
|
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
||||||
|
/* #define JANET_RECURSION_GUARD 1024 */
|
||||||
|
/* #define JANET_MAX_PROTO_DEPTH 200 */
|
||||||
|
/* #define JANET_MAX_MACRO_EXPAND 200 */
|
||||||
|
/* #define JANET_STACK_MAX 16384 */
|
||||||
|
/* #define JANET_NO_NANBOX */
|
||||||
|
|
||||||
|
#endif /* end of include guard: JANETCONF_H */
|
||||||
@@ -1,36 +1,60 @@
|
|||||||
# Copyright 2017-2018 (C) Calvin Rose
|
# Copyright 2017-2019 (C) Calvin Rose
|
||||||
|
|
||||||
(do
|
(do
|
||||||
|
|
||||||
(var *should-repl* :private false)
|
(var *should-repl* false)
|
||||||
(var *no-file* :private true)
|
(var *no-file* true)
|
||||||
(var *raw-stdin* :private false)
|
(var *quiet* false)
|
||||||
(var *handleopts* :private true)
|
(var *raw-stdin* false)
|
||||||
(var *exit-on-error* :private true)
|
(var *handleopts* true)
|
||||||
|
(var *exit-on-error* true)
|
||||||
|
(var *colorize* true)
|
||||||
|
(var *compile-only* false)
|
||||||
|
|
||||||
|
(if-let [jp (os/getenv "JANET_PATH")] (set module/*syspath* jp))
|
||||||
|
|
||||||
# Flag handlers
|
# Flag handlers
|
||||||
(def handlers :private
|
(def handlers :private
|
||||||
{"h" (fn [&]
|
{"h" (fn [&]
|
||||||
(print "usage: " process/args.0 " [options] scripts...")
|
(print "usage: " (get process/args 0) " [options] script args...")
|
||||||
(print
|
(print
|
||||||
`Options are:
|
`Options are:
|
||||||
-h Show this help
|
-h : Show this help
|
||||||
-v Print the version string
|
-v : Print the version string
|
||||||
-s Use raw stdin instead of getline like functionality
|
-s : Use raw stdin instead of getline like functionality
|
||||||
-e Execute a string of janet
|
-e code : Execute a string of janet
|
||||||
-r Enter the repl after running all scripts
|
-r : Enter the repl after running all scripts
|
||||||
-p Keep on executing if there is a top level error (persistent)
|
-p : Keep on executing if there is a top level error (persistent)
|
||||||
-- Stop handling options`)
|
-q : Hide prompt, logo, and repl output (quiet)
|
||||||
|
-k : Compile scripts but do not execute
|
||||||
|
-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`)
|
||||||
(os/exit 0)
|
(os/exit 0)
|
||||||
1)
|
1)
|
||||||
"v" (fn [&] (print janet/version "-" janet/build) (os/exit 0) 1)
|
"v" (fn [&] (print janet/version "-" janet/build) (os/exit 0) 1)
|
||||||
"s" (fn [&] (:= *raw-stdin* true) (:= *should-repl* true) 1)
|
"s" (fn [&] (set *raw-stdin* true) (set *should-repl* true) 1)
|
||||||
"r" (fn [&] (:= *should-repl* true) 1)
|
"r" (fn [&] (set *should-repl* true) 1)
|
||||||
"p" (fn [&] (:= *exit-on-error* false) 1)
|
"p" (fn [&] (set *exit-on-error* false) 1)
|
||||||
"-" (fn [&] (:= *handleopts* false) 1)
|
"q" (fn [&] (set *quiet* true) 1)
|
||||||
|
"k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
|
||||||
|
"n" (fn [&] (set *colorize* false) 1)
|
||||||
|
"m" (fn [i &] (set module/*syspath* (get process/args (+ i 1))) 2)
|
||||||
|
"c" (fn [i &]
|
||||||
|
(def e (require (get process/args (+ i 1))))
|
||||||
|
(spit (get process/args (+ i 2)) (make-image e))
|
||||||
|
(set *no-file* false)
|
||||||
|
3)
|
||||||
|
"-" (fn [&] (set *handleopts* false) 1)
|
||||||
|
"l" (fn [i &]
|
||||||
|
(import* (get process/args (+ i 1))
|
||||||
|
:prefix "" :exit *exit-on-error*)
|
||||||
|
2)
|
||||||
"e" (fn [i &]
|
"e" (fn [i &]
|
||||||
(:= *no-file* false)
|
(set *no-file* false)
|
||||||
(eval (get process/args (+ i 1)))
|
(eval-string (get process/args (+ i 1)))
|
||||||
2)})
|
2)})
|
||||||
|
|
||||||
(defn- dohandler [n i &]
|
(defn- dohandler [n i &]
|
||||||
@@ -45,16 +69,25 @@
|
|||||||
(if (and *handleopts* (= "-" (string/slice arg 0 1)))
|
(if (and *handleopts* (= "-" (string/slice arg 0 1)))
|
||||||
(+= i (dohandler (string/slice arg 1 2) i))
|
(+= i (dohandler (string/slice arg 1 2) i))
|
||||||
(do
|
(do
|
||||||
(:= *no-file* false)
|
(set *no-file* false)
|
||||||
(import* _env arg :prefix "" :exit *exit-on-error*)
|
(import* arg :prefix "" :exit *exit-on-error* :compile-only *compile-only*)
|
||||||
(++ i))))
|
(set i lenargs))))
|
||||||
|
|
||||||
(when (or *should-repl* *no-file*)
|
(when (and (not *compile-only*) (or *should-repl* *no-file*))
|
||||||
(if *raw-stdin*
|
(if-not *quiet*
|
||||||
(repl nil identity)
|
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||||
(do
|
(defn noprompt [_] "")
|
||||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2018 Calvin Rose"))
|
(defn getprompt [p]
|
||||||
(repl (fn [buf p]
|
(def offset (parser/where p))
|
||||||
(def [line] (parser/where p))
|
(string "janet:" offset ":" (parser/state p) "> "))
|
||||||
(def prompt (string "janet:" line ":" (parser/state p) "> "))
|
(def prompter (if *quiet* noprompt getprompt))
|
||||||
(getline prompt buf)))))))
|
(defn getstdin [prompt buf]
|
||||||
|
(file/write stdout prompt)
|
||||||
|
(file/flush stdout)
|
||||||
|
(file/read stdin :line buf))
|
||||||
|
(def getter (if *raw-stdin* getstdin getline))
|
||||||
|
(defn getchunk [buf p]
|
||||||
|
(getter (prompter p) buf))
|
||||||
|
(def onsig (if *quiet* (fn [x &] x) nil))
|
||||||
|
(setdyn :pretty-format (if *colorize* "%.20P" "%.20p"))
|
||||||
|
(repl getchunk onsig)))
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -23,14 +23,12 @@
|
|||||||
#include "line.h"
|
#include "line.h"
|
||||||
|
|
||||||
/* Common */
|
/* Common */
|
||||||
int janet_line_getter(JanetArgs args) {
|
Janet janet_line_getter(int32_t argc, Janet *argv) {
|
||||||
JANET_FIXARITY(args, 2);
|
janet_arity(argc, 0, 2);
|
||||||
JANET_CHECK(args, 0, JANET_STRING);
|
const char *str = (argc >= 1) ? (const char *) janet_getstring(argv, 0) : "";
|
||||||
JANET_CHECK(args, 1, JANET_BUFFER);
|
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||||
janet_line_get(
|
janet_line_get(str, buf);
|
||||||
janet_unwrap_string(args.v[0]),
|
return janet_wrap_buffer(buf);
|
||||||
janet_unwrap_buffer(args.v[1]));
|
|
||||||
JANET_RETURN(args, args.v[0]);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static void simpleline(JanetBuffer *buffer) {
|
static void simpleline(JanetBuffer *buffer) {
|
||||||
@@ -57,8 +55,8 @@ void janet_line_deinit() {
|
|||||||
;
|
;
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_line_get(const uint8_t *p, JanetBuffer *buffer) {
|
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||||
fputs((const char *)p, stdout);
|
fputs(p, stdout);
|
||||||
simpleline(buffer);
|
simpleline(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -96,6 +94,7 @@ static int cols = 80;
|
|||||||
static char *history[JANET_HISTORY_MAX];
|
static char *history[JANET_HISTORY_MAX];
|
||||||
static int history_count = 0;
|
static int history_count = 0;
|
||||||
static int historyi = 0;
|
static int historyi = 0;
|
||||||
|
static int sigint_flag = 0;
|
||||||
static struct termios termios_start;
|
static struct termios termios_start;
|
||||||
|
|
||||||
/* Unsupported terminal list from linenoise */
|
/* Unsupported terminal list from linenoise */
|
||||||
@@ -146,8 +145,8 @@ static int curpos() {
|
|||||||
int cols, rows;
|
int cols, rows;
|
||||||
unsigned int i = 0;
|
unsigned int i = 0;
|
||||||
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
|
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
|
||||||
while (i < sizeof(buf)-1) {
|
while (i < sizeof(buf) - 1) {
|
||||||
if (read(STDIN_FILENO, buf+i, 1) != 1) break;
|
if (read(STDIN_FILENO, buf + i, 1) != 1) break;
|
||||||
if (buf[i] == 'R') break;
|
if (buf[i] == 'R') break;
|
||||||
i++;
|
i++;
|
||||||
}
|
}
|
||||||
@@ -168,7 +167,7 @@ static int getcols() {
|
|||||||
if (cols == -1) goto failed;
|
if (cols == -1) goto failed;
|
||||||
if (cols > start) {
|
if (cols > start) {
|
||||||
char seq[32];
|
char seq[32];
|
||||||
snprintf(seq, 32, "\x1b[%dD", cols-start);
|
snprintf(seq, 32, "\x1b[%dD", cols - start);
|
||||||
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {}
|
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {}
|
||||||
}
|
}
|
||||||
return cols;
|
return cols;
|
||||||
@@ -180,7 +179,7 @@ failed:
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void clear() {
|
static void clear() {
|
||||||
if (write(STDOUT_FILENO,"\x1b[H\x1b[2J",7) <= 0) {}
|
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {}
|
||||||
}
|
}
|
||||||
|
|
||||||
static void refresh() {
|
static void refresh() {
|
||||||
@@ -208,7 +207,7 @@ static void refresh() {
|
|||||||
/* Erase to right */
|
/* Erase to right */
|
||||||
janet_buffer_push_cstring(&b, "\x1b[0K");
|
janet_buffer_push_cstring(&b, "\x1b[0K");
|
||||||
/* Move cursor to original position. */
|
/* Move cursor to original position. */
|
||||||
snprintf(seq, 64,"\r\x1b[%dC", (int)(_pos + plen));
|
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + plen));
|
||||||
janet_buffer_push_cstring(&b, seq);
|
janet_buffer_push_cstring(&b, seq);
|
||||||
if (write(STDOUT_FILENO, b.data, b.count) == -1) {}
|
if (write(STDOUT_FILENO, b.data, b.count) == -1) {}
|
||||||
janet_buffer_deinit(&b);
|
janet_buffer_deinit(&b);
|
||||||
@@ -323,7 +322,7 @@ static int line() {
|
|||||||
nread = read(STDIN_FILENO, &c, 1);
|
nread = read(STDIN_FILENO, &c, 1);
|
||||||
if (nread <= 0) return -1;
|
if (nread <= 0) return -1;
|
||||||
|
|
||||||
switch(c) {
|
switch (c) {
|
||||||
default:
|
default:
|
||||||
if (insert(c)) return -1;
|
if (insert(c)) return -1;
|
||||||
break;
|
break;
|
||||||
@@ -335,6 +334,7 @@ static int line() {
|
|||||||
return 0;
|
return 0;
|
||||||
case 3: /* ctrl-c */
|
case 3: /* ctrl-c */
|
||||||
errno = EAGAIN;
|
errno = EAGAIN;
|
||||||
|
sigint_flag = 1;
|
||||||
return -1;
|
return -1;
|
||||||
case 127: /* backspace */
|
case 127: /* backspace */
|
||||||
case 8: /* ctrl-h */
|
case 8: /* ctrl-h */
|
||||||
@@ -374,7 +374,7 @@ static int line() {
|
|||||||
/* Extended escape, read additional byte. */
|
/* Extended escape, read additional byte. */
|
||||||
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
|
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
|
||||||
if (seq[2] == '~') {
|
if (seq[2] == '~') {
|
||||||
switch(seq[1]) {
|
switch (seq[1]) {
|
||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -446,8 +446,8 @@ static int checktermsupport() {
|
|||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_line_get(const uint8_t *p, JanetBuffer *buffer) {
|
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||||
prompt = (const char *)p;
|
prompt = p;
|
||||||
buffer->count = 0;
|
buffer->count = 0;
|
||||||
historyi = 0;
|
historyi = 0;
|
||||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||||
@@ -460,7 +460,11 @@ void janet_line_get(const uint8_t *p, JanetBuffer *buffer) {
|
|||||||
}
|
}
|
||||||
if (line()) {
|
if (line()) {
|
||||||
norawmode();
|
norawmode();
|
||||||
|
if (sigint_flag) {
|
||||||
|
raise(SIGINT);
|
||||||
|
} else {
|
||||||
fputc('\n', stdout);
|
fputc('\n', stdout);
|
||||||
|
}
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
norawmode();
|
norawmode();
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -23,12 +23,12 @@
|
|||||||
#ifndef JANET_LINE_H_defined
|
#ifndef JANET_LINE_H_defined
|
||||||
#define JANET_LINE_H_defined
|
#define JANET_LINE_H_defined
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
|
|
||||||
void janet_line_init();
|
void janet_line_init();
|
||||||
void janet_line_deinit();
|
void janet_line_deinit();
|
||||||
|
|
||||||
void janet_line_get(const uint8_t *p, JanetBuffer *buffer);
|
void janet_line_get(const char *p, JanetBuffer *buffer);
|
||||||
int janet_line_getter(JanetArgs args);
|
Janet janet_line_getter(int32_t argc, Janet *argv);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,9 +20,16 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "line.h"
|
#include "line.h"
|
||||||
|
|
||||||
|
#ifdef _WIN32
|
||||||
|
#include <windows.h>
|
||||||
|
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||||
|
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||||
|
#endif
|
||||||
|
#endif
|
||||||
|
|
||||||
extern const unsigned char *janet_gen_init;
|
extern const unsigned char *janet_gen_init;
|
||||||
extern int32_t janet_gen_init_size;
|
extern int32_t janet_gen_init_size;
|
||||||
|
|
||||||
@@ -31,9 +38,25 @@ int main(int argc, char **argv) {
|
|||||||
JanetArray *args;
|
JanetArray *args;
|
||||||
JanetTable *env;
|
JanetTable *env;
|
||||||
|
|
||||||
|
/* Enable color console on windows 10 console. */
|
||||||
|
#ifdef _WIN32
|
||||||
|
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||||
|
DWORD dwMode = 0;
|
||||||
|
GetConsoleMode(hOut, &dwMode);
|
||||||
|
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||||
|
SetConsoleMode(hOut, dwMode);
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Set up VM */
|
/* Set up VM */
|
||||||
janet_init();
|
janet_init();
|
||||||
env = janet_core_env();
|
|
||||||
|
/* 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 */
|
/* Create args tuple */
|
||||||
args = janet_array(argc);
|
args = janet_array(argc);
|
||||||
@@ -41,11 +64,6 @@ int main(int argc, char **argv) {
|
|||||||
janet_array_push(args, janet_cstringv(argv[i]));
|
janet_array_push(args, janet_cstringv(argv[i]));
|
||||||
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
||||||
|
|
||||||
/* Expose line getter */
|
|
||||||
janet_def(env, "getline", janet_wrap_cfunction(janet_line_getter), NULL);
|
|
||||||
janet_register("getline", janet_line_getter);
|
|
||||||
janet_line_init();
|
|
||||||
|
|
||||||
/* Run startup script */
|
/* Run startup script */
|
||||||
status = janet_dobytes(env, janet_gen_init, janet_gen_init_size, "init.janet", NULL);
|
status = janet_dobytes(env, janet_gen_init, janet_gen_init_size, "init.janet", NULL);
|
||||||
|
|
||||||
|
|||||||
104
src/tools/xxd.c
104
src/tools/xxd.c
@@ -1,104 +0,0 @@
|
|||||||
/*
|
|
||||||
* Copyright (c) 2018 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.
|
|
||||||
*/
|
|
||||||
|
|
||||||
/* Simple clone of the xxd tool used at build time. Used to
|
|
||||||
* create headers out of source files. Only used for core libraries
|
|
||||||
* like the bootstrapping code and the stl. */
|
|
||||||
|
|
||||||
#include <stdlib.h>
|
|
||||||
#include <stdio.h>
|
|
||||||
#include <stdint.h>
|
|
||||||
|
|
||||||
#define BUFSIZE 1024
|
|
||||||
#define PERLINE 10
|
|
||||||
|
|
||||||
int main(int argc, const char **argv) {
|
|
||||||
|
|
||||||
static const char hex[] = "0123456789ABCDEF";
|
|
||||||
char buf[BUFSIZE];
|
|
||||||
size_t bytesRead = 0;
|
|
||||||
int32_t totalRead = 0;
|
|
||||||
int lineIndex = 0;
|
|
||||||
int line = 0;
|
|
||||||
|
|
||||||
if (argc != 4) {
|
|
||||||
fprintf(stderr, "Usage: %s infile outfile symbol\n", argv[0]);
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Open the files */
|
|
||||||
FILE *in = fopen(argv[1], "rb");
|
|
||||||
FILE *out = fopen(argv[2], "wb");
|
|
||||||
|
|
||||||
/* Check if files open successfully */
|
|
||||||
if (in == NULL) {
|
|
||||||
fprintf(stderr, "Could not open input file %s\n", argv[1]);
|
|
||||||
return 1;
|
|
||||||
} else if (out == NULL) {
|
|
||||||
fprintf(stderr, "Could not open output file %s\n", argv[2]);
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Write the header */
|
|
||||||
fprintf(out, "/* Auto generated - DO NOT EDIT */\n\n#include <stdint.h>\n\n");
|
|
||||||
fprintf(out, "static const unsigned char bytes[] = {");
|
|
||||||
|
|
||||||
/* Read in chunks from buffer */
|
|
||||||
while ((bytesRead = fread(buf, 1, sizeof(buf), in)) > 0) {
|
|
||||||
size_t i;
|
|
||||||
totalRead += bytesRead;
|
|
||||||
for (i = 0; i < bytesRead; ++i) {
|
|
||||||
int byte = ((uint8_t *)buf) [i];
|
|
||||||
|
|
||||||
/* Write the byte */
|
|
||||||
if (lineIndex++ == 0) {
|
|
||||||
if (line++)
|
|
||||||
fputc(',', out);
|
|
||||||
fputs("\n\t", out);
|
|
||||||
} else {
|
|
||||||
fputs(", ", out);
|
|
||||||
}
|
|
||||||
fputs("0x", out);
|
|
||||||
fputc(hex[byte >> 4], out);
|
|
||||||
fputc(hex[byte & 0xF], out);
|
|
||||||
|
|
||||||
/* Make line index wrap */
|
|
||||||
if (lineIndex >= PERLINE)
|
|
||||||
lineIndex = 0;
|
|
||||||
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Write the tail */
|
|
||||||
fputs("\n};\n\n", out);
|
|
||||||
|
|
||||||
fprintf(out, "const unsigned char *%s = bytes;\n\n", argv[3]);
|
|
||||||
|
|
||||||
/* Write chunk size */
|
|
||||||
fprintf(out, "int32_t %s_size = %d;\n", argv[3], totalRead);
|
|
||||||
|
|
||||||
/* Close the file handles */
|
|
||||||
fclose(in);
|
|
||||||
fclose(out);
|
|
||||||
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,7 +20,7 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <emscripten.h>
|
#include <emscripten.h>
|
||||||
|
|
||||||
extern const unsigned char *janet_gen_webinit;
|
extern const unsigned char *janet_gen_webinit;
|
||||||
@@ -32,11 +32,11 @@ static const uint8_t *line_prompt = NULL;
|
|||||||
|
|
||||||
/* Yield to JS event loop from janet. Takes a repl prompt
|
/* Yield to JS event loop from janet. Takes a repl prompt
|
||||||
* and a buffer to fill with input data. */
|
* and a buffer to fill with input data. */
|
||||||
static int repl_yield(JanetArgs args) {
|
static Janet repl_yield(int32_t argc, Janet *argv) {
|
||||||
JANET_FIXARITY(args, 2);
|
janet_fixarity(argc, 2);
|
||||||
JANET_ARG_STRING(line_prompt, args, 0);
|
line_prompt = janet_getstring(argv, 0);
|
||||||
JANET_ARG_BUFFER(line_buffer, args, 1);
|
line_buffer = janet_getbuffer(argv, 1);
|
||||||
JANET_RETURN_NIL(args);
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Re-enter the loop */
|
/* Re-enter the loop */
|
||||||
@@ -44,7 +44,7 @@ static int enter_loop(void) {
|
|||||||
Janet ret;
|
Janet ret;
|
||||||
JanetSignal status = janet_continue(repl_fiber, janet_wrap_nil(), &ret);
|
JanetSignal status = janet_continue(repl_fiber, janet_wrap_nil(), &ret);
|
||||||
if (status == JANET_SIGNAL_ERROR) {
|
if (status == JANET_SIGNAL_ERROR) {
|
||||||
janet_stacktrace(repl_fiber, "runtime", ret);
|
janet_stacktrace(repl_fiber, ret);
|
||||||
janet_deinit();
|
janet_deinit();
|
||||||
repl_fiber = NULL;
|
repl_fiber = NULL;
|
||||||
return 1;
|
return 1;
|
||||||
@@ -52,18 +52,15 @@ static int enter_loop(void) {
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Allow JS interop from within janet */
|
/* Allow JS interoperation from within janet */
|
||||||
static int cfun_js(JanetArgs args) {
|
static Janet cfun_js(int32_t argc, Janet *argv) {
|
||||||
const uint8_t *bytes;
|
janet_fixarity(argc, 1);
|
||||||
int32_t len;
|
JanetByteView bytes = janet_getbytes(argv, 0);
|
||||||
JANET_FIXARITY(args, 1);
|
emscripten_run_script((const char *)bytes.bytes);
|
||||||
JANET_ARG_BYTES(bytes, len, args, 0);
|
return janet_wrap_nil();
|
||||||
(void) len;
|
|
||||||
emscripten_run_script((const char *)bytes);
|
|
||||||
JANET_RETURN_NIL(args);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Intialize the repl */
|
/* Initialize the repl */
|
||||||
EMSCRIPTEN_KEEPALIVE
|
EMSCRIPTEN_KEEPALIVE
|
||||||
void repl_init(void) {
|
void repl_init(void) {
|
||||||
int status;
|
int status;
|
||||||
@@ -73,7 +70,7 @@ void repl_init(void) {
|
|||||||
janet_init();
|
janet_init();
|
||||||
janet_register("repl-yield", repl_yield);
|
janet_register("repl-yield", repl_yield);
|
||||||
janet_register("js", cfun_js);
|
janet_register("js", cfun_js);
|
||||||
env = janet_core_env();
|
env = janet_core_env(NULL);
|
||||||
|
|
||||||
janet_def(env, "repl-yield", janet_wrap_cfunction(repl_yield), NULL);
|
janet_def(env, "repl-yield", janet_wrap_cfunction(repl_yield), NULL);
|
||||||
janet_def(env, "js", janet_wrap_cfunction(cfun_js), NULL);
|
janet_def(env, "js", janet_wrap_cfunction(cfun_js), NULL);
|
||||||
|
|||||||
@@ -1,10 +1,12 @@
|
|||||||
# Copyright 2017-2018 (C) Calvin Rose
|
# Copyright 2017-2019 (C) Calvin Rose
|
||||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2018 Calvin Rose"))
|
|
||||||
|
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||||
|
|
||||||
(fiber/new (fn webrepl []
|
(fiber/new (fn webrepl []
|
||||||
|
(setdyn :pretty-format "%.20P")
|
||||||
(repl (fn get-line [buf p]
|
(repl (fn get-line [buf p]
|
||||||
(def [line] (parser/where p))
|
(def offset (parser/where p))
|
||||||
(def prompt (string "janet:" line ":" (parser/state p) "> "))
|
(def prompt (string "janet:" offset ":" (parser/state p) "> "))
|
||||||
(repl-yield prompt buf)
|
(repl-yield prompt buf)
|
||||||
(yield)
|
(yield)
|
||||||
buf))))
|
buf))))
|
||||||
|
|||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user