<commit_before>;;;; Copyright (c) 2019 <NAME> (<EMAIL>)
;;;; This code is licensed under the MIT license.

(in-package :mezzano.disk)

(defclass disk-mixin ()
  ((%writable-p   :initarg :writable-p      :accessor disk-writable-p)
   (%n-sectors    :initarg :n-sectors       :accessor disk-n-sectors)
   (%sector-size  :initarg :sector-size     :accessor disk-sector-size)))

(defclass disk-pt-mixin ()
  ((%pt-type     :initarg :pt-type         :accessor pt-type)
   (%disk-id     :initarg :disk-id         :accessor disk-id)
   (%first-lba   :initarg :pt-first-lba    :accessor pt-first-lba)
   (%last-lba    :initarg :pt-last-lba     :accessor pt-last-lba)))

(defclass disk-partition-mixin ()
  ((%disk             :initarg :disk             :accessor dp-disk)
   (%partition-num    :initarg :partition-num    :accessor dp-partition-num)
   (%partition-type   :initarg :partition-type   :accessor dp-partition-type)
   (%start-lba        :initarg :start-lba        :accessor dp-start-lba)
   (%size             :initarg :size             :accessor dp-size)))

;;======================================================================
;; Support functions
;;======================================================================

(defun aref-n-octets (buf idx length)
  (loop :for n :from idx :below (+ idx length)
        :for res := (aref buf n) :then (logior (ash res 8) (aref buf n))
        :finally (return res)))

(defun (setf aref-n-octets) (value buf idx length)
  (loop :for n :from idx :below (+ idx length)
        :for offset :downfrom (- (ash length 3) 8) :by 8
        :do (setf (aref buf n) (ldb (byte 8 offset) value))
        :finally (return value)))

(defmacro def-accessor (name offset size)
  (let ((acc-name (intern (concatenate 'string "GET-" (symbol-name name)))))
    `(progn
       (defun ,acc-name (buf &optional (base 0))
         (let ((idx (+ ,offset base)))
           ,(if (eql size 1)
                '(aref buf idx)
                `(aref-n-octets buf idx ,size))))
       (defun (setf ,acc-name) (value buf &optional (base 0))
         (let ((idx (+ ,offset base)))
           ,(if (eql size 1)
                '(setf (aref buf idx) value)
                `(setf (aref-n-octets buf idx ,size) value)))))))

;;======================================================================
;; GUID Partition Table Code (GPT)
;;======================================================================

;; Partition Table Header fields
(def-accessor :header-size     12 4)
(def-accessor :header-crc      16 4)
(def-accessor :first-lba       40 8)
(def-accessor :last-lba        48 8)
(def-accessor :disk-id         56 16)<commit_msg>Disk partition: Field accessor code changed to little endian.<commit_after>;;;; Copyright (c) 2019 <NAME> (<EMAIL>)
;;;; This code is licensed under the MIT license.

(in-package :mezzano.disk)

(defclass disk-mixin ()
  ((%writable-p   :initarg :writable-p      :accessor disk-writable-p)
   (%n-sectors    :initarg :n-sectors       :accessor disk-n-sectors)
   (%sector-size  :initarg :sector-size     :accessor disk-sector-size)))

(defclass disk-pt-mixin ()
  ((%pt-type     :initarg :pt-type         :accessor pt-type)
   (%disk-id     :initarg :disk-id         :accessor disk-id)
   (%first-lba   :initarg :pt-first-lba    :accessor pt-first-lba)
   (%last-lba    :initarg :pt-last-lba     :accessor pt-last-lba)))

(defclass disk-partition-mixin ()
  ((%disk             :initarg :disk             :accessor dp-disk)
   (%partition-num    :initarg :partition-num    :accessor dp-partition-num)
   (%partition-type   :initarg :partition-type   :accessor dp-partition-type)
   (%start-lba        :initarg :start-lba        :accessor dp-start-lba)
   (%size             :initarg :size             :accessor dp-size)))

;;======================================================================
;; Support functions
;;======================================================================

(defmacro def-accessor (name offset size)
  (let ((acc-name (intern (concatenate 'string "GET-" (symbol-name name)))))
    `(progn
       (defun ,acc-name (buf &optional (base 0))
         ,(case size
            (1 `(aref buf (+ ,offset base)))
            (2 `(sys::ub16ref/le buf (+ ,offset base)))
            (4 `(sys::ub32ref/le buf (+ ,offset base)))
            (8 `(sys::ub64ref/le buf (+ ,offset base)))
            (16 `(let ((idx (+ ,offset base)))
                   (logior
                    (sys::ub64ref/le buf idx)
                    (ash (sys::ub64ref/le buf (+ idx 8)) 64))))
            (T (error "def-accessor: invalid field ~A~%" name ))))
       (defun (setf ,acc-name) (value buf &optional (base 0))
         ,(case size
            (1 `(setf (aref buf (+ ,offset base)) value))
            (2 `(setf (sys::ub16ref/le buf (+ ,offset base)) value))
            (4 `(setf (sys::ub32ref/le buf (+ ,offset base)) value))
            (8 `(setf (sys::ub64ref/le buf (+ ,offset base)) value))
            (16 `(let ((idx (+ ,offset base)))
                   (setf
                    (sys::ub64ref/le buf idx) value
                    (sys::ub64ref/le buf (+ idx 8)) (ldb (byte 64 64) value)))))
         value))))

;;======================================================================
;; GUID Partition Table Code (GPT)
;;======================================================================

;; Partition Table Header fields
(def-accessor :header-size     12 4)
(def-accessor :header-crc      16 4)
(def-accessor :first-lba       40 8)
(def-accessor :last-lba        48 8)
(def-accessor :disk-id         56 16)
{'fraction_non_alphanumeric': 0.2424350940017905, 'fraction_numerical': 0.01629364368845121, 'mean_word_length': 2.6178756476683938, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 7, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1733824', 'n_tokens_mistral': 1853, 'n_tokens_neox': 1723, 'n_words': 483}