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