Armpit Scheme allows the user to configure and use the MCU's UART1. To this effect, one first selects appropriate pin functions for UART1 pins and then sets communication parameters for the UART. The corresponding MCU registers can be written to and read from using scheme's read and write functions. In Armpit, the PINSEL registers are defined as Scheme Ports (eg. (pinsel 0)) but UART1 registers are not. The latter are accessed using their raw address as the destination port for write or as the source port for read (eg. (read #xE0010014) to read UART1's Line Status Register -- U1LSR). 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).
Note: The initial release of Armpit Scheme Version 00.0017 contained a bug in the function char->integer that prevented this example from working properly. The bug is fixed in subsequent releases.
; Armpit UART1 Serial LCD Example
; tested on Tiny2131
; Configure UART1 pin functions and com speed to 9600,8,N,1
(begin
(write ; write TXD1 function to PINSEL0
(logior #x00010000 ; set bits 17:16 to UART1 TXD1 function
(logand #xFFFCFFFF ; clear bits 17:16
(read (pinsel 0)))) ; read PINSEL0 pin functions
(pinsel 0))
(write #x01 #xE0010008) ; enable UART1 by writing 1 to U1FCR
(write #x80 #xE001000C) ; enable Divisor Latch (DLAB = 1) by writing #x80 to U1LCR
(write #x87 #xE0010000) ; set low divisor for 9600 bauds in U1DLL
(write #x01 #xE0010004) ; set high divisor for 9600 bauds in U1DLM
(write #x03 #xE001000C)) ; set 8 data bits, no parity, 1 stop bit in U1LCR
; function to write an ASCII code to UART1
(define (uart1-write-ascii code)
(if (zero? (logand #x20 (read #xE0010014))) ; is UART1 busy (x-mit register not empty)?
(uart1-write-ascii code) ; if so, keep waiting
(write code #xE0010000))) ; otherwise, send ASCII code
; function to write a string to UART1
(define (uart1-write-string strng . n)
(let ((pos (if (null? n) 0 (car n))))
(if (< pos (string-length strng))
(begin
(uart1-write (string-ref strng pos))
(uart1-write-string strng (+ pos 1))))))
; function to write a number, string or char to UART1
(define (uart1-write expr)
(cond
((char? expr)
(uart1-write-ascii (char->integer expr)))
((number? expr)
(uart1-write (number->string expr)))
((string? expr)
(uart1-write-string expr))))
; clear the LCD screen
(begin
(uart1-write-ascii 254)
(uart1-write-ascii 1))
; write-out a string
(uart1-write "hello: ")
; move to line 2 of LCD
(begin
(uart1-write-ascii 254)
(uart1-write-ascii 192))
; write-out a number
(uart1-write (/ 100 -3))
Armpit Scheme allows acces to the MCU's TIMER1 functions. These can be used, for example, to drive the SRF-04 Ultrasonic Range Finder from Devantech (eg. sensors section at Acroname). In this application, a Match pin and register are used to control the Trigger Input line of the Ranger, and a Capture pin and register are used to latch the round-trip echo time from the Echo Out line of the Ranger. TIMER1 registers are accessed by read/write functions using Scheme Ports defined as (timer 1 offset) where offset is the address offset to the desired register from the start address of the TIMER1 register block (i.e. the offset from #xE0008000). The program below examplifies the configuration of TIMER1 and its use for this application.
; Armpit Scheme Sonar Range Finder Example
; tested on Tiny2131
; configure TIMER1 and pin functions (P0.17 <- match 1.2, P0.19 <- capture 1.2)
(begin
(write ; write new pin functions to pinsel 1
(logior #x000000CC ; set function of P0.19 to CAP1.2 and P0.17 to MAT1.2
(logand #xFFFFFF33 ; clear bits 7:6 and 3:2
(read (pinsel 1)))) ; get PINSEL1 settings
(pinsel 1))
(write #x02 (timer 1 #x04)) ; reset and stop TIMER1 (T1TCR)
(write 59 (timer 1 #x0C)) ; set Prescale Register for 1 micro-secs timing (at 60MHZ)
(write #x00 (timer 1 #x70)) ; set TIMER1 to timer mode
(write #x04 (timer 1 #x14)) ; set T1MCR to stop timer on MR0 and do nothing on MR2
(write 50000 (timer 1 #x18)) ; set T1MR0 to stop after 50 milli-secs
(write 100 (timer 1 #x20)) ; set T1MR2 for 100 micro-secs control pulse
(write #x80 (timer 1 #x28))) ; set T1CCR to capture timer value on falling edge of P0.19
; function to get sonar reading as round-trip echo time in micro-seconds
(define (read-sonar)
(write #x02 (timer 1 #x04)) ; reset and stop TIMER1 (T1TCR)
(write #x0104 (timer 1 #x3C)) ; set T1EMR to make P0.17 high first, then low on MR2 match
(write #x01 (timer 1 #x04)) ; start TIMER1 (T1TCR)
(let loop ()
(if (zero? (logand #x01 (read (timer 1 #x04)))) ; is timer stopped?
(read (timer 1 #x34)) ; if so, read sonar echo time in micro-seconds + 100 from T1CR2
(loop)))) ; otherwise, keep looping
; function to get sonar reading and return it as a distance in centimeters
(define (sonar-cm)
(/ (- (read-sonar) 100) 2 29.033))
; read the sonar
(sonar-cm)
The MCU's Real-Time Clock (RTC) is accessible to Armpit Scheme via scheme read/write ports. The ports are defined as (rtc #xYY) where YY is the offset to the corresponding register in the MCU's RTC Block (cf. peripheral register memory map in the LPC2xxx User Manuals from NXP). The example below illustrates how the hour, minute, seconds, year, month and day-of-month registers of the RTC can be read from and written to (Note: On the LPC2131 version, the RTC is not initialized and RTC Scheme Ports are not defined due to memory constraints such that the RTC is available using raw hardware-address ports only).
; Armpit Real-Time Clock Example (see also NXP/Philips AN10382)
; tested on Tiny2106
; function to read/set the date
(define date
(lambda opt-date-list
(let ((year (rtc #x3C))
(month (rtc #x38))
(dom (rtc #x2C)))
(if (null? opt-date-list)
(list (read month) (read dom) (read year))
(begin
(write (car opt-date-list) month)
(write (cadr opt-date-list) dom)
(write (caddr opt-date-list) year))))))
; function to read/set the time
(define time
(lambda opt-time-list
(let ((hour (rtc #x28))
(minu (rtc #x24))
(seco (rtc #x20)))
(if (null? opt-time-list)
(list (read hour) (read minu) (read seco))
(begin
(write (car opt-time-list) hour)
(write (cadr opt-time-list) minu)
(write (caddr opt-time-list) seco))))))
; reading the date
(date)
; setting the date to July 16, 2006
(date 7 16 2006)
; reading the time
(time)
; setting the time to 4:10:00am
(time 4 10 0)
The example program below illustrates how Armpit Scheme reads from ADC lines and writes to PWM lines of the MCU. The ADC scheme ports are for reading only and are returned by (adc x y). The PWM ports are for writing only and are returned by (pwm x). Not all ADC and PWM lines of a given MCU are active by default.
; Armpit Servo-Control Example (see LPC2131 user manual for PWM/ADC lines)
; tested on Tiny2131
; The sensor is read from the MCU's ADC 0 0 line
; The servo is actuated via the MCU's PWM 2 line
; function to wait (by countdown)
(define wait
(lambda (n)
(if (zero? n) #t (wait (- n 1)))))
; function to sweep servo broom around sensor and record sensor readings
(define scan
(lambda (n r)
(write n (pwm 2))
(wait 50)
(if (and (< n 52) (< (read (adc 0 0)) 700))
(scan n r)
(if (> n 102) r
(scan (+ n 1)
(cons (list (read (adc 0 0)) n) r))))))
; function to position servo to minimum sensor reading
(define pstn
(lambda (r)
(write (assq (apply min (map car r)) r))
(newline)
(write (cadr (assq (apply min (map car r)) r)) (pwm 2))))
; function to repeat scan/position actions n times
(define doit
(lambda (n)
(if (zero? n) #t
(begin
(pstn (scan 51 '()))
(wait 5000)
(doit (- n 1))))))
; perform scanning and positioning 10 times
(doit 10)
Armpit Scheme supports multitasking by allowing its user to define a process-queue switched by the MCU's timer 0 interrupts. The code below examplifies. It starts by writing a task-switching callback to timer 0 (i.e. to scheme port (timer 0 #xff)), then starts the timer. The function spawn is then defined to add thunks to the process queue. Examples are provided for toggling LEDs on and off while the REP remains available. Task switching can be stopped by stopping timer 0: (write 2 (timer 0 #x04)) or by setting the queue to null: (set! *queue* '()). You can read the timer with: (read (timer 0 #x08)). In these instructions, numbers like #x04 and #x08 are the offsets of the corresponding Timer 0 Block registers on the LPC2000 devices (cf. the NXP User Manuals).
The code below works on most boards except the Tiny2131. Because of memory limitations, the 2131 version of the code needs to use shorter variable names. That code (2131) is given below the more general version.
; Armpit MultiTasking Example
; Tested on all boards (not for Tiny2131)
; Initialize the process queue
(define *queue* '())
; Set timer 0 callback and set interrupts to every 10ms (10000 microsec)
(write
(lambda ()
(call/cc
(lambda (resume)
(write 2 (timer 0 #x04))
(write 5 (timer 0 #x14))
(write 10000 (timer 0 #x18))
(let ((r (if (null? *queue*)
resume
(let ((proc (car *queue*)))
(set! *queue* (append (cdr *queue*) (list resume)))
proc))))
(write 1 (timer 0 #x04))
(r #t)))))
(timer 0 #xff))
; Start timer 0 to produce interrupts every 1ms (1000 microsec) for task switching
(begin
(write 2 (timer 0 #x04))
(write 5 (timer 0 #x14))
(write 1000 (timer 0 #x18))
(write 1 (timer 0 #x04)))
; function to spawn a new thunk (task)
(define spawn
(lambda (thunk)
(write 0 (timer 0 #x04))
(set! *queue* (cons thunk *queue*))
(write 999 (timer 0 #x08))
(write 1 (timer 0 #x04))))
; function to toggle a gpio pin every "ticks" tick
(define toggler
(lambda (pin ticks)
(lambda ()
(let go ((n ticks))
(if (> n 0)
(go (- n 1))
(begin
(write (not (read pin)) pin)
(go ticks)))))))
; spawn togglers on MCU board's LEDs
(spawn (toggler (gpio 0 23) 100)) ; Tiny2106 red led
(spawn (toggler (gpio 0 24) 200)) ; Tiny2106 yellow led
(spawn (toggler (gpio 0 25) 400)) ; Tiny2106 green led
(spawn (toggler (gpio 1 21) 100)) ; Tiny2138 red led
(spawn (toggler (gpio 1 22) 200)) ; Tiny2138 yellow led
(spawn (toggler (gpio 1 23) 400)) ; Tiny2138 green led
(spawn (toggler (gpio 0 30) 200)) ; H2214 red led
(spawn (toggler (gpio 1 24) 200)) ; H2148 green led
The version of the task switcher for the Tiny2131 is displayed below.
; Armpit MultiTasking Example
; Tested on Tiny2131
; Initialize the process queue
(define *q* '())
; Set timer 0 callback and set interrupts to every 10ms (10000 microsec)
(write
(lambda ()
(call/cc
(lambda (rsme)
(write 2 (timer 0 #x04))
(write 10000 (timer 0 #x18))
(write 1 (timer 0 #x04))
(if (null? *q*)
(rsme #t)
((car *q*) (set! *q* (append (cdr *q*) (list rsme))))))))
(timer 0 #xff))
; Start timer 0 to produce interupts every 1ms (1000 microsec) for task switching
(begin
(write 2 (timer 0 #x04))
(write 5 (timer 0 #x14))
(write 1000 (timer 0 #x18))
(write 1 (timer 0 #x04)))
; function to spawn a new thunk (task)
(define spwn
(lambda (thnk)
(write 0 (timer 0 #x04))
(set! *q* (cons thnk *q*))
(write 1 (timer 0 #x04))))
; function to toggle a gpio pin every "tcks" tick
(define tglr
(lambda (pin tcks)
(lambda ()
(let go ((n tcks))
(if (> n 0)
(go (- n 1))
(begin
(write (not (read pin)) pin)
(go tcks)))))))
; spawn togglers on MCU board's LEDs
(spwn (tglr (gpio 1 21) 200)) ; Tiny2131 red led
(spwn (tglr (gpio 1 22) 100)) ; Tiny2131 yellow led
(spwn (tglr (gpio 1 23) 50)) ; Tiny2131 green led
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 Tiny2106
; 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 Tiny2106
; 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 Tiny2106
; 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)