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