yw05
/
ywatds
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Optimize track database memory usage

master
y5nw 2021-08-23 17:33:33 +02:00
parent 031d94fb4f
commit 1728978923
4 changed files with 80 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
dataserver.lisp
View File

@ -11,6 +11,7 @@
;; Command-line arguments ;; Command-line arguments
(defparameter *debugp* nil) (defparameter *debugp* nil)
(defparameter *gcp* nil)
(defparameter *world-path* nil) (defparameter *world-path* nil)
;; Note: do NOT change *server-port* and *server* at debug time ;; Note: do NOT change *server-port* and *server* at debug time
(defparameter *server-port* nil) (defparameter *server-port* nil)
@ -32,6 +33,8 @@
(tracks:import-data *nodedb*) (tracks:import-data *nodedb*)
(psetf *trackdb* ,tdb *trackdb-temp* ,tdbtemp))) (psetf *trackdb* ,tdb *trackdb-temp* ,tdbtemp)))
(setf *trackdb* (tracks:import-data (ndb:import-data (savefilepath "ndb4.ls"))))) (setf *trackdb* (tracks:import-data (ndb:import-data (savefilepath "ndb4.ls")))))
(when *gcp*
#+sbcl(sb-ext:gc :full t))
(hunchentoot:acceptor-log-message *server* :info "Database updated")))) (hunchentoot:acceptor-log-message *server* :info "Database updated"))))
(defmacro mainloop () (defmacro mainloop ()
@ -42,6 +45,7 @@
(setf *world-path* (ensure-world-path (car argv))) (setf *world-path* (ensure-world-path (car argv)))
(setf *server-port* (coerce (parse-integer (cadr argv)) '(integer 0 65535))) (setf *server-port* (coerce (parse-integer (cadr argv)) '(integer 0 65535)))
(setf *debugp* (member "--debug" (cddr argv) :test #'string=)) (setf *debugp* (member "--debug" (cddr argv) :test #'string=))
(setf *gcp* (member "--force-periodic-gc" (cddr argv) :test #'string=))
(setf *server* (make-instance 'easy-routes:routes-acceptor :port *server-port*)) (setf *server* (make-instance 'easy-routes:routes-acceptor :port *server-port*))
(register-routes) (register-routes)
(register-debugging-routes) (register-debugging-routes)
@ -156,6 +160,7 @@
(defun start-server () (defun start-server ()
(tracks:init-tracks) (tracks:init-tracks)
(load-data)
(hunchentoot:start *server*) (hunchentoot:start *server*)
;; loop until an error occurs ;; loop until an error occurs
(if *debugp* (mainloop) (handler-case (mainloop) (if *debugp* (mainloop) (handler-case (mainloop)

72
tracks/conns.lisp
View File

@ -1,5 +1,8 @@
(in-package :tracks) (in-package :tracks)
(defparameter *dir-shared* nil)
(defparameter *conns-shared* nil)
(defstruct trackside (defstruct trackside
(:pos (error "no coordinates specified") :type aux:v3d) (:pos (error "no coordinates specified") :type aux:v3d)
(:side (error "no side specified") :type (integer 0 15))) (:side (error "no side specified") :type (integer 0 15)))
@ -34,46 +37,69 @@
(print-unreadable-object (obj s) (print-unreadable-object (obj s)
(format s "FROM ~a TO ~a" (conns-from obj) (conns-to obj)))) (format s "FROM ~a TO ~a" (conns-from obj) (conns-to obj))))
(defmacro dir (c &optional r) (defun init-shared-dirs ()
`(make-dir :c (or ,c 0) :r (or ,r 0))) (setf *dir-shared* (make-array 32 :element-type 'dir :adjustable nil :initial-contents
(loop for i from 0 to 31 collect
(make-dir :c (ash i -1) :r (mod i 2)))))
(setf *conns-shared* (coerce (loop for i from 0 to 1023 collect
(make-conns :from (aref *dir-shared* (ash i -5))
:to (aref *dir-shared* (mod i 32))))
'(vector conns 1024))))
(defmacro conns (c1 c2 &optional r1 r2) (defmacro dir (c &optional r shared)
`(make-conns :from (dir ,c1 ,r1) :to (dir ,c2 ,r2))) (alexandria:with-gensyms (cc rc)
`(let ((,cc (the (integer 0 15) ,c)) (,rc (the (integer 0 1) (or ,r 1))))
(if ,shared (aref *dir-shared* (+ (* 2 ,cc) ,rc))
(make-dir :c ,cc :r ,rc)))))
(defmacro conns-t ((c1 &body cb) (&optional r1 &body rb)) (defmacro conns (c1 c2 &optional r1 r2 shared)
(alexandria:with-gensyms (cf ct rf rt)
`(let ((,cf (the (integer 0 15) ,c1)) (,ct (the (integer 0 15) ,c2))
(,rf (the (integer 0 1) (or ,r1 0))) (,rt (the (integer 0 1) (or ,r2 0))))
(if ,shared (aref *conns-shared* (+ (ash ,cf 6) (ash ,rf 5) (ash ,ct 1) ,rt))
(make-conns :from (dir ,c1 ,r1) :to (dir ,c2 ,r2))))))
(defmacro dirs->conns (from to &optional shared)
(alexandria:once-only
(from to)
`(if ,shared (conns (dir-c ,from) (dir-c ,to) (dir-r ,from) (dir-r ,to) t)
(make-conns :from ,from :to ,to))))
(defmacro conns-t ((c1 &body cb) (&optional r1 &body rb) &optional shared)
``(,,@(loop for c in cb and ri = rb then (cdr ri) for r = (car ri) ``(,,@(loop for c in cb and ri = rb then (cdr ri) for r = (car ri)
collect `(conns ,c1 ,c ,r1 ,r)))) collect `(conns ,c1 ,c ,r1 ,r ,shared))))
(defmacro conns-x ((&body cb) (&body rb)) (defmacro conns-x ((&body cb) (&body rb) &optional shared)
``(,,@(loop for (c1 c2) on cb by #'cddr and r = rb then (cddr rb) ``(,,@(loop for (c1 c2) on cb by #'cddr and r = rb then (cddr rb)
for r1 = (car r) and r2 = (cadr r) for r1 = (car r) and r2 = (cadr r)
collect `(conns ,c1 ,c2 ,r1 ,r2)))) collect `(conns ,c1 ,c2 ,r1 ,r2 ,shared))))
(defmacro adjust-dir (dir diff) (defmacro adjust-dir (dir diff &optional shared)
(alexandria:once-only (alexandria:once-only
(dir) (dir)
`(dir (mod (+ 16 (or ,diff 0) (dir-c ,dir)) 16) (dir-r ,dir)))) `(dir (mod (+ 16 (or ,diff 0) (dir-c ,dir)) 16) (dir-r ,dir) ,shared)))
(defmacro adjust-conns (conns diff) (defmacro adjust-conns (conns diff &optional shared)
(alexandria:once-only (alexandria:once-only
(conns diff) (conns diff shared)
`(make-conns :from (adjust-dir (conns-from ,conns) ,diff) `(dirs->conns (adjust-dir (conns-from ,conns) ,diff ,shared)
:to (adjust-dir (conns-to ,conns) ,diff)))) (adjust-dir (conns-to ,conns) ,diff ,shared)
,shared)))
(defmacro adjust-conns-list (clist diff) (defmacro adjust-conns-list (clist diff &optional shared)
(alexandria:with-gensyms (i) (alexandria:with-gensyms (i)
(alexandria:once-only (alexandria:once-only
(diff) (diff shared)
`(loop for ,i in ,clist collect (adjust-conns ,i ,diff))))) `(loop for ,i in ,clist collect (adjust-conns ,i ,diff ,shared)))))
(defmacro adjust-dir-with-param2 (dir param2) (defmacro adjust-dir-with-param2 (dir param2 &optional shared)
`(adjust-dir ,dir (* 4 ,param2))) `(adjust-dir ,dir (* 4 ,param2) ,shared))
(defmacro adjust-conns-with-param2 (conns param2) (defmacro adjust-conns-with-param2 (conns param2 &optional shared)
`(adjust-conns ,conns (* 4 ,param2))) `(adjust-conns ,conns (* 4 ,param2) ,shared))
(defmacro adjust-conns-list-with-param2 (clist param2) (defmacro adjust-conns-list-with-param2 (clist param2 &optional shared)
`(adjust-conns-list ,clist (* 4 ,param2))) `(adjust-conns-list ,clist (* 4 ,param2) ,shared))
(defmacro apply-dir-to-v3d (pos dir) (defmacro apply-dir-to-v3d (pos dir)
(alexandria:with-gensyms (h) (alexandria:with-gensyms (h)

2
tracks/database.lisp
View File

@ -77,7 +77,7 @@
(ndb:loopdb (ndb:loopdb
(ndb pos node param2) (ndb pos node param2)
(alexandria:when-let ((clist (gethash node *track->conns*))) (alexandria:when-let ((clist (gethash node *track->conns*)))
(setf (gethash pos tmpdb) (adjust-conns-list-with-param2 clist param2)))) (setf (gethash pos tmpdb) (adjust-conns-list-with-param2 clist param2 t))))
(loop for pos being the hash-keys of tmpdb using (hash-value clist) (loop for pos being the hash-keys of tmpdb using (hash-value clist)
for dirs = (conns-list-dirs clist) for dirs = (conns-list-dirs clist)
for connects = (make-empty-connects) do for connects = (make-empty-connects) do

49
tracks/registration.lisp
View File

@ -13,7 +13,7 @@
(names conns) (names conns)
`(loop for ,i = 0 then (1+ ,i) for ,s in `("" "_30" "_45" "_60") `(loop for ,i = 0 then (1+ ,i) for ,s in `("" "_30" "_45" "_60")
for ,n = (loop for ,j in ,names collect (concatenate 'string ,j ,s)) for ,n = (loop for ,j in ,names collect (concatenate 'string ,j ,s))
do (register-tracks ,n (adjust-conns-list ,conns ,i)))))) do (register-tracks ,n (adjust-conns-list ,conns ,i t))))))
(defmacro prefix-names (prefix &body names) (defmacro prefix-names (prefix &body names)
(alexandria:once-only (alexandria:once-only
@ -35,59 +35,60 @@
(defmacro register-default-tracks (prefix) (defmacro register-default-tracks (prefix)
`(register-rotatable-track-with-preset `(register-rotatable-track-with-preset
,prefix ,prefix
(("st") (conns-t (0 8) ())) (("st") (conns-t (0 8) () t))
(("cr") (conns-t (0 7) ())) (("cr") (conns-t (0 7) () t))
(("swlst" "swlcr") (conns-t (0 8 7) ())) (("swlst" "swlcr") (conns-t (0 8 7) () t))
(("swrst" "swrcr") (conns-t (0 8 9) ())))) (("swrst" "swrcr") (conns-t (0 8 9) () t))))
(defmacro register-y-turnout-tracks (prefix) (defmacro register-y-turnout-tracks (prefix)
`(register-rotatable-track-with-preset `(register-rotatable-track-with-preset
,prefix ,prefix
(("l" "r") (conns-t (0 7 9) ())))) (("l" "r") (conns-t (0 7 9) () t))))
(defmacro register-3way-turnout-tracks (prefix) (defmacro register-3way-turnout-tracks (prefix)
`(register-rotatable-track-with-preset `(register-rotatable-track-with-preset
,prefix ,prefix
(("l" "s" "r") (conns-t (0 7 8 9) ())))) (("l" "s" "r") (conns-t (0 7 8 9) () t))))
(defmacro register-slope-tracks (prefix) (defmacro register-slope-tracks (prefix)
`(register-rotatable-track-with-preset `(register-rotatable-track-with-preset
,prefix ,prefix
(("vst1" "vst31" "vst32") (conns-t (8 0) (0 0))) (("vst1" "vst31" "vst32") (conns-t (8 0) (0 0) t))
(("vst2" "vst33") (conns-t (8 0) (0 1))))) (("vst2" "vst33") (conns-t (8 0) (0 1) t))))
(defmacro register-straightonly-tracks (prefix) (defmacro register-straightonly-tracks (prefix)
`(register-rotatable-track-with-preset `(register-rotatable-track-with-preset
,prefix ,prefix
(("st") (conns-t (0 8) ())))) (("st") (conns-t (0 8) () t))))
(defmacro register-perp-xing-tracks (prefix) (defmacro register-perp-xing-tracks (prefix)
`(register-rotatable-track-with-preset `(register-rotatable-track-with-preset
,prefix ,prefix
(("st") (conns-x (0 8 4 12) ())))) (("st") (conns-x (0 8 4 12) () t))))
(defmacro register-90+x-xing-tracks (prefix) (defmacro register-90+x-xing-tracks (prefix)
`(register-track-with-preset `(register-track-with-preset
,prefix ,prefix
(("30l") (conns-x (0 8 1 9) ())) (("30l") (conns-x (0 8 1 9) () t))
(("45l") (conns-x (0 8 2 10) ())) (("45l") (conns-x (0 8 2 10) () t))
(("60l") (conns-x (0 8 3 11) ())) (("60l") (conns-x (0 8 3 11) () t))
(("60r") (conns-x (0 8 5 13) ())) (("60r") (conns-x (0 8 5 13) () t))
(("45r") (conns-x (0 8 6 14) ())) (("45r") (conns-x (0 8 6 14) () t))
(("30r") (conns-x (0 8 7 15) ())))) (("30r") (conns-x (0 8 7 15) () t))))
(defmacro register-diag-xing-tracks (prefix) (defmacro register-diag-xing-tracks (prefix)
`(register-track-with-preset `(register-track-with-preset
,prefix ,prefix
(("30l45r") (conns-x (1 9 6 14) ())) (("30l45r") (conns-x (1 9 6 14) () t))
(("60l30l") (conns-x (3 11 1 9) ())) (("60l30l") (conns-x (3 11 1 9) () t))
(("60l45r") (conns-x (3 11 6 14) ())) (("60l45r") (conns-x (3 11 6 14) () t))
(("60l60r") (conns-x (3 11 5 13) ())) (("60l60r") (conns-x (3 11 5 13) () t))
(("60r45l") (conns-x (5 13 2 10) ())) (("60r45l") (conns-x (5 13 2 10) () t))
(("60r30r") (conns-x (5 13 7 15) ())) (("60r30r") (conns-x (5 13 7 15) () t))
(("30r45l") (conns-x (7 15 2 10) ())))) (("30r45l") (conns-x (7 15 2 10) () t))))
(defun init-tracks () (defun init-tracks ()
(init-shared-dirs)
(setf *track->conns* (make-hash-table :test #'equal)) (setf *track->conns* (make-hash-table :test #'equal))
(register-default-tracks "advtrains:dtrack") (register-default-tracks "advtrains:dtrack")
(register-y-turnout-tracks "advtrains:dtrack_sy") (register-y-turnout-tracks "advtrains:dtrack_sy")