(FILECREATED " 4-Oct-84 15:54:54" {ERIS}<LISPCORE>LIBRARY>REMOTEVMEM.;3 8076
changes to: (FNS VMAPPAGE REMOTEPMAP)
(VARS REMOTEVMEMCOMS)
previous date: "13-Jul-84 18:00:46" {ERIS}<LISPCORE>LIBRARY>REMOTEVMEM.;2)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT REMOTEVMEMCOMS)
(RPAQQ REMOTEVMEMCOMS ((FNS CLEARPAGECACHE OPENREMOTEVMEMFILE CLOSEREMOTEVMEMFILE VMAPPAGE REMOTEPMAP
REMOTERETURN REMOTESETWORD DEBUGGINGTRSERVER)
(VARS (REMOTEPAGELST)
(REMOTECACHESIZE 100))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS REMOTEVMEMFILE)
(CONSTANTS \PUPSOC.TELERAID)
(CONSTANTS * TRPUPTYPES)
(ADDVARS * (LIST (CONS (QUOTE PUPTYPES)
TRPUPTYPES)))
(FILES (LOADCOMP)
PUP))))
(DEFINEQ
(CLEARPAGECACHE
[LAMBDA NIL (* lmm "20-AUG-81 16:45")
(SETQ REMOTEPAGELST])
(OPENREMOTEVMEMFILE
[LAMBDA (HOST) (* bvm: "13-Jul-84 17:20")
(SETQ VMEMFILE (create REMOTEVMEMFILE
REMOTEVMEMADDR ←(ETHERPORT HOST)
REMOTEVMEMSOCKET ←(OPENPUPSOCKET])
(CLOSEREMOTEVMEMFILE
[LAMBDA NIL (* bvm: "13-Jul-84 17:11")
(CLEARPAGECACHE)
(AND VMEMFILE (fetch REMOTEVMEMSOCKET of VMEMFILE)
(CLOSEPUPSOCKET (fetch REMOTEVMEMSOCKET of VMEMFILE])
(VMAPPAGE
[LAMBDA (PAGE#) (* lmm " 4-Oct-84 15:45")
(PROG ((ENTRY (ASSOC PAGE# REMOTEPAGELST))
TAIL)
(IF ENTRY
THEN (MOVETOP ENTRY REMOTEPAGELST)
(RETURN (CDR ENTRY)))
[push REMOTEPAGELST (CONS PAGE# (SETQ ENTRY (REMOTEPMAP VMEMFILE PAGE# (\ALLOCBLOCK
WORDSPERPAGE]
(IF (CDR (SETQ TAIL (NTH REMOTEPAGELST REMOTECACHESIZE)))
THEN (RPLACD TAIL))
(RETURN ENTRY])
(REMOTEPMAP
[LAMBDA (FL PAGE# BUFFER) (* lmm " 4-Oct-84 15:49")
(OR (EQ FL VMEMFILE)
(SHOULDNT))
(PROG ((SOC (fetch REMOTEVMEMSOCKET of FL))
INPUP OUTPUP)
(SETUPPUP (SETQ OUTPUP (ALLOCATE.PUP))
(fetch REMOTEVMEMADDR of FL)
\PUPSOC.TELERAID TR.GIVEPAGE (LLSH PAGE# 8)
SOC)
(to \MAXETHERTRIES when (SETQ INPUP (\EXCHANGEPUPS SOC OUTPUP NIL T))
do (SELECTC (fetch PUPTYPE of INPUP)
(TR.HEREISPAGE (RETURN (\BLT BUFFER (fetch PUPCONTENTS of INPUP)
WORDSPERPAGE)))
(TR.ERROR (RETURN (ERROR "INVALID ADDRESS -- PAGE#" PAGE#)))
NIL)
finally (ERROR "REMOTE SYSTEM NOT RESPONDING"))
(RELEASE.PUP OUTPUP)
(AND INPUP (RELEASE.PUP INPUP))
(RETURN BUFFER])
(REMOTERETURN
[LAMBDA NIL (* bvm: "13-Jul-84 17:18")
(bind INPUP (OUTPUP ←(ALLOCATE.PUP))
(SOC ←(fetch REMOTEVMEMSOCKET of VMEMFILE)) first (SETUPPUP OUTPUP (fetch REMOTEVMEMADDR
of VMEMFILE)
\PUPSOC.TELERAID TR.GO NIL SOC)
to \MAXETHERTRIES when (SETQ INPUP (EXCHANGEPUPS SOC OUTPUP NIL T))
do (SELECTC (PROG1 (fetch PUPTYPE of INPUP)
(RELEASE.PUP INPUP))
(TR.GOACK (replace PUPTYPE of OUTPUP with TR.GOREPLY)
(add (fetch PUPID of OUTPUP)
1)
(replace EPREQUEUE of OUTPUP with (QUOTE FREE))
(SENDPUP SOC OUTPUP)
(RETURN))
NIL)
finally (ERROR "REMOTE SYSTEM NOT RESPONDING")
(RELEASE.PUP OUTPUP])
(REMOTESETWORD
[LAMBDA (PTR VALUE) (* bvm: "13-Jul-84 17:19")
(bind INPUP (OUTPUP ←(ALLOCATE.PUP))
(SOC ←(fetch REMOTEVMEMSOCKET of VMEMFILE))
first (SETUPPUP OUTPUP (fetch REMOTEVMEMADDR of VMEMFILE)
\PUPSOC.TELERAID TR.STORE NIL SOC)
(PROGN (PUTPUPWORD OUTPUP 0 (VHILOC PTR))
(PUTPUPWORD OUTPUP 1 (VLOLOC PTR))
(PUTPUPWORD OUTPUP 2 VALUE)
(add (fetch PUPLENGTH of OUTPUP)
(UNFOLD 3 BYTESPERWORD)))
to \MAXETHERTRIES when (SETQ INPUP (EXCHANGEPUPS SOC OUTPUP NIL T))
do (SELECTC (fetch PUPTYPE of INPUP)
(TR.STOREDONE (RETURN))
(TR.ERROR (RETURN (ERROR "INVALID ADDRESS" PTR)))
NIL)
finally (ERROR "REMOTE SYSTEM NOT RESPONDING"))
VALUE])
(DEBUGGINGTRSERVER
[LAMBDA NIL (* bvm: "14-MAR-83 18:07")
(PROG ((SOC (\CREATESOCKET \PUPSOC.TELERAID))
VA STLOC STVAL INPUP OUTPUP)
LP (SETQ INPUP (GETPUP SOC T))
(SELECTC (fetch PUPTYPE of INPUP)
(TR.GIVEPAGE (printout T "REQUEST FOR VA " (SETQ VA (fetch PUPID of INPUP))
T)
(SETUPPUP INPUP (fetch PUPSOURCE of INPUP)
(fetch PUPSOURCESOCKET of INPUP)
TR.HEREISPAGE VA SOC)
(replace PUPLENGTH of INPUP with (IPLUS BYTESPERPAGE \PUPOVLEN))
(for I from 0 to 511 do (PUTPUPBYTE INPUP I (VGETBASEBYTE VA I)))
(replace EPREQUEUE of INPUP with (QUOTE FREE))
(SENDPUP SOC INPUP))
(TR.STORE [SETQ STPTR (VVAG2 (GETPUPBYTE INPUP 1)
(IPLUS (LLSH (GETPUPBYTE INPUP 2)
8)
(GETPUPBYTE INPUP 3]
(SETQ STVAL (IPLUS (LLSH (GETPUPBYTE INPUP 4)
8)
(GETPUPBYTE INPUP 5)))
(printout T "store word " STVAL " at " STPTR T)
(VPUTBASE STPTR 0 STVAL)
(SETUPPUP INPUP (fetch PUPSOURCE of INPUP)
(fetch PUPSOURCESOCKET of INPUP)
TR.STOREDONE
(fetch PUPID of INPUP)
SOC)
(replace EPREQUEUE of INPUP with (QUOTE FREE))
(SENDPUP SOC INPUP))
(TR.GO (SETUPPUP (SETQ OUTPUP (ALLOCATE.PUP))
(fetch PUPSOURCE of INPUP)
(fetch PUPSOURCESOCKET of INPUP)
TR.GOACK
(fetch PUPID of INPUP)
SOC)
(COND
([AND (SETQ INPUP (EXCHANGEPUPS SOC OUTPUP NIL NIL 10000))
(EQ (fetch PUPTYPE of INPUP)
TR.GOREPLY)
(EQUAL (fetch PUPID of INPUP)
(IPLUS 1 (fetch PUPID of OUTPUP]
(GO DONE))
(T (printout T "GO SEQUENCE ABORTED" T)))
(* acknowledge pup AND WAIT FOR REPLY)
)
(printout T "WRONG PUP TYPE" T))
(GO LP)
DONE(RETURN])
)
(RPAQQ REMOTEPAGELST NIL)
(RPAQQ REMOTECACHESIZE 100)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD REMOTEVMEMFILE (RVFTAG RVFFN (REMOTEVMEMADDR . REMOTEVMEMSOCKET))
RVFTAG ←(QUOTE PMAP)
RVFFN ←(FUNCTION REMOTEPMAP))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \PUPSOC.TELERAID 27)
(CONSTANTS \PUPSOC.TELERAID)
)
(RPAQQ TRPUPTYPES ((TR.GIVEPAGE 197)
(TR.HEREISPAGE 193)
(TR.STORE 198)
(TR.STOREDONE 192)
(TR.GO 199)
(TR.GOACK 194)
(TR.GOREPLY 131)
(TR.ERROR 196)))
(DECLARE: EVAL@COMPILE
(RPAQQ TR.GIVEPAGE 197)
(RPAQQ TR.HEREISPAGE 193)
(RPAQQ TR.STORE 198)
(RPAQQ TR.STOREDONE 192)
(RPAQQ TR.GO 199)
(RPAQQ TR.GOACK 194)
(RPAQQ TR.GOREPLY 131)
(RPAQQ TR.ERROR 196)
(CONSTANTS (TR.GIVEPAGE 197)
(TR.HEREISPAGE 193)
(TR.STORE 198)
(TR.STOREDONE 192)
(TR.GO 199)
(TR.GOACK 194)
(TR.GOREPLY 131)
(TR.ERROR 196))
)
(ADDTOVAR PUPTYPES (TR.GIVEPAGE 197)
(TR.HEREISPAGE 193)
(TR.STORE 198)
(TR.STOREDONE 192)
(TR.GO 199)
(TR.GOACK 194)
(TR.GOREPLY 131)
(TR.ERROR 196))
(FILESLOAD (LOADCOMP)
PUP)
)
(PUTPROPS REMOTEVMEM COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (809 6780 (CLEARPAGECACHE 819 . 955) (OPENREMOTEVMEMFILE 957 . 1198) (
CLOSEREMOTEVMEMFILE 1200 . 1468) (VMAPPAGE 1470 . 2041) (REMOTEPMAP 2043 . 2974) (REMOTERETURN 2976 .
3825) (REMOTESETWORD 3827 . 4666) (DEBUGGINGTRSERVER 4668 . 6778)))))
STOP