(FILECREATED " 8-Feb-86 15:58:12" {DSK}<LISPFILES2>IMPROVEDDCOMS>LISP.;1 7839
changes to: (VARS LISPCOMS) (RECORDS PROLOG.TERM))
(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)
(PRETTYCOMPRINT LISPCOMS)
(RPAQQ LISPCOMS ((RECORDS PROLOG.TERM) (FNS QL QP.TERM.PRINT QP.lispify.cell QP.prologify
R.call.lisp R.send.direct.Ai R.send.direct.AiM R.send.variable.Ai R.send.variable.AiM R.start.calling)
(P (DEFPRINT (QUOTE PROLOG.TERM) (QUOTE QP.TERM.PRINT))) (MACROS QP.lispify send.to.lisp) (CONSTANTS
QP.AV)))
[DECLARE: EVAL@COMPILE
(DATATYPE PROLOG.TERM ((PROLOG.FUNCTOR POINTER) (PROLOG.ARGS POINTER)))
]
(/DECLAREDATATYPE (QUOTE PROLOG.TERM) (QUOTE (POINTER POINTER)) (QUOTE ((PROLOG.TERM 0 POINTER) (
PROLOG.TERM 2 POINTER))) (QUOTE 4))
(DEFINEQ
(QL
(LAMBDA (N) (SELECTQ N (1 (QP.lispify.cell (ReadPrologTag A1) (ReadPrologPtr A1) T)) (2 (
QP.lispify.cell (ReadPrologTag A2) (ReadPrologPtr A2) T)) (3 (QP.lispify.cell (ReadPrologTag A3) (
ReadPrologPtr A3) T)) (4 (QP.lispify.cell (ReadPrologTag A4) (ReadPrologPtr A4) T)) (QP.lispify (
add.cell QP.membot N) T))))
(QP.TERM.PRINT
(LAMBDA (TERM STREAM) (DECLARE (SPECVARS FN)) (if (STKPOS (QUOTE \MAPCHARS1)) then (\MAPCHARS1 (QUOTE
%|%[) NIL FN) (\MAPCHARS1 (fetch PROLOG.FUNCTOR of TERM) NIL FN) (for ARG in (fetch PROLOG.ARGS of
TERM) do (\MAPCHARS1 (QUOTE % ) NIL FN) (\MAPCHARS1 ARG NIL FN)) (\MAPCHARS1 (QUOTE %]) NIL FN) else (
PRIN1 (QUOTE %|%[)) (PRIN1 (fetch PROLOG.FUNCTOR of TERM)) (for ARG in (fetch PROLOG.ARGS of TERM) do
(PRIN1 (QUOTE % )) (PRIN1 ARG)) (PRIN1 (QUOTE %]))) T))
(QP.lispify.cell
(LAMBDA (Tag Ptr Debug) (PROG (A P) L (SELECTC Tag (ref.tag.8 (if (AND Debug (OR (\BASELESSP Ptr
QP.membot) (\BASELESSP QP.memtop Ptr))) then (RETURN (CONS (QUOTE %.) (CONS (QUOTE SHOULDNT) (LOC Ptr)
)))) (SETQ Tag (\GETBASEBYTE Ptr 0)) (SETQ P (\GETBASEPTR Ptr 0)) (if (OR (NEQ Tag ref.tag.8) (NEQ P
Ptr)) then (SETQ Ptr P) (GO L)) (if (NOT Debug) then (QP.OVERFLOW 21) elseif (EQ Debug (QUOTE S)) then
(RETURN Ptr) else (RETURN (CONS (QUOTE %.) (CONS (if (\BASELESSP Ptr QP.init.E) then (QUOTE Global)
else (QUOTE Local)) (LOC Ptr)))))) (list.tag.8 (SETQ P (\ADDBASE Ptr 2)) (RETURN (CONS (QP.lispify Ptr
Debug) (QP.lispify P Debug)))) (struct.tag.8 (SETQ A NIL) (SETQ Tag (atom.of.cell Ptr)) (SETQ P (
\ADDBASE Ptr (LLSH (arity.of.cell Ptr) 1))) (until (EQ P Ptr) (SETQ A (CONS (QP.lispify P Debug) A)) (
SETQ P (\ADDBASE P -2))) (RETURN (CREATE PROLOG.TERM PROLOG.FUNCTOR ← Tag PROLOG.ARGS ← A))) (RETURN
Ptr)))))
(QP.prologify
(LAMBDA (Ptr C) (PROG NIL L (if (LITATOM Ptr) then (\PUTBASEPTR C 0 Ptr) (\PUTBASE C 0 symbol.tag.16)
elseif (SMALLP Ptr) then (\PUTBASEPTR C 0 Ptr) (\PUTBASEBYTE C 0 immed.tag.8) elseif (LISTP Ptr) then
(\PUTBASEPTR C 0 (get.24 H)) (\PUTBASEBYTE C 0 list.tag.8) (SETQ C (get.24 H)) (increment.cell.pointer
H 2) (check.heap) (QP.prologify (CAR Ptr) C) (SETQ Ptr (CDR Ptr)) (SETQ C (\ADDBASE C 2)) (GO L)
elseif (TYPENAMEP Ptr (QUOTE PROLOG.TERM)) then (LET* ((A (fetch PROLOG.FUNCTOR of Ptr)) (L (fetch
PROLOG.ARGS of Ptr)) (N (LENGTH L))) (if (EQ N 0) then (QP.prologify A C) elseif (AND (EQ A (QUOTE %.)
) (EQ N 2)) then (\PUTBASEPTR C 0 (get.24 H)) (\PUTBASEBYTE C 0 list.tag.8) (SETQ C (get.24 H)) (
increment.cell.pointer H 2) (check.heap) (QP.prologify (CAR L) C) (SETQ Ptr (CADR L)) (SETQ C (
\ADDBASE C 2)) (GO L) else (if (IGREATERP N 255) then (SHOULDNT (QUOTE PROLOG.TERM))) (if (NOT (
LITATOM A)) then (SHOULDNT (QUOTE PROLOG.TERM))) (\PUTBASEPTR C 0 A) (\PUTBASE C 0 (IPLUS N
symbol.tag.16)) (SETQ C (get.24 H)) (increment.cell.pointer H (IPLUS N 1)) (check.heap) (until (NULL L
) (SETQ C (\ADDBASE C 2)) (QP.prologify (CAR L) C) (SETQ L (CDR L))))) else (\PUTBASEPTR C 0 (
QP.ADD.REF Ptr)) (\PUTBASEBYTE C 0 (if (FIXP Ptr) then boxed.tag.8 elseif (FLOATP Ptr) then
float.tag.8 else other.tag.8))))))
(R.call.lisp
(LAMBDA NIL (SETQ MV.RETURNER0 (SELECTC (get.16 I) (0 (APPLY* (get.24 C))) (1 (APPLY* (get.24 C)
MV.RETURNER0)) (2 (APPLY* (get.24 C) MV.RETURNER0 MV.RETURNER1)) (3 (APPLY* (get.24 C) MV.RETURNER0
MV.RETURNER1 MV.RETURNER2)) (4 (APPLY* (get.24 C) MV.RETURNER0 MV.RETURNER1 MV.RETURNER2 MV.RETURNER3)
) (5 (APPLY* (get.24 C) MV.RETURNER0 MV.RETURNER1 MV.RETURNER2 MV.RETURNER3 MV.RETURNER4)) (6 (APPLY*
(get.24 C) MV.RETURNER0 MV.RETURNER1 MV.RETURNER2 MV.RETURNER3 MV.RETURNER4 MV.RETURNER5)) (7 (APPLY*
(get.24 C) MV.RETURNER0 MV.RETURNER1 MV.RETURNER2 MV.RETURNER3 MV.RETURNER4 MV.RETURNER5 MV.RETURNER6)
) (8 (APPLY* (get.24 C) MV.RETURNER0 MV.RETURNER1 MV.RETURNER2 MV.RETURNER3 MV.RETURNER4 MV.RETURNER5
MV.RETURNER6 MV.RETURNER7)) (9 (APPLY* (get.24 C) MV.RETURNER0 MV.RETURNER1 MV.RETURNER2 MV.RETURNER3
MV.RETURNER4 MV.RETURNER5 MV.RETURNER6 MV.RETURNER7 MV.RETURNER8)) (10 (APPLY* (get.24 C) MV.RETURNER0
MV.RETURNER1 MV.RETURNER2 MV.RETURNER3 MV.RETURNER4 MV.RETURNER5 MV.RETURNER6 MV.RETURNER7
MV.RETURNER8 MV.RETURNER9)) (11 (APPLY* (get.24 C) MV.RETURNER0 MV.RETURNER1 MV.RETURNER2 MV.RETURNER3
MV.RETURNER4 MV.RETURNER5 MV.RETURNER6 MV.RETURNER7 MV.RETURNER8 MV.RETURNER9 MV.RETURNER10)) (12 (
APPLY* (get.24 C) MV.RETURNER0 MV.RETURNER1 MV.RETURNER2 MV.RETURNER3 MV.RETURNER4 MV.RETURNER5
MV.RETURNER6 MV.RETURNER7 MV.RETURNER8 MV.RETURNER9 MV.RETURNER10 MV.RETURNER11)) (13 (APPLY* (get.24
C) MV.RETURNER0 MV.RETURNER1 MV.RETURNER2 MV.RETURNER3 MV.RETURNER4 MV.RETURNER5 MV.RETURNER6
MV.RETURNER7 MV.RETURNER8 MV.RETURNER9 MV.RETURNER10 MV.RETURNER11 MV.RETURNER12)) (14 (APPLY* (get.24
C) MV.RETURNER0 MV.RETURNER1 MV.RETURNER2 MV.RETURNER3 MV.RETURNER4 MV.RETURNER5 MV.RETURNER6
MV.RETURNER7 MV.RETURNER8 MV.RETURNER9 MV.RETURNER10 MV.RETURNER11 MV.RETURNER12 MV.RETURNER13)) (15 (
APPLY* (get.24 C) MV.RETURNER0 MV.RETURNER1 MV.RETURNER2 MV.RETURNER3 MV.RETURNER4 MV.RETURNER5
MV.RETURNER6 MV.RETURNER7 MV.RETURNER8 MV.RETURNER9 MV.RETURNER10 MV.RETURNER11 MV.RETURNER12
MV.RETURNER13 MV.RETURNER14)) (16 (APPLY* (get.24 C) MV.RETURNER0 MV.RETURNER1 MV.RETURNER2
MV.RETURNER3 MV.RETURNER4 MV.RETURNER5 MV.RETURNER6 MV.RETURNER7 MV.RETURNER8 MV.RETURNER9
MV.RETURNER10 MV.RETURNER11 MV.RETURNER12 MV.RETURNER13 MV.RETURNER14 MV.RETURNER15)) (SHOULDNT
"Too many arguments in Lisp call"))) (LET ((R QP.AV) (C (get.24 H)) (N (get.16 N))) (put.24 S C) (
increment.cell.pointer H N) (until (EQ N 0) (QP.prologify (GETTOPVAL (CAR R)) C) (SETQ R (CDR R)) (
SETQ C (\ADDBASE C 2)) (SETQ N (IDIFFERENCE N 1)))) (read.continue 0)))
(R.send.direct.Ai
(LAMBDA NIL (send.to.lisp (get.Aval N) (QUOTE S))))
(R.send.direct.AiM
(LAMBDA NIL (send.to.lisp (get.Amem N) (QUOTE S))))
(R.send.variable.Ai
(LAMBDA NIL (send.to.lisp (get.Aval N) NIL)))
(R.send.variable.AiM
(LAMBDA NIL (send.to.lisp (get.Amem N) NIL)))
(R.start.calling
(LAMBDA NIL (* defined I C R) (put.16 I (LOGAND (get.code P 0) 255)) (put.24 C (\VAG2 0 (get.code P 1)
)) (put.24 R QP.AV) (read.continue 2)))
)
(DEFPRINT (QUOTE PROLOG.TERM) (QUOTE QP.TERM.PRINT))
(DECLARE: EVAL@COMPILE
(PUTPROPS QP.lispify MACRO (OPENLAMBDA (Ptr Debug) (QP.lispify.cell (\GETBASEBYTE Ptr 0) (\GETBASEPTR
Ptr 0) Debug)))
(PUTPROPS send.to.lisp MACRO (X (APPLY (FUNCTION (LAMBDA (VALUE Debug) (BQUOTE (PROGN (put.32 T0 (\,
VALUE)) (LET ((L (get.24 R)) (Tag (ReadPrologTag T0)) (Ptr (ReadPrologPtr T0))) (SETTOPVAL (CAR L) (if
(IGEQ Tag immed.tag.8) then Ptr else (QP.lispify.cell Tag Ptr (\, Debug)))) (put.24 R (CDR L))) (
read.continue 0))))) X)))
)
(DECLARE: EVAL@COMPILE
(RPAQQ QP.AV (MV.RETURNER0 MV.RETURNER1 MV.RETURNER2 MV.RETURNER3 MV.RETURNER4 MV.RETURNER5
MV.RETURNER6 MV.RETURNER7 MV.RETURNER8 MV.RETURNER9 MV.RETURNER10 MV.RETURNER11 MV.RETURNER12
MV.RETURNER13 MV.RETURNER14 MV.RETURNER15))
(CONSTANTS QP.AV)
)
(PUTPROPS LISP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (801 6942 (QL 811 . 1133) (QP.TERM.PRINT 1135 . 1618) (QP.lispify.cell 1620 . 2564) (
QP.prologify 2566 . 3904) (R.call.lisp 3906 . 6481) (R.send.direct.Ai 6483 . 6556) (R.send.direct.AiM
6558 . 6632) (R.send.variable.Ai 6634 . 6703) (R.send.variable.AiM 6705 . 6775) (R.start.calling 6777
. 6940)))))
STOP