regina/regutil/regstem.c

   1 /* Stem and variable manipulation functions for regutil
   2  *
   3  * The contents of this file are subject to the Mozilla Public License
   4  * Version 1.0 (the "License"); you may not use this file except in
   5  * compliance with the License. You may obtain a copy of the License at
   6  * http://www.mozilla.org/MPL/
   7  *
   8  * Software distributed under the License is distributed on an "AS IS"
   9  * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
  10  * License for the specific language governing rights and limitations
  11  * under the License.
  12  *
  13  * The Original Code is regutil.
  14  *
  15  * The Initial Developer of the Original Code is Patrick TJ McPhee.
  16  * Portions created by Patrick McPhee are Copyright © 1998, 2001
  17  * Patrick TJ McPhee. All Rights Reserved.
  18  *
  19  * Contributors:
  20  *
  21  * $Header: /opt/cvs/Regina/regutil/regstem.c,v 1.5 2009/11/23 23:24:35 mark Exp $
  22  */
  23
  24 /* ******************************************************************** */
  25 /* ************************** Stem Routines *************************** */
  26 /* ******************************************************************** */
  27
  28 #include "regutil.h"
  29 #include <ctype.h>
  30
  31 /* compare two strings case-sensitively */
  32 static int rxstrcmp(const PRXSTRING l, const PRXSTRING r)
  33 {
  34    register int len = min(l->strlength, r->strlength),
  35                 d = l->strlength - r->strlength,
  36                 c = memcmp(l->strptr, r->strptr, len);
  37
  38    return c ? c : d;
  39 }
  40
  41 /* case-insensitive comparison of two regions of memory */
  42 static int casecmp(const unsigned char * l, const unsigned char * r, const int len)
  43 {
  44    register int i, c;
  45    for (i = c = 0; !c && i < len; i++)
  46       c = toupper(l[i]) - toupper(r[i]);
  47
  48    return c;
  49 }
  50
  51 /* compare two strings case-insensitively */
  52 static int rxstrcasecmp(const PRXSTRING l, const PRXSTRING r)
  53 {
  54    register int len = min(l->strlength, r->strlength),
  55                 d = l->strlength - r->strlength,
  56                 c = casecmp(l->strptr, r->strptr, len);
  57
  58    return (len && c) ? c : d;
  59 }
  60
  61 static int rxstrcmpbackwards(const PRXSTRING l, const PRXSTRING r)
  62 {
  63    return rxstrcmp(r, l);
  64 }
  65
  66 static int rxstrcasecmpbackwards(const PRXSTRING l, const PRXSTRING r)
  67 {
  68    return rxstrcasecmp(r, l);
  69 }
  70
  71 /* either map a file into memory or allocate a buffer */
  72 #ifdef HAVE_MMAP
  73 # include <unistd.h>
  74 # include <fcntl.h>
  75 # ifdef HAVE_SYS_MMAN_H
  76 #  include <sys/mman.h>
  77 # endif
  78 # include <sys/stat.h>
  79
  80 # ifndef MAP_FAILED
  81 #  define MAP_FAILED ((void *)-1)
  82 # endif
  83
  84 char * mapfile(const char * name, int * len)
  85 {
  86    int fd;
  87    struct stat st;
  88    char * s;
  89
  90    if ((fd = open(name, O_RDONLY)) == -1 || fstat(fd, &st)) {
  91       if (fd != -1)
  92          close(fd);
  93       return NULL;
  94    }
  95
  96    s = mmap(NULL, st.st_size, PROT_READ, MAP_PRIVATE, fd, 0);
  97    close(fd);
  98
  99    if (s == MAP_FAILED)
 100       return NULL;
 101
 102    *len = st.st_size;
 103    return s;
 104 }
 105
 106 int unmapfile(char *buf, int size)
 107 {
 108    if (buf == NULL)
 109       return -1;
 110    else
 111       return munmap(buf, size);
 112 }
 113
 114 #elif defined(MAPVIEWOFFILE)
 115
 116 #include <windows.h>
 117
 118 /* open a file and create a memory mapping to it */
 119 char * mapfile(const char * s, int *len)
 120 {
 121    HFILE fh;
 122    HANDLE hShm;
 123    char * buf;
 124    OFSTRUCT ofs;
 125    BY_HANDLE_FILE_INFORMATION bhfi;
 126
 127    memset(&ofs, 0, sizeof(ofs));
 128    fh = OpenFile(s, &ofs, OF_READ);
 129
 130    if (fh == INVALID_HANDLE_VALUE) {
 131       return NULL;
 132    }
 133
 134    GetFileInformationByHandle(fh, &bhfi);
 135    *len = bhfi.nFileSizeLow;
 136
 137    hShm = CreateFileMapping((HANDLE)fh, NULL, PAGE_READONLY, 0, 0, NULL);
 138
 139    if (hShm == NULL) {
 140       CloseHandle((HANDLE)fh);
 141       return NULL;
 142    }
 143
 144    buf = (char *)MapViewOfFileEx(hShm, FILE_MAP_READ, 0, 0, 0, NULL);
 145    CloseHandle(hShm);
 146    CloseHandle((HANDLE)fh);
 147
 148    return buf;
 149 }
 150
 151 int unmapfile(char *buf, int size)
 152 {
 153    if (buf == NULL)
 154       return -1;
 155    else
 156       return UnmapViewOfFile(buf) - 1;
 157 }
 158
 159
 160 #else
 161
 162 #include <sys/stat.h>
 163
 164 char * mapfile(const char * name, int * len)
 165 {
 166    FILE * fp;
 167    struct stat st;
 168    char * s;
 169
 170    if ((fp = fopen(name, "rb")) == NULL || fstat(fileno(fp), &st)) {
 171       if (fp != NULL)
 172          fclose(fp);
 173       return NULL;
 174    }
 175
 176    s = malloc(st.st_size);
 177
 178    if (s == NULL) {
 179       fclose(fp);
 180       return NULL;
 181    }
 182
 183    fread(s, 1, st.st_size, fp);
 184    fclose(fp);
 185
 186    *len = st.st_size;
 187    return s;
 188 }
 189
 190 int unmapfile(char *buf, int size)
 191 {
 192    if (buf == NULL)
 193       return -1;
 194    else {
 195       free(buf);
 196       return 0;
 197    }
 198 }
 199
 200 #endif
 201
 202
 203
 204
 205 /* sysstemsort(stemname[, order] [,sensitivity] [,startpos,endpos] [,firstcol,lastcol]) */
 206 rxfunc(sysstemsort)
 207 {
 208    chararray * ca;
 209    int insensitive = 0, backwards = 0, start = 0, count = 0, first = 0, width = 0;
 210    register int i;
 211    char * s;
 212    int (*cmpfn)(const PRXSTRING l, const PRXSTRING r);
 213
 214    checkparam(1, 7);
 215
 216    /* default to ascending sort, but go descending if the second arg is given
 217     * and the first character is `d' */
 218    if (argc > 1 && argv[1].strptr && toupper(argv[1].strptr[0]) == 'D')
 219       backwards = 1;
 220
 221    /* default to case-sensitive sort, but go insensitive if the third arg is
 222     * given and the first character is `i' */
 223    if (argc > 2 && argv[2].strptr && toupper(argv[2].strptr[0]) == 'I')
 224       insensitive = 1;
 225
 226    /* one can choose to sort a sub-set of the array, from index start to index
 227     * end. We must convert start from 1-based to 0-based, and we really want
 228     * end to be the count of elements to sort. */
 229    if (argc > 3 && argv[3].strptr) {
 230       rxstrdup(s, argv[3]);
 231       start = atoi(s) - 1;
 232
 233       if (start < 0)
 234          start = 0;
 235
 236    }
 237
 238    if (argc > 4 && argv[4].strptr) {
 239       rxstrdup(s, argv[4]);
 240       count = atoi(s) - start;
 241
 242       if (count < 0)
 243          count = 0;
 244    }
 245
 246    /* finally, one can choose to compare the full data or
 247     * substr(first,last-first+1) of the data. As with start and end,
 248     * we want first to be 0-based, and se want a width, not a last */
 249    if (argc > 5 && argv[5].strptr) {
 250       rxstrdup(s, argv[5]);
 251       first = atoi(s) - 1;
 252
 253       if (first < 0)
 254          first = 0;
 255    }
 256
 257    if (argc > 6 && argv[6].strptr) {
 258       rxstrdup(s, argv[6]);
 259       width = atoi(s) - first;
 260
 261       if (width < 0)
 262          width = 0;
 263    }
 264
 265    ca = new_chararray();
 266
 267    if (!ca) {
 268       return NOMEMORY;
 269    }
 270
 271    getastem(argv, ca);
 272
 273    if (!count) {
 274       count = ca->count - start;
 275       if (count < 0)
 276          count = 0;
 277    }
 278
 279    if (insensitive && backwards)
 280       cmpfn = rxstrcasecmpbackwards;
 281    else if (insensitive)
 282       cmpfn = rxstrcasecmp;
 283    else if (backwards)
 284       cmpfn = rxstrcmpbackwards;
 285    else
 286       cmpfn = rxstrcmp;
 287
 288    if (!first && !width)
 289       qsort(ca->array+start, count, sizeof(*ca->array), (int(*)(const void *, const void *))cmpfn);
 290    else {
 291       struct {
 292          RXSTRING se;
 293          RXSTRING orig;
 294       } * aa;
 295
 296       aa = malloc(sizeof(*aa) * count);
 297       if (!aa) {
 298          delete_chararray(ca);
 299          return NOMEMORY;
 300       }
 301
 302       for (i = 0; i < count; i++) {
 303          aa[i].orig = ca->array[i+start];
 304
 305          aa[i].se.strptr = aa[i].orig.strptr + first;
 306
 307          aa[i].se.strlength = aa[i].orig.strlength - first;
 308
 309          if (width && (int)aa[i].se.strlength > width)
 310             aa[i].se.strlength = width;
 311
 312          else if ((int)aa[i].se.strlength < 0)
 313             aa[i].se.strlength = 0;
 314       }
 315
 316       qsort(aa, count, sizeof(*aa), (int(*)(const void *, const void *))cmpfn);
 317
 318       for (i = 0; i < count; i++) {
 319          ca->array[i+start] = aa[i].orig;
 320       }
 321
 322       free(aa);
 323    }
 324
 325    setastem(argv, ca);
 326    delete_chararray(ca);
 327
 328    result_zero();
 329    return 0;
 330 }
 331
 332 /* regmultistemsort(order,sensitivity,firstcol,lastcol,stemname1,stemname2[,stemname3,...]) */
 333 rxfunc(regmultistemsort)
 334 {
 335    struct {
 336       RXSTRING se;
 337       RXSTRING orig;
 338       int idx;
 339    } * aa;
 340    chararray * ca, *tmpca;
 341    int insensitive = 0, backwards = 0, count = 0, first = 0, width = 0, size;
 342    register int i, j;
 343    char * s;
 344    int (*cmpfn)(const PRXSTRING l, const PRXSTRING r);
 345
 346    checkparam(6, -1);
 347
 348    /* validate that all stems are stems and they all have the same length */
 349    if ( getstemsize(&argv[4], &count ) ) {
 350       result_minus_one();
 351       return 0;
 352    }
 353    for ( i = 5; i < argc; i++ ) {
 354       if ( getstemsize(&argv[i], &size ) ) {
 355          result_minus_one();
 356          return 0;
 357       }
 358       /* check that this stem is the same size as the first */
 359       if ( size != count ) {
 360          result_minus_one();
 361          return 0;
 362       }
 363    }
 364
 365    /* default to ascending sort, but go descending if the first arg is given
 366     * and the first character is `d' */
 367    if (argv[0].strptr && toupper(argv[0].strptr[0]) == 'D')
 368       backwards = 1;
 369
 370    /* default to case-sensitive sort, but go insensitive if the second arg is
 371     * given and the first character is `i' */
 372    if (argv[1].strptr && toupper(argv[1].strptr[0]) == 'I')
 373       insensitive = 1;
 374
 375    /* finally, one can choose to compare the full data or
 376     * substr(first,last-first+1) of the data.
 377     * We want first to be 0-based, and we want a width, not a last */
 378    if (argv[2].strptr) {
 379       rxstrdup(s, argv[2]);
 380       first = atoi(s) - 1;
 381
 382       if (first < 0)
 383          first = 0;
 384    }
 385
 386    if (argv[3].strptr) {
 387       rxstrdup(s, argv[3]);
 388       width = atoi(s) - first;
 389
 390       if (width < 0)
 391          width = 0;
 392    }
 393
 394    /*
 395     * Allocate a new chararray for the first stem */
 396    ca = new_chararray();
 397
 398    if (!ca) {
 399       return NOMEMORY;
 400    }
 401
 402    /*
 403     * Copy the first stem into the chararray */
 404    getastem(&argv[4], ca);
 405
 406    if (insensitive && backwards)
 407       cmpfn = rxstrcasecmpbackwards;
 408    else if (insensitive)
 409       cmpfn = rxstrcasecmp;
 410    else if (backwards)
 411       cmpfn = rxstrcmpbackwards;
 412    else
 413       cmpfn = rxstrcmp;
 414
 415    /* sort the first stem */
 416    aa = malloc(sizeof(*aa) * count);
 417    if (!aa) {
 418       delete_chararray(ca);
 419       return NOMEMORY;
 420    }
 421
 422    for (i = 0; i < count; i++) {
 423       aa[i].idx = i;
 424       aa[i].orig = ca->array[i];
 425       aa[i].se.strptr = aa[i].orig.strptr + first;
 426       aa[i].se.strlength = aa[i].orig.strlength - first;
 427       if (width && (int)aa[i].se.strlength > width)
 428          aa[i].se.strlength = width;
 429       else if ((int)aa[i].se.strlength < 0)
 430          aa[i].se.strlength = 0;
 431    }
 432
 433    qsort(aa, count, sizeof(*aa), (int(*)(const void *, const void *))cmpfn);
 434
 435    for (i = 0; i < count; i++) {
 436       ca->array[i] = aa[i].orig;
 437    }
 438    setastem(&argv[4], ca);
 439
 440    /*
 441     * Allocate a new chararray for the first stem */
 442    tmpca = new_chararray();
 443
 444    if (!tmpca) {
 445       return NOMEMORY;
 446    }
 447    /*
 448     * We have sorted the first stem, now rearrange the order of the other stems to match the sorted
 449     * order of the first */
 450    for ( i = 5; i < argc; i++ ) {
 451       /* copy the stem to a chararray */
 452       getastem(&argv[i], ca);
 453       /* and again to a temp chararray */
 454       getastem(&argv[i], tmpca);
 455       for (j = 0; j < count; j++) {
 456          ca->array[j] = tmpca->array[aa[j].idx];
 457       }
 458       setastem(&argv[i], ca);
 459    }
 460
 461    delete_chararray(ca);
 462    delete_chararray(tmpca);
 463    free(aa);
 464    result_zero();
 465    return 0;
 466 }
 467
 468 /* sysstemcopy(from, to [, fromindex, toindex, count, insertoverlay]) */
 469 rxfunc(sysstemcopy)
 470 {
 471    chararray * ca, *tca;
 472    char * s;
 473    register int i;
 474    int find = 0, tind = 0, count = 0, insert = 0;
 475
 476    checkparam(2, 6);
 477
 478    /* as with stemsort, we want the indices to be offsets (ie, 0-based) */
 479    if (argc > 2 && argv[2].strptr) {
 480       rxstrdup(s, argv[2]);
 481       find = atoi(s) - 1;
 482    }
 483
 484    if (argc > 3 && argv[3].strptr) {
 485       rxstrdup(s, argv[3]);
 486       tind = atoi(s) - 1;
 487    }
 488
 489    /* but this time, there's a count which should be left alone */
 490    if (argc > 4 && argv[4].strptr) {
 491       rxstrdup(s, argv[4]);
 492       count = atoi(s);
 493    }
 494
 495    if (argc > 5 && argv[5].strptr && toupper(argv[5].strptr[0]) == 'I')
 496       insert = 1;
 497
 498    ca = new_chararray();
 499
 500    getastem(argv, ca);
 501
 502    if (!find && !tind && !count && !insert) {
 503       setastem(argv+1, ca);
 504    }
 505    /* I don't know why we needed to screw up this simple interface, but here
 506     * goes: */
 507    else {
 508       if (!count || (ca->count < (find+count))) {
 509          count = ca->count - find;
 510       }
 511
 512       if (count <= 0) {
 513          delete_chararray(ca);
 514
 515          /* should this be -1? */
 516          result_zero();
 517          return 0;
 518       }
 519
 520       tca = new_chararray();
 521       getastem(argv+1, tca);
 522       if (insert) {
 523
 524          /* make sure there's room */
 525          if (tca->ptr_alloc < (tca->count + count + tind)) {
 526             tca->ptr_alloc = tca->count+count+tind;
 527             tca->array = realloc(tca->array, tca->ptr_alloc*sizeof(tca->array));
 528          }
 529
 530          /* if we're extending past the end of the current array, set the
 531           * intervening elements to null */
 532
 533          if (tind > tca->count) {
 534             for (i = tca->count; i < tind; i++) {
 535                tca->array[i].strptr = NULL;
 536                tca->array[i].strlength = 0;
 537             }
 538             tca->count = tind + count;
 539          }
 540          else {
 541             memmove(tca->array+tind+count, tca->array+tind, (tca->count-tind)*sizeof(*tca->array));
 542             tca->count += count;
 543          }
 544       }
 545       else {
 546          /* still make sure there's room */
 547          if (tca->ptr_alloc < (count + tind)) {
 548             tca->ptr_alloc = count+tind;
 549             tca->array = realloc(tca->array, tca->ptr_alloc*sizeof(tca->array));
 550          }
 551
 552          /* if we're extending past the end of the current array, set the
 553           * intervening elements to null */
 554
 555          if (tind > tca->count) {
 556             for (i = tca->count; i < tind; i++) {
 557                tca->array[i].strptr = NULL;
 558                tca->array[i].strlength = 0;
 559             }
 560             tca->count = tind + count;
 561          }
 562          else if (tca->count < (tind+count)) {
 563             tca->count = tind + count;
 564          }
 565       }
 566
 567       memcpy(tca->array+tind, ca->array+find, count*sizeof(*ca->array));
 568
 569       setastem(argv+1, tca);
 570       delete_chararray(tca);
 571    }
 572
 573    delete_chararray(ca);
 574
 575    result_zero();
 576    return 0;
 577 }
 578
 579 /* sysstemdelete(stem, index [, count]) */
 580 rxfunc(sysstemdelete)
 581 {
 582    chararray * ca;
 583    char * counts, *inds;
 584    int count = 1, ind, size;
 585
 586    checkparam(2, 3);
 587
 588    rxstrdup(inds, argv[1]);
 589    ind = atoi(inds);
 590
 591    if (argc > 2) {
 592       rxstrdup(counts, argv[2]);
 593       count = atoi(counts);
 594    }
 595
 596    /* find out how many there are */
 597    getstemsize(argv, &size);
 598
 599    if (ind <= 0 || ind > size || count < 1 || count > (size - ind + 1)) {
 600       memcpy(result->strptr, "-1", 2);
 601       result->strlength = 2;
 602       return 0;
 603    }
 604
 605    ca = new_chararray();
 606
 607    /* retrieve the parts we want to keep, unless we're deleting the full
 608     * array */
 609    if ( ind > 1 && ind+count > size ) {
 610       /* set it with new size */
 611       setstemsize(argv, ind-1);
 612    } else if (ind > 1 || count < size) {
 613       /* retrieve from ind+count to the end */
 614       getstemtail(argv, ind+count, ca);
 615
 616       /* and set it with new indices */
 617       setstemtail(argv, ind, ca);
 618    }
 619    else {
 620       setastem(argv, ca);
 621    }
 622
 623    delete_chararray(ca);
 624
 625    result_zero();
 626    return 0;
 627 }
 628
 629 /* syssteminsert(stem, index, value) */
 630 rxfunc(syssteminsert)
 631 {
 632    chararray * ca;
 633    char *inds;
 634    int ind;
 635
 636    checkparam(3, 3);
 637
 638    ca = new_chararray();
 639
 640    getastem(argv, ca);
 641
 642    rxstrdup(inds, argv[1]);
 643    ind = atoi(inds) - 1;   /* translate rexx index to C index */
 644
 645    if (ind < 0 || ind > ca->count) {
 646       memcpy(result->strptr, "-1", 2);
 647       result->strlength = 2;
 648       return 0;
 649    }
 650
 651    /* add the value to the end of the array -- this is just to ensure there's space */
 652    cha_adddummy(ca, argv[2].strptr, argv[2].strlength);
 653
 654    /* if inserting at the end of the array, there's no need to screw
 655     * around */
 656    if (ind < (ca->count - 1)) {
 657       /* move the array over */
 658       memmove(ca->array+ind+1, ca->array+ind, sizeof(*ca->array)*(ca->count-ind-2));
 659       /* and set the pointers again */
 660       ca->array[ind] = argv[2];
 661    }
 662
 663    setastem(argv, ca);
 664    delete_chararray(ca);
 665
 666    result_zero();
 667    return 0;
 668 }
 669
 670 /* stemread(filename, stemname) */
 671 rxfunc(regstemread)
 672 {
 673    char * filname, *fdata, *cp;
 674    int flen;
 675    register int offs = 0, oldoffs = 0;
 676    chararray * ca;
 677    register int count = 1;
 678
 679    checkparam(2, 2);
 680
 681    rxstrdup(filname, argv[0]);
 682    fdata = mapfile(filname, &flen);
 683
 684    if (!fdata || !flen) {
 685       result_one();
 686       return 0;
 687    }
 688
 689    ca = new_chararray();
 690
 691    /* deal with a leading newline */
 692    if (fdata[0] == '\n') {
 693       oldoffs = 1;
 694       cha_adddummy(ca, fdata, 0);
 695    }
 696    else {
 697       oldoffs = 0;
 698    }
 699
 700    for (cp = memchr(fdata+oldoffs, '\n', flen - oldoffs); cp; cp = memchr(fdata+oldoffs, '\n', flen - oldoffs)) {
 701       offs = cp - fdata;
 702
 703       /* some systems print cr-lf, not just lf */
 704       if (cp[-1] == '\r')
 705          offs--;
 706
 707       cha_adddummy(ca, fdata+oldoffs, offs - oldoffs);
 708       oldoffs = cp - fdata + 1;
 709
 710       /* set 1000 elements at a time to cut down on memory allocation */
 711       if (ca->count >= 1000) {
 712          setstemtail(argv+1, count, ca);
 713          count += ca->count;
 714          ca->count = 0;
 715       }
 716    }
 717
 718    /* handle incomplete last lines */
 719    if (flen > 0 && fdata[flen-1] != '\n')
 720    {
 721       cha_adddummy(ca, fdata+oldoffs, flen-oldoffs);
 722    }
 723
 724    if (ca->count)
 725       setstemtail(argv+1, count, ca);
 726    /* subtract 1 because count is one greater than the number of
 727     * elements set before calling setstemtail */
 728    setstemsize(argv+1, count+ca->count - 1);
 729    delete_chararray(ca);
 730    unmapfile(fdata, flen);
 731
 732    result_zero();
 733    return 0;
 734 }
 735
 736 /* stemwrite(filename, stemname) */
 737 rxfunc(regstemwrite)
 738 {
 739    FILE * fp;
 740    char * filname;
 741    register int i;
 742    chararray * ca;
 743
 744    checkparam(2, 2);
 745
 746    rxstrdup(filname, argv[0]);
 747
 748    fp = fopen(filname, "w");
 749    if (!fp) {
 750       result_one();
 751       return 0;
 752    }
 753
 754    ca = new_chararray();
 755    getastem(argv+1, ca);
 756
 757    for (i = 0; i < ca->count; i++) {
 758       fwrite(ca->array[i].strptr, 1, ca->array[i].strlength, fp);
 759       fputc('\n', fp);
 760    }
 761
 762    fclose(fp);
 763    delete_chararray(ca);
 764
 765    result_zero();
 766
 767    return 0;
 768 }
 769
 770 /* regstemdover(stem, variable[, outstem])
 771  * returns 0 when it's finished
 772  */
 773 rxfunc(regstemdoover)
 774 {
 775    static chararray * ca = NULL;
 776    static char * name = NULL;
 777    static int len = 0, cur = 0;
 778    char * s;
 779    SHVBLOCK sb;
 780
 781    checkparam(2,3);
 782
 783    rxstrdup(s, argv[0]);
 784    strupr(s);
 785
 786    /* we can only do one of these at a time */
 787    if (!name || len != argv[0].strlength || memcmp(name, s, len)) {
 788       if (name)
 789          free(name);
 790
 791       if (ca)
 792          delete_chararray(ca);
 793       ca = NULL;
 794
 795       cur = 0;
 796       len = argv[0].strlength;
 797       name = malloc(len+1);
 798       memcpy(name, s, len+1);
 799    }
 800
 801    if (!ca) {
 802       ca = new_chararray();
 803
 804       sb.shvcode = RXSHV_NEXTV;
 805       sb.shvnext = NULL;
 806       sb.shvret = 0;
 807       sb.shvvalue.strptr = (void *)-1;
 808
 809       while (! (sb.shvret & RXSHV_LVAR)) {
 810          sb.shvvaluelen = sb.shvvalue.strlength = 0;
 811          sb.shvname.strptr = NULL;
 812          RexxVariablePool(&sb);
 813          if (sb.shvname.strptr && sb.shvname.strlength > len &&
 814              !memcmp(sb.shvname.strptr, name, len)) {
 815             cha_addstr(ca, sb.shvname.strptr+len, sb.shvname.strlength - len);
 816          }
 817          if (sb.shvname.strptr)
 818             REXXFREEMEMORY(sb.shvname.strptr);
 819       }
 820    }
 821
 822    if (!ca) {
 823       result_zero();
 824    }
 825
 826    else if (cur >= ca->count) {
 827       delete_chararray(ca);
 828       ca = NULL;
 829       free(name);
 830       name = NULL;
 831       cur = len = 0;
 832       result_zero();
 833    }
 834    else {
 835       sb.shvcode = RXSHV_SET;
 836       sb.shvnext = NULL;
 837       sb.shvret = 0;
 838       sb.shvvalue = ca->array[cur++];
 839       sb.shvname = argv[1];
 840       RexxVariablePool(&sb);
 841
 842       result_one();
 843    }
 844
 845    return 0;
 846 }
 847
 848 /* compare the offsetth element of stem haystack against the match table
 849  * needle. If exact is true, it must match exactly. Otherwise, it needs to
 850  * be contained somewhere in there. */
 851 static int stemcompare(PRXSTRING needle, PRXSTRING haystack,
 852                        int offset, rxbool exact, rxbool casesensitive)
 853 {
 854    register int i, offs = 0, rc;
 855    SHVBLOCK shv;
 856
 857    /* get the value of offset */
 858    memset(&shv, 0, sizeof(shv));
 859    shv.shvcode = RXSHV_FETCH;
 860    shv.shvvalue.strlength = shv.shvvaluelen = 1024;
 861    shv.shvvalue.strptr = alloca(1024);
 862    shv.shvname.strptr = alloca(haystack->strlength + 10);
 863    shv.shvnamelen = shv.shvname.strlength =
 864                sprintf(shv.shvname.strptr, "%.*s%d", (int)haystack->strlength,
 865                                                      haystack->strptr, offset);
 866    RexxVariablePool(&shv);
 867    if (shv.shvret & RXSHV_TRUNC) {
 868       shv.shvret = 0;
 869       shv.shvvalue.strptr = alloca(shv.shvvaluelen);
 870       shv.shvvalue.strlength = shv.shvvaluelen;
 871       RexxVariablePool(&shv);
 872    }
 873
 874    /* can't match if it's not long enough */
 875    if (shv.shvvalue.strlength < needle->strlength) {
 876       /* if performing an exact match, we may be doing a binary search and
 877        * so need to know which side we're on */
 878       if (exact) {
 879          if (casesensitive) {
 880             rc = memcmp(needle->strptr, shv.shvvalue.strptr, shv.shvvalue.strlength);
 881          }
 882          else {
 883             for (i = 0; i < shv.shvvalue.strlength; i++) {
 884                rc = ((int)(unsigned char)needle->strptr[i]) -
 885                     toupper((unsigned char)shv.shvvalue.strptr[i]);
 886
 887                if (rc) {
 888                   break;
 889                }
 890             }
 891          }
 892
 893          /* match up to the end of the haystack string, so return 1,
 894           * since substrings go first */
 895          if (!rc)
 896            rc = 1;
 897       }
 898       else
 899          rc = 1;
 900    }
 901
 902    else do {
 903       /* loop until something in haystack doesn't match */
 904       if (casesensitive) {
 905          rc = memcmp(needle->strptr, shv.shvvalue.strptr+offs, needle->strlength);
 906
 907          /* skip ahead quickly to the next possible match */
 908          if (rc && !exact) {
 909             char * cp = memchr(shv.shvvalue.strptr+offs+1, needle->strptr[0], shv.shvvalue.strlength - offs - 1);
 910             if (cp) {
 911                offs = (long)cp - (long)shv.shvvalue.strptr - 1;
 912             }
 913             else {
 914                offs = shv.shvvalue.strlength;
 915             }
 916          }
 917       }
 918       else {
 919          for (i = 0; i < needle->strlength; i++) {
 920             rc = ((int)(unsigned char)needle->strptr[i]) -
 921                  toupper((unsigned char)shv.shvvalue.strptr[i+offs]);
 922
 923             if (rc)
 924                break;
 925          }
 926       }
 927    } while (rc && !exact && (++offs <= (shv.shvvalue.strlength - needle->strlength)));
 928
 929    /* if this is an exact match, make sure the lengths match. We do this at
 930     * the end because it only applies when needle is a substring of
 931     * haystack */
 932    if (exact && !rc && shv.shvvalue.strlength != needle->strlength) {
 933       rc = -1;
 934    }
 935
 936    return rc;
 937 }
 938
 939
 940 /* regstemsearch(needle, haystack, [start], [flags]) */
 941 rxfunc(regstemsearch)
 942 {
 943    RXSTRING needle, haystack;
 944    char *sstart;
 945    register int offs = 1;
 946    rxbool casesensitive = false, exact = false, sorted = false;
 947    register int i;
 948    int size;
 949    int rc;
 950
 951    checkparam(2, 4);
 952
 953    haystack = argv[1];
 954
 955    /* make sure the stem name is null terminated */
 956    if (haystack.strptr[haystack.strlength-1] != '.') {
 957       rxstrdup(haystack.strptr, haystack);
 958       haystack.strptr[haystack.strlength++] = '.';
 959    }
 960
 961    getstemsize(&haystack, &size);
 962
 963    if (!size) {
 964       result_zero();
 965       return 0;
 966    }
 967
 968    if (argc > 2 && argv[2].strptr) {
 969       rxstrdup(sstart, argv[2]);
 970       offs = atoi(sstart);
 971    }
 972
 973    if (argc > 3) {
 974       if (memchr(argv[3].strptr, 'c', argv[3].strlength) ||
 975           memchr(argv[3].strptr, 'C', argv[3].strlength))
 976          casesensitive = true;
 977
 978       if (memchr(argv[3].strptr, 'e', argv[3].strlength) ||
 979           memchr(argv[3].strptr, 'E', argv[3].strlength))
 980          exact = true;
 981
 982       if (memchr(argv[3].strptr, 's', argv[3].strlength) ||
 983           memchr(argv[3].strptr, 'S', argv[3].strlength))
 984          sorted = true;
 985    }
 986
 987    if (casesensitive)
 988       needle = argv[0];
 989    else {
 990       needle.strlength = argv[0].strlength;
 991       needle.strptr = alloca(needle.strlength);
 992       for (i = 0; i < needle.strlength; i++) {
 993          needle.strptr[i] = toupper(argv[0].strptr[i]);
 994       }
 995    }
 996
 997    /* bsearch and lsearch are not appropriate if we want to avoid the
 998     * overhead of retrieving the values of all members of the stem */
 999    if (!sorted)
1000    {
1001       for (i = offs; i <= size; i++) {
1002          if (!(rc = stemcompare(&needle, &haystack, i, exact, casesensitive)))
1003             break;
1004       }
1005    }
1006    else
1007    {
1008       register int l = offs, r = size;
1009       for (i = (r - l) / 2 + l; i <= r  && i >= l; i = (r - l) / 2 + l) {
1010          if ((rc = stemcompare(&needle, &haystack, i, exact, casesensitive)) < 0) {
1011             r = i - 1;
1012          }
1013          else if (rc > 0) {
1014             l = i + 1;
1015          }
1016          else
1017             break;
1018       }
1019    }
1020
1021    if (!rc) {
1022       result->strlength = sprintf(result->strptr, "%d", i);
1023    }
1024    else
1025       result_zero();
1026    return 0;
1027 }
1028
1029 /* sysdumpvariables([filename])
1030  * write all variables either to file filename or to stdout
1031  */
1032 rxfunc(sysdumpvariables)
1033 {
1034    static const char dumpformat[] = "Name=%.*s, Value=\"%.*s\"\n";
1035    SHVBLOCK sb;
1036    FILE * fp;
1037    char * filename;
1038
1039    checkparam(0, 1);
1040    if (argc == 1) {
1041       rxstrdup(filename, argv[0]);
1042       fp = fopen(filename, "a");
1043    }
1044    else {
1045       fp = stdout;
1046    }
1047
1048    if (fp == NULL) {
1049       memcpy(result->strptr, "-1", 2);
1050       result->strlength = 2;
1051    }
1052    else {
1053       /* let's guess it will work from here on in */
1054       result_zero();
1055    }
1056
1057    sb.shvcode = RXSHV_NEXTV;
1058    sb.shvnext = 0;
1059    sb.shvret = 0;
1060
1061    while (! (sb.shvret & RXSHV_LVAR)) {
1062       /* set ptrs to NULL so RexxVariablePool will allocate memory
1063        * for us -- this is slightly more expensive, but prevents
1064        * the possibility of truncation (we can't recover from
1065        * truncation when stepping through the variable pool). */
1066       sb.shvvalue.strptr = NULL;
1067       sb.shvname.strptr = NULL;
1068
1069       RexxVariablePool(&sb);
1070
1071       if (sb.shvname.strptr && sb.shvvalue.strptr) {
1072          fprintf(fp, dumpformat, (int)sb.shvname.strlength, sb.shvname.strptr,
1073                  (int)sb.shvvalue.strlength, sb.shvvalue.strptr);
1074          REXXFREEMEMORY(sb.shvname.strptr);
1075          REXXFREEMEMORY(sb.shvvalue.strptr);
1076       }
1077    }
1078
1079    if (argc == 1)
1080       fclose(fp);
1081
1082    return 0;
1083 }