(FILECREATED " 8-Feb-86 15:10:43" {DSK}<LISPFILES2>IMPROVEDDCOMS>LOAD.;1
 23817  

      changes to:  (VARS LOADCOMS))


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

(PRETTYCOMPRINT LOADCOMS)

(RPAQQ LOADCOMS
 ((ADDVARS (GLOBALVARS QP.LAST.CLAUSE.RECORD) (GLOBALVARS QP.CLAUSE.OFFSET) (
GLOBALVARS QP.DUMMY.CLAUSE) (GLOBALVARS QP.DEBUG.CLAUSE) (GLOBALVARS QP.INTERPRET.CLAUSE) (GLOBALVARS 
QP.UNDEFINED.CLAUSE) (GLOBALVARS QP.FAILURE.CLAUSE)) (MACROS QP.REGISTER.OR.MEMORY.1 \LEFTBYTE 
\RIGHTBYTE) (FNS ASSEMBLE.CLAUSE QP.ADD.CLAUSE QP.ALLOCATE.CLAUSE.RECORD QP.AREG.REGISTER 
QP.ATTACH.CLAUSE.RECORD QP.INITIALIZE.PROLOG QP.LOOK QP.LOOK.ATOM QP.LOOK.BYTE QP.LOOK.BYTE.ATOM 
QP.LOOK.BYTE.BYTE QP.LOOK.BYTE.CELL QP.LOOK.BYTE.FUNCTOR QP.LOOK.CELL QP.LOOK.CLAUSE QP.LOOK.CONSTANT 
QP.LOOK.EXTEND QP.LOOK.EXTEND.CELL QP.LOOK.EXTEND.WORD QP.LOOK.FUNCTOR QP.LOOK.INSTR QP.LOOK.NULL 
QP.LOOK.OFFSET QP.LOOK.ONE.CLAUSE QP.LOOK.OPCODE QP.LOOK.PROCEDURE QP.LOOK.SIZE.OFFSET 
QP.LOOK.SIZE.PROCEDURE QP.OBJ.TAG QP.RECONSULT QP.STORE.INCORE QP.STORE.INDEX QP.STORE.INSTR 
QP.STORE.INSTR.AREG QP.STORE.INSTR.ATOM QP.STORE.INSTR.BYTE QP.STORE.INSTR.BYTE.ATOM 
QP.STORE.INSTR.BYTE.BYTE QP.STORE.INSTR.BYTE.CELL QP.STORE.INSTR.BYTE.FUNCTOR QP.STORE.INSTR.CELL 
QP.STORE.INSTR.EXTEND QP.STORE.INSTR.EXTEND.CELL QP.STORE.INSTR.EXTEND.WORD QP.STORE.INSTR.FUNCTOR 
QP.STORE.INSTR.NULL QP.STORE.INSTR.OFFSET QP.STORE.INSTR.PROCEDURE QP.STORE.INSTR.SIZE.OFFSET 
QP.STORE.INSTR.SIZE.PROCEDURE QP.TRAP.CLAUSE QP.UNIT.CLAUSE) (VARS (QP.LAST.CLAUSE.RECORD NIL))))

(ADDTOVAR GLOBALVARS
 QP.LAST.CLAUSE.RECORD)

(ADDTOVAR GLOBALVARS
 QP.CLAUSE.OFFSET)

(ADDTOVAR GLOBALVARS
 QP.DUMMY.CLAUSE)

(ADDTOVAR GLOBALVARS
 QP.DEBUG.CLAUSE)

(ADDTOVAR GLOBALVARS
 QP.INTERPRET.CLAUSE)

(ADDTOVAR GLOBALVARS
 QP.UNDEFINED.CLAUSE)

(ADDTOVAR GLOBALVARS
 QP.FAILURE.CLAUSE)
(DECLARE: EVAL@COMPILE 
(PUTPROPS QP.REGISTER.OR.MEMORY.1 MACRO (**MACROARG** (LET ((AREG (CAR (NTH **MACROARG** 1))) (OPCODE 
(CAR (NTH **MACROARG** 2)))) (BQUOTE (COND ((GREATERP (\, AREG) 4) (SETQ (\, OPCODE) (IPLUS 512 (\, 
OPCODE)))) (T (SETQ (\, AREG) (QP.AREG.REGISTER (\, AREG)))))))))
(PUTPROPS \LEFTBYTE MACRO (X (APPLY (FUNCTION (LAMBDA (BASE OFFSET) (BQUOTE (\GETBASEBYTE (\, BASE) (
Twice (\, OFFSET) 0))))) X)))
(PUTPROPS \RIGHTBYTE MACRO (X (APPLY (FUNCTION (LAMBDA (BASE OFFSET) (BQUOTE (\GETBASEBYTE (\, BASE) (
Twice (\, OFFSET) 1))))) X)))
)
(DEFINEQ

(ASSEMBLE.CLAUSE

(NLAMBDA THEARGS (LET* ((PROCLIST (CAR THEARGS)) (PROC (QP.LOCAL.PREDICATE (CAR PROCLIST) (CADR 
PROCLIST) (CADDR PROCLIST))) (LENGTH (CADR THEARGS)) (INSTRS (CDDR THEARGS)) (CLAUSEPTR (
QP.CLAUSE.ALLOC (IPLUS 3 LENGTH)))) (SETQ QP.CLAUSE.OFFSET 2) (PROG ((INSTRS INSTRS)) LP (COND ((NULL 
INSTRS) (RETURN NIL)) (T (LET ((INSTR (CAR INSTRS))) (SETQ INSTRS (CDR INSTRS)) (QP.STORE.INSTR 
CLAUSEPTR (CAR INSTR) (CADR INSTR) (CADDR INSTR) (CADDDR INSTR) (CAR (CDDDDR INSTR)))) (GO LP)))) (if 
QP.INDEXP then (QP.ADD.CLAUSE CLAUSEPTR PROC) else (QP.ASSERT.INDEXED PROC CLAUSEPTR NIL)))))

(QP.ADD.CLAUSE

(LAMBDA (CLAUSE PROCRECORD) (COND ((EQ (QP.GET.PREDICATE.STATE PROCRECORD) 0) (SETF (PROC.CLAUSES 
PROCRECORD) CLAUSE) (SETF (PROC.LOFLAG PROCRECORD) 1) (QP.STORE.INDEX CLAUSE (QUOTE just.me.else))) ((
EQ (\GETBASEBYTE (PROC.LASTCLAUSE PROCRECORD) 0) (QP.OP.CODE (QUOTE just.me.else))) (QP.STORE.INDEX (
PROC.LASTCLAUSE PROCRECORD) (QUOTE try.me.else) CLAUSE) (QP.STORE.INDEX CLAUSE (QUOTE trust.me.else)))
 ((EQ (\GETBASEBYTE (PROC.LASTCLAUSE PROCRECORD) 0) (QP.OP.CODE (QUOTE trust.me.else))) (
QP.STORE.INDEX (PROC.LASTCLAUSE PROCRECORD) (QUOTE retry.me.else) CLAUSE) (QP.STORE.INDEX CLAUSE (
QUOTE trust.me.else)))) (SETF (PROC.LASTCLAUSE PROCRECORD) CLAUSE)))

(QP.ALLOCATE.CLAUSE.RECORD

(LAMBDA (SIZE) (SETQ QP.CLAUSE.OFFSET 2) (SETQ QP.LAST.CLAUSE.RECORD (QP.CLAUSE.ALLOC (IPLUS SIZE 3)))
))

(QP.AREG.REGISTER

(LAMBDA (AREG) (ITIMES 2 (IDIFFERENCE AREG 1))))

(QP.ATTACH.CLAUSE.RECORD

(LAMBDA (PROC) (if QP.INDEXP then (QP.ADD.CLAUSE QP.LAST.CLAUSE.RECORD PROC) else (QP.ASSERT.INDEXED 
PROC QP.LAST.CLAUSE.RECORD))))

(QP.INITIALIZE.PROLOG

(LAMBDA NIL (QP.INIT.PROCEDURES) (SETQ BYTE.BUFFER.LENGTH 0) (SETQ BYTE.BUFFER (ALLOCSTRING 4096 0 
BYTE.BUFFER)) (QP.INIT.IO) (SETQ QP.SCRATCH.STRING (ALLOCSTRING 256)) (PROG ((X (\ALLOCBLOCK 5))) (
\PUTBASE X 0 (QP.OP.CODE (QUOTE ignore.me))) (\PUTBASE X 1 (QP.OP.CODE (QUOTE fail.on.retry))) (
\PUTBASEPTR X 2 NIL) (\PUTBASEPTR X 4 NIL) (\PUTBASEPTR X 6 0) (\PUTBASEPTR X 8 0) (SETQ 
QP.DUMMY.CLAUSE X)) (QP.TRAP.CLAUSE QP.UNDEFINED.CLAUSE $interpreter←hook 2 interp) (QP.TRAP.CLAUSE 
QP.INTERPRET.CLAUSE $interpreter←hook 2 interp) (QP.TRAP.CLAUSE QP.DEBUG.CLAUSE $debug←trap 2 interp) 
(QP.UNIT.CLAUSE apply apply 3 si) (QP.UNIT.CLAUSE store.skeleton store←skeleton 1 si) (SETQ 
QP.FAILURE.CLAUSE (QP.UNIT.CLAUSE fail fail 0 si)) (ASSEMBLE.CLAUSE (portray 1 user) 1 (fail)) T))

(QP.LOOK

(LAMBDA (PROC ARITY MODULE) (PROG (CLAUSE) (COND ((NOT (TYPENAMEP PROC (QUOTE QP.PROCEDURE.RECORD))) (
SETQ PROC (QP.LOCAL.PREDICATE PROC (OR ARITY 0) (OR MODULE (QUOTE si)))))) (SETQ CLAUSE (PROC.CLAUSES 
PROC)) (COND ((EQ CLAUSE QP.EMPTY.PROC.ADDRESS) (PRIN3 "No clauses for this procedure (0!!!)") (RETURN
)) ((EQ CLAUSE QP.UNDEFINED.CLAUSE) (PRIN3 "No clauses for this procedure") (RETURN))) L (COND ((
TYPENAMEP CLAUSE (QUOTE INDEX.BLOCK)) (SETQ CLAUSE (\GETBASEPTR CLAUSE 4)))) (TERPRI) (
QP.LOOK.ONE.CLAUSE CLAUSE) (SETQ CLAUSE (\GETBASEPTR CLAUSE 0)) (COND ((NEQ CLAUSE QP.FAILURE.CLAUSE) 
(GO L))))))

(QP.LOOK.ATOM

(LAMBDA (CLAUSE INSTR) (PRINT (LIST INSTR (\VAG2 0 (\GETBASE CLAUSE (ADD1 QP.CLAUSE.OFFSET))))) (INCR 
QP.CLAUSE.OFFSET 2)))

(QP.LOOK.BYTE

(LAMBDA (CLAUSE INSTR TYPE) (PRINT (LIST INSTR (LET ((BYTE (\RIGHTBYTE CLAUSE QP.CLAUSE.OFFSET))) (
SELECTQ TYPE ((a1 byte) BYTE) (y1 (IDIFFERENCE BYTE QP.PERMANENT.OFFSET)) (SHOULDNT))))) (INCR 
QP.CLAUSE.OFFSET)))

(QP.LOOK.BYTE.ATOM

(LAMBDA (CLAUSE INSTR) (PRINT (LIST INSTR (\RIGHTBYTE CLAUSE QP.CLAUSE.OFFSET) (\VAG2 0 (\GETBASE 
CLAUSE (ADD1 QP.CLAUSE.OFFSET))))) (INCR QP.CLAUSE.OFFSET 2)))

(QP.LOOK.BYTE.BYTE

(LAMBDA (CLAUSE INSTR REVERSAL TYPE2) (LET ((SRC1 (\RIGHTBYTE CLAUSE QP.CLAUSE.OFFSET)) (SRC2 (
\RIGHTBYTE CLAUSE (ADD1 QP.CLAUSE.OFFSET))) DEST1 DEST2) (COND ((EQ REVERSAL (QUOTE REVERSED)) (SETQ 
DEST1 SRC2) (SETQ DEST2 SRC1)) (T (SETQ DEST1 SRC1) (SETQ DEST2 SRC2))) (PRINT (LIST INSTR DEST1 (COND
 ((EQ TYPE2 (QUOTE PERMANENT)) (IDIFFERENCE DEST2 QP.PERMANENT.OFFSET)) (T DEST2)))) (INCR 
QP.CLAUSE.OFFSET 2))))

(QP.LOOK.BYTE.CELL

(LAMBDA (CLAUSE INSTR) (PRINT (LIST INSTR (\RIGHTBYTE CLAUSE QP.CLAUSE.OFFSET) (\GETBASEPTR CLAUSE (
ADD1 QP.CLAUSE.OFFSET)))) (INCR QP.CLAUSE.OFFSET 3)))

(QP.LOOK.BYTE.FUNCTOR

(LAMBDA (CLAUSE INSTR) (PRINT (LIST INSTR (\RIGHTBYTE CLAUSE QP.CLAUSE.OFFSET) (\VAG2 0 (\GETBASE 
CLAUSE (IPLUS 2 QP.CLAUSE.OFFSET))) (\RIGHTBYTE CLAUSE (ADD1 QP.CLAUSE.OFFSET)))) (INCR 
QP.CLAUSE.OFFSET 3)))

(QP.LOOK.CELL

(LAMBDA (CLAUSE INSTR) (PRINT (LIST INSTR (\VAG2 (\RIGHTBYTE CLAUSE (ADD1 QP.CLAUSE.OFFSET)) (\GETBASE
 CLAUSE (IPLUS QP.CLAUSE.OFFSET 2))))) (INCR QP.CLAUSE.OFFSET 3)))

(QP.LOOK.CLAUSE

(LAMBDA (CLAUSE INSTR) (PRINT (LIST INSTR (LIST (QUOTE CLAUSE) (\RIGHTBYTE CLAUSE QP.CLAUSE.OFFSET) (
\GETBASE CLAUSE (ADD1 QP.CLAUSE.OFFSET))))) (INCR QP.CLAUSE.OFFSET 2)))

(QP.LOOK.CONSTANT

(LAMBDA (CLAUSE INSTR) (PRINT (LIST INSTR (\GETBASEPTR CLAUSE (ADD1 QP.CLAUSE.OFFSET)))) (INCR 
QP.CLAUSE.OFFSET 3)))

(QP.LOOK.EXTEND

(LAMBDA (CLAUSE INSTR) (PRINT (LIST INSTR)) (INCR QP.CLAUSE.OFFSET)))

(QP.LOOK.EXTEND.CELL

(LAMBDA (CLAUSE INSTR) (LET* ((CELL (\GETBASEPTR CLAUSE (ADD1 QP.CLAUSE.OFFSET)))) (PRINT (LIST INSTR 
CELL)) (INCR QP.CLAUSE.OFFSET 3))))

(QP.LOOK.EXTEND.WORD

(LAMBDA (CLAUSE INSTR) (LET ((WORD (\GETBASE CLAUSE (ADD1 QP.CLAUSE.OFFSET)))) (PRINT (LIST INSTR (RSH
 (LLSH WORD 16) 16))) (INCR QP.CLAUSE.OFFSET 2))))

(QP.LOOK.FUNCTOR

(LAMBDA (CLAUSE INSTR) (PRINT (LIST INSTR (\VAG2 0 (\GETBASE CLAUSE (IPLUS 2 QP.CLAUSE.OFFSET))) (
\RIGHTBYTE CLAUSE (ADD1 QP.CLAUSE.OFFSET)))) (INCR QP.CLAUSE.OFFSET 3)))

(QP.LOOK.INSTR

(LAMBDA (CLAUSE) (LET* ((OPCODE (\LEFTBYTE CLAUSE QP.CLAUSE.OFFSET)) (FIELDS (CADDR (GETHASH OPCODE 
QP.INSTRUCTION.HARRAY))) (INSTR (CAR (GETHASH OPCODE QP.INSTRUCTION.HARRAY))) (MAYBESTAR (CADR (
GETHASH OPCODE QP.INSTRUCTION.HARRAY)))) (TAB 4) (COND ((EQ MAYBESTAR (QUOTE *)) (LET* ((INSTR2 FIELDS
) (OPCODE2 (GETHASH INSTR2 QP.INSTRUCTION.HARRAY)) (FIELDS2 (CADDR (GETHASH OPCODE2 
QP.INSTRUCTION.HARRAY)))) (QP.LOOK.OPCODE CLAUSE OPCODE FIELDS2 INSTR))) (T (QP.LOOK.OPCODE CLAUSE 
OPCODE FIELDS INSTR))))))

(QP.LOOK.NULL

(LAMBDA (CLAUSE INSTR) (PRINT (LIST INSTR)) (INCR QP.CLAUSE.OFFSET)))

(QP.LOOK.OFFSET

(LAMBDA (CLAUSE INSTR) (LET* ((CLAUSE.HILOC (\HILOC CLAUSE)) (CLAUSE.LOLOC (\LOLOC CLAUSE)) (
CLAUSE.BEGIN (IPLUS (LLSH CLAUSE.HILOC 16) CLAUSE.LOLOC)) (INSTR.ADDR (IPLUS (ITIMES (\RIGHTBYTE 
CLAUSE QP.CLAUSE.OFFSET) 65536) (\GETBASE CLAUSE (ADD1 QP.CLAUSE.OFFSET)))) (OFFSET (IDIFFERENCE 
INSTR.ADDR CLAUSE.BEGIN))) (PRINT (LIST INSTR (QUOTE +) OFFSET)) (INCR QP.CLAUSE.OFFSET 2))))

(QP.LOOK.ONE.CLAUSE

(LAMBDA (CLAUSE) (PROG NIL (SETQ QP.CLAUSE.OFFSET 0) LP (COND ((QP.LOOK.INSTR CLAUSE) (GO LP))))))

(QP.LOOK.OPCODE

(LAMBDA (CLAUSE OPCODE FIELDS INSTR) (COND ((EQ OPCODE 0) NIL) ((EQ OPCODE QP.EXTENSION.OPCODE) (LET* 
((EXTENSION (\RIGHTBYTE CLAUSE QP.CLAUSE.OFFSET)) (INSTR2 (CAR (GETHASH EXTENSION QP.EXTENSION.HARRAY)
)) (FIELDS2 (CDR (GETHASH EXTENSION QP.EXTENSION.HARRAY)))) (COND ((EQUAL FIELDS2 (QUOTE (extend word)
)) (QP.LOOK.EXTEND.WORD CLAUSE INSTR2)) ((EQUAL FIELDS2 (QUOTE (extend cell))) (QP.LOOK.EXTEND.CELL 
CLAUSE INSTR2)) (T (QP.LOOK.EXTEND CLAUSE INSTR2))))) ((EQUAL FIELDS NIL) (QP.LOOK.NULL CLAUSE INSTR))
 ((MEMBER FIELDS (QUOTE ((byte) (y1) (a1)))) (QP.LOOK.BYTE CLAUSE INSTR (CAR FIELDS))) ((EQUAL FIELDS 
(QUOTE (cell))) (QP.LOOK.CELL CLAUSE INSTR)) ((EQUAL FIELDS (QUOTE (functor))) (QP.LOOK.FUNCTOR CLAUSE
 INSTR)) ((EQUAL FIELDS (QUOTE (atom))) (QP.LOOK.ATOM CLAUSE INSTR)) ((EQUAL FIELDS (QUOTE (a1 cell)))
 (QP.LOOK.BYTE.CELL CLAUSE INSTR)) ((MEMBER FIELDS (QUOTE ((a1 y2) (a2 y1) (a2 a1) (a1 a2)))) (
QP.LOOK.BYTE.BYTE CLAUSE INSTR (SELECTQ (CAR FIELDS) (a1 (QUOTE NORMAL)) (a2 (QUOTE REVERSED)) (
SHOULDNT)) (SELECTQ (CADR FIELDS) ((y1 y2) (QUOTE PERMANENT)) ((a1 a2) (QUOTE ARGUMENT)) (SHOULDNT))))
 ((EQUAL FIELDS (QUOTE (a1 functor))) (QP.LOOK.BYTE.FUNCTOR CLAUSE INSTR)) ((EQUAL FIELDS (QUOTE (a1 
atom))) (QP.LOOK.BYTE.ATOM CLAUSE INSTR)) ((EQUAL FIELDS (QUOTE (size procedure))) (
QP.LOOK.SIZE.PROCEDURE CLAUSE INSTR)) ((EQUAL FIELDS (QUOTE (size offset))) (QP.LOOK.SIZE.OFFSET 
CLAUSE INSTR)) ((EQUAL FIELDS (QUOTE (procedure))) (QP.LOOK.PROCEDURE CLAUSE INSTR)) ((EQUAL FIELDS (
QUOTE (offset))) (QP.LOOK.OFFSET CLAUSE INSTR)) ((EQUAL FIELDS (QUOTE (clause))) (QP.LOOK.CLAUSE 
CLAUSE INSTR)) (T (PRINT (LIST OPCODE INSTR FIELDS)) (SHOULDNT)))))

(QP.LOOK.PROCEDURE

(LAMBDA (CLAUSE INSTR) (PRINT (CONS INSTR (QP.P.PROCEDURE (\GETBASEPTR CLAUSE QP.CLAUSE.OFFSET)))) (
INCR QP.CLAUSE.OFFSET 2)))

(QP.LOOK.SIZE.OFFSET

(LAMBDA (CLAUSE INSTR) (LET* ((CLAUSE.HILOC (\HILOC CLAUSE)) (CLAUSE.LOLOC (\LOLOC CLAUSE)) (
CLAUSE.BEGIN (IPLUS (LLSH CLAUSE.HILOC 16) CLAUSE.LOLOC)) (INSTR.ADDR (IPLUS (ITIMES (\RIGHTBYTE 
CLAUSE QP.CLAUSE.OFFSET) 65536) (\GETBASE CLAUSE (ADD1 QP.CLAUSE.OFFSET)))) (OFFSET (IDIFFERENCE 
INSTR.ADDR CLAUSE.BEGIN))) (PRINT (LIST INSTR (IQUOTIENT (\GETBASE CLAUSE (IPLUS QP.CLAUSE.OFFSET 2)) 
2) (QUOTE +) OFFSET)) (INCR QP.CLAUSE.OFFSET 3))))

(QP.LOOK.SIZE.PROCEDURE

(LAMBDA (CLAUSE INSTR) (PRINT (NCONC (LIST INSTR (IQUOTIENT (\GETBASE CLAUSE (IPLUS QP.CLAUSE.OFFSET 2
)) 2)) (QP.P.PROCEDURE (\GETBASEPTR CLAUSE QP.CLAUSE.OFFSET)))) (INCR QP.CLAUSE.OFFSET 3)))

(QP.OBJ.TAG

(LAMBDA (OBJ) (SELECTQ (TYPENAME OBJ) (LITATOM symbol.tag.16) (SMALLP immed.tag.16) (FIXP boxed.tag.16
) (FLOATP float.tag.16) (BIGNUM boxed.tag.16) (SHOULDNT (QUOTE QP.OBJ.TAG)))))

(QP.RECONSULT

(LAMBDA (FILE) (LET ((FORM NIL) (TABLE (HASHARRAY 500 1.5)) (STREAM (OPENSTREAM FILE (QUOTE INPUT)))) 
(UNTIL (EQ (SETQ FORM (READ STREAM T)) (QUOTE STOP)) DO (PROGN (COND ((EQ (CAR FORM) (QUOTE 
ASSEMBLE.CLAUSE)) (LET* ((PROC (CADR FORM)) (NAME (CAR PROC)) (ARITY (CADR PROC)) (MODULE (CADDR PROC)
) (PROCREC (QP.LOCAL.PREDICATE NAME ARITY MODULE))) (COND ((NOT (GETHASH PROCREC TABLE)) (PUTHASH 
PROCREC T TABLE) (QP.ABOLISH NAME ARITY MODULE))) (EVAL FORM))) (T (EVAL FORM))))) (PRINT (CLOSEF 
STREAM)))))

(QP.STORE.INCORE

(LAMBDA (INSTR ARG1 ARG2 ARG3 ARG4) (QP.STORE.INSTR QP.LAST.CLAUSE.RECORD INSTR ARG1 ARG2 ARG3 ARG4)))

(QP.STORE.INDEX

(LAMBDA (CLAUSE INSTR NEXTCLAUSE) (\PUTBASEPTR CLAUSE 0 (OR NEXTCLAUSE QP.FAILURE.CLAUSE)) (\PUTBASE 
CLAUSE 0 (IPLUS (\GETBASE CLAUSE 0) (QP.LEFT.OP.CODE INSTR)))))

(QP.STORE.INSTR

(LAMBDA ARGLIST (LET* ((CLAUSE (ARG ARGLIST 1)) (INSTR (ARG ARGLIST 2)) (OPCODE (GETHASH INSTR 
QP.INSTRUCTION.HARRAY)) (FIELDS (CADR (GETHASH OPCODE QP.INSTRUCTION.HARRAY)))) (COND ((EQUAL INSTR (
QUOTE load.pvar.address)) (SHOULDNT (QUOTE load.pvar.address))) ((EQUAL OPCODE QP.EXTENSION.OPCODE) (
LET ((TYPE (CADDR (GETHASH (GETHASH INSTR QP.EXTENSION.HARRAY) QP.EXTENSION.HARRAY)))) (COND ((EQ TYPE
 (QUOTE word)) (QP.STORE.INSTR.EXTEND.WORD CLAUSE INSTR (ARG ARGLIST 3))) ((EQ TYPE (QUOTE cell)) (
QP.STORE.INSTR.EXTEND.CELL CLAUSE INSTR (ARG ARGLIST 3))) (T (QP.STORE.INSTR.EXTEND CLAUSE INSTR))))) 
(T (SELECTQ FIELDS (NIL (QP.STORE.INSTR.NULL CLAUSE INSTR)) (a1.cell (QP.STORE.INSTR.BYTE.CELL CLAUSE 
INSTR (ARG ARGLIST 3) (ARG ARGLIST 4))) (a1.atom (QP.STORE.INSTR.BYTE.ATOM CLAUSE INSTR (ARG ARGLIST 3
) (ARG ARGLIST 4))) (a1.functor (QP.STORE.INSTR.BYTE.FUNCTOR CLAUSE INSTR (ARG ARGLIST 3) (ARG ARGLIST
 4) (ARG ARGLIST 5))) (a1.y2 (QP.STORE.INSTR.BYTE.BYTE CLAUSE INSTR (ARG ARGLIST 3) (ARG ARGLIST 4) (
QUOTE a1) (QUOTE y2))) (a2.y1 (QP.STORE.INSTR.BYTE.BYTE CLAUSE INSTR (ARG ARGLIST 3) (ARG ARGLIST 4) (
QUOTE a2) (QUOTE y1))) (a2.a1 (QP.STORE.INSTR.BYTE.BYTE CLAUSE INSTR (ARG ARGLIST 3) (ARG ARGLIST 4) (
QUOTE a2) (QUOTE a1))) (a1.a2 (QP.STORE.INSTR.BYTE.BYTE CLAUSE INSTR (ARG ARGLIST 3) (ARG ARGLIST 4) (
QUOTE a1) (QUOTE a2))) (a1 (QP.STORE.INSTR.AREG CLAUSE INSTR (ARG ARGLIST 3))) (y1 (
QP.STORE.INSTR.BYTE CLAUSE INSTR (ARG ARGLIST 3) (QUOTE y1))) (byte (QP.STORE.INSTR.BYTE CLAUSE INSTR 
(ARG ARGLIST 3) (QUOTE byte))) (cell (QP.STORE.INSTR.CELL CLAUSE INSTR (ARG ARGLIST 3))) (functor (
QP.STORE.INSTR.FUNCTOR CLAUSE INSTR (ARG ARGLIST 3) (ARG ARGLIST 4))) (atom (QP.STORE.INSTR.ATOM 
CLAUSE INSTR (ARG ARGLIST 3))) (size.procedure (QP.STORE.INSTR.SIZE.PROCEDURE CLAUSE INSTR (ARG 
ARGLIST 3) (ARG ARGLIST 4) (ARG ARGLIST 5) (ARG ARGLIST 6))) (size.offset (QP.STORE.INSTR.SIZE.OFFSET 
CLAUSE INSTR (ARG ARGLIST 3) (ARG ARGLIST 4))) (offset (QP.STORE.INSTR.OFFSET CLAUSE INSTR (ARG 
ARGLIST 3))) (procedure (QP.STORE.INSTR.PROCEDURE CLAUSE INSTR (ARG ARGLIST 3) (ARG ARGLIST 4) (ARG 
ARGLIST 5))) (PROGN (PRINT (LIST OPCODE INSTR FIELDS)) (SHOULDNT))))))))

(QP.STORE.INSTR.AREG

(LAMBDA (CLAUSEPTR INSTR BYTE) (LET ((OPCODE (QP.LEFT.OP.CODE INSTR))) (QP.REGISTER.OR.MEMORY.1 BYTE 
OPCODE) (\PUTBASE CLAUSEPTR QP.CLAUSE.OFFSET (IPLUS BYTE OPCODE)) (INCR QP.CLAUSE.OFFSET 1))))

(QP.STORE.INSTR.ATOM

(LAMBDA (CLAUSEPTR INSTR ATOM) (LET ((PLACE (\ADDBASE CLAUSEPTR QP.CLAUSE.OFFSET))) (\PUTBASE PLACE 0 
(QP.LEFT.OP.CODE INSTR)) (\PUTBASE PLACE 1 (\LOLOC ATOM))) (INCR QP.CLAUSE.OFFSET 2)))

(QP.STORE.INSTR.BYTE

(LAMBDA (CLAUSEPTR INSTR BYTE TYPE) (\PUTBASE CLAUSEPTR QP.CLAUSE.OFFSET (IPLUS (SELECTQ TYPE ((a1 
byte) BYTE) (y1 (IPLUS BYTE QP.PERMANENT.OFFSET)) (SHOULDNT)) (QP.LEFT.OP.CODE INSTR))) (INCR 
QP.CLAUSE.OFFSET 1)))

(QP.STORE.INSTR.BYTE.ATOM

(LAMBDA (CLAUSEPTR INSTR BYTE ATOM) (LET ((OPCODE (QP.LEFT.OP.CODE INSTR))) (QP.REGISTER.OR.MEMORY.1 
BYTE OPCODE) (\PUTBASE CLAUSEPTR QP.CLAUSE.OFFSET (IPLUS BYTE OPCODE)) (\PUTBASE CLAUSEPTR (ADD1 
QP.CLAUSE.OFFSET) (\LOLOC ATOM)) (INCR QP.CLAUSE.OFFSET 2))))

(QP.STORE.INSTR.BYTE.BYTE

(LAMBDA (CLAUSEPTR INSTR BYTE1 BYTE2 FIELD1 FIELD2) (LET ((OPCODE (QP.LEFT.OP.CODE INSTR)) (HAS.Y.REG 
(OR (MEMBER FIELD1 (QUOTE (y1 y2))) (MEMBER FIELD2 (QUOTE (y1 y2)))))) (COND ((EQ FIELD1 (QUOTE a1)) (
COND ((GREATERP BYTE1 4) (INCR OPCODE 512)) (T (SETQ BYTE1 (QP.AREG.REGISTER BYTE1))))) ((EQ FIELD2 (
QUOTE a1)) (COND ((GREATERP BYTE2 4) (INCR OPCODE 512)) (T (SETQ BYTE2 (QP.AREG.REGISTER BYTE2)))))) (
COND ((EQ FIELD1 (QUOTE a2)) (COND ((MEMBER FIELD2 (QUOTE (y1 y2))) (COND ((GREATERP BYTE1 4) (INCR 
OPCODE 512)) (T (SETQ BYTE1 (QP.AREG.REGISTER BYTE1))))) (T (COND ((GREATERP BYTE1 4) (INCR OPCODE 
1024)) (T (SETQ BYTE1 (QP.AREG.REGISTER BYTE1))))))) ((EQ FIELD2 (QUOTE a2)) (COND ((MEMBER FIELD2 (
QUOTE (y1 y2))) (COND ((GREATERP BYTE2 4) (INCR OPCODE 512)) (T (SETQ BYTE2 (QP.AREG.REGISTER BYTE2)))
)) (T (COND ((GREATERP BYTE2 4) (INCR OPCODE 1024)) (T (SETQ BYTE2 (QP.AREG.REGISTER BYTE2)))))))) (
LET (DEST1 DEST2) (COND ((MEMBER FIELD2 (QUOTE (y1 y2))) (SETQ BYTE2 (IPLUS BYTE2 QP.PERMANENT.OFFSET)
))) (COND ((EQ FIELD1 (QUOTE a2)) (SETQ DEST1 BYTE2) (SETQ DEST2 BYTE1)) ((EQ FIELD1 (QUOTE a1)) (SETQ
 DEST1 BYTE1) (SETQ DEST2 BYTE2)) (T (SHOULDNT))) (\PUTBASE CLAUSEPTR QP.CLAUSE.OFFSET (IPLUS DEST1 
OPCODE)) (\PUTBASE CLAUSEPTR (ADD1 QP.CLAUSE.OFFSET) DEST2) (INCR QP.CLAUSE.OFFSET 2)))))

(QP.STORE.INSTR.BYTE.CELL

(LAMBDA (CLAUSEPTR INSTR BYTE CELL) (LET ((OPCODE (QP.LEFT.OP.CODE INSTR))) (QP.REGISTER.OR.MEMORY.1 
BYTE OPCODE) (\PUTBASE CLAUSEPTR QP.CLAUSE.OFFSET (IPLUS BYTE OPCODE)) (LET ((NEXT (ADD1 
QP.CLAUSE.OFFSET))) (QP.LOAD.GC.PROTECT CELL) (\PUTBASE CLAUSEPTR NEXT (PLUS (QP.OBJ.TAG CELL) (\HILOC
 CELL))) (\PUTBASE CLAUSEPTR (ADD1 NEXT) (\LOLOC CELL)) (INCR QP.CLAUSE.OFFSET 3)))))

(QP.STORE.INSTR.BYTE.FUNCTOR

(LAMBDA (CLAUSEPTR INSTR BYTE NAME ARITY) (LET ((PLACE (\ADDBASE CLAUSEPTR QP.CLAUSE.OFFSET)) (OPCODE 
(QP.LEFT.OP.CODE INSTR))) (QP.REGISTER.OR.MEMORY.1 BYTE OPCODE) (\PUTBASE PLACE 0 (PLUS BYTE OPCODE)) 
(\PUTBASE PLACE 1 (PLUS symbol.tag.16 ARITY)) (\PUTBASE PLACE 2 (\LOLOC NAME))) (INCR QP.CLAUSE.OFFSET
 3)))

(QP.STORE.INSTR.CELL

(LAMBDA (CLAUSEPTR INSTR CELL) (QP.LOAD.GC.PROTECT CELL) (LET ((PLACE (\ADDBASE CLAUSEPTR 
QP.CLAUSE.OFFSET))) (\PUTBASE PLACE 0 (QP.LEFT.OP.CODE INSTR)) (\PUTBASE PLACE 1 (PLUS (QP.OBJ.TAG 
CELL) (\HILOC CELL))) (\PUTBASE PLACE 2 (\LOLOC CELL))) (INCR QP.CLAUSE.OFFSET 3)))

(QP.STORE.INSTR.EXTEND

(LAMBDA (CLAUSEPTR INSTR) (LET ((SECONDARY (GETHASH INSTR QP.EXTENSION.HARRAY))) (\PUTBASE CLAUSEPTR 
QP.CLAUSE.OFFSET (IPLUS (LLSH QP.EXTENSION.OPCODE 8) SECONDARY)) (INCR QP.CLAUSE.OFFSET 1))))

(QP.STORE.INSTR.EXTEND.CELL

(LAMBDA (CLAUSEPTR INSTR CELL) (LET ((SECONDARY (GETHASH INSTR QP.EXTENSION.HARRAY))) (\PUTBASE 
CLAUSEPTR QP.CLAUSE.OFFSET (IPLUS (LLSH QP.EXTENSION.OPCODE 8) SECONDARY)) (QP.LOAD.GC.PROTECT CELL) (
\PUTBASE CLAUSEPTR (ADD1 QP.CLAUSE.OFFSET) (IPLUS (QP.OBJ.TAG CELL) (\HILOC CELL))) (\PUTBASE 
CLAUSEPTR (IPLUS QP.CLAUSE.OFFSET 2) (\LOLOC CELL)) (INCR QP.CLAUSE.OFFSET 3))))

(QP.STORE.INSTR.EXTEND.WORD

(LAMBDA (CLAUSEPTR INSTR WORD) (LET ((SECONDARY (GETHASH INSTR QP.EXTENSION.HARRAY))) (\PUTBASE 
CLAUSEPTR QP.CLAUSE.OFFSET (IPLUS (LLSH QP.EXTENSION.OPCODE 8) SECONDARY)) (\PUTBASE CLAUSEPTR (ADD1 
QP.CLAUSE.OFFSET) (\LOLOC WORD)) (INCR QP.CLAUSE.OFFSET 2))))

(QP.STORE.INSTR.FUNCTOR

(LAMBDA (CLAUSEPTR INSTR NAME ARITY) (LET ((PLACE (\ADDBASE CLAUSEPTR QP.CLAUSE.OFFSET))) (\PUTBASE 
PLACE 0 (QP.LEFT.OP.CODE INSTR)) (\PUTBASE PLACE 1 (IPLUS symbol.tag.16 ARITY)) (\PUTBASE PLACE 2 (
\LOLOC NAME))) (INCR QP.CLAUSE.OFFSET 3)))

(QP.STORE.INSTR.NULL

(LAMBDA (CLAUSEPTR INSTR) (\PUTBASE CLAUSEPTR QP.CLAUSE.OFFSET (QP.LEFT.OP.CODE INSTR)) (INCR 
QP.CLAUSE.OFFSET 1)))

(QP.STORE.INSTR.OFFSET

(LAMBDA (CLAUSEPTR INSTR OFFSET) (LET* ((CLAUSE.HILOC (\HILOC CLAUSEPTR)) (CLAUSE.LOLOC (\LOLOC 
CLAUSEPTR)) (ADDRESS (IPLUS OFFSET (LLSH CLAUSE.HILOC 16) CLAUSE.LOLOC)) (ADDRESS.HILOC (LRSH ADDRESS 
16)) (ADDRESS.LOLOC (LOGAND ADDRESS 65535))) (\PUTBASE CLAUSEPTR QP.CLAUSE.OFFSET (IPLUS (
QP.LEFT.OP.CODE INSTR) ADDRESS.HILOC)) (\PUTBASE CLAUSEPTR (ADD1 QP.CLAUSE.OFFSET) ADDRESS.LOLOC) (
INCR QP.CLAUSE.OFFSET 2))))

(QP.STORE.INSTR.PROCEDURE

(LAMBDA (CLAUSEPTR INSTR NAME ARITY MODULE) (LET ((PROC (QP.LOCAL.PREDICATE NAME ARITY MODULE)) (PLACE
 (\ADDBASE CLAUSEPTR QP.CLAUSE.OFFSET))) (\PUTBASE PLACE 0 (PLUS (QP.LEFT.OP.CODE INSTR) (\HILOC PROC)
)) (\PUTBASE PLACE 1 (\LOLOC PROC))) (INCR QP.CLAUSE.OFFSET 2)))

(QP.STORE.INSTR.SIZE.OFFSET

(LAMBDA (CLAUSEPTR INSTR SIZE OFFSET) (LET* ((CLAUSE.HILOC (\HILOC CLAUSEPTR)) (CLAUSE.LOLOC (\LOLOC 
CLAUSEPTR)) (ADDRESS (IPLUS OFFSET (LLSH CLAUSE.HILOC 16) CLAUSE.LOLOC)) (ADDRESS.HILOC (LRSH ADDRESS 
16)) (ADDRESS.LOLOC (LOGAND ADDRESS 65535))) (\PUTBASE CLAUSEPTR QP.CLAUSE.OFFSET (IPLUS (
QP.LEFT.OP.CODE INSTR) ADDRESS.HILOC)) (\PUTBASE CLAUSEPTR (ADD1 QP.CLAUSE.OFFSET) ADDRESS.LOLOC) (
\PUTBASE CLAUSEPTR (IPLUS QP.CLAUSE.OFFSET 2) (ITIMES 2 SIZE)) (INCR QP.CLAUSE.OFFSET 3))))

(QP.STORE.INSTR.SIZE.PROCEDURE

(LAMBDA (CLAUSEPTR INSTR SIZE NAME ARITY MODULE) (LET ((PROC (QP.LOCAL.PREDICATE NAME ARITY MODULE))) 
(\PUTBASE CLAUSEPTR QP.CLAUSE.OFFSET (IPLUS (QP.LEFT.OP.CODE INSTR) (\HILOC PROC))) (\PUTBASE 
CLAUSEPTR (ADD1 QP.CLAUSE.OFFSET) (\LOLOC PROC)) (\PUTBASE CLAUSEPTR (IPLUS QP.CLAUSE.OFFSET 2) (
ITIMES 2 SIZE)) (INCR QP.CLAUSE.OFFSET 3))))

(QP.TRAP.CLAUSE

(NLAMBDA (CLAUSE NAME ARITY MODULE) (SETQ CLAUSE (SETTOPVAL CLAUSE (\MAKENUMBER 2 0))) (\PUTBASEPTR 
CLAUSE 0 (QP.LOCAL.PREDICATE NAME ARITY MODULE)) (\PUTBASEBYTE CLAUSE 0 (QP.OP.CODE (QUOTE trap)))))

(QP.UNIT.CLAUSE

(NLAMBDA (OPCODE NAME ARITY MODULE) (SETQ NAME (QP.LOCAL.PREDICATE NAME ARITY MODULE)) (SETQ OPCODE (
\MAKENUMBER (QP.LEFT.OP.CODE OPCODE) 0)) (\ADDREF OPCODE) (SETF (PROC.CLAUSES NAME) OPCODE) (SETF (
PROC.LASTCLAUSE NAME) QP.FAILURE.CLAUSE) (SETF (PROC.LOFLAG NAME) 1) OPCODE))
)

(RPAQQ QP.LAST.CLAUSE.RECORD
 NIL)
(PRETTYCOMPRINT LOADCOMS)

(RPAQQ LOADCOMS
 ((ADDVARS (GLOBALVARS QP.LAST.CLAUSE.RECORD) (GLOBALVARS QP.CLAUSE.OFFSET) (
GLOBALVARS QP.DUMMY.CLAUSE) (GLOBALVARS QP.DEBUG.CLAUSE) (GLOBALVARS QP.INTERPRET.CLAUSE) (GLOBALVARS 
QP.UNDEFINED.CLAUSE) (GLOBALVARS QP.FAILURE.CLAUSE)) (MACROS QP.REGISTER.OR.MEMORY.1 \LEFTBYTE 
\RIGHTBYTE) (FNS ASSEMBLE.CLAUSE QP.ADD.CLAUSE QP.ALLOCATE.CLAUSE.RECORD QP.AREG.REGISTER 
QP.ATTACH.CLAUSE.RECORD QP.INITIALIZE.PROLOG QP.LOOK QP.LOOK.ATOM QP.LOOK.BYTE QP.LOOK.BYTE.ATOM 
QP.LOOK.BYTE.BYTE QP.LOOK.BYTE.CELL QP.LOOK.BYTE.FUNCTOR QP.LOOK.CELL QP.LOOK.CLAUSE QP.LOOK.CONSTANT 
QP.LOOK.EXTEND QP.LOOK.EXTEND.CELL QP.LOOK.EXTEND.WORD QP.LOOK.FUNCTOR QP.LOOK.INSTR QP.LOOK.NULL 
QP.LOOK.OFFSET QP.LOOK.ONE.CLAUSE QP.LOOK.OPCODE QP.LOOK.PROCEDURE QP.LOOK.SIZE.OFFSET 
QP.LOOK.SIZE.PROCEDURE QP.OBJ.TAG QP.RECONSULT QP.STORE.INCORE QP.STORE.INDEX QP.STORE.INSTR 
QP.STORE.INSTR.AREG QP.STORE.INSTR.ATOM QP.STORE.INSTR.BYTE QP.STORE.INSTR.BYTE.ATOM 
QP.STORE.INSTR.BYTE.BYTE QP.STORE.INSTR.BYTE.CELL QP.STORE.INSTR.BYTE.FUNCTOR QP.STORE.INSTR.CELL 
QP.STORE.INSTR.EXTEND QP.STORE.INSTR.EXTEND.CELL QP.STORE.INSTR.EXTEND.WORD QP.STORE.INSTR.FUNCTOR 
QP.STORE.INSTR.NULL QP.STORE.INSTR.OFFSET QP.STORE.INSTR.PROCEDURE QP.STORE.INSTR.SIZE.OFFSET 
QP.STORE.INSTR.SIZE.PROCEDURE QP.TRAP.CLAUSE QP.UNIT.CLAUSE) (VARS (QP.LAST.CLAUSE.RECORD NIL)) (
DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA ASSEMBLE.CLAUSE) (NLAML 
QP.UNIT.CLAUSE QP.TRAP.CLAUSE) (LAMA QP.STORE.INSTR)))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 ASSEMBLE.CLAUSE)

(ADDTOVAR NLAML
 QP.UNIT.CLAUSE QP.TRAP.CLAUSE)

(ADDTOVAR LAMA
 QP.STORE.INSTR)
)
(PUTPROPS LOAD COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2458 21969 (ASSEMBLE.CLAUSE 2468 . 3072) (QP.ADD.CLAUSE 3074 . 3757) (
QP.ALLOCATE.CLAUSE.RECORD 3759 . 3895) (QP.AREG.REGISTER 3897 . 3967) (QP.ATTACH.CLAUSE.RECORD 3969 . 
4130) (QP.INITIALIZE.PROLOG 4132 . 4940) (QP.LOOK 4942 . 5564) (QP.LOOK.ATOM 5566 . 5708) (
QP.LOOK.BYTE 5710 . 5943) (QP.LOOK.BYTE.ATOM 5945 . 6129) (QP.LOOK.BYTE.BYTE 6131 . 6569) (
QP.LOOK.BYTE.CELL 6571 . 6748) (QP.LOOK.BYTE.FUNCTOR 6750 . 6985) (QP.LOOK.CELL 6987 . 7174) (
QP.LOOK.CLAUSE 7176 . 7369) (QP.LOOK.CONSTANT 7371 . 7510) (QP.LOOK.EXTEND 7512 . 7601) (
QP.LOOK.EXTEND.CELL 7603 . 7766) (QP.LOOK.EXTEND.WORD 7768 . 7946) (QP.LOOK.FUNCTOR 7948 . 8140) (
QP.LOOK.INSTR 8142 . 8672) (QP.LOOK.NULL 8674 . 8761) (QP.LOOK.OFFSET 8763 . 9166) (QP.LOOK.ONE.CLAUSE
 9168 . 9290) (QP.LOOK.OPCODE 9292 . 10982) (QP.LOOK.PROCEDURE 10984 . 11134) (QP.LOOK.SIZE.OFFSET 
11136 . 11604) (QP.LOOK.SIZE.PROCEDURE 11606 . 11828) (QP.OBJ.TAG 11830 . 12027) (QP.RECONSULT 12029
 . 12555) (QP.STORE.INCORE 12557 . 12680) (QP.STORE.INDEX 12682 . 12867) (QP.STORE.INSTR 12869 . 15071
) (QP.STORE.INSTR.AREG 15073 . 15294) (QP.STORE.INSTR.ATOM 15296 . 15510) (QP.STORE.INSTR.BYTE 15512
 . 15753) (QP.STORE.INSTR.BYTE.ATOM 15755 . 16046) (QP.STORE.INSTR.BYTE.BYTE 16048 . 17391) (
QP.STORE.INSTR.BYTE.CELL 17393 . 17803) (QP.STORE.INSTR.BYTE.FUNCTOR 17805 . 18152) (
QP.STORE.INSTR.CELL 18154 . 18453) (QP.STORE.INSTR.EXTEND 18455 . 18677) (QP.STORE.INSTR.EXTEND.CELL 
18679 . 19086) (QP.STORE.INSTR.EXTEND.WORD 19088 . 19380) (QP.STORE.INSTR.FUNCTOR 19382 . 19653) (
QP.STORE.INSTR.NULL 19655 . 19796) (QP.STORE.INSTR.OFFSET 19798 . 20243) (QP.STORE.INSTR.PROCEDURE 
20245 . 20545) (QP.STORE.INSTR.SIZE.OFFSET 20547 . 21066) (QP.STORE.INSTR.SIZE.PROCEDURE 21068 . 21443
) (QP.TRAP.CLAUSE 21445 . 21666) (QP.UNIT.CLAUSE 21668 . 21967)))))
STOP