(FILECREATED " 2-Feb-86 19:01:16" {DSK}<LISPFILES2>TAGS.LSP;2 6921
changes to: (VARS TAGSCOMS))
(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)
(PRETTYCOMPRINT TAGSCOMS)
(RPAQQ TAGSCOMS ((CONSTANTS boxed.tag.16 boxed.tag.8 float.tag.16 float.tag.8 immed.tag.16
immed.tag.8 list.tag.16 list.tag.8 other.tag.16 other.tag.8 ref.tag.16
ref.tag.8 struct.tag.16 struct.tag.8 symbol.tag.16 symbol.tag.8)
(MACROS arity.of arity.of.cell atom.of atom.of.cell def.tag is.unbound tag.of tag.ref
untag.anything untag.boxed untag.float untag.immed untag.list untag.ref untag.stack
untag.struct untag.symbol)
(PROP (Ptr Tag)
tag.struct)
(PROP (Ptr Tag)
tag.list)
(PROP (Ptr Tag)
tag.symbol)
(PROP (Ptr Tag)
tag.boxed)
(PROP (Ptr Tag)
tag.float)
(PROP (Ptr Tag)
tag.stack)
(FNS let.macro)
(PROP (Tag Ptr)
tag.immed)
(PROP (Tag Ptr)
tag.number)
(PROP (Tag Ptr)
tag.other)
(PROP (Ptr Tag LO HI)
tag.symbol.fast)))
(DECLARE: EVAL@COMPILE
(RPAQQ boxed.tag.16 59648)
(RPAQQ boxed.tag.8 233)
(RPAQQ float.tag.16 63488)
(RPAQQ float.tag.8 248)
(RPAQQ immed.tag.16 55552)
(RPAQQ immed.tag.8 217)
(RPAQQ list.tag.16 32768)
(RPAQQ list.tag.8 128)
(RPAQQ other.tag.16 55808)
(RPAQQ other.tag.8 218)
(RPAQQ ref.tag.16 0)
(RPAQQ ref.tag.8 0)
(RPAQQ struct.tag.16 18432)
(RPAQQ struct.tag.8 72)
(RPAQQ symbol.tag.16 51200)
(RPAQQ symbol.tag.8 200)
(CONSTANTS boxed.tag.16 boxed.tag.8 float.tag.16 float.tag.8 immed.tag.16 immed.tag.8 list.tag.16
list.tag.8 other.tag.16 other.tag.8 ref.tag.16 ref.tag.8 struct.tag.16 struct.tag.8
symbol.tag.16 symbol.tag.8)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS arity.of MACRO (X (APPLY (FUNCTION (LAMBDA (Val)
(if (NOT (MEMB Val QP.32))
then
(SHOULDNT (QUOTE arity.of)))
(BQUOTE (\HILOC (ReadPrologPtr (\, Val))))))
X)))
(PUTPROPS arity.of.cell MACRO (OPENLAMBDA (Ptr)
(\GETBASEBYTE Ptr 1)))
(PUTPROPS atom.of MACRO (X (APPLY (FUNCTION (LAMBDA (Val)
(if (NOT (MEMB Val QP.32))
then
(SHOULDNT (QUOTE atom.of)))
(BQUOTE (\VAG2 0 (\GET.LO.16 (\, Val))))))
X)))
(PUTPROPS atom.of.cell MACRO (OPENLAMBDA (Ptr)
(\VAG2 0 (\GETBASE Ptr 1))))
(PUTPROPS def.tag MACRO (X (APPLY (FUNCTION (LAMBDA (F Tag)
(BQUOTE (def.props (\, F)
Tag
(LAMBDA (Ptr)
(\, Tag))
Ptr
(LAMBDA
(Ptr)
(BQUOTE (get.24
(\, Ptr))))))))
X)))
(PUTPROPS is.unbound MACRO (X (APPLY (FUNCTION (LAMBDA
(Val Ptr)
(if (NOT (AND (MEMB Val QP.32)
(MEMB Ptr (QUOTE (R C S)))))
then
(SHOULDNT (QUOTE is.unbound)))
(BQUOTE (AND (EQ (ReadPrologTag (\, Val))
0)
(EQ (ReadPrologPtr (\, Val))
(ReadPrologPtr (\, Ptr)))))))
X)))
(PUTPROPS tag.of MACRO (X (APPLY (FUNCTION (LAMBDA (Val)
(if (NOT (MEMB Val QP.32))
then
(SHOULDNT (QUOTE tag.of)))
(BQUOTE (ReadPrologTag (\, Val)))))
X)))
(PUTPROPS tag.ref MACRO (X (APPLY (FUNCTION (LAMBDA (Ptr)
Ptr))
X)))
(PUTPROPS untag.anything MACRO (X (APPLY (FUNCTION (LAMBDA (Val)
(if (NOT (MEMB Val QP.32))
then
(SHOULDNT (QUOTE untag.anything)))
(BQUOTE (ReadPrologPtr (\, Val)))))
X)))
(PUTPROPS untag.boxed MACRO (X (APPLY (FUNCTION (LAMBDA (Val)
(BQUOTE (untag.anything (\, Val)))))
X)))
(PUTPROPS untag.float MACRO (X (APPLY (FUNCTION (LAMBDA (Val)
(BQUOTE (untag.anything (\, Val)))))
X)))
(PUTPROPS untag.immed MACRO (X (APPLY (FUNCTION (LAMBDA (Val)
(BQUOTE (untag.anything (\, Val)))))
X)))
(PUTPROPS untag.list MACRO (X (APPLY (FUNCTION (LAMBDA (Val)
(BQUOTE (untag.anything (\, Val)))))
X)))
(PUTPROPS untag.ref MACRO (X (APPLY (FUNCTION (LAMBDA (Val)
(BQUOTE (untag.anything (\, Val)))))
X)))
(PUTPROPS untag.stack MACRO (X (APPLY (FUNCTION (LAMBDA (Val)
(BQUOTE (untag.anything (\, Val)))))
X)))
(PUTPROPS untag.struct MACRO (X (APPLY (FUNCTION (LAMBDA (Val)
(BQUOTE (untag.anything (\, Val)))))
X)))
(PUTPROPS untag.symbol MACRO (X (APPLY (FUNCTION (LAMBDA (Val)
(if (NOT (MEMB Val QP.32))
then
(SHOULDNT (QUOTE untag.symbol)))
(BQUOTE (\VAG2 0 (\GET.LO.16 (\, Val))))))
X)))
)
(PUTPROPS tag.struct Ptr (LAMBDA (Ptr)
(BQUOTE (get.24 (\, Ptr)))))
(PUTPROPS tag.struct Tag (LAMBDA (Ptr)
struct.tag.8))
(PUTPROPS tag.list Ptr (LAMBDA (Ptr)
(BQUOTE (get.24 (\, Ptr)))))
(PUTPROPS tag.list Tag (LAMBDA (Ptr)
list.tag.8))
(PUTPROPS tag.symbol Ptr (LAMBDA (Ptr)
(BQUOTE (get.24 (\, Ptr)))))
(PUTPROPS tag.symbol Tag (LAMBDA (Ptr)
symbol.tag.8))
(PUTPROPS tag.boxed Ptr (LAMBDA (Ptr)
(BQUOTE (get.24 (\, Ptr)))))
(PUTPROPS tag.boxed Tag (LAMBDA (Ptr)
boxed.tag.8))
(PUTPROPS tag.float Ptr (LAMBDA (Ptr)
(BQUOTE (get.24 (\, Ptr)))))
(PUTPROPS tag.float Tag (LAMBDA (Ptr)
float.tag.8))
(PUTPROPS tag.stack Ptr (LAMBDA (Ptr)
(BQUOTE (get.24 (\, Ptr)))))
(PUTPROPS tag.stack Tag (LAMBDA (Ptr)
other.tag.8))
(DEFINEQ
(let.macro
(LAMBDA (Tag Val FORM)
(if (LISTP Val)
then (BQUOTE (LET (((\, Tag)
(\, Val)))
(\, FORM)))
else (SUBST Val Tag FORM))))
)
(PUTPROPS tag.immed Tag (LAMBDA (Ptr)
immed.tag.8))
(PUTPROPS tag.immed Ptr (LAMBDA (Ptr)
Ptr))
(PUTPROPS tag.number Tag (LAMBDA (Ptr)
(let.macro (QUOTE Ptr)
Ptr
(QUOTE (if (SMALLP Ptr)
then immed.tag.8 elseif (FIXP Ptr)
then boxed.tag.8 elseif (FLOATP Ptr)
then float.tag.8 else (SHOULDNT
(QUOTE tag.number)))))))
(PUTPROPS tag.number Ptr (LAMBDA (Ptr)
Ptr))
(PUTPROPS tag.other Tag (LAMBDA (Ptr)
(let.macro (QUOTE Ptr)
Ptr
(QUOTE (if (SMALLP Ptr)
then immed.tag.8 elseif (FIXP Ptr)
then boxed.tag.8 elseif (FLOATP Ptr)
then float.tag.8 elseif (LITATOM Ptr)
then symbol.tag.8 else other.tag.8)))))
(PUTPROPS tag.other Ptr (LAMBDA (Ptr)
Ptr))
(PUTPROPS tag.symbol.fast Ptr (LAMBDA (I)
(BQUOTE (\VAG2 0 (get.16 (\, I))))))
(PUTPROPS tag.symbol.fast Tag (LAMBDA (I)
symbol.tag.8))
(PUTPROPS tag.symbol.fast LO (LAMBDA (I)
(BQUOTE (get.16 (\, I)))))
(PUTPROPS tag.symbol.fast HI (LAMBDA (I)
symbol.tag.16))
(PUTPROPS TAGS.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5506 5702 (let.macro 5516 . 5700)))))
STOP