(FILECREATED " 2-Feb-86 18:32:05" {DSK}<LISPFILES2>INDEX.LSP;2 8581
changes to: (VARS INDEXCOMS))
(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)
(PRETTYCOMPRINT INDEXCOMS)
(RPAQQ INDEXCOMS ((MACROS create.choice.point get.link hashed.index index index.2 restore.registers
restore.registers.2 save.registers set.top.of.stack)
(FNS R.either R.jump.to R.just.index.else R.just.me.else R.or R.or.finally
R.retry.index.else R.retry.me.else R.trust.index.else R.trust.me.else
R.try.index.else R.try.me.else W.either W.jump.to)))
(DECLARE: EVAL@COMPILE
(PUTPROPS create.choice.point MACRO (OPENLAMBDA NIL (* needed R)
(put.addr R 0 (get.24 B0))
(put.addr R 1 (get.24 E))
(put.addr R 2 (get.24 CP))
(put.addr R 3 (get.24 B))
(put.addr R 4 (address.operand))
(put.addr R 5 (get.24 TR))
(put.addr R 6 (get.24 H))
(put.24 B (add.cell R 7))
(put.24 HB (get.24 H))
(check.stack B)))
(PUTPROPS get.link MACRO (X (APPLY (FUNCTION (LAMBDA (N)
(BQUOTE (\GETBASEPTR (get.24 P)
(\, (Twice N 1))))))
X)))
(PUTPROPS hashed.index MACRO (OPENLAMBDA NIL (put.16 I (get.code P 1))
(put.16 I (LOGAND (get.16 I)
(\GET.LO.16 T0)))
(put.24 R (get.link 4))
(put.32 T1 (get.cell R (get.16 I)))
(* scratch I R)
(* defined S T0)
(select.4 T1 (0 (fast.fail))
(8 (put.24 R (untag.struct T1))
(put.32 T1 (get.cell R 0))
(if (same.cell T0 T1)
then
(continue.at (add.cell R 1))
else
(fast.fail)))
(128 (put.24 R (untag.list T1))
(until (NULL (get.24 R))
(put.24 P (get.addr R 1))
(put.32 T1 (get.cell P 0))
(if (same.cell T0 T1)
then
(RETFROM (QUOTE R.just.index.else)
(continue.at
(add.cell P 1))))
(put.24 R (get.addr R 0)))
(fast.fail))
(SHOULDNT (QUOTE hashed.index)))))
(PUTPROPS index MACRO (OPENLAMBDA NIL (put.32 T0 (get.Aval 1))
(select.16 T0 (ref.tag.8 (put.24 R (untag.ref T0))
(put.32 T0 (get.cell R 0))
(reselect.when.bound T0 R)
(continue.at (get.link 1)))
(list.tag.8 (put.24 S (untag.list T0))
(continue.at (get.link 3)))
(struct.tag.8 (put.24 S (untag.struct T0))
(put.32 T0 (get.cell S 0))
(increment.cell.pointer S)
(hashed.index))
(symbol.tag.8 (hashed.index))
(immed.tag.8 (hashed.index))
(PROGN (continue.at (get.link 1))))))
(PUTPROPS
index.2 MACRO
(X (APPLY (FUNCTION (LAMBDA
(fail OP)
(BQUOTE (PROG NIL SELECT (SELECTC (ReadPrologTag T1)
(ref.tag.8 (put.24 S (untag.ref T1))
(put.32 T1 (get.cell S 0))
(reselect.when.bound T1 S)
(RETURN (continue.at
(get.link 1))))
(list.tag.8 (put.24 S (untag.list T1)))
(struct.tag.8 (put.24 S (untag.struct
T1))
(put.32 T1 (get.cell S 0))
(increment.cell.pointer
S))
(symbol.tag.8)
(immed.tag.8)
(PROGN (RETURN (continue.at (get.link
1)))))
(\, OP)
(if (EQ (ReadPrologTag T1)
list.tag.8)
then
(put.24 P (get.link 3))
else
(put.16 I (get.code P 1))
(put.16 I (LOGAND (get.16 I)
(\GET.LO.16 T1)))
(put.24 R (get.link 4))
(put.32 T0 (get.cell R (get.16 I)))
(* scratch I R P)
(* defined S T1)
(SELECTC (ReadPrologTag T0)
(0 (RETURN ((\, fail))))
(8 (put.24 R (untag.struct T0))
(put.32 T0 (get.cell R 0))
(if (same.cell T0 T1)
then
(put.24 P (add.cell R 1))
else
(RETURN ((\, fail)))))
(128 (put.24 R (untag.list T0))
(if (PROG NIL L (put.24 P (get.addr R 1))
(put.32 T0 (get.cell P 0))
(if (same.cell T0 T1)
then
(put.24 P (add.cell P 1))
(RETURN NIL))
(put.24 R (get.addr R 0))
(if (NULL (get.24 R))
then
(RETURN T))
(GO L))
then
(RETURN ((\, fail)))))
(SHOULDNT (QUOTE hashed.index))))
(RETURN (continue.at (get.24 P)))))))
X)))
(PUTPROPS restore.registers MACRO (OPENLAMBDA NIL (* needed R)
(* defined C S)
(* scratch HB)
(decrement.cell.pointer R 6)
(put.24 C (get.addr R 5))
(put.24 S (get.addr R 4))
(put.Aval 1 (get.cell R 3))
(put.Aval 2 (get.cell R 2))
(put.Aval 3 (get.cell R 1))
(put.Aval 4 (get.cell R 0))
(put.16 I (PROC.ARITY (get.24 C)))
(if (IGREATERP (get.16 I)
4)
then
(put.24 HB (loc.Amem 5))
(put.16 I (IDIFFERENCE (get.16 I)
4))
(until (zero I)
(decrement.cell.pointer R)
(put.cell HB 0 (get.cell R 0))
(increment.cell.pointer HB)
(decrement.counter I)))))
(PUTPROPS restore.registers.2 MACRO (OPENLAMBDA NIL (* needed R S)
(* defined C)
(* scratch HB)
(decrement.cell.pointer R 6)
(put.24 C (get.addr R 5))
(put.Aval 1 (get.cell R 3))
(put.Aval 2 (get.cell R 2))
(put.Aval 3 (get.cell R 1))
(put.Aval 4 (get.cell R 0))
(put.16 I (PROC.ARITY (get.24 C)))
(if (IGREATERP (get.16 I)
4)
then
(put.24 HB (loc.Amem 5))
(put.16 I (IDIFFERENCE (get.16 I)
4))
(until (zero I)
(decrement.cell.pointer R)
(put.cell HB 0 (get.cell R 0))
(increment.cell.pointer HB)
(decrement.counter I)))))
(PUTPROPS save.registers MACRO (OPENLAMBDA NIL (* needed C S)
(set.top.of.stack)
(put.16 I (PROC.ARITY (get.24 C)))
(while (IGREATERP (get.16 I)
4)
(put.cell R 0 (get.Amem I))
(increment.cell.pointer R)
(decrement.counter I))
(put.cell R 0 (get.Aval 4))
(put.cell R 1 (get.Aval 3))
(put.cell R 2 (get.Aval 2))
(put.cell R 3 (get.Aval 1))
(put.addr R 4 (get.24 S))
(put.addr R 5 (get.24 C))
(increment.cell.pointer R 6)))
(PUTPROPS set.top.of.stack MACRO (OPENLAMBDA NIL (if (before E B)
then
(put.24 R (get.24 B))
else
(put.24 R (E.plus.env.size.from.CP)))))
)
(DEFINEQ
(R.either
(LAMBDA NIL
(put.24 CP (add.code P 1))
(set.top.of.stack)
(create.choice.point)
(continue.reading 2)))
(R.jump.to
(LAMBDA NIL
(continue.at (address.operand))))
(R.just.index.else
(LAMBDA NIL
(index)))
(R.just.me.else
(LAMBDA NIL
(read.continue 1)))
(R.or
(LAMBDA NIL
(put.24 HB (get.24 H))
(put.addr B saved.BP (address.operand))
(read.continue 1)))
(R.or.finally
(LAMBDA NIL
(put.24 B (get.addr B saved.B))
(put.24 HB (get.addr B saved.H))
(read.continue 0)))
(R.retry.index.else
(LAMBDA NIL
(put.32 T1 (get.cell R -3))
(index.2 index.fail (PROGN (restore.registers.2)
(put.24 HB (get.24 H))
(put.addr B saved.BP (address.operand))))))
(R.retry.me.else
(LAMBDA NIL (* needed R)
(restore.registers)
(put.24 HB (get.24 H))
(put.addr B saved.BP (address.operand))
(read.continue 1)))
(R.trust.index.else
(LAMBDA NIL
(put.32 T1 (get.cell R -3))
(index.2 fast.fail (PROGN (restore.registers.2)
(put.24 B (get.addr B saved.B))
(put.24 HB (get.addr B saved.H))))))
(R.trust.me.else
(LAMBDA NIL (* needed R)
(restore.registers)
(put.24 B (get.addr B saved.B))
(put.24 HB (get.addr B saved.H))
(read.continue 1)))
(R.try.index.else
(LAMBDA NIL
(put.32 T1 (get.Aval 1))
(index.2 index.fail (PROGN (save.registers)
(create.choice.point)))))
(R.try.me.else
(LAMBDA NIL
(save.registers)
(create.choice.point)
(read.continue 1)))
(W.either
(LAMBDA NIL
(put.24 CP (add.code P 1))
(set.top.of.stack)
(create.choice.point)
(continue.reading 2)))
(W.jump.to
(LAMBDA NIL
(continue.at (address.operand))))
)
(PUTPROPS INDEX.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (6607 8489 (R.either 6617 . 6751) (R.jump.to 6753 . 6819) (R.just.index.else 6821 . 6871
) (R.just.me.else 6873 . 6930) (R.or 6932 . 7050) (R.or.finally 7052 . 7180) (R.retry.index.else 7182
. 7385) (R.retry.me.else 7387 . 7604) (R.trust.index.else 7606 . 7808) (R.trust.me.else 7810 . 8029)
(R.try.index.else 8031 . 8178) (R.try.me.else 8180 . 8283) (W.either 8285 . 8419) (W.jump.to 8421 .
8487)))))
STOP