Язык программирования Форт
Упражнения 1. 05
Блок [76 :0] ( Глава 8. Упражнения 1. 05 из 06 ) ( 10. ) VARIABLE SPCS : COUNT-SPCS ( адр --) 1024 0 DO DUP I + С@ 32 = IF 1 SPCS +! THEN LOOP DROP ; ( 11. ) CREATE ALPHA 52 ALLOT : ALPHACOUNT ( адр cw -- ) ALPHA 52 0 FILL ( очистка массива ) 0 DO DUP I + С@ 223 AND DUP 64 > OVER 91 < AND IF 65 - 2 * ALPHA + 1 SWAP +! ELSE DROP THEN LOOP DROP ;
Блок 77 [77 :0] ( Глава 8. Упражнения 1. 06 из 06 ) ( 12. ) : LETTERBAR ( n с --) SWAP 0 DO DUP EMIT LOOP DROP ; : ALPHALLOT ( -- ) ALPHA CR 26 0 DO DUP I 2 * + @ ?DUP 0= 0= IF I 65 @ LETTERBAR CR THEN ; LOOP DROP QUIT ; ( 13. ) : .S ( -- ) DEPTH ?DUP 0= IF ." Stack empty" ELSE 0 DO DEPTH ROLL DUP . LOOP THEN ;
Блок 78 [78 :0] ( Глава 8. Упражнения 2. 01 из 03 ) ( 1. ) : .ARR ( адр n --) 2 * CR 0 DO DUP I + @ . ( 2. ) 2 +LOOP DROP ; : .SQARR ( адр n -- ) 2 * CR DUP @ DO DUP 0 DO OVER I J + + @ . 2 +LOOP CR 2 +LOOP 2DROP ; ( 3. ) : D.ARR ( адр n --) 4 * CR 0 DO DUP I + 2@ D. 4 +LOOP DROP ; : D.SQARR ( адр n -- ) 4 * CR DUP 0 DO DUP 0 DO OVER J + + 2@ D. 4 +LOOP CR 4 +LOOP 2DROP ; ( Может покаэаться более естественным использовать LOOP и 2 * или 4 * для вычисления адреса извлекаемого элемента, но быстрее использовать +LOOP и делать умножение только раз в начале описания. )
Блок 79 [79 :0] ( Глава 1. Упражнения 2. 02 из 03 ) ( 4. ) : F-C ( -- ) СК 201 0 DO I 6 .R I 32 - 5 9 */ 6 .R CR 10 +LOOP ; ( Заметьте, что хотя шаг цикла равен 10, предел цикла должен только на 1 превосходить верхнюю ступеньку. ) ( 5. ) : F-C1 ( -- ) CR 0 200 DO I 6 .R I 32 - 5 9 */ 6 .R CR 10 +LOOP ; ( 6. ) : FINDCHAR ( адр1 с -- адр2 ) 1024 0 DO OVER OVER SWAP 1 + C@ IF DROP I + LEAVE THEN LOOP ;
Блок 80 [80 :0] ( Глава 8. Упражнения 2. 03 из 03 ) ( 7. ) : $= ( адр1 адр2 -- f ) OVER OVER C@ SWAP C@ = 0= IF 0 DROP DROP EXIT THEN 1+ SWAP 1+ DUP 1- С@ 0 DO OVER OVER I + C@ SWAP I + C@ = 0= IF DROP DROP 0 LEAVE THEN LOOP DUP IF DROP DROP 1 ( или -1 для Форт-03) THEN ; ( 8. ) : SEARCH ( адр @адр -- f ) 1+ DUP 1- C@ 0 DO OVER OVER 1 + C@ SWAP I + C@ = 0= IF DROP DROP 0 LEAVE THEN LOОР DUP IF DROP DROP 1 ( или -1 ) THEN ; : $FIND ( адр $адр - адр ) 1024 0 DO SWAP 1+ SWAP OVER OVER SEARCH IF LEAVE THEN LOOP DROP ;
Forekc.ru
Рефераты, дипломы, курсовые, выпускные и квалификационные работы, диссертации, учебники, учебные пособия, лекции, методические пособия и рекомендации, программы и курсы обучения, публикации из профильных изданий