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