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