[comp.sources.atari.st] v02i093: sozobon1.2 -- Update to Sozobon C compiler part02/09

koreth@panarthea.ebay.sun.com (Steven Grimm) (10/25/89)

Submitted-by: ncar.ucar.edu!dunike!onecom!wldrdg!hans (Johann Ruegg)
Posting-number: Volume 2, Issue 93
Archive-name: sozobon1.2/part02

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 2 (of 9)."
# Contents:  hcc/MAIN.C hcc/MD.C hcc/NODES.H top/FUNC.C top/INST.C
#   top/PEEP1.C
# Wrapped by koreth@panarthea on Tue Oct 24 18:40:44 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'hcc/MAIN.C' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'hcc/MAIN.C'\"
else
echo shar: Extracting \"'hcc/MAIN.C'\" \(8368 characters\)
sed "s/^X//" >'hcc/MAIN.C' <<'END_OF_FILE'
X/* Copyright (c) 1988,1989 by Sozobon, Limited.  Author: Johann Ruegg
X *
X * Permission is granted to anyone to use this software for any purpose
X * on any computer system, and to redistribute it freely, with the
X * following restrictions:
X * 1) No charge may be made other than reasonable charges for reproduction.
X * 2) Modified versions must be clearly marked as such.
X * 3) The authors are not responsible for any harmful consequences
X *    of using this software, even if they result from defects in it.
X *
X *	main.c
X *
X *	Main routine, error handling, keyword lookup.
X */
X
X#include <stdio.h>
X#include "param.h"
X#include "nodes.h"
X#include "tok.h"
X
Xint lineno;
Xint nmerrors;
Xint oflags[26];
Xint xflags[26];
Xint pflag = 0;			/* enable profiling */
Xstatic int anydebug;
X#define debug oflags['z'-'a']
X
XFILE *input;
XFILE *output;
X#if CC68
XFILE *fopenb();
X#define fopen fopenb
X#endif
Xchar *inname;
X
X#if NEEDBUF
Xchar my_ibuf[BUFSIZ];
X#endif
X
X#ifdef MINIX
X#define strchr	index
X#endif
X
XNODEP cur;
X
X#define MAXPREDEF	20
X
Xstruct def {
X	char *dname, *dval;
X} defines[MAXPREDEF] = {
X	{"MC68000"},
X	{"mc68000"},
X	{"SOZOBON"},
X#ifdef FOR_AMIGA
X	{"AMIGA"},
X	{"AMIGADOS"},
X#else
X	{"ATARI_ST"},
X#ifdef MINIX
X	{"MINIX"},
X#else
X	{"TOS"},
X#endif
X#endif
X};
Xstatic int npred = 4;
X
X#ifdef MINIX
Xchar	tmpdir[128] = ".";		/* where the output goes */
X#endif
X
Xmain(argc, argv)
Xchar **argv;
X{
X	char	*p, *getenv();
X	int shownames;
X	int i;
X
X	if (sizeof(NODE) & 3) {
X		printf("sizeof NODE not mult of 4\n");
X		exit(1);
X	}
X
X	/*
X	 * Parse the INCLUDE environment variable, if present.
X	 */
X	if ((p = getenv("INCLUDE")) != NULL)
X		doincl(p);
X
X	shownames = 0;
X#ifndef FOR_AMIGA
X	if (isatty(0)) {
X#ifndef MINIX
X		write(1, "\33v", 2);
X#endif
X		setbuf(stdout, NULL);
X	}
X#endif
X/* put author here */
X	while (argc-- > 1) {
X		argv++;
X		if (argv[0][0] == '-')
X			doopt(&argv[0][1]);
X#if CC68
X		else if (argv[0][0] == '+') {
X			upstr(&argv[0][1]);
X			doopt(&argv[0][1]);
X		}
X#endif
X		else {
X			if (argc > 1 || shownames) {
X				shownames++;
X				printf("%s:\n", argv[0]);
X			}
X			if (input != NULL)
X				fclose(input);
X			input = fopen(argv[0], ROPEN);
X			if (input == NULL) {
X				printf("Cant open %s\n", argv[0]);
X				exit(1);
X			}
X#if NEEDBUF
X			setbuf(input, my_ibuf);
X#endif
X			inname = argv[0];
X			dofile();
X		}
X	}
X	if (input == NULL) {
X		input = stdin;
X		output = stdout;
X		inname = "<STDIN>";
X		dofile();
X	}
X	exit(0);
X}
X
Xadddef(s)
Xchar *s;
X{
X	char *as, *strchr();
X
X	if (npred >= MAXPREDEF) {
X		warn("too many -D 's");
X		return;
X	}
X	if ((as = strchr(s,'=')) != NULL)
X		*as++ = 0;
X	else
X		as = NULL;
X	defines[npred].dname = s;
X	defines[npred].dval = as;
X	npred++;
X}
X
Xsubdef(s)
Xchar *s;
X{
X	int i;
X
X	for (i=0; i<npred; i++)
X		if (strcmp(s, defines[i].dname) == 0)
X			goto found;
X	return;
Xfound:
X	while (i < npred) {
X		defines[i] = defines[i+1];
X		i++;
X	}
X	npred--;
X}
X
Xdodefs()
X{
X	int i;
X	struct def *p;
X
X	/*
X	 * Define the "built-in" macros
X	 */
X	p = defines;
X	for (i=0; i < npred; i++,p++)
X		optdef(p->dname, p->dval ? p->dval : "1");
X}
X
Xdoincl(s)
Xchar	*s;
X{
X	char	*malloc(), *strcpy();
X	char	buf[256];
X	char	dir[128];
X	register char	*p;
X	char c;
X
X	strcpy(buf, s);
X
X	/*
X	 * Convert ',' and ';' to nulls
X	 */
X	for (p=buf; *p != '\0' ;p++)
X		if (*p == ',' || *p == ';')
X			*p = '\0';
X	p[1] = '\0';			/* double null terminated */
X
X	/*
X	 * Grab each directory, make sure it ends with a slash
X	 * and add it to the directory list.
X	 */
X	for (p=buf; *p != '\0' ;p++) {
X		strcpy(dir, p);
X		c = dir[strlen(dir)-1];
X#ifndef FOR_AMIGA
X#ifdef MINIX
X		if (c != '/')
X			strcat(dir, "/");
X#else
X		if (c != '\\')
X			strcat(dir, "\\");
X#endif
X#else
X		if (c != '/' && c != ':')
X			strcat(dir, "/");
X#endif
X
X		optincl( strcpy(malloc((unsigned) (strlen(dir) + 1)), dir) );
X
X		while (*p != '\0')
X			p++;
X	}
X}
X
Xdofile()
X{
X	extern int nodesmade, nodesavail;
X	char *scopy();
X	extern NODEP deflist[], symtab[], tagtab;
X	extern NODEP strsave;
X	extern int level;
X	int i;
X
X	out_start(inname);
X	inname = scopy(inname);
X	lineno = 1;
X	nmerrors = 0;
X	dodefs();
X	advnode();
X
X	level = 0;
X	program();
X	dumpstrs(strsave);
X#ifdef OUT_AZ
X	xrefs();
X#endif
X
X	out_end();
X	if (cur && cur->e_token == EOFTOK)
X		freenode(cur);
X	sfree(inname);
X	for (i=0; i<NHASH; i++) {
X		if (debug>1 && deflist[i]) {
X			printf("defines[%d]", i);
X			printlist(deflist[i]);
X		}
X		freenode(deflist[i]);
X		deflist[i] = NULL;
X		if (debug && symtab[i]) {
X			printf("gsyms[%d]", i);
X			printlist(symtab[i]);
X		}
X		freenode(symtab[i]);
X		symtab[i] = NULL;
X	}
X	if (debug) {
X		printf("structs");
X		printlist(tagtab);
X	}
X	freenode(tagtab);
X	tagtab = NULL;
X	freenode(strsave);
X	strsave = NULL;
X	if (nmerrors) {
X		printf("%d errors\n", nmerrors);
X		exit(1);
X	}
X	if (nodesmade != nodesavail) {
X		printf("lost %d nodes!!!\n", nodesmade-nodesavail);
X		exit(1);
X	}
X/*
X	printf("Space = %ldK\n", ((long)nodesavail*sizeof(NODE))/1024);
X*/
X}
X
Xstatic	char	Version[] =
X"hcc: version 1.20  Copyright (c) 1988,1989 by Sozobon, Limited.";
X
Xdoopt(s)
Xchar *s;
X{
X	register char c;
X
X	while ((c = *s++)) {
X#ifdef	DEBUG
X		if (c >= 'a' && c <='z') {
X			oflags[c-'a']++;
X			anydebug++;
X		} else
X#endif
X		if (c >= 'A' && c <= 'Z') {
X			switch (c) {
X			case 'D':
X				adddef(s);
X				return;
X			case 'U':
X				subdef(s);
X				return;
X			case 'I':
X				doincl(s);
X				return;
X			case 'P':
X				pflag = 1;
X				continue;
X			case 'V':
X				printf("%s\n", Version);
X				continue;
X#ifdef MINIX
X			case 'T':
X				strcpy(tmpdir, s);
X				if (tmpdir[strlen(tmpdir)-1] == '/')
X					tmpdir[strlen(tmpdir)-1] = '\0';
X				return;
X#endif
X			}
X#ifdef	DEBUG
X			xflags[c-'A']++;
X			anydebug++;
X#endif
X		}
X	}
X}
X
Xerrors(s,t)
Xchar *s, *t;
X{
X	optnl();
X	printf("error in %s on line %d: %s %s\n", inname, lineno, s,t);
X	nmerrors++;
X}
X
Xerrorn(s,np)
Xchar *s;
XNODE *np;
X{
X	optnl();
X	printf("error in %s on line %d: %s ", inname, lineno, s);
X	put_nnm(np);
X	putchar('\n');
X	nmerrors++;
X}
X
Xerror(s)
Xchar *s;
X{
X	optnl();
X	printf("error in %s on line %d: %s\n", inname, lineno, s);
X	nmerrors++;
X}
X
Xwarns(s,t)
Xchar *s, *t;
X{
X	optnl();
X	printf("warning in %s on line %d: %s %s\n", inname, lineno, s,t);
X}
X
Xwarnn(s,np)
Xchar *s;
XNODE *np;
X{
X	optnl();
X	printf("warning in %s on line %d: %s ", inname, lineno, s);
X	put_nnm(np);
X	putchar('\n');
X}
X
Xwarn(s)
Xchar *s;
X{
X	optnl();
X	printf("warning in %s on line %d: %s\n", inname, lineno, s);
X}
X
Xfatals(s,t)
Xchar *s, *t;
X{
X	optnl();
X	printf("fatal error in %s on line %d: %s %s\n", inname, lineno, s,t);
X	exit(1);
X}
X
Xfataln(s,np)
Xchar *s;
XNODE *np;
X{
X	optnl();
X	printf("fatal error in %s on line %d: %s ", inname, lineno, s);
X	put_nnm(np);
X	putchar('\n');
X	exit(1);
X}
X
Xfatal(s)
Xchar *s;
X{
X	optnl();
X	printf("fatal error in %s on line %d: %s\n", inname, lineno, s);
X	exit(1);
X}
X
Xstatic
Xoptnl()
X{
X	if (anydebug)
X		putchar('\n');
X}
X
Xstruct kwtbl {
X	char *name;
X	int	kwval;
X	int	kflags;
X} kwtab[] = {
X	/* must be sorted */
X	{"asm", K_ASM},
X	{"auto", K_AUTO},
X	{"break", K_BREAK},
X	{"case", K_CASE},
X	{"char", K_CHAR},
X	{"continue", K_CONTINUE},
X	{"default", K_DEFAULT},
X	{"do", K_DO},
X	{"double", K_DOUBLE},
X	{"else", K_ELSE},
X	{"enum", K_ENUM},
X	{"extern", K_EXTERN},
X	{"float", K_FLOAT},
X	{"for", K_FOR},
X	{"goto", K_GOTO},
X	{"if", K_IF},
X	{"int", K_INT},
X	{"long", K_LONG},
X	{"register", K_REGISTER},
X	{"return", K_RETURN},
X	{"short", K_SHORT},
X	{"sizeof", K_SIZEOF},
X	{"static", K_STATIC},
X	{"struct", K_STRUCT},
X	{"switch", K_SWITCH},
X	{"typedef", K_TYPEDEF},
X	{"union", K_UNION},
X	{"unsigned", K_UNSIGNED},
X	{"void", K_VOID},
X	{"while", K_WHILE},
X
X	{0,0}
X};
X
X#define FIRST_C	'a'
X#define LAST_C	'z'
Xstruct kwtbl *kwstart[LAST_C-FIRST_C+1];
X
Xkw_init()
X{
X	register struct kwtbl *p;
X	register c;
X
X	for (p=kwtab; p->name; p++) {
X		c = p->name[0];
X		if (kwstart[c-FIRST_C] == 0)
X			kwstart[c-FIRST_C] = p;
X	}
X}
X
Xkw_tok(tp)
XNODE *tp;
X{
X	register struct kwtbl *kp;
X	register char *nm;
X	register i;
X	static first = 0;
X
X	nm = tp->n_name;
X	if (first == 0) {
X		kw_init();
X		first = 1;
X	}
X	i = nm[0];
X	if (i < FIRST_C || i > LAST_C)
X		return;
X	kp = kwstart[i-FIRST_C];
X	if (kp)
X	for (; kp->name; kp++) {
X		i = strcmp(nm, kp->name);
X		if (i == 0) {
X			tp->e_token = kp->kwval;
X			tp->e_flags = kp->kflags;
X			return;
X		} else if (i < 0)
X			return;
X	}
X}
X
X#if CC68
X/* fix args since stupid lib makes all lower case */
Xupstr(s)
Xchar *s;
X{
X	while (*s) {
X		if (*s >= 'a' && *s <= 'z')
X			*s += 'A'-'a';
X		s++;
X	}
X}
Xdownstr(s)
Xchar *s;
X{
X	while (*s) {
X		if (*s >= 'A' && *s <= 'Z')
X			*s -= 'A'-'a';
X		s++;
X	}
X}
X#endif
END_OF_FILE
if test 8368 -ne `wc -c <'hcc/MAIN.C'`; then
    echo shar: \"'hcc/MAIN.C'\" unpacked with wrong size!
fi
# end of 'hcc/MAIN.C'
fi
if test -f 'hcc/MD.C' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'hcc/MD.C'\"
else
echo shar: Extracting \"'hcc/MD.C'\" \(7524 characters\)
sed "s/^X//" >'hcc/MD.C' <<'END_OF_FILE'
X/* Copyright (c) 1988 by Sozobon, Limited.  Author: Johann Ruegg
X *
X * Permission is granted to anyone to use this software for any purpose
X * on any computer system, and to redistribute it freely, with the
X * following restrictions:
X * 1) No charge may be made other than reasonable charges for reproduction.
X * 2) Modified versions must be clearly marked as such.
X * 3) The authors are not responsible for any harmful consequences
X *    of using this software, even if they result from defects in it.
X *
X *	md.c
X *
X *	Machine dependant parts of first pass (parse)
X *	Also type checking subroutines.
X */
X
X#include <stdio.h>
X#include "param.h"
X#include "tok.h"
X#include "nodes.h"
X#include "cookie.h"
X
XNODEP bas_type();
X
Xint adjtab[] = {
X	K_INT,		/* none */
X	K_SHORT,	/* short */
X	K_LONG,		/* long */
X	0,		/* short long */
X	K_UNSIGNED,	/* unsigned */
X	K_UNSIGNED,	/* unsigned short */
X	T_ULONG,	/* unsigned long */
X	0,		/* unsigned short long */
X};
X
Xadj_type(old, adj)
X{
X	int rv;
X
X	switch (old) {
X	case K_CHAR:
X		if (adj & SAW_UNS)
X			return T_UCHAR;
X		break;
X	case K_INT:
X		rv = adjtab[adj];
X		if (rv == 0) {
X			error("bad type spec");
X			return K_INT;
X		}
X		return rv;
X	case K_FLOAT:
X		if (adj & SAW_LONG)
X			return K_DOUBLE;
X		break;
X	}
X	return old;
X}
X
X/* given ICON value, and flags SEE_L,SEE_U
X	determine final type */
Xicon_ty(tp)
XNODE *tp;
X{
X	int flags;
X	long val;
X	int islong, isuns;
X
X	flags = tp->e_flags;
X	val = tp->e_ival;
X
X	islong = (flags & SEE_L);
X	isuns = (flags & SEE_U);
X
X	if (islong && isuns)
X		return T_ULONG;
X	if (islong || islongv(val))
X		return K_LONG;
X	if (isuns)
X		return K_UNSIGNED;
X	return isintv((int)val) ? K_INT : K_CHAR;
X}
X
Xisintv(i)
X{
X	if (i > 0x7f || i < -0x80)
X		return 1;
X	return 0;
X}
X
Xislongv(l)
Xlong l;
X{
X#ifndef NOLONGS
X#define	HIBITS	0xffff0000L
X
X	if ((l & HIBITS) == 0)		/* upper 16 bits zero */
X		return 0;
X
X	if ((l & HIBITS) == HIBITS) {	/* upper bits all on */
X		if (l & 0x8000L)
X			return 0;	/* upper bits aren't significant */
X		else
X			return 1;
X	}
X	return 1;
X#else
X	return 0;
X#endif
X}
X
Xmkint(l)
Xlong l;
X{
X	return l;
X}
X
Xlc_reg(rp, xp)
Xint *rp;
XNODE *xp;
X{
X	switch (xp->n_tptr->t_token) {
X	case STAR:
X		return al_areg(rp,xp);
X	case K_CHAR:
X	case T_UCHAR:
X	case T_ULONG:
X	case K_INT:
X	case K_UNSIGNED:
X	case K_LONG:
X		return al_dreg(rp,xp);
X	default:
X		return 0;
X	}
X}
X
Xal_areg(rp,xp)
Xint *rp;
XNODEP xp;
X{
X	register rmask, n;
X
X	rmask = *rp;
X	for (n=ARV_START; n<=ARV_END; n++)
X		if ((rmask & (1<<n)) == 0) {
X			xp->e_rno = n;
X			*rp |= (1<<n);
X			return 1;
X		}
X	return 0;
X}
X
Xal_dreg(rp,xp)
Xint *rp;
XNODEP xp;
X{
X	register rmask, n;
X
X	rmask = *rp;
X	for (n=DRV_START; n<=DRV_END; n++)
X		if ((rmask & (1<<n)) == 0) {
X			xp->e_rno = n;
X			*rp |= (1<<n);
X			return 1;
X		}
X	return 0;
X}
X
Xlong
Xarg_size(sz,np)
Xlong sz;
XNODEP np;
X{
X	np->e_offs = 0;
X
X	switch (np->n_tptr->t_token) {
X	case '[':
X		printf("GAK! array arg ");
X		return SIZE_P;
X	case K_CHAR:
X	case T_UCHAR:
X		np->e_offs = SIZE_I - SIZE_C;
X		return SIZE_I;
X#if SIZE_I != SIZE_S
X	case K_SHORT:
X		np->e_offs = SIZE_I - SIZE_S;
X		return SIZE_I;
X#endif
X	default:
X		if (sz & 1)
X			sz++;
X		return sz;
X	}
X}
X
Xmustlval(np)
XNODEP np;
X{
X	switch (np->e_token) {
X	case ID:
X	case STAR:
X	case '.':
X		break;
X	default:
X		errorn("not lvalue", np);
X		return 1;
X	}
X	return 0;
X}
X
Xmustty(np, flags)
XNODEP np;
X{
X	switch (np->n_tptr->t_token) {
X	case STAR:
X		if (flags & R_POINTER)
X			return 0;
X		error("pointer not allowed");
X		return 1;
X	case K_STRUCT:
X	case K_UNION:
X		if (flags & R_STRUCT)
X			return 0;
X		error("struct/union not allowed");
X		return 1;
X	case K_CHAR:
X	case K_SHORT:
X	case K_INT:
X	case K_UNSIGNED:
X	case K_LONG:
X	case T_UCHAR:
X	case T_ULONG:
X		if (flags & R_INTEGRAL)
X			return 0;
X		error("integral not allowed");
X		return 1;
X	case K_FLOAT:
X	case K_DOUBLE:
X		if (flags & R_FLOATING)
X			return 0;
X		error("floating not allowed");
X		return 1;
X	default:
X		error("bad type");
X		return 1;
X	}
X	return 0;
X}
X
XNODEP
Xfuncty(np)
XNODEP np;
X{
X	int lt;
X
X	lt = np->n_tptr->t_token;
X	if (lt != K_VOID)
X		mustty(np, R_ASSN);
X	switch (lt) {
X	case STAR:
X	case K_STRUCT:
X	case K_UNION:
X		return np->n_tptr;
X	}
X	lt = widen(lt);
X	return bas_type(lt);
X}
X
XNODEP
Xnormalty(lp, rp)
XNODEP lp, rp;
X{
X	/* already checked types are R_ARITH */
X	/* rp may be NULL */
X	int lt, rt, rett;
X
X	lt = lp->n_tptr->t_token;
X	if (rp)
X		rt = rp->n_tptr->t_token;
X	else
X		rt = K_INT;
X	rett = maxt(widen(lt), widen(rt));
X	return bas_type(rett);
X}
X
Xasn_chk(ltp, rp)
XNODEP ltp, rp;
X{
X
X	switch (ltp->t_token) {
X	case K_STRUCT:
X	case K_UNION:
X		if (same_type(ltp, rp->n_tptr) == 0)
X			error("bad struct assign");
X		return;
X	case STAR:
X		if (mayzero(rp))
X			return;
X		if (mustty(rp, R_POINTER))
X			return;
X		if (same_type(ltp->n_tptr, rp->n_tptr->n_tptr)
X			== 0)
X			warn("pointer types mismatch");
X		return;
X	default:
X		if (mustty(rp, R_ARITH))
X			return;
X	}
X}
X
Xchkcmp(np)
XNODEP np;
X{
X	/* already checked types are R_SCALAR */
X	int lt, rt;
X	NODEP lp = np->n_left, rp = np->n_right;
X
X	lt = lp->n_tptr->t_token;
X	lt = (lt == STAR);
X	rt = rp->n_tptr->t_token;
X	rt = (rt == STAR);
X	if (lt && rt) {		/* ptr cmp ptr */
X		if (same_type(lp->n_tptr, rp->n_tptr) == 0) {
X			warn("cmp of diff ptrs");
X		}
X	} else if (lt) {	/* ptr cmp intg */
X		mustzero(rp);
X	} else if (rt) {	/* intg +-[ ptr */
X		mustzero(lp);
X	} /* else both ARITH */
X}
X
XNODEP
Xcolonty(np)
XNODEP np;
X{
X	/* already checked types are R_SCALAR */
X	int lt, rt;
X	NODEP lp = np->n_left, rp = np->n_right;
X
X	lt = lp->n_tptr->t_token;
X	lt = (lt == STAR);
X	rt = rp->n_tptr->t_token;
X	rt = (rt == STAR);
X	if (lt && rt) {		/* ptr : ptr */
X		warn(": diff ptrs");
X		return lp->n_tptr;
X	} else if (lt) {	/* ptr : intg */
X		mustzero(rp);
X		return lp->n_tptr;
X	} else if (rt) {
X		mustzero(lp);
X		return rp->n_tptr;
X	} else
X		return normalty(lp, rp);
X}
X
XNODEP
Xaddty(np)
XNODEP np;
X{
X	/* already checked types are R_SCALAR */
X	/* op is '+' or '-' or '+=' or '-=' or '[' */
X	int oop = np->e_token;
X	int op;
X	int lt, rt;
X	NODEP lp = np->n_left, rp = np->n_right;
X
X	op = oop;
X	if (isassign(op))
X		op -= ASSIGN 0;
X	lt = lp->n_tptr->t_token;
X	lt = (lt == STAR);
X	rt = rp->n_tptr->t_token;
X	rt = (rt == STAR);
X	if (lt && rt) {		/* ptr - ptr */
X		if (oop != '-' || same_type(lp->n_tptr, rp->n_tptr) == 0) {
X			error("bad +/-");
X			return lp->n_tptr;
X		}
X		np->e_token = PTRDIFF;
X		np->e_offs = lp->n_tptr->n_tptr->t_size;
X		return bas_type(K_INT);
X	} else if (lt) {	/* ptr +-[ intg */
Xpandi:
X		mustty(rp, R_INTEGRAL);
X		np->e_offs = lp->n_tptr->n_tptr->t_size;
X		if (op == '+')
X			np->e_token += PTRADD-'+';
X		else if (op == '-')
X			np->e_token += PTRSUB-'-';
X		return lp->n_tptr;
X	} else if (rt) {	/* intg +-[ ptr */
X		if (isassign(oop) || op == '-') {
X			error("illegal int op ptr");
X			return bas_type(K_INT);
X		}
X		/* switch sides so intg is on right */
X		np->n_left = rp;
X		np->n_right = lp;
X		lp = rp;
X		rp = np->n_right;
X		goto pandi;		
X	} else {		/* intg +- intg */
X		return normalty(lp, rp);
X	}
X}
X
Xmustzero(np)
XNODEP np;
X{
X	if (np->e_token == ICON && np->e_ival == 0) {
X		return;
X	}
X	error("bad ':' combination");
X}
X
Xmayzero(np)
XNODEP np;
X{
X	if (np->e_token == ICON && np->e_ival == 0) {
X		return 1;
X	}
X	return 0;
X}
X
Xwiden(ty)
X{
X	switch (ty) {
X	case K_CHAR:
X	case T_UCHAR:
X		return K_INT;
X	case K_SHORT:
X		return K_INT;
X	case K_FLOAT:
X		return K_DOUBLE;
X	default:
X		return ty;
X	}
X}
X
Xint pri_t[] = {
X	1, 6,		/* uchar, ulong */
X	5,2,4,3,0,	/* long, short, uns, int, char */
X	7,8,9   	/* float, double, void */
X};
X
Xmaxt(t1, t2)
X{
X	extern nmerrors;
X
X	if (nmerrors)
X		return K_INT;
X	if (pri_t[t1-FIRST_BAS] > pri_t[t2-FIRST_BAS])
X		return t1;
X	return t2;
X}
END_OF_FILE
if test 7524 -ne `wc -c <'hcc/MD.C'`; then
    echo shar: \"'hcc/MD.C'\" unpacked with wrong size!
fi
# end of 'hcc/MD.C'
fi
if test -f 'hcc/NODES.H' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'hcc/NODES.H'\"
else
echo shar: Extracting \"'hcc/NODES.H'\" \(4451 characters\)
sed "s/^X//" >'hcc/NODES.H' <<'END_OF_FILE'
X/* Copyright (c) 1988 by Sozobon, Limited.  Author: Johann Ruegg
X *
X * Permission is granted to anyone to use this software for any purpose
X * on any computer system, and to redistribute it freely, with the
X * following restrictions:
X * 1) No charge may be made other than reasonable charges for reproduction.
X * 2) Modified versions must be clearly marked as such.
X * 3) The authors are not responsible for any harmful consequences
X *    of using this software, even if they result from defects in it.
X *
X *	nodes.h
X */
X
X/*
X *	stuff common to all nodes
X */
X#define COMMON	int cflags;	\
X		int fill;	\
X		union node *left;	\
X		union node *right;	\
X		union node *tptr;	\
X		union node *nm_ext;	\
X		char cname[NMSIZE]
X
X#define n_flags	e.cflags
X#define n_left	e.left
X#define n_next	e.left
X#define n_right e.right
X#define n_tptr	e.tptr
X#define n_nmx	e.nm_ext
X#define n_name	e.cname
X
X/*
X *	expression (and symbol table) node
X */
Xstruct enode {
X	COMMON;
X	int	token;		/* must be same place as tnode */
X	int	eflags;
X	char	etype;		/* type of node */
X	char	sc;
X	char	eprec;
X	char	rno;
X	union {
X		long	vival;
X		long	voffs;
X		double	vfval;
X	} vu;
X#ifndef NOFIELDS
X	unsigned	fldw:6, fldof:6;	/* use fields just so
X						we know fields work */
X#else
X	char	fldw, fldof;		/* use if cant do fields */
X#endif
X};
X
X#define e_token	e.token
X#define e_flags	e.eflags
X#define e_prec	e.eprec
X#define e_rno	e.rno
X#define e_type	e.etype
X#define e_ival	e.vu.vival
X#define e_offs	e.vu.voffs
X#define e_fval	e.vu.vfval
X#define e_sc	e.sc
X#define e_fldw	e.fldw
X#define e_fldo	e.fldof
X
X/* for e_flags values, see tok.h */
X
X/* values for e_type */
X
X#define E_LEAF	0	/* no descendants */
X#define E_UNARY 1	/* left node is expr, no right node */
X#define E_BIN	2	/* left and right are expr */
X#define E_SPEC	3	/* special '(', '[', '.', '->', ... */
X
X/*
X * code generation node
X */
Xstruct gnode {
X	COMMON;
X	int	token;
X	int	eflags;
X	char	etype;
X	char	sc;
X/* all of above fields must match first fields in enode! */
X
X	char	needs;		/* registers needed */
X	char	grno;		/* register used in ret value */
X	char	basety;		/* type FLOAT, UNS, INT or AGREG */
X	char	basesz;		/* size 1,2,4 or 3 -> see bsize */
X	char	gr1, gr2;
X	char	*betwc;		/* code for between L and R */
X	long	goffs;		/* offsets for OREG, ONAME */
X	union gu {
X		long	bsize;		/* AGREG size or misc. */
X		struct {
X#ifndef NOFIELDS
X#ifdef AZ_HOST
X			unsigned gfldw:6, gfldo:6;	/* BUG! */
X#else
X			int	gfldw:6, gfldo:6;	/* field info */
X#endif
X#else
X			char	gfldw, gfldo;	/* use if no fields */
X#endif
X		} gfl;
X	} gu;
X};
X
X#define g_token	g.token
X#define g_flags	g.eflags
X#define g_type	g.etype
X#define g_sc	g.sc
X#define g_needs g.needs
X#define g_rno	g.grno
X#define g_offs	g.goffs
X#define g_betw	g.betwc
X#define g_ty	g.basety
X#define g_sz	g.basesz
X#define g_code	g.tptr
X#define g_bsize	g.gu.bsize
X#define g_fldw	g.gu.gfl.gfldw
X#define g_fldo	g.gu.gfl.gfldo
X#define g_r1	g.gr1
X#define g_r2	g.gr2
X
X/* types of operands -- ordered in cast strength order */
X#define ET_S	1	/* signed integer */
X#define ET_U	2	/* unsigned integer */
X#define ET_F	3	/* float or double */
X#define ET_A	4	/* aggregate */
X
X/*
X *	type list node
X */
Xstruct tnode {
X	COMMON;
X	int	token;		/* must be same place as enode */
X	int	tflags;
X	char	aln;		/* alignment needed */
X	long	tsize;
X};
X
X#define t_token	t.token
X#define t_flags	t.tflags
X#define t_size	t.tsize
X#define t_aln	t.aln
X
X/*
X *	name extension node
X */
Xstruct nmext {
X	COMMON;
X	char nmx[NMXSIZE-NMSIZE];	/* name extension (with name)*/
X};
X
X#define x_nm	x.nmx
X
X/*
X *	block info node
X */
Xstruct bnode {
X	COMMON;
X	union node *syms;
X	union node *tags;
X	int	regs;		/* reg alloc mask */
X	long	lsize;		/* size of locals */
X	int	tmsize;		/* max tmps used for 1 expr */
X};
X
X#define b_syms	b.syms
X#define b_tags	b.tags
X#define b_regs	b.regs
X#define b_size	b.lsize
X#define b_tsize b.tmsize
X
X/*
X *	node to hold case for switch generation
X */
Xstruct cnode {
X	COMMON;
X	int	c_value;	/* value for case */
X	int	c_label;	/* case label or label label */
X	int	c_def;		/* label defined */
X};
X
X#define c_defined c.c_def
X#define c_casev c.c_value
X#define c_casel c.c_label
X
Xunion node {
X	struct enode e;
X	struct tnode t;
X	struct nmext x;
X	struct bnode b;
X	struct cnode c;
X	struct gnode g;
X};
X
Xtypedef union node NODE;
Xtypedef NODE *NODEP;
X
X/* defines for n_flags */
X
X#define N_BRKPR	1	/* break printnode recursion */
X#define N_COPYT	2	/* tptr is a copy */
X#define N_ISFREE 4	/* node is on free list (error check) */
X
XNODEP allocnode();
END_OF_FILE
if test 4451 -ne `wc -c <'hcc/NODES.H'`; then
    echo shar: \"'hcc/NODES.H'\" unpacked with wrong size!
fi
# end of 'hcc/NODES.H'
fi
if test -f 'top/FUNC.C' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'top/FUNC.C'\"
else
echo shar: Extracting \"'top/FUNC.C'\" \(4582 characters\)
sed "s/^X//" >'top/FUNC.C' <<'END_OF_FILE'
X/* Copyright (c) 1988 by Sozobon, Limited.  Author: Tony Andrews
X *
X * Permission is granted to anyone to use this software for any purpose
X * on any computer system, and to redistribute it freely, with the
X * following restrictions:
X * 1) No charge may be made other than reasonable charges for reproduction.
X * 2) Modified versions must be clearly marked as such.
X * 3) The authors are not responsible for any harmful consequences
X *    of using this software, even if they result from defects in it.
X */
X#include "top.h"
X
XBLOCK	*fhead;		/* head of the current function */
X
X/*
X * dofunc() - process one function
X *
X * Returns FALSE on end of file
X */
Xbool
Xdofunc()
X{
X	BLOCK	*getfunc();
X
X	clrvar();
X
X#ifdef	DEBUG
X	if (debug)
X		fprintf(stderr, "dofunc() - calling getfunc()\n");
X#endif
X	if ((fhead = getfunc()) == NULL)
X		return FALSE;
X
X	/*
X	 * Process the function we just read
X	 */
X	bopt(fhead);		/* perform branch optimization */
X
X	if (do_regs)
X		setreg(fhead);	/* try to assign locals to registers */
X
X	if (do_peep) {
X		rhealth(fhead, TRUE);	/* live/dead register analysis */
X		peep(fhead);		/* peephole optimizations */
X	}
X
X	/*
X	 * Now dump out the modified tree
X	 */
X#ifdef	DEBUG
X	if (debug)
X		fprintf(stderr, "dofunc() - calling putfunc()\n");
X#endif
X	putfunc(fhead);
X
X	freesym();		/* free the symbol table */
X
X	return TRUE;
X}
X
Xstatic	bool	saw_eof = FALSE;
X
X/*
X * getfunc() - get a function and return a pointer to its starting block
X *
X * Returns NULL on end of file.
X */
XBLOCK *
Xgetfunc()
X{
X	register BLOCK	*head;	/* starting block for this function */
X	register BLOCK	*cb;	/* the block we're currently reading */
X	register BLOCK	*ob;	/* the last block we read */
X
X	if (saw_eof)
X		return NULL;
X
X	head = NULL;
X
X	/*
X	 * Starting a global function
X	 */
X	if (strcmp(t_op, ".globl") == 0) {
X		/*
X		 * Enter the symbol and mark it global.
X		 */
X		head = mksym(t_arg);
X		head->flags |= B_GLOBAL;
X	
X		readline();
X	}
X
X	ob = NULL;
X
X	for (;;) {
X		if (ob == NULL) {
X			if (t_lab[0] != '_') {
X				fprintf(stderr, "top: expected function label\n");
X				exit(1);
X			}
X			if (head == NULL)
X				head = mksym(t_lab);
X
X		} else if (t_lab[0] == '\0') {
X			fprintf(stderr, "top: expected block label\n");
X			exit(1);
X		}
X
X		if ((cb = getsym(t_lab)) == NULL)
X			cb = mksym(t_lab);
X
X		/*
X		 * The last block falls through to this one.
X		 */
X		if (ob != NULL) {
X			ob->chain = cb;
X			ob->next = cb;
X			ob->bfall = cb;
X		}
X
X		t_lab[0] = '\0';
X
X		/*
X		 * Now read lines until we hit a new block or another
X		 * function.
X		 */
X		for (;;) {
X			/*
X			 * If we see a global, we're done with the function
X			 */
X			if (strcmp(t_op, ".globl") == 0)
X				return head;
X			/*
X			 * If we see a function label, we're done too.
X			 */
X			if (t_lab[0] == '_')
X				return head;
X			/*
X			 * If we see any other label, we're done with the block.
X			 */
X			if (t_lab[0])
X				break;
X
X			addinst(cb, t_op, t_arg);
X
X			/*
X			 * If we're at EOF, note that we've hit the end of
X			 * file, but return the function we just read.
X			 */
X			if (!readline()) {
X				saw_eof = TRUE;
X				return head;
X			}
X		}
X		ob = cb;
X	}
X}
X
X/*
X * putfunc(sb) - print out the function starting at block 'sb'
X *
X * The 'next' pointers determine the order in which things are placed
X * in the file. Branch instructions have been removed so they need to
X * be replaced here on output. Conditional branches are generated if
X * indicated (by non-null 'bcond'). Unconditional branches are generated
X * at the end of a block if it's "fall through" block isn't going to
X * be the next thing in the file.
X */
Xputfunc(sb)
Xregister BLOCK	*sb;
X{
X	register BLOCK	*cb;
X	register INST	*ci;
X
X	fprintf(ofp, "\t.text\n");
X
X	for (cb = sb; cb != NULL ;cb = cb->next) {
X		if (cb->flags & B_GLOBAL)
X			fprintf(ofp, "\t.globl\t%s\n", cb->name);
X
X		if (*cb->name == '_')
X			fprintf(ofp, "%s:\n", cb->name);
X
X		else if (cb->flags & B_LABEL)
X			fprintf(ofp, "%s:\n", cb->name);
X#ifdef	DEBUG
X		if (debug) {
X			fprintf(ofp, "*\n");
X			fprintf(ofp, "* %s, ref:%04x  set:%04x\n",
X				cb->name, cb->rref, cb->rset);
X			fprintf(ofp, "*\n");
X		}
X#endif
X
X		for (ci = cb->first; ci != NULL ;ci = ci->next)
X			putinst(ci);
X		/*
X		 * If there's a conditional branch, put out the
X		 * appropriate instruction for it.
X		 */
X		if (cb->bcond != NULL && cb->bcode >= 0)
X			fprintf(ofp, "\t%s\t%s\n",
X				opnames[cb->bcode], cb->bcond->name);
X		/*
X		 * If there's a "fall through" label, and the destination
X		 * block doesn't come next, put out a branch.
X		 */
X		if (cb->bfall != NULL && cb->bfall != cb->next) {
X			s_badd++;
X			fprintf(ofp, "\tbra\t%s\n", cb->bfall->name);
X		}
X	}
X}
END_OF_FILE
if test 4582 -ne `wc -c <'top/FUNC.C'`; then
    echo shar: \"'top/FUNC.C'\" unpacked with wrong size!
fi
# end of 'top/FUNC.C'
fi
if test -f 'top/INST.C' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'top/INST.C'\"
else
echo shar: Extracting \"'top/INST.C'\" \(7882 characters\)
sed "s/^X//" >'top/INST.C' <<'END_OF_FILE'
X/* Copyright (c) 1988 by Sozobon, Limited.  Author: Tony Andrews
X *
X * Permission is granted to anyone to use this software for any purpose
X * on any computer system, and to redistribute it freely, with the
X * following restrictions:
X * 1) No charge may be made other than reasonable charges for reproduction.
X * 2) Modified versions must be clearly marked as such.
X * 3) The authors are not responsible for any harmful consequences
X *    of using this software, even if they result from defects in it.
X */
X
X/*
X * Routines dealing with the parsing and output of instructions.
X */
X
X#include "top.h"
X
Xstatic	void	getarg();
Xstatic	int	isreg();
X
X/*
X * addinst(bp, op, args) - add an instruction to block 'bp'
X */
Xvoid
Xaddinst(bp, op, args)
Xregister BLOCK	*bp;
Xchar	*op, *args;
X{
X	register INST	*ni;
X	register int	i;
X	register char	*s;
X	char	*arg2 = "";
X
X	if (*op == '\0')	/* no instruction there */
X		return;
X
X	ni = (INST *) alloc(sizeof(INST));
X
X	ni->flags = 0;
X	ni->opcode = -1;
X	ni->next = NULL;
X	ni->prev = NULL;
X	ni->live = 0;
X	ni->rref = ni->rset = 0;
X
X	ni->src.areg = ni->dst.areg = 0;
X	ni->src.ireg = ni->dst.ireg = 0;
X	ni->src.disp = ni->dst.disp = 0;
X	ni->src.amode = ni->dst.amode = NONE;
X
X	/*
X	 * Link into the block appropriately
X	 */
X	if (bp->first == NULL) {
X		bp->first = bp->last = ni;
X	} else {
X		bp->last->next = ni;
X		ni->prev = bp->last;
X
X		bp->last = ni;
X	}
X
X	for (s = op; *s ;s++) {
X		/*
X		 * Pseudo-ops start with a period, so the length
X		 * specifier can't be the first character.
X		 */
X		if (*s == '.' && s != op) {	/* length specifier */
X			*s++ = '\0';
X			switch (*s) {
X			case 'b':
X				ni->flags |= LENB;
X				break;
X			case 'w':
X				ni->flags |= LENW;
X				break;
X			case 'l':
X				ni->flags |= LENL;
X				break;
X			default:
X				fprintf(stderr, "Bad length spec '%c'\n", *s);
X				exit(1);
X			}
X		}
X	}
X
X	for (i=0; opnames[i] ;i++) {
X		if (strcmp(op, opnames[i]) == 0) {
X			ni->opcode = i;
X			break;
X		}
X	}
X
X	if (ni->opcode < 0) {
X		fprintf(stderr, "Unknown op '%s'\n", op);
X		exit(1);
X	}
X
X	/*
X	 * Look for the split between the first and second operands.
X	 */
X	for (s = args; *s ;s++) {
X		/*
X		 * skip chars in parens, since an operand split can't
X		 * occur within.
X		 */
X		if (*s == '(') {
X			while (*s != ')')
X				s++;
X		}
X		if (*s == ',') {
X			*s++ = '\0';
X			arg2 = s;
X			break;
X		}
X	}
X
X	getarg(&ni->src, args);
X	getarg(&ni->dst, arg2);
X}
X
X/*
X * delinst(bp, ip) - delete instruction 'ip' in block 'bp'
X */
Xvoid
Xdelinst(bp, ip)
XBLOCK	*bp;
Xregister INST	*ip;
X{
X	register INST	*pi, *ni;	/* previous and next instructions */
X
X	pi = ip->prev;
X	ni = ip->next;
X
X	if (pi != NULL)
X		pi->next = ni;
X	else
X		bp->first = ni;
X
X	if (ni != NULL)
X		ni->prev = pi;
X	else
X		bp->last = pi;
X
X	/*
X	 * Free space used by the instruction.
X	 */
X	freeop(&ip->src);
X	freeop(&ip->dst);
X	free(ip);
X
X	s_idel++;
X}
X
X/*
X * getarg(op, s) - parse string 's' into the operand structure 'op'
X *
X * Hack alert!! The following code parses the operands only to the
X * extent needed by the optimizer. We're primarily interested in
X * details about addressing modes used, not in any expressions that
X * might be present. This code is highly tuned to the output of the
X * compiler.
X */
Xstatic	void
Xgetarg(op, s)
Xregister struct	opnd	*op;
Xregister char	*s;
X{
X	extern	long	atol();
X	register int	reg;
X	register char	*p;
X
X	if (*s == '\0') {
X		op->amode = NONE;
X		return;
X	}
X
X	if (*s == '#') {				/* immediate data */
X		op->amode = IMM;
X		s += 1;
X		if (isdigit(s[0]) || s[0] == '-')
X			op->disp  = atol(s);
X		else {
X			op->amode |= SYMB;
X			op->astr = strsave(s);
X		}
X		return;
X	} else if ((reg = isreg(s)) >= 0) {		/* reg. direct */
X		op->amode = REG;
X		op->areg = reg;
X	} else if (s[0] == '(' || (s[0] == '-' && s[1] == '(')) {
X		op->amode = REGI;
X		if (s[0] == '-') {
X			op->amode |= DEC;
X			s++;
X		}
X		s++;		/* skip the left paren */
X		if ((op->areg = isreg(s)) < 0) {
X			fprintf(stderr, "bad reg. '%s'\n", s);
X			exit(1);
X		}
X		s += 3;		/* skip the register and right paren */
X
X		if (s[0] == '+')
X			op->amode |= INC;
X	} else if (!isdigit(s[0]) && (s[0] != '-')) {
X		op->amode = ABS;
X		op->astr = strsave(s);
X	} else {
X		for (p=s; isdigit(*p) || *p == '-' ;p++)
X			;
X		if (*p != '(') {
X			/*
X			 * Must have been absolute, but with an
X			 * address instead of a symbol.
X			 */
X			op->amode = ABS;
X			op->astr = strsave(s);
X			return;
X		}
X		*p++ = '\0';
X		op->disp = atol(s);
X		s = p;
X		if (s[0] == 'p' && s[1] == 'c') {	/* PC relative */
X			if (s[2] == ')') {
X				op->amode = PCD;
X				return;
X			}
X			op->amode = PCDX;
X			op->ireg = isreg(s+3);
X			if (s[6] == 'l')
X				op->amode |= XLONG;
X		} else if ((reg = isreg(s)) >= 0) {
X			op->areg = reg;
X			if (s[2] == ')') {
X				op->amode = REGID;
X				return;
X			}
X			op->amode = REGIDX;
X			op->ireg = isreg(s+3);
X			if (s[6] == 'l')
X				op->amode |= XLONG;
X		} else {
X			fprintf(stderr, "bad reg. '%s' after disp\n", s);
X			exit(1);
X		}
X	}
X}
X
X/*
X * characters that can terminate a register name
X */
X#define	isterm(c) ((c) == '\0' || (c) == ')' || (c) == ',' || (c) == '.')
X
Xstatic	int
Xisreg(s)
Xregister char	*s;
X{
X	if (s[0] == 'd' && isdigit(s[1]) && isterm(s[2]))
X		return D0 + (s[1] - '0');
X	if (s[0] == 'a' && isdigit(s[1]) && isterm(s[2]))
X		return A0 + (s[1] - '0');
X	if (s[0] == 's' && s[1] == 'p' && isterm(s[2]))
X		return SP;
X
X	return -1;
X}
X
X
X/*
X * Routines for printing out instructions
X */
X
Xstatic	char	*rstr();
Xstatic	void	putop();
X
Xvoid
Xputinst(ip)
Xregister INST	*ip;
X{
X	char	c;
X
X	fprintf(ofp, "\t%s", opnames[ip->opcode]);
X
X	switch (ip->flags) {
X	case LENB:
X		c = 'b';
X		break;
X	case LENW:
X		c = 'w';
X		break;
X	case LENL:
X		c = 'l';
X		break;
X	default:
X		c = '\0';
X		break;
X	}
X	if (c)
X		fprintf(ofp, ".%c", c);
X
X	if (ip->src.amode != NONE) {
X		fprintf(ofp, "\t");
X		putop(&ip->src);
X	}
X
X	if (ip->dst.amode != NONE) {
X		fprintf(ofp, ",");
X		putop(&ip->dst);
X	}
X#ifdef	DEBUG
X	if (debug)
X		fprintf(ofp, "\t\t* ref(%04x), set(%04x), live(%04x)",
X			reg_ref(ip), reg_set(ip), ip->live);
X#endif
X	fprintf(ofp, "\n");
X}
X
Xstatic	void
Xputop(op)
Xregister struct	opnd	*op;
X{
X	switch (op->amode & MMASK) {
X	case NONE:
X		break;
X	case REG:
X		fprintf(ofp, "%s", rstr(op->areg));
X		break;
X	case IMM:
X		if (op->amode & SYMB)
X			fprintf(ofp, "#%s", op->astr);
X		else
X			fprintf(ofp, "#%ld", op->disp);
X		break;
X	case ABS:
X		fprintf(ofp, "%s", op->astr);
X		break;
X	case REGI:
X		if (op->amode & DEC)
X			fprintf(ofp, "-");
X		fprintf(ofp, "(%s)", rstr(op->areg));
X		if (op->amode & INC)
X			fprintf(ofp, "+");
X		break;
X	case REGID:
X		fprintf(ofp, "%ld(%s)", op->disp, rstr(op->areg));
X		break;
X	case REGIDX:
X		fprintf(ofp, "%ld(%s,", op->disp, rstr(op->areg));
X		fprintf(ofp, "%s.%c)", rstr(op->ireg),
X			(op->amode & XLONG) ? 'l' : 'w');
X		break;
X	case PCD:
X		fprintf(ofp, "%ld(pc)", op->disp);
X		break;
X	case PCDX:
X		fprintf(ofp, "%ld(pc,%s.%c)", op->disp, rstr(op->ireg),
X			(op->amode & XLONG) ? 'l' : 'w');
X		break;
X	default:
X		fprintf(stderr, "bad addr. mode in putop: %d\n", op->amode);
X		exit(1);
X	}
X}
X
Xstatic	char *
Xrstr(r)
Xregister char	r;
X{
X	static	char	buf[3];
X
X	if (r == SP) {
X		buf[0] = 's';
X		buf[1] = 'p';
X	} else if (r >= A0 && r <= A6) {
X		buf[0] = 'a';
X		buf[1] = '0' + (r - A0);
X	} else {
X		buf[0] = 'd';
X		buf[1] = '0' + (r - D0);
X	}
X	buf[2] = '\0';
X
X	return buf;
X}
X
X/*
X * opeq(op1, op2) - test equality of the two instruction operands
X */
Xbool
Xopeq(op1, op2)
Xregister struct	opnd	*op1, *op2;
X{
X	if (op1->amode != op2->amode || op1->areg != op2->areg ||
X	    op1->ireg  != op2->ireg)
X		return FALSE;
X
X	/*
X	 * Depending on the addressing mode, we either need to
X	 * compare the "astr" strings, or the displacements.
X	 */
X	if ((op1->amode == ABS) || (op1->amode == (IMM|SYMB))) {
X		/* compare strings */
X		if (op1->astr == NULL)
X			return (op2->astr == NULL);
X		else {
X			if (op2->astr == NULL)
X				return FALSE;
X	
X			return (strcmp(op1->astr, op2->astr) == 0);
X		}
X	} else {
X		/* compare displacements */
X		return (op1->disp == op2->disp);
X	}
X}
END_OF_FILE
if test 7882 -ne `wc -c <'top/INST.C'`; then
    echo shar: \"'top/INST.C'\" unpacked with wrong size!
fi
# end of 'top/INST.C'
fi
if test -f 'top/PEEP1.C' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'top/PEEP1.C'\"
else
echo shar: Extracting \"'top/PEEP1.C'\" \(5178 characters\)
sed "s/^X//" >'top/PEEP1.C' <<'END_OF_FILE'
X/* Copyright (c) 1988 by Sozobon, Limited.  Author: Tony Andrews
X *
X * Permission is granted to anyone to use this software for any purpose
X * on any computer system, and to redistribute it freely, with the
X * following restrictions:
X * 1) No charge may be made other than reasonable charges for reproduction.
X * 2) Modified versions must be clearly marked as such.
X * 3) The authors are not responsible for any harmful consequences
X *    of using this software, even if they result from defects in it.
X */
X
X/*
X * Single-instruction peephole optimizations and the overall driver routine.
X */
X
X#include "top.h"
X
X
Xvoid
Xpeep(bp)
Xregister BLOCK	*bp;
X{
X	bool	peep1(), peep2(), peep3();
X	extern	BLOCK	*fhead;
X	register bool	changed;
X
X	peep1(bp);
X
X	/*
X	 * Loop until no more changes are made. After each change, do
X	 * live/dead analysis or the data gets old. In each loop, make
X	 * at most one change.
X	 */
X	do {
X		changed = peep3(bp);
X
X		if (!changed)
X			changed = peep2(bp);
X
X		if (!changed)
X			changed = peep1(bp);
X
X		rhealth(fhead, FALSE);
X
X	} while (changed);
X}
X
X/*
X * ipeep1(ip) - check for changes to the instruction 'ip'
X */
Xstatic	bool
Xipeep1(bp, ip)
Xregister BLOCK	*bp;
Xregister INST	*ip;
X{
X	/*
X	 * clr.l  Dn			=> moveq.l  Dn
X	 */
X	if (ip->opcode == CLR && ip->src.amode == REG &&
X	    ISD(ip->src.areg) && (ip->flags & LENL)) {
X		ip->opcode = MOVEQ;
X		ip->dst = ip->src;	/* we'll have two operands now */
X		ip->src.amode = IMM;
X		ip->src.disp = 0;
X		DBG(printf("%d ", __LINE__))
X		return TRUE;
X	}
X
X	/*
X	 * move.*  #n,Dn		=> moveq.l  #n,Dn
X	 *
X	 * moveq is always a long operation, but as long as the immediate
X	 * value is appropriate, we don't care what the original length
X	 * was. Clearing upper bytes won't matter.
X	 */
X	if (ip->opcode == MOVE && ip->src.amode == IMM && ISD(ip->dst.areg) &&
X	    D8OK(ip->src.disp)) {
X	    	ip->opcode = MOVEQ;
X	    	ip->flags = LENL;
X		DBG(printf("%d ", __LINE__))
X	    	return TRUE;
X	}
X
X	/*
X	 * add.x  #n, X 		=> addq.x  #n, X
X	 *
X	 * where 1 <= n <= 8
X	 */
X	if (ip->opcode == ADD && ip->src.amode == IMM &&
X	    ip->src.disp >= 1 && ip->src.disp <= 8) {
X	    	ip->opcode = ADDQ;
X		DBG(printf("%d ", __LINE__))
X	    	return TRUE;
X	}
X
X	/*
X	 * sub.x  #n, X 		=> subq.x  #n, X
X	 *
X	 * where 1 <= n <= 8
X	 */
X	if (ip->opcode == SUB && ip->src.amode == IMM &&
X	    ip->src.disp >= 1 && ip->src.disp <= 8) {
X	    	ip->opcode = SUBQ;
X		DBG(printf("%d ", __LINE__))
X	    	return TRUE;
X	}
X
X	/*
X	 * movem.x  Reg,-(sp)		=> move.x Reg,-(sp)
X	 */
X	if (ip->opcode == MOVEM && ip->src.amode == REG &&
X	    ip->dst.areg == SP && ip->dst.amode == (REGI|DEC)) {
X	    	ip->opcode = MOVE;
X		DBG(printf("%d ", __LINE__))
X	    	return TRUE;
X	}
X
X	/*
X	 * movem.x  (sp)+,Reg		=> move.x (sp)+,Reg
X	 */
X	if (ip->opcode == MOVEM && ip->dst.amode == REG &&
X	    ip->src.amode == (REGI|INC) && ip->src.areg == SP) {
X	    	ip->opcode = MOVE;
X		DBG(printf("%d ", __LINE__))
X	    	return TRUE;
X	}
X
X	/*
X	 *	add[q]	#?, Rn
X	 *
X	 * Remove instruction if Rn is dead. This is most often used
X	 * to eliminate the fixup of SP following a function call when
X	 * we're just about to return, since the "unlk" clobbers SP
X	 * anyway.
X	 */
X	if ((ip->opcode == ADDQ || ip->opcode == ADD) && ip->src.amode == IMM &&
X	     ip->dst.amode == REG) {
X
X		if ((ip->live & RM(ip->dst.areg)) == 0) {
X		     	delinst(bp, ip);
X			DBG(printf("%d ", __LINE__))
X		     	return TRUE;
X		}
X	}
X
X	/*
X	 *	move.x	X, X
X	 *
X	 *	Delete as long as X isn't INC or DEC
X	 */
X	if ((ip->opcode == MOVE) && opeq(&ip->src, &ip->dst) &&
X	    ((ip->src.amode & (INC|DEC)) == 0)) {
X
X		delinst(bp, ip);
X		DBG(printf("%d ", __LINE__))
X		return TRUE;
X	}
X
X	/*
X	 *	move.x	Rm, Rn
X	 *
X	 *	Delete if Rn is dead.
X	 */
X	if (ip->opcode == MOVE &&
X	     ip->src.amode == REG && ip->dst.amode == REG) {
X
X		if ((ip->live & RM(ip->dst.areg)) == 0) {
X		     	delinst(bp, ip);
X			DBG(printf("%d ", __LINE__))
X		     	return TRUE;
X		}
X	}
X
X
X	/*
X	 *	cmp.x	#0, X		=>	tst.x	X
X	 *	beq/bne				beq/bne
X	 *
X	 *	Where X is not An
X	 */
X	if (bp->last == ip && (bp->bcode == BEQ || bp->bcode == BNE) &&
X	    ip->opcode == CMP &&
X	    ((ip->dst.amode != REG) || !ISA(ip->dst.areg))) {
X
X		if (ip->src.amode == IMM && ip->src.disp == 0) {
X			ip->opcode = TST;
X			ip->src = ip->dst;
X			ip->dst.amode = NONE;
X			DBG(printf("%d ", __LINE__))
X			return TRUE;
X		}
X	}
X
X	/*
X	 * add.x  #n, Am 		=> lea  n(Am), Am
X	 *
X	 * where 'n' is a valid displacement
X	 */
X	if (ip->opcode == ADD && ip->src.amode == IMM && ip->dst.amode == REG &&
X	    ISA(ip->dst.areg) && DOK(ip->src.disp)) {
X	    	ip->opcode = LEA;
X	    	ip->flags = 0;
X	    	ip->src.amode = REGID;
X	    	ip->src.areg = ip->dst.areg;
X		DBG(printf("%d ", __LINE__))
X	    	return TRUE;
X	}
X
X	return FALSE;
X}
X
X/*
X * peep1(bp) - peephole optimizations with a window size of 1
X */
Xstatic	bool
Xpeep1(bp)
Xregister BLOCK	*bp;
X{
X	register INST	*ip;
X	register bool	changed = FALSE;
X	register bool	bchange;
X
X	DBG(printf("p1: "))
X	for (; bp != NULL ;bp = bp->next) {
X		bchange = FALSE;
X		for (ip = bp->first; ip != NULL ;ip = ip->next) {
X			if (ipeep1(bp, ip)) {
X				s_peep1++;
X				changed = TRUE;
X				bchange = TRUE;
X			}
X		}
X		if (bchange)
X			bprep(bp);
X	}
X	DBG(printf("\n"); fflush(stdout))
X	return changed;
X}
END_OF_FILE
if test 5178 -ne `wc -c <'top/PEEP1.C'`; then
    echo shar: \"'top/PEEP1.C'\" unpacked with wrong size!
fi
# end of 'top/PEEP1.C'
fi
echo shar: End of archive 2 \(of 9\).
cp /dev/null ark2isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 9 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0