очередная инкарнация стековых манипуляторов. Чем отличается от реализации chess-a?
Это скорее модель для исследования, тестов и проб. Реализация по сравнению
с оригинальной от chess-a более громоздка, состоит из множества слов - 5 базовых
слов ( sm.tst? sm.load sm.comp sm,,,] sm, ) и кучи мелких вспомагательных
слов, которые можно иногда использовать для повышения быстродействия и
оптимизации. Реализация не зависит от каких-либо специфичных либ и может быть
легко портируема на другие Форты. Основное отличие от предыдущих версий -
модификация CASE - теперь анализируем не посимвольно, а как подстроку с текущей
позиции. Это позволяет легко определять в конструкции CASE группы из 2 символов
с префиксов ' и группы из 3 символов с префиксом " и привязывать к ним определенные
компилирующие действия. Некоторая перегруппировка - определения m- i- p- @- !- блоков
перемещены до определения стекового манипулятора, чтобы иметь возможность использовать
их внутри манипулятора. пример : x0 4 5 6 1/[123i]1.2.3. ; либо : x1 4 5 6 1/[3\]1.2.3. ;
что можно прочитать так - устанавливаем для манипулятора буфер 1, загружаем три числа со
стека в ячейки 1,2 и 3 и затем печаем их содержимое.
Код:
USER-CREATE /d0/ 10 10 * CELLS USER-ALLOT USER /d/ /d0/ /d/ !
USER /org USER /beg USER /cur USER /lim USER /a/ USER /u/ VECT sm,
: SPDROP ( n -- ) [ BASE @ HEX C1 C, E0 C, 02 C, 03 C, E8 C, 8B C, 45 C, 00 C, 8D C, 6D C, 04 C, C3 C, BASE ! ] ;
: SPMOVE ( a n -- ) [ BASE @ HEX 8D C, 5D C, 04 C, 8B C, 55 C, 00 C, 8B C, 0B C, 89 C, 0A C, 8D C, 52 C, 04 C,
8D C, 5B C, 04 C, 48 C, 75 C, F3 C, 8B C, 45 C, 04 C, 8D C, 6D C, 08 C, C3 C, BASE ! ] ;
\ непосредственно установка рабочего буфера(кадра) ( 0 d!, 1 d! ...9 d! ):
: d! ( n -- ) 10 * CELLS /d0/ + /d/ ! ;
\ Слово __ надо использовать для реентерабельных целей просто переустанавливает
\ указатель /d/ и готовит возврат к предыдущему буферу(кадру) при выходе из слова
\ с манипулятором (такой простейший стек).
: __RET -10 CELLS /d/ +! ; : __ 10 CELLS /d/ +! R> ['] __RET >R >R ;
\ доступ к адресам ячеек
: '0 /d/ @ 36 + ; : '1 /d/ @ 32 + ; : '2 /d/ @ 28 + ; : '3 /d/ @ 24 + ;
: '4 /d/ @ 20 + ; : '5 /d/ @ 16 + ; : '6 /d/ @ 12 + ; : '7 /d/ @ 8 + ;
: '8 /d/ @ 4 + ; : '9 /d/ @ ;
\ копирование значений со стека данных в последовательные ячейки манипулятора
: 0| ; : 0\ ; : 1| /d/ @ 32 + 1 SPMOVE ; : 2| /d/ @ 28 + 2 SPMOVE ;
: 3| /d/ @ 24 + 3 SPMOVE ; : 4| /d/ @ 20 + 4 SPMOVE ; : 5| /d/ @ 16 + 5 SPMOVE ;
: 6| /d/ @ 12 + 6 SPMOVE ; : 7| /d/ @ 8 + 7 SPMOVE ; : 8| /d/ @ 4 + 8 SPMOVE ;
: 9| /d/ @ 9 SPMOVE ;
\ загрузка значений со стека данных в последовательные ячейки манипулятора
: 1\ /d/ @ 32 + 1 SPMOVE 1 SPDROP ; : 2\ /d/ @ 28 + 2 SPMOVE 2 SPDROP ; : 3\ /d/ @ 24 + 3 SPMOVE 3 SPDROP ;
: 4\ /d/ @ 20 + 4 SPMOVE 4 SPDROP ; : 5\ /d/ @ 16 + 5 SPMOVE 5 SPDROP ; : 6\ /d/ @ 12 + 6 SPMOVE 6 SPDROP ;
: 7\ /d/ @ 8 + 7 SPMOVE 7 SPDROP ; : 8\ /d/ @ 4 + 8 SPMOVE 8 SPDROP ; : 9\ /d/ @ 9 SPMOVE 9 SPDROP ;
\ вспомагательные слова
: dg? ( a -- f ) C@ [CHAR] 0 [CHAR] 9 1+ WITHIN ;
: [c,] ( C -- ) 48 - 9 SWAP - CELLS LIT, ;
: [d,] ['] /d/ COMPILE, ['] @ COMPILE, ['] + COMPILE, ;
: [p,] 2- LIT, ['] PICK COMPILE, ;
: num? ( a u -- f ) OVER DUP dg? SWAP C@ [CHAR] - = OR -ROT OVER SWAP 1 D+ ?DO I dg? AND LOOP ;
: NOTFOUND ( A U -- ) \ m-block
2DUP /u/ ! /a/ ! + 1- C@ [CHAR] _ = /u/ @ 1 > AND 0= IF /a/ @ /u/ @ NOTFOUND EXIT THEN
/a/ @ DUP /cur ! /u/ @ + 2- /lim ! BEGIN sm, /cur @ /lim @ <> WHILE /cur 1+! REPEAT ;
: NOTFOUND ( A U -- ) \ i-block
/u/ ! /a/ ! /a/ @ /u/ @ + 1- DUP C@ [CHAR] i = SWAP /a/ @ ?DO I dg? AND LOOP 0= IF /a/ @ /u/ @ NOTFOUND EXIT THEN
/a/ @ DUP /u/ @ + 2- DO I C@ [c,] [d,] ['] ! COMPILE, -1 +LOOP ;
: NOTFOUND ( A U -- ) \ p-block
/u/ ! /a/ ! /a/ @ /u/ @ + 1- DUP C@ [CHAR] p = SWAP /a/ @ ?DO I dg? AND LOOP 0= IF /a/ @ /u/ @ NOTFOUND EXIT THEN
2 /a/ @ DUP /u/ @ + 2- DO DUP [p,] I C@ [c,] [d,] ['] ! COMPILE, 1+ -1 +LOOP DROP ;
: NOTFOUND ( A U -- ) \ @-block
/u/ ! /a/ ! /u/ @ 2 MOD 1 = /a/ @ /u/ @ 2/ + C@ [CHAR] @ = AND /u/ @ 2/ /a/ @ + /a/ @ ?DO I dg? AND LOOP
/a/ @ /u/ @ + /a/ @ /u/ @ 2/ + 1+ ?DO I dg? AND LOOP 0= IF /a/ @ /u/ @ NOTFOUND EXIT THEN
/u/ @ 2/ 1+ /org ! /u/ @ 2/ /a/ @ + /a/ @
?DO I C@ [c,] [d,] ['] @ COMPILE, ['] @ COMPILE, I /org @ + C@ [c,] [d,] ['] @ COMPILE, I C@ [c,] [d,] ['] +! COMPILE, LOOP ;
: NOTFOUND ( A U -- ) \ !-block
/u/ ! /a/ ! /u/ @ 2 MOD 1 = /a/ @ /u/ @ 2/ + C@ [CHAR] ! = AND /u/ @ 2/ /a/ @ + /a/ @
?DO I dg? AND LOOP /a/ @ /u/ @ + /a/ @ /u/ @ 2/ + 1+ ?DO I dg? AND LOOP 0= IF /a/ @ /u/ @ NOTFOUND EXIT THEN
/u/ @ 2/ 1+ /org ! /u/ @ 2/ /a/ @ + /a/ @ ?DO I C@ [c,] [d,] ['] @ COMPILE, ['] ! COMPILE, I /org @ + C@ [c,] [d,] ['] @ COMPILE, I C@ [c,] [d,] ['] +! COMPILE, LOOP ;
: 'parse
/cur 1+!
/cur @ dg? IF /cur @ C@ [c,] [d,] EXIT THEN
/cur @ 2 num? IF /cur @ 2 ?SLITERAL1 /cur 1+! EXIT THEN
/cur @ 2 SFIND 0= IF NOTFOUND ELSE COMPILE, /cur 1+! THEN ;
: "parse
/cur 1+!
/cur @ 3 num? IF /cur @ 3 ?SLITERAL1 /cur 2 /cur +! DROP EXIT THEN
/cur @ 3 SFIND 0= IF NOTFOUND ELSE COMPILE, 2 /cur +! THEN ;
: sm.tst? ( a u -- f ) /u/ ! DUP /a/ ! dg? /a/ @ 1+ DUP DUP C@ [CHAR] \ = SWAP C@ [CHAR] | = OR SWAP C@ [CHAR] / = OR AND /u/ @ 2 > AND ;
: sm.load ( a u -- beg end ) /a/ @ C@ 48 - /org !
/a/ @ 1+ C@ [CHAR] / = IF /org @ LIT, ['] d! COMPILE, ELSE
/org @ 0<> IF /a/ @ C@ [c,] [d,] /org @ LIT, ['] SPMOVE COMPILE,
/a/ @ 1+ C@ [CHAR] \ = IF /org @ LIT, ['] SPDROP COMPILE, THEN THEN THEN
/a/ @ 2+ /beg ! /a/ @ /u/ @ + /lim ! ;
: sm.comp /beg @ /cur ! BEGIN sm, /lim @ /cur @ <> WHILE /cur 1+! REPEAT ;
: sm,,,] /cur @ 1+ /beg ! BEGIN /cur @ 1+ C@ [CHAR] ] <> WHILE /cur 1+! REPEAT
/cur 1+! /beg @ /cur @ OVER - sm.tst? IF sm.load sm.comp ELSE /a/ @ /u/ @ SFIND 0= IF NOTFOUND ELSE COMPILE, THEN THEN ;
\ Lambda. код внутри конструкции LAMBDA{ }LAMBDA не выполняется, возвращается xt на этот код.
: LAMBDA{ ( -- ) LAST-NON HERE BRANCH, >MARK 2 HERE DUP TO LAST-NON ; IMMEDIATE
: }LAMBDA ( -- xt ) >R POSTPONE EXIT POSTPONE THEN R> POSTPONE LITERAL TO LAST-NON ; IMMEDIATE
: S' [CHAR] ' PARSE [COMPILE] SLITERAL ; IMMEDIATE
: ?? ( a u -- f ) SWAP OVER /cur @ OVER COMPARE 0= IF 1- /cur +! 0 THEN ;
: op, ( -- )
0 CASE
S" ((" ?? OF POSTPONE LAMBDA{ ENDOF
S" ))" ?? OF POSTPONE }LAMBDA ENDOF
S' "gav' ?? OF S" gav-gav!" SLIT, ['] TYPE COMPILE, ENDOF
S" 'ku" ?? OF S" ku-ku!" SLIT, ['] TYPE COMPILE, ENDOF
S" 0" ?? OF 36 LIT, [d,] ['] @ COMPILE, ENDOF
S" 1" ?? OF 32 LIT, [d,] ['] @ COMPILE, ENDOF
S" 2" ?? OF 28 LIT, [d,] ['] @ COMPILE, ENDOF
S" 3" ?? OF 24 LIT, [d,] ['] @ COMPILE, ENDOF
S" 4" ?? OF 20 LIT, [d,] ['] @ COMPILE, ENDOF
S" 5" ?? OF 16 LIT, [d,] ['] @ COMPILE, ENDOF
S" 6" ?? OF 12 LIT, [d,] ['] @ COMPILE, ENDOF
S" 7" ?? OF 8 LIT, [d,] ['] @ COMPILE, ENDOF
S" 8" ?? OF 4 LIT, [d,] ['] @ COMPILE, ENDOF
S" 9" ?? OF 0 LIT, [d,] ['] @ COMPILE, ENDOF
S" +" ?? OF ['] + COMPILE, ENDOF \ арифметика
S" -" ?? OF ['] - COMPILE, ENDOF
S" *" ?? OF ['] * COMPILE, ENDOF
S" /" ?? OF ['] / COMPILE, ENDOF
S" %" ?? OF ['] MOD COMPILE, ENDOF
S" :" ?? OF ['] /MOD COMPILE, ENDOF
S" _" ?? OF ['] NEGATE COMPILE, ENDOF
S" |" ?? OF ['] OR COMPILE, ENDOF \ логика и сдвиги
S" ^" ?? OF ['] XOR COMPILE, ENDOF
S" &" ?? OF ['] AND COMPILE, ENDOF
S" ~" ?? OF ['] INVERT COMPILE, ENDOF
S" }" ?? OF ['] RSHIFT COMPILE, ENDOF
S" {" ?? OF ['] LSHIFT COMPILE, ENDOF
S" !" ?? OF ['] ! COMPILE, ENDOF \ память
S" @" ?? OF ['] @ COMPILE, ENDOF
S" b" ?? OF ['] C@ COMPILE, ENDOF
S" w" ?? OF ['] C! COMPILE, ENDOF
S" V" ?? OF ['] MOVE COMPILE, ENDOF
S" F" ?? OF ['] FILL COMPILE, ENDOF
S" a" ?? OF ['] ALLOCATE COMPILE, ENDOF
S" f" ?? OF ['] FREE COMPILE, ENDOF
S" r" ?? OF ['] RESIZE COMPILE, ENDOF
S" o" ?? OF ['] THROW COMPILE, ENDOF
S" h" ?? OF ['] HERE COMPILE, ENDOF
S" =" ?? OF ['] = COMPILE, ENDOF \ сравнения
S" >" ?? OF ['] > COMPILE, ENDOF
S" <" ?? OF ['] < COMPILE, ENDOF
S" z" ?? OF ['] 0<> COMPILE, ENDOF
S" Z" ?? OF ['] 0= COMPILE, ENDOF
S" m" ?? OF ['] MIN COMPILE, ENDOF
S" M" ?? OF ['] MAX COMPILE, ENDOF
S" H" ?? OF ['] WITHIN COMPILE, ENDOF
S" d" ?? OF ['] DUP COMPILE, ENDOF \ копирование и удаление в стеке
S" x" ?? OF ['] DROP COMPILE, ENDOF
S" p" ?? OF ['] DEPTH COMPILE, ENDOF
S" Y" ?? OF ['] TRUE COMPILE, ENDOF
S" y" ?? OF ['] FALSE COMPILE, ENDOF
S" i" ?? OF POSTPONE IF ENDOF \ ветвления
S" e" ?? OF POSTPONE ELSE ENDOF
S" t" ?? OF POSTPONE THEN ENDOF
S" D" ?? OF POSTPONE DO ENDOF \ циклы со счетчиком
S" ?" ?? OF POSTPONE ?DO ENDOF
S" L" ?? OF POSTPONE LOOP ENDOF
S" N" ?? OF POSTPONE +LOOP ENDOF
S" I" ?? OF POSTPONE I ENDOF
S" J" ?? OF POSTPONE J ENDOF
S" Q" ?? OF POSTPONE LEAVE ENDOF
S" B" ?? OF POSTPONE BEGIN ENDOF \ циклы
S" A" ?? OF POSTPONE AGAIN ENDOF
S" U" ?? OF POSTPONE UNTIL ENDOF
S" W" ?? OF POSTPONE WHILE ENDOF
S" R" ?? OF POSTPONE REPEAT ENDOF
S" ;" ?? OF POSTPONE EXIT ENDOF
S" C" ?? OF POSTPONE CASE ENDOF \ выбор по целому
S" E" ?? OF POSTPONE ENDCASE ENDOF
S" (" ?? OF POSTPONE OF ENDOF
S" )" ?? OF POSTPONE ENDOF ENDOF
S" ." ?? OF ['] . COMPILE, ENDOF \ печать
S" c" ?? OF ['] EMIT COMPILE, ENDOF
S" S" ?? OF ['] SPACES COMPILE, ENDOF
S" T" ?? OF ['] TYPE COMPILE, ENDOF
S" \" ?? OF ['] CR COMPILE, ENDOF
S" X" ?? OF ['] EXECUTE COMPILE, ENDOF
S" q" ?? OF ['] COMPARE COMPILE, ENDOF
S" s" ?? OF ['] SEARCH COMPILE, ENDOF
S" n" ?? OF ['] NextWord COMPILE, ENDOF
S" $" ?? OF ['] SFIND COMPILE, ENDOF
S" O" ?? OF ['] RECURSE COMPILE, ENDOF
S" v" ?? OF ['] EVALUATE COMPILE, ENDOF
S" K" ?? OF ['] , COMPILE, ENDOF
S" k" ?? OF ['] C, COMPILE, ENDOF
S" ," ?? OF ['] COMPILE, COMPILE, ENDOF
S" #" ?? OF ['] LIT, COMPILE, ENDOF
S" g" ?? OF ['] BRANCH, COMPILE, ENDOF
S" j" ?? OF ['] ?BRANCH, COMPILE, ENDOF
S" `" ?? OF /cur 1+! /cur @ C@ 48 - LIT, ENDOF
S" [" ?? OF sm,,,] ENDOF
S" '" ?? OF 'parse ENDOF
S' "' ?? OF "parse ENDOF
ENDCASE ;
' op, TO sm,
: NOTFOUND ( A U -- ) sm.tst? IF sm.load sm.comp ELSE /a/ @ /u/ @ NOTFOUND THEN ;
Цитата:
: t1 0|"gav ;
: t2 0|'ku ;
t1 -- gav-gav! Ok
t2 -- ku-ku! OK
p.s. добавлена лямда, исправлена ошибка