amForth Morse Code

Die erste Implementierung ist sehr gradlinig mit einem Forth-Wort für jeden Morse-Buchstaben und einer grossen IF-THEN Konstruktion im Hauptteil:

\ 2011-10-26  EW
\ 2011-11-02  CS
\ arduino duemilanove + danger shield
\ morse code stuff (Potsdam/Augsburg/Oberhausen)

marker --morse--

\ je ein Forth-Wort pro Morse-Buchstabe
: _A  kurz lang Zend ;
: _B  lang kurz kurz kurz Zend ;
: _C  lang kurz lang kurz ;
: _D  lang kurz kurz Zend ;
: _E  kurz Zend ;
: _F  kurz kurz lang kurz Zend ;
: _G  lang lang kurz Zend ;
: _H  kurz kurz kurz kurz Zend ;
: _I  kurz kurz Zend ;
: _J  kurz lang lang lang Zend ;
: _K  lang kurz lang Zend ;
: _L  kurz lang kurz kurz Zend ;
: _M  lang lang Zend ;
: _N  lang kurz Zend ;
: _O  lang lang lang Zend ;
: _P  kurz lang lang kurz Zend ;
: _Q  lang lang kurz lang Zend ;
: _R  kurz lang kurz Zend ;
: _S  kurz kurz kurz Zend ;
: _T  lang Zend ;
: _U  kurz kurz lang Zend ;
: _V  kurz kurz kurz lang Zend ;
: _W  kurz lang lang Zend ;
: _X  lang kurz kurz lang Zend ;
: _Y  lang kurz lang lang Zend ;
: _Z  lang lang kurz kurz Zend ;


\ Variable zum Speichern des original 'emit'
variable o-emit

\ neues Emit zum Ausgeben von Zeichen als Morse-Code
: morseemit ( key -- )
  dup o-emit @ execute        ( original 'emit' aufrufen )
  dup [char] a = if _A then
  dup [char] b = if _B then
  dup [char] c = if _C then
  dup [char] d = if _D then
  dup [char] e = if _E then
  dup [char] f = if _F then
  dup [char] g = if _G then
  dup [char] h = if _H then
  dup [char] i = if _I then
  dup [char] j = if _J then
  dup [char] k = if _K then
  dup [char] l = if _L then
  dup [char] m = if _M then
  dup [char] n = if _N then
  dup [char] o = if _O then
  dup [char] p = if _P then
  dup [char] q = if _Q then
  dup [char] r = if _R then
  dup [char] s = if _S then
  dup [char] t = if _T then
  dup [char] u = if _U then
  dup [char] v = if _V then
  dup [char] w = if _W then
  dup [char] x = if _X then
  dup [char] y = if _Y then
  dup [char] z = if _Z then
  dup bl           = if Wend then  ( Leerzeichen = Wortende )
  drop
  Zend   ( Zeichenende )
;

\ neues 'morseemit' in 'emit' eintragen
: morse
  ['] emit defer@ o-emit !
  ['] morseemit is emit
;

\ original 'emit' wieder herstellen
: endmorse
  o-emit @ is emit 
;

In dieser Version des Morse-Programms nutzen wir immer noch Forth-Wörter für die Signale, aber ersetzten die Grosse IF-THEN Verzweigung durch eine Spring-Tabelle. Die Sprung-Tabelle enhält 256 Einträge für die 256 ASCII-Zeichen. In den Tabellen-Einträgen befindet sich die Adresse des jeweiligen Forth-Worts (Execution Token = xt), welches die Signale für den Morse-Code ausgibt. Ist ein Tabelleneintrag '0' so ist dieser Eintrag nicht gefüllt und es wird kein Morse-Code ausgegeben.

\ 2011-10-26  EW
\ 2011-11-02  CS
\ arduino duemilanove + danger shield
\ morse code stuff (Potsdam/Augsburg/Oberhausen)
\ 2nd version

marker --morse--

: _A  kurz lang Zend ;
: _B  lang kurz kurz kurz Zend ;
: _C  lang kurz lang kurz ;
: _D  lang kurz kurz Zend ;
: _E  kurz Zend ;
: _F  kurz kurz lang kurz Zend ;
: _G  lang lang kurz Zend ;
: _H  kurz kurz kurz kurz Zend ;
: _I  kurz kurz Zend ;
: _J  kurz lang lang lang Zend ;
: _K  lang kurz lang Zend ;
: _L  kurz lang kurz kurz Zend ;
: _M  lang lang Zend ;
: _N  lang kurz Zend ;
: _O  lang lang lang Zend ;
: _P  kurz lang lang kurz Zend ;
: _Q  lang lang kurz lang Zend ;
: _R  kurz lang kurz Zend ;
: _S  kurz kurz kurz Zend ;
: _T  lang Zend ;
: _U  kurz kurz lang Zend ;
: _V  kurz kurz kurz lang Zend ;
: _W  kurz lang lang Zend ;
: _X  lang kurz kurz lang Zend ;
: _Y  lang kurz lang lang Zend ;
: _Z  lang lang kurz kurz Zend ;

\ erstelle Tabelle fuer execution token
variable mtable 256 cells allot

\ loesche Tabelle
mtable 256 cells erase

\ Hilfswort zum fuellen der Tabelle
: >mtable ( xt c -- )
  cells mtable + !
;

\ Tabelle zur kompilierzeit fuellen
' _A char a >mtable
' _B char b >mtable
' _C char c >mtable
' _D char d >mtable
' _E char e >mtable
' _F char f >mtable
' _G char g >mtable
' _H char h >mtable
' _I char i >mtable
' _J char j >mtable
' _K char k >mtable
' _L char l >mtable
' _M char m >mtable
' _N char n >mtable
' _O char o >mtable
' _P char p >mtable
' _Q char q >mtable
' _R char r >mtable
' _S char s >mtable
' _T char t >mtable
' _U char u >mtable
' _V char v >mtable
' _W char w >mtable
' _X char x >mtable
' _Y char y >mtable
' _Z char z >mtable
' Wend   bl >mtable

variable o-emit

: morseemit ( key -- )
  dup o-emit @ execute ( altes emit ausfuehren )
  255 and              ( sicherstellen das wir nur 0-255 Werte bekommen )
  cells mtable + @       ( execution token holen ) 
  dup if execute       ( wenn > 0 dann ausfuehren ) 
      else drop then   ( ansonsten wegwerfen )
;

: morse
  ['] emit defer@ o-emit !
  ['] morseemit is emit
;

: endmorse
  o-emit @ is emit 
;

Morse-Code Signale als Forth-Wörter speichern ist einfach, verbraucht aber recht viel Flash-Speicher. Morse-Code Signale können in je einem Byte (8 bit) gespeichert werden. In der dritten Version des Morse-Programms werden bis zu fünf Morse-Signale in den oberen 5 Bits gespeichert ( 0 = kurz, 1 = lang ), die unteren 3 Bits speichern die Anzahl der Signale im Morse-Code. Hierdurch reduziert sich der Speicherverbrauch des Programms.

Die Tabelle mit dem gepackten Morse-Code wird vom Forth-Interpreter zur Kompilierzeit erstellt und verbraucht bei der Ausführung keine extra Rechenzeit:

\ 2011-10-26  EW
\ 2011-11-04  CS
\ arduino duemilanove + danger shield
\ morse code stuff (Potsdam/Augsburg/Oberhausen)
\ 3nd version

marker --morse--

\ erstelle Tabelle fuer gepackte morse daten
variable mtable 256 allot

\ loesche Tabelle
mtable 256 erase

\ Hilfswort zum fuellen der Tabelle
: >mtable ( gepackter-morsecode c -- )
  mtable + c!
;

\ Hilfswort zum packen vor morse code
: pack ( #zeichen code -- pcode )
  3 lshift swap 7 and or
;

: unpack ( pcode -- #zeichen code )
  dup 7 and swap 3 rshift 
;

: binary 2 base ! ;

\ Tabelle zur kompilierzeit fuellen
binary 00010 decimal 2 pack char a >mtable
binary 00001 decimal 4 pack char b >mtable
binary 01010 decimal 4 pack char c >mtable
binary 00001 decimal 3 pack char d >mtable
binary 00000 decimal 1 pack char e >mtable
binary 00100 decimal 4 pack char f >mtable
binary 00011 decimal 3 pack char g >mtable
binary 00000 decimal 4 pack char h >mtable
binary 00000 decimal 2 pack char i >mtable
binary 01110 decimal 4 pack char j >mtable
binary 00101 decimal 3 pack char k >mtable
binary 00010 decimal 4 pack char l >mtable
binary 00011 decimal 2 pack char m >mtable
binary 00001 decimal 2 pack char n >mtable
binary 00111 decimal 3 pack char o >mtable
binary 00110 decimal 4 pack char p >mtable
binary 01101 decimal 4 pack char q >mtable
binary 00010 decimal 3 pack char r >mtable
binary 00000 decimal 3 pack char s >mtable
binary 00001 decimal 1 pack char t >mtable
binary 00001 decimal 3 pack char u >mtable
binary 00001 decimal 4 pack char v >mtable
binary 00011 decimal 3 pack char w >mtable
binary 01001 decimal 4 pack char x >mtable
binary 01011 decimal 4 pack char y >mtable
binary 00011 decimal 4 pack char z >mtable

variable o-emit

: domorse ( code #signale -- ) 
  0 ?do                ( Schleife Anzahl der Signale )
    dup 1 and          ( erstes bit maskieren )
    if lang            ( bit gesetzt = lang )
    else kurz then     ( sonst kurz )
    2/                 ( bits nach rechts schieben )
  loop
  drop Zend            ( Zeichenende )
;

: morseemit ( key -- )
  dup o-emit @ execute ( altes emit ausfuehren )
  255 and              ( sicherstellen das wir nur 0-255 Werte bekommen )
  dup bl = if          ( leerzeichen? )
    Wend               ( Wortende zeit warten )
  then 
  mtable + c@          ( gepackten morse code holen )
  unpack               ( entpacken )
  domorse              ( signale ausgeben )
;

: morse
  ['] emit defer@ o-emit !
  ['] morseemit is emit
;

: endmorse
  o-emit @ is emit 
;

• Wie kann das Morse-Code Programm weiter optimiert werden (weniger Speicherverbrauch)?
• erweitere das Programm, so das auch Zifferns als Morse-Code ausgegeben werden
• erweitere das Programm, so das auch Sonderzeichen als Morse-Code ausgegeben werden

Antworten auf diese Aufgaben können auf Mastodon gepostet werden. Bitte Geduld wenn ich nicht sofort antworte, ich kann leider nicht immer online sein.