Annotation of freem/src/symtab_bltin.c, revision 1.1
1.1 ! snw 1: /*
! 2: * *
! 3: * * *
! 4: * * *
! 5: * ***************
! 6: * * * * *
! 7: * * MUMPS *
! 8: * * * * *
! 9: * ***************
! 10: * * *
! 11: * * *
! 12: * *
! 13: *
! 14: * symtab.c
! 15: * FreeM local system table and user-defined special variable table
! 16: *
! 17: *
! 18: * Author: Serena Willis <jpw@coherent-logic.com>
! 19: * Copyright (C) 1998 MUG Deutschland
! 20: * Copyright (C) 2020 Coherent Logic Development LLC
! 21: *
! 22: *
! 23: * This file is part of FreeM.
! 24: *
! 25: * FreeM is free software: you can redistribute it and/or modify
! 26: * it under the terms of the GNU Affero Public License as published by
! 27: * the Free Software Foundation, either version 3 of the License, or
! 28: * (at your option) any later version.
! 29: *
! 30: * FreeM is distributed in the hope that it will be useful,
! 31: * but WITHOUT ANY WARRANTY; without even the implied warranty of
! 32: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 33: * GNU Affero Public License for more details.
! 34: *
! 35: * You should have received a copy of the GNU Affero Public License
! 36: * along with FreeM. If not, see <https://www.gnu.org/licenses/>.
! 37: *
! 38: **/
! 39:
! 40: #include <stdlib.h>
! 41: #define ZNEW 'N'
! 42: #include "mpsdef.h"
! 43: #include <string.h>
! 44: #include <sys/ipc.h>
! 45: #include <sys/shm.h>
! 46: #include <sys/sem.h>
! 47: #include <unistd.h>
! 48: #include "mdebug.h"
! 49: #include "merr.h"
! 50: #include "consttbl.h"
! 51: #include "shmmgr.h"
! 52:
! 53: /* Turn this on to get tons of lovely debugging messages about
! 54: symbol-table calls */
! 55: /* #define DEBUG_SYM */
! 56:
! 57: short restoring_consts = FALSE;
! 58: int semid_symtab;
! 59:
! 60: #if !defined(__OpenBSD__) && !defined(__APPLE__)
! 61: union semun {
! 62: int val; /* Value for SETVAL */
! 63: struct semid_ds *buf; /* Buffer for IPC_STAT, IPC_SET */
! 64: unsigned short *array; /* Array for GETALL, SETALL */
! 65: struct seminfo *__buf; /* Buffer for IPC_INFO
! 66: (Linux-specific) */
! 67: };
! 68: #endif
! 69:
! 70:
! 71: long str2long(char *string)
! 72: {
! 73: int loop = 0;
! 74: int mult = 1;
! 75: int exp = 1;
! 76: long value = 0;
! 77:
! 78: if (string[0] == '-') {
! 79: mult = -1;
! 80: string++;
! 81: }
! 82:
! 83: while(string[loop] != EOL && string[loop] >= '0' && string[loop] <= '9') loop++;
! 84:
! 85: loop--;
! 86:
! 87: while(loop > -1) {
! 88: value += (string[loop] - '0') * exp;
! 89: exp *= 10; loop--;
! 90: }
! 91:
! 92: value *= mult;
! 93:
! 94: return value;
! 95: }
! 96:
! 97: void symtab_init ()
! 98: {
! 99: register int i;
! 100: union semun arg;
! 101: key_t symtab_sk;
! 102: symtab_sk = ftok (config_file, 6);
! 103:
! 104:
! 105: if (first_process) {
! 106:
! 107: for (i = 0; i < 128; i++) {
! 108: shm_config->hdr->alphptr[i] = 0L;
! 109: }
! 110:
! 111: shm_config->hdr->symlen = PSIZE;
! 112: shm_config->hdr->s = &mbpartition[PSIZE] - 256;
! 113: shm_config->hdr->PSIZE = DEFPSIZE;
! 114: shm_config->hdr->argptr = mbpartition;
! 115:
! 116: fprintf (stderr, "symtab_init: initializing memory-backed globals\r\n");
! 117:
! 118: semid_symtab = semget (symtab_sk, 1, 0666 | IPC_CREAT);
! 119: if (semid_symtab == -1) {
! 120: fprintf (stderr, "symtab_init: failed to create symbol table semaphore\r\n");
! 121: exit (1);
! 122: }
! 123: else {
! 124: fprintf (stderr, "symtab_init: symbol table semaphore created with semid %d\r\n", semid_symtab);
! 125: }
! 126:
! 127: arg.val = 1;
! 128: if (semctl (semid_symtab, 0, SETVAL, arg) == -1) {
! 129: fprintf (stderr, "symtab_init: failed to initialize symbol table semaphore\r\n");
! 130: exit (1);
! 131: }
! 132: else {
! 133: fprintf (stderr, "symtab_init: symbol table semaphore initialized\r\n");
! 134: }
! 135:
! 136: fprintf (stderr, "symtab_init: allocating partition for memory-backed globals\r\n");
! 137:
! 138: mbpartition = (char *) shm_alloc ((size_t) PSIZE + 2);
! 139: NULLPTRCHK(mbpartition,"symtab_init");
! 140:
! 141: shm_config->hdr->partition = mbpartition;
! 142:
! 143: if (symtab_get_sem ()) {
! 144: for (i = 0; i < 128; i++) shm_config->hdr->alphptr[i] = 0L;
! 145: symtab_release_sem ();
! 146: }
! 147:
! 148: }
! 149: else {
! 150:
! 151: semid_symtab = semget (symtab_sk, 1, 0);
! 152: if (semid_symtab == -1) {
! 153: fprintf (stderr, "symtab_init: could not attach to symbol table semaphore\r\n");
! 154: exit (1);
! 155: }
! 156:
! 157: mbpartition = shm_config->hdr->partition;
! 158:
! 159: }
! 160:
! 161: }
! 162:
! 163: short have_symtab_sem = FALSE;
! 164:
! 165: short symtab_get_sem(void)
! 166: {
! 167: int tries;
! 168: struct sembuf s = {0, -1, IPC_NOWAIT};
! 169:
! 170: if (have_symtab_sem) {
! 171: return TRUE;
! 172: }
! 173:
! 174: for (tries = 0; tries < 5; tries++) {
! 175:
! 176: if (semop (semid_symtab, &s, 1) != -1) {
! 177: have_symtab_sem = TRUE;
! 178: return TRUE;
! 179: }
! 180:
! 181: sleep (1);
! 182:
! 183: }
! 184: fprintf (stderr, "symtab_get_sem: fail\r\n");
! 185:
! 186: have_symtab_sem = FALSE;
! 187: return FALSE;
! 188: }
! 189:
! 190: void symtab_release_sem(void)
! 191: {
! 192: struct sembuf s = {0, 1, 0};
! 193:
! 194: semop (semid_symtab, &s, 1);
! 195:
! 196: have_symtab_sem = FALSE;
! 197: }
! 198:
! 199:
! 200: void symtab_shm (short action, char *key, char *data) /* symbol table functions */
! 201: {
! 202: char *old_s;
! 203: char *old_argptr;
! 204: long old_psize;
! 205: long old_symlen;
! 206: unsigned long stptrs[128];
! 207: register int i;
! 208: char *old_partition = partition;
! 209: partition = mbpartition;
! 210:
! 211: writing_mb = TRUE;
! 212:
! 213: if (symtab_get_sem ()) {
! 214:
! 215: /* save off current non-shared symtab state */
! 216: old_s = s;
! 217: old_argptr = argptr;
! 218: old_psize = PSIZE;
! 219: old_symlen = symlen;
! 220: for (i = 0; i < 128; i++) {
! 221: stptrs[i] = alphptr[i];
! 222: }
! 223:
! 224: /* replace symtab state with the values from the shared symtab */
! 225: s = shm_config->hdr->s;
! 226: argptr = shm_config->hdr->argptr;
! 227: PSIZE = shm_config->hdr->PSIZE;
! 228: symlen = shm_config->hdr->symlen;
! 229: for (i = 0; i < 128; i++) {
! 230: alphptr[i] = shm_config->hdr->alphptr[i];
! 231: }
! 232:
! 233: /* execute the action (symtab_bltin will now be working with the shared symbol table) */
! 234: symtab_bltin (action, key, data);
! 235:
! 236: /* copy new alphptr state back to shared memory */
! 237: for (i = 0; i < 128; i++) {
! 238: shm_config->hdr->alphptr[i] = alphptr[i];
! 239: }
! 240:
! 241: /* restore non-shared symtab alphptr state */
! 242: for (i = 0; i < 128; i++) {
! 243: alphptr[i] = stptrs[i];
! 244: }
! 245:
! 246: /* write the new shared symtab state back to shared memory */
! 247: shm_config->hdr->s = s;
! 248: shm_config->hdr->argptr = argptr;
! 249: shm_config->hdr->PSIZE = PSIZE;
! 250: shm_config->hdr->symlen = symlen;
! 251:
! 252: /* restore the non-shared symtab state */
! 253: s = old_s;
! 254: argptr = old_argptr;
! 255: PSIZE = old_psize;
! 256: symlen = old_symlen;
! 257:
! 258: symtab_release_sem ();
! 259:
! 260: }
! 261: else {
! 262: fprintf (stderr, "symtab_shm: failed to acquire symbol table sempahore\r\n");
! 263: }
! 264:
! 265: writing_mb = FALSE;
! 266: partition = old_partition;
! 267:
! 268: }
! 269:
! 270: /* local symbol table management */
! 271: /* (+)functions are now re-implemented */
! 272: /* (!)functions are new */
! 273: /* (?)re-implemented, with issues */
! 274: /* +set_sym +get_sym */
! 275:
! 276: /* +kill_sym +$data */
! 277: /* +kill_all +$fra_order */
! 278: /* +killexcl +fra_query */
! 279: /* +new_sym +bigquery */
! 280: /* +new_all +getinc */
! 281: /* +newexcl */
! 282: /* +killone +m_alias */
! 283: /* !merge_sym +zdata */
! 284: /* !pop_sym */
! 285:
! 286:
! 287:
! 288: /* The symbol table is placed at the high end of 'partition'. It begins at
! 289: * 'symlen' and ends at 'PSIZE'. The layout is
! 290: * (keylength)(key...)(<EOL>)(datalength)(data...[<EOL>])
! 291: * The keys are sorted in $order sequence.
! 292: *
! 293: * ****possible future layout with less space requirements****
! 294: * (keylength)(statusbyte)(key...)[(datalength)(data...[<EOL>])]
! 295: * 'keylength' is the length of 'key' overhead bytes not included.
! 296: * 'statusbyte' is an indicator with the following bits:
! 297: * 0 (LSB) 1=data information is missing 0=there is a data field
! 298: * 1 1=key is numeric 0=key is alphabetic
! 299: * 2..7 0..number of previous key_pieces
! 300: * note, that the status byte of a defined unsubscripted variable
! 301: * is zero.
! 302: * If a subscripted variable is stored, the variablename and each
! 303: * subscript are separate entries in the symbol table.
! 304: * E.g. S USA("CA",6789)="California" ; with $D(ABC)=0 before the set
! 305: * then the following format is used:
! 306: * (3)( 1)ABC
! 307: * (2)(1*4+1)CA
! 308: * (4)(2*4+2)6789(10)California
! 309: * ****end of "possible future layout"****
! 310: * To have the same fast access regardless of the position in the
! 311: * alphabet for each character a pointer to the first variable beginning
! 312: * with that letter is maintained. (0 indicates there's no such var.)
! 313: */
! 314:
! 315: void symtab_bltin (short action, char *key, char *data) /* symbol table functions */
! 316: {
! 317: /* must be static: */
! 318: static unsigned long tryfast = 0L; /* last $order reference */
! 319:
! 320: /* the following variables may */
! 321: /* be static or not */
! 322: static unsigned short nocompact = TRUE; /* flag: do not compact symtab if */
! 323:
! 324: /* value becomes shorter */
! 325: /* be static or dynamic: */
! 326:
! 327: static long keyl, datal; /* length of key and data */
! 328: static long kill_from;
! 329: static char tmp1[256], tmp2[256], tmp3[256];
! 330:
! 331: register long i, j, k, k1;
! 332: char tt_with[STRLEN];
! 333: char tt_key[STRLEN];
! 334:
! 335: #ifdef DEBUG_SYM
! 336:
! 337: int i0, i1;
! 338: char *start;
! 339:
! 340: #endif
! 341:
! 342: if (restoring_consts == FALSE) {
! 343: if (((action % 2) == 0) && const_is_defined (key)) {
! 344: merr_raise (CMODIFY);
! 345: return;
! 346: }
! 347: }
! 348:
! 349: if (action == kill_all) goto no_with;
! 350: if ((stlen (key) >= 5) && (strncmp (key, "%INT.", 5) == 0)) goto no_with;
! 351: if (strncmp (key, "^$", 2) == 0) goto no_with;
! 352: if (strncmp (key, "$", 1) == 0) goto no_with;
! 353:
! 354: stcpy (tt_with, i_with);
! 355: stcpy (tt_key, key);
! 356:
! 357: stcnv_m2c (tt_with);
! 358: stcnv_m2c (tt_key);
! 359:
! 360: snprintf (key, 100, "%s%s\201\201", tt_with, tt_key);
! 361:
! 362:
! 363: no_with:
! 364:
! 365:
! 366: if (dbg_enable_watch && ((action % 2) == 0)) dbg_fire_watch (key);
! 367:
! 368: if (key && key[1] != '$') stcpy (zloc, key);
! 369:
! 370: if (v22ptr) {
! 371:
! 372: procv22 (key);
! 373:
! 374: if (key[0] == '^') {
! 375:
! 376: char zrsav[256];
! 377: int naksav;
! 378: char gosav[256];
! 379:
! 380: stcpy (zrsav, zref);
! 381:
! 382: naksav = nakoffs;
! 383:
! 384: stcpy (gosav, g_o_val);
! 385: global (action, key, data);
! 386:
! 387: stcpy (zref, zrsav);
! 388:
! 389: nakoffs = naksav;
! 390:
! 391: stcpy (l_o_val, g_o_val);
! 392: stcpy (g_o_val, gosav);
! 393:
! 394: return;
! 395:
! 396: }
! 397:
! 398: }
! 399:
! 400: /* process optional limitations */
! 401: if (glvnflag.all && key[0] >= '%' && key[0] <= 'z') {
! 402:
! 403: if ((i = glvnflag.one[0])) { /* number of significant chars */
! 404:
! 405: j = 0;
! 406:
! 407: while ((k1 = key[j]) != DELIM && k1 != EOL) {
! 408:
! 409: if (j >= i) {
! 410:
! 411: while ((k1 = key[++j]) != DELIM && k1 != EOL) ;
! 412:
! 413: stcpy (&key[i], &key[j]);
! 414:
! 415: break;
! 416:
! 417: }
! 418:
! 419: j++;
! 420: }
! 421:
! 422: }
! 423:
! 424: if (glvnflag.one[1]) { /* upper/lower sensitivity */
! 425:
! 426: j = 0;
! 427:
! 428: while ((k1 = key[j]) != DELIM && k1 != EOL) {
! 429:
! 430: if (k1 >= 'a' && k1 <= 'z') key[j] = k1 - 32;
! 431:
! 432: j++;
! 433:
! 434: }
! 435:
! 436: }
! 437:
! 438:
! 439: if ((i = glvnflag.one[2])) {
! 440:
! 441: /* IMPACT: x11-94-28 */
! 442: if (stlen (key) > i) {
! 443: merr_raise (M75);
! 444: return;
! 445: } /* key length limit */
! 446:
! 447: }
! 448:
! 449: if ((i = glvnflag.one[3])) { /* subscript length limit */
! 450:
! 451: j = 0;
! 452:
! 453: while ((k1 = key[j++]) != DELIM && k1 != EOL) ;
! 454:
! 455: if (k1 == DELIM) {
! 456:
! 457: k = 0;
! 458:
! 459: for (;;) {
! 460:
! 461: k1 = key[j++];
! 462:
! 463: if (k1 == DELIM || k1 == EOL) {
! 464:
! 465: if (k > i) {
! 466: merr_raise (M75);
! 467: return;
! 468: }
! 469:
! 470: k = 0;
! 471:
! 472: }
! 473:
! 474: if (k1 == EOL) break;
! 475:
! 476: k++;
! 477:
! 478: }
! 479: }
! 480: }
! 481: }
! 482:
! 483:
! 484:
! 485: if (aliases && (action != m_alias)) { /* there are aliases */
! 486:
! 487: i = 0;
! 488: j = 0;
! 489:
! 490: while (i < aliases) {
! 491:
! 492: k1 = i + UNSIGN (ali[i]) + 1;
! 493:
! 494: /* is current reference an alias ??? */
! 495: j = 0;
! 496:
! 497: while (ali[++i] == key[j]) {
! 498:
! 499: if (ali[i] == EOL) break;
! 500:
! 501: j++;
! 502:
! 503: }
! 504:
! 505: /* yes, it is, so resolve it now! */
! 506: if (ali[i] == EOL && (key[j] == EOL || key[j] == DELIM)) {
! 507:
! 508: stcpy (tmp1, key);
! 509: stcpy (key, &ali[i + 1]);
! 510: stcat (key, &tmp1[j]);
! 511:
! 512: i = 0;
! 513:
! 514: continue; /* try again, it might be a double alias! */
! 515:
! 516: }
! 517:
! 518: i = k1;
! 519:
! 520: }
! 521:
! 522: }
! 523:
! 524: #ifdef DEBUG_SYM
! 525:
! 526: printf("DEBUG (%d): ",action);
! 527:
! 528: if(key) {
! 529:
! 530: printf("[key] is [");
! 531:
! 532: for(loop=0; key[loop] != EOL; loop++) printf("%c",(key[loop] == DELIM) ? '!' : key[loop]);
! 533:
! 534: printf("]\r\n");
! 535:
! 536: }
! 537: else {
! 538: printf("No key passed in.\r\n");
! 539: }
! 540:
! 541: if(data) {
! 542:
! 543: printf("[data] (datalen) is [");
! 544:
! 545: for(loop=0; data[loop] != EOL; loop++) printf("%c", data[loop]);
! 546:
! 547: printf("] (%d)\r\n",stlen(data));
! 548: printf("[Numeric?] is [%d]\r\n",is_numeric(data));
! 549:
! 550: }
! 551: else {
! 552: printf("No data passed in.\r\n");
! 553: }
! 554:
! 555: #endif
! 556:
! 557: switch (action) {
! 558:
! 559:
! 560: case get_sym: /* retrieve */
! 561:
! 562:
! 563: /* OLD get_sym routine */
! 564: if ((i = alphptr[(int) key[0]])) {
! 565:
! 566: // printf ("alphptr match; writing_mb = %d\r\n", writing_mb);
! 567:
! 568: k = 1;
! 569: j = i + 1; /* first char always matches! */
! 570:
! 571: do {
! 572:
! 573: while (key[k] == partition[++j]) { /* compare keys */
! 574:
! 575: if (key[k] == EOL) {
! 576:
! 577: /* IMPACT: x11-94-28 */
! 578: i = UNSIGN (partition[++j]);
! 579:
! 580: if (i < 4) {
! 581:
! 582: k = 0;
! 583:
! 584: while (k < i) data[k++] = partition[++j];
! 585:
! 586: }
! 587: else {
! 588: stcpy0 (data, &partition[j + 1], i);
! 589: }
! 590:
! 591: data[i] = EOL;
! 592:
! 593: return;
! 594:
! 595: }
! 596:
! 597: k++;
! 598:
! 599: }
! 600:
! 601: i += UNSIGN (partition[i]); /* skip key */
! 602: i += UNSIGN (partition[i]) + 1; /* skip data */
! 603:
! 604: k = 0;
! 605: j = i;
! 606:
! 607: } while (i < PSIZE);
! 608: }
! 609:
! 610: merr_raise (M6);
! 611: data[0] = EOL;
! 612:
! 613: return;
! 614:
! 615:
! 616:
! 617:
! 618:
! 619: case set_sym: /* store/create variable */
! 620:
! 621:
! 622: /* HANDLE ISVs FROM unnew() */
! 623:
! 624: if (key[0] == '$') {
! 625:
! 626: switch (key[1]) {
! 627:
! 628: case 't': /* $TEST */
! 629:
! 630: test = data[0];
! 631: break;
! 632:
! 633: case 'z': /* $Z ISVs */
! 634:
! 635: if (key[2] == 'r') { /* $ZREFERENCE / $REFERENCE */
! 636: stcpy (zref, data);
! 637: }
! 638:
! 639: break;
! 640:
! 641: }
! 642:
! 643: }
! 644:
! 645: datal = stlen (data); /* data length */
! 646:
! 647:
! 648:
! 649:
! 650:
! 651: /* Old set_sym routine */
! 652: /* check whether the key has subscripts or not */
! 653: if ((keyl = stlen (key) + 2) > STRLEN) {
! 654: merr_raise (M75);
! 655: return;
! 656: }
! 657:
! 658: k1 = 0;
! 659: i = 1;
! 660:
! 661: while (key[i] != EOL) {
! 662:
! 663: if (key[i++] == DELIM) {
! 664: k1 = i;
! 665: break;
! 666: }
! 667:
! 668: }
! 669:
! 670: if ((i = alphptr[(int) key[0]])) { /* previous entry */
! 671:
! 672: j = i + 1;
! 673: k = 1;
! 674:
! 675: }
! 676: else {
! 677:
! 678: i = symlen;
! 679: j = i;
! 680: k = 0;
! 681:
! 682: }
! 683:
! 684: if (k1 == 0) /* key was unsubscripted */
! 685:
! 686: /* compare keys */
! 687: while (i < PSIZE) {
! 688:
! 689: while (key[k] == partition[++j]) {
! 690:
! 691: if (key[k] == EOL) goto old;
! 692:
! 693: k++;
! 694:
! 695: }
! 696:
! 697: if (key[k] < partition[j]) break;
! 698:
! 699: i += UNSIGN (partition[i]); /* skip key */
! 700: i += UNSIGN (partition[i]) + 1; /* skip data */
! 701:
! 702: j = i;
! 703: k = 0;
! 704:
! 705: }
! 706: else { /* key was subscripted */
! 707:
! 708: /* compare keys */
! 709: while (i < PSIZE) {
! 710:
! 711: while (key[k] == partition[++j]) {
! 712:
! 713: if (key[k] == EOL) goto old;
! 714:
! 715: k++;
! 716:
! 717: }
! 718:
! 719:
! 720: if (k < k1) {
! 721: if (key[k] < partition[j]) break;
! 722: }
! 723: else {
! 724:
! 725: long m, n, o, ch;
! 726:
! 727: /* get complete subscripts */
! 728: n = k;
! 729:
! 730: while (key[--n] != DELIM) ;
! 731:
! 732: n++;
! 733: m = j + n - k;
! 734: o = 0;
! 735:
! 736: while ((ch = tmp3[o++] = partition[m++]) != EOL && ch != DELIM) ;
! 737:
! 738: if (ch == DELIM) tmp3[--o] = EOL;
! 739:
! 740: o = 0;
! 741:
! 742: while ((ch = tmp2[o++] = key[n++]) != EOL && ch != DELIM) ;
! 743:
! 744: if (ch == DELIM) tmp2[--o] = EOL;
! 745:
! 746: if (collate (tmp3, tmp2) == FALSE) {
! 747: if (stcmp (tmp2, tmp3) || ch == EOL) break;
! 748: }
! 749:
! 750: }
! 751:
! 752: i += UNSIGN (partition[i]); /* skip key */
! 753: i += UNSIGN (partition[i]) + 1; /* skip data */
! 754:
! 755: j = i;
! 756: k = 0;
! 757:
! 758: }
! 759: }
! 760:
! 761: /* if entry found, i pointer to searched entry
! 762: * else entry not found, i pointer to alphabetically next entry */
! 763:
! 764: /* new entry */
! 765: if (setop) {
! 766:
! 767: tmp1[0] = EOL;
! 768:
! 769: m_op (tmp1, data, setop);
! 770:
! 771: setop = 0;
! 772:
! 773: if (merr () > OK) return;
! 774:
! 775: datal = stcpy (data, tmp1);
! 776:
! 777: }
! 778:
! 779: k = i;
! 780: j = key[0];
! 781: i = keyl + datal + 1;
! 782:
! 783: if (alphptr['%']) alphptr['%'] -= i;
! 784:
! 785: for (k1 = 'A'; k1 <= j; k1++) {
! 786: if (alphptr[k1]) alphptr[k1] -= i;
! 787: }
! 788:
! 789: i = k - i;
! 790:
! 791: if (alphptr[j] == 0 || alphptr[j] > i) alphptr[j] = i;
! 792:
! 793: j = keyl + datal + 1;
! 794: i = symlen - j;
! 795:
! 796: if (i <= 256) { /* more space needed. try to get it */
! 797:
! 798: long dif = 0L;
! 799:
! 800: dif = getpmore ();
! 801:
! 802: if (dif == 0) {
! 803: merr_raise (STORE);
! 804: return;
! 805: }
! 806:
! 807: data = argptr;
! 808: i += dif;
! 809: k += dif;
! 810:
! 811: }
! 812:
! 813: symlen = i;
! 814: s = &partition[i] - 256;
! 815:
! 816: stcpy0 (&partition[i], &partition[j + i], k - i);
! 817:
! 818: i = k - (keyl + datal + 1);
! 819: partition[i++] = (char) (keyl);
! 820:
! 821: stcpy (&partition[i], key); /* store new key */
! 822:
! 823: i += keyl - 1;
! 824:
! 825: /* IMPACT: x11-94-28 */
! 826: partition[i++] = (char) (datal);
! 827:
! 828: stcpy0 (&partition[i], data, datal); /* store new data */
! 829:
! 830: return;
! 831:
! 832: /* there is a previous value */
! 833: old:
! 834: i += UNSIGN (partition[i]);
! 835:
! 836: if (setop) {
! 837:
! 838: j = UNSIGN (partition[i]);
! 839: stcpy0 (tmp1, &partition[i + 1], j);
! 840:
! 841: tmp1[j] = EOL;
! 842:
! 843: m_op (tmp1, data, setop);
! 844:
! 845: setop = 0;
! 846:
! 847: if (merr () > OK) return;
! 848:
! 849: datal = stcpy (data, tmp1);
! 850:
! 851: }
! 852:
! 853: old0: /* entry from getinc */
! 854:
! 855: /* IMPACT: x11-94-28 */
! 856: j = UNSIGN (partition[i]) - datal;
! 857:
! 858: if (j < 0) { /* more space needed */
! 859:
! 860: if ((symlen + j) <= 256) {
! 861:
! 862: long dif = 0L;
! 863:
! 864: dif = getpmore ();
! 865:
! 866: if (dif == 0L) {
! 867: merr_raise (STORE);
! 868: return;
! 869: }
! 870:
! 871: data = argptr;
! 872: i += dif;
! 873:
! 874: }
! 875:
! 876: for (k = 36; k < key[0]; k++) {
! 877: if (alphptr[k])
! 878: alphptr[k] += j;
! 879: }
! 880:
! 881: if (alphptr[k] && alphptr[k] < i) alphptr[k] += j;
! 882:
! 883: stcpy0 (&partition[symlen + j], &partition[symlen], i - symlen);
! 884:
! 885: i += j;
! 886: symlen += j;
! 887: s = &partition[symlen] - 256;
! 888: tryfast = 0;
! 889:
! 890: }
! 891: else if (j > 0) { /* surplus space */
! 892:
! 893: if (nocompact) {
! 894:
! 895: /* in a dynamic environment it is sufficient to */
! 896: /* set newdatalength=olddatalength */
! 897:
! 898: datal += j;
! 899:
! 900: }
! 901: else {
! 902:
! 903: /* instead of compression of the local symbol table, */
! 904: /* which the following piece of code does */
! 905:
! 906: symlen += j;
! 907: s = &partition[symlen] - 256;
! 908:
! 909: for (k = 36; k < key[0]; k++) {
! 910: if (alphptr[k]) alphptr[k] += j;
! 911: }
! 912:
! 913: if (alphptr[k] && alphptr[k] < i) alphptr[k] += j;
! 914:
! 915: i += j;
! 916: k = i;
! 917: j = i - j;
! 918:
! 919: while (i >= symlen) {
! 920: partition[i--] = partition[j--];
! 921: }
! 922:
! 923: i = k;
! 924: tryfast = 0;
! 925: nocompact = TRUE;
! 926:
! 927: }
! 928: }
! 929:
! 930: /* IMPACT: x11-94-28 */
! 931: partition[i++] = (char) (datal);
! 932: j = datal;
! 933:
! 934: if (j < 4) {
! 935:
! 936: k = 0;
! 937:
! 938: while (k < j) partition[i++] = data[k++];
! 939:
! 940: return;
! 941:
! 942: }
! 943:
! 944: stcpy0 (&partition[i], data, j); /* store new data */
! 945:
! 946: return;
! 947:
! 948: /* end of set_sym section */
! 949:
! 950:
! 951: case dat:
! 952:
! 953:
! 954: /* note: we assume EOL<DELIM<ASCII */
! 955: data[0] = '0';
! 956: data[1] = EOL;
! 957:
! 958: if ((i = alphptr[(int) key[0]])) {
! 959:
! 960: data[2] = EOL;
! 961: j = i + 1;
! 962: k = 1;
! 963:
! 964: do {
! 965:
! 966: while ((k1 = key[k] - partition[++j]) == 0) { /* compare keys */
! 967:
! 968: if (key[k] == EOL) break;
! 969:
! 970: k++;
! 971:
! 972: }
! 973:
! 974: if (k1 == 0) {
! 975: data[0] = '1';
! 976: }
! 977: else {
! 978:
! 979: if (partition[j] == DELIM && key[k] == EOL) {
! 980:
! 981: data[1] = data[0];
! 982: data[0] = '1';
! 983:
! 984: return;
! 985:
! 986: }
! 987:
! 988: if (k1 < 0 && k < 2) return;
! 989:
! 990: }
! 991:
! 992: i += UNSIGN (partition[i]); /* skip key */
! 993: i += UNSIGN (partition[i]) + 1; /* skip data */
! 994:
! 995: j = i;
! 996: k = 0;
! 997:
! 998: } while (i < PSIZE);
! 999:
! 1000: }
! 1001:
! 1002: return;
! 1003:
! 1004:
! 1005:
! 1006: /* end of $data section */
! 1007:
! 1008:
! 1009:
! 1010:
! 1011: case getinc: /* increment by one and retrieve */
! 1012:
! 1013: #ifdef DEBUG_SYM
! 1014:
! 1015: printf ("DEBUG GETINC: ");
! 1016: printf ("[key] is [");
! 1017:
! 1018: for (loop = 0; key[loop] != EOL; loop++) printf ("%c", (key[loop] == DELIM) ? '!' : key[loop]);
! 1019:
! 1020: printf("]\r\n");
! 1021: #endif
! 1022:
! 1023:
! 1024: if ((i = alphptr[(int) key[0]])) {
! 1025:
! 1026: j = i + 1;
! 1027: k = 1;
! 1028:
! 1029: do {
! 1030:
! 1031: while (key[k] == partition[++j]) { /* compare keys */
! 1032:
! 1033: if (key[k] == EOL) {
! 1034:
! 1035: i = UNSIGN (partition[++j]);
! 1036: stcpy0 (data, &partition[j + 1], i);
! 1037:
! 1038: data[i] = EOL; /* data retrieved ... now increment */
! 1039:
! 1040: /****************increment by one*******************/
! 1041: if (i == 0) i++; /* if data was empty use EOL as dummy value */
! 1042: if (i > 1 && data[0] == '0') i++; /* leading zero use EOL as dummy value */
! 1043:
! 1044: k = 0;
! 1045:
! 1046: while (k < i) {
! 1047:
! 1048: if ((k1 = data[k++]) < '0' || k1 > '9') { /* no positive integer */
! 1049:
! 1050: numlit (data);
! 1051:
! 1052: tmp1[0] = '1';
! 1053: tmp1[1] = EOL;
! 1054:
! 1055: add (data, tmp1);
! 1056:
! 1057: datal = stlen (data);
! 1058:
! 1059: i = j;
! 1060:
! 1061: nocompact = FALSE; /* getinc needs compacted symtab */
! 1062:
! 1063: goto old0;
! 1064:
! 1065: }
! 1066:
! 1067: }
! 1068:
! 1069: k1 = k--; /* length of string */
! 1070:
! 1071: while ((partition[j + 1 + k] = ++data[k]) > '9') {
! 1072:
! 1073: partition[j + 1 + k] = '0';
! 1074: data[k--] = '0';
! 1075:
! 1076: if (k < 0) {
! 1077:
! 1078: k = k1;
! 1079:
! 1080: while (k >= 0) {
! 1081: data[k + 1] = data[k];
! 1082: k--;
! 1083: }
! 1084:
! 1085: data[0] = '1';
! 1086: s = &partition[--symlen] - 256;
! 1087:
! 1088: if (alphptr['%']) alphptr['%']--;
! 1089:
! 1090: for (k = 'A'; k <= key[0]; k++) {
! 1091: if (alphptr[k]) alphptr[k]--;
! 1092: }
! 1093:
! 1094: k = j - 1;
! 1095: j = symlen;
! 1096:
! 1097: stcpy0 (&partition[j], &partition[j + 1], k - j);
! 1098:
! 1099: partition[k] = (char) ++i;
! 1100: partition[++k] = '1';
! 1101:
! 1102: return;
! 1103:
! 1104: }
! 1105:
! 1106: }
! 1107:
! 1108: return;
! 1109:
! 1110: /************end increment by one*******************/
! 1111:
! 1112: }
! 1113:
! 1114: k++;
! 1115:
! 1116: }
! 1117:
! 1118: /** if (key[k]<partition[j]) break; **/
! 1119: i += UNSIGN (partition[i]); /* skip key */
! 1120: i += UNSIGN (partition[i]) + 1; /* skip data */
! 1121:
! 1122: j = i;
! 1123: k = 0;
! 1124:
! 1125: } while (i < PSIZE);
! 1126:
! 1127: }
! 1128:
! 1129: data[0] = EOL;
! 1130: merr_raise (UNDEF);
! 1131:
! 1132: return;
! 1133:
! 1134:
! 1135:
! 1136: case fra_order: /* next one please */
! 1137:
! 1138:
! 1139: if (ordercnt < 0) goto zinv;
! 1140:
! 1141: k1 = (j = stcpy (tmp1, key) - 1);
! 1142:
! 1143: while (tmp1[k1] != DELIM) {
! 1144: if ((--k1) <= 0) goto unsubscr;
! 1145: }
! 1146:
! 1147: tmp1[++k1] = EOL;
! 1148:
! 1149: stcpy (tmp2, &key[k1]);
! 1150:
! 1151: if (ordercnt == 0) {
! 1152:
! 1153: stcpy (data, tmp2);
! 1154:
! 1155: l_o_val[0] = EOL;
! 1156:
! 1157: return;
! 1158:
! 1159: }
! 1160:
! 1161: data[0] = EOL;
! 1162:
! 1163: if ((i = alphptr[(int) key[0]]) == 0) {
! 1164:
! 1165: l_o_val[0] = EOL;
! 1166:
! 1167:
! 1168: return;
! 1169:
! 1170: }
! 1171:
! 1172: /***************************/
! 1173: /* frequent special case: the key of which we search the next
! 1174: * entry is defined ! */
! 1175: if (tmp2[0] != EOL) {
! 1176:
! 1177: if (tryfast && stcmp (key, &partition[tryfast + 1]) == 0) {
! 1178:
! 1179: j = tryfast;
! 1180: j += UNSIGN (partition[j]); /* skip key */
! 1181: j += UNSIGN (partition[j]) + 1; /* skip data */
! 1182:
! 1183: goto begorder;
! 1184:
! 1185: }
! 1186:
! 1187: k = 1;
! 1188: j = i + 1; /* first char always matches! */
! 1189:
! 1190: do {
! 1191:
! 1192: while (key[k] == partition[++j]) { /* compare keys */
! 1193:
! 1194: if (key[k++] == EOL) {
! 1195: j = i;
! 1196: goto begorder;
! 1197: }
! 1198:
! 1199: }
! 1200:
! 1201: i += UNSIGN (partition[i]); /* skip key */
! 1202: i += UNSIGN (partition[i]) + 1; /* skip data */
! 1203:
! 1204: k = 0;
! 1205: j = i;
! 1206:
! 1207: } while (i < PSIZE);
! 1208:
! 1209: }
! 1210:
! 1211: /* the key was not defined */
! 1212: /***************************/
! 1213: j = alphptr[(int) key[0]];
! 1214:
! 1215: begorder:
! 1216:
! 1217: do {
! 1218:
! 1219: if (key[0] != partition[j + 1]) {
! 1220:
! 1221: l_o_val[0] = EOL;
! 1222: data[0] = EOL;
! 1223:
! 1224: return;
! 1225:
! 1226: }
! 1227:
! 1228: stcpy0 (data, &partition[j + 1], k1);
! 1229:
! 1230: data[k1] = EOL;
! 1231:
! 1232: if (stcmp (tmp1, data) == 0) {
! 1233:
! 1234: stcpy (data, &partition[j + 1 + k1]); /* index on same level */
! 1235:
! 1236: k = 0;
! 1237:
! 1238: while (data[k] != EOL && data[k] != DELIM) k++;
! 1239:
! 1240: data[k] = EOL;
! 1241:
! 1242: if (collate (tmp2, data)) {
! 1243:
! 1244: if (--ordercnt <= 0) {
! 1245:
! 1246: tryfast = j;
! 1247:
! 1248: /* save data value for inspection with $V(110) */
! 1249: j += UNSIGN (partition[j]); /* skip key */
! 1250: k = UNSIGN (partition[j++]);
! 1251: stcpy0 (l_o_val, &partition[j], k);
! 1252:
! 1253: l_o_val[k] = EOL;
! 1254:
! 1255: return;
! 1256:
! 1257: }
! 1258:
! 1259: ordercounter++;
! 1260:
! 1261: }
! 1262:
! 1263: }
! 1264:
! 1265: j += UNSIGN (partition[j]); /* skip key */
! 1266: j += UNSIGN (partition[j]) + 1; /* skip data */
! 1267:
! 1268: } while (j < PSIZE);
! 1269:
! 1270: data[0] = EOL;
! 1271: tryfast = 0;
! 1272: l_o_val[0] = EOL;
! 1273:
! 1274: return;
! 1275:
! 1276: /* end of $order section */
! 1277:
! 1278:
! 1279: case kill_all:
! 1280:
! 1281: genocid:
! 1282:
! 1283:
! 1284:
! 1285:
! 1286: /* Old genocide routine */
! 1287: alphptr['%'] = 0;
! 1288:
! 1289: for (i = 'A'; i <= 'z'; alphptr[i++] = 0) ;
! 1290:
! 1291: symlen = PSIZE;
! 1292: s = &partition[symlen] - 256;
! 1293: tryfast = 0;
! 1294:
! 1295: ssvn_system_update ();
! 1296: ssvn_job_update ();
! 1297: ssvn_routine_update ();
! 1298:
! 1299: #if defined(HAVE_MWAPI_MOTIF)
! 1300: ssvn_display_update ();
! 1301: #endif
! 1302:
! 1303: const_restore ();
! 1304:
! 1305: return;
! 1306:
! 1307:
! 1308:
! 1309:
! 1310: case kill_sym: /* kill them dirty bloody variables */
! 1311:
! 1312:
! 1313: /* Old Kill Routine */
! 1314:
! 1315: if ((i = alphptr[(int) key[0]]) == 0) return; /* damn - nothing to kill */
! 1316:
! 1317: kill_from = 0;
! 1318:
! 1319: while (i < PSIZE) {
! 1320:
! 1321: j = i;
! 1322: k = 0;
! 1323:
! 1324: while ((k1 = key[k]) == partition[++j]) { /* compare keys */
! 1325:
! 1326: if (k1 == EOL) break;
! 1327:
! 1328: k++;
! 1329:
! 1330: }
! 1331:
! 1332: if (k1 == EOL && (partition[j] == DELIM || partition[j] == EOL)) {
! 1333:
! 1334: if (kill_from == 0) kill_from = i;
! 1335:
! 1336: }
! 1337: else {
! 1338: if (kill_from) break;
! 1339: }
! 1340:
! 1341: i += UNSIGN (partition[i]); /* skip key */
! 1342: i += UNSIGN (partition[i]) + 1; /* skip data */
! 1343:
! 1344: }
! 1345:
! 1346: k_entry: /* entry from killone section */
! 1347:
! 1348:
! 1349: if (kill_from) {
! 1350:
! 1351: j = i - kill_from;
! 1352: symlen += j;
! 1353: s = &partition[symlen] - 256;
! 1354:
! 1355: for (k = 36; k < key[0]; k++) {
! 1356: if (alphptr[k]) alphptr[k] += j;
! 1357: }
! 1358:
! 1359: if (alphptr[k] == kill_from) {
! 1360:
! 1361: alphptr[k] = i;
! 1362:
! 1363: if (partition[i + 1] != key[0]) alphptr[k] = 0;
! 1364:
! 1365: }
! 1366: else {
! 1367: alphptr[k] += j;
! 1368: }
! 1369:
! 1370: /* j=i-j; while(i>symlen) partition[--i]=partition[--j]; */
! 1371: stcpy1 (&partition[i - 1], &partition[i - j - 1], i - symlen);
! 1372:
! 1373: }
! 1374:
! 1375: tryfast = 0;
! 1376:
! 1377: return;
! 1378:
! 1379:
! 1380: /* end of kill_sym section */
! 1381:
! 1382: case killone: /* kill one variable, not descendants */
! 1383:
! 1384:
! 1385: if ((i = alphptr[(int) key[0]]) == 0) return; /* nothing to kill */
! 1386:
! 1387: kill_from = 0;
! 1388:
! 1389: while (i < PSIZE) {
! 1390:
! 1391: j = i;
! 1392: k = 0;
! 1393:
! 1394: while ((k1 = key[k]) == partition[++j]) { /* compare keys */
! 1395:
! 1396: if (k1 == EOL) break;
! 1397:
! 1398: k++;
! 1399:
! 1400: }
! 1401:
! 1402: k = i;
! 1403: i += UNSIGN (partition[i]); /* skip key */
! 1404: i += UNSIGN (partition[i]) + 1; /* skip data */
! 1405:
! 1406: if (k1 == EOL) {
! 1407:
! 1408: if (partition[j] == DELIM) return; /* descendant */
! 1409:
! 1410: kill_from = k;
! 1411:
! 1412: goto k_entry;
! 1413:
! 1414: }
! 1415:
! 1416: }
! 1417:
! 1418: tryfast = 0;
! 1419:
! 1420: return;
! 1421:
! 1422:
! 1423: /* end of killone section */
! 1424:
! 1425: case killexcl: /* exclusive kill */
! 1426:
! 1427:
! 1428: i = symlen;
! 1429:
! 1430: while (i < PSIZE) {
! 1431:
! 1432: tmp2[0] = SP;
! 1433: kill_from = i;
! 1434:
! 1435: stcpy (tmp3, &partition[i + 1]);
! 1436: stcpy (&tmp2[1], tmp3);
! 1437: stcat (tmp2, " \201");
! 1438:
! 1439: i += UNSIGN (partition[i]);
! 1440: i += UNSIGN (partition[i]) + 1;
! 1441:
! 1442: if (kill_ok (key, tmp2) == 0) continue; /* don't kill */
! 1443:
! 1444: while (i < PSIZE) {
! 1445:
! 1446: j = i;
! 1447: k = 0;
! 1448:
! 1449: while ((k1 = tmp3[k]) == partition[++j]) { /* compare keys */
! 1450:
! 1451: if (k1 == EOL) break;
! 1452:
! 1453: k++;
! 1454:
! 1455: }
! 1456:
! 1457: if (k1 != EOL || (partition[j] != DELIM && partition[j] != EOL)) break;
! 1458:
! 1459: i += UNSIGN (partition[i]); /* skip key */
! 1460: i += UNSIGN (partition[i]) + 1; /* skip data */
! 1461:
! 1462: }
! 1463:
! 1464: j = i - kill_from;
! 1465: symlen += j;
! 1466: s = &partition[symlen] - 256;
! 1467:
! 1468: for (k = 36; k < tmp3[0]; k++) {
! 1469: if (alphptr[k]) alphptr[k] += j;
! 1470: }
! 1471:
! 1472: if (alphptr[k] == kill_from) {
! 1473:
! 1474: alphptr[k] = i;
! 1475:
! 1476: if (partition[i + 1] != tmp3[0]) alphptr[k] = 0;
! 1477:
! 1478: }
! 1479: else {
! 1480: alphptr[k] += j;
! 1481: }
! 1482:
! 1483: stcpy1 (&partition[i - 1], &partition[i - j - 1], i - symlen);
! 1484:
! 1485: i = kill_from + j;
! 1486:
! 1487: }
! 1488:
! 1489: tryfast = 0;
! 1490:
! 1491: return;
! 1492:
! 1493: /* end of killexcl section */
! 1494:
! 1495: case fra_query: /* next entry */
! 1496: case bigquery:
! 1497:
! 1498:
! 1499: if (ordercnt == 0) {
! 1500:
! 1501: l_o_val[0] = EOL;
! 1502:
! 1503: zname (data, key + stlen (i_with));
! 1504:
! 1505: return;
! 1506:
! 1507: }
! 1508:
! 1509: /***************************/
! 1510: /* frequent special case: the key which we search for is the next
! 1511: * entry */
! 1512:
! 1513: if ((i = alphptr[(int) key[0]])) {
! 1514:
! 1515: if (stcmp (key, &partition[tryfast + 1]) == 0) {
! 1516: i = tryfast;
! 1517: }
! 1518: else {
! 1519:
! 1520: j = i;
! 1521:
! 1522: do {
! 1523:
! 1524: if (stcmp (key, &partition[j + 1]) == 0) {
! 1525: i = j;
! 1526: break;
! 1527: }
! 1528:
! 1529: j += UNSIGN (partition[j]); /* skip key */
! 1530: j += UNSIGN (partition[j]) + 1; /* skip data */
! 1531:
! 1532: } while (j < PSIZE);
! 1533:
! 1534: }
! 1535: }
! 1536: else {
! 1537: i = symlen; /* no previous entry */
! 1538: }
! 1539: /***************************/
! 1540:
! 1541:
! 1542: /* check whether the key has subscripts or not */
! 1543: k1 = 0;
! 1544: k = 1;
! 1545:
! 1546: while (key[k] != EOL) {
! 1547:
! 1548: if (key[k++] == DELIM) {
! 1549: k1 = k;
! 1550: break;
! 1551: }
! 1552:
! 1553: }
! 1554:
! 1555: while (i < PSIZE) {
! 1556:
! 1557: j = i;
! 1558: k = 0;
! 1559:
! 1560: while (key[k] == partition[++j]) { /* compare keys */
! 1561:
! 1562: if (key[k] == EOL) break;
! 1563:
! 1564: k++;
! 1565:
! 1566: }
! 1567:
! 1568: if (key[k] == EOL) {
! 1569:
! 1570: if (partition[j] == EOL) {
! 1571: i += UNSIGN (partition[i]);
! 1572: i += UNSIGN (partition[i]) + 1;
! 1573: }
! 1574:
! 1575: break;
! 1576:
! 1577: }
! 1578:
! 1579: if (k < k1 || k1 == 0) {
! 1580:
! 1581: if (key[k] < partition[j]) break;
! 1582:
! 1583: }
! 1584: else {
! 1585: long m, n, o, ch;
! 1586:
! 1587: /* get complete subscripts */
! 1588: n = k;
! 1589:
! 1590: while (key[--n] != DELIM) ;
! 1591:
! 1592: n++;
! 1593: m = j + n - k;
! 1594: o = 0;
! 1595:
! 1596: while ((ch = tmp2[o++] = key[n++]) != EOL && ch != DELIM) ;
! 1597:
! 1598: if (ch == DELIM) tmp2[--o] = EOL;
! 1599:
! 1600: o = 0;
! 1601:
! 1602: while ((ch = tmp3[o++] = partition[m++]) != EOL && ch != DELIM) ;
! 1603:
! 1604: if (ch == DELIM) tmp3[--o] = EOL;
! 1605:
! 1606: if (collate (tmp2, tmp3)) break;
! 1607:
! 1608: }
! 1609:
! 1610: i += UNSIGN (partition[i]); /* skip key */
! 1611: i += UNSIGN (partition[i]) + 1; /* skip data */
! 1612:
! 1613: }
! 1614:
! 1615: /* multiple backward query */
! 1616: if (ordercnt < 0) {
! 1617:
! 1618: j = symlen;
! 1619: k = ordercnt - 1;
! 1620:
! 1621: while (j < i) { /* count entries */
! 1622:
! 1623: j += UNSIGN (partition[j]); /* skip key */
! 1624: j += UNSIGN (partition[j]) + 1; /* skip data */
! 1625:
! 1626: k++;
! 1627:
! 1628: }
! 1629:
! 1630: if (k < 0) {
! 1631:
! 1632: data[0] = EOL;
! 1633: l_o_val[0] = EOL;
! 1634:
! 1635: return;
! 1636:
! 1637: }
! 1638:
! 1639: i = symlen;
! 1640:
! 1641: while (--k >= 0) {
! 1642:
! 1643: i += UNSIGN (partition[i]); /* skip key */
! 1644: i += UNSIGN (partition[i]) + 1; /* skip data */
! 1645:
! 1646: }
! 1647:
! 1648: }
! 1649: /* end: multiple backward query */
! 1650:
! 1651: while (--ordercnt > 0) { /* multiple forward $query */
! 1652:
! 1653: if (i >= PSIZE) break;
! 1654:
! 1655: i += UNSIGN (partition[i]); /* skip key */
! 1656: i += UNSIGN (partition[i]) + 1; /* skip data */
! 1657:
! 1658: }
! 1659:
! 1660: /* now 'i' is pointer to 'next' entry */
! 1661: tryfast = i;
! 1662:
! 1663: /* save data value for inspection with $V(110) */
! 1664: j = i;
! 1665:
! 1666: j += UNSIGN (partition[j]);
! 1667: k = UNSIGN (partition[j]);
! 1668:
! 1669: stcpy0 (l_o_val, &partition[j + 1], k);
! 1670: l_o_val[k] = EOL;
! 1671:
! 1672: keyl = i;
! 1673: keyl += UNSIGN (partition[i++]) - 2;
! 1674:
! 1675: /* action==bigquery may return a result in a different lvn */
! 1676: /* which is illegal with $query() */
! 1677: if (action == fra_query) {
! 1678:
! 1679: k = 0; /* is result same lvn? */
! 1680:
! 1681: while (partition[i+k] == key[k]) {
! 1682:
! 1683: if (key[k] == DELIM) break;
! 1684:
! 1685: k++;
! 1686:
! 1687: }
! 1688:
! 1689: if (partition[i+k] != DELIM) i = keyl + 1; /* discard result! */
! 1690:
! 1691: }
! 1692:
! 1693: if (i <= keyl) {
! 1694: zname (data, &partition[i + stlen (i_with)]);
! 1695: }
! 1696: else {
! 1697: data[0] = EOL;
! 1698: }
! 1699:
! 1700: return;
! 1701: /* end of $query section */
! 1702:
! 1703: zinv: /* previous one please */
! 1704:
! 1705: data[0] = EOL;
! 1706: l_o_val[0] = EOL;
! 1707:
! 1708: k1 = (j = stcpy (tmp1, key) - 1);
! 1709:
! 1710: while (tmp1[k1] != DELIM) {
! 1711:
! 1712: if ((--k1) <= 0) {
! 1713: merr_raise (NEXTER);
! 1714: return;
! 1715: }
! 1716:
! 1717: }
! 1718:
! 1719: tmp1[++k1] = EOL;
! 1720:
! 1721: stcpy (tmp2, &key[k1]);
! 1722:
! 1723: if (tmp2[0] == EOL) {
! 1724:
! 1725: tmp2[0] = DEL;
! 1726: tmp2[1] = DEL;
! 1727: tmp2[2] = EOL;
! 1728:
! 1729: }
! 1730:
! 1731: k = (int) (key[0]);
! 1732:
! 1733: if (alphptr[k] == 0) return;
! 1734:
! 1735: j = alphptr[k];
! 1736:
! 1737: do {
! 1738:
! 1739: if (key[0] != partition[j + 1]) goto zinvend;
! 1740:
! 1741: stcpy0 (tmp3, &partition[j + 1], k1);
! 1742:
! 1743: tmp3[k1] = EOL;
! 1744:
! 1745: if (stcmp (tmp1, tmp3) == 0) {
! 1746:
! 1747: stcpy (tmp3, &partition[j + 1 + k1]); /* index on same level */
! 1748:
! 1749: k = 0;
! 1750:
! 1751: while (tmp3[k] != EOL && tmp3[k] != DELIM) k++;
! 1752:
! 1753: tmp3[k] = EOL;
! 1754:
! 1755: if (collate (tmp3, tmp2) == FALSE) goto zinvend;
! 1756:
! 1757: stcpy (data, tmp3);
! 1758:
! 1759: /* save data value for inspection with $V(110) */
! 1760: i = j;
! 1761:
! 1762: i += UNSIGN (partition[i]);
! 1763: k = UNSIGN (partition[i]);
! 1764:
! 1765: stcpy0 (l_o_val, &partition[i + 1], k);
! 1766:
! 1767: l_o_val[k] = EOL;
! 1768:
! 1769: }
! 1770:
! 1771: j += UNSIGN (partition[j]); /* skip key */
! 1772: j += UNSIGN (partition[j]) + 1; /* skip data */
! 1773:
! 1774: } while (j < PSIZE);
! 1775:
! 1776: zinvend:
! 1777:
! 1778: if (data[0] == EOL) return;
! 1779:
! 1780: ordercounter++;
! 1781:
! 1782: if (++ordercnt >= 0) return;
! 1783:
! 1784: stcpy (&key[k1], data);
! 1785:
! 1786: goto zinv;
! 1787:
! 1788:
! 1789:
! 1790:
! 1791:
! 1792: /* end of $zinverse section */
! 1793:
! 1794:
! 1795: case new_sym: /* new one symbol */
! 1796:
! 1797: if (key[0] == '$') { /* $svn: save current value on new stack */
! 1798:
! 1799:
! 1800:
! 1801: if (newptr > newlimit && getnewmore ()) return;
! 1802:
! 1803: if ((key[1] | 0140) == 't') { /* NEW $TEST */
! 1804:
! 1805: *newptr++ = test;
! 1806: *newptr++ = EOL;
! 1807: *newptr++ = 1;
! 1808:
! 1809: k1 = stcpy (newptr, "$t\201");
! 1810:
! 1811: newptr += k1;
! 1812: *newptr++ = EOL;
! 1813: *newptr++ = k1;
! 1814: *newptr++ = set_sym;
! 1815:
! 1816: //if (mcmnd != ZNEW) test = FALSE;
! 1817:
! 1818: return;
! 1819:
! 1820: }
! 1821:
! 1822: if ((key[1] | 0140) == 'j') { /* NEW $JOB */
! 1823:
! 1824: *newptr++ = pid / 256;
! 1825: *newptr++ = pid % 256;
! 1826: *newptr++ = EOL;
! 1827: *newptr++ = 2;
! 1828:
! 1829: k1 = stcpy (newptr, "$j\201");
! 1830:
! 1831: newptr += k1;
! 1832: *newptr++ = EOL;
! 1833: *newptr++ = k1;
! 1834: *newptr++ = set_sym;
! 1835:
! 1836: return;
! 1837:
! 1838: }
! 1839:
! 1840: if (((key[1] | 0140) == 'z') && ((key[2] | 0140) == 'i')) { /* NEW $ZINRPT */
! 1841:
! 1842: *newptr++ = breakon;
! 1843: *newptr++ = EOL;
! 1844: *newptr++ = 1;
! 1845:
! 1846: k1 = stcpy (newptr, "$zi\201");
! 1847:
! 1848: newptr += k1;
! 1849: *newptr++ = EOL;
! 1850: *newptr++ = k1;
! 1851: *newptr++ = set_sym;
! 1852:
! 1853: return;
! 1854:
! 1855: }
! 1856:
! 1857:
! 1858: /* NEW $ETRAP added 10 Oct 2020, JPW */
! 1859: if (((key[1] | 0140) == 'e') && ((key[2] | 0140) == 't')) { /* NEW $ETRAP */
! 1860:
! 1861: j = stcpy (newptr, etrap);
! 1862:
! 1863: newptr += j;
! 1864: *newptr++ = EOL;
! 1865: *newptr++ = j;
! 1866:
! 1867: k1 = stcpy (newptr, "$et\201");
! 1868:
! 1869: newptr += k1;
! 1870: *newptr++ = EOL;
! 1871: *newptr++ = k1;
! 1872: *newptr++ = set_sym;
! 1873:
! 1874: return;
! 1875:
! 1876: }
! 1877:
! 1878: /* NEW $ESTACK added 12 Oct 2020, JPW */
! 1879: if (((key[1] | 0140) == 'e') && ((key[2] | 0140) == 's')) { /* NEW $ESTACK */
! 1880:
! 1881: char esbuf[256];
! 1882:
! 1883: snprintf (esbuf, 255, "%d\201", estack);
! 1884:
! 1885: j = stcpy (newptr, esbuf);
! 1886:
! 1887: newptr += j;
! 1888: *newptr++ = EOL;
! 1889: *newptr++ = j;
! 1890:
! 1891: k1 = stcpy (newptr, "$es\201");
! 1892:
! 1893: newptr += k1;
! 1894: *newptr++ = EOL;
! 1895: *newptr++ = k1;
! 1896: *newptr++ = set_sym;
! 1897:
! 1898: estack = 0;
! 1899:
! 1900: return;
! 1901:
! 1902: }
! 1903:
! 1904: j = stcpy (newptr, zref); /* NEW $ZREFERENCE */
! 1905:
! 1906: newptr += j;
! 1907: *newptr++ = EOL;
! 1908: *newptr++ = j;
! 1909:
! 1910: k1 = stcpy (newptr, "$zr\201");
! 1911:
! 1912: newptr += k1;
! 1913: *newptr++ = EOL;
! 1914: *newptr++ = nakoffs;
! 1915:
! 1916: k1++;
! 1917:
! 1918: *newptr++ = k1;
! 1919: *newptr++ = set_sym;
! 1920:
! 1921: if (mcmnd != ZNEW) zref[0] = EOL;
! 1922:
! 1923: return;
! 1924:
! 1925:
! 1926: }
! 1927:
! 1928:
! 1929:
! 1930: if ((i = alphptr[(int) key[0]])) { /* is there something to be saved?/killed */
! 1931:
! 1932: /* always FALSE with special variables */
! 1933: kill_from = 0;
! 1934:
! 1935: while (i < PSIZE) {
! 1936:
! 1937: j = i;
! 1938: k = 0;
! 1939:
! 1940: while ((k1 = key[k]) == partition[++j]) { /* compare keys */
! 1941:
! 1942: if (k1 == EOL) break;
! 1943:
! 1944: k++;
! 1945:
! 1946: }
! 1947:
! 1948: if (k1 == EOL && (partition[j] == DELIM || partition[j] == EOL)) {
! 1949:
! 1950: if (kill_from == 0) kill_from = i;
! 1951:
! 1952: }
! 1953: else {
! 1954: if (kill_from) break;
! 1955: }
! 1956:
! 1957: if (kill_from) { /* save current values on new stack */
! 1958:
! 1959: j = UNSIGN (partition[i]);
! 1960: k = i + 1;
! 1961: k1 = j;
! 1962: i += j;
! 1963: j = UNSIGN (partition[i]);
! 1964:
! 1965: if (newptr > newlimit && getnewmore ()) return;
! 1966:
! 1967: #ifdef DEBUG_SYM
! 1968:
! 1969: start = newptr;
! 1970:
! 1971: #endif
! 1972:
! 1973: stcpy0 (newptr, &partition[i + 1], j);
! 1974:
! 1975: newptr += j;
! 1976: *newptr++ = EOL;
! 1977: *newptr++ = j;
! 1978:
! 1979: i += (j + 1);
! 1980:
! 1981: stcpy0 (newptr, &partition[k], k1);
! 1982:
! 1983: newptr += k1;
! 1984: *newptr++ = EOL;
! 1985: *newptr++ = k1;
! 1986: *newptr++ = set_sym;
! 1987:
! 1988: #ifdef DEBUG_SYM
! 1989:
! 1990: printf ("SAVING [newptr] newptr became [");
! 1991:
! 1992: while (start < newptr) {
! 1993:
! 1994: printf ("%c(%d)", (*start==EOL) ? ('!') : *start, *start);
! 1995:
! 1996: start++;
! 1997:
! 1998: }
! 1999:
! 2000: printf("{%d}]\r\n", *(newptr - 1));
! 2001:
! 2002: #endif
! 2003:
! 2004: }
! 2005: else {
! 2006:
! 2007: i += UNSIGN (partition[i]); /* skip key */
! 2008: i += UNSIGN (partition[i]) + 1; /* skip data */
! 2009:
! 2010: }
! 2011:
! 2012: }
! 2013:
! 2014: if (kill_from && mcmnd != ZNEW) {
! 2015:
! 2016: j = i - kill_from;
! 2017: symlen += j;
! 2018: s = &partition[symlen] - 256;
! 2019:
! 2020: for (k = 36; k < key[0]; k++) {
! 2021: if (alphptr[k]) alphptr[k] += j;
! 2022: }
! 2023:
! 2024: if (alphptr[k] == kill_from) {
! 2025:
! 2026: alphptr[k] = i;
! 2027:
! 2028: if (partition[i + 1] != key[0]) alphptr[k] = 0;
! 2029:
! 2030: }
! 2031: else {
! 2032: alphptr[k] += j;
! 2033: }
! 2034:
! 2035: stcpy1 (&partition[i - 1], &partition[i - j - 1], i - symlen);
! 2036:
! 2037: }
! 2038:
! 2039: tryfast = 0;
! 2040:
! 2041: }
! 2042:
! 2043: if (newptr > newlimit && getnewmore ()) return;
! 2044:
! 2045: #ifdef DEBUG_SYM
! 2046: start = newptr;
! 2047: #endif
! 2048:
! 2049: j = stcpy (newptr, key);
! 2050:
! 2051: newptr += j;
! 2052: *newptr++ = EOL;
! 2053: *newptr++ = j;
! 2054: *newptr++ = kill_sym;
! 2055:
! 2056: #ifdef DEBUG_SYM
! 2057:
! 2058: printf ("KILLING [newptr] newptr became [");
! 2059:
! 2060: while (start < newptr) {
! 2061: printf ("%c(%d)", (*start == EOL) ? ('!') : *start,*start );
! 2062:
! 2063: start++;
! 2064:
! 2065: }
! 2066:
! 2067: printf ("{%d}]\r\n", *(newptr - 1));
! 2068:
! 2069: #endif
! 2070:
! 2071: return;
! 2072:
! 2073: /* end of new_sym section */
! 2074:
! 2075:
! 2076: case new_all: /* new all symbols */
! 2077:
! 2078:
! 2079:
! 2080: i = symlen;
! 2081:
! 2082: while (i < PSIZE) {
! 2083:
! 2084: j = UNSIGN (partition[i]);
! 2085: k = i + 1;
! 2086: k1 = j;
! 2087: i += j;
! 2088: j = UNSIGN (partition[i]);
! 2089:
! 2090: if (newptr > newlimit && getnewmore ()) return;
! 2091:
! 2092: stcpy0 (newptr, &partition[i + 1], j);
! 2093:
! 2094: newptr += j;
! 2095: *newptr++ = EOL;
! 2096: *newptr++ = j;
! 2097: i += (j + 1);
! 2098:
! 2099: stcpy0 (newptr, &partition[k], k1);
! 2100:
! 2101: newptr += k1;
! 2102: *newptr++ = EOL;
! 2103: *newptr++ = k1;
! 2104: *newptr++ = set_sym;
! 2105:
! 2106: }
! 2107:
! 2108: *newptr++ = kill_all;
! 2109:
! 2110: if (mcmnd == ZNEW) return;
! 2111:
! 2112: goto genocid; /* ... and now kill them all */
! 2113:
! 2114: /* end of new_all section */
! 2115:
! 2116:
! 2117: case newexcl: /* new all except specified */
! 2118:
! 2119:
! 2120:
! 2121: i = symlen;
! 2122:
! 2123: while (i < PSIZE) {
! 2124:
! 2125: tmp2[0] = SP;
! 2126: kill_from = i;
! 2127:
! 2128: stcpy (tmp3, &partition[i + 1]);
! 2129: stcpy (&tmp2[1], tmp3);
! 2130: stcat (tmp2, " \201");
! 2131:
! 2132: if (kill_ok (key, tmp2) == 0) { /* don't new */
! 2133:
! 2134: i += UNSIGN (partition[i]);
! 2135: i += UNSIGN (partition[i]) + 1;
! 2136:
! 2137: continue;
! 2138:
! 2139: }
! 2140:
! 2141: j = UNSIGN (partition[i]);
! 2142: k = i + 1;
! 2143: k1 = j;
! 2144: i += j;
! 2145: j = UNSIGN (partition[i]);
! 2146:
! 2147: if (newptr > newlimit && getnewmore ()) return;
! 2148:
! 2149: stcpy0 (newptr, &partition[i + 1], j);
! 2150:
! 2151: newptr += j;
! 2152: *newptr++ = EOL;
! 2153: *newptr++ = j;
! 2154: i += (j + 1);
! 2155:
! 2156: stcpy0 (newptr, &partition[k], k1);
! 2157:
! 2158: newptr += k1;
! 2159: *newptr++ = EOL;
! 2160: *newptr++ = k1;
! 2161: *newptr++ = set_sym;
! 2162:
! 2163: while (i < PSIZE) {
! 2164:
! 2165: j = i;
! 2166: k = 0;
! 2167:
! 2168: while ((k1 = tmp3[k]) == partition[++j]) { /* compare keys */
! 2169:
! 2170: if (k1 == EOL) break;
! 2171:
! 2172: k++;
! 2173:
! 2174: }
! 2175:
! 2176: if (k1 != EOL || (partition[j] != DELIM && partition[j] != EOL)) break;
! 2177:
! 2178: j = UNSIGN (partition[i]);
! 2179: k = i + 1;
! 2180: k1 = j;
! 2181: i += j;
! 2182: j = UNSIGN (partition[i]);
! 2183:
! 2184: if (newptr > newlimit && getnewmore ()) return;
! 2185:
! 2186: stcpy0 (newptr, &partition[i + 1], j);
! 2187:
! 2188: newptr += j;
! 2189: *newptr++ = EOL;
! 2190: *newptr++ = j;
! 2191: i += (j + 1);
! 2192:
! 2193: stcpy0 (newptr, &partition[k], k1);
! 2194:
! 2195: newptr += k1;
! 2196: *newptr++ = EOL;
! 2197: *newptr++ = k1;
! 2198: *newptr++ = set_sym;
! 2199:
! 2200: }
! 2201:
! 2202: if (mcmnd == ZNEW) continue;
! 2203:
! 2204: j = i - kill_from;
! 2205: symlen += j;
! 2206: s = &partition[symlen] - 256;
! 2207:
! 2208: for (k = 36; k < tmp3[0]; k++) {
! 2209:
! 2210: if (alphptr[k]) alphptr[k] += j;
! 2211:
! 2212: }
! 2213:
! 2214: if (alphptr[k] == kill_from) {
! 2215:
! 2216: alphptr[k] = i;
! 2217:
! 2218: if (partition[i + 1] != tmp3[0]) alphptr[k] = 0;
! 2219:
! 2220: }
! 2221: else {
! 2222: alphptr[k] += j;
! 2223: }
! 2224:
! 2225: stcpy1 (&partition[i - 1], &partition[i - j - 1], i - symlen);
! 2226:
! 2227: i = kill_from + j;
! 2228:
! 2229: }
! 2230:
! 2231: tryfast = 0;
! 2232:
! 2233: if (newptr > newlimit && getnewmore ()) return;
! 2234:
! 2235: j = stcpy (newptr, key);
! 2236:
! 2237: newptr += (j + 1);
! 2238: *newptr++ = j;
! 2239: *newptr++ = killexcl;
! 2240:
! 2241: return;
! 2242:
! 2243:
! 2244: /* end of newexcl section */
! 2245:
! 2246:
! 2247: case m_alias: /* define an alias of a variable */
! 2248:
! 2249:
! 2250: /* process stuff */
! 2251: if (stcmp (key, data) == 0) return; /* sorry, that's no alias */
! 2252:
! 2253: if (data[0] == EOL) { /* delete an alias from the table */
! 2254:
! 2255: if (aliases) { /* there are aliases */
! 2256:
! 2257: i = 0;
! 2258:
! 2259: while (i < aliases) {
! 2260:
! 2261: k = i;
! 2262: k1 = i + UNSIGN (ali[i]) + 1;
! 2263: j = 0; /* is current reference an alias ??? */
! 2264:
! 2265: while (ali[++i] == key[j]) {
! 2266:
! 2267: if (ali[i] == EOL) break;
! 2268:
! 2269: j++;
! 2270:
! 2271: }
! 2272:
! 2273: /* yes, it is, so resolve it now! */
! 2274: if (ali[i] == EOL && key[j] == EOL) {
! 2275:
! 2276: if (aliases > k1) stcpy0 (&ali[k], &ali[k1], aliases - k1);
! 2277:
! 2278: aliases -= (k1 - k);
! 2279:
! 2280: return;
! 2281:
! 2282: }
! 2283:
! 2284: i = k1;
! 2285:
! 2286: }
! 2287:
! 2288: }
! 2289:
! 2290: return;
! 2291:
! 2292: }
! 2293:
! 2294: /* new entry to alias table. there is no check agains duplicate entries */
! 2295: i = stlen (key);
! 2296: j = stlen (data);
! 2297:
! 2298: ali[aliases++] = (char) (i + j + 2); /* byte for fast skipping */
! 2299:
! 2300: stcpy (&ali[aliases], key);
! 2301: aliases += (i + 1);
! 2302:
! 2303: stcpy (&ali[aliases], data);
! 2304: aliases += (j + 1);
! 2305:
! 2306: /* write note to unmake the alias */
! 2307: j = stcpy (newptr, key);
! 2308: newptr += (j + 1);
! 2309: *newptr++ = j;
! 2310: *newptr++ = m_alias;
! 2311:
! 2312: return;
! 2313:
! 2314: case zdata: /* nonstandard data function */
! 2315:
! 2316:
! 2317:
! 2318: {
! 2319: long counties[128];
! 2320: int icnt, icnt0;
! 2321:
! 2322: i = 0;
! 2323:
! 2324: while (i < 128) counties[i++] = 0L; /* init count; */
! 2325:
! 2326: /* note: we assume EOL<DELIM<ASCII */
! 2327:
! 2328: icnt = 0;
! 2329: i = 0;
! 2330:
! 2331: while ((j = key[i++]) != EOL) {
! 2332: if (j == DELIM) {
! 2333: icnt++;
! 2334: }
! 2335: }
! 2336:
! 2337: if ((i = alphptr[(int) key[0]])) {
! 2338:
! 2339: data[2] = EOL;
! 2340: j = i + 1;
! 2341: k = 1;
! 2342:
! 2343: do {
! 2344:
! 2345: icnt0 = j + 1;
! 2346:
! 2347: while ((k1 = key[k] - partition[++j]) == 0) { /* compare keys */
! 2348:
! 2349: if (key[k] == EOL) break;
! 2350:
! 2351: k++;
! 2352:
! 2353: }
! 2354:
! 2355: if (k1 == 0) {
! 2356: counties[0] = 1;
! 2357: }
! 2358: else {
! 2359:
! 2360: if (partition[j] == DELIM && key[k] == EOL) {
! 2361:
! 2362: int ch;
! 2363:
! 2364: j = icnt0;
! 2365: icnt0 = 0;
! 2366:
! 2367: while ((ch = partition[j++]) != EOL) {
! 2368:
! 2369: if (ch == DELIM) {
! 2370: icnt0++;
! 2371: }
! 2372:
! 2373: }
! 2374:
! 2375: if (icnt0 <= icnt) break;
! 2376:
! 2377: counties[icnt0 - icnt]++;
! 2378:
! 2379: }
! 2380:
! 2381: /* if (k1<0 && k<2) break; */
! 2382:
! 2383: }
! 2384:
! 2385: i += UNSIGN (partition[i]); /* skip key */
! 2386: i += UNSIGN (partition[i]) + 1; /* skip data */
! 2387:
! 2388: j = i;
! 2389: k = 0;
! 2390:
! 2391: } while (i < PSIZE);
! 2392:
! 2393: }
! 2394:
! 2395: i = 128;
! 2396:
! 2397: while (counties[--i] == 0L) ;
! 2398:
! 2399: lintstr (data, counties[0]);
! 2400:
! 2401: j = 1;
! 2402: tmp1[0] = ',';
! 2403:
! 2404: while (j <= i) {
! 2405:
! 2406: lintstr (&tmp1[1], counties[j++]);
! 2407: stcat (data, tmp1);
! 2408:
! 2409: }
! 2410:
! 2411: return;
! 2412: } /* end of $zdata section */
! 2413:
! 2414: } /* end of action switch */
! 2415:
! 2416:
! 2417: /* return next variable or array name - non standard */
! 2418: unsubscr:
! 2419:
! 2420: if (standard) {
! 2421: merr_raise (NEXTER);
! 2422: return;
! 2423: }
! 2424:
! 2425: j = key[0];
! 2426: data[0] = EOL;
! 2427:
! 2428: while (alphptr[j] == 0) {
! 2429: if (++j >= DEL) return;
! 2430: }
! 2431:
! 2432: i = alphptr[j];
! 2433:
! 2434: while (i < PSIZE) {
! 2435:
! 2436: j = i;
! 2437: k = 0;
! 2438:
! 2439: while ((k1 = key[k] - partition[++j]) == 0) { /* compare keys */
! 2440:
! 2441: if (key[k] == EOL) break;
! 2442:
! 2443: k++;
! 2444:
! 2445: }
! 2446:
! 2447: if (k1 < 0 && (partition[j] != DELIM || key[k] != EOL)) {
! 2448:
! 2449: j = i;
! 2450: i = 0;
! 2451:
! 2452: while ((data[i] = partition[++j]) != EOL) {
! 2453:
! 2454: if (data[i] == DELIM) {
! 2455: data[i] = EOL;
! 2456: break;
! 2457: }
! 2458:
! 2459: i++;
! 2460:
! 2461: }
! 2462:
! 2463: return;
! 2464:
! 2465: }
! 2466:
! 2467: i += UNSIGN (partition[i]); /* skip key */
! 2468: i += UNSIGN (partition[i]) + 1; /* skip data */
! 2469:
! 2470: }
! 2471:
! 2472: return;
! 2473:
! 2474: } /* end of symtab() */
! 2475:
! 2476:
! 2477: /******************************************************************************/
! 2478: short int collate (s, t)
! 2479: char *s;
! 2480: char *t;
! 2481: /* if 't' follows 's' in MUMPS collating sequence a 1 is returned
! 2482: * otherwise 0
! 2483: */
! 2484: {
! 2485: short dif;
! 2486:
! 2487: if (s[0] == EOL) return (t[0] != EOL); /* the empty one is the leader! */
! 2488: if (t[0] == EOL) return FALSE;
! 2489: if ((dif = stcmp (t, s)) == 0) return FALSE;
! 2490:
! 2491: if (numeric (s)) { /* then come numerics */
! 2492:
! 2493: if (numeric (t) == FALSE) return TRUE;
! 2494:
! 2495: return comp (s, t);
! 2496:
! 2497: }
! 2498:
! 2499: if (numeric (t)) return FALSE;
! 2500:
! 2501: return dif > 0;
! 2502:
! 2503: } /* end of collate() */
! 2504:
! 2505: /******************************************************************************/
! 2506: short int numeric (char *str)
! 2507: /**
! 2508: * boolean function that tests
! 2509: * whether str is a canonical
! 2510: * numeric
! 2511: */
! 2512: {
! 2513: register int ptr = 0, ch;
! 2514: register int point;
! 2515:
! 2516:
! 2517:
! 2518: if (str[0] == '-') {
! 2519: ptr = 1;
! 2520: }
! 2521: if (str[ptr] == EOL) {
! 2522: return FALSE;
! 2523: }
! 2524: if (str[ptr] == '0') return str[1] == EOL; /* leading zero */
! 2525:
! 2526: point = FALSE;
! 2527:
! 2528: while ((ch = str[ptr++]) != EOL) {
! 2529:
! 2530:
! 2531: if (ch > '9') {
! 2532: return FALSE;
! 2533: }
! 2534:
! 2535: if (ch < '0') {
! 2536:
! 2537: if (ch != '.') return FALSE;
! 2538: if (point) return FALSE; /* multiple points */
! 2539:
! 2540: point = TRUE;
! 2541:
! 2542: }
! 2543:
! 2544: }
! 2545:
! 2546: if (point) {
! 2547:
! 2548: if ((ch = str[ptr - 2]) == '0') return FALSE; /* trailing zero */
! 2549: if (ch == '.') return FALSE; /* trailing point */
! 2550: }
! 2551: return TRUE;
! 2552: } /* end of numeric() */
! 2553:
! 2554: /******************************************************************************/
! 2555: short int comp (s, t)
! 2556: char *s;
! 2557: char *t;
! 2558: /* s and t are strings representing */
! 2559: /* MUMPS numbers. comp returns t>s */
! 2560: {
! 2561:
! 2562: register int s1 = s[0], t1 = t[0], point = '.';
! 2563:
! 2564: #if !defined(_AIX)
! 2565: if (fp_mode) {
! 2566: double fp_s;
! 2567: double fp_t;
! 2568:
! 2569: stcnv_m2c (s);
! 2570: stcnv_m2c (t);
! 2571:
! 2572: fp_s = atof (s);
! 2573: fp_t = atof (t);
! 2574:
! 2575: return fp_t > fp_s;
! 2576: }
! 2577: #endif
! 2578:
! 2579: if (s1 != t1) {
! 2580:
! 2581: if (s1 == '-') return TRUE; /* s<0<t */
! 2582: if (t1 == '-') return FALSE; /* t<0<s */
! 2583: if (s1 == point && t1 == '0') return FALSE; /* s>0; t==0 */
! 2584: if (t1 == point && s1 == '0') return TRUE; /* t>0; s==0 */
! 2585:
! 2586: }
! 2587:
! 2588: if (t1 == '-') {
! 2589:
! 2590: char *a;
! 2591:
! 2592: a = &t[1];
! 2593: t = &s[1];
! 2594: s = a;
! 2595:
! 2596: }
! 2597:
! 2598: s1 = 0;
! 2599:
! 2600: while (s[s1] > point) s1++; /* Note: EOL<'.' */
! 2601:
! 2602: t1 = 0;
! 2603:
! 2604: while (t[t1] > point) t1++;
! 2605:
! 2606: if (t1 > s1) return TRUE;
! 2607: if (t1 < s1) return FALSE;
! 2608:
! 2609: while (*t == *s) {
! 2610:
! 2611: if (*t == EOL) return FALSE;
! 2612:
! 2613: t++;
! 2614: s++;
! 2615:
! 2616: }
! 2617:
! 2618: if (*t > *s) return TRUE;
! 2619:
! 2620: return FALSE;
! 2621:
! 2622: } /* end of comp() */
! 2623: /******************************************************************************/
! 2624: void intstr (str, integ) /* converts integer to string */
! 2625: char *str;
! 2626: short integ;
! 2627: {
! 2628:
! 2629: if (integ < 0) {
! 2630: integ = (-integ);
! 2631: *str++ = '-';
! 2632: }
! 2633:
! 2634: if (integ < 10) {
! 2635:
! 2636: *str++ = integ + '0';
! 2637: *str = EOL;
! 2638:
! 2639: return;
! 2640:
! 2641: }
! 2642: else if (integ < 100) {
! 2643: str += 2;
! 2644: }
! 2645: else if (integ < 1000) {
! 2646: str += 3;
! 2647: }
! 2648: else if (integ < 10000) {
! 2649: str += 4;
! 2650: }
! 2651: else {
! 2652: str += 5;
! 2653: }
! 2654:
! 2655: *str = EOL;
! 2656:
! 2657: do {
! 2658: *(--str) = integ % 10 + '0';
! 2659: } while (integ /= 10);
! 2660:
! 2661: return;
! 2662: } /* end of intstr() */
! 2663:
! 2664: /******************************************************************************/
! 2665: void lintstr (str, integ) /* converts long integer to string */
! 2666: char *str;
! 2667: long integ;
! 2668: {
! 2669: char result[11]; /* 32 bit = 10 digits+sign */
! 2670: register int i = 0;
! 2671:
! 2672: if (integ < 0) {
! 2673: integ = (-integ);
! 2674: *str++ = '-';
! 2675: }
! 2676:
! 2677: do {
! 2678: result[i++] = integ % 10 + '0';
! 2679: } while (integ /= 10);
! 2680:
! 2681: do {
! 2682: *str++ = result[--i];
! 2683: } while (i > 0);
! 2684:
! 2685: *str = EOL;
! 2686:
! 2687: return;
! 2688:
! 2689: } /* end of lintstr() */
! 2690:
! 2691: /****************************************************************/
! 2692:
! 2693: /* user defined special variable table management */
! 2694: /* The symbol table is placed at the high end of 'svntable'. It begins at
! 2695: * 'svnlen' and ends at 'UDFSVSIZ'. The layout is
! 2696: * (keylength)(key...)(<EOL>)(datalength)(data...[<EOL>])
! 2697: * The keys are sorted in alphabetic sequence.
! 2698: *
! 2699: * To have the same fast access regardless of the position in the
! 2700: * alphabet for each character a pointer to the first variable beginning
! 2701: * with that letter is maintained. (0 indicates there's no such var.)
! 2702: */
! 2703: void udfsvn (action, key, data) /* symbol table functions */
! 2704: short action; /* set_sym get_sym */
! 2705: char *key; /* lvn as ASCII-string */
! 2706: char *data;
! 2707: {
! 2708:
! 2709: long keyl; /* length of key */
! 2710: long datal; /* length of data */
! 2711: register long int i, j, k, k1;
! 2712:
! 2713:
! 2714:
! 2715: #ifdef DEBUG_SYM
! 2716:
! 2717: char *start;
! 2718:
! 2719: #endif
! 2720:
! 2721: switch (action) {
! 2722:
! 2723:
! 2724: case get_sym: /* retrieve */
! 2725:
! 2726:
! 2727: if ((i = svnaptr[(int) key[0]])) {
! 2728:
! 2729: k = 1;
! 2730: j = i + 1; /* first char always matches! */
! 2731:
! 2732: do {
! 2733:
! 2734: while (key[k] == svntable[++j]) { /* compare keys */
! 2735:
! 2736: if (key[k++] == EOL) {
! 2737:
! 2738: i = UNSIGN (svntable[++j]);
! 2739: stcpy0 (data, &svntable[j + 1], i);
! 2740: data[i] = EOL;
! 2741:
! 2742: return;
! 2743: }
! 2744:
! 2745: }
! 2746:
! 2747: i += UNSIGN (svntable[i]); /* skip key */
! 2748: i += UNSIGN (svntable[i]) + 1; /* skip data */
! 2749:
! 2750: k = 0;
! 2751: j = i;
! 2752:
! 2753: } while (i < UDFSVSIZ);
! 2754:
! 2755: }
! 2756:
! 2757: merr_raise (ILLFUN);
! 2758: return;
! 2759:
! 2760:
! 2761: case set_sym: /* store/create variable; */
! 2762:
! 2763:
! 2764: if ((keyl = stlen (key) + 2) > STRLEN) {
! 2765: merr_raise (M75);
! 2766: return;
! 2767: } /* key length +2 */
! 2768:
! 2769: datal = stlen (data); /* data length */
! 2770:
! 2771: if ((i = svnaptr[(int) key[0]])) { /* previous entry */
! 2772:
! 2773: j = i + 1;
! 2774: k = 1;
! 2775:
! 2776: }
! 2777: else {
! 2778:
! 2779: i = svnlen;
! 2780: j = i;
! 2781: k = 0;
! 2782:
! 2783: }
! 2784:
! 2785: while (i < UDFSVSIZ) { /* compare keys */
! 2786:
! 2787: while (key[k] == svntable[++j]) {
! 2788:
! 2789: if (key[k] == EOL) goto old;
! 2790:
! 2791: k++;
! 2792:
! 2793: }
! 2794:
! 2795: if (key[k] < svntable[j]) break;
! 2796:
! 2797: i += UNSIGN (svntable[i]); /* skip key */
! 2798: i += UNSIGN (svntable[i]) + 1; /* skip data */
! 2799: j = i;
! 2800: k = 0;
! 2801:
! 2802: }
! 2803:
! 2804: /* if entry found, i pointer to searched entry
! 2805: * else entry not found, i pointer to alphabetically next entry */
! 2806: /* new entry */
! 2807:
! 2808: k = i;
! 2809: j = key[0];
! 2810: i = keyl + datal + 1;
! 2811:
! 2812: if (svnlen <= i) {
! 2813:
! 2814: long dif;
! 2815:
! 2816: dif = getumore ();
! 2817:
! 2818: if (dif == 0L) return;
! 2819:
! 2820: k += dif;
! 2821:
! 2822: }
! 2823:
! 2824: for (k1 = 'a'; k1 <= j; k1++) {
! 2825: if (svnaptr[k1]) svnaptr[k1] -= i;
! 2826: }
! 2827:
! 2828: i = k - i;
! 2829:
! 2830: if (svnaptr[j] == 0 || svnaptr[j] > i) svnaptr[j] = i;
! 2831:
! 2832: i = (svnlen -= (j = keyl + datal + 1));
! 2833: stcpy0 (&svntable[i], &svntable[j + i], k - i);
! 2834:
! 2835: i = k - (keyl + datal + 1);
! 2836: svntable[i++] = (char) (keyl);
! 2837: stcpy (&svntable[i], key); /* store new key */
! 2838:
! 2839: i += keyl - 1;
! 2840: svntable[i++] = (char) (datal);
! 2841: stcpy0 (&svntable[i], data, datal); /* store new data */
! 2842:
! 2843: return;
! 2844:
! 2845: /* there is a previous value */
! 2846: old:
! 2847:
! 2848: i += UNSIGN (svntable[i]);
! 2849: j = UNSIGN (svntable[i]) - datal;
! 2850:
! 2851: if (j < 0) { /* more space needed */
! 2852:
! 2853: if (svnlen <= (-j)) {
! 2854:
! 2855: long dif;
! 2856:
! 2857: dif = getumore ();
! 2858:
! 2859: if (dif == 0L) return;
! 2860:
! 2861: i += dif;
! 2862:
! 2863: }
! 2864:
! 2865: svnlen += j;
! 2866:
! 2867: for (k = 'a'; k < key[0]; k++) {
! 2868: if (svnaptr[k]) svnaptr[k] += j;
! 2869: }
! 2870:
! 2871: if (svnaptr[k] && svnaptr[k] < i) svnaptr[k] += j;
! 2872:
! 2873: k = i + j;
! 2874: i = svnlen;
! 2875: stcpy0 (&svntable[i], &svntable[i - j], k - i);
! 2876:
! 2877: i = k;
! 2878:
! 2879: }
! 2880: else if (j > 0) { /* surplus space */
! 2881:
! 2882: svnlen += j;
! 2883:
! 2884: for (k = 'a'; k < key[0]; k++) {
! 2885: if (svnaptr[k]) svnaptr[k] += j;
! 2886: }
! 2887:
! 2888: if (svnaptr[k] && svnaptr[k] < i) svnaptr[k] += j;
! 2889:
! 2890: i += j;
! 2891: k = i;
! 2892: j = i - j;
! 2893:
! 2894: while (i >= svnlen) {
! 2895: svntable[i--] = svntable[j--];
! 2896: }
! 2897:
! 2898: i = k;
! 2899:
! 2900: }
! 2901:
! 2902: svntable[i++] = (char) (datal);
! 2903:
! 2904: stcpy0 (&svntable[i], data, datal); /* store new data */
! 2905:
! 2906: return;
! 2907: /* end of set_sym section */
! 2908: }
! 2909: } /* end user defined special variable table */
! 2910:
! 2911:
! 2912: /******************************************************************************/
! 2913: long getpmore ()
! 2914: { /* try to get more 'partition' space. returns size increment */
! 2915:
! 2916: long siz;
! 2917: long dif;
! 2918:
! 2919: if (autopsize == FALSE) return 0L;
! 2920:
! 2921: siz = PSIZE;
! 2922:
! 2923: if (siz % 1024) siz = (siz & ~01777) + 02000; /* round for full kB; */
! 2924:
! 2925: siz += 01777;
! 2926: dif = siz - PSIZE;
! 2927:
! 2928: if (newpsize (siz)) return 0L;
! 2929:
! 2930: return dif;
! 2931:
! 2932: } /* end getpmore */
! 2933:
! 2934: /******************************************************************************/
! 2935: long getumore ()
! 2936: { /* try to get more udfsvntab space. returns size increment */
! 2937: long siz, dif;
! 2938:
! 2939: if (autousize == FALSE) {
! 2940: merr_raise (STORE);
! 2941: return 0L;
! 2942: }
! 2943:
! 2944: siz = UDFSVSIZ;
! 2945:
! 2946: if (siz % 1024) siz = (siz & ~01777) + 02000; /* round for full kB; */
! 2947:
! 2948: siz += 01777;
! 2949: dif = siz - UDFSVSIZ;
! 2950:
! 2951: if (newusize (siz)) {
! 2952: merr_raise (STORE);
! 2953: return 0L;
! 2954: }
! 2955:
! 2956: return dif;
! 2957:
! 2958: } /* end getumore */
! 2959:
! 2960: /******************************************************************************/
! 2961: long getrmore ()
! 2962: { /* try to get more routine space. returns size increment */
! 2963: long siz, dif;
! 2964: short i;
! 2965:
! 2966: if (autorsize == FALSE) {
! 2967: merr_raise (PGMOV);
! 2968: return 0L;
! 2969: }
! 2970:
! 2971: siz = PSIZE0;
! 2972:
! 2973: if (siz % 1024) siz = (siz & ~01777) + 02000; /* round for full kB; */
! 2974:
! 2975: siz += 01777;
! 2976: dif = siz - PSIZE0;
! 2977:
! 2978: for (i = 0; i < NO_OF_RBUF; i++) { /* empty routine buffer */
! 2979: pgms[i][0] = EOL;
! 2980: ages[i] = 0L;
! 2981: }
! 2982:
! 2983: if (newrsize (siz, NO_OF_RBUF)) {
! 2984: merr_raise (PGMOV);
! 2985: return 0L;
! 2986: }
! 2987:
! 2988: return dif;
! 2989:
! 2990: } /* end getrmore */
! 2991:
! 2992: /******************************************************************************/
! 2993: short int getnewmore ()
! 2994: { /* enlarge new_buffers */
! 2995: char *newbuf;
! 2996: int i;
! 2997: long dif;
! 2998:
! 2999: newbuf = calloc ((unsigned) (NSIZE + 4096), 1); /* new_buffer */
! 3000:
! 3001: if (newbuf == NULL) { /* could not allocate stuff... */
! 3002: merr_raise (STKOV);
! 3003: return 1;
! 3004: }
! 3005:
! 3006: stcpy0 (newbuf, newstack, (long) NSIZE);
! 3007:
! 3008: dif = newbuf - newstack;
! 3009:
! 3010: free (newstack); /* free previously allocated space */
! 3011:
! 3012: newstack = newbuf;
! 3013: NSIZE += 4096;
! 3014: newptr += dif;
! 3015: newlimit = newstack + NSIZE - 1024;
! 3016: i = 0;
! 3017:
! 3018: while (i <= nstx) {
! 3019:
! 3020: if (nestnew[i]) nestnew[i] += dif;
! 3021:
! 3022: i++;
! 3023:
! 3024: }
! 3025:
! 3026: return 0;
! 3027:
! 3028: } /* end getnewmore() */
! 3029: /******************************************************************************/
! 3030:
! 3031:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to symtab_bltin.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem / src