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