(FILECREATED "15-Feb-85 18:17:43" {ERIS}<LISPCORE>LIBRARY>REMOTEVMEM.;9 8775   

      changes to:  (VARS REMOTEVMEMCOMS)

      previous date: "13-Feb-85 12:38:51" {ERIS}<LISPCORE>LIBRARY>REMOTEVMEM.;7)


(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT REMOTEVMEMCOMS)

(RPAQQ REMOTEVMEMCOMS ((FNS CLEARPAGECACHE OPENREMOTEVMEMFILE CLOSEREMOTEVMEMFILE VMAPPAGE REMOTEPMAP 
			    REMOTERETURN REMOTESETWORD \TR.NOSERVER DEBUGGINGTRSERVER)
		       (INITVARS (REMOTEPAGELST)
				 (REMOTECACHESIZE 100))
		       (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS REMOTEVMEMFILE)
				 (CONSTANTS \PUPSOC.TELERAID)
				 (CONSTANTS * TRPUPTYPES)
				 (ADDVARS * (LIST (CONS (QUOTE PUPTYPES)
							TRPUPTYPES)))
				 (GLOBALVARS REMOTECACHESIZE REMOTEPAGELST)
				 (ADDVARS (DONTCOMPILEFNS DEBUGGINGTRSERVER))
				 (FILES (LOADCOMP)
					PUP VMEM))))
(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)                                  (* bvm: "13-Feb-85 12:35")
    (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 (INVALIDADDR (UNFOLD PAGE# WORDSPERPAGE]
			 (\PT.ERROR (RETURN (\TR.NOSERVER)))
			 NIL)
	     finally (ERROR "REMOTE SYSTEM NOT RESPONDING"))
          (RELEASE.PUP OUTPUP)
          (AND INPUP (RELEASE.PUP INPUP))
          (RETURN BUFFER])

(REMOTERETURN
  [LAMBDA NIL                                                (* bvm: "13-Feb-85 12:35")
    (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))
		   (\PT.ERROR (RETURN (\TR.NOSERVER)))
		   NIL)
       finally (ERROR "REMOTE SYSTEM NOT RESPONDING")
	       (RELEASE.PUP OUTPUP])

(REMOTESETWORD
  [LAMBDA (PTR VALUE)                                        (* bvm: "13-Feb-85 12:35")
    (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)))
		   (\PT.ERROR (RETURN (\TR.NOSERVER)))
		   NIL)
       finally (ERROR "REMOTE SYSTEM NOT RESPONDING"))
    VALUE])

(\TR.NOSERVER
  [LAMBDA NIL                                                (* bvm: "13-Feb-85 12:38")
    (ERROR (PORTSTRING (fetch REMOTEVMEMADDR of VMEMFILE))
	   "not running TeleRaid server" T])

(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])
)

(RPAQ? REMOTEPAGELST )

(RPAQ? 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))

(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS REMOTECACHESIZE REMOTEPAGELST)
)


(ADDTOVAR DONTCOMPILEFNS DEBUGGINGTRSERVER)

(FILESLOAD (LOADCOMP)
	   PUP VMEM)
)
(PUTPROPS REMOTEVMEM COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (901 7341 (CLEARPAGECACHE 911 . 1047) (OPENREMOTEVMEMFILE 1049 . 1290) (
CLOSEREMOTEVMEMFILE 1292 . 1560) (VMAPPAGE 1562 . 2133) (REMOTEPMAP 2135 . 3113) (REMOTERETURN 3115 . 
4061) (REMOTESETWORD 4063 . 5003) (\TR.NOSERVER 5005 . 5227) (DEBUGGINGTRSERVER 5229 . 7339)))))
STOP