Issues in compiling SDRAW from Touretzky's _Common Lisp: A Gentle Introduction to Symbolic Computation_

Greetings,

Just now, I tried compiling the SDRAW tool from the book _Common Lisp:
A Gentle Introduction to Symbolic Computation_, by David S. Touretzky,
using the Personal Edition of LispWorks 7.1.2 (Windows (64-bit));
however, I ran into the following error message:

----- quoted text follows immediately after this line -----
; SDRAW::SCRAWL1
; SDRAW::SCRAWL-CAR-CMD
; SDRAW::SCRAWL-CDR-CMD
; SDRAW::SCRAWL-BACK-UP-CMD
; SDRAW::SCRAWL-START-CMD

**++++ Error between functions:
  Subcharacter #\’ not defined for dispatch char #\#.

**++++ Error between functions:
  Subcharacter #\’ not defined for dispatch char #\#.
; SDRAW::DISPLAY-SCRAWL-RESULT
; SDRAW::DISPLAY-SCRAWL-HELP
; SDRAW::DISPLAY-SCRAWL-ERROR
; SDRAW::READ-UPPERCASE-CHAR
;; Processing Cross Reference Information

The following functions are undefined:
SDRAW::EXTRACT-OBJ which is referenced by SDRAW::SCRAWL-BACK-UP-CMD
SDRAW::GET-CAR/CDR-STRING which is referenced by
SDRAW::DISPLAY-SCRAWL-RESULT
SDRAW::DRAW-STRUCTURE which is referenced by SDRAW::SDRAW
SDRAW::STRUCT1 which is referenced by SDRAW::STRUCT-PROCESS-CONS and
SDRAW::SDRAW
; *** 3 errors detected, no fasl file produced.
;;; Compilation finished with 0 warnings, 3 errors, 0 notes.

---- Done ----
----- quoted text ends immediately before this line -----

The source code (included in the text) that I tried to compile was as
follows:

----- quoted text follows immediately after this line -----
;;; -*- Mode: Lisp; Package: SDRAW -*-
;;;
;;; SDRAW - draws cons cell structures.
;;; From the book "Common Lisp: A Gentle Introduction to
;;; Symbolic Computation" by David S. Touretzky.
;;; The Benjamin/Cummings Publishing Co., 1989.
;;;
;;; User-level routines:
;;; (SDRAW obj) - draws obj on the terminal
;;; (SDRAW-LOOP) - puts the user in a read-eval-draw loop
;;; (SCRAWL obj) - interactively crawl around obj
(in-package "SDRAW")
(export ’(sdraw::sdraw sdraw::sdraw-loop sdraw::scrawl))
(shadowing-import ’(sdraw::sdraw sdraw::sdraw-loop sdraw::scrawl)
(find-package "USER"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The parameters below are in units of characters (horizontal)
;;; and lines (vertical). They apply to all versions of SDRAW,
;;; but their values may change if cons cells are being drawn as
;;; bit maps rather than as character sequences.
(defparameter *sdraw-display-width* 79.)
(defparameter *sdraw-horizontal-atom-cutoff* 79.)
(defparameter *sdraw-horizontal-cons-cutoff* 65.)
(defparameter *etc-string* "etc.")
(defparameter *circ-string* "circ.")
(defparameter *etc-spacing* 4.)
(defparameter *circ-spacing* 5.)
(defparameter *inter-atom-h-spacing* 3.)
(defparameter *cons-atom-h-arrow-length* 9.)
(defparameter *inter-cons-v-arrow-length* 3.)
(defparameter *cons-v-arrow-offset-threshold* 2.)
(defparameter *cons-v-arrow-offset-value* 1.)
(defparameter *sdraw-vertical-cutoff* 22.)
(defparameter *sdraw-num-lines* 25)
(defvar *line-endings* (make-array *sdraw-num-lines*))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; SDRAW and subordinate definitions.
(defun sdraw (obj)
(fill *line-endings* most-negative-fixnum)
(draw-structure (struct1 obj 0 0 nil))
(values))
(defun struct1 (obj row root-col obj-memory)
(cond ((atom obj)
(struct-process-atom (format nil "~S" obj) row root-col))
((member obj obj-memory :test #’eq)
(struct-process-circ row root-col))
((>= row *sdraw-vertical-cutoff*)
(struct-process-etc row root-col))
(t (struct-process-cons obj row root-col
(cons obj obj-memory)))))
(defun struct-process-atom (atom-string row root-col)
(let* ((start-col (struct-find-start row root-col))
(end-col (+ start-col (length atom-string))))
(cond ((< end-col *sdraw-horizontal-atom-cutoff*)
(struct-record-position row end-col)
(list ’atom row start-col atom-string))
(t (struct-process-etc row root-col)))))
(defun struct-process-etc (row root-col)
(let ((start-col (struct-find-start row root-col)))
(struct-record-position
row
(+ start-col (length *etc-string*) *etc-spacing*))
(list ’msg row start-col *etc-string*)))
(defun struct-process-circ (row root-col)
(let ((start-col (struct-find-start row root-col)))
(struct-record-position
row
(+ start-col (length *circ-string*) *circ-spacing*))
(list ’msg row start-col *circ-string*)))
(defun struct-process-cons (obj row root-col obj-memory)
(let* ((cons-start (struct-find-start row root-col))
(car-structure
(struct1 (car obj)
(+ row *inter-cons-v-arrow-length*)
cons-start obj-memory))
(start-col (third car-structure)))
(if (>= start-col *sdraw-horizontal-cons-cutoff*)
(struct-process-etc row root-col)
(list ’cons row start-col car-structure
(struct1 (cdr obj) row
(+ start-col *cons-atom-h-arrow-length*)
obj-memory)))))
(defun struct-find-start (row root-col)
(max root-col (+ *inter-atom-h-spacing*
(aref *line-endings* row))))
(defun struct-record-position (row end-col)
(setf (aref *line-endings* row) end-col))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; SDRAW-LOOP and subordinate definitions.
(defparameter *sdraw-loop-prompt-string* "S> ")
(defun sdraw-loop ()
"Read-eval-print loop using sdraw to display results."
(format t "~&Type any Lisp expression, or (ABORT) to exit.~%~%")
(sdl1))
(defun sdl1 ()
(loop
(format t "~&~A" *sdraw-loop-prompt-string*)
(let ((form (read)))
(setf +++ ++
++ +
+ -
- form)
(let ((result (multiple-value-list
(handler-case (eval form)
(error (condx) condx)))))
(typecase (first result)
(error (display-sdl-error result))
(t (setf /// //
// /
/ result
*** **
** *
* (first result))
(display-sdl-result *)))))))
(defun display-sdl-result (result)
(let* ((*print-circle* t)
(*print-length* nil)
(*print-level* nil)
(*print-pretty* nil)
(full-text (format nil "Result: ~S" result))
(text (if (> (length full-text)
*sdraw-display-width*)
(concatenate ’string
(subseq full-text 0 (- *sdraw-display-width* 4))
"...)")
full-text)))
(sdraw result)
(if (consp result)
(format t "~%~A~%" text))
(terpri)))
(defun display-sdl-error (error)
(format t "~A~%~%" error))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; SCRAWL and subordinate definitions.
(defparameter *scrawl-prompt-string* "SCRAWL> ")
(defvar *scrawl-object* nil)
(defvar *scrawl-current-obj*)
(defvar *extracting-sequence* nil)
(defun scrawl (obj)
"Read-eval-print loop to travel through list"
(format t "~&Crawl through list: ’H’ for help, ’Q’ to quit.~%~%")
(setf *scrawl-object* obj)
(setf *scrawl-current-obj* obj)
(setf *extracting-sequence* nil)
(sdraw obj)
(scrawl1))
(defun scrawl1 ()
(loop
(format t "~&~A" *scrawl-prompt-string*)
(let ((command (read-uppercase-char)))
(case command
(#\A (scrawl-car-cmd))
(#\D (scrawl-cdr-cmd))
(#\B (scrawl-back-up-cmd))
(#\S (scrawl-start-cmd))
(#\H (display-scrawl-help))
(#\Q (return))
(t (display-scrawl-error))))))
(defun scrawl-car-cmd ()
(cond ((consp *scrawl-current-obj*)
(push ’car *extracting-sequence*)
(setf *scrawl-current-obj* (car *scrawl-current-obj*)))
(t (format t
"~&Can’t take CAR or CDR of an atom. Use B to back up.~%")))
(display-scrawl-result))
(defun scrawl-cdr-cmd ()
(cond ((consp *scrawl-current-obj*)
(push ’cdr *extracting-sequence*)
(setf *scrawl-current-obj* (cdr *scrawl-current-obj*)))
(t (format t
"~&Can’t take CAR or CDR of an atom. Use B to back up.~%")))
(display-scrawl-result))
(defun scrawl-back-up-cmd ()
(cond (*extracting-sequence*
(pop *extracting-sequence*)
(setf *scrawl-current-obj*
(extract-obj *extracting-sequence* *scrawl-object*)))
(t (format t "~&Already at beginning of object.")))
(display-scrawl-result))
(defun scrawl-start-cmd ()
(setf *scrawl-current-obj* *scrawl-object*)
(setf *extracting-sequence* nil)
(display-scrawl-result))
(defun extract-obj (seq obj)
(reduce #’funcall
seq
:initial-value obj
:from-end t))
(defun get-car/cdr-string ()
(if (null *extracting-sequence*)
(format nil "’~S" *scrawl-object*)
(format nil "(c~Ar ’~S)"
(map ’string #’(lambda (x)
(ecase x
(car #\a)
(cdr #\d)))
*extracting-sequence*)
*scrawl-object*)))

(defun display-scrawl-result (&aux (*print-pretty* nil)
(*print-length* nil)
(*print-level* nil)
(*print-circle* t))
(let* ((extract-string (get-car/cdr-string))
(text (if (> (length extract-string) *sdraw-display-width*)
(concatenate ’string
(subseq extract-string 0
(- *sdraw-display-width* 4))
"...)")
extract-string)))
(sdraw *scrawl-current-obj*)
(format t "~&~%~A~%~%" text)))
(defun display-scrawl-help ()
(format t "~&Legal commands: A)car D)cdr B)back up~%")
(format t "~& S)start Q)quit H)help~%"))
(defun display-scrawl-error ()
(format t "~&Illegal command.~%")
(display-scrawl-help))
(defun read-uppercase-char ()
(let ((response (read-line)))
(and (plusp (length response))
(char-upcase (char response 0)))))
----- quoted text ends immediately before this line -----

What did I do wrong?
-- 
Benjamin L. Russell  /   DekuDekuplex at Yahoo dot com
http://dekudekuplex.wordpress.com/
Computer Science Document Translator/Editor
"Furuike ya, kawazu tobikomu mizu no oto." -- Matsuo Basho^

_______________________________________________
Lisp Hug - the mailing list for LispWorks users
lisp-hug@lispworks.com
http://www.lispworks.com/support/lisp-hug.html