Adapt getters to parser local dump location. Implement sym-by-value.

diff --git a/xdump.lisp b/xdump.lisp
index eaa8ce125e9c03a0d4945835ebfb0b947a67733f..3114323a86bd0f40f29b532f89e0ec3ad9499575 100644 (file)
--- a/xdump.lisp
+++ b/xdump.lisp
@@ -21,14 +21,6 @@
                                  :initial-element nil))
    (has-uid-p :accessor has-uid-p :initarg :has-uid-p)))
 
                                  :initial-element nil))
    (has-uid-p :accessor has-uid-p :initarg :has-uid-p)))
 

-(defun get-table (table-name)
-  (let* ((table-index (gethash table-name *index-by-name*))
-        (table (aref *table-by-index* table-index)))
-    table))
-
-(defun get-table-entry (table-name index)
-    (aref (table-entries (get-table table-name)) index))
-

 (defclass xdump-parser ()
   ((line-parser :accessor line-parser :initform nil)
    (entry-buffer :accessor entry-buffer
 (defclass xdump-parser ()
   ((line-parser :accessor line-parser :initform nil)
    (entry-buffer :accessor entry-buffer


@@ -52,6 +44,9 @@
    (meta-index :accessor meta-index :initform (make-array 5))
    (meta-meta :accessor meta-meta :initform (make-array 5))))
 
    (meta-index :accessor meta-index :initform (make-array 5))
    (meta-meta :accessor meta-meta :initform (make-array 5))))
 

+(defgeneric get-table (xdump-parser table-name))
+(defgeneric get-table-entry (xdump-parser table-name index))
+(defgeneric sym-by-value (xdump-parser table-name value))

 (defgeneric finish-table (xdump-parser number-of-records))
 (defgeneric parse-entry (xdump-parser line))
 (defgeneric parse-meta (xdump-parser name timestamp))
 (defgeneric finish-table (xdump-parser number-of-records))
 (defgeneric parse-entry (xdump-parser line))
 (defgeneric parse-meta (xdump-parser name timestamp))


@@ -60,6 +55,24 @@
 (defgeneric parse-line (xdump-parser line))
 (defgeneric reset-table-parser (xdump-parser))
 
 (defgeneric parse-line (xdump-parser line))
 (defgeneric reset-table-parser (xdump-parser))
 

+(defmethod get-table ((parser xdump-parser) table-name)
+  (with-slots (index-by-name table-by-index) parser
+    (let* ((table-index (gethash table-name index-by-name))
+          (table (aref table-by-index table-index)))
+      table)))
+
+(defmethod get-table-entry ((parser xdump-parser) table-name index)
+    (aref (table-entries (get-table table-name)) index))
+
+(defmethod sym-by-value ((parser xdump-parser) table-name value)
+  (with-slots (table-classes-package) parser
+    (let ((value-slot (find-symbol "VALUE" table-classes-package))
+         (name-slot (find-symbol "NAME" table-classes-package))
+         (meta-type-table (get-table parser table-name)))
+      (loop for entry across (table-entries meta-type-table)
+          if (= (slot-value entry value-slot) value)
+          return (slot-value entry name-slot)))))
+

 (defmethod reset-table-parser ((parser xdump-parser))
   (with-slots (line-parser entry-buffer entry-index finalizer name timestamp)
       parser
 (defmethod reset-table-parser ((parser xdump-parser))
   (with-slots (line-parser entry-buffer entry-index finalizer name timestamp)
       parser


@@ -142,13 +155,14 @@
                                           slot-list)))))))
 
 (defun entry-from-vector (class meta-table entry-vector table-classes-package)
                                           slot-list)))))))
 
 (defun entry-from-vector (class meta-table entry-vector table-classes-package)

-  (let ((new-entry (make-instance class)))
+  (let ((new-entry (make-instance class))
+       (i 0))

     (loop
     (loop

-       for item in entry-vector

        for column across meta-table do
         (let ((slot (find-symbol (string-upcase (meta-name column))
                                  table-classes-package)))
        for column across meta-table do
         (let ((slot (find-symbol (string-upcase (meta-name column))
                                  table-classes-package)))

-          (setf (slot-value new-entry slot) item)))
+          (setf (slot-value new-entry slot) (nth i entry-vector))
+          (incf i)))

     new-entry))
 
 (defmethod table-entry-insert-at ((table xdump-table) entry index)
     new-entry))
 
 (defmethod table-entry-insert-at ((table xdump-table) entry index)