(FILECREATED "18-Mar-86 11:22:27" {ERIS}<LISP>KOTO>PATCHES>HPRINTPATCH.;1
 10254  

      changes to:  (VARS HPRINTPATCHCOMS))


(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT HPRINTPATCHCOMS)

(RPAQQ HPRINTPATCHCOMS
 ((FNS HVBAKREAD)))
(DEFINEQ

(HVBAKREAD

  [LAMBDA (FILE RDTBL BKRF)
                                            (* rrb 
                                                                           "17-Mar-86 17:36")

    (PROG (HV HV1 HV2 HV3 (RPTCNT 0)
              RPTVAL READVAL)
      READLP
          (SKIPSEPRS FILE RDTBL)
          (SELECTQ (SETQ HV (READC FILE))
              (}                                                           (* Empty printout 
                                                                           from false start for 
                                                                           HPRINTMACRO. Next char 
                                                                           should be { and be 
                                                                           default)

                 (SKIPSEPRS FILE RDTBL)
                 (COND
                    ((EQ (QUOTE {)
                         (READC FILE))
                     (GO READLP))
                    (T (HVREADERR))))
              (H                                                           (* Hash array)

                 [SETQ READVAL (COND
                                  ((EQ (SKIPSEPRS FILE RDTBL)
                                       (QUOTE %())
                                   (APPLY (FUNCTION HASHARRAY)
                                          (READ FILE RDTBL)))
                                  (T (HARRAY (RATOM FILE RDTBL]
                 (AND BKRF (FRPLACA BKRF READVAL))
                 (FRPTQ (RATOM FILE RDTBL)
                        (PROGN (SETQ HV (READ FILE RDTBL))
                               (PUTHASH (READ FILE RDTBL)
                                      HV READVAL)))
                 (HVREADEND FILE RDTBL))
              ((A Y) 
                                                                           (* array)

                   [SETQ READVAL (ARRAY (SETQ HV1 (READ FILE RDTBL))
                                        (SETQ HV2 (READ FILE RDTBL))
                                        NIL
                                        (SETQ HV3 (SELECTQ HV
                                                      (Y (READ FILE RDTBL))
                                                      1]
                   (AND BKRF (FRPLACA BKRF READVAL))
                   (FRPTQ (ARRAYSIZE READVAL)
                          (PROGN (SETA READVAL HV3 (HVRPTREAD FILE RDTBL))
                                 (add
 HV3 1)))
                   [AND (FIXP HV2)
                        (NOT (IEQP HV1 HV2))
                        (OR (EQ HV (QUOTE Y))
                            (NOT (ZEROP HV2)))
                        (for
 I from
 (ADD1 HV2) to
 HV1
                           do
 (SETD READVAL I (HVRPTREAD FILE RDTBL]
                   (HVREADEND FILE RDTBL))
              (($ ~) 
                                                                           (* DATATYPE)

                   (SETQ HV1 (RATOM FILE RDTBL))
                   [COND
                      ((EQ HV (QUOTE ~))                                   (* This should be a 
                                                                           previously known 
                                                                           datatype not specified 
                                                                           in file)

                       (SETQ HV2 (GETDESCRIPTORS HV1)))
                      ([NOT (SETQ HV2 (CDR (FASSOC HV1 DATATYPESEEN]
                       (SETQ HV2 (READ FILE RDTBL))
                       (OR (NULL (GETFIELDSPECS HV1))
                           (EQUAL HV2 (GETFIELDSPECS HV1))
                           (ERROR 
                 "attempt to read DATATYPE with different field specification than currently defined" 
                                  HV1))
                       (SETQ DATATYPESEEN (CONS (CONS HV1 (SETQ HV2 (/DECLAREDATATYPE HV1 HV2)))
                                                DATATYPESEEN]
                   (SETQ READVAL (NCREATE HV1))
                   (AND BKRF (FRPLACA BKRF READVAL))
                   (for
 X in
 HV2 do
 (REPLACEFIELD X READVAL (HVRPTREAD FILE RDTBL)))
                   (HVREADEND FILE RDTBL))
              (R                                                           (* repeat)

                 (AND BKRF (HVREADERR))
                 (RETURN HPRPTSTRING))
              (#                                                           (* Kludge for
                                                                           (VAG smallnumber))

                 (RETURN (PROG1 (VAG (RATOM FILE RDTBL))
                                (HVREADEND FILE RDTBL))))
              (!                                                           (* ! -
                                                                           value cell)

                 (RETURN (AT2VC (RATOM FILE RDTBL))))
              (D                                                           (* READTABLEP)

                 (SETQ READVAL (COPYREADTABLE (QUOTE ORIG)))
                 (AND BKRF (FRPLACA BKRF READVAL))
                 (for
 I in
 (READ FILE RDTBL) do
 (SETSYNTAX I (HVRPTREAD FILE RDTBL)
                                                                   READVAL))
                 (HVREADEND FILE RDTBL))
              (T                                                           (* TERMTABLEP)

                 (SETQ READVAL (COPYTERMTABLE (QUOTE ORIG)))
                 (AND BKRF (FRPLACA BKRF READVAL))
                 (while
 (SETQ HV (RATOM FILE RDTBL))
                    do
 (SELECTQ HV
                               (CONTROL (CONTROL T READVAL))
                               (ECHOMODE (ECHOMODE NIL READVAL))
                               ((UPARROW IGNORE REAL SIMULATE) 
                                    (ECHOCHAR (READ FILE RDTBL)
                                           HV READVAL))
                               ((CTRLV RETYPE LINEDELETE CHARDELETE EOL) 
                                    [MAPC (READ FILE FILERDTBL)
                                          (FUNCTION (LAMBDA (CH)
                                                      (SETSYNTAX CH HV READVAL])
                               ((DELETELINE 1STCHDEL NTHCHDEL POSTCHDEL EMPTYCHDEL) 
                                    (DELETECONTROL HV (READ FILE RDTBL)
                                           READVAL))
                               ((T 0) 
                                    (RAISE HV READVAL))
                               (NOECHO (DELETECONTROL (QUOTE NOECHO)
                                              NIL READVAL))
                               (HVREADERR)))
                 (HVREADEND FILE RDTBL))
              ((0 1 2 3 4 5 6 7 8 9) 
                                                                           (* immediately 
                                                                           followed by a number)

                   (AND BKRF (HVREADERR))                                  (* BACK REFERENCE -
                                                                           shouldn't be forward 
                                                                           reference as well)

                   (SETQ HV2 HV)
                   (while
 (SMALLP (SETQ HV (READC FILE))) do
 (SETQ HV2
                                                                      (IPLUS (ITIMES HV2 10)
                                                                             HV)))
                   (RETURN (OR [CAR (FNTH BACKREFS (ADD1 (IDIFFERENCE BACKREFCNT HV2]
                               (HVREADERR))))
              (%(                                                          (* form that should 
                                                                           be evaluated with its 
                                                                           first argument replaced 
                                                                           with the file being 
                                                                           read. This is the case 
                                                                           that handle IMAGEOBJs.)

                  (SETQ READVAL
                   (PROG1 [APPLY (READ FILE RDTBL)
                                 (CONS FILE (PROGN                         (* dump the first 
                                                                           argument which is a 
                                                                           dummy so that the call 
                                                                           that is on the file 
                                                                           looks like a realy 
                                                                           call.)

                                                   (CDR (until
 (PROGN (SKIPSEPRS FILE RDTBL)
                                                                          (EQ (PEEKC FILE)
                                                                              (QUOTE %))))
                                                           collect
 (EVAL (READ FILE RDTBL))
                                                           finally
     (* read the closing
                                                                           (QUOTE %)))

                                                                 (RATOM FILE RDTBL]
                          (HVREADEND FILE RDTBL)))
                  (AND BKRF (FRPLACA BKRF READVAL))
                  (RETURN READVAL))
              (HVREADERR))
          (OR (ZEROP RPTCNT)
              (HVREADERR))
          (RETURN READVAL])
)
(PUTPROPS HPRINTPATCH COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (281 10172 (HVBAKREAD 291 . 10170)))))
STOP