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