(FILECREATED " 8-Feb-86 15:14:11" {DSK}<LISPFILES2>IMPROVEDDCOMS>CELL.;1
 6223   

      changes to:  (VARS CELLCOMS))


(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)

(PRETTYCOMPRINT CELLCOMS)

(RPAQQ CELLCOMS
 ((ADDVARS (GLOBALVARS QP.memtop) (GLOBALVARS QP.membot) (GLOBALVARS QP.init.E) (
GLOBALVARS QP.init.H)) (FNS FIXP.CONSTANTP QP.reset Twice \BASELESSP put.cell.macro) (PROP (Ptr Tag LO
 HI) get.cell) (MACROS add.cell before decrement.cell.pointer get.Amem get.Yval get.addr get.word 
increment.cell.pointer loc.Amem loc.Yval put.Amem put.Yval put.addr put.cell put.word same.addr 
same.cell same.cont waybefore)))

(ADDTOVAR GLOBALVARS
 QP.memtop)

(ADDTOVAR GLOBALVARS
 QP.membot)

(ADDTOVAR GLOBALVARS
 QP.init.E)

(ADDTOVAR GLOBALVARS
 QP.init.H)
(DEFINEQ

(FIXP.CONSTANTP

(LAMBDA (X) (SETQ X (CONSTANTEXPRESSIONP X)) (AND (LISTP X) (FIXP (CAR X)))))

(QP.reset

(LAMBDA NIL (PROG (I) (WritePrologPtrAnd0Tag A1 NIL) (WritePrologPtrAnd0Tag A2 NIL) (
WritePrologPtrAnd0Tag A3 NIL) (WritePrologPtrAnd0Tag A4 NIL) (FOR I FROM 0 TO 2431 DO (\PUTBASE 
QP.membot I 0)) (FOR I FROM 0 TO 2047 DO (\PUTBASE QP.init.E I 0)))))

(Twice

(LAMBDA (Base Offset) (if (FIXP.CONSTANTP Base) then (IPLUS (LLSH (FIXP.CONSTANTP Base) 1) Offset) 
elseif (EQ Offset 0) then (BQUOTE (LLSH (\, Base) 1)) else (BQUOTE (IPLUS (LLSH (\, Base) 1) (\, 
Offset))))))

(\BASELESSP

(LAMBDA (X Y) (OR (ILESSP (\HILOC X) (\HILOC Y)) (AND (EQ (\HILOC X) (\HILOC Y)) (ILESSP (\LOLOC X) (
\LOLOC Y))))))

(put.cell.macro

(LAMBDA (Ptr Offset Val) (if (NOT (AND (LISTP Val) (LITATOM (CAR Val)))) then (SHOULDNT (QUOTE 
put.cell)) elseif (EQ (CAR Val) (QUOTE tag.ref)) then (BQUOTE (\PUTBASEPTR (get.24 (\, Ptr)) (\, (
Twice Offset 0)) (get.24 (\, (CADR Val))))) elseif (GETPROP (CAR Val) (QUOTE HI)) then (BQUOTE (
\PUTBASEPTR (get.24 (\, Ptr)) (\, (Twice Offset 0)) (\VAG2 (\, (APPLY (GETPROP (CAR Val) (QUOTE HI)) (
CDR Val))) (\, (APPLY (GETPROP (CAR Val) (QUOTE LO)) (CDR Val)))))) elseif (GETPROP (CAR Val) (QUOTE 
Ptr)) then (BQUOTE (PROGN (\PUTBASEPTR (get.24 (\, Ptr)) (\, (Twice Offset 0)) (\, (APPLY (GETPROP (
CAR Val) (QUOTE Ptr)) (CDR Val)))) (\PUTBASEBYTE (get.24 (\, Ptr)) (\, (Twice (Twice Offset 0) 0)) (\,
 (APPLY (GETPROP (CAR Val) (QUOTE Tag)) (CDR Val)))))) elseif (GETPROP (CAR Val) (QUOTE MACRO)) then (
put.cell.macro Ptr Offset (EXPANDMACRO Val T)) else (SHOULDNT (QUOTE put.cell)))))
)

(PUTPROPS get.cell Ptr
 (LAMBDA (Ptr Offset) (BQUOTE (\GETBASEPTR (get.24 (\, Ptr)) (\, (Twice Offset
 0))))))

(PUTPROPS get.cell Tag
 (LAMBDA (Ptr Offset) (BQUOTE (\GETBASEBYTE (get.24 (\, Ptr)) (\, (Twice (
Twice Offset 0) 0))))))

(PUTPROPS get.cell LO
 (LAMBDA (Ptr Offset) (BQUOTE (\GETBASE (get.24 (\, Ptr)) (\, (Twice Offset 1))
))))

(PUTPROPS get.cell HI
 (LAMBDA (Ptr Offset) (BQUOTE (\GETBASE (get.24 (\, Ptr)) (\, (Twice Offset 0))
))))
(DECLARE: EVAL@COMPILE 
(PUTPROPS add.cell MACRO (X (APPLY (FUNCTION (LAMBDA (Ptr Offset) (if (FIXP.CONSTANTP Offset) then (
BQUOTE (\ADDBASE (get.24 (\, Ptr)) (\, (Twice Offset 0)))) else (BQUOTE (\ADDBASE (\ADDBASE (get.24 (
\, Ptr)) (\, Offset)) (\, Offset)))))) X)))
(PUTPROPS before MACRO (X (APPLY (FUNCTION (LAMBDA (X Y) (BQUOTE (\BASELESSP (get.24 (\, X)) (get.24 (
\, Y)))))) X)))
(PUTPROPS decrement.cell.pointer MACRO (X (APPLY (FUNCTION (LAMBDA (R N) (SETQ N (if N then (MINUS N) 
else -1)) (BQUOTE (put.24 (\, R) (add.cell (\, R) (\, N)))))) X)))
(PUTPROPS get.Amem MACRO (X (APPLY (FUNCTION (LAMBDA (N) (BQUOTE (get.cell QP.membot (get.16 (\, N))))
)) X)))
(PUTPROPS get.Yval MACRO (X (APPLY (FUNCTION (LAMBDA (N) (BQUOTE (get.cell E (get.16 (\, N)))))) X)))
(PUTPROPS get.addr MACRO (X (APPLY (FUNCTION (LAMBDA (Ptr Offset) (BQUOTE (\GETBASEPTR (get.24 (\, Ptr
)) (\, (Twice Offset 0)))))) X)))
(PUTPROPS get.word MACRO (X (APPLY (FUNCTION (LAMBDA (Ptr Offset) (BQUOTE (\GETBASE (get.24 (\, Ptr)) 
(\, (Twice Offset 1)))))) X)))
(PUTPROPS increment.cell.pointer MACRO (X (APPLY (FUNCTION (LAMBDA (R N) (OR N (SETQ N 1)) (BQUOTE (
put.24 (\, R) (add.cell (\, R) (\, N)))))) X)))
(PUTPROPS loc.Amem MACRO (X (APPLY (FUNCTION (LAMBDA (N) (BQUOTE (add.cell QP.membot (get.16 (\, N))))
)) X)))
(PUTPROPS loc.Yval MACRO (X (APPLY (FUNCTION (LAMBDA (N) (BQUOTE (add.cell E (get.16 (\, N)))))) X)))
(PUTPROPS put.Amem MACRO (X (APPLY (FUNCTION (LAMBDA (N Val) (BQUOTE (put.cell QP.membot (get.16 (\, N
)) (\, Val))))) X)))
(PUTPROPS put.Yval MACRO (X (APPLY (FUNCTION (LAMBDA (N Val) (BQUOTE (put.cell E (get.16 (\, N)) (\, 
Val))))) X)))
(PUTPROPS put.addr MACRO (X (APPLY (FUNCTION (LAMBDA (Ptr Offset Val) (BQUOTE (\PUTBASEPTR (get.24 (\,
 Ptr)) (\, (Twice Offset 0)) (\, Val))))) X)))
(PUTPROPS put.cell MACRO (X (APPLY (FUNCTION (LAMBDA (Ptr Offset Val) (put.cell.macro Ptr Offset Val))
) X)))
(PUTPROPS put.word MACRO (X (APPLY (FUNCTION (LAMBDA (Ptr Offset Val) (SETQ Val (if (SMALLP Val) then 
(BQUOTE (QUOTE (\, (\VAG2 0 Val)))) elseif (AND (LISTP Val) (EQ (CAR Val) (QUOTE get.16)) (MEMB (CADR 
Val) (QUOTE (I N)))) then (BQUOTE ((OPCODES RDPROLOGPTR) (\, (PrologZeroExtend (PrologNameToLoUReg (
CADR Val)))))) elseif (AND (LITATOM Val) (MEMB Val (QUOTE (I N)))) then (BQUOTE ((OPCODES RDPROLOGPTR)
 (\, (PrologZeroExtend (PrologNameToLoUReg Val))))) else (SHOULDNT (QUOTE put.word)))) (BQUOTE (
\PUTBASEPTR (get.24 (\, Ptr)) (\, (Twice Offset 0)) (\, Val))))) X)))
(PUTPROPS same.addr MACRO (X (APPLY (FUNCTION (LAMBDA (X Y) (BQUOTE (EQ (get.24 (\, X)) (get.24 (\, Y)
))))) X)))
(PUTPROPS same.cell MACRO (X (APPLY (FUNCTION (LAMBDA (X Y) (BQUOTE (AND (EQ (\GET.HI.16 (\, X)) (
\GET.HI.16 (\, Y))) (EQ (\GET.LO.16 (\, X)) (\GET.LO.16 (\, Y))))))) X)))
(PUTPROPS same.cont MACRO (X (APPLY (FUNCTION (LAMBDA (X Y) (if (OR (NEQ X (QUOTE T0)) (NEQ Y (QUOTE 
T1))) then (SHOULDNT (QUOTE same.cont))) (QUOTE (AND (EQ (\GETBASE (ReadPrologPtr T0) 0) (\GETBASE (
ReadPrologPtr T1) 0)) (EQ (\GETBASE (ReadPrologPtr T0) 1) (\GETBASE (ReadPrologPtr T1) 1)))))) X)))
(PUTPROPS waybefore MACRO (X (APPLY (FUNCTION (LAMBDA (X Y) (BQUOTE (ILESSP (ADD1 (\HILOC (get.24 (\, 
X)))) (\HILOC (get.24 (\, Y))))))) X)))
)
(PUTPROPS CELL COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (813 2455 (FIXP.CONSTANTP 823 . 920) (QP.reset 922 . 1188) (Twice 1190 . 1411) (
\BASELESSP 1413 . 1545) (put.cell.macro 1547 . 2453)))))
STOP