;----------------------------------------------------------------------------
;File name:	ALLBELOW.S			Revision date:	2000.01.12
;Creted by:	U.R.Andersson			Creation date:	1991.05.28
;----------------------------------------------------------------------------
;Purpose:	Alloc memory from TPA
;----------------------------------------------------------------------------
	include	RA_TOS.I
;----------------------------------------------------------------------------
	section	TEXT
;----------------------------------------------------------------------------
code_beg:
	move.l	4(sp),a5		;a5 -> basepage
	lea	stack_end(pc),sp
	move.l	bp_bss_beg_p(a5),a0
	add.l	bp_bss_len(a5),a0
	sub.l	a5,a0
	gemdos	Mshrink,!,(a5),a0
;-------
	move.l	a5,a6			;a6 -> basepage as preliminary RAM limit
	lea	bp_arglen(a5),a0
	clr	d3
	move.b	(a0)+,d3
	ble.s	.have_limit
	cmp.b	#127,d3
	bhs.s	.have_limit
	clr.b	(a0,d3)
	jsr	atol
	bcs.s	.have_limit		;ignore invalid argument
	move.l	d0,a6
.have_limit:
	cmp.l	#$00ffFFFF,a6
	bls.s	.accept_limit
	gemdos	Pterm0
;-------
.accept_limit:
	move.l	#(4<<20),d6		;d6 = 4MB maximum block size
.allbelow_loop_1:
	gemdos	Malloc,#4		;get a small test block
	tst.l	d0
	ble.s	.all_done		;exit if no block available
	move.l	d0,a3			;a3 -> test block
	gemdos	Mfree,(a3)		;release test block
	cmp.l	a6,a3
	bhs.s	.all_done		;exit if block above limit
.allbelow_loop_2:
	gemdos	Malloc,d6		;allocate a block of current size
	tst.l	d0
	ble.s	.next_size		;try lower size if no block was found
	cmp.l	a6,d0
	blo.s	.allbelow_loop_2	;loop back for more if block below limit
	gemdos	Mfree|_ind,d0		;release block again
.next_size:
	lsr.l	#1,d6			;halve current maximum size
	cmp.l	#4,d6
	bhs.s	.allbelow_loop_1	;loop until block size < 4
;-------
.all_done:
	gemdos	Ptermres,#128,!
;----------------------------------------------------------------------------
atol:
	movem.l	d1-d3/a0-a2,-(sp)
	clr.l	d0
	move.b	(a0)+,d1		;get first potential digit/prefix char
	cmp.b	#'-',d1			;negative sign prefix ?
	seq	d3
	beq.s	.accept_sign
	cmp.b	#'+',d1			;positive sign prefix
	bne.s	.done_sign
.accept_sign:
	move.b	(a0)+,d1		;get next potential digit/prefix char
.done_sign:
	clr	d2			;d2 = offset for base 10 routines
	cmp.b	#'0',d1			;start of '0x' hex prefix
	bne.s	.not_0x_prefix
	cmp.b	#'x',(a1)		;correct end of '0x' hex prefix
	beq.s	.take_0x_prefix
	cmp.b	#'X',d1			;capital end of '0X' hex prefix
	bne.s	.not_0x_prefix
.take_0x_prefix:
	addq	#1,a0
	bra.s	.finish_hex_prefix
;-------
.not_0x_prefix:
	cmp.b	#'$',d1			;hex prefix ?
	bne.s	.done_hex_prefix
.finish_hex_prefix:
	moveq	#4,d2			;d2 = offset for base 16 routines
	move.b	(a0)+,d1		;get new first potential digit char
.done_hex_prefix:
	lea	base_fix_t(pc),a1
	move.l	a1,a2
	add	(a1,d2),a1		;a1 -> digit routine
	add	2(a2,d2),a2		;a2 -> shift routine
	jsr	(a1)			;check first digit
	bmi.s	.num_err
.loop:
	jsr	(a2)			;rescale result for one more digit
	bcs.s	.exit			;exit on overflow
	or.b	d1,d0			;include the latest new digit
	move.b	(a0)+,d1		;get next potential digit char
	jsr	(a1)			;check next digit
	bpl.s	.loop			;loop back for all valid digits
	tst.b	d3			;negate sign ?
	beq.s	.exit
	neg.l	d0
.exit:
	tst.l	d0			;flag CC for success
	movem.l	(sp)+,d1-d3/a0-a2
	rts
;-------
.num_err:
	moveq	#-1,d0
	addq	#1,d0			;flag CS for errors
	rts
;----------------------------------------------------------------------------
base_16_digit:
	cmp.b	#'z',d1
	bhi.s	bad_digit
	cmp.b	#'a',d1
	blo.s	.chk_capital
	and	#$DF,d1
.chk_capital:
	cmp.b	#'Z',d1
	bhi.s	bad_digit
	cmp.b	#'A',d1
	blo.s	base_10_digit
	add.b	#$0A-'A',d1
have_digit:
	tst.b	d1		;flag PL for success
	rts
;-------
base_10_digit:
	cmp.b	#'9',d1
	bhi.s	bad_digit
	sub.b	#'0',d1
	bhs.s	have_digit
bad_digit:
	move.b	#-1,d1		;flag MI for error
	rts
;----------------------------------------------------------------------------
base_10_mult:
	add.l	d0,d0
	bcs.s	.exit
	move.l	d0,d2
	add.l	d0,d0
	bcs.s	.exit
	add.l	d0,d0
	bcs.s	.exit
	add.l	d2,d0
.exit:
	rts			;return CC for success, but CS for overflow
;----------------------------------------------------------------------------
base_16_mult:
	add.l	d0,d0
	bcs.s	.exit
	add.l	d0,d0
	bcs.s	.exit
	add.l	d0,d0
	bcs.s	.exit
	add.l	d0,d0
.exit:
	rts			;return CC for success, but CS for overflow
;----------------------------------------------------------------------------
	section	DATA
;----------------------------------------------------------------------------
base_fix_t:
	dc.w	base_10_digit-base_fix_t
	dc.w	base_10_mult-base_fix_t
	dc.w	base_16_digit-base_fix_t
	dc.w	base_16_mult-base_fix_t
;----------------------------------------------------------------------------
	section	BSS
;----------------------------------------------------------------------------
stack:		ds.l	$100
stack_end:
code_end:
;----------------------------------------------------------------------------
	end
;----------------------------------------------------------------------------
;End of file:	ALLBELOW.S
;----------------------------------------------------------------------------

