File [eris]<PrologCore>QP1.5>Sources>apr-86>OPCODES!1

(FILECREATED " 8-Feb-86 17:02:23" {DSK}<LISPFILES2>IMPROVEDDCOMS>OPCODES.;1 9410   

      previous date: " 5-Dec-85 19:49:00" {GOEDEL}</usr2/pds/updating/>OPCODES)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT OPCODESCOMS)

(RPAQQ OPCODESCOMS ((SCCS) (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)))))
(* %%G%  %%W% )
(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) (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) (* hdj "20-Nov-85 14:05") (* * 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 (
MakeUCodeRealBaseAddr (fetch (ARRAYP BASE) of PROLOG.PUFN.TABLE))) (WritePrologPtrAnd0Tag LMBase (
MakeUCodeRealBaseAddr (fetch (ARRAYP BASE) of PROLOG.ENABLE.PUFN.TABLE))) (* lock the A registers, 
which occupy 2 pages) (WritePrologPtrAnd0Tag A0Base (MakeUCodeRealBaseAddr QP.ABase)) (
WritePrologPtrAnd0Tag A1Base (MakeUCodeRealBaseAddr (\ADDBASE QP.ABase WORDSPERPAGE)))) (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 (1320 2147 (PROLOG.GEN.OP# 1330 . 1408) (PROLOG.INCR.P 1410 . 1548) (ReadPrologPtr 1550
 . 1678) (ReadPrologTag 1680 . 1808) (WritePrologPtrAnd0Tag 1810 . 1967) (WritePrologTagAndPtr 1969 . 
2145)) (2148 3924 (\WRITE-TOP-HALF 2158 . 2345) (\READ-TOP-HALF 2347 . 2530) (\WRITE-BOTTOM-HALF 2532
 . 2722) (\READ-BOTTOM-HALF 2724 . 2896) (PROLOG.SAVE.REGISTERS 2898 . 3361) (PROLOG.RESTORE.REGISTERS
 3363 . 3922)) (4520 5174 (PrologNameToURegs 4530 . 4776) (PrologNameToHiUReg 4778 . 4974) (
PrologNameToLoUReg 4976 . 5172)) (6900 7250 (MAKEOP 6910 . 7248)) (7251 7636 (\RDPROLOGPTR.UFN 7261 . 
7335) (\POPDISP.UFN 7337 . 7407) (\RDPROLOGTAG.UFN 7409 . 7483) (\WRTPTR&TAG.UFN 7485 . 7558) (
\WRTPTR&0TAG.UFN 7560 . 7634)) (7680 7823 (\MAKE-REGISTER-FILE 7690 . 7821)) (7907 9041 (
PROLOG.AROUNDEXITFN 7917 . 9039)))))
STOP