vd-archiv:listings:4d2006-03-listings
Inhaltsverzeichnis
4d2006-03 Listings
SMBus Basiscode
\ 2006-07-31 SMBus.fs --- SMBus Basiscode
\ i2c Bus am R8C
\ P1.0 -- SCL
\ P1.1 -- SDA
\ Konstanten
0 Constant PinSCL
1 Constant PinSDA
port1 Constant PortI2C
$E3 Constant PddrI2C
\ SDA,SCL Pins auf 0 oder 1 setzen
: sda0 PinSDA PortI2C bclr ;
: sda1 PinSDA PortI2C bset ;
: scl0 PinSCL PortI2C bclr ;
: scl1 PinSCL PortI2C bset ;
\ 1 SCL Zyklus sind im Programm 4 ticks
: tick 1 us ;
: 2tick tick tick ;
\ sende 1 Bit
: bit>i2c ( bit -- )
IF sda1 ELSE sda0 ENDIF
tick scl1 2tick scl0 tick ;
\ erzeuge Bit Nr. i aus Byte x als 0 oder 1
: getBit ( x i -- b ) rshift $01 and ;
\ sende 1 Byte, (8 Bit) "most significant bit" zuerst
: >i2c ( x -- )
8 0 DO
dup 8 I 1+ - getBit
bit>i2c
LOOP
drop ;
\ sende START, STOP, REPEATED_START
: i2c_start ( -- ) tick sda0 2tick scl0 tick ;
: i2c_stop ( -- ) tick scl1 2tick sda1 tick ;
: i2c_rstart sda1 tick scl1 tick sda0 tick scl0 tick ;
\ setze SDA zum Lesen / Senden
: sdaInput ( -- ) PinSDA PddrI2C bclr ;
: sdaOutput ( -- ) PinSDA PddrI2C bset ;
\ lies SDA
: readSDA ( -- f )
PinSDA PortI2C btst IF 1 ELSE 0 ENDIF ;
\ lies 1 Byte (8 Bit), "most significant bit" zuerst
: <i2c ( -- x )
sdaInput
0
8 0 DO
1 lshift
tick scl1 tick readSDA tick scl0 tick
+
LOOP
sdaOutput ;
\ lies ACK (0) oder NACK (1) vom Partner
: ack<i2c ( -- f )
sdaInput
tick scl1 tick readSDA tick scl0 tick
sdaOutput ;
\ sende N Bytes nach Adresse addr
\ das "most significant Byte" liegt oben auf dem Stapel
: NB>i2c ( x1 .. xN.msB N addr -- )
i2c_start \ START
>i2c ack<i2c drop \ ADRESSE senden, ACK lesen
0 DO \ Schleife, nimmt N vom Stapel
>i2c ack<i2c drop \ DATA_BYTE verschicken
LOOP \ Ende Schleife
i2c_stop \ STOP
;
\ lies N Bytes von Adresse addr
\ das "least significant Byte" liegt oben auf dem Stapel
\ Adresse und ControlByte sind schon verschickt
: NB<i2c ( N addr -- xN.msB .. x1 )
i2c_rstart \ REPEATED_START
1+ >i2c ack<i2c drop \ ADRESSE | READ senden, ACK lesen
1- dup 0 > IF \ Schleife ueber N-1 Byte
0 DO \ Datenbyte = 0 (initialisieren)
<i2c 0 bit>i2c \ DATA_BYTE lesen, ACK schicken
LOOP \ Ende Schleife
ENDIF \
<i2c 1 bit>i2c \ letzes Byte lesen, NACK schicken
i2c_stop \ STOP
;
\ finis
adv_01
\ 2006-06-28 EW adv_01.fs
\
\ i2c_bus connected to r8c
\ P1.0 -- SCL
\ P1.1 -- SDA
\ device PCF8574 (8bit IO) at address $20
rom
include SMBus.fs
$40 Constant i2c_addr_portexpander
\ send Byte x to portexpander
: >portexpander ( x -- )
i2c_start \ START
i2c_addr_portexpander >i2c \ Adresse schreiben
ack<i2c drop \ ACK lesen und verwerfen
>i2c \ Datenbyte schreiben
ack<i2c drop \ ACK lesen und verwerfen
i2c_stop \ STOP
;
\ watch the show!
Variable N
0 N !
: run
0 >portexpander
1000 ms
BEGIN
N @
dup invert >portexpander
1+ N !
1000 ms
key? UNTIL
;
ram
\ finis
adv_02
\ 2006-06-28 EW adv_02.fs
\
\ i2c Bus am R8C
\ P1.0 -- SCL
\ P1.1 -- SDA
\ am Bus:
\ PCF8574 (8bit IO), 7-bit Adresse: $20
rom
include SMBus.fs
$40 Constant i2c_addr_portexpander
\ vom portexpander lesen
: <portexpander ( -- x )
$ff \ "ControlByte"
1 i2c_addr_portexpander NB>i2c
1 i2c_addr_portexpander NB<i2c
;
ram
\ finis
adv_03
\ 2006-06-28 EW adv_03.fs --- Thermometer
\
\ i2c Bus am R8C
\ P1.0 -- SCL
\ P1.1 -- SDA
\ am Bus:
\ PCF8574 (8bit IO), 7-bit Adresse: $20
\ LM75 (Thermometer, 9-bit signed, 7-bit Adresse: $4f
rom
include SMBus.fs
$9e Constant i2c_addr_lm75
: get.T ( -- xh xl )
$00 \ ControlByte
1 i2c_addr_lm75 NB>i2c \ verschicken
2 i2c_addr_lm75 NB<i2c \ 2 Byte lesen
;
: decode.T ( xh xl -- T*10 )
$80 and \ die ungueltigen Bits loeschen
swap \ xh nach oben holen
8 lshift \ xh << 8
+ \ == (xh << 8) + ( xl & 0x80)
5 128 */ \ == T*10
;
\ _always_ display sign '+' or '-'
: sign! 0 < IF 45 ELSE 43 ENDIF hold ;
\ format T for display (type or lcdtype)
: format.T ( T*10 -- )
dup >R \ store copy for sign
abs s>d \ remove sign, make double
\ 1 digit, "." 2digits sign_always
\ Numbers >= 1000 are truncated in the high digits!!!
<# # 46 hold # # R> sign! #> \ == "%+5.1f"
;
\ write string to lcd position col (0..15) row (0..1)
\ with next lcdtype
: lcdpos ( row col -- )
swap $40 * + $80 + lcdctrl! &1 ms ;
: thermometer
lcdpage
BEGIN
0 5 lcdpos
get.T decode.T format.T lcdtype
250 ms
key? UNTIL
;
ram
\ finis
Sudoku
\ Nach geladenem Gforth-R8C ueber die Tastatur in das
\ RAM des R8Cs eingeben. Danach per SAVESYSTEM
\ "festfrieren". Kann per EMPTY bis auf das eigentliche
\ Forth-System geloescht werden.
\ Ich verwende im gesamten Programm Grossschreibung.
\ Kleinschreibung reicht aber. Das System ist auf
\ egal voreingestellt.
HEX
\ Sudoku-Matrix, zeilenweise, pro Element ein Byte
CREATE M
0 C, 1 C, 2 C, 3 C, 4 C, 5 C, 6 C, 7 C, 8 C,
3 C, 4 C, 5 C, 6 C, 7 C, 8 C, 0 C, 1 C, 2 C,
6 C, 7 C, 8 C, 0 C, 1 C, 2 C, 3 C, 4 C, 5 C,
1 C, 2 C, 3 C, 4 C, 5 C, 6 C, 7 C, 8 C, 0 C,
4 C, 5 C, 6 C, 7 C, 8 C, 0 C, 1 C, 2 C, 3 C,
7 C, 8 C, 0 C, 1 C, 2 C, 3 C, 4 C, 5 C, 6 C,
2 C, 3 C, 4 C, 5 C, 6 C, 7 C, 8 C, 0 C, 1 C,
5 C, 6 C, 7 C, 8 C, 0 C, 1 C, 2 C, 3 C, 4 C,
8 C, 0 C, 1 C, 2 C, 3 C, 4 C, 5 C, 6 C, 7 C,
\ Hole Element in Zeile i und Spalte j von Matrix M
: IJ@ ( i j -- a[ij] ) SWAP 9 * + M + C@ ;
\ Speichere Element in Zeile i und Spalte j nach Matrix M
: IJ! ( a[ij] i j -- ) SWAP 9 * + M + C! ;
\ Addiere n modulo 9 zu saemtlichen Elementen von Matrix M
: ADDn ( n -- )
51 0 DO DUP M I + C@ + 9 MOD M I + C! LOOP DROP ;
\ INDEX
VARIABLE IX
\ Vertausche willkuerlich 2 Spalten einer Laengsdreierreihe in Matrix M
: XCHJ ( -- ) IX @ C@ 9 0
DO DUP 9 MOD DUP DUP 3 MOD 0> IF 1 - ELSE 1+ THEN
2DUP I SWAP IJ@ I ROT IJ@ ROT I SWAP IJ! I ROT IJ!
LOOP DROP ;
\ Vertausche Zeile 3 und 5 und Zeile 7 und 8 in Matrix M
: XCHI ( -- ) 9 0
DO 3 I IJ@ 5 I IJ@ 3 I IJ! 5 I IJ! 7 I IJ@ 8 I IJ@ 7 I IJ! 8 I IJ!
LOOP ;
\ ASCII --> Ziffernausgabe
: ZIFF ( n -- ) DUP 8 U> IF DROP SPACE SPACE ELSE 1+ . THEN ;
\ IX um 5 weitersetzen
: I5+! ( -- ) IX @ DUP 600 > IF 300 - THEN 5 + IX ! ;
\ Zufaellige Auslassungen
\ Etwa 27d Elemente bleiben als Vorgabe stehen. Breite Streuung!
: RAND ( n -- m ) IX @ C@ 3 MOD IF DROP 20 THEN I5+! ;
\ Bildschirmdarstellung von geaenderter Vorgabematrix
: V ( -- ) CR 9 0
DO 9 0 DO J I IJ@ ZIFF LOOP 5 SPACES
9 0 DO J I IJ@ RAND ZIFF LOOP CR
LOOP ;
\ Neue Sudoku-Matrix mit passender Vorgabematrix
: S ( -- ) IX @ C@ ADDN XCHI XCHJ I5+! V ;
\ Will man zu ein und derselben (Loesungs-)Matrix M verschiedene
\ Vorgabematrizen erzeugen, dann rufe man (beliebig oft) V auf.
\ Bei jedem erneuten Aufruf von V wird die bis dato erreichte
\ Sudoku-Matrix M beibehalten, waehrend die Vorgabematrix neu er-
\ zeugt wird.
\ Selbstverstaendlich kann man eine erreichte Vorgabematrix
\ auch per Hand ausbessern: Man uebernehme (und notiere auf
\ Papier) nur, sagen wir, 27d Elemente oder ergaenze (bei zu
\ wenigen Vorgabeelementen) Elemente durch Einfuegen von der
\ Sudoku-Matrix M her.
\ Man kann eine erreichte Sudoku-Matrix M auch per Hand aendern:
\ Dazu stehen die drei Forth-Worte x ADDN XCHI XCHJ (in
\ beliebiger Anwendungsreihenfolge) zur Verfuegung. x kann
\ eine beliebige Zahl sein.
\ Geaenderte Vorgabe-Matrizen bei gleichbleibender Sudoku-
\ Matrix werden durch V angezeigt. Geaenderte Sudoku-Matrizen
\ mit passender Vorgabe-Matrix werden durch S angezeigt.
\ Solche Tastatureingaben muessen natuerlich immer durch
\ [return] abgeschlossen werden, um Wirksamkeit zu erlangen.
Arithmetik in Galois Feldern, Grundkoerper F_p
( Arithmetik in Galois Feldern, Grundkoerper F_p )
: Restklassen ;
variable F_pp
2 F_pp ! \ Vorbesetzung mit 2
: F_p+ ( a b -- a+b ) + F_pp @ mod ;
: F_p- ( a b -- a-b ) - F_pp @ mod ;
: F_p* ( a b -- a*b ) * F_pp @ mod ;
: F_p/ ( a b -- a/b )
swap 0 swap ( b 0 a) ( oder b q r )
begin
rot dup >r \ q r b
/mod \ q r delta-q
rot + \ r q
r> swap rot dup \ b q r r
F_pp @ + swap \ b q r' r
0=
until
drop swap drop ;
\ Einrichtung des gesonderten F_p^n Stapels entfaellt hier
\ ************ weil nur fuer F_p^2 *******************
2 constant F_p^nn
F_p^nn cell * constant F_p^2#bytes \ Speicherplatz fuer eine Zahl aus F_p^2
\ --------------------------------------------------------------
\ Arithmetik fuer Galois-Felder F_p^n auf dem Parameterstapel
\ nur Spezialfall n=2 und Polynom a^2+a+1=0
\ dieses Polynom ist irreduzibel fuer z. B. p= 2, 5
: F_p^2+ ( a0 a1 b0 b1 -- a0+b0 a1+b1 )
swap >r f_p+ swap r> f_p+ swap ;
: F_p^2- ( a0 a1 b0 b1 -- a0-bo a1-b1 )
swap >r f_p- swap r> f_p- swap ;
: F_p^2* ( a0 a1 b0 b1 -- c0 c1 )
\ c0 = a0*b0 - a1*b1
\ c1 = a1*b0 + a0*b1 - a1*b1
dup >r swap dup >r \ a0 a1 b1 b0 |R b0 b1
rot dup >r f_p* \ a0 b1 a1*b0 |R a1 b0 b1
rot dup >r \ b1 a1*b0 a0 |R a0 a1 b0 b1
rot f_p* f_p+ \ a1*b0+a0*b1 |R a0 a1 b0 b1
r> r> r> rot \ a1*b0+a0*b1 a1 b0 a0 |R b1
f_p* swap r> f_p* \ a1*b0+a0*b1 a0*b0 a1*b1 |R
dup >r f_p- \ a1*b0+a0*b1 a0*b0-a1*b1 |R a1 b1
swap r> f_p- ; \ a0*b0-a1*b1 a1*b0+a0*b1-a1*b1 |R
: konj ( a0 a1 -- a0+a1 a1 )
dup rot f_p+ swap ; \ nur falls Polynom a^2+a+1=0 korrekt
: F_p^2/ ( a0 a1 b0 b1 - c0 c1 )
\ aehnlich wie durch Erweiterung mit dem konjugiert komplexen Nenner
\ machbar, Als Uebungsaufgabe empfohlen.
;
\ -----------------------------------------------------------------
\ Variablen und Konstanten
: F_p^2variable
create [ F_p^2#bytes ] literal allot ;
: F_p^2!
dup [ F_p^2#bytes 1- ] literal + swap
do
i ! 4
+loop ;
: F_p^2@ dup 1- swap [ F_p^2#bytes 2 / ] literal +
do
i @ -4
+loop ;
f_p^2variable test
\ finis
vd-archiv/listings/4d2006-03-listings.txt · Zuletzt geändert: 2017-05-21 18:24 von mka