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