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