Skip to content
Browse files

Fix up session closing code (handle errors better)

add routine to tune the generational garbage collector.
Still need to set 3 generations as global sbcl constant.
  • Loading branch information...
1 parent 0a86cda commit b206082301d1c3b63b164d4eebd1f20285c706e5 @bvds committed Mar 3, 2010
Showing with 64 additions and 55 deletions.
  1. +7 −6 Algebra/solver.cl
  2. +9 −1 Base/garbage-collect.cl
  3. +43 −47 Help/State.cl
  4. +5 −1 Help/sessions.cl
View
13 Algebra/solver.cl
@@ -168,11 +168,12 @@
(solver-logging *solver-logging*))
(defun solver-unload ()
- (write-line "exit" (sb-ext:process-input *process*))
- ;; see comment in do-solver-turn about buffering
- (force-output (sb-ext:process-input *process*))
- (sb-ext:process-wait *process*)
- (sb-ext:process-close *process*))
+ (when *process* ;; nil if solver-load fails
+ (write-line "exit" (sb-ext:process-input *process*))
+ ;; see comment in do-solver-turn about buffering
+ (force-output (sb-ext:process-input *process*))
+ (sb-ext:process-wait *process*)
+ (sb-ext:process-close *process*)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; eq slot range defined in DLL. NB: must stay in sync w/DLL!
@@ -335,7 +336,7 @@
"If '(Error: <' is start return string else lisp-read."
(cond ((and (>= (length x) 9)
(equal "Error: <" (subseq x 1 9)))
- (warn "~&!!! Error in SOLVER: ~A~%" x) ;trace msg on error returns
+ (warn "Error reported by SOLVER: ~A" x) ;trace msg on error returns
x)
((= 0 (length x)) nil)
;; do-solver-turn sets read format as double-precision
View
10 Base/garbage-collect.cl
@@ -33,5 +33,13 @@
(warn "dereference-with ~A got type ~A: ~a"
',func (type-of ,obj) ,obj))))
-
+
+;; In principle, should store original values and restore when
+;; Session is finished.
+(defun tune-generational-gc ()
+ #-sbcl (warn "No working tune-generational-gc")
+ #+sbcl (let ((b (* 100 1024 1024)))
+ (setf (generation-bytes-consed-between-gcs 2) b)
+ (setf (generation-number-of-gcs-before-promotion 2) 24)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
View
90 Help/State.cl
@@ -143,61 +143,57 @@
(setf *cp* (read-problem-file (string-upcase name)
:path (andes-path "solutions/")))
- ;; If the problem failed to load then we will submit a color-red turn
- ;; to the workbench in order to make the case known. If not then the
- ;; code will set up the problem for use and then return a color-green
- ;; turn.
(if *cp*
- (do-read-problem-info-setup)
- (error "Unable to load problem ~A.&nbsp; Please try another problem." name)))
-
-;; Once the problem has been loaded successfully into the *cp* parameter
-;; then we need to setup the struct for runtime use. This code will do
-;; that and conclude by returning a color-green-turn.
-(defun do-read-problem-info-setup ()
- "Setup the loaded problem."
- (when *debug-help*
- (format t "Current Problem now ~A~%" (problem-name *cp*)))
-
- ;; Initialize sg structures
- (sg-setup *cp*)
- ;;(format T "~&Solution Entries:~%~{~A~}" *sg-entries*)
-
- ;; enter appropriate predefined student labels into symbol table:
- (enter-predefs)
-
- ;; re-initialize the dialog state
- (reset-next-step-help))
+ ;; Once the problem has been loaded successfully into the *cp* parameter
+ ;; then we need to setup the struct for runtime use.
+ (progn
+ ;; Initialize sg structures
+ (sg-setup *cp*)
+
+ ;; enter appropriate predefined student labels into symbol table:
+ (enter-predefs)
+
+ ;; re-initialize the dialog state
+ (reset-next-step-help))
+ ;; Raising an error, rather than a warning, keeps subsequent
+ ;; code in open-problem from being executed, and sends a
+ ;; message to the student.
+ (error "Unable to load problem ~A.&nbsp; Please try another problem."
+ name)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; close-problem -- close the specified problem
;; returns: unused
;; note(s): should be current problem
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun do-close-problem ()
- ;; empty symbol table and entry list
- (clear-symbol-table)
- (fill **grammar** nil) ;shallow dereference, for garbage collection
- (setf **grammar** nil)
- ;; shallow dereference, for garbage collection
- (dereference-with dereference-StudentEntry *StudentEntries*)
-
- ;; unload current problem with its sgraph structures
- ;; Garbage collection for problems may be complicated,
- ;; since it may use stuff that is shared across problems
- (dereference-problem *cp*)
- (setf *cp* nil)
-
- (dereference-with dereference-SystemEntry *sg-entries*)
-
- ;; *sg-eqns* is a list of ((index algebra SystemEntry) ...)
- (dolist (eqn *sg-eqns*) (dereference-SystemEntry (third eqn)))
- (fill *sg-eqns* nil)
- (setf *sg-eqns* nil)
-
- ;; Set the current problem instance time from the universal time.
- (setq *Current-Problem-Instance-Start-UTime* (get-universal-time)))
-
+ (when *cp* ;*cp* not defined if load failed.
+ (dereference-with dereference-bgnode *nsh-nodes*)
+
+ (dereference-with dereference-SystemEntry *sg-entries*)
+
+ ;; *sg-eqns* is a list of ((index algebra SystemEntry) ...)
+ (dolist (eqn *sg-eqns*) (dereference-SystemEntry (third eqn)))
+ (fill *sg-eqns* nil)
+ (setf *sg-eqns* nil)
+
+ ;; unload current problem with its sgraph structures
+ ;; Garbage collection for problems may be complicated,
+ ;; since it may use stuff that is shared across problems
+ (dereference-problem *cp*)
+ (setf *cp* nil))
+
+ ;; shallow dereference, for garbage collection
+ (dereference-with dereference-StudentEntry *StudentEntries*)
+
+ ;; empty symbol table and entry list
+ (clear-symbol-table)
+ (fill **grammar** nil) ;shallow dereference, for garbage collection
+ (setf **grammar** nil)
+
+ ;; Set the current problem instance time from the universal time.
+ (setq *Current-Problem-Instance-Start-UTime* (get-universal-time)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
View
6 Help/sessions.cl
@@ -55,6 +55,9 @@
"start a server with help system, optionally specifying the port, log file path, and database access."
;; global setup
+ ;; adjust parameters in generational gc to handle many sessions
+ (tune-generational-gc)
+
;; in runtime version only: set *andes-path* to process working directory
#+allegro-cl-runtime (setf *andes-path*
(make-pathname
@@ -715,7 +718,7 @@
(&key time)
"shut problem down"
(declare (ignore time)) ;used by logging.
- (prog1
+ (unwind-protect
(env-wrap
(let ((result (execute-andes-command 'get-stats 'persist)))
@@ -726,6 +729,7 @@
(:URL . "http://www.webassign.net/something/or/other"))
result)
result))
+ ;; de-reference list of variables.
(fill (help-env-vals webserver:*env*) nil)
;; Tell the session manager that the session is over.

0 comments on commit b206082

Please sign in to comment.
Something went wrong with that request. Please try again.