![[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|
Return to symtab_bltin.c CVS log | Up to [Coherent Logic Development] / freem / src |
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: