(FILECREATED "17-Apr-86 16:40:58" {ERIS}<PROLOGCORE>SOURCES>OPCODES.;5 10675
changes to: (VARS REGISTER.ASSIGNMENTS OPCODESCOMS)
(FNS PROLOG.AROUNDEXITFN)
previous date: " 8-Feb-86 17:02:23" {ERIS}<PROLOGCORE>SOURCES>OPCODES.;4)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT OPCODESCOMS)
(RPAQQ OPCODESCOMS [(FNS PROLOG.GEN.OP# PROLOG.INCR.P ReadPrologPtr ReadPrologTag
WritePrologPtrAnd0Tag WritePrologTagAndPtr)
(FNS \WRITE-TOP-HALF \READ-TOP-HALF \WRITE-BOTTOM-HALF \READ-BOTTOM-HALF
PROLOG.SAVE.REGISTERS PROLOG.RESTORE.REGISTERS)
(VARS REGISTER.ASSIGNMENTS)
(RECORDS REGISTERDEF)
(FNS PrologNameToURegs PrologNameToHiUReg PrologNameToLoUReg)
(MACROS PROLOG.INCR.P ReadPrologPtr ReadPrologTag WritePrologPtrAnd0Tag
WritePrologTagAndPtr WriteProlog16 ReadProlog16)
(MACROS PrologOpcode)
(FNS MAKEOP)
(FNS \RDPROLOGPTR.UFN \POPDISP.UFN \RDPROLOGTAG.UFN \WRTPTR&TAG.UFN
\WRTPTR&0TAG.UFN)
(PROP DOPVAL POPDISP)
(FNS \MAKE-REGISTER-FILE)
[DECLARE: DONTEVAL@LOAD DOCOPY (*)
(VARS (\REGISTER-FILE (\MAKE-REGISTER-FILE]
(FNS PROLOG.AROUNDEXITFN)
(DECLARE: DONTEVAL@LOAD DOCOPY (*)
(ADDVARS (AROUNDEXITFNS PROLOG.AROUNDEXITFN)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML WritePrologTagAndPtr WritePrologPtrAnd0Tag
ReadPrologTag ReadPrologPtr)
(LAMA])
(DEFINEQ
(PROLOG.GEN.OP#
(LAMBDA (OP#) (* hdj "13-May-85 14:29") (PACK* "OP" OP#)))
(PROLOG.INCR.P
(LAMBDA NIL (* hdj " 6-May-85 17:34") (LET ((OLDPC (ReadPrologPtr P))) (WritePrologPtrAnd0Tag P (
\ADDBASE OLDPC 1)))))
(ReadPrologPtr
(NLAMBDA (RegisterName) (* hdj " 6-May-85 17:29") ((OPCODES RDPROLOGPTR) (PrologNameToURegs
RegisterName))))
(ReadPrologTag
(NLAMBDA (RegisterName) (* hdj " 6-May-85 17:36") ((OPCODES RDPROLOGTAG) (PrologNameToURegs
RegisterName))))
(WritePrologPtrAnd0Tag
(NLAMBDA (RegisterName PtrVal) (* hdj " 6-May-85 17:33") ((OPCODES WRTPTR&0TAG) (PrologNameToURegs
RegisterName) (EVAL PtrVal))))
(WritePrologTagAndPtr
(NLAMBDA (RegisterName TagVal PtrVal) (* hdj " 6-May-85 17:32") ((OPCODES WRTPTR&TAG) (
PrologNameToURegs RegisterName) (EVAL TagVal) (EVAL PtrVal))))
)
(DEFINEQ
(\WRITE-TOP-HALF
(LAMBDA (REGISTER VALUE) (* hdj "16-Oct-85 15:41") (LET ((HILOC (fetch (REGISTERDEF AHI) of REGISTER))
) ((OPCODES WRTPTR&0TAG) (LOGOR (LLSH HILOC 8) HILOC) VALUE))))
(\READ-TOP-HALF
(LAMBDA (REGISTER) (* hdj "28-Oct-85 12:31") (LET ((HILOC (fetch (REGISTERDEF AHI) of REGISTER))) (
\LOLOC ((OPCODES RDPROLOGPTR) (LOGOR (LLSH HILOC 8) HILOC))))))
(\WRITE-BOTTOM-HALF
(LAMBDA (REGISTER VALUE) (* hdj "16-Oct-85 15:42") (LET ((LOLOC (fetch (REGISTERDEF ALO) of REGISTER))
) ((OPCODES WRTPTR&0TAG) (LOGOR (LLSH LOLOC 8) LOLOC) VALUE))))
(\READ-BOTTOM-HALF
(LAMBDA (REGISTER) (* hdj "15-Nov-85 11:07") (LET ((LOLOC (fetch (REGISTERDEF ALO) of REGISTER))) (
\LOLOC ((OPCODES RDPROLOGPTR) (LLSH LOLOC 8))))))
(PROLOG.SAVE.REGISTERS
(LAMBDA NIL (* hdj "20-Nov-85 14:04") (DECLARE (GLOBALVARS REGISTER.ASSIGNMENTS \REGISTER-FILE)) (for
REGISTER in REGISTER.ASSIGNMENTS as REG# from 0 when (LET ((NAME (fetch (REGISTERDEF NAME) of REGISTER
))) (AND (NEQ NAME (QUOTE *)) (NEQ NAME (QUOTE Trashable)) (NEQ NAME (QUOTE Zero)))) do (SETA
\REGISTER-FILE (ITIMES REG# 2) (\READ-TOP-HALF REGISTER)) (SETA \REGISTER-FILE (ADD1 (ITIMES REG# 2))
(\READ-BOTTOM-HALF REGISTER)))))
(PROLOG.RESTORE.REGISTERS
(LAMBDA NIL (* hdj "20-Nov-85 14:05") (DECLARE (GLOBALVARS REGISTER.ASSIGNMENTS \REGISTER-FILE)) (* *
assume that the registers we must not touch are the last ones in REGISTER.ASSIGNMENTS) (for REGISTER
in REGISTER.ASSIGNMENTS as REG# from 0 when (LET ((NAME (fetch (REGISTERDEF NAME) of REGISTER))) (AND
(NEQ NAME (QUOTE *)) (NEQ NAME (QUOTE Trashable)) (NEQ NAME (QUOTE Zero)))) do (\WRITE-TOP-HALF
REGISTER (ELT \REGISTER-FILE (ITIMES REG# 2))) (\WRITE-BOTTOM-HALF REGISTER (ELT \REGISTER-FILE (ADD1
(ITIMES REG# 2)))))))
)
(RPAQQ REGISTER.ASSIGNMENTS ((P 28 22)
(CP 61 154)
(C 234 233)
(R 232 231)
(S 229 227)
(H 223 221)
(HB 220 219)
(TR 218 217)
(E 211 206)
(B 205 204)
(B0 193 189)
(T0 188 186)
(T1 177 159)
(N 155 155)
(I 110 110)
(* * Special registers)
(CurClause 74 73)
(A1 21 20)
(A2 238 237)
(A3 236 235)
(A4 18 17)
(W 54 54)
(Debug 60 60)
(LMBase 108 108)
(PUfnTableBase 107 107)
(LispEmuCodeBase 95 94)
(VMlim 156 156)
(A0Base 158 158)
(A1Base 157 157)
(PFCont 78 78)
(PInit 151 151)
(DeltaPC 63 63)
(Save 72 72)
(Trashable 55 55)
(Zero 97 97)))
[DECLARE: EVAL@COMPILE
(RECORD REGISTERDEF (NAME ALO AHI))
]
(DEFINEQ
(PrologNameToURegs
(LAMBDA (NAME) (* hdj "30-May-85 18:00") (LET ((REG (FASSOC NAME REGISTER.ASSIGNMENTS))) (OR REG (HELP
"Unknown Prolog register" NAME)) (LOGOR (LLSH (fetch (REGISTERDEF ALO) of REG) 8) (fetch (REGISTERDEF
AHI) of REG)))))
(PrologNameToHiUReg
(LAMBDA (NAME) (* hdj "30-May-85 18:01") (LET ((REG (FASSOC NAME REGISTER.ASSIGNMENTS))) (OR REG (HELP
"Unknown Prolog register" NAME)) (fetch (REGISTERDEF AHI) of REG))))
(PrologNameToLoUReg
(LAMBDA (NAME) (* hdj "30-May-85 18:01") (LET ((REG (FASSOC NAME REGISTER.ASSIGNMENTS))) (OR REG (HELP
"Unknown Prolog register" NAME)) (fetch (REGISTERDEF ALO) of REG))))
)
(DECLARE: EVAL@COMPILE
[PUTPROPS PROLOG.INCR.P MACRO (QUOTE (LET ((OLDPC (ReadPrologPtr P)))
(WritePrologPtrAnd0Tag P (\ADDBASE OLDPC 1]
[PUTPROPS ReadPrologPtr MACRO (ARGS (LET* ((RegisterName (CAR ARGS))
(REGDEF (PrologNameToURegs RegisterName)))
(BQUOTE ((OPCODES RDPROLOGPTR)
, REGDEF]
[PUTPROPS ReadPrologTag MACRO (ARGS (LET* ((RegisterName (CAR ARGS))
(REGDEF (PrologNameToURegs RegisterName)))
(BQUOTE ((OPCODES RDPROLOGTAG)
, REGDEF]
[PUTPROPS WritePrologPtrAnd0Tag MACRO (ARGS (LET* ((RegisterName (CAR ARGS))
(PtrVal (CADR ARGS))
(REGDEF (PrologNameToURegs RegisterName)))
(BQUOTE ((OPCODES WRTPTR&0TAG)
, REGDEF , PtrVal]
[PUTPROPS WritePrologTagAndPtr MACRO (ARGS (LET* ((RegisterName (CAR ARGS))
(TagVal (CADR ARGS))
(PtrVal (CADDR ARGS))
(REGDEF (PrologNameToURegs RegisterName)))
(BQUOTE ((OPCODES WRTPTR&TAG)
, REGDEF , TagVal , PtrVal]
[PUTPROPS WriteProlog16 MACRO (ARGS (* * write 16 bits into a Prolog register. Simulated by writing
24 bits in two chunks - the second chunk overwrites the first.
HACK!)
(LET* ((RegisterName (CAR ARGS))
(PtrVal (CADR ARGS))
(REGDEF (PrologNameToLoUReg RegisterName)))
(BQUOTE ((OPCODES WRTPTR&0TAG)
,
(LOGOR (LLSH REGDEF 8)
REGDEF)
, PtrVal]
[PUTPROPS ReadProlog16 MACRO (ARGS (* * read 16 bits from a Prolog register. We do this by reading
from a zero register into hi and the register we want into lo.
HACK!)
(LET* [(RegisterName (CAR ARGS))
(REGDEF (PrologNameToLoUReg RegisterName))
(ZEROREGDEF (PrologNameToLoUReg (QUOTE Zero]
(BQUOTE ((OPCODES RDPROLOGPTR)
,
(LOGOR (LLSH ZEROREGDEF 8)
REGDEF]
)
(DECLARE: EVAL@COMPILE
[PUTPROPS PrologOpcode MACRO (ARGS (LET ((N (CAR ARGS)))
(LIST (MKATOM (CONCAT "PrologOp" N]
)
(DEFINEQ
(MAKEOP
(LAMBDA (InstructionName UFNFN) (* hdj " 4-Jun-85 21:44") (PROG ((ItsOpcode (\FINDOP InstructionName))
) (\SETUFNENTRY (fetch (OPCODE OP#) of ItsOpcode) UFNFN (IDIFFERENCE (IPLUS 1 (COND ((ZEROP (fetch (
OPCODE OPNARGS) of ItsOpcode)) 0) (T 1))) (fetch (OPCODE LEVADJ) of ItsOpcode)) (fetch (OPCODE OPNARGS
) of ItsOpcode)))))
)
(DEFINEQ
(\RDPROLOGPTR.UFN
(LAMBDA (A B) (* hdj " 4-Jun-85 21:46") (HELP A B)))
(\POPDISP.UFN
(LAMBDA (A B) (* hdj " 4-Jun-85 21:44") (HELP A B)))
(\RDPROLOGTAG.UFN
(LAMBDA (A B) (* hdj " 4-Jun-85 21:47") (HELP A B)))
(\WRTPTR&TAG.UFN
(LAMBDA (A B) (* hdj " 4-Jun-85 21:48") (HELP A B)))
(\WRTPTR&0TAG.UFN
(LAMBDA (A B) (* hdj " 4-Jun-85 21:48") (HELP A B)))
)
(PUTPROPS POPDISP DOPVAL (1 POPDISP))
(DEFINEQ
(\MAKE-REGISTER-FILE
(LAMBDA NIL (* hdj "20-Nov-85 15:06") (ARRAY (ITIMES (LENGTH REGISTER.ASSIGNMENTS) 2) (QUOTE WORD) 0 0
)))
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ \REGISTER-FILE (\MAKE-REGISTER-FILE))
)
(DEFINEQ
(PROLOG.AROUNDEXITFN
[LAMBDA (EVENT) (* edited: "17-Apr-86 14:58")
(* * unlock/lock those pages that need to be locked down for Prolog. Only do it if they are really being used -- a
good heuristic is if the memory has been allocated, they are being used. QP.membot will be bound to the base of the
Prolog area if this is so.)
(DECLARE (GLOBALVARS PROLOG.PUFN.TABLE PROLOG.ENABLE.PUFN.TABLE QP.membot QP.ABase))
(if QP.membot
then (SELECTQ EVENT
((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT BEFORESAVEVM)
(PROLOG.SAVE.REGISTERS))
((AFTERLOGOUT AFTERMAKESYS AFTERSYSOUT AFTERSAVEVM)
(PROLOG.RESTORE.REGISTERS)
(* * lock these things down and tell Prolog emulator about their real addresses)
(WritePrologPtrAnd0Tag PUfnTableBase (MakeUCodeVirtBaseAddr
(fetch (ARRAYP BASE) of
PROLOG.PUFN.TABLE)))
(WritePrologPtrAnd0Tag LMBase (MakeUCodeVirtBaseAddr
(fetch (ARRAYP BASE) of
PROLOG.ENABLE.PUFN.TABLE)))
(* lock the A registers, which occupy 2 pages)
(WritePrologPtrAnd0Tag A0Base (MakeUCodeVirtBaseAddr QP.ABase))
(WritePrologPtrAnd0Tag A1Base (MakeUCodeVirtBaseAddr (\ADDBASE
QP.ABase
WORDSPERPAGE)))
(WritePrologPtrAnd0Tag PInit 0))
(PROGN)))
NIL])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(ADDTOVAR AROUNDEXITFNS PROLOG.AROUNDEXITFN)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML WritePrologTagAndPtr WritePrologPtrAnd0Tag ReadPrologTag ReadPrologPtr)
(ADDTOVAR LAMA )
)
(PUTPROPS OPCODES COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1541 2368 (PROLOG.GEN.OP# 1551 . 1629) (PROLOG.INCR.P 1631 . 1769) (ReadPrologPtr 1771
. 1899) (ReadPrologTag 1901 . 2029) (WritePrologPtrAnd0Tag 2031 . 2188) (WritePrologTagAndPtr 2190 .
2366)) (2369 4145 (\WRITE-TOP-HALF 2379 . 2566) (\READ-TOP-HALF 2568 . 2751) (\WRITE-BOTTOM-HALF 2753
. 2943) (\READ-BOTTOM-HALF 2945 . 3117) (PROLOG.SAVE.REGISTERS 3119 . 3582) (PROLOG.RESTORE.REGISTERS
3584 . 4143)) (5092 5746 (PrologNameToURegs 5102 . 5348) (PrologNameToHiUReg 5350 . 5546) (
PrologNameToLoUReg 5548 . 5744)) (7723 8073 (MAKEOP 7733 . 8071)) (8074 8459 (\RDPROLOGPTR.UFN 8084 .
8158) (\POPDISP.UFN 8160 . 8230) (\RDPROLOGTAG.UFN 8232 . 8306) (\WRTPTR&TAG.UFN 8308 . 8381) (
\WRTPTR&0TAG.UFN 8383 . 8457)) (8503 8646 (\MAKE-REGISTER-FILE 8513 . 8644)) (8730 10306 (
PROLOG.AROUNDEXITFN 8740 . 10304)))))
STOP