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