🚀 go-pugleaf

      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