;----------------------------------------------------------------------------
;File name:	BLOCKnnn.S			Revision date:	1994.10.05
;Creted by:	U.R.Andersson			Creation date:	1991.05.28
;----------------------------------------------------------------------------
;Purpose:	Block memory below TPA
;----------------------------------------------------------------------------
;
	include	TOS\URAn_SYS.S
	include	TOS\URAn_DOS.S
;
;----------------------------------------------------------------------------
;
	text
	opt	a+
;
;----------------------------------------------------------------------------
;
code_beg:
	move.l	4(sp),a5
	move.l	4(a5),d6
	sub.l	a5,d6		;d6 = selfsize
	lea	mystack+$100,sp
	move.l	#$200+(code_end-code_beg),d5
	bsr	calc_nnn
	gemdos	Cconws,s_blocking
	move.l	nnn_long,-(sp)
	bsr	shownumber
	addq	#4,sp
	gemdos	Cconws,s_kbytes
	move.l	nnn_long,d7
	beq.s	alldone
	asl.l	#8,d7
	asl.l	#2,d7
	cmp.l	d6,d7
	bhs.s	nomem_exit
	gemdos	Mshrink,!,(a5),d7
	tst.l	d0
	bmi.s	nomem_exit
	gemdos	Pexec,!,s_memblock,s_null,s_null
	tst.l	d0
	bpl.s	alldone
	gemdos	Pexec,!,s_automemb,s_null,s_null
	tst.l	d0
	bmi.s	nomemblock_exit	
alldone:
	gemdos	Pterm,#0
;
nomem_exit:
	gemdos	Cconws,s_nomem
do_hitkeyexit:
	gemdos	Cconws,s_hitkeyexit
	bios	Bconin,#2
	gemdos	Pterm,#1
;
nomemblock_exit:
	gemdos	Cconws,s_nomemblock
	bra.s	do_hitkeyexit
;
;----------------------------------------------------------------------------
;
calc_nnn:
	clr.w	nnn_long
	lea	$80(a5),a0
	move.b	(a0)+,d0
	beq.s	.no_arg
	and	#7,d0
	clr.b	(a0,d0)
	bra.s	.calc_number
;
.no_arg:
	gemdos	Fsetdta,localdta
	gemdos	Fsfirst,s_selfname,#0
	lea	localdta+35,a0	;a0->6'th char of filename
	tst	d0
	bpl.s	.calc_number
	gemdos	Fsetdta,localdta
	gemdos	Fsfirst,s_autoname,#0
	lea	localdta+35,a0	;a0->6'th char of filename
	tst	d0
	bmi.s	self_notfound
.calc_number:
	clr.l	d1
	clr.l	d0
.calc_loop:
	move.b	(a0)+,d0
	beq.s	.calc_end
	cmp.b	#'.',d0
	beq.s	.calc_end
	sub.b	#'0',d0
	bmi.s	.calc_end
	cmp.b	#10,d0
	bge.s	.calc_end
	mulu	#10,d1
	add	d0,d1
	bra.s	.calc_loop
;
.calc_end:
	move	d1,nnn_word
	move	d1,d0
	rts
;
;
self_notfound:
	gemdos	Cconws,s_notfound
	bra	do_hitkeyexit
;
;----------------------------------------------------------------------------
;
shownumber:
	lea	numbuf_1,a0
	move.l	4(sp),d0
.show_lp1:
	divu	#10,d0
	swap	d0
	add.b	#'0',d0
	move.b	d0,(a0)+
	swap	d0
	and.l	#$FFFF,d0
	bne.b	.show_lp1
	lea	numbuf_2,a1
.show_lp2:
	move.b	-(a0),(a1)+
	cmp.l	#numbuf_1,a0
	bne.b	.show_lp2
	clr.b	(a1)+
	gemdos	Cconws,numbuf_2
	rts
;
;----------------------------------------------------------------------------
;
	data
;
;----------------------------------------------------------------------------
;
s_automemb:	dc.b	'\AUTO\'
s_memblock:	dc.b	'MEMBLOCK.TOS',NUL
s_autoname:	dc.b	'\AUTO\'
s_selfname:	dc.b	'BLOCK*.PRG',NUL
s_notfound:	dc.b	'BLOCKnnn: Cannot find BLOCKnnn.PRG !',CR,LF,NUL
s_nomem:	dc.b	'BLOCKnnn: Not enough memory available !',CR,LF
s_nomemblock:	dc.b	'BLOCKnnn: Cannot run MEMBLOCK.TOS !',CR,LF,NUL
s_null:		dc.b	NUL
s_hitkeyexit:	dc.b	'BLOCKnnn: Hit any key to exit...',CR,LF,NUL
s_blocking:	dc.b	'BLOCKnnn: Blocking ',NUL
s_kbytes:	dc.b	' Kilobytes.',CR,LF,NUL
	even
;
;----------------------------------------------------------------------------
;
	section	BSS
;
;----------------------------------------------------------------------------
;
localdta:	ds.b	44
nnn_long:	ds.w	1
nnn_word:	ds.w	1
numbuf_1:	ds.b	10
numbuf_2:	ds.b	12
stack:		ds.l	$100
stack_end:
code_end:
;
;----------------------------------------------------------------------------
	end
;----------------------------------------------------------------------------
;End of file:	BLOCKnnn.S
;----------------------------------------------------------------------------

