Google
 

Trailing-Edge - PDP-10 Archives - -
There are no other files named in the archive.
(FILECREATED "16-DEC-81 00:24:14" <LISPUSERS>PUPBSP.;2 6281   

     changes to:  PUPBSPCOMS

     previous date: "16-DEC-81 00:22:54" <LISPUSERS>PUPBSP.;1)


(* Copyright (c) 1981 Xerox Corporation)


(PRETTYCOMPRINT PUPBSPCOMS)

(RPAQQ PUPBSPCOMS ((FNS CONN# MAKEJOB MAKESUBSYS FTP PUPHOSTP PUPOPENF PUPPAIR PUPSERVER PUPUSER 
			SENDPUPPARAMETER SUBSYSJFN)
		   (LOCALVARS . T)
		   (FILES (FROM VALUEOF LISPUSERSDIRECTORIES)
			  NET)
		   (DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
							  NET))))
(DEFINEQ

(CONN#
  [LAMBDA NIL                      (* lmm " 5-JUL-78 03:28")
    (IPLUS (LRSH (OPENR 464)
		 9)
	   (SETQ CONN# (ADD1 (OR (FIXP (GETATOMVAL (QUOTE CONN#)))
				 0])

(MAKEJOB
  [LAMBDA (FILE ENTRY TTY)         (* lmm "28-JUL-78 02:02")
                                   (* create a job running FILE started at ENTRY 
				   (just starts exec if FILE not specified))
    (LOC (ASSEMBLE NIL
	           (CV TTY)
	           (PUSHNN (= 0)
			   (= 0)
			   (= 0)
			   (1)
			   (= 0)
			   (= 0)
			   (= 0)
			   (= 0)
			   (= 0))
	           (CQ FILE)
	           (CAME 1 , ' EXEC)
	           (CAMN 1 , ' NIL)
	           (JRST NOH)      (* need to store entry,,asciz address at word 2 in table)
	           (MOVEI 1 , (LRSH (IPLUS (BIT 0)
					   (BIT 2))
				    22Q))
                                   (* no herald, start fork)
	           (NREF (HRLM 1 , -1))
	           [CQ (SETQ FILE (VAG (SUBSYSJFN FILE]
	           (CQ ENTRY)
	           (CAMN 1 , KNIL)
	           (JRST NOSKT)
	           (FASTCALL IUNBOX)
	           (NREF (HRLM 1 , -6))
                                   (* store in 2nd word in table)
	       NOSKT
	           (CQ MACSCRATCHSTRING)
	           (FASTCALL UPATM)
	           (MOVEI 1 , 0 (3))
                                   (* now look for word boundary)
	       MACLP
	           (ILDB 2 , 3)
	           (CAIN 1 , 0 (3))
	           (JRST MACLP)
	           (NREF (HRRM 3 , -6))
                                   (* save string pointer)
	           (VAR (HRRZ 2 , FILE))
                                   (* JFN)
	           (HRROI 1 , 0 (3))
                                   (* string pointer for JFNS)
	           (MOVE 3 , = 211110000001Q)
                                   (* standard JFNS word)
	           (JS JFNS)
	           (MOVE 1 , 2)
	           (JS RLJFN)
	           (JFCL)
	           (MOVSI 1 , (LRSH (IPLUS (BIT 0)
					   (BIT 3)
					   (BIT 4)
					   (BIT 10Q)
					   (BIT 12Q)
					   (BIT 14Q))
				    22Q))
	           (JRST CRJ)
	       ERR (CQ (ERROR (ERSTR)
			      NIL T))
	       NOH (MOVSI 1 , (LRSH (IPLUS (BIT 0)
					   (BIT 10Q)
					   (BIT 12Q)
					   (BIT 14Q))
				    22Q))
	       CRJ (NREF (MOVEI 2 , -10Q))
	           (JS CRJOB)
	           (JRST ERR)
	           (POPNN 11Q])

(MAKESUBSYS
  [LAMBDA (FILE ENTRY PRIMIO)      (* lmm " 3-JUL-78 16:05")
    (PROG (FORK)
          (JS GET (XWD (SETQ FORK (CFORK))
		       (SUBSYSJFN FILE)))
          (AND PRIMIO (JS SPJFN FORK (XWD PRIMIO PRIMIO)))
          (JS FFORK FORK)          (* don't really let it run)
          (JS SFORK FORK (IPLUS (JS GEVEC FORK NIL NIL 2)
				(OR ENTRY 0)))
          (RETURN FORK])

(FTP
  [LAMBDA (HOST FILE ACCESS USER PWD ACCT BYTESIZE)
                                   (* lmm "18-OCT-78 01:43")
    (COND
      ((PUPHOSTP HOST)
	(PUPFTP HOST FILE ACCESS USER PWD ACCT BYTESIZE))
      (T (ARPAFTP HOST FILE ACCESS USER PWD ACCT BYTESIZE])

(PUPHOSTP
  [LAMBDA (X)                      (* lmm "24-SEP-78 03:09")
    (INFILEP (PACK* "PUP:." X])

(PUPOPENF
  [LAMBDA (LSKT HOST FSKT ACCESS LISTEN DONTWAIT)
                                   (* bvm: " 3-MAR-81 11:17")
    (PROG [TEM (LSKT (COND
		       ((FIXP LSKT)
			 (CONCAT (OCTAL LSKT)
				 "!A"))
		       (LSKT)
		       (T (CONCAT (OCTAL (CONN#))
				  "!J"]
          (while [OPENP (SETQ TEM
			  (PACK (CONS "PUP:"
				      (CONS LSKT (CONS "."
						       (AND HOST (LIST HOST "+"
								       (COND
									 ((FIXP FSKT)
									   (OCTAL FSKT))
									 (T (OR FSKT (QUOTE TELNET]
	     do (SETQ LSKT (CONCAT "0" LSKT)))
          (RETURN (OPENFILE TEM ACCESS NIL 8 (COND
			      [LISTEN (COND
					[DONTWAIT (QUOTE ((MODE 3]
					(T (QUOTE ((MODE 2]
			      (T (COND
				   [DONTWAIT (QUOTE ((MODE 1]
				   (T 
                                   (* mode 0)
				      NIL])

(PUPPAIR
  [LAMBDA (LSKT HOST SKT LISTEN DONTWAIT)
                                   (* lmm "23-JUN-78 13:21")
    (SETQ INF (PUPOPENF LSKT HOST SKT (QUOTE INPUT)
			LISTEN DONTWAIT))
    (SETQ OUTF (PUPOPENF (JS CVSKT (OPNJFN INF)
			     NIL NIL 3)
			 HOST SKT (QUOTE OUTPUT)
			 LISTEN DONTWAIT])

(PUPSERVER
  [LAMBDA (PUP# WAITFLG)           (* lmm "23-JUN-78 13:06")
    (MAKENEWCONNECTION NIL (QUOTE PUPSERVER)
		       (LOGOR (LLSH (USERNUMBER)
				    15)
			      (OR PUP# 0))
		       NIL
		       (NOT WAITFLG])

(PUPUSER
  [LAMBDA (HOST USER PUP# WAITFLG)
                                   (* lmm "23-JUN-78 13:06")
    (MAKENEWCONNECTION (OR HOST (HOSTNAME))
		       (QUOTE PUP)
		       (LOGOR (LLSH (OR (NUMBERP USER)
					(USERNUMBER USER))
				    15)
			      (OR PUP# 0))
		       NIL
		       (NOT WAITFLG])

(SENDPUPPARAMETER
  [LAMBDA (J MARK VAL)             (* lmm " 9-MAY-78 01:57")
    (JS MTOPR J 3 MARK)
    (JS BOUT J VAL)
    (JS MTOPR J 21Q)])

(SUBSYSJFN
  [LAMBDA (FILE)                   (* lmm "27-JUN-78 04:29")
    (OR (COND
	  ((OR (NULL FILE)
	       (EQ FILE (QUOTE EXEC)))
	    (GTJFN (QUOTE <SYSTEM>EXEC.SAV)
		   NIL NIL 32768))
	  ((GTJFN (PACK* (QUOTE <SUBSYS>)
			 FILE
			 (QUOTE .SAV))
		  NIL NIL 32768))
	  ((GTJFN FILE (QUOTE .SAV)
		  NIL 32768)))
	(ERROR FILE "not found"])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(FILESLOAD (FROM VALUEOF LISPUSERSDIRECTORIES)
	   NET)
(DECLARE: EVAL@COMPILE DONTCOPY 
(FILESLOAD (LOADCOMP)
	   NET)
)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (538 6072 (CONN# 550 . 734) (MAKEJOB 738 . 2969) (MAKESUBSYS 2973 . 3378) (FTP 3382 . 
3661) (PUPHOSTP 3665 . 3777) (PUPOPENF 3781 . 4636) (PUPPAIR 4640 . 4965) (PUPSERVER 4969 . 5206) (
PUPUSER 5210 . 5533) (SENDPUPPARAMETER 5537 . 5694) (SUBSYSJFN 5698 . 6069)))))
(DECLARE: DONTCOPY (PUTPROPS PUPBSP COPYRIGHT ("Xerox Corporation" 1981)))
STOP