diff --git a/core/actor.lisp b/core/actor.lisp index 473c31f..ef5264f 100644 --- a/core/actor.lisp +++ b/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 diff --git a/csys/environ.lisp b/csys/environ.lisp index 84865b0..a31e8ef 100644 --- a/csys/environ.lisp +++ b/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))) diff --git a/csys/program/basic.lisp b/csys/program/basic.lisp index 3ce8b2b..ae6b74f 100644 --- a/csys/program/basic.lisp +++ b/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 diff --git a/scopes-core.asd b/scopes-core.asd index 8584b1d..a75b90f 100644 --- a/scopes-core.asd +++ b/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")) diff --git a/test/etc/config-csys.lisp b/test/etc/config-csys.lisp index 2777e60..c5883ab 100644 --- a/test/etc/config-csys.lisp +++ b/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)