Приложение А.
ОТВЕТЫ К УПРАЖНЕНИЯМ
ГЛАВА 1
1. : ДАР ." подставку для книг" ;
: ДАРИТЕЛЬ ." Маша" ;
: БЛАГОДАРНОСТЬ CR ." Дорогая " ДАРИТЕЛЬ ." ," CR
5 SPACES ." спасибо за " ДАР ." . " ;
2. : МЕНЬШЕ-НА-ДЕСЯТЬ ( n - n-10 ) -10 + ; или
: МЕНЬШЕ-НА-ДЕСЯТЬ ( n - n-10 ) 10 - ;
3. При компиляции определения БЛАГОДАРНОСТЬ компилятор включает в
него определение слова ДАРИТЕЛЬ, существующее на момент компиляции.
Если вы после компиляции слова БЛАГОДАРНОСТЬ добавите в словарь новый
вариант слова ДАРИТЕЛЬ, то этот никак не отразится на уже
скомпилированном слове БЛАГОДАРНОСТЬ. ( Но вы можете переопределить
( перекомпилировать ) и слово БЛАГОДАРНОСТЬ. В этом случае в его
определение войдет новый вариант слова ДАРИТЕЛЬ.)
ГЛАВА 2
1. DUP DUP: (1 2 -- 1 2 2 2)
2DUP: (1 2 -- 1 2 1 2)
2. : NIP ( а b - b ) SWAP DROP ;
3. : TUCK ( а Ь - Ь a b) SWAP OVER ;
4. : -ROT ( а Ь с - cab) ROT ROT ;
5. SWAP 2SWAP SWAP
6. : 3DUP ( n1 n2 n3 - n1 n2 n3 n1 n2 n3) DUP 2OVER ROT ;
7. : 2-7 ( c a b - n) OVER + * + ;
8. : 2-8 ( a b - n) 2DUP - ROT ROT + / ;
9. : УПАКОВКА ( #яиц - )
12 /MOD . ." коробок и " . ." не упаковано " ;
ГЛАВА 4
1. -1 0= NOT . -1 ok
0 0= NOT . 0 ok
200 0= NOT . -1 ok
2. Не спросит ничего.
3. ( употреблять спиртные напитки можно только с 21 года, тогда:)
: РАЗРЕШЕНИЕ ( возраст - )
20 > IF ." Употребление алкоголя разрешено "
ELSE ." Вы еще молоды " THEN ;
4. : ЗНАКИ ( n) DUP 0= IF ." Нуль " ELSE
DUP 0< IF ." Отрицательное " ELSE
." Положительное " THEN THEN DROP ;
( или как-нибудь иначе - лишь бы работало)
5. : <> ( n1 n2 - ?) = NOT ;
6. : XOR ( х у - ?)
2DUP NOT AND SWAP ROT NOT AND OR ;
7. : STARS ( n - ) ?DUP IF STARS THEN ;
8. : NEGATE ( n - -n) 0 SWAP - ;
: ABS ( n - |n| ) DUP 0< IF NEGATE THEN ;
9. : /UP ( делимое делитель - частное) /MOD SWAP IF 1+ THEN ;
10. : -ROT ( а Ь с - c a b) ROT ROT ;
: WITHIN ( n l h - ?) -ROT OVER > NOT -ROT > AND ;
Ниже приводится более эффективный вариант, в котором используются
приемы, рассмотренные в следующих главах:
: WITHIN ( n l h - ?) OVER - >R - R> U< ;
11. : УГАДАЙ ( ответ попытка - ответ )
2DUP = IF ." Вы угадали! " 2DROP ELSE
2DUP < IF ." Слишком много " ELSE
." Слишком мало " THEN DROP THEN ;
12. : .ОТРИЦАТЕЛЬНОЕ ( n - |n|) 0< IF ." Отрицательное " ABS THEN
: ПРОПИСЬ ( n - ) DUP ABS 4 > IF ." Выходит за границу " ELSE
DUP .ОТРИЦАТЕЛЬНОЕ DUP 0= IF ." Нуль " ELSE
DUP 1 = IF ." Один " ELSE
DUP 2 = IF ." Два " ELSE
DUP 3 = IF ." Три " ELSE
." Четыре "
THEN THEN THEN THEN THEN DROP ;
13. в предположении,что -ROT и WITHIN уже загружены:
: 3DUP ( a b c - a b c a b c) DUP 2OVER ROT ;
: ЛОВУШКА ( ответ -меньш-число -большее-число -- ответ | -- )
3DUP OVER = -ROT = AND
IF ."Вы угадали! " 2DROP DROP ELSE
3DUP SWAP 1 + SWAP WITHIN IF ." Между "
ELSE ." Вне " THEN 2DROP THEN ;
ГЛАВА 5
1. -1 интерпретируется как число "отрицательная единица" ;
1- является словом форта, которое вычитает единицу из значения на стеке.
2. */ NEGATE
3. МАХ МАХ МАХ .
4. а) : 2ЗНАЧ ( n1 n2 - n? n?) \ помещение большего значения на вершину
2DUP > IF SWAP THEN ;
б) : 3ЗНАЧ ( n1 n2 nЗ - n? n? n?) \ большее значение на вершину
2ЗНАЧ >R 2ЗНАЧ R> 2ЗНАЧ ;
( Вы можете продолжать в том же духе и далее ... )
: 4ЗНАЧ \ иэ четырех элементов стека больший поместить в вершину
3ЗНАЧ >R 3ЗНАЧ R> 2ЗНАЧ ;
...последним оператором во всем случаях должен быть 2ЗНАЧ.)
в) : ?ОБЪЕМ ( длина ширина высота - ) \ в любом порядке
3ЗНАЧ 22 > ROT 6 > ROT 19 >
AND AND IF ." Подходит " THEN ;
( Автор благодарит за пример Микаэла Хэма.)
5. : РИСУЙ ( n - ) CR 80 100 */ STARS ;
6. а) 0 32 - 10 18 */ . -17 ok
б) 212 32 - 10 18 */ . 100 ok
в) -32 32 - 10 18 */ . -35 ok
г) 16 18 10 */ 32 + . 60 ok
д) 233 273 - . -40 ok
7. : Ф>Ц ( фаренг - цельс) 32 - 10 18 */ ;
: Ц>Ф ( цельс - фаренг) 18 10 */ 32 + ;
: К>Ц ( кельв - цельс) 273 - ;
: Ц>К ( цельс - кельв) 273 + ;
: Ф>К ( фаренг - кельв) Ф>Ц Ц>К ;
: К>Ф ( кельв - фаренг) К>Ц Ц>Ф ;
Block# 270
0 \ Ответы к упражнениям: глава 6
1 \ Упражнения 1-6
2 : STARS ( n) 0 ?DO 42 EMIT LOOP ;
3 : КЛЕТКА ( ширина высота - ) 0 DO CR DUP STARS LOOP DROP ;
4 : \STARS ( #строк - ) 0 DO CR I SPACES 10 STARS LOOP ;
5 : /STARS ( #строк - )
6 1- 0 SWAP DO CR I SPACES 10 STARS -1 +LOOP ;
7 \ Определение /STARS с использованием конструкции BEGIN ... UNTIL:
8 : A/STARS ( #строк)
9 BEGIN 1- CR DUP SPACES 10 STARS DUP 0= UNTIL DROP ;
10
11 \ РОМБЫ определены в два этапа:
12 : ТРЕУГОЛЬНИК ( приращение граница индекс - )
13 DO CR 9 I - SPACES I 2* 1+ STARS DUP +LOOP DROP ;
14 : РОМБЫ ( #ром6ов - )
15 0 DO 1 10 0 ТРЕУГОЛЬНИК -1 0 9 ТРЕУГОЛЬНИК LOOP CR :
Block# 271
0 \ Ответы к упражнениям; глава 6; продолжение 1 \ Упражнение 7:
2 : THRU ( от до - ) 1+ SWAP DO I DUP . LOAD LOOP ;
3 \ Упражнение 8
4 : R%, ( n1 % - n2) 10 */ 5 + 10 / ;
5 : УДВОЕНО ( вклад процент - )
6 OVER 2* SWAP ROT 21 1 DO
7 CR ." Год " I 2 .R 3 SPACES
8 2DUP R% + DUP ." Сумма " ? DUP 2OVER DROP > IF
10 CR CR ." Более чем удвоено через " I . ." лет " LEAVE
11 THEN LOOP 2DROP DROP ;
12 \ Упражнение 9
13 : ** (n1 n2 - n1 -в-степени-n2)
14 1 SWAP ?DUP IF 0 DO OVER * LOOP THEN SWAP DROP ;
15 \ Спасибо за упражнение Дж.И.Андересну, Эдинбург, Шотландия
Block# 272
0 \ Ответы к упражнениям; глава 7
1 \ Упражнение 1:
2 : N-MAX 0 BEGIN 1+ DUP 0< UNTIL 1- . ;
3 ( Начиная с нуля, увеличиваем значение на стеке до тех пор, пока оно
4 не станет отрицательным - это означает, что достигнута граница пред-
5 ставления целых чисел. Последний оператор 1- возвращает значение
6 перед достижением границы.)
7
8 \ Упражнение 2 (а-е):
9 : BYNARY 2 BASE ! ;
10 : БИТОВЫЙ ( #бита - позиция-бита) 1 SWAP 0 ?DO 2* LOOP ;
11 : УСТАНОВИТЬ-БИТ ( битовый1 #бита - битовый2) БИТОВЫЙ OR ;
12 : ОЧИСТИТЬ-БИТ ( битовый1 #бита - битовый2) БИТОВЫЙ -1 XOR AND ;
13 : ДАЙ-БИТ ( битовый #бита - бит ) БИТОВЫЙ AND ;
14 : ПЕРЕКЛЮЧИТЬ-БИТ ( битовый1 #бита - битовый2) БИТОВЫЙ XOR ;
15 : ИЗМЕНЕНИЕ ( (битовый1 битовый2 - битовый3 ) XOR ;
Block# 273
0 \ Ответы к упражнениям; глава 7, продолжение
1 \ Упражнение 3:
2 : БИП ." Бип " 7 EMIT ;
3 : ЗАДЕРЖКА 20000 0 DO LOOP ;
4 : 3ЗВОНКА БИП ЗАДЕРЖКА БИП ЗАДЕРЖКА БИП ;
5
6 \ Упражнение 4а:
7 : Ф>Ц -320 М+ 10 18 М*/ ;
8 : Ц>Ф 18 10 М*/ 320 М+ ;
9 : К>Ц -2732 М+ ;
10 : Ц>К 2732 М+ ;
11 : Ф>К Ф>Ц Ц>К ;
12 : К>Ф К>Ц Ц>Ф 5
13 \ Упражнение 4б:
14 : .ГРАДУС ( d - ) DUP >R DABS
15 <# # 46 HOLD #S R> SIGN #> TYPE SPACE ;
Block# 274
0 \ Ответы к упражнениям; глава 7, продолжение
1 \ Упражнение 5: ( в результате получается 17513;считается довольно долго.)
2 : ВЫЧИСЛ ( х - dv)
3 DUP 7 М* 20 М+ ROT 1 М*/ 5 M+ ;
4 : ?DMAX 0 BEGIN 1+ DUP ВЫЧИСЛ 0 в D< UNTIL 1- . ;
5
6 \ Упражнение 6:
7 В 16-чной системе десятичная цифра имеет такое же значение.
8
9 \ Упражнение 7: 10 : BINARY 2 BASE ! ;
11 : 3-СИСТЕМЫ
12 17 0 DO CR ." Десятичная" DECIMAL I 4 .R 8 SPACES
13 .' 16-ричная" HEX I 3 .R 8 SPACES
14 ." Двоичная" BINARY I S .R 8 SPACES
15 LOOP DECIMAL ;
Block# 275
0 \ Ответы к упражнениям глава 7, продолжение
1 \ Упражнение 8:
2 ( 3.7 интерпретируется как число двойной длины, поскольку содержит
3 десятичную точку, и поэтому занимает два элемента стека,
4 Так как 37 является небольшим числом, то его старшая часть
5 состоит из нулей. "." является оператором над значением одинарной
6 длины; две же точки подряд выводят обе части значения двойной
7 длины. Старшая часть располагается на вершине стека, поэтому
8 ее выводит первая точка; Вторая точка выводит младшую часть -
9 37.)
10 ( Число 65536 в точности на единицу превышает число, которое уме-
11 щается в 16 разрядах. Поэтому 17-й разряд становится равным "1",
12 а все остальные биты превращаются в нули. 17-й бит числа двойной
13 длины является крайним правым битом старшей части. Она выводится
14 как "1". Младшая часть выводится как нули.)
15 ( Число 65538 больше на два, поэтому младшая часть выглядит как "2".)
Block# 276
0 \ Ответы к упражнениям; глава 7, продолжение
1 \ Упражнение 9:
2 ( Поскольку данный фрагмент не является словом, форт интерпретирует
3 его как число. Так как NUMBER интерпретирует точку как разделитель
4 целой и дробной части числа, что для него является признаком числа
5 двойной длины, то он на стек поместит ноль двойной длины.)
6
7 \ Упражнение 10:
8 : .ТЕЛЕФОН ( d - ) <# # # # # ASCII - HOLD # # #
9 OVER IF ASCII / HOLD #S THEN #> TYPE SPACE ;
10
11
12
13
14
15
Block# 277
0 \ Ответы к упражнениям; глава 8
1 \ Упражнение 1-а
2 VARIABLE ПИРОЖКИ 0 ПИРОЖКИ !
3 : ИСПЕКИ-ПИРОЖОК 1 ПИРОЖКИ +! ;
4 : СЪЕШЬ-ПИРОЖОК ПИРОЖКИ @ IF -1 ПИРОЖКИ +! ." Спасибо "
5 ELSE ." Какой пирожок?" THEN ;
6 \ Упражнение 1-б
7 VARIABLE ЗАМОРОЖЕННЫЕ-ПИРОЖКИ 0 ЗАМОРОЖЕННЫЕ-ПИРОЖКИ !
8 : ЗАМОРОЗЬ-ПИРОЖКИ ПИРОЖКИ @ ЗАМОРОЖЕННЫЕ-ПИРОЖКИ +! 0 ПИРОЖКИ ! ;
9 \ Упражнение 2:
10 : .БАЗА BASE @ DUP DECIMAL . BASE ! ;
11 \ Упражнение 3 ( сверх-надежный вариант):
12 : S>D ( п - d) DUP 0< ; \ из одинарной в двойную длину
13 : М. ( d - ) TUCK DABS
14 <# DPL @ DUP -1 <> IF В ?DO # LOOP ASCII . HOLD ELSE
15 DROP S>D THEN #S ROT SIGN #> TYPE SPACE ;
Block# 278
0 \ Ответы к упражнениям; глава 8, Упражнение 4
1
2 CREATE #КАРАНДАШЕЙ 8 ALLOT \ карандаши четырех цветов
3 0 CONSTANT КРАСНЫХ 2 CONSTANT ГОЛУБЫХ
4 4 CONSTANT ЗЕЛЕНЫХ 6 CONSTANT ОРАНЖЕВЫХ
5
6 : КАРАНДАШЕЙ ( смещение - а) #КАРАНДАШЕЙ + ;
7
8 23 КРАСНЫХ КАРАНДАШЕЙ .
9 15 ГОЛУБЫХ КАРАНДАШЕЙ !
10 12 ЗЕЛЕНЫХ КАРАНДАШЕЙ !
11 0 ОРАНЖЕВЫХ КАРАНДАШЕЙ I
12
13 \ Для проверки мы можем ввести, например, следующий текст:
14 \ ГОЛУБЫХ КАРАНДАШЕЙ ? 15 ok
15
Block# 279
0 \ Ответы к упражнениям; глава 8, Упражнение 5
1
2 CREATE 'ШАБЛОНЫ 20 ALLOT ( 10 ячеек)
3 : ШАБЛОНЫ ( i - а ) 2* 'ШАБЛОНЫ + ;
4 : STARS ?DUP IF 0 DO 42 EMIT LOOP THEN ;
5 : ИНИЦ-ШАБЛОНОВ 10 0 DO 16 MOD I ШАБЛОНЫ ! LOOP ;
6
7 : РИСУЙ ( - )
8 100 DO CR I 2 .R SPACE I ШАБЛОНЫ @ STARS LOOP CR ;
9
10 ИНИЦ-ШАБЛОНОВ
11
12
13
14
15
Block# 280
0 \ Ответы к упражнениям; глава 8, упражнение 6
1 1 CONSTANT ЖЕНЩИНА 0 CONSTANT МУЖЧИНА
2 2 CONSTANT СЕМЕЙНЫЙ 0 CONSTANT ОДИНОКИЙ
3 4 CONSTANT РАБОТАЕТ 0 CONSTANT HE-РАБОТАЕТ
4 8 CONSTANT ГОРОДСКОЙ 0 CONSTANT HE-ГОРОДСКОЙ
5 VARIABLE ВАСЯ
6 VARIABLE ИРА
7 : ОПИСАНИЯ ( состояние состояние состояние состояние имярек -- )
8 >R OR OR OR R> ! ;
9 МУЖЧИНА СЕМЕЙНЫЙ HE-РАБОТАЕТ HE-ГОРОДСКОЙ ВАСЯ ОПИСАНИЯ
10 ЖЕНЩИНА ОДИНОКИЙ РАБОТАЕТ ГОРОДСКОЙ ИРА ОПИСАНИЯ
11
12
13
14
15
Block# 281
0 \ Ответы к упражнениям; глава 8, упражнение 6, продолжение
1 : .ПОЛ ( битовый - ) женщина AND IF ." жен" THEN ." муж " ;
2 : .СЕМ-ПОЛ ( битовый - )
3 СЕМЕЙНЫЙ AND IF ." семейный " ELSE ." одинокий " THEN ;
4 : .РАБОТА ( битовый - )
5 РАБОТАЕТ AND 0= IF ." не " THEN ." работает " ;
6 : .ЖИТЕЛЬСТВО ( битовый - )
7 ГОРОДСКОЙ AND 0= IF ." не " THEN ." городской " ;
8 : СВЕДЕНИЯ ( имярек - )
9 @ DUP -ПОЛ DUP .СЕМ-ПОЛ DUP .РАБОТА .ЖИТЕЛЬСТВО ; 113
11
12
13
14
15
Block# 282
0 \ Ответы к упражнениям; глава 3, упражнение 7
1 CREATE ПОЛЕ 9 ALLOT
2 : КВАДРАТ ( #квадрата - а) ПОЛЕ + ;
3 : ОЧИСТИТЬ ПОЛЕ 9 0 FILL ; ОЧИСТИТЬ
4 : ЛИНИЯ ." | " ;
5 : ПОДЧЕРКИВАНИЕ CR 9 0 DO ASCII - EMIT LOOP CR ;
6 : .КЛЕТКА ( #квадрата - ) КВАДРАТ С@ DUP 0= IF 2 SPACES ELSE
7 DUP 1 = IF ." X " ELSE ." 0 " THEN THEN DROP ;
8 : КАРТИНКА CR 9 0 DO I IF I 3 MOD 0= IF
9 ПОДЧЕРКИВАНИЕ ELSE ЛИНИЯ THEN THEN I .КЛЕТКА LOOP CR QUIT ;
10 : ХОД ( игрок #квадрата - )
11 1- 0 MAX 8 MIN КВАДРАТ С! ;
12 : X! ( #квадрата - ) 1 SWAP ХОД КАРТИНКА ;
13 : 0! ( #квадрата - ) -1 SWAP ХОД КАРТИНКА ;
14
15 Block# 283
0 \ Ответы к упражнениям; глава 9
1
2 \ Упражнение 1:
3 VARIABLE 'ПОЛУЧАЕМ
4 : ПОЛУЧАЕМ ( n n - ) 'ПОЛУЧАЕМ @ EXECUTE . :
5 : СКЛАДЫВАЯ ['] + 'ПОЛУЧАЕМ ! ;
6 : УМНОЖАЯ ['] * 'ПОЛУЧАЕМ ! ;
7
8 \ Упражнение 2:
9 \ Вы можете узнать это, введя 1в \ HERE U.
11 \ в начале работы или после применения системных команд, очи-
12 \ щающих словарь, таких как COLD или EMPTY.
13
14
15
Block # 284
0 \ Ответы к упражнениям; глава 7, продолжение
1
2 \ Упражнение 3:
3 \ Вы можете узнать это, введя
4 \ PAD HERE - U.
5
6 \ Упражнение 4:
7 \ а) Разницы нет. Переменная оставляет на стеке собственный pfa.
8 \ б) Пользовательская переменная оставляет на стеке адрес ячейки
9 \ из пользовательской таблицы, Элемент словаря, который ищется 10 словом, может находиться где угодно, 11 \ 12
13
14
15
Block # 285
0 \ Ответы к упражнениям; глава 9, продолжение
1 \ Упражнение 5, Решение 1:
2 CREATE 'ЧТО-ДЕЛАТЬ 12 ALLOT \ 6 ячеек
3 : ЧТО-ДЕЛАТЬ ( i -- а) 0 МАХ 5 MIN 2* 'ЧТО-ДЕЛАТЬ + ;
4
5 : ВСТРЕЧА ." Привет, я говорю на форте. " ;
6 : ПОСЛЕДОВАТЕЛЬНОСТЬ 11 1 DO I . LOOP ;
7 : ПЛИТКА 10 5 КЛЕТКА ; \ См. ответы к главе 6
6 : НИЧЕГО ;
9
10 ' ВСТРЕЧА 0 ЧТО-ДЕЛАТЬ ! ' ПОСЛЕДОВАТЕЛЬНОСТЬ 1 ЧТО-ДЕЛАТЬ !
11 ' ПЛИТКА 2 ЧТО-ДЕЛАТЬ ! ' НИЧЕГО 3 ЧТО-ДЕЛАТЬ !
12 ' НИЧЕГО 4 ЧТО-ДЕЛАТЬ ! ' НИЧЕГО 5 ЧТО-ДЕЛАТЬ !
13
14 : ЧТО-НИБУДЬ ( индекс --) ЧТО-ДЕЛАТЬ @EXECUTE ;
15
Block # 286
0 \ Ответы к упражнениям; глава 9, продолжение
1 \ Упражнение 5, Решение 2;
2 CREATE 'ЧТО-ДЕЛАТЬ 12 ALLOT \ 6 ячеек
3 : ЧТО-ДЕЛАТЬ ( i -- а) 0 MАХ 5 MIN 2* 'ЧТО-ДЕЛАТЬ + ;
4
5 : ВСТРЕЧА ." Привет, я говорю на форте. " ;
6 : ПОСЛЕДОВАТЕЛЬНОСТЬ 11 1 DO I . LOOP ;
7 : ПЛИТКА 13 5 КЛЕТКА 5 \ см. ответы к главе 6
8 : НИЧЕГО ;
9
10 : ИНИЦИАЛИЗАЦИЯ ( - )
11 6 0 DO ['] НИЧЕГО I ЧТО-ДЕЛАТЬ ! LOOP
12 ['] ВСТРЕЧА 0 ЧТО-ДЕЛАТЬ ! ['] ПОСЛЕДОВАТЕЛЬНОСТЬ 1 ЧТО-ДЕЛАТЬ !
13 ['] ПЛИТКА 2 ЧТО-ДЕЛАТЬ ! ;
14 ИНИЦИАЛИЗАЦИЯ
15 : ЧТО-НИБУДЬ ( индекс - ) ЧТО-ДЕЛАТЬ @EXECUTE ;
Block # 287
0 \ Ответы к упражнениям; глава 10
1 \ Упражнение 1:
2 : СИМВОЛ ( i - а)
3 228 BLOCK + ;
4 : ЗАМЕНА ( c1 с2 - ) \ замена c1 на с2
5 1024 0 DO OVER I СИМВОЛ С@ = IF DUP I СИМВОЛ С!
6 UPDATE THEN LOOP 2DROP ;
7
8 \ Упражнение 2:
9 181 LOAD \ Случайные числа
10 \ ??? CONSTANT ПРЕДСКАЗАНИЯ \ номер блока под сообщения
11 : ПРЕДСКАЗАНИЕ CR 16 CHOOSE 64 * ПРЕДСКАЗАНИЯ BLOCK +
12 64 -TRAILING TYPE SPACE ;
13 \ Вы можете обращаться к своим собственным "предсказаниям".Занесите
14 \ их по одному на строку в свободный блок, л затем занесите номер
15 \ этого блока в приведенное выше определение константы ПРЕДСКАЗАНИЯ
Block# 238
0 \ Ответы к упражнениям; глава 10, продолжение
1 \ часть а:
2 : ДА/НЕТ? ( - t=Y | f=прочее) KEY DUP EMIT ASCII Y = ;
3 \ часть б:
4 : ДА/НЕТ? ( - t=Y | f=прочее)
5 KEY 95 AND DUP EMIT ASCII Y = ;
6 \ часть в; два возможных решения:
7 : ДА/НЕТ? ( - t=Y | f=N )
8 BEGIN KEY 95 AND DUP ASCII Y = IF DROP TRUE EXIT ELSE
9 DUP ASCII N = IF 0= EXIT THEN THEN 10 DROP FALSE UNTIL ;
11
12 : ДА/НЕТ? ( - t=Y | f=N )
13 BEGIN KEY 95 AND DUP ASCII Y = OVER ASCII N = OR NOT
14 WHILE DROP REPEAT ASCII Y = ;
15
Block# 289
0 \ Ответы к упражнениям; глав* 10, упражнение 4 1
1 : ЖИВОТНЫЕ LIT" КРЫСЫ БЫКА ТИГРА КРОЛИКА ДРАКОНА ЗМЕИ ЛОШАДИ
2 БАРАНА ОБЕЗЬЯНЫПЕТУХА СОБАКИ СВИНЬИ " ;
3 : .ЖИВОТНОЕ ( u - ) \ и изменяется от 0 до 11
4 8 * ЖИВОТНЫЕ 1+ + 8 -TRAILING TYPE ;
5 : (ГОРОСКОП) ( год - )
6 1900 - 12 MOD
7 ." Вы родились в год " .ЖИВОТНОЕ
8 ASCII . EMIT CR ;
9 350 351 THRU \ загрузка определения EXPECT#
10 : ЦИФРЫ ( #цифр - d )
11 DUP 0 DO ASCII EMIT LOOP DUP 0 DO ЗАБОИ LOOP
12 PAD SWAP 2DUP 1+ BLANK EXPECT# DROP PAD 1- NUMBER :
13 : ГОРОСКОП
14 CR ." В каком году вы родились? " 4 ЦИФРЫ
15 CR DROP (ГОРОСКОП) ;
Block# 290
0 \ Ответы к упражнениям; глава 10, упражнение 5
1 VARIABLE СТРОКА
2 : начало 0 строка ' ;
3 : добавить \ 1прилагательное, 2прилагательное, 3прилагательное,
4 \ существительное ( - )
5 СТРОКА @ 0 БРЕД 60 BLANK UPDATE
6 3 0 DO
7 ASCII , WORD COUNT СТРОКА @ I БРЕД SWAP CMOVE UPDATE
8 LOOP 1 СТРОКА +! ;
9 \ или, используя TEXT:
10 : добавить \ 1прилагательное, 2прилагательное 3прилагательное,
11 \ существительное ( - )
12 3 0 DO
13 ASCII , TEXT PAD СТРОКА @ I БРЕД 28 CMOVE UPDATE
14 LOOP 1 СТРОКА +! ;
15 Block# 291
0 \ Ответы к упражнениям; глава 10
1 \ Упражнение 6
2 : >ДАТА ( а -- n n )
3 0 0 ROT CONVERT ROT >R 0 SWAP CONVERT ROT >R
4 0 SWAP CONVERT 2DROP 1900 + R> R> 256 * + SWAP ;
5 : СКАНИРОВАНИЕ BL WORD >ДАТА ;
6
7 \ Упражнение 7
8 VARIABLE STUFF \ первым блоком файла
9 300 STUFF \ является блок 300
10 : ЭЛЕМЕНТ ( i - а)
11 2* 1024 /MOD STUFF @ + BLOCK + UPDATE ;
12 \ Проверка виртуального массива:
13 : ИНИЦИАЛ-МАССИВ 600 0 ВО I I ЭЛЕМЕНТ ! LOOP ;
14 : .МАССИВ 600 0 DO I . SPACE I ЭЛЕМЕНТ ? LOOP ;
15
Block# 292
0 \ Ответы к упражнениям; глава 10, упражнение 7, продолжение
1
2 \ Теперь преобразуем виртуальный массив в файл:
3 : ИСПОЛЬЗОВАНО ( -- а) СВОБ @ BLOCK UPDATE ;
4 \ Переопределим ЭЛЕМЕНТ так, чтобы ИСПОЛЬЗОВАННЫЕ пропускались:
5 : ЭЛЕМЕНТ ( i - а)
6 1+ 2* 1024 /MOD СВОБ @ + BLOCK + UPDATE ;
7
8 : НЕТ-ИСП 0 ИСПОЛЬЗОВАНО ! ;
9 НЕТ-ИСП
10 : ПОМЕСТИТЬ ( n - ) ИСПОЛЬЗОВАНО @ ЭЛЕМЕНТ ! 1 ИСПОЛЬЗОВАНО +! ;
11 s ВНЕСТИ ( n1 n2 - ) SWAP ПОМЕСТИТЬ ПОМЕСТИТЬ ;
12
13 : ТАБЛИЦА CR ИСПОЛЬЗОВАНО @ 0 ?DO I 8 МOD 0= IF CR THEN
14 I ЭЛЕМЕНТ @ 8 .R LOOP CR ;
15
Block# 293
0 \ Ответы к упражнениям; глава 11
1 \ Упражнение 1:
2 : ЗАГРУЗКА ( n - ) CREATE , DOES> ( - ) @ LOAD ;
4 \ Упражнение 2:
5 : ОСНОВАНИЕ. ( n - ) CREATE ,
6 DOES> ( n -- ) @ BASE @ SWAP BASE ' SWAP . BASE ! ;
7
8 \ Упражнение 3:
9 : МНОГО ( a -- ) CREATE ,
10 DOES> ( -- ) @ SWAP 0 ?DO DUP EXECUTE LOOP DROP ;
11 ' CR МНОГО CRS
12 4 CRS
13
14
15
Block# 294
0 \ Ответы к упражнениям; глава 11, продолжение
1 \ Упражнение 4:
2 : TURNE [COMPILE] DO ; IMMEDIATE
3 : RETURNE [COMPILE] LOOP ; IMMEDIATE
4 : ПОПЫТКА 10 0 TURNE I . RETURNE ;
5
6 \ Упражнение 5:
7 : ЦИКЛЫ ( #раз - )
8 >IN @ SWAP 0 DO DUP >IN ! INTERPRET LOOP DROP ;
9
10
11
12
13
14
15
Block# 295
0 \ Ответы к упражнениям; глава 11, упражнение 6:
1 : STAR * 42 EMIT ;
2 : .РЯД ( b - ) \ вывод звездочки на каждый бит из байта
3 CR 8 0 DO DUP 128 AND IF STAR ELSE SPACE THEN
4 2* LOOP DROP ;
5 VARIABLE ШАБЛОН
6 : БИТ ( t=не-пробел - )
7 1 AND ШАБЛОН @ 2* + ШАБЛОН ! ;
8 : ЗВЕЗДЫ>БИТЫ ( а - b)
9 0 ШАБЛОН ! 8 OVER + SWAP DO I С@ BL <> БИТ LOOP
10 ШАБЛОН @ ;
11 : ЧТ-РЯД ( - b)
12 ASCII | WORD COUNT + 8 - ЗВЕЗДЫ>БИТЫ ;
13 : ФОРМА CREATE 8 0 DO ЧТ-РЯД С, . LOOP
14 DOES> 8 OVER + SWAP DO I С@ .РЯД LOOP CR ;
15
Block# 296
0 ФОРМА .L XXX |
1 X |
2 X |
3 X |
4 X |
5 X |
6 X X|
7 XXXXXXXX|
8 ФОРМА .В ХХХХХХХ |
9 X X|
10 X X|
11 XXXXXX |
12 X X|
13 X X|
14 X X|
15 XXXXXXX|
Block# 297
0 \ Ответы к упражнениям; глава 12, упражнение 1:
1 : ширина ( смещение длина - нов-смещение )
2 CREATE OVER , DUP , + ;
3 13 \ начальная позиция внутри записи
4 16 ширина фамилия
5 12 ширина имя
6 24 ширина работа
7 12 ширина телефон
8 CONSTANT /ЗАПИСЬ ( количество байт на запись ) EXIT
9 По приведенным выше правилам компилируются одинаковые структуры.
10 "ширина" является определяющим словом, которое хранит на стеке
11 текущую позицию внутри поля. Для каждого паля "ширина" компили-
12 рует смещение и длину, а затем их складывает, чтобы получить
13 следующее смещение. После того, как определится "телефон", по-
14 лученное а результате значение является длиной всей записи и
15 превращается в константу /ЗАПИСЬ
Block# 296
0 \ Ответы к упражнениям; глава 12, упражнение 2:
1 : вызвать ( имя ( -- )
2 имя запомнить ВВЕРХ -НАЙТИ IF ОТСУТСТВУЕТ
3 ELSE CR .ИМЯ телефон .ПОЛЕ THEN ;
4
5
6
7
8
9
10
11
12
13
14
15