This Forth compiler, available under the GPL free software license, is hosted on Unix (or Linux) using gforth 0.6.x and generates code for the Microchip PIC 16F87x and 16F88 microcontrollers family. It includes two kinds of cooperative schedulers. You can download PicForth 1.2.5.
In the distribution, you will find some examples: a model railroad booster (see below), a DCC signal generator, some code for silver card smartcards.
Below you can find an example of code in charge of a model railroad booster (electronic design by Alexis Polti) using the DCC system (Digital Command Control).
Resources:
|
Forth code
\ \ Code for the DCC booster. \ \ The DCC booster is in charge of driving a H bridge, which amplifies a \ DCC signal so that it can power a model railroad circuit. \ \ This device is in charge of checking for high current (short-circuit) \ and thermal warning problems. Note that short-circuit may happen if the \ circuit does have a reverse loop. In this case, if a jumper on the \ board allows it, the signal phase will be reversed and a few µs later \ we will recheck for the short-circuit. If it has disappeared, the DCC \ signal will stay reversed until a new short-circuit occurs. \ pic16f87x \ Port mapping 5 pin-a jumper \ Inversion allowed jumper (in) 0 pin-b thermal \ H bridge thermal sensor (in) 1 pin-b presence \ Presence detected (out) 2 pin-b inversion \ Inversion active (out) 3 pin-b disconnection \ Disconnection (out) 6 pin-b loco-detected \ Engine detected on track (in) 7 pin-b short-detected \ Short-circuit detected (in) 1 pin-c brake \ H bridge BRAKE (out) 2 pin-c pwm \ H bridge PWM (out) \ Enable and disable output (act and signal) : enable-output ( -- ) brake low pwm high disconnection low ; : disable-output ( -- ) brake high pwm low disconnection high ; \ Timer routines. At 4MhZ, with a prescaler of 64, each tick corresponds \ to 64µs. Call ticks with a "negate"d value. The minimum watchdog time is \ 7ms; it needs to be cleared within the loop. :: ticks ( -n -- ) tmr0 ! \ Store -n into tmr0 t0if bit-clr \ Clear overflow bit begin clrwdt t0if bit-set? until \ Wait for overflow to occur ; : 64µs ( -- ) -1 ticks ; : 10ms ( -- ) -$9d ticks ; variable scount : 1s ( -- ) $64 scount v-for 10ms v-next ; \ Handle track shortcut : handle-shortcut ( -- ) \ Toggle inversion if inversion is allowed (jumper high) jumper high? if inversion toggle then \ If shortcut is gone after 64µs, exit 64µs short-detected low? if exit then \ We are still in shortcut condition, disable output for 10ms disable-output 10ms enable-output ; \ Maintain output disabled as long as thermal alert is on. Wait for one \ extra second before reenabling output. : handle-thermal-alert ( -- ) disable-output begin clrwdt thermal low? until 1s enable-output ; \ If there is a loco, repeat the signal : check-loco ( -- ) loco-detected high? if presence high then loco-detected low? if presence low then ; \ Initialization : init ( -- ) $00 portb ! \ Clear portb output latches $00 portc ! \ Clear portc output latches $06 adcon1 ! \ Disable A/C converter $ff trisa ! \ All pins of porta as inputs $f1 trisb ! \ Portb 1, 2 and 3 as outputs $f9 trisc ! \ Portc 1 and 2 as outputs $05 option_reg ! \ CLKOUT, prescaler(tmr0)=64 enable-output ; \ Main program : mainloop ( -- ) begin short-detected high? if handle-shortcut then thermal high? if handle-thermal-alert then check-loco again ; main : main ( -- ) init mainloop ; \ Configuration word fosc-hs set-fosc \ High-speed oscillator |
Assembly code
0x0000 018A clrf 0x0A
0x0001 2846 goto 0x046 ; (init-picforth)
; name: enable-output
; max return-stack depth: 0
0x0004 1087 bcf 0x07,1
0x0005 1507 bsf 0x07,2
0x0006 1186 bcf 0x06,3
0x0007 0008 return
; name: disable-output
; max return-stack depth: 0
0x0008 1487 bsf 0x07,1
0x0009 1107 bcf 0x07,2
0x000A 1586 bsf 0x06,3
0x000B 0008 return
; name: ticks
; max return-stack depth: 0
0x000C 0081 movwf 0x01
0x000D 110B bcf 0x0B,2
0x000E 0064 clrwdt
0x000F 1D0B btfss 0x0B,2
0x0010 280E goto 0x00E ; ticks + 0x002
0x0011 0008 return
; name: 64µs
; max return-stack depth: 0
0x0012 30FF movlw 0xFF
0x0013 280C goto 0x00C ; ticks
; name: 10ms
; max return-stack depth: 0
0x0014 3063 movlw 0x63
0x0015 280C goto 0x00C ; ticks
; name: 1s
; max return-stack depth: 1
0x0016 3064 movlw 0x64
0x0017 00A2 movwf 0x22
0x0018 2014 call 0x014 ; 10ms
0x0019 0BA2 decfsz 0x22,f
0x001A 2818 goto 0x018 ; 1s + 0x002
0x001B 0008 return
; name: handle-shortcut
; max return-stack depth: 1
0x001C 1E85 btfss 0x05,5
0x001D 2820 goto 0x020 ; handle-shortcut + 0x004
0x001E 3004 movlw 0x04
0x001F 0686 xorwf 0x06,f
0x0020 2012 call 0x012 ; 64µs
0x0021 1F86 btfss 0x06,7
0x0022 0008 return
0x0023 2008 call 0x008 ; disable-output
0x0024 2014 call 0x014 ; 10ms
0x0025 2804 goto 0x004 ; enable-output
; name: handle-thermal-alert
; max return-stack depth: 2
0x0026 2008 call 0x008 ; disable-output
0x0027 0064 clrwdt
0x0028 1806 btfsc 0x06,0
0x0029 2827 goto 0x027 ; handle-thermal-alert + 0x001
0x002A 2016 call 0x016 ; 1s (rs depth: 1)
0x002B 2804 goto 0x004 ; enable-output
; name: check-loco
; max return-stack depth: 0
0x002C 1B06 btfsc 0x06,6
0x002D 1486 bsf 0x06,1
0x002E 1F06 btfss 0x06,6
0x002F 1086 bcf 0x06,1
0x0030 0008 return
; name: init
; max return-stack depth: 0
0x0031 0186 clrf 0x06
0x0032 0187 clrf 0x07
0x0033 3006 movlw 0x06
0x0034 1683 bsf 0x03,5
0x0035 009F movwf 0x1F
0x0036 30FF movlw 0xFF
0x0037 0085 movwf 0x05
0x0038 30F1 movlw 0xF1
0x0039 0086 movwf 0x06
0x003A 30F9 movlw 0xF9
0x003B 0087 movwf 0x07
0x003C 3005 movlw 0x05
0x003D 0081 movwf 0x01
0x003E 1283 bcf 0x03,5
0x003F 2804 goto 0x004 ; enable-output
; name: mainloop
; max return-stack depth: 3
0x0040 1B86 btfsc 0x06,7
0x0041 201C call 0x01C ; handle-shortcut (rs depth: 1)
0x0042 1806 btfsc 0x06,0
0x0043 2026 call 0x026 ; handle-thermal-alert (rs depth: 2)
0x0044 202C call 0x02C ; check-loco
0x0045 2840 goto 0x040 ; mainloop (rs depth: 3)
; name: (init-picforth)
; max return-stack depth: 0
0x0046 3033 movlw 0x33
0x0047 0084 movwf 0x04
; name: main
; max return-stack depth: 3
0x0048 2031 call 0x031 ; init
0x0049 2840 goto 0x040 ; mainloop (rs depth: 3)
|
You can get the current development version using Darcs.
To understand the scope of these changes, please refer to the documentation.
subwf when it leads to better code. Feature
requested by David McNab <david@rebirthing.co.nz>.goto instruction patching in
multitasker.fs. Bug reported and diagnosed by Alex
Holden <alex@linuxhacker.org>.exit followed by
if. Reported by Alex Holden
<alex@linuxhacker.org>.flag word from David McNab
<david@rebirthing.co.nz> which handles 1-bit variables.roll and -roll words.retlw to
return. Implemented after a question from David McNab
<david@rebirthing.co.nz>.return-in-w into target vocabulary and
document it. Suggested by David McNab
<david@rebirthing.co.nz>.exit in inlined words.
Thanks to Alex Holden <alex@linuxhacker.org> for asking for
clarification.suspend-interrupts when picisr.fs is
included) was seen as the first definition in macros. Reported by
Alex Holden <alex@linuxhacker.org>.resolve when multiple code banks are
involved. Reported by Alex Holden
<alex@linuxhacker.org>.0 < phrase (not 0<) could
lead to incorrect result when not followed by a conditional
construct. Reported by Alex Holden
<alex@linuxhacker.org>.abs word as documented in the
manual.dup 0<> phrase was incorrect due to mowf
not setting the Z status bit. Reported by Alex Holden
<alex@linuxhacker.org>.case/of/endof/endcase.
Suggested by David McNab <david@rebirthing.co.nz>.write-map/write-dis. Implemented by
Alex Holden <alex@linuxhacker.org>.map and words is now in
low->high order not high->low. Implemented by Alex Holden
<alex@linuxhacker.org>.words and
map. Fix by Alex Holden
<alex@linuxhacker.org>.unsupported. Fix by Alex Holden
<alex@linuxhacker.org>adjust-bank. Reported by David
McNab <david@rebirthing.co.nz>.nip now optimizes code such as 1 2
nip by replacing it by 2. This situation can
arise when a bit name is given and only the bit number is
interesting.picisr.fs now include versions of
suspend-interrupts and restore-interrupts
that can be nested up to 256 levels. However this requires one more
byte of memory (problem signaled by Alex Holden
<alex@linuxhacker.org>).set-wrt. Reported by
Jamie Lawson <jlawson@ces.uoguelph.ca>.[IF],
[ELSE], [THEN], [IFDEF] and
[IFUNDEF] from gforth. Suggested by David McNab
<david@rebirthing.co.nz>.disallow-optimizations and
allow-optimizations allow a finer control on PicForth
optimizations.else is now
handled properly. Bug reported by Alex Holden
<alex@linuxhacker.org>.include and needs work
properly.
(reported by David McNab <david@rebirthing.co.nz>)
+ Missing tools/bootloading directory
+ Missing dcc2.fs
::code word was added, thanks to David McNab
<david@rebirthing.co.nz>.pick word was added, thanks to J.C. Wren
<jcwren@jcwren.com>.rot, -rot and 2swap
were added in libextra.fs, thanks to J.C. Wren
<jcwren@jcwren.com>.7 9 < if ... then (which
would never occur in real programs) is now properly handled. The
optimizer was too enthusiastic and did not set the carry flag
properly.sleep word is imported from assembler and can
be used from Forth code.libstrings.fs allows the creation of 7
bits packed strings in flash memory. Each program word holds two
characters and strings are zero terminated. An iterator allows the
retrieval of one character at a time.w-! removes the content of W from a memory
register.-! can handle more cases.suspend-interrupts and
restore-interrupts allow interrupt bit saving and
restoring. Builtin words do use those internally. If
picisr.fs is not included, those words are noops.rrf! and rlf! allow for variable bit
shifting without resorting to assembler.t, allows for a single byte to be added in a
table.lshift and rshift have been further
optimized.goto is used in place of call in more
places when it is possible.v-next rememebers the variable used at
v-for time. Therefore, v-next no longer
takes a variable address as parameter.table, ftable, eetable,
table> and end-table allow to create
respectively RAM, flash or EEPROM tables.picflash.fs contains new words
fcreate, f,, fallot and
fhigh!.picforth.pdf, picforth.txt,
picforth.info and picforth.html and use
the one which most suits your needs and tastes.table and tc: have been
removed as they were inefficient and useless in their current
form.bank0, bank1,
bank2 and bank3 allow to choose the
memory bank in which next variables will be stored.needs works the usual way.set-stack-size allows to set the default stack
size.cmove cases are optimized.bit-clr? until)., is used. Note
however that variables are not automatically initialized to 0 (see
README).if) will
not be normalized if it is not needed.bit-clr? and low? have
been added.libcmove.fs implements ANS Forth
CMOVE.spifcard.fs has been
added./if, c-if,
c-/if, /until, /while and
=if have been removed as the new optimizations makes
them unnecessary.hex>nibble and nibble>hex
from libnibble.fs have been optimized.swap and drop after a string literal
word are optimized.=if adds a new test.i2cloader.fs is a flash and eeprom programmer
using I2C.bit builds a name representing a particular bit at
a particular address.c, z,
t0if, ...) do now push their address as well, and must
be used without any address. For example, to test for timer 0
overflow, you must use t0if bit-set? if ... then.bit-set, bit-clr,
bit-set?, bit-toggle, high,
low, high? and toggle now
use inverted parameters (push port first then bit number). Symbols
defined with bit, pin-a,
pin-b, pin-c, pin-d or
pin-e can now be used in assembly code as the
parameter order is similar to the Forth one.checker.fs has been renamed
controller.fs, as the previous name was
misleading./and invert the top-of-stack then
and the two top values.swapf-tos exchanges nibble of top-of-stack.lshift with a bit count greater than 3 will use a
shorter code than before.and and /and will use bit
manipulation when this is more efficient.checker.fs is
included.libnibble.fs library converts characters to
nibbles and nibbles to characters.- followed by
if could be incorrect.lshift and rshift
could generate incorrect code.yield operation crosses a 256 bytes page limit.incfsz and decfsz will be used when
it is possible.lshift, rshift, 2* and
2/ are implemented.invert! inverts the content of an address.-! is implemented.macro allows you to enter the macro definition
mode, while target gets you back to code
generation.drop followed by an integer leads to very
efficient code.+ and - have been further
optimized.:: allow efficient W register
parameter passing. >w and w>
respectively pop the top-of-stack into w and push w on the stack.
They can be used to implement efficient return value handling.or now uses bit-set instructions when it makes
sense, as well as or!, and! and
/and!.negate and invert have been
optimized.recurse is implemented the traditional way.>input and >output change a pin
direction by working on the corresponding tris register.include.over was not
interrupt-safe.make interactive, you will be dropped
into an interactive mode where you can disassemble words using
see, words, map and
dis.silver.fs, contains some code that
runs on a smartcard.eecreate and ee, manipulate EEPROM
contentee@ selected the flash instead of the EEPROMhigh, low, high? and
toggle are aliases for bit-set,
bit-low, bit-set? and
bit-toggle intended to work on portsAdd library files libfetch.fs and
libstore.fs which were forgotten in previous versions
and are used by generator.fs.
until and /until (control
structures)clrwdt (accessible from Forth)pin-a, pin-b, pin-c,
pin-d, pin-e (pin mapping)bit-clear is renamed to bit-clr
