ildb: skip route locks and signal names

interlocking.lisp

@@ -4,7 +4,6 @@
   (:export :load-ildb
 	   :ars-rule :ars-rule-p :ars-rule-type :ars-rule-match :ars-rule-invertp
 	   :tcbside :make-tcbside :tcbside-p :tcbside-pos :tcbside-side
-	   :path-entry :path-entry-p :path-entry-next :path-entry-locks
 	   :route :route-p :route-name :route-ars-rules :route-path
 	   :tcbdata :tcbdata-p :tcbdata-signal-pos :tcbdata-signal-name :tcbdata-routes
 	   :tcb :tcb-p :tcb-pos :tcb-side-a :tcb-side-b
@@ -47,30 +46,10 @@
   (with-accessors ((p tcbside-pos) (side tcbside-side)) obj
     (json:encode-json (list (cons "p" p) (cons "s" side)))))
 
-(defstruct path-entry
-  (next nil :type (or null tcbside))
-  (locks (aux:adj-vector-of '(cons aux:v3d string)) :type (vector (cons aux:v3d string))))
-
-(defmethod print-object ((obj path-entry) s)
-  (with-accessors ((next path-entry-next) (locks path-entry-locks)) obj
-    (print-unreadable-object (obj s)
-      (format s "TO ~a" (or next "EOI"))
-      (loop for (pos . st) across locks do
-	   (format s " ~_LOCKING ~a TO ~s" pos st)))))
-
-(defmethod json:encode-json ((obj path-entry) &optional json:*json-output*)
-  (with-accessors ((next path-entry-next) (locks path-entry-locks)) obj
-    (json:encode-json-alist (list (cons "next" next)
-				  (cons "locks" (loop with ht = (make-hash-table)
-						   for i across locks
-						   for (pos . st) = i
-						   do (setf (gethash pos ht) st)
-						   finally (return ht)))))))
-
 (defstruct route
   (name "" :type string)
   (ars-rules (aux:adj-vector-of 'ars-rule) :type (or (eql t) (vector ars-rule)))
-  (path (aux:adj-vector-of 'path-entry) :type (vector path-entry)))
+  (path (aux:adj-vector-of '(or tcbside null)) :type (vector (or tcbside null))))
 
 (defmethod print-object ((obj route) s)
   (with-accessors ((name route-name) (ars route-ars-rules) (path route-path)) obj
@@ -92,27 +71,20 @@
 (defstruct tcbdata
   (ts nil :type (or string null))
   (signal-pos nil :type (or aux:v3d null))
-  (signal-name nil :type (or string null))
   (routes (aux:adj-vector-of 'route) :type (vector route)))
 
 (defmethod print-object ((obj tcbdata) s)
-  (with-accessors ((ts tcbdata-ts) (spos tcbdata-signal-pos) (sname tcbdata-signal-name)
+  (with-accessors ((ts tcbdata-ts) (spos tcbdata-signal-pos) (routelist tcbdata-routes)) obj
-		   (routelist tcbdata-routes))
-      obj
     (print-unreadable-object (obj s)
-      (format s "~:i~:[EOI~;~:*IN SECTION ~a~]~:[~*~; ~:_~:*SIGNALING AT ~a NAMED ~s~]"
+      (format s "~:i~:[EOI~;~:*IN SECTION ~a~]~@[ SIGNALING AT ~a~]" ts spos)
-	      ts spos sname)
       (when (> (length routelist) 0)
 	(pprint-indent :block 1 s)
 	(loop for i across routelist do (format s " ~_~a" i))))))
 
 (defmethod json:encode-json ((obj tcbdata) &optional json:*json-output*)
-  (with-accessors ((ts tcbdata-ts) (spos tcbdata-signal-pos) (sname tcbdata-signal-name)
+  (with-accessors ((ts tcbdata-ts) (spos tcbdata-signal-pos) (routelist tcbdata-routes)) obj
-		   (routelist tcbdata-routes))
-      obj
     (json:encode-json (list (cons "in_section" ts)
 			    (cons "signal_pos" spos)
-			    (cons "signal_name" sname)
 			    (cons "routes" routelist)))))
 
 (defstruct tcb
@@ -173,11 +145,11 @@
 	 finally (return ,r)))))
 
 (defmacro route-next (route)
-  (alexandria:with-gensyms (p)
+  (alexandria:with-gensyms (p l)
     (alexandria:once-only
      (route)
-     `(let ((,p (route-path ,route)))
+     `(let* ((,p (route-path ,route)) (,l (length ,p)))
-	(path-entry-next (aref ,p (1- (length ,p))))))))
+	(if (> ,l 0) (aref ,p (1- ,l)))))))
 
 (defmacro find-tcb-at (ildb pos)
   `(gethash ,pos (ildb-tcbs ,ildb)))
@@ -194,14 +166,12 @@
 	finally (return ,locks))))
 
 (defmacro parse-path (pathht)
-  (alexandria:with-gensyms (ent next p s locks)
+  (alexandria:with-gensyms (ent next p s)
-    `(aux:collect-integrally-indexed-non-nil
+    `(aux:collect-integrally-indexed-entries
-      ((vector path-entry) ,pathht nil ,ent 1)
+      ((vector (or tcbside null)) ,pathht nil ,ent 1)
-      (aux:with-entries-in-hash-table (,ent (,next "next") (,locks "locks"))
+      (let ((,next (gethash "next" ,ent)))
-	(aux:with-entries-in-hash-table (,next (,p "p") (,s "s"))
+	(if ,next (aux:with-entries-in-hash-table (,next (,p "p") (,s "s"))
-	  (make-path-entry :next (make-tcbside :pos (aux:hash-table-to-v3d ,p)
+		    (make-tcbside :pos (aux:hash-table-to-v3d ,p) :side (1- ,s))))))))
-					       :side (1- ,s))
-			   :locks (parse-route-locks ,locks)))))))
 
 (defmacro parse-ars-rules (rulesht)
   (alexandria:with-gensyms (ent neg ln rc ftype match)
@@ -233,16 +203,14 @@
       (parse-route ,ent))))
 
 (defmacro read-tcb-side (side)
-  (alexandria:with-gensyms (ts spos sname routes)
+  (alexandria:with-gensyms (ts spos routes)
     (alexandria:once-only
      (side)
      `(let ((,ts (gethash "ts_id" ,side nil))
 	    (,spos (ignore-errors (aux:hash-table-to-v3d (gethash "signal" ,side))))
-	    (,sname (gethash "signal_name" ,side))
 	    (,routes (read-routes (gethash "routes" ,side (make-hash-table)))))
 	(make-tcbdata :ts ,ts
 		      :signal-pos ,spos
-		      :signal-name ,sname
 		      :routes ,routes)))))
 
 (defun load-ildb (fn)