Home |  Files |  GPIO/LED |  Threads |  Small Threads |  Runge-Kutta |  Expert System |  LCDDemo


A Scheme Interpreter for ARM Microcontrollers:
Program Examples for Version 00.0137

SourceForge.net Logo
 

Files:


The code below exemplifies writing to and reading from files, listing files, erasing all files and the new operation of unlocking the file system (if it remained locked due to a multitasking crash). Armpit Scheme files are stored in FLASH memory, either on-chip or off-chip depending on the MCU board.



; Armpit Scheme File Example
; tested on Tiny2131, LPC-H2103, Tiny2138, SFE-Logomatic, LPC-H2148,
;           LCDDemo-2158, Tiny2106, LPC-H2214, STR-H711, SAM7-H256,
;           LPC-H2888, CS-E9302, STM32-H103, LM3S1968-EVB

; unlock file system (optional - file system may get locked during read/write errors)
(unlock)

; erase all files (optional - may take a few seconds)
(erase)

; list all files
(files)

; write some data to a file named zag
(let ((port (open-output-file "zag")))
  (if (zero? port) #f
     (begin 
       (write "hello" port)
       (write '(1 2 3) port)
       (write 3.4e-2 port)
       (close-output-port port))))
 
; list all files
(files)

; read and display data from a file named zag
(let ((port (open-input-file "zag")))
  (if (zero? port) #f
     (let loop ((val (read port)))
        (if (eof-object? val)
           (close-input-port port)
           (begin
             (write val)
             (newline)
             (loop (read port)))))))


 

GPIO LED Toggling:


The code below exemplifies common gpio operations in Armpit Scheme 00.0137. It is the same as in previous versions except that register addresses ("ports") are shifted right by one hexadecimal digit (4 bits) (that is done when defining ledport -- note how it has only 7 hexadecimal digits). The code starts with MCU-specific port and offset definitions. This is followed by semi-common code that defines the set-pin and clear-pin functions for MCUs that have separate set and clear registers and for those that have a common set-and-clear register. Code for testing if a pin is set or not is common to all MCUs as is the function toggle. They are followed by calls to toggle that will turn LEDs on and off on the target boards. Note that the LED pin ports have been powered-up and the LED pin functions have have been set to GPIO output during the Armpit Scheme hardware-initialization cycle (before the armpit> prompt gets displayed).



; Armpit Scheme GPIO Example
; tested on Tiny2131, LPC-H2103, Tiny2138, SFE-Logomatic, LPC-H2148,
;           LCDDemo-2158, Tiny2106, LPC-H2214, SAM7-H256, STR-H711
;           LPC-H2888, CS-E9302, STM32-H103, LM3S1968-EVB

; LPC-H2103, Tiny2106, SFE-Logomatic, LPC-H2214
; define GPIO ports and offsets
; ledport <- gpio0
(begin
  (define ledport #xE002800)  ; IO0 port (PIN = #x00, SET = #x04, DIR = #x08, CLR = #x0C)
  (define pin-status #x00)  ; IOxPIN register offset
  (define pin-set    #x04)  ; IOxSET register offset
  (define pin-clear  #x0C)) ; IOxCLR register offset

; Tiny213x, LPC-H2148, LCDDemo-2158
; ledport <- gpio1
(begin
  (define ledport #xE002801)  ; IO1 port (PIN = #x00, SET = #x04, DIR = #x08, CLR = #x0C)
  (define pin-status #x00)  ; IOxPIN register offset
  (define pin-set    #x04)  ; IOxSET register offset
  (define pin-clear  #x0C)) ; IOxCLR register offset

; LPC-H2888
; define GPIO ports and offsets
(begin
  (define ledport    #x8000308) ; GPIO PORT 2, PINS_2
  (define pin-status #x00)  ; Pins_2
  (define pin-set    #x14)  ; Mode0s_2
  (define pin-clear  #x18)) ; Mode0c_2

; SAM7-H256
; define GPIO ports and offsets
(begin
  (define ledport  #xFFFFF40)  ; 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

; STM32-H103
; define GPIO ports and offsets
(begin
  (define ledport    #x4001100) ; GPIO PORT C
  (define pin-status #x0C)  ; output data register (ODR)
  (define pin-set    #x10)  ; bit set register (BSR)
  (define pin-clear  #x14)) ; bit reset register (BRR)

; STR-H711
; define GPIO ports and offsets -- version 00.0136
(begin
  (define ledport #xE000400)  ; IOPORT1
  (define pin-status   #x0C)) ; Pin Data Register offset (PD)

; CS-E9302
; define GPIO ports and offsets
(begin
  (define ledport    #x8084002) ; GPIO PORT E
  (define pin-status #x00))       ; Data Register offset

; LM3S1968-EVB
; define GPIO ports and offsets
(begin
  (define ledport #x4002600)  ; GPIO PORT G
  (define pin-status #x03fc)) ; all io mask

;------------- Semi-Common Code Starts -------------

; LPC-H2103, Tiny2106, Tiny213x, SFE-Logomatic, LPC-H2148, LCDDemo-2158,
; LPC-H2214, LPC-H2888, SAM7-H256, STM32-H103
; functions to set and clear a pin on a gpio port
(begin
  (define (set-pin port pin)
    (write (ash 1 (min pin 29)) port pin-set))
  (define (clear-pin port pin)
    (write (ash 1 (min pin 29)) port pin-clear)))

; STR-H711, CS-E9302, LM3S1968-EVB
; functions to set and clear a pin on a gpio port
(begin
  (define (set-pin port pin)
    (write (logior (ash 1 pin) (read port pin-status)) port pin-status))
  (define (clear-pin port pin)
    (write (logxor (ash 1 pin) (read port pin-status)) port pin-status)))

;------------- Common Code Starts -------------

; 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 (min pin 29))))))

; 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)))

;------------- Common Code Ends -------------

; toggle MCU board's LED(s)
(toggle ledport 26) ; LPC-H2103 green led

(toggle ledport 23) ; Tiny2106 red led

(toggle ledport 24) ; Tiny2106 yellow led

(toggle ledport 25) ; Tiny2106 green led

(toggle ledport 21) ; Tiny213x red led

(toggle ledport 22) ; Tiny213x yellow led

(toggle ledport 23) ; Tiny213x green led

(toggle ledport  2) ; SFE-Logomatic green led

(toggle ledport 11) ; SFE-Logomatic red led

(toggle ledport 24) ; LPC-H2148 green led

(toggle ledport 25) ; LCDDemo-2158 green led

(toggle ledport 30) ; LPC-H2214 red led

(toggle ledport  1) ; LPC-H2888 red led

(toggle ledport  8) ; SAM7-H256 green led

(toggle ledport  8) ; STR-H711 green led

(toggle ledport  0) ; CS-E9302 green led

(toggle ledport  1) ; CS-E9302 red led

(toggle ledport 12) ; STM32-H103 green led

(toggle ledport  2) ; LM3S1968-EVB green led


 

Multitasking:


This example is an update of the multitasking code used in prior versions of Armpit Scheme. The major difference with previous versions is that port addresses in 00.0137 are right-shifted by 4 bits (one hexadecimal digit). Timer ports, start/stop functions and configurations are given as MCU-specific blocks at the beginning of the code. This is followed by the program proper that is common to all MCUs.



; Armpit MultiTasking Example [requires the GPIO example, above]
; Tested on Tiny2138, SFE-Logomatic, LPC-H2148, LCDDemo-2158, Tiny2106,
;           LPC-H2214, SAM7-H256, STR-H711, LPC-H2888, CS-E9302,
;           STM32-H103, LM3S1968-EVB

; Tiny2106, Tiny213x, SFE-Logomatic, LPC-H2148, LCDDemo-2158, LPC-H2214
; define ports and offsets, functions to stop, start timer, and configure timer
(begin
  (define timer0 #xE000400)  ; T0 (IR = #x00, TCR = #x04, TC = #x08, PR = #x0C, MCR = #x14, MR0 = #x18)
  (define timer-period #x18) ; TxMR0 offset
  (define timer-count  #x08) ; TxTC  offset
  (define (stop timer)
    (write 0 timer #x04))    ; disable timer via TxTCR
  (define (restart timer)
    (write 2 timer #x04)     ; reset timer via TxTCR
    (write 1 timer #x04))    ; enable and start timer via TxTCR
  (write 59 timer0 #x0C)     ; set timer0 period to 1 us (for 60MHz clk) via T0PR
  (write 5  timer0 #x14)     ; set timer0 to generate interrupt and stop on MR0 match via T0MCR
  (stop timer0)
  (write 10000 timer0 timer-period))

; LPC-H2888
; define ports and offsets, functions to stop, start timer, and configure timer
(begin
  (define timer0 #x8002000)   ; Timer0 base address
  (define timer-period #x00)  ; offset to TnLoad
  (define timer-count  #x04)  ; offset to TnValue
  (define (stop timer)
    (write 0 timer #x08))     ; disable timer via TnControl
  (define (restart timer)
    (write 2344 timer0 timer-period)
    (write #xc8 timer #x08))  ; start timer via TnControl (60 MHz / 256 clock)
  (stop timer0))

; SAM7-H256
; define ports and offsets, functions to stop, start timer, and configure timer
(begin
  (define timer0  #xFFFA000)    ; 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
  (define (stop timer)
    (write 2 timer #x00))       ; stop timer via TCx_CCR
  (define (restart timer)
    (write 5 timer #x00))       ; enable, reset and start timer via TCx_CCR
  (write #x1000 #xFFFFFC0 #x10) ; Enable clock/power for timer0 (bit 12) via PMC_PCER
  (write #xC042 timer0 #x04)    ; wave mode, stop on cap RC, clock/32 (2/3 us for 48MHz clk) via TC0_CMR
  (write #x10   timer0 #x24)    ; Enable interrupt on RC match via TC0_IER
  (stop timer0)
  (write 15000 timer0 timer-period))

; STR-H711
; define ports and offsets, functions to stop, start timer, and configure timer
(begin
  (define timer0  #xE000900)     ; TIMER0
  (define timer-period #x08)     ; TIMn_OCAR offset
  (define timer-count  #x10)     ; TIMn_CNTR offset (resets to FFFC)
  (define (stop timer)
    (write 0 timer #x14))        ; disable timer via TIMn_CR1
  (define (restart timer)
    (write #x8000 timer #x14)    ; start timer via TIMn_CR1
    (write 0 timer timer-count)) ; reset timer count
  (write #x402F timer0 #x18)     ; period=1us (for 48 MHz clk) and generate interrupt on match via TIMn_CR2
  (stop timer0)
  (write 10000 timer0 timer-period))

; CS-E9302
; define ports and offsets, functions to stop, start timer, and configure timer
(begin
  (define timer0 #x8081000)   ; Timer1 base address
  (define timer-period #x00)  ; offset to Timer1Load
  (define timer-count  #x04)  ; offset to Timer1Value
  (define (stop timer)
    (write 0 timer #x08))     ; disable timer via TimerNControl
  (define (restart timer)
    (write #xC8 timer #x08))  ; start timer via TimerNControl (500kHz clock)
  (stop timer0)
  (write 5000 timer0 timer-period))

; STM32-H103
; define ports and offsets, functions to stop, start timer, and configure timer
(begin
  (define timer0 #x40012c0)
  (define timer-period #x2c)
  (define timer-count  #x24)
  (define (restart timer)
    (write #x0d timer #x00))
  (define (stop timer) #t)
  (write 0 timer0 #x0c)
  (write 71 timer0 #x28)
  (write 10000 timer0 timer-period)
  (write #x0d timer0 #x00)
  (write 1 timer0 #x14)
  (write 71 timer0 #x28)
  (write 10000 timer0 timer-period)
  (write 1 timer0 #x0c))

; LM3S1968 Eval Board
; define ports and offsets, functions to stop, start timer, and configure timer
(begin
  (define timer0 #x4003000)
  (define timer-control #x0C)
  (define timer-config #x00)
  (define timer-mode #x04)
  (define timer-period #x28)
  (define timer-imask #x18)
  (define timer-count #x48)
  (define (stop timer)
    (write #x00 timer timer-control))
  (define (restart timer)
    (write #x01 timer timer-control))
  (stop timer0)
  (write #x00 timer0 timer-config)
  (write #x01 timer0 timer-mode)
  (write 500000 timer0 timer-period)
  (write #x01 timer0 timer-imask))

;------------- Common Code Starts -------------

; 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
(restart timer0)

; read the timer count (to check proper operation, read it a few times)
(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))))))

;------------- Common Code Ends -------------

; spawn toggler on MCU board's LED(s)
(spawn (toggler ledport 23 2000)) ; Tiny2106 red led

(spawn (toggler ledport 24 1000)) ; Tiny2106 yellow led

(spawn (toggler ledport 25  500)) ; Tiny2106 green led

(spawn (toggler ledport 21 2000)) ; Tiny213x red led

(spawn (toggler ledport 22 1000)) ; Tiny213x yellow led

(spawn (toggler ledport 23  500)) ; Tiny213x green led

(spawn (toggler ledport 11 2000)) ; SFE-Logomatic red led

(spawn (toggler ledport  2 1000)) ; SFE-Logomatic green led

(spawn (toggler ledport 24 1000)) ; LPC-H2148 green led

(spawn (toggler ledport 25 1000)) ; LCDDemo LPC2158 green led

(spawn (toggler ledport 30 1000)) ; LPC-H2214 red led

(spawn (toggler ledport  1 1000)) ; LPC-H2888 red LED

(spawn (toggler ledport  8 1000)) ; SAM7-H256 green led

(spawn (toggler ledport  8 1000)) ; STR-H711 green led

(spawn (toggler ledport  0 2000)) ; CS-E9302 green LED

(spawn (toggler ledport  1 1000)) ; CS-E9302 red LED

(spawn (toggler ledport 12 1000)) ; STM32-H103 green led

(spawn (toggler ledport  2 2000)) ; LM3S1968-EVB green led


 

Multitasking on Small Memory MCUs:


This example adapts the multitasking code given above to MCUs with a small amount of RAM (eg. 8kB). It does not require the GPIO example.



; Armpit Scheme Multitasking Example [does not need gpio example above]
; FOR SMALL MEMORY MCUs
; Tested on Tiny2131, LPC-H2103

; define useful ports and configure timer0
(begin
  (define tmr0 #xE000400)
  (define gio0 #xE002800)
  (define gio1 #xE002801)
  (write    59 tmr0 #x0C)
  (write     5 tmr0 #x14)
  (write     2 tmr0 #x04)
  (write 10000 tmr0 #x18))

; 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 tmr0 #x04)
      (write 1 tmr0 #x04)
      (if (null? *q*) (rsme #t))
      ((car *q*) (set! *q* (append (cdr *q*) (cons rsme '())))))))
 tmr0 #x010000)

; Start timer 0
(write 1 tmr0 #x04)

; read the timer count
(read tmr0 #x08)

; function to spawn a new thunk (for infinite loops only: does not dequeue tasks)
(define (spwn thnk)
  (write 0  tmr0 #x04)
  (set! *q* (cons thnk *q*))
  (write 1  tmr0 #x04))

; function to toggle a gpio pin every "tcks" tick
(define (tglr port pin tcks)
  (define (go n)
    (if (> n 0)
      (go (- n 1))
      ((lambda ()
         (write pin port
       	 (if (= 0 (logand (read port #x00) pin)) #x04 #x0C))
        (go tcks)))))
  (lambda () (go tcks)))

; spawn togglers on MCU board's LEDs
(spwn (tglr gio1 (ash 1 23)  500)) ; Tiny2131 green led

(spwn (tglr gio1 (ash 1 22) 1000)) ; Tiny2131 yellow led

(spwn (tglr gio1 (ash 1 21) 2000)) ; Tiny2131 red led

(spwn (tglr gio0 (ash 1 26) 1000)) ; LPC-H2103 green led


 

Runge-Kutta:


The code below is the Runge-Kutta solution of a system of Ordinary Differential Equations (ODEs) representing a simple oscillator that is given on page 44 of the Revised^5 Report on the Algorithmic Language Scheme (r5rs). A helper function to drive the code is given at the end.



; Armpit Scheme Runge-Kutta Example (R5RS p. 44)
; Tested on Tiny2138, SFE-Logomatic, LPC-H2148, LCDDemo-2158, Tiny2106,
;           LPC-H2214, SAM7-H256, STR-H711, LPC-H2888, CS-E9302,
;           LM3S1968-EVB

(define integrate-system
  (lambda (system-derivative initial-state h)
    (let ((next (runge-kutta-4 system-derivative h)))
      (letrec ((states
		(cons initial-state
		      (delay (map-streams next states)))))
	states))))

; paste this in two chunks to avoid errors
(define runge-kutta-4
  (lambda (f h)
    (let ((*h (scale-vector h))
	  (*2 (scale-vector 2))
	  (*1/2 (scale-vector (/ 1 2)))
	  (*1/6 (scale-vector (/ 1 6))))
      (lambda (y)
	(let* ((k0 (*h (f y)))
	       (k1 (*h (f (add-vectors y (*1/2 k0)))))
	       (k2 (*h (f (add-vectors y (*1/2 k1)))))
	       (k3 (*h (f (add-vectors y k2)))))
	  (add-vectors
	   y (*1/6 (add-vectors k0 (*2 k1) (*2 k2) k3))))))))

(define elementwise
  (lambda (f)
    (lambda vectors
      (generate-vector
       (vector-length (car vectors))
       (lambda (i)
	 (apply f
		(map (lambda (v) (vector-ref v i))
		     vectors)))))))

(define generate-vector
  (lambda (size proc)
    (let ((ans (make-vector size)))
      (letrec ((loop
		(lambda (i)
		  (cond ((= i size) ans)
			(else
			 (vector-set! ans i (proc i))
			 (loop (+ i 1)))))))
	(loop 0)))))

(define add-vectors (elementwise +))

(define scale-vector
  (lambda (s)
    (elementwise (lambda (x) (* x s)))))

(define map-streams
  (lambda (f s)
    (cons (f (head s))
	  (delay (map-streams f (tail s))))))

(define head car)

(define tail
  (lambda (stream) (force (cdr stream))))

(define damped-oscillator
  (lambda (R L C)
    (lambda (state)
      (let ((Vc (vector-ref state 0))
	    (I1 (vector-ref state 1)))
	(vector (- 0 (+ (/ Vc (* R C)) (/ I1 C)))
		(/ Vc L))))))

(define the-states
  (integrate-system
   (damped-oscillator 10000 1000 .001)
   '#(1 0)
   .01))

; function to compute the solution for a given time span
(define oscillate
  (lambda (steps)
    (let loop ((n steps) (r the-states))
      (and (>= n 0)
	   (write (- steps n))
	   (write (head r))
	   (newline)
	   (loop (- n 1) (tail r))))))

; compute the solution
(oscillate 10)

(oscillate 50)

(oscillate 100)


 

Expert System:


This Expert System example is the same as that of version 00.0098. The first comment updates the MCU boards on which it has been tested.




; Armpit Scheme Expert System Example
; Tested on Tiny2106, LPC-H2214, SAM7-H256, STR-H711, LPC-H2888,
;           CS-E9302, LM3S1968-EVB

; 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 a variable is bound
; uses (interaction-environment) to define 'new' vars
(define (bound? var)
  (or (defined? var)
      (eval `(define ,var 'UNASSIGNED) (interaction-environment)))
  (not (eq? (eval var) 'UNASSIGNED)))

; 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 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 '(grandfather ?x alice))

(all '(grandfather ?x linda))

(all '(?x jim ?y))

(all '(grandparent ?x ?x))

(all '(son ?x ?y))

(all '(son jim ?x))

(all '(son ?x jim))

(all '(daughter ?x joe))

 

LCDDemo-2158 I2C LCD:


This is an example of how to use the 8-digit LCD on the Future Designs LCDDemo-LPC2158 MCU board.




; Armpit Scheme I2C Communication to LCD Example
; Tested on LCDDemo-2158


; define useful ports
; pinsel <- PINSEL0 port (0 = #x00, 1 = #x04, 2 = #x14)
; i2c    <- I2C0    port (CONSET = #x00, STAT = #x04, SCLH = #x10, SCLL = #x14, CONCLR = #x18)
(begin
  (define i2c    #xE001C00) 
  (define pinsel #xE002C00) 
  (define lcd    '#(#x38)))

; configure MCU pins for I2C0 operation
; 1- configure P0.2 and P0.3 as I2C via PINSEL0
; 2- set I2C high clock period to 0.783 us (60 MHz pclck, 400kb/s) via I2C0SCLH
; 3- set I2C low period to 1.716 us (60 MHz pclck, 400kb/s) via I2C0SCLL
; 4- clear STA and SI via I2C0CONCLR
; 5- enable I2C on port 0, both master and slave (set I2EN, AA) via I2C0CONSET
(begin
  (write (logior #x50 (logand #xFFFFFF0F (read pinsel 0))) pinsel 0)
  (write 47   i2c #x10) 
  (write 103  i2c #x14) 
  (write #x28 i2c #x18) 
  (write #x44 i2c #x00)) 

; function to write data/commands to LCD via I2C
(define (write-lcd val)
  (write val i2c lcd 3)) ; write 3 bytes to lcd address

; write-lcd (above) may break when multitasking.
; A multitasking-safe(r) (serialized) version is below (commented).
; It is designed to work with the multitasking/GPIO example above.
; function to write data/commands to LCD via I2C
;(define (write-lcd val)
;  (stop timer0)
;  (write val i2c lcd 3) ; write 3 bytes to lcd address
;  (restart timer0))

; configure LCD
(write-lcd #xcce070) ; mode set (bias 1/3, enabled), select dev 0, no blnk

; light-up all LCD segments
(let loop ((pos 0))
  (if (> pos 7) #t
     (begin
       (write-lcd (logior #xffff (ash pos 18)))
       (loop (+ pos 1)))))

; clear LCD segments
(let loop ((pos 0))
  (if (> pos 7) #t
     (begin
       (write-lcd (ash pos 18))
       (loop (+ pos 1)))))

; display 3 letters
(begin
  (write-lcd #x0Ce426)  ; write letter A at digit 3
  (write-lcd #x08e427)  ; write letter B at digit 2
  (write-lcd #x048007)) ; write letter C at digit 1



Last updated June 17, 2008

bioe-hubert-at-sourceforge.net