Small C compiler version C3.0R1.1 (part 1 of 3)

sources-request at panda.UUCP sources-request at panda.UUCP
Mon May 19 22:22:06 AEST 1986


Mod.sources:  Volume 5, Issue 7
Submitted by: genrad!linus!mnetor!clewis (Chris Lewis)

There've been quite a few requests for this via net.micro.cpm, so's I
thought I'd post it thru mod.sources.  This is Ron Cain's original Small
C compiler, but highly extended.  Included are code generators for 8080,
6809, 68000, and VAX, as well as run-time support for 8080 CPM, VAX BSD4.1,
and a FLEX 6809 environment.  See the README for a description of Small C's
limitations.

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	README
#	M_README
#	Makefile
#	Makefile.bsd
#	code8080.c
#	codeas09.c
#	codem68k.c
#	codevax.c
#	data.c
#	data.h
# This archive created: Sun May 18 18:28:42 1986
export PATH; PATH=/bin:$PATH
echo shar: extracting "'README'" '(2959 characters)'
if test -f 'README'
then
	echo shar: will not over-write existing file "'README'"
else
cat << \SHAR_EOF > 'README'
			Small C version C3.0R1.1
			      (SCC3)

			    Chris Lewis

This directory contains the source for a version of Ron Cain's Small C 
compiler that I have heavily modified - beyond the Small-C V2.0 later
published in Dr. Dobbs.  This compiler generates assembler source code that
needs to be assembled and linked to make a running program.

Small C is a public domain compiler for a subset of C.  The main things
lacking are "#if", structs/unions, doubles/floats/longs and more than
one level of indirection.  Even so, it's powerful enough to be able to
compile itself.  It's also lots of fun to play around with.  It could
use lots of more work (eg: a real scanner), but what the heck...
Retargetting the compiler requires only relinking the frontend with a new
code generator.

Code generators for 6809 (MIT UNIX-like assembler), M68K (Motorola V/68 UNIX
assembler), VAX (BSD 4.1 assembler), and 8080 (RMAC assembler) are provided.

Users having access to System V make should be able to use the Makefile 
without any modification except for INCDIR and LIBDIR (where you'd like 
to put the compiler itself).

Users not having access to System V will probably have to rewrite the Makefile.
[ I have provided a Makefile that seems to work with bsd systems - mod]

WARNING: you will probably see a great deal of compilation warnings when
you compile this compiler with a "real" UNIX C.  Don't worry - this is
*perfectly* normal - Small C is a subset of real C, and in order to
keep the compiler in this subset you have to bend the rules somewhat.
The only time where this might cause a problem is where pointers are
"different" from ints (ie: different length or on non-byte-addressible
machines).  Small C assumes that ints are the same as pointers.

Invocation:
	scc<6809|vax|m68k|8080> filename

There are other options available - see main.c for details.

The code generated by these compilers need a run-time support library
for two things: operations that are "hard" on a particular processor
(eg: 16 bit multiply on an 8080), or O/S interface (vax is BSD 4.1,
6809 is FLEX, 8080 is CPM, never had one for M68k).

Status: the 6809, VAX and 8080 versions work last I checked - a problem or
two may have crept in during the implementation of the compile/assemble/and
link code for machines that support it.  The M68k version has never been
tested.  I don't have a Pyramid version because Pyrcorp seems reluctant
to publish instruction set information.

So you want to write a new coder do you?  Well, it's easy - read the
comments in one of the coders.  You should not have to modify *any* of
the existing files, just write a new codexxx.c file.  Please contact
me if you run into trouble.  I would be greatly interested in any new
coders or bug reports in the compilers.  As far as I am aware, the
major restriction on porting this thing for different targets is that
pointers and integers *must* be the same length, alignment, and be
interchangeable.
SHAR_EOF
if test 2959 -ne "`wc -c < 'README'`"
then
	echo shar: error transmitting "'README'" '(should have been 2959 characters)'
fi
fi
echo shar: extracting "'M_README'" '(550 characters)'
if test -f 'M_README'
then
	echo shar: will not over-write existing file "'M_README'"
else
cat << \SHAR_EOF > 'M_README'
		***  Moderator's README ***

This directory contains the base source code for the smallC compiler
(actually three versions:  the 8080, 6809 and vax code generators are
here also.)

The "includes" directory contains headers which are intended to be included in
user programs - the place where these files reside should be set in the Makefile
as INCDIR.  The directories "6809", "8080", and "vax" contain runtime support
for the respective compilers.  The directory "lib" contains the source code
for some common C library functions (portable ones).
SHAR_EOF
if test 550 -ne "`wc -c < 'M_README'`"
then
	echo shar: error transmitting "'M_README'" '(should have been 550 characters)'
fi
fi
echo shar: extracting "'Makefile'" '(1429 characters)'
if test -f 'Makefile'
then
	echo shar: will not over-write existing file "'Makefile'"
else
cat << \SHAR_EOF > 'Makefile'
#	Requires System V make
#	@(#)Makefile 1.5 86/05/13
.SUFFIXES:	.o .c .c~ .h .h~
.PRECIOUS:	scclib.a
#	You'll probabably want to change these.  These are used by the compilers#	to figure out where the include files should go.
TARGDIR = /u/clewis/lib
INCDIR = "/u/clewis/src/scc/include/"

INSTFLAGS = -DINCDIR=$(INCDIR)
CFLAGS = '$(INSTFLAGS)' -O
AR = ar
ARFLAGS = rv

LIB = scclib.a

FE =	$(LIB)(data.o) \
	$(LIB)(error.o) \
	$(LIB)(expr.o) \
	$(LIB)(function.o) \
	$(LIB)(gen.o) \
	$(LIB)(io.o) \
	$(LIB)(lex.o) \
	$(LIB)(main.o) \
	$(LIB)(preproc.o) \
	$(LIB)(primary.o) \
	$(LIB)(stmt.o) \
	$(LIB)(sym.o) \
	$(LIB)(while.o)

all:	scc8080 sccas09 sccvax sccm68k

$(FE) code8080.o codeas09.o codevax.o codem68k.o: defs.h data.h

install:	all
	mv sccvax scc8080 sccas09 sccm68k $(TARGDIR)

#Alternately, you may have to do an lorder
$(LIB):	$(FE)
	-ranlib $(LIB)
	-ucb ranlib $(LIB)

scc8080:	code8080.o $(LIB)
	$(CC) -o scc8080 $(CFLAGS) $(LIB) code8080.o

sccas09:	codeas09.o $(LIB)
	$(CC) -o sccas09 $(CFLAGS) $(LIB) codeas09.o

sccvax:		codevax.o $(LIB)
	$(CC) -o sccvax $(CFLAGS) $(LIB) codevax.o

sccm68k:	codem68k.o $(LIB)
	$(CC) -o sccm68k $(CFLAGS) $(LIB) codem68k.o

print:
	pr -n defs.h data.h data.c error.c expr.c function.c gen.c \
		io.c lex.c main.c preproc.c primary.c stmt.c \
		sym.c while.c code*.c | lp
clean:
	rm -f $(LIB) code8080.o codeas09.o codevax.o codem68k.o \
		     sccvax scc8080 sccas09 sccm68k
SHAR_EOF
if test 1429 -ne "`wc -c < 'Makefile'`"
then
	echo shar: error transmitting "'Makefile'" '(should have been 1429 characters)'
fi
fi
echo shar: extracting "'Makefile.bsd'" '(1359 characters)'
if test -f 'Makefile.bsd'
then
	echo shar: will not over-write existing file "'Makefile.bsd'"
else
cat << \SHAR_EOF > 'Makefile.bsd'
#	I couldn't get the supplied makefile to work, so I wrote one for
#       BSD systems      - John Nelson, moderator, mod.sources
#
#	You'll probabably want to change these.  These are used by the compilers#	to figure out where the include files should go.
TARGDIR = /u/clewis/lib
INCDIR = "/u/clewis/src/scc/include/"

INSTFLAGS = -DINCDIR=$(INCDIR)
CFLAGS = '$(INSTFLAGS)' -O
AR = ar
ARFLAGS = rv

LIB = scclib.a

FE =	data.o \
	error.o \
	expr.o \
	function.o \
	gen.o \
	io.o \
	lex.o \
	main.o \
	preproc.o \
	primary.o \
	stmt.o \
	sym.o \
	while.o

all:	scc8080 sccas09 sccvax sccm68k

$(FE) code8080.o codeas09.o codevax.o codem68k.o: defs.h data.h

install:	all
	mv sccvax scc8080 sccas09 sccm68k $(TARGDIR)

#Alternately, you may have to do an lorder
$(LIB):	$(FE)
	-rm $@
	ar q $@ $(FE)
	-ranlib $(LIB)

scc8080:	code8080.o $(LIB)
	$(CC) -o scc8080 $(CFLAGS) $(LIB) code8080.o

sccas09:	codeas09.o $(LIB)
	$(CC) -o sccas09 $(CFLAGS) $(LIB) codeas09.o

sccvax:		codevax.o $(LIB)
	$(CC) -o sccvax $(CFLAGS) $(LIB) codevax.o

sccm68k:	codem68k.o $(LIB)
	$(CC) -o sccm68k $(CFLAGS) $(LIB) codem68k.o

print:
	pr -n defs.h data.h data.c error.c expr.c function.c gen.c \
		io.c lex.c main.c preproc.c primary.c stmt.c \
		sym.c while.c code*.c | lp
clean:
	rm -f $(LIB) code8080.o codeas09.o codevax.o codem68k.o \
		     sccvax scc8080 sccas09 sccm68k
SHAR_EOF
if test 1359 -ne "`wc -c < 'Makefile.bsd'`"
then
	echo shar: error transmitting "'Makefile.bsd'" '(should have been 1359 characters)'
fi
fi
echo shar: extracting "'code8080.c'" '(9671 characters)'
if test -f 'code8080.c'
then
	echo shar: will not over-write existing file "'code8080.c'"
else
cat << \SHAR_EOF > 'code8080.c'
/*	File code8080.c: 2.2 (84/08/31,10:05:09) */
/*% cc -O -c %
 *
 */

#include <stdio.h>
#include "defs.h"
#include "data.h"

/*	Define ASNM and LDNM to the names of the assembler and linker
	respectively */

/*
 *	Some predefinitions:
 *
 *	INTSIZE is the size of an integer in the target machine
 *	BYTEOFF is the offset of an byte within an integer on the
 *		target machine. (ie: 8080,pdp11 = 0, 6809 = 1,
 *		360 = 3)
 *	This compiler assumes that an integer is the SAME length as
 *	a pointer - in fact, the compiler uses INTSIZE for both.
 */
#define	INTSIZE	2
#define	BYTEOFF	0

/*
 *	print all assembler info before any code is generated
 *
 */
header ()
{
	outstr (";	Small C 8080;\n;\tCoder (2.4,84/11/27)\n;");
	FEvers();
	nl ();
	ol ("extrn	?gchar,?gint,?pchar,?pint,?bool");
	ol ("extrn	?sxt");
	ol ("extrn	?or,?and,?xor");
	ol ("extrn	?eq,?ne,?gt,?le,?ge,?lt,?uge,?ult,?ugt,?ule");
	ol ("extrn	?asr,?asl");
	ol ("extrn	?sub,?neg,?com,?lneg,?mul,?div");
	ol ("extrn	?case");
}

nl ()
{
	outbyte (EOL);
}
initmac()
{
	defmac("cpm\t1");
	defmac("I8080\t1");
	defmac("RMAC\t1");
	defmac("smallc\t1");
}

galign(t)
int	t;
{
	return(t);
}

/*
 *	return size of an integer
 */
intsize() {
	return(INTSIZE);
}

/*
 *	return offset of ls byte within word
 *	(ie: 8080 & pdp11 is 0, 6809 is 1, 360 is 3)
 */
byteoff() {
	return(BYTEOFF);
}

/*
 *	Output internal generated label prefix
 */
olprfix() {
	outbyte('?');
}

/*
 *	Output a label definition terminator
 */
col ()
{
	outbyte (58);
}

/*
 *	begin a comment line for the assembler
 *
 */
comment ()
{
	outbyte (';');
}

/*
 *	Emit user label prefix
 */
prefix ()
{
}


/*
 *	print any assembler stuff needed after all code
 *
 */
trailer ()
{
	ol ("end");
}

/*
 *	function prologue
 */
prologue ()
{
}

/*
 *	text (code) segment
 */
gtext ()
{
	ol ("cseg");
}

/*
 *	data segment
 */
gdata ()
{
	ol ("dseg");
}

/*
 *  Output the variable symbol at scptr as an extrn or a public
 */
ppubext(scptr) char *scptr; {
	if (cptr[STORAGE] == STATIC) return;
	ot (scptr[STORAGE] == EXTERN ? "extrn\t" : "public\t");
	prefix ();
	outstr (scptr);
	nl();
}

/*
 * Output the function symbol at scptr as an extrn or a public
 */
fpubext(scptr) char *scptr; {
	if (scptr[STORAGE] == STATIC) return;
	ot (scptr[OFFSET] == FUNCTION ? "public\t" : "extrn\t");
	prefix ();
	outstr (scptr);
	nl ();
}

/*
 *  Output a decimal number to the assembler file
 */
onum(num) int num; {
	outdec(num);	/* pdp11 needs a "." here */
}


/*
 *	fetch a static memory cell into the primary register
 */
getmem (sym)
char	*sym;
{
	if ((sym[IDENT] != POINTER) & (sym[TYPE] == CCHAR)) {
		ot ("lda\t");
		outstr (sym + NAME);
		nl ();
		gcall ("?sxt");
	} else {
		ot ("lhld\t");
		outstr (sym + NAME);
		nl ();
	}
}

/*
 *	fetch the address of the specified symbol into the primary register
 *
 */
getloc (sym)
char	*sym;
{
	immed ();
	if (sym[STORAGE] == LSTATIC) {
		printlabel(glint(sym));
		nl();
	} else {
		outdec (glint(sym) - stkp);
		nl ();
		ol ("dad\tsp");
	}
}

/*
 *	store the primary register into the specified static memory cell
 *
 */
putmem (sym)
char	*sym;
{
	if ((sym[IDENT] != POINTER) & (sym[TYPE] == CCHAR)) {
		ol ("mov\ta,l");
		ot ("sta\t");
	} else
		ot ("shld\t");
	outstr (sym + NAME);
	nl ();
}

/*
 *	store the specified object type in the primary register
 *	at the address on the top of the stack
 *
 */
putstk (typeobj)
char	typeobj;
{
	gpop ();
	if (typeobj == CCHAR)
		gcall ("?pchar");
	else
		gcall ("?pint");
}

/*
 *	fetch the specified object type indirect through the primary
 *	register into the primary register
 *
 */
indirect (typeobj)
char	typeobj;
{
	if (typeobj == CCHAR)
		gcall ("?gchar");
	else
		gcall ("?gint");
}

/*
 *	swap the primary and secondary registers
 *
 */
swap ()
{
	ol ("xchg");
}

/*
 *	print partial instruction to get an immediate value into
 *	the primary register
 *
 */
immed ()
{
	ot ("lxi\th,");
}

/*
 *	push the primary register onto the stack
 *
 */
gpush ()
{
	ol ("push\th");
	stkp = stkp - INTSIZE;
}

/*
 *	pop the top of the stack into the secondary register
 *
 */
gpop ()
{
	ol ("pop\td");
	stkp = stkp + INTSIZE;
}

/*
 *	swap the primary register and the top of the stack
 *
 */
swapstk ()
{
	ol ("xthl");
}

/*
 *	call the specified subroutine name
 *
 */
gcall (sname)
char	*sname;
{
	ot ("call\t");
	outstr (sname);
	nl ();
}

/*
 *	return from subroutine
 *
 */
gret ()
{
	ol ("ret");
}

/*
 *	perform subroutine call to value on top of stack
 *
 */
callstk ()
{
	immed ();
	outstr ("$+5");
	nl ();
	swapstk ();
	ol ("pchl");
	stkp = stkp + INTSIZE;
}

/*
 *	jump to specified internal label number
 *
 */
jump (label)
int	label;
{
	ot ("jmp\t");
	printlabel (label);
	nl ();
}

/*
 *	test the primary register and jump if false to label
 *
 */
testjump (label, ft)
int	label,
	ft;
{
	ol ("mov\ta,h");
	ol ("ora\tl");
	if (ft)
		ot ("jnz\t");
	else
		ot ("jz\t");
	printlabel (label);
	nl ();
}

/*
 *	print pseudo-op  to define a byte
 *
 */
defbyte ()
{
	ot ("db\t");
}

/*
 *	print pseudo-op to define storage
 *
 */
defstorage ()
{
	ot ("ds\t");
}

/*
 *	print pseudo-op to define a word
 *
 */
defword ()
{
	ot ("dw\t");
}

/*
 *	modify the stack pointer to the new value indicated
 *
 */
modstk (newstkp)
int	newstkp;
{
	int	k;

	k = galign(newstkp - stkp);
	if (k == 0)
		return (newstkp);
	if (k > 0) {
		if (k < 7) {
			if (k & 1) {
				ol ("inx\tsp");
				k--;
			}
			while (k) {
				ol ("pop\tb");
				k = k - INTSIZE;
			}
			return (newstkp);
		}
	} else {
		if (k > -7) {
			if (k & 1) {
				ol ("dcx\tsp");
				k++;
			}
			while (k) {
				ol ("push\tb");
				k = k + INTSIZE;
			}
			return (newstkp);
		}
	}
	swap ();
	immed ();
	outdec (k);
	nl ();
	ol ("dad\tsp");
	ol ("sphl");
	swap ();
	return (newstkp);
}

/*
 *	multiply the primary register by INTSIZE
 */
gaslint ()
{
	ol ("dad\th");
}

/*
 *	divide the primary register by INTSIZE
 */
gasrint()
{
	gpush();	/* push primary in prep for gasr */
	immed ();
	onum (1);
	nl ();
	gasr ();  /* divide by two */
}

/*
 *	Case jump instruction
 */
gjcase() {
	ot ("jmp\t?case");
	nl ();
}

/*
 *	add the primary and secondary registers
 *	if lval2 is int pointer and lval is not, scale lval
 */
gadd (lval,lval2) int *lval,*lval2;
{
	gpop ();
	if (dbltest (lval2, lval)) {
		swap ();
		gaslint ();
		swap ();
	}
	ol ("dad\td");
}

/*
 *	subtract the primary register from the secondary
 *
 */
gsub ()
{
	gpop ();
	gcall ("?sub");
}

/*
 *	multiply the primary and secondary registers
 *	(result in primary)
 *
 */
gmult ()
{
	gpop();
	gcall ("?mul");
}

/*
 *	divide the secondary register by the primary
 *	(quotient in primary, remainder in secondary)
 *
 */
gdiv ()
{
	gpop();
	gcall ("?div");
}

/*
 *	compute the remainder (mod) of the secondary register
 *	divided by the primary register
 *	(remainder in primary, quotient in secondary)
 *
 */
gmod ()
{
	gdiv ();
	swap ();
}

/*
 *	inclusive 'or' the primary and secondary registers
 *
 */
gor ()
{
	gpop();
	gcall ("?or");
}

/*
 *	exclusive 'or' the primary and secondary registers
 *
 */
gxor ()
{
	gpop();
	gcall ("?xor");
}

/*
 *	'and' the primary and secondary registers
 *
 */
gand ()
{
	gpop();
	gcall ("?and");
}

/*
 *	arithmetic shift right the secondary register the number of
 *	times in the primary register
 *	(results in primary register)
 *
 */
gasr ()
{
	gpop();
	gcall ("?asr");
}

/*
 *	arithmetic shift left the secondary register the number of
 *	times in the primary register
 *	(results in primary register)
 *
 */
gasl ()
{
	gpop ();
	gcall ("?asl");
}

/*
 *	two's complement of primary register
 *
 */
gneg ()
{
	gcall ("?neg");
}

/*
 *	logical complement of primary register
 *
 */
glneg ()
{
	gcall ("?lneg");
}

/*
 *	one's complement of primary register
 *
 */
gcom ()
{
	gcall ("?com");
}

/*
 *	Convert primary value into logical value (0 if 0, 1 otherwise)
 *
 */
gbool ()
{
	gcall ("?bool");
}

/*
 *	increment the primary register by 1 if char, INTSIZE if
 *      int
 */
ginc (lval) int lval[];
{
	ol ("inx\th");
	if (lval[2] == CINT)
		ol ("inx\th");
}

/*
 *	decrement the primary register by one if char, INTSIZE if
 *	int
 */
gdec (lval) int lval[];
{
	ol ("dcx\th");
	if (lval[2] == CINT)
		ol("dcx\th");
}

/*
 *	following are the conditional operators.
 *	they compare the secondary register against the primary register
 *	and put a literl 1 in the primary if the condition is true,
 *	otherwise they clear the primary register
 *
 */

/*
 *	equal
 *
 */
geq ()
{
	gpop();
	gcall ("?eq");
}

/*
 *	not equal
 *
 */
gne ()
{
	gpop();
	gcall ("?ne");
}

/*
 *	less than (signed)
 *
 */
glt ()
{
	gpop();
	gcall ("?lt");
}

/*
 *	less than or equal (signed)
 *
 */
gle ()
{
	gpop();
	gcall ("?le");
}

/*
 *	greater than (signed)
 *
 */
ggt ()
{
	gpop();
	gcall ("?gt");
}

/*
 *	greater than or equal (signed)
 *
 */
gge ()
{
	gpop();
	gcall ("?ge");
}

/*
 *	less than (unsigned)
 *
 */
gult ()
{
	gpop();
	gcall ("?ult");
}

/*
 *	less than or equal (unsigned)
 *
 */
gule ()
{
	gpop();
	gcall ("?ule");
}

/*
 *	greater than (unsigned)
 *
 */
gugt ()
{
	gpop();
	gcall ("?ugt");
}

/*
 *	greater than or equal (unsigned)
 *
 */
guge ()
{
	gpop();
	gcall ("?uge");
}

inclib() {
#ifdef	cpm
	return("B:");
#endif
#ifdef	unix
	return(INCDIR);
#endif
}

/*	Squirrel away argument count in a register that modstk
	doesn't touch.
*/

gnargs(d)
int	d; {
	ot ("mvi\ta,");
	onum(d);
	nl ();
}

assemble(s)
char	*s; {
#ifdef	ASNM
	char buf[100];
	strcpy(buf, ASNM);
	strcat(buf, " ");
	strcat(buf, s);
	buf[strlen(buf)-1] = 's';
	return(system(buf));
#else
	return(0);
#endif
}

link() {
#ifdef	LDNM
	fputs("I don't know how to link files yet\n", stderr);
#else
	return(0);
#endif
}
SHAR_EOF
if test 9671 -ne "`wc -c < 'code8080.c'`"
then
	echo shar: error transmitting "'code8080.c'" '(should have been 9671 characters)'
fi
fi
echo shar: extracting "'codeas09.c'" '(9534 characters)'
if test -f 'codeas09.c'
then
	echo shar: will not over-write existing file "'codeas09.c'"
else
cat << \SHAR_EOF > 'codeas09.c'
/*	File codeas09.c: 2.2 (84/08/31,10:05:13) */
/*% cc -O -c %
 *
 */

#include <stdio.h>
#include "defs.h"
#include "data.h"

/*	Define ASNM and LDNM to the names of the assembler and linker
	respectively */

/*
 *	Some predefinitions:
 *
 *	INTSIZE is the size of an integer in the target machine
 *	BYTEOFF is the offset of an byte within an integer on the
 *		target machine. (ie: 8080,pdp11 = 0, 6809 = 1,
 *		360 = 3)
 *	This compiler assumes that an integer is the SAME length as
 *	a pointer - in fact, the compiler uses INTSIZE for both.
 */
#define	INTSIZE	2
#define	BYTEOFF	1

/*
 *	print all assembler info before any code is generated
 *
 */
header ()
{
	outstr("|\tSmall C MC6809\n|\tCoder (2.4,84/11/27)\n|");
	FEvers();
	nl ();
	ol (".globl\tsmul,sdiv,smod,asr,asl,neg,lneg,case");
	ol (".globl\teq,ne,lt,le,gt,ge,ult,ule,ugt,uge,bool");
}
nl ()
{
	outbyte (EOL);
}

initmac() {
	defmac("mc6809\t1");
	defmac("mitas09\t1");
	defmac("smallc\t1");
}

galign(t)
int t;
{
	return (t);
}


/*
 *	return size of an integer
 */
intsize() {
	return(INTSIZE);
}

/*
 *	return offset of ls byte within word
 *	(ie: 8080 & pdp11 is 0, 6809 is 1, 360 is 3)
 */
byteoff() {
	return(BYTEOFF);
}

/*
 *	Output internal generated label prefix
 */
olprfix() {
	outstr("LL");
}

/*
 *	Output a label definition terminator
 */
col ()
{
	outstr ("=.\n");
}

/*
 *	begin a comment line for the assembler
 *
 */
comment ()
{
	outbyte ('|');
}

/*
 *	Output a prefix in front of user labels
 */
prefix () {
	outbyte ('_');
}


/*
 *	print any assembler stuff needed after all code
 *
 */
trailer ()
{
	ol (".end");
}

/*
 *	function prologue
 */
prologue ()
{
}

/*
 *	text (code) segment
 */
gtext ()
{
	ol (".text");
}

/*
 *	data segment
 */
gdata ()
{
	ol (".data");
}

/*
 *  Output the variable symbol at scptr as an extrn or a public
 */
ppubext(scptr) char *scptr; {
	if (scptr[STORAGE] == STATIC) return;
	ot (".globl\t");
	prefix ();
	outstr (scptr);
	nl();
}

/*
 * Output the function symbol at scptr as an extrn or a public
 */
fpubext(scptr) char *scptr; {
	ppubext(scptr);
}

/*
 *  Output a decimal number to the assembler file
 */
onum(num) int num; {
	outdec(num);	/* pdp11 needs a "." here */
	outbyte('.');
}


/*
 *	fetch a static memory cell into the primary register
 */
getmem (sym)
char	*sym;
{
	if ((sym[IDENT] != POINTER) & (sym[TYPE] == CCHAR)) {
		ot ("ldb\t");
		prefix ();
		outstr (sym + NAME);
		nl ();
		ot ("sex");
		nl ();
	} else {
		ot ("ldd\t");
		prefix ();
		outstr (sym + NAME);
		nl ();
	}
}

/*
 *	fetch the address of the specified symbol into the primary register
 *
 */
getloc (sym)
char	*sym;
{
	if (sym[STORAGE] == LSTATIC) {
		immed();
		printlabel(glint(sym));
		nl();
	} else {
		ot ("leay\t");
		onum (glint(sym) - stkp);
		outstr ("(s)\n\ttfr\ty,d\n");
	}
}

/*
 *	store the primary register into the specified static memory cell
 *
 */
putmem (sym)
char	*sym;
{
	if ((sym[IDENT] != POINTER) & (sym[TYPE] == CCHAR)) {
		ot ("stb\t");
	} else
		ot ("std\t");
	prefix ();
	outstr (sym + NAME);
	nl ();
}

/*
 *	store the specified object type in the primary register
 *	at the address on the top of the stack
 *
 */
putstk (typeobj)
char	typeobj;
{
	if (typeobj == CCHAR)
		ol ("stb\t@(s)++");
	else
		ol ("std\t@(s)++");
	stkp = stkp + INTSIZE;
}

/*
 *	fetch the specified object type indirect through the primary
 *	register into the primary register
 *
 */
indirect (typeobj)
char	typeobj;
{
	ol("tfr\td,y");
	if (typeobj == CCHAR)
		ol ("ldb\t(y)\n\tsex");
	else
		ol ("ldd\t(y)");
}

/*
 *	swap the primary and secondary registers
 *
 */
swap ()
{
	ol ("exg\td,x");
}

/*
 *	print partial instruction to get an immediate value into
 *	the primary register
 *
 */
immed ()
{
	ot ("ldd\t#");
}

/*
 *	push the primary register onto the stack
 *
 */
gpush ()
{
	ol ("pshs\td");
	stkp = stkp - INTSIZE;
}

/*
 *	pop the top of the stack into the secondary register
 *
 */
gpop ()
{
	ol ("puls\td");
	stkp = stkp + INTSIZE;
}

/*
 *	swap the primary register and the top of the stack
 *
 */
swapstk ()
{
	ol ("ldy\t(s)\nstd\t(s)\n\ttfr\ty,d");
}

/*
 *	call the specified subroutine name
 *
 */
gcall (sname)
char	*sname;
{
	ot ("jsr\t");
	if (*sname == '^')
		outstr (++sname);
	else {
		prefix ();
		outstr (sname);
	}
	nl ();
}

/*
 *	return from subroutine
 *
 */
gret ()
{
	ol ("rts");
}

/*
 *	perform subroutine call to value on top of stack
 *
 */
callstk ()
{
	gpop();
	ol ("jsr\t(x)");
}

/*
 *	jump to specified internal label number
 *
 */
jump (label)
int	label;
{
	ot ("lbra\t");
	printlabel (label);
	nl ();
}

/*
 *	test the primary register and jump if false to label
 *
 */
testjump (label, ft)
int	label,
	ft;
{
	ol ("cmpd\t#0");
	if (ft)
		ot ("lbne\t");
	else
		ot ("lbeq\t");
	printlabel (label);
	nl ();
}

/*
 *	print pseudo-op  to define a byte
 *
 */
defbyte ()
{
	ot (".byte\t");
}

/*
 *	print pseudo-op to define storage
 *
 */
defstorage ()
{
	ot (".blkb\t");
}

/*
 *	print pseudo-op to define a word
 *
 */
defword ()
{
	ot (".word\t");
}

/*
 *	modify the stack pointer to the new value indicated
 *
 */
modstk (newstkp)
int	newstkp;
{
	int	k;

	k = galign(newstkp - stkp);
	if (k == 0)
		return (newstkp);
	ot ("leas\t");
	onum (k);
	outstr ("(s)\n");
	return (newstkp);
}

/*
 *	multiply the primary register by INTSIZE
 */
gaslint ()
{
	ol ("aslb\n\trola");
}

/*
 *	divide the primary register by INTSIZE
 */
gasrint()
{
	ol ("asra\n\trorb");
}

/*
 *	Case jump instruction
 */
gjcase() {
	ot ("jmp\tcase");
	nl ();
}

/*
 *	add the primary and secondary registers
 *	if lval2 is int pointer and lval is int, scale lval
 */
gadd (lval, lval2) int *lval, *lval2;
{
	if (dbltest (lval2, lval)) {
		ol ("asl\t1(s)\n\trol\t(s)");
	}
	ol ("addd\t(s)++");
	stkp = stkp + INTSIZE;
}

/*
 *	subtract the primary register from the secondary
 *
 */
gsub ()
{
	ol ("subd\t(s)++\n\tcoma\n\tcomb\n\taddd\t#1");
	stkp = stkp + INTSIZE;
}

/*
 *	multiply the primary and secondary registers
 *	(result in primary)
 *
 */
gmult ()
{
	gcall ("^smul");
	stkp = stkp + INTSIZE;
}

/*
 *	divide the secondary register by the primary
 *	(quotient in primary, remainder in secondary)
 *
 */
gdiv ()
{
	gcall ("^sdiv");
	stkp = stkp + INTSIZE;
}

/*
 *	compute the remainder (mod) of the secondary register
 *	divided by the primary register
 *	(remainder in primary, quotient in secondary)
 *
 */
gmod ()
{
	gcall ("^smod");
	stkp = stkp + INTSIZE;
}

/*
 *	inclusive 'or' the primary and secondary registers
 *
 */
gor ()
{
	ol ("ora\t(s)+\n\torb\t(s)+");
	stkp = stkp + INTSIZE;
}

/*
 *	exclusive 'or' the primary and secondary registers
 *
 */
gxor ()
{
	ol ("eora\t(s)+\n\teorb\t(s)+");
	stkp = stkp + INTSIZE;
}

/*
 *	'and' the primary and secondary registers
 *
 */
gand ()
{
	ol ("anda\t(s)+\n\tandb\t(s)+");
	stkp = stkp + INTSIZE;
}

/*
 *	arithmetic shift right the secondary register the number of
 *	times in the primary register
 *	(results in primary register)
 *
 */
gasr ()
{
	gcall ("^asr");
	stkp = stkp + INTSIZE;
}

/*
 *	arithmetic shift left the secondary register the number of
 *	times in the primary register
 *	(results in primary register)
 *
 */
gasl ()
{
	gcall ("^asl");
	stkp = stkp + INTSIZE;
}

/*
 *	two's complement of primary register
 *
 */
gneg ()
{
	gcall ("^neg");
}

/*
 *	logical complement of primary register
 *
 */
glneg ()
{
	gcall ("^lneg");
}

/*
 *	one's complement of primary register
 *
 */
gcom ()
{
	ol ("coma\n\tcomb");
}

/*
 *	convert primary register into logical value
 *
 */
gbool ()
{
	gcall ("^bool");
}
/*
 *	increment the primary register by 1 if char, INTSIZE if
 *      int
 */
ginc (lval) int lval[];
{
	if (lval[2] == CINT)
		ol ("addd\t#2");
	else
		ol ("addd\t#1");
}

/*
 *	decrement the primary register by one if char, INTSIZE if
 *	int
 */
gdec (lval) int lval[];
{
	if (lval[2] == CINT)
		ol ("subd\t#2");
	else
		ol ("subd\t#1");
}

/*
 *	following are the conditional operators.
 *	they compare the secondary register against the primary register
 *	and put a literl 1 in the primary if the condition is true,
 *	otherwise they clear the primary register
 *
 */

/*
 *	equal
 *
 */
geq ()
{
	gcall ("^eq");
	stkp = stkp + INTSIZE;
}

/*
 *	not equal
 *
 */
gne ()
{
	gcall ("^ne");
	stkp = stkp + INTSIZE;
}

/*
 *	less than (signed)
 *
 */
glt ()
{
	gcall ("^lt");
	stkp = stkp + INTSIZE;
}
/*
 *	less than or equal (signed)
 *
 */
gle ()
{
	gcall ("^le");
	stkp = stkp + INTSIZE;
}

/*
 *	greater than (signed)
 *
 */
ggt ()
{
	gcall ("^gt");
	stkp = stkp + INTSIZE;
}

/*
 *	greater than or equal (signed)
 *
 */
gge ()
{
	gcall ("^ge");
	stkp = stkp + INTSIZE;
}

/*
 *	less than (unsigned)
 *
 */
gult ()
{
	gcall ("^ult");
	stkp = stkp + INTSIZE;
}

/*
 *	less than or equal (unsigned)
 *
 */
gule ()
{
	gcall ("^ule");
	stkp = stkp + INTSIZE;
}

/*
 *	greater than (unsigned)
 *
 */
gugt ()
{
	gcall ("^ugt");
	stkp = stkp + INTSIZE;
}

/*
 *	greater than or equal (unsigned)
 *
 */
guge ()
{
	gcall ("^uge");
	stkp = stkp + INTSIZE;
}

inclib() {
#ifdef	flex
	return("B.");
#endif
#ifdef	unix
	return(INCDIR);
#endif
#ifdef	cpm
	return("B:");
#endif
}

/*	Squirrel away argument count in a register that modstk/getloc/stloc
	doesn't touch.
*/

gnargs(d)
int	d; {
	ot ("ldu\t#");
	onum(d);
	nl ();
}

assemble(s)
char	*s; {
#ifdef	ASNM
	char buf[100];
	strcpy(buf, ASNM);
	strcat(buf, " ");
	strcat(buf, s);
	buf[strlen(buf)-1] = 's';
	return(system(buf));
#else
	return(0);
#endif
}

link() {
#ifdef	LDNM
	fputs("I don't know how to link files yet\n", stderr);
#else
	return(0);
#endif
}
SHAR_EOF
if test 9534 -ne "`wc -c < 'codeas09.c'`"
then
	echo shar: error transmitting "'codeas09.c'" '(should have been 9534 characters)'
fi
fi
echo shar: extracting "'codem68k.c'" '(11259 characters)'
if test -f 'codem68k.c'
then
	echo shar: will not over-write existing file "'codem68k.c'"
else
cat << \SHAR_EOF > 'codem68k.c'
/*	File codem68k.c: 1.2 (84/11/28,10:15:09) */
/*% cc -O -c %
 *
 */

#include <stdio.h>
#include "defs.h"
#include "data.h"

#ifdef	unix
#ifdef	m68k
#define	ASNM	"as -o "
#define	LDNM	"ld -o a.out /lib/crt0.o "
#endif
#ifdef	pyr
#define	ASNM	"/u1/cx/bin/m68kas -o "
#define	LDNM	"/u1/cx/bin/m68kld -o a.out /u1/cx/lib/m68kcrt0.o "
#endif
#endif

int	needr0;
int	needh;
/*
 *	Some predefinitions:
 *
 *	INTSIZE is the size of an integer in the target machine
 *	BYTEOFF is the offset of an byte within an integer on the
 *		target machine. (ie: 8080,pdp11 = 0, 6809 = 1,
 *		360 = 3)
 *	This compiler assumes that an integer is the SAME length as
 *	a pointer - in fact, the compiler uses INTSIZE for both.
 */
#define	INTSIZE	4
#define	BYTEOFF	3

/*
 *	print all assembler info before any code is generated
 *
 */
header ()
{
	outstr("#\tSmall C M68000\n#\tCoder (1.2,84/11/28)\n#");
	FEvers();
	nl ();
	ol ("global\tTlneg");
	ol ("global\tTcase");
	ol ("global\tTeq");
	ol ("global\tTne");
	ol ("global\tTlt");
	ol ("global\tTle");
	ol ("global\tTgt");
	ol ("global\tTge");
	ol ("global\tTult");
	ol ("global\tTule");
	ol ("global\tTugt");
	ol ("global\tTuge");
	ol ("global\tTbool");
	ol ("global\tTmult");
	ol ("global\tTdiv");
	ol ("global\tTmod");
}

nl()
{
	if (needh) {
		ol ("word\t0");
		needh = 0;
	}
	if (needr0) {
		needr0 = 0;
		outstr(",%d0");
	}
	outbyte(EOL);
}

initmac() {
	defmac("m68k\t1");
	defmac("unix\t1");
	defmac("smallc\t1");
}

galign(t)
int t;
{
	int sign;
	if (t < 0) {
		sign = 1;
		t = -t;
	} else
		sign = 0;
	t = (t + INTSIZE - 1) & ~(INTSIZE - 1);
	t = sign? -t: t;
	return (t);
}



/*
 *	return size of an integer
 */
intsize() {
	return(INTSIZE);
}

/*
 *	return offset of ls byte within word
 *	(ie: 8080 & pdp11 is 0, 6809 is 1, 360 is 3)
 */
byteoff() {
	return(BYTEOFF);
}

/*
 *	Output internal generated label prefix
 */
olprfix() {
	outstr("LL");
}

/*
 *	Output a label definition terminator
 */
col ()
{
	outstr (":\n");
}

/*
 *	begin a comment line for the assembler
 *
 */
comment ()
{
	outbyte ('#');
}

/*
 *	Output a prefix in front of user labels
 */
prefix () {
/*	outbyte ('_'); */
}


/*
 *	print any assembler stuff needed after all code
 *
 */
trailer ()
{
}

/*
 *	function prologue
 */
prologue ()
{
	/* this is where we'd put splimit stuff */
}

/*
 *	text (code) segment
 */
gtext ()
{
	ol ("text");
}

/*
 *	data segment
 */
gdata ()
{
	ol ("data");
}

/*
 *  Output the variable symbol at scptr as an extrn or a public
 */
ppubext(scptr) char *scptr; {
	if (scptr[STORAGE] == STATIC) return;
	ot ("global\t");
	prefix ();
	outstr (scptr);
	nl();
}

/*
 * Output the function symbol at scptr as an extrn or a public
 */
fpubext(scptr) char *scptr; {
	ppubext(scptr);
}

/*
 *  Output a decimal number to the assembler file
 */
onum(num) int num; {
	outdec(num);	/* pdp11 needs a "." here */
}


/*
 *	fetch a static memory cell into the primary register
 */
getmem (sym)
char	*sym;
{
	int ischr;
	if ((sym[IDENT] != POINTER) & (sym[TYPE] == CCHAR)) {
		ischr = 1;
		ot ("mov.b\t");
		prefix ();
		outstr (sym + NAME);
	} else {
		ischr = 0;
		ot ("mov.l\t");
		prefix ();
		outstr (sym + NAME);
	}
	outstr(",%d0\n");
	if (ischr)
		ol ("ext.b\t%d0");
}

/*
 *	fetch the address of the specified symbol into the primary register
 *
 */
getloc (sym)
char	*sym;
{
	if (sym[STORAGE] == LSTATIC) {
		immed();
		printlabel(glint(sym));
		nl();
	} else {
		ot ("lea.l\t");
		onum (glint(sym) - stkp);
		outstr (",%a0\n");
		ol ("mov.l\t%a0,%d0");
	}
}

/*
 *	store the primary register into the specified static memory cell
 *
 */
putmem (sym)
char	*sym;
{
	if ((sym[IDENT] != POINTER) & (sym[TYPE] == CCHAR)) {
		ot ("mov.b\t%d0,");
	} else
		ot ("mov.l\t%d0,");
	prefix ();
	outstr (sym + NAME);
	nl ();
}

/*
 *	store the specified object type in the primary register
 *	at the address on the top of the stack
 *
 */
putstk (typeobj)
char	typeobj;
{
	ol ("mov.l\t(%sp)+,%a0");
	if (typeobj == CCHAR)
		ol ("mov.b\t%d0,(%a0)");
	else
		ol ("mov.l\t%d0,(%a0)");
	stkp = stkp + INTSIZE;
}

/*
 *	fetch the specified object type indirect through the primary
 *	register into the primary register
 *
 */
indirect (typeobj)
char	typeobj;
{
	ol ("mov.l\t%d0,%a0");
	if (typeobj == CCHAR)
		ol ("mov.b\t(%a0),%d0");
	else
		ol ("mov.l\t(%a0),%d0");
}

/*
 *	swap the primary and secondary registers
 *
 */
swap ()
{
	ol ("mov.l\t%d0,%d2\n\tmov.l\t%d1,%d0\n\tmov.l\t%d2,%d1");
}

/*
 *	print partial instruction to get an immediate value into
 *	the primary register
 *
 */
immed ()
{
	ot ("mov.l\t&");
	needr0 = 1;
}

/*
 *	push the primary register onto the stack
 *
 */
gpush ()
{
	ol ("mov.l\t%d0,-(%sp)");
	stkp = stkp - INTSIZE;
}

/*
 *	pop the top of the stack into the secondary register
 *
 */
gpop ()
{
	ol ("mov.l\t(%sp)+,%d1");
	stkp = stkp + INTSIZE;
}

/*
 *	swap the primary register and the top of the stack
 *
 */
swapstk ()
{
	ol ("mov.l\t(%sp)+,%d2\nmov.l\t%d0,-(%sp)\nmov.l\t%d2,%d0");
}

/*
 *	call the specified subroutine name
 *
 */
gcall (sname)
char	*sname;
{
	if (*sname == '^') {
		ot ("jsr\tT");
		outstr (++sname);
	} else {
		ot ("jsr\t");
		prefix ();
		outstr (sname);
	}
	nl ();
}

/*
 *	return from subroutine
 *
 */
gret ()
{
	ol ("rts");
}

/*
 *	perform subroutine call to value on top of stack
 *
 */
callstk ()
{
	ol ("jsr\t(%sp)+");
	stkp = stkp + INTSIZE;
}

/*
 *	jump to specified internal label number
 *
 */
jump (label)
int	label;
{
	ot ("jmp\t");
	printlabel (label);
	nl ();
}

/*
 *	test the primary register and jump if false to label
 *
 */
testjump (label, ft)
int	label,
	ft;
{
	ol ("cmp.l\t%d0,&0");
	if (ft)
		ot ("beq\t");
	else
		ot ("bne\t");
	printlabel (label);
	nl ();
}

/*
 *	print pseudo-op  to define a byte
 *
 */
defbyte ()
{
	ot ("byte\t");
}

/*
 *	print pseudo-op to define storage
 *
 */
defstorage ()
{
	ot ("space\t");
}

/*
 *	print pseudo-op to define a word
 *
 */
defword ()
{
	ot ("long\t");
}

/*
 *	modify the stack pointer to the new value indicated
 *
 */
modstk (newstkp)
int	newstkp;
{
	int	k;

	k = newstkp - stkp;
	if (k % INTSIZE)
		error("Bad stack alignment (compiler error)");
	if (k == 0)
		return (newstkp);
	ot ("add.l\t&");
	onum (k);
	outstr (",sp");
	nl();
	return (newstkp);
}

/*
 *	multiply the primary register by INTSIZE
 */
gaslint ()
{
	ol ("asl.l\t&2,%d0");
}

/*
 *	divide the primary register by INTSIZE
 */
gasrint()
{
	ol ("asr.l\t&2,%d0");
}

/*
 *	Case jump instruction
 */
gjcase() {
	gcall ("^case");
}

/*
 *	add the primary and secondary registers
 *	if lval2 is int pointer and lval is int, scale lval
 */
gadd (lval, lval2) int *lval, *lval2;
{
	if (dbltest (lval2, lval)) {
		ol ("asl.l\t&2,(%sp)");
	}
	ol ("add.l\t(%sp)+,%d0");
	stkp = stkp + INTSIZE;
}

/*
 *	subtract the primary register from the secondary
 *
 */
gsub ()
{
	ol ("mov.l\t(%sp)+,%d2");
	ol ("sub.l\t%d0,%d2");
	ol ("mov.l\t%d2,%d0");
	stkp = stkp + INTSIZE;
}

/*
 *	multiply the primary and secondary registers
 *	(result in primary)
 *
 */
gmult ()
{
	gcall ("^mult");
	stkp = stkp + INTSIZE;
}

/*
 *	divide the secondary register by the primary
 *	(quotient in primary, remainder in secondary)
 *
 */
gdiv ()
{
	gcall ("^div");
	stkp = stkp + INTSIZE;
}

/*
 *	compute the remainder (mod) of the secondary register
 *	divided by the primary register
 *	(remainder in primary, quotient in secondary)
 *
 */
gmod ()
{
	gcall ("^mod");
	stkp = stkp + INTSIZE;
}

/*
 *	inclusive 'or' the primary and secondary registers
 *
 */
gor ()
{
	ol ("or.l\t(%sp)+,%d0");
	stkp = stkp + INTSIZE;
}

/*
 *	exclusive 'or' the primary and secondary registers
 *
 */
gxor ()
{
	ol ("mov.l\t(%sp)+,%d1");
	ol ("eor.l\t%d1,%d0");
	stkp = stkp + INTSIZE;
}

/*
 *	'and' the primary and secondary registers
 *
 */
gand ()
{
	ol ("and.l\t(%sp)+,%d0");
	stkp = stkp + INTSIZE;
}

/*
 *	arithmetic shift right the secondary register the number of
 *	times in the primary register
 *	(results in primary register)
 *
 */
gasr ()
{
	ol ("mov.l\t(%sp)+,%d1");
	ol ("asr.l\t%d0,%d1");
	ol ("mov.l\t%d1,%d0");
	stkp = stkp + INTSIZE;
}

/*
 *	arithmetic shift left the secondary register the number of
 *	times in the primary register
 *	(results in primary register)
 *
 */
gasl ()
{
	ol ("mov.l\t(%sp)+,%d1");
	ol ("asl.l\t%d0,%d1");
	ol ("mov.l\t%d1,%d0");
	stkp = stkp + INTSIZE;
}

/*
 *	two's complement of primary register
 *
 */
gneg ()
{
	ol ("neg.l\t%d0");
}

/*
 *	logical complement of primary register
 *
 */
glneg ()
{
	gcall ("^lneg");
}

/*
 *	one's complement of primary register
 *
 */
gcom ()
{
	ol ("not\t%d0");
}

/*
 *	convert primary register into logical value
 *
 */
gbool ()
{
	gcall ("^bool");
}
/*
 *	increment the primary register by 1 if char, INTSIZE if
 *      int
 */
ginc (lval) int lval[];
{
	if (lval[2] == CINT)
		ol ("addq.l\t&4,%d0");
	else
		ol ("addq.l\t&1,%d0");
}

/*
 *	decrement the primary register by one if char, INTSIZE if
 *	int
 */
gdec (lval) int lval[];
{
	if (lval[2] == CINT)
		ol ("subq.l\t&4,%d0");
	else
		ol ("subq.l\t&1,%d0");
}

/*
 *	following are the conditional operators.
 *	they compare the secondary register against the primary register
 *	and put a literl 1 in the primary if the condition is true,
 *	otherwise they clear the primary register
 *
 */

/*
 *	equal
 *
 */
geq ()
{
	gcall ("^eq");
	stkp = stkp + INTSIZE;
}

/*
 *	not equal
 *
 */
gne ()
{
	gcall ("^ne");
	stkp = stkp + INTSIZE;
}

/*
 *	less than (signed)
 *
 */
glt ()
{
	gcall ("^lt");
	stkp = stkp + INTSIZE;
}
/*
 *	less than or equal (signed)
 *
 */
gle ()
{
	gcall ("^le");
	stkp = stkp + INTSIZE;
}

/*
 *	greater than (signed)
 *
 */
ggt ()
{
	gcall ("^gt");
	stkp = stkp + INTSIZE;
}

/*
 *	greater than or equal (signed)
 *
 */
gge ()
{
	gcall ("^ge");
	stkp = stkp + INTSIZE;
}

/*
 *	less than (unsigned)
 *
 */
gult ()
{
	gcall ("^ult");
	stkp = stkp + INTSIZE;
}

/*
 *	less than or equal (unsigned)
 *
 */
gule ()
{
	gcall ("^ule");
	stkp = stkp + INTSIZE;
}

/*
 *	greater than (unsigned)
 *
 */
gugt ()
{
	gcall ("^ugt");
	stkp = stkp + INTSIZE;
}

/*
 *	greater than or equal (unsigned)
 *
 */
guge ()
{
	gcall ("^uge");
	stkp = stkp + INTSIZE;
}

inclib() {
#ifdef	flex
	return("B.");
#endif
#ifdef	unix
	return(INCDIR);
#endif
#ifdef	cpm
	return("B:");
#endif
}

/*	Squirrel away argument count in a register that modstk/getloc/stloc
	doesn't touch.
*/

gnargs(d)
int	d; {
	ot ("mov.l\t&");
	onum(d);
	outstr(",%d3\n");
}

#ifndef	NOASLD
char	assems[400];
int	assinit;
assemble(s)
char	*s; {
#ifdef	ASNM
	char	cmd[100],buf[100];
	char	*p;
	int	ex, rc, delaft;
#ifdef	unix
	p = strrchr(s, '/');
	if (p)
		strcat(buf, p+1);
	else
#endif
		strcat(buf, s);
	p = buf + strlen(buf) - 1;
	rc = typeof(s);
	delaft = (rc == 'c');
	if (rc == 'c' || rc == 's') {
		ex = 0;
		*p = 'o';
	} else
		ex = 1;
	if (!assinit) {
		strcat(assems, LDNM);
		assinit = 1;
	}
	strcat(assems, buf);
	strcat(assems, " ");
	if (ex)
		return(0);
	strcpy(cmd, ASNM);
	strcat(cmd, buf);
	strcat(cmd, " ");
	*p = 's';
	strcat(cmd, buf);
	rc = system(cmd);
	if (!rc && delaft)
		unlink(buf);
	return(rc);
#else
	return(0);
#endif
}

link() {
#ifdef	LDNM
#ifdef	unix
#ifdef	m68k
	strcat(assems, " -lc");
#else
	strcat(assems, " /u1/cx/lib/libc.a");
#endif
#endif
	return(system(assems));
#else
	return(0);
#endif
}
#endif
SHAR_EOF
if test 11259 -ne "`wc -c < 'codem68k.c'`"
then
	echo shar: error transmitting "'codem68k.c'" '(should have been 11259 characters)'
fi
fi
echo shar: extracting "'codevax.c'" '(10274 characters)'
if test -f 'codevax.c'
then
	echo shar: will not over-write existing file "'codevax.c'"
else
cat << \SHAR_EOF > 'codevax.c'
/*	File codevax.c: 2.2 (84/08/31,10:05:16) */
/*% cc -O -c %
 *
 */

#include <stdio.h>
#include "defs.h"
#include "data.h"

#ifdef	vax
#define	ASNM	"/bin/as"
#define	LDNM	"/bin/ld"
#endif

/*	Define ASNM and LDNM to the names of the assembler and linker
	respectively */

int	needr0;
int	needh;
/*
 *	Some predefinitions:
 *
 *	INTSIZE is the size of an integer in the target machine
 *	BYTEOFF is the offset of an byte within an integer on the
 *		target machine. (ie: 8080,pdp11 = 0, 6809 = 1,
 *		360 = 3)
 *	This compiler assumes that an integer is the SAME length as
 *	a pointer - in fact, the compiler uses INTSIZE for both.
 */
#define	INTSIZE	4
#define	BYTEOFF	0

/*
 *	print all assembler info before any code is generated
 *
 */
header ()
{
	outstr("#\tSmall C VAX\n#\tCoder (2.4,84/11/27)\n#");
	FEvers();
	nl ();
	ol (".globl\tlneg");
	ol (".globl\tcase");
	ol (".globl\teq");
	ol (".globl\tne");
	ol (".globl\tlt");
	ol (".globl\tle");
	ol (".globl\tgt");
	ol (".globl\tge");
	ol (".globl\tult");
	ol (".globl\tule");
	ol (".globl\tugt");
	ol (".globl\tuge");
	ol (".globl\tbool");
}

nl()
{
	if (needh) {
		ol (".word\t0");
		needh = 0;
	}
	if (needr0) {
		needr0 = 0;
		outstr(",r0");
	}
	outbyte(EOL);
}

initmac() {
	defmac("vax\t1");
	defmac("unix\t1");
	defmac("smallc\t1");
}

galign(t)
int t;
{
	int sign;
	if (t < 0) {
		sign = 1;
		t = -t;
	} else
		sign = 0;
	t = (t + INTSIZE - 1) & ~(INTSIZE - 1);
	t = sign? -t: t;
	return (t);
}



/*
 *	return size of an integer
 */
intsize() {
	return(INTSIZE);
}

/*
 *	return offset of ls byte within word
 *	(ie: 8080 & pdp11 is 0, 6809 is 1, 360 is 3)
 */
byteoff() {
	return(BYTEOFF);
}

/*
 *	Output internal generated label prefix
 */
olprfix() {
	outstr("LL");
}

/*
 *	Output a label definition terminator
 */
col ()
{
	outstr (":\n");
}

/*
 *	begin a comment line for the assembler
 *
 */
comment ()
{
	outbyte ('#');
}

/*
 *	Output a prefix in front of user labels
 */
prefix () {
	outbyte ('_');
}


/*
 *	print any assembler stuff needed after all code
 *
 */
trailer ()
{
}

/*
 *	function prologue
 */
prologue ()
{
	ol (".align\t1");
}

/*
 *	text (code) segment
 */
gtext ()
{
	ol (".text");
}

/*
 *	data segment
 */
gdata ()
{
	ol (".data");
}

/*
 *  Output the variable symbol at scptr as an extrn or a public
 */
ppubext(scptr) char *scptr; {
	if (scptr[STORAGE] == STATIC) return;
	ot (".globl\t");
	prefix ();
	outstr (scptr);
	nl();
}

/*
 * Output the function symbol at scptr as an extrn or a public
 */
fpubext(scptr) char *scptr; {
	ppubext(scptr);
}

/*
 *  Output a decimal number to the assembler file
 */
onum(num) int num; {
	outdec(num);	/* pdp11 needs a "." here */
}


/*
 *	fetch a static memory cell into the primary register
 */
getmem (sym)
char	*sym;
{
	if ((sym[IDENT] != POINTER) & (sym[TYPE] == CCHAR)) {
		ot ("cvtbl\t");
		prefix ();
		outstr (sym + NAME);
	} else {
		ot ("movl\t");
		prefix ();
		outstr (sym + NAME);
	}
	outstr(",r0\n");
}

/*
 *	fetch the address of the specified symbol into the primary register
 *
 */
getloc (sym)
char	*sym;
{
	if (sym[STORAGE] == LSTATIC) {
		immed();
		printlabel(glint(sym));
		nl();
	} else {
		ot ("moval\t");
		onum (glint(sym) - stkp);
		outstr ("(sp),r0\n");
	}
}

/*
 *	store the primary register into the specified static memory cell
 *
 */
putmem (sym)
char	*sym;
{
	if ((sym[IDENT] != POINTER) & (sym[TYPE] == CCHAR)) {
		ot ("cvtlb\tr0,");
	} else
		ot ("movl\tr0,");
	prefix ();
	outstr (sym + NAME);
	nl ();
}

/*
 *	store the specified object type in the primary register
 *	at the address on the top of the stack
 *
 */
putstk (typeobj)
char	typeobj;
{
	if (typeobj == CCHAR)
		ol ("cvtlb\tr0,*(sp)+");
	else
		ol ("movl\tr0,*(sp)+");
	stkp = stkp + INTSIZE;
}

/*
 *	fetch the specified object type indirect through the primary
 *	register into the primary register
 *
 */
indirect (typeobj)
char	typeobj;
{
	if (typeobj == CCHAR)
		ol ("cvtbl\t(r0),r0");
	else
		ol ("movl\t(r0),r0");
}

/*
 *	swap the primary and secondary registers
 *
 */
swap ()
{
	ol ("movl\tr0,r2\n\tmovl\tr1,r0\n\tmovl\tr2,r1");
}

/*
 *	print partial instruction to get an immediate value into
 *	the primary register
 *
 */
immed ()
{
	ot ("movl\t$");
	needr0 = 1;
}

/*
 *	push the primary register onto the stack
 *
 */
gpush ()
{
	ol ("pushl\tr0");
	stkp = stkp - INTSIZE;
}

/*
 *	pop the top of the stack into the secondary register
 *
 */
gpop ()
{
	ol ("movl\t(sp)+,r1");
	stkp = stkp + INTSIZE;
}

/*
 *	swap the primary register and the top of the stack
 *
 */
swapstk ()
{
	ol ("popl\tr2\npushl\tr0\nmovl\tr2,r0");
}

/*
 *	call the specified subroutine name
 *
 */
gcall (sname)
char	*sname;
{
	if (*sname == '^') {
		ot ("jsb\t");
		outstr (++sname);
	} else {
		ot ("jsb\t");
		prefix ();
		outstr (sname);
	}
	nl ();
}

/*
 *	return from subroutine
 *
 */
gret ()
{
	ol ("rsb");
}

/*
 *	perform subroutine call to value on top of stack
 *
 */
callstk ()
{
	ol ("jsb\t(sp)+");
	stkp = stkp + INTSIZE;
}

/*
 *	jump to specified internal label number
 *
 */
jump (label)
int	label;
{
	ot ("jmp\t");
	printlabel (label);
	nl ();
}

/*
 *	test the primary register and jump if false to label
 *
 */
testjump (label, ft)
int	label,
	ft;
{
	ol ("cmpl\tr0,$0");
	if (ft)
		ot ("jneq\t");
	else
		ot ("jeql\t");
	printlabel (label);
	nl ();
}

/*
 *	print pseudo-op  to define a byte
 *
 */
defbyte ()
{
	ot (".byte\t");
}

/*
 *	print pseudo-op to define storage
 *
 */
defstorage ()
{
	ot (".space\t");
}

/*
 *	print pseudo-op to define a word
 *
 */
defword ()
{
	ot (".long\t");
}

/*
 *	modify the stack pointer to the new value indicated
 *
 */
modstk (newstkp)
int	newstkp;
{
	int	k;

	k = newstkp - stkp;
	if (k % INTSIZE)
		error("Bad stack alignment (compiler error)");
	if (k == 0)
		return (newstkp);
	ot ("addl2\t$");
	onum (k);
	outstr (",sp");
	nl();
	return (newstkp);
}

/*
 *	multiply the primary register by INTSIZE
 */
gaslint ()
{
	ol ("ashl\t$2,r0,r0");
}

/*
 *	divide the primary register by INTSIZE
 */
gasrint()
{
	ol ("ashl\t$-2,r0,r0");
}

/*
 *	Case jump instruction
 */
gjcase() {
	ot ("jmp\tcase");
	nl ();
}

/*
 *	add the primary and secondary registers
 *	if lval2 is int pointer and lval is int, scale lval
 */
gadd (lval, lval2) int *lval, *lval2;
{
	if (dbltest (lval2, lval)) {
		ol ("ashl\t$2,(sp),(sp)");
	}
	ol ("addl2\t(sp)+,r0");
	stkp = stkp + INTSIZE;
}

/*
 *	subtract the primary register from the secondary
 *
 */
gsub ()
{
	ol ("subl3\tr0,(sp)+,r0");
	stkp = stkp + INTSIZE;
}

/*
 *	multiply the primary and secondary registers
 *	(result in primary)
 *
 */
gmult ()
{
	ol ("mull2\t(sp)+,r0");
	stkp = stkp + INTSIZE;
}

/*
 *	divide the secondary register by the primary
 *	(quotient in primary, remainder in secondary)
 *
 */
gdiv ()
{
	ol ("divl3\tr0,(sp)+,r0");
	stkp = stkp + INTSIZE;
}

/*
 *	compute the remainder (mod) of the secondary register
 *	divided by the primary register
 *	(remainder in primary, quotient in secondary)
 *
 */
gmod ()
{
	ol ("movl\t(sp)+,r2\n\tmovl\t$0,r3\nediv\tr0,r2,r1,r0");
	stkp = stkp + INTSIZE;
}

/*
 *	inclusive 'or' the primary and secondary registers
 *
 */
gor ()
{
	ol ("bisl2\t(sp)+,r0");
	stkp = stkp + INTSIZE;
}

/*
 *	exclusive 'or' the primary and secondary registers
 *
 */
gxor ()
{
	ol ("xorl2\t(sp)+,r0");
	stkp = stkp + INTSIZE;
}

/*
 *	'and' the primary and secondary registers
 *
 */
gand ()
{
	ol ("mcoml\t(sp)+,r1\n\tbicl2\tr1,r0");
	stkp = stkp + INTSIZE;
}

/*
 *	arithmetic shift right the secondary register the number of
 *	times in the primary register
 *	(results in primary register)
 *
 */
gasr ()
{
	ol("mnegl\tr0,r0\n\tashl\tr0,(sp)+,r0");
	stkp = stkp + INTSIZE;
}

/*
 *	arithmetic shift left the secondary register the number of
 *	times in the primary register
 *	(results in primary register)
 *
 */
gasl ()
{
	ol ("ashl\tr0,(sp)+,r0");
	stkp = stkp + INTSIZE;
}

/*
 *	two's complement of primary register
 *
 */
gneg ()
{
	ol ("mnegl\tr0,r0");
}

/*
 *	logical complement of primary register
 *
 */
glneg ()
{
	gcall ("^lneg");
}

/*
 *	one's complement of primary register
 *
 */
gcom ()
{
	ol ("mcoml\tr0,r0");
}

/*
 *	convert primary register into logical value
 *
 */
gbool ()
{
	gcall ("^bool");
}
/*
 *	increment the primary register by 1 if char, INTSIZE if
 *      int
 */
ginc (lval) int lval[];
{
	if (lval[2] == CINT)
		ol ("addl2\t$4,r0");
	else
		ol ("incl\tr0");
}

/*
 *	decrement the primary register by one if char, INTSIZE if
 *	int
 */
gdec (lval) int lval[];
{
	if (lval[2] == CINT)
		ol ("subl2\t$4,r0");
	else
		ol ("decl\tr0");
}

/*
 *	following are the conditional operators.
 *	they compare the secondary register against the primary register
 *	and put a literl 1 in the primary if the condition is true,
 *	otherwise they clear the primary register
 *
 */

/*
 *	equal
 *
 */
geq ()
{
	gcall ("^eq");
	stkp = stkp + INTSIZE;
}

/*
 *	not equal
 *
 */
gne ()
{
	gcall ("^ne");
	stkp = stkp + INTSIZE;
}

/*
 *	less than (signed)
 *
 */
glt ()
{
	gcall ("^lt");
	stkp = stkp + INTSIZE;
}
/*
 *	less than or equal (signed)
 *
 */
gle ()
{
	gcall ("^le");
	stkp = stkp + INTSIZE;
}

/*
 *	greater than (signed)
 *
 */
ggt ()
{
	gcall ("^gt");
	stkp = stkp + INTSIZE;
}

/*
 *	greater than or equal (signed)
 *
 */
gge ()
{
	gcall ("^ge");
	stkp = stkp + INTSIZE;
}

/*
 *	less than (unsigned)
 *
 */
gult ()
{
	gcall ("^ult");
	stkp = stkp + INTSIZE;
}

/*
 *	less than or equal (unsigned)
 *
 */
gule ()
{
	gcall ("^ule");
	stkp = stkp + INTSIZE;
}

/*
 *	greater than (unsigned)
 *
 */
gugt ()
{
	gcall ("^ugt");
	stkp = stkp + INTSIZE;
}

/*
 *	greater than or equal (unsigned)
 *
 */
guge ()
{
	gcall ("^uge");
	stkp = stkp + INTSIZE;
}

/*	Squirrel away argument count in a register that modstk
	doesn't touch.
*/

gnargs(d)
int	d; {
	ot ("movl\t$");
	onum(d);
	outstr (",r6\n");
}

inclib() {
#ifdef	flex
	return("B.");
#endif
#ifdef	unix
	return(INCDIR);
#endif
#ifdef	cpm
	return("B:");
#endif
}

assemble(s)
char	*s; {
#ifdef	ASNM
	char buf[100];
	strcpy(buf, ASNM);
	strcat(buf, " -o ");
	strcat(buf, s);
	buf[strlen(buf)-1] = 'o';
	strcat(buf, " ");
	strcat(buf, s);
	buf[strlen(buf)-1] = 's';
	return(system(buf));
#else
	return(0);
#endif
}

link() {
#ifdef	LDNM
	fputs("I don't know how to link files yet\n", stderr);
#else
	return(0);
#endif
}
SHAR_EOF
if test 10274 -ne "`wc -c < 'codevax.c'`"
then
	echo shar: error transmitting "'codevax.c'" '(should have been 10274 characters)'
fi
fi
echo shar: extracting "'data.c'" '(722 characters)'
if test -f 'data.c'
then
	echo shar: will not over-write existing file "'data.c'"
else
cat << \SHAR_EOF > 'data.c'
/*	File data.c: 2.2 (84/11/27,16:26:13) */
/*% cc -O -c %
 *
 */

#include <stdio.h>
#include "defs.h"

/* storage words */

char	symtab[SYMTBSZ];
char	*glbptr, *rglbptr, *locptr;
int	ws[WSTABSZ];
int	*wsptr;
int	swstcase[SWSTSZ];
int	swstlab[SWSTSZ];
int	swstp;
char	litq[LITABSZ];
int	litptr;
char	macq[MACQSIZE];
int	macptr;
char	line[LINESIZE];
char	mline[LINESIZE];
int	lptr, mptr;

/* miscellaneous storage */

int	nxtlab,
	litlab,
	stkp,
	argstk,
	ncmp,
	errcnt,
	glbflag,
	ctext,
	cmode,
	lastst;

FILE	*input, *input2, *output;
FILE	*inclstk[INCLSIZ];
int	inclsp;
char	fname[20];

char	quote[2];
char	*cptr;
int	*iptr;
int	fexitlab;
int	iflevel, skiplevel;
int	errfile;
int	sflag;
int	cflag;
int	errs;
int	aflag;
SHAR_EOF
if test 722 -ne "`wc -c < 'data.c'`"
then
	echo shar: error transmitting "'data.c'" '(should have been 722 characters)'
fi
fi
echo shar: extracting "'data.h'" '(807 characters)'
if test -f 'data.h'
then
	echo shar: will not over-write existing file "'data.h'"
else
cat << \SHAR_EOF > 'data.h'
/*	File data.h: 2.2 (84/11/27,16:26:11) */

/* storage words */

extern	char	symtab[];
extern	char	*glbptr, *rglbptr, *locptr;
extern	int	ws[];
extern	int	*wsptr;
extern	int	swstcase[];
extern	int	swstlab[];
extern	int	swstp;
extern	char	litq[];
extern	int	litptr;
extern	char	macq[];
extern	int	macptr;
extern	char	line[];
extern	char	mline[];
extern	int	lptr, mptr;

/* miscellaneous storage */

extern	int	nxtlab,
		litlab,
		stkp,
		argstk,
		ncmp,
		errcnt,
		glbflag,
		ctext,
		cmode,
		lastst;

extern	FILE	*input, *input2, *output;
extern	FILE	*inclstk[];
extern	int	inclsp;
extern	char	fname[];

extern	char	quote[];
extern	char	*cptr;
extern	int	*iptr;
extern	int	fexitlab;
extern	int	iflevel, skiplevel;
extern	int	errfile;
extern	int	sflag;
extern	int	cflag;
extern	int	errs;
extern	int	aflag;
SHAR_EOF
if test 807 -ne "`wc -c < 'data.h'`"
then
	echo shar: error transmitting "'data.h'" '(should have been 807 characters)'
fi
fi
exit 0
#	End of shell archive



More information about the Mod.sources mailing list