1 /********************************************
2 bi_funct.c
3 copyright 2008-2014,2016, Thomas E. Dickey
4 copyright 1991-1995,1996, Michael D. Brennan
5
6 This is a source file for mawk, an implementation of
7 the AWK programming language.
8
9 Mawk is distributed without warranty under the terms of
10 the GNU General Public License, version 2, 1991.
11 ********************************************/
12
13 /*
14 * $MawkId: bi_funct.c,v 1.110 2016/11/07 21:43:45 tom Exp $
15 */
16
17 #include <mawk.h>
18 #include <bi_funct.h>
19 #include <bi_vars.h>
20 #include <memory.h>
21 #include <init.h>
22 #include <files.h>
23 #include <fin.h>
24 #include <field.h>
25 #include <regexp.h>
26 #include <repl.h>
27
28 #include <ctype.h>
29 #include <math.h>
30 #include <time.h>
31
32 #if defined(mawk_srand) || defined(mawk_rand)
33 #define USE_SYSTEM_SRAND
34 #endif
35
36 #if defined(HAVE_BSD_STDLIB_H) && defined(USE_SYSTEM_SRAND)
37 #include <bsd/stdlib.h> /* prototype arc4random */
38 #endif
39
40 #if defined(WINVER) && (WINVER >= 0x501)
41 #include <windows.h>
42 #endif
43
44 #if OPT_TRACE > 0
45 #define return_CELL(func, cell) TRACE(("..." func " ->")); \
46 TRACE_CELL(cell); \
47 return cell
48 #else
49 #define return_CELL(func, cell) return cell
50 #endif
51
52 /* global for the disassembler */
53 /* *INDENT-OFF* */
54 const BI_REC bi_funct[] =
55 { /* info to load builtins */
56
57 { "length", bi_length, 0, 1 }, /* special must come first */
58 { "index", bi_index, 2, 2 },
59 { "substr", bi_substr, 2, 3 },
60 { "sprintf", bi_sprintf, 1, 255 },
61 { "sin", bi_sin, 1, 1 },
62 { "cos", bi_cos, 1, 1 },
63 { "atan2", bi_atan2, 2, 2 },
64 { "exp", bi_exp, 1, 1 },
65 { "log", bi_log, 1, 1 },
66 { "int", bi_int, 1, 1 },
67 { "sqrt", bi_sqrt, 1, 1 },
68 { "rand", bi_rand, 0, 0 },
69 { "srand", bi_srand, 0, 1 },
70 { "close", bi_close, 1, 1 },
71 { "system", bi_system, 1, 1 },
72 { "toupper", bi_toupper, 1, 1 },
73 { "tolower", bi_tolower, 1, 1 },
74 { "fflush", bi_fflush, 0, 1 },
75
76 /* useful gawk extension (time functions) */
77 { "systime", bi_systime, 0, 0 },
78 #ifdef HAVE_MKTIME
79 { "mktime", bi_mktime, 1, 1 },
80 #endif
81 #ifdef HAVE_STRFTIME
82 { "strftime", bi_strftime, 0, 3 },
83 #endif
84
85 { (char *) 0, (PF_CP) 0, 0, 0 }
86 };
87 /* *INDENT-ON* */
88
89 /* load built-in functions in symbol table */
90 void
bi_funct_init(void)91 bi_funct_init(void)
92 {
93 register const BI_REC *p;
94 register SYMTAB *stp;
95
96 /* length is special (posix bozo) */
97 stp = insert(bi_funct->name);
98 stp->type = ST_LENGTH;
99 stp->stval.bip = bi_funct;
100
101 for (p = bi_funct + 1; p->name; p++) {
102 stp = insert(p->name);
103 stp->type = ST_BUILTIN;
104 stp->stval.bip = p;
105 }
106
107 #ifndef NO_INIT_SRAND
108 /* seed rand() off the clock */
109 {
110 CELL c[2];
111
112 memset(c, 0, sizeof(c));
113 c[1].type = C_NOINIT;
114 bi_srand(c + 1);
115 }
116 #endif
117
118 }
119
120 /**************************************************
121 string builtins (except split (in split.c) and [g]sub (at end))
122 **************************************************/
123
124 CELL *
bi_length(CELL * sp)125 bi_length(CELL *sp)
126 {
127 size_t len;
128
129 TRACE_FUNC("bi_length", sp);
130
131 if (sp->type == 0)
132 cellcpy(sp, field);
133 else
134 sp--;
135
136 if (sp->type < C_STRING)
137 cast1_to_s(sp);
138 len = string(sp)->len;
139
140 free_STRING(string(sp));
141 sp->type = C_DOUBLE;
142 sp->dval = (double) len;
143
144 return_CELL("bi_length", sp);
145 }
146
147 char *
str_str(char * target,size_t target_len,const char * key,size_t key_len)148 str_str(char *target, size_t target_len, const char *key, size_t key_len)
149 {
150 register int k = key[0];
151 int k1;
152 const char *prior;
153 char *result = 0;
154
155 switch (key_len) {
156 case 0:
157 break;
158 case 1:
159 if (target_len != 0) {
160 result = memchr(target, k, target_len);
161 }
162 break;
163 case 2:
164 k1 = key[1];
165 prior = target;
166 while (target_len >= key_len && (target = memchr(target, k, target_len))) {
167 target_len = target_len - (size_t) (target - prior) - 1;
168 prior = ++target;
169 if (target[0] == k1) {
170 result = target - 1;
171 break;
172 }
173 }
174 break;
175 default:
176 key_len--;
177 prior = target;
178 while (target_len > key_len && (target = memchr(target, k, target_len))) {
179 target_len = target_len - (size_t) (target - prior) - 1;
180 prior = ++target;
181 if (memcmp(target, key + 1, key_len) == 0) {
182 result = target - 1;
183 break;
184 }
185 }
186 break;
187 }
188 return result;
189 }
190
191 CELL *
bi_index(CELL * sp)192 bi_index(CELL *sp)
193 {
194 size_t idx;
195 size_t len;
196 const char *p;
197
198 TRACE_FUNC("bi_index", sp);
199
200 sp--;
201 if (TEST2(sp) != TWO_STRINGS)
202 cast2_to_s(sp);
203
204 if ((len = string(sp + 1)->len)) {
205 idx = (size_t) ((p = str_str(string(sp)->str,
206 string(sp)->len,
207 string(sp + 1)->str,
208 len))
209 ? p - string(sp)->str + 1
210 : 0);
211 } else { /* index of the empty string */
212 idx = 1;
213 }
214
215 free_STRING(string(sp));
216 free_STRING(string(sp + 1));
217 sp->type = C_DOUBLE;
218 sp->dval = (double) idx;
219 return_CELL("bi_index", sp);
220 }
221
222 /* substr(s, i, n)
223 if l = length(s) then get the characters
224 from max(1,i) to min(l,n-i-1) inclusive */
225
226 CELL *
bi_substr(CELL * sp)227 bi_substr(CELL *sp)
228 {
229 int n_args, len;
230 register int i, n;
231 STRING *sval; /* substr(sval->str, i, n) */
232
233 TRACE_FUNC("bi_substr", sp);
234
235 n_args = sp->type;
236 sp -= n_args;
237 if (sp->type != C_STRING)
238 cast1_to_s(sp);
239 /* don't use < C_STRING shortcut */
240 sval = string(sp);
241
242 if ((len = (int) sval->len) == 0) /* substr on null string */
243 {
244 if (n_args == 3) {
245 cell_destroy(sp + 2);
246 }
247 cell_destroy(sp + 1);
248 return_CELL("bi_substr", sp);
249 }
250
251 if (n_args == 2) {
252 n = len;
253 if (sp[1].type != C_DOUBLE) {
254 cast1_to_d(sp + 1);
255 }
256 } else {
257 if (TEST2(sp + 1) != TWO_DOUBLES)
258 cast2_to_d(sp + 1);
259 n = d_to_i(sp[2].dval);
260 }
261 i = d_to_i(sp[1].dval) - 1; /* i now indexes into string */
262
263 /*
264 * If the starting index is past the end of the string, there is nothing
265 * to extract other than an empty string.
266 */
267 if (i > len) {
268 n = 0;
269 }
270
271 /*
272 * Workaround in case someone's written a script that does substr(0,last-1)
273 * by transforming it into substr(1,last).
274 */
275 if (i < 0) {
276 n -= i + 1;
277 i = 0;
278 }
279
280 /*
281 * Keep 'n' from extending past the end of the string.
282 */
283 if (n > len - i) {
284 n = len - i;
285 }
286
287 if (n <= 0) /* the null string */
288 {
289 sp->ptr = (PTR) & null_str;
290 null_str.ref_cnt++;
291 } else { /* got something */
292 sp->ptr = (PTR) new_STRING0((size_t) n);
293 memcpy(string(sp)->str, sval->str + i, (size_t) n);
294 }
295
296 free_STRING(sval);
297 return_CELL("bi_substr", sp);
298 }
299
300 /*
301 match(s,r)
302 sp[0] holds r, sp[-1] holds s
303 */
304
305 CELL *
bi_match(CELL * sp)306 bi_match(CELL *sp)
307 {
308 char *p;
309 size_t length;
310
311 TRACE_FUNC("bi_match", sp);
312
313 if (sp->type != C_RE)
314 cast_to_RE(sp);
315 if ((--sp)->type < C_STRING)
316 cast1_to_s(sp);
317
318 cell_destroy(RSTART);
319 cell_destroy(RLENGTH);
320 RSTART->type = C_DOUBLE;
321 RLENGTH->type = C_DOUBLE;
322
323 p = REmatch(string(sp)->str,
324 string(sp)->len,
325 cast_to_re((sp + 1)->ptr),
326 &length,
327 0);
328
329 if (p) {
330 sp->dval = (double) (p - string(sp)->str + 1);
331 RLENGTH->dval = (double) length;
332 } else {
333 sp->dval = 0.0;
334 RLENGTH->dval = -1.0; /* posix */
335 }
336
337 free_STRING(string(sp));
338 sp->type = C_DOUBLE;
339
340 RSTART->dval = sp->dval;
341
342 return_CELL("bi_match", sp);
343 }
344
345 CELL *
bi_toupper(CELL * sp)346 bi_toupper(CELL *sp)
347 {
348 STRING *old;
349 register char *p, *q;
350
351 TRACE_FUNC("bi_toupper", sp);
352
353 if (sp->type != C_STRING)
354 cast1_to_s(sp);
355 old = string(sp);
356 sp->ptr = (PTR) new_STRING0(old->len);
357
358 q = string(sp)->str;
359 p = old->str;
360 while (*p) {
361 *q = *p++;
362 *q = (char) toupper((UChar) * q);
363 q++;
364 }
365 free_STRING(old);
366 return_CELL("bi_toupper", sp);
367 }
368
369 CELL *
bi_tolower(CELL * sp)370 bi_tolower(CELL *sp)
371 {
372 STRING *old;
373 register char *p, *q;
374
375 TRACE_FUNC("bi_tolower", sp);
376
377 if (sp->type != C_STRING)
378 cast1_to_s(sp);
379 old = string(sp);
380 sp->ptr = (PTR) new_STRING0(old->len);
381
382 q = string(sp)->str;
383 p = old->str;
384 while (*p) {
385 *q = *p++;
386 *q = (char) tolower((UChar) * q);
387 q++;
388 }
389 free_STRING(old);
390 return_CELL("bi_tolower", sp);
391 }
392
393 /*
394 * Like gawk...
395 */
396 CELL *
bi_systime(CELL * sp)397 bi_systime(CELL *sp)
398 {
399 time_t result;
400 time(&result);
401
402 TRACE_FUNC("bi_systime", sp);
403
404 sp++;
405 sp->type = C_DOUBLE;
406 sp->dval = (double) result;
407 return_CELL("bi_systime", sp);
408 }
409
410 #ifdef HAVE_MKTIME
411 /* mktime(datespec)
412 Turns datespec into a time stamp of the same form as returned by systime().
413 The datespec is a string of the form
414 YYYY MM DD HH MM SS [DST].
415 */
416 CELL *
bi_mktime(CELL * sp)417 bi_mktime(CELL *sp)
418 {
419 time_t result;
420 struct tm my_tm;
421 STRING *sval = string(sp);
422
423 TRACE_FUNC("bi_mktime", sp);
424
425 if (!sval)
426 goto error;
427
428 memset(&my_tm, 0, sizeof(my_tm));
429 switch (sscanf(sval->str, "%d %d %d %d %d %d %d",
430 &my_tm.tm_year,
431 &my_tm.tm_mon,
432 &my_tm.tm_mday,
433 &my_tm.tm_hour,
434 &my_tm.tm_min,
435 &my_tm.tm_sec,
436 &my_tm.tm_isdst)) {
437 case 7:
438 break;
439 case 6:
440 my_tm.tm_isdst = -1; /* ask mktime to get timezone */
441 break;
442 default:
443 goto error; /* not enough data */
444 }
445
446 if (0) {
447 error:
448 result = -1;
449 } else {
450 my_tm.tm_year -= 1900;
451 my_tm.tm_mon -= 1;
452 result = mktime(&my_tm);
453 }
454 TRACE(("...bi_mktime(%s) ->%s", sval->str, ctime(&result)));
455
456 cell_destroy(sp);
457 sp->type = C_DOUBLE;
458 sp->dval = (double) result;
459 return_CELL("bi_mktime", sp);
460 }
461 #endif
462
463 /* strftime(format, timestamp, utc)
464 should be equal to gawk strftime. all parameters are optional:
465 format: ansi c strftime format descriptor. default is "%c"
466 timestamp: seconds since unix epoch. default is now
467 utc: when set and != 0 date is utc otherwise local. default is 0
468 */
469 #ifdef HAVE_STRFTIME
470 CELL *
bi_strftime(CELL * sp)471 bi_strftime(CELL *sp)
472 {
473 const char *format = "%c";
474 time_t rawtime;
475 struct tm *ptm;
476 int n_args;
477 int utc;
478 STRING *sval = 0; /* strftime(sval->str, timestamp, utc) */
479 char buff[128];
480 size_t result;
481
482 TRACE_FUNC("bi_strftime", sp);
483
484 n_args = sp->type;
485 sp -= n_args;
486
487 if (n_args > 0) {
488 if (sp->type != C_STRING)
489 cast1_to_s(sp);
490 /* don't use < C_STRING shortcut */
491 sval = string(sp);
492
493 if ((int) sval->len != 0) /* strftime on valid format */
494 format = sval->str;
495 } else {
496 sp->type = C_STRING;
497 }
498
499 if (n_args > 1) {
500 if (sp[1].type != C_DOUBLE)
501 cast1_to_d(sp + 1);
502 rawtime = d_to_i(sp[1].dval);
503 } else {
504 time(&rawtime);
505 }
506
507 if (n_args > 2) {
508 if (sp[2].type != C_DOUBLE)
509 cast1_to_d(sp + 2);
510 utc = d_to_i(sp[2].dval);
511 } else {
512 utc = 0;
513 }
514
515 if (utc != 0)
516 ptm = gmtime(&rawtime);
517 else
518 ptm = localtime(&rawtime);
519
520 result = strftime(buff, sizeof(buff) / sizeof(buff[0]), format, ptm);
521 TRACE(("...bi_strftime (%s, \"%d.%d.%d %d.%d.%d %d\", %d) ->%s\n",
522 format,
523 ptm->tm_year,
524 ptm->tm_mon,
525 ptm->tm_mday,
526 ptm->tm_hour,
527 ptm->tm_min,
528 ptm->tm_sec,
529 ptm->tm_isdst,
530 utc,
531 buff));
532
533 if (sval)
534 free_STRING(sval);
535
536 sp->ptr = (PTR) new_STRING1(buff, result);
537
538 while (n_args > 1) {
539 n_args--;
540 cell_destroy(sp + n_args);
541 }
542 return_CELL("bi_strftime", sp);
543 }
544 #endif /* HAVE_STRFTIME */
545
546 /************************************************
547 arithmetic builtins
548 ************************************************/
549
550 #if STDC_MATHERR
551 static void
fplib_err(char * fname,double val,char * error)552 fplib_err(
553 char *fname,
554 double val,
555 char *error)
556 {
557 rt_error("%s(%g) : %s", fname, val, error);
558 }
559 #endif
560
561 CELL *
bi_sin(CELL * sp)562 bi_sin(CELL *sp)
563 {
564 TRACE_FUNC("bi_sin", sp);
565
566 #if ! STDC_MATHERR
567 if (sp->type != C_DOUBLE)
568 cast1_to_d(sp);
569 sp->dval = sin(sp->dval);
570 #else
571 {
572 double x;
573
574 errno = 0;
575 if (sp->type != C_DOUBLE)
576 cast1_to_d(sp);
577 x = sp->dval;
578 sp->dval = sin(sp->dval);
579 if (errno)
580 fplib_err("sin", x, "loss of precision");
581 }
582 #endif
583 return_CELL("bi_sin", sp);
584 }
585
586 CELL *
bi_cos(CELL * sp)587 bi_cos(CELL *sp)
588 {
589 TRACE_FUNC("bi_cos", sp);
590
591 #if ! STDC_MATHERR
592 if (sp->type != C_DOUBLE)
593 cast1_to_d(sp);
594 sp->dval = cos(sp->dval);
595 #else
596 {
597 double x;
598
599 errno = 0;
600 if (sp->type != C_DOUBLE)
601 cast1_to_d(sp);
602 x = sp->dval;
603 sp->dval = cos(sp->dval);
604 if (errno)
605 fplib_err("cos", x, "loss of precision");
606 }
607 #endif
608 return_CELL("bi_cos", sp);
609 }
610
611 CELL *
bi_atan2(CELL * sp)612 bi_atan2(CELL *sp)
613 {
614 TRACE_FUNC("bi_atan2", sp);
615
616 #if ! STDC_MATHERR
617 sp--;
618 if (TEST2(sp) != TWO_DOUBLES)
619 cast2_to_d(sp);
620 sp->dval = atan2(sp->dval, (sp + 1)->dval);
621 #else
622 {
623 errno = 0;
624 sp--;
625 if (TEST2(sp) != TWO_DOUBLES)
626 cast2_to_d(sp);
627 sp->dval = atan2(sp->dval, (sp + 1)->dval);
628 if (errno)
629 rt_error("atan2(0,0) : domain error");
630 }
631 #endif
632 return_CELL("bi_atan2", sp);
633 }
634
635 CELL *
bi_log(CELL * sp)636 bi_log(CELL *sp)
637 {
638 TRACE_FUNC("bi_log", sp);
639
640 #if ! STDC_MATHERR
641 if (sp->type != C_DOUBLE)
642 cast1_to_d(sp);
643 sp->dval = log(sp->dval);
644 #else
645 {
646 double x;
647
648 errno = 0;
649 if (sp->type != C_DOUBLE)
650 cast1_to_d(sp);
651 x = sp->dval;
652 sp->dval = log(sp->dval);
653 if (errno)
654 fplib_err("log", x, "domain error");
655 }
656 #endif
657 return_CELL("bi_log", sp);
658 }
659
660 CELL *
bi_exp(CELL * sp)661 bi_exp(CELL *sp)
662 {
663 TRACE_FUNC("bi_exp", sp);
664
665 #if ! STDC_MATHERR
666 if (sp->type != C_DOUBLE)
667 cast1_to_d(sp);
668 sp->dval = exp(sp->dval);
669 #else
670 {
671 double x;
672
673 errno = 0;
674 if (sp->type != C_DOUBLE)
675 cast1_to_d(sp);
676 x = sp->dval;
677 sp->dval = exp(sp->dval);
678 if (errno && sp->dval)
679 fplib_err("exp", x, "overflow");
680 /* on underflow sp->dval==0, ignore */
681 }
682 #endif
683 return_CELL("bi_exp", sp);
684 }
685
686 CELL *
bi_int(CELL * sp)687 bi_int(CELL *sp)
688 {
689 TRACE_FUNC("bi_int", sp);
690
691 if (sp->type != C_DOUBLE)
692 cast1_to_d(sp);
693 sp->dval = sp->dval >= 0.0 ? floor(sp->dval) : ceil(sp->dval);
694 return_CELL("bi_int", sp);
695 }
696
697 CELL *
bi_sqrt(CELL * sp)698 bi_sqrt(CELL *sp)
699 {
700 TRACE_FUNC("bi_sqrt", sp);
701
702 #if ! STDC_MATHERR
703 if (sp->type != C_DOUBLE)
704 cast1_to_d(sp);
705 sp->dval = sqrt(sp->dval);
706 #else
707 {
708 double x;
709
710 errno = 0;
711 if (sp->type != C_DOUBLE)
712 cast1_to_d(sp);
713 x = sp->dval;
714 sp->dval = sqrt(sp->dval);
715 if (errno)
716 fplib_err("sqrt", x, "domain error");
717 }
718 #endif
719 return_CELL("bi_sqrt", sp);
720 }
721
722 #if !(defined(mawk_srand) || defined(mawk_rand))
723 /* For portability, we'll use our own random number generator , taken
724 from: Park, SK and Miller KW, "Random Number Generators:
725 Good Ones are Hard to Find", CACM, 31, 1192-1201, 1988.
726 */
727
728 static long seed; /* must be >=1 and < 2^31-1 */
729 static CELL cseed; /* argument of last call to srand() */
730
731 #define M 0x7fffffff /* 2^31-1 */
732 #define MX 0xffffffff
733 #define A 16807
734 #define Q 127773 /* M/A */
735 #define R 2836 /* M%A */
736
737 #if M == MAX__LONG
738 #define crank(s) s = A * (s % Q) - R * (s / Q) ;\
739 if ( s <= 0 ) s += M
740 #else
741 /* 64 bit longs */
742 #define crank(s) { unsigned long t = (unsigned long) s ;\
743 t = (A * (t % Q) - R * (t / Q)) & MX ;\
744 if ( t >= M ) t = (t+M)&M ;\
745 s = (long) t ;\
746 }
747 #endif /* M == MAX__LONG */
748 #endif /* defined(mawk_srand) || defined(mawk_rand) */
749
750 static double
initial_seed(void)751 initial_seed(void)
752 {
753 double result;
754 #if defined(HAVE_GETTIMEOFDAY)
755 struct timeval data;
756 gettimeofday(&data, (struct timezone *) 0);
757 result = (data.tv_sec * 1000000) + data.tv_usec;
758 #elif defined(WINVER) && (WINVER >= 0x501)
759 union {
760 FILETIME ft;
761 long long since1601; /* time since 1 Jan 1601 in 100ns units */
762 } data;
763
764 GetSystemTimeAsFileTime(&data.ft);
765 result = (double) (data.since1601 / 10LL);
766 #else
767 time_t now;
768 (void) time(&now);
769 result = (double) now;
770 #endif
771 return result;
772 }
773
774 CELL *
bi_srand(CELL * sp)775 bi_srand(CELL *sp)
776 {
777 #ifdef USE_SYSTEM_SRAND
778 static long seed = 1;
779 static CELL cseed =
780 {
781 C_DOUBLE, 0, 0, 1.0
782 };
783 #endif
784
785 CELL c;
786
787 TRACE_FUNC("bi_srand", sp);
788
789 if (sp->type == C_NOINIT) /* seed off clock */
790 {
791 cellcpy(sp, &cseed);
792 cell_destroy(&cseed);
793 cseed.type = C_DOUBLE;
794 cseed.dval = initial_seed();
795 } else { /* user seed */
796 sp--;
797 /* swap cseed and *sp ; don't need to adjust ref_cnts */
798 c = *sp;
799 *sp = cseed;
800 cseed = c;
801 }
802
803 #ifdef USE_SYSTEM_SRAND
804 seed = d_to_i(cseed.dval);
805 mawk_srand((unsigned) seed);
806 #else
807 /* The old seed is now in *sp ; move the value in cseed to
808 seed in range [1,M) */
809
810 cellcpy(&c, &cseed);
811 if (c.type == C_NOINIT)
812 cast1_to_d(&c);
813
814 seed = ((c.type == C_DOUBLE)
815 ? (long) (d_to_i(c.dval) & M) % M + 1
816 : (long) hash(string(&c)->str) % M + 1);
817 if (seed == M)
818 seed = M - 1;
819
820 cell_destroy(&c);
821
822 /* crank it once so close seeds don't give a close
823 first result */
824 crank(seed);
825 #endif
826
827 return_CELL("bi_srand", sp);
828 }
829
830 CELL *
bi_rand(CELL * sp)831 bi_rand(CELL *sp)
832 {
833 TRACE_FUNC("bi_rand", sp);
834
835 #ifdef USE_SYSTEM_SRAND
836 {
837 long value = (long) mawk_rand();
838 sp++;
839 sp->type = C_DOUBLE;
840 sp->dval = ((double) value) / ((unsigned long) MAWK_RAND_MAX);
841 }
842 #else
843 crank(seed);
844 sp++;
845 sp->type = C_DOUBLE;
846 sp->dval = (double) seed / (double) M;
847 #endif
848
849 return_CELL("bi_rand", sp);
850 }
851
852 #undef A
853 #undef M
854 #undef MX
855 #undef Q
856 #undef R
857 #undef crank
858
859 /*************************************************
860 miscellaneous builtins
861 close, system and getline
862 fflush
863 *************************************************/
864
865 CELL *
bi_close(CELL * sp)866 bi_close(CELL *sp)
867 {
868 int x;
869
870 TRACE_FUNC("bi_close", sp);
871
872 if (sp->type < C_STRING)
873 cast1_to_s(sp);
874 x = file_close((STRING *) sp->ptr);
875 free_STRING(string(sp));
876 sp->type = C_DOUBLE;
877 sp->dval = (double) x;
878
879 return_CELL("bi_close", sp);
880 }
881
882 CELL *
bi_fflush(CELL * sp)883 bi_fflush(CELL *sp)
884 {
885 int ret = 0;
886
887 TRACE_FUNC("bi_fflush", sp);
888
889 if (sp->type == 0)
890 fflush(stdout);
891 else {
892 sp--;
893 if (sp->type < C_STRING)
894 cast1_to_s(sp);
895 ret = file_flush(string(sp));
896 free_STRING(string(sp));
897 }
898
899 sp->type = C_DOUBLE;
900 sp->dval = (double) ret;
901
902 return_CELL("bi_fflush", sp);
903 }
904
905 CELL *
bi_system(CELL * sp GCC_UNUSED)906 bi_system(CELL *sp GCC_UNUSED)
907 {
908 #ifdef HAVE_REAL_PIPES
909 int ret_val;
910
911 TRACE_FUNC("bi_system", sp);
912
913 if (sp->type < C_STRING)
914 cast1_to_s(sp);
915
916 flush_all_output();
917 ret_val = wait_status(system(string(sp)->str));
918
919 cell_destroy(sp);
920 sp->type = C_DOUBLE;
921 sp->dval = (double) ret_val;
922 #elif defined(MSDOS)
923 int retval;
924
925 if (sp->type < C_STRING)
926 cast1_to_s(sp);
927 retval = DOSexec(string(sp)->str);
928 free_STRING(string(sp));
929 sp->type = C_DOUBLE;
930 sp->dval = (double) retval;
931 #else
932 sp = 0;
933 #endif
934 return_CELL("bi_system", sp);
935 }
936
937 /* getline() */
938
939 /* if type == 0 : stack is 0 , target address
940
941 if type == F_IN : stack is F_IN, expr(filename), target address
942 if type == PIPE_IN : stack is PIPE_IN, target address, expr(pipename)
943 */
944
945 CELL *
bi_getline(CELL * sp)946 bi_getline(CELL *sp)
947 {
948 CELL tc;
949 CELL *cp = 0;
950 char *p = 0;
951 size_t len;
952 FIN *fin_p;
953
954 TRACE_FUNC("bi_getline", sp);
955
956 switch (sp->type) {
957 case 0:
958 sp--;
959 if (!main_fin)
960 open_main();
961
962 if (!(p = FINgets(main_fin, &len)))
963 goto eof;
964
965 cp = (CELL *) sp->ptr;
966 if (TEST2(NR) != TWO_DOUBLES)
967 cast2_to_d(NR);
968 NR->dval += 1.0;
969 rt_nr++;
970 FNR->dval += 1.0;
971 rt_fnr++;
972 break;
973
974 case F_IN:
975 sp--;
976 if (sp->type < C_STRING)
977 cast1_to_s(sp);
978 fin_p = (FIN *) file_find(sp->ptr, F_IN);
979 free_STRING(string(sp));
980 sp--;
981
982 if (!fin_p)
983 goto open_failure;
984 if (!(p = FINgets(fin_p, &len))) {
985 FINsemi_close(fin_p);
986 goto eof;
987 }
988 cp = (CELL *) sp->ptr;
989 break;
990
991 case PIPE_IN:
992 sp -= 2;
993 if (sp->type < C_STRING)
994 cast1_to_s(sp);
995 fin_p = (FIN *) file_find(sp->ptr, PIPE_IN);
996 free_STRING(string(sp));
997
998 if (!fin_p)
999 goto open_failure;
1000 if (!(p = FINgets(fin_p, &len))) {
1001 FINsemi_close(fin_p);
1002 #ifdef HAVE_REAL_PIPES
1003 /* reclaim process slot */
1004 wait_for(0);
1005 #endif
1006 goto eof;
1007 }
1008 cp = (CELL *) (sp + 1)->ptr;
1009 break;
1010
1011 default:
1012 bozo("type in bi_getline");
1013
1014 }
1015
1016 /* we've read a line , store it */
1017
1018 if (len == 0) {
1019 tc.type = C_STRING;
1020 tc.ptr = (PTR) & null_str;
1021 null_str.ref_cnt++;
1022 } else {
1023 tc.type = C_MBSTRN;
1024 tc.ptr = (PTR) new_STRING0(len);
1025 memcpy(string(&tc)->str, p, len);
1026 }
1027
1028 slow_cell_assign(cp, &tc);
1029
1030 cell_destroy(&tc);
1031
1032 sp->dval = 1.0;
1033 goto done;
1034 open_failure:
1035 sp->dval = -1.0;
1036 goto done;
1037 eof:
1038 sp->dval = 0.0; /* fall thru to done */
1039
1040 done:
1041 sp->type = C_DOUBLE;
1042
1043 return_CELL("bi_getline", sp);
1044 }
1045
1046 /**********************************************
1047 sub() and gsub()
1048 **********************************************/
1049
1050 /* entry: sp[0] = address of CELL to sub on
1051 sp[-1] = substitution CELL
1052 sp[-2] = regular expression to match
1053 */
1054
1055 CELL *
bi_sub(CELL * sp)1056 bi_sub(CELL *sp)
1057 {
1058 CELL *cp; /* pointer to the replacement target */
1059 CELL tc; /* build the new string here */
1060 CELL sc; /* copy of the target CELL */
1061 char *front, *middle, *back; /* pieces */
1062 size_t front_len, middle_len, back_len;
1063
1064 TRACE_FUNC("bi_sub", sp);
1065
1066 sp -= 2;
1067 if (sp->type != C_RE)
1068 cast_to_RE(sp);
1069 if (sp[1].type != C_REPL && sp[1].type != C_REPLV)
1070 cast_to_REPL(sp + 1);
1071 cp = (CELL *) (sp + 2)->ptr;
1072 /* make a copy of the target, because we won't change anything
1073 including type unless the match works */
1074 cellcpy(&sc, cp);
1075 if (sc.type < C_STRING)
1076 cast1_to_s(&sc);
1077 front = string(&sc)->str;
1078
1079 middle = REmatch(front,
1080 string(&sc)->len,
1081 cast_to_re(sp->ptr),
1082 &middle_len,
1083 0);
1084
1085 if (middle != 0) {
1086 front_len = (size_t) (middle - front);
1087 back = middle + middle_len;
1088 back_len = string(&sc)->len - front_len - middle_len;
1089
1090 if ((sp + 1)->type == C_REPLV) {
1091 STRING *sval = new_STRING0(middle_len);
1092
1093 memcpy(sval->str, middle, middle_len);
1094 replv_to_repl(sp + 1, sval);
1095 free_STRING(sval);
1096 }
1097
1098 tc.type = C_STRING;
1099 tc.ptr = (PTR) new_STRING0(front_len + string(sp + 1)->len + back_len);
1100
1101 {
1102 char *p = string(&tc)->str;
1103
1104 if (front_len) {
1105 memcpy(p, front, front_len);
1106 p += front_len;
1107 }
1108 if (string(sp + 1)->len) {
1109 memcpy(p, string(sp + 1)->str, string(sp + 1)->len);
1110 p += string(sp + 1)->len;
1111 }
1112 if (back_len)
1113 memcpy(p, back, back_len);
1114 }
1115
1116 slow_cell_assign(cp, &tc);
1117
1118 free_STRING(string(&tc));
1119 }
1120
1121 free_STRING(string(&sc));
1122 repl_destroy(sp + 1);
1123 sp->type = C_DOUBLE;
1124 sp->dval = middle != (char *) 0 ? 1.0 : 0.0;
1125
1126 return_CELL("bi_sub", sp);
1127 }
1128
1129 static unsigned repl_cnt; /* number of global replacements */
1130
1131 static STRING *
gsub3(PTR re,CELL * repl,CELL * target)1132 gsub3(PTR re, CELL *repl, CELL *target)
1133 {
1134 int j;
1135 CELL xrepl;
1136 STRING *input = string(target);
1137 STRING *output;
1138 STRING *buffer;
1139 STRING *sval;
1140 size_t have;
1141 size_t used = 0;
1142 size_t guess = input->len;
1143 size_t limit = guess;
1144
1145 int skip0 = -1;
1146 size_t howmuch;
1147 char *where;
1148
1149 TRACE(("called gsub3\n"));
1150
1151 /*
1152 * If the replacement is constant, do it only once.
1153 */
1154 if (repl->type != C_REPLV) {
1155 cellcpy(&xrepl, repl);
1156 } else {
1157 memset(&xrepl, 0, sizeof(xrepl));
1158 }
1159
1160 repl_cnt = 0;
1161 output = new_STRING0(limit);
1162
1163 for (j = 0; j <= (int) input->len; ++j) {
1164 where = REmatch(input->str + j,
1165 input->len - (size_t) j,
1166 cast_to_re(re),
1167 &howmuch,
1168 (j != 0));
1169 /*
1170 * REmatch returns a non-null pointer if it found a match. But
1171 * that can be an empty string, e.g., for "*" or "?". The length
1172 * is in 'howmuch'.
1173 */
1174 if (where != 0) {
1175 have = (size_t) (where - (input->str + j));
1176 if (have) {
1177 skip0 = -1;
1178 TRACE(("..before match:%d:", (int) have));
1179 TRACE_STRING2(input->str + j, have);
1180 TRACE(("\n"));
1181 memcpy(output->str + used, input->str + j, have);
1182 used += have;
1183 }
1184
1185 TRACE(("REmatch %d vs %d len=%d:", (int) j, skip0, (int) howmuch));
1186 TRACE_STRING2(where, howmuch);
1187 TRACE(("\n"));
1188
1189 if (repl->type == C_REPLV) {
1190 if (xrepl.ptr == 0 ||
1191 string(&xrepl)->len != howmuch ||
1192 (howmuch != 0 &&
1193 memcmp(string(&xrepl)->str, where, howmuch))) {
1194 if (xrepl.ptr != 0)
1195 repl_destroy(&xrepl);
1196 sval = new_STRING1(where, howmuch);
1197 cellcpy(&xrepl, repl);
1198 replv_to_repl(&xrepl, sval);
1199 free_STRING(sval);
1200 }
1201 }
1202
1203 have = string(&xrepl)->len;
1204 TRACE(("..replace:"));
1205 TRACE_STRING2(string(&xrepl)->str, have);
1206 TRACE(("\n"));
1207
1208 if (howmuch || (j != skip0)) {
1209 ++repl_cnt;
1210
1211 /*
1212 * If this new chunk is longer than its replacement, add that
1213 * to the estimate of the length. Then, if the estimate goes
1214 * past the allocated length, reallocate and copy the existing
1215 * data.
1216 */
1217 if (have > howmuch) { /* growing */
1218 guess += (have - howmuch);
1219 if (guess >= limit) {
1220 buffer = output;
1221 limit = (++guess) * 2; /* FIXME - too coarse? */
1222 output = new_STRING0(limit);
1223 memcpy(output->str, buffer->str, used);
1224 free_STRING(buffer);
1225 }
1226 } else if (howmuch > have) { /* shrinking */
1227 guess -= (howmuch - have);
1228 }
1229
1230 /*
1231 * Finally, copy the new chunk.
1232 */
1233 memcpy(output->str + used, string(&xrepl)->str, have);
1234 used += have;
1235 }
1236
1237 if (howmuch) {
1238 j = (int) ((size_t) (where - input->str) + howmuch) - 1;
1239 } else {
1240 j = (int) (where - input->str);
1241 if (j < (int) input->len) {
1242 TRACE(("..emptied:"));
1243 TRACE_STRING2(input->str + j, 1);
1244 TRACE(("\n"));
1245 output->str[used++] = input->str[j];
1246 }
1247 }
1248 skip0 = (howmuch != 0) ? (j + 1) : -1;
1249 } else {
1250 have = (input->len - (size_t) j);
1251 TRACE(("..after match:%d:", (int) have));
1252 TRACE_STRING2(input->str + j, have);
1253 TRACE(("\n"));
1254 memcpy(output->str + used, input->str + j, have);
1255 used += have;
1256 break;
1257 }
1258 }
1259
1260 TRACE(("..input %d ->output %d\n",
1261 (int) input->len,
1262 (int) output->len));
1263
1264 repl_destroy(&xrepl);
1265 if (output->len > used) {
1266 buffer = output;
1267 output = new_STRING1(output->str, used);
1268 free_STRING(buffer);
1269 }
1270 TRACE(("..done gsub3\n"));
1271 return output;
1272 }
1273
1274 /* set up for call to gsub() */
1275 CELL *
bi_gsub(CELL * sp)1276 bi_gsub(CELL *sp)
1277 {
1278 CELL *cp; /* pts at the replacement target */
1279 CELL sc; /* copy of replacement target */
1280 CELL tc; /* build the result here */
1281 STRING *result;
1282
1283 TRACE_FUNC("bi_gsub", sp);
1284
1285 sp -= 2;
1286
1287 if (sp->type != C_RE)
1288 cast_to_RE(sp);
1289 if ((sp + 1)->type != C_REPL && (sp + 1)->type != C_REPLV)
1290 cast_to_REPL(sp + 1);
1291
1292 cellcpy(&sc, cp = (CELL *) (sp + 2)->ptr);
1293 if (sc.type < C_STRING)
1294 cast1_to_s(&sc);
1295
1296 TRACE(("..actual gsub args:\n"));
1297 TRACE(("arg0: "));
1298 TRACE_CELL(sp);
1299 TRACE(("arg1: "));
1300 TRACE_CELL(sp + 1);
1301 TRACE(("arg2: "));
1302 TRACE_CELL(&sc);
1303
1304 result = gsub3(sp->ptr, sp + 1, &sc);
1305 tc.ptr = (PTR) result;
1306
1307 if (repl_cnt) {
1308 tc.type = C_STRING;
1309 slow_cell_assign(cp, &tc);
1310 }
1311
1312 sp->type = C_DOUBLE;
1313 sp->dval = (double) repl_cnt;
1314
1315 TRACE(("Result: "));
1316 TRACE_CELL(sp);
1317 TRACE(("String: "));
1318 TRACE_STRING(result);
1319 TRACE(("\n"));
1320
1321 /* cleanup */
1322 free_STRING(string(&sc));
1323 free_STRING(string(&tc));
1324 repl_destroy(sp + 1);
1325
1326 return_CELL("bi_gsub", sp);
1327 }
1328