/*********************************************************
/******  an ml1 implementation				 *
/******  juli 1975  math. centre			 *
/******    script teus	  				 *
/******    lowl program PJ BROWN			 *
/*********************************************************
/miscellaneous constant and register definitions
	nlrep=12
	sprep=40
	tabrep=11
	qutrep=42
	stopcd=177
	slrep=36
	ffpt=r0
	temapt=r2
	idpt=r3
	lfpt=sp
	_last=r4
	chanpt=r5
	_stcksze=10220.
	_wths= 77777	/add one and you are negative
	
	.data
	.globl	_tstchr
_tstchr:.byte	200,201,202,203,204,205,206,207
	.byte	210,211,212,213,214,215,216,217
	.byte	220,221,222,223,224,225,226,227
	.byte	230,231,232,233,234,235,236,237
	.byte	240,241,242,243,244,245,246,247
	.byte	250,251,252,253,254,255,256,257
	.byte	0+1,1+1,2+1,3+1,4+1,5+1,6+1,7+1
	.byte	9. ,10.,272,273,274,275,276,277
	.byte	300,0  ,0  ,0  ,0  ,0  ,0  ,0  
	.byte	0  ,0  ,0  ,0  ,0  ,0  ,0  ,0  
	.byte	0  ,0  ,0  ,0  ,0  ,0  ,0  ,0  
	.byte	0  ,0  ,0  ,333,334,335,336,337
	.byte	340,0  ,0  ,0  ,0  ,0  ,0  ,0  
	.byte	0  ,0  ,0  ,0  ,0  ,0  ,0  ,0  
	.byte	0  ,0  ,0  ,0  ,0  ,0  ,0  ,0  
	.byte	0  ,0  ,0  ,373,374,375,376,377
	
	/default values of the s-variables
	-1; -1; -1; -1; -1; -1; -1; /_s22 untill _s28
_s21:	0	/controls mainoutput, <0 no output >0 linecount
_s20:	0	/controls output !=0 no output at all
	0;0;0;0;0
_s14:	-1	/ =0 listinput, >0 do linecount
	0
_s12:	0	/column of termination \n is returned
		/==0 no columncontrol
_s11:	1	/startcolumn of input
_s10:	1	/nr of input file
	0;0;0;0;0;0;0;0;0
_s0:	28.	/number of s-variables
	.text
	
	.globl	_runsys	/a routine to run into the ml1
_runsys:
	sys	signal;	11.;	erlso
	mov	sp,_spsave
	mov	r5,_spsave+2
	sub	$100,sp		/take own stacksegment
	mov	sp,_regstr+14	/save it a while
	mov	$_endstack,r4	/forwards stack stop
	mov	$_stack,r0	/forwards stackpointer
	mov	$_s0,svarpt
	tst	_readin
	bne	1f
	jmp	begin

/******  read ml1 data in ************************************

1:	mov	$2,0f+2	/check for right file
	mov	$_regstr,0f
	mov	_readin,r0
	sys	0;	8f
	bec	1f
_ft:	mov	$9f,-(sp)	/give error message
	jsr	pc,_message
	.data
8:	sys	read;	0:..	;..
9:	<error in ml1 def. file\n\0>; .even
	.text
	mov	$1,r0
	sys	exit
1:	cmp	_regstr,$"ml
	jne	_ft
	mov	$ghshtb+112-_regstr,0b+2	/read data segment of ml1 in
	mov	$_regstr,0b
	mov	_readin,r0
	sys	0;	8b
	bes	_ft
	cmp	r0,0b+2		/anough data read?
	bne	_ft
	mov	$24424,0b+2	/read bss segment of ml1 in
				/_endstack-_bssbgn
	mov	$_bssbgn,0b
	mov	_readin,r0
	sys	0;	8b
	bes	_ft
	cmp	r0,0b+2		/anough data read?
	jne	_ft
	mov	_regstr+14,sp	/take new stackpointer
2:	mov	$1000,0b+2	/read the backstack in
	mov	$_bffr,0b
	mov	_readin,r0
	sys	0;	8b
	jes	_ft
	asr	r0
	beq	3f
	mov	$_bffr,r1
4:	mov	(r1)+,-(sp)
	sob	r0,4b
	br	2b
3:	mov	_readin,r0
	sys	close
	mov	$_regstr,r0
	mov	(r0)+,r5
	mov	(r0)+,r4
	mov	(r0)+,r3
	mov	(r0)+,r2
	mov	(r0)+,r1
	mov	(r0),r0
	add	$4,(sp)
	rts	pc		/do exit 2


/******  finish  *********************  end of ml1 *****

	.globl	mdquit
mdquit:	tst	(sp)+
	jsr	pc,_bufflush	/flush first all output
	mov	_spsave,sp	/reset unixregisters
	mov	_spsave+2,r5
	rts	pc		/go back to unix

/****** finish with a ml1-data-dump , called from mdread **********
mdqut:	mov	r0,_regstr+12	/copy first ml1 data to a file
	mov	$_regstr,r0	/save ml1-registers
	mov	r5,(r0)+
	mov	r4,(r0)+
	mov	r3,(r0)+
	mov	r2,(r0)+
	mov	r1,(r0)
	mov	_writin,0f
	sys	0;	9f
	.data
9:	sys	creat;	0:..;	666
	.text
	bec	2f
_ft2:	mov	$9f,-(sp)
	jsr	pc,_message
	.data
9:	<error in ml1 dumpfile\n\0>; .even
	.text
	mov	$1,r0
	sys	exit
2:	mov	r0,_writin
	mov	$"ml,0b
	mov	$0b,1f
	mov	$2,1f+2
	sys	0;	9f
	.data
9:	sys	write;	1:..	;..
	.text
	bes	_ft2
	mov	$ghshtb+112-_regstr,1b+2	/dump data segment of ml1
	mov	$_regstr,1b	
	mov	_writin,r0
	sys	0;	9b
	jes	_ft2
	cmp	r0,1b+2
	jne	_ft2
	mov	$24424,1b+2	/write bss segment
				/_endstack- _bssbgn
	mov	$_bssbgn,1b
	mov	_writin,r0
	sys	0;	9b
	jes	_ft2
	cmp	r0,1b+2
	jne	_ft2
	mov	_regstr+14,r2
6:	mov	$_bffr,r1
	mov	$1000,r0
4:	mov	-(r2),(r1)+
	cmp	sp,r2
	bne	3f
	dec	r0
	br	4f
3:	sob	r0,4b
4:	sub	$1000,r0
	neg	r0
	asl	r0
	mov	r0,1b+2
	mov	$_bffr,1b
	mov	_writin,r0
	sys	0;	9b
	jes	_ft2
	cmp	r0,1b+2
	jne	_ft2
	cmp	sp,r2
	jne	6b	/ready?
	mov	_regstr+12,r0
	mov	_regstr+10,r1
	mov	_regstr+6,r2
	rts	pc
	
	.data
	.globl  _spsave
_spsave: 0; 0; 0; 0; 0; 0; .text

debug:	mov	r1,-(sp)
	mov	(r2)+,r1
	mov	$9f,-(sp)
	jsr	pc,_message
	.data
9:	<\npoint :\0>; .even
	.text
	jsr	pc,prnum
	mov	(sp)+,r1
	rts	r2

	.globl	_goswitch
_goswitch: mov	*(sp),(sp)	/pick value var
	asl	(sp)		/2 * var
	add	(sp)+,(sp)	/dangerous instruction
	mov	*(sp),(sp)
	jmp	*(sp)+		/jump to indirection
	



/******  forward blockmove!  ***********   --  _fmove -- ****

	.globl	_fmove	/perform a forward blockmove
_fmove:	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	srcpt,r2
	mov	dstpt,r3
	movb	(r2)+,(r3)+
	sob	r1,.-2
	mov	(sp)+,r3
	mov	(sp)+,r2
	rts	pc
	

/******  backward blockmove!  *********  --  _bmove --   ****

	.globl	_bmove	/perform a back block move
_bmove:	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	srcpt,r2
	mov	dstpt,r3
	add	r1,r2
	add	r1,r3
	movb	-(r2),-(r3)
	sob	r1,.-2
	mov	(sp)+,r3
	mov	(sp)+,r2
	rts	pc
	


	

/****** hash an atom  ************    --  mdfind  --   *****

	.globl	mdfind	/the hash procedure
	/hashfie: ((*idpt+*spt)*4+idlen)&037 runs 0-31
mdfind:	mov	r2,-(sp)
	mov	r3,-(sp)
	movb	*spt,r2
	movb	*idpt,r3
	add	r3,r2
	asl	r2
	asl	r2
	add	idlen,r2
	asl	r2
	bic	$177700,r2
	add	hashpt,r2
	mov	r2,htabpt
	mov	(sp)+,r3
	mov	(sp)+,r2
	rts	pc
	

/****** convert int to string!  *******  --  mdconv  --  ****

	.globl	mdconv
	/converts meval to a string of digits
mdconv:	mov	r0,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)
	mov	meval,r0
	jsr	pc,_diwrit
	mov	r5,idpt
	mov	r4,idlen
	mov	(sp)+,r5
	mov	(sp)+,r4
	mov	(sp)+,r0
	rts	pc
	
	/converts r0 to string of digits,cloppers r4,r5
	/r4 is set to length of string
	/r5 points to head of the string
_diwrit: clr	_length
	mov	$_pdiwrit+2,_pdiwrit	/temp buffer
	mov	r0,r4
	bpl	2f
	movb	$'-,*_pdiwrit
	inc	_pdiwrit
	neg	r4
2:	mov	r4,r5
	clr	r4
	inc	_length
	div	$10.,r4
	beq	2f
	mov	r5,-(sp)
	br	2b
2:	mov	_length,r4
	mov	r5,-(sp)
3:	mov	(sp)+,r5
	add	$'0,r5
	movb	r5,*_pdiwrit
	inc	_pdiwrit
	sob	r4,3b
	mov	_pdiwrit,r4	/length of string of digits
	mov	$_pdiwrit+2,r5
	sub	r5,r4
	rts	pc
	.data
_length:	0
_pdiwrit:	.=.+16
	.text
	

/******  perform mul or div!    *******  --  mdop  --    ****

	.globl	mdop
	/perform multiplication or division
	/meval=op1*meval or meval=op1/meval
mdop:	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	op1,r1		/set op1 ready
	cmp	opsw,$1		/a multiplication?
	bne	1f
	clc			/be sure c is cleared!
	mul	meval,r1
	bcs	8f		/c set is overflow
	mov	r1,meval
3:	add	$4,4(sp)	/exit 2 no overflow
8:	mov	(sp)+,r1
	mov	(sp)+,r0
	rts	pc
1:	clr	-(sp)
	tst	r1
	sxt	r0		/sign to r0
	bge	2f
	com	(sp)
2:	tst	meval
	bgt	2f
	blt	5f
	tst	(sp)+
	br	8b
5:	com	(sp)
2:	div	meval,r0
	mov	r0,meval
	tst	r1
	beq	4f
	add	(sp),meval
4:	tst	(sp)+
	br	3b
	


/*****   I/O   R O U T I N E S                  ******



/******  do standard output!  **********   --  mderch --  ***

	.globl	mderch	/performs terminal or standard output
mderch:	mov	r1,_out
	mov	r0,-(sp)
	mov	$1,r0
	mov	$_out,3f
	mov	$1,3f+2
	sys	0; 9f
	mov	(sp)+,r0
	rts	pc
	.data
9:	 sys	write; 3:.. ; ..	/syscall write
_out:	0
	.text
	
	.globl	_message	/performs output of string terminated by \0
_message:  mov	r0,-(sp)
	mov	r5,-(sp)
	clr	r0
	mov	6(sp),r5	/pick address of message
	mov	r5,3b
1:	inc	r0		/count the char's
	tstb	(r5)+
	bne	1b
	dec	r0
	mov	r0,3b+2
	mov	$1,r0
	sys	0; 9b
	mov	(sp)+,r5
	mov	(sp)+,r0
	mov	(sp)+,(sp)	/again a dangerous instruction
	rts	pc

/	buffer[i-1]:	r1 points to it
			/0:  filedescriptor
_chrcnt=2		/1:  nrbytes in inbuffer or freebytes outbuffer
_buf=4			/2:  address of buffer
_chr=6			/3:  address of next char for in or out
_size=8.		/4:  buffersize
_colcnt=10.		/5:  columncnter or linecntr for output
	
_bufsze=12.		/number of bytes in one buffer descriptor
	

/******  read a char from a file ! ****  --  mdread  --  ****

	
	/perform a read in r1 via file nr in s10
	.globl	mdread
mdread: mov	r3,-(sp)
	mov	_s10,r3		/get channelinput nr
	bgt	1f		/wrong number?
2:	mov	$0f,-(sp)
	jsr	pc,_message
	.data;0:<\nillegal input channel s\0> ; .even;.text
	mov	r3,r1
	jsr	pc,prnum
	mov	(sp)+,r3
	clr	_error
	mov	$lohalt,(sp)
	rts	pc
1:	cmp	r3,_maxin	/still right number?
	bgt	2b		/no you 're crazy
	dec	r3		/now it is allright
	mul	$_bufsze,r3
	add	_inbuffer,r3	/ _inbuffer= &buffer[0]
	/do now some reading

_reader: dec	_chrcnt(r3)	/update counter
	blt	1f		/yes end of buffer and go for a new
	movb	*_chr(r3),r1	/read a char
	inc	_chr(r3)	/points to next char
	tst	_s14		/do we want inputlisting?
	blt	2f		/no we don't
	jsr	pc,_list	/do list output
2:	tst	_s12		/column control?
	beq	2f
	inc	_colcnt(r3)
	cmp	_colcnt(r3),_s11
	blt	_reader		/skip to right column
	cmpb	r1,$'\n		/end of line?
	bne	3f
	clr	_colcnt(r3)	/if so, zeroise columncounter
2:	mov	(sp)+,r3	/restore r1
	add	$4,(sp)		/exit 2
	rts	pc		/a happy return
3:	cmp	_colcnt(r3),_s12	/ending column
	bge	_reader		/a debug you expect a nl somewhere!******
	br	2b	

/we just go for a new buffer to read in, just follow me
1:	mov	r0,-(sp)	/take a clean r0
	mov	(r3),r0		/get file descriptor
	mov	_buf(r3),4f
	mov	_size(r3),4f+2
	sys	0; 9f
	.data
9:	sys	read		/read it
4:	..; ..			/bufferaddress & charcount
	.text
	jcs	2f		/oh what a shame an error
	tst	r0		/end of file already?
	beq	5f		/yes there is nothing more
	mov	_buf(r3),_chr(r3)	/reset inpointer
	mov	r0,_chrcnt(r3)	/new inputcounter
	mov	(sp)+,r0	/restore r0
	jbr	_reader		/oh boy, now you can get it
5:	inc	_s10		/goto new file
	cmp	_s10,_maxin	/perhaps no more files
	bge	3f		/no more
	mov	(sp)+,r0	/reset r0
	jmp	mdread+2	/do it another time
3:	tst	_writin
	beq	4f
	jsr	pc,mdqut
	jmp	4f
	mov	(sp)+,r0
	jmp	mdread+2
4:	mov	(sp)+,r0	/restore r0
	mov	(sp)+,r3	/eof, restore r1 and do exit 1
	rts	pc
2:	mov	_s10,r1		/the shaming channel
	mov	$0f,-(sp)
	jsr	pc,_message
	.data;0:<\nerror on inputchannel \0>;.even;.text
	jsr	pc,prnum
	clr	_error
	mov	$lohalt,4(sp)
	br	3b
	
	/list the input stream _s14<0 no output (default) >0 linecnt
_list:	mov	r3,-(sp)
	mov	$_listd,r3
	mov	$_s14,_addouch
	jsr	pc,_outchar
	mov	(sp)+,r3
	rts	pc
	.data
_listd:	0;0;0;0;0;0; .text


/*****  write a char to a file ! *****  --  mdouch  --  ****

	
	/perform output _s20 == 0 suppress output
	/_s21... _s28 ==0 output  <0 no output, >0 do linecount
	.globl	mdouch
	.data
_addouch:	0
	/do an actual write of the char via filedesc (r3)
	.text
_outchar:  tst	*_addouch	/do we want a linecount on the channel
	ble	3f
	jsr	pc,_linecnt	/do first perhaps a linecount
3:	 tst	(r3)		/standard output?
	bne	1f
	jsr	pc,mderch
	rts	pc
1:	dec	_chrcnt(r3)	/free bytes?
	bgt	4f
	jsr	pc,_flsh-4	/flush first the buffer
4:	movb	r1,*_chr(r3)	/get byte in buffer
	inc	_chr(r3)	/update pointer
	rts	pc

/buffer has to be flushed, (r3) filedescriptor
	inc	_chrcnt(r3)	/correct freecount
_flsh:	mov	_buf(r3),4f	/set outputbuffer ready
	mov	_size(r3),4f+2	/count	the bytes
	sub	_chrcnt(r3),4f+2 
	inc	4f+2
	mov	r0,-(sp)	/save r0
	mov	(r3),r0		/get filedescriptor
	sys	0; 9f
	.data
9:	sys	write		/go for a write
4:	..; ..			/address and count of outbuffer
	.text
	jcs	1f		/go if an error was born
	mov	(sp)+,r0	/restore r0
	mov	_size(r3),_chrcnt(r3) /restore number of free bytes
	mov	_buf(r3),_chr(r3) /restore next free bytepointer
	rts	pc
1:	mov	$0f,-(sp)
	jsr	pc,_message	/joepie, an error!
	.data;0:<\nerror on outputchannel\n\0>;.even;.text
	clr	_error
	jmp	lohalt
	
	/compute first the address of the filedecriptor
	/and look for wanted output on that channel
mdouch:	tst	_s20
	beq	1f		/yes we wat output
	rts	pc
1:	mov	r4,-(sp)	/save r4
	mov	_maxout,r4	/get number of outfiles
	mov	$_s20,_addouch	/get address of first outswitch
	mov	r3,-(sp)
	mov	_outbuffer,r3
	sub	$_bufsze,r3
3:	sub	$2,_addouch
	add	$_bufsze,r3
	tst	*_addouch
	blt	2f
	jsr	pc,_outchar
2:	sob	r4,3b
	mov	(sp)+,r3
	mov	(sp)+,r4	/restore r4
	rts	pc
	
	/perform flushing of all outputbuffers
_bufflush: mov	r3,-(sp)
	mov	r4,-(sp)
	mov	_maxout,r4
	mov	_outbuffer,r3
	sub	$_bufsze,r3
1:	add	$_bufsze,r3
	tst	(r3)
	beq	4f
	jsr	pc,_flsh
	sob	r4,1b
4:	mov	(sp)+,r4
	mov	(sp)+,r3
	rts	pc
	
	/perform linecount in output file (r3)==fdescriptor
_linecnt: tst	_colcnt(r3)
	blt	1f
	beq	3f
	cmp	r1,$'\n
	beq	.+4
	rts	pc
	com	_colcnt(r3)
	rts	pc
3:	dec	_colcnt(r3)
1:	neg	_colcnt(r3)
	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)
	mov	_colcnt(r3),r0
	jsr	pc,_diwrit
2:	movb	(r5)+,r1
	jsr	pc,_outchar
	sob	r4,2b
	movb	$'\t,r1
	jsr	pc,_outchar
	mov	(sp)+,r5
	mov	(sp)+,r4
	mov	(sp)+,r1
	mov	(sp)+,r0
	rts	pc
	
	.bss
	.globl  _bssbgn
_bssbgn: 	.=.+2
	.data
_regstr: 0;0;0;0;0;0;0;0	/register dump

