Optimizing the 68020+ 32-bit math

[Thomas Richter]

Originally Posted by alkis

If BCPL goes, then tripos executable will also bomb, I guess.

Yes, to improve overall sanity of mankind. (-: Frankly, there are no BCPL/tripos executables left. They were rewritten in 2.04 already.

[ross]

Originally Posted by Thomas Richter

Yes, to improve overall sanity of mankind. (-: Frankly, there are no BCPL/tripos executables left. They were rewritten in 2.04 already.

Being undocumented, the only thing to do is follow the disassembly of what and how the routines do.
And in fact, for sanity, getting them out of the way was a VERY good choice.
What the framework does with registers is something unique (and not in a good way)

[a/b]

...back home, and since you haven't beat 500 already: AddTask(brain_torture) ;\.

Also, BCPL can't go away fast enough. BPTRs though...

[a/b]

Alrighty, 520 bytes (518 code) and 496 bytes hax version.
Different timing method, using FORBID macro instead of a call, PR0000 size further reduced, register usage slightly improved.
maxdigits=9320

edit: 516 (514 code) with ross' libname optimization.
edit2: oh noes, more editing. 512 bytes and 492 hax bytes.

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

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

; user settings
PRINT_DIGITS		= 1
HACKS			= 0	; use undocumented OS stuff?

; exec
TDNestCnt		= 295
LibList			= 378
LN_NAME			= 10	; list node name

; dos
Input			= -54
Output			= -60
Read			= -42
Write			= -48
DateStamp		= -192
TICKS_PER_SECOND	= 50	; dos timer frequency

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

start
; 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
	move.l	#'.sod',d1
.lib_name
	cmp.b	(a0)+,d1
	bne.b	.lib_loop
	lsr.l	#8,d1
	bne.b	.lib_name
	ELSE
	lea	-$148(a2),a6		; dos library from bcpl vector
	ENDIF	; HACKS

	jsr	Output(a6)
	move.l	d0,a3			; a3 = stdout
	lea	workspace(pc),a4

	bsr.w	getnum			; returns N in d6 (k = N)

	addq.b	#1,TDNestCnt(a5)	; FORBID macro, a2/a5 are now free

	bsr.b	.gettime
	move.l	d7,-(a7)

;*** TIMED PART START ******************************************

	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

	move.w	#10000,d5

; 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[] (a2=--, a3=stdout, a5=--, a6=dos)

.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

.gettime	; returns ticks in d7
	lea	-12(sp),sp		; -ds_SIZEOF
	move.l	sp,d1
	jsr	DateStamp(a6)
	movem.l	(sp)+,d0/d1/d7		; d0=days, d1=minutes, d7=ticks
	mulu.w	#TICKS_PER_SECOND*60,d1
	add.l	d1,d7
	rts

.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
	exg	d0,d3

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

.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
	bsr.b	PR0000
	ENDIF

	sub.w	#7*4,d6			; k -= 7*4
	bne.b	.outer_loop

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

	bsr.b	.gettime
	sub.l	(a7)+,d7		; end_time-start_time

	add.l	d7,d7			; dos ticks (1/50) to 1/100
	addq.l	#1,d7			; round up
	divu.w	#100,d7			; 1/100ths upper, seconds lower

	move.l	a4,d2			; print buffer
	move.b	#' ',(a4)+

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

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

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

	move.b	d4,(a4)+		; newline

	move.l	a4,d3
	sub.l	d2,d3			; string size
	bra.b	callwrite

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

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

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

PR0000		; d1=value
	move.l	#'0000'-$01010001,d0
	move.w	-(a4),d3
.Loop	addq.b	#1,d0			; top 3 digits in a loop
	add.w	d3,d1
	bpl.b	.Loop
	sub.w	d3,d1
	rol.l	#8,d0
	move.w	-(a4),d3		; last value is string size (4)
	bmi.b	.Loop
	add.b	d1,d0			; 4th digit
 
	move.l	d0,-(a4)

	moveq	#pbuffer-workspace,d2
	sub.l	d2,a4
writetext
	add.l	a4,d2			; offset to buffer address
callwrite
	move.l	a3,d1			; stdout
	jmp	Write(a6) 		; call Write(stdout,buffer,size)

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

; Data must be in this order all up to msg1.

	CNOP	0,4
pbuffer	DCB.B	4,0
dec2str	DC.W	dec2str-pbuffer,-10,-100,-1000

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

; Reorder as needed and don't lose bytes due to EVENs.
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
	moveq	#10,d4			; global const
	move.w	#((65536-(workspace-start))/7)&(~3),d7 ; maxD (multiple of 4)
	lea	writetext(pc),a2	; a2 only used in this subroutine

	moveq	#msg1-workspace,d2
	moveq	#msg1end-msg1,d3
	jsr	(a2)

.error	moveq	#msg2-workspace,d2
	moveq	#msg2end-msg2,d3
	jsr	(a2)
	move.w	d7,d1
	bsr.b	printnum
	moveq	#msg3-workspace,d2
	moveq	#msg3end-msg3,d3
	jsr	(a2)

	jsr	Input(a6)		; get stdin
	move.l	d0,d1
	move.l	a4,d2			; read overwrites msg1
	moveq	#4+1,d3			; up to 4 digits + newline
	jsr	Read(a6)		; returns length in d0

	move.l	d2,a0
	moveq	#0,d2
.nextch	subq.w	#1,d0
	beq.b	.parsed
	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	.nextch
.parsed
	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-workspace,d2
	moveq	#msg4end-msg4,d3
	jmp	(a2)
.not_adjusted
	rts

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

bss	DS.B	65536-(*-start)		; 64kb allowed for code+data

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

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

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

[ross]

Awesome

I was thinking of a way to get it to 516 and the only thing I came up with is to generate another constant but I have no idea if it is possible to rearrange the code to free up a register.

Main idea:

.lib_loop
	move.l	(a6),a6			; next library in the list
	move.l	LN_NAME(a6),a0
	moveq	#4-1,d0
	move.l	#'dos.',dx
.lib_name
	rol.l	#8,dx
	cmp.b	(a0)+,dx
	dbne	d0,.lib_name
	bne.b	.lib_loop

then:

	bsr.b	SPrintTime		; d5 is already set to 10000

	move.b	dx,(a4)+

	moveq	#'0',d3			; print leading zeroes

[ross]

In fact there is a much better way!

516

.lib_loop
	move.l	(a6),a6			; next library in the list
	move.l	LN_NAME(a6),a0
	move.l	#'.sod',d1
.lib_name
	cmp.b	(a0)+,d1
	bne.b	.lib_loop
	lsr.l	#8,d1
	bne.b	.lib_name

[a/b]

Good idea, but no dreg survives the main loop. If we try to replace any with an areg:
- d4, d5: used with mul/div, and those constants must survive dos write
- d6: suba doesn't affect ccr, going subq loses at least 2 bytes elsewhere
- d7: can't swap areg, there would be a possibility if we could replace d1 with another dreg that survives dos write (so d4-d5, d6 is outer loop ctr and must survive) and then use areg instead of d7:

;	add.w	d7,d1
;	move.l	d1,d7
;	swap	d7			; can't swap ax
;	bsr.b	PR0000
	add.w	ax,dy
	bsr.b	PR0000			; dy top word survives
	swap	dy
	move.l	dy,ax

But can't do that either.
Using stack instead of d6, since it practically won't affect the speed, but that would lose bytes having to stack it first and clean up to fetch start time.

Can't seem to see a way around it ;\.

[ross]

Originally Posted by a/b

Can't seem to see a way around it ;\.

Sorry for making you rack your brains in the early morning , see above for a better solution.

[a/b]

Gonna edit the last source I posted.

edit: Editing my edit because edit... 2 more bytes saved, fixing my crap in time calc&print. 512 bytes and 492 hax now.

[ross]

Originally Posted by a/b

.. 512 bytes and 492 hax now.

I like these values, maybe it's time to stop

[a/b]

I was thinking the same when we were close to 564 (a500+c64), followed by a huge disappointment of going from 568 to 560.
Maybe, 512 is a nice number... and 500 seems far, but you never know.

[Don_Adan]

Good job, anyway i have question about time calc routine. If someone started this program about 23:59? Then it will be correctly calculated time or not?

[a/b]

You did not say that! Of course it will*.

* /fontsize 0.001: depends on input parameter.

[alkis]

Originally Posted by a/b

* /fontsize 0.001...

lol

[a/b]

Well, it's deliberately implemented as it is ("good enough").

But now you are making me feel bad, so if you want support for that case (+8 bytes):

LONG_TIMER		= 0	; check for day transition?

	bsr.b	.gettime
	sub.l	(a7)+,d7		; end_time-start_time
	IFNE	LONG_TIMER
; I'll shoot if you ask for DST adjustment or anything similar.
	bpl.b	.same_day
	add.l	#TICKS_PER_SECOND*60*60*24,d7
.same_day
	ENDIF

Actually, I was only looking for an excuse to take a break from work and do some more m68k coding.

[Don_Adan]

You know Amiga version must be the best You made very good job, anyway good program must works in all cases, even very rare or almost impossible.

[alkis]

msg1,2,3 unified.
480 bytes. (500 bytes without hacks)

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

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

; user settings
PRINT_DIGITS		= 1
HACKS			= 1	; use undocumented OS stuff?

; exec
TDNestCnt		= 295
LibList			= 378
LN_NAME			= 10	; list node name

; dos
Input			= -54
Output			= -60
Read			= -42
Write			= -48
DateStamp		= -192
TICKS_PER_SECOND	= 50	; dos timer frequency

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

start
; 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
	move.l	#'.sod',d1
.lib_name
	cmp.b	(a0)+,d1
	bne.b	.lib_loop
	lsr.l	#8,d1
	bne.b	.lib_name
	ELSE
	lea	-$148(a2),a6		; dos library from bcpl vector
	ENDIF	; HACKS

	jsr	Output(a6)
	move.l	d0,a3			; a3 = stdout
	lea	workspace(pc),a4

	bsr.w	getnum			; returns N in d6 (k = N)

	addq.b	#1,TDNestCnt(a5)	; FORBID macro, a2/a5 are now free

	bsr.b	.gettime
	move.l	d7,-(a7)

;*** TIMED PART START ******************************************

	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

	move.w	#10000,d5

; 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[] (a2=--, a3=stdout, a5=--, a6=dos)

.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

.gettime	; returns ticks in d7
	lea	-12(sp),sp		; -ds_SIZEOF
	move.l	sp,d1
	jsr	DateStamp(a6)
	movem.l	(sp)+,d0/d1/d7		; d0=days, d1=minutes, d7=ticks
	mulu.w	#TICKS_PER_SECOND*60,d1
	add.l	d1,d7
	rts

.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
	exg	d0,d3

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

.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
	bsr.b	PR0000
	ENDIF

	sub.w	#7*4,d6			; k -= 7*4
	bne.b	.outer_loop

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

	bsr.b	.gettime
	sub.l	(a7)+,d7		; end_time-start_time

	add.l	d7,d7			; dos ticks (1/50) to 1/100
	addq.l	#1,d7			; round up
	divu.w	#100,d7			; 1/100ths upper, seconds lower

	move.l	a4,d2			; print buffer
	move.b	#' ',(a4)+

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

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

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

	move.b	d4,(a4)+		; newline

	move.l	a4,d3
	sub.l	d2,d3			; string size
	bra.b	callwrite

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

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

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

PR0000		; d1=value
	move.l	#'0000'-$01010001,d0
	move.w	-(a4),d3
.Loop	addq.b	#1,d0			; top 3 digits in a loop
	add.w	d3,d1
	bpl.b	.Loop
	sub.w	d3,d1
	rol.l	#8,d0
	move.w	-(a4),d3		; last value is string size (4)
	bmi.b	.Loop
	add.b	d1,d0			; 4th digit
 
	move.l	d0,-(a4)

	moveq	#pbuffer-workspace,d2
	sub.l	d2,a4
writetext
	add.l	a4,d2			; offset to buffer address
callwrite
	move.l	a3,d1			; stdout
	jmp	Write(a6) 		; call Write(stdout,buffer,size)

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

; Data must be in this order all up to msg1.

	CNOP	0,4
pbuffer	DCB.B	4,0
dec2str	DC.W	dec2str-pbuffer,-10,-100,-1000

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

; Reorder as needed and don't lose bytes due to EVENs.
msg1	DC.B	"number pi calculator v16",10	; odd length
msg1end
msg2	DC.B	"number of digits (up to "	; even length
msg2end
NumDigits  = ((65536-(workspace-start))/7)&(~3)
Thousands  = NumDigits/1000
Hundreds   = (NumDigits-Thousands*1000)/100
Tens       = (NumDigits-Thousands*1000-Hundreds*100)/10
Ones       = (NumDigits-Thousands*1000-Hundreds*100-Tens*10)
        DC.B   Thousands+'0',Hundreds+'0',Tens+'0',Ones+'0'
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
	moveq	#10,d4			; global const
	move.w	#((65536-(workspace-start))/7)&(~3),d7 ; maxD (multiple of 4)
	lea	writetext(pc),a2	; a2 only used in this subroutine

.error	moveq	#msg1-workspace,d2
	moveq	#msg3end-msg1,d3
	jsr	(a2)

	jsr	Input(a6)		; get stdin
	move.l	d0,d1
	move.l	a4,d2			; read overwrites msg1
	moveq	#4+1,d3			; up to 4 digits + newline
	jsr	Read(a6)		; returns length in d0

	move.l	d2,a0
	moveq	#0,d2
.nextch	subq.w	#1,d0
	beq.b	.parsed
	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	.nextch
.parsed
	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	.not_adjusted
.adjusted
	bsr.b	printnum		; either 5 digits or adjusted D
	moveq	#msg4-workspace,d2
	moveq	#msg4end-msg4,d3
	jmp	(a2)
.not_adjusted
	rts

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

bss	DS.B	65536-(*-start)		; 64kb allowed for code+data

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

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

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

[a/b]

I'm on the fence with that one, it changes how the program behaves externally.
Yes, embedding max digits totally makes sense but... Pretty much all the other version could do the same so I see it as an all or nothing deal.
Let's dial 1-8000-litwr :P.

[alkis]

It's a constant. It's like having code to calculate the 16 in version

[a/b]

Yeah, I understand that and agree that it should be printed as part of a string. But that has implications on other versions (they can be made shorter), and a decision should be made by all involved parties or by whoever is in charge as that usually makes things a lot easier.
Btw, there is a bug: Read() is using msg1 as input buffer (move.l a4,d2) so if you input invalid data and have to repeat, the text will be corrupt.
Edit maister is back: You can also save 2 bytes because d7 is used only once: remove move.w #<maxd>,d7 and change to cmp #<maxd>,d2.

Another thing I should've mentioned earlier. Amiga version already gets a discount for using a simplified input because of buffering. For example, pc version won't let you enter 5 digits. Amiga version will. It will only consume 5 chars but you can enter 5 (or a hundred) chars and then press enter (newline as 6th). And if those 5 happen to be invalid, it will ask you again. And then Read() returns the 6th char (newline), and of course it's invalid and asks again. So you get 2 prompts in a row in the same line. To avoid that situation, entering 5 digits will not trigger another prompt, it will use 4 digits and assume the 5th is a newline, and let you pass (to avoid being fed the rest of input from a previous call) and adjust them. That's what cmp.b (a0),d4 does. And this avoids several bytes longer flushing, extra input validation, etc.