|
4223
|
1 #include "IO.h"
|
|
|
2 #include "Str.h"
|
|
|
3 #include "kork.h"
|
|
|
4 #include "list.h"
|
|
|
5 #include "main_io.h"
|
|
|
6 #include "main_opt.h"
|
|
|
7 #include "match.h"
|
|
|
8 #include "pp.h"
|
|
|
9 #include "re.h"
|
|
|
10 #include "run.h"
|
|
|
11 #include "val.h"
|
|
|
12 #include "xmalloc.h"
|
|
|
13
|
|
|
14 #include <ctype.h>
|
|
|
15 #include <errno.h>
|
|
|
16 #include <float.h>
|
|
|
17 #include <math.h>
|
|
|
18 #include <stdio.h>
|
|
|
19 #include <stdlib.h>
|
|
|
20 #include <string.h>
|
|
|
21
|
|
|
22 void pp_abs(struct val *v) {
|
|
|
23 V_NUM(v);
|
|
|
24 v_set_n(v, fabs(v->num));
|
|
|
25 }
|
|
|
26
|
|
|
27 void pp_acos(struct val *v) {
|
|
|
28 V_NUM(v);
|
|
|
29 v_set_n(v, acos(v->num));
|
|
|
30 }
|
|
|
31
|
|
|
32 void pp_asin(struct val *v) {
|
|
|
33 V_NUM(v);
|
|
|
34 v_set_n(v, asin(v->num));
|
|
|
35 }
|
|
|
36
|
|
|
37 void pp_atan(struct val *v) {
|
|
|
38 V_NUM(v);
|
|
|
39 v_set_n(v, atan(v->num));
|
|
|
40 }
|
|
|
41
|
|
|
42 void pp_atan2(struct val *v) {
|
|
|
43 if (!V_LIST_P(v) || li_length(v->magic.list) != 2) {
|
|
|
44 v_set_undef(v);
|
|
|
45 #ifdef EINVAL
|
|
|
46 errno = EINVAL;
|
|
|
47 #endif
|
|
|
48 return;
|
|
|
49 } else {
|
|
|
50 struct val *const a = li_at(v->magic.list, 0);
|
|
|
51 struct val *const b = li_at(v->magic.list, 1);
|
|
|
52 V_NUM(a);
|
|
|
53 V_NUM(b);
|
|
|
54 v_set_n(v, atan2(a->num, b->num));
|
|
|
55 }
|
|
|
56 }
|
|
|
57
|
|
|
58 void pp_chr(struct val *v) {
|
|
|
59 V_NUM(v);
|
|
|
60 V_xxx_OFF(v);
|
|
|
61 ko_cpy_c(v->ko, (unsigned char)(v->num + .5));
|
|
|
62 v->type = V_STR_K;
|
|
|
63 }
|
|
|
64
|
|
|
65 void pp_cos(struct val *v) {
|
|
|
66 V_NUM(v);
|
|
|
67 v_set_n(v, cos(v->num));
|
|
|
68 }
|
|
|
69
|
|
|
70 void pp_defined(struct val *v) {
|
|
|
71 if (v->type != V_UNDEF) {
|
|
|
72 v_set_n(v, 1.0);
|
|
|
73 }
|
|
|
74 }
|
|
|
75
|
|
|
76 void pp_eof(struct val *v) {
|
|
|
77 if (!V_EXT_P(v)) {
|
|
|
78 v_set_undef(v);
|
|
|
79 #ifdef EBADF
|
|
|
80 errno = EBADF;
|
|
|
81 #endif
|
|
|
82 return;
|
|
|
83 }
|
|
|
84 if (io_eof(v->magic.ext)) {
|
|
|
85 v_set_n(v, 1.0);
|
|
|
86 } else {
|
|
|
87 v_set_m(v, "", 0);
|
|
|
88 }
|
|
|
89 }
|
|
|
90
|
|
|
91 void pp_error(struct val *v) {
|
|
|
92 if (!V_EXT_P(v)) {
|
|
|
93 v_set_undef(v);
|
|
|
94 #ifdef EBADF
|
|
|
95 errno = EBADF;
|
|
|
96 #endif
|
|
|
97 return;
|
|
|
98 }
|
|
|
99 if (io_err(v->magic.ext)) {
|
|
|
100 v_set_n(v, 1.0);
|
|
|
101 } else {
|
|
|
102 v_set_m(v, "", 0);
|
|
|
103 }
|
|
|
104 }
|
|
|
105
|
|
|
106 void pp_escape(struct val *v) {
|
|
|
107 String tmp;
|
|
|
108 size_t i;
|
|
|
109
|
|
|
110 V_STR(v);
|
|
|
111 V_xxx_OFF(v);
|
|
|
112 St_init(&tmp);
|
|
|
113 St_cpy(&tmp, ko_str(v->ko));
|
|
|
114 ko_zero(v->ko);
|
|
|
115 for (i = St_len(&tmp); i; ) {
|
|
|
116 --i;
|
|
|
117 if (!(ST_INDEX(&tmp, i) == '_' || isalnum(ST_INDEX(&tmp, i)))) {
|
|
|
118 ko_cat_c(v->ko, '!');
|
|
|
119 }
|
|
|
120 ko_cat_c(v->ko, ST_INDEX(&tmp, i));
|
|
|
121 }
|
|
|
122 St_clear(&tmp);
|
|
|
123 ko_reverse(v->ko);
|
|
|
124 v->type = V_STR_K;
|
|
|
125 }
|
|
|
126
|
|
|
127 void pp_getc(struct val *v) {
|
|
|
128 int c;
|
|
|
129
|
|
|
130 if (!V_EXT_P(v)) {
|
|
|
131 V_xxx_OFF(v);
|
|
|
132 v->type = V_UNDEF;
|
|
|
133 #ifdef EBADF
|
|
|
134 errno = EBADF;
|
|
|
135 #endif
|
|
|
136 return;
|
|
|
137 }
|
|
|
138 c = io_getc(v->magic.ext);
|
|
|
139 #if EOF != -1
|
|
|
140 if (c == EOF) {
|
|
|
141 c = -1;
|
|
|
142 }
|
|
|
143 #endif
|
|
|
144 v_set_n(v, c);
|
|
|
145 }
|
|
|
146
|
|
|
147 void pp_getenv(struct val *v) {
|
|
|
148 const char *const tmp = getenv(v_sptr(v, NULL));
|
|
|
149 if (tmp) {
|
|
|
150 v_set_m(v, tmp, strlen(tmp));
|
|
|
151 } else {
|
|
|
152 V_xxx_OFF(v);
|
|
|
153 v->type = V_UNDEF;
|
|
|
154 }
|
|
|
155 }
|
|
|
156
|
|
|
157 void pp_gets(struct val *v) {
|
|
|
158
|
|
|
159 if (!V_EXT_P(v)) {
|
|
|
160 V_xxx_OFF(v);
|
|
|
161 v->type = V_UNDEF;
|
|
|
162 #ifdef EBADF
|
|
|
163 errno = EBADF;
|
|
|
164 #endif
|
|
|
165 return;
|
|
|
166 }
|
|
|
167
|
|
|
168 if (ko_getline(v->magic.ext, v->ko) + 1u) {
|
|
|
169 V_xxx_OFF(v);
|
|
|
170 v->type = V_STR_K;
|
|
|
171 } else {
|
|
|
172 V_xxx_OFF(v);
|
|
|
173 v->type = V_UNDEF;
|
|
|
174 }
|
|
|
175 }
|
|
|
176
|
|
|
177 void pp_int(struct val *v) {
|
|
|
178 V_NUM(v);
|
|
|
179 v_set_n(v, floor(v->num + .5));
|
|
|
180 }
|
|
|
181
|
|
|
182 void pp_io(struct val *v) {
|
|
|
183 if (V_EXT_P(v)) {
|
|
|
184 v_set_n(v, 1.0);
|
|
|
185 } else {
|
|
|
186 v_set_m(v, "", 0);
|
|
|
187 }
|
|
|
188 }
|
|
|
189
|
|
|
190 void pp_length(struct val *v) {
|
|
|
191 if (V_LIST_P(v)) {
|
|
|
192 v_set_n(v, li_length(v->magic.list));
|
|
|
193 return;
|
|
|
194 }
|
|
|
195 v_set_n(v, ko_length(v_kork(v)));
|
|
|
196 }
|
|
|
197
|
|
|
198 void pp_log(struct val *v) {
|
|
|
199 V_NUM(v);
|
|
|
200 v_set_n(v, log(v->num));
|
|
|
201 }
|
|
|
202
|
|
|
203 void pp_log10(struct val *v) {
|
|
|
204 V_NUM(v);
|
|
|
205 v_set_n(v, log10(v->num));
|
|
|
206 }
|
|
|
207
|
|
|
208 void pp_lower(struct val *v) {
|
|
|
209 V_STR(v);
|
|
|
210 V_xxx_OFF(v);
|
|
|
211 ko_lower(v->ko);
|
|
|
212 }
|
|
|
213
|
|
|
214 void pp_moend(struct val *v) {
|
|
|
215 size_t n;
|
|
|
216
|
|
|
217 V_NUM(v);
|
|
|
218 n = RINT(v->num);
|
|
|
219 if (n < Interp.m_end.size) {
|
|
|
220 v_set_n(v, Interp.m_end.index[n]);
|
|
|
221 } else {
|
|
|
222 v_set_undef(v);
|
|
|
223 }
|
|
|
224 }
|
|
|
225
|
|
|
226 void pp_mostart(struct val *v) {
|
|
|
227 size_t n;
|
|
|
228
|
|
|
229 V_NUM(v);
|
|
|
230 n = RINT(v->num);
|
|
|
231 if (n < Interp.m_start.size) {
|
|
|
232 v_set_n(v, Interp.m_start.index[n]);
|
|
|
233 } else {
|
|
|
234 v_set_undef(v);
|
|
|
235 }
|
|
|
236 }
|
|
|
237
|
|
|
238 void pp_neg(struct val *v) {
|
|
|
239 V_NUM(v);
|
|
|
240 V_xxx_OFF(v);
|
|
|
241 v->num = -v->num;
|
|
|
242 v->type = V_NUM_K;
|
|
|
243 }
|
|
|
244
|
|
|
245 void pp_not(struct val *v) {
|
|
|
246 if (v_true(v)) {
|
|
|
247 v_set_m(v, "", 0);
|
|
|
248 } else {
|
|
|
249 v_set_n(v, 1.0);
|
|
|
250 }
|
|
|
251 }
|
|
|
252
|
|
|
253 void pp_num(struct val *v) {
|
|
|
254 V_NUM(v);
|
|
|
255 V_xxx_OFF(v);
|
|
|
256 v->type = V_NUM_K;
|
|
|
257 }
|
|
|
258
|
|
|
259 void pp_open(struct val *v) {
|
|
|
260 IO *fh;
|
|
|
261 struct val *name, *mode;
|
|
|
262 enum io_flags flags;
|
|
|
263
|
|
|
264 if (!V_LIST_P(v) || li_length(v->magic.list) != 2) {
|
|
|
265 v_set_undef(v);
|
|
|
266 #ifdef ENOENT
|
|
|
267 errno = ENOENT;
|
|
|
268 #endif
|
|
|
269 return;
|
|
|
270 }
|
|
|
271
|
|
|
272 name = li_at(v->magic.list, 0);
|
|
|
273 V_STR(name);
|
|
|
274 if (ko_chr(name->ko, '\0') + 1u) {
|
|
|
275 v_set_undef(v);
|
|
|
276 #ifdef ENOENT
|
|
|
277 errno = ENOENT;
|
|
|
278 #endif
|
|
|
279 return;
|
|
|
280 }
|
|
|
281
|
|
|
282 mode = li_at(v->magic.list, 1);
|
|
|
283 flags = 0;
|
|
|
284 V_STR(mode);
|
|
|
285
|
|
|
286 if (ko_chr(mode->ko, 'A') + 1u) {
|
|
|
287 flags |= IO_APPEND;
|
|
|
288 if (ko_chr(mode->ko, '+') + 1u) {
|
|
|
289 flags |= IO_READ;
|
|
|
290 }
|
|
|
291 } else if (ko_chr(mode->ko, 'W') + 1u) {
|
|
|
292 flags |= IO_WRITE | IO_TRUNCATE;
|
|
|
293 if (ko_chr(mode->ko, '+') + 1u) {
|
|
|
294 flags |= IO_READ;
|
|
|
295 }
|
|
|
296 } else {
|
|
|
297 flags |= IO_READ;
|
|
|
298 if (ko_chr(mode->ko, '+') + 1u) {
|
|
|
299 flags |= IO_WRITE;
|
|
|
300 } else if (ko_chr(mode->ko, 'Z') + 1u) {
|
|
|
301 flags |= IO_BUFFERED;
|
|
|
302 }
|
|
|
303 }
|
|
|
304
|
|
|
305 if (ko_chr(mode->ko, 'B') + 1u) {
|
|
|
306 flags |= IO_BINARY;
|
|
|
307 }
|
|
|
308 if ((flags & IO_WRITE || flags & IO_APPEND) && ko_chr(mode->ko, 'F') + 1u) {
|
|
|
309 flags |= IO_AUTOFLUSH;
|
|
|
310 }
|
|
|
311
|
|
|
312 if (!(fh = io_open(ko_szp(name->ko), flags))) {
|
|
|
313 v_set_undef(v);
|
|
|
314 return;
|
|
|
315 }
|
|
|
316
|
|
|
317 v_set_io(v, fh);
|
|
|
318 }
|
|
|
319
|
|
|
320 void pp_openr(struct val *v) {
|
|
|
321 V_STR(v);
|
|
|
322 V_xxx_OFF(v);
|
|
|
323 if (ko_chr(v->ko, '\0') + 1u) {
|
|
|
324 v->type = V_UNDEF;
|
|
|
325 #ifdef ENOENT
|
|
|
326 errno = ENOENT;
|
|
|
327 #endif
|
|
|
328 } else if ((v->magic.ext = io_open(ko_szp(v->ko), IO_READ | IO_BINARY))) {
|
|
|
329 v->type = V_EXT_K;
|
|
|
330 } else {
|
|
|
331 v->type = V_UNDEF;
|
|
|
332 }
|
|
|
333 }
|
|
|
334
|
|
|
335 void pp_openw(struct val *v) {
|
|
|
336 V_STR(v);
|
|
|
337 V_xxx_OFF(v);
|
|
|
338 if (ko_chr(v->ko, '\0') + 1u) {
|
|
|
339 v->type = V_UNDEF;
|
|
|
340 #ifdef ENOENT
|
|
|
341 errno = ENOENT;
|
|
|
342 #endif
|
|
|
343 } else if ((v->magic.ext = io_open(ko_szp(v->ko), IO_WRITE | IO_TRUNCATE | IO_BINARY | IO_AUTOFLUSH))) {
|
|
|
344 v->type = V_EXT_K;
|
|
|
345 } else {
|
|
|
346 v->type = V_UNDEF;
|
|
|
347 }
|
|
|
348 }
|
|
|
349
|
|
|
350 void pp_ord(struct val *v) {
|
|
|
351 V_STR(v);
|
|
|
352 V_xxx_OFF(v);
|
|
|
353 if (ko_length(v->ko)) {
|
|
|
354 v->num = ko_at(v->ko, 0);
|
|
|
355 v->type = V_NUM_K;
|
|
|
356 } else {
|
|
|
357 v->type = V_UNDEF;
|
|
|
358 }
|
|
|
359 }
|
|
|
360
|
|
|
361 void pp_quote(struct val *v) {
|
|
|
362 String tmp;
|
|
|
363 size_t i;
|
|
|
364
|
|
|
365 V_STR(v);
|
|
|
366 V_xxx_OFF(v);
|
|
|
367 St_init(&tmp);
|
|
|
368 St_cpy_m(&tmp, ko_ptr(v->ko), ko_length(v->ko));
|
|
|
369 ko_zero(v->ko);
|
|
|
370 for (i = 0; i < St_len(&tmp); ++i) {
|
|
|
371 if (!(ST_INDEX(&tmp, i) == '_' || isalnum(ST_INDEX(&tmp, i)))) {
|
|
|
372 ko_cat_c(v->ko, '\\');
|
|
|
373 }
|
|
|
374 ko_cat_c(v->ko, ST_INDEX(&tmp, i));
|
|
|
375 }
|
|
|
376 St_clear(&tmp);
|
|
|
377 v->type = V_STR_K;
|
|
|
378 }
|
|
|
379
|
|
|
380 void pp_remove(struct val *v) {
|
|
|
381 V_STR(v);
|
|
|
382 V_xxx_OFF(v);
|
|
|
383 if (ko_chr(v->ko, '\0') + 1u) {
|
|
|
384 v->type = V_UNDEF;
|
|
|
385 #ifdef ENOENT
|
|
|
386 errno = ENOENT;
|
|
|
387 #endif
|
|
|
388 return;
|
|
|
389 }
|
|
|
390
|
|
|
391 if (remove(ko_szp(v->ko))) {
|
|
|
392 v_set_m(v, "", 0);
|
|
|
393 } else {
|
|
|
394 v_set_n(v, 1.0);
|
|
|
395 }
|
|
|
396 }
|
|
|
397
|
|
|
398 void pp_rename(struct val *v) {
|
|
|
399 struct val *from, *to;
|
|
|
400
|
|
|
401 if (!V_LIST_P(v) || li_length(v->magic.list) != 2) {
|
|
|
402 v_set_undef(v);
|
|
|
403 #ifdef ENOENT
|
|
|
404 errno = ENOENT;
|
|
|
405 #endif
|
|
|
406 return;
|
|
|
407 }
|
|
|
408
|
|
|
409 from = li_at(v->magic.list, 0);
|
|
|
410 V_STR(from);
|
|
|
411 if (ko_chr(from->ko, '\0') + 1u) {
|
|
|
412 v_set_undef(v);
|
|
|
413 #ifdef ENOENT
|
|
|
414 errno = ENOENT;
|
|
|
415 #endif
|
|
|
416 return;
|
|
|
417 }
|
|
|
418
|
|
|
419 to = li_at(v->magic.list, 1);
|
|
|
420 V_STR(to);
|
|
|
421 if (ko_chr(to->ko, '\0') + 1u) {
|
|
|
422 v_set_undef(v);
|
|
|
423 #ifdef EINVAL
|
|
|
424 errno = EINVAL;
|
|
|
425 #endif
|
|
|
426 return;
|
|
|
427 }
|
|
|
428
|
|
|
429 if (rename(ko_szp(from->ko), ko_szp(to->ko))) {
|
|
|
430 v_set_m(v, "", 0);
|
|
|
431 } else {
|
|
|
432 v_set_n(v, 1.0);
|
|
|
433 }
|
|
|
434 }
|
|
|
435
|
|
|
436 void pp_reverse(struct val *v) {
|
|
|
437 if (V_LIST_P(v)) {
|
|
|
438 li_reverse(v->magic.list);
|
|
|
439 v->type = V_LIST_K;
|
|
|
440 return;
|
|
|
441 }
|
|
|
442 V_STR(v);
|
|
|
443 V_xxx_OFF(v);
|
|
|
444 ko_reverse(v->ko);
|
|
|
445 v->type = V_STR_K;
|
|
|
446 }
|
|
|
447
|
|
|
448 void pp_seek(struct val *v) {
|
|
|
449 struct val *fh, *tmp;
|
|
|
450 long off;
|
|
|
451 enum io_whence whence = IOS_START;
|
|
|
452
|
|
|
453 if (!V_LIST_P(v) || li_length(v->magic.list) < 2 || li_length(v->magic.list) > 3) {
|
|
|
454 v_set_undef(v);
|
|
|
455 #ifdef EINVAL
|
|
|
456 errno = EINVAL;
|
|
|
457 #endif
|
|
|
458 return;
|
|
|
459 }
|
|
|
460
|
|
|
461 fh = li_at(v->magic.list, 0);
|
|
|
462 if (!V_EXT_P(fh)) {
|
|
|
463 v_set_undef(v);
|
|
|
464 #ifdef EBADF
|
|
|
465 errno = EBADF;
|
|
|
466 #endif
|
|
|
467 return;
|
|
|
468 }
|
|
|
469
|
|
|
470 tmp = li_at(v->magic.list, 1);
|
|
|
471 V_NUM(tmp);
|
|
|
472 off = RINT(tmp->num);
|
|
|
473
|
|
|
474 if ((tmp = li_at(v->magic.list, 2))) {
|
|
|
475 V_NUM(tmp);
|
|
|
476 switch ((long)RINT(tmp->num)) {
|
|
|
477 case 0: whence = IOS_START; break;
|
|
|
478 case 1: whence = IOS_CUR; break;
|
|
|
479 case 2: whence = IOS_END; break;
|
|
|
480 default:
|
|
|
481 v_set_undef(v);
|
|
|
482 #ifdef EINVAL
|
|
|
483 errno = EINVAL;
|
|
|
484 #endif
|
|
|
485 return;
|
|
|
486 }
|
|
|
487 }
|
|
|
488
|
|
|
489 v_set_n(v, io_seek(fh->magic.ext, off, whence));
|
|
|
490 }
|
|
|
491
|
|
|
492 void pp_sin(struct val *v) {
|
|
|
493 V_NUM(v);
|
|
|
494 v_set_n(v, sin(v->num));
|
|
|
495 }
|
|
|
496
|
|
|
497 void pp_sqrt(struct val *v) {
|
|
|
498 V_NUM(v);
|
|
|
499 V_xxx_OFF(v);
|
|
|
500 v->num = sqrt(v->num);
|
|
|
501 v->type = V_NUM_K;
|
|
|
502 }
|
|
|
503
|
|
|
504 void pp_str(struct val *v) {
|
|
|
505 V_STR(v);
|
|
|
506 V_xxx_OFF(v);
|
|
|
507 v->type |= V_STR_K;
|
|
|
508 }
|
|
|
509
|
|
|
510 void pp_tan(struct val *v) {
|
|
|
511 V_NUM(v);
|
|
|
512 v_set_n(v, tan(v->num));
|
|
|
513 }
|
|
|
514
|
|
|
515 void pp_tell(struct val *v) {
|
|
|
516 if (!V_EXT_P(v)) {
|
|
|
517 v_set_undef(v);
|
|
|
518 #ifdef EBADF
|
|
|
519 errno = EBADF;
|
|
|
520 #endif
|
|
|
521 return;
|
|
|
522 }
|
|
|
523 v_set_n(v, io_tell(v->magic.ext));
|
|
|
524 }
|
|
|
525
|
|
|
526 void pp_typeof(struct val *v) {
|
|
|
527 if (V_SUB_P(v)) {
|
|
|
528 v_set_m(v, "stuff", 5);
|
|
|
529 } else if (V_EXT_P(v)) {
|
|
|
530 v_set_m(v, "stream", 6);
|
|
|
531 } else if (V_LIST_P(v)) {
|
|
|
532 v_set_m(v, "list", 4);
|
|
|
533 } else if (V_NUM_P(v)) {
|
|
|
534 v_set_m(v, "number", 6);
|
|
|
535 } else if (V_STR_P(v)) {
|
|
|
536 v_set_m(v, "string", 6);
|
|
|
537 } else {
|
|
|
538 v_set_m(v, "nothing", 7);
|
|
|
539 }
|
|
|
540 }
|
|
|
541
|
|
|
542 void pp_upper(struct val *v) {
|
|
|
543 V_STR(v);
|
|
|
544 V_xxx_OFF(v);
|
|
|
545 ko_upper(v->ko);
|
|
|
546 }
|
|
|
547
|
|
|
548 #define NUMB(expr) \
|
|
|
549 do { \
|
|
|
550 V_NUM(b); \
|
|
|
551 V_NUM(v); \
|
|
|
552 v_set_n(v, expr); \
|
|
|
553 } while (0)
|
|
|
554
|
|
|
555 #define ARITH(op) NUMB(v->num op b->num)
|
|
|
556
|
|
|
557 void pp_add(struct val *v, struct val *b) {
|
|
|
558 ARITH(+);
|
|
|
559 }
|
|
|
560
|
|
|
561 #define LOGIC(init, cond) \
|
|
|
562 do { \
|
|
|
563 init; \
|
|
|
564 if (cond) { \
|
|
|
565 v_set_n(v, 1.0); \
|
|
|
566 } else { \
|
|
|
567 v_set_m(v, "", 0); \
|
|
|
568 } \
|
|
|
569 } while (0)
|
|
|
570
|
|
|
571 void pp_and(struct val *v, struct val *b) {
|
|
|
572 LOGIC((void)0, v_true(v) && v_true(b));
|
|
|
573 }
|
|
|
574
|
|
|
575 void pp_comma(struct val *v, struct val *b) {
|
|
|
576 v_set(v, b);
|
|
|
577 }
|
|
|
578
|
|
|
579 void pp_concat(struct val *v, struct val *b) {
|
|
|
580 v_cat(v, b);
|
|
|
581 }
|
|
|
582
|
|
|
583 void pp_div(struct val *v, struct val *b) {
|
|
|
584 ARITH(/);
|
|
|
585 }
|
|
|
586
|
|
|
587 #define CMP_LS(op) LOGIC((void)0, v_cmp_ls(v, b) op 0)
|
|
|
588
|
|
|
589 void pp_eq(struct val *v, struct val *b) {
|
|
|
590 CMP_LS(==);
|
|
|
591 }
|
|
|
592
|
|
|
593 #define CMP_N(op) LOGIC(V_NUM(v); V_NUM(b), v->num op b->num)
|
|
|
594
|
|
|
595 void pp_eq_n(struct val *v, struct val *b) {
|
|
|
596 if (V_EXT_P(v)) {
|
|
|
597 if (V_EXT_P(b)) {
|
|
|
598 LOGIC((void)0, v->magic.ext == b->magic.ext);
|
|
|
599 } else if (V_SUB_P(b)) {
|
|
|
600 goto false_cmp;
|
|
|
601 } else {
|
|
|
602 goto default_cmp;
|
|
|
603 }
|
|
|
604 } else if (V_SUB_P(v)) {
|
|
|
605 if (V_SUB_P(b)) {
|
|
|
606 LOGIC((void)0, v->magic.sub == b->magic.sub);
|
|
|
607 } else if (V_EXT_P(b)) false_cmp: {
|
|
|
608 LOGIC((void)0, 0);
|
|
|
609 } else {
|
|
|
610 goto default_cmp;
|
|
|
611 }
|
|
|
612 } else default_cmp: {
|
|
|
613 CMP_N(==);
|
|
|
614 }
|
|
|
615 }
|
|
|
616
|
|
|
617 static const char xdigits[] = "0123456789" "abcdefghijklmnopqrstuvwxyz";
|
|
|
618
|
|
|
619 void pp_frombase(struct val *v, struct val *b) {
|
|
|
620 double p;
|
|
|
621 size_t i;
|
|
|
622 int base, sign;
|
|
|
623 const char *tmp;
|
|
|
624
|
|
|
625 V_NUM(b);
|
|
|
626 V_STR(v);
|
|
|
627 V_xxx_OFF(v);
|
|
|
628 if (floor(b->num + .5) < 2. || floor(b->num + .5) > 36.) {
|
|
|
629 v->type = V_UNDEF;
|
|
|
630 return;
|
|
|
631 }
|
|
|
632 base = floor(b->num + .5);
|
|
|
633 ko_shiftws(v->ko);
|
|
|
634
|
|
|
635 sign = 0;
|
|
|
636 if (ko_at(v->ko, 0) == '-') {
|
|
|
637 sign = 1;
|
|
|
638 ko_shift(v->ko, 1);
|
|
|
639 } else if (ko_at(v->ko, 0) == '+') {
|
|
|
640 ko_shift(v->ko, 1);
|
|
|
641 }
|
|
|
642
|
|
|
643 p = 0.0;
|
|
|
644 for (i = 0; i < ko_length(v->ko); ++i) {
|
|
|
645 if ((tmp = strchr(xdigits, tolower(ko_at(v->ko, i)))) &&
|
|
|
646 tmp - xdigits < base) {
|
|
|
647 p *= base;
|
|
|
648 p += tmp - xdigits;
|
|
|
649 } else {
|
|
|
650 break;
|
|
|
651 }
|
|
|
652 }
|
|
|
653
|
|
|
654 if (i < ko_length(v->ko)) {
|
|
|
655 if (ko_at(v->ko, i) == '.') {
|
|
|
656 double shift = 1.0;
|
|
|
657
|
|
|
658 for (++i; i < ko_length(v->ko); ++i) {
|
|
|
659 if ((tmp = strchr(xdigits, tolower(ko_at(v->ko, i)))) &&
|
|
|
660 tmp - xdigits < base) {
|
|
|
661 shift *= base;
|
|
|
662 p *= base;
|
|
|
663 p += tmp - xdigits;
|
|
|
664 } else {
|
|
|
665 break;
|
|
|
666 }
|
|
|
667 }
|
|
|
668
|
|
|
669 p /= shift;
|
|
|
670 }
|
|
|
671 }
|
|
|
672
|
|
|
673 if (sign) {
|
|
|
674 p = -p;
|
|
|
675 }
|
|
|
676 v_set_n(v, p);
|
|
|
677 }
|
|
|
678
|
|
|
679 void pp_gt(struct val *v, struct val *b) {
|
|
|
680 CMP_LS(>);
|
|
|
681 }
|
|
|
682
|
|
|
683 void pp_gt_n(struct val *v, struct val *b) {
|
|
|
684 CMP_N(>);
|
|
|
685 }
|
|
|
686
|
|
|
687 void pp_lt(struct val *v, struct val *b) {
|
|
|
688 CMP_LS(<);
|
|
|
689 }
|
|
|
690
|
|
|
691 void pp_lt_n(struct val *v, struct val *b) {
|
|
|
692 CMP_N(<);
|
|
|
693 }
|
|
|
694
|
|
|
695 void pp_match(struct val *v, struct val *b) {
|
|
|
696 t_regex *re;
|
|
|
697
|
|
|
698 V_STR(b);
|
|
|
699 re = re_compile(ko_str(b->ko));
|
|
|
700 do_match(v, re);
|
|
|
701 re_free(re);
|
|
|
702 }
|
|
|
703
|
|
|
704 void pp_mod(struct val *v, struct val *b) {
|
|
|
705 NUMB(fmod(v->num, b->num));
|
|
|
706 }
|
|
|
707
|
|
|
708 void pp_mult(struct val *v, struct val *b) {
|
|
|
709 ARITH(*);
|
|
|
710 }
|
|
|
711
|
|
|
712 void pp_ne(struct val *v, struct val *b) {
|
|
|
713 CMP_LS(!=);
|
|
|
714 }
|
|
|
715
|
|
|
716 void pp_ne_n(struct val *v, struct val *b) {
|
|
|
717 if (V_EXT_P(v)) {
|
|
|
718 if (V_EXT_P(b)) {
|
|
|
719 LOGIC((void)0, v->magic.ext != b->magic.ext);
|
|
|
720 } else if (V_SUB_P(b)) {
|
|
|
721 goto true_cmp;
|
|
|
722 } else {
|
|
|
723 goto default_cmp;
|
|
|
724 }
|
|
|
725 } else if (V_SUB_P(v)) {
|
|
|
726 if (V_SUB_P(b)) {
|
|
|
727 LOGIC((void)0, v->magic.sub != b->magic.sub);
|
|
|
728 } else if (V_EXT_P(b)) true_cmp: {
|
|
|
729 LOGIC((void)0, 1);
|
|
|
730 } else {
|
|
|
731 goto default_cmp;
|
|
|
732 }
|
|
|
733 } else default_cmp: {
|
|
|
734 CMP_N(!=);
|
|
|
735 }
|
|
|
736 }
|
|
|
737
|
|
|
738 void pp_or(struct val *v, struct val *b) {
|
|
|
739 LOGIC((void)0, v_true(v) || v_true(b));
|
|
|
740 }
|
|
|
741
|
|
|
742 void pp_pop(struct val *v, struct val *b) {
|
|
|
743 long p;
|
|
|
744
|
|
|
745 V_NUM(b);
|
|
|
746 p = RINT(b->num);
|
|
|
747
|
|
|
748 if (V_LIST_P(v)) {
|
|
|
749 v->type = V_LIST_K;
|
|
|
750 if (p < 0) {
|
|
|
751 p += li_length(v->magic.list);
|
|
|
752 }
|
|
|
753 if (p < 0) {
|
|
|
754 p = 0;
|
|
|
755 }
|
|
|
756 if ((size_t)p >= li_length(v->magic.list)) {
|
|
|
757 return;
|
|
|
758 }
|
|
|
759 li_trunc(v->magic.list, p);
|
|
|
760 return;
|
|
|
761 }
|
|
|
762
|
|
|
763 V_STR(v);
|
|
|
764 V_xxx_OFF(v);
|
|
|
765 v->type = V_STR_K;
|
|
|
766 if (p < 0) {
|
|
|
767 p += ko_length(v->ko);
|
|
|
768 }
|
|
|
769 if (p < 0) {
|
|
|
770 p = 0;
|
|
|
771 }
|
|
|
772 if ((size_t)p >= ko_length(v->ko)) {
|
|
|
773 return;
|
|
|
774 }
|
|
|
775 ko_trunc(v->ko, p);
|
|
|
776 }
|
|
|
777
|
|
|
778 void pp_pow(struct val *v, struct val *b) {
|
|
|
779 NUMB(pow(v->num, b->num));
|
|
|
780 }
|
|
|
781
|
|
|
782 void pp_read(struct val *v, struct val *b) {
|
|
|
783 long n;
|
|
|
784
|
|
|
785 if (V_SUB_P(v)) {
|
|
|
786 const size_t curdepth = depth_get();
|
|
|
787 stack_store(&Interp.arg, b);
|
|
|
788 eval_into(sub_expr(v->magic.sub), v);
|
|
|
789 depth_restore(curdepth);
|
|
|
790 return;
|
|
|
791 }
|
|
|
792
|
|
|
793 if (V_EXT_P(v)) {
|
|
|
794 V_NUM(b);
|
|
|
795 ko_read(v->magic.ext, v->ko, b->num < 0.0 ? (size_t)-1 : b->num + .5);
|
|
|
796 V_xxx_OFF(v);
|
|
|
797 v->type = V_STR_K;
|
|
|
798 return;
|
|
|
799 }
|
|
|
800
|
|
|
801 if (V_LIST_P(v)) {
|
|
|
802 struct val *ptr;
|
|
|
803 V_NUM(b);
|
|
|
804 n = RINT(b->num);
|
|
|
805 if (n < 0) {
|
|
|
806 n += li_length(v->magic.list);
|
|
|
807 }
|
|
|
808
|
|
|
809 if (n >= 0 && (ptr = li_at(v->magic.list, n))) {
|
|
|
810 struct list *tmp = li_dup(v->magic.list);
|
|
|
811 v_set(v, ptr);
|
|
|
812 li_delete(tmp);
|
|
|
813 } else {
|
|
|
814 v_set_undef(v);
|
|
|
815 }
|
|
|
816 return;
|
|
|
817 }
|
|
|
818
|
|
|
819 V_STR(v);
|
|
|
820 V_xxx_OFF(v);
|
|
|
821 V_NUM(b);
|
|
|
822 n = RINT(b->num);
|
|
|
823 if (n < 0) {
|
|
|
824 n += ko_length(v->ko);
|
|
|
825 }
|
|
|
826 if (n >= 0 && (size_t)n < ko_length(v->ko)) {
|
|
|
827 ko_shift(v->ko, n);
|
|
|
828 ko_trunc(v->ko, 1);
|
|
|
829 v->type = V_STR_K;
|
|
|
830 } else {
|
|
|
831 v->type = V_UNDEF;
|
|
|
832 }
|
|
|
833 }
|
|
|
834
|
|
|
835 void pp_shift(struct val *v, struct val *b) {
|
|
|
836 long p;
|
|
|
837
|
|
|
838 V_NUM(b);
|
|
|
839 p = RINT(b->num);
|
|
|
840
|
|
|
841 if (V_LIST_P(v)) {
|
|
|
842 v->type = V_LIST_K;
|
|
|
843 if (p < 0) {
|
|
|
844 p += li_length(v->magic.list);
|
|
|
845 }
|
|
|
846 if (p <= 0) {
|
|
|
847 return;
|
|
|
848 }
|
|
|
849 if ((size_t)p >= li_length(v->magic.list)) {
|
|
|
850 li_zero(v->magic.list);
|
|
|
851 } else {
|
|
|
852 li_shift(v->magic.list, p);
|
|
|
853 }
|
|
|
854 return;
|
|
|
855 }
|
|
|
856
|
|
|
857 V_STR(v);
|
|
|
858 V_xxx_OFF(v);
|
|
|
859 v->type = V_STR_K;
|
|
|
860 if (p < 0) {
|
|
|
861 p += ko_length(v->ko);
|
|
|
862 }
|
|
|
863 if (p <= 0) {
|
|
|
864 return;
|
|
|
865 }
|
|
|
866 if ((size_t)p >= ko_length(v->ko)) {
|
|
|
867 ko_zero(v->ko);
|
|
|
868 } else {
|
|
|
869 ko_shift(v->ko, p);
|
|
|
870 }
|
|
|
871 }
|
|
|
872
|
|
|
873 void pp_sub(struct val *v, struct val *b) {
|
|
|
874 ARITH(-);
|
|
|
875 }
|
|
|
876
|
|
|
877 void pp_tobase(struct val *v, struct val *b) {
|
|
|
878 double p;
|
|
|
879 int base, sign;
|
|
|
880 size_t i;
|
|
|
881
|
|
|
882 V_NUM(b);
|
|
|
883 V_NUM(v);
|
|
|
884 V_xxx_OFF(v);
|
|
|
885
|
|
|
886 if (floor(b->num + .5) < 2. || floor(b->num + .5) > 36.) {
|
|
|
887 v->type = V_UNDEF;
|
|
|
888 return;
|
|
|
889 }
|
|
|
890 base = floor(b->num + .5);
|
|
|
891
|
|
|
892 sign = 0;
|
|
|
893 if (v->num < 0.) {
|
|
|
894 v->num = -v->num;
|
|
|
895 sign = 1;
|
|
|
896 }
|
|
|
897
|
|
|
898 p = v->num;
|
|
|
899 ko_zero(v->ko);
|
|
|
900
|
|
|
901 if (floor(p) < p) {
|
|
|
902 double foo, bar;
|
|
|
903 size_t rounds;
|
|
|
904
|
|
|
905 foo = 1 + floor(log(pow(10, DBL_DIG)) / log(base));
|
|
|
906 bar = p > 0. ? 1 + floor(log(p) / log(base)) : 0.;
|
|
|
907 if (bar >= foo) {
|
|
|
908 rounds = 0;
|
|
|
909 } else {
|
|
|
910 rounds = foo - bar;
|
|
|
911 }
|
|
|
912
|
|
|
913 for (i = 0; i < rounds; ++i) {
|
|
|
914 p *= base;
|
|
|
915 if (floor(p) >= p) {
|
|
|
916 ++i;
|
|
|
917 break;
|
|
|
918 }
|
|
|
919 }
|
|
|
920
|
|
|
921 p = floor(p);
|
|
|
922 while (i--) {
|
|
|
923 int c;
|
|
|
924 c = fmod(p, base);
|
|
|
925 p = floor(p / base);
|
|
|
926 if (c >= 0) {
|
|
|
927 ko_cat_c(v->ko, xdigits[c]);
|
|
|
928 }
|
|
|
929 }
|
|
|
930 }
|
|
|
931
|
|
|
932 while (ko_at(v->ko, 0) == '0') {
|
|
|
933 ko_shift(v->ko, 1);
|
|
|
934 }
|
|
|
935
|
|
|
936 if (ko_length(v->ko)) {
|
|
|
937 ko_cat_c(v->ko, '.');
|
|
|
938 }
|
|
|
939
|
|
|
940 while (p > 0.) {
|
|
|
941 int c;
|
|
|
942 c = fmod(p, base);
|
|
|
943 p = floor(p / base);
|
|
|
944 if (c >= 0) {
|
|
|
945 ko_cat_c(v->ko, xdigits[c]);
|
|
|
946 }
|
|
|
947 }
|
|
|
948
|
|
|
949 if (!ko_length(v->ko) || ko_lastchar(v->ko) == '.') {
|
|
|
950 ko_cat_c(v->ko, '0');
|
|
|
951 }
|
|
|
952 if (sign) {
|
|
|
953 ko_cat_c(v->ko, '-');
|
|
|
954 }
|
|
|
955
|
|
|
956 v->type = V_STR_K;
|
|
|
957 }
|
