core/actor, csys: improve testing and debugging, suppress irrelevant warnings

core/actor.lisp

@@ -59,11 +59,14 @@
 
 (defun ac-step (tsk bhv msg)
   (let ((*self* tsk))
-    (handler-case (funcall bhv msg)
-      (error (err) 
-             (util:lg :error "behavior" msg err))
-             ;(invoke-debugger err))
-      )))
+    (flet ((handle-err (err)
+      (let* ((st (butlast (dissect:stack) 16))
+             (stack (format nil "~%~{~a~%~}" st)))
+        (util:lg :error "ac-step" err bhv stack tsk msg)
+        (return-from ac-step nil))))
+      ;(dissect:with-capped-stack () 
+      (handler-bind ((error #'handle-err)) 
+        (funcall bhv msg)))))
 
 ;;;; the core (classical, i.e. Hewitt) actor API
 

csys/environ.lisp

@@ -77,7 +77,7 @@
     (when addr
       (register-cell (cells scope) addr new))
       (let* ((ct-addr (cons :env (cdr addr)))
-             (ct (find-cell (cells scope) ct-addr)))
+             (ct (find-cell (cells scope) ct-addr :no-warn t)))
         (when ct (csys:send-connect new ct)))
     (csys:send-message new (list (message:domain msg) :next) data)
     nil))
@@ -130,16 +130,16 @@
         (setf (gethash categ reg) idx))
       (index:put idx key cell))))
 
-(defun find-cells (reg addr)
+(defun find-cells (reg addr &key no-warn)
   (destructuring-bind (dom cat &optional (key "")) addr
     (let* ((idx (gethash (list dom cat) reg))
            (cells (when idx (index:query idx key))))
-      (unless cells
+      (unless (or no-warn cells)
         (util:lgw "not found" addr reg idx))
       cells)))
  
-(defun find-cell (reg addr)
-  (let ((cells (find-cells reg addr)))
+(defun find-cell (reg addr &key no-warn)
+  (let ((cells (find-cells reg addr :no-warn no-warn)))
     (when (> (length cells) 1)
       (util:lgw "more than one cell found" addr reg cells))
     (car cells)))

csys/program/basic.lisp

@@ -25,7 +25,7 @@
       (csys:send-create self :cat :e00 :connect :succ)
       (csys:send-create self :cat :s00 :loc "0-1" :connect :pred)
       (csys:send-connect self self :op (csys:multiply -1))
-      ;; switch :active
+      ;(csys:send-switch self :active)
       nil)))
  
 ;;;; basic-1: minimal cross-linked system

scopes-core.asd

@@ -6,7 +6,7 @@
   :version "0.0.1"
   :homepage "https://www.cyberconcepts.org"
   :description "Core packages of the scopes project."
-  :depends-on (:alexandria :cl-dotenv :cl-readline :com.inuoe.jzon 
+  :depends-on (:alexandria :cl-dotenv :cl-readline :com.inuoe.jzon :dissect
                :flexi-streams :ironclad :local-time :log4cl 
                :lparallel :qbase64 :serapeum :str)
   :components ((:file "config" :depends-on ("util/util"))

test/etc/config-csys.lisp

@@ -2,7 +2,7 @@
 
 (in-package :scopes/test-csys)
 
-(config:root)
+(config:root :env-keys '(:loglevel))
 
 (config:add :logger  :class 'logging:config
             :loglevel (config:from-env :loglevel :info)