/* Output from p2c, the Pascal-to-C translator */
/* From input file "formJ.p" */

/* to simplify portability, the files p2c.h and p2clib.c are
   included here explicitly, replacing #include <p2c/p2c.h> */


/* the following is p2c.h, copied here for convenience */

#ifndef P2C_H
#define P2C_H


/* Header file for code generated by "p2c", the Pascal-to-C translator */

/* "p2c"  Copyright (C) 1989 Dave Gillespie, version 1.16.
 * This file may be copied, modified, etc. in any way.  It is not restricted
 * by the licence agreement accompanying p2c itself.
 */


#include <stdio.h>



/* If the following heuristic fails, compile -DBSD=0 for non-BSD systems,
   or -DBSD=1 for BSD systems. */

#ifdef M_XENIX
# define BSD 0
#endif

#ifdef FILE       /* a #define in BSD, a typedef in SYSV (hp-ux, at least) */
# ifndef BSD	  /*  (a convenient, but horrible kludge!) */
#  define BSD 1
# endif
#endif

#ifdef BSD
# if !BSD
#  undef BSD
# endif
#endif


#ifdef __STDC__
# include <stddef.h>
# include <stdlib.h>
# define HAS_STDLIB
# define __CAT__(a,b)a##b
#else
# ifndef BSD
#  include <memory.h>
# endif
# include <sys/types.h>
# define __ID__(a)a
# define __CAT__(a,b)__ID__(a)b
#endif


#ifdef BSD
# include <strings.h>
# define memcpy(a,b,n) (bcopy(b,a,n),a)
# define memcmp(a,b,n) bcmp(a,b,n)
# define strchr(s,c) index(s,c)
# define strrchr(s,c) rindex(s,c)
#else
# include <string.h>
#endif

#include <ctype.h>
#include <math.h>
#include <setjmp.h>
#include <assert.h>


typedef struct __p2c_jmp_buf {
    struct __p2c_jmp_buf *next;
    jmp_buf jbuf;
} __p2c_jmp_buf;


/* Warning: The following will not work if setjmp is used simultaneously.
   This also violates the ANSI restriction about using vars after longjmp,
   but a typical implementation of longjmp will get it right anyway. */

#ifndef FAKE_TRY
# define TRY(x)         do { __p2c_jmp_buf __try_jb;  \
			     __try_jb.next = __top_jb;  \
			     if (!setjmp((__top_jb = &__try_jb)->jbuf)) {
# define RECOVER(x)	__top_jb = __try_jb.next; } else {
# define RECOVER2(x,L)  __top_jb = __try_jb.next; } else {  \
			     if (0) { L: __top_jb = __try_jb.next; }
# define ENDTRY(x)      } } while (0) 
#else
# define TRY(x)         if (1) {
# define RECOVER(x)     } else do {
# define RECOVER2(x,L)  } else do { L: ;
# define ENDTRY(x)      } while (0)
#endif



#ifdef M_XENIX  /* avoid compiler bug */
# define SHORT_MAX  (32767)
# define SHORT_MIN  (-32768)
#endif


/* The following definitions work only on twos-complement machines */
#ifndef SHORT_MAX
# define SHORT_MAX  (((unsigned short) -1) >> 1)
# define SHORT_MIN  (~SHORT_MAX)
#endif

#ifndef INT_MAX
# define INT_MAX    (((unsigned int) -1) >> 1)
# define INT_MIN    (~INT_MAX)
#endif

#ifndef LONG_MAX
# define LONG_MAX   (((unsigned long) -1) >> 1)
# define LONG_MIN   (~LONG_MAX)
#endif

#ifndef SEEK_SET
# define SEEK_SET   0
# define SEEK_CUR   1
# define SEEK_END   2
#endif

#ifndef EXIT_SUCCESS
# define EXIT_SUCCESS  0
# define EXIT_FAILURE  1
#endif


#define SETBITS  32


#ifdef __STDC__
# define Signed     signed
# define Void       void      /* Void f() = procedure */
# ifndef Const
#  define Const     const
# endif
# ifndef Volatile
# define Volatile  volatile
# endif
# define PP(x)      x         /* function prototype */
# define PV()       (void)    /* null function prototype */
typedef void *Anyptr;
#else
# define Signed
# define Void       void
# ifndef Const
#  define Const
# endif
# ifndef Volatile
#  define Volatile
# endif
# define PP(x)      ()
# define PV()       ()
typedef char *Anyptr;
#endif

#ifdef __GNUC__
# define Inline     inline
#else
# define Inline
#endif

#define Register    register  /* Register variables */
#define Char        char      /* Characters (not bytes) */

#ifndef Static
# define Static     static    /* Private global funcs and vars */
#endif

#ifndef Local
# define Local      static    /* Nested functions */
#endif

typedef Signed   char schar;
typedef unsigned char uchar;
typedef unsigned char boolean;

#ifndef true
# define true    1
# define false   0
#endif


typedef struct {
    Anyptr proc, link;
} _PROCEDURE;

#ifndef _FNSIZE
# define _FNSIZE  120
#endif


extern Void    PASCAL_MAIN  PP( (int, Char **) );
extern Char    **P_argv;
extern int     P_argc;
extern short   P_escapecode;
extern int     P_ioresult;
extern __p2c_jmp_buf *__top_jb;


#ifdef P2C_H_PROTO   /* if you have Ansi C but non-prototyped header files */
extern Char    *strcat      PP( (Char *, Const Char *) );
extern Char    *strchr      PP( (Const Char *, int) );
extern int      strcmp      PP( (Const Char *, Const Char *) );
extern Char    *strcpy      PP( (Char *, Const Char *) );
extern size_t   strlen      PP( (Const Char *) );
extern Char    *strncat     PP( (Char *, Const Char *, size_t) );
extern int      strncmp     PP( (Const Char *, Const Char *, size_t) );
extern Char    *strncpy     PP( (Char *, Const Char *, size_t) );
extern Char    *strrchr     PP( (Const Char *, int) );

extern Anyptr   memchr      PP( (Const Anyptr, int, size_t) );
extern Anyptr   memmove     PP( (Anyptr, Const Anyptr, size_t) );
extern Anyptr   memset      PP( (Anyptr, int, size_t) );
#ifndef memcpy
extern Anyptr   memcpy      PP( (Anyptr, Const Anyptr, size_t) );
extern int      memcmp      PP( (Const Anyptr, Const Anyptr, size_t) );
#endif

extern int      atoi        PP( (Const Char *) );
extern double   atof        PP( (Const Char *) );
extern long     atol        PP( (Const Char *) );
extern double   strtod      PP( (Const Char *, Char **) );
extern long     strtol      PP( (Const Char *, Char **, int) );
#endif /*P2C_H_PROTO*/

#ifndef HAS_STDLIB
extern Anyptr   malloc      PP( (size_t) );
extern Void     free        PP( (Anyptr) );
#endif

extern int      _OutMem     PV();
extern int      _CaseCheck  PV();
extern int      _NilCheck   PV();
extern int	_Escape     PP( (int) );
extern int	_EscIO      PP( (int) );

extern long     ipow        PP( (long, long) );
extern Char    *strsub      PP( (Char *, Char *, int, int) );
extern Char    *strltrim    PP( (Char *) );
extern Char    *strrtrim    PP( (Char *) );
extern Char    *strrpt      PP( (Char *, Char *, int) );
extern Char    *strpad      PP( (Char *, Char *, int, int) );
extern int      strpos2     PP( (Char *, Char *, int) );
extern long     memavail    PV();
extern int      P_peek      PP( (FILE *) );
extern int      P_eof       PP( (FILE *) );
extern int      P_eoln      PP( (FILE *) );
extern Void     P_readpaoc  PP( (FILE *, Char *, int) );
extern Void     P_readlnpaoc PP( (FILE *, Char *, int) );
extern long     P_maxpos    PP( (FILE *) );
extern Char    *P_trimname  PP( (Char *, int) );
extern long    *P_setunion  PP( (long *, long *, long *) );
extern long    *P_setint    PP( (long *, long *, long *) );
extern long    *P_setdiff   PP( (long *, long *, long *) );
extern long    *P_setxor    PP( (long *, long *, long *) );
extern int      P_inset     PP( (unsigned, long *) );
extern int      P_setequal  PP( (long *, long *) );
extern int      P_subset    PP( (long *, long *) );
extern long    *P_addset    PP( (long *, unsigned) );
extern long    *P_addsetr   PP( (long *, unsigned, unsigned) );
extern long    *P_remset    PP( (long *, unsigned) );
extern long    *P_setcpy    PP( (long *, long *) );
extern long    *P_expset    PP( (long *, long) );
extern long     P_packset   PP( (long *) );
extern int      P_getcmdline PP( (int l, int h, Char *line) );
extern Void     TimeStamp   PP( (int *Day, int *Month, int *Year,
				 int *Hour, int *Min, int *Sec) );
extern Void	P_sun_argv  PP( (char *, int, int) );


/* I/O error handling */
#define _CHKIO(cond,ior,val,def)  ((cond) ? P_ioresult=0,(val)  \
					  : P_ioresult=(ior),(def))
#define _SETIO(cond,ior)          (P_ioresult = (cond) ? 0 : (ior))

/* Following defines are suitable for the HP Pascal operating system */
#define FileNotFound     10
#define FileNotOpen      13
#define FileWriteError   38
#define BadInputFormat   14
#define EndOfFile        30

/* Creating temporary files */
#if (defined(BSD) || defined(NO_TMPFILE)) && !defined(HAVE_TMPFILE)
# define tmpfile()  (fopen(tmpnam(NULL), "w+"))
#endif

/* File buffers */
#define FILEBUF(f,sc,type) sc int __CAT__(f,_BFLAGS);   \
			   sc type __CAT__(f,_BUFFER)

#define RESETBUF(f,type)   (__CAT__(f,_BFLAGS) = 1)
#define SETUPBUF(f,type)   (__CAT__(f,_BFLAGS) = 0)

#define GETFBUF(f,type)    (*((__CAT__(f,_BFLAGS) == 1 &&   \
			       ((__CAT__(f,_BFLAGS) = 2),   \
				fread(&__CAT__(f,_BUFFER),  \
				      sizeof(type),1,(f)))),\
			      &__CAT__(f,_BUFFER)))
#define AGETFBUF(f,type)   ((__CAT__(f,_BFLAGS) == 1 &&   \
			     ((__CAT__(f,_BFLAGS) = 2),   \
			      fread(&__CAT__(f,_BUFFER),  \
				    sizeof(type),1,(f)))),\
			    __CAT__(f,_BUFFER))

#define PUTFBUF(f,type,v)  (GETFBUF(f,type) = (v))
#define CPUTFBUF(f,v)      (PUTFBUF(f,char,v))
#define APUTFBUF(f,type,v) (memcpy(GETFBUF(f,type), (v),  \
				   sizeof(__CAT__(f,_BUFFER))))

#define GET(f,type)        (__CAT__(f,_BFLAGS) == 1 ?   \
			    fread(&__CAT__(f,_BUFFER),sizeof(type),1,(f)) :  \
			    (__CAT__(f,_BFLAGS) = 1))

#define PUT(f,type)        (fwrite(&__CAT__(f,_BUFFER),sizeof(type),1,(f)),  \
			    (__CAT__(f,_BFLAGS) = 0))
#define CPUT(f)            (PUT(f,char))

#define BUFEOF(f)	   (__CAT__(f,_BFLAGS) != 2 && P_eof(f))
#define BUFFPOS(f)	   (ftell(f) - (__CAT__(f,_BFLAGS) == 2))

/* Memory allocation */
#ifdef __GCC__
# define Malloc(n)  (malloc(n) ?: (Anyptr)_OutMem())
#else
extern Anyptr __MallocTemp__;
# define Malloc(n)  ((__MallocTemp__ = malloc(n)) ? __MallocTemp__ : (Anyptr)_OutMem())
#endif
#define FreeR(p)    (free((Anyptr)(p)))    /* used if arg is an rvalue */
#define Free(p)     (free((Anyptr)(p)), (p)=NULL)

/* sign extension */
#define SEXT(x,n)   ((x) | -(((x) & (1L<<((n)-1))) << 1))

/* packed arrays */   /* BEWARE: these are untested! */
#define P_getbits_UB(a,i,n,L)   ((int)((a)[(i)>>(L)-(n)] >>   \
				       (((~(i))&((1<<(L)-(n))-1)) << (n)) &  \
				       (1<<(1<<(n)))-1))

#define P_getbits_SB(a,i,n,L)   ((int)((a)[(i)>>(L)-(n)] <<   \
				       (16 - ((((~(i))&((1<<(L)-(n))-1))+1) <<\
					      (n)) >> (16-(1<<(n))))))

#define P_putbits_UB(a,i,x,n,L) ((a)[(i)>>(L)-(n)] |=   \
				 (x) << (((~(i))&((1<<(L)-(n))-1)) << (n)))

#define P_putbits_SB(a,i,x,n,L) ((a)[(i)>>(L)-(n)] |=   \
				 ((x) & (1<<(1<<(n)))-1) <<   \
				 (((~(i))&((1<<(L)-(n))-1)) << (n)))

#define P_clrbits_B(a,i,n,L)    ((a)[(i)>>(L)-(n)] &=   \
				 ~( ((1<<(1<<(n)))-1) <<   \
				   (((~(i))&((1<<(L)-(n))-1)) << (n))) )

/* small packed arrays */
#define P_getbits_US(v,i,n)     ((int)((v) >> ((i)<<(n)) & (1<<(1<<(n)))-1))
#define P_getbits_SS(v,i,n)     ((int)((long)(v) << (SETBITS - (((i)+1) << (n))) >> (SETBITS-(1<<(n)))))
#define P_putbits_US(v,i,x,n)   ((v) |= (x) << ((i) << (n)))
#define P_putbits_SS(v,i,x,n)   ((v) |= ((x) & (1<<(1<<(n)))-1) << ((i)<<(n)))
#define P_clrbits_S(v,i,n)      ((v) &= ~( ((1<<(1<<(n)))-1) << ((i)<<(n)) ))

#define P_max(a,b)   ((a) > (b) ? (a) : (b))
#define P_min(a,b)   ((a) < (b) ? (a) : (b))


/* Fix toupper/tolower on Suns and other stupid BSD systems */
#ifdef toupper
# undef toupper
# undef tolower
# define toupper(c)   my_toupper(c)
# define tolower(c)   my_tolower(c)
#endif

#ifndef _toupper
# if 'A' == 65 && 'a' == 97
#  define _toupper(c)  ((c)-'a'+'A')
#  define _tolower(c)  ((c)-'A'+'a')
# else
#  define _toupper(c)  toupper(c)
#  define _tolower(c)  tolower(c)
# endif
#endif


#endif    /* P2C_H */



/* End. */


/* end of p2c.h */


/* the following is p2clib.c */

/* Run-time library for use with "p2c", the Pascal to C translator */

/* "p2c"  Copyright (C) 1989 Dave Gillespie.
 * This file may be copied, modified, etc. in any way.  It is not restricted
 * by the licence agreement accompanying p2c itself.
 */


/* #define LACK_LABS     */   /* Define these if necessary */
/* #define LACK_MEMMOVE  */


#ifndef NO_TIME
# include <time.h>
#endif


#define Isspace(c)  isspace(c)      /* or "((c) == ' ')" if preferred */




int P_argc;
char **P_argv;

short P_escapecode;
int P_ioresult;

long EXCP_LINE;    /* Used by Pascal workstation system */

Anyptr __MallocTemp__;

__p2c_jmp_buf *__top_jb;




void PASCAL_MAIN(argc, argv)
int argc;
char **argv;
{
    P_argc = argc;
    P_argv = argv;
    __top_jb = NULL;

#ifdef LOCAL_INIT
    LOCAL_INIT();
#endif
}





/* In case your system lacks these... */

#ifdef LACK_LABS
long labs(x)
long x;
{
    return((x > 0) ? x : -x);
}
#endif


#ifdef LACK_MEMMOVE
Anyptr memmove(d, s, n)
Anyptr d, s;
register long n;
{
    if (d < s || d - s >= n) {
	memcpy(d, s, n);
	return d;
    } else if (n > 0) {
	register char *dd = d + n, *ss = s + n;
	while (--n >= 0)
	    *--dd = *--ss;
    }
    return d;
}
#endif


int my_toupper(c)
int c;
{
    if (islower(c))
	return _toupper(c);
    else
	return c;
}


int my_tolower(c)
int c;
{
    if (isupper(c))
	return _tolower(c);
    else
	return c;
}




long ipow(a, b)
long a, b;
{
    long v;

    if (a == 0 || a == 1)
	return a;
    if (a == -1)
	return (b & 1) ? -1 : 1;
    if (b < 0)
	return 0;
    if (a == 2)
	return 1 << b;
    v = (b & 1) ? a : 1;
    while ((b >>= 1) > 0) {
	a *= a;
	if (b & 1)
	    v *= a;
    }
    return v;
}




/* Common string functions: */

/* Store in "ret" the substring of length "len" starting from "pos" (1-based).
   Store a shorter or null string if out-of-range.  Return "ret". */

char *strsub(ret, s, pos, len)
register char *ret, *s;
register int pos, len;
{
    register char *s2;

    if (--pos < 0 || len <= 0) {
        *ret = 0;
        return ret;
    }
    while (pos > 0) {
        if (!*s++) {
            *ret = 0;
            return ret;
        }
        pos--;
    }
    s2 = ret;
    while (--len >= 0) {
        if (!(*s2++ = *s++))
            return ret;
    }
    *s2 = 0;
    return ret;
}


/* Return the index of the first occurrence of "pat" as a substring of "s",
   starting at index "pos" (1-based).  Result is 1-based, 0 if not found. */

int strpos2(s, pat, pos)
char *s;
register char *pat;
register int pos;
{
    register char *cp, ch;
    register int slen;

    if (--pos < 0)
        return 0;
    slen = strlen(s) - pos;
    cp = s + pos;
    if (!(ch = *pat++))
        return 0;
    pos = strlen(pat);
    slen -= pos;
    while (--slen >= 0) {
        if (*cp++ == ch && !strncmp(cp, pat, pos))
            return cp - s;
    }
    return 0;
}


/* Case-insensitive version of strcmp. */

int strcicmp(s1, s2)
register char *s1, *s2;
{
    register unsigned char c1, c2;

    while (*s1) {
	if (*s1++ != *s2++) {
	    if (!s2[-1])
		return 1;
	    c1 = toupper(s1[-1]);
	    c2 = toupper(s2[-1]);
	    if (c1 != c2)
		return c1 - c2;
	}
    }
    if (*s2)
	return -1;
    return 0;
}




/* HP and Turbo Pascal string functions: */

/* Trim blanks at left end of string. */

char *strltrim(s)
register char *s;
{
    while (Isspace(*s++)) ;
    return s - 1;
}


/* Trim blanks at right end of string. */

char *strrtrim(s)
register char *s;
{
    register char *s2 = s;

    if (!*s)
	return s;
    while (*++s2) ;
    while (s2 > s && Isspace(*--s2))
        *s2 = 0;
    return s;
}


/* Store in "ret" "num" copies of string "s".  Return "ret". */

char *strrpt(ret, s, num)
char *ret;
register char *s;
register int num;
{
    register char *s2 = ret;
    register char *s1;

    while (--num >= 0) {
        s1 = s;
        while ((*s2++ = *s1++)) ;
        s2--;
    }
    return ret;
}


/* Store in "ret" string "s" with enough pad chars added to reach "size". */

char *strpad(ret, s, padchar, num)
char *ret;
register char *s;
register int padchar, num;
{
    register char *d = ret;

    if (s == d) {
	while (*d++) ;
    } else {
	while ((*d++ = *s++)) ;
    }
    num -= (--d - ret);
    while (--num >= 0)
	*d++ = padchar;
    *d = 0;
    return ret;
}


/* Copy the substring of length "len" from index "spos" of "s" (1-based)
   to index "dpos" of "d", lengthening "d" if necessary.  Length and
   indices must be in-range. */

void strmove(len, s, spos, d, dpos)
register char *s, *d;
register int len, spos, dpos;
{
    s += spos - 1;
    d += dpos - 1;
    while (*d && --len >= 0)
	*d++ = *s++;
    if (len > 0) {
	while (--len >= 0)
	    *d++ = *s++;
	*d = 0;
    }
}


/* Delete the substring of length "len" at index "pos" from "s".
   Delete less if out-of-range. */

void strdelete(s, pos, len)
register char *s;
register int pos, len;
{
    register int slen;

    if (--pos < 0)
        return;
    slen = strlen(s) - pos;
    if (slen <= 0)
        return;
    s += pos;
    if (slen <= len) {
        *s = 0;
        return;
    }
    while ((*s = s[len])) s++;
}


/* Insert string "src" at index "pos" of "dst". */

void strinsert(src, dst, pos)
register char *src, *dst;
register int pos;
{
    register int slen, dlen;

    if (--pos < 0)
        return;
    dlen = strlen(dst);
    dst += dlen;
    dlen -= pos;
    if (dlen <= 0) {
        strcpy(dst, src);
        return;
    }
    slen = strlen(src);
    do {
        dst[slen] = *dst;
        --dst;
    } while (--dlen >= 0);
    dst++;
    while (--slen >= 0)
        *dst++ = *src++;
}




/* File functions */

/* Peek at next character of input stream; return EOF at end-of-file. */

int P_peek(f)
FILE *f;
{
    int ch;

    ch = getc(f);
    if (ch == EOF)
	return EOF;
    ungetc(ch, f);
    return (ch == '\n') ? ' ' : ch;
}


/* Check if at end of file, using Pascal "eof" semantics.  End-of-file for
   stdin is broken; remove the special case for it to be broken in a
   different way. */

int P_eof(f)
FILE *f;
{
    register int ch;

    if (feof(f))
	return 1;
    if (f == stdin)
	return 0;    /* not safe to look-ahead on the keyboard! */
    ch = getc(f);
    if (ch == EOF)
	return 1;
    ungetc(ch, f);
    return 0;
}


/* Check if at end of line (or end of entire file). */

int P_eoln(f)
FILE *f;
{
    register int ch;

    ch = getc(f);
    if (ch == EOF)
        return 1;
    ungetc(ch, f);
    return (ch == '\n');
}


/* Read a packed array of characters from a file. */

Void P_readpaoc(f, s, len)
FILE *f;
char *s;
int len;
{
    int ch;

    for (;;) {
	if (len <= 0)
	    return;
	ch = getc(f);
	if (ch == EOF || ch == '\n')
	    break;
	*s++ = ch;
	--len;
    }
    while (--len >= 0)
	*s++ = ' ';
    if (ch != EOF)
	ungetc(ch, f);
}

Void P_readlnpaoc(f, s, len)
FILE *f;
char *s;
int len;
{
    int ch;

    for (;;) {
	ch = getc(f);
	if (ch == EOF || ch == '\n')
	    break;
	if (len > 0) {
	    *s++ = ch;
	    --len;
	}
    }
    while (--len >= 0)
	*s++ = ' ';
}


/* Compute maximum legal "seek" index in file (0-based). */

long P_maxpos(f)
FILE *f;
{
    long savepos = ftell(f);
    long val;

    if (fseek(f, 0L, SEEK_END))
        return -1;
    val = ftell(f);
    if (fseek(f, savepos, SEEK_SET))
        return -1;
    return val;
}


/* Use packed array of char for a file name. */

Char *P_trimname(fn, len)
register Char *fn;
register int len;
{
    static Char fnbuf[256];
    register Char *cp = fnbuf;
    
    while (--len >= 0 && *fn && !isspace(*fn))
	*cp++ = *fn++;
    return fnbuf;
}




/* Pascal's "memavail" doesn't make much sense in Unix with virtual memory.
   We fix memory size as 10Meg as a reasonable compromise. */

long memavail()
{
    return 10000000;            /* worry about this later! */
}

long maxavail()
{
    return memavail();
}




/* Sets are stored as an array of longs.  S[0] is the size of the set;
   S[N] is the N'th 32-bit chunk of the set.  S[0] equals the maximum
   I such that S[I] is nonzero.  S[0] is zero for an empty set.  Within
   each long, bits are packed from lsb to msb.  The first bit of the
   set is the element with ordinal value 0.  (Thus, for a "set of 5..99",
   the lowest five bits of the first long are unused and always zero.) */

/* (Sets with 32 or fewer elements are normally stored as plain longs.) */

long *P_setunion(d, s1, s2)         /* d := s1 + s2 */
register long *d, *s1, *s2;
{
    long *dbase = d++;
    register int sz1 = *s1++, sz2 = *s2++;
    while (sz1 > 0 && sz2 > 0) {
        *d++ = *s1++ | *s2++;
	sz1--, sz2--;
    }
    while (--sz1 >= 0)
	*d++ = *s1++;
    while (--sz2 >= 0)
	*d++ = *s2++;
    *dbase = d - dbase - 1;
    return dbase;
}


long *P_setint(d, s1, s2)           /* d := s1 * s2 */
register long *d, *s1, *s2;
{
    long *dbase = d++;
    register int sz1 = *s1++, sz2 = *s2++;
    while (--sz1 >= 0 && --sz2 >= 0)
        *d++ = *s1++ & *s2++;
    while (--d > dbase && !*d) ;
    *dbase = d - dbase;
    return dbase;
}


long *P_setdiff(d, s1, s2)          /* d := s1 - s2 */
register long *d, *s1, *s2;
{
    long *dbase = d++;
    register int sz1 = *s1++, sz2 = *s2++;
    while (--sz1 >= 0 && --sz2 >= 0)
        *d++ = *s1++ & ~*s2++;
    if (sz1 >= 0) {
        while (sz1-- >= 0)
            *d++ = *s1++;
    }
    while (--d > dbase && !*d) ;
    *dbase = d - dbase;
    return dbase;
}


long *P_setxor(d, s1, s2)         /* d := s1 / s2 */
register long *d, *s1, *s2;
{
    long *dbase = d++;
    register int sz1 = *s1++, sz2 = *s2++;
    while (sz1 > 0 && sz2 > 0) {
        *d++ = *s1++ ^ *s2++;
	sz1--, sz2--;
    }
    while (--sz1 >= 0)
	*d++ = *s1++;
    while (--sz2 >= 0)
	*d++ = *s2++;
    while (--d > dbase && !*d) ;
    *dbase = d - dbase;
    return dbase;
}


int P_inset(val, s)                 /* val IN s */
register unsigned val;
register long *s;
{
    register int bit;
    bit = val % SETBITS;
    val /= SETBITS;
    if (val < *s++ && ((1<<bit) & s[val]))
	return 1;
    return 0;
}


long *P_addset(s, val)              /* s := s + [val] */
register long *s;
register unsigned val;
{
    register long *sbase = s;
    register int bit, size;
    bit = val % SETBITS;
    val /= SETBITS;
    size = *s;
    if (++val > size) {
        s += size;
        while (val > size)
            *++s = 0, size++;
        *sbase = size;
    } else
        s += val;
    *s |= 1<<bit;
    return sbase;
}


long *P_addsetr(s, v1, v2)              /* s := s + [v1..v2] */
register long *s;
register unsigned v1, v2;
{
    register long *sbase = s;
    register int b1, b2, size;
    if ((int)v1 > (int)v2)
	return sbase;
    b1 = v1 % SETBITS;
    v1 /= SETBITS;
    b2 = v2 % SETBITS;
    v2 /= SETBITS;
    size = *s;
    v1++;
    if (++v2 > size) {
        while (v2 > size)
            s[++size] = 0;
        s[v2] = 0;
        *s = v2;
    }
    s += v1;
    if (v1 == v2) {
        *s |= (~((-2)<<(b2-b1))) << b1;
    } else {
        *s++ |= (-1) << b1;
        while (++v1 < v2)
            *s++ = -1;
        *s |= ~((-2) << b2);
    }
    return sbase;
}


long *P_remset(s, val)              /* s := s - [val] */
register long *s;
register unsigned val;
{
    register int bit;
    bit = val % SETBITS;
    val /= SETBITS;
    if (++val <= *s) {
	if (!(s[val] &= ~(1<<bit)))
	    while (*s && !s[*s])
		(*s)--;
    }
    return s;
}


int P_setequal(s1, s2)              /* s1 = s2 */
register long *s1, *s2;
{
    register int size = *s1++;
    if (*s2++ != size)
        return 0;
    while (--size >= 0) {
        if (*s1++ != *s2++)
            return 0;
    }
    return 1;
}


int P_subset(s1, s2)                /* s1 <= s2 */
register long *s1, *s2;
{
    register int sz1 = *s1++, sz2 = *s2++;
    if (sz1 > sz2)
        return 0;
    while (--sz1 >= 0) {
        if (*s1++ & ~*s2++)
            return 0;
    }
    return 1;
}


long *P_setcpy(d, s)                /* d := s */
register long *d, *s;
{
    register long *save_d = d;

#ifdef SETCPY_MEMCPY
    memcpy(d, s, (*s + 1) * sizeof(long));
#else
    register int i = *s + 1;
    while (--i >= 0)
        *d++ = *s++;
#endif
    return save_d;
}


/* s is a "smallset", i.e., a 32-bit or less set stored
   directly in a long. */

long *P_expset(d, s)                /* d := s */
register long *d;
register long s;
{
    if (s) {
	d[1] = s;
	*d = 1;
    } else
        *d = 0;
    return d;
}


long P_packset(s)                   /* convert s to a small-set */
register long *s;
{
    if (*s++)
        return *s;
    else
        return 0;
}





/* Oregon Software Pascal extensions, courtesy of William Bader */

int P_getcmdline(l, h, line)
int l, h;
Char *line;
{
    int i, len;
    char *s;
    
    h = h - l + 1;
    len = 0;
    for(i = 1; i < P_argc; i++) {
	s = P_argv[i];
	while (*s) {
	    if (len >= h) return len;
	    line[len++] = *s++;
	}
	if (len >= h) return len;
	line[len++] = ' ';
    }
    return len;
}

Void TimeStamp(Day, Month, Year, Hour, Min, Sec)
int *Day, *Month, *Year, *Hour, *Min, *Sec;
{
#ifndef NO_TIME
    struct tm *tm;
    long clock;

    time(&clock);
    tm = localtime(&clock);
    *Day = tm->tm_mday;
    *Month = tm->tm_mon + 1;		/* Jan = 0 */
    *Year = tm->tm_year;
    if (*Year < 1900)
	*Year += 1900;     /* year since 1900 */
    *Hour = tm->tm_hour;
    *Min = tm->tm_min;
    *Sec = tm->tm_sec;
#endif
}




/* SUN Berkeley Pascal extensions */

Void P_sun_argv(s, len, n)
register char *s;
register int len, n;
{
    register char *cp;

    if ((unsigned)n < P_argc)
	cp = P_argv[n];
    else
	cp = "";
    while (*cp && --len >= 0)
	*s++ = *cp++;
    while (--len >= 0)
	*s++ = ' ';
}




int _OutMem()
{
    return _Escape(-2);
}

int _CaseCheck()
{
    return _Escape(-9);
}

int _NilCheck()
{
    return _Escape(-3);
}





/* The following is suitable for the HP Pascal operating system.
   It might want to be revised when emulating another system. */

char *_ShowEscape(buf, code, ior, prefix)
char *buf, *prefix;
int code, ior;
{
    char *bufp;

    if (prefix && *prefix) {
        strcpy(buf, prefix);
	strcat(buf, ": ");
        bufp = buf + strlen(buf);
    } else {
        bufp = buf;
    }
    if (code == -10) {
        sprintf(bufp, "Pascal system I/O error %d", ior);
        switch (ior) {
            case 3:
                strcat(buf, " (illegal I/O request)");
                break;
            case 7:
                strcat(buf, " (bad file name)");
                break;
            case FileNotFound:   /*10*/
                strcat(buf, " (file not found)");
                break;
            case FileNotOpen:    /*13*/
                strcat(buf, " (file not open)");
                break;
            case BadInputFormat: /*14*/
                strcat(buf, " (bad input format)");
                break;
            case 24:
                strcat(buf, " (not open for reading)");
                break;
            case 25:
                strcat(buf, " (not open for writing)");
                break;
            case 26:
                strcat(buf, " (not open for direct access)");
                break;
            case 28:
                strcat(buf, " (string subscript out of range)");
                break;
            case EndOfFile:      /*30*/
                strcat(buf, " (end-of-file)");
                break;
            case FileWriteError: /*38*/
		strcat(buf, " (file write error)");
		break;
        }
    } else {
        sprintf(bufp, "Pascal system error %d", code);
        switch (code) {
            case -2:
                strcat(buf, " (out of memory)");
                break;
            case -3:
                strcat(buf, " (reference to NIL pointer)");
                break;
            case -4:
                strcat(buf, " (integer overflow)");
                break;
            case -5:
                strcat(buf, " (divide by zero)");
                break;
            case -6:
                strcat(buf, " (real math overflow)");
                break;
            case -8:
                strcat(buf, " (value range error)");
                break;
            case -9:
                strcat(buf, " (CASE value range error)");
                break;
            case -12:
                strcat(buf, " (bus error)");
                break;
            case -20:
                strcat(buf, " (stopped by user)");
                break;
        }
    }
    return buf;
}


int _Escape(code)
int code;
{
    char buf[100];

    P_escapecode = code;
    if (__top_jb) {
	__p2c_jmp_buf *jb = __top_jb;
	__top_jb = jb->next;
	longjmp(jb->jbuf, 1);
    }
    if (code == 0)
        exit(0);
    if (code == -1)
        exit(1);
    fprintf(stderr, "%s\n", _ShowEscape(buf, P_escapecode, P_ioresult, ""));
    exit(1);
}

int _EscIO(code)
int code;
{
    P_ioresult = code;
    return _Escape(-10);
}




/* End. */

/* end of p2clib.c */


/* version H: Sun Oct 16 03:27:50 EDT 1988 */

/* copyright Prof. K. Steiglitz
            Dept. of Computer Science
            Princeton University
            Princeton, NJ 08544 */

/* generates input file for meteor */

/* Constraint-based design of linear-phase fir filters with
   upper and lower bounds, and convexity constraints.
   Finds minimum length, or optimizes fixed length, or pushes band-edges.
   If L is the filter length, the models are

   odd-length
    cosine:   sum ( i from 0 to (L-1)/2 ) coeff[i]*cos(i*omega)
    sine:     sum ( i from 0 to (L-1)/2 ) coeff[i]*sin((i+1)*omega)

   even-length
    cosine:   sum ( i from 0 to L/2-1 ) coeff[i]*cos((i+.5)*omega)
    sine:     sum ( i from 0 to L/2-1 ) coeff[i]*sin((i+.5)*omega)  */

#define Lmax            128   /* filter length */
#define nspecmax        20   /* max. no. of specifications */
#define maxnamelength   10   /* max. length of output file name */


typedef Char name[maxnamelength];


Static FILE *infile, *outfile;
Static name infilename, outfilename;
Static Char ch;
Static boolean gotwhattodo;   /* remembers if we've gotten whattodo */
Static uchar Lsmallest, Llargest;
Static long n;   /* there are n+1 columns from 0 to pi */
Static long i;
Static double result[nspecmax];
Static enum {
  ll, rr
} whichway;
Static char nspec;   /* no. of bands */
Static enum {
  con, lim
} spectype[nspecmax];   /* type of band */
Static double left[nspecmax], right[nspecmax];   /* bandedges as read in */
Static double bound1[nspecmax], bound2[nspecmax];
    /* left and right bounds */
Static Char sense[nspecmax];   /* sense of constraint, + up, - down */
Static Char interpolate[nspecmax];   /* g=geometric, a=arithmetic */
Static Char hug[nspecmax];   /* allow this constraint to be hugged? */
Static enum {
  findlen, maxdist, pushedge
} whattodo;   /* type of optimization */
Static long npushed;   /* number of bandedges pushed */
Static long bandpushed[nspecmax];   /* bandedges pushed */
Static boolean ok;   /* flag to get good input */
Static enum {
  cosine, sine
} symtype;   /* cosine or sine model */


#define maxlinelen      250

#define zero            "0"
#define nine            "9"
#define point           "."
#define blank           " "
#define plus            "+"
#define minus           "-"

#define radix           10.0


typedef Char buffer[maxlinelen];


/* Local variables for getnum: */
struct LOC_getnum {
  long sign;
  char state;
  double scalefactor;
  long length;
  Char ch;
  buffer line;
  boolean digit, invalid;
} ;


Local Void getline(line, length, infile, LINK)
Char *line;
long *length;
FILE **infile;
struct LOC_getnum *LINK;
{
  /* reads a line into buffer */
  Char ch;

  *length = 0;
  while (!P_eoln(*infile)) {
    ch = getc(*infile);
    if (ch == '\n')
      ch = ' ';
    if (*length < maxlinelen) {
      (*length)++;
      line[*length - 1] = ch;
    }
  }
  fscanf(*infile, "%*[^\n]");
  getc(*infile);
}  /* getline */


Local Void scan(r, i, LINK)
double *r;
long *i;
struct LOC_getnum *LINK;
{
  /* scans line buffer for a number r, starting at position i+1 */
  Char STR1[256], STR2[256], STR3[256], STR4[256];

  LINK->state = 0;
  LINK->sign = 1;
  while (*i < LINK->length && LINK->state < 5)   /* finite-state machine */
  {  /* to recognize numbers */
    (*i)++;
    LINK->ch = LINK->line[*i - 1];
    sprintf(STR1, "%c", LINK->ch);
    sprintf(STR2, "%c", LINK->ch);
    LINK->digit = (strcmp(zero, STR1) <= 0) & (strcmp(STR2, nine) <= 0);
    switch (LINK->state) {

    case 0:
      if (LINK->digit) {
	*r = LINK->ch - 48.0;
	LINK->state = 1;
      } else {
	sprintf(STR1, "%c", LINK->ch);
	sprintf(STR2, "%c", LINK->ch);
	if ((strcmp(STR1, plus) == 0) | (strcmp(STR2, minus) == 0)) {
	  sprintf(STR3, "%c", LINK->ch);
	  if (!strcmp(STR3, minus))
	    LINK->sign = -1;
	  LINK->state = 2;
	} else {
	  sprintf(STR3, "%c", LINK->ch);
	  if (!strcmp(STR3, point)) {
	    LINK->scalefactor = radix;
	    LINK->state = 4;
	  } else {
	    sprintf(STR4, "%c", LINK->ch);
	    if (!strcmp(STR4, blank))
	      LINK->state = 0;
	    else
	      LINK->state = 5;
	  }
	}
      }
      break;

    case 1:
      if (LINK->digit)
	*r = *r * radix + LINK->ch - '0';
      else {
	sprintf(STR1, "%c", LINK->ch);
	if (!strcmp(STR1, point)) {
	  LINK->scalefactor = radix;
	  LINK->state = 3;
	} else {
	  sprintf(STR2, "%c", LINK->ch);
	  if (!strcmp(STR2, blank))
	    LINK->state = 6;
	  else
	    LINK->state = 5;
	}
      }
      break;

    case 2:
      if (LINK->digit) {
	*r = LINK->ch - 48.0;
	LINK->state = 1;
      } else {
	sprintf(STR1, "%c", LINK->ch);
	if (!strcmp(STR1, point)) {
	  LINK->scalefactor = radix;
	  LINK->state = 4;
	} else
	  LINK->state = 5;
      }
      break;

    case 3:
      if (LINK->digit) {
	*r += (LINK->ch - '0') / LINK->scalefactor;
	LINK->scalefactor *= radix;
      } else {
	sprintf(STR1, "%c", LINK->ch);
	if (!strcmp(STR1, blank))
	  LINK->state = 6;
	else
	  LINK->state = 5;
      }
      break;

    case 4:
      if (LINK->digit) {
	*r = (LINK->ch - '0') / LINK->scalefactor;
	LINK->scalefactor *= radix;
	LINK->state = 3;
      } else
	LINK->state = 5;
      break;
    }
  }
  switch (LINK->state) {

  case 0:
  case 2:
  case 4:
  case 5:
    LINK->invalid = true;
    break;

  case 1:
  case 3:
  case 6:
    *r = LINK->sign * *r;
    break;
  }
}  /* scan */


Static Void getnum(nnum)
long nnum;
{

  /* finds the first nnum fixed-point numbers in input
     line, puts the numbers in the array called result */
  struct LOC_getnum V;
  long count, pos;
  boolean done;
  FILE *TEMP;


  done = false;
  while (!done) {
    TEMP = stdin;
/* p2c: formJ.p, line 187:
 * Note: Taking address of stdin; consider setting VarFiles = 0 [144] */
    getline(V.line, &V.length, &TEMP, &V);
    count = 1;
    V.invalid = false;
    pos = 0;
    while (count <= nnum && !V.invalid) {
      scan(&result[count - 1], &pos, &V);
      if (!V.invalid) {
	count++;
	if (count > nnum)
	  done = true;
      } else
	printf("input not valid, please try again\n");
    }
  }
}  /* getnum */

#undef maxlinelen
#undef zero
#undef nine
#undef point
#undef blank
#undef plus
#undef minus
#undef radix


Static Void getspec(i)
long i;
{
  /* reads in data for one spec */
  printf("\n       reading data for spec %3ld\n", i);
  printf("enter \"l\" for a limit spec, \"c\" for a convexity spec\n");
  scanf("%c%*[^\n]", &ch);
  getchar();
  if (ch == '\n')
    ch = ' ';
  if (ch == 'c') {
    spectype[i - 1] = con;
    printf("enter \"+\" for convex up, \"-\" for down\n");
    scanf("%c%*[^\n]", &sense[i - 1]);
    getchar();
    if (sense[i - 1] == '\n')
      sense[i - 1] = ' ';
    printf("enter left and right band edges\n");
    getnum(2L);
    left[i - 1] = result[0];
    right[i - 1] = result[1];
  }
  if (ch != 'l')
    return;
  spectype[i - 1] = lim;
  printf("enter \"+\" for upper limit, \"-\" for lower\n");
  scanf("%c%*[^\n]", &sense[i - 1]);
  getchar();
  if (sense[i - 1] == '\n')
    sense[i - 1] = ' ';
  printf("enter \"a\" for arithmetic interpolation, \"g\" for geometric\n");
  scanf("%c%*[^\n]", &interpolate[i - 1]);
  getchar();
  if (interpolate[i - 1] == '\n')
    interpolate[i - 1] = ' ';
  printf("enter \"h\" if this constraint can be hugged/ \"n\" otherwise\n");
  scanf("%c%*[^\n]", &hug[i - 1]);
  getchar();
  if (hug[i - 1] == '\n')
    hug[i - 1] = ' ';
  printf("enter left and right band edges\n");
  getnum(2L);
  left[i - 1] = result[0];
  right[i - 1] = result[1];
  printf("enter bounds at left and right band edges\n");
  getnum(2L);
  bound1[i - 1] = result[0];
  bound2[i - 1] = result[1];
}  /* getspec */


Static Void writefile()
{
  /* writes data to outfile */
  long FORLIM;

  fprintf(outfile, "%12d%12d     smallest and largest length\n",
	  Lsmallest, Llargest);

  if (symtype == cosine)
    fprintf(outfile, "c\n");
  else
    fprintf(outfile, "s\n");

  if (whattodo == pushedge) {
    if (whichway == ll)
      fprintf(outfile, "left     direction of pushed specs\n");
    else
      fprintf(outfile, "right     direction of pushed specs\n");
    fprintf(outfile, "%12ld     number of specs pushed\n", npushed);
    FORLIM = npushed;
    for (i = 1; i <= FORLIM; i++)
      fprintf(outfile, "%12ld", bandpushed[i - 1]);
    fprintf(outfile, "     specs pushed\n");
  }
  if (whattodo == maxdist)
    fprintf(outfile,
	    "neither left nor right: maximize distance from constraints\n");
  fprintf(outfile, "%12ld     number of grid points\n", n);
  FORLIM = nspec;
  for (i = 1; i <= FORLIM; i++) {
    if (spectype[i - 1] == con)
      fprintf(outfile, "convex spec\n");
    else
      fprintf(outfile, "limit spec\n");
    if (spectype[i - 1] == lim) {
      if (sense[i - 1] == '+')
	fprintf(outfile, "+     upper limit\n");
      else
	fprintf(outfile, "-     lower limit\n");
    }
    if (spectype[i - 1] == con) {
      if (sense[i - 1] == '+')
	fprintf(outfile, "+     convex up\n");
      else
	fprintf(outfile, "-     convex down\n");
    }
    if (spectype[i - 1] == lim) {
      if (interpolate[i - 1] == 'a')
	fprintf(outfile, "arithmetic interpolation\n");
      else
	fprintf(outfile, "geometric interpolation\n");
    }
    if (spectype[i - 1] == lim) {
      if (hug[i - 1] == 'h')
	fprintf(outfile, "hugged spec\n");
      else
	fprintf(outfile, "not hugged spec\n");
    }
    fprintf(outfile, "% .5E% .5E     band edges\n", left[i - 1], right[i - 1]);
    if (spectype[i - 1] == lim)
      fprintf(outfile, "% .5E% .5E     bounds\n",
	      bound1[i - 1], bound2[i - 1]);
  }
  fprintf(outfile, "end\n");
}  /* writefile */


Static Void getfilename(filename)
Char *filename;
{
  /* gets name of output file */
  char length;

  length = 0;
  while (!P_eoln(stdin)) {
    ch = getchar();
    if (ch == '\n')
      ch = ' ';
    if (length < maxnamelength - 1) {
      length++;
      filename[length - 1] = ch;
    }
  }
  scanf("%*[^\n]");
  getchar();
}  /* getfilename */


Static Void getwhattodo()
{
  /* gets problem data besides specs: whattodo, Lsmallest, Llargest,
     npushed, bandpushed, n. Meant to be interactive, so doesn't abort. */
  long FORLIM;

  gotwhattodo = true;
  printf("enter \"m\" to find minimum length\n");
  printf("      \"o\" to optimize\n");
  printf("      \"p\" to push a band edge\n");
  scanf("%c%*[^\n]", &ch);
  getchar();
  if (ch == '\n')
    ch = ' ';
  if (ch == 'm')
    whattodo = findlen;
  if (ch == 'o')
    whattodo = maxdist;
  if (ch == 'p')
    whattodo = pushedge;
  if (whattodo == findlen) {
    printf("\n  finding minimum length\n");
    ok = false;
    while (!ok) {
      printf("  enter smallest and largest lengths to be considered\n");
      printf("  both odd, or both even, between 1 and %3ld\n", (long)Lmax);
      getnum(2L);
      Lsmallest = (long)result[0];
      Llargest = (long)result[1];
      if (Lsmallest < 1 || Llargest > Lmax)
	printf("Lsmallest < 1 or Llargest > %3ld; please try again\n",
	       (long)Lmax);
      else {
	if ((Lsmallest & 1) != (Llargest & 1))
	  printf("parity of lengths not the same; please try again\n");
	else
	  ok = true;
      }
    }
  }
  if (whattodo == maxdist) {
    printf("\n  finding solution that maximizes distance from constraints\n");
    ok = false;
    while (!ok) {
      printf("  enter (fixed) filter length, between 1 and %3ld\n",
	     (long)Lmax);
      getnum(1L);
      Lsmallest = (long)result[0];
      Llargest = Lsmallest;
      if (Lsmallest < 1 || Llargest > Lmax)
	printf("length < 1 or length > %3ld; please try again\n", (long)Lmax);
      else
	ok = true;
    }
  }
  if (whattodo == pushedge) {
    printf("\n  pushing edges\n");
    ok = false;
    while (!ok) {
      printf("  enter (fixed) filter length, between 1 and %3ld\n",
	     (long)Lmax);
      getnum(1L);
      Lsmallest = (long)result[0];
      Llargest = Lsmallest;
      if (Lsmallest < 1 || Llargest > Lmax)
	printf("length < 1 or length > %3ld; please try again\n", (long)Lmax);
      else
	ok = true;
    }
    printf("enter \"l\" to push left, or \"r\" to push right\n");
    scanf("%c%*[^\n]", &ch);
    getchar();
    if (ch == '\n')
      ch = ' ';
    if (ch == 'l')
      whichway = ll;
    else
      whichway = rr;
    printf("enter number of bandedges to be pushed\n");
    getnum(1L);
    npushed = (long)result[0];
    printf("enter list of bandedges to be pushed\n");
    getnum(npushed);
    FORLIM = npushed;
    for (i = 1; i <= FORLIM; i++)
      bandpushed[i - 1] = (long)result[i - 1];
  }
  printf("enter \"c\" or \"s\" for cos or sin model (symm. or anti-symm. coeffs.)\n");
  scanf("%c%*[^\n]", &ch);
  getchar();
  if (ch == '\n')
    ch = ' ';
  if (ch == 'c')
    symtype = cosine;
  else
    symtype = sine;
  printf("enter number of grid points less 1\n");
  getnum(1L);
  n = (long)result[0];
}  /* getwhattodo */


Static Void print()
{
  /* prints table of specs and whattodo */
  long FORLIM;

  if (nspec > 0) {
    printf("  # type  sense  edge1    edge2   bound1   bound2  hugged?  interp\n");
    FORLIM = nspec;
    for (i = 1; i <= FORLIM; i++) {
      if (spectype[i - 1] == lim)
	printf("%3ld limit   %c %8.5f %8.5f %8.5f %8.5f     %c        %c\n",
	       i, sense[i - 1], left[i - 1], right[i - 1], bound1[i - 1],
	       bound2[i - 1], hug[i - 1], interpolate[i - 1]);
      if (spectype[i - 1] == con)
	printf("%3ld convex  %c %8.5f %8.5f \n",
	       i, sense[i - 1], left[i - 1], right[i - 1]);
    }
  }
  if (!gotwhattodo)
    return;
  if (whattodo == findlen) {
    printf("    FINDING MIN LENGTH \n");
    if (Lsmallest & 1)
      printf("    ODD LENGTHS from %3d to %3d\n", Lsmallest, Llargest);
    else
      printf("    EVEN LENGTHS from %3d to %3d\n", Lsmallest, Llargest);
  }
  if (whattodo == maxdist)
    printf("    OPTIMIZING, fixed length= %3d\n", Lsmallest);
  if (whattodo == pushedge) {
    if (whichway == ll)
      printf("PUSHING %2ld BANDEDGES LEFT, fixed length= %3d",
	     npushed, Lsmallest);
    if (whichway == rr)
      printf("PUSHING %2ld BANDEDGES RIGHT, fixed length= %3d",
	     npushed, Lsmallest);
    printf(", bands: ");
    FORLIM = npushed;
    for (i = 1; i <= FORLIM; i++)
      printf("%3ld", bandpushed[i - 1]);
    putchar('\n');
  }
  if (symtype == cosine)
    printf("    COSINE model (symmetric coeffs.)\n");
  else
    printf("    SINE model (anti-symmetric coeffs.)\n");
  printf("  %5ld grid points\n", n + 1);
}  /* print */


Static Void delete__(k)
long k;
{
  /* deletes k-th spec */
  long FORLIM;

  FORLIM = nspec;
  for (i = k; i < FORLIM; i++) {
    sense[i - 1] = sense[i];
    left[i - 1] = left[i];
    right[i - 1] = right[i];
    bound1[i - 1] = bound1[i];
    bound2[i - 1] = bound2[i];
    hug[i - 1] = hug[i];
    spectype[i - 1] = spectype[i];
    sense[i - 1] = sense[i];
    left[i - 1] = left[i];
    right[i - 1] = right[i];
  }
  nspec--;
}  /* delete */


Static Void readdata()
{
  /* reads in data from old file */
  /* not meant to be interactive, so aborts on bad filter lengths */
  int TEMP, TEMP1;
  long FORLIM;

  fscanf(infile, "%d%d%*[^\n]", &TEMP, &TEMP1);
  getc(infile);

  Lsmallest = TEMP;
  Llargest = TEMP1;
  fscanf(infile, "%c%*[^\n]", &ch);
  getc(infile);
  if (ch == '\n')
    ch = ' ';
  if (ch == 'c')
    symtype = cosine;
  else
    symtype = sine;

  if ((Lsmallest & 1) != (Llargest & 1)) {
    printf("parity of lengths not the same in input file: quitting\n");
    _Escape(0);
  }

  if (Lsmallest < 1 || Llargest > Lmax) {
    printf("filter length out of range: quitting\n");
    _Escape(0);
  }

  if (Lsmallest != Llargest)
    whattodo = findlen;

  if (Lsmallest == Llargest) {
    fscanf(infile, "%c%*[^\n]", &ch);
    getc(infile);   /* right, left, or neither: edges to be pushed? */
    if (ch == '\n')
      ch = ' ';
    if (ch == 'n')
      whattodo = maxdist;
    else {
      whattodo = pushedge;
      if (ch == 'r')
	whichway = rr;
      else
	whichway = ll;
      fscanf(infile, "%ld%*[^\n]", &npushed);
      getc(infile);
      FORLIM = npushed;
      for (i = 1; i <= FORLIM; i++)
	fscanf(infile, "%ld", &bandpushed[i - 1]);
      fscanf(infile, "%*[^\n]");
      getc(infile);
    }
  }
  gotwhattodo = true;
  fscanf(infile, "%ld%*[^\n]", &n);
  getc(infile);   /* there are n+1 grid points between 0 and pi */
  nspec = 0;
  fscanf(infile, "%c%*[^\n]", &ch);
  getc(infile);
  if (ch == '\n')
    ch = ' ';
  while (ch != 'e') {   /* 'e' for end */
    nspec++;
    i = nspec;
    if (ch == 'c') {
      spectype[i - 1] = con;
      fscanf(infile, "%c%*[^\n]", &sense[i - 1]);
      getc(infile);
      if (sense[i - 1] == '\n')
	sense[i - 1] = ' ';
      fscanf(infile, "%lg%lg%*[^\n]", &left[i - 1], &right[i - 1]);
      getc(infile);
    }
    if (ch == 'l') {
      spectype[i - 1] = lim;
      fscanf(infile, "%c%*[^\n]", &sense[i - 1]);
      getc(infile);
      if (sense[i - 1] == '\n')
	sense[i - 1] = ' ';
      fscanf(infile, "%c%*[^\n]", &interpolate[i - 1]);
      getc(infile);
      if (interpolate[i - 1] == '\n')
	interpolate[i - 1] = ' ';
      fscanf(infile, "%c%*[^\n]", &hug[i - 1]);
      getc(infile);
      if (hug[i - 1] == '\n')
	hug[i - 1] = ' ';
      fscanf(infile, "%lg%lg%*[^\n]", &left[i - 1], &right[i - 1]);
      getc(infile);
      fscanf(infile, "%lg%lg%*[^\n]", &bound1[i - 1], &bound2[i - 1]);
      getc(infile);
    }
    fscanf(infile, "%c%*[^\n]", &ch);
    getc(infile);   /* next */
    if (ch == '\n')
      ch = ' ';
  }  /* while */
}  /* readdata */


main(argc, argv)
int argc;
Char *argv[];
{  /* main */
  Char STR2[256];

  PASCAL_MAIN(argc, argv);
  outfile = NULL;
  infile = NULL;
  printf("WELCOME TO METEOR FORMATTER: GENERATES INPUT FILE FOR METEOR\n\n");
  gotwhattodo = false;
  nspec = 0;
  printf("enter \"y\" if you want to edit an old file\n");
  scanf("%c%*[^\n]", &ch);
  getchar();
  if (ch == '\n')
    ch = ' ';
  if (ch == 'y') {
    printf("enter name of input file, up to %3ld characters\n",
	   (long)maxnamelength);
    getfilename(infilename);
    printf("filename: %.*s\n", maxnamelength, infilename);
    if (infile != NULL) {
      sprintf(STR2, "%.*s", maxnamelength, infilename);
      infile = freopen(STR2, "r", infile);
    } else {
      sprintf(STR2, "%.*s", maxnamelength, infilename);
      infile = fopen(STR2, "r");
    }
    if (infile == NULL)
      _EscIO(FileNotFound);
    readdata();
    print();
  }
  printf("\nenter name of output file, up to %3ld characters\n",
	 (long)maxnamelength);
  getfilename(outfilename);
  while (!strncmp(outfilename, infilename, sizeof(name))) {
    printf("same as infilename, please try again\n");
    getfilename(outfilename);
  }
  printf("filename: %.*s\n", maxnamelength, outfilename);
  if (outfile != NULL) {
    sprintf(STR2, "%.*s", maxnamelength, outfilename);
    outfile = freopen(STR2, "w", outfile);
  } else {
    sprintf(STR2, "%.*s", maxnamelength, outfilename);
    outfile = fopen(STR2, "w");
  }
  if (outfile == NULL)
    _EscIO(FileNotFound);
  ch = 'x';
  while (ch != 'w') {
    printf(" \n");
    printf("enter \"y\" to read spec number %3d\n", nspec + 1);
    printf("      \"p\" to print current information\n");
    printf("      \"r\" to re-enter a spec\n");
    printf("      \"d\" to delete a spec\n");
    printf("      \"s\" to specify what to do\n");
    printf("      \"w\" to write output file and exit\n");
    scanf("%c%*[^\n]", &ch);
    getchar();
    if (ch == '\n')
      ch = ' ';
    if (ch == 'y') {
      nspec++;
      getspec((long)nspec);
    }
    if (ch == 'p')
      print();
    if (ch == 'r') {
      printf("enter number of spec you want to re-enter\n");
      getnum(1L);
      i = (long)result[0];
      getspec(i);
    }
    if (ch == 'd') {
      printf("enter number of spec you want to delete\n");
      getnum(1L);
      i = (long)result[0];
      delete__(i);
    }
    if (ch == 's')
      getwhattodo();
    if (ch != 'w')
      continue;
    if (gotwhattodo && nspec > 0) {
      printf("\nwriting file \"");
      for (i = 1; i <= 10; i++) {
	if (outfilename[i - 1] != ' ')
	  putchar(outfilename[i - 1]);
      }
      printf("\" and exiting\n");
      writefile();
      continue;
    }
    if (!gotwhattodo)
      printf("please specify what to do\n");
    if (nspec == 0)
      printf("please enter some specs\n");
    ch = 'x';   /* don't exit loop */
  }
  if (infile != NULL)
    fclose(infile);
  if (outfile != NULL)
    fclose(outfile);
  exit(0);
}  /* main */






/* End. */

