regina/instore.c

   1 /* This files solves the problems with instore macros.
   2  * While parsing a special tree of type tnode is created
   3  * and fold together with containing strings to one big
   4  * beast (called a tinned tree, american: canned heat :-) ).
   5  * Then we have two objects: a special tree and the tinned tree.
   6  * There is a one to one releationship between them.
   7  * The tinned tree may be expanded to a tree by ExpandTinnedTree().
   8  * The tree is tinned by TinTree() which should only be called from
   9  * the lexical analyser.
  10  * We are protected against multithreading while normal parsing.
  11  * Destroying the tree and tinning/expanding is done in
  12  * multithreaded mode.
  13  */
  14
  15 #include "rexx.h"
  16 #include "rxiface.h"
  17 #include <assert.h>
  18
  19 /* We begin with some odd tricks. We want a fast but memory
  20  * saving routine to build the tree. We don't want to copy
  21  * tree leaves more than one. Thus we pack them into buckets.
  22  * This allows a very fast kind of searching. Keep in mind
  23  * that we must create a pointerless list which is included
  24  * in the tinned tree.
  25  *
  26  * This structure is called ttree, have a look at regina_t.h.
  27  *
  28  * DEFAULT_TTREE_ELEMS defines the normal number of elements in the ttree.
  29  * The more elements the better is the performance in searching. The less
  30  * elements the better is the memory waste overhead. We want some more space
  31  * than MAX_INTERNAL_SIZE in memory.c. This leads to "normal" memory
  32  * allocation and can be freed without problems if we parse a nested
  33  * Rexx program. This is currently 2048. We allocate nearly 8K. This
  34  * will give a reasonable performance and a slight overhead for
  35  * external(!) functions, 4K in the middle.
  36  */
  37 #define DEFAULT_TTREE_ELEMS (8192 / sizeof(treenode))
  38
  39 /* Same as before but for offsrclines: */
  40 #define DEFAULT_OTREE_ELEMS (4096 / sizeof(offsrcline))
  41
  42 static ttree *CurrentT = NULL;
  43 static otree *CurrentO = NULL;
  44 static nodeptr Reused = NULL;
  45 static const char MagicHeader[] = MAGIC;
  46
  47 /* NewProg indicates the start of a new parsing sequence. We don't allow
  48  * a nesting call. In case of an error is is the job of fetch_... to do the
  49  * cleanup.
  50  */
  51 void NewProg(void)
  52 {
  53    CurrentT = NULL; /* Trivial */
  54    CurrentO = NULL; /* Trivial */
  55    Reused = NULL; /* Can't reuse stuff of another parsing process */
  56 }
  57
  58 /* EndProg is called at the end of the parsing process. Start is the
  59  * starting element of the later interpreter tree.
  60  * parser_data.root is assigned.
  61  */
  62 void EndProg(nodeptr Start)
  63 {
  64    parser_data.root = Start; /* trivial, too */
  65    CurrentT = NULL;
  66    CurrentO = NULL;
  67    Reused = NULL; /* Can't reuse stuff of another parsing process */
  68 }
  69
  70 /* FreshNode returns a new ttree element. Call only within a NewProg/EndProg
  71  * calling sequence.
  72  * If you don't want the returned node WHILE PARSING because you want to do
  73  * some tricks the the node at a later time, you are allowed to call
  74  * RejectNode(). Rejected nodes are tried to be passed back to the used
  75  * nodes.
  76  */
  77 nodeptr FreshNode(void)
  78 {
  79    nodeptr h;
  80
  81    if (Reused != NULL) /* This should be put back first */
  82    {
  83       h = Reused;
  84       Reused = Reused->next;
  85       h->next = NULL; /* Everything except nodeindex is 0 now */
  86       return(h);
  87    }
  88
  89    if (CurrentT && (CurrentT->num < CurrentT->max)) /* bucket not full */
  90    {
  91       memset(CurrentT->elems + CurrentT->num, 0, sizeof(treenode));
  92       CurrentT->elems[CurrentT->num].nodeindex = CurrentT->sum + CurrentT->num;
  93       return(CurrentT->elems + CurrentT->num++);
  94    }
  95
  96    if (CurrentT == NULL) /* First call */
  97    {
  98       parser_data.nodes = (ttree *)Malloc_TSD(parser_data.TSD, sizeof(ttree));
  99       CurrentT = parser_data.nodes;
 100       CurrentT->sum = 0;
 101    }
 102    else /* current bucket is full */
 103    {
 104       CurrentT->next = (ttree *)Malloc_TSD(parser_data.TSD, sizeof(ttree));
 105       CurrentT->next->sum = CurrentT->sum + CurrentT->num;
 106       CurrentT = CurrentT->next;
 107    }
 108
 109    /* always */
 110    CurrentT->next = NULL;
 111    CurrentT->max = DEFAULT_TTREE_ELEMS;
 112    CurrentT->num = 1;
 113    CurrentT->elems = (treenode *)Malloc_TSD(parser_data.TSD,
 114                                 CurrentT->max * sizeof(treenode));
 115
 116    memset(CurrentT->elems, 0, sizeof(treenode));
 117    CurrentT->elems[0].nodeindex = CurrentT->sum;
 118    return(CurrentT->elems);
 119 }
 120
 121 /* RejectNode gives the argument back to the pool of unused treenode entries
 122  * which are managed and passed back by FreshNode().
 123  * You should use the function ONLY IF YOU ARE WITHING THE PARSING PROCESS!
 124  * It is not guaranteed that the memory of the entry is freed. It can only
 125  * be reused.
 126  * Note that the content of the entry is NOT FREED in any kind.
 127  */
 128 void RejectNode(nodeptr NoLongerUsed)
 129 {
 130    unsigned long idx;
 131
 132    assert(CurrentT != NULL);
 133    /* CurrentT == NULL can't happen, since CurrentT is only set within the
 134     * parsing process while at least one treenode has been returned.
 135     */
 136    if (CurrentT == NULL) /* In case of no assertion we return simply */
 137       return;
 138
 139    /* Save exactly the nodeindex and destroy everything else */
 140    idx = NoLongerUsed->nodeindex;
 141    memset(NoLongerUsed, 0, sizeof(treenode)); /* Clean it up */
 142    NoLongerUsed->nodeindex = idx;
 143
 144    NoLongerUsed->next = Reused;
 145    Reused = NoLongerUsed;
 146 }
 147
 148 /* FreshLine returns a new otree element. Call only within a NewProg/EndProg
 149  * calling sequence.
 150  */
 151 offsrcline *FreshLine(void)
 152 {
 153    if (CurrentO && (CurrentO->num < CurrentO->max)) /* bucket not full */
 154    {
 155       memset(CurrentO->elems + CurrentO->num, 0, sizeof(offsrcline));
 156       return(CurrentO->elems + CurrentO->num++);
 157    }
 158
 159    if (CurrentO == NULL) /* First call */
 160    {
 161       parser_data.srclines = (otree *)Malloc_TSD(parser_data.TSD, sizeof(otree));
 162       CurrentO = parser_data.srclines;
 163       CurrentO->sum = 0;
 164    }
 165    else /* current bucket is full */
 166    {
 167       CurrentO->next = (otree *)Malloc_TSD(parser_data.TSD, sizeof(otree));
 168       CurrentO->next->sum = CurrentO->sum + CurrentO->num;
 169       CurrentO = CurrentO->next;
 170    }
 171
 172    /* always */
 173    CurrentO->next = NULL;
 174    CurrentO->max = DEFAULT_OTREE_ELEMS;
 175    CurrentO->num = 1;
 176    CurrentO->elems = (offsrcline *)Malloc_TSD(parser_data.TSD,
 177                                 CurrentO->max * sizeof(offsrcline));
 178
 179    memset(CurrentO->elems, 0, sizeof(offsrcline));
 180    return(CurrentO->elems);
 181 }
 182
 183 /*****************************************************************************
 184  *****************************************************************************
 185  * start of the multithreaded part *******************************************
 186  *****************************************************************************
 187  *****************************************************************************/
 188
 189
 190 /* DestroyNode kills all allocated elements within a nodeptr
 191  * without freeing the node itself.
 192  */
 193 static void DestroyNode(const tsd_t *TSD, nodeptr p)
 194 {
 195    int type ;
 196
 197    if (p->name)
 198       Free_stringTSD( p->name ) ;
 199
 200    if (p->now)
 201       FreeTSD( p->now ) ;
 202
 203    type = p->type ;
 204    if (type == X_CON_SYMBOL || type == X_STRING)
 205    {
 206       if (p->u.number)
 207       {
 208          FreeTSD( p->u.number->num ) ;
 209          FreeTSD( p->u.number ) ;
 210       }
 211    }
 212    if (type==X_SIM_SYMBOL || type==X_STEM_SYMBOL || type==X_HEAD_SYMBOL ||
 213        type==X_CTAIL_SYMBOL || type==X_VTAIL_SYMBOL )
 214    {
 215       if (p->u.varbx)
 216       {
 217          detach( TSD, p->u.varbx ) ;
 218       }
 219    }
 220
 221    if (type == X_CEXPRLIST)
 222    {
 223       if (p->u.strng)
 224          Free_stringTSD( p->u.strng ) ;
 225    }
 226 }
 227
 228 /* DestroyInternalParsingTree frees all allocated memory used by a parsing
 229  * tree. The structure itself is not freed.
 230  */
 231 void DestroyInternalParsingTree(const tsd_t *TSD, internal_parser_type *ipt)
 232 {
 233    ttree *tr, *th;
 234    otree *otr, *oh;
 235    lineboxptr lr, lh;
 236    labelboxptr ar, ah;
 237    unsigned long i;
 238
 239    if (!ipt)
 240       return;
 241
 242    /* Cleanup all the nodes */
 243    if (ipt->nodes != NULL)
 244    {
 245       tr = ipt->nodes;
 246
 247       while (tr)
 248       {
 249          for (i = 0; i < tr->num; i++)
 250             DestroyNode(TSD, tr->elems + i);
 251          th = tr->next;
 252          FreeTSD(tr->elems);
 253          FreeTSD(tr);
 254          tr = th;
 255       }
 256
 257       ipt->nodes = NULL;
 258    }
 259    ipt->root = NULL; /* not really needed */
 260
 261    /* Cleanup all the lineboxes */
 262    if (ipt->first_source_line != NULL)
 263    {
 264       lr = ipt->first_source_line;
 265
 266       while (lr)
 267       {
 268          lh = lr->next;
 269          Free_stringTSD(lr->line);
 270          FreeTSD(lr);
 271          lr = lh;
 272       }
 273
 274       ipt->first_source_line = ipt->last_source_line = NULL;
 275    }
 276
 277    /* Cleanup all the labelboxes */
 278    if (ipt->first_label != NULL)
 279    {
 280       ar = ipt->first_label;
 281
 282       while (ar)
 283       {
 284          ah = ar->next;
 285          FreeTSD(ar);
 286          ar = ah;
 287       }
 288
 289       ipt->first_label = ipt->last_label = NULL;
 290    }
 291
 292    if (ipt->sort_labels != NULL)
 293    {
 294       FreeTSD(ipt->sort_labels);
 295
 296       ipt->sort_labels = NULL;
 297    }
 298
 299    /* Cleanup the incore sourceline informations */
 300    /* Cleanup all the nodes */
 301    if (ipt->srclines != NULL)
 302    {
 303       otr = ipt->srclines;
 304
 305       while (otr)
 306       {
 307          oh = otr->next;
 308          FreeTSD(otr->elems);
 309          FreeTSD(otr);
 310          otr = oh;
 311       }
 312
 313       ipt->srclines = NULL;
 314    }
 315    if (ipt->kill)
 316       Free_stringTSD(ipt->kill);
 317    ipt->kill = NULL;
 318 }
 319
 320 /* ExpandTinnedTree expands the external tree from a former parsing operation
 321  * to a fully usable tree. All allocations and relacations are done to fake
 322  * a normal parsing operation.
 323  * The external tree won't be used any longer after this operation but the
 324  * external tree must have been checked before this operation.
 325  * The freshly allocated tree is returned.
 326  */
 327 internal_parser_type ExpandTinnedTree(const tsd_t *TSD,
 328                                       const external_parser_type *ept,
 329                                       unsigned long size,
 330                                       const char *incore_source,
 331                                       unsigned long incore_source_length)
 332 {
 333    internal_parser_type ipt;
 334    unsigned long i,j;
 335    const extstring *es;
 336    const offsrcline *lastsrcline;
 337    nodeptr thisptr;
 338
 339    memset(&ipt, 0, sizeof(ipt));
 340
 341    /* We build the sourcelines first *****************************************/
 342    if (incore_source_length == 0)
 343       incore_source = NULL;
 344    if (ept->NumberOfSourceLines == 0)
 345       incore_source = NULL;
 346    if (incore_source) /* Its worth to check exactly */
 347    {
 348       lastsrcline = (const offsrcline *) ((char *) ept + ept->source);
 349       lastsrcline += ept->NumberOfSourceLines - 1;
 350       j = lastsrcline->length + lastsrcline->offset;
 351       /* j shall be very close to the end of the source string. It may
 352        * follow a linefeed (or carriage return/linefeed) and probably a
 353        * ^Z for CP/M descendents which includes Microsoft products. It's
 354        * fais to assume the following check:
 355        */
 356       if ((j > incore_source_length) ||
 357           (j + 3 < incore_source_length))
 358       incore_source = NULL;
 359    }
 360    if (incore_source) /* We are sure enough to use the source string */
 361    {
 362       ipt.incore_source = incore_source;
 363       ipt.srclines = (otree *)MallocTSD(sizeof(otree));
 364       ipt.srclines->sum = 0;
 365       ipt.srclines->next = NULL;
 366       ipt.srclines->max = ept->NumberOfSourceLines;
 367       ipt.srclines->num = ipt.srclines->max;
 368       ipt.srclines->elems = (offsrcline *)MallocTSD(ipt.srclines->num * sizeof(offsrcline));
 369       memcpy(ipt.srclines->elems,
 370              (char *) ept + ept->source,
 371              ipt.srclines->num * sizeof(offsrcline));
 372    }
 373    /**************************************************************************/
 374
 375    ipt.tline = -1; /* unused */
 376    ipt.tstart = -1; /* unused */
 377    ipt.result = 0; /* unused */
 378    ipt.first_label = ipt.last_label = NULL; /* initialize it for newlabel() */
 379    ipt.numlabels = 0; /* initialize it for newlabel() */
 380    ipt.sort_labels = NULL; /* initialize it for newlabel() */
 381
 382    ipt.nodes = (ttree *)MallocTSD(sizeof(ttree));
 383    ipt.nodes->sum = 0;
 384    ipt.nodes->next = NULL;
 385    ipt.nodes->max = ept->NumberOfTreeElements;
 386    ipt.nodes->num = ipt.nodes->max;
 387    ipt.nodes->elems = (treenode *)MallocTSD(ipt.nodes->num * sizeof(treenode));
 388
 389    memcpy(ipt.nodes->elems,
 390           (char *) ept + ept->tree,
 391           ipt.nodes->num * sizeof(treenode));
 392    ipt.root = ipt.nodes->elems + ept->TreeStart;
 393
 394    /* Everything is ready for a relocation step. Don't forget to *************
 395     * create the labelboxes as necessary.
 396     */
 397    for (i = 0;i < ept->NumberOfTreeElements;i++)
 398    {
 399       thisptr = ipt.nodes->elems + i;
 400       if (thisptr->name)
 401       {
 402          es = (extstring *) ((char *) ept + (unsigned long) thisptr->name);
 403          thisptr->name = Str_makeTSD(es->length);
 404          thisptr->name->len = es->length;
 405          memcpy(thisptr->name->value,
 406                 es + 1 /* position of string content */,
 407                 es->length);
 408       }
 409
 410       /*
 411        * Do things the parsing step would have do. Simple values in thisptr->u
 412        * are copied already.
 413        */
 414
 415       /*
 416        * See also several places in this file and in debug.c where this
 417        * switch list must be changed. Seek for X_CEXPRLIST.
 418        */
 419       switch ( thisptr->type )
 420       {
 421          case X_CEXPRLIST:
 422             if ( thisptr->u.strng )
 423             {
 424                es = (extstring *) ((char *) ept + (unsigned long) thisptr->u.strng);
 425                thisptr->u.strng = Str_makeTSD( es->length );
 426                thisptr->u.strng->len = es->length;
 427                memcpy( thisptr->u.strng->value,
 428                        es + 1 /* position of string content */,
 429                        es->length);
 430             }
 431             break;
 432
 433          case X_LABEL:
 434             newlabel(TSD, &ipt, thisptr);
 435             break;
 436
 437          default:
 438             break;
 439       }
 440
 441       if (thisptr->next == (nodeptr) (unsigned long) -1)
 442          thisptr->next = NULL;
 443       else
 444          thisptr->next = ipt.nodes->elems + (unsigned long) thisptr->next;
 445       for (j = 0;j < sizeof(thisptr->p) / sizeof(thisptr->p[0]);j++)
 446       {
 447          if (thisptr->p[j] == (nodeptr) (unsigned long) -1)
 448             thisptr->p[j] = NULL;
 449          else
 450             thisptr->p[j] = ipt.nodes->elems + (unsigned long) thisptr->p[j];
 451       }
 452    }
 453    size = size; /* keep compiler happy */
 454
 455    return(ipt);
 456 }
 457
 458 /* We must take care of the alignment of structure. We may get a SIGBUS in
 459  * the following if we don't do it. We assume that an alignment for an
 460  * unsigned long is sufficient for all types including structures. We also
 461  * assume a power of two for an unsigned's size.
 462  */
 463 #define USIZ sizeof(unsigned long)
 464 #define USIZ_1 (USIZ-1)
 465 /* Wastes one byte in average but is much faster */
 466 #define StringSize(s) (((sizeof(extstring)+s->len)|USIZ_1)+1)
 467
 468 static unsigned long ComputeExternalSize(const internal_parser_type *ipt,
 469                                          unsigned long *SourceLines,
 470                                          unsigned long *Nodes)
 471 {
 472    otree *otp;
 473    ttree *ttp;
 474    nodeptr np;
 475    unsigned long size = sizeof(external_parser_type);
 476    unsigned long i, elems, bufchars;
 477
 478    /* sourceline table */
 479    elems = 0;
 480    if ((otp = ipt->srclines) == NULL)
 481    {
 482       if (ipt->last_source_line)
 483       {
 484          elems = ipt->last_source_line->lineno;
 485       }
 486    }
 487    else
 488    {
 489       while (otp->next)
 490          otp = otp->next;
 491       elems = otp->sum + otp->num;
 492    }
 493    *SourceLines = elems;
 494    size += elems * sizeof(offsrcline); /* the table */
 495
 496    /* nodetable */
 497    elems = bufchars = 0;
 498    ttp = ipt->nodes;
 499    while (ttp)
 500    {
 501       for (i = 0;i < ttp->num;i++)
 502       {
 503          elems++;
 504          np = ttp->elems + i;
 505          if (np->name)
 506             bufchars += StringSize(np->name);
 507
 508          /*
 509           * Add all sizes of strings that have been generated at the parsing
 510           * step.
 511           */
 512
 513          /*
 514           * See also several places in this file and in debug.c where this
 515           * switch list must be changed. Seek for X_CEXPRLIST.
 516           */
 517          switch ( np->type )
 518          {
 519             case X_CEXPRLIST:
 520                if ( np->u.strng )
 521                   bufchars += StringSize( np->u.strng );
 522             break;
 523
 524             default:
 525                break;
 526          }
 527       }
 528       ttp = ttp->next;
 529    }
 530    *Nodes = elems;
 531    size += elems * sizeof(treenode);
 532    size += bufchars;
 533
 534    size += sizeof(((external_parser_type *)0)->Magic);
 535    return(size);
 536 }
 537
 538 /* FillStrings copies all offsrclines from the otree to base+start
 539  * consecutively.
 540  * The index just beyond the last copied byte is returned.
 541  */
 542 static unsigned long FillStrings(char *base, unsigned long start,
 543                                  const otree *otp)
 544 {
 545    if (otp != NULL)
 546    {
 547       while (otp != NULL)
 548       {
 549          memcpy(base + start, otp->elems, otp->num * sizeof(offsrcline));
 550          start += otp->num * sizeof(offsrcline);
 551          otp = otp->next;
 552       }
 553    }
 554    return(start);
 555 }
 556
 557 /* FillTree copies all treenodes of the ttree to base+buf in a relocatable
 558  * manner. Look at ExpandTinnedTree() or regina_t.h for a description.
 559  * Each treenode is copied to the table and the containing strings are copied
 560  * as extstrings to base+start which is incremented.
 561  * The table must be large enough.
 562  * The index just beyond the last copied character is returned.
 563  */
 564 static unsigned long FillTree(treenode *table, char *base, unsigned long start,
 565                               const ttree *ttp)
 566 {
 567    cnodeptr np;
 568    unsigned long i,j;
 569    extstring *e;
 570
 571    while (ttp)
 572    {
 573       for (i = 0;i < ttp->num;i++)
 574       {
 575          np = (cnodeptr) (ttp->elems + i);
 576          *table = *np; /* Full copy includes unnecessary stuff but is fast */
 577
 578          if (np->name)
 579          {
 580             table->name = (streng *) start;
 581             e = (extstring *) (base + start);
 582             e->length = np->name->len;
 583             memcpy(e + 1 /* just beyond the head */, np->name->value, e->length);
 584             start += StringSize(np->name);
 585          }
 586
 587          /*
 588           * Remove all "flags" from the target and copy only approved values
 589           * the parser computes already.
 590           */
 591          memset( &table->u, 0, sizeof( table->u ) );
 592
 593          /*
 594           * See also several places in this file and in debug.c where this
 595           * switch list must be changed. Seek for X_CEXPRLIST.
 596           */
 597          switch ( np->type )
 598          {
 599             case X_EQUAL:
 600             case X_DIFF:
 601             case X_GT:
 602             case X_GTE:
 603             case X_LT:
 604             case X_LTE:
 605                table->u.flags = np->u.flags;
 606                break;
 607
 608             case X_PARSE:
 609                /*
 610                 * fixes 972850
 611                 */
 612                table->u.parseflags = np->u.parseflags;
 613                break;
 614
 615             case X_ADDR_V:
 616                table->u.nonansi = np->u.nonansi;
 617                break;
 618
 619             case X_CEXPRLIST:
 620                if ( np->u.strng )
 621                {
 622                   table->u.strng = (streng *) start;
 623                   e = (extstring *) (base + start);
 624                   e->length = np->u.strng->len;
 625                   memcpy(e + 1, np->u.strng->value, e->length);
 626                   start += StringSize(np->u.strng);
 627                }
 628             break;
 629
 630             case X_LABEL:
 631                table->u.trace_only = np->u.trace_only;
 632                break;
 633
 634             case X_ADDR_WITH:
 635                if ( !np->p[0] && !np->p[1] && !np->p[2] )
 636                   table->u.of = np->u.of;
 637                break;
 638
 639             default:
 640                break;
 641          }
 642
 643          if (table->next == NULL)
 644             table->next = (nodeptr) (unsigned long) -1;
 645          else
 646             table->next = (nodeptr) np->next->nodeindex;
 647          for (j = 0;j < sizeof(np->p) / sizeof(np->p[0]);j++)
 648          {
 649             if (table->p[j] == NULL)
 650                table->p[j] = (nodeptr) (unsigned long) -1;
 651             else
 652                table->p[j] = (nodeptr) np->p[j]->nodeindex;
 653          }
 654          table++;
 655       }
 656       ttp = ttp->next;
 657    }
 658
 659    return(start);
 660 }
 661
 662 /* TinTree "tins" a tree into an external structure. The complete structure
 663  * is allocated by one call to IfcAllocateMemory. The returned value shall
 664  * be used as an instore macro for RexxStart.
 665  * *length is set to the allocated size of the memory block on return.
 666  * ExpandedTinnedTree can expand the returned value and IsValidTin checks it.
 667  */
 668 external_parser_type *TinTree(const tsd_t *TSD,
 669                               const internal_parser_type *ipt,
 670                               unsigned long *length)
 671 {
 672    external_parser_type *retval;
 673    unsigned long srclines, nodecount, len;
 674
 675    *length = ComputeExternalSize(ipt, &srclines, &nodecount);
 676
 677    retval = (external_parser_type *)IfcAllocateMemory(*length);
 678    if (retval == NULL)
 679       return(NULL);
 680    memset(retval, 0, sizeof(external_parser_type));
 681
 682    /* Build the envelope */
 683    len = sizeof(MagicHeader); /* includes a terminating 0 */
 684    if (len > sizeof(retval->Magic))
 685       len = sizeof(retval->Magic);
 686    memcpy(retval->Magic, MagicHeader, len);
 687    len = sizeof(PARSE_VERSION_STRING);
 688    if (len > sizeof(retval->ReginaVersion))
 689       len = sizeof(retval->ReginaVersion);
 690    memcpy(retval->ReginaVersion, PARSE_VERSION_STRING, len);
 691
 692    retval->arch_detector.s.one = 1;
 693    retval->arch_detector.s.two = 2;
 694    retval->arch_detector.s.ptr3 = (void *)3;
 695    retval->arch_detector.s.ptr4 = (void *)4;
 696    retval->OverallSize = (unsigned long) *length;
 697    retval->NumberOfSourceLines = srclines;
 698    retval->version = INSTORE_VERSION;
 699    retval->NumberOfTreeElements = nodecount;
 700
 701    retval->source = sizeof(external_parser_type);
 702    len = FillStrings((char *) retval,
 703                      sizeof(external_parser_type),
 704                      ipt->srclines);
 705
 706    retval->tree = len;
 707    retval->TreeStart = ipt->root->nodeindex;
 708    len = FillTree((treenode *) ((char *) retval + len),
 709                   (char *) retval,
 710                   len + nodecount*sizeof(treenode),
 711                   ipt->nodes);
 712
 713    memcpy((char *) retval + len, retval->Magic, sizeof(retval->Magic));
 714
 715    assert((unsigned long) len + sizeof(retval->Magic) == *length);
 716
 717    /* DEBUGGING: return NULL if you don't want tinned trees */
 718    TSD = TSD; /* keep compiler happy */
 719    return(retval);
 720 }
 721
 722 /* IsValidTin returns 1 if the structure ept if of length eptlen and seems
 723  * to contain a valid parsing tree. 0 is returned if this is not the case.
 724  */
 725 int IsValidTin(const external_parser_type *ept, unsigned long eptlen)
 726 {
 727    char Magic[sizeof(((external_parser_type *)0)->Magic)];
 728    unsigned long len;
 729
 730    /* Some paranoia tests first: */
 731    if ((ept == NULL) || (eptlen < sizeof(external_parser_type)))
 732       return(0);
 733
 734    /* Be sure to fill Magic as described */
 735    memset(Magic, 0, sizeof(Magic));
 736    len = sizeof(MagicHeader); /* includes a terminating 0 */
 737    if (len > sizeof(ept->Magic))
 738       len = sizeof(ept->Magic);
 739    memcpy(Magic, MagicHeader, len);
 740
 741    if (memcmp(Magic, ept->Magic, sizeof(Magic)) != 0)
 742       return(0);
 743
 744    if ((ept->arch_detector.s.one != 1) ||
 745        (ept->arch_detector.s.two != 2) ||
 746        (ept->arch_detector.s.ptr3 != (void *)3) ||
 747        (ept->arch_detector.s.ptr4 != (void *)4))
 748       return(0);
 749
 750    if (ept->OverallSize != eptlen)
 751       return(0);
 752
 753    if (ept->version != INSTORE_VERSION)
 754       return(0);
 755
 756    if (memcmp(Magic,
 757               (char *) ept + eptlen - sizeof(Magic),
 758               sizeof(Magic)) != 0)
 759       return(0);
 760
 761    return(1);
 762 }