(FILECREATED " 2-Feb-86 18:54:53" {DSK}<LISPFILES2>REGISTERS.LSP;2 14120
changes to: (VARS REGISTERSCOMS)
(FNS QP.BLOCK))
(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)
(PRETTYCOMPRINT REGISTERSCOMS)
(RPAQQ REGISTERSCOMS ((FNS DynReadPrologNbr DynReadPrologPtr DynReadPrologTag PrologMentionTwice
PrologZeroExtend QP.BLOCK QP.aregB QP.aregR QP.aregW put.32.macro
put.Aval.macro)
(MACROS \GET.HI.16 \GET.LO.16 \PUT.HI.16 \PUT.LO.16 decrement.counter def.block get.16 get.24
get.4 get.nb increment.counter put.16 put.24 put.32 put.4 put.Aval put.nb zero)
(CONSTANTS QP.24 QP.32)
(PROP (Ptr Tag LO HI)
get.32)
(ADDVARS (GLOBALVARS QP.aregR1)
(GLOBALVARS QP.aregR0)
(GLOBALVARS QP.aregW1)
(GLOBALVARS QP.aregW0)
(GLOBALVARS QP.aregB1)
(GLOBALVARS QP.aregB0))
(P (PROGN (SETQ QP.aregB0 (QP.BLOCK (LIST (PrologNameToURegs (QUOTE A1))
0
(PrologNameToURegs (QUOTE A2))
0
(PrologNameToURegs (QUOTE A3))
0
(PrologNameToURegs (QUOTE A4))
0)))
(SETQ QP.aregB1 (\ADDBASE QP.aregB0 1))))
(P (PROGN (SETQ QP.aregW0 (QP.BLOCK (LIST (PrologMentionTwice (PrologNameToHiUReg
(QUOTE A1)))
(PrologMentionTwice (PrologNameToLoUReg
(QUOTE A1)))
(PrologMentionTwice (PrologNameToHiUReg
(QUOTE A2)))
(PrologMentionTwice (PrologNameToLoUReg
(QUOTE A2)))
(PrologMentionTwice (PrologNameToHiUReg
(QUOTE A3)))
(PrologMentionTwice (PrologNameToLoUReg
(QUOTE A3)))
(PrologMentionTwice (PrologNameToHiUReg
(QUOTE A4)))
(PrologMentionTwice (PrologNameToLoUReg
(QUOTE A4))))))
(SETQ QP.aregW1 (\ADDBASE QP.aregW0 1))))
(P (PROGN (SETQ QP.aregR0 (QP.BLOCK (LIST (PrologZeroExtend (PrologNameToHiUReg (QUOTE A1)))
(PrologZeroExtend (PrologNameToLoUReg (QUOTE A1)))
(PrologZeroExtend (PrologNameToHiUReg (QUOTE A2)))
(PrologZeroExtend (PrologNameToLoUReg (QUOTE A2)))
(PrologZeroExtend (PrologNameToHiUReg (QUOTE A3)))
(PrologZeroExtend (PrologNameToLoUReg (QUOTE A3)))
(PrologZeroExtend (PrologNameToHiUReg (QUOTE A4)))
(PrologZeroExtend (PrologNameToLoUReg (QUOTE A4)))))
)
(SETQ QP.aregR1 (\ADDBASE QP.aregR0 1))))
(PROP (Ptr Tag LO HI)
get.Aval)))
(DEFINEQ
(DynReadPrologNbr
(LAMBDA (Reg)
(\LOLOC ((OPCODES RDPROLOGPTR)
(PrologZeroExtend (PrologNameToLoUReg Reg))))))
(DynReadPrologPtr
(LAMBDA (Reg)
((OPCODES RDPROLOGPTR)
(PrologNameToURegs Reg))))
(DynReadPrologTag
(LAMBDA (Reg)
((OPCODES RDPROLOGTAG)
(PrologNameToURegs Reg))))
(PrologMentionTwice
(LAMBDA (Reg)
(ITIMES Reg 257)))
(PrologZeroExtend
(LAMBDA (Reg)
(LOGOR (LLSH Reg 8)
(PrologNameToLoUReg (QUOTE Zero)))))
(QP.BLOCK
(LAMBDA (ARGS)
(LET ((B (\ALLOCBLOCK (LENGTH ARGS))))
(for X in ARGS as I from 0 do (\PUTBASE B I X))
B)))
(QP.aregB
(LAMBDA (Reg)
(SELECTQ Reg
(1 (\GETBASE QP.aregB0 0))
(2 (\GETBASE QP.aregB0 2))
(3 (\GETBASE QP.aregB0 4))
(4 (\GETBASE QP.aregB0 6))
(I (QUOTE (\GETBASE QP.aregB0 (get.16 I))))
(N (QUOTE (\GETBASE QP.aregB0 (get.16 N))))
(SHOULDNT QP.aregB))))
(QP.aregR
(LAMBDA (Reg x)
(if (EQ x 0)
then (SELECTQ Reg
(1 (\GETBASE QP.aregR0 0))
(2 (\GETBASE QP.aregR0 2))
(3 (\GETBASE QP.aregR0 4))
(4 (\GETBASE QP.aregR0 6))
(I (QUOTE (\GETBASE QP.aregR0 (get.16 I))))
(N (QUOTE (\GETBASE QP.aregR0 (get.16 N))))
(SHOULDNT (QUOTE QP.aregR)))
else (SELECTQ Reg
(1 (\GETBASE QP.aregR1 0))
(2 (\GETBASE QP.aregR1 2))
(3 (\GETBASE QP.aregR1 4))
(4 (\GETBASE QP.aregR1 6))
(I (QUOTE (\GETBASE QP.aregR1 (get.16 I))))
(N (QUOTE (\GETBASE QP.aregR1 (get.16 N))))
(SHOULDNT (QUOTE QP.aregR))))))
(QP.aregW
(LAMBDA (Reg x)
(if (EQ x 0)
then (SELECTQ Reg
(1 (\GETBASE QP.aregW0 0))
(2 (\GETBASE QP.aregW0 2))
(3 (\GETBASE QP.aregW0 4))
(4 (\GETBASE QP.aregW0 6))
(I (QUOTE (\GETBASE QP.aregW0 (get.16 I))))
(N (QUOTE (\GETBASE QP.aregW0 (get.16 N))))
(SHOULDNT (QUOTE QP.aregW)))
else (SELECTQ Reg
(1 (\GETBASE QP.aregW1 0))
(2 (\GETBASE QP.aregW1 2))
(3 (\GETBASE QP.aregW1 4))
(4 (\GETBASE QP.aregW1 6))
(I (QUOTE (\GETBASE QP.aregW1 (get.16 I))))
(N (QUOTE (\GETBASE QP.aregW1 (get.16 N))))
(SHOULDNT (QUOTE QP.aregW))))))
(put.32.macro
(LAMBDA (Reg Val)
(if (NOT (AND (MEMB Reg QP.32)
(LISTP Val)
(LITATOM (CAR Val))))
then (SHOULDNT (QUOTE put.32))
elseif (EQ (CAR Val)
(QUOTE tag.ref))
then (BQUOTE (WritePrologPtrAnd0Tag (\, Reg)
(get.24 (\, (CADR Val)))))
elseif (GETPROP (CAR Val)
(QUOTE Ptr))
then (BQUOTE (WritePrologTagAndPtr (\, Reg)
(\, (APPLY (GETPROP (CAR Val)
(QUOTE Tag))
(CDR Val)))
(\, (APPLY (GETPROP (CAR Val)
(QUOTE Ptr))
(CDR Val)))))
elseif (GETPROP (CAR Val)
(QUOTE HI))
then (BQUOTE (PROGN (\PUT.HI.16 (\, Reg)
(\, (APPLY (GETPROP (CAR Val)
(QUOTE HI))
(CDR Val))))
(\PUT.LO.16 (\, Reg)
(\, (APPLY (GETPROP (CAR Val)
(QUOTE LO))
(CDR Val))))))
elseif (GETPROP (CAR Val)
(QUOTE MACRO))
then (put.32.macro Reg (EXPANDMACRO Val T))
else (SHOULDNT (QUOTE put.cell)))))
(put.Aval.macro
(LAMBDA (Reg Val)
(if (NOT (AND (LISTP Val)
(LITATOM (CAR Val))))
then (SHOULDNT (QUOTE put.Aval))
elseif (EQ (CAR Val)
(QUOTE tag.ref))
then (BQUOTE ((OPCODES WRTPTR&0TAG)
(\, (QP.aregB Reg))
(get.24 (\, (CADR Val)))))
elseif (GETPROP (CAR Val)
(QUOTE Ptr))
then (BQUOTE ((OPCODES WRTPTR&TAG)
(\, (QP.aregB Reg))
(\, (APPLY (GETPROP (CAR Val)
(QUOTE Tag))
(CDR Val)))
(\, (APPLY (GETPROP (CAR Val)
(QUOTE Ptr))
(CDR Val)))))
elseif (GETPROP (CAR Val)
(QUOTE HI))
then (BQUOTE (PROGN ((OPCODES WRTPTR&0TAG)
(\, (QP.aregW Reg 0))
(\, (APPLY (GETPROP (CAR Val)
(QUOTE HI))
(CDR Val))))
((OPCODES WRTPTR&0TAG)
(\, (QP.aregW Reg 1))
(\, (APPLY (GETPROP (CAR Val)
(QUOTE LO))
(CDR Val))))))
elseif (GETPROP (CAR Val)
(QUOTE MACRO))
then (put.Aval.macro Reg (EXPANDMACRO Val T))
else (SHOULDNT (QUOTE put.cell)))))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS \GET.HI.16 MACRO (X (APPLY (FUNCTION (LAMBDA (Reg)
(BQUOTE (\LOLOC ((OPCODES RDPROLOGPTR)
(\, (PrologZeroExtend
(PrologNameToHiUReg
Reg))))))))
X)))
(PUTPROPS \GET.LO.16 MACRO (X (APPLY (FUNCTION (LAMBDA (Reg)
(BQUOTE (\LOLOC ((OPCODES RDPROLOGPTR)
(\, (PrologZeroExtend
(PrologNameToLoUReg
Reg))))))))
X)))
(PUTPROPS \PUT.HI.16 MACRO (X (APPLY (FUNCTION (LAMBDA (Reg Val)
(BQUOTE ((OPCODES WRTPTR&0TAG)
(\, (PrologMentionTwice (
PrologNameToHiUReg Reg)))
(\, Val)))))
X)))
(PUTPROPS \PUT.LO.16 MACRO (X (APPLY (FUNCTION (LAMBDA (Reg Val)
(BQUOTE ((OPCODES WRTPTR&0TAG)
(\, (PrologMentionTwice (
PrologNameToLoUReg Reg)))
(\, Val)))))
X)))
(PUTPROPS decrement.counter MACRO (X (APPLY (FUNCTION (LAMBDA
(X)
(BQUOTE (put.16 (\, X)
(IPLUS (get.16 (\, X))
-1)))))
X)))
(PUTPROPS def.block MACRO
(ARGS (PROGN (BQUOTE (PROGN (def.global (\, (CAR ARGS)))
(def.global (\, (CADR ARGS)))
(def.init (PROGN (SETQ (\, (CAR ARGS))
(QP.BLOCK (LIST (\,@ (CDDR ARGS)))))
(SETQ (\, (CADR ARGS))
(\ADDBASE (\, (CAR ARGS))
1)))))))))
(PUTPROPS get.16 MACRO (X (APPLY (FUNCTION (LAMBDA (X)
(if (SMALLP X)
then X elseif (MEMB X (QUOTE (N I)))
then
(BQUOTE (\GET.LO.16 (\, X)))
else
(SHOULDNT (QUOTE get.16)))))
X)))
(PUTPROPS get.24 MACRO (X (APPLY (FUNCTION (LAMBDA (X)
(if (MEMB X QP.24)
then
(BQUOTE (ReadPrologPtr (\, X)))
elseif
(MEMB X (QUOTE (NIL QP.membot QP.init.E
QP.init.H QP.memtop)))
then X else (SHOULDNT (QUOTE get.24)))))
X)))
(PUTPROPS get.4 MACRO (X (APPLY (FUNCTION (LAMBDA (X)
(if (NEQ X (QUOTE W))
then
(SHOULDNT (QUOTE get.4)))
(BQUOTE (\GET.LO.16 W))))
X)))
(PUTPROPS get.nb MACRO (X (APPLY (FUNCTION (LAMBDA (X)
(if (MEMB X QP.32)
then
(BQUOTE (ReadPrologPtr (\, X)))
else
(SHOULDNT (QUOTE get.nb)))))
X)))
(PUTPROPS increment.counter MACRO (X (APPLY (FUNCTION (LAMBDA
(X)
(BQUOTE (put.16 (\, X)
(IPLUS (get.16 (\, X))
1)))))
X)))
(PUTPROPS put.16 MACRO (X (APPLY (FUNCTION (LAMBDA (X Y)
(if (MEMB X (QUOTE (N I)))
then
(BQUOTE (\PUT.LO.16 (\, X)
(\, Y)))
else
(SHOULDNT (QUOTE put.16)))))
X)))
(PUTPROPS put.24 MACRO (X (APPLY (FUNCTION (LAMBDA (X Y)
(if (MEMB X QP.24)
then
(BQUOTE (WritePrologPtrAnd0Tag (\, X)
(\, Y)))
else
(SHOULDNT (QUOTE put.24)))))
X)))
(PUTPROPS put.32 MACRO (X (APPLY (FUNCTION (LAMBDA (Reg Val)
(put.32.macro Reg Val)))
X)))
(PUTPROPS put.4 MACRO (X (APPLY (FUNCTION (LAMBDA (X V)
(if (NEQ X (QUOTE W))
then
(SHOULDNT (QUOTE put.4)))
(BQUOTE (\PUT.LO.16
W
(\, (if (EQ V (QUOTE READ))
then 0 elseif
(EQ V (QUOTE WRITE))
then 256 elseif (SMALLP V)
then V else (SHOULDNT
(QUOTE put.4))))))))
X)))
(PUTPROPS put.Aval MACRO (X (APPLY (FUNCTION (LAMBDA (Reg Val)
(put.Aval.macro Reg Val)))
X)))
(PUTPROPS put.nb MACRO (X (APPLY (FUNCTION (LAMBDA (X Y)
(if (MEMB X QP.32)
then
(BQUOTE (WritePrologTagAndPtr (\, X)
boxed.tag.8
(\, Y)))
else
(SHOULDNT (QUOTE put.nb)))))
X)))
(PUTPROPS zero MACRO (X (APPLY (FUNCTION (LAMBDA (X)
(BQUOTE (EQ (get.16 (\, X))
0))))
X)))
)
(DECLARE: EVAL@COMPILE
(RPAQQ QP.24 (P CP R C S E B B0 H HB TR CurClause))
(RPAQQ QP.32 (T0 T1 A1 A2 A3 A4))
(CONSTANTS QP.24 QP.32)
)
(PUTPROPS get.32 Ptr (LAMBDA (Reg)
(BQUOTE (ReadPrologPtr (\, Reg)))))
(PUTPROPS get.32 Tag (LAMBDA (Reg)
(BQUOTE (ReadPrologTag (\, Reg)))))
(PUTPROPS get.32 LO (LAMBDA (Reg)
(BQUOTE (\GET.LO.16 (\, Reg)))))
(PUTPROPS get.32 HI (LAMBDA (Reg)
(BQUOTE (\GET.HI.16 (\, Reg)))))
(ADDTOVAR GLOBALVARS QP.aregR1)
(ADDTOVAR GLOBALVARS QP.aregR0)
(ADDTOVAR GLOBALVARS QP.aregW1)
(ADDTOVAR GLOBALVARS QP.aregW0)
(ADDTOVAR GLOBALVARS QP.aregB1)
(ADDTOVAR GLOBALVARS QP.aregB0)
(PROGN (SETQ QP.aregB0 (QP.BLOCK (LIST (PrologNameToURegs (QUOTE A1))
0
(PrologNameToURegs (QUOTE A2))
0
(PrologNameToURegs (QUOTE A3))
0
(PrologNameToURegs (QUOTE A4))
0)))
(SETQ QP.aregB1 (\ADDBASE QP.aregB0 1)))
(PROGN (SETQ QP.aregW0 (QP.BLOCK (LIST (PrologMentionTwice (PrologNameToHiUReg (QUOTE A1)))
(PrologMentionTwice (PrologNameToLoUReg (QUOTE A1)))
(PrologMentionTwice (PrologNameToHiUReg (QUOTE A2)))
(PrologMentionTwice (PrologNameToLoUReg (QUOTE A2)))
(PrologMentionTwice (PrologNameToHiUReg (QUOTE A3)))
(PrologMentionTwice (PrologNameToLoUReg (QUOTE A3)))
(PrologMentionTwice (PrologNameToHiUReg (QUOTE A4)))
(PrologMentionTwice (PrologNameToLoUReg (QUOTE A4))))))
(SETQ QP.aregW1 (\ADDBASE QP.aregW0 1)))
(PROGN (SETQ QP.aregR0 (QP.BLOCK (LIST (PrologZeroExtend (PrologNameToHiUReg (QUOTE A1)))
(PrologZeroExtend (PrologNameToLoUReg (QUOTE A1)))
(PrologZeroExtend (PrologNameToHiUReg (QUOTE A2)))
(PrologZeroExtend (PrologNameToLoUReg (QUOTE A2)))
(PrologZeroExtend (PrologNameToHiUReg (QUOTE A3)))
(PrologZeroExtend (PrologNameToLoUReg (QUOTE A3)))
(PrologZeroExtend (PrologNameToHiUReg (QUOTE A4)))
(PrologZeroExtend (PrologNameToLoUReg (QUOTE A4))))))
(SETQ QP.aregR1 (\ADDBASE QP.aregR0 1)))
(PUTPROPS get.Aval Ptr (LAMBDA (Reg)
(BQUOTE ((OPCODES RDPROLOGPTR)
(\, (QP.aregB Reg))))))
(PUTPROPS get.Aval Tag (LAMBDA (Reg)
(BQUOTE ((OPCODES RDPROLOGTAG)
(\, (QP.aregB Reg))))))
(PUTPROPS get.Aval LO (LAMBDA (Reg)
(BQUOTE (\LOLOC ((OPCODES RDPROLOGPTR)
(\, (QP.aregR Reg 1)))))))
(PUTPROPS get.Aval HI (LAMBDA (Reg)
(BQUOTE (\LOLOC ((OPCODES RDPROLOGPTR)
(\, (QP.aregR Reg 0)))))))
(PUTPROPS REGISTERS.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2388 7392 (DynReadPrologNbr 2398 . 2538) (DynReadPrologPtr 2540 . 2640) (
DynReadPrologTag 2642 . 2742) (PrologMentionTwice 2744 . 2810) (PrologZeroExtend 2812 . 2932) (
QP.BLOCK 2934 . 3106) (QP.aregB 3108 . 3469) (QP.aregR 3471 . 4175) (QP.aregW 4177 . 4881) (
put.32.macro 4883 . 6113) (put.Aval.macro 6115 . 7390)))))
STOP