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