маленькая такая задачка

mOleg

WingLion писал(а):

есть у меня подозрение, что странный код:
Код:
IF NIP DUP THEN DROP

везде можно заменить на
Код:
IF SWAP THEN DROP

все правильно!

forther

Эх, молодежь ...

: msb begin
dup dup 1- and
dup while
nip
repeat
drop
;

Mihail

WingLion писал(а):

есть у меня подозрение, что странный код:

Код:

IF NIP DUP THEN DROP

везде можно заменить на

Код:

IF SWAP THEN DROP

Это я с расчетом на СПФ.

Код:

>: xx nip dup ; see xx

58AF80 894500      MOV     0 [EBP] , EAX 
58AF83 C3      RET     NEAR 
END-CODE   Ok
>: zz swap ; see zz

58AF90 8B5500      MOV     EDX , 0 [EBP] 
58AF93 894500      MOV     0 [EBP] , EAX 
58AF96 8BC2      MOV     EAX , EDX 
58AF98 C3      RET     NEAR 
END-CODE   Ok

WingLion

forther писал(а):

: msb begin
dup dup 1- and
dup while
nip
repeat
drop
;

Почему-то у меня подозрение, что при нуле на входе этот код зациклится...

Hishnik

Точно зациклится. Кстати, на основе дихотомии решение самое эффективное (из фортовских).
А еще можно посмотреть систему команд 80386+. Мнится мне, что там есть что-то готовое для получения индекса самого старшего и самого младшего из единичных и нулевых битов.

forther

WingLion писал(а):

Почему-то у меня подозрение, что при нуле на входе этот код зациклится...

не зациклится

in4

Mihail писал(а):

58AF90 8B5500 MOV EDX , 0 [EBP]
58AF93 894500 MOV 0 [EBP] , EAX
58AF96 8BC2 MOV EAX , EDX

можно ли заменить на

Код:

874500 xchg      eax,[ebp][00000] ; код получен в HIEW 6.03, 32битовый сегмент

если да - будет фортерам счастье со SWAP !!
странно только, почему это операцию (частую!!) раньше не соптимизировали...

Mihail

in4 писал(а):

Код:

874500 xchg      eax,[ebp][00000] ; код получен в HIEW 6.03, 32битовый сегмент

если да - будет фортерам счастье со SWAP !!

Код:

xchg eax,[ebp]

Много медленнее

Код:

     MOV   EDX, [EBP]
     MOV   [EBP], EAX
     MOV   EAX, EDX

Может на новых процах это уже не так?

WingLion

WingLion писал(а):

Код:
: Чего-То 32 0 DO DUP 2/ OR LOOP 1+ 2/ ;

проверять надоть...

Решил я таки проверить то, что предложил с самого начала:

Код:

 : xx 32 0 DO DUP 2/ OR LOOP 1+ 2/ ;
Ok
xx .
Ok
DECIMAL 10 xx .
Ok
xx .
Ok
xx .
Ok
xx .
Ok
xx .
Ok
xx .
Ok
xx .
Ok

Работает, только для чисел не более чем 2<sup>15</sup>-1
на 16-разрядном Форте
Надо только заметить, что у меня Форт при включении сразу в HEX режиме работает...

WingLion

А вот, если цикл развернуть, да лишние дупы повыкидывать...

получится:

Код:

: xx DUP 2/ OR DUP 2/ 2/ OR 
  DUP 2/ 2/ 2/ 2/ OR
  DUP 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ OR  
  DUP 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ OR 
  1+ 2/ ;

Mihail

Для обработки отрицательных чисел следует
2/ заменить на U2/ .
: U2/ 1 RSHIFT ;
Вообще:

Код:

: xx 
  DUP U2/ OR 
  DUP U2/ U2/ OR 
  DUP 4 RSHIFT OR
  DUP 8 RSHIFT OR   \ для 16 разрядных чисел
  DUP 16 RSHIFT OR \ для 32 разрядных чисел
  DUP U2/ XOR
;

WingLion

Ну, тут уже по-разному можно извращаться. Главное, чтобы работало!

dream

Здрасьте всем. Дабы не флудить на форуме запостю в этот топик... В программинге полный профан, ничего "сильнее" VB (и то местами не осилил) А тут сессия подходит. Препод решил приобщить к "правильному программированию" и рассказал про Forth. Короче трабл в том что надо сделать задачку - "Алгоритм вычисления корня из целого числа" На Си вроде кое-как настрочили, а вот как его запрограмить в Forth. Заплутали в этом roll, pick, да и вообще синтаксис не понятный, блин. Может есть крутые программеры, что помогут и не дадут пропасть человеку (читай целой группе без 5 минут молодых специалистов! Жива еще студенческая солидарность?) Не могу догнать как, из примерно такого, можно что-то вынести, как высчитать корень?
1 ( n i)
0 ( n i k)
begin
2 pick > 0
while
.s
repeat ;

Mihail

dream писал(а):

На Си вроде кое-как настрочили, а вот как его запрограмить в Forth.

Я алгоритма не знаю. Покажи на Си будет на Форте.

Icefall

Алгоритм Ньютона: X[0]=X/2; X[I+1]=X[I]/2+X/X[I]/2
Код на основе Баранова&Ноздрунова. У них было для 16-разрядной версии Форта; сейчас у нас 32 бита, поэтому можно проще:

Код:

: SQRT ( n -- s )  dup 2 < IF 0 MAX EXIT THEN
    DUP 2/  ( -- n s )
    BEGIN  2DUP / OVER  ( -- n s n/s s )
           + 2/ ( -- n s s' )
       SWAP OVER ( -- n s' s s' )
     - ABS 2 < UNTIL NIP ;

В скобках - комментарии. Набирать не обязательно

маленькая такая задачка

Кто сейчас на конференции