From 2fe73c36325111eb765ee91072b98d3fbbc8e71d Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Fri, 25 Sep 2026 09:23:59 +0200
Subject: [PATCH] csys/environ: add cells index, always use scope for storing
 or retrieving cells

---
 csys/environ.lisp | 40 +++++++++++++++++++++++-----------------
 1 file changed, 23 insertions(+), 17 deletions(-)

diff --git a/csys/environ.lisp b/csys/environ.lisp
index 3306780..db91cb6 100644
--- a/csys/environ.lisp
+++ b/csys/environ.lisp
@@ -18,14 +18,15 @@
 (defvar *env* nil)
 
 (defclass scope (csys:scope)
-  ((spaces :reader spaces :initarg :spaces)))
+  ((spaces :reader spaces :initarg :spaces)
+   (cells :reader cells :initform (make-hash-table))))
 
 (defun create (proc meta-env &key contacts (spaces '(:env :csys)))
   (let* ((prg (csys:make-program proc))
          (spcs (loop for d in spaces append (list d (space:create))))
          (scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00) :spaces spcs))
          (env (csys:neuron scope)))
-    (create-contact-cells contacts env (spaces scope))
+    (create-contact-cells contacts env scope)
     env))
 
 (defun simple-setup (cfg)
@@ -48,7 +49,7 @@
 (defclass contact-scope (csys:scope)
   ((loc :reader loc :initarg :loc)))
 
-(defun create-contact-cells (contacts env cells)
+(defun create-contact-cells (contacts env scope)
   (util:loop-plist contacts cat locs do
     (dolist (loc locs)
       (let ((ct (csys:neuron 
@@ -56,7 +57,7 @@
                               :cls 'contact-scope
                               :categ (list :env cat) :loc loc))))
         ;(util:lgi cells cat loc)
-        (register-cell cells (list :env cat loc) ct)))))
+        (register-cell scope (list :env cat loc) ct)))))
 
 (defun proc-contact (msg scope)
   (let ((head (copy-list (shape:head msg)))) 
@@ -78,9 +79,9 @@
          (addr (getf data :addr (getf data :categ)))
          (new (getf data :new)))
     (when addr
-      (register-cell (spaces scope) addr new))
+      (register-cell scope addr new))
       (let* ((ct-addr (cons :env (cdr addr)))
-             (ct (find-cell (spaces scope) ct-addr :no-warn t)))
+             (ct (find-cell scope ct-addr :no-warn t)))
         (when ct (csys:send-connect new ct)))
     (csys:send-message new (list (message:domain msg) :next) data)
     nil))
@@ -88,7 +89,7 @@
 (defun forward (msg scope)
   (let ((addr (message:addr msg))) 
     (if addr 
-      (let ((cell (find-cell (spaces scope) (message:addr msg)))) 
+      (let ((cell (find-cell scope (message:addr msg)))) 
         (actor:send cell msg))
       (let ((rcvr (actor:customer msg)))
         (if rcvr
@@ -101,8 +102,9 @@
   (let* ((data (shape:data msg))
          (tgt (getf data :target))
          (cust (actor:customer msg)))
-    (when (listp tgt) 
-      (setf (getf data :target) (find-cell (spaces scope) tgt)))
+    (cond 
+      ((null tgt) (setf (getf data :target) (find-cell-near scope cust)))
+      ((listp tgt) (setf (getf data :target) (find-cell scope tgt))))
     (forward (message:create (shape:head msg) :data data :customer cust) scope)))
 
 ;;;; public shortcuts
@@ -115,7 +117,6 @@
     (send-message head `(:value ,val) :env env)))
 
 (defun send-connect (rcvr target &key (domain csys:*domain*) (env *env*) op)
-  ;; TODO: use msg.customer instead of :to in data
   (let* ((cat-loc (when (listp rcvr) rcvr))
          (head (cons domain (cons :connect cat-loc)))
          (cust (unless cat-loc rcvr))
@@ -128,16 +129,21 @@
 
 ;;;; internal helpers
 
-(defun register-cell (reg addr cell)
+(defun register-cell (scope addr cell)
   (destructuring-bind (dom cat &optional (loc "")) addr
-    (let ((idx (getf reg dom)))
-      (space:put idx loc cell))))
+    (let* ((reg (spaces scope))
+           (spc (getf reg dom)))
+      (space:put spc loc cell)
+      (setf (gethash cell (cells scope)) addr))))
 
-(defun find-cell (reg addr &key no-warn)
+(defun find-cell (scope addr &key no-warn)
   (destructuring-bind (dom cat &optional loc) addr
-    (let* ((idx (getf reg dom))
-           (cell (space:fetch idx loc)))
+    (let* ((reg (spaces scope))
+           (spc (getf reg dom))
+           (cell (space:fetch spc loc)))
       (unless (or no-warn cell)
-        (util:lgw "not found" addr reg idx))
+        (util:lgw "not found" addr reg spc))
       cell)))
 
+(defun find-cell-near (scope cell))
+