Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Пн окт 14, 2019 21:53

...
Google Search
Forth-FAQ Spy Grafic

Часовой пояс: UTC + 3 часа [ Летнее время ]




Ответить
Имя пользователя:
Заголовок:
Текст сообщения:
Введите текст вашего сообщения. Длина сообщения в символах не более: 60000

Размер шрифта:
Цвет шрифта
Настройки:
BBCode ВКЛЮЧЕН
[img] ВЫКЛЮЧЕН
[flash] ВЫКЛЮЧЕН
[url] ВКЛЮЧЕН
Смайлики ВЫКЛЮЧЕНЫ
Отключить в этом сообщении BBCode
Не преобразовывать адреса URL в ссылки
Вопрос
Теперь гостю придется вводить здесь пароль. Не от своей учетной записи, а ПАРОЛЬ ДЛЯ ГОСТЯ, получить который можно после регистрации на форуме через ЛС.:
Этот вопрос предназначен для выявления и предотвращения автоматических регистраций.
   

Обзор темы - Реализация сопрограмм на форте
Автор Сообщение
  Заголовок сообщения:  Re: Реализация сопрограмм на форте  Ответить с цитатой
diver писал(а):
А просто несколько потоков бы не прокатило бы?)

Не-а)
Потоки и сопрограммы это разные вещи
Сообщение Добавлено: Вс фев 24, 2019 11:52
  Заголовок сообщения:  Re: Реализация сопрограмм на форте  Ответить с цитатой
А просто несколько потоков бы не прокатило бы?)
Сообщение Добавлено: Вс фев 24, 2019 11:38
  Заголовок сообщения:  Реализация сопрограмм на форте  Ответить с цитатой
Думал над некоторыми операциями парсинга и вспомнил, что некоторые вещи удобно решать с помощью сопрограмм.
Вот реализовал на Нове. Код несложный можно портировать и на СПФ при желании.

Код затачивался под "синхронное" исполнение итераторов, поэтому у каждой сопрограммы свой стек возвратов
Код:
~ER\data-stack\REVERSE.F
~ER\STRUCT\STRUCT-SUGAR.F


USER-VALUE coop-stack

STRUCT: coop-struct
CELL -- LAST-RP      \ точка сброса. "выход" из сопрограмм
CELL -- countC      \ сколько всего сопрограмм
CELL -- currentC   \ номер текущей сопрограммы
STRUCT;

: coop-addr coop-stack coop-struct + ;

\ каждый элемент стека сопрограмм включает позицию присваиваемую указателю стека возвратов
\ и указатель на выделенную память под стек возвратов
STRUCT: coop-elem
CELL -- pos
CELL -- mem
STRUCT;

\ перенести позицию и память на стек сопрограмм
: >coopS \ pos mem --
coop-stack countC @ coop-elem *
coop-addr
+
>R
R@ mem !
R@ pos !
RDROP
coop-stack countC 1+!
;

\ безусловный переход на след. сопрограмму
: COOP-JMP      
coop-stack currentC 1+!
coop-stack currentC @
coop-stack countC @
= IF
coop-stack currentC 0!
coop-addr pos @
ELSE
coop-stack currentC @ coop-elem * 
coop-addr
+
pos @
THEN
RP!
;

\ освободить стеки возвратов и выделенную память под сопрограммы
: COOP-FREE
coop-stack countC @ >R
coop-addr
BEGIN R@ WHILE
DUP mem @ FREE THROW
coop-elem +
-1 RP@ +!
REPEAT
RDROP DROP
coop-stack FREE THROW
;


: COOP-EXIT      \ выйти из ВСЕХ сопрограмм. действие по умолчанию
coop-stack LAST-RP @ RP!
COOP-FREE
0   \ в >COOP перехват ошибок, это для THROW
;

: >COOP \ xt1 xt2 .. xtn n
DUP 30 > IF S" many cooprogramms" DROP THROW THEN
['] THROW >R

   coop-struct
   30 coop-elem *
   +
   ALLOCATE THROW
   FROM coop-stack KEEP!
RP@ coop-stack LAST-RP !
-1 coop-stack currentC !      \ поскольку COOP-JMP инкрементирует
>R
coop-stack countC 0!
R@ REVERSE
BEGIN R@ WHILE
980 CELLS 1000 CELLS ALLOCATE THROW   \ -- смещение память
DUP >R + R>            \ смещение память -- позиция память
2DUP >coopS

DROP >R               \ нужна только позиция
R@ !                \ записываем в позицию xt
['] COOP-EXIT R> CELL+ !      \ записываем за xt код безусловного выхода. Стек растёт вниз
-1 RP@ +!
REPEAT
RDROP
['] COOP-JMP CATCH
coop-stack LAST-RP @ RP!
COOP-FREE
;

\ передать управление следующей сопрограмме. После завершения сопрограмм управление передастся коду после COOP-NEXT
: COOP-NEXT
RP@
   coop-stack currentC @ coop-elem *
   coop-stack coop-struct +
   +
   pos !
COOP-JMP
;


Тестовый пример
Код:
\ инициализация матрицы

~er\array\matrix.f

~ER\LAMBDA\L-CODE.F

10 10 HEAP-MATRIX VALUE M

: TEST
L{ 100 0->n COOP-NEXT }L
L{ 10 0->n ['] DROP >R 10 0->n OVER >R COOP-NEXT R> }L
L{ BEGIN M ELEM-ADDR ! COOP-NEXT AGAIN }L
3 >COOP
M TYPE-intMATRIX
;


Вложения:
coop.F [2.63 Кб]
Скачиваний: 327
Сообщение Добавлено: Чт фев 07, 2019 22:41

Часовой пояс: UTC + 3 часа [ Летнее время ]


Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
phpBB сборка от FladeX // Русская поддержка phpBB