From e6a802a939871616786e65a764ced32965305728 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Wed, 19 Aug 2026 16:13:18 +0200
Subject: [PATCH] csys, value-add action: + limits parameter

---
 csys/csys.lisp          | 13 ++++++++-----
 csys/environ.lisp       |  2 +-
 csys/program/basic.lisp | 22 ++++++++++++----------
 space/space.lisp        | 18 ++++++++++++++++++
 test/test-csys.lisp     |  4 ++--
 5 files changed, 41 insertions(+), 18 deletions(-)
 create mode 100644 space/space.lisp

diff --git a/csys/csys.lisp b/csys/csys.lisp
index c0fa67e..04aee41 100644
--- a/csys/csys.lisp
+++ b/csys/csys.lisp
@@ -154,17 +154,20 @@
     (setf (value scope) (shape:data-value msg :value))
     (values msg scope)))
 
-(defun value-add (&key (bias 0) (threshold 1))
+(defun value-add (&key (bias 0) (threshold 1) limits)
   (lambda (msg scope)
     (let* ((val (getf (shape:data msg) :value))
-           (newval (+ val (value scope))))
+           (newval (+ val (value scope)))
+           (limit2 (cadr limits)))
       ;(util:lgi newval (length (syns scope)))
+      (when limit2 (setf newval (min newval limit2)))
       (if (>= newval threshold)
         (let* ((head (new-msg-head msg scope))
                (msg (message:create head :data (list :value newval))))
           (setf (value scope) bias)
           (values msg scope))
-        (progn
+        (let ((limit1 (car limits)))
+          (when limit1 (setf newval (max newval limit1)))
           (setf (value scope) newval)
           (values nil scope))))))
  
@@ -194,8 +197,8 @@
       (values nil scope))))
 
 (defun retire (msg scope)
-  ;(environ:unregister *self*)
-  ;(environ:remove-pred-syns *self*)
+  #+// (environ:unregister *self*)
+  #+// (environ:remove-pred-syns *self*)
   (setf (stage scope) :retired)
   (setf (syns scope) nil)
   (setf (proc scope)
diff --git a/csys/environ.lisp b/csys/environ.lisp
index a31e8ef..43fdc9e 100644
--- a/csys/environ.lisp
+++ b/csys/environ.lisp
@@ -85,7 +85,7 @@
 (defun forward (msg scope)
   (let ((addr (message:addr msg))) 
     (if addr 
-      (dolist (cell (find-cells (cells scope) (message:addr msg))) 
+      (let ((cell (find-cell (cells scope) (message:addr msg)))) 
         (actor:send cell msg))
       (let ((rcvr (getf (shape:data msg) :to)))
         (if rcvr
diff --git a/csys/program/basic.lisp b/csys/program/basic.lisp
index 8dbf742..88d1bf9 100644
--- a/csys/program/basic.lisp
+++ b/csys/program/basic.lisp
@@ -14,10 +14,11 @@
 ;;;; basic-0: minimal recursive system
 
 (defun prog-b0 ()
-  (csys:make-program
-    (list '(:c00 :initial) (csys:std-proc :next (b0-next-zero))
-          '(:e00 :initial) (csys:eff-proc)
-          ':default (csys:std-proc))))
+  (let ((val-action (csys:value-add :limits '(0)))) 
+    (csys:make-program
+      (list '(:c00 :initial) (csys:std-proc :value val-action :next (b0-next-zero))
+            '(:e00 :initial) (csys:eff-proc)
+            ':default (csys:std-proc)))))
 
 (defun b0-next-zero ()
   (lambda (msg scope) 
@@ -35,11 +36,12 @@
         :eff-contacts '(:e01 ("1-0" "1-1"))))
 
 (defun prog-b1 ()
-  (csys:make-program
-    (list '(:s01 :initial) (csys:std-proc :next (b1-next-zero))
-          '(:s01 :basic) (csys:std-proc :next (b1-next-one))
-          '(:e01 :default) (csys:eff-proc :value (csys:value-add :bias 2))
-          ':default (csys:std-proc))))
+  (let ((val-action (csys:value-add :bias 2 :limits '(0)))) 
+    (csys:make-program
+      (list '(:s01 :initial) (csys:std-proc :next (b1-next-zero))
+            '(:s01 :basic) (csys:std-proc :next (b1-next-one))
+            '(:e01 :default) (csys:eff-proc :value val-action)
+            ':default (csys:std-proc)))))
 
 (defun b1-next-zero ()
   (lambda (msg scope) 
@@ -67,7 +69,7 @@
         :eff-contacts '(:e02 ("2-0" "2-1"))))
 
 (defun prog-b2 ()
-  (let ((val-action (csys:value-add :bias 2))) 
+  (let ((val-action (csys:value-add :bias 2 :limits '(0)))) 
     (csys:make-program
       (list '(:c02 :initial) (csys:std-proc :value val-action :next (b2-next-zero))
             '(:c02 :basic) (csys:std-proc :value val-action :next (b2-next-one))
diff --git a/space/space.lisp b/space/space.lisp
new file mode 100644
index 0000000..beb9d08
--- /dev/null
+++ b/space/space.lisp
@@ -0,0 +1,18 @@
+;;;; cl-scopes/space
+
+;;;; definitions for spatial registering and retrieving objects by location
+
+(defpackage :scopes/space
+  (:use :common-lisp)
+  (:local-nicknames (:alx :alexandria))
+  (:export #:create #:put #:query))
+
+(in-package :scopes/space)
+
+(defclass index ()
+  ((data :reader data :initform (make-hash-table :test #'equal))))
+
+(defun create ()
+  (make-instance 'index))
+
+
diff --git a/test/test-csys.lisp b/test/test-csys.lisp
index f75fdfa..7ddba16 100644
--- a/test/test-csys.lisp
+++ b/test/test-csys.lisp
@@ -90,7 +90,7 @@
 (deftest test-basic-2 ()
   (let ((environ:*env* (setup (basic:config-b2) :delay 0.03)))
     (environ:send-value '(:s02 "1-0") 1) (sleep 0.0001)
-    (environ:send-value '(:s02 "1-1") 2) (sleep 0.0001) ;; 2 => loop
-    (environ:send-value '(:s02 "1-0") 2) ;; stop loop
+    (environ:send-value '(:s02 "1-1") 2) (sleep 0.0001)
+    (environ:send-value '(:s02 "1-0") 2)
     (teardown)))