buildsna : bankset 0 : org #100 : run #100 : di : ld sp,#100

ld hl,#C000 ; HEAP dans la mémoire vidéo!
ld bc,16384 ; on prend les 16k
call memoryInit

repeat 8,x,0
ld b,0 : ld a,r : or 16 : ld c,a
call memoryAlloc : ld (ptrlist+x*4),hl : ld (ptrlist+2+x*4),bc
ld (hl),#FF : ld de,hl : inc de : dec c : ldir
rend

stressTest
ld c,10
.revbl ld b,#F5
.novbl in a,(c) : rra : jr c,.novbl
.vbl in a,(c) : rra : jr nc,.vbl : dec c : jr nz,.revbl

ld ix,ptrlist
.getAlmost ld hl,almost : ld a,(hl) : inc l : ld (.getAlmost+1),hl : and 7 : add a : add a : add xl : ld xl,a ; IX=pointeur dans la liste

ld bc,(ix+2) ; BC=taille allouée
ld a,b : or c : jr z,.allouer ; vide, on alloue
; libérer mais d'abord effacer
ld hl,(ix+0) : ld (hl),0 : ld de,hl : inc de : dec c : ldir : ld (ix+2),bc ; effacer la taille pour indiquer la libération
ld hl,(ix+0) : call memoryFree
jr stressTest

.allouer
push ix : ld a,r : and #1F : add 16 : ld c,a : call memoryAlloc : pop ix
ld (ix+0),hl : ld (ix+2),bc
ld (hl),#FF : ld de,hl : inc de : dec c : ldir
jr stressTest


confine 32
ptrlist defs 32 ; 8 pointeurs+8tailles

align 256 ; mélange de fisher yates
almost defb 137,42,198,7,224,91,153,12,65,240,33,176,58,209,14,187, 99,3,231,120,54,168,201,77,5,146,89,250,31,162,73,216, 140,18,222,104,67,195,28,245,10,156,84,226,47,132,170,61, 238,2,149,93,180,36,211,70,253,25,160,115,44,199,8,134, 220,57,172,96,13,243,75,188,30,155,68,207,101,52,229,6, 164,87,248,41,121,190,15,218,63,177,109,34,252,80,143,4, 196,66,237,23,159,98,213,46,171,119,32,241,85,150,9,200, 60,223,136,78,254,27,183,92,145,11,214,53,167,103,230,1, 126,35,247,82,192,69,156,21,174,95,208,48,135,244,16,181, 72,210,38,165,100,233,26,142,59,217,90,173,64,239,19,151, 76,225,45,130,205,55,186,97,12,234,83,157,39,221,102,169, 20,246,71,184,56,197,29,138,242,88,161,49,212,105,232,17, 147,62,249,94,178,24,203,74,189,40,163,107,255,86,228,51, 175,118,37,206,81,154,14,241,67,131,202,43,182,111,236,58, 215,96,123,8,191,52,166,73,139,219,22,204,61,148,235,79, 110,27,193,69,158,34,251,90,176,125,53,200,7,185,112,241


guruMeditation brk : jr $ ; breaker l'émulateur en cas de non allocation mémoire


struct memblock
taille defw ; taille utile (hors entête)
suivant defw ; bloc libre suivant
endstruct 

free_list defw 0 ; pas de mémoire disponible par défaut

memoryInit
; HL=début du bloc
; BC=taille du bloc
ld (free_list),hl
dec bc : dec bc : dec bc : dec bc ; corriger d'une taille d'entête
ld (hl),c : inc hl : ld (hl),b : inc hl
ld (hl),0 : inc hl : ld (hl),0 ; pas d'autre bloc libre
ret

memoryAlloc
; BC=taille souhaitée
ld ix,(free_list) : ld iy,0
.boucleSurLesBlocs
ld a,xh : or xl : jp z,guruMeditation ; plus de mémoire disponible
; est-ce que le bloc courant est assez grand?
ld hl,(ix+memblock.taille)
sbc hl,bc : jp m,.blocSuivant
; est-ce qu'on va découper le bloc?
ld hl,(ix+memblock.taille) : dec hl : dec hl : dec hl : dec hl
sbc hl,bc : jp m,.blocEntier : jr nz,.decoupeBloc
.blocEntier
ld hl,(ix+memblock.suivant)
ld a,yl : or yh : jr z,.entierMAJFreeList; A-t'on déjà lu un bloc avant celui là?
ld (iy+memblock.suivant),hl
.renvoieZone ld hl,{sizeof}memblock : ld de,ix : add hl,de : ret ; HL=zone mémoire allouée
.entierMAJFreeList ld (free_list),hl : jr .renvoieZone

.decoupeBloc
; on créé un nouveau bloc HL dans le bloc courant + size
ld de,ix : ld hl,4 : add hl,de : add hl,bc ; HL=nouveau bloc
; on relie ce nouveau bloc à free_list ou au bloc précédent
ld a,yl : or yh : jr z,.decoupeMAJFreeList
ld (iy+memblock.suivant),hl : jr .apresLien
.decoupeMAJFreeList ld (free_list),hl
.apresLien
push hl : pop iy ; IY=nouveau bloc (plus besoin du précédent ici)
ld hl,(ix+memblock.taille) : sbc hl,bc : ld de,-{sizeof}memblock : add hl,de : ld (iy+memblock.taille),hl
ld hl,(ix+memblock.suivant) : ld (iy+memblock.suivant),hl
ld (ix+memblock.taille),bc
ld hl,{sizeof}memblock : ld de,ix : add hl,de : ret ; HL=zone mémoire allouée

.blocSuivant ; IY=IX, IX=IX.suivant
push ix : ld de,(ix+memblock.suivant) : ld ix,de : pop iy
jp .boucleSurLesBlocs 


memoryFree
; HL=pointeur à libérer
ld bc,-4 : add hl,bc ; HL=bloc du pointeur à libérer
ld bc,0 ; init du bloc précédent
ex hl,de : ld hl,(free_list) ; DE=bloc à libérer HL=premier bloc de la liste

.chercheInsertion ld a,h : or l : jr z,.trouveInsertion
or a : sbc hl,de : add hl,de ; CP HL,DE
jp p,.trouveInsertion
ld bc,hl ; précédent=courant
inc hl : inc hl : ld a,(hl) : inc hl : ld h,(hl) : ld l,a ; courant=courant.suivant
jr .chercheInsertion

.trouveInsertion
ld ix,de ; IX=bloc à libérer
ld (ix+memblock.suivant),hl ; le bloc à libérer pointe vers le suivant
ld a,b : or c : jr z,.pasDePrecedent
ld iy,bc : ld (iy+memblock.suivant),de : jr .depuisPrecedent
.pasDePrecedent ld (free_list),de : .depuisPrecedent
; notre cellule est liée

; test de fusion avec le suivant si il y a un suivant
ld a,(ix+memblock.suivant) : or (ix+memblock.suivant+1) : jr z,.pasDeSuivant
ld hl,4 : add hl,de : ld bc,(ix+memblock.taille) : add hl,bc : ld bc,(ix+memblock.suivant) : sbc hl,bc : jr nz,.pasDeSuivant
ld de,(ix+memblock.taille) : inc de : inc de : inc de : inc de ; bloc.taille+4
ld hl,(ix+memblock.suivant) : ld a,(hl) : inc hl : ld h,(hl) : ld l,a ; bloc.suivant.taille
add hl,de : ld (ix+memblock.taille),hl ; taille fusionnée
ld hl,(ix+memblock.suivant) : inc hl : inc hl : ld a,(hl) : inc hl : ld h,(hl) : ld l,a ; bloc.suivant.suivant
ld (ix+memblock.suivant),hl ; bloc suivant retiré de la liste et son suivant copié dans le bloc courant
.pasDeSuivant

; test de fusion avec le précédent, si il en existe un
ld a,yl : or yh : ret z
ld hl,4 : ld de,iy : add hl,de : ld de,(iy+memblock.taille) : add hl,de : ld de,ix : sbc hl,de : ret nz
ld hl,(iy+memblock.taille) : ld de,(ix+memblock.taille) : add hl,de : ld de,4 : add hl,de : ld (iy+memblock.taille),hl
ld hl,(ix+memblock.suivant) : ld (iy+memblock.suivant),hl
ret