#!/opt/sol2/bin/perl -s
#
# My first perl file, for taking the output of the DDL parser and creating
# a Lexer/Parser for a CIF file.  The first section of the program creates
# the Lexer, with each data name that should be recognised getting a separate
# token name.  Simultaneously, the type of each of these tokens is written
# to the bison file.  A second pass through the DDL parser output sets up
# variable names and the various actions when inside and outside a loop.
#
# Execution: ddlperl.perl -e -f <ddlversion> <dicfile name>
#

# First we create our own input file
# We assume that the ddlparser is already in existence somewhere
#
if($#ARGV < 1) {                     #not enough
    die "Error: Use as follows - ddlperl -e -f <dicfile name> <DDL version>\nOptions: -e\t include esds\n         -f\t fortran compatible\n";}
if($ARGV[1]>2 | $ARGV[1]<1) {        #Funny ddl specification
    die "Improper DDL specification (1 or 2)\n";}
if(! -e $ARGV[0]) {                  #No file exists
    die "Dictionary file $ARGV[0] not found\n";}
$ddlparser = join("",'ddl',$ARGV[1],'parse ',$ARGV[0],' > ','ddlout');
if ($e) { $useesds = 'yes';} else {$useesds = 'no';}
if ($f) { $usefort = 'yes';} else {$usefort = 'no';}
print "Fortran: $usefort  Esds: $useesds\n";

system $ddlparser;
#
#First output the top portion of the Lex file
open(PERL_LEX, ">cifsiv.lex") or die "Can't create cifsiv.lex file\n";
print PERL_LEX <<'ENDOFBEGIN';
%{
  /* A test lexical analyser for a CIF file 
  /* This is a prototype of a scanner that is automatically
     produced by Perl */
#include <stdio.h>
#include <string.h>
#include <math.h>
#include <stdlib.h>
#include "cifsiv.tab.h"
extern char blockname[80];
  char nosdnum[80];
  char *sdbeg;
  int firstpt,secondpt,dp;  /* variables for getting standard deviation */
%}

%x inputtext ourblock
%option nomain
%option noyywrap

DNUM -?(([0-9]+)|([0-9]*[.][0-9]+))([(][0-9]+[)])?([eE][+-]?[0-9]+)?
INUM [+\-]*[[:digit:]]+
CHARS [<>a-zA-Z!~`@#$%^&_|\\:;,\.]

%%
<*>"data_"[[:graph:]]+    {if(strncmp(yytext,blockname,strlen(blockname))==0) 
                           /* is our block */
                          BEGIN(ourblock);
                          else BEGIN(INITIAL);}
<ourblock>^;             BEGIN(inputtext);
<inputtext>^;            {BEGIN(ourblock); return(DATASTRING);}/* finished text */
<inputtext>.*                {strncpy(yylval.item,yytext,80); 
                                   yylval.item[80] = 0x00;} /* save this */
<inputtext>\n/[^;]       /* do nothing */      
<ourblock>"#".*$             /* do nothing (comment) */
<ourblock>"loop_"         return(LOOP);
ENDOFBEGIN
open(PERL_BISON,">grammar.top") or die "Can't open file grammar.top\n";
#
#  Make some preliminary definitions for error handling
#
# write bison header
#
print PERL_BISON <<"BISON HEADER 1";
/* A grammar file for parsing of a DDL file; incomplete, designed simply
to extract cifnames and variables.  This file is a prototype for an
automatically created file */
%{
#define CIFVARDEC        /* define variables in this file */
#include <stdio.h>
#include <math.h>
#include "cifvars.h"
BISON HEADER 1
if($usefort eq 'yes') {
print PERL_BISON ("#define errornum cifcmnptr->errornum\n");
print PERL_BISON ("#define errormes cifcmnptr->errormes\n");
}
print PERL_BISON <<"END BISON HEADER";
/* external function for printing errors */

extern int yylex(void);
int yyerror(char *errmes);

/* local variables */
struct {
void * location;
void * esdlocation; /* if there is any attached esd */
int size;
int maxentries;
int checktype;      /* for checking data type */
} attdata[100];     /* information on each loop item */

int noinloop = 0;
int looppos = 0;
double * doubleptr;
int packets = 0;        /* count the packets */
char junk[81];      /* for storing unknown datatypes */
char safestr[40];   /* for controlling size of error message */
char recentitem[40]; /* latest item, for error messages */
%}

/* Bison declarations */
%union{
int flag;         /* for flagging type of loop blocks */
char item[81];         /* for single items */
double number[2]; /* including esd */
}

%token <item> ITEMNAME     /* a cif item */
%token <item> LOOP         /* start looping */
%token <item> ITEMVALUE    /* the value for the item */
%token <item> ITEMDEF      /* data block name */
%token <item> VARNAME      /* variable name in final program */
%token <item> VARTYPE      /* type of variable */
%token <item> NAME         /* name of unknown cif item follows*/ 
%token <item> UNKATTR      /* an unknown attribute name */
%token <item> DATASTRING   /* a string of data */
%token <item> QUESTION     /* a question mark */
%token <number> DNUM       /* a number */
END BISON HEADER
#
# Now start reading in names
#
open(DDLOUT, "ddlout") or die "Can't find DDL parser output\n";
while(<DDLOUT>) {
  s/'//g ; s/\n/ / ;           #remove inverted commas and newlines
  @items = split(/[ ]+/);      #make a string
  if($items[0] eq 'NAME')
    {
    $symname = uc(@items[1]); 
    $symname =~ s/(\[)([0-9a-zA-Z])(\])/$2/g; #No square brackets in bison
    $symname =~ s/\./_/g;                     #Avoid dots just in case
    print(PERL_LEX ("<ourblock>\"",@items[1],"\" {strncpy(yylval.item, yytext, 80);"));
    print(PERL_LEX ("\n                        return C", $symname,";}\n"));
    print(PERL_BISON ('%token <item> C',$symname, ' /* Automatically created */',"\n"));
    }
  if($items[0] eq 'ALIAS')     #recognise alias as well
    {
     print(PERL_LEX ("<ourblock>\"",@items[1],"\" {strncpy(yylval.item, yytext, 80);"));
     print(PERL_LEX ("\n                   return C", $symname,";}\n"));
    #the above line assumes that aliases always follow names.  Also implicit
    #is that they occur only in DDL2 files, where names are not looped
    }
  if($items[0] eq 'Error!')    #a parsing error
    {
    print "Error in dictionary file: last successful item $symname\n";
    }
}

# Now write out tail end of Lex file

print PERL_LEX <<'ENDOFFILE';
<ourblock>"_"[[:graph:]]+  {strncpy(yylval.item,yytext,80);/* for debugging */
                                    yylval.item[79] = 0x00;
                                    return NAME;} 
<ourblock>"'".*"'"        {firstpt = strcspn(yytext+1,"'");
                           strncpy(yylval.item, yytext+1, firstpt);
                           yylval.item[firstpt] = 0x00;
                           return DATASTRING;}
<ourblock>{DNUM}          { /* we need to extract standard deviations before
                            converting */
                           if((sdbeg = strchr(yytext,'('))==NULL)
                           {
                              yylval.number[0] = strtod(yytext,NULL); 
                              yylval.number[1] = -1;
                              return DNUM;
                            }
                           else
                           {
                              firstpt = strcspn(yytext,"()");
                              secondpt = strcspn(sdbeg,")");
                              strncpy(nosdnum, yytext,firstpt);
                              nosdnum[firstpt]= 0x00;  /* terminate string*/
                              strcat(nosdnum, sdbeg+secondpt+1);
                              yylval.number[0] = strtod(nosdnum, NULL);
                              yylval.number[1] = strtod(sdbeg+1, NULL);
                              /* get esd in proper scale */
                              if((dp = strcspn(yytext,".("))<firstpt-1) /*has dpt */
                              {
                                yylval.number[1] = yylval.number[1] * pow(10,(double)(dp-firstpt+1));
                              }
                              yylval.number[1] = yylval.number[1] * (yylval.number[0]/strtod(yytext,NULL));  /* account for exponent */
                              return DNUM;
                           }
                       }
<ourblock>"?"             {return QUESTION;}
<ourblock>[^[:space:]]+   {strncpy(yylval.item, yytext,80);
                           yylval.item[80] = 0x00;
                           return DATASTRING;}
<*>[[:space:]]+           /* do nothing */
ENDOFFILE

close(PERL_LEX);    # We have created the Lexer.  Now we focus on the parser.
print('Cif file lexical analyser created...');
##########################################
# Write out high level grammar rules     #
##########################################
print PERL_BISON <<'HIGHLEVELGRAMMAREND';

%type <item> input attributeassoc loopblock keyvaluepair
%type <item> anattribute looptop loopbottom 
%type <number> anumber
%%

/* Grammar rules */
input:  attributeassoc      /* file is sequence of lists of associations */
        | input attributeassoc    
        ;    

attributeassoc: keyvaluepair
                {
                strncpy(recentitem,$1,40); recentitem[39]=0x00;
                }
	       | loopblock
                {
                strncpy(recentitem,$1,40); recentitem[39]=0x00;
                }
               | error
                {
                if(errornum == 0)    /* no other messages */
                  {
                   errornum = 5;
                   sprintf(errormes, "Parse error: latest item name %s\n",recentitem);
                   }
                }
             ;

loopblock: LOOP looptop loopbottom
         {
         if(looppos!=0 && errornum == 0) {   /* loop mismatch */
         strncpy(safestr, $2, 40);
         sprintf(errormes, "Looped item miscount: %s, packets %d\n",safestr,packets);
         errornum = 1;  /* continue on anyway */
         }       
	 /* set everything back to zero */
	 noinloop = 0; looppos = 0; packets = 0;
	 }
         | LOOP looptop error         /* no values */
         {
         if(errornum == 0)
              {
              strncpy(safestr, $2, 40);
              sprintf(errormes, "No loop values: %s\n",safestr);
              errornum = 1;
              }
         }
	 ;

looptop: anattribute
         {
	     strncpy($$,$1,80);  /* store for later */
             $$[80] = 0x00;  /* terminate correctly */
             /* first time through; initialise */
	     noinloop = 1;
	 }
         | looptop anattribute
	 {
	     noinloop++;
	 }
         ;

loopbottom: loopvalue
         {
	   attdata[looppos].location += attdata[looppos].size;/* for next time*/
	   attdata[looppos].esdlocation += attdata[looppos].size;
           if(noinloop>1) looppos = 1;
           else packets = 1;
	 }
         | loopbottom loopvalue
         {
             attdata[looppos].location += attdata[looppos].size; /* next time*/
	     attdata[looppos].esdlocation += attdata[looppos].size;
	     looppos++; 
	     if(looppos==noinloop)
	     { 
                 if(packets>=attdata[looppos-1].maxentries)
		 {
		     yyerror("Out of variable range in loop\n");
                     return(-1);
		 }
		 looppos -= noinloop;
                 packets++;
	     }
	 }

loopvalue: DATASTRING
           {
           if(attdata[looppos].checktype != 1 &&
           attdata[looppos].checktype != 0) {
             if(errornum == 0) {
               strncpy(safestr,$1,40);
               sprintf(errormes, "String %s in loop instead of number.\n",safestr);
               errornum = 2;
               }
             }
             else {
               strncpy(attdata[looppos].location,$1,80); /* store the string */
             }
           }
           | anumber
           {
               if(attdata[looppos].checktype != 2 &&
               attdata[looppos].checktype != 0) {
                 if(errornum == 0) {
                   sprintf(errormes, "Number %f instead of string in loop.\n",$1[0]);
                   errornum = 3;
                 }
               } else {
               doubleptr = (double*) attdata[looppos].location;
               *doubleptr = $1[0];
HIGHLEVELGRAMMAREND
# Do we have esds?
if($useesds eq 'yes') {
print PERL_BISON<<'ESDBITEND';
             doubleptr = (double*) attdata[looppos].esdlocation;
             *doubleptr = $1[1];
ESDBITEND
}
print PERL_BISON<<'HLGEND';
             }
           }
           | QUESTION
           {
           }
           ;

anumber: DNUM
         ;

/* the following lines are automatically generated based on a search
of the specified dictionary file */

keyvaluepair: NAME DATASTRING      /* something we don't know about */
              {
/*              printf("%s + string %s\n",$1,$2); */
               strncpy($$,$1,40);  /* store for errors */
              }
              | NAME anumber
              {
/*              printf("%s + number %f\n",$1,$2[0]); */
               strncpy($$,$1,40);  /* store for errors */
              }
              | NAME QUESTION
              {
               strncpy($$,$1,40);  /* store for errors */
              }
HLGEND
###################################################################
#  Now we define the keyvaluepair rule and simultaneously a header#
#  file for the declarations
###################################################################
open(VARTOP, ">vartop") or die "Can't open header file\n";
open(VARMID, ">varmid") or die "Can't open header file\n";
open(VARBOT, ">varbot") or die "Can't open header file\n";
if($usefort eq 'yes') {
  open(FORVARTOP, ">forvar") or die "Can't open fortran header\n";
  open(FORVARBOT, ">forbot") or die "Can't open fortran header\n";
  print FORVARTOP <<'FORTRAN HEADER END';
C The following common block corresponds to a structure defined
C in the C header, which is written to by routine 'cifsiv'. 
C In order to correctly write to this common block, 'cifsiv'
C should be called with a *third* argument which will always be
C 'blockbeg'.
      REAL BLOCKBEG           
      CHARACTER*84  ERRORMES  
      INTEGER ERRORNUM        
FORTRAN HEADER END
  $comout = "      COMMON/CIFCMN/BLOCKBEG,ERRORMES,ERRORNUM,";
  print VARBOT ('    float blockbeg; /* dummy for fortran interface */',"\n");
  print VARBOT ('    cifstring errormes;/* error message */',"\n");
  print VARBOT ('    int errornum; /* error number */',"\n");
  }
print VARTOP <<'HEADER END';
/* These declarations have been automatically generated by the
cif file input/output function generator.  This file should be
included in any routines that call these functions */
typedef char cifstring[84];   /* to avoid array complications later */
HEADER END
#
# We also open a temporary file which will be appended later
#
open(LOOPTEMP, ">grammar.bot") or die "Can't make temporary file\n";
open(DDLOUT, "ddlout") or die "Nani kore?? can't open ddlout\n";
@names = ();
$varname = '';
$vartype = 0;
$vardec = 0;
$tokentype = 0;
while(<DDLOUT>)
{
  s/'//g ; s/\n/ / ;           #remove inverted commas and newlines
  @items = split(/[ ]+/);      #make a string
  if (@items[0] eq 'NAME')
    {
    $symname = uc(@items[1]); 
    $symname =~ s/(\[)([0-9a-zA-Z])(\])/$2/g; #No square brackets in bison
    $symname =~ s/\./_/g; # Avoid dots too
    @names = (@names, uc(join('',"C",$symname)));
    }
  if(@items[0] eq 'TYPE')
    {
    $vartype = @items[1];
    $forvartype = @items[2];
    if (@items[1] eq 'cifstring') {
       $tokentype = 'DATASTRING'; $checktype = 1;
       }
    else {
       $tokentype = 'anumber';
       $checktype = 2;
       }
    }
  if(@items[0] eq 'VAR')
    {
    $varname = @items[1];
    }
  if(@items[0] eq 'ENDITEM')# have to output what we know
    {
###########################################################
#   Output data to variable declarations and grammar files#
###########################################################
#   If we have an array, we define a type for this array so that later on,
#   we can cast a pointer to this type.
#
    $arrayflag = 0;
    $_ = $varname;
     if(s/(.+)(\[)([0-9]+)(\])/$1/)         # Have an array
      { $arrayhead = $_;                    # Save the name
        $arraysize = $3;                    # Save the size
        $arrayflag = 1;
        $definer = join('',uc($arrayhead),"MAX "); #define
         print VARTOP 
         ("#define $definer $arraysize \n");# define array max size
        $esdname = join('',"$arrayhead",'esd','[',"$arraysize",']');
      }
      else
      {
        $esdname = join('',$varname,'esd');
      }
    if($#names > 0)                         # need to have an array
      {
      if($arrayflag == 1)                   # a multi--dimensional array
        {
         print VARTOP 
         ("typedef $vartype $arrayhead","type ",'[',$#names+1,'];',"\n");
         $vartype = join('',"$arrayhead","type");
         $vardec = "$vartype $varname";
         $esddec = "$vartype $esdname";
         $numinarray = $#names + 1;
        } 
      else               #not a user--defined array
        {
        $vardec = join('',"$vartype $varname [",$#names+1,"]");#array dim
        $esddec = join('',"$vartype $esdname [",$#names+1,"]");
        $numinarray = $#names + 1;
        }
      }
    else                 #not an array of names
      {
      $vardec = "$vartype $varname";
      $esddec = "$vartype $esdname";
      }
#
#   Now we output the variable declaration
#
    if($usefort eq 'yes') {
      print VARBOT ("    $vardec; ",'/*',"@items[2]",'*/',"\n");
      $_ = $varname; $foresdname = $esdname;
      if($numinarray > 0) {
      if($arrayflag == 1) {
        s/(.+)(\[)([0-9]+)(\])/$1($numinarray,$3)/;
        $foresdname =~ s/(.+)(\[)([0-9]+)(\])/$1($numinarray,$3)/;
      }
      else {
        $_ = join('',$_,'(',$numinarray,')');
        $foresdname = join('',$foresdname,'(',$numinarray,')');
      }        
      }
      s/\[/(/g; s/\]/)/g;
      $foresdname =~ s/\[/(/g; $foresdname =~ s/\]/)/g;
      print FORVARTOP ("      $forvartype $_ \n");
      s/(.+)(\(.*\))/$1/;
      $comnew = join('',$comout,$_,',');
      if(length($comnew) > 70) {  # time to output
        print FORVARBOT ("$comout\n");
        $comout = join('',"     *",$_,',');
        }
        else {
        $comout = $comnew;
        }
      }
    else {
      print VARMID ("$vardec; ",'/*',"@items[2]",'*/',"\n");
      print VARBOT ("extern $vardec; ",'/*',"@items[2]",'*/',"\n");
      }
    if($useesds eq 'yes' and $tokentype eq 'anumber') {
              if($usefort eq 'yes') {
         print VARBOT ("    $esddec; \n");
         print FORVARTOP ("      $forvartype $foresdname \n");
         $foresdname =~ s/(.+)(\(.*\))/$1/;
         $comnew = join('',$comout,$foresdname,',');
         if(length($comnew) > 70) {  # time to output
           print FORVARBOT ("$comout\n");
           $comout = join('',"     *",$foresdname,',');
           }
         else {
           $comout = $comnew;
           }
         }
      else {
        print VARMID ("$esddec; \n");
        print VARBOT ("extern $esddec; \n");
        }
      }
#
#   If the variable name contains the length of an array, we want it set to the
#   zeroth element in the case of a non--looped item, and constantly incremented
#   in the case of a looped variable.  We substitute zero for whatever was 
#   between the brackets.
#
    $varname =~ s/\[[0-9]+\]/\[0\]/g;  #All indices to zero
    $esdname =~ s/\[[0-9]+\]/\[0\]/g;  #All indices to zero
    $i = 0;
    foreach $aname (@names)
      {
#
# Print to the simple keyvaluepair section
#
      print PERL_BISON <<"ENDDEF1";
             | $aname QUESTION
               {
ENDDEF1
      print PERL_BISON ('         strncpy($$,$1,40);',"\n     }");
      print PERL_BISON ("         | $aname error\n    {\n");
      print PERL_BISON <<'ENDDEF2';
               if(errornum == 0) {     /* no previous error */
               strncpy(safestr,$1,40);
               sprintf(errormes,"Type mismatch: %s\n",safestr);
               errornum = 4;
               }
             }
ENDDEF2
      print PERL_BISON ("      | $aname $tokentype\n     {\n");
#
#  Print to the loop section if array has been declared
#
      if($arrayflag == 1) {
      print LOOPTEMP <<"MIDNEWATTR";
             | $aname
             {
MIDNEWATTR
      print LOOPTEMP <<'ENDNEWATTR';
             /* store name for possible use in error messages */
                strncpy($$,$1,40);
                $$[40] = 0x00;
             /* set data pointer to here */
ENDNEWATTR
      }
      $outname = $varname;
      $outesdname = $esdname;
      if($#names > 0)                 # add an array reference
         {
         if($arrayflag == 1) {
           $outname =~ s/([a-zA-z0-9_]+)(\[[0-9]+\])/$1$2\[$i\]/;
           $outesdname =~ s/([a-zA-z0-9_]+)(\[[0-9]+\])/$1$2\[$i\]/;
           }
         else {
           $outname = join('',$outname,"[$i]");
           $outesdname = join('',$outesdname,"[$i]");
           }
         } 
# If Fortran supported, add structure name
      if($usefort eq 'yes') {
         $outname = join('',"cifcmnptr->",$outname);
         $outesdname = join('',"cifcmnptr->",$outesdname);
         }
      if($tokentype eq 'DATASTRING') 
        {print PERL_BISON ("             strncpy($outname,",'$2,',"80);");
        }
      elsif($tokentype eq 'anumber') {
        print PERL_BISON ("             $outname = ",'$2[0];');
        if($useesds eq 'yes') {
          print PERL_BISON ("             $outesdname = ",'$2[1];');
          }
        }
      if($arrayflag == 1)  {          #loop input method
         print LOOPTEMP ("    attdata[noinloop].location = (char*) &$outname;\n");
         print LOOPTEMP ("    attdata[noinloop].size = sizeof($vartype);\n");
         print LOOPTEMP ("    attdata[noinloop].maxentries = $definer ;");
         print LOOPTEMP ("    attdata[noinloop].checktype = $checktype;");
         if($useesds eq 'yes' and $tokentype eq 'anumber') {
           print LOOPTEMP ("\n    attdata[noinloop].esdlocation = (char*) &$outesdname;");
          }
        }
      print PERL_BISON ("\n             ",'}',"\n");  # ready for next one
         if($arrayflag == 1) 
           {print LOOPTEMP       ("\n             ",'}',"\n");}  # ready for next one 
      $i++;
      }
#
#  Don't forget to set them to zero after output
#
     @names = ();
     $varname = '';
     $outname = '';
     $outesdname = ''; 
     $numinarray = 0;
    }         # End of DATABLOCK if statement
}             # End of DDLOUT file

#
#  Now we concatenate our temporary files
#
print PERL_BISON <<"LOOP STATEMENTS";
          ;     /* end of simple processes */

/* When an item name is detected inside a loop, a pointer to the beginning
of the array corresponding to that item is created.  If that item has not
been declared as an array variable, an error should be registered. */

anattribute: NAME    /* an unknown name */
             {
                attdata[noinloop].location = junk;
                attdata[noinloop].size = 0;
                attdata[noinloop].maxentries = 100000; /* not used */
                attdata[noinloop].esdlocation = junk;
                attdata[noinloop].checktype = 0;
             }
LOOP STATEMENTS

#
# Finish off the second half
#
print LOOPTEMP <<'END OF PARSER';
          ;

%%

/* Extra C code */
int yyerror(char *arg)
{
/* don't print anything as we have a better method */
if(errornum == 0) {   /* no previous error */
strncpy(errormes, arg, 20);
strncat(errormes, " Last item: ",12);
strncat(errormes, recentitem, 40);
strncat(errormes, "\n",2);
errornum = 5;  /* parse error */
}
return(0);
}

END OF PARSER
#
# Add on our temporary file
#
close(PERL_BISON); close(LOOPTEMP); 
# Finish off variables file
if($usefort eq 'yes') {
print VARMID ("typedef struct {\n");
print VARBOT <<'VARBOTEND';
} cifcmnstr;

#ifdef CIFVARDEC
cifcmnstr *cifcmnptr;
#else
extern cifcmnstr *cifcmnptr;
#endif
VARBOTEND
}
else {
print VARTOP ('#ifdef CIFVARDEC',"\n"); 
print VARTOP ("cifstring errormes;           /* an error message */\n");
print VARTOP ("int       errornum;           /* an error number  */\n");
print VARMID ('#else',"\n");
print VARMID ("extern cifstring errormes;    /* an error message */\n");
print VARMID ("extern int       errornum;    /* an error number  */\n");
print VARBOT ('#endif',"\n");
}
close(VARTOP); close(VARMID); close(VARBOT); close(FORVARTOP);
chop $comout; print FORVARBOT ($comout); close(FORVARBOT);
system 'cat vartop varmid varbot > cifvars.h';
system 'cat grammar.top grammar.bot > cifsiv.y';
if($usefort eq 'yes') {system 'cat forvar forbot > forcif.inc'};
#
#  Finally, output the actual function specification
#
open(CIFREAD, ">cifwrapper.c") or die "Can't create read file\n";
print CIFREAD <<'CIFREADHEAD';
/* File to invoke the cifparser for reading variables */
#include <stdio.h>
#include "cifvars.h"     /* created automatically */
extern FILE *yyin;
extern int yydebug;
char blockname[80];      /* name of data block */
CIFREADHEAD
    if($usefort eq 'yes') {
    print CIFREAD <<'FORCIFSTART';
char wantfile[80];
void cifsiv_(char *filename, char *wantblock, cifcmnstr *tohere, int filelen, int blocklen)  
{
strncpy(wantfile,filename,filelen);
wantfile[filelen] = 0x00;
FORCIFSTART
    } else {
    print CIFREAD ('void cifsiv_(char *wantfile, char *wantblock)',"\n{");
    }

print CIFREAD <<'READTOPHALF';
if((yyin = fopen(wantfile,"r")) == NULL)
    {
    printf("Cannot open file %s; Aborting\n",wantfile);
    return;
    }
strncpy(blockname,"data_",6);
READTOPHALF
    if($usefort eq 'yes') {
	print CIFREAD << 'FORBLOCKNAME';
strncat(blockname,wantblock,blocklen);
blockname[blocklen+6] = 0x00;
cifcmnptr = tohere;
FORBLOCKNAME
    }
    else {
	print CIFREAD ("strncat(blockname,wantblock,73);\n");
    }
print CIFREAD <<'CIFREADING';
blockname[79] = 0x00;   /* terminate string for safety */
/* printf("Target blockname: %s, length %d\n",blockname,strlen(blockname));*/
/*yydebug = 1;*/
yyparse();
}
CIFREADING
    close(CIFREAD);
#
# Now put it all together
#
    print STDOUT "Making parser source...\n";
system 'bison -b cifsiv -d -t cifsiv.y';  #Make parser source
    print STDOUT "Making lexer source...\n";
system 'flex -Cf cifsiv.lex';               #Make lexer source
    print STDOUT "Compiling source...\n";
@args = ("cc",  "-g", "-c", "lex.yy.c","cifsiv.tab.c","cifwrapper.c");
$rc = 0xffff & system @args;
if($rc == 0) {print STDOUT "Linking source...\n"};
system 'ld -r -o cifsiv.o cifwrapper.o lex.yy.o cifsiv.tab.o';
    print STDOUT "Removing unwanted files...\n";
system 'rm -f grammar.bot grammar.top';      #Unneeded files
system 'rm -f vartop varmid varbot forvar forbot cifsiv.tab.c';
system 'rm -f lex.yy.o cifsiv.tab.o cifwrapper.o cifsiv.tab.h';
print STDOUT "Finished.\n";