The status of General Purpose Input/Output (gpio, PIO) lines of the MCU can be read and modified using Armpit Scheme's extended read and write functions. These functions read/write from/to a register when both a port and a register offset are included in their argument list. The port is an integer representing the MCU-defined base address of the PIO line to read (eg. #xFFFFF400 for PIOA, from the AT91SAM7S256 user's manual). The register offset is also an integer and equals the offset of the register to read/write from/to relative to the port's base address (#x30 for SODR, #x34 for CODR and #x38 for ODSR). These ports and registers are defined as scheme variables at the top of the code below. They are then used in functions that: 1) identify whether a given pin is set in a given gpio port; 2) set a given pin in a given gpio port, and; 3) clear a given pin in a gpio port. These basic functions are used in a 4th function that toggles a given pin on a given gpio port. An Example of its use to toggle the green LED of the SAM7-H256 board (pin PA.8), on and off, is given.
; Armpit Scheme GPIO Example
; tested on SAM7-H256
; define GPIO ports and offsets
(define pioa #xFFFFF400) ; PIOA (SODR = #x30, CODR = #x34, ODSR = #x38)
(define pin-status #x38) ; PIOA_ODSR
(define pin-set #x30) ; PIOA_SODR
(define pin-clear #x34) ; PIOA_CODR
; function to check the status of a pin on a gpio port
(define (is-set? port pin)
(not (zero? (logand (read port pin-status) (ash 1 pin)))))
; function to set a pin on a gpio port
(define (set-pin port pin)
(write (ash 1 pin) port pin-set))
; function to clear a pin on a gpio port
(define (clear-pin port pin)
(write (ash 1 pin) port pin-clear))
; function to toggle a pin on a gpio port
(define (toggle port pin)
(if (is-set? port pin)
(clear-pin port pin)
(set-pin port pin)))
; toggle MCU board's LED(s)
(toggle pioa 8) ; SAM7-H256 green led
Armpit Scheme's extended read/write functions can be used to configure and control the MCU's PWM output lines. The example below demonstrates this application for the PWM0 line. The code starts by defining the PIOA, PMC (power control) and PWM ports (base addresses of #xFFFFF400, #xFFFFFC00 and #xFFFCC000) that are needed to configure PA.0 as the PWM0 output line. The PWM block is then powered up via the PMC port's PMC_PCER register and its input clock is selected via the PWM port's PWMC_MR register. Pin PA.0 is then configured for PWM operation by writing to the the PIOA port's PIOA_PDR and PIOA_ASR registers (offsets of #x04 and #x70) which is followed by configuring the PWM for a 2.5 ms period with 1024 ticks per period, starting with a duty-cycle of 2/1024, and enabling the PWM via PWM0 registers PWMC_CPR0, PWMC_CDTY0, PWMC_CMR0 and WMC_ENA (offsets of #x0208, #x0204, #x0200 and #x04). The PWM initialization code is followed by the definition of a function, set-pwm, that sets the duty cycle of a PWM channel to a given value. The function is applied to modify the duty cycle of PWM0 from its initial value of zero to a value of 500.
; Armpit Scheme PWM Example
; tested on SAM7-H256
; define useful ports
(define pioa #xFFFFF400) ; PIOA (PER = #x00, PDR = #x04, ASR = #x70, BSR = #X74)
(define pmc #xFFFFFC00) ; PMC (PCER = #x10)
(define pwm #xFFFCC000) ; PWM (MR = #x00, ENA = #x04, CMR0 = #x200, CDTY0 = #x204, CPR0 = #x208, CUPD0 = #x210)
; configure PWM block
(begin
(write #x0400 pmc #x10) ; Enable clock/power for PWM (bit 10 = #x0400) via PMC_PCER
(write #x75 pwm #x00)) ; Set PWM clock A to Master / 117 (= #x75) -> 410 KHz via PWMC_MR
; configure PWM0 (PA 0)
(begin
(write #x01 pioa #x04) ; Disable the GPIO function for PWM0 pin (PA/bit 0) via PIOA_PDR
(write #x01 pioa #x70) ; Select PWM0 function (Periph A, pin/bit 0) via PIOA_ASR
(write #x0400 pwm #x0208) ; Set PWM0 period to 1024 (400 Hz == 2.5 ms) via PWMC_CPR0
(write #x02 pwm #x0204) ; Set PWM0 duty cycle to 2 (minimum according to errata) via PWMC_CDTY0
(write #x020B pwm #x0200) ; Set PWM0 mode to left aligned, start high, use 400 kHz Clock A via PWMC_CMR0
(write #x01 pwm #x04)) ; Enable PWM0 channel via PWMC_ENA
(define (set-pwm channel value)
(write (min (max value 2) 1023)
pwm (+ #x0210 (ash channel 5)))) ; set duty in Channel Update register PWMC_CUPDx
(set-pwm 0 500)
Armpit Scheme can be used to read the MCU's ADC lines as examplified below for adc line 4. The ADC is powered up and its timing parameters are specified by writing to the PMC port register PCER (base: #xFFFFFC00, offset: #x10) and to the ADC port register ADC_MR (base: #xFFFD8000, offset: #x04). A function, read-adc, is defined to obtain values from a given adc channel and it is then applied to reading a value from channel 4. The function set-adc starts by enabling only the selected channel and then initiates adc conversion by writing a startup code to the ADC_CR register. It then waits in a tail-recursive loop for the conversion to be complete as indicated by the selected channel's bit in ADC_SR (offset #x1C). When the data is ready, read-adc reads it from ADC_LCDR (offset #x20), and returns the result. Note that, on the SAM7-H256 board, one should connect the 3.3V reference voltage (eg. ext2-18) externally to the ADVREF pin (ext2-13) so that ADC readings have a proper reference.
; Armpit Scheme ADC Example
; tested on SAM7-H256
; define useful ports
(define pmc #xFFFFFC00) ; PMC port (PCER = #x10)
(define adc #xFFFD8000) ; ADC port (CR = #x00, MR = #x04, CHER = #x10, CHDR = #x14, SR = #x1C, LCDR = #x20)
; configure adc
(begin
(write #x10 pmc #x10) ; Enable clock/power for ADC (bit 4) via PMC_PCER
(write #x020B0400 adc #x04)) ; set SHTIME=0.625us, STARTUP=20us, ADCCLK=4.8MHz, 10-bit via ADC_MR
; function to read a value from an input channel in the adc
(define (read-adc channel)
(write #xFF adc #x14) ; disable all channels via ADC_CHDR
(write (ash 1 channel) adc #x10) ; enable selected channel via ADC_CHER
(write 2 adc #x00) ; start conversion via ADC_CR
(let loop ((status 0))
(if (zero? (logand status (ash 1 channel))) ; check if conversion is done
(loop (read adc #x1C)) ; if not, loop with new status read from ADC_SR
(read adc #x20)))) ; if so, read and return value from ADC_LCDR
; read a value from channel 4 of the ADC (connector pin ext2-14 on SAM7-H256)
(read-adc 4)
Armpit Scheme allows the user to configure and use the MCU's UART1. The program below examplifies configuration and use of UART1 to write to a Serial LCD module (the BPI-216 from Scott Edwards Electronics was used for testing). The appropriate MCU pin (PA.22) is configured to operate as uart1's Tx line by writing to PIOA port registers PIOA_PDR and PIOA_ASR (base address #xE002C000, offsets #x04 and #x70). The uart is then powered, configured and enabled by writing to the PMC port's PMC_PCER register (base: #xFFFFFC00, offset: #x10) and to registers US1_BRGR, US1_TTGR, US1_MR, US1_PTCR and US1_CR of the UART1 (US1) port (base: #xFFFC4000, offsets: #x20, #x28, #x04, #x0120, #x00). The scheme functions write-char and write are then used to write command characters and write the external representations of scheme objects, respecitvely, to the LCD, via the uart1 port.
; Armpit Scheme Example of Serial Communication to an LCD, via uart1
; tested on SAM7-H256
; define useful ports
(define pmc #xFFFFFC00) ; PMC port (PCER = #x10)
(define pioa #xFFFFF400) ; PIOA port (PER = #x00, PDR = #x04, ASR = #x70, BSR = #X74)
(define uart1 #xFFFC4000) ; US1 port (CR = #x00, MR = #x04, BRGR = #x20, TTGR = #x28, PTCR = #x0120)
; Configure UART1 pin functions and com speed to 9600,8,N,1
(begin
(write #x600000 pioa #x04) ; Disable the GPIO for uart1 pins (pins/bits 21, 22) via PIOA_PDR
(write #x600000 pioa #x70) ; Select uart1 function (Periph A, pins/bits 21, 22) via PIOA_ASR
(write #x80 pmc #x10) ; Enable clock/power for uart1 (bit 7) via PMC_PCER
(write 313 uart1 #x20) ; Set Baud Rate to 9600 (CLOCK/UART0_DIVx16) via US1_BRGR
(write 0 uart1 #x28) ; disable time guard via US1_TTGR
(write #x08C0 uart1 #x04) ; Set mode to 8N1, 16 x Oversampling via US1_MR
(write #x0202 uart1 #x0120) ; Disable DMA transfers via US1_PTCR
(write #x40 uart1 #x00)) ; Enable TX (bit 6) via US1_CR
; clear the LCD screen
(begin
(write-char (integer->char 254) uart1)
(write-char (integer->char 1) uart1))
; write-out a string
(write "hello: " uart1)
; move to line 2 of LCD
(begin
(write-char (integer->char 254) uart1)
(write-char (integer->char 192) uart1))
; write-out a number
(write (/ 100 -3) uart1)
Armpit Scheme supports multitasking by allowing its user to define a process-queue switched by the MCU's timer 0 or timer 1 interrupt callbacks. The code below examplifies. It starts by defining useful ports and register offsets, as well as timer management functions (stop, restart). It then configures timer 0 to operate with a 2/3 micro-second tick. An empty process queue is then defined and a function that switches tasks from this queue is installed as the timer 0 callback by writing it to timer 0 port, offset #x010000. The timer is then configured to generate interrupts every 10 ms and is started. Two utility functions are then defined: spawn and toggler. The first is used to spawn a thunk onto the process queue and the other produces a thunk that toggles a GPIO pin every time its internal counter reaches zero. The toggler uses the functions defined earlier in the GPIO example (above) which are therefore also needed for running this multitasking example. The last line of code shows how to spawn a LED toggler on the SAM7-H256 board.
; Armpit MultiTasking Example
; Tested on SAM7-H256 [requires the GPIO example, above]
; define useful ports and offsets
(define timer0 #xFFFA0000) ; TC0 port (CCR = #x00, CMR = #x04, CV = #x10, RC = #x1C, IER = #x24)
(define timer-period #x1C) ; TCx_RC offset
(define timer-count #x10) ; TCx_CV offset
; function to stop a timer
(define (stop timer)
(write 2 timer #x00)) ; stop timer via TCx_CCR
; function to restart a timer
(define (restart timer)
(write 5 timer #x00)) ; enable, reset and start timer via TCx_CCR
; configure timer0
(define pmc #xFFFFFC00) ; PMC (PCER = #x10)
(begin
(write #x1000 pmc #x10) ; Enable clock/power for timer0 (bit 12) via PMC_PCER
(write #xC042 timer0 #x04) ; set wave mode, stop on capture of RC, clock/32 (2/3 us for 48MHz clk) via TC0_CMR
(write #x10 timer0 #x24)) ; Enable interrupt on RC match via TC0_IER
; Initialize the process queue
(define *queue* '())
; Set timer 0 callback to switch queued thunks
(write
(lambda ()
(call/cc
(lambda (resume)
(restart timer0)
(if (null? *queue*)
(resume #t)
((car *queue*) (set! *queue* (append (cdr *queue*) (list resume))))))))
timer0 #x010000)
; Start timer 0 to produce interrupts every 10 ms for task switching
(begin
(stop timer0)
(write 15000 timer0 timer-period)
(restart timer0))
; read the timer count (check proper operation)
(read timer0 timer-count)
; function to spawn a new thunk (task)
(define (spawn thunk)
(stop timer0)
(set! *queue*
(cons
(lambda ()
(thunk)
((car *queue*) (set! *queue* (cdr *queue*))))
*queue*))
(restart timer0))
; function to toggle a gpio pin every "ticks" countdown ticks
(define (toggler port pin ticks)
(lambda ()
(let go ((n ticks))
(if (> n 0)
(go (- n 1))
(begin
(toggle port pin)
(go ticks))))))
; spawn toggler on MCU board's LED
(spawn (toggler pioa 8 200)) ; SAM7-H256 green led
The Ultrasonic Ranger example has not yet been implemented on the AT91SAM7 (see LPC2000 examples if desired).
The MCU's Real-Time Timer (RTT) is accessible to Armpit Scheme via the extended read/write functions. The RTT port's base address is #xFFFFFD20 and the peripheral provides time in seconds since initialization. The example below illustrates how to configure and read the RTT.
; Armpit Real-Time Timer Example
; tested on SAM7-H256
; define useful port
(define rtt #xFFFFFD20) ; RTT (MR = #x00, AR = #x04, VR = #x08, SR = #x0C)
; initialize the Real Time Timer (RTT, used as rtc)
(write #x048000 rtt #x00) ; restart RTT for 1 second timing (wih clk=48MHz) via RTT_MR
; read rtt (time in seconds since rtt restart)
(read rtt #x08)
Armpit Scheme allows I2C communication as master and slave on the LPC2000 and will allow I2C communication as master on the AT91SAM7 MCU in an upcoming release. The sample code below is a preview of how the I2C (TWI) subsystem is expected to be initialized in said future release.
; Armpit Scheme I2C Communication Example: Master mode only; pre-release (appropriate ISRs are not yet available for AT91SAM7)
; Tested on SAM7-H256
; define useful port
(define i2c #xFFFB8000) ; TWI (CR = #x00, MMR = #x04, IADR = #x0C, CWGR = #x10, IER = #x24)
; Configure TWI (I2C) pin function and com speed to 400kb/s
(define pmc #xFFFFFC00) ; PMC (PCER = #x10)
(define pioa #xFFFFF400) ; PIOA (PER = #x00, PDR = #x04, ASR = #x70, BSR = #X74)
(begin
(write #x18 pioa #x04) ; Disable the GPIO function for TWI pins (pins/bits 3, 4) via PIOA_PDR
(write #x18 pioa #x70) ; Select TWI function (Periph A, pins/bits 3, 4) via PIOA_ASR
(write #x0200 pmc #x10) ; Enable clock/power for TWI (bit 9) via PMC_PCER
(write #x234F i2c #x10) ; Set clock wave generator for 400 kb/s at 48MHz via TWI_CWGR
(write #x0107 i2c #x24)) ; Enable interrupts (nack, txrdy, rxrdy, txcomp) via TWI_IER
Armpit Scheme can be used to implement a rudimentary expert system. The main limitation in this sort of exercise is the amount of RAM available to the MCU. The example below runs fine with 64KB of RAM but is certainly slower than one may like (or need for real-time control applications). It uses a form of McCarthy's nondeterministic AMB (ambiguous) operator.
; Armpit Scheme Expert System Example
; Tested on SAM7-H256
; utility function for printed output
(define (writeln . expr)
(display-all expr))
; utility function for printed output
(define (display-all lst)
(if (null? lst)
(newline)
(begin
(display (car lst))
(display-all (cdr lst)))))
; initial function that defines what to do when query fails
(define (fail) #f)
; current depth of chaining over rules
(define chain-depth 0)
; function to delay evaluation of alternatives
(define (cdelay fn)
(let ((hold-fail fail))
(set! fail
(lambda ()
(set! fail hold-fail)
(fn)))))
; function to pick one of several alternatives
(define (amb . expr-list)
(call/cc
(lambda (return)
(for-each
(lambda (expr)
(cdelay (lambda () (return expr))))
expr-list)
(fail))))
; helper macro to temporarily set the value of a variable
(define-syntax set
(syntax-rules ()
((_ var val)
(let ((local-save var))
(cdelay (lambda () (set! var local-save) (amb)))
(set! var val)))))
; function to temporarily set the value of a variable
(define (bind! var expr)
(eval `(set ,var ',expr)))
; function to identify whether an expression is a variable
(define (variable? expr)
(and
(symbol? expr)
(eq? #\?
(string-ref (symbol->string expr) 0))))
; function to identify whether an expression is a rule
(define (rule? expr)
(and (pair? expr)
(equal? (cadr expr) ':-)))
; function to identify whether a variable is bound
(define (bound? var)
(or (defined? var)
(eval `(define ,var 'UNASSIGNED)))
(not (eq? (eval var) 'UNASSIGNED)))
; function to substitute variable-bindings into an expression
(define (subst-bindings form)
(cond ((pair? form)
(cons (subst-bindings (car form))
(subst-bindings (cdr form))))
((variable? form)
(if (bound? form)
(subst-bindings (eval form))
form))
(else form)))
; function to unify two expressions
(define (unify pattern1 pattern2)
(cond
((equal? pattern1 pattern2) #t)
((and (pair? pattern1) (pair? pattern2))
(and
(unify (car pattern1) (car pattern2))
(unify (cdr pattern1) (cdr pattern2))))
((variable? pattern1)
(if (bound? pattern1)
(unify (eval pattern1) pattern2)
(and
(no-self-ref? pattern1 pattern2)
(bind! pattern1 pattern2))))
((variable? pattern2)
(unify pattern2 pattern1))
(else (amb))))
; function to identify whether self-references exist in an expression
(define (no-self-ref? var expr)
(cond ((equal? var expr) (amb))
((pair? expr)
(and (no-self-ref? var (car expr))
(no-self-ref? var (cdr expr))))
((variable? expr)
(or (not (bound? expr))
(no-self-ref? var (eval expr))))
(else #t)))
; function to evaluate a knowledge-base query
(define (qeval query kb)
(or (eq? query #t)
(let ((kb-item (apply amb kb)))
(if (rule? kb-item)
(let ((clean-rule (rename-vars kb-item)))
(unify query (car clean-rule))
(set chain-depth (+ 1 chain-depth))
(and-query (cddr clean-rule) kb))
(unify query kb-item)))))
; function to evaluate an and query
(define (and-query pattern-list kb)
(or (null? pattern-list)
(and (qeval (car pattern-list) kb)
(and-query (cdr pattern-list) kb))))
; function to rename the variables in an expression
(define (rename-vars expr)
(cond
((pair? expr)
(cons
(rename-vars (car expr))
(rename-vars (cdr expr))))
((variable? expr)
(string->symbol
(string-append
(symbol->string expr)
(number->string chain-depth))))
(else expr)))
; function to find all true resolutions of a query
(define (all query . kbase)
(let ((kb (if (null? kbase) *knowledge-base* (car kbase))))
(and (qeval query kb)
(writeln (subst-bindings query))
(amb))))
; a basic fact base for testing
(define *fact-base*
'((parent john joe)
(parent john jim)
(parent julie joe)
(parent jill jim)
(parent julie john)
(parent jim bill)
(parent jim jill)
(parent joe alice)
(parent joe linda)
(male john)
(male joe)
(male jim)
(male bill)
(female julie)
(female alice)
(female linda)))
; a basic rule base for testing
(define *rule-base*
'(((mother ?x ?y) :- (female ?x) (parent ?x ?y))
((father ?x ?y) :- (male ?x) (parent ?x ?y))
((daughter ?x ?y) :- (female ?x) (parent ?y ?x))
((son ?x ?y) :- (male ?x) (parent ?y ?x))
((grandparent ?x ?z) :- (parent ?x ?y) (parent ?y ?z))
((grandmother ?x ?z) :- (mother ?x ?y) (parent ?y ?z))
((grandfather ?x ?z) :- (father ?x ?y) (parent ?y ?z))))
; define the knowledge base used for testing
(define *knowledge-base*
(append *fact-base* *rule-base*))
; examples of basic queries
(all '(father ?x ?y))
(all '(father ?x ?x))
(all '(mother ?x ?y))
(all '(parent ?x joe))
(all '(grandparent ?x alice))
(all '(?x jim ?y))
(all '(grandparent ?x ?x))
(all '(son ?x ?y))
(all '(son jim ?x))
(all '(son ?x jim))
(all '(daughter ?x joe))
Armpit Scheme is being tested for its ability to run the declarative logic programming system miniKANREN. At the time of this writing, it has been identified that the treatment of ellipsis in Armpit Scheme's macro system is not as powerful as described in r5rs and hence two modifications (minimum) are required to get miniKANREN running on Armpit (up to test #4.57). The required modifications to the "fresh" and "conde" macros are given below.
; Armpit Example Modifications to miniKANREN
; Tested on SAM7-H256
; modification of the fresh macro
(define-syntax fresh
(syntax-rules ()
((_ (x ...) g ...)
(lambdag@ (s)
(fresh+ (x ...) (g ...) s)))))
; helper macro for fresh
(define-syntax fresh+
(syntax-rules ()
((_ (x) (g ...) s)
(let ((x (var 'x)))
((all g ...) s)))
((_ (x y ...) (g ...) s)
(let ((x (var 'x)))
(fresh+ (y ...) (g ...) s)))))
; modification of the conde macro
(define-syntax conde
(syntax-rules (else)
((_) fail)
((_ (else g ...)) (all g ...))
((_ (g ...) c ...)
(anye (all g ...) (conde c ...)))))
As a last example, Armpit Scheme can be used to apply the obfuscating Applicative Order Y-combinator described for example by Daniel P. Friedman and Matthias Felleisen in The Little Schemer (I believe). It is applied below to calculating the factorial of 7 via anonymous recursion.
; Armpit Example of Applicative Order Y-combinator, for anonymous recursion
; tested on SAM7-H256
; the Y-combinator:
(define Y
(lambda (g)
((lambda (f) (f f))
(lambda (f) (g (lambda (x) ((f f) x)))))))
; its application to calculating 7! :
((Y (lambda (f) (lambda (n) (if (< n 2) 1 (* n (f (- n 1)))))))
7)