*
*  Memory.a  -  Self administrating memory routines
*
		ifnd	IFILES
IFILES		set	1
		include	"exec/types.i"
		include	"exec/memory.i"
		include	"exec/funcdef.i"
		include	"exec/lists.i"
		include	"exec/exec_lib.i"
		include	"call.i"
		endc

		xref	_NoMem
  ifd	DEBUG
		xref	_MemError
ExtraBytes	equ	20
  else
ExtraBytes	equ	12
  endc
		CSECT	text,0,0,2,2



*********************************************************
*
*  --  AllocM  --
*

 Func	_Calloc
		mulu	d1,d0				By ANSI definition max 64k at a time
		move.l	#MEMF_CLEAR,d1
		bra.s	AM_
 Func	_Malloc
		moveq.l	#MEMF_ANY,d1

 Func	_AllocMA

CallersRA	equ	16				4 regs movem'd

AM_		movem.l	d2/d3/a2/a6,-(a7)
		move.l	d1,d3				Memtype, keep for error
		moveq.l	#ExtraBytes,d2			12 (20) bytes for minnode and size (and debug info)
		add.l	d0,d2				Add to requested number
		move.l	d2,d0				Keep requested size
AM_Alloc	move.l	4,a6
		jsr	_LVOAllocMem(a6)
		move.l	d0,a0				Block of memory
		tst.l	d0				Allocated?
		bne.s	AM_GotMem			Yes..

*--	No memory, call custom function

		move.l	d3,-(a7)			Memory type
		move.l	d2,-(a7)			Memory size
		jsr	_NoMem(pc)			Call warning (or cure) function
		addq.l	#8,a7
		move.l	d0,a0				Set a0 to block or clear in case of no retry
		tst.l	d0				Accept no memory?
		beq.s	AM_Rtn				Yes, return zero..
		moveq.l	#-1,d1				Retry flag
		cmp.l	d0,d1				Retry?
		bne.s	AM_GotMem			No, we have a pointer to a block from NoMem()..
		move.l	d2,d0				Yes retry, memory size
		move.l	d3,d1				Memory type
		bra.s	AM_Alloc			Retry..

AM_GotMem

*--	We have a block, store our info into the reserved fields

  ifd	DEBUG
		move.b	#$aa,-4(a0,d2.l)		Check value
		move.l	CallersRA(a7),(a0)+		Callers return address
  endc
		move.l	d2,(a0)+			Remember size
		lea.l	MemList(a4),a1			Our administration base
		move.l	(a1),a2				Old Node1 becomes Node2
		move.l	a0,LN_PRED(a2)			Node1 into Node2.LN_PRED
		move.l	a0,(a1)				Node1 into List.LN_HEAD
		move.l	a2,(a0)+			Node2 into Node1.LN_SUCC
		move.l	a1,(a0)+			List into Node1.LN_PRED
		move.l	a0,d0				Return pointer to free block

AM_Rtn		movem.l	(a7)+,d2/d3/a2/a6
		rts


*********************************************************
*
*  --  FreeM  --
*

 Func	_Free
 Func	_FreeMA

		cmp.w	#0,a1
		beq.s	FM_Rtn

		movem.l	a6/a2,-(a7)
		move.l	-(a1),a0			Node0
		move.l	-(a1),a2			Node2
		move.l	a0,LN_PRED(a2)			Node0 predecessor of Node2
		move.l	a2,(a0)				Node2 successor of Node0
		move.l	-(a1),d0			Size
  ifd	DEBUG
		subq.l	#4,a1				Callers return address
		cmp.b	#$aa,-4(a1,d0.l)		Check value
		beq.s	FM_CheckOK			No error..
		movem.l	d0/a1,-(a7)			Keep size and location
		move.l	a1,-(a7)			Location as parameter
		jsr	_MemError(pc)
		addq.l	#4,a7
		movem.l	(a7)+,d0/a1			Restore size and location
FM_CheckOK
  endc
		move.l	4,a6
		jsr	_LVOFreeMem(a6)
		movem.l	(a7)+,a6/a2

FM_Rtn		rts		


*********************************************************
*
*  --  FreeMAll
*

 Func	_FreeMAll

		movem.l	a2-a3/a6,-(a7)
		move.l	4,a6
		lea.l	MemList(a4),a2

FMA_TestList	cmp.l	LH_TAILPRED(a2),a2
		beq.s	FMA_Rtn
		move.l	(a2),a1
		movem.l	(a1),a0/a3			Succ/Pred
		move.l	a0,(a3)				Pred gets new Succ
		move.l	a3,LN_PRED(a0)			Succ gets new Pred
		move.l	-(a1),d0			Size
  ifd	DEBUG
		subq.l	#4,a1				Callers return address
		cmp.b	#$aa,-4(a1,d0.l)		Check value
		beq.s	FMA_CheckOK			No error..
		movem.l	d0/a1,-(a7)			Keep size and location
		move.l	a1,-(a7)			Location as parameter
		jsr	_MemError(pc)
		addq.l	#4,a7
		movem.l	(a7)+,d0/a1			Restore size and location
FMA_CheckOK
  endc
		jsr	_LVOFreeMem(a6)
		bra.s	FMA_TestList

FMA_Rtn		movem.l	(a7)+,a2-a3/a6
		rts


*********************************************************

		SECTION	__MERGED,data

MemList
ML_Head		dc.l	ML_Tail
ML_Tail		dc.l	0
ML_TailPred	dc.l	ML_Head

		END