simh-testsetgenerator/Ibm1130/utils/asm1130.c

/*
 * (C) Copyright 2002, Brian Knittel.
 * You may freely use this program, but: it offered strictly on an AS-IS, AT YOUR OWN
 * RISK basis, there is no warranty of fitness for any purpose, and the rest of the
 * usual yada-yada. Please keep this notice and the copyright in any distributions
 * or modifications.
 *
 * This is not a supported product, but I welcome bug reports and fixes.
 * Mail to sim@ibm1130.org
 */

// ---------------------------------------------------------------------------------
// ASM1130 - IBM 1130 Cross Assembler
//
// Version
//		   1.07 - 2003Jan05 - Filenames are now left in lower case. SYMBOLS.SYS stays all upper case
//		   1.06 - 2002May02	- Fixed bug in ebdic constants (data goes into low byte)
//							  First stab at adding ISS level # info, this is iffy
//         1.05 - 2002Apr24 - Made negative BSS size a warning not an error, as it
//                            it's looking like it happens twice in PTMASMBL.
//                            This version still doesn't do fixed point numbers and
//                            negative floats may be wrong.
//         1.04 - 2002Apr18 - Added binary (card loader format) output, removed
//                            interim IPL output formats and moved that to MKBOOT.
//                            Enhanced relocatable code handling. Added floating
//                            point constants, but don't know how to make fixed point
//                            constants yet. Made amenable to syntax variations found
//                            in the DMS sources. Doesn't properly handle ILS
//                            modules yet and ISS is probably wrong.
//         1.03 - 2002Apr10 - numerous fixes, began to add relative/absolute support
//         1.02 - 2002Feb26 - replaced "strupr" with "upcase" for compatibility
//         1.01 - 2002Feb25 - minor compiler compatibility changes
//         1.00 - 2002Feb01 - first release. Tested only under Win32.
// ---------------------------------------------------------------------------------
//
// Usage:
//		asm1130 [-bvsx] [-o[file]] [-l[file]] [-rN.M] file...
//
// Description:
//		-b		binary output (.bin, relocatable absolute format)
//		-v		verbose
//		-s		print symbol table
//		-x		print cross references
//		-o		output file (default is name of first source file + extension .out or .bin)
//		-l		listing file (default is name of first source file + extension .lst)
//		-y		preload system symbol table SYMBOLS.SYS (from the current directory)
//		-w		write the system symbol table SYMBOLS.SYS in the current directory
//		-W		same as -w but don't prompt to confirm overwriting existing file
//		-r		set DMS release to release N version M, for sbrk cards
//
// Listing and symbol table output can be turned on by *LIST directives in the source, too
// Listing file default extension is .LST
//
// Input files can use strict IBM 1130 Assembler column format, or loose formatting
// with tabs, or any mix on a line-by-line basis. Input files default extension is .ASM.
//
// Strict specification is:
//
//			label		columns  1 -  5
//			opcode				 7 - 10
//			tag					 12
//			index				 13
//			arguments			 15 - 51
//
// Loose, indicated by presence of ascii tab character(s):
//
//			label<tab>opcode<tab>index and format indicators<tab>arguments
//
// In both cases, the IBM convention that the arguments section ends with the
// first nonblank applies. This means that ".DC 1, 2, 3" assembles only the 1!
//
// Output file format is that used by the LOAD command in my 1130
// simulator. Lines are any of the following. All values are in hex:
//
//	@addr			load address for subsequent words is addr
//	Znwords			Zero the next "nwords" and increment load address by nwords.
//	=addr			set IAR register to address addr (a convenience)
//	 value			load value at load address and increment load address
//
// Output file default extension is .OUT or .BIN for binary assemblies
//
// Note: this version does not handle relative assembly, and so doesn't carry
// absolute/relative indication through expression calculation.
//
// Seems to work. Was able to assemble the resident monitor OK.
// >>> Look for "bug here" though, for things to check out.
//
// Notes:
// org_advanced tells whether * in an expression refers to the address AFTER the
// instruction (1 or 2 words, depending on length). This is the case for opcodes
// but not all directives.
//
// Added special coldstart format directives:
//
//	 .IPL 1130,XXXXXXXX
//   .IPL 1800,XXXXXXXX
//
// (these are not standard IBM)
//
// These directives cause the output file to be written in binary in either 1130 or
// 1800 IPL format. In 1130 format, the index bits are lost and the displacement
// is sign extended. In 1800 format, the data are punched 8 bits at a time into
// two columns per word. If an identifier is not given, data are punched into
// all 80 columns. If an identifier is given, data is punched in columns 0 through
// 72, and the identification XXXXXXXX is punched in columns 73 through 80. (If
// there are multiple output cards the last ident character is incremented). A
// warning is issued if 1130 assembly results in lost bits. These directives
// should be the first in the file as you don't want text and binary mixed in
// the same output file.
//
// Revision History
// 16Apr02	1.03	Added sector break, relocation flag output
// 02Apr02	1.02	Fixed bug in BOSC: it CAN be a short instruction.
//					Added directives for 1130 and 1800 IPL output formats
//					Added conditional assembly directives
// ---------------------------------------------------------------------------------

#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <stdarg.h>
#include <setjmp.h>
#include <time.h>
#include <ctype.h>

// ---------------------------------------------------------------1------------------
// DEFINITIONS
// ---------------------------------------------------------------------------------

// I have found some IBM source code where @ and ' seem interchangable.
// Comment out this define to make @ and ' different in symbol names, keep to make equivalent

#if defined(VMS)
	#  include <unistd.h>  					/* to pick up 'unlink' */
#endif

#define BETWEEN(v,a,b) (((v) >= (a)) && ((v) <= (b)))
#define MIN(a,b)       (((a) <= (b)) ? (a) : (b))
#define MAX(a,b)       (((a) >= (b)) ? (a) : (b))

#ifndef WIN32
   int strnicmp (char *a, char *b, int n);
   int strcmpi  (char *a, char *b);
#endif

#define FIX_ATS	

#define DMSVERSION "V2M12"				/* required 5 characters on sector break card col 67-71 */

#define DOLLAREXIT		"/38"			// hmmm, are these really fixed absolutely in all versions?
#define DOLLARDUMP		"/3F"

#define SYSTEM_TABLE "SYMBOLS.SYS"

#define BOOL  int
#define TRUE  1
#define FALSE 0

#define VERSION "ASM1130 CROSS ASSEMBLER V1.07"

#define ISTV	0x33			// magic number from DMS R2V12 monitorm symbol @ISTV

#define MAXLITERALS	300
#define MAXENTRIES   14

#define LINEFORMAT    "                          %4ld | %s"
#define LEFT_MARGIN   "                                |"
                 //	 XXXX XXXX XXXX XXXX XXXX XXXX
				 //  org  w1   w2   w3   w4   w5
				 //  XXXX 1111 2222 3333 4444  LLLL |
				 //  12345678901234567890123456789012

typedef enum {ABSOLUTE = 0, RELATIVE = 1, LIBF = 2, CALL = 3} RELOC;

typedef struct tag_symbol {			// symbol table entry:
	char *name;						// name of symbol
	int  value;						// value (absolute)
	int  pass;						// defined during pass #
	int  defined;					// definition state, see #defines below
	RELOC relative;					// ABSOLUTE = absolute, RELATIVE = relative
	struct tag_symbol *next;		// next symbol in list
	struct tag_xref   *xrefs;		// cross references
} SYMBOL, *PSYMBOL;

#define S_UNDEFINED		0			// values of 'defined'
#define S_PROVISIONAL	1			// usually an expression with forward references
#define S_DEFINED		2			// ordering must be undef < prov < def

typedef struct tag_xref {			// cross reference entry
	char *fname;					// filename
	int  lno;						// line number
	BOOL definition;				// true = definition, false = reference
	struct tag_xref *next;			// next reference
} XREF, *PXREF;

typedef struct tag_expr {			// expression result: absolute or relative
	int value;
	RELOC relative;
} EXPR;

typedef enum {PROGTYPE_ABSOLUTE = 1, PROGTYPE_RELOCATABLE = 2, PROGTYPE_LIBF = 3, PROGTYPE_CALL = 4,
			  PROGTYPE_ISSLIBF  = 5, PROGTYPE_ISSCALL = 6,     PROGTYPE_ILS  = 7} PROGTYPE;

typedef enum {SUBTYPE_INCORE = 0, SUBTYPE_FORDISK = 1, SUBTYPE_ARITH = 2,
			  SUBTYPE_FORNONDISK = 3, SUBTYPE_FUNCTION=8} SUBTYPE;

typedef enum {INTMODE_UNSPECIFIED  = 0, INTMODE_MATCHREAL = 0x0080, INTMODE_ONEWORD   = 0x0090} INTMODE;
typedef enum {REALMODE_UNSPECIFIED = 0, REALMODE_STANDARD = 0x0001, REALMODE_EXTENDED = 0x0002} REALMODE;

#define OP_INDEXED 	0x0300			// 1130 opcode modifier bits
#define OP_LONG    	0x0400
#define OP_INDIRECT	0x0080

typedef enum {OUTMODE_LOAD, OUTMODE_1130, OUTMODE_1800, OUTMODE_BINARY} OUTMODE;

#ifdef WIN32
#  define OUTWRITEMODE "wb"			// write outfile in binary mode
#  define ENDLINE      "\r\n"		// explictly write CR/LF
#else
#  define OUTWRITEMODE "w"			// use native mode
#  define ENDLINE      "\n"
#endif

// ---------------------------------------------------------------------------------
// GLOBALS
// ---------------------------------------------------------------------------------

// command line syntax
char *usestr =
"Usage: asm1130 [-bpsvwxy] [-o[file]] [-l[file]] [-rN.M] file...\n\n"
"-b  binary (relocatable format) output; default is simulator LOAD format\n"
"-p  count passes required; no assembly output is created with this flag"
"-s  add symbol table to listing\n"
"-v  verbose mode\n"
"-w  write system symbol table as SYMBOLS.SYS\n"
"-W  same as -w but do not confirm overwriting previous file\n"
"-x  add cross reference table to listing\n"
"-y  preload system symbol table SYMBOLS.SYS\n"
"-o  set output file; default is first input file + .out or .bin\n"
"-l  create listing file; default is first input file + .lst\n"
"-r  set dms version to VN RM for system SBRK cards";

BOOL verbose = FALSE;							// verbose mode flag
BOOL tabformat = FALSE;							// TRUE if tabs were seen in the file
int  pass;										// current assembler pass (1 or 2)
char curfn[256];								// current input file name
char progname[8];								// base name of primary input file
char *outfn = NULL;								// output file name
int  lno;										// current input file line number
BOOL preload = FALSE;							// preload system symbol table
BOOL savetable = FALSE;							// write system symbol table
BOOL saveprompt = TRUE;							// prompt before overwriting
int  nerrors = 0;								// count of errors
int  nwarnings = 0;								// count of warnings
FILE *fin = NULL;								// current input file
FILE *fout = NULL;								// output file stream
OUTMODE outmode = OUTMODE_LOAD;					// output file mode
int  outcols = 0;								// columns written in using card output
int maxiplcols = 80;
char cardid[9];									// characters used for IPL card ID
FILE *flist = NULL;								// listing file stream
char *listfn = NULL;							// listing filename
BOOL do_list = FALSE;							// flag: create listing
BOOL passcount = FALSE;							// flag: count passes only
BOOL list_on = TRUE;							// listing is currently enabled
BOOL do_xref = FALSE;							// cross reference listing
BOOL do_syms = FALSE;							// symbol table listing
BOOL ended = FALSE;								// end of current file
BOOL hasforward = FALSE;						// true if there are any forward references
char listline[350];								// output listing line
BOOL line_error;								// already saw an error on current line
RELOC relocate = RELATIVE;						// relocatable assembly mode
BOOL assembled = FALSE;							// true if any output has been generated
int  nwout;										// number of words written on current line
int  org = 0;									// output address (origin)
int org_advanced;								// if TRUE, * means instruction addr+(value) during evaluation
int  pta = -1;									// program transfer address
BOOL cexpr = FALSE;								// "C" expression syntax
PSYMBOL symbols = NULL;							// the symbol table (linear search)
BOOL check_control = TRUE;						// check for control cards
PROGTYPE progtype = PROGTYPE_RELOCATABLE;		// program type
INTMODE intmode   = INTMODE_UNSPECIFIED;		// integer mode
REALMODE realmode = REALMODE_UNSPECIFIED;		// real mode
int nintlevels = 0;								// # of interrupt levels for ISS
int intlevel_primary = 0;						// primary level for ISS and level for ILS
int intlevel_secondary = 0;						// secondary level for ISS
int iss_number = 0;								// ISS number
PSYMBOL entry[MAXENTRIES];						// entries for subroutines
int nentries = 0;
int ndefined_files = 0;

struct lit {									// accumulated literals waiting to be output
	int  value;									// constant value
	int  tagno;									// constant symbol tag number (e.g. _L001)
	BOOL hex;									// constant was expressed in hex
	BOOL even;									// constant was operand of a double-width instruction (e.g. AD)
} literal[MAXLITERALS];

int n_literals = 0, lit_tag = 0;
BOOL requires_even_address;						// target of current instruction
BOOL dmes_saved;								// odd character left over from dmes ending in '
int dmes_savew;
char opfield[256];								// extracted operand field from source line
char dmsversion[12] = DMSVERSION;				// version number for SBRK cards
const char whitespace[] = " \t";				// whitespace

int ascii_to_ebcdic_table[128] = 
{
//
	0x00,0x01,0x02,0x03,0x37,0x2d,0x2e,0x2f, 0x16,0x05,0x25,0x0b,0x0c,0x0d,0x0e,0x0f,
//
	0x10,0x11,0x12,0x13,0x3c,0x3d,0x32,0x26, 0x18,0x19,0x3f,0x27,0x1c,0x1d,0x1e,0x1f,
//  spac !    "    #    $    %    &    '     (    )    *    +    ,    -    .    /
	0x40,0x5a,0x7f,0x7b,0x5b,0x6c,0x50,0x7d, 0x4d,0x5d,0x5c,0x4e,0x6b,0x60,0x4b,0x61,
//  0    1    2    3    4    5    6    7     8    9    :    ;    <    =    >    ?
	0xf0,0xf1,0xf2,0xf3,0xf4,0xf5,0xf6,0xf7, 0xf8,0xf9,0x7a,0x5e,0x4c,0x7e,0x6e,0x6f,
//  @    A    B    C    D    E    F    G     H    I    J    K    L    M    N    O
	0x7c,0xc1,0xc2,0xc3,0xc4,0xc5,0xc6,0xc7, 0xc8,0xc9,0xd1,0xd2,0xd3,0xd4,0xd5,0xd6,
//  P    Q    R    S    T    U    V    W     X    Y    Z    [    \    ]    &    _
	0xd7,0xd8,0xd9,0xe2,0xe3,0xe4,0xe5,0xe6, 0xe7,0xe8,0xe9,0xba,0xe0,0xbb,0xb0,0x6d,
//       a    b    c    d    e    f    g     h    i    j    k    l    m    n    o
	0x79,0x81,0x82,0x83,0x84,0x85,0x86,0x87, 0x88,0x89,0x91,0x92,0x93,0x94,0x95,0x96,
//  p    q    r    s    t    u    v    w     x    y    z    {    |    }    ~
	0x97,0x98,0x99,0xa2,0xa3,0xa4,0xa5,0xa6, 0xa7,0xa8,0xa9,0xc0,0x4f,0xd0,0xa1,0x07,
};

int ascii_to_1403_table[128] = 
{ /*  00   01   02   03   04   05   06   07    08   09   0a   0b   0c   0d   0e  0f  */
	0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f, 0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,
	0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f, 0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,
	0x7f,0x7f,0x7f,0x7f,0x62,0x7f,0x15,0x0b, 0x57,0x2f,0x23,0x6d,0x16,0x61,0x6e,0x4c,
	0x49,0x40,0x01,0x02,0x43,0x04,0x45,0x46, 0x07,0x08,0x7f,0x7f,0x7f,0x4a,0x7f,0x7f,
	0x7f,0x64,0x25,0x26,0x67,0x68,0x29,0x2a, 0x6b,0x2c,0x58,0x19,0x1a,0x5b,0x1c,0x5d,
	0x5e,0x1f,0x20,0x0d,0x0e,0x4f,0x10,0x51, 0x52,0x13,0x54,0x7f,0x7f,0x7f,0x7f,0x7f,
	0x7f,0x64,0x25,0x26,0x67,0x68,0x29,0x2a, 0x6b,0x2c,0x58,0x19,0x1a,0x5b,0x1c,0x5d,
	0x5e,0x1f,0x20,0x0d,0x0e,0x4f,0x10,0x51, 0x52,0x13,0x54,0x7f,0x7f,0x7f,0x7f,0x7f
};

#include "../ibm1130_conout.h"			/* conout_to_ascii_table */
#include "../ibm1130_prtwheel.h"		/* 1132 printer printwheel data */

// ---------------------------------------------------------------------------------
// PROTOTYPES
// ---------------------------------------------------------------------------------

void bail (char *msg);
void flag (char *arg);
void proc (char *fname);
void startpass (int n);
void errprintf (char *fmt, ...);
void asm_error (char *fmt, ...);
void asm_warning (char *fmt, ...);
char *astring (char *str);
PSYMBOL lookup_symbol (char *name, BOOL define);
void add_xref (PSYMBOL s, BOOL definition);
int  get_symbol (char *name);
void set_symbol (char *name, int value, int known, RELOC relative);
char * gtok (char **pc, char *tok);
char *skipbl (char *c);
void sym_list (void);
void xref_list (void);
void listhdr (void);
int  getexpr (char *pc, BOOL undefined_ok, EXPR *expr);
void passreport (void);
void listout (BOOL reset);
void output_literals (BOOL eof);
char *upcase (char *str);
void prep_line (char *line);
int ascii_to_hollerith (int ch);
char *detab (char *str);
void preload_symbols (void);
void save_symbols (void);
void bincard_init (void);
void bincard_writecard (char *sbrk_text);
void bincard_writedata (void);
void bincard_flush (void);
void bincard_sbrk (char *line);
void bincard_setorg (int neworg);
void bincard_writew (int word, RELOC relative);
void bincard_endcard (void);
void handle_sbrk (char *line);
void bincard_typecard (void);
void namecode (unsigned short *words, char *tok);

// ---------------------------------------------------------------------------------
// main routine
// ---------------------------------------------------------------------------------

int main (int argc, char **argv)
{
	int i, sawfile = FALSE;

	for (i = 1; i < argc; i++)					// process command line switches
		if (*argv[i] == '-')
			flag(argv[i]+1);

	startpass(1);								// first pass, process files 

	for (i = 1; i < argc; i++)
		if (*argv[i] != '-')
			proc(argv[i]), sawfile = TRUE;

	if (! sawfile)								// should have seen at least one file
		bail(usestr);

	if (passcount) {
		passreport();
		return 0;
	}

	startpass(2);								// second pass, process files again

	for (i = 1; i < argc; i++)
		if (*argv[i] != '-')
			proc(argv[i]);

	if (outmode == OUTMODE_LOAD) {
		if (pta >= 0)							// write start address to the load file
			fprintf(fout, "=%04x" ENDLINE, pta & 0xFFFF);
	}
	else 
		bincard_endcard();

	if (flist) {
		if (nerrors || nwarnings) {				// summarize (or summarise)
			if (nerrors == 0)
				fprintf(flist, "There %s ", (nwarnings == 1) ? "was" : "were");
			else
			    fprintf(flist, "\nThere %s %d error%s %s",
					(nerrors == 1) ? "was" : "were", nerrors, (nerrors == 1) ? "" : "s", nwarnings ? "and " : "");

			if (nwarnings > 0)
				fprintf(flist, "%d warning%s ", nwarnings, (nwarnings == 1) ? "" : "s");

			fprintf(flist, "in this assembly\n");
		}
		else
			fprintf(flist, "\nThere were no errors in this assembly\n"); 
	}

	if (flist) {								// finish the listing
		if (pta >= 0)
			fprintf(flist, "\nProgram transfer address = %04x\n", pta);

		if (do_xref)
			xref_list();
		else if (do_syms)
			sym_list();
	}

	if (savetable)
		save_symbols();

	return 0;									// all done
}

// ---------------------------------------------------------------------------------
// flag - process one command line switch
// ---------------------------------------------------------------------------------

void flag (char *arg)
{
	int major, minor;

	while (*arg) {
		switch (*arg++) {
			case 'o':							// output (load) file name
				if (! *arg)
					bail(usestr);
				outfn = arg;
				return;

			case 'p':
				passcount = TRUE;
				break;

			case 'v':							// mumble while running
				verbose = TRUE;
				break;

			case 'x':							// print cross reference table
				do_xref = TRUE;
				break;
			
			case 's':							// print symbol table
				do_syms = TRUE;
				break;

			case 'l':							// listing file name
				listfn = (* arg) ? arg : NULL;
				do_list = TRUE;
				return;

			case 'W':
				saveprompt = FALSE;
				// fall through
			case 'w':
				savetable = TRUE;
				break;

			case 'y':
				preload = TRUE;
				break;

			case 'b':
				outmode = OUTMODE_BINARY;
				break;

			case 'r':
				if (sscanf(arg, "%d.%d", &major, &minor) != 2)
					bail(usestr);
				sprintf(dmsversion, "V%01.1dM%02.2d", major, minor);
				return;

			default:
				bail(usestr);
				break;
		}
	}
}

// ---------------------------------------------------------------------------------
// bail - print error message on stderr (only) and exit
// ---------------------------------------------------------------------------------

void bail (char *msg)
{
	fprintf(stderr, "%s\n", msg);
	exit(1);
}

// ---------------------------------------------------------------------------------
// errprintf - print error message to stderr
// ---------------------------------------------------------------------------------

void errprintf (char *fmt, ...)
{
	va_list args;

	va_start(args, fmt);							// get pointer to argument list

	vfprintf(stderr, fmt, args);					// write errors to terminal (stderr)

	va_end(args);
}

// ---------------------------------------------------------------------------------
// asm_error - report an error to listing file and to user's console
// ---------------------------------------------------------------------------------

void asm_error (char *fmt, ...)
{
	va_list args;

	if (pass == 1)									// only print on pass 2
		return;

	va_start(args, fmt);							// get pointer to argument list

	fprintf(stderr, "E: %s (%d): ", curfn, lno);
	vfprintf(stderr, fmt, args);					// write errors to terminal (stderr)
	putc('\n', stderr);

	if (flist != NULL && list_on) {
		listout(FALSE);
		line_error = TRUE;

		fprintf(flist, "**** Error: ");
		vfprintf(flist, fmt, args);					// write errors to listing file
		putc('\n', flist);
	}

	nerrors++;
	va_end(args);
}

// ---------------------------------------------------------------------------------
// asm_warning - same but warnings are not counted
// ---------------------------------------------------------------------------------

void asm_warning (char *fmt, ...)
{
	va_list args;

	if (pass == 1)									// only print on pass 2
		return;

	va_start(args, fmt);							// get pointer to argument list

	fprintf(stderr, "W: %s (%d): ", curfn, lno);
	vfprintf(stderr, fmt, args);					// write errors to terminal (stderr)
	putc('\n', stderr);

	if (flist != NULL && list_on) {
		listout(FALSE);
		line_error = TRUE;

		fprintf(flist, "**** Warning: ");
		vfprintf(flist, fmt, args);					// write errors to listing file
		putc('\n', flist);
	}

	nwarnings++;
}

// ---------------------------------------------------------------------------------
// sym_list - print the symbol table
// ---------------------------------------------------------------------------------

void sym_list (void)
{
	PSYMBOL s;
	int n = 5;

	if (symbols == NULL || flist == NULL)
		return;

	fprintf(flist, "\n=== SYMBOL TABLE ==============================================================\n");

	for (s = symbols, n = 0; s != NULL; s = s->next) {
		if (n >= 5) {
			putc('\n', flist);
			n = 0;
		}
		else if (n > 0)
			fprintf(flist, "     ");

		fprintf(flist, "%-6s ", s->name);
		if (s->defined == S_DEFINED)
			fprintf(flist, "%04x%s", s->value & 0xFFFF, s->relative ? "R" : " ");
		else
			fprintf(flist, "UUUU ");

		n++;
	}
	fprintf(flist, "\n");
}

// ---------------------------------------------------------------------------------
// passreport - report # of passes required for assembly on the 1130
// ---------------------------------------------------------------------------------

void passreport (void)
{
	PSYMBOL s;

	for (s = symbols; s != NULL; s = s->next) {
		if (s->defined == S_UNDEFINED || s->defined == S_PROVISIONAL) {
			printf("There are undefined symbols. Cannot determine pass requirement.\n");
			return;
		}
	}

	if (hasforward)
		printf("There are forward references. Two passes are required.\n");
	else
		printf("There are no forward references. Only one pass is required.\n");
}

// ---------------------------------------------------------------------------------
// xref_list - print the cross-reference table
// ---------------------------------------------------------------------------------

void xref_list (void)
{
	int n = 0;
	PXREF x;
	PSYMBOL s;

	if (flist == NULL || symbols == NULL)
		return;

	fprintf(flist, "\n=== CROSS REFERENCES ==========================================================\n");

	if (symbols == NULL || flist == NULL)
		return;

	fprintf(flist, "Name  Val  Defd Referenced\n");

	for (s = symbols; s != NULL; s = s->next) {
		fprintf(flist, "%-5s %04x%s", s->name, s->value & 0xFFFF, s->relative ? "R" : " ");

		for (x = s->xrefs; x != NULL; x = x->next)
			if (x->definition)
				break;

		if (x == NULL)
			fprintf(flist, "----");
		else
			fprintf(flist, " %4d", x->lno);

		for (n = 0, x = s->xrefs; x != NULL; x = x->next) {
			if (x->definition)
				continue;

			if (n >= 12) {
				n = 0;
				fprintf(flist, "\n               ");
			}
			fprintf(flist, " %4d", x->lno);
			n++;
		} 
		putc('\n', flist);
	}
}

// ---------------------------------------------------------------------------------
// listhdr - print a banner header in the listing file. Since it's not paginated
// at this time, this is not used often.
// ---------------------------------------------------------------------------------

void listhdr (void)
{
	time_t t;
	
	time(&t);
	fprintf(flist, "%s -- %s -- %s\n", VERSION, dmsversion, ctime(&t));
}

// ---------------------------------------------------------------------------------
// astring - allocate a copy of a string
// ---------------------------------------------------------------------------------

char *astring (char *str)
{
	static char *s = NULL;

	if (s != NULL)
		if (strcmp(s, str) == 0)		// if same as immediately previous allocation
			return s;					// return same pointer (why did I do this?)

	if ((s = malloc(strlen(str)+1)) == NULL)
		bail("out of memory");

	strcpy(s, str);
	return s;
}

// ---------------------------------------------------------------------------------
// lookup_symbol - get pointer to a symbol.
// If define is TRUE, creates and marks 'undefined' if not previously defined.
// ---------------------------------------------------------------------------------

PSYMBOL lookup_symbol (char *name, BOOL define)
{
	PSYMBOL s, n, prv = NULL;
	int c;
	char *at;

	if (strlen(name) > 5) {				// (sigh)
		asm_error("Symbol '%s' is longer than 5 letters", name);
		name[5] = '\0';
	}

#ifdef FIX_ATS
	while ((at = strchr(name, '@')) != NULL)
		*at = '\'';
#endif
										// search sorted list of symbols
	for (s = symbols; s != NULL; prv = s, s = s->next) {
		c = strcmpi(s->name, name);
		if (c == 0)
			return s;
		if (c > 0)
			break;
	}

	if (! define)
		return NULL;					// not found

	if ((n = malloc(sizeof(SYMBOL))) == NULL)
		bail("out of memory");

	n->name    = astring(name);			// symbol was undefined -- add it now
	n->value   = 0;
	n->defined = FALSE;
	n->xrefs   = NULL;
	n->defined = FALSE;

	n->next    = s;						// link in alpha order

	if (prv == NULL)					// we stopped before first item in list
		symbols = n;
	else
		prv->next = n;					// insert after item before place we stopped

	return n;
}

// ---------------------------------------------------------------------------------
// add_xref - add a cross reference entry to a symbol
// ---------------------------------------------------------------------------------

void add_xref (PSYMBOL s, BOOL definition)
{
	PXREF x, prv = NULL, n;

	if (pass == 1 || ! do_xref)			// define only during 2nd pass and only if listing was requested
		return;

	for (x = s->xrefs; x != NULL; prv = x, x = x->next)
		if (strcmpi(x->fname, curfn) == 0 && x->lno == lno)
			return;						// ignore multiple refs on same line

	if ((n = malloc(sizeof(XREF))) == NULL)
		bail("out of memory");

	n->fname = astring(curfn);
	n->lno   = lno;
	n->definition = definition;

	n->next = x;						// link at end of existing list

	if (prv == NULL)
		s->xrefs = n;
	else
		prv->next = n;
}

// ---------------------------------------------------------------------------------
// get_symbol - get a symbol value, defining if necessary
// ---------------------------------------------------------------------------------

int get_symbol (char *name) 
{
	PSYMBOL s;

	s = lookup_symbol(name, TRUE);			// lookup, define if necessary
	
	if (pass == 2)							// should be defined by now
		if (! s->defined)
			asm_error("Symbol '%s' is undefined", name);

	add_xref(s, FALSE);						// note the reference

	return s->value;			
}

// ---------------------------------------------------------------------------------
// set_symbol - set a symbol value. Known = TRUE means we really know the value;
// FALSE means we're calculating it with forward referenced values or something like
// that.
// ---------------------------------------------------------------------------------

void set_symbol (char *name, int value, int known, RELOC relative) 
{
	PSYMBOL s;
	char *at;

	if (strlen(name) > 5) {
		asm_error("Symbol '%s' is longer than 5 letters", name);
		name[5] = '\0';
	}

#ifdef FIX_ATS
	while ((at = strchr(name, '@')) != NULL)
		*at = '\'';
#endif

	s = lookup_symbol(name, TRUE);
	
	if (s->defined == S_DEFINED)			// once defined, it should not change
		if (s->value != value)
			asm_error("Symbol '%s' %s", name, (s->pass == pass) ? "is multiply defined" : "changed between passes");

	s->value    = value;
	s->relative = relative;
	s->defined  = known ? S_DEFINED : S_PROVISIONAL;
	s->pass     = pass;

	if (! known)
		hasforward = TRUE;

	add_xref(s, TRUE);						// record the place of definition
}

// ---------------------------------------------------------------------------------
// skipbl - return pointer to first nonblank character in string s
// ---------------------------------------------------------------------------------

char *skipbl (char *s)
{
	while (*s && *s <= ' ')
		s++;

	return s;
}

// ---------------------------------------------------------------------------------
// gtok - extracts a whitespace-delimited token from the string pointed to by *pc;
// stores the token into the buffer tok and returns pointer to same.  Returns NULL
// when there are no tokens.  Best to call repeatedly with a pointer to the source
// buffer, e.g.
//			char *pbuf = buf;
//			while (gtok(&pbuf, token) != NULL) ...
// ---------------------------------------------------------------------------------

char * gtok (char **pc, char *tok)
{
	char *s = *pc, *otok = tok;

	while (*s && *s <= ' ')			// skip blanks
		s++;

	if (! *s) {						// no tokens to be found
		*tok = '\0';
		*pc = s;
		return NULL;
	}

	while (*s > ' ')				// save nonblanks into 'tok'
		*tok++ = *s++;

	*tok = '\0';					// terminate
	*pc = s;						// adjust caller's pointer

	return otok;					// return pointer to token
}

// listing format:
//
// ADDR CODE                  SOURCE
// 0000 0000 0000 0000 0000 | XXXXXXXXXXXXXXXXX

// ---------------------------------------------------------------------------------
// trim - remove trailing whitespace from string s
// ---------------------------------------------------------------------------------

char *trim (char *s)
{
	char *os = s, *nb;

	for (nb = s-1; *s; s++)
		if (*s > ' ')
			nb = s;

	nb[1] = '\0';
	return os;
}

// ---------------------------------------------------------------------------------
// listout - emit current constructed output listing line held in "listline" and
// if "reset" is true, prepare listline for second and subsequent listing lines
// for a given input statement.
// ---------------------------------------------------------------------------------

void listout (BOOL reset)
{
	if (flist && list_on && ! line_error) {
		trim(listline);
		fputs(listline, flist);
		putc('\n', flist);
		if (reset)
			sprintf(listline, LEFT_MARGIN, org);
	}
}

// ---------------------------------------------------------------------------------
// storew - store a word in the output medium (hex or binary file). Most of the time
// writew is used. Advances the origin!
// ---------------------------------------------------------------------------------

void storew (int word, RELOC relative)
{
	if (pass == 2) {					// save in output (load) file.
		switch (outmode) {
			case OUTMODE_BINARY:
				bincard_writew(word, relative);
				break;

			case OUTMODE_LOAD:
				fprintf(fout, " %04x%s" ENDLINE, word & 0xFFFF,
					(relative == ABSOLUTE) ? ""  : (relative == RELATIVE) ? "R" :
					(relative == LIBF)     ? "L" : (relative == CALL)     ? "$" : "?");
				break;

			default:
				bail("in storew, can't happen");
		}
	}

	if (relative != LIBF)
		org++;

	assembled = TRUE;					// remember that we wrote something
}

// ---------------------------------------------------------------------------------
// setw - store a word value in the current listing output line in position 'pos'.
// ---------------------------------------------------------------------------------

void setw (int pos, int word, RELOC relative)
{
	char tok[10], *p;
	int i;
	
	if (flist == NULL || ! list_on)
		return;

	sprintf(tok, "%04x", word & 0xFFFF);

	for (i = 0, p = listline + 5*pos; i < 4; i++)
		p[i] = tok[i];

	if (relative == RELATIVE)
		p[i] = 'R';
	else if (relative != ABSOLUTE)
		p[i] = '*';
}

// ---------------------------------------------------------------------------------
// writew - emit an assembled word value.  Words are also displayed in the listing file.
// if relative is true, a relocation entry should be recorded.
// ---------------------------------------------------------------------------------

void writew (int word, RELOC relative)
{										// first, the listing stuff...
	if (nwout == 0) {					// on first output word, display address in column 0
		setw(0, org, FALSE);
	}
	else if (nwout >= 4) {				// if 4 words have already been written, start new line
		listout(TRUE);
		nwout = 0;
	}

	nwout++;
	setw(nwout, word, relative);		// display word in the listing line

	storew(word, relative);				// write it to the output medium
}

// ---------------------------------------------------------------------------------
// setorg - take note of new load address
// ---------------------------------------------------------------------------------

void setorg (int neworg)
{
	if (pass == 2) {
		setw(0, neworg, FALSE);						// display in listing file in column 0

		if (outmode == OUTMODE_LOAD) {				// write new load address to the output file
			fprintf(fout, "@%04x%s" ENDLINE, neworg & 0xFFFF, relocate ? "R" : "");
		}
		else {
			bincard_setorg(neworg);
		}
	}

	org = neworg;
}

// ---------------------------------------------------------------------------------
// org_even - force load address to an even address
// ---------------------------------------------------------------------------------

void org_even (void)
{
	if (org & 1)
		setorg(org+1);
}

// ---------------------------------------------------------------------------------
// tabtok - get the token in tab-delimited column number i, from source string c,
// saving in string 'tok'. If save is nonnull, we copy the entire remainder of
// the input string in buffer 'save' (in contrast to 'tok' which gets only the
// first whitespace delimited token).
// ---------------------------------------------------------------------------------

void tabtok (char *c, char *tok, int i, char *save)
{
	*tok = '\0';

	while (--i >= 0) {			// skip to i'th tab-delimited field
		if ((c = strchr(c, '\t')) == NULL) {
			if (save)			// was none
				*save = '\0';
			return;
		}
		c++;
	}

	while (*c == ' ')			// skip leading blanks
		c++;

	if (save != NULL)			// save copy of entire remainder
		strcpy(save, c);

	while (*c > ' ') {			// take up to any whitespace
		if (*c == '(') {			// if we start with a paren, take all up to closing paren including spaces
			while (*c && *c != ')')
				*tok++ = *c++;
		}
		else if (*c == '.') {		// period means literal character following
			*tok++ = *c++;
			if (*c)
				*tok++ = *c++;
		}
		else
			*tok++ = *c++;
	}

	*tok = '\0';
}

// ---------------------------------------------------------------------------------
// coltok - extract a token from string c, saving to buffer tok, by examining
// columns ifrom through ito only.  If save is nonnull, the entire remainder
// of the input from ifrom to the end is saved there. In this routine
// if condense is true, we save all nonwhite characters in the column range;
// not the usual thing. This helps us coalesce the format, tag, & index things
// nto one string for the simple minded parser. If condense is FALSE, we terminate
// on the first nonblank, except that if we start with a (, we take up to ) and
// then terminate on a space.
//
// ifrom and ito on entry are column numbers, not indices; we change that right away
// ---------------------------------------------------------------------------------

void coltok (char *c, char *tok, int ifrom, int ito, BOOL condense, char *save)
{
	char *otok = tok;
	int i;

	ifrom--;
	ito--;

	for (i = 0; i < ifrom; i++) {
		if (c[i] == '\0') {				// line ended before this column
			*tok = '\0';
			if (save)
				*save = '\0';
			return;
		}
	}

	if (save)							// save from ifrom on
		strcpy(save, c+i);

	if (condense) {
		for (; i <= ito; i++) {			// save only nonwhite characters
			if (c[i] > ' ')
				*tok++ = c[i];
		}
	}
	else {
		if (c[i] == ' ' && save != NULL)// if it starts with a space, it's empty
			*save = '\0';

		while (i <= ito) {				// take up to any whitespace
			if (c[i] <= ' ')
				break;
			else if (c[i] == '(') {		// starts with paren? take to close paren
				while (i <= ito && c[i]) {
					if ((*tok++ = c[i++]) == ')')
						break;
				}
			}
			else if (c[i] == '.') {		// period means literal character following
				*tok++ = c[i++];
				if (i <= ito && c[i])
					*tok++ = c[i++];
			}
			else
				*tok++ = c[i++];
		}
	}

	*tok = '\0';
	trim(otok);
}

// ---------------------------------------------------------------------------------
// opcode table
// ---------------------------------------------------------------------------------

// modifiers for the opcode definition table:

#define L		"L"			// long
#define X		"X"			// absolute displacement
#define I		"I"			// indirect
#define IDX		"0123"		// indexed (some LDX commands in the DMS source say LDX L0, so accept 0
#define E		"E"			// even address
#define NONE	""
#define ALL		L X I IDX		// hope non-Microsoft C accepts and concatenates strings like this
#define ANY		"\xFF"
#define NUMS	"0123456789"

#define IS_DBL	0x0001			// double word operand implies even address
#define IS_ABS	0x0002			// always uses absolute addressing mode (implied X)
#define NO_IDX	0x0004			// even with 1 or 2 modifier, this is not really indexed (for STX/LDX)
#define NO_ARGS	0x0008			// statement takes no arguments
#define TRAP	0x1000			// debug this instruction

struct tag_op {											// OPCODE TABLE
	char *mnem;
	int  opcode;
	void (*handler)(struct tag_op *op, char *label, char *mods, char *arg);
	char *mods_allowed;
	char *mods_implied;
	int  flags;
};
								// special opcode handlers
void std_op (struct tag_op *op, char *label, char *mods, char *arg);
void b_op	(struct tag_op *op, char *label, char *mods, char *arg);
void bsc_op (struct tag_op *op, char *label, char *mods, char *arg);
void bsi_op (struct tag_op *op, char *label, char *mods, char *arg);
void mdx_op (struct tag_op *op, char *label, char *mods, char *arg);
void shf_op (struct tag_op *op, char *label, char *mods, char *arg);

void x_aif  (struct tag_op *op, char *label, char *mods, char *arg);
void x_aifb (struct tag_op *op, char *label, char *mods, char *arg);
void x_ago  (struct tag_op *op, char *label, char *mods, char *arg);
void x_agob (struct tag_op *op, char *label, char *mods, char *arg);
void x_anop (struct tag_op *op, char *label, char *mods, char *arg);
void x_abs  (struct tag_op *op, char *label, char *mods, char *arg);
void x_call (struct tag_op *op, char *label, char *mods, char *arg);
void x_dsa  (struct tag_op *op, char *label, char *mods, char *arg);
void x_file (struct tag_op *op, char *label, char *mods, char *arg);
void x_link (struct tag_op *op, char *label, char *mods, char *arg);
void x_libf (struct tag_op *op, char *label, char *mods, char *arg);
void x_org  (struct tag_op *op, char *label, char *mods, char *arg);
void x_opt  (struct tag_op *op, char *label, char *mods, char *arg);
void x_ces  (struct tag_op *op, char *label, char *mods, char *arg);
void x_bes  (struct tag_op *op, char *label, char *mods, char *arg);
void x_bss  (struct tag_op *op, char *label, char *mods, char *arg);
void x_dc   (struct tag_op *op, char *label, char *mods, char *arg);
void x_dec  (struct tag_op *op, char *label, char *mods, char *arg);
void x_ebc  (struct tag_op *op, char *label, char *mods, char *arg);
void x_end  (struct tag_op *op, char *label, char *mods, char *arg);
void x_ent  (struct tag_op *op, char *label, char *mods, char *arg);
void x_epr  (struct tag_op *op, char *label, char *mods, char *arg);
void x_equ  (struct tag_op *op, char *label, char *mods, char *arg);
void x_exit (struct tag_op *op, char *label, char *mods, char *arg);
void x_ils  (struct tag_op *op, char *label, char *mods, char *arg);
void x_iss  (struct tag_op *op, char *label, char *mods, char *arg);
void x_libr (struct tag_op *op, char *label, char *mods, char *arg);
void x_lorg (struct tag_op *op, char *label, char *mods, char *arg);
void x_dmes (struct tag_op *op, char *label, char *mods, char *arg);
void x_dn   (struct tag_op *op, char *label, char *mods, char *arg);
void x_dump (struct tag_op *op, char *label, char *mods, char *arg);
void x_pdmp (struct tag_op *op, char *label, char *mods, char *arg);
void x_hdng (struct tag_op *op, char *label, char *mods, char *arg);
void x_list (struct tag_op *op, char *label, char *mods, char *arg);
void x_spac (struct tag_op *op, char *label, char *mods, char *arg);
void x_spr  (struct tag_op *op, char *label, char *mods, char *arg);
void x_ejct (struct tag_op *op, char *label, char *mods, char *arg);
void x_trap (struct tag_op *op, char *label, char *mods, char *arg);
void x_xflc (struct tag_op *op, char *label, char *mods, char *arg);

struct tag_op ops[] = {
	".OPT", 0,   	x_opt,  NONE, 		NONE,	0,		// non-IBM extensions
	"TRAP", 0,      x_trap, NONE,       NONE,	0,		// assembler breakpoint trap
	".CES",	0,      x_ces,	NONE,       NONE,	0,		// lets us specify simulated console entry switch values for startup

	"ABS",	0,		x_abs,	NONE,		NONE,	0,
	"BES",	0,		x_bes,	E, 	  		NONE,	0,		// standard pseudo-ops
	"BSS",	0,		x_bss,	E, 	  		NONE,	0,
	"DC",	0,		x_dc,	NONE, 		NONE,	0,
	"DEC",  0,      x_dec,  E,          E, 		IS_DBL,
	"DMES",	0,		x_dmes,	ANY,		NONE,	0,
	"DN",	0,		x_dn,	NONE,		NONE,	0,
	"DSA",	0,		x_dsa,	NONE,		NONE,	0,
	"DUMP",	0,		x_dump,	NONE,		NONE,	0,
	"EBC",	0,		x_ebc,	NONE,		NONE,	0,
	"EJCT",	0,		x_ejct,	NONE,		NONE,	0,
	"END",  0,      x_end,	NONE, 		NONE,	0,
	"ENT",	0,		x_ent,	NONE,		NONE,	0,
	"EPR",	0,		x_epr,	NONE,		NONE,	0,
	"EQU",	0,		x_equ,	NONE, 		NONE, 	0,
	"EXIT",	0,		x_exit,	NONE,		NONE,	0,		// alias for call $exit since we don't have macros yet
	"FILE",	0,		x_file,	NONE,		NONE,	0,
	"HDNG",	0,		x_hdng,	ANY,		NONE,	0,
	"ILS",	0,		x_ils,	NUMS,		NONE,	0,
	"ISS",	0,		x_iss,	NUMS,		NONE,	0,
	"LIBF",	0,		x_libf,	NONE,		NONE,	0,
	"LIBR",	0,		x_libr,	NONE,		NONE,	0,
	"LINK",	0,		x_link,	NONE,		NONE,	0,
	"LIST",	0,		x_list,	NONE,		NONE,	0,
	"LORG", 0,      x_lorg, NONE,       NONE,	0,
	"ORG",	0,		x_org,	NONE, 		NONE,	0,
	"PDMP",	0,		x_pdmp,	NONE,		NONE,	0,
	"SPAC",	0,		x_spac,	NONE,		NONE,	0,
	"SPR",	0,		x_spr,	NONE,		NONE,	0,
	"XFLC", 0,		x_xflc, NONE,		NONE,	0,

	"A",	0x8000,	std_op, ALL, 		NONE,	0,		// standard addressing ops
	"AD",	0x8800,	std_op, ALL, 		NONE,	IS_DBL,
	"AND",	0xE000,	std_op, ALL, 		NONE,	0,
	"BSI",	0x4000, bsi_op, ALL,		NONE,	0,
	"CALL", 0x4000, x_call,	ALL,        L,		0,		// alias for BSI L, or external call
	"D"	,	0xA800,	std_op, ALL, 		NONE,	0,
	"EOR",	0xF000,	std_op, ALL, 		NONE,	0,
	"LD",	0xC000,	std_op, ALL, 		NONE,	0,
	"LDD",	0xC800,	std_op, ALL, 		NONE,	IS_DBL,
	"LDS",	0x2000,	std_op, NONE,		NONE,	IS_ABS,
	"LDX",	0x6000,	std_op, ALL,		NONE,	IS_ABS|NO_IDX,
	"M",	0xA000,	std_op, ALL, 		NONE,	0,
	"MDX",  0x7000, mdx_op, ALL,    	NONE,	0,
	"MDM",  0x7000, mdx_op, L,			L,	   	0,		// like MDX L
	"NOP",	0x1000, std_op, NONE, 		NONE,	NO_ARGS,
	"OR",	0xE800,	std_op, ALL, 		NONE,	0,
	"S",	0x9000,	std_op, ALL, 		NONE,	0,
	"SD",	0x9800,	std_op, ALL, 		NONE,	IS_DBL,
	"STD",	0xD800,	std_op, ALL, 		NONE,	IS_DBL,
	"STO",	0xD000,	std_op, ALL, 		NONE,	0,
	"STS",	0x2800,	std_op, ALL, 		NONE,	0,
	"STX",	0x6800,	std_op, ALL, 		NONE,	NO_IDX,
	"WAIT",	0x3000, std_op, NONE,		NONE,	NO_ARGS,
	"XCH",	0x1810, std_op, NONE,		NONE,	0,		// same as RTE 16
	"XIO",  0x0800, std_op, ALL,		NONE,	IS_DBL,

	"BSC",	0x4800, bsc_op, ALL,		NONE,	0,		// branch family
	"BOSC",	0x4840, bsc_op, ALL,        NONE,	0,		// is BOSC always long form? No.
	"SKP",	0x4800, bsc_op,	NONE,		NONE,	0,		// alias for BSC one word version

	"B",	0x4800, b_op,   ALL,		NONE,	0,		// alias for MDX or BSC L 
	"BC",	0x4802, std_op, ALL,		L,		0,		// alias for BSC L 
	"BN",	0x4828, std_op, ALL,		L,		0,		// alias for BSC L 
	"BNN",	0x4810, std_op, ALL,		L,		0,		// alias for BSC L 
	"BNP",	0x4808, std_op, ALL,		L,		0,		// alias for BSC L 
	"BNZ",	0x4820, std_op, ALL,		L,		0,		// alias for BSC L 
	"BO",	0x4801, std_op, ALL,		L,		0,		// alias for BSC L 
	"BOD",	0x4840, std_op, ALL,		L,		0,		// alias for BSC L 
	"BP",	0x4830, std_op, ALL,		L,		0,		// alias for BSC L 
	"BZ",	0x4818, std_op, ALL,	L,		0,		// alias for BSC L 

	"RTE",	0x18C0, shf_op, IDX X, 		X,		0,		// shift family
	"SLA",	0x1000, shf_op, IDX X,  	X,		0,
	"SLC",	0x10C0, shf_op, IDX X,  	X,		0,
	"SLCA",	0x1040, shf_op, IDX X,  	X,	   	0,
	"SLT",	0x1080, shf_op, IDX X,  	X,	  	0,
	"SRA",	0x1800, shf_op, IDX X,  	X,	 	0,
	"SRT",	0x1880, shf_op, IDX X,  	X,		0,

	"AIF",	0,		x_aif,	NONE,		NONE,	0,		// assemble if
	"AIFB",	0,		x_aifb,	NONE,		NONE,	0,		// assemble if
	"AGO",	0,		x_ago,	NONE,		NONE,	0,		// assemble goto
	"AGOB",	0,		x_agob,	NONE,		NONE,	0,		// assemble goto
	"ANOP",	0,		x_anop,	NONE,		NONE,	0,		// assemble target

	NULL	// end of table
};

// ---------------------------------------------------------------------------------
// addextn - apply file extension 'extn' to filename 'fname' and put result in 'outbuf'
// if outbuf is NULL, we allocate a buffer
// ---------------------------------------------------------------------------------

char *addextn (char *fname, char *extn, char *outbuf)
{
	char *buf, line[500], *c;

	buf = (outbuf == NULL) ? line : outbuf;

	strcpy(buf, fname);							// create listfn from first source filename (e.g. xxx.lst);
	if ((c = strrchr(buf, '\\')) == NULL)
		if ((c = strrchr(buf, '/')) == NULL)
			if ((c = strrchr(buf, ':')) == NULL)
				c = buf;

	if ((c = strrchr(c, '.')) == NULL)
		strcat(buf, extn);
	else
		strcpy(c, extn);

	return (outbuf == NULL) ? astring(line) : outbuf;
}

// ---------------------------------------------------------------------------------
// controlcard - examine an assembler control card (* in column 1)
// ---------------------------------------------------------------------------------

BOOL controlcard (char *line)
{
	if (strnicmp(line, "*LIST", 5) == 0) {		// turn on listing file even if not specified on command line
		do_list = list_on = TRUE;
		return TRUE;
	}
	
	if (strnicmp(line, "*XREF", 5) == 0) {
		do_xref = TRUE;
		return TRUE;
	}

	if (strnicmp(line, "*PRINT SYMBOL TABLE", 19) == 0) {
		do_syms = TRUE;
		return TRUE;
	}

	if (strnicmp(line, "*SAVE SYMBOL TABLE", 18) == 0) {
		savetable = TRUE;
		return TRUE;
	}

	if (strnicmp(line, "*SYSTEM SYMBOL TABLE", 20) == 0) {
		preload = TRUE;
		preload_symbols();
		return TRUE;
	}

	return FALSE;
}

// ---------------------------------------------------------------------------------
// stuff - insert characters into a line
// ---------------------------------------------------------------------------------

void stuff (char *buf, char *tok, int maxchars)
{
	while (*tok) {
		*buf++ = *tok++;
		
		if (maxchars)
			if (--maxchars <= 0)
				break;	
	}
}

// ---------------------------------------------------------------------------------
// format_line - construct a source code input line from components
// ---------------------------------------------------------------------------------

void format_line (char *buf, char *label, char *op, char *mods, char *args, char *remarks)
{
	int i;

	if (tabformat) {
		sprintf(buf, "%s\t%s\t%s\t%s\t%s", label, op, mods, args, remarks);
	}
	else {
		for (i = 0; i < 72; i++)
			buf[i] = ' ';
		buf[i] = '\0';

		stuff(buf+20, label, 5);
		stuff(buf+26, op,    4);
		stuff(buf+31, mods,  2);
		stuff(buf+34, args,  72-34);
	}
}

// ---------------------------------------------------------------------------------
// lookup_op - find an opcode
// ---------------------------------------------------------------------------------

struct tag_op * lookup_op (char *mnem)
{
	struct tag_op *op;
	int i;

	for (op = ops; op->mnem != NULL; op++) {
		if ((i = strcmp(op->mnem, mnem)) == 0)
			return op;

		if (i > 0)
			break;
	}
	return NULL;
}

// ---------------------------------------------------------------------------------
// bincard - routines to write IBM 1130 Card object format
// ---------------------------------------------------------------------------------

unsigned short bincard[54];		// the 54 data words that can fit on a binary format card
char binflag[45];				// the relocation flags of the 45 buffered object words (0, 1, 2, 3)
int bincard_n   = 0;			// number of object words stored in bincard (0-45)
int bincard_seq = 0;			// card output sequence number
int bincard_org = 0;			// origin of current card-full
int bincard_maxaddr = 0;
BOOL bincard_first = TRUE;		// TRUE when we're to write the program type card

// bincard_init - prepare a new object data output card

void bincard_init (void)
{
	memset(bincard, 0, sizeof(bincard));		// clear card data
	memset(binflag, 0, sizeof(binflag));		// clear relocation data
	bincard_n = 0;								// no data
	bincard[0] = bincard_org;					// store load address
	bincard_maxaddr = MAX(bincard_maxaddr, bincard_org-1);	// save highest address written-to (this may be a BSS)
}

// binard_writecard - emit a card. sbrk_text = NULL for normal data cards, points to comment text for sbrk card
// note: sbrk_text if not NULL MUST be a writeable buffer of at LEAST 71 characters

void bincard_writecard (char *sbrk_text)
{
	unsigned short binout[80];
	char ident[12];
	int i, j;

	if (sbrk_text != NULL) {		// sbrk card has 4 binary words followed by comment text
		for (j = 66; j < 71; j++)	// be sure input columns 67..71 are nonblank (have version number)
			if (sbrk_text[j] <= ' ')
				break;
		
		if (j < 71)					// sbrk card didn't have the info, stuff in current release
			for (j = 0; j < 5; j++)
				sbrk_text[66+j] = dmsversion[j];

		binout[0] = 0;
		binout[1] = 0;
		binout[2] = 0;
		binout[3] = 0x1000;

		sbrk_text += 5;				// start at the real column 6 (after *SBRK
		for (j = 5;  j < 72; j++)
			binout[j] = (*sbrk_text) ? ascii_to_hollerith(*sbrk_text++) : 0;

	}
	else {							// binary card format packs 54 words into 72 columns
		for (i = j = 0; i < 54; i += 3, j += 4) {
			binout[j  ] = ( bincard[i]          & 0xFFF0);
			binout[j+1] = ((bincard[i]   << 12) & 0xF000)  | ((bincard[i+1] >> 4) & 0x0FF0);
			binout[j+2] = ((bincard[i+1] <<  8) & 0xFF00)  | ((bincard[i+2] >> 8) & 0x00F0);
			binout[j+3] = ((bincard[i+2] <<  4) & 0xFFF0);
		}
	}

	sprintf(ident, "%08ld", ++bincard_seq);			// append sequence text
	memmove(ident, progname, MIN(strlen(progname), 4));

	for (i = 0; i < 8; i++)
		binout[j++] = ascii_to_hollerith(ident[i]);
	
	fwrite(binout, sizeof(binout[0]), 80, fout);		// write card image
}

// binard_writedata - emit an object data card

void bincard_writedata (void)
{
	unsigned short rflag = 0;
	int i, j, nflag = 0;

	bincard[1] = 0;								// checksum
	bincard[2] = 0x0A00 | bincard_n;			// data card type + word count

	for (i = 0, j = 3; i < bincard_n; i++) {	// construct relocation indicator bitmap
		if (nflag == 8) {
			bincard[j++] = rflag;
			rflag = 0;
			nflag = 0;
		}
		rflag = (rflag << 2) | (binflag[i] & 3);
		nflag++;
	}

	if (nflag > 0)
		bincard[j] = rflag << (16 - 2*nflag);

	bincard_writecard(FALSE);					// emit the card
}

// bincard_flush - flush any pending binary data

void bincard_flush (void)
{
	if (bincard_n > 0)
		bincard_writedata();

	bincard_init();
}

// bincard_sbrk - emit an SBRK card

void bincard_sbrk (char *line)
{
	if (bincard_first)
		bincard_typecard();
	else
		bincard_flush();

	bincard_writecard(line);
}

// bincard_setorg - set the origin

void bincard_setorg (int neworg)
{
	bincard_org = neworg;			// set origin for next card
	bincard_flush();				// flush any current data & store origin
}

// bincard_endcard - write end of program card

void bincard_endcard (void)
{
	bincard_flush();

	bincard[0] = (bincard_maxaddr + 2) & ~1;	// effective length: add 1 to max origin, then 1 more to round up
	bincard[1] = 0;
	bincard[2] = 0x0F00;
	bincard[3] = pta & 0xFFFF;

	bincard_writecard(NULL);
}

// bincard_typecard - write the program type 

void bincard_typecard (void)
{
	int i;

	if (! bincard_first) 
		return;

	bincard_first = FALSE;

	memset(bincard, 0, sizeof(bincard));

	bincard[2] = (unsigned short) ((progtype << 8) | intmode | realmode);

// all indices not listed are documented as 'reserved'

	switch (progtype) {
		case PROGTYPE_ABSOLUTE:
		case PROGTYPE_RELOCATABLE:
//			bincard[ 4] = 0;		// length of common (fortran only)
			bincard[ 5] = 0x0003;
//			bincard[ 6] = 0;		// length of work area (fortran only)
			bincard[ 8] = ndefined_files;
			namecode(&bincard[9], progname);
			bincard[11] = (pta < 0) ? 0 : pta;
			break;

		case PROGTYPE_LIBF:
		case PROGTYPE_CALL:
			bincard[ 5] = 3*nentries;
			for (i = 0; i < nentries; i++) {
				namecode(&bincard[9+3*i], entry[i]->name);
				bincard[11+3*i] = entry[i]->value;
			}
			break;

		case PROGTYPE_ISSLIBF:
		case PROGTYPE_ISSCALL:
			bincard[ 5] = 6+nintlevels;
			namecode(&bincard[9], entry[0]->name);
			bincard[11] = entry[0]->value;
			bincard[12] = iss_number + ISTV;			// magic number ISTV is 0x33 in DMS R2V12
			bincard[13] = iss_number;
			bincard[14] = nintlevels;
			bincard[15] = intlevel_primary;
			bincard[16] = intlevel_secondary;
			bincard[29] = 1;
			break;

		case PROGTYPE_ILS:
			bincard[ 2] = (unsigned short) (progtype << 8);
			bincard[ 5] = 4;
			bincard[12] = intlevel_primary;
			break;

		default:
			bail("in bincard_typecard, can't happen");
	}

	bincard[1] = 0;		// checksum

	bincard_writecard(NULL);

	bincard_init();
}

// bincard_writew - write a word to the current output card.

void bincard_writew (int word, RELOC relative)
{
	if (pass != 2)
		return;

	if (bincard_first)
		bincard_typecard();
	else if (bincard_n >= 45)				// flush full card buffer
		bincard_flush();

	binflag[bincard_n] = relative & 3;		// store relocation bits and data word
	bincard[9+bincard_n++] = word;

	if (relative != LIBF) {
		bincard_maxaddr = MAX(bincard_maxaddr, bincard_org);
		bincard_org++;
	}
}

// writetwo - notification that we are about to write two words which must stay together

void writetwo (void)
{
	if (pass == 2 && outmode == OUTMODE_BINARY && bincard_n >= 44)
		bincard_flush();
}

// handle_sbrk - handle an SBRK directive.
// This was not part of the 1130 assembler; they assembled DMS on a 360

void handle_sbrk (char *line)
{
	char rline[90];

	if (pass != 2)
		return;

	strncpy(rline, line, 81);			// get a copy and pad it if necessary to 80 characters
	rline[80] = '\0';
	while (strlen(rline) < 80)
		strcat(rline, " ");

	switch (outmode) {
		case OUTMODE_LOAD:
			fprintf(fout, "#SBRK%s\n", trim(rline+5));

		case OUTMODE_BINARY:
			bincard_sbrk(rline);
			break;

		default:
			bail("in handle_sbrk, can't happen");
	}
}

// ---------------------------------------------------------------------------------
// namecode - turn a string into a two-word packed name
// ---------------------------------------------------------------------------------

void namecode (unsigned short *words, char *tok)
{
	long val = 0;
	int i, ch;

	for (i = 0; i < 5; i++) {					// pick up bits
		if (*tok)
			ch = *tok++;
		else
			ch = ' ';

		val = (val << 6) | (ascii_to_ebcdic_table[ch] & 0x3F);
	}

	words[0] = (unsigned short) (val >> 16);
	words[1] = (unsigned short) val;
}

// ---------------------------------------------------------------------------------
// parse_line - parse one input line.
// ---------------------------------------------------------------------------------

void parse_line (char *line)
{
	char label[100], mnem[100], arg[200], mods[20], *c;
	struct tag_op *op;

	if (line[0] == '/' && line[1] == '/')		// job control card? probably best to ignore it
		return;

	if (line[0] == '*') {						// control card comment or comment in tab-format file
		if (check_control)						// pay attention to control cards only at top of file
			if (! controlcard(line))
				check_control = FALSE;			// first non-control card shuts off sensitivity to them

		if (strnicmp(line+1, "SBRK", 4) == 0)
			handle_sbrk(line);

		return;
	}

	check_control = FALSE;						// non-control card, consider them no more

	label[0] = '\0';							// prepare to extract fields
	mods[0]  = '\0';
	mnem[0]  = '\0';
	arg[0]   = '\0';

	if (tabformat || strchr(line, '\t') != NULL) {	// if input line has tabs, parse loosely
		tabformat = TRUE;							// this is a tab-formatted file

		for (c = line; *c && *c <= ' '; c++)	// find first nonblank
		 	;

		if (*c == '*' || ! *c)					// ignore as a comment
			return;

		tabtok(line, label, 0, NULL);
		tabtok(line, mnem,  1, NULL);
		tabtok(line, mods,  2, NULL);
		tabtok(line, arg,   3, opfield);
	}
	else {										// if no tabs, use strict card-column format
		if (line[20] == '*')					// comment
			return;

		line[72] = '\0';						// clip off sequence

		coltok(line, label, 21, 25, TRUE, NULL);
		coltok(line, mnem,  27, 30, TRUE, NULL);
		coltok(line, mods,  32, 33, TRUE, NULL);
		coltok(line, arg,   35, 72, FALSE, opfield);
	}

// I don't know where I got this idea, but it's wrong...
//	if (strchr(mods, '1') || strchr(mods, '2') || strchr(mods, '3')) {	// index + X means ignore X
//		if ((c = strchr(mods, 'X')) != NULL)
//			strcpy(c, c+1);						// remove the X
//	}

	if (*label)									// display org in any line with a label
		setw(0, org, FALSE);

	if (! *mnem) {								// label w/o mnemonic, just define the symbol
		if (*label)
			set_symbol(label, org, TRUE, relocate);
		return;
	}

	if ((op = lookup_op(mnem)) == NULL) {		// look up mnemonic
		if (*label)
			set_symbol(label, org, TRUE, relocate);// at least define the label

		asm_error("Unknown opcode '%s'", mnem);
		return;
	}

	if (op->flags & TRAP)						// assembler debugging breakpoint
		x_trap(op, label, mods, arg);

	if (*op->mods_allowed != '\xFF') {			// validate modifiers against list of allowed characters
		for (c = mods; *c; ) {
			if (strchr(op->mods_allowed, *c) == NULL) {
				asm_warning("Modifier '%c' not permitted", *c);
				strcpy(c, c+1);					// remove it and keep parsing
			}
			else
				c++;
		}
	}

	strcat(mods, op->mods_implied);				// tack on implied modifiers

	if (strchr(mods, 'I'))						// indirect implies long
		strcat(mods, "L");

	requires_even_address = op->flags & IS_DBL;

	org_advanced = strchr(mods, 'L') ? 2 : 1;	// by default, * means address + 1 or 2. Sometimes it doesn't
	(op->handler)(op, label, mods, arg);
}

// ---------------------------------------------------------------------------------
// get one input line from current file or macro
// ---------------------------------------------------------------------------------

BOOL get_line (char *buf, int nbuf, BOOL onelevel)
{
	char *retval;

	if (ended)								// we hit the END command
		return FALSE;
	
	// if macro active, return line from macro buffer, otherwise read from file
	// do not pop end-of-macro if onelevel is TRUE 

	if ((retval = fgets(buf, nbuf, fin)) == NULL)
		return FALSE;

	lno++;									// count the line
	return TRUE;
}

// ---------------------------------------------------------------------------------
// proc - process one pass of one source file
// ---------------------------------------------------------------------------------

void proc (char *fname)
{																											    	
	char line[256], *c;
	int i;

	if (strchr(fname, '.') == NULL)				// if input file has no extension,
		addextn(fname, ".asm", curfn);			// set appropriate file extension
	else
		strcpy(curfn, fname);					// otherwise use extension specified

// let's leave filename case alone even if it doesn't matter
//#if (defined(WIN32) || defined(VMS))
//	upcase(curfn);								// only force uppercase of name on Windows and VMS
//#endif

	if (progname[0] == '\0') {					// pick up primary filename
		if ((c = strrchr(curfn, '\\')) == NULL)
			if ((c = strrchr(curfn, '/')) == NULL)
				if ((c = strrchr(curfn, ':')) == NULL)
					c = curfn;

		strncpy(progname, c, sizeof(progname));	// take name after path
		progname[sizeof(progname)-1] = '\0';
		if ((c = strchr(progname, '.')) != NULL)// remove extension
			*c = '\0';
	}

	lno   = 0;									// reset global input line number
	ended = FALSE;								// have not seen END statement

	if (listfn == NULL)							// if list file name is undefined,
		listfn = addextn(fname, ".lst", NULL);	// create from first filename

	if (verbose)
		fprintf(stderr, "--- Starting file %s pass %d\n", curfn, pass);

	if ((fin = fopen(curfn, "r")) == NULL) {
		perror(curfn);							// oops
		exit(1);
	}

	if (flist) {								// put banner in listing file
		strcpy(listline,"=== FILE ======================================================================");
		for (i = 9, c = curfn; *c;)
			listline[i++] = *c++;
		listline[i] = ' ';
		fputs(listline, flist);
		putc('\n', flist);
		list_on = TRUE;
	}
												// read all lines till EOF or END statement
	while (get_line(line, sizeof(line), FALSE)) {
		prep_line(line);						// preform standard line prep
		parse_line(line);						// parse
		listout(FALSE);							// complete the listing
	}

	fclose(fin);

	if (n_literals > 0) {	  					// force out any pending literal constants at end of file
		output_literals(TRUE);
		listout(FALSE);
	}
}

// ---------------------------------------------------------------------------------
// prep_line - prepare input line for parsing
// ---------------------------------------------------------------------------------

void prep_line (char *line)
{
	char *c;

	upcase(line);							// uppercase it
	nwout = 0;								// number of words output so far
	line_error = FALSE;						// no errors on this line so far

	for (c = line; *c; c++) {				// truncate at newline
		if (*c == '\r' || *c == '\n') {
			*c = '\0';
			break;
		}
	}

	if (flist && list_on) {					// construct beginning of listing line
		if (tabformat)
			sprintf(listline, LINEFORMAT, lno, detab(line));
		else {
			if (strlen(line) > 20)			// get the part where the commands start
				c = line+20;
			else
				c = "";

			sprintf(listline, LINEFORMAT, lno, c);
			stuff(listline, line, 20);		// stuff the left margin in to the left side
		}
	}
}

// ---------------------------------------------------------------------------------
// opcmp - operand name comparison routine for qsort
// ---------------------------------------------------------------------------------

int opcmp (const void *a, const void *b)
{
	return strcmp(((struct tag_op *) a)->mnem, ((struct tag_op *) b)->mnem);
}

// ---------------------------------------------------------------------------------
// preload_symbols - load a saved symbol table
// ---------------------------------------------------------------------------------

void preload_symbols (void)
{
	FILE *fd;
	char str[200], sym[20];
	int v;
	static BOOL preloaded_already = FALSE;

	if (pass > 1 || preloaded_already)
		return;

	preloaded_already = TRUE;

	if ((fd = fopen(SYSTEM_TABLE, "r")) == NULL)				// read the system symbol tabl
		perror(SYSTEM_TABLE);
	else {
		while (fgets(str, sizeof(str), fd) != NULL) {
			if (sscanf(str, "%s %x", sym, &v) == 2)
				set_symbol(sym, v, TRUE, FALSE);
		}
		fclose(fd);
	}
}

// ---------------------------------------------------------------------------------
// save_symbols - save a symbol table
// ---------------------------------------------------------------------------------

void save_symbols (void)
{
	FILE *fd;
	char str[20];
	PSYMBOL s;

	if (relocate) {
		fprintf(stderr, "Can't save symbol table unless ABS assembly\n");
		return;
	}

	if ((fd = fopen(SYSTEM_TABLE, "r")) != NULL) {
		fclose(fd);
		if (saveprompt) {
			printf("Overwrite system symbol table %s? ", SYSTEM_TABLE);
			fgets(str, sizeof(str), stdin);
			if (str[0] != 'y' && str[0] != 'Y')
				return;
		}
		unlink(SYSTEM_TABLE);
	}

	if ((fd = fopen(SYSTEM_TABLE, "w")) == NULL) {
		perror(SYSTEM_TABLE);
		return;
	}

	for (s = symbols; s != NULL; s = s->next)
		fprintf(fd, "%-5s %04x\n", s->name, s->value);

	fclose(fd);
}

// ---------------------------------------------------------------------------------
// startpass - initialize data structures, prepare to start a pass
// ---------------------------------------------------------------------------------

void startpass (int n)
{
	int nops;
	struct tag_op *p;

	pass       = n;								// reset globals: pass number
	nerrors    = 0;								// error count
	org        = 0;								// load address (origin)
	lno        = 0;								// input line number
	relocate   = TRUE;							// relocatable assembly mode
	assembled  = FALSE;							// true if any output has been generated
	list_on    = do_list;						// listing enable
	dmes_saved = FALSE;							// partial character strings output

	n_literals = 0;								// literal values pending output
	lit_tag    = 0;

	if (pass == 1) {							// first pass only
		for (nops = 0, p = ops; p->mnem != NULL; p++, nops++)			// count opcodes
			;

		qsort(ops, nops, sizeof(*p), opcmp);							// sort the opcode table

		if (preload)
			preload_symbols();
	}
	else {															// second pass only
		if (outfn == NULL)
			outfn = addextn(curfn, (outmode == OUTMODE_LOAD) ? ".out" : ".bin" , NULL);

		if ((fout = fopen(outfn, OUTWRITEMODE)) == NULL) {				// open output file
			perror(outfn);
			exit(1);
		}

		if (do_list) {													// open listing file
			if ((flist = fopen(listfn, "w")) == NULL) {
				perror(listfn);
				exit(1);
			}
			listhdr();													// print banner
		}
	}
}

// ---------------------------------------------------------------------------------
// x_dc - DC define constant directive
// ---------------------------------------------------------------------------------

void x_dc (struct tag_op *op, char *label, char *mods, char *arg)
{	
	EXPR expr;
//	char *tok;

	org_advanced = 1;					// assume * means this address+1
// doesn't make sense, but I think I found DMS listings to support it

	if (strchr(mods, 'E') != NULL)		// force even address
		org_even();

	setw(0, org, FALSE);				// display org in listing line

	if (*label)							// define label
		set_symbol(label, org, TRUE, relocate);

// just one!?
	getexpr(arg, FALSE, &expr);
	writew(expr.value, expr.relative);	// store value

										// pick up values, comma delimited
//	for (tok = strtok(arg, ","); tok != NULL; tok = strtok(NULL, ",")) {
//		getexpr(tok, FALSE, &expr);
//		writew(expr.value, expr.relative);		// store value
//	}
}

// ---------------------------------------------------------------------------------
// x_dec - DEC define double word constant directive.
// ---------------------------------------------------------------------------------

// wd[0]: 8 unused bits | characteristic (=	exponent+128)
// wd[1]: sign + 15 msb of mantissa in 2's complement 
// wd[2]: 16 lsb of mantissa

// NOTE: these are wrong with Fixed point numbers

void convert_double_to_extended (double d, unsigned short *wd)
{
	int neg, exp;
	unsigned long mantissa;
	unsigned char *byte = (unsigned char *) &d;

	if (d == 0.) {
		wd[0] = wd[1] = wd[2] = 0;
		return;
	}
    //					  7         6         5         4             0
	// d = ansi real*8    SXXX XXXX XXXX MMMM MMMM MMMM MMMM MMMM ... MMMM MMMM

	neg = byte[7] & 0x80;
	exp = ((byte[7] & 0x7F) << 4) | ((byte[6] & 0xF0) >> 4);	// extract exponent
	exp -= 1023;												// remove bias

	exp++;														// shift to account for implied 1 we added

	// get 32 bits worth of mantissa. add the implied point
	mantissa = 0x80000000L | ((byte[6] & 0x0F) << 27) | (byte[5] << 19) | (byte[4] << 11) | (byte[3] << 3) | ((byte[2] & 0xE0) >> 5);

	if (mantissa & (0x80000000L >> 31))							// keep 31 bits, round if necessary
		mantissa += (0x80000000L >> 31);

	mantissa >>= (32-31);										// get into low 31 bits

	// now turn into IBM 1130 extended precision

	exp += 128;

	if (neg)
		mantissa = (unsigned long) (- (long) mantissa);			// two's complement

	wd[0] = (unsigned short) (exp & 0xFF);
	wd[1] = (unsigned short) ((neg ? 0x8000 : 0) | ((mantissa >> (31-15)) & 0x7FFF));
	wd[2] = (unsigned short) (mantissa & 0xFFFF);
}

void convert_double_to_standard (double d, unsigned short *wd)
{
	int neg, exp;
	unsigned long mantissa;
	unsigned char *byte = (unsigned char *) &d;

	if (d == 0.) {
		wd[0] = wd[1] = 0;
		return;
	}
    //					  7         6         5         4             0
	// d = ansi real*8    SXXX XXXX XXXX MMMM MMMM MMMM MMMM MMMM ... MMMM MMMM

	neg = byte[7] & 0x80;
	exp = ((byte[7] & 0x7F) << 4) | ((byte[6] & 0xF0) >> 4);	// extract exponent
	exp -= 1023;												// remove bias

	exp++;														// shift to account for implied 1 we added

	// get 32 bits worth of mantissa. add the implied point
	mantissa = 0x80000000L | ((byte[6] & 0x0F) << 27) | (byte[5] << 19) | (byte[4] << 11) | (byte[3] << 3) | ((byte[2] & 0xE0) >> 5);

//	if (mantissa & (0x80000000L >> 23))							// keep 23 bits, round if necessary
//		mantissa += (0x80000000L >> 23);

// DEBUG
//  printf("%8.4lf: %08lx %d\n", d, mantissa, exp);

	mantissa >>= (32-23);										// get into low 23 bits

	// now turn into IBM 1130 standard precision

	exp += 128;

	if (neg)
		mantissa = (unsigned long) (- (long) mantissa);			// two's complement

	wd[0] = (unsigned short) ((neg ? 0x8000 : 0) | ((mantissa >> (23-15)) & 0x7FFF));
	wd[1] = (unsigned short) ((mantissa & 0x00FF) << 8) | (exp & 0xFF);

// DEBUG
// printf("       D %04x%04x\n", wd[0], wd[1]);
}

void convert_double_to_fixed (double d, unsigned short *wd, int bexp)
{
	int neg, exp, rshift;
	unsigned long mantissa;
	unsigned char *byte = (unsigned char *) &d;

	if (d == 0.) {
		wd[0] = wd[1] = 0;
		return;
	}
    //					  7         6         5         4             0
	// d = ansi real*8    SXXX XXXX XXXX MMMM MMMM MMMM MMMM MMMM ... MMMM MMMM

	neg = byte[7] & 0x80;
	exp = ((byte[7] & 0x7F) << 4) | ((byte[6] & 0xF0) >> 4);	// extract exponent
	exp -= 1023;												// remove bias

	exp++;														// shift to account for implied 1 we added

	// get 32 bits worth of mantissa. add the implied point
	mantissa = 0x80000000L | ((byte[6] & 0x0F) << 27) | (byte[5] << 19) | (byte[4] << 11) | (byte[3] << 3) | ((byte[2] & 0xE0) >> 5);

	mantissa >>= 1;												// shift it out of the sign bit

// DEBUG
// printf("%8.4lf: %08lx %d\n", d, mantissa, exp);

	rshift = bexp - exp;

	if (rshift > 0) {
		mantissa >>= rshift;
	}
	else if (rshift < 0) {
		mantissa >>= (-rshift);
		asm_warning("Fixed point overflow");
	}

	if (neg)
		mantissa = (unsigned long) (- (long) mantissa);			// two's complement

// DEBUG
// printf("       B %08lx\n", mantissa);

	wd[0] = (unsigned short) ((mantissa >> 16) & 0xFFFF);		// return all of the bits; no exponent here
	wd[1] = (unsigned short) (mantissa & 0xFFFF);
}

void getDconstant (char *tok, unsigned short *wd)
{
	unsigned long l;
	char *b, *fmt;
	double d;
	int bexp, fixed;

	wd[0] = 0;
	wd[1] = 0;

	if (strchr(tok, '.') == NULL && strchr(tok, 'B') == NULL && strchr(tok, 'E') == NULL) {
		fmt = "%ld";
		if (*tok == '/') {						// I don't see that this is legal but can't hurt to allow it
			fmt = "%lx";
			tok++;
		}
		if (sscanf(tok, fmt, &l) != 1) {		// no decimal means it's an integer?
			asm_error("Syntax error in constant");
		}
		else {
			wd[0] = (unsigned short) ((l >> 16) & 0xFFFF);	// high word
			wd[1] = (unsigned short) (l & 0xFFFF);			// low word
		}
		return;
	}

	fixed = 0;
	if ((b = strchr(tok, 'B')) != NULL) {
		fixed = 1;
		bexp  = atoi(b+1);
		*b    = '\0';			// truncate at the b
	}
	if (sscanf(tok, "%lg", &d) != 1) {
		asm_error("Syntax error in constant");
		return;
	}

	if (fixed)
		convert_double_to_fixed(d, wd, bexp);
	else
		convert_double_to_standard(d, wd);
}

// If the input value is an integer with no decimal point and no B or E,
// DEC generates a double INTEGER value.
// IBM documentation ranges from ambiguous to wrong on this point, but
// examination of the DMS microfiche supports this.

void x_dec (struct tag_op *op, char *label, char *mods, char *arg)
{	
//	char *tok;
	unsigned short wd[2];

	org_advanced = 2;					// assume * means address after this location, since it's +1 for dc?

	org_even();							// even address is implied
	setw(0, org, FALSE);				// display the origin

	if (*label)							// define label
		set_symbol(label, org, TRUE, relocate);

// just one!?
	getDconstant(arg, wd);
	writew(wd[0], FALSE);				// write hiword, then loword
	writew(wd[1], FALSE);

										// pick up values, comma delimited
//	for (tok = strtok(arg, ","); tok != NULL; tok = strtok(NULL, ",")) {
//		getDconstant(tok, wd);
//
//		writew(wd[0], FALSE);			// write hiword, then loword
//		writew(wd[1], FALSE);
}

void x_xflc (struct tag_op *op, char *label, char *mods, char *arg)
{	
	char *tok, *b;
	double d;
	int bexp, fixed;
	unsigned short wd[3];

	org_advanced = 2;					// who knows?

	setw(0, org, FALSE);				// display the origin

	if (*label)							// define label
		set_symbol(label, org, TRUE, relocate);
										// pick up values, comma delimited
	for (tok = strtok(arg, ","); tok != NULL; tok = strtok(NULL, ",")) {
		bexp = 0;
		if ((b = strchr(tok, 'B')) != NULL) {
			bexp = atoi(b+1);
			fixed = TRUE;
			*b = '\0';					// truncate at the b
			asm_warning("Fixed point extended floating constant?");
		}

		if (sscanf(tok, "%lg", &d) != 1) {
			asm_error("Syntax error in constant");
			d = 0.;
		}

		convert_double_to_extended(d, wd);

		writew(wd[0], ABSOLUTE);
		writew(wd[1], ABSOLUTE);
		writew(wd[2], ABSOLUTE);
	}
}

// ---------------------------------------------------------------------------------
// x_equ - EQU directive
// ---------------------------------------------------------------------------------

void x_equ (struct tag_op *op, char *label, char *mods, char *arg)
{	
	EXPR expr;

	org_advanced = FALSE;				// * means this address, not incremented

	getexpr(arg, FALSE, &expr);

	setw(0, expr.value, expr.relative);	// show this as address

	if (*label)							// EQU is all about defining labels, better have one
		set_symbol(label, expr.value, TRUE, expr.relative);
//	else								// IBM assembler doesn't complain about this
//		asm_error("EQU without label?");
}

// ---------------------------------------------------------------------------------
// x_lorg - LORG directive -- output queued literal values
// ---------------------------------------------------------------------------------

void x_lorg  (struct tag_op *op, char *label, char *mods, char *arg)
{
	org_advanced = FALSE;				// * means this address (not used, though)
	output_literals(FALSE);				// generate .DC's for queued literal values
}

// ---------------------------------------------------------------------------------
// x_abs - ABS directive
// ---------------------------------------------------------------------------------

void x_abs (struct tag_op *op, char *label, char *mods, char *arg)
{
	if (assembled)
		asm_error("ABS must be first statement");

	relocate = ABSOLUTE;

	switch (progtype) {
		case PROGTYPE_ABSOLUTE:
		case PROGTYPE_RELOCATABLE:
			progtype = PROGTYPE_ABSOLUTE;		// change program type, still assumed to be mainline
			break;

		case PROGTYPE_LIBF:
		case PROGTYPE_CALL:
		case PROGTYPE_ISSLIBF:
		case PROGTYPE_ISSCALL:
		case PROGTYPE_ILS:
			asm_error("ABS not allowed with LIBF, ENT, ILS or ISS");
			break;

		default:
			bail("in x_libr, can't happen");
	}
}

// ---------------------------------------------------------------------------------
// x_call - ORG pseudo-op
// ---------------------------------------------------------------------------------

void x_call (struct tag_op *op, char *label, char *mods, char *arg)
{
	unsigned short words[2];
	static struct tag_op *bsi = NULL;

	if (*label)							// define label
		set_symbol(label, org, TRUE, relocate);

	if (! *arg) {
		asm_error("CALL missing argument");
		return;
	}

	if (pass == 1) {						// it will take two words in any case
		org += 2;
		return;
	}

	setw(0, org, FALSE);					// display origin

	if (lookup_symbol(arg, FALSE) != NULL) {	// it's a defined symbol?
		if (bsi == NULL)
			if ((bsi = lookup_op("BSI")) == NULL)
				bail("Can't find BSI op");

		(bsi->handler)(bsi, "", "L", arg);
	}
	else {
		namecode(words, arg);				// emit namecode for loader

		writetwo();
		writew(words[0], CALL);
		writew(words[1], ABSOLUTE);
	}
}

// ---------------------------------------------------------------------------------
// x_org - ORG directive
// ---------------------------------------------------------------------------------

void x_org (struct tag_op *op, char *label, char *mods, char *arg)
{
	EXPR expr;

	org_advanced = FALSE;				// * means this address

	if (*label)							// label is defined BEFORE the new origin is set!!!
		set_symbol(label, org, TRUE, relocate);

	if (getexpr(arg, FALSE, &expr) != S_DEFINED)
		return;

	setorg(expr.value);				// set origin to this value
}

// ---------------------------------------------------------------------------------
// x_end - END directive
// ---------------------------------------------------------------------------------

void x_end (struct tag_op *op, char *label, char *mods, char *arg)
{
	EXPR expr;

	org_advanced = FALSE;				// * means this address

	if (*arg) {							// they're specifing the program start address
		if (getexpr(arg, FALSE, &expr) == S_DEFINED)
			pta = expr.value;
	}

	if (*label)							// define label
		set_symbol(label, org, TRUE, relocate);

	setw(0, org, FALSE);				// display origin

	ended = TRUE;						// assembly is done, stop reading file
}

// ---------------------------------------------------------------------------------
// x_ent - ENT op
// ---------------------------------------------------------------------------------

void x_ent (struct tag_op *op, char *label, char *mods, char *arg)
{
	PSYMBOL s;

	org_advanced = FALSE;				// * means this address

	if (pass < 2)
		return;

//	if (*label)							// define label
//		set_symbol(label, org, TRUE, relocate);
//
//	setw(0, org, FALSE);				// display origin

	if (! *arg)
		asm_error("No entry label specified");

	else if ((s = lookup_symbol(arg, FALSE)) == NULL)
		asm_error("Entry symbol %s not defined", arg);

	else if (nentries >= MAXENTRIES)
		asm_error("Too many entries, limit is %d", MAXENTRIES);

	else
		entry[nentries++] = s;			// save symbol pointer

	switch (progtype) {
		case PROGTYPE_ABSOLUTE:
			asm_error("ENT not allowed with ABS");
			break;
		case PROGTYPE_RELOCATABLE:
			progtype = PROGTYPE_CALL;
			break;
		case PROGTYPE_LIBF:
		case PROGTYPE_CALL:
		case PROGTYPE_ISSLIBF:
		case PROGTYPE_ISSCALL:
			break;
		case PROGTYPE_ILS:
			asm_error("Can't mix ENT and ILS, can you?");
			break;
		default:
			bail("in x_libr, can't happen");
	}
}

// ---------------------------------------------------------------------------------
// declare a libf-type subprogram
// ---------------------------------------------------------------------------------

void x_libr (struct tag_op *op, char *label, char *mods, char *arg)
{
	switch (progtype) {
		case PROGTYPE_ABSOLUTE:
			asm_error("LIBR not allowed with ABS");
			break;
		case PROGTYPE_RELOCATABLE:
		case PROGTYPE_LIBF:
		case PROGTYPE_CALL:
			progtype = PROGTYPE_LIBF;
			break;
		case PROGTYPE_ISSLIBF:
		case PROGTYPE_ISSCALL:
			progtype = PROGTYPE_ISSLIBF;
			break;
		case PROGTYPE_ILS:
			asm_error("Can't use LIBR in an ILS");
			break;
		default:
			bail("in x_libr, can't happen");
	}
}

// ---------------------------------------------------------------------------------
// x_ils - ILS directive
// ---------------------------------------------------------------------------------

void x_ils  (struct tag_op *op, char *label, char *mods, char *arg)
{
	switch (progtype) {
		case PROGTYPE_ABSOLUTE:
			asm_error("ILS not allowed with ABS");
			break;
		case PROGTYPE_RELOCATABLE:
		case PROGTYPE_ILS:
			progtype = PROGTYPE_ILS;
			break;
		case PROGTYPE_LIBF:
		case PROGTYPE_CALL:
			asm_error("Invalid placement of ILS");
			break;
		case PROGTYPE_ISSLIBF:
		case PROGTYPE_ISSCALL:
			break;
		default:
			bail("in x_libr, can't happen");
	}

	intlevel_primary = atoi(mods);
}

// ---------------------------------------------------------------------------------
// x_iss - ISS directive
// ---------------------------------------------------------------------------------

void x_iss  (struct tag_op *op, char *label, char *mods, char *arg)
{
	char *tok;

	switch (progtype) {
		case PROGTYPE_ABSOLUTE:
			asm_error("ISS not allowed with ABS");
			break;
		case PROGTYPE_RELOCATABLE:
		case PROGTYPE_CALL:
		case PROGTYPE_ISSCALL:
			progtype = PROGTYPE_ISSCALL;
			break;
		case PROGTYPE_LIBF:
		case PROGTYPE_ISSLIBF:
			progtype = PROGTYPE_ISSLIBF;
			break;
		case PROGTYPE_ILS:
			asm_error("Can't mix ISS and ILS");
		default:
			bail("in x_libr, can't happen");
	}

	iss_number = atoi(mods);					// get ISS number

	opfield[16] = '\0';							// be sure not to look too far into this

	nintlevels = 0;								// # of interrupt levels for ISS
	intlevel_primary = 0;						// primary level for ISS and level for ILS
	intlevel_secondary = 0;						// secondary level for ISS

	if ((tok = strtok(opfield, " ")) == NULL)
		asm_error("ISS missing entry label");
	else
		x_ent(NULL, label, "", arg);			// process as an ENT

	if ((tok = strtok(NULL, " ")) != NULL) { 	// get associated levels
		nintlevels++;
		intlevel_primary = atoi(tok);
	}

	if ((tok = strtok(NULL, " ")) != NULL) {
		nintlevels++;
		intlevel_secondary = atoi(tok);
	}
}

void x_spr  (struct tag_op *op, char *label, char *mods, char *arg)
{
	realmode = REALMODE_STANDARD;
}

void x_epr  (struct tag_op *op, char *label, char *mods, char *arg)
{
	realmode = REALMODE_EXTENDED;
}

void x_dsa  (struct tag_op *op, char *label, char *mods, char *arg)
{
	unsigned short words[2];

	setw(0, org, FALSE);					// display origin

	if (*label)								// define label
		set_symbol(label, org, TRUE, relocate);

	if (! *arg) {
		asm_error("DSA missing filename");
	}
	else {
		namecode(words, arg);					
		writetwo();
		writew(words[0], CALL);				// special relocation bits here 3 and 1
		writew(words[1], RELATIVE);
	}
}

void x_link (struct tag_op *op, char *label, char *mods, char *arg)
{
	unsigned short words[2];
	char nline[128];

	setw(0, org, FALSE);					// display origin

	if (*label)								// define label
		set_symbol(label, org, TRUE, relocate);

	if (! *arg) {
		asm_error("LINK missing program name");
	}
	else {
		format_line(nline, label, "CALL", "", "$LINK", "");
		parse_line(nline);

		namecode(words, arg);					
		writew(words[0], ABSOLUTE);					// special relocation bits here 3 and 1
		writew(words[1], ABSOLUTE);
	}
}

void x_libf (struct tag_op *op, char *label, char *mods, char *arg)
{
	unsigned short words[2];

	if (*label)								// define label
		set_symbol(label, org, TRUE, relocate);

	if (! *arg) {
		asm_error("LIBF missing argument");
		return;
	}

	if (pass == 1) {						// it will take one words in any case
		org++;
		return;
	}

	setw(0, org, FALSE);					// display origin

	namecode(words, arg);					// emit namecode for loader

	writetwo();
	writew(words[0], LIBF);					// this one does NOT advance org!
	writew(words[1], ABSOLUTE);
}

void x_file (struct tag_op *op, char *label, char *mods, char *arg)
{
	int i, n, r;
	EXPR vals[5];
	char *tok;

	for (i = 0; i < 5; i++) {
		if ((tok = strtok(arg, ",")) == NULL) {
			asm_error("FILE has insufficient arguments");
			return;
		}
		arg = NULL;			// for next strtok call

		if (i == 3) {
			if (strcmpi(tok, "U") != 0)
				asm_error("Argument 4 must be the letter U");
		}
		else if (getexpr(tok, FALSE, &vals[i]) == S_DEFINED) {
			if (i <= 3 && vals[i].relative)
				asm_error("Argument %d must be absolute", i+1);
			else if (pass == 2 && vals[i].value == 0)
				asm_error("Argument %d must be nonzero", i+1);
		}
	}

	writew(vals[0].value, ABSOLUTE);
	writew(vals[1].value, ABSOLUTE);
	writew(vals[2].value, ABSOLUTE);
	writew(vals[4].value, vals[i].relative);
	writew(0, ABSOLUTE);
	n = MAX(1, vals[2].value);
	r = 320/n;
	writew(r, ABSOLUTE);
	r = MAX(1, r);
	writew((16*vals[1].value)/r, ABSOLUTE);

	if (pass == 2)
		ndefined_files++;
}

// ---------------------------------------------------------------------------------
// x_trap - place to set a breakpoint
// ---------------------------------------------------------------------------------

void x_trap (struct tag_op *op, char *label, char *mods, char *arg)
{
	// debugging breakpoint
}

// ---------------------------------------------------------------------------------
// x_ces - .CES directive (nonstandard). Specify a value for the console entry
// switches. When this program is loaded into the simulator, the switches will
// be set accordingly. Handy for bootstraps and other programs that read
// the switches.
// ---------------------------------------------------------------------------------

void x_ces (struct tag_op *op, char *label, char *mods, char *arg)
{
	EXPR expr;

	if (outmode != OUTMODE_LOAD)				// this works only in our loader format
		return;

	if (getexpr(arg, FALSE, &expr) != S_DEFINED)
		return;

	if (pass == 2)
		fprintf(fout, "S%04x" ENDLINE, expr.value & 0xFFFF);
}

// ---------------------------------------------------------------------------------
// x_bss - BSS directive - reserve space in core
// ---------------------------------------------------------------------------------

void x_bss (struct tag_op *op, char *label, char *mods, char *arg)
{
	EXPR expr;

	org_advanced = FALSE;				// * means this address

	if (! *arg) {
		expr.value = 0;
		expr.relative = ABSOLUTE;
	}
	else if (getexpr(arg, FALSE, &expr) != S_DEFINED)
		return;

	if (strchr(mods, 'E') != NULL)	// force even address
		org_even();

	if (expr.relative)
		asm_error("BSS size must be an absolute value");

	setw(0, org, FALSE);			// display origin

	if (*label)						// define label
		set_symbol(label, org, TRUE, relocate);

	if (expr.value < 0)
		asm_warning("Negative BSS size");

	else if (expr.value > 0) {
		if (outmode == OUTMODE_LOAD) {
			org += expr.value;		// advance the origin by appropriate number of words
			if (pass == 2)			// emit new load address in output file
				fprintf(fout, "@%04x%s" ENDLINE, org & 0xFFFF, relocate ? "R" : "");
		}
		else {
			org += expr.value;		// advance the origin by appropriate number of words
			if (pass == 2)
				bincard_setorg(org);
		}
	}
}

// ---------------------------------------------------------------------------------
// x_bes - Block Ended by Symbol directive. Like BSS but label gets address AFTER the space, instead of first address
// ---------------------------------------------------------------------------------

void x_bes (struct tag_op *op, char *label, char *mods, char *arg)
{
	EXPR expr;

	org_advanced = FALSE;				// * means this address

	if (! *arg) {						// arg field = space
		expr.value = 0;
		expr.relative = ABSOLUTE;
	}
	else if (getexpr(arg, FALSE, &expr) != S_DEFINED)
		return;

	if (strchr(mods, 'E') != NULL && (org & 1) != 0)
		org_even();						// force even address

	if (expr.relative)
		asm_error("BES size must be an absolute value");

	if (expr.value < 0)
		asm_warning("Negative BES size");

	else if (expr.value > 0) {
		setw(0, org+expr.value, FALSE);	// display NEW origin

		if (outmode == OUTMODE_LOAD) {
			org += expr.value;			// advance the origin
			if (pass == 2)				// emit new load address in output file
				fprintf(fout, "@%04x%s" ENDLINE, org & 0xFFFF, relocate ? "R" : "");
		}
		else {
			org += expr.value;			// advance the origin
			bincard_setorg(org);
		}
	}

	if (*label)							// NOW define the label
		set_symbol(label, org, TRUE, relocate);
}

// ---------------------------------------------------------------------------------
// x_dmes - DMES define message directive.  Various encodings, none pretty.
// ---------------------------------------------------------------------------------

int dmes_wd;
int dmes_nc;
enum {CODESET_CONSOLE, CODESET_1403, CODESET_1132, CODESET_EBCDIC} dmes_cs;
void stuff_dmes (int ch, int rpt);

void x_dmes (struct tag_op *op, char *label, char *mods, char *arg)
{
	int rpt;
	char *c = opfield;
	BOOL cont = FALSE;

	if (dmes_saved) {					// previous DMES had an odd character saved
		dmes_wd = dmes_savew;
		dmes_nc = 1;					// stick it into the outbut buffer
	}
	else
		dmes_nc = dmes_wd = 0;			// clear output buffer

	trim(opfield);						// remove trailing blanks from rest of input line (use whole thing)
	setw(0, org, FALSE);				// display origin

	if (*label)							// define label
		set_symbol(label, org, TRUE, relocate);

	if (strchr(mods, '1') != NULL)		// determine the encoding scheme
		dmes_cs = CODESET_1403;
	else if (strchr(mods, '2') != NULL)
		dmes_cs = CODESET_1132;
	else  if (strchr(mods, '0') != NULL || ! *mods)
		dmes_cs = CODESET_CONSOLE;
	else {
		asm_error("Invalid printer code in tag field");
		dmes_cs = CODESET_EBCDIC;
	}

	while (*c) {						// pick up characters
		if (*c == '\'') {				// quote (') is the escape character
			c++;

			rpt = 0;					// get repeat count
			while (BETWEEN(*c, '0', '9')) {
				rpt = rpt*10 + *c++ - '0';
			}
			if (rpt <= 0)				// no count = insert one copy
				rpt = 1;

			switch (*c) {				// handle escape codes
				case '\'':
					stuff_dmes(*c, 1);
					break;

				case 'E':
					*c = '\0';					// end
					break;

				case 'X':
				case 'S':
					stuff_dmes(' ', rpt);
					break;

				case 'F':
					stuff_dmes(*++c, rpt);		// repeat character
					break;

				case ' ':
				case '\0':
					cont = TRUE;
					*c = '\0';					// end
					break;

				case 'T':
					if (dmes_cs != CODESET_CONSOLE) {
badcode:				asm_error("Invalid ' escape for selected printer");
						break;
					}
					stuff_dmes(0x41, -rpt);		// tab
					break;

				case 'D':
					if (dmes_cs != CODESET_CONSOLE) goto badcode;
					stuff_dmes(0x11, -rpt);		// backspace
					break;

				case 'B':
					if (dmes_cs != CODESET_CONSOLE) goto badcode;
					stuff_dmes(0x05, -rpt);		// black
					break;

				case 'A':
					if (dmes_cs != CODESET_CONSOLE) goto badcode;
					stuff_dmes(0x09, -rpt);		// red
					break;

				case 'R':
					if (dmes_cs != CODESET_CONSOLE) goto badcode;
					stuff_dmes(0x81, -rpt);		// return
					break;

				case 'L':
					if (dmes_cs != CODESET_CONSOLE) goto badcode;
					stuff_dmes(0x03, -rpt);		// line feed
					break;
				
				default:
					asm_error("Invalid ' escape in DMES");
					*c = '\0';
					break;
			}
		}
		else 									// just copy literal character
			stuff_dmes(*c, 1);

		if (*c)
			c++;
	}

	dmes_saved = FALSE;

	if (dmes_nc) {								// odd number of characters
		if (cont) {
			dmes_saved = TRUE;
			dmes_savew = dmes_wd;				// save for next time
		}
		else
			stuff_dmes(' ', 1);					// pad with a space to force out even # of characters
	}
}

// ---------------------------------------------------------------------------------
// stuff_dmes - insert 'rpt' copies of character 'ch' into output words
// ---------------------------------------------------------------------------------

void stuff_dmes (int ch, int rpt)
{
	int nch, i;						// nch is translated output value

	if (rpt < 0) {					// negative repeat means no translation needed
		rpt = -rpt;
		nch = ch;
	}
	else {
		switch (dmes_cs) {
			case CODESET_CONSOLE:
				nch = 0x21;
				for (i = 0; i < 256; i++) {
					if (conout_to_ascii[i] == ch) {
						nch = i;
						break;
					}
				}
				break;

			case CODESET_EBCDIC:
				nch = ascii_to_ebcdic_table[ch & 0x7F];
				if (nch == 0)
					nch = 0x7F;
				break;

			case CODESET_1403:
				nch = ascii_to_1403_table[ch & 0x7F];
				if (nch == 0)
					nch = 0x7F;
				break;

			case CODESET_1132:
				nch = 0x40;
				for (i = 0; i < WHEELCHARS_1132; i++) {
					if (codewheel1132[i].ascii == ch) {
						nch = codewheel1132[i].ebcdic;
						break;
					}
				}
				break;

			default:
				bail("bad cs in x_dmes, can't happen");
				break;
		}
	}
			
	while (--rpt >= 0) {				// pack them into words, output when we have two
		if (dmes_nc == 0) {
			dmes_wd = (nch & 0xFF) << 8;
			dmes_nc = 1;
		}
		else {
			dmes_wd |= (nch & 0xFF);
			writew(dmes_wd, FALSE);
			dmes_nc = 0;
		}
	}
}

// ---------------------------------------------------------------------------------
// x_ebc - handle EBCDIC string definition (delimited with periods)
// ---------------------------------------------------------------------------------

void x_ebc (struct tag_op *op, char *label, char *mods, char *arg)
{
	char *p;

//	setw(0, org, FALSE);
	if (*label)
		set_symbol(label, org, TRUE, relocate);

	p = trim(opfield);						// remove trailing blanks from rest of input line (use whole thing)

	if (*p != '.') {
		asm_error("EBC data must start with .");
		return;
	}
	p++;									// skip leading period

	dmes_nc = dmes_wd = 0;					// clear output buffer (we're borrowing the DMES packer)
	dmes_cs = CODESET_EBCDIC;

	while (*p && *p != '.')					// store packed ebcdic
		stuff_dmes(*p++, 1);

	if (dmes_nc)							// odd number of characters
		stuff_dmes(' ', 1);					// pad with a space to force out even # of characters

	if (*p != '.')
		asm_error("EBC missing closing .");
}

// ---------------------------------------------------------------------------------
// x_dn - define name DN directive. Pack 5 characters into two words. This by the
// way is the reason the language Forth is not Fourth.
// ---------------------------------------------------------------------------------

void x_dn (struct tag_op *op, char *label, char *mods, char *arg)
{
	unsigned short words[2];

	setw(0, org, FALSE);					// display origin

	if (*label)								// define label
		set_symbol(label, org, TRUE, relocate);

	namecode(words, arg);					

	writew(words[0], ABSOLUTE);
	writew(words[1], ABSOLUTE);
}

// ---------------------------------------------------------------------------------
// x_dump - DUMP directive - pretend we saw "call $dump, call $exit"
// ---------------------------------------------------------------------------------

void x_dump (struct tag_op *op, char *label, char *mods, char *arg)
{
	x_pdmp(op, label, mods, arg);
	x_exit(NULL, "", "", "");			// compile "call $exit"
}

// ---------------------------------------------------------------------------------
// x_pdmp - PDMP directive - like DUMP but without the call $exit
// ---------------------------------------------------------------------------------

void x_pdmp (struct tag_op *op, char *label, char *mods, char *arg)
{
	char nline[200], *tok;
	EXPR addr[3];
	int i;

	for (i = 0, tok = strtok(arg, ","); i < 3 && tok != NULL; i++, tok = strtok(NULL, ",")) {
		if (getexpr(tok, FALSE, addr+i) != S_DEFINED) {
			addr[i].value = (i == 1) ? 0x3FFF : 0;
			addr[i].relative = ABSOLUTE;
		}
	}

	org_advanced = FALSE;				// * means this address+1

	format_line(nline, label, "BSI", "L", DOLLARDUMP, "");
	parse_line(nline);					// compile "call $dump"

	writew(addr[2].value, ABSOLUTE);	// append arguments (0, start, end address)
	writew(addr[0].value, addr[0].relative);
	writew(addr[1].value, addr[1].relative);
}

// ---------------------------------------------------------------------------------
// x_hdng - HDNG directive
// ---------------------------------------------------------------------------------

void x_hdng (struct tag_op *op, char *label, char *mods, char *arg)
{
	char *c;

	// label is not entered into the symbol table

	if (flist == NULL || ! list_on) {
		line_error = TRUE;					// inhibit listing: don't print the HDNG statement
		return;
	}

	line_error = TRUE;						// don't print the statement

	c = skipbl(opfield);
	trim(c);
	fprintf(flist, "\f%s\n\n", c);			// print page header
}

// ---------------------------------------------------------------------------------
// x_list - LIST directive. enable or disable listing
// ---------------------------------------------------------------------------------

void x_list (struct tag_op *op, char *label, char *mods, char *arg)
{
	BOOL on;

	// label is not entered into the symbol table

	line_error = TRUE;			// don't print the LIST statement

	if (flist == NULL || ! list_on) {
		return;
	}

	if (strcmpi(arg, "ON") == 0)
		on = TRUE;
	else if (strcmpi(arg, "OFF") == 0)
		on = FALSE;
	else
		on = do_list;

	list_on = on;
}

// ---------------------------------------------------------------------------------
// x_spac - SPAC directive. Put blank lines in listing
// ---------------------------------------------------------------------------------

void x_spac (struct tag_op *op, char *label, char *mods, char *arg)
{
	EXPR expr;

	// label is not entered into the symbol table

	if (flist == NULL || ! list_on) {
		line_error = TRUE;			// don't print the SPAC statement
		return;
	}

	if (getexpr(arg, FALSE, &expr) != S_DEFINED)
		return;

	line_error = TRUE;			// don't print the statement

	while (--expr.value >= 0) 
		putc('\n', flist);
}

// ---------------------------------------------------------------------------------
// x_ejct - EJCT directive - put formfeed in listing
// ---------------------------------------------------------------------------------

void x_ejct (struct tag_op *op, char *label, char *mods, char *arg)
{
	// label is not entered into the symbol table

	if (flist == NULL || ! list_on) {
		line_error = TRUE;			// don't print the EJCT statement
		return;
	}

	line_error = TRUE;			// don't print the statement

	putc('\f', flist);
}

// ---------------------------------------------------------------------------------
// basic_opcode - construct a standard opcode value from op table entry and modifier chars
// ---------------------------------------------------------------------------------

int basic_opcode (struct tag_op *op, char *mods)
{
	int opcode = op->opcode;						// basic code value

	if (strchr(mods, '1') != 0)						// indexing
		opcode |= 0x0100;
	else if (strchr(mods, '2') != 0)
		opcode |= 0x0200;
	else if (strchr(mods, '3') != 0)
		opcode |= 0x0300;

	if (strchr(mods, 'L')) {						// two-word format
		opcode |= OP_LONG;
		if (strchr(mods, 'I') != 0)					// and indirect to boot
			opcode |= OP_INDIRECT;
	}

	return opcode;
}

// ---------------------------------------------------------------------------------
// std_op - assemble a vanilla opcode
// ---------------------------------------------------------------------------------

void std_op (struct tag_op *op, char *label, char *mods, char *arg)
{
	EXPR expr;
	int opcode = basic_opcode(op, mods);
	BOOL val_ok = FALSE;

	if (*label)										// define label
		set_symbol(label, org, TRUE, relocate);

	if (*arg && ! (op->flags & NO_ARGS)) {			// get value argument
		if (getexpr(arg, FALSE, &expr) == S_DEFINED) 
			val_ok = TRUE;
	}
	else {
		expr.value = 0;
		expr.relative = FALSE;
	}

	if (opcode & OP_LONG) {							// two-word format, just write code and value
		writew(opcode, FALSE);
		writew(expr.value, expr.relative);
	}
	else {											// one-word format
		if (strchr(mods, 'I') != 0)
			asm_error("Indirect mode not permitted on one-word instructions");

		if (val_ok && ! (strchr(mods, 'X') || (op->flags & IS_ABS) || ((opcode & OP_INDEXED) && ! (op->flags & NO_IDX))))
			expr.value -= (org+1);					// compute displacement

		if (expr.value < -128 || expr.value > 127) {// check range
			asm_error("Offset of %d is too large", expr.value);
			expr.value = 0;
		}

		writew(opcode | (expr.value & 0x00FF), FALSE);// that's the code
	}
}

// ---------------------------------------------------------------------------------
// mdx_op - assemble a MDX family instruction
// ---------------------------------------------------------------------------------

void mdx_op (struct tag_op *op, char *label, char *mods, char *arg)
{
	EXPR dest, incr = {0, FALSE};
	int opcode = basic_opcode(op, mods);
	char *tok;

	if (*label)										// define label
		set_symbol(label, org, TRUE, relocate);

	if ((tok = strtok(arg, ",")) == NULL) {			// argument format is dest[,increment]
//		asm_error("Destination not specified");		// seems not to be an error, IBM omits it sometimes
		dest.value = 0;
		dest.relative = ABSOLUTE;
	}
	else
		getexpr(tok, FALSE, &dest);					// parse the address

	tok = strtok(NULL, ",");						// look for second argument

	if (opcode & OP_LONG) {							// two word format
		if (opcode & OP_INDEXED) {					// format: MDX 2 dest
			if (tok != NULL)
				asm_error("This format takes only one argument");
		}
		else {										// format: MDX   dest,increment
			if (opcode & OP_INDIRECT)
				asm_error("Indirect can't be used without indexing");

			if (tok == NULL) {
//				asm_error("This format takes two arguments");
				incr.value = 0;
				incr.relative = ABSOLUTE;
			}
			else 
				getexpr(tok, FALSE, &incr);

			if (incr.value < -128 || incr.value >= 127)			// displacement style
				asm_error("Invalid increment value (8 bits signed)");

			opcode |= (incr.value & 0xFF);
		}

		writew(opcode, ABSOLUTE);
		writew(dest.value, dest.relative);
	}
	else {											// one word format MDX  val
		if (tok != NULL)
			asm_error("This format takes only one argument");

		if (! (strchr(mods, 'X') || (opcode & OP_INDEXED)))
			dest.value -= (org+1);						// compute displacement

		if (dest.value < -128 || dest.value > 127)
			asm_error("Offset/Increment of %d is too large", dest.value);

		writew(opcode | (dest.value & 0xFF), FALSE);
	}
}

// ---------------------------------------------------------------------------------
// bsi_op - BSI long instruction is like a BSC L, short is standard
// ---------------------------------------------------------------------------------

void bsi_op (struct tag_op *op, char *label, char *mods, char *arg)
{
	if (strchr(mods, 'L') || strchr(mods, 'I'))
		bsc_op(op, label, mods, arg);
	else
		std_op(op, label, mods, arg);
}

// ---------------------------------------------------------------------------------
// b_op - branch; use short or long version
// --------------------------------------------------------------------------------

void b_op (struct tag_op *op, char *label, char *mods, char *arg)
{
	static struct tag_op *mdx = NULL;

	if (strchr(mods, 'L') || strchr(mods, 'I')) {
		bsi_op(op, label, mods, arg);	
		return;
	}

	if (mdx == NULL)
		if ((mdx = lookup_op("MDX")) == NULL)
			bail("Can't find MDX op");

	(mdx->handler)(mdx, label, mods, arg);
}

// ---------------------------------------------------------------------------------
// bsc_op - compute a BSC family instruction
// ---------------------------------------------------------------------------------

void bsc_op (struct tag_op *op, char *label, char *mods, char *arg)
{
	EXPR dest;
	int opcode = basic_opcode(op, mods);
	char *tok, *tests;

	if (*label)										// define label
		set_symbol(label, org, TRUE, relocate);

	if (opcode & OP_LONG) {							// two word format
		if ((tok = strtok(arg, ",")) == NULL) {		// format is BSC dest[,tests]
			asm_error("Destination not specified");
			dest.value = 0;
			dest.relative = ABSOLUTE;
		}
		else
			getexpr(tok, FALSE, &dest);

		tests = strtok(NULL, ",");					// get test characters
	}
	else
		tests = arg;								// short format is BSC tests

	if (tests != NULL) {							// stick in the testing bits
		for (; *tests; tests++) {
			switch (*tests) {
							 // bit 0x40 is the BOSC bit
				case 'Z': opcode |= 0x20; break;
				case '-': opcode |= 0x10; break;
				case '+':
				case '&': opcode |= 0x08; break;
				case 'E': opcode |= 0x04; break;
				case 'C': opcode |= 0x02; break;
				case 'O': opcode |= 0x01; break;
				default:
					asm_error("Invalid test flag: '%c'", *tests);
			}
		}
	}

	writew(opcode, ABSOLUTE);							// emit code
	if (opcode & OP_LONG)
		writew(dest.value, dest.relative);
}

// ---------------------------------------------------------------------------------
// shf_op - assemble a shift instruction
// ---------------------------------------------------------------------------------

void shf_op (struct tag_op *op, char *label, char *mods, char *arg)
{
	EXPR expr;
	int opcode = basic_opcode(op, mods);

	if (*label)										// define label
		set_symbol(label, org, TRUE, relocate);

	if (opcode & OP_INDEXED) {						// shift value comes from index register
		expr.value = 0;
		expr.relative = ABSOLUTE;
	}
	else
		getexpr(arg, FALSE, &expr);

	if (expr.relative) {
		asm_error("Shift value is a relative address");
		expr.relative = ABSOLUTE;
	}

	if (expr.value < 0 || expr.value > 32) {		// check range
		asm_error("Shift count of %d is invalid", expr.value);
		expr.value = 0;
	}

	writew(opcode | (expr.value & 0x3F), FALSE);	// put shift count into displacement field
}

// ---------------------------------------------------------------------------------
// x_mdm - MDM instruction
// ---------------------------------------------------------------------------------

void x_mdm (struct tag_op *op, char *label, char *mods, char *arg)
{
	int opcode = basic_opcode(op, mods);

	if (*label)										// define label
		set_symbol(label, org, TRUE, relocate);
													// oh dear: bug here
	asm_error("'%s' is not yet supported", op->mnem);
}

// ---------------------------------------------------------------------------------
// x_exit - EXIT directive. Assembler manual says it treats like CALL $EXIT, but
// object code reveals the truth: jump to $EXIT, which is a small value, so we can use LDX.
// ---------------------------------------------------------------------------------

void x_exit (struct tag_op *op, char *label, char *mods, char *arg)
{
	char nline[120];

	format_line(nline, label, "LDX", "X", DOLLAREXIT, "");
	parse_line(nline);
}

// ---------------------------------------------------------------------------------
// x_opt - .OPT directive. Nonstandard. Possible values:
//
// .OPT CEXPR - use C precedence in evaluating expressions rather than strict left-right
// ---------------------------------------------------------------------------------

void x_opt (struct tag_op *op, char *label, char *mods, char *arg)
{
	char *tok;

	org_advanced = FALSE;				// * means this address

	if (*label) {
		asm_error("Label not permitted on .OPT statement");
		return;
	}
										// look for OPT arguments
	for (tok = strtok(arg, ","); tok != NULL; tok = strtok(NULL, ",")) {
		if (strcmp(tok, "CEXPR") == 0) {
			cexpr = TRUE;				// use C expression precedence (untested)
		}
		else
			asm_error("Unknown .OPT: '%s'", tok);
	}
}

// ---------------------------------------------------------------------------------
// askip - skip input lines until a line with the target label appears
// ---------------------------------------------------------------------------------

void askip (char *target)
{
	char nline[200], cur_label[20], *c;

	while (get_line(nline, sizeof(nline), TRUE)) {	// read next line (but don't exit a macro)
		listout(FALSE);								// end listing of previous input line

		prep_line(nline);							// preform standard line prep

		strncpy(cur_label, nline, 6);				// get first 5 characters
		cur_label[5] = '\0';

		for (c = cur_label; *c > ' '; c++)			// truncate at first whitespace
			;
		*c = '\0';
													// stop if there's a match
		if ((target == NULL) ? (cur_label[0] == '\0') : strcmp(target, cur_label) == 0) {
			parse_line(nline);						// process this line
			return;
		}
	}

	if (target != NULL)
		asm_error("Label %s not found", target);
}

// ---------------------------------------------------------------------------------
// x_aif - process conditional assembly jump
// ---------------------------------------------------------------------------------

void x_aif (struct tag_op *op, char *label, char *mods, char *arg)
{
	char *target, *tok;
	EXPR expr1, expr2;
	BOOL istrue;
	enum {OP_EQ, OP_LT, OP_GT, OP_NE, OP_LE, OP_GE} cmp_op;

	// label is not entered into the symbol table

	arg = skipbl(arg);
	if (*arg != '(') {
		asm_error("AIF operand must start with (");
		return;
	}

	arg++;											// skip the paren

	// normally whitespace is never found in the arg string (see tabtok and coltok).
	// However, spaces inside parens are permitted. 

	if ((tok = strtok(arg, whitespace)) == NULL) {
		asm_error("AIF missing first expression");
		return;
	}

	getexpr(tok, FALSE, &expr1);

	if ((tok = strtok(NULL, whitespace)) == NULL) {
		asm_error("AIF missing conditional operator");
		return;
	}

	if      (strcmp(tok, "EQ") == 0)
		cmp_op = OP_EQ;
	else if (strcmp(tok, "LT") == 0)
		cmp_op = OP_LT;
	else if (strcmp(tok, "GT") == 0)
		cmp_op = OP_GT;
	else if (strcmp(tok, "NE") == 0)
		cmp_op = OP_NE;
	else if (strcmp(tok, "LE") == 0)
		cmp_op = OP_LE;
	else if (strcmp(tok, "GE") == 0)
		cmp_op = OP_GE;
	else {
		asm_error("AIF: %s is not a valid conditional operator", tok);
		return;
	}

	if ((tok = strtok(NULL, ")")) == NULL) {
		asm_error("AIF missing second expression");
		return;
	}

	getexpr(tok, FALSE, &expr2);

	switch (cmp_op) {								// test the condition
		case OP_EQ: istrue = expr1.value == expr2.value; break;
		case OP_LT: istrue = expr1.value <  expr2.value; break;
		case OP_GT: istrue = expr1.value >  expr2.value; break;
		case OP_NE: istrue = expr1.value != expr2.value; break;
		case OP_LE: istrue = expr1.value <= expr2.value; break;
		case OP_GE: istrue = expr1.value >= expr2.value; break;
		default: bail("in aif, can't happen");
	}

	// After the closing paren coltok and tabtok guarantee we will have no whitespace

	if ((target = strtok(arg, ",")) == NULL)		// get target label
		asm_warning("Missing target label");

	if (istrue)
		askip(target);								// skip to the target
}

// ---------------------------------------------------------------------------------
// x_aifb - conditional assembly jump back (macro only)
// ---------------------------------------------------------------------------------

void x_aifb (struct tag_op *op, char *label, char *mods, char *arg)
{
	asm_error("aifb valid in macros only and not implemented in any case");
}

// ---------------------------------------------------------------------------------
// x_ago 
// ---------------------------------------------------------------------------------

void x_ago  (struct tag_op *op, char *label, char *mods, char *arg)
{
	char *target;

	// label is not entered into the symbol table

	// handle differently in a macro

	if ((target = strtok(arg, ",")) == NULL)		// get target label
		asm_warning("Missing target label");

	askip(target);									// skip to the target
}

// ---------------------------------------------------------------------------------
// ---------------------------------------------------------------------------------

void x_agob (struct tag_op *op, char *label, char *mods, char *arg)
{
	asm_error("agob valid in macros only and not implemented in any case");
}

// ---------------------------------------------------------------------------------
// ---------------------------------------------------------------------------------

void x_anop (struct tag_op *op, char *label, char *mods, char *arg)
{
	// label is not entered into the symbol table
	// do nothing else
}

// ---------------------------------------------------------------------------------
// expression parser, borrowed from older code, no comments, sorry
// ---------------------------------------------------------------------------------

char *exprptr, *oexprptr;

#define GETNEXT (*exprptr++)
#define UNGET    --exprptr

#define	LETTER	0			/* character types */
#define	DIGIT	1
#define ETC	2
#define	ILL	3
#define	SPACE	4
#define	MULOP	5
#define	ADDOP	6
#define	EXPOP	7

int    getnb      (void);
void   c_expr     (EXPR *ap);
void   c_expr_m   (EXPR *ap);
void   c_expr_e   (EXPR *ap);
void   c_expr_u   (EXPR *ap);
void   c_term     (EXPR *ap);
int    c_number   (int c, int r, int nchar);
int    digit      (int c, int r);
int    c_esc      (int c);
void   exprerr    (int n);
void   a1130_expr (EXPR *ap);
void   a1130_term (EXPR *ap);
					
char	ctype[128] = {			// character types
/*^0ABCDEFG */	ILL,	ILL,	ILL,	ILL,	ILL,	ILL,	ILL,	ILL,
/*^HIJKLMNO */	ILL,	SPACE,	SPACE,	ILL,	SPACE,	SPACE,	ILL,	ILL,
/*^PQRSTUVW */	ILL,	ILL,	ILL,	ILL,	ILL,	ILL,	ILL,	ILL,
/*^XYZ      */	ILL,	ILL,	ILL,	ILL,	ILL,	ILL,	ILL,	ILL,
/*  !"#$%&' */	SPACE,	ETC,	ETC,	LETTER,	LETTER,	MULOP,	MULOP,	LETTER,		/* $ # @ and ' are letters here */
/* ()*+,-./ */	ETC,	ETC,	MULOP,	ADDOP,	ETC,	ADDOP,	ETC,    MULOP,
/* 01234567 */	DIGIT,	DIGIT,	DIGIT,	DIGIT,	DIGIT,	DIGIT,	DIGIT,	DIGIT,
/* 89:;<=>? */	DIGIT,	DIGIT,	ETC,	ETC,	MULOP,	ETC,	MULOP,	ETC,
/* @ABCDEFG */	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,
/* HIJKLMNO */	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,
/* PQRSTUVW */	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,
/* XYZ[\]^_ */	LETTER,	LETTER,	LETTER,	ETC,	ETC,	ETC,	EXPOP,	LETTER,
/* `abcdefg */	ETC,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,
/* hijklmno */	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,
/* pqrstuvw */	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,	LETTER,
/* xyz{|}~  */	LETTER,	LETTER,	LETTER,	ETC,	ADDOP,	ETC,	ETC,	ETC
};

char *errstr[] = {
	"Missing exponent",					// 0
	"Undefined symbol",					// 1
	"Division by zero",					// 2
	"Illegal operator",					// 3
	") expected",						// 4
	"Char expected after '",			// 5
	"Char expected after .",			// 6
	"Number expected after =",			// 7
	"Syntax error",						// 8
	"Number syntax",					// 9
	"Char expected after \\",			// 10
	"Relocation error"					// 11
};

int getnb () {
	int c;

	if (cexpr) {			// in C mode, handle normally
		while (ctype[(c = GETNEXT)] == SPACE)
			;
	}						// in 1130 mode, a space terminates the expression. Here, eat the rest
	else if ((c = GETNEXT) == ' ') {
		while ((c = GETNEXT) != '\0')
			;
	}

	return c;
}

int symbest, exprerrno;
jmp_buf exprjmp;

// ---------------------------------------------------------------------------------
// getexpr
// ---------------------------------------------------------------------------------

int getexpr (char *pc, BOOL undefined_ok, EXPR *pval)
{
	symbest = S_DEFINED;			// assume no questionable symbols

	pval->value = 0;
	pval->relative = ABSOLUTE;

	if (! *pc)						// blank expression is same as zero, ok?
		return S_DEFINED;

	if (setjmp(exprjmp) != 0) {		// encountered a syntax error & bailed
		pval->value = 0;
		pval->relative = ABSOLUTE;
		return S_UNDEFINED;
	}

	exprptr = oexprptr = pc;		// make global the buffer pointer

	c_expr(pval);

	if (GETNEXT)					// expression should have been entirely eaten
		exprerr(8);					// if characters are left, it's an error

	if (pval->relative < 0 || pval->relative > 1)
		exprerr(11);				// has to work out to an absolute or a single relative term

	if (symbest == S_DEFINED)		// tell how it came out
		return S_DEFINED;

	pval->value = 0;
	pval->relative = ABSOLUTE;
	return (pass == 1 && undefined_ok) ? S_PROVISIONAL : S_UNDEFINED;
}

// ---------------------------------------------------------------------------------
// output_literals - construct .DC assembler lines to assemble pending literal
// constant values that have accumulated.
// ---------------------------------------------------------------------------------

void output_literals (BOOL eof)
{
	char line[120], label[12], num[20];
	int i;

	for (i = 0; i < n_literals; i++) {			// generate DC statements for any pending literal constants
		if (literal[i].even && literal[i].hex)				// create the value string
			sprintf(num, "/%08lx", literal[i].value);
		else if (literal[i].even)
			sprintf(num, "%ld",    literal[i].value);
		else if (literal[i].hex)
			sprintf(num, "/%04x",  literal[i].value & 0xFFFF);
		else
			sprintf(num, "%d",     literal[i].value);

		sprintf(label, "_L%03d", literal[i].tagno);
		format_line(line, label, literal[i].even ? "DEC" : "DC", "", num, "GENERATED LITERAL CONSTANT");

		if (eof) {
			eof = FALSE;							// at end of file, for first literal, only prepare blank line
			sprintf(listline, LEFT_MARGIN, org);
		}
		else
			listout(TRUE);							// push out any pending line(s)

		if (flist && list_on) 						// this makes stuff appear in the listing
			sprintf(listline, LEFT_MARGIN " %s", detab(line));

		nwout = 0;

		parse_line(line);							// assemble the constant definition
	}

	n_literals = 0;									// clear list
}

// ---------------------------------------------------------------------------------
// a1130_term - extract one term of an expression
// ---------------------------------------------------------------------------------

void a1130_term (EXPR *ap)
{
	PSYMBOL s;
	char token[80], *t;
	int c;

	if (cexpr) {						// use C syntax
		c_term(ap);
		return;
	}

    c = GETNEXT;

	if (ctype[c] == DIGIT) {			/* number */
		ap->value = c_number(c,10,-1);
		ap->relative = ABSOLUTE;
	}
	else if (c == '+') {				/* unary + */
		a1130_term(ap);
	}
	else if (c == '-') {				/* unary - */
	 	a1130_term(ap);
		ap->value = - ap->value;
	}
	else if (c == '/') {				/* / starts a hex constant */
		ap->value = c_number(c,16,-1);
		ap->relative = ABSOLUTE;
	}
	else if (c == '*') {				/* asterisk alone = org */
		ap->value = org + org_advanced;	// here is where that offset matters!
		ap->relative = relocate;
	}
	else if (c == '.') {				/* EBCDIC constant */
		c = GETNEXT;
		if (c == '\0') {
			UNGET;
			c = ' ';
		}
		c = ascii_to_ebcdic_table[c];
		ap->value = c;					// VALUE IS IN LOW BYTE!!!
		ap->relative = ABSOLUTE;
	}
	else if (ctype[c] == LETTER) {		/* symbol */
		t = token;
		do {
			*t++ = c;
			c = GETNEXT;
		} while (ctype[c] == LETTER || ctype[c] == DIGIT);
		UNGET;
		*t++ = '\0';

		s = lookup_symbol(token, TRUE);
		add_xref(s, FALSE);
		ap->value    = s->value;
		ap->relative = s->relative;

		symbest = MIN(symbest, s->defined);		// this goes to lowest value (undefined < provisional < defined)
		if (pass == 2 && s->defined != S_DEFINED)
			exprerr(1);
	}
	else
		exprerr(8);
}

// ---------------------------------------------------------------------------------
// c_expr - evalate an expression
// ---------------------------------------------------------------------------------

void c_expr (EXPR *ap)
{
	int c;
	EXPR rop;

	c_expr_m(ap);									// get combined multiplicative terms
	for (;;) {										// handle +/- precedence operators
		if (ctype[c=getnb()] != ADDOP) {
			UNGET;
			break;
		}
		c_expr_m(&rop);								// right hand operand
		switch (c) {
			case '+':
				ap->value += rop.value;
				ap->relative += rop.relative;
				break;

			case '-':
				ap->value -= rop.value;
				ap->relative -= rop.relative;
				break;

			case '|':
				if (ap->relative || rop.relative)
					exprerr(11);
				ap->value = ((long) (ap->value)) | ((long) rop.value);
				break;

			default:
				printf("In expr, can't happen\n");
		}
	}
}

// ---------------------------------------------------------------------------------
// c_expr_m - get multiplicative precedence terms. Again, this is not usually used
// ---------------------------------------------------------------------------------

void c_expr_m (EXPR *ap)
{
	int c;
	EXPR rop;

	c_expr_e(ap);						// get exponential precedence term
	for (;;) {							// get operator
		c = getnb();
		if ((c=='<') || (c=='>'))
			if (c != getnb())			// << or >>
				exprerr(3);
		if (ctype[c] != MULOP) {
			UNGET;
			break;
		}
		c_expr_e(&rop);					// right hand operand

		switch(c) {
			case '*':
				if (ap->relative && rop.relative)
					exprerr(11);

				ap->value *= rop.value;
				ap->relative = (ap->relative || rop.relative) ? RELATIVE : ABSOLUTE;
				break;

			case '/':
				if (rop.value == 0)
					exprerr(2);
				if (ap->relative || rop.relative)
					exprerr(11);

				ap->value /= rop.value;
				break;

			case '%':
				if (rop.value == 0)
					exprerr(2);
				if (ap->relative || rop.relative)
					exprerr(11);

				ap->value = ((long) (ap->value)) % ((long) rop.value);
				break;

			case '&':
				if (ap->relative || rop.relative)
					exprerr(11);

				ap->value = ((long) (ap->value)) & ((long) rop.value);
				break;

			case '>':
				if (ap->relative || rop.relative)
					exprerr(11);

				ap->value = ((long) (ap->value)) >> ((long) rop.value);
				break;

			case '<':
				if (ap->relative || rop.relative)
					exprerr(11);

				ap->value = ((long) (ap->value)) << ((long) rop.value);
				break;

			default:
				printf("In expr_m, can't happen\n");
		}
	}
}

// ---------------------------------------------------------------------------------
// c_expr_e - get exponential precedence terms. Again, this is not usually used
// ---------------------------------------------------------------------------------

void c_expr_e (EXPR *ap)
{
	int c, i, v;
	EXPR rop;

	c_expr_u(ap);
	for (;;) {
		c = getnb();
		if (ctype[c] != EXPOP) {
			UNGET;
			break;
		}
		c_expr_u(&rop);

		switch(c) {
			case '^':
				if (ap->relative || rop.relative)
					exprerr(11);

				v = ap->value;
				ap->value = 1;
				for (i = 0; i < rop.value; i++)
					ap->value *= v;
				break;

			default:
				printf("In expr_e, can't happen\n");
		}
	}
}

// ---------------------------------------------------------------------------------
// c_expr_u - get unary precedence terms. Again, this is not usually used
// ---------------------------------------------------------------------------------

void c_expr_u (EXPR *ap)
{
	int c;

	if ((c = getnb()) == '!') {
		a1130_term(ap);
		ap->value = ~ ((long)(ap->value));
		if (ap->relative)
			exprerr(11);
	}
	else if (c == '-') {
		a1130_term(ap);
		ap->value = - ap->value;
		if (ap->relative)
			exprerr(11);
	}
	else {
		UNGET;
		a1130_term(ap);
	}
}

// ---------------------------------------------------------------------------------
// c_term - get basic operand or parenthesized expression.  Again, this is not usually used
// ---------------------------------------------------------------------------------

void c_term (EXPR *ap)
{
	int c, cc;
	PSYMBOL s;
	char token[80], *t;

	ap->relative = ABSOLUTE;			/* assume absolute */

	if ((c = getnb()) == '(') {			/* parenthesized expr */
		c_expr(ap);						/* start over at the top! */
		if ((cc = getnb()) != ')')
			exprerr(4);
	}
	else if (c == '\'') {				/* single quote: char */
		if ((c = GETNEXT) == '\0')
			c = ' ';
		ap->value = c_esc(c);
	}
	else if (ctype[c] == DIGIT) {		/* number */
		ap->value = c_number(c,10,-1);
	}
	else if (c == '0') {				/* 0 starts a hex or octal constant */
		if ((c = GETNEXT) == 'x') {
			c = GETNEXT;
			ap->value = c_number(c,16,-1);
		}
		else {
			ap->value = c_number(c,8,-1);
		}
	}
	else if (c == '*') {				/* asterisk alone = org */
		ap->value = org + org_advanced;
		ap->relative = relocate;
	}
	else if (ctype[c] == LETTER) {		/* symbol */
		t = token;
		do {
			*t++ = c;
			c = GETNEXT;
		} while (ctype[c] == LETTER || ctype[c] == DIGIT);
		UNGET;
		*t++ = '\0';

		s = lookup_symbol(token, TRUE);
		ap->value = s->value;
		ap->relative = s->relative;
		add_xref(s, FALSE);
		symbest = MIN(symbest, s->defined);		// this goes to lowest value (undefined < provisional < defined)

		if (pass == 2 && s->defined != S_DEFINED)
			exprerr(1);
	}
	else
		exprerr(8);
}

// ---------------------------------------------------------------------------------
// c_number - get a C format constant value.  Again, this is not usually used
// ---------------------------------------------------------------------------------

int c_number (int c, int r, int nchar)
{
	int v, n;

	nchar--;

	if (c == '/' && ! cexpr) {						/* special radix stuff */
		r = 16;
		c = GETNEXT;
	}
	else if (r == 10 && c == '0' && cexpr) {		/* accept C style 0x## also */
		c = GETNEXT;
		if (c == 'x') {
			r = 16;
			c = GETNEXT;
		}
		else {
			r = 8;
			UNGET;
			c = '0';
		}
	}

	n = 0;				/* decode number */
	while ((nchar-- != 0) && (v = digit(c, r)) >= 0) {
		if (v >= r)		/* out of range! */
			exprerr(9);

		n = r*n + v;

		c = GETNEXT;
		if (c == '.') {		// maybe make it decimal?
			c = GETNEXT;
			break;
		}
	}

	UNGET;
	return (n);
}

// ---------------------------------------------------------------------------------
// digit - get digit value of character c in radix r
// ---------------------------------------------------------------------------------

int digit (int c, int r)
{
	if (r == 16) {
		if (c >= 'A' && c <= 'F')
			return (c - 'A' + 10);
	}

	if (c >= '0' && c <= '9')
		return (c - '0');

	return (-1);
}

// ---------------------------------------------------------------------------------
// c_esc - handle C character escape
// ---------------------------------------------------------------------------------

int c_esc (int c)
{
	if (c != '\\')			/* not escaped */
		return(c);

	if ((c = GETNEXT) == '\0')	/* must be followed by something */
		exprerr(10);
	if ((c >= 'A') && (c <= 'Z'))	/* handle upper case */
		c += 'a'-'A';
	if (ctype[c] == LETTER)		/* control character abbrevs */
		switch (c) {
			case 'b': c = '\b'; break;	/* backspace */
			case 'e': c = 27  ; break;	/* escape */
			case 'f': c = '\f'; break;	/* formfeed */
			case 'n': c = '\n'; break;	/* newline */
			case 'r': c = '\r'; break;	/* return */
			case 't': c = '\t'; break;	/* horiz. tab */
		}
	else if (ctype[c] == DIGIT) {	/* get character by the numbers */
		c = c_number(c,8,3);	/* force octal */
	}

	return c;
}

// ---------------------------------------------------------------------------------
// exprerr - note an expression syntax error. Longjumps back to caller with failure code
// ---------------------------------------------------------------------------------

void exprerr (int n)
{
	char msg[256];
	int nex = exprptr-oexprptr;

	strncpy(msg, oexprptr, nex);		// show where the problem was
	msg[nex] = '\0';
	strcat(msg, " << ");
	strcat(msg, errstr[n]);

	asm_error(msg);

	exprerrno = n;
	longjmp(exprjmp, 1);
}

/* ------------------------------------------------------------------------ 
 * upcase - force a string to uppercase (ASCII)
 * ------------------------------------------------------------------------ */

char *upcase (char *str)
{
	char *s;

	for (s = str; *s; s++) {
		if (*s >= 'a' && *s <= 'z')
			*s -= 32;
	} 

	return str;
}

/* ------------------------------------------------------------------------ 
 * hollerith table for IPL card ident field
 * ------------------------------------------------------------------------ */

typedef struct {
	int		hollerith;
	char	ascii;
} CPCODE;

static CPCODE cardcode_029[] =
{
	0x0000,		' ',
	0x8000, 	'&',	 		// + in 026 Fortran
	0x4000,		'-',
	0x2000,		'0',
	0x1000,		'1',
	0x0800,		'2',
	0x0400,		'3',
	0x0200,		'4',
	0x0100,		'5',
	0x0080,		'6',
	0x0040,		'7',
	0x0020,		'8',
	0x0010,		'9',
	0x9000, 	'A',
	0x8800,		'B',
	0x8400,		'C',
	0x8200,		'D',
	0x8100,		'E',
	0x8080,		'F',
	0x8040,		'G',
	0x8020,		'H',
	0x8010,		'I',
	0x5000, 	'J',
	0x4800,		'K',
	0x4400,		'L',
	0x4200,		'M',
	0x4100,		'N',
	0x4080,		'O',
	0x4040,		'P',
	0x4020,		'Q',
	0x4010,		'R',
	0x3000, 	'/',
	0x2800,		'S',
	0x2400,		'T',
	0x2200,		'U',
	0x2100,		'V',
	0x2080,		'W',
	0x2040,		'X',
	0x2020,		'Y',
	0x2010,		'Z',
	0x0820,		':',
	0x0420,		'#',		// = in 026 Fortran
	0x0220,		'@',		// ' in 026 Fortran
	0x0120,		'\'',
	0x00A0,		'=',
	0x0060,		'"',
	0x8820,		'c',		// cent
	0x8420,		'.',
	0x8220,		'<',		// ) in 026 Fortran
	0x8120,		'(',
	0x80A0,		'+',
	0x8060,		'|',
	0x4820,		'!',
	0x4420,		'$',
	0x4220,		'*',
	0x4120,		')',
	0x40A0,		';',
	0x4060,		'n',		// not
	0x2820,		'x',		// what?
	0x2420,		',',
	0x2220,		'%',		// ( in 026 Fortran
	0x2120,		'_',
	0x20A0,		'>',
	0x2060,		'>',
};

int ascii_to_hollerith (int ch)
{
	int i;

	for (i = 0; i < sizeof(cardcode_029) / sizeof(CPCODE); i++)
		if (cardcode_029[i].ascii == ch)
			return cardcode_029[i].hollerith;

	return 0;
}

/* ------------------------------------------------------------------------ 
 * detab - replace tabs with spaces for listing files
 * ------------------------------------------------------------------------ */

char *detab (char *instr)
{
	static char outstr[256];
	char *out = outstr;
	int col = 0;

	while (*instr) {
		if (*instr == '\t') {
			do {
				*out++ = ' ';
				col++;
			}
			while (col & 7);
		}
		else {
			*out++ = *instr;
			col++;
		}

		instr++;
	}
	
	*out = '\0';

	return outstr;
}


#ifndef WIN32

int strnicmp (char *a, char *b, int n)
{
	int ca, cb;

	for (;;) {
		if (--n < 0)					// still equal after n characters? quit now
			return 0;

		if ((ca = *a) == 0)				// get character, stop on null terminator
			return *b ? -1 : 0;

		if (ca >= 'a' && ca <= 'z')		// fold lowercase to uppercase
			ca -= 32;

		cb = *b;
		if (cb >= 'a' && cb <= 'z')
			cb -= 32;

		if ((ca -= cb) != 0)			// if different, return comparison
			return ca;

		a++, b++;
	}
}

int strcmpi (char *a, char *b)
{
	int ca, cb;

	for (;;) {
		if ((ca = *a) == 0)				// get character, stop on null terminator
			return *b ? -1 : 0;

		if (ca >= 'a' && ca <= 'z')		// fold lowercase to uppercase
			ca -= 32;

		cb = *b;
		if (cb >= 'a' && cb <= 'z')
			cb -= 32;

		if ((ca -= cb) != 0)			// if different, return comparison
			return ca;

		a++, b++;
	}
}

#endif