(FILECREATED "13-AUG-83 08:56:24" <BLISP>REMOTEVMEM.;21 7794
changes to: (VARS REMOTEVMEMCOMS)
previous date: "16-JUL-83 16:37:35" <BLISP>REMOTEVMEM.;20)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT REMOTEVMEMCOMS)
(RPAQQ REMOTEVMEMCOMS [(FNS CLEARPAGECACHE VMAPPAGE REMOTEPMAP REMOTERETURN REMOTESETWORD
DEBUGGINGTRSERVER VMEMSOCKET)
(VARS (REMOTEPAGELST))
[DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS \PUPSOC.TELERAID)
(CONSTANTS * TRPUPTYPES)
(ADDVARS * (LIST (CONS (QUOTE PUPTYPES)
TRPUPTYPES)))
(P (SELECTQ (AND (GETD (QUOTE COMPILEMODE))
(COMPILEMODE))
((ALTO D)
(FILESLOAD (LOADCOMP)
PUP))
(PROGN (FILESLOAD (LOADCOMP)
DCODEFOR10 PUP10)
(FILESLOAD (SYSLOAD)
CJSYS]
(DECLARE: DONTEVAL@LOAD (P (SELECTQ (SYSTEMTYPE)
((ALTO D))
(FILESLOAD (SYSLOAD)
PUP10])
(DEFINEQ
(CLEARPAGECACHE
[LAMBDA NIL (* lmm "20-AUG-81 16:45")
(SETQ REMOTEPAGELST])
(VMAPPAGE
[LAMBDA (PAGE#) (* bvm: "26-AUG-81 12:35")
(SELECTQ (SYSTEMTYPE)
[(ALTO D)
(CDR (OR (ASSOC PAGE# REMOTEPAGELST)
(CAR (push REMOTEPAGELST (CONS PAGE# (REMOTEPMAP VMEMFILE PAGE#
(NCREATE (QUOTE VMEMPAGEP]
(MAPPAGE PAGE# VMEMFILE])
(REMOTEPMAP
[LAMBDA (FL PAGE# BUFFER) (* bvm: "14-MAR-83 17:52")
(OR (EQ FL VMEMFILE)
(SHOULDNT))
(PROG ((SOC (VMEMSOCKET))
INPUP OUTPUP)
(SETUPPUP (SETQ OUTPUP (ALLOCATE.PUP))
(ETHERPORT (CAR (CADDR FL))
T)
\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 (SELECTQ (SYSTEMTYPE)
((ALTO D)
(\BLT BUFFER (fetch PUPCONTENTS
of INPUP)
WORDSPERPAGE))
(for I from 0 to (SUB1 WORDSPERPAGE)
do (SETWORDCONTENTS (WORDOFFSET BUFFER I)
(\GETPUPWORD INPUP I]
(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: "16-JUL-83 16:07")
(bind INPUP (OUTPUP ←(ALLOCATE.PUP))
(SOC ←(VMEMSOCKET)) first (SETUPPUP OUTPUP (ETHERPORT (CAR (CADDR VMEMFILE))
T)
\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: "14-MAR-83 17:54")
(bind INPUP (OUTPUP ←(ALLOCATE.PUP))
(SOC ←(VMEMSOCKET))
first (SETUPPUP OUTPUP (ETHERPORT (CAR (CADDR VMEMFILE))
T)
\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])
(VMEMSOCKET
[LAMBDA NIL (* bvm: "14-MAR-83 15:01")
(OR (CDR (CADDR VMEMFILE))
(CDR (RPLACD (CADDR VMEMFILE)
(OPENPUPSOCKET])
)
(RPAQQ REMOTEPAGELST NIL)
(DECLARE: EVAL@COMPILE DONTCOPY
(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))
(SELECTQ (AND (GETD (QUOTE COMPILEMODE))
(COMPILEMODE))
((ALTO D)
(FILESLOAD (LOADCOMP)
PUP))
(PROGN (FILESLOAD (LOADCOMP)
DCODEFOR10 PUP10)
(FILESLOAD (SYSLOAD)
CJSYS)))
)
(DECLARE: DONTEVAL@LOAD
(SELECTQ (SYSTEMTYPE)
((ALTO D))
(FILESLOAD (SYSLOAD)
PUP10))
)
(PUTPROPS REMOTEVMEM COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (988 6445 (CLEARPAGECACHE 998 . 1134) (VMAPPAGE 1136 . 1471) (REMOTEPMAP 1473 . 2511) (
REMOTERETURN 2513 . 3323) (REMOTESETWORD 3325 . 4136) (DEBUGGINGTRSERVER 4138 . 6248) (VMEMSOCKET 6250
. 6443)))))
STOP
P