(FILECREATED "17-Apr-86 16:37:10" {ERIS}<PROLOGCORE>SOURCES>INTERPRET.;5 3368 changes to: (FNS PROLOG.INIT.REGISTERS) previous date: " 8-Feb-86 15:29:18" {ERIS}<PROLOGCORE>SOURCES>INTERPRET.;4) (* 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) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA def.write.mode def.read.mode def.both.mode) (NLAML) (LAMA]) (DEFINEQ (PROLOG.INIT.REGISTERS [LAMBDA (X) (* edited: "17-Apr-86 14:56") (if (NOT (CCODEP (QUOTE \GCSCANPROLOG))) then (PROLOG.INIT.MEMORY) [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)))) ) (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 (628 3102 (PROLOG.INIT.REGISTERS 638 . 2281) (R.extend 2283 . 2368) (W.extend 2370 . 2455) (def.both.mode 2457 . 2552) (def.opcode 2554 . 2969) (def.read.mode 2971 . 3034) (def.write.mode 3036 . 3100))))) STOP