(FILECREATED " 8-Feb-86 15:41:52" {DSK}<LISPFILES2>IMPROVEDDCOMS>FAIL.;1
 1838   

      changes to:  (VARS FAILCOMS))


(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)

(PRETTYCOMPRINT FAILCOMS)

(RPAQQ FAILCOMS
 ((CONSTANTS saved.B saved.B0 saved.BP saved.CE saved.CP saved.H saved.TR) (MACROS 
fast.fail index.fail) (FNS QP.NXTICP QP.PRUNEP R.fail W.fail) (ADDVARS (GLOBALVARS QP.NXTICP))))
(DECLARE: EVAL@COMPILE 

(RPAQQ saved.B
 -4)

(RPAQQ saved.B0
 2)

(RPAQQ saved.BP
 -3)

(RPAQQ saved.CE
 0)

(RPAQQ saved.CP
 1)

(RPAQQ saved.H
 -1)

(RPAQQ saved.TR
 -2)

(CONSTANTS saved.B saved.B0 saved.BP saved.CE saved.CP saved.H saved.TR)
)
(DECLARE: EVAL@COMPILE 
(PUTPROPS fast.fail MACRO (OPENLAMBDA NIL (put.24 R (add.cell B -7)) (put.24 E (get.addr R 5)) (until 
(same.addr TR E) DO (put.24 S (get.addr TR 0)) (increment.cell.pointer TR) (put.cell S 0 (tag.ref S)))
 (put.24 B0 (get.addr R 0)) (put.24 E (get.addr R 1)) (put.24 CP (get.addr R 2)) (put.24 H (get.addr R
 6)) (put.24 P (get.addr R 4)) (continue.at (get.24 P))))
(PUTPROPS index.fail MACRO (OPENLAMBDA NIL (put.24 R (add.cell B -7)) (continue.at (get.addr B 
saved.BP))))
)
(DEFINEQ

(QP.NXTICP

(LAMBDA (FIRST) (if (NOT (SMALLP FIRST)) then (SETQ QP.NXTICP FIRST)) (if (EQ QP.NXTICP QP.init.E) 
then (VALUES 0 0) else (VALUES (\ADDBASE (\GETBASEPTR QP.NXTICP -6) -1) (PROGN (SETQ QP.NXTICP (
\GETBASEPTR QP.NXTICP -8)) 0)))))

(QP.PRUNEP

(LAMBDA (Ptr COUNT) (IGREATERP (IPLUS (LLSH (IDIFFERENCE (\HILOC Ptr) (\HILOC QP.init.E)) 9) (LRSH (
IDIFFERENCE (\LOLOC Ptr) (\LOLOC QP.init.E)) 7)) COUNT)))

(R.fail

(LAMBDA NIL (fast.fail)))

(W.fail

(LAMBDA NIL (fast.fail)))
)

(ADDTOVAR GLOBALVARS
 QP.NXTICP)
(PUTPROPS FAIL COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1204 1714 (QP.NXTICP 1214 . 1459) (QP.PRUNEP 1461 . 1634) (R.fail 1636 . 1673) (W.fail 
1675 . 1712)))))
STOP