(FILECREATED " 2-Feb-86 18:36:57" {DSK}<LISPFILES2>INTERPRET.LSP;2
 4076   

      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
 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.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (373 3474 (PROLOG.INIT.REGISTERS 383 . 2281) (R.extend 2283 . 2382) (W.extend 2384 . 
2483) (def.both.mode 2485 . 2630) (def.opcode 2632 . 3289) (def.read.mode 3291 . 3380) (def.write.mode
 3382 . 3472)))))
STOP