(FILECREATED "16-JUL-83 16:37:35" {PHYLUM}<LISPCORE>SOURCES>REMOTEVMEM.;10 17066Q
changes to: (VARS TRPUPTYPES REMOTEVMEMCOMS)
(FNS REMOTERETURN)
previous date: "14-MAR-83 18:09:52" {PHYLUM}<LISPCORE>SOURCES>REMOTEVMEM.;7)
(* 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)
(VARS (PUPTYPES (UNION TRPUPTYPES PUPTYPES)))
(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 33Q)
(CONSTANTS \PUPSOC.TELERAID)
)
(RPAQQ TRPUPTYPES ((TR.GIVEPAGE 305Q)
(TR.HEREISPAGE 301Q)
(TR.STORE 306Q)
(TR.STOREDONE 300Q)
(TR.GO 307Q)
(TR.GOACK 302Q)
(TR.GOREPLY 203Q)
(TR.ERROR 304Q)))
(DECLARE: EVAL@COMPILE
(RPAQQ TR.GIVEPAGE 305Q)
(RPAQQ TR.HEREISPAGE 301Q)
(RPAQQ TR.STORE 306Q)
(RPAQQ TR.STOREDONE 300Q)
(RPAQQ TR.GO 307Q)
(RPAQQ TR.GOACK 302Q)
(RPAQQ TR.GOREPLY 203Q)
(RPAQQ TR.ERROR 304Q)
(CONSTANTS (TR.GIVEPAGE 305Q)
(TR.HEREISPAGE 301Q)
(TR.STORE 306Q)
(TR.STOREDONE 300Q)
(TR.GO 307Q)
(TR.GOACK 302Q)
(TR.GOREPLY 203Q)
(TR.ERROR 304Q))
)
(RPAQ PUPTYPES (UNION TRPUPTYPES PUPTYPES))
(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" 3676Q 3677Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2023Q 14544Q (CLEARPAGECACHE 2035Q . 2245Q) (VMAPPAGE 2247Q . 2766Q) (REMOTEPMAP 2770Q
. 5006Q) (REMOTERETURN 5010Q . 6462Q) (REMOTESETWORD 6464Q . 10137Q) (DEBUGGINGTRSERVER 10141Q .
14237Q) (VMEMSOCKET 14241Q . 14542Q)))))
STOP