.area	SM (abs,ovr)

	.org	0x100

	ld	hl,0x308
	ld	de,8
	ld	bc,0x30 ;0x38 ;0x10
	ldir

	ld	hl,0x1234
	ld	de,0x56
	call	div_hl_de
	ex	de,hl
	call	print_word
	ex	de,hl
	call	print_space
	call	print_word
	call	print_crlf

	ld	hl,0x6543
	ld	de,0x21
	call	div_hl_de
	ex	de,hl
	call	print_word
	ex	de,hl
	call	print_space
	call	print_word
	call	print_crlf

	ld	hl,0xb975
	ld	de,0x31
	call	div_hl_de
	ex	de,hl
	call	print_word
	ex	de,hl
	call	print_space
	call	print_word
	call	print_crlf

	ld	hl,0xdb97
	ld	de,0x531
	call	div_hl_de
	ex	de,hl
	call	print_word
	ex	de,hl
	call	print_space
	call	print_word
	call	print_crlf

	pop	de
	call	sm

	; push argument
	.db	<imm_w
	.dw	5

	; push result pointer
	.db	<add_isp
	.dw	0

	; call sm_factorial(argument)
	.db	<call_i
	.dw	sm_factorial
	.db	<adj_isp
	.dw	2

;	; print it the easy way
;	.db	<esc
;	ex	de,hl
;	call	print_word
;	call	print_crlf
;	ex	de,hl
;	call	sm

	; print 10000s
	.db	<div_iuw
	.dw	10000
	.db	<add_iw
	.dw	'0
	.db	<call_i
	.dw	sm_print_char
	.db	<adj_isp
	.dw	2

	; print 1000s
	.db	<div_iuw
	.dw	1000
	.db	<add_iw
	.dw	'0
	.db	<call_i
	.dw	sm_print_char
	.db	<adj_isp
	.dw	2

	; print 100s
	.db	<div_iuw
	.dw	100
	.db	<add_iw
	.dw	'0
	.db	<call_i
	.dw	sm_print_char
	.db	<adj_isp
	.dw	2

	; print 10s
	.db	<div_iuw
	.dw	10
	.db	<add_iw
	.dw	'0
	.db	<call_i
	.dw	sm_print_char
	.db	<adj_isp
	.dw	2

	; print 1s
	.db	<add_iw
	.dw	'0
	.db	<call_i
	.dw	sm_print_char
	.db	<adj_isp
	.dw	2

	.db	<imm_w
	.dw	0xd
	.db	<call_i
	.dw	sm_print_char
	.db	<adj_isp
	.dw	2

	.db	<imm_w
	.dw	0xa
	.db	<call_i
	.dw	sm_print_char
	.db	<adj_isp
	.dw	2

	.db	<esc
	rst	0 ; can't return into ccp as clobbered by stack growth

sm_factorial:
	; get argument
	.db	<add_isp
	.dw	4
	.db	<ld_w

	; is argument < 2?
	.db	<lt_isw
	.dw	2
	.db	<jnz_i
	.dw	1$

	; no, set up for *result =
	.db	<add_isp
	.dw	2
	.db	<ld_w

	; get argument
	.db	<add_isp
	.dw	6
	.db	<ld_w

	; subtract 1
	.db	<add_iw
	.dw	-1

	; push result pointer
	.db	<add_isp
	.dw	0

	; call sm_factorial(argument - 1)
	.db	<call_i
	.dw	sm_factorial
	.db	<adj_isp
	.dw	2

	; get argument
	.db	<add_isp
	.dw	8
	.db	<ld_w

	; multiply
	.db	<mul_w

	; set *result = sm_factorial(argument - 1) * argument
	.db	<st_w

	; return 
	.db	<jmp

1$:	; yes, set up for *result =
	.db	<add_isp
	.dw	2
	.db	<ld_w

	; set *result = 1
	.db	<st_iw
	.dw	1

	; return 
	.db	<jmp

sm_print_char:
	.db	<esc
	ld	hl,0
	add	hl,sp
	ld	a,(hl)
	call	print_char
	call	sm
	.db	<jmp

digits:
	.ascii	'0123456789abcdef'

print_word:
	push	af
	ld	a,h
	call	print_byte
	ld	a,l
	call	print_byte
	pop	af
	ret

print_byte:
	push	af
	push	af
	rrca
	rrca
	rrca
	rrca
	call	print_digit
	pop	af
	call	print_digit
	pop	af
	ret

print_digit:
	push	de
	push	hl
	and	0xf
	ld	e,a
	ld	d,0
	ld	hl,digits
	add	hl,de
	ld	a,(hl)
	pop	hl
	pop	de
	jp	print_char

print_space:
	push	af
	ld	a,0x20
	call	print_char
	pop	af
	ret

print_trace:
	push	af
	push	bc
	push	de
	push	hl
	ld	a,'p
	call	print_char
	ld	a,'c
	call	print_char
	ld	a,'=
	call	print_char
	rst	0x10 ; ex bc,hl
	call	print_word
	rst	0x10 ; ex bc,hl
	call	print_space
	ld	a,'o
	call	print_char
	ld	a,'p
	call	print_char
	ld	a,'=
	call	print_char
	call	print_word
	call	print_space
	ld	a,'s
	call	print_char
	ld	a,'p
	call	print_char
	ld	a,'=
	call	print_char
	ld	hl,10
	add	hl,sp
	call	print_word
	call	print_space
	ld	a,'t
	call	print_char
	ld	a,'o
	call	print_char
	ld	a,'s
	call	print_char
	ld	a,'=
	call	print_char
	ex	de,hl
	call	print_word
	ex	de,hl
	call	print_space
	ld	a,'s
	call	print_char
	ld	a,'t
	call	print_char
	ld	a,'k
	call	print_char
	ld	b,4
	ld	a,'=
1$:	call	print_char
	ld	e,(hl)
	inc	hl
	ld	d,(hl)
	inc	hl
	ex	de,hl
	call	print_word
	ex	de,hl
	ld	a,' 
	djnz	1$
	pop	hl
	pop	de
	pop	bc
	pop	af
print_crlf:
	push	af
	ld	a,0xd
	call	print_char
	ld	a,0xa
	call	print_char
	pop	af
	ret

print_char:
	push	bc
	push	de
	push	hl
	ld	e,a
	ld	c,2
	call	5
	pop	hl
	pop	de
	pop	bc
	ret

	.org	0x308

; ld hl,(bc)+
	ld	a,(bc)
	ld	l,a
	inc	bc
	ld	a,(bc)
	ld	h,a
	inc	bc
	ret

	.org	0x310

; ex bc,hl
	ld	a,l
	ld	l,c
	ld	c,a
	ld	a,h
	ld	h,b
	ld	b,a
	ret

	.org	0x318

; print de
	ex	de,hl
	call	print_word
	ex	de,hl
	jp	print_space

	.org	0x320

; print bc
	rst	0x10 ; ex bc,hl
	call	print_word
	rst	0x10 ; ex bc,hl
	jp	print_space
	
	.org	0x328

; print hl
	call	print_word
	jp	print_space

	.org	0x330

; print stack
	ret ;jp	print_trace

	.org	0x338

; print 'A
	push	af
	ld	a,'A
	call	print_char
	pop	af
	ret

; lower dispatcher, just before 0x100

	.org	0x3eb ;d

dispatch_l5: ; pc in de
	ex	de,hl
	pop	de
dispatch_l6: ; tos in de, pc in hl
	ld	c,l
	ld	b,h
	ld	l,(hl)
	ld	h,>esc
 rst 0x30 ; print stack
	inc	bc
	jp	(hl)

sm:
	pop	bc
	.db	0x21 ; ld hl,
dispatch_l1: ; tos in de and hl, pc in bc
	push	de
dispatch_l2: ; tos in hl, pc in bc
	ex	de,hl
dispatch_l3: ; tos in de, pc in bc, h clobbered
	ld	h,>esc
dispatch_l4: ; tos in de, pc in bc, h = >esc
	ld	a,(bc)
	ld	l,a
	inc	bc
 rst 0x30 ; print stack
	jp	(hl)

; 0x100

esc:
	rst	0x10 ; ex bc,hl
	jp	(hl)

call_i: ; same as imm_w, call
	rst	8 ; ld hl,(bc)+
	push	de
	ld	e,c
	ld	d,b
	jr	dispatch_l6

_call:
	rst	0x10 ; ex bc,hl
	ex	de,hl
	jr	dispatch_l6

jmp_i: ; same as imm_w, jmp
	rst	8 ; ld hl,(bc)+
	jr	dispatch_l6

jz_i: ; same as imm_w, jz
	rst	8 ; ld hl,(bc)+
	ex	de,hl
	.db	0x3e ; ld a,
jz:
	pop	hl
	ld	a,l
	or	h
	jr	nz,dispatch_mm1
	jr	dispatch_l5

jnz_i: ; same as imm_w, jnz
	rst	8 ; ld hl,(bc)+
	ex	de,hl
	.db	0x3e ; ld a,
jnz:
	pop	hl
	ld	a,l
	or	h
	jr	z,dispatch_mm1
	jr	dispatch_l5

xchg_w:
	pop	hl
	jr	dispatch_l1

dup_w:
	push	de
	jr	dispatch_l4

imm_w:
	rst	8 ; ld hl,(bc)+
	jr	dispatch_l1

add_isp: ; same as imm_w, add_sp
	rst	8 ; ld hl,(bc)+
	push	de
	.db	0x3e ; ld a,
add_sp:
	ex	de,hl
	add	hl,sp
	jr	dispatch_l2

ld_iw: ; same as imm_w, ld_w
	rst	8 ; ld hl,(bc)+
	push	de
	.db	0x3e ; ld a,
ld_w:
	ex	de,hl
	ld	e,(hl)
	inc	hl
	ld	d,(hl)
	jr	dispatch_l3

ld_isb: ; same as imm_w, ld_sb
	rst	8 ; ld hl,(bc)+
	push	de
	.db	0x3e ; ld a,
ld_sb:
	ex	de,hl
	ld	e,(hl)
	ld	a,e
	rla
	sbc	a,a
	ld	d,a
	jr	dispatch_l3

ld_iub: ; same as imm_w, ld_ub
	rst	8 ; ld hl,(bc)+
	push	de
	.db	0x3e ; ld a,
ld_ub:
	ex	de,hl
	ld	e,(hl)
	ld	d,0
	jr	dispatch_l3

neg_w:
	dec	de
not_w:
	ld	a,e
	cpl
	ld	e,a
	ld	a,d
	cpl
	ld	d,a
	jr	dispatch_l4

add_iw: ; same as imm_w, add_w
	rst	8 ; ld hl,(bc)+
	.db	0x3e ; ld a,
add_w:
	pop	hl
	add	hl,de
	jr	dispatch_l2

;sub_iw: ; same as imm_w, sub_w
;	rst	8 ; ld hl,(bc)+
;	.db	0x3e ; ld a,
sub_xw: ; same as xchg_w, sub_w
	pop	hl
	rst	0x10 ; ex bc,hl
	.db	0x3e ; ld a,
sub_w: ; same as neg_w, add_w
	pop	hl
	or	a
	sbc	hl,de
	jr	dispatch_l2

eq_iw: ; same as imm_w, eq_w
	rst	8 ; ld hl,(bc)+
	.db	0x3e ; ld a,
eq_w:
	pop	hl
	sub	a
	sbc	hl,de
	ld	e,a
	ld	d,a
	jr	nz,dispatch_l3
	inc	e
	jr	dispatch_l3

; middle dispatch routines

jmp: ; also means ret
	ld	c,e
	ld	b,d
	jr	dispatch_m0

adj_isp: ; same as imm_w, adj_sp
	rst	8 ; ld hl,(bc)+
	push	de
	.db	0x3e ; ld a,
adj_sp: ; same as add_sp, st_sp
	ex	de,hl
	add	hl,sp
	.db	0x3e ; ld a,
st_sp:
	ex	de,hl
	ld	sp,hl
	jr	dispatch_mm1

;st_ixw: ; same as imm_w, xchg_w, st_w
;	rst	8 ; ld hl,(bc)+
;	ld	(hl),e
;	inc	hl
;	ld	(hl),d
;	jr	dispatch_mm1

st_iw: ; same as imm_w, st_w
	rst	8 ; ld hl,(bc)+
	ex	de,hl
	.db	0x3e ; ld a,
st_w:
	pop	hl
	ld	(hl),e
	inc	hl
	ld	(hl),d
	jr	dispatch_mm1

st_ixb: ; same as imm_w, xchg_w, st_d
	rst	8 ; ld hl,(bc)+
	.db	0x3e ; ld a,
st_d:
	pop	hl
	ld	(hl),e
	jr	dispatch_mm1

; middle dispatcher, near 0x180, smaller in size
; used for store-type routines that empty stack and need it to be popped

dispatch_mm1: ; pc in bc
	ld	h,>esc
dispatch_m0: ; pc in bc, h = >esc
	pop	de
dispatch_m4:
	ld	a,(bc)
	ld	l,a
 rst 0x30 ; print stack
	inc	bc
	jp	(hl)

lt_iuw: ; same as imm_w, lt_iuw
	rst	8 ; ld hl,(bc)+
	.db	0x3e ; ld a,
gt_uw: ; same as xchg_w, lt_uw
	pop	hl
	ex	de,hl
	.db	0x3e ; ld a,
lt_uw:
	pop	hl
	sub	a
	sbc	hl,de
	ld	d,a
	adc	a,a
	ld	e,a
	jr	dispatch_u3

lt_isw: ; same as imm_w, lt_isw
	rst	8 ; ld hl,(bc)+
	.db	0x3e ; ld a,
gt_sw: ; same as xchg_w, lt_sw
	pop	hl
	ex	de,hl
	.db	0x3e ; ld a,
lt_sw:
	pop	hl
	sub	a
	sbc	hl,de
	ld	d,a
	jp	pe,lt_sw_overflow
	add	hl,hl
	adc	a,a
	ld	e,a
	jr	dispatch_u3
lt_sw_overflow:
	add	hl,hl
	ccf
	adc	a,a
	ld	e,a
	jr	dispatch_u3

and_iw: ; same as imm_w, and_w
	rst	8 ; ld hl,(bc)+
	.db	0x3e ; ld a,
and_w:
	pop	hl
	ld	a,l
	or	e
	ld	e,a
	ld	a,h
	or	d
	ld	d,a
	jr	dispatch_u3

or_iw: ; same as imm_w, and_w
	rst	8 ; ld hl,(bc)+
	.db	0x3e ; ld a,
or_w:
	pop	hl
	ld	a,l
	or	e
	ld	e,a
	ld	a,h
	or	d
	ld	d,a
	jr	dispatch_u3

xor_iw: ; same as imm_w, and_w
	rst	8 ; ld hl,(bc)+
	.db	0x3e ; ld a,
xor_w:
	pop	hl
	ld	a,l
	xor	e
	ld	e,a
	ld	a,h
	xor	d
	ld	d,a
	jr	dispatch_u3

;sl_xw:
;	pop	hl
;	ex	de,hl
;	.db	0x3e ; ld a,
sl_w:
	pop	hl
	call	sl_hl_e
	jr	dispatch_u2

;sr_xuw:
;	pop	hl
;	ex	de,hl
;	.db	0x3e ; ld a,
sr_uw:
	pop	hl
	call	srl_hl_e
	jr	dispatch_u2

;sr_xsw:
;	pop	hl
;	ex	de,hl
;	.db	0x3e ; ld a,
sr_sw:
	pop	hl
	call	sra_hl_e
	jr	dispatch_u2

mul_iw:
	rst	8 ; ld hl,(bc)+
	.db	0x3e ; ld a,
mul_w:
	pop	hl
	call	mul_hl_de
	jr	dispatch_u2

div_iuw:
	rst	8 ; ld hl,(bc)+
	.db	0x3e ; ld a,
div_xuw:
	pop	hl
	ex	de,hl
	.db	0x3e ; ld a,
div_uw:
	pop	hl
	call	div_hl_de
;	jr	dispatch_um1

; upper dispatcher, after 0x200

dispatch_um1: ; tos in hl and de, pc in bc
	push	hl
	.db	0x3e ; ld a,
;dispatch_u1: ; tos in de and hl, pc in bc
;	push	de
dispatch_u2: ; tos in hl, pc in bc
	ex	de,hl
dispatch_u3: ; tos in de, pc in bc, h clobbered
	ld	h,>esc
dispatch_u4: ; tos in de, pc in bc, h = >esc
	ld	a,(bc)
	ld	l,a
 rst 0x30 ; print stack
	inc	bc
	jp	(hl)

; math package

sl_hl_e:
	ld	a,e
	and	0xf
	ret	z
1$:	add	hl,hl
	dec	a
	jr	nz,1$
	ret

srl_hl_e:
	ld	a,e
	and	0xf
	ret	z
	push	bc
	ld	b,a
	ld	a,l
srl_hl_loop:
	srl	h
	rra
	djnz	srl_hl_loop
	ld	l,a
	pop	bc
	ret

sra_hl_e:
	ld	a,e
	and	0xf
	ret	z
	push	bc
	ld	b,a
	ld	a,l
sra_hl_loop:
	sra	h
	rra
	djnz	sra_hl_loop
	ld	l,a
	pop	bc
	ret

mul_hl_de:
	push	bc
	ld	a,h
	ld	c,l
	ld	hl,0
	ld	b,8
1$:	add	hl,hl
	rla
	jr	nc,2$
	add	hl,de
2$:	djnz	1$
	ld	a,c
	ld	b,8
3$:	add	hl,hl
	rla
	jr	nc,4$
	add	hl,de
4$:	djnz	3$
	pop	bc
	ret

div_hl_de:
	push	bc
	ld	a,h
	ld	c,l
	ld	hl,0
	call	div0
	ld	b,a
	ld	a,c
	ld	c,b
	jr	c,2$
	call	div0
	jr	c,3$
1$:	ld	d,c
	ld	e,a
	pop	bc
	ret

2$:	call	div1
	jr	nc,1$
3$:	add	hl,de
	ld	d,c
	ld	e,a
	pop	bc
	ret

; non-restoring division routine

; de = divisor, hl:a = dividend with hl = previous remainder, a = next byte
; enter at div0 with positive remainder in hl, such that hl < de
; enter at div1 with negative remainder in hl, such that hl >= -de

; div0/1 return a = 8-bit quotient as an odd number interpreted as -ff..ff,
; by summing positive/negative place values, e.g. -80 +40 +20 -10 +8 -4 -2 +1

; if entered at div0, there is a -80 and so quotient is in range -ff..-1
; if entered at div1, there is a +80 and so quotient is in range 1..ff
; falls out of loop after div01 with positive remainder, div11 with negative,
; depending on this we should re-enter at div0 or div1, signalled by cf return

; the successive quotient bytes can be concatenated into a full quotient,
; but negative bytes require the next higher quotient byte to be decremented,
; we know in advance if this will happen because the implied sign of the
; quotient byte depends only on whether we entered at div0 or div1, hence,
; before the div11 return we'll decrement to compensate for next negative byte

; the decrement can also be seen as compensating for the extra add hl,de that
; may be needed to make negative remainder positive before return to caller,
; thus leaving things in a consistent state regardless of which exit occurred,
; to find out if we need the extra add hl,de we can look for even return byte

; in the following code each sbc hl,de gets an inc a and each add hl,de gets
; a dec a, guaranteeing the integrity of the division, the initial scf/rla is
; needed to make the result 100 + -ff..ff or 1..1ff, so that the decrements
; cannot borrow into the upcoming dividend bits also held in a, and there must
; be another shift between the scf/rla and increment/decrement so that the scf
; is implicitly in the 100s place, making the code awkward though it's correct 

div0:
 push af
 ld a,'A
 call print_char
 pop af
 call print_word
 push af
 ld a,':
 call print_char
 pop af
 call print_byte
 push af
 ld a,'/
 call print_char
 pop af
 ex de,hl
 call print_word
 ex de,hl
	ld	b,8
	scf
	rla
div00:	adc	hl,hl
	sbc	hl,de
	jr	nc,1$
	add	a,a
	inc	a
	jr	div11
1$:	add	a,a
	inc	a
div01:	djnz	div00
	or	a
 push af
 ld a,'B
 call print_char
 pop af
 push af
 ld a,'0
 adc a,0
 call print_char
 ld a,':
 call print_char
 pop af
 call print_byte
 push af
 ld a,',
 call print_char
 pop af
 call print_word
 call print_crlf
	ret

div1:
 push af
 ld a,'C
 call print_char
 pop af
 call print_word
 push af
 ld a,':
 call print_char
 pop af
 call print_byte
 push af
 ld a,'/
 call print_char
 pop af
 ex de,hl
 call print_word
 ex de,hl
	ld	b,8
	scf
	rla
div10:	adc	hl,hl
	add	hl,de
	jr	nc,1$
	add	a,a
	dec	a
	jr	div01
1$:	add	a,a
	dec	a
div11:	djnz	div10
	dec	a			; compensation
	scf
 push af
 ld a,'D
 call print_char
 pop af
 push af
 ld a,'0
 adc a,0
 call print_char
 ld a,':
 call print_char
 pop af
 call print_byte
 push af
 ld a,',
 call print_char
 pop af
 call print_word
 call print_crlf
	ret