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