Annotation of freem/src/global_bltin.c, revision 1.25

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>