Subversion Repositories core_arm

;-----------------------------------------------------------------------

(defun int-to-bitstring-rec (n m size)

  "Return a bitstring reverse order"

  (if (> size 0)

      (if (eq (logand n m) 0)

          (cons '0 (int-to-bitstring-rec n (lsh m 1) (- size 1)) )

          (cons '1 (int-to-bitstring-rec n (lsh m 1) (- size 1)) )

      )

      '()

    )

)

(defun int-to-bitstring (n m size)

  "Return a bitstring"

  (reverse (int-to-bitstring-rec n m size))

)

(defun hexchar-to-bitstring (hexchar)

  "Convert char to bit sequence"

  ( let ((n (downcase hexchar)))

    (if (and (>= n ?a) (<= n ?f))

      (int-to-bitstring (+ (- n ?a) 10) 1 4 )

      (if (and (>= n ?0) (<= n ?9))

        (int-to-bitstring (- n ?0) 1 4 )

      )

    )

  )

)

(defun hex-to-bitstring (hex)

  "Convert hex string into bitstring"

  (if (> (length hex) 0)

    ( append (hexchar-to-bitstring (elt hex 0)) (hex-to-bitstring (substring hex 1 (length hex))))

    '()

  )

)

;-----------------------------------------------------------------------

(defun mapcar* (function &rest args)

  "Apply FUNCTION to successive cars of all ARGS. Return the list of results."

  ;; If no list is exhausted,

  (if (not (memq 'nil args))

      ;; apply function to CARs.

      (cons (apply function (mapcar 'car args))

            (apply 'mapcar* function

                   ;; Recurse for rest of elements.

                   (mapcar 'cdr args)))))

(defun isundef-p (e)

  (not (or (eq e 0) (eq e 1))))

(defun and-bit (l)

  "And bit using undef values"

  (if (and (eq (nth 0 l) '1) (eq (nth 1 l) '1))

    '1

    (if (or (isundef-p (nth 0 l)) (isundef-p (nth 1 l)))

      'U

      '0

    )

  )

)

(defun or-bit (l)

  "And bit using undef values"

  (if (and (eq (nth 0 l) '0) (eq (nth 1 l) '0))

    '0

    (if (or (isundef-p (nth 0 l)) (isundef-p (nth 1 l)))

      'U

      '1

    )

  )

)

(defun make-undef-bit (l)

  "Undef values on l[1] == 0"

  (if (eq (nth 1 l) '1)

    (nth 0 l)

    'U

  )

)

(defun make-isundef-bit (b)

  "1 if not undef"

  (if (isundef-p b)

    '1

    '0

  )

)

(defun and-bitstring (a b)

  "And bitstring"

  (mapcar' 'and-bit (mapcar* 'list a b))

)

(defun or-bitstring (a b)

  "Or bitstring"

  (mapcar 'or-bit (mapcar* 'list a b))

)

(defun make-undef-bitstring (a u)

  "Set undefined value where u == 0"

  (mapcar 'make-undef-bit (mapcar* 'list a u))

)

(defun make-set-bitstring (a)

  "Make maskestring where not undefined"

  (mapcar 'make-isundef-bit a)

)

;-----------------------------------------------------------------------

(defun in-bound-p (start end pos)

  (and (>= pos start) (< pos end)))

(defun count-bits (a)

  "Count n equal bits from start"

  (let ((e (pop a))

        (n 1))

    (if (eq e '())

      (setq n 0)

      (while (eq e (nth 0 a))

         (pop a)

         (setq n (+ n 1))

      )

    )

    `,n

  )

)

(defun make-setbit-groups-rec (a)

   (if (> (length a) 0)

      (let ((n (count-bits a))

            (e (nth 0 a)))

        (append (make-setbit-groups-rec (nthcdr n a)) `(,(make-list n e)))

      )

      '()

   )

)

(defun make-setbit-groups (a)

   "Raise the consecutive 1s"

   (reverse (make-setbit-groups-rec a)))

(defun or-setbit-groups-func (l)

  (let ((a (nth 0 l))

        (b (nth 1 l))

        (al (length (nth 0 l)))

        (bl (length (nth 1 l)))

        (ae (nth 0 (nth 0 l)))

        (be (nth 0 (nth 1 l)))

        (oe (logior (nth 0 (nth 0 l)) (nth 0 (nth 1 l))))

        )

    (insert (number-to-string oe))

    ( if (eq al bl)

        (

         if (> al bl)

            ()

            ()

        )

    )

    ))

(defun rec-copy-list-func (e)

  (if (listp e)

      (mapcar 'rec-copy-list-func e)

   `,e)

)

(defun rec-copy-list (l)

  "Copy list"

  (mapcar 'rec-copy-list-func l)

)

(defun cut-copy-list (l start end)

  "Copy list and cut range"

  (let ((c (rec-copy-list l)))

    (if (<= end 0)

        (setq c '())

        (if (<= end (length c))

            (setcdr (nthcdr (- end 1) c) '())

        )

    )

    (nthcdr start c)

  )

)

;l:        (0  0  0  0  0)

;p1:     1     x

;p2:     3         |<x

;result:  ((0)(1  1)( 0 0))

;(split-setbit-copy-list '(0  0  0  0  0) 1 3)

(defun split-setbit-copy-list (l p1 p2 )

  "Splits list between [p1,p2]  and fill [p1,p2] with ones"

  (let

      ((r l)

       (size (length l)))

    (if (and (in-bound-p 1 size p1)(in-bound-p 1 size p2))  ; split into 3

        (

          `( ( ,(cut-copy-list l 0 p1) ) ( ,(make-list (- p2 p1) 1) ) ( ,(cut-copy-list l p2 size)))

         )

        (if (in-bound-p 1 size p1)                          ; split into 2

           (

            `( ( ,(cut-copy-list l 0 p1) ) ( ,(make-list (- size p1) 1) ) )

            )

           (if (in-bound-p 1 size p2)                       ; split into 2

               (

                `( ( ,(make-list p2 1) ) (  ,(cut-copy-list l p2 size) ) )

               )

               (if (and (< p1 0) (>= p2 size))

                   `( ,(make-list size 1) )

                   `( ,l);                                       ; do not split

               )

           )

        )

    )

    ))

;l:      ((1  1  1)(0  0)(1  1))

;off:  2         x

;elt: (x x)

;result: ((1  1)(1)(1)(0)(1  1))

;(or-setbit-groups-into '((1  1  1)(0  0)(1  1)) 2 '(0 0))

(defun or-setbit-groups-into (l off elt)

  "Insert splitting range element <elt> into list <l> at offset <off>"

  (let ((cur 0)

        (start off)

        (end (+ off (length elt)))

        (v '())

        )

    (dolist (e (mapcar (function (lambda (x)

      (let ((curstart cur)

            (curend (+ cur (length x))))

        (setq cur curend)

        (split-setbit-copy-list x (- start curstart) (- end curstart)

            )))) l )

     v)

      (setq v (append v e))

      )

))

;a:      ((1  1  1)(0  0)(1  1))

;b:      ((0)(1  1  1)(0  0)(1))

;result: ((1)(1  1)(1)(0)(1)(1))

;(or-setbit-groups '((1  1  1)(0  0)(1  1)) '((0)(1  1  1)(0  0)(1)))

(defun or-setbit-groups (a b)

  "Split and or 2 raised setbit groups"

  (let ((value a)

        (off 0)

        )

    (dolist (elt b value)

      (if (eq (nth 0 elt) 1)

          (setq value (or-setbit-groups-into value off elt))

      )

      (setq off (+ off (length elt)))

      )))

(setq a '(1 1 0 0))

(setq b '(1 0 0 0))

(setq c '(1 1 0 1))

(setq ac (make-setbit-groups a))

(setq bc (make-setbit-groups b))

(setq cc (make-setbit-groups c))

(setq dc (or-setbit-groups ac bc))

(or-setbit-groups dc cc)

(or-setbit-groups-func '((0) (1 1 )))1

(setq l '(2 3 4))

(setcdr l '(4))

l

(setq a1 (hex-to-bitstring "ff"))

(setq b1 (hex-to-bitstring "f0"))

(setq c1 (make-undef-bitstring a b))

(setq a2 (hex-to-bitstring "ff"))

(setq b2 (hex-to-bitstring "f8"))

(setq c2 (make-undef-bitstring a b))

(setq cc c2)

(setq cu (make-set-bitstring c2))

(setq h (make-hash-table))

(puthash 'a a h)

(puthash 'b 2 h)

(puthash 'c 3 h)

(list (gethash 'c h) (gethash 'a h))