;_____________________________________________________________________________
;
; PI calculation test
; It calculates pi-number using the next C-algorithm
; https://crypto.stanford.edu/pbc/notes/pi/code.html
;
; #include <stdio.h>
; #define N 2800
; main() {
;   long r[N + 1], i, k, b, c;
;   c = 0;
;   for (i = 0; i < N; i++)
;      r[i] = 2000;
;   for (k = N; k > 0; k -= 14) {
;      d = 0;
;      i = k;
;      for(;;) {
;        d += r[i]*10000;
;        b = i*2 - 1;
;        r[i] = d % b;
;        d /= b;
;        i--;
;        if (i	== 0) break;
;        d *= i;
;      }
;      printf("%.4d", (int)(c +	d/10000));
;      c = d % 10000;
;   }
; }
;
; the time of the calculation is quadratic, so if T is time to calculate N digits
; then 4*T is required to calculate 2*N digits
;_____________________________________________________________________________
;
; Test configuration values
;
		HMUL	= 1			; hardware multiplication, 0 - no
		HDIV	= 1			; hardware division, 0 - no
		OPT	= 3.			; use 3 if N<=14000, limits R3 to 0x1f'ff'ff'ff
		MAXD	= 1200.			; maximal digits (memory limited)
;_____________________________________________________________________________
;
		.title	pitest			;
		.list	meb			;
						;
		R0	= %0			;
		R1	= %1			;
		R2	= %2			;
		R3	= %3			;
		R4	= %4			;
		R5	= %5			;
		SP	= %6			;
		PC	= %7			;
						;
		RXCSR	= 177560		;
		RXDAT	= 177562		;
		TXCSR	= 177564		;
		TXDAT	= 177566		;
						;
		TXSIZE	= 128.			;
		RXSIZE	= 16.			;
;_____________________________________________________________________________
;
		.macro	.print	ARG		;
		mov	R0,-(SP)		;
		mov	ARG, R0			;
		jsr	PC, print		;
		mov	(SP)+,R0		;
		.endm				;
						;
;_____________________________________________________________________________
;
		.macro	vect, offset, adr, val	;
		.	= offset		;
.if	nb, <adr>				;
		.word	adr			;
.iff						;
		.word	.+2			;
.endc						;
.if	nb, <val>				;
		.word	val			;
.iff						;
		.word	340			;
.endc						;
		.endm				;
;_____________________________________________________________________________
;
		.asect				;
		. = 0				;
						; initial start vector
		vect	0, entry		; for F11 processor
;_____________________________________________________________________________
;
		vect	4			; interrupts 4-376
		vect	10			;
		vect	14			;
		vect	20			;
		vect	24, entry		;
		vect	30			;
		vect	34			;
		vect	40			;
		vect	44			;
		vect	50			;
		vect	54			;
		vect	60, isrrx		; rx console
		vect	64, isrtx		; tx console
		vect	70			;
		vect	74			;
		vect	100, isr50		;
		vect	104			;
		vect	110			;
		vect	114			;
		vect	120			;
		vect	124			;
		vect	130			;
		vect	134			;
		vect	140			;
		vect	144			;
		vect	150			;
		vect	154			;
		vect	160			;
		vect	164			;
		vect	170			;
		vect	174			;
		vect	200			;
		vect	204			;
		vect	210			;
		vect	214			;
		vect	220			;
		vect	224			;
		vect	230			;
		vect	234			;
		vect	240			;
		vect	244			;
		vect	250			;
		vect	254			;
		vect	260			;
		vect	264			;
		vect	270			;
		vect	274			;
		vect	300			;
		vect	304			;
		vect	310			;
		vect	314			;
		vect	320			;
		vect	324			;
		vect	330			;
		vect	334			;
		vect	340			;
		vect	344			;
		vect	350			;
		vect	354			;
		vect	360			;
		vect	364			;
		vect	370			;
		vect	374			;
;_____________________________________________________________________________
;
		.rept	100.			;
		.word	0			;
		.endr				;
$stack		=.				;
						;
$ticks:		.word	0, 0			;
						;
$txbeg:		.word	0			;
$txend:		.word	0			;
$txbuf:		.blkb	TXSIZE			;
		.even				;
						;
$rxbeg:		.word	0			;
$rxend:		.word	0			;
$rxbuf:		.blkb	RXSIZE			;
		.even				;
;_____________________________________________________________________________
;
isr50:		inc	$ticks			; 32-bit ticks counter
		beq	1$			;
		rti				;
1$:		inc	$ticks+2		;
		rti				;
						;
;_____________________________________________________________________________
;
isrrx:		mov	R0, -(SP)		;
		mov	$rxbeg,	R0		;
		movb	@#RXDAT, (R0)+		;
		cmp	R0, #$rxbuf+RXSIZE	;
		blo	1$			;
		mov	#$rxbuf, R0		;
1$:		mov	R0, $rxbeg		;
		mov	(SP)+, R0		;
		rti				;
						;
inkey:		mov	R1, -(SP)		;
		mov	$rxend,	R1		;
		mov	$rxbeg,	R0		;
		sub	R1, R0			;
		bne	1$			;
		mov	(SP)+, R1		;
		sec				;
		rts	PC			;
						;
1$:		movb	(R1)+, R0		;
		cmp	R1, #$rxbuf+RXSIZE	;
		blo	2$			;
		mov	#$rxbuf, R1		;
2$:		mov	R1, $rxend		;
		mov	(SP)+, R1		;
		clc				;
		rts	PC			;
						;
getch:		jsr	PC, inkey		;
		bcs	getch			;
		rts	PC			;
						;
;_____________________________________________________________________________
;
isrtx:		mov	R0, -(SP)		;
		mov	$txend,	R0		;
		cmp	R0, $txbeg		;
		bne	1$			;
		bic	#100, @#TXCSR		;
		mov	(SP)+, R0		;
		rti				;
						;
1$:		movb	(R0)+, @#TXDAT		;
		cmp	R0, #$txbuf+TXSIZE	;
		blo	2$			;
		mov	#$txbuf, R0		;
2$:		mov	R0, $txend		;
		mov	(SP)+, R0		;
		rti				;
						;
putch:						;
;		tstb	@#TXCSR			;
;		bpl	putch			;
;		movb	R0, @#TXDAT		;
;		rts	PC			;
;						;
		mov	R1, -(SP)		;
		mov	$txbeg,	R1		;
		movb	R0, (R1)+		;
		cmp	R1, #$txbuf+TXSIZE	;
		blo	1$			;
		mov	#$txbuf, R1		;
1$:		cmp	R1, $txend		;
		beq	1$			;
		mov	R1, $txbeg		;
		bis	#100, @#TXCSR		;
		mov	(SP)+, R1		;
		rts	PC			;
						;
flush:		cmp	$txbeg,	$txend		;
		bne	flush			;
		rts	PC			;
						;
print:		mov	R1, -(SP)		;
		mov	R0, R1			;
1$:		movb	(R1)+, R0		;
		beq	2$			;
		jsr	PC, putch		;
		br	1$			;
2$:		mov	(SP)+, R1		;
		rts	PC			;
						;
outhex:		mov	R1, -(SP)		;
		mov	R0, -(SP)		;
						;
		bic	#177760, R0		;
		movb	1$(R0),	R1		;
		mov	(SP), R0		;
		asr	R0			;
		asr	R0			;
		asr	R0			;
		asr	R0			;
		bic	#177760, R0		;
		movb	1$(R0),	R0		;
		swab	R0			;
		bis	R0, R1			;
		mov	R1, @#177714		;
						;
		mov	(SP), R0		;
		swab	R0			;
		bic	#177760, R0		;
		movb	1$(R0),	R1		;
		movb	1(SP), R0		;
		asr	R0			;
		asr	R0			;
		asr	R0			;
		asr	R0			;
		bic	#177760, R0		;
		movb	1$(R0),	R0		;
		swab	R0			;
		bis	R0, R1			;
		mov	R1, @#177715		;
						;
		mov	(SP)+, R0		;
		mov	(SP)+, R1		;
		rts	PC			;
						;
1$:		.byte	077, 006, 133, 117	;
		.byte	146, 155, 175, 007	;
		.byte	177, 157, 167, 174	;
		.byte	071, 136, 171, 161	;
						;
;_____________________________________________________________________________
;
entry:		mov	#$stack, SP		;
		mov	#$rxbuf, $rxend		;
		mov	#$rxbuf, $rxbeg		;
		mov	#$txbuf, $txend		;
		mov	#$txbuf, $txbeg		;
						;
		mov	#6161.,	R0		; '1811' logo
		jsr	PC, outhex		;
						;
		mov	#100, @#RXCSR		;
		mov	#000, @#TXCSR		;
		clr	R0			;
		mtps	R0			;
						;
;_____________________________________________________________________________
;
start:		.print	#mes1			;
1$:		jsr	PC, getch		;
		cmp	R0, #'0			;
		bne	2$			;
		jsr	PC, spigot		;
		br	start			;
2$:		jsr	PC, putch		;
		br	1$			;
;_____________________________________________________________________________
;
		.radix	10.			;
		.macro	mul32x16 ?l1 ?l2	; R3:R1*R2 -> R4:R0
.if ne HMUL					;
		mul	R2, R3			;
		mov	R1, R0			;
		mul	R2, R0			;
		bpl	l1			;
						;
		add	R2, R0			;
l1:		add	R3, R0			;
		mov	R0, R4			;
		mov	R1, R0			;
.iff						;
		clr	R0			;
		clr	R4			;
		ror	R2			;
		bcc	l1			;
						;
		mov	R1, R0			;
		mov	R3, R4			;
l1:		asl	R1			;
		rol	R3			;
		asr	R2			;
		bcc	l2			;
						;
		add	R1, R0			;
		adc	R4			;
		add	R3, R4			;
		tst	R2			;
l2:		bne	l1			;
.endc						;
	      .endm				;
						;
						;
		.macro	mul16x16 ?l1 ?l2	; R1*R2 -> R4:R0, R3 is used
.if ne HMUL					;
		mul	R1, R2			;
		mov	R2, R4			;
		mov	R3, R0			;
.iff						;
		clr	R3			;
		mul32x16			;
.endc						;
		.endm				;
						;
;_____________________________________________________________________________
;
		.macro	div0	?l0		;
		asl	R2			;
		rol	R3			;
		cmp	R3, R1			;
		bcs	l0			;
						;
		sub	R1, R3			;
		inc	R2			;
l0:						;
		.endm				;
						;
		.macro div32x16	?div32 ?exit ?l1 ?l2
						; R1:R2 = R3:R2/R1, R3 = R3:R2%R1, used: R0,R4
.if ne HDIV					; may work wrong if R1>$7fff
		mov	R3, R4			;
		inc	R4			;
		asl	R4			; this division implementation is limited
		cmp	R4, R1			; may work wrong if R1>$3fff or R3>$7fff
		bcc	div32			;
						;
		mov	R2, R4			;
		mov	R3, R2			;
		mov	R4, R3			;
		div	R1, R2			;
l1:		clr	R1			;
		br	exit			;
						;
div32:						;
		mov	R2, R4			;
		clr	R2			;
		div	R1, R2			;
						;
		asl	R1			;
		mov	R2, R0			;
		mov	R3, R2			;
		mov	R4, R3			;
		div	R1, R2			;
						;
		asl	R2			;
		asr	R1			;
		cmp	R3, R1			;
		bcs	l2			;
						;
		inc	R2			;
		sub	R1, R3			;
l2:		mov	R0, R1			;
						;
.iff						;
		cmp	R3, R1			;
		bcc	div32			;
						;
		.rept	16.			;
		div0				;
		.endm				;
		clr	R1			;
		jmp	@#exit			;
						;
div32:		mov	R2, R0			;
						;
		.rept	OPT			;
		asl	R3			;
		.endm				;
		mov	R3, R2			;
		clr	R3			;
						;
		.rept	16.-OPT			;
		div0				;
		.endm				;
						;
		mov	R2, R4			;
		mov	R0, R2			;
						;
		.rept	16.			;
		div0				;
		.endm				;
		mov	R4,R1			;
		.endc				;
exit:						;
		.endm				;
;_____________________________________________________________________________
;
div32x16s:	cmp	R3, R1			; R1:R2 = R3:R2/R1, R3 = R3:R2%R1, used: R0,R4
		bcc	32$			; compact form - 64 bytes
						; may work wrong if R1>$7fff
		jsr	PC, 3$			;
		clr	R1			;
		rts	PC			;
						;
32$:		mov	R2, R0			;
		mov	R3, R2			;
		clr	R3			;
		jsr	PC, 3$			;
		mov	R2, R4			;
		mov	R0, R2			;
		jsr	PC, 3$			;
		mov	R4, R1			;
		rts	PC			;
						;
3$:		jsr	PC, @#.+4		;
		jsr	PC, @#.+4		;
		jsr	PC, @#.+4		;
		jsr	PC, @#.+4		;
		asl	R2			;
		rol	R3			;
		cmp	R3, R1			;
		bcs	20$			;
		sub	R1, R3			;
		inc	R2			;
20$:		rts	PC			;
;_____________________________________________________________________________
;
spigot:		.print	#mes2			;
		call	getnum			; R0 - entered number
		add	#3, R0			;
		bic	#3, R0			;
		cmp	R0, #0			;
		bne	71$			;
		mov	#MAXD, R0		;
71$:		cmp	R0, #MAXD		;
		blos	72$			;
		mov	#MAXD, R0		;
						;
72$:		mov	R0, R4			;
		.print	#mes3			;
		mov	R4, R0			;
		call	print4			;
		.print	#eol			;
		.print	#eol			;
						;
		asr	R4			;
		mov	R4, R0			;
		asl	R0			;
		add	R0, R4			;
		asl	R0			;
		add	R0, R4			; R4 <- R4/2*7
		mov	R4, 101$+2		; replace N in opcode
		inc	R4			;
		mov	R4, 100$+2		; replace N in opcode
						;
		mov	$ticks,	$stime		;
100$:		mov	#MAXD+1, R0		; fill r-array
		mov	#2000.,	R1		;
		mov	#ra, R2			;
1$:		mov	R1, (R2)+		;
		sob	R0, 1$			;
						;
		clr	cv			;
101$:		mov	#MAXD, kv		; MAXD replaced by actual N
						;
20$:		clr	dv			; d <- 0
		clr	dv+2			;
		mov	kv, iv			; i <-k
						;
21$:		mov	iv, R0			;
		asl	R0			;
		mov	R0, R5			;
		add	#ra, R0			;
		mov	R0, -(SP)		;
						;
		mov	@R0, R1			; r[i]
		mov	#10000., R2		; r[i]*10000, mul16x16
		mul16x16			;
		add	dv, R0			;
		adc	R4			;
		add	dv+2, R4		;
						;
		dec	R5			; b <- 2*i-1
		mov	R5, R1			;
		mov	R4, R3			;
		mov	R0, R2			;
		div32x16			;
		mov	R3, @(SP)+		; r[i] <- d%b
		mov	R2, dv			; d <- d/b
		mov	R1, dv+2		;
		dec	iv			; i <- i - 1
		beq 4$				;
						;
		mov	R1, R3			;
		mov	R2, R1			;
		mov	iv, R2			;
		mul32x16			;
		mov	R0, dv			; d <- d*i
		mov	R4, dv+2		;
		jmp	21$			;
						;
4$:		mov	R1, R3			;
		mov	#10000., R1		;
		jsr	PC, div32x16s		;
		add	cv, R2			; c + d/10000
		mov	R3, cv			; c <- d%10000
						;
		mov	R2, R0			;
		jsr	PC, print4		;
		sub	#14., kv		; k <- k - 14
		beq	5$			;
		jmp	20$			;
						;
5$:		mov	$ticks,	R2		;
		sub	$stime,	R2		;
		.print	#mes4			;
		mov	R2, R0			;
		jsr	PC, print5		;
		jsr	PC, flush		;
		rts	PC			;
;_____________________________________________________________________________
;
print4:		mov	R3, -(SP)		;
		mov	R2, -(SP)		;
		mov	R0, R2			;
						;
		mov	#1000.,	R3		;
		jsr	PC, 1$			;
		mov	#100., R3		;
		jsr	PC, 1$			;
		mov	#10., R3		;
		jsr	PC, 1$			;
		mov	R2, R0			;
		jsr	PC, 3$			;
						;
		mov	(SP)+, R2		;
		mov	(SP)+, R3		;
		rts	PC			;
						;
1$:		mov	#-1, R0			;
2$:		inc	R0			;
		sub	R3, R2			;
		bcc	2$			;
		add	R3, R2			;
3$:		add	#'0, R0			;
		jmp	putch			;
;_____________________________________________________________________________
;
print5:		mov	R3, -(SP)		;
		mov	R2, -(SP)		;
		mov	R0, R2			;
						;
		mov	#10000., R3		;
		jsr	PC, 1$			;
		mov	#1000.,	R3		;
		jsr	PC, 1$			;
		mov	#100., R3		;
		jsr	PC, 1$			;
		mov	#10., R3		;
		jsr	PC, 1$			;
		mov	R2, R0			;
		jsr	PC, 3$			;
						;
		mov	(SP)+, R2		;
		mov	(SP)+, R3		;
		rts	PC			;
						;
1$:		mov	#-1, R0			;
2$:		inc	R0			;
		sub	R3, R2			;
		bcc	2$			;
		add	R3, R2			;
3$:		add	#'0, R0			;
		jmp	putch			;
;_____________________________________________________________________________
;
getnum:		mov	R3, -(SP)		;
		mov	R2, -(SP)		;
		mov	R1, -(SP)		;
		clr	R1			; length
		clr	R2			; number
						;
1$:		jsr	PC, getch		;
		cmp	#13., R0		;
		beq	3$			;
						;
		cmp	R0, #8.			; backspace
		beq	2$			;
						;
		cmp	R0, #'0			;
		blo	1$			;
		cmp	R0, #'9			;
		bhi	1$			;
		cmp	R1, #4			;
		bhis	1$			;
						;
		mov	R2, -(SP)		;
		inc	R1			;
		jsr	PC, putch		;
		sub	#'0, R0			;
		mov	R2, R3			;
		asl	R3			;
		asl	R3			;
		add	R3, R2			;
		asl	R2			;
		add	R0, R2			;
		br	1$			;
						;
2$:		tst	R1			;
		beq	1$			;
		dec	R1			;
		.print	#del			;
		mov	(SP)+, R2		;
		br	1$			;
						;
3$:		asl	R1			;
		add	R1, SP			;
		mov	R2, R0			;
		mov	(SP)+, R1		;
		mov	(SP)+, R2		;
		mov	(SP)+, R3		;
		rts	PC			;
;_____________________________________________________________________________
;
$stime:		.word	0, 0			;
cv:		.word	0			;
dv:		.word	0, 0			;
iv:		.word	0			;
kv:		.word	0			;
ra:		.blkw	MAXD/2*7+1		;
;_____________________________________________________________________________
;
		.radix	8.
del:		.asciz	<10><40><10>
eol:		.asciz	<15><12>
mes1:		.asciz	<15><12>"Press zero to start PI calculation.."<12><15>
mes2:		.asciz	<15><12>"Enter the number of PI-digits fo calculate: "
mes3:		.asciz	<15><12>"PI digits will be printed: "
mes4:		.asciz	<15><12>"System ticks (50Hz) elapsed: "
;_____________________________________________________________________________
;
		.even
		.end