Optimizing the 68020+ 32-bit math

[ross]

Originally Posted by ross

-10 bytes to 562, -12 to 560 with your -2 to pad file

Argh!, this can fail on <020+ because [LN_NAME] can be misaligned..

[Don_Adan]

Why not?

	lea	LibList(a5),a6
.d	movea.l	(a6),a6
	movea.l	LN_NAME(a6),a1
	cmpi.b	#"d",(a1)
	bne.b	.d

[ross]

Originally Posted by Don_Adan

Why not?

	lea	LibList(a5),a6
.d	movea.l	(a6),a6
	movea.l	LN_NAME(a6),a1
	cmpi.b	#"d",(a1)
	bne.b	.d

Too risky. There may be many libraries starting with "d" .. but for sure only one starting with "dos.".

Alternative: (this can go down to 568 with -2 from a/b, and maybe a2 could be used for something because final state is know)

;***************************************************************

; N = 7*D, D = digits, e.g. N = 700 for 100 digits

; user settings
PRINT_DIGITS		= 1
ALT_PRINT		= 1	; shorter but marginally slower print
HACKS			= 0	; use undocumented OS stuff

; exec
OldOpenLibrary		= -408
CloseLibrary		= -414
Forbid			= -132
;Permit			= -138
AddIntServer		= -168
RemIntServer		= -174
VBlankFrequency 	= 530
INTB_VERTB		= 5	; vblank interrupt
NT_INTERRUPT		= 2	; node type
LibList	= $17a
LN_NAME	= $a

; dos
Input			= -54
Output			= -60
Read			= -42
Write			= -48

;***************************************************************

start
; Construct interrupt struct on stack while a0 still points to
; cmdline (valid string ptr!) and use that as a name.
	lea	time(PC),A3
	lea	rasterint(PC),A4
	movem.l	a0/a3/a4,-(SP)		; ln_Name, is_Data, is_Code
	move.w #NT_INTERRUPT<<8+0,-(SP) ; ln_Type, ln_Pri
	subq.l #2*4,SP			; ln_Succ, ln_Pred (set by exec)

	move.l	4.w,a5
	IFEQ	HACKS
	lea	LibList(a5),a6
.d	lea	dos(pc),a2
	moveq	#4-1,d0
	movea.l	(a6),a6
	movea.l	LN_NAME(a6),a1
.0	cmpm.b	(a2)+,(a1)+
	dbne	d0,.0
	bne.b	.d
;	move.l	a5,a6			; use exec
;	lea	dosname(pc),a1		; open dos library
;	jsr	OldOpenLibrary(a6)
;	move.l d0,a6			; use dos
	ELSE
	lea	-$148(a2),a6		; dos library
	ENDIF	; HACKS

	jsr	Output(a6)		; get stdout
	move.l	d0,-(A3)		; a3 = cout

	move.w	#((65536-(workspace-start))/7)&(~3),D7	; maxD (multiple of 4)
	moveq	#10,D4			; global const
	subq.l	#rasterint-writetext,a4	; a4 = writetext

         moveq #msg1-cout,D2		; must be checked if in moveq range
         moveq #msg1end-msg1,d3
	jsr	(a4)			; writetext

	bsr.w	getnum			; returns D in d1 and d2
	addq.w	#3,d1
	and.w	#~3,d1			; adjust D to a multiple of 4
	moveq	#7,d6
	mulu.w	d1,d6			; k = N = 7*D
         cmp.b (a0),d4			; last char is newline (1-4 digits)?
         bne.b .adjusted
         cmp.w d2,d1
         beq.b .not_adjusted
.adjusted
         bsr.w PR0000			; either 5 digits or adjusted D
         moveq #msg4-cout,D2
         moveq #msg4end-msg4,d3
	jsr	(a4)			; writetext
.not_adjusted

        exg a5,a6			; use exec
        jsr Forbid(a6)
        moveq #INTB_VERTB,d0
        move.l SP,A1
        jsr AddIntServer(a6)
        exg a5,a6			; use dos
 
;*** TIMED PART START ******************************************

	lea	workspace(pc),a4
	move.w	#10000,d5

	move.l	#2000<<16+2000,d0
	move.l	a4,a0
	move.l	d6,d7
.fill	move.l	d0,(a0)+
	subq.w	#4,d7
	bne.b	.fill

; outer+inner loop:
;	d3 upper word must initially be and remain 0
; 	d7 must initially be 0 (c = 0)
; d0=*, d1=d, d2=b, d3=tmp, d4=10, d5=10000, d6=k, d7=c
; a0=*, a1=*, a2=--, a4=r[]

.outer_loop
	moveq	#0,d1			; d = 0
	add.l	d6,a4			; &r[i]
	move.w	d6,d2
	subq.w	#1,d2			; b = k-1
	bra.b	.inner_entry

.longdiv
	swap	d0
	move.w	d0,d3
	divu.w	d2,d3
	swap	d3
	move.w	d3,d0
	swap	d0
	divu.w	d2,d0

	move.w	d0,d3
	clr.w	d0
	swap	d0
	move.w	d0,(a4)			; r[i] = d%b

	subq.w	#2,d2			; b -= 2
	bcs.b	.inner_done

	exg	d0,d3			; keep d3 upper word clear

.inner_loop
	sub.l	d0,d1			; d = (d-d/b-d%b)/2
	sub.l	d3,d1			; same as d *= i
	lsr.l	#1,d1
.inner_entry
	move.w	-(a4),d0		; r[i]
	mulu.w	d5,d0
	add.l	d0,d1			; d += r[i]*10000
	move.l	d1,d0
	divu.w	d2,d0			; d/b
	bvs.b	.longdiv

	move.w	d0,d3			; d/b
	clr.w	d0
	swap	d0			; d%b
	move.w	d0,(a4)			; r[i] = d%b

	subq.w	#2,d2			; b -= 2
	bcc.b	.inner_loop

.inner_done
	divu.w	d5,d1			; d/10000
	add.w	d7,d1			; d = c+d/10000 (to be printed out)
	move.l	d1,d7
	swap	d7			; c = d%10000
	IFNE	PRINT_DIGITS		; must keep d3 upper word clear
	bsr.b	PR0000
	ELSE
	moveq	#0,d3
	ENDIF

	sub.w	#7*4,d6			; k -= 7*4 (size > speed)
	bne.b	.outer_loop

;*** TIMED PART END ********************************************

	movem.l	(a3)+,d1/d7		; last use of cout and time
	move.l	a3,d2			; buffer

	move.b	VBlankFrequency(a5),d6	; d6 must be 0
	move.l	d6,d0
	add.w	d0,d0
	divu.w	d0,d7			; d7 = seconds
	move.l	d7,d3
	swap	d3
	mulu.w	#100,d3
	add.l	d3,d6			; round up (+0.5)
	divu.w	d0,d6			; d6 = 1/100ths

	move.b	#' ',(a3)+

	moveq	#0,d3			; skip leading zeroes
	bsr.b	SPrintTime		; d5 is already set to 10000

	move.b	#'.',(a3)+

	moveq	#'0',d3			; print leading zeroes
	move.w	d6,d7
	moveq	#10,d5
	bsr.b	SPrintTime

	move.b	d4,(a3)+		; newline

	move.l	a3,d3
	sub.l	d2,d3
	jsr	Write(a6)

        exg a5,a6			; use exec
        moveq #INTB_VERTB,d0
        move.l SP,A1
        lea     22(SP),SP		; restore stack (is_Size)
;		moveq	#0,d0
        jmp RemIntServer(a6)

;	IFEQ	HACKS
;	move.l	a5,a1
;	jmp	CloseLibrary(a6)	; close dos
;	ELSE
;	rts
;	ENDIF

	; END OF PROGRAM (exec will re-enable multitasking)

;***************************************************************

SPrintTime	; d7=value, a3=buffer
.Next	ext.l	d7
	divu.w	d5,d7
	cmp.b	d3,d7
	beq.b	.LeadZero
	moveq	#'0',d3
	add.b	d3,d7
	move.b	d7,(a3)+
.LeadZero
	swap	d7
	divu.w	d4,d5
	bne.b	.Next
	rts

	IFNE	ALT_PRINT

PR0000		; d1=value
	subq.l	#cout-dec_convert,a3
	move.l	#$2f2f2f30,d0
	moveq	#$01,d2
	move.w	(a3)+,d3
.Loop	ror.l	#8,d2
.Digit	add.l	d2,d0
	sub.w	d3,d1
	bcc.b	.Digit
	add.w	d3,d1
	move.w	(a3)+,d3
	bne.b	.Loop
	add.b	d1,d0

	ELSE

PR0000	; prints d1, uses a0,a1(scratch),d0,d1,d2,d3
        move.w	#$0100,a0
	move.l	#$2f3a2f2f,d0
	move.w	#1000,d2
.d1000	add.w	a0,d0
	sub.w	d2,d1
	bcc.b	.d1000
	add.w	d2,d1

	moveq	#100,d2
.d100	addq.b	#1,d0
	sub.w	d2,d1
	bcc.b	.d100
	add.w	d2,d1

	swap	d0
.d10	add.w	a0,d0
	sub.w	d4,d1
	bcc.b	.d10
	add.b	d1,d0

	ENDIF	; ALT_PRINT

        move.l D0,buf-cout(A3)
        moveq #buf-cout,D2
        moveq #4,D3
writetext
        move.l (A3),D1			; cout
        add.l  A3,D2			; offset to buffer address
        jmp Write(A6) 			; call Write(stdout,buffer,size)

; If interrupt priority is >= 10 then a0 must be set to $dff000 on exit
rasterint
	addq.l	#2,(a1)			; a1 = is_Data (time)
	moveq	#0,d0 			; must set Z flag on exit!
	rts

dos		dc.b "dos."

;***************************************************************

	CNOP	0,4

	IFNE	ALT_PRINT
dec_convert				; must be right before cout
	DC.W	1000,100,10,0
	ENDIF

cout	dc.l 0
time	dc.l 0
buf	ds.b 4

;***************************************************************
; Overwritten code/data starts here. 
workspace

msg1	dc.b 'number pi calculator v16',10	; odd length
msg1end
msg2	dc.b 'number of digits (up to '		; even length
msg2end
msg3	dc.b ')? '				; odd length
msg3end
msg4	dc.b ' digits will be printed',10	; even length
msg4end
	even

getnum
.error	moveq #msg2-cout,D2
        moveq #msg2end-msg2,d3
	jsr	(a4)			; writetext
        move.w d7,d1
        bsr.w PR0000
        moveq #msg3-cout,D2
        moveq #msg3end-msg3,d3
	jsr	(a4)			; writetext
        jsr Input(a6)			; get stdin
        move.l d0,d1
        moveq #msg1-cout,D2
        add.l A3,D2
        moveq #4+1,d3			; 4 digits + newline
        jsr Read(a6)

        move.l	d2,a0
	moveq	#0,d2
.loop	subq.w	#1,d0
	beq.b	.done
	move.w	#256-'0',d6
	add.b	(a0)+,d6
	cmp.w	d4,d6			; digit 0-9?
	bhs.b	.error
	mulu.w	d4,d2
	add.w	d6,d2			; D = D*10+digit
	bra.b	.loop
.done
	cmp.w d7,d2			; D > maxD?
	bhi.b .error
	move.w d2,d1			; D = 0?
	beq.b .error
	rts

;	IFEQ	HACKS
;dosname	dc.b "dos.library",0
;	ENDIF

Buffy	dx.b 65536-(Buffy-start)

;***************************************************************

; asm-one&co
;	PRINTV	Buffy-start+36		; 36 = hunk overhead
;	PRINTV	((65536-(workspace-start))/7)&(~3)

;***************************************************************

[a/b]

2 bytes needed? jsr Write(a6) in the time printing part can be replaced with a bsr.b to jmp Write(a6) in PR00000, it's within 128 bytes.
That's the 2 bytes save I mentioned earlier.

As for the "hacks", yeah there is probably more that could be done but it's just not my cup of tea. I'll just wait until you are done with that and copy/paste it with if/endif.

There are more libs that start with a "d" (diskfont, datatypes, ...), but I'd guess dos is always before the rest in the list, so hack successful?

PS: Thread too fast for my tired hands. Yeah, currently a2 is still unused, super very tiny speed opt possible (Don), but it'd be better served elsewhere and there's nothing I see at the momemt.

[Don_Adan]

Originally Posted by ross

Too risky. There may be many libraries starting with "d" .. but for sure only one starting with "dos.".

Alternative: (this can go down to 568 with -2 from a/b, and maybe a2 could be used for something because final state is know)

;***************************************************************

; N = 7*D, D = digits, e.g. N = 700 for 100 digits

; user settings
PRINT_DIGITS		= 1
ALT_PRINT		= 1	; shorter but marginally slower print
HACKS			= 0	; use undocumented OS stuff

; exec
OldOpenLibrary		= -408
CloseLibrary		= -414
Forbid			= -132
;Permit			= -138
AddIntServer		= -168
RemIntServer		= -174
VBlankFrequency 	= 530
INTB_VERTB		= 5	; vblank interrupt
NT_INTERRUPT		= 2	; node type
LibList	= $17a
LN_NAME	= $a

; dos
Input			= -54
Output			= -60
Read			= -42
Write			= -48

;***************************************************************

start
; Construct interrupt struct on stack while a0 still points to
; cmdline (valid string ptr!) and use that as a name.
	lea	time(PC),A3
	lea	rasterint(PC),A4
	movem.l	a0/a3/a4,-(SP)		; ln_Name, is_Data, is_Code
	move.w #NT_INTERRUPT<<8+0,-(SP) ; ln_Type, ln_Pri
	subq.l #2*4,SP			; ln_Succ, ln_Pred (set by exec)

	move.l	4.w,a5
	IFEQ	HACKS
	lea	LibList(a5),a6
.d	lea	dos(pc),a2
	moveq	#4-1,d0
	movea.l	(a6),a6
	movea.l	LN_NAME(a6),a1
.0	cmpm.b	(a2)+,(a1)+
	dbne	d0,.0
	bne.b	.d
;	move.l	a5,a6			; use exec
;	lea	dosname(pc),a1		; open dos library
;	jsr	OldOpenLibrary(a6)
;	move.l d0,a6			; use dos
	ELSE
	lea	-$148(a2),a6		; dos library
	ENDIF	; HACKS

	jsr	Output(a6)		; get stdout
	move.l	d0,-(A3)		; a3 = cout

	move.w	#((65536-(workspace-start))/7)&(~3),D7	; maxD (multiple of 4)
	moveq	#10,D4			; global const
	subq.l	#rasterint-writetext,a4	; a4 = writetext

         moveq #msg1-cout,D2		; must be checked if in moveq range
         moveq #msg1end-msg1,d3
	jsr	(a4)			; writetext

	bsr.w	getnum			; returns D in d1 and d2
	addq.w	#3,d1
	and.w	#~3,d1			; adjust D to a multiple of 4
	moveq	#7,d6
	mulu.w	d1,d6			; k = N = 7*D
         cmp.b (a0),d4			; last char is newline (1-4 digits)?
         bne.b .adjusted
         cmp.w d2,d1
         beq.b .not_adjusted
.adjusted
         bsr.w PR0000			; either 5 digits or adjusted D
         moveq #msg4-cout,D2
         moveq #msg4end-msg4,d3
	jsr	(a4)			; writetext
.not_adjusted

        exg a5,a6			; use exec
        jsr Forbid(a6)
        moveq #INTB_VERTB,d0
        move.l SP,A1
        jsr AddIntServer(a6)
        exg a5,a6			; use dos
 
;*** TIMED PART START ******************************************

	lea	workspace(pc),a4
	move.w	#10000,d5

	move.l	#2000<<16+2000,d0
	move.l	a4,a0
	move.l	d6,d7
.fill	move.l	d0,(a0)+
	subq.w	#4,d7
	bne.b	.fill

; outer+inner loop:
;	d3 upper word must initially be and remain 0
; 	d7 must initially be 0 (c = 0)
; d0=*, d1=d, d2=b, d3=tmp, d4=10, d5=10000, d6=k, d7=c
; a0=*, a1=*, a2=--, a4=r[]

.outer_loop
	moveq	#0,d1			; d = 0
	add.l	d6,a4			; &r[i]
	move.w	d6,d2
	subq.w	#1,d2			; b = k-1
	bra.b	.inner_entry

.longdiv
	swap	d0
	move.w	d0,d3
	divu.w	d2,d3
	swap	d3
	move.w	d3,d0
	swap	d0
	divu.w	d2,d0

	move.w	d0,d3
	clr.w	d0
	swap	d0
	move.w	d0,(a4)			; r[i] = d%b

	subq.w	#2,d2			; b -= 2
	bcs.b	.inner_done

	exg	d0,d3			; keep d3 upper word clear

.inner_loop
	sub.l	d0,d1			; d = (d-d/b-d%b)/2
	sub.l	d3,d1			; same as d *= i
	lsr.l	#1,d1
.inner_entry
	move.w	-(a4),d0		; r[i]
	mulu.w	d5,d0
	add.l	d0,d1			; d += r[i]*10000
	move.l	d1,d0
	divu.w	d2,d0			; d/b
	bvs.b	.longdiv

	move.w	d0,d3			; d/b
	clr.w	d0
	swap	d0			; d%b
	move.w	d0,(a4)			; r[i] = d%b

	subq.w	#2,d2			; b -= 2
	bcc.b	.inner_loop

.inner_done
	divu.w	d5,d1			; d/10000
	add.w	d7,d1			; d = c+d/10000 (to be printed out)
	move.l	d1,d7
	swap	d7			; c = d%10000
	IFNE	PRINT_DIGITS		; must keep d3 upper word clear
	bsr.b	PR0000
	ELSE
	moveq	#0,d3
	ENDIF

	sub.w	#7*4,d6			; k -= 7*4 (size > speed)
	bne.b	.outer_loop

;*** TIMED PART END ********************************************

	movem.l	(a3)+,d1/d7		; last use of cout and time
	move.l	a3,d2			; buffer

	move.b	VBlankFrequency(a5),d6	; d6 must be 0
	move.l	d6,d0
	add.w	d0,d0
	divu.w	d0,d7			; d7 = seconds
	move.l	d7,d3
	swap	d3
	mulu.w	#100,d3
	add.l	d3,d6			; round up (+0.5)
	divu.w	d0,d6			; d6 = 1/100ths

	move.b	#' ',(a3)+

	moveq	#0,d3			; skip leading zeroes
	bsr.b	SPrintTime		; d5 is already set to 10000

	move.b	#'.',(a3)+

	moveq	#'0',d3			; print leading zeroes
	move.w	d6,d7
	moveq	#10,d5
	bsr.b	SPrintTime

	move.b	d4,(a3)+		; newline

	move.l	a3,d3
	sub.l	d2,d3
	jsr	Write(a6)

        exg a5,a6			; use exec
        moveq #INTB_VERTB,d0
        move.l SP,A1
        lea     22(SP),SP		; restore stack (is_Size)
;		moveq	#0,d0
        jmp RemIntServer(a6)

;	IFEQ	HACKS
;	move.l	a5,a1
;	jmp	CloseLibrary(a6)	; close dos
;	ELSE
;	rts
;	ENDIF

	; END OF PROGRAM (exec will re-enable multitasking)

;***************************************************************

SPrintTime	; d7=value, a3=buffer
.Next	ext.l	d7
	divu.w	d5,d7
	cmp.b	d3,d7
	beq.b	.LeadZero
	moveq	#'0',d3
	add.b	d3,d7
	move.b	d7,(a3)+
.LeadZero
	swap	d7
	divu.w	d4,d5
	bne.b	.Next
	rts

	IFNE	ALT_PRINT

PR0000		; d1=value
	subq.l	#cout-dec_convert,a3
	move.l	#$2f2f2f30,d0
	moveq	#$01,d2
	move.w	(a3)+,d3
.Loop	ror.l	#8,d2
.Digit	add.l	d2,d0
	sub.w	d3,d1
	bcc.b	.Digit
	add.w	d3,d1
	move.w	(a3)+,d3
	bne.b	.Loop
	add.b	d1,d0

	ELSE

PR0000	; prints d1, uses a0,a1(scratch),d0,d1,d2,d3
        move.w	#$0100,a0
	move.l	#$2f3a2f2f,d0
	move.w	#1000,d2
.d1000	add.w	a0,d0
	sub.w	d2,d1
	bcc.b	.d1000
	add.w	d2,d1

	moveq	#100,d2
.d100	addq.b	#1,d0
	sub.w	d2,d1
	bcc.b	.d100
	add.w	d2,d1

	swap	d0
.d10	add.w	a0,d0
	sub.w	d4,d1
	bcc.b	.d10
	add.b	d1,d0

	ENDIF	; ALT_PRINT

        move.l D0,buf-cout(A3)
        moveq #buf-cout,D2
        moveq #4,D3
writetext
        move.l (A3),D1			; cout
        add.l  A3,D2			; offset to buffer address
        jmp Write(A6) 			; call Write(stdout,buffer,size)

; If interrupt priority is >= 10 then a0 must be set to $dff000 on exit
rasterint
	addq.l	#2,(a1)			; a1 = is_Data (time)
	moveq	#0,d0 			; must set Z flag on exit!
	rts

dos		dc.b "dos."

;***************************************************************

	CNOP	0,4

	IFNE	ALT_PRINT
dec_convert				; must be right before cout
	DC.W	1000,100,10,0
	ENDIF

cout	dc.l 0
time	dc.l 0
buf	ds.b 4

;***************************************************************
; Overwritten code/data starts here. 
workspace

msg1	dc.b 'number pi calculator v16',10	; odd length
msg1end
msg2	dc.b 'number of digits (up to '		; even length
msg2end
msg3	dc.b ')? '				; odd length
msg3end
msg4	dc.b ' digits will be printed',10	; even length
msg4end
	even

getnum
.error	moveq #msg2-cout,D2
        moveq #msg2end-msg2,d3
	jsr	(a4)			; writetext
        move.w d7,d1
        bsr.w PR0000
        moveq #msg3-cout,D2
        moveq #msg3end-msg3,d3
	jsr	(a4)			; writetext
        jsr Input(a6)			; get stdin
        move.l d0,d1
        moveq #msg1-cout,D2
        add.l A3,D2
        moveq #4+1,d3			; 4 digits + newline
        jsr Read(a6)

        move.l	d2,a0
	moveq	#0,d2
.loop	subq.w	#1,d0
	beq.b	.done
	move.w	#256-'0',d6
	add.b	(a0)+,d6
	cmp.w	d4,d6			; digit 0-9?
	bhs.b	.error
	mulu.w	d4,d2
	add.w	d6,d2			; D = D*10+digit
	bra.b	.loop
.done
	cmp.w d7,d2			; D > maxD?
	bhi.b .error
	move.w d2,d1			; D = 0?
	beq.b .error
	rts

;	IFEQ	HACKS
;dosname	dc.b "dos.library",0
;	ENDIF

Buffy	dx.b 65536-(Buffy-start)

;***************************************************************

; asm-one&co
;	PRINTV	Buffy-start+36		; 36 = hunk overhead
;	PRINTV	((65536-(workspace-start))/7)&(~3)

;***************************************************************

Maybe risky, but i dont think. dos.library can not be closed and must be opened as one of first libraries. this is dependent how is created LibList.

[ross]

Originally Posted by a/b

2 bytes needed? jsr Write(a6) in the time printing part can be replaced with a bsr.b to jmp Write(a6) in PR00000, it's within 128 bytes.
That's the 2 bytes save I mentioned earlier.

As for the "hacks", yeah there is probably more that could be done but it's just not my cup of tea. I'll just wait until you are done with that and copy/paste it with if/endif.

There are more libs that start with a "d" (diskfont, datatypes, ...), but I'd guess dos is always before the rest in the list, so hack successful?

PS: Thread too fast for my tired hands. Yeah, currently a2 is still unused, super very tiny speed opt possible (Don), but it'd be better served elsewhere and there's nothing I see at the momemt.

Ok, 568 bytes version.

Too scared to move

dos dc.b "dos."

elsewhere for a2 usage (or other ax setup), I do not know the code

;***************************************************************

; N = 7*D, D = digits, e.g. N = 700 for 100 digits

; user settings
PRINT_DIGITS		= 1
ALT_PRINT		= 1	; shorter but marginally slower print
HACKS			= 0	; use undocumented OS stuff

; exec
OldOpenLibrary		= -408
CloseLibrary		= -414
Forbid			= -132
;Permit			= -138
AddIntServer		= -168
RemIntServer		= -174
VBlankFrequency 	= 530
INTB_VERTB		= 5	; vblank interrupt
NT_INTERRUPT		= 2	; node type
LibList	= $17a
LN_NAME	= $a

; dos
Input			= -54
Output			= -60
Read			= -42
Write			= -48

;***************************************************************

start
; Construct interrupt struct on stack while a0 still points to
; cmdline (valid string ptr!) and use that as a name.
	lea	time(PC),A3
	lea	rasterint(PC),A4
	movem.l	a0/a3/a4,-(SP)		; ln_Name, is_Data, is_Code
	move.w #NT_INTERRUPT<<8+0,-(SP) ; ln_Type, ln_Pri
	subq.l #2*4,SP			; ln_Succ, ln_Pred (set by exec)

	move.l	4.w,a5
	IFEQ	HACKS
	lea	LibList(a5),a6
.d	lea	dos(pc),a2
	moveq	#4-1,d0
	movea.l	(a6),a6
	movea.l	LN_NAME(a6),a1
.0	cmpm.b	(a2)+,(a1)+
	dbne	d0,.0
	bne.b	.d
;	move.l	a5,a6			; use exec
;	lea	dosname(pc),a1		; open dos library
;	jsr	OldOpenLibrary(a6)
;	move.l d0,a6			; use dos
	ELSE
	lea	-$148(a2),a6		; dos library
	ENDIF	; HACKS

	jsr	Output(a6)		; get stdout
	move.l	d0,-(A3)		; a3 = cout

	move.w	#((65536-(workspace-start))/7)&(~3),D7	; maxD (multiple of 4)
	moveq	#10,D4			; global const
	subq.l	#rasterint-writetext,a4	; a4 = writetext

         moveq #msg1-cout,D2		; must be checked if in moveq range
         moveq #msg1end-msg1,d3
	jsr	(a4)			; writetext

	bsr.w	getnum			; returns D in d1 and d2
	addq.w	#3,d1
	and.w	#~3,d1			; adjust D to a multiple of 4
	moveq	#7,d6
	mulu.w	d1,d6			; k = N = 7*D
         cmp.b (a0),d4			; last char is newline (1-4 digits)?
         bne.b .adjusted
         cmp.w d2,d1
         beq.b .not_adjusted
.adjusted
         bsr.w PR0000			; either 5 digits or adjusted D
         moveq #msg4-cout,D2
         moveq #msg4end-msg4,d3
	jsr	(a4)			; writetext
.not_adjusted

        exg a5,a6			; use exec
        jsr Forbid(a6)
        moveq #INTB_VERTB,d0
        move.l SP,A1
        jsr AddIntServer(a6)
        exg a5,a6			; use dos
 
;*** TIMED PART START ******************************************

	lea	workspace(pc),a4
	move.w	#10000,d5

	move.l	#2000<<16+2000,d0
	move.l	a4,a0
	move.l	d6,d7
.fill	move.l	d0,(a0)+
	subq.w	#4,d7
	bne.b	.fill

; outer+inner loop:
;	d3 upper word must initially be and remain 0
; 	d7 must initially be 0 (c = 0)
; d0=*, d1=d, d2=b, d3=tmp, d4=10, d5=10000, d6=k, d7=c
; a0=*, a1=*, a2=--, a4=r[]

.outer_loop
	moveq	#0,d1			; d = 0
	add.l	d6,a4			; &r[i]
	move.w	d6,d2
	subq.w	#1,d2			; b = k-1
	bra.b	.inner_entry

.longdiv
	swap	d0
	move.w	d0,d3
	divu.w	d2,d3
	swap	d3
	move.w	d3,d0
	swap	d0
	divu.w	d2,d0

	move.w	d0,d3
	clr.w	d0
	swap	d0
	move.w	d0,(a4)			; r[i] = d%b

	subq.w	#2,d2			; b -= 2
	bcs.b	.inner_done

	exg	d0,d3			; keep d3 upper word clear

.inner_loop
	sub.l	d0,d1			; d = (d-d/b-d%b)/2
	sub.l	d3,d1			; same as d *= i
	lsr.l	#1,d1
.inner_entry
	move.w	-(a4),d0		; r[i]
	mulu.w	d5,d0
	add.l	d0,d1			; d += r[i]*10000
	move.l	d1,d0
	divu.w	d2,d0			; d/b
	bvs.b	.longdiv

	move.w	d0,d3			; d/b
	clr.w	d0
	swap	d0			; d%b
	move.w	d0,(a4)			; r[i] = d%b

	subq.w	#2,d2			; b -= 2
	bcc.b	.inner_loop

.inner_done
	divu.w	d5,d1			; d/10000
	add.w	d7,d1			; d = c+d/10000 (to be printed out)
	move.l	d1,d7
	swap	d7			; c = d%10000
	IFNE	PRINT_DIGITS		; must keep d3 upper word clear
	bsr.b	PR0000
	ELSE
	moveq	#0,d3
	ENDIF

	sub.w	#7*4,d6			; k -= 7*4 (size > speed)
	bne.b	.outer_loop

;*** TIMED PART END ********************************************

	movem.l	(a3)+,d1/d7		; last use of cout and time
	move.l	a3,d2			; buffer

	move.b	VBlankFrequency(a5),d6	; d6 must be 0
	move.l	d6,d0
	add.w	d0,d0
	divu.w	d0,d7			; d7 = seconds
	move.l	d7,d3
	swap	d3
	mulu.w	#100,d3
	add.l	d3,d6			; round up (+0.5)
	divu.w	d0,d6			; d6 = 1/100ths

	move.b	#' ',(a3)+

	moveq	#0,d3			; skip leading zeroes
	bsr.b	SPrintTime		; d5 is already set to 10000

	move.b	#'.',(a3)+

	moveq	#'0',d3			; print leading zeroes
	move.w	d6,d7
	moveq	#10,d5
	bsr.b	SPrintTime

	move.b	d4,(a3)+		; newline

	move.l	a3,d3
	sub.l	d2,d3
	bsr.b	wf				;jsr	Write(a6)

        exg a5,a6			; use exec
        moveq #INTB_VERTB,d0
        move.l SP,A1
        lea     22(SP),SP		; restore stack (is_Size)
;		moveq	#0,d0
        jmp RemIntServer(a6)

;	IFEQ	HACKS
;	move.l	a5,a1
;	jmp	CloseLibrary(a6)	; close dos
;	ELSE
;	rts
;	ENDIF

	; END OF PROGRAM (exec will re-enable multitasking)

;***************************************************************

SPrintTime	; d7=value, a3=buffer
.Next	ext.l	d7
	divu.w	d5,d7
	cmp.b	d3,d7
	beq.b	.LeadZero
	moveq	#'0',d3
	add.b	d3,d7
	move.b	d7,(a3)+
.LeadZero
	swap	d7
	divu.w	d4,d5
	bne.b	.Next
	rts

	IFNE	ALT_PRINT

PR0000		; d1=value
	subq.l	#cout-dec_convert,a3
	move.l	#$2f2f2f30,d0
	moveq	#$01,d2
	move.w	(a3)+,d3
.Loop	ror.l	#8,d2
.Digit	add.l	d2,d0
	sub.w	d3,d1
	bcc.b	.Digit
	add.w	d3,d1
	move.w	(a3)+,d3
	bne.b	.Loop
	add.b	d1,d0

	ELSE

PR0000	; prints d1, uses a0,a1(scratch),d0,d1,d2,d3
        move.w	#$0100,a0
	move.l	#$2f3a2f2f,d0
	move.w	#1000,d2
.d1000	add.w	a0,d0
	sub.w	d2,d1
	bcc.b	.d1000
	add.w	d2,d1

	moveq	#100,d2
.d100	addq.b	#1,d0
	sub.w	d2,d1
	bcc.b	.d100
	add.w	d2,d1

	swap	d0
.d10	add.w	a0,d0
	sub.w	d4,d1
	bcc.b	.d10
	add.b	d1,d0

	ENDIF	; ALT_PRINT

        move.l D0,buf-cout(A3)
        moveq #buf-cout,D2
        moveq #4,D3
writetext
        move.l (A3),D1			; cout
        add.l  A3,D2			; offset to buffer address
wf      jmp Write(A6) 			; call Write(stdout,buffer,size)

; If interrupt priority is >= 10 then a0 must be set to $dff000 on exit
rasterint
	addq.l	#2,(a1)			; a1 = is_Data (time)
	moveq	#0,d0 			; must set Z flag on exit!
	rts

dos		dc.b "dos."

;***************************************************************

	CNOP	0,4

	IFNE	ALT_PRINT
dec_convert				; must be right before cout
	DC.W	1000,100,10,0
	ENDIF

cout	dc.l 0
time	dc.l 0
buf	ds.b 4

;***************************************************************
; Overwritten code/data starts here. 
workspace

msg1	dc.b 'number pi calculator v16',10	; odd length
msg1end
msg2	dc.b 'number of digits (up to '		; even length
msg2end
msg3	dc.b ')? '				; odd length
msg3end
msg4	dc.b ' digits will be printed',10	; even length
msg4end
	even

getnum
.error	moveq #msg2-cout,D2
        moveq #msg2end-msg2,d3
	jsr	(a4)			; writetext
        move.w d7,d1
        bsr.w PR0000
        moveq #msg3-cout,D2
        moveq #msg3end-msg3,d3
	jsr	(a4)			; writetext
        jsr Input(a6)			; get stdin
        move.l d0,d1
        moveq #msg1-cout,D2
        add.l A3,D2
        moveq #4+1,d3			; 4 digits + newline
        jsr Read(a6)

        move.l	d2,a0
	moveq	#0,d2
.loop	subq.w	#1,d0
	beq.b	.done
	move.w	#256-'0',d6
	add.b	(a0)+,d6
	cmp.w	d4,d6			; digit 0-9?
	bhs.b	.error
	mulu.w	d4,d2
	add.w	d6,d2			; D = D*10+digit
	bra.b	.loop
.done
	cmp.w d7,d2			; D > maxD?
	bhi.b .error
	move.w d2,d1			; D = 0?
	beq.b .error
	rts

;	IFEQ	HACKS
;dosname	dc.b "dos.library",0
;	ENDIF

Buffy	dx.b 65536-(Buffy-start)

;***************************************************************

; asm-one&co
;	PRINTV	Buffy-start+36		; 36 = hunk overhead
;	PRINTV	((65536-(workspace-start))/7)&(~3)

;***************************************************************

[ross]

Originally Posted by Don_Adan

Maybe risky, but i dont think. dos.library can not be closed and must be opened as one of first libraries. this is dependent how is created LibList.

Yeah, you're right, and I also thought about "d" only, but i don't know what algorithm Exec uses for inserting libraries and stuff, so i used "dos."

[a/b]

Originally Posted by ross

Yep, no crash thanks to the _Forbid() state and double stack.
And can be applied on my added version also.

If there are two spare bytes in the hunk a d0=0 can be added to remove the error on exit: (only by chance?)

       lea     22(SP),SP		; restore stack (is_Size)
       moveq #0,d0
       jmp RemIntServer(a6)

Are you sure? If you remove the struct from stack and jmp into RemIntServer, there will still be one longword (is_Code) overwritten by ROM, so if the interrupt happens right after that and before INTENA disable you are toast. Yeah, super tiny chance but...

[Don_Adan]

Originally Posted by ross

Yeah, you're right, and I also thought about "d" only, but i don't know what algorithm Exec uses for inserting libraries and stuff, so i used "dos."

About
dos dc.b "dos."
i dont think is correctly placed. perhaps ALT_PRINT version will be not works.

[a/b]

Placement is fine, that small table is accessed from the cout side (as cout-8).

[ross]

Originally Posted by a/b

Are you sure? If you remove the struct from stack and jmp into RemIntServer, there will still be one longword (is_Code) overwritten by ROM, so if the interrupt happens right after that and before INTENA disable you are toast. Yeah, super tiny chance but...

Why overwritten by ROM? The return point for interrupt is stacked in SSP.
Real problem is if a subroutine is executed before INTENA disable.
But code do not crash, so seems not

Originally Posted by Don_Adan

About
dos dc.b "dos."
i dont think is correctly placed. perhaps ALT_PRINT version will be not works.

Yep, move it if the position is for some reason wrong.

[a/b]

First instruction in KS3 RemIntServer is move.l d2,-(sp) so it destroys is_Code even if you don't use jsr. Can't post rom source code because they have no Amigas in Guantanamo Bay ;P.

Hmm, but.... If you push an extra reg, any reg, at the end, and then adjust with 26 and not 22 before exit, that would solve the problem. Not sure if that would work with any KS (would have to check stack usage)...

[ross]

Originally Posted by ross

Why overwritten by ROM? The return point for interrupt is stacked in SSP.
Real problem is if a subroutine is executed before INTENA disable.
But code do not crash, so seems not

00F81676 2f02                     MOVE.L D2,-(A7) [0002a008]
00F81678 2400                     MOVE.L D0,D2
00F8167A c0fc 000c                MULU.W #$000c,D0
00F8167E 41f6 0054                LEA.L (A6,D0.W,$54) == $000014b9,A0
00F81682 2050                     MOVEA.L (A0) [000159dc],A0
00F81684 2208                     MOVE.L A0,D1
00F81686 33fc 4000 00df f09a      MOVE.W #$4000,$00dff09a

Damn..

Not a subroutine executed but a value stacked

This hack could not be used (and also the full "dos." hack collapse).
(very remote possibility, but possible)

EDIT: sorry mods for the close post, it was a quick edit

@don: removed the

moveq #0,d0

before

RemIntServer()

, is of course my idiocy..

[ross]

Well, actually not:

	movem.l	a0/a3-a5,-(SP)		; ln_Name, is_Data, is_Code, pad

And a fix for the final

lea

.



EDIT: me and a/b wrote the same things at the same time with double "hidden" edit

[a/b]

Haha, yeah.. I edited when I figured out the solution, then remembered there could be differences in other KS versions and edited again.. Dirty old bastard ;p.

[ross]

Originally Posted by a/b

Haha, yeah.. I edited when I figured out the solution, then remembered there could be differences in other KS versions and edited again.. Dirty old bastard ;p.

Same code in all KS

New code:

;***************************************************************

; N = 7*D, D = digits, e.g. N = 700 for 100 digits

; user settings
PRINT_DIGITS		= 1
ALT_PRINT		= 1	; shorter but marginally slower print
HACKS			= 0	; use undocumented OS stuff

; exec
OldOpenLibrary		= -408
CloseLibrary		= -414
Forbid			= -132
;Permit			= -138
AddIntServer		= -168
RemIntServer		= -174
VBlankFrequency 	= 530
INTB_VERTB		= 5	; vblank interrupt
NT_INTERRUPT		= 2	; node type
LibList	= $17a
LN_NAME	= $a

; dos
Input			= -54
Output			= -60
Read			= -42
Write			= -48

;***************************************************************

start
; Construct interrupt struct on stack while a0 still points to
; cmdline (valid string ptr!) and use that as a name.
	lea	time(PC),A3
	lea	rasterint(PC),A4
	movem.l	a0/a3-a5,-(SP)		; ln_Name, is_Data, is_Code, pad
	move.w #NT_INTERRUPT<<8+0,-(SP) ; ln_Type, ln_Pri
	subq.l #2*4,SP			; ln_Succ, ln_Pred (set by exec)

	move.l	4.w,a5
	IFEQ	HACKS
	lea	LibList(a5),a6
.d	lea	dos(pc),a2
	moveq	#4-1,d0
	movea.l	(a6),a6
	movea.l	LN_NAME(a6),a1
.0	cmpm.b	(a2)+,(a1)+
	dbne	d0,.0
	bne.b	.d
;	move.l	a5,a6			; use exec
;	lea	dosname(pc),a1		; open dos library
;	jsr	OldOpenLibrary(a6)
;	move.l d0,a6			; use dos
	ELSE
	lea	-$148(a2),a6		; dos library
	ENDIF	; HACKS

	jsr	Output(a6)		; get stdout
	move.l	d0,-(A3)		; a3 = cout

	move.w	#((65536-(workspace-start))/7)&(~3),D7	; maxD (multiple of 4)
	moveq	#10,D4			; global const
	subq.l	#rasterint-writetext,a4	; a4 = writetext

         moveq #msg1-cout,D2		; must be checked if in moveq range
         moveq #msg1end-msg1,d3
	jsr	(a4)			; writetext

	bsr.w	getnum			; returns D in d1 and d2
	addq.w	#3,d1
	and.w	#~3,d1			; adjust D to a multiple of 4
	moveq	#7,d6
	mulu.w	d1,d6			; k = N = 7*D
         cmp.b (a0),d4			; last char is newline (1-4 digits)?
         bne.b .adjusted
         cmp.w d2,d1
         beq.b .not_adjusted
.adjusted
         bsr.w PR0000			; either 5 digits or adjusted D
         moveq #msg4-cout,D2
         moveq #msg4end-msg4,d3
	jsr	(a4)			; writetext
.not_adjusted

        exg a5,a6			; use exec
        jsr Forbid(a6)
        moveq #INTB_VERTB,d0
        move.l SP,A1
        jsr AddIntServer(a6)
        exg a5,a6			; use dos
 
;*** TIMED PART START ******************************************

	lea	workspace(pc),a4
	move.w	#10000,d5

	move.l	#2000<<16+2000,d0
	move.l	a4,a0
	move.l	d6,d7
.fill	move.l	d0,(a0)+
	subq.w	#4,d7
	bne.b	.fill

; outer+inner loop:
;	d3 upper word must initially be and remain 0
; 	d7 must initially be 0 (c = 0)
; d0=*, d1=d, d2=b, d3=tmp, d4=10, d5=10000, d6=k, d7=c
; a0=*, a1=*, a2=--, a4=r[]

.outer_loop
	moveq	#0,d1			; d = 0
	add.l	d6,a4			; &r[i]
	move.w	d6,d2
	subq.w	#1,d2			; b = k-1
	bra.b	.inner_entry

.longdiv
	swap	d0
	move.w	d0,d3
	divu.w	d2,d3
	swap	d3
	move.w	d3,d0
	swap	d0
	divu.w	d2,d0

	move.w	d0,d3
	clr.w	d0
	swap	d0
	move.w	d0,(a4)			; r[i] = d%b

	subq.w	#2,d2			; b -= 2
	bcs.b	.inner_done

	exg	d0,d3			; keep d3 upper word clear

.inner_loop
	sub.l	d0,d1			; d = (d-d/b-d%b)/2
	sub.l	d3,d1			; same as d *= i
	lsr.l	#1,d1
.inner_entry
	move.w	-(a4),d0		; r[i]
	mulu.w	d5,d0
	add.l	d0,d1			; d += r[i]*10000
	move.l	d1,d0
	divu.w	d2,d0			; d/b
	bvs.b	.longdiv

	move.w	d0,d3			; d/b
	clr.w	d0
	swap	d0			; d%b
	move.w	d0,(a4)			; r[i] = d%b

	subq.w	#2,d2			; b -= 2
	bcc.b	.inner_loop

.inner_done
	divu.w	d5,d1			; d/10000
	add.w	d7,d1			; d = c+d/10000 (to be printed out)
	move.l	d1,d7
	swap	d7			; c = d%10000
	IFNE	PRINT_DIGITS		; must keep d3 upper word clear
	bsr.b	PR0000
	ELSE
	moveq	#0,d3
	ENDIF

	sub.w	#7*4,d6			; k -= 7*4 (size > speed)
	bne.b	.outer_loop

;*** TIMED PART END ********************************************

	movem.l	(a3)+,d1/d7		; last use of cout and time
	move.l	a3,d2			; buffer

	move.b	VBlankFrequency(a5),d6	; d6 must be 0
	move.l	d6,d0
	add.w	d0,d0
	divu.w	d0,d7			; d7 = seconds
	move.l	d7,d3
	swap	d3
	mulu.w	#100,d3
	add.l	d3,d6			; round up (+0.5)
	divu.w	d0,d6			; d6 = 1/100ths

	move.b	#' ',(a3)+

	moveq	#0,d3			; skip leading zeroes
	bsr.b	SPrintTime		; d5 is already set to 10000

	move.b	#'.',(a3)+

	moveq	#'0',d3			; print leading zeroes
	move.w	d6,d7
	moveq	#10,d5
	bsr.b	SPrintTime

	move.b	d4,(a3)+		; newline

	move.l	a3,d3
	sub.l	d2,d3
	bsr.b	wf				;jsr	Write(a6)

        exg a5,a6			; use exec
        moveq #INTB_VERTB,d0
        move.l SP,A1
        lea     26(SP),SP		; restore stack (is_Size+pad)
        jmp RemIntServer(a6)

;	IFEQ	HACKS
;	move.l	a5,a1
;	jmp	CloseLibrary(a6)	; close dos
;	ELSE
;	rts
;	ENDIF

	; END OF PROGRAM (exec will re-enable multitasking)

;***************************************************************

SPrintTime	; d7=value, a3=buffer
.Next	ext.l	d7
	divu.w	d5,d7
	cmp.b	d3,d7
	beq.b	.LeadZero
	moveq	#'0',d3
	add.b	d3,d7
	move.b	d7,(a3)+
.LeadZero
	swap	d7
	divu.w	d4,d5
	bne.b	.Next
	rts

	IFNE	ALT_PRINT

PR0000		; d1=value
	subq.l	#cout-dec_convert,a3
	move.l	#$2f2f2f30,d0
	moveq	#$01,d2
	move.w	(a3)+,d3
.Loop	ror.l	#8,d2
.Digit	add.l	d2,d0
	sub.w	d3,d1
	bcc.b	.Digit
	add.w	d3,d1
	move.w	(a3)+,d3
	bne.b	.Loop
	add.b	d1,d0

	ELSE

PR0000	; prints d1, uses a0,a1(scratch),d0,d1,d2,d3
        move.w	#$0100,a0
	move.l	#$2f3a2f2f,d0
	move.w	#1000,d2
.d1000	add.w	a0,d0
	sub.w	d2,d1
	bcc.b	.d1000
	add.w	d2,d1

	moveq	#100,d2
.d100	addq.b	#1,d0
	sub.w	d2,d1
	bcc.b	.d100
	add.w	d2,d1

	swap	d0
.d10	add.w	a0,d0
	sub.w	d4,d1
	bcc.b	.d10
	add.b	d1,d0

	ENDIF	; ALT_PRINT

        move.l D0,buf-cout(A3)
        moveq #buf-cout,D2
        moveq #4,D3
writetext
        move.l (A3),D1			; cout
        add.l  A3,D2			; offset to buffer address
wf      jmp Write(A6) 			; call Write(stdout,buffer,size)

; If interrupt priority is >= 10 then a0 must be set to $dff000 on exit
rasterint
	addq.l	#2,(a1)			; a1 = is_Data (time)
	moveq	#0,d0 			; must set Z flag on exit!
	rts

dos		dc.b "dos."

;***************************************************************

	CNOP	0,4

	IFNE	ALT_PRINT
dec_convert				; must be right before cout
	DC.W	1000,100,10,0
	ENDIF

cout	dc.l 0
time	dc.l 0
buf	ds.b 4

;***************************************************************
; Overwritten code/data starts here. 
workspace

msg1	dc.b 'number pi calculator v16',10	; odd length
msg1end
msg2	dc.b 'number of digits (up to '		; even length
msg2end
msg3	dc.b ')? '				; odd length
msg3end
msg4	dc.b ' digits will be printed',10	; even length
msg4end
	even

getnum
.error	moveq #msg2-cout,D2
        moveq #msg2end-msg2,d3
	jsr	(a4)			; writetext
        move.w d7,d1
        bsr.w PR0000
        moveq #msg3-cout,D2
        moveq #msg3end-msg3,d3
	jsr	(a4)			; writetext
        jsr Input(a6)			; get stdin
        move.l d0,d1
        moveq #msg1-cout,D2
        add.l A3,D2
        moveq #4+1,d3			; 4 digits + newline
        jsr Read(a6)

        move.l	d2,a0
	moveq	#0,d2
.loop	subq.w	#1,d0
	beq.b	.done
	move.w	#256-'0',d6
	add.b	(a0)+,d6
	cmp.w	d4,d6			; digit 0-9?
	bhs.b	.error
	mulu.w	d4,d2
	add.w	d6,d2			; D = D*10+digit
	bra.b	.loop
.done
	cmp.w d7,d2			; D > maxD?
	bhi.b .error
	move.w d2,d1			; D = 0?
	beq.b .error
	rts

;	IFEQ	HACKS
;dosname	dc.b "dos.library",0
;	ENDIF

Buffy	dx.b 65536-(Buffy-start)

;***************************************************************

; asm-one&co
;	PRINTV	Buffy-start+36		; 36 = hunk overhead
;	PRINTV	((65536-(workspace-start))/7)&(~3)

;***************************************************************

[a/b]

Well, a2... So funny how we couldn't see it... STDOUT :P Combined with some more code rarrangement, -8 to 560 bytes.
Also, maxn is now 9312 (it dropped by 4 to 9304 with the openlib change, but now it's back with vengeance).

;***************************************************************

; N = 7*D, D = digits, e.g. N = 700 for 100 digits

; user settings
PRINT_DIGITS		= 1
ALT_PRINT		= 1	; shorter but marginally slower print
HACKS			= 0	; use undocumented OS stuff

; exec
Forbid			= -132
AddIntServer		= -168
RemIntServer		= -174
LibList			= 378
VBlankFrequency 	= 530
LN_NAME			= 10	; list node name
INTB_VERTB		= 5	; vblank interrupt
NT_INTERRUPT		= 2	; node type

; dos
Input			= -54
Output			= -60
Read			= -42
Write			= -48

;***************************************************************

start
; Construct interrupt struct on stack while a0 still points to
; cmdline (valid string ptr!) and use that as a name. Also add
; padding (8 bytes) to protect it from overwritting during exit.
	lea	time(PC),A3
	lea	rasterint(PC),A4
	movem.l	a0/a3/a4/a5-a6,-(SP)	; ln_Name, is_Data, is_Code, pad
	move.w	#NT_INTERRUPT<<8+0,-(SP) ; ln_Type, ln_Pri
	subq.l	#2*4,SP			; ln_Succ, ln_Pred (set by exec)

; Instead of opening/closing dos library we find it in exec's list.
	move.l	4.w,a5			; exec library
	IFEQ	HACKS
	lea	LibList(a5),a6
.lib_loop
	move.l	(a6),a6			; next library in the list
	move.l	LN_NAME(a6),a0
	lea	dosname(pc),a1
	moveq	#dosnameend-dosname-1,d0
.lib_name
	cmpm.b	(a0)+,(a1)+
	dbne	d0,.lib_name
	bne.b	.lib_loop
	ELSE
	lea	-$148(a2),a6		; dos library from bcpl vector
	ENDIF	; HACKS

	jsr	Output(a6)
	move.l	d0,a2			; a2 = stdout
	moveq	#10,D4			; global const

	subq.l	#rasterint-writetext,a4	; a4 = writetext
	bsr.w	getnum			; returns N in d6 (k = N)

	exg	a5,a6			; use exec
	jsr	Forbid(a6)
	moveq	#INTB_VERTB,d0
	move.l	SP,A1
	jsr	AddIntServer(a6)
	exg	a5,a6			; use dos
 
;*** TIMED PART START ******************************************

	lea	workspace(pc),a4
	move.w	#10000,d5

	move.l	#2000<<16+2000,d0
	move.l	a4,a0
	move.l	d6,d7
.fill	move.l	d0,(a0)+
	subq.w	#4,d7
	bne.b	.fill

; outer+inner loop:
;	d3 upper word must initially be and remain 0
; 	d7 must initially be 0 (c = 0)
; d0=*, d1=d, d2=b, d3=tmp, d4=10, d5=10000, d6=k, d7=c
; a0=*, a1=*, a4=r[]

.outer_loop
	moveq	#0,d1			; d = 0
	add.l	d6,a4			; &r[i]
	move.w	d6,d2
	subq.w	#1,d2			; b = k-1
	bra.b	.inner_entry

.longdiv
	swap	d0
	move.w	d0,d3
	divu.w	d2,d3
	swap	d3
	move.w	d3,d0
	swap	d0
	divu.w	d2,d0

	move.w	d0,d3
	clr.w	d0
	swap	d0
	move.w	d0,(a4)			; r[i] = d%b

	subq.w	#2,d2			; b -= 2
	bcs.b	.inner_done

	exg	d0,d3			; keep d3 upper word clear

.inner_loop
	sub.l	d0,d1			; d = (d-d/b-d%b)/2
	sub.l	d3,d1			; same as d *= i
	lsr.l	#1,d1
.inner_entry
	move.w	-(a4),d0		; r[i]
	mulu.w	d5,d0
	add.l	d0,d1			; d += r[i]*10000
	move.l	d1,d0
	divu.w	d2,d0			; d/b
	bvs.b	.longdiv

	move.w	d0,d3			; d/b
	clr.w	d0
	swap	d0			; d%b
	move.w	d0,(a4)			; r[i] = d%b

	subq.w	#2,d2			; b -= 2
	bcc.b	.inner_loop

.inner_done
	divu.w	d5,d1			; d/10000
	add.w	d7,d1			; d = c+d/10000 (to be printed out)
	move.l	d1,d7
	swap	d7			; c = d%10000
	IFNE	PRINT_DIGITS		; must keep d3 upper word clear
	bsr.b	PR0000
	ELSE
	moveq	#0,d3
	ENDIF

	sub.w	#7*4,d6			; k -= 7*4 (size > speed)
	bne.b	.outer_loop

;*** TIMED PART END ********************************************

	move.l	(a3)+,d7		; measured time
	move.l	a3,d2			; buffer

	move.b	VBlankFrequency(a5),d6	; d6 must be 0
	move.l	d6,d0
	add.w	d0,d0
	divu.w	d0,d7			; d7 = seconds
	move.l	d7,d3
	swap	d3
	mulu.w	#100,d3
	add.l	d3,d6			; round up (+0.5)
	divu.w	d0,d6			; d6 = 1/100ths

	move.b	#' ',(a3)+

	moveq	#0,d3			; skip leading zeroes
	bsr.b	SPrintTime		; d5 is already set to 10000

	move.b	#'.',(a3)+

	moveq	#'0',d3			; print leading zeroes
	move.w	d6,d7
	moveq	#10,d5
	bsr.b	SPrintTime

	move.b	d4,(a3)+		; newline

	move.l	a3,d3
	sub.l	d2,d3
	bsr.b	callwrite		; shorter than direct call

	exg	a5,a6			; use exec
	moveq	#INTB_VERTB,d0
	move.l	SP,A1
	lea	22+8(SP),SP		; restore stack (is_Size+pad)
	jmp	RemIntServer(a6)

	; END OF PROGRAM (exec will re-enable multitasking)

;***************************************************************

SPrintTime	; d7=value, a3=buffer
.Next	ext.l	d7
	divu.w	d5,d7
	cmp.b	d3,d7
	beq.b	.LeadZero
	moveq	#'0',d3
	add.b	d3,d7
	move.b	d7,(a3)+
.LeadZero
	swap	d7
	divu.w	d4,d5
	bne.b	.Next
	rts

	IFNE	ALT_PRINT

PR0000		; d1=value
	subq.l	#time-dec_convert,a3
	move.l	#$2f2f2f30,d0
	moveq	#$01,d2
	move.w	(a3)+,d3
.Loop	ror.l	#8,d2
.Digit	add.l	d2,d0
	sub.w	d3,d1
	bcc.b	.Digit
	add.w	d3,d1
	move.w	(a3)+,d3
	bne.b	.Loop
	add.b	d1,d0

	ELSE

PR0000	; prints d1, uses a0,a1(scratch),d0,d1,d2,d3
        move.w	#$0100,a0
	move.l	#$2f3a2f2f,d0
	move.w	#1000,d2
.d1000	add.w	a0,d0
	sub.w	d2,d1
	bcc.b	.d1000
	add.w	d2,d1

	moveq	#100,d2
.d100	addq.b	#1,d0
	sub.w	d2,d1
	bcc.b	.d100
	add.w	d2,d1

	swap	d0
.d10	add.w	a0,d0
	sub.w	d4,d1
	bcc.b	.d10
	add.b	d1,d0

	ENDIF	; ALT_PRINT

	move.l	D0,buf-time(A3)
	moveq	#buf-time,D2
        moveq	#4,D3
writetext
        add.l	A3,D2			; offset to buffer address
callwrite
	move.l	a2,d1			; stdout
        jmp	Write(A6) 		; call Write(stdout,buffer,size)

;***************************************************************

; If interrupt priority is >= 10, a0 must be set to $dff000 on exit
rasterint
	addq.l	#2,(a1)			; a1 = is_Data (time)
	moveq	#0,d0 			; must set Z flag on exit
	rts

;***************************************************************

	CNOP	0,4

	IFNE	ALT_PRINT
dec_convert				; must be right before time
	DC.W	1000,100,10,0
	ENDIF

time	dc.l 0
buf	ds.b 4

;*** OVERWRITTEN CODE/DATA STARTS HERE *************************
workspace

msg1	dc.b 'number pi calculator v16',10	; odd length
msg1end
msg2	dc.b 'number of digits (up to '		; even length
msg2end
msg3	dc.b ')? '				; odd length
msg3end
	even
printnum					; shortcut within 128 bytes
	bra.b	PR0000

msg4	dc.b ' digits will be printed',10	; even length
msg4end
	even

getnum
	move.w	#((65536-(workspace-start))/7)&(~3),d7	; maxD (multiple of 4)

	moveq	#msg1-time,D2
	moveq	#msg1end-msg1,d3
	jsr	(a4)

.error	moveq	#msg2-time,D2
        moveq	#msg2end-msg2,d3
	jsr	(a4)
        move.w	d7,d1
	bsr.b	printnum
        moveq	#msg3-time,D2
        moveq	#msg3end-msg3,d3
	jsr	(a4)

        jsr	Input(a6)		; get stdin
        move.l	d0,d1
        moveq	#msg1-time,D2
        add.l	A3,D2
        moveq	#4+1,d3			; 4 digits + newline
        jsr	Read(a6)

        move.l	d2,a0
	moveq	#0,d2
.loop	subq.w	#1,d0
	beq.b	.done
	move.w	#256-'0',d6
	add.b	(a0)+,d6
	cmp.w	d4,d6			; digit 0-9?
	bhs.b	.error
	mulu.w	d4,d2
	add.w	d6,d2			; D = D*10+digit
	bra.b	.loop
.done
	cmp.w	d7,d2			; D > maxD?
	bhi.b	.error
	move.w	d2,d1			; D = 0?
	beq.b	.error

	addq.w	#3,d1
	and.w	#~3,d1			; adjust D to a multiple of 4
	moveq	#7,d6
	mulu.w	d1,d6			; k = N = 7*D
        cmp.b	(a0),d4			; last char is newline (1-4 digits)?
        bne.b	.adjusted
        cmp.w	d2,d1
        beq.b	.not_adjusted
.adjusted
	bsr.b	printnum		; either 5 digits or adjusted D
        moveq	#msg4-time,D2
        moveq	#msg4end-msg4,d3
	jmp	(a4)
.not_adjusted
	rts

;***************************************************************

	IFEQ	HACKS
dosname	dc.b	"dos."
dosnameend
	ENDIF

buffy	ds.b	65536-(buffy-start)	; 64kb allowed for code+data

;***************************************************************

; asm-one&co
;	PRINTV	buffy-start+36		; 36 = hunk overhead
;	PRINTV	((65536-(workspace-start))/7)&(~3)

;***************************************************************

[ross]

Originally Posted by a/b

Well, a2... So funny how we couldn't see it... STDOUT :P Combined with some more code rarrangement, -8 to 560 bytes.
Also, maxn is now 9312 (it dropped by 4 to 9304 with the openlib change, but now it's back with vengeance).

Great!

[Bruce Abbott]

Originally Posted by alkis

Hmm, is it me or is DOSBase at -$148(a2) when program is executed from dos?
(Tested in 1.3 and 3.1)

I checked in 3.0, and sure enough it's there too (BCPL global vectors are parked right after DOS library in RAM). Highly undocumented, but since we are accepting undocumented OS features...

They say it will go away at some point in the future, but we don't have to worry about that because emulators and original 'real iron' will always support it. Therefore I approve this message.

Originally Posted by a/b

Shorter but marginally slower (barely noticable on 68000 with many digits, however it's configurable so that's that) PR0000 routine, plus some interrupt magic: -8 bytes to 572 (548 with hacks).

548 bytes is awesome! Now the 386 code is blown right out of the water.

I'm loving that dosbase hack - it means you can write simple command line programs without opening any libraries.

I examined some 1.3 CLI commands to see what registers they used. The most interesting one was lab. Here's the entire program disassembled:-

eor.l d0,d0
rts

Now that's what I call efficient coding!

[a/b]

Latest hax version is 536 bytes.
But to be honest, a number of m68k optimizations we have done can be applied not only to x86 version but many of them as they seem to be 1 by 1 translations of some originator version and not specifically written and hyper optimized for a particular cpu/platform.