(FILECREATED " 8-Feb-86 15:29:51" {DSK}<LISPFILES2>IMPROVEDDCOMS>INDEX.;1
 6766   

      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 COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (5096 6678 (R.either 5106 . 5222) (R.jump.to 5224 . 5284) (R.just.index.else 5286 . 5330
) (R.just.me.else 5332 . 5383) (R.or 5385 . 5489) (R.or.finally 5491 . 5605) (R.retry.index.else 5607
 . 5787) (R.retry.me.else 5789 . 5938) (R.trust.index.else 5940 . 6121) (R.trust.me.else 6123 . 6274) 
(R.try.index.else 6276 . 6405) (R.try.me.else 6407 . 6496) (W.either 6498 . 6614) (W.jump.to 6616 . 
6676)))))
STOP