;;;
;;; resource-db.lisp
;;;
;;; Resource database
;;;
;;; Copyright (C) 2005, Alastair Bridgewater
;;;

(in-package :clxs)

(defconstant +resource-mask+ #x3ffff)

(defvar *resource-client-table* nil)
(defvar *resource-range-table* nil)
(defvar *next-resource-range* 1)

(defun reset-resource-database ()
  "Purpose: This function is called to reset the Resource
Database to its initial state. That is, it destroys any and
all existing resources and clears the table of assigned
ranges."
  ;; Create database tables.
  (setf *resource-client-table* (make-array 4096 :initial-element nil))
  (setf *resource-range-table* (make-array 4096 :initial-element nil))
  (setf *next-resource-range* 1)

  ;; Initialize server resource range.
  (setf (aref *resource-range-table* 0) (make-hash-table))
  (setf (aref *resource-client-table* 0) :server)
  nil)

(defun find-free-resource-range ()
  "Find the next free resource range, or NIL if no range is free.
Starts from *next-resource-range* and wraps when reaches the end
of the range space, skipping range 0."
  (dotimes (i 4096)
    (let ((range (logand 4095 (+ *next-resource-range* i))))
      (when (and (not (zerop range))
		 (not (aref *resource-range-table* range)))
	(setf *next-resource-range* (1+ range))
	(return range)))))

(defun assign-resource-range (client)
  "Purpose: Assigns a resource range to a newly-connected
client. Sets the client-state-resource-base and
client-state-resource-mask on the client, and associates
the client with said resource range."
  (declare (type client-state client))
  (let ((resource-range (find-free-resource-range)))
    (if (eq resource-range nil)
	(values nil)
	(progn
	  (setf (aref *resource-client-table* resource-range) client)
	  (setf (aref *resource-range-table* resource-range) (make-hash-table))
	  (setf (slot-value client 'resource-id-base)
		(ash resource-range 18))
	  (setf (slot-value client 'resource-id-mask)
		+resource-mask+)
	  (values t)))))

(defun x-resource (resource-id)
  ;; FIXME: We should return NIL if someone passes an out-of-range resource-id.
  (let* ((resource-range (ash resource-id -18))
	 (resource-index (logand resource-id +resource-mask+))
	 (resource-hash (aref *resource-range-table* resource-range)))
    (and resource-hash (gethash resource-index resource-hash nil))))

(defun (setf x-resource) (object resource-id)
  (let* ((resource-range (ash resource-id -18))
	 (resource-index (logand resource-id +resource-mask+))
	 (resource-hash-table (aref *resource-range-table* resource-range)))
    (setf (gethash resource-index resource-hash-table) object)))

(defun destroy-resources-for-range (resource-id)
  (declare (ignorable resource-id))
  ;; FIXME: Implement.
  )

(defun resource-client (resource-id)
  (let ((resource-range (ash resource-id -18)))
    (aref *resource-client-table* resource-range)))

;;; EOF