1/* -*- mode: C -*- */ 2 3/* Some "inline" functions for generic scalar types */ 4 5#if SLANG_HAS_FLOAT 6# ifndef IS_INFINITY 7# ifdef HAVE_INF 8# define IS_INFINITY(x) isinf(x) 9# else 10# define IS_INFINITY(x) _pSLmath_isinf(x) 11# endif 12# endif 13#endif 14 15#ifdef TRANSPOSE_2D_ARRAY 16static SLang_Array_Type *TRANSPOSE_2D_ARRAY (SLang_Array_Type *at, SLang_Array_Type *bt) 17{ 18 GENERIC_TYPE *a_data, *b_data; 19 SLindex_Type nr, nc, i; 20 21 nr = at->dims[0]; 22 nc = at->dims[1]; 23 24 a_data = (GENERIC_TYPE *) at->data; 25 b_data = (GENERIC_TYPE *) bt->data; 26 27 for (i = 0; i < nr; i++) 28 { 29 GENERIC_TYPE *offset = b_data + i; 30 int j; 31 for (j = 0; j < nc; j++) 32 { 33 *offset = *a_data++; 34 offset += nr; 35 } 36 } 37 return bt; 38} 39#undef TRANSPOSE_2D_ARRAY 40#endif 41 42#ifdef INNERPROD_FUNCTION 43 44static void INNERPROD_FUNCTION 45 (SLang_Array_Type *at, SLang_Array_Type *bt, SLang_Array_Type *ct, 46 SLuindex_Type a_loops, SLuindex_Type a_stride, 47 SLuindex_Type b_loops, SLuindex_Type b_inc, 48 SLuindex_Type inner_loops) 49{ 50 GENERIC_TYPE_A *a; 51 GENERIC_TYPE_B *b; 52 GENERIC_TYPE_C *c; 53 SLuindex_Type kmin; 54 SLuindex_Type block = Inner_Prod_Block_Size; 55 56 block *= sizeof (double)/sizeof(GENERIC_TYPE_B); 57 58 c = (GENERIC_TYPE_C *) ct->data; 59 b = (GENERIC_TYPE_B *) bt->data; 60 a = (GENERIC_TYPE_A *) at->data; 61#if 1 62 for (kmin = 0; kmin < inner_loops; kmin += block) 63 { 64 SLuindex_Type jmin; 65 SLuindex_Type kmax = kmin + block; 66 if (kmax > inner_loops) kmax = inner_loops; 67 68 for (jmin = 0; jmin < b_loops; jmin += block) 69 { 70 SLuindex_Type i; 71 SLuindex_Type jmax = jmin + block; 72 if (jmax > b_loops) jmax = b_loops; 73 74 for (i = 0; i < a_loops; i++) 75 { 76 GENERIC_TYPE_A *aa = a + i * a_stride; 77 GENERIC_TYPE_C *cc = c + i * b_loops; 78 SLuindex_Type k; 79 80 for (k = kmin; k < kmax; k++) 81 { 82 double x = (double) aa[k]; 83 84 if (x != 0.0) 85 { 86 SLuindex_Type j; 87 GENERIC_TYPE_B *bb = b + b_inc*k; 88 89 j = jmin; 90 if (j + 8 < jmax) 91 { 92 SLuindex_Type jmax1 = jmax - 8; 93 while (j < jmax1) 94 { 95 cc[j] += x * bb[j]; j++; 96 cc[j] += x * bb[j]; j++; 97 cc[j] += x * bb[j]; j++; 98 cc[j] += x * bb[j]; j++; 99 cc[j] += x * bb[j]; j++; 100 cc[j] += x * bb[j]; j++; 101 cc[j] += x * bb[j]; j++; 102 cc[j] += x * bb[j]; j++; 103 } 104 } 105 while (j < jmax) 106 { 107 cc[j] += x * bb[j]; j++; 108 } 109 } 110 } 111 } 112 } 113 } 114#else 115 while (a_loops--) 116 { 117 GENERIC_TYPE_B *bb; 118 SLuindex_Type j; 119 120 bb = b; 121 122 for (j = 0; j < inner_loops; j++) 123 { 124 double x = (double) a[j]; 125 126 if (x != 0.0) 127 { 128 SLuindex_Type k; 129 130 for (k = 0; k < b_loops; k++) 131 c[k] += x * bb[k]; 132 } 133 bb += b_inc; 134 } 135 c += b_loops; 136 a += a_stride; 137 } 138#endif 139} 140#undef INNERPROD_FUNCTION 141 142#undef GENERIC_TYPE_A 143#undef GENERIC_TYPE_B 144#undef GENERIC_TYPE_C 145#endif 146 147#ifdef INNERPROD_COMPLEX_A 148static void INNERPROD_COMPLEX_A 149 (SLang_Array_Type *at, SLang_Array_Type *bt, SLang_Array_Type *ct, 150 SLuindex_Type a_loops, SLuindex_Type a_stride, 151 SLuindex_Type b_loops, SLuindex_Type b_inc, 152 SLuindex_Type inner_loops) 153{ 154 double *a; 155 GENERIC_TYPE *b; 156 double *c; 157 158 c = (double *) ct->data; 159 b = (GENERIC_TYPE *) bt->data; 160 a = (double *) at->data; 161 162 a_stride *= 2; 163 164 while (a_loops--) 165 { 166 GENERIC_TYPE *bb; 167 SLuindex_Type bb_loops; 168 169 bb = b; 170 bb_loops = b_loops; 171 172 while (bb_loops--) 173 { 174 double real_sum; 175 double imag_sum; 176 SLuindex_Type iloops; 177 double *aa; 178 GENERIC_TYPE *bbb; 179 180 aa = a; 181 bbb = bb; 182 iloops = inner_loops; 183 184 real_sum = 0.0; 185 imag_sum = 0.0; 186 while (iloops--) 187 { 188 real_sum += aa[0] * (double)bbb[0]; 189 imag_sum += aa[1] * (double)bbb[0]; 190 aa += 2; 191 bbb += b_inc; 192 } 193 194 *c++ = real_sum; 195 *c++ = imag_sum; 196 bb++; 197 } 198 199 a += a_stride; 200 } 201} 202 203static void INNERPROD_A_COMPLEX 204 (SLang_Array_Type *at, SLang_Array_Type *bt, SLang_Array_Type *ct, 205 SLuindex_Type a_loops, SLuindex_Type a_stride, 206 SLuindex_Type b_loops, SLuindex_Type b_inc, 207 SLuindex_Type inner_loops) 208{ 209 GENERIC_TYPE *a; 210 double *b; 211 double *c; 212 213 c = (double *) ct->data; 214 b = (double *) bt->data; 215 a = (GENERIC_TYPE *) at->data; 216 217 b_inc *= 2; 218 219 while (a_loops--) 220 { 221 double *bb; 222 SLuindex_Type bb_loops; 223 224 bb = b; 225 bb_loops = b_loops; 226 227 while (bb_loops--) 228 { 229 double real_sum; 230 double imag_sum; 231 SLuindex_Type iloops; 232 GENERIC_TYPE *aa; 233 double *bbb; 234 235 aa = a; 236 bbb = bb; 237 iloops = inner_loops; 238 239 real_sum = 0.0; 240 imag_sum = 0.0; 241 while (iloops--) 242 { 243 real_sum += (double)aa[0] * bbb[0]; 244 imag_sum += (double)aa[0] * bbb[1]; 245 aa += 1; 246 bbb += b_inc; 247 } 248 249 *c++ = real_sum; 250 *c++ = imag_sum; 251 bb += 2; 252 } 253 254 a += a_stride; 255 } 256} 257 258#undef INNERPROD_A_COMPLEX 259#undef INNERPROD_COMPLEX_A 260#endif /* INNERPROD_COMPLEX_A */ 261 262#ifdef INNERPROD_COMPLEX_COMPLEX 263static void INNERPROD_COMPLEX_COMPLEX 264 (SLang_Array_Type *at, SLang_Array_Type *bt, SLang_Array_Type *ct, 265 SLuindex_Type a_loops, SLuindex_Type a_stride, 266 SLuindex_Type b_loops, SLuindex_Type b_inc, 267 SLuindex_Type inner_loops) 268{ 269 double *a; 270 double *b; 271 double *c; 272 273 c = (double *) ct->data; 274 b = (double *) bt->data; 275 a = (double *) at->data; 276 277 a_stride *= 2; 278 b_inc *= 2; 279 280 while (a_loops--) 281 { 282 double *bb; 283 SLuindex_Type bb_loops; 284 285 bb = b; 286 bb_loops = b_loops; 287 288 while (bb_loops--) 289 { 290 double real_sum; 291 double imag_sum; 292 SLuindex_Type iloops; 293 double *aa; 294 double *bbb; 295 296 aa = a; 297 bbb = bb; 298 iloops = inner_loops; 299 300 real_sum = 0.0; 301 imag_sum = 0.0; 302 while (iloops--) 303 { 304 real_sum += aa[0]*bbb[0] - aa[1]*bbb[1]; 305 imag_sum += aa[0]*bbb[1] + aa[1]*bbb[0]; 306 aa += 2; 307 bbb += b_inc; 308 } 309 310 *c++ = real_sum; 311 *c++ = imag_sum; 312 bb += 2; 313 } 314 315 a += a_stride; 316 } 317} 318#undef INNERPROD_COMPLEX_COMPLEX 319#endif 320 321#ifdef SUM_FUNCTION 322#if SLANG_HAS_FLOAT 323static int SUM_FUNCTION (VOID_STAR xp, SLuindex_Type inc, SLuindex_Type num, VOID_STAR yp) 324{ 325 GENERIC_TYPE *x, *xmax; 326 double sum, sumerr; 327 328 x = (GENERIC_TYPE *) xp; 329 xmax = x + num; 330 331 sumerr = 0.0; 332 sum = 0.0; 333 while (x < xmax) 334 { 335 double v = *x - sumerr; 336 double new_sum = sum + v; 337 sumerr = (new_sum - sum) - v; 338 sum = new_sum; 339 x += inc; 340 } 341 *(SUM_RESULT_TYPE *)yp = (SUM_RESULT_TYPE) sum; 342 return 0; 343} 344#endif /* SLANG_HAS_FLOAT */ 345#undef SUM_FUNCTION 346#endif 347 348#ifdef SUMSQ_FUNCTION 349#if SLANG_HAS_FLOAT 350static int SUMSQ_FUNCTION (VOID_STAR xp, SLuindex_Type inc, SLuindex_Type num, VOID_STAR yp) 351{ 352 GENERIC_TYPE *x, *xmax; 353 double sum, sumerr; 354 355 sum = 0.0; 356 sumerr = 0.0; 357 358 x = (GENERIC_TYPE *) xp; 359 xmax = x + num; 360 while (x < xmax) 361 { 362 double v = (double)(*x) * (double)(*x) - sumerr; 363 double new_sum = sum + v; 364 sumerr = (new_sum - sum) - v; 365 sum = new_sum; 366 x += inc; 367 } 368 *(SUM_RESULT_TYPE *)yp = (SUM_RESULT_TYPE) sum; 369 return 0; 370} 371#endif /* SLANG_HAS_FLOAT */ 372#undef SUMSQ_FUNCTION 373#endif 374#undef SUM_RESULT_TYPE 375 376#ifdef MIN_FUNCTION 377static int 378MIN_FUNCTION (VOID_STAR ip, SLuindex_Type inc, SLuindex_Type num, VOID_STAR sp) 379{ 380 SLuindex_Type n, n0; 381 GENERIC_TYPE m; 382 GENERIC_TYPE *i = (GENERIC_TYPE *)ip; 383 384 if (-1 == check_for_empty_array ("min", num)) 385 return -1; 386 387# ifdef IS_NAN_FUNCTION 388 n0 = 0; 389 do 390 { 391 m = i[n0]; 392 n0 += inc; 393 } 394 while (IS_NAN_FUNCTION(m) && (n0 < num)); 395# else 396 m = i[0]; 397 n0 = inc; 398# endif 399 400 for (n = n0; n < num; n += inc) 401 if (m > i[n]) m = i[n]; 402 403 *(GENERIC_TYPE *)sp = m; 404 return 0; 405} 406#undef MIN_FUNCTION 407#endif 408 409#ifdef MINABS_FUNCTION 410static int 411MINABS_FUNCTION (VOID_STAR ip, SLuindex_Type inc, SLuindex_Type num, VOID_STAR sp) 412{ 413 SLuindex_Type n, n0; 414 GENERIC_TYPE m; 415 GENERIC_TYPE *i = (GENERIC_TYPE *)ip; 416 417 if (-1 == check_for_empty_array ("minabs", num)) 418 return -1; 419 420# ifdef IS_NAN_FUNCTION 421 n0 = 0; 422 do 423 { 424 m = ABS_FUNCTION(i[n0]); 425 n0 += inc; 426 } 427 while (IS_NAN_FUNCTION(m) && (n0 < num)); 428# else 429 m = ABS_FUNCTION(i[0]); 430 n0 = inc; 431# endif 432 433 for (n = n0; n < num; n += inc) 434 if (m > ABS_FUNCTION(i[n])) m = ABS_FUNCTION(i[n]); 435 436 *(GENERIC_TYPE *)sp = m; 437 return 0; 438} 439#undef MINABS_FUNCTION 440#endif 441 442#ifdef MAX_FUNCTION 443static int 444MAX_FUNCTION (VOID_STAR ip, SLuindex_Type inc, SLuindex_Type num, VOID_STAR s) 445{ 446 SLuindex_Type n, n0; 447 GENERIC_TYPE m; 448 GENERIC_TYPE *i = (GENERIC_TYPE *) ip; 449 450 if (-1 == check_for_empty_array ("max", num)) 451 return -1; 452 453# ifdef IS_NAN_FUNCTION 454 n0 = 0; 455 do 456 { 457 m = i[n0]; 458 n0 += inc; 459 } 460 while (IS_NAN_FUNCTION(m) && (n0 < num)); 461# else 462 m = i[0]; 463 n0 = inc; 464# endif 465 466 for (n = n0; n < num; n += inc) 467 if (m < i[n]) m = i[n]; 468 469 *(GENERIC_TYPE *)s = m; 470 return 0; 471} 472#undef MAX_FUNCTION 473#endif 474 475#ifdef MAXABS_FUNCTION 476static int 477MAXABS_FUNCTION (VOID_STAR ip, SLuindex_Type inc, SLuindex_Type num, VOID_STAR s) 478{ 479 SLuindex_Type n, n0; 480 GENERIC_TYPE m; 481 GENERIC_TYPE *i = (GENERIC_TYPE *) ip; 482 483 if (-1 == check_for_empty_array ("maxabs", num)) 484 return -1; 485 486# ifdef IS_NAN_FUNCTION 487 n0 = 0; 488 do 489 { 490 m = ABS_FUNCTION(i[n0]); 491 n0 += inc; 492 } 493 while (IS_NAN_FUNCTION(m) && (n0 < num)); 494# else 495 m = ABS_FUNCTION(i[0]); 496 n0 = inc; 497# endif 498 499 for (n = n0; n < num; n += inc) 500 if (m < ABS_FUNCTION(i[n])) m = ABS_FUNCTION(i[n]); 501 502 *(GENERIC_TYPE *)s = m; 503 return 0; 504} 505#undef MAXABS_FUNCTION 506#endif 507 508#ifdef ANY_FUNCTION 509static int 510ANY_FUNCTION (VOID_STAR ip, SLuindex_Type inc, SLuindex_Type num, VOID_STAR s) 511{ 512 SLuindex_Type n; 513 GENERIC_TYPE *i = (GENERIC_TYPE *) ip; 514 515 for (n = 0; n < num; n += inc) 516 if (i[n] != 0) 517 { 518#ifdef IS_NAN_FUNCTION 519 if (IS_NAN_FUNCTION(i[n])) 520 continue; 521#endif 522 *(char *)s = 1; 523 return 0; 524 } 525 526 *(char *)s = 0; 527 return 0; 528} 529#undef ANY_FUNCTION 530#endif 531 532#ifdef ALL_FUNCTION 533static int 534ALL_FUNCTION (VOID_STAR ip, SLuindex_Type inc, SLuindex_Type num, VOID_STAR s) 535{ 536 SLuindex_Type n; 537 GENERIC_TYPE *i = (GENERIC_TYPE *) ip; 538 539 if (num == 0) 540 { 541 *(char *)s = 0; 542 return 0; 543 } 544 for (n = 0; n < num; n += inc) 545 { 546 if (i[n] == (GENERIC_TYPE)0) 547 { 548 *(char *)s = 0; 549 return 0; 550 } 551#ifdef IS_NAN_FUNCTION 552 /* I really do not want to call this for all numbers, nor do I know 553 * what makes most sense. Doing nothing means that all(_NaN) is 1. 554 * Such an interpretation is consistent with using 555 * length(x) == length(where (x)) 556 */ 557#endif 558 } 559 560 *(char *)s = 1; 561 return 0; 562} 563#undef ALL_FUNCTION 564#endif 565 566#ifdef CUMSUM_FUNCTION 567#ifdef SLANG_HAS_FLOAT 568static int 569CUMSUM_FUNCTION (SLtype xtype, VOID_STAR xp, SLuindex_Type inc, 570 SLuindex_Type num, 571 SLtype ytype, VOID_STAR yp, VOID_STAR clientdata) 572{ 573 GENERIC_TYPE *x, *xmax; 574 CUMSUM_RESULT_TYPE *y; 575 double c; 576 double cerr; 577 578 (void) xtype; 579 (void) ytype; 580 (void) clientdata; 581 582 x = (GENERIC_TYPE *) xp; 583 y = (CUMSUM_RESULT_TYPE *) yp; 584 xmax = x + num; 585 586 c = 0.0; 587 cerr = 0.0; 588 while (x < xmax) 589 { 590 double d = (double) *x - cerr; 591 double c1 = c + d; 592 cerr = (c1 - c) - d; 593 c = c1; 594 *y = (CUMSUM_RESULT_TYPE) c; 595 x += inc; 596 y += inc; 597 } 598 return 0; 599} 600#endif /* SLANG_HAS_FLOAT */ 601#undef CUMSUM_FUNCTION 602#undef CUMSUM_RESULT_TYPE 603#endif 604 605#ifdef PROD_FUNCTION 606#if SLANG_HAS_FLOAT 607static int PROD_FUNCTION (VOID_STAR xp, SLuindex_Type inc, SLuindex_Type num, VOID_STAR yp) 608{ 609 GENERIC_TYPE *x, *xmax; 610 double prod; 611 612 prod = 1.0; 613 614 x = (GENERIC_TYPE *) xp; 615 xmax = x + num; 616 while (x < xmax) 617 { 618 prod *= (double) *x; 619 x += inc; 620 } 621 *(PROD_RESULT_TYPE *)yp = (PROD_RESULT_TYPE) (prod); 622 return 0; 623} 624#endif /* SLANG_HAS_FLOAT */ 625#undef PROD_FUNCTION 626#undef PROD_RESULT_TYPE 627#endif 628 629#ifdef WHEREFIRSTMAX_FUNC 630static int WHEREFIRSTMAX_FUNC (VOID_STAR xp, SLuindex_Type inc, SLuindex_Type num, VOID_STAR yp) 631{ 632 GENERIC_TYPE *x; 633 SLuindex_Type i, imax; 634 GENERIC_TYPE maxval; 635 636 if (-1 == check_for_empty_array ("wherefirstmax", num)) 637 return -1; 638 639 x = (GENERIC_TYPE *) xp; 640 641# ifdef IS_NAN_FUNCTION 642 i = 0; 643 do 644 { 645 maxval = x[i]; 646 imax = i; 647 i += inc; 648 } 649 while (IS_NAN_FUNCTION(maxval) && (i < num)); 650# else 651 maxval = x[0]; 652 imax = 0; 653# endif 654 655 for (i = imax+inc; i < num; i += inc) 656 { 657 if (maxval < x[i]) 658 { 659 imax = i; 660 maxval = x[i]; 661 } 662 } 663 *(SLuindex_Type *)yp = imax; 664 return 0; 665} 666# undef WHEREFIRSTMAX_FUNC 667#endif 668 669#ifdef WHERELASTMAX_FUNC 670static int WHERELASTMAX_FUNC (VOID_STAR xp, SLuindex_Type inc, SLuindex_Type num, VOID_STAR yp) 671{ 672 GENERIC_TYPE *x; 673 SLuindex_Type i, imax; 674 GENERIC_TYPE maxval; 675 676 if (-1 == check_for_empty_array ("wherelastmax", num)) 677 return -1; 678 679 x = (GENERIC_TYPE *) xp; 680 681# ifdef IS_NAN_FUNCTION 682 i = 0; 683 do 684 { 685 maxval = x[i]; 686 imax = i; 687 i += inc; 688 } 689 while (IS_NAN_FUNCTION(maxval) && (i < num)); 690# else 691 maxval = x[0]; 692 imax = 0; 693# endif 694 695 for (i = imax+inc; i < num; i += inc) 696 { 697 if (maxval <= x[i]) 698 { 699 imax = i; 700 maxval = x[i]; 701 } 702 } 703 *(SLuindex_Type *)yp = imax; 704 return 0; 705} 706# undef WHERELASTMAX_FUNC 707#endif 708 709#ifdef WHEREFIRSTMIN_FUNC 710static int WHEREFIRSTMIN_FUNC (VOID_STAR xp, SLuindex_Type inc, SLuindex_Type num, VOID_STAR yp) 711{ 712 GENERIC_TYPE *x; 713 SLuindex_Type i, imin; 714 GENERIC_TYPE minval; 715 716 if (-1 == check_for_empty_array ("wherefirstmin", num)) 717 return -1; 718 719 x = (GENERIC_TYPE *) xp; 720 721# ifdef IS_NAN_FUNCTION 722 i = 0; 723 do 724 { 725 minval = x[i]; 726 imin = i; 727 i += inc; 728 } 729 while (IS_NAN_FUNCTION(minval) && (i < num)); 730# else 731 minval = x[0]; 732 imin = 0; 733# endif 734 735 for (i = imin+inc; i < num; i += inc) 736 { 737 if (minval > x[i]) 738 { 739 imin = i; 740 minval = x[i]; 741 } 742 } 743 *(SLuindex_Type *)yp = imin; 744 return 0; 745} 746# undef WHEREFIRSTMIN_FUNC 747#endif 748 749#ifdef WHERELASTMIN_FUNC 750static int WHERELASTMIN_FUNC (VOID_STAR xp, SLuindex_Type inc, SLuindex_Type num, VOID_STAR yp) 751{ 752 GENERIC_TYPE *x; 753 SLuindex_Type i, imin; 754 GENERIC_TYPE minval; 755 756 if (-1 == check_for_empty_array ("wherefirstmin", num)) 757 return -1; 758 759 x = (GENERIC_TYPE *) xp; 760 761# ifdef IS_NAN_FUNCTION 762 i = 0; 763 do 764 { 765 minval = x[i]; 766 imin = i; 767 i += inc; 768 } 769 while (IS_NAN_FUNCTION(minval) && (i < num)); 770# else 771 minval = x[0]; 772 imin = 0; 773# endif 774 775 for (i = imin+inc; i < num; i += inc) 776 { 777 if (minval >= x[i]) 778 { 779 imin = i; 780 minval = x[i]; 781 } 782 } 783 *(SLuindex_Type *)yp = imin; 784 return 0; 785} 786# undef WHERELASTMIN_FUNC 787#endif 788 789#ifdef DO_WHEREFIRST_OP_FUNC 790static int DO_WHEREFIRST_OP_FUNC (SLang_Array_Type *at, int op, GENERIC_TYPE_B b, SLindex_Type istart) 791{ 792 GENERIC_TYPE_A *a; 793 SLindex_Type i, num_elements; 794 795 a = (GENERIC_TYPE_A *) at->data; 796 num_elements = (SLindex_Type) at->num_elements; 797 798# define WHEREFIRST_CASE_BODY(cop) \ 799 i = istart; while ((i < num_elements) && (0 == (a[i] cop b))) i++; 800 801 switch (op) 802 { 803 case SLANG_EQ: WHEREFIRST_CASE_BODY(==); break; 804 case SLANG_NE: WHEREFIRST_CASE_BODY(!=); break; 805 case SLANG_GT: WHEREFIRST_CASE_BODY( >); break; 806 case SLANG_GE: WHEREFIRST_CASE_BODY(>=); break; 807 case SLANG_LT: WHEREFIRST_CASE_BODY( <); break; 808 case SLANG_LE: WHEREFIRST_CASE_BODY(<=); break; 809 default: 810 SLang_verror (SL_Internal_Error, "Unexpected op: %d\n", op); 811 return -1; 812 } 813 814 if (i < num_elements) 815 return SLang_push_array_index (i); 816 817 return SLang_push_null (); 818} 819#undef WHEREFIRST_CASE_BODY 820#undef DO_WHEREFIRST_OP_FUNC 821#endif 822 823#ifdef DO_WHERELAST_OP_FUNC 824static int DO_WHERELAST_OP_FUNC (SLang_Array_Type *at, int op, GENERIC_TYPE_B b, SLindex_Type istart) 825{ 826 GENERIC_TYPE_A *a; 827 SLindex_Type num_elements; 828 829 a = (GENERIC_TYPE_A *) at->data; 830 num_elements = (SLindex_Type) at->num_elements; 831 if (istart >= num_elements) istart = num_elements-1; 832 833# define WHERELAST_CASE_BODY(cop) \ 834 while ((istart >= 0) && (0 == (a[istart] cop b))) istart-- 835 836 switch (op) 837 { 838 case SLANG_EQ: WHERELAST_CASE_BODY(==); break; 839 case SLANG_NE: WHERELAST_CASE_BODY(!=); break; 840 case SLANG_GT: WHERELAST_CASE_BODY( >); break; 841 case SLANG_GE: WHERELAST_CASE_BODY(>=); break; 842 case SLANG_LT: WHERELAST_CASE_BODY( <); break; 843 case SLANG_LE: WHERELAST_CASE_BODY(<=); break; 844 default: 845 SLang_verror (SL_Internal_Error, "Unexpected op: %d\n", op); 846 return -1; 847 } 848 849 if (istart >= 0) 850 return SLang_push_array_index (istart); 851 852 return SLang_push_null (); 853} 854#undef WHERELAST_CASE_BODY 855#undef DO_WHERELAST_OP_FUNC 856#endif 857 858#ifdef GENERIC_TYPE_A 859# undef GENERIC_TYPE_A 860#endif 861 862#ifdef GENERIC_TYPE_B 863# undef GENERIC_TYPE_B 864#endif 865 866#ifdef GENERIC_TYPE 867# undef GENERIC_TYPE 868#endif 869 870#ifdef IS_NAN_FUNCTION 871# undef IS_NAN_FUNCTION 872#endif 873 874#ifdef ABS_FUNCTION 875# undef ABS_FUNCTION 876#endif 877