169 lines
4.8 KiB
Scheme
169 lines
4.8 KiB
Scheme
(cond-expand
|
|
(guile
|
|
(define-module (embddr common))
|
|
|
|
(import (srfi srfi-1)
|
|
(srfi srfi-60))
|
|
|
|
(export log2 clog2 round-to
|
|
one? power-of-two?
|
|
curry curry-r
|
|
transpose
|
|
number->string-binary
|
|
number->string-binary-slice
|
|
number->string-hex
|
|
number->bits
|
|
string-c-radix->number
|
|
has-duplicates? find-duplicates
|
|
|
|
make-mux-selectors))
|
|
(else
|
|
(error "Guile is required")))
|
|
|
|
;;; Log2
|
|
(define (log2 x)
|
|
(/ (log x) (log 2)))
|
|
|
|
;;; Ceiling of log2 ($clog2 function in SV)
|
|
(define (clog2 x)
|
|
(inexact->exact (ceiling (log2 x))))
|
|
|
|
;;; Check a number is a power of two
|
|
(define (power-of-two? x)
|
|
(let ((l (round (log2 x))))
|
|
(= (expt 2 l) x)))
|
|
|
|
;;; Check for (x == 1)
|
|
(define (one? x) (= x 1))
|
|
|
|
;;; Round to the 'n' decimal place
|
|
(define (round-to n num)
|
|
(let ((k (expt 10 n)))
|
|
(/ (round (* num k)) k)))
|
|
|
|
;;; Currying
|
|
;;; Example: ((curry-r f 1) 2 3) -> (f 1 2 3)
|
|
(define (curry f . args)
|
|
(lambda x (apply f (append args x))))
|
|
|
|
;;; Currying right
|
|
;;; Example: ((curry-r f 1) 2 3) -> (f 2 3 1)
|
|
(define (curry-r f . args)
|
|
(lambda x (apply f (append x args))))
|
|
|
|
;;; Transpose of matrix (list of lists)
|
|
(define (transpose m)
|
|
(apply map (cons list m)))
|
|
|
|
;;; Convert number to binary string of length 'len'
|
|
(define (number->string-binary n len)
|
|
(list->string
|
|
(reverse
|
|
(map (lambda (x) (if x #\1 #\0))
|
|
(list-tabulate len (lambda (i) (bit-set? i n)))))))
|
|
|
|
;;; Convert number to binary and slice from msb to lsb
|
|
(define (number->string-binary-slice n msb lsb)
|
|
(list->string
|
|
(reverse
|
|
(drop
|
|
(map (lambda (x) (if x #\1 #\0))
|
|
(list-tabulate (+ msb 1) (lambda (i) (bit-set? i n))))
|
|
lsb))))
|
|
|
|
;;; Convert number to hex with length l (padded left with 0)
|
|
(define (number->string-hex n l)
|
|
(let* ((s (number->string n 16))
|
|
(sl (string-length s)))
|
|
(if (<= l sl)
|
|
s
|
|
(string-append (make-string (- l sl) #\0) s))))
|
|
|
|
;;; Convert number to bit list
|
|
(define (number->bits x len)
|
|
(map (lambda (n) (if (bit-set? n x) 1 0)) (iota len)))
|
|
|
|
;;; Convert arbitrary radix string in C-format (0x, 0b 0..) to number
|
|
(define (string-c-radix->number str)
|
|
(if (and str (string? str))
|
|
(let ((str (string-trim-both str)))
|
|
(cond
|
|
((string-every #\0 str) 0)
|
|
((string-prefix? "0x" str)
|
|
(string->number (substring str 2) 16))
|
|
((string-prefix? "0b" str)
|
|
(string->number (substring str 2) 2))
|
|
((string-prefix? "0" str)
|
|
(string->number (substring str 1) 8))
|
|
(else
|
|
(string->number str 10))))
|
|
#f))
|
|
|
|
;;; Check list for duplicates
|
|
(define (has-duplicates? items less)
|
|
(if (< (length items) 2)
|
|
#f
|
|
(let ((sorted (sort items less)))
|
|
(any (lambda (a b) (and (not (less a b))
|
|
(not (less b a))))
|
|
sorted
|
|
(append (cdr sorted)
|
|
`(,(car sorted)))))))
|
|
|
|
;;; Return first duplicated item or #f if no duplicates
|
|
(define (find-duplicates items less)
|
|
(if (null? items)
|
|
#f
|
|
(let ((sorted (sort items less)))
|
|
(let loop ((item (car sorted))
|
|
(rest (cdr sorted)))
|
|
(cond
|
|
((null? rest) #f)
|
|
((and (not (less item (car rest)))
|
|
(not (less (car rest) item))) item)
|
|
(else (loop (car rest) (cdr rest))))))))
|
|
|
|
;;; In the list b0 leaves only the last most significant (other than b1) bit
|
|
(define (bits-first-diff-msb b0 b1)
|
|
(let loop ((b0 (reverse b0))
|
|
(b1 (reverse b1))
|
|
(keep '()))
|
|
(if (null? b0)
|
|
keep
|
|
(let ((b0b (car b0))
|
|
(b0s (cdr b0)))
|
|
(if (= b0b (car b1))
|
|
(loop b0s (cdr b1) (cons #f keep))
|
|
(append (make-list (length b0s) #f) (cons b0b keep)))))))
|
|
|
|
;;; Return bit lists of address selectors
|
|
;;; If list item is #f then bit is not care
|
|
;;; First element of each list is a address
|
|
;;; Example:
|
|
;;; (make-mux-selectors '(#x10 #x20 #x30)) ->
|
|
;;; ((#x30 #f #f #f #f 1 1)
|
|
;;; (#x20 #f #f #f #f 0 1)
|
|
;;; (#x10 #f #f #f #f #f 0))
|
|
(define (make-mux-selectors addrs)
|
|
(let ((bit-width (apply max (map integer-length addrs)))
|
|
(addrs (sort addrs >)))
|
|
(map
|
|
(lambda (addr)
|
|
(let ((others (remove (curry = addr) addrs))
|
|
(abits (number->bits addr bit-width)))
|
|
(cons
|
|
addr
|
|
(apply map
|
|
(lambda bits
|
|
(let ((abit (car bits))
|
|
(obits (cdr bits)))
|
|
(if (every not obits) #f abit)))
|
|
(cons
|
|
abits
|
|
(map
|
|
(lambda (other)
|
|
(let ((obits (number->bits other bit-width)))
|
|
(bits-first-diff-msb abits obits)))
|
|
others))))))
|
|
addrs)))
|