acuff@SUMEX-AIM.STANFORD.EDU (Richard Acuff) (02/13/91)
EXPLORER (TM) BUG REPORT
DATE-TIME : 12-Feb-91 16:34:47
PRIORITY : H (H)igh (M)edium (L)ow
TYPE : B (B)ug (D)esign (M)anual
MACHINE-TYPE: M (E)xplorer (M)icroExplorer
DESCRIPTION-OF-PROBLEM:
Evaluating the following results in the error backtraced below:
(read-from-string "(test #+non-feature (test . #+TI foo #-TI bar))")
When the reader sees "#+non-feature" it goes into read suppression mode.
In this mode it doesn't expand the macros which would result in the
"#+TI foo #-TI bar" clauses getting reduced to one ojbect, and so ends up
thinking there is more than one object after the ".".
WORK-AROUND:
The following simple change to SYS:INTERNAL-READ-LIST causes it to not
care if there is more than one thing after a ".". Commented with RDA.
sys:
(defun internal-read-list (stream &optional character)
(let* ((thelist nil)
(listtail (locf thelist))
(top-level-list top-level-list)
correspondence-entry)
(when (and read-Check-Indentation Last-Whitespace (Char= Last-Whitespace #\Cr)
(null *read-suppress*)) ;;we are truly reading, not skipping things
(If (Null Top-Level-List)
(unless (and (listp xr-list-so-far) ; PDC 8/7/86
(symbolp (car xr-list-so-far))
(get (car xr-list-so-far) 'may-surround-defun))
(progn
(signal-proceed-case (() 'sys:missing-closeparen
"Open paren found in column zero; missing closeparens assumed.")
(:no-action))
(setf missing-close-paren t)
(unread-char #\( stream)
(setf xr-splice-p t)
(return-from internal-read-list nil)))))
(setf last-whitespace nil)
(setf missing-close-paren nil)
(setf top-level-list nil)
(when xr-correspondence-flag
(unread-char character stream)
(setq correspondence-entry `(nil ,(funcall stream :read-bp) ,@xr-correspondence))
(setq xr-correspondence correspondence-entry) (read-char stream))
(do ((firstchar (flush-whitespace stream) (flush-whitespace stream)))
((char= firstchar #\))
(when xr-correspondence-flag (rplaca correspondence-entry thelist))
thelist)
(when (char= firstchar #\.)
(let ((nextchar (internal-read-char stream t)))
;;RDA: Don't get error because several reader macros which
;;would result in one object if evaluated follow a dot when
;;we're not evaluating the macros. Add (UNLESS *READ-SUPPRESS*
(unless *read-suppress*
(cond ((token-delimiterp nextchar)
(cond ((eq listtail (locf thelist))
(cerror :no-action nil 'sys:read-error-1
"Nothing appears before . in list."))
((whitespacep nextchar)
(setq nextchar (flush-whitespace stream))))
(rplacd listtail
(let* ((XR-LIST-SO-FAR ':AFTER-DOT)
(XR-SPLICE-P NIL)
(values (read-after-dot stream nextchar)))
(WHEN XR-SPLICE-P
(return XR-LIST-SO-FAR))
;;return list containing last thing.
(car values)))
(when xr-correspondence-flag (rplaca correspondence-entry thelist))
(return thelist))
;;put back nextchar so we can read it normally.
(t (unread-char nextchar stream))))))
;;next thing is not an isolated dot.
(let* ((XR-LIST-SO-FAR thelist)
(XR-SPLICE-P NIL)
(listobj (read-maybe-nothing stream firstchar)))
(COND (XR-SPLICE-P
(SETQ theLIST XR-LIST-SO-FAR)
(SETQ listtail
(COND ((ATOM theLIST) (LOCF theLIST))
( (LAST theLIST)))))
;;allows the possibility that a comment was read.
(t (when listobj
(rplacd listtail listobj)
(setq listtail listobj)))))
(when (and missing-close-paren (null top-level-list))
(when xr-correspondence-flag (rplaca correspondence-entry thelist))
(return thelist))
)))
TI Number:
Submitter: Acuff
CUSTOMER-ID: 172
NAME : Richard Acuff
LOCATION : WR C101 Acuff
ADDRESS : 701 Welch Rd., Bldg. C, Stanford, CA 94305
PHONE : (415) 723-2225
NET-ADDRESS: Richard Acuff <acuff@SUMEX-AIM.Stanford.EDU>
BACKTRACE:
>>Error: More than one object follows . in list.
Backtrace from the debugger:
Open catches below this frame for tags: T, T, UCL::COMMAND-ABORT, #:G2376, ("Return to Lisp Listener top level."), UCL::EXIT-COMMAND-LOOP.
SYS::READ-AFTER-DOT (P.C. = 48)
Arg 0 (STREAM): SYS::READ-FROM-STRING-STREAM
Arg 1 (FIRSTCHAR): #\#
Local 0 (LASTOBJ): (NIL)
Local 1 (CHAR): #\f
Local 2 (LASTCHAR): #\b
Disassembled code:
45 PUSH FEF|7 ; 'SYS:READ-ERROR-1
46 PUSH FEF|9 ; '"More than one object follows . in list."
47 TEST CALL-4 FEF|10 ; #'CERROR
=> 48 PUSH ARG|0 ; STREAM
49 PUSH CALL-1 FEF|4 ; #'SYS::FLUSH-WHITESPACE
50 MOVEM LOCAL|2 ; LASTCHAR
No specials bound in this frame
Values to be collected for MULTIPLE-VALUE-LIST.
Open catches below this frame for tags: T, T, UCL::COMMAND-ABORT, #:G2376, ("Return to Lisp Listener top level."), UCL::EXIT-COMMAND-LOOP.
SYS::INTERNAL-READ-LIST (P.C. = 169)
Arg 0 (STREAM): SYS::READ-FROM-STRING-STREAM
Arg 1 (CHARACTER): #\(
Local 0 (THELIST): (NIL)
Local 1 (LISTTAIL): (NIL)
Local 2 (CORRESPONDENCE-ENTRY): NIL
Local 3: NIL
Local 4 (FIRSTCHAR): #\.
Local 5 (NEXTCHAR): #\#
Local 6 (VALUES): NIL
Local 7 (LISTOBJ): (NIL)
Disassembled code:
166 PUSH ARG|0 ; STREAM
167 PUSH LOCAL|5 ; NEXTCHAR
168 PUSH CALL-2 FEF|34 ; #'SYS::READ-AFTER-DOT
=> 169 POP LOCAL|6 ; VALUES
170 TEST FEF|5 ; SYS::XR-SPLICE-P
171 BR-NULL 173
Names and values of specials bound in this frame:
SYS::TOP-LEVEL-LIST: NIL
SYS::XR-LIST-SO-FAR: :AFTER-DOT
SYS::XR-SPLICE-P: NIL
Open catches below this frame for tags: T, UCL::COMMAND-ABORT, #:G2376, ("Return to Lisp Listener top level."), UCL::EXIT-COMMAND-LOOP.
Open catches in this frame for tag: T.
SYS::READ-PRESERVING-WHITESPACE* (P.C. = 226)
Arg 0 (STREAM): SYS::READ-FROM-STRING-STREAM
Arg 1 (EOF-ERRORP): T
Arg 2 (EOF-VALUE): NIL
Arg 3 (RECURSIVEP): T
Local 0 (TEMP): NIL
Local 1: NIL
Local 2 (CHAR): #\(
Local 3 (MACROFUN): SYS::INTERNAL-READ-LIST
Local 4 (RESULT): NIL
Names and values of specials bound in this frame:
SYS::XR-SPLICE-P: NIL
Open catches below this frame for tags: T, UCL::COMMAND-ABORT, #:G2376, ("Return to Lisp Listener top level."), UCL::EXIT-COMMAND-LOOP.
READ-PRESERVING-WHITESPACE (P.C. = 70)
Arg 0 (STREAM): SYS::READ-FROM-STRING-STREAM
Arg 1 (EOF-ERRORP): T
Arg 2 (EOF-VALUE): NIL
Arg 3 (RECURSIVEP): T
Values to be collected for MULTIPLE-VALUE-LIST.
Open catches below this frame for tags: T, UCL::COMMAND-ABORT, #:G2376, ("Return to Lisp Listener top level."), UCL::EXIT-COMMAND-LOOP.
SYS::SHARP-PLUS (P.C. = 44)
Arg 0 (STREAM): SYS::READ-FROM-STRING-STREAM
Arg 1 (IGNORE): #\+
Arg 2 (IGNORE): NIL
Local 0 (FEATURE): :NON-FEATURE
Values to be collected for MULTIPLE-VALUE-LIST.
Open catches below this frame for tags: T, UCL::COMMAND-ABORT, #:G2376, ("Return to Lisp Listener top level."), UCL::EXIT-COMMAND-LOOP.
SYS::READ-DISPATCH-CHAR (P.C. = 82)
Arg 0 (STREAM): SYS::READ-FROM-STRING-STREAM
Arg 1 (CHAR): #\#
Local 0 (NUMARGP): NIL
Local 1 (NUMARG): 0
Local 2 (SUB-CHAR): #\+
Local 3 (CH): #\+
Local 4 (DIG): NIL
Local 5 (LIST): ((#\# . #<ART-Q-256 40662433>))
Local 6 (EL): (#\# . #<ART-Q-256 40662433>)
Local 7 (DPAIR): (#\# . #<ART-Q-256 40662433>)
Open catches below this frame for tags: T, UCL::COMMAND-ABORT, #:G2376, ("Return to Lisp Listener top level."), UCL::EXIT-COMMAND-LOOP.
SYS::READ-MAYBE-NOTHING (P.C. = 19)
Arg 0 (STREAM): SYS::READ-FROM-STRING-STREAM
Arg 1 (CHAR): #\#
Local 0 (RETVAL): NIL
Values to be collected for MULTIPLE-VALUE-LIST.
Open catches below this frame for tags: T, UCL::COMMAND-ABORT, #:G2376, ("Return to Lisp Listener top level."), UCL::EXIT-COMMAND-LOOP.
SYS::INTERNAL-READ-LIST (P.C. = 191)
Arg 0 (STREAM): SYS::READ-FROM-STRING-STREAM
Arg 1 (CHARACTER): #\(
Local 0 (THELIST): (TEST)
Local 1 (LISTTAIL): (TEST)
Local 2 (CORRESPONDENCE-ENTRY): NIL
Local 3: NIL
Local 4 (FIRSTCHAR): #\#
Local 5 (NEXTCHAR): NIL
Local 6 (VALUES): NIL
Local 7 (LISTOBJ): (TEST)
Open catches below this frame for tags: UCL::COMMAND-ABORT, #:G2376, ("Return to Lisp Listener top level."), UCL::EXIT-COMMAND-LOOP.
Open catches in this frame for tag: T.
SYS::READ-PRESERVING-WHITESPACE* (P.C. = 226)
Arg 0 (STREAM): SYS::READ-FROM-STRING-STREAM
Arg 1 (EOF-ERRORP): T
Arg 2 (EOF-VALUE): NIL
Arg 3 (RECURSIVEP): NIL
Local 0 (TEMP): (T .
"NON-FEATURETRINGDA-LIST-READ-SUPPRESSTTREAM
Local 1: NIL
Local 2 (CHAR): #\(
Local 3 (MACROFUN): SYS::INTERNAL-READ-LIST
Local 4 (RESULT): NIL
Open catches below this frame for tags: UCL::COMMAND-ABORT, #:G2376, ("Return to Lisp Listener top level."), UCL::EXIT-COMMAND-LOOP.
READ (P.C. = 116)
Arg 0 (STREAM): SYS::READ-FROM-STRING-STREAM
Arg 1 (EOF-ERRORP): T
Arg 2 (EOF-VALUE): NIL
Arg 3 (RECURSIVEP): NIL
Arg 4 (PRESERVE-WHITESPACE): NIL
--Defaulted args:--
Arg 5 (DISCARD-CLOSE-PARENS): NIL
Arg 6 (CHECK-INDENT): NIL
Local 0 (W-O): (:TYI :UNTYI :GET-STRING-INDEX)
Local 1 (WHITECHAR): NIL
Remainder of stack:
READ-FROM-STRING (P.C. = 43)
SYS:*EVAL (P.C. = 560)
EVALHOOK (P.C. = 43)
SYS:*EVAL (P.C. = 560)
(:METHOD UCL::TOP-LEVEL-FUNCTIONS :EXECUTE) (P.C. = 84)
(:METHOD UCL:BASIC-COMMAND-LOOP :EXECUTE-COMMAND) (P.C. = 44)
UCL::PROCESS-TYPEIN (P.C. = 101)
(:METHOD UCL:BASIC-COMMAND-LOOP :HANDLE-TYPEIN-INPUT) (P.C. = 28)
(:METHOD TV::RH-COMMAND :EXECUTE) (P.C. = 69)
(:METHOD UCL:BASIC-COMMAND-LOOP :EXECUTE-COMMAND) (P.C. = 44)
(:METHOD UCL:BASIC-COMMAND-LOOP :HANDLE-KEY-INPUT) (P.C. = 52)
(:METHOD UCL:BASIC-COMMAND-LOOP :FETCH-AND-EXECUTE) (P.C. = 72)
(:METHOD W::LISP-LISTENER :LOOP) (P.C. = 114)
(:METHOD UCL:COMMAND-LOOP-MIXIN :COMMAND-LOOP) (P.C. = 58)
SYS::PROCESS-TOP-LEVEL (P.C. = 155)
SOFTWARE-CONFIGURATION:
With SYSTEM 6.41, GC 6.7, VIRTUAL-MEMORY 6.3, MICRONET 6.0,
MICRONET-COMM 6.4, DISK-IO 6.4, DISK-LABEL 6.1, BASIC-PATHNAME 6.5,
MAC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.8,
BASIC-FILE 6.15, RPC 6.2, NFS-MX 6.9, EH 6.8, MAKE-SYSTEM 6.5,
MEMORY-AUX 6.0, COMPILER 6.18, TV 6.32, NVRAM 6.4, UCL 6.1,
INPUT-EDITOR 6.1, MACTOOLBOX 2.25, METER 6.2, ZWEI 6.28, DEBUG-TOOLS 6.5,
WINDOW-MX 6.12, PRINTER 6.8, MAC-PRINTER-TYPES 6.2, CLIPBOARD 6.1,
TI-CLOS 6.53, CLEH 6.5, NETWORK-PATHNAME 6.2, NETWORK-NAMESPACE 6.1,
DATALINK 6.0, CHAOSNET 6.9, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.3,
DATALINK-DISPLAYS 6.0, MX-DATALINK 6.1, NAMESPACE-EDITOR 6.7, IP 3.65,
NFS-MX-SERVER 6.0, MX-SERIAL 6.2, PRINTER-TYPES 6.2, IMAGEN 6.1,
MAIL-DAEMON 6.6, MAIL-READER 6.9, TELNET 6.1, VT100 6.0,
STREAMER-TAPE 6.6, DECNET 1.72, VISIDOC 6.7, PROFILE 6.3,
Experimental KSL-PATCHES 10.5, microcode 195, Band Name: 6.1(41),
KSL9 10.2, 17-Jan, Host: KSL-Mac-62
HARDWARE-CONFIGURATION:
microExplorer, Microcode MX-UCODE 195 for the Explorer Lisp Microprocessor