<commit_before>;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
;;;
;;; --- Device buffers.
;;;

(in-package :io.zeta-streams)

;;;-----------------------------------------------------------------------------
;;; Buffer Classes and Types
;;;-----------------------------------------------------------------------------

(defclass buffer ()
  ((synchronized :initarg :synchronized :reader synchronizedp)
   (input-iobuf :initarg :input-buffer :accessor input-iobuf-of)
   (output-iobuf :initarg :output-buffer :accessor output-iobuf-of))
  (:default-initargs :synchronized nil))

(defclass single-channel-buffer (single-channel-device buffer)
  ((last-io-op :initform nil :accessor last-io-op-of)))

(defclass dual-channel-buffer (dual-channel-device buffer) ())



;;;-----------------------------------------------------------------------------
;;; Buffer Generic Functions
;;;-----------------------------------------------------------------------------

(defgeneric buffer-clear-input (buffer))

(defgeneric buffer-clear-output (buffer))

(defgeneric buffer-fill-input (buffer &optional timeout))

(defgeneric buffer-flush-output (buffer &optional timeout))

;;; Internal functions

(defgeneric buffer-read-octets (buffer vector start end timeout))

(defgeneric buffer-write-octets (buffer vector start end timeout))

(defgeneric %buffer-clear-input (buffer))

(defgeneric %buffer-fill-input (buffer timeout))

(defgeneric %buffer-flush-output (buffer timeout))



;;;-----------------------------------------------------------------------------
;;; Helper macros
;;;-----------------------------------------------------------------------------

(defmacro with-synchronized-buffer ((buffer &optional direction) &body body)
  (with-gensyms (body-fun)
    (labels ((make-locks (body direction)
               (ecase direction
                 (:input
                  `(bt:with-lock-held ((iobuf-lock (input-iobuf-of ,buffer)))
                     ,body))
                 (:output
                  `(bt:with-lock-held ((iobuf-lock (output-iobuf-of ,buffer)))
                     ,body))
                 (:both
                  (make-locks (make-locks body :output) :input)))))
      `(flet ((,body-fun () ,@body))
         (if (synchronizedp ,buffer)
             ,(make-locks `(,body-fun) direction)
             (,body-fun))))))



;;;-----------------------------------------------------------------------------
;;; Buffer Constructors
;;;-----------------------------------------------------------------------------

(defmethod initialize-instance :after
    ((device single-channel-buffer) &key buffer buffer-size)
  (with-accessors ((input-iobuf input-iobuf-of)
                   (output-iobuf output-iobuf-of))
      device
    (check-type buffer (or null iobuf))
    (setf input-iobuf (or buffer (make-iobuf buffer-size))
          output-iobuf input-iobuf)))

(defmethod initialize-instance :after
    ((device dual-channel-buffer) &key input-buffer output-buffer
     input-buffer-size output-buffer-size)
  (with-accessors ((input-iobuf input-iobuf-of)
                   (output-iobuf output-iobuf-of))
      device
    (check-type input-buffer (or null iobuf))
    (check-type output-buffer (or null iobuf))
    (setf input-iobuf (or input-buffer (make-iobuf input-buffer-size)))
    (setf output-iobuf (or output-buffer (make-iobuf output-buffer-size)))))



;;;-----------------------------------------------------------------------------
;;; Buffer DEVICE-CLOSE
;;;-----------------------------------------------------------------------------

(defmethod device-close ((buffer single-channel-buffer) &optional abort)
  (with-accessors ((handle input-handle-of))
      buffer
    (with-synchronized-buffer (buffer :input)
      (unless (or abort (eql :read (last-io-op-of buffer)))
        (%buffer-flush-output buffer 0))
      (device-close handle)))
  (values buffer))

(defmethod device-close ((buffer buffer) &optional abort)
  (with-accessors ((input-handle input-handle-of buffer)
                   (output-handle output-handle-of buffer))
      buffer
    (with-synchronized-buffer (buffer :both)
      (unless abort
        (%buffer-flush-output buffer 0))
      (device-close input-handle)
      (device-close output-handle)))
  (values buffer))



;;;-----------------------------------------------------------------------------
;;; Buffer DEVICE-READ
;;;-----------------------------------------------------------------------------<commit_msg>Use :IO instead of :BOTH.<commit_after>;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
;;;
;;; --- Device buffers.
;;;

(in-package :io.zeta-streams)

;;;-----------------------------------------------------------------------------
;;; Buffer Classes and Types
;;;-----------------------------------------------------------------------------

(defclass buffer ()
  ((synchronized :initarg :synchronized :reader synchronizedp)
   (input-iobuf :initarg :input-buffer :accessor input-iobuf-of)
   (output-iobuf :initarg :output-buffer :accessor output-iobuf-of))
  (:default-initargs :synchronized nil))

(defclass single-channel-buffer (single-channel-device buffer)
  ((last-io-op :initform nil :accessor last-io-op-of)))

(defclass dual-channel-buffer (dual-channel-device buffer) ())



;;;-----------------------------------------------------------------------------
;;; Buffer Generic Functions
;;;-----------------------------------------------------------------------------

(defgeneric buffer-clear-input (buffer))

(defgeneric buffer-clear-output (buffer))

(defgeneric buffer-fill-input (buffer &optional timeout))

(defgeneric buffer-flush-output (buffer &optional timeout))

;;; Internal functions

(defgeneric buffer-read-octets (buffer vector start end timeout))

(defgeneric buffer-write-octets (buffer vector start end timeout))

(defgeneric %buffer-clear-input (buffer))

(defgeneric %buffer-fill-input (buffer timeout))

(defgeneric %buffer-flush-output (buffer timeout))



;;;-----------------------------------------------------------------------------
;;; Helper macros
;;;-----------------------------------------------------------------------------

(defmacro with-synchronized-buffer ((buffer &optional direction) &body body)
  (with-gensyms (body-fun)
    (labels ((make-locks (body direction)
               (ecase direction
                 (:input
                  `(bt:with-lock-held ((iobuf-lock (input-iobuf-of ,buffer)))
                     ,body))
                 (:output
                  `(bt:with-lock-held ((iobuf-lock (output-iobuf-of ,buffer)))
                     ,body))
                 (:io
                  (make-locks (make-locks body :output) :input)))))
      `(flet ((,body-fun () ,@body))
         (if (synchronizedp ,buffer)
             ,(make-locks `(,body-fun) direction)
             (,body-fun))))))



;;;-----------------------------------------------------------------------------
;;; Buffer Constructors
;;;-----------------------------------------------------------------------------

(defmethod initialize-instance :after
    ((device single-channel-buffer) &key buffer buffer-size)
  (with-accessors ((input-iobuf input-iobuf-of)
                   (output-iobuf output-iobuf-of))
      device
    (check-type buffer (or null iobuf))
    (setf input-iobuf (or buffer (make-iobuf buffer-size))
          output-iobuf input-iobuf)))

(defmethod initialize-instance :after
    ((device dual-channel-buffer) &key input-buffer output-buffer
     input-buffer-size output-buffer-size)
  (with-accessors ((input-iobuf input-iobuf-of)
                   (output-iobuf output-iobuf-of))
      device
    (check-type input-buffer (or null iobuf))
    (check-type output-buffer (or null iobuf))
    (setf input-iobuf (or input-buffer (make-iobuf input-buffer-size)))
    (setf output-iobuf (or output-buffer (make-iobuf output-buffer-size)))))



;;;-----------------------------------------------------------------------------
;;; Buffer DEVICE-CLOSE
;;;-----------------------------------------------------------------------------

(defmethod device-close ((buffer single-channel-buffer) &optional abort)
  (with-accessors ((handle input-handle-of))
      buffer
    (with-synchronized-buffer (buffer :input)
      (unless (or abort (eql :read (last-io-op-of buffer)))
        (%buffer-flush-output buffer 0))
      (device-close handle)))
  (values buffer))

(defmethod device-close ((buffer buffer) &optional abort)
  (with-accessors ((input-handle input-handle-of buffer)
                   (output-handle output-handle-of buffer))
      buffer
    (with-synchronized-buffer (buffer :io)
      (unless abort
        (%buffer-flush-output buffer 0))
      (device-close input-handle)
      (device-close output-handle)))
  (values buffer))



;;;-----------------------------------------------------------------------------
;;; Buffer DEVICE-READ
;;;-----------------------------------------------------------------------------
{'fraction_non_alphanumeric': 0.3239795918367347, 'fraction_numerical': 0.00044365572315882877, 'mean_word_length': 1.471765350877193, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, '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': '635674', 'n_tokens_mistral': 2373, 'n_tokens_neox': 2243, 'n_words': 534}