вот, давно хотел сделать блокирование повторного входа в секцию.
(можно посмотреть на использование (BOX)
\ 15.04.2009 ~mOleg
\ Сopyright [C] 2009 mOleg mininoleg@yahoo.com
\ блокирование повторного исполнения секций кода между потоками Форт-системы
memory/ box.fts \ мне все больше нравится эта либа!
\ используя addr как начало блокируемой секции с мьютексом в начале секции
\ выполнить одно из двух действий: если мьютекс (а это глобальная переменная)
\ не занят, занять его, и передать управление на блокируемую секцию, после
\ выполнения мьютекс освобождается, и возвращается флаг false успешности
\ завершения операции. В противном случае, то есть мьютекс уже занят, выйти
\ на точку PERMIT с ошибкой. Ошибка так же возвращается, если возникла ошибка
\ во время выполнения кода в блокируемой секции.
: (PERMIT) ( addr --> false | err )
DUP >R ?LockMutex
IF R@ CELL + CATCH R> UnlockMutex
ELSE RDROP NOTICE" Исполнение секции заблокировано!"
THEN ;
\ начать описание блокируемой секции
: BAN ( --> ) BOX{ 0 , ; IMMEDIATE
\ завершить описание блокируемой секции
: PERMIT ( --> 0 | err ) RET, }BOX COMPILE (PERMIT) ; IMMEDIATE
?DEFINED test{ \EOF -- тестовая секция ---------------------------------------
.\lib\vocs\compile.fts
test{
: sample-a 720498 BAN 402984 PERMIT 598750 ;
sample-a 598750 <> THROW THROW 402984 <> THROW 720498 <> THROW
: sample-b 720498 BAN 94875 THROW PERMIT 598750 ;
sample-b 598750 <> THROW 94875 <> THROW 720498 <> THROW
: sample-c 720498 BAN 402984 RECURSE PERMIT 598750 ;
\ тут RECURSE, чтобы не возиться с многозадачностью
sample-c 598750 <> THROW THROW 598750 <> THROW 0 = THROW
720498 <> THROW 402984 <> THROW 720498 <> THROW
}test
</pre>
кстати box тоже изменился чуточку:
<pre>
\ 2009-02-05 ~mOleg
\ Сopyright [C] 2009 mOleg mininoleg@yahoo.com
\ контейнеры с данными внутри кода
\ обойти данные в коде, начинающиеся со следующей ячейки,
\ вернуть адрес начала данных
\ : (BOX) ( r: addr --> addr ) AR@ CELL + AR@ @ R+ ;
\ для использования в других структурах не-immediate варианты BOX[ ]BOX
: BOX{ ( --> l: addr ) ?COMP COMPILE (BOX) HERE >L 0 , ;
: }BOX ( l: addr --> ) HERE L@ - L> ! ;
\ начать описание контейнера
: BOX[ ( --> l: addr ) BOX{ [COMPILE] [ ; IMMEDIATE
\ завершить описание контейнера, зафиксировать его размер,
\ вернуться к состоянию компиляции
: ]BOX ( l: addr --> ) }BOX ] ; IMMEDIATE
?DEFINED test{ \EOF -- тестовая секция ---------------------------------------
test{ : test 479875 BOX[ 49857 , -1984 , 564757 , ]BOX 98374 ;
test 98374 <> THROW SWAP 479875 <> THROW
DUP @ 49857 <> THROW
DUP CELL + @ -1984 <> THROW
2 CELLS + @ 564757 <> THROW
}test