ack/mach/mantra/int/mloop0

	.define	filb
	.define _m_a_i_n
	.define curproc
	.define	pd
	.define	nproc
	.define	retarea
	.define	retsize
	.define hp
	.define maxcount
	.define firstp
	.define globmax
	.define tblmax
	.define ml
	.define argc
	.define topstack
#ifndef FPTRAP
	.define __fptrp
#endif
.sect .text
.sect .rom
.sect .data
.sect .bss
.sect .text
!---------------------------------------------------------------------------
!		START OF THE PROGRAM
!---------------------------------------------------------------------------

_m_a_i_n:
#ifdef __BSD4_2
		jsr	getmask
#endif
		move.l	sp,d0
		add.l	#0x10000,d0		! rough guess. What is the
						! real top ???
		move.l	d0,topstack
		tst.l	(sp)+
		lea	retarea,a5		!a5 POINTS AT RETURN AREA
		move.l	nd,-(sp)		!nd contains endbss
		bsr	_Xbreak
		add.l	wrd,sp
#if	last
		move.l	#126,d0			!initialise lasttable
		lea	lasttable,a1
0:		clr.l	(a1)+
		dbra	d0,0b
		move.l	#-1,(a1)
		move.l	#linused-8,linused
#endif
		move.l	4(sp),a2
		move.l	(a2),filb	!interpreter name in filb
		sub.l	#1,(sp)
		bgt	0f
	.sect .data
emfile:	.asciz	"e.out"
	.align 2
	.sect .text
		move.l	4(sp),a0	!4(sp) is argv
		move.l	#emfile,(a0)	!pointer to e.out in argp1
		add.l	#1,(sp)		!only 1 argument in this case
		bra	1f
0:		add.l	#4,4(sp)	!skip name of interpreter
1:		add.l	#4-word,sp
		move.l	sp,ml
		move.l	word(sp),a2
		cl	-(sp)
		move.l	(a2),-(sp)
		lea	eb,a6
		bsr	_Xopen
		testen	(sp)+
		bne	nofile
		mov	(sp)+,savefd
		move.l	(a2),filb	!load file name in filb
					!information about file for error mess.
		move.l	#16,-(sp) ;	pea	header
		mov	savefd,-(sp)			!skip first header
		bsr	_Xread	;	testen	(sp)+
		bne	badarg1
		move.l	#32,(sp)
		pea	header
		mov	savefd,-(sp)
		bsr	_Xread	
		testen	(sp)+
		bne	badarg1
		cmp.l	#32,(sp)+
		bne	badarg1
		lea	header,a0
		move.l	#5,d0			!convert em integer to integer
0:		add.l	#4,a5
		move.b	(a0)+,-(a5) ;	move.b	(a0)+,-(a5)
		move.b	(a0)+,-(a5) ;	move.b	(a0)+,-(a5)
		move.l	(a5),-4(a0) ;	dbra	d0,0b
		move.l	nd,a0	;	move.l	a0,pb	!Bottom emtext
		add.l	ntext,a0 ;	move.l	a0,pd	!proc. descr. base
		move.l	nproc,d1 ;	asl.l	#3,d1	!2 pointers
#if	count + prof + flow
		mulu	#3,d1				!or 6 pointers
#endif
		add.l	d1,a0	;	move.l	a0,eb	!external base
		add.l	szdata,a0 ;	move.l	a0,tblmax
		move.l	a0,globmax ;	move.l	a0,hp
		add.l	#2000,a0 ;	move.l	a0,-(sp)
		bsr	_Xbreak				!ask for core
		testen	(sp)+	;	bne	toolarge
		move.l	eb,a6	;	move.l	filb,4(a6)
		move.l	ntext,-(sp) 
		move.l	pb,-(sp)
		mov	savefd,-(sp)
		bsr	_Xread
		testen	(sp)+	;	bne	badarg
		add.l	#4,sp
#if	float
! PM
#endif

lblbuf:		sub.l	#2048,sp
		claimstack
		move.l	sp,a4				!transport  ptr a4
		move.l	sp,a1
		move.l	a1,-(sp)
		move.l	#2048,-(sp) ;	move.l	a4,-(sp)
		mov	savefd,-(sp) ;	bsr	_Xread
		testen	(sp)+	;	bne	badarg
		move.l	(sp)+,d0
		move.l	(sp)+,a1
		cmp.l	#2048,d0 ;	bcs	0f
		add.l	#1024,a1 ;	bra	1f	!a1 =buffer middle
0:		add.l	d0,a1				!a1 = buffer end
1:		move.l	eb,a3		!At a3 filling has to start
		clr.l	d1	;	clr.l	d2
		move.l	#datswi,a6

datloop:	cmp.l	a4,a1	;	bhi	9f	!Go on filling data
		bsr	blshift		!shift block down , read next block
9:		sub.l	#1,ndata ;	blt	finito
		clr.l	d1
		move.b	(a4)+,d1 ;	beq	dat0	!type byte in d1
		move.l	a3,a2	;	move.b	(a4)+,d2  !count byte in d2
		asl.l	#2,d1	;	move.l	-4(a6,d1),a0
		jmp	(a0)

	.sect .data
datswi:	.data4	dat1;	.data4	dat2;	.data4	dat3;	.data4	dat4
	.data4	dat5;	.data4	dat6;	.data4	dat6;	.data4	dofloat
	.sect .text

dat0:		add.l	#4,a5
		move.b	(a4)+,-(a5) ;	move.b	(a4)+,-(a5)
		move.b	(a4)+,-(a5) ;	move.b	(a4)+,-(a5)
		move.l	(a5),d0 ;	move.l	a3,d4	!d0 =count
		sub.l	a2,d4	!reconstruct byte count of previous describtor
		sub.l	#1,d0	;	sub.l	#1,d4
1:		move.l	d4,d3
2:		move.b	(a2)+,(a3)+ ;	dbra	d3,2b
		dbra	d0,1b	;	bra 	datloop

dat1:		mov	und,(a3)+ ;	sub.b	#1,d2
		bne	dat1	;	bra	datloop

dat2:		move.b	(a4)+,(a3)+ ;	sub.b	#1,d2
		bne	dat2	;	bra	datloop

dat3:		move.w	wrd,d1	;	add.l	d1,a3		!wrd = 2 or 4
3:		move.b	(a4)+,-(a3) ;	sub.b	#1,d1	;	bgt 3b
		add.l	wrd,a3	;	sub.b	#1,d2
		bne	dat3	;	bra	datloop

dat4:		move.l	eb,d4	;	bra	4f
dat5:		move.l	pb,d4
4:		add.l	#4,a3
		move.b	(a4)+,-(a3) ;	move.b	(a4)+,-(a3)
		move.b	(a4)+,-(a3) ;	move.b	(a4)+,-(a3)
		add.l	d4,(a3)+ ;	sub.b	#1,d2
		bne	4b	;	bra	datloop

dat6:		add.l	d2,a3	;	move.l	d2,d3
6:		move.b	(a4)+,-(a3) ;	sub.b	#1,d2
		bne	6b	;	add.l	d3,a3
		bra	datloop

.sect .data
flt_label:	.data4 0
.sect .text
dofloat:
		move.l	d2,d0
		checkfsize
4:
8:
		movem.l	a0/a1/d0-d2,-(sp)
		move.l	a3,-(sp)
		add.l	d0,a3
		move.l	d0,-(sp)
		move.l	a4,-(sp)
		move.l	a4,flt_label
		bsr	_con_float
		lea	12(sp),sp
		clr.l	flt_label
		movem.l	(sp)+,a0/a1/d0-d2
1:
		tst.b	(a4)+ ;		bne	1b
		bra	datloop

#ifdef FLTRAP
!DUMMY ASCII TO FLOAT ROUTINE
_con_float:
		rts
#else
__fptrp:
		tst.l	flt_label
		beq	1f
		rts
1:
		move.l	4(sp),d0
		mov	d0,-(sp)
		bra	error
#endif
blshift:	move.l	a1,a0	;	move.l	#1024,d0
		move.l	d1,-(sp)
		tst.l	-(sp)
		sub.l	d0,a0	;	move.l	d0,-(sp)
		sub.l	d0,a4			!update pointer
		asr.l	#2,d0
0:		move.l	(a1)+,(a0)+ ;	sub.w	#1,d0
		bgt	0b	;	move.l	a0,a1
		move.l	a1,4(sp)
		move.l	a1,-(sp) ;	mov	savefd,-(sp)
		bsr	_Xread
		testen	(sp)+	;	bne	badarg
		move.l	(sp)+,d0
		move.l	(sp)+,a1
		move.l	(sp)+,d1
		cmp.l	#1024,d0 ;	beq	1f
		add.l	d0,a1
1:		rts

finito:		cmp.l	hp,a3	;	bne	badarg	!load file error
		move.l	eb,a6				!eb IN a6 NOW
		lea	4(a6),a0			!filb CONTAINS eb+4
		move.l	a0,filb

!WE START TO READ THE PROCEDURE DESCRIPTORS

		move.l	nproc,d1 ;	move.l	pd,a3
		asl.l	#3,d1			!proc. descr. is 8 bytes
4:		move.l	a1,d2	;	sub.l	a4,d2	!What is available?
		add.l	#7,d2	;	and.w	#-0x8,d2  !multiple of 8!
		sub.l	d2,d1				!subtract what can 
		asr.l	#3,d2				!be read. divide by 8
		sub.l	#1,d2
2:		add.l	#4,a3
		move.b	(a4)+,-(a3) ;	move.b	(a4)+,-(a3)
		move.b	(a4)+,-(a3) ;	move.b	(a4)+,-(a3)
		add.l	#8,a3
		move.b	(a4)+,-(a3) ;	move.b	(a4)+,-(a3)
		move.b	(a4)+,-(a3) ;	move.b	(a4)+,-(a3)
		move.l	pb,d0 ;	add.l	d0,(a3)+  !em address to machine address

#if	count+prof+flow
		clr.l	(a3)+
		clr.l	(a3)+
		clr.l	(a3)+
		clr.l	(a3)+
#endif
		dbra	d2,2b	;	tst.l	d1
		ble	3f	;	bsr	blshift		!more or ready
		bra	4b
3:		cmp.l	eb,a3	;	bne	badarg
		move.l	savefd,-(sp) ;	bsr	_Xclose
		move.l	ml,sp				!refresh stack

#if	count+prof+flow
!						|=======================|
! Here we fill the fields in the procedure	|   current file name	|
! descriptor with table information. The	|-----------------------|
! procedure descriptor has six fields,		|   link to next proc	|
! like described in this picture. We		|-----------------------|
! construct a linked list of the procedure	|   first line number	|
! descriptors, such that the defined		|-----------------------|
! order of procedures is compatible		|    count pointer	|
! with the text order. Thereafter we		|-----------------------|
! scan the text for line information to		|    start address	|
! fill the count pointer and startline		|-----------------------|
! field. The link to the first procedure	|  bytes for locals	|
! 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.

! Register use: a6 is external base ("eb"), a5 points at return area, other
! registers are free

makelink:	move.l	pd,a0
		move.l	#0,a2
		move.l	a0,a3		!a3 will point at the first proc.
		move.l	a0,a4		!a4 will point at proc descr base
0:		move.l	a0,a1		!keep former descr pointer in a1
		add.l	#24,a0		!a0 points at next one
		cmp.l	a0,a6		!top of descriptor space
		bls	4f		!yes? ready!
1:		move.l	4(a0),d0	!start address of current proc in d0
		cmp.l	4(a1),d0	!compair start address with previous
		bcc	2f		!d0 large? follow link!
		sub.l	#24,a1		!d0 small? compair with previous
		cmp.l	a1,a4		!is a1 smaller than pd
		bls	1b		!no? try again
		move.l	a3,16(a0)	!yes? then smallest text add up to now
		move.l	a0,a3		!remind a3 is to point at first proc
		bra	0b		!next descriptor
2:		move.l	16(a1),d1	!follow the link to find place
		beq	3f		!if 0 then no link defined
		move.l	d1,a2
		cmp.l	4(a2),d0	!compair start address
		bcs	3f		!start addr between those of a1 and a2
		move.l	a2,a1		!d0 above start address of a1
		bra	2b		!go on looking
3:		move.l	a0,16(a1)	!a0 follows a1
		move.l	d1,16(a0)	!a2 follows a0
		bra	0b
4:		move.l	a3,firstp	!firstp links to first procedure

! Register use: a3 points at first procedure , d0 opcode byte , a1 base of
! table , d1 keeps min line nr , d2 keeps max line nr , d3 current line nr ,
! maxcount in d4

procinf:	move.l	#1,maxcount	!count pointer for first procedure
		move.l	#1,d4
		move.l	#0,d3
		move.l	#0,d0
0:		move.l	a3,-(sp)	!stack current procedure
		move.l	#-1,d1		!minimal line number on 0xFFFFFFFF
		move.l	#0,d2		!maximal line number on 0
		tst.l	16(a3)		!bottom address next procedure
		beq	6f		!if 0 last procedure
		move.l	16(a3),a4
		move.l	4(a4),a4	!a4 points at top of current proc
		bra	2f
6:		move.l	pd,a4
2:		move.l	4(a3),a3	!start address of current procedure
8:		move.b	(a3)+,d0	!start scanning
		cmp.b	#-2,d0	
		beq	1f		!case escape1
		cmp.b	#-1,d0	
		beq	6f		!case escape2
		cmp.b	#-106,d0
		bhi	7f		!ordinary skip at 7
		beq	2f		!case lni at 2
		cmp.b	#-108,d0		!lin_l ?
		bcs	7f		!ordinary skip at 7
		beq	3f		!lin_l at 3
		move.l	#0,d3
		move.b	(a3)+,d3	!lin_s0 here
		bra	4f		!compare at 4
2:		add.l	#1,d3
		bra	4f
3:		adroff
		move.l	#0,d3
		move.w	(a5),d3
		bra	4f
6:		move.b	(a3)+,d0
		cmp.b	#35,d0		!lin_q ?
		bne	6f		!skip for escape2 at 6f
		move.b	(a3)+,(a5)+
		move.b	(a3)+,(a5)+
		move.b	(a3)+,(a5)+
		move.b	(a3)+,(a5)
		sub.l	#3,a5
		move.l	(a5),d3
4:		cmp.l	d1,d3		!d3 less than minimum ?
		bcc	5f
		move.l	d3,d1
5:		cmp.l	d3,d2		!d3 more than maximum ?
		bcc	9f
		move.l	d3,d2
		bra	9f
6:		add.l	#4,a3
		bra	9f
1:		move.b	(a3)+,d0
		move.l	d0,a2		!escape1 opcodes treated here
		add.l	#256,a2		!second	table
		bra	1f
7:		move.l	d0,a2
1:		move.b	skipdisp(a2),d0	!look for argument size
		add.l	d0,a3
9:		cmp.l	a3,a4		!still more text
		bhi 	8b
		move.l	(sp)+,a3	!bottom back
		sub.l	d1,d2		!compute number of lines
		bcs	9f		!no line so no information
		move.l	d4,8(a3)
		move.l	d1,12(a3)
		add.l	#1,d2
		add.l	d2,d4		!this is the new maxcount
		move.l	d4,maxcount
9:		tst.l	16(a3)		!follow link to next procedure
		beq	1f
		move.l	16(a3),a3
		bra	0b
1:
countlabel:

	.sect .data
skipdisp:
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 1; .data1 0; .data1 0; .data1 2; .data1 0;
.data1 0; .data1 1; .data1 1; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 1; .data1 2; .data1 1; .data1 1; .data1 1; .data1 1;
.data1 1; .data1 1; .data1 1; .data1 2; .data1 1; .data1 1; .data1 1; .data1 1;

.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 1; .data1 0; .data1 0; .data1 0;
.data1 1; .data1 0; .data1 0; .data1 0; .data1 1; .data1 0; .data1 0; .data1 0;
.data1 1; .data1 1; .data1 0; .data1 1; .data1 0; .data1 2; .data1 0; .data1 2;
.data1 1; .data1 0; .data1 0; .data1 0; .data1 1; .data1 1; .data1 0; .data1 1;
.data1 2; .data1 1; .data1 1; .data1 1; .data1 1; .data1 1; .data1 1; .data1 1;

.data1 2; .data1 2; .data1 0; .data1 0; .data1 1; .data1 1; .data1 1; .data1 0;
.data1 0; .data1 2; .data1 1; .data1 0; .data1 1; .data1 0; .data1 0; .data1 1;
.data1 1; .data1 1; .data1 0; .data1 0; .data1 2; .data1 1; .data1 0; .data1 2;
.data1 0; .data1 1; .data1 1; .data1 2; .data1 1; .data1 1; .data1 1; .data1 1;
.data1 1; .data1 2; .data1 0; .data1 0; .data1 0; .data1 0; .data1 1; .data1 2;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 1; .data1 2; .data1 2;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 1; .data1 1; .data1 0; .data1 0;

.data1 0; .data1 1; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 1;
.data1 0; .data1 0; .data1 1; .data1 0; .data1 0; .data1 1; .data1 1; .data1 1;
.data1 1; .data1 0; .data1 2; .data1 1; .data1 1; .data1 1; .data1 2; .data1 0;
.data1 0; .data1 1; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 1;
.data1 2; .data1 2; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 1; .data1 0; .data1 0; .data1 0; .data1 0; .data1 2; .data1 1;
.data1 1; .data1 1; .data1 1; .data1 1; .data1 1; .data1 1; .data1 1; .data1 1;
.data1 2; .data1 1; .data1 0; .data1 0; .data1 1; .data1 2; .data1 7; .data1 5;

!escaped opcodes

.data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0;
.data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 2; .data1 0; .data1 2;
.data1 2; .data1 2; .data1 2; .data1 2; .data1 0; .data1 2; .data1 2; .data1 0;
.data1 2; .data1 0; .data1 0; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0;
.data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0;
.data1 2; .data1 0; .data1 0; .data1 0; .data1 0; .data1 2; .data1 2; .data1 2;
.data1 2; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2;
.data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 2; .data1 2;

.data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 2; .data1 2;
.data1 2; .data1 2; .data1 2; .data1 2; .data1 0; .data1 2; .data1 0; .data1 1;
.data1 2; .data1 2; .data1 2; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2;
.data1 0; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 0; .data1 2;
.data1 0; .data1 2; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0;
.data1 2; .data1 0; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2;
.data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 2; .data1 2;
.data1 2; .data1 2; .data1 0; .data1 0; .data1 2; .data1 2; .data1 0; .data1 2;

.data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2;
.data1 2; .data1 0; .data1 1; .data1 0; .data1 0; .data1 0; .data1 2; .data1 0;
.data1 2; .data1 0; .data1 2; .data1 2; .data1 2; .data1 2; .data1 2; .data1 2;
.data1 0; .data1 2; .data1 0; .data1 1; .data1 2; .data1 0; .data1 0; .data1 2;

	.sect .text
		move.l	globmax,d1
		move.l	d1,a3
#if prof
		move.l	d1,ltime
		move.l	d1,profile	!PROFILE POINTER FOR CURRENT PROC
		move.l	maxcount,d0
		add.l	#1,d0
		asl.l	#2,d0		!4 BYTES FOR EACH LINE
		add.l	d0,d1
		move.l	d0,profsiz	!profsiz CONTAINS NEEDED MEM SIZE
#endif
#if flow
		move.l	d1,lflow
		move.l	maxcount,d0
		asr.l	#3,d0		!divide by 8
		add.l	#2,d0
		bclr	#0,d0		!make integer number of words (2 byte!)
		add.l	d0,d1
		move.l	d0,flowsiz
#endif
#if count
		move.l	d1,lcount
		move.l	maxcount,d0
		add.l	#1,d0
		asl.l	#2,d0
		add.l	d0,d1
		move.l	d0,countsiz
#endif
		move.l	d1,tblmax
		add.l	#1024,d1
		cmp.l	nd,d1
		bcs	2f
		move.l	d1,-(sp)
		bsr	_Xbreak
		testen	(sp)+
		bne	toolarge
2:		sub.l	a3,d1
		asr.l	wmu,d1
3:		cl	(a3)+
		dbra	d1,3b
		sub.l	#1024,a3
		move.l	a3,hp
cfp:		move.l	ml,sp		!LABEL FOR DEBUGGING

#endif

!----------------------------------------------------------------------------
!		START CALLING SEQUENCE HERE
!-----------------------------------------------------------------------------

		lea	loop,a4
		move.l	pb,a3
		move.l	#0,a2
		move.l	wmu-1,d7
		clr.l	d6
lblsp:		move.l	entry,-(sp)		!start procedure to call
		bra	cai_z


nofile:		mov	#0xD,d0 ;	bra	notrap1
badarg:		move.l	eb,a6
badarg1:	mov	#0xE,d0 ;	bra	notrap1
toolarge:	mov	#0xF,d0 ;	bra	notrap1
	.sect .data
retsize: .space	2
retarea: .space 32


	.sect .bss
argc:	.space	4
argv:	.space	4
envp:	.space	4
savefd:	.space	4
header:
ntext:	.space	4
ndata:	.space	4
nproc:	.space	4
entry:	.space	4
nline:	.space	4
szdata:	.space	4
firstp:	.space	4
maxcount:  .space 4

tblmax:	.space	4
globmax: .space	4
topstack: .space 4
ml:	.space	4
eb:	.space	4		!EXPLICITELY REQUIRED eb, filb, curproc IN
filb:	.space	4		!THIS ORDER
curproc: .space 4
pb:	.space	4
pd:	.space	4
hp:	.space	4


	.sect .text