|
|
1 # ifndef FUNCDEF
2 # define INCLUDE_CTYPE
3 # include "kfun.h"
4 # include "table.h"
5
6 /*
7 * NAME: kfun->argerror()
8 * DESCRIPTION: handle an argument error in a builtin kfun
9 */
10 static void kf_argerror(kfun, n)
11 int kfun, n;
12 {
13 error("Bad argument %d for kfun %s", n, kftab[kfun].name);
14 }
15
16 /*
17 * NAME: kfun->itoa()
18 * DESCRIPTION: convert an Int to a string
19 */
20 static char *kf_itoa(i, buffer)
21 Int i;
22 char *buffer;
23 {
24 register Uint u;
25 register char *p;
26
27 u = (i >= 0) ? i : -i;
28
29 p = buffer + 11;
30 *p = '\0';
31 do {
32 *--p = '' + u % 10;
33 u /= 10;
34 } while (u != 0);
35 if (i < 0) {
36 *--p = '-';
37 }
38
39 return p;
40 }
41 # endif
42
43
44 # ifdef FUNCDEF
45 FUNCDEF("+", kf_add, pt_add)
46 # else
47 char pt_add[] = { C_STATIC, T_MIXED, 2, T_MIXED, T_MIXED };
48
49 /*
50 * NAME: kfun->add()
51 * DESCRIPTION: value + value
52 */
53 int kf_add(f)
54 register frame *f;
55 {
56 register string *str;
57 register array *a;
58 char *num, buffer[18];
59 xfloat f1, f2;
60 long l;
61
62 switch (f->sp[1].type) {
63 case T_INT:
64 switch (f->sp->type) {
65 case T_INT:
66 PUT_INT(&f->sp[1], f->sp[1].u.number + f->sp->u.number);
67 f->sp++;
68 return 0;
69
70 case T_STRING:
71 i_add_ticks(f, 2);
72 num = kf_itoa(f->sp[1].u.number, buffer);
73 str = str_new((char *) NULL,
74 (l=(long) strlen(num)) + f->sp->u.string->len);
75 strcpy(str->text, num);
76 memcpy(str->text + l, f->sp->u.string->text, f->sp->u.string->len);
77 str_del(f->sp->u.string);
78 f->sp++;
79 PUT_STRVAL(f->sp, str);
80 return 0;
81 }
82 break;
83
84 case T_FLOAT:
85 i_add_ticks(f, 1);
86 switch (f->sp->type) {
87 case T_FLOAT:
88 GET_FLT(f->sp, f2);
89 f->sp++;
90 GET_FLT(f->sp, f1);
91 flt_add(&f1, &f2);
92 PUT_FLT(f->sp, f1);
93 return 0;
94
95 case T_STRING:
96 i_add_ticks(f, 2);
97 GET_FLT(&f->sp[1], f1);
98 flt_ftoa(&f1, buffer);
99 str = str_new((char *) NULL,
100 (l=(long) strlen(buffer)) + f->sp->u.string->len);
101 strcpy(str->text, buffer);
102 memcpy(str->text + l, f->sp->u.string->text, f->sp->u.string->len);
103 str_del(f->sp->u.string);
104 f->sp++;
105 PUT_STRVAL(f->sp, str);
106 return 0;
107 }
108 break;
109
110 case T_STRING:
111 i_add_ticks(f, 2);
112 switch (f->sp->type) {
113 case T_INT:
114 num = kf_itoa(f->sp->u.number, buffer);
115 f->sp++;
116 str = str_new((char *) NULL,
117 f->sp->u.string->len + (long) strlen(num));
118 memcpy(str->text, f->sp->u.string->text, f->sp->u.string->len);
119 strcpy(str->text + f->sp->u.string->len, num);
120 str_del(f->sp->u.string);
121 PUT_STR(f->sp, str);
122 return 0;
123
124 case T_FLOAT:
125 i_add_ticks(f, 1);
126 GET_FLT(f->sp, f2);
127 flt_ftoa(&f2, buffer);
128 f->sp++;
129 str = str_new((char *) NULL,
130 f->sp->u.string->len + (long) strlen(buffer));
131 memcpy(str->text, f->sp->u.string->text, f->sp->u.string->len);
132 strcpy(str->text + f->sp->u.string->len, buffer);
133 str_del(f->sp->u.string);
134 PUT_STR(f->sp, str);
135 return 0;
136
137 case T_STRING:
138 str = str_add(f->sp[1].u.string, f->sp->u.string);
139 str_del(f->sp->u.string);
140 f->sp++;
141 str_del(f->sp->u.string);
142 PUT_STR(f->sp, str);
143 return 0;
144 }
145 break;
146
147 case T_ARRAY:
148 if (f->sp->type == T_ARRAY) {
149 i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
150 a = arr_add(f->data, f->sp[1].u.array, f->sp->u.array);
151 arr_del(f->sp->u.array);
152 f->sp++;
153 arr_del(f->sp->u.array);
154 PUT_ARR(f->sp, a);
155 return 0;
156 }
157 break;
158
159 case T_MAPPING:
160 if (f->sp->type == T_MAPPING) {
161 i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
162 a = map_add(f->data, f->sp[1].u.array, f->sp->u.array);
163 arr_del(f->sp->u.array);
164 f->sp++;
165 arr_del(f->sp->u.array);
166 PUT_MAP(f->sp, a);
167 return 0;
168 }
169 break;
170
171 default:
172 kf_argerror(KF_ADD, 1);
173 }
174
175 kf_argerror(KF_ADD, 2);
176 }
177 # endif
178
179
180 # ifdef FUNCDEF
181 FUNCDEF("+", kf_add_int, pt_add_int)
182 # else
183 char pt_add_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
184
185 /*
186 * NAME: kfun->add_int()
187 * DESCRIPTION: int + int
188 */
189 int kf_add_int(f)
190 register frame *f;
191 {
192 PUT_INT(&f->sp[1], f->sp[1].u.number + f->sp->u.number);
193 f->sp++;
194 return 0;
195 }
196 # endif
197
198
199 # ifdef FUNCDEF
200 FUNCDEF("++", kf_add1, pt_add1)
201 # else
202 char pt_add1[] = { C_STATIC, T_MIXED, 1, T_MIXED };
203
204 /*
205 * NAME: kfun->add1()
206 * DESCRIPTION: value++
207 */
208 int kf_add1(f)
209 register frame *f;
210 {
211 xfloat f1, f2;
212
213 if (f->sp->type == T_INT) {
214 PUT_INT(f->sp, f->sp->u.number + 1);
215 } else if (f->sp->type == T_FLOAT) {
216 i_add_ticks(f, 1);
217 GET_FLT(f->sp, f1);
218 FLT_ONE(f2.high, f2.low);
219 flt_add(&f1, &f2);
220 PUT_FLT(f->sp, f1);
221 } else {
222 kf_argerror(KF_ADD1, 1);
223 }
224 return 0;
225 }
226 # endif
227
228
229 # ifdef FUNCDEF
230 FUNCDEF("++", kf_add1_int, pt_add1_int)
231 # else
232 char pt_add1_int[] = { C_STATIC, T_INT, 1, T_INT };
233
234 /*
235 * NAME: kfun->add1_int()
236 * DESCRIPTION: int++
237 */
238 int kf_add1_int(f)
239 frame *f;
240 {
241 PUT_INT(f->sp, f->sp->u.number + 1);
242 return 0;
243 }
244 # endif
245
246
247 # ifdef FUNCDEF
248 FUNCDEF("&", kf_and, pt_and)
249 # else
250 char pt_and[] = { C_STATIC, T_MIXED, 2, T_MIXED, T_MIXED };
251
252 /*
253 * NAME: kfun->and()
254 * DESCRIPTION: value & value
255 */
256 int kf_and(f)
257 register frame *f;
258 {
259 array *a;
260
261 switch (f->sp[1].type) {
262 case T_INT:
263 if (f->sp->type == T_INT) {
264 PUT_INT(&f->sp[1], f->sp[1].u.number & f->sp->u.number);
265 f->sp++;
266 return 0;
267 }
268 break;
269
270 case T_ARRAY:
271 if (f->sp->type == T_ARRAY) {
272 i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
273 a = arr_intersect(f->data, f->sp[1].u.array, f->sp->u.array);
274 arr_del(f->sp->u.array);
275 f->sp++;
276 arr_del(f->sp->u.array);
277 PUT_ARR(f->sp, a);
278 return 0;
279 }
280 break;
281
282 case T_MAPPING:
283 if (f->sp->type == T_ARRAY) {
284 i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
285 a = map_intersect(f->data, f->sp[1].u.array, f->sp->u.array);
286 arr_del(f->sp->u.array);
287 f->sp++;
288 PUT_MAP(f->sp, a);
289 return 0;
290 }
291 break;
292
293 default:
294 kf_argerror(KF_AND, 1);
295 }
296
297 kf_argerror(KF_AND, 2);
298 }
299 # endif
300
301
302 # ifdef FUNCDEF
303 FUNCDEF("&", kf_and_int, pt_and_int)
304 # else
305 char pt_and_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
306
307 /*
308 * NAME: kfun->and_int()
309 * DESCRIPTION: int & int
310 */
311 int kf_and_int(f)
312 register frame *f;
313 {
314 PUT_INT(&f->sp[1], f->sp[1].u.number & f->sp->u.number);
315 f->sp++;
316 return 0;
317 }
318 # endif
319
320
321 # ifdef FUNCDEF
322 FUNCDEF("/", kf_div, pt_div)
323 # else
324 char pt_div[] = { C_STATIC, T_MIXED, 2, T_MIXED, T_MIXED };
325
326 /*
327 * NAME: kfun->div()
328 * DESCRIPTION: mixed / mixed
329 */
330 int kf_div(f)
331 register frame *f;
332 {
333 register Int i, d;
334 xfloat f1, f2;
335
336 if (f->sp[1].type != f->sp->type) {
337 kf_argerror(KF_DIV, 2);
338 }
339 switch (f->sp->type) {
340 case T_INT:
341 i = f->sp[1].u.number;
342 d = f->sp->u.number;
343 if (d == 0) {
344 error("Division by zero");
345 }
346 if ((i | d) < 0) {
347 Int r;
348
349 r = ((Uint) ((i < 0) ? -i : i)) / ((Uint) ((d < 0) ? -d : d));
350 PUT_INT(&f->sp[1], ((i ^ d) < 0) ? -r : r);
351 } else {
352 PUT_INT(&f->sp[1], ((Uint) i) / ((Uint) d));
353 }
354 f->sp++;
355 return 0;
356
357 case T_FLOAT:
358 i_add_ticks(f, 1);
359 GET_FLT(f->sp, f2);
360 f->sp++;
361 GET_FLT(f->sp, f1);
362 flt_div(&f1, &f2);
363 PUT_FLT(f->sp, f1);
364 return 0;
365
366 default:
367 kf_argerror(KF_DIV, 1);
368 }
369 }
370 # endif
371
372
373 # ifdef FUNCDEF
374 FUNCDEF("/", kf_div_int, pt_div_int)
375 # else
376 char pt_div_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
377
378 /*
379 * NAME: kfun->div()
380 * DESCRIPTION: int / int
381 */
382 int kf_div_int(f)
383 register frame *f;
384 {
385 register Int i, d;
386
387 i = f->sp[1].u.number;
388 d = f->sp->u.number;
389 if (d == 0) {
390 error("Division by zero");
391 }
392 if ((i | d) < 0) {
393 Int r;
394
395 r = ((Uint) ((i < 0) ? -i : i)) / ((Uint) ((d < 0) ? -d : d));
396 PUT_INT(&f->sp[1], ((i ^ d) < 0) ? -r : r);
397 } else {
398 PUT_INT(&f->sp[1], ((Uint) i) / ((Uint) d));
399 }
400 f->sp++;
401 return 0;
402 }
403 # endif
404
405
406 # ifdef FUNCDEF
407 FUNCDEF("==", kf_eq, pt_eq)
408 # else
409 char pt_eq[] = { C_STATIC, T_INT, 2, T_MIXED, T_MIXED };
410
411 /*
412 * NAME: kfun->eq()
413 * DESCRIPTION: value == value
414 */
415 int kf_eq(f)
416 register frame *f;
417 {
418 register bool flag;
419 xfloat f1, f2;
420
421 if (f->sp[1].type != f->sp->type) {
422 i_pop(f, 2);
423 PUSH_INTVAL(f, FALSE);
424 return 0;
425 }
426
427 switch (f->sp->type) {
428 case T_NIL:
429 f->sp++;
430 PUT_INTVAL(f->sp, TRUE);
431 break;
432
433 case T_INT:
434 PUT_INT(&f->sp[1], (f->sp[1].u.number == f->sp->u.number));
435 f->sp++;
436 break;
437
438 case T_FLOAT:
439 i_add_ticks(f, 1);
440 GET_FLT(f->sp, f2);
441 f->sp++;
442 GET_FLT(f->sp, f1);
443 PUT_INTVAL(f->sp, (flt_cmp(&f1, &f2) == 0));
444 break;
445
446 case T_STRING:
447 i_add_ticks(f, 2);
448 flag = (str_cmp(f->sp[1].u.string, f->sp->u.string) == 0);
449 str_del(f->sp->u.string);
450 f->sp++;
451 str_del(f->sp->u.string);
452 PUT_INTVAL(f->sp, flag);
453 break;
454
455 case T_OBJECT:
456 PUT_INTVAL(&f->sp[1], (f->sp[1].oindex == f->sp->oindex));
457 f->sp++;
458 break;
459
460 case T_ARRAY:
461 case T_MAPPING:
462 flag = (f->sp[1].u.array == f->sp->u.array);
463 arr_del(f->sp->u.array);
464 f->sp++;
465 arr_del(f->sp->u.array);
466 PUT_INTVAL(f->sp, flag);
467 break;
468 }
469
470 return 0;
471 }
472 # endif
473
474
475 # ifdef FUNCDEF
476 FUNCDEF("==", kf_eq_int, pt_eq_int)
477 # else
478 char pt_eq_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
479
480 /*
481 * NAME: kfun->eq_int()
482 * DESCRIPTION: int == int
483 */
484 int kf_eq_int(f)
485 register frame *f;
486 {
487 PUT_INT(&f->sp[1], (f->sp[1].u.number == f->sp->u.number));
488 f->sp++;
489 return 0;
490 }
491 # endif
492
493
494 # ifdef FUNCDEF
495 FUNCDEF(">=", kf_ge, pt_ge)
496 # else
497 char pt_ge[] = { C_STATIC, T_INT, 2, T_MIXED, T_MIXED };
498
499 /*
500 * NAME: kfun->ge()
501 * DESCRIPTION: value >= value
502 */
503 int kf_ge(f)
504 register frame *f;
505 {
506 xfloat f1, f2;
507 bool flag;
508
509 if (f->sp[1].type != f->sp->type) {
510 kf_argerror(KF_GE, 2);
511 }
512 switch (f->sp->type) {
513 case T_INT:
514 PUT_INT(&f->sp[1], (f->sp[1].u.number >= f->sp->u.number));
515 f->sp++;
516 return 0;
517
518 case T_FLOAT:
519 i_add_ticks(f, 1);
520 GET_FLT(f->sp, f2);
521 f->sp++;
522 GET_FLT(f->sp, f1);
523 PUT_INTVAL(f->sp, (flt_cmp(&f1, &f2) >= 0));
524 return 0;
525
526 case T_STRING:
527 i_add_ticks(f, 2);
528 flag = (str_cmp(f->sp[1].u.string, f->sp->u.string) >= 0);
529 str_del(f->sp->u.string);
530 f->sp++;
531 str_del(f->sp->u.string);
532 PUT_INTVAL(f->sp, flag);
533 return 0;
534
535 default:
536 kf_argerror(KF_GE, 1);
537 }
538 }
539 # endif
540
541
542 # ifdef FUNCDEF
543 FUNCDEF(">=", kf_ge_int, pt_ge_int)
544 # else
545 char pt_ge_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
546
547 /*
548 * NAME: kfun->ge_int()
549 * DESCRIPTION: int >= int
550 */
551 int kf_ge_int(f)
552 register frame *f;
553 {
554 PUT_INT(&f->sp[1], (f->sp[1].u.number >= f->sp->u.number));
555 f->sp++;
556 return 0;
557 }
558 # endif
559
560
561 # ifdef FUNCDEF
562 FUNCDEF(">", kf_gt, pt_gt)
563 # else
564 char pt_gt[] = { C_STATIC, T_INT, 2, T_MIXED, T_MIXED };
565
566 /*
567 * NAME: kfun->gt()
568 * DESCRIPTION: value > value
569 */
570 int kf_gt(f)
571 register frame *f;
572 {
573 xfloat f1, f2;
574 bool flag;
575
576 if (f->sp[1].type != f->sp->type) {
577 kf_argerror(KF_GT, 2);
578 }
579 switch (f->sp->type) {
580 case T_INT:
581 PUT_INT(&f->sp[1], (f->sp[1].u.number > f->sp->u.number));
582 f->sp++;
583 return 0;
584
585 case T_FLOAT:
586 i_add_ticks(f, 1);
587 GET_FLT(f->sp, f2);
588 f->sp++;
589 GET_FLT(f->sp, f1);
590 PUT_INTVAL(f->sp, (flt_cmp(&f1, &f2) > 0));
591 return 0;
592
593 case T_STRING:
594 i_add_ticks(f, 2);
595 flag = (str_cmp(f->sp[1].u.string, f->sp->u.string) > 0);
596 str_del(f->sp->u.string);
597 f->sp++;
598 str_del(f->sp->u.string);
599 PUT_INTVAL(f->sp, flag);
600 return 0;
601
602 default:
603 kf_argerror(KF_GT, 1);
604 }
605 }
606 # endif
607
608
609 # ifdef FUNCDEF
610 FUNCDEF(">", kf_gt_int, pt_gt_int)
611 # else
612 char pt_gt_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
613
614 /*
615 * NAME: kfun->gt_int()
616 * DESCRIPTION: int > int
617 */
618 int kf_gt_int(f)
619 register frame *f;
620 {
621 PUT_INT(&f->sp[1], (f->sp[1].u.number > f->sp->u.number));
622 f->sp++;
623 return 0;
624 }
625 # endif
626
627
628 # ifdef FUNCDEF
629 FUNCDEF("<=", kf_le, pt_le)
630 # else
631 char pt_le[] = { C_STATIC, T_INT, 2, T_MIXED, T_MIXED };
632
633 /*
634 * NAME: kfun->le()
635 * DESCRIPTION: value <= value
636 */
637 int kf_le(f)
638 register frame *f;
639 {
640 xfloat f1, f2;
641 bool flag;
642
643 if (f->sp[1].type != f->sp->type) {
644 kf_argerror(KF_LE, 2);
645 }
646 switch (f->sp->type) {
647 case T_INT:
648 PUT_INT(&f->sp[1], (f->sp[1].u.number <= f->sp->u.number));
649 f->sp++;
650 return 0;
651
652 case T_FLOAT:
653 i_add_ticks(f, 1);
654 GET_FLT(f->sp, f2);
655 f->sp++;
656 GET_FLT(f->sp, f1);
657 PUT_INTVAL(f->sp, (flt_cmp(&f1, &f2) <= 0));
658 return 0;
659
660 case T_STRING:
661 i_add_ticks(f, 2);
662 flag = (str_cmp(f->sp[1].u.string, f->sp->u.string) <= 0);
663 str_del(f->sp->u.string);
664 f->sp++;
665 str_del(f->sp->u.string);
666 PUT_INTVAL(f->sp, flag);
667 return 0;
668
669 default:
670 kf_argerror(KF_LE, 1);
671 }
672 }
673 # endif
674
675
676 # ifdef FUNCDEF
677 FUNCDEF("<=", kf_le_int, pt_le_int)
678 # else
679 char pt_le_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
680
681 /*
682 * NAME: kfun->le_int()
683 * DESCRIPTION: int <= int
684 */
685 int kf_le_int(f)
686 register frame *f;
687 {
688 PUT_INT(&f->sp[1], (f->sp[1].u.number <= f->sp->u.number));
689 f->sp++;
690 return 0;
691 }
692 # endif
693
694
695 # ifdef FUNCDEF
696 FUNCDEF("<<", kf_lshift, pt_lshift)
697 # else
698 char pt_lshift[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
699
700 /*
701 * NAME: kfun->lshift()
702 * DESCRIPTION: int << int
703 */
704 int kf_lshift(f)
705 register frame *f;
706 {
707 if (f->sp[1].type != T_INT) {
708 kf_argerror(KF_LSHIFT, 1);
709 }
710 if (f->sp->type != T_INT) {
711 kf_argerror(KF_LSHIFT, 2);
712 }
713 if ((f->sp->u.number & ~31) != 0) {
714 if (f->sp->u.number < 0) {
715 error("Negative left shift");
716 }
717 PUT_INT(&f->sp[1], 0);
718 } else {
719 PUT_INT(&f->sp[1], (Uint) f->sp[1].u.number << f->sp->u.number);
720 }
721 f->sp++;
722 return 0;
723 }
724 # endif
725
726
727 # ifdef FUNCDEF
728 FUNCDEF("<<", kf_lshift_int, pt_lshift_int)
729 # else
730 char pt_lshift_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
731
732 /*
733 * NAME: kfun->lshift_int()
734 * DESCRIPTION: int << int
735 */
736 int kf_lshift_int(f)
737 register frame *f;
738 {
739 if ((f->sp->u.number & ~31) != 0) {
740 if (f->sp->u.number < 0) {
741 error("Negative left shift");
742 }
743 PUT_INT(&f->sp[1], 0);
744 } else {
745 PUT_INT(&f->sp[1], (Uint) f->sp[1].u.number << f->sp->u.number);
746 }
747 f->sp++;
748 return 0;
749 }
750 # endif
751
752
753 # ifdef FUNCDEF
754 FUNCDEF("<", kf_lt, pt_lt)
755 # else
756 char pt_lt[] = { C_STATIC, T_INT, 2, T_MIXED, T_MIXED };
757
758 /*
759 * NAME: kfun->lt()
760 * DESCRIPTION: value < value
761 */
762 int kf_lt(f)
763 register frame *f;
764 {
765 xfloat f1, f2;
766 bool flag;
767
768 if (f->sp[1].type != f->sp->type) {
769 kf_argerror(KF_LT, 2);
770 }
771 switch (f->sp->type) {
772 case T_INT:
773 PUT_INT(&f->sp[1], (f->sp[1].u.number < f->sp->u.number));
774 f->sp++;
775 return 0;
776
777 case T_FLOAT:
778 i_add_ticks(f, 1);
779 GET_FLT(f->sp, f2);
780 f->sp++;
781 GET_FLT(f->sp, f1);
782 PUT_INTVAL(f->sp, (flt_cmp(&f1, &f2) < 0));
783 return 0;
784
785 case T_STRING:
786 i_add_ticks(f, 2);
787 flag = (str_cmp(f->sp[1].u.string, f->sp->u.string) < 0);
788 str_del(f->sp->u.string);
789 f->sp++;
790 str_del(f->sp->u.string);
791 PUT_INTVAL(f->sp, flag);
792 return 0;
793
794 default:
795 kf_argerror(KF_LT, 1);
796 }
797 }
798 # endif
799
800
801 # ifdef FUNCDEF
802 FUNCDEF("<", kf_lt_int, pt_lt_int)
803 # else
804 char pt_lt_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
805
806 /*
807 * NAME: kfun->lt_int()
808 * DESCRIPTION: int < int
809 */
810 int kf_lt_int(f)
811 register frame *f;
812 {
813 PUT_INT(&f->sp[1], (f->sp[1].u.number < f->sp->u.number));
814 f->sp++;
815 return 0;
816 }
817 # endif
818
819
820 # ifdef FUNCDEF
821 FUNCDEF("%", kf_mod, pt_mod)
822 # else
823 char pt_mod[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
824
825 /*
826 * NAME: kfun->mod()
827 * DESCRIPTION: int % int
828 */
829 int kf_mod(f)
830 register frame *f;
831 {
832 register Int i, d;
833
834 if (f->sp[1].type != T_INT) {
835 kf_argerror(KF_MOD, 1);
836 }
837 if (f->sp->type != T_INT) {
838 kf_argerror(KF_MOD, 2);
839 }
840 i = f->sp[1].u.number;
841 d = f->sp->u.number;
842 if (d == 0) {
843 error("Modulus by zero");
844 }
845 if ((i | d) < 0) {
846 Int r;
847
848 r = ((Uint) ((i < 0) ? -i : i)) % ((Uint) ((d < 0) ? -d : d));
849 PUT_INT(&f->sp[1], ((i ^ d) < 0) ? -r : r);
850 } else {
851 PUT_INT(&f->sp[1], ((Uint) i) % ((Uint) d));
852 }
853 f->sp++;
854 return 0;
855 }
856 # endif
857
858
859 # ifdef FUNCDEF
860 FUNCDEF("%", kf_mod_int, pt_mod_int)
861 # else
862 char pt_mod_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
863
864 /*
865 * NAME: kfun->mod_int()
866 * DESCRIPTION: int % int
867 */
868 int kf_mod_int(f)
869 register frame *f;
870 {
871 register Int i, d;
872
873 i = f->sp[1].u.number;
874 d = f->sp->u.number;
875 if (d == 0) {
876 error("Modulus by zero");
877 }
878 if ((i | d) < 0) {
879 Int r;
880
881 r = ((Uint) ((i < 0) ? -i : i)) % ((Uint) ((d < 0) ? -d : d));
882 PUT_INT(&f->sp[1], ((i ^ d) < 0) ? -r : r);
883 } else {
884 PUT_INT(&f->sp[1], ((Uint) i) % ((Uint) d));
885 }
886 f->sp++;
887 return 0;
888 }
889 # endif
890
891
892 # ifdef FUNCDEF
893 FUNCDEF("*", kf_mult, pt_mult)
894 # else
895 char pt_mult[] = { C_STATIC, T_MIXED, 2, T_MIXED, T_MIXED };
896
897 /*
898 * NAME: kfun->mult()
899 * DESCRIPTION: mixed * mixed
900 */
901 int kf_mult(f)
902 register frame *f;
903 {
904 xfloat f1, f2;
905
906 if (f->sp[1].type != f->sp->type) {
907 kf_argerror(KF_MULT, 2);
908 }
909 switch (f->sp->type) {
910 case T_INT:
911 PUT_INT(&f->sp[1], f->sp[1].u.number * f->sp->u.number);
912 f->sp++;
913 return 0;
914
915 case T_FLOAT:
916 i_add_ticks(f, 1);
917 GET_FLT(f->sp, f2);
918 f->sp++;
919 GET_FLT(f->sp, f1);
920 flt_mult(&f1, &f2);
921 PUT_FLT(f->sp, f1);
922 return 0;
923
924 default:
925 kf_argerror(KF_MULT, 1);
926 }
927 }
928 # endif
929
930
931 # ifdef FUNCDEF
932 FUNCDEF("*", kf_mult_int, pt_mult_int)
933 # else
934 char pt_mult_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
935
936 /*
937 * NAME: kfun->mult_int()
938 * DESCRIPTION: int * int
939 */
940 int kf_mult_int(f)
941 register frame *f;
942 {
943 PUT_INT(&f->sp[1], f->sp[1].u.number * f->sp->u.number);
944 f->sp++;
945 return 0;
946 }
947 # endif
948
949
950 # ifdef FUNCDEF
951 FUNCDEF("!=", kf_ne, pt_ne)
952 # else
953 char pt_ne[] = { C_STATIC, T_INT, 2, T_MIXED, T_MIXED };
954
955 /*
956 * NAME: kfun->ne()
957 * DESCRIPTION: value != value
958 */
959 int kf_ne(f)
960 register frame *f;
961 {
962 register bool flag;
963 xfloat f1, f2;
964
965 if (f->sp[1].type != f->sp->type) {
966 i_pop(f, 2);
967 PUSH_INTVAL(f, TRUE);
968 return 0;
969 }
970
971 switch (f->sp->type) {
972 case T_NIL:
973 f->sp++;
974 PUT_INTVAL(f->sp, FALSE);
975 break;
976
977 case T_INT:
978 PUT_INT(&f->sp[1], (f->sp[1].u.number != f->sp->u.number));
979 f->sp++;
980 break;
981
982 case T_FLOAT:
983 i_add_ticks(f, 1);
984 GET_FLT(f->sp, f2);
985 f->sp++;
986 GET_FLT(f->sp, f1);
987 PUT_INTVAL(f->sp, (flt_cmp(&f1, &f2) != 0));
988 break;
989
990 case T_STRING:
991 i_add_ticks(f, 2);
992 flag = (str_cmp(f->sp[1].u.string, f->sp->u.string) != 0);
993 str_del(f->sp->u.string);
994 f->sp++;
995 str_del(f->sp->u.string);
996 PUT_INTVAL(f->sp, flag);
997 break;
998
999 case T_OBJECT:
1000 PUT_INTVAL(&f->sp[1], (f->sp[1].oindex != f->sp->oindex));
1001 f->sp++;
1002 break;
1003
1004 case T_ARRAY:
1005 case T_MAPPING:
1006 flag = (f->sp[1].u.array != f->sp->u.array);
1007 arr_del(f->sp->u.array);
1008 f->sp++;
1009 arr_del(f->sp->u.array);
1010 PUT_INTVAL(f->sp, flag);
1011 break;
1012 }
1013
1014 return 0;
1015 }
1016 # endif
1017
1018
1019 # ifdef FUNCDEF
1020 FUNCDEF("!=", kf_ne_int, pt_ne_int)
1021 # else
1022 char pt_ne_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
1023
1024 /*
1025 * NAME: kfun->ne_int()
1026 * DESCRIPTION: int != int
1027 */
1028 int kf_ne_int(f)
1029 register frame *f;
1030 {
1031 PUT_INT(&f->sp[1], (f->sp[1].u.number != f->sp->u.number));
1032 f->sp++;
1033 return 0;
1034 }
1035 # endif
1036
1037
1038 # ifdef FUNCDEF
1039 FUNCDEF("~", kf_neg, pt_neg)
1040 # else
1041 char pt_neg[] = { C_STATIC, T_INT, 1, T_INT };
1042
1043 /*
1044 * NAME: kfun->neg()
1045 * DESCRIPTION: ~ int
1046 */
1047 int kf_neg(f)
1048 register frame *f;
1049 {
1050 if (f->sp->type != T_INT) {
1051 kf_argerror(KF_NEG, 1);
1052 }
1053 PUT_INT(f->sp, ~f->sp->u.number);
1054 return 0;
1055 }
1056 # endif
1057
1058
1059 # ifdef FUNCDEF
1060 FUNCDEF("~", kf_neg_int, pt_neg_int)
1061 # else
1062 char pt_neg_int[] = { C_STATIC, T_INT, 1, T_INT };
1063
1064 /*
1065 * NAME: kfun->neg_int()
1066 * DESCRIPTION: ~ int
1067 */
1068 int kf_neg_int(f)
1069 frame *f;
1070 {
1071 PUT_INT(f->sp, ~f->sp->u.number);
1072 return 0;
1073 }
1074 # endif
1075
1076
1077 # ifdef FUNCDEF
1078 FUNCDEF("!", kf_not, pt_not)
1079 # else
1080 char pt_not[] = { C_STATIC, T_INT, 1, T_MIXED };
1081
1082 /*
1083 * NAME: kfun->not()
1084 * DESCRIPTION: ! value
1085 */
1086 int kf_not(f)
1087 register frame *f;
1088 {
1089 switch (f->sp->type) {
1090 case T_NIL:
1091 PUT_INTVAL(f->sp, TRUE);
1092 return 0;
1093
1094 case T_INT:
1095 PUT_INT(f->sp, !f->sp->u.number);
1096 return 0;
1097
1098 case T_FLOAT:
1099 PUT_INTVAL(f->sp, VFLT_ISZERO(f->sp));
1100 return 0;
1101
1102 case T_STRING:
1103 str_del(f->sp->u.string);
1104 break;
1105
1106 case T_ARRAY:
1107 case T_MAPPING:
1108 arr_del(f->sp->u.array);
1109 break;
1110 }
1111
1112 PUT_INTVAL(f->sp, FALSE);
1113 return 0;
1114 }
1115 # endif
1116
1117
1118 # ifdef FUNCDEF
1119 FUNCDEF("!", kf_not_int, pt_not)
1120 # else
1121 /*
1122 * NAME: kfun->not_int()
1123 * DESCRIPTION: ! int
1124 */
1125 int kf_not_int(f)
1126 frame *f;
1127 {
1128 PUT_INT(f->sp, !f->sp->u.number);
1129 return 0;
1130 }
1131 # endif
1132
1133
1134 # ifdef FUNCDEF
1135 FUNCDEF("|", kf_or, pt_or)
1136 # else
1137 char pt_or[] = { C_STATIC, T_MIXED, 2, T_MIXED, T_MIXED };
1138
1139 /*
1140 * NAME: kfun->or()
1141 * DESCRIPTION: value | value
1142 */
1143 int kf_or(f)
1144 register frame *f;
1145 {
1146 array *a;
1147
1148 switch (f->sp[1].type) {
1149 case T_INT:
1150 if (f->sp->type == T_INT) {
1151 PUT_INT(&f->sp[1], f->sp[1].u.number | f->sp->u.number);
1152 f->sp++;
1153 return 0;
1154 }
1155 break;
1156
1157 case T_ARRAY:
1158 if (f->sp->type == T_ARRAY) {
1159 i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
1160 a = arr_setadd(f->data, f->sp[1].u.array, f->sp->u.array);
1161 arr_del(f->sp->u.array);
1162 f->sp++;
1163 arr_del(f->sp->u.array);
1164 PUT_ARR(f->sp, a);
1165 return 0;
1166 }
1167 break;
1168
1169 default:
1170 kf_argerror(KF_OR, 1);
1171 }
1172
1173 kf_argerror(KF_OR, 2);
1174 }
1175 # endif
1176
1177
1178 # ifdef FUNCDEF
1179 FUNCDEF("|", kf_or_int, pt_or_int)
1180 # else
1181 char pt_or_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
1182
1183 /*
1184 * NAME: kfun->or_int()
1185 * DESCRIPTION: int | int
1186 */
1187 int kf_or_int(f)
1188 register frame *f;
1189 {
1190 PUT_INT(&f->sp[1], f->sp[1].u.number | f->sp->u.number);
1191 f->sp++;
1192 return 0;
1193 }
1194 # endif
1195
1196
1197 # ifdef FUNCDEF
1198 FUNCDEF("[]", kf_rangeft, pt_rangeft)
1199 # else
1200 char pt_rangeft[] = { C_STATIC, T_MIXED, 3, T_MIXED, T_MIXED, T_MIXED };
1201 /*
1202 * NAME: kfun->rangeft()
1203 * DESCRIPTION: value [ int .. int ]
1204 */
1205 int kf_rangeft(f)
1206 register frame *f;
1207 {
1208 string *str;
1209 array *a;
1210
1211 if (f->sp[2].type == T_MAPPING) {
1212 a = map_range(f->data, f->sp[2].u.array, &f->sp[1], f->sp);
1213 i_del_value(f->sp++);
1214 i_del_value(f->sp++);
1215 i_add_ticks(f, f->sp->u.array->size);
1216 arr_del(f->sp->u.array);
1217 PUT_ARR(f->sp, a);
1218
1219 return 0;
1220 }
1221
1222 if (f->sp[1].type != T_INT) {
1223 kf_argerror(KF_RANGEFT, 2);
1224 }
1225 if (f->sp->type != T_INT) {
1226 kf_argerror(KF_RANGEFT, 3);
1227 }
1228 switch (f->sp[2].type) {
1229 case T_STRING:
1230 i_add_ticks(f, 2);
1231 str = str_range(f->sp[2].u.string, (long) f->sp[1].u.number,
1232 (long) f->sp->u.number);
1233 f->sp += 2;
1234 str_del(f->sp->u.string);
1235 PUT_STR(f->sp, str);
1236 break;
1237
1238 case T_ARRAY:
1239 a = arr_range(f->data, f->sp[2].u.array, (long) f->sp[1].u.number,
1240 (long) f->sp->u.number);
1241 i_add_ticks(f, a->size);
1242 f->sp += 2;
1243 arr_del(f->sp->u.array);
1244 PUT_ARR(f->sp, a);
1245 break;
1246
1247 default:
1248 kf_argerror(KF_RANGEFT, 1);
1249 }
1250
1251 return 0;
1252 }
1253 # endif
1254
1255
1256 # ifdef FUNCDEF
1257 FUNCDEF("[]", kf_rangef, pt_rangef)
1258 # else
1259 char pt_rangef[] = { C_STATIC, T_MIXED, 2, T_MIXED, T_MIXED };
1260
1261 /*
1262 * NAME: kfun->rangef()
1263 * DESCRIPTION: value [ int .. ]
1264 */
1265 int kf_rangef(f)
1266 register frame *f;
1267 {
1268 string *str;
1269 array *a;
1270
1271 if (f->sp[1].type == T_MAPPING) {
1272 a = map_range(f->data, f->sp[1].u.array, f->sp, (value *) NULL);
1273 i_del_value(f->sp++);
1274 i_add_ticks(f, f->sp->u.array->size);
1275 arr_del(f->sp->u.array);
1276 PUT_MAP(f->sp, a);
1277
1278 return 0;
1279 }
1280
1281 if (f->sp->type != T_INT) {
1282 kf_argerror(KF_RANGEF, 2);
1283 }
1284 switch (f->sp[1].type) {
1285 case T_STRING:
1286 i_add_ticks(f, 2);
1287 str = str_range(f->sp[1].u.string, (long) f->sp->u.number,
1288 f->sp[1].u.string->len - 1L);
1289 f->sp++;
1290 str_del(f->sp->u.string);
1291 PUT_STR(f->sp, str);
1292 break;
1293
1294 case T_ARRAY:
1295 a = arr_range(f->data, f->sp[1].u.array, (long) f->sp->u.number,
1296 f->sp[1].u.array->size - 1L);
1297 i_add_ticks(f, a->size);
1298 f->sp++;
1299 arr_del(f->sp->u.array);
1300 PUT_ARR(f->sp, a);
1301 break;
1302
1303 default:
1304 kf_argerror(KF_RANGEF, 1);
1305 }
1306
1307 return 0;
1308 }
1309 # endif
1310
1311
1312 # ifdef FUNCDEF
1313 FUNCDEF("[]", kf_ranget, pt_ranget)
1314 # else
1315 char pt_ranget[] = { C_STATIC, T_MIXED, 2, T_MIXED, T_MIXED };
1316
1317 /*
1318 * NAME: kfun->ranget()
1319 * DESCRIPTION: value [ .. int ]
1320 */
1321 int kf_ranget(f)
1322 register frame *f;
1323 {
1324 string *str;
1325 array *a;
1326
1327 if (f->sp[1].type == T_MAPPING) {
1328 a = map_range(f->data, f->sp[1].u.array, (value *) NULL, f->sp);
1329 i_del_value(f->sp++);
1330 i_add_ticks(f, f->sp->u.array->size);
1331 arr_del(f->sp->u.array);
1332 PUT_MAP(f->sp, a);
1333
1334 return 0;
1335 }
1336
1337 if (f->sp->type != T_INT) {
1338 kf_argerror(KF_RANGET, 2);
1339 }
1340 switch (f->sp[1].type) {
1341 case T_STRING:
1342 i_add_ticks(f, 2);
1343 str = str_range(f->sp[1].u.string, 0L, (long) f->sp->u.number);
1344 f->sp++;
1345 str_del(f->sp->u.string);
1346 PUT_STR(f->sp, str);
1347 break;
1348
1349 case T_ARRAY:
1350 a = arr_range(f->data, f->sp[1].u.array, 0L, (long) f->sp->u.number);
1351 i_add_ticks(f, a->size);
1352 f->sp++;
1353 arr_del(f->sp->u.array);
1354 PUT_ARR(f->sp, a);
1355 break;
1356
1357 default:
1358 kf_argerror(KF_RANGET, 1);
1359 }
1360
1361 return 0;
1362 }
1363 # endif
1364
1365
1366 # ifdef FUNCDEF
1367 FUNCDEF("[]", kf_range, pt_range)
1368 # else
1369 char pt_range[] = { C_STATIC, T_MIXED, 1, T_MIXED };
1370
1371 /*
1372 * NAME: kfun->range()
1373 * DESCRIPTION: value [ .. ]
1374 */
1375 int kf_range(f)
1376 register frame *f;
1377 {
1378 string *str;
1379 array *a;
1380
1381 if (f->sp->type == T_MAPPING) {
1382 a = map_range(f->data, f->sp->u.array, (value *) NULL, (value *) NULL);
1383 i_add_ticks(f, f->sp->u.array->size);
1384 arr_del(f->sp->u.array);
1385 PUT_MAP(f->sp, a);
1386
1387 return 0;
1388 }
1389
1390 switch (f->sp->type) {
1391 case T_STRING:
1392 i_add_ticks(f, 2);
1393 str = str_range(f->sp->u.string, 0L, f->sp->u.string->len - 1L);
1394 str_del(f->sp->u.string);
1395 PUT_STR(f->sp, str);
1396 break;
1397
1398 case T_ARRAY:
1399 a = arr_range(f->data, f->sp->u.array, 0L, f->sp->u.array->size - 1L);
1400 i_add_ticks(f, a->size);
1401 arr_del(f->sp->u.array);
1402 PUT_ARR(f->sp, a);
1403 break;
1404
1405 default:
1406 kf_argerror(KF_RANGE, 1);
1407 }
1408
1409 return 0;
1410 }
1411 # endif
1412
1413
1414 # ifdef FUNCDEF
1415 FUNCDEF(">>", kf_rshift, pt_rshift)
1416 # else
1417 char pt_rshift[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
1418
1419 /*
1420 * NAME: kfun->rshift()
1421 * DESCRIPTION: int >> int
1422 */
1423 int kf_rshift(f)
1424 register frame *f;
1425 {
1426 if (f->sp[1].type != T_INT) {
1427 kf_argerror(KF_RSHIFT, 1);
1428 }
1429 if (f->sp->type != T_INT) {
1430 kf_argerror(KF_RSHIFT, 2);
1431 }
1432 if ((f->sp->u.number & ~31) != 0) {
1433 if (f->sp->u.number < 0) {
1434 error("Negative right shift");
1435 }
1436 PUT_INT(&f->sp[1], 0);
1437 } else {
1438 PUT_INT(&f->sp[1], (Uint) f->sp[1].u.number >> f->sp->u.number);
1439 }
1440 f->sp++;
1441 return 0;
1442 }
1443 # endif
1444
1445
1446 # ifdef FUNCDEF
1447 FUNCDEF(">>", kf_rshift_int, pt_rshift_int)
1448 # else
1449 char pt_rshift_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
1450
1451 /*
1452 * NAME: kfun->rshift_int()
1453 * DESCRIPTION: int >> int
1454 */
1455 int kf_rshift_int(f)
1456 register frame *f;
1457 {
1458 if ((f->sp->u.number & ~31) != 0) {
1459 if (f->sp->u.number < 0) {
1460 error("Negative right shift");
1461 }
1462 PUT_INT(&f->sp[1], 0);
1463 } else {
1464 PUT_INT(&f->sp[1], (Uint) f->sp[1].u.number >> f->sp->u.number);
1465 }
1466 f->sp++;
1467 return 0;
1468 }
1469 # endif
1470
1471
1472 # ifdef FUNCDEF
1473 FUNCDEF("-", kf_sub, pt_sub)
1474 # else
1475 char pt_sub[] = { C_STATIC, T_MIXED, 2, T_MIXED, T_MIXED };
1476
1477 /*
1478 * NAME: kfun->sub()
1479 * DESCRIPTION: value - value
1480 */
1481 int kf_sub(f)
1482 register frame *f;
1483 {
1484 xfloat f1, f2;
1485
1486 switch (f->sp[1].type) {
1487 case T_INT:
1488 if (f->sp->type == T_INT) {
1489 PUT_INT(&f->sp[1], f->sp[1].u.number - f->sp->u.number);
1490 f->sp++;
1491 return 0;
1492 }
1493 break;
1494
1495 case T_FLOAT:
1496 if (f->sp->type == T_FLOAT) {
1497 i_add_ticks(f, 1);
1498 GET_FLT(f->sp, f2);
1499 f->sp++;
1500 GET_FLT(f->sp, f1);
1501 flt_sub(&f1, &f2);
1502 PUT_FLT(f->sp, f1);
1503 return 0;
1504 }
1505 break;
1506
1507 case T_ARRAY:
1508 if (f->sp->type == T_ARRAY) {
1509 array *a;
1510
1511 i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
1512 a = arr_sub(f->data, f->sp[1].u.array, f->sp->u.array);
1513 arr_del(f->sp->u.array);
1514 f->sp++;
1515 arr_del(f->sp->u.array);
1516 PUT_ARR(f->sp, a);
1517 return 0;
1518 }
1519 break;
1520
1521 case T_MAPPING:
1522 if (f->sp->type == T_ARRAY) {
1523 array *a;
1524
1525 i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
1526 a = map_sub(f->data, f->sp[1].u.array, f->sp->u.array);
1527 arr_del(f->sp->u.array);
1528 f->sp++;
1529 arr_del(f->sp->u.array);
1530 PUT_MAP(f->sp, a);
1531 return 0;
1532 }
1533 break;
1534
1535 default:
1536 kf_argerror(KF_SUB, 1);
1537 }
1538
1539 kf_argerror(KF_SUB, 2);
1540 }
1541 # endif
1542
1543
1544 # ifdef FUNCDEF
1545 FUNCDEF("-", kf_sub_int, pt_sub_int)
1546 # else
1547 char pt_sub_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
1548
1549 /*
1550 * NAME: kfun->sub_int()
1551 * DESCRIPTION: int - int
1552 */
1553 int kf_sub_int(f)
1554 register frame *f;
1555 {
1556 PUT_INT(&f->sp[1], f->sp[1].u.number - f->sp->u.number);
1557 f->sp++;
1558 return 0;
1559 }
1560 # endif
1561
1562
1563 # ifdef FUNCDEF
1564 FUNCDEF("--", kf_sub1, pt_sub1)
1565 # else
1566 char pt_sub1[] = { C_STATIC, T_MIXED, 1, T_MIXED };
1567
1568 /*
1569 * NAME: kfun->sub1()
1570 * DESCRIPTION: value--
1571 */
1572 int kf_sub1(f)
1573 register frame *f;
1574 {
1575 xfloat f1, f2;
1576
1577 if (f->sp->type == T_INT) {
1578 PUT_INT(f->sp, f->sp->u.number - 1);
1579 } else if (f->sp->type == T_FLOAT) {
1580 i_add_ticks(f, 1);
1581 GET_FLT(f->sp, f1);
1582 FLT_ONE(f2.high, f2.low);
1583 flt_sub(&f1, &f2);
1584 PUT_FLT(f->sp, f1);
1585 } else {
1586 kf_argerror(KF_SUB1, 1);
1587 }
1588 return 0;
1589 }
1590 # endif
1591
1592
1593 # ifdef FUNCDEF
1594 FUNCDEF("--", kf_sub1_int, pt_sub1_int)
1595 # else
1596 char pt_sub1_int[] = { C_STATIC, T_INT, 1, T_INT };
1597
1598 /*
1599 * NAME: kfun->sub1_int()
1600 * DESCRIPTION: int--
1601 */
1602 int kf_sub1_int(f)
1603 frame *f;
1604 {
1605 PUT_INT(f->sp, f->sp->u.number - 1);
1606 return 0;
1607 }
1608 # endif
1609
1610
1611 # ifdef FUNCDEF
1612 FUNCDEF("(float)", kf_tofloat, pt_tofloat)
1613 # else
1614 char pt_tofloat[] = { C_STATIC, T_FLOAT, 1, T_MIXED };
1615
1616 /*
1617 * NAME: kfun->tofloat()
1618 * DESCRIPTION: convert to float
1619 */
1620 int kf_tofloat(f)
1621 register frame *f;
1622 {
1623 xfloat flt;
1624
1625 i_add_ticks(f, 1);
1626 if (f->sp->type == T_INT) {
1627 /* from int */
1628 flt_itof(f->sp->u.number, &flt);
1629 PUT_FLTVAL(f->sp, flt);
1630 return 0;
1631 } else if (f->sp->type == T_STRING) {
1632 char *p;
1633
1634 /* from string */
1635 p = f->sp->u.string->text;
1636 if (!flt_atof(&p, &flt) ||
1637 p != f->sp->u.string->text + f->sp->u.string->len) {
1638 error("String cannot be converted to float");
1639 }
1640 str_del(f->sp->u.string);
1641 PUT_FLTVAL(f->sp, flt);
1642 return 0;
1643 }
1644
1645 if (f->sp->type != T_FLOAT) {
1646 error("Value is not a float");
1647 }
1648 return 0;
1649 }
1650 # endif
1651
1652
1653 # ifdef FUNCDEF
1654 FUNCDEF("(int)", kf_toint, pt_toint)
1655 # else
1656 char pt_toint[] = { C_STATIC, T_INT, 1, T_MIXED };
1657
1658 /*
1659 * NAME: kfun->toint()
1660 * DESCRIPTION: convert to integer
1661 */
1662 int kf_toint(f)
1663 register frame *f;
1664 {
1665 xfloat flt;
1666
1667 if (f->sp->type == T_FLOAT) {
1668 /* from float */
1669 i_add_ticks(f, 1);
1670 GET_FLT(f->sp, flt);
1671 PUT_INTVAL(f->sp, flt_ftoi(&flt));
1672 return 0;
1673 } else if (f->sp->type == T_STRING) {
1674 char *p;
1675 Int i;
1676
1677 /* from string */
1678 i = strtol(f->sp->u.string->text, &p, 10);
1679 if (p != f->sp->u.string->text + f->sp->u.string->len) {
1680 error("String cannot be converted to int");
1681 }
1682 str_del(f->sp->u.string);
1683 PUT_INTVAL(f->sp, i);
1684 return 0;
1685 }
1686
1687 if (f->sp->type != T_INT) {
1688 error("Value is not an int");
1689 }
1690 return 0;
1691 }
1692 # endif
1693
1694
1695 # ifdef FUNCDEF
1696 FUNCDEF("!!", kf_tst, pt_tst)
1697 # else
1698 char pt_tst[] = { C_STATIC, T_INT, 1, T_MIXED };
1699
1700 /*
1701 * NAME: kfun->tst()
1702 * DESCRIPTION: !! value
1703 */
1704 int kf_tst(f)
1705 register frame *f;
1706 {
1707 switch (f->sp->type) {
1708 case T_NIL:
1709 PUT_INTVAL(f->sp, FALSE);
1710 return 0;
1711
1712 case T_INT:
1713 PUT_INT(f->sp, (f->sp->u.number != 0));
1714 return 0;
1715
1716 case T_FLOAT:
1717 PUT_INTVAL(f->sp, !VFLT_ISZERO(f->sp));
1718 return 0;
1719
1720 case T_STRING:
1721 str_del(f->sp->u.string);
1722 break;
1723
1724 case T_ARRAY:
1725 case T_MAPPING:
1726 arr_del(f->sp->u.array);
1727 break;
1728 }
1729
1730 PUT_INTVAL(f->sp, TRUE);
1731 return 0;
1732 }
1733 # endif
1734
1735
1736 # ifdef FUNCDEF
1737 FUNCDEF("!!", kf_tst_int, pt_tst)
1738 # else
1739 /*
1740 * NAME: kfun->tst_int()
1741 * DESCRIPTION: !! int
1742 */
1743 int kf_tst_int(f)
1744 frame *f;
1745 {
1746 PUT_INT(f->sp, (f->sp->u.number != 0));
1747 return 0;
1748 }
1749 # endif
1750
1751
1752 # ifdef FUNCDEF
1753 FUNCDEF("unary -", kf_umin, pt_umin)
1754 # else
1755 char pt_umin[] = { C_STATIC, T_MIXED, 1, T_MIXED };
1756
1757 /*
1758 * NAME: kfun->umin()
1759 * DESCRIPTION: - mixed
1760 */
1761 int kf_umin(f)
1762 register frame *f;
1763 {
1764 xfloat flt;
1765
1766 switch (f->sp->type) {
1767 case T_INT:
1768 PUT_INT(f->sp, -f->sp->u.number);
1769 return 0;
1770
1771 case T_FLOAT:
1772 i_add_ticks(f, 1);
1773 if (!VFLT_ISZERO(f->sp)) {
1774 GET_FLT(f->sp, flt);
1775 FLT_NEG(flt.high, flt.low);
1776 PUT_FLT(f->sp, flt);
1777 }
1778 return 0;
1779 }
1780
1781 kf_argerror(KF_UMIN, 1);
1782 }
1783 # endif
1784
1785
1786 # ifdef FUNCDEF
1787 FUNCDEF("unary -", kf_umin_int, pt_umin_int)
1788 # else
1789 char pt_umin_int[] = { C_STATIC, T_INT, 1, T_INT };
1790
1791 /*
1792 * NAME: kfun->umin_int()
1793 * DESCRIPTION: - int
1794 */
1795 int kf_umin_int(f)
1796 frame *f;
1797 {
1798 PUT_INT(f->sp, -f->sp->u.number);
1799 return 0;
1800 }
1801 # endif
1802
1803
1804 # ifdef FUNCDEF
1805 FUNCDEF("^", kf_xor, pt_xor)
1806 # else
1807 char pt_xor[] = { C_STATIC, T_MIXED, 2, T_MIXED, T_MIXED };
1808
1809 /*
1810 * NAME: kfun->xor()
1811 * DESCRIPTION: value ^ value
1812 */
1813 int kf_xor(f)
1814 register frame *f;
1815 {
1816 array *a;
1817
1818 switch (f->sp[1].type) {
1819 case T_INT:
1820 if (f->sp->type == T_INT) {
1821 PUT_INT(&f->sp[1], f->sp[1].u.number ^ f->sp->u.number);
1822 f->sp++;
1823 return 0;
1824 }
1825 break;
1826
1827 case T_ARRAY:
1828 if (f->sp->type == T_ARRAY) {
1829 i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
1830 a = arr_setxadd(f->data, f->sp[1].u.array, f->sp->u.array);
1831 arr_del(f->sp->u.array);
1832 f->sp++;
1833 arr_del(f->sp->u.array);
1834 PUT_ARR(f->sp, a);
1835 return 0;
1836 }
1837 break;
1838
1839 default:
1840 kf_argerror(KF_XOR, 1);
1841 }
1842
1843 kf_argerror(KF_XOR, 2);
1844 }
1845 # endif
1846
1847
1848 # ifdef FUNCDEF
1849 FUNCDEF("^", kf_xor_int, pt_xor_int)
1850 # else
1851 char pt_xor_int[] = { C_STATIC, T_INT, 2, T_INT, T_INT };
1852
1853 /*
1854 * NAME: kfun->xor_int()
1855 * DESCRIPTION: int ^ int
1856 */
1857 int kf_xor_int(f)
1858 register frame *f;
1859 {
1860 PUT_INT(&f->sp[1], f->sp[1].u.number ^ f->sp->u.number);
1861 f->sp++;
1862 return 0;
1863 }
1864 # endif
1865
1866
1867 # ifdef FUNCDEF
1868 FUNCDEF("(string)", kf_tostring, pt_tostring)
1869 # else
1870 char pt_tostring[] = { C_STATIC, T_STRING, 1, T_MIXED };
1871
1872 /*
1873 * NAME: kfun->tostring()
1874 * DESCRIPTION: cast an int or float to a string
1875 */
1876 int kf_tostring(f)
1877 register frame *f;
1878 {
1879 char *num, buffer[18];
1880 xfloat flt;
1881
1882 i_add_ticks(f, 2);
1883 if (f->sp->type == T_INT) {
1884 /* from int */
1885 num = kf_itoa(f->sp->u.number, buffer);
1886 } else if (f->sp->type == T_FLOAT) {
1887 /* from float */
1888 i_add_ticks(f, 1);
1889 GET_FLT(f->sp, flt);
1890 flt_ftoa(&flt, num = buffer);
1891 } else if (f->sp->type == T_STRING) {
1892 return 0;
1893 } else {
1894 error("Value is not a string");
1895 }
1896
1897 PUT_STRVAL(f->sp, str_new(num, (long) strlen(num)));
1898 return 0;
1899 }
1900 # endif
1901
1902
1903 # ifdef FUNCDEF
1904 FUNCDEF("[]", kf_ckrangeft, pt_ckrangeft)
1905 # else
1906 char pt_ckrangeft[] = { C_STATIC, T_INT, 3, T_MIXED, T_INT, T_INT };
1907
1908 /*
1909 * NAME: kfun->ckrangeft()
1910 * DESCRIPTION: Check a [ from .. to ] subrange.
1911 * This function doesn't pop its arguments and returns nothing.
1912 */
1913 int kf_ckrangeft(f)
1914 register frame *f;
1915 {
1916 if (f->sp[1].type != T_INT) {
1917 kf_argerror(KF_CKRANGEFT, 2);
1918 }
1919 if (f->sp->type != T_INT) {
1920 kf_argerror(KF_CKRANGEFT, 3);
1921 }
1922 if (f->sp[2].type == T_STRING) {
1923 str_ckrange(f->sp[2].u.string, (long) f->sp[1].u.number,
1924 (long) f->sp->u.number);
1925 } else if (f->sp[2].type == T_ARRAY) {
1926 arr_ckrange(f->sp[2].u.array, (long) f->sp[1].u.number,
1927 (long) f->sp->u.number);
1928 } else {
1929 kf_argerror(KF_CKRANGEFT, 1);
1930 }
1931 return 0;
1932 }
1933 # endif
1934
1935
1936 # ifdef FUNCDEF
1937 FUNCDEF("[]", kf_ckrangef, pt_ckrangef)
1938 # else
1939 char pt_ckrangef[] = { C_STATIC, T_INT, 2, T_MIXED, T_INT };
1940
1941 /*
1942 * NAME: kfun->ckrangef()
1943 * DESCRIPTION: Check a [ from .. ] subrange, add missing index.
1944 * This function doesn't pop its arguments.
1945 */
1946 int kf_ckrangef(f)
1947 register frame *f;
1948 {
1949 if (f->sp->type != T_INT) {
1950 kf_argerror(KF_CKRANGEF, 2);
1951 }
1952 if (f->sp[1].type == T_STRING) {
1953 (--f->sp)->type = T_INT;
1954 f->sp->u.number = (Int) f->sp[2].u.string->len - 1;
1955 str_ckrange(f->sp[2].u.string, (long) f->sp[1].u.number,
1956 (long) f->sp->u.number);
1957 } else if (f->sp[1].type == T_ARRAY) {
1958 (--f->sp)->type = T_INT;
1959 f->sp->u.number = (Int) f->sp[2].u.array->size - 1;
1960 arr_ckrange(f->sp[2].u.array, (long) f->sp[1].u.number,
1961 (long) f->sp->u.number);
1962 } else {
1963 kf_argerror(KF_CKRANGEF, 1);
1964 }
1965 return 0;
1966 }
1967 # endif
1968
1969
1970 # ifdef FUNCDEF
1971 FUNCDEF("[]", kf_ckranget, pt_ckranget)
1972 # else
1973 char pt_ckranget[] = { C_STATIC, T_INT, 2, T_MIXED, T_INT };
1974
1975 /*
1976 * NAME: kfun->ckranget()
1977 * DESCRIPTION: Check a [ .. to ] subrange, add missing index.
1978 * This function doesn't pop its arguments.
1979 */
1980 int kf_ckranget(f)
1981 register frame *f;
1982 {
1983 if (f->sp->type != T_INT) {
1984 kf_argerror(KF_CKRANGET, 2);
1985 }
1986 if (f->sp[1].type == T_STRING) {
1987 str_ckrange(f->sp[1].u.string, 0L, (long) f->sp->u.number);
1988 } else if (f->sp[1].type == T_ARRAY) {
1989 arr_ckrange(f->sp[1].u.array, 0L, (long) f->sp->u.number);
1990 } else {
1991 kf_argerror(KF_CKRANGET, 1);
1992 }
1993
1994 --f->sp;
1995 f->sp[0] = f->sp[1];
1996 PUT_INT(&f->sp[1], 0);
1997 return 0;
1998 }
1999 # endif
2000
2001
2002 # ifdef FUNCDEF
2003 FUNCDEF("sum", kf_sum, pt_sum)
2004 # else
2005 char pt_sum[] = { C_KFUN_VARARGS | C_VARARGS | C_STATIC, T_MIXED, 0 };
2006
2007 /*
2008 * NAME: kfun->sum()
2009 * DESCRIPTION: perform a summand operation
2010 */
2011 int kf_sum(f, nargs)
2012 register frame *f;
2013 int nargs;
2014 {
2015 char buffer[12], *num;
2016 string *s;
2017 array *a;
2018 register value *v, *e1, *e2;
2019 register int i, type, vtype, nonint;
2020 register long size;
2021 register ssizet len;
2022 register Int result;
2023 register long isize;
2024
2025 /*
2026 * pass 1: check the types of everything and calculate the size
2027 */
2028 i_add_ticks(f, nargs);
2029 type = T_NIL;
2030 isize = size = 0;
2031 nonint = nargs;
2032 result = 0;
2033 for (v = f->sp, i = nargs; --i >= 0; v++) {
2034 if (v->u.number == -2) {
2035 /* simple term */
2036 v++;
2037 vtype = v->type;
2038 if (vtype == T_STRING) {
2039 size += v->u.string->len;
2040 } else if (vtype == T_ARRAY) {
2041 size += v->u.array->size;
2042 } else {
2043 size += strlen(kf_itoa(v->u.number, buffer));
2044 }
2045 } else if (v->u.number < -2) {
2046 /* aggregate */
2047 size += -3 - v->u.number;
2048 v += -3 - v->u.number;
2049 vtype = T_ARRAY;
2050 } else {
2051 /* subrange term */
2052 size += v->u.number - v[1].u.number + 1;
2053 v += 2;
2054 vtype = v->type;
2055 }
2056
2057 if (vtype == T_STRING || vtype == T_ARRAY) {
2058 nonint = i;
2059 isize = size;
2060 if (type == T_NIL && (vtype != T_ARRAY || i == nargs - 1)) {
2061 type = vtype;
2062 } else if (type != vtype) {
2063 error("Bad argument 2 for kfun +");
2064 }
2065 } else if (vtype != T_INT || type == T_ARRAY) {
2066 error("Bad argument %d for kfun +", (i == nargs - 1) ? 1 : 2);
2067 } else {
2068 result += v->u.number;
2069 }
2070 }
2071 if (nonint > 1) {
2072 size = isize + strlen(kf_itoa(result, buffer));
2073 }
2074
2075 /*
2076 * pass 2: build the string or array
2077 */
2078 result = 0;
2079 if (type == T_STRING) {
2080 s = str_new((char *) NULL, size);
2081 s->text[size] = '\0';
2082 for (v = f->sp, i = nargs; --i >= 0; v++) {
2083 if (v->u.number == -2) {
2084 /* simple term */
2085 v++;
2086 if (v->type == T_STRING) {
2087 size -= v->u.string->len;
2088 memcpy(s->text + size, v->u.string->text, v->u.string->len);
2089 str_del(v->u.string);
2090 result = 0;
2091 } else if (nonint < i) {
2092 num = kf_itoa(v->u.number, buffer);
2093 len = strlen(num);
2094 size -= len;
2095 memcpy(s->text + size, num, len);
2096 result = 0;
2097 } else {
2098 result += v->u.number;
2099 }
2100 } else {
2101 /* subrange */
2102 len = v->u.number - v[1].u.number + 1;
2103 size -= len;
2104 memcpy(s->text + size, v[2].u.string->text + v[1].u.number,
2105 len);
2106 v += 2;
2107 str_del(v->u.string);
2108 result = 0;
2109 }
2110 }
2111 if (nonint > 0) {
2112 num = kf_itoa(result, buffer);
2113 memcpy(s->text, num, strlen(num));
2114 }
2115
2116 f->sp = v - 1;
2117 PUT_STRVAL(f->sp, s);
2118 } else if (type == T_ARRAY) {
2119 a = arr_new(f->data, size);
2120 e1 = a->elts + size;
2121 for (v = f->sp, i = nargs; --i >= 0; v++) {
2122 if (v->u.number == -2) {
2123 /* simple term */
2124 v++;
2125 len = v->u.array->size;
2126 e2 = d_get_elts(v->u.array) + len;
2127 } else if (v->u.number < -2) {
2128 /* aggregate */
2129 for (len = -3 - v->u.number; len > 0; --len) {
2130 *--e1 = *++v;
2131 }
2132 continue;
2133 } else {
2134 /* subrange */
2135 len = v->u.number - v[1].u.number + 1;
2136 e2 = d_get_elts(v[2].u.array) + v->u.number + 1;
2137 v += 2;
2138 }
2139
2140 e1 -= len;
2141 i_copy(e1, e2 - len, len);
2142 arr_del(v->u.array);
2143 size -= len;
2144 }
2145
2146 f->sp = v - 1;
2147 d_ref_imports(a);
2148 PUT_ARRVAL(f->sp, a);
2149 } else {
2150 /* integers only */
2151 for (v = f->sp, i = nargs; --i > 0; v += 2) {
2152 result += v[1].u.number;
2153 }
2154
2155 f->sp = v + 1;
2156 f->sp->u.number += result;
2157 }
2158
2159 return 0;
2160 }
2161 # endif
2162
2163
2164 # ifdef FUNCDEF
2165 FUNCDEF("status", kf_status_idx, pt_status_idx)
2166 # else
2167 char pt_status_idx[] = { C_STATIC, T_MIXED, 1, T_INT };
2168
2169 /*
2170 * NAME: kfun->status_idx()
2171 * DESCRIPTION: return status()[idx]
2172 */
2173 int kf_status_idx(f)
2174 register frame *f;
2175 {
2176 if (f->sp->type != T_INT) {
2177 error("Non-numeric array index");
2178 }
2179 i_add_ticks(f, 6);
2180 if (!conf_statusi(f, f->sp->u.number, f->sp)) {
2181 error("Index out of range");
2182 }
2183 return 0;
2184 }
2185 # endif
2186
2187
2188 # ifdef FUNCDEF
2189 FUNCDEF("status", kf_statuso_idx, pt_statuso_idx)
2190 # else
2191 char pt_statuso_idx[] = { C_STATIC, T_MIXED, 2, T_OBJECT, T_INT };
2192
2193 /*
2194 * NAME: kfun->statuso_idx()
2195 * DESCRIPTION: return status(obj)[idx]
2196 */
2197 int kf_statuso_idx(f)
2198 register frame *f;
2199 {
2200 if (f->sp[1].type != T_OBJECT) {
2201 return 1;
2202 }
2203 if (f->sp->type != T_INT) {
2204 error("Non-numeric array index");
2205 }
2206 i_add_ticks(f, 6);
2207 if (!conf_objecti(f->data, OBJR(f->sp[1].oindex), f->sp->u.number,
2208 &f->sp[1])) {
2209 error("Index out of range");
2210 }
2211 f->sp++;
2212 return 0;
2213 }
2214 # endif
2215
2216
2217 # ifdef FUNCDEF
2218 FUNCDEF("call_trace", kf_calltr_idx, pt_calltr_idx)
2219 # else
2220 char pt_calltr_idx[] = { C_STATIC, T_MIXED | (1 << REFSHIFT), 1, T_INT };
2221
2222 /*
2223 * NAME: kfun->calltr_idx()
2224 * DESCRIPTION: return call_trace()[idx]
2225 */
2226 int kf_calltr_idx(f)
2227 register frame *f;
2228 {
2229 if (f->sp->type != T_INT) {
2230 error("Non-numeric array index");
2231 }
2232 i_add_ticks(f, 10);
2233 if (!i_call_tracei(f, f->sp->u.number, f->sp)) {
2234 error("Index out of range");
2235 }
2236 return 0;
2237 }
2238 # endif
2239
2240
2241 # ifdef FUNCDEF
2242 FUNCDEF("nil", kf_nil, pt_nil)
2243 # else
2244 char pt_nil[] = { C_STATIC, T_NIL, 0 };
2245
2246 /*
2247 * NAME: kfun->nil()
2248 * DESCRIPTION: return nil
2249 */
2250 int kf_nil(f)
2251 register frame *f;
2252 {
2253 *--f->sp = nil_value;
2254 return 0;
2255 }
2256 # endif
2257
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.