(FILECREATED " 8-Feb-86 16:44:36" {DSK}<LISPFILES2>IMPROVEDDCOMS>REGISTERS.;2 10675
changes to: (VARS REGISTERSCOMS) (FNS QP.BLOCK)
previous date: " 8-Feb-86 15:15:33" {DSK}<LISPFILES2>IMPROVEDDCOMS>REGISTERS.;1)
(* 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) (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)))))
(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 COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2035 5565 (DynReadPrologNbr 2045 . 2159) (DynReadPrologPtr 2161 . 2246) (
DynReadPrologTag 2248 . 2333) (PrologMentionTwice 2335 . 2391) (PrologZeroExtend 2393 . 2485) (
QP.BLOCK 2487 . 2608) (QP.aregB 2610 . 2871) (QP.aregR 2873 . 3409) (QP.aregW 3411 . 3947) (
put.32.macro 3949 . 4725) (put.Aval.macro 4727 . 5563)))))
STOP