Автор |
Сообщение |
|
|
Заголовок сообщения: |
|
|
|
|
|
|
Добавлено: Пн фев 25, 2008 00:03 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
Вот, приблизительно так. Если есть вопросы, спрашивайте.
Код: \ EVALUATE - должно ложить 0 в BLK перед своим выполнением, и восстанавливать в конце \ REFILL - будет иметь вид: \ : REFILL BLK @ IF 1 BLK +! 0 >IN ! TRUE ELSE ( старый REFILL ) THEN ; \ SOURCE - будет иметь вид: \ : SOURCE BLK @ IF BLK @ BLOCK 1024 ELSE ( старый SOURCE ) THEN ; \ бэкслеш "\" будет иметь вид: \ : \ BLK @ IF >IN @ 63 + -64 AND >IN ! ELSE ( старый \ ) THEN ; IMMEDIATE
CREATE $BUFFERS 2500 ALLOT \ можно выделять память и по другому, главное, чтобы $buffers возвращал ее адресс $BUFFERS 2500 ERASE $BUFFERS DUP 100 + DUP 1100 + ROT 2! CREATE BLK 0 ,
CREATE $STORAGE 0 , : STORAGE-NAME S" storage1.blk" ; : OPEN-STORAGE ( -- ) STORAGE-NAME R/W OPEN-FILE IF DROP STORAGE-NAME R/W CREATE-FILE THROW THEN $STORAGE ! ; : CLOSE-STORAGE ( -- ) $STORAGE @ CLOSE-FILE THROW ; : SAVE-BUFFER ( addr -- ) DUP 2 CELLS - @ IF OPEN-STORAGE DUP 1 CELLS - @ 1- 1024 M* $STORAGE @ REPOSITION-FILE IF CLOSE-STORAGE -35 THROW THEN DUP 1024 $STORAGE @ WRITE-FILE IF CLOSE-STORAGE -34 THROW THEN CLOSE-STORAGE 2 CELLS - 0 SWAP ! ELSE DROP THEN ; : FREE-BUFFER ( u -- addr ) $BUFFERS >R R@ @ 1 CELLS - @ OVER = IF DROP R> @ EXIT THEN R@ 2@ SWAP R@ 2! R@ @ 1 CELLS - @ OVER = IF DROP R> @ EXIT THEN DROP R> @ DUP SAVE-BUFFER ; : BUFFER ( u -- addr ) DUP FREE-BUFFER SWAP OVER 1 CELLS - ! ; : BLOCK ( u -- addr ) DUP FREE-BUFFER 2DUP 1 CELLS - @ = IF NIP ELSE 2DUP 1 CELLS - ! OPEN-STORAGE SWAP 1- 1024 M* $STORAGE @ REPOSITION-FILE IF CLOSE-STORAGE -35 THROW THEN DUP 1024 $STORAGE @ READ-FILE IF CLOSE-STORAGE -33 THROW THEN DROP CLOSE-STORAGE THEN ; : SAVE-BUFFERS ( -- ) $BUFFERS 2@ SAVE-BUFFER SAVE-BUFFER ; : FLUSH ( -- ) SAVE-BUFFERS $BUFFERS 2@ 2 CELLS - 2 CELLS ERASE 2 CELLS - 2 CELLS ERASE ; : UPDATE ( -- ) TRUE $BUFFERS @ 2 CELLS - ! ; : EMPTY-BUFFERS ( -- ) $BUFFERS 2@ 2 CELLS - 1032 ERASE 2 CELLS - 1032 ERASE ; VARIABLE SCR : LIST ( u -- ) DUP SCR ! BLOCK 17 1 DO CR I 0 <# # # #> TYPE SPACE 64 0 DO DUP C@ BL MAX EMIT CHAR+ LOOP ." \" LOOP DROP ;
: LOAD ( i*x u — j*x ) \ ВНИМАНИЕ!!! это пример кода, я не знаю как будет в SPF, но код слова простой, \ думаю будет не сложно разобраться, главное тут реализация INTERPRET BLK @ >R >IN @ >R \ сохраняем старый источник (только то что перепишем) DUP BLK ! 0 >IN ! \ устанавливаем новый источник IF ['] INTERPRET CATCH \ в данном случае, INTERPRET читает входной поток через SOURCE которе описано выше ?DUP IF \ дальше идет вывод сообщения об ошибке CR ." BLOCK " BLK @ . ." , LINE " >IN @ 1- 64 / DUP 1+ . ." :" CR SOURCE DROP SWAP 64 * + >IN @ 1- 64 MOD OVER + SWAP ?DO I C@ BL MAX EMIT LOOP SPACE ." ERROR #" . ABORT THEN ELSE -35 ( invalid block number ) THROW \ нулевого блока не существует THEN R> >IN ! R> BLK ! \ восстанавливаем то что переписали ;
: THRU ( i*x u1 u2 -- j*x ) 1+ SWAP ?DO I LOAD LOOP ;
Вот, приблизительно так. Если есть вопросы, спрашивайте.
[code]\ EVALUATE - должно ложить 0 в BLK перед своим выполнением, и восстанавливать в конце \ REFILL - будет иметь вид: \ : REFILL BLK @ IF 1 BLK +! 0 >IN ! TRUE ELSE ( старый REFILL ) THEN ; \ SOURCE - будет иметь вид: \ : SOURCE BLK @ IF BLK @ BLOCK 1024 ELSE ( старый SOURCE ) THEN ; \ бэкслеш "\" будет иметь вид: \ : \ BLK @ IF >IN @ 63 + -64 AND >IN ! ELSE ( старый \ ) THEN ; IMMEDIATE
CREATE $BUFFERS 2500 ALLOT \ можно выделять память и по другому, главное, чтобы $buffers возвращал ее адресс $BUFFERS 2500 ERASE $BUFFERS DUP 100 + DUP 1100 + ROT 2! CREATE BLK 0 ,
CREATE $STORAGE 0 , : STORAGE-NAME S" storage1.blk" ; : OPEN-STORAGE ( -- ) STORAGE-NAME R/W OPEN-FILE IF DROP STORAGE-NAME R/W CREATE-FILE THROW THEN $STORAGE ! ; : CLOSE-STORAGE ( -- ) $STORAGE @ CLOSE-FILE THROW ; : SAVE-BUFFER ( addr -- ) DUP 2 CELLS - @ IF OPEN-STORAGE DUP 1 CELLS - @ 1- 1024 M* $STORAGE @ REPOSITION-FILE IF CLOSE-STORAGE -35 THROW THEN DUP 1024 $STORAGE @ WRITE-FILE IF CLOSE-STORAGE -34 THROW THEN CLOSE-STORAGE 2 CELLS - 0 SWAP ! ELSE DROP THEN ; : FREE-BUFFER ( u -- addr ) $BUFFERS >R R@ @ 1 CELLS - @ OVER = IF DROP R> @ EXIT THEN R@ 2@ SWAP R@ 2! R@ @ 1 CELLS - @ OVER = IF DROP R> @ EXIT THEN DROP R> @ DUP SAVE-BUFFER ; : BUFFER ( u -- addr ) DUP FREE-BUFFER SWAP OVER 1 CELLS - ! ; : BLOCK ( u -- addr ) DUP FREE-BUFFER 2DUP 1 CELLS - @ = IF NIP ELSE 2DUP 1 CELLS - ! OPEN-STORAGE SWAP 1- 1024 M* $STORAGE @ REPOSITION-FILE IF CLOSE-STORAGE -35 THROW THEN DUP 1024 $STORAGE @ READ-FILE IF CLOSE-STORAGE -33 THROW THEN DROP CLOSE-STORAGE THEN ; : SAVE-BUFFERS ( -- ) $BUFFERS 2@ SAVE-BUFFER SAVE-BUFFER ; : FLUSH ( -- ) SAVE-BUFFERS $BUFFERS 2@ 2 CELLS - 2 CELLS ERASE 2 CELLS - 2 CELLS ERASE ; : UPDATE ( -- ) TRUE $BUFFERS @ 2 CELLS - ! ; : EMPTY-BUFFERS ( -- ) $BUFFERS 2@ 2 CELLS - 1032 ERASE 2 CELLS - 1032 ERASE ; VARIABLE SCR : LIST ( u -- ) DUP SCR ! BLOCK 17 1 DO CR I 0 <# # # #> TYPE SPACE 64 0 DO DUP C@ BL MAX EMIT CHAR+ LOOP ." \" LOOP DROP ;
: LOAD ( i*x u — j*x ) \ ВНИМАНИЕ!!! это пример кода, я не знаю как будет в SPF, но код слова простой, \ думаю будет не сложно разобраться, главное тут реализация INTERPRET BLK @ >R >IN @ >R \ сохраняем старый источник (только то что перепишем) DUP BLK ! 0 >IN ! \ устанавливаем новый источник IF ['] INTERPRET CATCH \ в данном случае, INTERPRET читает входной поток через SOURCE которе описано выше ?DUP IF \ дальше идет вывод сообщения об ошибке CR ." BLOCK " BLK @ . ." , LINE " >IN @ 1- 64 / DUP 1+ . ." :" CR SOURCE DROP SWAP 64 * + >IN @ 1- 64 MOD OVER + SWAP ?DO I C@ BL MAX EMIT LOOP SPACE ." ERROR #" . ABORT THEN ELSE -35 ( invalid block number ) THROW \ нулевого блока не существует THEN R> >IN ! R> BLK ! \ восстанавливаем то что переписали ;
: THRU ( i*x u1 u2 -- j*x ) 1+ SWAP ?DO I LOAD LOOP ; [/code]
|
|
|
|
Добавлено: Ср фев 20, 2008 17:42 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
Конечно. Можете как вам удобнее постить или сюда или в spf-dev или в багтрекер.
Конечно. Можете как вам удобнее постить или сюда или в spf-dev или в багтрекер.
|
|
|
|
Добавлено: Ср фев 20, 2008 15:37 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
Я с СПФ не разработчик, поэтому могу выложить исходники прямо тут, а кто более опытный можете вставить куда лучше в СПФ. Так пойдет?
Я с СПФ не разработчик, поэтому могу выложить исходники прямо тут, а кто более опытный можете вставить куда лучше в СПФ. Так пойдет?
|
|
|
|
Добавлено: Ср фев 20, 2008 14:03 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
ygrek писал(а): Значит нужно исправление. Есть желающие нарисовать BLOCK wordset? Я могу, он у меня есть полностью на АНСИ написанный, значит и к СПФ приклетися должен. Хотя надо потестить, конечно.
[quote="ygrek"]Значит нужно исправление. Есть желающие нарисовать BLOCK wordset?[/quote]Я могу, он у меня есть полностью на АНСИ написанный, значит и к СПФ приклетися должен. Хотя надо потестить, конечно. :)
|
|
|
|
Добавлено: Ср фев 20, 2008 14:01 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
Значит нужно исправление. Есть желающие нарисовать BLOCK wordset?
Значит нужно исправление. Есть желающие нарисовать BLOCK wordset?
|
|
|
|
Добавлено: Ср фев 20, 2008 12:01 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
ygrek писал(а): Разве BLOCK и BLOCK-EXT обязательны? Обязательны если присутствует File-access word set. Это упоминается многократно в стандарте. Например в 11.3.2: Цитата: 11.3.2 Blocks in files If the File-Access word set is implemented, the Block word set shall be implemented.
На самом деле, в SPF Block word set присутствует, причем в комменариях указано что автор знает про необходимость его включения. Однако, реально, слова из этого расширения ничего не делают, всегда возвращая ошибку про неверный номер блока. Грубая такая заглушка.
Я понимаю, что блоки никому нафиг ненадо, но так как они реализованы сейчас в ансификации СПФ - не соответствует стандарту.
[quote="ygrek"]Разве BLOCK и BLOCK-EXT обязательны?[/quote]Обязательны если присутствует File-access word set. Это упоминается многократно в стандарте. Например в 11.3.2: [quote]11.3.2 Blocks in files If the File-Access word set is implemented, the Block word set shall be implemented.[/quote]
На самом деле, в SPF Block word set присутствует, причем в комменариях указано что автор знает про необходимость его включения. Однако, реально, слова из этого расширения ничего не делают, всегда возвращая ошибку про неверный номер блока. Грубая такая заглушка. ;)
Я понимаю, что блоки никому нафиг ненадо, но так как они реализованы сейчас в ансификации СПФ - не соответствует стандарту.
|
|
|
|
Добавлено: Вт фев 19, 2008 23:55 |
|
|
|
|
|
Заголовок сообщения: |
ANS в SPF |
|
|
http://fforum.winglion.ru/viewtopic.php?p=12969#12969
Forthware писал(а): Ну вот, в SPF заявлена тоже, а с блоками он не работает. Разве BLOCK и BLOCK-EXT обязательны? ANS'94 писал(а): The optional Block word set Цитата: 3. Usage requirements
A system shall provide all of the words defined in 6.1 Core Words. It may also provide any words defined in the optional word sets and extensions word sets. [...] A system need not provide all words in executable form. The implementation may provide definitions, including definitions of words in the Core word set, in source form only. If so, the mechanism for adding the definitions to the dictionary is implementation defined.
http://fforum.winglion.ru/viewtopic.php?p=12969#12969
[quote="Forthware"]Ну вот, в SPF заявлена тоже, а с блоками он не работает.[/quote] Разве BLOCK и BLOCK-EXT обязательны?
[quote="ANS'94"]The optional Block word set[/quote]
[quote] 3. Usage requirements
A system shall provide all of the words defined in 6.1 Core Words. It may also provide any words defined in the optional word sets and extensions word sets. [...] A system need not provide all words in executable form. The implementation may provide definitions, including definitions of words in the Core word set, in source form only. If so, the mechanism for adding the definitions to the dictionary is implementation defined. [/quote]
|
|
|
|
Добавлено: Вт фев 19, 2008 23:33 |
|
|
|
|