(FILECREATED " 8-Feb-86 15:29:18" {DSK}<LISPFILES2>IMPROVEDDCOMS>INTERPRET.;1
 3225   

      changes to:  (VARS INTERPRETCOMS))


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

(PRETTYCOMPRINT INTERPRETCOMS)

(RPAQQ INTERPRETCOMS
 ((FNS PROLOG.INIT.REGISTERS R.extend W.extend def.both.mode def.opcode 
def.read.mode def.write.mode)))
(DEFINEQ

(PROLOG.INIT.REGISTERS

(LAMBDA (X) (if (NOT (CCODEP (QUOTE \GCSCANPROLOG))) then (PROLOG.INIT.MEMORY) (WritePrologPtrAnd0Tag 
LMBase (MakeUCodeRealBaseAddr (fetch (ARRAYP BASE) of PROLOG.ENABLE.PUFN.TABLE))) (
WritePrologPtrAnd0Tag PUfnTableBase (MakeUCodeRealBaseAddr (fetch (ARRAYP BASE) of PROLOG.PUFN.TABLE))
) (WritePrologPtrAnd0Tag LispEmuCodeBase (fetch (ARRAYP BASE) of (GETD (QUOTE QP.PROLOG)))) (
WritePrologPtrAnd0Tag Debug 0) (SETQ QP.init.H (\ADDBASE QP.membot 768)) (SETQ QP.init.E (\ADDBASE 
QP.membot 1572864)) (SETQ QP.memtop (\ADDBASE QP.membot 2097152)) (if (NOT (CCODEP (QUOTE 
\GCSCANPROLOG\))) then (COMPILE! (QUOTE \GCSCANPROLOG\))) (MOVD (QUOTE \GCSCANPROLOG\) (QUOTE 
\GCSCANPROLOG)) (PROMPTPRINT "One-time Prolog initialization completed.")) (put.24 H QP.init.H) (
put.24 HB QP.init.H) (put.24 S QP.init.H) (put.24 TR QP.init.E) (put.24 E QP.init.E) (put.24 B 
QP.init.E) (put.24 B0 QP.init.E) (put.24 R NIL) (put.24 C X) (put.32 T0 (tag.ref NIL)) (put.32 T1 (
tag.ref NIL)) (\PUTBASEPTR QP.membot 0 NIL) (put.24 CP QP.membot) (put.addr B 0 (get.24 B0)) (put.addr
 B 1 (get.24 E)) (put.addr B 2 (get.24 CP)) (put.addr B 3 (get.24 B)) (put.addr B 4 QP.FAILURE.CLAUSE)
 (put.addr B 5 (get.24 TR)) (put.addr B 6 (get.24 H)) (increment.cell.pointer B 7) (put.24 B0 (get.24 
B)) (put.24 E (get.24 B)) (put.24 P (PROC.CLAUSES (get.24 C))) (put.4 W READ) (put.16 I 0) (if (GETD (
QUOTE QP.init.windows)) then (QP.init.windows))))

(R.extend

(LAMBDA NIL (SPREADAPPLY* (\VAG2 0 (\GETBASE QP.extendR (get.16 N))))))

(W.extend

(LAMBDA NIL (SPREADAPPLY* (\VAG2 0 (\GETBASE QP.extendW (get.16 N))))))

(def.both.mode

(NLAMBDA L (def.opcode (CAR L) 0 (CDDR L)) (def.opcode (CAR L) 1 (CDDR L))))

(def.opcode

(LAMBDA (name mode body) (PROG (F O) (SETQ F (PACK* (if (ZEROP mode) then (QUOTE R.) else (QUOTE W.)) 
name)) (PUTD F (CONS (QUOTE LAMBDA) (CONS (QUOTE NIL) body))) (QP.ADDTOFILE F (QUOTE FNS)) (SETQ O (
QP.OP.CODE name)) (if (NOT (SMALLP O)) then (PRIN1 "Undefined opcode: ") (PRINT name) elseif (ILESSP O
 256) then (SETA QP.opcode (IPLUS O mode) F) else (SETA QP.opcode (IPLUS O mode -256) F)))))

(def.read.mode

(NLAMBDA L (def.opcode (CAR L) 0 (CDDR L))))

(def.write.mode

(NLAMBDA L (def.opcode (CAR L) 1 (CDDR L))))
)
(PRETTYCOMPRINT INTERPRETCOMS)

(RPAQQ INTERPRETCOMS
 ((FNS PROLOG.INIT.REGISTERS R.extend W.extend def.both.mode def.opcode 
def.read.mode def.write.mode) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (
NLAMA def.write.mode def.read.mode def.both.mode) (NLAML) (LAMA)))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 def.write.mode def.read.mode def.both.mode)

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(PUTPROPS INTERPRET COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (376 2659 (PROLOG.INIT.REGISTERS 386 . 1838) (R.extend 1840 . 1925) (W.extend 1927 . 
2012) (def.both.mode 2014 . 2109) (def.opcode 2111 . 2526) (def.read.mode 2528 . 2591) (def.write.mode
 2593 . 2657)))))
STOP