#include <stdio.h>
#include <errno.h>
#include <ctype.h>
#include <stdlib.h>
#include <stdarg.h>
#include <strings.h>

#include "parse-fsm.h"
#include "parse-action.h"

extern const char *__progname;

/* SVAL and UVAL are signed and unsigned arbitrary expression values */
/* LOC is an address value */
/* VPM and LPM are the printf format modifiers for SVAL/UVAL and LOC */
typedef signed long long int SVAL;
typedef unsigned long long int UVAL;
#define VPM "q"
typedef unsigned long int LOC;
#define LPM "l"

typedef enum {
	  MOP_NONE = 1,
	  MOP_NIL,
	  MOP_NEG,
	  MOP_CMP,
	  MOP_NOT,
	  MOP_SB,
	  MOP_UB,
	  MOP_SW,
	  MOP_UW,
	  MOP_SL,
	  MOP_UL,
	  MOP_IS_SB,
	  MOP_IS_UB,
	  MOP_IS_SW,
	  MOP_IS_UW,
	  MOP_IS_SL,
	  MOP_IS_UL,
	  MOP_KNOWN,
	  MOP_BSW,
	  MOP_BSL,
	  MOP_BSQ,
	  MOP_WSL,
	  MOP_WSQ,
	  MOP_LSQ,
	  MOP_SFLOAT,
	  MOP_DFLOAT,
	  MOP_FLOAT,
	  MOP_INT,
	  MOP_FSIGN,
	  MOP_FEXP,
	  MOP_FMANT,
	  MOP_FLG,
	  MOP_CLG,
	  } MOP;

typedef enum {
	  DOP_NONE = 1,
	  DOP_ADD,
	  DOP_SUB,
	  DOP_MUL,
	  DOP_DIV,
	  DOP_MOD,
	  DOP_AND,
	  DOP_OR,
	  DOP_XOR,
	  DOP_LSH,
	  DOP_RSH,
	  DOP_LT,
	  DOP_GT,
	  DOP_LE,
	  DOP_GE,
	  DOP_EQ,
	  DOP_NE,
	  } DOP;

typedef enum {
	  NFN_NONE = 1,
	  NFN_MKFLOAT,
	  } NFN;

typedef enum {
	  FS_0 = 1,
	  FS_1,
	  FS_ANY,
	  } FSIZE;

typedef enum {
	  X_CONST = 1,
	  X_SYMBOL,
	  X_MONAD,
	  X_DYAD,
	  X_NAD,
	  X_IMMFN,
	  } EXPRTYPE;

typedef enum {
	  XST_UOP = 1,
	  XST_BOP,
	  XST_NFN,
	  XST_PAR,
	  XST_EXP,
	  XST_MARK,
	  } XSTACKTYPE;

typedef enum {
	  MLS_TEXT = 1,
	  MLS_ARG,
	  MLS_QARG,
	  MLS_QSTR,
	  MLS_LOCAL,
	  } MLSTYPE;

typedef enum {
	  LSV_NO = 1,
	  LSV_ASSIGNI,
	  LSV_ASSIGNF,
	  LSV_UNKASGN,
	  LSV_LABEL,
	  LSV_DECIMAL,
	  } LSV;

typedef enum {
	  SCK_WORD = 1,
	  SCK_LONG,
	  SCK_WLONG,
	  SCK_REF,
	  } SCK;

/* VT_U never appears in a t field; it is solely for expr_make() */
typedef enum {
	  VT_I = 1,
	  VT_F,
	  VT_U,
	  } VALTYPE;

typedef struct sym SYM;
typedef struct isrc ISRC;
typedef struct expr EXPR;
typedef struct patchup PATCHUP;
typedef struct patchlist PATCHLIST;
typedef struct xstack XSTACK;
typedef struct mempatch MEMPATCH;
typedef struct lowpatch LOWPATCH;
typedef struct fileline FILELINE;
typedef struct writing WRITING;
typedef struct strlist STRLIST;
typedef struct intlist INTLIST;
typedef struct cstack CSTACK;
typedef struct memseg MEMSEG;
typedef struct macro MACRO;
typedef struct mline MLINE;
typedef struct mlsub MLSUB;
typedef struct macarg MACARG;
typedef struct macx MACX;
typedef struct mxl MXL;
typedef struct setconst SETCONST;
typedef struct macxf MACXF;
typedef struct cpustate CPUSTATE;
typedef struct symvalstack SYMVALSTACK;
typedef struct fval FVAL;
typedef struct empriv EMPRIV;
typedef struct val VAL;

/*
 * neg is 0 for +ve, 1 for -ve
 * m top bit is not hidden; m=0 is zero
 * e is biased such that e=0 m=FVMANT_HIBIT is 1.0
 */
struct fval {
  int neg;
  int e; /* unbiased */
  UVAL m; /* top bit is not hidden */
#define FVMANT_HIBIT 0x8000000000000000ULL
#define FVMANT_SRBIT 0x0000008000000000ULL
#define FVMANT_DRBIT 0x0000000000000400ULL
#define FVMANT_TOP53 0xfffffffffffff800ULL
#define FVMANT_TOP32 0xffffffff00000000ULL
#define FVMANT_TOP24 0xffffff0000000000ULL
#define FVMANT_TOP16 0xffff000000000000ULL
#define FVMANT_TOP8  0xff00000000000000ULL
#define FVMANT_TOP4  0xf000000000000000ULL
#define FVMANT_TOP2  0xc000000000000000ULL
#define FVMANT_TOP1  0x8000000000000000ULL
#define FVMANT_MASK  0xffffffffffffffffULL
#define FVMANT_LOW32 0x00000000ffffffffULL
  } ;

/*
 * I'd much rather make the nested union anonymous, but then it's not
 *  usable as a constructor expression member initializer name.  For
 *  example, if it's anonymous, then (VAL){.t=VT_I,.i=0} doesn't work.
 */
struct val {
  VALTYPE t;
  union {
    SVAL i;
    FVAL f;
    } u;
  } ;
#define I_VAL(x) ((VAL){.t=VT_I,.u={.i=(x)}})
#define F_VAL(x) ((VAL){.t=VT_F,.u={.f=(x)}})

struct empriv {
  char *b;
  int a;
  int l;
  const char *file;
  int line;
  } ;

struct macxf {
  MACX *mx;
  MXL **lt;
  char *file;
  int line;
  char *lb;
  int la;
  int ln;
  } ;

struct setconst {
  SETCONST *link;
  const char *opname;
  char *file;
  int line;
  LOC loc;
  int reg;
  SCK kind;
  union {
    EXPR *val;
    SETCONST *ref;
    } ;
  LOC at;
  } ;

struct mxl {
  MXL *link;
  char *text;
  int len;
  char *file;
  int line;
  } ;

struct macx {
  MXL *lines;
  int clx;
  } ;

struct macarg {
  char *name;
  int namelen;
  int local;
  } ;

struct macro {
  MACRO *flink;
  MACRO *blink;
  char *name;
  int nargs;
  int nlocals;
  MLINE *text;
  } ;

struct mline {
  MLINE *link;
  char *file;
  int line;
  int nsubs;
  MLSUB *subs;
  } ;

struct mlsub {
  MLSTYPE type;
  union {
    char *text;
    int arg;
    int local;
    } ;
  } ;

struct lowpatch {
  LOC loc;
  int bits;
  unsigned short int rest;
  SVAL (*finalize)(SVAL, int);
  } ;

struct memseg {
  MEMSEG *up;
  MEMSEG *dn;
  LOC base;
  LOC size;
  LOC alloc;
  unsigned char *data;
  } ;

struct cstack {
  CSTACK *link;
  int curtrue;
  int evertrue;
  char *file;
  int line;
  } ;

struct strlist {
  STRLIST *link;
  char *s;
  } ;

struct intlist {
  INTLIST *link;
  int i;
  } ;

struct writing {
  WRITING *link;
  LOC loc;
  int size;
  int wrote;
  } ;

struct fileline {
  FILELINE *link;
  const char *file;
  int line;
  unsigned int flags;
  } ;

struct mempatch {
  LOC loc;
  int size;
  int count;
  const char *onerr;
  } ;

struct xstack {
  XSTACK *link;
  XSTACKTYPE type;
  union {
    MOP uop;
    DOP bop;
    struct {
      NFN op;
      EXPR **args;
      int aargs;
      int nargs;
      } nfn;
    EXPR *exp;
    } u;
  } ;

struct patchlist {
  PATCHLIST *link;
  PATCHUP *patchup;
  } ;

struct patchup {
  EXPR *expr;
  const char *file;
  int line;
  int refcnt;
  void (*whenfixed)(PATCHUP *);
  void *arg;
  } ;

struct expr {
  EXPRTYPE type;
  union {
    VAL val;
    SYM *sym;
    struct {
      MOP op;
      EXPR *arg;
      } monad;
    struct {
      DOP op;
      EXPR *lhs;
      EXPR *rhs;
      } dyad;
    struct {
      NFN op;
      int nargs;
      EXPR **args;
      } nad;
    } u;
  } ;

struct isrc {
  ISRC *link;
  char *name;
  int curline;
  unsigned int flags;
/* these flags are also used in flflags, below */
#define ISF_EXPN 0x00000001
  FILE *f;
  } ;

struct sym {
  SYM *link;
  const char *name;
  unsigned int flags;
#define SF_ASSIGN 0x00000001 /* value set by assignment */
#define SF_COLON  0x00000002 /* value set by "label:" */
#define SF_DOT    0x00000004 /* is . */
  EXPR *value;
  SYMVALSTACK *valstack;
  PATCHLIST *patchups;
  } ;

struct symvalstack {
  SYMVALSTACK *link;
  EXPR *value;
  } ;

struct cpustate {
  CPUTYPE type;
  const char *tag;
  void (*incdot)(int);
  CPUSTATE *link;
  SYM *syms;
  SYM *dotsym;
  LOC locsym_b_loc[10];
  char locsym_b_have[10];
  SYM *locsym_f_sym[10];
  unsigned int locsym_serial;
  } ;

static void incdot_sh(int); /* forward */
static CPUSTATE cpustate_sh = { CPU_SH, "SH", &incdot_sh };
static void incdot_vmu(int); /* forward */
static CPUSTATE cpustate_vmu = { CPU_VMU, "VMU", &incdot_vmu };
static CPUSTATE *allcpus;
static CPUSTATE *cpu;

static CSTACK *ifstack;

static int errs;
static int debugging = 0;

static const char *fn_in = 0;
static const char *fn_srec = 0;
static const char *fn_list = 0;

static ISRC *istack;
static FILELINE fl; /* .link not used */
static FILELINE *flstack;
static FILE *f_srec;
static FILE *f_list;
static STRLIST *msgs;
static char *msgbuf;
static int msglen;
static FILE *msgf;
static INTLIST *liststack;
static int list_on;
static int list_force;
static UVAL list_value;
static FVAL list_fvalue;
static LSV list_showvalue;
static char *cur_line;

static MEMSEG **memsegs;
static int nmemsegs;

static char *string_buf = 0;
static int string_len;
static int string_have;
static char string_term;
static int locsym_n;
static char locsym_dir;
static XSTACK *xstack;
static MOP fn_mop;
static NFN fn_nfn;
static int data_size;
static SYM *assign_sym;
static EXPR *assign_expr;
static SYM *label_sym;
static int repeat_count;
static WRITING *written;
static unsigned int instr_flags;
#define IF_DS_HAS     0x00000001
#define IF_DS_ILLEGAL 0x00000002
#define IF_DS_HAD     0x00000004
static LOC delay_slot_dot;
static unsigned short int instr_base_val;
static unsigned short int instr_base_mask;
static unsigned short int instr_extra_val;
static unsigned short int instr_extra_mask;
static unsigned short int instr_fields_val;
static unsigned short int instr_fields_mask;
static const char *reg_prefix;
static unsigned int reg_bits;
static int reg_shift;
static unsigned int reg_xval;
static unsigned int reg_xmask;
static EXPR *low_bits;
static int low_nbits;
static SVAL (*low_finalize)(SVAL, int);
static int offset_shift_bits;
static LOC entry;
static int have_entry;
static FSIZE f_sz;
static FSIZE f_pr;
static FSIZE *f_which;
static MACRO *macros;
static int macro_defining;
static char *macro_name;
static int macro_locals_at;
static MACARG *macro_args;
static int macro_args_a;
static int macro_args_n;
static MACRO *xmacro;
static int pseudo_set_size;
static const char *pseudo_set_name;
static SETCONST *set_constants;
static SETCONST failconst_;
#define failconst (&failconst_)
static PUSHPOP pushpop_op;
static EXPR *vmu_base;
static unsigned char vmu_i;
static CPUSTATE *symbol_space;
static char *symbol_name;
static EXPR *vmu_b3;
static EXPR *vmu_d9;
static EXPR *vmu_aref;
static MEMSEG *mem_get_cache = 0;
static FVAL float_10;
static FVAL float_1_10;
static FVAL float_value;
static FVAL float_pow10;
static int float_sawdot;
static int float_ndigit;
static int float_negexp;
static int expr_constant_ndig;
static UVAL expr_constant_val;
static FILE *dot_error;

static void panic(const char *) __attribute__((__noreturn__));
static void panic(const char *s)
{
 fprintf(stderr,"panic: %s\n",s);
 abort();
}

#ifdef MALLOC_PARANOIA

static const char guard1[8]
 = { 0x1c, 0x52, 0xc5, 0x0a, 0xa1, 0x83, 0x81, 0xa3 };
#define WG1SIZE 8
static const char guard2[8]
 = { 0x23, 0xb7, 0x25, 0xe6, 0xf7, 0xa7, 0xb2, 0xd3 };
#define WG2SIZE 8
static void *mthread = 0;
static int wcount = 0;

#define WFLINK(d) (((void **)d)[0])
#define WBLINK(d) (((void **)d)[1])
#define WLEN(d) (((int *)d)[2])
#define WFILE(d) (((const char **)d)[3])
#define WLINE(d) (((int *)d)[4])
#define WG1OFF   24
#define WDATAOFF (WG1OFF+WG1SIZE)
#define WEXTRA (WDATAOFF+WG2SIZE)

static void wmcheck(void)
{
 char *blk;
 int nb;
 int n;
 void *bl;

 fprintf(stderr,"wmcheck: entry:");
 n = 0;
 bl = 0;
 for (blk=mthread;blk;blk=WFLINK(blk))
  { fprintf(stderr," %p",(void *)blk);
    if (bcmp(blk+WG1OFF,&guard1[0],WG1SIZE)) panic("wmcheck: guard 1 wrong");
    nb = WLEN(blk);
    if ((nb < 0) || (nb > 16777216)) panic("wmcheck: size ludicrous");
    if (bcmp(blk+WDATAOFF+nb,&guard2[0],WG2SIZE)) panic("wmcheck: guard 2 wrong");
    if (WBLINK(blk) != bl) panic("wmcheck: blink wrong");
    bl = blk;
    n ++;
  }
 fprintf(stderr,"\n");
 if (n != wcount) panic("wmcheck: count wrong");
}

static void *wmalloc(unsigned int nb, const char *file, int line)
{
 char *d;

 fprintf(stderr,"wmalloc: entry %u (%s %d)\n",nb,file,line);
 wmcheck();
 d = malloc(nb+WEXTRA);
 WFLINK(d) = mthread;
 WBLINK(d) = 0;
 if (mthread) WBLINK(mthread) = d;
 WLEN(d) = nb;
 WFILE(d) = file;
 WLINE(d) = line;
 mthread = d;
 wcount ++;
 bcopy(&guard1[0],d+WG1OFF,WG1SIZE);
 bcopy(&guard2[0],d+WDATAOFF+nb,WG2SIZE);
 wmcheck();
 fprintf(stderr,"wmalloc: exit %p\n",(void *)(d+WDATAOFF));
 return(d+WDATAOFF);
}

static void wfree(void *buf, const char *file, int line)
{
 char *d;
 int nb;

 fprintf(stderr,"wfree: entry %p (%s %d)\n",buf,file,line);
 wmcheck();
 if (buf == 0) return;
 d = ((char *)buf) - WDATAOFF;
 if (bcmp(d+WG1OFF,&guard1[0],WG1SIZE)) panic("wfree: guard 1 wrong");
 nb = WLEN(d);
 if ((nb < 0) || (nb > 16777216)) panic("wfree: size ludicrous");
 if (bcmp(d+WDATAOFF+nb,&guard2[0],WG2SIZE)) panic("wfree: guard 2 wrong");
 if (WFLINK(d)) WBLINK(WFLINK(d)) = WBLINK(d);
 if (WBLINK(d)) WFLINK(WBLINK(d)) = WFLINK(d); else mthread = WFLINK(d);
 wcount --;
 memset(d,0x3d,nb+WEXTRA);
 wmcheck();
 free(d);
 wmcheck();
 fprintf(stderr,"wfree: done\n");
}

static void *wrealloc(void *buf, int newnb, const char *file, int line)
{
 char *d;
 int nb;
 char *newd;

 fprintf(stderr,"wrealloc: entry %p %u (%s %d)\n",buf,newnb,file,line);
 wmcheck();
 if (buf == 0) return(wmalloc(newnb,file,line));
 d = ((char *)buf) - WDATAOFF;
 if (bcmp(d+WG1OFF,&guard1[0],WG1SIZE)) panic("wrealloc: guard 1 wrong");
 nb = WLEN(d);
 if ((nb < 0) || (nb > 16777216)) panic("wrealloc: size ludicrous");
 if (bcmp(d+WDATAOFF+nb,&guard2[0],WG2SIZE)) panic("wrealloc: guard 2 wrong");
 if (newnb < nb)
  { memset(d+WDATAOFF+nb,0x3b,WG2SIZE);
    WLEN(d) = newnb;
    bcopy(&guard2[0],d+WDATAOFF+newnb,WG2SIZE);
    fprintf(stderr,"wrealloc: easy shrink\n");
    wmcheck();
    return(buf);
  }
 if (newnb == nb) return(buf);
 memset(d+WDATAOFF+nb,0x39,WG2SIZE);
 if (WFLINK(d)) WBLINK(WFLINK(d)) = WBLINK(d);
 if (WBLINK(d)) WFLINK(WBLINK(d)) = WFLINK(d); else mthread = WFLINK(d);
 wcount --;
 newd = realloc(d,newnb+WEXTRA);
 bcopy(&guard2[0],newd+WDATAOFF+newnb,WG2SIZE);
 WFLINK(newd) = mthread;
 WBLINK(newd) = 0;
 if (mthread) WBLINK(mthread) = newd;
 WLEN(newd) = newnb;
 WFILE(newd) = file;
 WLINE(newd) = line;
 mthread = newd;
 wcount ++;
 wmcheck();
 fprintf(stderr,"wrealloc: done %p\n",(void *)(newd+WDATAOFF));
 return(newd+WDATAOFF);
}

static char *wstrdup(const char *s, const char *file, int line)
{
 int l;
 char *n;

 l = strlen(s);
 n = wmalloc(l+1,file,line);
 bcopy(s,n,l+1);
 return(n);
}

#define malloc(nb) wmalloc((nb),__FILE__,__LINE__)
#define free(x) wfree((x),__FILE__,__LINE__)
#define realloc(x,nb) wrealloc((x),(nb),__FILE__,__LINE__)
#define strdup(s) wstrdup((s),__FILE__,__LINE__)

#endif

#define Cisspace(x) isspace((unsigned char)(x))

static void handleargs(int ac, char **av)
{
 int i;
 int skip;
 int wantedargs;

 skip = 0;
 for (i=1;i<ac;i++)
  { if (skip > 0)
     { skip --;
       continue;
     }
#define WANTARGS(n) do { skip += (wantedargs = (n)); if (i+skip >= ac) goto needarg; } while (0)
    if (av[i][0] == '-')
     { if (!strcmp(av[i],"-in"))
	{ WANTARGS(1);
	  fn_in = av[i+skip];
	}
       else if (!strcmp(av[i],"-out") || !strcmp(av[i],"-o"))
	{ WANTARGS(1);
	  fn_srec = av[i+skip];
	}
       else if (!strcmp(av[i],"-list") || !strcmp(av[i],"-l"))
	{ WANTARGS(1);
	  fn_list = av[i+skip];
	}
       else if (!strcmp(av[i],"-debug"))
	{ debugging = 1;
	}
       else
	{ fprintf(stderr,"%s: %s: unrecognized flag\n",__progname,av[i]);
	  errs ++;
	}
     }
    else
     { if (! fn_in)
	{ fn_in = av[i];
	}
       else if (! fn_srec)
	{ fn_srec = av[i];
	}
       else if (! fn_list)
	{ fn_list = av[i];
	}
       else
	{ fprintf(stderr,"%s: %s: stray extra argument\n",__progname,av[i]);
	  errs ++;
	}
     }
  }
 if (0)
  {
needarg:;
    fprintf(stderr,"%s: %s needs ",__progname,av[i]);
    if (wantedargs == 1)
     { fprintf(stderr,"a following arg\n");
     }
    else
     { fprintf(stderr,"%d following args\n",wantedargs);
     }
    errs ++;
  }
 if (! fn_in)
  { fprintf(stderr,"%s: need an input file\n",__progname);
    errs ++;
  }
 if (!fn_srec && !fn_list)
  { fprintf(stderr,"%s: need an output file (s-record or listing)\n",__progname);
    errs ++;
  }
 if (errs) exit(1);
}

static void strlist_push(STRLIST **stk, char *s)
{
 STRLIST *sl;

 sl = malloc(sizeof(STRLIST));
 sl->s = s;
 sl->link = *stk;
 *stk = sl;
}

static char *strlist_pop(STRLIST **stk)
{
 STRLIST *sl;
 char *rv;

 sl = *stk;
 *stk = sl->link;
 rv = sl->s;
 free(sl);
 return(rv);
}

static int msg_write(void *arg __attribute__((__unused__)), const char *buf, int len)
{
 msgbuf = realloc(msgbuf,msglen+len+1);
 bcopy(buf,msgbuf+msglen,len);
 msglen += len;
 return(len);
}

static int err_and_list(void *arg __attribute__((__unused__)), const char *buf, int len)
{
 fwrite(buf,1,len,stderr);
 fwrite(buf,1,len,msgf);
 return(len);
}

static void vwarnmsgfl(const char *, int, const char *, va_list)
	__attribute__((__format__(__printf__,3,0)));
static void vwarnmsgfl(const char *file, int line, const char *fmt, va_list ap)
{
 FILE *f;

 fprintf(stderr,"\"%s\", line %d: ",file,line);
 msgbuf = malloc(1);
 msglen = 0;
 msgf = fwopen(0,msg_write);
 if (flstack) fprintf(msgf,"(\"%s\", line %d) ",file,line);
 f = fwopen(0,err_and_list);
 vfprintf(f,fmt,ap);
 fclose(f);
 fclose(msgf);
 msgbuf[msglen] = '\0';
 strlist_push(&msgs,msgbuf);
 fprintf(stderr,"\n");
}

static void verrmsgfl(const char *, int, const char *, va_list)
	__attribute__((__format__(__printf__,3,0)));
static void verrmsgfl(const char *file, int line, const char *fmt, va_list ap)
{
 vwarnmsgfl(file,line,fmt,ap);
 errs ++;
}

static void warnmsg(const char *, ...)
	__attribute__((__format__(__printf__,1,2)));
static void warnmsg(const char *fmt, ...)
{
 va_list ap;

 va_start(ap,fmt);
 vwarnmsgfl(fl.file,fl.line,fmt,ap);
 va_end(ap);
}

static void errmsg(const char *, ...)
	__attribute__((__format__(__printf__,1,2)));
static void errmsg(const char *fmt, ...)
{
 va_list ap;

 va_start(ap,fmt);
 verrmsgfl(fl.file,fl.line,fmt,ap);
 va_end(ap);
}

static void errmsgfl(const char *, int, const char *, ...)
	__attribute__((__format__(__printf__,3,4)));
static void errmsgfl(const char *file, int line, const char *fmt, ...)
{
 va_list ap;

 va_start(ap,fmt);
 verrmsgfl(file,line,fmt,ap);
 va_end(ap);
}

static int errmsg_w(void *pv, const char *buf, int len)
{
 EMPRIV *p;

 p = pv;
 if (p->l+len > p->a) p->b = realloc(p->b,p->a=p->l+len);
 bcopy(buf,p->b+p->l,len);
 p->l += len;
 return(len);
}

static int errmsg_c(void *pv)
{
 EMPRIV *p;

 p = pv;
 errmsg_w(pv,"",1);
 if (p->file)
  { errmsgfl(p->file,p->line,"%s",p->b);
  }
 else
  { errmsg("%s",p->b);
  }
 free(p->b);
 free(p);
 return(0);
}

static FILE *errmsg_open(void)
{
 EMPRIV *p;
 FILE *f;

 p = malloc(sizeof(EMPRIV));
 p->b = 0;
 p->a = 0;
 p->l = 0;
 p->file = 0;
 f = funopen(p,0,&errmsg_w,0,&errmsg_c);
 if (! f) free(p);
 return(f);
}

static FILE *errmsgfl_open(const char *file, int line)
{
 EMPRIV *p;
 FILE *f;

 p = malloc(sizeof(EMPRIV));
 p->b = 0;
 p->a = 0;
 p->l = 0;
 p->file = file;
 p->line = line;
 f = funopen(p,0,&errmsg_w,0,&errmsg_c);
 if (! f) free(p);
 return(f);
}

static void reset_file_line(void)
{
 if (istack)
  { fl.file = istack->name;
    fl.line = istack->curline;
    fl.flags = istack->flags;
  }
 else
  { fl.file = 0;
    fl.line = -1;
    fl.flags = 0;
  }
}

static void include_file(char *fn, const char *tag)
{
 FILE *f;
 ISRC *i;

 if (istack && (*fn != '/'))
  { char *ls;
    ls = rindex(istack->name,'/');
    if (ls)
     { int sn;
       char *n;
       sn = ls - istack->name;
       n = malloc(sn+1+strlen(fn)+1);
       sprintf(n,"%.*s/%s",sn,istack->name,fn);
       free(fn);
       fn = n;
     }
  }
 f = fopen(fn,"r");
 if (f == 0)
  { fprintf(stderr,"%s: can't open %s file %s: %s\n",__progname,tag,fn,strerror(errno));
    free(fn);
    return;
  }
 i = malloc(sizeof(ISRC));
 i->link = istack;
 i->name = fn;
 i->curline = 0;
 i->flags = 0;
 i->f = f;
 istack = i;
 reset_file_line();
}

static int null_r(void *arg __attribute__((__unused__)), char *buf __attribute__((__unused__)), int nb __attribute__((__unused__)))
{
 return(0);
}

static int null_w(void *arg __attribute__((__unused__)), const char *buf __attribute__((__unused__)), int nb)
{
 return(nb);
}

static FILE *open_file(const char *fn, const char *how, const char *what)
{
 FILE *f;

 if (fn)
  { f = fopen(fn,how);
    if (f == 0)
     { fprintf(stderr,"%s: can't open %s file %s: %s\n",__progname,what,fn,strerror(errno));
       exit(1);
     }
  }
 else
  { f = funopen(0,null_r,null_w,0,0);
    if (f == 0)
     { fprintf(stderr,"%s: can't open dummy %s file: %s\n",__progname,what,strerror(errno));
       exit(1);
     }
  }
 return(f);
}

static SYM *newsym(const char *name)
{
 SYM *s;

 s = malloc(sizeof(SYM));
 s->name = name ? strdup(name) : 0;
 s->flags = 0;
 s->value = 0;
 s->patchups = 0;
 return(s);
}

static SYM *lookup_sym(const char *name, CPUSTATE *in, int createp)
{
 SYM **sp;
 SYM *s;

 sp = &in->syms;
 while ((s = *sp))
  { if (!strcmp(name,s->name))
     { if (sp != &in->syms)
	{ *sp = s->link;
	  s->link = in->syms;
	  in->syms = s;
	}
       return(s);
     }
    sp = &s->link;
  }
 if (! createp) return(0);
 s = newsym(name);
 s->link = in->syms;
 in->syms = s;
 return(s);
}

static EXPR *expr_make(EXPRTYPE type, ...)
{
 va_list ap;
 EXPR *e;
 VALTYPE vt;

 e = malloc(sizeof(EXPR));
 e->type = type;
 va_start(ap,type);
 switch (type)
  { default:
       panic("expr_make: type bad");
       break;
    case X_CONST:
       vt = va_arg(ap,VALTYPE);
       switch (vt)
	{ case VT_I:
	     e->u.val.t = VT_I;
	     e->u.val.u.i = va_arg(ap,SVAL);
	     break;
	  case VT_F:
	     e->u.val.t = VT_F;
	     e->u.val.u.f = va_arg(ap,FVAL);
	     break;
	  case VT_U:
	     e->u.val = va_arg(ap,VAL);
	     switch (e->u.val.t)
	      { case VT_I:
		case VT_F:
		   break;
		default:
		   panic("expr_make X_CONST VT_U: valtype bad");
		   break;
	      }
	     break;
	  default:
	     panic("expr_make X_CONST: valtype bad");
	     break;
	}
       break;
    case X_SYMBOL:
       e->u.sym = va_arg(ap,SYM *);
       break;
    case X_MONAD:
    case X_IMMFN:
       e->u.monad.op = va_arg(ap,MOP);
       e->u.monad.arg = va_arg(ap,EXPR *);
       break;
    case X_DYAD:
       e->u.dyad.lhs = va_arg(ap,EXPR *);
       e->u.dyad.op = va_arg(ap,DOP);
       e->u.dyad.rhs = va_arg(ap,EXPR *);
       break;
    case X_NAD:
       e->u.nad.op = va_arg(ap,NFN);
       e->u.nad.nargs = va_arg(ap,int);
       e->u.nad.args = va_arg(ap,EXPR **);
       break;
  }
 return(e);
}

static EXPR *expr_clone(EXPR *e)
{
 EXPR *e2;
 int i;

 if (! e) return(0);
 e2 = malloc(sizeof(EXPR));
 e2->type = e->type;
 switch (e->type)
  { default:
       panic("expr_clone: type bad");
       break;
    case X_CONST:
       e2->u.val = e->u.val;
       break;
    case X_SYMBOL:
       e2->u.sym = e->u.sym;
       break;
    case X_MONAD:
    case X_IMMFN:
       e2->u.monad.op = e->u.monad.op;
       e2->u.monad.arg = expr_clone(e->u.monad.arg);
       break;
    case X_DYAD:
       e2->u.dyad.lhs = expr_clone(e->u.dyad.lhs);
       e2->u.dyad.op = e->u.dyad.op;
       e2->u.dyad.rhs = expr_clone(e->u.dyad.rhs);
       break;
    case X_NAD:
       e2->u.nad.op = e->u.nad.op;
       e2->u.nad.nargs = e->u.nad.nargs;
       e2->u.nad.args = malloc(e2->u.nad.nargs*sizeof(EXPR *));
       for (i=e2->u.nad.nargs-1;i>=0;i--) e2->u.nad.args[i] = expr_clone(e->u.nad.args[i]);
       break;
  }
 return(e2);
}

static void init_cpu_stab(void)
{
 int i;

 cpu->syms = 0;
 cpu->dotsym = lookup_sym(".",cpu,1);
 cpu->dotsym->flags |= SF_DOT;
 cpu->dotsym->value = expr_make(X_CONST,VT_I,(SVAL)0);
 for (i=0;i<10;i++)
  { cpu->locsym_b_have[i] = 0;
    cpu->locsym_f_sym[i] = 0;
  }
 cpu->locsym_serial = 0;
}

static void init_stab(void)
{
 CPUSTATE *save;
 CPUSTATE *c;

 save = cpu;
 for (c=allcpus;c;c=c->link)
  { cpu = c;
    init_cpu_stab();
  }
 cpu = save;
 symbol_name = 0;
}

static void init_mem(void)
{
 memsegs = 0;
 nmemsegs = 0;
 have_entry = 0;
}

static void init_list(void)
{
 list_on = 1;
 liststack = 0;
}

static void init_ifs(void)
{
 ifstack = 0;
}

static void pop_istack(void)
{
 ISRC *i;

 i = istack->link;
 fclose(istack->f);
 free(istack->name);
 free(istack);
 istack = i;
 reset_file_line();
}

static char *getline(void)
{
 char *buf;
 int len;
 int have;
 int c;

 buf = malloc(1);
 len = 0;
 have = 0;
 while (1)
  { if (istack == 0) return(0);
    c = getc(istack->f);
    if (c == EOF)
     { if (len > 0)
	{ fprintf(stderr,"%s: %s: missing newline supplied at EOF\n",__progname,fl.file);
	  buf[len] = '\0';
	  return(buf);
	}
       pop_istack();
       continue;
     }
    if (c == '\n')
     { buf[len] = '\0';
       return(buf);
     }
    if (len >= have) buf = realloc(buf,(have=(len+16))+1);
    buf[len++] = c;
  }
}

static void reset_assembled_data(void)
{
 written = 0;
 instr_flags &= ~(IF_DS_HAS|IF_DS_ILLEGAL);
 instr_base_val = 0;
 instr_base_mask = 0;
 reset_ops();
}

static LOC cpudot(CPUSTATE *c)
{
 if ( (c->dotsym->value->type != X_CONST) ||
      (c->dotsym->value->u.val.t != VT_I) ) panic("cpudot: . wrong");
 return(c->dotsym->value->u.val.u.i);
}

static LOC dot(void)
{
 return(cpudot(cpu));
}

static WRITING *sort_writings(WRITING *list)
{
 WRITING *w1;
 WRITING *w2;
 WRITING *w;
 WRITING **wp;

 if (!list || !list->link) return(list);
 w1 = 0;
 w2 = 0;
 while (list)
  { w = list;
    list = w->link;
    w->link = w1;
    w1 = w2;
    w2 = w;
  }
 w1 = sort_writings(w1);
 w2 = sort_writings(w2);
 wp = &list;
 while (w1 || w2)
  { if (!w2 || (w1 && (w1->loc < w2->loc)))
     { w = w1;
       w1 = w->link;
     }
    else
     { w = w2;
       w2 = w->link;
     }
    *wp = w;
    wp = &w->link;
  }
 *wp = 0;
 return(list);
}

static unsigned char mem_get_1(LOC loc)
{
 int l;
 int m;
 int h;
 MEMSEG *s;

 if ( mem_get_cache &&
      (loc >= mem_get_cache->base) &&
      (loc < mem_get_cache->base+mem_get_cache->size))
  { return(mem_get_cache->data[loc-mem_get_cache->base]);
  }
 l = -1;
 h = nmemsegs;
 while (h-l > 1)
  { m = (h + l) >> 1;
    s = memsegs[m];
    if (loc >= s->base)
     { if (loc < s->base+s->size)
	{ mem_get_cache = s;
	  return(s->data[loc-s->base]);
	}
       l = m;
     }
    else
     { h = m;
     }
  }
 panic("mem_get_1: fell through");
}

static const char *mop_str(MOP op)
{
 switch (op)
  { case MOP_NEG:    return("- ");       break;
    case MOP_CMP:    return("~ ");       break;
    case MOP_NOT:    return("! ");       break;
    case MOP_SB:     return("@SB ");     break;
    case MOP_UB:     return("@UB ");     break;
    case MOP_SW:     return("@SW ");     break;
    case MOP_UW:     return("@UW ");     break;
    case MOP_SL:     return("@SL ");     break;
    case MOP_UL:     return("@UL ");     break;
    case MOP_IS_SB:  return("@IS_SB ");  break;
    case MOP_IS_UB:  return("@IS_UB ");  break;
    case MOP_IS_SW:  return("@IS_SW ");  break;
    case MOP_IS_UW:  return("@IS_UW ");  break;
    case MOP_IS_SL:  return("@IS_SL ");  break;
    case MOP_IS_UL:  return("@IS_UL ");  break;
    case MOP_KNOWN:  return("@KNOWN ");  break;
    case MOP_BSW:    return("@BSW ");    break;
    case MOP_BSL:    return("@BSL ");    break;
    case MOP_BSQ:    return("@BSQ ");    break;
    case MOP_WSL:    return("@WSL ");    break;
    case MOP_WSQ:    return("@WSQ ");    break;
    case MOP_LSQ:    return("@LSQ ");    break;
    case MOP_SFLOAT: return("@SFLOAT "); break;
    case MOP_DFLOAT: return("@DFLOAT "); break;
    case MOP_FLOAT:  return("@FLOAT ");  break;
    case MOP_INT:    return("@INT ");    break;
    case MOP_FSIGN:  return("@FSIGN ");  break;
    case MOP_FEXP:   return("@FEXP ");   break;
    case MOP_FMANT:  return("@FMANT ");  break;
    case MOP_FLG:    return("@FLG ");  break;
    case MOP_CLG:    return("@CLG ");  break;
    default: panic("mop_str: op bad"); break;
  }
}

static const char *dop_str(DOP op)
{
 switch (op)
  { case DOP_ADD:   return(" + ");      break;
    case DOP_SUB:   return(" - ");      break;
    case DOP_MUL:   return(" * ");      break;
    case DOP_DIV:   return(" / ");      break;
    case DOP_MOD:   return(" % ");      break;
    case DOP_AND:   return(" & ");      break;
    case DOP_OR:    return(" | ");      break;
    case DOP_XOR:   return(" ^ ");      break;
    case DOP_LSH:   return(" << ");     break;
    case DOP_RSH:   return(" >> ");     break;
    case DOP_LT:    return(" < ");      break;
    case DOP_GT:    return(" > ");      break;
    case DOP_LE:    return(" <= ");     break;
    case DOP_GE:    return(" >= ");     break;
    case DOP_EQ:    return(" == ");     break;
    case DOP_NE:    return(" != ");     break;
    default: panic("dop_str: op bad"); break;
  }
}

static const char *nfn_str(NFN op)
{
 switch (op)
  { case NFN_MKFLOAT: return("MKFLOAT"); break;
    default: panic("nfn_str: op bad"); break;
  }
}

static int print_fval(FILE *f, FVAL v)
{
 return(fprintf(f,"@MKFLOAT[%d,%d,%"VPM"d]",v.neg,v.e,v.m));
}

static int fprint_expr(FILE *f, EXPR *e)
{
 int n;
 int i;
 const char *sep;

 switch (e->type)
  { default:
       n = fprintf(f,"{?%d}",e->type);
       break;
    case X_CONST:
       switch (e->u.val.t)
	{ case VT_I:
	     n = fprintf(f,"%"VPM"d",e->u.val.u.i);
	     break;
	  case VT_F:
	     n = print_fval(f,e->u.val.u.f);
	     break;
	  default:
	     panic("fprint_expr X_CONST: type bad");
	     break;
	}
       break;
    case X_SYMBOL:
       n = fprintf(f,"%s",e->u.sym->name);
       break;
    case X_MONAD:
    case X_IMMFN:
       n = fprintf(f,"%s[ ",mop_str(e->u.monad.op));
       n += fprint_expr(f,e->u.monad.arg);
       n += fprintf(f," ]");
       break;
    case X_DYAD:
       n = fprintf(f,"[ ");
       n += fprint_expr(f,e->u.dyad.lhs);
       n += fprintf(f,"%s",dop_str(e->u.dyad.op));
       n += fprint_expr(f,e->u.dyad.rhs);
       n += fprintf(f," ]");
       break;
    case X_NAD:
       n = fprintf(f,"@%s[",nfn_str(e->u.nad.op));
       sep = " ";
       for (i=0;i<e->u.nad.nargs;i++)
	{ n += fprint_expr(f,e->u.nad.args[i]);
	  n += fprintf(f,"%s",sep);
	  sep = " , ";
	}
       n += fprintf(f," ]");
       break;
  }
 return(n);
}

static void write_mem(LOC loc, unsigned char val)
{
 int l;
 int m;
 int h;
 MEMSEG *s;
 MEMSEG *n;
 MEMSEG *w;

 l = -1;
 h = nmemsegs;
 while (h-l > 1)
  { m = (h + l) >> 1;
    s = memsegs[m];
    if (loc >= s->base)
     { l = m;
     }
    else
     { h = m;
     }
  }
 s = (l < 0) ? 0 : memsegs[l];
 n = (h < nmemsegs) ? memsegs[h] : 0;
 if (s && (loc < s->base+s->size))
  { s->data[loc-s->base] = val;
    return;
  }
 if (s && (loc == s->base+s->size))
  { if (n && (loc == n->base-1))
     { if (s->alloc < s->size+1+n->size)
	{ s->data = realloc(s->data,s->alloc=s->size+1+n->size+64);
	}
       s->data[s->size] = val;
       bcopy(n->data,s->data+s->size+1,n->size);
       s->size += n->size + 1;
       s->up = n->up;
       if (s->up) s->up->dn = s;
       free(n->data);
       if (l+2 < nmemsegs) bcopy(memsegs+l+2,memsegs+l+1,(nmemsegs-(l+2))*sizeof(MEMSEG *));
       free(n);
       mem_get_cache = 0;
       nmemsegs --;
       return;
     }
    if (s->alloc < s->size+1)
     { s->data = realloc(s->data,s->alloc=s->size+64);
     }
    s->data[s->size++] = val;
    return;
  }
 if (n && (loc == n->base-1))
  { char *t;
    t = malloc(n->alloc=n->size+64);
    bcopy(n->data,t+1,n->size);
    t[0] = val;
    free(n->data);
    n->data = t;
    n->base --;
    n->size ++;
    return;
  }
 w = malloc(sizeof(MEMSEG));
 w->base = loc;
 w->size = 1;
 w->alloc = 64;
 w->data = malloc(64);
 w->data[0] = val;
 w->up = n;
 w->dn = s;
 if (s) s->up = w;
 if (n) n->dn = w;
 memsegs = realloc(memsegs,(nmemsegs+1)*sizeof(MEMSEG *));
 if (h < nmemsegs) bcopy(memsegs+h,memsegs+h+1,(nmemsegs-h)*sizeof(MEMSEG *));
 memsegs[h] = w;
 nmemsegs ++;
}

static const char *lsv_str(LSV v)
{
 static char *badbuf = 0;

 switch (v)
  { case LSV_NO:      return("NO");      break;
    case LSV_ASSIGNI: return("ASSIGNI"); break;
    case LSV_ASSIGNF: return("ASSIGNF"); break;
    case LSV_UNKASGN: return("UNKASGN"); break;
    case LSV_LABEL:   return("LABEL");   break;
    case LSV_DECIMAL: return("DECIMAL"); break;
  }
 free(badbuf);
 asprintf(&badbuf,"?%d",(int)v);
 return(badbuf);
}

static void dump_writings(LOC loc, int lno, unsigned int flags, const char **ltext)
{
 WRITING **wp;
 WRITING *w;
 LOC atloc;
 int haveloc;
 int linen;
 int inx;
 int mark;

 static void maybe_print_line(void)
  { if (*ltext)
     { if (!haveloc && (list_showvalue != LSV_NO))
	{ switch (list_showvalue)
	   { case LSV_ASSIGNI:
		if (list_value & ~0xffffffffULL)
		 { fprintf(f_list,"%-22"VPM"x",list_value);
		 }
		else
		 { fprintf(f_list,"%08"VPM"x              ",list_value);
		 }
		break;
	     case LSV_ASSIGNF:
		fprintf(f_list,"(float)               ");
		break;
	     case LSV_UNKASGN:
		fprintf(f_list,"?""?                    ");
		break;
	     case LSV_LABEL:
		fprintf(f_list,"%08"LPM"x:             ",(LOC)list_value);
		break;
	     case LSV_DECIMAL:
		fprintf(f_list,"%22"VPM"d",list_value);
		break;
	     default:
		panic("dump_writings/maybe_print_line: showvalue bad");
		break;
	   }
	}
       else
	{ if (! haveloc)
	   { fprintf(f_list,"          ");
	     linen = 0;
	   }
	  fprintf(f_list,"%*s",(4-linen)*3,"");
	}
       if (lno < 0)
	{ fprintf(f_list,"      ");
	}
       else if (flags & ISF_EXPN)
	{ fprintf(f_list,"    - ");
	}
       else
	{ fprintf(f_list,"%5d ",lno);
	}
       fprintf(f_list,"%s",*ltext);
       *ltext = 0;
     }
  }

 static void do_mark(void)
  { if (mark) fprintf(f_list,"(");
  }

 static void do_newline(void)
  { if (mark) fprintf(f_list,")");
    fprintf(f_list,"\n");
  }

 if (debugging)
  { fprintf(stderr,"[dump_writings loc=%08"LPM"x lno=%d showvalue=%s value=%"VPM"x ltext=%p",loc,lno,lsv_str(list_showvalue),list_value,(const void *)*ltext);
    if (*ltext) fprintf(stderr,"=%s",*ltext);
    fprintf(stderr,"]\n");
  }
 mark = !*ltext;
 wp = &written;
 haveloc = 0;
 while ((w = *wp))
  { if (w->loc == loc)
     { *wp = w->link;
       inx = 0;
       while (1)
	{ if (! haveloc)
	   { do_mark();
	     fprintf(f_list,"%08"LPM"x: ",loc);
	     atloc = loc;
	     haveloc = 1;
	     linen = 0;
	     continue;
	   }
	  if ( (linen > 3) ||
	       ((w->size > 16) && (inx == 0) && (linen > 0)) )
	   { maybe_print_line();
	     do_newline();
	     haveloc = 0;
	     continue;
	   }
	  if (w->wrote)
	   { fprintf(f_list," %02x",mem_get_1(w->loc+inx));
	     loc ++;
	     atloc ++;
	     inx ++;
	     linen ++;
	   }
	  else
	   { fprintf(f_list," ?""?");
	     loc ++;
	     atloc ++;
	     inx ++;
	     linen ++;
	   }
	  if ((w->size > 16) && (inx == 8))
	   { int n;
	     n = w->size - 16;
	     loc += n;
	     atloc += n;
	     inx += n;
	     do_newline();
	     do_mark();
	     fprintf(f_list,"           .. .. .. ..");
	   }
	  if (inx >= w->size) break;
	}
       free(w);
     }
    else
     { wp = &w->link;
     }
  }
 if (*ltext || (haveloc && (linen > 0)))
  { maybe_print_line();
    do_newline();
  }
}

static void dump_to_listing(LOC predot, const char *l)
{
 STRLIST *sl;

 written = sort_writings(written);
 if (list_on || list_force || msgs) dump_writings(predot,fl.line,fl.flags,&l);
 sl = 0;
 while (msgs) strlist_push(&sl,strlist_pop(&msgs));
 while (sl)
  { char *s;
    s = strlist_pop(&sl);
    fprintf(f_list,"*** %s\n",s);
    free(s);
  }
 if (list_on) while (written) dump_writings(written->loc,fl.line,fl.flags,&l);
 while (written)
  { WRITING *w;
    w = written;
    written = w->link;
    free(w);
  }
}

static void delay_slot_warn(void)
{
 if (instr_flags & IF_DS_HAD)
  { errmsg("this is probably wrong in a delay slot");
  }
}

static void expr_free(EXPR *e)
{
 int i;

 if (e == 0) return;
 switch (e->type)
  { default:
       panic("expr_free: type bad");
       break;
    case X_CONST:
    case X_SYMBOL:
       break;
    case X_MONAD:
    case X_IMMFN:
       expr_free(e->u.monad.arg);
       break;
    case X_DYAD:
       expr_free(e->u.dyad.lhs);
       expr_free(e->u.dyad.rhs);
       break;
    case X_NAD:
       for (i=e->u.nad.nargs-1;i>=0;i--) expr_free(e->u.nad.args[i]);
       free(e->u.nad.args);
       break;
  }
 free(e);
}

static void xst_pop(void)
{
 XSTACK *x;

 if (! xstack) panic("xst_pop: stack empty");
 x = xstack->link;
 free(xstack);
 xstack = x;
}

static void assemble(void)
{
 while (1)
  { char *l;
    LOC predot;
    l = getline();
    if (! l) break;
    istack->curline ++;
    reset_file_line();
    if (debugging) fprintf(stderr,"[line %d in %s: %s]\n",fl.line,fl.file,l);
    reset_assembled_data();
    predot = dot();
    if ((instr_flags & IF_DS_HAD) && (predot != delay_slot_dot)) instr_flags &= ~IF_DS_HAD;
    list_force = 0;
    list_showvalue = LSV_NO;
    cur_line = l;
    if (! parseline(l)) errmsg("Parse failed");
    if (xstack)
     { errmsg("Junk left on expression stack");
       while (xstack)
	{ switch (xstack->type)
	   { case XST_EXP:
		expr_free(xstack->u.exp);
		break;
	     default:
		break;
	   }
	  xst_pop();
	}
     }
    if (instr_flags & IF_DS_ILLEGAL) delay_slot_warn();
    dump_to_listing(predot,l);
    free(l);
    if (instr_flags & IF_DS_HAS)
     { delay_slot_dot = dot();
       instr_flags |= IF_DS_HAD;
     }
    reset_ops();
  }
}

static void push_file_line(const char *f, int l, unsigned int flg)
{
 FILELINE *n;

 n = malloc(sizeof(FILELINE));
 *n = fl;
 fl.file = f;
 fl.line = l;
 fl.flags = flg;
 n->link = flstack;
 flstack = n;
}

static void pop_file_line(void)
{
 FILELINE *o;

 o = flstack;
 flstack = o->link;
 fl = *o;
 free(o);
}

#define fzero(sgn) ( (FVAL) { .neg = sgn, .e = 0, .m = 0 } )
#define vfzero(sgn) F_VAL(fzero(sgn))

static SVAL fval_to_ival(FVAL fv)
{
 SVAL v;

 if ((fv.m == 0) || (fv.e < 0)) return(0);
 if (fv.e < 63)
  { v = fv.m >> (63 - fv.e);
    return(fv.neg?-v:v);
  }
 return(fv.neg?(SVAL)~((~(UVAL)0)>>1):(SVAL)((~(UVAL)0)>>1));
}

static FVAL normalize_shift(FVAL f)
{
 if (! (f.m & FVMANT_TOP32))
  { f.m <<= 32;
    f.e -= 32;
  }
 if (! (f.m & FVMANT_TOP16))
  { f.m <<= 16;
    f.e -= 16;
  }
 if (! (f.m & FVMANT_TOP8))
  { f.m <<= 8;
    f.e -= 8;
  }
 if (! (f.m & FVMANT_TOP4))
  { f.m <<= 4;
    f.e -= 4;
  }
 if (! (f.m & FVMANT_TOP2))
  { f.m <<= 2;
    f.e -= 2;
  }
 if (! (f.m & FVMANT_TOP1))
  { f.m <<= 1;
    f.e --;
  }
 return(f);
}

static FVAL ival_to_fval(SVAL sv)
{
 FVAL f;

 if (sv < 0)
  { f.m = - (UVAL)sv;
    f.neg = 1;
  }
 else
  { f.m = sv;
    f.neg = 0;
  }
 if (f.m == 0) return(fzero(0));
 f.e = 63;
 return(normalize_shift(f));
}

static VAL val_to_int(VAL v)
{
 switch (v.t)
  { case VT_I:
       return(v);
       break;
    case VT_F:
       return(I_VAL(fval_to_ival(v.u.f)));
       break;
    default:
       panic("val_to_int: type bad");
       break;
  }
}

static VAL val_to_float(VAL v)
{
 switch (v.t)
  { case VT_I:
       return(F_VAL(ival_to_fval(v.u.i)));
       break;
    case VT_F:
       return(v);
       break;
    default:
       panic("val_to_float: type bad");
       break;
  }
}

static UVAL float_to_single(FVAL fv)
{
 unsigned int m;
 UVAL rbit;

 if (fv.m == 0)
  { /* zero */
    return(fv.neg?0x80000000:0);
  }
 if (fv.e >= -126)
  { /* ordinary or infinity */
    if (fv.m & FVMANT_SRBIT)
     { if ((fv.m & ~FVMANT_TOP24) == FVMANT_SRBIT)
	{ /* round to even */
	  m = fv.m >> 40;
	  m += m & 1;
	}
       else
	{ /* round up */
	  m = (fv.m >> 40) + 1;
	}
     }
    else
     { /* round down */
       m = fv.m >> 40;
     }
    if (m == 0x01000000)
     { m >>= 1;
       fv.e ++;
     }
    if (fv.e > 127)
     { /* Too large to be a single; generate an infinity. */
       warnmsg("floating-point value out of single-float range, generating infinity");
       return((fv.neg?0x80000000:0)|0x78000000);
     }
    else
     { /* Ordinary */
       return((fv.neg?0x80000000:0)|((fv.e+127)<<23)|(m&0x007fffff));
     }
  }
 /* denormalized or underflow-to-zero */
 if (fv.e > -150)
  { rbit = FVMANT_SRBIT << (-126 - fv.e);
    if (fv.m & rbit)
     { if ((fv.m & (rbit|(rbit-1))) == rbit)
	{ /* round to even */
	  m = fv.m >> (-86 - fv.e);
	  m += m & 1;
	}
       else
	{ /* round up */
	  m = (fv.m >> (-86 - fv.e)) + 1;
	}
     }
    else
     { /* round down */
       m = fv.m >> (-86 - fv.e);
     }
    if ((fv.e == -127) && (m == 0x00800000))
     { /* rounded up to smallest normalized number */
       return((fv.neg?0x80000000:0)|(1<<23));
     }
    else
     { return((fv.neg?0x80000000:0)|m);
     }
  }
 if ((fv.e == -150) && (fv.m > FVMANT_HIBIT))
  { /* smallest denormalized number */
    return((fv.neg)?0x80000001:1);
  }
 /* underflow to zero */
 return(fv.neg?0x80000000:0);
}

/*
 * We return the 32-bit halves swapped (sign, exponent, and high 23
 *  bits of mantissa in the low half, low 32 bits of mantissa in the
 *  high half) because little-endian SH is a bit weird with doubles
 *  stored in memory; it's LE within each 32-bit half, but the halves
 *  are stored big-endian style.  We return the value that, when stored
 *  purely little-endian, does the right thing.
 */
static UVAL float_to_double(FVAL fv)
{
 UVAL m;
 UVAL rbit;

 if (fv.m == 0)
  { /* zero */
    return(fv.neg?0x80000000ULL:0ULL);
  }
 if (fv.e >= -1022)
  { /* ordinary or infinity */
    if (fv.m & FVMANT_DRBIT)
     { if ((fv.m & ~FVMANT_TOP53) == FVMANT_DRBIT)
	{ /* round to even */
	  m = fv.m >> 11;
	  m += m & 1;
	}
       else
	{ /* round up */
	  m = (fv.m >> 11) + 1;
	}
     }
    else
     { /* round down */
       m = fv.m >> 11;
     }
    if (m == 0x0020000000000000ULL)
     { m >>= 1;
       fv.e ++;
     }
    if (fv.e > 1023)
     { /* Too large to be a single; generate an infinity. */
       warnmsg("floating-point value out of double-float range, generating infinity");
       return((fv.neg?0x80000000:0)|0x7ff00000);
     }
    else
     { /* Ordinary */
       return((fv.neg?0x80000000:0)|((fv.e+1023)<<20)|((m>>32)&0x000fffffULL)|((m&0xffffffffULL)<<32));
     }
  }
 /* denormalized or underflow-to-zero */
 if (fv.e > -1075)
  { rbit = FVMANT_DRBIT << (-1022 - fv.e);
    if (fv.m & rbit)
     { if ((fv.m & (rbit|(rbit-1))) == rbit)
	{ /* round to even */
	  m = fv.m >> (-1011 - fv.e);
	  m += m & 1;
	}
       else
	{ /* round up */
	  m = (fv.m >> (-1011 - fv.e)) + 1;
	}
     }
    else
     { /* round down */
       m = fv.m >> (-1011 - fv.e);
     }
    if ((fv.e == -1023) && (m == 0x0010000000000000ULL))
     { /* rounded up to smallest normalized number */
       return((fv.neg?0x80000000:0)|(1<<20));
     }
    else
     { return((fv.neg?0x80000000:0)|((m>>32)&0x000fffffULL)|((m&0xffffffffULL)<<32));
     }
  }
 if ((fv.e == -1075) && (fv.m > FVMANT_HIBIT))
  { /* smallest denormalized number */
    return((fv.neg)?0x180000000ULL:0x100000000ULL);
  }
 /* underflow to zero */
 return(fv.neg?0x80000000:0);
}

static SVAL fval_to_ieee(FVAL, int, const char *, ...)
	__attribute__((__format__(__printf__,3,4)));
static SVAL fval_to_ieee(FVAL fv, int size, const char *fmt, ...)
{
 va_list ap;
 FILE *f;
 const char *kind;

 switch (size)
  { case 1:
       kind = "byte";
       if (0)
	{
    case 2:
	  kind = "word";
	}
       f = errmsg_open();
       fprintf(f,"%s ",kind);
       va_start(ap,fmt);
       vfprintf(f,fmt,ap);
       va_end(ap);
       fprintf(f," is floating point");
       fclose(f);
       return(0);
       break;
    case 4:
       return(float_to_single(fv));
       break;
    case 8:
       return(float_to_double(fv));
       break;
    default:
       panic("fval_to_ieee: size bad");
       break;
  }
}

static int lg_f(UVAL v)
{
 int n;

 n = -1;
 while (v)
  { n ++;
    v >>= 1;
  }
 return(n);
}

static int lg_c(UVAL v)
{
 return( (v & (v-1)) ? lg_f(v)+1 : lg_f(v) );
}

static VAL perform_mop(MOP op, VAL v)
{
 switch (op)
  { case MOP_NEG:
       switch (v.t)
	{ case VT_I:
	     return(I_VAL(-v.u.i));
	     break;
	  case VT_F:
	     v.u.f.neg = ! v.u.f.neg;
	     return(v);
	     break;
	  default:
	     panic("perform_mop MOP_NEG: type bad");
	     break;
	}
       break;
    case MOP_CMP:
       switch (v.t)
	{ case VT_I:
	     return(I_VAL(~v.u.i));
	     break;
	  case VT_F:
	     errmsg("~ applied to floating-point value");
	     return(vfzero(0));
	     break;
	  default:
	     panic("perform_mop MOP_CMP: type bad");
	     break;
	}
       break;
    case MOP_NOT:
       switch (v.t)
	{ case VT_I:
	     return(I_VAL(!v.u.i));
	     break;
	  case VT_F:
	     errmsg("! applied to floating-point value");
	     return(vfzero(0));
	     break;
	  default:
	     panic("perform_mop MOP_NOT: type bad");
	     break;
	}
       break;
    case MOP_SB:
       v = val_to_int(v);
       if ((v.u.i < -(SVAL)0x80) || (v.u.i > (SVAL)0x7f))
	{ errmsg("value out of signed byte range");
	}
       return(v);
       break;
    case MOP_UB:
       v = val_to_int(v);
       if ((v.u.i < (SVAL)0) || (v.u.i > (SVAL)0xff))
	{ errmsg("value out of unsigned byte range");
	}
       return(v);
       break;
    case MOP_SW:
       v = val_to_int(v);
       if ((v.u.i < -(SVAL)0x8000) || (v.u.i > (SVAL)0x7fff))
	{ errmsg("value out of signed word range");
	}
       return(v);
       break;
    case MOP_UW:
       v = val_to_int(v);
       if ((v.u.i < (SVAL)0) || (v.u.i > (SVAL)0xffff))
	{ errmsg("value out of unsigned word range");
	}
       return(v);
       break;
    case MOP_SL:
       v = val_to_int(v);
       if ((v.u.i < -(SVAL)0x80000000ULL) || (v.u.i > (SVAL)0x7fffffffULL))
	{ errmsg("value out of signed long range");
	}
       return(v);
       break;
    case MOP_UL:
       v = val_to_int(v);
       if ((v.u.i < (SVAL)0) || (v.u.i > (SVAL)0xffffffffULL))
	{ errmsg("value out of unsigned long range");
	}
       return(v);
       break;
    case MOP_IS_SB:
       v = val_to_int(v);
       return(I_VAL( ((v.u.i >= -(SVAL)0x80) && (v.u.i <= (SVAL)0x7f)) ));
       break;
    case MOP_IS_UB:
       v = val_to_int(v);
       return(I_VAL( ((v.u.i >= 0) && (v.u.i <= (SVAL)0xff)) ));
       break;
    case MOP_IS_SW:
       v = val_to_int(v);
       return(I_VAL( ((v.u.i >= -(SVAL)0x8000) && (v.u.i <= (SVAL)0x7fff)) ));
       break;
    case MOP_IS_UW:
       v = val_to_int(v);
       return(I_VAL( ((v.u.i >= 0) && (v.u.i <= (SVAL)0xffff)) ));
       break;
    case MOP_IS_SL:
       v = val_to_int(v);
       return(I_VAL( ((v.u.i >= -(SVAL)0x80000000ULL) && (v.u.i <= (SVAL)0x7fffffffULL)) ));
       break;
    case MOP_IS_UL:
       v = val_to_int(v);
       return(I_VAL( ((v.u.i >= 0) && (v.u.i <= (SVAL)0xffffffffULL)) ));
       break;
    case MOP_BSW:
       v = val_to_int(v);
       if ((v.u.i < -(SVAL)0x8000) || (v.u.i > (SVAL)0xffff))
	{ errmsg("value out of word range");
	}
       return(I_VAL(((v.u.i&0x00ff)<<8)|((v.u.i>>8)&0x00ff)));
       break;
    case MOP_BSL:
       v = val_to_int(v);
       if ((v.u.i < -(SVAL)0x80000000ULL) || (v.u.i > (SVAL)0xffffffffULL))
	{ errmsg("value out of long range");
	}
       return(I_VAL( ((v.u.i&0x000000ff)<<24) |
		     ((v.u.i&0x0000ff00)<< 8) |
		     ((v.u.i>> 8)&0x0000ff00) |
		     ((v.u.i>>24)&0x000000ff) ));
       break;
    case MOP_BSQ:
       v = val_to_int(v);
       return(I_VAL( ((v.u.i&0x00000000000000ffULL)<<56) |
		     ((v.u.i&0x000000000000ff00ULL)<<40) |
		     ((v.u.i&0x0000000000ff0000ULL)<<24) |
		     ((v.u.i&0x00000000ff000000ULL)<< 8) |
		     ((v.u.i>> 8)&0x00000000ff000000ULL) |
		     ((v.u.i>>24)&0x0000000000ff0000ULL) |
		     ((v.u.i>>40)&0x000000000000ff00ULL) |
		     ((v.u.i>>56)&0x00000000000000ffULL) ));
       break;
    case MOP_WSL:
       v = val_to_int(v);
       if ((v.u.i < -(SVAL)0x80000000ULL) || (v.u.i > (SVAL)0xffffffffULL))
	{ errmsg("value out of long range");
	}
       return(I_VAL( ((v.u.i&0x0000ffff)<<16) |
		     ((v.u.i>>16)&0x0000ffff) ));
       break;
    case MOP_WSQ:
       v = val_to_int(v);
       return(I_VAL( ((v.u.i&0x000000000000ffffULL)<<48) |
		     ((v.u.i&0x00000000ffff0000ULL)<<16) |
		     ((v.u.i>>16)&0x00000000ffff0000ULL) |
		     ((v.u.i>>48)&0x000000000000ffffULL) ));
       break;
    case MOP_LSQ:
       v = val_to_int(v);
       return(I_VAL( ((v.u.i&0x00000000ffffffffULL)<<32) |
		     ((v.u.i>>32)&0x00000000ffffffffULL) ));
       break;
    case MOP_SFLOAT:
       switch (v.t)
	{ case VT_I:
	     errmsg("@SFLOAT applied to integer value");
	     return(I_VAL(0));
	     break;
	  case VT_F:
	     return(I_VAL(fval_to_ieee(v.u.f,4,"")));
	     break;
	  default:
	     panic("perform_mop MOP_SFLOAT: type bad");
	     break;
	}
       break;
    case MOP_DFLOAT:
       switch (v.t)
	{ case VT_I:
	     errmsg("@DFLOAT applied to integer value");
	     return(I_VAL(0));
	     break;
	  case VT_F:
	     return(I_VAL(fval_to_ieee(v.u.f,8,"")));
	     break;
	  default:
	     panic("perform_mop MOP_DFLOAT: type bad");
	     break;
	}
       break;
    case MOP_FLOAT:
       switch (v.t)
	{ case VT_I:
	     return(F_VAL(ival_to_fval(v.u.i)));
	     break;
	  case VT_F:
	     return(v);
	     break;
	  default:
	     panic("perform_mop MOP_FLOAT: type bad");
	     break;
	}
       break;
    case MOP_INT:
       switch (v.t)
	{ case VT_I:
	     return(v);
	     break;
	  case VT_F:
	     return(I_VAL(fval_to_ival(v.u.f)));
	     break;
	  default:
	     panic("perform_mop MOP_INT: type bad");
	     break;
	}
       break;
    case MOP_FSIGN:
       switch (v.t)
	{ case VT_I:
	     errmsg("@FSIGN applied to integer value");
	     return(I_VAL(0));
	     break;
	  case VT_F:
	     return(I_VAL(v.u.f.neg));
	     break;
	  default:
	     panic("perform_mop MOP_FSIGN: type bad");
	     break;
	}
       break;
    case MOP_FEXP:
       switch (v.t)
	{ case VT_I:
	     errmsg("@FEXP applied to integer value");
	     return(I_VAL(0));
	     break;
	  case VT_F:
	     return(I_VAL(v.u.f.e));
	     break;
	  default:
	     panic("perform_mop MOP_FEXP: type bad");
	     break;
	}
       break;
    case MOP_FMANT:
       switch (v.t)
	{ case VT_I:
	     errmsg("@FMANT applied to integer value");
	     return(I_VAL(0));
	     break;
	  case VT_F:
	     return(I_VAL(v.u.f.m));
	     break;
	  default:
	     panic("perform_mop MOP_FMANT: type bad");
	     break;
	}
       break;
    case MOP_FLG:
       v = val_to_int(v);
       return(I_VAL( lg_f(v.u.i) ));
       break;
    case MOP_CLG:
       v = val_to_int(v);
       return(I_VAL( lg_c(v.u.i) ));
       break;
    default:
       panic("perform_mop: op bad");
       break;
  }
}

static void common_arithmetic(VAL *a, VAL *b)
{
 switch (a->t)
  { case VT_I:
       switch (b->t)
	{ case VT_I:
	     break;
	  case VT_F:
	     *a = val_to_float(*a);
	     break;
	  default:
	     panic("common_arithmetic V_I: b type bad");
	     break;
	}
       break;
    case VT_F:
       switch (b->t)
	{ case VT_I:
	     *b = val_to_float(*b);
	     break;
	  case VT_F:
	     break;
	  default:
	     panic("common_arithmetic V_F: b type bad");
	     break;
	}
       break;
    default:
       panic("common_arithmetic: a type bad");
       break;
  }
}

static int integer_arithmetic(VAL *a, VAL *b, const char *opname)
{
 int err;

 err = 0;
 switch (a->t)
  { case VT_I:
       break;
    case VT_F:
       err = 1;
       *a = I_VAL(0);
       break;
    default:
       panic("integer_arithmetic: a type bad");
       break;
  }
 if (b)
  { switch (b->t)
     { case VT_I:
	  break;
       case VT_F:
	  err = 1;
	  *b = I_VAL(0);
	  break;
       default:
	  panic("integer_arithmetic: b type bad");
	  break;
     }
    if (err) errmsg("%s on a floating-point value",opname);
  }
 else
  { if (err) errmsg("%s",opname);
  }
 return(err);
}

static FVAL float_add(FVAL a, FVAL b)
{
 int sc;
 UVAL low;

 if (! a.m) return(b);
 if (! b.m) return(a);
 if (a.e < b.e)
  { FVAL t;
    t = a;
    a = b;
    b = t;
  }
 sc = a.e - b.e;
 if (sc > 64) return(a);
 if (sc == 0)
  { if (a.neg == b.neg)
     { a.e ++;
       a.m += b.m;
       if ((a.m & 3) == 3) a.m ++;
       a.m = (a.m >> 1) | FVMANT_HIBIT;
       return(a);
     }
    else
     { if (a.m > b.m)
	{ a.m -= b.m;
	}
       else
	{ a.neg = ! a.neg;
	  a.m = b.m - a.m;
	  if (a.m == 0) return(fzero(a.neg));
	}
       return(normalize_shift(a));
     }
  }
 low = (b.m << (64-sc)) & FVMANT_MASK;
 b.m >>= sc;
 if (a.neg == b.neg)
  { a.m += b.m;
    if (! (a.m & FVMANT_HIBIT))
     { a.e ++;
       low = (low >> 1) | ((a.m & 1) << 63);
       a.m = (a.m >> 1) | FVMANT_HIBIT;
     }
    if ( (low > FVMANT_HIBIT) ||
	 ( (low == FVMANT_HIBIT) &&
	   (a.m & 1) ) )
     { a.m ++;
       if (! (a.m & FVMANT_HIBIT))
	{ a.e ++;
	  a.m = FVMANT_HIBIT;
	}
     }
    return(a);
  }
 else
  { a.m -= b.m;
    if ( (low > FVMANT_HIBIT) ||
	 ( (low == FVMANT_HIBIT) &&
	   (a.m & 1) ) ) a.m --;
    if (a.m == 0) return(fzero(a.neg)); /* not sure this can happen */
    return(normalize_shift(a));
  }
}

static FVAL float_mul(FVAL a, FVAL b)
{
 UVAL plow;
 UVAL pmid1;
 UVAL pmid2;
 FVAL p;

 if ((a.m == 0) || (b.m == 0)) return(fzero(a.neg^b.neg));
 plow = (a.m & FVMANT_LOW32) * (b.m & FVMANT_LOW32);
 pmid1 = (a.m & FVMANT_LOW32) * (b.m >> 32);
 pmid2 = (a.m >> 32) * (b.m & FVMANT_LOW32);
 p.m = (a.m >> 32) * (b.m >> 32);
 p.m += (pmid1 >> 32) + (pmid2 >> 32);
 pmid1 = (pmid1 & FVMANT_LOW32) + (pmid2 & FVMANT_LOW32) + (plow >> 32);
 p.m += (pmid1 >> 32);
 plow = (plow & FVMANT_LOW32) | ((pmid1 & FVMANT_LOW32) << 32);
 p.neg = a.neg ^ b.neg;
 p.e = a.e + b.e;
 if (! (p.m & FVMANT_HIBIT))
  { p.m = (p.m << 1) | (plow >> 63);
    plow = (plow << 1) & FVMANT_MASK;
    if (! (p.m & FVMANT_HIBIT)) panic("float_mul: lost high bit");
  }
 else
  { p.e ++;
  }
 if ( (plow > FVMANT_HIBIT) ||
      ( (plow == FVMANT_HIBIT) &&
	(p.m & 1) ) )
  { p.m ++;
    if (! (p.m & FVMANT_HIBIT))
     { p.m = FVMANT_HIBIT;
       p.e ++;
     }
  }
 return(p);
}

static FVAL float_div(FVAL a, FVAL b)
{
 int i;
 FVAL q;
 int h;

 void divbit(void)
  { q.m <<= 1;
    if (h || (a.m >= b.m))
     { q.m |= 1;
       a.m = (a.m - b.m) & FVMANT_MASK;
     }
    h = (a.m & FVMANT_HIBIT) ? 1 : 0;
    a.m <<= 1;
  }

 if (! b.m) panic("float_div: zero divisor mantissa");
 if (! a.m) return(fzero(a.neg^b.neg));
 q.neg = a.neg ^ b.neg;
 q.e = a.e - b.e;
 q.m = 0;
 h = 0;
 for (i=64;i>0;i--) divbit();
 if (! (q.m & FVMANT_HIBIT))
  { divbit();
    q.e --;
    if (! (q.m & FVMANT_HIBIT)) panic("float_div: lost high bit");
  }
 if ((a.m > b.m) || ((a.m == b.m) && (q.m & 1)))
  { q.m ++;
    if (! (q.m & FVMANT_HIBIT))
     { q.m = FVMANT_HIBIT;
       q.e ++;
     }
  }
 return(q);
}

static int fval_cmp_lt(FVAL a, FVAL b)
{
 /* If b is negative and a isn't, either a>b or a=+0 and b=-0;
    return value is 0 either way. */
 if (!a.neg && b.neg) return(0);
 /* If a is negative and b isn't, either a<b or a=-0 and b=+0;
    return 1 in the former case and 0 in the latter. */
 if (a.neg && !b.neg) return(a.m||b.m);
 /* At this point, we know the signs are the same. */
 /* Check for cases involving zero.
    (The above handled zeros only when they have opposite signs.)
    Have to do this before the below because zero is defined by .m==0
    only; .e is unspecified and may be anything. */
 if (! a.m) return(b.m?!a.neg:0);
 if (! b.m) return(a.neg);
 /* At this point, we have identical signs and know neither is zero. */
 /* If the exponents differ, the smaller exponent gives smaller
    magnitude; return based on sign. */
 if (a.e != b.e) return((a.e<b.e)?!a.neg:a.neg);
 /* Signs and exponents are equal.  Compare mantissas.
    Reverse the comparison for negative numbers. */
 return(a.neg?(a.m<b.m):(b.m<a.m));
}

static int fval_cmp_eq(FVAL a, FVAL b)
{
 /* Zero equals zero, even if the signs differ; nothing else does. */
 if (! a.m) return(!b.m);
 if (! b.m) return(0);
 /* Except for zero (which is already handled),
    equality occurs only when all parts are equal. */
 return((a.neg==b.neg)&&(a.e==b.e)&&(a.m==b.m));
}

static VAL do_shift(VAL v, SVAL sc)
{
 switch (v.t)
  { case VT_I:
       if (sc > 0) v.u.i <<= sc; else if (sc < 0) v.u.i >>= -sc;
       break;
    case VT_F:
       v.u.f.e += sc;
       break;
    default:
       panic("do_shift: type bad");
       break;
  }
 return(v);
}

static VAL perform_dop(DOP op, VAL lhs, VAL rhs)
{
 switch (op)
  { case DOP_ADD:
       common_arithmetic(&lhs,&rhs);
       switch (lhs.t)
	{ case VT_I:
	     return(I_VAL(lhs.u.i+rhs.u.i));
	     break;
	  case VT_F:
	     return(F_VAL(float_add(lhs.u.f,rhs.u.f)));
	     break;
	  default:
	     panic("perform_dop DOP_ADD: type bad");
	     break;
	}
       break;
    case DOP_SUB:
       common_arithmetic(&lhs,&rhs);
       switch (lhs.t)
	{ case VT_I:
	     return(I_VAL(lhs.u.i-rhs.u.i));
	     break;
	  case VT_F:
	     rhs.u.f.neg = ! rhs.u.f.neg;
	     return(F_VAL(float_add(lhs.u.f,rhs.u.f)));
	     break;
	  default:
	     panic("perform_dop DOP_SUB: type bad");
	     break;
	}
       break;
    case DOP_MUL:
       common_arithmetic(&lhs,&rhs);
       switch (lhs.t)
	{ case VT_I:
	     return(I_VAL(lhs.u.i*rhs.u.i));
	     break;
	  case VT_F:
	     return(F_VAL(float_mul(lhs.u.f,rhs.u.f)));
	     break;
	  default:
	     panic("perform_dop DOP_MUL: type bad");
	     break;
	}
       break;
    case DOP_DIV:
       common_arithmetic(&lhs,&rhs);
       switch (lhs.t)
	{ case VT_I:
	     if (rhs.u.i == 0)
	      { errmsg("division by zero");
		return(I_VAL(0));
	      }
	     return(I_VAL(lhs.u.i/rhs.u.i));
	     break;
	  case VT_F:
	     if (rhs.u.f.m == 0)
	      { errmsg("division by zero");
		return(vfzero(0));
	      }
	     return(F_VAL(float_div(lhs.u.f,rhs.u.f)));
	     break;
	  default:
	     panic("perform_dop DOP_DIV: type bad");
	     break;
	}
       break;
    case DOP_AND:
       integer_arithmetic(&lhs,&rhs,"&");
       return(I_VAL(lhs.u.i&rhs.u.i));
       break;
    case DOP_OR:
       integer_arithmetic(&lhs,&rhs,"|");
       return(I_VAL(lhs.u.i|rhs.u.i));
       break;
    case DOP_XOR:
       integer_arithmetic(&lhs,&rhs,"^");
       return(I_VAL(lhs.u.i^rhs.u.i));
       break;
    case DOP_LSH:
       integer_arithmetic(&lhs,0,"floating-point shift count");
       return(do_shift(lhs,rhs.u.i));
       break;
    case DOP_RSH:
       integer_arithmetic(&lhs,0,"floating-point shift count");
       return(do_shift(lhs,-rhs.u.i));
       break;
    case DOP_LT:
       common_arithmetic(&lhs,&rhs);
       switch (lhs.t)
	{ case VT_I:
	     return(I_VAL(lhs.u.i<rhs.u.i));
	     break;
	  case VT_F:
	     return(I_VAL(fval_cmp_lt(lhs.u.f,rhs.u.f)));
	     break;
	  default:
	     panic("perform_dop DOP_LT: type bad");
	     break;
	}
       break;
    case DOP_GT:
       common_arithmetic(&lhs,&rhs);
       switch (lhs.t)
	{ case VT_I:
	     return(I_VAL(lhs.u.i>rhs.u.i));
	     break;
	  case VT_F:
	     return(I_VAL(fval_cmp_lt(rhs.u.f,lhs.u.f)));
	     break;
	  default:
	     panic("perform_dop DOP_GT: type bad");
	     break;
	}
       break;
    case DOP_LE:
       common_arithmetic(&lhs,&rhs);
       switch (lhs.t)
	{ case VT_I:
	     return(I_VAL(lhs.u.i<=rhs.u.i));
	     break;
	  case VT_F:
	     return(I_VAL(!fval_cmp_lt(rhs.u.f,lhs.u.f)));
	     break;
	  default:
	     panic("perform_dop DOP_LE: type bad");
	     break;
	}
       break;
    case DOP_GE:
       common_arithmetic(&lhs,&rhs);
       switch (lhs.t)
	{ case VT_I:
	     return(I_VAL(lhs.u.i>=rhs.u.i));
	     break;
	  case VT_F:
	     return(I_VAL(!fval_cmp_lt(lhs.u.f,rhs.u.f)));
	     break;
	  default:
	     panic("perform_dop DOP_GE: type bad");
	     break;
	}
       break;
    case DOP_EQ:
       common_arithmetic(&lhs,&rhs);
       switch (lhs.t)
	{ case VT_I:
	     return(I_VAL(lhs.u.i==rhs.u.i));
	     break;
	  case VT_F:
	     return(I_VAL(fval_cmp_eq(lhs.u.f,rhs.u.f)));
	     break;
	  default:
	     panic("perform_dop DOP_EQ: type bad");
	     break;
	}
       break;
    case DOP_NE:
       common_arithmetic(&lhs,&rhs);
       switch (lhs.t)
	{ case VT_I:
	     return(I_VAL(lhs.u.i!=rhs.u.i));
	     break;
	  case VT_F:
	     return(I_VAL(!fval_cmp_eq(lhs.u.f,rhs.u.f)));
	     break;
	  default:
	     panic("perform_dop DOP_NE: type bad");
	     break;
	}
       break;
    case DOP_MOD:
       if (integer_arithmetic(&lhs,&rhs,"%")) return(I_VAL(0));
       if (rhs.u.i == 0)
	{ errmsg("mod by zero");
	  return(I_VAL(0));
	}
       return(I_VAL(lhs.u.i%rhs.u.i));
       break;
    default:
       panic("perform_dop: op bad");
       break;
  }
}

static VAL perform_nfn(NFN op, int nargs, EXPR **args)
{
 switch (op)
  { case NFN_MKFLOAT:
	{ VAL sgn;
	  VAL exp;
	  VAL mant;
	  FVAL rv;
	  if (nargs != 3)
	   { errmsg("@MKFLOAT with other than 3 args");
	     return(vfzero(0));
	   }
	  if ( (args[0]->type != X_CONST) ||
	       (args[1]->type != X_CONST) ||
	       (args[2]->type != X_CONST) ) panic("perform_nfn NFN_MKFLOAT: non-const arg");
	  sgn = args[0]->u.val;
	  exp = args[1]->u.val;
	  mant = args[2]->u.val;
	  if ( integer_arithmetic(&sgn,0,"floating_point arg to @MKFLOAT") ||
	       integer_arithmetic(&exp,0,"floating_point arg to @MKFLOAT") ||
	       integer_arithmetic(&mant,0,"floating_point arg to @MKFLOAT") ) return(vfzero(0));
	  rv.neg = sgn.u.i ? 1 : 0;
	  rv.e = exp.u.i;
	  rv.m = mant.u.i;
	  return(F_VAL(normalize_shift(rv)));
	}
       break;
    default:
       panic("perform_nfn: op bad");
       break;
  }
}

static EXPR *perform_immfn(MOP op, EXPR *arg)
{
 EXPR *rv;

 switch (op)
  { case MOP_KNOWN:
       rv = expr_make(X_CONST,VT_I,arg->type==X_CONST);
       expr_free(arg);
       break;
    default:
       panic("perform_immfn: op bad");
       break;
  }
 return(rv);
}

static EXPR *simplify_expr(EXPR *e)
{
 VAL v;
 EXPR *rx;
 int i;
 int ac;

 switch (e->type)
  { default:
       panic("simplify_expr: type bad");
       break;
    case X_CONST:
       return(e);
       break;
    case X_SYMBOL:
       if (e->u.sym->value)
	{ e->u.sym->value = simplify_expr(e->u.sym->value);
	  if (e->u.sym->value->type == X_CONST)
	   { v = e->u.sym->value->u.val;
	     expr_free(e);
	     return(expr_make(X_CONST,VT_U,v));
	   }
	}
       break;
    case X_MONAD:
       e->u.monad.arg = simplify_expr(e->u.monad.arg);
       if (e->u.monad.arg->type == X_CONST)
	{ v = perform_mop(e->u.monad.op,e->u.monad.arg->u.val);
	  expr_free(e);
	  return(expr_make(X_CONST,VT_U,v));
	}
       break;
    case X_IMMFN:
       e->u.monad.arg = simplify_expr(e->u.monad.arg);
       rx = perform_immfn(e->u.monad.op,e->u.monad.arg);
       return(rx);
       break;
    case X_DYAD:
       e->u.dyad.lhs = simplify_expr(e->u.dyad.lhs);
       e->u.dyad.rhs = simplify_expr(e->u.dyad.rhs);
       if ( (e->u.dyad.lhs->type == X_CONST) &&
	    (e->u.dyad.rhs->type == X_CONST) )
	{ v = perform_dop(e->u.dyad.op,e->u.dyad.lhs->u.val,e->u.dyad.rhs->u.val);
	  expr_free(e);
	  return(expr_make(X_CONST,VT_U,v));
	}
       break;
    case X_NAD:
       ac = 1;
       for (i=e->u.nad.nargs-1;i>=0;i--)
	{ e->u.nad.args[i] = simplify_expr(e->u.nad.args[i]);
	  if (e->u.nad.args[i]->type != X_CONST) ac = 0;
	}
       if (ac)
	{ v = perform_nfn(e->u.nad.op,e->u.nad.nargs,e->u.nad.args);
	  expr_free(e);
	  return(expr_make(X_CONST,VT_U,v));
	}
       break;
  }
 return(e);
}

static void resolve_patchups(SYM *s)
{
 PATCHLIST *l;
 PATCHUP *p;

 switch (s->value->type)
  { case X_CONST:
       break;
    default:
       return;
       break;
  }
 if (debugging)
  { fprintf(stderr,"[resolving patchups for %s=",s->name);
    fprint_expr(stderr,s->value);
    fprintf(stderr,"\n");
  }
 while (s->patchups)
  { l = s->patchups;
    s->patchups = l->link;
    p = l->patchup;
    free(l);
    p->refcnt --;
    if (p->expr)
     { push_file_line(p->file,p->line,0);
       p->expr = simplify_expr(p->expr);
       switch (p->expr->type)
	{ case X_CONST:
	     (*p->whenfixed)(p);
	     expr_free(p->expr);
	     p->expr = 0;
	     break;
	  default:
	     break;
	}
       pop_file_line();
     }
    if (p->refcnt < 1)
     { if (p->expr) panic("resolve_patchups: expr nonnil");
       free(p);
     }
  }
}

static void locsym_boundary(void)
{
 int i;
 SYM *s;
 PATCHLIST *l;

 for (i=0;i<10;i++)
  { cpu->locsym_b_have[i] = 0;
    s = cpu->locsym_f_sym[i];
    if (s)
     { for (l=s->patchups;l;l=l->link)
	{ push_file_line(l->patchup->file,l->patchup->line,0);
	  errmsg("undefined local label reference %df",i);
	  pop_file_line();
	}
       s->value = expr_make(X_CONST,VT_I,(SVAL)0);
       resolve_patchups(s);
       cpu->locsym_f_sym[i] = 0;
     }
  }
}

void do_locsymbar(void)
{
 locsym_boundary();
}

static CSTACK *pop_cs(void)
{
 CSTACK *cs;

 cs = ifstack;
 if (cs) ifstack = cs->link;
 return(cs);
}

static void free_cs(CSTACK *cs)
{
 free(cs->file);
 free(cs);
}

static void finish_assembly(void)
{
 SYM *s;
 CSTACK *cs;
 CPUSTATE *c;

 locsym_boundary();
 for (c=allcpus;c;c=c->link)
  { for (s=c->syms;s;s=s->link)
     { if (s->patchups)
	{ fprintf(stderr,"%s: %s symbol `%s' value never finalized\n",__progname,c->tag,s->name);
	}
     }
  }
 while ((cs=pop_cs()))
  { push_file_line(cs->file,cs->line,0);
    errmsg("unmatched .if");
    pop_file_line();
    free_cs(cs);
  }
 while (set_constants)
  { SETCONST *sc;
    sc = set_constants;
    set_constants = sc->link;
    switch (sc->kind)
     { case SCK_WORD:
       case SCK_LONG:
       case SCK_WLONG:
	  errmsgfl(sc->file,sc->line,"unresolved SETS constant (loc=%08"LPM"x)",sc->loc);
	  break;
       default:
	  panic("finish_assembly: set-constant kind bad");
	  break;
     }
    free(sc->file);
    free(sc);
  }
}

static void dump_s_records(void)
{
 int sx;
 MEMSEG *s;
 unsigned char ck;
 LOC l;
 LOC e;
 int n;
 int i;

 f_srec = open_file(fn_srec,"w","S-record");
 for (sx=0;sx<nmemsegs;sx++)
  { s = memsegs[sx];
    l = s->base;
    e = s->base + s->size;
    while (l < e)
     { n = 32;
       if (n > e-l) n = e - l;
       fprintf(f_srec,"S3%02X%08"LPM"X",n+5,l);
       ck = n + 5 + (l >> 24) + ((l >> 16) & 0xff) + ((l >> 8) & 0xff) + (l & 0xff);
       for (i=0;i<n;i++)
	{ fprintf(f_srec,"%02X",s->data[i+l-s->base]);
	  ck += s->data[i+l-s->base];
	}
       fprintf(f_srec,"%02X\n",0xff&~ck);
       l += n;
     }
  }
 if (have_entry)
  { ck = 5 + (entry >> 24) + ((entry >> 16) & 0xff) + ((entry >> 8) & 0xff) + (entry & 0xff);
    fprintf(f_srec,"S705%08"LPM"X%02X\n",entry,0xff&~ck);
  }
 fclose(f_srec);
}

static void add_cpu(CPUSTATE *c)
{
 c->link = allcpus;
 allcpus = c;
}

static void init_cpus(void)
{
 allcpus = 0;
 add_cpu(&cpustate_sh);
 add_cpu(&cpustate_vmu);
 cpu = &cpustate_sh;
}

static void init_machine_state(void)
{
 instr_flags = 0;
 f_sz = FS_ANY;
 f_pr = FS_ANY;
}

static void init_macros(void)
{
 macros = 0;
 macro_defining = 0;
 macro_name = 0;
 macro_args = 0;
 macro_args_a = 0;
}

static void init_set(void)
{
 set_constants = 0;
}

int main(int, char **);
int main(int ac, char **av)
{
 errs = 0;
 handleargs(ac,av);
 istack = 0;
 flstack = 0;
 xstack = 0;
 init_macros();
 include_file(strdup(fn_in),"input");
 f_list = open_file(fn_list,"w","listing");
 init_cpus();
 init_machine_state();
 init_stab();
 init_mem();
 init_list();
 init_ifs();
 init_set();
 assemble();
 finish_assembly();
 if (! errs) dump_s_records();
 exit(errs?1:0);
}

/*
 * We have to be careful in the 64-bit case, because
 *  (SVAL)0x8000000000000000 may be negative.
 */
static int setmem_(LOC loc, SVAL val, int size)
{
 int i;

 switch (size)
  { case 1:
       write_mem(loc,val);
       val /= (SVAL)0x80;
       break;
    case 2:
       write_mem(loc,val&0xff);
       write_mem(loc+1,val>>8);
       val /= (SVAL)0x8000;
       return((val < -(SVAL)0x8000) || (val > 0xffff));
       break;
    case 4:
       for (i=0;i<4;i++)
	{ write_mem(loc+i,(val>>(i*8))&0xff);
	}
       val /= (SVAL)0x80000000;
       break;
    case 8:
       for (i=0;i<8;i++)
	{ write_mem(loc+i,(val>>(i*8))&0xff);
	}
       if ((SVAL)0x8000000000000000ULL < 0) return(0);
       val /= (SVAL)0x8000000000000000ULL;
       break;
    default:
       panic("setmem_: size bad");
       break;
  }
 return((val!=0)&&(val!=-(SVAL)1)&&(val!=1));
}

static void record_write(LOC loc, int size, int wrote)
{
 WRITING *w;

 if (written && (written->wrote == wrote))
  { if (written->loc+written->size == loc)
     { written->size += size;
       return;
     }
    if (loc+size == written->loc)
     { written->size += size;
       written->loc = loc;
       return;
     }
  }
 w = malloc(sizeof(WRITING));
 w->link = written;
 w->loc = loc;
 w->size = size;
 w->wrote = wrote;
 written = w;
}

static int setmem(LOC loc, SVAL val, int size)
{
 if (setmem_(loc,val,size)) return(1);
 record_write(loc,size,1);
 return(0);
}

static int add_a_patchup(EXPR *e, PATCHUP *p)
{
 PATCHLIST *l;
 int i;
 int rv;

 switch (e->type)
  { default:
       panic("add_a_patchup: type bad");
       break;
    case X_CONST:
       return(0);
       break;
    case X_SYMBOL:
       if (debugging) fprintf(stderr,"[adding patchup for %s]\n",e->u.sym->name);
       l = malloc(sizeof(PATCHLIST));
       l->link = e->u.sym->patchups;
       l->patchup = p;
       e->u.sym->patchups = l;
       p->refcnt ++;
       return(1);
       break;
    case X_MONAD:
    case X_IMMFN:
       return(add_a_patchup(e->u.monad.arg,p));
       break;
    case X_DYAD:
       return( add_a_patchup(e->u.dyad.lhs,p) +
	       add_a_patchup(e->u.dyad.rhs,p) );
       break;
    case X_NAD:
       rv = 0;
       for (i=e->u.nad.nargs-1;i>=0;i--) rv += add_a_patchup(e->u.nad.args[i],p);
       return(rv);
       break;
  }
}

static PATCHUP *add_patchups(EXPR *e, void (*fixup)(PATCHUP *), void *arg)
{
 PATCHUP *p;

 p = malloc(sizeof(PATCHUP));
 p->expr = e;
 p->file = strdup(fl.file);
 p->line = fl.line;
 p->refcnt = 0;
 p->whenfixed = fixup;
 p->arg = arg;
 if (! add_a_patchup(e,p)) panic("add_patchups: add_a_patchup failed");
 return(p);
}

static int setmem_multi(LOC loc, SVAL val, int size, int count)
{
 int i;

 for (i=count;i>0;i--)
  { if (setmem(loc,val,size)) return(1);
    loc += size;
  }
 return(0);
}

static void mem_patch_fixup(PATCHUP *p)
{
 MEMPATCH *mp;

 mp = p->arg;
 switch (p->expr->type)
  { case X_CONST:
       switch (p->expr->u.val.t)
	{ case VT_I:
	     if (debugging) fprintf(stderr,"[mem_patch_fixup: loc=%08"LPM"x,val=%"VPM"d,size=%d,count=%d]\n",mp->loc,p->expr->u.val.u.i,mp->size,mp->count);
	     if (setmem_multi(mp->loc,p->expr->u.val.u.i,mp->size,mp->count))
	      { errmsg("%s",mp->onerr);
	      }
	     break;
	  case VT_F:
	     if (setmem_multi(mp->loc,fval_to_ieee(p->expr->u.val.u.f,mp->size,"patchup value for %08"LPM"x",mp->loc),mp->size,mp->count))
	      { errmsg("%s",mp->onerr);
	      }
	     break;
	  default:
	     panic("mem_patch_fixup X_CONST: type bad");
	     break;
	}
       break;
    default:
       panic("mem_patch_fixup: type bad");
       break;
  }
 free(mp);
}

static void add_mem_patchups(EXPR *e, LOC loc, int size, int count, const char *onerr)
{
 MEMPATCH *mp;

 mp = malloc(sizeof(MEMPATCH));
 mp->loc = loc;
 mp->size = size;
 mp->count = count;
 mp->onerr = onerr;
 add_patchups(e,mem_patch_fixup,mp);
}

static void store_or_patchup(EXPR *e, LOC loc, int size, const char *onerr)
{
 switch (e->type)
  { case X_CONST:
       switch (e->u.val.t)
	{ case VT_I:
	     if (setmem(loc,e->u.val.u.i,size))
	      { errmsg("%s",onerr);
	      }
	     break;
	  case VT_F:
	     if (setmem(loc,fval_to_ieee(e->u.val.u.f,size,"value for %08"LPM"x",loc),size))
	      { errmsg("%s",onerr);
	      }
	     break;
	  default:
	     panic("store_or_patchup X_CONST: type bad");
	     break;
	}
       expr_free(e);
       break;
    default:
       add_mem_patchups(e,loc,size,1,onerr);
       record_write(loc,size,0);
       break;
  }
}

void pl_trace(int n, const char *name)
{
 if (! debugging) return;
 fprintf(stderr,"<state %d",n);
 if (name) fprintf(stderr," (%s)",name);
 fprintf(stderr,">\n");
}

void pl_action(const char *s)
{
 if (! debugging) return;
 fprintf(stderr,"<action %s>\n",s);
}

int false_if(void)
{
 return(ifstack&&!ifstack->curtrue);
}

void do_assignment(void)
{
 if (assign_sym->flags & SF_DOT)
  { switch (assign_expr->type)
     { case X_CONST:
	  switch (assign_expr->u.val.t)
	   { case VT_I:
		break;
	     case VT_F:
		errmsg("can't assign floating-point value to .");
		break;
	     default:
		panic("do_assignment . X_CONST: type bad");
		break;
	   }
	  break;
       default:
	  errmsg("can't assign nonconstant value to .");
	  break;
     }
  }
 switch (assign_expr->type)
  { case X_CONST:
       switch (assign_expr->u.val.t)
	{ case VT_I:
	     list_value = assign_expr->u.val.u.i;
	     list_showvalue = LSV_ASSIGNI;
	     break;
	  case VT_F:
	     list_fvalue = assign_expr->u.val.u.f;
	     list_showvalue = LSV_ASSIGNF;
	     break;
	  default:
	     panic("do_assignment non-. X_CONST: type bad");
	     break;
	}
       break;
    default:
       list_showvalue = LSV_UNKASGN;
       break;
  }
 if (assign_sym->flags & SF_COLON)
  { errmsg("= assignment to :-defined symbol");
  }
 expr_free(assign_sym->value);
 assign_sym->value = assign_expr;
 resolve_patchups(assign_sym);
 assign_sym->flags = (assign_sym->flags & ~SF_COLON) | SF_ASSIGN;
}

void set_label(void)
{
 if (label_sym->flags & SF_COLON)
  { errmsg("redefinition of symbol `%s'",label_sym->name);
  }
 else if (label_sym->flags & SF_ASSIGN)
  { errmsg(": definition of =-assigned symbol");
  }
 /*locsym_boundary();*/
 expr_free(label_sym->value);
 label_sym->value = expr_make(X_CONST,VT_I,(SVAL)dot());
 list_value = dot();
 list_showvalue = LSV_LABEL;
 resolve_patchups(label_sym);
 label_sym->flags = (assign_sym->flags & ~SF_ASSIGN) | SF_COLON;
}

void set_loclabel(void)
{
 SYM *s;

 s = cpu->locsym_f_sym[locsym_n];
 if (s)
  { s->value = expr_make(X_CONST,VT_I,(SVAL)dot());
    resolve_patchups(s);
    cpu->locsym_f_sym[locsym_n] = 0;
  }
 cpu->locsym_b_have[locsym_n] = 1;
 cpu->locsym_b_loc[locsym_n] = dot();
}

void set_data_size(int n)
{
 data_size = n;
}

static EXPR *parsed_expr(void)
{
 EXPR *e;

 if ( !xstack ||
      (xstack->type != XST_EXP) ||
      (xstack->link && xstack->link->type != XST_MARK) ) panic("parsed_expr: stack trashed");
 e = xstack->u.exp;
 xst_pop();
 if (xstack) xst_pop();
 if (debugging)
  { fprintf(stderr,"[parsed_expr: ");
    fprint_expr(stderr,e);
    fprintf(stderr," -> ");
  }
 e = simplify_expr(e);
 if (debugging)
  { fprint_expr(stderr,e);
    fprintf(stderr,"]\n");
  }
 return(e);
}

static void incdot(int n)
{
 (*cpu->incdot)(n);
}

static void incdot_sh(int n)
{
 if ( (cpustate_sh.dotsym->value->type != X_CONST) ||
      (cpustate_sh.dotsym->value->u.val.t != VT_I) ) panic("incdot_sh: . bad");
 cpustate_sh.dotsym->value->u.val.u.i += n;
}

static void incdot_vmu(int n)
{
 cpustate_sh.dotsym->value->u.val.u.i += n;
 cpustate_vmu.dotsym->value->u.val.u.i += n;
}

void assemble_data_expression(void)
{
 EXPR *e;

 e = parsed_expr();
 switch (data_size)
  { default:
       panic("assemble_data_expression: size bad");
       break;
    case 1:
       store_or_patchup(e,dot(),1,"byte value out of range");
       incdot(1);
       break;
    case 2:
       store_or_patchup(e,dot(),2,"word value out of range");
       incdot(2);
       break;
    case 4:
       store_or_patchup(e,dot(),4,"long value out of range");
       incdot(4);
       break;
    case 8:
       store_or_patchup(e,dot(),8,"quad value out of range");
       incdot(8);
       break;
  }
}

void assemble_space_expression(void)
{
 EXPR *e;

 e = parsed_expr();
 switch (e->type)
  { case X_CONST:
       switch (e->u.val.t)
	{ case VT_I:
	     incdot(e->u.val.u.i);
	     break;
	  case VT_F:
	     errmsg(".space with a floating-point value");
	     break;
	  default:
	     panic("assemble_space_expression X_CONST: type bad");
	     break;
	}
       break;
    default:
       errmsg(".space with a nonconstant value");
       break;
  }
 expr_free(e);
}

void assemble_repeat_count(void)
{
 EXPR *e;

 e = parsed_expr();
 if ((e->type == X_CONST) && (e->u.val.t == VT_I))
  { if ((e->u.val.u.i < 0) || (e->u.val.u.i > 65536))
     { errmsg("repeat count out of range");
       repeat_count = 0;
     }
    else
     { repeat_count = e->u.val.u.i;
     }
    expr_free(e);
  }
 else
  { expr_free(e);
    errmsg("nonconstant repeat count");
    repeat_count = 0;
  }
}

void assemble_repeat_value(void)
{
 EXPR *e;
 const char *onerr;

 e = parsed_expr();
 switch (data_size)
  { default: panic("assemble_repeat_value: size bad"); break;
    case 1: onerr = "rbyte value out of range"; break;
    case 2: onerr = "rword value out of range"; break;
    case 4: onerr = "rlong value out of range"; break;
    case 8: onerr = "rquad value out of range"; break;
  }
 switch (e->type)
  { case X_CONST:
       switch (e->u.val.t)
	{ case VT_I:
	     if (setmem_multi(dot(),e->u.val.u.i,data_size,repeat_count))
	      { errmsg("%s",onerr);
	      }
	     break;
	  case VT_F:
	     if (setmem_multi(dot(),fval_to_ieee(e->u.val.u.f,data_size,"repeated value"),data_size,repeat_count))
	      { errmsg("%s",onerr);
	      }
	     break;
	  default:
	     panic("assemble_repeat_value X_CONST: type bad");
	     break;
	}
       break;
    default:
       add_mem_patchups(e,dot(),data_size,repeat_count,onerr);
       break;
  }
 incdot(repeat_count*data_size);
}

void assemble_ascii(void)
{
 int i;

 for (i=0;i<string_len;i++)
  { setmem(dot(),string_buf[i],1);
    incdot(1);
  }
}

void assemble_ascic(void)
{
 int i;

 if (string_len > 255)
  { errmsg(".ascic string longer than 255 bytes");
  }
 setmem(dot(),string_len&255,1);
 incdot(1);
 for (i=0;i<string_len;i++)
  { setmem(dot(),string_buf[i],1);
    incdot(1);
  }
}

void assemble_asciz(void)
{
 assemble_ascii();
 setmem(dot(),0,1);
 incdot(1);
}

void assemble_error_start(void)
{
 dot_error = errmsgfl_open(fl.file,fl.line);
 fprintf(dot_error,".error: ");
}

void assemble_error_char(int c)
{
 putc(c,dot_error);
}

void assemble_error_done(void)
{
 fclose(dot_error);
 dot_error = 0;
}

void push_include(void)
{
 include_file(strdup(string_buf),".include");
}

void set_listing(int onoff)
{
 if (list_on) list_force = 1;
 list_on = onoff;
 if (list_on) list_force = 1;
}

static void intlist_push(INTLIST **stk, int v)
{
 INTLIST *il;

 il = malloc(sizeof(INTLIST));
 il->i = v;
 il->link = *stk;
 *stk = il;
}

static int intlist_pop(INTLIST **stk)
{
 INTLIST *il;
 int rv;

 il = *stk;
 *stk = il->link;
 rv = il->i;
 free(il);
 return(rv);
}

void push_listing(void)
{
 if (list_on) list_force = 1;
 intlist_push(&liststack,list_on);
 if (list_on) list_force = 1;
}

void pop_listing(void)
{
 if (liststack == 0)
  { errmsg("unmatched .list pop");
  }
 else
  { if (list_on) list_force = 1;
    list_on = intlist_pop(&liststack);
    if (list_on) list_force = 1;
  }
}

static CSTACK *new_cs(void)
{
 CSTACK *cs;

 cs = malloc(sizeof(CSTACK));
 cs->file = 0;
 return(cs);
}

static void push_cs(CSTACK *cs)
{
 cs->link = ifstack;
 ifstack = cs;
}

void do_if(void)
{
 CSTACK *cs;
 EXPR *e;

 e = parsed_expr();
 if (false_if())
  { cs = 0;
  }
 else
  { switch (e->type)
     { case X_CONST:
	  switch (e->u.val.t)
	   { case VT_I:
		cs = new_cs();
		cs->curtrue = (e->u.val.u.i != 0);
		cs->evertrue = cs->curtrue;
		break;
	     case VT_F:
		errmsg(".if expression value is floating point");
		cs = 0;
		break;
	     default:
		panic("do_if true X_CONST: type bad");
		break;
	   }
	  break;
       default:
	  errmsg(".if expression value not known");
	  cs = 0;
	  break;
     }
  }
 if (! cs)
  { cs = new_cs();
    cs->curtrue = 0;
    cs->evertrue = 1;
  }
 cs->file = strdup(fl.file);
 cs->line = fl.line;
 push_cs(cs);
 expr_free(e);
}

void do_elif(void)
{
 CSTACK *cs;
 EXPR *e;

 e = parsed_expr();
 cs = pop_cs();
 if (! cs)
  { errmsg(".elif not inside a .if/.endif");
  }
 else
  { if (cs->evertrue)
     { cs->curtrue = 0;
     }
    else
     { switch (e->type)
	{ case X_CONST:
	     switch (e->u.val.t)
	      { case VT_I:
		   cs->curtrue = (e->u.val.u.i != 0);
		   cs->evertrue = cs->curtrue;
		   break;
		case VT_F:
		   errmsg(".elif expression value is floating point");
		   cs->curtrue = 0;
		   cs->evertrue = 1;
		   break;
		default:
		   panic("do_elif true X_CONST: type bad");
		   break;
	      }
	     break;
	  default:
	     errmsg(".elif expression value not known");
	     cs->curtrue = 0;
	     cs->evertrue = 1;
	     break;
	}
     }
    push_cs(cs);
  }
 expr_free(e);
}

void do_else(void)
{
 CSTACK *cs;

 cs = pop_cs();
 if (cs)
  { cs->curtrue = ! cs->evertrue;
    cs->evertrue = 1;
    push_cs(cs);
  }
 else
  { errmsg(".else not inside a .if/.endif");
  }
}

void do_endif(void)
{
 CSTACK *cs;

 cs = pop_cs();
 if (cs)
  { free_cs(cs);
  }
 else
  { errmsg("unmatched .endif");
  }
}

void do_align(void)
{
 EXPR *x;

 x = parsed_expr();
 switch (x->type)
  { case X_CONST:
       switch (x->u.val.t)
	{ case VT_I:
	     if (dot() % x->u.val.u.i) incdot(x->u.val.u.i-(dot()%x->u.val.u.i));
	     break;
	  case VT_F:
	     errmsg(".align with a floating-point value");
	     break;
	  default:
	     panic("do_align X_CONST: type bad");
	     break;
	}
       break;
    default:
       errmsg(".align with a nonconstant value");
       break;
  }
 expr_free(x);
 delay_slot_warn();
 instr_flags &= ~IF_DS_HAD;
}

void save_label_symbol(void)
{
 label_sym = lookup_sym(symbol_name,symbol_space,1);
}

void locsym_set_digit(char c)
{
 locsym_n = c - '0';
}

void save_assignment_symbol(void)
{
 assign_sym = lookup_sym(symbol_name,symbol_space,1);
}

void save_assignment_symbol_dot(void)
{
 save_symbol_name(".");
 save_assignment_symbol();
}

void save_assignment_expression(void)
{
 assign_expr = parsed_expr();
}

static void parse_blanks(void)
{
 parselinegetarg()->flags |= FSM_FLAG_PARSE_BLANKS;
}

static void skip_blanks(void)
{
 parselinegetarg()->flags &= ~FSM_FLAG_PARSE_BLANKS;
}

void begin_expression(void)
{
 XSTACK *x;

 x = malloc(sizeof(XSTACK));
 x->link = xstack;
 x->type = XST_MARK;
 xstack = x;
 parse_blanks();
}

void end_expression(void)
{
 if (! expr_can_end()) panic("end_expression: can't end");
 skip_blanks();
}

static void xst_push_expr(EXPR *e)
{
 XSTACK *x;

 x = malloc(sizeof(XSTACK));
 x->link = xstack;
 x->type = XST_EXP;
 x->u.exp = e;
 xstack = x;
}

static void xst_collapse1(void)
{
 EXPR *lhs;
 EXPR *rhs;
 MOP mop;
 DOP dop;

 if ( !xstack ||
      (xstack->type != XST_EXP) ||
      !xstack->link ||
      (xstack->link->type == XST_EXP) ||
      (xstack->link->type == XST_MARK) ) panic("xst_collapse1: stack trashed");
 switch (xstack->link->type)
  { default:
       panic("xst_collapse1: type bad");
       break;
    case XST_UOP:
       rhs = xstack->u.exp;
       xst_pop();
       mop = xstack->u.uop;
       xst_pop();
       switch (mop)
	{ default:
	     panic("xst_collapse1 XST_UOP: op bad");
	     break;
	  case MOP_NIL:
	     xst_push_expr(rhs);
	     break;
	  case MOP_NEG:
	  case MOP_CMP:
	  case MOP_NOT:
	  case MOP_SB:
	  case MOP_UB:
	  case MOP_SW:
	  case MOP_UW:
	  case MOP_SL:
	  case MOP_UL:
	  case MOP_IS_SB:
	  case MOP_IS_UB:
	  case MOP_IS_SW:
	  case MOP_IS_UW:
	  case MOP_IS_SL:
	  case MOP_IS_UL:
	  case MOP_BSW:
	  case MOP_BSL:
	  case MOP_BSQ:
	  case MOP_WSL:
	  case MOP_WSQ:
	  case MOP_LSQ:
	  case MOP_SFLOAT:
	  case MOP_DFLOAT:
	  case MOP_FLOAT:
	  case MOP_INT:
	  case MOP_FSIGN:
	  case MOP_FEXP:
	  case MOP_FMANT:
	  case MOP_FLG:
	  case MOP_CLG:
	     xst_push_expr(expr_make(X_MONAD,mop,rhs));
	     break;
	  case MOP_KNOWN:
	     xst_push_expr(expr_make(X_IMMFN,mop,rhs));
	     break;
	}
       break;
    case XST_BOP:
       rhs = xstack->u.exp;
       xst_pop();
       dop = xstack->u.bop;
       xst_pop();
       if (!xstack || (xstack->type != XST_EXP)) panic("xst_collapse1 XST_BOP: stack bad");
       lhs = xstack->u.exp;
       xst_pop();
       xst_push_expr(expr_make(X_DYAD,lhs,dop,rhs));
       break;
    case XST_PAR:
       lhs = xstack->u.exp;
       xst_pop();
       xst_pop();
       xst_push_expr(lhs);
       break;
  }
}

static int dop_pri(DOP dop)
{
 switch (dop)
  { case DOP_MUL: case DOP_DIV: case DOP_MOD:
       return(5);
       break;
    case DOP_ADD: case DOP_SUB:
       return(4);
       break;
    case DOP_LSH: case DOP_RSH:
       return(3);
       break;
    case DOP_LT: case DOP_GT:
    case DOP_LE: case DOP_GE:
    case DOP_EQ: case DOP_NE:
       return(2);
       break;
    case DOP_AND: case DOP_OR:  case DOP_XOR:
       return(1);
       break;
    default:
       panic("dop_pri: op bad");
       break;
  }
}

static void xst_collapse(int pri)
{
 while (1)
  { if ( !xstack ||
	 (xstack->type != XST_EXP) ||
	 !xstack->link ||
	 (xstack->link->type == XST_EXP) ||
	 (xstack->link->type == XST_MARK) ) return;
    switch (xstack->link->type)
     { default:
	  panic("xst_collapse: type bad");
	  break;
       case XST_UOP:
	  xst_collapse1();
	  break;
       case XST_BOP:
	  if (dop_pri(xstack->link->u.bop) < pri) return;
	  xst_collapse1();
	  break;
       case XST_PAR:
	  return;
	  break;
     }
  }
}

int expr_can_end(void)
{
 xst_collapse(0);
 return( xstack && (xstack->type == XST_EXP) &&
	 (!xstack->link || (xstack->link->type == XST_MARK)) );
}

void abort_expression(void)
{
 while (xstack && (xstack->type != XST_MARK)) xst_pop();
 skip_blanks();
}

static void xst_push_uop(MOP op)
{
 XSTACK *x;

 x = malloc(sizeof(XSTACK));
 x->link = xstack;
 x->type = XST_UOP;
 x->u.uop = op;
 xstack = x;
}

static void xst_push_nfn(NFN op)
{
 XSTACK *x;

 x = malloc(sizeof(XSTACK));
 x->link = xstack;
 x->type = XST_NFN;
 x->u.nfn.op = op;
 x->u.nfn.args = 0;
 x->u.nfn.aargs = 0;
 x->u.nfn.nargs = 0;
 xstack = x;
}

static void add_nfn_arg(void)
{
 EXPR *e;

 if ( !xstack || (xstack->type != XST_EXP) ||
      !xstack->link || (xstack->link->type != XST_NFN) ) panic("add_nfn_arg: stack trashed");
 e = xstack->u.exp;
 xst_pop();
 if (xstack->u.nfn.aargs >= xstack->u.nfn.nargs)
  { xstack->u.nfn.aargs = xstack->u.nfn.nargs + 8;
    xstack->u.nfn.args = realloc(xstack->u.nfn.args,xstack->u.nfn.aargs*sizeof(EXPR *));
  }
 xstack->u.nfn.args[xstack->u.nfn.nargs++] = e;
}

static void close_nfn(void)
{
 EXPR *e;

 if (!xstack || (xstack->type != XST_NFN)) panic("close_nfn: stack trashed");
 e = expr_make(X_NAD,xstack->u.nfn.op,xstack->u.nfn.nargs,xstack->u.nfn.args);
 xst_pop();
 xst_push_expr(e);
}

static void xst_push_bop(DOP op)
{
 XSTACK *x;

 xst_collapse(dop_pri(op));
 x = malloc(sizeof(XSTACK));
 x->link = xstack;
 x->type = XST_BOP;
 x->u.bop = op;
 xstack = x;
}

int expr_str_op(const char *s)
{
 DOP op;

      if (!strcmp(s,"<<")) op = DOP_LSH;
 else if (!strcmp(s,">>")) op = DOP_RSH;
 else if (!strcmp(s,"<=")) op = DOP_LE;
 else if (!strcmp(s,">=")) op = DOP_GE;
 else if (!strcmp(s,"==")) op = DOP_EQ;
 else if (!strcmp(s,"!=")) op = DOP_NE;
 else panic("expr_str_op: string bad");
 if (!xstack || (xstack->type != XST_EXP)) return(0);
 xst_push_bop(op);
 return(1);
}

int expr_op(char c)
{
 MOP uop;
 DOP bop;

 uop = MOP_NONE;
 bop = DOP_NONE;
 switch (c)
  { default: panic("expr_op: char bad"); break;
    case '+': uop = MOP_NIL; bop = DOP_ADD; break;
    case '-': uop = MOP_NEG; bop = DOP_SUB; break;
    case '*':                bop = DOP_MUL; break;
    case '/':                bop = DOP_DIV; break;
    case '%':                bop = DOP_MOD; break;
    case '&':                bop = DOP_AND; break;
    case '|':                bop = DOP_OR;  break;
    case '^':                bop = DOP_XOR; break;
    case '<':                bop = DOP_LT;  break;
    case '>':                bop = DOP_GT;  break;
    case '~': uop = MOP_CMP;                break;
    case '!': uop = MOP_NOT;                break;
  }
 if (xstack && (xstack->type == XST_EXP))
  { if (bop == DOP_NONE) return(0);
  }
 else
  { if (uop == MOP_NONE) return(0);
    xst_push_uop(uop);
    return(1);
  }
 xst_push_bop(bop);
 return(1);
}

static void xst_push_par(void)
{
 XSTACK *x;

 x = malloc(sizeof(XSTACK));
 x->link = xstack;
 x->type = XST_PAR;
 xstack = x;
}

int function_call_name(const char *name)
{
 fn_mop = MOP_NONE;
 fn_nfn = NFN_NONE;
      if (!strcmp(name,"SB"))      fn_mop = MOP_SB;
 else if (!strcmp(name,"UB"))      fn_mop = MOP_UB;
 else if (!strcmp(name,"SW"))      fn_mop = MOP_SW;
 else if (!strcmp(name,"UW"))      fn_mop = MOP_UW;
 else if (!strcmp(name,"SL"))      fn_mop = MOP_SL;
 else if (!strcmp(name,"UL"))      fn_mop = MOP_UL;
 else if (!strcmp(name,"IS_SB"))   fn_mop = MOP_IS_SB;
 else if (!strcmp(name,"IS_UB"))   fn_mop = MOP_IS_UB;
 else if (!strcmp(name,"IS_SW"))   fn_mop = MOP_IS_SW;
 else if (!strcmp(name,"IS_UW"))   fn_mop = MOP_IS_UW;
 else if (!strcmp(name,"IS_SL"))   fn_mop = MOP_IS_SL;
 else if (!strcmp(name,"IS_UL"))   fn_mop = MOP_IS_UL;
 else if (!strcmp(name,"KNOWN"))   fn_mop = MOP_KNOWN;
 else if (!strcmp(name,"BSW"))     fn_mop = MOP_BSW;
 else if (!strcmp(name,"BSL"))     fn_mop = MOP_BSL;
 else if (!strcmp(name,"BSQ"))     fn_mop = MOP_BSQ;
 else if (!strcmp(name,"WSL"))     fn_mop = MOP_WSL;
 else if (!strcmp(name,"WSQ"))     fn_mop = MOP_WSQ;
 else if (!strcmp(name,"LSQ"))     fn_mop = MOP_LSQ;
 else if (!strcmp(name,"SFLOAT"))  fn_mop = MOP_SFLOAT;
 else if (!strcmp(name,"DFLOAT"))  fn_mop = MOP_DFLOAT;
 else if (!strcmp(name,"FLOAT"))   fn_mop = MOP_FLOAT;
 else if (!strcmp(name,"INT"))     fn_mop = MOP_INT;
 else if (!strcmp(name,"FSIGN"))   fn_mop = MOP_FSIGN;
 else if (!strcmp(name,"FEXP"))    fn_mop = MOP_FEXP;
 else if (!strcmp(name,"FMANT"))   fn_mop = MOP_FMANT;
 else if (!strcmp(name,"FLG"))     fn_mop = MOP_FLG;
 else if (!strcmp(name,"CLG"))     fn_mop = MOP_CLG;
 else if (!strcmp(name,"MKFLOAT")) fn_nfn = NFN_MKFLOAT;
 else return(0);
 return(1);
}

void push_function_open(void)
{
 if (fn_mop != MOP_NONE)
  { xst_push_uop(fn_mop);
    xst_push_par();
  }
 if (fn_nfn != NFN_NONE)
  { xst_push_nfn(fn_nfn);
  }
}

static int xst_collapse_paren(void)
{
 while (1)
  { if (!xstack || (xstack->type != XST_EXP)) panic("xst_collapse_paren: stack trashed 1");
    if (!xstack->link || (xstack->link->type == XST_MARK)) return(0);
    if (xstack->link->type == XST_EXP) panic("xst_collapse_paren: stack trashed 2");
    switch (xstack->link->type)
     { default:
	  panic("xst_collapse_paren: type bad");
	  break;
       case XST_UOP:
	  xst_collapse1();
	  break;
       case XST_BOP:
	  xst_collapse1();
	  break;
       case XST_NFN:
	  add_nfn_arg();
	  close_nfn();
	  return(1);
	  break;
       case XST_PAR:
	  xst_collapse1();
	  return(1);
	  break;
     }
  }
}

static int xst_collapse_comma(void)
{
 while (1)
  { if (!xstack || (xstack->type != XST_EXP)) panic("xst_collapse_comma: stack trashed 1");
    if (!xstack->link || (xstack->link->type == XST_MARK)) return(0);
    if (xstack->link->type == XST_EXP) panic("xst_collapse_comma: stack trashed 2");
    switch (xstack->link->type)
     { default:
	  panic("xst_collapse_comma: type bad");
	  break;
       case XST_UOP:
	  xst_collapse1();
	  break;
       case XST_BOP:
	  xst_collapse1();
	  break;
       case XST_NFN:
	  add_nfn_arg();
	  return(1);
	  break;
       case XST_PAR:
	  return(0);
	  break;
     }
  }
}

int expr_paren(char c)
{
 switch (c)
  { case '(':
       xst_push_par();
       break;
    case ')':
       if (! xst_collapse_paren()) return(0);
       break;
  }
 return(1);
}

int expr_comma(void)
{
 if (! xst_collapse_comma()) return(0);
 return(1);
}

int xst_terminal_ok(void)
{
 return(!xstack || (xstack->type != XST_EXP));
}

void expr_locsymref(void)
{
 SYM *s;

 if (! xst_terminal_ok()) panic("expr_locsymref: terminal not ok");
 switch (locsym_dir)
  { case 'b':
       if (! cpu->locsym_b_have[locsym_n])
	{ errmsg("undefined local label reference %db",locsym_n);
	  xst_push_expr(expr_make(X_CONST,VT_I,(SVAL)0));
	}
       else
	{ xst_push_expr(expr_make(X_CONST,VT_I,(SVAL)cpu->locsym_b_loc[locsym_n]));
	}
       break;
    case 'f':
       s = cpu->locsym_f_sym[locsym_n];
       if (! s)
	{ char *n;
	  asprintf(&n,"__%df_%u",locsym_n,cpu->locsym_serial++);
	  s = newsym(n);
	  free(n);
	  s->link = cpu->syms;
	  cpu->syms = s;
	  cpu->locsym_f_sym[locsym_n] = s;
	}
       xst_push_expr(expr_make(X_SYMBOL,s));
       break;
  }
}

int expr_constant(unsigned long int v)
{
 if (! xst_terminal_ok()) return(0);
 xst_push_expr(expr_make(X_CONST,VT_I,(SVAL)v));
 return(1);
}

int expr_constant_init(void)
{
 if (! xst_terminal_ok()) return(0);
 expr_constant_ndig = 0;
 expr_constant_val = 0;
 return(1);
}

void expr_constant_digit(unsigned int base, int dchar)
{
 expr_constant_ndig ++;
 expr_constant_val *= base;
 switch (dchar)
  { case '0':                          break;
    case '1': expr_constant_val +=  1; break;
    case '2': expr_constant_val +=  2; break;
    case '3': expr_constant_val +=  3; break;
    case '4': expr_constant_val +=  4; break;
    case '5': expr_constant_val +=  5; break;
    case '6': expr_constant_val +=  6; break;
    case '7': expr_constant_val +=  7; break;
    case '8': expr_constant_val +=  8; break;
    case '9': expr_constant_val +=  9; break;
    case 'a': case 'A': expr_constant_val += 10; break;
    case 'b': case 'B': expr_constant_val += 11; break;
    case 'c': case 'C': expr_constant_val += 12; break;
    case 'd': case 'D': expr_constant_val += 13; break;
    case 'e': case 'E': expr_constant_val += 14; break;
    case 'f': case 'F': expr_constant_val += 15; break;
    default: panic("expr_constant_digit: digit bad"); break;
  }
}

int expr_constant_done(void)
{
 if (expr_constant_ndig < 1) return(0);
 xst_push_expr(expr_make(X_CONST,VT_I,(SVAL)expr_constant_val));
 return(1);
}

static int string_names_register(const char *name, const char *prefix, unsigned int bits)
{
 int pl;
 char *ep;
 unsigned long int v;

 pl = strlen(prefix);
 if (strncmp(name,prefix,pl)) return(0);
 v = strtoul(name+pl,&ep,10);
 if (ep == name+pl) return(0);
 if (*ep) return(0);
 if (v & ~bits) return(0);
 return(1);
}

int expr_symbol(void)
{
 if ( string_names_register(symbol_name,"r",0xf) ||
      string_names_register(symbol_name,"fr",0xf) ||
      string_names_register(symbol_name,"dr",0xe) ||
      string_names_register(symbol_name,"xd",0xe) ||
      string_names_register(symbol_name,"fv",0xc) ) return(0);
 if (! xst_terminal_ok()) return(0);
 xst_push_expr(expr_make(X_SYMBOL,lookup_sym(symbol_name,symbol_space,1)));
 return(1);
}

int expr_symbol_dot(void)
{
 save_symbol_name(".");
 return(expr_symbol());
}

void locsym_set_direction(char c)
{
 locsym_dir = c;
}

void init_string(void)
{
 if (! string_buf)
  { string_buf = malloc(1);
    string_have = 0;
  }
 string_len = 0;
}

void begin_string_part(char term)
{
 string_term = term;
 parse_blanks();
}

int end_string(int abort)
{
 if ((string_len > 0) && !abort)
  { string_buf[string_len] = '\0';
    return(1);
  }
 return(0);
}

int is_string_term(char c)
{
 if (c == string_term)
  { skip_blanks();
    return(1);
  }
 return(0);
}

void save_string_char(char c)
{
 if (string_len >= string_have)
  { string_buf = realloc(string_buf,(string_have=string_len+16)+1);
  }
 string_buf[string_len++] = c;
}

void save_string_expr(void)
{
 EXPR *e;

 e = parsed_expr();
 switch (e->type)
  { case X_CONST:
       switch (e->u.val.t)
	{ case VT_I:
	     if ((e->u.val.u.i <= -128) || (e->u.val.u.i > 255))
	      { errmsg("< > expr out of range");
	      }
	     else
	      { save_string_char(e->u.val.u.i);
	      }
	     break;
	  case VT_F:
	     errmsg("floating-point expr in < >");
	     break;
	  default:
	     panic("save_string_expr X_CONST: type bad");
	     break;
	}
       break;
    default:
       errmsg("nonconstant expr in < > - use .byte");
       break;
  }
 expr_free(e);
}

void abort_string(void)
{
}

void assemble_entry_expression(void)
{
 EXPR *x;

 x = parsed_expr();
 switch (x->type)
  { case X_CONST:
       switch (x->u.val.t)
	{ case VT_I:
	     if (have_entry && (entry != x->u.val.u.i))
	      { errmsg("multiple .entry directives with different values");
	      }
	     else
	      { have_entry = 1;
		entry = x->u.val.u.i;
	      }
	     break;
	  case VT_F:
	     errmsg(".entry with a floating-point value");
	     break;
	  default:
	     panic("assemble_entry_expression X_CONST: type bad");
	     break;
	}
       break;
    default:
       errmsg(".entry with a nonconstant value");
       break;
  }
 expr_free(x);
}

void reset_ops(void)
{
 instr_extra_val = 0;
 instr_extra_mask = 0;
 instr_fields_val = 0;
 instr_fields_mask = 0;
 expr_free(low_bits);
 low_bits = 0;
 low_nbits = 0;
 expr_free(vmu_d9);
 vmu_d9 = 0;
 expr_free(vmu_b3);
 vmu_b3 = 0;
 expr_free(vmu_aref);
 vmu_aref = 0;
 expr_free(vmu_base);
 vmu_base = 0;
}

static SVAL finalize_branch_displacement(SVAL v, int bits)
{
 SVAL m;

 m = ((UVAL)1) << bits;
 if (v & 1)
  { errmsg("odd branch offset");
  }
 if (-v > m)
  { errmsg("branch too far");
  }
 else if (v > m-2)
  { errmsg("branch too far");
  }
 return(v>>1);
}

static SVAL finalize_offset(SVAL v, int bits)
{
 if (v < 0)
  { errmsg("negative offset");
    return(v);
  }
 if (v & ((1U << offset_shift_bits) - 1))
  { errmsg("misaligned offset");
  }
 v >>= offset_shift_bits;
 if (v >> bits) errmsg("offset too large");
 return(v);
}

static SVAL finalize_immediate(SVAL v, int bits __attribute__((__unused__)))
{
 if ((v < -128) || (v > 255))
  { errmsg("immediate value out of range");
  }
 return(v);
}

static SVAL finalize_pcrel_w(SVAL v, int bits __attribute__((__unused__)))
{
 if (v & 1)
  { errmsg("misaligned pc-relative word displacement");
  }
 if (v < 0)
  { errmsg("negative pc-relative displacement");
  }
 else if (v > 510)
  { errmsg("pc-relative displacement out of range");
  }
 return(v>>1);
}

static SVAL finalize_pcrel_l(SVAL v, int bits __attribute__((__unused__)))
{
 if (v & 3)
  { errmsg("misaligned pc-relative long displacement");
  }
 if (v < 0)
  { errmsg("negative pc-relative displacement");
  }
 else if (v > 1020)
  { errmsg("pc-relative displacement out of range");
  }
 return(v>>2);
}

static void low_patch_fixup(PATCHUP *p)
{
 LOWPATCH *lp;
 SVAL v;

 lp = p->arg;
 if (debugging) fprintf(stderr,"[low_patch_fixup: loc=%08"LPM"x bits=%d]\n",lp->loc,lp->bits);
 switch (p->expr->type)
  { case X_CONST:
       switch (p->expr->u.val.t)
	{ case VT_I:
	     v = (*lp->finalize)(p->expr->u.val.u.i,lp->bits);
	     setmem(lp->loc,lp->rest|(v&((1U<<lp->bits)-1)),2);
	     break;
	  case VT_F:
	     errmsgfl(p->file,p->line,"instruction field has floating-point type");
	     break;
	  default:
	     panic("low_patch_fixup X_CONST: type bad");
	     break;
	}
       break;
    default:
       panic("low_patch_fixup: type bad");
       break;
  }
 free(lp);
}

static void oddinstr(void)
{
 if (dot() & 1)
  { errmsg("instruction at odd address");
  }
}

void assemble_instruction(void)
{
 unsigned short int bm;
 LOWPATCH *lp;

 bm = low_nbits ? (1U << low_nbits) - 1 : 0;
 if ( ( instr_base_mask | instr_extra_mask |
	instr_fields_mask | bm ) != 0xffff)
  { errmsg("missing bits: base %04x extra %04x fields %04x low %04x",
	instr_base_mask, instr_extra_mask, instr_fields_mask, bm);
  }
 if ( ( instr_base_mask | instr_extra_mask |
	instr_fields_mask | bm ) !=
      ( instr_base_mask + instr_extra_mask +
	instr_fields_mask + bm ) )
  { errmsg("overlapping bits: base %04x extra %04x fields %04x low %04x",
	instr_base_mask, instr_extra_mask, instr_fields_mask, bm);
  }
 if (debugging)
  { fprintf(stderr,"[instruction: %04x/%04x %04x/%04x %04x/%04x %04x]\n",
	instr_base_val, instr_base_mask,
	instr_extra_val, instr_extra_mask,
	instr_fields_val, instr_fields_mask, bm);
  }
 oddinstr();
 do <"wrote">
  { if (low_bits)
     { low_bits = simplify_expr(low_bits);
       switch (low_bits->type)
	{ case X_CONST:
	     switch (low_bits->u.val.t)
	      { case VT_I:
		   instr_fields_val |= (*low_finalize)(low_bits->u.val.u.i,low_nbits) & ((1U << low_nbits) - 1);
		   instr_fields_mask |= bm;
		   break;
		case VT_F:
		   errmsg("instruction field has floating-point type");
		   break <"wrote">;
		default:
		   panic("assemble_instruction low_bits X_CONST: type bad");
		   break;
	      }
	     break;
	  default:
	     lp = malloc(sizeof(LOWPATCH));
	     lp->loc = dot();
	     lp->bits = low_nbits;
	     lp->rest = (instr_base_val & instr_base_mask) |
			  (instr_extra_val & instr_extra_mask) |
			  (instr_fields_val & instr_fields_mask);
	     lp->finalize = low_finalize;
	     add_patchups(low_bits,&low_patch_fixup,lp);
	     low_bits = 0;
	     record_write(dot(),2,0);
	     break <"wrote">;
	}
     }
    setmem( dot(),
	    (instr_base_val & instr_base_mask) |
	      (instr_extra_val & instr_extra_mask) |
	      (instr_fields_val & instr_fields_mask),
	    2 );
  } while (0);
 incdot(2);
}

void branch_displacement(int bits)
{
 low_bits = simplify_expr(expr_make(X_DYAD,parsed_expr(),DOP_SUB,expr_make(X_CONST,VT_I,(SVAL)(dot()+4))));
 low_nbits = bits;
 low_finalize = &finalize_branch_displacement;
}

void expr_offset(int bits)
{
 low_bits = parsed_expr();
 low_nbits = bits;
 low_finalize = &finalize_offset;
 offset_shift_bits = 0;
}

void offset_shift(int bits)
{
 offset_shift_bits = bits;
}

void fsize_is_0(void)
{
 *f_which = FS_0;
}

void fsize_is_1(void)
{
 *f_which = FS_1;
}

void fsize_is_any(void)
{
 *f_which = FS_ANY;
}

void fsize_is_pr(void)
{
 f_which = &f_pr;
}

void fsize_is_sz(void)
{
 f_which = &f_sz;
}

void change_sz(void)
{
 switch (f_sz)
  { case FS_0:   f_sz = FS_1; break;
    case FS_1:   f_sz = FS_0; break;
    case FS_ANY:              break;
    default: panic("change_sz: size bad"); break;
  }
}

void immediate_value(void)
{
 low_bits = parsed_expr();
 low_nbits = 8;
 low_finalize = &finalize_immediate;
}

void opc_base(unsigned short int val, unsigned short int mask)
{
 if (instr_base_mask) panic("opc_base: base mask set");
 instr_base_val = val;
 instr_base_mask = mask;
}

void opc_extra(unsigned short int val, unsigned short int mask)
{
 if (instr_extra_mask & mask) panic("opc_extra: mask overlap");
 instr_extra_val |= val & mask;
 instr_extra_mask |= mask;
}

void pr_mustbe(int val)
{
 if (val)
  { if (f_pr == FS_0) errmsg("This instruction requires PR=1");
  }
 else
  { if (f_pr == FS_1) errmsg("This instruction requires PR=0");
  }
}

void sz_mustbe(int val)
{
 if (val)
  { if (f_sz == FS_0) errmsg("This instruction requires SZ=1");
  }
 else
  { if (f_sz == FS_1) errmsg("This instruction requires SZ=0");
  }
}

void set_register_params(const char *prefix, unsigned int bits, int shift, unsigned int xval, unsigned int xmask)
{
 reg_prefix = prefix;
 reg_bits = bits;
 reg_shift = shift;
 reg_xval = xval;
 reg_xmask = xmask;
}

int register_name(const char *name)
{
 int pl;
 char *ep;
 unsigned long int v;

 pl = strlen(reg_prefix);
 if (strncmp(name,reg_prefix,pl)) return(0);
 v = strtoul(name+pl,&ep,10);
 if (ep == name+pl) return(0);
 if (*ep) return(0);
 if (v & ~reg_bits) return(0);
 if (instr_fields_mask & ((reg_bits << reg_shift) | reg_xmask)) panic("register_name: mask overlap");
 instr_fields_val |= ((v & reg_bits) << reg_shift) | reg_xval;
 instr_fields_mask |= (reg_bits << reg_shift) | reg_xmask;
 return(1);
}

int register_prefix(const char *name)
{
 return(!strncmp(name,reg_prefix,strlen(reg_prefix)));
}

int expr_names_register(void)
{
 EXPR *e;
 int rv;

 rv = 0;
 e = parsed_expr();
 switch (e->type)
  { case X_CONST:
       switch (e->u.val.t)
	{ case VT_I:
	     if ((e->u.val.u.i >= 0) && (e->u.val.u.i <= reg_bits))
	      { rv = 1;
		if (instr_fields_mask & ((reg_bits << reg_shift) | reg_xmask)) panic("expr_names_register X_CONST VT_I: mask overlap");
		instr_fields_val |= ((e->u.val.u.i & reg_bits) << reg_shift) | reg_xval;
		instr_fields_mask |= (reg_bits << reg_shift) | reg_xmask;
	      }
	     break;
	  case VT_F:
	     errmsg("r{} with a floating-point value");
	     break;
	  default:
	     panic("expr_names_register X_CONST: type bad");
	     break;
	}
       break;
    default:
       errmsg("r{} with a nonconstant value");
       break;
  }
 expr_free(e);
 return(rv);
}

void pcrel_w(unsigned short int base, unsigned short int mask)
{
 opc_base(base,mask);
 low_bits = simplify_expr(expr_make(X_DYAD,parsed_expr(),DOP_SUB,expr_make(X_CONST,VT_I,(SVAL)(dot()+4))));
 low_nbits = 8;
 low_finalize = &finalize_pcrel_w;
}

void pcrel_l(unsigned short int base, unsigned short int mask)
{
 opc_base(base,mask);
 low_bits = simplify_expr(expr_make(X_DYAD,parsed_expr(),DOP_SUB,expr_make(X_CONST,VT_I,(SVAL)((dot()&~(LOC)3)+4))));
 low_nbits = 8;
 low_finalize = &finalize_pcrel_l;
}

int in_macro_def(void)
{
 return(macro_defining);
}

static MACRO *find_macro(const char *name)
{
 MACRO *m;

 for (m=macros;m;m=m->flink) if (!strcmp(m->name,name)) return(m);
 return(m);
}

static void undef_macro(MACRO *m)
{
 MLINE *l;
 int i;

 if (m->flink) m->flink->blink = m->blink;
 if (m->blink) m->blink->flink = m->flink; else macros = m->flink;
 free(m->name);
 while (m->text)
  { l = m->text;
    m->text = l->link;
    free(l->file);
    for (i=l->nsubs-1;i>=0;i--)
     { switch (l->subs[i].type)
	{ case MLS_TEXT:
	     free(l->subs[i].text);
	     break;
	  default:
	     break;
	}
     }
    free(l->subs);
    free(l);
  }
 free(m);
}

void undefine_macro(void)
{
 MACRO *m;

 m = find_macro(macro_name);
 if (! m) return;
 undef_macro(m);
}

void set_macro_name(const char *n)
{
 free(macro_name);
 macro_name = strdup(n);
 macro_locals_at = -1;
 macro_args_n = 0;
}

void set_macro_arg(const char *n)
{
 int i;
 MACARG *a;

 if (macro_args_n >= macro_args_a)
  { i = macro_args_a;
    macro_args_a = macro_args_n + 8;
    macro_args = realloc(macro_args,macro_args_a*sizeof(*macro_args));
    for (;i<macro_args_a;i++) macro_args[i].name = 0;
  }
 for (i=macro_args_n-1;i>=0;i--)
  { if (! strcmp(n,macro_args[i].name))
     { if (macro_args[i].local)
	{ errmsg("duplicate local `%s'",n);
	}
       else if (macro_locals_at >= 0)
	{ errmsg("local `%s' hides arg",n);
	}
       else
	{ errmsg("duplicate macro arg `%s'",n);
	}
     }
  }
 a = &macro_args[macro_args_n++];
 free(a->name);
 a->name = strdup(n);
 a->namelen = strlen(n);
 a->local = (macro_locals_at >= 0);
}

void macro_locals(void)
{
 macro_locals_at = macro_args_n;
}

void start_macro_def(void)
{
 MACRO *m;

 m = find_macro(macro_name);
 if (m)
  { errmsg("redefinition of macro `%s'",macro_name);
    undef_macro(m);
  }
 m = malloc(sizeof(MACRO));
 m->name = strdup(macro_name);
 m->nargs = (macro_locals_at < 0) ? macro_args_n : macro_locals_at;
 m->nlocals = (macro_locals_at < 0) ? 0 : (macro_args_n - macro_locals_at);
 m->text = 0;
 m->flink = macros;
 m->blink = 0;
 if (m->flink) m->flink->blink = m;
 macros = m;
 if (macro_defining) panic("start_macro_def: already defining");
 macro_defining = 1;
}

void push_macro_depth(void)
{
 macro_defining ++;
}

void pop_macro_depth(void)
{
 MLINE *lines;
 MLINE *ml;

 macro_defining --;
 if (macro_defining < 0) panic("pop_macro_depth: stack underflow");
 if (macro_defining > 0) return;
 lines = macros->text;
 macros->text = 0;
 while (lines)
  { ml = lines;
    lines = ml->link;
    ml->link = macros->text;
    macros->text = ml;
  }
}

static void save_mlsub(int *np, int *ap, MLSUB **vp, MLSTYPE t, ...)
{
 va_list argp;
 MLSUB *s;

 if (*np >= *ap) *vp = realloc(*vp,(*ap=4+*np)*sizeof(**vp));
 s = &vp[0][np[0]++];
 s->type = t;
 va_start(argp,t);
 switch (t)
  { case MLS_TEXT:
	{ char *ptr;
	  int len;
	  ptr = va_arg(argp,char *);
	  len = va_arg(argp,int);
	  s->text = malloc(len+1);
	  bcopy(ptr,s->text,len);
	  s->text[len] = '\0';
	}
       break;
    case MLS_ARG:
       s->arg = va_arg(argp,int);
       break;
    case MLS_QARG:
       s->arg = va_arg(argp,int);
       break;
    case MLS_QSTR:
       s->arg = va_arg(argp,int);
       break;
    case MLS_LOCAL:
       s->local = va_arg(argp,int);
       break;
    default:
       panic("save_mlsub: type bad");
       break;
  }
 va_end(argp);
}

#if 0
static void dump_mline(MLINE *l)
{
 int i;
 MLSUB *s;

 errmsg("macro line %p, nsubs %d:",(void *)l,l->nsubs);
 for (i=0;i<l->nsubs;i++)
  { s = &l->subs[i];
    switch (s->type)
     { case MLS_TEXT:
	  errmsg("  %d: TEXT %s",i,s->text);
	  break;
       case MLS_ARG:
	  errmsg("  %d: ARG %d",i,s->arg);
	  break;
       case MLS_QARG:
	  errmsg("  %d: QARG %d",i,s->arg);
	  break;
       case MLS_QSTR:
	  errmsg("  %d: QSTR %d",i,s->arg);
	  break;
       case MLS_LOCAL:
	  errmsg("  %d: LOCAL %d",i,s->local);
	  break;
       default:
	  panic("dump_mline: type bad");
	  break;
     }
  }
}
#endif

void save_macro_line(void)
{
 int i;
 int i0;
 int j;
 MLINE *l;
 static MLSUB *sv = 0;
 static int sa = 0;
 int sn;
 int ni;
 int ei;
 MLSTYPE argt;
 int cond;

 sn = 0;
 i0 = -1;
 for <"crack"> (i=0;cur_line[i];i++)
  { if (cur_line[i] != '$')
     { if (i0 < 0) i0 = i;
       continue;
     }
    if (cur_line[i+1] == '(')
     { if (cur_line[i+2] == '"')
	{ ni = i + 3;
	  argt = MLS_QSTR;
	}
       else if (cur_line[i+2] == '(')
	{ ni = i + 3;
	  argt = MLS_QARG;
	}
       else
	{ ni = i + 2;
	  argt = MLS_ARG;
	}
       for (j=macro_args_n-1;j>=0;j--)
	{ if (! strncmp(macro_args[j].name,cur_line+ni,macro_args[j].namelen))
	   { switch (argt)
	      { case MLS_ARG:
		   ei = ni + macro_args[j].namelen;
		   cond = (cur_line[ei] == ')');
		   break;
		case MLS_QARG:
		   ei = ni + macro_args[j].namelen + 1;
		   cond = (cur_line[ei-1] == ')') && (cur_line[ei] == ')');
		   break;
		case MLS_QSTR:
		   ei = ni + macro_args[j].namelen + 1;
		   cond = (cur_line[ei-1] == '"') && (cur_line[ei] == ')');
		   break;
		default:
		   panic("save_macro_line arg: type bad");
		   break;
	      }
	     if (cond)
	      { if (i0 >= 0)
		 { save_mlsub(&sn,&sa,&sv,MLS_TEXT,cur_line+i0,i-i0);
		   i0 = -1;
		 }
		if (macro_args[j].local)
		 { save_mlsub(&sn,&sa,&sv,MLS_LOCAL,j-macro_locals_at);
		 }
		else
		 { save_mlsub(&sn,&sa,&sv,argt,j);
		 }
		i = ei;
		continue <"crack">;
	      }
	   }
	}
     }
  }
 if (i0 >= 0) save_mlsub(&sn,&sa,&sv,MLS_TEXT,cur_line+i0,i-i0);
 l = malloc(sizeof(MLINE));
 l->file = strdup(fl.file);
 l->line = fl.line;
 l->nsubs = sn;
 l->subs = malloc(sn*sizeof(MLSUB));
 bcopy(sv,l->subs,sn*sizeof(MLSUB));
 l->link = macros->text;
 macros->text = l;
}

int name_for_call(const char *name)
{
 xmacro = find_macro(name);
 return(!!xmacro);
}

static char *gen_local(void)
{
 char *b;
 static int n = 0;

 asprintf(&b,"__MACLCL_%d",n++);
 return(b);
}

static int mx_r(void *mxv, char *buf, int len)
{
 MACX *mx;
 MXL *l;
 char *buf0;

 mx = mxv;
 l = mx->lines;
 buf0 = buf;
 for (;len>0;len--)
  { if (! l) break;
    if (mx->clx >= l->len)
     { *buf++ = '\n';
       free(istack->name);
       istack->name = strdup(l->file);
       istack->curline = l->line - 1;
       istack->flags = ISF_EXPN;
       mx->lines = l->link;
       free(l->text);
       free(l->file);
       free(l);
       l = mx->lines;
       mx->clx = 0;
       break;
     }
    else
     { *buf++ = l->text[mx->clx++];
     }
  }
 return(buf-buf0);
}

static int mx_c(void *mxv)
{
 MACX *mx;
 MXL *l;

 mx = mxv;
 while (mx->lines)
  { l = mx->lines;
    mx->lines = l->link;
    free(l->text);
    free(l->file);
    free(l);
  }
 free(mx);
 return(0);
}

/* keep this in sync with parse.fsm's string parser */
#define DELIMS "\"\"//!!::..@@?""?<>[]()"

static void gen_string_quotes(const char *buf, int len, void (*fn)(char))
{
 const char *delims;
 int i;
 const char *dbest;
 int l;
 const char *dp;

 for (delims=DELIMS;*delims;delims+=2)
  { if (! memchr(buf,delims[1],len))
     { (*fn)(delims[0]);
       for (i=0;i<len;i++) (*fn)(buf[i]);
       (*fn)(delims[1]);
       return;
     }
  }
 while (len > 0)
  { l = -1;
    for (delims="\"\"//!!::..@@?""?<>[]()";*delims;delims+=2)
     { dp = memchr(buf,delims[1],len);
       if (! dp) dp = buf + len;
       if (dp-buf > l)
	{ l = dp - buf;
	  dbest = delims;
	}
     }
    (*fn)(dbest[0]);
    for (i=0;i<l;i++) (*fn)(*buf++);
    (*fn)(dbest[1]);
    len -= l;
  }
}

/*
 * Macro argument rules:
 *
 * Arguments are separated by commas; leading and trailing whitespace
 *  is stripped from each argument.  However, any character in an
 *  argument may be quoted with a \.  Such a character acts as though
 *  it had no special semantics even if it is a character such as ,
 *  that normally does.
 *
 * Args expanded with $(name) are simply textually substituted.  Args
 *  expanded with $((name)) have backslashes inserted before each
 *  backslash, bracket, or comma, and before the first and last
 *  characters if they're whitespace.  (This is not a useful thing to
 *  do unless the expansion is being used as a macro argument.)  Args
 *  expanded with $("name") are escaped in ways making them suitable
 *  for use as argument to .ascii or relatives.
 *
 * If there are too many actuals, the extras are dropped with a
 *  message; if there are too few, zero-length strings are silently
 *  supplied for the missing ones.
 */
void do_macro_call(void)
{
 char *argstr;
 int argx[xmacro->nargs];
 int argl[xmacro->nargs];
 char *locals[xmacro->nlocals];
 int argno;
 int x;
 static char *argbuf = 0;
 static int arga = 0;
 int argn;
 int y;
 int lastns;
 int q;
 MLINE *xl;
 static char *expbuf = 0;
 static int expa = 0;
 int expn;
 int sx;
 MLSUB *s;
 ISRC *is;
 MACX *mx;
 MXL *mxl;
 MXL **xlt;

 void argsave(char c)
  { if (argn >= arga) argbuf = realloc(argbuf,arga=argn+16);
    if (y < 0) y = argn;
    argbuf[argn++] = c;
  }

 void endarg(void)
  { if (argno == xmacro->nargs)
     { errmsg("too many arguments to macro `%s'",xmacro->name);
     }
    if (argno < xmacro->nargs)
     { if (lastns >= 0)
	{ argx[argno] = y;
	  argl[argno] = lastns - y;
	}
       else
	{ argx[argno] = 0;
	  argl[argno] = 0;
	}
     }
    argno ++;
    y = -1;
    lastns = -1;
  }

 void expsave(char c)
  { if (expn >= expa) expbuf = realloc(expbuf,expa=expn+16);
    expbuf[expn++] = c;
  }

 argstr = parselinerest();
 argno = 0;
 x = 0;
 y = -1;
 argn = 0;
 lastns = -1;
 q = 0;
 while <"args"> (1)
  { if ((y < 0) && Cisspace(argstr[x]))
     { x ++;
       continue;
     }
    if (! argstr[x]) break;
    if (q)
     { q = 0;
       argsave(argstr[x]);
       lastns = argn;
     }
    else
     { switch (argstr[x])
	{ case ';':
	     break <"args">;
	     break;
	  case ',':
	     endarg();
	     break;
	  case '\\':
	     q = 1;
	     break;
	  default:
	     argsave(argstr[x]);
	     if (! Cisspace(argstr[x])) lastns = argn;
	     break;
	}
     }
    x ++;
  }
 if ((y >= 0) || (argn > 0) || xmacro->nargs) endarg();
 while (argno < xmacro->nargs)
  { argx[argno] = 0;
    argl[argno] = 0;
    argno ++;
  }
 for (x=xmacro->nlocals-1;x>=0;x--) locals[x] = 0;
 mx = malloc(sizeof(MACX));
 xlt = &mx->lines;
 for (xl=xmacro->text;xl;xl=xl->link)
  { expn = 0;
    for (sx=0;sx<xl->nsubs;sx++)
     { s = &xl->subs[sx];
       switch (s->type)
	{ case MLS_TEXT:
	     for (x=0;s->text[x];x++) expsave(s->text[x]);
	     break;
	  case MLS_ARG:
	     y = s->arg;
	     if ((y < 0) || (y >= xmacro->nargs)) panic("do_macro_call expanding ARG: argno bad");
	     for (x=0;x<argl[y];x++) expsave(argbuf[argx[y]+x]);
	     break;
	  case MLS_QARG:
	     y = s->arg;
	     if ((y < 0) || (y >= xmacro->nargs)) panic("do_macro_call expanding QARG: argno bad");
	     for (x=0;x<argl[y];x++)
	      { char c;
		c = argbuf[argx[y]+x];
		switch (c)
		 { default:
		      if (Cisspace(c))
		       { if ((x == 0) || (x == argl[y]-1))
			  {
		   case '\\': case '[': case ']': case ',':
			    expsave('\\');
			  }
		       }
		      break;
		 }
		expsave(c);
	      }
	     break;
	  case MLS_QSTR:
	     y = s->arg;
	     if ((y < 0) || (y >= xmacro->nargs)) panic("do_macro_call expanding QSTR: argno bad");
	     gen_string_quotes(argbuf+argx[y],argl[y],&expsave);
	     break;
	  case MLS_LOCAL:
	     y = s->local;
	     if ((y < 0) || (y >= xmacro->nlocals)) panic("do_macro_call expanding LOCAL: argno bad");
	     if (! locals[y]) locals[y] = gen_local();
	     for (x=0;locals[y][x];x++) expsave(locals[y][x]);
	     break;
	}
     }
    mxl = malloc(sizeof(MXL));
    mxl->text = malloc(expn);
    mxl->len = expn;
    mxl->file = strdup(xl->file);
    mxl->line = xl->line;
    bcopy(expbuf,mxl->text,expn);
    *xlt = mxl;
    xlt = &mxl->link;
  }
 *xlt = 0;
 mx->clx = 0;
 is = malloc(sizeof(ISRC));
 is->name = strdup("macro expansion");
 is->curline = 0;
 is->flags = ISF_EXPN;
 is->f = funopen(mx,&mx_r,0,0,&mx_c);
 is->link = istack;
 istack = is;
 for (x=xmacro->nlocals-1;x>=0;x--) free(locals[x]);
}

static int pseudo_shift_prep(void)
{
 SVAL sc;

 oddinstr();
 low_bits = simplify_expr(low_bits);
 switch (low_bits->type)
  { case X_CONST:
       switch (low_bits->u.val.t)
	{ case VT_I:
	     break;
	  case VT_F:
	     errmsg("floating-point shift count");
	     return(1);
	     break;
	  default:
	     panic("pseudo_shift_prep X_CONST: type bad");
	     break;
	}
       break;
    default:
       errmsg("nonconstant shift count");
       return(1);
       break;
  }
 sc = low_bits->u.val.u.i;
 if ((sc < 0) || (sc > 31))
  { errmsg("shift count %"VPM"d out of range",sc);
    return(1);
  }
 return(0);
}

static int shift_instr_count(int c)
{
 if ((c < 0) || (c > 31)) panic("shift_instr_count: arg bad");
 return("\0\1\1\2\2\3\3\4\1\2\2\3\3\4\4\5\1\2\2\3\3\4\4\5\2\3\3\4\4\5\5\6"[c]);
}

static void pseudo_shl(int sc, unsigned short int s1, unsigned short int s2, unsigned short int s8, unsigned short int s16)
{
 unsigned short int v;

 v = instr_fields_val & 0x0f00;
 while (sc >= 16)
  { setmem(dot(),s16|v,2);
    incdot(2);
    sc -= 16;
  }
 while (sc >= 8)
  { setmem(dot(),s8|v,2);
    incdot(2);
    sc -= 8;
  }
 while (sc >= 2)
  { setmem(dot(),s2|v,2);
    incdot(2);
    sc -= 2;
  }
 while (sc)
  { setmem(dot(),s1|v,2);
    incdot(2);
    sc --;
  }
}

static void pseudo_shad(unsigned int sc)
{
 setmem(dot(),0xe000|((instr_fields_val&0x00f0)<<4)|(sc&0xff),2);
 incdot(2);
 setmem(dot(),0x400c|instr_fields_val,2);
 incdot(2);
}

static void pseudo_shld(unsigned int sc)
{
 setmem(dot(),0xe000|((instr_fields_val&0x00f0)<<4)|(sc&0xff),2);
 incdot(2);
 setmem(dot(),0x400d|instr_fields_val,2);
 incdot(2);
}

void pseudo_shll(void)
{
 if (pseudo_shift_prep()) return;
 if ((instr_fields_mask == 0x0f00) || (shift_instr_count(low_bits->u.val.u.i) < 3))
  { pseudo_shl(low_bits->u.val.u.i,0x4000,0x4008,0x4018,0x4028);
  }
 else
  { pseudo_shld(low_bits->u.val.u.i);
  }
}

void pseudo_shlr(void)
{
 int ic;

 if (pseudo_shift_prep()) return;
 ic = shift_instr_count(low_bits->u.val.u.i);
 if ((instr_fields_mask == 0x0f00) || (shift_instr_count(low_bits->u.val.u.i) < 3))
  { pseudo_shl(low_bits->u.val.u.i,0x4001,0x4009,0x4019,0x4029);
  }
 else
  { pseudo_shld(-(unsigned int)low_bits->u.val.u.i);
  }
}

void pseudo_shar(void)
{
 int i;

 if (pseudo_shift_prep()) return;
 if ((low_bits->u.val.u.i < 3) || (instr_fields_mask == 0x0f00))
  { for (i=low_bits->u.val.u.i;i>0;i--)
     { setmem(dot(),0x4021|(instr_fields_val&0x0f00),2);
       incdot(2);
     }
    return;
  }
 pseudo_shad(-(unsigned int)low_bits->u.val.u.i);
}

void pseudo_shxr(void)
{
 pseudo_shlr();
}

void opc_delay_slot_empty(void)
{
 instr_flags &= ~IF_DS_HAD;
}

void opc_delay_slot_illegal_if_sr(void)
{
 if ((instr_extra_val & 0x00f0) == 0x0000) opc_delay_slot_illegal();
}

void opc_delay_slot_illegal(void)
{
 instr_flags |= IF_DS_ILLEGAL;
}

void opc_delay_slot_has(void)
{
 instr_flags |= IF_DS_HAS | IF_DS_ILLEGAL;
}

static void expn_add_line(MACXF *xf)
{
 MXL *l;

 l = malloc(sizeof(MXL));
 l->text = malloc(xf->ln);
 l->len = xf->ln;
 l->file = strdup(xf->file);
 l->line = xf->line;
 if (xf->line >= 0) xf->line ++;
 bcopy(xf->lb,l->text,xf->ln);
 *xf->lt = l;
 xf->lt = &l->link;
}

static int expn_w(void *xfv, const char *buf, int len)
{
 MACXF *xf;
 int i;

 xf = xfv;
 for (i=0;i<len;i++)
  { switch (buf[i])
     { default:
	  if (xf->ln >= xf->la) xf->lb = realloc(xf->lb,xf->la=xf->ln+8);
	  xf->lb[xf->ln++] = buf[i];
	  break;
       case '\n':
	  expn_add_line(xf);
	  xf->ln = 0;
	  break;
     }
  }
 return(len);
}

static int expn_c(void *xfv)
{
 MACXF *xf;
 MACX *mx;
 ISRC *is;

 xf = xfv;
 if (xf->ln > 0) expn_add_line(xf);
 *xf->lt = 0;
 mx = xf->mx;
 mx->clx = 0;
 is = malloc(sizeof(ISRC));
 is->name = strdup("expansion");
 is->curline = 0;
 is->flags = ISF_EXPN;
 is->f = funopen(mx,&mx_r,0,0,&mx_c);
 is->link = istack;
 istack = is;
 free(xf->lb);
 free(xf->file);
 free(xf);
 return(0);
}

static FILE *fopen_expansion(const char *file, int line)
{
 MACX *mx;
 MACXF *xf;
 FILE *f;

 mx = malloc(sizeof(MACX));
 xf = malloc(sizeof(MACXF));
 if (!mx || !xf)
  { free(mx);
    free(xf);
    return(0);
  }
 xf->mx = mx;
 xf->lb = 0;
 xf->la = 0;
 xf->ln = 0;
 xf->lt = &mx->lines;
 xf->file = strdup(file);
 xf->line = line;
 f = funopen(xf,0,&expn_w,0,&expn_c);
 if (! f)
  { free(mx);
    free(xf);
  }
 return(f);
}

void pseudo_set_setup(int sz, const char *n)
{
 pseudo_set_size = sz;
 pseudo_set_name = n;
}

/*
 * In full generality, this gets *really* complicated: if we had a
 *  syntax to say "clobbering MACH/MACL is OK", we might even consider
 *  factoring and using multiplies (which gets even harder if you allow
 *  doing a 32×32->64 multiply and using other than the low 32 bits of
 *  the product).  For complicated ways of building numbers we also
 *  might want a way to declare more than one temporary register.  But
 *  for the moment, we cheap out on most of this and just do some
 *  quick-&-dirty heuristics.
 *
 * Any value can be done in not more than six words:
 *		mov.l	1f,rN
 *		bra	2f
 *		 nop
 *		(alignment padding)
 *	1:	.long	value
 *
 * This really should be restructured to be more recursive, so that,
 *  eg, 0xf3ffff00 can be constructed as
 *	mov	#0x0d,rN
 *	shll16	rN
 *	neg	rN,rN
 *	shll8	rN
 *  by recursing to full generality inside the maybe-shift code.
 *  That's getting pretty close to dynamic programming; that's probably
 *  where this should end up.
 */
void pseudo_set_inline(void)
{
 SVAL v;
 unsigned int i;
 int n;
 int m;
 char *inst[6];
 int ia[7];
 char *best[6];
 int beste;
 int bestn;
 int j;
 UVAL mask;
 FILE *xf;

 auto int saveinst(int, int, const char *, ...)
	__attribute__((__format__(__printf__,3,4)));
 int saveinst(int i, int w, const char *fmt, ...)
  { va_list ap;
    char *s;
    if ((i < 0) || (i >= 6)) return(-1);
    va_start(ap,fmt);
    vasprintf(&s,fmt,ap);
    va_end(ap);
    free(inst[i]);
    inst[i] = s;
    ia[i+1] = ia[i] + w;
    return(i+1);
  }

 int gen_trivial(int i, unsigned int v, unsigned int m, int r)
  { unsigned int uv;
    int sv;
    uv = (v & 0x80) ? (v | 0xffffff00) : (v & 0x000000ff);
    if ((uv ^ v) & m) return(-1);
    sv = (v & 0x80) ? (int)(v&0xff) - (int)0x100 : (v&0xff);
    return(saveinst(i,2,"\tmov\t#%d,r%d",sv,r));
  }

 int gen_mov_shift8(int i, unsigned int v, int r)
  { int j;
    if (! (v & 0x000000ff))
     { j = gen_trivial(i,v>>8,0x00ffffff,r);
       if (j >= 0) return(saveinst(j,2,"\tshll8\tr%d",r));
     }
    if (! (v & 0x0000ffff))
     { j = gen_trivial(i,v>>16,0x0000ffff,r);
       if (j >= 0) return(saveinst(j,2,"\tshll16\tr%d",r));
     }
    if (! (v & 0x00ffffff))
     { j = gen_trivial(i,v>>24,0x000000ff,r);
       if (j >= 0)
	{ j = saveinst(j,2,"\tshll8\tr%d",r);
	  if (j >= 0) return(saveinst(j,2,"\tshll16\tr%d",r));
	}
     }
    return(-1);
  }

 int gen_mov_shift_aux(int i, unsigned int n, int r, int rx)
  { int j;
    int k;
    for (k=1;k<32;k++)
     { j = gen_trivial(i,n>>k,0xffffffffU>>k,r);
       if (j >= 0)
	{ j = saveinst(j,2,"\tmov\t#%d,r%d",k,rx);
	  if (j >= 0) return(saveinst(j,2,"\tshld\tr%d,r%d",rx,r));
	}
     }
    return(-1);
  }

 int gen_shift_add(int i, unsigned int v, unsigned int m, int r)
  { int j;
    unsigned char lb;
    j = gen_trivial(i,v,m,r);
    if (j >= 0) return(j);
    lb = v & 0xff;
    j = (lb & 0x80)
	? gen_shift_add(i,(v>>8)+1,m>>8,r)
	: gen_shift_add(i,v>>8,m>>8,r);
    if ((j > 0) && !strncmp(inst[j-1],"\tshll8\t",7))
     { free(inst[j-1]);
       asprintf(&inst[j-1],"\tshll16\tr%d",r);
     }
    else
     { j = saveinst(j,2,"\tshll8\tr%d",r);
     }
    if (lb) j = saveinst(j,2,"\tadd\t#%d,r%d",(lb&0x80)?(int)lb-(int)0x100:(int)lb,r);
    return(j);
  }

 int gen_shift_or(int i, unsigned int v, unsigned int m)
  { int j;
    unsigned char lb;
    j = gen_trivial(i,v,m,0);
    if (j >= 0) return(j);
    lb = v & 0xff;
    j = gen_shift_or(i,v>>8,m>>8);
    if ((j > 0) && !strncmp(inst[j-1],"\tshll8\t",7))
     { free(inst[j-1]);
       inst[j-1] = strdup("\tshll16\tr0");
     }
    else
     { j = saveinst(j,2,"\tshll8\tr0");
     }
    if (lb) j = saveinst(j,2,"\tor\t#%d,r0",lb);
    return(j);
  }

 int gen_literal(int i, unsigned int v, int sz, int r)
  { int j;
    switch (sz)
     { case 1:
	  return(-1); /* let gen_trivial do it */
	  break;
       case 2:
	  return(-1); /* shift-and-add can always do better */
	  break;
       case 4:
	  if (dot() & 2)
	   { j = saveinst(i,2,"\tmov.l\t0x%"LPM"x,r%d",dot()+6,r);
	     j = saveinst(j,2,"\tbra\t0x%"LPM"x",dot()+10);
	     j = saveinst(j,2,"\tnop");
	     j = saveinst(j,0,"\t.align\t4");
	     j = saveinst(j,4,"\t.long\t0x%x",v&0xffffffffU);
	   }
	  else
	   { j = saveinst(i,2,"\tmov.l\t0x%"LPM"x,r%d",dot()+8,r);
	     j = saveinst(j,2,"\tbra\t0x%"LPM"x",dot()+12);
	     j = saveinst(j,2,"\tnop");
	     j = saveinst(j,2,"\t.align\t4");
	     j = saveinst(j,4,"\t.long\t0x%x",v&0xffffffffU);
	   }
	  return(j);
	  break;
     }
    panic("pseudo_set_inline/gen_literal: fell through");
  }

 void maybesave(int i)
  { int j;
    if ( (i >= 0) &&
	 ( (beste < 0) ||
	   (ia[i] < beste) ||
	   ((ia[i] < beste) && (i < bestn)) ) )
     { beste = ia[i];
       for (j=i-1;j>=0;j--)
	{ free(best[j]);
	  best[j] = inst[j];
	  inst[j] = 0;
	}
       beste = ia[i];
       bestn = i;
     }
  }

 oddinstr();
 delay_slot_warn();
 low_bits = simplify_expr(low_bits);
 switch (low_bits->type)
  { case X_CONST:
       switch (low_bits->u.val.t)
	{ case VT_I:
	     v = low_bits->u.val.u.i;
	     break;
	  case VT_F:
	     if (pseudo_set_size == 4)
	      { v = fval_to_ieee(low_bits->u.val.u.f,4,"%s value",pseudo_set_name);
	      }
	     else
	      { errmsg("floating-point %s value",pseudo_set_name);
		return;
	      }
	     break;
	  default:
	     panic("pseudo_set_inline X_CONST: type bad");
	     break;
	}
       break;
    default:
       errmsg("nonconstant %s value",pseudo_set_name);
       return;
       break;
  }
 mask = (((UVAL)1) << (pseudo_set_size*8)) - 1;
 if ( (v < -(SVAL)(mask&~(mask>>1))) ||
      (v > (SVAL)mask) )
  { errmsg("%s value %"VPM"d out of range",pseudo_set_name,v);
    return;
  }
 n = (instr_fields_val >> 8) & 0xf;
 m = (instr_fields_mask & 0x00f0) ? ((instr_fields_val >> 4) & 0xf) : -1;
 i = v & mask;
 ia[0] = 0;
 beste = -1;
 for (j=6-1;j>=0;j--)
  { inst[j] = 0;
    best[j] = 0;
  }
 maybesave(gen_trivial(0,i,mask,n));
 /*
  * If all set bits fall in the same byte, whose high bit is clear, or
  *  if the complement or negation satisfies that condition.
  */
 maybesave(gen_mov_shift8(0,i,n));
 j = gen_mov_shift8(0,mask^i,n);
 if (j >= 0) maybesave(saveinst(j,2,"\tnot\tr%d,r%d",n,n));
 j = gen_mov_shift8(0,mask&-i,n);
 if (j >= 0) maybesave(saveinst(j,2,"\tneg\tr%d,r%d",n,n));
 /*
  * If we have an auxiliary register, see if the number (or its
  *  complement or negation) can be expressed using
  *	mov	#imm,rN
  *	mov	#x,rM
  *	shld	rM,rN
  */
 if (m >= 0)
  { maybesave(gen_mov_shift_aux(0,i,n,m));
    j = gen_mov_shift_aux(0,mask^i,n,m);
    if (j >= 0) maybesave(saveinst(j,2,"\tnot\t%d,%d",n,n));
    j = gen_mov_shift_aux(0,mask&-i,n,m);
    if (j >= 0) maybesave(saveinst(j,2,"\tneg\t%d,%d",n,n));
  }
 /*
  * Shift-and-add.
  */
 maybesave(gen_shift_add(0,i,mask,n));
 /*
  * Shift-and-or.
  */
 if (n == 0) maybesave(gen_shift_or(0,i,mask));
 /*
  * Literal data.
  */
 maybesave(gen_literal(0,i,pseudo_set_size,n));
 /*
  * We should have _something_ by now.
  */
 if (beste < 0) panic("pseudo_set_inline: have nothing");
 xf = fopen_expansion(pseudo_set_name,-1);
 for (j=0;j<bestn;j++) fprintf(xf,"%s\n",best[j]);
 fclose(xf);
}

void pseudo_set_separate(void)
{
 SVAL v;
 unsigned int i;
 int n;
 SETCONST *sc;
 UVAL mask;

 oddinstr();
 delay_slot_warn();
 low_bits = simplify_expr(low_bits);
 do <"done">
  { mask = (((UVAL)1) << (pseudo_set_size*8)) - 1;
    n = (instr_fields_val >> 8) & 0xf;
    switch (low_bits->type)
     { case X_CONST:
	  switch (low_bits->u.val.t)
	   { case VT_I:
		v = low_bits->u.val.u.i;
		if ( (v < -(SVAL)(mask&~(mask>>1))) ||
		     (v > (SVAL)mask) )
		 { errmsg("%s value %"VPM"d out of range",pseudo_set_name,v);
		   return;
		 }
		i = v & mask;
		break;
	     case VT_F:
		switch (pseudo_set_size)
		 { case 4:
		      v = fval_to_ieee(low_bits->u.val.u.f,4,"SETS.L value");
		      i = v & (UVAL)0xffffffffU;
		      break;
		   default:
		      errmsg("floating-point %s value",pseudo_set_name);
		      return;
		      break;
		 }
		break;
	     default:
		panic("pseudo_set_separate X_CONST: type bad");
		break;
	   }
	  break;
       default:
	  i = mask >> 1; /* dummy value for logic below */
	  break;
     }
    if ((i & 0x80U) ? ((i|~mask) >= -(UVAL)128) : (i <= 127))
     { setmem(dot(),0xe000|(n<<8)|(i&0xff),2);
       break <"done">;
     }
    sc = malloc(sizeof(SETCONST));
    sc->opname = pseudo_set_name;
    sc->file = strdup(fl.file);
    sc->line = fl.line;
    sc->loc = dot();
    sc->reg = n;
    switch (pseudo_set_size)
     { case 2:
	  sc->kind = SCK_WORD;
	  break;
       case 4:
	  sc->kind = ((i & 0x8000U) ? (i >= 0xffff8000U) : (i <= 0x00007fffU)) ? SCK_WLONG : SCK_LONG;
	  break;
       default:
	  panic("pseudo_set_separate: size bad");
	  break;
     }
    sc->val = low_bits;
    low_bits = 0;
    sc->link = set_constants;
    set_constants = sc;
    record_write(dot(),2,0);
  } while (0);
 incdot(2);
}

static SETCONST *sort_setconst(SETCONST *list)
{
 SETCONST *a;
 SETCONST *b;
 SETCONST *t;
 SETCONST **lp;

 if (!list || !list->link) return(list);
 a = 0;
 b = 0;
 while (list)
  { t = list;
    list = t->link;
    t->link = a;
    a = b;
    b = t;
  }
 a = sort_setconst(a);
 b = sort_setconst(b);
 lp = &list;
 while (a || b)
  { if (!b || (a && (a->loc < b->loc)))
     { t = a;
       a = a->link;
     }
    else
     { t = b;
       b = b->link;
     }
    *lp = t;
    lp = &t->link;
  }
 *lp = 0;
 return(list);
}

static void check_setconst_word(SETCONST *sc)
{
 switch (sc->val->type)
  { case X_CONST:
       switch (sc->val->u.val.t)
	{ case VT_I:
	     if ( (sc->val->u.val.u.i < -(SVAL)(UVAL)0x8000) ||
		  (sc->val->u.val.u.i > (SVAL)(UVAL)0xffff) )
	      { errmsg("%s value %"VPM"d out of range",sc->opname,sc->val->u.val.u.i);
	      }
	     break;
	  case VT_F:
	     errmsg("floating-point %s value",sc->opname);
	     expr_free(sc->val);
	     sc->val = expr_make(X_CONST,VT_I,(SVAL)0);
	     break;
	  default:
	     panic("check_setconst_word X_CONST: type bad");
	     break;
	}
       break;
    default:
       panic("check_setconst_word: type bad");
       break;
  }
 if (sc->val->u.val.u.i < 0) sc->val->u.val.u.i += (SVAL)(UVAL)0x10000;
}

static void check_setconst_long(SETCONST *sc)
{
 UVAL v;

 switch (sc->val->type)
  { case X_CONST:
       switch (sc->val->u.val.t)
	{ case VT_I:
	     if ( (sc->val->u.val.u.i < -(SVAL)(UVAL)0x80000000) ||
		  (sc->val->u.val.u.i > (SVAL)(UVAL)0xffffffff) )
	      { errmsg("%s value %"VPM"d out of range",sc->opname,sc->val->u.val.u.i);
	      }
	     break;
	  case VT_F:
	     v = fval_to_ieee(sc->val->u.val.u.f,4,"%s value",sc->opname);
	     expr_free(sc->val);
	     sc->val = expr_make(X_CONST,VT_I,(SVAL)v);
	     break;
	  default:
	     panic("check_setconst_long X_CONST: type bad");
	     break;
	}
       break;
    default:
       panic("check_setconst_long: type bad");
       break;
  }
 if (sc->val->u.val.u.i < 0) sc->val->u.val.u.i += (SVAL)(UVAL)0x100000000ULL;
}

static void check_setconst_wlong(SETCONST *sc)
{
 if ( (sc->val->type != X_CONST) ||
      (sc->val->u.val.t != VT_I) ||
      (sc->val->u.val.u.i < -(SVAL)(UVAL)0x8000) ||
      (sc->val->u.val.u.i > (SVAL)(UVAL)0xffff) ) panic("check_setconst_wlong: val bad");
 if (sc->val->u.val.u.i < 0) sc->val->u.val.u.i += (SVAL)(UVAL)0x10000;
}

static void collapse_consts(SETCONST *l, void (*chk)(SETCONST *v))
{
 SETCONST *t;

 for (t=l;t;t=t->link)
  { switch (t->val->type)
     { default:
	  t->val = simplify_expr(t->val);
	  break;
       case X_CONST:
	  break;
     }
    switch (t->val->type)
     { default:
	  break;
       case X_CONST:
	  (*chk)(t);
	  break;
     }
  }
 for (;l;l=l->link)
  { if (l->kind == SCK_REF) continue;
    switch (l->val->type)
     { case X_CONST:
	  switch (l->val->u.val.t)
	   { case VT_I:
		break;
	     default:
		panic("collapse_consts X_CONST: type bad");
		break;
	   }
	  break;
       default:
	  continue;
	  break;
     }
    for (t=l->link;t;t=t->link)
     { if (t->kind == SCK_REF) continue;
       if ( (t->val->type != X_CONST) ||
	    (t->val->u.val.t != VT_I) ||
	    (t->val->u.val.u.i != l->val->u.val.u.i) ) continue;
       expr_free(t->val);
       t->kind = SCK_REF;
       t->ref = l;
     }
  }
}

/*
 * See the comment header on pseudo_set_constants, below, for more on
 *  this function.  This is responsible for figuring out the shuffle
 *  order outlined there.
 *
 * This is passed two lists and a location.  It tries to find a shuffle
 *  for the lists starting at the location.  If it succeeds, it returns
 *  the shuffled SETCONST list, with all elements' at values set; if it
 *  fails, it returns failconst and leaves the lists as they were on
 *  entry (possibly excepting their at values).  Note that nil is a
 *  success return.  On failure, failconst->ref is set to a failing
 *  list member, for error reporting.
 *
 * We never recurse without advancing something (usually one of the
 *  list pointers), thereby ensuring recursion is bounded.
 */
static SETCONST *gen_merge(LOC at, SETCONST *w, SETCONST *l, SETCONST *wl)
{
 SETCONST *r;
 SETCONST *fwl;
 SETCONST **pfwl;

 if (!w && !l && !wl) return(0);
 if (w && (w->kind == SCK_REF))
  { /*
     * Duplicates another constant, which must have been already
     *	generated since refs always point backwards in the lists.
     *	Don't actually generate anything; just point to the earlier
     *	constant.
     *
     * We do not need to check for out-of-range here, since this loc
     *	cannot be earlier than the earlier SETCONST's loc.
     */
    w->at = w->ref->at;
    r = gen_merge(at,w->link,l,wl);
    if (r != failconst)
     { w->link = r;
       return(w);
     }
  }
 if (l && (l->kind == SCK_REF))
  { /*
     * As above, but for longs.
     */
    l->at = l->ref->at;
    r = gen_merge(at,w,l->link,wl);
    if (r != failconst)
     { l->link = r;
       return(l);
     }
  }
 if (wl && (wl->kind == SCK_REF))
  { /*
     * As above, but for longs which could be words.
     */
    wl->at = wl->ref->at;
    r = gen_merge(at,w,l,wl->link);
    if (r != failconst)
     { wl->link = r;
       return(wl);
     }
  }
 /*
  * If the next element of any list is out of range, fail.  Nothing we
  *  can do could possibly fix this.  Ultimately, every failure return
  *  is due to one of these failures passing up the recursion chain;
  *  this is where failconst->ref is set.
  */
 if (w && (at > w->loc+4+510))
  { failconst->ref = w;
    return(failconst);
  }
 if (l && (at > (l->loc&~(LOC)3)+4+1020))
  { failconst->ref = l;
    return(failconst);
  }
 if (wl && (at > (wl->loc&~(LOC)3)+4+1020))
  { failconst->ref = wl;
    return(failconst);
  }
 /*
  * Find the first non-ref word/long which is within word range.
  */
 for (pfwl=&wl;(fwl=*pfwl);pfwl=&fwl->link)
  { if ((at <= fwl->loc+4+510) && (fwl->kind != SCK_REF)) break;
  }
 /*
  * If we're on an odd word boundary, either generate a word constant
  *  or, if we have no word constants, .align 4.  We can't do better
  *  than this, since generating a long at this point would mean
  *  generating a .align 4 first.
  *
  * In this case, if we have both words and word/longs, we have to
  *  decide which to generate.  We generate whichever one has an
  *  earlier loc, except that we don't consider word/longs which are
  *  out of word range.
  */
 if (at & 2)
  { if (fwl && (!w || (fwl->loc < w->loc)))
     { fwl->at = at;
       *pfwl = fwl->link;
       r = gen_merge(at+2,w,l,wl);
       if (r != failconst)
	{ fwl->link = r;
	  fwl->kind = SCK_WORD;
	  return(fwl);
	}
       *pfwl = fwl;
     }
    if (w)
     { w->at = at;
       r = gen_merge(at+2,w->link,l,wl);
       if (r != failconst)
	{ w->link = r;
	  return(w);
	}
     }
    /*
     * No words available, so there is nothing to do but skip.  (This
     *	turns into a .align when code is generated.)
     */
    at += 2;
  }
 /*
  * If two lists are empty, use the third.
  */
 if (!w && !wl)
  { l->at = at;
    r = gen_merge(at+4,0,l->link,0);
    if (r != failconst)
     { l->link = r;
       return(l);
     }
    return(failconst);
  }
 if (!l && !wl)
  { w->at = at;
    r = gen_merge(at+2,w->link,0,0);
    if (r != failconst)
     { w->link = r;
       return(w);
     }
    return(failconst);
  }
 if (!l && !w)
  { if (fwl)
     { fwl->at = at;
       *pfwl = fwl->link;
       r = gen_merge(at+2,0,0,wl);
       if (r != failconst)
	{ fwl->link = r;
	  fwl->kind = SCK_WORD;
	  return(fwl);
	}
       *pfwl = fwl;
     }
    wl->at = at;
    r = gen_merge(at+4,0,0,wl->link);
    if (r != failconst)
     { wl->link = r;
       wl->kind = SCK_LONG;
       return(wl);
     }
    return(failconst);
  }
 /*
  * No obvious reason to prefer any.  Try them all.  Try to do the ones
  *  more likely to provoke a failure earlier.
  */
 if (l)
  { l->at = at;
    r = gen_merge(at+4,w,l->link,wl);
    if (r != failconst)
     { l->link = r;
       return(l);
     }
  }
 if (fwl)
  { fwl->at = at;
    *pfwl = fwl->link;
    r = gen_merge(at+2,w,l,wl);
    if (r != failconst)
     { fwl->link = r;
       fwl->kind = SCK_WORD;
       return(fwl);
     }
    *pfwl = fwl;
  }
 if (w)
  { w->at = at;
    r = gen_merge(at+2,w->link,l,wl);
    if (r != failconst)
     { w->link = r;
       return(w);
     }
  }
 if (wl)
  { wl->at = at;
    r = gen_merge(at+4,w,l,wl->link);
    if (r != failconst)
     { wl->link = r;
       wl->kind = SCK_LONG;
       return(wl);
     }
  }
 /*
  * Nothing worked.  Lose lose.
  */
 return(failconst);
}

static void free_setconst_list(SETCONST *l)
{
 SETCONST *t;

 while (l)
  { t = l;
    l = t->link;
    if (t->kind != SCK_REF) expr_free(t->val);
    free(t->file);
    free(t);
  }
}

#if 0
static void dump_list(SETCONST *l, const char *tag)
{
 errmsg("%s:",tag);
 for (;l;l=l->link)
  { switch (l->kind)
     { case SCK_WORD:
	  errmsg("  %p WORD %08"LPM"x %04x",(void *)l,l->loc,0xffff&(unsigned int)l->value);
	  break;
       case SCK_LONG:
	  errmsg("  %p LONG %08"LPM"x %08x",(void *)l,l->loc,0xffffffff&(unsigned int)l->value);
	  break;
       case SCK_WLONG:
	  errmsg("  %p WLONG %08"LPM"x %04x",(void *)l,l->loc,0xffff&(unsigned int)l->value);
	  break;
       case SCK_REF:
	  errmsg("  %p REF %p",(void *)l,(void *)l->ref);
	  break;
       default:
	  errmsg("  %p ?%d",(void *)l,(int)l->kind);
	  break;
     }
  }
}
#endif

/*
 * We could in principle implement a word constant as a longword, and
 *  arguably should if it's within longword but not word range of its
 *  referencing instruction.  We don't, because this means taking up
 *  more space than expected; the coder can fix the resulting error by
 *  switching from SETS.W to SETS.L if desired.
 *
 * We can also implement a long constant as a word if the value fits
 *  and it's within word range of its instruction.  This we do do.  (In
 *  contrast to implementing a SETS.W with a longword datum, which uses
 *  more space than coded, this uses less.)
 *
 * First, split the list into words, longwords, and longwords which
 *  could be implemnted as words.  Then see if we can come up with an
 *  order in which to generate the constants that keeps them all in
 *  range.  This may be nontrivial; for example, it's possible to have
 *  a word and a long, each of which would be in range individually but
 *  which cannot both be generated in range.  It's also possible to
 *  have two SETS.Ls either of which is in range but which cannot both
 *  be.
 *
 * However, it is easy to prove that, for each size, we cannot do
 *  better than generating the data in the same order as the
 *  referencing instructions, so we can just sort each list by
 *  instruction location and then consider only generation orders that
 *  are shuffles of the two lists.  Having a third list - longs that
 *  could be done as words - complicates this, but the same conclusion
 *  is valid: if it's possible at all, it's possible with a shuffle of
 *  the three lists.
 *
 * We also could in principle reuse either half of a long value for a
 *  word value.  We don't bother looking for such cases, though
 *  arguably we should.  (This also introduces the possibility that we
 *  can do better than a shuffle of the in-order lists: it may be that
 *  the only way to get everything within range is to generate an
 *  out-of-order long and a word reuse of one half of it.  We already
 *  have this to some extent with the long-as-word stuff; maybe that
 *  technique could be extended for this?  A solution to this issue
 *  would probably also allow collapsing words with word/longs, which
 *  we currently don't do.)  If we want to get really fancy, we might
 *  search assembled code for opportunistic cases where the value we
 *  want happens to occur in the instruction stream.  We don't do that
 *  either; it seems unlikely to win and feels brittle - patching an
 *  instruction could silently change a constant.)
 */
void pseudo_set_constants(void)
{
 SETCONST *wlist;
 SETCONST *llist;
 SETCONST *wllist;
 SETCONST *mlist;
 SETCONST *sc;
 SETCONST *t;
 FILE *xf;
 LOC o;
 LOC d;
 int w;

 if (! set_constants) return;
 d = dot();
 if (d & 1)
  { warnmsg("SETCONST at odd address; supplying \".align 2\"");
    incdot(1);
    d ++;
  }
 wlist = 0;
 llist = 0;
 wllist = 0;
 while (set_constants)
  { sc = set_constants;
    set_constants = sc->link;
    switch (sc->kind)
     { case SCK_WORD:
	  sc->link = wlist;
	  wlist = sc;
	  break;
       case SCK_LONG:
	  sc->link = llist;
	  llist = sc;
	  break;
       case SCK_WLONG:
	  sc->link = wllist;
	  wllist = sc;
	  break;
       default:
	  panic("pseudo_set_constants prep: kind bad");
	  break;
     }
  }
 wlist = sort_setconst(wlist);
 llist = sort_setconst(llist);
 wllist = sort_setconst(wllist);
 /*
  * We could potentially collapse a WORD value with a WLONG value, but
  *  determining exactly when we can do this is nontrivial.  For now,
  *  we punt: WORDs and WLONGs never collapse with one another.  (The
  *  question does not arise between LONG and WLONG, because any LONG
  *  value that could be collapsed with a WLONG value would _be_ a
  *  WLONG value, not a LONG at all.)
  */
 collapse_consts(wlist,&check_setconst_word);
 collapse_consts(llist,&check_setconst_long);
 collapse_consts(wllist,&check_setconst_wlong);
 mlist = gen_merge(d,wlist,llist,wllist);
 if (mlist == failconst)
  { errmsgfl(failconst->ref->file,failconst->ref->line,"constant too distant");
    free_setconst_list(wlist);
    free_setconst_list(llist);
    free_setconst_list(wllist);
  }
 else
  { xf = fopen_expansion("SETCONST",-1);
    d = dot();
    for (sc=mlist;sc;sc=sc->link)
     { t = sc;
       switch (t->kind)
	{ case SCK_WORD:
	     if (t->at & 1) panic("pseudo_set_constants SCK_WORD: at bad 1");
	     if (t->at != d)
	      { if (!(d & 1) || (t->at-d != 1)) panic("pseudo_set_constants SCK_WORD: d bad");
		fprintf(xf,"\t.align\t2\n");
		d = t->at;
	      }
	     fprintf(xf,"\t.word\t");
	     w = fprint_expr(xf,t->val);
	     if (w < 23) fprintf(xf,"%*s",23-w,"");
	     fprintf(xf," ; %08"LPM"x",t->loc);
	     for (t=sc->link;t;t=t->link)
	      { if ((t->kind == SCK_REF) && (t->ref == sc))
		 { fprintf(xf,", %08"LPM"x",t->loc);
		 }
	      }
	     fprintf(xf,"\n");
	     t = sc;
	     d += 2;
	     break;
	  case SCK_LONG:
	     if (t->at & 3) panic("pseudo_set_constants SCK_LONG: at bad");
	     if (t->at != d)
	      { if (!(d & 3) || (t->at != (d&~(LOC)3)+4)) panic("pseudo_set_constants SCK_LONG: d bad");
		fprintf(xf,"\t.align\t4\n");
		d = t->at;
	      }
	     fprintf(xf,"\t.long\t");
	     w = fprint_expr(xf,t->val);
	     if (w < 23) fprintf(xf,"%*s",23-w,"");
	     fprintf(xf," ; %08"LPM"x",t->loc);
	     for (t=sc->link;t;t=t->link)
	      { if ((t->kind == SCK_REF) && (t->ref == sc))
		 { fprintf(xf,", %08"LPM"x",t->loc);
		 }
	      }
	     fprintf(xf,"\n");
	     t = sc;
	     d += 4;
	     break;
	  case SCK_REF:
	     t = sc->ref;
	     break;
	  default:
	     panic("pseudo_set_constants: kind bad 1");
	     break;
	}
       switch (t->kind)
	{ case SCK_WORD:
	     if (t->at & 1) panic("pseudo_set_constants SCK_WORD: at bad 2");
	     o = sc->loc + 4;
	     if (t->at < o) panic("pseudo_set_constants SCK_WORD: offset negative");
	     o = t->at - o;
	     if ((o & 1) || (o > 510)) panic("pseudo_set_constants SCK_WORD: out of range");
	     if (setmem_multi(sc->loc,0x9000|(sc->reg<<8)|(o>>1),2,1))
	      { errmsg("can't backpatch");
	      }
	     break;
	  case SCK_LONG:
	     if (t->at & 3) panic("pseudo_set_constants SCK_LONG: at bad 2");
	     o = (sc->loc & ~(LOC)3) + 4;
	     if (t->at < o) panic("pseudo_set_constants SCK_LONG: offset negative");
	     o = t->at - o;
	     if ((o & 3) || (o > 1020)) panic("pseudo_set_constants SCK_LONG: out of range");
	     if (setmem_multi(sc->loc,0xd000|(sc->reg<<8)|(o>>2),2,1))
	      { errmsg("can't backpatch");
	      }
	     break;
	  default:
	     panic("pseudo_set_constants: kind bad 2");
	     break;
	}
     }
    fclose(xf);
    free_setconst_list(mlist);
  }
}

void pushpop_is(PUSHPOP pp)
{
 pushpop_op = pp;
}

void pushpop_dot(void)
{
 save_symbol_name(".");
 pushpop_symbol();
}

void pushpop_symbol(void)
{
 SYM *s;
 SYMVALSTACK *svs;

 s = lookup_sym(symbol_name,symbol_space,1);
 switch (pushpop_op)
  { case PP_PUSH:
       svs = malloc(sizeof(SYMVALSTACK));
       svs->value = expr_clone(s->value);
       svs->link = s->valstack;
       s->valstack = svs;
       break;
    case PP_POP:
       svs = s->valstack;
       if (! svs)
	{ errmsg(".pop on a symbol with an empty stack");
	  return;
	}
       s->valstack = svs->link;
       expr_free(s->value);
       s->value = svs->value;
       free(svs);
       break;
  }
 list_showvalue = LSV_DECIMAL;
 list_value = 0;
 for (svs=s->valstack;svs;svs=svs->link) list_value ++;
}

void float_start(void)
{
 static int didinit = 0;

 float_value = fzero(0);
 float_pow10 = ival_to_fval(1);
 float_sawdot = 0;
 float_ndigit = 0;
 float_negexp = 0;
 if (! didinit)
  { float_10 = ival_to_fval(10);
    float_1_10 = float_div(ival_to_fval(1),float_10);
  }
}

void float_digit(char digit)
{
 if (float_sawdot)
  { float_pow10 = float_mul(float_pow10,float_1_10);
    float_value = float_add(float_value,float_mul(float_pow10,ival_to_fval(digit-'0')));
  }
 else
  { float_value = float_add(float_mul(float_value,float_10),ival_to_fval(digit-'0'));
  }
 float_ndigit ++;
}

int float_decpt(void)
{
 if (float_sawdot) return(0);
 float_sawdot = 1;
 return(1);
}

int float_wrapup(void)
{
 if (! xst_terminal_ok()) return(0);
 if (float_ndigit < 1) return(0);
 xst_push_expr(expr_make(X_CONST,VT_F,float_value));
 return(1);
}

void float_exp_sign(char sgn)
{
 switch (sgn)
  { case '-':
       float_negexp = 1;
       break;
    case '+':
       break;
    default:
       panic("float_exp_sign: sign bad");
       break;
  }
}

int float_wrapup_exp(int e10)
{
 FVAL base;
 FVAL power;
 FVAL bp;

 if (! xst_terminal_ok()) return(0);
 if (float_ndigit < 1) return(0);
 if (e10 == 0) return(1);
 base = float_negexp ? float_1_10 : float_10;
 power = ival_to_fval(1);
 bp = base;
 while (1)
  { if (e10 & 1) power = float_mul(power,bp);
    e10 >>= 1;
    if (! e10) break;
    bp = float_mul(bp,bp);
  }
 float_value = float_mul(float_value,power);
 xst_push_expr(expr_make(X_CONST,VT_F,float_value));
 return(1);
}

void save_symbol_space(CPUTYPE t)
{
 switch (t)
  { case CPU_SH:
       symbol_space = &cpustate_sh;
       break;
    case CPU_VMU:
       symbol_space = &cpustate_vmu;
       break;
    default:
       panic("save_symbol_space: CPU bad");
       break;
  }
}

void save_symbol_space_cur(void)
{
 symbol_space = cpu;
}

void save_symbol_name(const char *name)
{
 free(symbol_name);
 symbol_name = strdup(name);
}

void use_cpu(CPUTYPE t)
{
 if (cpu->type == t) return;
 switch (t)
  { case CPU_SH:
       cpu = &cpustate_sh;
       break;
    case CPU_VMU:
       cpu = &cpustate_vmu;
       break;
    default:
       panic("use_cpu: CPU bad");
       break;
  }
}

int if_cpu(CPUTYPE t)
{
 return(cpu->type==t);
}

void v_base(int v)
{
 expr_free(vmu_base);
 vmu_base = expr_make(X_CONST,VT_I,(SVAL)v);
}

void v_seti(int i)
{
 vmu_i = i;
}

void v_save_d9(void)
{
 vmu_d9 = parsed_expr();
}

void v_save_b3(void)
{
 vmu_b3 = parsed_expr();
}

void v_save_aref(void)
{
 vmu_aref = parsed_expr();
}

void v_assemble(int v0, ...)
{
 va_list ap;
 int v;
 int nb;
 LOC predot;
 LOC postdot;

 predot = dot();
 va_start(ap,v0);
 for <"pass1"> (v=v0;;v=va_arg(ap,int))
  { switch (v)
     { case VAS_BASEADD:
	  (void) va_arg(ap,int);
	  break;
       case VAS_ADDI:
       case VAS_ADDD8:
       case VAS_ADDA12H:
       case VAS_ADDD9B3:
	  break;
       case VAS_BASE:
       case VAS_IMM8:
       case VAS_DLOW:
       case VAS_A12LOW:
       case VAS_R8:
	  nb ++;
	  break;
       case VAS_A16:
       case VAS_R16:
	  nb += 2;
	  break;
       case VAS_END:
	  break <"pass1">;
	  break;
       default:
	  panic("v_assemble pass1: arg bad");
	  break;
     }
  }
 va_end(ap);
 postdot = predot + nb;
#if 1
 errmsg("unimplemented");
#else
 va_start(ap,v0);
 for <"pass2"> (v=v0;;v=va_arg(ap,int))
  { switch (v)
     { case VAS_BASEADD:
	  vmu_base = simplify_expr(expr_make(X_DYAD,vmu_base,DOP_ADD,expr_make(X_CONST,(SVAL)va_arg(ap,int))));
	  break;
       case VAS_ADDI:
	  vmu_base = simplify_expr(expr_make(X_DYAD,vmu_base,DOP_ADD,expr_make(X_CONST,(SVAL)vmu_i)));
	  break;
       case VAS_ADDD8:
// XXX figure out how best to handle this stuff - patchups?
	  break;
       case VAS_ADDA12H:
	  break;
       case VAS_ADDD9B3:
	  break;
       case VAS_BASE:
	  break;
       case VAS_IMM8:
	  break;
       case VAS_DLOW:
	  break;
       case VAS_A12LOW:
	  break;
       case VAS_R8:
	  nb ++;
	  break;
       case VAS_A16:
       case VAS_R16:
	  nb += 2;
	  break;
       case VAS_END:
	  break <"pass2">;
	  break;
       default:
	  panic("v_assemble pass2: arg bad");
	  break;
     }
  }
 va_end(ap);
#endif
}

/*
vmu/sh matters for:
do_assignment
set_label
set_loclabel
anything that writes to memory
*/