LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032570. :SYSTEM-TYPE :LOGICAL :VERSION 7. :TYPE "LISP" :NAME "TRAVERSE" :DIRECTORY ("REL3-PUBLIC" "PUBLIC" "BENCH") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2753213382. :AUTHOR "REL3" :LENGTH-IN-BYTES 3047. :LENGTH-IN-BLOCKS 3. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ;;;-*- Mode:LISP; Package:CL-TRAVERSE; Base:10; Syntax: Common-lisp -*-;;; From the "Dick Gabriel" Benchmark Series.;;; Enhancements (C) Copyright 1983, Lisp Machine, Inc.;;;BEGIN;;;TRAVERSE;;; Benchmark to create once and traverse a Structure;(declare  (fasload struct fas dsk (mac lsp)))(defstruct (node (:conc-name nil))   (parents ())   (sons ())   (sn (snb))   (entry1 ())   (entry2 ())   (entry3 ())   (entry4 ())   (entry5 ())   (entry6 ())   (mark ()))(DEFPARAMETER sn 0)(defun snb () (setq sn (1+ sn)))(DEFPARAMETER rand 21.)(defun seed () (setq rand 21.))(defun random () (setq rand (mod (* rand 17.) 251.)))(defun remove (n q)       (cond ((eq (cdr (car q)) (car q))      (prog2 () (caar q) (rplaca q ())))     ((= n 0)      (prog2 () (caar q)     (do ((p (car q) (cdr p))) ((eq (cdr p) (car q))  (rplaca q  (rplacd p (cdr (car q))))))))     (t (do ((n n (1- n))     (q (car q) (cdr q))     (p (cdr (car q)) (cdr p)))    ((= n 0) (prog2 () (car q) (rplacd q p)))))))(defun select (n q)       (do ((n n (1- n))    (q (car q) (cdr q)))   ((= n 0) (car q))))(defun add (a q)       (cond ((null q)      `(,(let ((x `(,a)))      (rplacd x x) x)))     ((null (car q))      (let ((x `(,a)))   (rplacd x x)   (rplaca q x)))     (t (rplaca q(rplacd (car q) `(,a .,(cdr (car q))))))))(defun create-structure (n)       (let ((a `(,(make-node))))    (do ((m (1- n) (1- m)) (p a))((= m 0) (setq a `(,(rplacd p a))) (do ((unused a)      (used (add (remove 0 a) ()))      (x) (y))     ((null (car unused))      (find-root (select 0 used) n))     (setq x (remove (mod (random) n) unused))     (setq y (select (mod (random) n) used))     (add x used)     (setf (sons y) `(,x .,(sons y)))     (setf (parents x) `(,y .,(parents x))) ))(push (make-node) a))))(defun find-root (node n) (do ((n n (1- n)))     ((= n 0) node)     (cond ((null (parents node))    (return node))   (t (setq node (car (parents node)))))))(DEFPARAMETER traverse-count 0)(DEFPARAMETER marker ())(defun travers (node mark)       (cond ((eq (mark node) mark) ())     (t (setf (mark node) mark)(setq traverse-count (1+ traverse-count))(setf (entry1 node) (not (entry1 node)))(setf (entry2 node) (not (entry1 node)))(setf (entry3 node) (not (entry1 node)))(setf (entry4 node) (not (entry1 node)))(setf (entry5 node) (not (entry1 node)))(setf (entry6 node) (not (entry1 node)))(do ((sons (sons node) (cdr sons)))    ((null sons) ())    (travers (car sons) mark)))))(defun traverse (root)       (let ((traverse-count 0))    (travers root (setq marker (not marker)))    traverse-count));(include "timer.lsp")(DEFVAR root)(timer init-timit       (prog2 (setq root (create-structure 100.)) ()))       (timer timit       (do ((i 50. (1- i)))   ((= i 0))   (traverse root)   (traverse root)   (traverse root)   (traverse root)   (traverse root))) ;;;ENDCRO make-benchmark (&rest