I'm obviously missing some little piece, because I doubt the distributed binary is doing this to everybody.
I downloaded and installed ftp://cmucl.cons.org/pub/lisp/cmucl/release/18e/cmucl-18e-sparcv9-solaris7.tar.gz , and I ran it on a SPARCStation running solaris 2.8 . This is what happened: king-sun king 22> /net/dlsun3003/private/projects/org/develop/CMUCL/bin/lisp -dynamic-space-size 1023 CMU Common Lisp 18e linkage CVS 2003-04-14 16:28:55, running on king-sun With core: /net/dlsun3003/private/projects/org/develop/CMUCL/lib/cmucl/lib/lisp.core Dumped on: Mon, 2003-04-14 14:49:54-07:00 on edgedsp4 See <http://www.cons.org/cmucl/> for support information. Loaded subsystems: Python 1.1, target SPARCstation/Solaris 2 CLOS 18e (based on PCL September 16 92 PCL (f)) * * (load "pseudo-OATW.lisp") NIL * ; Loading #p"/private/king/pseudo-OATW.lisp". T * (parse-programs 3000 100 2000) ; In: LAMBDA (N STREAM-SEQUENCE) ; #'(LAMBDA (N IGNORE) (MAKE-LIST N)) ; Note: Variable IGNORE defined but never used. Parsing program #0 [created 0 nodes so far] Parsing program #1 [created 1093 nodes so far] segv_handler: Real protection violation: 0x40b72000 segv_handler: Real protection violation: 0x40b74000 Maximum number (4096) of interrupts exceeded. Exiting. king-sun king 23> When I modify the code for parse-programs to do a (gc) for every "program", it works. I suspect that problems arise when an automatically-initiated GC is performed. Does anyone have any suggestions? The code in file pseudo-OATW.lisp follows: -dk (in-package "USER") (defvar *initial-plist-size* 12) (defstruct (kbnode (:constructor create-kbnode (&optional (knowledge (make-array *initial-plist-size* :initial-element nil))))) (knowledge nil :type simple-vector)) (defvar *reference-class* (create-kbnode)) (defvar *sum-class* (create-kbnode)) (defvar *assignment-class* (create-kbnode)) (defvar *if-statement-class* (create-kbnode)) (defvar *non-leaf-class* (create-kbnode)) (defvar *program-class* (create-kbnode)) (defvar *elements-attribute* (create-kbnode)) (defvar *element-of-attribute* (create-kbnode)) (defvar *parent-expr-attribute* (create-kbnode)) (defvar *random-down-attribute* (create-kbnode)) (defvar *surface-syntax-attribute* (create-kbnode)) (defvar *varname-attribute* (create-kbnode)) (defun db-put (node attribute value) (let ((knowledge (kbnode-knowledge node))) (if (null (aref knowledge (- (length knowledge) 2))) (dotimes (i (/ (length knowledge) 2)) (when (null (aref knowledge (* i 2))) (setf (aref knowledge (* i 2)) attribute (aref knowledge (+ i i 1)) value) (return))) (progn (molt-kbnode node) (db-put node attribute value))))) (defun db-put-tree (node attribute value) (db-put node attribute value) (db-put attribute node *parent-expr-attribute*)) (defun db-get (node attribute) (let ((knowledge (kbnode-knowledge node))) (dotimes (i (/ (length knowledge) 2) nil) (when (eq (aref knowledge (* i 2)) attribute) (return (aref knowledge (+ i i 1))))))) (defun db-push (node attribute added-value) (let ((knowledge (kbnode-knowledge node))) (dotimes (i (/ (length knowledge) 2) (progn (db-put node attribute nil) (db-push node attribute added-value))) (when (eq (aref knowledge (* i 2)) attribute) (return (push added-value (aref knowledge (+ i i 1)))))))) (defun db-push-tree (node attribute added-value) (db-push node attribute added-value) (db-put attribute node *parent-expr-attribute*)) (defun molt-kbnode (node) (let* ((old-knowledge (kbnode-knowledge node)) (new-knowledge (make-array (ceiling (* (length old-knowledge) 1.5)) :initial-element nil))) (dotimes (i (length old-knowledge)) (setf (aref new-knowledge i) (aref old-knowledge i))) (setf (kbnode-knowledge node) new-knowledge))) (defun make-object-in-class (class) (let ((result (create-kbnode))) (db-put result *element-of-attribute* class) (db-push class *elements-attribute* result) result)) (defvar *interned-vars-pkg* (make-package "OATW-NAMES")) ;; This code simulates the reading of a program of size N. ;; That involves "reading" N characters, making a ternary ;; tree where the root node is a *program-class*, interning ;; symbols [assumed each symbol is used ten times] and ;; churning some CONSes, strings, and other array space. ;; ;; We make the following assumptions: To support each ;; character we need *cons-churn* conses, *array-cell-churn* ;; array elements in clumps of *churned-array-size*, and ;; *string-char-churn* characters in clumps of ;; *churned-string-size* . All sizes are averages, and can ;; vary from zero to twice that ammount with uniform ;; distribution. We call the random number generator, which ;; can add to the churn and certainly churns a float number. ;; ;; The way we structure the "program" is: ;; If we create a node with ten or fewer characters, we ;; create a *reference-class* object with a surface syntax ;; of a new string with ten characters. The reference will ;; have an interned name drawn from a space of chosen size ;; If we create a node with more than ten chars, we do this ;; by recursively creating three nodes, each with roughly ;; one third of the characters; then we make a ;; *non-leaf-class* instance whose *random-down-attribute* ;; is the list of all three and whose ;; *surface-syntax-attribute* is the three subnodes ;; separated by spaces [each space string is separate -- ;; not EQ]. ;; ;; A leaf node requires about ;; ;; (defvar *cons-churn* 3) (defvar *array-cell-churn* 2) (defvar *churned-array-size* 10) (defvar *string-char-churn* 2) (defvar *churned-string-size* 30) (defvar *parsed-programs* '()) (defstruct (stream-sequence (:constructor create-stream-sequence (&optional (head (cons nil nil)) (tail head)))) head tail) (defun read-a-character (ss) (setf (cdr (stream-sequence-tail ss)) (cons nil nil) (stream-sequence-tail ss) (cdr (stream-sequence-tail ss)))) (defun churn-for-n-chars (n stream-sequence) (dotimes (i n) (read-a-character stream-sequence)) (churn1 #'(lambda (n ignore) (make-list n)) n *cons-churn* 1) (churn1 #'(lambda (n unit-churn) (dotimes (i n) (make-array unit-churn))) n *array-cell-churn* *churned-array-size*) (churn1 #'(lambda (n unit-churn) (dotimes (i n) (make-string unit-churn))) n *string-char-churn* *churned-string-size*)) (defun churn1 (churn-fn chars churn-units-per-char unit-churn) (let ((instances (round (random (/ (* 1.0 chars churn-units-per-char) unit-churn))))) (funcall churn-fn instances unit-churn))) (defun make-node-with-N-characters (n num-vars stream-sequence node-count-place) (if (< n 11) (let ((result (make-object-in-class *reference-class*))) (incf (car node-count-place)) (churn-for-n-chars n stream-sequence) (let ((name (intern (format nil "VAR~s" (random num-vars)) *interned-vars-pkg*))) (db-put result *varname-attribute* name) (db-put result *surface-syntax-attribute* (vector (symbol-name name)))) result) (let ((result (make-object-in-class *non-leaf-class*)) (children '())) (incf (car node-count-place)) (dotimes (i 3) (let ((child (make-node-with-N-characters (floor (+ i n) 3) num-vars stream-sequence node-count-place))) (db-put child *parent-expr-attribute* result) (push child children))) (db-put result *random-down-attribute* children) (db-put result *surface-syntax-attribute* (vector (first children) (concatenate 'string " " " ") (second children) (concatenate 'string " " " ") (third children))) result))) (defun least-bit (int) (logand int (lognot (- int 1)))) (defun bits-in-int (int) (let ((result 0) the-bit) (loop (if (zerop (setf the-bit (least-bit int))) (return-from bits-in-int result)) (incf result) (setf int (logand int (lognot the-bit)))))) (defvar *resource-use* 300000) (defun parse-programs (program-size num-programs num-vars) (let ((node-count (list 0))) (dotimes (i num-programs) (when (or (= i (- num-programs 1)) (>= (least-bit i) (/ i 8))) (format t "Parsing program #~d [created ~d nodes so far]~%" i (car node-count))) (let ((new-prog (make-node-with-N-characters program-size num-vars (create-stream-sequence) node-count))) ;; test for solaris version segv problem (push new-prog *parsed-programs*)))))
