From c133c8b585f9a995253cf90f8c8ee84685796193 Mon Sep 17 00:00:00 2001 From: Gerd Flaig Date: Wed, 9 Feb 2011 23:55:24 +0100 Subject: [PATCH] Put table entry classes in seperate packages, one per xdump parser --- xdump.lisp | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/xdump.lisp b/xdump.lisp index 8e099d8..eaa8ce1 100644 --- a/xdump.lisp +++ b/xdump.lisp @@ -45,6 +45,8 @@ :initform (make-array 128 :adjustable t :initial-element nil)) + (table-classes-package :accessor table-classes-package + :initform (make-package (gensym))) (index-by-name :accessor index-by-name :initform (make-hash-table :size 128 :test 'equal)) (meta-index :accessor meta-index :initform (make-array 5)) @@ -125,7 +127,7 @@ ;; create xdump-table instance and entry class (let* ((class-name (string-upcase (format nil "~a-table-entry" name))) - (package (find-package "XDUMP-DATA")) + (package (table-classes-package parser)) (table-instance (make-instance 'xdump-table :name name :index table-index @@ -139,13 +141,13 @@ (eval (table-entry-defclass-form name class-name package slot-list))))))) -(defun entry-from-vector (class meta-table entry-vector) +(defun entry-from-vector (class meta-table entry-vector table-classes-package) (let ((new-entry (make-instance class))) (loop for item in entry-vector for column across meta-table do (let ((slot (find-symbol (string-upcase (meta-name column)) - (find-package "XDUMP-DATA")))) + table-classes-package))) (setf (slot-value new-entry slot) item))) new-entry)) @@ -160,7 +162,7 @@ (defun table-finalizer (parser) (with-slots (entry-buffer name timestamp index-by-name meta-by-index - table-by-index) parser + table-by-index table-classes-package) parser (if (string= name "table") ; special magic: prefill index-by-name (loop for entry across entry-buffer do (setf (gethash (second entry) index-by-name) (first entry)))) @@ -172,7 +174,8 @@ (loop for entry across entry-buffer do (let ((entry-instance (entry-from-vector (table-entry-class table) meta-table - entry))) + entry + table-classes-package))) (if has-uid-p (let ((index (first entry))) (table-entry-insert-at table entry-instance index)) -- 2.43.0