(FILECREATED "24-Apr-86 09:13:46" {DSK}<LISPFILES2>DCOMS>FAIL.;3 2012
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)))
(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) (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 (CHOICE) (while (\BASELESSP QP.init.E CHOICE) do (LET* ((CLAUSE (\ADDBASE (\GETBASEPTR CHOICE
-6) -1)) (B (\GETBASE CLAUSE 1))) (if (AND (EQ (LOGAND (\LOLOC CLAUSE) 1) 0) (OR (EQ B (CONSTANT (
QP.OP.CODE (QUOTE retry.at)))) (EQ B (CONSTANT (QP.OP.CODE (QUOTE fail.on.retry))))) (EQ (\GETBASE
CLAUSE 0) (CONSTANT (QP.OP.CODE (QUOTE ignore.me))))) then (RETFROM (QUOTE QP.NXTICP) (VALUES CLAUSE (
\GETBASEPTR CHOICE -8))))) (SETQ CHOICE (\GETBASEPTR CHOICE -8))) (VALUES 0 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)))
)
(PUTPROPS FAIL COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1160 1925 (QP.NXTICP 1170 . 1670) (QP.PRUNEP 1672 . 1845) (R.fail 1847 . 1884) (W.fail
1886 . 1923)))))
STOP