(FILECREATED "17-Apr-86 16:46:41" {ERIS}<PROLOGCORE>SOURCES>PUTIL.;5 7596
changes to: (FNS MakeUCodeVirtBaseAddr PROLOG.INIT.MEMORY)
(VARS PUTILCOMS)
previous date: " 3-Feb-86 18:40:05" {ERIS}<PROLOGCORE>SOURCES>PUTIL.;4)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PUTILCOMS)
(RPAQQ PUTILCOMS [(FNS \DOGC1)
(FNS DUMMY.FOR.COMPILER MakeUCodeBaseAddr MakeUCodeRealBaseAddr
MakeUCodeVirtBaseAddr PROLOG.INIT.MEMORY PROLOG.INIT.TABLES)
(FNS FILL.PC.TABLE)
(FNS PROLOG.SINGLESTEP)
(MACROS PROLOG.DUMMY.GOES PROLOG.GETNEXTLISPBYTECODE PROLOGOP)
(INITVARS (QP.membot))
(CONSTANTS QP.AReg.pages QP.pages)
(VARS PROLOG.TARGET.OP)
(PROP ARGNAMES PROLOGOP)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(DEFINEQ
(\DOGC1
(LAMBDA NIL (* edited: "30-Nov-85 14:57") (* * \DOGC1 with hook to call Prolog register-trace code) (
AND (GETD (QUOTE \GCSCANPROLOG)) (\GCSCANPROLOG)) (\GCSCANSTACK) (\GCMAPSCAN) (* map thru, releasing
entries) (\GCMAPUNSCAN) (* map thru, unmarking stack entries) NIL))
)
(DEFINEQ
(DUMMY.FOR.COMPILER
(LAMBDA NIL (* hdj "10-May-85 19:13") (QUOTE START)))
(MakeUCodeBaseAddr
(LAMBDA (LISPBASE) (* hdj "22-May-85 16:26") (* * for those ucode routines that need addresses in the
form "bits 8..15,,0..7") (LOGOR (LOGAND (\LOLOC LISPBASE) (MASK.1'S 8 8)) (\HILOC LISPBASE))))
(MakeUCodeRealBaseAddr
(LAMBDA (LISPBASE) (* edited: " 5-Dec-85 19:25") (* * assume LISPBASE is on a page boundary and is
locked down) (* * "return bits [8..15,,0..7]") (LET* ((REALPAGE (\READRP (fetch (POINTER PAGE#) of
LISPBASE))) (SWAPPEDREALPAGE (LOGAND (MASK.1'S 0 16) (LOGOR (LRSH REALPAGE 8) (LLSH REALPAGE 8))))) (*
* the 112 undoes the high-address bit transposition done by the hardware) (if (NEQ 0 (LOGAND 16
SWAPPEDREALPAGE)) then (IPLUS SWAPPEDREALPAGE 112) else SWAPPEDREALPAGE))))
(MakeUCodeVirtBaseAddr
[LAMBDA (LISPBASE) (* edited: "17-Apr-86 16:35")
(* * the microcode assumes LISPBASE is on a page boundary and is locked down)
(* * "return bits [8..15,,0..7]")
(LET ((VIRTPAGE (fetch (POINTER PAGE#) of LISPBASE)))
(LOGAND (MASK.1'S 0 16)
(LOGOR (LRSH VIRTPAGE 8)
(LLSH VIRTPAGE 8])
(PROLOG.INIT.MEMORY
[LAMBDA NIL (* edited: "17-Apr-86 14:55")
(if (LITATOM (GETTOPVAL (QUOTE QP.membot)))
then (RESETFORM (CURSOR WAITINGCURSOR)
(PROLOG.INIT.TABLES)))
(* * set VMlim to be one page higher than last Prolog page)
[WritePrologPtrAnd0Tag VMlim (MakeUCodeBaseAddr (SETQ QP.memtop
(create POINTER
PAGE# ←(IPLUS
(fetch (POINTER PAGE#)
of QP.membot)
QP.pages]
(WritePrologPtrAnd0Tag LMBase (MakeUCodeVirtBaseAddr (fetch (ARRAYP BASE) of
PROLOG.ENABLE.PUFN.TABLE)))
(WritePrologPtrAnd0Tag PUfnTableBase (MakeUCodeVirtBaseAddr (fetch (ARRAYP BASE)
of PROLOG.PUFN.TABLE)))
(WritePrologPtrAnd0Tag A0Base (MakeUCodeVirtBaseAddr QP.ABase))
(WritePrologPtrAnd0Tag A1Base (MakeUCodeVirtBaseAddr (\ADDBASE QP.ABase WORDSPERPAGE)))
(* * initialize the Prolog continuation register to 0)
(WritePrologPtrAnd0Tag PInit 0)
(WritePrologPtrAnd0Tag PFCont 0)
(if (GETD (QUOTE QP.PROLOG))
then (FILL.PC.TABLE (QUOTE QP.PROLOG)
PROLOG.PUFN.TABLE))
T])
(PROLOG.INIT.TABLES
(LAMBDA NIL (* edited: "30-Nov-85 14:54") (DECLARE (GLOBALVARS PROLOG.PUFN.TABLE
PROLOG.ENABLE.PUFN.TABLE QP.membot QP.ABase)) (PROMPTPRINT
"Grabbing 4mb of virtual memory for Prolog - this will take a while... ") (SETQ PROLOG.PUFN.TABLE (
ARRAY 256 (QUOTE WORD) 0 0 128)) (SETQ PROLOG.ENABLE.PUFN.TABLE (ARRAY 256 (QUOTE WORD) 1 0 128)) (
SETQ QP.ABase (SETQ QP.membot (\ALLOCPAGEBLOCK QP.pages))) (* * Having allocated the microcode
interface tables lock them in memory) (\LOCKPAGES (fetch (ARRAYP BASE) of PROLOG.PUFN.TABLE) 1) (
\LOCKPAGES (fetch (ARRAYP BASE) of PROLOG.ENABLE.PUFN.TABLE) 1) (\LOCKPAGES QP.ABase QP.AReg.pages) (
PROMPTPRINT "done.")))
)
(DEFINEQ
(FILL.PC.TABLE
(LAMBDA (DEF TABLE) (* hdj "13-May-85 16:29") (DECLARE (GLOBALVARS PROLOG.TARGET.OP)) (PROG ((CA (OR (
MCODEP DEF) (ERROR DEF "not compiled code"))) CODELOC OPCODEDEF PROLOG.OP.NUM) (if (OR (NOT (ARRAYP
TABLE)) (NEQ (ARRAYSIZE TABLE) 256) (NEQ (ARRAYTYP TABLE) (QUOTE SMALLPOSP))) then (\ILLEGAL.ARG TABLE
)) (* CODELOC GETS INCREMENTED BY THE PROLOG.GETNEXTLISPBYTECODE MACRO) (SETQ CODELOC (fetch (
CODEARRAY STARTPC) of CA)) (bind (B B1 B2 B3 LEN) do (SETQ B (PROLOG.GETNEXTLISPBYTECODE)) (SETQ B1 (
AND (ILESSP 0 (SETQ LEN (fetch OPNARGS of (SETQ OPCODEDEF (\FINDOP B))))) (PROLOG.GETNEXTLISPBYTECODE)
)) (SETQ B2 (AND (ILESSP 1 LEN) (PROLOG.GETNEXTLISPBYTECODE))) (SETQ B3 (AND (ILESSP 2 LEN) (
PROLOG.GETNEXTLISPBYTECODE))) (if (EQ (fetch OPCODENAME of OPCODEDEF) (CAR PROLOG.TARGET.OP)) then (*
* this is written as if somehow it was independent of the exact encoding of the beginning of the code,
but its unlikely) (* this crufty code on top of the PROLOG.TARGET.OP is done as follows.
PROLOG.TARGET.OP is currently RAID followed by SIC. The RAID call doesn't usually exist in normal
code, and thus is a good indicator. The following SIC is just so that we can have a byte in the code
that PRINTCODE ignores. This isn't great, but it allows printcode to work. We could patch this by
using a distinguished opcode for PROLOG.TARGET.OP that PRINTCODE would ignore the following byte, or
by having the compiler emit this table in the first place.) (add CODELOC (LENGTH (CDR PROLOG.TARGET.OP
))) (SETQ PROLOG.OP.NUM (CODELT CA CODELOC)) (SETA TABLE PROLOG.OP.NUM (ADD1 (SETQ CODELOC (ADD1
CODELOC))))) repeatuntil (EQ (fetch OPCODENAME of OPCODEDEF) (QUOTE -X-))) (RETURN (LIST TABLE CA)))))
)
(DEFINEQ
(PROLOG.SINGLESTEP
(LAMBDA NIL (* hdj " 8-May-85 14:23") (printout T "Single step (type key to continue) >> ") (\GETKEY)
(TERPRI)))
)
(DECLARE: EVAL@COMPILE
[PUTPROPS PROLOG.DUMMY.GOES MACRO
(ARGS (LET ((N (CAR ARGS)))
(BQUOTE (SELECTQ (DUMMY.FOR.COMPILER)
(START (GO START))
,@
[for X from 0 to N collect (BQUOTE (, (PROLOG.GEN.OP# X)
(GO , (PROLOG.GEN.OP#
X]
(, (PROLOG.GEN.OP# 255)
(GO , (PROLOG.GEN.OP# 255)))
(FINISHED (GO FINISHED))
NIL]
[PUTPROPS PROLOG.GETNEXTLISPBYTECODE MACRO (NIL (CODELT CA (PROG1 CODELOC (add CODELOC 1]
[PUTPROPS PROLOGOP DMACRO (ARGS (LET ((OP# (CAR ARGS))
(PCINCR (CADR ARGS))
(ACTION (CDDR ARGS)))
(BQUOTE ((OPCODES POPDISP)
(PROGN ((OPCODES ,@ (MKLIST PROLOG.TARGET.OP)
, OP#))
,@ ACTION ,@ (if PCINCR then (LIST PCINCR]
)
(RPAQ? QP.membot )
(DECLARE: EVAL@COMPILE
(RPAQQ QP.AReg.pages 2)
(RPAQQ QP.pages 8192)
(CONSTANTS QP.AReg.pages QP.pages)
)
(RPAQQ PROLOG.TARGET.OP (RAID SIC))
(PUTPROPS PROLOGOP ARGNAMES (OP# PCINCR . ACTION))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS PUTIL COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (907 1202 (\DOGC1 917 . 1200)) (1203 4469 (DUMMY.FOR.COMPILER 1213 . 1290) (
MakeUCodeBaseAddr 1292 . 1512) (MakeUCodeRealBaseAddr 1514 . 2017) (MakeUCodeVirtBaseAddr 2019 . 2457)
(PROLOG.INIT.MEMORY 2459 . 3781) (PROLOG.INIT.TABLES 3783 . 4467)) (4470 6204 (FILL.PC.TABLE 4480 .
6202)) (6205 6353 (PROLOG.SINGLESTEP 6215 . 6351)))))
STOP