changeset 100:990add11e9f8

add micro-c stuff
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 27 Dec 2018 11:49:54 +0900
parents 92ed427b7f7d
children 15569aa4098e
files os9/mc09/c.txt os9/mc09/crtos9.asm os9/mc09/makefile os9/mc09/mc.c os9/mc09/mc2.c os9/mc09/mclibos9.c src/a09.c
diffstat 7 files changed, 947 insertions(+), 55 deletions(-) [+]
line wrap: on
line diff
--- a/os9/mc09/c.txt	Thu Dec 27 11:01:16 2018 +0900
+++ b/os9/mc09/c.txt	Thu Dec 27 11:49:54 2018 +0900
@@ -375,7 +375,7 @@
 * micro-C user program
 *
 *	OPT	LIST
-	LIB	c.out		include compilers output
+	INCLUDE	"c.out"		include compilers output
 *	OPT	NOL
 *
 *
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/os9/mc09/crtos9.asm	Thu Dec 27 11:49:54 2018 +0900
@@ -0,0 +1,386 @@
+
+*
+* micro-C driver under FLEX
+*
+*	12-Dec-81	M.Ohta,H.Tezuka
+*
+
+	ORG	$100
+
+_00000
+	LDX	$CC2B		LOAD MEM END
+	LEAS	1,X
+	
+	JSR	$CD24		CR/LF
+	
+	LEAS	-256,S		ALLOCATE WORK AREA
+	LEAU	128,S		POINT TO CONTENT OF ARGUMENT VECTOR
+
+	STU	,S
+	BSR	_0C004		GET ARGV[0]
+	CLRA			ARGC*2
+_0C000	ADDA	#2		INCREMENT ARGC
+	STU	A,S
+	PSHS	A
+	BSR	_0C009		GET NEXT ARGV
+	PULS	A
+	CMPU	#-1
+	BNE	_0C000
+	STU	A,S
+
+	LEAU	128,S
+	TFR	A,B
+_0C001	LDX	A,S
+	PSHU	X
+	SUBA	#2
+	BNE	_0C001
+	LDX	,S
+	PSHU	X
+	LEAS	,U
+	LSRB
+	CLRA
+	PSHS	D,U		push argc,argv
+	LEAY	_99999,PCR	clear globals
+	LDX	#_GLOBALS
+_0C002	BEQ	_0C003
+	CLR	,Y+
+	LEAX	-1,X
+	BRA	_0C002
+
+_0C003	LEAY	_99999,PCR
+	LBSR	_INITIALIZE	call initializer
+	LBSR	_main
+exit	JSR	$D403		FMS close
+	JMP	$CD03		WARMS
+
+_0C004	LDX	$CC14
+_0C005	CMPX	#$C080
+	BEQ	_0C007
+	LDB	,-X
+	CMPB	#$0D
+	BEQ	_0C006
+	CMPB	$CC02
+	BNE	_0C005
+_0C006	LEAX	1,X
+_0C007	LDB	,X+
+	CMPB	#' 
+	BEQ	_0C008
+	STB	,U+
+	CMPX	#$CC02
+	BLO	_0C007
+_0C008	CLR	,U+
+	RTS
+
+_0C009	JSR	$CD27
+	CMPA	#' 
+	BEQ	_0C009
+	CMPA	#$0D
+	BEQ	_0C013
+	CMPA	$CC02
+	BEQ	_0C013
+_0C010	CMPA	#'"
+	BEQ	_0C014
+	CMPA	#''
+	BEQ	_0C014
+	CMPA	#' 
+	BEQ	_0C012
+	CMPA	#$0D
+	BEQ	_0C012
+	CMPA	$CC02
+	BEQ	_0C012
+	STA	,U+
+_0C011	JSR	$CD27
+	BRA	_0C010
+
+_0C012	CLR	,U+
+	RTS
+
+_0C013	LDU	#-1
+	RTS
+
+_0C014	PSHS	A
+	LDX	$CC14
+_0C015
+	LDA	,X+
+	CMPA	#$0D
+	BEQ	_0C016
+	CMPA	,S
+	BEQ	_0C017
+	STA	,U+
+	BRA	_0C015
+
+_0C016	LEAX	-1,X
+_0C017	STX	$CC14
+	PULS	A
+	BRA	_0C011
+
+*
+* run time support
+*
+
+FMS	LDX	2,S
+	LDA	5,S
+	STA	,X
+	LDA	7,S
+	TST	59,X
+	BMI	_FMS1
+	CMPA	#$0A
+	BNE	_FMS0
+	LDA	#$0D
+_FMS0	CMPA	#$09
+	BNE	_FMS1
+	LDA	#$20
+_FMS1	JSR	$D406
+	BNE	_FMSERR
+	TFR	A,B
+	TST	59,X
+	BMI	_FMS9
+	CMPB	#$0D
+	BNE	_FMS8
+	LDB	#$0A
+_FMS8	CMPB	#$09
+	BNE	_FMS9
+	LDB	#$20
+_FMS9	CLRA
+	RTS
+	
+_FMSERR LDD	#-1
+	RTS
+	
+GETCH	PSHS	X,Y,U
+	JSR	$CD15		get character
+	TFR	A,B
+	ANDB	#$7F
+	CMPB	#26		control-Z ?
+	BNE	_0G001
+	LDD	#-1
+	PULS	X,Y,U,PC
+
+_0G001	CMPB	#$0D
+	BNE	_0G002
+	LDB	#$0A
+_0G002	CLRA
+	PULS	X,Y,U,PC
+*
+PUTCH	LDD	2,S
+	PSHS	D,X,Y,U
+	TFR	B,A
+	CMPA	#$09
+	BNE	_0P001
+	LDA	#$20
+_0P001	CMPA	#$0A
+	BNE	_0P002
+	JSR	$CD24		put CR/LF
+	PULS	D,X,Y,U,PC
+
+_0P002	JSR	$CD18		put character
+	PULS	D,X,Y,U,PC
+*
+PUTCH2	LDD	2,S
+	PSHS	D
+	LDA	$CC22
+	PSHS	A
+	LDA	#$FF
+	STA	$CC22
+	LDD	1,S
+	PSHS	D
+	BSR	PUTCH
+	LEAS	2,S
+	PULS	A
+	STA	$CC22
+	PULS	D,PC
+*
+_00001	PSHS	D,X,Y		multiply
+	
+	LDA	,S
+	LDB	3,S
+	MUL
+	STB	4,S
+	
+	LDD	1,S
+	MUL
+	STB	5,S
+	
+	LDA	1,S
+	LDB	3,S
+	MUL
+	ADDA	4,S
+	ADDA	5,S
+	
+	LEAS	6,S
+	RTS
+*
+_00002	CLR	,-S		signed divide
+	
+	CMPX	#0
+	BPL	_02000
+	
+	COM	,S
+	
+	EXG	D,X
+	LBSR	_00020
+	EXG	D,X
+
+_02000	TSTA
+	BPL	_02001
+	
+	COM	,S
+	
+	LBSR	_00020
+	
+_02001	LBSR	_00010
+	TFR	X,D
+	TST	,S+
+	BPL	_02002
+	
+	LBSR	_00020
+	
+_02002	RTS
+*
+_00003	LBSR	_00010		unsigned divide
+	TFR	X,D
+	RTS
+*
+_00004	CLR	,-S		signed modulous
+	
+	CMPX	#0
+	BPL	_04000
+	
+	EXG	D,X
+	BSR	_00020
+	EXG	D,X
+
+_04000	TSTA
+	BPL	_04001
+	
+	COM	,S
+	BSR	_00020
+	
+_04001	BSR	_00010
+	
+	TST	,S+
+	BPL	_04002
+	
+	BSR	_00020
+	
+_04002	RTS
+*
+_00005	BSR	_00010		unsigned modulous
+
+	RTS
+*
+_00006	CMPX	#0		signed left shift
+	BMI	_06001
+ 
+_06000	BEQ	_06009
+	LSLB
+	ROLA
+	LEAX	-1,X
+	BRA	_06000
+	
+_06001	BEQ	_06009
+	ASRA
+	RORB
+	LEAX	1,X
+	BRA	_06001
+	
+_06009	RTS
+*
+_00007	CMPX	#0		unsined left shift
+	BMI	_07001
+	
+_07000	BEQ	_07009
+	LSLB
+	ROLA
+	LEAX	-1,X
+	BRA	_07000
+	
+_07001	BEQ	_07009
+	LSRA
+	RORB
+	LEAX	1,X
+	BRA	_07001
+	
+_07009	RTS
+*
+_00008	CMPX	#0		sined right shift
+	BMI	_08001
+	
+_08000	BEQ	_08009
+	ASRA
+	RORB
+	LEAX	-1,X
+	BRA	_08000
+	
+_08001	BEQ	_08009
+	LSLB
+	ROLA
+	LEAX	1,X
+	BRA	_08001
+	
+_08009	RTS
+*
+_00009	CMPX	#0		unsined right shift
+	BMI	_09001
+	
+_09000	BEQ	_09009
+	LSRA
+	RORB
+	LEAX	-1,X
+	BRA	_09000
+	
+_09001	BEQ	_09009
+	LSLB
+	ROLA
+	LEAX	1,X
+	BRA	_09001
+	
+_09009	RTS
+*
+_00020	NEGA			negate D reg
+	NEGB
+	SBCA	#0
+	RTS
+*
+_00010	PSHS	D,X		divide subroutine
+	
+	CLRA
+	CLRB
+	
+	LDX	#17
+	
+_00011	SUBD	2,S
+	BCC	_00012
+	
+	ADDD	2,S
+	
+_00012	ROL	1,S
+	ROL	,S
+	ROLB
+	ROLA
+	
+	LEAX	-1,X
+	BNE	_00011
+	
+	RORA
+	RORB
+	
+	COM	1,S
+	COM	,S
+	PULS	X
+	
+	LEAS	2,S
+	RTS
+*
+* micro-C user program
+*
+*	OPT	LIST
+	INCLUDE	"c.out"		include compilers output
+*	OPT	NOL
+*
+*
+*
+_99999	EQU	*		global vars allocated here
+*
+	END	_00000
+
--- a/os9/mc09/makefile	Thu Dec 27 11:01:16 2018 +0900
+++ b/os9/mc09/makefile	Thu Dec 27 11:49:54 2018 +0900
@@ -5,16 +5,20 @@
 
 DESTDIR=/usr/local/bin
 
+CFLAGS = -m32 -Wno-return-type -Wno-implicit-int -Wno-implicit-function-declaration -Wno-parentheses
+
+AS09 = ../../src/a09
+
 all:	mc2.o
 
 mc: mc.c
-	cc mc.c -o mc
+	cc $(CFLAGS) mc.c -o mc
 
 c.out:	mc mc2.c mclib.c
-	mc mc2.c
+	./mc mc2.c
 
 mc2.o:	c.out
-	as09 c.txt -o mc2.o -v -O
+	$(AS09) c.txt -l c.lst -o mc2.o 
 
 lint: mc.c
 	lint mc.c >lint
--- a/os9/mc09/mc.c	Thu Dec 27 11:01:16 2018 +0900
+++ b/os9/mc09/mc.c	Thu Dec 27 11:49:54 2018 +0900
@@ -5,6 +5,10 @@
 */
 #include <stdio.h>
 
+/* to avoid conflict with stdio.h */
+#define getline getline1
+#define index index1
+
 #define INT	(-1)
 #define CHAR	(-2)
 #define UNSIGNED	(-3)
@@ -235,7 +239,7 @@
 			fprintf(stderr,
 				"Total global variables : %u bytes.\n\n",gpc);
 			printf("_%d\tRTS\n_INITIALIZE\tEQU\t_1\n",ilabel);
-			printf("_GLOBALS\tEQU\t%u\n\tEND\n",gpc);
+			printf("_GLOBALS\tEQU\t%u\n",gpc);
 			exit(0);
 		}
 	fprintf(stderr,"%5d:%s.\n",lineno,
--- a/os9/mc09/mc2.c	Thu Dec 27 11:01:16 2018 +0900
+++ b/os9/mc09/mc2.c	Thu Dec 27 11:49:54 2018 +0900
@@ -233,7 +233,7 @@
 			fprintf(stderr,
 				"Total global variables : %u bytes.\n\n",gpc);
 			printf("_%d\tRTS\n_INITIALIZE\tEQU\t_1\n",ilabel);
-			printf("_GLOBALS\tEQU\t%u\n\tEND\n",gpc);
+			printf("_GLOBALS\tEQU\t%u\n",gpc);
 			exit(0);
 		}
 	fprintf(stderr,"%5d:%s.\n",lineno,
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/os9/mc09/mclibos9.c	Thu Dec 27 11:49:54 2018 +0900
@@ -0,0 +1,486 @@
+#define	FILE	char
+#define	FCBSIZE	320
+#define	NFILES	8
+
+#define	NULL	0
+#define EOF	(-1)
+
+#define	stdin	_fcbtbl[0]
+#define	stdout	_fcbtbl[1]
+#define	stderr	_fcbtbl[2]
+
+#define	STDIN	0xffff
+#define	STDOUT	0xfffe
+#define	STDERR	0xfffd
+
+FILE *_fcbtbl[NFILES];
+
+_main(argc,argv)
+int argc;
+char **argv;
+{int i;
+	stdin = STDIN;
+	stdout = STDOUT;
+	stderr = STDERR;
+	initheap();
+	for ( i = 3; i < NFILES; i++ ) _fcbtbl[i] = NULL;
+	main(argc,argv);
+}
+
+FILE *fopen(name,mode)
+char *name,*mode;
+{FILE *fcbp;
+ char *p;
+ int rd,wt,cm;
+	rd = wt = cm = 0;
+	for ( p = mode; *p; p++ ) {
+		switch ( *p ) {
+		case 'r':
+			rd = 1; break;
+		case 'w':
+			wt = 1; break;
+		case 'c':
+			cm = 1; break;
+		default:
+			return NULL;
+		}
+	}
+	if ( !(rd ^ wt) ) return NULL;
+	if ( rd ) return _open(name,cm);
+	else return _create(name,cm);
+}
+
+FILE *_open(name,cm)
+char *name;
+int cm;
+{FILE *fcbp;
+ int i;
+	for ( i = 0; i < NFILES; i++)
+		if ( _fcbtbl[i] == NULL ) break;
+	if ( i >= NFILES) return NULL;
+	if ( (fcbp = malloc(FCBSIZE)) == NULL ) return NULL;
+	if ( _setname(name,fcbp) == 0 ) return NULL;
+	if ( FMS(fcbp,1) < 0 ) return NULL;
+	fcbp[59] = cm ? 0 : 0xff;
+	fcbp[60] = 0;
+	return (_fcbtbl[i] = fcbp);
+}
+
+FILE *_create(name,cm)
+char *name;
+int cm;
+{FILE *fcbp;
+ int i;
+	for ( i = 0; i < NFILES; i++)
+		if ( _fcbtbl[i] == NULL ) break;
+	if ( i >= NFILES) return NULL;
+	if ( (fcbp = malloc(FCBSIZE)) == NULL ) return NULL;
+	if ( _setname(name,fcbp) == 0 ) return NULL;
+	if ( FMS(fcbp,2) < 0 )
+	{	if ( (fcbp[1] != 3) || (FMS(fcbp,12) < 0) ) return NULL;
+		_setname(name,fcbp);
+		if (FMS(fcbp,2) < 0) return NULL;
+	}
+	fcbp[15] = 0;
+	fcbp[59] = cm ? 0 : 0xff;
+	fcbp[60] = 0;
+	return (_fcbtbl[i] = fcbp);
+}
+
+fclose(fcbp)
+FILE *fcbp;
+{int i;
+	for ( i = 0; i < NFILES; i++ )
+		if ( fcbp == _fcbtbl[i] ) break;
+	if ( i >= NFILES ) return EOF;
+	_fcbtbl[i] = NULL;
+	if ( (fcbp == STDIN) || (fcbp == STDOUT) || (fcbp == STDERR) ) return 0;
+	if ( FMS(fcbp,4) < 0 ) return EOF;
+	mfree(fcbp);
+	return 0;
+}
+
+_setname(name,fcbp)
+char *name,*fcbp;
+{int i;
+	while(isspace(*name)) ++name;
+	if (isdigit(*name))
+	{	fcbp[3] = *name++ - '0';
+		if (*name++ != '.') return 0;
+	}
+	else fcbp[3] = 0xff;
+	for (i = 4; i < 15; ++i) fcbp[i] = 0;
+	if (!isalpha(*name)) return -1;
+	for (i = 4; i < 12; ++i)
+	{	if (!*name || (*name == '.')) break;
+		fcbp[i] = *name++;
+	}
+	while (*name && (*name != '.')) ++name;
+	if (*name == '.')
+	{	++name;
+		for (i = 12; i < 15; ++i)
+		{	if (!*name) break;
+			fcbp[i] = *name++;
+		}
+	}
+	return 1;
+}
+
+
+getc(fcbp)
+char *fcbp;
+{
+	switch (fcbp)
+	{case STDIN:
+		return GETCH();
+	case STDOUT:
+	case STDERR:
+		return EOF;
+	default:
+		if (fcbp[2] != 1) return EOF;
+		return FMS(fcbp,0);
+	}
+}
+
+putc(c,fcbp)
+char c,*fcbp;
+{	if ( c == '\t' ) c = ' ';
+	switch (fcbp)
+	{case STDIN:
+		return EOF;
+	case STDOUT:
+		return PUTCH(c);
+	case STDERR:
+		return PUTCH2(c);
+	default:
+		if (fcbp[2] != 2) return EOF;
+		if (FMS(fcbp,0,c) < 0) return EOF;
+		return c;
+	}
+}
+
+getchar()
+{	return getc(stdin);
+}
+
+putchar(c)
+char c;
+{	return putc(c,stdout);
+}
+
+printf(s)
+char *s;
+{	_fprintf(stdout,s,(int *)&s+1);
+}
+
+fprintf(f,s)
+char *f,*s;
+{	_fprintf(f,s,(int *)&s+1);
+}
+
+_fprintf(f,s,p)
+char *f,*s;
+int *p;
+{int l,m,n;
+ char c,buf[8];
+	while(c = *s++)
+		if (c != '%') putc(c,f);
+		else
+		{	if (l=(*s == '-')) ++s;
+			if (isdigit(*s)) s += _getint(&m,s);
+			else m = 0;
+			if (*s == '.') ++s;
+			if (isdigit(*s)) s += _getint(&n,s);
+			else n = 32767;
+			switch(*s++)
+			{case 'd':
+				itoa(*p++,buf);
+				break;
+			case 'o':
+				itooa(*p++,buf);
+				break;
+			case 'x':
+				itoxa(*p++,buf);
+				break;
+			case 'u':
+				itoua(*p++,buf);
+				break;
+			case 'c':
+				ctos(*p++,buf);
+				break;
+			case 's':
+				_putstr(f,*p++,l,m,n);
+				continue;
+			case '\0':
+				return;
+			default:
+				ctos(c,buf);
+				break;
+			}
+			_putstr(f,buf,l,m,n);
+		}
+}
+
+_getint(p,s)
+int *p;
+char *s;
+{int i;
+	for(*p=i=0; isdigit(*s); ++i) *p = *p * 10 + *s++ - '0';
+	return i;
+}
+
+_putstr(f,s,l,m,n)
+char *f,*s;
+int l,m,n;
+{int k;
+	k = (strlen(s) < n ? strlen(s) : n);
+	m = (k < m ? m-k : 0);
+	if (l)
+	{	_putsn(f,s,n);
+		_putspc(f,m);
+	}
+	else
+	{	_putspc(f,m);
+		_putsn(f,s,n);
+	}
+}
+	
+_putsn(f,s,n)
+char *f,*s;
+int n;
+{	while(*s)
+		if (--n >= 0) putc(*s++,f);
+		else break;
+}
+
+_putspc(f,n)
+char *f;
+int n;
+{	while(--n >= 0) putc(' ',f);
+}
+
+puts(s)
+char *s;
+{	while(*s) putchar(*s++);
+}
+
+itoa(n,s)
+int n;
+char *s;
+{	if (n < 0)
+	{	*s++ = '-';
+		return (itoua(-n,s)+1);
+	}
+	return itoua(n,s);
+}
+
+itoua(n,s)
+int n;
+char *s;
+{	return _itoda(n,s,10);
+}
+
+itooa(n,s)
+int n;
+char *s;
+{	return _itoda(n,s,8);
+}
+
+itoxa(n,s)
+int n;
+char *s;
+{	return _itoda(n,s,16);
+}
+
+_itoac(n)
+int n;
+{	return (n + ((n < 10) ? '0' : ('A'-10)));
+}
+
+_itoda(n,s,r)
+unsigned n;
+int r;
+char *s;
+{int i;
+ char t[8],*u;
+	u = t;
+	*u++ = '\0';
+	do *u++ = _itoac(n % r); while(n /= r);
+	for (i=0; *s++ = *--u; ++i);
+	return i;
+}
+
+char *ctos(c,s)
+char c,*s;
+{	s[0] = c;
+	s[1] = '\0';
+	return s;
+}
+
+strlen(s)
+char *s;
+{int i;
+	for(i = 0; *s++; ++i);
+	return i;
+}
+
+isdigit(c)
+char c;
+{	return '0' <= c && c <= '9';
+}
+
+isspace(c)
+char c;
+{	return (c == ' ' || c == '\t' || c == '\n');
+}
+
+isalpha(c)
+char c;
+{	return (isupper(c) || islower(c) || c == '_');
+}
+
+isupper(c)
+char c;
+{	return ('A' <= c && c <= 'Z');
+}
+
+islower(c)
+char c;
+{	return ('a' <= c && c <= 'z');
+}
+
+toupper(c)
+char c;
+{	return (islower(c) ? c + ('A'-'a') : c);
+}
+
+tolower(c)
+char c;
+{	return (isupper(c) ? c + ('a'-'A') : c);
+}
+
+atoi(s)
+char *s;
+{int i;
+	while (isspace(*s)) ++s;
+	for (i = 0; isdigit(*s);) i = i * 10 + *s++ - '0';
+	return i;
+}
+
+typedef struct header
+		{	struct header *bptr;
+			unsigned bsize;
+		} HEADER;
+
+HEADER base,*allocp,*heapp;
+
+char *malloc(s)
+unsigned s;
+{HEADER *p,*q;
+ int nunits;
+	nunits = 1 + (s + sizeof(HEADER) - 1) / sizeof(HEADER);
+	if ((q = allocp) == NULL)
+	{	base.bptr = allocp = q = &base;
+		base.bsize = 0;
+	}
+	for (p = q->bptr; ; q = p,p = p->bptr)
+	{	if (p->bsize >= nunits)
+		{	if (p->bsize == nunits)
+				q->bptr = p->bptr;
+			else
+			{	p->bsize -= nunits;
+				p += p->bsize;
+				p->bsize = nunits;
+			}
+			allocp = q;
+			clearblock(p);
+			return ((char *)(p + 1));
+		}
+		if (p == allocp)
+			if ((p = morecore(nunits)) == NULL)
+				return(NULL);
+	}
+}
+
+clearblock(p)
+HEADER *p;
+{char *s,*t;
+	s = (char *)(p + 1);
+	t = (char *)(p + p->bsize);
+	while (s < t) *s++ = 0;
+}
+
+#define NALLOC 128
+
+HEADER *morecore(nu)
+unsigned nu;
+{char *cp;
+ HEADER *up;
+ int rnu;
+	rnu = NALLOC * ((nu + NALLOC - 1) / NALLOC);
+	cp = sbrk(rnu * sizeof(HEADER));
+	if ((int)cp == -1) return NULL;
+	up = (HEADER *) cp;
+	up->bsize = rnu;
+	mfree((char *)(up+1));
+	return allocp;
+}
+
+#asm
+sbrk	PSHS	U
+	LEAU	,S
+	
+	LDD	heapp,Y
+	BNE	_mc0
+	BSR	initheap
+_mc0	PSHS	D
+	TFR	S,D
+	SUBD	,S++
+	CMPD	4,U
+	BCC	_mc1
+	LDD	#-1
+	LEAS	,U
+	PULS	U,PC
+	
+_mc1	LDD	4,U
+	LDX	heapp,Y
+	LEAX	D,X
+	LDD	heapp,Y
+	STX	heapp,Y
+	LEAS	,U
+	PULS	U,PC
+
+initheap
+	PSHS	U
+	LEAU	,S
+	TFR	Y,D
+	ADDD	#_GLOBALS
+	STD	heapp,Y
+	LEAS	,U
+	PULS	U,PC
+#endasm
+
+mfree(ap)
+char *ap;
+{HEADER *p,*q;
+	p = (HEADER *)ap - 1;
+	for (q = allocp; !(p > q && p < q->bptr); q = q->bptr)
+		if (q >= q->bptr && (p > q || p < q->bptr)) break;
+	if (p + p->bsize == q->bptr)
+	{	p->bsize += q->bptr->bsize;
+		p->bptr = q->bptr->bptr;
+	}
+	else p->bptr = q->bptr;
+	if (q + q->bsize == p)
+	{	q->bsize += p->bsize;
+		q->bptr = p->bptr;
+	}
+	else q->bptr = p;
+	allocp = q;
+}
+
+unsigned freesize()
+{int i;
+	if (!heapp) initheap();
+	return ((char *)&i - (char *)heapp);
+}
--- a/src/a09.c	Thu Dec 27 11:01:16 2018 +0900
+++ b/src/a09.c	Thu Dec 27 11:49:54 2018 +0900
@@ -76,6 +76,14 @@
                 unsigned char cat;
                 unsigned short code;};
 
+#define EXPERR 1
+#define ILLAERR 2
+#define UDEFLABELERR 4
+#define MULTLABELERR 8
+#define RBRACHERR 16
+#define MSSINGLBLERR 32
+#define ILLNMERR 0x8000
+
 /* Instruction categories:
    0 one byte oprcodes   NOP
    1 two byte opcodes    SWI2
@@ -332,6 +340,10 @@
                           label or constant, this is important when
                           generating relocatable object code. */
 
+void seterror(int e) {
+    error |= e;
+}
+
 void makelonger(int gl) {
     if (pass==1) return;
     for(struct longer *p=lglist;p;p=p->next) {
@@ -420,7 +432,7 @@
   if(namebuf[i]>'9')t-=7;
   i++;
  }
- if(i==0)error|=1;
+ if(i==0)seterror(1);
  return t;
 }
 
@@ -472,7 +484,7 @@
    p->cat=6;
    p->value=0;
  }
- if(p->cat==9||p->cat==11)error|=1;
+ if(p->cat==9||p->cat==11)seterror(1);
  exprcat=p->cat&14;
  if(exprcat==6||exprcat==10)unknown=1;
  if(((exprcat==2||exprcat==8)
@@ -490,7 +502,7 @@
  int t;
  skipspace();
  c=*srcptr;
- if(isalpha(c))return scanlabel();
+ if(isalpha(c)||c=='_')return scanlabel();
  else if(isdigit(c))return scandecimal();
  else switch(c) {
   case '*' : srcptr++;exprcat|=2; if(rmbmode) return prevloc; else return loccounter;
@@ -501,7 +513,7 @@
   case '@' : return scanoct();
   case '\'' : return scanchar();
   case '(' : srcptr++;t=scanexpr(0);skipspace();
-             if(*srcptr==')')srcptr++;else error|=1;
+             if(*srcptr==')')srcptr++;else seterror(1);
              return t;
   case '-' : srcptr++;exprcat^=32;return -scanfactor();
   case '+' : srcptr++;return scanfactor();
@@ -509,7 +521,7 @@
   case '^' : 
   case '~' : srcptr++;exprcat|=16;return ~scanfactor();
  }
- error|=1;
+ seterror(1);
  return 0;
 }
 
@@ -542,12 +554,12 @@
            break;
   case '/':oldcat=exprcat;
            u=scanexpr(10);
-           if(u)t/=u;else error|=1;
+           if(u)t/=u;else seterror(1);
            exprcat|=oldcat|16;
            break;
   case '%':oldcat=exprcat;
            u=scanexpr(10);
-           if(u)t%=u;else error|=1;
+           if(u)t%=u;else seterror(1);
            exprcat|=oldcat|16;
            break;
   case '+':if(level==9)EXITEVAL
@@ -682,10 +694,10 @@
    srcptr++;
    postbyte=0x83;
   } else postbyte=0x82;
-  if(!scanindexreg())error|=2;else srcptr++;
+  if(!scanindexreg())seterror(2);else srcptr++;
  } else {
   postbyte=0x80;
-  if(!scanindexreg())error|=2;else srcptr++;
+  if(!scanindexreg())seterror(2);else srcptr++;
   if(*srcptr=='+') {
    srcptr++;
    if(*srcptr=='+') {
@@ -715,10 +727,10 @@
    case 3:postbyte+=0x89;break;
    }
  } else { /*pc relative*/
-  if(toupper(*srcptr)!='P')error|=2;
+  if(toupper(*srcptr)!='P')seterror(2);
   else {
     srcptr++;
-    if(toupper(*srcptr)!='C')error|=2;
+    if(toupper(*srcptr)!='C')seterror(2);
     else {
      srcptr++;
      if(toupper(*srcptr)=='R')srcptr++;
@@ -785,7 +797,7 @@
   scanspecial();
   break;
  case '#':
-  if(mode==5)error|=2;else mode=0;
+  if(mode==5)seterror(2);else mode=0;
   srcptr++;
   if (*srcptr=='"') {
       operand = (srcptr[1]<<8) + srcptr[2] ;
@@ -827,9 +839,9 @@
  if(mode>=5) {
   skipspace();
   postbyte|=0x10;
-  if(*srcptr!=']')error|=2;else srcptr++;
+  if(*srcptr!=']')seterror(2);else srcptr++;
  }
- if(pass==2&&unknown)error|=4;
+ if(pass==2&&unknown)seterror(4);
 }
 
 unsigned char codebuf[128];
@@ -944,7 +956,7 @@
  if(lp) {
   if(lp->cat!=13&&lp->cat!=6) {
    if(lp->cat!=2||lp->value!=loccounter)
-     lp->value=loccounter; // error|=8;
+     lp->value=loccounter; // seterror(8);
   } else {
    lp->cat=2;
    lp->value=loccounter;
@@ -982,7 +994,7 @@
  case 4: case 6: offs=(unsigned short)operand-loccounter-codeptr-2;
                 if(offs<-128||offs>=128||opsize==3||unknown||!certain) {
                   if((!unknown)&&opsize==2&&(offs<-128||offs>=128) ) {
-                     error|=16; makelonger(glineno);
+                     seterror(16); makelonger(glineno);
                   }
                   offs--;
                   opsize=3;
@@ -1012,7 +1024,7 @@
 {
  scanoperands();
  if(mode>=3)
-      error|=2;
+      seterror(2);
  putbyte(co);
  putbyte(operand);
 }
@@ -1022,7 +1034,7 @@
 {
  putbyte(co);
  scanoperands();
- if(mode==0) error|=2;
+ if(mode==0) seterror(2);
  if(mode<3) {
    opsize=3;
    postbyte=0x8f;
@@ -1037,23 +1049,23 @@
 {
  int offs;
  scanoperands();
- if(mode!=1&&mode!=2)error|=2;
+ if(mode!=1&&mode!=2)seterror(2);
  offs=(unsigned short)operand-loccounter-2;
  if(!unknown&&(offs<-128||offs>=128)) {
-     error|=16;makelonger(glineno);
+     seterror(16);makelonger(glineno);
      if (co==0x20) {
-         if(mode!=1&&mode!=2)error|=2;
+         if(mode!=1&&mode!=2)seterror(2);
          putbyte(0x16);
          putword(operand-loccounter-3);
      } else {
-         if(mode!=1&&mode!=2)error|=2;
+         if(mode!=1&&mode!=2)seterror(2);
          putbyte(0x10);
          putbyte(co);
          putword(operand-loccounter-4);
      }
      return;
  }
- if(pass==2&&unknown)error|=4;
+ if(pass==2&&unknown)seterror(4);
  putbyte(co);
  putbyte(offs);
 }
@@ -1062,7 +1074,7 @@
 lbra(int co)
 {
  scanoperands();
- if(mode!=1&&mode!=2)error|=2;
+ if(mode!=1&&mode!=2)seterror(2);
  putbyte(co);
  putword(operand-loccounter-3);
 }
@@ -1071,7 +1083,7 @@
 lbranch(int co)
 {
  scanoperands();
- if(mode!=1&&mode!=2)error|=2;
+ if(mode!=1&&mode!=2)seterror(2);
  putword(co);
  putword(operand-loccounter-4);
 }
@@ -1120,7 +1132,7 @@
 {
  scanoperands();
  switch(mode) {
- case 0: error|=2;break;
+ case 0: seterror(2);break;
  case 1: putbyte(co);break;
  case 2: putbyte(co+0x70);break;
  default: putbyte(co+0x60);break;
@@ -1135,13 +1147,13 @@
  putbyte(co);
  skipspace();
  scanname();
- if((p=findreg(namebuf))==0)error|=2;
+ if((p=findreg(namebuf))==0)seterror(2);
  else postbyte=(p->tfr)<<4;
  skipspace();
- if(*srcptr==',')srcptr++;else error|=2;
+ if(*srcptr==',')srcptr++;else seterror(2);
  skipspace();
  scanname();
- if((p=findreg(namebuf))==0)error|=2;
+ if((p=findreg(namebuf))==0)seterror(2);
  else postbyte|=p->tfr;
  putbyte(postbyte);
 }
@@ -1156,7 +1168,7 @@
   if(*srcptr==',')srcptr++;
   skipspace();
   scanname();
-  if((p=findreg(namebuf))==0)error|=2;
+  if((p=findreg(namebuf))==0)seterror(2);
   else postbyte|=p->psh;
   skipspace();
  }while (*srcptr==',');
@@ -1170,7 +1182,7 @@
  if (*srcptr==',') {
    srcptr++;
  } else {
-   error|=1;  
+   seterror(1);  
  }
 }
 
@@ -1182,16 +1194,16 @@
  reset_crc();
  putword(0x87cd);
  putword(scanexpr(0)-loccounter);  // module size
- if(unknown&&pass==2)error|=4;
+ if(unknown&&pass==2)seterror(4);
  skipComma();
  putword(scanexpr(0)-loccounter);  // offset to module name
- if(unknown&&pass==2)error|=4;
+ if(unknown&&pass==2)seterror(4);
  skipComma();
  putbyte(scanexpr(0));             // type / language
- if(unknown&&pass==2)error|=4;
+ if(unknown&&pass==2)seterror(4);
  skipComma();
  putbyte(scanexpr(0));             // attribute
- if(unknown&&pass==2)error|=4;
+ if(unknown&&pass==2)seterror(4);
  int parity=0;
  for(int i=0; i< 8; i++) parity^=codebuf[i];
  putbyte(parity^0xff);              // header parity
@@ -1199,7 +1211,7 @@
  while (*srcptr==',') {             // there are some more
    srcptr++;
    putword(scanexpr(0));   
-   if(unknown&&pass==2)error|=4;
+   if(unknown&&pass==2)seterror(4);
    skipspace();
  }
  prevloc = codeptr;
@@ -1239,7 +1251,7 @@
         setlabel(lp);
         oldlc = loccounter;
         operand=scanexpr(0);
-        if(unknown)error|=4;
+        if(unknown)seterror(4);
         loccounter+=operand;
         if(generating&&pass==2) {
            if(!outmode && !os9 ) {
@@ -1251,14 +1263,14 @@
         break;
  case 5:/* EQU */
         operand=scanexpr(0);
-        if(!lp)error|=32;
+        if(!lp)seterror(32);
         else {
          if(lp->cat==13||lp->cat==6||
             (lp->value==(unsigned short)operand&&pass==2)) {
           if(exprcat==2)lp->cat=2;
           else lp->cat=0;
           lp->value=oldlc=operand;
-         } else // else error|=8;
+         } else // else seterror(8);
           lp->value=oldlc=operand;
         }
         break;
@@ -1275,7 +1287,7 @@
          if(*srcptr=='\"')srcptr++;
         } else {
           putbyte(scanexpr(0));
-          if(unknown&&pass==2)error|=4;
+          if(unknown&&pass==2)seterror(4);
         }
         skipspace();
         } while(*srcptr==',');
@@ -1296,7 +1308,7 @@
          if(*srcptr==',')srcptr++;
          skipspace();
          putword(scanexpr(0));
-         if(unknown&&pass==2)error|=4;
+         if(unknown&&pass==2)seterror(4);
          skipspace();
         } while(*srcptr==',');
         break;
@@ -1342,7 +1354,7 @@
         break;                
  case 12: /* ORG */
          operand=scanexpr(0);
-         if(unknown)error|=4;
+         if(unknown)seterror(4);
          if(generating&&pass==2&&!outmode&&!os9) {
            for(i=0;i<(unsigned short)operand-loccounter;i++)
                 fputc(0,objfile); 
@@ -1352,20 +1364,20 @@
          break;
   case 14: /* SETDP */
          operand=scanexpr(0);
-         if(unknown)error|=4;
+         if(unknown)seterror(4);
          if(!(operand&255))operand=(unsigned short)operand>>8;
          if((unsigned)operand>255)operand=-1;
          dpsetting=operand;              
          break;
   case 15: /* SET */
         operand=scanexpr(0);
-        if(!lp)error|=32;
+        if(!lp)seterror(32);
         else {
          if(lp->cat&1||lp->cat==6) {
           if(exprcat==2)lp->cat=3;
           else lp->cat=1;
           lp->value=oldlc=operand;
-         } else // else error|=8;
+         } else // else seterror(8);
           lp->value=oldlc=operand;
         }
         break;
@@ -1402,7 +1414,7 @@
         setlabel(lp);
         putword(0x103f); // SWI2
         putbyte(scanexpr(0));
-        if(unknown&&pass==2)error|=4;
+        if(unknown&&pass==2)seterror(4);
         break; 
    case 18: /* TTL */     
         break;
@@ -1428,7 +1440,7 @@
  unknown=0;certain=1;
  lp=0;
  codeptr=0;
- if(isalnum(*srcptr)) {
+ if(*srcptr=='_'||isalnum(*srcptr)) {
   scanname();lp=findsym(namebuf);
   if(*srcptr==':') srcptr++;
   if(lp && pass==2) {
@@ -1463,9 +1475,9 @@
    }
    c=*srcptr;
    if (debug) fprintf(stderr,"DEBUG: processline: mode=%d, opsize=%d, error=%d, postbyte=%02X c=%c\n",mode,opsize,error,postbyte,c);
-   if(c!=' '&&*(srcptr-1)!=' '&&c!=0&&c!=';')error|=2;
+   if(c!=' '&&*(srcptr-1)!=' '&&c!=0&&c!=';')seterror(2);
   }
-  else error|=0x8000;
+  else seterror(0x8000);
  } else {
      if (lp) {
          lp->next = prevlp;