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