Думал над некоторыми операциями парсинга и вспомнил, что некоторые вещи удобно решать с помощью сопрограмм.
Вот реализовал на Нове. Код несложный можно портировать и на СПФ при желании.
Код затачивался под "синхронное" исполнение итераторов, поэтому у каждой сопрограммы свой стек возвратов
Код:
~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
;