Forth

Forth on Raspberry Pi sudo apt-get install wget wget http://www.fourmilab.ch/atlast/download/1.2/atlast-1.2.tar.gz tar -xzvf atlast-1.2.tar.gz cd atlast-1.2/ make Or, get it all, source code added from this tutorial: sudo apt-get install git git clone https://github.com/skvamme/atlast.git cd atlast make

Start the Forth interpreter with ./atlast and exit with Ctrl + d.

atlast.html and atlast.pdf is included and is an extensive ATLAST Forth manual. Read it online and read about Forth itself here  and here  (Beware that the Forth dialect in the book Starting Forth is a bit outdated compared to ATLAST Forth). Leo Brodie wrote another book, Thinking Forth, read it here and here

BQ Aquaris command line compass
I noticed the other day that I can compile ATLAST on my Raspberry Pi 2 and run it on my BQ Aquaris, Ubuntu Touch @UBports mobile phone. Just copy the compiled ATLAST program from your Raspberry Pi to the phablet home directory on Ubuntu Touch. And here's Forth code for a command line compass that you can try. The latest version is at https://github.com/skvamme/command-line-compass ( Calibrate and read bq aquaris magnetometer ) ( author Stina Kvamme )

FILE fd 32 string magraw 32 string accraw 2variable xmin 2variable xmax 2variable ymin 2variable ymax 2variable zmin 2variable zmax 2variable x 2variable y 2variable z 3.14159265358979323846 2constant pi ( values from last findextremes hardcoded ) 19.0 xmax 2! -87.0 xmin 2! -12.0 ymax 2! -125.0 ymin 2! 136.0 zmax 2! 33.0 zmin 2!

( Read string from magnetometer: "-38 -91 125". Put in string magraw ) ( -- )
 * magdevread "/sys/devices/platform/msensor/driver/sensordata" 1 fd fopen drop fd magraw fgets drop fd fclose ;

( str -- z y x )
 * tofloat strint swap strint swap strint swap drop float rot float 4 roll float ;

( Remove hard iron distortion ) ( z y x -- z1 y1 x1 )
 * calibrate xmax 2@ xmin 2@ f+ 2.0 f/ f- 2rot

zmax 2@ zmin 2@ f+ 2.0 f/ f- 2rot ymax 2@ ymin 2@ f+ 2.0 f/ f- 2rot ;

( -- )
 * heading magdevread magraw tofloat calibrate 2swap atan2 180.0 f* pi f/ -1.0 f* 2dup 0.0 f< if 360.0 f+ then fix . cr 2drop ;


 * run begin heading 1000000 sleep again ;

( ********************************* Calibration words ********************************************************* )

( find the extremes of x y and z. Puts result in variables ) ( z y x -- )
 * minormax x 2! y 2! z 2!

z 2@ zmax 2@ f> if z 2@ zmax 2! then z 2@ zmin 2@ f< if z 2@ zmin 2! then y 2@ ymax 2@ f> if y 2@ ymax 2! then y 2@ ymin 2@ f< if y 2@ ymin 2! then x 2@ xmax 2@ f> if x 2@ xmax 2! then x 2@ xmin 2@ f< if x 2@ xmin 2! then ;


 * printval

." "xmax: " xmax 2@ f. ." " xmin: " xmin 2@ f. cr ." "ymax: " ymax 2@ f. ." " ymin: " ymin 2@ f. cr ." "zmax: " zmax 2@ f. ." " zmin: " zmin 2@ f. cr ;

( loop the minormax to find the extremes. Let it run for a few minutes while moving the phone in all directions ) ( -- )
 * findextremes 1000.0 xmin 2! -1000.0 xmax 2! 1000.0 ymin 2! -1000.0 ymax 2! 1000.0 zmin 2! -1000.0 zmax 2!

begin magdevread magraw tofloat minormax printval again ; Put the code in a file compass.atl and start ATLAST ./atlast -icompass.atl run

Adding new Gertboard words
Most of the power of ATLAST Forth derives from the ease with which C coded primitives can be added to the language. In my case I will add some words for controlling my Gertboard. There is a detailed description on how to add new words in the ATLAST Forth manual. And you can copy much of the word implementations from the gertboard_sw directory if you have downloaded and compiled the gertboard demo files.

wget http://www.raspberrypi.org/phpBB3/download/file.php?id=2510 unzip gertboard_sw.zip cd gertboard_sw make

UPDATE: If you have Raspberry Pi 2 the Gertboard demo is not working due to a change in memory layout. Open gb_common.c in an editor and change at line 38 #define BCM2708_PERI_BASE       0x20000000 to #define BCM2708_PERI_BASE        0x3F000000 save, exit and make again.

It is easy to add your own words, just add a "define GERTBOARD" to atlast.c around line 56.
 * 1) define EVALUATE                     /* The EVALUATE primitive */
 * 2) define FILEIO                       /* File I/O primitives */
 * 3) define GERTBOARD                    /* Gertboard functions */

Include gb_common.h and gb_spi.h right after include :
 * 1) ifdef MATH
 * 2) include 
 * 3) endif


 * 1) ifdef GERTBOARD
 * 2) include "gb_common.h"
 * 3) include "gb_spi.h"
 * 4) endif

Then add your own word definitions at the end of the section with word definitions, around line 2704, right after #endif /* COMPILERW */ in atlast.c:
 * 1) ifdef GERTBOARD

prim P_gert_io // state --- { // Setup and restore I/O Sl(1); if(S0 == 1) setup_io; // Map the I/O sections else restore_io; // Unmap and free memory Pop; }

prim P_gert_setport // Channel state --- { // Set a digital io port to a specified state int rev; Sl(2); if (S1 == 21) { // Find out which revision of Raspberry Pi we have rev = pi_revision; if (rev != 1) S1 = 27; // GP21 on Gertboard is controlled by GPIO27 } INP_GPIO(S1); OUT_GPIO(S1); if (S0 == 1) GPIO_SET0 = (1<<S1); else GPIO_CLR0 = (1<<S1); Pop2; }

prim P_gert_getport // channel --- state { // Get a digital I/O port int rev; Sl(1); if (S0 == 21) { // Find out which revision of Raspberry Pi we have rev = pi_revision; if (rev != 1) S0 = 27; // GP21 on Gertboard is controlled by GPIO27 } INP_GPIO(S0); S0 = !!(GPIO_IN0 & (1 << S0)); }


 * 1) endif /* GERTBOARD */

And finally, add the actual words to the Table of primitive words, right after #endif /* EVALUATE */ at line 2960 or so. {"0EVALUATE", P_evaluate},
 * 1) ifdef EVALUATE
 * 1) endif /* EVALUATE */

{"0GERTBOARD", P_gert_io}, {"0SETIO", P_gert_setport}, {"0GETIO", P_gert_getport},
 * 1) ifdef GERTBOARD
 * 1) endif /* GERTBOARD */

As we are using code from the Gertboard demos, softlink the files gb_common.o, gb_common.h, gb_spi.o and gb_spi.h from the gertboard_sw directory to atlast-1.2 directory. ln -s ~/gertboard_sw/gb_common.o gb_common.o ln -s ~/gertboard_sw/gb_common.h gb_common.h ln -s ~/gertboard_sw/gb_spi.o gb_spi.o ln -s ~/gertboard_sw/gb_spi.h gb_spi.h Add gb_common.o and gb_spi.o to the file Makefile in atlast-1.2. ATLOBJ = atlast.o gb_common.o gb_spi.o atlmain.o Now, save and run "make" again to recompile atlast.c.

Test the new words
Wire up the Gertboard according to the information you get when you run the command sudo ./leds in the Gertboard demo directory.

Run sudo ./atlast in the atlast-1.2 directory.

Type 1 gertboard

Type 22 1 setio and press enter, the corresponding LED will go on.

Type 22 0 setio and the LED will go off.

Type 0 gertboard

Play with it
Define your own LED demo, start the interpreter with sudo ./atlast. Define these words:
 * use 1 ;
 * free 0 ;
 * leds 25 24 23 22 21 18 17 11 10 9 8 7 ;
 * on 12 0 do 1 setio loop ;
 * off 12 0 do 0 setio loop ;

Now type: use gertboard leds on leds off free gertboard

A real Use Case
I have a kWh meter that I would like to read with the Raspberry Pi. On the meter there is a small LED that blinks once per 3.6 sec at 1 kW. So I need a way to detect time between pulses. I mounted a simple LDR (2k - 20k) for around €2 over the blinking light and connected it to Gertboard Buf1 and ground. Set B1 as an input with a jumper on the board and connect GP25 to B1.

Now that you know how to add a primitive word to ATLAST, I just list the code for the word: prim P_gert_getnegedge // channel --- clocks clocks_per_sec { // Get a digital I/O port negative edge unsigned int i; clock_t start, end;

start = clock; Sl(1); if (S0 == 21) { // Find out which rev of Raspberry Pi we have rev = pi_revision; if (rev != 1) S0 = 27; // GP21 on Gertboard is controlled by GPIO27 } INP_GPIO(S0); i = 0; while(GPIO_IN0 & (1 << S0)) {   i++; if(i > 100000000) break; // Timeout after 10 seconds } long_wait(1); end = clock; S0 = (double) (end - start); So(1); Push = (stackitem) CLOCKS_PER_SEC; } Add #include  at line 20 in atlast.c Add fflush(stdout); to prim P_cr at line 1460 or so.

prim P_cr                          /* Carriage return */ {   V printf("\n"); fflush(stdout); } Start the interpreter with sudo ./atlast. Test the commands 1 gertboard


 * w 25 getnegedge 2drop 25 getnegedge 36 * swap 100 / / ." "w=" . cr ;

w

0 gertboard Result: Jolly good, or as they say in USA, awesome! Tests shows an accuracy down to a single watt.

More Fun
To play a little more with the demo I need another primary word: SLEEP that takes one item on the stack, sleep time in microseconds. This very simple word should have been the word to start with, it actually shows three fundamental things for a primary word in three lines of code. Sl(1) to make sure there is at least one item on the stack. usleep(S0) is using the top stack item S0. Pop; pops the S0 stack item off the stack when it has been used.

Add this primary word to atlast.c. Put it right after the function prim P_quit prim P_sleep // microsec --- {  Sl(1); usleep(S0); Pop; } Remember to wire up the Gertboard according to the information you get when you run the command sudo ./leds in the Gertboard demo directory. Now we can do: sudo ./atlast


 * use 1 ;
 * free 0 ;
 * leds 25 24 23 22 21 18 17 11 10 9 8 7 ;
 * on 12 0 do 1 setio 500000 sleep loop ;
 * off 12 0 do 0 setio 500000 sleep loop ;

Now define the word leddemo:
 * leddemo use gertboard leds on leds off leds on leds off free gertboard ;

( and try it ) leddemo

Reflective Sensor
The edge trigger word can be used for other sensors as well, I tried it with this Reflective Sensor and it works right out of the box. Connect VCC to a digital output and the "Out" to a digital input. Gnd to Gnd. I found it more convenient to look for positive edges so here is the word for that: prim P_gert_getposedge // channel wait_microsec --- clocks clocks_per_second { // Get a digital I/O port positive edge unsigned int i; // wait is duration until port is low again clock_t start, end;

start = clock; Sl(1); if (S1 == 21) S1 = 27; INP_GPIO(S1); i = 0; while(!(GPIO_IN0 & (1 << S1))) {   i++; if(i > 100000000) break; } usleep(S0); end = clock; S1 = (double) (end - start); S0 = CLOCKS_PER_SEC; }

Define a word COUNT to test the setup (output on the sensor is connected to Buf2 on Gertboard and VCC is connected to Buf3): 1 gertboard 23 1 setio
 * count 1 100 1 do 24 100000 getposedge 2drop 1 + .s cr loop ;

count

More Gertboard Words
Here are some more words for reading and writing the analog input and output (DtoA and AtoD). First GETATOD, it takes a channel on the stack and leaves a voltage. prim P_gert_getatod // chan --- voltage { // V will be in range 0-1023 (0-3.3 V)   Sl(1); INP_GPIO(8); SET_GPIO_ALT(8,0); INP_GPIO(9); SET_GPIO_ALT(9,0); INP_GPIO(10); SET_GPIO_ALT(10,0); INP_GPIO(11); SET_GPIO_ALT(11,0); setup_spi; S0 = read_adc(S0); }

And SETDTOA expects a channel and a voltage on the stack and sets the output accordingly. prim P_gert_setdtoa // chan volt -- { // V between 0 and 255 Sl(2); INP_GPIO(7); SET_GPIO_ALT(7,0); INP_GPIO(9); SET_GPIO_ALT(9,0); INP_GPIO(10); SET_GPIO_ALT(10,0); INP_GPIO(11); SET_GPIO_ALT(11,0); setup_spi; write_dac(S1, S0*16); // V_out = S0*16 / 256 * 2.048 Pop2; }

If you would like to read a burst of values from an analog input, here's how to do it. The word GETBURST expects a channel, a delay in microseconds between samples, and the number of samples you want. It leaves the samples on stack. You may want to increase the stack length constant at line 138 like this: atl_int atl_stklen = 1000;	     /* Evaluation stack length */ prim P_gert_burst // chan delay samples --- n1, n2, nn { unsigned int i, num, chan, delay; Sl(3); So(S0 - 3); INP_GPIO(8); SET_GPIO_ALT(8,0); INP_GPIO(9); SET_GPIO_ALT(9,0); INP_GPIO(10); SET_GPIO_ALT(10,0); INP_GPIO(11); SET_GPIO_ALT(11,0); setup_spi; num = S0; delay = S1; chan = S2; Pop; Pop; Pop; for(i = 0; i < num; i++){ Push = (stackitem) read_adc(chan); usleep(delay); } } And finally, add the new words to the list of primitives:

{"0GETATOD", P_gert_getatod}, {"0GETBURST", P_gert_burst}, {"0SETDTOA", P_gert_setdtoa},

If you want a simple way to inspect the values captured with the getburst word, one way is to let ATLAST Forth create an HTML page. Here is the code for that: FILE fd
 * printstring ( s1 -- )

fd fputs drop


 * printreal ( f1 -- )

"                   " dup 2swap "%f" 4 roll fstrform dup " " swap strcat printstring


 * printint ( n -- )

"                   " dup -rot "%ld" swap strform dup " " swap strcat printstring


 * htmlcanvas ( s1 -- )

10 fd fopen drop "  Burstdemo   " printstring " " printstring " var canvas = document.getElementById('burst'); var ctx = canvas.getContext('2d'); ctx.lineWidth=1; " printstring "ctx.strokeStyle ='#000000'; ctx.beginPath; " printstring 0 100000 100 getburst 100 0 do "ctx.lineTo(" printstring 10 i * printint "," printstring printint "); " printstring loop "ctx.stroke;  " printstring fd fclose The word htmlcanvas takes a filename on stack. It runs getburst and writes the result as a line diagram in a canvas element. "test.html" htmlcanvas .( "ok" cr

Tellstick
In order to have a safe way to handle mains switching, a Tellstick is an excellent choice. It can control many consumer brands of wireless controlled sockets and dimmers. Implementing some words in Forth for switching mains on and off leaves the safe voltages for sensing through the Gertboard interface.

Download and install the development kit from Telldus: (UPDATE: I could not make 2.1.2 to work. Use 2.1.1 and add a line in /home/pi/telldus-core-2.1.1/common/Socket.h before you run the make command, right after line 9, see below.) 7	 #include  8	 typedef HANDLE SOCKET_T; 9	#else Add this line here #include  10	 typedef int SOCKET_T; 11	#endif
 * 1) ifdef _WINDOWS

wget http://download.telldus.se/TellStick/Software/telldus-core/telldus-core-2.1.1.tar.gz tar -xzvf telldus-core-2.1.1.tar.gz sudo apt-get install libconfuse-dev sudo apt-get install libftdi-dev sudo apt-get install cmake cd telldus-core-2.1.1 cmake. make sudo make install

In case of trouble, here is another Tellstick wikipage R-Pi_Tellstick_core

When that installation is done you can copy two files over to the ATLAST Forth directory: cd /home/pi/atlast-1.2 cp ../telldus-core-2.1.1/client/telldus-core.h. cp ../telldus-core-2.1.1/client/libtelldus-core.so.

Then add the lib libtelldus-core.so to the Makefile, at the top, right after -lm: LIBRARIES = -lm libtelldus-core.so

In atlast.c, add define TELLDUS right before #define MATH;
 * 1) define TELLDUS                      /* Tellstick functions */

In atlast.c, include the telldus_core.h file:
 * 1) ifdef TELLDUS
 * 2) include "telldus_core.h"
 * 3) endif

In atlast.c, right after #endif /* COMPILERW */ add the following Tellstick primitives:
 * 1) ifdef TELLDUS

prim P_tell_init // --- { tdInit; }

prim P_tell_close // --- { tdClose; }

prim P_tell_on // device --- { Sl(1); tdTurnOn(S0); Pop; }

prim P_tell_off // device --- { Sl(1); tdTurnOff(S0); Pop; }


 * 1) endif /* TELLDUS */

And finally, add the new words to the list of primitives: {"0TELLON", P_tell_on}, {"0TELLOFF", P_tell_off}, {"0TELLINIT", P_tell_init}, {"0TELLCLOSE", P_tell_close},
 * 1) ifdef TELLDUS
 * 1) endif /* TELLDUS */

Save atlast.c and re-run make to compile and you can try your new words. Remember to configure /etc/tellstick.conf according to the brands of hardware you are using, read the Tellstick documentation. First, start telldusd and then ATLAST. telldusd ./atlast In the ATLAST console, type your new Forth words: tellinit 1 tellon 1 telloff tellclose

Tellstick duo
If you are fortunate enough to have a Tellstick Duo, you probably want to listen for incoming 433 MHz signals so here we go. But first follow the Tellstick instructions above, and test that they work as expected.

Add this primitive word to atlast.c. We will use it to register a callback. (A callback is an ordinary function, nothing strange, but it will be called not by you but by the Tellstick Duo when there is data coming in). prim P_tell_rawevent // string --- {  Sl(1); tdRegisterRawDeviceEvent( rawcallback, S0); Pop; } Then add the callback function. This is the function that will be called. Add it around line 295, just above the line /* TOKEN  --  Scan a token and return its type. */ static void rawcallback(const char *data, int controllerId, int callbackId, void *context) {   dictword *dw; V strcpy((char *)context, data); dw = atl_lookup("rawevent"); atl_exec(dw); } Finally, add the new primitive word to the list of primitives {"0TELLRAWCALLBACK", P_tell_rawevent},
 * 1) ifdef TELLDUS
 * 1) endif

Now, to try it out, save and re-compile with make and then start telldusd and ./atlast. Type the following in the ATLAST console: 127 string raw
 * rawevent raw type cr ;

raw tellrawcallback The word rawevent is executed by the callback function. You can re-define it, and it will use the latest definition. With this definition it will just type the incoming data in the console. If you take a Nexa remote control and press a few buttons, the incoming data should print as a string, for example,

"class:command;protocol:waveman;model:codeswitch;house:A;unit:1;method:turnoff;"

You can even put the three lines of Forth code in a file, for example, telldus.atl and start ATLAST like this ./atlast -i./telldus.atl

Websockets
With all these sensor signals coming in from Gertboard and Tellstick Duo it would be nice to be able to connect to a web server and upload data in real time. Websockets is a new way to create a full duplex communication pipe between a websocket client and a web server. Download and install noPoll http://www.aspl.es/nopoll sudo apt-get install cmake sudo apt-get install wget sudo apt-get install libssl-dev wget www.aspl.es/nopoll/downloads/nopoll-0.4.6.b400.tar.gz tar -xzvf nopoll-0.4.6.b400.tar.gz cd nopoll-0.4.6.b400/ ./configure make sudo make install

Add the lib nopoll to the Atlast Makefile so that the lines LIBRARIES and INCLUDE looks like this: LIBRARIES = -lrt -lm -L/usr/local/lib -lnopoll

INCLUDE = -I/usr/local/include/nopoll -Wl,-rpath -Wl,/usr/local/lib

In atlast.c, add #define WEBSOCKETS right before #define MATH;
 * 1) define WEBSOCKETS		     /* Websockets functions */

In atlast.c, include the nopoll.h file:
 * 1) ifdef WEBSOCKETS
 * 2) include 
 * 3) endif

In atlast.c, right before /* TOKEN  --  Scan a token and return its type. */ add the following nopoll globals: noPollCtx *ctx; noPollConn *conn;
 * 1) ifdef WEBSOCKETS
 * 1) endif

In atlast.c, right before /* Table of primitive words  */ add the following nopoll primitives: prim P_ws_connect // "localhost" "1234" "/wsh" -- bool {	Sl(3); Hpc(S0); Hpc(S1); Hpc(S2); ctx = nopoll_ctx_new; conn = nopoll_conn_new (ctx, (char *) S2, (char *) S1, NULL, (char *) S0, NULL, NULL); nopoll_conn_wait_until_connection_ready (conn, 5); Pop; Pop; S0 = (nopoll_conn_is_ok (conn)) ? Truth : Falsity; }
 * 1) ifdef WEBSOCKETS

prim P_ws_close // -- {	nopoll_conn_close (conn); nopoll_ctx_unref(ctx); }

prim P_ws_send // string -- length {	Sl(1); int bytes_written, length; Hpc(S0); length = strlen((char *) S0); bytes_written = nopoll_conn_send_text(conn, (char *) S0, length); if(bytes_written != length) bytes_written = nopoll_conn_flush_writes(conn, 2000000, bytes_written); S0 = bytes_written; }

prim P_ws_receive // buffer length timeout_ms -- result {	Sl(3); Hpc(S2); int result; result = nopoll_conn_read(conn,(char *) S2,S1,nopoll_true, S0); Pop; Pop; S0 = result; }
 * 1) endif /* WEBSOCKETS */

And finally, add the new words to the list of primitives: {"0WSCONNECT", P_ws_connect}, {"0WSSEND", P_ws_send}, {"0WSREC", P_ws_receive}, {"0WSCLOSE", P_ws_close},
 * 1) ifdef WEBSOCKETS
 * 1) endif /* WEBSOCKETS */

Save atlast.c and re-run make to compile and you can try your new words.

make clean make

To connect to the echo server: ./atlast 256 string raw "echo.websocket.org" "80" "/" wsconnect. "test" wssend. raw 127 1000 wsrec. raw type cr "send some more" wssend. raw 127 1000 wsrec. raw type cr wsclose The dot after wsconnect will print out a -1 if connected, 0 otherwise. The dot after wssend will print the number of characters sent. The dot after wsrec will print the number of characters received.

A websockets example
We have a nice temperature sensor connected to our gertboard atod channel 0 and wants to send the temp value up to a server every second. A common wire protocol for websockets communication is json. Here's some words for encoding a json object. ( jsonencoder )

127 string json 32 string tmp 32 string voltage 32 string id 1 constant use "voltage" voltage strcat "id" id strcat
 * printstring "\"" tmp strcat tmp strcat "\"" tmp strcat tmp ;
 * printreal "%.4f" tmp fstrform tmp ;
 * printint "%ld" tmp strform tmp ;
 * realorint 2dup = if printreal else printint then ;
 * realorstring dup 1000000000 > if printreal else printstring then ;
 * print dup 1000000 < if realorint else realorstring then ;
 * jsonencode 0 json c! 0 do 0 tmp c! i 0 = if "{" json strcat else "," json strcat then print swap

"\"" json strcat json strcat "\"" json strcat ":" json strcat json strcat loop "}" json strcat ; The word jsonencode takes name-value pairs on the stack and the pair count and puts a json string in the buffer json. I have defined two names, id and voltage. You may want to increase the number of temporary string buffers in atlast.c at line 137. A temporary string buffer is a buffer not defined with size and the word string. id "outdoorsensor" voltage 0.345 2 jsonencode json type So, the code for temperature sensor upload could be something like this:
 * connect "192.168.0.114" "8080" "/washer" wsconnect . cr ;
 * sendsample id "outdoor" voltage 0 getatod 2 jsonencode json wssend . cr ;
 * run use gertboard connect begin sendsample 1000000 sleep again ;

run