/* dirs.c -- STAR Assembler Directives and Pseudo Ops

This file is part of STAR, the Saturn Macro Assembler.

   STAR is not distributed by the Free Software Foundation. Do not ask
them for a copy or how to obtain new releases. Instead, send e-mail to
the address below. STAR is merely covered by the GNU General Public
License.

Please send your comments, ideas, and bug reports to
Jan Brittenson <bson@ai.mit.edu>

*/


/* Copyright (C) 1990, 1991 Jan Brittenson.

   STAR is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 1, or (at your option) any
later version.

   STAR is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
for more details.

   You should have received a copy of the GNU General Public License
along with STAR; see the file COPYING. If not, to obtain a copy, write
to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139,
USA, or send e-mail to bson@ai.mit.edu. */


#include <stdio.h>
#include <math.h>
#include "sects.h"
#include "star.h"
#include "symbols.h"


/* Globals */
extern SYM_ROOT
  *symtbl;

extern long
  loc;

extern
  mustbe(), cifnest, ciftrue, cifsave;

extern char
  nextch();

extern void
  getblock();

extern struct val
  toint(), tostr(), val_zero, val_one, evexpr();

int
  macro_invocation;		/* True if macro invocation */

char
  getblock_term[132];		/* getblock() terminator */

static dummy;


void block_copy(s,d,n)
  register char *s, *d;
  register n;
{
  while(n--) *d++ = *s++;
}


void block_clear(d,n)
  register char *d;
  register n;
{
  while(n--) *d++ = '\0';
}


int block_compare(b1, b2, n)
  register unsigned char *b1, *b2;
  register n;
{
  register tmp;

  while(n--)
    if(tmp = *b1++ - *b2++)
      return(tmp);

  return(0);
}


/* Return size of field in nibbles */
fnibbles(f)
  int f;
{
  switch(f)
    {
    case F_X: return(3);
    case F_B: return(2);
    case F_W: return(16);
    case F_A: return(5);
    default:
      return(1);
    }
}


/* Value node constructor */
struct vnode *new_vnode(v)
  struct val v;
{
  register struct vnode *vtmp;
  extern char *malloc();

  if(!(vtmp = (struct vnode *) malloc(sizeof(struct vnode))))
    fatal("Can't allocate %d bytes for value node", sizeof(struct vnode));

  vtmp->vlink = NULL;
  vtmp->value = v;
  return(vtmp);
}


/* Instantiate symbol to new value */
void instantiate(s, v)
  struct sstruct *s;
  struct val v;
{
  struct vnode *vn;

  if(!s)
    return;

  if(s->flags & F_UDF)
    {
      s->flags &= ~(F_UDF|F_HID);
      s->value = v;
      s->vlink = NULL;
      return;
    }

  vn = new_vnode(s->value);
  vn->vlink = s->vlink;
  s->vlink = vn;
  s->value = v;
  s->flags &= ~(F_HID|F_UDF);
}


/* Deallocate value */
void free_val(v)
  struct val v;
{
  struct marg *ma;
  char **l;
  extern isexpr_data();


  switch(v.type)
    {
    case VT_STR: 

      if(!isexpr_data(v.vstr))
	free(v.vstr); 

      break;

    case VT_OP:
    case VT_SECT:
    case VT_REAL:
    case VT_INT: return;
    case VT_MAC:

      for(ma = v.vmacro->args; ma < v.vmacro->args + v.vmacro->nargs; ma++)
	if(ma->def)
	  free(ma->def);

      free(v.vmacro->args);

      for(l = v.vmacro->lines; l < v.vmacro->lines + v.vmacro->nlines;
	  free(*l++));

      free(v.vmacro);
      return;

    default:

      fatal("Attempted to free bogus value, type is %d", v.type);
    }
}


/* Deinstantiate symbol to previous value */
void deinstantiate(s)
  struct sstruct *s;
{
  struct vnode *vn;

  if(!s)
    return;

  if(!(s->flags & F_UDF))
    free_val(s->value);

  /* No previous value */
  if(!s->vlink)
    {
      s->value = val_zero;
      s->flags |= F_UDF|F_HID;
      return;
    }

  vn = s->vlink;
  s->vlink = vn->vlink;
  s->value = vn->value;

  free(vn);
}


/* Wrap string into value */
struct val strval(s)
  char *s;
{
  struct val tmp;
  extern char *expr_strdup();

  tmp.type = VT_STR;
  tmp.vstr = expr_strdup(s);

  return(tmp);
}

  
/* Get macro argument */
static char *get_macro_arg(cpp)
  char **cpp;
{
  char *tmp, *cp;
  extern char *expr_allp;
  
  if(!cpp || !*cpp)
    return("");

  *cpp = byspace(*cpp);
  
  tmp = *cpp;

  /* Scan until comma or comment */
  while(**cpp && **cpp != ',' && **cpp != ';')
    if(**cpp == '\\' && (*cpp)[1])
      (*cpp) += 2;
    else
      if(**cpp == '`')
	{
	  char *allp_save = expr_allp;
	  extern char *str();
	  
	  str(cpp);
	  expr_allp = allp_save;
	}
      else
	(*cpp)++;

  *(*cpp)++ = '\0';

  *cpp = byspace(*cpp);

  /* Test if end of line */
  if(**cpp < '\040' || **cpp == ';')
    *cpp = NULL;

  /* Eliminate trailing blanks */
  for(cp = tmp+strlen(tmp); cp > tmp && cp[-1] <= ' '; cp--);
  *cp = '\0';

  return(tmp);
}


/* Expand body of lines */
void expand_body(body, nlines)
  char **body;
  int nlines;
{
  extern char inbuf[], *inp;
  extern pass, exit_asm, exit_file;
  extern long loc0, loc;
  long shallow_loc0 = loc0;
  char **l;
  int prev_macinc = macro_invocation;

  macro_invocation = TRUE;

  for(l = body; l < body + nlines && !exit_file && !exit_asm; l++)
    {
      strcpy(inbuf, *l);	/* Copy line to input buffer */

      inp     = inbuf;		/* Reset scan pointer */
      loc0    = loc;		/* Reloc from here */

      strcpy(inbuf,		/* Expand &sym entries */
	     expand_symbols(inbuf)); 

      scanlabel();		/* Scan line for label */

      if(*inp)
	assemble_line();	/* Assemble line contents */

      deflabel();		/* Define label, if any */
    }

  loc0 = shallow_loc0;
  macro_invocation = prev_macinc;
}


/* Expand macro */
void expand_macro(m, cp)
  struct macro *m;
  char *cp;
{
  char *arg, **l, *passlabel, *pcp;
  struct marg *ma;
  extern char
    label_pass3[], label[];
  struct val v;
  extern pass, ciftrue;


  passlabel = (pass == 3 ? label_pass3 : label);

  /* Instantiate label, if any */
  if(m->label)
    instantiate(m->label, solidify(strval(passlabel)));
  else
    deflabel();


  /* Loop variables/arguments, and instantiate */
  cp = byspace(cp);

  if(!*cp || *cp == ';')
    cp = NULL;

  for(ma = m->args; ma < m->args + m->nargs; ma++)
    {
      if(pcp = cp)
	v = strval(get_macro_arg(&cp));

      if(pcp && v.vstr[0])
	instantiate(ma->argsym, solidify(v));
      else
	if(ma->def)
	  instantiate(ma->argsym, solidify(strval(ma->def)));
	else
	  {
	    /* Error, missing argument; deinstantiate all
	     * symbols instantiated
	     */
	    sgnerr("Missing required macro argument `%s'", ma->argsym->name);
	    
	    for(; ma > m->args; --ma)
	      deinstantiate(ma->argsym);
	    
	    if(m->label)
	      deinstantiate(m->label);
	    
	    return;
	  }
    }

  /* Loop macro body and assemble */
  expand_body(m->lines, m->nlines);

  /* Deinstantiate symbols */
  if(m->label)
    deinstantiate(m->label);

  for(ma = m->args; ma < m->args + m->nargs; ma++)
    deinstantiate(ma->argsym);
}


/* Parse integer parameter.
 * The 'cpp' parameter is set to NULL if last parameter.
 */
static INT getpar(cpp, low, high, dname)
  char **cpp, *dname;
  INT low;
  unsigned INT high;
{
  INT tmp;
  
  *cpp = byspace(*cpp);
  
  /* Evaluate expression */
  tmp = toint(evexpr(cpp)).vint;
  *cpp = byspace(*cpp);
  
  /* Test if end of line */
  if(**cpp < '\040' || **cpp == ';')
    *cpp = NULL;
  else
    mustbe(cpp, ',');
  
  
  if(high && low &&
     ((tmp > 0 && (unsigned INT) tmp > high) || 
      (tmp < 0 && tmp < low)))
    {
      sgnerr("Value of %ld not consistent with %s data", (long) tmp, dname);
      tmp = 0;
    }
  
  return(tmp);
}


/* Parse symbol name parameter.
 * The 'cpp' parameter is set to NULL if last symbol.
 */
static char *getsym(cpp)
  char **cpp;
{
  char *name1, *name, chsav;
  extern char *scansym(), *expr_strdup();
  extern void verify_symbol_name();
  
  if(!cpp || !*cpp)
    return("L__nn__");

  *cpp = byspace(*cpp);
  
  /* Scan symbol name */
  name1 = scansym(cpp, &chsav);
  name = expr_strdup(name1);
  name1[strlen(name1)] = chsav;

  *cpp = byspace(*cpp);
  
  /* Test if end of line */
  if(**cpp < '\040' || **cpp == ';')
    *cpp = NULL;
  else
    mustbe(cpp, ',');
  
  verify_symbol_name(name);

  return(name);
}


/* Get string parameter.
 * The 'cpp' parameter is set to NULL if last parameter.
 */
static char *getstrpar(cpp)
  char **cpp;
{
  char *tmp;
  
  *cpp = byspace(*cpp);
  
  /* Evaluate expression */
  tmp = tostr(evexpr(cpp)).vstr;
  *cpp = byspace(*cpp);
  
  
  /* Test if end of line */
  if(**cpp < '\040' || **cpp == ';')
    *cpp = NULL;
  else
    {
      mustbe(cpp, ',');
      *cpp = byspace(*cpp);
    }

  return(tmp);
}


/* Get real parameter.
 * The 'cpp' parameter is set to NULL if last parameter.
 */
static REAL getrealpar(cpp)
  char **cpp;
{
  REAL tmp;
  
  *cpp = byspace(*cpp);
  
  /* Evaluate expression */
  tmp = toreal(evexpr(cpp)).vdouble;
  *cpp = byspace(*cpp);
  
  
  /* Test if end of line */
  if(**cpp < '\040' || **cpp == ';')
    *cpp = NULL;
  else
    {
      mustbe(cpp, ',');
      *cpp = byspace(*cpp);
    }

  return(tmp);
}


/* BYTE pseudo op
 * Format:
 *	byte	expr, expr, expr, expr...
 */
void dbyte(ip, cp)
  char *cp;
  struct istruct *ip;
{
  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  while(cp)
    code2(getpar(&cp, (INT) -128, (INT) 255, "byte"));
}


/* Code 10's complement bcd number.
 * In reverse order, if `revflag' is nonzero.
 */
void codebcd(digits, value)
  int digits;
  REAL value;
{
  int d, negativep = FALSE;

  if(value < 0.0)
    {
      negativep = TRUE;
      value = -value;
    }
      
  for(d = digits-1; d > 0; d--, value *= 10);

  for(d = digits; d > 0; d--, value /= 10)
    if(negativep)
      code1(0xa - (int) fmod(value, 10.0));
    else
      code1((int) fmod(value, 10.0));
}


/* DOUBLE pseudo op
 * Format:
 *	double	expr, expr, expr, expr...
 */
void ddouble(ip, cp)
  char *cp;
  struct istruct *ip;
{
  REAL d;
  int xs;
  extern eol();

  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  while(cp)
    {
      d = getrealpar(&cp);

      xs = EXPONENT(d);

      if(xs >= 0)
	code3(xs);
      else
	{
	  int axs = -xs;
	  code3(0x99a -
		(((axs / 100) << 8) |
		 (((axs / 10) % 10) << 4) |
		 (axs % 10) ));
	}

      d /= pow(10.0, (REAL) xs);
      codebcd(12, (d < 0.0 ? -d : d));
      code1(d < 0.0 ? 9 : 0);
    }
}	  


/* DATA pseudo op
 * Format:
 *	DATA.[nf] expr, expr, expr, expr...
 */
void ddata(ip, cp)
  char *cp;
  struct istruct *ip;
{
  char fname[32];
  int f;
  INT fmini;
  unsigned INT fmaxi;

  decode_suffix(&cp, &f, FT_FIX|FT_N);

  if(!ciftrue)
    return;

  if(f & F_N)
    f &= 077;
  else
    {
      if(f != F_X && f != F_B && f != F_W && f != F_A)
	{
	  sgnerr("Inconsistent data suffix");
	  f = F_A;
	}

      f = fnibbles(f);
    }

  fmaxi = ((INT) 1 << (f * 4)) - 1;
  fmini = - ((INT) 1 << (f * 4 - 1));

  switch(f)
    {
    case 2: strcpy(fname, "byte"); break;
    case 1: strcpy(fname, "nibble"); break;
    default:      
      sprintf(fname, "%d-nibble", f);
    }

  while(cp)
    if(f == 16)
      coden(f, getpar(&cp, (INT) 0, (unsigned INT) 0, fname));
    else
      coden(f, getpar(&cp, (INT) fmini, (unsigned INT) fmaxi, fname));
}


/* EVEN
 * Output zero nibble if odd address.
 */
void deven(ip, cp)
  struct istruct *ip;
  char *cp;
{
  extern long loc0;

  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  if(loc0 & 1)
    code1(0);
}


/* ODD
 * Output zero nibble if even address.
 */
void dodd(ip, cp)
  struct istruct *ip;
  char *cp;
{
  extern long loc0;

  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  if(!(loc0 & 1))
    code1(0);
}


/* Test if end of line */
eol(cpp)
  char **cpp;
{
  return(!cpp || !*cpp || !*(*cpp = byspace(*cpp)) || **cpp == ';');
}


/* Make sure there is nothing more */
nomore(cpp)
  char **cpp;
{
  if(!eol(cpp))
    sgnerr("Excessive chars or missing operator");
}


/* Evaluate one argument and make sure there isn't anything more */
struct val ev1arg(cpp)
  char **cpp;
{
  struct val tmp;
  
  /* Skip spaces, and evaluate expression */
  *cpp = byspace(*cpp);
  tmp = evexpr(cpp);
  
  /* Make sure there isn't anything more */
  nomore(cpp);
  *cpp = NULL;
  return(tmp);
}


/* Test if nested */
isnested()
{
  if(cifnest == 0)
    {
      sgnerr("Not inside conditional body");
      cifnest = 1;
      return(FALSE);
    }

  return(TRUE);
}


/* IF
 * Format:
 *	if expr
 */
void dif(ip, cp)
  struct istruct *ip;
  char *cp;
{
  int tmp;
  
  decode_suffix(&cp, &dummy, FT_NONE);

  /* One more level of conditional if nesting */
  if(cifnest >= 15)
    {
      sgnerr("Conditional nesting too deep");
      return;
    }
  cifnest++;
  
  cifsave = (cifsave << 1) | ciftrue;
  
  /* Evaluate single argument, and change true bit */
  ciftrue = !!toint(ev1arg(&cp)).vint;

  if(!(cifsave & 1))
    ciftrue = FALSE;
}


/* ELSE
 * Format:
 *	else
 */
void delse(ip, cp)
  struct istruct *ip;
  char *cp;
{
  decode_suffix(&cp, &dummy, FT_NONE);

  /* Make sure we're nested */
  isnested();
  nomore(&cp);
  
  /* Toggle true bit */
  if(cifsave & 1)
    ciftrue = !ciftrue;
}


/* ANY
 * Format:
 *	any
 */
void dany(ip, cp)
  struct istruct *ip;
  char *cp;
{
  decode_suffix(&cp, &dummy, FT_NONE);

  /* Make sure we're nested */
  isnested();
  nomore(&cp);
  
  /* Set flag */
  ciftrue = cifsave & 1;
}


/* ENDIF
 * Format:
 *	endif
 */
void dendif(ip, cp)
  struct istruct *ip;
  char *cp;
{
  decode_suffix(&cp, &dummy, FT_NONE);

  /* Make sure we're nested */
  isnested();
  nomore(&cp);
  
  /* Drop one level */
  --cifnest;
  ciftrue = cifsave & 1;
  cifsave >>= 1;
}


/* Free body of lines */
void free_body(body, nlines)
  char **body;
  int nlines;
{
  char **l;

  for(l = body; nlines > 0; free(*l++), nlines--);

  free(body);
}


/* REPT
 * Format:
 *	rept expr
 *      ...block...
 *      endrept
 */
void drept(ip, cp)
  struct istruct *ip;
  char *cp;
{
  INT counter;
  char **reptbody;
  int reptlines;
  extern FILE *sourcefile;

  decode_suffix(&cp, &dummy, FT_NONE);

  getblock(&reptbody, &reptlines, "ENDREPT", FALSE, FALSE);

  if(!ciftrue)
    return;

  /* Keep looping body */
  for(counter = toint(evexpr(&cp)).vint; counter > 0; counter--)
    expand_body(reptbody, reptlines);
      
  free_body(reptbody, reptlines);
}


/* DEFINE
 * Format:
 *	define	symbol expr
 */
void ddef(ip, cp)
  struct istruct *ip;
  char *cp;
{
  char chsav, *symsp;
  SYM_NODE *symp;
  extern char *scansym();
  extern pass;
  extern void verify_symbol_name();
  

  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  /* Scan for symbol */
  symsp = scansym(&cp, &chsav);
  if(chsav)
    cp++;

  /* Look it up */
  if(!(symp = sm_find_sym(symtbl, symsp)))
    {
      struct val v;

      verify_symbol_name(symsp);

      /* Not found - define symbol */
      v = solidify(ev1arg(&cp)); /* To circumvent GCC bug -bson */
      sm_enter_sym(symtbl, symsp, v, F_LBL);
    }
  else

    /* Found - rebind */
    rebind(symp, ev1arg(&cp));

  symsp[strlen(symsp)] = chsav;
}


/* ORIGIN
 * Format:
 *	origin	expr
 */
void dorg(ip, cp)
  struct istruct *ip;
  char *cp;
{
  extern long loc, loc0;
  
  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  loc0 = loc = toint(ev1arg(&cp)).vint;
}


/* Generate code for string */
static void codestr(tmpcp)
  register char *tmpcp;
{
  for(; *tmpcp; code2(*tmpcp++));
}


/* True if end of line within string */
static str_eol(cpp)
  char **cpp;
{
  return(!cpp || !*cpp || !**cpp);
}


/* Get next char in string */
static char str_nextch(cpp)
  char **cpp;
{
  if(!cpp || !*cpp || !**cpp)
    return('\0');

  return(*(*cpp)++);
}


/* Support for 'hexch' */
char hexcpp(cpp)
  char **cpp;
{
  register char tmpc;
  
  if(eol(cpp))
    {
      sgnerr("Found end of line when expecting hex digit");
      return(0);
    }
  
  tmpc = toupper(str_nextch(cpp));
  return((tmpc <= 'F' && tmpc >= 'A') ? tmpc - 55 : tmpc - '0');
}


/* Return character constant in hex */
char hexch(cpp)
  char **cpp;
{
  return(hexcpp(cpp) << 4 + hexcpp(cpp));
}


/* Return character from octal constant */
char octch(ch, cpp)
  char ch, **cpp;
{
  register int acc;
  
  for(acc = ch - '0'; !eol(cpp) && **cpp <= '7' && **cpp >= '0';
      acc = (acc << 3) + str_nextch(cpp) - '0');
}


/* Return next char according to string syntax */
static quoted_char;

char strch(cpp)
  register char **cpp;
{
  char tmpc;
  extern FILE *sourcefile;
  extern char inbuf[];
  
  
  quoted_char = FALSE;

  /* Non-quote */
  if(**cpp != '\\')
    return(str_nextch(cpp));
  
  /* Quote */
  (*cpp)++;
  quoted_char = TRUE;
  
  if(str_eol(cpp))
    {
      fgetss(inbuf, 256, sourcefile);
      *cpp = inbuf;
      return('\n');
    }
  
  /* Special lettering */
  switch(tmpc = str_nextch(cpp))
    {
    case 'n':	return('\n');
    case 'e':	return('\033');
    case 'r':   return('\015');
    case 't':	return('\t');
    case 'x':	return(hexch(cpp));
    case '0':
    case '1':
    case '2':
    case '3':
    case '4':
    case '5':
    case '6':
    case '7':	return(octch(tmpc, cpp));
    case 'g':	return('\007');
    case 'b':	return('\010');
    default:	return(tmpc);
    }
}



/* Parse string.
 * The string allocated in the expr data area.
 */
char *str(cpp)
  char **cpp;
{
  char ch, *buf;
  register char *cp;
  extern char *expr_allp, *scansym(), *expr_strdup();


  *(buf = cp = expr_allp) = '\0';
  
  /* End of line? */
  if(eol(cpp))
    {
      expr_allp++;
      return(buf);
    }
  
  /* If no opening quote, simply scan symbol name */
  if(**cpp != '`')
    {
      buf = scansym(cpp, &ch);
      cp = expr_strdup(buf);
      buf[strlen(buf)] = ch;
      return(cp);
    }

  /* Loop until delimiter */
  for(str_nextch(cpp);
      !str_eol(cpp) && ((ch = strch(cpp)) != '\'' || quoted_char); )

    /* Substring? */
    if(ch == '`' && !quoted_char)
      {
	(*cpp)--;
	*cp++ = '`';
	expr_allp++;
	str(cpp);
	cp = expr_allp-1;
	*cp++ = '\'';
      }
    else
      {
	*cp++ = ch;
	expr_allp++;
      }
  
  if(ch != '\'')
    sgnerr("Missing closing string delimiter (')");

  *cp = '\0';
  expr_allp++;
  return(buf);
}	


/* ALIGN
 * Format:
 *	align expr
 */
void dalign(ip, cp)
  struct istruct *ip;
  char *cp;
{
  long offs;
  extern long loc, loc0;
  
  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  offs = (long) toint(ev1arg(&cp)).vint;
  offs--;			/* Due to avoid GCC bug */
  
  /* Already aligned */
  if(loc0 & offs)
    
    /* No */
    loc0 = ((loc0 & ~offs) + offs);
}


/* ASCII
 * Format:
 *	ascii	<str>
 */
void dasc(ip, cp)
  struct istruct *ip;
  char *cp;
{
  char *str;
  
  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  while(cp)
    {
      str = getstrpar(&cp);
      codestr(str);
    }
}


/* ASCIZ
 * Format:
 *	asciz	<str>
 */
void dascz(ip, cp)
  struct istruct *ip;
  char *cp;
{
  char *str;
  
  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  while(cp)
    {
      str = getstrpar(&cp);
      codestr(str);
    }

  code2(0);
}


/* ERROR
 * Format:
 *	error message
 */
void derror(ip, cp)
  struct istruct *ip;
  char *cp;
{
  decode_suffix(&cp, &dummy, FT_NONE);

  if(ciftrue)
    sgnerr("%s", byspace(cp));
}


/* END
 * Format:
 *	end
 */
void dend(ip, cp)
  struct istruct *ip;
  char *cp;
{
  extern exit_file;

  decode_suffix(&cp, &dummy, FT_NONE);

  exit_file = ciftrue;
}


/* EXIT
 * Format:
 *	exit
 */
void dexit(ip, cp)
  struct istruct *ip;
  char *cp;
{
  extern exit_asm;

  decode_suffix(&cp, &dummy, FT_NONE);

  exit_asm = ciftrue;
}


/* SAVE
 * Format:
 *	save	name
 */
void dsave(ip, cp)
  struct istruct *ip;
  char *cp;
{
  char chsav, *symsp;
  SYM_NODE *symp;
  extern char *scansym();
  extern pass;

  
  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  /* Scan for symbol */
  while(cp)
    {
      symsp = getsym(&cp);
      
      /* Look it up */
      if(!(symp = sm_find_sym(symtbl, symsp)))
	
	/* None - define with value `' */
	sm_enter_sym(symtbl, symsp, solidify(val_nullstr), F_LBL);
      else
	if(symp->flags & F_UDF)
	  rebind(symp, val_nullstr);
	else
	  /* Instantiate to its current value */
	  instantiate(symp, solidify(symp->value));
    }
}


/* RESTORE
 * Format:
 *	restore	name
 */
void drestore(ip, cp)
  struct istruct *ip;
  char *cp;
{
  char chsav, *symsp;
  SYM_NODE *symp;
  extern char *scansym();
  

  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  /* Loop symbols */
  while(cp)
    {
      symsp = getsym(&cp);
      
      /* Look it up */
      if(!(symp = sm_find_sym(symtbl, symsp)) || (symp->flags & F_UDF))
	
	/* None - error */
	sgnerr("Undefined symbol `%s'\n", symsp);
      else
	
	/* Instantiate to its previous value */
	deinstantiate(symp);
    }  
}


/* DEBUG: print value on stderr */
debug_print_val(v)
  struct val v;
{
  switch(v.type)
    {
    case VT_INT: fprintf(stderr, " integer:%lu\n", v.vint); break;
    case VT_REAL: fprintf(stderr, " real:%lg\n", v.vdouble); break;
    case VT_STR: fprintf(stderr, " string:`%s'\n", v.vstr); break;
    case VT_MAC: fprintf(stderr, " macro:0x%lx\n", v.vmacro); break;
    case VT_SECT: fprintf(stderr, " sect:0x%lx\n", v.vsect); break;
    default:
      fprintf(stderr, " type %d:0x%lx\n", v.type, v.vstr);
    }
}


/* DEBUG: dump symbol table */
static void dump_sym_chain(s)
  SYM_NODE *s;
{
  for(; s; s = s->sgt)
    {
      dump_sym_chain(s->slt);
      
      fprintf(stderr, "%s = %04o/", s->name, s->flags);
      debug_print_val(s->value);
    }
}

static void dump_sym_aux(stbl)
  SYM_ROOT *stbl;
{
  SYM_NODE **sp;

  /* Loop hash entries */
  for(sp = stbl->sm_slot; sp < stbl->sm_slot + SYM_NHASH; sp++)
    if(*sp)
      dump_sym_chain(*sp);
}

debug_print_sym()
{
  fputs("*** Symbol table ***\n", stderr);
  dump_sym_aux(symtbl);
}


/* DEBUG: Print macro value on stderr */
void debug_print_macro(m)
  struct macro *m;
{
  char **l;
  struct marg *ma;

  fprintf(stderr, "*** MACRO ***\nlabel=%s\n",
	  (m->label ? m->label->name : "(no label)"));

  fprintf(stderr, "%d arguments:\n", m->nargs);

  for(ma = m->args; ma < m->args + m->nargs; ma++)
    {
      fprintf(stderr, "  Symbol `%s' ", ma->argsym->name);

      if(ma->def)
	fprintf(stderr, "default `%s'\n", ma->def);
      else
	fprintf(stderr, "no default\n");
    }

  fprintf(stderr, "\n%d lines:\n", m->nlines);

  for(l = m->lines; l < m->lines + m->nlines; )
    fprintf(stderr, "%s\n", *l++);

  fputc('\n', stderr);
}


/* Get block of lines from source file */
void getblock(blockp, linesp, termword, packflag, listing)
  char ***blockp, *termword;
  int *linesp, packflag, listing;
{
  int nlines;
  long startpos;
  char lbuf[256], *cp, **block, **l;
  extern pass, lincnt, inhibit_list, scmp(), fgetss();
  extern FILE *sourcefile, *listfile;
  extern long ftell();
  extern char *malloc(), *strdup(), bufcpy[];
  extern void writelist();


  /* First see how many lines we have */
  startpos = ftell(sourcefile);
  for(nlines = 0; !feof(sourcefile); nlines++)
    {
      do
	{
	  fgetss(lbuf, sizeof lbuf, sourcefile);

	  if(feof(sourcefile))
	    sgnerr("Missing %s", termword);

	  if(listing)
	    {
	      lincnt++;
	      strcpy(bufcpy, lbuf);

	      writelist(listfile);
	    }

	  cp = byspace(lbuf);
	  if(!packflag || (*cp && *cp != ';'))
	    break;
	}
      while(!feof(sourcefile));

      if(feof(sourcefile))
	break;

      if(mtstr(&cp, termword))
	break;
    }

  /* Save away block terminator */
  strcpy(getblock_term, lbuf);

  /* Inihibit one listing line */
  inhibit_list = 1;

  /* Merely spanning? */
  if(!blockp || !linesp)
    return;

  /* Null block? */
  *linesp = nlines;

  /* Return if just spanning */
  if(!ciftrue || !nlines)
    return;

  /* Allocate block storage */
  block = (char **) malloc(nlines * sizeof(char **));

  /* Duplicate lines */
  fseek(sourcefile, startpos, 0);

  for(l = block; !feof(sourcefile); nlines--)
    {
      do
	{
	  fgetss(lbuf, sizeof lbuf, sourcefile);

	  cp = byspace(lbuf);
	  if(!packflag || (*cp && *cp != ';'))
	    break;
	}
      while(!feof(sourcefile));

      if(feof(sourcefile))
	break;

      if(mtstr(&cp, termword))
	break;

      if(nlines > 0)
	if(packflag)
	  *l++ = strdup(cp);
	else
	  *l++ = strdup(lbuf);
    }

  *blockp = block;
}


/* Parse macro header */
static struct marg *macro_header(cpp, namep, nargsp)
  char **cpp, **namep;
  int *nargsp;
{
  int
    nargs, nargs_to_alloc, oldpass = pass;
  char *name, c;
  struct marg
    args[64], *ap, *ma;
  extern char
    *malloc(), *strdup(), *scansym(), *str();
  extern struct sstruct
    *symref();
  extern void
    verify_symbol_name();


  *namep = NULL;
  *nargsp = 0;


  /* Parse symbol name */
  *cpp = byspace(*cpp);

  pass = 3;

  name = scansym(cpp, &c);

  verify_symbol_name(name);

  if(!name[0])
    {
      sgnerr("Bad macro name");
      pass = oldpass;
      return(NULL);
    }

  *namep = strdup(name);
  name[strlen(name)] = c;

  /* Parse arguments of form name[=value] */
  for(nargs = 0, ap = args; ap < args+64 ; ap++)
    {
      *cpp = byspace(*cpp);
  
      /* Done if end of argument list */
      if(!**cpp || **cpp == ';')
	break;
      
      nargs++;
      ap->def = NULL;

      name = scansym(cpp, &c);

      verify_symbol_name(name);

      if(!name[0])
	{
	  pass = oldpass;
	  return(NULL);
	}

      ap->argsym = symref(name);
      name[strlen(name)] = c;

      /* Continue with next argument if no default */
      if(**cpp == '=')
	{
	  (*cpp)++;
	  *cpp = byspace(*cpp);
	  ap->def = strdup(str(cpp));
	}

      *cpp = byspace(*cpp);
      if(**cpp != ',')
	break;

      (*cpp)++;
    }

  /* Duplicate argument data and return.
   * If there are no arguments, then we allocate an argument
   * block consisting of a token entry. We still set the argument
   * count to 0.
   */
  nargs_to_alloc = (nargs ? nargs : 1);

  ma = (struct marg *) malloc(nargs_to_alloc * sizeof(struct marg));

  if(nargs)
    bcopy(args, ma, nargs_to_alloc * sizeof(struct marg));

  *nargsp = nargs;
  pass = oldpass;

  return(ma);
}


/* MACRO
 * format:
 *  label: MACRO name arg1=def1, arg2=def2..., argN=defN
 *    ... block ...
 *	   ENDMACRO
 */
void dmacro(ip, cp)
  struct istruct *ip;
  char *cp;
{
  char
    **body, *mname, **cpp = &cp, *passlabel;
  int
    nlines, mbytes, nargs;
  struct macro *m;
  struct marg *ma;
  struct sstruct
    *symp, *lb;
  struct val mval;
  extern pass;
  extern char
    *malloc(), *strdup(),
    label[], label_pass3[];
  extern void writelist();
  extern FILE *listfile;
  extern SYM_NODE *symref();


  passlabel = (pass == 3 ? label_pass3 : label);

  if(!ciftrue || pass != 1)
    {
      passlabel[0] = '\0';
      writelist(listfile);
      getblock(NULL, NULL, "ENDMACRO", TRUE, TRUE);
      return;
    }

  if(passlabel[0])
    {
      lb = symref(passlabel);
      passlabel[0] = '\0';
    }
  else
    lb = NULL;

  writelist(listfile);

  ma = macro_header(cpp, &mname, &nargs);
  getblock(&body, &nlines, "ENDMACRO", TRUE, TRUE);

  if(!nlines || !ma)
    {
      sgnerr("Missing macro body");

      if(mname)
	free(mname);

      if(ma)
	free(ma);

      return;
    }

  mbytes = sizeof(struct macro) + (nlines - 1) * sizeof m->lines[0];

  if(!(m = (struct macro *) malloc(mbytes)))
    fatal("Can't allocate %d bytes for macro definition", mbytes);

  /* Initialize label */
  m->label = lb;

  /* Initialize arguments */
  m->nargs = nargs;
  m->args = ma;

  /* Initialize lines */
  m->nlines = nlines;
  bcopy(body, m->lines, nlines * sizeof m->lines[0]);
  
  /* Create symbol and bind */
  mval.type = VT_MAC;
  mval.vmacro = m;

  if(symp = sm_find_sym(symtbl, mname))
    {
      if(!(symp->flags & F_UDF))
	free_val(symp->value);

      symp->value = mval;
      symp->flags &= ~(F_UDF|F_HID);
    }
  else
    sm_enter_sym(symtbl, mname, mval, F_LBL);

  /* Clean up */
  free(body);
  free(mname);
}


/* RADIX:
 * Format:
 *      radix r
 */
void dradix(ip, cp)
  struct istruct *ip;
  char *cp;
{
  INT r;
  extern struct val
    evbin(), evoct(), evdec(), echex(), evreal(),
    (*defrdx)();

  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  r = toint(ev1arg(&cp)).vint;

  switch((long) r)
    {
    case 0: defrdx = evreal; break;
    case 2: defrdx = evbin; break;
    case 8: defrdx = evoct; break;
    case 10: defrdx = evdec; break;
    case 16: defrdx = evhex; break;
    default:

      sgnerr("Radix %ld is not supported", (long) r);
    }
}


/* HIDE
 * Format:
 *	hide	name, name, name...
 */
void dhide(ip, cp)
  struct istruct *ip;
  char *cp;
{
  char chsav, *symsp;
  SYM_NODE *symp;
  extern char *scansym();

  
  if(!ciftrue)
    return;


  decode_suffix(&cp, &dummy, FT_NONE);

  /* Scan for symbols */
  while(cp)
    {
      symsp = getsym(&cp);
      
      /* Look it up */
      if((symp = sm_find_sym(symtbl, symsp)) && !(symp->flags & F_UDF))
	
	/* Hide */
	symp->flags |= F_HID;
      else
	sgnerr("Undefined symbol `%s'", symsp);
    }
}


/* LIBCALL
 * Format:
 *	libcall	name, name, name...
 *
 * Mark symbol as LIBCALLed, but otherwise undefined.
 * 
 */
void dlibcall(ip, cp)
  struct istruct *ip;
  char *cp;
{
  char chsav, *symsp;
  SYM_NODE *symp;
  extern char *scansym();

  
  if(!ciftrue)
    return;

  decode_suffix(&cp, &dummy, FT_NONE);

  /* Scan for symbols */
  while(cp)
    {
      symsp = getsym(&cp);

      /* Look it up */
      if(symp = sm_find_sym(symtbl, symsp))
	
	/* Exists - mark as LIBCALLed */
	symp->flags |= F_USED;
      else

	/* Does not exist - create */
	sm_enter_sym(symtbl, symsp, val_zero, F_LBL|F_UDF|F_USED);
    }
}


/* STATIC
 * Format:
 *    static start, end
 */
void dstatic(ip, cp)
  struct istruct *ip;
  char *cp;
{
  struct val s1, s2;
  extern long static_begin, static_end;

  
  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  s1 = toint(evexpr(&cp));

  cp = byspace(cp);

  if(*cp != ',')
    {
      sgnerr("Missing argument");
      return;
    }

  cp++;

  s2 = toint(evexpr(&cp));

  nomore(&cp);

  static_begin = s1.vint & 0xfffff;
  static_end   = s2.vint & 0xfffff;
}


/* FLOATING
 * Format:
 *     floating start, end
 */
void dfloating(ip, cp)
  struct istruct *ip;
  char *cp;
{
  struct val f1, f2;
  extern long floating_begin, floating_end;


  decode_suffix(&cp, &dummy, FT_NONE);

  if(!ciftrue)
    return;

  f1 = toint(evexpr(&cp));

  cp = byspace(cp);

  if(*cp != ',')
    {
      sgnerr("Missing argument");
      return;
    }

  cp++;

  f2 = toint(evexpr(&cp));

  nomore(&cp);

  floating_begin = f1.vint & 0xfffff;
  floating_end   = f2.vint & 0xfffff;
}


/* Convert string value to uppercase */
struct val uppercase(v)
  struct val v;
{
  register char *cp;

  v = tostr(v);

  for(cp = v.vstr; *cp = toupper(*cp); cp++);

  return(v);
}


/* DOBLOCK
 * Format:
 *     doblock  name, endsym
 */
void ddoblock(ip, cp)
  struct istruct *ip;
  char *cp;
{
  char
    *s, *name, *endname, c, **l,
    **argbody, mcall[256], *passlabel;
  int
    arglines, listsave;
  struct sstruct *symp;
  struct macro *m;
  extern char
    *scansym(), *strdup(), *str(), *inp,
    label[], label_pass3[], bufcpy[], codebuf[], *codeptr;
  extern
    pass, listflag, seqflag, inhibit_list, errors_enabled, lincnt;
  extern long
    loc0, loc;
  extern FILE *listfile;
  extern void writelist();


  decode_suffix(&cp, &dummy, FT_NONE);

  passlabel = (pass == 3 ? label_pass3 : label);

  s = scansym(&cp, &c);
  name = strdup(s);
  s[strlen(s)] = c;
  cp = byspace(cp);

  if(*cp++ != ',')
    {
      sgnerr("Missing second %s argument", ip->name);
      free(name);
      return;
    }

  endname = strdup(uppercase(evexpr(&cp)).vstr);

  if(!eol(&cp))
    sgnerr("Excessive line contents");

  if(ciftrue)
    deflabel();

/*  if(!macro_invocation) */
  writelist(listfile);

  codeptr = codebuf;
  loc0 = loc;

  /* Get block, but turn list off unless we're merely spanning */
  getblock(&argbody, &arglines, endname, FALSE, !ciftrue);

  free(endname);
      
  if(!ciftrue)
    {
/*      free_body(argbody, arglines); */
      free(name);
      return;
    }

  /* See if symbol is defined */
  if(!(symp = sm_find_sym(symtbl, name)) || (symp->flags & F_UDF))
    {
      sgnerr("Undefined symbol `%s'", name);
      free_body(argbody, arglines);
      free(name);
      return;
    }

  free(name);

  /* Make sure it's a macro */
  if(symp->value.type != VT_MAC)
    {
      sgnerr("`%s' is not a macro", symp->name);
      free_body(argbody, arglines);
      return;
    }

  m = symp->value.vmacro;

  /* Make sure it is properly defined */
  if(m->nargs != 1 || !m->args[0].def)
    {
      sgnerr("Macro `%s' is not properly defined for %s",
	     symp->name, ip->name);
      free_body(argbody, arglines);
      return;
    }
  
  loc0 = loc;
  seqflag = FALSE;

  /* Loop the argument body, and invoke macro for each line */
  for(l = argbody; l < argbody + arglines; l++)
    {
      char *macro_arg;

      loc0 = loc;

      errors_enabled = TRUE;

      strcpy(bufcpy, *l);
      inp = byspace(*l);

      if(*inp && *inp != ';')
	{	
	  scanlabel();
	  sprintf(mcall, "`%s'", inp);
	  macro_arg = strdup(mcall);
	  
	  expand_macro(m, macro_arg);

	  free(macro_arg);
	}

      deflabel();

      /* Add to list file */
      if(pass == 3)
	{
	  inhibit_list = 0;

	  lincnt++;
	  writelist(listfile);
	}

      codeptr = codebuf;
    }

  /* Get rid of body */
  free_body(argbody, arglines);

  /* Add terminating line to listing.
   * This will actually be listed by the caller.
   */
  if(pass == 3)
    {
      strcpy(bufcpy, getblock_term);
      lincnt++;
    }
}


/* ASECT, CSECT, DSECT, PSECT, LSECT
 * Format:
 *	xSECT  sect_name
 */
void dsect(ip, cp)
  struct istruct *ip;
  char *cp;
{
  char chsav, *symsp;
  SYM_NODE *symp;
  extern SYM_ROOT *symtbl;
  extern SECT *cur_sect;
  extern long loc, loc0;
  extern SYM_NODE *sym_cursect;


  if(!ciftrue)
    return;

  decode_suffix(&cp, &dummy, FT_NONE);

  /* Save old loc in old sect */
  cur_sect->sc_loc = loc;
  
  /* Scan for symbol argument */
  symsp = getsym(&cp);

  if(cp)
    sgnerr("Extraneous arguments supplied to %s", ip->name);

  /* Look it up */
  if((symp = sm_find_sym(symtbl, symsp)) &&
    
     /* Exists - check if value is sect, then switch to it */
     symp->value.type == VT_SECT)
    {
      symp->flags &= ~F_UDF;
      symp->flags |= F_REF;

      /* Then switch to new sect  */
      free_val(sym_cursect->value);

      sym_cursect->value.type = VT_SECT;

      /* Note the order of these two is important, as
       * the symbol may be SECT.
       */
      cur_sect = symp->value.vsect;
      sym_cursect->value.vsect = cur_sect;


      loc0 = loc = cur_sect->sc_loc;
      return;
    }
  
  /* Does not exist, or value is not sect - create new sect */
  if(symp)
/*    free_val(symp->value) */ ; 
  else
    symp = sm_enter_sym(symtbl, symsp, val_zero, F_LBL|F_REF);

  free_val(sym_cursect->value);
  sym_cursect->value.type = VT_SECT;
  sym_cursect->value.vsect =
    cur_sect = sc_new(symp, ip->opcode);

  loc0 = loc = 0;
  symp->value.type = VT_SECT;
  symp->value.vsect = cur_sect;
}


/* DUMPSYM
 */
void ddumpsym(ip, cp)
  struct istruct *ip;
  char *cp;
{
  debug_print_sym();
}


/* KBEGIN
 */
void dkbegin(ip, cp)
  struct istruct *ip;
  char *cp;
{
  extern unsigned long kcrc;

  if(!ciftrue)
    return;

  decode_suffix(&cp, &dummy, FT_NONE);

  nomore(&cp);

  kcrc = 0;
}
