/* X-Midas Fortran PreProcessor (xfpp)

   Author: JGS     1993-01-01 (Original C Version)
   Author: bdil24  2004-09-13 (Removed VMS, vax, unix sections, DR 503943)
   Author: JC4     2007-01-17 (Changes to allow use from NeXtMidas's XBC option,
                               allow compilers to be switched at runtime rather
                               than compile time)
                   2023-10-25  (Renamed BPointer to IPointer since BPointer was
                                being treated as boolean)
*/

#include <string>

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <ctype.h>

#include "xmversion.h"

#define NORMAL 0
#define ERROR  1

/* This allows NeXtMidas to override M_CHECKIN and M_RETURN as needed. */
#ifndef M_CHECKIN
#define M_CHECKIN "continue !XFPP" /* Replacement string for M$CHECKIN */
#endif

#ifndef M_RETURN
#define M_RETURN  "return !XFPP"   /* Replacement string for M$RETURN */
#endif


typedef struct {
  char            name[20], array[20];
  int             id, index;
}               POINTERSTRUCT;

typedef struct {
  int             level;
  char           *inc;
}               NESTDOSTRUCT;

#define	L_text		4096
#define	L_label		16
#define	L_comment	4096
#define	L_line		4096
#define	L_list		4096
#define	L_name		32
#define	L_pointer	128
#define	L_do		128

#define L_filename	256

#define	HT   9
#define	CR   13
#define	LF   10
#define	TIC  39
#define	LPAR 40
#define	RPAR 41

int             type[256];
char            line[L_line], defines[L_list];

char            stdincludes[] = "primitive.inc,dsef.inc,dses.inc,midas.inc,\
tables.inc,headers.inc,types.inc,constants.inc,buffers.inc,buffers2.inc,\
qmessdef.inc,qmessdecl.inc,";

FILE           *f_in, *f_out;
char            fn_in[L_filename], fn_out[L_filename], flags[80];

bool            Bxfpp, Bsubroutine, Bprogram, Bdses, Boptions,
                Bheader, Bwrap;
bool            Bverbose, Bincludes, Bterminate, Bcompress;
int		Bpound;
int             linein = 0;
int Ipointer = 0;

/* Declarations */
int  find(const char *, const char *, int);
int  getline(char *, char *, char *);
void lower(char *, char *);
int  parse(char *, const char *, const char *, char *);
int  pastparen(char *, int, int);
int  putline(const char *, const char *, const char *, int);
void replace(char *, int, int, char *, const char *);
int  sub(char *, const char *, int, char *, const char *);
void typeinit(void);
int  word(char *, int, int);
bool tests_as_true(const char* expr);
int  xfpp(const char *, const char *, const char *);

/* Main routine, should be called with 3 arguments.
   argv[0] - Name of input file.
   argv[1] - Name of output file.
   argv[2] - XFPP flags (see explain file).
*/
int main(int argc, char *argv[])
{
  if (argc < 4) {
    printf("Wrong number of arguments - need all 3\n");
    return ERROR;
  }
  return xfpp(argv[1], argv[2], argv[3]);
}

/* Preprocess the given Fortran file. In X-Midas 4.4.4 this was part of the
   main(..) method, it has been separated out to allow it to be called
   directly (as is done by the XBC option tree in NeXtMidas).
   @param fname_in   Name of input file (not null).
   @param fname_out  Name of output file (not null).
   @param xfpp_flags XFPP flags (not null).
*/
int xfpp(const char *fname_in, const char *fname_out, const char *xfpp_flags) {
  int             level, addlevel, lastlevel, ndo, ndod, i, j, k, np, ilab,
                  defstate[16];
  char            text[L_text], sx[L_text], label[L_label], comment[L_comment],
                  variables[L_list],commons[L_list], includes[L_list],
                  tmp[L_text];
  bool            output;

  POINTERSTRUCT   p[L_pointer];
  NESTDOSTRUCT    nestdo[L_do];

  /* 2011-02-21 NTN: fix for BUG 2342 FortranPreprocessor (xfpp) sometimes inserts invalid char into .fpp */
  memset(comment, 0, L_comment);

/* process the command line options */
  strcpy(fn_in, fname_in);
  strcpy(fn_out, fname_out);
  strcpy(flags, xfpp_flags);

  lower(flags, flags);

  if ((i = find(flags, "#", 0)) >= 0) {
    strcpy(defines, flags + i);
    strcat(defines, "#");
    flags[i] = 0;
    Bpound = 1;
  }
  else
    Bpound = 0;

  Bxfpp = find(flags, "x", 0) >= 0;
  Bdses = find(flags, "d", 0) >= 0;
  Ipointer = find(flags, "p", 0);
  Boptions = find(flags, "o", 0) >= 0;
  Bsubroutine = find(flags, "s", 0) >= 0;
  Bheader = find(flags, "h", 0) >= 0;
  Bincludes = find(flags, "i", 0) >= 0;
  Bverbose = find(flags, "v", 0) >= 0;
  Bterminate = find(flags, "t", 0) >= 0;
  Bcompress = find(flags, "c", 0) >= 0;
  Bwrap = find(flags, "w", 0) >= 0;

  if (Bxfpp || Bdses || (Ipointer >= 0))
    Bwrap = 1;

  typeinit();
  line[0] = 0;
  includes[0] = 0;
  variables[0] = 0;
  commons[0] = 0;
  np = ndo = ndod = level = 0;
  defstate[1] = 1;

/* open files */
  f_in = fopen(fn_in, "r");
  if (f_in == 0) {
    printf("Error opening input file %s\n", fn_in);
    return ERROR;
  }
  f_out = fopen(fn_out, "w");
  if (f_out == 0) {
    printf("Error opening output file %s\n", fn_out);
    return ERROR;
  }

/* start processing loop*/
  while (getline(label, text, comment) >= 0) {

    addlevel = 0;
    output = 1;

/* invoke preprocessor through comment field ? */
    if (label[0] == '%') {
      if (find(text, "cXFPP", -1) == 0) {
	Bxfpp = 1;
	Bwrap = 1;
	strncpy(text, "cXfpp", 5);	/* do not copy enable key to output
					 * file */
	printf("Invoking XFPP Fortran preprocessor functions\n");
      }
      if (Bxfpp == 1 && find(text, "cxfpp", -1) == 0) {
	Bxfpp = 0;
	printf("Disabling XFPP Fortran preprocessor functions\n");
      }
      if (find(text, "cCOMMON", -1) == 0) {
	parse(text, "/", "/", tmp);
	strcat(tmp, ",");
	lower(tmp, tmp);
	if (find(commons, tmp, 0) < 0)
	  strcat(commons, tmp);
      }
    }

/* create lowercase version of command for searches */
    lower(text, sx);

/* process # directives (k=0:nodirective,1:true,-1:false) */
    if (Bpound != 0 && sx[0] == '#') {
      if ( find(sx,"&",0) >= 0) {
        printf("Cannot use & in # directive: %s\n", sx);
        return ERROR;
      }
      i = word(sx, 0, 1);
      if (size_t(i) == strlen(sx)) i--;
      j = i;
      k = -1;
      while (k < 0 && sx[j] > ' ') {
	i = j;
	if (sx[i] == '|') i++;
        if (sx[i] == '!') i++;
        for (j = i; sx[j] > ' ' && sx[j] != '|'; j++);
	sprintf(tmp,"#%.*s#", j-i, sx+i);
	if (tests_as_true(tmp)) {
	  if (sx[i - 1] != '!') k=1;
	} else {
	  if (sx[i - 1] == '!') k=1;
	}
      }
      if (Bcompress) output = 0;
      text[0] = '!';		/* turn directive into comment */
      if (Bverbose)
	printf("Directive %.*s == %d\n", j, sx, k);
    }
    else
      k = 0;

    if (Bpound == 0);
    else if (k == 0) {
      if (defstate[Bpound] != 1) {
	if (Bcompress)
	  output = 0;
	else if (label[0] == '%' || label[0] == '~')
	  strcpy(text, "!\n");
	else {
	  label[0] = '!';
	  text[0] = 0;
	}
	goto OUT;
      }
    }
    else if (find(sx, "#if", 0) == 0) {
      Bpound++;
      defstate[Bpound] = k;
      /* If the parent has code turned off, the child should as well */
      if (Bpound > 1 && defstate[Bpound - 1] != 1)
	defstate[Bpound] = 0;
    }
    else if (find(sx, "#elif", 0) == 0) {
      if (defstate[Bpound] == 1)
	defstate[Bpound] = 0;
      else if (defstate[Bpound] == -1)
	defstate[Bpound] = k;
    }
    else if (find(sx, "#else", 0) == 0) {
      if (find(sx, "#elseif", 0) == 0) {
	fprintf(stderr,
		"WARNING: Using #elseif is incorrect and is being handled\n"
		"         like an #else directive. Change to #elif.\n");
      }
      if (defstate[Bpound] == 1)
	defstate[Bpound] = 0;
      else if (defstate[Bpound] == -1)
	defstate[Bpound] = 1;
    }
    else if (find(sx, "#endif", 0) == 0) {
      Bpound--;
    }
    else if (find(sx, "#define", 0) == 0) {
      strcat (defines,tmp+1);
    }
    else if (find(sx, "#undef", 0) == 0) {
      sub (defines, tmp, 0, defines, "#");
    }



/* skip the rest if this is a comment */
    if (!output || label[0] == '%')
      goto OUT;

/* if in nowrap mode - find the offset to the beginning of the first word */
    if (Bwrap)
      i = 0;
    else
      for (i = 0; sx[i] == ' ' || sx[i] == HT || (sx[i] >= '0' && sx[i] <= '9'); i++);
    ilab = i;

/* replace program calls with subroutine for dynamic libraries */
    if (Bsubroutine) {
      if (find(sx + ilab, "program", -1) == 0) {
	for (j = strlen(sx); sx[j - 1] <= ' '; j--);
	if (Bheader) {		/* add the special header code */
	  putline("", "subroutine MAINROUTINE", "", 0);
	  sprintf(tmp, "call mh$%.*s", j - ilab - 8, sx + ilab + 8);
	  putline("", tmp, "", 0);
	  putline("", "return", "", 0);
	  putline("", "end", "", 0);
	  putline("", "", "", 0);
	}
	sprintf(text, "subroutine mh$%.*s !XFPP", j - ilab - 8, sx + ilab + 8);
	strcpy(label, "");
      }
      if ((j = find(sx, "m$checkin", 1)) > 0) {
	i = word(sx, j, -1);
	if (find(sx + i, "call", -1) == 0)
	  replace(sx, i, j + 9, text, M_CHECKIN);
      }
      if ((j = find(sx, "m$return", 1)) > 0) {
	i = word(sx, j, -1);
	if (find(sx + i, "call", -1) == 0)
	  replace(sx, i, j + 8, text, M_RETURN);
      }
      if ((j = find(sx, "mx$setup", 1)) > 0) {
        i = word(sx, j, -1);
        if (find(sx + i, "call", -1) == 0) {
          for (;sx[j] != '('; j++);
          replace(sx, i, j+1, text, "call nmx$setup (Mx,");
        }
      }
    }

/* handle rearrangement of old style DSES routines */
    if (Bdses && find(sx, "call", -1) == 0) {
      if (find(sx, "md$bufin", 1) > 0 || find(sx, "md$bufout", 1) > 0 ||
	  find(sx, "md$buftmp", 1) > 0 || find(sx, "md$bufres", 1) > 0 ||
	  find(sx, "md$blockdata", 1) > 0) {
	printf("XFPP changing old calling sequence - see HELP file\n");
	printf("Old= [%s]\n", text);
	if (find(sx, "md$blockdata", 1) <= 0)
	  i = find(sx, ",", 0);
	else
	  i = 0;
	i = i + 1 + find(sx + i + 1, ",", 0);
	j = i + 1 + find(sx + i + 1, ",", 0);
	strncpy(tmp, sx + i + 1, j - i);
	tmp[j - i] = 0;
	sub(sx, tmp, 0, text, "");
	tmp[strlen(tmp) - 1] = '=';
	sub(sx, "call", -1, text, tmp);
	printf("New= [%s]\n", text);
      }
    }

/* find all common blocks and includes for options file creation */
    if (find(sx + ilab, "common", -1) == 0) {
      parse(sx, "/", "/", tmp);
      if (find(commons, tmp, 1) < 0) {
        strcat(tmp, ",");
	strcat(commons, tmp);
      }
    }
    else if (find(sx + ilab, "include", -1) == 0) {
      parse(sx, "'", "'", tmp);
      if (find(includes, tmp, 1) < 0) {
        strcat(tmp, ",");
	strcat(includes, tmp);
      }
      strcpy(text,sx);
    }

/* if preprocessor is on, replace all of the logical operator identities */
    if (Bxfpp) {
      sub(sx, "==", 0, text, ".eq.");
      sub(sx, "<>", 0, text, ".ne.");
      sub(sx, "^=", 0, text, ".ne.");
      sub(sx, "<=", 0, text, ".le.");
      sub(sx, ">=", 0, text, ".ge.");
      sub(sx, "<", 0, text, ".lt.");
      sub(sx, ">", 0, text, ".gt.");
      sub(sx, "^", 0, text, ".not.");
      sub(sx, "&", 0, text, ".and.");
      sub(sx, "|", 0, text, ".or.");
    }

/* if preprocessor is on, look for special commands (do,if) */
    if (Bxfpp) {
      if (find(sx, "if", -1) == 0) {
	if ((j = find(sx, ":", 3)) > 0) {
	  i = pastparen(sx, 0, 1);
	  text[j] = 0;
	  sprintf(line, " %s ;else; %s ;endif", text + i, text + j + 1);
	  strcpy(text + i, "then");
	  strcpy(sx + i, "then");
	}
      }
      else if (find(sx, "do", -1) == 0) {
	ndo++;
	ndod++;
	nestdo[ndod].inc = 0;
	nestdo[ndod].level = ndo;
	i = word(sx, 0, 1);
	if (sx[i] == 0) {
	  strcpy(sx, "do while (.TRUE.)");
	  strcpy(text, sx);
	}
	else if (sx[i] == '(') {
	  i++;
	  j = i + find(sx + i, ",", 3);
	  if (j > i) {		/* has loop init */
	    strncpy(tmp, text + i, j - i);
	    tmp[j - i] = 0;
	    putline("", tmp, "", level);
	    strcpy(sx + i, sx + j + 1);
	    strcpy(text + i, text + j + 1);
	    j = i + find(sx + i, ",", 3);
	    if (j > i) {	/* has loop increment */
	      k = j + find(sx + j, ")", 3);
	      text[k] = 0;
	      nestdo[ndod].inc = (char *) malloc(k - j);
	      strcpy(nestdo[ndod].inc, text + j + 1);
	      strcpy(sx + j, ")");
	      strcpy(text + j, ")");
	    }
	  }
	  sub(sx, "do", -1, text, "do while");
	}
      }
      else if (find(sx, "enddo", -1) == 0) {
	if (nestdo[ndod].inc != 0) {
	  putline("", nestdo[ndod].inc, "", level);
	  free(nestdo[ndod].inc);
	}
	ndod--;
      }
      else if (find(sx, "until", -1) == 0) {
	sprintf(tmp, "if (.not. %s ) goto %d", text + 5, 7200 + nestdo[ndod].level);
	putline(label, tmp, "", level);
	if (nestdo[ndod].inc != 0) {
	  putline("", nestdo[ndod].inc, "", level);
	  free(nestdo[ndod].inc);
	}
	putline("", "enddo", "", --level);
	sprintf(label, " %d ", 7200 + nestdo[ndod].level);
	strcpy(sx, "continue");
	strcpy(text, sx);
	ndod--;
      }
    }

/* handle auto indentation and loop leveling */
    lastlevel = level;
    if (Bwrap == 0);		/* no indenting */
    else if (find(sx, "if", -1) == 0) {
      if (find(sx, "then", 1) >= 0)
	addlevel++;
    }
    else if (find(sx, "endif", -1) == 0)
      level--;
    else if (find(sx, "end if", -1) == 0)
      level--;
    else if (find(sx, "elseif", -1) == 0) {
      level--;
      addlevel++;
    }
    else if (find(sx, "else", -1) == 0) {
      level--;
      addlevel++;
    }
    else if (find(sx, "do", -1) == 0)
      addlevel++;
    else if (find(sx, "enddo", -1) == 0)
      level--;
    else if (find(sx, "end do", -1) == 0)
      level--;
    else if (find(sx, "subroutine", -1) == 0)
      level = 0;

/* write the output line */
OUT:;
    if (output)
      putline(label, text, comment, level);
    level += addlevel;

/* handle inserts after possible pointer assignments */
    if (Ipointer == 2 && label[0] != '%') {
      if (lastlevel == 0 && find(sx, "end", -1) == 0)
    Ipointer = 0;
      for (i = 0; i < np; i++)
	if (find(sx, p[i].name, 2) >= 0) {
	  sprintf(tmp, "call m$pointer (BOC,%d,%s)", p[i].id, p[i].name);
	  putline("", tmp, "! XFPP", level);
	}
    }

/* end of main text processing loop */
  }

/* close files */

  fclose(f_in);
  fclose(f_out);

/* Search non-standard includes for commons */
  for (i = 0; (j = find(includes + i, ",", 0)) > 0; i += (j + 1)) {
    Bwrap = 1;
    sprintf(fn_in, "%.*s", j, includes + i);
    if (find(stdincludes, fn_in, 1) >= 0)
      continue;			/* skip standard include */
    if (find(fn_in, ".", 0) < 0)
      continue;			/* not a valid file name */
    f_in = fopen(fn_in, "r");
    if (f_in == 0) {
      if (Bverbose)
	printf("Error opening include file %s\n", fn_in);
      continue;
    }
    while (getline(label, text, comment) >= 0) {
      if (label[0] == '%')
	continue;
      lower(text, sx);
      if (find(sx, "common", -1) == 0) {
	parse(sx, "/", "/", tmp);
	if (find(commons, tmp, 1) < 0) {
	  strcat(tmp, ",");
	  strcat(commons, tmp);
        }
      }
      else if (find(sx, "include", -1) == 0) {
	parse(sx, "'", "'", tmp);
	if (find(includes, tmp, 1) < 0) {
	  strcat(tmp, ",");
	  strcat(includes, tmp);
        }
      }
    }
    fclose(f_in);
  }

/* report includes and common blocks */
  if (Bverbose) {
    printf("Includes: %s\n", includes);
    printf("Commons: %s\n", commons);
  }

/* write options file if necessary */
  if (Boptions && commons[0] != 0) {
    sub(fn_out, ".fpp", 0, fn_out, ".opt");
    f_out = fopen(fn_out, "w");
    if (f_out != 0) {
      for (j = 0; commons[j] != 0;) {
	for (i = j; commons[i] != ','; i++);
	sprintf(tmp, "PSECT=%.*s,NOSHR\n", i - j, commons + j);
	fputs(tmp, f_out);
	j = i + 1;
      } fclose(f_out);
    }
    else
      printf("Error opening options file %s\n", fn_out);
  }

/* write includes file if necessary */
  if (Bincludes) {
    strcpy(fn_out, "includes.list");
    f_out = fopen(fn_out, "w");
    if (f_out != 0) {
      sub(includes, ",", 0, includes, "\n");
      fputs(includes, f_out);
      fclose(f_out);
    }
    else
      printf("Error opening includes file %s\n", fn_out);
  }

  return NORMAL;
}


// Given a preprocessor expression, returns the boolean evaluation of it.
// This considers it true if (1) it's a single symbol that exists in
// the #-delimited "defines" string; or (2) it's an expression of the
// form XM_SYS_VERSION_AT_LEAST(x,y,z).
//
// The form is pretty strict, too. This is not intended to be a general
// expression evaluator!

bool tests_as_true (const char* expr)
{
  if (find(defines, expr, 0) >= 0)
    return true;

  static char version_test[] = "xm_sys_version_at_least(";
  if (find(expr + 1, version_test, 0) == 0) {
    // Pick out version code components, make the test
    const char* vstr = expr + 1 + strlen(version_test);
    int major, minor, patch;
    sscanf(vstr, "%d,%d,%d", &major, &minor, &patch);
    int vcode = patch + 1000*(minor + 1000*major);
    return XM_SYS_VERSION >= vcode;
  }

  return false;

} // tests_as_true


/*

  Fortran preprocessor utility routines

*/


int getline(char *label, char *text, char *comment)
{
  int             i, j, k, l, ii, segment, paren, quote;
  int            c, cl;
  int  len;
  unsigned int decimal;
  unsigned int convert_binary_2_decimal(char *);
  char *tmp,*tmp2,*tmp3;
  char tmpline[256],token[132];

  if (line[0] == 0) {
    fgets(line, L_line, f_in);
    linein++;
    if (feof(f_in))
      return (-1);
  }

/* TAD - PGF77 preparse non-supported binary constants. */
  if ( (tmp=strstr(defines,"_pgf77"))!=0) {
     lower(line,tmpline);
     tmp2 = tmpline;
     while ( (tmp=strstr(tmp2,"b\'"))!=0) {
         tmp3 = strchr(tmp+2,'\'');
         if (tmp3 != 0) {
            len = (unsigned long) (tmp3) - (unsigned long) (tmp) + 1;
            l = 0;
            for (i=2; i<len-1; i++) {
                if (tmp[i]!='0' && tmp[i]!='1') {
                   l = 1;
                   break;
                }
            }
            if (!l) {
               strncpy(token,tmp,len);
               token[len]=0;
               decimal = convert_binary_2_decimal(token);
               sprintf(token,"\'%x\'X",decimal);
               for (i=strlen(token); i<len; i++) token[i]=' ';
               token[i]=0;
               j = (unsigned long) tmp - (unsigned long) tmpline;
               strcpy(&line[j],token);
            }
            tmp2 = tmp3 + 1;
         } else {
            tmp2 += 2;
         }
     }
  }

/* comment line  ? */
  if (strchr("cCdD!#", line[0]) != 0) {
    label[0] = '%';
    strcpy(text, line);
    line[0] = 0;
    return (1);
  }

/* no wrap mode */
  if (Bwrap == 0) {
    label[0] = '~';
    strcpy(text, line);
    line[0] = 0;
    return (1);
  }

/* init counters */
  i = j = k = l = segment = paren = quote = 0;
  cl = ' ';

/* continuation line preceded by a comment */
  if (!Bxfpp && strncmp(line, "     ", 5) == 0 && line[5] > ' ') {
    l = -1;
    i = 6;
    segment = 1;
  }

/* process line */
ADDTOLINE:;
  for (; (c = line[i]) != 0; i++) {
    if (c < ' ')
      c = ' ';
    if (c == '!')
      segment = 2;
    if (c == ';' && Bxfpp) {
      for (ii = 1; line[i + ii] != 0; ii++)
	line[ii] = line[i + ii];
      line[0] = ' ';
      line[ii] = 0;
      goto NOCONT;
    }
    if (c != ' ' || cl != ' ') {
      if (segment == 0) {
	if (type[c] == 1)
	  label[l++] = c;
	else {
	  segment = 1;
	  if (l == 0)
	    text[j++] = c;
	}
      }
      else if (segment == 1) {

	if (c == TIC) {
	  do {			/* special case for quoted string constants */
	    if (line[i] == 0) {
	      for (; line[i - 1] <= ' '; i--)
		j--;
	      if (line[i - 1] == '_')
		j--;
	      else
		text[j++] = ' ';
	      fgets(line, L_line, f_in);
	      linein++;
	      for (i = 0; line[i] <= ' '; i++);
	      if (!Bxfpp) {
		if (i != 5)
		  goto UNCLOSED_QUOTE;
		else
		  i++;
	      }
	    }
	    if (j >= L_text)
	      goto UNCLOSED_QUOTE;
	    text[j++] = line[i++];
	  } while (line[i] != TIC);
	}

	else if (c == '(')
	  paren++;
	else if (c == ')')
	  paren--;
	if (j >= L_text)
	  goto LINE_TOOLONG;
	text[j++] = c;
      }
      else if (segment == 2)
	comment[k++] = c;
    }
    cl = c;
  }

/* clean off trailing spaces for continuation processing */
  if (k > 0 && comment[k - 1] == ' ')
    cl = comment[--k - 1];
  else if (j > 0 && text[j - 1] == ' ')
    cl = text[--j - 1];

/* check for next line continuation */
  line[0] = 0;
  if (Bxfpp) {
    if (quote > 0 || paren > 0 || cl == '+' || cl == '-' || cl == '*'
	|| cl == ',' || cl == '=' || cl == '_') {
      if (cl == '_') {
	j--;
	cl = ' ';
      }
      fgets(line, L_line, f_in);
      linein++;
      i = 0;
      segment = 1;
      goto ADDTOLINE;
    }
  }
  else {
    if (!feof(f_in)) {
      strcpy(line, "      ");
      fgets(line, L_line, f_in);
      linein++;
      for (i = 0; i < 5; i++)
	if (line[i] != ' ')
	  goto NOCONT;
      if (line[i++] > ' ') {
	segment = 1;
	goto ADDTOLINE;
      }
    }
  }

/* termintate the strings and fill out the label string */
NOCONT:;
  text[j] = 0;
  comment[k] = 0;
  if (l == -1)
    strcpy(label, "     &");
  else {
    i = 6;
    label[i--] = 0;
    label[i--] = ' ';
    for (; l > 0;)
      label[i--] = label[--l];
    for (; i >= 0;)
      label[i--] = ' ';
  }

  return (1);

UNCLOSED_QUOTE:;
  printf("Unclosed quoted string found by preprocessor near line %d\n", linein);
  printf("%.*s\n", j - 1, text);
  goto NOCONT;

LINE_TOOLONG:;
  printf("Line too long for preprocessor to handle near line %d\n", linein);
  printf("%.*s\n", j - 1, text);
  goto NOCONT;

}

unsigned int powersoftwo[32]={
                 1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,
                 32768,65536,131072,262144,524288,1048576,2097152,4194304,
                 8388608,16777216,33554432,67108864,134217728,268435456,
                 536870912,1073741824,2147483648u};

unsigned int convert_binary_2_decimal(char *binary)
{
   int i,k,len;
   unsigned int j;
   j = 0;
   k = 0;
   /* B'01111110' LEN must start at rightmost digit */
   len = strlen(binary) - 2;
   for (i=len; i>=2; i--){
       if (binary[i] == '1') {
          j += powersoftwo[k];
       }
       k++;
   }
   return(j);
}

int putline(const char *label, const char *text, const char *comment, int level)
{
  char            lout[128], c;
  int             i, j, k, kk, jw, w = 0, q = 0;

  if (label[0] == '%' || label[0] == '~') {

    std::string new_text(text);
    if (Bterminate) {
      // Append a '~' to the end of the displayed string (before any CR/LF)
      std::string::size_type pre_crlf_pos = new_text.find_last_not_of("\r\n");
      new_text.insert(pre_crlf_pos, 1, '~');
    }
    fputs(new_text.c_str(), f_out);

  }
  else {

    if (label[0] == 0) {
      strcpy(lout, "      ");
      j = 6;
    }
    else
      for (j = 0; label[j] != 0; j++)
	lout[j] = label[j];

    kk = 2 * level;
    if (kk > 20)
      kk = 20;			/* limit indentation */
    for (k = kk; k > 0; k--)
      lout[j++] = ' ';

    for (i = 0; text[i] != 0; i++) {
      lout[j++] = c = text[i];
      if (c == TIC) {
	q = 1 - q;
	if (q == 0 && text[i + 1] != TIC)
	  w = j;
      }
      if (q == 1);		/* no break points in quotes */
      else if (strchr(" +-%", c))
	w = j - 1;		/* break before char */
      else if (strncmp(text + i, "//", 2) == 0);	/* string concat case */
      else if (strncmp(text + i, ").", 2) == 0);	/* struct arrray case */
      else if (strchr(",*/)=", c))
	w = j;			/* break after char */
      if (j >= 72) {
	if (q == 0)
	  jw = j - w;		/* no quote break */
	else if (w > 10) {
	  jw = j - w;
	  q = 0;
	}			/* quote break if not too long */
	else
	  jw = 0;		/* no smart break (at 72 chars) */
	j -= jw;
	i -= jw;
	lout[j++] = 10;
	lout[j] = 0;
	fputs(lout, f_out);
	strcpy(lout, "     &");
	j = 6;
	w = j;			/* for (k=kk;k>0;k--) lout[j++]=' '; */
      }
    }
    for (i = 0; comment[i] != 0 && j < 80; i++)
      lout[j++] = comment[i];
    if (j > 6 || text[0] == 0) {
      lout[j++] = 10;
      lout[j] = 0;
      fputs(lout, f_out);
    }

  }
  return (1);
}


void typeinit(void)
{
  int             j, i = 0;

  j = i + 34;
  for (; i < j;)
    type[i++] = -1;
  j = i + 1;
  for (; i < j;)
    type[i++] = -2;
  j = i + 8;
  for (; i < j;)
    type[i++] = -1;
  j = i + 1;
  for (; i < j;)
    type[i++] = 0;
  j = i + 1;
  for (; i < j;)
    type[i++] = -2;
  j = i + 2;
  for (; i < j;)
    type[i++] = 0;
  j = i + 1;
  for (; i < j;)
    type[i++] = -1;
  j = i + 10;
  for (; i < j;)
    type[i++] = 1;
  j = i + 7;
  for (; i < j;)
    type[i++] = -1;
  j = i + 26;
  for (; i < j;)
    type[i++] = 2;
  j = i + 4;
  for (; i < j;)
    type[i++] = -1;
  j = i + 1;
  for (; i < j;)
    type[i++] = 2;
  j = i + 1;
  for (; i < j;)
    type[i++] = -1;
  j = i + 26;
  for (; i < j;)
    type[i++] = 2;
  j = i + 5;
  for (; i < j;)
    type[i++] = -1;

}

void lower(char *S, char *s)
{
  int             i;

  for (i = 0; S[i] != 0; i++)
    s[i] = tolower(S[i]);
  s[i] = S[i];
}

int word(char *s, int i, int mode)
{
  while (mode > 0) {
    while (s[i] > ' ')
      i++;
    while (s[i] <= ' ' && s[i] != 0)
      i++;
    mode--;
  }
  while (mode < 0) {
    while (i > 0 && s[--i] <= ' ');
    while (i > 0 && s[i - 1] > ' ')
      i--;
    mode++;
  }
  return (i);
}

int pastparen(char *s, int i, int mode)
{
  int             paren;

  while (mode > 0) {
    while (s[i] != '(')
      i++;
    i++;
    for (paren = 1; paren > 0; i++) {
      if (s[i] == '(')
	paren++;
      else if (s[i] == ')')
	paren--;
    }
    i++;
    while (s[i] <= ' ' && s[i] != 0)
      i++;
    mode--;
  }
  return (i);
}

/*
  find searches for the string f in s
    mode = 0 matches anywhere in the string
    mode = 1 matches only if delimitted
    mode = 2 matches only if delimitted and on the left of an equal sign
             or a sole argument in parenthesis
    mode = 3 matches only if not in parenthesis
    mode = <0 matches only if at the beginning of string
    delimitters are (non-alpha and non-digit and underscore)
*/

int find(const char *s, const char *f, int mode)
{
  int             i, j, paren = 0, quote = 0, lf;

  for (i = 0; s[i] != 0; i++) {

    if (s[i] == f[0] && quote == 0) {
      for (j = 1; f[j] != 0; j++)
	if (s[i + j] != f[j])
	  goto NOMATCH;
      if (mode == 0)
	return (i);
      else if (mode == 3 && paren == 0)
	return (i);
      else if (abs(mode) == 1) {
        if ((i == 0 || type[int(s[i - 1])] <= 0) && type[int(s[i + j])] <= 0)
	  return (i);
      }
      else if (abs(mode) == 2) {
        if ((i == 0 || type[int(s[i - 1])] <= 0) && type[int(s[i + j])] <= 0) {
	  lf = strlen(f);
	  j = i + lf;
	  if (s[j] == ' ')
	    j++;
	  if (s[j] == '=')
	    return (i);
	  if (paren > 0 && (s[j] == ',' || s[j] == ')')) {
	    j = i - 1;
	    if (s[j] == ' ')
	      j--;
	    if (s[j] == ',' || s[j] == '(')
	      return (i);
	  }
	}
      }
    }
NOMATCH:;
    if (s[i] == TIC)
      quote = 1 - quote;
    else if (s[i] == LPAR)
      paren += 1;
    else if (s[i] == RPAR)
      paren -= 1;
    if (mode < 0)
      return (-1);
  }
  return (-1);
}

void replace(char *s, int i, int j, char *sc, const char *r)
{
  int             lr, k, diff;

  lr = strlen(r);
  diff = lr - (j - i);

  if (diff > 0) {
    k = strlen(s);
    do {
      s[k + diff] = s[k];
      sc[k + diff] = sc[k];
    } while ((k--) > j);
    for (k = 0; k < lr; k++)
      s[k + i] = sc[k + i] = r[k];
  }
  else if (diff < 0) {
    for (k = 0; k < lr; k++)
      s[k + i] = sc[k + i] = r[k];
    do {
      s[j + diff] = s[j];
      sc[j + diff] = sc[j];
    } while (s[j++] != 0);
  }
  else {
    for (k = 0; k < lr; k++)
      s[k + i] = sc[k + i] = r[k];
  }
}

int sub(char *s, const char *ro, int mode, char *sc, const char *rn)
{
  int             i, j, n;

  n = 0;
  j = strlen(ro);

  while ((i = find(s, ro, mode)) >= 0) {
    replace(s, i, i + j, sc, rn);
    n++;
    if (mode < 0)
      return (n);
  }

  return (n);
}


int parse(char *s, const char *s1, const char *s2, char *r)
{
  int             i, j;

  r[0] = 0;
  if ((i = find(s, s1, 0)) < 0)
    return (0);
  for (i++; s[i] <= ' '; i++);
  if ((j = i + find(s + i, s2, 0)) < 0)
    j = strlen(s);
  for (; s[j - 1] <= ' '; j--);
  sprintf(r, "%.*s", j - i, s + i);
  return (j - i);
}
