;;; -*- Mode: Common-Lisp; Package: User; Base: 8.; Patch-File: T -*-
;;; Patch file for DEBUG-TOOLS version 6.3
;;; Reason: Altered GRIND-INTO-LIST-MAKE-ITEM to add a COND test on LOC parameter before using it in len calculation.
;;; Written 06/15/89 09:38:05 by CROWE,
;;; while running on Bravo from band LODA
;;; With SYSTEM 6.4, VIRTUAL-MEMORY 6.1, EH 6.0, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0,
;;;  BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.0, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.0, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.2, TV 6.6, DATALINK 6.0, CHAOSNET 6.0, GC 6.1, MEMORY-AUX 6.0, NVRAM 6.0,
;;;  SYSLOG 6.0, STREAMER-TAPE 6.0, UCL 6.0, INPUT-EDITOR 6.0, METER 6.0, ZWEI 6.0,
;;;  Experimental DEBUG-TOOLS 6.1, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.1, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.0,
;;;  IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.0, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.0, TI-CLOS 6.5, CLEH 6.0, IP 3.45,
;;;  Experimental BUG 11.6, CLX 6.0, CLUE 6.4, X11M 6.1,  microcode 429, Band Name: Release 6.0 + SLE 6/5

#!C
; From file INSPECT.LISP#> DEBUG-TOOLS; MR-X:
#8R TV#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "TV"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: DEBUG-TOOLS; INSPECT.#"


(DEFUN GRIND-INTO-LIST-MAKE-ITEM (THING LOC ATOM-P LEN)
  (LET ((IDX (IF GRIND-INTO-LIST-STRING
	       (ARRAY-ACTIVE-LENGTH GRIND-INTO-LIST-STRING)
	       0)))
    (COND
      (ATOM-P
         ;; An atom -- make an item for it.
       ;; ***  TAC 06-14-89 - figure out what kind of data loc is - avoid operations on it multiple times. 
       (LET ((data (COND ((CONSP loc) (CAR loc))
			 ((LOCATIVEP loc) (CONTENTS loc))
			 (t loc))))
	 (PUSH (LIST LOC :LOCATIVE IDX (+ IDX (if (stringp data)
						  (+ 1 (or (position #\cr data)
							   (1- (flatsize data))))
						  len)))
	       (CAR GRIND-INTO-LIST-ITEMS))))
      (T
       ;; Printing an interesting character
       (CASE THING
	 (sys:start-of-object
	  ;; Start of a list.
	  (PUSH (LIST LOC IDX GRIND-INTO-LIST-LINE () ()) GRIND-INTO-LIST-LIST-ITEM-STACK))
	 (sys:end-of-object
	  ;; Closing a list.
	  (LET ((ITEM (POP GRIND-INTO-LIST-LIST-ITEM-STACK)))
		;; 1+ is to account for close-paren which hasn't been
		;; typed yet. in rel2 next line was (1+ idx)
	    (SETF (FOURTH ITEM) IDX)
	    (SETF (FIFTH ITEM) GRIND-INTO-LIST-LINE)
	    (PUSH ITEM GRIND-INTO-LIST-LIST-ITEMS))))))))
))