Fix dumping for tables without uid

diff --git a/xdump.lisp b/xdump.lisp
index 5d68b1d4aa3bc54bbe5c58f54e360b964720c223..624eb6929173f16bed0365b28ca5803af7649fb9 100644 (file)
--- a/xdump.lisp
+++ b/xdump.lisp
@@ -17,14 +17,15 @@
    (entries :accessor table-entries :initform (make-array 8
                                                          :fill-pointer 8
                                                          :adjustable t
-                                                         :initial-element nil))))
+                                                         :initial-element nil))
+   (has-uid-p :accessor has-uid-p :initarg :has-uid-p)))
 
 ;(defclass empire-table ()
 ;  (()))
 
-(defvar *meta-by-index* (make-array 50 :adjustable t :initial-element nil))
-(defvar *table-by-index* (make-array 50 :adjustable t :initial-element nil))
-(defvar *index-by-name* (make-hash-table :size 50 :test 'equal))
+(defvar *meta-by-index* (make-array 128 :adjustable t :initial-element nil))
+(defvar *table-by-index* (make-array 128 :adjustable t :initial-element nil))
+(defvar *index-by-name* (make-hash-table :size 128 :test 'equal))
 (defvar *meta-index* (make-array 5) "meta slot symbol by meta table column index")
 (defvar *meta-meta* (make-array 5))
 
@@ -82,16 +83,23 @@
       (let ((table-index (if (string= "table" name)
                             ; voodoo: the first column of the table of tables is the uid
                             (elt (aref entry-buffer 0) 4)
-                            (gethash name *index-by-name*))))
+                            (gethash name *index-by-name*)))
+           (has-uid-p nil))
        (setf (aref *meta-by-index* table-index) meta-table)
 
+       ;; determine if this table has a uid column
+       (if (and (string= "uid" (elt (aref entry-buffer 0) 0))
+                (eql (elt (aref entry-buffer 0) 4) table-index))
+           (setf has-uid-p t))
+
        ;; create xdump-table instance and entry class
        (let* ((class-name (string-upcase (format nil "~a-table-entry" name)))
               (package (find-package "XDUMP-DATA"))
               (table-instance (make-instance 'xdump-table
                                              :name name
                                              :index table-index
-                                             :entry-class (intern class-name package)))
+                                             :entry-class (intern class-name package)
+                                             :has-uid-p has-uid-p))
               (slot-list (loop for entry across entry-buffer
                             collect (car entry))))
          (setf (aref *table-by-index* table-index) table-instance)
@@ -103,6 +111,22 @@
                                  (list (intern slot-name package) :accessor (intern accessor-name package))))
                            slot-list))))))))
 
+(defun entry-from-vector (class meta-table entry-vector)
+  (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"))))
+          (setf (slot-value new-entry slot) item)))
+    new-entry))
+
+(defmethod table-entry-insert-at ((table xdump-table) entry index)
+                                       ; extend array if necessary
+  (let ((entries (table-entries table)))
+    (unless (> (fill-pointer entries) index)
+      (adjust-array entries (* 2 index) :fill-pointer index :initial-element nil))
+    (setf (aref entries index) entry)))
+
 (defun table-finalizer (parser)
   (with-slots (entry-buffer name timestamp) parser
     (if (string= name "table") ; special magic: prefill index-by-name
@@ -111,19 +135,14 @@
     (format t "table-finalizer: ~a~%" name)
     (let* ((table-index (gethash name *index-by-name*))
           (meta-table (aref *meta-by-index* table-index))
-          (table (aref *table-by-index* table-index)))
+          (table (aref *table-by-index* table-index))
+          (has-uid-p (has-uid-p table)))
       (loop for entry across entry-buffer do
-          (let ((e (make-instance (table-entry-class table)))
-                (index (first entry))
-                (entries (table-entries table)))
-            ; extend array if necessary
-            (unless (> (fill-pointer entries) index)
-              (adjust-array entries (* 2 index) :fill-pointer index :initial-element nil))
-            (setf (aref entries index) e)
-            (loop
-               for item in entry
-               for column across meta-table do
-                 (setf (slot-value e (find-symbol (string-upcase (meta-name column)) (find-package "XDUMP-DATA"))) item))))
+          (let ((entry-instance (entry-from-vector (table-entry-class table) meta-table entry)))
+            (if has-uid-p
+                (let ((index (first entry)))
+                  (table-entry-insert-at table entry-instance index))
+                (vector-push-extend entry-instance (table-entries table)))))
       (setf (table-last-update table) timestamp))))
 
 (defmethod finish-table ((parser xdump-parser) number-of-records)