strtol.src

	.assume	adl=1

	.include	"errno.inc"

.if	ERANGE & 0xFF != ERANGE
	.print	"ERANGE is assumed to be between 1 and 255"
	.err
.endif

	; until we figure out how to get FASMG require or etc working correctly
	.equ	HAVE_WE_FIGURED_OUT_BINUTILS_YET, 0

;-------------------------------------------------------------------------------

	.section	.text.___strtoi

	.global	___strtoi
	.type	___strtoi, @function

___strtoi:
	; Similar to strtol, except that it will raise ERANGE and return INT_MIN/INT_MAX when out of range
	call	__strtol_common
	; overflow occured if B is non-zero
	djnz	.L.out_of_range
	inc	e
	dec	e
	jr	nz, .L.out_of_range
	ld	b, a
	inc	b
	ex	de, hl
	sbc	hl, hl
	djnz	.L.positive
	sbc	hl, de
	ret	m		; INT_MIN <= x < 0
	; no underflow if x is zero
	jr	nz, .L.out_of_range
.L.positive:
	adc	hl, de
	ret	p		; 0 <= x <= INT_MAX
.L.out_of_range:
	or	a, a		; test sign (Z = negative)
	ld	hl, ERANGE
	ld	(_errno), hl
	ld	hl, $7FFFFF	; overflow
	ret	nz
	inc	hl		; underflow
	ret

;-------------------------------------------------------------------------------

	.section	.text._strtol

	.global	_strtol
	.type	_strtol, @function

_strtol:
	call	__strtol_common
	; overflow occured if B is non-zero
	djnz	_strtol.out_of_range
	ld	a, e
	rla
	jr	c, _strtol.maybe_out_of_range
	ret	nz
	jp	__lneg

_strtol.maybe_out_of_range:
	; greater than INT_MAX
	jr	nz, _strtol.overflow
	; negative
	; check that the result is not an exact INT_MIN
	or	a, a
	adc	hl, hl
	jr	nz, _strtol.underflow
	ld	a, e
	adc	a, a
	ret	z		; exact INT_MIN
_strtol.underflow:
	xor	a, a		; set Z
_strtol.out_of_range:
_strtol.overflow:
	ld	e, $80
	ld	hl, ERANGE
	ld	(_errno), hl
	ld	l, h		; ld hl, 0
	ret	z		; underflow
	; overflow
	dec	hl
	dec	e
	ret

;-------------------------------------------------------------------------------

	.section	.text.___strtoui

	.global	___strtoui
	.type	___strtoui, @function

___strtoui:
	; Similar to strtoul, except that it will raise ERANGE and return UINT_MAX when out of range
	call	__strtol_common
	; overflow occured if B is non-zero
	djnz	_strtoul.out_of_range
	call	z, __ineg
	inc	e
	dec	e
	ret	z

.if HAVE_WE_FIGURED_OUT_BINUTILS_YET
; REQUIRE	require	_strtoul.out_of_range

;-------------------------------------------------------------------------------

	.section	.text._strtoul.out_of_range

	.local	_strtoul.out_of_range
_strtoul.out_of_range:
.endif
	ld	hl, ERANGE
	ld	(_errno), hl
	ld	l, h		; ld hl, 0
	dec	hl
	ld	e, l
	ret

	.section	.text._strtoul

	.global	_strtoul
	.type	_strtoul, @function
_strtoul:
	call	__strtol_common
	; overflow occured if B is non-zero
	djnz	_strtoul.out_of_range
	ret	nz
	jp	__lneg

.if HAVE_WE_FIGURED_OUT_BINUTILS_YET
.else
_strtoul.out_of_range:
	ld	hl, ERANGE
	ld	(_errno), hl
	ld	l, h		; ld hl, 0
	dec	hl
	ld	e, l
	ret
.endif

;-------------------------------------------------------------------------------

	.section	.text.__strtol_common

	.local	__strtol_common

__strtol_common:
	; output: E:UHL
	; B = 1 if no overflow
	; Z means that A is zero = negate return value
	; NZ means that A is non-zero = positive return value
	push	ix
	ld	ix, 0
	lea	hl, ix - 37	; ld hl, -37
	add	ix, sp

	ld	bc, (ix + 15)	; base
	add	hl, bc
	jr	c, .L.invalid_base
	; UBC is zero here
	ld	b, c		; store the base in B to allow for djnz hax
	ld	hl, (ix + 9)	; nptr
;-------------------------------------------------------------------------------
; consume whitespace (inlinsed isspace)
.L.whitespace_loop:
	ld	a, (hl)
	inc	hl
	cp	a, 32
	jr	z, .L.whitespace_loop
	sub	a, 9
	add	a, -5
	jr	nc, .L.whitespace_loop
; test for plus/minus signs
	; A = (HL - 1) - 9 + -5
	; A = (HL - 1) - 14
	xor	a, '-' - 14
	push	af
	jr	z, .L.minus_sign
	xor	a, ('+' - 14) ^ ('-' - 14)
	jr	z, .L.plus_sign
	dec	hl
	xor	a, a
.L.plus_sign:
.L.minus_sign:
	; A = 0, (HL) = start of number
;-------------------------------------------------------------------------------
; update the base if needed
	or	a, b		; base
	jr	z, .L.auto_base
	xor	a, 16
	jr	z, .L.hex_base
	xor	a, 2 ^ 16
	jr	nz, .L.other_base
.L.auto_base:	; test for 0* 0x* 0X* 0b* 0B*
.L.bin_base:	; test for 0x* 0X*
.L.hex_base:	; test for 0b* 0B*
	inc	b		; djnz hax
	ld	a, (hl)
	xor	a, '0'
	jr	nz, .L.maybe_decimal
	inc	hl
	ld	a, (hl)
	res	5, a		; upper case
	xor	a, 'X'
	jr	z, .L.maybe_hex
	xor	a, 'B' ^ 'X'
	jr	z, .L.maybe_bin
	dec	hl
	djnz	.L.other_base
	ld	b, 8		; octal
	jr	.L.save_new_base

.L.maybe_bin:
	bit	4, b
	jr	nz, .L.undo_inc	; hexadecimal
	; base is 0 or 2
	inc	hl
	ld	b, 2
	jr	.L.save_new_base

.L.maybe_hex:
	bit	1, b
	jr	nz, .L.undo_inc	; binary
	; base is 0 or 16
	inc	hl
	ld	b, 16
	jr	.L.save_new_base

.L.undo_inc:
	dec	hl
	; dec	b
	; jr	.L.other_base
.L.maybe_decimal:
	; set to decimal if base is not zero
	djnz	.L.other_base
	ld	b, 10		; decimal
.L.save_new_base:
;-------------------------------------------------------------------------------
.L.other_base:
	ld	a, (hl)		; first digit of the number
	push	hl
	pop	iy
	ld	d, b
.L.invalid_base_hijack:
	; or	a, a		; carry is cleared here
	sbc	hl, hl
	ld	e, l
	ld	b, l
	; A = first digit of the number
	; E:UHL = 0
	; D = base
	; UBC = 0 when base is valid (otherwise unknown)
	; B = 0

	; The strto* functions return nptr (not nptr + whitespace) if there are
	; no digits in the string. Having a digit check here allows us to
	; directly handle the case where the string has no digits.

	sub	a, 48
	cp	a, 10
	jr	c, .L.check_digit
	; Convert an alphabetic digit, case-insensitive
	sub	a, 65 - 48
	res	5, a
	add	a, 10
.L.check_digit:
	; End the loop when the digit is out of range for the base
	cp	a, d
	jr	c, .L.loop
;-------------------------------------------------------------------------------
; no digit found or invalid base
	; set *endptr to nptr and return 0
	ld	iy, (ix + 9)	; nptr
	jr	.L.write_endptr
.L.invalid_base:
	xor	a, a
	ld	d, a
	; Setting D (base) to zero ensures that cp a, d will never set carry.
	; forcing the function to return.
	push	af
	; sets E:UHL to zero
	jr	.L.invalid_base_hijack
;-------------------------------------------------------------------------------
	; common path   : 30F +  1R +  3W +  5 + __lmulu_b
	; decimal path  :  6F +  0R +  0W +  1
	; other path    : 12F +  0R +  0W +  1
	;
	; decimal digit : 36F +  1R +  3W +  4 + __lmulu_b
	; other digit   : 42F +  1R +  3W +  4 + __lmulu_b
	; __lmulu_b     : 43F + 15R + 12W + 17
	;
	; Total CC per digit:
	; decimal digit : 79F + 16R + 15W + 21
	; other digit   : 85F + 16R + 15W + 21
.L.check_decimal:
	cp	a, d
	jr	nc, .L.end_loop
.L.loop:
	ld	c, a		; UBC = digit if no carry, don't care otherwise
	ld	a, d		; A = base
	ld	d, e		; D = upper accumulator byte
	ld	e, b		; E = 0 if no carry, don't care otherwise
	; E:UHL = UHL * base
	call	__lmulu_b
	; Add digit to lower product bytes
	add	hl, bc
	ld	c, a		; C = base
	ld	a, e		; A = upper product byte
	ld	e, c		; E = base
	mlt	de		; DE = upper accumulator byte * base
	; Carry into upper product byte
	adc	a, e
	ld	e, a
	; Set B != 0 if any carry from the upper byte or previous iterations
	sbc	a, a
	or	a, d
	or	a, b
	ld	b, a
	ld	d, c		; D = base
	; IY = str, D = base, E:UHL = accumulator, BCU = 0, B = 0 if no carry
.L.next_digit:
	inc	iy
	; Convert a numerical digit
	ld	a, (iy)
	sub	a, 48
	cp	a, 10
	jr	c, .L.check_decimal
	; Convert an alphabetic digit, case-insensitive
	sub	a, 65 - 48
	res	5, a
	add	a, 10
	; End the loop when the digit is out of range for the base
	cp	a, d
	jr	c, .L.loop
.L.end_loop:
;-------------------------------------------------------------------------------
.L.write_endptr:
	push	hl
	ld	hl, (ix + 12)	; endptr
	add	hl, de
	or	a, a
	sbc	hl, de
	jr	z, .L.endptr_null
	ld	(hl), iy
.L.endptr_null:
	pop	hl
	inc	b		; djnz hax
	pop	af
	pop	ix
	ret

	.extern	_errno
	.extern	__ineg
	.extern	__lneg
	.extern	__lmulu_b