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