1: /*
2: * $Id: global_bltin.c,v 1.6 2025/03/24 01:33:30 snw Exp $
3: * freem database engine
4: *
5: *
6: * Author: Serena Willis <snw@coherent-logic.com>
7: * Copyright (C) 1998 MUG Deutschland
8: * Copyright (C) 2020, 2025 Coherent Logic Development LLC
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: *
26: * $Log: global_bltin.c,v $
27: * Revision 1.6 2025/03/24 01:33:30 snw
28: * Guard declaration of time function in global_bltin.c for portability
29: *
30: * Revision 1.5 2025/03/22 22:52:24 snw
31: * Add STRLEN_GBL macro to manage global string length
32: *
33: * Revision 1.4 2025/03/09 19:14:25 snw
34: * First phase of REUSE compliance and header reformat
35: *
36: *
37: * SPDX-FileCopyrightText: (C) 2025 Coherent Logic Development LLC
38: * SPDX-License-Identifier: AGPL-3.0-or-later
39: **/
40:
41: #include <sys/types.h>
42: #include <sys/stat.h>
43: #include <fcntl.h>
44: #include <unistd.h>
45: #include <string.h>
46:
47: #include <errno.h>
48:
49:
50: #include "mpsdef.h"
51:
52: static void b_free (short filedes, unsigned long blknbr);
53: static void splitp (short filedes, char *block, long *addr, long *offs, unsigned long *blknbr);
54: static void update (short filedes, char *ins_key, long keyl);
55: static void insert (int filedes, char *ins_key, long key_len, unsigned long blknbr);
56: static void scanpblk (char *block, long *adr, long *fnd);
57: static void scandblk (char *block, long *adr, long *fnd);
58: static void getnewblk (int filedes, unsigned long *blknbr);
59: static short int g_collate (char *t);
60: //static short int g_numeric (char *str);
61: short g_numeric (char *str);
62: void close_all_globals(void);
63: static void panic (void);
64:
65: #define ROOT 0L
66:
67: /* end of line symbol in global module is 30, which is a code not */
68: /* otherwise used in subscripts */
69: #define g_EOL 30
70:
71: #define EOL1 EOL
72:
73: /* numerics (('.'<<1)&037)==28 ; (('-'<<1)&037)==26; */
74: #define POINT 28
75: #define MINUS 26
76:
77: /* ALPHA and OMEGA are dummy subscripts in $order processing */
78: /* ALPHA sorts before all other subscripts */
79: /* OMEGA sorts after all other subscripts */
80: /* e.g. ("abc") -> "abc",OMEGA ; ("abc","") -> "abc",ALPHA */
81: #define OMEGA 29
82: #define ALPHA 31
83:
84: /* length of blocks. status bytes defined as offset to blocklength */
85: /* BLOCKLEN 1024 is defined in mpsdef0 include file */
86: #define DATALIM (BLOCKLEN-11)
87: #define LLPTR (BLOCKLEN-10)
88: #define NRBLK LLPTR
89: #define COLLA (BLOCKLEN- 7)
90: #define RLPTR (BLOCKLEN- 6)
91: #define FREE RLPTR
92: #define BTYP (BLOCKLEN- 3)
93: #define OFFS (BLOCKLEN- 2)
94:
95: /* length of blockpointers in bytes */
96: #define PLEN 3
97:
98: #define EMPTY 0
99: #define FBLK 1
100: #define POINTER 2
101: #define BOTTOM 6
102: #define DATA 8
103:
104: #if !defined(__OpenBSD__) && !defined(_AIX) && !defined(__osf__) && !defined(MSDOS) && !defined(__vax__) && !defined(__OS2__)
105: long time ();
106: #endif
107:
108: /* globals management */
109:
110: /* 0 = set_sym 1 = get_sym */
111: /* 2 = kill_sym 3 = $data */
112: /* 5 = $fra_order */
113: /* 7 = $fra_query */
114: /* */
115: /* 14=killone 13=getnext */
116: /* 16=merge_sym 17=$zdata */
117: /* gvn as ASCII-string */
118:
119: /* returns OK action fulfilled */
120: /* (ierr) UNDEF missing in action */
121: /* NAKED illegal naked reference */
122: /* SBSCR illegal subscript */
123: /* DBDGD data base degradation */
124:
125: /* The data is organized in a B* tree structure on external storage.
126: * For a description of the principles of the algorithms see
127: * Donald E. Knuth "The Art of Computer Programming" vol. 3 p. 478.
128: * This tree structure guarantees fast disk access and is the
129: * canonical way to implement M globals.
130: *
131: * Each M global occupies a separate UNIX file in the directory
132: * specified in the globals_path directive for the current namespace
133: * in /etc/freem.conf. The default namespace on a new installation
134: * of FreeM is called "USER".
135: *
136: * Any global whose name begins with "%" will always be stored in the
137: * SYSTEM namespace, in the directory specified in its "globals_path"
138: * directive in /etc/freem.conf (by default, /var/local/freem/SYSTEM/globals).
139: *
140: * The UNIX file names are the same as the corresponding M global
141: * names; i.e. beginning with an '^'. However it is possible to access
142: * globals in other directories if the path name is specified.
143: * E.g. "S ^/usr/mumps/test=1" does "S ^test=1" in the file /usr/mumps/^test.
144: * If FreeM is started with the -s/--standard switches, it is not possible
145: * to specify a directory. There is a syntactic ambiguity: the '/' character
146: * in the directory name is in conflict with the '/' divide operator. Use
147: * parentheses to make things clear:
148: *
149: * ^/usr/mumps/test/2 ; '/2' is part of the name
150: * (^/usr/mumps/test)/2 ; ambiguity resolved
151: * ^test/2 ; '/2' is a divide operation
152: * ^/usr/mumps/test("ok")/2 ; '/2' is a divide
153: *
154: * To prevent jobs from messing the globals up, access is regulated
155: * with the 'locking' mechanism. (that is different from mumps LOCKs)
156: *
157: * Data is organized in blocks of 1024 bytes (BLOCKLEN) with the following
158: * layout:
159: * byte 0 - 1013 'stuff' 0...DATALIM
160: * organization is:
161: * length of key (minus offset into previous key)
162: * offset into previous key
163: * key (without EOL character)
164: * length of data or two bytes as pointer
165: * data(without EOL character) in pointer blocks
166: *
167: * byte 1014 - 1016 leftlink pointer LLPTR
168: * in root block: number of blocks NRBLK
169: * byte 1017 <reserved>
170: * byte 1017 in root block: type of collating sequence COLLA
171: * LSB=0: numeric(standard) LSB=1: alphabetic
172: * byte 1018 - 1020 rightlink pointer RLPTR
173: * in root block: number of free blocks list FREE
174: * byte 1021 block type BTYP
175: * (2=POINTER,6=BOTTOM LEVEL POINTER,8=DATA)
176: * byte 1022 - 1023 offset OFFS
177: * (pointer to unused part of 'stuff')
178: *
179: * the file is *not* closed on return. since access is regulated by the
180: * locking mechanism, that will not spell trouble.
181: */
182:
183: void global_bltin (short action, char *key, char *data)
184: {
185:
186: /* these must be static variables */
187:
188: static short filedes; /* filedescr for global access */
189: static char filnam[256]; /* name of global/unix file */
190:
191: /* the following vars may be */
192: /* static or dynamic */
193:
194: static unsigned long blknbr; /* block number */
195: static unsigned long oldblk;
196: static unsigned long newblk;
197: static unsigned long other;
198: static long j1;
199: static long limit;
200: static short typ; /* block type */
201: static long keyl, /* length of compacted key */
202: datal, /* length of data */
203: olddatal,
204: offset,
205: found,
206: addr, /* address of key in 'block' */
207: needed, /* new bytes needed to ins. stuff */
208: ret_to, /* return code */
209: kill_again;
210: static char key1[256];
211: static char tmp1[256]; /* intermediate storage for op= */
212: static char block[BLOCKLEN];
213: static int getnflag; /* flag 1=$ZO-variable 0=$Q-function */
214: static int tryfast; /* try fast access if get_sym on */
215: /* previous global */
216:
217: struct stat dinf; /* get modification date */
218:
219: long savj,
220: savch; /* saved j and ch for multiple pathes */
221: register long int i,
222: j,
223: k,
224: ch;
225: long pathscan; /* flag for repeated scan of pathlist setting an undef global */
226:
227:
228: /* process optional limitations */
229: if (glvnflag.all && key[0] >= '%' && key[0] <= 'z') {
230:
231: if ((i = glvnflag.one[0])) { /* number of significant chars */
232:
233: j = 0;
234: while ((k = key[j]) != DELIM && k != EOL) {
235:
236: if (j >= i) {
237:
238: while ((k = key[++j]) != DELIM && k != EOL);
239:
240: stcpy (&key[i], &key[j]);
241:
242: break;
243: }
244:
245: j++;
246:
247: }
248: }
249:
250: if (glvnflag.one[1]) { /* upper/lower sensitivity */
251:
252: j = 0;
253:
254: while ((k = key[j]) != DELIM && k != EOL) {
255:
256: if (k >= 'a' && k <= 'z') key[j] = k - 32;
257:
258: j++;
259:
260: }
261:
262: }
263:
264: if ((i = glvnflag.one[2])) {
265:
266: if (stlen (key) > i) {
267: merr_raise (M75);
268: return;
269: } /* key length limit */
270:
271: }
272:
273: if ((i = glvnflag.one[3])) { /* subscript length limit */
274:
275: j = 0;
276:
277: while ((k = key[j++]) != DELIM && k != EOL);
278:
279: if (k == DELIM) {
280:
281: k = 0;
282: for (;;) {
283:
284: k = key[j++];
285:
286: if (k == DELIM || k == EOL) {
287:
288: if (k > i) {
289: merr_raise (M75);
290: return;
291: }
292:
293: k = 0;
294: }
295:
296: if (k == EOL) break;
297:
298: k++;
299: }
300: }
301: }
302: }
303:
304: if (action == getnext) {
305:
306: getnflag = TRUE;
307: varnam[0] = EOL;
308:
309: if (zref[0] == EOL) {
310: merr_raise (M7);
311: data[0] = EOL;
312:
313: return;
314: }
315:
316: stcpy (key, zref);
317:
318: action = fra_query;
319: ordercnt = 1L;
320: }
321: else {
322:
323: getnflag = FALSE;
324:
325: /* naked reference section */
326:
327: if (key[1] == DELIM) { /* resolve naked reference */
328:
329: while (--nakoffs >= 0) { /* naked reference pointer */
330: if (zref[nakoffs] == DELIM) break;
331: }
332:
333: if ((i = ++nakoffs) == 0) { /* illegal naked reference */
334: data[0] = EOL1;
335: merr_raise (NAKED);
336:
337: return;
338: }
339:
340: j = 2;
341: while ((zref[i] = key[j++]) != EOL) {
342:
343: if ((++i) >= STRLEN) {
344: zref[255] = EOL;
345: merr_raise (M75);
346:
347: return;
348: }
349:
350: }
351: nakoffs = stcpy (key, zref);
352: }
353: else {
354:
355: /* only save off $REFERENCE if the global isn't part of SSVN backing storage */
356: if (key[1] != '$') {
357: nakoffs = stcpy (zref, key); /* save reference */
358: }
359:
360: }
361: }
362:
363: if (v22ptr) {
364:
365: procv22 (key);
366:
367: if (key[0] != '^') {
368: char losav[256];
369:
370: stcpy (losav, l_o_val);
371: symtab (action, key, data);
372: stcpy (g_o_val, l_o_val);
373: stcpy (l_o_val, losav);
374:
375: return;
376: }
377: }
378:
379: /* construct full UNIX filename */
380: savj = 0;
381: savch = ch = EOL;
382: pathscan = TRUE;
383: nextpath:
384: k = 0;
385: j = savj;
386:
387: if (key[1] == '%' || key[1] == '$') { /* %-globals and SSVN backing storage, no explicit path */
388:
389: if (gloplib[0] != EOL) {
390:
391: /* append % global access path */
392: while ((ch = filnam[k++] = gloplib[j++]) != ':' && ch != EOL);
393:
394: }
395:
396: }
397: else if (key[1] != '/') { /* no explicit path specified */
398:
399: if (glopath[0] != EOL) {
400:
401: /* append global access path */
402: while ((ch = filnam[k++] = glopath[j++]) != ':' && ch != EOL);
403:
404: }
405:
406: }
407:
408: if (savj == 0 && ch == EOL) pathscan = FALSE; /* one path only: inhibit search */
409:
410: if (k > 0) {
411:
412: if (k == 1 || (k == 2 && filnam[0] == '.')) {
413: k = 0;
414: }
415: else {
416: filnam[k - 1] = '/';
417: }
418:
419: }
420:
421: savch = ch;
422: savj = j;
423: i = 0;
424: j = 0;
425:
426: while (key[i] != EOL) {
427:
428: if ((filnam[k] = key[i]) == DELIM) break;
429:
430: if (filnam[k] == '/') {
431:
432: j = i;
433:
434: if (k > i) {
435: i = 0;
436: j = 0;
437: k = 0;
438:
439: continue;
440: }
441:
442: }
443:
444: i++;
445: k++;
446:
447: }
448:
449: filnam[k] = NUL; /* NUL not EOL !!! */
450:
451: /* if a unix directory is specified, reposition '^' */
452: /* '^/usr/test' becomes '/usr/^test' */
453: if (j > 0) {
454:
455: for (k = 0; k < j; k++) {
456: filnam[k] = filnam[k + 1];
457: }
458:
459: filnam[j] = '^';
460:
461: }
462:
463: /* compact key to internal format: characters are shifted left */
464: /* delimiters become LSB of previous character */
465: /* test subscripts for being numeric or not */
466: /* numeric values are shifted into the code space */
467: /* that is available because of illegal CTRL subscipts */
468:
469: k = 0;
470:
471: if (key[i] == EOL) { /* unsubscripted variable */
472:
473: if (action == fra_order) {
474: g_o_val[0] = EOL;
475: merr_raise (NEXTER);
476:
477: return;
478: }
479:
480: }
481: else if (key[++i] == EOL) { /* empty (first) subscript */
482:
483: if ((action != fra_order) && (action != fra_query)) {
484: merr_raise (SBSCR);
485: return;
486: }
487:
488: }
489: else { /* non empty subscript */
490:
491: j1 = g_numeric (&key[i]);
492:
493: while ((ch = key[i++]) != EOL) {
494:
495: if (ch == DELIM) {
496:
497: if (k == 0) {
498: merr_raise (SBSCR);
499: return;
500: }
501:
502: if (compactkey[--k] & 01) {
503: merr_raise (SBSCR);
504: return;
505: }
506:
507: compactkey[k++] |= 01;
508: j1 = g_numeric (&key[i]);
509:
510: }
511: else if (UNSIGN (ch) >= DEL) { /* transform 8bit char to 7bit */
512:
513: compactkey[k++] = (DEL << 1);
514: ch = UNSIGN (ch) - DEL;
515:
516: if (UNSIGN (ch) >= DEL) {
517: compactkey[k++] = (DEL << 1);
518: ch = UNSIGN (ch) - DEL;
519: }
520:
521: compactkey[k++] = ch << 1;
522:
523: }
524: else if (ch < SP || ch >= DEL) {
525:
526: /*no CTRLs */
527:
528: merr_raise (SBSCR);
529: return;
530: }
531: else {
532: compactkey[k++] = (j1 ? (ch << 1) & 036 : ch << 1);
533: }
534: }
535:
536: }
537:
538: if (action == fra_order) {
539:
540: if (ordercnt > 0) {
541:
542: compactkey[k] = (k == 0 || (compactkey[k - 1] & 01) ? ALPHA : OMEGA);
543:
544: if (k > 0) compactkey[k - 1] |= 01;
545:
546: keyl = (++k);
547:
548: }
549: else if (ordercnt == 0) { /* no scan at all */
550:
551: k = 0;
552: i = 0;
553:
554: while ((ch = key[i++]) != EOL) {
555: if (ch == DELIM) k = i;
556: }
557:
558: stcpy (data, &key[k]);
559: g_o_val[0] = EOL;
560:
561: return;
562:
563: }
564: else { /* backward scanning */
565:
566: if (k == 0 || (compactkey[k - 1] & 01)) {
567:
568: compactkey[k] = OMEGA;
569:
570: if (k > 0) compactkey[k - 1] |= 01;
571:
572: k++;
573:
574: }
575: else {
576: compactkey[k - 1] |= 01;
577: }
578:
579: keyl = k;
580: }
581:
582: }
583: else {
584:
585: if ((keyl = k) > 0) {
586:
587: if ((compactkey[--k] & 01) && (action != fra_query)) {
588: merr_raise (SBSCR);
589: return;
590: }
591:
592: compactkey[k++] |= 01;
593: }
594: }
595:
596: compactkey[k] = g_EOL;
597:
598: /* look whether file is already open */
599: tryfast = FALSE;
600: ch = usage[i = j = inuse];
601:
602: while (i < NO_GLOBLS) {
603:
604: k = 0;
605:
606: while (filnam[k] == oldfil[i][k]) {
607:
608: if (filnam[k++] == NUL) {
609:
610: filedes = olddes[i];
611:
612: if (inuse == i && action == get_sym) {
613:
614: tryfast = TRUE;
615:
616: if (usage[i] != (-1)) usage[i]++;
617: if (lonelyflag) goto tfast2;
618:
619: fstat (filedes, &dinf);
620:
621: if (g_ages[i] > dinf.st_mtime) goto tfast2;
622:
623: g_ages[i] = time (0L);
624:
625: goto tfast0;
626:
627: }
628:
629: inuse = i;
630:
631: if (usage[i] != (-1)) usage[i]++;
632:
633: goto lock;
634: }
635:
636: }
637:
638: if (ch < 0 || (usage[i] >= 0 && usage[i] < ch)) ch = usage[j = i];
639:
640: if (i++ == inuse) {
641: inuse = (-1);
642: i = 0;
643: }
644:
645: }
646:
647: inuse = j;
648: usage[j] = 1;
649:
650: /* close previous file */
651: if ((filedes = olddes[j]) > 0) {
652: close (filedes);
653: olddes[j] = 0;
654: }
655:
656: strcpy (oldfil[j], filnam); /* save current filename */
657:
658: reopen:
659:
660: for (;;) {
661:
662: errno = 0;
663:
664: if ((filedes = open (filnam, 2)) != -1) break;
665: if (errno == EINTR) continue;
666:
667: if (errno == EMFILE || errno == ENFILE) { /* too many open files now */
668: close_all_globals ();
669:
670: continue;
671: }
672:
673: break;
674: }
675:
676: if (filedes == -1) {
677:
678: usage[inuse] = 0;
679: oldfil[inuse][0] = NUL;
680: olddes[inuse] = 0;
681: g_ages[inuse] = 0;
682:
683: if ((pathscan || errno != ENOENT) && (savch != EOL)) goto nextpath; /* try next access path */
684:
685: /* file not found */
686: if (action != set_sym) {
687:
688: if (errno != ENOENT) {
689: merr_raise (PROTECT);
690: return;
691: }
692:
693: if (action == dat || action == zdata) {
694: data[0] = '0';
695: data[1] = EOL1;
696:
697: return;
698: }
699:
700: data[0] = EOL1;
701:
702: if (action == get_sym || getnflag) {
703: merr_raise (M7);
704: data[0] = EOL;
705: }
706: else if (action == fra_order || action == fra_query) {
707: g_o_val[0] = EOL;
708: }
709:
710: return;
711: }
712:
713: if (errno != ENOENT) {
714: merr_raise (PROTECT);
715: return;
716: }
717:
718: if (pathscan) {
719: savj = 0;
720: savch = ch = EOL;
721: pathscan = FALSE;
722:
723: goto nextpath;
724: }
725:
726: if (setop) {
727:
728: tmp1[0] = EOL;
729: m_op (tmp1, data, setop);
730: setop = 0;
731:
732: if (merr () > OK) return;
733:
734: datal = stcpy (data, tmp1);
735: }
736:
737: for (i = 0; i < BLOCKLEN; block[i++] = 0); /* clear block */
738:
739: stcpy0 (&block[2], compactkey, (long) keyl);
740:
741: block[0] = keyl; /* $length of key */
742: j = i = keyl + 2;
743: block[i++] = 0;
744: block[i++] = 0;
745: block[i++] = ROOT + 1; /* block 1 = data */
746: block[BTYP] = BOTTOM;
747: block[COLLA] = 0; /* collating sequence */
748: block[OFFS] = i / 256;
749: block[OFFS + 1] = i % 256;
750: block[NRBLK] = 0;
751: block[NRBLK + 1] = 0;
752: block[NRBLK + 2] = ROOT + 1; /* nr. of blocks */
753:
754: /* create file, write_lock it and initialize root block */
755: for (;;) {
756:
757: errno = 0;
758:
759: if ((filedes = creat (filnam, 0666)) != -1) break;
760:
761: if (errno == EMFILE || errno == ENFILE) {
762: close_all_globals ();
763: continue;
764: }
765:
766: merr_raise (PROTECT);
767: return;
768: }
769:
770: if (lonelyflag == FALSE) locking (filedes, 1, 0L);
771:
772: for (;;) {
773:
774: errno = 0;
775:
776: lseek (filedes, ROOT * BLOCKLEN, 0);
777: write (filedes, block, BLOCKLEN);
778:
779: if (errno == 0) break;
780:
781: panic ();
782: }
783:
784: block[NRBLK] = 0;
785: block[NRBLK + 1] = 0;
786: block[NRBLK + 2] = ROOT; /* clear */
787:
788: /* copy and write length of data */
789: block[j] = k = stcpy (&block[j + 1], data);
790: block[i = k + j + 1] = 0; /* clear EOL symbol */
791: block[BTYP] = DATA; /* type */
792: block[OFFS] = i / 256;
793: block[OFFS + 1] = i % 256;
794:
795: for (;;) {
796:
797: errno = 0;
798: write (filedes, block, BLOCKLEN);
799:
800: if (errno == 0) break;
801:
802: lseek (filedes, (ROOT + 1L) * BLOCKLEN, 0);
803: panic ();
804:
805: }
806:
807: close (filedes);
808:
809: if (lonelyflag == FALSE) locking (filedes, 0, 0L); /* unlock */
810:
811: /* close new file, so other users can find it */
812: return;
813: }
814:
815: olddes[inuse] = filedes; /* save current filedescriptor */
816:
817: /* request global for exclusive use */
818: /* odd numbered actions get read access (get_sym,data,fra_order) 3 */
819: /* even ones read/write access (set_sym,kill_sym) 1 */
820:
821: lock:
822:
823: if (action == get_sym) {
824:
825: tfast0:
826:
827: if (lonelyflag == FALSE) locking (filedes, 3, 0L);
828: if (tryfast) goto tfast1; /* try again last block */
829:
830: blknbr = oldblk = ROOT; /* start with ROOT block */
831:
832: for (;;) {
833:
834:
835: tfast1:
836:
837: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
838: read (filedes, block, BLOCKLEN);
839:
840:
841: tfast2:
842:
843: if ((typ = block[BTYP]) == DATA) { /* scan data block: here we test for equality only */
844:
845: offset = UNSIGN (block[OFFS]) * 256 +
846: UNSIGN (block[OFFS + 1]);
847: j = UNSIGN (block[0]);
848: i = 0;
849:
850: stcpy0 (key1, &block[2], j); /* get first key */
851:
852: ch = keyl; /* ch is a register! */
853:
854: while (i < offset) {
855:
856: j = UNSIGN (block[i++]); /* length of key - offset */
857: k = UNSIGN (block[i++]); /* offset into previous entry */
858:
859: #ifdef VERSNEW
860:
861: stcpy0 (&key0[k], &block[i], j);
862: i += j;
863: j += k;
864:
865: #else
866:
867: j += k;
868:
869: while (k < j) key1[k++] = block[i++]; /* get key */
870:
871: #endif /* VERSNEW */
872:
873: if (j != ch) { /* keys have different length */
874:
875: i += UNSIGN (block[i]);
876: i++;
877:
878: continue;
879:
880: }
881:
882: /* key1[j]=g_EOL; */
883: j = ch;
884:
885: do {
886: j--;
887: } while (compactkey[j] == key1[j]); /* compare keys */
888:
889:
890: if (j < 0) {
891:
892: k = UNSIGN (block[i++]);
893: stcpy0 (data, &block[i], k); /* get value */
894: data[k] = EOL1; /* append EOL */
895:
896: goto quit;
897:
898: }
899:
900: i += UNSIGN (block[i]);
901: i++; /* skip data */
902:
903: }
904:
905: /* fast access failed. try normal path */
906: if (tryfast) {
907: tryfast = FALSE;
908: goto tfast0;
909: }
910:
911: merr_raise (M7);
912: data[0] = EOL;
913:
914: goto quit; /* variable not found */
915: }
916: else {
917:
918: if (tryfast) {
919: tryfast = FALSE;
920: goto tfast0;
921: }
922:
923: if (typ == EMPTY) {
924:
925: if (blknbr == ROOT) {
926: close (filedes);
927: goto reopen;
928: }
929:
930: merr_raise (DBDGD);
931: goto quit;
932:
933: }
934:
935: }
936:
937: scanpblk (block, &addr, &found);
938:
939: addr += UNSIGN (block[addr]) + 2; /* skip key */
940:
941: if ((blknbr = UNSIGN (block[addr]) * 65536 + UNSIGN (block[addr + 1]) * 256 + UNSIGN (block[addr + 2])) == oldblk) {
942: merr_raise (DBDGD);
943: goto quit;
944: }
945:
946: addr += PLEN; /* skip data */
947: oldblk = blknbr;
948:
949: if (merr () == INRPT) goto quit;
950:
951: }
952: } /* end of get_sym */
953:
954:
955: if (lonelyflag == FALSE) locking (filedes, (action & 01 ? 3 : 1), 0L);
956:
957: /* a KILL on an unsubscripted global deletes the entire file */
958: if (action == kill_sym && compactkey[0] == g_EOL) {
959:
960: lseek (filedes, ROOT, 0);
961:
962: /* note : UNIX does not tell other */
963: block[BTYP] = EMPTY; /* jobs that a file has been unlinked */
964:
965: /* as long as they keep it open. */
966: /* so we mark this global as EMPTY */
967: write (filedes, block, BLOCKLEN);
968:
969: if (lonelyflag == FALSE) locking (filedes, 0, 0L); /* unlock */
970:
971: close (filedes);
972:
973: olddes[inuse] = 0;
974: oldfil[inuse][0] = NUL;
975: usage[inuse] = 0;
976:
977: unlink (filnam);
978:
979: return;
980: }
981:
982: k_again: /* entry point for repeated kill operations */
983:
984: /* scan tree for the proper position of key */
985: blknbr = oldblk = ROOT; /* start with ROOT block */
986: trx = (-1);
987:
988: for (;;) {
989:
990: if (++trx >= TRLIM) {
991: merr_raise (STKOV);
992: goto quit;
993: }
994:
995: traceblk[trx] = blknbr;
996: traceadr[trx] = 0;
997:
998: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
999: read (filedes, block, BLOCKLEN);
1000:
1001: typ = block[BTYP];
1002:
1003: if (typ == DATA) {
1004: scandblk (block, &addr, &found);
1005: break;
1006: }
1007:
1008: if (typ == EMPTY) {
1009:
1010: if (blknbr == ROOT) {
1011: close (filedes);
1012: goto reopen;
1013: }
1014:
1015: merr_raise (DBDGD);
1016: goto quit;
1017: }
1018:
1019: scanpblk (block, &addr, &found);
1020:
1021: traceadr[trx] = addr;
1022: addr += UNSIGN (block[addr]);
1023: addr += 2; /* skip key */
1024:
1025: if ((blknbr = UNSIGN (block[addr]) * 65536 + UNSIGN (block[addr + 1]) * 256 + UNSIGN (block[addr + 2])) == oldblk) {
1026: merr_raise (DBDGD);
1027: goto quit;
1028: }
1029:
1030: addr += PLEN; /* skip data */
1031: oldblk = blknbr;
1032: }
1033:
1034: traceadr[trx] = addr;
1035:
1036: switch (action) {
1037:
1038: case set_sym:
1039:
1040: datal = stlen (data);
1041: offset = UNSIGN (block[OFFS]) * 256 +
1042: UNSIGN (block[OFFS + 1]);
1043:
1044: if (found != 2) { /* new entry */
1045:
1046: if (setop) {
1047:
1048: tmp1[0] = EOL;
1049:
1050: m_op (tmp1, data, setop);
1051:
1052: setop = 0;
1053:
1054: if (merr () > OK) return;
1055:
1056: datal = stcpy (data, tmp1);
1057:
1058: }
1059:
1060: needed = keyl + datal + 3;
1061:
1062: if ((offset + needed) > DATALIM) {
1063: ret_to = 'n'; /* n=new */
1064: goto splitd;
1065: }
1066:
1067:
1068: s10: {
1069: long len; /* insert key */
1070: char key0[256];
1071:
1072: i = 0;
1073:
1074: while (i < addr) { /* compute offset into previous entry */
1075:
1076: len = UNSIGN (block[i++]);
1077:
1078: #ifdef VERSNEW
1079:
1080: k = UNSIGN (block[i++]);
1081: stcpy0 (&key0[k], &block[i], len);
1082:
1083: i += len;
1084: key0[k + len] = g_EOL;
1085:
1086: #else
1087:
1088: len += (k = UNSIGN (block[i++]));
1089:
1090: while (k < len) key0[k++] = block[i++];
1091:
1092: key0[k] = g_EOL;
1093:
1094: #endif /* VERSNEW */
1095:
1096: i += UNSIGN (block[i]);
1097: i++; /* skip data */
1098:
1099: }
1100:
1101: k = 0;
1102:
1103: if (addr > 0) {
1104:
1105: while (compactkey[k] == key0[k]) {
1106:
1107: if (key[k] == g_EOL) break;
1108:
1109: k++;
1110:
1111: }
1112:
1113: /* do *not* fully compact numerics */
1114: if ((i = UNSIGN (compactkey[k])) <= POINT) {
1115:
1116: while (--k >= 0 && (UNSIGN (compactkey[k]) & 01) == 0);
1117:
1118: k++;
1119: }
1120:
1121: }
1122:
1123: needed -= k;
1124: i = (offset += needed);
1125: block[OFFS] = i / 256;
1126: block[OFFS + 1] = i % 256;
1127:
1128: while (i >= addr) {
1129: block[i] = block[i - needed];
1130: i--;
1131: }
1132:
1133: #ifdef VERSNEW
1134:
1135: i = addr;
1136: block[i++] = j1 = keyl - k;
1137: block[i++] = k;
1138:
1139: stcpy0 (&block[i], &compactkey[k], j1);
1140:
1141: i += j1;
1142: block[i++] = datal;
1143:
1144: stcpy0 (&block[i], data, datal);
1145:
1146: #else
1147:
1148: block[addr + 1] = k;
1149: j1 = k;
1150: i = addr + 2;
1151:
1152: while (k < keyl) block[i++] = compactkey[k++];
1153:
1154: block[addr] = k - j1;
1155: addr = i++;
1156: k = 0;
1157:
1158: while (k < datal) block[i++] = data[k++];
1159:
1160: block[addr] = k;
1161:
1162: #endif /* VERSNEW */
1163:
1164: }
1165:
1166: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
1167: write (filedes, block, BLOCKLEN);
1168:
1169: if (traceadr[trx] == 0) update (filedes, compactkey, keyl);
1170:
1171: break;
1172: }
1173:
1174: /* there was a previous entry */
1175: addr += UNSIGN (block[addr]);
1176: addr += 2;
1177: olddatal = UNSIGN (block[addr]);
1178:
1179: if (setop) {
1180:
1181: stcpy0 (tmp1, &block[addr + 1], (long) olddatal);
1182:
1183: tmp1[olddatal] = EOL;
1184:
1185: m_op (tmp1, data, setop);
1186:
1187: setop = 0;
1188:
1189: if (merr () > OK) return;
1190:
1191: datal = stcpy (data, tmp1);
1192: }
1193:
1194: if ((j1 = olddatal - datal) != 0) {
1195:
1196: if (j1 > 0) { /* surplus space */
1197:
1198: i = addr + datal;
1199: k = offset;
1200: offset -= j1;
1201: j1 += i;
1202:
1203: stcpy0 (&block[i], &block[j1], offset - i);
1204:
1205: i = offset;
1206:
1207: while (i < k) block[i++] = 0; /* clear area */
1208:
1209: }
1210: else {
1211: /* if (j1<0) */
1212: /* we need more space */
1213:
1214: if ((offset - j1) > DATALIM) {
1215: /* block too small */
1216: ret_to = 'u'; /* u=update */
1217:
1218: goto splitd;
1219: }
1220:
1221: s20:
1222:
1223: i = offset;
1224: k = addr + olddatal;
1225: offset -= j1;
1226: j1 = offset;
1227:
1228: while (i > k) block[j1--] = block[i--];
1229:
1230: }
1231:
1232: /* overwrite */
1233: block[OFFS] = offset / 256;
1234: block[OFFS + 1] = offset % 256;
1235: block[addr] = datal;
1236:
1237: }
1238: else { /* if nothing changes, do not write */
1239:
1240: i = 0;
1241: j = addr + 1;
1242:
1243: while (i < datal) {
1244: if (block[j++] != data[i]) break;
1245:
1246: i++;
1247: }
1248:
1249: if (i == datal) goto quit;
1250:
1251: }
1252:
1253: stcpy0 (&block[++addr], data, (long) datal);
1254: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
1255: write (filedes, block, BLOCKLEN);
1256: break;
1257:
1258:
1259: case dat:
1260:
1261: data[0] = '0';
1262: data[1] = EOL1;
1263: data[2] = EOL1;
1264:
1265: if (found == 2) { /* ... advance to next entry */
1266: addr += UNSIGN (block[addr]);
1267: addr += 2; /* skip key */
1268: addr += UNSIGN (block[addr]);
1269: addr++; /* skip data */
1270:
1271: data[0] = '1';
1272: }
1273:
1274: {
1275: long len;
1276: char key0[256];
1277:
1278: /* get following entry, eventually in the next blk */
1279: offset = UNSIGN (block[OFFS]) * 256 +
1280: UNSIGN (block[OFFS + 1]);
1281:
1282: if (addr >= offset) {
1283:
1284: if ((blknbr = UNSIGN (block[RLPTR]) * 65536 + UNSIGN (block[RLPTR + 1]) * 256 + UNSIGN (block[RLPTR + 2]))) {
1285:
1286: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
1287: read (filedes, block, BLOCKLEN);
1288: j1 = UNSIGN (block[0]);
1289:
1290: i = 0;
1291: j = 2;
1292:
1293: while (i < j1) key0[i++] = block[j++];
1294:
1295: key0[i] = g_EOL;
1296:
1297: }
1298: else {
1299: goto quit;
1300: }
1301:
1302: }
1303: else {
1304:
1305: i = 0;
1306:
1307: while (i <= addr) { /* compute offset complete key */
1308: len = UNSIGN (block[i++]);
1309:
1310: #ifdef VERSNEW
1311:
1312: k = UNSIGN (block[i++]);
1313: stcpy0 (&key0[k], &block[i], len);
1314: key0[k + len] = g_EOL;
1315: i += len;
1316:
1317: #else
1318:
1319: len += (j = UNSIGN (block[i++]));
1320:
1321: while (j < len) key0[j++] = block[i++];
1322:
1323: key0[j] = g_EOL;
1324:
1325: #endif /* VERSNEW */
1326:
1327: i += UNSIGN (block[i]);
1328: i++; /* skip data */
1329: }
1330:
1331: }
1332:
1333: /* is it a descendant? */
1334: if (compactkey[0] == g_EOL && key0[0] != g_EOL) {
1335: data[1] = data[0];
1336: data[0] = '1';
1337:
1338: break;
1339: }
1340:
1341: i = 0;
1342:
1343: while (compactkey[i] == key0[i]) i++;
1344:
1345: if (compactkey[i] == g_EOL) {
1346: data[1] = data[0];
1347: data[0] = '1';
1348: }
1349: }
1350:
1351: break;
1352:
1353:
1354: case fra_order:
1355:
1356: if (ordercnt < 0) goto zinv;
1357:
1358: offset = UNSIGN (block[OFFS]) * 256 + UNSIGN (block[OFFS + 1]);
1359:
1360: if (addr >= offset) { /* look in next block */
1361:
1362: if ((blknbr = UNSIGN (block[RLPTR]) * 65536 + UNSIGN (block[RLPTR + 1]) * 256 + UNSIGN (block[RLPTR + 2])) == 0) {
1363: data[0] = EOL1;
1364: g_o_val[0] = EOL;
1365:
1366: goto quit;
1367: } /* no next block */
1368:
1369: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
1370: read (filedes, block, BLOCKLEN);
1371: scandblk (block, &addr, &found);
1372:
1373: }
1374:
1375: {
1376: long len;
1377: int ch0;
1378: char scratch[256];
1379: char key0[256];
1380:
1381: i = 0;
1382:
1383: while (i <= addr) { /* compute offset complete key */
1384:
1385: len = UNSIGN (block[i++]);
1386: len += (j = UNSIGN (block[i++]));
1387:
1388: while (j < len) key0[j++] = block[i++];
1389:
1390: key0[j] = g_EOL;
1391: i += UNSIGN (block[i]);
1392:
1393: i++; /* skip data */
1394: }
1395:
1396: /* save data value for inspection with $V(111) */
1397: i = addr;
1398: i += UNSIGN (block[i]);
1399: i += 2; /* skip key */
1400: j = UNSIGN (block[i++]);
1401: stcpy0 (g_o_val, &block[i], j); /* get value */
1402: g_o_val[j] = EOL; /* append EOL */
1403:
1404: i = 0;
1405: j = 0;
1406:
1407: while ((scratch[j++] = UNSIGN (key0[i++])) != g_EOL);
1408:
1409: if (compactkey[--keyl] == ALPHA) keyl++;
1410:
1411: /* count subscripts of key */
1412: i = 0;
1413: j1 = 0;
1414:
1415: while (i < keyl) if (compactkey[i++] & 01)
1416:
1417: j1++;
1418: i = 0;
1419: j = 0;
1420: k = 0;
1421:
1422: while (i < keyl) {
1423:
1424: if (scratch[i] != compactkey[j++]) {
1425: k++;
1426: break;
1427: }
1428:
1429: if (scratch[i++] & 01) k++;
1430:
1431: }
1432:
1433: if (k < j1) {
1434: data[0] = EOL1;
1435: g_o_val[0] = EOL;
1436:
1437: goto quit;
1438: }
1439:
1440: while (--i >= 0) {
1441: if ((scratch[i] & 01)) break;
1442: }
1443:
1444: i++;
1445: j = 0;
1446:
1447: while ((ch = UNSIGN (scratch[i++])) != g_EOL) {
1448:
1449: ch0 = (ch >= SP ? (ch >> 1) : /* 'string' chars */
1450: (ch < 20 ? (ch >> 1) + '0' : /* 0...9 */
1451: (ch >> 1) + SP)); /* '.' or '-' */
1452:
1453:
1454: if (ch0 == DEL) {
1455:
1456: if (((ch = UNSIGN (scratch[i++])) >> 1) == DEL) {
1457: ch0 += DEL;
1458: ch = UNSIGN (scratch[i++]);
1459: }
1460:
1461: ch0 += (ch >> 1);
1462: }
1463:
1464: data[j++] = ch0;
1465:
1466: if (ch & 01) break;
1467:
1468: }
1469:
1470: /* forget that data value if $d=10 */
1471: if (UNSIGN (scratch[i]) != g_EOL) g_o_val[0] = EOL;
1472:
1473: data[j] = EOL1;
1474: ordercounter++;
1475:
1476: if (--ordercnt > 0) { /* repeated forward scanning */
1477:
1478: if (ch != g_EOL) scratch[i] = g_EOL;
1479:
1480: stcpy0 (compactkey, scratch, i + 1);
1481:
1482: compactkey[i - 1] |= 01;
1483: compactkey[i] = OMEGA;
1484: keyl = i + 1;
1485:
1486: goto k_again;
1487:
1488: }
1489:
1490: }
1491:
1492: break;
1493:
1494:
1495: case fra_query:
1496:
1497: if (ordercnt < 1) {
1498: merr_raise (ARGLIST);
1499: goto quit;
1500: }
1501:
1502: if (found == 2) { /* ... advance to next entry */
1503: addr += UNSIGN (block[addr]);
1504: addr += 2; /* skip key */
1505: addr += UNSIGN (block[addr]);
1506: addr++; /* skip data */
1507: }
1508:
1509: offset = UNSIGN (block[OFFS]) * 256 + UNSIGN (block[OFFS + 1]);
1510:
1511: while (--ordercnt > 0) { /* repeated forward query */
1512:
1513: addr += UNSIGN (block[addr]);
1514: addr += 2; /* skip key */
1515: addr += UNSIGN (block[addr]);
1516: addr++; /* skip data */
1517:
1518: if (addr >= offset) { /* look in next block */
1519:
1520: if ((blknbr = UNSIGN (block[RLPTR]) * 65536 + UNSIGN (block[RLPTR + 1]) * 256 + UNSIGN (block[RLPTR + 2])) == 0) {
1521: data[0] = EOL1;
1522:
1523: goto quit; /* no next block */
1524: }
1525:
1526: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
1527: read (filedes, block, BLOCKLEN);
1528:
1529: addr = 0;
1530: offset = UNSIGN (block[OFFS]) * 256 +
1531: UNSIGN (block[OFFS + 1]);
1532: }
1533:
1534: }
1535:
1536: if (addr >= offset) { /* look in next block */
1537:
1538: if ((blknbr = UNSIGN (block[RLPTR]) * 65536 + UNSIGN (block[RLPTR + 1]) * 256 + UNSIGN (block[RLPTR + 2])) == 0) {
1539:
1540: if (getnflag) {
1541: zref[0] = EOL;
1542: merr_raise (ARGER);
1543: }
1544:
1545: data[0] = EOL1;
1546:
1547: goto quit; /* no next block */
1548: }
1549:
1550: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
1551: read (filedes, block, BLOCKLEN);
1552:
1553: addr = 0;
1554: }
1555:
1556: {
1557: long len;
1558: char key0[256];
1559:
1560: i = 0;
1561:
1562: while (i <= addr) { /* compute offset complete key */
1563:
1564: len = UNSIGN (block[i++]);
1565: len += (j = UNSIGN (block[i++]));
1566:
1567: while (j < len) key0[j++] = block[i++];
1568:
1569: key0[j] = g_EOL;
1570: k = i; /* save i for getnflag processing */
1571: i += UNSIGN (block[i]);
1572: i++; /* skip data */
1573:
1574: }
1575:
1576: if (getnflag) {
1577:
1578: int ch0;
1579:
1580: i = k;
1581: k = UNSIGN (block[i++]);
1582:
1583: stcpy0 (data, &block[i], k); /* get value */
1584:
1585: data[k] = EOL1; /* append EOL */
1586: j = 0;
1587:
1588: while (zref[j] != DELIM && zref[j] != EOL) j++;
1589:
1590: if (zref[j] == EOL) zref[j] = DELIM;
1591:
1592: nakoffs = j;
1593: j++;
1594: i = 0; /* make this ref $ZR */
1595:
1596: while ((ch = UNSIGN (key0[i++])) != g_EOL) {
1597:
1598: ch0 = (ch >= SP ? (ch >> 1) : /* 'string' chars */
1599: (ch < 20 ? (ch >> 1) + '0' : /* 0...9 */
1600: (ch >> 1) + SP)); /* '.' or '-' */
1601:
1602:
1603: if (ch0 == DEL) {
1604:
1605: if (((ch = UNSIGN (key0[i++])) >> 1) == DEL) {
1606: ch0 += DEL;
1607: ch = UNSIGN (key0[i++]);
1608: }
1609:
1610: ch0 += (ch >> 1);
1611:
1612: }
1613:
1614: zref[j++] = ch0;
1615:
1616:
1617: if (j >= 252) {
1618: zref[j] = EOL;
1619: merr_raise (M75);
1620:
1621: goto quit;
1622: }
1623:
1624: if (ch & 01) {
1625: nakoffs = j;
1626: zref[j++] = DELIM;
1627: }
1628:
1629: }
1630:
1631: zref[--j] = EOL;
1632:
1633: break;
1634:
1635: }
1636: else { /* save data value for inspection with $V(111) */
1637:
1638: int ch0;
1639:
1640: i = addr;
1641: i += UNSIGN (block[i]);
1642: i += 2; /* skip key */
1643: j = UNSIGN (block[i++]);
1644:
1645: stcpy0 (g_o_val, &block[i], j); /* get value */
1646:
1647: g_o_val[j] = EOL; /* append EOL */
1648:
1649: j = 0;
1650: i = 0;
1651:
1652: while ((data[j] = zref[j]) != DELIM) {
1653:
1654: if (data[j] == EOL1) {
1655: data[j] = '(';
1656: break;
1657: }
1658:
1659: j++;
1660:
1661: }
1662:
1663: data[j++] = '(';
1664: k = 1;
1665:
1666: while ((ch = UNSIGN (key0[i++])) != g_EOL) {
1667: int typ;
1668:
1669: if (k) {
1670: k = 0;
1671:
1672: if ((typ = (ch > SP))) data[j++] = '"';
1673: }
1674:
1675: ch0 = (ch >= SP ? (ch >> 1) : /* 'string' chars */
1676: (ch < 20 ? (ch >> 1) + '0' : /* 0...9 */
1677: (ch >> 1) + SP)); /* '.' or '-' */
1678:
1679: if (ch0 == DEL) {
1680:
1681: if (((ch = UNSIGN (key0[i++])) >> 1) == DEL) {
1682: ch0 += DEL;
1683: ch = UNSIGN (key0[i++]);
1684: }
1685:
1686: ch0 += (ch >> 1);
1687: }
1688:
1689: data[j] = ch0;
1690:
1691: if (j >= 252) {
1692: data[j] = EOL1;
1693: merr_raise (M75);
1694:
1695: goto quit;
1696: }
1697:
1698: if (data[j++] == '"') data[j++] = '"';
1699:
1700: if (ch & 01) {
1701:
1702: if (typ) data[j++] = '"';
1703:
1704: data[j++] = ',';
1705: k = 1;
1706:
1707: }
1708: }
1709:
1710: data[j--] = EOL1;
1711: data[j] = ')';
1712:
1713: }
1714: }
1715:
1716: break;
1717:
1718:
1719: case kill_sym: /* search and destroy */
1720:
1721: killo: /* entry from killone section */
1722: offset = UNSIGN (block[OFFS]) * 256 + UNSIGN (block[OFFS + 1]);
1723:
1724: i = 0;
1725: key1[0] = g_EOL;
1726:
1727: while (i < addr) { /* compute complete key */
1728:
1729: k = UNSIGN (block[i++]);
1730: k += (j = UNSIGN (block[i++]));
1731:
1732: while (j < k) key1[j++] = block[i++];
1733:
1734: key1[j] = g_EOL;
1735: i += UNSIGN (block[i]);
1736:
1737: i++; /* skip data */
1738:
1739: }
1740:
1741: /* look whether there's something to do at all */
1742: if (found != 2) { /* is it a descendant ? */
1743:
1744: char key0[256];
1745: long trxsav;
1746:
1747: if (addr >= offset) { /* nothing to kill in that block */
1748:
1749: blknbr = UNSIGN (block[RLPTR]) * 65536 + UNSIGN (block[RLPTR + 1]) * 256 + UNSIGN (block[RLPTR + 2]);
1750:
1751: if (blknbr == 0) break; /* there is no next block */
1752:
1753: /* maybe there's something in the next block ... */
1754: trxsav = trx;
1755:
1756: for (;;) {
1757:
1758: other = traceblk[--trx];
1759: addr = traceadr[trx];
1760:
1761: lseek (filedes, (long) other * (long) (BLOCKLEN), 0);
1762: read (filedes, block, BLOCKLEN);
1763:
1764: addr += UNSIGN (block[addr]);
1765: addr += (2 + PLEN); /* skip previous entry */
1766: offset = UNSIGN (block[OFFS]) * 256 +
1767: UNSIGN (block[OFFS + 1]);
1768: traceadr[trx] = addr;
1769:
1770: if (addr < offset) break;
1771:
1772: traceadr[trx] = 0;
1773: traceblk[trx] = UNSIGN (block[RLPTR]) * 65536 +
1774: UNSIGN (block[RLPTR + 1]) * 256 +
1775: UNSIGN (block[RLPTR + 2]);
1776:
1777: }
1778:
1779: trx = trxsav;
1780:
1781: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
1782: read (filedes, block, BLOCKLEN);
1783:
1784: offset = UNSIGN (block[OFFS]) * 256 +
1785: UNSIGN (block[OFFS + 1]);
1786: addr = 0;
1787: k = UNSIGN (block[0]);
1788: stcpy0 (key0, &block[2], k);
1789: key0[k] = g_EOL;
1790:
1791: }
1792: else { /* get following entry */
1793:
1794: stcpy0 (key0, key1, j);
1795: i = addr;
1796: k = UNSIGN (block[i++]);
1797: k += (j = UNSIGN (block[i++]));
1798:
1799: while (j < k) key0[j++] = block[i++];
1800:
1801: key0[j] = g_EOL;
1802: }
1803:
1804: /* is it a descendant? */
1805: i = 0;
1806:
1807: while (compactkey[i] == key0[i]) i++;
1808:
1809: if (compactkey[i] != g_EOL) break; /* nothing to kill */
1810: }
1811:
1812: /* scan this block for all descendants */
1813: {
1814:
1815: long begadr, endadr, len;
1816: char key0[256];
1817:
1818: stcpy0 (key0, compactkey, (long) keyl);
1819:
1820: begadr = endadr = i = addr;
1821:
1822: if (action == killone) {
1823:
1824: i += UNSIGN (block[i]);
1825: i += 2; /* skip key */
1826: i += UNSIGN (block[i]);
1827: i++; /* skip data */
1828:
1829: endadr = i;
1830: }
1831: else {
1832:
1833: while (i < offset) {
1834:
1835: len = UNSIGN (block[i++]);
1836: k = j = UNSIGN (block[i++]);
1837:
1838: if (k >= keyl) {
1839: i += len;
1840: }
1841: else {
1842:
1843: len += k;
1844:
1845: while (j < len) key0[j++] = block[i++];
1846:
1847: key0[j] = g_EOL;
1848:
1849: /* k=0; ueberfluessig */
1850: while (compactkey[k] == key0[k]) {
1851:
1852: if (compactkey[k] == g_EOL) break;
1853:
1854: k++;
1855: }
1856:
1857: if (compactkey[k] != g_EOL) break; /* no descendant */
1858:
1859: }
1860:
1861: i += UNSIGN (block[i]);
1862: i++; /* skip data */
1863: endadr = i;
1864:
1865: }
1866:
1867: }
1868:
1869: kill_again = (endadr == offset && action != killone); /* may be there's more to kill */
1870:
1871: if ((begadr == 0) && (endadr == offset)) { /* block becomes empty */
1872:
1873: long left,
1874: right;
1875: char block0[BLOCKLEN];
1876:
1877: p_empty: /* entry if pointer block goes empty */
1878:
1879: left = UNSIGN (block[LLPTR]) * 65536 +
1880: UNSIGN (block[LLPTR + 1]) * 256 +
1881: UNSIGN (block[LLPTR + 2]);
1882: right = UNSIGN (block[RLPTR]) * 65536 +
1883: UNSIGN (block[RLPTR + 1]) * 256 +
1884: UNSIGN (block[RLPTR + 2]);
1885:
1886: if (left) {
1887:
1888: lseek (filedes, (long) left * (long) (BLOCKLEN), 0);
1889: read (filedes, block0, BLOCKLEN);
1890:
1891: block0[RLPTR] = block[RLPTR];
1892: block0[RLPTR + 1] = block[RLPTR + 1];
1893: block0[RLPTR + 2] = block[RLPTR + 2];
1894:
1895: lseek (filedes, (long) left * (long) (BLOCKLEN), 0);
1896: write (filedes, block0, BLOCKLEN);
1897:
1898: }
1899:
1900: if (right) {
1901:
1902: lseek (filedes, (long) right * (long) (BLOCKLEN), 0);
1903: read (filedes, block0, BLOCKLEN);
1904:
1905: block0[LLPTR] = block[LLPTR];
1906: block0[LLPTR + 1] = block[LLPTR + 1];
1907: block0[LLPTR + 2] = block[LLPTR + 2];
1908:
1909: lseek (filedes, (long) right * (long) (BLOCKLEN), 0);
1910: write (filedes, block0, BLOCKLEN);
1911:
1912: }
1913:
1914: b_free (filedes, blknbr); /* modify free list */
1915:
1916: /* delete pointer */
1917: /**************************/
1918: {
1919: long trxsav;
1920: long freecnt;
1921:
1922: trxsav = trx;
1923:
1924: blknbr = traceblk[--trx];
1925: addr = traceadr[trx];
1926:
1927: lseek (filedes, (long) (blknbr) * (long) (BLOCKLEN), 0);
1928: read (filedes, block, BLOCKLEN);
1929: offset = UNSIGN (block[OFFS]) * 256 +
1930: UNSIGN (block[OFFS + 1]);
1931: freecnt = UNSIGN (block[addr]) + 2 + PLEN;
1932:
1933: /* delete key */
1934: offset -= freecnt;
1935:
1936: if (offset == 0) { /* pointer block went empty */
1937:
1938: if (blknbr == ROOT) { /* global went empty */
1939:
1940: lseek (filedes, 0L, 0);
1941:
1942: /* note : UNIX does not tell other */
1943: block[BTYP] = EMPTY; /* jobs that a file has been unlinked */
1944:
1945: /* as long as they keep it open. */
1946: /* so we mark this global as EMPTY */
1947: write (filedes, block, BLOCKLEN);
1948: close (filedes);
1949: unlink (filnam);
1950:
1951: if (lonelyflag == FALSE) locking (filedes, 0, 0L); /* unlock */
1952:
1953: olddes[inuse] = 0;
1954: oldfil[inuse][0] = NUL;
1955: usage[inuse] = 0;
1956:
1957: return;
1958:
1959: }
1960:
1961: goto p_empty; /* clear pointer block */
1962:
1963: }
1964:
1965: block[OFFS] = offset / 256;
1966: block[OFFS + 1] = offset % 256;
1967:
1968: stcpy0 (&block[addr], &block[addr + freecnt], (long) (offset - addr));
1969:
1970: for (i = offset; i < offset + freecnt; block[i++] = 0);
1971:
1972: lseek (filedes, (long) (blknbr) * (long) (BLOCKLEN), 0);
1973: write (filedes, block, BLOCKLEN);
1974:
1975: if (addr == 0) { /* update of pointer */
1976: traceadr[trx] = 0;
1977:
1978: update (filedes, &block[2], (long) UNSIGN (block[0]));
1979: }
1980:
1981: trx = trxsav;
1982:
1983: }
1984:
1985: if (kill_again) goto k_again;
1986:
1987: break;
1988: }
1989:
1990: i = begadr;
1991: j = endadr;
1992:
1993: while (j < offset) block[i++] = block[j++];
1994: while (i < offset) block[i++] = 0;
1995:
1996: /** clear rest */
1997: offset += (begadr - endadr);
1998: if (begadr < offset && block[begadr + 1]) { /* new key_offset for next entry */
1999: i = block[begadr];
2000: j = block[begadr + 1];
2001: k = 0;
2002: if (begadr)
2003: while (key0[k] == key1[k])
2004: k++; /* new key_offset */
2005: if (k < j) {
2006: ch = j - k; /* space requirement */
2007: block[begadr] = i + ch; /* new key_length */
2008: block[begadr + 1] = k; /* new key_offset */
2009: i = offset;
2010: j = i + ch;
2011: offset = j;
2012: begadr++;
2013: while (i > begadr)
2014: block[j--] = block[i--];
2015: stcpy0 (&block[begadr + 1], &key0[k], ch);
2016: }
2017: }
2018: block[OFFS] = offset / 256;
2019: block[OFFS + 1] = offset % 256;
2020: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
2021: write (filedes, block, BLOCKLEN);
2022: if (addr < 3) { /* update of pointer */
2023: traceadr[trx] = 0;
2024: update (filedes, &block[2], (long) UNSIGN (block[0]));
2025: }
2026: }
2027:
2028: if (kill_again) goto k_again;
2029:
2030: break;
2031:
2032: zinv:
2033:
2034: {
2035: long len;
2036: int ch0;
2037: char scratch[256];
2038: char key0[256];
2039:
2040: if (addr <= 0) { /* look in previous block */
2041:
2042: if ((blknbr = UNSIGN (block[LLPTR]) * 65536 + UNSIGN (block[LLPTR + 1]) * 256 + UNSIGN (block[LLPTR + 2])) == 0) {
2043: data[0] = EOL1;
2044: goto quit;
2045: } /* no previous block */
2046:
2047: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
2048: read (filedes, block, BLOCKLEN);
2049:
2050: addr = UNSIGN (block[OFFS]) * 256 +
2051: UNSIGN (block[OFFS + 1]);
2052:
2053: }
2054:
2055: i = 0;
2056:
2057: while (i < addr) { /* compute offset complete key */
2058:
2059: len = UNSIGN (block[i++]);
2060: len += (j = UNSIGN (block[i++]));
2061:
2062: while (j < len) key0[j++] = block[i++];
2063:
2064: key0[j] = g_EOL;
2065: j1 = i;
2066: i += UNSIGN (block[i]);
2067: i++; /* skip data */
2068:
2069: }
2070:
2071: /* save data value for inspection with $V(111) */
2072: j = UNSIGN (block[j1++]);
2073:
2074: stcpy0 (g_o_val, &block[j1], j); /* get value */
2075: g_o_val[j] = EOL; /* append EOL */
2076:
2077: i = 0;
2078: j = 0;
2079:
2080: while ((scratch[j++] = UNSIGN (key0[i++])) != g_EOL);
2081:
2082: /* count subscripts of key */
2083: i = 0;
2084: j1 = 0;
2085:
2086: while (i < keyl) {
2087:
2088: if (compactkey[i++] & 01) {
2089: j1++;
2090: }
2091:
2092: }
2093:
2094: i = 0;
2095: j = 0;
2096: k = 0;
2097:
2098: while (i < keyl) {
2099:
2100: if (scratch[i] != compactkey[j++]) {
2101: k++;
2102: break;
2103: }
2104:
2105: if (scratch[i++] & 01) k++;
2106:
2107: }
2108:
2109: if (k < j1) {
2110: data[0] = EOL1;
2111: g_o_val[0] = EOL;
2112:
2113: goto quit;
2114: }
2115:
2116: while (--i >= 0) {
2117: if ((scratch[i] & 01)) break;
2118: }
2119:
2120: i++;
2121: j = 0;
2122:
2123: while ((ch = UNSIGN (scratch[i++])) != g_EOL) {
2124:
2125: ch0 = (ch >= SP ? (ch >> 1) : /* 'string' chars */
2126: (ch < 20 ? (ch >> 1) + '0' : /* 0...9 */
2127: (ch >> 1) + SP)); /* '.' or '-' */
2128:
2129: if (ch0 == DEL) {
2130:
2131: if (((ch = UNSIGN (scratch[i++])) >> 1) == DEL) {
2132: ch0 += DEL;
2133: ch = UNSIGN (scratch[i++]);
2134: }
2135:
2136: ch0 += (ch >> 1);
2137:
2138: }
2139:
2140: data[j++] = ch0;
2141:
2142: if (ch & 01) break;
2143:
2144: }
2145:
2146: data[j] = EOL1;
2147:
2148: if (j == 0) break;
2149:
2150: ordercounter++;
2151:
2152: if (ordercnt++ < (-1)) { /* repeated backward scanning */
2153:
2154: if (ch != g_EOL) scratch[i] = g_EOL;
2155:
2156: stcpy0 (compactkey, scratch, i + 1);
2157:
2158: compactkey[i - 1] |= 01;
2159: keyl = i;
2160:
2161: goto k_again;
2162:
2163: }
2164:
2165: }
2166:
2167: break;
2168:
2169:
2170: case zdata: /* nonstandard data function */
2171:
2172: {
2173: long counties[128];
2174: char key0[256];
2175: int icnt, icnt0, len;
2176:
2177: i = 0;
2178:
2179: while (i < 128) counties[i++] = 0L; /* init count; */
2180:
2181: if (found == 2) { /* ... advance to next entry */
2182: addr += UNSIGN (block[addr]);
2183: addr += 2; /* skip key */
2184: addr += UNSIGN (block[addr]);
2185: addr++; /* skip data */
2186:
2187: counties[0] = 1L;
2188: }
2189:
2190: offset = UNSIGN (block[OFFS]) * 256 + UNSIGN (block[OFFS + 1]);
2191: icnt = 0;
2192: i = 0;
2193:
2194: while ((ch = compactkey[i++]) != g_EOL) {
2195:
2196: if (ch & 01) {
2197: icnt++;
2198: }
2199:
2200: }
2201:
2202: len = i - 1;
2203: i = 0;
2204:
2205: while (i < addr) { /* compute offset complete key */
2206:
2207: icnt0 = UNSIGN (block[i++]);
2208: icnt0 += (j = UNSIGN (block[i++]));
2209:
2210: while (j < icnt0) key0[j++] = block[i++];
2211:
2212: key0[j] = g_EOL;
2213: i += UNSIGN (block[i]);
2214:
2215: i++; /* skip data */
2216:
2217: }
2218:
2219: for (;;) { /* is it still a descendant ??? */
2220:
2221: if (addr >= offset) { /* look in next block */
2222:
2223: if ((blknbr = UNSIGN (block[RLPTR]) * 65536 + UNSIGN (block[RLPTR + 1]) * 256 + UNSIGN (block[RLPTR + 2])) == 0) {
2224: break; /* no next block */
2225: }
2226:
2227: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
2228: read (filedes, block, BLOCKLEN);
2229:
2230: addr = 0;
2231: offset = UNSIGN (block[OFFS]) * 256 +
2232: UNSIGN (block[OFFS + 1]);
2233:
2234: }
2235:
2236: i = UNSIGN (block[addr++]);
2237: i += (j = UNSIGN (block[addr++]));
2238:
2239: while (j < i) key0[j++] = block[addr++];
2240:
2241: addr += UNSIGN (block[addr]);
2242: addr++; /* skip data */
2243: icnt0 = 0;
2244: i = 0;
2245:
2246: while (i < j) if (key0[i++] & 01)
2247:
2248: icnt0++;
2249:
2250: if (icnt0 <= icnt) break;
2251:
2252: i = 0;
2253:
2254: while (i < len) {
2255:
2256: if (key0[i] != compactkey[i]) break;
2257:
2258: i++;
2259:
2260: }
2261:
2262: if (i < len) break;
2263:
2264: counties[icnt0 - icnt]++;
2265:
2266: }
2267:
2268: i = 128;
2269:
2270: while (counties[--i] == 0L);
2271:
2272: lintstr (data, counties[0]);
2273:
2274: j = 1;
2275: tmp1[0] = ',';
2276:
2277: while (j <= i) {
2278: lintstr (&tmp1[1], counties[j++]);
2279: stcat (data, tmp1);
2280: }
2281:
2282: }
2283:
2284: break;
2285:
2286: case getinc:
2287:
2288: {
2289: int setopsav;
2290:
2291: setopsav = setop;
2292: setop = '+';
2293: data[0] = '1';
2294: data[1] = EOL;
2295:
2296: global (set_sym, key, data);
2297:
2298: setop = setopsav;
2299:
2300: return;
2301: }
2302:
2303: case killone:
2304:
2305: {
2306: if (found == 2) goto killo; /* entry found use normal kill routine */
2307:
2308: goto quit;
2309: }
2310:
2311: case merge_sym:
2312:
2313: printf("MERGE NOT IMPLEMENTED FOR GLOBALS\n");
2314:
2315: #ifdef DEBUG_GBL
2316:
2317: int loop;
2318:
2319: printf ("DEBUG MERGE: ");
2320: printf ("[key] is [");
2321:
2322: for (loop = 0; key[loop] != EOL; loop++) printf ("%c", (key[loop] == DELIM) ? '!' : key[loop]);
2323:
2324: printf ("]\r\n");
2325: printf ("[data] is [");
2326:
2327: for(loop = 0; data[loop] != EOL; loop++) printf ("%c", (data[loop] == DELIM) ? '!' : data[loop]);
2328:
2329: printf("]\r\n");
2330:
2331: #endif
2332: return;
2333:
2334: default:
2335:
2336: merr_raise (INVREF); /* accidental call with wrong action code (v22-stuff) */
2337: } /* end of switch */
2338:
2339: quit:
2340:
2341: /* clean things up */
2342:
2343: lseek (filedes, ROOT, 0);
2344:
2345: if (lonelyflag == FALSE) locking (filedes, 0, 0L); /* unlock */
2346:
2347: return;
2348:
2349:
2350: splitd: /* split data block in two sections */
2351:
2352: /* part of the data is taken to an other location. */
2353: /* old information in 'block' stored at 'blknbr' */
2354: /* 'addr' there I would like to insert, if possible (which is not) */
2355: /* 'offset' filled up to this limit */
2356:
2357: getnewblk (filedes, &newblk); /* get a new block */
2358:
2359: /* if we have to insert at the begin or end of a block */
2360: /* we don't split - we just start a new block */
2361: /* if an insert in the midst of a block, we split */
2362:
2363: if (addr >= offset) {
2364: long right,
2365: right1,
2366: right2;
2367:
2368: right = UNSIGN (block[RLPTR]);
2369: right1 = UNSIGN (block[RLPTR + 1]);
2370: right2 = UNSIGN (block[RLPTR + 2]);
2371: block[RLPTR] = newblk / 65536;
2372: block[RLPTR + 1] = newblk % 65536 / 256;
2373: block[RLPTR + 2] = newblk % 256;
2374:
2375: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
2376: write (filedes, block, BLOCKLEN);
2377:
2378: block[RLPTR] = right;
2379: block[RLPTR + 1] = right1;
2380: block[RLPTR + 2] = right2;
2381: block[LLPTR] = blknbr / 65536;
2382: block[LLPTR + 1] = blknbr % 65536 / 256;
2383: block[LLPTR + 2] = blknbr % 256;
2384: offset = 0;
2385: addr = 0;
2386: blknbr = newblk;
2387:
2388: insert (filedes, compactkey, keyl, newblk);
2389:
2390: /* up-date LL-PTR of RL-block */
2391: if ((other = right * 65536 + right1 * 256 + right2)) {
2392:
2393: char block0[BLOCKLEN];
2394:
2395: lseek (filedes, (long) other * (long) (BLOCKLEN), 0);
2396: read (filedes, block0, BLOCKLEN);
2397:
2398: block0[LLPTR] = blknbr / 65536;
2399: block0[LLPTR + 1] = blknbr % 65536 / 256;
2400: block0[LLPTR + 2] = blknbr % 256;
2401:
2402: lseek (filedes, (long) other * (long) (BLOCKLEN), 0);
2403: write (filedes, block0, BLOCKLEN);
2404:
2405: }
2406:
2407: goto spltex;
2408: }
2409:
2410: if (addr == 0) {
2411: long left, left1, left2;
2412:
2413: left = UNSIGN (block[LLPTR]);
2414: left1 = UNSIGN (block[LLPTR + 1]);
2415: left2 = UNSIGN (block[LLPTR + 2]);
2416:
2417: block[LLPTR] = newblk / 65536;
2418: block[LLPTR + 1] = newblk % 65536 / 256;
2419: block[LLPTR + 2] = newblk % 256;
2420:
2421: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
2422: write (filedes, block, BLOCKLEN);
2423:
2424: block[LLPTR] = left;
2425: block[LLPTR + 1] = left1;
2426: block[LLPTR + 2] = left2;
2427: block[RLPTR] = blknbr / 65536;
2428: block[RLPTR + 1] = blknbr % 65536 / 256;
2429: block[RLPTR + 2] = blknbr % 256;
2430: offset = 0;
2431: blknbr = newblk;
2432: traceadr[trx] = (-1); /* inhibit second update of pointers */
2433:
2434: insert (filedes, compactkey, keyl, newblk);
2435:
2436: if (addr < 3) { /* update of pointer */
2437: traceadr[trx] = 0;
2438:
2439: update (filedes, compactkey, keyl);
2440: }
2441:
2442: /* other is ***always*** zero !!!
2443: * if (other=left*65536+left1*256+left2) up-date RL-PTR of LL-block
2444: * { char block0[BLOCKLEN];
2445: * lseek(filedes,(long)other*(long)(BLOCKLEN),0);
2446: * read(filedes,block0,BLOCKLEN);
2447: * block0[RLPTR ]=blknbr/65536;
2448: * block0[RLPTR+1]=blknbr%65536/256;
2449: * block0[RLPTR+2]=blknbr%256;
2450: * lseek(filedes,(long)other*(long)(BLOCKLEN),0);
2451: * write(filedes,block0,BLOCKLEN);
2452: * }
2453: */
2454:
2455: goto spltex;
2456:
2457: }
2458:
2459: {
2460: char block0[BLOCKLEN];
2461: char key0[256];
2462: int newlimit;
2463:
2464: block0[BTYP] = DATA;
2465:
2466: /* now search for a dividing line */
2467: limit = (offset + needed) / 2;
2468: i = (offset - needed) / 2;
2469:
2470: if (addr < i) limit = i;
2471:
2472: i = 0;
2473: newlimit = i;
2474:
2475: while (i < limit) {
2476:
2477: newlimit = i;
2478: j = UNSIGN (block[i++]); /* length of key - offset */
2479: k = UNSIGN (block[i++]); /* offset into previous entry */
2480: j += k;
2481:
2482: while (k < j) key0[k++] = block[i++]; /* get key */
2483:
2484: key0[k] = g_EOL;
2485: i += UNSIGN (block[i]);
2486: i++; /* skip data */
2487:
2488: }
2489:
2490: limit = newlimit;
2491: i = newlimit;
2492:
2493: j = i;
2494: i = 0; /* copy part of old to new blk */
2495:
2496: if ((k = UNSIGN (block[j + 1])) != 0) { /* expand key */
2497:
2498: block0[i++] = UNSIGN (block[j++]) + k;
2499: block0[i++] = 0;
2500:
2501: if (addr > limit) addr += k;
2502:
2503: j = 0;
2504:
2505: while (j < k) block0[i++] = key0[j++];
2506:
2507: j = limit + 2;
2508:
2509: }
2510:
2511: while (j < offset) {
2512:
2513: block0[i++] = block[j];
2514: block[j] = 0;
2515:
2516: j++;
2517:
2518: }
2519:
2520: while (i <= DATALIM) block0[i++] = 0; /* clear rest of block */
2521:
2522: offset -= limit;
2523:
2524: if (k > 0) offset += k; /* new offsets */
2525:
2526: block[OFFS] = limit / 256;
2527: block[OFFS + 1] = limit % 256;
2528: block0[OFFS] = offset / 256;
2529: block0[OFFS + 1] = offset % 256;
2530:
2531: if (addr <= limit) { /* save new block away */
2532:
2533: /* update rightlink and leftlink pointers */
2534: other = UNSIGN (block[RLPTR]) * 65536 +
2535: UNSIGN (block[RLPTR + 1]) * 256 +
2536: UNSIGN (block[RLPTR + 2]);
2537: block0[RLPTR] = block[RLPTR];
2538: block0[RLPTR + 1] = block[RLPTR + 1];
2539: block0[RLPTR + 2] = block[RLPTR + 2];
2540: block[RLPTR] = newblk / 65536;
2541: block[RLPTR + 1] = newblk % 65536 / 256;
2542: block[RLPTR + 2] = newblk % 256;
2543: block0[LLPTR] = blknbr / 65536;
2544: block0[LLPTR + 1] = blknbr % 65536 / 256;
2545: block0[LLPTR + 2] = blknbr % 256;
2546:
2547: lseek (filedes, (long) (newblk) * (long) (BLOCKLEN), 0);
2548: write (filedes, block0, BLOCKLEN);
2549:
2550: offset = limit;
2551: /* insert new block in pointer structure */
2552:
2553: insert (filedes, &block0[2], (long) UNSIGN (block0[0]), newblk);
2554:
2555: /* up-date LL-PTR of RL-block */
2556: if (other != 0) {
2557:
2558: lseek (filedes, (long) other * (long) (BLOCKLEN), 0);
2559: read (filedes, block0, BLOCKLEN);
2560:
2561: block0[LLPTR] = newblk / 65536;
2562: block0[LLPTR + 1] = newblk % 65536 / 256;
2563: block0[LLPTR + 2] = newblk % 256;
2564:
2565: lseek (filedes, (long) other * (long) (BLOCKLEN), 0);
2566: write (filedes, block0, BLOCKLEN);
2567:
2568: }
2569:
2570: }
2571: else {
2572: /* save old block away and make new block the current block */
2573: /* update rightlink and leftlink pointers */
2574: other = UNSIGN (block[RLPTR]) * 65536 +
2575: UNSIGN (block[RLPTR + 1]) * 256 +
2576: UNSIGN (block[RLPTR + 2]);
2577: block0[RLPTR] = block[RLPTR];
2578: block0[RLPTR + 1] = block[RLPTR + 1];
2579: block0[RLPTR + 2] = block[RLPTR + 2];
2580: block[RLPTR] = newblk / 65536;
2581: block[RLPTR + 1] = newblk % 65536 / 256;
2582: block[RLPTR + 2] = newblk % 256;
2583: block0[LLPTR] = blknbr / 65536;
2584: block0[LLPTR + 1] = blknbr % 65536 / 256;
2585: block0[LLPTR + 2] = blknbr % 256;
2586:
2587: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
2588: write (filedes, block, BLOCKLEN);
2589: stcpy0 (block, block0, (long) BLOCKLEN);
2590:
2591: traceadr[trx] = (addr -= limit);
2592: traceblk[trx] = (blknbr = newblk);
2593:
2594: /* insert new block in pointer structure */
2595: insert (filedes, &block0[2], (long) UNSIGN (block0[0]), newblk);
2596:
2597: /* up-date LL-PTR of RL-block */
2598: if (other != 0) {
2599:
2600: lseek (filedes, (long) other * (long) (BLOCKLEN), 0);
2601: read (filedes, block0, BLOCKLEN);
2602:
2603: block0[LLPTR] = newblk / 65536;
2604: block0[LLPTR + 1] = newblk % 65536 / 256;
2605: block0[LLPTR + 2] = newblk % 256;
2606:
2607: lseek (filedes, (long) other * (long) (BLOCKLEN), 0);
2608: write (filedes, block0, BLOCKLEN);
2609:
2610: }
2611:
2612: }
2613: }
2614:
2615: spltex:
2616:
2617: if (ret_to == 'n') goto s10;
2618:
2619: goto s20;
2620: } /* end global() */
2621:
2622: /*
2623: * split pointer block in two sections
2624: * filedes: global file descriptor
2625: * block: old block (which is too small)
2626: * addr: addr of entry where to insert
2627: * offs: offset of block
2628: * blknbr: number of old block
2629: *
2630: * part of the data is taken to an other location.
2631: * old information in 'block' stored at 'blknbr'
2632: * 'addr' there I would like to insert, if possible (which is not)
2633: * 'offset' filled up to this limit
2634: */
2635: static void splitp (short filedes, char *block, long *addr, long *offs, unsigned long *blknbr)
2636: {
2637:
2638: char block0[BLOCKLEN];
2639: long limit;
2640: unsigned long newblk;
2641: unsigned long other;
2642: register int i, j;
2643:
2644: getnewblk (filedes, &newblk); /* get a new block */
2645:
2646: if (*blknbr == ROOT) { /* ROOT overflow is special */
2647:
2648: stcpy0 (block0, block, (long) BLOCKLEN);
2649:
2650: /* clear pointers */
2651: block[LLPTR] = 0;
2652: block[LLPTR + 1] = 0;
2653: block[LLPTR + 2] = 0;
2654: block[RLPTR] = 0;
2655: block[RLPTR + 1] = 0;
2656: block[RLPTR + 2] = 0;
2657:
2658: /* old root block is a 'normal' block now */
2659: /* new root points to a single block */
2660: i = UNSIGN (block0[0]) + 2;
2661: block0[i++] = newblk / 65536;
2662: block0[i++] = newblk % 65536 / 256;
2663: block0[i++] = newblk % 256;
2664: block0[OFFS] = i / 256;
2665: block0[OFFS + 1] = i % 256;
2666:
2667: while (i < DATALIM) block0[i++] = 0; /* clear rest */
2668:
2669: /* update number of blocks ! */
2670: i = UNSIGN (block0[NRBLK]) * 65536 +
2671: UNSIGN (block0[NRBLK + 1]) * 256 +
2672: UNSIGN (block0[NRBLK + 2]) + 1;
2673:
2674: block0[NRBLK] = i / 65536;
2675: block0[NRBLK + 1] = i % 65536 / 256;
2676: block0[NRBLK + 2] = i % 256;
2677: block0[BTYP] = POINTER;
2678:
2679: lseek (filedes, ROOT, 0);
2680: write (filedes, block0, BLOCKLEN);
2681:
2682: /* shift trace_stack */
2683: j = trx++;
2684: i = trx;
2685:
2686: /** if (j>=TRLIM) 'global too big' */
2687: while (j >= 0) {
2688: traceblk[i] = traceblk[j];
2689: traceadr[i--] = traceadr[j--];
2690: }
2691:
2692: traceblk[0] = 0; /*ROOT */
2693: traceadr[0] = 0;
2694: traceblk[1] = newblk;
2695: *blknbr = newblk;
2696:
2697: getnewblk (filedes, &newblk); /* get a new block */
2698:
2699: }
2700:
2701: block0[BTYP] = block[BTYP];
2702:
2703: /* now search for a dividing line */
2704: i = 0;
2705: limit = (*offs) / 2;
2706:
2707: while (i < limit) {
2708: i += UNSIGN (block[i]);
2709: i += 2; /* skip key */
2710: i += PLEN; /* skip data */
2711: }
2712:
2713: /* new offsets */
2714: limit = i;
2715:
2716: i = (*offs) - limit;
2717:
2718: block[OFFS] = limit / 256;
2719: block[OFFS + 1] = limit % 256;
2720: block0[OFFS] = i / 256;
2721: block0[OFFS + 1] = i % 256;
2722:
2723: for (i = 0; i <= DATALIM; block0[i++] = 0);
2724:
2725: i = 0;
2726: j = limit; /* copy part of old to new blk */
2727:
2728: while (j < (*offs)) {
2729: block0[i++] = block[j];
2730: block[j] = 0;
2731:
2732: j++;
2733: }
2734:
2735: if ((*addr) <= limit) { /* save new block away */
2736:
2737: /* update rightlink and leftlink pointers */
2738: other = UNSIGN (block[RLPTR]) * 65536 +
2739: UNSIGN (block[RLPTR + 1]) * 256 +
2740: UNSIGN (block[RLPTR + 2]);
2741: block0[RLPTR] = block[RLPTR];
2742: block0[RLPTR + 1] = block[RLPTR + 1];
2743: block0[RLPTR + 2] = block[RLPTR + 2];
2744: block[RLPTR] = newblk / 65536;
2745: block[RLPTR + 1] = newblk % 65536 / 256;
2746: block[RLPTR + 2] = newblk % 256;
2747: block0[LLPTR] = (*blknbr) / 65536;
2748: block0[LLPTR + 1] = (*blknbr) % 65536 / 256;
2749: block0[LLPTR + 2] = (*blknbr) % 256;
2750:
2751: lseek (filedes, (long) (newblk) * (long) (BLOCKLEN), 0);
2752: write (filedes, block0, BLOCKLEN);
2753:
2754: (*offs) = limit;
2755:
2756: insert (filedes, &block0[2], (long) UNSIGN (block0[0]), newblk);
2757:
2758: /* up-date LL-PTR of RL-block */
2759: if (other != 0) {
2760:
2761: lseek (filedes, (long) other * (long) (BLOCKLEN), 0);
2762: read (filedes, block0, BLOCKLEN);
2763:
2764: block0[LLPTR] = newblk / 65536;
2765: block0[LLPTR + 1] = newblk % 65536 / 256;
2766: block0[LLPTR + 2] = newblk % 256;
2767:
2768: lseek (filedes, (long) other * (long) (BLOCKLEN), 0);
2769: write (filedes, block0, BLOCKLEN);
2770:
2771: }
2772:
2773: }
2774: else { /* save old block away and make new block the current block */
2775:
2776: /* update rightlink and leftlink pointers */
2777: other = UNSIGN (block[RLPTR]) * 65536 +
2778: UNSIGN (block[RLPTR + 1]) * 256 +
2779: UNSIGN (block[RLPTR + 2]);
2780:
2781: block0[RLPTR] = block[RLPTR];
2782: block0[RLPTR + 1] = block[RLPTR + 1];
2783: block0[RLPTR + 2] = block[RLPTR + 2];
2784: block[RLPTR] = newblk / 65536;
2785: block[RLPTR + 1] = newblk % 65536 / 256;
2786: block[RLPTR + 2] = newblk % 256;
2787: block0[LLPTR] = (*blknbr) / 65536;
2788: block0[LLPTR + 1] = (*blknbr) % 65536 / 256;
2789: block0[LLPTR + 2] = (*blknbr) % 256;
2790:
2791: (*addr) -= limit;
2792: (*offs) -= limit;
2793:
2794: lseek (filedes, (long) (*blknbr) * (long) (BLOCKLEN), 0);
2795: write (filedes, block, BLOCKLEN);
2796: stcpy0 (block, block0, (long) BLOCKLEN);
2797:
2798: (*blknbr) = newblk;
2799:
2800: insert (filedes, &block0[2], (long) UNSIGN (block0[0]), newblk);
2801:
2802: /* up-date LL-PTR of RL-block */
2803: if (other != 0) {
2804:
2805: lseek (filedes, (long) other * (long) (BLOCKLEN), 0);
2806: read (filedes, block0, BLOCKLEN);
2807:
2808: block0[LLPTR] = newblk / 65536;
2809: block0[LLPTR + 1] = newblk % 65536 / 256;
2810: block0[LLPTR + 2] = newblk % 256;
2811:
2812: lseek (filedes, (long) other * (long) (BLOCKLEN), 0);
2813: write (filedes, block0, BLOCKLEN);
2814:
2815: }
2816:
2817: }
2818:
2819: return;
2820:
2821: } /* end of splitp() */
2822:
2823: /* update pointer
2824: * filedes: file descriptor
2825: * ins_key: key to be inserted
2826: * keyl: length of that key
2827: */
2828: static void update (short filedes, char *ins_key, long keyl)
2829: {
2830: long offset;
2831: long addr;
2832: unsigned long blknbr;
2833: char block[BLOCKLEN];
2834: long i, j, k;
2835:
2836: while (traceadr[trx] == 0) { /* update of pointer blocks necessary */
2837:
2838: if (--trx < 0) break;
2839:
2840: blknbr = traceblk[trx];
2841: addr = traceadr[trx];
2842:
2843: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
2844: read (filedes, block, BLOCKLEN);
2845:
2846: {
2847: long oldkeyl;
2848:
2849: oldkeyl = UNSIGN (block[addr]);
2850:
2851: i = addr + keyl + 1;
2852: j = oldkeyl - keyl;
2853:
2854: offset = UNSIGN (block[OFFS]) * 256 +
2855: UNSIGN (block[OFFS + 1]);
2856:
2857: if (j > 0) { /* surplus space */
2858:
2859: k = offset;
2860: offset -= j;
2861: j += i;
2862:
2863: while (i < offset) block[i++] = block[j++];
2864:
2865: while (i < k) block[i++] = 0; /* clear area */
2866:
2867: }
2868: else if (j < 0) { /* we need more space */
2869:
2870: /* block too small */
2871: if ((offset - j) > DATALIM) splitp (filedes, block, &addr, &offset, &blknbr);
2872:
2873: i = offset;
2874: offset -= j;
2875: j = offset;
2876: k = addr + oldkeyl;
2877:
2878: while (i > k) block[j--] = block[i--];
2879:
2880: }
2881:
2882: block[OFFS] = offset / 256;
2883: block[OFFS + 1] = offset % 256;
2884: block[addr] = keyl;
2885:
2886: /* overwrite */
2887: i = 0;
2888: j = (++addr);
2889: block[j++] = 0; /*!!! */
2890:
2891: while (i < keyl) block[j++] = ins_key[i++];
2892:
2893: /* block pointed to remains the same */
2894: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
2895: write (filedes, block, BLOCKLEN);
2896:
2897: }
2898:
2899: lseek (filedes, (long) blknbr * (long) (BLOCKLEN), 0);
2900: read (filedes, block, BLOCKLEN);
2901:
2902: }
2903:
2904: return;
2905:
2906: } /* end of update() */
2907:
2908: /*
2909: * insert pointer
2910: * filedes: file descriptor
2911: * ins_key: key to be inserted
2912: * key_len: length of that key
2913: * blknbr: key points to this block
2914: */
2915: static void insert (int filedes, char *ins_key, long key_len, unsigned long blknbr) /* insert pointer */
2916: {
2917: unsigned long blk;
2918: char block[BLOCKLEN];
2919: long trxsav;
2920: long offset;
2921: long needed;
2922: long addr;
2923: register int i, k;
2924:
2925: trxsav = trx--;
2926: blk = traceblk[trx];
2927: addr = traceadr[trx];
2928:
2929: lseek (filedes, (long) (blk) * (long) (BLOCKLEN), 0);
2930: read (filedes, block, BLOCKLEN);
2931:
2932: offset = UNSIGN (block[OFFS]) * 256 +
2933: UNSIGN (block[OFFS + 1]);
2934:
2935: if (traceadr[trx + 1] != (-1)) {
2936: addr += UNSIGN (block[addr]);
2937: addr += (2 + PLEN);
2938: } /* advance to next entry */
2939:
2940: needed = key_len + 2 + PLEN;
2941:
2942: if ((offset + needed) > DATALIM) splitp (filedes, block, &addr, &offset, &blk);
2943:
2944: /* insert key */
2945: i = (offset += needed);
2946:
2947: block[OFFS] = i / 256;
2948: block[OFFS + 1] = i % 256;
2949:
2950: while (i >= addr) {
2951: block[i] = block[i - needed];
2952: i--;
2953: }
2954:
2955: i = addr + 2;
2956: k = 0;
2957:
2958: while (k < key_len) block[i++] = ins_key[k++];
2959:
2960: block[addr] = k;
2961: block[addr + 1] = 0; /* !!! */
2962: block[i++] = blknbr / 65536;
2963: block[i++] = blknbr % 65536 / 256;
2964: block[i] = blknbr % 256;
2965:
2966: lseek (filedes, (long) (blk) * (long) (BLOCKLEN), 0);
2967: write (filedes, block, BLOCKLEN);
2968:
2969: trx = trxsav;
2970:
2971: return;
2972: } /* end of insert() */
2973:
2974: /*
2975: * mark 'blknbr' as free
2976: * filedes: global file descriptor
2977: * blknbr: block to be freed
2978: */
2979: static void b_free (short filedes, unsigned long blknbr)
2980: {
2981: char block0[BLOCKLEN];
2982: unsigned long free;
2983: unsigned long other;
2984: long i;
2985: long offset;
2986:
2987: /* mark block as empty */
2988: lseek (filedes, (long) (blknbr) * BLOCKLEN, 0);
2989: read (filedes, block0, BLOCKLEN);
2990:
2991: block0[BTYP] = EMPTY;
2992:
2993: lseek (filedes, (long) (blknbr) * BLOCKLEN, 0);
2994: write (filedes, block0, BLOCKLEN);
2995:
2996: /* do we have a list of free blocks? */
2997: lseek (filedes, ROOT, 0);
2998: read (filedes, block0, BLOCKLEN);
2999:
3000: if ((free = UNSIGN (block0[FREE]) * 65536 + UNSIGN (block0[FREE + 1]) * 256 + UNSIGN (block0[FREE + 2]))) {
3001:
3002: for (;;) {
3003:
3004: lseek (filedes, (long) free * (long) BLOCKLEN, 0);
3005: read (filedes, block0, BLOCKLEN);
3006:
3007: other = UNSIGN (block0[RLPTR]) * 65536 +
3008: UNSIGN (block0[RLPTR + 1]) * 256 +
3009: UNSIGN (block0[RLPTR + 2]);
3010:
3011: if (other == 0) break;
3012:
3013: free = other;
3014:
3015: }
3016:
3017: offset = UNSIGN (block0[OFFS]) * 256 + UNSIGN (block0[OFFS + 1]);
3018:
3019: /* if list is full, start new page */
3020: if (offset > (DATALIM - PLEN)) {
3021:
3022: offset -= PLEN;
3023: other = UNSIGN (block0[offset]) * 65536 +
3024:
3025: UNSIGN (block0[offset + 1]) * 256 +
3026: UNSIGN (block0[offset + 2]);
3027:
3028: block0[offset] = 0;
3029: block0[offset + 1] = 0;
3030: block0[offset + 2] = 0;
3031: block0[OFFS] = offset / 256;
3032: block0[OFFS + 1] = offset % 256;
3033: block0[RLPTR] = other / 65536;
3034: block0[RLPTR + 1] = other % 65536 / 256;
3035: block0[RLPTR + 2] = other % 256;
3036:
3037: lseek (filedes, (long) free * (long) BLOCKLEN, 0);
3038: write (filedes, block0, BLOCKLEN);
3039:
3040: for (i = 0; i < BLOCKLEN; block0[i++] = 0); /* clear block */
3041:
3042: block0[BTYP] = FBLK;
3043: block0[LLPTR] = free / 65536;
3044: block0[LLPTR + 1] = free % 65536 / 256;
3045: block0[LLPTR + 2] = free % 256;
3046: offset = 0;
3047:
3048: free = other;
3049:
3050: }
3051:
3052: }
3053: else {
3054:
3055: getnewblk (filedes, &free);
3056:
3057: /* set FBLK free blocks pointer */
3058: lseek (filedes, ROOT, 0);
3059: read (filedes, block0, BLOCKLEN);
3060:
3061: block0[FREE] = free / 65536;
3062: block0[FREE + 1] = free % 65536 / 256;
3063: block0[FREE + 2] = free % 256;
3064:
3065: lseek (filedes, ROOT, 0);
3066: write (filedes, block0, BLOCKLEN);
3067:
3068: for (i = 0; i < BLOCKLEN; block0[i++] = 0); /* clear block */
3069:
3070: block0[BTYP] = FBLK;
3071: offset = 0;
3072: }
3073:
3074: /* enter 'blknbr' */
3075: block0[offset++] = blknbr / 65536;
3076: block0[offset++] = blknbr % 65536 / 256;
3077: block0[offset++] = blknbr % 256;
3078: block0[OFFS] = offset / 256;
3079: block0[OFFS + 1] = offset % 256;
3080:
3081: lseek (filedes, (long) free * (long) BLOCKLEN, 0);
3082: write (filedes, block0, BLOCKLEN);
3083:
3084: return;
3085: } /* end of b_free() */
3086:
3087: /*
3088: * scan pointer 'block' for 'compactkey'
3089: *
3090: * 'adr' will return an adress
3091: * 2 heureka; key found at adr
3092: * 1 not found, adr=following entry
3093: */
3094: static void scanpblk (char *block, long *adr, long *fnd)
3095: {
3096: register int i = 0;
3097: register int k;
3098: long j, offset, len;
3099: char key0[256];
3100:
3101: *adr = 0;
3102: offset = UNSIGN (block[OFFS]) * 256 + UNSIGN (block[OFFS + 1]);
3103:
3104: while (i < offset) {
3105:
3106: #ifdef VERSNEW
3107:
3108: j = i; /* save adress of current entry */
3109: len = UNSIGN (block[i++]);
3110:
3111: stcpy0 (key0, &block[++i], len);
3112:
3113: key0[len] = g_EOL;
3114: i += len;
3115:
3116: #else
3117:
3118: j = i++;
3119: len = UNSIGN (block[j]);
3120: k = 0;
3121: i++;
3122:
3123: while (k < len) key0[k++] = block[i++];
3124:
3125: key0[k] = g_EOL;
3126:
3127: #endif /* VERSNEW */
3128:
3129: if (((*fnd) = g_collate (key0)) == 1) return;
3130:
3131: *adr = j;
3132:
3133: if ((*fnd) == 2) return;
3134:
3135: i += PLEN;
3136:
3137: }
3138:
3139: return;
3140:
3141: } /* end of scanpblk() */
3142:
3143: /*
3144: * scan 'block' for 'compactkey'
3145: * same stuff as scanpblk for the params.
3146: */
3147: static void scandblk (char *block, long *adr, long *fnd)
3148: {
3149: register int i = 0;
3150: register int k;
3151: long offset, len;
3152: char key0[256];
3153:
3154: offset = UNSIGN (block[OFFS]) * 256 +
3155: UNSIGN (block[OFFS + 1]);
3156:
3157: while (i < offset) {
3158:
3159: #ifdef VERSNEW
3160:
3161: *adr = i;
3162:
3163: len = UNSIGN (block[i++]);
3164: k = UNSIGN (block[i++]);
3165:
3166: stcpy0 (&key0[k], &block[i], len);
3167:
3168: key0[k + len] = g_EOL;
3169: i += len;
3170:
3171: #else
3172:
3173: *adr = i++;
3174:
3175: len = UNSIGN (block[*adr]) + (k = UNSIGN (block[i++]));
3176:
3177: while (k < len) key0[k++] = block[i++];
3178:
3179: key0[k] = g_EOL;
3180:
3181: #endif /* VERSNEW */
3182:
3183: if (((*fnd) = g_collate (key0)) != 0) return;
3184:
3185: i += UNSIGN (block[i]);
3186:
3187: i++; /* skip data */
3188:
3189: }
3190:
3191: *adr = i;
3192:
3193: return;
3194:
3195: } /* end of scandblk() */
3196:
3197: /*
3198: * get a new block
3199: * filedes: global file descriptor
3200: * blknbr: number of new block
3201: */
3202: static void getnewblk (int filedes, unsigned long *blknbr)
3203: {
3204: char nblock[BLOCKLEN];
3205: unsigned long freeblks, no_of_blks;
3206: long other;
3207: long offset;
3208:
3209: lseek (filedes, ROOT, 0);
3210: read (filedes, nblock, BLOCKLEN);
3211:
3212: freeblks = UNSIGN (nblock[FREE]) * 65536 + UNSIGN (nblock[FREE + 1]) * 256 + UNSIGN (nblock[FREE + 2]);
3213: no_of_blks = UNSIGN (nblock[NRBLK]) * 65536 + UNSIGN (nblock[NRBLK + 1]) * 256 + UNSIGN (nblock[NRBLK + 2]);
3214:
3215: if (freeblks) {
3216:
3217: lseek (filedes, (long) (freeblks) * BLOCKLEN, 0);
3218: read (filedes, nblock, BLOCKLEN);
3219:
3220: offset = UNSIGN (nblock[OFFS]) * 256 + UNSIGN (nblock[OFFS + 1]);
3221:
3222: if (offset == 0) { /* free list is empty. return free list blk as new block. */
3223:
3224: *blknbr = freeblks;
3225: other = UNSIGN (nblock[RLPTR]) * 65536 + UNSIGN (nblock[RLPTR + 1]) * 256 + UNSIGN (nblock[RLPTR + 2]);
3226:
3227: /* update RL-block, if any */
3228: if (other) {
3229:
3230: lseek (filedes, (long) (other) * BLOCKLEN, 0);
3231: read (filedes, nblock, BLOCKLEN);
3232:
3233: nblock[LLPTR] = 0;
3234: nblock[LLPTR + 1] = 0;
3235: nblock[LLPTR + 2] = 0;
3236:
3237: lseek (filedes, (long) (other) * BLOCKLEN, 0);
3238: write (filedes, nblock, BLOCKLEN);
3239:
3240: }
3241:
3242: /* update ROOT block */
3243: lseek (filedes, ROOT, 0);
3244: read (filedes, nblock, BLOCKLEN);
3245:
3246: nblock[FREE] = other / 65536;
3247: nblock[FREE + 1] = other % 65536 / 256;
3248: nblock[FREE + 2] = other % 256;
3249:
3250: lseek (filedes, ROOT, 0);
3251: write (filedes, nblock, BLOCKLEN);
3252:
3253: return;
3254:
3255: }
3256:
3257: offset -= PLEN;
3258: *blknbr = UNSIGN (nblock[offset]) * 65536 + UNSIGN (nblock[offset + 1]) * 256 + UNSIGN (nblock[offset + 2]);
3259: nblock[offset] = 0;
3260: nblock[offset + 1] = 0;
3261: nblock[OFFS] = offset / 256;
3262: nblock[OFFS + 1] = offset % 256;
3263:
3264: lseek (filedes, (long) (freeblks) * BLOCKLEN, 0);
3265: write (filedes, nblock, BLOCKLEN);
3266:
3267: return;
3268:
3269: }
3270:
3271: /* else ** freeblk==0 ** */
3272: no_of_blks++;
3273: nblock[NRBLK] = no_of_blks / 65536;
3274: nblock[NRBLK + 1] = no_of_blks % 65536 / 256;
3275: nblock[NRBLK + 2] = no_of_blks % 256;
3276:
3277: lseek (filedes, ROOT, 0);
3278: write (filedes, nblock, BLOCKLEN);
3279:
3280: *blknbr = no_of_blks;
3281:
3282: for (;;) {
3283:
3284: errno = 0;
3285:
3286: lseek (filedes, (long) (no_of_blks) * BLOCKLEN, 0);
3287: write (filedes, nblock, BLOCKLEN);
3288:
3289: if (errno == 0) break;
3290:
3291: panic ();
3292:
3293: }
3294:
3295: return;
3296:
3297: } /* end of getnewblk() */
3298:
3299: /*
3300: * return TRUE if 't' follows 'compactkey' in MUMPS collating sequence
3301: */
3302: static short int g_collate (char *t)
3303: {
3304: char *s = compactkey;
3305: register int chs = *s;
3306: register int cht = *t;
3307: register int tx = 0;
3308: register int sx;
3309: short dif;
3310:
3311: /* the empty one is the leader! */
3312: if (chs == g_EOL) {
3313:
3314: if (cht == g_EOL) return 2;
3315:
3316: return TRUE;
3317:
3318: }
3319:
3320: if (cht == g_EOL) return FALSE;
3321:
3322: while (cht == s[tx]) {
3323:
3324: if (cht == g_EOL) return 2;
3325:
3326: cht = t[++tx];
3327:
3328: } /* (s==t) */
3329:
3330: chs = s[tx];
3331:
3332: if (chs == OMEGA) return FALSE;
3333: if (chs == ALPHA) return cht != g_EOL;
3334: if (chs == g_EOL && t[tx - 1] & 01) return TRUE;
3335: if (cht == g_EOL && s[tx - 1] & 01) return FALSE;
3336:
3337: if (tx > 0) {
3338:
3339: tx--;
3340:
3341: while ((t[tx] & 01) == 0) {
3342:
3343: tx--;
3344:
3345: if (tx < 0) break;
3346:
3347: }
3348:
3349: tx++;
3350:
3351: }
3352:
3353: chs = s[tx];
3354: cht = t[tx];
3355:
3356: if (UNSIGN (chs) <= POINT) { /* then come numerics */
3357:
3358: if (UNSIGN (cht) > POINT) return UNSIGN (cht) != g_EOL;
3359:
3360: /* both are numeric! now compare numeric values */
3361:
3362: if (chs == MINUS) {
3363: if (cht != MINUS) return TRUE;
3364: }
3365: else {
3366: if (cht == MINUS) return FALSE;
3367: }
3368:
3369: if (chs == 1 && cht == POINT) return TRUE;
3370: if (cht == 1 && chs == POINT) return FALSE;
3371:
3372: dif = sx = tx;
3373:
3374: while (s[sx] != POINT) {
3375: if (s[sx++] & 01) break;
3376: }
3377:
3378: while (t[tx] != POINT) {
3379: if (t[tx++] & 01) break;
3380: }
3381:
3382: if (tx > sx) return cht != MINUS;
3383: if (tx < sx) return cht == MINUS;
3384:
3385: tx = dif;
3386: while ((cht >> 1) == (chs >> 1)) {
3387:
3388: if (cht & 01) return t[dif] == MINUS;
3389: if (chs & 01) return t[dif] != MINUS;
3390:
3391: chs = s[++tx];
3392: cht = t[tx];
3393:
3394: }
3395:
3396: return (((cht >> 1) > (chs >> 1)) == (t[dif] != MINUS)) && (t[tx] != s[tx]);
3397:
3398: }
3399:
3400: if (UNSIGN (cht) <= POINT) return FALSE;
3401:
3402: while ((dif = (UNSIGN (cht) >> 1) - (UNSIGN (chs) >> 1)) == 0) { /* ASCII collating */
3403:
3404: if ((cht & 01) && ((chs & 01) == 0)) return FALSE;
3405: if ((chs & 01) && ((cht & 01) == 0)) return TRUE;
3406:
3407: chs = s[++tx];
3408: cht = t[tx];
3409:
3410: }
3411:
3412: if (chs == g_EOL) return TRUE;
3413: if (cht == g_EOL) return FALSE;
3414:
3415: return dif > 0;
3416:
3417: } /* end g_collate() */
3418:
3419: /*
3420: * test whether 'str' is canonical
3421: */
3422: //static short int g_numeric (char *str)
3423: short g_numeric (char *str)
3424: {
3425: register int ptr = 0, ch;
3426: register int point = 0;
3427:
3428: if (str[0] == '-') {
3429: if ((ch = str[++ptr]) == EOL || (ch == DELIM) || (ch == '0')) return FALSE;
3430: }
3431: else if (str[0] == '0') {
3432:
3433: if ((ch = str[ptr + 1]) == EOL || ch == DELIM) return TRUE;
3434:
3435: return FALSE; /* leading zero */
3436: }
3437:
3438: while ((ch = str[ptr++]) != EOL && ch != DELIM) {
3439:
3440: if (ch > '9') return FALSE;
3441:
3442: if (ch < '0') {
3443:
3444: if (ch != '.') return FALSE;
3445: if (point) return FALSE; /* multiple points */
3446:
3447: point = TRUE;
3448:
3449: }
3450:
3451: }
3452:
3453: if (point) {
3454:
3455: ch = str[ptr - 2];
3456:
3457: if (ch == '0' || ch == '.') return FALSE;
3458:
3459: }
3460:
3461: return TRUE;
3462:
3463: } /* end g_numeric() */
3464:
3465: void close_all_globals (void)
3466: {
3467: register int i;
3468:
3469: for (i = 0; i < NO_GLOBLS; i++) {
3470:
3471: if (oldfil[i][0] != NUL) {
3472:
3473: close (olddes[i]);
3474:
3475: usage[i] = 0;
3476: olddes[i] = 0;
3477: oldfil[i][0] = NUL;
3478:
3479: }
3480:
3481: }
3482:
3483: return;
3484:
3485: } /* end close_all_globals() */
3486:
3487: static void panic (void)
3488: {
3489: printf ("\033[s\033[25H\033[5;7mwrite needs more disk space immediately\007");
3490: sleep (1);
3491: printf ("\033[m\007\033[2K\033[u");
3492:
3493: /* restore screen 'cause system messed up screen */
3494:
3495: #ifdef NOWRITEM
3496:
3497: write_m ("\033[4~\201");
3498:
3499: #endif /* NOWRITEM */
3500:
3501: return;
3502:
3503: } /* end panic() */
3504:
3505:
3506: void gbl_dump_stat(void)
3507: {
3508: register int i;
3509:
3510: printf ("FreeM Global Statistics [PID %d]\r\n", pid);
3511:
3512: printf ("%-10s%-20s%s\r\n", "USECT", "AGE", "FILE");
3513: printf ("%-10s%-20s%s\r\n", "=====", "===", "====");
3514:
3515: for (i = 0; i < NO_GLOBLS; i++) {
3516: printf ("%-10d%-20ld%s\r\n", usage[i], g_ages[i], oldfil[i]);
3517: }
3518:
3519: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to global_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