home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of A1200
/
World_Of_A1200.iso
/
programs
/
misc
/
enote
/
source.lha
/
source
/
memory.a
< prev
next >
Wrap
Text File
|
1995-01-10
|
4KB
|
170 lines
*
* 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