home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8707 / 49 / tprint.cl < prev    next >
Encoding:
Text File  |  1990-07-13  |  1.1 KB  |  37 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ; File:         tprint.cl
  3. ; Description:  TPRINT benchmark from the Gabriel tests
  4. ; Author:       Richard Gabriel
  5. ; Created:      12-Apr-85
  6. ; Modified:     19-Jul-85 19:05:26 (Bob Shaw)
  7. ; Language:     Common Lisp
  8. ; Package:      User
  9. ; Status:       Public Domain
  10. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11.  
  12. ;;; TPRINT -- Benchmark to print and read to the terminal.
  13.  
  14. (defvar ttest-atoms '(abc1 cde2 efg3 ghi4 ijk5 klm6 mno7 opq8 qrs9
  15.               stu0 uvw1 wxy2 xyz3 \123a \234b \345c \456d 
  16.               \567d \678e \789f \890g))
  17.  
  18. (defun init (m n atoms)
  19.   (let ((atoms (subst () () atoms)))
  20.     (do ((a atoms (cdr a)))
  21.     ((null (cdr a)) (rplacd a atoms)))
  22.     (init-aux m n atoms)))
  23.  
  24. (defun init-aux (m n atoms)
  25.   (cond ((= m 0) (pop atoms))
  26.     (t (do ((i n (- i 2))
  27.         (a ()))
  28.            ((< i 1) a)
  29.          (push (pop atoms) a)
  30.          (push (init-aux (1- m) n atoms) a)))))
  31.  
  32. (defvar ttest-pattern (init 6 6 ttest-atoms))
  33.  
  34. ;;; call:  (print ttest-pattern)
  35.  
  36. (run-benchmark "Tprint" '(print ttest-pattern))
  37.