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