roboforum.ru

chu писал(а): - 2. поправил самописный amforth-4.2_uploader.spf;

Штатный uploader написан на Python и работает только на linux. Не поделитель своим? Под Windows будет работать?

Alex-chin писал(а): Не поделитель своим?

Нивопрос. Только никто не обещает, что будет легко
Там наверняка граблей по кустам расставлено вместо роялей.
Определение upload сырое, надо бы переработать, да все как-то...
работает же
- Весьма напрягают множественные вложения IF..ELSE..THEN - некрасиво это както, не по-фортофски ( не фортово
- Отсутствует обработка сообщений amforth'a ?? об ошибках - загрузчик просто отваливается, сказав something wrong, aborted. Как правило, amforth не нашол какое-либо слово.
Наверняка есть и другие нюансы, но если это интересно, думаю совместно доведем загручик до ума. Успехов.

Спасибо!

В последнем варианте загрузчика была допущена досадная ошибка.
Ошибка исправлена. Работоспособность загрузчика проверена.
Вложение в моем предыдущем посте отредактировано.
Но на всякий случай работоспособный загрузчик приложу еще раз.

о! Спасибо!

Ok! Кто в последний раз видел г-на Chu ?
Вот только я умудрился залить amForth 4.6 в arduino UNO r3, а товаришь Chu пропал!?

Ну что же, это опять я, всем привет.
Я вернулся после долгого отсутствия благодаря тому что проявился интерес к данной теме, появились люди, появились вопросы. спасибо им. in forth we trust. ( гы, типа веруем в будущее
но начну с прошлого. за истекший период времени произошли довольно значительные изменения, таким образом предыдущие вложения практически неактуальны.

обновленный аплоудер, по-прежнему не вполне нравится, но по-любому - лучше прежнего:

написан на форте, на российском SPF4.
кстати, буржуины признают SPF4 как один из самых быстрых ( среди бесплатных) и вполне рекомендуют к применению.
к аплоудеру прилагается допиленный мною до нужной кондиции модулек для работы с КОММ портом:


также обновил amforth до версии 4.8 - тоже ребята не сидят сложа руки, молодцы.
все их новшества не вкурил, но они точно есть. правда выхватил у них пару косяков - некоторые весьма критичны для "устаревших" микроконтроллеров. напрмер моя мега32А не выходила на связь с терминалом. расковырял, нашел - явная ошибка. убил несколько дней.
выдержка из лога трабблов:

Код: Выделить всё • Развернуть

11:03 22.03.2012

определенно не работает приемник (кажется)
по крайнеймере компорттулкит отсылает, но ничего не получает в ответ
курю...words\usart.asm 

вижу такое ( в листинге)

000100 3841        .dw XT_DOLITERAL
000101 0006        .dw USART_C_VALUE
000102 3841        .dw XT_DOLITERAL
000103 00c0        .dw USART_C | bm_USARTC_en
000104 387e        .dw XT_CSTORE

или я дурак или явная ошибка

попутано USART_C_VALUE и USART_C
щаз проверю

заменил на

  .dw XT_DOLITERAL
  .dw USART_C_VALUE | bm_USARTC_en
  .dw XT_DOLITERAL
  .dw USART_C
  .dw XT_CSTORE

зашибись! работает! ахренеть!
странно это, так как по умолчанию UCSRC инициализируется 
точно таким же значением - см. стр. 162 даташита на мегу 32 
( документ 2503O–AVR–07/09)

впрочем, это не единственная кривость, есть и другие, связанные с именами регистров МК. проявляются во время компиляции проекта. кто будет собирать amforth самостоятельно - пишите, помогу.

местами пришлось поработать напильником над исходниками amforth'а - чувствовал себя довольно неуютно, но зато поимел опыт и (развоевавшись) прикрутил к системе переменную, в которой хранится источник ресета

Код: Выделить всё • Развернуть

amforth 4.8 ATmega32A 16000 kHz 
reset source= 2 

> 

думается, будет полезна в будущем ( в некоторых случаях - весьма полезна)

коренным образом перелопатил свой модулёчек tttt1.f - захотелось мне параметр для ?delay задавать не плюс/минус лапоть, а поточнее. чтобы не терять времени сверх необходимого при работе с 1-проводными девайсами. теперь они расчитываются us/ ( u1 -- u2 ) , где u1 - потребные микросекунды, u2 - параметр ?delay

много игрался с времянками, познавательно получилось.
временнЫе ( в тиках, тактах) накладные расходы адресной интерпретации и доступа к памяти:

Код: Выделить всё • Развернуть

\ +------------------+------+
\ |     action       | ticks|
\ +------------------+------+
\ | execute...........  19  |
\ | exit/enter........  27  |
\ | variable @ .......  45  |
\ | value ( eeprom ).. 298  |
\ | constant..........  14  |
\ | @ ................   4  |
\ | ! ................  12  |
\ +-------------------------+
\

всетаки нарисую весь код tttt1.f, прошу простить:

Код: Выделить всё • Развернуть

\
\ tttt1.frt - timer1 tools for timing tests
\
\ 12:17 27.04.2012  *chu* небольшие улучшения,
\                         добавил рaсчет параметра ?delay
\ 11:13 24.04.2012  *chu* изменил запуск таймера с прескалером
\ 21:06 09.10.2010  *chu*
\
\ =============================================================
\
\ !!! check if .x already exist  !!!
\ : .x base @ swap hex u. base ! ;

 marker =tttt1=

 only forth also assembler
 decimal

\ =============================================================
  code  int-restore  ( sreg -- )
        SREG $20 - R24 out,
        R24  Y+ ld,
        R25  Y+ ld,
  end-code
\ =============================================================

\ stop timer1
  code t1>   
        TCCR1B $20 - R2 out,   
  end-code


\ ( n -- )
\ start timer1 with n clock source

  code <t1
        R16    $7    ldi,   \ mask for Clock Select bits
        R16    R24   and,

        R24    Y+     ld, 
        R25    Y+     ld,

        R17    TCCR1B
               $20  - in,

        R17    $F8  andi,   \ clear Clock Select bits
        R17    R16    or,   \ set Clock source

        TCCR1B 
        $20  -  R17  out,
  
  end-code


\   : delay ( n -- ) begin 1- dup 0= until drop ;

  code delay
 label> 
        R24  1  sbiw,   \ 2
      <radr     brne,   \ 2/1
                 nop,   \ 1
        R24  Y+   ld,   \ 2
        R25  Y+   ld,   \ 2
  end-code

\   : ?delay ( n -- ) begin dup 0= not while 1- again drop ;

  code ?delay           \ ticks
        R16  R24 mov,   \ 1
        R16  R25  or,   \ 1
       adr>     breq,   \ 2/1
                 nop,   \ 1
 label>
        R24  1  sbiw,   \ 2
      <radr     brne,   \ 2/1
                 nop,   \ 1
 <labelb
        R24  Y+   ld,   \ 2
        R25  Y+   ld,   \ 2
  end-code


  previous 

 0 TCCR1A c!
 0 TCCR1B c!

\  stop timer1 & zero counter
 : <t1>  t1> 0 dup TCNT1H c! TCNT1L c! $3c TIFR c! ;


\ ( -- n ) get timer1 counter value
 : t1@  TCNT1L c@ TCNT1H c@ 8 lshift + ;

\ ( -- ? ) check timer1 overflow
 : tov1?
        TIFR  dup c@ $4 and   \ test  TOV1 flag
        swap over swap  c!   \ clear TOV1 by writing'1'
        ;

\  display t1 counter

 : t1@.  dup
        ." (0x" .x ." )"
        bl emit u. ." ticks"
        ;

 : ?tov1. ( ? -- )
        if   bl emit ." overrun"
        then cr
        ;

 : t1.  t1@   t1@.
        tov1? ?tov1.
        ;

\ timing test using timer1, xt - executable address
\ ( *x xt -- *y )

\  : ?ticks  <t1> 1 <t1 execute t1> t1. ;

\ "честный" подсчет тиков,  без тиков, затраченных на 
\ исполнение execute ( decimal 19 ) и t1> ( decimal 1 )

  : ?ticks.   ( x* xt -- y* )
        <t1> 1 <t1 execute t1> 
        t1@  [ decimal ] 19 - 1 -
        t1@. tov1? ?tov1.
        ;

\
\ =============================================================
\ note: 
\ +------------------+------+
\ |     action       | ticks|
\ +------------------+------+
\ | execute...........  19  |
\ | exit/enter........  27  |
\ | variable @ .......  45  |
\ | value ( eeprom ).. 298  |
\ | constant..........  14  |
\ | @ ................   4  |
\ | ! ................  12  |
\ +-------------------------+
\
\ =============================================================
\

  f_cpu
   1000 ud/mod  rot drop
   1000 ud/mod  rot drop drop

    value ticks/1us    \ тики в 1мкс 
$4  value ticks/1decr  \ тики на один декремент в ?delay



 : ?ticks ( -- n ) <t1> 1 <t1 execute t1> t1@ ;
 
 : .ticks tov1? ?tov1. t1@. ; 

 : u0.r >r 0 <# r> 0 ?do # loop #> type ;

\ пересчет тиков в микросекунды ( u0.r required )

 : .us  ( u -- )
        base @ decimal swap bl emit ." = "
         ticks/1us u/mod . $8 emit ." ."
          begin  ?dup while
           1000  ticks/1us */mod 3 u0.r
          repeat bl emit ." us" cr
        base !
        ;

\  1 value t1>#ticks
\  base @ decimal 19 value execute#ticks  base !
\  base @ decimal 27 value exit/enter#ticks  base !
 

\ расчет параметров для ?delay
\ decimal 103 =
\ exit/enter+constant+exit/enter+?delay+exit/enter
\     27    +    14  +   27     +   8  +  27

\ u1 - микросекунды
\ u2 - параметр ?delay
\

 : us/  ( u1 -- u2 )
        ticks/1us *
        [ base @ decimal ] 103 [ base ! ]
        dup >r max r> -
        ticks/1decr u/mod swap 2/ + 
        ;
\
\ =============================================================
\

по приведенному коду - вопросы, критика, идеи людей понимающих - приветствуются!
основная цель перестройки модуля - us/, так писать гораздо удобнее:

Код: Выделить всё • Развернуть

  : 1w-reset
        dq+ -int 
        dq-
        [ 480 us/ ] literal
          ?delay             ( H )
        dq+
        int-restore
        ;

в целом, работает:

Код: Выделить всё • Развернуть

> : test10us <t1> 1 <t1 [ 10 us/ ] literal ?delay t1> t1@ ;
 ok
> test10us dup .ticks .us

(0xA0 ) 160 ticks = 10 . us
 ok
> 

хотя, какие-то смутные сомнения... все же имеют место быть - не с кем было посоветоваться, когда я это крутил.
да, и еще: минимальная задержка, которую обеспечивает ?delay:
0 =
(0x67 ) 103 ticks = 6.437500 us

впрочем, еще раз повторюсь - тщательная и независимая проверка - весьма желательна.
засим, пока откланяюсь.
Moving forth
хм, дажа интересно - попрут меня отсюда с каким то там фортом...?

chu писал(а):Ну что же, это опять я, всем привет.
[кусь]
обновленный аплоудер, по-прежнему не вполне нравится, но по-любому - лучше прежнего:
написан на форте, на российском SPF4.
кстати, буржуины признают SPF4 как один из самых быстрых ( среди бесплатных) и вполне рекомендуют к применению.
[кусь]

хотя, какие-то смутные сомнения... все же имеют место быть - не с кем было посоветоваться, когда я это крутил.
да, и еще: минимальная задержка, которую обеспечивает ?delay:
0 =
(0x67 ) 103 ticks = 6.437500 us

впрочем, еще раз повторюсь - тщательная и независимая проверка - весьма желательна.
засим, пока откланяюсь.
Moving forth
хм, дажа интересно - попрут меня отсюда с каким то там фортом...?

Знающие люди сидят на SPF4!!!
Я конечно извиняюсь (давно не занимался электроникой и почти всё позабыл), а разве тики не зависят от частоты?
Хотел проверить tttt1.frt, но столкнулся с приколом. Требуется подключение assembler.frt, а там в первых строках

Код: Выделить всё • Развернуть

assembler definitions  \ vocabulary

. Вроде по дефолту не определён словарь assembler?
Если попрут, то ты не теряйся!

ilya73 писал(а):Знающие люди сидят на SPF4!!!
Я конечно извиняюсь (давно не занимался электроникой и почти всё позабыл), а разве тики не зависят от частоты?

тики от частоты не зависят. 8 тиков - что на 8 МГц, что на 16 МГц - всерно 8 тиков,
времена другие, именно поэтому я перевел все в тики, а все остальные расчеты опираются на f_cpu

ilya73 писал(а):Хотел проверить tttt1.frt, но столкнулся с приколом. Требуется подключение assembler.frt, а там в первых строках

Код: Выделить всё • Развернуть

assembler definitions  \ vocabulary

. Вроде по дефолту не определён словарь assembler?

я сделал так (поправил прямо в буржуинском исходнике) - assembler поместил в отдельный словарь:

Код: Выделить всё • Развернуть

 marker =assembler=
hex
  vocabulary    assembler            \ 14:01 27.07.2011 chu
only forth also assembler  definitions   

это в начале, а в конце исходника:

Код: Выделить всё • Развернуть

 previous definitions 

вернулся опять в forth словарь ( vocabulary )

Добавлено спустя 16 минут:
каждое слово ( в выделенном "кодом" тексте) для forth-системы - это команда.
иными словами: форт-система восприняв ( распознав ) слово, исполняет какие-то вполне определенные действия.

Ок! Попробую в воскресенье (вечером) загрузить-проверить. А новое в 1-wire имеются?

ilya73 писал(а):Ок! А новое в 1-wire имеются?

код, реализующий базовые 1-wire операции, изменил с учетом слова us/
( у меня имеется две макетки с мегами32 - на 8МГц и на 16МГц )вроде получилось удобно - система сама расчитывает параметр ?delay во время загрузки (компиляции).

Код: Выделить всё • Развернуть

\
\ 1-wire 
\
\ *chu* 20:41 07.12.2010*
\       20:30 12.12.2010* 
\ *chu* 14:17 24.04.2012* add 1-Wire Master Timing calculation
\ =============================================================
\

  marker =1-wire=

\ 1-wire master timing  = Standard Recommended Speed
\
\                 A     =    6 us
\                 B     =   64 us
\                 C     =   60 us
\                 D     =   10 us
\                 E     =    9 us
\                 F     =   55 us
\                 G     =    0
\                 H     =  480 us
\                 I     =   70 us
\                 J     =  410 us
\
\ ===============================================================
\ |   us/ ( n1 -- n2 )  n1 - микросекунды, n2 - параметр ?delay |
\ |   us/ defined in tttt1.f module                                  |
\ ===============================================================
\
\ базовые примитивы:
\ DetectPresence,ReadBit,WriteBit0,WriteBit1,SendByte,ReceiveByte
\  1w-presence?  1w-bit@   1w-0!     1w-1!    1w-c!     1w-c@


  4 constant 1w

  PORTC 1w portbit#: dq   \ assembler name
  PORTC 1w portpin:  DQ   \ highlevel name

\
  
  only forth also assembler decimal

  code ?dq- \ begin DQ pin_low?  until 
       label>
        dq 2 - swap sbic,
       <radr rjmp,
  end-code
  
  code ?dq+ \ begin DQ pin_high? until 
       label>
        dq 2 - swap sbis,
       <radr rjmp,
  end-code


  code  dq+
        dq over over 1 -
        swap cbi, \ set input
        swap sbi, \ and pull-up
  end-code
  
  code  dq-
        dq over over 1-
        swap sbi, \ set output
        swap cbi, \ and low
  end-code
  
  code   (1w-bit@) \ 1 rshift DQ pin@ if $80 or then
        R24 lsr,
        dq  $2 - swap sbic,
        R24 $80 ori,
  end-code

  previous 

\ basic operations on 1-wire bus

  : 1w-reset
        dq+ -int 
        dq-
        [ 480 us/ ] literal  ?delay  ( H )
        dq+
        int-restore
        ;

  : 1w-presence?  ( -- f ) \ is anybody alive on 1-wire bus?
        dq+ -int 
        dq-
        [ 480 us/ ] literal  ?delay  ( H )
        DQ
        dq+
        [  70 us/ ] literal  ?delay  ( I )
        pin@ 0=
        swap int-restore
        ;

  : 1w-1!
        dq+ -int 
        dq-
        [   6 us/ ] literal  ?delay  ( A )
        dq+
        [  64 us/ ] literal  ?delay  ( B )
        int-restore
        ;

  : 1w-0!
        dq+ -int 
        dq-
        [  60 us/ ] literal  ?delay  ( C )
        dq+
        [  10 us/ ] literal  ?delay  ( D ) 
        int-restore
        ;

  : 1w-bit@ ( c -- c' )
        dq+ -int swap
        dq-
        [   6 us/ ] literal  ?delay  ( A )
        dq+
        [   9 us/ ] literal  ?delay  ( E ) 
         (1w-bit@) 
        [  55 us/ ] literal  ?delay  ( F )
        swap int-restore
        ;

        
 \ byte transmission functions

  : 1w-c!   ( c -- )
        8 0 do
            dup 1 and if
             1w-1!  else
             1w-0!  then
            1 rshift
        loop drop
        ;
  
  : 1w-c@   ( -- c )
        0  8 0 do 1w-bit@ loop
        ;

 \ block transmission functions

  : 1w!  ( addr n -- )
        over + swap
        do i c@ 1w-c! loop
        ;

  : 1w@  ( addr n -- )
        over + swap
        do 1w-c@ i c! loop
        ;
  
\
\ =============================================================
\
\
\

  marker =dallas=
  

  $01  constant  id_DS2401    \ Silicon Serial Number 
  $10  constant  id_DS18S20   \ 1-Wire Parasite-Power Digital Thermometer
  $28  constant  id_DS18B20   \
  $22  constant  id_DS1822    \ Programmable Resolution 1-Wire Digital Thermometer
  
\ DS1820/DS1822    ROM COMMANDS
  $F0  constant     SEARCH_ROM
  $33  constant     READ_ROM
  $55  constant     MATCH_ROM
  $CC  constant     SKIP_ROM
  $EC  constant     ALARM_SEARCH

\ DS1820/DS1822    FUNCTION COMMANDS
  $44  constant     CONVERT_T
  $4E  constant     WRITE_SCRATCHPAD
  $BE  constant     READ_SCRATCHPAD
  $48  constant     COPY_SCRATCHPAD
  $B8  constant     RECALL_E2   
  $B4  constant     READ_POWER_SUPPLY

 \ структуры памяти ds18x2x

   0       \ rom
   1   --   1w_family
   6   --   1w_id#
   1   --   1w_crc
  constant /1w_rom

   0       \ scratchpad
   1   --   mem.tl
   1   --   mem.th
   1   --   mem.rth
   1   --   mem.rtl
   1   --   mem.config
   1   --   mem.5
   1   --   mem.6
   1   --   mem.7
   1   --   mem.crc
  constant /scratchpad

 \ выделение памяти
 here dup /1w_rom     dup allot erase value @dallas
 here dup /scratchpad dup allot erase value @scratchpad

\
\ =============================================================
\  

поисковый алгоритм:

Код: Выделить всё • Развернуть

\
\
\
\ ****************************************************
\
\  1-Wire Search Algorithm
\   (APPLICATION NOTE 187)
\
\ ****************************************************
\ @dallas - буфер для 64битового ключа ( сетевой уровень )
\

\    anew  =1w-search=
   marker  =1w-search=

    only forth decimal

\   1w.f required
\ crc8.f required
\ ****************************************************
\
\ флаги/переменные для 1-wire search algorithm

      \ предыдущий поиск нашел последнего
  $0 value LastDeviceFlag
      \ номер бита с которого должен начинаться ( следующий ) поиск
  $0 value LastDiscrepancy
  $0 value LastFamilyDiscrepancy
        \ номер бита, куда был записан последний 0 при несовпадении
  $0 value last_zero       \ variable #last-zero
  $0 value search_direction   \ variable search-dir


\ 1 constant lsb#
\ ****************************************************
\ @dallas /1w_rom 

    : rom_crc?  ( 's a n -- crc8 )
        @dallas /1w_rom  $crc8    \ 0= successful
        ;   

    : 1wbit?  ( -- bit ~bit  )
        0 1w-bit@
        0 1w-bit@
        ;

\
    \ no device found then reset counters
    \ so next 'search' will be like a first
    : no_1w ( -- 0 )
        0 to LastDiscrepancy
        0 to LastFamilyDiscrepancy
        0 to LastDeviceFlag
        0
        ;

\
    \ n =  номер бита в @dallas ( 63..0 )
    \ # = маска бита , a = адрес байта.
    : rom_bit#  ( n -- a # )
        $08  /mod @dallas + 
        swap lsb# 
        swap lshift
        ;
   
    \ операции с битом: установка, сброс, чтение
    : rom_bit+   ( n -- )
        rom_bit#
        over  c@ or
        swap  c!
        ;
 
    : rom_bit-   ( n -- )
        rom_bit# invert
        over  c@ and
        swap  c!
        ;
        
    : rom_bit@   ( n -- b )
        rom_bit#
        swap  c@ and 
        ;

\
\ cmd - SEARCH_ROM or ALARM_SEARCH command

    : 1w_search ( cmd -- f ) 

        1w-presence? if

            LastDeviceFlag 0= if
           
            0 to last_zero ( cmd ) 1w-c!
           
            $41 $01
            do
               1wbit?

               over over and if    \ оба бита ==1, выход
               drop drop
               cr ." no devices"
               cr ." bit#: " i .
               unloop   exit then

               over =         if
            drop
                 i LastDiscrepancy  =  if
                 1 to search_direction else
                 
                      i LastDiscrepancy  >   if
                      0 to search_direction  else
                      i 1- rom_bit@
                      to search_direction  then  
                                    then
                                    
                 search_direction 0=   if
                     i dup to last_zero
                     9 <  if last_zero to LastFamilyDiscrepancy then
                                         then
                                else
               ( bit ) to search_direction
                                then
                      
               search_direction    if
               i 1- rom_bit+ 1w-1! else
               i 1- rom_bit- 1w-0! then
            loop
            
            last_zero dup to LastDiscrepancy 0= if
                     true to LastDeviceFlag     then
                
            LastDiscrepancy  LastFamilyDiscrepancy = if
                        0 to LastFamilyDiscrepancy   then
                    
                                    rom_crc? 0= if
                                    true  exit  then

                              else       
                   drop no_1w  cr 
                ." last found" cr then
               
                         else       
              drop no_1w cr
        ." not found" cr 
                     then
        ;
       
\       
\ ****************************************************
\ сканирование сети 1-wire, построение таблицы устройств
\
\
\
    0  value 1w_last   \ количество 1-wire приборов на шине 
   $10 value max_1w   \ кол-во 1-wire устройств ( 16*8= 128байт )

  \ таблица 1-wire устройств
  \ here dup max_1w /1w_rom * dup allot erase value 1w_devices

  here dup page-size dup allot erase value storage-buff

\
\ ****************************************************
\
\ копирование 64бит идентификатора из буфера @dallas
\ в таблицу устройств, i - индекс устройства в таблице
  : 1w_romt!   ( i -- )
      /1w_rom * 
       storage-buff + 
       @dallas swap 
      /1w_rom cmove
      ;

\ копирование 64бит идентификатора из таблицы устройств
\ в буфер @dallas, i - индекс устройства в таблице
  : 1w_romt@   ( i -- )
      /1w_rom * 
       storage-buff +
       @dallas 
      /1w_rom cmove
      ;

\
  : .1w_discovered
        cr 1w_last base @ swap decimal . base !
        space ." devices detected"
        ;

\
\ ****************************************************
\
\
\
\ тестовое слово
\  : .1w_search
\   
\       cr LastDeviceFlag  ." LastDeviceFlag="  $09 emit .x
\       cr LastDiscrepancy ." LastDiscrepancy=" $09 emit .x
\       cr LastFamilyDiscrepancy ." LastFamilyDiscrepancy=" $09 emit .x
\       cr last_zero ." last_zero=" $09 emit .x
\       cr search_direction ." search_direction=" $09 emit .x
\       cr ." 1w-rom:" 
\       @dallas /1w_rom over + swap
\        do space i c@ .x loop
\       space rom_crc? if ." bad crc" else ."  crc ok" then
\   
\       cr
\        ;
\
\
\ ****************************************************
\

выглядит конечно же ужасно, но ... так получилось
просто в свое время я его переписал с сишного примера, практически один к одному.
в то время он работал под SPF4, а базовые 1-wire примитивы были прошиты в микроконтроллер ( MSP430 ). форт-система отсылала МК команды, МК исполнял затребованные подпрограммы и возвращал результат в форт-систему. работало довольно медленно за счет постоянного обмена м/у MSP430 и SPF4, зато отлаживалось, как песня.
а потом я перенес код из SPF4 в amforth без существенных изменений
заработало сразу!

ниже приведу прикладной код, который ( как есть) предназначен скорее для ознакомления, исследования и экспериментов с сетью microlan.
задачи создать законченное устойство - не стояло.
из особенностей могу отметить следующее:
- на моих макетках к каждой меге прилагается i2c serial eeprom 24c512
общей емкостью 64К байт = 512 страниц (секторов) по 128 байт
- соответственно в ram выделяется буфер storage-buff под один сектор
- соответственно количество 1-wire устройств на шине ограничено: 128/8=16 штуками
- процедура сканирования сети строит таблицу обнаруженных приборов либо в
озу ( storage-buff ) либо непосредственно в eeprom 24c512, в выделенном секторе
(1w-page). значение value-переменной 1w-buff@ определяет расположение создаваемой таблицы

Код: Выделить всё • Развернуть

\
\
\ 12:56 25.09.2011 vm/chu
\
\ ****************************************************
\ i2c-24c512.f crc8.f  1w.f 1w-search required
\ 1w-sensors.f this file
\
\ ****************************************************
\
\
    decimal
\    anew =sensors=
   marker =sensors=

 \ номер сектора в 24c512 где сохраняется таблица микролан
  ee/page 1- constant 1w-page

          \ флаг-селектор 0== таблица строится
          \ непосредственно в EEPROM
    0 value 1w-buff@   \ 1w-eeprom

    0 dup value 1w-lan
    \
    1 cells  -- 1w.pin#      \ pin connection
    1 cells  -- lan.name   \ counted string pointer
    1 cells  -- storage>   \ start addr at i2c-eeprom
    1 cells  -- lan.size   \ nuber of sensors
    1 cells  -- lan.crc16   \
    constant   /1w-lan
        
    0 dup value sensor
    1 cells  -- sensor.name   \ location : room, outdoor, heater, etc.
    1 cells  -- sensor.id#   \ table index
    1 cells  -- sensor.power   \
    constant   /sensor
    
\ ****************************************************

\ чтение/запись /1w_rom bytes буфера @dallas
\ из/в индексированную таблицу в serial EEPROM
\
    : #i>ee-addr  ( i -- ee-addr )
        /1w_rom * 
         1w-page #page>addr +
        ;

    : 1w-seet!   ( i --  )   \
        #i>ee-addr >r 
        @dallas /1w_rom r> 
        >eeprom
        drop
        ;

    : 1w-seet@   ( i --  )   \
        #i>ee-addr >r 
        @dallas /1w_rom r> 
        eeprom>
        drop
        ;

\
\ ****************************************************
\ 
\ сканирование сети, построение таблицы
  : 1w_scan

        no_1w to 1w_last

        SEARCH_ROM
        begin
   
        dup 1w_search if
         
        1w_last dup 
                1w-buff@ if
                1w_romt! else
                1w-seet! then
        1+ to 1w_last
                      else  
        .1w_discovered 
        drop exit     then
     
        LastDeviceFlag 
        until drop
        .1w_discovered 
        ;
\
\ выбор 1-wire девайса из таблицы
  : 1w_select ( i --  )
        1w-presence? 
        if
           1w-buff@ if
           1w_romt@ else
           1w-seet@ then
          MATCH_ROM  
          1w-c!
          @dallas /1w_rom 1w!
        else
          drop
        then
        ;
\
\ ****************************************************
\

  : 1w_pwr?  ( i -- t/f )
        1w_select
        READ_POWER_SUPPLY
        1w-c! 0 
        1w-bit@
        ;

  : .mode
        if   ." powered,  "
        else ." parasite, "
        then
        ;

  : 1w-lookup
        1w_last 0
        ?do  cr i
        dup . ." :" 1w_pwr? .mode
         @dallas 1w_family c@
         id_DS18S20 over = if ." DS18S20" then
         id_DS18B20 over = if ." DS18B20" then
         id_DS1822  over = if ." DS1822"  then
        drop
        loop cr
        ;

\
\ ****************************************************
\
\ чтение данных из выбранного девайса с проверкой контрольной суммы
\ в буфер 1W_SCRATCHPAD
  : 1w_read  ( i -- f )
        1w_select
        READ_SCRATCHPAD 
        1w-c!
        @scratchpad /scratchpad 1w@ 
        @scratchpad /scratchpad $crc8
        ; 

\ запуск преобразования,
  : 1w_convert ( i-- )
        1w_select
        CONVERT_T
        1w-c!
        begin 0 1w-bit@ until
        ;

\ измерение,считывание результата в @scratchpad
\ f=1 success

  : 1w_sensor@ ( i -- f )
        dup
        1w_convert
        1w_read 0=
        ;

\ преобразование измерения

  : t_convert ( -- n )
        @scratchpad mem.tl c@
        @scratchpad mem.th c@
        8 lshift +

        @dallas  1w_family c@
        $20 and              \ ds18B20 or ds1822
        if 2/ 2/ 2/ then 2/  \ только целые числа

        @scratchpad mem.th c@
        $f8 and 
        if $ff80 or then     \ sign
        ;

\

  : t-monitor
        begin cr
          1w_last 0 
          ?do
           i dup . 1w_sensor@
           if t_convert . then cr 
          loop
          1000 ms pause
        key?  
        until
        key drop
        ;

\
\ ====================================================
\

осталось упомянуть циклическую контрольную сумму.
в первом варианте вычислялась только crc8 ( как таблично, так и процедурой), но потом ( об этом как-нибудь в другой раз) мне зохотелось еще и crc16.
приведу последний вариант:

Код: Выделить всё • Развернуть

\
\ 
\
\ appnote AVR318 : Dallas 1-Wire® master 
\
\ Two different CRC’s are commonly found in 1-Wire devices. 
\ *********************************************************
\
\

 $0      value    msb#
 $01     constant lsb#

    : lsb  lsb# and ;

 $18     constant poly-8     \ x**8  + x**5  + x**4 + 1
 $4002   constant poly-16    \ x**16 + x**15 + x**2 + 1
 
 $0      value    polynom
 
    : crc8!
          poly-8  to polynom
          $80     to msb#
          ;
          
    : crc16!
          poly-16 to polynom
          $8000   to msb#
          ;

\ Описанный ниже алгоритм используется для вычисления
\ двух разных CRC-кодов.
\ crc8! crc16!
\ использование value-переменной создает существенные
\ временные задержки ( 353 тика для получения значения )
\ табличные методы более скоростные 

    : crc   ( 's c  --- crc )
      8 0
        do
           over over xor lsb 
           if swap 
           polynom xor 1 rshift  msb#  or
           else   swap 1 rshift
           then   swap 1 rshift
        loop 
        drop
        ;

\
\
    : $crc   ( a # --- crc )
        0 -rot over + swap
        do   i c@ crc loop
        ;

\
\ ****************************************************
\
\ построение таблицы crc ( SPF4 )
\
\  : crctab  ( -- )
\        CR
\        4 SPACES ." create" BL EMIT
\        polynom
\      CASE
\        poly-8  OF ." crc8tab"  ENDOF
\        poly-16 OF ." crc16tab" ENDOF
\      ENDCASE
\        CR
\        0 0x100 0 DO DUP I crc I 0x8 /MOD DROP 0=
\                     IF CR 0x09 EMIT
\                     THEN ." 0x" .X ." , "
\                  LOOP DROP CR
\        ;
\
\ *********************************************************
\
    create crc16_table

        $0000 , $C0C1 , $C181 , $0140 , $C301 , $03C0 , $0280 , $C241 , 
        $C601 , $06C0 , $0780 , $C741 , $0500 , $C5C1 , $C481 , $0440 , 
        $CC01 , $0CC0 , $0D80 , $CD41 , $0F00 , $CFC1 , $CE81 , $0E40 , 
        $0A00 , $CAC1 , $CB81 , $0B40 , $C901 , $09C0 , $0880 , $C841 , 
        $D801 , $18C0 , $1980 , $D941 , $1B00 , $DBC1 , $DA81 , $1A40 , 
        $1E00 , $DEC1 , $DF81 , $1F40 , $DD01 , $1DC0 , $1C80 , $DC41 , 
        $1400 , $D4C1 , $D581 , $1540 , $D701 , $17C0 , $1680 , $D641 , 
        $D201 , $12C0 , $1380 , $D341 , $1100 , $D1C1 , $D081 , $1040 , 
        $F001 , $30C0 , $3180 , $F141 , $3300 , $F3C1 , $F281 , $3240 , 
        $3600 , $F6C1 , $F781 , $3740 , $F501 , $35C0 , $3480 , $F441 , 
        $3C00 , $FCC1 , $FD81 , $3D40 , $FF01 , $3FC0 , $3E80 , $FE41 , 
        $FA01 , $3AC0 , $3B80 , $FB41 , $3900 , $F9C1 , $F881 , $3840 , 
        $2800 , $E8C1 , $E981 , $2940 , $EB01 , $2BC0 , $2A80 , $EA41 , 
        $EE01 , $2EC0 , $2F80 , $EF41 , $2D00 , $EDC1 , $EC81 , $2C40 , 
        $E401 , $24C0 , $2580 , $E541 , $2700 , $E7C1 , $E681 , $2640 , 
        $2200 , $E2C1 , $E381 , $2340 , $E101 , $21C0 , $2080 , $E041 , 
        $A001 , $60C0 , $6180 , $A141 , $6300 , $A3C1 , $A281 , $6240 , 
        $6600 , $A6C1 , $A781 , $6740 , $A501 , $65C0 , $6480 , $A441 , 
        $6C00 , $ACC1 , $AD81 , $6D40 , $AF01 , $6FC0 , $6E80 , $AE41 , 
        $AA01 , $6AC0 , $6B80 , $AB41 , $6900 , $A9C1 , $A881 , $6840 , 
        $7800 , $B8C1 , $B981 , $7940 , $BB01 , $7BC0 , $7A80 , $BA41 , 
        $BE01 , $7EC0 , $7F80 , $BF41 , $7D00 , $BDC1 , $BC81 , $7C40 , 
        $B401 , $74C0 , $7580 , $B541 , $7700 , $B7C1 , $B681 , $7640 , 
        $7200 , $B2C1 , $B381 , $7340 , $B101 , $71C0 , $7080 , $B041 , 
        $5000 , $90C1 , $9181 , $5140 , $9301 , $53C0 , $5280 , $9241 , 
        $9601 , $56C0 , $5780 , $9741 , $5500 , $95C1 , $9481 , $5440 , 
        $9C01 , $5CC0 , $5D80 , $9D41 , $5F00 , $9FC1 , $9E81 , $5E40 , 
        $5A00 , $9AC1 , $9B81 , $5B40 , $9901 , $59C0 , $5880 , $9841 , 
        $8801 , $48C0 , $4980 , $8941 , $4B00 , $8BC1 , $8A81 , $4A40 , 
        $4E00 , $8EC1 , $8F81 , $4F40 , $8D01 , $4DC0 , $4C80 , $8C41 , 
        $4400 , $84C1 , $8581 , $4540 , $8701 , $47C0 , $4680 , $8641 , 
        $8201 , $42C0 , $4380 , $8341 , $4100 , $81C1 , $8081 , $4040 , 

\
\ *********************************************************
\ табличное вычисление crc16

\ одного байта 
    : @crc16   ( s' c -- crc16 )
        over xor $FF and cells crc16_table + @i swap 8 rshift xor
        ;

\ строки в озу
    : $crc16   ( a # --- crc16 )
        0  -rot over + swap
        do i c@ @crc16 loop
        ;


\ тест
\ >S" 123456789" $crc16 .X BB3D  Ok
\ соответствует приведенному в руководстве Росса Уильямса
\ *********************************************************
\
\
\ ****************************************************
\ таблица кодов циклической контрольной суммы
\    anew  =crc8tab=
    create crc8_table

        $5E00 , $E2BC , $3F61 , $83DD ,  
        $9CC2 , $207E , $FDA3 , $411F ,  
        $C39D , $7F21 , $A2FC , $1E40 ,  
        $015F , $BDE3 , $603E , $DC82 ,  
        $7D23 , $C19F , $1C42 , $A0FE ,  
        $BFE1 , $035D , $DE80 , $623C ,  
        $E0BE , $5C02 , $81DF , $3D63 ,  
        $227C , $9EC0 , $431D , $FFA1 ,  
        $1846 , $A4FA , $7927 , $C59B ,  
        $DA84 , $6638 , $BBE5 , $0759 ,  
        $85DB , $3967 , $E4BA , $5806 ,  
        $4719 , $FBA5 , $2678 , $9AC4 ,  
        $3B65 , $87D9 , $5A04 , $E6B8 ,  
        $F9A7 , $451B , $98C6 , $247A ,  
        $A6F8 , $1A44 , $C799 , $7B25 ,  
        $643A , $D886 , $055B , $B9E7 ,  
        $D28C , $6E30 , $B3ED , $0F51 ,  
        $104E , $ACF2 , $712F , $CD93 ,  
        $4F11 , $F3AD , $2E70 , $92CC ,  
        $8DD3 , $316F , $ECB2 , $500E ,  
        $F1AF , $4D13 , $90CE , $2C72 ,  
        $336D , $8FD1 , $520C , $EEB0 ,  
        $6C32 , $D08E , $0D53 , $B1EF ,  
        $AEF0 , $124C , $CF91 , $732D ,  
        $94CA , $2876 , $F5AB , $4917 ,  
        $5608 , $EAB4 , $3769 , $8BD5 ,  
        $0957 , $B5EB , $6836 , $D48A ,  
        $CB95 , $7729 , $AAF4 , $1648 ,  
        $B7E9 , $0B55 , $D688 , $6A34 ,  
        $752B , $C997 , $144A , $A8F6 ,  
        $2A74 , $96C8 , $4B15 , $F7A9 ,  
        $E8B6 , $540A , $89D7 , $356B ,  

\
\
    : @crc8   ( c --- crc8 )
        $ff and
        2 /mod crc8_table + @i
        swap if >< then
        $ff and
        ;

\ строки в озу
    : $crc8   ( a # --- crc8 )
        0  -rot  over  +  swap
        do i c@ xor @crc8 loop
        ;

\
\ ****************************************************
\

комментировать не буду, вроде и так понятно, отмечу только, что одна процедура умеет посчитать либо crc8! либо crc16!
упомянутую книгу http://bookz.ru/authors/ross-vil_ams/williamsrs01.html
читал дважды, ниразу ниасилил, туповат. взял оттуда полиномы и сверил результат, вродебы все верно.
че-та я устал, четыре часа уже тружусь, пойду пока
Moving Forth

По поводу 1-wire есть маленькое пожелание:
изменить

Код: Выделить всё • Развернуть

4 constant 1w

  PORTC 1w portbit#: dq   \ assembler name
  PORTC 1w portpin:  DQ   \ highlevel name

на чё-нить из серии юзер-дефайнед, т.е. либа одна, а порт юзверь может переопределить в своём исходнике сам!?

ilya73 писал(а):По поводу 1-wire есть маленькое пожелание:
изменить

Код: Выделить всё • Развернуть

4 constant 1w

  PORTC 1w portbit#: dq   \ assembler name
  PORTC 1w portpin:  DQ   \ highlevel name

на чё-нить из серии юзер-дефайнед, т.е. либа одна, а порт юзверь может переопределить в своём исходнике сам!?

нивапрос, как надо, так и переопределяйте.
разница м/у portbit#: и portpin: в том, что portpin:
возвращает адрес порта и маску бита, а portbit#: - адрес порта и номер бита. номер бита используется в машинных инструкциях sbic и sbis
определение:

Код: Выделить всё • Развернуть

marker =portbit=

\ в отличие от portpin:
\ используется номер бита, а не маска

  only forth also assembler decimal

  code (portbit#)
   R16 R25 mov,
       R25 clr,
   -Y  R25 st,
   -Y  R16 st,
  end-code

  previous

  : portbit#:
        create 8  lshift swap $20 - or , 
        does>  @i (portbit#)
        ;

go forth

chu писал(а):

ilya73 писал(а):По поводу 1-wire есть маленькое пожелание:
изменить

Код: Выделить всё • Развернуть

4 constant 1w

  PORTC 1w portbit#: dq   \ assembler name
  PORTC 1w portpin:  DQ   \ highlevel name

на чё-нить из серии юзер-дефайнед, т.е. либа одна, а порт юзверь может переопределить в своём исходнике сам!?

нивапрос, как надо, так и переопределяйте.

go forth

Я это к чему, чтобы не было разброда и шатания (я у себя в либе поменяю константу, Вася Пупкин поменяет), а было единообразие.
IMHO Нефиг мне (без особой нужды) своими кривыми ручками лезть в грамотно написанный код! И для совместимости пользительней!

ilya73 писал(а):

chu писал(а):

ilya73 писал(а):По поводу 1-wire есть маленькое пожелание:
изменить

Код: Выделить всё • Развернуть

4 constant 1w

  PORTC 1w portbit#: dq   \ assembler name
  PORTC 1w portpin:  DQ   \ highlevel name

на чё-нить из серии юзер-дефайнед, т.е. либа одна, а порт юзверь может переопределить в своём исходнике сам!?

нивапрос, как надо, так и переопределяйте.

go forth

Я это к чему, чтобы не было разброда и шатания (я у себя в либе поменяю константу, Вася Пупкин поменяет), а было единообразие.
IMHO Нефиг мне (без особой нужды) своими кривыми ручками лезть в грамотно написанный код! И для совместимости пользительней!

распределение пинов МК - дело интимное (ответственное), определяется поставленной задачей. у моей меги32 - выводов побольше, чем у 328-ой. посмотрел распиновку, в твоем случае удобно использовать portD.4 альтернативные функции этого вывода - вход частоты для usart или счетный вход таймера0. инными словами, выделенный код необходимо изменить:

Код: Выделить всё • Развернуть

  PORTD 4 portbit#: dq   \ assembler name
  PORTD 4 portpin:  DQ   \ highlevel name

определение константы 1w - не более, чем графоманский изыск