File:  [Coherent Logic Development] / freem / src / global_bltin.c
Revision 1.18: download - view: text, annotated - select for diffs
Fri Apr 11 16:23:18 2025 UTC (11 months, 2 weeks ago) by snw
Branches: MAIN
CVS tags: HEAD
Avoid re-reading the same block consecutively when possible

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

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