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

(FILECREATED "20-Jan-93 15:04:46" {DSK}<python>lde>lispcore>library>VMEM.;2
 17754  

      changes to%:  (RECORDS REMOTEPOINTER)

      previous date%: " 9-Nov-92 16:30:26" {DSK}<python>lde>lispcore>library>VMEM.;1)


(* ; "
Copyright (c) 1982, 1984, 1985, 1986, 1990, 1992, 1993 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT VMEMCOMS)

(RPAQQ VMEMCOMS
 [(FNS INITVMEM REOPENVMFILE VVAG2)
                     (INITVARS (VMEMFILE))
                     (FNS VGETBASE0 VPUTBASE0 VGETBASEPTR0 VPUTBASEPTR0 INVALIDADDR)
                     (COMS (FNS PRINTVM ENDVMPRINT)
                           (DECLARE%: DONTCOPY (CONSTANTS NOPAGE)))
                     (FNS OPENVMFILE UNMAPVM CLOSEVMEMFILE MAPVMPAGE VBIN1 VBOUT1 VBIN2 VBOUT2)
                     (FNS SETVMPTR VMPAGEP)
                     [DECLARE%: EVAL@COMPILE DONTCOPY (MACROS * VMACROS)
                            (RECORDS REMOTEPOINTER)
                            DONTEVAL@LOAD
                            (P (OR (SELECTQ (AND (GETD 'COMPILEMODE)
                                                 (COMPILEMODE))
                                          ((ALTO D)
                                           T)
                                          NIL)
                                   (FILESLOAD (LOADCOMP)
                                          DCODEFOR10]
                     [COMS (FNS VTYPEDPOINTER \REMOTEPOINTER.DEFPRINT)
                           (INITRECORDS REMOTEPOINTER)
                           (DECLARE%: DONTEVAL@LOAD DOCOPY (P (DEFPRINT 'REMOTEPOINTER 
                                                                     '\REMOTEPOINTER.DEFPRINT]
                     (ADDVARS (VMEMVARS (PGEMPTY (FIXPARRAY 256))
                                     (PGTAB (POINTERARRAY 256 PGEMPTY))
                                     (RDSYSINIT T)))
                     (GLOBALVARS PGTAB PGEMPTY VMEMFILEX VMEMFILE FIRSTPMT)
                     (COMS (FNS POINTERARRAY WORDARRAY FIXPARRAY)
                           (P (MAPC '((ELT FASTELT FASTELTN FASTELTW)
                                      (SETA FASTSETA FASTSETAN FASTSETAW)
                                      (GETHASH IGETHASH)
                                      (PUTHASH IPUTHASH))
                                    (FUNCTION (LAMBDA (X)
                                                     (MAPC (CDR X)
                                                           (FUNCTION (LAMBDA (Y)
                                                                            (MOVD? (CAR X)
                                                                                   Y])
(DEFINEQ

(INITVMEM

  (LAMBDA (FILE WRITEABLE)
                                   (* bvm%: "13-Sep-86 17:40")

    (COND
       (VMEMFILE (CLOSEVMEMFILE
)))
    (COND
       ((NLISTP FILE)
        (SETQ FILE (OPENVMFILE
 (OR FILE 'LISP.SYSOUT)
                          WRITEABLE))
        (SETQ VMOUTFILEX (AND WRITEABLE VMEMFILE))
        (for
 X in
 VMEMVARS do
 (OR (BOUNDP (CAR X))
                                  (SET (CAR X)
                                       (EVAL (CADR X)))))
        (UNMAPVM
)                                            (* Read the pagemap pages and record 

                                                             the page addresses.)

        (VREADPAGEMAP))
       (T (OPENREMOTEVMEMFILE (CAR FILE))))))

(REOPENVMFILE

  (LAMBDA (FILE WRITEABLE)
                                   (* bvm%: "13-Sep-86 17:40")

          
          (* * VMEMFILEX soon to be obsolete)


    (SETQ VMEMFILE (SETQ VMEMFILEX (OPENSTREAM FILE (COND
                                                       (WRITEABLE 'BOTH)
                                                       (T 'INPUT))
                                          'OLD 8)))))

(VVAG2

  (LAMBDA (HI LO)
                                            (* lmm " 9-MAR-81 09:34")

          
          (* DOESN'T BELONG HERE, BUT ON MEM! INCLUDED BECAUSE REMOTE-PRINTCODE CALLS 

          VVAG2 BUT DIDN'T IMPORT MEM)


    ((LAMBDA (X)
       (DECLARE
 (LOCALVARS . T))
       (COND
          ((ZEROP X)
           NIL)
          (T X)))
     (IPLUS (LLSH HI 16)
            LO))))
)

(RPAQ? VMEMFILE
 )
(DEFINEQ

(VGETBASE0

  (LAMBDA (PTR)
                                              (* lmm "20-AUG-81 16:43")

    (COND
       ((NLISTP VMEMFILE)
        (SETVMPTR
 PTR)
        (VBIN2
))
       (T (WORDCONTENTS (WORDOFFSET (VMAPPAGE (LRSH PTR 8))
                               (LOGAND PTR 255)))))))

(VPUTBASE0

  (LAMBDA (PTR VALUE)
                                        (* lmm "20-AUG-81 16:43")

    (COND
       ((NLISTP VMEMFILE)
        (SETVMPTR
 PTR)
        (VBOUT2
 VALUE))
       (T (SETWORDCONTENTS (WORDOFFSET (VMAPPAGE (LRSH PTR 8))
                                  (LOGAND PTR 255))
                 VALUE)
          (REMOTESETWORD PTR VALUE)))
    VALUE))

(VGETBASEPTR0

  (LAMBDA (PTR)
                                              (* lmm " 8-SEP-81 23:12")

    (AND (NOT (ZEROP (SETQ PTR (COND
                                  ((NLISTP VMEMFILE)
                                   (SETVMPTR
 PTR)
                                   (VBIN1
)
                                   (VVAG2
 (VBIN1
)
                                          (VBIN2
)))
                                  (T (VVAG2
 (LOGAND 255 (WORDCONTENTS (SETQ PTR
                                                                       (WORDOFFSET
                                                                        (VMAPPAGE (LRSH PTR 8))
                                                                        (LOGAND 255 PTR)))))
                                            (WORDCONTENTS (WORDOFFSET PTR 1))))))))
         PTR)))

(VPUTBASEPTR0

  (LAMBDA (PTR VALUE)
                                        (* lmm "20-AUG-81 16:43")

    (COND
       ((NLISTP VMEMFILE)
        (SETVMPTR
 PTR)
        (VBOUT2
 (VHILOC VALUE))
        (VBOUT2
 (VLOLOC VALUE)))
       (T (PROG (WORD)
                (SETWORDCONTENTS (SETQ WORD (WORDOFFSET (VMAPPAGE (LRSH PTR 8))
                                                   (LOGAND PTR 255)))
                       (VHILOC VALUE))
                (SETWORDCONTENTS (WORDOFFSET WORD 1)
                       (VLOLOC VALUE))
                (REMOTESETWORD PTR (VHILOC VALUE))
                (REMOTESETWORD (ADD1 PTR)
                       (VLOLOC VALUE))
                (RETURN VALUE))))))

(INVALIDADDR

  [LAMBDA (PTR)
                               (* ; 

                                                "Edited  9-Nov-92 15:22 by sybalsky:mv:envos")


    (* ;; "Handle Invalid addresses in Teleraid and INIT building.  For INIT building, I changed the ERROR! to ERROR so we can do diagnosis.  JDS 11/9/92")


    (printout T "Invalid Address: ")
    (VPRINTVA PTR)
    (TERPRI T)                                               (* ERROR!)

    (ERROR "Invalid address"])
)
(DEFINEQ

(PRINTVM

  (LAMBDA NIL
                                                (* lmm " 4-MAY-82 21:09")

    (PROG ((LASTSEG NOPAGE)
           (LASTPAGE NOPAGE)
           LASTE FIRSTE)
          (for
 SEG from
 0 to
 255 bind
 P
             do
 (OR (EQ (SETQ P (FASTELT PGTAB SEG))
                        PGEMPTY)
                    (for
 PAGE from
 0 to
 255 bind
 E
                       do
 (COND
                             ((NEQ (SETQ E (FASTELTN P PAGE))
                                   0)
                              (COND
                                 ((NOT (IEQ SEG LASTSEG))
                                  (ENDVMPRINT
)
                                  (printout T T "segment " (SETQ LASTSEG SEG)
                                         T)))
                              (COND
                                 ((OR (NOT (IEQ (SUB1 PAGE)
                                                LASTPAGE))
                                      (NOT (IEQ (SUB1 E)
                                                LASTE)))
                                  (ENDVMPRINT
)
                                  (printout T PAGE)
                                  (SETQ FIRSTE E)))
                              (SETQ LASTPAGE PAGE)
                              (SETQ LASTE E))))))
          (ENDVMPRINT
))))

(ENDVMPRINT

  (LAMBDA NIL
                                                (* lmm " 4-MAY-82 21:47")

    (COND
       ((NOT (IEQ LASTPAGE NOPAGE))
        (COND
           ((IEQ FIRSTE LASTE)
            (printout T 10 (COND
                              ((IGEQ FIRSTE 32768)
                               (SETQ FIRSTE (LOGAND FIRSTE 32767))
                               (SETQ LASTE (LOGAND LASTE 32767))
                               "*")
                              (T " "))
                   FIRSTE T))
           (T (printout T "-" LASTPAGE 10 (COND
                                             ((IGEQ FIRSTE 32768)
                                              (SETQ FIRSTE (LOGAND FIRSTE 32767))
                                              (SETQ LASTE (LOGAND LASTE 32767))
                                              "*")
                                             (T " "))
                     FIRSTE "-" LASTE T)))
        (SETQ LASTPAGE NOPAGE)))))
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(RPAQQ NOPAGE
 -2)


(CONSTANTS NOPAGE)
)
)
(DEFINEQ

(OPENVMFILE

  (LAMBDA (NAME WRITEABLE)
                                   (* lmm "19-DEC-81 00:21")

    (WHENCLOSE (REOPENVMFILE
 NAME WRITEABLE)
           'CLOSEALL
           'NO
           'AFTER
           'CLOSEVMEMFILE
           'STATUS
           (FUNCTION (LAMBDA (FILE)
                       (LIST 'REOPENVMFILE FILE (OPENP FILE 'BOTH)))))))

(UNMAPVM

  (LAMBDA NIL
                                                (* lmm " 3-AUG-80 22:12")

    (for
 I from
 0 to
 255 bind
 P do
 (OR (EQ (SETQ P (FASTELT PGTAB I))
                                           PGEMPTY)
                                       (for
 J from
 0 to
 255 do
 (FASTSETAN P J 0))))))

(CLOSEVMEMFILE

  (LAMBDA NIL
                                                (* bvm%: "13-Jul-84 17:22")

    (COND
       ((NLISTP VMEMFILE)
        (CLOSEF? VMEMFILE))
       (T (CLOSEREMOTEVMEMFILE)))
    (SETQ VMEMFILE)))

(MAPVMPAGE

  (LAMBDA (VP PAGE)
                                          (* lmm "21-AUG-81 22:38")

          
          (* Associate virtual page VP with page PAGE of the vmem file)


    (PROG ((A (LRSH VP 8))
           (B (LOGAND VP 255))
           D)
          (COND
             ((EQ (SETQ D (FASTELT PGTAB A))
                  PGEMPTY)
              (FASTSETA PGTAB A (SETQ D (FIXPARRAY
 256)))))
          (FASTSETAN D B PAGE))))

(VBIN1

  (LAMBDA NIL
                                                (* bvm%: "13-Sep-86 17:38")

    (\BIN VMEMFILE)))

(VBOUT1

  (LAMBDA (BYTE)
                                             (* lmm "16-MAY-81 16:52")

    (\BOUT (OR VMOUTFILEX (ERROR "Can't write on " VMEMFILE))
           BYTE)))

(VBIN2

  (LAMBDA NIL
    (IPLUS (LLSH (VBIN1
)
                 8)
           (VBIN1
))))

(VBOUT2

  (LAMBDA (VALUE)
                                            (* lmm "19-MAR-81 12:24")

    (VBOUT1
 (LRSH VALUE 8))
    (VBOUT1
 (LOGAND VALUE 255))
    VALUE))
)
(DEFINEQ

(SETVMPTR

  (LAMBDA (PTR)
                                              (* lmm " 4-MAY-82 20:42")

          
          (* Positions VMEMFILE to start reading at virtual address PTR, and sets 

          VMBYTESLEFT to the number of bytes left on the page.)


    (PROG ((A (FASTELT PGTAB (VHILOC PTR)))
           (J (LRSH (VLOLOC PTR)
                    8)))                                     (* The multiple FASTELTNs are to avoid 

                                                             boxing)

          (COND
             ((IEQP (FASTELTN A J)
                    0)
              (INVALIDADDR
 (IPLUS PTR 0))))
          (SETFILEPTR VMEMFILE (IPLUS (LLSH (LOGAND (FASTELTN A J)
                                                   32767)
                                            9)
                                      (LLSH (LOGAND (VLOLOC PTR)
                                                   255)
                                            1))))))

(VMPAGEP

  (LAMBDA (VP)
                                               (* bvm%: "10-Dec-84 12:46")

    (NOT (IEQP (.LOOKUPMAP. VP)
               0))))
)
(DECLARE%: EVAL@COMPILE DONTCOPY 

(RPAQQ VMACROS
 (VPAGEBASE VADDBASE VHILOC VVAG2 VGETBASEBYTE VLOLOC VPAGELOC VGETBASE VPUTBASE 
                          VGETBASEPTR VPUTBASEPTR VBIN1 VBIN2 .LOOKUPMAP.))
(DECLARE%: EVAL@COMPILE 

(PUTPROPS VPAGEBASE MACRO ((PTR)
                           (LOGAND PTR -256)))

(PUTPROPS VADDBASE MACRO ((PTR D)
                          (IPLUS PTR D)))

(PUTPROPS VHILOC MACRO ((PTR)
                        (LRSH (OR PTR 0)
                              16)))

(PUTPROPS VVAG2 MACRO ((HI LO)
                       (IPLUS (LLSH HI 16)
                              LO)))

[PUTPROPS VGETBASEBYTE MACRO (LAMBDA (PTR N)
             (* lmm " 9-MAR-81 09:49")

                               (COND
                                  ((ZEROP (LOGAND N 1))
                                   (LRSH (VGETBASE PTR (LRSH N 1))
                                         8))
                                  (T (LOGAND 255 (VGETBASE PTR (LRSH N 1]

(PUTPROPS VLOLOC MACRO ((PTR)
                        (LOGAND (OR PTR 0)
                               65535)))

(PUTPROPS VPAGELOC MACRO ((PTR)
                          (LRSH (OR PTR 0)
                                8)))

[PUTPROPS VGETBASE MACRO ((PTR D)
                          (VGETBASE0
 (VADDBASE PTR D]

(PUTPROPS VPUTBASE MACRO ((PTR D VAL)
                          (VPUTBASE0
 (VADDBASE PTR D)
                                 VAL)))

[PUTPROPS VGETBASEPTR MACRO ((PTR D)
                             (VGETBASEPTR0
 (VADDBASE PTR D]

(PUTPROPS VPUTBASEPTR MACRO ((PTR D VALUE)
                             (VPUTBASEPTR0
 (VADDBASE PTR D)
                                    VALUE)))

(PUTPROPS VBIN1 MACRO (NIL (\BIN VMEMFILE)))

[PUTPROPS VBIN2 MACRO (NIL (IPLUS (LLSH (VBIN1
)
                                        8)
                                  (VBIN1
]

[PUTPROPS .LOOKUPMAP. MACRO ((VP)
                             (FASTELTN (FASTELT PGTAB (LRSH VP 8))
                                    (LOGAND VP 255]
)

(DECLARE%: EVAL@COMPILE

(DATATYPE REMOTEPOINTER
 ((RPTYPE POINTER)
                             (RPHILOC WORD)
                             (RPLOLOC WORD)))
)

(/DECLAREDATATYPE 'REMOTEPOINTER '(POINTER WORD WORD)
       '((REMOTEPOINTER 0 POINTER)
         (REMOTEPOINTER 2 (BITS . 15))
         (REMOTEPOINTER 3 (BITS . 15)))
       '4)
DONTEVAL@LOAD 

(OR (SELECTQ (AND (GETD 'COMPILEMODE)
                  (COMPILEMODE))
        ((ALTO D) 
             T)
        NIL)
    (FILESLOAD (LOADCOMP)
           DCODEFOR10))
)
(DEFINEQ

(VTYPEDPOINTER

  (LAMBDA (TYPE POINTER)
                                     (* bvm%: "15-Feb-85 18:06")

          
          (* Produces a local object that represents a remote POINTER with type 

          information. Used for visual presentation to teleraid user)


    (create
 REMOTEPOINTER
           RPTYPE _ TYPE
           RPHILOC _ (VHILOC POINTER)
           RPLOLOC _ (VLOLOC POINTER))))

(\REMOTEPOINTER.DEFPRINT

  (LAMBDA (RPTR)
                                             (* bvm%: "15-Feb-85 18:11")

                                                             (* How to print a REMOTEPOINTER)

    (LIST (CONCAT '{ (OR (ffetch
 RPTYPE of
 (\DTEST RPTR 'REMOTEPOINTER))
                         "")
                 "}#"
                 (OCTALSTRING (ffetch
 RPHILOC of
 RPTR))
                 '%,
                 (OCTALSTRING (ffetch
 RPLOLOC of
 RPTR))))))
)

(/DECLAREDATATYPE 'REMOTEPOINTER '(POINTER WORD WORD)
       '((REMOTEPOINTER 0 POINTER)
         (REMOTEPOINTER 2 (BITS . 15))
         (REMOTEPOINTER 3 (BITS . 15)))
       '4)
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(DEFPRINT 'REMOTEPOINTER '\REMOTEPOINTER.DEFPRINT)
)

(ADDTOVAR VMEMVARS
 (PGEMPTY (FIXPARRAY 256))
                       (PGTAB (POINTERARRAY 256 PGEMPTY))
                       (RDSYSINIT T))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS PGTAB PGEMPTY VMEMFILEX VMEMFILE FIRSTPMT)
)
(DEFINEQ

(POINTERARRAY

  (LAMBDA (N INIT)
                                           (* lmm " 4-DEC-80 16:58")

    (ARRAY N 'POINTER INIT 0)))

(WORDARRAY

  (LAMBDA (N)
                                                (* lmm " 4-DEC-80 16:58")

    (ARRAY N 'SMALLPOSP 0 0)))

(FIXPARRAY

  (LAMBDA (N)
                                                (* lmm " 4-DEC-80 16:58")

    (ARRAY N 'FIXP 0 0)))
)

[MAPC '((ELT FASTELT FASTELTN FASTELTW)
        (SETA FASTSETA FASTSETAN FASTSETAW)
        (GETHASH IGETHASH)
        (PUTHASH IPUTHASH))
      (FUNCTION (LAMBDA (X)
                  (MAPC (CDR X)
                        (FUNCTION (LAMBDA (Y)
                                    (MOVD? (CAR X)
                                           Y]
(PUTPROPS VMEM COPYRIGHT ("Venue & Xerox Corporation" 1982 1984 1985 1986 1990 1992 1993))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2716 4346 (INITVMEM 2726 . 3495) (REOPENVMFILE 3497 . 3925) (VVAG2 3927 . 4344)) (4370 
7179 (VGETBASE0 4380 . 4687) (VPUTBASE0 4689 . 5078) (VGETBASEPTR0 5080 . 5953) (VPUTBASEPTR0 5955 . 
6675) (INVALIDADDR 6677 . 7177)) (7180 9537 (PRINTVM 7190 . 8552) (ENDVMPRINT 8554 . 9535)) (9632 
11667 (OPENVMFILE 9642 . 10009) (UNMAPVM 10011 . 10362) (CLOSEVMEMFILE 10364 . 10599) (MAPVMPAGE 10601
 . 11056) (VBIN1 11058 . 11187) (VBOUT1 11189 . 11376) (VBIN2 11378 . 11477) (VBOUT2 11479 . 11665)) (
11668 12841 (SETVMPTR 11678 . 12675) (VMPAGEP 12677 . 12839)) (15413 16355 (VTYPEDPOINTER 15423 . 
15843) (\REMOTEPOINTER.DEFPRINT 15845 . 16353)) (16862 17297 (POINTERARRAY 16872 . 17016) (WORDARRAY 
17018 . 17158) (FIXPARRAY 17160 . 17295)))))
STOP