/* This file is in the public domain. */

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

#define NEED_NAME
#define NEED_OPFORMATS
#define NEED_DEFS
#define NEED_ALT_DEFS
#include "instrtbl.h"

#include "htable.h"
#include "copyof.h"
#include "heapsort.h"
#include "as11-fsm.h"

#define MAXLINESIZ 512 /* max line length for assembly files */

/* NRD in fcvt-exptab-gen.c must be >= MAXDDIG */
/* NBITS in fcvt-mantbits-gen.c must match WORKBITS */
/* NDIG in fcvt-mantbits-gen.c must match MAXDDIG */
#define MAXDDIG 26
#define WORKBITS 80

extern const char *__progname;

typedef struct liststack LISTSTACK;
typedef struct dblword DBLWORD;
typedef struct splitfloat SPLITFLOAT;
typedef enum sv_type SV_TYPE;
typedef enum stackop STACKOP;
typedef struct stackval STACKVAL;
typedef struct stackel STACKEL;
typedef struct ifstack IFSTACK;
typedef struct symbol SYMBOL;
typedef struct instack INSTACK;

typedef DBLWORD FLOAT;

struct liststack {
  LISTSTACK *link;
  int dolist;
  } ;

struct dblword {
  unsigned long int l;
  unsigned long int h;
  } ;

struct splitfloat {
  int sign;
  int exp;
  DBLWORD mant;
  } ;

enum sv_type {
  SV_TYPE_UINT = 1,
  SV_TYPE_SINT,
  SV_TYPE_F,
  SV_TYPE_OP1,
  SV_TYPE_OP2
  } ;

enum stackop {
  OP_LOR = 1,
  OP_LAND,
  OP_OR,
  OP_XOR,
  OP_AND,
  OP_EQ,
  OP_NEQ,
  OP_LT,
  OP_GT,
  OP_LE,
  OP_GE,
  OP_LSH,
  OP_RSH,
  OP_ADD,
  OP_SUB,
  OP_MUL,
  OP_DIV,
  OP_MOD,
  OP_IASF,
  OP_FASI,
  OP_FIX,
  OP_TRUNC,
  OP_ROUND,
  OP_FLOAT,
  OP_UMINUS,
  OP_UTILDE,
  OP_UBANG
  } ;

struct stackval {
  SV_TYPE type;
  union {
    DBLWORD i;
    FLOAT f;
    STACKOP op;
    } u;
  } ;

struct stackel {
  STACKEL *link;
  STACKVAL v;
  } ;

struct ifstack {
  IFSTACK *link;
  int condtrue;
  int infalse;
  int asmtrue;
  char *name;
  int serial;
  int line;
  } ;

struct symbol {
  char *name;
  STACKVAL value;
  int flags;
#define SYM_F_SETYET  0x00000001
#define SYM_F_SPECIAL 0x00000002
  void (*specf)(SYMBOL *, int, ...);
#define SPECOP_INIT 0
#define SPECOP_SET  1
  } ;

struct instack {
  INSTACK *link;
  char *name;
  FILE *file;
  int line;
  int serial;
  } ;

/* warning: ROUNDUP is evals its second argument thrice */
#define ROUNDUP(n,unit) ((((n)+(unit)-1)/(unit))*(unit))

static INSTR_DEF **id_names;

static char *outfile;
static char *listfile;

static FILE *outf;
static FILE *listf;

static INSTACK *instack;
#define infile (instack->name)
#define inf (instack->file)
#define asmline (instack->line)
static int inserial = 0;
static int instack_depth;
static int pop_instack;
static int hexoutput;

static char *argfn = 0;

static unsigned char core[65536];
static unsigned char wrotecore[65536];

static FLOAT fzero = { 0, 0 };
static FLOAT fmax = { 0xffff7fff, 0xffffffff };
static DBLWORD izero = { 0, 0 };
static STACKVAL svzero;

static char *symtbl;
static SYMBOL *sym_dot;
static word dot;
static LISTSTACK *liststack;
#define dolisting (liststack->dolist)
static STACKEL *stack;
static IFSTACK *ifstack;
#define INFALSE() (ifstack&&!ifstack->asmtrue)
static char *asmfile;
static int asmerrs;
static int asm_secondpass;
static int asmlinc;
static char line[MAXLINESIZ];
static int unlisted_lines;
static char asmname[MAXLINESIZ];
static int asmnamefill;
static INSTR_DEF *asm_opcode;
static int asm_regno;
static STACKVAL asm_expr;
static int asm_mode;
static int asm_regno1;
static STACKVAL asm_expr1;
static int asm_mode1;
static int doublefloat;
static unsigned char numberdigits[MAXLINESIZ];
static int defbase;
static int numberbase;
static int numberoverflow;
static int numberunsigned;
static int nnumberdigits;
static int floatscale;
static int floatexp;
static int floatexpsign;
static char asm_termc;
static int asm_iftype;
#define IF_EQ  1
#define IF_NE  2
#define IF_GT  3
#define IF_GE  4
#define IF_LE  5
#define IF_LT  6
#define IF_DF  7
#define IF_NDF 8
static char assign_sym[MAXLINESIZ];
static int asm_lcbegin;

static void *deconst(const void *s)
{
 void *s2;

 bcopy(&s,&s2,sizeof(void *));
 return(s2);
}

static void bugchk(const char *, ...) __attribute__((__noreturn__));
static void bugchk(const char *fmt, ...)
{
 va_list ap;

 fprintf(stderr,"%s: INTERNAL BUG: ",__progname);
 va_start(ap,fmt);
 vfprintf(stderr,fmt,ap);
 fprintf(stderr,"\n");
 va_end(ap);
 abort();
}

static SPLITFLOAT split(FLOAT f)
{
 SPLITFLOAT rv;

 rv.sign = (f.l >> 15) & 1;
 rv.exp = (f.l >> 7) & 0xff;
 rv.mant.h = (f.l >> 16) | ((f.l & 0x7f) << 16) | 0x800000;
 rv.mant.l = (f.h >> 16) | ((f.h & 0xffff) << 16);
 return(rv);
}

static FLOAT unsplit(SPLITFLOAT sf)
{
 FLOAT f;

 f.l = (sf.sign << 15) | (sf.exp << 7) | ((sf.mant.h >> 16) & 0x7f) | ((sf.mant.h & 0xffff) << 16);
 f.h = (sf.mant.l >> 16) | ((sf.mant.l & 0xffff) << 16);
 return(f);
}

static int sxw(word w)
{
 return((w&0x8000)?((~0U)<<16)|w:w);
}

static unsigned int lg(unsigned long int uli)
{
 int l;

 l = 0;
 if (uli & (0xffff0000     )) l += 16;
 if (uli & (0x0000ff00 << l)) l += 8;
 if (uli & (0x000000f0 << l)) l += 4;
 if (uli & (0x0000000c << l)) l += 2;
 if (uli & (0x00000002 << l)) l += 1;
 return(l);
}

static unsigned int dlg(DBLWORD dw)
{
 return(dw.h?(32+lg(dw.h)):lg(dw.l));
}

static FLOAT negf(FLOAT f)
{
 f.l ^= 0x8000;
 return(f);
}

static DBLWORD neg64(DBLWORD i)
{
 i.h ^= 0xffffffff;
 if (i.l == 0) i.h = ((i.h + 1) & 0xffffffff); else i.l = ((0xffffffff ^ i.l) + 1) & 0xffffffff;
 return(i);
}

static DBLWORD shift64(DBLWORD i, int n)
{
 if (n >= 64)
  { i = izero;
  }
 else if (n >= 32)
  { i.h = (i.l << (n-32)) & 0xffffffff;
    i.l = 0;
  }
 else if (n > 0)
  { i.h = ((i.h << n) | (i.l >> (32-n))) & 0xffffffff;
    i.l = (i.l << n) & 0xffffffff;
  }
 else if (n <= -64)
  { i = izero;
  }
 else if (n <= -32)
  { i.l = i.h >> (-n-32);
    i.h = 0;
  }
 else if (n < 0)
  { i.l = ((i.l >> -n) | (i.h << (32+n))) & 0xffffffff;
    i.h >>= -n;
  }
 return(i);
}

static void asmwarn(const char *fmt, ...)
{
 va_list ap;

 if (! asm_secondpass) return;
 va_start(ap,fmt);
 if (asmline > 0)
  { fprintf(stderr,"%s: \"%s\", line %d: Warning: ",__progname,asmfile,asmline);
  }
 vfprintf(stderr,fmt,ap);
 fprintf(stderr,"\n");
 va_end(ap);
 va_start(ap,fmt);
 fprintf(listf,"Warning:\t");
 vfprintf(listf,fmt,ap);
 fprintf(listf,"\n");
 va_end(ap);
 asmerrs ++;
}

static DBLWORD add64(DBLWORD i1, DBLWORD i2, int s)
{
 DBLWORD sum;

 sum.l = (i1.l + i2.l) & 0xffffffff;
 sum.h = (i1.h + i2.h) & 0xffffffff;
 if (((i1.l|i2.l)&~sum.l) & 0x80000000) sum.h = (sum.h + 1) & 0xffffffff;
 if ((s>=0) && (s ? ( ((i1.h & 0x80000000) == (i2.h & 0x80000000)) &&
		      ((i1.h & 0x80000000) != (sum.h & 0x80000000)) )
		  : (((i1.h|i2.h)&~sum.h) & 0x80000000) ))
  { asmwarn("%s integer addition overflows",s?"Signed":"Unsigned");
  }
 return(sum);
}

static DBLWORD sub64(DBLWORD i1, DBLWORD i2, int s)
{
 DBLWORD diff;

 diff.l = (i1.l - i2.l) & 0xffffffff;
 diff.h = (i1.h - i2.h) & 0xffffffff;
 if (i2.l > i1.l) diff.h = (diff.h - 1) & 0xffffffff;
 if ((s>=0) && (s ? ( ((i1.h & 0x80000000) != (i2.h & 0x80000000)) &&
		      ((i1.h & 0x80000000) != (diff.h & 0x80000000)) )
		  : ((i2.h > i1.h) || ((i2.h == i1.h) && (i2.l > i1.l))) ))
  { asmwarn("%s integer subtraction overflows",s?"Signed":"Unsigned");
  }
 return(diff);
}

static FLOAT fround(FLOAT f)
{
 SPLITFLOAT sf;

 sf = split(f);
 if (sf.mant.l & 0x80000000) sf.mant.h ++;
 if (sf.mant.h > 0x00ffffff)
  { if (sf.exp == 0xff)
     { asmwarn("Floating-point rounding overflows; using chopped value");
       return(f);
     }
    sf.exp ++;
    sf.mant.h >>= 1;
  }
 sf.mant.l = 0;
 return(unsplit(sf));
}

static FLOAT mulf(FLOAT f1, FLOAT f2)
{
 int i;
 int j;
 int k;
 int p;
 unsigned long int uli1;
 unsigned long int uli2;
 unsigned char n1[7];
 unsigned char n2[7];
 unsigned char pr[14];
 SPLITFLOAT sf1;
 SPLITFLOAT sf2;
 SPLITFLOAT prod;

 if (0)
  {
underflow:;
    asmwarn("Floating-point multiplication underflows");
    return(fzero);
  }
 if (0)
  {
overflow:;
    asmwarn("Floating-point multiplication overflows");
    return(fzero);
  }
 sf1 = split(f1);
 sf2 = split(f2);
 prod.sign = sf1.sign ^ sf2.sign;
 prod.exp = sf1.exp + sf2.exp - 0x80;
 if (prod.exp < 1) goto underflow;
 if (prod.exp > 0xff) goto overflow;
 uli1 = sf1.mant.l;
 uli2 = sf2.mant.l;
 for (i=6;i>2;i--)
  { n1[i] = uli1 & 0xff;
    uli1 >>= 8;
    n2[i] = uli2 & 0xff;
    uli2 >>= 8;
  }
 uli1 = sf1.mant.h;
 uli2 = sf2.mant.h;
 for (;i>=0;i--)
  { n1[i] = uli1 & 0xff;
    uli1 >>= 8;
    n2[i] = uli2 & 0xff;
    uli2 >>= 8;
  }
 p = 0;
 for (k=12;k>6;k--)
  { for (i=6,j=k-6;j<=6;i--,j++) p += n1[i] * n2[j];
    pr[k+1] = p & 0xff;
    p >>= 8;
  }
 for (;k>=0;k--)
  { for (i=0,j=k;j>=0;i++,j--) p += n1[i] * n2[j];
    pr[k+1] = p & 0xff;
    p >>= 8;
  }
 if (p > 0xff) bugchk("impossible overflow 1 in mulf");
 pr[0] = p;
 i = 7;
 p = (p < 0x80) ? 0x40 : 0x80;
 while (p)
  { if (i < 0) bugchk("impossible overflow 2 in mulf");
    p += pr[i];
    pr[i] = p & 0xff;
    p >>= 8;
    i --;
  }
 if (pr[0] < 0x80)
  { prod.mant.h = (pr[0] << 17) | (pr[1] << 9) | (pr[2] << 1) | (pr[3] >> 7);
    prod.mant.l = ((pr[3] & 0x7f) << 25) | (pr[4] << 17) | (pr[5] << 9) | (pr[6] << 1) | (pr[7] >> 1);
    prod.exp --;
    if (prod.exp < 1) goto underflow;
  }
 else
  { prod.mant.h = (pr[0] << 16) | (pr[1] << 8) | pr[2];
    prod.mant.l = (pr[3] << 24) | (pr[4] << 16) | (pr[5] << 8) | pr[6];
  }
 return(unsplit(prod));
}

static DBLWORD mul64(DBLWORD i1, DBLWORD i2)
{
 int i;
 int j;
 int k;
 int p;
 unsigned long int uli1;
 unsigned long int uli2;
 DBLWORD prod;
 unsigned char n1[8];
 unsigned char n2[8];
 unsigned char pr[16];

 uli1 = i1.l;
 uli2 = i2.l;
 for (i=7;i>3;i--)
  { n1[i] = uli1 & 0xff;
    uli1 >>= 8;
    n2[i] = uli2 & 0xff;
    uli2 >>= 8;
  }
 uli1 = i1.h;
 uli2 = i2.h;
 for (;i>=0;i--)
  { n1[i] = uli1 & 0xff;
    uli1 >>= 8;
    n2[i] = uli2 & 0xff;
    uli2 >>= 8;
  }
 p = 0;
 for (k=14;k>7;k--)
  { for (i=7,j=k-7;j<=7;i--,j++) p += n1[i] * n2[j];
    pr[k+1] = p & 0xff;
    p >>= 8;
  }
 for (;k>=0;k--)
  { for (i=0,j=k;j>=0;i++,j--) p += n1[i] * n2[j];
    pr[k+1] = p & 0xff;
    p >>= 8;
  }
 if (p > 0xff) bugchk("impossible overflow in mul64");
 pr[0] = p;
 if ((pr[0] != 0) && (pr[0] != 0xff))
  { asmwarn("Integer multiplication overflows");
  }
 else
  { for (i=1;i<8;i++)
     { if (pr[i] != pr[0])
	{ asmwarn("Integer multiplication overflows");
	  break;
	}
     }
  }
 prod.h = (pr[8] << 24) | (pr[9] << 16) | (pr[10] << 8) | pr[11];
 prod.l = (pr[12] << 24) | (pr[13] << 16) | (pr[14] << 8) | pr[15];
 return(prod);
}

static FLOAT addf_(FLOAT f1, FLOAT f2, const char *what)
{
 int i;
 int s;
 int expdiff;
 unsigned long int uli1;
 unsigned long int uli2;
 unsigned char n1[9];
 unsigned char n2[9];
 unsigned char su[9];
 SPLITFLOAT sf1;
 SPLITFLOAT sf2;
 SPLITFLOAT sum;

 sf1 = split(f1);
 sf2 = split(f2);
 if (sf1.exp < sf2.exp)
  { sum = sf1;
    sf1 = sf2;
    sf2 = sum;
  }
 expdiff = sf1.exp - sf2.exp;
 if (expdiff > 60) return(unsplit(sf1));
 if (sf1.sign) sf1.mant = neg64(sf1.mant);
 if (sf2.sign) sf2.mant = neg64(sf2.mant);
 uli1 = sf1.mant.l;
 uli2 = sf2.mant.l;
 for (i=7;i>3;i--)
  { n1[i] = uli1 & 0xff;
    uli1 >>= 8;
    n2[i] = uli2 & 0xff;
    uli2 >>= 8;
  }
 uli1 = sf1.mant.h;
 uli2 = sf2.mant.h;
 for (;i>=0;i--)
  { n1[i] = uli1 & 0xff;
    uli1 >>= 8;
    n2[i] = uli2 & 0xff;
    uli2 >>= 8;
  }
 n1[8] = 0;
 n2[8] = 0;
 i = expdiff / 8;
 if (i > 0)
  { bcopy(&n2[0],&n2[i],9-i);
    for (i--;i>0;i--) n2[i] = n2[0];
  }
 expdiff %= 8;
 if (expdiff)
  { s = n2[0];
    for (i=1;i<9;i++)
     { s = (s << 8) | n2[i];
       n2[i] = (s >> expdiff) & 0xff;
       s &= 0xff;
     }
  }
 s = 0x80;
 for (i=8;i>=0;i--)
  { s += n1[i] + n2[i];
    su[i] = s & 0xff;
    s >>= 8;
  }
 sum.mant.h = (su[0] << 24) | (su[1] << 16) | (su[2] << 8) | su[3];
 sum.mant.l = (su[4] << 24) | (su[5] << 16) | (su[6] << 8) | su[7];
 if (s)
  { sum.sign = 1;
    sum.mant = neg64(sum.mant);
  }
 else
  { sum.sign = 0;
  }
 if ((sum.mant.h|sum.mant.l) == 0) return(fzero);
 i = dlg(sum.mant);
 if (i > 56)
  { sum.mant.l = (sum.mant.l + 1) & 0xffffffff;
    if (sum.mant.l == 0)
     { sum.mant.h = (sum.mant.h + 1) & 0xffffffff;
     }
    sum.mant.l = (sum.mant.l >> 1) | ((sum.mant.h & 1) << 31);
    sum.mant.h >>= 1;
    sum.exp = sf1.exp + 1;
    if (sum.exp > 0xff)
     { asmwarn("Floating-point %s overflows",what);
       return(fzero);
     }
  }
 else if (i < 56)
  { i = 56 - i;
    if (i > 16) asmwarn("Floating-point %s loses %d bits of significance",what,i);
    if (i < 24)
     { sum.mant.h = (sum.mant.h << i) | (sum.mant.l >> (32-i));
       sum.mant.l = (sum.mant.l << i) & 0xffffffff;
     }
    else if (i < 32)
     { sum.mant.h = sum.mant.l >> (32-i);
       sum.mant.l = (sum.mant.l << i) & 0xffffffff;
     }
    else if (i == 32)
     { sum.mant.h = sum.mant.l;
       sum.mant.l = 0;
     }
    else
     { sum.mant.h = sum.mant.l << (i-32);
       sum.mant.l = 0;
     }
    sum.exp = sf1.exp - i;
    if (sum.exp < 1)
     { asmwarn("Floating-point %s underflows",what);
       return(fzero);
     }
  }
 else
  { sum.exp = sf1.exp;
  }
 return(unsplit(sum));
}

static FLOAT addf(FLOAT f1, FLOAT f2)
{
 return(addf_(f1,f2,"addition"));
}

static FLOAT subf(FLOAT f1, FLOAT f2)
{
 return(addf_(f1,negf(f2),"subtraction"));
}

static void divmod64(DBLWORD num, DBLWORD den, DBLWORD *quop, DBLWORD *remp)
{
 int numlg;
 int denlg;
 int shf;
 DBLWORD quo;
 DBLWORD rem;
 DBLWORD sden;

 numlg = dlg(num);
 denlg = dlg(den);
 if (numlg < denlg)
  { *quop = izero;
    *remp = num;
    return;
  }
 shf = numlg - denlg;
 quo = izero;
 rem = num;
 sden = shf ? shift64(den,shf) : den;
 for (;shf>=0;shf--)
  { if ((sden.h < rem.h) || ((sden.h == rem.h) && (sden.l <= rem.l)))
     { rem = add64(rem,neg64(sden),-1);
       if (shf < 32)
	{ quo.l |= 1 << shf;
	}
       else
	{ quo.h |= 1 << (shf-32);
	}
     }
    sden.l = (sden.l >> 1) | ((sden.h << 31) & 0x80000000);
    sden.h >>= 1;
  }
 *quop = quo;
 *remp = rem;
}

static DBLWORD div64(DBLWORD num, DBLWORD den, int sgn, int wantrem)
{
 DBLWORD q;
 DBLWORD r;
 int negn;
 int negd;

 negn = 0;
 negd = 0;
 if (sgn)
  { if (num.h & 0x80000000)
     { negn = 1;
       num = neg64(num);
     }
    if (den.h & 0x80000000)
     { negd = 1;
       den = neg64(den);
     }
  }
 divmod64(num,den,&q,&r);
 if (negn) r = neg64(r);
 if (negd != negn) q = neg64(q);
 return(wantrem?r:q);
}

static FLOAT divf(FLOAT f1, FLOAT f2)
{
 SPLITFLOAT sf1;
 SPLITFLOAT sf2;
 SPLITFLOAT sq;
 int shifts;

 sf1 = split(f1);
 sf2 = split(f2);
 if (sf1.exp == 0)
  { if (sf2.exp == 0)
     { asmwarn("Floating 0/0; 0 used as result");
       return(fzero);
     }
    return(fzero);
  }
 else if (sf2.exp == 0)
  { asmwarn("Floating divide-by-0");
    return(fmax);
  }
 sq.sign = sf1.sign ^ sf2.sign;
 sq.exp = 0x80 + sf1.exp - sf2.exp;
 sq.mant = izero;
 shifts = 0;
 while (sq.mant.h < 0x08000000) /* four guard bits */
  { sq.mant = shift64(sq.mant,1);
    if ((sf1.mant.h > sf2.mant.h) || ((sf1.mant.h == sf2.mant.h) && (sf1.mant.l >= sf2.mant.l)))
     { if (sf1.mant.l < sf2.mant.l)
	{ sf1.mant.l = (sf1.mant.l - sf2.mant.l) & 0xffffffff;
	  sf1.mant.h --;
	}
       else
	{ sf1.mant.l -= sf2.mant.l;
	}
       sf1.mant.h -= sf2.mant.h;
       sq.mant.l |= 1;
     }
    sf1.mant = shift64(sf1.mant,1);
    shifts ++;
  }
 if ((shifts < 60) || (shifts > 61)) bugchk("strange shift count %d in divf",shifts);
 sq.mant.l = (sq.mant.l + 8) & 0xffffffff;
 if (sq.mant.l < 8) sq.mant.h ++;
 if (sq.mant.h > 0x0fffffff)
  { sq.mant = shift64(sq.mant,-5);
    sq.exp --;
  }
 else
  { sq.mant = shift64(sq.mant,-4);
  }
 sq.exp += 61 - shifts;
 return(unsplit(sq));
}

static FLOAT u64_to_f(DBLWORD i64)
{
 if ((i64.h == 0) && (i64.l == 0))
  { FLOAT rv;
    rv.h = 0;
    rv.l = 0;
    return(rv);
  }
 else
  { SPLITFLOAT sf;
    int e2;
    sf.sign = 0;
    e2 = dlg(i64) - 1;
    sf.exp = 0x80 + e2 + 2;
    sf.mant.h = (e2 < 22)
	     ? ((i64.l << (22-e2)) & 0xffffffff)
	     : (e2 == 22)
	     ? i64.l
	     : (e2 < 32)
	     ? (i64.l >> (e2-22))
	     : (e2 < 54)
	     ? (((i64.l >> (e2-22)) | (i64.h << (54-e2))) & 0xffffffff)
	     : (e2 == 54)
	     ? i64.h
	     : (i64.h >> (e2-54))
	     ;
    sf.mant.l = (e2 <= 22)
	     ? 0
	     : (e2 < 54)
	     ? ((i64.l << (54-e2)) & 0xffffffff)
	     : (e2 == 54)
	     ? i64.l
	     : (((i64.l >> (e2-54)) | (i64.h << (86-e2))) & 0xffffffff)
	     ;
    return(unsplit(sf));
  }
}

static FLOAT s64_to_f(DBLWORD i64)
{
 if (i64.h & 0x80000000)
  { return(negf(u64_to_f(neg64(i64))));
  }
 return(u64_to_f(i64));
}

static void f_to_i_ovf(void)
{
 asmwarn("Floating-to-integer conversion overflows");
}

static DBLWORD f_to_i64(FLOAT f, int sgn, int rnd)
{
 int rb;
 int ov;
 SPLITFLOAT sf;
 DBLWORD rv;

 sf = split(f);
 if (sf.exp == 0)
  { rv.h = 0;
    rv.l = 0;
    return(rv);
  }
 sf.exp -= 0x80;
 rb = 0;
 ov = sgn ? (sf.exp >= 64) : (sf.exp > 64);
 if (sf.exp < 56)
  { rv = shift64(sf.mant,sf.exp-56);
    rb = shift64(sf.mant,sf.exp-55).l & 1;
  }
 else if (sf.exp == 56)
  { rv = sf.mant;
  }
 else
  { rv = shift64(sf.mant,sf.exp-56);
  }
 if (rnd && rb)
  { rv.l = (rv.l + 1) & 0xffffffff;
    if (rv.l == 0)
     { rv.h = (rv.h + 1) & 0xffffffff;
       if ((rv.h == 0) || (sgn && (rv.h & 0x80000000))) ov = 1;
     }
  }
 if (ov && (sgn >= 0)) f_to_i_ovf();
 return(rv);
}

static STACKVAL sv_makebool(int cbool)
{
 STACKVAL rv;

 rv.type = SV_TYPE_SINT;
 rv.u.i.h = 0;
 rv.u.i.l = cbool ? 1 : 0;
 return(rv);
}

static STACKVAL sv_neg(STACKVAL sv)
{
 STACKVAL rv;

 rv.type = sv.type;
 switch (sv.type)
  { case SV_TYPE_SINT:
    case SV_TYPE_UINT:
       rv.u.i = neg64(sv.u.i);
       break;
    case SV_TYPE_F:
       rv.u.f = negf(sv.u.f);
       break;
    default:
       bugchk("bad type %d to sv_neg",(int)sv.type);
       break;
  }
 return(rv);
}

static STACKVAL sv_com(STACKVAL sv)
{
 STACKVAL rv;

 rv.type = sv.type;
 switch (sv.type)
  { case SV_TYPE_SINT:
    case SV_TYPE_UINT:
       rv.u.i.h = 0xffffffff ^ sv.u.i.h;
       rv.u.i.l = 0xffffffff ^ sv.u.i.l;
       break;
    case SV_TYPE_F:
       asmwarn("Can't use ~ with floats");
       rv.u.f = fzero;
       break;
    default:
       bugchk("bad type %d to sv_com",(int)sv.type);
       break;
  }
 return(rv);
}

static STACKVAL typecvt(STACKVAL sv, SV_TYPE newtype)
{
 if (sv.type == newtype) return(sv);
 switch (newtype)
  { case SV_TYPE_SINT:
       switch (sv.type)
	{ case SV_TYPE_SINT:
	     break;
	  case SV_TYPE_UINT:
	     break;
	  case SV_TYPE_F:
	     sv.u.i = f_to_i64(sv.u.f,1,1);
	     break;
	  default:
	     bugchk("bad type %d in typecvt (vs SINT)",(int)sv.type);
	     break;
	}
       break;
    case SV_TYPE_UINT:
       switch (sv.type)
	{ case SV_TYPE_SINT:
	     break;
	  case SV_TYPE_UINT:
	     break;
	  case SV_TYPE_F:
	     sv.u.i = f_to_i64(sv.u.f,1,1);
	     break;
	  default:
	     bugchk("bad type %d in typecvt (vs UINT)",(int)sv.type);
	     break;
	}
       break;
    case SV_TYPE_F:
       switch (sv.type)
	{ case SV_TYPE_SINT:
	     sv.u.f = s64_to_f(sv.u.i);
	     break;
	  case SV_TYPE_UINT:
	     sv.u.f = u64_to_f(sv.u.i);
	     break;
	  case SV_TYPE_F:
	     break;
	  default:
	     bugchk("bad type %d in typecvt (vs F)",(int)sv.type);
	     break;
	}
       break;
    default:
       bugchk("bad to type %d in typecvt",(int)sv.type);
       break;
  }
 sv.type = newtype;
 return(sv);
}

static void typematch(STACKVAL *sv1, STACKVAL *sv2)
{
 int commontype;

 if (sv1->type == sv2->type) return;
 switch (sv1->type)
  { case SV_TYPE_SINT:
       switch (sv2->type)
	{ case SV_TYPE_SINT: commontype = SV_TYPE_SINT; break;
	  case SV_TYPE_UINT: commontype = SV_TYPE_UINT; break;
	  case SV_TYPE_F:    commontype = SV_TYPE_F;    break;
	  default: bugchk("bad type %d in typematch (vs SINT)",(int)sv2->type); break;
	}
       break;
    case SV_TYPE_UINT:
       switch (sv2->type)
	{ case SV_TYPE_SINT: commontype = SV_TYPE_UINT; break;
	  case SV_TYPE_UINT: commontype = SV_TYPE_UINT; break;
	  case SV_TYPE_F:    commontype = SV_TYPE_F;    break;
	  default: bugchk("bad type %d in typematch (vs UINT)",(int)sv2->type); break;
	}
       break;
    case SV_TYPE_F:
       switch (sv2->type)
	{ case SV_TYPE_SINT: commontype = SV_TYPE_F;    break;
	  case SV_TYPE_UINT: commontype = SV_TYPE_F;    break;
	  case SV_TYPE_F:    commontype = SV_TYPE_F;    break;
	  default: bugchk("bad type %d in typematch (vs F)",(int)sv2->type); break;
	}
       break;
    default:
       bugchk("bad main type %d in typematch",(int)sv1->type);
       break;
  }
 if (sv1->type != commontype) *sv1 = typecvt(*sv1,commontype);
 if (sv2->type != commontype) *sv2 = typecvt(*sv2,commontype);
}

static STACKVAL sv_or(STACKVAL sv1, STACKVAL sv2)
{
 if (sv1.type != sv2.type) typematch(&sv1,&sv2);
 switch (sv1.type)
  { case SV_TYPE_SINT:
    case SV_TYPE_UINT:
       sv1.u.i.l |= sv2.u.i.l;
       sv1.u.i.h |= sv2.u.i.h;
       break;
    case SV_TYPE_F:
       asmwarn("Can't use | with floats");
       sv1.u.f = fzero;
       break;
    default:
       bugchk("bad type %d to sv_or",(int)sv1.type);
       break;
  }
 return(sv1);
}

static STACKVAL sv_xor(STACKVAL sv1, STACKVAL sv2)
{
 if (sv1.type != sv2.type) typematch(&sv1,&sv2);
 switch (sv1.type)
  { case SV_TYPE_SINT:
    case SV_TYPE_UINT:
       sv1.u.i.l ^= sv2.u.i.l;
       sv1.u.i.h ^= sv2.u.i.h;
       break;
    case SV_TYPE_F:
       asmwarn("Can't use ^ with floats");
       sv1.u.f = fzero;
       break;
    default:
       bugchk("bad type %d to sv_xor",(int)sv1.type);
       break;
  }
 return(sv1);
}

static STACKVAL sv_and(STACKVAL sv1, STACKVAL sv2)
{
 if (sv1.type != sv2.type) typematch(&sv1,&sv2);
 switch (sv1.type)
  { case SV_TYPE_SINT:
    case SV_TYPE_UINT:
       sv1.u.i.l &= sv2.u.i.l;
       sv1.u.i.h &= sv2.u.i.h;
       break;
    case SV_TYPE_F:
       asmwarn("Can't use & with floats");
       sv1.u.f = fzero;
       break;
    default:
       bugchk("bad type %d to sv_and",(int)sv1.type);
       break;
  }
 return(sv1);
}

static STACKVAL sv_lsh(STACKVAL sv1, STACKVAL sv2)
{
 switch (sv2.type)
  { case SV_TYPE_SINT:
       if (sv2.u.i.h) sv2 = svzero;
       break;
    case SV_TYPE_UINT:
       break;
    case SV_TYPE_F:
       asmwarn("Can't use a float as the right operand of <<");
       return(sv1);
       break;
    default:
       bugchk("bad rhs type %d to sv_lsh",(int)sv2.type);
       break;
  }
 switch (sv1.type)
  { case SV_TYPE_SINT:
    case SV_TYPE_UINT:
       sv1.u.i = (sv2.u.i.h || (sv2.u.i.l >= 64)) ? izero : shift64(sv1.u.i,sv2.u.i.l);
       break;
    case SV_TYPE_F:
       if (sv2.u.i.h || (sv2.u.i.l > 256))
	{ asmwarn("Floating overflow in <<");
	  sv1.u.f = fzero;
	}
       else
	{ SPLITFLOAT sf;
	  sf = split(sv1.u.f);
	  sf.exp += sv2.u.i.l;
	  if (sf.exp > 0xff)
	   { asmwarn("Floating overflow in <<");
	     sv1.u.f = fzero;
	   }
	  else
	   { sv1.u.f = unsplit(sf);
	   }
	}
       break;
    default:
       bugchk("bad lhs type %d to sv_lsh",(int)sv1.type);
       break;
  }
 return(sv1);
}

static STACKVAL sv_rsh(STACKVAL sv1, STACKVAL sv2)
{
 switch (sv2.type)
  { case SV_TYPE_SINT:
       if (sv2.u.i.h) sv2 = svzero;
       break;
    case SV_TYPE_UINT:
       break;
    case SV_TYPE_F:
       asmwarn("Can't use a float as the right operand of >>");
       return(sv1);
       break;
    default:
       bugchk("bad rhs type %d to sv_rsh",(int)sv2.type);
       break;
  }
 switch (sv1.type)
  { case SV_TYPE_SINT:
       if (sv1.u.i.h & 0x80000000)
	{ if (sv2.u.i.h || (sv2.u.i.l >= 64))
	   { sv1.u.i.l = 0xffffffff;
	     sv1.u.i.h = 0xffffffff;
	   }
	  else
	   { sv1.u.i = shift64(sv1.u.i,-(int)sv2.u.i.l);
	     if (sv2.u.i.l < 32)
	      { sv1.u.i.h |= ((~0) << (32-sv2.u.i.l)) & 0xffffffff;
	      }
	     else if (sv2.u.i.l == 32)
	      { sv1.u.i.h = 0xffffffff;
	      }
	     else
	      { sv1.u.i.h = 0xffffffff;
		sv1.u.i.l |= ((~0) << (64-sv2.u.i.l)) & 0xffffffff;
	      }
	   }
	}
       else
	{ sv1.u.i = (sv2.u.i.h || (sv2.u.i.l > 64)) ? izero : shift64(sv1.u.i,sv2.u.i.l);
	}
       break;
    case SV_TYPE_UINT:
       sv1.u.i = (sv2.u.i.h || (sv2.u.i.l > 64)) ? izero : shift64(sv1.u.i,sv2.u.i.l);
       break;
    case SV_TYPE_F:
       if (sv2.u.i.h || (sv2.u.i.l > 256))
	{ asmwarn("Floating underflow in >>");
	  sv1.u.f = fzero;
	}
       else
	{ SPLITFLOAT sf;
	  sf = split(sv1.u.f);
	  sf.exp -= sv2.u.i.l;
	  if (sf.exp > 1)
	   { asmwarn("Floating underflow in >>");
	     sv1.u.f = fzero;
	   }
	  else
	   { sv1.u.f = unsplit(sf);
	   }
	}
       break;
    default:
       bugchk("bad lhs type %d to sv_rsh",(int)sv1.type);
       break;
  }
 return(sv1);
}

static STACKVAL sv_add(STACKVAL sv1, STACKVAL sv2)
{
 if (sv1.type != sv2.type) typematch(&sv1,&sv2);
 switch (sv1.type)
  { case SV_TYPE_SINT:
       sv1.u.i = add64(sv1.u.i,sv2.u.i,1);
       break;
    case SV_TYPE_UINT:
       sv1.u.i = add64(sv1.u.i,sv2.u.i,0);
       break;
    case SV_TYPE_F:
       sv1.u.f = addf(sv1.u.f,sv2.u.f);
       break;
    default:
       bugchk("bad type %d in sv_add",(int)sv1.type);
       break;
  }
 return(sv1);
}

static STACKVAL sv_sub(STACKVAL sv1, STACKVAL sv2)
{
 if (sv1.type != sv2.type) typematch(&sv1,&sv2);
 switch (sv1.type)
  { case SV_TYPE_SINT:
       sv1.u.i = sub64(sv1.u.i,sv2.u.i,1);
       break;
    case SV_TYPE_UINT:
       sv1.u.i = sub64(sv1.u.i,sv2.u.i,0);
       break;
    case SV_TYPE_F:
       sv1.u.f = subf(sv1.u.f,sv2.u.f);
       break;
    default:
       bugchk("bad type %d in sv_sub",(int)sv1.type);
       break;
  }
 return(sv1);
}

static STACKVAL sv_mul(STACKVAL sv1, STACKVAL sv2)
{
 if (sv1.type != sv2.type) typematch(&sv1,&sv2);
 switch (sv1.type)
  { case SV_TYPE_SINT:
       sv1.u.i = mul64(sv1.u.i,sv2.u.i);
       break;
    case SV_TYPE_UINT:
       sv1.u.i = mul64(sv1.u.i,sv2.u.i);
       break;
    case SV_TYPE_F:
       sv1.u.f = mulf(sv1.u.f,sv2.u.f);
       break;
    default:
       bugchk("bad type %d in sv_mul",(int)sv1.type);
       break;
  }
 return(sv1);
}

static STACKVAL sv_div(STACKVAL sv1, STACKVAL sv2)
{
 if (sv1.type != sv2.type) typematch(&sv1,&sv2);
 switch (sv1.type)
  { case SV_TYPE_SINT:
       sv1.u.i = div64(sv1.u.i,sv2.u.i,1,0);
       break;
    case SV_TYPE_UINT:
       sv1.u.i = div64(sv1.u.i,sv2.u.i,0,0);
       break;
    case SV_TYPE_F:
       sv1.u.f = divf(sv1.u.f,sv2.u.f);
       break;
    default:
       bugchk("bad type %d in sv_div",(int)sv1.type);
       break;
  }
 return(sv1);
}

static STACKVAL sv_mod(STACKVAL sv1, STACKVAL sv2)
{
 if (sv1.type != sv2.type) typematch(&sv1,&sv2);
 switch (sv1.type)
  { case SV_TYPE_SINT:
       sv1.u.i = div64(sv1.u.i,sv2.u.i,1,1);
       break;
    case SV_TYPE_UINT:
       sv1.u.i = div64(sv1.u.i,sv2.u.i,0,1);
       break;
    case SV_TYPE_F:
       asmwarn("Can't use %% with floats");
       sv1.u.f = fzero;
       break;
    default:
       bugchk("bad type %d in sv_mod",(int)sv1.type);
       break;
  }
 return(sv1);
}

static int sv_cmp(STACKVAL sv1, STACKVAL sv2)
{
 if (sv1.type != sv2.type) typematch(&sv1,&sv2);
 switch (sv1.type)
  { case SV_TYPE_SINT:
	{ long int i1;
	  long int i2;
	  i1 = (sv1.u.i.h & 0x80000000) ? - ((0xffffffff ^ sv1.u.i.h) + 1) : sv1.u.i.h;
	  i2 = (sv2.u.i.h & 0x80000000) ? - ((0xffffffff ^ sv2.u.i.h) + 1) : sv2.u.i.h;
	  if (i1 > i2) return(1); else if (i1 < i2) return(-1);
	  if (sv1.u.i.l > sv2.u.i.l) return(1); else if (sv1.u.i.l < sv2.u.i.l) return(-1); else return(0);
	}
       break;
    case SV_TYPE_UINT:
       if (sv1.u.i.h > sv2.u.i.h) return(1); else if (sv1.u.i.h < sv2.u.i.h) return(-1);
       if (sv1.u.i.l > sv2.u.i.l) return(1); else if (sv1.u.i.l < sv2.u.i.l) return(-1); else return(0);
       break;
    case SV_TYPE_F:
	{ SPLITFLOAT sf1;
	  SPLITFLOAT sf2;
	  sf1 = split(sv1.u.f);
	  sf2 = split(sv2.u.f);
	  if (sf1.sign != sf2.sign) return(sf1.sign?-1:1);
	  if (sf1.sign)
	   { SPLITFLOAT tsf;
	     tsf = sf1;
	     sf1 = sf2;
	     sf2 = tsf;
	   }
	  if (sf1.exp != sf2.exp) return((sf1.exp>sf2.exp)?1:-1);
	  if (sf1.mant.h != sf2.mant.h) return((sf1.mant.h>sf2.mant.h)?1:-1);
	  if (sf1.mant.l != sf2.mant.l) return((sf1.mant.l>sf2.mant.l)?1:-1);
	  return(0);
	}
       break;
    default:
       bugchk("bad type %d in sv_cmp",(int)sv1.type);
       break;
  }
}

static void initcore(void)
{
 bzero(&wrotecore[0],sizeof(wrotecore));
}

static void setdot(word a)
{
 dot = a & 0xffff;
 sym_dot->value.type = SV_TYPE_UINT;
 sym_dot->value.u.i.l = dot;
 sym_dot->value.u.i.h = 0;
}

static SYMBOL *new_symbol(const char *name)
{
 SYMBOL s;
 SYMBOL *sp;
 void *scp;

 s.name = deconst(name);
 scp = find_hentry(symtbl,&s);
 if (scp) return((SYMBOL *)scp);
 sp = malloc(sizeof(SYMBOL));
 sp->name = copyofstr(name);
 add_new_hentry(symtbl,sp);
 sp->flags = 0;
 return(sp);
}

static SYMBOL *find_symbol(const char *name)
{
 SYMBOL s;

 s.name = deconst(name);
 return(find_hentry(symtbl,&s));
}

static void specsym_dot(SYMBOL *s, int op, ...)
{
 va_list ap;

 va_start(ap,op);
 switch (op)
  { case SPECOP_INIT:
       sym_dot = s;
       setdot(0);
       break;
    case SPECOP_SET:
       setdot(typecvt(va_arg(ap,STACKVAL),SV_TYPE_UINT).u.i.l);
       break;
    default:
       bugchk("bad op %d to specsym_dot",op);
       break;
  }
 va_end(ap);
}

static void asmerr(const char *fmt, ...)
{
 va_list ap;

 if (! asm_secondpass) return;
 va_start(ap,fmt);
 if (asmline > 0)
  { fprintf(stderr,"\"%s\", line %d: ",asmfile,asmline);
  }
 vfprintf(stderr,fmt,ap);
 fprintf(stderr,"\n");
 va_end(ap);
 va_start(ap,fmt);
 fprintf(listf,"****\t\t");
 vfprintf(listf,fmt,ap);
 fprintf(listf,"\n");
 va_end(ap);
 asmerrs ++;
}

static void specsym_base(SYMBOL *s, int op, ...)
{
 va_list ap;
 DBLWORD newbase;

 va_start(ap,op);
 switch (op)
  { case SPECOP_INIT:
       defbase = 8;
       s->value.type = SV_TYPE_SINT;
       s->value.u.i.l = 8;
       s->value.u.i.h = 0;
       break;
    case SPECOP_SET:
       newbase = typecvt(va_arg(ap,STACKVAL),SV_TYPE_UINT).u.i;
       if (newbase.h || (newbase.l < 2) || (newbase.l > 36))
	{ asmerr("Bad value for .base: valid values are 2. through 36. (2 through 44)");
	}
       else
	{ defbase = newbase.l;
	  s->value.type = SV_TYPE_SINT;
	  s->value.u.i.l = newbase.l;
	  s->value.u.i.h = 0;
	}
       break;
    default:
       bugchk("bad op %d to specsym_base",op);
       break;
  }
 va_end(ap);
}

static void makespecials(void)
{
 int i;
 SYMBOL *s;
 static struct {
	  const char *name;
	  void (*fxn)(SYMBOL *, int, ...);
	  } spectbl[] = { { ".", specsym_dot },
			  { ".base", specsym_base },
			  { 0, 0 } };
 for (i=0;spectbl[i].name;i++)
  { s = new_symbol(spectbl[i].name);
    s->flags |= SYM_F_SPECIAL;
    s->specf = spectbl[i].fxn;
    (*s->specf)(s,SPECOP_INIT);
  }
}

static int sym_h(void *svp, unsigned int siz)
{
 return(string_hfxn(((SYMBOL *)svp)->name,siz));
}

static int sym_cmp(void *svp1, void *svp2)
{
 return(string_cmpfxn(((SYMBOL *)svp1)->name,((SYMBOL *)svp2)->name));
}

static void setup_symtbl(void)
{
 symtbl = new_htable(sym_h,sym_cmp);
 makespecials();
}

static void initlisting(void)
{
 liststack = malloc(sizeof(LISTSTACK));
 liststack->link = 0;
 liststack->dolist = 0;
}

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

 i = 0;
 while (1)
  { for (;(i<65536)&&!wrotecore[i];i++) ;
    if (i >= 65536) return;
    for (j=i+1;(j<65536)&&wrotecore[j];j++) ;
    if (hexoutput)
     { fprintf(outf,"%04x %04x\n",i,j-i);
       for (;i<j;i++) fprintf(outf,"%02x\n",0xff&(int)core[i]);
     }
    else
     { while (i < j)
	{ if ((i & 1) || (i+1 >= j))
	   { fprintf(outf,"%06o %03o\n",i,0xff&(int)core[i]);
	     i ++;
	   }
	  else
	   { fprintf(outf,"%06o %06o\n",i,(0xff&(int)core[i])|((0xff&(int)core[i+1])<<8));
	     i += 2;
	   }
	}
     }
  }
}

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

 if (fn == 0)
  { f = fopen("/dev/null","w");
    if (f == 0)
     { fprintf(stderr,"%s: can't open /dev/null for %s\n",__progname,what);
       exit(1);
     }
  }
 else if (!strcmp(fn,"-"))
  { f = stdout;
  }
 else
  { f = fopen(fn,"w");
    if (f == 0)
     { fprintf(stderr,"%s: can't open %s for %s\n",__progname,fn,what);
       exit(1);
     }
  }
 return(f);
}

static int idcmp(void *idvp1, void *idvp2)
{
 return(strcmp(((INSTR_DEF *)idvp1)->name,((INSTR_DEF *)idvp2)->name));
}

static void init_assemble(void)
{
 static int done = 0;
 int i;
 void **idvp;

 if (done) return;
 done = 1;
 idvp = malloc(instr_def_n*sizeof(void *));
 for (i=instr_def_n-1;i>=0;i--) idvp[i] = &instr_defs[i];
 heap_sort(&idvp[0],instr_def_n,idcmp);
 id_names = malloc(instr_def_n*sizeof(INSTR_DEF *));
 for (i=0;i<instr_def_n;i++) id_names[i] = (INSTR_DEF *) idvp[i];
 free(idvp);
 svzero.type = SV_TYPE_SINT;
 svzero.u.i = izero;
}

static void init_input(const char *fn)
{
 FILE *f;
 INSTACK *is;

 f = fopen(fn,"r");
 if (f == 0)
  { fprintf(stderr,"%s: can't open %s for input\n",__progname,fn);
    exit(1);
  }
 is = malloc(sizeof(INSTACK));
 is->link = 0;
 is->name = copyofstr(fn);
 is->file = f;
 is->line = 1;
 inserial = 0;
 is->serial = inserial++;
 instack = is;
 instack_depth = 1;
}

static int endinclude(void)
{
 if (instack->link)
  { INSTACK *is;
    is = instack;
    instack = is->link;
    fclose(is->file);
    free(is->name);
    free(is);
    instack_depth --;
    asmlinc = 0;
    return(0);
  }
 return(1);
}

static void eat_newline(void)
{
 int l;

 l = strlen(line);
 if (l > 0)
  { if (line[l-1] == '\n')
     { line[l-1] = '\0';
       asmlinc = 1;
     }
    else
     { asmlinc = 0;
       if (l == MAXLINESIZ-1)
	{ asmwarn("Excessively long line, forcibly broken");
	}
       else
	{ asmwarn("Improperly terminated line");
	}
     }
  }
}

static STACKVAL popstack(void)
{
 STACKEL *e;
 STACKVAL rv;

 if (stack == 0) bugchk("stack underflow in popstack");
 e = stack->link;
 rv = stack->v;
 free(stack);
 stack = e;
 return(rv);
}

static void clearstack(void)
{
 while (stack) popstack();
}

static int clear_symset_aux(void *svp)
{
 ((SYMBOL *)svp)->flags &= ~SYM_F_SETYET;
 return(0);
}

static void clear_symset(void)
{
 map_htable(symtbl,clear_symset_aux);
}

static void pop_ifstack(void)
{
 IFSTACK *ifs;

 if (! ifstack) bugchk("pop_ifstack: no ifs on stack");
 ifs = ifstack->link;
 free(ifstack->name);
 free(ifstack);
 ifstack = ifs;
}

static void clear_ifstack(void)
{
 while (ifstack) pop_ifstack();
}

static int pop_liststack(void)
{
 if (liststack->link)
  { LISTSTACK *ls;
    ls = liststack->link;
    free(liststack);
    liststack = ls;
    return(1);
  }
 else
  { return(0);
  }
}

static void clear_liststack(void)
{
 while (pop_liststack()) ;
}

static void setlisting(int ison)
{
 dolisting = ison;
 if (dolisting && (unlisted_lines > 0))
  { fprintf(listf,"\t....\n");
    unlisted_lines = 0;
  }
}

static void assemble(void)
{
 asmfile = infile;
 asmerrs = 0;
 asm_secondpass = 0;
 asmline = 1;
 setdot(0);
 while (1)
  { if (pop_instack && endinclude()) break;
    pop_instack = 0;
    if (fgets(&line[0],MAXLINESIZ,inf) != &line[0])
     { pop_instack = 1;
       continue;
     }
    eat_newline();
    clearstack();
    asm_parse(line);
    asmline += asmlinc;
  }
#if 0
 dumpsyms();
#endif
 asm_secondpass = 1;
 clear_symset();
 rewind(inf);
 asmline = 1;
 setdot(0);
 clear_ifstack();
 clear_liststack();
 pop_instack = 0;
 unlisted_lines = 0;
 setlisting(1);
 while (1)
  { if (pop_instack && endinclude()) break;
    pop_instack = 0;
    if (fgets(&line[0],MAXLINESIZ,inf) != &line[0])
     { pop_instack = 1;
       continue;
     }
    eat_newline();
    clearstack();
    if (dolisting)
     { if (INFALSE())
	{ fprintf(listf,"------:");
	}
       else
	{ fprintf(listf,"%06o:",dot);
	}
       if (instack_depth > 1)
	{ fprintf(listf,"\t%d\t%s\n",instack_depth-1,&line[0]);
	}
       else
	{ fprintf(listf,"\t\t%s\n",&line[0]);
	}
     }
    else
     { unlisted_lines ++;
     }
    if (! asm_parse(line)) asmerr("Can't parse line");
    asmline += asmlinc;
  }
 while (ifstack)
  { if (ifstack->serial == instack->serial)
     { asmerr("Unclosed .if block (beginning at line %d)",ifstack->line);
     }
    else
     { asmerr("Unclosed .if block (beginning at line %d of file %s)",ifstack->line,ifstack->name);
     }
    pop_ifstack();
  }
 fclose(inf);
}

int main(int, char **);
int main(int ac, char **av)
{
 int skip;
 int errs;
 int argno;

 if (0)
  {
usage:;
    fprintf(stderr,"Usage: %s [-l listing-file] [-[oO] output-file] assembly-file\n",__progname);
    exit(1);
  }
 skip = 0;
 errs = 0;
 argno = 0;
 for (ac--,av++;ac;ac--,av++)
  { if (skip > 0)
     { skip --;
       continue;
     }
    if (**av == '-')
     { for (++*av;**av;++*av)
	{ if (0)
	   {
needarg:;
	     fprintf(stderr,"%s: -%c needs another argument\n",__progname,**av);
	     errs ++;
	     continue;
	   }
	  switch (**av)
	   { default:
		fprintf(stderr,"%s: bad flag -%c\n",__progname,**av);
		errs ++;
		break;
	     case 'l':
		if (++skip >= ac) goto needarg;
		listfile = av[skip];
		break;
	     case 'o': hexoutput = 1;
		if (0)
		 {
	     case 'O': hexoutput = 0;
		 }
		if (++skip >= ac) goto needarg;
		outfile = av[skip];
		break;
	   }
	}
     }
    else
     { switch (argno++)
	{ default:
	     fprintf(stderr,"%s: extra argument %s\n",__progname,*av);
	     errs ++;
	     break;
	  case 0:
	     argfn = *av;
	     break;
	}
     }
  }
 if (errs) goto usage;
 initcore();
 setup_symtbl();
 setdot(0);
 initlisting();
 stack = 0;
 ifstack = 0;
 if (! argfn) goto usage;
 pop_instack = 0;
 init_input(argfn);
 outf = openout(outfile,"output");
 listf = openout(listfile,"listing");
 init_assemble();
 assemble();
 dumpcore();
 fclose(inf);
 fclose(outf);
 fclose(listf);
 exit(0);
}

static void pushstack(STACKVAL v)
{
 STACKEL *e;

 e = malloc(sizeof(STACKEL));
 e->link = stack;
 e->v = v;
 stack = e;
}

static void push_ifstack(int cond)
{
 IFSTACK *ifs;

 ifs = malloc(sizeof(IFSTACK));
 ifs->infalse = ifstack && (ifstack->infalse || !ifstack->asmtrue);
 ifs->link = ifstack;
 ifstack = ifs;
 ifs->condtrue = cond;
 ifs->name = copyofstr(infile);
 ifs->serial = instack->serial;
 ifs->line = asmline;
 psop_ift();
}

static void push_liststack(void)
{
 LISTSTACK *ls;

 ls = malloc(sizeof(LISTSTACK));
 ls->link = liststack;
 liststack = ls;
 ls->dolist = ls->link->dolist;
}

static void push_input(const char *fn)
{
 FILE *f;
 INSTACK *is;

 f = fopen(fn,"r");
 if (f == 0)
  { fprintf(stderr,"%s: can't open %s for input\n",__progname,fn);
    return;
  }
 asmline += asmlinc;
 asmlinc = 0;
 is = malloc(sizeof(INSTACK));
 is->link = instack;
 is->name = copyofstr(fn);
 is->file = f;
 is->line = 1;
 is->serial = inserial++;
 instack = is;
 instack_depth ++;
}

static int digitval(char d)
{
 switch (d)
  { case '0':           return(0);  break;
    case '1':           return(1);  break;
    case '2':           return(2);  break;
    case '3':           return(3);  break;
    case '4':           return(4);  break;
    case '5':           return(5);  break;
    case '6':           return(6);  break;
    case '7':           return(7);  break;
    case '8':           return(8);  break;
    case '9':           return(9);  break;
    case 'a': case 'A': return(10); break;
    case 'b': case 'B': return(11); break;
    case 'c': case 'C': return(12); break;
    case 'd': case 'D': return(13); break;
    case 'e': case 'E': return(14); break;
    case 'f': case 'F': return(15); break;
    case 'g': case 'G': return(16); break;
    case 'h': case 'H': return(17); break;
    case 'i': case 'I': return(18); break;
    case 'j': case 'J': return(19); break;
    case 'k': case 'K': return(20); break;
    case 'l': case 'L': return(21); break;
    case 'm': case 'M': return(22); break;
    case 'n': case 'N': return(23); break;
    case 'o': case 'O': return(24); break;
    case 'p': case 'P': return(25); break;
    case 'q': case 'Q': return(26); break;
    case 'r': case 'R': return(27); break;
    case 's': case 'S': return(28); break;
    case 't': case 'T': return(29); break;
    case 'u': case 'U': return(30); break;
    case 'v': case 'V': return(31); break;
    case 'w': case 'W': return(32); break;
    case 'x': case 'X': return(33); break;
    case 'y': case 'Y': return(34); break;
    case 'z': case 'Z': return(35); break;
  }
 return(99);
}

static int cvtnum(unsigned char *bp, int base, DBLWORD *vp)
{
 unsigned short int si[4];
 int i;
 int j;
 unsigned long int t;

 for (j=0;j<4;j++) si[j] = 0;
 for (i=0;bp[i];i++)
  { t = digitval(bp[i]);
    if (t >= base) return(1);
    for (j=0;j<4;j++)
     { t += si[j] * base;
       si[j] = t & 0xffff;
       t >>= 16;
     }
    if (t) numberoverflow = 1;
  }
 vp->h = (si[3] << 16) | si[2];
 vp->l = (si[1] << 16) | si[0];
 return(0);
}

static void losebits(DBLWORD i, int m)
{
 if ( ((i.h != 0) || (i.l & ~m)) &&
      ((i.h != 0xffffffff) || ((i.l & ~m) != ~m)) )
  { asmwarn("Significant bits lost");
  }
}

static void assembleit(DBLWORD data, int nb)
{
 int nr;
 DBLWORD v;

 if (dolisting && asm_secondpass)
  { v = data;
    if (dot & 1)
     { fprintf(listf,"\t %03lo\n",v.l&0xff);
       v = shift64(v,-8);
       nr = nb - 1;
     }
    else
     { nr = nb;
     }
    for (;nr>1;nr-=2)
     { fprintf(listf,"\t %06lo\n",v.l&0xffff);
       v = shift64(v,-16);
     }
    if (nr) fprintf(listf,"\t    %03lo\n",v.l&0xff);
  }
 v = data;
 for (nr=nb;nr>0;nr--)
  { core[dot] = v.l & 0xff;
    wrotecore[dot] = 1;
    setdot(dot+1);
    v = shift64(v,-8);
  }
 for (nr=nb;nr>0;nr--)
  { v = shift64(v,8);
    if (v.l & 0x100) v.l |= 0xff;
  }
 if (((v.h != 0) || (v.l != 0)) && ((v.h != 0xffffffff) || (v.l != 0xffffffff))) asmwarn("Significant bits lost");
}

static void assemble_byte(DBLWORD b)
{
 assembleit(b,1);
}

static void assemble_word(DBLWORD w)
{
 assembleit(w,2);
}

static void assemble_long(DBLWORD l)
{
 assembleit(l,4);
}

static void assemble_quad(DBLWORD q)
{
 assembleit(q,8);
}

static word assemble_g_op(word *warr, int *wind, int mode, int rno, STACKVAL expr)
{
 switch (mode)
  { case 6:
    case 7:
    case 2 | 8:
    case 3 | 8:
       expr = typecvt(expr,SV_TYPE_UINT);
       losebits(expr.u.i,0xffff);
       warr[(*wind)++] = expr.u.i.l & 0xffff;
       break;
    case 6 | 8:
    case 7 | 8:
       expr = typecvt(expr,SV_TYPE_UINT);
       losebits(expr.u.i,0xffff);
       warr[*wind] = (expr.u.i.l & 0xffff) - (dot + (*wind << 1) + 2);
       (*wind) ++;
       break;
  }
 return(((mode&7)<<3)|rno);
}

static word assemble_fg_op(word *warr, int *wind, int mode, int rno, STACKVAL expr)
{
 switch (mode)
  { case 0:
       if (rno > 5) asmwarn("The %s instruction won't execute with f%o",asm_opcode->name,rno);
       break;
    case 2 | 8:
	{ unsigned long int f;
	  f = fround(typecvt(expr,SV_TYPE_F).u.f).l;
	  warr[(*wind)++] = f & 0xffff;
	  warr[(*wind)++] = (f >> 16) & 0xffff;
	}
       break;
    case 3 | 8:
       expr = typecvt(expr,SV_TYPE_UINT);
       losebits(expr.u.i,0xffff);
       warr[(*wind)++] = expr.u.i.l & 0xffff;
       break;
    case 6 | 8:
    case 7 | 8:
       expr = typecvt(expr,SV_TYPE_UINT);
       losebits(expr.u.i,0xffff);
       warr[*wind] = (expr.u.i.l & 0xffff) - (dot + (*wind << 1) + 2);
       (*wind) ++;
       break;
  }
 return(((mode&7)<<3)|rno);
}

static word assemble_dg_op(word *warr, int *wind, int mode, int rno, STACKVAL expr)
{
 switch (mode)
  { case 0:
       if (rno > 5) asmwarn("The %s instruction won't execute with f%o",asm_opcode->name,rno);
       break;
    case 2 | 8:
	{ DBLWORD d;
	  d = typecvt(expr,SV_TYPE_F).u.f;
	  warr[(*wind)++] = d.l & 0xffff;
	  warr[(*wind)++] = (d.l >> 16) & 0xffff;
	  warr[(*wind)++] = d.h & 0xffff;
	  warr[(*wind)++] = (d.h >> 16) & 0xffff;
	}
       break;
    case 3 | 8:
       expr = typecvt(expr,SV_TYPE_UINT);
       losebits(expr.u.i,0xffff);
       warr[(*wind)++] = expr.u.i.l & 0xffff;
       break;
    case 6 | 8:
    case 7 | 8:
       expr = typecvt(expr,SV_TYPE_UINT);
       losebits(expr.u.i,0xffff);
       warr[*wind] = (expr.u.i.l & 0xffff) - (dot + (*wind << 1) + 2);
       (*wind) ++;
       break;
  }
 return(((mode&7)<<3)|rno);
}

void asm_trace(int sno __attribute__((__unused__)), const char *sname __attribute__((__unused__)))
{
/* printf("%s\n",sname); */
}

int in_false_if(void)
{
 return(INFALSE());
}

int valid_opcode(void)
{
 int l;
 int m;
 int h;
 int c;

 for (c=0;asmname[c];c++)
  { if (isascii(asmname[c]) && isupper(asmname[c])) asmname[c] = tolower(asmname[c]);
  }
 l = -1;
 h = instr_def_n;
 while (h-l > 1)
  { m = (h + l) / 2;
    c = strcmp(&asmname[0],id_names[m]->name);
    if (c <= 0) h = m;
    if (c >= 0) l = m;
  }
 if (h != l) return(0);
 asm_opcode = id_names[h];
 return(1);
}

int instr_ops(INSTR_OPS fmt)
{
 return(asm_opcode->ops_format==fmt);
}

void last_operand(void)
{
 int i;
 int nwords;
 word words[16];

 if (dot & 1)
  { asmerr("Attempt to assemble an instruction at an odd location");
    setdot(dot+1);
  }
 nwords = 1;
 words[0] = asm_opcode->value;
 switch (asm_opcode->ops_format)
  { case OPS_NONE:
       break;
    case OPS_G0:
       words[0] |= assemble_g_op(&words[0],&nwords,asm_mode,asm_regno,asm_expr);
       break;
    case OPS_R0:
       words[0] |= asm_regno;
       break;
    case OPS_O30:
       asm_expr = typecvt(popstack(),SV_TYPE_UINT);
       if (asm_expr.u.i.h || (asm_expr.u.i.l & ~7))
	{ asmerr("The %s instruction requires a value 0 to 7",asm_opcode->name);
	}
       words[0] |= asm_expr.u.i.l & 7;
       break;
    case OPS_B80:
	{ word displ;
	  asm_expr = typecvt(popstack(),SV_TYPE_UINT);
	  displ = (asm_expr.u.i.l - (dot + 2)) & 0xffff;
	  if (displ & 1)
	   { asmerr("Attempt to branch to an odd address");
	     displ = 0;
	   }
	  displ = sxw(displ) >> 1;
	  if (((displ & 0xff80) != 0) && ((displ & 0xff80) != 0xff80))
	   { asmerr("Branch too far [from %o to %o, displ=0x%04x]",(dot+2)&0xffff,asm_expr.u.i.l&0xffff,displ);
	     displ = 0;
	   }
	  words[0] |= displ & 0xff;
	}
       break;
    case OPS_R6_G0:
       words[0] |= asm_regno1 << 6;
       words[0] |= assemble_g_op(&words[0],&nwords,asm_mode,asm_regno,asm_expr);
       break;
    case OPS_G0_R6:
       words[0] |= asm_regno << 6;
       words[0] |= assemble_g_op(&words[0],&nwords,asm_mode1,asm_regno1,asm_expr1);
       break;
    case OPS_G6_G0:
       words[0] |= assemble_g_op(&words[0],&nwords,asm_mode1,asm_regno1,asm_expr1) << 6;
       words[0] |= assemble_g_op(&words[0],&nwords,asm_mode,asm_regno,asm_expr);
       break;
    case OPS_R6_B60:
	{ word displ;
	  asm_expr = typecvt(popstack(),SV_TYPE_UINT);
	  words[0] |= asm_regno1 << 6;
	  displ = ((dot + 2) - asm_expr.u.i.l) & 0xffff;
	  if (displ & 1)
	   { asmerr("Attempt to branch to an odd address");
	     displ = 0;
	   }
	  if (displ & 0x8000)
	   { asmerr("The %s instruction can't branch forwards [from %o to %o, displ=0x%04x]",asm_opcode->name,dot+2,asm_expr,displ);
	     displ = 0;
	   }
	  displ >>= 1;
	  if (displ && ((displ & 0xffc0) != 0))
	   { asmerr("Branch too far [from %o to %o, displ=0x%04x]",dot+2,asm_expr,displ);
	     displ = 0;
	   }
	  words[0] |= displ & 0x3f;
	}
       break;
    case OPS_O80:
       asm_expr = typecvt(popstack(),SV_TYPE_UINT);
       if (asm_expr.u.i.h || (asm_expr.u.i.l & ~0xff))
	{ asmerr("The %s instruction requires a value 0 to 377 (255.)",asm_opcode->name);
	}
       words[0] |= asm_expr.u.i.l & 0xff;
       break;
    case OPS_O60:
       asm_expr = typecvt(popstack(),SV_TYPE_UINT);
       if (asm_expr.u.i.h || (asm_expr.u.i.l & ~077))
	{ asmerr("The %s instruction requires a value 0 to 77 (63.)",asm_opcode->name);
	}
       words[0] |= asm_expr.u.i.l & 077;
       break;
    case OPS_F0:
       words[0] |= assemble_fg_op(&words[0],&nwords,asm_mode,asm_regno,asm_expr);
       break;
    case OPS_FA6_F0:
       if (asm_regno1 > 3)
	{ asmerr("The %s instruction works only for registers f0-f3",asm_opcode->name);
	  asm_regno1 &= 3;
	}
       words[0] |= asm_regno1 << 6;
       words[0] |= assemble_fg_op(&words[0],&nwords,asm_mode,asm_regno,asm_expr);
       break;
    case OPS_F0_FA6:
       if (asm_regno > 3)
	{ asmerr("The %s instruction works only for registers f0-f3",asm_opcode->name);
	  asm_regno &= 3;
	}
       words[0] |= asm_regno << 6;
       words[0] |= assemble_fg_op(&words[0],&nwords,asm_mode1,asm_regno1,asm_expr1);
       break;
    case OPS_FA6_G0:
       if (asm_regno1 > 3)
	{ asmerr("The %s instruction works only for registers f0-f3",asm_opcode->name);
	  asm_regno1 &= 3;
	}
       words[0] |= asm_regno1 << 6;
       words[0] |= assemble_g_op(&words[0],&nwords,asm_mode,asm_regno,asm_expr);
       break;
    case OPS_G0_FA6:
       if (asm_regno > 3)
	{ asmerr("The %s instruction works only for registers f0-f3",asm_opcode->name);
	  asm_regno &= 3;
	}
       words[0] |= asm_regno << 6;
       words[0] |= assemble_g_op(&words[0],&nwords,asm_mode1,asm_regno1,asm_expr1);
       break;
    case OPS_D0:
       words[0] |= assemble_dg_op(&words[0],&nwords,asm_mode,asm_regno,asm_expr);
       break;
    case OPS_FA6_D0:
       if (asm_regno1 > 3)
	{ asmerr("The %s instruction works only for registers f0-f3",asm_opcode->name);
	  asm_regno1 &= 3;
	}
       words[0] |= asm_regno1 << 6;
       words[0] |= assemble_dg_op(&words[0],&nwords,asm_mode,asm_regno,asm_expr);
       break;
    case OPS_D0_FA6:
       if (asm_regno > 3)
	{ asmerr("The %s instruction works only for registers f0-f3",asm_opcode->name);
	  asm_regno &= 3;
	}
       words[0] |= asm_regno << 6;
       words[0] |= assemble_dg_op(&words[0],&nwords,asm_mode1,asm_regno1,asm_expr1);
       break;
    default:
       bugchk("invalid ops_format %d in last_operand",asm_opcode->ops_format);
       break;
  }
 for (i=0;i<nwords;i++)
  { DBLWORD dw;
    dw.l = 0xffff & (int)words[i];
    dw.h = 0;
    assemble_word(dw);
  }
}

void first_operand(void)
{
 asm_regno1 = asm_regno;
 asm_expr1 = asm_expr;
 asm_mode1 = asm_mode;
}

void set_float_size(int isdbl)
{
 doublefloat = isdbl;
}

void op_mode(int m)
{
 if ("\0\0\0\0\0\0\1\1\0\0\1\1\0\0\1\1"[m]) asm_expr = popstack();
 asm_mode = m;
}

void pc_mode(int m)
{
 asm_regno = 7;
 op_mode(m|8);
}

int set_regno(void)
{
 if ( ((asmname[0] == 'r') || (asmname[0] == 'R')) &&
      (asmname[1] >= '0') &&
      (asmname[1] <= '7') &&
      (asmname[2] == '\0') )
  { asm_regno = asmname[1] - '0';
    return(1);
  }
 if ( ((asmname[0] == 's') || (asmname[0] == 'S')) &&
      ((asmname[1] == 'p') || (asmname[1] == 'P')) &&
      (asmname[2] == '\0') )
  { asm_regno = 6;
    return(1);
  }
 if ( ((asmname[0] == 'p') || (asmname[0] == 'P')) &&
      ((asmname[1] == 'c') || (asmname[1] == 'C')) &&
      (asmname[2] == '\0') )
  { asm_regno = 7;
    return(1);
  }
 return(0);
}

void pop_value(void)
{
 popstack();
}

int set_fregno(void)
{
 if ( ((asmname[0] == 'f') || (asmname[0] == 'F')) &&
      (asmname[1] >= '0') &&
      (asmname[1] <= '5') &&
      (asmname[2] == '\0') )
  { asm_regno = asmname[1] - '0';
    return(1);
  }
 return(0);
}

void psop_iftf(void)
{
 if (! ifstack)
  { asmerr(".iftf not inside a .if block");
    return;
  }
 ifstack->asmtrue = !ifstack->infalse;
}

void psop_ift(void)
{
 if (! ifstack)
  { asmerr(".ift not inside a .if block");
    return;
  }
 ifstack->asmtrue = ifstack->condtrue && !ifstack->infalse;
}

void psop_iff(void)
{
 if (! ifstack)
  { asmerr(".iff not inside a .if block");
    return;
  }
 ifstack->asmtrue = !ifstack->condtrue && !ifstack->infalse;
}

void psop_endc(void)
{
 if (! ifstack)
  { asmerr(".endc with no matching .if");
    return;
  }
 pop_ifstack();
}

void psop_if_eq(void)
{
 asm_iftype = IF_EQ;
}

void psop_if_ne(void)
{
 asm_iftype = IF_NE;
}

void psop_if_gt(void)
{
 asm_iftype = IF_GT;
}

void psop_if_ge(void)
{
 asm_iftype = IF_GE;
}

void psop_if_le(void)
{
 asm_iftype = IF_LE;
}

void psop_if_lt(void)
{
 asm_iftype = IF_LT;
}

void psop_if_df(void)
{
 asm_iftype = IF_DF;
}

void psop_if_ndf(void)
{
 asm_iftype = IF_NDF;
}

void psop_doif(void)
{
 switch (asm_iftype)
  { case IF_EQ: push_ifstack(sv_cmp(popstack(),svzero) == 0); break;
    case IF_NE: push_ifstack(sv_cmp(popstack(),svzero) != 0); break;
    case IF_GT: push_ifstack(sv_cmp(popstack(),svzero) >  0); break;
    case IF_GE: push_ifstack(sv_cmp(popstack(),svzero) >= 0); break;
    case IF_LE: push_ifstack(sv_cmp(popstack(),svzero) <= 0); break;
    case IF_LT: push_ifstack(sv_cmp(popstack(),svzero) <  0); break;
    case IF_DF: push_ifstack(!!find_symbol(&asmname[0])); break;
    case IF_NDF: push_ifstack(!find_symbol(&asmname[0])); break;
    default: bugchk("bad iftype %d",asm_iftype);
  }
}

void psop_even(void)
{
 if (dot & 1) setdot(dot+1);
}

void psop_odd(void)
{
 if ((dot & 1) == 0) setdot(dot+1);
}

void begin_blocked_bytes(void)
{
}

void end_blocked_bytes(void)
{
}

void get_spaces(void)
{
 asm_parsegetarg()->flags |= FSM_FLAG_PARSE_BLANKS;
}

void set_ascii_term(char c)
{
 asm_termc = c;
}

int psop_ascii_term(char c)
{
 return(c==asm_termc);
}

void psop_ascii_char(char c)
{
 DBLWORD v;

 v.l = (unsigned char) c;
 v.h = 0;
 assemble_byte(v);
}

void warn_untermstring(void)
{
 asmerr("Missing string terminator");
}

void skip_spaces(void)
{
 asm_parsegetarg()->flags &= ~FSM_FLAG_PARSE_BLANKS;
}

void psop_ascii_expr(void)
{
 assemble_byte(typecvt(popstack(),SV_TYPE_UINT).u.i);
}

void psop_ascii_null(void)
{
 assemble_byte(izero);
}

void psop_align(void)
{
 STACKVAL sv;

 sv = typecvt(popstack(),SV_TYPE_UINT);
 if (sv.u.i.h || (sv.u.i.l & 0xffff0000))
  { setdot(0);
  }
 else
  { setdot(ROUNDUP(dot,sv.u.i.l));
  }
}

void psop_space(int factor)
{
 STACKVAL sv;

 sv = typecvt(popstack(),SV_TYPE_UINT);
 setdot(dot+(sv.u.i.l*factor));
}

void psop_db(void)
{
 assemble_byte(typecvt(popstack(),SV_TYPE_UINT).u.i);
}

void psop_dw(void)
{
 assemble_word(typecvt(popstack(),SV_TYPE_UINT).u.i);
}

void psop_dl(void)
{
 assemble_long(typecvt(popstack(),SV_TYPE_UINT).u.i);
}

void psop_dq(void)
{
 assemble_quad(typecvt(popstack(),SV_TYPE_UINT).u.i);
}

void psop_df(void)
{
 FLOAT f;
 DBLWORD l;

 f = fround(typecvt(popstack(),SV_TYPE_F).u.f);
 l.l = f.l;
 l.h = f.h;
 assemble_long(l);
}

void psop_dd(void)
{
 FLOAT f;
 DBLWORD q;

 f = typecvt(popstack(),SV_TYPE_F).u.f;
 q.l = f.l;
 q.h = f.h;
 assemble_quad(q);
}

void psop_list_on(void)
{
 setlisting(1);
}

void psop_list_off(void)
{
 setlisting(0);
}

void psop_list_push(void)
{
 push_liststack();
}

void psop_list_pop(void)
{
 if (! pop_liststack())
  { asmerr(".list pop with no corresponding .list push");
  }
 else
  { setlisting(dolisting);
  }
}

void psop_include_begin(char c)
{
 asm_termc = c;
 asmnamefill = 0;
 get_spaces();
}

int psop_include_end(char c)
{
 if (c == asm_termc)
  { skip_spaces();
    asmname[asmnamefill] = '\0';
    push_input(&asmname[0]);
    return(1);
  }
 return(0);
}

void psop_include_unterm(void)
{
 asmwarn("Unterminated .include name");
 asmname[asmnamefill] = '\0';
 push_input(&asmname[0]);
}

void psop_include_char(char c)
{
 asmname[asmnamefill++] = c;
}

void psop_end(int needpop)
{
 if (needpop) popstack();
 pop_instack = 1;
}

void warn_ignored(void)
{
 asmerr("Junk at end of line: %s",asm_parserest());
}

void begin_symbol(void)
{
 asmnamefill = 0;
 get_spaces();
}

void symbol_char(char c)
{
 asmname[asmnamefill++] = c;
}

void finish_symbol(void)
{
 asmname[asmnamefill] = '\0';
 skip_spaces();
}

void set_lc_start(void)
{
 asm_lcbegin = asm_parserest() - &line[0];
}

void do_lc(void)
{
 int end;
 int i;

 end = asm_parserest() - &line[0];
 for (i=asm_lcbegin;i<end;i++)
  { if (isascii(line[i]) && isupper(line[i])) line[i] = tolower(line[i]);
  }
}

void define_label(void)
{
 SYMBOL *s;

 s = find_symbol(&asmname[0]);
 if (s == sym_dot)
  { asmerr("Attempt to use `.' as a label");
    return;
  }
 if (asm_secondpass)
  { if (! s) asmerr("Label `%s' appeared in second pass",&assign_sym[0]);
    if (s->flags & SYM_F_SETYET)
     { asmerr("Redefinition of `%s'",s->name);
       return;
     }
    if (sv_cmp(s->value,sym_dot->value) != 0)
     { asmerr("Phase error: `%s' value changed",s->name);
       return;
     }
  }
 if (! s) s = new_symbol(&asmname[0]);
 s->value = sym_dot->value;
 s->flags |= SYM_F_SETYET;
}

void set_assign_sym(void)
{
 strcpy(&assign_sym[0],&asmname[0]);
}

void do_assignment(int defn)
{
 STACKVAL val;
 SYMBOL *s;

 val = popstack();
 if (! INFALSE())
  { s = find_symbol(&assign_sym[0]);
    if (! s)
     { if (defn && asm_secondpass)
	{ asmerr("Symbol `%s' appeared in the second pass",s->name);
	}
       s = new_symbol(&assign_sym[0]);
     }
    if (s->flags & SYM_F_SPECIAL)
     { (*s->specf)(s,SPECOP_SET,val);
     }
    else
     { if (defn && asm_secondpass)
	{ if (s->flags & SYM_F_SETYET)
	   { asmerr("Assignment to `%s', which already has a value",s->name);
	   }
	  else if (sv_cmp(s->value,val) != 0)
	   { asmerr("Phase error: `%s' value changed",s->name);
	   }
	}
       s->value = val;
       s->flags |= SYM_F_SETYET;
     }
  }
}

void dyad_op_str(const char *s)
{
 STACKVAL v;

 v.type = SV_TYPE_OP2;
      if (!strcmp(s,"||")) v.u.op = OP_LOR;
 else if (!strcmp(s,"&&")) v.u.op = OP_LAND;
 else if (!strcmp(s,"==")) v.u.op = OP_EQ;
 else if (!strcmp(s,"!=")) v.u.op = OP_NEQ;
 else if (!strcmp(s,"<=")) v.u.op = OP_LE;
 else if (!strcmp(s,">=")) v.u.op = OP_GE;
 else if (!strcmp(s,"<<")) v.u.op = OP_LSH;
 else if (!strcmp(s,">>")) v.u.op = OP_RSH;
 else bugchk("bad str %s to dyad_op_str",s);
 pushstack(v);
}

void combine_op(void)
{
 STACKVAL lhs;
 STACKVAL rhs;
 STACKVAL op;
 STACKVAL res;

 rhs = popstack();
 op = popstack();
#if 0
 printf("combine_op:\n");
 printsv("\trhs = ",rhs);
 printsv("\top  = ",op);
#endif
 switch (op.type)
  { case SV_TYPE_OP1:
       switch (op.u.op)
	{ default:
	     bugchk("invalid monadic op %d",(int)op.u.op);
	     break;
	  case OP_UMINUS: res = sv_neg(rhs); break;
	  case OP_UTILDE: res = sv_com(rhs); break;
	  case OP_UBANG:  res = sv_makebool(sv_cmp(rhs,svzero)!=0); break;
	  case OP_IASF:   { res.type = SV_TYPE_F; res.u.f = typecvt(rhs,SV_TYPE_UINT).u.i; } break;
	  case OP_FASI:   { res.type = SV_TYPE_UINT; res.u.i = typecvt(rhs,SV_TYPE_F).u.f; } break;
	  case OP_FIX:    res = typecvt(rhs,SV_TYPE_SINT); break;
	  case OP_TRUNC:  { res.type = SV_TYPE_UINT; res.u.i = f_to_i64(typecvt(rhs,SV_TYPE_F).u.f,1,0); } break;
	  case OP_ROUND:  { res.type = SV_TYPE_UINT; res.u.i = f_to_i64(typecvt(rhs,SV_TYPE_F).u.f,1,1); } break;
	  case OP_FLOAT:  res = typecvt(rhs,SV_TYPE_F); break;
	}
       break;
    case SV_TYPE_OP2:
       lhs = popstack();
#if 0
       printsv("\tlhs = ",lhs);
#endif
       switch (op.u.op)
	{ default:
	     bugchk("invalid dyadic op %d",(int)op.u.op);
	     break;
	  case OP_OR:   res = sv_or(lhs,rhs);  break;
	  case OP_XOR:  res = sv_xor(lhs,rhs); break;
	  case OP_AND:  res = sv_and(lhs,rhs); break;
	  case OP_LT:   res = sv_makebool(sv_cmp(lhs,rhs)<0); break;
	  case OP_GT:   res = sv_makebool(sv_cmp(lhs,rhs)>0); break;
	  case OP_ADD:  res = sv_add(lhs,rhs); break;
	  case OP_SUB:  res = sv_sub(lhs,rhs); break;
	  case OP_MUL:  res = sv_mul(lhs,rhs); break;
	  case OP_DIV:  res = sv_div(lhs,rhs); break;
	  case OP_MOD:  res = sv_mod(lhs,rhs); break;
	  case OP_LOR:  res = sv_makebool(sv_cmp(lhs,svzero)||sv_cmp(rhs,svzero)); break;
	  case OP_LAND: res = sv_makebool(sv_cmp(lhs,svzero)&&sv_cmp(rhs,svzero)); break;
	  case OP_EQ:   res = sv_makebool(sv_cmp(lhs,rhs)==0); break;
	  case OP_NEQ:  res = sv_makebool(sv_cmp(lhs,rhs)!=0); break;
	  case OP_LE:   res = sv_makebool(sv_cmp(lhs,rhs)<=0); break;
	  case OP_GE:   res = sv_makebool(sv_cmp(lhs,rhs)>=0); break;
	  case OP_LSH:  res = sv_lsh(lhs,rhs); break;
	  case OP_RSH:  res = sv_rsh(lhs,rhs); break;
	}
       break;
    default:
       bugchk("non-op on stack in combine_op");
       break;
  }
#if 0
 printsv("\tres = ",res);
#endif
 pushstack(res);
}

void pop_op(void)
{
 popstack();
}

void dyad_op(char c)
{
 STACKVAL v;

 v.type = SV_TYPE_OP2;
 switch (c)
  { case '|': v.u.op = OP_OR;  break;
    case '^': v.u.op = OP_XOR; break;
    case '&': v.u.op = OP_AND; break;
    case '<': v.u.op = OP_LT;  break;
    case '>': v.u.op = OP_GT;  break;
    case '+': v.u.op = OP_ADD; break;
    case '-': v.u.op = OP_SUB; break;
    case '*': v.u.op = OP_MUL; break;
    case '/': v.u.op = OP_DIV; break;
    case '%': v.u.op = OP_MOD; break;
    default: bugchk("bad char %c to dyad_op",c); break;
  }
 pushstack(v);
}

void monad_op(char c)
{
 STACKVAL v;

 v.type = SV_TYPE_OP1;
 switch (c)
  { case '-': v.u.op = OP_UMINUS; break;
    case '~': v.u.op = OP_UTILDE; break;
    case '!': v.u.op = OP_UBANG;  break;
    default: bugchk("bad char %c to monad_op",c); break;
  }
 pushstack(v);
}

void monad_op_str(const char *s)
{
 STACKVAL v;

 v.type = SV_TYPE_OP1;
      if (!strcmp(s,"iasf"))  v.u.op = OP_IASF;
 else if (!strcmp(s,"fasi"))  v.u.op = OP_FASI;
 else if (!strcmp(s,"fix"))   v.u.op = OP_FIX;
 else if (!strcmp(s,"trunc")) v.u.op = OP_TRUNC;
 else if (!strcmp(s,"round")) v.u.op = OP_ROUND;
 else if (!strcmp(s,"float")) v.u.op = OP_FLOAT;
 else bugchk("bad str %s to monad_op_str",s);
 pushstack(v);
}

void symbol_value(void)
{
 SYMBOL *s;
 STACKVAL v;

 s = find_symbol(&asmname[0]);
 if (s)
  { v = s->value;
  }
 else
  { asmerr("Undefined symbol `%s'",&asmname[0]);
    v = svzero;
  }
 pushstack(v);
}

int finish_number(void)
{
 STACKVAL v;

 skip_spaces();
 numberdigits[nnumberdigits] = '\0';
 if (numberbase == 0)
  { v.type = SV_TYPE_F;
    if (floatexpsign < 0) floatexp = - floatexp;
    floatexp += (floatscale < 0) ? nnumberdigits : floatscale;
    if (0)
     {
overflow:;
       asmwarn("Number `%s' overflows",&numberdigits[0]);
       v.u.f = fmax;
     }
    else if (0)
     {
underflow:;
       asmwarn("Number `%s' underflows",&numberdigits[0]);
       v.u.f = fzero;
     }
    else
     { int i;
       int j;
       int k;
       int p;
       int exp2;
       char num[MAXDDIG];
       char mul[MAXDDIG];
       char prod[MAXDDIG];
       char bits[WORKBITS];
       static struct {
		int exp2;
		const char *mul;
		} exptab_[] = {
#include "fcvt-exptab"
				};
       static char mantbits[MAXDDIG][WORKBITS] = {
#include "fcvt-mantbits"
						   };
#define exptab (&exptab_[EXPTABOFF])
       if (floatexp < EXPTABMIN) goto underflow;
       if (nnumberdigits > MAXDDIG) nnumberdigits = MAXDDIG;
       for (i=0;i<nnumberdigits;i++) num[i] = numberdigits[i] - '0';
       for (;i<MAXDDIG;i++) num[i] = 0;
retry:;
       if (floatexp > EXPTABMAX) goto overflow;
       exp2 = exptab[floatexp].exp2;
       for (i=0;i<MAXDDIG;i++) mul[i] = exptab[floatexp].mul[i] - '0';
       p = 0;
       for (k=(MAXDDIG-1)*2;k>=MAXDDIG;k--)
	{ for (i=MAXDDIG-1,j=k-(MAXDDIG-1);j<MAXDDIG-1;i--,j++) p += num[i] * mul[j];
	  p /= 10;
	}
       for (;k>=0;k--)
	{ for (i=0,j=k;j>=0;i++,j--) p += num[i] * mul[j];
	  prod[k] = p % 10;
	  p /= 10;
	}
       if (p)
	{ floatexp ++;
	  goto retry;
	}
       p = 0;
       for (k=WORKBITS-1;k>=0;k--)
	{ for (j=0;j<MAXDDIG;j++) if (mantbits[j][k]) p += prod[j];
	  bits[k] = p & 1;
	  p >>= 1;
	}
       if (p) bugchk("overflow %d in converting float mantissa from decimal to binary",p);
       for (i=0;(i<WORKBITS)&&!bits[i];i++) ;
       if (i < WORKBITS)
	{ SPLITFLOAT sf;
	  for (j=64+i;(j>=0)&&bits[j];j--) bits[j] = 0;
	  if (j < 0)
	   { bits[0] = 1;
	     exp2 ++;
	     i = 0;
	   }
	  else
	   { bits[j] = 1;
	     if (j < i) i --;
	   }
	  exp2 -= i;
	  if (exp2 > 0x7f) goto overflow;
	  if (exp2 < -0x7f) goto underflow;
	  if (i > 0) bcopy(&bits[i],&bits[0],64);
	  sf.sign = 0;
	  sf.exp = exp2 + 0x80;
	  sf.mant.h = 0;
	  for (i=0;i<=23;i++) sf.mant.h = (sf.mant.h << 1) | bits[i];
	  sf.mant.l = 0;
	  for (i=24;i<=55;i++) sf.mant.l = (sf.mant.l << 1) | bits[i];
	  v.u.f = unsplit(sf);
	}
       else
	{ v.u.f = fzero;
	}
#undef exptab
     }
  }
 else if (numberbase == 256)
  { if (nnumberdigits > 1)
     { v.type = SV_TYPE_UINT;
       v.u.i.l = (numberdigits[1] << 8) | numberdigits[0];
     }
    else
     { v.type = SV_TYPE_SINT;
       v.u.i.l = numberdigits[0];
     }
    v.u.i.h = 0;
  }
 else
  { DBLWORD val;
    val.h = 0;
    val.l = 0;
    if (cvtnum(&numberdigits[0],numberbase,&val)) return(0);
    v.type = (numberunsigned || (val.h & 0x80000000)) ? SV_TYPE_UINT : SV_TYPE_SINT;
    v.u.i = val;
    if (numberoverflow) asmwarn("Number `%s' overflows",&numberdigits[0]);
  }
 pushstack(v);
 return(1);
}

int init_number(int n)
{
 if ((n != 0) && (n != 256) && ((n < 2) || (n > 36))) return(0);
 numberbase = n;
 nnumberdigits = 0;
 floatscale = -1;
 numberunsigned = 0;
 get_spaces();
 return(1);
}

int store_number_digit(char c)
{
 numberdigits[nnumberdigits++] = c;
 return(digitval(c)<numberbase);
}

void store_float_point(void)
{
 floatscale = nnumberdigits;
}

int float_noexp_ok(void)
{
 if ((nnumberdigits > 0) && (floatscale >= 0) && (floatscale < nnumberdigits))
  { floatexpsign = 1;
    floatexp = 0;
    return(1);
  }
 else
  { return(0);
  }
}

int have_a_digit(void)
{
 return(nnumberdigits>0);
}

void set_float_exp_sign(int sgn)
{
 floatexpsign = sgn;
}

void set_float_exp(int e)
{
 floatexp = e;
}

int defnumberbase(void)
{
 return(defbase);
}

int prefixed_ok(void)
{
 return(defbase<=16);
}

#if 0

static void printsv(const char *tag, STACKVAL sv)
{
 printf("%s",tag);
 switch (sv.type)
  { case SV_TYPE_SINT: printf("SINT %08lx%08lx\n",sv.u.i.h,sv.u.i.l); break;
    case SV_TYPE_F:   { SPLITFLOAT sf; sf = split(sv.u.f); printf("F S=%d EXP=%02x MANT=%06lx%08lx\n",sf.sign,sf.exp,sf.mant.h,sf.mant.l); } break;
    case SV_TYPE_OP1: printf("OP1 0x%x\n",(int)sv.u.op); break;
    case SV_TYPE_OP2: printf("OP2 0x%x\n",(int)sv.u.op); break;
    default:          printf("<bad type %d>\n",sv.type); break;
  }
}

static int sxb(byte b)
{
 return((b&0x80)?((~0U)<<8)|b:b);
}

static int zxw(word w)
{
 return(0xffff&(int)w);
}

static int zxb(byte b)
{
 return(0xff&(int)b);
}

static DBLWORD f_to_s64(FLOAT f, int rnd)
{
 return(f_to_i64(f,1,rnd));
}

static DBLWORD f_to_u64(FLOAT f, int rnd)
{
 return(f_to_i64(f,0,rnd));
}

static int dumpsym(void *svp)
{
 SYMBOL *s;
 STACKVAL v;

 s = svp;
 v = typecvt(s->value,SV_TYPE_UINT);
 printf("%s, value %o\n",s->name,0xffff&(int)v.u.i.l);
 return(0);
}

static void dumpsyms(void)
{
 map_htable(symtbl,dumpsym);
}

static int defbase_is(int n)
{
 return(defbase==n);
}

static void set_number_unsigned(void)
{
 numberunsigned = 1;
}

static void dumpdigits(char *dp, int nd)
{
 int i;
 char buf[1024];

 for (i=0;i<nd;i++) buf[i] = '0' + dp[i];
 buf[i] = '\0';
 printf("%s\n",&buf[0]);
}

#endif