#include <stdio.h>
#include <errno.h>
#include <ctype.h>
#include <fcntl.h>
#include <regex.h>
#include <limits.h>
#include <stdarg.h>
#include <stdlib.h>
#include <unistd.h>
#include <signal.h>
#include <setjmp.h>
#include <strings.h>
#include <sys/stat.h>
#include <sys/wait.h>
#include <sys/ioctl.h>
#include <parsedate.h>

/* These belong in an include file...but where is it? */
extern int tgetent(char *, const char *);
extern int tgetnum(const char *);

extern const char *__progname;

#include "format.h"
typedef unsigned int FOPT_TYPE;
#define FOPT_BIT(x) (1U<<((x)-1))

#include "seq.h"
#include "folder.h"
#include "system.h"
#include "deconst.h"
#include "context.h"
#include "message.h"

struct format {
  int codesize;
  unsigned char *code;
  int codealloc;
  int ncb;
  int *cb;
  } ;

/* "value follows" - value is an int overlaid on next sizeof(int) chars. */
/* branch targets are absolute offsets into the code vector. */
#define C_NCONST           1 /* value follows */
#define C_SCONST           2 /* NUL-terminated str follows */
#define C_ADD              3 /* i i -- i */
#define C_SUB              4 /* i i -- i */
#define C_MUL              5 /* i i -- i */
#define C_DIV              6 /* i i -- i */
#define C_MOD              7 /* i i -- i */
#define C_EQ               8 /* i i -- i */
#define C_LT               9 /* i i -- i */
#define C_GT              10 /* i i -- i */
#define C_NOT             11 /* b -- b */
#define C_AND             12 /* b b -- b */
#define C_OR              13 /* b b -- b */
#define C_XOR             14 /* b b -- b */
#define C_IF              15 /* test TOS, if false do a JMP */
#define C_JMP             16 /* unconditional, target in following value */
#define C_STRCAT          17 /* s s -- s */
#define C_STRCMP          18 /* s s -- i (case-sensitive) */
#define C_STRINGCMP       19 /* s s -- i (case-insensitive) */
#define C_STRCUT          20 /* s i -- s s */
#define C_SUBSTR          21 /* s i i -- s */
#define C_STRLEN          22 /* s -- i */
#define C_REXPLODE        23 /* s s -- s1 ... sN N */
#define C_EXPLODE         24 /* s s -- s1 ... sN N */
#define C_RIMPLODE        25 /* s1 ... sN N s -- s */
#define C_IMPLODE         26 /* s1 ... sN N s -- s */
#define C_INSTR           27 /* s s -- i */
#define C_INSTRING        28 /* s s -- i */
#define C_RINSTR          29 /* s s -- i */
#define C_RINSTRING       30 /* s s -- i */
#define C_ATOI            31 /* s -- i */
#define C_INTOSTR         32 /* i -- s */
#define C_INTOSTR_W       33 /* i i i -- s */
#define C_UPCASE          34 /* s -- s */
#define C_DNCASE          35 /* s -- s */
#define C_DUP             36 /* x -- x x */
#define C_SWAP            37 /* x1 x2 -- x2 x1 */
#define C_POP             38 /* x -- */
#define C_ROT             39 /* x1 x2 x3 -- x2 x3 x1 */
#define C_NROT            40 /* x1 x2 x3 -- x3 x1 x2 */
#define C_ROTATE          41 /* x1 x2 ... xN N -- x2 ... xN x1; xN ... x2 x1 -N -- x1 xN ... x2 */
#define C_ROLL            42 /* xN ... x1 N M -- xM ... x1 xN ... xM+1 */
#define C_PICK            43 /* x1 ... xN N -- x1 ... xN x1 */
#define C_PUT             44 /* x1 x2 ... xN x N -- x x2 ... xN */
#define C_OVER            45 /* x1 x2 -- x1 x2 x1 */
#define C_DEPTH           46 /* (bos) x1 ... xN -- (bos) x1 ... xN N */
#define C_CALL            47 /* target in following value */
#define C_H_STR           48 /* header value, NUL-terminated name follows */
#define C_H_STR_TOS       49 /* header value, name is TOS */
#define C_H_D_PARSE       50 /* s -- i */
#define C_H_D_CUR         51 /* s -- i */
#define C_H_D_YEAR        52 /* i -- i */
#define C_H_D_MONTH       53 /* i -- i */
#define C_H_D_MDAY        54 /* i -- i */
#define C_H_D_WDAY        55 /* i -- i */
#define C_H_D_HOUR        56 /* i -- i */
#define C_H_D_MINUTE      57 /* i -- i */
#define C_H_D_SECOND      58 /* i -- i */
#define C_H_D_ZONEOFF     59 /* i -- i */
#define C_H_D_EXPLODE     60 /* i -- i i i i i i i */
#define C_H_D_STR_ZONE    61 /* i -- i */
#define C_H_D_STR_M_S     62 /* i -- s */
#define C_H_D_STR_M_L     63 /* i -- s */
#define C_H_D_STR_W_S     64 /* i -- s */
#define C_H_D_STR_W_L     65 /* i -- s */
#define C_H_A_ADDR        66 /* s -- s */
#define C_H_A_COMMENT     67 /* s -- s */
#define C_H_A_COUNT       68 /* s -- i */
#define C_H_A_EXPLODE     69 /* s -- s1 ... sN N */
#define C_M_NUMBER        70 /* -- i */
#define C_M_FOLDER        71 /* -- s */
#define C_M_PNUMBER       72 /* -- i */
#define C_M_CNUMBER       73 /* -- i */
#define C_M_NNUMBER       74 /* -- i */
#define C_M_CFOLDER       75 /* -- s */
#define C_M_ISPREV_NUMBER 76 /* -- b */
#define C_M_ISCUR_NUMBER  77 /* -- b */
#define C_M_ISNEXT_NUMBER 78 /* -- b */
#define C_M_ISCUR_FOLDER  79 /* -- b */
#define C_Q_MEMBER        80 /* s s i -- b */
#define C_RET             81 /* return from subword */
#define C_TST_I           82 /* x -- b */
#define C_TST_S           83 /* x -- b */
#define C_ENV_GET         84 /* s -- s, or s -- 0 */
#define C_ENV_PUT         85 /* s -- */
#define C_ENV_UNSET       86 /* s -- */
#define C_EXTENSION       87 /* EXT_xxx code in next byte */
#define C_ICALL           88 /* like CALL, but use fmt->cb[TOS] as target */

typedef struct backpatch BACKPATCH;
struct backpatch {
  int codeloc;
  int patchloc;
  const char *progloc;
  } ;

typedef struct patchlist PATCHLIST;
struct patchlist {
  PATCHLIST *link;
  BACKPATCH patch;
  } ;

typedef struct ctlstruct CTLSTRUCT;
struct ctlstruct {
  CTLSTRUCT *link;
  const char *begin;
  int type;
#define CST_IF   1
#define CST_LOOP 2
  union {
    struct {
      PATCHLIST *endpatches;
      BACKPATCH if_backpatch;
      int in_else : 1;
      } if_;
    struct {
      int contloc;
      PATCHLIST *endpatches;
      } loop_;
    } u;
  } ;

typedef struct cblock CBLOCK;
struct cblock {
  CBLOCK *link;
  CTLSTRUCT *css;
  const char *begin;
  BACKPATCH backpatch;
  int cbx;
  } ;

typedef struct defn DEFN;
struct defn {
  DEFN *link;
  const char *name;
  int loc;
  BACKPATCH backpatch;
  PATCHLIST *precalls;
  const char *begin;
  } ;

typedef struct stackel STACKEL;
struct stackel {
  STACKEL *link;
  int type;
#define SE_INTEGER 1
#define SE_STRING  2
#define SE_ANY     3 /* never appears in type, just for spush() */
  union {
    int i;
    char *s;
    } u;
  } ;

typedef struct kid KID;
struct kid {
  KID *link;
  int pid;
  } ;

typedef struct hdr HDR;
struct hdr {
  HDR *link;
  unsigned int seen : 1;
  char *name;
  char *value;
  } ;

typedef struct recache RECACHE;
struct recache {
  RECACHE *link;
  char *s;
  regex_t re;
  } ;

static CBLOCK *cblocks;
static RECACHE *recache = 0;
static int hdrsloaded;
static HDR *hdrs;
static KID *kids;
static FILE *out;
static int outfd;
static int outpushed;
static EXT__T exts;
static DEFN *defs;
static DEFN *curdef;
static FORMAT *fmt;
static CTLSTRUCT *css;
static PATCHLIST *patched;
static char *code0;
static const char *cp;
#define UCP ((const unsigned char *)cp)
static MESSAGE *msg;
static int pc0;
static int pc;
static STACKEL *stack;
static jmp_buf ierrsj;
#define IESJ_IERR 1 /* interperr() called */
#define IESJ_PIPE 2 /* got SIGPIPE */
static int debugging = 0;
static struct winsize ttysize;
static volatile int /*sig_atomic_t*/ ttysize_valid = 0;
static FOPT_TYPE optspec;
static void (*errfn)(const char *, void *);
static void *fncookie;

static struct {
	 const char *name;
	 int ext;
	 } ext_table[] = { { "width",     EXT_WIDTH     },
			   { "height",    EXT_HEIGHT    },
			   { "unixfrom",  EXT_UNIXFROM  },
			   { "hdrreset",  EXT_HDRRESET  },
			   { "hdrget",    EXT_HDRGET    },
			   { "hdrmatch",  EXT_HDRMATCH  },
			   { "bodyline",  EXT_BODYLINE  },
			   { "outstring", EXT_OUTSTRING },
			   { "filter",    EXT_FILTER    },
			   { "dumpbody",  EXT_DUMPBODY  },
			   { 0, 0 } };

static void print_code_context(FILE *out, const char *at, const char *whenat)
{
 const char *start;
 const char *end;
 const char *s;

 if (at-code0 > 30) start = at - 30; else start = code0;
 if (strlen(at) > 30) end = at + 30; else end = at + strlen(at);
 for (s=start;s<end;s++)
  { if (s == at) fprintf(out,"%s",whenat);
    putc((*s=='\n')?' ':*s,out);
  }
 if (s == at) fprintf(out,"%s",whenat);
}

static void v_progerr_at_begin(const char *, const char *, const char *, va_list *) __attribute__ ((format(printf,3,0)));
static void v_progerr_at_begin(const char *at, const char *begin, const char *fmt, va_list *ap)
{
 fprintf(stderr,"%s: program error: ",__progname);
 vfprintf(stderr,fmt,*ap);
 fprintf(stderr,"\n%s: At: ",__progname);
 print_code_context(stderr,at,"<<here>>");
 if (begin)
  { fprintf(stderr,"\n%s: Starting: ",__progname);
    print_code_context(stderr,begin,"<<here>>");
  }
 fprintf(stderr,"\n");
 exit(1);
}

static void progerr(const char *, ...) __attribute__ ((format(printf,1,2)));
static void progerr(const char *fmt, ...)
{
 va_list ap;

 va_start(ap,fmt);
 v_progerr_at_begin(cp,0,fmt,&ap);
 va_end(ap);
}

static void progerr_begin(const char *, const char *, ...) __attribute__ ((format(printf,2,3)));
static void progerr_begin(const char *begin, const char *fmt, ...)
{
 va_list ap;

 va_start(ap,fmt);
 v_progerr_at_begin(cp,begin,fmt,&ap);
 va_end(ap);
}

static void progerr_at(const char *, const char *, ...) __attribute__ ((format(printf,2,3)));
static void progerr_at(const char *at, const char *fmt, ...)
{
 va_list ap;

 va_start(ap,fmt);
 v_progerr_at_begin(at,0,fmt,&ap);
 va_end(ap);
}

static void grow_code(int n)
{
 if (fmt->codesize+n > fmt->codealloc) fmt->code = realloc(fmt->code,(fmt->codealloc=fmt->codesize+n+16));
 fmt->codesize += n;
}

static void compile_code(unsigned char cv)
{
 grow_code(1);
 fmt->code[fmt->codesize-1] = cv;
}

static int curloc(void)
{
 return(fmt->codesize);
}

static void compile_int(int v)
{
 grow_code(sizeof(int));
 bcopy(&v,&fmt->code[fmt->codesize-sizeof(int)],sizeof(int));
}

static void setup_backpatch(BACKPATCH *bp, int cloc, int ploc, const char *code)
{
 bp->codeloc = cloc;
 bp->patchloc = ploc;
 bp->progloc = code;
}

static void do_backpatch(BACKPATCH *bp, int to)
{
 PATCHLIST *p;

 if ((bp->patchloc < 0) || (bp->patchloc+sizeof(int) > fmt->codesize)) abort();
 bcopy(&to,&fmt->code[bp->patchloc],sizeof(int));
 p = malloc(sizeof(PATCHLIST));
 p->patch = *bp;
 p->link = patched;
 patched = p;
}

static void compile_number(void)
{
 int v;
 int neg;

 if (cp[-1] == '_')
  { neg = 1;
    v = 0;
  }
 else
  { neg = 0;
    v = cp[-1] - '0';
  }
 while (*cp && isdigit(*cp))
  { v = (v * 10) + (*cp - '0');
    cp ++;
  }
 if (neg) v = - v;
 compile_int(v);
}

static unsigned char backslash_char(const char *begin, const char *errmsg)
{
 int v;

 if (! *cp)
  { if (begin)
     { progerr_begin(begin,"%s",errmsg);
     }
    else
     { progerr("%s",errmsg);
     }
  }
 switch (*cp)
  { case 'a': v = '\a'; break;
    case 'b': v = '\b'; break;
    case 'e': v = '\e'; break;
    case 'f': v = '\f'; break;
    case 'n': v = '\n'; break;
    case 'r': v = '\r'; break;
    case 't': v = '\t'; break;
    case 'v': v = '\v'; break;
    case '0': case '1': case '2': case '3':
    case '4': case '5': case '6': case '7':
       v = *cp - '0';
       switch (cp[1])
	{ case '0': case '1': case '2': case '3':
	  case '4': case '5': case '6': case '7':
	     v = (v << 3) | (cp[1] - '0');
	     switch (cp[2])
	      { case '0': case '1': case '2': case '3':
		case '4': case '5': case '6': case '7':
		   v = (v << 3) | (cp[2] - '0');
		   cp ++;
		   break;
	      }
	     cp ++;
	     break;
	}
       break;
    default:
       v = *UCP;
       break;
  }
 return(v);
}

static void compile_string(char endchar)
{
 int bq;
 int ended;
 const char *begin;

 begin = cp;
 bq = 0;
 ended = 0;
 for (;*cp;cp++)
  { if (bq)
     { unsigned char v;
       v = backslash_char(begin,"end of program inside a string");
       if (! ended)
	{ compile_code(v);
	  ended = (v == 0);
	}
       bq = 0;
       continue;
     }
    if (*cp == endchar)
     { if (! ended) compile_code(0);
       cp ++;
       return;
     }
    switch (*cp)
     { case '\\':
	  bq = 1;
	  break;
       default:
	  if (! ended) compile_code(*UCP);
	  break;
     }
  }
}

static void compile_charconst(void)
{
 unsigned char v;

 switch (*cp)
  { case '\'':
       progerr("character constant with no character");
       break;
    case '\\':
       cp ++;
       v = backslash_char(0,"end of program inside a character constant");
       break;
    default:
       v = *UCP;
       break;
  }
 if (*++cp != '\'') progerr("unclosed character constant");
 cp ++;
 compile_int(v);
}

static void push_csstack(void)
{
 CTLSTRUCT *cs;

 cs = malloc(sizeof(CTLSTRUCT));
 cs->link = css;
 css = cs;
}

static void pop_csstack(void)
{
 CTLSTRUCT *cs;

 cs = css;
 css = cs->link;
 free(cs);
}

static void push_patchlist(PATCHLIST **lp, int codeloc, int patchloc, const char *progloc)
{
 PATCHLIST *pl;

 pl = malloc(sizeof(PATCHLIST));
 pl->link = *lp;
 *lp = pl;
 setup_backpatch(&pl->patch,codeloc,patchloc,progloc);
}

static void do_backpatch_list(PATCHLIST **lp, int loc)
{
 PATCHLIST *pl;
 PATCHLIST *p;

 pl = *lp;
 while (pl)
  { p = pl;
    pl = p->link;
    do_backpatch(&p->patch,loc);
    free(p);
  }
 *lp = 0;
}

static CTLSTRUCT *findloop(void)
{
 CTLSTRUCT *cs;

 for (cs=css;cs&&(cs->type!=CST_LOOP);cs=cs->link) ;
 return(cs);
}

static void compile_conditional(void)
{
 switch (*cp++)
  { case '?':
	{ int cloc;
	  int ploc;
	  cloc = curloc();
	  compile_code(C_IF);
	  ploc = curloc();
	  compile_int(-1);
	  push_csstack();
	  css->begin = cp - 2;
	  css->type = CST_IF;
	  setup_backpatch(&css->u.if_.if_backpatch,cloc,ploc,cp-2);
	  css->u.if_.endpatches = 0;
	  css->u.if_.in_else = 0;
	}
       break;
    case '|':
       if (css && (css->type == CST_IF))
	{ int jloc;
	  int ploc;
	  if (css->u.if_.in_else)
	   { progerr_begin(css->begin,"misplaced ?| in conditional");
	   }
	  jloc = curloc();
	  compile_code(C_JMP);
	  ploc = curloc();
	  compile_int(-1);
	  push_patchlist(&css->u.if_.endpatches,jloc,ploc,cp-2);
	  do_backpatch(&css->u.if_.if_backpatch,curloc());
	  css->u.if_.in_else = 1;
	}
       else
	{ progerr("improperly nested control structure, improper ?|");
	}
       break;
    case '+':
       if (css && (css->type == CST_IF))
	{ int cloc;
	  int ploc;
	  if (! css->u.if_.in_else)
	   { progerr_begin(css->begin,"misplaced ?+ in conditional");
	   }
	  cloc = curloc();
	  compile_code(C_IF);
	  ploc = curloc();
	  compile_int(-1);
	  setup_backpatch(&css->u.if_.if_backpatch,cloc,ploc,cp-2);
	  css->u.if_.in_else = 0;
	}
       else
	{ progerr("improperly nested control structure, improper ?+");
	}
       break;
    case '.':
       if (css && (css->type == CST_IF))
	{ if (! css->u.if_.in_else)
	   { do_backpatch(&css->u.if_.if_backpatch,curloc());
	   }
	  do_backpatch_list(&css->u.if_.endpatches,curloc());
	  pop_csstack();
	}
       else
	{ progerr("improperly nested control structure, improper ?.");
	}
       break;
    default:
       cp --;
       progerr("invalid character after ?");
       break;
  }
}

static void compile_loop(void)
{
 CTLSTRUCT *l;

 switch (*cp++)
  { case '(':
       push_csstack();
       css->type = CST_LOOP;
       css->begin = cp - 2;
       css->u.loop_.contloc = curloc();
       css->u.loop_.endpatches = 0;
       break;
    case ')':
       if (css && (css->type == CST_LOOP))
	{ compile_code(C_JMP);
	  compile_int(css->u.loop_.contloc);
	  do_backpatch_list(&css->u.loop_.endpatches,curloc());
	  pop_csstack();
	}
       else
	{ progerr("improperly nested control structure, improper L)");
	}
       break;
    case 'u':
       compile_code(C_NOT);
       /* fall through */
    case 'w':
       if ((l=findloop()))
	{ int cloc;
	  int ploc;
	  cloc = curloc();
	  compile_code(C_IF);
	  ploc = curloc();
	  compile_int(-1);
	  push_patchlist(&l->u.loop_.endpatches,cloc,ploc,cp-2);
	}
       else
	{ progerr("Lw/Lu not in a loop");
	}
       break;
    case 'b':
       if ((l=findloop()))
	{ int cloc;
	  int ploc;
	  cloc = curloc();
	  compile_code(C_JMP);
	  ploc = curloc();
	  compile_int(-1);
	  push_patchlist(&l->u.loop_.endpatches,cloc,ploc,cp-2);
	}
       else
	{ progerr("Lb not in a loop");
	}
       break;
    case 'c':
       if ((l=findloop()))
	{ compile_code(C_JMP);
	  compile_int(l->u.loop_.contloc);
	}
       else
	{ progerr("Lc not in a loop");
	}
       break;
    default:
       cp --;
       progerr("invalid character after L");
       break;
  }
}

static void compile_paren_string(void)
{
 if (*cp++ != '(') progerr("missing ( delimiter");
 compile_string(')');
}

static void compile_include(void)
{
 int loc;
 int fd;
 int ibegoff;
 struct stat stb;
 char *fn;
 static const char *progdir = 0;

 ibegoff = (cp-1) - code0;
 if (*cp++ != '(') progerr("missing ( delimiter");
 loc = curloc();
 compile_string(')');
 fn = strdup((char *)&fmt->code[loc]);
 fmt->codesize = loc;
 if (progdir == 0) progdir = profile_relative_to(system_get_profile(),"progdir","programs",system_mmdir());
 if (fn[0] != '/')
  { char *t;
    asprintf(&t,"%s/%s",progdir,fn);
    free(fn);
    fn = t;
  }
 fd = open(fn,O_RDONLY,0);
 if (fd < 0)
  { fprintf(stderr,"%s: can't open include file %s: %s\n",__progname,fn,strerror(errno));
  }
 else
  { int off;
    int ilen;
    int len;
    int nr;
    fmt->codesize = loc;
    fstat(fd,&stb);
    off = cp - code0;
    ilen = off - ibegoff;
    len = strlen(code0);
    code0 = realloc(code0,len+stb.st_size-ilen+1);
    bcopy(code0+off,code0+stb.st_size+ibegoff,len-off+1);
    nr = read(fd,code0+ibegoff,stb.st_size);
    if (nr < 0)
     { fprintf(stderr,"%s: read error on include file %s: %s\n",__progname,fn,strerror(errno));
     }
    else if (nr < stb.st_size)
     { fprintf(stderr,"%s: short read on include file %s: wanted %d, got %d\n",__progname,fn,(int)stb.st_size,nr);
       bcopy(code0+stb.st_size+off,code0+nr+off,len-off+1);
     }
    close(fd);
    cp = code0 + ibegoff;
  }
 free(fn);
}

static __inline__ int namechar(char c)
{
 return(isalnum(c)||(c=='_'));
}

static char *skip_name(void)
{
 const char *cp0;
 char *t;

 while (*cp && isspace(*cp)) cp ++;
 cp0 = cp;
 while (*cp && namechar(*cp)) cp ++;
 t = malloc((cp-cp0)+1);
 bcopy(cp0,t,cp-cp0);
 t[cp-cp0] = '\0';
 return(t);
}

static DEFN *lookup_defn(char *name, int create)
{
 DEFN *d;

 for (d=defs;d;d=d->link)
  { if (!strcmp(d->name,name))
     { if (create) free(name);
       return(d);
     }
  }
 if (! create) return(0);
 d = malloc(sizeof(DEFN));
 d->link = defs;
 defs = d;
 d->name = name;
 d->loc = -1;
 d->precalls = 0;
 d->begin = 0;
 return(d);
}

static void compile_define(void)
{
 const char *begin;
 char *name;
 DEFN *d;
 int cloc;
 int ploc;

 if (curdef) progerr_begin(curdef->begin,"nested definition");
 /* css check necessary to avoid bugs due to eg ?? ... :foo ?| ; ... ?. */
 if (css) progerr_begin(css->begin,"definition inside control structure");
 /* cblocks check ditto eg { ... :foo ... } ... ; */
 if (cblocks) progerr_begin(cblocks->begin,"definition inside { ... }");
 begin = cp - 1;
 if (*cp == ':')
  { cp ++;
    name = skip_name();
    lookup_defn(name,1);
    return;
  }
 name = skip_name();
 d = lookup_defn(name,1);
 if (d->loc != -1) progerr("word already defined");
 cloc = curloc();
 compile_code(C_JMP);
 ploc = curloc();
 compile_int(-1);
 setup_backpatch(&d->backpatch,cloc,ploc,begin);
 do_backpatch_list(&d->precalls,curloc());
 d->loc = curloc();
 curdef = d;
 d->begin = begin;
}

static void compile_enddef(void)
{
 if (! curdef) progerr("; not matched by a :");
 compile_code(C_RET);
 do_backpatch(&curdef->backpatch,curloc());
 curdef = 0;
}

static void compile_call(void)
{
 char *name;
 DEFN *d;
 const char *begin;
 int cloc;
 int ploc;

 begin = cp - 1;
 name = skip_name();
 d = lookup_defn(name,0);
 free(name);
 if (! d) progerr("call to undefined name");
 cloc = curloc();
 compile_code(C_CALL);
 ploc = curloc();
 if (d->loc < 0)
  { compile_int(-1);
    push_patchlist(&d->precalls,cloc,ploc,begin);
  }
 else
  { compile_int(d->loc);
  }
}

static void compile_extension(void)
{
 char *name;
 int x;
 int i;

 name = skip_name();
 for (i=0;ext_table[i].name;i++) if (!strcmp(name,ext_table[i].name)) break;
 if (! ext_table[i].name) progerr("unrecognized extension");
 x = ext_table[i].ext;
 if (! (exts & EXT__BIT(x))) progerr("unrecognized extension");
 compile_code(C_EXTENSION);
 compile_code(x);
}

static void compile_end(void)
{
 DEFN *d;

 if (curdef) progerr_begin(curdef->begin,"end of program inside a definition");
 if (css) progerr_begin(css->begin,"end of program inside control structure");
 if (cblocks) progerr_begin(cblocks->begin,"end of program inside { ... }");
 for (d=defs;d;d=d->link)
  { if (d->precalls) progerr_at(d->precalls->patch.progloc,"call to never-defined word");
  }
 compile_code(C_RET);
}

static void compile_simple_comment(void)
{
 const char *begin;

 begin = cp - 2;
 while (*cp++) if ((cp[-1] == ']') && (cp[-2] == ']')) return;
 progerr_begin(begin,"end of program inside [[ ]]");
}

static void compile_cblock_begin(void)
{
 CBLOCK *cb;
 int cloc;
 int ploc;

 cb = malloc(sizeof(CBLOCK));
 cb->css = css;
 css = 0;
 cb->begin = cp - 1;
 cloc = curloc();
 compile_code(C_JMP);
 ploc = curloc();
 compile_int(-1);
 setup_backpatch(&cb->backpatch,cloc,ploc,cp-1);
 cb->cbx = fmt->ncb++;
 fmt->cb = realloc(fmt->cb,fmt->ncb*sizeof(int));
 fmt->cb[cb->cbx] = curloc();
 cb->link = cblocks;
 cblocks = cb;
}

static void compile_cblock_end(void)
{
 CBLOCK *cb;

 if (css) progerr_begin(css->begin,"unclosed control structure at end of { ... }");
 if (! cblocks) progerr(/*{*/"unmatched }");
 compile_code(C_RET);
 cb = cblocks;
 cblocks = cb->link;
 do_backpatch(&cb->backpatch,curloc());
 compile_code(C_NCONST);
 compile_int(cb->cbx);
 css = cb->css;
 free(cb);
}

static void print_escaped_str(FILE *f, const void *sv)
{
 unsigned const char *s;

 for (s=sv;*s;s++)
  { switch (*s)
     { case '\\': case '"': fprintf(f,"\\%c",*s); break;
       case '\a': fprintf(f,"\\a"); break;
       case '\b': fprintf(f,"\\b"); break;
       case '\e': fprintf(f,"\\e"); break;
       case '\f': fprintf(f,"\\f"); break;
       case '\n': fprintf(f,"\\n"); break;
       case '\r': fprintf(f,"\\r"); break;
       case '\t': fprintf(f,"\\t"); break;
       case '\v': fprintf(f,"\\v"); break;
       default:
	  if (isprint(*s))
	   { putc(*s,f);
	   }
	  else
	   { if (isdigit(s[1])) fprintf(f,"\\%03o",*s); else fprintf(f,"\\%o",*s);
	   }
	  break;
     }
  }
}

static int print_instr(FILE *out, FORMAT *fmt, int off)
{
 switch (fmt->code[off++])
  { case C_NCONST:
	{ const char *s;
	  int v;
	  s = "C_NCONST";
	  if (0)
	   {
    case C_IF:
	     s = "C_IF";
	   }
	  if (0)
	   {
    case C_JMP:
	     s = "C_JMP";
	   }
	  if (0)
	   {
    case C_CALL:
	     s = "C_CALL";
	   }
	  bcopy(&fmt->code[off],&v,sizeof(int));
	  fprintf(out,"%s %d",s,v);
	  off += sizeof(int);
	}
       break;
    case C_SCONST:
	{ const char *s;
	  s = "C_SCONST";
	  if (0)
	   {
    case C_H_STR:
	     s = "C_H_STR";
	   }
	  fprintf(out,"%s \"",s);
	  print_escaped_str(out,&fmt->code[off]);
	  fprintf(out,"\"");
	  off += strlen((char *)&fmt->code[off]) + 1;
	}
       break;
    case C_EXTENSION:
	{ int i;
	  int x;
	  x = fmt->code[off++];
	  for (i=0;ext_table[i].name;i++) if (ext_table[i].ext == x) break;
	  if (ext_table[i].name)
	   { fprintf(out,"C_EXTENSION %s",ext_table[i].name);
	   }
	  else
	   { fprintf(out,"C_EXTENSION %d?",x);
	   }
	}
       break;
    case C_ADD:             fprintf(out,"C_ADD");             break;
    case C_SUB:             fprintf(out,"C_SUB");             break;
    case C_MUL:             fprintf(out,"C_MUL");             break;
    case C_DIV:             fprintf(out,"C_DIV");             break;
    case C_MOD:             fprintf(out,"C_MOD");             break;
    case C_EQ:              fprintf(out,"C_EQ");              break;
    case C_LT:              fprintf(out,"C_LT");              break;
    case C_GT:              fprintf(out,"C_GT");              break;
    case C_NOT:             fprintf(out,"C_NOT");             break;
    case C_AND:             fprintf(out,"C_AND");             break;
    case C_OR:              fprintf(out,"C_OR");              break;
    case C_XOR:             fprintf(out,"C_XOR");             break;
    case C_STRCAT:          fprintf(out,"C_STRCAT");          break;
    case C_STRCMP:          fprintf(out,"C_STRCMP");          break;
    case C_STRINGCMP:       fprintf(out,"C_STRINGCMP");       break;
    case C_STRCUT:          fprintf(out,"C_STRCUT");          break;
    case C_SUBSTR:          fprintf(out,"C_SUBSTR");          break;
    case C_STRLEN:          fprintf(out,"C_STRLEN");          break;
    case C_REXPLODE:        fprintf(out,"C_REXPLODE");        break;
    case C_EXPLODE:         fprintf(out,"C_EXPLODE");         break;
    case C_RIMPLODE:        fprintf(out,"C_RIMPLODE");        break;
    case C_IMPLODE:         fprintf(out,"C_IMPLODE");         break;
    case C_INSTR:           fprintf(out,"C_INSTR");           break;
    case C_INSTRING:        fprintf(out,"C_INSTRING");        break;
    case C_ATOI:            fprintf(out,"C_ATOI");            break;
    case C_INTOSTR:         fprintf(out,"C_INTOSTR");         break;
    case C_INTOSTR_W:       fprintf(out,"C_INTOSTR_W");       break;
    case C_UPCASE:          fprintf(out,"C_UPCASE");          break;
    case C_DNCASE:          fprintf(out,"C_DNCASE");          break;
    case C_DUP:             fprintf(out,"C_DUP");             break;
    case C_SWAP:            fprintf(out,"C_SWAP");            break;
    case C_POP:             fprintf(out,"C_POP");             break;
    case C_ROT:             fprintf(out,"C_ROT");             break;
    case C_NROT:            fprintf(out,"C_NROT");            break;
    case C_ROTATE:          fprintf(out,"C_ROTATE");          break;
    case C_ROLL:            fprintf(out,"C_ROLL");            break;
    case C_PICK:            fprintf(out,"C_PICK");            break;
    case C_PUT:             fprintf(out,"C_PUT");             break;
    case C_OVER:            fprintf(out,"C_OVER");            break;
    case C_DEPTH:           fprintf(out,"C_DEPTH");           break;
    case C_H_STR_TOS:       fprintf(out,"C_H_STR_TOS");       break;
    case C_H_D_PARSE:       fprintf(out,"C_H_D_PARSE");       break;
    case C_H_D_CUR:         fprintf(out,"C_H_D_CUR");         break;
    case C_H_D_YEAR:        fprintf(out,"C_H_D_YEAR");        break;
    case C_H_D_MONTH:       fprintf(out,"C_H_D_MONTH");       break;
    case C_H_D_MDAY:        fprintf(out,"C_H_D_MDAY");        break;
    case C_H_D_WDAY:        fprintf(out,"C_H_D_WDAY");        break;
    case C_H_D_HOUR:        fprintf(out,"C_H_D_HOUR");        break;
    case C_H_D_MINUTE:      fprintf(out,"C_H_D_MINUTE");      break;
    case C_H_D_SECOND:      fprintf(out,"C_H_D_SECOND");      break;
    case C_H_D_ZONEOFF:     fprintf(out,"C_H_D_ZONEOFF");     break;
    case C_H_D_EXPLODE:     fprintf(out,"C_H_D_EXPLODE");     break;
    case C_H_D_STR_ZONE:    fprintf(out,"C_H_D_STR_ZONE");    break;
    case C_H_D_STR_M_S:     fprintf(out,"C_H_D_STR_M_S");     break;
    case C_H_D_STR_M_L:     fprintf(out,"C_H_D_STR_M_L");     break;
    case C_H_D_STR_W_S:     fprintf(out,"C_H_D_STR_W_S");     break;
    case C_H_D_STR_W_L:     fprintf(out,"C_H_D_STR_W_L");     break;
    case C_H_A_ADDR:        fprintf(out,"C_H_A_ADDR");        break;
    case C_H_A_COMMENT:     fprintf(out,"C_H_A_COMMENT");     break;
    case C_H_A_COUNT:       fprintf(out,"C_H_A_COUNT");       break;
    case C_H_A_EXPLODE:     fprintf(out,"C_H_A_EXPLODE");     break;
    case C_M_NUMBER:        fprintf(out,"C_M_NUMBER");        break;
    case C_M_FOLDER:        fprintf(out,"C_M_FOLDER");        break;
    case C_M_PNUMBER:       fprintf(out,"C_M_PNUMBER");       break;
    case C_M_CNUMBER:       fprintf(out,"C_M_CNUMBER");       break;
    case C_M_NNUMBER:       fprintf(out,"C_M_NNUMBER");       break;
    case C_M_CFOLDER:       fprintf(out,"C_M_CFOLDER");       break;
    case C_M_ISPREV_NUMBER: fprintf(out,"C_M_ISPREV_NUMBER"); break;
    case C_M_ISCUR_NUMBER:  fprintf(out,"C_M_ISCUR_NUMBER");  break;
    case C_M_ISNEXT_NUMBER: fprintf(out,"C_M_ISNEXT_NUMBER"); break;
    case C_M_ISCUR_FOLDER:  fprintf(out,"C_M_ISCUR_FOLDER");  break;
    case C_Q_MEMBER:        fprintf(out,"C_Q_MEMBER");        break;
    case C_RET:             fprintf(out,"C_RET");             break;
    case C_TST_I:           fprintf(out,"C_TST_I");           break;
    case C_TST_S:           fprintf(out,"C_TST_S");           break;
    case C_ENV_GET:         fprintf(out,"C_ENV_GET");         break;
    case C_ENV_PUT:         fprintf(out,"C_ENV_PUT");         break;
    case C_ENV_UNSET:       fprintf(out,"C_ENV_UNSET");       break;
    case C_ICALL:           fprintf(out,"C_ICALL");           break;
    default: abort(); break;
  }
 return(off);
}

static void compile_main(void)
{
 int lastcs;

 lastcs = fmt->codesize;
 while (1)
  { if (debugging && (patched || (lastcs < fmt->codesize)))
     { fprintf(stderr,"Code stream now ");
       print_code_context(stderr,cp,"<<cp>>");
       fprintf(stderr,"\n");
       while (lastcs < fmt->codesize)
	{ fprintf(stderr," %4d: ",lastcs);
	  lastcs = print_instr(stderr,fmt,lastcs);
	  fprintf(stderr,"\n");
	}
       while (patched)
	{ PATCHLIST *l;
	  l = patched;
	  patched = l->link;
	  fprintf(stderr,"(%4d: ",l->patch.codeloc);
	  print_instr(stderr,fmt,l->patch.codeloc);
	  fprintf(stderr,")\n");
	  free(l);
	}
     }
    while (*cp && isspace(*cp)) cp ++;
    if (! *cp) break;
    switch (*cp++)
     { case 'D':
	  debugging = 1;
	  break;
       case '0': case '1': case '2': case '3': case '4':
       case '5': case '6': case '7': case '8': case '9':
       case '_':
	  compile_code(C_NCONST);
	  compile_number();
	  break;
       case '"':
	  compile_code(C_SCONST);
	  compile_string('"');
	  break;
       case '\'':
	  compile_code(C_NCONST);
	  compile_charconst();
	  break;
       case '{'/*}*/:
	  compile_cblock_begin();
	  break;
       case /*{*/'}':
	  compile_cblock_end();
	  break;
       case '+': compile_code(C_ADD); break;
       case '-': compile_code(C_SUB); break;
       case '*': compile_code(C_MUL); break;
       case '/': compile_code(C_DIV); break;
       case '%': compile_code(C_MOD); break;
       case '=': compile_code(C_EQ); break;
       case '<': compile_code(C_LT); break;
       case '>': compile_code(C_GT); break;
       case '!': compile_code(C_NOT); break;
       case '&': compile_code(C_AND); break;
       case '|': compile_code(C_OR); break;
       case '^': compile_code(C_XOR); break;
       case '?':
	  compile_conditional();
	  break;
       case 'L':
	  compile_loop();
	  break;
       case 'C':
	  switch (*cp++)
	   { case 'r': compile_code(C_RET); break;
	     case 'c': compile_code(C_ICALL); break;
	     default:
		cp --;
		progerr("invalid character after C");
		break;
	   }
	  break;
       case '$':
	  switch (*cp++)
	   { case '+': compile_code(C_STRCAT); break;
	     case '|': compile_code(C_STRCUT); break;
	     case '_': compile_code(C_SUBSTR); break;
	     case 'l': compile_code(C_STRLEN); break;
	     case 'i':
		switch (*cp++)
		 { case '+': compile_code(C_INSTR); break;
		   case '-': compile_code(C_RINSTR); break;
		   default:
		      cp --;
		      progerr("invalid character after $i");
		      break;
		 }
		break;
	     case 'I':
		switch (*cp++)
		 { case '+': compile_code(C_INSTRING); break;
		   case '-': compile_code(C_RINSTRING); break;
		   default:
		      cp --;
		      progerr("invalid character after $I");
		      break;
		 }
		break;
	     case '?':
		switch (*cp++)
		 { case 'f': compile_code(C_STRCMP); break;
		   case 'l': compile_code(C_STRINGCMP); break;
		   default:
		      cp --;
		      progerr("invalid character after $?");
		      break;
		 }
		break;
	     case '*':
		switch (*cp++)
		 { case '+': compile_code(C_REXPLODE); break;
		   case '-': compile_code(C_EXPLODE); break;
		   default:
		      cp --;
		      progerr("invalid character after $*");
		      break;
		 }
		break;
	     case '!':
		switch (*cp++)
		 { case '+': compile_code(C_RIMPLODE); break;
		   case '-': compile_code(C_IMPLODE); break;
		   default:
		      cp --;
		      progerr("invalid character after $!");
		      break;
		 }
		break;
	     case 'c':
		switch (*cp++)
		 { case 'u': compile_code(C_UPCASE); break;
		   case 'l': compile_code(C_DNCASE); break;
		   default:
		      cp --;
		      progerr("invalid character after $c");
		      break;
		 }
		break;
	     case '>':
		switch (*cp++)
		 { case 'i': compile_code(C_ATOI); break;
		   default:
		      cp --;
		      progerr("invalid character after $>");
		      break;
		 }
		break;
	     case '<':
		switch (*cp++)
		 { case 'i': compile_code(C_INTOSTR); break;
		   case '<':
		      switch (*cp++)
		       { case 'i': compile_code(C_INTOSTR_W); break;
			 default:
			    cp --;
			    progerr("invalid character after $<<");
			    break;
		       }
		      break;
		   default:
		      cp --;
		      progerr("invalid character after $<");
		      break;
		 }
		break;
	     default:
		cp --;
		progerr("invalid character after $");
		break;
	   }
	  break;
       case 's':
	  switch (*cp++)
	   { case '+': compile_code(C_DUP); break;
	     case 'x': compile_code(C_SWAP); break;
	     case '-': compile_code(C_POP); break;
	     case 'r': compile_code(C_ROT); break;
	     case 'R': compile_code(C_NROT); break;
	     case 's': compile_code(C_ROTATE); break;
	     case 'l': compile_code(C_ROLL); break;
	     case 'g': compile_code(C_PICK); break;
	     case 'p': compile_code(C_PUT); break;
	     case 'o': compile_code(C_OVER); break;
	     case '#': compile_code(C_DEPTH); break;
	     default:
		cp --;
		progerr("invalid character after s");
		break;
	   }
	  break;
       case 't':
	  switch (*cp++)
	   { case '?':
		switch (*cp++)
		 { case 'i': compile_code(C_TST_I); break;
		   case 's': compile_code(C_TST_S); break;
		   default:
		      cp --;
		      progerr("invalid character after t?");
		      break;
		 }
		break;
	     default:
		cp --;
		progerr("invalid character after t");
		break;
	   }
	  break;
       case 'e':
	  switch (*cp++)
	   { case 'g': compile_code(C_ENV_GET); break;
	     case 'p': compile_code(C_ENV_PUT); break;
	     case 'r': compile_code(C_ENV_UNSET); break;
	     default:
		cp --;
		progerr("invalid character after t?");
		break;
	   }
	  break;
       case 'h':
	  switch (*cp++)
	   { case 's':
		 { int oo;
		   oo = curloc();
		   compile_code(C_H_STR);
		   compile_paren_string();
		   if (curloc() == oo+2)
		    { fmt->codesize = oo;
		      compile_code(C_H_STR_TOS);
		    }
		 }
		break;
	     case 'd':
		switch (*cp++)
		 { case 'p': compile_code(C_H_D_PARSE);   break;
		   case 'c': compile_code(C_H_D_CUR);     break;
		   case 'Y': compile_code(C_H_D_YEAR);    break; 
		   case 'M': compile_code(C_H_D_MONTH);   break;
		   case 'D': compile_code(C_H_D_MDAY);    break;
		   case 'W': compile_code(C_H_D_WDAY);    break;
		   case 'h': compile_code(C_H_D_HOUR);    break;
		   case 'm': compile_code(C_H_D_MINUTE);  break;
		   case 's': compile_code(C_H_D_SECOND);  break;
		   case '*': compile_code(C_H_D_EXPLODE); break;
		   case 'z': compile_code(C_H_D_ZONEOFF); break;
		   case '$':
		      switch (*cp++)
		       { case 'z': compile_code(C_H_D_STR_ZONE); break;
			 case 'M': compile_code(C_H_D_STR_M_S);  break;
			 case 'm': compile_code(C_H_D_STR_M_L);  break;
			 case 'W': compile_code(C_H_D_STR_W_S);  break;
			 case 'w': compile_code(C_H_D_STR_W_L);  break;
			 default:
			    cp --;
			    progerr("invalid character after hd$");
			    break;
		       }
		      break;
		   default:
		      cp --;
		      progerr("invalid character after hd");
		      break;
		 }
		break;
	     case 'a':
		switch (*cp++)
		 { case 'a': compile_code(C_H_A_ADDR); break;
		   case 'c': compile_code(C_H_A_COMMENT); break;
		   case '#': compile_code(C_H_A_COUNT); break;
		   case '*': compile_code(C_H_A_EXPLODE); break;
		   default:
		      cp --;
		      progerr("invalid character after ha");
		      break;
		 }
		break;
	     default:
		cp --;
		progerr("invalid character after h");
		break;
	   }
	  break;
       case 'm':
	  switch (*cp++)
	   { case 'n': compile_code(C_M_NUMBER); break;
	     case 'f': compile_code(C_M_FOLDER); break;
	     case '#':
		switch (*cp++)
		 { case 'p': compile_code(C_M_PNUMBER); break;
		   case 'c': compile_code(C_M_CNUMBER); break;
		   case 'n': compile_code(C_M_NNUMBER); break;
		   default:
		      cp --;
		      progerr("invalid character after m#");
		      break;
		 }
		break;
	     case 'c':
		switch (*cp++)
		 { case 'f': compile_code(C_M_CFOLDER); break;
		   default:
		      cp --;
		      progerr("invalid character after mc");
		      break;
		 }
		break;
	     case '?':
		switch (*cp++)
		 { case 'c':
		      switch (*cp++)
		       { case 'f': compile_code(C_M_ISCUR_FOLDER); break;
			 default:
			    cp --;
			    progerr("invalid character after m?c");
			    break;
		       }
		      break;
		   case '#':
		      switch (*cp++)
		       { case 'p': compile_code(C_M_ISPREV_NUMBER); break;
			 case 'c': compile_code(C_M_ISCUR_NUMBER); break;
			 case 'n': compile_code(C_M_ISNEXT_NUMBER); break;
			 default:
			    cp --;
			    progerr("invalid character after m?#");
			    break;
		       }
		      break;
		   default:
		      cp --;
		      progerr("invalid character after m?");
		      break;
		 }
		break;
	     default:
		cp --;
		progerr("invalid character after m");
		break;
	   }
	  break;
       case 'q':
	  switch (*cp++)
	   { case 'm': compile_code(C_Q_MEMBER); break;
	     default:
		cp --;
		progerr("invalid character after q");
		break;
	   }
	  break;
       case '\\':
	  compile_call();
	  break;
       case ':':
	  compile_define();
	  break;
       case ';':
	  compile_enddef();
	  break;
       case 'i':
	  compile_include();
	  break;
       case '@':
	  compile_extension();
	  break;
       case '[':
	  switch (*cp++)
	   { case '[':
		compile_simple_comment();
		break;
	     default:
		cp --;
		progerr("invalid character after [");
		break;
	   }
	  break;
       default:
	  progerr("unrecognized character");
	  break;
     }
  }
 compile_end();
}

static void free_cruft(void)
{
 while (defs)
  { DEFN *d;
    d = defs;
    defs = d->link;
    free(deconst(d->name));
    free(d);
  }
 while (patched)
  { PATCHLIST *p;
    p = patched;
    patched = p->link;
    free(p);
  }
}

static void debug_dump(void)
{
 int i;
 int j;

 fprintf(stderr,"program: %s\n",code0);
 fprintf(stderr,"compiled:\n");
 i = 0;
 while (i < fmt->codesize)
  { for (j=0;j<fmt->ncb;j++)
     { if (i == fmt->cb[j])
	{ fprintf(stderr,"%4d: [code block %d]\n",i,j);
	}
     }
    fprintf(stderr,"%4d: ",i);
    i = print_instr(stderr,fmt,i);
    fprintf(stderr,"\n");
  }
}

static FORMAT *setup_program(const char *code)
{
 code0 = strdup(code);
 fmt = malloc(sizeof(FORMAT));
 fmt->codesize = 0;
 fmt->code = 0;
 fmt->codealloc = 0;
 fmt->ncb = 0;
 fmt->cb = 0;
 cp = code0;
 css = 0;
 defs = 0;
 curdef = 0;
 cblocks = 0;
 patched = 0;
 compile_main();
 free_cruft();
 if (debugging) debug_dump();
 return(fmt);
}

static int filequotelen(const char *s)
{
 int n;

 for (n=0;*s;s++)
  { switch (*s)
     { case ')': case '\\': n ++;
     }
    n ++;
  }
 return(n);
}

static char *filequotestr(const char *s, char *bp)
{
 for (;*s;s++)
  { switch (*s)
     { case ')': case '\\': *bp++ = '\\';
     }
    *bp++ = *s;
  }
 *bp = '\0';
 return(bp);
}

/* One could argue we should
   do { ttysize_valid = 1; ..set it.. } while (! ttysize_valid), in case a
   SIGWINCH arrives while we're working.  But there's not much point when
   the SIGWINCH could just as well arrive after we return and before the
   value gets used. */
static void get_tty_size(void)
{
 if (ttysize_valid) return;
 if ( (ioctl(1,TIOCGWINSZ,&ttysize) < 0) ||
      (ttysize.ws_row <= 0) ||
      (ttysize.ws_col <= 0) )
  { char *termtype;
    char capbuf[1024];
    ttysize.ws_row = 24;
    ttysize.ws_col = 80;
    termtype = getenv("TERM");
    if (termtype && (tgetent(&capbuf[0],termtype) == 1))
     { int v;
       v = tgetnum("li");
       if (v > 0) ttysize.ws_row = v;
       v = tgetnum("co");
       if (v > 0) ttysize.ws_col = v;
     }
  }
 ttysize_valid = 1;
}

static void got_sigwinch(int sig __attribute__((__unused__)))
{
 ttysize_valid = 0;
}

FORMAT *format_program(PROFILE *p, const char *tag, const char *defpgm, ...)
{
 char *buf;
 const char *val;
 FORMAT *f;
 va_list ap;
 int need_sigwinch;

 need_sigwinch = 0;
 exts = 0;
 va_start(ap,defpgm);
 while (1)
  { int x;
    x = va_arg(ap,int);
    if (x == EXT_END) break;
    switch (x)
     { case EXT_WIDTH: case EXT_HEIGHT:
	  need_sigwinch = 1;
	  break;
       case EXT_UNIXFROM: case EXT_HDRRESET: case EXT_HDRGET:
       case EXT_HDRMATCH: case EXT_BODYLINE: case EXT_OUTSTRING:
       case EXT_FILTER: case EXT_DUMPBODY:
	  break;
       default:
	  abort();
	  break;
     }
    exts |= EXT__BIT(x);
  }
 va_end(ap);
 buf = malloc(strlen(tag)+6+1);
 sprintf(buf,"%sformat",tag);
 val = profile_lookup(p,buf);
 if (val)
  { f = setup_program(val);
    free(buf);
    return(f);
  }
 sprintf(buf,"%sform",tag);
 val = profile_lookup(p,buf);
 if (val)
  { char *bp;
    free(buf);
    buf = malloc(2+filequotelen(val)+1+1);
    bp = buf;
    *bp++ = 'i';
    *bp++ = '(';
    bp = filequotestr(val,bp);
    *bp++ = ')';
    *bp = '\0';
    f = setup_program(buf);
    free(buf);
    return(f);
  }
 free(buf);
 if (need_sigwinch) signal(SIGWINCH,got_sigwinch);
 return(setup_program(defpgm));
}

static STACKEL *spopse(void)
{
 STACKEL *s;

 s = stack;
 stack = s->link;
 return(s);
}

static void sefree(STACKEL *s)
{
 switch (s->type)
  { case SE_INTEGER:
       break;
    case SE_STRING:
       free(s->u.s);
       break;
    default:
       abort();
  }
 free(s);
}

static void spop(void)
{
 sefree(spopse());
}

static void spopn(int n)
{
 for (;n>0;n--) spop();
}

static void spush(int type, ...)
{
 va_list ap;
 STACKEL *s;

 s = malloc(sizeof(STACKEL));
 s->type = type;
 va_start(ap,type);
 switch (type)
  { case SE_INTEGER:
       s->u.i = va_arg(ap,int);
       break;
    case SE_STRING:
       s->u.s = va_arg(ap,char *);
       break;
    case SE_ANY:
       free(s);
       s = va_arg(ap,STACKEL *);
       break;
    default:
       abort();
       break;
  }
 s->link = stack;
 stack = s;
}

static void kidwait(void)
{
 int pid;
 KID **kp;
 KID *k;
 KID *root;

 root = kids;
 kids = 0;
 while (root)
  { pid = wait(0);
    if (pid <= 0) break;
    kp = &root;
    while ((k = *kp))
     { if (k->pid == pid)
	{ *kp = k->link;
	  free(k);
	  break;
	}
       else
	{ kp = &k->link;
	}
     }
  }
 while (root)
  { k = root;
    root = k->link;
    free(k);
  }
}

static void hdrsfree(void)
{
 while (hdrs)
  { HDR *h;
    h = hdrs;
    hdrs = h->link;
    free(h->name);
    free(h->value);
    free(h);
  }
}

static void interp_postcleanup(void)
{
 if (optspec & FOPT_BIT(FOPT_OUTFD))
  { fclose(out);
    if (outpushed) close(outfd);
    kidwait();
  }
 hdrsfree();
 while (stack) spop();
}

typedef struct ierr_buf IERR_BUF;
struct ierr_buf {
  char *wptr;
  int wspace;
  } ;

static int ierr_write(void *bfv, const char *buf, int len)
{
 IERR_BUF *bf;
 int n;

 bf = bfv;
 n = len;
 if (n > bf->wspace) n = bf->wspace;
 bcopy(buf,bf->wptr,n);
 bf->wptr += n;
 bf->wspace -= n;
 return(len);
}

static void print_stack_(FILE *out, STACKEL *stk)
{
 if (stk->link)
  { print_stack_(out,stk->link);
    fprintf(out,", ");
  }
 switch (stk->type)
  { case SE_INTEGER:
       fprintf(out,"%d",stk->u.i);
       break;
    case SE_STRING:
       fprintf(out,"\"");
       print_escaped_str(out,stk->u.s);
       fprintf(out,"\"");
       break;
    default:
       abort();
       break;
  }
}

static void print_stack(FILE *out, STACKEL *stk)
{
 fprintf(out,"(");
 if (stk) print_stack_(out,stk);
 fprintf(out,")");
}

static void interperr(const char *msg)
{
 FILE *f;
 char line[501];
 IERR_BUF bf;

 if (errfn)
  { (*errfn)(msg,fncookie);
    bf.wptr = &line[0];
    bf.wspace = 400;
    f = fwopen(&bf,ierr_write);
    fprintf(f,"at: ");
    print_stack(f,stack);
    bf.wspace += 100;
    fprintf(f," %d: ",pc0);
    print_instr(f,fmt,pc0);
    fclose(f);
    *bf.wptr = '\0';
    (*errfn)(&line[0],fncookie);
  }
 interp_postcleanup();
 longjmp(ierrsj,IESJ_IERR);
}

static void chkarg(const char *pat)
{
 int i;
 STACKEL *s;

 for (i=0,s=stack;pat[i];i++,s=s->link) if (!s) interperr("stack underflow");
 for (i--,s=stack;i>=0;i--,s=s->link)
  { switch (pat[i])
     { case 'i':
	  if (s->type != SE_INTEGER) interperr("non-integer argument");
	  break;
       case 's':
	  if (s->type != SE_STRING) interperr("non-string argument");
	  break;
       case 'b':
	  break;
       case 'x':
	  break;
       default:
	  abort();
	  break;
     }
  }
}

static void int_binop(int op)
{
 int lhs;
 int rhs;
 int r;

 chkarg("ii");
 lhs = stack->link->u.i;
 rhs = stack->u.i;
 switch (op)
  { case C_ADD: r = lhs + rhs; break;
    case C_SUB: r = lhs - rhs; break;
    case C_MUL: r = lhs * rhs; break;
    case C_DIV: if (rhs == 0) interperr("/ by zero"); r = lhs / rhs; break;
    case C_MOD: if (rhs == 0) interperr("% by zero"); r = lhs % rhs; break;
    case C_EQ: r = lhs == rhs; break;
    case C_LT: r = lhs < rhs; break;
    case C_GT: r = lhs > rhs; break;
    default: abort(); break;
  }
 spop();
 stack->u.i = r;
}

static int bool_arg(STACKEL *se)
{
 switch (se->type)
  { case SE_INTEGER:
       return(se->u.i!=0);
       break;
    case SE_STRING:
       return(se->u.s[0]!='\0');
       break;
  }
 abort();
}

static void bool_unop(int op)
{
 int arg;
 int r;

 chkarg("b");
 arg = bool_arg(stack);
 spop();
 switch (op)
  { case C_NOT: r = ! arg; break;
    default: abort(); break;
  }
 spush(SE_INTEGER,r);
}

static void bool_binop(int op)
{
 int lhs;
 int rhs;
 int r;

 chkarg("bb");
 rhs = bool_arg(stack);
 spop();
 lhs = bool_arg(stack);
 spop();
 switch (op)
  { case C_AND: r = lhs && rhs; break;
    case C_OR:  r = lhs || rhs; break;
    case C_XOR: r = lhs ? !rhs : rhs; break;
    default: abort(); break;
  }
 spush(SE_INTEGER,r);
}

static void do_explode(int op)
{
 STACKEL *se1;
 STACKEL *se2;
 char *s1;
 char *s2;
 int l1;
 int l2;
 char *t;
 int np;

 chkarg("ss");
 se2 = spopse();
 se1 = spopse();
 s1 = se1->u.s;
 s2 = se2->u.s;
 l1 = strlen(s1);
 l2 = strlen(s2);
 if (l2 == 0)
  { np = 0;
    for (;*s1;s1++)
     { t = malloc(2);
       t[0] = *s1;
       t[1] = '\0';
       spush(SE_STRING,t);
       np ++;
     }
  }
 else
  { int maxo;
    int o;
    int o0;
    maxo = l1 - l2;
    if (maxo < 0)
     { spush(SE_ANY,se1);
       sefree(se2);
       spush(SE_INTEGER,1);
       return;
     }
    np = 0;
    o = 0;
    o0 = 0;
    while (o <= maxo)
     { if (!bcmp(s1+o,s2,l2))
	{ np ++;
	  t = malloc((o-o0)+1);
	  bcopy(s1+o0,t,o-o0);
	  t[o-o0] = '\0';
	  spush(SE_STRING,t);
	  o += l2;
	  o0 = o;
	}
       else
	{ o ++;
	}
     }
    spush(SE_STRING,strdup(s1+o0));
    np ++;
  }
 sefree(se1);
 sefree(se2);
 if (op == C_EXPLODE)
  { int i;
    STACKEL **tp;
    se1 = 0;
    for (i=0;i<np;i++)
     { se2 = spopse();
       se2->link = se1;
       se1 = se2;
     }
    if (se1)
     { for (se2=se1;se2->link;se2=se2->link) ;
       tp = &se2->link;
       *tp = stack;
       stack = se1;
     }
  }
 spush(SE_INTEGER,np);
}

static void do_implode(int op)
{
 int n;
 char *sep;
 int seplen;
 int len;
 char *rv;
 int o;
 int i;
 int l;
 STACKEL *se;

 chkarg("is");
 se = stack;
 sep = se->u.s;
 se = se->link;
 n = se->u.i;
 se = se->link;
 if (n < 0) interperr("negative count to $!+/$!-");
 len = 0;
 for (i=n;se&&(i>0);i--,se=se->link)
  { if (se->type != SE_STRING) interperr("non-string argument");
    len += strlen(se->u.s);
  }
 if (i > 0) interperr("stack underflow");
 seplen = strlen(sep);
 if (n > 1) len += (n-1) * seplen;
 rv = malloc(len+1);
 switch (op)
  { case C_IMPLODE:
       o = 0;
       for (i=n,se=stack->link->link;i>0;i--,se=se->link)
	{ l = strlen(se->u.s);
	  bcopy(se->u.s,rv+o,l);
	  o += l;
	  if (i > 1)
	   { bcopy(sep,rv+o,seplen);
	     o += seplen;
	   }
	}
       rv[o] = '\0';
       break;
    case C_RIMPLODE:
       o = len;
       rv[o] = '\0';
       for (i=n,se=stack->link->link;i>0;i--,se=se->link)
	{ l = strlen(se->u.s);
	  o -= l;
	  bcopy(se->u.s,rv+o,l);
	  if (i > 1)
	   { o -= seplen;
	     bcopy(sep,rv+o,seplen);
	   }
	}
       break;
    default:
       abort();
       break;
  }
 spopn(n+2);
 spush(SE_STRING,rv);
}

static void do_search(int op)
{
 char *sbig;
 char *ssmall;
 int lbig;
 int lsmall;
 int o;
 int m;
 __typeof__(&strncmp) fn;

 chkarg("ss");
 sbig = stack->u.s;
 ssmall = stack->link->u.s;
 lbig = strlen(sbig);
 lsmall = strlen(ssmall);
 switch (op)
  { case C_INSTR: case C_RINSTR: fn = strncmp; break;
    case C_INSTRING: case C_RINSTRING: fn = strncasecmp; break;
    default: abort(); break;
  }
 m = lbig - lsmall;
 switch (op)
  { case C_INSTR: case C_INSTRING:
       for (o=0;o<=m;o++) if (!(*fn)(sbig+o,ssmall,lsmall)) break;
       break;
    case C_RINSTR: case C_RINSTRING:
       for (o=m;o>=0;o--) if (!(*fn)(sbig+o,ssmall,lsmall)) break;
       break;
  }
 spop();
 spop();
 if ((o < 0) || (o > m)) o = -1;
 spush(SE_INTEGER,o);
}

static void do_chgcase(int (*fn)(int))
{
 char *s;

 chkarg("s");
 for (s=stack->u.s;*s;s++) *s = (*fn)(*s);
}

static STACKEL *stackel_clone(STACKEL *s)
{
 STACKEL *n;

 n = malloc(sizeof(STACKEL));
 *n = *s;
 switch (s->type)
  { case SE_INTEGER:
       break;
    case SE_STRING:
       n->u.s = strdup(s->u.s);
       break;
    default:
       abort();
       break;
  }
 return(n);
}

static void hdr_date_parse(void)
{
 int t;

 chkarg("s");
 t = parsedate(stack->u.s);
 spop();
 spush(SE_INTEGER,t);
}

static void hdr_date_cur(void)
{
 spush(SE_INTEGER,time(0));
}

static void hdr_date_part(int op)
{
 struct tm *tm;
 time_t t;
 int v;

 chkarg("i");
 t = stack->u.i;
 tm = localtime(&t);
 switch (op)
  { case C_H_D_YEAR:    v = tm->tm_year + 1900; break;
    case C_H_D_MONTH:   v = tm->tm_mon + 1;     break;
    case C_H_D_MDAY:    v = tm->tm_mday;        break;
    case C_H_D_WDAY:    v = tm->tm_wday;        break;
    case C_H_D_HOUR:    v = tm->tm_hour;        break;
    case C_H_D_MINUTE:  v = tm->tm_min;         break;
    case C_H_D_SECOND:  v = tm->tm_sec;         break;
    case C_H_D_ZONEOFF: v = tm->tm_gmtoff/60;   break;
    default: abort(); break;
  }
 spop();
 spush(SE_INTEGER,v);
}

static void hdr_date_explode(void)
{
 struct tm *tm;
 time_t t;

 chkarg("i");
 t = stack->u.i;
 tm = localtime(&t);
 spop();
 spush(SE_INTEGER,tm->tm_year+1900);
 spush(SE_INTEGER,tm->tm_mon+1);
 spush(SE_INTEGER,tm->tm_mday);
 spush(SE_INTEGER,tm->tm_wday);
 spush(SE_INTEGER,tm->tm_hour);
 spush(SE_INTEGER,tm->tm_min);
 spush(SE_INTEGER,tm->tm_sec);
 spush(SE_INTEGER,tm->tm_gmtoff/60);
}

static void hdr_date_str_zone(void)
{
 struct tm *tm;
 time_t t;

 chkarg("i");
 t = stack->u.i;
 tm = localtime(&t);
 spop();
 spush(SE_STRING,strdup(tm->tm_zone));
}

static void hdr_date_str(int op)
{
 static const char *m_table[] = { "January", "February", "March",
				  "April", "May", "June",
				  "July", "August", "September",
				  "October", "November", "December" };
 static const char *w_table[] = { "Sunday", "Monday", "Tuesday", "Wednesday",
				  "Thursday", "Friday", "Saturday" };
 const char **table;
 int v;
 int maxv;
 char *s;

 chkarg("i");
 v = stack->u.i;
 switch (op)
  { case C_H_D_STR_M_S: case C_H_D_STR_M_L:
       table = m_table;
       v --;
       maxv = 12;
       break;
    case C_H_D_STR_W_S: case C_H_D_STR_W_L:
       table = w_table;
       maxv = 7;
       break;
    default:
       abort();
       break;
  }
 if ((v < 0) || (v >= maxv)) interperr("argument out of range");
 s = strdup(table[v]);
 switch (op)
  { case C_H_D_STR_M_S: case C_H_D_STR_W_S: s[3] = '\0'; break;
  }
 spop();
 spush(SE_STRING,s);
}

static void hdr_addr_op(int op)
{
 char *str;
 int slen;
 unsigned char *sflg;
#define SF_QPAIR   0x01
#define SF_QSTRING 0x02
#define SF_COMMENT 0x04
#define SF_DOMLIT  0x08
#define SF_ADDRSEP 0x10
 int abegin;
 int aend;
 int cdepth;
 int o;
 int commas;
 unsigned char f;

 chkarg("s");
 str = stack->u.s;
 slen = strlen(str);
 sflg = malloc(slen);
 bzero(sflg,slen);
 cdepth = 0;
 commas = 0;
 abegin = -1;
 aend = -1;
 f = 0;
 for (o=0;o<slen;o++)
  { if (f & SF_QPAIR)
     { sflg[o] = f;
       f &= ~SF_QPAIR;
       continue;
     }
    if (f & (SF_COMMENT|SF_QSTRING|SF_DOMLIT))
     { if (str[o] == '\\')
	{ f |= SF_QPAIR;
	  sflg[o] = f;
	  continue;
	}
       switch (str[o])
	{ case ']':
	     if (f & SF_DOMLIT)
	      { sflg[o] = f;
		f &= ~SF_DOMLIT;
		continue;
	      }
	     break;
	  case '"':
	     if (f & SF_QSTRING)
	      { sflg[o] = f;
		f &= ~SF_QSTRING;
		continue;
	      }
	     break;
	  case '(': case ')':
	     if (f & SF_COMMENT)
	      { sflg[o] = f;
		if (str[o] == '(') cdepth ++; else cdepth --;
		if (cdepth < 1) f &= ~SF_COMMENT;
		continue;
	      }
	     break;
	}
     }
    switch (str[o])
     { case '[':
	  f |= SF_DOMLIT;
	  break;
       case '"':
	  f |= SF_QSTRING;
	  break;
       case '(':
	  f |= SF_COMMENT;
	  cdepth = 1;
	  break;
       case '<':
	  if (abegin < 0) abegin = o;
	  break;
       case '>':
	  if ((aend < 0) && (abegin >= 0)) aend = o;
	  break;
       case ',':
	  sflg[o] = f | SF_ADDRSEP;
	  commas ++;
	  continue;
	  break;
     }
    sflg[o] = f;
  }
 switch (op)
  { case C_H_A_ADDR:
	{ char *t;
	  if (aend >= 0)
	   { t = malloc(aend-abegin);
	     bcopy(str+abegin+1,t,aend-abegin-1);
	     t[aend-abegin-1] = '\0';
	   }
	  else
	   { int c;
	     t = malloc(slen+1);
	     c = 0;
	     for (o=0;o<slen;o++)
	      { if (sflg[o] & SF_COMMENT) continue;
		t[c++] = str[o];
	      }
	     t[c] = '\0';
	   }
	  spop();
	  spush(SE_STRING,t);
	}
       break;
    case C_H_A_COMMENT:
	{ char *t;
	  int c;
	  t = malloc(slen+1);
	  c = 0;
	  for (o=0;o<slen;o++)
	   { if ( (aend >= 0)
		  ? ((o >= abegin) && (o <= aend))
		  : !(sflg[o] & SF_COMMENT) ) continue;
	     t[c++] = str[o];
	   }
	  if ((aend < 0) && (c >= 2) && (t[0] == '(') && (t[c-1] == ')'))
	   { bcopy(t+1,t,c-1);
	     c --;
	   }
	  t[c] = '\0';
	  spop();
	  spush(SE_STRING,t);
	}
       break;
    case C_H_A_COUNT:
       spop();
       spush(SE_INTEGER,commas+1);
       break;
    case C_H_A_EXPLODE:
	{ STACKEL *se;
	  char *t;
	  int o0;
	  se = spopse();
	  o0 = 0;
	  for (o=0;o<=slen;o++)
	   { if ((sflg[o] & SF_ADDRSEP) || (o == slen))
	      { t = malloc((o-o0)+1);
		bcopy(str+o,t,o-o0);
		t[o-o0] = '\0';
		spush(SE_STRING,t);
		o0 = o + 1;
	      }
	   }
	  spush(SE_INTEGER,commas+1);
	  sefree(se);
	}
       break;
  }
 free(sflg);
#undef SF_QPAIR
#undef SF_QSTRING
#undef SF_COMMENT
#undef SF_DOMLIT
#undef SF_ADDRSEP
}

static void do_typetest(int destype)
{
 int rv;

 chkarg("x");
 rv = (stack->type == destype);
 spush(SE_INTEGER,rv);
}

static void dmove(int from, int to)
{
 if (from == to) return;
 dup2(from,to);
 close(from);
}

static void record_kid(int pid)
{
 KID *k;

 k = malloc(sizeof(KID));
 k->pid = pid;
 k->link = kids;
 kids = k;
}

static int fmt_run_write(void *cookie __attribute__((__unused__)), const char *buf, int nb)
{
 return(write(outfd,buf,nb));
}

static void push_process(void (*fn)(void *), void *arg)
{
 int p[2];
 int kid;

 if (pipe(p) < 0)
  { fprintf(stderr,"%s: pipe: %s\n",__progname,strerror(errno));
    exit(1);
  }
 fclose(out);
 kid = fork();
 if (kid < 0)
  { fprintf(stderr,"%s: fork: %s\n",__progname,strerror(errno));
    exit(1);
  }
 if (kid == 0)
  { int e;
    int i;
    const char **cmd;
    dmove(outfd,1);
    dmove(p[0],0);
    close(p[1]);
    (*fn)(arg);
    e = errno;
    cmd = arg;
    fprintf(stderr,"%s: (%s)",__progname,cmd[0]);
    for (i=1;cmd[i];i++) fprintf(stderr," %s",cmd[i]);
    fprintf(stderr,": %s\n",strerror(e));
    fflush(stderr);
    _exit(1);
  }
 record_kid(kid);
 if (outpushed) close(outfd);
 outfd = p[1];
 outpushed = 1;
 out = fwopen(0,fmt_run_write);
 close(p[0]);
}

static void exec_it(void *avv)
{
 execvp(((char **)avv)[0],1+(char **)avv);
}

static void push_filter(void)
{
 const char **cmd;
 int npop;

 chkarg("x");
 switch (stack->type)
  { case SE_INTEGER:
	{ int n;
	  int i;
	  STACKEL *se;
	  n = stack->u.i;
	  if (n < 1) interperr("nargs < 1 to @filter");
	  cmd = malloc((n+2)*sizeof(const char *));
	  for (se=stack->link,i=n;i>=0;se=se->link,i--)
	   { if (! se)
	      { free(cmd);
		interperr("stack underflow");
	      }
	     if (se->type != SE_STRING)
	      { free(cmd);
		interperr("non-string argument to @filter");
	      }
	     cmd[i] = se->u.s;
	   }
	  cmd[n+1] = 0;
	  npop = n + 2;
	}
       break;
    case SE_STRING:
       cmd = malloc(5*sizeof(const char *));
       cmd[0] = (getenv("SHELL") ? : "/bin/sh");
       cmd[1] = cmd[0];
       cmd[2] = "-c";
       cmd[3] = stack->u.s;
       cmd[4] = 0;
       npop = 1;
       break;
  }
 push_process(exec_it,cmd);
 spopn(npop);
}

static int get_hdr(MESSAGE *m __attribute__((__unused__)), const char *name, const char *val, void *vtp)
{
 HDR *h;

 h = malloc(sizeof(HDR));
 h->seen = 0;
 h->name = strdup(name);
 h->value = strdup(val);
 **(HDR ***)vtp = h;
 *(HDR ***)vtp = &h->link;
 return(0);
}

static void check_hdrs(void)
{
 HDR **tail;
 HDR *root;

 if (hdrsloaded) return;
 tail = &root;
 message_header_scan(msg,get_hdr,&tail);
 *tail = 0;
 hdrsloaded = 1;
 hdrs = root;
 message_body_begin(msg);
}

static void do_get_hdr(int (*cmpfn)(HDR *, void *), void *cookie, int npop)
{
 HDR *h;

 chkarg("s");
 check_hdrs();
 for (h=hdrs;h;h=h->link)
  { if (h->seen) continue;
    if ((*cmpfn)(h,cookie))
     { h->seen = 1;
       spopn(npop);
       spush(SE_STRING,strdup(h->name));
       spush(SE_STRING,strdup(h->value));
       return;
     }
  }
 spopn(npop);
 spush(SE_INTEGER,0);
}

static void do_reset_hdrs(void)
{
 HDR *h;

 check_hdrs();
 for (h=hdrs;h;h=h->link) h->seen = 0;
}

static int hdr_cmp_simple(HDR *h, void *svp)
{
 char *s;

 s = svp;
 return(!*s || !strcasecmp(h->name,s));
}

static int hdr_cmp_regexp(HDR *h, void *revp)
{
 return(!regexec((regex_t *)revp,h->name,0,0,0));
}

static regex_t *cached_re_comp(const char *s)
{
 regex_t re;
 RECACHE **rp;
 RECACHE *r;

 rp = &recache;
 while ((r = *rp))
  { if (! strcmp(s,r->s))
     { if (r != recache)
	{ *rp = r->link;
	  r->link = recache;
	  recache = r;
	}
       return(&r->re);
     }
  }
 if (regcomp(&re,s,REG_EXTENDED|REG_ICASE|REG_NOSUB)) interperr("invalid RE");
 r = malloc(sizeof(RECACHE));
 r->s = strdup(s);
 r->re = re;
 r->link = recache;
 recache = r;
 return(&r->re);
}

static void execute_extension(int x)
{
 switch (x)
  { case EXT_WIDTH:
       get_tty_size();
       spush(SE_INTEGER,ttysize.ws_col);
       break;
    case EXT_HEIGHT:
       get_tty_size();
       spush(SE_INTEGER,ttysize.ws_row);
       break;
    case EXT_UNIXFROM:
	{ const char *uf;
	  if (! msg) interperr("@unixfrom without a message");
	  check_hdrs();
	  uf = message_unix_from(msg);
	  if (uf) spush(SE_STRING,strdup(uf)); else spush(SE_INTEGER,0);
	}
       break;
    case EXT_HDRRESET:
       if (! msg) interperr("@hdrreset without a message");
       do_reset_hdrs();
       break;
    case EXT_HDRGET:
       if (! msg) interperr("@hdrget without a message");
       do_get_hdr(hdr_cmp_simple,stack->u.s,1);
       break;
    case EXT_HDRMATCH:
       if (! msg) interperr("@hdrmatch without a message");
       do_get_hdr(hdr_cmp_regexp,cached_re_comp(stack->u.s),1);
       break;
    case EXT_BODYLINE:
	{ char *l;
	  if (! msg) interperr("@bodyline without a message");
	  check_hdrs();
	  l = message_body_line(msg);
	  if (l) spush(SE_STRING,l); else spush(SE_INTEGER,0);
	}
       break;
    case EXT_OUTSTRING:
       if (! out) interperr("@outstring without output");
       chkarg("s");
       fprintf(out,"%s",stack->u.s);
       spop();
       break;
    case EXT_FILTER:
       if (! out) interperr("@filter without output");
       push_filter();
       break;
    case EXT_DUMPBODY:
	{ FILE *f;
	  int c;
	  if (! out) interperr("@dumpbody without output");
	  if (! msg) interperr("@dumpbody without a message");
	  f = message_fp(msg);
	  while ((c=getc(f)) != EOF) putc(c,out);
	}
       break;
    default:
       abort();
       break;
  }
}

static void crank(void)
{
 while (1)
  { if ((pc < 0) || (pc >= fmt->codesize)) abort();
    if (debugging)
     { int npc;
       print_stack(stderr,stack);
       fprintf(stderr," %d: ",pc);
       npc = print_instr(stderr,fmt,pc);
       fprintf(stderr,"  [%d]\n",npc);
     }
    pc0 = pc;
    switch (fmt->code[pc++])
     { case C_NCONST:
	   { int v;
	     bcopy(&fmt->code[pc],&v,sizeof(int));
	     spush(SE_INTEGER,v);
	     pc += sizeof(int);
	   }
	  break;
       case C_SCONST:
	   { int l;
	     l = strlen((char *)&fmt->code[pc]);
	     spush(SE_STRING,strdup((char *)&fmt->code[pc]));
	     pc += l + 1;
	   }
	  break;
       case C_ADD: case C_SUB: case C_MUL: case C_DIV: case C_MOD:
       case C_EQ: case C_LT: case C_GT:
	  int_binop(fmt->code[pc-1]);
	  break;
       case C_NOT:
	  bool_unop(fmt->code[pc-1]);
	  break;
       case C_AND: case C_OR: case C_XOR:
	  bool_binop(fmt->code[pc-1]);
	  break;
       case C_IF:
	   { int cond;
	     chkarg("b");
	     cond = bool_arg(stack);
	     spop();
	     if (cond)
	      { pc += sizeof(int);
		break;
	      }
	   }
	  /* fall through */
       case C_JMP:
	   { int targ;
	     bcopy(&fmt->code[pc],&targ,sizeof(int));
	     pc = targ;
	   }
	  break;
       case C_STRCAT:
	   { char *t;
	     chkarg("ss");
	     t = malloc(strlen(stack->link->u.s)+strlen(stack->u.s)+1);
	     sprintf(t,"%s%s",stack->link->u.s,stack->u.s);
	     spop();
	     spop();
	     spush(SE_STRING,t);
	   }
	  break;
       case C_STRCMP:
	   { int v;
	     chkarg("ss");
	     v = strcmp(stack->link->u.s,stack->u.s);
	     spop();
	     spop();
	     spush(SE_INTEGER,v);
	   }
	  break;
       case C_STRINGCMP:
	   { int v;
	     chkarg("ss");
	     v = strcasecmp(stack->link->u.s,stack->u.s);
	     spop();
	     spop();
	     spush(SE_INTEGER,v);
	   }
	  break;
       case C_STRCUT:
	   { char *s;
	     char *s1;
	     char *s2;
	     int sl;
	     int c;
	     chkarg("si");
	     s = stack->link->u.s;
	     c = stack->u.i;
	     sl = strlen(s);
	     if (c < 0) c += sl;
	     if (c < 0) c = 0; else if (c >= sl) c = sl;
	     s1 = malloc(c+1);
	     s2 = malloc((sl-c)+1);
	     bcopy(s,s1,c);
	     s1[c] = '\0';
	     bcopy(s+c,s2,sl-c);
	     s2[sl-c] = '\0';
	     spop();
	     spop();
	     spush(SE_STRING,s1);
	     spush(SE_STRING,s2);
	   }
	  break;
       case C_SUBSTR:
	   { char *s;
	     int i1;
	     int i2;
	     int sl;
	     char *t;
	     chkarg("sii");
	     s = stack->link->link->u.s;
	     i1 = stack->link->u.i;
	     i2 = stack->u.i;
	     sl = strlen(s);
	     if (i1 < 0) i1 += sl;
	     if (i2 < 0) i2 += sl;
	     if ((i2 < 0) || (i1 > sl)) { i1 = 0; i2 = 0; }
	     else if (i1 < 0)           { i2 -= i1; i1 = 0; }
	     else if (i1+i2 > sl)       { i2 = sl - i1; }
	     t = malloc(i2+1);
	     bcopy(s+i1,t,i2);
	     t[i2] = '\0';
	     spop();
	     spop();
	     spop();
	     spush(SE_STRING,t);
	   }
	  break;
       case C_STRLEN:
	   { int l;
	     chkarg("s");
	     l = strlen(stack->u.s);
	     spop();
	     spush(SE_INTEGER,l);
	   }
	  break;
       case C_EXPLODE: case C_REXPLODE:
	  do_explode(fmt->code[pc-1]);
	  break;
       case C_IMPLODE: case C_RIMPLODE:
	  do_implode(fmt->code[pc-1]);
	  break;
       case C_INSTR: case C_INSTRING: case C_RINSTR: case C_RINSTRING:
	  do_search(fmt->code[pc-1]);
	  break;
       case C_ATOI:
	   { int v;
	     chkarg("s");
	     v = atoi(stack->u.s);
	     spop();
	     spush(SE_INTEGER,v);
	   }
	  break;
       case C_INTOSTR_W:
	   { int width;
	     char pad;
	     int v;
	     int npop;
	     char ibuf[(((CHAR_BIT*sizeof(int))+2)/3)+2];
	     char *t;
	     chkarg("iii");
	     npop = 3;
	     v = stack->link->link->u.i;
	     width = stack->link->u.i;
	     pad = stack->u.i;
	     if (0)
	      {
       case C_INTOSTR:
		chkarg("i");
		npop = 1;
		v = stack->u.i;
		width = 1;
		pad = ' ';
	      }
	     sprintf(&ibuf[0],"%d",v);
	     v = strlen(&ibuf[0]);
	     if (v < width)
	      { t = malloc(width+1);
		memset(t,pad,width-v);
		bcopy(&ibuf[0],t+(width-v),v+1);
	      }
	     else
	      { t = strdup(&ibuf[0]);
	      }
	     spopn(npop);
	     spush(SE_STRING,t);
	   }
	  break;
       case C_UPCASE:
	  do_chgcase(toupper);
	  break;
       case C_DNCASE:
	  do_chgcase(tolower);
	  break;
       case C_DUP:
	  chkarg("x");
	  spush(SE_ANY,stackel_clone(stack));
	  break;
       case C_SWAP:
	   { STACKEL *x1;
	     STACKEL *x2;
	     chkarg("xx");
	     x2 = spopse();
	     x1 = spopse();
	     spush(SE_ANY,x2);
	     spush(SE_ANY,x1);
	   }
	  break;
       case C_POP:
	  chkarg("x");
	  spop();
	  break;
       case C_ROT:
	   { STACKEL *x1;
	     STACKEL *x2;
	     STACKEL *x3;
	     chkarg("xxx");
	     x3 = spopse();
	     x2 = spopse();
	     x1 = spopse();
	     spush(SE_ANY,x2);
	     spush(SE_ANY,x3);
	     spush(SE_ANY,x1);
	   }
	  break;
       case C_NROT:
	   { STACKEL *x1;
	     STACKEL *x2;
	     STACKEL *x3;
	     chkarg("xxx");
	     x3 = spopse();
	     x2 = spopse();
	     x1 = spopse();
	     spush(SE_ANY,x3);
	     spush(SE_ANY,x1);
	     spush(SE_ANY,x2);
	   }
	  break;
       case C_ROTATE:
	   { int n;
	     chkarg("i");
	     n = stack->u.i;
	     if (n > 1)
	      { STACKEL *above;
		STACKEL *el;
		STACKEL *below;
		for (above=stack;n>1;n--,above=above->link) if (! above) interperr("stack underflow");
		el = above->link;
		if (! el) interperr("stack underflow");
		below = el->link;
		spop();
		el->link = stack;
		above->link = below;
		stack = el;
	      }
	     else if (n < -1)
	      { STACKEL *above;
		STACKEL *el;
		STACKEL *below;
		for (above=stack;n<0;n++,above=above->link) if (! above) interperr("stack underflow");
		spop();
		el = stack;
		below = above->link;
		stack = el->link;
		above->link = el;
		el->link = below;
	      }
	     else
	      { spop();
	      }
	   }
	  break;
       case C_ROLL:
	   { STACKEL **xml;
	     STACKEL **xnl;
	     STACKEL **xp;
	     STACKEL *e;
	     int i;
	     int n;
	     int m;
	     chkarg("ii");
	     n = stack->link->u.i;
	     m = stack->u.i;
	     if (n <= 0) interperr("sl length arg must be >0");
	     m %= n;
	     if (m < 0) m += n;
	     if (m == 0) break;
	     xp = &stack->link->link;
	     for (i=0;i<m;i++)
	      { e = *xp;
		if (e == 0) interperr("stack underflow");
		xp = &e->link;
	      }
	     xml = xp;
	     for (;i<n;i++)
	      { e = *xp;
		if (e == 0) interperr("stack underflow");
		xp = &e->link;
	      }
	     spop();
	     spop();
	     xnl = xp;
	     e = *xml;
	     *xml = *xnl;
	     *xnl = stack;
	     stack = e;
	   }
	  break;
       case C_PICK:
	   { int i;
	     STACKEL *e;
	     chkarg("i");
	     i = stack->u.i;
	     if (i <= 0) interperr("sg arg must be > 0");
	     for (e=stack;e&&(i>0);i--,e=e->link) ;
	     if (e == 0) interperr("stack underflow");
	     spop();
	     spush(SE_ANY,stackel_clone(e));
	   }
	  break;
       case C_PUT:
	   { int i;
	     STACKEL *a;
	     STACKEL *t;
	     chkarg("xi");
	     i = stack->u.i;
	     if (i <= 0) interperr("sp arg must be > 0");
	     if (i == 1)
	      { spop();
		a = stack->link;
		stack->link = a->link;
		a->link = stack;
		stack = a;
		spop();
	      }
	     else
	      { spop();
		for (a=stack;a&&(i>1);i--,a=a->link) ;
		if (!a || !a->link) interperr("stack underflow");
		t = stack;
		stack = stack->link;
		t->link = a->link->link;
		a->link->link = stack;
		stack = a->link;
		a->link = t;
		spop();
	      }
	   }
	  break;
       case C_OVER:
	  chkarg("xx");
	  spush(SE_ANY,stackel_clone(stack->link));
	  break;
       case C_DEPTH:
	   { int d;
	     STACKEL *e;
	     for (d=0,e=stack;e;d++,e=e->link) ;
	     spush(SE_INTEGER,d);
	   }
	  break;
       case C_TST_I:
	  do_typetest(SE_INTEGER);
	  break;
       case C_TST_S:
	  do_typetest(SE_STRING);
	  break;
       case C_ENV_GET:
	   { char *v;
	     chkarg("s");
	     v = getenv(stack->u.s);
	     spop();
	     if (v) spush(SE_STRING,strdup(v)); else spush(SE_INTEGER,0);
	   }
	  break;
       case C_ENV_PUT:
	  chkarg("s");
	  putenv(stack->u.s);
	  spop();
	  break;
       case C_ENV_UNSET:
	  chkarg("s");
	  unsetenv(stack->u.s);
	  spop();
	  break;
       case C_CALL:
	   { int targ;
	     int spc;
	     bcopy(&fmt->code[pc],&targ,sizeof(int));
	     spc = pc + sizeof(int);
	     pc = targ;
	     crank();
	     pc = spc;
	   }
	  break;
       case C_ICALL:
	   { int spc;
	     chkarg("i");
	     if ((stack->u.i < 0) || (stack->u.i >= fmt->ncb)) interperr("bad code pointer");
	     spc = pc;
	     pc = fmt->cb[stack->u.i];
	     spop();
	     crank();
	     pc = spc;
	   }
	  break;
       case C_H_STR:
	   { int l;
	     const char *v;
	     if (! msg) interperr("hs(...) without a message");
	     l = strlen((char *)&fmt->code[pc]);
	     v = message_header_val(msg,(char *)&fmt->code[pc]);
	     spush(SE_STRING,strdup(v?v:""));
	     pc += l + 1;
	   }
	  break;
       case C_H_STR_TOS:
	   { const char *v;
	     if (! msg) interperr("hs() without a message");
	     chkarg("s");
	     v = message_header_val(msg,stack->u.s);
	     spop();
	     spush(SE_STRING,strdup(v?v:""));
	   }
	  break;
       case C_H_D_PARSE:
	  hdr_date_parse();
	  break;
       case C_H_D_CUR:
	  hdr_date_cur();
	  break;
       case C_H_D_YEAR: case C_H_D_MONTH: case C_H_D_MDAY: case C_H_D_WDAY:
       case C_H_D_HOUR: case C_H_D_MINUTE: case C_H_D_SECOND:
	  hdr_date_part(fmt->code[pc-1]);
	  break;
       case C_H_D_EXPLODE:
	  hdr_date_explode();
	  break;
       case C_H_D_STR_ZONE:
	  hdr_date_str_zone();
	  break;
       case C_H_D_STR_M_S: case C_H_D_STR_M_L:
       case C_H_D_STR_W_S: case C_H_D_STR_W_L:
	  hdr_date_str(fmt->code[pc-1]);
	  break;
       case C_H_A_ADDR: case C_H_A_COMMENT:
       case C_H_A_COUNT: case C_H_A_EXPLODE:
	  hdr_addr_op(fmt->code[pc-1]);
	  break;
       case C_M_NUMBER:
	  if (! msg) interperr("mn without a message");
	  spush(SE_INTEGER,message_number(msg));
	  break;
       case C_M_FOLDER:
	  if (! msg) interperr("mf without a message");
	  spush(SE_STRING,strdup(folder_name(message_folder(msg))));
	  break;
       case C_M_PNUMBER:
	   { int v;
	     if (! msg) interperr("m#p without a message");
	     v = folder_msg(message_folder(msg),FM_PREV);
	     if (v < 0) v = -1;
	     spush(SE_INTEGER,v);
	   }
	  break;
       case C_M_CNUMBER:
	   { int v;
	     if (! msg) interperr("m#c without a message");
	     v = folder_msg(message_folder(msg),FM_CUR);
	     if (v < 0) v = -1;
	     spush(SE_INTEGER,v);
	   }
	  break;
       case C_M_NNUMBER:
	   { int v;
	     if (! msg) interperr("m#n without a message");
	     v = folder_msg(message_folder(msg),FM_NEXT);
	     if (v < 0) v = -1;
	     spush(SE_INTEGER,v);
	   }
	  break;
       case C_M_CFOLDER:
	   { char *s;
	     s = context_lookup("folder");
	     spush(SE_STRING,s?s:strdup(""));
	   }
	  break;
       case C_M_ISPREV_NUMBER:
	  if (! msg) interperr("m?#p without a message");
	  spush(SE_INTEGER,message_number(msg)==folder_msg(message_folder(msg),FM_PREV));
	  break;
       case C_M_ISCUR_NUMBER:
	  if (! msg) interperr("m?#c without a message");
	  spush(SE_INTEGER,message_number(msg)==folder_msg(message_folder(msg),FM_CUR));
	  break;
       case C_M_ISNEXT_NUMBER:
	  if (! msg) interperr("m?#n without a message");
	  spush(SE_INTEGER,message_number(msg)==folder_msg(message_folder(msg),FM_NEXT));
	  break;
       case C_M_ISCUR_FOLDER:
	   { char *cf;
	     if (! msg) interperr("m?cf without a message");
	     cf = context_lookup("folder");
	     spush(SE_INTEGER,cf&&!strcmp(cf,folder_name(message_folder(msg))));
	     if (cf) free(cf);
	   }
	  break;
       case C_Q_MEMBER:
	   { FOLDER *f;
	     char *fn;
	     char *sn;
	     int mn;
	     int rv;
	     chkarg("ssi");
	     fn = stack->link->link->u.s;
	     sn = stack->link->u.s;
	     mn = stack->u.i;
	     rv = 0;
	     if (folder_lookup(fn,&f,0))
	      { SEQS *ss;
		SEQ *s;
		folder_lock(f,FOLDER_WAIT|FOLDER_SHARED);
		ss = seqs_open(f);
		s = seq_lookup(ss,sn);
		rv = seq_test(s,mn);
		seqs_abort(ss);
		folder_unlock(f);
	      }
	     spop();
	     spop();
	     spop();
	     spush(SE_INTEGER,rv!=0);
	   }
	  break;
       case C_EXTENSION:
	  execute_extension(fmt->code[pc++]);
	  break;
       case C_RET:
	  return;
	  break;
       default:
	  abort();
	  break;
     }
  }
}

static void got_sigpipe(int sig __attribute__((__unused__)))
{
 longjmp(ierrsj,IESJ_PIPE);
}

static void preload_stack(int n, FMT_STACK *vec)
{
 int i;

 for (i=0;i<n;i++)
  { switch (vec[i].type)
     { case FOS_T_INTEGER:
	  spush(SE_INTEGER,vec[i].u.i);
	  break;
       case FOS_T_STRING:
	  spush(SE_STRING,strdup(vec[i].u.s));
	  break;
       default:
	  abort();
	  break;
     }
  }
}

#if 0

static void copy_stuff(int f, const char *ftag, int t, const char *ttag)
{
 int n;
 int r;
 char buf[65536];

 while (1)
  { n = read(f,&buf[0],sizeof(buf));
    if (n < 0)
     { fprintf(stderr,"%s: %s read error: %s\n",__progname,ftag,strerror(errno));
       break;
     }
    if (n == 0) break;
    r = write(t,&buf[0],n);
    if (r < 0)
     { fprintf(stderr,"%s: %s write error: %s\n",__progname,ttag,strerror(errno));
       break;
     }
    if (r < n)
     { int o;
       int l;
       fprintf(stderr,"%s: short %s write, retrying rest\n",__progname,ttag);
       o = r;
       l = n - r;
       while (l > 0)
	{ r = write(fd,&buf[o],l);
	  if (r < 0)
	   { fprintf(stderr,"%s: %s write error: %s\n",__progname,ttag,strerror(errno));
	     break;
	   }
	  l -= r;
	  o += r;
	}
     }
  }
}

#endif

#if 0

void buffer_it(void *arg __attribute__((__unused__)))
{
 int fd;
 static char fn[] = "/tmp/format.XXXXXX";

 fd = mkstemp(&fn[0]);
 if (fd < 0)
  { fprintf(stderr,"%s: mkstemp: %s\n",__progname,strerror(errno));
    exit(1);
  }
 copy_stuff(0,"message",fd,"temp file");
 lseek(fd,0,SEEK_SET);
 copy_stuff(fd,"temp file",1,"output");
 exit(0);
}

#endif

void format_run(FORMAT *f, MESSAGE *m, void (*ok)(const char *, void *), void (*err)(const char *, void *), void *cookie, ...)
{
 va_list ap;
 int optval;
 int stackn;
 FMT_STACK *stackload;

 optspec = 0;
 va_start(ap,cookie);
 while (1)
  { optval = va_arg(ap,int);
    if (optval == FOPT_END) break;
    switch (optval)
     { case FOPT_OUTFD:
	  outfd = va_arg(ap,int);
	  break;
       case FOPT_STACK:
	  stackn = va_arg(ap,int);
	  stackload = va_arg(ap,FMT_STACK *);
	  break;
       default:
	  abort();
	  break;
     }
    optspec |= FOPT_BIT(optval);
  }
 msg = m;
 fmt = f;
 pc = 0;
 stack = 0;
 kids = 0;
 hdrs = 0;
 hdrsloaded = 0;
 out = 0;
 errfn = err;
 fncookie = cookie;
 if (optspec & FOPT_BIT(FOPT_OUTFD))
  { out = fwopen(0,fmt_run_write);
    outpushed = 0;
  }
 if (optspec & FOPT_BIT(FOPT_STACK))
  { preload_stack(stackn,stackload);
  }
 switch (setjmp(ierrsj))
  { case 0:
       signal(SIGPIPE,got_sigpipe);
       crank();
       if (ok)
	{ if (stack)
	   { if (stack->type == SE_STRING)
	      { (*ok)(stack->u.s,cookie);
	      }
	     else
	      { if (err) (*err)("top-of-stack isn't a string",cookie);
	      }
	   }
	  else if (stack)
	   { if (err) (*err)("empty stack",cookie);
	   }
	}
       break;
    case IESJ_IERR:
       return;
       break;
    case IESJ_PIPE:
       break;
    default:
       abort();
       break;
  }
 interp_postcleanup();
}