/
/  (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The	Netherlands.
/
/	    This product is part of the	Amsterdam Compiler Kit.
/
/  Permission to use, sell, duplicate or disclose this software	must be
/  obtained in writing.	Requests for such permissions may be sent to
/
/	Dr. Andrew S. Tanenbaum
/	Wiskundig Seminarium
/	Vrije Universiteit
/	Postbox	7161
/	1007 MC	Amsterdam
/	The Netherlands
/
/
/------------------------------------------------------------------------------
/
/	This is	an interpreter for EM programs with no virtual memory
/	which is adapted from an EM1 interpreter by Hans van Staveren
/	by	Evert Wattel
/		Vrije Universiteit
/		Amsterdam
/
/	Memory layout:
/
/	 interpreter  em-text  pd  global  tables  heap	 unused	stack
/	__________________________________________________________________
/	|	     |	     |	  |	  |	  |	|      |      |	 |
/	|	     |	     |	  |	  |	  |	|      |      |	 |
/	|      1     |	 2   |	3 |   4	  |   5	  |  6	|      |  7   |	8|
/	|	     |	     |	  |	  |	  |	|      |      |	 |
/	|____________|_______|____|_______|_______|_____|______|______|__|
/
/	1:	Interpreter text+data+bss
/	2:	EM text
/	3:	EM procedure descriptors
/	4:	EM global data area
/	5:	flow, count and	profile	tables
/	6:	EM heap	area
/	7:	EM local data and stack
/	8:	Arguments to interpreter
/
/	Assembly time flags:
/	.test  : controls checking for undefined variables,nil pointers,
/		 array indices,	etc....
/	.prof  : controls generation of	a runtime profile
/	.opfreq: controls runtime frequency count per opcode
/	.flow  : controls generation of	a flow bitmap
/	.count : controls generation of	a flow count
/	.last  : controls generation of	file with last 16
/		 consecutive blocks of lines executed
/
/	Register layout:
/	pcx = EM programcounter
/	lb  = EM base-address
/	nxt = address of start of interpreter loop
/
/	The general structure of this interpreter is as	follows:
/	The opcode byte	of the instruction is placed in	r0
/	with sign-extension and	multiplied by 2.
/	If .opfreq is nonzero each occurence of	each opcode is counted.
/	Then, if .prof is nonzero an estimation	of the time required
/	to execute the instruction is added to a counter associated
/	with the source-line number. This estimation is	roughly	the
/	number of memory-cycles	needed.	At the end of this accounting
/	loprof points to the loword of the double precision counter.
/	This can be used by individual execution routines to add some
/	more to	the counter depending on their operand.
/
/	NOTE: This interpreter can be loaded in	separate I and D space
/
/
/------------------------------------------------------------------------------
/	Declaring of some constants
/------------------------------------------------------------------------------

	nxt	= r4
	pcx	= r3
	lb	= r2

	statd	= -8.

	unixextra= 1280.	/ extra	memory asked by	heap overflow
	und	= 100000	/ undefined memory pattern
	signext	= 177400	/ high bits for	signextension
	EINVAL	= 22.		/ UNIX error code for bad signal

/ Interpreter options
	.float	 = 1
	.opfreq	= 0
	.last	= 1
	V7	= 1
	V6	= 0
	VPLUS	= 0
	HARDWARE_FP	= 1
/------------------------------------------------------------------------------
/	EM1 machine errors (in the range 0-63)
/------------------------------------------------------------------------------

	EARRAY	= 0.
	ERANGE	= 1.
	ESET	= 2.
	EIOVFL	= 3.
	EFOVFL	= 4.
	EFUNFL	= 5.
	EIDIVZ	= 6.
	EFDIVZ	= 7.
	EIUND	= 8.
	EFUND	= 9.
	ECONV	= 10.
	ESTACK	= 16.
	EHEAP	= 17.
	EILLINS	= 18.
	EODDZ	= 19.
	ECASE	= 20.
	EMEMFLT	= 21.
	EBADPTR	= 22.
	EBADPC	= 23.
	EBADLAE	= 24.
	EBADMON	= 25.
	EBADLIN	= 26.
	EBADGTO	= 27.

/------------------------------------------------------------------------------
/	Declaring of some instructions unknown to the assembler
/------------------------------------------------------------------------------

	next	= 10407		/ = mov	nxt,pc;	jump to	decode loop
	rti	= 2		/ return from interrupt
	iot	= 4		/ force	core dump
	stst	= 170300^tst	/ store	floating point status
	indir	= 0		/ for sys indir
	exit	= 1
	fork	= 2
	read	= 3
	write	= 4
	open	= 5
	close	= 6
	creat	= 8.
	break	= 17.
	alarm	= 27.
	pause	= 29.
	sleep	= 35.
	signal	= 48.

/------------------------------------------------------------------------------
/	External references
/------------------------------------------------------------------------------

	.globl	_end

/
/------------------------------------------------------------------------------
/	Now the	real program starts
/------------------------------------------------------------------------------

startoff:
	mov	sp,r0
	mov	sp,ml
	mov	sp,filb
	add	$2,filb		/ pointer to argv in filb for error message
	dec	(r0)
	mov	(r0)+,argc	/ pass to userprogram later
	bgt	0f		/ go for argument
	mov	$emfile,forward+2    / e.out is	load file default
	mov	$forward+2,argv
	br	1f
0:
	tst	(r0)+		/ skip interpreter name
	mov	r0,argv		/ pass to userprogram later
	mov	(r0),forward+2	     / argv filename to	open call
1:
.if V7
	tst	(r0)+		/ increment r0 look for	last arg
	bne	1b
	mov	r0,environ
.endif
	sys	indir;forward
	.data
forward:      sys     open;0;0
emfile:	<e.out\0>
.even
	.text
	jes	badarg
	mov	r0,saver0	/ save filedescriptor
	mov	r0,r5		/ duplicate filedescriptor
	sys	read;header;16.	/ skip first header
	jes	badarg		/ failed
	mov	r5,r0		/ recall fildes
	sys	read;header;16.	/ read second header
	jes	badarg		/ failed
	cmp	r0,$16.		/ long enough ?
	jne	badarg		/ no.
	mov	$_end,r0	/ Bottom em-text
	mov	r0,pb		/ program base
	add	txtsiz,r0	/ reserve space	for text
	mov	r0,pd		/ set up proc.descr base
	mov	nprocs,	r3	/ number of procs
	ash	$2,r3		/ proc.	descr is 4 bytes
.if .count +.prof + .flow
	mul	$3,r3		/ or 12	bytes
.endif
	add	r3,r0		/ reserve space
	mov	r0,eb		/ top of pd space
	mov	r0,r3		/ base for data	fill

	add	szdata,r0	/ size of external data
	jcs	toolarge	/ too much text and data
	mov	r0,globmax	/ maximum global
	add	$1280.,r0	/ bit extra core for setup
	mov	r0,sybreak+2	/ set up for core claim
	sys	indir;sybreak	/ ask for the core
	jes	toolarge	/ too much, sorry

	mov	txtsiz,leescal+4     / set up for text read
	mov	pb,leescal+2	     / start address text read
	mov	r5,r0		/ file descriptor input
	sys	indir;leescal	     / read!!
	.data
leescal:
1:	sys	read;0;0	/ read call
	.text
lblread:


/ hier is nu dus de tekst ingelezen. De	sybreak	voor de
/ tabellen  en de data moet opnieuw gebeuren.


.if .last
	mov	$47.,r0
	mov	$lasttab,r5
3:	clr	(r5)+
	sob	r0,3b
	mov	$-1,(r5)
	sub	$96.,r5
	mov	r5,linused
.endif
lblfloat:
.if .float
	sys	signal;8.;sig8	/ catch	floating exception
	ldfps	$7600
	movf	$50200,fr3	/ load 2^32 in fr3 for conversion
				/ unsigned to float
.endif


	sys	signal;11.;sig11	/ catch	segmentation violation
	sys	signal;12.;sig12	/ catch	bad system calls

			/ We make a 1024 buffer	for reading in
			/ data descriptors. When the number of
			/ bytes	in the buffer is less than 512
			/ we read another block. Descriptors of
			/ more than 512	bytes are not allowed.
			/ This is no restriction since they do
			/ not fit in the descriptor format.
lblbuf:

	sub	$02000,sp	/ new buffer bottom
	tst	(sp)		/ ask for core
	mov	sp,r4		/ pointer in descriptor
	mov	saver0,r0	/ recall fildes
	clr	r1		/ clear	registers for byte
	clr	r2		/ format instruction and data
	mov	sp,r5		/ copy
	mov	r5,leescal+2	/ set up for read
	mov	$02000,leescal+4     / idem
	sys	indir;leescal	     / read
	jes	badarg		/ read failed
	cmp	$02000,r0	/ not yet eof?
	bgt	0f		/ eof encountered

	add	$01000,r5	/ buffer middle
	mov	r5,saver1	/ save buffermiddle to compare
	br	datloop		/ start	data initialization
0:	add	r0,r5		/ now pointer at top of	file
	mov	r5,saver1	/ still	set up for compare




datloop:
	cmp	r4,saver1	/ descriptor over middle?
	ble	9f		/ no? go ahead
	jsr	pc,blshift	/ yes? shift block down, read next

9:	dec	ndatad		/ still	data to	initialize?
	blt	finito		/ no? go on
	movb	(r4)+,r1	/ opcode descriptor
	beq	0f		/ if 0 then go there
	mov	r3,r5		/ copy data pointer
	clr	r2		/ unsigned integer byte
	bisb	(r4)+,r2	/ "ored" in for	data size
	asl	r1		/ make opcode even
	mov	datswi(r1),pc  / main data swich

.data
datswi:	0;	dat1;	dat2;	dat3;	dat4;	dat5;	dat6;	dat6;	dofloat
.text
dat3:	asl	r2		/ multiply with	2
dat2: 2: movb	(r4)+,(r3)+	/ copy byte from buffer	to data
	sob	r2,2b		/ until	r2 is 0
	br	datloop		/ next datadescriptor


dat4:	mov	eb,r0		/ external base	should be added
	br	2f		/ for data pointers

dat5:	mov	pb,r0		/ and program base for procedures

2:	movb	(r4)+,(r3)	/ move in first	byte of	pointer
	movb	(r4)+,1(r3)	/ move in second byte of pointer
	add	r0,(r3)+	/ add pointer base
	sob	r2,2b		/ jump back if there is	more
	br	datloop		/ next data descriptor

dat1:	mov	$und,(r3)+	/ reserve words	with undefineds
	sob	r2,dat1		/ jump back if more
	br	datloop		/ next data descriptor

0:	mov	r3,r1		/ copy data pointer (odd register)
	sub	r5,r1		/ subtract previous pointer
	movb	(r4)+,(r3)	/ copy first byte of operand
	movb	(r4)+,1(r3)	/ copy second byte
	mul	(r3),r1		/ the number of	bytes to copy
1:	movb	(r5)+,(r3)+	/ is the product of the	operand
	sob	r1,1b		/ and the number of bytes in the
	br	datloop		/ previous operation

dat6:	add	r2,r3		/ new data pointer, the	old is
	mov	r3,r0		/ still	in r5
	asr	r2		/ divide by 2
	beq	6f		/ case 1 byte is special
	sub	$2,r0		/ this is the least significant
				/ byte in PDP11-standard
2:	movb	(r4)+,(r0)+	/ copy low byte
	movb	(r4)+,(r0)	/ copy high byte
	sub	$3,r0		/ next lowest byte
	sob	r2,2b		/ jump if not ready
	br	datloop		/ next descriptor
6:	movb	(r4)+,(r5)	/ copy one byte
	br	datloop		/ next descriptor

blshift:
	mov	saver1,r1	/ bottom of top	half
	mov	r1,r2		/ set up bottom
	sub	$01000,r2
	mov	$1000,r0	/ number to copy
	mov	r0,leescal+4	     / amount to read
	sub	r0,r4		/ decrease pointer
	asr	r0		/ 512 bytes is 256 words
3:	mov	(r1)+,(r2)+	/ copy top half	in bottom half
	sob	r0,3b
	mov	saver1,leescal+2     / set up for read
blockr:
	mov	saver0,r0		/ filedescriptor
	sys	indir;leescal
	jes	badarg
	clr	r1		/ clear	registers which	contain
	clr	r2		/ descriptor bytes later
	cmp	$01000,r0	/ look if eof is encountered
	beq	3f		/ yes? go on
	add	r0,saver1	/ no extra read	necessary
3:	rts	pc

finito:
       cmp     globmax,r3	    / test if data size	ok
       jne     badarg	       / load file error
	mov	eb,filb
	add	$4,filb


	mov	nprocs,r5	/ set up for procdesc read
	mov	pd,r3		/ proc descriptor base
	asl	r5		/ multiply with	4 because
	asl	r5		/ procdes is 4 bytes
1:	mov	saver1,r1	/ look what is available
	sub	r4,r1		/ in buffer to be read
	add	$3,r1		/ let it be a multiple
	bic	$3,r1		/ of four
	sub	r1,r5		/ subtract what	can be read
	asr	r1;   asr  r1;	/ divide by four
0:
	movb	(r4)+,(r3)+	/ copy byte
	movb	(r4)+,(r3)+	/ copy byte
	movb	(r4)+,(r3)+	/ copy byte
	movb	(r4)+,(r3)+	/ copy byte
	add	pb,-2(r3)	/ change em-address in pdp-address
.if .count + .prof + .flow
	clr	(r3)+
	clr	(r3)+
	clr	(r3)+
	clr	(r3)+
.endif
	sob	r1,0b		/ look if there	is more
	tst	r5		/ is there still a descriptor
	ble	2f;		/ no? go on
	jsr	pc,blshift	/ yes? read again
	br	1b

2:
	cmp	eb,r3	     / test if procdes is ok
	jne	badarg		/ load file error
	mov	saver0,r0	/ fildes in r0
	sys	close		/ close	input load file
	mov	ml,sp		/ fresh	stack
	mov	2(sp),*filb
.if .flow + .count + .prof
/					   |==================|
/ Here we fill the fields in the procedure | bytes for locals |
/ descriptor with table	information. The   |------------------|
/ procedure descriptor has six fields,	   |  start address   |
/ like described in this picture. We	   |------------------|
/ construct a linked list of the proc.	   |  count pointer   |
/ descriptors, such that the defined	   |------------------|
/ order	of procedures is compatible	   |   first line nr  |
/ with the text	order. Thereafter we	   |------------------|
/ scan the text	for line information to	   |  link next	proc  |
/ fill the countpointer	and startline	   |------------------|
/ field. The link to the first proc.	   | current file name|
/ is in	firstp,	links are descriptor	   |==================|
/ start	addresses. The last procedure
/ links	to the external	base. All lines	in the text get	a count
/ number, lines	of a procedure get consecutive count numbers,
/ the procedure	count pointer gives the	number of the first line.
/ Count	pointer	zero is	reserved for the case that no line number
/ is yet defined.

makelink:
	mov	pd,r0		/ first	descriptor
	mov	r0,r3		/ points to first proc
	mov	r0,r4		/ pd in	register
	mov	eb,r5		/ eb in	register

0:	mov	r0,r1		/ copy old descriptor bottom
	add	$12.,r0		/ next descriptor
	cmp	r0,r5		/ top of descriptor space
	bhis	4f		/ ready? continue
1:	cmp	2(r0),2(r1)	/ compare start	addresses
	bhis	2f		/ 2(r0)	large? follow link
	sub	$12.,r1		/ 2(r0)	small? previous	descriptor
	cmp	r1,r4		/ is r1	smaller	than pd?
	bhis	1b		/ no? try again
	mov	r3,8.(r0)	/ yes? then r0 has small text address
	mov	r0,r3		/ now r3 again points to first proc
	br	0b		/ next descriptor

2:	mov	8.(r1),r2	/ follow link to compare with 2(r0)
	beq	3f		/ if 0 then no link defined
	cmp	2(r0),2(r2)	/ compare start	addresses
	blo	3f		/ r0 between r1	and r2
	mov	r2,r1		/ r0 above r2,
	br	2b		/ look again.

3:	mov	r0,8.(r1)	/ link of r1 points to r0
	mov	r2,8.(r0)	/ link of r0 points to r2
	br	0b		/ next descriptor

4:	mov	r3,firstp	/ firstp links to first	procedure

procinf:
	mov	$1,maxcount	/ countptr for first proc
	mov	r3,r4		/ points to first proc

0:	mov	r3,-(sp)	/ stack	current	procedure
	mov	$-1,r1		/ minimal line number 0177777
	clr	r5		/ maximum line number on 0
	mov	8.(r3),r4	/ bottom address next descriptor
	beq	6f		/ if 0 last procedure
	mov	2(r4),r4	/ top of current procedure
	br	2f		/ start	looking	for lines
6:	mov	pd,r4		/ top of last procedure
2:
	mov	2(r3),r3	/ start	text address procedure
8:	movb	(r3)+,r2	/ first	opcode for scanning
	cmp	$-2,r2		/ case escape
	beq	1f		/ escape treated at label 1
	cmp	$-106.,r2	/ case lni
	blt	7f		/ ordinary skip	at label 7
	beq	2f		/ lni treated at label 2
	cmp	$-108.,r2	/ case lin.l
	bgt	7f		/ ordinary skip	at label 7
	beq	3f		/ lin.l	at label 3
	clr	r0		/ lin.s0 treated here
	bisb	(r3)+,r0	/ line number in r0
	br	4f		/ compares at label 4
2:	inc	r0		/ lni increases	line number
	br	4f		/ compares at label 4
3:	jsr	pc,wrdoff	/ get 2	byte number
4:
	cmp	r1,r0		/ look if r0 less than minimum
	blo	5f		/ nothing to declare
	mov	r0,r1		/ r0 new minimum
5:	cmp	r0,r5		/ look if r0 more than maximum
	blo	9f		/ nothing spectacular
	mov	r0,r5		/ r0 new maximum
	br	9f		/ line processed

1:	clr	r2
	bisb	(r3)+,r2	/ escaped instruction opcode
	add	$128.,r2	/ ready	for table entry
7:	movb	skipdisp(r2),r2	/ skip the required number of bytes
	add	r2,r3

9:	cmp	r3,r4		/ still	more text in this proc?
	blt	8b		/ yes? again
filpd:
	mov	(sp)+,r3	/ get bottom descriptor	back
	sub	r1,r5		/ number of lines encountered
	bcs	9f		/ no lines then	no file	information
	mov	maxcount,4(r3)	/ this is the count pointer
	mov	r1,6(r3)	/ minimum line in descriptor
	inc	r5
	add	r5,maxcount	/ this is the new maximum
9:	mov	8.(r3),r3	/ follow link to next procedure
	bne	0b		/ restart
.data
.byte 2; .byte 2; .byte	0; .byte 0; .byte 1; .byte 1; .byte 1; .byte 0;
.byte 0; .byte 2; .byte	1; .byte 0; .byte 1; .byte 0; .byte 0; .byte 1;
.byte 1; .byte 1; .byte	0; .byte 0; .byte 2; .byte 1; .byte 0; .byte 2;
.byte 0; .byte 1; .byte	1; .byte 2; .byte 1; .byte 1; .byte 1; .byte 1;
.byte 1; .byte 2; .byte	0; .byte 0; .byte 0; .byte 0; .byte 1; .byte 2;
.byte 0; .byte 0; .byte	0; .byte 0; .byte 0; .byte 1; .byte 2; .byte 2;
.byte 0; .byte 0; .byte	0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
.byte 0; .byte 0; .byte	0; .byte 0; .byte 1; .byte 1; .byte 0; .byte 0;

.byte 0; .byte 1; .byte	0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 1;
.byte 0; .byte 0; .byte	1; .byte 0; .byte 0; .byte 1; .byte 1; .byte 1;
.byte 1; .byte 0; .byte	2; .byte 1; .byte 1; .byte 1; .byte 2; .byte 0;
.byte 0; .byte 1; .byte	0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 1;
.byte 2; .byte 2; .byte	0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
.byte 0; .byte 1; .byte	0; .byte 0; .byte 0; .byte 0; .byte 2; .byte 1;
.byte 1; .byte 1; .byte	1; .byte 1; .byte 1; .byte 1; .byte 1; .byte 1;
.byte 2; .byte 1; .byte	0; .byte 0; .byte 1; .byte 2; .byte 7; .byte 5;

skipdisp:
.byte 0; .byte 0; .byte	0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
.byte 0; .byte 0; .byte	0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
.byte 0; .byte 0; .byte	0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
.byte 0; .byte 0; .byte	0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
.byte 0; .byte 0; .byte	0; .byte 1; .byte 0; .byte 0; .byte 2; .byte 0;
.byte 0; .byte 1; .byte	1; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
.byte 0; .byte 0; .byte	1; .byte 2; .byte 1; .byte 1; .byte 1; .byte 1;
.byte 1; .byte 1; .byte	1; .byte 2; .byte 1; .byte 1; .byte 1; .byte 1;

.byte 0; .byte 0; .byte	0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
.byte 0; .byte 0; .byte	0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
.byte 0; .byte 0; .byte	0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
.byte 0; .byte 0; .byte	0; .byte 0; .byte 1; .byte 0; .byte 0; .byte 0;
.byte 1; .byte 0; .byte	0; .byte 0; .byte 1; .byte 0; .byte 0; .byte 0;
.byte 1; .byte 1; .byte	0; .byte 1; .byte 0; .byte 2; .byte 0; .byte 2;
.byte 1; .byte 0; .byte	0; .byte 0; .byte 1; .byte 1; .byte 0; .byte 1;
.byte 2; .byte 1; .byte	1; .byte 1; .byte 1; .byte 1; .byte 1; .byte 1;

/escaped opcodes

.byte 2; .byte 0; .byte	2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0;
.byte 2; .byte 0; .byte	2; .byte 0; .byte 2; .byte 2; .byte 0; .byte 2;
.byte 2; .byte 2; .byte	2; .byte 2; .byte 0; .byte 2; .byte 2; .byte 0;
.byte 2; .byte 0; .byte	0; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0;
.byte 2; .byte 0; .byte	2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0;
.byte 2; .byte 0; .byte	0; .byte 0; .byte 0; .byte 2; .byte 2; .byte 2;
.byte 2; .byte 2; .byte	0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2;
.byte 0; .byte 2; .byte	0; .byte 2; .byte 0; .byte 2; .byte 2; .byte 2;

.byte 0; .byte 2; .byte	0; .byte 2; .byte 0; .byte 2; .byte 2; .byte 2;
.byte 2; .byte 2; .byte	2; .byte 2; .byte 0; .byte 2; .byte 0; .byte 1;
.byte 2; .byte 2; .byte	2; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2;
.byte 0; .byte 0; .byte	2; .byte 0; .byte 2; .byte 0; .byte 0; .byte 2;
.byte 0; .byte 2; .byte	2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0;
.byte 2; .byte 0; .byte	0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2;
.byte 0; .byte 2; .byte	0; .byte 2; .byte 0; .byte 2; .byte 2; .byte 2;
.byte 2; .byte 2; .byte	0; .byte 0; .byte 2; .byte 2; .byte 0; .byte 2;

.byte 0; .byte 2; .byte	0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2;
.byte 2; .byte 0; .byte	1; .byte 0; .byte 0; .byte 0; .byte 2; .byte 0;
.byte 2; .byte 0; .byte	2; .byte 2; .byte 2; .byte 2; .byte 2; .byte 2;
.byte 0; .byte 2; .byte	0; .byte 1; .byte 2; .byte 0; .byte 0; .byte 2;
.text
	mov	globmax,r3	/ bottom of table space
	mov	r3,r5		/ copy
.if .prof
	mov	r3,ltime	/ set up pointer to base
mov	r3,hiprof
mov	r3,loprof
add	$2,loprof
	mov	maxcount,r0	/ number of lines
	inc	r0
	asl	r0		/ four byter per prof count
	asl	r0
	add	r0,r3
	mov	r0,profsiz
.endif
.if .flow
	mov	r3,lflow	/ set up pointer to base
	mov	maxcount,r0
	ash	$-3,r0		/ divide by 8
	add	$2,r0
	bic	$1,r0		/ Rounded up to	an integral number of words
	add	r0,r3
	mov	r0,flowsiz
.endif
.if .count
	mov	r3,lcount	/ set up pointer
	mov	maxcount,r0
	inc	r0
	ash	$2,r0		/ multiply by 4
	add	r0,r3
	mov	r0,countsiz
.endif
	mov	r3,tblmax
	cmp	r3,sybreak+2	/ core available for tables?
	blos	2f
	mov	r3,sybreak+2
	sys	indir;sybreak	/ ask for core
2:	sub	r5,r3		/ this amount of space required
	asr	r3
2:	clr	(r5)+		/ clear	table space
	sob	r3,2b
.endif
.if  [1	- .count] * [1 - .flow]	* [1 - .prof]
	mov	globmax,tblmax
.endif

		     / start calling sequence here
calseq:
	mov	tblmax,hp
	mov	pd,r3		/ top of em-text and top of stack
	clr	r2		/ are dummy return values
	mov	environ,-(sp)	/ setup	environment pointer
	mov	argv,-(sp)	/ setup	argument pointer
	mov	*argv,*filb	/ setup	first file message
	mov	argc,-(sp)	/ setup	argument count
	mov	entry.,-(sp)	/ start	procedure to call
precal:
	mov	$loop,r4	/ main loop address in r4
	jbr	cai.z		/ according to the cai

noarg:	mov	r0,argv
	mov	$0f,r0;		jbr	rude_error
badarg:	mov	$1f,r0;		jbr	rude_error
toolarge:mov	$2f,r0;		jbr	rude_error


	.data
0:	<no load file\0>
1:	<load file error\0>
2:	<program too large\0>
	.even
	.text


dofloat:
	jsr	pc,atof
	mov	r5,r3		/ restore r3
				/ Assumed that the result is 8
				/ bytes	Recall r2 and move the
				/ amount of bytes asked	for
	clr	r1		/ restore for opcode
	sub	$8.,r2		/ 8 bytes?
	beq	1f		/ yes! later, 4	bytes next
	movfo	fr0,-(sp)	/ push result
	mov	(sp)+,(r3)+	/ write	result in data
	mov	(sp)+,(r3)+	/ idem
	jbr	datloop		/ next loop
1:	movf	fr0,-(sp)	/ push result
	mov	(sp)+,(r3)+	/ write	result in data
	mov	(sp)+,(r3)+	/ write	result in data
	mov	(sp)+,(r3)+	/ write	result in data
	mov	(sp)+,(r3)+	/ write	result in data
	jbr	datloop
atof:
	mov	r2,-(sp)		/ save byte count
	clr	-(sp)
	clrf	fr0
	clr	r2
1:
	movb	(r4)+,r0		/ get byte
	cmp	$' ,r0
	bge	1b
	cmpb	r0,$'+
	beq	1f
	cmpb	r0,$'-
	bne	2f
	inc	(sp)
1:
	movb	(r4)+,r0		/ get next byte
2:
	sub	$'0,r0
	cmp	r0,$9.
	bhi	2f
	jsr	pc,digit
		br 1b
	inc	r2
	br	1b
2:
	cmpb	r0,$'.-'0
	bne	2f
1:
	movb	(r4)+,r0		/ get next byte
	sub	$'0,r0
	cmp	r0,$9.
	bhi	2f
	jsr	pc,digit
		dec r2
	br	1b
2:
	cmpb	r0,$'E-'0
	beq	3f
	cmpb	r0,$'e-'0
	bne	1f
3:
	clr	r3
	clr	r1
	movb	(r4)+,r0		/ get next byte
	cmpb	r0,$'+
	beq	3f
	cmpb	r0,$'-
	bne	5f
	inc	r3
3:
	movb	(r4)+,r0		/ get next byte
5:
	sub	$'0,r0
	cmp	r0,$9.
	bhi	3f
	mul	$10.,r1
	add	r0,r1
	br	3b
3:
	tst	r3
	bne	3f
	neg	r1
3:
	sub	r1,r2
1:
	movf	$one,fr1
	movf	$one,fr2
	mov	r2,-(sp)
	beq	2f
	bgt	1f
	neg	r2
1:
	mulf	$twohalf,fr1
	mulf	$four,fr2
	sob	r2,1b
2:
	tst	(sp)+
	bge	1f
	divf	fr1,fr0
	divf	fr2,fr0
	br	2f
1:
	mulf	fr1,fr0
	mulf	fr2,fr0
2:
	tst	(sp)+
	beq	1f
	negf	fr0
1:	mov	(sp)+,r2
	rts	pc


digit:
	cmpf	$big,fr0
	cfcc
	blt	1f
	mulf	$ten,fr0
	movif	r0,fr1
	addf	fr1,fr0
	rts	pc
1:
	add	$2,(sp)
	rts	pc
/
/
one	= 40200
twohalf	= 40440
four	= 40600
ten	= 41040
big	= 56200
huge	= 77777


/------------------------------------------------------------------------------
/------------------------------------------------------------------------------
/	Main loop of interpreter starts	here
/------------------------------------------------------------------------------

loop:
	movb	(pcx)+,r0		/ pickup opcode	+ sign extend
9:	asl	r0			/ opcode now -256 .. 254 & even

.if .opfreq
	mov	r0,r1
	asl	r1			/ multiply by two again
	add	$1,counttab+514.(r1)	/ cannot be inc
	adc	counttab+512.(r1)	/ double precision counters
.endif
.if .prof
	add	timeinf(r0),*loprof
	adc	*hiprof			   / double precision
.endif
	mov	dispat(r0),pc		/ fast dispatch

/------------------------------------------------------------------------------
/	Two byte opcodes come here for decoding	of second byte
/------------------------------------------------------------------------------

escape1:
	clr	r0
	bisb	(pcx)+,r0		/ fetch	second byte no sign extend
	asl	r0			/ 0 to 512 & even
	cmp	$0500,r0		/ look for righ	range
	jlt	e.illins

.if .opfreq
	mov	r0,r1
	asl	r1			/ multiply by two again
	add	$1,counttab+1026.(r1)	/ cannot be inc
	adc	counttab+1024.(r1)	/ double precision counters
.endif
.if .prof
	add	time2inf(r0),*loprof
	adc	*hiprof			   / double precision
.endif
	mov	dispae1(r0),pc		  / fast dispatch

/----------------------------------------------------------------------------
escape2:
	movb	(pcx)+,r0		/ fetch	second byte and	sign extend
	jne	e.illins

.if .opfreq
	add	$1,counttab+1666.	/ cannot be inc
	adc	counttab+1664.		/ double precision counters
.endif
	jbr	loc.f			/ fast dispatch
/------------------------------------------------------------------------------
/	dispatch tables, first the unescaped opcodes
/
/	name convention	is as follows:
/	each execution routine has as a	name the name of the instruction
/	followed by a dot and a	suffix.
/	suffix can be an integer (sometimes followed by	a W),
/	an 's'or a 'w',	followed by an integer,	an 'l' ,a 'p' ,
/	a 'n', sometimes followed by a 'w',  or	a 'z'.
/	loc.1		routine	to execute loc 1
/	zge.s0		routine	to execute zge 0 thru 255
/	lae.w1		routine	to execute lae 1024 thru lae 2046
/	lof.2W		routine	to execute lof 2*the word size
/	lol.pw		routine	to execute positive lol	instructions
/	loe.l		routine	to execute all loe instructions
/	add.z		routine	to execute instruction without operand
/			or with	operand	on the stack.
/------------------------------------------------------------------------------
	.data



lal.p;	 lal.n;	  lal.0;   lal._1;  lal.w0;  lal.w_1; lal.w_2; lar.1W
ldc.0;	 lde.lw;  lde.w0;  ldl.0;   ldl.w_1; lfr.1W;  lfr.2W;  lfr.s0
lil.w_1; lil.w0;  lil.0;   lil.1W;  lin.l;   lin.s0;  lni.z;   loc.l
loc._1;	 loc.s0;  loc.s_1; loe.lw;  loe.w0;  loe.w1;  loe.w2;  loe.w3
loe.w4;	 lof.l;	  lof.1W;  lof.2W;  lof.3W;  lof.4W;  lof.s0;  loi.l
loi.1;	 loi.1W;  loi.2W;  loi.3W;  loi.4W;  loi.s0;  lol.pw;  lol.nw
lol.0;	 lol.1W;  lol.2W;  lol.3W;  lol._1W; lol._2W; lol._3W; lol._4W
lol._5W; lol._6W; lol._7W; lol._8W; lol.w0;  lol.w_1; lxa.1;   lxl.1
lxl.2;	 mlf.s0;  mli.1W;  mli.2W;  rck.1W;  ret.0;   ret.1W;  ret.s0
rmi.1W;	 sar.1W;  sbf.s0;  sbi.1W;  sbi.2W;  sdl.w_1; set.s0;  sil.w_1
sil.w0;	 sli.1W;  ste.lw;  ste.w0;  ste.w1;  ste.w2;  stf.l;   stf.1W
stf.2W;	 stf.s0;  sti.1;   sti.1W;  sti.2W;  sti.3W;  sti.4W;  sti.s0
stl.pw;	 stl.nw;  stl.0;   stl.1W;  stl._1W; stl._2W; stl._3W; stl._4W
stl._5W; stl.w_1; teq.z;   tgt.z;   tlt.z;   tne.z;   zeq.l;   zeq.s0
zeq.s1;	 zer.s0;  zge.s0;  zgt.s0;  zle.s0;  zlt.s0;  zne.s0;  zne.s_1
zre.lw;	 zre.w0;  zrl._1W; zrl._2W; zrl.w_1; zrl.nw;  escape1; escape2


dispat:		      /	dispatch table for unescaped opcodes


loc.0;	 loc.1;	  loc.2;   loc.3;   loc.4;   loc.5;   loc.6;   loc.7
loc.8;	 loc.9;	  loc.10;  loc.11;  loc.12;  loc.13;  loc.14;  loc.15
loc.16;	 loc.17;  loc.18;  loc.19;  loc.20;  loc.21;  loc.22;  loc.23
loc.24;	 loc.25;  loc.26;  loc.27;  loc.28;  loc.29;  loc.30;  loc.31
loc.32;	 loc.33;  aar.1W;  adf.s0;  adi.1W;  adi.2W;  adp.l ;  adp.1
adp.2;	 adp.s0;  adp.s_1; ads.1W;  and.1W;  asp.1W;  asp.2W;  asp.3W
asp.4W;	 asp.5W;  asp.w0;  beq.l;   beq.s0;  bge.s0;  bgt.s0;  ble.s0
blm.s0;	 blt.s0;  bne.s0;  bra.l;   bra.s_1; bra.s_2; bra.s0;  bra.s1
cal.1;	 cal.2;	  cal.3;   cal.4;   cal.5;   cal.6;   cal.7;   cal.8
cal.9;	 cal.10;  cal.11;  cal.12;  cal.13;  cal.14;  cal.15;  cal.16
cal.17;	 cal.18;  cal.19;  cal.20;  cal.21;  cal.22;  cal.23;  cal.24
cal.25;	 cal.26;  cal.27;  cal.28;  cal.s0;  cff.z;   cif.z;   cii.z
cmf.s0;	 cmi.1W;  cmi.2W;  cmp.z;   cms.s0;  csa.1W;  csb.1W;  dec.z
dee.w0;	 del.w_1; dup.1W;  dvf.s0;  dvi.1W;  fil.l;   inc.z;   ine.lw
ine.w0;	 inl._1W; inl._2W; inl._3W; inl.w_1; inn.s0;  ior.1W;  ior.s0
lae.l;	 lae.w0;  lae.w1;  lae.w2;  lae.w3;  lae.w4;  lae.w5;  lae.w6



/------------------------------------------------------------------------------
/	now dispatch table for escaped opcodes
/------------------------------------------------------------------------------

dispae1:      /dispatch	escaped	opcodes	1

aar.l;	 aar.z;	  adf.l;   adf.z;   adi.l;   adi.z;   ads.l;   ads.z
adu.l;	 adu.z;	  and.l;   and.z;   asp.lw;  ass.l;   ass.z;   bge.l
bgt.l;	 ble.l;	  blm.l;   bls.l;   bls.z;   blt.l;   bne.l;   cai.z
cal.l;	 cfi.z;	  cfu.z;   ciu.z;   cmf.l;   cmf.z;   cmi.l;   cmi.z
cms.l;	 cms.z;	  cmu.l;   cmu.z;   com.l;   com.z;   csa.l;   csa.z
csb.l;	 csb.z;	  cuf.z;   cui.z;   cuu.z;   dee.lw;  del.pw;  del.nw
dup.l;	 dus.l;	  dus.z;   dvf.l;   dvf.z;   dvi.l;   dvi.z;   dvu.l
dvu.z;	 fef.l;	  fef.z;   fif.l;   fif.z;   inl.pw;  inl.nw;  inn.l
inn.z;	 ior.l;	  ior.z;   lar.l;   lar.z;   ldc.l;   ldf.l;   ldl.pw
ldl.nw;	 lfr.l;	  lil.pw;  lil.nw;  lim.z;   los.l;   los.z;   lor.s0
lpi.l;	 lxa.l;	  lxl.l;   mlf.l;   mlf.z;   mli.l;   mli.z;   mlu.l
mlu.z;	 mon.z;	  ngf.l;   ngf.z;   ngi.l;   ngi.z;   nop.z;   rck.l
rck.z;	 ret.l;	  rmi.l;   rmi.z;   rmu.l;   rmu.z;   rol.l;   rol.z
ror.l;	 ror.z;	  rtt.z;   sar.l;   sar.z;   sbf.l;   sbf.z;   sbi.l
sbi.z;	 sbs.l;	  sbs.z;   sbu.l;   sbu.z;   sde.l;   sdf.l;   sdl.pw
sdl.nw;	 set.l;	  set.z;   sig.z;   sil.pw;  sil.nw;  sim.z;   sli.l






sli.z;	 slu.l;	  slu.z;   sri.l;   sri.z;   sru.l;   sru.z;   sti.l
sts.l;	 sts.z;	  str.s0;  tge.z;   tle.z;   trp.z;   xor.l;   xor.z
zer.l;	 zer.z;	  zge.l;   zgt.l;   zle.l;   zlt.l;   zne.l;   zrf.l
zrf.z;	 zrl.pw;  dch.z;   exg.s0;  exg.l;   exg.z;   lpb.z;   gto.l

/------------------------------------------------------------------------------
/	timeinf	tables,	first the unescaped opcodes
/	these tables are parallel to the tables	dispat and dispae1
/	Each entry contains a reasonable estimate of
/	the number of memory-cycles needed to
/	execute	that instruction. The exact amount cannot be
/	supplied, since	this can depend	rather heavily on the
/	size of	the object in set, array case instructions etc.
/	The table timeinf also contains, added to each entry,
/	the number of memory-cycles needed to decode the instruction.
/	This number is currently 6. The	number is computed for
/	the case that all check	and runinf options are off.
/------------------------------------------------------------------------------
.if .prof
23.;	23.;	12.;	12.;	18.;	17.;	19.;	61.
11.;	31.;	21.;	15.;	20.;	30.;	30.;	31.
20.;	18.;	18.;	19.;	29.;	18.;	13.;	20.
10.;	14.;	13.;	27.;	20.;	20.;	20.;	20.
20.;	23.;	16.;	16.;	16.;	16.;	17.;	38.
14.;	26.;	26.;	26.;	26.;	28.;	26.;	25.
11.;	11.;	11.;	11.;	11.;	11.;	11.;	11.
11.;	11.;	11.;	11.;	16.;	16.;	26.;	24.

24.;	53.;	25.;	25.;	18.;	27.;	44.;	54.
30.;	59.;	53.;	21.;	28.;	19.;	51.;	18.
18.;	21.;	27.;	19.;	20.;	18.;	25.;	16.
16.;	15.;	12.;	24.;	24.;	24.;	24.;	25.
26.;	25.;	15.;	13.;	11.;	11.;	11.;	11.
11.;	16.;	14.;	14.;	14.;	14.;	20.;	16.
16.;	21.;	16.;	16.;	16.;	16.;	16.;	16.
26.;	16.;	10.;	10.;	15.;	24.;	10.;	40.

timeinf:

 9.;	10.;	10.;	10.;	10.;	10.;	10.;	10.
10.;	10.;	10.;	10.;	10.;	10.;	10.;	10.
10.;	10.;	10.;	10.;	10.;	10.;	10.;	10.
10.;	10.;	10.;	10.;	10.;	10.;	10.;	10.
10.;	10.;	48.;	53.;	21.;	28.;	20.;	10.
10.;	12.;	13.;	11.;	44.;	11.;	11.;	11.
11.;	11.;	27.;	21.;	17.;	17.;	17.;	17.
81.;	17.;	17.;	21.;	12.;	12.;	11.;	12.

54.;	54.;	54.;	54.;	54.;	54.;	54.;	54.
54.;	54.;	54.;	54.;	54.;	54.;	54.;	54.
54.;	54.;	54.;	54.;	54.;	54.;	54.;	54.
54.;	54.;	54.;	54.;	54.;	41.;	49.;	37.
40.;	53.;	53.;	51.;	60.;	24.;	41.;	11.
20.;	19.;	10.;	53.;	30.;	29.;	11.;	30.
20.;	15.;	15.;	15.;	19.;	44.;	37.;	36.
25.;	19.;	19.;	19.;	19.;	19.;	19.;	19.

/------------------------------------------------------------------------------
/	time2inf table for escaped opcodes
/	cycles necessary for decoding is already accounted for in timeinf
/------------------------------------------------------------------------------

time2inf:

57.;	46.;	61.;	50.;	37.;	26.;	30.;	19.
45.;	34.;	52.;	41.;	37.;	42.;	31.;	21.
21.;	21.;	91.;   108.;	97.;	21.;	21.;	53.
60.;	56.;	55.;	26.;	53.;	42.;	62.;	51.
72.;	61.;	72.;	61.;	38.;	27.;	40.;	29.
53.;	46.;	54.;	38.;	23.;	30.;	30.;	28.
36.;	45.;	34.;	61.;	50.;	39.;	28.;	44.
33.;	68.;	57.;	68.;	57.;	30.;	28.;	54.

45.;	44.;	33.;	70.;	59.;	22.;	27.;	28.
29.;	37.;	28.;	27.;	11.;	47.;	40.;	21.
20.;	35.;	33.;	61.;	50.;	34.;	23.;	39.
28.;   500.;	47.;	36.;	41.;	30.;   100.;	38.
27.;	62.;	39.;	28.;	44.;	33.;	88.;	77.
92.;	81.;	32.;	68.;	57.;	61.;	50.;	37.
26.;	33.;	22.;	45.;	34.;	29.;	28.;	30.
28.;	61.;	52.;	16.;	28.;	27.;	11.;	30.

19.;	36.;	25.;	32.;	21.;	36.;	25.;	31.
39.;	32.;	32.;	14.;	14.;   117.;	45.;	34.
31.;	22.;	20.;	20.;	20.;	20.;	20.;	27.
16.;	26.;	17.;	39.;	47.;	36.;	10.;	29.
.endif
	     .text
/------------------------------------------------------------------------------
/	LOAD CONSTANT, LOAD LOCAL, STORE LOCAL
/------------------------------------------------------------------------------

loc.0:	clr	-(sp)
	next
loc.1:	loc.2:	loc.3:	loc.4:	loc.5:	loc.6:	loc.7:	loc.8:
loc.9:	loc.10:	loc.11:	loc.12:	loc.13:	loc.14:	loc.15:	loc.16:
loc.17:	loc.18:	loc.19:	loc.20:	loc.21:	loc.22:	loc.23:	loc.24:
loc.25:	loc.26:	loc.27:	loc.28:	loc.29:	loc.30:	loc.31:	loc.32:
loc.33:
	asr	r0		/ make multiplication undone
	mov	r0,-(sp)
	next
loc._1:
	mov	$-1,-(sp)
	next
loc.s0:
	clr	r0
	br	2f
loc.s_1:
	mov	$-400,r0
2:	bisb	(pcx)+,r0
	mov	r0,-(sp)
	next
lpi.l:				/ let op, dit is een pointer
				/ zonder offset	op het moment!
loc.l:
	jsr	pc,wrdoff
	mov	r0,-(sp)
	next
ldc.0:
	clr	-(sp)
	clr	-(sp)
	next
ldc.l:
	jsr	pc,wrdoff
	mov	r0,-(sp)
	sxt    -(sp)
	next

loc.f:	jsr	pc,wrdoff;	mov	r0,r1
	jsr	pc,wrdoff;	mov	r0,-(sp)
	mov	r1,-(sp);	next

/__________________________________________________________________________

lol.0:		mov	010(r2),-(sp);	next
lol.1W:		mov	012(r2),-(sp);	next
lol.2W:		mov	014(r2),-(sp);	next
lol.3W:		mov	016(r2),-(sp);	next
lol._1W:	mov	-02(r2),-(sp);	next
lol._2W:	mov	-04(r2),-(sp);	next
lol._3W:	mov	-06(r2),-(sp);	next
lol._4W:	mov	-010(r2),-(sp);	next
lol._5W:	mov	-012(r2),-(sp);	next
lol._6W:	mov	-014(r2),-(sp);	next
lol._7W:	mov	-016(r2),-(sp);	next
lol._8W:	mov	-020(r2),-(sp);	next

lol.w0:		clr	r0;		bisb	(pcx)+,r0
5:		asl	r0;		add	r2,r0
		mov	010(r0),-(sp);	next
lol.w_1:	mov	$-400,r0;	bisb	(pcx)+,r0
2:		asl	r0;		add	r2,r0
		mov	(r0),-(sp);	next
lol.pw:		jsr	pc,wrdoff;	br	5b
lol.nw:		jsr	pc,wrdoff;	br	2b

/------------------------------------------------------------------------------

ldl.0:		mov	10.(r2),-(sp);	mov	8.(r2),-(sp);	 next
ldl.w_1:	mov	$-400,r0;	bisb	(pcx)+,r0
2:		asl	r0;		add	r2,r0
		mov	2(r0),-(sp);	mov	(r0),-(sp);    next
ldl.pw:		jsr	pc,wrdoff;	asl	r0
		add	r2,r0;		mov	10.(r0),-(sp)
		mov	8.(r0),-(sp);	next
ldl.nw:		jsr	pc,wrdoff;	br	2b

/------------------------------------------------------------------------------
loe.lw:		jsr	pc,wrdoff;	br	2f
loe.w0:		loe.w1:		loe.w2:		loe.w3:		loe.w4:
		asr	r0;		add	$0144,r0
		swab	r0;		bisb	(pcx)+,r0
2:		asl	r0;		add	eb,r0
		mov	(r0),-(sp);	next
lde.lw:		jsr	pc,wrdoff;	br	2f
lde.w0:		clr	r0;		bisb	(pcx)+,r0
2:		asl	r0;		add	eb,r0
		mov	2(r0),-(sp);	mov	(r0),-(sp);    next


/------------------------------------------------------------------------------
lil.0:		clr	r0;		br	1f
lil.1W:		mov	$1,r0;		br	1f
lil.pw:		jsr	pc,wrdoff;	br	1f
lil.w0:		clr	r0;		bisb	(pcx)+,r0
1:		add	$04,r0
2:		asl	r0;		add	r2,r0
		mov	(r0),-(sp);	jsr	pc,chckptr
		mov	*(sp),(sp);	next
lil.w_1:	mov	$-400,r0;	bisb	(pcx)+,r0;    br      2b
lil.nw:		jsr	pc,wrdoff;	br     2b
/------------------------------------------------------------------------------
lof.l:		jsr	pc,wrdoff
1:		jsr	pc,chckptr;	add	(sp)+,r0;
		mov	(r0),-(sp);    next

lof.1W:		lof.2W:		lof.3W:		lof.4W:
		add	$0276,r0;
		br	1b
lof.s0:		clr	r0;		bisb	(pcx)+,r0;	br	1b
ldf.l:		jsr	pc,wrdoff;	add	(sp)+,r0
		mov	2(r0),-(sp);	mov	(r0),-(sp);	next
/------------------------------------------------------------------------------
lal.p:		jsr	pc,wrdoff
5:		add	r2,r0;		add	$8.,r0
		mov	r0,-(sp);	next
lal.0:		mov	r2,-(sp);	add	$8.,(sp);	next
lal.w0:		clr	r0;		bisb	(pcx)+,r0
		asl	r0;		br	5b
lal.n:		jsr	pc,wrdoff;	br	2f
lal._1:		mov	$-1,r0
2:		add	r2,r0;		mov	r0,-(sp);	next
lal.w_1:	mov	$-400,r0
3:		bisb	(pcx)+,r0;	asl	r0;		br	2b
lal.w_2:	mov	$-1000,r0;	br	3b

lae.l:		jsr	pc,wrdoff;	br	1f
lae.w0:	lae.w1:	lae.w2:	lae.w3:	lae.w4:	lae.w5:	lae.w6:
		asr	r0
		sub	$0171,r0;	swab	r0
		bisb	(pcx)+,r0;	asl	r0
1:		add	eb,r0;
.if .test
		cmp	globmax,r0;
		bhi	1f;		jsr	pc,e.badlae;
.endif
1:		mov	r0,-(sp);      next
/------------------------------------------------------------------------------
lxl.1:		mov	$1,r0;		br	1f
lxl.2:		mov	$2,r0;		br	1f
lxl.l:		jsr	pc,wrdoff
		bgt	1f;		jlt	e.oddz
		mov	r2,-(sp);	next
1:		mov	r2,r1
2:		mov	8(r1),r1;	sob	r0,2b
		mov	r1,-(sp);	next

lxa.1:		mov	$1,r0;		br	1f
lxa.l:		jsr	pc,wrdoff;	bgt	1f
		jlt	e.oddz;		mov	r2,-(sp)
		add	$10,(sp);	next
1:		mov	r2,r1
2:		mov	8(r1),r1;	sob	r0,2b
		add	$10,r1;		mov	 r1,-(sp);	 next

/------------------------------------------------------------------------------
loi.l:		jsr	pc,wrdoff;	br	2f
loi.1W:	loi.2W:	loi.3W:	loi.4W:
		add	$260,r0;	br	1f
loi.s0:		clr	r0;		bisb	(pcx)+,r0
2:		cmp	$1,r0;		beq	loi.1
1:		jsr	pc,chckptr;	mov	(sp)+,r1;	add	r0,r1
		asr	r0;		jcs	e.oddz
1:		mov	-(r1),-(sp);	sob	r0,1b;		next
loi.1:		jsr	pc,chckptb;	mov	(sp),r1;	clr	r0
		bisb	(r1),r0;	mov	r0,(sp);	next
los.z:
		mov	(sp)+,r0
		br	0f
los.l:
		jsr	pc,wrdoff
0:
		cmp	$04,r0
		beq	4f

		cmp	$02,r0;		beq	3f
		jbr	e.oddz
4:		mov	(sp)+,r0
3:		mov	(sp)+,r0;	br	2b

/------------------------------------------------------------------------------
			/Store group
/------------------------------------------------------------------------------
stl.pw:		jsr	pc,wrdoff;	asl	r0;	br    0f
stl.0:		clr	r0;		br	0f
stl.1W:		mov	$2,r0
0:		add	r2,r0;		mov(sp)+,8.(r0);	next

stl.nw:		jsr	pc,wrdoff;	br	0f
stl.w_1:	mov	$-400,r0;	bisb	(pcx)+,r0
0:		asl	r0;		add	r2,r0
		mov	(sp)+,(r0);	next
stl._1W:	mov	(sp)+,-2(r2);	next
stl._2W:	mov	(sp)+,-4(r2);	next
stl._3W:	mov	(sp)+,-6(r2);	next
stl._4W:	mov	(sp)+,-10(r2);	next
stl._5W:	mov	(sp)+,-12(r2);	next

sdl.w_1:	mov	$-400,r0;	bisb	(pcx)+,r0
0:		asl	r0;		add	r2,r0
2:		mov	(sp)+,(r0)+;	mov	(sp)+,(r0);	next
sdl.nw:		jsr	pc,wrdoff;	br	0b
sdl.pw:		jsr	pc,wrdoff;	asl	r0
		add	r2,r0;		add	$8.,r0;		br	2b

/------------------------------------------------------------------------------

sde.l:		jsr	pc,wrdoff;	add	eb,r0
		br	2b
ste.lw:		jsr	pc,wrdoff;	br	1f
ste.w0:		clr	r0;		br	0f
ste.w1:		mov	$400,r0;	br	0f
ste.w2:		mov	$1000,r0
0:		bisb	(pcx)+,r0
1:		asl	r0;		add	eb,r0
		mov	(sp)+,(r0);	next


/------------------------------------------------------------------------------

stf.l:		jsr	pc,wrdoff;	br	6f
stf.1W:		mov	$2,r0;		br	6f
stf.2W:		mov	$4,r0;		br	6f
stf.s0:		clr	r0;		bisb	(pcx)+,r0
6:		add	(sp)+,r0;	br	7f
sdf.l:		jsr	pc,wrdoff;	add	(sp)+,r0
		jbr	 2b


/------------------------------------------------------------------------------
sil.w0:		clr	r0;		bisb	(pcx)+,r0
5:		asl	r0;		add	r2,r0
		mov	8.(r0),r0;	br	7f
sil.w_1:	mov	$-400,r0;	bisb	(pcx)+,r0
2:		asl	r0;		add	r2,r0
		mov	(r0),r0;
7:		mov	(sp),r1;	mov	r0,(sp);
		jsr	pc,chckptr;	mov	r1,*(sp)+;    next
sil.pw:		jsr	pc,wrdoff;	br	5b
sil.nw:		jsr	pc,wrdoff;	br	2b
/------------------------------------------------------------------------------
sti.1:		jsr	pc,chckptb;	mov	(sp)+,r1;
		movb	(sp)+,(r1);	next
sti.1W:		sti.2W:		sti.3W:		sti.4W:
		add	$114,r0;	br	1f
sti.s0:		clr	r0;		bisb	(pcx)+,r0;	br     1f
sti.l:		jsr	pc,wrdoff
1:		asr	r0;		beq	3f
		jcs	e.oddz;		jsr	pc,chckptr;
		mov	(sp)+,r1
2:		mov	(sp)+,(r1)+;	sob	r0,2b;		next
3:		jcs	sti.1;		jbr	e.oddz
sts.l:		jsr	pc,wrdoff
0:		cmp	$2,r0;		beq	2f
		cmp	$4,r0;		beq	4f;		jbr   e.oddz
4:		mov	(sp)+,r0
2:		mov	(sp)+,r0;	br	1b
sts.z:		mov	(sp)+,r0;	br	0b

/------------------------------------------------------------------------------
/		 POINTER ARITHMETIC
/------------------------------------------------------------------------------
adp.l:		jsr	pc,wrdoff;	add	r0,(sp);    next
adp.1:		add	$1,(sp);	next
adp.2:		add	$2,(sp);	next
adp.s0:		clr	r0;		bisb	(pcx)+,r0
		add	r0,(sp);	next
adp.s_1:	mov	$-400,r0;	bisb	(pcx)+,r0
		add	r0,(sp);	next
ads.l:		jsr	pc,wrdoff;	br	0f
ads.z:		mov	(sp)+,r0
0:		cmp	$1,r0;		beq	1f
		asr	r0;		jcs	e.oddz
2:		mov	(sp)+,r1;	sob	r0,2b
		add	r1,(sp);	next
ads.1W:		mov	(sp)+,r1;	add	r1,(sp);    next
1:		movb	(sp)+,r1
		add	r1,(sp);	next
sbs.l:		jsr	pc,wrdoff;	br	0f
sbs.z:		mov	(sp)+,r0
0:		mov	(sp)+,r1;	sub	r1,(sp)
		beq	0f;		mov	$-1,r1
		br	1f
0:		clr	r1
1:		dec	r0;		beq	3f
		dec	r0;		beq	2f
		asr	r0
4:		mov	r1,-(sp);	sob	r0,4b
2:		next
3:		clrb	1(sp);	next


/------------------------------------------------------------------------------
/------------------------------------------------------------------------------
/	Clears,	increments and decrements
/------------------------------------------------------------------------------
inc.z:		mov	sp,r1;
4:
.if .test
		cmp	(r1),$und;	jne	3f;
		jsr	pc,e.iund;			3:
.endif
		inc	(r1);		bvs	9f;	next
inl._1W:	mov	r2,r1;		sub	$2,r1;		br 4b
inl._2W:	mov	r2,r1;		sub	$4,r1;		br 4b
inl._3W:	mov	r2,r1;		sub	$6,r1;		br 4b
inl.w_1:	mov	$-400,r0;	bisb	(pcx)+,r0;
1:		asl	r0;		mov	r2,r1;
		add	r0,r1;		br	4b
inl.pw:		jsr	pc,wrdoff;	add	$4,r0;
		br	1b;		/      !! proc frame 4	words
inl.nw:		jsr	pc,wrdoff;	br	1b
ine.lw:		jsr	pc,wrdoff;	br	1f
ine.w0:		clr	r0;		bisb	(pcx)+,r0;
1:		asl	r0;		add	eb,r0;
		mov	r0,r1;		br	4b
dec.z:		mov	sp,r1;
4:
.if .test
		cmp	(r1),$und;	jne	3f;
		jsr	pc,e.iund;			3:
.endif
		dec	(r1);		bvs	9f;	next
del.w_1:	mov	$-400,r0;	bisb	(pcx)+,r0;
1:		asl	r0;		mov	r0,r1;
		add	r2,r1;		br	4b
del.pw:		jsr	pc,wrdoff;	add	$4,r0;
		br	1b;		/	!proc frame 4 words
del.nw:		jsr	pc,wrdoff;	br	1b
dee.w0:		clr	r0;		bisb	(pcx)+,r0;
1:		asl	r0;		add	eb,r0;
		mov	r0,r1;		br	4b
dee.lw:		jsr	pc,wrdoff;	br	1b;
9:		jsr	pc,e.iovfl;	next
		/ jump to an error routine for integer overflow
zrl._1W:	clr	-2(r2);		next
zrl._2W:	clr	-4(r2);		next
zrl.w_1:	mov	$-400,r0;	bisb	(pcx)+,r0;
1:		asl	r0;		add	r2,r0;
		clr	(r0);		next
zrl.nw:		jsr	pc,wrdoff;	br	1b
zrl.pw:		jsr	pc,wrdoff;	add	$4,r0;
		br	1b
zre.lw:		jsr	pc,wrdoff;	br	1f
zre.w0:		clr	r0;		bisb	(pcx)+,r0;
1:		asl	r0;		add	eb,r0;
		clr	(r0);		next
zrf.l:		jsr	pc,wrdoff;	br	1f
zrf.z:		mov	(sp)+,r0;
1:		asr	r0;
2:		clr	-(sp);		sob	r0,2b;		next
zer.s0:		clr	r0;		bisb	(pcx)+,r0;
3:		bit	$1,r0;		jne	e.illins
		/ test if number of bytes is even
		br	1b
zer.l:		jsr	pc,wrdoff;	br	3b
zer.z:		mov	(sp)+,r0;	br	3b
/------------------------------------------------------------------------------
/		LOGICAL	GROUP
/------------------------------------------------------------------------------

and.1W:		mov	$1,r1;		mov	$2,r0;
		br	lbland;
and.l:		jsr	pc,wrdoff;	br	0f
and.z:		mov	(sp)+,r0;
0:		ble	9f;		mov	r0,r1;
		asr	r1;		bcs	9f;
lbland:		add	sp,r0;
1:		mov	(sp)+,r5;	com	r5;
		bic	r5,(r0)+;	sob	r1,1b;
		next
ior.1W:		mov	$1,r1;		mov	$2,r0;
		br	0f
ior.s0:		clr	r0;		bisb	(pcx)+,r0;
		br	0f
ior.l:		jsr	pc,wrdoff;	br	0f
ior.z:		mov	(sp)+,r0;
lblior:

0:		ble	9f;		bit	$1,r0;
		bne	9f;		mov	r0,r1;
		mov	sp,r5;	add	r0,r5;	asr	r1;
1:		bis	(sp)+,(r5)+;	sob	r1,1b;		   next
xor.l:		jsr	pc,wrdoff;	br	0f;
xor.z:		mov	(sp)+,r0;
0:		ble	9f;		bit	$1,r0;
		bne	9f;		mov	r0,r1;
		mov	sp,r5;	add	r0,r5;	asr	r1
1:		mov	(sp)+,r0;
		xor	r0,(r5)+;    sob     r1,1b;		next
com.l:		jsr	pc,wrdoff;	br	1f
com.z:		mov	(sp)+,r0;
1:		bit	$1,r0;		bne	9f
		mov	r0,r1;		asr	r1
		add	sp,r0;
2:		com	-(r0);		sob	r1,2b
		next
rol.l:		jsr	pc,wrdoff;	br	3f
rol.z:		mov	(sp)+,r0;
3:		clr	r4;
		mov	(sp)+,r5;	ash	$3,r0;
		div	r0,r4;		mov	r5,r4;
		bge	1f;		add	r0,r4;
1:		ash	$-3,r0;		mov	sp,r1;
		cmp	r0,$1;		beq	1f;
		add	r0,r1;		mov	r1,r5;
		asr	r0;		jcs	9f
		mov	r3,saver0;	mov	r0,r3;
4:		mov	r3,r0;		mov	r5,r1;
2:		rol	-(r1);		sob	r0,2b;
		adc	-2(r5);		sob	r4,4b;
		mov	saver0,r3;	mov	$loop,r4;	next
1:		rolb	(r1)+;		adc	(r1);
		sob	r4,1b;		mov	saver1,r4;	next
ror.l:		jsr	pc,wrdoff;	neg	(sp);	br 3b
ror.z:		mov	(sp)+,r0;	neg	(sp);	br 3b
9:		jsr	 pc,e.oddz  /error codes for odd or
				    /negative number of	bytes

/------------------------------------------------------------------------------
/		SET GROUP
/------------------------------------------------------------------------------

set.s0:		clr	r0;		bisb	(pcx)+,r0
1:
.if .test
		bgt	9f;		jsr	pc,e.set
9:
.endif
		mov	(sp)+,r1
		jsr	pc,settest;	inc	r0
		asr	r0;	      /	if r0 odd choose next even
2:		clr	-(sp);		sob	r0,2b; / empty set
		mov	r1,r0;		ash	$-3,r0;
		add	sp,r0;		bic	$177770,r1;
		bisb	bits(r1),(r0);	next
set.l:		jsr	pc,wrdoff;	br	1b
set.z:		mov	(sp)+,r0;	br	1b
inn.s0:		clr	r0;		bisb	(pcx)+,r0
1:
.if .test
		bgt	9f;		jsr	pc,e.set
9:
.endif
		mov	sp,r5;
		add	r0,r5;		mov	(sp)+,r1;
		jsr	pc,settest;	mov	r1,r0
		ash	$-3,r0;		add	sp,r0;
		clr	-(sp);
		bic	$177770,r1;	   bitb	   bits(r1),(r0)
		beq	2f;		mov	r5,sp;
		mov	$1,(sp);	next
2:		mov	r5,sp;		clr	(sp);	 next
inn.l:		jsr	pc,wrdoff;	br	1b
inn.z:		mov	(sp)+,r0;	br	1b
	.data
bits:	.byte	1
	.byte	2
	.byte	4
	.byte	10
	.byte	20
	.byte	40
	.byte	100
	.byte	200
	.even
	.text
settest:	mov	r0,-(sp);	clc
		ash	$3,r0;		sub	r1,r0;
.if .test
		bgt	3f;		jsr	pc,e.set
.endif
3:		mov	(sp)+,r0;	rts	pc
/------------------------------------------------------------------------------
/		ARRAY	GROUP
/------------------------------------------------------------------------------



lar.1W:		mov	$2,r0;		br	1f
lar.l:		jsr	pc,wrdoff;	br	1f
lar.z:		mov	(sp)+,r0;
1:		jsr	pc,calcarr;	clr	-2(sp);
		sub	r5,sp;		bic	$1,sp;
		mov	sp,r0;
2:		movb	(r1)+,(r0)+;	sob	r5,2b;	next
sar.1W:		mov	$2,r0;		br	1f
sar.l:		jsr	pc,wrdoff;	br	1f
sar.z:		mov	(sp)+,r0;
1:		jsr	pc,calcarr;	mov	sp,r0;
		add	r5,sp;		inc	sp;
		bic	$1,sp;
2:		movb	(r0)+,(r1)+;	sob	r5,2b;	next
aar.1W:		mov	$2,r0;		br	1f
aar.l:		jsr	pc,wrdoff;	br	1f
aar.z:		mov	(sp)+,r0;
1:		jsr	pc,calcarr;	mov	r1,-(sp);	next

calcarr:	sub	$02,r0;		beq	0f;
		jsr	pc,e.oddz;
0:		tst	(sp)+;
		mov	(sp)+,r0;	mov	(sp)+,r1;
		sub	(r0)+,r1;	bge	9f
		jsr	pc,e.array
9:
		cmp	(r0)+,r1;	bge	9f
		jsr	pc,e.array
9:
		mov	(r0),r5;
		mul	r5,r1;		add	(sp)+,r1;
		mov	-010(sp),-(sp);	rts	pc;



/------------------------------------------------------------------------------
/--------------------------------------------------------------
/		CONVERT	GROUP
/--------------------------------------------------------------

cii.z:
		/ convert int to int
		/ 1 byte -> ? :	sign extension
	mov	(sp)+,r0
	inc	r0		/ dest 1 byte =	dest 1 word
	bic	$1,r0
.if .test
	cmp	(sp),$2		/ if size 2 then trap for undefined
	bne	7f
	cmp	2(sp),$und
	bne	7f
	jsr	pc,e.iund	   / this is the trap
7:
.endif
	sub	(sp)+,r0
0:	blt	1f
	asr	r0
	bcc	2f
	movb	(sp),r1
	mov	r1,(sp)
2:	tst	r0
	beq	3f
	tst	(sp)
4:	sxt	-(sp)
	sob	r0,4b
3:	next
1:	sub	r0,sp
.if .test
	mov	sp,r1
	neg	r0
	asr	r0
	tst	(sp)
	blt	3f
5:	tst	-(r1)
	bne	9f
	sob	r0,5b
	next
3:	cmp	-(r1),$-1
	bne	9f
	sob	r0,3b
.endif
	next
/-------
cui.z:	mov	(sp)+,r0
	sub	(sp)+,r0
	clr	-(sp)
	add	$-2,r0
	br	0b
cif.z:
	mov	(sp)+,r0
	jsr	pc,setfloat
	mov	(sp)+,r0
.if .test
	cmp	r0,$2		/ trap if size 2 undefined integer
	bne	7f
	cmp	(sp),$und
	bne	7f
	jsr	pc,e.iund	   / trap for undefined	integer
7:
.endif
	jsr	pc,setint
	movif	(sp)+,fr0
	movf	fr0,-(sp)
	next
cuf.z:
	mov	(sp)+,r0
	jsr	pc,setfloat
	mov	(sp)+,r0
	cmp	r0,$02
	bne	1b
	clr	-(sp)
	mov	$04,r0
	jsr	pc,setint
	movif	(sp)+,fr0
	cfcc
	bge	1f
	addf	fr3,fr0
1:	movf	fr0,-(sp)
	next
/-------
cff.z:
	mov	(sp)+,r0
	cmp	(sp)+,r0
	beq	1f
	jsr	pc,setfloat
	movof	(sp)+,fr0
	movf	fr0,-(sp)
1:	next
/-------
ciu.z:	mov	(sp)+,r0
.if .test
	cmp	(sp),$2		/ trap undefined of size 2
	bne	7f
	cmp	2(sp),$und
	bne	7f
	jsr	pc,e.iund	   / this is the trap
7:
.endif
	sub	(sp)+,r0
	asr	r0
	bcc	2f
	clrb	1(sp)
2:
6:	tst	r0
	beq	3f
	blt	5f
4:	clr	-(sp)
	sob	r0,4b
3:	next
9:	jsr	pc,e.conv;	next
5:	neg	r0
4:	tst	(sp)+
	sob	r0,4b
	next
cuu.z:
	mov	(sp)+,r0
	sub	(sp)+,r0
	asr	r0
	jbr	6b
/-------
cfu.z:
	mov	(sp)+,r0
	jsr	pc,setint
	mov	(sp)+,r0
	jsr	pc,setfloat
	movf	(sp)+,fr0
	movfi	fr0,-(sp)
.if .test
	jcs	9b
	jlt	9b
.endif
	next
/-------
cfi.z:
	mov	(sp)+,r0
	jsr	pc,setint
	mov	(sp)+,r0
	jsr	pc,setfloat
	movf	(sp)+,fr0
	movfi	fr0,-(sp)
	jcs	e.conv
	next
/--------------------------------------------------------------
/		INTEGER	ARITHMETIC
/--------------------------------------------------------------

adi.l:	jsr	pc,wrdoff;	br	0f
adi.z:	mov	(sp)+,r0
0:	cmp	r0,$04
	bgt	1f
	cmp	r0,$02
	bgt	2f
	bne	1f
adi.1W:
.if .test
	cmp	(sp),$und	/ trap undefineds of size 2
	beq	6f
	cmp	2(sp),$und
	bne	7f
6:	jsr	pc,e.iund	   / this is the trap
7:
.endif
	add	(sp)+,(sp)
.if .test
	bvs	9f
.endif
	next
adi.2W:	2:	add	(sp)+,02(sp)
.if .test
	bvc	2f
	jsr	pc,e.iovfl
2:
.endif
	add	(sp)+,02(sp)
	adc	(sp)
.if .test
	bvs	9f
.endif

	next
1:
	jsr    pc,e.oddz ;	next
/-------
sbi.l:	jsr	pc,wrdoff;	br	0f
sbi.z:	mov	(sp)+,r0
0:	cmp	r0,$04
	bgt	1b
	cmp	r0,$02
	bgt	2f
	bne	1b
sbi.1W:
.if .test
	cmp	(sp),$und	/ trap for size	2 undefineds
	beq	6f
	cmp	2(sp),$und
	bne	7f
6:	jsr	pc,e.iund	   / this is the trap
7:
.endif
	sub	(sp)+,(sp)
.if .test
	bvs	9f
.endif
	next
sbi.2W:	2:		sub	(sp)+,02(sp)
.if .test
	bvc	2f
	jsr	pc,e.iovfl
2:
.endif
	sub	(sp)+,02(sp)
	sbc	(sp)
.if .test
	bvs	9f
	next
9:	jsr	pc,e.iovfl
.endif
	next
/------
mli.l:	 jsr	pc,wrdoff;	br	0f
mli.z:	 mov	(sp)+,r0
0:
	cmp	r0,$04
	bgt	1f
	beq	mli4
	cmp	r0,$02
	bne	1f
mli.1W:	mov	(sp)+,r1
.if .test
	cmp	r1,$und		/ trap for undefineds of size 2
	beq	6f
	cmp	(sp),$und
	bne	7f
6:	jsr	pc,e.iund	   / this is the trap
7:
.endif
	mul	(sp)+,r1
.if .test

	bcc	9f		/ overflow
	jsr	pc,e.iovfl
9:
.endif
	mov	r1,-(sp)
	next
1:	jmp	e.oddz
/------
mli.2W:		mli4:
.if .prof
	add	$91.,*loprof
	adc	*hiprof
.endif
	jsr	pc,regsave
	tst	02(sp)
	sxt	r0
	sub	(sp),r0
	tst	06(sp)
	sxt	r2
	sub	04(sp),r2
	mov	r0,r4
	mul	r2,r4
	mul	06(sp),r0
.if .test
	bge	2f
	inc	r4
2:
.endif
	mul	02(sp),r2
.if .test
	bge	2f
	inc	r4
2:	sub	r2,r5
	sbc	r4
	sub	r0,r5
	sbc	r4
	add	r1,r3
	sbc	r5
	sbc	r4
.endif
	mov	02(sp),r0
	mul	06(sp),r0
.if .test
	bge	2f
	sub	$1,r5
	sbc	r4
.endif
2:	sub	r3,r0
.if .test
	sxt	r2
	sbc	r5
	sbc	r4
	cmp	r2,r4
	bne	2f
	cmp	r2,r5
	beq	9f
2:	jsr	pc,e.iovfl
9:
.endif
	add	$010,sp
	mov	r1,-(sp);
	mov	r0,-(sp);
	jsr	pc,regretu;	     next


/-------
dvi.l:	jsr    pc,wrdoff;      br      0f
dvi.z:	mov    (sp)+,r0
0:	cmp	r0,$04
	bgt	1f
	beq	dvi4
	cmp	r0,$02
	bne	1f
dvi.1W:	mov	02(sp),r1
	sxt	r0
.if .test
	cmp	r1,$und		/ trap for undifined of	size 2
	beq	6f
	cmp	(sp),$und
	bne	7f
6:	jsr	pc,e.iund	   / this is the trap
7:
.endif
	div	(sp)+,r0
	jcs	9f
	mov	r0,(sp)
	next
1:	jmp	e.oddz
/-------
dvi4:
.if .prof
	add	$100.,*loprof
	adc	*hiprof
.endif
	jsr	pc,regsave
	mov	02(sp),r3
	bne	1f
	tst	(sp)
	bne	1f
9:	jsr	pc,e.idivz
1:	sxt	r4
	bpl	1f
	neg	r3
1:	cmp	r4,(sp)
	bne	hardldiv
	mov	06(sp),r2
	mov	04(sp),r1
	bge	2f
	neg	r1
	neg	r2
	sbc	r1
	com	r4
2:	mov	r4,-(sp)
	clr	r0
	div	r3,r0
	mov	r0,-(sp)
	mov	r1,r0
	mov	r1,r4
	mov	r2,r1
	div	r3,r0
	bvc	3f
	mov	r2,r1
	mov	r4,r0
	sub	r3,r0
	div	r3,r0
	tst	r1
	sxt	r1
	add	r1,r0
3:	mov	r0,r1
	mov	(sp)+,r0
	br	4f
hardldiv:
.if .prof
	add	$75.,*loprof
	adc	*hiprof
.endif
	clr	-(sp)
	mov	010(sp),r2
	mov	06(sp),r1
	bpl	5f
	com	(sp)
	neg	r1
	neg	r2
	sbc	r1
5:	clr	r0
	mov	02(sp),r3
	bge	6f
	neg	r3
	neg	04(sp)
	sbc	r3
	com	(sp)
6:	mov	$16.,r4
9:	clc
	rol	r2
	rol	r1
	rol	r0
	cmp	r3,r0
	bhi	7f
	bcs	8f
	cmp	04(sp),r1
	blos	8f
7:	sob	r4,9b
	br	1f
8:	sub	04(sp),r1
	sbc	r0
	sub	r3,r0
	inc	r2
	sob	r4,9b
1:
	mov	r2,r1
	clr	r0
4:	tst	(sp)+
	beq	1f
	neg	r0
	neg	r1
	sbc	r0
1:	add	$010,sp
	mov	r1,-(sp);
	mov	r0,-(sp);
	jsr	pc,regretu;	     next
/-------
rmi.l:	jsr	pc,wrdoff;	br	0f
rmi.z:	mov	(sp)+,r0
0:	cmp	r0,$04
	bgt	1f
	beq	rmi4
	cmp	r0,$02
	bne	1f
rmi.1W:	mov	02(sp),r1
	sxt	r0
.if .test
	cmp	r1,$und		/ trap for undefineds of size 2
	beq	6f
	cmp	(sp),$und
	bne	7f
6:	jsr	pc,e.iund	   / this is the trap
7:
.endif
	div	(sp)+,r0
	bcs	9f
	mov	r1,(sp)
	next
1:	jmp	e.oddz
/-------
rmi4:
.if .prof
	add	$100.,*loprof
	adc	*hiprof
.endif
	jsr	pc,regsave
	mov	02(sp),r3
	bne	1f
	tst	(sp)
	bne	1f
9:	jsr	pc,e.idivz
1:	tst	r3
	sxt	r4
	bpl	1f
	neg	r3
1:	cmp	r4,(sp)
	bne	hardrmi4
	mov	06(sp),r2
	mov	04(sp),r1
	mov	r1,r4
	bge	2f
	neg	r1
	neg	r2
	sbc	r1
2:	mov	r4,-(sp)
	clr	r0
	div	r3,r0
	mov	r1,r0
	mov	r1,r4
	mov	r2,r1
	div	r3,r0
	bvc	3f
	mov	r2,r1
	mov	r4,r0
	sub	r3,r0
	div	r3,r0
	tst	r1
	beq	3f
	add	r3,r1
3:	tst	(sp)+
	bpl	4f
	neg	r1
4:	sxt	r0
	br	9f
hardrmi4:
.if .prof
	add	$75.,*loprof
	adc	*hiprof
.endif
	mov	06(sp),r2
	mov	04(sp),r1
	bpl	5f
	neg	r1
	neg	r2
	sbc	r1
5:	clr	r0
	mov	(sp),r3
	bge	6f
	neg	r3
	neg	02(sp)
	sbc	r3
6:	mov	$16.,r4
1:	clc
	rol	r2
	rol	r1
	rol	r0
	cmp	r3,r0
	bhi	7f
	bcs	8f
	cmp	02(sp),r1
	blos	8f
7:	sob	r4,1b
	br	2f
8:	sub	02(sp),r1
	sbc	r0
	sub	r3,r0
	sob	r4,1b
2:	tst	04(sp)
	bge	9f
	neg	r0
	neg	r1
	sbc	r0
9:	add	$010,sp
	mov	r1,-(sp)
	mov	r0,-(sp)
	jsr	pc,regretu;	     next
/-------
ngi.l:	jsr	pc,wrdoff;	br	1f
ngi.z:	mov	(sp)+,r0
1:
lblngi:
	cmp	r0,$02
	bgt	1f
.if .test
	cmp	(sp),$und	/ trap for undefineds of size 2
	bne	7f
	jsr	pc,e.iund
7:
.endif
	neg	(sp)
3:	next
1:	cmp	r0,$04
	bgt	2f
	mov	(sp),r0
	neg	(sp)
	mov	02(sp),r1
	neg	02(sp)
	sbc	(sp)
	cmp	r0,(sp)
.if .test
	bne	3b
	cmp	r1,02(sp)
	bne	3b
2:	jsr	pc,e.iovfl
.endif
	next
/-------
sli.l:	jsr	pc,wrdoff;	br	0f
sli.z:	mov	(sp)+,r0
0:	cmp	r0,$02
	bgt	1f
sli.1W:	mov	(sp)+,r1
	mov	(sp)+,r0
.if .test
	cmp	r0,$und		/ trap for undefined size 2
	bne	7f
	jsr	pc,e.iund
7:
.endif
	ash	r1,r0
.if .test
	bvc	7f
	jsr	pc,e.iovfl
7:
.endif
	mov	r0,-(sp)
	next
1:	cmp	r0,$04
	bgt	2f
	mov	02(sp),r0
	mov	04(sp),r1
	ashc	(sp)+,r0
.if .test
	bvc	7f
	jsr	pc,e.iovfl
7:
.endif
	mov	r0,(sp)
	mov	r1,02(sp)
	next
2:	jmp	e.oddz
/-------
sri.l:	jsr	pc,wrdoff;	br	0f
sri.z:	mov	(sp)+,r0
0:	cmp	r0,$02
	bgt	1f
	mov	(sp)+,r1
	mov	(sp)+,r0
.if .test
	cmp	r0,$und		/ trap for undefined size 2
	bne	7f
	jsr	pc,e.iund
7:
.endif
	neg	r1
	ash	r1,r0
	mov	r0,-(sp)
	next
1:	cmp	r0,$04
	bgt	2f
	mov	02(sp),r0
	mov	04(sp),r1
	neg	(sp)
	ashc	(sp)+,r0
	mov	r0,(sp)
	mov	r1,02(sp)
	next
2:	jmp	e.oddz
/--------------------------------------------------------------
adu.l:	jsr	pc,wrdoff;	br	0f
adu.z:	mov	(sp)+,r0
0:	jsr	pc,tstr0;	add	r0,sp
	mov	sp,r1;		add	r0,sp;		asr	r0
2:	adc	-(sp);		add	-(r1),(sp);	sob r0,2b
	next
sbu.l:	jsr	pc,wrdoff;	br	0f
sbu.z:	mov	(sp)+,r0
0:	jsr	pc,tstr0;	add	r0,sp
	mov	sp,r1;		add	r0,sp;		asr	r0;
2:	sbc	-(sp);		sub	-(r1),(sp);	sob r0,2b
	next
mlu.l:	jsr	pc,wrdoff;	br	0f
mlu.z:	mov	(sp)+,r0
0:	jsr	pc,tstr0
	cmp	r0,$04
	bgt	1f
	beq	mlu4
	mov	(sp)+,r1
	mul	(sp)+,r1
	mov	r1,-(sp)
	next
1:	jmp	e.oddz
mlu4:
.if .prof
	add	$90.,*loprof
	adc	*hiprof
.endif
	jsr	pc,regsave
	clr	r0
	mov	02(sp),r1
	mov	06(sp),r3
	mul	r3,r0
	tst	r3
	bge	1f
	ashc	$15.,r0
1:	mov	02(sp),r3
	clr	r2
	mul	04(sp),r2
	add	r3,r0
	mov	06(sp),r3
	clr	r2
	mul	(sp),r2
	add	r3,r0
	add	$010,sp
	mov	r1,-(sp)
	mov	r0,-(sp)
	jsr	pc,regretu;	     next
9:	jmp	e.oddz
/-------
dvu.l:	jsr	pc,wrdoff;	br	0f
dvu.z:	mov	(sp)+,r0
0:
	clr	saver0;
	cmp	r0,$04
	bgt	9b
	beq	dvu4
	clr	r0
	mov	02(sp),r1
	tst	(sp)
	blt	1f
	div	(sp)+,r0
	mov	r0,(sp);	next
1:	mov	(sp),-(sp);
	clr	02(sp);
	clr	-(sp);
	mov	$1,saver0;
dvu4:
.if .prof
	add	$95.,*loprof
	adc	*hiprof
.endif
	jsr	pc,regsave
	clr	r0
	tst	(sp)
	bne	harddvu4
	tst	02(sp)
	blt	harddvu4
	mov	06(sp),r2
	mov	04(sp),r1
	mov	02(sp),r3
	div	r3,r0
	mov	r0,-(sp)
	mov	r1,r0
	mov	r1,r4
	mov	r2,r1
	div	r3,r0
	bvc	1f
	mov	r2,r1
	mov	r4,r0
	sub	r3,r0
	div	r3,r0
	tst	r1
	sxt	r1
	add	r1,r0
1:	mov	r0,r1
	mov	(sp)+,r0
	br	2f
harddvu4:
.if .prof
	add	$75.,*loprof
	adc	*hiprof
.endif
	mov	06(sp),r2
	mov	04(sp),r1
	mov	(sp),r3
	mov	$17.,r4
	br	3f
6:	rol	r2
	rol	r1
	rol	r0
3:	cmp	r3,r0
	bhi	4f
	blo	5f
	cmp	02(sp),r1
	blos	5f
4:	clc
	sob	r4,6b
	br	7f
5:	sub	02(sp),r1
	sbc	r0
	sub	r3,r0
	sec
	sob	r4,6b
7:	rol	r2
	bcc	8f
	mov	$01,r0
	br	9f
8:	clr	r0
9:	mov	r2,r1
2:	add	$010,sp
	mov	r1,-(sp)
	mov	r0,-(sp)
	jsr	pc,regretu
	tst	saver0;
	beq	2f;
	tst	(sp)+
2:
	  next
/-------
9:	jbr	e.oddz
rmu.l:	jsr	pc,wrdoff;	br	0f
rmu.z:	mov	(sp)+,r0
0:	clr	saver0;
	cmp	r0,$04
	bgt	9b
	beq	rmu4
	cmp	r0,$02
	bne	9b
	mov	$1,saver0;
	mov	02(sp),r1
	tst	(sp)
	blt	1f
	clr	r0
	div	(sp)+,r0
	mov	r1,(sp);		next
1:	mov	(sp),-(sp)
	clr	02(sp)
	clr	-(sp)
rmu4:
.if .prof
	add	$95.,*loprof
	adc	*hiprof
.endif
	jsr	pc,regsave
	clr	r0
	tst	(sp)
	bne	hardrmu4
	tst	02(sp)
	blt	hardrmu4
	mov	06(sp),r2
	mov	04(sp),r1
	mov	02(sp),r3
	div	r3,r0
	mov	r1,r0
	mov	r1,r4
	mov	r2,r1
	div	r3,r0
	bvc	1f
	mov	r2,r1
	mov	r4,r0
	sub	r3,r0
	div	r3,r0
	tst	r1
	beq	1f
	add	r3,r1
1:	clr	r0
	br	2f
hardrmu4:
.if .prof
	add	$75.,*loprof
	adc	*hiprof
.endif
	mov	06(sp),r2
	mov	04(sp),r1
	mov	(sp),r3
	mov	$17.,r4
	br	3f
6:	clc
	rol	r2
	rol	r1
	rol	r0
3:	cmp	r3,r0
	bhi	4f
	bcs	5f
	cmp	02(sp),r1
	blos	5f
4:	sob	r4,6b
	br	2f
5:	sub	02(sp),r1
	sbc	r0
	sub	r3,r0
	sob	r4,6b
2:	add	$010,sp
	mov	r1,-(sp)
	mov	r0,-(sp)
	jsr	pc,regretu
	tst	saver0
	beq	2f;
	tst	(sp)+;
2:	  next
/-------
slu.l:	jsr	pc,wrdoff;	br	0f
slu.z:	mov	(sp)+,r0
0:
	cmp	r0,$02
	bgt	1f
	mov	(sp)+,r1
	mov	(sp)+,r0
	ash	r1,r0
	mov	r0,-(sp)
	next
1:	cmp	r0,$04
	bgt	2f
	mov	02(sp),r0
	mov	04(sp),r1
	ashc	(sp)+,r0
	mov	r0,(sp)
	mov	r1,02(sp)
	next
2:	jmp	e.oddz
/-------
sru.l:	jsr	pc,wrdoff;	br	0f
sru.z:	mov	(sp)+,r0
0:
	cmp	r0,$02
	bgt	1f
	mov	2(sp),r1
	neg	(sp)
	clr	r0
	ashc	(sp)+,r0
2:	mov	r1,-(sp)
	next
1:	cmp	r0,$04
	bgt	3f
	mov	02(sp),r0
	mov	04(sp),r1
	neg	(sp)
	beq	4f
	ashc	$-1,r0
	bic	$0100000,r0
	inc	(sp)
	beq	4f
	ashc	(sp)+,r0
4:	mov	r0,(sp)
	mov	r1,02(sp)
	next
3:	jmp	e.oddz
/-------

/--------------------------------------------------------------
		/ FLOATING POINT INSTRUCTIONS
/--------------------------------------------------------------

adf.s0:	clr	r0;		bisb	(pcx)+,r0; br	   0f
adf.l:	jsr	pc,wrdoff;	br	0f
adf.z:	mov	(sp)+,r0
0:
	jsr	pc,setfloat
	movf	(sp)+,fr0
	addf	(sp)+,fr0
	movf	fr0,-(sp)
	next
/-------

sbf.s0:	clr	r0;		bisb	(pcx)+,r0; br	   0f
sbf.l:	jsr	pc,wrdoff;	br	0f
sbf.z:	mov	(sp)+,r0
0:
	jsr	pc,setfloat
	movf	(sp)+,fr0
	subf	(sp)+,fr0
	negf	fr0
	movf	fr0,-(sp)
	next
/-------

mlf.s0:	clr	r0;		bisb	(pcx)+,r0; br	   0f
mlf.l:	jsr	pc,wrdoff;	br	0f
mlf.z:	mov	(sp)+,r0
0:
	jsr	pc,setfloat
	movf	(sp)+,fr0
	mulf	(sp)+,fr0
	movf	fr0,-(sp)
	next
/-------

dvf.s0:	clr	r0;		bisb	(pcx)+,r0; br	   0f
dvf.l:	jsr	pc,wrdoff;	br	0f
dvf.z:	mov	(sp)+,r0
0:
	jsr	pc,setfloat
	movf	(sp)+,fr0
	movf	(sp)+,fr1
	divf	fr0,r1
	movf	fr1,-(sp)
	next
/-------

ngf.l:	jsr	pc,wrdoff;	br	0f
ngf.z:	mov	(sp)+,r0
0:
	jsr	pc,setfloat
	negf	(sp)
	next
/-------

fif.l:	jsr	pc,wrdoff;	br	0f
fif.z:	mov	(sp)+,r0
0:
	jsr	pc,setfloat
	movf	(sp)+,fr0
	modf	(sp)+,fr0
	movf	fr0,-(sp)
	movf	fr1,-(sp)
	next
/-------

fef.l:	jsr	pc,wrdoff;	br	0f
fef.z:	mov	(sp)+,r0
0:
	jsr	pc,setfloat
	movf	(sp),fr0
	movei	fr0,-(sp)
	movie	$0,fr0
	movf	fr0,02(sp)
	next
/----------------------------------------------------------------------------
/	TEST AND BRANCH	GROUP
/----------------------------------------------------------------------------
tlt.z:	tst	(sp)+; blt     true;   clr     -(sp); next
tle.z:	tst	(sp)+; ble     true;   clr     -(sp); next
teq.z:	tst	(sp)+; beq     true;   clr     -(sp); next
tne.z:	tst	(sp)+; bne     true;   clr     -(sp); next
tge.z:	tst	(sp)+; bge     true;   clr     -(sp); next
tgt.z:	tst	(sp)+; bgt     true;   clr     -(sp); next
/----------------------------------------------------------------------------
zlt.s0:		tst	(sp)+; blt     yesbr2; br      nobr2
zlt.l:		tst	(sp)+; blt     yesbr3; br      nobr3
zle.s0:		tst	(sp)+; ble     yesbr2; br      nobr2
zle.l:		tst	(sp)+; ble     yesbr3; br      nobr3
zeq.s0:		tst	(sp)+; beq     yesbr2; br      nobr2
zeq.s1:		tst	(sp)+; beq     yesbr4; br      nobr2
zeq.l:		tst	(sp)+; beq     yesbr3; br      nobr3
zne.s0:		tst	(sp)+; bne     yesbr2; br      nobr2
zne.l:		tst	(sp)+; bne     yesbr3; br      nobr3
zne.s_1:	tst	(sp)+; bne     yesbr5; br      nobr2
zge.s0:		tst	(sp)+; bge     yesbr2; br      nobr2
zge.l:		tst	(sp)+; bge     yesbr3; br      nobr3
zgt.s0:		tst	(sp)+; bgt     yesbr2; br      nobr2
zgt.l:		tst	(sp)+; bgt     yesbr3; br      nobr3
great:
true:	mov	$1,-(sp)
	next

/------------------------------------------------------------------------------

blt.s0:	cmp	(sp)+,(sp)+;  bgt     yesbr2; br      nobr2
blt.l:	cmp	(sp)+,(sp)+;  bgt     yesbr3; br      nobr3
ble.s0:	cmp	(sp)+,(sp)+;  bge     yesbr2; br      nobr2
ble.l:	cmp	(sp)+,(sp)+;  bge     yesbr3; br      nobr3
beq.l:	cmp	(sp)+,(sp)+;  beq     yesbr3; br      nobr3
beq.s0:	cmp	(sp)+,(sp)+;  beq     yesbr2; br      nobr2
bne.s0:	cmp	(sp)+,(sp)+;  bne     yesbr2; br      nobr2
bne.l:	cmp	(sp)+,(sp)+;  bne     yesbr3; br      nobr3
bge.s0:	cmp	(sp)+,(sp)+;  ble     yesbr2; br      nobr2
bge.l:	cmp	(sp)+,(sp)+;  ble     yesbr3; br      nobr3
bgt.s0:	cmp	(sp)+,(sp)+;  blt     yesbr2; br      nobr2
bgt.l:	cmp	(sp)+,(sp)+;  blt     yesbr3; br      nobr3

bra.s0:	yesbr2:
	clr	r0;
5:	bisb	(pcx)+,r0
1:	add	r0,pcx
	next
bra.l:	yesbr3:
	jsr	pc,wrdoff
	br	1b
bra.s1:		yesbr4:		mov	$400,r0;	br 5b
bra.s_1:	yesbr5:		mov	$-400,r0;	br 5b
bra.s_2:	mov	$-800,r0;	br 5b
nobr2:	tstb	(pcx)+
	next
nobr3:	cmpb	(pcx)+,(pcx)+
	next
/
/------------------------------------------------------------------------------
/	Compare	group
/------------------------------------------------------------------------------

calccomp:	mov	(sp)+,saver1;		/ old pc
		mov	sp,r1;
		add	r0,r1;		mov	r1,r5;
		add	r0,r1;		mov	r1,saver0;   / new sp
		mov	r0,r1;		asr	r1;
2:		cmp	(r5)+,(sp)+;	blt	3f;
		bgt	4f;		dec	r1;
		beq	5f
2:		cmp	(r5)+,(sp)+;	blo	3f;
		bhi	4f;		sob	r1,2b;
5:		mov	saver0,sp;	clr    -(sp);
		br	5f
4:		mov	saver0,sp;	mov	$1,-(sp);
		br	5f
3:		mov	saver0,sp;	mov	$-1,-(sp);
		br	5f
5:		mov	saver1,-(sp);	rts  pc

cmi.1W:		mov	$2,r0;		br	1f
cmi.2W:		mov	$4,r0;		br	1f
cmi.l:		jsr	pc,wrdoff;	br	1f
cmi.z:		mov	(sp)+,r0;
1:		jsr	pc,calccomp;	next
cms.s0:		clr	r0;		bisb	(pcx)+,r0
1:		jsr	pc,calccomp;	tst	(sp)+;
		bne	great;		clr	-(sp);		next
cms.l:		jsr	pc,wrdoff;	br	1b
cms.z:		mov	(sp)+,r0;	br	1b
cmu.l:		jsr	pc,wrdoff;	br	1f
cmu.z:		mov	(sp)+,r0;	br	1f
cmp.z:		mov	$2,r0;
1:		jsr	pc,calccomp;	mov	(sp)+,r1;
		jlo	less;		jhi	great;
		clr	-(sp);		next
cmf.s0:		clr	r0;		bisb	(pcx)+,r0;
1:		cmp	$4,r0;		beq	3f
		cmp	$8,r0;		beq	3f
		jsr	pc,e.oddz;
3:		jsr	pc,setfloat
		movf	(sp)+,fr0;	cmpf	(sp)+,fr0;
4:		cfcc;	jlt	less;	jgt	great;
		clr	-(sp);		next
cmf.l:		jsr	pc,wrdoff;	br	1b
cmf.z:		mov	(sp)+,r0;	br	1b
less:		mov	$-1,-(sp);	next

/------------------------------------------------------------------------------
/------------------------------------------------------------------------------
/------------------------------------------------------------------------------
/	call and return	group
/------------------------------------------------------------------------------
/
/	Frame format on	the stack is:
/
/	| Parameter 1		  |
/	| - - -	- - - -	- - - -	- |
/	| Static link =	param 0	  | < AB
/	|_________________________|	 ____
/	|-------------------------|	     |	P
/	| Saved	line number	  |	     |	R
/	|-------------------------|	     |	O
/	| Saved	file address	  |	     |	C
/	|-------------------------|	     |	F
/	| Return address	  |	     |	R
/	|-------------------------|	     |	A
/	| Dynamic link		  | < LB     |	M
/	|_________________________|	 ____|	E
/	|-------------------------|
/	|			  |
/	| local	variable -1	  |
/	|-------------------------|
/	|			  |
/
/
/	The static link	and the	parameters are set by the
/	calling	procedure; the frame is	set by cal which reserves
/	also the space for local variables.
/------------------------------------------------------------------------------

cal.1:	cal.2:	cal.3:	cal.4:	cal.5:	cal.6:	cal.7:	cal.8:
cal.9:	cal.10:	cal.11:	cal.12:	cal.13:	cal.14:	cal.15:	cal.16:
cal.17:	cal.18:	cal.19:	cal.20:	cal.21:	cal.22:	cal.23:	cal.24:
cal.25:	cal.26:	cal.27:	cal.28:

	asr	r0;		sub	$077,r0;	br  1f
cal.s0:	clr	r0;		bisb	(pcx)+,r0;	br  1f
cai.z:	mov	(sp)+,r0;	br	1f
cal.l:	jsr	pc,wrdoff
lblcal:
1:
	cmp	nprocs,r0
	jlos	e.badpc
1:	asl	r0;		asl	r0;
.if .flow + .count + .prof
	mov	r0,r5;
	asl	r5
	add	r5,r0		/ procdes 12 bytes in this case
.endif
	add	pd,r0;		/ now r0 points	to the bottom
				/ of the proc descriptor
	mov	*eb,-(sp)	/ save line number
	mov	*filb,-(sp)	/ save file address

.if .prof + .count + .flow
	tst	10.(r0)		/ yet a	filename defined in this proc?
	bne	4f		/ yes? continue
	mov	(sp),10.(r0)	/ no? Then take	the old	filename
4:	mov	curproc,(sp)	/ save old procdescriptor
	mov	r0,curproc	/ continue with	the new	one
	mov	4(r0),countfld	/ count	pointer	minus line number
	sub	6(r0),countfld	/ to add at line numbers
.endif
	mov	pcx,-(sp)	/ return address
	mov	r2,-(sp)	/ old local base
	mov	sp,r2		/ new local base
	mov	(r0)+,r1	/ number of bytes for locals
	beq	3f		/ no locals
	inc	r1;	asr  r1	/ make even
2:	mov	$und,-(sp)	/ make undefined
	sob	r1,2b		/ for r1 words local
3:	mov	(r0),pcx	/ em start address
	next			/ ready
/------------------------------------------------------------------------------

ret.l:	jsr	pc,wrdoff;	br	1f
ret.1W:	mov	$2,r0;		br	1f
ret.s0:	clr	r0;		bisb	(pcx)+,r0;
	jlt	e.oddz		/ bad	result size
	beq	ret.0		/ no result
	cmp	$32.,r0;	bge	1f;	jsr	pc,e.badlfr
1:	inc	r0;	asr r0	/ make even
	mov	r0,retsize	/ result size
	mov	$retarea,r1	/ must point to	retarea
2:	mov	(sp)+,(r1)+	/ load result
	sob	r0,2b		/ continue when	there is more
	br	3f
retcount:
ret.0:	clr	retsize		/ no function result
3:	mov	r2,sp		/ set sp to bottom frame
	mov	(sp)+,r2	/ restore (dynamic) local base
	jeq	lblhalt;	/ if zero then main procedure returns
	mov	(sp)+,pcx	/ return address in program counter
	mov	eb,r1		/ must point to	external base
	mov	(sp)+,r0	/ file or procdesbase in r0
.if .count + .flow + .prof
	mov	r0,curproc	/ save procdesbase current proc
	mov	4(r0),countfld	/ restore pointer to
	beq	5f		/ countfield 0 non interesting
	sub	6(r0),countfld	/ table	entries
	mov	countfld,countptr
	add	(sp),countptr
.if .prof
	tst	(sp)
	beq	5f
	mov	countptr,r5
	asl	r5
	asl	r5
	add	ltime,r5
	mov	r5,hiprof
	add	$2,r5
	mov	r5,loprof
.endif
5:
	mov	10.(r0),r0	/ pointer to file name in r0
.endif
retlast:
.if .last
	tst	4(r1)		/ file 0 not stacked
	beq	4f
	cmp	r0,4(r1)	/ same file name?
	beq	4f		/ yes continue
	jsr	pc,nexttab	/ next line table entry	in r5
	clr	(r5)		/ 0 indicates file pointer follows
	jsr	pc,nexttab	/ next entry in	r5
	mov	4(r1),(r5)	/ store	pointer	to file	name
5:	mov	(sp),(r1)	/ restored line	number in *eb
	beq	4f		/ do not put 0 in last table
	jsr	pc,nexttab	/ next entry in	r5
	mov	(sp),(r5)	/ line number in table
4:	cmp	(sp),(r1)	/ line number different?
	bne	5b		/ yes? put it in table
.endif
	mov	r0,4(r1)	/ old file address
	mov	(sp)+,(r1)	/ reset	line number
	next			/ main loop again

lfr.l:	jsr	pc,wrdoff;
8:	bit	$1,r0;		jne	e.illins
	cmp	r0,retsize;	jeq	7f;	jsr	pc,e.badlfr
7:	asr	r0;				 / number of words
	tst	r0;		beq	0f;
	mov	$retarea,r1;	/ must point to	retarea
	add	r0,r1;
	add	r0,r1;		/ top of result
2:	mov	-(r1),-(sp);	/ move word of result
	sob	r0,2b;		/ look for more
0:	next
lfr.1W:	mov	$2,r0;		br	8b
lfr.2W:	mov	$4,r0;		br	8b
lfr.s0:	clr	r0;		bisb	(pcx)+,r0;	br	8b
/
/------------------------------------------------------------------------------

/	miscellaneous
/------------------------------------------------------------------------------
exg.s0:	clr	r0;		bisb	(pcx)+,r0;	br	1f
exg.l:	jsr	pc,wrdoff;	br	1f
exg.z:	mov	(sp)+,r0;
1:	cmp	r0,$1;		beq	0f;
	blt	9f;		bit	$1,r0;
	bne	9f;
	add	r0,sp;
	mov	r0,r1;		asr	r1;
	add	sp,r0;
2:	mov	-(sp),r5;	mov	-(r0),(sp);
	mov	r5,(r0);	sob	r1,2b;
	next
0:	swab	(sp);		next
9:	jsr	pc,e.oddz;	next




/------------------------------------------------------------------------------

dup.1W:		mov	(sp),-(sp);	next
dup.l:		jsr	pc,wrdoff;	br	1f;
dus.l:		jsr	pc,wrdoff;	br	0f;
dus.z:		mov	(sp)+,r0;
0:		ble	9b;		bit	$1,r0;
		bne	9b;		add	r0,sp;
		tst	-(sp);		mov	(sp)+,r0;
1:		ble	9b;		inc	r0;
		bic	$1,r0;		mov	r0,r1;
		mov	sp,r5;		add	r0,r5;
		asr	r1;
2:		mov	-(r5),-(sp);	sob	r1,2b;	     next

nop.z:
	next

/------------------------------------------------------------------------------
fil.l:	jsr	pc,wrdoff;	add	eb,r0
	cmp	r0,*filb;	beq	1f;
.if .last
	clr	*eb			/ new file asks	for new	line
	jsr	pc,nexttab;	clr	(r5);
	jsr	pc,nexttab;	mov	*filb,(r5);
.endif
.if .flow + .count + .prof
	mov	curproc,r1	/ current proc descriptor
	mov	4(r1),countfld
	sub	6(r1),countfld	  / start countptr for this proc
	mov	r0,10.(r1)	/ file pointer in procdes
.endif
	mov	r0,*filb
1:	next
lni.z:	inc	*eb;
.if .count + .flow + .prof
	inc	countptr
.if .prof
	add	$4,hiprof
	add	$4,loprof
.endif
.endif
	br	8f
lin.l:	jsr	pc,wrdoff;	br	1f
lin.s0:	clr	r0;		bisb	(pcx)+,r0
1:	cmp    *eb,r0;	       beq     9f;
	mov    r0,*eb
.if .count + .flow + .prof
	mov	countfld,r5
	add	r0,r5		/ this is the right countptr
	mov	r5,countptr
.if .prof
	asl	r5
	asl	r5
	add	ltime,r5
	mov	r5,hiprof
	add	$2,r5
	mov	r5,loprof
.endif
.endif
8:
.if .last
	jsr	pc,nexttab	/ next entry in	lasttab
	mov	*eb,(r5)	/ set endline
.endif
.if .count
	mov	countptr,r1	     / line number in r1
	asl	r1
	asl	r1		/ multiply by 4
	add	lcount,r1	/ r1 is	pointer	to long	integer	now
	add	$1,2(r1)	/ cannot be inc
	adc	(r1)		/ that was all
.endif
.if .flow
	mov	countptr,r1	     / line number in r1
	clr	r0		/ get ready for	divide
	div	$8.,r0		/ r0 = byte offset; r1 = bit offset
	add	lflow,r0	/ r0 is	byte pointer now
	bisb	bits(r1),(r0)	/ set bit
.endif
9:	next

/------------------------------------------------------------------------------

bls.l:	jsr	pc,wrdoff;	br	0f;
bls.z:	mov	(sp)+,r0;
0:	asr	r0
	bhi	1f
	jbr	e.oddz
1:	mov	(sp)+,r1;	sob	r0,1b;
	mov	r1,r0;		br	1f;
blm.l:	jsr	pc,wrdoff
	tst	r0
	br	1f
blm.s0:	clr	r0;		bisb	(pcx)+,r0
1:	jsr	pc,regsave;	jsr	pc,chckptr
	mov	(sp)+,r2;	jsr	pc,chckptr
	mov	(sp)+,r3
	mov	r0,r1
	asr	r0
	beq	2f	/ Now avoid wrong copy.	The pieces may overlap !
	cmp	r3,r2
	beq	2f
	blt	3f
1:	mov	(r3)+,(r2)+
	sob	r0,1b
2:	jsr	pc,regretu;		next
3:	add	r1,r3;		add	r1,r2;
1:	mov	-(r3),-(r2);	sob	r0,1b;		br    2b
/------------------------------------------------------------------------------
/	Range check and	case instructions
/------------------------------------------------------------------------------
csa.l:	jsr	pc,wrdoff;	br	1f;
csa.z:	mov	(sp)+,r0;
1:	sub	$2,r0;		jne	e.illins;
csa.1W:	mov	(sp)+,r0;
	mov	(sp)+,r1;	sub	2(r0),r1;
	blt	6f;		cmp	4(r0),r1;
	blo	6f;		asl	r1;
	add	$6,r1;		add	r0,r1;
5:	mov	(r1),pcx;
	jeq	e.case;		next
6:	mov	r0,r1;		br	5b;

csb.z:	mov	(sp)+,r0;	br	1f;
csb.l:	jsr	pc,wrdoff;
1:	sub	$2,r0;		jne	e.illins;
csb.1W:	mov	(sp)+,r0;	mov	(sp)+,r1;
	mov	2(r0),r5;	mov	r0,pcx;
					/use pcx as ordinary register
2:	add	$4,r0;		cmp	(r0),r1;
	beq	4f;		sob	r5,2b;
	mov	(pcx),pcx;	jeq	e.case;		next
4:	mov	2(r0),pcx;	jeq	e.case;		next

rck.l:	jsr	pc,wrdoff;	br	1f;
rck.z:	mov	(sp)+,r0;
1:	sub	$2,r0;		beq	rck.1W;
	sub	$2,r0;		jne	e.oddz;
	mov	(sp)+,r1;	cmp	(sp),(r1);
	blt	9f;		cmp	(sp),4(r1);
	bgt	9f;		next
rck.1W:	mov	(sp)+,r1;	cmp	(sp),(r1);
	blt	9f;		cmp	(sp),2(r1);
	bgt	9f;		next
9:	mov	$ERANGE,-(sp);	jmp	trp.z;

/------------------------------------------------------------------------------
/	Load and store register
/------------------------------------------------------------------------------
lbllor:
lor.s0:	clr	r0;		bisb	(pcx)+,r0
	cmp	r0,$2;		jhi	e.illins
	asl	r0;		jmp	1f(r0)
1:	br	2f;	br	3f;	br	4f
2:	mov	lb,-(sp);	next
3:	mov	sp,r1;		mov	r1,-(sp);	next
4:	mov	hp,-(sp);	next
lblstr:
str.s0:	clr	r0;		bisb	(pcx)+,r0
	cmp	r0,$2;		jhi	e.illins
	asl	r0;		jmp	1f(r0)
1:	br	2f;	br	3f;	br	4f
2:	mov	(sp)+,lb;	next
3:	mov	(sp)+,r1;	mov	r1,sp;	next
4:	mov	(sp)+,r1;
5:	cmp	r1,sybreak+2;
	blos	5f;		add	$unixextra,sybreak+2;
	sys	indir;sybreak		/ ask for more core
	jec	5b;
	jsr	pc,e.heap;		   / core claim	failed
5:	cmp	r1,globmax;	jlo	e.heap;
	mov	r1,hp;		next

/------------------------------------------------------------------------------

ass.l:	jsr	pc,wrdoff;	br	1f
ass.z:	mov	(sp)+,r0;
1:	cmp	$2,r0;		beq	2f
	cmp	$4,r0;		jne	e.oddz
	mov	(sp)+,r0;
2:	mov	(sp)+,r0;	br	3f
asp.lw:	jsr	pc,wrdoff;	br	2f
asp.w0:	clr	r0;		bisb	(pcx)+,r0;
2:	asl	r0;		br	3f
asp.1W:		asp.2W:		asp.3W:		asp.4W:		asp.5W:
	sub	$88.,r0;
3:	blt	4f;		add	r0,sp;	next
4:	neg	r0;		asr	r0;
2:	mov	$und,-(sp);	sob	r0,2b;	next


/------------------------------------------------------------------------------

dch.z:	mov	(sp)+,r1;	mov	(r1),-(sp);
	cmp	(sp),ml;	jge	e.badptr;
	next			/ dch adjusts local base to
				/ dynamically previous local base

lpb.z:	add	$8.,(sp);	 next	 / static link 8 bytes from lb

/------------------------------------------------------------------------------

gto.l:	jsr	pc,wrdoff;	/ get descriptor address
	add	eb,r0		/ descriptor is	in external address space
	mov	4(r0),r2;	/ new local base after jump
	mov	2(r0),sp;	/ new stack pointer after jump
	mov	(r0),pcx;	/ new program counter
.if .prof + .flow + .count
	mov	firstp,r0
1:	mov	8.(r0),r1
	cmp	r3,2(r1)
	blos	2f
	mov	r1,r0
	br	1b
2:	mov	r0,curproc	/ procdesbase current proc
	mov	4(r0),countfld	/ restore pointer to
	sub	6(r0),countfld	/ table	entries
	mov	10.(r0),*filb	/ file name restored
.endif
	next
/------------------------------------------------------------------------------
/	Ignore mask
/------------------------------------------------------------------------------

lim.z:	mov	ignmask,-(sp);	next	/ load ignore mask
sim.z:	mov	(sp)+,ignmask;	next	/ store	ignore mask
					/ for trap routines

sig.z:	mov	(sp),r1;		/ exchange previous
	mov	uerrorp,(sp);		/ and stacked error
	mov	r1,uerrorp;		/ procedure pointer
	next
/------------------------------------------------------------------------------
/	Signals	generated by UNIX
/------------------------------------------------------------------------------

sig1:
	mov	$sig.trp+0.,-(sp);	br	1f
sig2:
	mov	$sig.trp+2.,-(sp);	br	1f
sig3:
	mov	$sig.trp+4.,-(sp);	br	1f
sig13:
	mov	$sig.trp+24.,-(sp);	br	1f
sig14:
	mov	$sig.trp+26.,-(sp);	br	1f
sig15:
	mov	$sig.trp+28.,-(sp);	br	1f
sig16:
	mov	$sig.trp+30.,-(sp)	/ push address trap number
1:	mov	*(sp),-2(sp);		/ save trap number
	mov	$-2,*(sp)		/ set defold trap number
	mov	$retutrap,(sp)		/ set return address to	rti
	tst	-(sp)			/ trap number position on stack
	jbr	error

sig12:	mov	r0,-(sp)
	mov	$2,r0;			/ fildes standard error
	sys	0;	9b		/ call write message
	sys	signal;12.;sig12	/ this is a mon-error
	jsr	pc,e.badmon
	mov	(sp)+,r0
	rti

sig11:	mov	r0,saver1	 /save r0
	mov	sybreak+2,r0
	sub	sp,r0
	jgt	e.memflt	/real trap
	mov	$7f,r0
	mov	argv,sp		/setup a new stack
	jbr	rude_error

	.data
7:	<stack overflow\n\0>
	.even
sybreak:sys	break;_end	/For indirect calling of break
	.text
sig8:	mov	r0,saver1;
	sys	signal;8.;sig8
	mov	$ECONV,fpperr+6
	stfps	r0
	bit	$100,r0
	beq	1f
	mov	$ECONV,fpperr+6
1:	stst	r0
	mov	$retutrap,-(sp)
	mov	fpperr(r0),-(sp)
	mov	saver1,r0
	jbr	error
retutrap:	 rti
	.data
fpperr:	EILLINS; EILLINS; EFDIVZ; ECONV; EFOVFL; EFUNFL; EFUND;	EILLINS
	.text
/------------------------------------------------------------------------------
/	Errors,traps and all their friends

/------------------------------------------------------------------------------

savereg:	mov	r1,-(sp)	/ stack	r1 so r1 scratch register
		mov	2(sp),r1	/ now r1 contains return address
		mov	r0,2(sp)	/ save r0
		mov	r2,-(sp)	/ save r2
		mov	r3,-(sp)	/ save r3
		mov	r4,-(sp)	/ save r4
		mov	r5,-(sp)	/ save r5
		mov	12.(sp),r0	/ copy error number or param 0
		movf	fr0,-(sp)	/ save float registers
		movf	fr1,-(sp)	/ fr0 and fr1
		stfps	-(sp)		/ and status
		mov	$retsize+26.,r5
		mov	$13.,r2
8:		mov	-(r5),-(sp);	sob	r2,8b
		mov	r0,-(sp)	/ extra	errno (param 0)	on stack
		mov	r1,-(sp)	/ set return address
		rts	pc

restoreg:	mov	(sp)+,r1	/ return address in r1
		add	$2,sp		/ skip error number (param 0)
		mov	$13.,r2;
		mov	$retsize,r5;
8:		mov	(sp)+,(r5)+;	sob	r2,8b
		ldfps	(sp)+		/ restore floating point status
		movf	(sp)+,fr1	/ restore float	registers
		movf	(sp)+,fr0	/ fr0 and fr1
		mov	(sp)+,r5	/ restore r5
		mov	(sp)+,r4	/ restore r4
		mov	(sp)+,r3	/ restore r3
		mov	(sp)+,r2	/ restore r2
		mov	2(sp),r0	/ restore r0
		mov	r1,2(sp)	/ reset	return address
		mov	(sp)+,r1	/ restore r1
		rts	pc

/------------------------------------------------------------------------------
/	Various	error entries
/------------------------------------------------------------------------------

e.badlfr:	mov	r0,r5;	mov	$2,r0;	mov	$blfr,9f+2
		sys	0;9f;
		mov	r5,r0;	rts	pc
.data
9:		sys	write;7;0;
blfr:		<badlfr\n\0>
.even
.text

e.iund:		mov	$EIUND,-(sp);	       br      error
e.iovfl:	mov	$EIOVFL,-(sp);	       br      error
e.idivz:	mov	$EIDIVZ,-(sp);	       br      error
e.range:	mov	$ERANGE,-(sp);	       br      error
e.set:		mov	$ESET,-(sp);	       br      error
e.badptr:	mov	$EBADPTR,-(sp);	       br      fatal
e.fovfl:	mov	$EFOVFL,-(sp);	       br      error
e.funfl:	mov	$EFUNFL,-(sp);	       br      error
e.fdivz:	mov	$EFDIVZ,-(sp);	       br      error
e.fund:		mov	$EFUND,-(sp);	       br      error
e.conv:		mov	$ECONV,-(sp);	       br      error
e.stack:	mov	$ESTACK,-(sp);	       br      fatal
e.badpc:	mov	$EBADPC,-(sp);	       br      fatal
e.badlin:	mov	$EBADLIN,-(sp);	       br      error
e.badlae:	mov	$EBADLAE,-(sp);	       br      error
e.array:	mov	$EARRAY,-(sp);	       br      error
e.badmon:	mov	$EBADMON,-(sp);	       br      error
e.case:		mov	$ECASE,-(sp);	       br      fatal
e.oddz:		mov	$EODDZ,-(sp);	       br      fatal
e.illins:	mov	$EILLINS,-(sp);	       br      fatal
e.heap:		mov	$EHEAP,-(sp);	       br      fatal
e.memflt:	mov	$EMEMFLT,-(sp);	       br      fatal
e.badgto:	mov	$EBADGTO,-(sp);		br	error
/------------------------------------------------------------------------------

fatal:	mov	$hlt.z,-(sp)	/ return from fatal halts
	mov	2(sp),-(sp)	/ dup error number
error:
	jsr	pc,savereg	/ save old register contents
	cmp	$16.,r0;
	ble	9f;
	mov	$1,r1
	ash	r0,r1
	bic	ignmask,r1
	bne	9f
	jsr	pc,restoreg
	add	$2,sp		/ remove error number from stack
	rts	pc
9:
	cmp	uerrorp,$-1	/ has the user defined a trapprocedure ?
	beq	notrap		/ if not kill it off fast
	mov	uerrorp,-(sp)	/ go for cal
	mov	$-1,uerrorp	/ user must set	trap again
	jbr	precal		/ call trap routine

/------------------------------------------------------------------------------

rtt.z:	mov	r2,sp		/ sp to	bottom frame
	add	$8,sp		/ set to top frame
	jsr	pc,restoreg	/ restore status and registers
	add	$2,sp		/ skip error number
	rts	pc
/------------------------------------------------------------------------------
trp.z:	mov	(sp),-(sp);	/ error	number one down
	mov	r4,2(sp);	/ set return address to	main loop
	jbr	error		/ call error routine

/------------------------------------------------------------------------------

notrap:	mov	(sp),r1		/ error	number
	mov	$num+9.,r0
	mov	r1,retarea	/ set error number for exit status
	jsr	pc,itoa		/ make string
	mov	$num,r0
rude_error:
	mov	r0,8f+4
	mov	*filb,8f	/ pointer to file name
	mov	*eb,r1		/ line number
	mov	$line,8f+6	/ line message
	mov	$line+21.,r0
	jsr	pc,itoa		/ convert to string
1:	mov	$8f,r4
2:	mov	(r4)+,r0	/ next string
	beq	5f
3:	mov	r0,9f+2
4:	tstb	(r0)+		/ find zero byte
	bne	4b
	dec	r0
	sub	9f+2,r0		/ string length
	mov	r0,9f+4
	mov	$2,r0		/ diagnostic output
	sys	0; 9f
	jbr	2b
5:				/ no file
	mov	$-1,argc
	jbr	hlt.z

itoa:	mov	r5,-(sp)
	mov	r0,r5
1:	clr	r0
	div	$10.,r0
	add	$'0,r1
	movb	r1,-(r5)
	mov	r0,r1
	bne	1b
	mov	r5,r0
	mov	(sp)+,r5
	rts	pc

	.data
uerrorp:	-1		/ undefined trap procedure
sep:	<: \0>
line:	< on source line      \n\0>
num:	<error    \0>
	.even
8:	0			/ name of text file
	sep			/ separator
	0			/ error
	line+21.		/ line number if present
	0			/ end of list
lblwri:
9:	sys	write;0;0
	.text
/------------------------------------------------------------------------------
/	Exit instruction, with all it's	crud
/------------------------------------------------------------------------------

hlt.z:
	mov	(sp)+,retarea
.if .count + .flow + .prof
	br	9f
.endif
	bne	9f
	clr	r0
	sys	exit
9:
lblhalt:
	sys	creat;1f;666
.data
1:	<em_runinf\0>
2:	<runinf	file failed\n\0>
.even
.text
	bec	2f
3:	mov	$2b,lblwri+2
	mov	$19.,lblwri+4
	mov	$2.,r0
	sys	indir;lblwri
	br	9f
2:	mov	r0,saver0
	mov	$hp,r1
	mov	r1,ndatad
	mov	$txtsiz,r5
	mov	r5,txtsiz
	sub	r5,r1
	mov	r5,lblwri+2
	mov	r1,lblwri+4
	clr	r1
.if .last
	add	$1,r1
.endif
.if .opfreq
	add	$2,r1
.endif
.if .count
	add	$4,r1
.endif
.if .flow
	add	$8.,r1
.endif
.if .prof
	add	$16.,r1
.endif
	mov	r1,entry.
	sys	indir;lblwri
	bes	3b
	mov	pd,lblwri+2
	mov	tblmax,lblwri+4
	sub	pd,lblwri+4
	mov	saver0,r0
	sys	indir;lblwri
	bes	3b
	mov	ml,lblwri+2
	mov	ml,lblwri+4
	neg	lblwri+4
	mov	saver0,r0
	sys	indir;lblwri
	bes	3b
9:
	mov	retarea,r0	/ set exit status
2:	sys	exit

/------------------------------------------------------------------------------
/	System call interface routine
/------------------------------------------------------------------------------
R0_IN	=	0200
R1_IN	=	0100
R0_OUT	=	040
R1_OUT	=	020
CBIT	=	010

lblmon:
mon.z:
	mov	(sp)+,r0;	/ call number from stack
	cmp	r0,$1		/ sys exit ?
	jeq	hlt.z		/ go there
	bit	$177700,r0;	/ range	0-63?
	bne	mon.bad;	/ no? bad call
	movb	r0,call;	/ move call number in system call
	movb	tab(r0),r5;	/ table	lookup call conditions
	cmp	r5,$-1;		/ compare for special context
	beq	mon.special;	/ yes? jump to special context
monmon:	mov	r5,r4;		/ save call conditions
	rolb	r5		/ R0_IN
	bcc	1f		/ check	if bit 7 is on
	mov	(sp)+,r0;	/ call argument	in r0
1:	rolb	r5		/ R1_IN
	bcc	1f		/ check	if bit 6 is on
	mov	(sp)+,r1;	/ argument in r1
1:	bic	$177770,r4	/ clear	all exept bits	2,1,0
	beq	2f		/ if 0 forget about args
	mov	r3,saver1	/ save r3
	mov	$call+2,r3	/ base of args for call
1:	mov	(sp)+,(r3)+	/ move argument
	sob	r4,1b		/ look for more
	mov	saver1,r3	/ restore r3
2:	sys	indir;call	/ this is it folks
	bcc	1f		/ no error set?	forward
	mov	r0,r4		/ copy error in	r4
1:	rolb	r5		/ R0_OUT
	bcc	1f		/ check	original bit 5
	mov	r0,-(sp)	/ stack	r0 from	errno
1:	rolb	r5		/ R1_OUT
	bcc	1f		/ check	original bit 4
	mov	r1,-(sp)	/ stack	r1
1:	rolb	r5		/ CBIT
	bcc	mon.end		/ no c-bit then	ready
mon.cbit:
	mov	r4,-(sp)	/ stack	errno
	beq	mon.end		/ only once if no error
	mov	r4,-(sp)	/ stack	errno twice when  error
mon.end:
	mov	$loop,r4	/ restore r4
	next			/ ready

mon.special:			/ special calls	decoded	here
	cmp	r0,$fork	/ fork?
	beq	mon.fork
	cmp	r0,$signal	/ signal?
	beq	mon.signal
mon.bad:			/ otherwise undecodable
	mov	saver0,r4	/ restore r4
	jsr	pc,e.badmon	/ mon call error routine
	next

mon.fork:
	clr	r5
	clr	r4
	sys	fork
	inc	r5
	bcc	1f
	mov	r0,r4
1:	mov	r0,-(sp)
	mov	r5,-(sp)
	br	mon.cbit
mon.signal:
msign:
	mov	(sp)+,r1		/ trap number
	mov	(sp)+,r0		/ signal number
	cmp	r0,$16.			/ only 1 - 16 legal
	bhi	sig.bad
	mov	r0,call+2		/ move signal number into call
	beq	sig.bad			/ 0 illegal
	asl	r0			/ make 2-32 and	even
	mov	sig.trp-2(r0),r5	/ previous trap	number
	cmp	r1,$256.		/ values -1 and	-2 special
	bhis	1f
	mov	sig.adr-2(r0),r4	/ zero label means illegal signal
	bne	2f
sig.bad:
	mov	$EINVAL,r4		/ bad signal
	jbr	mon.cbit		/ and continue
1:	cmp	r1,$-3			/ -2: reset default, -3: ignore
	blo	sig.bad
	mov	r1,r4			/ trap number in r4
	inc	r4
	inc	r4			/ -2 ->	0, -3 -> -1
2:	mov	r1,sig.trp-2(r0)	/ new trap number
					/ -3 if	ignored; -2 if default action
	mov	r4,call+4		/ translated trap number in call
	clr	r4
	sys	indir;call
	bcs	sig.bad			/ unlikely to happen
	asr	r0			/ special if old label odd
	bcc	1f
	mov	$-3,r5			/ set ignore signal
1:	mov	r5,-(sp)		/ push trap number
	jbr	mon.cbit


	.data

call:	sys 0;	0;	0;	0;	0
sig.trp:
	-2;	-2;	-2;	-2;	-2;	-2;	-2;	-2
	-2;	-2;	21.;	25.;	 -2;	 -2;	 -2;	 -2
sig.adr:
	sig1;	sig2;	sig3;	0;	0;	0;	0;	sig8
	0;	0;	sig11;	sig12;	sig13;	sig14;	sig15;	sig16

tab:
.if V6
.byte -1					/  0 = indir
.byte -1					/  1 = exit
.byte -1					/  2 = fork
.byte 2		+R0_IN	+R0_OUT		+CBIT	/  3 = read
.byte 2		+R0_IN	+R0_OUT		+CBIT	/  4 = write
.byte 2			+R0_OUT		+CBIT	/  5 = open
.byte 0		+R0_IN			+CBIT	/  6 = close
.byte 0			+R0_OUT	+R1_OUT	+CBIT	/  7 = wait
.byte 2			+R0_OUT		+CBIT	/  8 = creat
.byte 2					+CBIT	/  9 = link
.byte 1					+CBIT	/ 10 = unlink
.byte 2					+CBIT	/ 11 = exec
.byte 1					+CBIT	/ 12 = chdir
.byte 0			+R0_OUT	+R1_OUT		/ 13 = time
.byte 3					+CBIT	/ 14 = mknod
.byte 2					+CBIT	/ 15 = chmod
.byte 2					+CBIT	/ 16 = chown
.byte -1					/ 17 = break
.byte 2					+CBIT	/ 18 = stat
.byte 2		+R0_IN			+CBIT	/ 19 = seek
.byte 0			+R0_OUT			/ 20 = getpid
.byte 3					+CBIT	/ 21 = mount
.byte 1					+CBIT	/ 22 = umount
.byte 0		+R0_IN			+CBIT	/ 23 = setuid
.byte 0			+R0_OUT			/ 24 = getuid
.byte 0	+R1_IN	+R0_IN			+CBIT	/ 25 = stime
.byte 3		+R0_IN	+R0_OUT		+CBIT	/ 26 = ptrace
.byte -1					/ 27 = x
.byte 1		+R0_IN			+CBIT	/ 28 = fstat
.byte -1					/ 29 = x
.byte -1					/ 30 = x
.byte 1		+R0_IN			+CBIT	/ 31 = stty
.byte 1		+R0_IN			+CBIT	/ 32 = gtty
.byte -1					/ 33 = x
.byte 0		+R0_IN			+CBIT	/ 34 = nice
.byte 0		+R0_IN				/ 35 = sleep
.byte 0						/ 36 = sync
.byte 1		+R0_IN			+CBIT	/ 37 = kill
.byte 0			+R0_OUT			/ 38 = csw
.byte -1					/ 39 = x
.byte -1					/ 40 = x
.byte 0		+R0_IN	+R0_OUT		+CBIT	/ 41 = dup
.byte 0			+R0_OUT	+R1_OUT	+CBIT	/ 42 = pipe
.byte 1						/ 43 = times
.byte 4						/ 44 = prof
.byte -1					/ 45 = x
.byte 0		+R0_IN			+CBIT	/ 46 = setgid
.byte 0			+R0_OUT			/ 47 = getgid
.byte -1					/ 48 = signal
.byte -1					/ 49 = reserved	for USG
.byte -1					/ 50 = reserved	for USG
.byte -1					/ 51 = x
.byte -1					/ 52 = x
.byte -1					/ 53 = x
.byte -1					/ 54 = x
.byte -1					/ 55 = x
.byte -1					/ 56 = x
.byte -1					/ 57 = x
.byte -1					/ 58 = x
.byte -1					/ 59 = x
.byte -1					/ 60 = x
.byte -1					/ 61 = x
.byte -1					/ 62 = x
.byte -1					/ 63 = x
.endif

.if VPLUS
.byte -1					/  0 = indir
.byte -1					/  1 = exit
.byte -1					/  2 = fork
.byte 2		+R0_IN	+R0_OUT		+CBIT	/  3 = read
.byte 2		+R0_IN	+R0_OUT		+CBIT	/  4 = write
.byte 2			+R0_OUT		+CBIT	/  5 = open
.byte 0		+R0_IN			+CBIT	/  6 = close
.byte 0			+R0_OUT	+R1_OUT	+CBIT	/  7 = wait
.byte 2			+R0_OUT		+CBIT	/  8 = creat
.byte 2					+CBIT	/  9 = link
.byte 1					+CBIT	/ 10 = unlink
.byte 2					+CBIT	/ 11 = exec
.byte 1					+CBIT	/ 12 = chdir
.byte 0			+R0_OUT	+R1_OUT		/ 13 = time
.byte 3					+CBIT	/ 14 = mknod
.byte 2					+CBIT	/ 15 = chmod
.byte 2					+CBIT	/ 16 = chown
.byte -1					/ 17 = break
.byte 2					+CBIT	/ 18 = stat
.byte 2		+R0_IN			+CBIT	/ 19 = seek
.byte 0			+R0_OUT			/ 20 = getpid
.byte 3					+CBIT	/ 21 = mount
.byte 1					+CBIT	/ 22 = umount
.byte 0		+R0_IN			+CBIT	/ 23 = setuid
.byte 0			+R0_OUT			/ 24 = getuid
.byte 0	+R1_IN	+R0_IN			+CBIT	/ 25 = stime
.byte 3		+R0_IN	+R0_OUT		+CBIT	/ 26 = ptrace
.byte 0		+R0_IN	+R0_OUT			/ 27 = alarm
.byte 1		+R0_IN			+CBIT	/ 28 = fstat
.byte 0						/ 29 = pause
.byte -1					/ 30 = x
.byte 1		+R0_IN			+CBIT	/ 31 = stty
.byte 1		+R0_IN			+CBIT	/ 32 = gtty
.byte 2					+CBIT	/ 33 = access
.byte 0		+R0_IN			+CBIT	/ 34 = nice
.byte 0		+R0_IN				/ 35 = sleep
.byte 0						/ 36 = sync
.byte 1		+R0_IN			+CBIT	/ 37 = kill
.byte 0			+R0_OUT			/ 38 = csw
.byte -1					/ 39 = x
.byte 0		+R0_IN	+R0_OUT	+R1_OUT	+CBIT	/ 40 = tell
.byte 0		+R0_IN	+R0_OUT		+CBIT	/ 41 = dup
.byte 0			+R0_OUT	+R1_OUT	+CBIT	/ 42 = pipe
.byte 1						/ 43 = times
.byte 4						/ 44 = prof
.byte -1					/ 45 = x
.byte 0		+R0_IN			+CBIT	/ 46 = setgid
.byte 0			+R0_OUT			/ 47 = getgid
.byte -1					/ 48 = signal
.byte -1					/ 49 = reserved	for USG
.byte -1					/ 50 = reserved	for USG
.byte 1					+CBIT	/ 51 = acct
.byte -1					/ 52 = x
.byte -1					/ 53 = x
.byte -1					/ 54 = x
.byte -1					/ 55 = x
.byte -1					/ 56 = x
.byte -1					/ 57 = x
.byte -1					/ 58 = x
.byte -1					/ 59 = x
.byte -1					/ 60 = x
.byte -1					/ 61 = x
.byte -1					/ 62 = x
.byte -1					/ 63 = x
.endif

.if V7
.byte -1					/  0 = indir
.byte 0						/  1 = exit
.byte -1					/  2 = fork
.byte 2		+R0_IN	+R0_OUT		+CBIT	/  3 = read
.byte 2		+R0_IN	+R0_OUT		+CBIT	/  4 = write
.byte 2			+R0_OUT		+CBIT	/  5 = open
.byte 0		+R0_IN			+CBIT	/  6 = close
.byte 0			+R0_OUT	+R1_OUT	+CBIT	/  7 = wait
.byte 2			+R0_OUT		+CBIT	/  8 = creat
.byte 2					+CBIT	/  9 = link
.byte 1					+CBIT	/ 10 = unlink
.byte -1					/ 11 = x no exec in em code
.byte 1					+CBIT	/ 12 = chdir
.byte -1					/ 13 = x time is obsolete
.byte 3					+CBIT	/ 14 = mknod
.byte 2					+CBIT	/ 15 = chmod
.byte 3					+CBIT	/ 16 = chown
.byte -1					/ 17 = break
.byte 2					+CBIT	/ 18 = stat
.byte 3		+R0_IN	+R0_OUT	+R1_OUT	+CBIT	/ 19 = lseek
.byte 0			+R0_OUT			/ 20 = getpid
.byte 3					+CBIT	/ 21 = mount
.byte 1					+CBIT	/ 22 = umount
.byte 0		+R0_IN			+CBIT	/ 23 = setuid
.byte 0			+R0_OUT	+R1_OUT		/ 24 = getuid
.byte 0	+R1_IN	+R0_IN			+CBIT	/ 25 = stime
.byte 3		+R0_IN	+R0_OUT		+CBIT	/ 26 = ptrace
.byte 0		+R0_IN	+R0_OUT			/ 27 = alarm
.byte 1		+R0_IN			+CBIT	/ 28 = fstat
.byte 0						/ 29 = pause
.byte 2					+CBIT	/ 30 = utime
.byte -1					/ 31 = x
.byte -1					/ 32 = x
.byte 2					+CBIT	/ 33 = access
.byte 0		+R0_IN			+CBIT	/ 34 = nice
.byte 1						/ 35 = ftime
.byte 0						/ 36 = sync
.byte 1		+R0_IN			+CBIT	/ 37 = kill
.byte -1					/ 38 = x
.byte -1					/ 39 = x
.byte -1					/ 40 = x
.byte 0	+R1_IN	+R0_IN	+R0_OUT		+CBIT	/ 41 = dup
.byte 0			+R0_OUT	+R1_OUT	+CBIT	/ 42 = pipe
.byte 1						/ 43 = times
.byte 4						/ 44 = prof
.byte -1					/ 45 = x
.byte 0		+R0_IN			+CBIT	/ 46 = setgid
.byte 0			+R0_OUT	+R1_OUT		/ 47 = getgid
.byte -1					/ 48 = signal
.byte -1					/ 49 = reserved	for USG
.byte -1					/ 50 = reserved	for USG
.byte 1					+CBIT	/ 51 = acct
.byte 3					+CBIT	/ 52 = phys
.byte 1					+CBIT	/ 53 = lock
.byte 3					+CBIT	/ 54 = ioctl
.byte -1					/ 55 = x
.byte 2					+CBIT	/ 56 = mpxcall
.byte -1					/ 57 = x
.byte -1					/ 58 = x
.byte 3					+CBIT	/ 59 = exece
.byte 1					+CBIT	/ 60 = umask
.byte 1					+CBIT	/ 61 = chroot
.byte -1					/ 62 = x
.byte -1					/ 63 = x
.endif

	.text
/------------------------------------------------------------------------------
/	General	subroutines
/------------------------------------------------------------------------------

wrdoff:	movb	(pcx)+,r0	/get first byte
	swab	r0		/put it	in high	byte
	clrb	r0		/clear low byte	of r0
	bisb	(pcx)+,r0	/"or" second byte in
	rts	pc		/done

/------------------------------------------------------------------------------

tstr0:	cmp	r0,$04;		jgt	e.oddz;
	cmp	r0,$02;		jne	e.oddz;		rts pc

chckptr:			/ this routine traps a pointer outside
				/ the globals, the stack or the	heap
	bit	$1,2(sp);	bne	8f
chckptb:
	mov	2(sp),r5;
	cmp	r5,sp;		bhis	9f
	cmp	r5,hp;		bhis	8f
.if  .count + .prof + .flow
	cmp	r5,tblmax;	bhis	9f
	cmp	r5,globmax;	bhis	8f
.endif
	cmp	r5,eb;		bhis	9f
8:	jsr	pc,e.badptr
9:	rts	pc

.if .last
nexttab: mov	linused,r5;
	add	$2,r5		/ increment lasttab
	cmp	r5,$linused	/ top of table reached?
	blo	1f
	sub	$96.,r5
1:	mov	r5,linused
	rts	pc
.endif
regsave:
	mov	r5,savearea
	mov	$[savearea+2],r5
	mov	r4,(r5)+
	mov	r3,(r5)+
	mov	r2,(r5)
	rts	pc
regretu:
	mov	$[savearea+6],r5
	mov	(r5),r2
	mov	-(r5),r3
	mov	-(r5),r4
	mov	-(r5),r5
	rts	pc

setfloat:
	cmp	r0,$8.
	bne	1f
	setd
	rts	pc
1:	cmp	r0,$04
	bne	3f
	setf
2:	rts	pc
3:	jmp	e.oddz
setint:
	cmp	r0,$04
	bne	4f
	setl
	rts	pc
4:	cmp	r0,$02
	bne	3b
	seti
5:	rts	pc



/------------------------------------------------------------------------------
/	Leftover data
/------------------------------------------------------------------------------




	.bss
filb:	.=.+2
curproc:.=.+2
linmax:	.=.+2
countptr:.=.+2
countfld:.=.+2
hiprof:	.=.+2
loprof:	.=.+2
ignmask:.=.+2		/ ignore mask for trap
retsize:.=.+2		/ size of return value of function
retarea:.=.+8		/ return area for function value
savearea:	.=.+8	/ save register	area
saver0:	.=.+2
saver1:	.=.+2
header:
	txtsiz:	.=.+2	/ program textsize in bytes
	ndatad:	.=.+2	/ number of loadfile descriptors
	nprocs:	.=.+2	/ number of entries in procedure descriptors
option:	entry.:	.=.+2	/ procedure number to start
	nlines:	.=.+2	/ maximum sorceline number
	szdata:	.=.+2	/ address of lowest uninitialized byte
	firstp:	.=.+2	/ descriptor address first basic block of text
	maxcount: .=.+2	/ total	number of processable source lines
argc:	.=.+2
argv:	.=.+2
environ:
	.=.+2
pb:	.=.+2
pd:	.=.+2
eb:	.=.+2
globmax:
	.=.+2
tblmax:	.=.+2
ml:	.=.+2
.if .last
lasttab:.=.+96.	       / 16 descriptors	of integers + index at the end
linused:.=.+2
.endif

.if .opfreq
counttab:
	.=.+1664.
.endif

.if .count
lcount:	.=.+2
countsiz:.=.+2
.endif

.if .flow
lflow:	.=.+2
flowsiz:.=.+2
.endif

.if .prof
ltime:	.=.+2
profsiz:.=.+2
.endif

hp:	.=.+2