Отправляет email-рассылки с помощью сервиса Sendsay

Язык программирования (и ОС) ФОРТ (FORTH)

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Виртуальный офис - дома" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Май 2006   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
ПонятОв Дмитрий

Статистика

1 подписчиков
0 за неделю
←   Все выпуски   →

Язык программирования (и ОС) ФОРТ (FORTH) написал альфа-версию аллокатора памяти для os


написал альфа-версию аллокатора памяти для os (нет слияния смежных свободных блоков памяти).
http://akps.ssau.ru/forth/os/

\ heap manager & lists

_heap const heap

0 const Nil

: list 0 var ; \ create list (variable with addr of first item or Nil)

list used \ used mem blocks list
list free \ free mem blocks list

{ mem/headsz ( -- n ) cell cell + } \ memblock header size
{ mem/next ( item1 -- item2 ) } \ next item in list addr
{ mem/sz ( item -- sz ) cell + } \ size of memblock data
{ mem/data ( item -- data ) mem/headsz + } \ memblock -> data

{ list. ( list -- )
\ print list (list = addr of list var points to first item or Nil)
begin
@ \ fetch next item
dup Nil <> \ check is it end of list
while
dup h. \ list item addr
." : "
dup mem/sz @ h. \ list item data size
[tab] emit
repeat drop cr
}

{ list/append ( item list -- )
\ append item to end of list
over over
@ swap mem/next ! \ list.lastitem -> item.next
! \ item -> list
}

0 var (item)

{ (list/remove/mid) ( list -- )
\ remove item from mid of list: modify item where item.next points to (item)
begin
@
dup Nil <>
while
dup ( curr ) mem/next @ (item) @ ( next item ) = if
dup mem/next \ get .next field addr
(item) @ mem/next @ \ get .next field value of (item)
swap ! \ curr.next=item.next -> post
then
repeat drop
}

{ (list/remove/first) ( list -- )
\ remove first item from list
dup @ @ swap !
}

{ list/remove ( item list -- )
\ remove item from list
swap (item) !
\ if item is first in list
dup ( list ) @ (item) @ <> if
(list/remove/mid) \ remove item from mid of list
else
(list/remove/first) \ remove first item from list
then
}

{ mem/init ( -- )
\ initialize heap manager
Nil heap @ mem/next !
memsz heap @ - mem/headsz - heap @ mem/sz !
heap @ free !
Nil used !
}

{ mem/endcut ( mem count -- )
\ cut off count bytes from end of mem
swap ( count mem )
mem/sz ( count mem/sz )
dup @ ( count mem/sz oldsz )
rot ( mem/sz oldsz count )
- swap !
}

0 var mem/need \ requested block size, bytes
0 var mem/found \ found free block flag
0 var mem/newblock \ addr of new allocated block

{ mem/alloc ( n -- mem|Nil )
\ allocate memory block
( n ) mem/need ! \ save need bytes to var
F mem/found ! \ clear found block flag
Nil mem/newblock !

\ loop over "free" list
free
begin
@
dup Nil <> \ while not end of list
mem/found @ 0 # = and \ and mem/found==F
while
dup mem/sz @ ( item.sz ) \ \ if current free block size more then
mem/need @ ( need ) \ / requested, allocate part of free block
u> if
T mem/found ! \ set found flag to T
\ cut some memory from the end of current free block
\ (use part of free block as memory for allocated&used block)
( freeblock )
dup mem/need @ mem/headsz + ( fb need+headsz ) mem/endcut
\ found addr of new block & save it to mem/newblock
dup ( fb fb )
dup mem/sz @ + ( fb fb+fbsz )
mem/headsz + ( fb db+fbsz+headsz=newblock )
mem/newblock ! ( fb )
then
repeat drop

\ if block was found, create new block header & return it
mem/found @ if
mem/newblock @ used list/append \ append new block to "used"
mem/need @ mem/newblock @ mem/sz ! \ set new block sz
mem/newblock @ \ return new block
else
Nil \ else return Nil
then
}

{ mem/free/defragmenter ( -- )
\ merge continuous blocks in "free" list, or you'll get memory leak
\ this word is TODO
}

{ mem/free ( mem -- )
\ free allocated block
\ remove block from "used" list
dup ( mem ) used list/remove
\ append block to "free" list
( mem ) free list/append
\ merge continuous blocks in "free" list, or you'll get memory leak
mem/free/defragmenter
}

{ z.
." used: " used list.
." free: " free list.
cr
}

0 var (1)
0 var (2)
0 var (3)
{ z
mem/init
z.
0x123 # mem/alloc (1) !
0x456 # mem/alloc (2) !
0x789 # mem/alloc (3) !
z.
(2) @ mem/free
z.
(3) @ mem/free
z.
bye
}
В избранное