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