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

(FILECREATED "21-Jul-88 11:44:33" |{MCS:MCS:STANFORD}<LANE>COURIEREVALSERVE.;6|
 9135   

      changes to%:  (VARS COURIEREVALSERVECOMS)

      previous date%: "17-Sep-87 13:47:38" |{MCS:MCS:STANFORD}<LANE>COURIEREVALSERVE.;5|)


(* "
Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation & Stanford University.  All rights reserved.
")

(PRETTYCOMPRINT COURIEREVALSERVECOMS)

(RPAQQ COURIEREVALSERVECOMS
 ((* Client Routines)
                                 (FNS REMOTEEVAL REMOTEAPPLY)
                                 (* Server Routines)
                                 (FNS CES.REMOTEEVAL CES.REMOTEAPPLY CES.ERRORN)
                                 (COURIERPROGRAMS EVAL)
                                 (FILES COURIERSERVE)
                                 (P (COURIER.START.SERVER))))



(* Client Routines)


(DEFINEQ

(REMOTEEVAL

  [LAMBDA (FORM COURIERSTREAM NOERRORFLG)
                (* ; "Edited 17-Sep-87 13:12 by cdl")

                                                             (* DECLARATIONS%: (RECORD RESULT

                                                           (REJECTTYPE ERRORTYPE ERRORSTRING)))

    (LET (STRING STREAM RESULT)
         (DECLARE
 (SPECVARS STREAM STRING))
         (if
 [LISTP (SETQ STRING (COURIER.CALL COURIERSTREAM 'EVAL 'EVAL (MKSTRING FORM T)
                                            'RETURNERRORS]
             then
 [with
 RESULT STRING (if
 ERRORSTRING
                                                  then
 [if
 (ZEROP (COURIER.FETCH (EVAL
                                                                                            . ERRORN)
                                                                                 NUMBER OF 
                                                                                 ERRORSTRING))
                                                               then
 (OR NOERRORFLG
                                                                            (ERROR 
                                                                           "Remote evaluation error!"
                                                                                   FORM))
                                                             else
 (OR NOERRORFLG
                                                                          (ERROR (ERRORMESS 
                                                                                        ERRORSTRING]
                                                else
 (OR NOERRORFLG (ERROR REJECTTYPE ERRORTYPE]
           elseif
 [SETQ RESULT (RESETLST
                                       [RESETSAVE NIL `(CLOSEF? ,(SETQ STREAM (OPENSTRINGSTREAM
                                                                               STRING
                                                                               'INPUT]
                                       (NLSETQ (READ STREAM)))]
             then
 (CAR RESULT)
           else
 (OR NOERRORFLG (ERROR "Unreadable remote evaluation result!" STRING])

(REMOTEAPPLY

  [LAMBDA (FN ARGS COURIERSTREAM NOERRORFLG)
             (* ; "Edited 17-Sep-87 13:14 by cdl")

                                                             (* DECLARATIONS%: (RECORD RESULT

                                                           (REJECTTYPE ERRORTYPE ERRORSTRING)))

    (LET (STRING STREAM RESULT)
         (DECLARE
 (SPECVARS STRING STREAM))
         (if
 [LISTP (SETQ STRING (COURIER.CALL COURIERSTREAM 'EVAL 'APPLY (MKSTRING FN T)
                                            (for
 ARG in
 ARGS collect
 (MKSTRING ARG T))
                                            'RETURNERRORS]
             then
 [with
 RESULT STRING
                             (if
 ERRORSTRING
                                 then
 [if
 (ZEROP (COURIER.FETCH (EVAL . ERRORN)
                                                                NUMBER OF ERRORSTRING))
                                              then
 (OR NOERRORFLG (ERROR "Remote apply error!"
                                                                             (CONS FN ARGS)))
                                            else
 (OR NOERRORFLG (ERROR (ERRORMESS ERRORSTRING]
                               else
 (OR NOERRORFLG (ERROR REJECTTYPE ERRORTYPE]
           else
 (if
 [SETQ RESULT (RESETLST
                                             [RESETSAVE NIL
                                                    `(CLOSEF? ,(SETQ STREAM (OPENSTRINGSTREAM
                                                                             STRING
                                                                             'INPUT]
                                             (NLSETQ (READ STREAM)))]
                        then
 (CAR RESULT)
                      else
 (OR NOERRORFLG (ERROR "Unreadable remote apply result!" STRING])
)



(* Server Routines)


(DEFINEQ

(CES.REMOTEEVAL

  [LAMBDA (COURIERSTREAM PROGRAM PROCEDURE STRING)
       (* ; "Edited 17-Sep-87 10:14 by cdl")

    (LET (STREAM SEXPR)
         (DECLARE
 (SPECVARS STREAM SEXPR))
         (if
 [SETQ SEXPR (RESETLST
                                 [RESETSAVE NIL `(CLOSEF? ,(SETQ STREAM (OPENSTRINGSTREAM
                                                                         STRING
                                                                         'INPUT]
                                 (NLSETQ (READ STREAM)))]
             then
 (SETQ SEXPR (CAR SEXPR))
                   [if
 (SETQ SEXPR (ERRORSET SEXPR))
                       then
 `(RETURN ,(MKSTRING (CAR SEXPR)
                                                 T))
                     else
 `(ABORT REMOTE.EVAL.ERROR ,(CES.ERRORN
]
           else
 `(ABORT REMOTE.READ.ERROR ,(CES.ERRORN
])

(CES.REMOTEAPPLY

  [LAMBDA (COURIERSTREAM PROGRAM PROCEDURE FN ARGS)
      (* ; "Edited 17-Sep-87 11:12 by cdl")

    (DECLARE
 (SPECVARS FN ARGS))
    (LET (ERROR SEXPR STREAM)
         (DECLARE
 (SPECVARS STREAM))
         [SETQ ARGS (for
 ARG in
 ARGS declare%:
 (SPECVARS ARG)
                       collect
 [SETQ SEXPR
                                    (RESETLST
                                        [RESETSAVE NIL `(CLOSEF? ,(SETQ STREAM (OPENSTRINGSTREAM
                                                                                ARG
                                                                                'INPUT]
                                        (NLSETQ (READ STREAM)))]
                             (if
 SEXPR
                                 then
 (CAR SEXPR)
                               else
 (SETQ ERROR 'REMOTE.READ.ERROR)
                                     (RETURN]
         (if
 ERROR
             then
 `(ABORT ,ERROR ,(CES.ERRORN
))
           else
 (if
 [SETQ FN (RESETLST
                                         [RESETSAVE NIL `(CLOSEF? ,(SETQ STREAM (OPENSTRINGSTREAM
                                                                                 FN
                                                                                 'INPUT]
                                         (NLSETQ (READ STREAM)))]
                        then
 (SETQ FN (CAR FN))
                              [if
 (SETQ SEXPR (NLSETQ (APPLY FN ARGS)))
                                  then
 `(RETURN ,(MKSTRING (CAR SEXPR)
                                                            T))
                                else
 `(ABORT REMOTE.APPLY.ERROR ,(CES.ERRORN
]
                      else
 `(ABORT REMOTE.READ.ERROR ,(CES.ERRORN
])

(CES.ERRORN

  [LAMBDA NIL
                                            (* ; "Edited 17-Sep-87 13:41 by cdl")

                                                             (* Minimal functionality, just for 

                                                           backward compatibility)

    (COURIER.CREATE (EVAL . ERRORN)
           NUMBER _ (CONSTANT (ZERO))
           EXPR _ (CONSTANT null])
)

(COURIERPROGRAM EVAL
 (1105 0)
    TYPES

      [(SEXPR STRING)
       (FN STRING)
       (ARGS (SEQUENCE SEXPR))
       (ERRORN (RECORD (NUMBER CARDINAL)
                      (EXPR SEXPR]
    PROCEDURES

      ((EVAL 0 (SEXPR)
             RETURNS
             (SEXPR)
             REPORTS
             (REMOTE.EVAL.ERROR REMOTE.READ.ERROR)
             IMPLEMENTEDBY CES.REMOTEEVAL)
       (APPLY 1 (FN ARGS)
              RETURNS
              (SEXPR)
              REPORTS
              (REMOTE.APPLY.ERROR REMOTE.READ.ERROR)
              IMPLEMENTEDBY CES.REMOTEAPPLY))
    ERRORS

      ((REMOTE.EVAL.ERROR 0 (ERRORN))
       (REMOTE.APPLY.ERROR 1 (ERRORN))
       (REMOTE.READ.ERROR 2 (ERRORN))))

(FILESLOAD COURIERSERVE)

(COURIER.START.SERVER)
(PUTPROPS COURIEREVALSERVE COPYRIGHT ("Xerox Corporation & Stanford University" 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (899 5041 (REMOTEEVAL 909 . 3155) (REMOTEAPPLY 3157 . 5039)) (5070 8241 (CES.REMOTEEVAL 
5080 . 5981) (CES.REMOTEAPPLY 5983 . 7822) (CES.ERRORN 7824 . 8239)))))
STOP