Upload

Digital Research

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/as68.h

@@ -0,0 +1,402 @@
+/*
+	Copyright 1981
+	Alcyon Corporation
+	8716 Production Ave.
+	San Diego, Ca.  92121
+*/
+
+#include "mach.h"
+#include <ctype.h>
+
+#ifdef PDP11
+	struct {
+		char lobyte;
+		char hibyte;
+	};
+	struct {
+		char *ptrw1;
+		char *ptrw2;
+	};
+	struct {
+		int wd1;
+		int wd2;
+	};
+	struct {
+		int swd1;
+	};
+#endif
+
+#ifdef MC68000
+	struct {
+		char hibyte;
+		char lobyte;
+	};
+	struct {
+		char *ptrw2;
+	};
+	struct {
+		int wd1;
+		int wd2;
+	};
+	struct {
+		int swd1;
+	};
+#endif
+
+#ifdef VAX11
+	struct {
+		short wd2;
+		short wd1;
+	};
+	struct {
+		short swd1;
+	};
+
+	struct {
+		char lobyte;
+		char hibyte;
+	};
+	struct {
+		char *ptrw2;
+	};
+#endif
+
+/* format of a symbol entry in the main table*/
+
+# define NAMELEN	8		/*length of name in symbol table*/
+struct symtab {
+	char name[NAMELEN];		/*symbol name*/
+	int  flags;			/*bit flags*/
+	char *tlnk;			/*table link*/
+	long  vl1;			/*symbol value*/
+};
+
+struct symtab *symtptr;
+# define STESIZE	(sizeof *symtptr)	/*byte length of symbol table entry*/
+
+/* flags for symbols*/
+# define SYDF	0100000		/*defined*/
+# define SYEQ	0040000		/*equated*/
+# define SYGL	0020000		/*global - entry or external*/
+# define SYER	0010000		/*equated register*/
+# define SYXR	0004000		/*external reference*/
+# define SYRA	0002000		/*DATA based relocatable*/
+# define SYRO	0001000		/*TEXT based relocatable*/
+# define SYBS	0000400		/*BSS based relocatable*/
+# define SYIN	0000200		/*internal symbol -- opcode, directive or equ*/
+# define SYPC	0000100		/*[vlh]equated using star '*' expression*/
+# define SYRM	0000040		/*[vlh]register mask equate*/
+
+/*flags for opcodes and directives*/
+# define OPDR	0100000		/*0=>opcode, 1=>directive*/
+# define OPFF	037			/*type of instruction (used as mask)*/
+
+struct irts {
+	char *irle;		/*ptr to last entry in chain*/
+	char *irfe;		/*ptr to first entry in chain*/
+};
+
+long stlen;			/*length of symbol table*/
+
+/*
+ * intermediate text file
+ * format of the intermediate text for one statement:
+ *
+ *	******************************************************
+ *	*  it type = ITBS      *     # it entries            *  0
+ *	******************************************************
+ *	*       absolute line number (long)                  *
+ *	******************************************************
+ *	*  it type = ITSY      * instr length                *  1
+ *	******************************************************
+ *	*  symbol table pointer for stmt label (long)        *
+ *	******************************************************
+ *	*  it type = ITSY      *  instr mode length          *  2
+ *	******************************************************
+ *	*            opcode ptr (long)                       *
+ *	******************************************************
+ *	*  it type = ITCN      *  relocation base            *  3
+ *	******************************************************
+ *	*            location counter (pass 1)               *
+ *	******************************************************
+ *	*  it type             *  relocation flag            *  4 - oprnds
+ *	******************************************************
+ *	*               value (long)                         *
+ *	******************************************************
+ *                         .
+ *
+ *                         .
+ *	******************************************************
+ *	*  it type             *  relocation flag            *  n - oprnds
+ *	******************************************************
+ *	*               value (long)                         *
+ *	******************************************************
+ */
+
+#define ITOP1	4	/*first it entry for operands*/
+
+/*
+ *	it type				meaning
+ *		0			beginning of statement
+ *		1			value is pointer to symbol table
+ *		2			value is a constant
+ *		3			value is a specal char
+ *
+ *  relocation flag for opcode it entry is operand length:
+ *		'b' => byte
+ *		'w' => word
+ *		'l' => long
+ */
+
+struct it {
+	char itty;		/*it type*/
+	char itrl;		/*relocation flag or # it entries*/
+	long  itop;
+};
+
+int mode;		/*operand mode (byte, word, long)*/
+int modelen;	/*operand length per mode*/
+#define BYTE	'b'
+#define WORD	'w'
+#define LONG	'l'
+
+/* parameters that define the main table*/
+#define SZMT 300		/*initial size of the main table */
+						/*must be large enough to initialize*/
+#define ICRSZMT 10		/*add to main table when run out*/
+int cszmt;				/*current size of main table*/
+char *bmte;				/*beginning of main table*/
+char *emte;				/*end of main table*/
+
+/* intermediate text types*/
+#define ITBS	0		/*beginning of statement*/
+#define ITSY	1		/*pointer to symbol table*/
+#define ITCN	2		/*constant*/
+#define ITSP	3		/*special*/
+#define ITRM	4		/*[vlh]register mask!*/
+#define ITPC	5		/*[vlh]pc relative argument*/
+
+# define ITBSZ	256		/*size of the it buffer*/
+int itbuf[ITBSZ];		/*it buffer*/
+
+#define STMAX	200		/*size of intermediate text buffer*/
+struct it stbuf[STMAX];		/*holds it for one statement*/
+#define STBFSIZE	(sizeof stbuf[0])
+
+char sbuf[512];		/*holds one block of source*/
+
+/*initial reference table for symbols*/
+# define SZIRT	128
+char *sirt[SZIRT];
+#define SIRTSIZE	(sizeof sirt[0])
+
+/*initial reference table to opcodes*/
+char *oirt[SZIRT];
+#define OIRTSIZE	(sizeof oirt[0])
+
+/*external symbol table*/
+#define EXTSZ	512
+char *extbl[EXTSZ];
+int extindx;		/*index to external symbol table*/
+char **pexti;			/*ptr to external symbol table*/
+
+int absln;		/*absolute line number*/
+int p2absln;	/*pass 2 line number*/
+int fcflg;		/*0=>passed an item.  1=>first char*/
+int fchr;		/*first char in term*/
+int ifn;		/*source file descriptor*/
+int *pitix;		/*ptr to it buffer*/
+int itwc;		/*number of words in it buffer*/
+struct it *pitw;	/*ptr to it buffer next entry*/
+int itype;		/*type of item*/
+long ival;		/*value of item*/
+char *lblpt;		/*label pointer*/
+char lbt[NAMELEN];	/*holds label name*/
+char *lmte;		/*last entry in main table*/
+long loctr;		/*location counter*/
+long savelc[4];	/*save relocation counters for 3 bases*/
+int nite;		/*number of entries in stbuf*/
+struct it *pnite;
+int lfn;		/*loader output file descriptor*/
+char *opcpt;		/*pointer to opcode entry in main table*/
+int p2flg;		/*0=>pass 1  1=>pass 2*/
+char **pirt;		/*entry in initial reference table*/
+int reloc;		/*relocation value returned by expression evaluator (expr)*/
+int rlflg;		/*relocation value of current location counter*/
+/*relocation values*/
+# define ABS	0		/*absolute*/
+# define DATA	1
+# define TEXT	2
+# define BSS	3
+# define EXTRN	4		/*externally defined*/
+
+#define EOLC	'\n'	/*end of line character*/
+#define EOF		0		/*end of file indicator*/
+#define NULL	0		/* [vlh] character null '\0' */
+#define TRUE	1		/* [vlh] boolean values */
+#define FALSE	0		/* [vlh] boolean values */
+
+int format;
+int sbuflen;		/*number of chars in sbuf*/
+char *psbuf;		/*ptr into sbuf*/
+int itfn;			/*it file number*/
+char itfnc;			/*last char of it file name*/
+int trbfn;			/*temp for text relocation bits*/
+char trbfnc;		/*last char of text rb file*/
+int dafn;			/*file for data stuff*/
+char dafnc;			/*last char of data file*/
+int drbfn;			/*file for data relocation bits*/
+char drbfnc;		/*last char*/
+int prtflg;			/*print output flag*/
+int undflg;			/*make undefined symbols external flag*/
+
+int starmul;		/* * is multiply operator*/
+
+char *endptr, *addptr;
+char *orgptr;
+char *subptr, *addiptr, *addqptr, *subiptr, *subqptr;
+char *cmpptr, *addaptr, *cmpaptr, *subaptr, *cmpmptr;
+char *equptr;
+char *andptr, *andiptr, *eorptr, *eoriptr, *orptr, *oriptr;
+char *cmpiptr;
+char *moveptr, *moveqptr;
+char *exgptr;
+char *evenptr;
+char *jsrptr, *bsrptr, *nopptr;
+
+char peekc;
+int numcon[2], numsym[2], indir[2], immed[2], numreg[2];
+int plevel;		/*parenthesis level counter*/
+int opdix;		/*operand index counter*/
+int p1inlen;	/*pass 1 instr length*/
+int instrlen;	/*pass 2 bytes in current instruction*/
+
+/* effective address mode bits*/
+#define DDIR		000
+#define ADIR		010
+#define INDIRECT	020
+#define INDINC		030
+#define DECIND		040
+#define INDDISP		050
+#define INDINX		060
+#define SADDR		070
+#define LADDR		071
+#define IMM			074
+
+#define AREGLO		8
+#define AREGHI		15
+
+/* relocation bit definitions:*/
+#define RBMASK		07		/*tells type of relocation*/
+#define INSABS		7		/*first word of instr -- absolute*/
+#define DABS		0		/*data word absolute*/
+#define TRELOC		2		/* TEXT relocatable*/
+#define DRELOC		1		/* DATA relocatable*/
+#define BRELOC		3		/* BSS relocatable*/
+#define EXTVAR		4		/* ref to external variable*/
+#define LUPPER		5		/* upper word of long*/
+#define EXTREL		6		/* external relative mode*/
+
+/* ptrs to ins[] and rlbits[]*/
+int *pins;
+int *prlb;
+int ins[5];					/*holds instruction words*/
+
+#define PRTCHLEN 128
+char prtchars[PRTCHLEN];	/*line buffer for putchar*/
+char *prtchidx;				/*index for putchar*/
+
+int extflg, extref;		/*external in expr*/
+
+#define CCR	16
+#define SR	17
+#define USP	18
+#define MOVECCR	042300
+#define MOVESR	043300
+#define SRMOVE	040300
+#define MOVEUSP	047140
+
+struct op {
+	int ea;			/* effective address bits*/
+	int len;		/* effective address length in bytes*/
+	long con;		/*constant or reloc part of operand*/
+	int drlc;		/*reloc of con*/
+	int ext;		/*external variable #*/
+	int idx;		/*index register if any*/
+	int xmod;		/*mode of index reg*/
+} opnd[2];
+
+struct buf{
+	int fildes;
+	int nunused;
+	char *xfree;
+	char buff[512];
+};
+
+struct buf lbuf;
+struct buf tbuf;
+struct buf dabuf;
+struct buf drbuf;
+
+int nerror;		/*# of assembler errors*/
+int in_err;		/*[vlh] don't generate instrlen err if already err state*/
+int shortadr;	/*short addresses if set*/
+
+#define CLRFOR	24
+#define CLRVAL	041000
+
+long itoffset;
+
+#define LASTCHTFN	tfilname[11]
+#define PC	22
+
+int equflg;		/*doing an equate stmt*/
+
+#define ANDI	01000
+#define AND	0140000
+#define ORI		0
+#define OR		0100000
+#define EORI	05000
+#define EOR		0130000
+#define MOVE	0
+
+long lseek();
+char *sbrk();
+char *lemt();
+
+int refpc;		/* * referenced in expr*/
+#define SOH	1
+
+/* Conditional Assembly variables and constants [vlh] */
+#define LOW_CA	21		/* [vlh] */
+#define HI_CA	30		/* [vlh] */
+
+int ca_true;	/* true unless in a false CA*/
+int ca;			/* depth of conditional assembly, none = 0*/
+int ca_level;	/* at what CA depth did CA go false?*/
+
+/* pass 1 global variables */
+int numops;		/*number of operands*/
+int inoffset;	/*[vlh]offset directive*/
+int didorg;
+int initflg;	/*initialize flag*/
+
+/* defines */
+#define igblk()		while(fchr==' ') fchr=gchr()
+#define ckein()		((pitw >= pnite))
+
+/* is it an alterable operand */
+#define memalt(ap)	(memea(ap) && altea(ap))
+#define dataalt(ap)	(dataea(ap) && altea(ap))
+#define altea(ap)	((((ap)->ea&070)!=SADDR || ((ap)->ea&6)==0))
+
+/* is it the specific type of operand */
+#define memea(ap)	(((ap)->ea&070) >= INDIRECT)
+#define dataea(ap)	(((ap)->ea&070) != ADIR)
+#define pcea(ap)	((ap)->ea==072 || (ap)->ea==073)
+#define ckdreg(ap)	((ap)->ea>=0 && (ap)->ea<AREGLO)
+#define ckareg(ap)	((ap)->ea>=AREGLO && (ap)->ea<=AREGHI)
+
+#ifndef VAX11
+#define myfflush(pp)	fflush(pp)
+#endif

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/buildfile

@@ -0,0 +1 @@
+cc -f -s -n dir.o expr.o main.o misc.o pass1a.o pass2.o symt.o version.o v7seek.o -o as68.11v7

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/cout.h

@@ -0,0 +1,13 @@
+#define HDSIZE	(sizeof couthd)	/**.o file header size*/
+struct hdr {
+	int  ch_magic;		/*c.out magic number 060016 = $600E*/
+	long ch_tsize;		/*text size*/
+	long ch_dsize;		/*data size*/
+	long ch_bsize;		/*bss size*/
+	long ch_ssize;		/*symbol table size*/
+	long ch_stksize;	/*stack size*/
+	long ch_entry;		/*entry point*/
+	int  ch_rlbflg;		/*relocation bits suppressed flag*/
+} couthd;
+
+#define MAGIC	0x601a	/* bra .+26 instruction*/

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/diff.com

@@ -0,0 +1,11 @@
+$ set def drb0:[steve.cpm68k.v102a.al40.oldas68]
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) DIR.C [-.as68]DIR.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) EXPR.C [-.as68]EXPR.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) MAIN.C [-.as68]MAIN.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) MISC.C [-.as68]MISC.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) PASS1A.C [-.as68]PASS1A.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) PASS2.C [-.as68]PASS2.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) SYMT.C [-.as68]SYMT.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) VERSION.C [-.as68]VERSION.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) AS68.H [-.as68]AS68.H
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) COUT.H [-.as68]COUT.H

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/diff.com.4

@@ -0,0 +1,11 @@
+$ set def drb0:[steve.cpm68k.v102.al40.oldas68]
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) DIR.C [-.as68]DIR.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) EXPR.C [-.as68]EXPR.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) MAIN.C [-.as68]MAIN.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) MISC.C [-.as68]MISC.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) PASS1A.C [-.as68]PASS1A.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) PASS2.C [-.as68]PASS2.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) SYMT.C [-.as68]SYMT.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) VERSION.C [-.as68]VERSION.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) AS68.H [-.as68]AS68.H
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) COUT.H [-.as68]COUT.H

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/diff1.com

@@ -0,0 +1,12 @@
+$ set def drb0:[steve.cpm68k.v102a.al40.oldas68]
+$ assign  drb0:[steve.cpm68k.v102.as68] old
+$ diff/ign=(blank,spac) DIR.C old:DIR.C
+$ diff/ign=(blank,spac) EXPR.C old:EXPR.C
+$ diff/ign=(blank,spac) MAIN.C old:MAIN.C
+$ diff/ign=(blank,spac) MISC.C old:MISC.C
+$ diff/ign=(blank,spac) PASS1A.C old:PASS1A.C
+$ diff/ign=(blank,spac) PASS2.C old:PASS2.C
+$ diff/ign=(blank,spac) SYMT.C old:SYMT.C
+$ diff/ign=(blank,spac) VERSION.C old:VERSION.C
+$ diff/ign=(blank,spac) AS68.H old:AS68.H
+$ diff/ign=(blank,spac) COUT.H old:COUT.H

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/diff1.com.2

@@ -0,0 +1,12 @@
+$ set def drb0:[steve.cpm68k.v102a.al40.oldas68]
+$ assign  drb0:[steve.cpm68k.v102.as68] old
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) DIR.C old:DIR.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) EXPR.C old:EXPR.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) MAIN.C old:MAIN.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) MISC.C old:MISC.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) PASS1A.C old:PASS1A.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) PASS2.C old:PASS2.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) SYMT.C old:SYMT.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) VERSION.C old:VERSION.C
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) AS68.H old:AS68.H
+$ diff/ign=(blank,spac,comm)/comm=(slash,semi) COUT.H old:COUT.H

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/dir.c

@@ -0,0 +1,929 @@
+/*
+	Copyright 1981
+	Alcyon Corporation
+	8716 Production Ave.
+	San Diego, Ca.  92121
+*/
+
+/*	Pass 1 and pass 2 directive handling routines */
+/*	code to handle conditional assembly directives */
+
+#include "as68.h"
+#include "cout.h"
+
+int p1gi();
+int p2gi();
+int igrst();
+
+/*directive to define an opcode*/
+hopd()
+{
+
+	if(!lbt[0]) {
+		xerr(4);		/*no label*/
+		return;
+	}
+	setname();					/*move label into main table*/
+	if((lblpt=lemt(oirt,TRUE))!=lmte) {
+		xerr(5);				/*opcode redefined*/
+		return;
+	}
+	mmte();						/*make main table entry*/
+	expr(&p1gi);				/*get instruction format*/
+	if(itype!=ITCN || ival<0 || ival>OPFF) {
+		xerr(18);			/*illegal format specifier*/
+		return;
+	}
+	lblpt->flags =| ival|SYIN;		/*remember format*/
+	if(fchr != ',') {			/*field separator*/
+		xerr(10);
+		return;
+	}
+	expr(&p1gi);				/*get opcode value*/
+	if(itype != ITCN) {
+		xerr(17);		/*not a constant*/
+		return;
+	}
+	lblpt->vl1 = ival;			/*put value in main table*/
+	igrst();					/*ignore rest of statement-comment*/
+}
+
+/* equate directive*/
+hequ()
+{
+	if(lbt[0] == 0) {
+		xerr(4);		/*no label*/
+		return;
+	}
+	setname();
+	if((lblpt=lemt(sirt,FALSE))!=lmte) {	/*aready there*/
+		if(lbt[0] == '~') {	/*local symbol*/
+			lblpt = lmte;
+			mmte();
+		}
+	}
+	else
+		mmte();
+	if(lblpt->flags&SYXR) {
+		xerr(29);
+		return;
+	}
+	lblpt->flags =| SYDF|SYEQ;	/*defined & equate*/
+	equflg = 1;
+	modelen = 4;
+	expr(&p1gi);
+	equflg = 0;
+	if(itype == ITSY && ival.ptrw2->flags&SYER) {
+		lblpt->flags =| SYER;	/*equated register*/
+		ival = ival.ptrw2->vl1;
+	}
+	else if(itype != ITCN) {
+		xerr(7);				/*not a constant*/
+		return;
+	}
+	if (inoffset && reloc != ABS) {	/* [vlh] */
+		xerr(11);
+		return;
+	}
+	if(initflg)					/*doing symbol table initialization*/
+		lblpt->flags =| SYIN;	/*internal symbol*/
+	lblpt->vl1 = ival;
+	if(reloc == DATA)			/*check relocation*/
+	{
+		lblpt->flags =| SYRA;	/*DATA relocatable*/
+	}
+	else if(reloc == TEXT)
+		lblpt->flags =| SYRO;	/*TEXT relocatable*/
+	else if(reloc == BSS)
+		lblpt->flags =| SYBS;	/*BSS relocatable*/
+	else if(fchr==',' && (fchr=gchr())=='r')
+		lblpt->flags =| SYER;	/*equated register*/
+	if (refpc)		/*[vlh] flag directive is pc relative */
+		lblpt->flags =| SYPC;
+	igrst();
+}
+
+/* process dsect directive*/
+hdsect()
+{
+	dorlst(DATA);
+}
+
+dorlst(xrtyp)
+{
+	inoffset = 0;	/* [vlh] offset mode terminated my sect directive */
+	dlabl();		/*define label on old base if there is one*/
+	savelc[rlflg] = loctr;	/*save old base relocation*/
+	rlflg = xrtyp;
+	loctr = savelc[xrtyp];	/*set new base relocation ctr*/
+	opitb();
+	stbuf[0].itrl = itwc;
+	wostb();
+	igrst();
+}
+
+/*process psect directive*/
+hpsect()
+{
+	dorlst(TEXT);
+}
+
+hbss()
+{
+	dorlst(BSS);
+}
+
+/*make pc even*/
+heven()
+{
+
+	if(loctr&1) {		/*have to make it even*/
+		dorlst(rlflg);
+		loctr++;
+	}
+	else {
+		igrst();
+	}
+}
+
+/*process globl directive*/
+hent()
+{
+	while(1) {
+		gterm(TRUE);					/*get entry symbol*/
+		if(itype!=ITSY) {				/*error if not symbol*/
+			xerr(28);
+			return;
+		}
+		if((lblpt=lemt(sirt,FALSE)) == lmte)	/*look up in main table*/
+			mmte();						/*not there, make new entry*/
+		else
+			if(lblpt->flags&SYER)		/*already there*/
+				uerr(29);
+		lblpt->flags =| SYGL;			/*symbol is an entry*/
+		if(lblpt->flags&SYXR) {			/*been thru hext code*/
+			lblpt->flags =& ~(SYXR|SYDF);	/*reset for init of .comm*/
+		}
+		if (inoffset && reloc != ABS) {	/* [vlh] */
+			xerr(11);
+			return;
+		}
+		if(fchr == ',')					/*skip ',' between entries*/
+			fchr = gchr();
+		else {
+			igrst();					/*statement finished*/
+			return;
+		}
+	}
+}
+
+/*process comm directive*/
+hext()
+{
+	gterm(TRUE);					/*get external symbol*/
+	if(itype!=ITSY) {				/*error if not symbol*/
+		xerr(28);
+		return;
+	}
+	if((lblpt=lemt(sirt,FALSE)) == lmte)	/*look up in main table*/
+		mmte();						/*not there, make new entry*/
+	else
+		if(lblpt->flags&SYDF && (lblpt->flags&SYXR)==0)	/*already there*/
+			uerr(29);
+	lblpt->flags =| SYXR | SYDF;	/*symbol is an external*/
+	mkextidx(lblpt);	/*put into external table*/
+	if(fchr == ',') {				/*skip ',' between operands*/
+		fchr = gchr();
+		gterm(TRUE);
+		if(itype != ITCN) {
+			xerr(17);
+			return;
+		}
+		lblpt->vl1.wd1 = ival;		/* # bytes of storage required*/
+	}
+	else
+		lblpt->vl1.wd1 = 1;			/* default # bytes*/
+	igrst();
+}
+
+mkextidx(p)
+struct symtab *p;
+{
+
+	if(extindx >= EXTSZ) {	/*check for overflow of external symbol tbl*/
+		rpterr("overflow of external table\n");
+		endit();
+	}
+	p->vl1.wd2 = pexti - extbl;	/* external symbol index #*/
+	*pexti++ = p;		/*save external in external table*/
+	extindx++;
+}
+
+/* end statement*/
+hend()
+{
+	register int i,j;
+
+	inoffset = 0;	/*[vlh] turn off inoffset mode*/
+	lblpt = 0;	/*no label*/
+	opitb();	/*output beginning of statement*/
+	igrst();	/* [vlh] ignore operands */
+	stbuf[0].itrl = itwc;	/*number of it entries*/
+	wostb();	/*write out statement buffer*/
+	if(pitix > itbuf)	/*some it in buffer*/
+		if(write(itfn,itbuf,ITBSZ*(sizeof i)) != ITBSZ*(sizeof i)) {
+			rpterr("I/O write error on it file\n");
+			endit();
+		}
+	if(initflg) {
+		putsymtab();
+		printf("68000 assembler initialized\n");
+		endit();
+	}
+	if((fchr=gchr())!=EOF) {
+		rpterr("end statement not at end of source\n");
+	}
+	savelc[rlflg] = loctr;	/*last location on current reloc base*/
+	fixunds();				/*make golbals and maybe undefineds external*/
+	if(!didorg)				/*did not assign to location counter*/
+		pass1a();			/*resolve short branches*/
+	pass2();				/*assembler pass 2*/
+}
+
+/* define storage given number of bytes*/
+hds()
+{
+	chkeven();			/*may need to make pc even*/
+	dlabl();			/*define label maybe*/
+	if (!inoffset)	/* [vlh] */
+		opitb();		/*output it for beginning of statement*/
+	refpc = 0;
+	expr(&p1gi);
+	if(itype!=ITCN) {
+		xerr(17);		/*must be constant*/
+		return;
+	}
+	if(reloc != ABS)  {
+		xerr(9);		/*must be absolute*/
+		return;
+	}
+	if (!inoffset) {	/* [vlh] don't generate it if in offset */
+		opitoo();			/*output one operand*/
+		stbuf[0].itrl = itwc;
+		wostb();			/*write out statement buffer*/
+		loctr =+ (ival*modelen);
+	}
+	igrst();
+}
+
+/* make pc even if necessary for .dc and .ds */
+chkeven()
+{
+	register char *pi;
+
+	if(modelen>1 && loctr&1) {
+		pi = opcpt;
+		opcpt = evenptr;
+		opitb();
+		stbuf[0].itrl = itwc;
+		wostb();
+		opcpt = pi;
+		loctr++;
+	}
+}
+
+/* define byte directive*/
+hdc()
+{
+	chkeven();
+	hdata(modelen);
+}
+
+/*
+ * define bytes or words of data
+ *	call with:
+ *		1 => defining bytes
+ *		2 => defining words
+ *		4 => defining long words
+ */
+hdata(mul)
+{
+	dlabl();		/*define label*/
+	opitb();		/*beginning of statement*/
+	numops = 0;		/*initialize count for number of operands*/
+	opito();		/*output it for operands*/
+	stbuf[0].itrl = itwc;	/* # of it entries*/
+	wostb();		/*write out statement buffer*/
+	loctr =+ numops*mul;	/* count by bytes or words*/
+}
+
+/* handle org statement*/
+horg()
+{
+	register i;
+
+	if(rlflg==TEXT && loctr!=0)
+		didorg++;	/*can't do branch optimization as separate pass now*/
+	expr(&p1gi);	/*value of new relocation counter*/
+	if(reloc != rlflg && reloc != ABS) {
+		xerr(27);
+		return;
+	}
+	if(ival < loctr) {
+		xerr(40);		/*trying to go backwards*/
+		return;
+	}
+	opcpt = orgptr;		/*org directive for pass 2*/
+	opitb();
+	opitoo();
+	stbuf[0].itrl = itwc;
+	wostb();
+	loctr = ival;
+	dlabl();		/*define label*/
+}
+
+/* Assemble for mask2 (R9M), ignore... */
+hmask2()	/* [vlh] */
+{
+	igrst();
+}
+
+/* Define register list */
+hreg()		/* [vlh] */
+{
+	int mask;
+	if(lbt[0]==0) {
+		xerr(4);		/*no label*/
+		return;
+	}
+	setname();					/*move label into main table*/
+	if((lblpt=lemt(sirt,FALSE))!=lmte) {
+		xerr(5);				/*opcode redefined*/
+		return;
+	}
+	if (inoffset)
+		if (reloc != ABS) {
+			xerr(11);
+			return;
+		}
+	mmte();						/*make main table entry*/
+	if ((mask = mkmask()) == -1) {
+		xerr(6);
+		return;
+	}
+	lblpt->flags =| SYDF|SYEQ|SYRM;	/* register mask, defined & equated */
+	lblpt->vl1 = mask;
+	igrst();
+}
+
+int regmsk[] {0100000,040000,020000,010000,04000,02000,01000,0400,0200,
+				0100,040,020,010,4,2,1};
+/* make a register mask for the reg routine */
+mkmask()	/* [vlh] */
+{
+	register int *p, i, j, mask;
+
+	p = &regmsk;	mask = 0;
+	while ((i = chkreg()) != -1) {
+		if (fchr == '-') {
+			fchr = gchr();
+			if ((j = chkreg()) == -1) {
+				xerr(40);
+				return(-1);
+			}
+			while (i <= j)
+				mask =| p[i++];
+		}
+		else mask =| p[i];
+		if (fchr != '/' && fchr != ',') break; /*[vlh] Signetics fix*/
+		fchr = gchr();
+	}
+	return(mask);
+}
+
+/* get a register # from file, return -1 if none or illegal */
+chkreg()	/* [vlh] */
+{
+	register int i, j;
+
+	i = j = 0;
+	if (fchr == 'a' || fchr == 'A')
+		i = 8;
+	else if (fchr != 'd' && fchr != 'r' && fchr != 'D' && fchr != 'R')
+		return(-1);
+	fchr = gchr();
+	do {
+		j = (j*10) + (fchr - '0');
+		fchr = gchr();
+	} while (isdigit(fchr));
+	if (j < 0 || j > AREGHI) return(-1);
+	i =+ j;
+	if (i >= 0 && i <= AREGHI) return(i);
+	else return(-1);
+}
+
+/* Define constant block */
+hdcb()		/* [vlh] */
+{
+	chkeven();	/* on even boundary if not byte block. */
+	dlabl();		/* define label... */
+	opitb();
+	opito();
+	stbuf[0].itrl = itwc;
+	numops = stbuf[ITOP1].itop;
+	loctr =+ numops * modelen;
+	wostb();		/* write out statement buffer */
+}
+
+/* Command line, similar to ds.b */
+hcomline()	/* [vlh] */
+{
+	dlabl();			/*define label maybe*/
+	modelen = 1;		/* byte store... */
+	opitb();			/*output it for beginning of statement*/
+	refpc = 0;
+	expr(&p1gi);
+	if(itype!=ITCN) {
+		xerr(17);		/*must be constant*/
+		return;
+	}
+	if(reloc != ABS)  {
+		xerr(9);		/*must be absolute*/
+		return;
+	}
+	opitoo();			/*output one operand*/
+	stbuf[0].itrl = itwc;
+	wostb();			/*write out statement buffer*/
+	loctr =+ ival;
+	igrst();
+}
+
+/* Relocateable id record, ignore */
+hidnt()	/* [vlh] */
+{
+	igrst();
+}
+
+/* Define offsets */
+hoffset()	/* [vlh] */
+{
+	inoffset = 1;
+	expr(&p1gi);	/* get new location counter */
+	if (itype != ITCN) {
+		xerr(17);	/* constant required */
+		return;
+	}
+	if (reloc != ABS) {
+		xerr(9);	/* must be absolute */
+		return;
+	}
+	loctr = ival;
+	igrst();
+}
+
+/* define sections: map to bss, text and data */
+hsection()	/* [vlh] */
+{
+	inoffset = 0;	/* reseting section turns off offset mode */
+	dlabl();		/* define label on old base if there is one */
+	savelc[rlflg] = loctr;	/* save old base relocation */
+	opitb();		/* intermediate table... */
+	expr(&p1gi);	/* get section # */
+	if (itype != ITCN) {
+		xerr(17);	/* must be a constant */
+		return;
+	}
+	if (ival > 15 || ival < 0) {
+		xerr(9);	/* proper range 0..15 */
+		return;
+	}
+	rlflg = (ival==14) ? DATA : (ival==15) ? BSS : TEXT;
+	loctr = savelc[rlflg];
+	stbuf[3].itop = loctr;		/* pass 1 location counter */
+	stbuf[3].itrl = rlflg;		/* relocation base */
+	stbuf[0].itrl = itwc;
+	wostb();
+	igrst();
+}
+
+/* hopt -- ignore, set up assembler options */
+hopt()	/* vlh */
+{
+	igrst();
+}
+
+/* hpage - page directive, ignore */
+hpage()		/* vlh */
+{
+	igrst();
+}
+
+/* httl - title directive, ignore */
+httl()	/* vlh */
+{
+	igrst();
+}
+
+/****	Second pass directive handling routines ****/
+
+/* second pass end statement*/
+send()
+{
+	register int i;
+
+	savelc[rlflg] = loctr;
+	if(savelc[TEXT]&1) {
+		rlflg = TEXT;
+		outbyte(0,DABS);
+	}
+	if(savelc[DATA]&1) {
+		rlflg = DATA;
+		outbyte(0,DABS);
+	}
+	ival = 0;
+	reloc = ABS;
+	ckeop(9);
+	print(0);
+	cpdata();			/*copy data to loader file*/
+	osymt();			/*output symbol table*/
+	myfflush(&tbuf);	/*flush text relocation bits*/
+	cprlbits();			/*copy relocation bits*/
+	myfflush(&lbuf);
+	i = (sizeof couthd.ch_magic) + 3*(sizeof couthd.ch_tsize);
+	if((seek(lfn,i,0) == -1) || write(lfn,&stlen,4) != 4)
+		rpterr("I/O error on loader output file\n");
+	endit();			/*end*/
+}
+
+/*second pass define storage - ds*/
+sds()
+{
+	print(0);
+	if(rlflg == TEXT || rlflg==DATA) {
+		expr(&p2gi);
+		if(itype != ITCN) {
+			uerr(13);
+			return;
+		}
+		ival =* modelen;
+		while(ival) {
+			outbyte(0,DABS);
+			loctr++;
+			ival--;
+		}
+	}
+	else
+		loctr =+ stbuf[ITOP1].itop*modelen;		/*reserve storage*/
+}
+
+/* second pass - define block storage, initialized */
+sdcb()	/* [vlh] */
+{
+	register int pfg, i, hflg, len;
+
+	expr(&p2gi);
+	if (itype != ITCN || reloc != ABS) {
+		uerr(13);	/* must be absolute constant */
+		return;
+	}
+	len = ival;
+	expr(&p2gi);
+	if (modelen==1 && (ival<-128 || ival>=256 || reloc != ABS)) {
+		uerr(20);
+		ival = 0;
+		reloc = ABS;
+	}
+	while (len--) {
+		if (modelen==1) {
+			if (!hflg) {
+				ins[i].hibyte = ival;
+				outbyte(ival.wd2,DABS);
+				hflg++;
+			}
+			else {
+				ins[i++].lobyte = ival;
+				outbyte(ival.wd2,DABS);
+				hflg=0;
+			}
+			goto sdbl2;
+		}
+		else if (modelen==2) {
+sdbl1:
+			ins[i++] = ival.wd2;
+			outword(ival.wd2, reloc);
+sdbl2:
+			if (i>3) {
+				instrlen = i*2;
+				print ((pfg++) ? 2 : 1);
+				loctr =+ instrlen;
+				i=0;
+			}
+		}
+		else {		/* long word... */
+			ins[i++] = ival.wd1;
+			outword(ival.wd1,LUPPER);
+			goto sdbl1;
+		}
+	}
+	if (i) {	/* more printing */
+		instrlen = i*2 - hflg;
+		print ((pfg) ? 2 : 1);
+		loctr =+ instrlen;
+	}
+}
+
+/*second pass data*/
+sdsect()
+{
+	savelc[rlflg] = loctr;
+	rlflg = DATA;
+	loctr = savelc[DATA];
+	print(0);			/*print the new location counter*/
+}
+
+/*second pass text*/
+spsect()
+{
+	savelc[rlflg] = loctr;
+	rlflg = TEXT;
+	loctr = savelc[TEXT];
+	print(0);			/*print the new location counter*/
+}
+
+sbss()
+{
+	savelc[rlflg] = loctr;
+	rlflg = BSS;
+	loctr = savelc[BSS];
+	print(0);			/*print the new location counter*/
+}
+
+/* make loctr even*/
+seven()
+{
+	if(loctr&1) {
+		if(rlflg==TEXT || rlflg==DATA)
+			outbyte(0,DABS);
+		loctr++;
+	}
+	print(0);
+}
+
+/* second pass org*/
+sorg()
+{
+	long l;
+
+	if(rlflg==TEXT || rlflg==DATA) {	/*must put out zeros*/
+		l = stbuf[ITOP1].itop - loctr;	/*# zeroes to output*/
+		ins[0] = 0;
+		print(1);
+		while(l > 0) {
+			outbyte(0,DABS);
+			loctr++;
+			l--;
+		}
+	}
+	else {	/*BSS*/
+		loctr = stbuf[ITOP1].itop;		/*new location counter*/
+		print(0);
+	}
+}
+
+/*
+ *second pass define data (words or bytes)
+ * call with
+ *	2 => defining words
+ *	1 => defining bytes
+ *	4 => defining long words
+ */
+sdata(dtyp)
+{
+	register pfg,i;
+	register hflg;
+
+	hflg = i = pfg = 0;
+	while(1) {
+		expr(&p2gi);			/*evaluate expression*/
+		if(pitw < pnite)
+			pitw--;		/*expr passed a token*/
+		if(itype!=ITCN && reloc != EXTRN) {	/*must be constant*/
+			uerr(13);
+			ival=0;
+			reloc = ABS;
+		}
+		if(reloc == EXTRN)
+			reloc = (extref<<3)|EXTVAR;	/*gen extern reference*/
+		if(dtyp==1) {			/*defining a byte*/
+			if(ival<-128 || ival>=256 || reloc!=ABS) {		/*not a byte*/
+				uerr(20);
+				ival=0;
+				reloc = ABS;
+			}
+			if(!hflg) {
+				ins[i].hibyte = ival;
+				outbyte(ival.wd2,DABS);
+				hflg++;
+			}
+			else {
+				ins[i++].lobyte = ival;
+				hflg = 0;
+				outbyte(ival.wd2,DABS);
+			}
+			goto sdal2;
+		}
+		else if(dtyp == 2) {	/*defining a word*/
+sdal1:
+			ins[i++] = ival.wd2;
+			outword(ival.wd2, reloc);
+sdal2:
+			if(i>3) {
+				instrlen = i*2;
+				print ((pfg++) ? 2 : 1);
+				loctr =+ instrlen;
+				i=0;
+			}
+		}
+		else {	/*long words*/
+			ins[i++] = ival.wd1;
+			outword(ival.wd1,LUPPER);
+			goto sdal1;
+		}
+		if(!ckeop(15))	/*should be end of operand*/
+			return;
+		pitw++;
+		if(ckein()) {
+			if(hflg) {
+				ins[i++].lobyte = 0;
+			}
+			if(i) {		/*more printing*/
+				instrlen = i*2 - hflg;
+				print ((pfg) ? 2 : 1);
+				loctr =+ instrlen;
+			}
+			return;
+		}
+	}
+}
+
+sdc()
+{
+	sdata(modelen);
+}
+
+ssection()	/* [vlh] */
+{
+	int sect;
+
+	sect = stbuf[3].itrl;
+	if (sect==DATA) sdsect();
+	else if (sect==BSS) sbss();
+	else spsect();
+}
+
+/*define word statement*/
+sdw()
+{
+	sdata(0);	/*defining words*/
+}
+/****	Conditional assembly directives ****/
+
+hifeq()	/* [vlh] */
+{
+	if (!acok()) return;
+	if (ival) {
+		if (ca_true) ca_level = ca;
+		ca_true = 0;
+	}
+	ca++;
+}
+
+hifne()	/* [vlh] */
+{
+	if (!acok()) return;
+	if (!ival) {
+		if (ca_true) ca_level = ca;
+		ca_true = 0;
+	}
+	ca++;
+}
+
+hiflt()	/* [vlh] */
+{
+	if (!acok()) return;
+	if (ival >= 0) {
+		if (ca_true) ca_level = ca;
+		ca_true = 0;
+	}
+	ca++;
+}
+
+hifle()	/* [vlh] */
+{
+	if (!acok()) return;
+	if (ival > 0) {
+		if (ca_true) ca_level = ca;
+		ca_true = 0;
+	}
+	ca++;
+}
+
+hifgt()	/* [vlh] */
+{
+	if (!acok()) return;
+	if (ival <= 0) {
+		if (ca_true) ca_level = ca;
+		ca_true = 0;
+	}
+	ca++;
+}
+
+hifge()	/* [vlh] */
+{
+	if (!acok()) return;
+	if (ival < 0) {
+		if (ca_true) ca_level = ca;
+		ca_true = 0;
+	}
+	ca++;
+}
+
+hifc()	/* [vlh] */
+{
+	if (!cmp_ops()) {
+		if (ca_true) ca_level = ca;
+		ca_true = 0;
+	}
+	ca++;
+}
+
+hifnc()	/* [vlh] */
+{
+	if (cmp_ops()) {
+		if (ca_true) ca_level = ca;
+		ca_true = 0;
+	}
+	ca++;
+}
+
+hendc()	/* [vlh] */
+{
+	if (!ca) {
+		xerr(25);	/* unexpected endc */
+		return;
+	}
+	ca--;
+	if (!ca_true)
+		if (ca_level == ca) ca_true = 1;
+	igrst();
+}
+
+acok()
+{
+	expr(&p1gi);
+	if (itype != ITCN) {
+		xerr(7);	/* must be a constant */
+		return(0);
+	}
+	if (reloc != ABS) {
+		xerr(11);	/* must be absolute, no forward references */
+		return(0);
+	}
+	igrst();
+	return(1);
+}
+
+cmp_ops()
+{
+	char str1[25], str2[25];
+	register int len1, len2;
+
+	if (fchr != '\'') { xerr(9); return(0); }
+	len1 = len2 = 0;
+	while (fchr = gchr()) {
+		if (fchr == '\'') break;
+		if (fchr == EOLC) return(0);
+		str1[len1++] = fchr;
+	}
+	if ((fchr=gchr()) != ',') {	xerr(9); return; }
+	if ((fchr=gchr()) != '\'') { xerr(10); return;}
+	while (fchr = gchr()) {
+		if (fchr == '\'') break;
+		if (fchr == EOLC) return(0);
+		str2[len2++] = fchr;
+	}
+	igrst();
+	if (len1 != len2) return(0);
+	str1[len1] = str2[len2] = NULL;
+	if (strcmp(str1,str2) == 0) return(1);
+	return(0);
+}
+
+strcmp(s,t)
+char *s, *t;
+{
+	for( ; *s == *t; s++, t++ )
+		if( *s == '\0' )
+			return(0);
+	return( *s - *t );
+}

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/expr.c

@@ -0,0 +1,505 @@
+/*
+	Copyright 1981
+	Alcyon Corporation
+	8716 Production Ave.
+	San Diego, Ca.  92121
+*/
+
+/* Expression evaluator */
+
+# include "as68.h"
+
+/*precedence of operators*/
+# define PAO	2		/*AND, OR*/
+# define PPM	2		/*+ -*/
+# define PMD	3		/** /*/
+# define PLP	1		/* (*/
+# define PRP	4		/* )*/
+# define PEE	0		/* all other special chars*/
+
+#define OPSTLEN 10
+#define TREELEN 20
+
+/*global integers for this package*/
+struct it	exitm;		/*expression item*/
+int	prcnt;		/*paren count*/
+int	rval;		/*relocation value*/
+int lpflg;
+int lastopr;	/*last token was operator when set*/
+
+long gval();	/*get operand value*/
+
+/*
+ * expression evaluator
+ *	call with:
+ *		address of function to get input
+ *	returns:
+ *		item type in itype
+ *		item value in ival
+ *		relocation flag in reloc:
+ *			0 => absolute
+ *			1 => data
+ *			2 => text
+ *			3 => bss
+ *			4 => external
+ *
+ * The only expressions involving externals which are legal are
+ *		external+constant or external-constant
+ */
+
+struct it *piop, *pitr;
+int iop, itr;
+
+struct it opstk[OPSTLEN];	/*operator stack*/
+struct it tree[TREELEN];		/*operand stack*/
+
+expr(iploc)
+int (*iploc)();
+{
+	register int i, ipr;
+
+	extflg = starmul = iop = lpflg = 0;
+	piop = &opstk[0];
+	itr = -1;		/*tree stack pointer*/
+	pitr = &tree[0];
+	pitr--;
+/* form end of expression operator*/
+	opstk[0].itty = ITSP;	/*special character*/
+	opstk[0].itop = '?';
+	lastopr = 1;
+
+/* get an input item*/
+	while(1) {
+		if(itr >= TREELEN-2) {
+			rpterr("expr tree overflow\n");
+			abort();
+		}
+		if(iop >= OPSTLEN-1) {
+			rpterr("expr opstk overflow\n");
+			abort();
+		}
+		(*iploc)();		/*get an input term*/
+		if (itype==ITPC) return;
+		starmul=0;		/* * is location counter*/
+
+/* special character*/
+		if(itype==ITSP) {
+			ipr = gprc(i=ival.wd2);	/*get precedence of character*/
+			if(ipr==PEE)			/*end of expression*/
+				break;
+			lastopr = 1;
+			if(ipr==PLP) {		/*left paren*/
+				lpflg++;
+				prcnt++;
+				iop++;			/*up stack pointer*/
+				piop++;
+				piop->swd1=exitm.swd1;	/*put operator on stack*/
+				piop->itop=exitm.itop;
+				continue;
+			}
+			if(ipr==PRP) {		/*right paren*/
+				if(lpflg) { exerr(1); return; }
+				starmul = 1;	/* * is multiply*/
+				prcnt--;		/*down one level*/
+
+				while (piop->itop != '(') {	/* top stk is '(' */
+					itr++;			/*up tree pointer*/
+					pitr++;
+					pitr->swd1 = piop->swd1;	/*move operator*/
+					pitr->itop = piop->itop;
+					iop--;			/*reduce operand stack*/
+					piop--;
+				}
+				iop--;		/*remove stack*/
+				piop--;
+				continue;
+			}
+
+			while(ipr<=gprc(i=piop->itop.wd2)) { /* >= precedence */
+				itr++;
+				pitr++;
+				pitr->swd1 = piop->swd1;	/*move operator*/
+				pitr->itop = piop->itop;
+				iop--;			/*reduce operand stack*/
+				piop--;
+			}
+			iop++;			/*up operator stack*/
+			piop++;
+			piop->swd1 = exitm.swd1;	/*put in operator stack*/
+			piop->itop = exitm.itop;
+			continue;
+		}
+
+/* symbol or constant*/
+		else {
+			lastopr = lpflg = 0;		/*clear flag*/
+			itr++;		/*up tree pointer*/
+			pitr++;
+			pitr->swd1 = exitm.swd1;	/*put in tree*/
+			pitr->itop = exitm.itop;
+			starmul = 1;		/* * is multiply*/
+			continue;
+		}
+	}	/* end while(1)... */
+
+/*output the rest of the operator stack to the tree*/
+	for(i=iop; i>=0; i--) {
+		itr++;
+		pitr++;
+		pitr->swd1 = piop->swd1;	/*move operator*/
+		pitr->itop = piop->itop;
+		piop--;
+	}
+
+	collapse();
+}
+
+/* collapse the tree into one entry*/
+collapse()
+{
+	register int rv1, rv2, topr, i, bos;
+	register long tv1, tv2;
+
+	bos = 0;
+exct1:
+	if(itr>=3) {
+		piop = &tree[bos];
+		iop = bos;
+		while (iop<=(itr-3+bos) && (piop->itty==ITSP ||
+				(piop+1)->itty==ITSP || (piop+2)->itty!=ITSP)) {
+			iop++;
+			piop++;
+		}
+		if (iop<=(itr-3+bos)) {
+			tv1 = gval(piop);		/*get value of first operand*/
+			rv1 = rval;				/*relocation value*/
+			tv2 = gval(piop+1);
+			rv2 = rval;
+			topr = (piop+2)->itop;	/*operator*/
+	
+	/* handle operators */
+			if (topr == '+') {
+				tv1=+ tv2;
+				rv1 = ckrl1(rv1,rv2);	/*relocation*/
+			}
+			else if (topr == '-') {
+				tv1 =- tv2;
+				rv1 = ckrl2(rv1,rv2);	/*relocation*/
+			}
+			else {
+				switch(topr) {	/*operator*/
+					case '/':	/* division */
+						tv1 =/ tv2; break;
+					case '*':	/* multiplication */
+						tv1 =* tv2; break;
+					case '&':	/* logical and */
+						tv1 =& tv2; break;
+					case '!':	/* logical or */
+						tv1 =| tv2; break;
+					case '<':	/* left shift */
+						tv1 =<< tv2.wd2; break;
+					case '>':	/* right shift */
+						tv1 =>> tv2.wd2; break;
+					default:	/*invalid operator*/
+						exerr(2); return;
+				}
+				rv1 = ckrl3(rv1,rv2);	/* relocation */
+			}
+	
+	/*put new value in tree*/
+			if (iop==bos) {
+				bos =+ 2;
+				iop = bos;
+			}
+			piop = &tree[iop];
+			piop->itty = ITCN;		/*must be constant*/
+			piop->itop = tv1;		/*value*/
+			piop->itrl = rv1;		/*relocation value*/
+	
+			if (iop != bos) {	/* push up the rest of the tree... */
+				i = iop + 2 - bos;
+				pitr = piop+2;
+				for(; i<itr; i++) {
+					piop++;
+					pitr++;
+					piop->swd1 = pitr->swd1;
+					piop->itop = pitr->itop;
+				}
+			}
+			itr =- 2;
+			goto exct1;
+		}
+	}
+
+/* check for unary minus and unary plus*/
+	if (tree[bos+1].itty!=ITSP && tree[bos].itop.wd2=='?')
+		{ exerr(3); return; }
+	if (tree[bos+1].itty!=ITSP || tree[bos].itty==ITSP) {
+		reloc = ABS;
+		ival = 0;
+		itype = ITCN;
+		return;
+	}
+
+	if(tree[bos+1].itop.wd2!='?') {		/*end of statement*/
+		if(tree[bos+1].itop.wd2!='+') {	/*ignore unary plus*/
+			if(tree[bos+1].itop.wd2!='-') {	/* invalid operator */
+				exerr(4);
+				return;
+			}
+			tree[bos+1].itop = -gval(&tree[bos]);
+			tree[bos+1].itty = ITCN;
+			tree[bos+1].itrl = tree[bos].itrl;
+			bos++;
+			itr--;
+			goto exct1;
+		}
+	}
+/* send results back to caller*/
+	if ((itype = tree[bos].itty)==ITCN)
+		ival = gval(&tree[bos]);
+	else {
+		ival = tree[bos].itop;
+		if(itype==ITSY && !(ival.ptrw2->flags&SYDF)) {	/*undef symbol*/
+			reloc = ABS;
+			ival = 0;
+			itype = ITCN;
+			return;
+		}
+	}
+	get_val(tree[bos].itrl);
+}
+
+/*
+ *if defined symbol get value and say constant
+ * except for externals and equated registers
+ */
+get_val(reloc_val)
+int reloc_val;
+{
+	if(itype==ITSY && (ival.ptrw2->flags&(SYXR|SYER))==0) {
+		if(ival.ptrw2->flags&SYRA)	/*get symbol relocation factor*/
+			reloc = DATA;
+		else if(ival.ptrw2->flags&SYRO)
+			reloc = TEXT;
+		else if(ival.ptrw2->flags&SYBS)
+			reloc = BSS;
+		else reloc = ABS;
+		ival = ival.ptrw2->vl1;		/*symbol vaue*/
+		itype = ITCN;				/*constant*/
+	}
+	else
+		if(itype == ITSY && ival.ptrw2->flags&SYXR) {	/*external symbol*/
+			fixext(ival.ptrw2);
+			reloc = EXTRN;
+		}
+		else
+			reloc = reloc_val;		/*relocation value of item*/
+}
+
+exerr(n)	/* [vlh] */
+int n;
+{
+	uerr(6);
+	ival = 0;
+	itype = ITCN;
+	reloc = ABS;
+}
+
+/*
+ * get precedence of a operator
+ *	call with
+ *		operator
+ *	returns
+ *		precedence
+ */
+gprc(dprc)
+{
+
+	switch(dprc) {
+
+		case '+':
+		case '-':
+		case '&':		/* and*/
+		case '!':		/* or*/
+		case '^':		/*exclusive or*/
+			return(PPM);
+
+		case '/':
+		case '*':
+		case '<':		/*left shift*/
+		case '>':		/*right shift*/
+			return(PMD);
+
+		case '(':
+			if(lastopr)
+				return(PLP);
+			break;
+
+		case ')':
+			if(!prcnt)	/*no left parens*/
+				break;
+			return(PRP);
+
+	}
+	return(PEE);	/*end of expression*/
+}
+
+/*
+ * get value from an it format item
+ *	call with
+ *		address of it format item
+ *	returns
+ *		the value
+ *		relocation value in rval
+ *	calls uerr if it cant get a value
+ */
+long gval(avwrd)
+struct it *avwrd;
+{
+	register struct it *vwrd;
+	register struct symtab *p;
+
+	vwrd = avwrd;
+	if(vwrd->itty == ITCN) {	/*constant*/
+		rval = vwrd->itrl;
+		return(vwrd->itop);			/*value*/
+	}
+	if(vwrd->itty != ITSY) {
+		uerr(6);
+		rval = ABS;
+		return(0);
+	}
+	p = vwrd->itop.ptrw2;
+	if(p->flags&SYXR) {		/*external reference*/
+		fixext(p);
+		return(0);
+	}
+	if((p->flags&SYDF) != SYDF || (p->flags&SYER)) {
+		uerr(6);
+		rval = ABS;
+		return(0);
+	}
+	rval = (p->flags&SYRA) ? DATA : (p->flags&SYRO) 	/* reloc of item */
+				? TEXT : (p->flags&SYBS) ? BSS : ABS;
+	return(p->vl1);
+}
+
+/*
+ * get items for expression evaluator (pass one)
+ *	returns:
+ *		item type in itype
+ *		item value in ival
+ *		item in it format in exitm
+ */
+p1gi()
+{
+	if(fcflg)		/*used item so must pass it*/
+		gterm(TRUE);
+	if(!fcflg && ckspc(fchr)==1) {
+		fcflg=1;	/*just pass first character*/
+		itype=ITSP;	/*special char*/
+		ival=fchr;	/*value is the char*/
+	}
+	else {	/*get a whole term*/
+		fcflg = 0;
+		gterm(TRUE);		/*get a term*/
+		if(itype==ITSY) {	/* got a symbol*/
+			ival.ptrw2=lemt(sirt,FALSE);	/*look it up in main table*/
+			if(ival.ptrw2==lmte)	/*not there before*/
+				mmte();		/*put it in table*/
+		}
+		else
+			if(itype == ITCN)
+				exitm.itrl = reloc;
+	}
+	exitm.itty = itype;
+	exitm.itop = ival;
+}
+
+/*
+ * get items for expression evaluator (pass 2)
+ * returns:
+ *		item type in itype
+ *		item value in ival
+ *		item in it format in exitm
+ */
+p2gi()
+{
+	if(pitw==pnite) {	/*end of statement*/
+		itype = ITSP;
+		ival = ' ';		/*blank*/
+		exitm.itty = itype;
+		exitm.itop = ival;
+		return;
+	}
+
+	if((itype = pitw->itty) == ITPC) {	/*vlh*/
+		pitw->itop = loctr;
+		if (p2flg || format==6) itype = pitw->itty = ITCN;
+	}
+	ival  = pitw->itop;	/*value*/
+	exitm.swd1 = pitw->swd1;
+	exitm.itop = ival;
+	pitw++;
+}
+
+/*
+ *check for a special character
+ *	call with
+ *		character to check
+ *	returns:
+ *		0 => character is number or letter
+ */
+ckspc(acksc)
+{
+	register cksc;
+
+	cksc = acksc;
+	if (isalnum(cksc)) return(0);
+	return((index("_~*.@$%\'",cksc) != -1) ? 0 : 1);	/*[vlh] compacted*/
+}
+
+/* generate new relocation for op + op*/
+ckrl1(rv1,rv2)
+{
+	if(rv1==rv2)
+		return(rv1);
+	if(rv1==ABS || rv2==ABS)
+		return(rv1+rv2);	/*the one that is not ABS*/
+	uerr(27);
+	return(ABS);
+}
+
+/*generate new relocation for op - op*/
+ckrl2(rv1,rv2)
+{
+	if(rv2==EXTRN)
+		uerr(26);
+	if(rv1==rv2)
+		return(ABS);
+	if(rv2==ABS)
+		return(rv1+rv2);
+	uerr(27);
+	return(ABS);
+}
+
+/*generate new relocation for op /*&|<>^! op*/
+ckrl3(rv1,rv2)
+{
+	if(rv1!=ABS || rv2!=ABS)
+		uerr(27);
+	return(ABS);
+}
+
+fixext(p)
+struct symtab *p;
+{
+	if(extflg)
+		uerr(36);		/*two externals in expr*/
+	extflg++;
+	extref = p->vl1.wd2;	/*get external #*/
+	rval = EXTRN;
+	itype = ITCN;
+	ival = 0;
+}

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/mach.h

@@ -0,0 +1 @@
+#define PDP11 1

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/misc.c

@@ -0,0 +1,988 @@
+/*
+	Copyright 1981
+	Alcyon Corporation
+	8716 Production Ave.
+	San Diego, Ca.  92121
+*/
+
+/* pass 2 miscellaneous routines */
+
+#include "as68.h"
+int p2gi();
+
+long stlen;
+int stdofd 1;
+char tfilname[];
+int ins[], rlbits[], f2mode[];
+int udfct, ftudp, pline, prsp;
+
+clrea(ap)
+struct op *ap;
+{
+	register struct op *p;
+
+	p = ap;
+	p->ea = p->len = p->xmod = p->drlc = 0; p->con = 0;
+	p->ext = p->idx = -1;
+}
+
+/*
+ * get one operand effective adddress (operand until , or EOS)
+ * returns:
+ *	opnd[opn].ea set to effective address mode bits
+ *	opnd[opn].len set to # bytes for operand
+ *	opnd[opn].con set to constant part of ea
+ *	opnd[opn].ext set to external symbol # if any
+ *	opnd[opn].idx set to index register if any
+ *	opnd[opn].drlc set to effective address relocation mode
+ *	opnd[opn].xmod set to index register addressing mode (word or long)
+ */
+getea(opn)
+{
+	register i,disp;
+	register struct op *p;
+	register int t;
+
+	p = &opnd[opn];
+	disp = 0;
+	clrea(p);
+	if(ckitc(pitw,'#')) {
+		p->len = (modelen==1) ? 2 : modelen;
+		p->ea = IMM;
+		pitw++;
+		goto dosimp;
+	}
+	if(ckitc(pitw,'(')) {
+geteal1:
+		pitw++;
+		if((i=getrgs()) == PC) {	/*pc relative*/
+			p->ea = 072;			/*set mode & register bits*/
+			p->len = 2;
+		}
+		else {
+			if(i != -1)		/*last was some type of register*/
+				pitw--;		/*havent used it yet*/
+			if((i=getareg()) < 0) {	/*not a reg # next*/
+				if(disp || getreg()!=-1) {
+					uerr(14);	/*illegal index reg*/
+					return;
+				}
+				pitw--;
+				goto dosimp;		/*must be expression in ()*/
+			}
+			p->ea = i&7;				/*put in a reg #*/
+		}
+		if(ckitc(pitw,',')) {	/*must be index reg #*/
+			do_ireg(p,i);
+			return;
+		}
+		ckrparen();
+		if(i != PC) {
+			if(!disp && ckitc(pitw,'+')) {
+				pitw++;
+				p->ea =| INDINC;
+			}
+			else if(disp) {		/*indirect with displacement*/
+				p->ea =| INDDISP;
+				p->len = 2;
+			}
+			else 
+				p->ea =| INDIRECT;
+		}
+		ckeop(9+opn);
+		return;
+	}
+	if(ckitc(pitw,'-')) {	/*predecrement maybe*/
+		pitw++;
+		if(ckitc(pitw,'(')) {	/*must be*/
+			pitw++;
+			if((i = getareg()) < 0) {	/*not valid a reg*/
+				pitw =- 2;		/*must be negative expr*/
+				goto dosimp;
+			}
+			p->ea = i|DECIND;
+			ckrparen();
+			ckeop(9+opn);
+			return;
+		}
+		pitw--;
+	}
+dosimp:					/*simple addr or imm expr*/
+	if(i=gspreg()) {
+		t = ins[0];
+		if(i==PC || (i==USP && t!=MOVE))
+			uerr(20);
+		if(i==SR || i==CCR) {
+			if(t!=AND&&t!=OR&&t!=EOR&&t!=ANDI&&t!=ORI&&t!=EORI&&t!=MOVE)
+					uerr(20);
+		}
+		p->idx = i;
+		ckeop(9+opn);
+		return;
+	}
+	if((i=getreg()) >= 0) {	/*register direct*/
+		p->ea = i;
+		if(modelen==1 && i>=AREGLO && i<=AREGHI)
+			uerr(20);
+		ckeop(9+opn);
+		return;
+	}
+	expr(&p2gi);
+	if(pitw < pnite)	/*expr passes one token*/
+		pitw--;
+	if(extflg) {
+		p->ext = extref;
+		extflg = 0;
+	}
+	p->con = ival;
+	p->drlc = reloc;		/*relocation factor*/
+	if(ckitc(pitw,'(')) {
+		disp++;
+		goto geteal1;
+	}
+	if(!p->ea) {	/*memory  address*/
+		if(shortadr && (!ival.wd1 || ival.wd1== -1)) { /*16-bit addrs*/
+			p->ea = SADDR;
+			p->len = 2;
+		}
+		else {
+			p->ea = LADDR;
+			p->len = 4;
+		}
+	}
+	ckeop(9+opn);
+}
+
+do_ireg(p,i,opn)
+struct op *p;
+int i, opn;
+{
+	pitw++;
+	p->idx = getreg();
+	if(p->idx<0 || p->idx>AREGHI)
+		uerr(14);
+	p->len = 2;
+	if(!ckitc(pitw,')')) {
+		p->xmod = getrgs() - 20;
+		if(p->xmod<0 || p->xmod>1) {
+			uerr(34);
+			p->xmod = 0;
+		}
+	}
+	ckrparen();
+	ckeop(9+opn);
+	if(i==PC)
+		p->ea =+ 1;
+	else
+		p->ea =| INDINX;
+}
+
+/*
+ * get an A register specification
+ *  call with:
+ *		pitw pointing to reg operand
+ *  returns:
+ *		-1 if not vaid A reg
+ *		A reg # if valid
+ *		also updates pitw if valid
+ */
+getareg()
+{
+	register i;
+
+	i = getreg();
+	if(i>=AREGLO && i<=AREGHI) {
+		return(i&7);
+	}
+	else {
+		if(i != -1)
+			pitw--;
+		return(-1);
+	}
+}
+
+/*
+ * get any register specification
+ *  call with :
+ *		pitw pointing at operand
+ *  returns:
+ *		register # with pitw updated
+ *		-1 if not valid register
+ */
+getreg()
+{
+	register i;
+
+	i = getrgs();
+	if(i>=0 && i<=AREGHI)
+		return(i);
+	else {
+		if(i != -1)
+			pitw--;
+		return(-1);
+	}
+}
+
+/*get any register specification*/
+getrgs()
+{
+	register char *i;
+
+	if(pitw->itty == ITSY) {
+		i = pitw->itop.ptrw2;		/*symbol ptr*/
+		if(i->flags&SYER) {
+			pitw++;
+			return(i->vl1.wd2);		/*register #*/
+		}
+	}
+	return(-1);
+}
+
+/* check for a right paren as the next char*/
+/*  output error msg if not found*/
+ckrparen()
+{
+	if(ckitc(pitw,')'))	/*found it*/
+		pitw++;
+	else
+		uerr(32);
+}
+
+/*
+ * check intermedate text item for special character
+ *	call with:
+ *		pointer to desired item in stbuf
+ *		character to check for
+ *	returns:
+ *		0 => no match
+ *		1 => match
+ */
+ckitc(ckpt,cksc)
+char *ckpt;
+{
+	if(ckpt >= pnite || ckpt->itty != ITSP || ckpt->itop.wd2 != cksc)
+		return(0);
+	return(1);
+}
+
+/*
+ * read intermediate text for one statement
+ * returns:
+ *	intermediate text in stbuf
+ */
+ristb()
+{
+	register riix;
+	register int *pi;
+	register int i;
+
+	do {
+		riix = stbuf[0].itrl;
+		itoffset =+ (riix&0377) * STBFSIZE;
+		pi = &stbuf[0];
+		for(i=0; i<(STBFSIZE)/(sizeof *pi); i++) {
+			if(pitix > &itbuf[ITBSZ-1]) {	/*need new buffer of it*/
+				doitrd();		/*read it buffer*/
+			}
+			*pi++ = *pitix++;		/*first word of it*/
+		}
+		if(stbuf[0].itty != ITBS)	/*best be beginning of statement */
+			abort();
+
+/* get the rest of the statement it*/
+		riix = stbuf[0].itrl & 0377;	/*unsigned byte*/
+		riix--;					/*already got first entry*/
+		while(riix--) {
+			for(i=0; i<(STBFSIZE)/(sizeof *pi); i++) {
+				if(pitix > &itbuf[ITBSZ-1]) {	/*need new buffer of it*/
+					doitrd();
+				}
+				*pi++ = *pitix++;
+			}
+		}
+	} while(stbuf[1].itrl == -1);	/* eliminated instr, read next one */
+}
+
+int errno;
+
+doitrd()
+{
+	register int i;
+
+	pitix = itbuf;
+	if((i=read(itfn,itbuf,ITBSZ*(sizeof i)))<=0) {
+		putchar(0);
+		stdofd = 2;
+		printf("it read error i=%d errno=%o\n",
+			i,errno);
+		putchar(0);
+		abort();
+	}
+}
+
+/*
+ * check for end of operand
+ * call with
+ *		error number if this is not end of operand
+ */
+ckeop(uen)
+{
+	if(pitw>=pnite)	/*end of all operands*/
+		return(1);
+	if(!ckitc(pitw,',')) {		/*not end of stmt must be op,op*/
+		uerr(uen);
+		return(0);
+	}
+	return(1);
+}
+
+/* output symbol table to file*/
+osymt()
+{
+	register char **sx1;
+	register char *p;
+	register i;
+
+	stlen = 0;
+	if(extindx) {				/*output external symbols first*/
+		if(prtflg)
+			printf("\n\n-EXTERNAL SYMBOLS-\n");
+		sx1 = extbl;
+		for(i=0;i<extindx;i++)	/*go through external table*/
+			osyme(*sx1++);			/*output symbol*/
+	}
+	if(prtflg)
+		printf("\n\n");
+
+	for(p=bmte; p<lmte; p=+ STESIZE) {	/*want them in order defined*/
+		if(p->flags&(SYXR|SYIN))
+			continue;
+		osyme(p);
+	}
+}
+
+/* make all undefined symbols external*/
+fixunds()
+{
+	register char **sx1, **sx2;
+
+/* loop thru symbol initial reference table*/
+	for(sx1= sirt; sx1<&sirt[SZIRT-1]; sx1 =+ 2) {
+		if(*(sx2 = sx1+1)==0)		/* this chain is empty*/
+			continue;
+
+/* symbols on one chain*/
+		sx2 = *sx2;	/*first entry on this chain*/
+		while(1) {
+			if(!(sx2->flags&SYDF)) {	/*not defined*/
+				if(undflg || sx2->flags&SYGL) { /*all or globals*/
+					sx2->flags = sx2->flags|SYDF|SYXR;
+					mkextidx(sx2);
+				}
+			}
+			if(sx2 == *sx1)	/*end of chain*/
+				break;
+			sx2 = sx2->tlnk;	/*next entry in chain*/
+		}
+	}
+}
+
+/*
+ * output symbols in a form to be read by a debugger
+ * call with pointer to symbol table entry
+ * prints all undefined symbols
+ */
+osyme(aosypt)
+struct symtab *aosypt;
+{
+	register struct symtab *osypt;
+	register char *p1;
+	register int i;
+#ifdef VAX11
+	register short *ps1;
+#else
+	register int *ps1;
+#endif
+
+	osypt = aosypt;		/*pointer to symbol table entry*/
+	if(!prtflg && !(osypt->flags&SYDF)) {	/*undefined symbol*/
+		pudfs(osypt);				/*print undefined*/
+		return;
+	}
+
+	p1 = &(osypt->name[0]);
+	if(prtflg && !((osypt->flags)&SYER)) {	/*put symbol on listing*/
+		if(osypt->flags&SYXR)	/*external symbol*/
+			printf("%s\n",p1);		/*just print name*/
+		else if (osypt->flags&SYDF) {
+			printf("%s\t",p1);
+			puthex(osypt->vl1.wd1,4);
+			puthex(osypt->vl1.wd2,4);
+			if(osypt->flags&SYRA)	/*print relocation factor*/
+				printf("\tDATA\n");
+			else if(osypt->flags&SYRO)
+				printf("\tTEXT\n");
+			else if(osypt->flags&SYBS)
+				printf("\tBSS\n");
+			else printf("\tABS\n");
+		}
+		else {	/*undefined*/
+			nerror++;
+			printf("%s\t*UNDEFINED*\n",p1);
+		}
+	}
+
+	stlen =+ 14;	/*one more symbol out*/
+
+/*output symbol to loader file*/
+	ps1 = &(osypt->name[0]);
+	for(i=0; i<NAMELEN/2; i++) {		/*output symbol name*/
+		putw(*ps1++,&lbuf);
+	}
+
+	putw(osypt->flags,&lbuf);		/* output symbol flags */
+	if(osypt->flags&SYXR) {		/*external symbol*/
+		putw(0,&lbuf);
+		putw(osypt->vl1.wd1,&lbuf);
+	}
+	else {
+		putw(osypt->vl1.wd1,&lbuf);	/*upper half symbol value*/
+		putw(osypt->vl1.wd2,&lbuf);		/*lower symbol value*/
+	}
+}
+
+/*
+ * print undefined symbols
+ * call with
+ *	pointer to undefined symbol
+ */
+pudfs(udspt)
+struct symtab *udspt;
+{
+	nerror++;
+	if(!ftudp) {		/*first time thru*/
+		printf("\n&& UNDEFINED SYMBOLS &&\n");
+		ftudp++;
+		udfct=0;		/*no symbols on this line*/
+	}
+
+	printf("%8s  ",&(udspt->name[0]));
+	if(udfct++ > 6) {
+		printf("\n");
+		udfct=0;
+	}
+}
+
+/*
+ * output source and object listing
+ *	call with
+ *		2 => print address and binary code only
+ *		1 => object in ins[] and instr type in format
+ *		0 => print address only
+ */
+print(pflag)
+{
+	register i,j;
+	register int *pi;
+
+	if( !prtflg ) return;		/*no printing desired*/
+	if(fchr==EOF)	return;		/*end of source file*/
+
+	i = instrlen; instrlen = 1;		/*to print preceeding lines*/
+	while(pline<p2absln) {		/*need to print some lines*/
+		printf("%4d ",pline);			/*put source line num on listing*/
+		printf("                        ");			/*align the source*/
+		prtline(1);
+		putchar('\n');
+		fchr=gchr();
+		if(fchr==EOF) return;
+		pline++;
+	}
+	instrlen = i;
+
+/* output current address, binary, and source*/
+	printf("%4d ",p2absln);			/*put source line num on listing*/
+	puthex(loctr.wd1,4);
+	puthex(loctr.wd2,4);
+	putchar(' ');
+	if(!pflag) {			/*no binary*/
+		printf("                   ");	/*blanks instead*/
+	}
+	else {
+		pi = ins;
+		for(i=0; i<instrlen/2; i++) {	/* binary*/
+			puthex(*pi++,4);
+		}
+		if(instrlen&1)
+			puthex(*pi,2);
+		putchar(' ');
+		for(;i<4;i++) {				/*four bytes max per line*/
+			printf("    ");		/*align the source*/
+		}
+	}
+	if(pline>p2absln || pflag==2) {
+		putchar('\n');			/*end of line*/
+	}
+	else {
+		prtline(0);
+		if(fchr==EOF) return;
+		putchar('\n');
+		fchr=gchr();
+		pline++;
+	}
+}
+
+/*print one line aligning source output*/
+prtline(flg)
+{
+	register i;
+	register col, blcnt;
+
+	if(fchr=='*' || flg) {	/*comment*/
+		while(fchr!=EOLC && fchr!=EOF) {
+			putchar(fchr);
+			fchr = gchr();
+		}
+		return;
+	}
+	col = 1;
+	blcnt = 0;
+	while(1) {
+		if(fchr==EOLC || fchr==EOF)
+			return;
+		if(fchr==' '&& blcnt<3) {
+			i= (++blcnt == 3) ? 017 : 7;
+			while(col&i) {
+				putchar(' ');
+				col++;
+			}
+			while(fchr==' ')
+				fchr=gchr();
+			if(fchr==EOLC || fchr==EOF)
+				return;
+		}
+		putchar(fchr);
+		fchr=gchr();
+		col++;
+	}
+}
+
+/* buffered putchar routine*/
+putchar(c)
+char c;
+{
+	register int i;
+
+	*prtchidx++ = c;
+	if(!c || prtchidx>=&prtchars[PRTCHLEN]) {
+		i = prtchidx - prtchars;
+		write(stdofd,prtchars,i);
+		prtchidx = prtchars;
+	}
+}
+
+int hibytflg[4], hibytw[4];
+
+outbyte(bv,br)
+{
+	if (rlflg == BSS) {		/* [vlh] */
+		uerr(39);
+		return;
+	}
+	if(hibytflg[rlflg]) {
+		outword(hibytw[rlflg]|(bv&0xff),br);
+		hibytflg[rlflg] = 0;
+	}
+	else {
+		hibytw[rlflg] = bv<<8;
+		hibytflg[rlflg]++;
+	}
+}
+
+outword(val,rb)
+{
+	switch(rlflg) {
+
+		case TEXT:
+			putw(val,&lbuf);
+			putw(rb,&tbuf);
+			break;
+
+		case DATA:
+			putw(val,&dabuf);
+			putw(rb,&drbuf);
+			break;
+
+		case BSS:
+			uerr(39);
+			break;
+
+		default:
+			rpterr("& outword: bad rlflg\n");
+			abort();
+	}
+}
+
+outinstr()
+{
+	register i;
+	register int *p1, *p2;
+
+	i = instrlen>>1;
+	p1 = ins;
+	p2 = rlbits;
+	while(i--) {
+		outword(*p1++, *p2++);
+	}
+}
+
+/* copy data bits from temporary file to loader file*/
+cpdata()
+{
+	myfflush(&lbuf);
+	myfflush(&dabuf);
+	docp(dafn,dafnc);
+}
+
+/* copy text then data relocation bits from temporary file to loader file*/
+cprlbits()
+{
+	myfflush(&lbuf);
+	myfflush(&drbuf);
+	docp(trbfn, trbfnc);
+	docp(drbfn, drbfnc);
+}
+
+/*
+ * copy one of the temporary files to the loader file
+ * call with:
+ *	file descriptor of the temporary file
+ *	last char of the temporary file name
+ */
+docp(cfn,cfnc)
+{
+	register i;
+
+	close(cfn);
+	LASTCHTFN = cfnc;
+	cfn = openfi(tfilname,0);
+	while((i=read(cfn,itbuf,512)) > 0) {
+		if(write(lfn,itbuf,i) != i) {
+			rpterr("& file write error\n");
+			abort();
+		}
+	}
+}
+
+/* print one word in hex*/
+puthex(v,l)
+{
+	register i,j,k;
+
+	j = 12;
+	for(i=0; i<l; i++) {
+		k = (v>>j)&017;
+		k =+ (k >= 10) ? ('A'-10) : '0';
+		putchar(k);
+		j =- 4;
+	}
+}
+
+/* check for a control operand*/
+controlea(ap)
+struct op *ap;
+{
+	register i;
+
+	i = ap->ea&070;
+	if(i==INDIRECT || i==INDDISP || i==INDINX)
+		return(1);
+	if(i==070) {
+		if((ap->ea&7) <= 3)
+			return(1);
+	}
+	return(0);
+}
+
+ckcomma()
+{
+	if(ckitc(pitw,',')) {		/*next token a comma*/
+		pitw++;
+		return(1);
+	}
+	return(0);
+}
+
+/*
+ * generate any necessary additional words for the effective address
+ *  call with:
+ *		pins pointing to next available word in ins[]
+ *		prlb pointing to next available word in rlbits[]
+ *		argument is ptr to op structure
+ *
+ * returns:
+ *		appropriate words in ins[] and rlbits[] for operand
+ *		pins and prlb updated.
+ */
+doea(apea)
+struct op *apea;
+{
+	register i,j;
+	register struct op *p;
+
+	p = apea;
+	switch((p->ea>>3)&7) {		/* ea mode bits*/
+
+	default:		/*no more words*/
+		return;
+
+	case 5:			/* d(An)*/
+		dodisp(p);
+		return;
+
+	case 6:			/* d(An,Ri)*/
+dindx:
+		if (p->con > 127L || p->con < -128L) {
+			uerr(35);
+		}
+		i = (p->con.wd2&0377) | (p->idx<<12) | (p->xmod<<11);
+		if(p->drlc != ABS)
+			uerr(27);
+		*pins++ = i;
+		*prlb++ = DABS;
+		instrlen =+ 2;
+		return;
+
+	case 7:		/*xxx.W, xxx.L, or #xxx*/
+		switch(p->ea&7) {
+
+		case 1:		/* xxx.L*/
+			doupper(p);
+			p->con.wd1 = 0;		/*clear for dodisp check*/
+
+		case 0:		/* xxx.W*/
+			dodisp(p);
+			return;
+
+		case 2:		/*d(PC)*/
+		case 3:		/*d(PC,Ri.X)*/
+			if(p->drlc != ABS) {
+				if(p->drlc != rlflg)	/*not same reloc base*/
+					uerr(27);
+				p->con =- (loctr+instrlen);
+				p->drlc = ABS;
+			}
+			if((p->ea&7) == 3)		/*d(PC,Ri.X)*/
+				goto dindx;
+			dodisp(p);
+			return;
+
+		case 4:		/* #xxx*/
+			chkimm(p);		/*check for valid length*/
+			if(modelen == 4) {		/*instr mode is long*/
+				doupper(p);
+				p->con.wd1 = 0;		/*clear for dodisp check*/
+			}
+			dodisp(p);
+			return;
+		}
+	}
+}
+
+dodisp(ap)
+struct op *ap;
+{
+	register struct op *p;
+
+	p = ap;
+	*pins++ = p->con.wd2;		/*displacement*/
+	if(p->con.wd1 && p->con.wd1 != -1)
+		uerr(41);		/*invalid 16-bit disp*/
+	*prlb++ = (p->ext != -1) ? (p->ext<<3)|EXTVAR : p->drlc;
+	instrlen =+ 2;
+}
+
+doupper(p)
+struct op *p;
+{
+	*pins++ = p->con.wd1;	/*upper half of long addr or constant*/
+	*prlb++ = LUPPER;
+	instrlen =+ 2;
+}
+
+/*
+ * build a format 1 (add, sub, and, etc) instr
+ * call with:
+ *	register #
+ *	mode bits
+ *	ptr to operand structure for effective address
+ */
+makef1(arreg, armode, apea)
+struct op *apea;
+{
+	register i,j;
+	register struct op *p;
+
+	p = apea;
+	ins[0] =| (arreg<<9);	/*put in reg #*/
+	ins[0] =| armode;	/*instr mode bits*/
+	ins[0] =| p->ea;		/*put in effective addr bits*/
+	doea(p);			/*may be more words in ea*/
+}
+
+/* generate an immediate instr*/
+genimm()
+{
+	ins[0] =| (f2mode[modelen] | opnd[1].ea);
+	if(modelen == 4) {
+		doupper(&opnd[0]);
+		opnd[0].con.wd1 = 0;	/*clear for dodisp check*/
+	}
+	chkimm(&opnd[0]);	/*check for valid immed length*/
+	dodisp(&opnd[0]);
+	doea(&opnd[1]);
+}
+
+chkimm(ap)
+struct op *ap;
+{
+	register struct op *p;
+
+	p=ap;
+	if(modelen == 2) {	/*word*/
+		if(p->con.wd1 && p->con.wd1!=-1)
+			uerr(42);
+	}
+	else if(modelen == 1) {	/*byte*/
+		if(p->con.wd1 && p->con.wd1!=-1)
+			uerr(43);
+		if(p->con.wd2>255 || p->con.wd2<=-256)
+			uerr(43);
+	}
+}
+
+/* try to make a normal instr into an immediate instr*/
+makeimm()
+{
+	if(opnd[0].ea != IMM)
+		return(0);
+	if(!dataalt(&opnd[1]))
+		return(0);
+	if(opcpt == addptr)
+		opcpt = addiptr;
+	else if(opcpt == andptr)
+		opcpt = andiptr;
+	else if(opcpt == orptr)
+		opcpt = oriptr;
+	else if(opcpt == subptr)
+		opcpt = subiptr;
+	else if(opcpt == cmpptr)
+		opcpt = cmpiptr;
+	else if(opcpt == eorptr)
+		opcpt = eoriptr;
+	else
+		return(0);
+	ins[0] = opcpt->vl1.wd2;
+	format = (opcpt->flags)&OPFF;
+	genimm();
+	return(1);
+}
+
+ckbytea()
+{
+	if(modelen==1 && !dataea(&opnd[0]))
+		uerr(20);	/*byte mod not allowed*/
+}
+
+/* get a special register token (CCR, SR, or USP)*/
+gspreg()
+{
+	register i;
+
+	i = getrgs();
+	if(i>AREGHI)
+		return(i);
+	if(i != -1)
+		pitw--;
+	return(0);
+}
+
+/*
+ * check an operand for a special register
+ * call with:
+ *  ptr to operand struct
+ *  special register value
+ */
+cksprg(ap,v1)
+struct op *ap;
+{
+	if(ap->ea)
+		return(0);
+	if(ap->idx == v1)
+		return(1);
+	return(0);
+}
+
+/* check for operand as any special register*/
+anysprg(ap)
+struct op *ap;
+{
+	if(ap->ea)
+		return(0);
+	if(ap->idx>=CCR && ap->idx<=USP)
+		return(1);
+	return(0);
+}
+
+/* copy opnd 0 to opnd 1*/
+cpop01()
+{
+	opnd[1].ea = opnd[0].ea;
+	opnd[1].len = opnd[0].len;
+	opnd[1].con = opnd[0].con;
+	opnd[1].drlc = opnd[0].drlc;
+	opnd[1].ext = opnd[0].ext;
+	opnd[1].idx = opnd[0].idx;
+	opnd[1].xmod = opnd[0].xmod;
+}
+
+cksize(ap)		/* [vlh] try to check displacement range */
+struct op *ap;
+{
+	long value;
+
+	if ((ap->ea&070) != 070) return;
+	value = (ap->con>0 && ap->con&0100000) ? -(ap->con&~0100000) : ap->con;
+	if (modelen == 1) {
+		if (value < -128L || value > 127L)	/* 8 bits */
+			uerr(35);
+	}
+	else if (modelen == 2)
+		if (value > 32767L || value < -32768L)	/* 16 bits */
+			uerr(41);
+}
+
+ccr_or_sr()		/* [vlh] */
+{
+	if(opnd[1].idx==CCR)
+		modelen = 1;		/*byte mode only*/
+	else	/* [vlh] SR */
+		if (modelen != 2) {
+			modelen = 2;
+			uerr(34);
+		}
+	cksize(&opnd[0]);
+	ins[0] =| IMM | f2mode[modelen];
+	dodisp(&opnd[0]);
+}
+
+get2ops()
+{
+	getea(0);		/*get first effective address*/
+	if(!ckcomma()) {
+		uerr(10);
+		return(1);		/*no second op*/
+	}
+	getea(1);		/*get second effective address*/
+	return(0);
+}

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/pass1a.c

@@ -0,0 +1,108 @@
+/*
+	Copyright 1981
+	Alcyon Corporation
+	8716 Production Ave.
+	San Diego, Ca.  92121
+*/
+
+/* reduce long relative branches to short if possible*/
+
+#include "as68.h"
+
+char tfilname[];
+int p2gi();
+
+pass1a()
+{
+	register long reduced;
+	register writfn;
+	register int i, wsize;
+
+	pitix = &itbuf[ITBSZ];
+	reduced = 0; itoffset = 0; stbuf[0].itrl = 0;
+	wsize = 3*STBFSIZE;		/* [vlh] don't calculate many times */
+	close(itfn);
+	LASTCHTFN = itfnc;
+	itfn = openfi(tfilname,0);	/*open it for reading*/
+	writfn = open(tfilname,1);	/*may need to rewrite some of it*/
+	if(writfn<0)
+		abort();
+	while(1) {
+		ristb();		/*read it for one statement*/
+		opcpt = stbuf[2].itop.ptrw2;	/*ptr to opcode entry in main tab*/
+		if(!(opcpt->flags&OPDR)) {	/*not a directive*/
+			format = (opcpt->flags)&OPFF;
+			p1inlen = stbuf[1].itrl;	/*pass 1 instr length guess*/
+			if(((format==6 && p1inlen==4) || opcpt==jsrptr) &&
+			  (rlflg=stbuf[3].itrl)==TEXT) {
+				nite = stbuf[0].itrl & 0377;/* # of it entries */
+				pnite = &stbuf[nite].itty;	/*ptr to end of stmt*/
+				modelen = stbuf[2].itrl;	/*instr mode length*/
+				opdix = ITOP1;				/*first operand*/
+				pitw = &stbuf[ITOP1].itty;	/*ptr to first operand*/
+				loctr = stbuf[3].itop - reduced;
+				expr(&p2gi);
+				ival =- loctr+2L;
+				if(itype==ITCN && !extflg && reloc!=ABS) {
+					if(format==9) {		/*jsr*/
+						i = (ival>= -128 && ival<=127) ? p1inlen-2 :
+							(ival>= -32768 && ival<=32767) ? p1inlen-4 : 0;
+						if (!i)
+							continue;
+						stbuf[2].itop.ptrw2 = bsrptr;	/*chng to bsr*/
+					}
+					else if(ival>= -128 && ival<=127) {
+						i = 2;		/*[vlh]was 4 for ival=2*/
+						if (!ival) stbuf[2].itop.ptrw2 = nopptr;
+					}
+					else
+						continue;
+					fixsyadr(i);
+					reduced =+ i;
+					stbuf[1].itrl =- i;		/*reduced somewhat*/
+					if(!stbuf[1].itrl)
+						stbuf[1].itrl = -1;	/*ignore flag*/
+					if(lseek(writfn,itoffset,0) == -1) {
+						rpterr("seek error on intermediate file\n");
+						abort();
+					}
+					if(write(writfn,&stbuf[0],wsize) != wsize) {
+						rpterr("write error on it file\n");
+						abort();
+					}
+				}
+			}
+		}
+		else if(opcpt == endptr) {
+			savelc[TEXT] =- reduced;
+			close(writfn);
+			return;
+		}
+	}
+}
+
+/* fix all symbol addresses that are text based and greater than loctr*/
+/*   fix means subtract 2 from them*/
+fixsyadr(al)
+{
+	register char **sx1, **sx2;
+	register l;
+
+	l = al;
+/* loop thru symbol initial reference table*/
+	for(sx1= sirt; sx1<&sirt[SZIRT-1]; sx1 =+ 2) {
+		if(*(sx2 = sx1+1)==0)		/* this chain is empty*/
+			continue;
+
+/* symbols on one chain*/
+		sx2 = *sx2;	/*first entry on this chain*/
+		while(1) {
+			if((sx2->flags&SYDF || sx2->flags&SYPC) && sx2->flags&SYRO &&
+			    sx2->vl1 > loctr)		/* [vlh] */
+				sx2->vl1 =- l;
+			if(sx2 == *sx1)	/*end of chain*/
+				break;
+			sx2 = sx2->tlnk;	/*next entry in chain*/
+		}
+	}
+}

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/pass2.c

@@ -0,0 +1,838 @@
+/*
+	Copyright 1981
+	Alcyon Corporation
+	8716 Production Ave.
+	San Diego, Ca.  92121
+*/
+
+/*
+ * pass two for the 68000 assembler
+ *		Bill Allen
+ *		March 1980
+ */
+
+#include "as68.h"
+#include "cout.h"	/*c.out header definition & MAGIC*/
+
+#define MOVEA 0100
+
+int p2gi();
+
+extern char tfilname[];	/*name of it file*/
+extern char initfnam[];	/*name of the initilization file*/
+int (*p2direct[])();
+
+int opf1(), opf2(), opf3(), opf4(), opf5(), relbr(), opf7(), opf8();
+int opf9(), opf11(), opf12(), opf13(), opf15(), opf17(), opf20();
+int opf21(), opf22(), opf23();
+
+int (*opfary[])() {
+	0,		/*0*/
+	opf1,	/*1*/
+	opf2,	/*2*/
+	opf3,	/*3*/
+	opf4,	/*4*/
+	opf5,	/*5*/
+	relbr,	/*6*/
+	opf7,	/*7*/
+	opf8,	/*8*/
+	opf9,	/*9*/
+	opf4,	/*10*/
+	opf11,	/*11*/
+	opf12,	/*12*/
+	opf13,	/*13*/
+	opf9,	/*14*/
+	opf15,	/*15*/
+	opf17,	/*16*/
+	opf17,	/*17*/
+	opf13,	/*18*/
+	opf11,	/*19*/
+	opf20,	/*20*/
+	opf21,	/*21*/
+	opf22,	/*22*/
+	opf23,	/*23*/
+	opf9,	/*24*/
+	opf9,	/*25*/
+	opf5,	/*26*/		/* [vlh] cmp, chk, extention verification */
+	opf4,	/*27*/		/* [vlh] addx, subx, extension verification */
+	opf13,	/*28*/		/* [vlh] swap, extension verification */
+	opf9,	/*29*/		/* [vlh] pea, extention verification */
+	opf15	/*30*/		/* [vlh] lea, extension verification */
+};
+
+#define LSTFRMT 30
+
+int f1mode[] {0,0,0100,0,0200};
+int f2mode[] {0,0,0100,0,0200};
+int f3mode[] {0,010000,030000,0,020000};
+int f15mode[] {0,0,0300,0,0700};
+int f5mode[] {0,0,0100,0,0200};
+int f5amode[] {0,0,0300,0,0700};
+int f13mode[] {0,0,0200,0,0300};
+int f23mode[] {0,0400,0500,0,0600};
+int rlbits[5];			/*holds relocation bits for instr*/
+int pline;				/*number of last printed line*/
+int brkln2 077777;		/*pass 2 break line number for debugging*/
+int prsp;				/*special print alignment flag*/
+int amode;				/*addressing mode*/
+
+/*pass two driver*/
+pass2()
+{
+#ifdef VAX11
+	register short *p;
+#else
+	register int *p;
+#endif
+	register i;
+	register (*dirop)();
+
+	pitix = &itbuf[ITBSZ];	/*it buffer is empty*/
+	lbuf.nunused = tbuf.nunused = dabuf.nunused = drbuf.nunused = 512;
+	lbuf.fildes = lfn;		/*set buffered io for binary file*/
+	lbuf.xfree = &lbuf.buff[0];
+	tbuf.fildes = trbfn;	/*set buffered io for text reloc bits file*/
+	tbuf.xfree = &tbuf.buff[0];
+	dabuf.fildes = dafn;	/*set buffered io for data bytes*/
+	dabuf.xfree = &dabuf.buff[0];
+	drbuf.fildes = drbfn;	/*set buffered io for data reloc bits*/
+	drbuf.xfree = &drbuf.buff[0];
+	couthd.ch_magic = MAGIC;/*c.out magic number*/
+	if(savelc[TEXT]&1)
+		savelc[TEXT]++;		/*make it even*/
+	couthd.ch_tsize = savelc[TEXT];	/*text size*/
+	if(savelc[DATA]&1)
+		savelc[DATA]++;		/*make it even*/
+	couthd.ch_dsize = savelc[DATA];	/*data size*/
+	couthd.ch_bsize = savelc[BSS];	/*bss size*/
+/*symbol table size is not known now -- it is set at end of pass 2*/
+/*  entry point and stack size are zero for now*/
+	p = &couthd;
+	for(i=0; i<HDSIZE/2; i++) {
+		putw(*p++,&lbuf);		/*write the file header words*/
+	}
+	savelc[0] = 0; savelc[1] = 0; savelc[2] = 0; savelc[3] = 0;
+	loctr = 0;		/*location counter*/
+	rlflg = TEXT;	/*TEXT relocatable*/
+	p2flg = 1;		/*pass two*/
+	if (lseek(ifn,0L,0) == -1)	{	/*beginning of source*/
+		rpterr("seek error on source file\n");
+		abort();
+	}
+	close(itfn);
+	LASTCHTFN = itfnc;
+	itfn = openfi(tfilname,0);	/*open it for reading*/
+	pline = 1;		/*no lines printed*/
+	fchr=gchr();	/*get first char*/
+	while(1) {		/*pass 2 main loop*/
+		ristb();	/*read it for one statement*/
+		p2absln = stbuf[0].itop;	/*line number*/
+		if(p2absln>=brkln2)		/*for debugging the assembler*/
+			i=0;
+		opcpt = stbuf[2].itop.ptrw2;	/*ptr to opcode entry in main tab*/
+		nite = stbuf[0].itrl & 0377;	/*number of it entries*/
+		pnite = &stbuf[nite].itty;	/*ptr to end of stmt*/
+		modelen = stbuf[2].itrl;	/*instr mode length*/
+		p1inlen = stbuf[1].itrl;	/*pass 1 instr length guess*/
+		opdix = ITOP1;				/*first operand*/
+		pitw = &stbuf[ITOP1].itty;	/*ptr to first operand*/
+		prsp = 0;				/*special print flag off*/
+		instrlen = 2;			/*default for print*/
+		if(opcpt->flags&OPDR) {	/*opcode is a directive*/
+			i = opcpt->vl1;	/*directive number*/
+			dirop = p2direct[i];
+			(*dirop)();			/*handle directive*/
+		}
+		else {
+			gcist();			/*generate code for one statement*/
+		}
+	}
+}
+
+/* generate code for an instruction*/
+/*  call with*/
+/*		intermediate text for instruction in stbuf*/
+gcist()
+{
+	register i,j;
+
+	if(stbuf[0].itty != ITBS)	/*beginning of statement*/
+		abort();
+	format = (opcpt->flags)&OPFF;
+	in_err = 0;				/*[vlh] no error this instruction, yet*/
+	ival = 0;				/*initial value for possible operand*/
+	reloc = ABS;
+	instrlen = 2;			/*at least 2 bytes*/
+	ins[0] = opcpt->vl1;	/*opcode value*/
+	rlbits[0] = INSABS;		/*instruction absolute*/
+	pins = &ins[1];
+	prlb = &rlbits[1];
+	if(nite>ITOP1) {		/*operands*/
+		if(!format) {
+			uerr(9);
+		}
+		else if(format>LSTFRMT)	/* [vlh] was a magic number... */
+			abort();
+		else {
+			(*opfary[format])();
+		}
+	}
+	if (!ckein() && !in_err) 		/* at end of statement ?? */
+		uerr(6);
+	print(1);			/*print source*/
+
+	loctr =+ p1inlen;
+	if (!in_err && p1inlen != instrlen)	/* [vlh] 2nd pass error recovery */
+		uerr(38);
+	outinstr();		/*write out instr binary*/
+}
+
+/* relative branches*/
+relbr()
+{
+	expr(&p2gi);
+	if(extflg) {	/*external reference*/
+		instrlen =+ 2;		/*long relative*/
+		*pins++ = ival;		/*pass constant part*/
+		*prlb++ = (extref<<3)|EXTREL;	/*ext ref*/
+		return;
+	}
+	ival =- (loctr+2);		/*calc relative offset*/
+	if(itype!=ITCN || reloc != rlflg) {
+		uerr(22);		/*invalid relative branch*/
+		ival = 0;
+	}
+	reloc = ABS;
+	if(p1inlen==4) {		/*long displacement*/
+		if(ival<0xffff8000 || ival>0x7fff)
+			uerr(22);
+		instrlen =+ 2;
+		*pins++ = ival;
+		*prlb++ = DABS;		/*data absolute*/
+	}
+	else {					/*short displacement*/
+		if (ival>127 || ival<-128)
+			uerr(22);
+		ins[0] =| (ival.wd2&0377);
+	}
+	if (!ival)	{	/* make it a nop */
+		opcpt = nopptr;
+		ins[0] = opcpt->vl1.wd2;
+		pins = &ins[1];
+		if (modelen==4) {
+			*pins++ = opcpt->vl1.wd2;
+			rlbits[1] = INSABS;
+		}
+	}
+	in_err++;	/* ignore extra eg. bra *+$d04(pc) vs. bra *+d04 */
+}
+
+/* format one -- add, sub, and, or, cmp, etc.*/
+/*  one operand must be a D reg (or A reg dest for add, sub, or cmp)*/
+opf1()
+{
+	register int *p;
+
+	if(get2ops())
+		return;
+	if (ins[0]==AND || ins[0]==OR)
+		if (cksprg(&opnd[1],CCR) || cksprg(&opnd[1],SR)) {
+			if (ins[0]==AND) opcpt = andiptr;
+			else opcpt = oriptr;
+			ins[0] = opcpt->vl1.wd2;
+			format = (opcpt->flags)&OPFF;
+			ccr_or_sr();
+			return;
+		}
+	p = f1mode;
+	if(ckdreg(&opnd[1])) {	/*destn is D reg*/
+		if((opcpt==andptr||opcpt==orptr)&&ckareg(&opnd[0]))	/*A source*/
+			uerr(20);
+		makef1(opnd[1].ea,p[modelen],&opnd[0]);	/*make instr*/
+		return;
+	}
+	else if(ckdreg(&opnd[0]) && memalt(&opnd[1])) {	/*source is D reg*/
+		if (pcea(&opnd[1])) uerr(10);
+		makef1(opnd[0].ea,p[modelen]+0400,&opnd[1]);
+		return;
+	}
+	else if(ckareg(&opnd[1])) {	/*A reg is dstn*/
+		if(opcpt==addptr)
+			opcpt = addaptr;
+		else if(opcpt==cmpptr)
+			opcpt = cmpaptr;
+		else if(opcpt==subptr)
+			opcpt = subaptr;
+		else {
+			uerr(20);
+			return;
+		}
+		format = (opcpt->flags)&OPFF;
+		opnd[1].ea =& 07;
+		p = f15mode;
+		makef1(opnd[1].ea,p[modelen],&opnd[0]);	/*make instr*/
+		return;
+	}
+	else if(!makeimm())		/*make an immediate instr*/
+		uerr(20);
+}
+
+/* format 2 -- addi, andi, subi, etc*/
+opf2()
+{
+	if(get2ops())
+		return;
+	if(ins[0]==ANDI || ins[0]==ORI || ins[0]==EORI) {
+		if(cksprg(&opnd[1],CCR) || cksprg(&opnd[1],SR)) {
+			ccr_or_sr();
+			return;
+		}
+	}
+	if(opnd[0].ea != IMM) {
+		uerr(9);
+		return;
+	}
+	if(!dataalt(&opnd[1]) || pcea(&opnd[1])) {
+		uerr(20);
+		return;
+	}
+	genimm();
+}
+
+/*format #3 -- move and movea*/
+opf3()
+{
+	register i,j,k;
+
+	if(get2ops())
+		return;
+	if(cksprg(&opnd[0],CCR)) {	/* [vlh] 19-jan-83 */
+		uerr(9);
+		return;
+	}
+	if(cksprg(&opnd[1],CCR)) {
+		ins[0] = MOVECCR;
+opf3l1:
+		if (modelen==1 || modelen==4) uerr(34);
+		if(anysprg(&opnd[0]))
+			uerr(20);
+		ins[0] =| opnd[0].ea;
+		if(!dataea(&opnd[0]))
+			uerr(9);
+		doea(&opnd[0]);
+		return;
+	}
+	if(cksprg(&opnd[1],SR)) {
+		ins[0] = MOVESR;
+		goto opf3l1;
+	}
+	if(cksprg(&opnd[0],SR)) {
+		if (modelen==1 || modelen==4)
+			uerr(34);
+		if(anysprg(&opnd[1]))
+			uerr(20);
+		ins[0] = SRMOVE | opnd[1].ea;
+		if(!dataalt(&opnd[1]) || pcea(&opnd[1]))
+			uerr(10);
+		doea(&opnd[1]);
+		return;
+	}
+	if(cksprg(&opnd[0],USP)) {
+		if (modelen == 1)
+			uerr(34);	/* default is word, can't test */
+		if (!ckareg(&opnd[1]))
+			uerr(33);
+		ins[0] = MOVEUSP|8|(opnd[1].ea&7);
+		return;
+	}
+	if(cksprg(&opnd[1],USP)) {
+		if (modelen == 1)
+			uerr(34);	/* default is word, can't test */
+		if (!ckareg(&opnd[0]))
+			uerr(33);
+		ins[0] = MOVEUSP|(opnd[0].ea&7);
+		return;
+	}
+	k = ins[0];
+	ins[0] =| f3mode[modelen];
+	ckbytea();
+	ins[0] =| opnd[0].ea;		/*source ea*/
+	doea(&opnd[0]);
+	ins[0] =| (opnd[1].ea&7)<<9;	/*dest register*/
+	ins[0] =| (opnd[1].ea&070)<<3;	/*dest mode*/
+	doea(&opnd[1]);
+	if(k==MOVEA) {
+		if(dataea(&opnd[1]))
+			uerr(20);
+	}
+	else if((pcea(&opnd[1]) && dataea(&opnd[1])) || opnd[1].ea==IMM)
+		uerr(20);
+}
+
+/* format 4 -- abcd, sbcd */
+/* format 10 -- cmpm*/
+/* format 27 -- addx, subx */
+opf4()
+{
+	if(get2ops())
+		return;
+	if (format==27) { /*addx,subx add in size bits*/
+		ins[0] =| f1mode[modelen];
+	}
+	else if(format==10) {	/*cmpm*/
+		if((opnd[0].ea&070)!=INDINC || (opnd[1].ea&070)!=INDINC)
+			uerr(20);
+		ins[0] =| f1mode[modelen] | ((opnd[0].ea&7)|((opnd[1].ea&7)<<9));
+		return;
+	}
+	if(ckdreg(&opnd[0]) && ckdreg(&opnd[1])) {
+		ins[0] =| ((opnd[0].ea&7)|((opnd[1].ea&7)<<9));
+		return;
+	}
+	if((opnd[0].ea&070)==DECIND && (opnd[1].ea&070)==DECIND) {
+		ins[0] =| 010 | ((opnd[0].ea&7)|((opnd[1].ea&7)<<9));
+		return;
+	}
+	uerr(20);
+}
+
+/*format 5 -- div, mul*/
+/*format 26 -- cmp, chk */
+opf5()
+{
+	if(get2ops())
+		return;
+	if(!ckdreg(&opnd[1])) {
+		if(opcpt==cmpptr) {
+			if(!dataea(&opnd[1]))	/* [vlh] made define */
+				ins[0] =| f5amode[modelen];	/* was pumode */
+			else if(makeimm())
+				return;
+			else
+				uerr(20);
+		}
+		else
+			uerr(20);
+	}
+	if(opcpt==cmpptr) {
+		ins[0] =| f5mode[modelen];	/* was pumode */
+		ckbytea();
+	}
+	else if(!dataea(&opnd[0]))
+		uerr(20);
+	ins[0] =| (opnd[1].ea&7)<<9 | opnd[0].ea;
+	doea(&opnd[0]);
+}
+
+#define BTST	0000
+/* format 7 -- bit instrs -- btst, bclr, bset, etc*/
+opf7()
+{
+	if(get2ops())
+		return;
+	if(opnd[1].ea==IMM||(ins[0]!=BTST&&pcea(&opnd[1]))||ckareg(&opnd[1]))
+		uerr(20);
+	if(ckdreg(&opnd[0])) {
+		ins[0] =| (opnd[0].ea<<9)|0400;
+	}
+	else {		/*static bit #*/
+		if(opnd[0].con<0L || opnd[0].con>31 ||
+			(opnd[1].ea&INDIRECT&&opnd[0].con>7)) /* [vlh] */
+			uerr(23);
+		if(opnd[0].ea != IMM)
+			uerr(17);
+		ins[0] =| 04000;
+		dodisp(&opnd[0]);
+	}
+	if (modelen==1 && !(memea(&opnd[1])))	/*[vlh]*/
+			uerr(20);
+	else if (!(ckdreg(&opnd[1])) && modelen==4)
+		uerr(20);
+	ins[0] =| opnd[1].ea;
+	doea(&opnd[1]);
+}
+
+/* format 8 -- shifts and rotates*/
+opf8()
+{
+	register i;
+
+	getea(0);	/*get first operand*/
+	if(pitw >= pnite) {		/*end of all ops*/
+		if(ckdreg(&opnd[0])) {	/*shift dreg one bit*/
+			cpop01();		/*copy opnd 0 to 1*/
+			opnd[0].ea = IMM;
+			opnd[0].con = 1L;
+			if (!ckdreg(&opnd[1])) uerr(20);
+opf8l1:
+			if(opnd[0].con<1 || opnd[0].con>8)	/*[vlh legal range 1..8*/
+				uerr(37);
+			ins[0] =| ((opnd[0].con.wd2&7)<<9)|f1mode[modelen]|opnd[1].ea;
+			return;
+		}
+		i = (ins[0]&077)<<6;
+		ins[0] =& 0177700;
+		ins[0] =| 0300|i|opnd[0].ea;
+		if(!memalt(&opnd[0]) || pcea(&opnd[0]) || modelen != 2)
+			uerr(20);
+		doea(&opnd[0]);
+		return;
+	}
+	if(!ckcomma()) {
+		uerr(10);
+		return;
+	}
+	getea(1);		/*get second operand*/
+	if(!ckdreg(&opnd[1]))	/* [vlh] second operand must be dreg */
+		uerr(20);
+	if(ckdreg(&opnd[0])) {	/*first op is D reg*/
+		ins[0] =| (opnd[0].ea<<9)|040;	/*reg # and reg bit*/
+	}
+	else {
+		if(opnd[0].ea != IMM)
+			uerr(20);
+		goto opf8l1;
+	}
+	ins[0] =| f1mode[modelen] | opnd[1].ea;	/*put in size and reg #*/
+}
+
+/* format 9 -- jmp, jsr */
+/* format 14 -- stop */
+/* format 24 -- clr, neg, negx, not */
+/* format 25 -- s?? */
+/* format 29 -- pea */
+/* one operand instructions -- jmp, clr, neg, not, sge, etc.*/
+opf9()
+{
+	getea(0);
+	if(format==24) {	/*clr, not, etc*/
+		ins[0] =| f1mode[modelen];	/*add size bits*/
+		if(!dataalt(&opnd[0]) || pcea(&opnd[0]))
+			uerr(20);
+	}
+	else if(format==25) {	/*tas,scc, etc*/
+		if(ckareg(&opnd[0]) || pcea(&opnd[0]) || opnd[0].ea==IMM)
+			uerr(20);
+	}
+	else if(format==14) {		/*stop*/
+		if(modelen!=2 || opnd[0].ea!=IMM)
+			uerr(20);
+		doea(&opnd[0]);
+		return;
+	}
+	else if(!controlea(&opnd[0]))	/*jmp, jsr, etc*/
+		uerr(20);
+	ins[0] =| opnd[0].ea;
+	doea(&opnd[0]);
+}
+
+/* format 11 -- dbcc*/
+/* format 19 -- link*/
+opf11()
+{
+	if(get2ops())
+		return;
+	if(format==19) {		/*link*/
+		if(!ckareg(&opnd[0]))
+			uerr(33);
+		if(opnd[1].ea != IMM)
+			uerr(17);
+	}
+	else {
+		if(!ckdreg(&opnd[0]))
+			uerr(33);
+		if(opnd[1].drlc!=rlflg)	/*[vlh]don't chk opnd[1].ea!=LADDR||SADDR*/
+			uerr(22);
+		opnd[1].con =- (loctr+2L);
+		cksize(&opnd[1]);
+		opnd[1].drlc = ABS;		/*not relocatable*/
+	}
+	ins[0] =| opnd[0].ea&7;	/*put in reg #*/
+	dodisp(&opnd[1]);
+}
+
+/* format 12 -- exg*/
+opf12()
+{
+	register i;
+
+	if(get2ops())
+		return;
+	if(ckdreg(&opnd[0])) {
+		if(ckdreg(&opnd[1])) {	/*exchange D regs*/
+			ins[0] =| 0100 | ((opnd[0].ea&7)<<9) | (opnd[1].ea&7);
+			return;
+		}
+		if(ckareg(&opnd[1])) {	/*ins[0] <- A and D flag*/
+			ins[0] =| 0210 | ((opnd[0].ea&7)<<9) | (opnd[1].ea&7);
+			return;
+		}
+	}
+	if(ckareg(&opnd[0])) {
+		if(ckareg(&opnd[1])) {	/*both a regs*/
+			ins[0] =| 0110 | ((opnd[0].ea&7)<<9) | (opnd[1].ea&7);
+			return;
+		}
+		if(ckdreg(&opnd[1])) {	/*A and D regs*/
+			i = opnd[0].ea;		/*exchg ea's*/
+			opnd[0].ea = opnd[1].ea;
+			opnd[1].ea = i;
+			ins[0] =| 0210 | ((opnd[0].ea&7)<<9) | (opnd[1].ea&7);
+			return;
+		}
+	}
+	uerr(20);
+}
+
+/* format 13 -- ext, unlk*/
+/* format 18 -- trap*/
+/* format 28 -- swap */
+#define UNLK	047130
+
+opf13()
+{
+	getea(0);
+	if(format==18) {	/*trap*/
+		if(opnd[0].con<0 || opnd[0].con>15)
+			uerr(15);
+		ins[0] =| opnd[0].con.wd2;
+		return;
+	}
+	if(ins[0]==UNLK) {	/*unlk instr*/
+		if(!ckareg(&opnd[0]))
+			uerr(20);
+	}
+	else {
+		if(!ckdreg(&opnd[0]))
+			uerr(20);
+		if (format==13)		/* ext */
+			ins[0] =| f13mode[modelen];
+	}
+	ins[0] =| opnd[0].ea&7;
+}
+
+/* format 15 -- adda, cmpa, suba*/
+/* format 30 -- lea */
+opf15()
+{
+	register i;
+
+	if(get2ops())
+		return;
+	if(!ckareg(&opnd[1]))
+		uerr(33);
+	if(format==30) {
+		i = 0700;
+		if(!controlea(&opnd[0]))
+			uerr(20);
+	}
+	else
+		i = f15mode[modelen];
+	makef1(opnd[1].ea&7,i,&opnd[0]);
+	if (format==15 && opnd[0].ea != 071) cksize(&opnd[0]);
+}
+
+/*formats 16 and 17 -- addq, inc, subq, dec*/
+opf17()
+{
+	if(format==16) {	/*inc or dec*/
+		clrea(&opnd[0]);
+		opnd[0].ea = IMM;
+		opnd[0].con = 1L;
+		opnd[0].drlc = ABS;
+		getea(1);
+	}
+	else {
+		if(get2ops())
+			return;
+	}
+	if(opnd[0].ea != IMM || !altea(&opnd[1]) || pcea(&opnd[1]))
+		uerr(20);
+	if(opnd[0].con<=0 || opnd[0].con>8)
+		uerr(15);
+	if(modelen==1 && !dataea(&opnd[1]))
+		uerr(34);
+	ins[0] =| f1mode[modelen]|((opnd[0].con.wd2&7)<<9)|opnd[1].ea;
+	doea(&opnd[1]);
+}
+
+/* format 20 -- movem */
+int regmsk0[] {0100000,040000,020000,010000,04000,02000,01000,0400,0200,
+				0100,040,020,010,4,2,1};
+int regmsk1[] {1,2,4,010,020,040,0100,0200,0400,01000,02000,04000,010000,
+				020000,040000,0100000};
+opf20()
+{
+	register dr;
+	register i,j;
+
+	dr = 0;
+	if(getreg() != -1 || pitw->itty == ITRM) {	/*regs to memory*/
+		if (pitw->itty != ITRM) {	/* [vlh] */
+			pitw--;
+			j = getrlist(regmsk0);
+		}
+		else {
+			j = pitw->itop;
+			pitw++;
+		}
+		if(!ckcomma())
+			uerr(10);
+	}
+	else
+		dr = 02000;
+	getea(0);
+	if(dr) {
+		if(!ckcomma())
+			uerr(10);
+		if (pitw->itty != ITRM)		/* [vlh] */
+			j = getrlist(regmsk1);	/*mem to regs*/
+		else {
+			j = pitw->itop;
+			j = fixmask(j);
+			pitw++;
+		}
+	}
+	else {
+		if(controlea(&opnd[0]))
+			j = fixmask(j);
+	}
+	i = opnd[0].ea&070;
+	if(!controlea(&opnd[0]) && i!=INDINC && i!=DECIND)
+		uerr(20);
+	if(modelen==4)	/*long*/
+		ins[0] =| 0100;
+	ins[0] =| opnd[0].ea|dr;
+	*pins++ = j;			/*reg mask*/
+	*prlb++ = DABS;
+	instrlen =+ 2;
+	doea(&opnd[0]);
+	if (!dr) {	/* 1st argument (2nd is reg list) */
+		if (pcea(&opnd[0]) || (opnd[0].ea&070)==INDINC)
+			uerr(20);	/* xx(pc), xx(pc,dx), -(ax) */
+	}
+	else	/* 2nd argument (1st is reg list) */
+		if ((opnd[0].ea&070)==DECIND)
+			uerr(20);	/* (ax)+ */
+}
+
+/*
+ * get a list of registers for the movem instr
+ * call with:
+ *	ptr to reg-to-mem or mem-to-reg array of bits
+ */
+getrlist(ap)
+int *ap;
+{
+	register int *p,i,j;
+	register int mask;
+
+	p = ap;
+	mask = 0;
+	while((i=getreg()) != -1) {
+		if(ckitc(pitw,'-')) {
+			pitw++;
+			if((j=getreg()) == -1) {
+				uerr(40);
+				break;
+			}
+			while(i<=j)
+				mask =| p[i++];
+		}
+		else
+			mask =| p[i];
+		if(ckitc(pitw,'/'))
+			pitw++;
+		else
+			break;
+	}
+	if(!mask)
+		uerr(40);
+	return(mask);
+}
+
+/*reverse a movem register mask for control ea to memory*/
+fixmask(msk)
+{
+	register i,j,k;
+
+	k = (msk&1) ? 0100000 : 0;
+	i = 2;
+	j = 040000;
+	while(i) {
+		if(msk&i)
+			k =| j;
+		i =<< 1;
+		j =>> 1;
+	}
+	return(k);
+}
+
+/* format 21 -- movep*/
+opf21()
+{
+	register m,d;
+	register char *p;
+
+	if(get2ops())
+		return;
+	if(ckdreg(&opnd[0])) {	/*d reg source*/
+		m = 0600;
+		d = opnd[0].ea;
+		p = &opnd[1];
+	}
+	else if(ckdreg(&opnd[1])) {		/*d reg dest*/
+		m = 0400;
+		d = opnd[1].ea;
+		p = &opnd[0];
+	}
+	else {
+		uerr(20);
+	}
+	if((p->ea&070) != INDDISP)
+		uerr(20);
+	if(modelen == 4)
+		m =| 0100;
+	ins[0] =| (d<<9)|m|(p->ea&7);
+	*pins++ = p->con.wd2;
+	*prlb++ = p->drlc;
+	instrlen =+ 2;
+}
+
+/* format 22 -- moveq*/
+opf22()
+{
+	if(get2ops())
+		return;
+	if(opnd[0].ea != IMM)
+		uerr(17);
+	if(opnd[0].con>255L || opnd[0].con<-256L)
+		uerr(15);
+	if(!ckdreg(&opnd[1]))
+		uerr(33);
+	ins[0] =| (opnd[1].ea<<9) | (opnd[0].con.wd2&0377);
+}
+
+/* format 23 -- eor*/
+opf23()
+{
+	if(get2ops())
+		return;
+	if (cksprg(&opnd[1],CCR) || cksprg(&opnd[1],SR)) {
+		opcpt = eoriptr;
+		ins[0] = opcpt->vl1.wd2;
+		format = (opcpt->flags)&OPFF;
+		ccr_or_sr();
+		return;
+	}
+	if(!ckdreg(&opnd[0])) {
+		if(makeimm())	/*must be immediate*/
+			return;
+		uerr(20);		/*or error*/
+	}
+	if(!dataalt(&opnd[1]) || pcea(&opnd[1]))
+		uerr(20);
+	ins[0] =| (opnd[0].ea<<9)|f23mode[modelen]|opnd[1].ea;
+	doea(&opnd[1]);
+}
+

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/symt.c

@@ -0,0 +1,820 @@
+/*
+	Copyright 1981
+	Alcyon Corporation
+	8716 Production Ave.
+	San Diego, Ca.  92121
+*/
+
+#include "as68.h"
+
+/* symbol table and misc routines*/
+
+int errno;
+char *ermsg[];
+char tfilname[];
+char initfnam[];
+char ldfn[];
+char tlab1[];
+int stdofd;
+int ftudp;
+int poslab;
+
+/*output it for beginning of statement*/
+opitb()
+{
+	stbuf[0].itty = ITBS;	/*beginning of statement*/
+	stbuf[0].itop = (fchr!=EOLC) ? absln : absln-1;
+	stbuf[1].itty = ITSY;	/*label entry*/
+	stbuf[1].itop.ptrw2 = lblpt;	/*pointer to symbol or 0*/
+
+/*put opcode in it buffer*/
+	stbuf[2].itty = ITSY;
+	stbuf[2].itrl = modelen;	/*mode of instr(byte, word, long)*/
+	stbuf[2].itop.ptrw2 = opcpt;	/*pointer to opcode in main table*/
+	stbuf[3].itty = ITCN;
+	stbuf[3].itrl = rlflg;		/*relocation base*/
+	stbuf[3].itop = loctr;		/*pass1 location counter*/
+	itwc = ITOP1;				/*next available slot-currently 4*/
+	pitw = &stbuf[ITOP1].itty;	/*init the pointer*/
+}
+
+/*
+ *  get an input term  (symbol, constant, or special character)
+ * 	call with:
+ * 		the first character in fchr
+ * 	returns:
+ * 		item type in itype
+ * 		item value in ival if item is a constant or special character
+ * 		if it is a symbol it is placed at the end of the main table
+
+ * meaning of state table:
+   
+ * currently getting:		symbol(0)	constant(1)		beginning(2)
+    
+ * next char:
+ * digit(0)					0			1				1
+    
+ * letter(3)				0			3				0
+    
+ * special char(6)			3			3				3
+    
+ * contents of the state table is the next state.  processing stops when
+ * state 3 is encountered.  state 2 is the beginning state.
+ */
+int sttbl[] {0,1,1,0,3,0,3,3,3};	/*state table for parser*/
+
+gterm(constpc)
+int constpc;
+{
+	register smode, i;
+	register char *p;
+	register int tmode;
+	register char *j;
+	long num;
+	char istr[80];
+
+	if(fchr == '\'' || fchr == '"')
+		if(astring())		/*maybe ascii string*/
+			return;
+	smode = 2;	/*beginning state*/
+	i = 0;
+	p = istr;
+
+/*loop to put item on istr*/
+	while(fchr>=' ') {		/*until a control char*/
+		if(smode==2 && fchr=='.')
+			tmode = 3;
+		else if(isalpha(fchr) || fchr=='~' || fchr=='_' || (fchr=='$'&&i))
+			tmode=3;
+		else if(isdigit(fchr))
+			tmode=0;
+		else
+			tmode = 6;
+		tmode = sttbl[tmode+smode];	/*new state*/
+		if(tmode==3) break;			/*end of item*/
+		smode = tmode;
+		*p++ = fchr;			/*save character*/
+		i++;
+		fchr=gchr();
+	}
+
+/* end of item*/
+	switch(smode) {
+
+	case 0:			/*symbol*/
+		*p = '\0';		/*end of symbol*/
+		itype = ITSY;		/*symbol*/
+		pack(istr,lmte);	/*put symbol at end of main table*/
+		j = lemt(sirt,FALSE);
+		if(istr[0]!='~' && !poslab && (j->flags&(SYEQ|SYER))==SYEQ) {
+			itype = (j->flags&SYRM) ? ITRM : ITCN;	/* [vlh] */
+			ival = j->vl1;
+			reloc = ((j->flags)&SYRO) ? TEXT : ((j->flags)&SYRA) ? DATA :
+				((j->flags)&SYBS) ? BSS : ABS;
+		}
+		return;
+
+	case 1:			/*constant*/
+		if(!constant(&num,istr,i)) {
+			uerr(17);			/*illegal constant*/
+			num = 0;
+		}
+		ival = num;
+		itype = ITCN;
+		reloc = ABS;
+		return;
+
+	case 2:			/*just a special char*/
+		switch(fchr) {
+
+		case '*':			/*location counter*/
+			if(starmul) {	/*multiply*/
+				starmul = 0;
+				goto specsy;
+			}
+			refpc++;	/*referenced pgm ctr*/
+			reloc = rlflg;	/*relocation of location counter*/
+			ival = loctr;
+			itype = (constpc) ? ITCN : ITPC;
+			break;
+
+
+		case '$':			/*hex constant*/
+			oconst(16);
+			return;
+
+		case '@':			/*octal const*/
+			oconst(8);
+			return;
+
+		case '%':			/*binary const*/
+			oconst(2);
+			return;
+
+		case '#':
+			immed[opdix]++;
+			goto specsy;
+
+		case '(':
+			indir[opdix]++;
+			plevel++;
+			goto specsy;
+
+		case ')':
+			plevel--;
+			goto specsy;
+
+		default:
+specsy:
+			itype = ITSP;		/*return special char*/
+			ival = fchr;
+		}
+		if(fchr != EOLC)
+			fchr=gchr();		/*get next char*/
+		if((ival=='>' && fchr=='>') || (ival=='<' && fchr=='<'))
+			fchr=gchr();			/*shift op, ignore second char*/
+		return;
+
+	default:
+		abort();		/*not possible*/
+	}
+}
+
+/*check for an ascii string enclosed in single quotes*/
+
+astring()
+{
+	register char delim;
+
+	if(fchr != '\'' && fchr != '"')		/*valid delimiter*/
+		return;
+	delim = fchr;
+	if(equflg || (itype==ITSP && ival.wd2=='#')) {	/*immediate operand*/
+		if(astr1(delim)) {
+			fchr = gchr();
+			if(fchr!=delim)
+				xerr(19);
+			fchr=gchr();
+		}
+		return((equflg) ? 1 : 0);
+	}
+	while(astr1(delim)) {
+		itype = ITSP;
+		ival = ',';			/*separate by commas*/
+		reloc = ABS;
+		opitoo();
+	}
+	return(0);
+}
+
+astr1(adelim)
+{
+	register delim,i,retv;
+	register long l;
+
+	delim = adelim;
+	i = 0; l = 0;
+	retv = 1;
+	while((fchr=gchr()) != EOF) {
+		if(fchr==delim) {
+			fchr = gchr();
+			if(fchr != delim) {
+				retv = 0;		/*end of string*/
+				break;
+			}
+		}
+		if(fchr == EOLC) {
+			xerr(19);
+			retv = 0;	/*end of string*/
+			break;
+		}
+		l = (l<<8) | fchr;
+		if(++i >= modelen) {
+			if((fchr=gchr()) == delim) {
+				fchr = gchr();
+				retv = 0;		/*end of string*/
+			}
+			else
+				peekc = fchr;	/*next char in string*/
+			break;			/*filled one bucket*/
+		}
+	}
+	while(i < modelen) {
+		l =<< 8;
+		i++;
+	}
+	itype = ITCN;
+	ival = l;
+	reloc = ABS;
+	if(!equflg)
+		opitoo();			/*output one operand*/
+	return(retv);
+}
+
+/*get constant given radix*/
+oconst(ardx)
+{
+	register trdx,j;
+	register long i;
+
+	switch (ardx) {		/* radix as power of 2 */
+		case 16 : trdx = 4; break;
+		case  8 : trdx = 3; break;
+		case  2 : trdx = 1; break;
+		default :
+			rpterr("invalid radix in oconst");
+			abort();
+	}
+	i=0;
+	while(1) {
+		fchr=gchr();
+		j=fchr;
+		if(isdigit(j))
+			j =- '0';
+		else if((j=tolower(j))>='a' && j<='f')
+			j = j-'a'+10;
+		else
+			break;			/*not valid numeric char*/
+		if(j>=0 && j<ardx)
+			i = (i<<trdx)+j;
+		else
+			break;
+	}
+	ival = i;
+	itype = ITCN;
+	reloc = ABS;
+}
+
+
+/*convert ascii constant to binary*/
+constant(pnum,pstr,idx)
+long *pnum;
+char *pstr;
+{
+	register i,j;
+	register char *p;
+	register long l;
+
+	p = pstr;
+	l = 0;
+	for(i=0; i<idx; i++) {
+		j = *pstr++;
+		if(isdigit(j))
+			j =- '0';
+		if(j<0 || j>=10)
+			return(0);
+		l = (l<<3) + (l<<1) + j;	/* l = l*10 + j*/
+	}
+	*pnum = l;
+	return(1);
+}
+
+/*
+ * method for looking up entries in the main table
+ *
+ * Note:	The entry to be looked up must be placed at the end
+ *			of the main table.  The global cell 'lmte'(last main
+ *			entry) points to the next available entry in the main
+ *			table.  The address of an initial reference table must
+ *			also be provided.
+ *
+ *	1)	Compute the hash code for the symbol and add it to the base address
+ *		of the initial reference table given as input.  Thus, two words are
+ *		accessed which define the chain on which the symbol must be if it
+ *		is in the table at all.
+ *
+ *	2)	Alter the table link of the last symbol in the chain so that it
+ *		points to the symbol being looked up.  Note that the symbol to be 
+ *		looked up is always placed at the end of the main table before
+ *		calling the lookup routine.  This essentially adds one more element
+ *		to the end of the chain, namely the symbol to be looked up.
+ *
+ *	3)	Now start at the first symbol in the chain and follow the chain
+ *		looking for a symbol equal to the smbol being looked up.  It is
+ *		guaranteed that such a symbol will be found because it is always
+ *		the last symbol on the chain.
+ *
+ *	4)	When the symbol is found, check to see if it is the last symbol
+ *		on the chain.  If not, the symbol being looked for is in the table
+ *		and has been found.  If it is the last symbol, the symbol being
+ *		looked up is not in the table.
+ *
+ *	5)	In the case the looked up symbol is not found, it is usually added
+ *		to the end of the table.  This is done simply b changing the
+ *		initial reference table entry which points to the previous
+ *		last symbol on the chain so that is now points to the symbol at the
+ *		end of the main table.  In case the symbol just looked up is not to
+ *		be added to the main table then no action is needed .  This means
+ *		that the table link of the last symbol on a chain may point any-
+ *		where.
+ *
+ * look up entry in the main table
+ *		call with:
+ *			address of initial reference table
+ *			entry to be looked up at the end of the main table
+ *		returns:
+ *			a pointer to the entry.  if this pointer is equal to
+ *			lmte then the symbol was not previously in the table.
+ */
+
+char *lemt(airt,oplook)
+char **airt;
+int oplook;		/* if true then looking in opcode table */
+{
+	register char *mtpt;
+	register int *p1, *p2;
+	register int i, j;
+
+	if (oplook) {	/* [vlh] get rid of preceding '.', to lowercase */
+		if (lmte->name[0]=='.') {
+			lmte->name[NAMELEN-1] = NULL;	/* in case of '.' */
+			j = 1;
+		}
+		else j = 0;
+		for (i=0; j<NAMELEN; i++, j++)
+			lmte->name[i] = tolower(lmte->name[j]);
+	}
+
+	pirt = airt + hash();	/*hashed ptr to irt*/
+	mtpt = pirt->irfe;		/*pointer to first entry in chain*/
+	if(!mtpt)				/*empty chain*/
+		mtpt = lmte;		/*start at end of main table*/
+	else
+		(pirt->irle)->tlnk = lmte;	/*last entry in chain is new symbol*/
+
+/*loop to locate entry in main table*/
+lemtl:
+	p1 = &mtpt->name[0];
+	p2 = &lmte->name[0];
+	i = NAMELEN/(sizeof i);
+	while(i) {
+		if(*p1++ != *p2++) {
+			mtpt = mtpt->tlnk;	/*go to next entry in chain*/
+			goto lemtl;
+		}
+		i--;
+	}
+	return(mtpt);
+}
+
+/* compute a hash code for the last entry in the main table*/
+/*	returns the hash code*/
+hash()
+{
+	register int i;
+	register ht1;
+	register char *p;
+
+	ht1 = 0;
+	p = &lmte->name[0];
+	for(i=0; i<NAMELEN; i++) 
+		ht1 =+ *p++;
+	return(ht1&(SZIRT-2));	/*make hash code even and between 0 & SZIRT-2*/
+}
+
+/*
+ * Make an entry in the main table
+ * assumes :
+ *   entry to be made is pointed at by lmte
+ *   pirt points to the correct initial reference table entry.
+ */
+mmte()
+{
+	pirt->irle = lmte;		/*pointer to last entry in chain*/
+	if(pirt->irfe == 0)		/*first entry in chain*/
+		pirt->irfe = lmte;
+	lmte =+ STESIZE;			/*bump last main table entry pointer*/
+	if(lmte>=emte) {		/*main table overflow*/
+		if(sbrk(STESIZE*ICRSZMT) == -1){	/*get more memory*/
+			rpterr("symbol table overflow\n");
+			endit();
+		}
+		else {
+			emte =+ STESIZE*ICRSZMT;	/*move end of main table*/
+			cszmt =+ ICRSZMT;
+		}
+	}
+}
+
+/*
+ * make an entry in the main table for a directive
+ *	call with:
+ *		pointer to string containing directive name
+ *		address of routine to handle directive in pass one
+ *		address of routine to handle directive in pass two
+ */
+mdemt(mdstr,dirnum)
+char *mdstr;
+{
+	register char *mdept;
+
+	pack(mdstr,lmte);		/*pack name at end of main table*/
+	mdept=lemt(oirt,TRUE);		/*look up in opcode table*/
+	if(mdept != lmte) {		/*best not be there already*/
+		uerr(5);
+		abort();
+		return;
+	}
+	mmte();					/*make main table entry*/
+	mdept->flags =| OPDR|SYIN;	/*directive*/
+	mdept->vl1 = dirnum;		/*directive #*/
+}
+
+/*
+ * pack a string into an entry in the main table
+ *	call with:
+ *		pointer to the string
+ *		pointer to desired entry in the main table
+ */
+pack(apkstr,apkptr)
+char *apkstr, *apkptr;
+{
+	register i;
+	register char *pkstr, *pkptr;
+
+	pkstr = apkstr;
+	pkptr = apkptr;
+	i = NAMELEN;
+	while(*pkstr && i) {
+		*pkptr++ = *pkstr++;
+		i--;
+	}
+	while(i--)
+		*pkptr++ = '\0';	/*pad with nulls*/
+}
+
+/* function to get characters for source file*/
+gchr()
+{
+	register chr1;
+
+	if(peekc) {
+		chr1 = peekc;
+		peekc = 0;
+	}
+	else {
+gchr1:
+		if(sbuflen<=0){		/*nothing on input buffer*/
+			sbuflen=read(ifn,sbuf,512);	/*read in source*/
+			if(sbuflen<=0)
+				return(EOF);			/*end of file*/
+			psbuf = sbuf;
+		}
+		chr1 = *psbuf++;
+		sbuflen--;
+	}
+	if (chr1 == SOH)	/*preprocessor flag*/
+		goto gchr1;		/*ignore it*/
+	if(chr1 == EOLC) {		/*end of line*/
+		if(!p2flg)		/*pass 1 only*/
+			absln++;
+	}
+	else if(chr1=='\t') {	/*convert tabs to spaces*/
+		chr1 = ' ';
+	}
+	return(chr1);
+}
+
+/*
+ * write out intermediate text for one statement
+ *	call with
+ *		the it for the statement in stbuf
+ */
+wostb()
+{
+	register int woix;
+	register int *itwo;
+	register int i;
+
+	if(stbuf[0].itty != ITBS) abort();	/*not beginning of stmt*/
+	itwo = &stbuf;
+	woix = stbuf[0].itrl & 0377;	/*unsigned byte*/
+	while(woix--) {
+		for(i=0; i<STBFSIZE/(sizeof *itwo); i++) {
+			if(pitix > &itbuf[ITBSZ-1]) {		/*no room in buffer*/
+				doitwr();
+			}
+			*pitix++ = *itwo++;	/*first word*/
+		}
+	}
+/*	debug();		//call debug package*/
+}
+
+doitwr()
+{
+	register int i;
+
+	if(write(itfn,itbuf,ITBSZ*(sizeof i)) != ITBSZ*(sizeof i)) {
+		rpterr("it write error errno=%o\n",errno);
+		endit();
+	}
+	pitix = itbuf;
+}
+
+/*
+ * user source error
+ *	call with:
+ *		number to indicate reason for error
+ *	types the error number and the line number on which
+ *	the error occured.
+ */
+uerr(errn)
+{
+	if(p2flg) {	/*pass 2 gets two ampersands*/
+		in_err++;	/* [vlh] instrlen <- pass1 estimation */
+		printf("&& %d: %s\n",p2absln,ermsg[errn-1]);
+	}
+	else
+		printf("& %d: %s\n",(fchr==EOLC)?absln-1:absln,ermsg[errn-1]);
+	nerror++;
+}
+/*
+ * user error that causes the statement to be abandoned
+ *	call with:
+ *		error number
+ */
+xerr(xern)
+{
+	uerr(xern);		/*type error message*/
+	if(!p2flg)		/*pass one*/
+		igrst();	/*pass rest of source*/
+}
+
+/* abort the assembly*/
+abort()
+{
+	rpterr("as68 abort\n");
+	nerror++;
+	endit();
+}
+
+/*ignore rest of statement*/
+igrst()
+{
+	while(fchr!=EOLC && fchr!=EOF)	/*until end of line*/
+		fchr=gchr();
+	while((fchr=gchr())==EOLC) ;	/*ignore null lines*/
+}
+
+/*ignore blanks after a label*/
+ligblk()
+{
+	if(fchr == EOF) return;
+	igblk();
+	if(fchr==EOLC) {
+		fchr=gchr();
+		ligblk();
+	}
+}
+
+rubout()
+{
+	nerror = -1;
+	endit();
+}
+
+/* exit from the assembler*/
+endit()
+{
+	LASTCHTFN = itfnc;
+	unlink(tfilname);		/*delete temporary files*/
+	LASTCHTFN = trbfnc;
+	unlink(tfilname);
+	LASTCHTFN = dafnc;
+	unlink(tfilname);
+	LASTCHTFN = drbfnc;
+	unlink(tfilname);
+	if(nerror != -1) {		/*not rubout*/
+		if(ftudp)
+			putchar('\n');
+		putchar(0);	/* flush the printing*/
+	}
+	if(nerror > 0) {
+		stdofd = 2;
+		printf("& %d errors\n",nerror);
+		putchar(0);
+	}
+	if (initflg)
+		unlink(ldfn);	/* [vlh] get rid of empty .o file */
+	exit(nerror!=0);
+}
+
+/*
+ * open files
+ *	call with:
+ *		pointer to name of file to open
+ *		flag for how to open
+ *			0 => read
+ *			1 => write
+ */
+openfi(pname,hflag)
+char *pname;
+{
+	register fd;
+
+	fd = (hflag) ? creat(pname,0666) : open(pname,hflag);
+	if(fd < 0) {	/*open failed*/
+		rpterr("can't open %s errno=%o\n",pname,errno);
+		endit();
+	}
+	return(fd);
+}
+
+/* get a temp file for the intermediate text*/
+gettempf()
+{
+	register i,j;
+	register char *p;
+
+	if(LASTCHTFN == 'A') {
+		j = getpid();
+		p = &LASTCHTFN-4;
+		while(p < &LASTCHTFN) {
+			*p++ = (j&017) + 'a';
+			j =>> 4;
+		}
+	}
+	while(LASTCHTFN < 'z') {
+		LASTCHTFN++;
+		if((j=creat(tfilname,0600))>=0)
+			return(j);
+	}
+	rpterr("temp file create error: %s errno=%o\n",tfilname,errno);
+	endit();
+}
+
+/* move label name from lbt to main table entry pointed to by lmte*/
+setname()
+{
+	register i;
+	register int *p1, *p2;
+
+	p1 = &lmte->name[0];
+	for(p2 = &lbt[0]; p2 < &lbt[NAMELEN]; ) {
+		*p1++ = *p2;
+		*p2++ = 0;
+	}
+}
+
+/* get the initialized main table and initial reference tables from*/
+/*	the initialize file*/
+getsymtab()
+{
+	register char **p;
+	register struct symtab *p1;
+	register char *p2;
+	register fd,i;
+
+	if((fd=open(initfnam,0)) < 0) {
+rerr:
+		printf("& Unable to read init file: %s\n", initfnam);
+		endit();
+	}
+	if(read(fd,sirt,SZIRT*SIRTSIZE) != SZIRT*SIRTSIZE) {
+		goto rerr;
+	}
+
+	if(read(fd,oirt,SZIRT*SIRTSIZE) != SZIRT*SIRTSIZE)
+		goto rerr;
+
+	if((i=read(fd,bmte,SZMT*STESIZE)) <= 0)
+		goto rerr;
+
+	if((i%STESIZE) != 0)
+		goto rerr;
+
+	lmte = bmte + i;
+	p2 = bmte-1;
+	for(p=sirt; p<&sirt[SZIRT]; p++) {
+		if(*p)
+			*p =+ p2;
+	}
+	for(p=oirt; p<&oirt[SZIRT]; p++) {
+		if(*p)
+			*p =+ p2;
+	}
+	for(p1=bmte; p1<lmte; p1++) {
+		if(p1->tlnk)
+			p1->tlnk =+ p2;
+	}
+	close(fd);
+}
+
+/* write the initialization file*/
+putsymtab()
+{
+	register char **p;
+	register struct symtab *p1;
+	register char *p2;
+	register fd,i;
+
+	if((fd=creat(initfnam,0644))<0) {
+werr:
+		printf("& Write error on init file: %s\n", initfnam);
+		return;
+	}
+/*
+ * change all pointers so that they are relative to the beginning
+ * of the symbol table
+ */
+	p2 = bmte-1;
+	for(p=sirt; p<&sirt[SZIRT]; p++) {
+		if(*p)
+			*p =- p2;
+	}
+	for(p=oirt; p<&oirt[SZIRT]; p++) {
+		if(*p)
+			*p =- p2;
+	}
+	for(p1=bmte; p1<lmte; p1++) {
+		if(p1->tlnk)
+			p1->tlnk =- p2;
+	}
+
+	if(write(fd,sirt,SZIRT*SIRTSIZE) != SZIRT*SIRTSIZE) {
+		goto werr;
+	}
+
+	if(write(fd,oirt,SZIRT*OIRTSIZE) != SZIRT*OIRTSIZE)
+		goto werr;
+
+	i = lmte - bmte;		/*length of current main table*/
+	if((i % STESIZE) != 0) {
+		goto werr;
+	}
+	if(write(fd,bmte,i) != i)
+		goto werr;
+	close(fd);
+}
+
+/* print an error on file descriptor 2*/
+/*	used for errors with disasterous consequences*/
+rpterr(ptch,x1,x2,x3,x4,x5,x6)
+char *ptch;
+{
+	putchar(0);		/*flush buffer*/
+	stdofd = 2;		/*error file*/
+	printf("& %d: ",absln);
+	printf(ptch,x1,x2,x3,x4,x5,x6);
+}
+
+/* set the file name for the relocatable object file (sourcefile.o)*/
+setldfn(ap)
+char *ap;
+{
+	register char *p1,*p2;
+
+	p1 = ap;
+	p2 = ldfn;
+	while(*p1) {
+		*p2++ = *p1++;
+	}
+	if(*(p2-2) != '.') {	/*not name.?*/
+		*p2++ = '.';
+		*p2++ = 'o';
+	}
+	else {			/* is name.? */
+		*(p2-1) = 'o';
+	}
+	*p2 = '\0';
+}

CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/oldas68/version.c

@@ -0,0 +1 @@
+char *compiled "@(#) assembler -  Fri Mar 18 08:10 1983";