home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD2.mdf / c / library / xplatfrm / tierra / genio.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-04-26  |  20.8 KB  |  639 lines
  1. /* genio.c  28-10-91  genebank input/output routines */
  2. /** Tierra Simulator V3.0: Copyright (c) 1991 Thomas S. Ray **/
  3.  
  4. #include "license.h"
  5.  
  6. #ifndef lint
  7. static char     sccsid[] = "@(#)genio.c    2.9 10/8/91";
  8. #endif
  9.  
  10. #include "tierra.h"
  11. #include "extern.h"
  12. #include <sys/types.h>
  13. #include <sys/stat.h>
  14. #include <errno.h>
  15.  
  16. #define WritEcoS(bits)        WritEcoF(bits, stdout)
  17.  
  18. /*
  19.  * open_ar - open a genebank archive
  20.  *
  21.  *     file - the filename;
  22.  *     size - the creature size
  23.  *     format - a byte, usually the instruction set number
  24.  *     mode - 0 if the file exists its contents should be preserved,
  25.  *          1+ if the file should be created (or truncated). mode > 1
  26.  *          is taken as the number of index entries to allocate 
  27.  *            (will be rounded to the next highest # such that
  28.  *            index + header is a multiple of 1K)
  29.  *
  30.  * returns a pointer to a file opened for update, or NULL if unsuccessful.
  31.  * open_ar fails if size or format are incompatible with the archive.
  32.  */
  33.  
  34. FILE *open_ar(file, size, format, mode)
  35.     I8s   *file, format;
  36.     I16s  size, mode;
  37. {
  38.     FILE *fp;
  39.     head_t head;
  40.     struct stat *buf = (struct stat *) thcalloc(1, sizeof(struct stat));
  41.  
  42.     if (mode || stat(file, buf) == -1) {
  43.     if (fp = fopen(file, "w+b")) {
  44.         strcpy(head.magic, "tie");
  45.         head.magic[3] = '0' + format;
  46.         head.size = size;
  47.         head.n = 0;
  48.         head.n_alloc = (((int) ((sizeof(head_t) + mode * sizeof(indx_t)) /
  49.                 1024.0) + 1) * 1024 - sizeof head) / sizeof(indx_t);
  50.         head.g_off = sizeof(head_t) + head.n_alloc * sizeof(indx_t);
  51.         write_head(fp, &head);
  52.     }
  53.     }
  54.     else if (fp = fopen(file, "r+b")) {
  55.     head = read_head(fp);
  56.     if (head.size != size || head.magic[3] != format + '0' ||
  57.                 strncmp(head.magic, "tie", 3)) {
  58.         fclose(fp);
  59.         fp = NULL;
  60.         errno = EINVAL;
  61.     }
  62.     }
  63.     return fp;
  64. }
  65.  
  66. /*
  67.  * read_head - read header from a genebank archive
  68.  */
  69.  
  70. head_t read_head(fp)
  71.     FILE *fp;
  72. {
  73.     head_t t;
  74.  
  75.     if (!fseek(fp, 0, 0)) fread(&t, sizeof(head_t), 1, fp);
  76.     else perror("read_head");
  77.     return t;
  78. }
  79.  
  80. /*
  81.  * write_head - write header to a genebank archive
  82.  */
  83.  
  84. void write_head(fp, head)
  85.     FILE    *fp;
  86.     head_t  *head;
  87. {
  88.     if (!fseek(fp, 0, 0)) fwrite(head, sizeof(head_t), 1, fp);
  89.     else perror("write_head");
  90. }
  91.  
  92. /*
  93.  * read_indx - read the index from a genebank archive
  94.  */
  95.  
  96. indx_t *read_indx(fp, head)
  97.     FILE    *fp;
  98.     head_t  *head;
  99. {
  100.     indx_t *t = 0;
  101.     
  102.     if (!fseek(fp, sizeof(head_t), 0)) {
  103.     t = (indx_t *) thcalloc(head->n_alloc, sizeof(indx_t));
  104.     fread(t, sizeof(indx_t), head->n, fp);
  105.     }
  106.     else perror("read_indx");
  107.     return t;
  108. }
  109.  
  110. /*
  111.  * write_indx - write the index to a genebank archive
  112.  */
  113.  
  114. void write_indx(fp, head, indx)
  115.     FILE    *fp;
  116.     head_t  *head;
  117.     indx_t  *indx;
  118. {
  119.     if (!fseek(fp, sizeof(head_t), 0)) {
  120.     fwrite(indx, sizeof(indx_t), head->n_alloc, fp);
  121.     }
  122.     else perror("write_indx");
  123. }
  124.  
  125. /*
  126.  * find_gen - find the index of a genome in an archive by its 3 letter name
  127.  *
  128.  * will return n (number of genomes) if not found, otherwise the position
  129.  * (0 - n-1) in archive
  130.  */
  131.  
  132. I32s find_gen(indx, gen, n)
  133.     indx_t indx[];
  134.     I8s   *gen;
  135.     I32s  n;
  136. {
  137.     I32s  i;
  138.  
  139.     for (i=0; i<n; i++) if (!strncmp(indx[i].gen, gen, 3)) break;
  140.     return i;
  141. }
  142.  
  143. /*
  144.  * get_gen - read a genome from genebank archive and return a pointer
  145.  *     to a struct g_list containing all saved info.
  146.  *
  147.  *     fp - pointer to open archive file
  148.  *     head - archive header
  149.  *     indxn - index entry of desired genome
  150.  *     n - position of desired genome in archive
  151.  *
  152.  * reads the genome and reformats its other args into the form used
  153.  * internally by tierra. the genotype must be in archive. n can be
  154.  * determined by find_gen(). currently no error checking
  155.  */
  156.  
  157. Pgl get_gen(fp, head, indxn, n)
  158.     FILE    *fp;
  159.     indx_t  *indxn;
  160.     head_t  *head;
  161.     I32s    n;
  162. {
  163.     Pgl  t = (Pgl) thcalloc(1, sizeof(struct g_list));
  164.  
  165.     fseek(fp, head->g_off +
  166.         (n * head->size * (sizeof(Instruction) + sizeof(GenBits))), 0);
  167.     t->genome = (HpInst) thcalloc(head->size, sizeof(Instruction));
  168.     t->gbits  = (HpGenB) thcalloc(head->size, sizeof(GenBits));
  169.     fread(t->genome, head->size * sizeof(Instruction), 1, fp);
  170.     fread(t->gbits,  head->size * sizeof(GenBits),     1, fp);
  171.     t->gen.size = head->size;
  172.     strncpy(t->gen.label, indxn->gen, 3);
  173.     t->parent.size = indxn->psize;
  174.     strncpy(t->parent.label, indxn->pgen, 3);
  175.     t->bits = indxn->bits;
  176.     t->d1 = indxn->d1;
  177.     t->d2 = indxn->d2;
  178.     t->originI = indxn->originI; t->originC = indxn->originC;
  179.     t->MaxPropPop = (float) indxn->mpp / 10000.;
  180.     t->MaxPropInst = (float) indxn->mpi / 10000.;
  181.     t->ploidy = (indxn->pt & 0360) >> 4;
  182.     t->track = indxn->pt & 017;
  183.     return t;
  184. }
  185.  
  186. /*
  187.  * add_gen - replace or add a genotype to end of genebank archive
  188.  *
  189.  *     fp - pointer to open archive file
  190.  *     head - header of archive
  191.  *     indx - index of archive
  192.  *     gen - genotype to be added
  193.  *
  194.  * reformats the genotype and replaces it in the archive, or adds it to
  195.  * the end if not found. args head & indx are modified by this fn.
  196.  * returns 0 on add, and 1 on replace.
  197.  */
  198.  
  199. I32s add_gen(fp, head, indx, gen)
  200.     FILE *fp;
  201.     head_t *head;
  202.     indx_t **indx;
  203.     Pgl    gen;
  204. {
  205.     Instruction *buf;
  206.     int n, s;
  207.  
  208.     n = find_gen(*indx, gen->gen.label, head->n);
  209.     if (n == head->n && head->n == head->n_alloc) {
  210.     head->n_alloc += 1024 / sizeof(indx_t);
  211.     *indx = (indx_t *) threalloc(*indx, head->n_alloc * sizeof(indx_t));
  212.     fseek(fp, head->g_off, 0);
  213.     buf = (Instruction *) thcalloc(s = head->size * head->n *
  214.             sizeof(Instruction), 1);
  215.     fread(buf, s, 1, fp);
  216.     fseek(fp, head->g_off=sizeof(head_t)+head->n_alloc*sizeof(indx_t), 0);
  217.     fwrite(buf, s, 1, fp);
  218.     thfree(buf);
  219.     }
  220.     fseek(fp, head->g_off +
  221.         (n * head->size * (sizeof(Instruction) + sizeof(GenBits))), 0);
  222.     fwrite(gen->genome, head->size * sizeof(Instruction), 1, fp);
  223.     fwrite(gen->gbits,  head->size * sizeof(GenBits),     1, fp);
  224.     strncpy((*indx)[n].gen, gen->gen.label, 3);
  225.     (*indx)[n].psize = gen->parent.size;
  226.     strncpy((*indx)[n].pgen, gen->parent.label, 3);
  227.     (*indx)[n].bits = gen->bits;
  228.     (*indx)[n].d1 = gen->d1;
  229.     (*indx)[n].d2 = gen->d2;
  230.     (*indx)[n].originI = gen->originI;
  231.     (*indx)[n].originC = gen->originC;
  232.     (*indx)[n].mpp = (short) (gen->MaxPropPop * 10000);
  233.     (*indx)[n].mpi = (short) (gen->MaxPropInst * 10000);
  234.     (*indx)[n].pt = (gen->ploidy << 4) + gen->track;
  235.     head->n += n = n == head->n;
  236.     write_head(fp, head);
  237.     write_indx(fp, head, *indx);
  238.     return !n;
  239. }
  240.  
  241.  
  242. /***** todo:
  243.     combine & fix getasc?gen, writasc?file
  244.     ?? replace getgen?format, writ?genfile w/ getgen, addgen in tierra
  245. *****/
  246.  
  247. I16s GetAscGen(g, ifile)
  248.     Pgl  g;
  249.     I8s  ifile[];
  250. {
  251.     I8s   bit[4], chm[4], buf[81], *data, inst[9], *inst2;
  252.     I16s  t1, BufSiz = 512, ComSiz = 0, format;
  253.     I32u  sl = 0, sln;
  254.     I32s  j, k, p, a = 0, b = 0, sc = 1;
  255.     I8u   ti, *s, *t;
  256.     FILE  *inf;
  257.  
  258.     inf = fopen(ifile,"r");
  259.     if(inf == NULL)
  260.     {   sprintf(mes[0],"GetAscGen: file %s not opened, exiting");
  261.         FEMessage(1);
  262.         while(hangup) ;
  263.         exit(0);
  264.     }
  265.     data = (I8s  *) thcalloc(85, sizeof(I8s));
  266.     g->ploidy = (I8s) 1; /* default ploidy */
  267.     fgets(data,84,inf);                                    /* blank line */
  268.     while(1)
  269.     {   fgets(data,84,inf);
  270.         if(strlen(data) < 3) break; /* get a blank line and break */
  271.         sscanf(data,"%s", buf);
  272.         if(!strcmp(buf,"format:"))
  273.         {   sscanf(data,"%*s%hd%*s%lu", &format, &g->bits); continue; }
  274.         if(!strcmp(buf,"genotype:"))
  275.     {   sscanf(data,"%*s%ld%s%*s%*s%ld%s", &g->gen.size,
  276.                 g->gen.label, &g->parent.size, g->parent.label);
  277.             continue;
  278.         }
  279.         if(!strcmp(buf,"1st_daughter:"))
  280.     {   sscanf(data,"%*s%*s%ld%*s%ld%*s%ld%*s%hd",
  281.                 &g->d1.flags, &g->d1.inst, &g->d1.mov_daught, &t1);
  282.             g->d1.BreedTrue = t1;
  283.             continue;
  284.         }
  285.         if(!strcmp(buf,"2nd_daughter:"))
  286.     {   sscanf(data,"%*s%*s%ld%*s%ld%*s%ld%*s%hd",
  287.                 &g->d2.flags, &g->d2.inst, &g->d2.mov_daught, &t1);
  288.             g->d2.BreedTrue = t1;
  289.             continue;
  290.         }
  291.         if(!strcmp(buf,"InstExe.m:"))
  292.     {   sscanf(data,"%*s%ld%*s%ld%*s%ld",
  293.                 &g->originI.m, &g->originI.i, &g->originC);
  294.             continue;
  295.         }
  296.         if(!strcmp(buf,"MaxPropPop:"))
  297.     {   sscanf(data,"%*s%f%*s%f", &g->MaxPropPop, &g->MaxPropInst);
  298.             continue;
  299.         }
  300.         if(!strcmp(buf,"ploidy:"))
  301.     {   sscanf(data,"%*s%ld%*s%ld", &j, &k);
  302.             g->ploidy = (I8s) j; g->track = (I8s) k;
  303.             continue;
  304.         }
  305.         if(!strcmp(buf,"comments:"))
  306.         {
  307. #ifdef COMMENTS
  308.         g->comments = (I8s  Fp) thcalloc(BufSiz, sizeof(I8s));
  309.             ComSiz = sl = strlen(data + 9);
  310.             while(ComSiz > BufSiz) {
  311.         BufSiz += 512;
  312.                 g->comments = (I8s  Fp) threalloc(g->comments, BufSiz);
  313.             }
  314.             strcpy(g->comments,data + 9);
  315. #endif
  316. /*  TOM UFFNER: sl has not been initialized! */
  317.             while(sl > 1) {
  318.         fgets(data,84,inf);
  319.                 sln = strlen(data);
  320. #ifdef COMMENTS
  321.                 while(ComSiz + sln > BufSiz) {
  322.             BufSiz += 512;
  323.                     g->comments = (I8s  Fp) threalloc(g->comments, BufSiz);
  324.                 }
  325.                 strcpy(g->comments + ComSiz, data);
  326.                 ComSiz += sln;
  327. #endif
  328.                 sl = sln;
  329.             }
  330. #ifdef COMMENTS
  331.             sl = strlen(g->comments);
  332.             g->comments = (I8s  Fp) threalloc(g->comments, sl + 1);
  333. #endif
  334.             break;
  335.         }
  336.     }
  337.     g->genome = (HpInst) thcalloc(g->gen.size, sizeof(Instruction));
  338.     g->gbits  = (HpGenB) thcalloc(g->gen.size, sizeof(GenBits));
  339.     for(p = 0; p < PLOIDY; p++)
  340.     {   if (p) fgets(data,84,inf);
  341.         fgets(data,84,inf);   fgets(data,84,inf);
  342.         for(j = 0; j < g->gen.size; j++)
  343.         {   fgets(data,84,inf); sl = sscanf(data,"%s%*s%s%s", inst, chm, bit);
  344.             if(sl > 1 && strlen(chm) == 3)
  345.             {   g->genome[j][p].read  = chm[2] - '0';
  346.                 g->genome[j][p].write = chm[1] - '0';
  347.                 g->genome[j][p].exec  = chm[0] - '0';
  348.             }
  349.             if(sl > 2 && strlen(bit) == 3)
  350.             {   if(bit[0] - '0')
  351.                     g->gbits[j][p] |= (I8s) 1;
  352.                 if(bit[1] - '0')
  353.                     g->gbits[j][p] |= (I8s) (1 << 1);
  354.                 if(bit[2] - '0')
  355.                     g->gbits[j][p] |= (I8s) (1 << 2);
  356.             }
  357.             for(k = 0; k < INSTNUM; k++)
  358.             {   if(!strcmp(inst,aid[k].mn))
  359.             {   ti = aid[k].op;
  360.                     break;
  361.                 }
  362.             }
  363.             if(k == INSTNUM)
  364.             {   sprintf(mes[0],"mnemonic %s not recognized", inst);
  365.                 FEMessage(1);
  366.                 ti = 0;
  367.             }
  368.             g->genome[j][p].inst = ti;
  369.         }
  370.     }
  371.     fclose(inf);
  372. #ifdef IBM3090
  373.     Ebcdic2Ascii(g->gen.label); Ebcdic2Ascii(g->parent.label);
  374.     if(g->comments) Ebcdic2Ascii(g->comments);
  375. #endif
  376.     return 1;
  377. }
  378.  
  379. void WritAscFile(g, file)
  380.     Pgl   g;
  381.     I8s   *file;
  382. {
  383.     I8s   bit[4], chm[4];
  384.     I16s  t1;
  385.     I16u  di, t, j;
  386.     I8s  format = INST;
  387.     long int  tp;
  388.     FILE *fp;
  389. #ifdef IBM3090
  390.     I8s  lbl[4], plbl[4], *comnts;
  391. #endif
  392.  
  393.     if (!strcmp(file, "-")) fp = stdout;
  394.     else if (!(fp = fopen(file, "w")))
  395.     {   perror("WritAscFile");
  396.     exit(1);
  397.     }
  398.     fprintf(fp, "\nformat: %hd  bits: %lu  ", format, g->bits);
  399.     WritEcoF(g->bits, fp);
  400. #ifdef IBM3090
  401.     strcpy(lbl,g->gen.label); strcpy(plbl,g->parent.label);
  402.     Ascii2Ebcdic(lbl); Ascii2Ebcdic(plbl);
  403.     fprintf(fp, "genotype: %04ld%s  parent genotype: %04ld%s\n",
  404.         g->gen.size, lbl, g->parent.size, plbl);
  405. #else
  406.     fprintf(fp, "genotype: %04ld%s  parent genotype: %04ld%s\n",
  407.         g->gen.size, g->gen.label, g->parent.size, g->parent.label);
  408. #endif
  409.     t1 = g->d1.BreedTrue;
  410.     fprintf(fp, "1st_daughter:  flags: %ld  inst: %ld  mov_daught: %ld  \
  411.         breed_true: %hd\n", g->d1.flags, g->d1.inst, g->d1.mov_daught, t1);
  412.     t1 = g->d2.BreedTrue;
  413.     fprintf(fp, "2nd_daughter:  flags: %ld  inst: %ld  mov_daught: %ld  \
  414.         breed_true: %hd\n", g->d2.flags, g->d2.inst, g->d2.mov_daught, t1);
  415.     tp = g->originC;
  416.     fprintf(fp, "InstExe.m: %ld  InstExe.i: %ld  origin: %ld  %s",
  417.         g->originI.m, g->originI.i, g->originC, ctime(&tp));
  418.     fprintf(fp, "MaxPropPop: %g  MaxPropInst: %g\n", g->MaxPropPop,
  419.         g->MaxPropInst);
  420.     fprintf(fp, "ploidy: %ld  track: %ld\n", (I32s) g->ploidy,
  421.         (I32s) g->track);
  422. #ifdef COMMENTS
  423.     if(g->comments) {
  424. #ifdef IBM3090
  425.         t = strlen(g->comments);
  426.         comnts = (I8s  *) thcalloc(t + 1, sizeof(I8s));
  427.         strcpy(comnts,g->comments);
  428.         Ascii2Ebcdic(comnts);
  429.         fprintf(fp, "comments:%s", comnts);
  430.         thfree(comnts);
  431. #else
  432.         fprintf(fp, "comments:%s", g->comments);
  433. #endif
  434.     }
  435.     else
  436. #endif
  437.     fprintf(fp, "\n");
  438.     chm[3] = bit[3] = 0;
  439.     for (j = 0; j < PLOIDY; j++)
  440.     {   if(j) fprintf(fp,"\n");
  441.         fprintf(fp, "track %ld: prot\n          xwr\n", j);
  442.         for (t = 0; t < g->gen.size; t++)
  443.         {   di = g->genome[t][j].inst;
  444.             bit[0] = IsBit(g->gbits[t][j],0) ? '1' : '0';
  445.             bit[1] = IsBit(g->gbits[t][j],1) ? '1' : '0';
  446.             bit[2] = IsBit(g->gbits[t][j],2) ? '1' : '0';
  447.             chm[0] = '0' + g->genome[t][j].exec;
  448.             chm[1] = '0' + g->genome[t][j].write;
  449.             chm[2] = '0' + g->genome[t][j].read;
  450.         fprintf(fp,"%-8s; %s %s %02x %3u\n", aid[di].mn, chm, bit, di, t);
  451.         }
  452.     }
  453. }
  454.  
  455. /*
  456.  * WritGenFile - write old style genebank file
  457.  *
  458.  *     replaces Writ1GenFile and Writ2GenFile...
  459.  * warning: this function is obsolescent. use only to verify that the new
  460.  * archive format works correctly.
  461.  */
  462.  
  463. void WritGenFile(g, file)
  464.     Pgl  g;
  465.     I8s  file[];
  466. {
  467.     FILE  *ouf;
  468.     I16s  prop;
  469.     I8s   format = INST;
  470.  
  471.     ouf = fopen(file,"wb");
  472.     if(ouf == NULL)
  473.     {   sprintf(mes[0],"WritGenFile: file %s not opened, exiting", file);
  474.         FEMessage(1);
  475.         while(hangup) ;
  476.         exit(0);
  477.     }
  478.     fwrite(&format,          sizeof(I8s),               1, ouf);
  479.     fwrite(&g->bits,    sizeof(I32u),              1, ouf);
  480.     fwrite(&g->gen,     sizeof(struct genotype),   1, ouf);
  481.     fwrite(&g->parent,  sizeof(struct genotype),   1, ouf);
  482.     fwrite(&g->d1,      sizeof(struct metabolism), 1, ouf);
  483.     fwrite(&g->d2,      sizeof(struct metabolism), 1, ouf);
  484.     fwrite(&g->originI, sizeof(struct event),      1, ouf);
  485.     fwrite(&g->originC, sizeof(I32s),              1, ouf);
  486.     prop = (I16s) 10000 * g->MaxPropPop;
  487.     fwrite(&prop,       sizeof(I16s),              1, ouf);
  488.     prop = (I16s) 10000 * g->MaxPropInst;
  489.     fwrite(&prop,       sizeof(I16s),              1, ouf);
  490. #ifdef COMMENTS
  491.     if (g->comments == NULL)
  492. #endif
  493.     fwrite("\012\0", sizeof(I8s), 2, ouf); /* "\n", ebcdic compatible */
  494. #ifdef COMMENTS
  495.     else {
  496.     s = strlen(g->comments) + 1;
  497.         fwrite(g->comments, sizeof(I8s),           s, ouf);
  498.     }
  499. #endif
  500. #if INST > 1
  501.     fwrite(&g->ploidy,  sizeof(I8s),               1, ouf);
  502.     fwrite(&g->track,   sizeof(I8s),               1, ouf);
  503. #endif
  504.     fwrite(g->genome, sizeof(Instruction), g->gen.size, ouf);
  505.     fwrite(g->gbits,  sizeof(GenBits),     g->gen.size, ouf);
  506.     fclose(ouf);
  507. }
  508.  
  509. /*
  510.  * GetGenFormat - read old style genebank file
  511.  *
  512.  *     replaces GetGen1Format and GetGen2Format...
  513.  * warning: this function is obsolescent. use only to verify that the new
  514.  * archive format works correctly.
  515.  */
  516.  
  517. I16s GetGenFormat(g,file)
  518.     Pgl  g;
  519.     I8s  file[];
  520. {  
  521.     FILE  *inf;
  522.     I8s   c = 1, format;
  523.     I16s  prop;
  524.     I32s  t = 0, bufsiz = 512;
  525.  
  526.     inf = fopen(file,"rb");
  527.     fread(&format,     sizeof(I8s),               1, inf);
  528.     fread(&g->bits,    sizeof(I32u),              1, inf);
  529.     fread(&g->gen,     sizeof(struct genotype),   1, inf);
  530.     fread(&g->parent,  sizeof(struct genotype),   1, inf);
  531.     fread(&g->d1,      sizeof(struct metabolism), 1, inf);
  532.     fread(&g->d2,      sizeof(struct metabolism), 1, inf);
  533.     fread(&g->originI, sizeof(struct event),      1, inf);
  534.     fread(&g->originC, sizeof(I32s),              1, inf);
  535.     fread(&prop,       sizeof(I16s),              1, inf);
  536.     g->MaxPropPop  = (float) prop / 10000.;
  537.     fread(&prop,       sizeof(I16s),              1, inf);
  538.     g->MaxPropInst = (float) prop / 10000.;
  539.     g->comments = (I8s *) thcalloc(bufsiz,sizeof(I8s));
  540.     do {
  541.     c = getc(inf);
  542.         g->comments[t++] = c;
  543.         if (t >= bufsiz) {
  544.         bufsiz += 512;
  545.             g->comments = (I8s *) threalloc(g->comments,bufsiz);
  546.         }
  547.     }
  548.     while(c);
  549.     if(g->comments[0] == 10 && g->comments[1] == 0) {  
  550.     thfree(g->comments);
  551.         g->comments = NULL;
  552.     }
  553.     else g->comments = (I8s  *) threalloc(g->comments,t);
  554. #ifndef COMMENTS
  555.     thfree(g->comments);
  556.     g->comments = NULL;
  557. #endif
  558. #if INST > 1
  559.     fread(&g->ploidy,  sizeof(I8s), 1, inf);
  560.     fread(&g->track,   sizeof(I8s), 1, inf);
  561. #endif
  562.     g->genome = (HpInst) thcalloc(g->gen.size,sizeof(Instruction));
  563.     fread(g->genome, sizeof(Instruction), g->gen.size, inf);
  564.     fclose(inf);
  565.     return (I16s) format;
  566. }
  567.  
  568. #ifdef IBM3090
  569. static unsigned char a2e[] = {
  570. 0000,0001,0002,0003,0067,0055,0056,0057,0026,0005,0045,0013,0014,0015,0016,
  571. 0017,0020,0021,0022,0023,0074,0075,0062,0046,0030,0031,0077,0047,0034,0035,
  572. 0036,0037,0100,0117,0177,0173,0133,0154,0120,0175,0115,0135,0134,0116,0153,
  573. 0140,0113,0141,0360,0361,0362,0363,0364,0365,0366,0367,0370,0371,0172,0136,
  574. 0114,0176,0156,0157,0174,0301,0302,0303,0304,0305,0306,0307,0310,0311,0321,
  575. 0322,0323,0324,0325,0326,0327,0330,0331,0342,0343,0344,0345,0346,0347,0350,
  576. 0351,0112,0340,0132,0137,0155,0171,0201,0202,0203,0204,0205,0206,0207,0210,
  577. 0211,0221,0222,0223,0224,0225,0226,0227,0230,0231,0242,0243,0244,0245,0246,
  578. 0247,0250,0251,0300,0152,0320,0241,0007,0040,0041,0042,0043,0044,0025,0006,
  579. 0027,0050,0051,0052,0053,0054,0011,0012,0033,0060,0061,0032,0063,0064,0065,
  580. 0066,0010,0070,0071,0072,0073,0004,0024,0076,0341,0101,0102,0103,0104,0105,
  581. 0106,0107,0110,0111,0121,0122,0123,0124,0125,0126,0127,0130,0131,0142,0143,
  582. 0144,0145,0146,0147,0150,0151,0160,0161,0162,0163,0164,0165,0166,0167,0170,
  583. 0200,0212,0213,0214,0215,0216,0217,0220,0232,0233,0234,0235,0236,0237,0240,
  584. 0252,0253,0254,0255,0256,0257,0260,0261,0262,0263,0264,0265,0266,0267,0270,
  585. 0271,0272,0273,0274,0275,0276,0277,0312,0313,0314,0315,0316,0317,0332,0333,
  586. 0334,0335,0336,0337,0352,0353,0354,0355,0356,0357,0372,0373,0374,0375,0376,
  587. 0377 };
  588.  
  589. static unsigned char e2a[] = {
  590. 0000,0001,0002,0003,0234,0011,0206,0177,0227,0215,0216,0013,0014,0015,0016,
  591. 0017,0020,0021,0022,0023,0235,0205,0010,0207,0030,0031,0222,0217,0034,0035,
  592. 0036,0037,0200,0201,0202,0203,0204,0012,0027,0033,0210,0211,0212,0213,0214,
  593. 0005,0006,0007,0220,0221,0026,0223,0224,0225,0226,0004,0230,0231,0232,0233,
  594. 0024,0025,0236,0032,0040,0240,0241,0242,0243,0244,0245,0246,0247,0250,0133,
  595. 0056,0074,0050,0053,0041,0046,0251,0252,0253,0254,0255,0256,0257,0260,0261,
  596. 0135,0044,0052,0051,0073,0136,0055,0057,0262,0263,0264,0265,0266,0267,0270,
  597. 0271,0174,0054,0045,0137,0076,0077,0272,0273,0274,0275,0276,0277,0300,0301,
  598. 0302,0140,0072,0043,0100,0047,0075,0042,0303,0141,0142,0143,0144,0145,0146,
  599. 0147,0150,0151,0304,0305,0306,0307,0310,0311,0312,0152,0153,0154,0155,0156,
  600. 0157,0160,0161,0162,0313,0314,0315,0316,0317,0320,0321,0176,0163,0164,0165,
  601. 0166,0167,0170,0171,0172,0322,0323,0324,0325,0326,0327,0330,0331,0332,0333,
  602. 0334,0335,0336,0337,0340,0341,0342,0343,0344,0345,0346,0347,0173,0101,0102,
  603. 0103,0104,0105,0106,0107,0110,0111,0350,0351,0352,0353,0354,0355,0175,0112,
  604. 0113,0114,0115,0116,0117,0120,0121,0122,0356,0357,0360,0361,0362,0363,0134,
  605. 0237,0123,0124,0125,0126,0127,0130,0131,0132,0364,0365,0366,0367,0370,0371,
  606. 0060,0061,0062,0063,0064,0065,0066,0067,0070,0071,0372,0373,0374,0375,0376,
  607. 0377 };
  608.  
  609. Ascii2Ebcdic(s) char *s; { while (*s = a2e[*s]) s++; }
  610. Ebcdic2Ascii(s) char *s; { while (*s = e2a[*s]) s++; }
  611. #endif
  612.  
  613. void WritEcoF(bits, ouf)
  614.     I32u  bits;
  615.     FILE  *ouf;
  616. {  
  617.     static char s[6], *t[] = { "EX", " TC", " TP", " MF", " MT", " MB" };
  618.     int i, j;
  619.  
  620.     for (i=0,j=0; i<6; i++,j=0) {
  621.     if (IsBit(bits, 5 * i + 2)) s[j++] = 's';
  622.     if (IsBit(bits, 5 * i + 3)) s[j++] = 'd';
  623.     if (IsBit(bits, 5 * i + 4)) s[j++] = 'o';
  624.     if (IsBit(bits, 5 * i + 5)) s[j++] = 'f';
  625.     if (IsBit(bits, 5 * i + 6)) s[j++] = 'h';
  626.     s[j] = 0;
  627.     fprintf(ouf,"%s%s", t[i], s);
  628.     }
  629.     fprintf(ouf,"\n");
  630. }
  631.  
  632. void SetBit(seed, bit, value)
  633. I32u  *seed, bit, value;
  634. {   if(value)
  635.         (*seed) |= (1 << bit);
  636.     else
  637.         (*seed) &= (~(1 << bit));
  638. }
  639.