(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "12-Jun-90 11:00:52" {DSK}<usr>local>lde>lispcore>library>REMOTEVMEM.;2
 10969  

      changes to%:  (VARS REMOTEVMEMCOMS)

      previous date%: "15-Feb-85 18:17:43" {DSK}<usr>local>lde>lispcore>library>REMOTEVMEM.;1)


(* ; "
Copyright (c) 1982, 1983, 1984, 1985, 1990 by Venue & 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 '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
 '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
 '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
 '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 _ '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 ("Venue & Xerox Corporation" 1982 1983 1984 1985 1990))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1098 9242 (CLEARPAGECACHE 1108 . 1244) (OPENREMOTEVMEMFILE 1246 . 1530) (
CLOSEREMOTEVMEMFILE 1532 . 1808) (VMAPPAGE 1810 . 2620) (REMOTEPMAP 2622 . 3689) (REMOTERETURN 3691 . 
4783) (REMOTESETWORD 4785 . 5812) (\TR.NOSERVER 5814 . 6036) (DEBUGGINGTRSERVER 6038 . 9240)))))
STOP