diff --git a/README.md b/README.md index 005f932..21d0688 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -[![Build Status](https://travis-ci.org/zeroflag/punyforth.svg?branch=master)](https://travis-ci.org/zeroflag/punyforth) +[![Build Status](https://travis-ci.org/zeroflag/punyforth.svg?branch=master)](https://travis-ci.org/zeroflag/punyforth) # Punyforth @@ -11,23 +11,22 @@ Punyforth also runs on x86 (Linux), ARM (Raspberry PI) but these are *not* the p ## Design goals * Simple -* Highly interactive +* Highly interactive * Extensible -* Small memory footprint +* Small memory footprint and resource efficiency ## Quick start -The easiest way to try out Punyforth is to use a ESP8266 based NodeMCU development board that has USB to serial interface on board (Geekcreit/Doit, Amica, WeMos, LoLin). Connect the development board to your computer via USB. Let's assume the serial port is COM3. +The easiest way to try out Punyforth is to use a ESP8266 based development board that has USB to serial interface on board (Geekcreit/Doit, Amica, WeMos, LoLin). Connect the development board to your computer via USB. Let's assume the serial port is COM4. ```bash $ cd arch/esp8266/bin -$ python modules.py core -$ flash com3 +$ python flash.py COM4 ``` -At first we select the modules to be installed using the *modules.py* python script. Then we install both Punyforth and the selected modules (this time only the core library) to the ESP8266 using the *flash* script. +The flash.py utility will store the Punyforth binary and modules source code on the flash memory of the esp8266. -Open a serial terminal[1](#serial) on port COM3 then type: +Open a serial terminal[1](#serial) on port COM4 then type: ```forth println: "Hello world!" @@ -37,6 +36,8 @@ println: "Hello world!" 1: Baud rate: 115200 bps. Local echo: on, line mode: enabled. You can find some free terminal emulators [here](https://learn.sparkfun.com/tutorials/terminal-basics/all). +Note that flash.py flashes with Quad I/O speed (qio) by default. This is the fastest mode but not all devices support this. If you have trouble while flashing try adding a --flashmode dio parameter. + ##### Now let's do some simple arithmetics. ```forth @@ -58,13 +59,15 @@ This should give you the following output. ``` Congratulation, you've just doubled a number and printed out the result in the [REPL](https://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_loop). +For a detailed getting started guide see [Developing and deploying Punyforth applications](https://github.com/zeroflag/punyforth/wiki/Developing-and-deploying-Punyforth-applications). + ## About the language Punyforth is a simple, imperative, stack-based, [concatenative programming language](https://en.wikipedia.org/wiki/Concatenative_programming_language) and interactive environment with good metaprogramming support and extensibility. The Forth environment combines the compiler with an interactive shell (REPL), where the user can define functions called words. -Punyforth does not have local variables, instead values are kept on a stack. This stack is used only for storing data. There is a separate return stack that stores information about nested subroutin calls. Both stacks are first-class in the language. +Punyforth does not have local variables, instead values are kept on a stack. This stack is used only for storing data. There is a separate return stack that stores information about nested subroutine calls. Both stacks are first-class in the language. As a consequence of the stack, Punyforth uses a form of syntax known as [Reverse Polish or Postfix Notation](https://en.wikipedia.org/wiki/Reverse_Polish_notation). @@ -94,24 +97,27 @@ Stack visualization: 2 9 -*dup* and *swap* are [stack shuffle](http://wiki.laptop.org/go/Forth_stack_operators) words. Excessive use of words like them make the code hard to follow, so it is advisable to use them sparingly. There are many ways to reduce the number of stack shuffles, one of them is to use [quotations and combinators](http://elasticdog.com/2008/12/beginning-factor-shufflers-and-combinators/). +*dup* and *swap* are [stack shuffle](http://wiki.laptop.org/go/Forth_stack_operators) words. Excessive use of words like them makes the code hard to follow, so it is advisable to use them sparingly. There are many ways to reduce the number of stack shuffles, one of them is to use [quotations and combinators](http://elasticdog.com/2008/12/beginning-factor-shufflers-and-combinators/). For example the above code could have been expressed the following way: ```forth -2 3 { dup * } bi@ + +2 3 { square } bi@ + ``` +Where square is defined as _dup *_. + See the chapter about quotations and combinators for more information. ### Differences between Punyforth and other Forth systems -Punyforth is heavily inspired by the [Forth](https://en.wikipedia.org/wiki/Forth_(programming_language)) programming language. It uses the same compilation model (outer interpreter, compiler, modes, dictionary, immediate words, etc) as other Forth systems. Punyforth is [bootstrapped](http://www.lispcast.com/two-kinds-of-bootstrapping) from a small set of [primitives](arch/x86/primitives.S) written in assembly language. The compiler targets these primitives and compiles [indirect-threaded code](https://en.wikipedia.org/wiki/Threaded_code). Higher level abstractions are built on top of the primitives therefore most of the system is written in itself (in Forth). +Punyforth is heavily inspired by the [Forth](https://en.wikipedia.org/wiki/Forth_(programming_language)) programming language. It uses the same compilation model (outer interpreter, compiler, modes, dictionary, immediate words, etc.) as other Forth systems. Punyforth is [bootstrapped](http://www.lispcast.com/two-kinds-of-bootstrapping) from a small set of [primitives](arch/x86/primitives.S) written in assembly language. The compiler targets these primitives and compiles [indirect-threaded code](https://en.wikipedia.org/wiki/Threaded_code). Higher level abstractions are built on top of the primitives therefore most of the system is written in itself (in Forth). #### Some of the differences * Punyforth is case sensitive * Strings are null-terminated -* Strings are created and printed differently (*str: "foobar"*, *print: "foobar"* instead of *s" foobar"*, *." foobar"*) +* String literals ("Hello World") and character literals ($A) are supported +* Strings can be printed out differently (*print: "foobar"* instead of *." foobar"*) * Parsing words are ended with a colon character by convention (including *variable:*, *constant:*, *create: does>*) * Defining a word in terms of itself results recursion by default (use the *override* word to alter this behaviour) * Curly brackets denote quotations instead of locals @@ -121,9 +127,9 @@ Punyforth supports exception handling, multitasking, socket and GPIO APIs and co ### Programming -During programming, the user uses the REPL to write and test small piece of codes or to extend the languge with new words (which are called subroutines or functions in other languages). +During programming, the user uses the REPL to write and test small piece of codes or to extend the languge with new words (which are called subroutines or functions in other languages). -The REPL (also known as the Forth Outer/Text Interpreter) operates in 2 modes. In interpretation mode, it immediately executes the words that the user typed in. In compilation mode (when you start a new word definition), its action depends on the compilation semantic of the current word. In most cases it compiles the execution token (pointer to the word) into the word to be defined. However, if the current word is flagged as immediate, the compiler executes the word at compile time so the word can define its own compilation semantic. This is a bit similar than Lisp macros. Control structures are implemented as immediate words in Forth. +The REPL (also known as the Forth Outer/Text Interpreter) operates in 2 modes. In interpretation mode, it immediately executes the words that the user typed in. In compilation mode (when you start a new word definition), its action depends on the compilation semantic of the current word. In most cases it compiles the execution token (pointer to the word) into the word to be defined. However, if the current word is flagged as immediate, the compiler executes the word at compile time so the word can define its own compilation semantic. This is a bit similar to Lisp macros. Control structures are implemented as immediate words in Forth. ### The syntax @@ -136,7 +142,7 @@ Forth has almost no syntax. It grabs tokens separated by whitespace, looks them ### Extending the dictionary -Words are stored in a *dictionary*. The dictionary maps words to executable code or data structures. +Words are stored in a *dictionary*. The dictionary maps words to executable code or data structures. You can use *defining words* to extend the dictionary with new definitions. The most basic defining words is the *:* (colon). This adds a new word to the dictionary with the behavior defined in terms of existing words. A colon definition begins with a colon and ends with a semicolon. @@ -174,19 +180,19 @@ General form of *if else then*. For example: ```forth -: max ( a b -- max ) +: max ( a b -- max ) 2dup < if nip else drop then ; - + 10 100 max . \ prints 100 ``` The else part can be omitted. ```forth -: abs ( n -- absn ) +: abs ( n -- absn ) dup 0< if -1 * then ; - --10 abs . \ prints 10 + +-10 abs . \ prints 10 ``` #### Case statement @@ -240,6 +246,8 @@ If the increment is negative then *limit* is inclusive. 0 8 do i . -2 +loop \ prints 86420 ``` +It is important to know that *Do* loops store the loop index on the return stack. You can break the semantics of *i* and *j* if you use the return stack to store temporary data. Also you can't simply *exit* a word from inside a do loop without clearing the return stack first. See *unloop* for more information. + #### Condition-controlled loops ##### until loop @@ -253,12 +261,12 @@ For example: ```forth : countdown ( n -- ) - begin + begin dup . 1- dup 0 < until drop ; - + 5 countdown \ prints 543210 ``` @@ -282,27 +290,42 @@ For example: dup . 1- repeat drop ; - + 5 countdown \ prints 543210 ``` -You can use the *exit* word to exit from the current word as well from the loop. +You can use the *exit* word to exit from the current word as well from the loop. But this won't work with do loops. The reason for this is because do loops store the loop index on the return stack. You can use the *unloop* word to clear the return stack before exiting a do loop. ```forth : some-word ( -- ) - 10 0 do + 10 0 do i 5 = if unloop exit then loop ; ``` + An *unloop* is required for each nesting level before the definition may be *exited*. + +```forth +: nested-exit ( -- ) + 5 0 do + 5 i 1+ do + j i + 7 = if + i . space j . cr + unloop unloop \ clear the return stack before exiting + exit + then + loop + loop ; +``` + Control structres are compile time words with no interpretation semantics. They can be used only in compilation mode, that is inside a word definition. ### Exception handling -If a word faces an error condition it can *throw* an exception. Your can provide exception handlers to *catch* exceptions. +If a word faces an error condition it can *throw* an exception. Your can provide exception handlers to *catch* exceptions. For example: @@ -310,23 +333,23 @@ For example: exception: EZERODIV : div ( q d -- r | throws:EZERODIV ) \ this word throws an exception in case of division by zero - dup 0= if - EZERODIV throw - else - / - then ; + dup 0= if + EZERODIV throw + else + / + then ; ``` ```forth : test-div ( q d -- r ) ['] div catch case - EZERODIV of + EZERODIV of println: '/ by zero' \ print exception in case of zero division 2drop \ drop q d - endof + endof throw \ rethrow if it wasn't EZERODIV, or there was no exception (code=0) - endcase ; + endcase ; ``` The word *catch* expects an execution token of a word that potentially throws an exception. @@ -341,26 +364,26 @@ You can modify this behaviour by overriding the *unhandled* deferred word. ```forth : my-uncaught-exception-handler ( code -- ) - cr print: "Uncaught exception: " ex-type - abort ; - + cr print: "Uncaught exception: " ex-type + abort ; + ' unhandled is: my-uncaught-exception-handler -``` +``` The implementation of exceptions is based on the idea of [William Bradley](http://www.complang.tuwien.ac.at/anton/euroforth/ef98/milendorf98.pdf). -### Immediate words +### Immediate words Immediate words are executed at compile time. Loops and control structures are implemented with immediate words that compile the required semantics. ```forth : begin - here \ saves the absolute address of the beginning of the loop to the stack - ; immediate - + here \ saves the absolute address of the beginning of the loop to the stack +; immediate + : until - ['] branch0 , \ compiles a conditional branch - here - cell - , \ calculate then compile the relative address + ['] branch0 , \ compiles a conditional branch + here - cell - , \ calculate then compile the relative address ; immediate ``` @@ -374,22 +397,22 @@ Parsing words can parse the input stream. One example of a parsing word is the c ``` ```forth -: ( \ comments start with ( character - begin \ consume the stream until ) character is found - key ')' = - until - ; immediate -``` +: ( \ comments start with ( character + begin \ consume the stream until ) character is found + key ')' = + until +; immediate +``` ```forth -: \ \ single line comments start with \ character - begin - key dup - 'cr' = swap - 'lf' = or - until \ consume the stream until cr or lf character is found - ; immediate -``` +: \ \ single line comments start with \ character + begin + key dup + 'cr' = swap + 'lf' = or + until \ consume the stream until cr or lf character is found +; immediate +``` The word *hex:* is an other example of a parsing word. @@ -397,7 +420,7 @@ The word *hex:* is an other example of a parsing word. hex: FF \ pushes 255 onto the stack ``` -This word interprets the input as a hexadecimal number then pushes it to the stack. Parsing words are similar than reader macros in Lips. +This word interprets the input as a hexadecimal number then pushes it to the stack. Parsing words are similar to reader macros in Lisp. ### Deferred words @@ -406,15 +429,15 @@ This word interprets the input as a hexadecimal number then pushes it to the sta For example ```forth -: myword1 ( -- ) +: myword1 ( -- ) print: 'foo' ; -: myword2 ( -- ) - myword1 +: myword2 ( -- ) + myword1 print: 'bar' ; - + : myword1 ( -- ) \ redefining myword1 to print out baz instead of foo - print: 'baz' ; + print: 'baz' ; myword2 \ myword2 will print out foobar, not bazbar ``` @@ -425,8 +448,8 @@ Redefinition has no effect on myword2. Let's try it again. This time using the * defer: myword1 : myword2 ( -- ) - myword1 \ I can define myword2 in terms of the (yet undefined) myword1 - print: 'bar' ; + myword1 \ I can define myword2 in terms of the (yet undefined) myword1 + print: 'bar' ; : printfoo ( -- ) print: 'foo' ; : printbaz ( -- ) print: 'baz' ; @@ -440,32 +463,32 @@ myword2 \ this prints out bazbar ### Override -You might want to redefine a word in terms of it's older definition. +You might want to redefine a word in terms of it's older definition. For example: ```forth -: myword ( -- ) +: myword ( -- ) print: 'foo' ; : myword ( -- ) - myword + myword print: 'bar' ; - + myword \ infinite recursion ``` Unfortunately this won't work because the *myword* inside the second defintion will refer to the new word, resulting infinite recursion. You can avoid this by marking the word with *override*. ```forth -: myword ( -- ) +: myword ( -- ) print: 'foo' ; : myword ( -- ) override - myword + myword print: 'bar' ; - -myword \ prints out foobar + +myword \ prints out foobar ``` Because the usage of *override*, the *myword* in the second defintion will refer to the old *myword*. Therefore the execution of *myword* will print out foobar. @@ -479,78 +502,76 @@ A quotation is an anonymous word inside an other word, similar than a lambda exp ( .. ) { ( ..quotation body.. ) } ( .. ) ; -``` +``` At runtime the quotation pushes its execution token onto the stack, therefore it can be used with execute, catch or combinators. ```forth -: demo ( -- n ) +: demo ( -- n ) 3 { 1+ 5 * } execute ; - + % demo (stack 20) -``` +``` #### Quotations and exception handling ```forth - { str: 'AF01z' hex>int } catch - if - println: 'invalid hex number' - abort - then + { "AF01z" hex>int } catch + if + println: 'invalid hex number' + abort + then ``` #### Quotations and Factor style combinators Punyforth supports a few [Factor](https://factorcode.org/) style combinators. -##### dip ( x quot -- x ) +##### dip ( x quot -- x ) Calls a quotation while temporarily hiding the top item on the stack. -```forth - 1 2 4 { + } dip \ Same as: 1 2 4 >r + r> - (stack 3 4) -``` - -##### keep ( x quot -- x ) +```forth + 1 2 4 { + } dip \ Same as: 1 2 4 >r + r> + (stack 3 4) +``` + +##### keep ( x quot -- x ) Calls a quotation with an item on the stack, restoring that item after the quotation returns. -```forth +```forth 1 2 4 { + } keep \ Same as: 1 2 4 dup >r + r> (stack 1 6 4) -``` - -##### bi ( x p q -- ) +``` + +##### bi ( x p q -- ) Applies quotation p to x, then applies quotation q to x. -```forth +```forth \ given a rectangle(width=3, height=4) - rectangle { .width @ } { .height @ } bi * \ Same as: rectangle dup .width @ swap .height @ * - (stack 12) -``` - -##### bi* ( x y p q -- ) + rectangle { .width @ } { .height @ } bi * \ Same as: rectangle dup .width @ swap .height @ * + (stack 12) +``` + +##### bi* ( x y p q -- ) Applies quotation p to x, then applies quotation q to y. -```forth - str: "john" str: ".doe" { 1+ c@ } { 2 + c@ } bi* = \ Same as: str: "john" str: ".doe" swap 1+ c@ swap 2 + c@ = +```forth + "john" ".doe" { 1+ c@ } { 2 + c@ } bi* = \ Same as: "john" ".doe" swap 1+ c@ swap 2 + c@ = (stack -1) - -``` - +``` + ##### bi@ ( x y quot -- ) Applies the quotation to x, then to y. ```forth - str: "john" str: ".doe" { strlen } bi@ = \ Same as: str: "john" str: ".doe" swap strlen swap strlen = + "john" ".doe" { strlen } bi@ = \ Same as: "john" ".doe" swap strlen swap strlen = (stack -1) - ``` ### The word *create: does>* @@ -564,10 +585,10 @@ The word *create:* and *does>* lets you combine a data structure with an action. One of the simplest application of *create: does>* is the definition of a constant. ``` forth -: constant: - create: , +: constant: + create: , does> @ ; - + 80 constant: COLUMNS COLUMNS . \ prints out 80 @@ -585,9 +606,9 @@ COLUMNS . \ prints out 80 ```forth : array: ( size "name" -- ) ( index -- addr ) - create: cells allot - does> swap cells + ; - + create: cells allot + does> swap cells + ; + 10 array: numbers \ create an array with 10 elements 12 3 numbers ! \ store 12 in the 3rd element @@ -600,26 +621,25 @@ COLUMNS . \ prints out 80 ```forth : struct 0 ; -: field: - create: over , + +: field: + create: over , + does> @ + ; -struct - cell field: .width +struct + cell field: .width cell field: .height constant Rect -: new-rect: ( "name" -- ) +: new-rect: ( "name" -- ) Rect create: allot ; - -: area ( rect -- area ) - dup .width @ swap .height @ * ; - + +: area ( rect -- area ) + dup .width @ swap .height @ * ; + new-rect: r1 3 r1 .width ! -5 r1 .height ! -r1 area . - +5 r1 .height ! +r1 area . ``` ### Unit testing @@ -666,18 +686,20 @@ The ESP8266 has a built in Wi-Fi chip that can be used both in access point and In station mode, the ESP8266 connects to an existing Wi-Fi access point. ```forth -str: "password" str: "existing-ssid" wifi-connect -``` +"password" "existing-ssid" wifi-connect +``` + +The station mode Wi-Fi settings are persistently stored by the ESP8266, there is no need to setup the Wi-Fi at every startup. In AP mode, the ESP8266 acts as an central connection point, which wireless clients (smartphones, laptops) can connect to. In this mode you have to choose an IP address for the ESP and an IP range for the clients. Client IP addresses are assigned by the [DHCP](https://en.wikipedia.org/wiki/Dynamic_Host_Configuration_Protocol) server. ```forth 172 16 0 1 >ipv4 wifi-set-ip \ AP ip is 172.16.0.1 -1 3 0 AUTH_WPA2_PSK str: "1234567890" str: "my-ssid" wifi-softap -4 172 16 0 2 >ipv4 dhcpd-start \ dhcp lease time = 4, first client ip is 172.16.0.2 -``` +4 3 0 AUTH_WPA2_PSK "1234567890" "my-ssid" wifi-softap \ max connections = 4 +8 172 16 0 2 >ipv4 dhcpd-start \ dhcp max_leases = 8, first client ip is 172.16.0.2 +``` -The Wi-Fi settings are persistently stored by the ESP8266, there is no need to setup the Wi-Fi at every startup. +The dhcp max_leases parameter should not be smaller than the maximum allowed connections. ### GPIO @@ -695,7 +717,7 @@ See [Philips Hue lightswitch example](arch/esp8266/forth/examples/example-philip ### Netconn -Netconn is a sequential API on top of the [lightweight TCP/IP stack](https://en.wikipedia.org/wiki/LwIP) of [FreeRTOS] (https://en.wikipedia.org/wiki/FreeRTOS). Punyforth provides a wrapper around the Netconn API. +Netconn is a sequential API on top of the [lightweight TCP/IP stack](https://en.wikipedia.org/wiki/LwIP) of [FreeRTOS](https://en.wikipedia.org/wiki/FreeRTOS). Punyforth provides a wrapper around the Netconn API. #### Simple HTTP request @@ -704,14 +726,14 @@ Netconn is a sequential API on top of the [lightweight TCP/IP stack](https://en. : fetch ( netcon -- ) begin - dup 512 line netcon-readln -1 <> + dup 512 line netcon-readln -1 <> while line type cr - repeat + repeat drop ; -80 str: "google.com" TCP netcon-connect constant: socket -socket str: "GET / HTTP/1.1\r\n\r\n" netcon-write +80 "google.com" TCP netcon-connect constant: socket +socket "GET / HTTP/1.1\r\n\r\n" netcon-write socket fetch socket netcon-dispose ``` @@ -719,8 +741,8 @@ socket netcon-dispose #### UDP client ```forth -str: "Lorem ipsum" constant: data -str: "192.168.0.3" constant: SERVER_IP +"Lorem ipsum" constant: data +"192.168.0.3" constant: SERVER_IP 8005 constant: SERVER_PORT SERVER_PORT SERVER_IP UDP netcon-connect dup data 11 netcon-send-buf @@ -745,7 +767,7 @@ while True: #### UDP server ```forth -str: "192.168.0.15" constant: HOST +"192.168.0.15" constant: HOST 8000 constant: PORT 128 buffer: data @@ -766,14 +788,14 @@ s.sendto(b'hello\r\n', ('192.168.0.15',8000)) See [Simple HTTP Server](arch/esp8266/forth/examples/example-http-server.forth) for more information. -### Tasks (experimental) +### Tasks Punyforth supports cooperative multitasking which enables users to run more than one task simultaneously. For example one task may wait for input on a socket, while another one receives commands through the serial port. Punyforth never initiates a context switch by its own. Instead, tasks voluntarily yield control periodically using the word *pause*. Tasks are executed in a round robin fashion. In order to run some code in the background, one must create a new task first, using the *task:* parsing word. A tasks can be activated inside a word. This word usually does something in a loop and calls *pause* periodically to yield controll to other tasks. ```forth -task: mytask +0 task: mytask : my-word mytask activate @@ -784,7 +806,7 @@ task: mytask To start the task, first you have to switch to multi tasking mode first by executing the word *multi*. Then simply call the word that was associated to the task. ```forth -multi +multi my-word ``` @@ -797,21 +819,21 @@ Often tasks need to communicate with each other. A mailbox is a fixed size block 5 mailbox: mailbox1 \ create a task for the consumer -task: task-consumer +0 task: task-consumer \ this word is executed by the task : consumer ( task -- ) - activate \ activate task - begin - mailbox1 mailbox-receive . \ receive and print one item from the mailbox - println: "received by consumer" - pause \ allow other tasks to run - again - deactivate ; \ deactivate task - -multi \ switch to multitask mode -task-consumer consumer \ run the consumer -123 mailbox1 mailbox-send \ send some numbers to the consumer + activate \ activate task + begin + mailbox1 mailbox-receive . \ receive and print one item from the mailbox + println: "received by consumer" + pause \ allow other tasks to run + again + deactivate ; \ deactivate task + +multi \ switch to multitask mode +task-consumer consumer \ run the consumer +123 mailbox1 mailbox-send \ send some numbers to the consumer 456 mailbox1 mailbox-send ``` @@ -823,9 +845,9 @@ task: task-counter \ this word is executed by the task : counter ( task -- ) - activate \ actiavte task - 100 0 do - i . cr + activate \ activate task + 100 0 do + i . cr 500 ms loop deactivate ; \ deactivate task @@ -838,26 +860,30 @@ task-counter counter \ run the consumer ```forth \ Returns the available free dictionary space. -freemem ( -- bytes ) +freemem ( -- bytes ) \ Returns the available free memory. -osfreemem ( -- bytes ) +osfreemem ( -- bytes ) \ Blocks all running tasks for the specified number of millisecond. ms ( msec -- ) \ Blocks for the specified number of microsecond. This is implemented as busy loop. Use it if you need high precision delay. -us ( usec -- ) +us ( usec -- ) \ Sets the baud rate of the specied uart. -uart-set-bps ( bps uart-number -- ) +uart-set-bps ( bps uart-number -- ) + +\ print out available words +help ( -- ) ``` You can see some example code under the [examples](arch/esp8266/forth/examples) directory. +Build instructions and further information is available at [punyforth wiki](https://github.com/zeroflag/punyforth/wiki). + ## Contact Attila Magyar [![Twitter Follow](https://img.shields.io/twitter/url/http/shields.io.svg?style=social&label=%40zeroflag&maxAge=2592000?style=flat-square)](https://twitter.com/zeroflag) [![Gitter chat](https://badges.gitter.im/gitterHQ/gitter.png)](https://gitter.im/punyforth/Lobby) - diff --git a/arch/arm/.gitignore b/arch/arm/.gitignore new file mode 100644 index 0000000..4047079 --- /dev/null +++ b/arch/arm/.gitignore @@ -0,0 +1 @@ +punyforth diff --git a/arch/arm/build b/arch/arm/build index b5976ab..b9aca19 100755 --- a/arch/arm/build +++ b/arch/arm/build @@ -9,6 +9,7 @@ cat ../../generic/forth/core.forth \ ../../generic/forth/ringbuf.forth \ ../../generic/forth/ringbuf_test.forth \ ../../generic/forth/test.forth \ + ../../generic/forth/decompiler.forth \ greet \ /dev/stdin \ | ./punyforth diff --git a/arch/arm/ext.S b/arch/arm/ext.S index ffb0301..5edc3e7 100644 --- a/arch/arm/ext.S +++ b/arch/arm/ext.S @@ -87,3 +87,8 @@ defprimitive "over",4,over,REGULAR defprimitive "time",4,time,REGULAR /* ( -- unixtime ) */ push {r0} NEXT + +defprimitive "r@",2,rfetch,REGULAR + ldr r0, [r6] + push {r0} + NEXT diff --git a/arch/arm/init.S b/arch/arm/init.S index bac7533..9d249e7 100644 --- a/arch/arm/init.S +++ b/arch/arm/init.S @@ -3,10 +3,6 @@ ldr r1, =input_index str r0, [r1] - ldr r0, =dictionary - ldr r1, =var_dp - str r0, [r1] - ldr r1, =stack_top str sp, [r1] diff --git a/arch/arm/primitives.S b/arch/arm/primitives.S index 8f81114..c3056fc 100644 --- a/arch/arm/primitives.S +++ b/arch/arm/primitives.S @@ -110,15 +110,14 @@ defprimitive "rshift",6,rshift,REGULAR NEXT defprimitive "_emit",5,uemit,REGULAR - pop {r0} - push {r6, r7} - ldr r1, =var0 - str r0, [r1] + mov r3, r7 // save forth ip + mov r1, sp // char to print mov r0, #1 // fd <- stdout mov r2, #1 // length mov r7, #4 // syscall <- sys_write swi 0 // system call - pop {r6, r7} + mov r7, r3 + pop {r0} // discard char NEXT defprimitive "abort",5,abort,REGULAR @@ -162,16 +161,14 @@ defprimitive "<",1,lt,REGULAR // only need to define this, all other com defprimitive "branch",6,branch,REGULAR ldr r0, [r7] - add r7, #CELLS add r7, r0 NEXT defprimitive "branch0",7,branch0,REGULAR - ldr r0, [r7] // load relative address to be jump - add r7, #CELLS pop {r1} // check condition - cmp r1, #0 - addeq r7, r0 // advance pc if condition was satisfied + cmp r1, #0 + beq code_branch + add r7, #CELLS // skip address NEXT defprimitive ">r",2,rpush,REGULAR @@ -201,6 +198,12 @@ defprimitive "execute",7,execute,REGULAR ldr r1, [r0] mov pc, r1 +// this exit primitive is only used by the compiler, this is used for detecting word endings works some as regular exit +defprimitive "",6,end_word,REGULAR + ldr r7, [r6] + add r6, #CELLS + NEXT + defprimitive "exit",4,exit,REGULAR ldr r7, [r6] add r6, #CELLS @@ -225,8 +228,9 @@ defprimitive "rp!",3,rpstore,REGULAR NEXT defprimitive "readchar",8,readchar,REGULAR - push {r7} - ldr r1, =var0 // buffer for one character + mov r3, r7 // save forth ip + push {r0} // make place for buffer + mov r1, sp // buffer for one character mov r0, #0 // read system call str r0, [r1] mov r2, #1 // length @@ -234,9 +238,8 @@ defprimitive "readchar",8,readchar,REGULAR swi 0 cmp r0, #0 ble code_abort - pop {r7} + mov r7, r3 ldr r0, [r1] - push {r0} NEXT // Different types of code words @@ -256,3 +259,14 @@ ENTERDOES: push {r0} // invoke behaviour with data pointer on the stack NEXT +ENTERCONST: + add r0, #CELLS + ldr r0, [r0] + push {r0} + NEXT + +ENTERVAR: + add r0, #CELLS + push {r0} + NEXT + diff --git a/arch/esp8266/bin/esptool.py b/arch/esp8266/bin/esptool.py index 8c1a496..df7978e 100644 --- a/arch/esp8266/bin/esptool.py +++ b/arch/esp8266/bin/esptool.py @@ -27,6 +27,10 @@ import tempfile import inspect +try: + xrange(1) +except NameError: + xrange = range class ESPROM: # These are the currently known commands supported by the ROM diff --git a/arch/esp8266/bin/flash.bat b/arch/esp8266/bin/flash.bat deleted file mode 100644 index 654fbf9..0000000 --- a/arch/esp8266/bin/flash.bat +++ /dev/null @@ -1 +0,0 @@ -esptool.py -p %1 write_flash -fs 32m -fm qio -ff 40m 0x00000 rboot.bin 0x1000 blank_config.bin 0x2000 punyforth.bin 0x51000 uber.forth \ No newline at end of file diff --git a/arch/esp8266/bin/flash.py b/arch/esp8266/bin/flash.py new file mode 100755 index 0000000..a8d02b8 --- /dev/null +++ b/arch/esp8266/bin/flash.py @@ -0,0 +1,274 @@ +import sys, os +from argparse import ArgumentParser, RawDescriptionHelpFormatter, ArgumentTypeError + +START_ADDRESS = 0x52000 +LAYOUT_ADDRESS = 0x51000 +SECTOR_SIZE = 4096 +MAX_LINE_LEN = max_line_len=128 - len(os.linesep) + +class BlockNumber: + @staticmethod + def from_address(addr): return BlockNumber(addr / SECTOR_SIZE) + def __init__(self, num): self.num = num + def __str__(self): return str(self.num) + +class App: + TEMPLATE = """%s load +%s load +%s +stack-show +/end\n""" + + def __init__(self, path, address, layout_address, code_format): + self.path = path + self.address = address + self.layout_address = layout_address + self.code_format = code_format + + def _generate(self, core_block_num): + name = 'main.tmp' + with open(name, "wt") as f: f.write(self._content(core_block_num)) + return name + + def _content(self, core_block_num): + return App.TEMPLATE % (core_block_num, BlockNumber.from_address(self.layout_address), self._read()) + + def code(self): + code = Code(self._generate('dummy'.ljust(8)), 'APP', self.code_format) + core_block_num = BlockNumber.from_address(self.address + code.flash_usage()) # XXX Assumption: after me there is the core module + return Code(self._generate(str(core_block_num).ljust(8)), 'APP', self.code_format) # save it again with the correct address + + def _read(self): + if not self.path: return '' + with open(self.path, "rt") as app: return app.read() + + def _save(self, output_file, content): + with open(output_file, 'wt') as f: f.write(content) + return output_file + +class CodeFormat: + @staticmethod + def create(block_format): + return ScreenAlignedFormat(MAX_LINE_LEN) if block_format else OriginalFormat() + + def transform(self, content): raise RuntimeError('Subclass responsibility') + +class ScreenAlignedFormat(CodeFormat): + def __init__(self, max_line_len): + self.max_line_len = max_line_len + + def transform(self, content): + """ This is for the block screen editor. A screen = 128 columns and 32 rows """ + def pad_line(line): + return line + (' ' * (self.max_line_len - len(line))) + return '\n'.join([pad_line(line) for line in content.split('\n')]) + +class OriginalFormat(CodeFormat): + def transform(self, content): return content + +class Code: + def __init__(self, path, name, code_format): + self.name = name + self.content = code_format.transform(self._load(path)) + + def _load(self, path): + with open(path) as f: return f.read() + + def validate(self, max_line_len): + if any(len(line) > max_line_len for line in self.content.split('\n')): + raise RuntimeError('Input overflow at line: "%s"' % [line for line in self.content.split('\n') if len(line) >= max_line_len][0]) + + def flash_usage(self): + return (len(self.content) / SECTOR_SIZE + 1) * SECTOR_SIZE + + def flashable(self, address): + return Flashable(self.name, address, self._save("%s.tmp" % self.name)) + + def _save(self, output_file): + with open(output_file, 'wt') as f: f.write(self.content) + return output_file + +class Flashable: + def __init__(self, name, address, path): + self.name = name + self.address = address + self.path = path + +class Modules: + class All: + def __call__(self, code): return code.name.lower() != 'test' + def __str__(self): return 'ALL' + + class Nothing: + def __call__(self, code): return code.name.lower() == 'app' + def __str__(self): return 'NONE' + + class Only: + def __init__(self, names): + self.names = set(each.lower() for each in names) + self.names.add('core') + self.names.add('app') + self.names.add('layout') + def __call__(self, code): return code.name.lower() in self.names + def __str__(self): return 'Only: %s' % self.names + + def __init__(self, start_address, layout_address, max_line_len): + self.start_address = start_address + self.layout_address = layout_address + self.max_line_len = max_line_len + self.modules = [] + self.module_filter = Modules.All() + + def add(self, code): + code.validate(self.max_line_len) + self.modules.append(code) + return self + + def select(self, module_filter): + print 'Selected modules: %s' % module_filter + self.module_filter = module_filter + + def selected(self): + return (each for each in self.modules if self.module_filter(each)) + + def flash(self, esp, block_format): + self.flash_layout(esp, block_format) + self.flash_modules(esp, block_format) + + def flash_layout(self, esp, block_format): + layout = Layout.generate(self.to_be_flashed(), block_format) + if self.module_filter(layout): + flashable = layout.flashable(self.layout_address) + esp.write_flash(self.layout_address, flashable.path) + + def flash_modules(self, esp, block_format): + esp.write_flash_many([(each.address, each.path) for each in self.to_be_flashed()]) + + def to_be_flashed(self): + result = [] + address = self.start_address + for code in self.selected(): + result.append(code.flashable(address)) + address += code.flash_usage() + return result + +class Layout: + @staticmethod + def generate(flashables, block_format): + layout = 'layout.tmp' + with open(layout, 'wt') as f: + for each in flashables: + if each.name not in ['APP', 'CORE']: + f.write('%s constant: %s\n' % (BlockNumber.from_address(each.address), each.name)) + f.write('/end\n') + return Code(layout, 'LAYOUT', CodeFormat.create(block_format)) + +class Binaries: + def __init__(self): + self.binaries = ( + (0x0000, 'rboot.bin'), + (0x1000, 'blank_config.bin'), + (0x2000, 'punyforth.bin')) + + def flash(self, esp): + print("Flashing binaries..") + esp.write_flash_many(self.binaries) + +class Esp: + def __init__(self, port, flashmode): + self.port = port + self.flashmode = flashmode + + def write_flash(self, address, path): + print 'Flashing %s' % os.path.basename(path) + os.system("python esptool.py -p %s write_flash -fm %s -ff 40m 0x%x %s" % (self.port, self.flashmode, address, path)) + + def write_flash_many(self, tupl): + if not tupl: return + print 'Flashing %s' % ', '.join('0x%x: %s' % (address, os.path.basename(path)) for (address, path) in tupl) + os.system("python esptool.py -p %s write_flash -fs 32m -fm %s -ff 40m %s" % (self.port, self.flashmode, ' '.join("0x%x %s" % each for each in tupl))) + +class CommandLine: + @staticmethod + def to_bool(v): + if v.lower() in ('yes', 'true', 'y', '1'): return True + if v.lower() in ('no', 'false', 'n', '0'): return False + raise ArgumentTypeError('%s is not a boolean' % v) + + def __init__(self): + self.parser = ArgumentParser(description='Flash punyforth binaries and forth code.', epilog=self.examples(), formatter_class=RawDescriptionHelpFormatter) + self.parser.add_argument('port', help='COM port of the esp8266') + self.parser.add_argument('--modules', nargs='*', default=['all'], help='List of modules. Default is "all".') + self.parser.add_argument('--binary', default=True, type=CommandLine.to_bool, help='Use "no" to skip flashing binaries. Default is "yes".') + self.parser.add_argument('--main', default='', help='Path of the Forth code that will be used as an entry point.') + self.parser.add_argument('--flashmode', default='qio', help='Valid values are: qio, qout, dio, dout') + self.parser.add_argument('--block-format', default=False, type=CommandLine.to_bool, help='Use "yes" to format source code into block format (128 columns and 32 rows padded with spaces). Default is "no".') + + def examples(self): + return """ +Examples: +Flash only source code in block format. Only flash the "flash" module. + $ python flash.py /dev/cu.wchusbserial1410 --binary false --block-format true --main myapp.forth --modules flash + +Flash all modules and binaries: + $ python flash.py /dev/cu.wchusbserial1410 + +Flash all modules, binaries and use myapp.forth as an entry point: + $ python flash.py /dev/cu.wchusbserial1410 --main myapp.forth + +Available modules:\n%s + """ % '\n'.join("\t* %s" % each[1] for each in AVAILABLE_MODULES) + + def parse(self): + args = self.parser.parse_args() + args.modules = self.modules(args) + args.code_format = CodeFormat.create(args.block_format) + return args + + def modules(self, args): + if args.modules == ['all']: return Modules.All() + if args.modules == ['none']: return Modules.Nothing() + return Modules.Only(args.modules) + +# TODO: +# Protection against loading multiple transitive modules + +AVAILABLE_MODULES = [ + ('../../../generic/forth/core.forth', 'CORE'), + ('../forth/dht22.forth', 'DHT22'), + ('../forth/flash.forth', 'FLASH'), + ('../forth/font5x7.forth', 'FONT57'), + ('../forth/gpio.forth', 'GPIO'), + ('../forth/mailbox.forth', 'MAILBOX'), + ('../forth/netcon.forth', 'NETCON'), + ('../forth/ntp.forth', 'NTP'), + ('../forth/ping.forth', 'PING'), + ('../forth/sonoff.forth', 'SONOFF'), + ('../forth/ssd1306-i2c.forth', 'SSD1306I2C'), + ('../forth/ssd1306-spi.forth', 'SSD1306SPI'), + ('../forth/tasks.forth', 'TASKS'), + ('../forth/tcp-repl.forth', 'TCPREPL'), + ('../forth/turnkey.forth', 'TURNKEY'), + ('../forth/wifi.forth', 'WIFI'), + ('../forth/event.forth', 'EVENT'), + ('../../../generic/forth/ringbuf.forth', 'RINGBUF'), + ('../../../generic/forth/decompiler.forth', 'DECOMP'), + ('../../../generic/forth/punit.forth', 'PUNIT'), + ('../../../generic/forth/test.forth', 'TEST') +] + +def tmpfiles(): return (each for each in os.listdir('.') if each.endswith('.tmp')) +def remove(files): + for each in files: os.remove(each) + +if __name__ == '__main__': + args = CommandLine().parse() + esp = Esp(args.port, args.flashmode) + app = App(args.main, START_ADDRESS, LAYOUT_ADDRESS, args.code_format) + modules = Modules(START_ADDRESS, LAYOUT_ADDRESS, max_line_len=MAX_LINE_LEN) + modules.add(app.code()) + for path, name in AVAILABLE_MODULES: modules.add(Code(path, name, args.code_format)) + modules.select(args.modules) + if args.binary: Binaries().flash(esp) + modules.flash(esp, args.block_format) + remove(tmpfiles()) diff --git a/arch/esp8266/bin/flash.sh b/arch/esp8266/bin/flash.sh deleted file mode 100755 index 7e79fe7..0000000 --- a/arch/esp8266/bin/flash.sh +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/sh -THEPORT=${1:-$ESPPORT} -if [ -z "$THEPORT" ] - then - echo "Port definition missing. Either give command-line parameter like '$0 /dev/usb000' or set environment variable ESPPORT" - exit 1 -fi - -python esptool.py -p $THEPORT write_flash -fs 32m -fm dio -ff 40m 0x00000 rboot.bin 0x1000 blank_config.bin 0x2000 punyforth.bin 0x51000 uber.forth - diff --git a/arch/esp8266/bin/modules.py b/arch/esp8266/bin/modules.py deleted file mode 100644 index fbccc5c..0000000 --- a/arch/esp8266/bin/modules.py +++ /dev/null @@ -1,131 +0,0 @@ -import sys, os -from compiler.ast import flatten - -FLASH_SPACE = 180*1024 -UBER_NAME = 'uber.forth' -MAX_LINE_LEN = 127 - -available_modules = { - 'core' : '../../../generic/forth/core.forth', - 'punit' : '../../../generic/forth/punit.forth', - 'test' : '../../../generic/forth/test.forth', - 'ringbuf' : '../../../generic/forth/ringbuf.forth', - 'gpio' : '../forth/gpio.forth', - 'event' : '../forth/event.forth', - 'wifi' : '../forth/wifi.forth', - 'ssd1306-spi' : '../forth/ssd1306-spi.forth', - 'netcon' : '../forth/netcon.forth', - 'netcon-test' : '../forth/netcon-test.forth', - 'tasks' : '../forth/tasks.forth', - 'tcp-repl' : '../forth/tcp-repl.forth', - 'flash' : '../forth/flash.forth', - 'dht22' : '../forth/dht22.forth', - 'ping' : '../forth/ping.forth', - 'example-game-of-life' : '../forth/examples/example-game-of-life.forth', - 'example-ircbot' : '../forth/examples/example-ircbot.forth', - 'example-philips-hue' : '../forth/examples/example-philips-hue.forth', - 'example-philips-hue-lightswitch' : '../forth/examples/example-philips-hue-lightswitch.forth', - 'example-philips-hue-pir' : '../forth/examples/example-philips-hue-pir.forth', - 'example-philips-hue-clap' : '../forth/examples/example-philips-hue-clap.forth', - 'example-geekcreit-rctank' : '../forth/examples/example-geekcreit-rctank.forth', - 'example-http-server' : '../forth/examples/example-http-server.forth', - 'example-dht22-data-logger' : '../forth/examples/example-dht22-data-logger.forth', -} - -dependencies = { - 'core' : [], - 'punit' : ['core'], - 'test' : ['core', 'punit'], - 'ringbuf' : ['core'], - 'gpio' : ['core'], - 'event' : ['core', 'tasks'], - 'wifi' : ['core'], - 'ssd1306-spi' : ['core', 'gpio'], - 'netcon' : ['core', 'tasks'], - 'netcon-test' : ['netcon', 'punit', 'wifi'], - 'tasks' : ['core', 'ringbuf'], - 'flash' : ['core'], - 'dht22' : ['core', 'gpio'], - 'ping': ['core', 'gpio'], - 'tcp-repl' : ['core', 'netcon', 'wifi'], - 'example-game-of-life' : ['core', 'ssd1306-spi'], - 'example-ircbot' : ['core', 'netcon', 'tasks', 'gpio'], - 'example-philips-hue' : ['core', 'netcon'], - 'example-philips-hue-lightswitch' : ['example-philips-hue', 'tasks', 'gpio', 'event'], - 'example-philips-hue-pir' : ['example-philips-hue', 'tasks', 'gpio', 'event'], - 'example-philips-hue-clap' : ['example-philips-hue', 'tasks', 'gpio', 'event'], - 'example-geekcreit-rctank' : ['core', 'tasks', 'gpio', 'event', 'wifi', 'netcon', 'tcp-repl'], - 'example-http-server' : ['core', 'netcon', 'wifi'], - 'example-dht22-data-logger' : ['dht22', 'netcon'] -} - -def print_help(): - print('Usage: %s [--app /path/to/app.forth] [modul1] [modul2] .. [modulN] ' % (os.path.basename(sys.argv[0]))) - print('Available modules:') - for each in available_modules.keys(): - print(' * ' + each) - sys.exit() - -def collect_dependecies(modules): - def _deps(modules, result=[]): - for mod in modules: - transitive = [] - _deps(dependencies[mod], result=transitive) - if transitive: - result.append(transitive) - if dependencies[mod]: - result.append(dependencies[mod]) - result.append([mod]) - print('Analyzing dependencies..') - result = [] - _deps(modules, result=result) - unique_result = [] - for each in flatten(result): - if each not in unique_result: unique_result.append(each) - print('Modules with dependencies: %s' % unique_result) - return unique_result - -def module_paths(modules): - try: - return [available_modules[each] for each in modules] - except KeyError as e: - print('Module not found: ' + str(e)) - sys.exit() - -def uber_module(modules, app=None): - contents = [open(each).read() for each in module_paths(modules)] - if app: - with open(app) as f: contents.append(f.read()) - contents.append('\nstack-show ') - contents.append(chr(0)) - return '\n'.join(contents) - -def check_uber(uber): - if len(uber) > FLASH_SPACE: - print('Not enough space in flash') - sys.exit() - if any(len(line) >= MAX_LINE_LEN for line in uber.split('\n')): - print('Input overflow at line: "%s"' % [line for line in uber.split('\n') if len(line) >= MAX_LINE_LEN][0]) - sys.exit() - -if __name__ == '__main__': - if os.path.isfile(UBER_NAME): os.remove(UBER_NAME) - if len(sys.argv) == 1: print_help() - if sys.argv[1] == '--app': - app = sys.argv[2] - if not os.path.isfile(app): - print('Application %s does not exist' % app) - print_help() - print("Application: %s" % app) - chosen_modules = sys.argv[3:] - else: - app = None - chosen_modules = sys.argv[1:] - print('Chosen modules %s' % chosen_modules) - if not set(chosen_modules).issubset(available_modules.keys()): - print('No such module') - print_help() - uber = uber_module(collect_dependecies(chosen_modules), app=app) - check_uber(uber) - with open(UBER_NAME, 'wt') as f: f.write(uber) - print('%s ready. Use flash to install' % UBER_NAME) \ No newline at end of file diff --git a/arch/esp8266/bin/punyforth.bin b/arch/esp8266/bin/punyforth.bin index 4273d38..ac4f5f1 100644 Binary files a/arch/esp8266/bin/punyforth.bin and b/arch/esp8266/bin/punyforth.bin differ diff --git a/arch/esp8266/cinterop.S b/arch/esp8266/cinterop.S index 1f254ff..c42f534 100644 --- a/arch/esp8266/cinterop.S +++ b/arch/esp8266/cinterop.S @@ -1,8 +1,7 @@ .macro CCALL label - addi sp, sp, -32 // adjust stack pointer - s32i a0, sp, 28 // save return address - s32i a8, sp, 20 // save a8 - s32i a12, sp, 16 // save a12 + addi sp, sp, -28 // adjust stack pointer + s32i a0, sp, 24 // save return address + s32i a8, sp, 16 // save a8 s32i a13, sp, 12 // save a13 s32i a14, sp, 8 // save a14 s32i a15, sp, 4 // save a15 @@ -10,8 +9,7 @@ l32i a15, sp, 4 // get saved a15 l32i a14, sp, 8 // get saved a14 l32i a13, sp, 12 // get saved a13 - l32i a12, sp, 16 // get saved a12 - l32i a8, sp, 20 // get saved a8 - l32i a0, sp, 28 // get the saved return address - addi sp, sp, 32 // restore stack pointer + l32i a8, sp, 16 // get saved a8 + l32i a0, sp, 24 // get the saved return address + addi sp, sp, 28 // restore stack pointer .endm diff --git a/arch/esp8266/ext.S b/arch/esp8266/ext.S index 66bf52b..b7582fd 100644 --- a/arch/esp8266/ext.S +++ b/arch/esp8266/ext.S @@ -28,107 +28,145 @@ defprimitive "readchar-nowait",15,readchar_nowait,REGULAR /* ( -- char | -1 ) */ DPUSH a2 NEXT +defprimitive "load",4,load,REGULAR + DPOP a2 // block number + CCALL forth_load + NEXT + +defprimitive "loading?",8,loading,REGULAR + CCALL forth_loading + DPUSH a2 + NEXT + +defprimitive "/end",4,end_load,REGULAR + CCALL forth_end_load + NEXT + defprimitive "over",4,over,REGULAR /* ( a b -- a b a ) */ - l32i a8, a15, CELLS + READTOS2 a8 + DPUSH a8 + NEXT + +defprimitive "-rot",4,mrot,REGULAR /*( a b c -- c a b ) */ + READTOS1 a8 + READTOS2 a9 + READTOS3 a10 + WRTETOS3 a8 + WRTETOS2 a10 + WRTETOS1 a9 + NEXT + +defprimitive "2dup",4,dup2,REGULAR + READTOS2 a9 + READTOS1 a8 + DPUSH a9 DPUSH a8 NEXT +defprimitive "2drop",5,"drop2",REGULAR + addi a15, a15, 2*CELLS + NEXT + +defprimitive "4drop",5,"drop4",REGULAR + addi a15, a15, 4*CELLS + NEXT + defprimitive "cells",5,cells,REGULAR - DPOP a9 + READTOS1 a9 movi a8, 2 ssl a8 sll a8, a9 - DPUSH a8 + WRTETOS1 a8 NEXT defprimitive ">",1,gt,REGULAR DPOP a8 - DPOP a9 + READTOS1 a9 movi a10, FALSE bge a8, a9, L5 movi a10, TRUE -L5: DPUSH a10 +L5: WRTETOS1 a10 NEXT defprimitive "=",1,eq,REGULAR DPOP a8 - DPOP a9 + READTOS1 a9 movi a10, FALSE bne a8, a9, L6 movi a10, TRUE -L6: DPUSH a10 +L6: WRTETOS1 a10 NEXT defprimitive "<>",2,noteq,REGULAR DPOP a8 - DPOP a9 + READTOS1 a9 movi a10, FALSE beq a8, a9, L7 movi a10, TRUE -L7: DPUSH a10 +L7: WRTETOS1 a10 NEXT defprimitive "<=",2,lte,REGULAR DPOP a8 - DPOP a9 + READTOS1 a9 movi a10, FALSE blt a8, a9, L8 movi a10, TRUE -L8: DPUSH a10 +L8: WRTETOS1 a10 NEXT defprimitive ">=",2,gte,REGULAR DPOP a8 - DPOP a9 + READTOS1 a9 movi a10, FALSE blt a9, a8, L9 movi a10, TRUE -L9: DPUSH a10 +L9: WRTETOS1 a10 NEXT defprimitive "1+",2,inc,REGULAR - DPOP a8 + READTOS1 a8 addi a8, a8, 1 - DPUSH a8 + WRTETOS1 a8 NEXT defprimitive "1-",2,dec,REGULAR - DPOP a8 + READTOS1 a8 addi a8, a8, -1 - DPUSH a8 + WRTETOS1 a8 NEXT defprimitive "0=",2,eq0,REGULAR - DPOP a8 + READTOS1 a8 movi a9, FALSE movi a10, TRUE moveqz a9, a10, a8 // move a10 to a9 if a8 is zero - DPUSH a9 + WRTETOS1 a9 NEXT defprimitive "0<>",3,noteq0,REGULAR - DPOP a8 + READTOS1 a8 movi a9, FALSE movi a10, TRUE movnez a9, a10, a8 // move a10 to a9 if a8 is not zero - DPUSH a9 + WRTETOS1 a9 NEXT defprimitive "0<",2,lt0,REGULAR - DPOP a8 + READTOS1 a8 movi a9, FALSE movi a10, TRUE movltz a9, a10, a8 // move a10 to a9 if a8 is less than zero - DPUSH a9 + WRTETOS1 a9 NEXT defprimitive "0>",2,gt0,REGULAR - DPOP a8 + READTOS1 a8 movi a9, TRUE movi a10, FALSE movltz a9, a10, a8 // move a10 to a9 if a8 is less than zero moveqz a9, a10, a8 // move a10 to a9 if a8 is zero - DPUSH a9 + WRTETOS1 a9 NEXT defprimitive "ms@",3,msat,REGULAR @@ -171,6 +209,11 @@ defprimitive "gpio-read",9,gpioread,REGULAR DPUSH a2 NEXT +defprimitive "adc-read",8,adcread,REGULAR + CCALL sdk_system_adc_read + DPUSH a2 + NEXT + defprimitive "pwm-init",8,pwminit,REGULAR DPOP a2 // pins array DPOP a3 // number of pins in array @@ -200,12 +243,27 @@ defprimitive "ms",2,ms,REGULAR CCALL forth_delay_ms NEXT +// internal timeout defprimitive "netcon-set-recvtimeout",22,netcon_set_recvtimeout,REGULAR DPOP a2 // conn DPOP a3 // recv timeout ms CCALL forth_netcon_set_recvtimeout NEXT +// get user defined socket read timeout +defprimitive "netcon-read-timeout@",20,netcon_get_readtimeout,REGULAR + DPOP a2 // netcon + CCALL forth_netcon_get_read_timeout + DPUSH a2 // timeout_sec + NEXT + +// set user defined socket read timeout +defprimitive "netcon-read-timeout!",20,netcon_set_readtimeout,REGULAR + DPOP a2 // netcon + DPOP a3 // timeout_sec + CCALL forth_netcon_set_read_timeout + NEXT + defprimitive "netcon-new",10,netcon_new,REGULAR DPOP a2 // conn type CCALL forth_netcon_new @@ -332,7 +390,7 @@ defprimitive "erase-flash",11,erase_flash,REGULAR NEXT defprimitive "read-flash",10,read_flash,REGULAR - DPOP a2 // sector + DPOP a2 // address DPOP a3 // buffer DPOP a4 // size CCALL forth_flash_read @@ -340,7 +398,7 @@ defprimitive "read-flash",10,read_flash,REGULAR NEXT defprimitive "write-flash",11,write_flash,REGULAR - DPOP a2 // sector + DPOP a2 // address DPOP a3 // buffer DPOP a4 // size CCALL forth_flash_write @@ -375,6 +433,20 @@ defprimitive "spi-send",8,spi_send,REGULAR DPUSH a2 NEXT +defprimitive "wifi-stop",9,wifi_stop,REGULAR + CCALL forth_wifi_stop + NEXT + +defprimitive "wifi-softap-start",17,wifi_softap_start,REGULAR + CCALL sdk_wifi_softap_start + DPUSH a2 // c bool + NEXT + +defprimitive "wifi-station-start",18,wifi_station_start,REGULAR + CCALL sdk_wifi_station_start + DPUSH a2 // c bool + NEXT + defprimitive "wifi-set-mode",13,wifi_set_mode,REGULAR DPOP a2 // mode CCALL forth_wifi_set_opmode @@ -405,8 +477,9 @@ defprimitive "wifi-set-ip",11,wifi_set_ip,REGULAR NEXT defprimitive "wifi-ip-str",11,wifi_ip_str,REGULAR - DPOP a2 // buffer - DPOP a3 // buffer size + DPOP a2 // interface 0 = station, 1 = softap + DPOP a3 // buffer + DPOP a4 // buffer size CCALL forth_wifi_get_ip_str NEXT @@ -461,3 +534,85 @@ defprimitive "pulse-in",8,pulse_in,REGULAR CCALL forth_pulse_in DPUSH a2 // pulse len us NEXT + +defprimitive "r@",2,rfetch,REGULAR + l32i a2, a13, 0 + DPUSH a2 + NEXT + +defprimitive "i2c-start",9,i2c_start,REGULAR + DPOP a2 // bus + CCALL forth_i2c_start + NEXT + +defprimitive "i2c-stop",8,i2c_stop,REGULAR + DPOP a2 // bus + CCALL forth_i2c_stop + DPUSH a2 // cbool + NEXT + +defprimitive "i2c-init",8,i2c_init,REGULAR + DPOP a2 // bus + DPOP a3 // scl_pin + DPOP a4 // sda_pin + DPOP a5 // freq + CCALL forth_i2c_init + DPUSH a2 // int result + NEXT + +defprimitive "i2c-read",8,i2c_read,REGULAR + DPOP a2 // bus + DPOP a3 // ack + CCALL forth_i2c_read + DPUSH a2 // data + NEXT + +defprimitive "i2c-write",9,i2c_write,REGULAR + DPOP a2 // bus + DPOP a3 // byte + CCALL forth_i2c_write + DPUSH a2 // cbool + NEXT + +defprimitive "i2c-read-slave",14,i2c_read_slave,REGULAR + DPOP a2 // bus + DPOP a3 // slave_addr + DPOP a4 // data + DPOP a5 // buffer + DPOP a6 // len + CCALL forth_i2c_slave_read + DPUSH a2 // int result + NEXT + +defprimitive "i2c-write-slave",15,i2c_write_slave,REGULAR + DPOP a2 // bus + DPOP a3 // slave_addr + DPOP a4 // data + DPOP a5 // buffer + DPOP a6 // len + CCALL forth_i2c_slave_write + DPUSH a2 // int result + NEXT + +defprimitive "cpufreq!",8,setcpufreq,REGULAR + DPOP a2 // frequency in mhz (byte) + CCALL sdk_system_update_cpu_freq + DPUSH a2 // C bool + NEXT + +defprimitive "cpufreq@",8,getcpufreq,REGULAR + CCALL sdk_system_get_cpu_freq + DPUSH a2 // C bool + NEXT + +defprimitive "ws2812rgb",9,ws2812rgb,REGULAR + DPOP a2 // gpio num + DPOP a3 // rgb + CCALL forth_ws2812_rgb + NEXT + +defprimitive "ws2812set",9,ws2812set,REGULAR + DPOP a2 // gpio num + DPOP a3 // rgb + CCALL forth_ws2812_set + NEXT diff --git a/arch/esp8266/forth/dht22.forth b/arch/esp8266/forth/dht22.forth index 65389f1..0650318 100644 --- a/arch/esp8266/forth/dht22.forth +++ b/arch/esp8266/forth/dht22.forth @@ -1,3 +1,5 @@ +GPIO load + 40 byte-array: bits 5 byte-array: bytes 2 init-variable: var-dht-pin \ default D4, wemos d1 mini dht22 shield, use dht-pin! to override @@ -56,7 +58,7 @@ exception: ECHECKSUM then ; : convert ( lsb-byte msb-byte -- value ) - { hex: 7F and 8 lshift or } keep + { 16r7F and 8 lshift or } keep 128 and 0<> if 0 swap - then ; @@ -72,4 +74,6 @@ exception: ECHECKSUM process validate temperature humidity ; - \ No newline at end of file + +/end + diff --git a/arch/esp8266/forth/event.forth b/arch/esp8266/forth/event.forth index bfad4f1..18d68ed 100644 --- a/arch/esp8266/forth/event.forth +++ b/arch/esp8266/forth/event.forth @@ -1,3 +1,5 @@ +TASKS load + struct cell field: .type cell field: .ms @@ -15,3 +17,6 @@ constant: Event pause repeat drop ; + +/end + diff --git a/arch/esp8266/forth/examples/example-buzzer-mario.forth b/arch/esp8266/forth/examples/example-buzzer-mario.forth new file mode 100644 index 0000000..3b2f2ca --- /dev/null +++ b/arch/esp8266/forth/examples/example-buzzer-mario.forth @@ -0,0 +1,48 @@ +GPIO load + +\ playing sound with a passive buzzer +523 constant: C +554 constant: C1 +587 constant: D +622 constant: Eb +659 constant: E +698 constant: F +740 constant: F1 +784 constant: G +831 constant: Ab +880 constant: A +932 constant: Bb +988 constant: B +1047 constant: c +1109 constant: c1 +1175 constant: d +1245 constant: eb +1319 constant: e +1397 constant: f +1479 constant: f1 +1567 constant: g +1661 constant: ab +1761 constant: a +1866 constant: bb +1976 constant: b + +create: song e , e , e , c , e , g , G , c , G , E , A , B , Bb , + A , G , e , g , a , f , g , e , c , d , B , c , + +create: tempo 6 , 12 , 12 , 6 , 12 , 24 , 24 , 18 , 18 , 18 , 12 , 12 , + 6 , 12 , 8 , 8 , 8 , 12 , 6 , 12 , 12 , 6 , 6 , 6 , 12 , + +4 constant: PIN \ d2 +create: PWM_PINS PIN c, +PIN GPIO_OUT gpio-mode +PWM_PINS 1 pwm-init +1023 pwm-duty + +: play ( -- ) + 25 0 do + pwm-start + song i cells + @ pwm-freq + tempo i cells + @ 20 * ms + pwm-stop + 1000 us + loop ; diff --git a/arch/esp8266/forth/examples/example-buzzer-starwars.forth b/arch/esp8266/forth/examples/example-buzzer-starwars.forth new file mode 100644 index 0000000..621f910 --- /dev/null +++ b/arch/esp8266/forth/examples/example-buzzer-starwars.forth @@ -0,0 +1,72 @@ +GPIO load +\ playing sound with a passive buzzer + +129 constant: cL +139 constant: cLS +146 constant: dL +156 constant: dLS +163 constant: eL +173 constant: fL +185 constant: fLS +194 constant: gL +207 constant: gLS +219 constant: aL +228 constant: aLS +232 constant: bL +261 constant: c +277 constant: cS +294 constant: d +311 constant: dS +329 constant: e +349 constant: f +370 constant: fS +391 constant: g +415 constant: gS +440 constant: a +455 constant: aS +466 constant: b +523 constant: cH +554 constant: cHS +587 constant: dH +622 constant: dHS +659 constant: eH +698 constant: fH +740 constant: fHS +784 constant: gH +830 constant: gHS +880 constant: aH +910 constant: aHS +933 constant: bH + +create: song a , a , a , f , cH , a , f , cH , a , eH , eH , eH , fH , cH , gS , f , cH , a , aH , a , a , aH , gHS , + gH , fHS , fH , fHS , aS , dHS , dH , cHS , cH , b , cH , f , gS , f , a , cH , a , cH , eH , aH , a , a , + aH , gHS , gH , fHS , fH , fHS , aS , dHS , dH , cHS , cH , b , cH , f , gS , f , cH , a , f , c , a , + +create: tempo 500 , 500 , 500 , 350 , 150 , 500 , 350 , 150 , 1000 , 500 , 500 , 500 , 350 , 150 , 500 , 350 , 150 , + 1000 , 500 , 350 , 150 , 500 , 250 , 250 , 125 , 125 , 250 , 250 , 500 , 250 , 250 , 125 , 125 , 250 , + 125 , 500 , 375 , 125 , 500 , 375 , 125 , 1000 , 500 , 350 , 150 , 500 , 250 , 250 , 125 , 125 , 250 , + 250 , 500 , 250 , 250 , 125 , 125 , 250 , 250 , 500 , 375 , 125 , 500 , 375 , 125 , 1000 , + +4 constant: PIN \ d2 + +create: PWM_PINS PIN c, + +PIN GPIO_OUT gpio-mode +PWM_PINS 1 pwm-init +1023 pwm-duty + +: play ( -- ) + 66 0 do + pwm-start + song i cells + @ pwm-freq + tempo i cells + @ ms + pwm-stop + 20 ms + i case + 26 of 250 ms endof + 34 of 250 ms endof + 52 of 250 ms endof + 60 of 250 ms endof + drop + endcase + loop ; diff --git a/arch/esp8266/forth/examples/example-clock.forth b/arch/esp8266/forth/examples/example-clock.forth new file mode 100644 index 0000000..85e2205 --- /dev/null +++ b/arch/esp8266/forth/examples/example-clock.forth @@ -0,0 +1,145 @@ +NTP load +SSD1306I2C load +FONT57 load + +variable: clock +variable: tick +variable: timezone +0 init-variable: offset +0 init-variable: last-sync +3 byte-array: ]mm 0 2 ]mm c! : mm 0 ]mm ; +3 byte-array: ]hh 0 2 ]hh c! : hh 0 ]hh ; + +: age ( -- ms ) ms@ last-sync @ - ; +: expired? ( -- bool ) age 60000 15 * > ; +: stale? ( -- bool ) age 60000 60 * > clock @ 0= or ; +: fetch ( -- ts ) 123 "time.google.com" network-time ; +: sync ( -- ) { fetch clock ! ms@ last-sync ! } catch ?dup if print: 'sync error:' ex-type cr then ; +: time ( -- ts ) clock @ offset @ 60 * + age 1000 / + ; +: mins ( ts -- n ) 60 / 60 % ; +: hour ( ts -- n ) 3600 / 24 % ; +: secs ( ts ---n ) 60 % ; + +\ based on: http://howardhinnant.github.io/date_algorithms.html#civil_from_days +: era ( ts -- n ) 86400 / 719468 + dup 0< if 146096 - then 146097 / ; +: doe ( ts -- n ) dup 86400 / 719468 + swap era 146097 * - ; +: yoe ( ts -- n ) doe dup 1460 / over 36524 / + over 146096 / - - 365 / ; +: doy ( ts -- n ) dup doe swap yoe dup 365 * over 4 / + swap 100 / - - ; +: mp ( ts -- n ) doy 5 * 2 + 153 / ; +: epoch-days ( ts -- n ) dup era 146097 * swap doe + 719468 - ; +: weekday ( ts -- 1..7=mon..sun ) epoch-days dup -4 >= if 4 + 7 % else 5 + 7 % 6 + then ?dup 0= if 7 then ; +: day ( ts -- 1..31 ) dup doy swap mp 153 * 2 + 5 / - 1+ ; +: month ( ts -- 1..12 ) mp dup 10 < if 3 else -9 then + ; +: year ( ts -- n ) dup yoe over era 400 * + swap month 2 < if 1 else 0 then + ; + +: era ( year -- n ) dup 0< if 399 - then 400 / ; +: yoe ( year --n ) dup era 400 * - ; +: doy ( d m -- n ) dup 2 > if -3 else 9 then + 153 * 2 + 5 / swap + 1- ; +: doe ( d m y -- n ) yoe dup 365 * over 4 / + swap 100 / - -rot doy + ; +: days ( d m y -- days-since-epoch ) over 2 <= if 1- then dup era 146097 * >r doe r> + 719468 - ; +: >ts ( d m y -- ts ) days 86400 * ; + +struct + cell field: .week \ 1st..4th + cell field: .dow \ 1..7 mon..sun + cell field: .month \ 1..12 + cell field: .hour \ 0..23 + cell field: .offset \ Offset from UTC in minutes + cell field: .name +constant: RULE +: rule: RULE create: allot ; + +struct + cell field: .standard + cell field: .summer +constant: TZ +: tz: TZ create: allot ; + +( US West Coast ) +rule: PST + 1 PST .week ! + 7 PST .dow ! +11 PST .month ! + 2 PST .hour ! +-480 PST .offset ! +"PST" PST .name ! +rule: PDT + 2 PDT .week ! + 7 PDT .dow ! + 3 PDT .month ! + 2 PDT .hour ! +-420 PDT .offset ! +"PDT" PDT .name ! +tz: US3 +PST US3 .standard ! +PDT US3 .summer ! + +( US East Coast ) +rule: EST + 1 EST .week ! + 7 EST .dow ! +11 EST .month ! + 2 EST .hour ! +-300 EST .offset ! +"EST" EST .name ! +rule: EDT + 2 EDT .week ! + 7 EDT .dow ! + 3 EDT .month ! + 2 EDT .hour ! +-240 EDT .offset ! +"EDT" EDT .name ! +tz: US1 +EST US1 .standard ! +EDT US1 .summer ! + +: 1stday ( month -- 1..7 ) 1 swap time year >ts weekday ; +: dday ( rule -- day ) + dup .dow @ + over .month @ 1stday 2dup >= if - else 7 swap - + then 1+ + swap .week @ 1- 7 * + ; + +: shifting-time ( rule -- utc ) + dup dday + over .month @ time year >ts + over .offset @ -60 * + + swap .hour @ 3600 * + ; + +: summer-start ( -- utc ) timezone @ .summer @ shifting-time ; +: standard-start ( -- utc ) timezone @ .standard @ shifting-time ; +: [a,b)? ( a n b -- bool ) over > -rot <= and ; +: daylight-saving? ( -- bool ) + standard-start summer-start > if + summer-start time standard-start [a,b)? + else + summer-start time standard-start [a,b)? invert + then ; +: current-zone ( -- rule ) daylight-saving? if timezone @ .summer @ else timezone @ .standard @ then ; +: apply-zone ( -- ) current-zone .offset @ offset ! ; + +: format ( -- ) + time hour 10 < if $0 hh c! 1 else 0 then ]hh time hour >str + time mins 10 < if $0 mm c! 1 else 0 then ]mm time mins >str ; + +: center ( -- ) + WIDTH 2 / "00:00 PDT" str-width 2 / - text-left ! + HEIGHT 2 / 8 font-size @ * 2 / - text-top ! ; +: colon ( -- ) tick @ if ":" else " " then draw-str tick @ invert tick ! ; +: clean ( -- ) 0 fill-buffer ; +: draw-time ( -- ) + format + WIDTH 128 >= if font-medium else font-small then + center hh draw-str colon mm draw-str " " draw-str + current-zone .name @ draw-str ; + +: stale-warning ( -- ) font-small 0 text-top ! 0 text-left ! "Stale" draw-str ; +: draw ( -- ) clean stale? if stale-warning else apply-zone draw-time then display ; +: start ( task -- ) activate begin expired? if sync then draw 1000 ms pause again ; + +0 task: time-task +: main ( -- ) + US3 timezone ! + display-init font5x7 font ! + sync multi time-task start ; + +main diff --git a/arch/esp8266/forth/examples/example-dht22-data-logger.forth b/arch/esp8266/forth/examples/example-dht22-data-logger.forth index 8022093..0f031a5 100644 --- a/arch/esp8266/forth/examples/example-dht22-data-logger.forth +++ b/arch/esp8266/forth/examples/example-dht22-data-logger.forth @@ -1,39 +1,24 @@ +DHT22 load +NETCON load +TURNKEY load + exception: EGAVEUP variable: data variable: server : measure ( -- temperature humidity | throws:EGAVEUP ) 10 0 do - ['] dht-measure catch ?dup 0<> - if - ex-type cr - 5000 ms - else - unloop exit - then + ['] dht-measure catch ?dup if ex-type cr 5000 ms else unloop exit then loop EGAVEUP throw ; : data! ( temperature humidity -- ) 16 lshift swap or data ! ; -: connect ( -- ) 8005 str: "192.168.0.10" UDP netcon-connect server ! ; +: connect ( -- ) 8005 "192.168.0.10" TCP netcon-connect server ! ; : dispose ( -- ) server @ netcon-dispose ; -: send ( -- ) server @ data 4 netcon-send-buf ; - -: log ( temperature humidity -- ) - data! - connect - ['] send catch dispose throw ; +: send ( -- ) server @ data 4 netcon-write-buf ; +: log ( temperature humidity -- ) data! connect ['] send catch dispose throw ; +: log-measurement ( -- ) { measure log } catch ?dup if ex-type cr then ; +: main ( -- ) log-measurement 50 ms 120000000 deep-sleep ; -: log-measurement ( -- ) - { - measure - 2dup log 500 ms log - } - catch ?dup 0<> if - ex-type cr - then ; - -log-measurement -6000 ms -600000000 deep-sleep -6000 ms +' boot is: main +turnkey abort diff --git a/arch/esp8266/forth/examples/example-game-of-life-ws2812.forth b/arch/esp8266/forth/examples/example-game-of-life-ws2812.forth new file mode 100644 index 0000000..91e6218 --- /dev/null +++ b/arch/esp8266/forth/examples/example-game-of-life-ws2812.forth @@ -0,0 +1,132 @@ +GPIO load + +\ 8x8 pixel ws2812 led matrix game of life written in Punyforth +\ see it in action: https://youtu.be/XMPZt5o3QAc + +64 array: world +5 constant: PIN ( data pin of ws2812 ) + +16r000000 constant: DEAD +16r250025 constant: DYING +16r08040C constant: LIVE +16r000C00 constant: BORN + +: clamp ( n -- n ) 7 and ; +: north ( x y -- x' y' ) 1- clamp ; +: south ( x y -- x' y' ) 1+ clamp ; +: west ( x y -- x' y' ) swap 1- clamp swap ; +: east ( x y -- x' y' ) swap 1+ clamp swap ; +: north-east ( x y -- x' y' ) swap 1+ clamp swap 1- clamp ; +: south-east ( x y -- x' y' ) swap 1+ clamp swap 1+ clamp ; +: south-west ( x y -- x' y' ) swap 1- clamp swap 1+ clamp ; +: north-west ( x y -- x' y' ) swap 1- clamp swap 1- clamp ; + +: >i ( x y -- idx ) 3 lshift + ; +: set! ( x y state -- ) -rot >i world ! ; +: at ( x y -- n ) >i world @ ; +: live? ( x y -- bool ) at LIVE = ; +: dead? ( x y -- bool ) at DEAD = ; +: kill ( x y -- ) 2dup live? if DYING set! else 2drop then ; +: live ( x y -- ) 2dup dead? if BORN set! else 2drop then ; +: status ( x y -- 0/1 ) at dup LIVE = swap DYING = or 1 and ; + +: xyover ( x y n -- x y n x y ) >r 2dup r> -rot ; +: neighbours ( x y -- n ) + 2dup north status + xyover north-east status + + xyover east status + + xyover south-east status + + xyover south status + + xyover south-west status + + xyover west status + + -rot north-west status + ; + +: evolve ( -- ) + 8 0 do + 8 0 do + i j status i j neighbours or 3 = \ newstatus = (oldstatus | #neighbors) == 3. + if i j live else i j kill then + loop + loop ; + +: finalize ( -- ) + 64 0 do i world @ + case + DYING of DEAD i world ! endof + BORN of LIVE i world ! endof + drop + endcase + loop ; + +: paint ( color -- ) PIN ws2812rgb ; +: show ( -- ) os-enter-critical 64 0 do i world @ paint loop os-exit-critical ; +: generations ( n -- ) 0 do evolve show 100 ms finalize show 100 ms loop ; +: seed ( -- ) random clamp random clamp live ; +: randomize ( n -- ) 0 do seed loop ; +: destroy ( -- ) 64 0 do 0 i world ! loop ; +: load ( buffer -- ) 64 0 do dup i cells + @ i world ! loop drop ; + +: # LIVE , ; +: _ DEAD , ; + +create: INFINITE + _ _ _ _ _ _ _ _ + _ _ _ _ _ _ _ _ + _ _ _ _ _ _ _ _ + _ _ _ # # # _ _ + _ _ # _ _ # _ _ + _ _ # # # _ _ _ + _ _ _ _ _ _ _ _ + _ _ _ _ _ _ _ _ + +create: ACORN + _ _ _ _ _ _ _ _ + _ _ _ _ _ _ _ _ + _ _ _ _ _ _ _ _ + _ _ # _ _ _ _ _ + _ _ _ _ # _ _ _ + _ # # _ _ # # # + _ _ _ _ _ _ _ _ + _ _ _ _ _ _ _ _ + +create: GLIDER + _ _ _ _ _ _ _ _ + _ _ _ _ _ _ _ _ + _ _ _ # _ _ _ _ + _ _ _ _ # _ _ _ + _ _ # # # _ _ _ + _ _ _ _ _ _ _ _ + _ _ _ _ _ _ _ _ + _ _ _ _ _ _ _ _ + +create: CALLAHANS + _ _ _ _ _ _ _ _ + _ _ _ _ _ _ _ _ + _ # # # _ # _ _ + _ # _ _ _ _ _ _ + _ _ _ _ # # _ _ + _ _ # # _ # _ _ + _ # _ # _ # _ _ + _ _ _ _ _ _ _ _ + +PIN GPIO_OUT gpio-mode +wifi-stop ( ws2812 requires precise timing ) + +: curtain ( -- ) + destroy show + 8 0 do + 8 0 do + i j 16r1F0212 set! + loop + show 50 ms + loop + destroy show 50 ms ; + +: demo ( -- ) + curtain + INFINITE load 50 generations 100 ms + ACORN load 29 generations 100 ms + GLIDER load 30 generations 100 ms + 15 randomize 10 generations 100 ms + CALLAHANS load 13 generations 100 ms + curtain ; diff --git a/arch/esp8266/forth/examples/example-game-of-life.forth b/arch/esp8266/forth/examples/example-game-of-life.forth index cc6e8a1..f8cfd00 100644 --- a/arch/esp8266/forth/examples/example-game-of-life.forth +++ b/arch/esp8266/forth/examples/example-game-of-life.forth @@ -1,11 +1,22 @@ -: north ( x y -- x' y' ) 1- 63 and ; -: north-east ( x y -- x' y' ) swap 1+ swap 1- truncate-xy ; -: east ( x y -- x' y' ) swap 1+ 127 and swap ; -: south-east ( x y -- x' y' ) swap 1+ swap 1+ truncate-xy ; -: south ( x y -- x' y' ) 1+ 63 and ; -: south-west ( x y -- x' y' ) swap 1- swap 1+ truncate-xy ; -: west ( x y -- x' y' ) swap 1- 127 and swap ; -: north-west ( x y -- x' y' ) swap 1- swap 1- truncate-xy ; +SSD1306SPI load + +BUFFER_SIZE buffer: screen2 + +: xchg-screen ( -- ) + screen screen1 = if + screen2 actual ! + else + screen1 actual ! + then ; + +: north ( x y -- x' y' ) 1- 63 and ; +: north-east ( x y -- x' y' ) swap 1+ swap 1- ; +: east ( x y -- x' y' ) swap 1+ 127 and swap ; +: south-east ( x y -- x' y' ) swap 1+ swap 1+ ; +: south ( x y -- x' y' ) 1+ 63 and ; +: south-west ( x y -- x' y' ) swap 1- swap 1+ ; +: west ( x y -- x' y' ) swap 1- 127 and swap ; +: north-west ( x y -- x' y' ) swap 1- swap 1- ; : xyover ( x y n -- x y n x y ) >r 2dup r> -rot ; @@ -41,7 +52,7 @@ 0 do next-generation xchg-screen - show-screen-buffer + display loop ; : place-random-cell ( -- ) diff --git a/arch/esp8266/forth/examples/example-geekcreit-rctank.forth b/arch/esp8266/forth/examples/example-geekcreit-rctank.forth index f543b33..ed523f7 100644 --- a/arch/esp8266/forth/examples/example-geekcreit-rctank.forth +++ b/arch/esp8266/forth/examples/example-geekcreit-rctank.forth @@ -1,3 +1,10 @@ +GPIO load +EVENT load +NETCON load +WIFI load +TCPREPL load +PING load + \ this demo is for http://bit.ly/2bqHz58 5 constant: PIN_SPEED_1 \ D1 @@ -52,6 +59,8 @@ FALSE init-variable: lamp-active 60000 constant: fast 65535 constant: full +medium init-variable: current-speed + : speed ( n -- ) case 0 of @@ -71,7 +80,40 @@ FALSE init-variable: lamp-active : brake ( -- ) 0 speed ; -medium init-variable: current-speed +\ Distance sensor setup +13 constant: PIN_TRIGGER \ D7 +12 constant: PIN_ECHO \ D6 +100 constant: MAX_CM +20 constant: MIN_CM + +: distance ( -- cm | MAX_CM ) + { PIN_ECHO MAX_CM cm>timeout PIN_TRIGGER ping pulse>cm } + catch dup ENOPULSE = if + drop MAX_CM + else + throw + then ; + +: obstacle? ( -- bool ) distance MIN_CM < ; + +: turn ( -- ) + right direction current-speed @ speed + 50 ms ; + +: go ( -- ) + forward direction current-speed @ speed + 50 ms ; + +: auto-pilot ( -- ) + begin + begin + obstacle? + while + turn + repeat + go + again ; + 8000 constant: PORT PORT wifi-ip netcon-udp-server constant: server-socket 1 buffer: command @@ -84,40 +126,25 @@ PORT wifi-ip netcon-udp-server constant: server-socket while command c@ case - [ char: F ] literal of - forward direction current-speed @ speed - endof - [ char: B ] literal of - back direction current-speed @ speed - endof - [ char: L ] literal of - left direction current-speed @ speed - endof - [ char: R ] literal of - right direction current-speed @ speed - endof - [ char: S ] literal of - brake - endof - [ char: I ] literal of + $F of forward direction current-speed @ speed endof + $B of back direction current-speed @ speed endof + $L of left direction current-speed @ speed endof + $R of right direction current-speed @ speed endof + $I of current-speed @ 10 + full min current-speed ! current-speed @ speed endof - [ char: D ] literal of + $D of current-speed @ 10 - 0 max current-speed ! current-speed @ speed - endof - [ char: E ] literal of - engine-start - endof - [ char: H ] literal of - engine-stop - endof - [ char: T ] literal of - lamp-toggle endof + $S of brake endof + $E of engine-start endof + $H of engine-stop endof + $T of lamp-toggle endof + $A of auto-pilot endof endcase repeat deactivate ; @@ -131,4 +158,4 @@ PORT wifi-ip netcon-udp-server constant: server-socket tank-task command-loop ; repl-start -tank-server-start \ No newline at end of file +tank-server-start diff --git a/arch/esp8266/forth/examples/example-geekcreit-rctank.py b/arch/esp8266/forth/examples/example-geekcreit-rctank.py index bcb95a1..c6c1fc3 100644 --- a/arch/esp8266/forth/examples/example-geekcreit-rctank.py +++ b/arch/esp8266/forth/examples/example-geekcreit-rctank.py @@ -24,6 +24,7 @@ def move(self, direction): def speedup(self): self._command(b'I') def slowdown(self): self._command(b'D') def toggle_lamp(self): self._command(b'T') + def auto_pilot(self): self._command(b'A') def toggle_engine(self): self._command(b'H' if self.engine_started else b'E') @@ -56,10 +57,22 @@ def control(self, robot): robot.speedup() elif self._button_down('speed-'): robot.slowdown() + elif self._button_down('auto-pilot'): + robot.auto_pilot() def _button_down(self, name): return self.joystick.get_button(self.button_config[name]) == 1 if __name__ == '__main__': - gamepad = Gamepad(joystick=0, horizontal_axis=0, vertical_axis=1, button_config={'engine': 0, 'speed+': 5, 'speed-': 7, 'lamp' : 4}) + gamepad = Gamepad( + joystick=0, + horizontal_axis=0, + vertical_axis=1, + button_config={ + 'engine': 0, + 'speed+': 5, + 'speed-': 7, + 'lamp' : 4, + 'auto-pilot' : 3 + }) gamepad.control(Tank(('192.168.0.22', 8000))) diff --git a/arch/esp8266/forth/examples/example-http-server.forth b/arch/esp8266/forth/examples/example-http-server.forth index e06fbef..d3983cc 100644 --- a/arch/esp8266/forth/examples/example-http-server.forth +++ b/arch/esp8266/forth/examples/example-http-server.forth @@ -1,3 +1,7 @@ +NETCON load +WIFI load +MAILBOX load + \ server listens on this port 80 constant: PORT wifi-ip constant: HOST @@ -31,7 +35,7 @@ WorkerSpace task: worker-task2 deactivate ; \ index page as a mult line string -str: " +" HTTP/1.0 200\r\n Content-Type: text/html\r\n Connection: close\r\n @@ -45,7 +49,7 @@ Connection: close\r\n : serve-client ( -- ) client @ 128 line netcon-readln print: 'received: ' line type print: ' len=' . cr - line str: "GET /" str-starts? if + line "GET /" str-starts? if client @ HTML netcon-write then ; @@ -70,3 +74,4 @@ Connection: close\r\n worker-task2 worker ; start-http-server + diff --git a/arch/esp8266/forth/examples/example-ircbot.forth b/arch/esp8266/forth/examples/example-ircbot.forth index 78060e0..457f6e4 100644 --- a/arch/esp8266/forth/examples/example-ircbot.forth +++ b/arch/esp8266/forth/examples/example-ircbot.forth @@ -1,3 +1,6 @@ +NETCON load +GPIO load + 2 constant: LED 512 constant: buffer-size buffer-size buffer: line-buffer @@ -6,18 +9,18 @@ buffer-size buffer: line-buffer exception: EIRC : connect ( -- ) - 6667 str: "irc.freenode.net" TCP netcon-connect irc-con ! ; + 6667 "irc.freenode.net" TCP netcon-connect irc-con ! ; : send ( str -- ) irc-con @ swap netcon-writeln ; : register ( -- ) - str: "NICK hodor179" send - str: "USER hodor179 hodor179 bla :hodor179" send ; + "NICK hodor179" send + "USER hodor179 hodor179 bla :hodor179" send ; -: join ( -- ) str: "JOIN #somechan" send ; -: greet ( -- ) str: "PRIVMSG #somechan :Hooodoor!" send ; -: quit ( -- ) str: "QUIT :hodor" send ; +: join ( -- ) "JOIN #somechan" send ; +: greet ( -- ) "PRIVMSG #somechan :Hooodoor!" send ; +: quit ( -- ) "QUIT :hodor" send ; : readln ( -- str ) irc-con @ buffer-size line-buffer netcon-readln -1 = if @@ -27,13 +30,13 @@ exception: EIRC : processline ( str -- ) dup type cr - dup str: "PING" str-starts? if - str: "PONG" send + dup "PING" str-starts? if + "PONG" send random 200 % 0= if greet then then - dup str: "PRIVMSG" str-in? if + dup "PRIVMSG" str-in? if LED blink then drop ; diff --git a/arch/esp8266/forth/examples/example-philips-hue.forth b/arch/esp8266/forth/examples/example-philips-hue.forth index 98585ef..cd1bf5a 100644 --- a/arch/esp8266/forth/examples/example-philips-hue.forth +++ b/arch/esp8266/forth/examples/example-philips-hue.forth @@ -1,11 +1,13 @@ +NETCON load + \ HUE Bridge local IP and port -str: "192.168.0.12" constant: BRIDGE_IP +"192.168.0.12" constant: BRIDGE_IP 80 constant: BRIDGE_PORT \ Base URL containing the HUE API key -str: "/api//lights/" constant: BASE_URL +"/api//lights/" constant: BASE_URL \ Light bulb ids for each room -str: "1" constant: HALL -str: "2" constant: BEDROOM +"1" constant: HALL +"2" constant: BEDROOM 1024 constant: buffer-len buffer-len buffer: buffer @@ -20,7 +22,7 @@ exception: EHTTP : read-http-code ( netconn -- http-code | throws:EHTTP ) buffer-len buffer netcon-readln 0 <= if EHTTP throw then - buffer str: "HTTP/" str-starts? if + buffer "HTTP/" str-starts? if buffer parse-http-code else EHTTP throw @@ -57,35 +59,35 @@ exception: EHTTP : on? ( bulb -- bool ) bridge - dup str: "GET " netcon-write + dup "GET " netcon-write dup BASE_URL netcon-write dup rot netcon-write - dup str: "\r\n\r\n" netcon-write + dup "\r\n\r\n" netcon-write consume&dispose - buffer str: '"on":true' str-in? ; + buffer "\"on\":true" str-in? ; : request-change-state ( bulb netconn -- ) - dup str: "PUT " netcon-write + dup "PUT " netcon-write dup BASE_URL netcon-write dup rot netcon-write - dup str: "/state HTTP/1.1\r\n" netcon-write - dup str: "Content-Type: application/json\r\n" netcon-write - dup str: "Accept: */*\r\n" netcon-write - dup str: "Connection: Close\r\n" netcon-write + dup "/state HTTP/1.1\r\n" netcon-write + dup "Content-Type: application/json\r\n" netcon-write + dup "Accept: */*\r\n" netcon-write + dup "Connection: Close\r\n" netcon-write drop ; : on ( bulb -- ) bridge tuck request-change-state - dup str: "Content-length: 22\r\n\r\n" netcon-write - dup str: '{"on":true,"bri": 255}\r\n' netcon-write + dup "Content-length: 22\r\n\r\n" netcon-write + dup "{\"on\":true,\"bri\": 255}\r\n" netcon-write netcon-dispose ; : off ( bulb -- ) bridge tuck request-change-state - dup str: "Content-length: 12\r\n\r\n" netcon-write - dup str: '{"on":false}\r\n' netcon-write + dup "Content-length: 12\r\n\r\n" netcon-write + dup "{\"on\":false}\r\n" netcon-write netcon-dispose ; : toggle ( bulb -- ) @@ -97,4 +99,4 @@ exception: EHTTP { if off else on then } catch ?dup if print: 'Error toggling light. ' ex-type cr 2drop - then ; \ No newline at end of file + then ; diff --git a/arch/esp8266/forth/examples/example-pir.forth b/arch/esp8266/forth/examples/example-pir.forth new file mode 100644 index 0000000..3f0c3af --- /dev/null +++ b/arch/esp8266/forth/examples/example-pir.forth @@ -0,0 +1,38 @@ +NETCON load +EVENT load +GPIO load + +\ Detects motion using a PIR sensor and notifies a server via TCP +\ I tested this with these mini IR PIR sensors +\ http://www.banggood.com/3Pcs-Mini-IR-Infrared-Pyroelectric-PIR-Body-Motion-Human-Sensor-Detector-Module-p-1020422.html + +4 ( D2 leg ) constant: PIN +Event buffer: event +defer: listener +variable: last-time + +: pir? ( evt -- bool ) { .type @ EVT_GPIO = } { .payload @ PIN = } bi and ; +: recent? ( evt -- bool ) ms@ swap .ms @ - 800 < ; +: time-since-last ( -- ms ) ms@ last-time @ - ; +: handle? ( -- bool ) event pir? event recent? time-since-last 5000 > and and ; + +: start-detector ( -- ) + PIN GPIO_IN gpio-mode + PIN GPIO_INTTYPE_EDGE_POS gpio-set-interrupt + begin + event next-event handle? if + ms@ last-time ! + ['] listener catch ?dup if ex-type cr then + then + again ; + +"K" constant: ID +variable: server + +: connect ( -- ) 8030 "192.168.0.10" TCP netcon-connect server ! ; +: dispose ( -- ) server @ netcon-dispose ; +: send ( -- ) server @ ID 1 netcon-write-buf ; +: notify-server ( -- ) connect ['] send catch dispose throw ; + +' listener is: notify-server +start-detector diff --git a/arch/esp8266/forth/examples/example-stock-price.forth b/arch/esp8266/forth/examples/example-stock-price.forth new file mode 100644 index 0000000..ca1ce59 --- /dev/null +++ b/arch/esp8266/forth/examples/example-stock-price.forth @@ -0,0 +1,154 @@ +NETCON load +SSD1306SPI load +FONT57 load +WIFI load + +\ stock price display with servo control +\ see it in action: https://youtu.be/4ad7dZmnoH8 + +1024 constant: buffer-len +buffer-len buffer: buffer +variable: price +variable: change +variable: open + +4 constant: SERVO \ d2 +SERVO GPIO_OUT gpio-mode + +\ servo control +: short 19250 750 ; immediate +: medium 18350 1650 ; immediate +: long 17200 2800 ; immediate +: pulse ( off-cycle-us on-cycle-us -- ) immediate + ['], SERVO , ['], GPIO_HIGH , ['] gpio-write , + ['], ( on cycle ) , ['] us , + ['], SERVO , ['], GPIO_LOW , ['] gpio-write , + ['], ( off cycle ) , ['] us , ; + +: down ( -- ) 30 0 do short pulse loop ; +: midway ( -- ) 30 0 do medium pulse loop ; +: up ( -- ) 30 0 do long pulse loop ; + +: parse-code ( buffer -- code | throws:ECONVERT ) + 9 + 3 >number invert if + ECONVERT throw + then ; + +exception: EHTTP + +: read-code ( netconn -- http-code | throws:EHTTP ) + buffer-len buffer netcon-readln + 0 <= if EHTTP throw then + buffer "HTTP/" str-starts? if + buffer parse-code + else + EHTTP throw + then ; + +: skip-headers ( netconn -- netconn ) + begin + dup buffer-len buffer netcon-readln -1 <> + while + buffer strlen 0= if exit then + repeat + EHTTP throw ; + +: read-resp ( netconn -- response-code ) + dup read-code + swap skip-headers + buffer-len buffer netcon-readln + print: 'len=' . cr ; + +: log ( response-code -- response-code ) dup print: 'HTTP:' . space buffer type cr ; +: consume ( netcon -- ) + dup read-resp log + swap netcon-dispose + 200 <> if EHTTP throw then ; + +: connect ( -- netconn ) 8319 "zeroflag.dynu.net" TCP netcon-connect ; +: stock-fetch ( -- ) + connect + dup "GET /stock/CLDR HTTP/1.0\r\n\r\n" netcon-write + consume ; + +exception: ESTOCK + +variable: idx +: reset ( -- ) 0 idx ! ; +: pos ( -- addr ) buffer idx @ + ; +: peek ( -- chr ) pos c@ ; +: next ( -- chr ) 1 idx +! idx @ buffer-len >= if ESTOCK throw then ; +: take ( chr -- ) begin dup peek <> while next repeat drop ; +: 0! ( -- ) 0 pos c! ; +: parse ( -- ) + reset buffer price ! + $, take 0! + next pos change ! + $, take 0! + next pos open ! + 10 take 0! ; + +: trend ( str -- ) + c@ case + $+ of up endof + $- of down endof + drop midway + endcase ; + +: open? ( -- bool ) open @ "1" =str ; + +: center ( str -- ) DISPLAY_WIDTH swap str-width - 2 / font-size @ / text-left ! ; +: spacer ( -- ) draw-lf draw-cr 2 text-top +! ; +: stock-draw ( -- ) + stock-fetch parse + price @ center price @ draw-str + spacer + change @ center change @ draw-str + change @ trend ; + +: error-draw ( exception -- ) + display-clear + 0 text-left ! 0 text-top ! + "Err: " draw-str + case + ENETCON of "NET" draw-str endof + EHTTP of "HTTP" draw-str endof + ESTOCK of "API" draw-str endof + "Other" draw-str + ex-type + endcase + display ; + +: show ( -- ) + display-clear + 3 text-top ! + 0 text-left ! + stock-draw + display ; + +0 task: stock-task +0 init-variable: last-refresh + +: expired? ( -- bool ) ms@ last-refresh @ - 60 1000 * > ; + +: stock-start ( task -- ) + activate + begin + last-refresh @ 0= expired? or if + ms@ last-refresh ! + { show } catch ?dup if error-draw then + then + pause + again ; + +: main ( -- ) + stack-show + font-medium + font5x7 font ! + display-init + multi + stock-task stock-start ; + +\ ' boot is: main +\ turnkey +main diff --git a/arch/esp8266/forth/flash.forth b/arch/esp8266/forth/flash.forth index 3c42dc2..c951c05 100644 --- a/arch/esp8266/forth/flash.forth +++ b/arch/esp8266/forth/flash.forth @@ -1,8 +1,62 @@ -0 constant: FLASH_OK -1 constant: FLASH_ERR -2 constant: FLASH_TIMEOUT -3 constant: FLASH_UNKNOWN - -\ example reading flash -\ 128 array: buffer -\ 128 0 buffer 512000 read-flash +exception: EBLOCK +4096 constant: SIZE +FALSE init-variable: dirty +SIZE buffer: buf +variable: offs + +: check ( code -- | 0=OK,1=ERR,2=TIMEOUT,3=UNKNOWN ) ?dup if print: 'FLASH ERR: ' . cr EBLOCK throw then ; +: flush ( -- ) + dirty @ if + offs @ 12 rshift ( >sector ) erase-flash check + SIZE buf offs @ write-flash check + FALSE dirty ! + then ; + +: block ( block# -- addr ) + flush 12 lshift ( SIZE * ) offs ! + SIZE buf offs @ read-flash check buf ; + +( screen editor requires to flash with --block-format yes ) + +128 constant: COLS +32 constant: ROWS + +: row ( y -- addr ) COLS * buf + ; +: ch ( y x -- addr ) swap row + ; +: type# ( y -- ) dup 10 < if space then . space ; + +: list ( block# -- ) + block drop + ROWS 0 do + i type# + i row COLS type-counted + loop ; + +\ editor command: blank row +: b ( y -- ) + COLS 2 - 0 do 32 over i ch c! loop + 13 over COLS 2 - ch c! + 10 swap COLS 1- ch c! + TRUE dirty ! ; + +: copy-row ( dst-y src-y -- ) COLS 0 do 2dup i ch c@ swap i ch c! loop 2drop ; + +\ editor command: delete row +: d ( y -- ) + ROWS 1- swap do i i 1+ copy-row loop + ROWS 1- b ; + +\ editor command: clear screen +: c ( -- ) ROWS 0 do i b loop ; + +\ editor command: overwrite row +: r: ( y "line" -- ) + dup b row + begin key dup crlf? invert while over c! 1+ repeat + 2drop ; + +\ editor command: prepends empty row before the given y +: p ( y -- ) dup ROWS 1- do i i 1- copy-row -1 +loop b ; + +/end + diff --git a/arch/esp8266/forth/font5x7.forth b/arch/esp8266/forth/font5x7.forth new file mode 100644 index 0000000..dd15a1f --- /dev/null +++ b/arch/esp8266/forth/font5x7.forth @@ -0,0 +1,43 @@ +create: font5x7 +0 , 1331379712 , 1799241307 , 473852751 , 473857086 , 1014905880 , 2102860824 , 1578900567 , +1859199 , 1588248 , 3888375807 , 605552895 , 3892248600 , 822077403 , 235289160 , 695806246 , +92225574 , 2134902533 , 1514087685 , 1513940796 , 471613055 , 471599112 , 571768638 , 1595155071 , +1600061535 , 25102598 , 2305163391 , 1616931477 , 2489344096 , 2493710242 , 75367432 , 2116030472 , +134746144 , 134749226 , 134752796 , 269488158 , 203295760 , 942672926 , 103823422 , 101596686 , +0 , 1593835520 , 117440512 , 335546112 , 343872639 , 712976932 , 135471890 , 1228300900 , +5251158 , 198408 , 1092754432 , 574685184 , 472514588 , 136977535 , 134757896 , 812679168 , +134744064 , 2056 , 536895584 , 33818640 , 1162432830 , 2135031870 , 1232207936 , 558254409 , +860703041 , 2131891224 , 1162159888 , 1245460805 , 1093749065 , 118034721 , 1229539638 , 1229538870 , +7721 , 20 , 13376 , 571738112 , 336860225 , 1090524180 , 34083874 , 101275905 , +1499283774 , 286424142 , 1233091602 , 1043745097 , 574701889 , 1094795647 , 1229553470 , 159334729 , +1040255241 , 1934704961 , 134744191 , 2134966399 , 1075839041 , 2130788161 , 1092752392 , 1077952639 , +469925696 , 75464450 , 1048514568 , 1044463937 , 151587199 , 1363230214 , 159342113 , 642132249 , +843663689 , 25100547 , 1077952259 , 538918720 , 1059004480 , 1061173312 , 336073827 , 2013528931 , +1499529988 , 4410697 , 1094795647 , 268960770 , 1094778912 , 33849153 , 1074004481 , 1077952576 , +134677248 , 1414799360 , 679428216 , 943211588 , 675562564 , 675562552 , 1414805631 , 134223956 , +402786686 , 2023531684 , 67373183 , 2101608568 , 1075839040 , 2130722112 , 4466704 , 1082081536 , +2013559808 , 142374916 , 947389444 , 943998020 , 606345468 , 606345240 , 142408728 , 1208484868 , +609506388 , 1144980484 , 1077951524 , 538737696 , 1008476224 , 1010839616 , 672147524 , 2425375812 , +1682209936 , 4475988 , 4273672 , 7798784 , 910229504 , 16908296 , 1006765058 , 1009132326 , +1637982494 , 1077950994 , 1412987424 , 559502676 , 1098470741 , 2018792482 , 1414865218 , 1411399800 , +205551957 , 309482014 , 1431655737 , 1414805849 , 1429821780 , 5788756 , 1098663168 , 2101674496 , +1157693506 , 310198396 , 4034728465 , 4029162792 , 1163220092 , 1414799360 , 175920252 , 843677449 , +843663689 , 1145324602 , 1212822074 , 1094332488 , 981082433 , 2015379522 , 2694880512 , 1111637373 , +1077755202 , 1010647104 , 606404388 , 1128889928 , 4230949734 , 167717679 , 3223385641 , 50953864 , +2035569696 , 1140850753 , 1211122045 , 942819912 , 2049065024 , 168458752 , 420314482 , 690388273 , +640167721 , 640231721 , 1078806576 , 134756384 , 134744072 , 792201224 , 3131885584 , 875040815 , +2063597818 , 336068608 , 572658730 , 135539220 , 5570645 , 2857740885 , 1442818645 , 16733695 , +16711680 , 4279242768 , 336860160 , 269484287 , 285147391 , 4027641872 , 4229174292 , 4145288192 , +65280 , 352256255 , 4228183060 , 269947924 , 521146399 , 336862992 , 268443412 , 15732752 , +520093696 , 269488144 , 269488159 , 1110032 , 285147136 , 269488144 , 269488144 , 4351 , +1376000 , 4278255360 , 270467072 , 4227858455 , 336917508 , 337055767 , 4093965332 , 16711680 , +336860407 , 336860180 , 351731959 , 337056788 , 270471184 , 336860191 , 269489396 , 15732976 , +521150208 , 520093696 , 20 , 5372 , 284168432 , 4279303952 , 4279505940 , 269488148 , +31 , 4279300096 , 4294967295 , 4042322160 , 4294967280 , 0 , 268435200 , 252645135 , +943998008 , 1246428228 , 41825354 , 33949186 , 41812606 , 1095325027 , 1145321571 , 2118124604 , +102768160 , 33717762 , 2783421849 , 1227496601 , 1917590570 , 810316289 , 810372426 , 1215842352 , +1516420144 , 1228815686 , 2113947977 , 2113995009 , 707406378 , 1598309418 , 1363166276 , 1077953610 , +1079069252 , 33488896 , 4286636035 , 134742016 , 906521451 , 908342802 , 252251910 , 402653190 , +24 , 805310480 , 16908096 , 16850688 , 488177694 , 1006637591 , 3947580 , 0 , +/end + diff --git a/arch/esp8266/forth/gpio.forth b/arch/esp8266/forth/gpio.forth index ca5e32d..8dc12eb 100644 --- a/arch/esp8266/forth/gpio.forth +++ b/arch/esp8266/forth/gpio.forth @@ -33,4 +33,6 @@ exception: ENOPULSE \ Measures a pulse duration (either HIGH or LOW) on a pin. : pulse-len ( timeout-us gpio-state gpio-pin -- us | throws:ENOPULSE ) pulse-in ?dup 0= if ENOPULSE throw then ; - \ No newline at end of file + +/end + diff --git a/arch/esp8266/forth/mailbox.forth b/arch/esp8266/forth/mailbox.forth new file mode 100644 index 0000000..5112bab --- /dev/null +++ b/arch/esp8266/forth/mailbox.forth @@ -0,0 +1,22 @@ +RINGBUF load + +: mailbox: ( size ) ( -- mailbox ) ringbuf: ; + +: mailbox-send ( message mailbox -- ) + begin + dup ringbuf-full? + while + pause + repeat + ringbuf-enqueue ; + +: mailbox-receive ( mailbox -- message ) + begin + dup ringbuf-empty? + while + pause + repeat + ringbuf-dequeue ; + +/end + diff --git a/arch/esp8266/forth/netcon-test.forth b/arch/esp8266/forth/netcon-test.forth index 7ede45a..71d1222 100644 --- a/arch/esp8266/forth/netcon-test.forth +++ b/arch/esp8266/forth/netcon-test.forth @@ -46,7 +46,7 @@ WorkerSpace task: echo-worker-task2 echo-worker-task1 echo-worker echo-worker-task2 echo-worker ; -str: "Hahooo" constant: request +"Hahooo" constant: request 128 buffer: response : test:netcon-echo \ TODO netcon-connect is blocking -> cant connect to itself diff --git a/arch/esp8266/forth/netcon.forth b/arch/esp8266/forth/netcon.forth index e8b20af..474174f 100644 --- a/arch/esp8266/forth/netcon.forth +++ b/arch/esp8266/forth/netcon.forth @@ -1,49 +1,28 @@ +TASKS load + 1 constant: UDP 2 constant: TCP -70 constant: RECV_TIMEOUT_MSEC -exception: ENETCON + +\ internal timeout, used for yielding control to other tasks in read loop +70 constant: RECV_TIMEOUT_MSEC + +exception: ENETCON ( indicates general netcon error ) +exception: ERTIMEOUT ( indicates read timeout ) \ netcon errors. see: esp-open-rtos/lwip/lwip/src/include/lwip/err.h - -1 constant: NC_ERR_MEM \ Out of memory error. - -2 constant: NC_ERR_BUF \ Buffer error. - -3 constant: NC_ERR_TIMEOUT \ Timeout. - -4 constant: NC_ERR_RTE \ Routing problem. - -5 constant: NC_ERR_INPROGRESS \ Operation in progress - -6 constant: NC_ERR_VAL \ Illegal value. - -7 constant: NC_ERR_WOULDBLOCK \ Operation would block. - -8 constant: NC_ERR_USE \ Address in use. - -9 constant: NC_ERR_ISCONN \ Already connected. --10 constant: NC_ERR_ABRT \ Connection aborted. --11 constant: NC_ERR_RST \ Connection reset. --12 constant: NC_ERR_CLSD \ Connection closed. --13 constant: NC_ERR_CONN \ Not connected. --14 constant: NC_ERR_ARG \ Illegal argument. --15 constant: NC_ERR_IF \ Low-level netif error. + -3 constant: NC_ERR_TIMEOUT \ Timeout. + -15 constant: NC_ERR_CLSD \ Connection closed. : netcon-new ( type -- netcon | throws:ENETCON ) override - netcon-new - dup 0= if ENETCON throw then + netcon-new dup 0= if ENETCON throw then RECV_TIMEOUT_MSEC over netcon-set-recvtimeout ; -: check-error ( errcode -- | throws:ENETCON ) - ?dup if - print: "NETCON error: " . cr - ENETCON throw - then ; +: check ( errcode -- | throws:ENETCON ) ?dup if print: "NETCON error: " . cr ENETCON throw then ; \ Connect to a remote port/ip. Must be used in both TCP and UDP case. -: netcon-connect ( port host type -- netcon | throws:ENETCON ) override - netcon-new dup - >r - netcon-connect - check-error - r> ; - -: netcon-bind ( port host netcon -- | throws:ENETCON ) override - netcon-bind check-error ; - -: netcon-listen ( netcon -- | throws:ENETCON ) override - netcon-listen check-error ; +: netcon-connect ( port host type -- netcon | throws:ENETCON ) override netcon-new dup >r netcon-connect check r> ; +: netcon-bind ( port host netcon -- | throws:ENETCON ) override netcon-bind check ; +: netcon-listen ( netcon -- | throws:ENETCON ) override netcon-listen check ; \ Create a TCP server by binding a connection to the given port host. \ Leaves a netcon connection associated to the server socket on the stack. @@ -54,8 +33,7 @@ exception: ENETCON \ Create a UDP server by binding a connection to the given port host. \ Leaves a netcon connection associated to the server socket on the stack. -: netcon-udp-server ( port host -- netcon | throws:ENETCON ) - UDP netcon-new ['] netcon-bind keep ; +: netcon-udp-server ( port host -- netcon | throws:ENETCON ) UDP netcon-new ['] netcon-bind keep ; \ Accept an incoming connection on a listening TCP connection. \ Leaves a new netcon connection that is associated to the client socket on the stack. @@ -63,7 +41,7 @@ exception: ENETCON begin pause dup netcon-accept dup NC_ERR_TIMEOUT <> if - check-error nip + check nip RECV_TIMEOUT_MSEC over netcon-set-recvtimeout exit then @@ -71,49 +49,42 @@ exception: ENETCON again ; \ Write the content of the given buffer to a UDP socket. -: netcon-send-buf ( netcon buffer len -- | throws:ENETCON ) - swap rot netcon-send - check-error ; - +: netcon-send-buf ( netcon buffer len -- | throws:ENETCON ) swap rot netcon-send check ; \ Write the content of the given buffer to a TCP socket. -: netcon-write-buf ( netcon buffer len -- | throws:ENETCON ) - swap rot netcon-write - check-error ; - +: netcon-write-buf ( netcon buffer len -- | throws:ENETCON ) swap rot netcon-write check ; \ Write a null terminated string to a TCP socket. -: netcon-write ( netcon str -- | throws:ENETCON ) override - dup strlen netcon-write-buf ; - +: netcon-write ( netcon str -- | throws:ENETCON ) override dup strlen netcon-write-buf ; \ Write a null terminated string then a CRLF to a TCP socket. -: netcon-writeln ( netcon str -- | throws:ENETCON ) - over - swap netcon-write - str: "\r\n" netcon-write ; +: netcon-writeln ( netcon str -- | throws:ENETCON ) over swap netcon-write "\r\n" netcon-write ; -: read-ungreedy ( size buffer netcon -- count code ) +: read-ungreedy ( size buffer netcon -- count code | throws:ERTIMEOUT ) + ms@ >r begin 3dup netcon-recvinto dup NC_ERR_TIMEOUT <> if rot drop rot drop rot drop + r> drop ( start time ) exit else pause then - 2drop + 2drop ( count code ) + dup netcon-read-timeout@ 0> if + ms@ r@ - over netcon-read-timeout@ 1000 * > if + ERTIMEOUT throw + then + then again ; \ Read maximum `size` amount of bytes into the buffer. \ Leaves the amount of bytes read on the top of the stack, or -1 if the connection was closed. -: netcon-read ( netcon size buffer -- count | -1 | throws:ENETCON ) - rot - read-ungreedy - dup NC_ERR_CLSD = if 2drop -1 exit then - check-error ; +: netcon-read ( netcon size buffer -- count | -1 | throws:ENETCON/ERTIMEOUT ) + rot read-ungreedy dup NC_ERR_CLSD = if 2drop -1 exit then check ; \ Read one line into the given buffer. The line terminator is CRLF. \ Leaves the length of the line on the top of the stack, or -1 if the connection was closed. \ If the given buffer is not large enough to hold EOVERFLOW is thrown. -: netcon-readln ( netcon size buffer -- count | -1 | throws:ENETCON/EOVERFLOW ) +: netcon-readln ( netcon size buffer -- count | -1 | throws:ENETCON/EOVERFLOW/ERTIMEOUT ) swap 0 do 2dup 1 swap i + netcon-read -1 = if @@ -133,7 +104,7 @@ exception: ENETCON EOVERFLOW throw ; \ Close then dispose the given socket. -: netcon-dispose ( netcon -- ) - dup - netcon-close - netcon-delete ; +: netcon-dispose ( netcon -- ) dup netcon-close netcon-delete ; + +/end + diff --git a/arch/esp8266/forth/ntp.forth b/arch/esp8266/forth/ntp.forth new file mode 100644 index 0000000..3db54de --- /dev/null +++ b/arch/esp8266/forth/ntp.forth @@ -0,0 +1,39 @@ +NETCON load + +\ Network Time Protocol implementation, originally based on the work of Craig A. Lindley +\ Usage example: +\ 123 "time.nist.gov" network-time + +exception: ENTP +variable: con +48 constant: SIZE +SIZE byte-array: packet + +: request ( -- buffer ) + SIZE 0 do 0 i packet c! loop + 16rE3 0 packet c! \ LI, Version, Mode + 16r06 2 packet c! \ Polling interval + 16rEC 3 packet c! \ Peer clock precision + 16r31 12 packet c! + 16r4E 13 packet c! + 16r31 14 packet c! + 16r34 15 packet c! + 0 packet ; + +: connect ( port host -- ) UDP netcon-connect con ! ; +: send ( -- ) con @ request SIZE netcon-send-buf ; +: receive ( -- #bytes ) con @ SIZE 0 packet netcon-read ; +: dispose ( -- ) con @ netcon-dispose ; +: ask ( port host -- #bytes ) connect { send receive } catch dispose throw ; + +: parse ( -- ) + 40 packet c@ 24 lshift + 41 packet c@ 16 lshift or + 42 packet c@ 8 lshift or + 43 packet c@ or + 2208988800 - ; + +: network-time ( port host -- seconds-since-1970 | throws:ENTP ) ask SIZE = if parse else ENTP throw then ; + +/end + diff --git a/arch/esp8266/forth/ping.forth b/arch/esp8266/forth/ping.forth index 3166f9c..ba0d097 100644 --- a/arch/esp8266/forth/ping.forth +++ b/arch/esp8266/forth/ping.forth @@ -1,3 +1,5 @@ +GPIO load + : emit-pulse ( trigger-pin -- ) dup GPIO_OUT gpio-mode dup GPIO_LOW gpio-write @@ -16,14 +18,16 @@ \ (2) The Module automatically sends eight 40 kHz and detect whether there is a pulse signal back. \ (3) IF the signal back, time of high output IO duration is the time from sending ultrasonic to returning. \ Distance = (high level time×velocity of sound (340M/S) / 2, -\ Usage example: PIN_ECHO 100 timeout>cm PIN_TRIGGER ping range>cm +\ Usage example: PIN_ECHO 100 cm>timeout PIN_TRIGGER ping pulse>cm : ping ( echo-pin timeout-us trigger-pin -- pulse-duration-us ) os-enter-critical { emit-pulse listen-echo } catch os-exit-critical throw ; -: timeout>cm ( us -- cm ) 60 * ; -: timeout>inch ( us -- cm ) 150 * ; -: range>cm ( us -- cm ) 58 / ; -: range>inch ( us -- inch ) 148 / ; \ No newline at end of file +: cm>timeout ( cm -- us ) 60 * ; +: inch>timeout ( inch -- us ) 150 * ; +: pulse>cm ( us -- cm ) 58 / ; +: pulse>inch ( us -- inch ) 148 / ; + +/end diff --git a/arch/esp8266/forth/sonoff.forth b/arch/esp8266/forth/sonoff.forth new file mode 100644 index 0000000..d0e5ebc --- /dev/null +++ b/arch/esp8266/forth/sonoff.forth @@ -0,0 +1,34 @@ +GPIO load + +\ module for sonoff smart socket + +12 constant: RELAY +RELAY GPIO_OUT gpio-mode +FALSE init-variable: relay-state + +: on? ( -- bool ) relay-state @ ; + +: on ( -- ) + on? if exit then + TRUE relay-state ! + RELAY GPIO_HIGH gpio-write ; + +: off ( -- ) + on? if + FALSE relay-state ! + RELAY GPIO_LOW gpio-write + then ; + +: toggle ( -- ) on? if off else on then ; + +13 constant: LED +LED GPIO_OUT gpio-mode + +: led-on ( -- ) LED GPIO_LOW gpio-write ; +: led-off ( -- ) LED GPIO_HIGH gpio-write ; + +: flash ( n -- ) LED swap times-blink led-off ; +: alert ( -- ) 10 flash ; + +/end + diff --git a/arch/esp8266/forth/ssd1306-i2c.forth b/arch/esp8266/forth/ssd1306-i2c.forth new file mode 100644 index 0000000..99090a6 --- /dev/null +++ b/arch/esp8266/forth/ssd1306-i2c.forth @@ -0,0 +1,175 @@ +GPIO load + +\ ssd1306 I2C display driver for OLED displays +\ Tested with 64x48 wemos oled shield and 128x32 integrated display of wifi kit 8 +\ Usage: +\ display-init +\ font5x7 font ! +\ 10 text-top ! 8 text-left ! +\ "Hello" draw-str +\ display +\ display-clear + +\ change width/height +64 constant: WIDTH +48 constant: HEIGHT +\ 128 constant: WIDTH +\ 32 constant: HEIGHT + +5 ( D1 SCL ) constant: SCL +4 ( D2 SDA ) constant: SDA +0 ( D3 RST ) constant: RST +16r3C constant: SLAVE +0 constant: BUS +2 ( 400K ) constant: FREQ + +WIDTH HEIGHT * 8 / constant: SIZE +SIZE 1+ buffer: screen1 +16r40 ( control byte ) screen1 ! +: screen ( -- buffer ) screen1 1+ ; + +exception: EI2C + +: wire ( -- ) + SCL GPIO_OUT gpio-mode + SDA GPIO_OUT gpio-mode + RST GPIO_LOW gpio-write ; + +: check ( code -- | throws:EI2C ) 0<> if EI2C throw then ; + +create: buf 16r80 c, 0 c, +: cmd ( byte -- | throws:EI2C ) buf 1+ c! 2 buf 0 ( data ) SLAVE BUS i2c-write-slave check ; + +: reset ( -- ) + RST GPIO_HIGH gpio-write 1 ms + RST GPIO_LOW gpio-write 10 ms + RST GPIO_HIGH gpio-write ; + +\ https://github.com/micropython/micropython/blob/master/drivers/display/ssd1306.py +: init ( -- ) + 16rAE ( SSD1306_DISPLAYOFF ) cmd + 16rD5 ( SSD1306_SETDISPLAYCLOCKDIV ) cmd + 16r80 cmd + 16rA8 ( SSD1306_SETMULTIPLEX ) cmd + HEIGHT 1- cmd + 16rD3 ( SSD1306_SETDISPLAYOFFSET ) cmd + 16r00 cmd + 16r40 ( SSD1306_SETSTARTLINE ) cmd + 16r8D ( SSD1306_CHARGEPUMP ) cmd + 16r14 cmd + 16r20 ( SSD1306_MEMORYMODE ) cmd + 16r00 cmd + 16rA1 ( SSD1306_SEGREMAP ) cmd + 16rC8 ( SSD1306_COMSCANDEC ) cmd + 16rDA ( SSD1306_SETCOMPINS ) cmd + HEIGHT 32 = if 16r02 else 16r12 then cmd + 16r81 ( SSD1306_SETCONTRAST ) cmd + 16rCF cmd + 16rD9 ( SSD1306_SETPRECHARGE ) cmd + 16rF1 cmd + 16rDB ( SSD1306_SETVCOMDETECT ) cmd + 16r40 cmd + 16rA4 ( SSD1306_DISPLAYALLON_RESUME ) cmd + 16rA6 ( SSD1306_NORMALDISPLAY ) cmd + 16rAF ( SSD1306_DISPLAYON ) cmd ; + +\ precompile some words for speed +: width*, immediate + WIDTH case + 128 of ['], 7 , ['] lshift , endof + 64 of ['], 6 , ['] lshift , endof + ['], , ['] * , + endcase ; + +: clampx, immediate + WIDTH case + 128 of ['], 127 , ['] and , endof + 64 of ['], 63 , ['] and , endof + ['], , ['] % , + endcase ; + +: clampy, immediate + HEIGHT case + 64 of ['], 63 , ['] and , endof + 32 of ['], 31 , ['] and , endof + ['], , ['] % , + endcase ; + +: clamp ( x y -- x' y' ) swap clampx, swap clampy, ; +: y>bitmask ( y -- bit-index ) 7 and 1 swap lshift ; +: xy>i ( x y -- bit-mask buffer-index ) clamp dup y>bitmask -rot 3 rshift width*, + ; +: or! ( value addr -- ) tuck c@ or swap c! ; +: and! ( value addr -- ) tuck c@ and swap c! ; +: set-pixel ( x y -- ) xy>i screen + or! ; +: unset-pixel ( x y -- ) xy>i screen + swap invert swap and! ; +: pixel-set? ( x y -- ) xy>i screen + c@ and 0<> ; +: hline ( x y width -- ) 0 do 2dup set-pixel { 1+ } dip loop 2drop ; +: rect-fill ( x y width height -- ) 0 do 3dup hline { 1+ } dip loop 3drop ; +: fill-buffer ( value -- ) SIZE 0 do dup i screen + c! loop drop ; + +: c1 WIDTH 64 = if 32 else 0 then ; +: c2 WIDTH 64 = if WIDTH 31 + else WIDTH 1- then ; +: display ( -- ) + 16r21 ( COLUMNADDR ) cmd + [ c1 ] literal cmd + [ c2 ] literal cmd + 16r22 ( PAGEADD ) cmd + 0 cmd + [ HEIGHT 3 rshift 1- ] literal cmd + SIZE 1+ screen 1- 0 ( data ) SLAVE BUS i2c-write-slave check ; + +: display-clear ( -- ) 0 fill-buffer display ; +: bus-init ( -- ) FREQ SDA SCL BUS i2c-init check ; +: display-init ( -- | throws:ESSD1306 ) wire bus-init reset init display-clear ; + +\ TODO move these to common place as they're used in the spi driver too +0 init-variable: font +0 init-variable: text-left +0 init-variable: text-top +1 init-variable: font-size + +: font-small ( -- ) 1 font-size ! ; +: font-medium ( -- ) 2 font-size ! ; +: font-big ( -- ) 3 font-size ! ; +: font-xbig ( -- ) 4 font-size ! ; +: draw-lf ( -- ) 9 text-top +! ; +: draw-cr ( -- ) 0 text-left ! ; +: dot ( x y -- ) { font-size @ * } bi@ font-size @ dup rect-fill ; + +: stripe ( bits -- ) + 8 0 do + dup 1 and 1= if + text-left @ text-top @ i + dot + then + 1 rshift + loop + drop ; + +: draw-char ( char -- ) + 255 and 5 * font @ + + 5 0 do + dup c@ stripe 1+ + 1 text-left +! + loop + 1 text-left +! + drop ; + +: draw-str ( str -- ) + font @ 0= if + println: 'Set a font like: "font5x7 font !"' + drop exit + then + dup strlen 0 do + dup i + c@ + case + 10 of draw-lf endof + 13 of draw-cr endof + draw-char + endcase + loop + drop ; + +: str-width ( str -- ) strlen 6 * font-size @ * ; + +/end + diff --git a/arch/esp8266/forth/ssd1306-spi.forth b/arch/esp8266/forth/ssd1306-spi.forth index e93c1fb..72bcd7a 100644 --- a/arch/esp8266/forth/ssd1306-spi.forth +++ b/arch/esp8266/forth/ssd1306-spi.forth @@ -1,3 +1,5 @@ +GPIO load + \ ssd1306 SPI display driver \ define the wiring @@ -7,74 +9,11 @@ 0 constant: RST \ RST D3 leg 1 constant: BUS -141 constant: SSD1306_CHARGE_PUMP_REGULATOR -20 constant: SSD1306_CHARGE_PUMP_ON -129 constant: SSD1306_SET_CONTRAST -164 constant: SSD1306_RESUME_TO_RAM_CONTENT -165 constant: SSD1306_IGNORE_RAM_CONTENT -166 constant: SSD1306_DISP_NORMAL -167 constant: SSD1306_DISP_INVERTED -174 constant: SSD1306_DISP_SLEEP -175 constant: SSD1306_DISP_ON - -\ Scroll commands -38 constant: SSD1306_SCROLL_RIGHT -39 constant: SSD1306_SCROLL_LEFT -41 constant: SSD1306_SCROLL_VERTICAL_RIGHT -42 constant: SSD1306_SCROLL_VERTICAL_LEFT -46 constant: SSD1306_SCROLL_OFF -47 constant: SSD1306_SCROLL_ON -163 constant: SSD1306_VERT_SCROLL_AREA - -\ Address setting commands -0 constant: SSD1306_SET_COL_LO_NIBBLE -16 constant: SSD1306_SET_COL_HI_NIBBLE -32 constant: SSD1306_MEM_ADDRESSING -33 constant: SSD1306_SET_COL_ADDR -34 constant: SSD1306_SET_PAGE_ADDR -176 constant: SSD1306_SET_PAGE_START_ADDR - -\ Hardware configuration -64 constant: SSD1306_SET_DISP_START_LINE -160 constant: SSD1306_SET_SEG_REMAP_0 -161 constant: SSD1306_SET_SEG_REMAP_127 -168 constant: SSD1306_SET_MULTIPLEX_RATIO -192 constant: SSD1306_SET_COM_SCAN_NORMAL -200 constant: SSD1306_SET_COM_SCAN_INVERTED -211 constant: SSD1306_SET_VERTICAL_OFFSET -218 constant: SSD1306_SET_WIRING_SCHEME -213 constant: SSD1306_SET_DISP_CLOCK -217 constant: SSD1306_SET_PRECHARGE_PERIOD -219 constant: SSD1306_SET_VCOM_DESELECT_LEVEL -227 constant: SSD1306_NOP - -0 constant: SPI_MODE0 -1 constant: SPI_MODE1 -2 constant: SPI_MODE2 -3 constant: SPI_MODE3 - 1 constant: SPI_WORD_SIZE_8BIT -2 constant: SPI_WORD_SIZE_16BIT -4 constant: SPI_WORD_SIZE_32BIT -0 constant: SPI_LITTLE_ENDIAN -1 constant: SPI_BIG_ENDIAN +: freq ( divider count -- freq ) 16 lshift swap 65535 and or ; -: spi-get-freq-div ( divider count -- freq ) 16 lshift swap 65535 and or ; - -64 10 spi-get-freq-div constant: SPI_FREQ_DIV_125K \ < 125kHz -32 10 spi-get-freq-div constant: SPI_FREQ_DIV_250K \ < 250kHz -16 10 spi-get-freq-div constant: SPI_FREQ_DIV_500K \ < 500kHz -8 10 spi-get-freq-div constant: SPI_FREQ_DIV_1M \ < 1MHz -4 10 spi-get-freq-div constant: SPI_FREQ_DIV_2M \ < 2MHz -2 10 spi-get-freq-div constant: SPI_FREQ_DIV_4M \ < 4MHz -5 2 spi-get-freq-div constant: SPI_FREQ_DIV_8M \ < 8MHz -4 2 spi-get-freq-div constant: SPI_FREQ_DIV_10M \ < 10MHz -2 2 spi-get-freq-div constant: SPI_FREQ_DIV_20M \ < 20MHz -1 2 spi-get-freq-div constant: SPI_FREQ_DIV_40M \ < 40MHz -1 1 spi-get-freq-div constant: SPI_FREQ_DIV_80M \ < 80MHz - -127 constant: DEFAULT_CONTRAST +5 2 freq constant: SPI_FREQ_DIV_8M \ < 8MHz 128 constant: DISPLAY_WIDTH 64 constant: DISPLAY_HEIGHT @@ -84,32 +23,42 @@ exception: ESSD1306_WRITE DISPLAY_WIDTH DISPLAY_HEIGHT * 8 / constant: BUFFER_SIZE -\ display buffers -BUFFER_SIZE byte-array: screen-ary1 -BUFFER_SIZE byte-array: screen-ary2 -BUFFER_SIZE byte-array: screen-output - -' screen-ary1 init-variable: var-screen-ary1 -' screen-ary2 init-variable: var-screen-ary2 -: screen1 ( index -- addr ) var-screen-ary1 @ execute ; -: screen2 ( index -- addr ) var-screen-ary2 @ execute ; +BUFFER_SIZE buffer: screen1 +screen1 init-variable: actual +: screen ( -- buffer ) actual @ ; -: display-setup-wiring +: wire ( -- ) DC GPIO_OUT gpio-mode RST GPIO_OUT gpio-mode DC GPIO_LOW gpio-write RST GPIO_LOW gpio-write ; -: check-write-result ( code -- | ESSD1306_WRITE ) - 255 <> if - ESSD1306_WRITE throw - then ; +: check-write-result ( code -- | ESSD1306_WRITE ) 255 <> if ESSD1306_WRITE throw then ; : write-command ( cmd -- | ESSD1306_WRITE ) DC GPIO_LOW gpio-write BUS spi-send8 check-write-result ; +: display-invert ( -- ) 167 write-command ; +: display-normal ( -- ) 166 write-command ; + +38 constant: RIGHT +39 constant: LEFT + +\ activate scroll. Display is 16 row tall +: scroll-start ( stop-row start-row direction -- ) + write-command ( direction ) + 0 write-command + write-command ( start ) + 0 write-command + write-command ( stop ) + 0 write-command + 255 write-command + 47 write-command ( SSD1306_SCROLL_ON ) ; + +: scroll-stop ( -- ) 46 write-command ; + : write-data ( data -- | ESSD1306_WRITE ) DC GPIO_HIGH gpio-write BUS spi-send8 @@ -122,100 +71,125 @@ BUFFER_SIZE byte-array: screen-output 10 ms RST GPIO_HIGH gpio-write ; -: display-send-init-sequence ( -- ) - SSD1306_DISP_SLEEP write-command - SSD1306_SET_DISP_CLOCK write-command - 128 write-command - SSD1306_SET_MULTIPLEX_RATIO write-command - 63 write-command - SSD1306_SET_VERTICAL_OFFSET write-command - 0 write-command - SSD1306_SET_DISP_START_LINE write-command - SSD1306_CHARGE_PUMP_REGULATOR write-command - SSD1306_CHARGE_PUMP_ON write-command - SSD1306_MEM_ADDRESSING write-command - 0 write-command - SSD1306_SET_SEG_REMAP_0 write-command - SSD1306_SET_COM_SCAN_NORMAL write-command - SSD1306_SET_WIRING_SCHEME write-command - 18 write-command - SSD1306_SET_VCOM_DESELECT_LEVEL write-command - 64 write-command - SSD1306_RESUME_TO_RAM_CONTENT write-command - SSD1306_DISP_NORMAL write-command - SSD1306_DISP_ON write-command ; +: init ( -- ) + 174 write-command ( SSD1306_DISP_SLEEP ) + 213 write-command ( SSD1306_SET_DISP_CLOCK ) + 128 write-command + 168 write-command ( SSD1306_SET_MULTIPLEX_RATIO ) + 63 write-command + 211 write-command ( SSD1306_SET_VERTICAL_OFFSET ) + 0 write-command + 64 write-command ( SSD1306_SET_DISP_START_LINE ) + 141 write-command ( SSD1306_CHARGE_PUMP_REGULATOR ) + 20 write-command ( SSD1306_CHARGE_PUMP_ON ) + 32 write-command ( SSD1306_MEM_ADDRESSING ) + 0 write-command + 160 write-command ( SSD1306_SET_SEG_REMAP_0 ) + 192 write-command ( SSD1306_SET_COM_SCAN_NORMAL ) + 218 write-command ( SSD1306_SET_WIRING_SCHEME ) + 18 write-command + 219 write-command ( SSD1306_SET_VCOM_DESELECT_LEVEL ) + 64 write-command + 164 write-command ( SSD1306_RESUME_TO_RAM_CONTENT ) + display-normal + 175 write-command ( SSD1306_DISP_ON ) ; : display-reset ( -- ) - 33 write-command - 0 write-command + 33 write-command + 0 write-command 127 write-command - 34 write-command - 0 write-command - 7 write-command + 34 write-command + 0 write-command + 7 write-command 1025 0 do 0 write-data loop ; -: xchg-screen ( -- ) - var-screen-ary2 @ - var-screen-ary1 @ var-screen-ary2 ! - var-screen-ary1 ! ; - -: y>bitmask ( y -- bit-index ) - 7 and - 1 swap lshift ; - -: xy>buffer-pos ( x y -- bit-mask array-index ) +: y>bitmask ( y -- bit-index ) 7 and 1 swap lshift ; +: xy-trunc ( x y -- x' y' ) swap 127 and swap 63 and ; + +: xy>i ( x y -- bit-mask buffer-index ) + xy-trunc dup y>bitmask -rot 3 rshift \ 8 / 7 lshift + ; \ DISPLAY_WIDTH * + -: or! ( value addr -- ) - tuck c@ or swap c! ; - -: and! ( value addr -- ) - tuck c@ and swap c! ; - -: set-pixel ( x y -- ) - xy>buffer-pos screen1 or! ; - -: unset-pixel ( x y -- ) - xy>buffer-pos screen1 - swap invert swap and! ; +: or! ( value addr -- ) tuck c@ or swap c! ; +: and! ( value addr -- ) tuck c@ and swap c! ; +: set-pixel ( x y -- ) xy>i screen + or! ; +: unset-pixel ( x y -- ) xy>i screen + swap invert swap and! ; +: pixel-set? ( x y -- ) xy>i screen + c@ and 0<> ; +: hline ( x y width -- ) 0 do 2dup set-pixel { 1+ } dip loop 2drop ; +: rect-fill ( x y width height -- ) 0 do 3dup hline { 1+ } dip loop 3drop ; +: fill-buffer ( value -- ) BUFFER_SIZE 0 do dup i screen + c! loop drop ; -: pixel-set? ( x y -- ) - xy>buffer-pos screen1 - c@ and 0<> ; - -: fill-screen-buffer ( value -- ) - BUFFER_SIZE 0 do - dup i screen1 c! - loop - drop ; - -: show-screen-buffer ( -- ) +: display ( -- ) SPI_WORD_SIZE_8BIT BUFFER_SIZE - 0 screen-output - 0 screen1 + 0 ( ignore output ) + screen BUS spi-send BUFFER_SIZE <> if ESSD1306 throw then ; -: display-clear ( -- ) - 0 fill-screen-buffer - show-screen-buffer ; - -: truncate-xy ( x y -- x' y' ) - swap 127 and - swap 63 and ; +: display-clear ( -- ) 0 fill-buffer display ; : display-init ( -- | ESSD1306 ) - display-setup-wiring - TRUE SPI_BIG_ENDIAN TRUE SPI_FREQ_DIV_4M SPI_MODE0 BUS - spi-init 1 <> if - ESSD1306 throw + wire + TRUE 0 ( little endian ) TRUE SPI_FREQ_DIV_8M 0 ( SPI_MODE0 ) BUS + spi-init 1 <> if ESSD1306 throw then + display-on init display-reset ; + +0 init-variable: font +0 init-variable: text-left +0 init-variable: text-top +1 init-variable: font-size + +: font-small ( -- ) 1 font-size ! ; +: font-medium ( -- ) 2 font-size ! ; +: font-big ( -- ) 3 font-size ! ; +: font-xbig ( -- ) 4 font-size ! ; +: draw-lf ( -- ) 9 text-top +! ; +: draw-cr ( -- ) 0 text-left ! ; + +: dot ( x y -- ) + { font-size @ * } bi@ + font-size @ dup rect-fill ; + +: stripe ( bits -- ) + 8 0 do + dup 1 and 1= if + text-left @ text-top @ i + dot + then + 1 rshift + loop + drop ; + +: draw-char ( char -- ) + 255 and 5 * font @ + + 5 0 do + dup c@ stripe 1+ + 1 text-left +! + loop + 1 text-left +! + drop ; + +: draw-str ( str -- ) + font @ 0= if + println: 'Set a font like: "font5x7 font !"' + drop exit then - display-on - display-send-init-sequence - display-reset ; + dup strlen 0 do + dup i + c@ + case + 10 of draw-lf endof + 13 of draw-cr endof + draw-char + endcase + loop + drop ; + +: str-width ( str -- ) strlen 6 * font-size @ * ; + +/end + diff --git a/arch/esp8266/forth/tasks.forth b/arch/esp8266/forth/tasks.forth index 14930f4..43bb2c4 100644 --- a/arch/esp8266/forth/tasks.forth +++ b/arch/esp8266/forth/tasks.forth @@ -12,138 +12,99 @@ struct cell field: .handler constant: Task -here Task allot constant: INTERPRETER -INTERPRETER INTERPRETER .next ! -SKIPPED INTERPRETER .status ! -_s0 INTERPRETER .s0 ! -_r0 INTERPRETER .r0 ! +here Task allot constant: REPL +REPL REPL .next ! +SKIPPED REPL .status ! +_s0 REPL .s0 ! +_r0 REPL .r0 ! -320 init-variable: var-task-stack-size -320 init-variable: var-task-rstack-size -INTERPRETER init-variable: var-last-task -INTERPRETER init-variable: var-current-task +112 init-variable: task-stack-size +112 init-variable: task-rstack-size +REPL init-variable: last +REPL init-variable: current -: last-task ( -- task ) var-last-task @ ; -: last-task! ( task -- ) var-last-task ! ; -: current-task ( -- task ) var-current-task @ ; -: current-task! ( task -- ) var-current-task ! ; - -: alloc-data-stack ( -- a ) - var-task-stack-size @ allot here ; - -: alloc-return-stack ( -- a ) - var-task-rstack-size @ allot here ; +: alloc-stack ( -- a ) task-stack-size @ allot here ; +: alloc-rstack ( -- a ) task-rstack-size @ allot here ; : task: ( user-space-size "name" ) ( -- task ) create: here \ task header begins here swap Task + allot \ make room for task header + user space SKIPPED over .status ! \ new status is SKIPPED - last-task .next @ over .next ! \ this.next = last-task.next - dup last-task .next ! \ last-task.next = this - alloc-data-stack over .sp ! \ this.sp = allocated - alloc-return-stack over .rp ! \ this.sp = allocated + last @ .next @ over .next ! \ this.next = last-task.next + dup last @ .next ! \ last-task.next = this + alloc-stack over .sp ! \ this.sp = allocated + alloc-rstack over .rp ! \ this.sp = allocated 0 over .handler ! \ exception handler of this thread dup .sp @ over .s0 ! \ init s0 = top of stack address dup .rp @ over .r0 ! \ init r0 = top of rstack address - last-task! ; \ last-task = this - -: task-choose-next ( -- ) - current-task - begin - .next @ dup - .status @ PAUSED = - until ; + last ! ; \ last-task = this -: task-save-context ( sp ip rp -- ) \ XXX temporal coupling - current-task .rp ! - current-task .ip ! - current-task .sp ! ; +: choose ( -- ) current @ begin .next @ dup .status @ PAUSED = until ; -: task-restore-context ( -- ) - current-task .sp @ sp! - current-task .rp @ rp! - current-task .ip @ >r ; +: save ( sp ip rp -- ) \ XXX temporal coupling + current @ .rp ! + current @ .ip ! + current @ .sp ! ; -: task-run ( task -- ) - current-task! - SKIPPED current-task .status ! - task-restore-context ; +: restore ( -- ) + current @ .sp @ sp! + current @ .rp @ rp! + current @ .ip @ >r ; -: task-user-space ( task -- a ) Task + ; +: switch ( task -- ) + current ! + SKIPPED current @ .status ! + restore ; -: user-space ( -- a ) - current-task task-user-space ; +: user-space ( -- a ) current @ Task + ; defer: pause : pause-multi ( -- ) - PAUSED current-task .status ! - sp@ r> rp@ task-save-context - task-choose-next task-run ; + PAUSED current @ .status ! + sp@ r> rp@ save + choose switch ; -: pause-single ( -- ) ; - -: s0-multi ( -- top-stack-adr ) current-task .s0 @ ; -: r0-multi ( -- top-rstack-adr ) current-task .r0 @ ; +: s0-multi ( -- top-stack-adr ) current @ .s0 @ ; +: r0-multi ( -- top-rstack-adr ) current @ .r0 @ ; ' s0 is: s0-multi ' r0 is: r0-multi : activate ( task -- ) r> over .ip ! - PAUSED current-task .status ! \ pause current task - sp@ cell + r> rp@ task-save-context - task-run ; - -: stop ( task -- ) - SKIPPED swap .status ! - task-choose-next task-run ; + PAUSED current @ .status ! \ pause current task + sp@ cell + r> rp@ save + switch ; -: deactivate ( -- ) - current-task stop ; +: stop ( task -- ) SKIPPED swap .status ! choose switch ; +: deactivate ( -- ) current @ stop ; : task-find ( task -- link ) lastword begin - dup 0<> + dup while - 2dup - link>body cell + = if \ XXX skip behaviour pointer - nip exit - then + 2dup link>body cell + = if nip exit then \ XXX skip behaviour pointer @ repeat 2drop 0 ; : tasks-print ( -- ) - current-task + current @ begin - dup task-find dup 0<> if - link-type cr - else - drop println: "interpreter" - then - .next @ dup - current-task = + dup task-find ?dup if link-type cr else println: "interpreter" then + .next @ dup current @ = until drop ; : semaphore: ( -- ) init-variable: ; : mutex: ( -- ) 1 semaphore: ; - -: wait ( semaphore -- ) - begin - pause - dup @ 0<> - until - -1 swap +! ; - -: signal ( semaphore -- ) - 1 swap +! - pause ; +: wait ( semaphore -- ) begin pause dup @ until -1 swap +! ; +: signal ( semaphore -- ) 1 swap +! pause ; -: multi-handler ( -- a ) current-task .handler ; +: multi-handler ( -- a ) current @ .handler ; : multi ( -- ) \ switch to multi-task mode ['] handler is: multi-handler \ each tasks should have its own exception handler @@ -152,25 +113,10 @@ defer: pause : single ( -- ) \ switch to signle-task mode ['] handler is: single-handler \ use global handler - 0 xpause ! - ['] pause is: pause-single ; - -: mailbox: ( size ) ( -- mailbox ) ringbuf: ; + 0 xpause ! + ['] pause is: nop ; -: mailbox-send ( message mailbox -- ) - begin - dup ringbuf-full? - while - pause - repeat - ringbuf-enqueue ; - -: mailbox-receive ( mailbox -- message ) - begin - dup ringbuf-empty? - while - pause - repeat - ringbuf-dequeue ; - single + +/end + diff --git a/arch/esp8266/forth/tcp-repl.forth b/arch/esp8266/forth/tcp-repl.forth index c6f535a..5deb19c 100644 --- a/arch/esp8266/forth/tcp-repl.forth +++ b/arch/esp8266/forth/tcp-repl.forth @@ -1,3 +1,7 @@ +NETCON load +WIFI load +MAILBOX load + wifi-ip constant: HOST 1983 constant: PORT @@ -9,7 +13,7 @@ wifi-ip constant: HOST 0 task: repl-worker-task : type-composite ( str -- ) - client @ 0<> if + client @ if client @ swap netcon-write else _type @@ -18,7 +22,7 @@ wifi-ip constant: HOST 2 buffer: emit-buf 0 emit-buf 1+ c! : emit-composite ( char -- ) - client @ 0<> if + client @ if emit-buf c! client @ emit-buf netcon-write else @@ -47,15 +51,13 @@ wifi-ip constant: HOST deactivate ; : command-loop ( -- ) - client @ str: "PunyREPL ready. Type quit to exit.\r\n" netcon-write + client @ "PunyREPL ready. Type quit to exit.\r\n" netcon-write push-enter begin client @ 128 line netcon-readln -1 <> - line str: "quit" =str invert and + line "quit" =str invert and while - line strlen 0<> if - line eval - then + line strlen if line eval then repeat ; : worker ( task -- ) @@ -79,3 +81,6 @@ wifi-ip constant: HOST ['] emit-composite xemit ! repl-server-task server repl-worker-task worker ; + +/end + diff --git a/arch/esp8266/forth/turnkey.forth b/arch/esp8266/forth/turnkey.forth new file mode 100644 index 0000000..5dfe74b --- /dev/null +++ b/arch/esp8266/forth/turnkey.forth @@ -0,0 +1,30 @@ +4096 constant: SIZE +16r51000 constant: BOOT_ADDR + +exception: ETURNKEY +defer: boot + +: dst ( -- n ) 16r51000 SIZE + ; +: heap-size ( -- n ) usedmem align ; +: check ( code -- | ETURNKEY ) ?dup if print: 'SPI FLASH ERROR: ' . cr ETURNKEY throw then ; + +: n, ( addr n -- addr+strlen ) over >r >str r> dup strlen + ; +: s, ( str-dst str-src -- str-dst+strlen ) tuck strlen 2dup + { cmove } dip ; + +: save-loader ( -- ) + here dup + heap-size n, " heap-start " s, dst n, " read-flash drop boot" s, + 0 swap c! + BOOT_ADDR SIZE / erase-flash check + SIZE swap BOOT_ADDR write-flash check ; + +: turnkey ( -- ) + heap-size SIZE / heap-size SIZE % 0> abs + 0 + do + dst SIZE / i + erase-flash check + loop + heap-size heap-start dst write-flash check + save-loader ; + +/end + diff --git a/arch/esp8266/forth/wifi.forth b/arch/esp8266/forth/wifi.forth index ec6b954..3bfe32e 100644 --- a/arch/esp8266/forth/wifi.forth +++ b/arch/esp8266/forth/wifi.forth @@ -26,7 +26,7 @@ exception: EWIFI \ Connect to an existing Wi-Fi access point with the given ssid and password \ For example: -\ str: "ap-pass" str: "ap-ssid" wifi-connect +\ "ap-pass" "ap-ssid" wifi-connect : wifi-connect ( password ssid -- | throws:EWIFI ) STATION_MODE wifi-set-mode check-status wifi-set-station-config check-status @@ -35,12 +35,21 @@ exception: EWIFI \ Creates an access point mode with the given properties \ For example: \ 172 16 0 1 >ipv4 wifi-set-ip -\ 1 3 0 AUTH_WPA2_PSK str: "1234567890" str: "my-ssid" wifi-softap -\ 4 172 16 0 2 >ipv4 dhcpd-start +\ 4 3 0 AUTH_WPA2_PSK "1234567890" "my-ssid" wifi-softap +\ 8 172 16 0 2 >ipv4 dhcpd-start +\ max-connections should be <= max-leases : wifi-softap ( max-connections channels hidden authmode password ssid -- | throws:EWIFI ) SOFTAP_MODE wifi-set-mode check-status wifi-set-softap-config check-status ; -: wifi-ip ( -- str ) - here 16 allot - 16 over wifi-ip-str ; +: ip ( interface -- str ) + { here 16 over } dip + 16 allot + wifi-ip-str ; + +\ station ip +: wifi-ip ( -- str ) 0 ip ; +: softap-ip ( -- str ) 1 ip ; + +/end + diff --git a/arch/esp8266/primitives.S b/arch/esp8266/primitives.S index 01143f5..3adf253 100644 --- a/arch/esp8266/primitives.S +++ b/arch/esp8266/primitives.S @@ -18,74 +18,100 @@ addi a13, a13, CELLS .endm +.macro READTOS1 reg + l32i \reg, a15, 0 +.endm + +.macro READTOS2 reg + l32i \reg, a15, CELLS +.endm + +.macro READTOS3 reg + l32i \reg, a15, 2*CELLS +.endm + +.macro READTOS4 reg + l32i \reg, a15, 3*CELLS +.endm + +.macro WRTETOS1 reg + s32i \reg, a15, 0 +.endm + +.macro WRTETOS2 reg + s32i \reg, a15, CELLS +.endm + +.macro WRTETOS3 reg + s32i \reg, a15, 2*CELLS +.endm + +.macro WRTETOS4 reg + s32i \reg, a15, 3*CELLS +.endm + defprimitive "dup",3,dup,REGULAR /* ( a -- a a ) */ - l32i a8, a15, 0 + READTOS1 a8 DPUSH a8 NEXT defprimitive "drop",4,drop,REGULAR /* ( a -- ) */ - DPOP a8 + addi a15, a15, CELLS NEXT defprimitive "swap",4,swap,REGULAR /* ( a b -- b a ) */ - DPOP a8 - DPOP a9 - DPUSH a8 - DPUSH a9 + READTOS1 a8 + READTOS2 a9 + WRTETOS1 a9 + WRTETOS2 a8 NEXT defprimitive "rot",3,rot,REGULAR /* ( a b c -- b c a ) */ - DPOP a8 - DPOP a9 - DPOP a10 - DPUSH a9 - DPUSH a8 - DPUSH a10 + READTOS1 a8 + READTOS2 a9 + READTOS3 a10 + WRTETOS3 a9 + WRTETOS2 a8 + WRTETOS1 a10 NEXT defprimitive "2swap",5,swap2,REGULAR /* ( a b c d -- c d a b ) */ - DPOP a8 - DPOP a9 - DPOP a10 - DPOP a11 - DPUSH a9 - DPUSH a8 - DPUSH a11 - DPUSH a10 + READTOS1 a8 + READTOS2 a9 + READTOS3 a10 + READTOS4 a11 + WRTETOS1 a10 + WRTETOS2 a11 + WRTETOS3 a8 + WRTETOS4 a9 NEXT defprimitive "2over",5,over2,REGULAR /* ( a b c d -- a b c d a b ) */ - DPOP a8 - DPOP a9 - DPOP a10 - DPOP a11 - DPUSH a11 - DPUSH a10 - DPUSH a9 - DPUSH a8 + READTOS3 a10 + READTOS4 a11 DPUSH a11 DPUSH a10 NEXT defprimitive "+",1,plus,REGULAR DPOP a8 - DPOP a9 + READTOS1 a9 add a8, a8, a9 - DPUSH a8 + WRTETOS1 a8 NEXT defprimitive "-",1,minus,REGULAR DPOP a9 - DPOP a8 + READTOS1 a8 sub a8, a8, a9 - DPUSH a8 + WRTETOS1 a8 NEXT defprimitive "*",1,multiply,REGULAR DPOP a8 - DPOP a9 + READTOS1 a9 mull a8, a8, a9 - DPUSH a8 + WRTETOS1 a8 NEXT .literal_position @@ -99,46 +125,46 @@ defprimitive "/mod",4,divmod,REGULAR /* ( n d -- m q ) */ defprimitive "or",2,or,REGULAR DPOP a8 - DPOP a9 + READTOS1 a9 or a8, a8, a9 - DPUSH a8 + WRTETOS1 a8 NEXT defprimitive "and",3,and,REGULAR DPOP a8 - DPOP a9 + READTOS1 a9 and a8, a8, a9 - DPUSH a8 + WRTETOS1 a8 NEXT defprimitive "xor",3,xor,REGULAR DPOP a8 - DPOP a9 + READTOS1 a9 xor a8, a8, a9 - DPUSH a8 + WRTETOS1 a8 NEXT defprimitive "invert",6,invert,REGULAR - DPOP a8 + READTOS1 a8 movi a9, TRUE xor a8, a8, a9 - DPUSH a8 + WRTETOS1 a8 NEXT defprimitive "lshift",6,lshift,REGULAR DPOP a8 - DPOP a9 + READTOS1 a9 ssl a8 sll a8, a9 - DPUSH a8 + WRTETOS1 a8 NEXT defprimitive "rshift",6,rshift,REGULAR DPOP a8 - DPOP a9 + READTOS1 a9 ssr a8 srl a8, a9 - DPUSH a8 + WRTETOS1 a8 NEXT .literal_position @@ -152,15 +178,15 @@ defprimitive "abort",5,abort,REGULAR NEXT defprimitive "@",1,fetch,REGULAR - DPOP a8 + READTOS1 a8 l32i a9, a8, 0 - DPUSH a9 + WRTETOS1 a9 NEXT defprimitive "c@",2,fetchbyte,REGULAR - DPOP a8 + READTOS1 a8 l8ui a9, a8, 0 - DPUSH a9 + WRTETOS1 a9 NEXT defprimitive "!",1,store,REGULAR @@ -183,26 +209,22 @@ defprimitive "[']",3,btick,REGULAR // compile only defprimitive "<",1,lt,REGULAR // only need to define this, all other comparisions are implemented in terms of lt DPOP a8 - DPOP a9 + READTOS1 a9 movi a10, FALSE bge a9, a8, L4 // a9 >= a8 ? movi a10, TRUE -L4: DPUSH a10 +L4: WRTETOS1 a10 NEXT defprimitive "branch",6,branch,REGULAR l32i a8, a14, 0 // read relative address as the next instruction - addi a14, a14, CELLS // x86 uses lodsd that increments forth PC, consider changing this add a14, a14, a8 // advance forth PC NEXT defprimitive "branch0",7,branch0,REGULAR - l32i a8, a14, 0 // read relative address - addi a14, a14, CELLS DPOP a9 - bnez a9, nobranch0 - add a14, a14, a8 -nobranch0: + beqz a9, code_branch + addi a14, a14, CELLS NEXT defprimitive ">r",2,rpush,REGULAR @@ -230,6 +252,11 @@ defprimitive "execute",7,execute,REGULAR l32i a9, a8, 0 // fetch codeword the same way as the inner interpreter does jx a9 +// this exit primitive is only used by the compiler, this is used for detecting word endings works some as regular exit +defprimitive "",6,end_word,REGULAR + RPOP a14 // pop forth PC from the return stack + NEXT + defprimitive "exit",4,exit,REGULAR RPOP a14 // pop forth PC from the return stack NEXT @@ -271,3 +298,12 @@ ENTERDOES: DPUSH a8 // invoke behavour with the data pointer on the stack NEXT +ENTERCONST: + l32i a8, a8, CELLS + DPUSH a8 + NEXT + +ENTERVAR: + addi a8, a8, CELLS + DPUSH a8 + NEXT diff --git a/arch/esp8266/rtos/user/Makefile b/arch/esp8266/rtos/user/Makefile index 5e81214..4889ad7 100644 --- a/arch/esp8266/rtos/user/Makefile +++ b/arch/esp8266/rtos/user/Makefile @@ -1,3 +1,3 @@ PROGRAM=punyforth -EXTRA_COMPONENTS = extras/dhcpserver extras/pwm +EXTRA_COMPONENTS = extras/dhcpserver extras/pwm extras/i2c extras/ws2812 include ../../../../../../common.mk diff --git a/arch/esp8266/rtos/user/forth_evt.c b/arch/esp8266/rtos/user/forth_evt.c index ef2648e..156f2c1 100644 --- a/arch/esp8266/rtos/user/forth_evt.c +++ b/arch/esp8266/rtos/user/forth_evt.c @@ -4,7 +4,7 @@ #include "queue.h" #include "forth_evt.h" -static xQueueHandle event_queue; +static QueueHandle_t event_queue; void init_event_queue() { event_queue = xQueueCreate(12, sizeof(struct forth_event)); @@ -15,5 +15,5 @@ void forth_add_event_isr(struct forth_event *event) { } int forth_wait_event(int timeout_ms, void* event) { - return (xQueueReceive(event_queue, event, timeout_ms / portTICK_RATE_MS) == pdTRUE) ? 1 : 0; + return (xQueueReceive(event_queue, event, timeout_ms / portTICK_PERIOD_MS) == pdTRUE) ? 1 : 0; } diff --git a/arch/esp8266/rtos/user/forth_flash.c b/arch/esp8266/rtos/user/forth_flash.c index ae54ba6..396f370 100644 --- a/arch/esp8266/rtos/user/forth_flash.c +++ b/arch/esp8266/rtos/user/forth_flash.c @@ -14,10 +14,10 @@ int forth_flash_erase_sector(int sector) { return map_err(sdk_spi_flash_erase_sector((uint16_t)sector)); } -int forth_flash_write(int sector, void* buffer, int size) { - return map_err(sdk_spi_flash_write((uint32_t)sector, buffer, (uint32_t)size)); +int forth_flash_write(int address, void* buffer, int size) { + return map_err(sdk_spi_flash_write((uint32_t)address, buffer, (uint32_t)size)); } -int forth_flash_read(int sector, void* buffer, int size) { - return map_err(sdk_spi_flash_read((uint32_t)sector, buffer, (uint32_t) size)); +int forth_flash_read(int address, void* buffer, int size) { + return map_err(sdk_spi_flash_read((uint32_t)address, buffer, (uint32_t)size)); } diff --git a/arch/esp8266/rtos/user/forth_gpio.c b/arch/esp8266/rtos/user/forth_gpio.c index fe7d087..546cfa7 100644 --- a/arch/esp8266/rtos/user/forth_gpio.c +++ b/arch/esp8266/rtos/user/forth_gpio.c @@ -25,8 +25,18 @@ int forth_gpio_read(int num) { return gpio_read(num); } +void IRAM gpio_intr_handler(uint8_t gpio_num) { + struct forth_event event = { + .event_type = EVT_GPIO, + .event_time_ms = xTaskGetTickCountFromISR() * portTICK_PERIOD_MS, + .event_time_us = sdk_system_get_time(), + .event_payload = (int) gpio_num, + }; + forth_add_event_isr(&event); +} + void forth_gpio_set_interrupt(int num, int int_type) { - gpio_set_interrupt(num, int_type); + gpio_set_interrupt(num, int_type, gpio_intr_handler); } void forth_pwm_freq(int freq) { @@ -37,25 +47,6 @@ void forth_pwm_duty(int duty) { pwm_set_duty((uint16_t) (duty & 0xFFFF)); } -void __attribute__((weak)) IRAM gpio_interrupt_handler(void) { - uint32_t status_reg = GPIO.STATUS; - GPIO.STATUS_CLEAR = status_reg; - uint8_t gpio_idx; - while ((gpio_idx = __builtin_ffs(status_reg))) { - gpio_idx--; - status_reg &= ~BIT(gpio_idx); - if (FIELD2VAL(GPIO_CONF_INTTYPE, GPIO.CONF[gpio_idx])) { - struct forth_event event = { - .event_type = EVT_GPIO, - .event_time_ms = xTaskGetTickCountFromISR() * portTICK_RATE_MS, - .event_time_us = sdk_system_get_time(), - .event_payload = gpio_idx - }; - forth_add_event_isr(&event); - } - } -} - #define WAIT_FOR_PIN_STATE(state) \ while (gpio_read(pin) != (state)) { \ if (xthal_get_ccount() - start_cycle_count > timeout_cycles) { \ diff --git a/arch/esp8266/rtos/user/forth_i2c.c b/arch/esp8266/rtos/user/forth_i2c.c new file mode 100644 index 0000000..89d748d --- /dev/null +++ b/arch/esp8266/rtos/user/forth_i2c.c @@ -0,0 +1,30 @@ +#include "FreeRTOS.h" +#include "i2c/i2c.h" + +int forth_i2c_init(int bus, int scl_pin, int sda_pin, int freq) { + return i2c_init(bus, scl_pin, sda_pin, (i2c_freq_t)freq); +} + +bool forth_i2c_write(int bus, int byte) { + return i2c_write(bus, byte); +} + +uint8_t forth_i2c_read(int bus, int ack) { + return i2c_read(bus, (bool)ack); +} + +void forth_i2c_start(int bus) { + return i2c_start(bus); +} + +bool forth_i2c_stop(int bus) { + return i2c_stop(bus); +} + +int forth_i2c_slave_write(int bus, int slave_addr, const uint8_t *data, const uint8_t *buf, int len) { + return i2c_slave_write(bus, slave_addr, data, buf, len); +} + +int forth_i2c_slave_read(int bus, int slave_addr, const uint8_t *data, uint8_t *buf, int len) { + return i2c_slave_read(bus, slave_addr, data, buf, len); +} diff --git a/arch/esp8266/rtos/user/forth_io.c b/arch/esp8266/rtos/user/forth_io.c index c17ed4e..8844221 100644 --- a/arch/esp8266/rtos/user/forth_io.c +++ b/arch/esp8266/rtos/user/forth_io.c @@ -1,41 +1,83 @@ +#include "FreeRTOS.h" #include "espressif/esp_common.h" +#include "espressif/sdk_private.h" #include "esp/uart.h" +#include "task.h" +#include "forth_io.h" -#define BUFFER_SIZE 1024 // should be multiple of 4 -bool _source_read_progress = true; +void forth_putchar(char c) { printf("%c", c); fflush(stdout); } +void forth_type(char* text) { printf("%s", text); fflush(stdout); } +void forth_uart_set_baud(int uart_num, int bps) { uart_set_baud(uart_num, bps); } + +#define BUFFER_SIZE 4096 // should be multiple of 4 +bool loading = false; char *buffer = NULL; -int buffer_offset = -1; -uint32_t source_code_address = 0x51000; +int buffer_offset; +uint32_t source_address; -int next_char_from_flash() { // read source stored code from flash memory - if (buffer == NULL) { - buffer = malloc(BUFFER_SIZE); +void err(char *msg) { + printf(msg); + sdk_system_restart(); +} + +uint32_t stack[8]; +int sp = 0; +bool empty() { return sp == 0; } +bool full() { return sp >= 8; } +void push(int e) { + if (full()) err("Overflow while loading\n"); + stack[sp++] = e; +} +int pop() { + if (empty()) err("Underflow while loading\n"); + return stack[--sp]; +} + +void load(uint32_t addr) { + if (buffer == NULL) buffer = malloc(BUFFER_SIZE); + buffer_offset = -1; + if (loading) push(source_address); + source_address = addr; + loading = true; +} + +void forth_load(uint32_t block_num) { + load(block_num * 4096); +} + +bool forth_loading() { + return loading; +} + +void forth_end_load() { + if (!empty()) { + loading = false; + load(pop()); + } else { + loading = false; + free(buffer); + buffer = NULL; + printf("\n"); } +} + +int next_char_from_flash() { // read source stored code from flash memory if (buffer_offset < 0 || buffer_offset >= BUFFER_SIZE) { - sdk_spi_flash_read(source_code_address, (void *) buffer, BUFFER_SIZE); - source_code_address += BUFFER_SIZE; + //printf("Reading 16r%x\n", source_address); + forth_putchar('.'); + sdk_spi_flash_read(source_address, (void *) buffer, BUFFER_SIZE); buffer_offset = 0; } - char next = buffer[buffer_offset++]; - if (next == 0 || next == 0xFF) { - _source_read_progress = false; - free(buffer); - printf("Punyforth ready.\n"); - return 10; - } - return next; + source_address++; + return buffer[buffer_offset++]; } int forth_getchar() { - return _source_read_progress - ? next_char_from_flash() - : getchar(); + return loading ? next_char_from_flash() : getchar(); } bool _enter_press = false; // XXX this is ugly, use for breaking out key loop -void forth_push_enter() { - _enter_press = true; -} +void forth_push_enter() { _enter_press = true; } int check_enter() { if (_enter_press) { @@ -46,24 +88,9 @@ int check_enter() { } int forth_getchar_nowait() { - if (_source_read_progress) { - return next_char_from_flash(); - } + if (loading) return next_char_from_flash(); + taskYIELD(); char buf[1]; - return sdk_uart_rx_one_char(buf) != 0 - ? check_enter() - : buf[0]; -} - -void forth_putchar(char c) { - printf("%c", c); -} - -void forth_type(char* text) { - printf("%s", text); -} - -void forth_uart_set_baud(int uart_num, int bps) { - uart_set_baud(uart_num, bps); + return sdk_uart_rx_one_char(buf) != 0 ? check_enter() : buf[0]; } diff --git a/arch/esp8266/rtos/user/forth_io.h b/arch/esp8266/rtos/user/forth_io.h new file mode 100644 index 0000000..ed22303 --- /dev/null +++ b/arch/esp8266/rtos/user/forth_io.h @@ -0,0 +1,6 @@ +#ifndef __FORTH_IO_H__ +#define __FORTH_IO_H__ + +void forth_load(uint32_t address); + +#endif diff --git a/arch/esp8266/rtos/user/forth_netconn.c b/arch/esp8266/rtos/user/forth_netconn.c index bb289aa..41e45e9 100644 --- a/arch/esp8266/rtos/user/forth_netconn.c +++ b/arch/esp8266/rtos/user/forth_netconn.c @@ -8,6 +8,7 @@ struct forth_netconn { struct netconn* conn; struct netbuf* nbuf; int bufpos; + int read_timeout_sec; }; struct forth_netconn* make_forth_netconn(struct netconn* conn) { @@ -16,9 +17,18 @@ struct forth_netconn* make_forth_netconn(struct netconn* conn) { result->conn = conn; result->nbuf = NULL; result->bufpos = 0; + result->read_timeout_sec = -1; return result; } +int forth_netcon_get_read_timeout(struct forth_netconn* conn) { + return conn->read_timeout_sec; +} + +void forth_netcon_set_read_timeout(struct forth_netconn* conn, int seconds) { + conn->read_timeout_sec = seconds; +} + struct forth_netconn* forth_netcon_new(int type) { enum netconn_type con_type; //printf("New netcon type: %d\n", type); @@ -144,7 +154,6 @@ struct recvinto_res { }; struct recvinto_res forth_netcon_recvinto(struct forth_netconn* conn, void* buffer, int size) { - // printf("receiving buffer %p max size: %d. cache len=%d cache start=%d cache end=%d\n", buffer, size, cache_data_len(conn), conn->cache_start, conn->cache_end); if (conn->nbuf == NULL) { struct netbuf *inbuf; err_t err; @@ -155,18 +164,18 @@ struct recvinto_res forth_netcon_recvinto(struct forth_netconn* conn, void* buff conn->nbuf = inbuf; conn->bufpos = 0; } - int count = netbuf_copy_partial(conn->nbuf, buffer, size, conn->bufpos); conn->bufpos += count; - if (count != 0) { - struct recvinto_res result = { .code = ERR_OK, .count = count }; - return result; + + struct recvinto_res result = { .code = ERR_OK, .count = count }; + + if (conn->bufpos >= netbuf_len(conn->nbuf)) { + netbuf_delete(conn->nbuf); + conn->nbuf = NULL; + conn->bufpos = 0; } - netbuf_delete(conn->nbuf); - conn->nbuf = NULL; - conn->bufpos = 0; - return forth_netcon_recvinto(conn, buffer, size); + return result; } struct accept_res { diff --git a/arch/esp8266/rtos/user/forth_time.c b/arch/esp8266/rtos/user/forth_time.c index ab677a1..b1e7e69 100644 --- a/arch/esp8266/rtos/user/forth_time.c +++ b/arch/esp8266/rtos/user/forth_time.c @@ -3,11 +3,11 @@ #include "espressif/esp_common.h" void forth_delay_ms(int millis) { - vTaskDelay(millis / portTICK_RATE_MS); + vTaskDelay(millis / portTICK_PERIOD_MS); } int forth_time_ms() { - return xTaskGetTickCount() * portTICK_RATE_MS; + return xTaskGetTickCount() * portTICK_PERIOD_MS; } /** diff --git a/arch/esp8266/rtos/user/forth_wifi.c b/arch/esp8266/rtos/user/forth_wifi.c index 65945bf..fa5fb53 100644 --- a/arch/esp8266/rtos/user/forth_wifi.c +++ b/arch/esp8266/rtos/user/forth_wifi.c @@ -1,9 +1,15 @@ #include "espressif/esp_common.h" +#include "espressif/esp_wifi.h" +#include "esplibs/libnet80211.h" #include "FreeRTOS.h" #include "string.h" #include "dhcpserver.h" #include "punycommons.h" + +// workaround see github.com/SuperHouse/esp-open-rtos/issues/140 +// void sdk_hostap_handle_timer(void *cnx_node) { } + int forth_wifi_set_opmode(int mode) { return sdk_wifi_set_opmode(mode); } @@ -48,12 +54,11 @@ void forth_wifi_set_ip(int ipv4) { sdk_wifi_set_ip_info(1, &ip); } -void forth_wifi_get_ip_str(char * buffer, int size) { +void forth_wifi_get_ip_str(int interface, char * buffer, int size) { struct ip_info wifi_info; - sdk_wifi_get_ip_info(0, &wifi_info); - struct ip_addr ip = wifi_info.ip; + sdk_wifi_get_ip_info(interface, &wifi_info); + struct ip4_addr ip = wifi_info.ip; snprintf(buffer, size, IPSTR, IP2STR(&ip)); - } void forth_dhcpd_start(int first_client_ipv4, int max_leases) { @@ -65,3 +70,9 @@ void forth_dhcpd_start(int first_client_ipv4, int max_leases) { void forth_dhcpd_stop() { dhcpserver_stop(); } + +void forth_wifi_stop() { + if (sdk_wifi_get_opmode() != 2) sdk_wifi_station_stop(); + if (sdk_wifi_get_opmode() != 1) sdk_wifi_softap_stop(); +} + diff --git a/arch/esp8266/rtos/user/forth_ws2812.c b/arch/esp8266/rtos/user/forth_ws2812.c new file mode 100644 index 0000000..fb4cb6e --- /dev/null +++ b/arch/esp8266/rtos/user/forth_ws2812.c @@ -0,0 +1,12 @@ +#include "FreeRTOS.h" +#include "espressif/esp_common.h" +#include "task.h" +#include "ws2812.h" + +void forth_ws2812_rgb(uint32_t gpio_num, uint32_t rgb) { + ws2812_seq_rgb(gpio_num, rgb); +} + +void forth_ws2812_set(uint32_t gpio_num, uint32_t rgb) { + ws2812_set(gpio_num, rgb); +} diff --git a/arch/esp8266/rtos/user/punyforth.S b/arch/esp8266/rtos/user/punyforth.S index 1dad446..879f673 100644 --- a/arch/esp8266/rtos/user/punyforth.S +++ b/arch/esp8266/rtos/user/punyforth.S @@ -19,10 +19,6 @@ forth_start: movi a9, input_index s32i a8, a9, 0 - movi a8, dictionary - movi a9, var_dp - s32i a8, a9, 0 - movi a15, stack movi a13, rstack_top diff --git a/arch/esp8266/rtos/user/user_main.c b/arch/esp8266/rtos/user/user_main.c index fba0e0a..8eb2090 100644 --- a/arch/esp8266/rtos/user/user_main.c +++ b/arch/esp8266/rtos/user/user_main.c @@ -6,6 +6,7 @@ #include "espressif/esp8266/esp8266.h" #include "punyforth.h" #include "forth_evt.h" +#include "forth_io.h" static void forth_init(void* dummy) { forth_start(); @@ -13,7 +14,8 @@ static void forth_init(void* dummy) { void user_init(void) { uart_set_baud(0, 115200); - printf("Punyforth loading..\n"); + printf("\nLoading Punyforth\n"); + forth_load(0x52000 / 4096); init_event_queue(); - xTaskCreate(forth_init, (signed char*) "punyforth", 640, NULL, 2, NULL); + xTaskCreate(forth_init, "punyforth", 640, NULL, 2, NULL); } diff --git a/arch/x86/.gitignore b/arch/x86/.gitignore new file mode 100644 index 0000000..4047079 --- /dev/null +++ b/arch/x86/.gitignore @@ -0,0 +1 @@ +punyforth diff --git a/arch/x86/build b/arch/x86/build index 49ef4bc..9f1d62b 100755 --- a/arch/x86/build +++ b/arch/x86/build @@ -11,6 +11,7 @@ cat ../../generic/forth/core.forth \ ../../generic/forth/ringbuf.forth \ ../../generic/forth/ringbuf_test.forth \ ../../generic/forth/test.forth \ + ../../generic/forth/decompiler.forth \ $GREET \ /dev/stdin \ | ./punyforth diff --git a/arch/x86/ext.S b/arch/x86/ext.S index 98186c9..1072e63 100644 --- a/arch/x86/ext.S +++ b/arch/x86/ext.S @@ -95,8 +95,11 @@ defprimitive "over",4,over,REGULAR // optional defprimitive "time",4,time,REGULAR /* ( -- unixtime ) */ mov eax, 13 - mov ebx, OFFSET FLAT:var0 - int 0x80 - mov eax, [var0] push eax + mov ebx, esp + int 0x80 + NEXT + +defprimitive "r@",2,rfetch,REGULAR + push [ebp] NEXT diff --git a/arch/x86/init.S b/arch/x86/init.S index 0056735..4804bb3 100644 --- a/arch/x86/init.S +++ b/arch/x86/init.S @@ -2,10 +2,6 @@ .macro init_forth cld - mov eax, OFFSET FLAT:input_buffer - mov [input_index], eax // initialize 'input_index' to the beginning of the input_buffer - mov eax, OFFSET FLAT:dictionary - mov [var_dp], eax // initialzie 'here' to the beginning of the dictionary mov [stack_top], esp mov ebp, OFFSET FLAT:rstack_top // ebp is used to track the return stack mov esi, OFFSET FLAT:outer_interpreter // esi works as an instruction pointer diff --git a/arch/x86/primitives.S b/arch/x86/primitives.S index 32d9092..29c2db7 100644 --- a/arch/x86/primitives.S +++ b/arch/x86/primitives.S @@ -6,9 +6,9 @@ defprimitive "dup",3,dup,REGULAR /* ( a -- a a ) */ mov eax, [esp] push eax NEXT - + defprimitive "drop",4,drop,REGULAR /* ( a -- ) */ - add esp, CELLS + add esp, CELLS NEXT defprimitive "swap",4,swap,REGULAR /* ( a b -- b a ) */ @@ -42,7 +42,7 @@ defprimitive "2over",5,over2,REGULAR /* ( a b c d -- a b c d a b ) */ pop edx pop ecx pop ebx - pop eax + pop eax push eax push ebx push ecx @@ -54,13 +54,13 @@ defprimitive "2over",5,over2,REGULAR /* ( a b c d -- a b c d a b ) */ defprimitive "+",1,plus,REGULAR pop eax add [esp], eax - NEXT - + NEXT + defprimitive "-",1,minus,REGULAR pop eax sub [esp], eax - NEXT - + NEXT + defprimitive "*",1,multiply,REGULAR pop eax pop ebx @@ -77,21 +77,21 @@ defprimitive "/mod",4,divmod,REGULAR /* ( n d -- m q ) */ push edx push eax NEXT - + defprimitive "or",2,or,REGULAR pop eax or [esp], eax NEXT - + defprimitive "and",3,and,REGULAR pop eax and [esp], eax - NEXT + NEXT defprimitive "xor",3,xor,REGULAR pop eax xor [esp], eax - NEXT + NEXT defprimitive "lshift",6,lshift,REGULAR pop ecx @@ -108,26 +108,25 @@ defprimitive "rshift",6,rshift,REGULAR NEXT defprimitive "_emit",5,uemit,REGULAR - mov edx, 1 // length - pop eax - mov [var0], eax - mov ecx, OFFSET FLAT:var0 + mov edx, 1 // length + mov ecx, esp // emit right off the stack mov ebx, 1 // stdout mov eax, 4 // sys_write int 0x80 + pop ebx NEXT - + defprimitive "abort",5,abort,REGULAR mov esp, [stack_top] mov eax, 1 int 0x80 - + defprimitive "@",1,fetch,REGULAR pop eax mov ebx, [eax] push ebx NEXT - + defprimitive "!",1,store,REGULAR pop edi pop eax @@ -139,12 +138,12 @@ defprimitive "c!",2,storebyte,REGULAR pop eax stosb NEXT - + defprimitive "[']",3,btick,REGULAR // compile only lodsd push eax NEXT - + defprimitive "<",1,lt,REGULAR // only need to define this, all other comparisions are implemented in terms of lt pop eax pop ebx @@ -158,19 +157,16 @@ defprimitive "<",1,lt,REGULAR // only need to define this, all other com defprimitive "invert",6,invert,REGULAR not dword ptr [esp] NEXT - + defprimitive "branch",6,branch,REGULAR - lodsd - add esi, eax + add esi, dword ptr [esi] NEXT defprimitive "branch0",7,branch0,REGULAR - lodsd - pop ebx - test ebx, ebx - jnz nobranch0 - add esi, eax -nobranch0: + pop eax + test eax, eax + jz code_branch + lodsd // skip the the offs NEXT defprimitive ">r",2,rpush,REGULAR @@ -178,17 +174,17 @@ defprimitive ">r",2,rpush,REGULAR sub ebp, CELLS mov [ebp], eax NEXT - + defprimitive "r>",2,rpop,REGULAR mov eax, [ebp] add ebp, CELLS push eax - NEXT + NEXT defprimitive "i",1,i,REGULAR mov eax, [ebp] push eax - NEXT + NEXT defprimitive "j",1,j,REGULAR mov eax, [ebp + 2 * CELLS] @@ -198,6 +194,12 @@ defprimitive "j",1,j,REGULAR defprimitive "execute",7,execute,REGULAR pop eax jmp [eax] + +// this exit primitive is only used by the compiler, this is used for detecting word endings works some as regular exit +defprimitive "",6,end_word,REGULAR + mov esi, [ebp] + add ebp, CELLS + NEXT defprimitive "exit",4,exit,REGULAR mov esi, [ebp] @@ -221,16 +223,14 @@ defprimitive "rp!",3,rpstore,REGULAR NEXT defprimitive "readchar",8,readchar,REGULAR - mov ecx, OFFSET FLAT:var0 // buffer for one character xor ebx, ebx // reads from stdin (FD 0) - mov [ecx], ebx + push ebx // make room for buffer + mov ecx, esp mov eax, 3 // use syscall 3 (read) to read from stdin mov edx, 1 // read one character int 0x80 // invoke system call to read from stdin cmp eax, 0 // number bytes read - jbe code_abort - mov eax, [var0] - push eax + jbe code_abort NEXT // Different types of code words @@ -248,5 +248,15 @@ ENTERDOES: add eax, CELLS // eax points to the codeword field, skip tshi mov esi, [eax] // after the codeword there is the behaviour pointer add eax, CELLS // after the behaviour pointer there is the data field - push eax + push eax NEXT // jump to behavour + +ENTERCONST: + mov eax, [eax + CELLS] + push eax + NEXT + +ENTERVAR: + add eax, CELLS + push eax + NEXT diff --git a/arch/x86/punyforth b/arch/x86/punyforth deleted file mode 100755 index 9fce7a5..0000000 Binary files a/arch/x86/punyforth and /dev/null differ diff --git a/contrib/Glossary.of.Punyforth.Words.docx b/contrib/Glossary.of.Punyforth.Words.docx new file mode 100644 index 0000000..8132f56 Binary files /dev/null and b/contrib/Glossary.of.Punyforth.Words.docx differ diff --git a/contrib/Glossary.of.Punyforth.Words.pdf b/contrib/Glossary.of.Punyforth.Words.pdf new file mode 100644 index 0000000..0b7a4b0 Binary files /dev/null and b/contrib/Glossary.of.Punyforth.Words.pdf differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/.DS_Store b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/.DS_Store new file mode 100644 index 0000000..b1cba6e Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/.DS_Store differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/.classpath b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/.classpath new file mode 100644 index 0000000..e41076c --- /dev/null +++ b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/.classpath @@ -0,0 +1,7 @@ + + + + + + + diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/.project b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/.project new file mode 100644 index 0000000..f904145 --- /dev/null +++ b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/.project @@ -0,0 +1,17 @@ + + + ESP8266ForthLoader + + + + + + org.eclipse.jdt.core.javabuilder + + + + + + org.eclipse.jdt.core.javanature + + diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/.settings/org.eclipse.jdt.core.prefs b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/.settings/org.eclipse.jdt.core.prefs new file mode 100644 index 0000000..a698e59 --- /dev/null +++ b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/.settings/org.eclipse.jdt.core.prefs @@ -0,0 +1,12 @@ +eclipse.preferences.version=1 +org.eclipse.jdt.core.compiler.codegen.inlineJsrBytecode=enabled +org.eclipse.jdt.core.compiler.codegen.methodParameters=do not generate +org.eclipse.jdt.core.compiler.codegen.targetPlatform=1.8 +org.eclipse.jdt.core.compiler.codegen.unusedLocal=preserve +org.eclipse.jdt.core.compiler.compliance=1.8 +org.eclipse.jdt.core.compiler.debug.lineNumber=generate +org.eclipse.jdt.core.compiler.debug.localVariable=generate +org.eclipse.jdt.core.compiler.debug.sourceFile=generate +org.eclipse.jdt.core.compiler.problem.assertIdentifier=error +org.eclipse.jdt.core.compiler.problem.enumIdentifier=error +org.eclipse.jdt.core.compiler.source=1.8 diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/.DS_Store b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/.DS_Store new file mode 100644 index 0000000..5473dda Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/.DS_Store differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/CircularBuffer.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/CircularBuffer.class new file mode 100644 index 0000000..36c5df6 Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/CircularBuffer.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/CmdListStatusIntfc.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/CmdListStatusIntfc.class new file mode 100644 index 0000000..b9775a5 Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/CmdListStatusIntfc.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader$1.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader$1.class new file mode 100644 index 0000000..fdc2499 Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader$1.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader$2.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader$2.class new file mode 100644 index 0000000..c553057 Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader$2.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader$3.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader$3.class new file mode 100644 index 0000000..89a4505 Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader$3.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader$4.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader$4.class new file mode 100644 index 0000000..dad35da Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader$4.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader.class new file mode 100644 index 0000000..ea4db56 Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/FSM$1.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/FSM$1.class new file mode 100644 index 0000000..e9d0575 Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/FSM$1.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/FSM$MAIN_STATES.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/FSM$MAIN_STATES.class new file mode 100644 index 0000000..96fe5c6 Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/FSM$MAIN_STATES.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/FSM$SUB_STATES.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/FSM$SUB_STATES.class new file mode 100644 index 0000000..f3890da Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/FSM$SUB_STATES.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/FSM.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/FSM.class new file mode 100644 index 0000000..f3f9cec Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/FSM.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/SerialPortReader.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/SerialPortReader.class new file mode 100644 index 0000000..92bbd13 Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/SerialPortReader.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/TextOutputIntfc.class b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/TextOutputIntfc.class new file mode 100644 index 0000000..d8ae9fa Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/bin/com/craigl/esp8266punyforthloader/TextOutputIntfc.class differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/jars/.DS_Store b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/jars/.DS_Store new file mode 100644 index 0000000..5008ddf Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/jars/.DS_Store differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/jars/ESP8266PunyForthLoader.jar b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/jars/ESP8266PunyForthLoader.jar new file mode 100644 index 0000000..20db7ea Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/jars/ESP8266PunyForthLoader.jar differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/jars/jssc.jar b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/jars/jssc.jar new file mode 100644 index 0000000..eb74f15 Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/jars/jssc.jar differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/loader b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/loader new file mode 100755 index 0000000..2ff5d5c --- /dev/null +++ b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/loader @@ -0,0 +1,2 @@ +#!/bin/bash +java -cp .:./bin:./jars/* com.craigl.esp8266punyforthloader.ESP8266PunyForthLoader diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/manifest b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/manifest new file mode 100644 index 0000000..59499bc --- /dev/null +++ b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/manifest @@ -0,0 +1,2 @@ +Manifest-Version: 1.0 + diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/.DS_Store b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/.DS_Store new file mode 100644 index 0000000..5473dda Binary files /dev/null and b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/.DS_Store differ diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/CircularBuffer.java b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/CircularBuffer.java new file mode 100644 index 0000000..aa92aca --- /dev/null +++ b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/CircularBuffer.java @@ -0,0 +1,68 @@ +package com.craigl.esp8266punyforthloader; + +import java.util.Arrays; + +public class CircularBuffer { + + private byte data[]; + private int head; + private int tail; + + public CircularBuffer(int bufferSize) { + data = new byte[bufferSize]; + head = 0; + tail = 0; + } + + public synchronized void clear() { + head = 0; + tail = 0; + Arrays.fill(data, (byte) 0); + } + public synchronized boolean write(byte value) { + if (! isFull()) { + data[tail++] = value; + if (tail == data.length) { + tail = 0; + } + return true; + } else { + return false; + } + } + + public synchronized byte read() { + if (head != tail) { + byte value = data[head++]; + if (head == data.length) { + head = 0; + } + return value; + } else { + return 0; + } + } + + public synchronized byte peek() { + if (head != tail) { + Byte value = data[head]; + return value.byteValue(); + } else { + return 0; + } + } + + public boolean isEmpty() { + return (head == tail); + } + + public boolean isFull() { + if (tail + 1 == head) { + return true; + } + if (tail == (data.length - 1) && head == 0) { + return true; + } + return false; + } +} diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/CmdListStatusIntfc.java b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/CmdListStatusIntfc.java new file mode 100644 index 0000000..b839fd9 --- /dev/null +++ b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/CmdListStatusIntfc.java @@ -0,0 +1,7 @@ +package com.craigl.esp8266punyforthloader; + +public interface CmdListStatusIntfc { + + public void cmdListEmpty(); + +} diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader.java b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader.java new file mode 100644 index 0000000..0c9f3ba --- /dev/null +++ b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/ESP8266PunyForthLoader.java @@ -0,0 +1,491 @@ +package com.craigl.esp8266punyforthloader; + +import java.awt.*; +import java.awt.event.*; + +import javax.swing.*; + +import java.io.*; +import java.util.*; + +import jssc.*; + +import java.util.regex.Pattern; + +public class ESP8266PunyForthLoader extends JPanel implements + CmdListStatusIntfc { + + private static final long serialVersionUID = 1L; + private static final String ENTER_KEY = "\r\n"; + + private boolean processIncludeDirective(String cmd) { + + // Was it the include directive ? + if (cmd.indexOf("#include") != -1) { + int len = "#include ".length(); + String fn = cmd.substring(len); + + // Check for file existance before trying to read it + File f = new File(path + fn); + if (f.exists()) { + + // Create a buffered reader for the specified file + FileInputStream fstream = null; + try { + fstream = new FileInputStream(path + fn); + } catch (FileNotFoundException e) { + e.printStackTrace(); + } + // / Create buffered reader + BufferedReader br = new BufferedReader(new InputStreamReader( + fstream)); + + // Push reader onto include file stack + includeFileStack.push(br); + } else { + // Include file not found + outputTextArea.append("ERROR: include file: \"" + path + fn + + "\" not found"); + } + + return true; + } else { + return false; + } + } + + // Called when cmd list in FSM goes empty + public void cmdListEmpty() { + + // Is the include file stack not empty + if (!includeFileStack.empty()) { + + // Get reader for include file if available from stack + BufferedReader br = includeFileStack.peek(); + + // Are we processing an include file ? + if (br != null) { + // Yes so attempt to read a line of the file + String textLine = null; + + try { + // Read a line of text from the include file + textLine = br.readLine(); + + // Have we reached EOF ? + if (textLine != null) { + // Remove extraneous white space + textLine.trim(); + + // Does the line have any content ? + if (textLine.length() != 0) { + // Yes the line has content + + // Is this a comment line ? + if (textLine.startsWith("\\")) { + // Yes so ignore it. Now submit an empty cmd so + // FSM continues + textLine = ""; + } + + // Is this an include file directive ? + else if (processIncludeDirective(textLine)) { + // Yes it was. Include file processed. Now + // submit an empty cmd so FSM continues + textLine = ""; + } + } + // Submit line to FSM + fsm.submitCmd(textLine); + + } else { + + // EOF so close the include file + br.close(); + + // Pop include file off of include file stack + includeFileStack.pop(); + + // Submit empty cmd so FSM continues + fsm.submitCmd(""); + } + } catch (IOException e) { + e.printStackTrace(); + } + } + } + } + + // Open a serial port by port name + private boolean openSerialPort(String portName) { + + // If a port is already open, close it + if (serialPort != null) { + try { + serialPort.closePort(); + } catch (SerialPortException e) { + e.printStackTrace(); + } + } + serialPort = null; + portIsOpen = false; + + // Check for vaild port name + if ((portName == null) || (portName.length() == 0)) { + return false; + } + + // Attempt to open the selected serial port + serialPort = new SerialPort(portName); + + if (serialPort == null) { + return false; + } + + // Attempt to open the port + try { + // Open the selected serial port + serialPort.openPort(); + serialPort.setParams(115200, 8, 1, 0); + + int mask = SerialPort.MASK_RXCHAR;// Prepare mask + serialPort.setEventsMask(mask);// Set mask + + // Add listener for serial events + serialPort.addEventListener(new SerialPortReader(serialPort, cb)); + } catch (SerialPortException e) { + e.printStackTrace(); + return false; + } + + // Signal all is well + portIsOpen = true; + return true; + } + + // Close an open serial port + private void closeSerialPort() { + + // Only attempt port close if port is open + if (portIsOpen && (serialPort != null)) { + try { + serialPort.closePort(); + } catch (SerialPortException e) { + e.printStackTrace(); + } + serialPort = null; + portIsOpen = false; + } + } + + // Build UI and Go + public void run() { + + // Get the home directory for CForthLoader + path = env.get("FORTH_HOME") + "/"; + + // Indicate serial port is not yet open + portIsOpen = false; + + // Get the available serial port names + Pattern pattern = Pattern.compile("tty\\Q.\\E*"); + portNames = SerialPortList.getPortNames(pattern); + + // Create loader user interface + + // Create top panel + JPanel topPanel = new JPanel(); + topPanel.setLayout(new GridLayout(1, 3)); + + // Left label panel + topPanel.add(new JLabel("Serial Config - 115200B/S : 8B : 1SB : N", + JLabel.CENTER)); + + // Port combo box is not user editable + portComboBox.setEditable(false); + + // Add combo box to panel + topPanel.add(portComboBox); + + // New panel for button + JPanel buttonPanel = new JPanel(); + buttonPanel.setLayout(new GridLayout(1, 3)); + buttonPanel.add(new JPanel()); + + // Add action listener to the open/close port button + openClosePortButton.addActionListener(new ActionListener() { + public void actionPerformed(ActionEvent evt) { + if ((!portIsOpen) && haveSerialPorts) { + // Get what is selected in the combo box + String portName = (String) portComboBox.getSelectedItem(); + + if (!portName.equalsIgnoreCase("No Serial Ports found")) { + // Attempt to open the port + openSerialPort(portName); + + // Let the FSM know the serial port + fsm.setSerialPort(serialPort); + + // Set button text + openClosePortButton.setText("Close"); + + // Enable text input and give it focus + inputTextField.setEnabled(true); + inputTextField.requestFocus(); + } + } else { + // Port was open so close it + closeSerialPort(); + + // Set button text + openClosePortButton.setText("Open"); + + // Disable text input + inputTextField.setEnabled(false); + + // Clear the circular buffer + cb.clear(); + + // Clear command list + fsm.clearCmdList(); + } + } + }); + + // Add open/close button to panel + buttonPanel.add(openClosePortButton); + buttonPanel.add(new JPanel()); + topPanel.add(buttonPanel); + + // Create middle panel + JPanel midPanel = new JPanel(); + midPanel.setLayout(new BorderLayout()); + + // Create border around panel + midPanel.setBorder(BorderFactory.createEmptyBorder(10, 10, 10, 10)); + + JLabel label = new JLabel("--- Output Area ---", JLabel.CENTER); + label.setBackground(Color.LIGHT_GRAY); + label.setOpaque(true); + label.setBorder(BorderFactory.createLineBorder(Color.black, 2)); + midPanel.add(label, BorderLayout.NORTH); + + // Define output text area + outputTextArea.setEditable(false); + midPanel.add(outputTextScrollPane, BorderLayout.CENTER); + + // Create bottom panel + JPanel bottomPanel = new JPanel(); + bottomPanel.setLayout(new BorderLayout()); + + label = new JLabel( + "--- Input Area : Use up/down cursor keys for command history ---", + JLabel.CENTER); + label.setBackground(Color.LIGHT_GRAY); + label.setOpaque(true); + label.setBorder(BorderFactory.createLineBorder(Color.black, 2)); + + bottomPanel.add(label, BorderLayout.NORTH); + + // Add action listener to input text field + inputTextField.addActionListener(new ActionListener() { + public void actionPerformed(ActionEvent evt) { + + // Get what the user typed + String cmd = inputTextField.getText().trim(); + + // Don't add empty entries to the history list + if (cmd.length() != 0) { + // Record non-empty cmd in history list + cmdHistoryList.add(cmd); + } + + // Was it the include directive ? + if (processIncludeDirective(cmd)) { + cmd = ""; + } + + // Was it the clear directive ? + else if (cmd.indexOf("#clear") != -1) { + outputTextArea.setText(""); + cmd = ""; + } + + // Was it the help directive ? + else if (cmd.indexOf("#help") != -1) { + outputTextArea.setText(""); + outputTextArea + .append("ESP8266PunyForthLoader by Craig A. Lindley\n"); + outputTextArea + .append("\nESP8266PunyForthLoader Directives:\n\n"); + outputTextArea.append("#clear - Clears the Output Area\n"); + outputTextArea + .append("#bye - Terminates ESP8266PunyForthLoader\n"); + outputTextArea.append("#help - Shows this message\n"); + outputTextArea + .append("#include filename - Loads Forth code from a file\n"); + outputTextArea.append("\nNOTES:\n"); + outputTextArea + .append("1. Remember to have your ESP8266 device connected before starting ESP8266PunyForthLoader\n"); + outputTextArea + .append("2. Remember to set the FORTH_HOME environment variable if using include files\n"); + outputTextArea.append("3. #include files can be nested\n"); + outputTextArea + .append("4. Use the up/down cursor keys to access command history\n"); + outputTextArea + .append("\nQuestions/Comments to calhjh@gmail.com\n"); + + cmd = ""; + } + + // Was it the exit directive ? + else if (cmd.indexOf("#bye") != -1) { + cmd = "!bye_bye!"; + } + + // Send it to the FSM + fsm.submitCmd(cmd); + + // Clear text in field + inputTextField.setText(""); + + // Point index at final entry of history list + cmdHistoryListIndex = cmdHistoryList.size() - 1; + } + }); + + // Add a key listener to the input text field + inputTextField.addKeyListener(new java.awt.event.KeyAdapter() { + public void keyPressed(java.awt.event.KeyEvent evt) { + + // Get count of history list entries + int count = cmdHistoryList.size(); + + // Up arrow key ? + if (evt.getKeyCode() == KeyEvent.VK_UP) { + // Populate input area + inputTextField.setText(cmdHistoryList + .get(cmdHistoryListIndex)); + + cmdHistoryListIndex--; + if (cmdHistoryListIndex < 0) { + cmdHistoryListIndex = 0; + } + } + + // Down arrow key ? + if (evt.getKeyCode() == KeyEvent.VK_DOWN) { + cmdHistoryListIndex++; + if (cmdHistoryListIndex == count) { + cmdHistoryListIndex = count - 1; + inputTextField.setText(""); + } else { + inputTextField.setText(cmdHistoryList + .get(cmdHistoryListIndex)); + } + } + } + }); + + // Text field is initially disabled + inputTextField.setEnabled(false); + + // Add text field to panel + bottomPanel.add(inputTextField, BorderLayout.CENTER); + + // Create over all view + setLayout(new BorderLayout()); + add(topPanel, BorderLayout.NORTH); + add(midPanel, BorderLayout.CENTER); + add(bottomPanel, BorderLayout.SOUTH); + + // Create and set up the display window. + JFrame frame = new JFrame( + "ESP8266 Puny Forth Loader - Craig A. Lindley - Version: 0.1"); + frame.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE); + + // Add content to the window. + frame.add(this); + + // Display the window. + frame.pack(); + frame.setVisible(true); + + // Are serial ports available ? + haveSerialPorts = portNames.length != 0; + + // Populate combo box with serial ports, if any + if (haveSerialPorts) { + for (int i = 0; i < portNames.length; i++) { + String pns = portNames[i]; + portComboBox.addItem(pns); + } + } else { + portComboBox.addItem("No Serial Ports found"); + } + + // Create a circular buffer for the received serial data + cb = new CircularBuffer(20000); + + // Instantiate FSM + fsm = new FSM(cb, new TextOutputIntfc() { + public void outputText(String t) { + // Append the text + outputTextArea.append(t); + + // Make sure the new text is visible + outputTextArea.setCaretPosition(outputTextArea.getDocument() + .getLength()); + } + }, this); + + // Run the FSM + fsm.runFSM(); + + // Close the serial port + closeSerialPort(); + + // Terminate program + System.exit(0); + } + + // Private data + boolean haveSerialPorts; + String[] portNames; + boolean portIsOpen; + + // References to custom class objects + CircularBuffer cb = null; + SerialPort serialPort = null; + FSM fsm = null; + + // Environment variables map + Map env = System.getenv(); + String path; + + // Cmd history list + ArrayList cmdHistoryList = new ArrayList(); + int cmdHistoryListIndex; + + // Include file stack + Stack includeFileStack = new Stack(); + + // Instantiate UI controls + JComboBox portComboBox = new JComboBox(); + JButton openClosePortButton = new JButton("Open"); + JTextArea outputTextArea = new JTextArea(30, 60); + JScrollPane outputTextScrollPane = new JScrollPane(outputTextArea, + JScrollPane.VERTICAL_SCROLLBAR_AS_NEEDED, + JScrollPane.HORIZONTAL_SCROLLBAR_NEVER); + JTextField inputTextField = new JTextField(30); + + // Program entry point + public static void main(String[] args) { + + // Create app instance + ESP8266PunyForthLoader app = new ESP8266PunyForthLoader(); + + // Run it + app.run(); + } +} diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/FSM.java b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/FSM.java new file mode 100644 index 0000000..75ccf84 --- /dev/null +++ b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/FSM.java @@ -0,0 +1,249 @@ +package com.craigl.esp8266punyforthloader; + +import java.util.ArrayList; +import java.util.concurrent.TimeUnit; + +import jssc.*; + +/* + * Finite state machine for interacting with CForth host + */ +public class FSM { + + private static final String ENTER_KEY = "\r\n"; + + enum MAIN_STATES { + INIT, SEND_CHK, DELAY, RECV_CHK + }; + + enum SUB_STATES { + ST1, ST2, ST3, ST4, ST5, ST6, ST7, ST8 + }; + + // Class constructor + public FSM(CircularBuffer cb, TextOutputIntfc out, CmdListStatusIntfc intfc) { + + // Save incoming + _port = null; + _cb = cb; + _out = out; + _intfc = intfc; + + // Set initial state of FSM + state = MAIN_STATES.INIT; + + // Set initial state of sub FSM + subState = SUB_STATES.ST1; + } + + public void setSerialPort(SerialPort port) { + _port = port; + } + + public void clearCmdList() { + cmdList.clear(); + } + + // Submit a forth command that will be executed at the proper time + public void submitCmd(String cmd) { + + // Trim up command string + cmd.trim(); + + cmd += ENTER_KEY; + + // Add cmd to the list of possible other commands + cmdList.add(cmd); + } + + // Run the finite state machine for CForth interaction + public void runFSM() { + + while (true) { + + switch (state) { + + case INIT: + + // Indicate a cmd can be sent + okFound = true; + + compiling = false; + prevByte = 0; + + // Set initial state of state machine + state = MAIN_STATES.SEND_CHK; + + break; + + case SEND_CHK: + + if (okFound && (cmdList.size() != 0)) { + + // Cmd can be sent so fetch the oldest to execute + String cmd = cmdList.remove(0); + + // End FSM execution + if (cmd.indexOf("!bye_bye!") != -1) { + return; + } + + // Check for start of compilation + if (cmd.startsWith(":")) { + compiling = true; + } + + // Check for end of compilation + if (cmd.endsWith(";")) { + compiling = false; + } + try { + // Write the cmd to the serial port + _port.writeString(cmd); + + // Output the cmd to terminal + _out.outputText(cmd); + + } catch (SerialPortException e) { + e.printStackTrace(); + } + + // Can't send another cmd until Puny Forth says it's OK + okFound = false; + + // Is the cmd list now empty ? + if (cmdList.size() == 0) { + // Yes, signal the event + _intfc.cmdListEmpty(); + + } + } + // Set next state + state = MAIN_STATES.DELAY; + break; + + case DELAY: + + try { + TimeUnit.MILLISECONDS.sleep(1); + } catch (InterruptedException e) { + e.printStackTrace(); + } + + // Set next state + state = MAIN_STATES.RECV_CHK; + break; + + case RECV_CHK: + + // Are there received bytes to process ? + if (!_cb.isEmpty()) { + + // Yes there are + byte b = _cb.read(); + + // Output the character + _out.outputText("" + ((char) b)); + + // Are we in a multi line definition ? + if ((b == '.') && (prevByte == '.') && (_cb.peek() == ' ') && compiling) { + okFound = true; + + } else { + + switch (subState) { + case ST1: + // Do we have an opening paren ? + if (b == '(') { + subState = SUB_STATES.ST2; + } + break; + + case ST2: + // Do we have an s ? + if (b == 's') { + subState = SUB_STATES.ST3; + } else { + subState = SUB_STATES.ST1; + } + break; + + case ST3: + // Do we have a t ? + if (b == 't') { + subState = SUB_STATES.ST4; + } else { + subState = SUB_STATES.ST1; + } + break; + + case ST4: + // Do we have an a ? + if (b == 'a') { + subState = SUB_STATES.ST5; + } else { + subState = SUB_STATES.ST1; + } + break; + + case ST5: + // Do we have a c ? + if (b == 'c') { + subState = SUB_STATES.ST6; + } else { + subState = SUB_STATES.ST1; + } + break; + + case ST6: + // Do we have a k ? + if (b == 'k') { + subState = SUB_STATES.ST7; + } else { + subState = SUB_STATES.ST1; + } + break; + + case ST7: + // We have (stack so ignore all chars until closing + // paren + if (b == ')') { + subState = SUB_STATES.ST8; + } + break; + + case ST8: + // Do we have a space ? + if (b == ' ') { + // Start the state machine over + subState = SUB_STATES.ST1; + + // Indicate we are ready for the next command + okFound = true; + } + break; + } + } + // Save previous byte + prevByte = b; + } + // Set next state + state = MAIN_STATES.SEND_CHK; + break; + } + } + } + + // Private data + SerialPort _port; + CircularBuffer _cb; + TextOutputIntfc _out; + CmdListStatusIntfc _intfc; + + MAIN_STATES state; + SUB_STATES subState; + ArrayList cmdList = new ArrayList(); + int arrayListIndex; + boolean okFound, compiling; + byte prevByte; +} diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/SerialPortReader.java b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/SerialPortReader.java new file mode 100644 index 0000000..5d8c443 --- /dev/null +++ b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/SerialPortReader.java @@ -0,0 +1,43 @@ +package com.craigl.esp8266punyforthloader; + +import jssc.*; + +/* + * This class must implement the method serialEvent, through which we learn about + * events that happened to our port. In this case the arrival of the data. + */ + +public class SerialPortReader implements SerialPortEventListener { + + // Class constructor + public SerialPortReader(SerialPort port, CircularBuffer cb) { + + // Save incoming + _port = port; + _cb = cb; + } + + public void serialEvent(SerialPortEvent event) { + + if (event.isRXCHAR()) { + // Check if data is available + if (event.getEventValue() >= 1) { + // Data is available so write it to the Circular Buffer + try { + byte [] byteArray = _port.readBytes(); + for (int i = 0; i < byteArray.length; i++) { + byte b = byteArray[i]; + _cb.write(b); + } + } + catch (SerialPortException ex) { + System.out.println(ex); + } + } + } + } + + // Private data + CircularBuffer _cb; + SerialPort _port; +} diff --git a/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/TextOutputIntfc.java b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/TextOutputIntfc.java new file mode 100644 index 0000000..2ffd05a --- /dev/null +++ b/contrib/loader_by_Craig_Lindley/ESP8266PunyForthLoader/src/com/craigl/esp8266punyforthloader/TextOutputIntfc.java @@ -0,0 +1,7 @@ +package com.craigl.esp8266punyforthloader; + +public interface TextOutputIntfc { + + public void outputText(String t); + +} diff --git a/contrib/loader_by_Craig_Lindley/readme.txt b/contrib/loader_by_Craig_Lindley/readme.txt new file mode 100644 index 0000000..1e3829f --- /dev/null +++ b/contrib/loader_by_Craig_Lindley/readme.txt @@ -0,0 +1,38 @@ +ESP8266PunyForthLoader Running Instructions +Craig A. Lindley +January 2017 + +Prerequisites +==================== +1. ESP8266PunyForthLoader.jar +2. jssc.jar (version 2.6.0 or newer) + +Executing From Shell +==================== +1. Change directory to where the Punyforth jar files are located +2. export FORTH_HOME=<“full path to directory with esp8266punyforth project files>†+3. export CLASSPATH=“./ESP8266PunyForthLoader.jar:./jssc.jar†+4. java com.craigl.esp8266punyforthloader.ESP8266PunyForthLoader + +Alternatively add the following to your .profile file in your home directory +==================== +# Items for ESP8266PunyForthLoader for ESP8266 +export FORTH_HOME=~/Documents/dev/ESP8266PunyForthLoader/projects +export CLASSPATH=~/Documents/dev/ESP8266PunyForthLoader/ESP8266PunyForthLoader.jar:~/Documents/dev/ESP8266PunyForthLoader/jssc.jar +alias pfl="java com.craigl.esp8266punyforthloader.ESP8266PunyForthLoader" + +Operation +==================== +1. Connect your ESP8266Forth device to your computer +2. Execute ESP8266PunyForthLoader as described above +3. Once loader is operational, select appropriate Serial Port from drop down list +4. Click Open button in the UI to open the selected Serial Port +5. Type #help into the Input Area to see the help info +6. Type ESP8266PunyForth commands to interact with ESP8266PunyForth +7. Type #include to load Forth code from a file +8. Use up/down cursor keys to retrieve command history +9. Type #bye to terminate ESP8266PunyForthLoader + + +NOTES: +1. ESP8266PunyForthLoader’s window can be resized as necessary diff --git a/contrib/mqtt/mqtt.forth b/contrib/mqtt/mqtt.forth new file mode 100644 index 0000000..ff497e4 --- /dev/null +++ b/contrib/mqtt/mqtt.forth @@ -0,0 +1,154 @@ + +\ common words for communication with mqtt broker +NETCON load + + +\ configuration for communicating with your broker +"192.168.1.172" constant: broker_addr +1883 constant: broker_port +"YourMQTT-ClientId" constant: mqtt-clientid + +\ mqtt message types +\ 10 = CONNECT message type +16r10 constant: msgtype_connect +16r20 constant: msgtype_conact +16rE0 constant: msgtype_disconnect +16r30 constant: msgtype_publish +16r82 constant: msgtype_subscribe +16r90 constant: msgtype_subresp + +\ socket reference to broker +variable: broker + +\ communication packet buffer. expect small packets +255 constant: packet_size +packet_size byte-array: packet +\ paki is an index into packet byte array when building the packet +\ note that the packet size to send is 1+ the paki value +variable: paki + +\ store two byte number into an address +: !pack-num ( num addr -- ) + 2dup + \ store high order byte to address + swap 8 rshift swap c! + \ store low order byte to address+1 + 1+ c! ; + +\ store string at an address +: !str ( s addr -- ) + swap dup strlen ( addr s len ) + rot swap ( s addr len ) + cmove ; + +\ store string into len+string struct that mqtt likes (packed string) +: !pack-str ( s addr -- len) + 2dup ( s addr s addr) + swap strlen dup >r swap ( s addr len addr) + !pack-num ( s addr) + \ fill rest of buffer with the string + 2 + ( s addr ) + r> dup >r ( s addr len ) + cmove ( ) + \ return length of string we just stored plus the length of num + r> 2 + + ; + +\ establish tcp socket connection to broker +: mqtt-con broker_port broker_addr TCP netcon-connect broker ! ; +: mqtt-close broker @ netcon-dispose ; +\ send packet to broker +: send-pak broker @ rot rot netcon-write-buf ; +: send-packet 0 packet paki @ send-pak ; +\ store single byte character in packet +: !c-packet ( c -- ) paki @ packet c! 1 paki +! ; +\ store packed string in packet +: !str-packet ( s -- ) paki @ packet !pack-str paki +! ; +\ store message length in the packet header ie. packet size - 2 +: !packet-len paki @ 2 - 1 packet c! ; + +\ stores mqtt CONNECT command into packet +: make-packet-connect + \ initialize the index into the byte-array + 0 paki ! + msgtype_connect !c-packet + 1 paki +! + \ msg len, must be calculated at the end + \ protocol name + "MQTT" !str-packet + \ protocol version + 16r04 !c-packet + \ flags + 16r02 !c-packet + \ keep-alive + 60 paki @ packet !pack-num + 2 paki +! + \ clientid + mqtt-clientid !str-packet + !packet-len + ; + +: make-packet-disconnect ( -- ) + 0 paki ! + msgtype_disconnect !c-packet + 1 paki +! + \ 2 - 2 = 0, will store 0 + !packet-len ; + +: make-packet-publish ( topic msg -- ) + 0 paki ! + msgtype_publish !c-packet + 1 paki +! + \ store topic with length + swap !str-packet + dup strlen swap paki @ packet !str paki +! + !packet-len ; + +\ compare buffer contents +: =buf ( b1 b2 n -- T|F) + 0 do + 2dup + i + c@ swap i + c@ <> if + 2drop unloop FALSE exit then + loop + 2drop TRUE ; + +\ read message from broker into packet and store length +: read-broker broker @ packet_size 0 packet netcon-read + paki ! ; + +\ compare broker response to expected response +: expect ( buf n -- TRUE | FALSE) + paki @ + dup -1 = if \ no bytes read from broker + 2drop FALSE exit + then + dup rot <> if \ did not read the expected number of bytes + 2drop FALSE exit + then + 0 packet swap =buf ; + +create: pak-conack 16r20 c, 16r02 c, 16r00 c, 16r00 c, +create: pak-disconnect 16re0 c, 16r00 c, + +: expect-conack pak-conack 4 expect ; + +: print-results + if + println: "Success" else println: "Failed" + print: "got " paki @ . print: " bytes" cr + then + 0 packet 10 dump ; + +: mqtt-pub + make-packet-connect mqtt-con send-packet + read-broker expect-conack if + make-packet-publish send-packet + pak-disconnect 2 send-pak + then mqtt-close ; + +\ example usage +\ "house/t1" "testmessage" mqtt-pub +\ print-results +/end + diff --git a/contrib/mqtt/readme.md b/contrib/mqtt/readme.md new file mode 100644 index 0000000..4ffb7d0 --- /dev/null +++ b/contrib/mqtt/readme.md @@ -0,0 +1,30 @@ +# MQTT for PunyForth + +* MQTT.forth allows the 8266 to publish messages onto a MQTT message queue using PunyForth +* So far, only pub has been implemented (no sub yet) + +# Instructions +Edit the configuration section in the mqtt.forth file. Specifically, enter the ip address of your mqtt broker. Then upload mqtt.forth to your 8266 board. Publish a message using +``` +"topic" "message" mqtt_pub +``` +If you do not have a broker to test with then install mosquitto. +``` +sudo apt-get install mosquitto mosquitto-clients +``` +The broker will run automatically but to see broker diagnostics messages use something like +``` +sudo /etc/init.d/mosquitto stop +hostname -I +mosquitto -v +``` +and subscribe to a topic using +``` +mosquitto_sub -h YOUR_IP_ADDRESS -t "YOUR_TOPIC" -d +``` +If everything is working then you will see the published messages in your subscriber terminal. +# Contact + +Contact dfoderick@gmail.com +Dave Foderick + diff --git a/contrib/worldclock/core.forth b/contrib/worldclock/core.forth new file mode 100644 index 0000000..5e8b0ed --- /dev/null +++ b/contrib/worldclock/core.forth @@ -0,0 +1,458 @@ +: interpret? state @ 0= ; +: backref, here - cell - , ; + +: begin immediate compile-time + here ; + +: again immediate compile-time + ['] branch , backref, ; + +: until immediate compile-time + ['] branch0 , backref, ; + +: char: word drop c@ ; + +: ( begin key [ char: ) ] literal = until ; immediate +: \ begin key dup 13 = swap 10 = or until ; immediate + +: dip ( a xt -- a ) swap >r execute r> ; +: keep ( a xt -- xt.a a ) over >r execute r> ; +: bi ( a xt1 xt2 -- xt1.a xt2.a ) ['] keep dip execute ; +: bi* ( a b xt1 xt2 -- xt1.a xt2.b ) ['] dip dip execute ; +: bi@ ( a b xt -- xt.a xt.b ) dup bi* ; + +: 3dup ( a b c -- a b c a b c) dup 2over rot ; +: 3drop ( a b c -- ) 2drop drop ; + +: cr ( -- ) 13 emit 10 emit ; +: space ( -- ) 32 emit ; + +: % ( n -- remainder ) /mod drop ; +: / ( n -- quotient ) /mod nip ; + +: +! ( n var -- ) dup @ rot + swap ! ; + +: prepare-forward-ref ( -- a) here 0 , ; +: resolve-forward-ref ( a -- ) dup here swap - cell - swap ! ; + +: if immediate compile-time + ['] branch0 , prepare-forward-ref ; + +: else immediate compile-time + ['] branch , prepare-forward-ref swap + resolve-forward-ref ; + +: then immediate compile-time + resolve-forward-ref ; + +: ?dup ( a -- a a | 0 ) dup if dup then ; + +: . ( n -- ) + dup 0< if 45 emit -1 * then + 10 /mod ?dup if . then + 48 + emit ; + +: ? ( a -- ) @ . ; + +: unloop r> r> r> 2drop >r ; + +: do immediate compile-time + ['] swap , ['] >r , ['] >r , + here ; \ prepare backref + +: bounds ( start len -- limit start ) + over + swap ; + +: loop immediate compile-time + ['] r> , ['] 1+ , ['] >r , + ['] i , ['] rp@ , ['] cell , ['] + , ['] @ , \ index limit + ['] >= , ['] branch0 , backref, + ['] unloop , ; + +: end? ( increment -- bool ) + rp@ cell + @ \ i+increment + rp@ 2 cells + @ \ limit + - dup rot - xor 0< ; \ (index-limit) and (index-limit+increment) have different sign? + +: +loop immediate compile-time + ['] dup , \ increment + ['] rp@ , ['] +! , + ['] end? , ['] branch0 , backref, + ['] unloop , ; + +: while immediate compile-time + ['] branch0 , prepare-forward-ref ; + +: repeat immediate compile-time + swap + ['] branch , backref, + resolve-forward-ref ; + +: case ( -- branch-counter ) immediate compile-time 0 ; + +: of immediate compile-time + ['] over , ['] = , + ['] branch0 , prepare-forward-ref + ['] drop , ; + +: endof immediate compile-time + swap 1+ swap \ increase number of branches + ['] branch , prepare-forward-ref swap + resolve-forward-ref + swap ; \ keep branch counter at TOS + +: endcase ( #branches #branchesi*a -- ) immediate compile-time + 0 do + resolve-forward-ref + loop ; + +: override immediate ( -- ) lastword hide ; + +: nop ; +: create: createheader enterdoes , ['] nop cell + , ; \ default behaviour is nop, does> overwrites this +: does> r> lastword link>body ! ; + +: constant: create: , does> @ ; +: init-variable: create: , ; +: variable: 0 init-variable: ; + +-1 constant: TRUE + 0 constant: FALSE + +: exception: ( "name" -- ) ( -- xt ) + create: lastword , + does> @ ; + +exception: EUNDERFLOW +exception: EOVERFLOW +exception: EASSERT +exception: ENOTFOUND +exception: ECONVERT +exception: EESCAPE + +: ['], ['] ['] , ; + +: defer: ( "name" -- ) + create: ['] nop , + does> @ execute ; + +: defer! ( dst-xt src-xt -- ) swap 2 cells + ! ; \ store xt as body + +defer: unhandled +defer: handler +0 init-variable: var-handler \ stores the address of the nearest exception handler +: single-handler ( -- a ) var-handler ; \ single threaded global handler + +: catch ( xt -- exception | 0 ) + sp@ >r handler @ >r \ save current stack pointer and previous handler (RS: sp h) + rp@ handler ! \ set the currend handler to this + execute \ execute word that potentially throws exception + r> handler ! \ word returned without exception, restore previous handler + r> drop 0 ; \ drop the saved sp return 0 indicating no error + +: throw ( i*x exception -- i*x exception | 0 ) + dup 0= if drop exit then \ 0 means no error, drop errorcode exit from execute + handler @ 0= if \ this was an uncaught exception + unhandled + exit + then + handler @ rp! \ restore rstack, now it is the same as it was before execute + r> handler ! \ restore next handler + r> swap >r sp! \ restore the data stack as it was before the most recent catch + drop r> ; \ return to the caller of most recent catch with the errcode + +: { immediate compile-time + ['], here 3 cells + , + ['] branch , prepare-forward-ref + entercol , ; + +: } immediate compile-time + ['] exit , + resolve-forward-ref ; + +: ' ( -- xt | throws:ENOTFOUND ) \ find the xt of the next word in the inputstream + word find dup if + link>xt + else + ENOTFOUND throw + then ; + +' handler ' single-handler defer! + +: postpone: ( -- | throws:ENOTFOUND ) ' , ; immediate \ force compile semantics of an immediate word + +: is: immediate + interpret? if + ' defer! + else + ['], ' , ['] defer! , + then ; + +: byte-array: ( size "name" -- ) ( index -- addr ) + create: allot + does> swap + ; + +: buffer: ( size "name" -- ) ( -- addr ) + create: allot ; + +: struct 0 ; +: field: create: over , + does> @ + ; + +: abs ( n -- n ) dup 0< if invert 1+ then ; +: max ( a b -- max ) 2dup < if nip else drop then ; +: min ( a b -- min ) 2dup < if drop else nip then ; +: between? ( min-inclusive num max-inclusive -- bool ) over >= -rot <= and ; + +: cmove ( src-addr dst-addr count -- ) + ?dup 0 <= if 2drop exit then + 0 do + 2dup { c@ } dip c! + { 1+ } bi@ + loop + 2drop ; + +: [str ( -- address-to-fill-in ) + ['], here 3 cells + , \ compile return value: address of string + ['] branch , \ compile branch that will skip the string + here \ address of the dummy address + 0 , ; \ dummy address + +: str] ( address-to-fill-in -- ) + 0 c, \ terminate string + dup here swap - cell - swap ! ; \ calculate and store relative address + +: eschr ( char -- char ) \ read next char from stdin + dup [ char: \ ] literal = if + drop key case + [ char: r ] literal of 13 endof + [ char: n ] literal of 10 endof + [ char: t ] literal of 9 endof + [ char: \ ] literal of 92 endof + [ char: " ] literal of 34 endof \ CAL + EESCAPE throw + endcase + then ; + +: whitespace? ( char -- bool ) + case + 32 of TRUE exit endof + 13 of TRUE exit endof + 10 of TRUE exit endof + 9 of TRUE exit endof + drop FALSE + endcase ; + +: line-break? ( char -- bool ) + dup 10 = swap 13 = or ; + +: c,-until ( separator -- ) + begin + key 2dup <> + while + dup line-break? if + drop + else + eschr c, + then + repeat + 2drop ; \ drop last key and separator + +: separator ( -- char ) + begin + key dup whitespace? + while + drop + repeat ; + +: str: ( "string content" ) immediate + separator + interpret? if + align! here swap c,-until 0 c, + else + [str swap c,-until str] + then ; + +: strlen ( str -- len ) + 0 swap + begin + dup c@ + while + ['] 1+ bi@ + repeat + drop ; + +\ : =str ( str1 str2 -- bool ) +\ begin +\ 2dup ['] c@ bi@ +\ 2dup ['] 0<> bi@ and +\ -rot = and +\ while +\ ['] 1+ bi@ +\ repeat +\ ['] c@ bi@ ['] 0= bi@ and ; + +: str-starts? ( str substr -- bool ) + begin + 2dup ['] c@ bi@ + dup 0= if \ end of substr + 4drop TRUE exit + then + swap + dup 0= if \ end of str + 4drop FALSE exit + then + <> if \ character mismatch + 2drop FALSE exit + then + ['] 1+ bi@ + again ; + +: str-in? ( str substr -- bool ) + begin + 2dup str-starts? if + 2drop TRUE exit + then + swap dup c@ 0= if + 2drop FALSE exit + then + 1+ swap + again ; + +\ : >s' ( ? addr n -- addr2 ? ) +\ 10 /mod ?dup if rot swap >s' then +\ 48 + over c! 1+ swap ; + +\ : >str ( addr n -- ) +\ dup 0< if abs >r 45 over c! 1+ r> then +\ 0 -rot >s' +\ 0 rot c! drop ; + +: hexchar>int ( char -- n | throws:ECONVERT ) + 48 over 57 between? if 48 - exit then + 65 over 70 between? if 55 - exit then + 97 over 102 between? if 87 - exit then + ECONVERT throw ; + +: hex>int' ( str len -- n | throws:ECONVERT ) + dup 0= if ECONVERT throw then + dup 1- 2 lshift 0 swap + 2swap 0 do + dup >r + c@ hexchar>int + over lshift rot + + swap 4 - + r> 1+ + loop + 2drop ; + +: hex>int ( str -- n | throws:ECONVERT ) dup strlen hex>int' ; + +: hex: immediate + word hex>int' + interpret? invert if ['], , then ; + +: print: ( "string" ) immediate + interpret? if + separator + begin + key 2dup <> + while + eschr emit + repeat + 2drop + else + postpone: str: ['] type , + then ; + +: println: ( "string" ) immediate + interpret? if + str: "print:" 6 find link>xt execute cr \ XXX + else + postpone: str: ['] type , ['] cr , + then ; + +defer: s0 ' s0 is: _s0 +defer: r0 ' r0 is: _r0 + +: depth ( -- n ) s0 sp@ - cell / 1- ; +: rdepth ( -- n ) r0 rp@ - cell / 1- ; + +: link-type ( link -- ) + ['] link>name ['] link>len bi + type-counted ; + +: words ( -- ) + lastword + begin + ?dup + while + dup link-type cr @ + repeat ; + +: stack-print ( -- ) + depth 0= if exit then + depth 10 > if print: ".. " then + 0 depth 2 - 9 min \ maximalize depth to print + do + sp@ i cells + @ . + i if space then + -1 + +loop ; + +\ : stack-clear ( i*x -- ) +\ depth 0= if exit then +\ depth 0 do drop loop ; + + : stack-show ( -- ) + { + depth 0< if EUNDERFLOW throw then + interpret? if + print: '(stack' + depth if space then + stack-print + [ char: ) ] literal emit space + else + print: '.. ' + then + } prompt ! ; + +\ : stack-hide ( -- ) 0 prompt ! ; + +: heap? ( a -- bool ) heap-start swap heap-end between? ; +: freemem ( -- n ) heap-end dp - ; + +: ex-type ( exception -- ) + dup heap? if + link-type + else + . + then ; + +: traceback ( code -- ) + cr print: "Exeption: " ex-type + print: " rdepth: " rdepth . cr + rdepth 1 + 3 do \ include ret address in outer interpreter + print: " at " + rp@ i cells + @ \ i. return address + lastword + begin + 2dup < + over 0<> and + while + @ + repeat + ?dup 0<> if + link-type space + else + print: '??? ' + then + [ char: ( ] literal emit . [ char: ) ] literal emit cr + loop + depth 0> if + print: '(stack ' + stack-print + [ char: ) ] literal emit + then + abort ; + +' unhandled is: traceback diff --git a/contrib/worldclock/worldclock.forth b/contrib/worldclock/worldclock.forth new file mode 100644 index 0000000..d0d3b75 --- /dev/null +++ b/contrib/worldclock/worldclock.forth @@ -0,0 +1,1578 @@ +\ World Clock App + +\ Misc Forth Utilities +\ Written for PunyForth +\ By: Craig A. Lindley and others +\ Last Update: 01/21/2017 + +\ (* Surround multiline comments with these *) +: (* + begin + begin key [ char: * ] literal = until + key [ char: ) ] literal = + if + exit + then + again +; immediate + +\ Add missing functions +: negate -1 * ; + +: r@ ( -- n ) + r> r> dup >r swap >r ; +; + +\ ST7735 65K Color LCD Display Driver for the Adafruit 1.8" SPI LCD +\ Only supports landscape mode with LCD connector on right +\ Written for PunyForth +\ By: Craig A. Lindley +\ Last Update: 01/21/2017 +\ Must have core and gpio modules loaded + +\ Define the wiring between the NodeMCU Amica and the LCD display +14 constant: SCL \ SCL D5 +13 constant: SDA \ SDA D7 + 2 constant: DC \ DC D4 +15 constant: CS \ CS D8 +\ NOTE: the RESET and LITE signals on the LCD are tied to 3.3VDC + +\ SPI interface number +1 constant: BUS + +\ Define some 16 bit color values +hex: 0000 constant: BLK +hex: F800 constant: RED +hex: FFE0 constant: YEL +hex: 07E0 constant: GRN +hex: 001F constant: BLU +hex: 07FF constant: CYA +hex: F81F constant: MAG +hex: FFFF constant: WHT + +\ ST7735 commands +hex: 01 constant: SWRST \ software reset +hex: 11 constant: SLPOUT \ sleep out +hex: 29 constant: DISPON \ display on +hex: 2A constant: CASET \ column address set +hex: 2B constant: RASET \ row address set +hex: 2C constant: RAMWR \ RAM write +hex: 36 constant: MADCTL \ pixel direction control +hex: 3A constant: COLMOD \ color mode + +\ Display rotation constants +hex: 80 constant: CTL_MY +hex: 40 constant: CTL_MX +hex: 20 constant: CTL_MV +\ hex: 08 constant: CTL_BGR + +exception: EST7735 + +\ Display dimensions in landscape mode +160 constant: WIDTH +128 constant: HEIGHT + +\ Check result of SPI write +: cWrt ( code -- | EST7735 ) + 255 <> if + EST7735 throw + then +; + +\ Write an 8 bit command to the display via SPI +: wCmd ( cmd -- | EST7735 ) + DC GPIO_LOW gpio-write + CS GPIO_LOW gpio-write + BUS spi-send8 + cWrt + CS GPIO_HIGH gpio-write +; + +\ Write 8 bit data to the display via SPI +: w8 ( data -- | EST7735 ) + DC GPIO_HIGH gpio-write + CS GPIO_LOW gpio-write + BUS spi-send8 + cWrt + CS GPIO_HIGH gpio-write +; + +\ Write 16 bit data to the display via SPI +: w16 ( data -- | EST7735 ) + DC GPIO_HIGH gpio-write + CS GPIO_LOW gpio-write + dup + 8 rshift BUS spi-send8 + cWrt + hex: FF and BUS spi-send8 + cWrt + CS GPIO_HIGH gpio-write +; + +\ Initialize the SPI interface and the display controller +: initLCD ( -- | EST7735 ) + + \ Initilize GPIO pins + DC GPIO_OUT gpio-mode + CS GPIO_OUT gpio-mode + DC GPIO_LOW gpio-write + CS GPIO_HIGH gpio-write + + \ Setup SPI interface + TRUE 1 TRUE 2 10 16 lshift swap 65535 and or 0 BUS + spi-init 1 <> if + EST7735 throw + then + + \ Initialize the display controller for operation + SWRST wCmd + 200 ms + SLPOUT wCmd + 500 ms + \ Set 16 bit color + COLMOD wCmd + 100 ms + hex: 05 w8 + 100 ms + MADCTL wCmd + \ Must add CTL_BGR for Sainsmart display + CTL_MY CTL_MV or w8 + 100 ms + DISPON wCmd + 200 ms +; + +\ Temp variables +variable: _wx0_ +variable: _wy0_ +variable: _wx1_ +variable: _wy1_ + +\ Sets a rectangular display window into which pixel data is written +\ Values should be set into variable above before call +: setWin ( -- ) + CASET wCmd + _wx0_ @ w16 + _wx1_ @ w16 + RASET wCmd + _wy0_ @ w16 + _wy1_ @ w16 + RAMWR wCmd +; + +\ Graphic Functions for the ST7735 65K Color LCD Controller +\ Written for PunyForth +\ By: Craig A. Lindley +\ Last Update: 01/21/2017 +\ Must have ST7735 loaded + +\ Temp variables +variable: _w_ +variable: _h_ + +\ Draw a pixel on the display +: pixel ( x y color -- ) + >r + dup _wy0_ ! _wy1_ ! + dup _wx0_ ! _wx1_ ! + setWin + r> + w16 ; + + +\ Fill a rectangle on the display +: fillRect ( x0 y0 x1 y1 color -- ) + >r + _wy1_ ! _wx1_ ! _wy0_ ! _wx0_ ! + _wx1_ @ _wx0_ @ - 1+ _w_ ! + _wy1_ @ _wy0_ @ - 1+ _h_ ! + + setWin + r> + _w_ @ _h_ @ * 0 + do + dup w16 + loop + drop ; + +\ Draw horizontal line of length with color +: hLine ( x y len color -- ) + >r ( x y len color -- x y len ) + >r ( x y len -- x y ) + over over ( x y -- x y x y ) + swap ( x y x y -- x y y x ) + r> ( x y y x --- x y y x len ) + + ( x y y x len -- x y y x+len ) + swap ( x y y x+len -- x y x+len y ) + r> ( x y x+len y -- x y x+len y color ) + fillRect ( x y x+len y color -- ) +; + + +\ Draw vertical line of length with color +: vLine ( x y len color -- ) + >r ( x y len color -- x y len ) + over ( x y len -- x y len y ) + + ( x y len y -- x y y+len ) + >r ( x y y+len -- x y ) + over ( x y -- x y x ) + r> ( x y x -- x y x y+len ) + r> ( x y x y+len -- x y x y+len color ) + fillRect ( x y x y+len color -- ) +; + +\ Text Functions for the ST7735 65K Color LCD Controller +\ Written for PunyForth +\ By: Craig A. Lindley +\ Last Update: 01/21/2017 + +5 constant: FW +7 constant: FH + +\ 5x7 font for characters 0x20 .. 0x7E +create: FNT +hex: 00 c, hex: 00 c, hex: 00 c, hex: 00 c, hex: 00 c, \ space +hex: 00 c, hex: 00 c, hex: 5F c, hex: 00 c, hex: 00 c, \ ! +hex: 00 c, hex: 07 c, hex: 00 c, hex: 07 c, hex: 00 c, \ " +hex: 14 c, hex: 7F c, hex: 14 c, hex: 7F c, hex: 14 c, \ # +hex: 24 c, hex: 2A c, hex: 7F c, hex: 2A c, hex: 12 c, \ $ +hex: 23 c, hex: 13 c, hex: 08 c, hex: 64 c, hex: 62 c, \ % +hex: 36 c, hex: 49 c, hex: 56 c, hex: 20 c, hex: 50 c, \ & +hex: 00 c, hex: 08 c, hex: 07 c, hex: 03 c, hex: 00 c, \ ' +hex: 00 c, hex: 1C c, hex: 22 c, hex: 41 c, hex: 00 c, \ ( +hex: 00 c, hex: 41 c, hex: 22 c, hex: 1C c, hex: 00 c, \ ) +hex: 2A c, hex: 1C c, hex: 7F c, hex: 1C c, hex: 2A c, \ * +hex: 08 c, hex: 08 c, hex: 3E c, hex: 08 c, hex: 08 c, \ + +hex: 00 c, hex: 80 c, hex: 70 c, hex: 30 c, hex: 00 c, \ , +hex: 08 c, hex: 08 c, hex: 08 c, hex: 08 c, hex: 08 c, \ - +hex: 00 c, hex: 00 c, hex: 60 c, hex: 60 c, hex: 00 c, \ . +hex: 20 c, hex: 10 c, hex: 08 c, hex: 04 c, hex: 02 c, \ / +hex: 3E c, hex: 51 c, hex: 49 c, hex: 45 c, hex: 3E c, \ 0 +hex: 00 c, hex: 42 c, hex: 7F c, hex: 40 c, hex: 00 c, \ 1 +hex: 72 c, hex: 49 c, hex: 49 c, hex: 49 c, hex: 46 c, \ 2 +hex: 21 c, hex: 41 c, hex: 49 c, hex: 4D c, hex: 33 c, \ 3 +hex: 18 c, hex: 14 c, hex: 12 c, hex: 7F c, hex: 10 c, \ 4 +hex: 27 c, hex: 45 c, hex: 45 c, hex: 45 c, hex: 39 c, \ 5 +hex: 3C c, hex: 4A c, hex: 49 c, hex: 49 c, hex: 31 c, \ 6 +hex: 41 c, hex: 21 c, hex: 11 c, hex: 09 c, hex: 07 c, \ 7 +hex: 36 c, hex: 49 c, hex: 49 c, hex: 49 c, hex: 36 c, \ 8 +hex: 46 c, hex: 49 c, hex: 49 c, hex: 29 c, hex: 1E c, \ 9 +hex: 00 c, hex: 00 c, hex: 14 c, hex: 00 c, hex: 00 c, \ : +hex: 00 c, hex: 40 c, hex: 34 c, hex: 00 c, hex: 00 c, \ ; +hex: 00 c, hex: 08 c, hex: 14 c, hex: 22 c, hex: 41 c, \ < +hex: 14 c, hex: 14 c, hex: 14 c, hex: 14 c, hex: 14 c, \ = +hex: 00 c, hex: 41 c, hex: 22 c, hex: 14 c, hex: 08 c, \ > +hex: 02 c, hex: 01 c, hex: 59 c, hex: 09 c, hex: 06 c, \ ? +hex: 3E c, hex: 41 c, hex: 5D c, hex: 59 c, hex: 4E c, \ @ +hex: 7C c, hex: 12 c, hex: 11 c, hex: 12 c, hex: 7C c, \ A +hex: 7F c, hex: 49 c, hex: 49 c, hex: 49 c, hex: 36 c, \ B +hex: 3E c, hex: 41 c, hex: 41 c, hex: 41 c, hex: 22 c, \ C +hex: 7F c, hex: 41 c, hex: 41 c, hex: 41 c, hex: 3E c, \ D +hex: 7F c, hex: 49 c, hex: 49 c, hex: 49 c, hex: 41 c, \ E +hex: 7F c, hex: 09 c, hex: 09 c, hex: 09 c, hex: 01 c, \ F +hex: 3E c, hex: 41 c, hex: 41 c, hex: 51 c, hex: 73 c, \ G +hex: 7F c, hex: 08 c, hex: 08 c, hex: 08 c, hex: 7F c, \ H +hex: 00 c, hex: 41 c, hex: 7F c, hex: 41 c, hex: 00 c, \ I +hex: 20 c, hex: 40 c, hex: 41 c, hex: 3F c, hex: 01 c, \ J +hex: 7F c, hex: 08 c, hex: 14 c, hex: 22 c, hex: 41 c, \ K +hex: 7F c, hex: 40 c, hex: 40 c, hex: 40 c, hex: 40 c, \ L +hex: 7F c, hex: 02 c, hex: 1C c, hex: 02 c, hex: 7F c, \ M +hex: 7F c, hex: 04 c, hex: 08 c, hex: 10 c, hex: 7F c, \ N +hex: 3E c, hex: 41 c, hex: 41 c, hex: 41 c, hex: 3E c, \ O +hex: 7F c, hex: 09 c, hex: 09 c, hex: 09 c, hex: 06 c, \ P +hex: 3E c, hex: 41 c, hex: 51 c, hex: 21 c, hex: 5E c, \ Q +hex: 7F c, hex: 09 c, hex: 19 c, hex: 29 c, hex: 46 c, \ R +hex: 26 c, hex: 49 c, hex: 49 c, hex: 49 c, hex: 32 c, \ S +hex: 03 c, hex: 01 c, hex: 7F c, hex: 01 c, hex: 03 c, \ T +hex: 3F c, hex: 40 c, hex: 40 c, hex: 40 c, hex: 3F c, \ U +hex: 1F c, hex: 20 c, hex: 40 c, hex: 20 c, hex: 1F c, \ V +hex: 3F c, hex: 40 c, hex: 38 c, hex: 40 c, hex: 3F c, \ W +hex: 63 c, hex: 14 c, hex: 08 c, hex: 14 c, hex: 63 c, \ X +hex: 03 c, hex: 04 c, hex: 78 c, hex: 04 c, hex: 03 c, \ Y + +(* +hex: 61 c, hex: 59 c, hex: 49 c, hex: 4D c, hex: 43 c, \ Z \ Z unused +hex: 00 c, hex: 7F c, hex: 41 c, hex: 41 c, hex: 41 c, \ [ +hex: 02 c, hex: 04 c, hex: 08 c, hex: 10 c, hex: 20 c, \ \ +hex: 00 c, hex: 41 c, hex: 41 c, hex: 41 c, hex: 7F c, \ ] +hex: 04 c, hex: 02 c, hex: 01 c, hex: 02 c, hex: 04 c, \ ^ +hex: 40 c, hex: 40 c, hex: 40 c, hex: 40 c, hex: 40 c, \ _ +hex: 00 c, hex: 03 c, hex: 07 c, hex: 08 c, hex: 00 c, \ ` +hex: 20 c, hex: 54 c, hex: 54 c, hex: 78 c, hex: 40 c, \ a +hex: 7F c, hex: 28 c, hex: 44 c, hex: 44 c, hex: 38 c, \ b +hex: 38 c, hex: 44 c, hex: 44 c, hex: 44 c, hex: 28 c, \ c +hex: 38 c, hex: 44 c, hex: 44 c, hex: 28 c, hex: 7F c, \ d +hex: 38 c, hex: 54 c, hex: 54 c, hex: 54 c, hex: 18 c, \ e +hex: 00 c, hex: 08 c, hex: 7E c, hex: 09 c, hex: 02 c, \ f +hex: 18 c, hex: A4 c, hex: A4 c, hex: 9C c, hex: 78 c, \ g +hex: 7F c, hex: 08 c, hex: 04 c, hex: 04 c, hex: 78 c, \ h +hex: 00 c, hex: 44 c, hex: 7D c, hex: 40 c, hex: 00 c, \ i +hex: 20 c, hex: 40 c, hex: 40 c, hex: 3D c, hex: 00 c, \ j +hex: 7F c, hex: 10 c, hex: 28 c, hex: 44 c, hex: 00 c, \ k +hex: 00 c, hex: 41 c, hex: 7F c, hex: 40 c, hex: 00 c, \ l +hex: 7C c, hex: 04 c, hex: 78 c, hex: 04 c, hex: 78 c, \ m +hex: 7C c, hex: 08 c, hex: 04 c, hex: 04 c, hex: 78 c, \ n +hex: 38 c, hex: 44 c, hex: 44 c, hex: 44 c, hex: 38 c, \ o +hex: FC c, hex: 18 c, hex: 24 c, hex: 24 c, hex: 18 c, \ p +hex: 18 c, hex: 24 c, hex: 24 c, hex: 18 c, hex: FC c, \ q +hex: 7C c, hex: 08 c, hex: 04 c, hex: 04 c, hex: 08 c, \ r +hex: 48 c, hex: 54 c, hex: 54 c, hex: 54 c, hex: 24 c, \ s +hex: 04 c, hex: 04 c, hex: 3F c, hex: 44 c, hex: 24 c, \ t +hex: 3C c, hex: 40 c, hex: 40 c, hex: 20 c, hex: 7C c, \ u +hex: 1C c, hex: 20 c, hex: 40 c, hex: 20 c, hex: 1C c, \ v +hex: 3C c, hex: 40 c, hex: 30 c, hex: 40 c, hex: 3C c, \ w +hex: 44 c, hex: 28 c, hex: 10 c, hex: 28 c, hex: 44 c, \ x +hex: 4C c, hex: 90 c, hex: 90 c, hex: 90 c, hex: 7C c, \ y +hex: 44 c, hex: 64 c, hex: 54 c, hex: 4C c, hex: 44 c, \ z +*) + +\ Foreground and background color storage +WHT init-variable: fgC +BLK init-variable: bgC + +\ Set the text's foreground color +: setFG ( color -- ) + fgC ! +; + +\ Set the text's background color +: setBG ( color -- ) + bgC ! +; + +1 init-variable: _sz_ + +\ Set the size of the text +: setSize ( size -- ) + _sz_ ! +; + +\ A variation on fillRect +: fr ( x y width height color -- ) + >r ( x y width height color -- x y width height ) + rot ( x y width height -- x width height y ) + dup ( x width height y -- x width height y y ) + rot ( x width height y y -- x width y y height ) + + ( x width y y height -- x width y y+height ) + >r ( x width y y+height -- x width y ) + -rot ( x width y -- y x width ) + over ( y x width -- y x width x ) + + ( y x width x -- y x x+width ) + >r ( y x width+x -- y x ) + swap ( y x -- x y ) + r> ( x y -- x y x+width ) + r> ( x y x+width -- x y x+width y+height ) + r> ( x y x+width y+height -- x y x+width y+height color ) + fillRect ( x y x+width y+height color -- ) +; + +variable: _c_ + +\ Print a character from the font +: pChr ( x y c -- ) + + \ For this app convert LC chars to UC chars + dup ( x y c -- x y c c ) + hex: 61 ( x y c c -- x y c c x61 ) + swap ( x y c c x61 -- x y c x61 c ) + hex: 7A ( x y c x61 c -- x y c x61 c x7A ) + between? ( x y c x61 c x7A -- x y c f ) + if + hex: DF and + then + + \ Calculate offset of char data in font + hex: 20 - FW * ( x y c -- x y offset ) + + FW 1+ 0 \ For each column + do + dup ( x y offset -- x y offset offset ) + FNT + i + c@ ( x y offset offset -- x y offset c ) + i 5 = \ Add a blank final column between characters + if + drop 0 + then + 8 0 \ For each row + do + dup ( x y offset c -- x y offset c c ) + 1 i lshift ( x y offset c c -- x y offset c c mask ) + and ( x y offset c c mask -- x y offset c f ) + if + fgC @ ( x y offset c -- x y offset c color ) + else + bgC @ ( x y offset c -- x y offset c color ) + then + _c_ ! ( x y offset c color -- x y offset c ) + 2over ( x y offset c -- x y offset c x y ) + swap ( x y offset c x y -- x y offset c y x ) + _sz_ @ 1 = + if \ No scaling ? + j + ( x y offset c y x -- x y offset c y x+j ) + swap ( x y offset c y x+j -- x y offset c x+j y ) + i + ( x y offset c x+j y -- x y offset c x+j y+i ) + _c_ @ ( x y offset c x+j y+i -- x y offset c x+j y+i color ) + pixel ( x y offset c x+j y+i color -- x y offset c ) + else \ Scaling + _sz_ @ dup ( x y offset c y x -- x y offset c y x size size ) + j * ( x y offset c y x size size -- x y offset c y x size size*j ) + swap ( x y offset c y x size size*j -- x y offset c y x size*j size ) + i * ( x y offset c y x size*j size -- x y offset c y x size*j size*i ) + rot rot ( x y offset c y x size*j size*i -- x y offset c y size*i x size*j ) + + ( x y offset c y size*i x size*j -- x y offset c y size*i x+size*j ) + rot rot ( x y offset c y size*i x+size*j -- x y offset c x+size*j y size*i ) + + ( x y offset c x+size*j y size*i -- x y offset c x+size*j y+size*i ) + _sz_ @ dup ( x y offset c x+size*j y+size*i -- x y offset c x+size*j y+size*i size size ) + _c_ @ ( ... x+size*j y+size*i size size -- ... x+size*j y+size*i size size color ) + fr ( ... x+size*j y+size*i size size color -- x y offset c ) + then + loop + drop + loop + 3drop +; + +\ Print zero terminated string onto display at specified position +\ with current text size and foreground and background colors +: pStr ( x y addr -- ) + begin + dup ( x y addr -- x y addr addr ) + c@ dup ( x y addr addr -- x y addr c c ) + 0 <> ( x y addr c c -- x y addr c f ) + while + >r ( x y addr c -- x y addr ) + 3dup ( x y addr -- x y addr x y addr ) + -rot ( x y addr x y addr -- x y addr addr x y ) + r> ( x y addr addr x y -- x y addr addr x y c ) + pChr ( x y addr addr x y c -- x y addr addr ) + drop ( x y addr addr -- x y addr ) + 1+ ( x y addr -- x y addr+1 ) + rot ( x y addr+1 -- y addr+1 x ) + FW 1+ _sz_ @ * + ( y addr+1 x -- y addr+1 x' ) + -rot ( y addr+1 x' -- 'x y addr+1 ) + repeat + 4drop +; + +\ Print a horizontally centered text string +: pCStr ( y addr -- ) + dup ( y addr -- y addr addr ) + strlen ( y addr addr -- y addr len ) + FW 1+ _sz_ @ * * ( y addr len -- y addr pixelcount ) + WIDTH ( y addr pixelcount -- y addr pixelcount width ) + swap ( y addr pixelcount width -- y addr width pixelcount ) + - ( y addr width pixelcount -- y addr width-pixelcount ) + 2 / ( y addr width-pixelcount -- y addr x ) + rot rot ( y addr x -- x y addr ) + pStr +; + +\ NTP - Network Time Protocol Access +\ Written for PunyForth +\ By: Craig A. Lindley +\ Last Update: 01/21/2017 + +\ Program Constants +123 constant: NTP_PRT \ Port to send NTP requests to +48 constant: PK_SZ \ NTP time stamp in first 48 bytes of message + +\ Buffer for UDP packets +PK_SZ byte-array: pBuf + +\ NTP server host +str: "time.nist.gov" constant: NTP_SRV + +\ Send an NTP request packet and read response packet +: getTime ( -- secondsSince1970 | 0 ) + + \ Clear all bytes of the packet buffer + PK_SZ 0 + do + 0 i pBuf c! + loop + + \ Initialize values needed to form NTP request + hex: E3 0 pBuf c! \ LI, Version, Mode + hex: 06 2 pBuf c! \ Polling interval + hex: EC 3 pBuf c! \ Peer clock precision + hex: 31 12 pBuf c! + hex: 4E 13 pBuf c! + hex: 31 14 pBuf c! + hex: 34 15 pBuf c! + + \ Send the UDP packet containing the NTP request + \ Make connection to NTP server + NTP_PRT NTP_SRV UDP netcon-connect + + \ Send the NTP packet + dup 0 pBuf PK_SZ netcon-send-buf + + \ Read response into buffer + dup + PK_SZ 0 pBuf netcon-read ( -- netcon bytesRead ) + + swap ( netcon bytesRead -- bytesRead netcon ) + + \ Terminate the connection + netcon-dispose ( bytesRead netcon -- bytesRead ) + + PK_SZ = + if + \ Assemble the response into time value + 40 pBuf c@ 24 lshift + 41 pBuf c@ 16 lshift or + 42 pBuf c@ 8 lshift or + 43 pBuf c@ or + + 2208988800 - \ SECS_TO_1970 + else + 0 + then +; + + +\ Time Library +\ Based on Arduino Time library by Michael Margolis & Paul Stoffregen +\ Written for PunyForth +\ By: Craig A. Lindley +\ Last Update: 01/21/2017 + +\ Program constants +60 constant: SPM +SPM 60 * constant: SPH +SPH 24 * constant: SPD + +600 constant: syncInt \ NTP time refresh interval in seconds + +\ Program variables +variable: sysTime \ System time +variable: prevMS +variable: nextSync +variable: cacheTime + +\ Time element structure - holds time and date +struct + cell field: .second + cell field: .minute + cell field: .hour + cell field: .wday \ Day of week, sunday is day 1 + cell field: .day + cell field: .month + cell field: .year +constant: timeElements + +\ Create a new time elements object +: newTimeElements: ( "name" -- ) + timeElements create: allot +; + +\ Instantiate timeElements object for current time +newTimeElements: time + +\ Instantiate timeElements object for use with makeTime +newTimeElements: newTime + +(* +str: "Year: " constant: yStr +str: "Mon: " constant: monStr +str: "Day: " constant: dStr +str: "WDay: " constant: wdStr +str: "Hour: " constant: hStr +str: "Min: " constant: minStr +str: "Sec: " constant: sStr + + +\ Show time elements object +: showTE ( tm -- ) + yStr type dup .year @ . space + monStr type dup .month @ . space + dStr type dup .day @ . space + wdStr type dup .wday @ . space + hStr type dup .hour @ . space + minStr type dup .minute @ . space + sStr type .second @ . cr cr +; +*) + +\ Initialized byte array creator +: byteArray ( N .. 1 number "name" -- ) ( index -- value ) + create: + 0 do c, loop + does> + c@ +; + +\ Array of days in each month +31 30 31 30 31 31 30 31 30 31 28 31 12 byteArray MONTHDAYS + +\ Leap year calc expects argument as years offset from 1970 +: leapYear? ( year -- f ) + 1970 + ( year -- year+1970 ) + dup dup ( year' -- year' year' year' ) + 4 % 0= ( year year year -- year year f ) + swap ( year year f -- year f year ) + 100 % 0<> ( year f year -- year f f ) + and ( year f f -- year f ) + swap ( year f -- f year ) + 400 % 0= ( f year -- f f ) + or ( f f -- f ) +; + +variable: _year_ +variable: _mon_ +variable: _monLen_ +variable: _days_ +variable: _exit_ + +\ Breakup the seconds since 1970 into individual time elements +: breakTime ( timeSecs -- ) + + dup ( timeSecs -- timeSecs timeSecs ) + 60 % time .second ! ( timeSecs timeSecs -- timeSecs ) + 60 / ( timeSecs -- timeMins ) + dup ( timeMins -- timeMins timeMins ) + 60 % time .minute ! ( timeMins timeMins -- timeMins ) + 60 / ( timeMins -- timeHours ) + dup ( timeHours -- timeHours timeHours ) + 24 % time .hour ! ( timeHours timeHours -- timeHours ) + 24 / ( timeHours -- timeDays ) + dup ( timeDays -- timeDays timeDays ) + 4 + 7 % 1+ time .wday ! \ Sunday is day 1 + + 0 _year_ ! ( timeDays -- ) + 0 _days_ ! + + begin + dup ( timeDays -- timeDays timeDays ) + _year_ @ leapYear? + if + 366 _days_ +! + else + 365 _days_ +! + then + _days_ @ > ( timeDays timeDays -- timeDays f ) + while + 1 _year_ +! + repeat ( timeDays -- ) + _year_ @ dup time .year ! ( timeDays -- timeDays year ) + leapYear? ( timeDays year -- timeDays f ) + if + 366 negate _days_ +! + else + 365 negate _days_ +! + then + _days_ @ - \ Time is now days in this year starting at 0 + + 0 _days_ ! ( -- timeDays ) + 0 _mon_ ! + 0 _monLen_ ! + FALSE _exit_ ! + + begin + _mon_ @ 12 < _exit_ @ 0= and + while + _mon_ @ 1 = \ Feb ? + if + _year_ @ leapYear? + if + 29 _monLen_ ! + else + 28 _monLen_ ! + then + else + _mon_ @ MONTHDAYS _monLen_ ! + then + dup ( timeDays -- timeDays timeDays ) + _monLen_ @ >= + if + _monLen_ @ - + else + TRUE _exit_ ! + then + 1 _mon_ +! + repeat + _mon_ @ time .month ! + 1+ time .day ! +; + +\ Convert newTime timeElements object into seconds since 1970 +\ NOTE: Year is offset from 1970 +: makeTime ( -- timeSecs ) + \ Seconds from 1970 till 1 jan 00:00:00 of the given year + newTime .year @ ( -- year ) + dup ( year -- year year ) + 365 * ( year year -- year daysInYears ) + SPD * ( year daysInYears -- year secsInYears ) + over ( year secsInYears -- year secsInYears year ) + 0 + do ( year secsInYears year 0 -- year secsInYears ) + i leapYear? + if + SPD + + then + loop + + \ Add days for this year, months start from 1 + newTime .month @ ( year secsInYears -- year secsInYears month ) + dup ( year secsInYears month -- year secsInYears month month ) + 1 <> + if + 1 + do ( year secsInYears month 1 -- year secsInYears ) + swap dup ( year secsInYears -- secsInYears year year ) + leapYear? ( secsInYears year year -- secsInYears year f ) + i 2 = and \ Feb in a leap year? + if + swap ( secsInYears year -- year secsInYears ) + 29 SPD * + + else + swap ( secsInYears year -- year secsInYears ) + i 1- MONTHDAYS + SPD * + + then + loop + else + drop + then + nip + + newTime .day @ 1- SPD * + + newTime .hour @ SPH * + + newTime .minute @ SPM * + + newTime .second @ + +; + +\ Return the current system time syncing with NTP as appropriate +: now ( -- sysTime ) + \ Calculate number of seconds since last call to now + begin + ms@ prevMS @ - abs 1000 >= + while + 1 sysTime +! \ Advance system time by one second + 1000 prevMS +! + repeat + + \ Is it time to sync with NTP ? + nextSync @ sysTime @ <= + if + getTime ( -- ntpTime ) + dup + sysTime ! + syncInt + + nextSync ! + ms@ prevMS ! + then + sysTime @ +; + +\ Check and possibly refresh time cache +: refreshCache ( timeSecs -- ) + dup dup ( timeSecs -- timeSecs timeSecs timeSecs ) + cacheTime @ <> ( timeSecs timeSecs timeSecs -- timeSecs timeSecs f ) + if + breakTime ( timeSecs timeSecs -- timeSecs ) + cacheTime ! ( timeSecs -- ) + else + 2drop ( timeSecs timeSecs -- ) + then +; + +\ Given time in seconds since 1970 return hour +: hour_t ( timeSecs -- hour ) + refreshCache ( timeSecs -- ) + time .hour @ ( -- hour ) +; + +(* +\ Return the now hour +: hour ( -- hour ) + now hour_t +; +*) + +\ Given time in seconds since 1970 return hour in 12 hour format +: hourFormat12_t ( timeSecs -- hour12 ) + refreshCache ( timeSecs -- ) + time .hour @ dup ( -- hour hour ) + 0= ( hour hour -- hour f ) + if + drop ( hour -- ) + 12 ( -- 12 ) + else ( -- hour ) + dup ( hour -- hour hour ) + 12 > ( hour hour -- hour f ) + if + 12 - + then + then +; + +(* +\ Return now hour in 12 hour format +: hourFormat12 ( -- hour12 ) + now hourFormat12_t +; +*) + +\ Given time in seconds since 1970 return PM status +: isPM_t ( timeSecs -- f ) + refreshCache + time .hour @ 12 >= +; + +(* +\ Determine if now time is PM +: isPM ( -- f ) + now isPM_t +; +*) + +\ Given time in seconds since 1970 return AM status +: isAM_t ( timeSecs -- f ) + refreshCache + time .hour @ 12 < +; + +(* +\ Determine if now time is AM +: isAM ( -- f ) + now isAM_t +; +*) + +\ Given time in seconds since 1970 return minute +: minute_t ( timeSecs -- minute ) + refreshCache + time .minute @ +; + +(* +\ Return the now minute +: minute ( -- minute ) + now minute_t +; +*) + +\ Given time in seconds since 1970 return second +: second_t ( timeSecs -- second ) + refreshCache + time .second @ +; + +(* +\ Return the now second +: second ( -- second ) + now second_t +; +*) + +\ Given time in seconds since 1970 return day +: day_t ( timeSecs -- day ) + refreshCache + time .day @ +; + +(* +\ Return the now day +: day ( -- day ) + now day_t +; +*) + +\ Given time in seconds since 1970 return the week day with Sun as day 1 +: weekDay_t ( timeSecs -- weekDay ) + refreshCache + time .wday @ +; + +(* +\ Return the now week day with Sun as day 1 +: weekDay ( -- weekDay ) + now weekDay_t +; +*) + +\ Given time in seconds since 1970 return month +: month_t ( timeSecs -- month ) + refreshCache + time .month @ +; + +(* +\ Return the now month +: month ( -- month ) + now month_t +; +*) + +\ Given time in seconds since 1970 return year in full 4 digit format +: year_t ( timeSecs -- year ) + refreshCache + time .year @ 1970 + +; + +(* +\ Return the now year in full 4 digit format +: year ( -- year ) + now year_t +; +*) + +(* +Test cases for breakTime and makeTime from Arduino program +ALL SUCCESSFUL +time_t: 1484340438 - Year: 47, Mon: 1, Day: 13, Hour: 20, Min: 47, Sec: 18 +time_t: 1525094490 - Year: 48, Mon: 4, Day: 30, Hour: 13, Min: 21, Sec: 30 +time_t: 1561177080 - Year: 49, Mon: 6, Day: 22, Hour: 4, Min: 18, Sec: 0 +time_t: 1603973175 - Year: 50, Mon: 10, Day: 29, Hour: 12, Min: 6, Sec: 15 +time_t: 68166375 - Year: 2, Mon: 2, Day: 28, Hour: 23, Min: 6, Sec: 15 +*) + +\ Time Zone and Daylight Savings Time Library +\ Based on Arduino Timezone library by Jack Christensen +\ Written for PunyForth +\ By: Craig A. Lindley +\ Last Update: 01/21/2017 + +\ Structure for describing a time change rule +struct + cell field: .wk \ last = 0 first second third fourth + cell field: .dow \ Sun = 1 .. Sat + cell field: .mon \ Jan = 1 .. Dec + cell field: .hr \ 0 .. 23 + cell field: .off \ Offset from UTC in minutes +constant: TCR + +\ Time change rule object creator +: newTCR: ( "name" -- addrTCR ) + TCR create: allot +; + +\ Structure for describing a title and two time change rules +struct + cell field: .name + cell field: .dstTCR + cell field: .stdTCR +constant: TZ + +\ Time zone object creator +: newTZ: ( "name" -- addrTZ ) + TZ create: allot +; + +\ Program variables +variable: dstUTC \ DST start for given/current year, given in UTC +variable: stdUTC \ STD start for given/current year, given in UTC +variable: dstLoc \ DST start for given/current year, given in local time +variable: stdLoc \ STD start for given/current year, given in local time +variable: theTZ \ Variable holding the current TZ object + +\ Temp vars +variable: _y_ +variable: _t_ +variable: _m_ +variable: _w_ + +\ Convert a time change rule (TCR) to a time_t value for given year +: toTime_t ( TCR year -- time_t ) + _y_ ! ( TCR year -- TCR ) + dup .mon @ _m_ ! + dup .wk @ _w_ ! ( -- TCR ) + + _w_ @ 0= \ Last week ? + if + 1 _m_ +! + _m_ @ 12 > + if + 1 _m_ ! + 1 _y_ +! + then + 1 _w_ ! + then + dup .hr @ + newTime .hour ! + 0 newTime .minute ! + 0 newTime .second ! + 1 newTime .day ! + _m_ @ + newTime .month ! + _y_ @ 1970 - + newTime .year ! + makeTime _t_ ! ( -- TCR ) + 7 _w_ @ 1- * ( TCR -- TCR f1 ) + over ( TCR f1 -- TCR f1 TCR ) + .dow @ ( TCR f1 TCR -- TCR f1 DOW ) + _t_ @ weekDay_t ( TCR f1 DOW -- TCR f1 DOW WD ) + - ( TCR f1 DOW WD -- TCR f1 DOW-WD ) + 7 + ( TCR f1 DOW-WD -- TCR f1 DOW-WD+7 ) + 7 % ( TCR f1 DOW-WD+7 -- TCR f1 DOW-WD+7%7 ) + + ( TCR f1 DOW-WD+7%7 -- TCR DOW-WD+7%7+f1 ) + SPD * ( TCR DOW-WD+7%7+f1 -- TCR DOW-WD+7%7+f1*SPD ) + _t_ +! ( TCR DOW-WD+7%7+f1*SPD -- TCR ) + .wk @ 0= ( TCR -- f ) + if + -7 SPD * _t_ +! + then + _t_ @ +; + +\ Calculate the DST and standard time change points for the given +\ given year as local and UTC time_t values. +: calcTC ( year -- ) + dup ( year -- year year ) + >r ( year year -- year ) + theTZ @ .dstTCR @ + swap ( year -- TCR year ) + toTime_t dstLoc ! ( TCR year -- ) + r> ( -- year ) + theTZ @ .stdTCR @ + swap ( year -- TCR year ) + toTime_t stdLoc ! ( TCR year -- ) + + dstLoc @ + theTZ @ .stdTCR @ + .off @ + SPM * + - + dstUTC ! + + stdLoc @ + theTZ @ .dstTCR @ + .off @ + SPM * + - + stdUTC ! +; + +\ Determine whether the given UTC time_t is within the DST interval +\ or the Standard time interval +: utcIsDST ( utc -- f ) + dup ( utc -- utc utc ) + year_t ( utc utc -- utc utc_yr ) + dstUTC @ ( utc utc_yr -- utc utc_yr utc_dst ) + year_t ( utc utc_yr utc_dst -- utc utc_yr dst_yr ) + over ( utc utc_yr dst_yr -- utc utc_yr dst_yr utc_yr ) + <> ( utc utc_yr dst_yr utc_yr -- utc utc_yr f ) + if + calcTC + else + drop + then ( -- utc ) + dup ( utc -- utc utc ) + stdUTC @ + dstUTC @ > + if \ Northern hemisphere + dstUTC @ >= ( utc utc -- utc f ) + swap ( utc f -- f utc ) + stdUTC @ < + and + else \ Southern hemisphere + stdUTC @ >= ( utc utc -- utc f ) + swap ( utc f -- f utc ) + dstUTC @ < + and 0= + then +; + +\ Convert the given UTC time to local time, standard or +\ daylight time, as appropriate +: toLocal ( utc -- time_t ) + dup ( utc -- utc utc ) + year_t ( utc utc -- utc utc_yr ) + dstUTC @ ( utc utc_yr -- utc utc_yr utc_dst ) + year_t ( utc utc_yr utc_dst -- utc utc_yr dst_yr ) + over ( utc utc_yr dst_yr -- utc utc_yr dst_yr utc_yr ) + <> ( utc utc_yr dst_yr utc_yr -- utc utc_yr f ) + if + calcTC ( utc utc_yr -- utc ) + else + drop + then ( -- utc ) + dup ( utc -- utc utc ) + utcIsDST ( utc utc -- utc f ) + if + theTZ @ .dstTCR @ + .off @ + SPM * + + + else + theTZ @ .stdTCR @ + .off @ + SPM * + + + then +; + +\ Set the timezone in preparation for time conversion +: setTZ ( tz -- ) + + \ Store tz into global variable + theTZ ! + + \ Clear all local variables for new calculation + 0 dstLoc ! + 0 stdLoc ! + 0 dstUTC ! + 0 stdUTC ! +; + +\ World Clock App +\ Written for PunyForth +\ By: Craig A. Lindley +\ Last Update: 01/21/2017 + +\ Set TRUE for 12 hour format; FALSE for 24 hour format +TRUE constant: 12HF + +\ BEGIN TIME CHANGE RULE DEFINITIONS + +(* +Australia Eastern Time Zone (Sydney, Melbourne) +TTimeChangeRule aEDT = {"AEDT", First, Sun, Oct, 2, 660}; //UTC + 11 hours +TimeChangeRule aEST = {"AEST", First, Sun, Apr, 3, 600}; //UTC + 10 hours +Timezone ausET(aEDT, aEST); +*) + +\ Create TCR for daylight saving time +newTCR: aEDT + +\ Initialize rule + 1 aEDT .wk ! \ First week + 1 aEDT .dow ! \ Sun +10 aEDT .mon ! \ Oct + 2 aEDT .hr ! \ 2 PM +660 aEDT .off ! \ TZ offset 11 hours + +\ Create TCR for standard time +newTCR: aEST + +\ Initialize rule + 1 aEST .wk ! \ First week + 1 aEST .dow ! \ Sun + 4 aEST .mon ! \ Apr + 3 aEST .hr ! \ 3 PM +600 aEST .off ! \ TZ offset 10 hours + +\ Create TZ object to hold TCRs +newTZ: ausET + +str: "Sydney" ausET .name ! +aEDT ausET .dstTCR ! +aEST ausET .stdTCR ! + +(* CURRENTLY NOT USED +//Central European Time (Frankfurt, Paris) +TimeChangeRule CEST = {"CEST", Last, Sun, Mar, 2, 120}; //Central European Summer Time +TimeChangeRule CET = {"CET ", Last, Sun, Oct, 3, 60}; //Central European Standard Timezone CE(CEST, CET); + +\ Create TCR for daylight saving time +newTCR: CEST + +\ Initialize rule + 0 CEST .wk ! \ Last week + 1 CEST .dow ! \ Sun + 3 CEST .mon ! \ Mar + 2 CEST .hr ! \ 2 PM +120 CEST .off ! \ TZ offset 2 hours + +\ Create TCR for standard time +newTCR: CET + +\ Initialize rule + 0 CET .wk ! \ Last week + 1 CET .dow ! \ Sun +10 CET .mon ! \ Oct + 3 CET .hr ! \ 3 PM +60 CET .off ! \ TZ offset 1 hours + +\ Create TZ object to hold TCRs +newTZ: CE + +str: "Frankfurt" CE .name ! +CEST CE .dstTCR ! +CET CE .stdTCR ! +*) + +(* +//United Kingdom (London, Belfast) +TimeChangeRule BST = {"BST", Last, Sun, Mar, 1, 60}; //British Summer Time +TimeChangeRule GMT = {"GMT", Last, Sun, Oct, 2, 0}; //Standard Time +Timezone UK(BST, GMT); +*) + +\ Create TCR for daylight saving time +newTCR: BST + +\ Initialize rule + 0 BST .wk ! \ Last week + 1 BST .dow ! \ Sun + 3 BST .mon ! \ Mar + 1 BST .hr ! \ 1 PM +60 BST .off ! \ TZ offset 1 hours + +\ Create TCR for standard time +newTCR: GMT + +\ Initialize rule + 0 GMT .wk ! \ First week + 1 GMT .dow ! \ Sun +10 GMT .mon ! \ Oct + 2 GMT .hr ! \ 2 PM + 0 GMT .off ! \ TZ offset 1 hours + +\ Create TZ object to hold TCRs +newTZ: UK + +str: "London" UK .name ! +BST UK .dstTCR ! +GMT UK .stdTCR ! + +(* +//US Eastern Time Zone (New York, Detroit) +TimeChangeRule usEDT = {"EDT", Second, Sun, Mar, 2, -240}; +TimeChangeRule usEST = {"EST", First, Sun, Nov, 2, -300}; +Timezone usET(usEDT, usEST); +*) + +\ Create TCR for daylight saving time +newTCR: usEDT + +\ Initialize rule + 2 usEDT .wk ! \ Second week + 1 usEDT .dow ! \ Sun + 3 usEDT .mon ! \ Mar + 2 usEDT .hr ! \ 2 PM +-240 usEDT .off ! \ TZ offset -4 hours + +\ Create TCR for standard time +newTCR: usEST + +\ Initialize rule + 1 usEST .wk ! \ First week + 1 usEST .dow ! \ Sun +11 usEST .mon ! \ Nov + 2 usEST .hr ! \ 2 PM +-300 usEST .off ! \ TZ offset -5 hours + +\ Create TZ object to hold TCRs +newTZ: usET + +str: "New York" usET .name ! +usEDT usET .dstTCR ! +usEST usET .stdTCR ! + +(* CURRENTLY NOT USED +//US Central Time Zone (Chicago, Houston) +TimeChangeRule usCDT = {"CDT", Second, Sun, Mar, 2, -300}; +TimeChangeRule usCST = {"CST", First, Sun, Nov, 2, -360}; +Timezone usCT(usCDT, usCST); + +\ Create TCR for daylight saving time +newTCR: usCDT + +\ Initialize rule + 2 usCDT .wk ! \ Second week + 1 usCDT .dow ! \ Sun + 3 usCDT .mon ! \ Mar + 2 usCDT .hr ! \ 2 PM +-300 usCDT .off ! \ TZ offset -5 hours + +\ Create TCR for standard time +newTCR: usCST + +\ Initialize rule + 1 usCST .wk ! \ First week + 1 usCST .dow ! \ Sun +11 usCST .mon ! \ Nov + 2 usCST .hr ! \ 2 PM +-360 usCST .off ! \ TZ offset -6 hours + +\ Create TZ object to hold TCRs +newTZ: usCT + +str: "Houston" usCT .name ! +usCDT usCT .dstTCR ! +usCST usCT .stdTCR ! +*) + +(* +//US Mountain Time Zone (Denver, Salt Lake City) +TimeChangeRule usMDT = {"MDT", Second, Sun, Mar, 2, -360}; +TimeChangeRule usMST = {"MST", First, Sun, Nov, 2, -420}; +Timezone usMT(usMDT, usMST); +*) + +\ Create TCR for daylight savings time +newTCR: usMDT + +\ Initialize rule + 2 usMDT .wk ! \ Second week + 1 usMDT .dow ! \ Sun + 3 usMDT .mon ! \ Mar + 2 usMDT .hr ! \ 2 PM +-360 usMDT .off ! \ TZ offset -6 hours + +\ Create TCR for standard time +newTCR: usMST + +\ Initialize rule + 1 usMST .wk ! \ First week + 1 usMST .dow ! \ Sun +11 usMST .mon ! \ Nov + 2 usMST .hr ! \ 2 PM +-420 usMST .off ! \ TZ offset -7 hours + +\ Create TZ object to hold TCRs +newTZ: usMT + +str: "Denver" usMT .name ! +usMDT usMT .dstTCR ! +usMST usMT .stdTCR ! + +(* CURRENTLY NOT USED +//Arizona is US Mountain Time Zone but does not use DST +Timezone usAZ(usMST, usMST); + +\ Create TZ object to hold TCRs +newTZ: usAZ + +str: "Phoenix" usAZ .name ! +usMST usAZ .dstTCR ! +usMST usAZ .stdTCR ! +*) + +(* +//US Pacific Time Zone (Las Vegas, Los Angeles) +TimeChangeRule usPDT = {"PDT", Second, Sun, Mar, 2, -420}; +TimeChangeRule usPST = {"PST", First, Sun, Nov, 2, -480}; +Timezone usPT(usPDT, usPST); +*) + +\ Create TCR for daylight savings time +newTCR: usPDT + +\ Initialize rule + 2 usPDT .wk ! \ Second week + 1 usPDT .dow ! \ Sun + 3 usPDT .mon ! \ Mar + 2 usPDT .hr ! \ 2 PM +-420 usPDT .off ! \ TZ offset -7 hours + +\ Create TCR for standard time +newTCR: usPST + +\ Initialize rule + 1 usPST .wk ! \ First week + 1 usPST .dow ! \ Sun +11 usPST .mon ! \ Nov + 2 usPST .hr ! \ 2 PM +-480 usPST .off ! \ TZ offset -8 hours + +\ Create TZ object to hold TCRs +newTZ: usPT + +str: "Los Angeles" usPT .name ! +usPDT usPT .dstTCR ! +usPST usPT .stdTCR ! + +\ END TIME CHANGE RULE DEFINITIONS + +\ Format buffer +20 buffer: fbuf +variable: i + +\ Copy a string into format buffer +: cat ( sAddr -- ) + begin + dup ( sAddr -- sAddr sAddr ) + c@ ( sAddr sAddr -- sAddr c ) + dup ( sAddr c -- sAddr c c ) + 0 ( sAddr c c -- sAddr c c 0 ) + <> ( sAddr c c 0 -- sAddr c f ) + while + i @ fbuf + c! ( sAddr c -- sAddr ) + 1 i +! + 1+ ( sAddr -- sAddr+1 ) + repeat + i @ fbuf + c! ( sAddr c -- sAddr ) + drop +; + +5 buffer: nbuf +variable: j +variable: i1 + +\ Integer to string conversion +\ Can only do positive numbers with less than 5 digits +: i2s ( n -- ) + 0 i1 ! + begin + dup ( n -- n n ) + 10 % ( n n -- n n%10 ) + 48 + ( n n%10 -- n n%10+48 ) + i1 @ nbuf + c! ( n n%10+48 -- n ) + 1 i1 +! + 10 / ( n -- n/10 ) + dup ( n/10 -- n/10 n/10 ) + 0 <= ( n/10 n/10 -- n/10 f ) + until + drop + 0 i1 @ nbuf + c! + + \ Now reverse the characters in the string + + i1 @ 1- j ! + 0 i1 ! + + begin + i1 @ nbuf + c@ ( -- nbuf[i] ) + j @ nbuf + c@ ( nbuf[i] -- nbuf[i] nbuf[j] ) + i1 @ nbuf + c! ( nbuf[i] nbuf[j] -- nbuf[i] ) + j @ nbuf + c! ( nbuf[i] -- ) + 1 i1 +! + -1 j +! + i1 @ j @ > + until +; + +\ String array creator +: sa: ( strN .. str1 number "name" -- ) ( index -- addr of string ) + create: + 0 do , loop + does> swap cells + @ +; + +\ Months string array +str: "Dec" str: "Nov" str: "Oct" str: "Sep" +str: "Aug" str: "Jul" str: "Jun" str: "May" +str: "Apr" str: "Mar" str: "Feb" str: "Jan" +str: "" +13 sa: MON + +\ Days string array +str: "Sat" str: "Fri" str: "Thu" str: "Wed" +str: "Tue" str: "Mon" str: "Sun" str: "" +8 sa: DOW + +\ Am - Pm string array +str: "PM" str: "AM" +2 sa: AMPM + +\ Display time and date. Assumes theTZ set before call +: dtd + + \ Clear the dynamic area of the screen + 2 14 WIDTH 3 - HEIGHT 15 - BLK fillRect + + \ Print using larger text + 2 _sz_ ! + + \ Print the name of the city + 20 theTZ @ .name @ pCStr + + \ Get the UTC time and convert it to local time + now toLocal >r + + \ Print day of the week + 41 r@ weekDay_t DOW pCStr + + \ Initialize format buffer index + 0 i ! + + \ Format date string like: Wed Jan 18, 2017 + r@ month_t MON cat str: " " cat + r@ day_t i2s nbuf cat str: ", " cat + r@ year_t i2s nbuf cat + \ Print the centered date line + 62 fbuf pCStr + + \ Initialize format buffer index + 0 i ! + + \ Format the time string like: 9:59 AM + r@ + 12HF + if + hourFormat12_t + else + hour_t + then + i2s nbuf cat + str: ":" cat + r@ minute_t i2s nbuf + \ If minutes single digit 0..9 add leading zero to string + dup strlen 1 = + if + str: "0" cat + then + cat + str: " " cat + r@ isAM_t + if + 0 AMPM + else + 1 AMPM + then + cat + + \ Print the centered time line + 3 _sz_ ! \ Print large text + 85 fbuf pCStr + + \ Clean up + r> drop +; + +variable: tz + +\ Run the world clock app +: wc + + \ Initialize the LCD controller + initLCD + + \ Clear the LCD to black + 0 0 WIDTH 1- HEIGHT 1- BLK fillRect + + \ Draw display frame + 0 0 WIDTH YEL hLine + 0 HEIGHT 1- WIDTH YEL hLine + 0 1 HEIGHT 2 - YEL vLine + WIDTH 1- 1 HEIGHT 2 - YEL vLine + + GRN setFG + + \ Draw fixed text + 5 str: "World Clock" pCStr + 116 str: "Craig A. Lindley" pCStr + + begin + tz @ + case + 0 of ausET setTZ endof + 1 of UK setTZ endof + 2 of usET setTZ endof + 3 of usMT setTZ endof + 4 of usPT setTZ endof + endcase + \ Print the time and data for selected time zone + dtd + 1 tz +! + tz @ 4 > + if + 0 tz ! + then + \ Wait 30 seconds + 30000 ms + again +; + +wc + + + + + + + + + + diff --git a/generic/data.S b/generic/data.S index c747082..13965cb 100644 --- a/generic/data.S +++ b/generic/data.S @@ -14,23 +14,26 @@ .set MAX_WORD_LEN,63 stack_top: .int 0 -var0: .int 0 state_var: .int STATE_INTERPRET -LAST_WORD: .int FINAL_WORD -input_index: .int 0 +input_index: .int input_buffer input_buffer: .space INPUT_BUFFER_SIZE,' ' .align 4,32 input_size: .int . - input_buffer -var_dp: .int 0 // data pointer -var_prompt_xt:.int 0 -var_pause_xt: .int 0 -var_emit_xt: .int 0 -var_type_xt: .int 0 -dictionary: .space 24576 +dictionary: + var_last_word: .int FINAL_WORD + var_prompt_xt: .int xt_exit + var_pause_xt: .int 0 + var_emit_xt: .int xt_uemit + var_type_xt: .int xt_utype + var_eundefi_xt:.int xt_eundef + var_eundefc_xt:.int xt_eundef + var_dp: .int heap +heap: + .space 25152 end_dictionary: -rstack_space: .space 320 +rstack_space: .space 112 rstack_top: -stack_space: .space 480 // used only by ESP port +stack_space: .space 112 // used only by ESP port stack: compile_only_warning: .asciz "\nWord has no interpretation semantics\n" undef_word_error: .asciz "\nUndefined word: " diff --git a/generic/forth/core.forth b/generic/forth/core.forth index 067c6ed..3606ba6 100644 --- a/generic/forth/core.forth +++ b/generic/forth/core.forth @@ -1,19 +1,13 @@ : interpret? state @ 0= ; -: backref, here - cell - , ; +: backref, here - , ; -: begin immediate compile-time - here ; +: begin immediate compile-time here ; +: again immediate compile-time ['] branch , backref, ; +: until immediate compile-time ['] branch0 , backref, ; -: again immediate compile-time - ['] branch , backref, ; - -: until immediate compile-time - ['] branch0 , backref, ; - -: char: word drop c@ ; - -: ( begin key [ char: ) ] literal = until ; immediate -: \ begin key dup 13 = swap 10 = or until ; immediate +: crlf? dup 10 = swap 13 = or ; +: ( begin key 41 = until ; immediate +: \ begin key crlf? until ; immediate : dip ( a xt -- a ) swap >r execute r> ; : keep ( a xt -- xt.a a ) over >r execute r> ; @@ -30,21 +24,16 @@ : % ( n -- remainder ) /mod drop ; : / ( n -- quotient ) /mod nip ; -: +! ( n var -- ) dup @ rot + swap ! ; -: c+! ( n var -- ) dup c@ rot + swap c! ; +: +! ( n var -- ) tuck @ + swap ! ; +: -! ( n var -- ) tuck @ swap - swap ! ; +: c+! ( n var -- ) tuck c@ + swap c! ; -: prepare-forward-ref ( -- a) here 0 , ; -: resolve-forward-ref ( a -- ) dup here swap - cell - swap ! ; - -: if immediate compile-time - ['] branch0 , prepare-forward-ref ; - -: else immediate compile-time - ['] branch , prepare-forward-ref swap - resolve-forward-ref ; +: prepare-forward-ref ( -- a ) here 0 , ; +: resolve-forward-ref ( a -- ) here over - swap ! ; -: then immediate compile-time - resolve-forward-ref ; +: if immediate compile-time ['] branch0 , prepare-forward-ref ; +: else immediate compile-time ['] branch , prepare-forward-ref swap resolve-forward-ref ; +: then immediate compile-time resolve-forward-ref ; : ?dup ( a -- a a | 0 ) dup if dup then ; @@ -56,18 +45,20 @@ : ? ( a -- ) @ . ; : unloop r> r> r> 2drop >r ; +: do immediate compile-time ['] swap , ['] >r , ['] >r , 0 ( do ) here ( backref ) ; +: ?do immediate compile-time + ['] 2dup , ['] swap , ['] >r , ['] >r , + ['] <> , ['] branch0 , prepare-forward-ref + 1 ( ?do ) here ( backref ) ; -: do immediate compile-time - ['] swap , ['] >r , ['] >r , - here ; \ prepare backref - -: bounds ( start len -- limit start ) - over + swap ; +: bounds ( start len -- limit start ) over + swap ; : loop immediate compile-time ['] r> , ['] 1+ , ['] >r , ['] i , ['] rp@ , ['] cell , ['] + , ['] @ , \ index limit - ['] >= , ['] branch0 , backref, + ['] >= , + ['] branch0 , backref, + if ( ?do ) resolve-forward-ref then ['] unloop , ; : end? ( increment -- bool ) @@ -78,16 +69,13 @@ : +loop immediate compile-time ['] dup , \ increment ['] rp@ , ['] +! , - ['] end? , ['] branch0 , backref, + ['] end? , + ['] branch0 , backref, + if ( ?do ) resolve-forward-ref then ['] unloop , ; -: while immediate compile-time - ['] branch0 , prepare-forward-ref ; - -: repeat immediate compile-time - swap - ['] branch , backref, - resolve-forward-ref ; +: while immediate compile-time ['] branch0 , prepare-forward-ref ; +: repeat immediate compile-time swap ['] branch , backref, resolve-forward-ref ; : case ( -- branch-counter ) immediate compile-time 0 ; @@ -102,10 +90,7 @@ resolve-forward-ref swap ; \ keep branch counter at TOS -: endcase ( #branches #branchesi*a -- ) immediate compile-time - 0 do - resolve-forward-ref - loop ; +: endcase ( #branches #branchesi*a -- ) immediate compile-time 0 do resolve-forward-ref loop ; : override immediate ( -- ) lastword hide ; @@ -113,16 +98,12 @@ : create: createheader enterdoes , ['] nop cell + , ; \ default behaviour is nop, does> overwrites this : does> r> lastword link>body ! ; -: constant: create: , does> @ ; -: init-variable: create: , ; : variable: 0 init-variable: ; -1 constant: TRUE 0 constant: FALSE -: exception: ( "name" -- ) ( -- xt ) - create: lastword , - does> @ ; +: exception: ( "name" -- ) ( -- xt ) create: lastword , does> @ ; exception: EUNDERFLOW exception: EOVERFLOW @@ -131,17 +112,12 @@ exception: ENOTFOUND exception: ECONVERT exception: EESCAPE -: ['], ['] ['] , ; - -: defer: ( "name" -- ) - create: ['] nop , - does> @ execute ; - +: defer: ( "name" -- ) create: ['] nop , does> @ execute ; : defer! ( dst-xt src-xt -- ) swap 2 cells + ! ; \ store xt as body defer: unhandled defer: handler -0 init-variable: var-handler \ stores the address of the nearest exception handler +variable: var-handler \ stores the address of the nearest exception handler : single-handler ( -- a ) var-handler ; \ single threaded global handler : catch ( xt -- exception | 0 ) @@ -152,8 +128,8 @@ defer: handler r> drop 0 ; \ drop the saved sp return 0 indicating no error : throw ( i*x exception -- i*x exception | 0 ) - dup 0= if drop exit then \ 0 means no error, drop errorcode exit from execute - handler @ 0= if \ this was an uncaught exception + ?dup 0= if exit then \ 0 means no error, drop errorcode exit from execute + handler @ 0= if \ this was an uncaught exception unhandled exit then @@ -162,64 +138,59 @@ defer: handler r> swap >r sp! \ restore the data stack as it was before the most recent catch drop r> ; \ return to the caller of most recent catch with the errcode +: ' ( -- xt | throws:ENOTFOUND ) \ find the xt of the next word in the inputstream + word find dup if link>xt else ENOTFOUND throw then ; + +: postpone: ( -- | throws:ENOTFOUND ) ' , ; immediate \ force compile semantics of an immediate word +: ['], ['] ['] , ; + : { immediate compile-time ['], here 3 cells + , ['] branch , prepare-forward-ref entercol , ; -: } immediate compile-time - ['] exit , - resolve-forward-ref ; - -: ' ( -- xt | throws:ENOTFOUND ) \ find the xt of the next word in the inputstream - word find dup if - link>xt - else - ENOTFOUND throw - then ; +: } immediate compile-time ['] exit , resolve-forward-ref ; ' handler ' single-handler defer! -: compile-imm: ( -- | throws:ENOTFOUND ) ' , ; immediate \ force compile semantics of an immediate word - -: is: immediate - interpret? if - ' defer! - else - ['], ' , ['] defer! , - then ; - -: array: ( size "name" -- ) ( index -- addr ) - create: cells allot - does> swap cells + ; +: is: immediate interpret? if ' defer! else ['], ' , ['] defer! , then ; -: byte-array: ( size "name" -- ) ( index -- addr ) - create: allot - does> swap + ; - -: buffer: ( size "name" -- ) ( -- addr ) - create: allot ; +: array: ( size "name" -- ) ( index -- addr ) create: cells allot does> swap cells + ; +: byte-array: ( size "name" -- ) ( index -- addr ) create: allot does> swap + ; +: buffer: ( size "name" -- ) ( -- addr ) create: allot ; : struct 0 ; : field: create: over , + does> @ + ; -: [str ( -- address-to-fill-in ) - ['], here 3 cells + , \ compile return value: address of string - ['] branch , \ compile branch that will skip the string - here \ address of the dummy address - 0 , ; \ dummy address +: abs ( n -- n ) dup 0< if invert 1+ then ; +: max ( n n -- n ) 2dup < if begin nip ; +: min ( n n -- n ) 2dup < until then drop ; +: between? ( min-inclusive num max-inclusive -- bool ) over >= -rot <= and ; + +: cmove ( src-addr dst-addr count -- ) + ?dup 0> if + 0 do + 2dup { c@ } dip c! + { 1+ } bi@ + loop + then + 2drop ; + +: [str ( -- forward-ref ) + ['], here 3 cells + , ( str pushes its own addr. at runtime ) + ['] branch , prepare-forward-ref ; -: str] ( address-to-fill-in -- ) - 0 c, \ terminate string - dup here swap - cell - swap ! ; \ calculate and store relative address +: str] ( forward-ref -- ) 0 c, resolve-forward-ref ; : eschr ( char -- char ) \ read next char from stdin - dup [ char: \ ] literal = if + dup 92 ( \ ) = if drop key case - [ char: r ] literal of 13 endof - [ char: n ] literal of 10 endof - [ char: t ] literal of 9 endof - [ char: \ ] literal of 92 endof + 114 ( r ) of 13 endof + 110 ( n ) of 10 endof + 116 ( t ) of 9 endof + 92 ( \ ) of 92 endof + 34 ( " ) of 34 endof + 39 ( ' ) of 39 endof EESCAPE throw endcase then ; @@ -233,44 +204,50 @@ defer: handler drop FALSE endcase ; -: line-break? ( char -- bool ) - dup 10 = swap 13 = or ; - : c,-until ( separator -- ) - begin - key 2dup <> - while - dup line-break? if - drop - else - eschr c, - then - repeat - 2drop ; \ drop last key and separator + begin key 2dup <> while dup crlf? if drop else eschr c, then repeat + 2drop ; \ last key and separator -: separator ( -- char ) - begin - key dup whitespace? - while - drop - repeat ; +: hexchar>int ( char -- n | throws:ECONVERT ) + 48 over 57 between? if 48 - exit then + 65 over 70 between? if 55 - exit then + 97 over 102 between? if 87 - exit then + ECONVERT throw ; -: str: ( "string content" ) immediate - separator - interpret? if - align! here swap c,-until 0 c, - else - [str swap c,-until str] - then ; +: hex>int' ( str len -- n | throws:ECONVERT ) + dup 0= if ECONVERT throw then + dup 1- 2 lshift 0 swap + 2swap 0 do + dup >r + c@ hexchar>int + over lshift rot + + swap 4 - + r> 1+ + loop + 2drop ; -: strlen ( str -- len ) - 0 swap - begin - dup c@ - while - ['] 1+ bi@ - repeat - drop ; +\ recognizers +: str, ( len -- ) >in -! 34 ( " ) c,-until ; +: chr? 2 = swap c@ 36 ( $ ) = and ; +: str? c@ 34 ( " ) = ; +: hex? 3 > over c@ 49 ( 1 ) = and over 1+ c@ 54 ( 6 ) = and swap 2 + c@ 114 ( r ) = and ; +: _ ( addr len -- ? ) + 2dup chr? if drop ['], 1+ c@ , exit then + over str? if nip [str >r str, r> str] exit then + 2dup hex? if 3 - swap 3 + swap hex>int' ['], , exit then + eundef ; +' _ eundefc ! + +: _ ( addr len -- ? ) + 2dup chr? if drop 1+ c@ exit then + over str? if nip dp >r str, 0 c, r> exit then + 2dup hex? if 3 - swap 3 + swap hex>int' exit then + eundef ; +' _ eundefi ! + +: separator ( -- char ) begin key dup whitespace? while drop repeat ; + +: strlen ( str -- len ) dup begin dup c@ while 1+ repeat swap - ; : =str ( str1 str2 -- bool ) begin @@ -309,55 +286,27 @@ defer: handler 1+ swap again ; -: abs ( n -- n ) dup 0< if -1 * then ; -: max ( a b -- max ) 2dup < if nip else drop then ; -: min ( a b -- min ) 2dup < if drop else nip then ; -: between? ( min-inclusive num max-inclusive -- bool ) over >= -rot <= and ; +: >s' ( ? addr n -- addr2 ? ) + 10 /mod ?dup if rot swap >s' then + 48 + over c! 1+ swap ; -: hexchar>int ( char -- n | throws:ECONVERT ) - 48 over 57 between? if 48 - exit then - 65 over 70 between? if 55 - exit then - 97 over 102 between? if 87 - exit then - ECONVERT throw ; - -: hex>int' ( str len -- n | throws:ECONVERT ) - dup 0= if ECONVERT throw then - dup 1- 2 lshift 0 swap - 2swap 0 do - dup >r - c@ hexchar>int - over lshift rot + - swap 4 - - r> 1+ - loop - 2drop ; +: >str ( addr n -- ) + dup 0< if abs >r 45 over c! 1+ r> then + 0 -rot >s' + 0 rot c! drop ; : hex>int ( str -- n | throws:ECONVERT ) dup strlen hex>int' ; -: hex: immediate - word hex>int' - interpret? invert if ['], , then ; - : print: ( "string" ) immediate + separator interpret? if - separator - begin - key 2dup <> - while - eschr emit - repeat - 2drop - else - compile-imm: str: ['] type , - then ; - -: println: ( "string" ) immediate - interpret? if - str: "print:" 6 find link>xt execute cr \ XXX + begin key 2dup <> while eschr emit repeat 2drop else - compile-imm: str: ['] type , ['] cr , + [str swap c,-until str] ['] type , then ; +: println: ( "string" ) immediate postpone: print: interpret? if cr else ['] cr , then ; + defer: s0 ' s0 is: _s0 defer: r0 ' r0 is: _r0 @@ -365,89 +314,57 @@ defer: r0 ' r0 is: _r0 : rdepth ( -- n ) r0 rp@ - cell / 1- ; : marker: ( "name" -- ) - create: - lastword , - does> - @ dup - @ var-lastword ! - var-dp ! ; - -: link-type ( link -- ) - ['] link>name ['] link>len bi - type-counted ; - -: help ( -- ) - lastword - begin - ?dup - while - dup link-type cr @ - repeat ; + create: lastword , + does> @ dup @ var-lastword ! var-dp ! ; + +: link-type ( link -- ) ['] link>name ['] link>len bi type-counted ; + +: help ( -- ) lastword begin ?dup while dup link-type cr @ repeat ; : stack-print ( -- ) depth 0= if exit then depth 10 > if print: ".. " then 0 depth 2 - 9 min \ maximalize depth to print do - sp@ i cells + @ . - i if space then - -1 - +loop ; + space sp@ i cells + @ . + -1 +loop ; -: stack-clear ( i*x -- ) - depth 0= if exit then - depth 0 do drop loop ; +: stack-clear ( i*x -- ) begin depth while drop repeat ; : stack-show ( -- ) { depth 0< if EUNDERFLOW throw then + loading? if exit then interpret? if - print: '(stack' - depth if space then - stack-print - [ char: ) ] literal emit space + print: '(stack' stack-print $) emit space else print: '.. ' then } prompt ! ; -: stack-hide ( -- ) 0 prompt ! ; +: stack-hide ( -- ) ['] exit prompt ! ; : heap? ( a -- bool ) heap-start swap heap-end between? ; +: freemem ( -- n ) heap-end dp - ; +: usedmem ( -- n ) dp heap-start - ; -: ex-type ( exception -- ) - dup heap? if - link-type - else - . - then ; +: ex-type ( exception -- ) dup heap? if link-type else . then ; : traceback ( code -- ) cr print: "Exeption: " ex-type print: " rdepth: " rdepth . cr - rdepth 3 do + rdepth 1+ 3 do \ include ret address in outer interpreter print: " at " - rp@ i cells + @ \ i. return address - dup heap? if - cell - @ \ instruction before the return address - lastword - begin - ?dup - while - 2dup - link>xt = if dup link-type space then - @ - repeat - [ char: ( ] literal emit . [ char: ) ] literal emit cr - else - print: "??? (" . println: ")" \ not valid return address, could be doloop var - then + rp@ i cells + @ \ i. return address + lastword + begin 2dup < over 0<> and while @ repeat + ?dup if link-type space else print: '??? ' then + $( emit . $) emit cr loop - depth 0> if - print: '(stack ' - stack-print - [ char: ) ] literal emit - then + depth 0> if print: '(stack' stack-print $) emit then abort ; ' unhandled is: traceback + +/end + diff --git a/generic/forth/decompiler.forth b/generic/forth/decompiler.forth new file mode 100644 index 0000000..bf601a8 --- /dev/null +++ b/generic/forth/decompiler.forth @@ -0,0 +1,89 @@ +' TRUE @ constant: entercons +' var-handler @ constant: entervar +: ++ ( var -- ) 1 swap +! ; +: endword? ( addr -- bool ) @ ['] = ; +: >link ( xt -- link | 0 ) lastword begin ?dup while 2dup link>xt = if nip exit then @ repeat drop 0 ; + +( Hex address conversion ) +8 byte-array: num +: clear ( -- ) 8 0 do $0 i num c! loop ; +: /%16 ( n -- q r ) dup 4 rshift swap 15 and ; +: digit ( n -- chr ) dup 10 < if 48 + else 55 + then ; +: hex ( n -- ) clear 8 0 do /%16 digit 7 i - num c! ?dup 0= if unloop exit then loop ; +: .h ( n -- ) print: '16r' hex 0 num 8 type-counted ; + +( Arrows between jump locations ) +10 constant: MAX +MAX array: jumps +MAX 4 * 1+ constant: LEN +LEN buffer: arrow +variable: rownum +variable: idx +: pack ( n n -- n ) 16 lshift or ; +: unpack ( n -- n n ) dup 16rFFFF and swap 16 rshift ; +: at ( i -- dst-row src-row ) jumps @ unpack ; +: add ( dst-row src-row -- ) idx @ MAX < if pack idx @ jumps ! idx ++ else 2drop then ; +: jump? ( addr -- bool ) @ dup ['] branch0 = swap ['] branch = or ; +: positions ( branch-addr -- dst-row src-row ) cell + @ cell / rownum @ 1+ + rownum @ ; + +: collect-jumps ( xt -- ) + 0 idx ! 1 rownum ! + begin + cell + dup jump? if dup positions add then + rownum ++ + dup endword? + until + 1 rownum ! drop ; + +: head ( -- ) + idx @ 0 ?do + i at ( dst-row src-row ) + rownum @ = if $- i 1+ 4 * 3 - arrow + c! $> i 1+ 4 * 2 - arrow + c! then + rownum @ = if $< i 1+ 4 * 3 - arrow + c! $- i 1+ 4 * 2 - arrow + c! then + loop ; +: sort ( n n -- n n ) 2dup > if swap then ; +: body? ( n n -- bool ) sort rownum @ > swap rownum @ < and ; +: body ( -- ) idx @ 0 ?do i at body? if $| i 1+ 4 * 1- arrow + c! then loop ; \ arrow body +: clear ( -- ) LEN 0 do 32 i arrow + c! loop ; +: .arrow ( -- ) clear body head arrow LEN type-counted cr ; + +variable: longest +: update ( link -- ) link>len longest @ max longest ! ; +: find-longest ( xt -- ) 10 longest ! begin cell + dup @ >link ?dup if update then dup endword? until drop ; +: spaces ( n -- ) 0 ?do 32 emit loop ; +: pad ( word-len -- ) longest @ swap - spaces ; + +( Decompiler ) +: separator $: emit space space ; +: .link ( link -- ) dup link-type link>len pad ; +: .n ( n -- ) here swap >str here type here strlen pad ; +: .xt ( xt -- ) dup >link ?dup if .link drop else .n then ; + +: row ( addr -- ) dup .h separator @ .xt .arrow rownum ++ ; +: header ( xt -- ) .h separator println: '' ; +: body ( xt -- ) begin cell + dup row dup endword? until drop ; +: colon ( xt -- ) dup collect-jumps dup find-longest dup header body ; + +: header ( xt -- ) dup .h separator print: ' dataptr: ' 2 cells + .h cr ; +: does ( xt -- ) dup header println: 'behavior:' cell + @ ( behaviorptr ) cell - body ; + +: body ( xt -- ) dup .h separator @ .h cr ; +: header ( xt -- ) .h separator println: '' ; +: cons ( xt -- ) dup header cell + body ; + +: header ( xt -- ) .h separator println: '' ; +: var ( xt -- ) dup header cell + body ; + +: dump ( addr cells -- ) 0 do dup body cell + loop drop println: '...' ; + +: decompile: ( "word" -- ) + ' dup @ case + entercol of colon endof + enterdoes of does endof + entercons of cons endof + entervar of var endof + drop ( codeword ) println: 'primitive:' @ 8 dump + endcase ; + +/end + diff --git a/generic/forth/deprecated.forth b/generic/forth/deprecated.forth new file mode 100644 index 0000000..cd990ce --- /dev/null +++ b/generic/forth/deprecated.forth @@ -0,0 +1,13 @@ +: char: immediate word drop c@ interpret? invert if postpone: literal then ; ( deprecated ) + +: str: ( "string content" ) immediate ( deprecated ) + separator + interpret? if + dp swap c,-until 0 c, + else + [str swap c,-until str] + then ; + +: hex: immediate ( deprecated ) + word hex>int' + interpret? invert if postpone: literal then ; diff --git a/generic/forth/punit.forth b/generic/forth/punit.forth index 96ce916..c0b3e09 100644 --- a/generic/forth/punit.forth +++ b/generic/forth/punit.forth @@ -18,11 +18,11 @@ marker: -punit FALSE else TRUE - over 0 + c@ [ char: t ] literal = and - over 1 + c@ [ char: e ] literal = and - over 2 + c@ [ char: s ] literal = and - over 3 + c@ [ char: t ] literal = and - over 4 + c@ [ char: : ] literal = and + over 0 + c@ $t = and + over 1 + c@ $e = and + over 2 + c@ $s = and + over 3 + c@ $t = and + over 4 + c@ $: = and then nip ; @@ -70,11 +70,9 @@ marker: -punit test-reset lastword begin - dup 0<> + dup while - dup test? if - dup test-run - then + dup test? if dup test-run then @ repeat drop @@ -83,8 +81,11 @@ marker: -punit \ Runs a single unit tests then prints out the test report. : test: ( "testname" -- ) cr test-reset - word find dup 0<> if + word find ?dup if test-run else - drop println: "No such test" + println: "No such test" then ; + +/end + diff --git a/generic/forth/ringbuf.forth b/generic/forth/ringbuf.forth index 835ab7f..7d061e8 100644 --- a/generic/forth/ringbuf.forth +++ b/generic/forth/ringbuf.forth @@ -68,3 +68,6 @@ constant: RingBuf front-slot @ swap removed ; + +/end + diff --git a/generic/forth/ringbuf_test.forth b/generic/forth/ringbuf_test.forth index 4dbefbf..091d2f2 100644 --- a/generic/forth/ringbuf_test.forth +++ b/generic/forth/ringbuf_test.forth @@ -66,4 +66,3 @@ marker: -ringbuf-test 2 over ringbuf-enqueue 3 over ringbuf-enqueue } catch EOVERFLOW =assert ; - diff --git a/generic/forth/test.forth b/generic/forth/test.forth index 76734de..5401861 100644 --- a/generic/forth/test.forth +++ b/generic/forth/test.forth @@ -4,18 +4,18 @@ exception: EFAC exception: ETEST : factorial ( n -- n! | throws:EFAC ) - dup 0< if - drop EFAC throw - then - dup 0= if - drop 1 - else - dup 1= if - drop 1 - else - dup 1- factorial * - then - then ; + dup 0< if + drop EFAC throw + then + dup 0= if + drop 1 + else + dup 1= if + drop 1 + else + dup 1- factorial * + then + then ; : factorial2 ( n -- n! ) 1 2 rot @@ -52,7 +52,7 @@ variable: test_var2 defer: deferred-word : use-deferred 2 3 deferred-word ; -: test:core-arithmetic +: test:arithmetic 12 3 min 3 =assert -3 7 min -3 =assert -3 -7 min -7 =assert @@ -92,22 +92,22 @@ defer: deferred-word 12 3 /mod 4 =assert 0 =assert 12 4 / 3 =assert 13 5 /mod 2 =assert 3 =assert 14 6 % 2 =assert ; -: test:core-branch +: test:branch TRUE if TRUE assert else FALSE assert then FALSE if FALSE assert else TRUE assert then 2 TRUE if dup * then 4 =assert 2 FALSE if dup * then 2 =assert ; -: test:core-bounds +: test:bounds 10000 5 bounds 10000 =assert 10005 =assert ; -: test:core-?dup +: test:?dup 42 0 ?dup 0 =assert 42 =assert 42 12 ?dup 12 =assert 12 =assert 42 =assert ; 424242 constant: SENTINEL -: test:core-doloop +: test:doloop SENTINEL 10000 5 bounds do i loop 10004 =assert 10003 =assert 10002 =assert 10001 =assert 10000 =assert SENTINEL =assert @@ -122,11 +122,18 @@ defer: deferred-word SENTINEL 0 0 do i -1 +loop 0 =assert SENTINEL =assert 0 8 2 do 9 3 do i j + + loop loop 360 =assert ; +: test:?doloop + 10 10 ?do EASSERT throw loop + 0 0 ?do EASSERT throw loop + 0 11 1 ?do i + loop 55 =assert + 5 5 ?do EASSERT throw +loop + 0 50 0 do i + 5 +loop 225 =assert ; + : doloop-exit 10 0 do i 5 = if i unloop exit then loop ; -: test:core-unloop +: test:unloop doloop-exit 5 =assert ; -: test:core-logic +: test:logic 1 0 or 1 =assert 0 1 or 1 =assert 1 1 or 1 =assert 0 0 or 0 =assert 1 0 and 0 =assert 0 1 and 0 =assert @@ -137,7 +144,7 @@ defer: deferred-word 3 10 < 3 11 > and if 1 else 0 then 0 =assert -98 45 < 33 11 > and if 1 else 0 then 1 =assert ; -: test:core-between +: test:between 1 2 3 between? assert 1 1 1 between? assert 1 1 2 between? assert @@ -145,23 +152,28 @@ defer: deferred-word 3 2 4 between? invert assert 1 3 2 between? invert assert ; -: test:core-factorial +: test:factorial 9 factorial 362880 =assert 8 factorial 8 factorial2 =assert 9 factorial 9 factorial3 =assert ; -: test:core-hex - str: "aBcDeF" hex>int 11259375 =assert - str: "AbCdEf" hex>int 11259375 =assert - str: "12345678" hex>int 305419896 =assert - str: "a1" hex>int 161 =assert - str: "123abc" hex>int 1194684 =assert - { str: "" hex>int } catch ECONVERT =assert - { str: "123g4" hex>int } catch ECONVERT =assert - { str: "12G4" hex>int } catch ECONVERT =assert - hex: a0f 2575 =assert ; - -: test:core-case +: test:hex + "aBcDeF" hex>int 11259375 =assert + "AbCdEf" hex>int 11259375 =assert + "123abc" hex>int 1194684 =assert + { "" hex>int } catch ECONVERT =assert + { "123g4" hex>int } catch ECONVERT =assert + { "12G4" hex>int } catch ECONVERT =assert ; + +: test:hex-literal + 16raBcDeF 11259375 =assert + 16rAbCdEf 11259375 =assert + 16r12345678 305419896 =assert + 16ra1 161 =assert + 16r123abc 1194684 =assert + 16rA0F 2575 =assert ; + +: test:case 1 case 1 of 10 endof 2 of 20 endof @@ -182,7 +194,7 @@ defer: deferred-word 2 of 3 endof endcase 2 =assert ; -: test:core-defer +: test:defer ['] deferred-word is: + use-deferred 5 =assert ['] deferred-word is: * @@ -203,7 +215,7 @@ defer: deferred-word : simple-throw 123 throw ; : throw-if-42 42 = if ETEST throw then ; -: test:core-catch +: test:catch sp@ test_var1 ! ['] negative-factorial catch EFAC =assert ['] 1nested-throw2 catch 30 =assert @@ -216,7 +228,7 @@ defer: deferred-word sp@ test_var2 ! test_var1 @ test_var2 @ =assert ; -: test:core-rdepth +: test:rdepth rdepth 1 >r 2 >r 3 >r dup 3 + rdepth =assert @@ -225,61 +237,50 @@ defer: deferred-word r> drop rdepth =assert ; -: test:core-alloc +: test:alloc freemem 16 allot freemem - 16 =assert ; -: test:core-str - str: "" strlen 0 =assert - str: "1" strlen 1 =assert - str: "12" strlen 2 =assert - str: "1234567" strlen 7 =assert - str: '""""' strlen 4 =assert - str: 'anystring' - str: '' - str-starts? TRUE =assert - str: '' - str: '' - str-starts? TRUE =assert - str: 'abc' - str: 'bc' +: test:str + "" strlen 0 =assert + "1" strlen 1 =assert + "12" strlen 2 =assert + "1234567" strlen 7 =assert + "anystring" "" str-starts? TRUE =assert + "" "" str-starts? TRUE =assert + "abc" + "bc" str-starts? FALSE =assert - str: 'abc' - str: 'ab' + "abc" + "ab" str-starts? TRUE =assert - str: 'aabbc' - str: 'aabbc' + "aabbc" + "aabbc" str-starts? TRUE =assert - str: 'aabbc' - str: 'aabbcc' + "aabbc" + "aabbcc" str-starts? FALSE =assert - str: 'abcxxxx' - str: 'abc' + "abcxxxx" + "abc" str-in? TRUE =assert - str: 'xxabcyy' - str: 'abc' + "xxabcyy" + "abc" str-in? TRUE =assert - str: 'xxabzyy' - str: 'abc' + "xxabzyy" + "abc" str-in? FALSE =assert - str: 'anystring' - str: '' - str-in? assert - str: 'xxx' - str: 'xxx' - str-in? assert - str: 'abcdef' - str: 'def' + "anystring" + "" str-in? assert - str: 'abcdef' - str: 'efg' - str-in? FALSE =assert - str: "" str: "" =str assert - str: "1" str: "12" =str invert assert - str: "" str: "12" =str invert assert - str: "1" str: "2" =str invert assert - str: "12" str: "13" =str invert assert - str: "abcd" str: "abcde" =str invert assert - str: "abcdef" str: "abcdeF" =str invert assert ; + "xxx" "xxx" str-in? assert + "abcdef" "def" str-in? assert + "abcdef" "efg" str-in? FALSE =assert + "" "" =str assert + "1" "12" =str invert assert + "" "12" =str invert assert + "1" "2" =str invert assert + "12" "13" =str invert assert + "abcd" "abcde" =str invert assert + "abcdef" "abcdeF" =str invert assert ; : test:eval-whitespace 32 whitespace? assert @@ -288,8 +289,7 @@ defer: deferred-word 9 whitespace? assert 65 whitespace? invert assert ; -: test:core-multi-line-str -str: +: test:multi-line-str " A\n B @@ -300,18 +300,20 @@ B dup 2 + c@ 66 = assert drop ; -: test:core-str-escape - str: 'a\nb' 1 + c@ 10 =assert - str: '\rb' c@ 13 =assert - str: '\\' c@ 92 =assert - str: '\\\\' strlen 2 =assert - str: '\t' c@ 9 =assert - str: 'abc\r\nd' strlen 6 =assert ; - -: test:core-untilloop +: test:str-escape + "a\nb" 1 + c@ 10 =assert + "\rb" c@ 13 =assert + "\\" c@ 92 =assert + "\\\\" strlen 2 =assert + "\t" c@ 9 =assert + "\"" c@ 34 =assert + "\'" c@ 39 =assert + "abc\r\nd" strlen 6 =assert ; + +: test:untilloop 2 10 begin 1- swap 2 * swap dup 0= until drop 2048 =assert ; -: test:core-quotation +: test:quotation 10 { } execute 10 =assert 6 { dup + } execute 12 =assert 3 4 { 1+ swap 2 * swap } execute 5 =assert 6 =assert @@ -321,20 +323,20 @@ B 12 { 1+ { 1+ } execute } execute 14 =assert 10 { 1+ { 1+ { 1+ } execute } execute } execute 13 =assert ; -: test:core-combinators +: test:combinators 1 2 4 { + } dip 4 =assert 3 =assert 1 2 4 { + } keep 4 =assert 6 =assert 1 =assert - str: "john" str: ".doe" { 1+ c@ } { 2 + c@ } bi* =assert - str: "john" str: ".doe" { strlen } bi@ =assert - str: "john.doe" { strlen } { 1+ c@ 103 - } bi =assert ; + "john" ".doe" { 1+ c@ } { 2 + c@ } bi* =assert + "john" ".doe" { strlen } bi@ =assert + "john.doe" { strlen } { 1+ c@ 103 - } bi =assert ; -: test:core-array +: test:array 5 0 do i i test_numbers ! loop 5 0 do i test_numbers @ i =assert loop ; create: seq1 1 , 2 , 3 , create: seq2 4 c, 5 c, -: test:core-create +: test:create seq1 0 cells + @ 1 =assert seq1 1 cells + @ 2 =assert seq1 2 cells + @ 3 =assert @@ -342,7 +344,7 @@ create: seq2 4 c, 5 c, seq2 1 + c@ 5 =assert ; 3 buffer: buf1 -: test:core-buffer +: test:buffer 1 buf1 0 + c! 2 buf1 1 + c! 3 buf1 2 + c! @@ -350,29 +352,60 @@ create: seq2 4 c, 5 c, buf1 1 + c@ 2 =assert buf1 2 + c@ 3 =assert ; -: test:core-struct +: test:struct 3 r1 .width ! 5 r1 .height ! r1 area 15 =assert ; -: test:core-var +: test:var 12 test_var1 ! test_var1 @ 12 =assert 3 test_var1 +! test_var1 @ 15 =assert ; : to-override 42 ; : to-override override to-override 3 + ; -: test:core-override +: test:override to-override 45 =assert ; +: test:>str + here dup 1234567 >str "1234567" =str assert + here dup 1234 >str "1234" =str assert + here dup -123 >str "-123" =str assert + here dup -87654321 >str "-87654321" =str assert + here dup 1 >str "1" =str assert + here dup -1 >str "-1" =str assert + here dup 2147483647 >str "2147483647" =str assert + here dup -2147483647 >str "-2147483647" =str assert + here dup 0 >str "0" =str assert ; + +"123" constant: s1 +"abcdef" constant: s2 +: test:cmove + s1 s2 0 cmove s2 "abcdef" =str assert + s1 s2 1 cmove s2 "1bcdef" =str assert + s1 s2 3 cmove s2 "123def" =str assert ; + variable: dp-before-mark dp dp-before-mark ! marker: -test-mark : word-after-marker 1 2 3 ; 237 allot -: test:core-marker +: test:marker -test-mark dp dp-before-mark @ =assert ; +: test:r@ + 123 >r r@ 123 =assert r> drop + -34 >r r@ -34 =assert r> drop ; + +: test:[ + [ 60 5 + ] literal 65 =assert ; + +: test:[2 + 1 if [ 60 5 + ] literal then 65 =assert ; + depth 0= assert test depth 0= assert -tests + +/end + diff --git a/generic/macros.S b/generic/macros.S index 9b8d4af..4eac915 100644 --- a/generic/macros.S +++ b/generic/macros.S @@ -33,5 +33,5 @@ xt_\label : .endm .macro lbl label - .int \label - . - CELLS + .int \label - . .endm diff --git a/generic/outerinterpreter.S b/generic/outerinterpreter.S index 3814fea..8695630 100644 --- a/generic/outerinterpreter.S +++ b/generic/outerinterpreter.S @@ -5,6 +5,24 @@ outer_interpreter: .int xt_word // ( a len ) - .int xt_token_eval + .int xt_dup2 + .int xt_find, xt_dup, xt_branch0 // dictionary lookup returns (link | 0) + lbl not_found_in_dictionary + .int xt_link2xt + .int xt_nip, xt_nip + .int xt_execute + .int xt_branch + lbl outer_interpreter +not_found_in_dictionary: // word was not found in the dictionary try to convert it to number + .int xt_drop // 0 + .int xt_dup2 // save (len wordadr) for printing if error occurs during conversion + .int xt_tonumber + .int xt_branch0 + lbl invalid_number + .int xt_nip, xt_nip // drop saved word + .int xt_branch + lbl outer_interpreter +invalid_number: + .int xt_eundefi, xt_fetch, xt_execute .int xt_branch lbl outer_interpreter diff --git a/generic/words.S b/generic/words.S index ad38050..6af0177 100644 --- a/generic/words.S +++ b/generic/words.S @@ -1,19 +1,23 @@ // Predefined words in binary (compiled) forth -defword "nip",3,nip,REGULAR +defword "nip",3,nip,REGULAR /* ( a b -- b ) */ .int xt_swap .int xt_drop - .int xt_exit + .int xt_end_word +.ifndef xt_drop2 defword "2drop",5,"drop2",REGULAR .int xt_drop .int xt_drop - .int xt_exit + .int xt_end_word +.endif +.ifndef xt_drop4 defword "4drop",5,"drop4",REGULAR .int xt_drop2 .int xt_drop2 - .int xt_exit + .int xt_end_word +.endif .ifndef xt_over defword "over",4,over,REGULAR /* ( a b -- a b a ) */ @@ -21,34 +25,38 @@ defword "over",4,over,REGULAR /* ( a b -- a b a ) */ .int xt_dup .int xt_rot .int xt_swap - .int xt_exit + .int xt_end_word .endif +.ifndef xt_dup2 defword "2dup",4,dup2,REGULAR .int xt_over .int xt_over - .int xt_exit + .int xt_end_word +.endif +.ifndef xt_mrot defword "-rot",4,mrot,REGULAR /*( a b c -- c a b ) */ .int xt_rot, xt_rot - .int xt_exit + .int xt_end_word +.endif defword "tuck",4,tuck,REGULAR /* ( a b -- b a b ) */ .int xt_swap, xt_over - .int xt_exit + .int xt_end_word defword "_s0",3,us0,REGULAR .int xt_btick, _M stack_top, xt_fetch - .int xt_exit + .int xt_end_word defword "_r0",3,ur0,REGULAR .int xt_btick, _M rstack_top - .int xt_exit + .int xt_end_word .ifndef xt_gt defword ">",1,gt,REGULAR .int xt_swap, xt_lt - .int xt_exit + .int xt_end_word .endif .ifndef xt_eq @@ -56,125 +64,117 @@ defword "=",1,eq,REGULAR .int xt_dup2 .int xt_lt, xt_invert, xt_mrot .int xt_swap, xt_lt, xt_invert, xt_and // !(a < b) and !(b < a) - .int xt_exit + .int xt_end_word .endif .ifndef xt_gte defword ">=",2,gte,REGULAR .int xt_lt, xt_invert - .int xt_exit + .int xt_end_word .endif .ifndef xt_lte defword "<=",2,lte,REGULAR .int xt_swap, xt_lt, xt_invert - .int xt_exit + .int xt_end_word .endif .ifndef xt_eq0 defword "0=",2,eq0,REGULAR .int xt_btick, 0, xt_eq - .int xt_exit + .int xt_end_word .endif .ifndef xt_noteq0 defword "0<>",3,noteq0,REGULAR .int xt_btick, 0, xt_noteq - .int xt_exit + .int xt_end_word .endif .ifndef xt_eq1 defword "1=",2,eq1,REGULAR .int xt_btick, 1, xt_eq - .int xt_exit + .int xt_end_word .endif .ifndef xt_lt0 defword "0<",2,lt0,REGULAR .int xt_btick, 0, xt_lt - .int xt_exit + .int xt_end_word .endif .ifndef xt_gt0 defword "0>",2,gt0,REGULAR .int xt_btick, 0, xt_gt - .int xt_exit + .int xt_end_word .endif .ifndef xt_inc defword "1+",2,inc,REGULAR .int xt_btick, 1, xt_plus - .int xt_exit + .int xt_end_word .endif .ifndef xt_dec defword "1-",2,dec,REGULAR .int xt_btick, 1, xt_minus - .int xt_exit + .int xt_end_word .endif .ifndef xt_cells defword "cells",5,cells,REGULAR .int xt_cell, xt_multiply - .int xt_exit + .int xt_end_word .endif defword "cell",4,cell,REGULAR .int xt_btick, CELLS - .int xt_exit + .int xt_end_word defword ",",1,comma,REGULAR .int xt_here, xt_store .int xt_here, xt_cell, xt_plus .int xt_var_dp, xt_store - .int xt_exit + .int xt_end_word defword "c,",2,commabyte,REGULAR .int xt_dp, xt_storebyte .int xt_dp, xt_inc .int xt_var_dp, xt_store - .int xt_exit + .int xt_end_word .ifndef xt_fetchbyte defword "c@",2,fetchbyte,REGULAR .int xt_fetch, xt_btick, 255, xt_and - .int xt_exit + .int xt_end_word .endif .ifndef xt_noteq defword "<>",2,noteq,REGULAR .int xt_eq, xt_invert - .int xt_exit + .int xt_end_word .endif defword ">in",3,toin,REGULAR .int xt_btick, _M input_index - .int xt_exit + .int xt_end_word defword "#tib",4,inputlen,REGULAR .int xt_btick, _M input_size - .int xt_exit + .int xt_end_word defword "tib",3,tib,REGULAR .int xt_btick, _M input_buffer - .int xt_exit + .int xt_end_word defword "state",5,state,REGULAR .int xt_btick, _M state_var - .int xt_exit - -defword "[",1,openbracket,IMMEDIATE - .int xt_btick, STATE_INTERPRET, xt_btick, state_var, xt_store - .int xt_exit + .int xt_end_word -defword "]",1,closebracket,REGULAR - .int xt_btick, STATE_COMPILE, xt_btick, state_var, xt_store - .int xt_exit - defword "literal",7,literal,IMMEDIATE .int xt_btick, xt_btick, xt_comma .int xt_comma - .int xt_exit + .int xt_end_word defword "compare",7,compare,REGULAR /*( a1 len1 a2 len2 - bool ) */ .int xt_rot, xt_swap // (a1 a2 len1 len2) @@ -205,7 +205,7 @@ compare_not_equal: compare_length_mismatch: .int xt_drop, xt_drop, xt_drop, xt_drop .int xt_btick, FALSE - .int xt_exit + .int xt_end_word defword "find",4,find,REGULAR /* ( a len -- link | 0 ) */ .int xt_lastword @@ -234,48 +234,44 @@ find_found: find_not_found: .int xt_drop, xt_drop, xt_drop .int xt_btick, 0 - .int xt_exit + .int xt_end_word defword "align",5,align,REGULAR .int xt_btick, 3, xt_plus, xt_btick, 3, xt_invert, xt_and - .int xt_exit + .int xt_end_word defword "here",4,here,REGULAR .int xt_dp, xt_align - .int xt_exit + .int xt_end_word defword "dp",2,dp,REGULAR .int xt_var_dp, xt_fetch - .int xt_exit + .int xt_end_word defword "var-dp",6,var_dp,REGULAR .int xt_btick, _M var_dp - .int xt_exit + .int xt_end_word defword "heap-start",10,heap_start,REGULAR .int xt_btick, _M dictionary - .int xt_exit + .int xt_end_word defword "heap-end",8,heap_end,REGULAR .int xt_btick, _M end_dictionary - .int xt_exit - -defword "freemem",7,freemem,REGULAR - .int xt_heap_end, xt_dp, xt_minus - .int xt_exit + .int xt_end_word defword "align!",6,align_bang,REGULAR /* ( -- ) */ .int xt_here, xt_align, xt_var_dp, xt_store - .int xt_exit + .int xt_end_word defword "allot",5,allot,REGULAR /* ( n -- ) */ .int xt_here, xt_plus, xt_align, xt_var_dp, xt_store - .int xt_exit + .int xt_end_word defword "createheader",12,createheader,REGULAR .int xt_word, xt_swap - .int xt_btick, _M LAST_WORD, xt_fetch, xt_comma // store link to previous word - .int xt_here, xt_cell, xt_minus, xt_btick, _M LAST_WORD, xt_store // update last word + .int xt_btick, _M var_last_word, xt_fetch, xt_comma // store link to previous word + .int xt_here, xt_cell, xt_minus, xt_btick, _M var_last_word, xt_store // update last word .int xt_swap, xt_dup, xt_btick, _M REGULAR, xt_or, xt_commabyte // write length + flags create_write_next_char: .int xt_dup, xt_branch0 @@ -288,70 +284,55 @@ create_write_next_char: create_name_done: .int xt_drop, xt_drop .int xt_here, xt_var_dp, xt_store // align after name - .int xt_exit + .int xt_end_word -defword ";",1,semicolon,IMMEDIATE - .int xt_openbracket - .int xt_btick, xt_exit, xt_comma - .int xt_lastword, xt_reveal - .int xt_exit - -defword ">number",7,tonumber,REGULAR /* ( a len -- num bool ) */ +defword ">number",7,tonumber,REGULAR /* ( a len -- number TRUE | FALSE ) */ .int xt_dup, xt_branch0 lbl tonum_empty - .int xt_swap, xt_dup, xt_fetchbyte, xt_btick, 45, xt_eq // check sign + .int xt_over, xt_fetchbyte, xt_btick, 45, xt_eq // check sign .int xt_branch0 lbl tonum_positive + .int xt_dec //( len ) + .int xt_swap + .int xt_inc //( addr ) .int xt_swap - .int xt_dec // decrement length - .int xt_dup, xt_rpush // move length to return stack - .int xt_plus // move to the last char of the number string - .int xt_btick, 0 - .int xt_btick, -1 // ( a res mul ) - .int xt_rpop, xt_dec, xt_rpush // decrement length once more because of the negative sign + .int xt_btick, -1, xt_rpush // store sign on rstack .int xt_branch - lbl tonum_loop + lbl start_convert tonum_positive: - .int xt_swap - .int xt_dec // decrement length - .int xt_dup, xt_rpush // move length to return stack - .int xt_plus // move to the last char of the number string - .int xt_btick, 0 - .int xt_btick, 1 // ( a res mul ) + .int xt_btick, 1, xt_rpush +start_convert: + .int xt_btick, 0, xt_swap //( addr result len ) tonum_loop: - .int xt_rot // ( res mul a ) - .int xt_dup, xt_fetchbyte + .int xt_dup, xt_branch0 + lbl tonum_done + .int xt_mrot + .int xt_btick, 10, xt_multiply + .int xt_over, xt_fetchbyte .int xt_dup, xt_btick, 47, xt_gt, xt_branch0 // check range lbl tonum_invalid_digit .int xt_dup, xt_btick, 58, xt_lt, xt_branch0 lbl tonum_invalid_digit - .int xt_btick, 48, xt_minus // ( res mul a digit ) - .int xt_swap, xt_dec, xt_swap // decrement a - .int xt_swap2 // ( a digit res mul ) - .int xt_rot // ( a res mul digit) - .int xt_over // ( a res mul digit mul ) - .int xt_multiply // ( a res mul digit*mul ) - .int xt_rot // ( a mul digit*mul res ) - .int xt_plus // ( a mul res ) - .int xt_swap, xt_btick, 10, xt_multiply // ( a res mul ) - .int xt_rpat, xt_fetch, xt_branch0 - lbl tonum_done - .int xt_rpop, xt_dec, xt_rpush // decrement length on return stack + .int xt_btick, 48, xt_minus, xt_plus + .int xt_swap, xt_inc, xt_swap + .int xt_rot, xt_dec // ( len ) .int xt_branch lbl tonum_loop tonum_done: - .int xt_rpop, xt_drop - .int xt_drop, xt_nip + .int xt_drop //( len ) + .int xt_rpop, xt_multiply //( * sign ) + .int xt_nip //( addr ) .int xt_btick, TRUE .int xt_exit tonum_invalid_digit: - .int xt_rpop, xt_drop4, xt_drop + .int xt_rpop, xt_drop //( sign ) + .int xt_drop4 .int xt_btick, FALSE .int xt_exit tonum_empty: .int xt_drop2 .int xt_btick, FALSE - .int xt_exit + .int xt_end_word defword "word",4,word,REGULAR /* ( -- a len ) */ .int xt_btick, 0 @@ -394,36 +375,87 @@ word_too_long: .int xt_abort defword ":",1,colon,REGULAR - .int xt_closebracket .int xt_createheader .int xt_btick, _M ENTERCOL, xt_comma // codeword is ENTERCOL - .int xt_exit + .int xt_compiler + .int xt_end_word + +defword "eundef",6,eundef,REGULAR + .int xt_btick, undef_word_error, xt_type + .int xt_typecounted + .int xt_btick, 13, xt_emit + .int xt_btick, 10, xt_emit + .int xt_tib, xt_inputlen, xt_fetch, xt_plus, xt_toin, xt_store // skip rest of the inputbuffer + .int xt_end_word + +defword "]",1,compiler,REGULAR + .int xt_btick, STATE_COMPILE, xt_btick, state_var, xt_store +compile: + .int xt_word // ( a len ) + .int xt_dup2, xt_btick, 1, xt_eq, xt_swap, xt_fetchbyte, xt_btick, 91, xt_eq, xt_and, xt_invert // is [ ? + .int xt_branch0 + lbl suspend_compile + .int xt_dup2, xt_btick, 1, xt_eq, xt_swap, xt_fetchbyte, xt_btick, 59, xt_eq, xt_and // is ; ? + .int xt_branch0 + lbl no_end + .int xt_drop2, xt_btick, xt_end_word, xt_comma + .int xt_btick, STATE_INTERPRET, xt_btick, state_var, xt_store + .int xt_lastword, xt_reveal, xt_exit +no_end: + .int xt_dup2, xt_find, xt_dup // ( link | 0 ) + .int xt_branch0 + lbl not_found_dict + .int xt_nip, xt_nip, xt_dup, xt_is_immediate + .int xt_branch0 + lbl do_compile + .int xt_link2xt, xt_execute + .int xt_branch + lbl compile +do_compile: + .int xt_link2xt, xt_comma + .int xt_branch + lbl compile +not_found_dict: + .int xt_drop // 0 + .int xt_dup2, xt_tonumber + .int xt_branch0 + lbl undefword + .int xt_nip, xt_nip + .int xt_literal // we're in compile mode, compile a literal number + .int xt_branch + lbl compile +undefword: + .int xt_eundefc, xt_fetch, xt_execute + .int xt_branch + lbl compile +suspend_compile: + .int xt_drop2 + .int xt_btick, STATE_INTERPRET, xt_btick, state_var, xt_store + .int xt_end_word + +defword "eundefi",7,eundefi,REGULAR + .int xt_btick, _M var_eundefi_xt + .int xt_end_word + +defword "eundefc",7,eundefc,REGULAR + .int xt_btick, _M var_eundefc_xt + .int xt_end_word defword "xemit",5,xemit,REGULAR .int xt_btick, _M var_emit_xt - .int xt_exit + .int xt_end_word defword "emit",4,emit,REGULAR // ( char -- ) - .int xt_xemit, xt_fetch, xt_branch0 - lbl emit_fallback .int xt_xemit, xt_fetch, xt_execute - .int xt_exit -emit_fallback: - .int xt_uemit - .int xt_exit + .int xt_end_word defword "xtype",5,xtype,REGULAR .int xt_btick, _M var_type_xt - .int xt_exit + .int xt_end_word defword "type",4,type,REGULAR // ( asciiz -- ) - .int xt_xtype, xt_fetch, xt_branch0 - lbl type_fallback - .int xt_xtype, xt_fetch, xt_execute - .int xt_exit -type_fallback: - .int xt_utype - .int xt_exit + .int xt_xtype, xt_fetch, xt_execute + .int xt_end_word .ifndef xt_utype defword "_type",5,utype,REGULAR // ( asciiz -- ) @@ -436,7 +468,7 @@ type_next_char: lbl type_next_char type_done: .int xt_drop - .int xt_exit + .int xt_end_word .endif .ifndef xt_typecounted @@ -453,7 +485,7 @@ type_counted_next_char: lbl type_counted_next_char type_counted_done: .int xt_drop2 - .int xt_exit + .int xt_end_word .endif defword "chr>in",6,char_toin,REGULAR /* (chr -- ) */ @@ -470,21 +502,26 @@ inbuf_overflow: defword "in>char",7,char_fromin,REGULAR /* ( -- chr ) */ .int xt_toin, xt_fetch, xt_fetchbyte // fetch next character from inputbuffer .int xt_toin, xt_fetch, xt_inc, xt_toin, xt_store // increment input index - .int xt_exit + .int xt_end_word defword "prompt",6,prompt,REGULAR .int xt_btick, _M var_prompt_xt - .int xt_exit + .int xt_end_word defword "show_prompt",11,show_prompt,REGULAR - .int xt_prompt, xt_fetch, xt_dup - .int xt_branch0 - lbl show_prompt_no_prompt - .int xt_execute - .int xt_exit -show_prompt_no_prompt: - .int xt_drop - .int xt_exit + .int xt_prompt, xt_fetch, xt_execute + .int xt_end_word + +.ifndef xt_end_load +defword "/end",4,end_load,REGULAR // dummy, used by esp port + .int xt_end_word +.endif + +.ifndef xt_loading +defword "loading?",8,loading,REGULAR // dummy, used by esp port + .int xt_btick, 0 + .int xt_end_word +.endif defword "key",3,key,REGULAR .int xt_tib, xt_inputlen, xt_fetch, xt_plus @@ -501,7 +538,7 @@ refill_buffer: .int xt_tib, xt_toin, xt_store read_one_char_from_buffer: .int xt_char_fromin - .int xt_exit + .int xt_end_word defword "compile-time",12,compile_time,REGULAR .int xt_state, xt_fetch, xt_btick, STATE_COMPILE, xt_eq @@ -510,107 +547,80 @@ defword "compile-time",12,compile_time,REGULAR .int xt_exit cannot_interpret_compile_only_word: .int xt_btick, _M compile_only_warning, xt_type - .int xt_exit + .int xt_end_word defword "var-lastword",12,var_lastword,REGULAR - .int xt_btick, _M LAST_WORD - .int xt_exit + .int xt_btick, _M var_last_word + .int xt_end_word defword "lastword",8,lastword,REGULAR .int xt_var_lastword, xt_fetch - .int xt_exit + .int xt_end_word + +defword "constant:",9,constant,REGULAR + .int xt_createheader + .int xt_btick, _M ENTERCONST, xt_comma, xt_comma + .int xt_end_word + +defword "init-variable:",14,initvar,REGULAR + .int xt_createheader + .int xt_btick, _M ENTERVAR, xt_comma, xt_comma + .int xt_end_word defword "enterdoes",9,enterdoes,REGULAR .int xt_btick, _M ENTERDOES - .int xt_exit + .int xt_end_word defword "entercol",8,entercol,REGULAR .int xt_btick, _M ENTERCOL - .int xt_exit + .int xt_end_word defword "link>flb",8,link2flb,REGULAR /* ( a1 -- a2 ) */ .int xt_cell, xt_plus - .int xt_exit + .int xt_end_word defword "link>len",8,link2len,REGULAR /* ( a1 -- len ) */ .int xt_link2flb, xt_fetchbyte, xt_btick, 0b00111111, xt_and - .int xt_exit + .int xt_end_word defword "link>flags",10,link2flags,REGULAR /* ( a1 -- flags ) */ .int xt_link2flb, xt_fetchbyte, xt_btick, 0b11000000, xt_and - .int xt_exit + .int xt_end_word defword "link>name",9,link2name,REGULAR /* ( a1 -- a2 ) */ .int xt_cell, xt_plus, xt_inc - .int xt_exit + .int xt_end_word defword "link>xt",7,link2xt,REGULAR /* ( a1 -- a2 ) */ .int xt_dup, xt_link2name, xt_swap .int xt_link2len, xt_plus, xt_align - .int xt_exit + .int xt_end_word defword "link>body",9,link2body,REGULAR /* ( a1 -- a2 ) */ .int xt_link2xt, xt_cell, xt_plus - .int xt_exit + .int xt_end_word defword "hidden?",7,is_hidden,REGULAR /* link -- bool */ .int xt_link2flags, xt_btick, HIDDEN, xt_and, xt_btick, HIDDEN, xt_eq - .int xt_exit + .int xt_end_word defword "hide",4,hide,REGULAR /* ( link -- ) */ .int xt_btick, HIDDEN, xt_over, xt_link2flb, xt_fetchbyte, xt_or .int xt_swap, xt_link2flb, xt_storebyte - .int xt_exit + .int xt_end_word defword "reveal",6,reveal,REGULAR /* ( link -- ) */ .int xt_btick, HIDDEN, xt_invert, xt_over, xt_link2flb, xt_fetchbyte, xt_and .int xt_swap, xt_link2flb, xt_storebyte - .int xt_exit + .int xt_end_word defword "immediate?",10,is_immediate,REGULAR /* ( link -- bool) */ .int xt_link2flags, xt_btick, IMMEDIATE, xt_and, xt_btick, IMMEDIATE, xt_eq - .int xt_exit + .int xt_end_word +FINAL_WORD: defword "immediate",9,immediate,IMMEDIATE .int xt_btick, IMMEDIATE, xt_lastword, xt_link2flb, xt_fetchbyte, xt_or .int xt_lastword, xt_link2flb, xt_storebyte - .int xt_exit + .int xt_end_word -FINAL_WORD: -defword "token-eval",10,token_eval,REGULAR /* ( word-adr len -- ) */ - .int xt_dup2 - .int xt_find, xt_dup, xt_branch0 // dictionary lookup returns (link | 0) - lbl not_found_in_dictionary - .int xt_dup, xt_link2xt // get the xt and flags of the word - .int xt_swap, xt_is_immediate, xt_invert - .int xt_branch0 - lbl interpret // if immediate word then interpet even if we're in compilation mode - .int xt_state, xt_fetch // if non immediate word, interpret or compile depending on state - .int xt_branch0 - lbl interpret - .int xt_nip, xt_nip - .int xt_comma // compile the xt into the current word definition - .int xt_exit -interpret: - .int xt_nip, xt_nip - .int xt_execute - .int xt_exit -not_found_in_dictionary: // word was not found in the dictionary try to convert it to number - .int xt_drop - .int xt_dup2 // save (len wordadr) for printing if error occurs during conversion - .int xt_tonumber - .int xt_branch0 - lbl invalid_number - .int xt_nip, xt_nip // drop saved word - .int xt_state, xt_fetch, xt_branch0 // depending on state compile number literal or push number to the stack - lbl eval_exit - .int xt_literal // we're in compile mode, compile a literal number - .int xt_exit -invalid_number: - .int xt_btick, undef_word_error, xt_type - .int xt_typecounted - .int xt_btick, 10, xt_emit - .int xt_tib, xt_inputlen, xt_fetch, xt_plus, xt_toin, xt_store // skip rest of the inputbuffer - .int xt_openbracket // switch back to interpret mode -eval_exit: - .int xt_exit diff --git a/license.txt b/license.txt new file mode 100644 index 0000000..7e915fa --- /dev/null +++ b/license.txt @@ -0,0 +1,13 @@ +CC0 1.0 Universal (CC0 1.0) Public Domain Dedication +==================================================== + +No Copyright + +This license is acceptable for Free Cultural Works. +The person who associated a work with this deed has dedicated the work to the public domain by waiving all of his or her rights to the work worldwide under copyright law, including all related and neighboring rights, to the extent allowed by law. + +You can copy, modify, distribute and perform the work, even for commercial purposes, all without asking permission. See Other Information below. + +In no way are the patent or trademark rights of any person affected by CC0, nor are the rights that other persons may have in the work or in how the work is used, such as publicity or privacy rights. +Unless expressly stated otherwise, the person who associated a work with this deed makes no warranties about the work, and disclaims liability for all uses of the work, to the fullest extent permitted by applicable law. +When using or citing the work, you should not imply endorsement by the author or the affirmer. diff --git a/screenshot/sonoff1.jpg b/screenshot/sonoff1.jpg new file mode 100644 index 0000000..8539fb4 Binary files /dev/null and b/screenshot/sonoff1.jpg differ diff --git a/screenshot/sonoff2.jpg b/screenshot/sonoff2.jpg new file mode 100644 index 0000000..5fd96e7 Binary files /dev/null and b/screenshot/sonoff2.jpg differ diff --git a/screenshot/sonoff3.png b/screenshot/sonoff3.png new file mode 100644 index 0000000..93a0881 Binary files /dev/null and b/screenshot/sonoff3.png differ