File:  [Coherent Logic Development] / freem / src / global_bltin.c
Revision 1.14: download - view: text, annotated - select for diffs
Wed Apr 9 19:52:02 2025 UTC (11 months, 4 weeks ago) by snw
Branches: MAIN
CVS tags: HEAD
Eliminate as many warnings as possible while building with -Wall

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

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