Google
 

Trailing-Edge - PDP-10 Archives - -
There are no other files named in the archive.
(FILECREATED "13-JUN-82 15:27:46" <LISPUSERS>EXEC.;50 41313  

      changes to:  (FNS FINDUSER)

      previous date: " 9-MAY-81 09:04:21" <LISPUSERS>EXEC.;49)


(* Copyright (c) 1982 by Xerox Corporation)

(PRETTYCOMPRINT EXECCOMS)

(RPAQQ EXECCOMS [(DECLARE: FIRST (ADDVARS (NOSWAPFNS EXPUNGE FORKSTAT1)))
	(* EXEC like features)
	(FNS CNDIR COPYALLBYTES EXPUNGE MEMSTAT MEMSTAT1 MSCOMBINE MSPRINT ODATE TERMSTAT TERMTYPE 
	     DETACH TTY# DETACHEDP DSKSTAT DSKSTAT1 DSKSTAT2 FINDUSER FORKSTAT FORKSTAT1 PRINRANGE 
	     PRINTUSERNAME FINDDIRECTORYNUMBER FINDUSERNUMBER SYSTAT JOBPARAMS PRINTJOBPARAMS 
	     GTJFNTTY FILESTAT FILESTAT1 FSPRINT)
	(P (MOVD (QUOTE USERLISPXPRINT)
		 (QUOTE LISPXODATE))
	   (SETSYNTAX 6 (QUOTE (INFIX FIRST IMMED GTJFNTTY))
		      T)
	   (SETSYNTAX 6 T EDITRDTBL))
	(LISPXMACROS UND DEL DELVER NDIR)
	(LISPXMACROS EXP CONN DET SY DSK FI MEM QU DA TY SEE INFO)
	(VARS TERMINALTYPES)
	(ALISTS (LISPXCOMS CON TALK WHE LD)
		(DIRCOMMANDS AU DEL))
	(ADDVARS (OTHERUSERS))
	(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
	       PASSWORDS)
	(DECLARE: DONTCOPY EVAL@COMPILE (RECORDS JOBPARAMS MEMSTAT SOURCE DSKSTAT)
		  DONTEVAL@LOAD
		  (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
			 CJSYS))
	(COMS (* Linking and breaking links functions and macros.)
	      (FNS BREAKLINKS LINKTOTTY LINKTOUSER OCTAL)
	      (LISPXMACROS BR LINK)
	      (ALISTS (LISPXCOMS TALK)))
	(BLOCKS (DSKSTAT DSKSTAT DSKSTAT1 DSKSTAT2 (GLOBALVARS DIRECTORIES))
		(SYSTATBLOCK (ENTRIES LINKTOUSER SYSTAT)
			     LINKTOTTY FINDUSER SYSTAT JOBPARAMS LINKTOUSER PRINTJOBPARAMS
			     (GLOBALVARS BYTELISPFLG OTHERUSERS))
		(STATSBLOCK (ENTRIES FILESTAT MEMSTAT FORKSTAT TERMSTAT TERMTYPE)
			    TERMSTAT TERMTYPE FILESTAT FILESTAT1 FORKSTAT FSPRINT MEMSTAT MEMSTAT1 
			    MSCOMBINE MSPRINT PRINRANGE (LOCALFREEVARS FLG)
			    (GLOBALVARS USERFORKS HOSTNAME TERMINALTYPES)
			    (NOLINKFNS . T)))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
									      (NLAML)
									      (LAMA])
(DECLARE: FIRST 

(ADDTOVAR NOSWAPFNS EXPUNGE FORKSTAT1)
)



(* EXEC like features)

(DEFINEQ

(CNDIR
  [LAMBDA (DIR PASSWORD)           (* mdy "23-May-79 14:47")
    (PROG (DIRNAME)
          [SETQ DIRNAME (OR (AND (FIXP DIR)
				 (DIRECTORYNAME DIR T))
			    (AND (OR (LITATOM DIR)
				     (STRINGP DIR))
				 (OR (DIRECTORYNAME DIR T)
				     (DIRECTORYNAME (PACK* DIR (CONSTANT (CHARACTER 27)))
						    T)))
			    (ERRORX (LIST 27 DIR]
      RETRY
          (COND
	    ((CONNECTDIR DIRNAME PASSWORD))
	    ((NOT (STREQUAL (SETQ PASSWORD (GETPASSWORD DIRNAME PASSWORD))
			    ""))
	      (GO RETRY))
	    (T (ERROR "Can't connect to directory" DIRNAME)))
          (RETURN (DIRECTORYNAME T T])

(COPYALLBYTES
  [LAMBDA (FROMFILE TOFILE BYTESIZE)
                                   (* rmk: " 6-AUG-80 11:44")
    (RESETLST (PROG (IN OUT PTR)
		    [RESETSAVE NIL (COND
				 [[SETQ IN (COND
				       (FROMFILE (OPENP FROMFILE (QUOTE INPUT)))
				       (T (INPUT]
				   (COND
				     ((RANDACCESSP IN)
                                   (* Start at the beginning if you can reset and restore current position later.
				   If can't reset, just start at current position.)
				       (SETQ PTR 0)
				       (LIST (QUOTE SETFILEPTR)
					     IN
					     (GETFILEPTR IN]
				 (T (LIST (QUOTE CLOSEF?)
					  (SETQ IN (OPENFILE FROMFILE (QUOTE INPUT)
							     NIL BYTESIZE]
                                   (* close the files only if I opened them)
		    [COND
		      ([NOT (SETQ OUT (COND
				(TOFILE (OPENP TOFILE (QUOTE OUTPUT)))
				(T (OUTPUT]
			(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
					     (SETQ OUT (OPENFILE TOFILE (QUOTE OUTPUT)
								 NIL BYTESIZE]
		    (COND
		      ((AND (NULL BYTESIZE)
			    (EQ OUT T))
			(PFCOPYBYTES IN OUT PTR (AND PTR -1)))
		      (T (COPYBYTES IN OUT PTR (AND PTR -1])

(EXPUNGE
  [LAMBDA (DIR)                    (* J.Vittal: "13-Jan-81 10:04")
                                   (* expunges given directory)
    (PROG [(NUM (DIRECTORYNUMBER (OR DIR T]
          (RETURN (OR [AND (OR (EQ (SYSTEMTYPE)
				   (QUOTE TOPS20))
			       (IEQP (DIRECTORYNUMBER T)
				     NUM)
			       (IEQP (DIRECTORYNUMBER)
				     NUM))
			   (COND
			     ((EQ (SYSTEMTYPE)
				  (QUOTE TENEX))
			       (ASSEMBLE NIL
				         (CV NUM)
				         (JS DELDF)
				         (JUMP 16Q , EXPERR)
				         (SKIPA 1 , ' T)
				     EXPERR
				         (MOVE 1 , ' NIL)))
			     (T (ASSEMBLE NIL
				          (CV 0)
				          (CV2 NUM)
				          (JS DELDF)
				          (JUMP 16Q , EXPERR)
				          (SKIPA 1 , ' T)
				      EXPERR
				          (MOVE 1 , ' NIL]
		      (RESETLST (RESETSAVE (CNDIR DIR)
					   (LIST (QUOTE CNDIR)
						 (DIRECTORYNAME T T)))
				(EXPUNGE DIR])

(MEMSTAT
  [LAMBDA (PG1 PGN SOURCE)         (* lmm "28-SEP-78 04:45")
    (RESETLST (RESETSAVE (RADIX 8))
	      (RESETSAVE (OUTPUT T))
	      (PROG (LP (MAX 511)
			TP)
		    (COND
		      [(NULL SOURCE)
			(COND
			  ((OR (EQ PGN T)
			       (EQ PG1 T))
			    (SETQ SOURCE T]
		      ((EQ SOURCE T))
		      [(SMALLP SOURCE)
                                   (* a file)
			(COND
			  ((NOT (FILESTAT1 SOURCE T))
			    (RETURN)))
			(TERPRI)
			(SETQ MAX (LOC (ASSEMBLE NIL
					         (CV SOURCE)
					         (JS FFFFP)
                                   (* Find First Free File Page returns jfn,,page)
					     LP  (MOVEI 3 , 0 (1))
					         (JS FFUFP)
                                   (* Find First Used File Page takes & returns jfn,,page)
					         (SKIPA)
                                   (* no more used; 3 has 1+max)
					         (AOJA 1 , LP)
                                   (* try again)
					         (MOVEI 1 , -1 (3]
		      (T (COND
			   ((NOT (FORKSTAT1 SOURCE))
			     (RETURN)))
			 (TERPRI)))
		    [COND
		      ((NOT (SMALLP PGN))
			(SETQ PGN (OR (SMALLP PG1)
				      MAX]
		    (COND
		      ((NOT (SMALLP PG1))
			(SETQ PG1 0)))
		    (while (ILEQ PG1 PGN) do (SETQ TP (MEMSTAT1 PG1 SOURCE))
					     (COND
					       ((MSCOMBINE TP LP))
					       (T (MSPRINT LP)
						  (SETQ LP TP)))
					     (SETQ PG1 (ADD1 PG1)))
		    (MSPRINT LP)
		    (TAB 0 0])

(MEMSTAT1
  [LAMBDA (PAGE SOURCE)            (* lmm "20-OCT-78 00:51")
    (PROG (ACCESS)
          [SETQ ACCESS (LOGOR (LLSH (LOGAND -262144 (JS RPACS (XWD (OR (FIXP SOURCE)
								       400000Q)
								   PAGE)
							NIL NIL 2))
				    2)
			      (COND
				((EQ SOURCE T)
				  (OPENR (IPLUS (LOC (COREVAL TYPTAB))
						PAGE)))
				(T 0]
                                   (* Note that the bits are shifted left 2, to avoid interfering with SYSBIT and 
				   PVTBIT in TYPTAB)
          (RETURN (AND (NEQ ACCESS 0)
		       (create MEMSTAT
			       PAGE _ PAGE
			       SOURCE _(COND
				 ((NOT (OR (BIT 8 ACCESS)
					   (SMALLP SOURCE)))
				   (JS RMAP (XWD (OR (FIXP SOURCE)
						     400000Q)
						 PAGE)
				       NIL NIL 1)))
			       ACCESS _ ACCESS])

(MSCOMBINE
  [LAMBDA (NP OP)                  (* lmm "28-APR-78 22:13")
    (OR (EQ NP OP)
	(AND NP OP (EQUAL (fetch ACCESS of NP)
			  (fetch ACCESS of OP))
	     (EQ (fetch PAGE of NP)
		 (IPLUS (fetch PAGE of OP)
			(fetch LENGTH of OP)))
	     [OR (EQ (fetch SOURCE of NP)
		     (fetch SOURCE of OP))
		 (AND (fetch SOURCE of NP)
		      (fetch SOURCE of OP)
		      (IEQP (fetch FORK\FILE of (fetch SOURCE of NP))
			    (fetch FORK\FILE of (fetch SOURCE of OP)))
		      (IEQP (fetch SP of (fetch SOURCE of NP))
			    (IPLUS (fetch SP of (fetch SOURCE of OP))
				   (fetch LENGTH of OP]
	     (replace LENGTH of OP with (ADD1 (fetch LENGTH of OP])

(MSPRINT
  [LAMBDA (X)                      (* lmm "25-OCT-78 03:20")
    (AND X (PROG (FLG (ACCESS (fetch ACCESS of X)))
                                   (* ACCESS is value of RPACS left shifted 2)
	         (TAB 0 0)
	         (PRINRANGE (fetch PAGE of X)
			    (fetch LENGTH of X))
	         (SPACES 1)
	         (TAB 9 T)
	         (COND
		   ((BIT 4 ACCESS)
		     (PRIN1 "@ ")))
	         [COND
		   ((EQ (fetch SOURCE of X)
			-1)
		     (GO LST))
		   ((NULL (fetch SOURCE of X))
		     (PRIN1 "private"))
		   (T [COND
			[(ILEQ (fetch FORK\FILE of (fetch SOURCE of X))
			       64)
                                   (* file)
			  (PRIN1 (JFNS (fetch FORK\FILE of (fetch SOURCE of X))
				       NIL
				       (CONSTANT (CONCAT]
			(T (PRIN1 "fork ")
			   (PRIN1 (LOGAND (fetch FORK\FILE of (fetch SOURCE of X))
					  63]
		      (SPACES 2)
		      (TAB 35 T)
		      (PRINRANGE (fetch SP of (fetch SOURCE of X))
				 (fetch LENGTH of X]
	         (SPACES 2)
	         (TAB 45 T)
	         (OR (BIT 3 ACCESS)
		     (PRIN1 "- "))
	         [COND
		   ((BIT 0 ACCESS)
		     (FSPRINT (QUOTE R]
	         [COND
		   ((BIT 1 ACCESS)
		     (FSPRINT (QUOTE W]
	         [COND
		   ((BIT 7 ACCESS)
		     (FSPRINT (QUOTE CW]
	         [COND
		   ((BIT 2 ACCESS)
		     (FSPRINT (QUOTE E]
	         [COND
		   ((BIT 6 ACCESS)
		     (FSPRINT (QUOTE TRAP-TO-USER]
	         [COND
		   ((BIT 10 ACCESS)
		     (FSPRINT (QUOTE P)))
		   ((BIT 11 ACCESS)
		     (FSPRINT (QUOTE S]
	     LST (COND
		   ((NEQ 0 (SETQ FLG (BITS 18 35 ACCESS)))
		     (SPACES 2)
		     (TAB 60 T)
		     (PRIN1 (OR (TYPENAMEFROMNUMBER FLG)
				FLG])

(ODATE
  [LAMBDA (DATE FILE)              (* lmm "27-SEP-78 04:21")
    (PRIN1 (GDATE DATE NIL (CONSTANT (CONCAT)))
	   FILE])

(TERMSTAT
  [LAMBDA (TERMID ALLFLG)          (* lmm "28-SEP-78 04:44")
    (RESETLST (RESETSAVE (OUTPUT T))
	      (RESETSAVE (RADIX 10))
	      (PROG ((FLG T)
		     JFN MOD)
		    [COND
		      ((NULL TERMID)
			(SETQ JFN 64))
		      [(NOT (FIXP (SETQ JFN TERMID)))
			(RESETSAVE NIL (LIST (QUOTE RLJFN)
					     (SETQ JFN (GTJFN TERMID]
		      ((AND (ILESSP TERMID 63)
			    (IGREATERP TERMID 0))
			(SETQ JFN (IPLUS TERMID 131072]
		    (SETQ MOD (JS RFMOD JFN 0 0 2))
		    (PRIN1 "terminal is ")
		    (PRIN1 (TERMTYPE JFN))
		    (COND
		      ((BIT 1 MOD)
			(FSPRINT "has formfeed")))
		    (COND
		      ((BIT 2 MOD)
			(FSPRINT "has TAB")))
		    (COND
		      ((NOT (BIT 3 MOD))
			(FSPRINT "no lowercase")))
		    (FSPRINT (BITS 4 10 MOD))
		    (PRIN1 " long")
		    (FSPRINT (BITS 11 17 MOD))
		    (PRIN1 " wide")
		    (SELECTQ (BITS 24 25 MOD)
			     (2    (* normal))
			     (0 (FSPRINT "no echo"))
			     (1 (FSPRINT "immediate echo"))
			     (FSPRINT "echo both immediate and deffered"))
		    (COND
		      ((NOT (BIT 26 MOD))
			(FSPRINT "links refused")))
		    (COND
		      ((BIT 27 MOD)
			(FSPRINT "advice allowed")))
		    (SELECTQ (BITS 28 29 MOD)
			     (1    (* normal))
			     (0 (FSPRINT "binary mode"))
			     (2 (FSPRINT "binary echo"))
			     (FSPRINT "binary output"))
		    (COND
		      ((BIT 30 MOD)
			(FSPRINT "indicate lower case")))
		    (COND
		      ((BIT 31 MOD)
			(FSPRINT "convert lower to upper")))
		    (SELECTQ (BITS 32 33 MOD)
			     (0    (* normal))
			     (1 (FSPRINT "char. half duplex"))
			     (3 (FSPRINT "half duplex"))
			     (SHOULDNT))
		    [SELECTQ (BITS 18 23 MOD)
			     (14 
                                   (* Normal: everything but alphabetics))
			     (15 (FSPRINT "wakeup every char" T T))
			     (PROGN (FSPRINT "wakup " T T)
				    (FSPRINT (SELECTQ (BIT 20 21 MOD)
						      (0 "no")
						      (1 "non-formatting")
						      (2 "formatting")
						      "all")
					     T)
				    (FSPRINT " controls" T)
				    (COND
				      ((BIT 22 MOD)
					(FSPRINT "punctuation" T)))
				    (COND
				      ((BIT 23 MOD)
					(FSPRINT "letters" T]
		    [PROG [(COC1 (JS RFCOC JFN NIL NIL 2))
			   (COC2 (JS RFCOC JFN NIL NIL 3))
			   IGNORE INDICATE SEND SIMULATE VAR FLG
			   (STDCOC (AND (NULL ALLFLG)
					(QUOTE ((IGNORE 0)
						 (INDICATE 1 2 3 4 5 6 8 11 14 15 16 17 18 19 20 21 
							   22 23 24 25 26 28 29 30)
						 (SEND 7 9 10 12 13 31)
						 (SIMULATE 27]
		          [for I from 0 to 31
			     do (SETQ VAR (SELECTQ (LOGAND 3 (LLSH (COND
								     ((ILEQ (SETQ J I)
									    17)
								       COC1)
								     (T (SETQ J (IDIFFERENCE I 18))
									COC2))
								   (IPLUS -34 J J)))
						   (0 (QUOTE IGNORE))
						   (1 (QUOTE INDICATE))
						   (2 (QUOTE SEND))
						   (3 (QUOTE SIMULATE))
						   NIL))
				(OR (FMEMB I (CDR (FASSOC VAR STDCOC)))
				    (SET VAR (NCONC1 (EVALV VAR)
						     (CHARACTER (IPLUS 64 I]
		          [COND
			    (IGNORE (TERPRI)
				    (SPACES 4)
				    (PRIN1 "ignore control ")
				    (MAPRINT IGNORE NIL NIL NIL (QUOTE ,]
		          [COND
			    (INDICATE (TERPRI)
				      (SPACES 4)
				      (PRIN1 "indicate control ")
				      (MAPRINT INDICATE NIL NIL NIL (QUOTE ,]
		          [COND
			    (SEND (TERPRI)
				  (SPACES 4)
				  (PRIN1 "send control ")
				  (MAPRINT SEND NIL NIL NIL (QUOTE ,]
		          (COND
			    (SIMULATE (TERPRI)
				      (SPACES 4)
				      (PRIN1 "simulate control ")
				      (MAPRINT SIMULATE NIL NIL NIL (QUOTE ,]
		    (TERPRI])

(TERMTYPE
  [LAMBDA (JFN)                    (* lmm "28-SEP-78 05:02")
    (PROG ((N (JS GTTYP (OR JFN 777777Q)
		  NIL NIL 2)))
          (RETURN (for X in TERMINALTYPES when [AND (OR (NULL (CAR X))
							(EQ (CAR X)
							    (SYSTEMTYPE))
							(EQMEMB HOSTNAME (CAR X)))
						    (SETQ X (FASSOC N (CDR X]
		     do (RETURN (CADR X))
		     finally (RETURN (COND
				       ((SMALLP N)
					 N)
				       (T (MKATOM (COND
						    ([NUMBERP (SETQ N (MKATOM (SIXBIT N]
						      (CONCAT "TEKTRONIX-" N))
						    (T N])

(DETACH
  [LAMBDA NIL                      (* lmm " 9-MAY-78 23:17")
    (COND
      ((NOT (DETACHEDP))
	(RESETLST (RESETSAVE (OUTPUT T))
		  (RESETSAVE (RADIX 10))
		  (PRIN1 "detaching job ")
		  (PRINT (JS GJINF NIL NIL NIL 3))
		  (JS DTACH)
		  (PRIN1 "reattached")
		  (TERPRI)
		  (ASSEMBLE NIL    (* to set terminal mode word)
			    (FASTCALL SETMOD))
		  NIL])

(TTY#
  [LAMBDA NIL                      (* lmm: "21-FEB-77 16:16:34")
    (JS GJINF NIL NIL NIL 4)])

(DETACHEDP
  [LAMBDA NIL                      (* lmm: "21-OCT-76 06:33:38")
    (EQ (TTY#)
	-1])

(DSKSTAT
  [LAMBDA (U NDAYS NPAGES NOSYS INV)
                                   (* J.Vittal: "11-Jan-81 15:56")
    (RESETLST (RESETSAVE (RADIX 10))
	      (RESETSAVE (OUTPUT T))
	      (PROG (STATS)
		    (COND
		      ((AND (FIXP U)
			    (NULL NDAYS))
			(SETQ NDAYS U)
			(SETQ U T)))
		    [SETQ STATS (DSKSTAT1 (OR (FIXP U)
					      (FINDDIRECTORYNUMBER (OR U T)
								   DIRECTORIES)
					      (ERROR U "not user name" T))
					  NPAGES
					  (IDIFFERENCE (IDATE)
						       (ITIMES (OR (SMALLP NDAYS)
								   90)
							       (CONSTANT (IDIFFERENCE (IDATE 
									      "2-JAN-77 00:00:00")
										      (IDATE 
									      "1-JAN-77 00:00:00"]
		    (COND
		      ((NOT STATS)
			(RETURN)))
		    [COND
		      ((EQ (SYSTEMTYPE)
			   (QUOTE TENEX))
			(PRINTUSERNAME (fetch DIR of STATS)))
		      (T (PRIN1 (DIRECTORYNAME (fetch DIR of STATS]
		    (PRIN1 ": ")
		    (PRIN1 (fetch USED of STATS))
		    (PRIN1 " used")
		    (DSKSTAT2 (fetch (DSKSTAT DELETED) of STATS)
			      "deleted")
		    (DSKSTAT2 (fetch OLD of STATS)
			      (LIST "untouched in " (OR (NUMBERP NDAYS)
							90)
				    " days"))
		    (DSKSTAT2 (fetch OLDVERSIONS of STATS)
			      "in old versions")
		    (COND
		      (INV (DSKSTAT2 (fetch PROTECTED of STATS)
				     "protected")))
		    (PRIN1 ".
")
		    (COND
		      ((NOT NOSYS)
			(PRIN1 "System total: ")
			[PRIN1 (COND
				 ((EQ (SYSTEMTYPE)
				      (QUOTE TENEX))
				   (JS GDSKC NIL NIL NIL 2))
				 (T (JS GDSKC (XWD 600000Q -1)
					NIL NIL 2)]
			(PRIN1 " pages left, ")
			[PRIN1 (COND
				 ((EQ (SYSTEMTYPE)
				      (QUOTE TENEX))
				   (JS GDSKC NIL NIL NIL 1))
				 (T (JS GDSKC (XWD 600000Q -1)
					NIL NIL 1)]
			(PRIN1 " used.
")))
		    (RETURN])

(DSKSTAT1
  [LAMBDA (DIR MINPAGES SINCE)     (* lmm "28-SEP-78 17:03")
    (PROG ((OLD 0)
	   (DELETED 0)
	   (OLDVERSIONS 0)
	   (USED (JS GTDAL DIR NIL NIL 2))
	   (PROTECTED 0))
          (COND
	    ([AND MINPAGES (ILESSP USED (OR (FIXP MINPAGES)
					    (JS GTDAL DIR NIL NIL 1)]
	      (RETURN)))
          (ASSEMBLE ((ALLCNT -25Q)
		     (DELCNT -24Q)
		     (VERCNT -23Q)
		     (OLDCNT -22Q)
		     (GNJFLG -21Q)
		     (DATE -20Q)
		     (JFN -17Q)
		     (FDB -17Q)
		     (e -7))
		    (CV SINCE)
		    (PUSHNN (= 0)
			    (= 0)
			    (= 0)
			    (= 0)
			    (= -1)
			    (1)
			    (0)
			    (0 1)
			    (0 2)
			    (0 3)
			    (0 4)
			    (0 5)
			    (0 6)
			    (0 7)
			    (= 101101777775Q)
			    (= 377777377777Q)
			    (= 0)
			    (XXXMHC)
			    (= 0)
			    (= 0)
			    (= 0)
			    (= 0))

          (* oldverflg -
	  since-date -
	  JFN -
	  FDB1 -
	  FDB2 -
	  FDB3 -
	  FDB4 -
	  FDB5 -
	  FDB6 -
	  gtjfn block are -
	  e flags,,version -
	  e+1 injfn,,outjfn -
	  e+2 device -
	  e+3 directory -
	  e+4 name -
	  e+5 extension -
	  e+6 protection -
	  e+7 account)


		    (CV2 DIR)
		    (MOVE 1 , XXXMHC)
		    (JS DIRST)
		    (JUMPA FAIL)
		    (MOVEI 2 , 0)
		    (IDPB 2 , 1)
		    (CQ "*.* ")
		    (FASTCALL UPATM)
		    (MOVE 2 , 3)
		    (NREF (MOVEI 1 , e))
		    (JS GTJFN)
		    (JRST FAIL)
		    (NREF (MOVEM 1 , JFN))
                                   (* save JFN)
		LP  (NREF (HRRZ 1 , JFN))
		    (MOVE 2 , = 15000001Q)
		    (NREF (MOVEI 3 , FDB+1))
		    (JS GTFDB)
		    (NREF (HRRZ 5 , FDB+11Q))
                                   (* save size)
		    (NREF (ADDM 5 , ALLCNT))
		    (NREF (MOVE 2 , FDB+1))
		    (TLNE 2 , 40000Q)
                                   (* deleted bit (b3 of word 1))
		    (JRST DELETEDFILE)
		    (NREF (MOVE 2 , DATE))
		    (NREF (CAML 2 , FDB+14Q))
                                   (* last write date)
		    (NREF (CAMG 2 , FDB+15Q))
                                   (* last read date)
		    (JRST NOTOLD)
		OLDFILE
		    (NREF (ADDM 5 , OLDCNT))
		    (JRST NEXTFILE)
		DELETEDFILE
		    (NREF (ADDM 5 , DELCNT))
		    (JRST NEXTFILE)
		NOTOLD
		    (NREF (MOVE 2 , GNJFLG))
		    (TLNN 2 , 36Q)
		    (NREF (ADDM 5 , VERCNT))
		NEXTFILE
		    (NREF (MOVE 1 , JFN))
		    (JS GNJFN)
		    (JRST OUT)
		    (NREF (MOVEM 1 , GNJFLG))
		    (JRST LP)
		OUT (NREF (HRRZ 1 , JFN))
		    (JS RLJFN)
		    (JFCL)
		    (NREF (MOVE 1 , OLDCNT))
		    (FASTCALL MKN)
		    (SETQ OLD)
		    (NREF (MOVE 1 , DELCNT))
		    (FASTCALL MKN)
		    (SETQ DELETED)
		    (NREF (MOVE 1 , VERCNT))
		    (FASTCALL MKN)
		    (SETQ OLDVERSIONS)
		    (CV USED)
		    (NREF (SUB 1 , ALLCNT))
		    (FASTCALL MKN)
		    (SETQ PROTECTED)
		FAIL(POPNN 26Q))
          (RETURN (create DSKSTAT
			  DIR _ DIR
			  USED _ USED
			  OLD _ OLD
			  OLDVERSIONS _ OLDVERSIONS
			  DELETED _ DELETED
			  PROTECTED _ PROTECTED])

(DSKSTAT2
  [LAMBDA (N STR)                  (* lmm " 5-OCT-78 14:32")
    (COND
      ((NOT (ZEROP N))
	(PRIN1 ", ")
	(PRIN1 N)
	(SPACES 1)
	(for S inside STR do (PRIN1 S])

(FINDUSER
  [LAMBDA (NAME)                   (* lmm "13-JUN-82 15:23")
    (PROG [[USERNUM (SELECTQ NAME
			     (NIL NIL)
			     (ALL (QUOTE ALL))
			     (COND
			       ((FIXP NAME)
				 (AND (USERNAME NAME T)
				      NAME))
			       (T (FINDUSERNUMBER NAME OTHERUSERS]
	   (TABLE (LOGAND (SELECTQ (SYSTEMTYPE)
				   (TENEX (JS SYSGT (CONSTANT (SIXBIT (QUOTE JOBDIR)))
					      NIL NIL 2))
				   (TOPS20 (JS SYSGT (CONSTANT (SIXBIT (QUOTE JOBTTY)))
					       NIL NIL 2))
				   (SHOULDNT))
			  262143))
	   (USERNAME (CONSTANT (CONCAT]
          (RETURN (bind USER for JOB from (SELECTQ (SYSTEMTYPE)
						   (TENEX 0)
						   (TOPS20 1)
						   (SHOULDNT))
		     to (IDIFFERENCE -1 (JS GETAB (XWD 777777Q TABLE)
					    NIL NIL 1))
		     eachtime (SETQ USER (SELECTQ (SYSTEMTYPE)
						  (TENEX (LOGAND 262143 (JS GETAB (XWD JOB TABLE)
									    NIL NIL 1)))
						  (TOPS20 (COND
							    ((IEQP (JS GETJI JOB 0 0 1)
								   JOB)
							      (JS GETJI JOB 0 2 0))
							    (T -1)))
						  (SHOULDNT)))
		     when (SELECTQ USERNUM
				   [NIL (NOT (SELECTQ (SYSTEMTYPE)
						      (TENEX (OR (ZEROP USER)
								 (EQ USER 1)))
						      [TOPS20 (OR (NOT (IEQP JOB
									     (JS GETJI JOB 0 0 1)))
								  (EQUAL USER (USERNUMBER
									   (QUOTE OPERATOR)))
								  (EQUAL USER (USERNUMBER
									   (QUOTE OPS]
						      (SHOULDNT]
				   (ALL (SELECTQ (SYSTEMTYPE)
						 (TENEX (NOT (ZEROP USER)))
						 (TOPS20 (IEQP JOB (JS GETJI JOB 0 0 1)))
						 (SHOULDNT)))
				   (IEQP USER USERNUM))
		     collect JOB])

(FORKSTAT
  [LAMBDA (FORK)                   (* lmm " 4-MAY-78 02:42")
    [COND
      (FORK (for X inside FORK do (FORKSTAT1 X)))
      (T (MAPHASH USERFORKS (FUNCTION (LAMBDA (X Y)
		      (FORKSTAT1 Y]
    FORK])

(FORKSTAT1
  [LAMBDA (FORK)                   (* lmm "28-SEP-78 04:45")
    (PROG (STATUS PC CHANNEL LISP UNASSIGNED FROZEN)
          [COND
	    ((NULL FORK)
	      (SETQ FORK 131072))
	    ((NOT (AND (FIXP FORK)
		       (IGEQ FORK 131072)
		       (ILEQ FORK 131088)))
	      (RETURN))
	    (T (SETQ LISP (GETHASH FORK USERFORKS]
          (ASSEMBLE NIL
		    (CV FORK)
		    (JS RFSTS)
		    (JUMP 16Q , LOSE)
		    (VAR (HRRM 1 , CHANNEL))
		    (HLRE 1 , 1)
		    (JUMPGE 1 , RFX)
		    (CAMN 1 , = -1)
		LOSE(SETQ UNASSIGNED)
		    (SETQ FROZEN)
		RFX (TRZ 1 , 400000Q)
		    (VAR (HRRM 1 , STATUS))
		    (VAR (HRRM 2 , PC)))
          (COND
	    (UNASSIGNED (RETURN)))
          (RESETLST (RESETSAVE (RADIX 8))
		    (RESETSAVE (OUTPUT T))
		    (PRIN1 "FORK ")
		    (PRIN1 (LOGAND FORK 63))
		    (PRIN1 ", ")
		    (COND
		      (FROZEN (PRIN1 "(FROZEN) ")))
		    (PRIN1 (SELECTQ (LOC STATUS)
				    (0 "RUNNING AT ")
				    (1 "I/O WAIT AT ")
				    (2 "HALTED AT ")
				    (3 (PRIN1 "TRAP, CHANNEL ")
				       (PRIN1 (LOC CHANNEL))
				       ", AT ")
				    (4 "FORK WAIT AT ")
				    "UNKNOWN STATE, PC= "))
		    (PRIN1 (LOC PC))
		    (COND
		      (LISP (PRIN1 " (subsys)")))
		    (TERPRI))
          (RETURN FORK])

(PRINRANGE
  [LAMBDA (X LEN)                  (* lmm "28-APR-78 22:04")
    (PRIN1 X)
    (COND
      ((NEQ LEN 1)
	(PRIN1 "-")
	(PRIN1 (IPLUS X LEN -1])

(PRINTUSERNAME
  [LAMBDA (N FILE)                 (* lmm " 3-MAY-78 17:56")
    (ASSEMBLE NIL
	      (CQ2 FILE)
	      (FASTCALL OFSET)
	      (CQ MACSCRATCHSTRING)
	      (PUSHJ CP , UPATM)
	      (MOVE 1 , 3)
	      (CQ2 N)
	      (SUBI 2 , ASZ)
	      (JS DIRST)
	      (JUMPA NONE)
	      (MOVEI 4 , 0)        (* 4 is a flag to lowercase)
	  LP  (ILDB 1 , 3)
	      (JUMPE 1 , DONE)
	      (CAIN 4 , 0)
	      (AOJA 4 , BOUT)      (* Set flag and output)
	      (CAIG 1 , 132Q)
	      (CAIGE 1 , 101Q)
	      (TDZA 4 , 4)
	      (ADDI 1 , 40Q)
	  BOUT(PUSHJ CP , FOUT)
	      (JUMPA LP)
	  NONE(CQ (PRIN1 "unknown" FILE))
	  DONE])

(FINDDIRECTORYNUMBER
  [LAMBDA (DIRNAME SPLST FLG)      (* mdy "22-May-79 19:14")
    (OR (AND (FIXP DIRNAME)
	     (DIRECTORYNAME DIRNAME)
	     DIRNAME)
	(DIRECTORYNUMBER DIRNAME)
	[DIRECTORYNUMBER (CONCAT DIRNAME (CONSTANT (CHARACTER 27]
	(DIRECTORYNUMBER (OR [CAR (SOME DIRECTORIES (FUNCTION (LAMBDA (DIR)
					    (AND DIR (STRPOS DIRNAME DIR 1 NIL T]
			     (FIXSPELL DIRNAME NIL SPLST FLG NIL NIL T T)
			     (ERROR "Can't find directory" DIRNAME])

(FINDUSERNUMBER
  [LAMBDA (USERNAME SPLST FLG)     (* mdy "22-May-79 19:14")
    (OR (AND (FIXP USERNAME)
	     (USERNAME USERNAME)
	     USERNAME)
	(USERNUMBER USERNAME)
	[USERNUMBER (CONCAT USERNAME (CONSTANT (CHARACTER 27]
	(USERNUMBER (OR (FIXSPELL USERNAME NIL SPLST FLG NIL NIL T T)
			(ERROR "Can't find user" USERNAME])

(SYSTAT
  [LAMBDA (USER)                   (* lmm "26-APR-81 11:42")
    (PROG [(JOBS (for X in (FINDUSER (AND (NEQ USER (QUOTE ,))
					  USER))
		    collect (JOBPARAMS X]
          (for X in [SORT JOBS (FUNCTION (LAMBDA (X Y)
			      (IGREATERP (fetch PER of X)
					 (fetch PER of Y]
	     do (PRINTJOBPARAMS X])

(JOBPARAMS
  [LAMBDA (JOB)                    (* lmm "29-APR-81 20:58")
    (PROG (TTY DIR)
          (SETQ DIR (SELECTQ (SYSTEMTYPE)
			     (TENEX (OR (FIXP (GETAB (QUOTE JOBDIR)
						     JOB))
					(RETURN)))
			     (TOPS20 (OR (SMALLP (JS GETJI JOB 0 0 0))
					 (RETURN)))
			     (SHOULDNT)))
          (RETURN (create JOBPARAMS
			  TTY _(SELECTQ (SYSTEMTYPE)
					(TENEX (COND
						 ((IEQP (SETQ TTY
							  (LRSH (OR (FIXP (GETAB (QUOTE JOBTTY)
										 JOB))
								    (RETURN))
								18))
							262143)
						   -1)
						 (T TTY)))
					(TOPS20 (SETQ TTY (JS GETJI JOB 0 1 0)))
					(SHOULDNT))
			  JOBNO _ JOB
			  USERNAME _(SELECTQ (SYSTEMTYPE)
					     (TENEX (LOGAND 262143 DIR))
					     (TOPS20 (JS GETJI JOB 0 2 0))
					     (SHOULDNT))
			  PGMNAME _[SIXBIT (GETAB (SELECTQ (SYSTEMTYPE)
							   (TENEX (QUOTE JOBNM2))
							   (TOPS20 (QUOTE JOBPNM))
							   (SHOULDNT))
						  JOB
						  (CONSTANT (IPLUS 1000000]
			  CNDIR _(SELECTQ (SYSTEMTYPE)
					  (TENEX (LRSH DIR 18))
					  (TOPS20 (JS GETJI JOB 0 3 0))
					  (SHOULDNT))
			  PER _(COND
			    ((EQ HOSTNAME (QUOTE PARC-MAXC))
                                   (* JSYS to return CPU utilization implemented only at PARC)
			      (FIX (FTIMES (FLOC (ASSEMBLE NIL
						           (CQ (VAG JOB))
						           (JSYS 444Q)
						           (MOVE 1 , 2)))
					   1000.0)))
			    (T 0])

(PRINTJOBPARAMS
  [LAMBDA (JOBPARAMS)              (* lmm "29-APR-81 20:59")
    (AND JOBPARAMS (RESETLST (RESETSAVE (RADIX 10))
			     (RESETSAVE (OUTPUT T))
			     (PROG ((P JOBPARAMS))
			           (TAB 0 0)
			           (PRIN1 (fetch JOBNO of P))
			           (TAB 4)
			           (RADIX 8)
			           [PRIN1 (COND
					    ((EQ (fetch TTY of P)
						 -1)
					      (QUOTE det))
					    (T (fetch TTY of P]
			           (RADIX 10)
			           (TAB 8)
			           (SELECTQ (SYSTEMTYPE)
					    (TENEX (PRINTUSERNAME (fetch USERNAME of P)))
					    [TOPS20 (PRIN1 (USERNAME (fetch USERNAME of P]
					    (SHOULDNT))
			           [COND
				     ((NOT (STREQUAL (fetch PGMNAME of P)
						     "EXEC"))
				       (PRIN1 (QUOTE ,))
				       (PRIN1 (fetch PGMNAME of P]
			           [COND
				     ((NOT (IEQP (fetch USERNAME of P)
						 (fetch CNDIR of P)))
				       (SELECTQ (SYSTEMTYPE)
						(TENEX (PRIN1 (QUOTE ",<"))
						       (PRINTUSERNAME (fetch CNDIR of P))
						       (PRIN1 (QUOTE >)))
						[TOPS20 (PRIN1 ",")
							(PRIN1 (DIRECTORYNAME (fetch CNDIR
										 of P]
						(SHOULDNT]
			           (COND
				     ((NOT (IEQP (fetch PER of P)
						 0))
				       (PRIN1 ",")
				       (PRIN1 (IQUOTIENT (fetch PER of P)
							 10))
				       (PRIN1 ".")
				       (PRIN1 (IREMAINDER (fetch PER of P)
							  10))
				       (PRIN1 "%%")))
			           (TERPRI])

(GTJFNTTY
  [LAMBDA (FILE RDTBL TCONC)       (* lmm "11-FEB-78 15:22")
    (PROG (JFN BUFFLG BUFS OKFLG FILENAME)
                                   (* BUFFLG is set when buffers are cleared;
				   BUFS is set to the old buffers ; only cleared if an error takes place)
      LOOP[COND
	    ([NOT (NLSETQ (SETQ JFN (JS GTJFN 123000000Q 100000101Q NIL 1)]
	      (PROGN (ASSEMBLE NIL
			       (FASTCALL SETMOD))
		     (ERROR!]

          (* read file name, accept *'s -
	  GTJFN has the funny property that it resets the terminal mode inside it but that it isn't protected from interrupts 
	  thus the NLSETQ)


          (JS BKJFN 100Q)          (* BKJFN -
				   to get confirmation char)
          (COND
	    ((OR (NOT (SETQ OKFLG (ILESSP (LOGAND 262143 JFN)
					  64)))
		 (IEQP (JS PBIN NIL NIL NIL 1)
		       27))        (* confirmed with altmode -
				   Do another bin and bkjfn to peek at next char and make sure that it isn't a 
				   "delete" char)
	      (GO CHECKCONFIRM)))
      GOTIT
          (SETQ FILENAME (JFNS (LOGAND -956039169 JFN)))
          (RLJFN JFN)
          (SPACES 1 T)             (* Just to make sure user knows the file is there)
          (COND
	    (BUFFLG (BKBUFS BUFS)))
          (RETURN (TCONC TCONC FILENAME))
      CHECKCONFIRM                 (* The SELECTQ will get either the char after alt or the last char in invalid 
				   file name)
          [SELECTQ (JS BIN 100Q NIL NIL 2)
		   ((1 24)         (* control A or X -
				   try again)
		     (COND
		       (OKFLG (RLJFN JFN)))
		     (PRIN1 "___" T)
		     (GO LOOP))
		   ((17 23 127)    (* control Q W or rubout -
				   abort)
		     (PRIN1 (QUOTE //)
			    T)
		     (COND
		       (OKFLG (PRIN1 (JFNS JFN NIL (CONSTANT (CONCAT)))
				     T)
			      (PRIN1 " " T)
			      (RLJFN JFN))
		       (T (PRIN1 "... ")))
		     (RETURN TCONC))
		   (COND
		     (OKFLG (JS BKJFN 100Q)
			    (GO GOTIT]
          [COND
	    ((NOT BUFFLG)
	      (SETQ BUFFLG T)
	      (SETQ BUFS (CLBUFS NIL T READBUF]
          (PRIN1 (QUOTE " ? file: ")
		 T)
          (DISMISS 100)
          (DOBE)
          (CLEARBUF T)
          (GO LOOP])

(FILESTAT
  [LAMBDA (JFN ALLFLG)             (* lmm "25-OCT-78 03:12")
    (RESETLST (RESETSAVE (RADIX 8))
	      (RESETSAVE (OUTPUT T))
	      (COND
		[JFN (OR (FILESTAT1 JFN ALLFLG)
			 (PROGN (PRIN2 JFN)
				(TAB 4)
				(PRIN1 "NOT ASSIGNED")
				(TERPRI]
		(T (RPTQ 64 (FILESTAT1 RPTN ALLFLG])

(FILESTAT1
  [LAMBDA (JFN OPENONLY)           (* J.Vittal: "12-Jan-79 09:13")
    (PROG (FLG (STS (JS GTSTS JFN 0 NIL 2))
	       STR TEM)
          (COND
	    ((AND (BIT 10 STS)
		  (OR (NOT OPENONLY)
		      (BIT 0 STS)))
                                   (* jfn legal)
	      (COND
		([OR (BIT 17 STS)
		     (SETQ STR (JFNS JFN NIL (CONSTANT (CONCAT]
		  (PRIN2 JFN)
		  (SPACES 1)
		  (TAB 4 T)
		  (COND
		    (STR (PRIN1 STR))
		    (T (PRIN1 "Restricted JFN")))
		  (SPACES 1)
		  (TAB 40 T)
		  [COND
		    [(BIT 0 STS)   (* open)
		      [COND
			((BIT 1 STS)
			  (FSPRINT (QUOTE READ]
		      [COND
			((BIT 2 STS)
			  (COND
			    ((BIT 4 STS)
			      (FSPRINT (QUOTE WRITE)))
			    (T (FSPRINT (QUOTE APPEND]
		      [COND
			((BIT 3 STS)
			  (FSPRINT (QUOTE EXECUTE]
		      (COND
			((BIT 5 STS)
			  (FSPRINT "PAGE-TABLE")))
		      (COND
			([NOT (ZEROP (SETQ TEM (BITS 32 35 STS]
			  (FSPRINT "MODE ")
			  (PRIN2 TEM)))
		      [COND
			((BIT 8 STS)
			  (FSPRINT (QUOTE EOF]
		      (COND
			((BIT 9 STS)
			  (FSPRINT "DATA ERROR")))
		      [COND
			((SETQ TEM (STRPOS ":" STR))
			  (PROG ((DSTS (JS GDSTS JFN 0 0 2)))
			        (SELECTQ (SETQ TEM (MKATOM (SUBSTRING STR 1 TEM STR)))
					 [PUP: [COND
						 ((BIT 4 DSTS)
						   (FSPRINT (QUOTE MARK]
					       [COND
						 ((BIT 5 DSTS)
						   (FSPRINT (QUOTE END]
					       [COND
						 ((BIT 6 DSTS)
						   (FSPRINT (QUOTE TIMEOUT]
					       (COND
						 ((BIT 7 DSTS)
						   (FSPRINT "NO CHECKSUMS")))
					       [COND
						 ((NEQ (BITS 32 35 STS)
						       14)
						   (COND
						     ((NOT (BIT 8 DSTS))
						       (FSPRINT "-R")))
						   (COND
						     ((NOT (BIT 9 DSTS))
						       (FSPRINT "-W"]
					       (COND
						 ((BIT 10 DSTS)
						   (FSPRINT "DISCARD PACKETS")))
					       (FSPRINT (SELECTQ (BITS 32 35 DSTS)
								 (0 "CLOS")
								 (1 "RFCO")
								 (2 "LIST")
								 (3 "OPEN")
								 (4 "ENDI")
								 (5 "ENDO")
								 (6 "DALY")
								 (7 "ABOR")
								 (HELP]
					 [NET: (FSPRINT (SELECTQ (BITS 0 3 DSTS)
								 (0 "DEAD")
								 (1 "CLZD")
								 (2 "PNDG")
								 (3 "LSNG")
								 (4 "RFCR")
								 (6 "RFCS")
								 (7 "OPND")
								 (8 "CLSW")
								 (11 "CLZW")
								 (12 "RFN2")
								 (14 "FREE")
								 (HELP]
					 (LPT:)
					 (TTY:)
					 (HELP TEM]
		      (COND
			((AND (NOT (BIT 17 STS))
			      (NOT (BIT 3 STS)))
			  (RADIX 10)
			  (FSPRINT (JS RFPTR JFN NIL NIL 2))
			  (PRIN1 (COND
				   ((BIT 4 STS)
				     "(")
				   (T "[")))
			  (PRIN2 (JS RFBSZ JFN NIL NIL 2))
			  (PRIN1 (COND
				   ((BIT 4 STS)
				     ")")
				   (T "]")))
			  (RADIX 8]
		    (T (FSPRINT (QUOTE "NOT OPENED"]
		  (TERPRI)))
	      (RETURN JFN])

(FSPRINT
  [LAMBDA (object NoComma NewLine)
                                   (* J.Vittal: "21-Sep-78 11:59")
    (COND
      [FLG (COND
	     ((NOT NoComma)
	       (PRIN1 ", "))
	     (T (PRIN1 " "]
      (T (SETQ FLG T)))
    (COND
      ((OR NewLine (IGREATERP (IPLUS (NCHARS object)
				     (POSITION)
				     4)
			      (LINELENGTH)))
	(TERPRI)
	(SPACES 4)))
    (PRIN1 object])
)
(MOVD (QUOTE USERLISPXPRINT)
      (QUOTE LISPXODATE))
(SETSYNTAX 6 (QUOTE (INFIX FIRST IMMED GTJFNTTY))
	   T)
(SETSYNTAX 6 T EDITRDTBL)

(ADDTOVAR LISPXMACROS (UND (DODIR LISPXLINE (QUOTE (UNDELETE))
				  ""
				  (QUOTE *)))
		      (DEL (DODIR LISPXLINE (QUOTE (DELETE))
				  "" -2))
		      (DELVER (SELECTQ (SYSTEMTYPE)
				       (TOPS20 (DODIR LISPXLINE (QUOTE (TRIMTO 1))
						      (QUOTE *)
						      0 T))
				       (DODIR LISPXLINE (QUOTE (OLDVERSIONS P DELETE))
					      (QUOTE *)
					      -3)))
		      (NDIR (DODIR LISPXLINE (QUOTE (PP COLUMNS 17))
				   (QUOTE *)
				   0)))

(ADDTOVAR LISPXCOMS NDIR)

(ADDTOVAR LISPXHISTORYMACROS (EXP (PROGN (PRIN2 (IDIFFERENCE
						  (PROG1 (JSYS 305Q (SETQ DIRNO
									  (FINDDIRECTORYNUMBER
									    (OR (CAR LISPXLINE)
										T)))
							       NIL NIL 2)
							 (EXPUNGE (CAR LISPXLINE)))
						  (JSYS 305Q DIRNO NIL NIL 2))
						T)
					 (PRIN1 " pages released.
" T)
					 NIL))
	  (DET NIL (DETACH))
	  (QU NIL (LOGOUT))
	  (DA (PROGN (LISPXODATE (IDATE)
				 T)
		     (TERPRI T))))

(ADDTOVAR LISPXMACROS [CONN (CNDIR (CAR LISPXLINE)
				   (AND (LISTP (CDR LISPXLINE))
					(PROG1 (CADR LISPXLINE)
					       (FRPLACA (CDR LISPXLINE]
		      (SY (SYSTAT (CAR LISPXLINE)))
		      (DSK (APPLY (QUOTE DSKSTAT)
				  LISPXLINE))
		      (FI (FILESTAT (CAR LISPXLINE)))
		      (MEM (APPLY (QUOTE MEMSTAT)
				  LISPXLINE))
		      (TY (COPYALLBYTES (CAR LISPXLINE)
					(OR (CADR LISPXLINE)
					    T)
					(CADDR LISPXLINE)))
		      (SEE (COPYALLBYTES (CAR LISPXLINE)
					 (OR (CADR LISPXLINE)
					     T)
					 (CADDR LISPXLINE)))
		      [INFO (SELECTQ (CAR LISPXLINE)
				     ((DSK DISK)
				      (APPLY (QUOTE DSKSTAT)
					     (CDR LISPXLINE)))
				     (FI (FILESTAT (CADR LISPXLINE)))
				     (ERROR (CAR LISPXLINE)
					    (QUOTE ?])

(ADDTOVAR LISPXCOMS CONN SY DSK MEM DA TY SEE INFO)

(RPAQQ TERMINALTYPES ((TOPS20 (8 Default)
			      (9 Ideal)
			      (10 VT05)
			      (11 VT50)
			      (12 LA30)
			      (13 GT40)
			      (14 LA36)
			      (15 VT52))
		      (TENEX (7 NVT)
			     (8 LA30)
			     (9 TI733)
			     (10 display)
			     (11 lineprocessor)
			     (12 OMRON)
			     (13 Ann-Arbor)
			     (14 TI743/745)
			     (16 MCA))
		      (NIL (0 MOD33)
			   (1 MOD35)
			   (2 MOD37)
			   (3 TI))))

(ADDTOVAR LISPXCOMS (CON . CONTIN)
		    (TALK . LINK)
		    (WHE . SY)
		    (LD . SY))

(ADDTOVAR DIRCOMMANDS (AU . AUTHOR)
		      (DEL . DELETE))

(ADDTOVAR OTHERUSERS )
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
	   PASSWORDS)
(DECLARE: DONTCOPY EVAL@COMPILE 
[DECLARE: EVAL@COMPILE 

(RECORD JOBPARAMS (PER TTY JOBNO USERNAME PGMNAME CNDIR))

(RECORD MEMSTAT (PAGE LENGTH SOURCE . ACCESS)
		LENGTH _ 1 SOURCE _ NIL)

(ACCESSFNS SOURCE ((FORK\FILE (LRSH DATUM 18))
		   (SP (LOGAND DATUM 262143))))

(RECORD DSKSTAT (DIR USED OLD OLDVERSIONS DELETED PROTECTED))
]
DONTEVAL@LOAD 
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
	   CJSYS)
)



(* Linking and breaking links functions and macros.)

(DEFINEQ

(BREAKLINKS
  [LAMBDA NIL                      (* lmm "27-SEP-78 05:23")
    (JS TLINK (XWD 620000Q -1)
	777777Q)
    NIL])

(LINKTOTTY
  [LAMBDA (TTY#)                   (* lmm "27-SEP-78 05:27")
                                   (* Tries to link to TTY# from controlling terminal.
				   Returns T if succeeds, NIL if fails.)
    (COND
      ((AND (JS TLINK (XWD 100000Q -1)
		(LOGOR TTY# 400000Q)
		NIL T)
	    (JS TLINK (XWD 40000Q -1)
		(LOGOR TTY# 400000Q)
		NIL T))
	T)
      (T (BREAKLINKS)
	 (printout T "Refused" T)
	 NIL])

(LINKTOUSER
  [LAMBDA (USER)                   (* lmm "27-SEP-78 05:30")

          (* Links the controlling terminal for the current job to a terminal associated with USER. Returns T if the link 
	  actually happened, and nil otherwise.)


    (PROG (JOBS)
          (RETURN (COND
		    ((NUMBERP USER)
		      (LINKTOTTY USER))
		    (T (LINKTOTTY (fetch TTY
				     of (COND
					  ((NULL (SETQ JOBS (for X in (FINDUSER USER)
							       when (NEQ (fetch TTY
									    of (SETQ X (JOBPARAMS
										   X)))
									 -1)
							       collect X)))
					    (PRIN1 "[not logged in]" T)
					    (TERPRI T)
					    (RETURN))
					  [(CDR JOBS)
                                   (* More than one USER's logged in.)
					    (for X in JOBS do (PRINTJOBPARAMS X))
					    (TERPRI T)
					    (ASKUSER NIL NIL "Which TTY? "
						     (for X in JOBS
							collect (LIST (OCTAL (fetch TTY of X))
								      ""
								      (QUOTE CONFIRMFLG)
								      T
								      (QUOTE RETURN)
								      (KWOTE X]
					  (T (CAR JOBS])

(OCTAL
  [LAMBDA (N SCRATCH)              (* lmm " 9-APR-78 00:07")
    (PROG ((J -1)
	   (S (CONSTANT (CONCAT "000000000000")))
	   (M N))
      LP  (RPLSTRING S J (LOGAND M 7))
          (COND
	    ([NOT (ZEROP (SETQ M (LRSH M 3]
	      (SUB1VAR J)
	      (GO LP)))
          (RETURN (COND
		    (SCRATCH (SUBSTRING S J -1 SCRATCH))
		    (T (CONCAT (SUBSTRING S J -1 (CONSTANT (CONCAT])
)

(ADDTOVAR LISPXMACROS (BR (PROGN (PRIN1 "Breaking Links" T)
				 (TERPRI T)
				 (BREAKLINKS)))
		      (LINK (LINKTOUSER (CAR LISPXLINE))))

(ADDTOVAR LISPXCOMS LINK)

(ADDTOVAR LISPXCOMS (TALK . LINK))
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: DSKSTAT DSKSTAT DSKSTAT1 DSKSTAT2 (GLOBALVARS DIRECTORIES))
(BLOCK: SYSTATBLOCK (ENTRIES LINKTOUSER SYSTAT)
	LINKTOTTY FINDUSER SYSTAT JOBPARAMS LINKTOUSER PRINTJOBPARAMS (GLOBALVARS BYTELISPFLG 
										  OTHERUSERS))
(BLOCK: STATSBLOCK (ENTRIES FILESTAT MEMSTAT FORKSTAT TERMSTAT TERMTYPE)
	TERMSTAT TERMTYPE FILESTAT FILESTAT1 FORKSTAT FSPRINT MEMSTAT MEMSTAT1 MSCOMBINE MSPRINT 
	PRINRANGE (LOCALFREEVARS FLG)
	(GLOBALVARS USERFORKS HOSTNAME TERMINALTYPES)
	(NOLINKFNS . T))
]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY (PUTPROPS EXEC COPYRIGHT ("Xerox Corporation" 1982)))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2206 34856 (CNDIR 2218 . 2852) (COPYALLBYTES 2856 . 4036) (EXPUNGE 4040 . 5015) (
MEMSTAT 5019 . 6545) (MEMSTAT1 6549 . 7369) (MSCOMBINE 7373 . 8218) (MSPRINT 8222 . 10084) (ODATE 
10088 . 10225) (TERMSTAT 10229 . 14043) (TERMTYPE 14047 . 14622) (DETACH 14626 . 15029) (TTY# 15033 . 
15144) (DETACHEDP 15148 . 15259) (DSKSTAT 15263 . 17167) (DSKSTAT1 17171 . 20317) (DSKSTAT2 20321 . 
20521) (FINDUSER 20525 . 22182) (FORKSTAT 22186 . 22435) (FORKSTAT1 22439 . 23741) (PRINRANGE 23745 . 
23912) (PRINTUSERNAME 23916 . 24595) (FINDDIRECTORYNUMBER 24599 . 25074) (FINDUSERNUMBER 25078 . 25421
) (SYSTAT 25425 . 25810) (JOBPARAMS 25814 . 27275) (PRINTJOBPARAMS 27279 . 28873) (GTJFNTTY 28877 . 
31157) (FILESTAT 31161 . 31484) (FILESTAT1 31488 . 34437) (FSPRINT 34441 . 34853)) (38091 40299 (
BREAKLINKS 38103 . 38238) (LINKTOTTY 38242 . 38693) (LINKTOUSER 38697 . 39883) (OCTAL 39887 . 40296)))
))
STOP