.globl	mno
.globl	mwn
.globl	def
.globl	wrn
.globl	ins
.globl	skip
.globl	mset
.globl	mgo
.globl	alt
.globl	nte
.globl	pvr
.globl	lng
.globl	ssub
.globl	stp
.globl	evexit
.globl	evopt
.globl	evor
.globl	gofail
.globl	gosuc
/code for mcaltermac
	.text
alt:
	mov	$2.,argno
	jsr	pc,stkarg
	jsr	pc,chatom
	mov	idlen,sqnum
	mov	idpt,sqpt
	mov	$1.,argno
	jsr	pc,stkarg
	jsr	pc,chatom
	mov	$delchn,r1
	jsr	pc,ludel
	jmp	erlia
	mov	sqnum,arglen
	mov	sqpt,eriapt
	mov	$2.,argno
alt1:	mov	chlink,r1
	sub	arglen,r1
	cmp	r1,$7.
	jle	erlia
	mov	chanpt,r1
	add	$6.,r1
	mov	r1,spt
/test for case of n
	cmp	spt,knpt
	jne	gl37
	movb	*eriapt,r1
	tstb	_tstchr(r1)
	jlt	erlia
gl37:	mov	chanpt,r1
	add	$4.,r1
	mov	r1,lotemp
	mov	arglen,*lotemp
	mov	spt,r1
	add	arglen,r1
	inc	r1
	bic	$1,r1
	mov	r1,tempt
/temp is needed below in case fields overlap
	mov	*infopt,r1
	mov	r1,temp
	mov	r1,*tempt
	tst	*tempt
	jeq	gl38
	mov	*tempt,r1
	add	infopt,r1
	sub	tempt,r1
	mov	r1,*tempt
gl38:
	mov	eriapt,srcpt
	mov	spt,dstpt
	mov	arglen,r1
	jsr	pc,_fmove
	mov	chanpt,r1
	add	chlink,r1
	mov	r1,chanpt
	jsr	pc,ludel
	jmp	mcexit
	jbr	alt1
/code for mcgomac
mgo:
	cmp	argct,$1.
	jeq	godo
	mov	$dif,r1
	jsr	pc,tesdel
	mov	meval,optyp
	mov	$2.,argno
	mov	$dge,r1
	jsr	pc,tesdel
	clr	sqnum
	clr	sqsw
	mov	$0f,-(sp)
	mov	$meval,-(sp)
	jmp	_goswitch
	.data
0:
	gogreq
	gogrt
	goen
	gobc
	goequ
/character comparison
	.text
goequ:	jsr	pc,stkarg
	mov	arglen,sqnum
	mov	$3.,argno
	jsr	pc,stkarg
	cmp	arglen,sqnum
	jne	gofail
	mov	inffpt,tempt
goeq1:	jsr	pc,advnce
	jmp	gosuc
	cmpb	*spt,*tempt
	jne	gofail
	inc	tempt
	jbr	goeq1
/belongs to class
gobc:	jsr	pc,stkarg
	mov	$3.,argno
	jsr	pc,stkarg
	jsr	pc,chekid
	cmp	idlen,$1.
	jne	erlia
	jbr	logobc
/numerical comparison
gogreq:
	mov	$1.,sqnum
gogrt:
	mov	$1.,sqsw
goen:	jsr	pc,stkarg
	jsr	pc,getexp
	add	meval,sqnum
	mov	$3.,argno
	jsr	pc,stkarg
	jsr	pc,getexp
	tst	sqsw
	jne	el12
	cmp	meval,sqnum
	jeq	gosuc
	jbr	gofail
el12:
	cmp	meval,sqnum
	jge	gofail
gosuc:	inc	optyp
gofail:
	cmp	optyp,$1.
	jne	mcexit
	mov	$1.,argno
/perform go to
godo:	jsr	pc,stkarg
	jsr	pc,gargch
	jmp	erlia
	cmpb	*spt,$'l
	jne	erlia
	jsr	pc,getexp
	tst	meval
	jne	el13
	cmp	level,$1.
	jeq	erlme
	jsr	pc,opexit
	jbr	entx2
el13:
	tst	meval
	jle	erlme
	jsr	pc,opexit
	jsr	pc,sklab
	jmp	labfnd
	mov	meval,skval
	mov	mchlin,sklin
	jbr	bsnext
/backwards go to
labfnd:	mov	*chanpt,r1
	add	stoppt,r1
	mov	r1,spt
	mov	chanpt,r1
	mov	2.(r1),linect
	jbr	bsnext
/code for mclengmac
lng:	jsr	pc,stkarg
	mov	arglen,r1
	/mul	$1.,r1*****
	mov	r1,meval
/go to label in code to perform insert
	jbr	inv1
/code for mcnotemac
nte:	jsr	pc,stkarg
	mov	$0f,-(sp)
	jsr	pc,_message
	.data;
0:	<\n\0>; .even
	.text
	mov	eriapt,idpt
	mov	arglen,idlen
	jsr	pc,loerpr
	jsr	pc,opexit
	mov	svarpt,r1
	sub	$8.,r1
	tst	(r1)
	jeq	er2a
	mov	$0f,-(sp)
	jsr	pc,_message
	.data;
0:	<\n\0>; .even
	.text
	jbr	bsnext
/code for mcpvarmac
pvr:	jsr	pc,stkarg
	jsr	pc,getexp
	mov	meval,r1
	sub	pvnum,r1
	mov	r1,idlen
	tst	r1
	jle	mcexit
	mov	idlen,r1
	asl	r1
	mov	r1,idlen
	jsr	pc,mkroom
/zeroise new pvars
	mov	ndefpt,r1
	add	idlen,r1
	mov	r1,tempt
znplp:
	sub	$2.,tempt
	clr	*tempt
	cmp	tempt,ndefpt
	jne	znplp
	mov	meval,r1
	mov	r1,pvnum
	mov	r1,*pvarpt
	jbr	mcexit
/code for mcsetmac
mset:	jsr	pc,stkarg
	jsr	pc,chekid
	mov	idpt,r1
	add	idlen,r1
	dec	r1
	mov	r1,spt
	jsr	pc,gmeadd
	mov	tempt,sqpt
	mov	$2.,argno
	jsr	pc,stkarg
	jsr	pc,getexp
	mov	meval,*sqpt
	jbr	mcexit
/code for mcsubmac
ssub:	jsr	pc,stkarg
	mov	arglen,optyp
	mov	$2.,argno
	jsr	pc,stkarg
	jsr	pc,getexp
	clr	sqnum
	jsr	pc,subchk
	mov	meval,r1
	dec	r1
	mov	r1,sqnum
	mov	$3.,argno
	jsr	pc,stkarg
	jsr	pc,getexp
	jsr	pc,subchk
	mov	meval,r1
	sub	sqnum,r1
	mov	r1,idlen
	mov	inffpt,r1
	add	sqnum,r1
	mov	r1,idpt
/go to label in code to perform insert
	jbr	fnctex
/code for mcno--- macros
mwn:	mov	hashpt,r1
	add	$72.,r1
	mov	r1,lotemp
	mov	$7.,*lotemp
/above statement applies only to mcnowarnmac
mno:	mov	type,r1
	asl	r1
	mov	r1,type
	mov	hashpt,r1
	add	type,r1
	add	$64.,r1
	mov	r1,lotemp
	mov	dbugpt,r1
	add	$36.,r1
	mov	r1,*lotemp
	jbr	mcexit
/code for mcwarnmac
wrn:
	mov	$2.,ntypsw
	jbr	evtree
/code for mcstopmac
stp:	clr	ntypsw
	jbr	evtree
/code for mcdefmac
def:	mov	argct,r1
	dec	r1
	mov	r1,argno
	mov	$das,r1
	jsr	pc,tesdel
	clr	sqsw
	tst	meval
	jeq	gl39
	mov	$1.,sqsw
gl39:
	mov	$3.,sqnum
	cmp	argct,$2.
	jeq	def1
	mov	$1.,argno
	jsr	pc,stkarg
	jsr	pc,getexp
	cmp	meval,$3.
	jlt	def1
	mov	meval,sqnum
def1:	mov	inffpt,r1
	inc	r1
	bic	$1,r1
	mov	r1,ffpt
	mov	*dbugpt,argno
	jsr	pc,stkarg
	dec	argno
	mov	$1.,ntypsw
	jbr	evtree
/code for mcinsmac
ins:
	mov	$3.,sqnum
	mov	$3.,ntypsw
	cmp	argct,$1.
	jeq	evtree
	jsr	pc,stkarg
	jsr	pc,chekid
	cmp	idlen,$1.
	jne	erlia
	cmpb	*idpt,$'p
	jeq	evtr2
	cmpb	*idpt,$'u
	jeq	minsu
	jbr	erlia
minsu:
	mov	$2.,sqnum
	jbr	evtr2
/code for mcskipmac
skip:	clr	sqsw
	mov	$4.,ntypsw
	cmp	argct,$1.
	jeq	evtree
	jsr	pc,stkarg
sk3:	jsr	pc,gargch
	jmp	evtr2
	cmpb	*spt,$'d
	jeq	skd
	cmpb	*spt,$'t
	jeq	skt
	cmpb	*spt,$'m
	jeq	skm
	jbr	erlia
skd:
	bis	$1.,sqsw
	jbr	sk3
skt:
	bis	$2.,sqsw
	jbr	sk3
skm:
	bis	$4.,sqsw
	jbr	sk3
evtr2:
	mov	$2.,argno
/deal with structure representation
evtree:	jsr	pc,stkarg
	clr	nodept
	clr	r1
	mov	r1,delct
	mov	r1,optlev
	mov	$2.,r1
	jsr	pc,bumpff
	mov	ffpt,r1
	inc	r1
	bic	$1,r1
	mov	r1,ffpt
	clr	exitsw
	mov	lfpt,lnodpt
	mov	$1.,r1
	mov	r1,consw
	mov	r1,nodesw
	mov	r1,keysw
	jsr	pc,getdel
ev1:
	inc	ffpt
	bic	$1,ffpt
	mov	ntypsw,(ffpt)+
	cmp	ffpt,_last
	jhis	erlso
	mov	$0f,-(sp)
	mov	$ntypsw,-(sp)
	jmp	_goswitch
	.data
0:
	ev2
	evmac
	ev2
	evins
	evskip
	.text
evmac:
	tst	sqsw
	jeq	gl41
	inc	ffpt
	bic	$1,ffpt
	mov	$4.,(ffpt)+
	cmp	ffpt,_last
	jhis	erlso
/stack offsets of start and end of rep text
gl41:	mov	stoppt,r1
	inc	r1
	bic	$1,r1
	mov	r1,temapt
	mov	eriapt,r1
	inc	r1
	bic	$1,r1
	sub	temapt,r1
	add	ffpt,r1
	mov	r1,tempt
/tempt now points at final position of slot
	mov	eriapt,r1
	sub	tempt,r1
	inc	ffpt
	bic	$1,ffpt
	mov	r1,(ffpt)+
	cmp	ffpt,_last
	jhis	erlso
	mov	inffpt,r1
	inc	r1
	bic	$1,r1
	sub	tempt,r1
	sub	$2.,r1
	inc	ffpt
	bic	$1,ffpt
	mov	r1,(ffpt)+
	cmp	ffpt,_last
	jhis	erlso
evins:
	inc	ffpt
	bic	$1,ffpt
	mov	sqnum,(ffpt)+
	cmp	ffpt,_last
	jhis	erlso
	jbr	ev2
evskip:
	inc	ffpt
	bic	$1,ffpt
	mov	sqsw,(ffpt)+
	cmp	ffpt,_last
	jhis	erlso
ev2:	jsr	pc,getdel
	jbr	ev2
/action at opt
evopt:
	inc	optlev
	mov	$6.,r1
	jsr	pc,declf
	mov	$allpt,srcpt
	mov	lfpt,dstpt
	mov	$6.,r1
	jsr	pc,_fmove
	mov	ffpt,r1
	mov	r1,opthpt
	mov	r1,optpt
	clr	allpt
	clr	nodesw
	jsr	pc,getdel
evcont:
	tst	delct
	jeq	ev1
	jbr	ev2
/action at or
evor:
	jsr	pc,joinch
	tst	delct
	jne	gl42
	mov	$2.,r1
	jsr	pc,bumpff
gl42:
	mov	optpt,nodept
	mov	ffpt,optpt
	mov	$1.,nodesw
	jsr	pc,getdel
/check that name of branch is unique
	mov	opthpt,r1
	jsr	pc,loschn
	jmp	macerr
chn5:
	cmp	chanpt,optpt
	jeq	evcont
	mov	optpt,idpt
	mov	chanpt,infopt
evor4:	mov	idpt,r1
	mov	2.(r1),idlen
	add	$4.,idpt
	mov	infopt,r1
	jsr	pc,cmpare
	jmp	evdiff
	mov	idpt,r1
	add	idlen,r1
	inc	r1
	bic	$1,r1
	mov	r1,idpt
/check with, withs and spaces
	jsr	pc,tespac
	mov	infopt,tempt
	mov	idpt,infopt
	mov	tempt,idpt
	jsr	pc,tespac
	mov	infopt,r1
	jsr	pc,tewith
	jmp	evor1
	mov	idpt,r1
	jsr	pc,tewith
	jmp	evdiff
	jbr	erlia
evor1:	mov	idpt,r1
	jsr	pc,tewith
	jmp	evor4
evdiff:	jsr	pc,loechn
	jmp	chn5
/action at end of string
evexit:
	tst	delct
	jeq	erlia
	tst	optlev
	jne	erlia
	mov	nodept,r1
	jsr	pc,loschn
	jmp	evex1
chn6:
	clr	*chanpt
	jsr	pc,loechn
	jmp	chn6
/check that all nodes have been placed
evex2:
	cmp	lfpt,topspt
	jeq	pldef
	mov	lfpt,r1
	tst	2.(r1)
	jeq	erlia
	add	$6.,lfpt
	jbr	evex2
evex1:
	tst	exitsw
	jeq	erlia
	jbr	evex2
/action after processing of structure rep
pldef:
	mov	$2.,offset
	mov	stoppt,r1
	inc	r1
	bic	$1,r1
	mov	r1,stoppt
	mov	ffpt,r1
	sub	stoppt,r1
	mov	r1,idlen
	mov	$0f,-(sp)
	mov	$ntypsw,-(sp)
	jmp	_goswitch
	.data
0:
	plstop
	plmac
	plwarn
	plins
	addenv
/input 578,output 499, 19.2% optimalized
