This page presents examples of: 1) using libraries, 2) the Runge-Kutta example of r5rs, 3) the library-based Runge-Kutta example of r6rs, 4) Fast Fourier Transforms (FFT), 5) an expert system, 6) the game of life (Conway) 7) spark sprite flares 8) random numbers, and 9) ARMSchemblers for Armpit Scheme. These examples are similar to those of previous snapshots but updated for this version, where applicable. Examples of GPIO, Threads, ADC, PWM and/or other hardware-oriented processes are presented in a separate page of MCU-specific examples.
The code below adapts the first library example given in section 7.3 of r6rs to ArmPit Scheme. The modifications are mainly related to the lack of "rename", "only" and "prefix" forms in this version.
; Armpit Scheme Party Library Example
; build the stack library
(define-library
(stack)
(export stack:make stack:push! stack:pop! stack:empty!)
(import (r5rs))
(define (stack:make) (list '()))
(define (stack:push! s v) (set-car! s (cons v (car s))))
(define (stack:pop! s)
(let ((v (caar s)))
(set-car! s (cdar s))
v))
(define (stack:empty! s) (set-car! s '())))
; build the balloons library
(define-library
(balloons)
(export balloon:make balloon:push balloon:pop)
(import (r5rs))
(define (balloon:make w h) (cons w h))
(define (balloon:push b amt)
(cons (- (car b) amt) (+ (cdr b) amt)))
(define (balloon:pop b) (display "Boom! ")
(display (* (car b) (cdr b)))
(newline)))
; build the party library
(define-library
(party)
(export make push push! make-party pop!)
(import (r5rs) (stack) (balloons))
(define make balloon:make)
(define push balloon:push)
(define push! stack:push!)
(define (make-party)
(let ((s (stack:make)))
(push! s (balloon:make 10 10))
(push! s (balloon:make 12 9))
s))
(define (pop! p)
(balloon:pop (stack:pop! p))))
; list all libraries
(libs)
; import the party library
(import (party))
; have a party (test program)
(begin
(define p (make-party))
(pop! p) ; displays "Boom! 108"
(push! p (push (make 5 5) 1))
(pop! p)) ; displays "Boom! 24"
; de-import all libraries (if desired)
(import)
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. This example is the same as in all prior versions of Armpit Scheme.
; Armpit Scheme Runge-Kutta Example (R5RS p. 44)
(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))))
(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))))
;; parallel RLC
;; i = inductor current
;; v = common voltage
;; dv/dt = -i/C - v/RC = - (i+v/R) 1/C
;; di/dt = v/L
;; d2v/dt2 = -1/C di/dt - 1/RC dv/dt
;; <=> d2v/dt2 + 1/RC dv/dt + v/LC = 0
(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)
The code below is the library version of the Runge-Kutta example presented above. It is adapted from the library example presented in Appendix D of the r6rs. The code has been modified from the r6rs example to use delay/force as in the r5rs example rather than lambdas (as in the r6rs example) because the former leads to markedly faster execution in the ArmPit Scheme interpreter (the same was observed in guile 1.7.1 for a non-library based implementation). It is the same as in the previous snapshot.
; Armpit Scheme Runge-Kutta Library Example (R6RS Appendix D)
; build the runge-kutta library
(define-library
(runge-kutta)
(export integrate-system head tail)
(import)
;; library body
(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))))
(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)
;; y is a system state
(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)))))
; list all libraries (as a check)
(libs)
; import the runge-kutta library
(import (runge-kutta))
;; parallel RLC
;; i = inductor current
;; v = common voltage
;; dv/dt = -i/C - v/RC = - (i+v/R) 1/C
;; di/dt = v/L
;; d2v/dt2 = -1/C di/dt - 1/RC dv/dt
;; <=> d2v/dt2 + 1/RC dv/dt + v/LC = 0
(define damped-oscillator
(lambda (R L C)
(lambda (state)
(let ((Vc (vector-ref state 0))
(Il (vector-ref state 1)))
(vector (- 0 (+ (/ Vc (* R C)) (/ Il 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 50)
; utility functions for a different solution syntax
(define (linspace start end n)
(let ((v (make-vector n)) (r (- end start)) (nm1 (- n 1)))
(let loop ((i 0))
(if (> i nm1) v
(begin (vector-set! v i (+ start (* r (inexact (/ i nm1)))))
(loop (+ i 1)))))))
(define (writeln item) (write item) (newline))
(define (rk-solve system tvec ic)
(let* ((nt (vector-length tvec))
(dt (/ (- (vector-ref tvec (- nt 1)) (vector-ref tvec 0)) (- nt 1)))
(v (make-vector nt)))
(let loop ((n 0) (s (integrate-system system ic dt)))
(if (>= n nt) v
(begin
(vector-set! v n (head s))
(loop (+ n 1) (tail s)))))))
; solve with alternative syntax
(vector-for-each writeln
(rk-solve (damped-oscillator 10000 1000 .001) (linspace 0 1 101) #(1 0)))
The code below provides two examples of Fast Fourier Transform computation. The examples are the same as in the previous snapshot. The first example is adapted for complex numbers from the FFT example provided in the Gambit-C Scheme benchmarks here, and side-effects the input data vector. The second example is adapted from a Scheme Workshop entry by John David Stone and preserves the input data vector.
; Armpit Scheme FFT Example
; Example 1: FFT adapted from Gambit-C Scheme
benchmarks
; modified for complex numbers
; define pi
(define pi (* 4 (atan 1)))
; forward FFT function
(define (four2 data)
(let ((n (vector-length data)))
(let loop1 ((i 0) (j 0))
(if (< i n)
(begin
(if (< i j)
(let ((temp (vector-ref data i)))
(vector-set! data i (vector-ref data j))
(vector-set! data j temp)))
(let loop2 ((m (bitwise-arithmetic-shift n -1)) (j j))
(if (and (>= m 2) (>= j m))
(loop2 (bitwise-arithmetic-shift m -1) (- j m))
(loop1 (+ i 1) (+ j m)))))))
(let loop3 ((mmax 1))
(if (< mmax n)
(let ((wp (- (make-polar 1 (/ pi mmax)) 1)))
(let loop4 ((w 1.0) (m 0))
(if (< m mmax)
(begin
(let loop5 ((i m))
(if (< i n)
(let* ((j (+ i mmax))
(temp (* w (vector-ref data j))))
(vector-set! data j (- (vector-ref data i) temp))
(vector-set! data i (+ (vector-ref data i) temp))
(loop5 (+ j mmax)))))
(loop4 (+ (* w wp) w) (+ m 1)))))
(loop3 (* mmax 2)))))))
; simple data set, 32 real values
(define data
(let ((d (make-vector 32)))
(let loop ((n 0))
(if (> n 31) d
(begin
(vector-set! d n (+ 1/3 (cos (* (/ 2 32) 2 pi n))))
(loop (+ n 1)))))))
; forward transform -- this side-effects data
(four2 data)
; view result
data
; slightly less simple data set, 32 real values
(define data
(let ((d (make-vector 32)))
(let loop ((n 0))
(if (> n 31) d
(begin
(vector-set! d n
(+ 1/3 (cos (* (/ 2 32) 2 pi n)) (* 2 (sin (* (/ 5 32) 2 pi n)))
(* -3 (sin (* (/ 15 32) 2 pi n))) ))
(loop (+ n 1)))))))
; compute transform and show rounded magnitudes
(begin
(define dat (vector-copy data))
(four2 dat)
(vector-map (lambda (c) (exact (round (magnitude c)))) dat))
; compute transform and show components
(let ((dat (vector-copy data)))
(four2 dat)
(vector
(vector-map (lambda (c) (exact (round (real-part c)))) dat)
(vector-map (lambda (c) (exact (round (imag-part c)))) dat)))
; Example 2: FFT adapted from Scheme Workshop code by John David Stone
; define pi
(define pi (* 4 (atan 1)))
(define fft
(let ((unshuffle
(lambda (seq)
(let loop ((rest seq)
(evens '())
(odds '()))
(if (null? rest)
(cons (reverse evens) (reverse odds))
(loop (cddr rest)
(cons (car rest) evens)
(cons (cadr rest) odds)))))))
(lambda (sequence)
(let ((len (length sequence)))
(if (= len 1)
sequence
(let ((nth-root (make-polar 1 (/ (* 2 pi) len)))
(half-len (quotient len 2))
(packs (unshuffle sequence)))
(let loop ((step 0)
(root 1)
(evens (fft (car packs)))
(odds (fft (cdr packs)))
(front '())
(rear '()))
(if (= step half-len)
(append (reverse front) (reverse rear))
(loop (+ step 1)
(* root nth-root)
(cdr evens)
(cdr odds)
(cons (+ (car evens) (* root (car odds)))
front)
(cons (- (car evens) (* root (car odds)))
rear))))))))))
; relatively simple data set, 32 real values
(define data2
(let ((d (make-vector 32)))
(let loop ((n 0))
(if (> n 31) (vector->list d)
(begin
(vector-set! d n
(+ 1/3 (cos (* (/ 2 32) 2 pi n)) (* 2 (cos (* (/ 5 32) 2 pi n)))))
(loop (+ n 1)))))))
; perform FFT
(fft data2)
; get magnitude of Fourier components
(map magnitude (fft data2))
; get rounded magnitude of Fourier components
(map round (map magnitude (fft data2)))
; get integer (exact) magnitude of Fourier components
(map exact (map round (map magnitude (fft data2))))
; get integer (exact) magnitude of Fourier components (method 2)
(map (lambda (c) (exact (round (magnitude c)))) (fft data2))
This Expert System example is the same as in the previous snapshot.
; Armpit Scheme Expert System Example
; 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 (eval `(expand (set ,var ',expr)))))
; function to identify whether a variable is bound
; uses (interaction-environment) to define 'new' vars
(define (bound? var)
(or (defined? var (interaction-environment))
(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 jill)
(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))
(all '(?x ?y ?z)) ; find every ternary relation that can be infered
This example is an adaptation of the library example presented in section 5.6.2 of R7RS (Revised 7 Report on the Algorithmic Language Scheme) draft 8, edited by A. Shinn, J. Cowan and A.A. Gleckler (December 9, 2012). It implements Conway's Game of Life on a rectangular grid and displays cell state "graphically" using ascii characters on a VT-100 terminal (eg. minicom, TeraTerm). The present adaptation is not in library form and includes components of VT-100 control adapted from the Programming Praxis web site. It is the same as in the previous snapshot.
; Armpit Scheme Game of Life Example
; VT-100 utility definitions (adapted from Programming Praxis)
(begin
(define esc (integer->char 27))
(define (cls) (for-each write-char (list esc #\[ #\2 #\J)))
(define (erase-eol) (for-each write-char (list esc #\[ #\K)))
(define (goto r c)
(write-char esc)
(write-char #\[)
(display r)
(write-char #\;)
(display c)
(write-char #\H)))
; Grid building functions (adapted from R7RS Draft 8)
(begin
;; Create an NxM grid.
(define (make n m)
(let ((grid (make-vector n)))
(do ((i 0 (+ i 1)))
((= i n) grid)
(let ((v (make-vector m #false)))
(vector-set! grid i v)))))
(define (rows grid)
(vector-length grid))
(define (cols grid)
(vector-length (vector-ref grid 0)))
;; Return #f if out of range.
(define (ref grid n m)
(and (< -1 n (rows grid))
(< -1 m (cols grid))
(vector-ref (vector-ref grid n) m)))
(define (put! grid n m v)
(vector-set! (vector-ref grid n) m v))
(define (each grid proc)
(do ((j 0 (+ j 1)))
((= j (rows grid)))
(do ((k 0 (+ k 1)))
((= k (cols grid)))
(proc j k (ref grid j k)))))
(define (each2 grid1 grid0 proc)
(do ((j 0 (+ j 1)))
((= j (rows grid1)))
(do ((k 0 (+ k 1)))
((= k (cols grid1)))
(proc j k (ref grid1 j k) (ref grid0 j k))))))
; Game of Life (adapted from R7RS Draft 8)
(begin
(define (life-count grid i j)
(define (count i j)
(if (ref grid i j) 1 0))
(+ (count (- i 1) (- j 1))
(count (- i 1) j)
(count (- i 1) (+ j 1))
(count i (- j 1))
(count i (+ j 1))
(count (+ i 1) (- j 1))
(count (+ i 1) j)
(count (+ i 1) (+ j 1))))
(define (life-alive? grid i j)
(case (life-count grid i j)
((3) #t)
((2) (ref grid i j))
(else #f)))
(define (life-print2 grid1 grid0)
(each2 grid1 grid0
(lambda (i j v1 v0)
(if (not (eq? v1 v0))
(begin
(goto (+ i 1) (+ j 1))
(write-char (if v1 #\o #\ ))
(goto (+ 1 (rows grid1)) 1))))))
(define (life grid iterations)
(cls)
(life-print2 grid (make (rows grid) (cols grid)))
(do
((i 0 (+ i 1))
(grid0 grid grid1)
(grid1 (make (rows grid) (cols grid)) grid0))
((= i iterations))
(each grid0
(lambda (j k v)
(put! grid1 j k (life-alive? grid0 j k))))
(life-print2 grid1 grid0))))
; Build grid and run glider (adapted from R7RS Draft 8)
(begin
(define grid (make 20 20))
(put! grid 1 1 #t)
(put! grid 2 2 #t)
(put! grid 3 0 #t)
(put! grid 3 1 #t)
(put! grid 3 2 #t)
(life grid 60))
This example comes from the discussion of adapting Spark to Scheme, on Reddit, and the corresponding implementation in Racket by kori-ayakashi. It illustrates some aspect of unicode support in version 080.
; Armpit Scheme Spark/Flare/Sprite Example
(define (floor-quotient x y) (exact (floor (/ x y)))) ; r7rs function
(define default-bars '(#\▁ #\▂ #\▃ #\▄ #\▅ #\▆ #\▇ #\█))
(define (spark-line l b)
(list->string
(map (lambda (index)
(list-ref b (- index 1)))
(map (lambda (percentage)
(if (or (zero? percentage)
(negative? percentage))
1
percentage))
(map
(lambda (number)
(floor-quotient
(* (length b) number)
(apply max l))) l)))))
(define (spark l) (display (spark-line l default-bars)))
; Tests
(spark '(2 5 5.5 6 10)) ; -> ▁▄▄▄█
(spark '(100 275 400 300)) ; -> ▂▅█▆
(spark '(1 2 3 4 100 5 10 20 50 300)) ; -> ▁▁▁▁▂▁▁▁▁█
This version includes a Parks-Miller linear congruential pseudo-random number sequence generator, named RNG, that, for 32-bit MCUs, takes a 4-octet bytevector as input and returns a 4-octet bytevector representing the next value in the pseudo-random sequence, while, for 64-bit MCUs, it takes an integer (of up to 32 bits) as input and returns the next one in the sequence. It can be used in functions that return integer or float pseudo-random number generators, with uniform distribution, as in the following 32-bit examples:
; 32-bit cortex-a8/m7
;; integer (0 to 536870911)
(define (make-irndu seed)
(lambda () (bytevector-s32-native-ref (<< (RNG seed) -2) 0)))
;; float (0.0 to 1.0)
(define (make-frndu seed)
(lambda ()
(/ (bytevector-s32-native-ref (<< (RNG seed) -2) 0) 5.36870911e8)))
These pseudo-random generators can then be used as follows:
; 32-bit cortex-a8/m7
ap> (define q (make-irndu #u8(1 0 0 0)))
ap> (q) ;; output is pseudo-random integer (call repeatedly for sequence)
ap> (define r (make-frndu #u8(1 0 0 0)))
ap> (r) ;; output is pseudo-random float (call repeatedly for sequence)
and similarly, for 64-bit MCUs, the genrators can be defined using:
; 64-bit cortex-a53
;; integer (0 to 2147483647)
(define (make-irndu seed)
(lambda () (set! seed (RNG seed)) seed))
;; float (0.0 to 1.0), seed is 0 to 2147483647
(define (make-frndu seed)
(lambda () (set! seed (RNG seed)) (/ seed 2.147483647e9)))
and then used as follows:
; 64-bit cortex-a53
ap> (define q (make-irndu 1))
ap> (q) ;; output is pseudo-random integer (call repeatedly for sequence)
ap> (define r (make-frndu 1))
ap> (r) ;; output is pseudo-random float (call repeatedly for sequence)
The ARMSchemblers presented here are considered works in progress, mainly because they do not come (yet) in the form of libraries. Nevertheless, they are able to assemble an interesting range of ARMSchembly code sequences:
ap> (sd-init) ; check for #t, #vu8(...) or a number, redo if #f
ap> (load "as32_080.scm") ; load ArmSchembler for 32-bit ARM target
Either of the 3 ArmSchemblers might then be used to produce a fast version of
the tak() function, using:
(define atak
(_mvah
(_mkc 3 ; sv1 = x, sv2 = y, sv3 = z
(assemble
'(takin ; [internal entry]
(cmp sv2 sv1) ; done?
(if (pl b done)) ; if so, jump to exit
(save sv1 sv2 sv3 con) ; dts = (x y z con ...)
(sub sv1 sv1 4) ; sv1 = (- x 1)
(call takin) ; sv1 = xnew = (tak sv1 sv2 sv3) = (tak (- x 1) y z)
(set! sv5 sv1) ; sv5 = xnew
(restore sv3 sv1 sv2) ; sv3 = x, sv1 = y, sv2 = z, dts = (con ...)
(save sv1 sv2 sv3 sv5) ; dts = (y z x xnew con ...)
(sub sv1 sv1 4) ; sv1 = (- y 1)
(call takin) ; sv1 = ynew = (tak sv1 sv2 sv3) = (tak (- y 1) z x)
(set! sv4 sv1) ; sv4 = ynew
(restore sv3 sv1 sv2) ; sv3 = y, sv1 = z, sv2 = x, dts = (xnew con ...)
(save sv4) ; dts = (ynew xnew con ...)
(sub sv1 sv1 4) ; sv1 = (- z 1)
(call takin) ; sv1 = znew = (tak sv1 sv2 sv3) = (tak (- z 1) x y)
(set! sv3 sv1) ; sv3 = znew
(restore sv2 sv1 con) ; sv2 = ynew, sv1 = xnew, con = con, dts = (...)
(b takin) ; jump to compute (tak sv1 sv2 sv3) = (tak xnew ynew znew)
; exit with result
done
(set! sv1 sv3) ; sv1 = z, result
(br con))) ; return
())))
and testing the result:
(atak 18 12 6) ; -> 7