July 2008 - bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] ksprotte changed trunk/projects/bos/m2/allocation-cache.lisp
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3543 Author: ksprotte URL: http://bknr.net/trac/changeset/3543 rebuild-cache: assert (in-transaction-p) U trunk/projects/bos/m2/allocation-cache.lisp Modified: trunk/projects/bos/m2/allocation-cache.lisp =================================================================== --- trunk/projects/bos/m2/allocation-cache.lisp 2008-07-22 08:32:05 UTC (rev 3542) +++ trunk/projects/bos/m2/allocation-cache.lisp 2008-07-22 08:35:04 UTC (rev 3543) @@ -232,7 +232,8 @@ (format t "~5D~10T~5D~%" size count)))))) (defun rebuild-cache () - "" + (assert (in-transaction-p) nil + "rebuild-cache may only be called in a transaction context") (unless *allocation-cache* (setq *allocation-cache* (make-allocation-cache))) (clear-cache)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3542 Author: ksprotte URL: http://bknr.net/trac/changeset/3542 removed (bos.m2.allocation-cache:rebuild-cache) from daily job, cause it is done in snapshot (and wrong to do there anyway - because rebuild-cache is not a transaction, but would need to be logged) U trunk/projects/bos/m2/allocation-cache.lisp U trunk/projects/bos/web/daily.lisp Modified: trunk/projects/bos/m2/allocation-cache.lisp =================================================================== --- trunk/projects/bos/m2/allocation-cache.lisp 2008-07-22 05:40:55 UTC (rev 3541) +++ trunk/projects/bos/m2/allocation-cache.lisp 2008-07-22 08:32:05 UTC (rev 3542) @@ -232,6 +232,7 @@ (format t "~5D~10T~5D~%" size count)))))) (defun rebuild-cache () + "" (unless *allocation-cache* (setq *allocation-cache* (make-allocation-cache))) (clear-cache) Modified: trunk/projects/bos/web/daily.lisp =================================================================== --- trunk/projects/bos/web/daily.lisp 2008-07-22 05:40:55 UTC (rev 3541) +++ trunk/projects/bos/web/daily.lisp 2008-07-22 08:32:05 UTC (rev 3542) @@ -7,8 +7,6 @@ (bknr.stats::make-yesterdays-stats :delete-events t) (format t "; snapshotting datastore~%") (snapshot) - (format t "; rebuilding allocation-cache~%") - (bos.m2.allocation-cache:rebuild-cache) (format t "; running check (consistent-p)~%") (flet ((consistent-p-report () (let (consistent-p)

1 0

[bknr-cvs] hans changed trunk/projects/pch/src/pch
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3541 Author: hans URL: http://bknr.net/trac/changeset/3541 snapshot intermediate state U trunk/projects/pch/src/pch.erl A trunk/projects/pch/src/pch_cache_mgr.erl A trunk/projects/pch/src/pch_front.erl Modified: trunk/projects/pch/src/pch.erl =================================================================== --- trunk/projects/pch/src/pch.erl 2008-07-21 15:40:49 UTC (rev 3540) +++ trunk/projects/pch/src/pch.erl 2008-07-22 05:40:55 UTC (rev 3541) @@ -3,39 +3,15 @@ -module(pch). -export([start/0, loop/2, stop/0]). --define(DEFAULTS, [{name, ?MODULE}, - {port, 9888}]). +-define(HTTP_PORT, 9888). +-define(MANAGEMENT_PORT, 9889). start() -> Cache = ets:new(table, [set, public]), - Loop = fun (Req) -> ?MODULE:loop(Req, Cache) end, - mochiweb_http:start([{loop, Loop} | ?DEFAULTS]). + pch_cache_mgr:start(?MANAGEMENT_PORT, Cache), + pch_front:start(?HTTP_PORT, Cache). stop() -> - mochiweb_http:stop(?MODULE). + pch_front:stop(), + pch_cache_mgr:stop(). -fetch_from_backend(Path) -> - {ok, {{_Version, 200, _ReasonPhrase}, Headers, Body}} = - http:request("http://test.createrainforest.org" ++ Path), - {ok, Headers, Body}. - -backend_request(Req, Cache) -> - Path = Req:get(path), - case ets:lookup(Cache, Path) of - [{Path, Headers, Body}] -> - io:format("cache HIT for ~p~n", [Path]), - Req:respond({200, Headers, Body}); - _ -> - io:format("cache MISS for ~p~n", [Path]), - {ok, Headers, Body} = fetch_from_backend(Path), - ets:insert(Cache, {Path, Headers, Body}), - Req:respond({200, Headers, Body}) - end. - -loop(Req, Cache) -> - case Req:get(method) of - M when M =:= 'GET' -> - backend_request(Req, Cache); - _ -> - Req:respond({501, [], ""}) - end. Added: trunk/projects/pch/src/pch_cache_mgr.erl =================================================================== --- trunk/projects/pch/src/pch_cache_mgr.erl (rev 0) +++ trunk/projects/pch/src/pch_cache_mgr.erl 2008-07-22 05:40:55 UTC (rev 3541) @@ -0,0 +1,19 @@ +-module(pch_cache_mgr). +-export([start/1, loop/2, stop/0]). + +start(Port, Cache) -> + mochiweb_http:start([{loop, fun (Req) -> + ?MODULE:loop(Req, Cache) end}, + {port, Port}, + {name, ?MODULE}]). + +stop() -> + mochiweb_http:stop(?MODULE). + +loop(Req, Cache) -> + case Req:get(method) of + M when M =:= 'GET' -> + backend_request(Req, Cache); + _ -> + Req:respond({501, [], ""}) + end. Added: trunk/projects/pch/src/pch_front.erl =================================================================== --- trunk/projects/pch/src/pch_front.erl (rev 0) +++ trunk/projects/pch/src/pch_front.erl 2008-07-22 05:40:55 UTC (rev 3541) @@ -0,0 +1,37 @@ +-module(pch_front). +-export([start/0, loop/2, stop/0]). + +start(Port, Cache) -> + mochiweb_http:start([{loop, fun (Req) -> + ?MODULE:loop(Req, Cache) end}, + {port, Port}, + {name, ?MODULE}]). + +stop() -> + mochiweb_http:stop(?MODULE), + +fetch_from_backend(Path) -> + {ok, {{_Version, 200, _ReasonPhrase}, Headers, Body}} = + http:request("http://test.createrainforest.org" ++ Path), + {ok, Headers, Body}. + +backend_request(Req, Cache) -> + Path = Req:get(path), + case ets:lookup(Cache, Path) of + [{Path, Headers, Body}] -> + io:format("cache HIT for ~p~n", [Path]), + Req:respond({200, Headers, Body}); + _ -> + io:format("cache MISS for ~p~n", [Path]), + {ok, Headers, Body} = fetch_from_backend(Path), + ets:insert(Cache, {Path, Headers, Body}), + Req:respond({200, Headers, Body}) + end. + +loop(Req, Cache) -> + case Req:get(method) of + M when M =:= 'GET' -> + backend_request(Req, Cache); + _ -> + Req:respond({501, [], ""}) + end.

1 0

[bknr-cvs] ksprotte changed branches/bos/projects/bos/m2/allocation-cache.lisp
by BKNR Commits 21 Jul '08

21 Jul '08

Revision: 3540 Author: ksprotte URL: http://bknr.net/trac/changeset/3540 fix for allocation-cache-subsystem; call (rebuild-cache) on snapshot-subsystem U branches/bos/projects/bos/m2/allocation-cache.lisp Modified: branches/bos/projects/bos/m2/allocation-cache.lisp =================================================================== --- branches/bos/projects/bos/m2/allocation-cache.lisp 2008-07-21 15:38:26 UTC (rev 3539) +++ branches/bos/projects/bos/m2/allocation-cache.lisp 2008-07-21 15:40:49 UTC (rev 3540) @@ -263,4 +263,5 @@ (rebuild-cache)) (defmethod bknr.datastore::snapshot-subsystem (store (subsystem allocation-cache-subsystem)) - ) \ No newline at end of file + (rebuild-cache)) +

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/
by BKNR Commits 21 Jul '08

21 Jul '08

Revision: 3539 Author: ksprotte URL: http://bknr.net/trac/changeset/3539 fixed some typos from last commit U trunk/projects/bos/m2/allocation-cache.lisp U trunk/projects/bos/m2/bos.m2.asd U trunk/projects/bos/m2/m2.lisp U trunk/projects/bos/m2/packages.lisp U trunk/projects/bos/web/contract-tree.lisp U trunk/projects/bos/web/quad-tree.lisp U trunk/projects/bos/web/sat-tree.lisp Modified: trunk/projects/bos/m2/allocation-cache.lisp =================================================================== --- trunk/projects/bos/m2/allocation-cache.lisp 2008-07-21 15:25:37 UTC (rev 3538) +++ trunk/projects/bos/m2/allocation-cache.lisp 2008-07-21 15:38:26 UTC (rev 3539) @@ -260,8 +260,7 @@ (defmethod bknr.datastore::restore-subsystem (store (subsystem allocation-cache-subsystem) &key until) (declare (ignore until)) - (rebuild-cache) - (bos.m2::invoke-store-transient-init-functions)) + (rebuild-cache)) (defmethod bknr.datastore::snapshot-subsystem (store (subsystem allocation-cache-subsystem)) ) \ No newline at end of file Modified: trunk/projects/bos/m2/bos.m2.asd =================================================================== --- trunk/projects/bos/m2/bos.m2.asd 2008-07-21 15:25:37 UTC (rev 3538) +++ trunk/projects/bos/m2/bos.m2.asd 2008-07-21 15:38:26 UTC (rev 3539) @@ -15,7 +15,8 @@ (:file "make-certificate" :depends-on ("config")) (:file "initialization-subsystem" :depends-on ("packages")) (:file "m2-store" :depends-on ("packages" "utils")) - (:file "m2" :depends-on ("tiled-index" + (:file "m2" :depends-on ("initialization-subsystem" + "tiled-index" "utils" "make-certificate" "mail-generator" Modified: trunk/projects/bos/m2/m2.lisp =================================================================== --- trunk/projects/bos/m2/m2.lisp 2008-07-21 15:25:37 UTC (rev 3538) +++ trunk/projects/bos/m2/m2.lisp 2008-07-21 15:38:26 UTC (rev 3539) @@ -657,7 +657,7 @@ (check-type country symbol) `(invoke-with-countries (lambda (,country) ,@body))) -(register-store-transient-init-function 'initialize-contract-stats) +(register-transient-init-function 'initialize-contract-stats) (defun string-safe (string) (if string Modified: trunk/projects/bos/m2/packages.lisp =================================================================== --- trunk/projects/bos/m2/packages.lisp 2008-07-21 15:25:37 UTC (rev 3538) +++ trunk/projects/bos/m2/packages.lisp 2008-07-21 15:38:26 UTC (rev 3539) @@ -78,7 +78,7 @@ (:shadowing-import-from :cl-interpol #:quote-meta-chars) (:export #:m2-store #:*m2-store* - #:register-store-transient-init-function + #:register-transient-init-function #:get-tile #:ensure-tile Modified: trunk/projects/bos/web/contract-tree.lisp =================================================================== --- trunk/projects/bos/web/contract-tree.lisp 2008-07-21 15:25:37 UTC (rev 3538) +++ trunk/projects/bos/web/contract-tree.lisp 2008-07-21 15:38:26 UTC (rev 3539) @@ -363,7 +363,7 @@ (list 0 0 +width+ +width+) #'contract-tree-changed)) -(register-store-transient-init-function 'make-contract-tree-from-m2 +(register-transient-init-function 'make-contract-tree-from-m2 'make-quad-tree 'geometry:make-rect-publisher) Modified: trunk/projects/bos/web/quad-tree.lisp =================================================================== --- trunk/projects/bos/web/quad-tree.lisp 2008-07-21 15:25:37 UTC (rev 3538) +++ trunk/projects/bos/web/quad-tree.lisp 2008-07-21 15:38:26 UTC (rev 3539) @@ -409,5 +409,5 @@ (+ local-draw-order (* (depth node) +max-num-of-local-draw-order-levels+))) -(register-store-transient-init-function 'make-quad-tree) +(register-transient-init-function 'make-quad-tree) Modified: trunk/projects/bos/web/sat-tree.lisp =================================================================== --- trunk/projects/bos/web/sat-tree.lisp 2008-07-21 15:25:37 UTC (rev 3538) +++ trunk/projects/bos/web/sat-tree.lisp 2008-07-21 15:38:26 UTC (rev 3539) @@ -80,7 +80,7 @@ (defun quad-tree-insert-sat-images () (mapc #'quad-tree-insert-sat-image (class-instances 'sat-image))) -(register-store-transient-init-function 'quad-tree-insert-sat-images +(register-transient-init-function 'quad-tree-insert-sat-images 'make-quad-tree) (defmethod name ((obj sat-image))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/m2/initialization-subsystem.lisp
by BKNR Commits 21 Jul '08

21 Jul '08

Revision: 3538 Author: ksprotte URL: http://bknr.net/trac/changeset/3538 call invoke-store-transient-init-functions also in snapshot-subsystem U trunk/projects/bos/m2/initialization-subsystem.lisp Modified: trunk/projects/bos/m2/initialization-subsystem.lisp =================================================================== --- trunk/projects/bos/m2/initialization-subsystem.lisp 2008-07-21 15:14:13 UTC (rev 3537) +++ trunk/projects/bos/m2/initialization-subsystem.lisp 2008-07-21 15:25:37 UTC (rev 3538) @@ -1,14 +1,14 @@ (in-package :bos.m2) -;;; store-transient-init-functions +;;; transient-init-functions ;;; ;;; Allows for registering transient init functions that ;;; will be called after each restore of m2-store -(defvar *store-transient-init-functions* nil) -(defvar *store-transient-init-constraints* nil) +(defvar *transient-init-functions* nil) +(defvar *transient-init-constraints* nil) -(defun register-store-transient-init-function (init-function &rest dependencies) +(defun register-transient-init-function (init-function &rest dependencies) "Register INIT-FUNCTION (a function-name) to be called after each restore of m2-store. Optionally, names of other init-functions can be specified as DEPENDENCIES. The specified @@ -27,31 +27,31 @@ (check-type init-function symbol) (dolist (dependency dependencies) (check-type dependency symbol)) - (let (new-store-transient-init-functions - new-store-transient-init-constraints) + (let (new-transient-init-functions + new-transient-init-constraints) (let ((constraints (build-constraints)) ;; dont know yet whether we have a circular dependency - so ;; we want to be able to abort without changes - (*store-transient-init-functions* *store-transient-init-functions*) - (*store-transient-init-constraints* *store-transient-init-constraints*)) - (pushnew init-function *store-transient-init-functions*) + (*transient-init-functions* *transient-init-functions*) + (*transient-init-constraints* *transient-init-constraints*)) + (pushnew init-function *transient-init-functions*) (dolist (dependency dependencies) - (pushnew dependency *store-transient-init-functions*)) + (pushnew dependency *transient-init-functions*)) (dolist (constraint constraints) - (pushnew constraint *store-transient-init-constraints* :test #'equal)) - (setq new-store-transient-init-functions - (topological-sort *store-transient-init-functions* - *store-transient-init-constraints* + (pushnew constraint *transient-init-constraints* :test #'equal)) + (setq new-transient-init-functions + (topological-sort *transient-init-functions* + *transient-init-constraints* #'ignorant-tie-breaker) - new-store-transient-init-constraints - *store-transient-init-constraints*)) - (setq *store-transient-init-functions* - new-store-transient-init-functions - *store-transient-init-constraints* - new-store-transient-init-constraints)))) + new-transient-init-constraints + *transient-init-constraints*)) + (setq *transient-init-functions* + new-transient-init-functions + *transient-init-constraints* + new-transient-init-constraints)))) -(defun invoke-store-transient-init-functions () - (dolist (function-name *store-transient-init-functions*) +(defun invoke-transient-init-functions () + (dolist (function-name *transient-init-functions*) (with-simple-restart (skip-init-function "Skip transient-init-function ~A" function-name) (funcall function-name)))) @@ -63,8 +63,12 @@ (defmethod bknr.datastore::restore-subsystem (store (subsystem initialization-subsystem) &key until) (declare (ignore until)) - (bos.m2::invoke-store-transient-init-functions)) + (invoke-transient-init-functions)) (defmethod bknr.datastore::snapshot-subsystem (store (subsystem initialization-subsystem)) - ) + ;; We are calling the initialization functions also here, because + ;; for transactions that follow the current snapshot we want to be + ;; in the same initial state as if the store had been freshly + ;; restored. + (invoke-transient-init-functions))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/m2/
by BKNR Commits 21 Jul '08

21 Jul '08

Revision: 3537 Author: ksprotte URL: http://bknr.net/trac/changeset/3537 bos: created new subsystem: initialization-subsystem U trunk/projects/bos/m2/bos.m2.asd A trunk/projects/bos/m2/initialization-subsystem.lisp U trunk/projects/bos/m2/m2-store.lisp U trunk/projects/bos/m2/m2.lisp Modified: trunk/projects/bos/m2/bos.m2.asd =================================================================== --- trunk/projects/bos/m2/bos.m2.asd 2008-07-21 15:08:54 UTC (rev 3536) +++ trunk/projects/bos/m2/bos.m2.asd 2008-07-21 15:14:13 UTC (rev 3537) @@ -13,7 +13,8 @@ (:file "tiled-index" :depends-on ("config")) (:file "mail-generator" :depends-on ("config")) (:file "make-certificate" :depends-on ("config")) - (:file "m2-store" :depends-on ("packages" "utils")) + (:file "initialization-subsystem" :depends-on ("packages")) + (:file "m2-store" :depends-on ("packages" "utils")) (:file "m2" :depends-on ("tiled-index" "utils" "make-certificate" Added: trunk/projects/bos/m2/initialization-subsystem.lisp =================================================================== --- trunk/projects/bos/m2/initialization-subsystem.lisp (rev 0) +++ trunk/projects/bos/m2/initialization-subsystem.lisp 2008-07-21 15:14:13 UTC (rev 3537) @@ -0,0 +1,70 @@ +(in-package :bos.m2) + +;;; store-transient-init-functions +;;; +;;; Allows for registering transient init functions that +;;; will be called after each restore of m2-store + +(defvar *store-transient-init-functions* nil) +(defvar *store-transient-init-constraints* nil) + +(defun register-store-transient-init-function (init-function &rest dependencies) + "Register INIT-FUNCTION (a function-name) to be called after +each restore of m2-store. Optionally, names of other +init-functions can be specified as DEPENDENCIES. The specified +INIT-FUNCTION will only be called after all of its DEPENDENCIES +have been called." + (labels ((ignorant-tie-breaker (choices reverse-partial-solution) + (declare (ignore reverse-partial-solution)) + ;; we dont care about making any particular choice here - + ;; this would be different for computing the class + ;; precedence list, for which the topological-sort used here + ;; was originally intended + (first choices)) + (build-constraints () + (loop for dependency in dependencies + collect (cons dependency init-function)))) + (check-type init-function symbol) + (dolist (dependency dependencies) + (check-type dependency symbol)) + (let (new-store-transient-init-functions + new-store-transient-init-constraints) + (let ((constraints (build-constraints)) + ;; dont know yet whether we have a circular dependency - so + ;; we want to be able to abort without changes + (*store-transient-init-functions* *store-transient-init-functions*) + (*store-transient-init-constraints* *store-transient-init-constraints*)) + (pushnew init-function *store-transient-init-functions*) + (dolist (dependency dependencies) + (pushnew dependency *store-transient-init-functions*)) + (dolist (constraint constraints) + (pushnew constraint *store-transient-init-constraints* :test #'equal)) + (setq new-store-transient-init-functions + (topological-sort *store-transient-init-functions* + *store-transient-init-constraints* + #'ignorant-tie-breaker) + new-store-transient-init-constraints + *store-transient-init-constraints*)) + (setq *store-transient-init-functions* + new-store-transient-init-functions + *store-transient-init-constraints* + new-store-transient-init-constraints)))) + +(defun invoke-store-transient-init-functions () + (dolist (function-name *store-transient-init-functions*) + (with-simple-restart (skip-init-function "Skip transient-init-function ~A" + function-name) + (funcall function-name)))) + +;;; initialization-subsystem +(defclass initialization-subsystem () + ()) + +(defmethod bknr.datastore::restore-subsystem (store (subsystem initialization-subsystem) + &key until) + (declare (ignore until)) + (bos.m2::invoke-store-transient-init-functions)) + +(defmethod bknr.datastore::snapshot-subsystem (store (subsystem initialization-subsystem)) + ) + Modified: trunk/projects/bos/m2/m2-store.lisp =================================================================== --- trunk/projects/bos/m2/m2-store.lisp 2008-07-21 15:08:54 UTC (rev 3536) +++ trunk/projects/bos/m2/m2-store.lisp 2008-07-21 15:14:13 UTC (rev 3537) @@ -14,58 +14,3 @@ (setf (slot-value store 'tile-index) (indexed-class-index-named (find-class 'm2) 'm2-index))) -;;; store-transient-init-functions -;;; -;;; Allows for registering transient init functions that -;;; will be called after each restore of m2-store - -(defvar *store-transient-init-functions* nil) -(defvar *store-transient-init-constraints* nil) - -(defun register-store-transient-init-function (init-function &rest dependencies) - "Register INIT-FUNCTION (a function-name) to be called after -each restore of m2-store. Optionally, names of other -init-functions can be specified as DEPENDENCIES. The specified -INIT-FUNCTION will only be called after all of its DEPENDENCIES -have been called." - (labels ((ignorant-tie-breaker (choices reverse-partial-solution) - (declare (ignore reverse-partial-solution)) - ;; we dont care about making any particular choice here - - ;; this would be different for computing the class - ;; precedence list, for which the topological-sort used here - ;; was originally intended - (first choices)) - (build-constraints () - (loop for dependency in dependencies - collect (cons dependency init-function)))) - (check-type init-function symbol) - (dolist (dependency dependencies) - (check-type dependency symbol)) - (let (new-store-transient-init-functions - new-store-transient-init-constraints) - (let ((constraints (build-constraints)) - ;; dont know yet whether we have a circular dependency - so - ;; we want to be able to abort without changes - (*store-transient-init-functions* *store-transient-init-functions*) - (*store-transient-init-constraints* *store-transient-init-constraints*)) - (pushnew init-function *store-transient-init-functions*) - (dolist (dependency dependencies) - (pushnew dependency *store-transient-init-functions*)) - (dolist (constraint constraints) - (pushnew constraint *store-transient-init-constraints* :test #'equal)) - (setq new-store-transient-init-functions - (topological-sort *store-transient-init-functions* - *store-transient-init-constraints* - #'ignorant-tie-breaker) - new-store-transient-init-constraints - *store-transient-init-constraints*)) - (setq *store-transient-init-functions* - new-store-transient-init-functions - *store-transient-init-constraints* - new-store-transient-init-constraints)))) - -(defun invoke-store-transient-init-functions () - (dolist (function-name *store-transient-init-functions*) - (with-simple-restart (skip-init-function "Skip transient-init-function ~A" - function-name) - (funcall function-name)))) \ No newline at end of file Modified: trunk/projects/bos/m2/m2.lisp =================================================================== --- trunk/projects/bos/m2/m2.lisp 2008-07-21 15:08:54 UTC (rev 3536) +++ trunk/projects/bos/m2/m2.lisp 2008-07-21 15:14:13 UTC (rev 3537) @@ -706,7 +706,8 @@ :subsystems (list (make-instance 'store-object-subsystem) (make-instance 'blob-subsystem :n-blobs-per-directory 1000) - (make-instance 'bos.m2.allocation-cache:allocation-cache-subsystem))) + (make-instance 'bos.m2.allocation-cache:allocation-cache-subsystem) + (make-instance 'initialization-subsystem))) (format t "~&; Startup der Quadratmeterdatenbank done.~%") (force-output))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/m2/allocation-cache.lisp
by BKNR Commits 21 Jul '08

21 Jul '08

Revision: 3536 Author: ksprotte URL: http://bknr.net/trac/changeset/3536 small indentation fix U trunk/projects/bos/m2/allocation-cache.lisp Modified: trunk/projects/bos/m2/allocation-cache.lisp =================================================================== --- trunk/projects/bos/m2/allocation-cache.lisp 2008-07-21 14:58:36 UTC (rev 3535) +++ trunk/projects/bos/m2/allocation-cache.lisp 2008-07-21 15:08:54 UTC (rev 3536) @@ -257,8 +257,8 @@ (defclass allocation-cache-subsystem () ()) -(defmethod bknr.datastore::restore-subsystem - (store (subsystem allocation-cache-subsystem) &key until) +(defmethod bknr.datastore::restore-subsystem (store (subsystem allocation-cache-subsystem) + &key until) (declare (ignore until)) (rebuild-cache) (bos.m2::invoke-store-transient-init-functions))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/Makefile
by BKNR Commits 21 Jul '08

21 Jul '08

Revision: 3535 Author: ksprotte URL: http://bknr.net/trac/changeset/3535 added Makefile 'start' target for bos U trunk/projects/bos/Makefile Modified: trunk/projects/bos/Makefile =================================================================== --- trunk/projects/bos/Makefile 2008-07-21 09:20:25 UTC (rev 3534) +++ trunk/projects/bos/Makefile 2008-07-21 14:58:36 UTC (rev 3535) @@ -19,6 +19,10 @@ .PHONY: clean clean: cleancore +.PHONY: start +start: bos.core + sbcl --core bos.core --eval '(start)' + # TAGS TAGS: find . -name '*.lisp' | xargs etags -a

1 0

[bknr-cvs] hans changed trunk/thirdparty/cl-qprint/base.lisp
by BKNR Commits 21 Jul '08

21 Jul '08

Revision: 3534 Author: hans URL: http://bknr.net/trac/changeset/3534 update cl-qprint to version 0.2.1 U trunk/thirdparty/cl-qprint/base.lisp Modified: trunk/thirdparty/cl-qprint/base.lisp =================================================================== --- trunk/thirdparty/cl-qprint/base.lisp 2008-07-21 09:18:46 UTC (rev 3533) +++ trunk/thirdparty/cl-qprint/base.lisp 2008-07-21 09:20:25 UTC (rev 3534) @@ -68,7 +68,7 @@ (princ #\linefeed stream)) -(defun encode (input &key encode-newlines) +(defun encode (input &key columns encode-newlines) "INPUT must be either a string or a stream. Reads from INPUT and produces a quoted-printable encoded string" (let ((out-stream (make-string-output-stream)) @@ -86,7 +86,8 @@ (get-output-stream-string out-stream)) ;; Put in a soft line break if the line's gotten too long - (when (>= (- position last-line-break) 74) + (when (and columns + (>= (- position last-line-break) (1- columns))) (princ #\= out-stream) (cr-lf out-stream) (setf last-line-break position))

1 0