3
;;; Compiler declarations. IOTA is a function for binding I/O
4
;;; streams. See documentation in MC:LIBDOC;IOTA >
6
(EVAL-WHEN (EVAL COMPILE)
7
(COND ((NOT (STATUS FEATURE IOTA))
8
(LOAD '((DSK LIBLSP) IOTA FASL)))))
10
;;; More compiler stuff. Macsyma builtins.
12
(DECLARE (*EXPR STRIPDOLLAR))
14
;;; These two MACRO's are just for CONS'ing up silly Macsyma structure
16
;; (MLIST-SIMP <thing1> <thing2> ...)
17
;; returns ((MLIST SIMP) <thing1> <thing2> ...)
19
(DEFUN MLIST-SIMP MACRO (X)
20
`(CONS '(MLIST SIMP) (LIST . ,(CDR X))))
22
;; (MTIMES-BLOCKS <n>)
23
;; returns ((MTIMES SIMP) <n> $BLOCKS) which will display as
24
;; "<n> BLOCKS" when Macsyma's display routines are run.
26
(DEFUN MTIMES-BLOCKS MACRO (X)
27
`(LIST '(MTIMES SIMP) ,(CADR X) '$BLOCKS))
29
;;; Returns info about the total number of blocks free in the system.
30
;;; expects an arg of an already open file object which is open to
31
;;; a file directory (file with name .FILE. (DIR) on any directory.)
33
(DEFUN STATUS-GLOBAL-DSKUSE (STREAM)
35
(DO ((C (TYI STREAM) (TYI STREAM))
37
((= C 13.) (LIST* '(MLIST SIMP) '|&TOTAL FREE BLOCKS| (NREVERSE L)))
39
(PUSH (APPEND '((MLIST SIMP))
42
(LIST '|&SECONDARY PACK|
45
(LIST '|&PRIMARY PACK|
47
(STATUS-DSKUSE\AUX STREAM 61.))
50
(STATUS-DSKUSE\AUX STREAM 32.)
55
;;; This function TYI's from STREAM until a character whose fixnum
56
;;; value is TERM is seen (eats the TERM character, too).
57
;;; Returns the readlisted form of the characters seen before TERM.
59
(DEFUN STATUS-DSKUSE\AUX (STREAM TERM)
60
(DO ((C (TYI STREAM) (TYI STREAM))
63
(LET ((BASE 10.)) (READLIST (NREVERSE L))))))
65
;;; STATUS-USER-DSKUSE
66
;;; Returns info about a user's disk use. The file object corresponding
67
;;; to the user's file directory must already be open and the first two
68
;;; lines should already have been READLINE'd.
69
;;; NAME= STRIPDOLLAR'd name
70
;;; USERNAME= Un-STRIPDOLLAR'd name
71
;;; DIRNAME= Un-STRIPDOLLAR'd dirname
72
;;; ALL-FLAG= a flag which if non-null means count all files in the
73
;;; directory - if NIL means just to count files with FN1 the
75
;;; STREAM= a file object open to the directory
77
(DEFUN STATUS-USER-DSKUSE (NAME USERNAME DIRNAME ALL-FLAG STREAM)
78
(DO ((C (PROGN (TYI STREAM) (TYI STREAM))
79
(PROGN (TYI STREAM) (TYI STREAM)))
80
(DIR-PRIMARY-DSKUSE 0.)
81
(DIR-SECONDARY-DSKUSE 0.)
82
(USR-PRIMARY-DSKUSE 0.)
83
(USR-SECONDARY-DSKUSE 0.))
85
(LIST* (MLIST-SIMP '|&DIRECTORY BLOCK USAGE|
90
(MLIST-SIMP '&SECONDARY
92
DIR-SECONDARY-DSKUSE)))
95
(MLIST-SIMP '|&USER BLOCK USAGE|
103
USR-SECONDARY-DSKUSE))))))))
104
(TYI STREAM) ; TYI second space
105
(LET ((SPEC (READLIST (DELETE 32.
106
(LIST (TYI STREAM) (TYI STREAM)
107
(TYI STREAM) (TYI STREAM))))))
108
(COND ((NOT (NUMBERP SPEC))
113
(SETQ USR-SECONDARY-DSKUSE
114
(+ USR-SECONDARY-DSKUSE (CAR V)))
115
(SETQ DIR-SECONDARY-DSKUSE
116
(+ DIR-SECONDARY-DSKUSE (CDR V))))
117
(STATUS-USER-DSKUSE\PARSE-LINE STREAM
122
(SETQ USR-PRIMARY-DSKUSE
123
(+ USR-PRIMARY-DSKUSE (CAR V)))
124
(SETQ DIR-PRIMARY-DSKUSE
125
(+ DIR-PRIMARY-DSKUSE (CDR V))))
126
(STATUS-USER-DSKUSE\PARSE-LINE STREAM
130
;;; STATUS-USER-DSKUSE\PARSE-LINE
131
;;; Reads an individual line from the dir and returns a CONS whose
132
;;; CAR is user use and CDR is directory use by the file in question.
133
;;; (Links count as 0).
135
;;; STREAM= the file directory file object already opened and in position
136
;;; ALL= flag saying whether or not to count files that don't have an FN1
137
;;; the same as the value of NAME
138
;;; NAME = a value to compare the FN1 to if ALL is non-NIL.
140
(DEFUN STATUS-USER-DSKUSE\PARSE-LINE (STREAM ALL NAME)
141
(LET ((FN1 (STATUS-USER-DSKUSE\PARSE-LINE\AUX STREAM))
142
(SIZE (PROG2 (STATUS-USER-DSKUSE\PARSE-LINE\AUX STREAM)
143
(LET ((IBASE 10.)) (READ STREAM))
145
(COND ((OR ALL (EQ FN1 NAME))
150
;;; STATUS-USER-DSKUSE\PARSE-LINE\AUX
151
;;; Reads 7 characters from STREAM, but only looks at first 6.
152
;;; Implodes all 6 except for trailing spaces and returns as a symbol.
154
;;; STREAM= file object being read from.
156
(DEFUN STATUS-USER-DSKUSE\PARSE-LINE\AUX (STREAM)
157
(DO ((C (TYI STREAM) (TYI STREAM))
162
((NOT (= (CAR L) 32.)) (IMPLODE (NREVERSE L)))))))
170
;;; which will default to the user's name, or
172
;;; FULLDISKUSE(<name>);
174
;;; <name> will not be evaluted.
178
;;; [[TOTAL FREE BLOCKS, [<pack-type>, <pack-number>, <n> BLOCKS],
179
;;; [<pack-type>, <pack-number>, <n> BLOCKS], ...]
180
;;; [DIRECTORY BLOCK USAGE, <directory-name>
181
;;; [PRIMARY, <n> BLOCKS],
182
;;; [SECONDARY, <n> BLOCKS]]
183
;;; [USER BLOCK USAGE, <user-name>,
184
;;; [PRIMARY, <n> BLOCKS],
185
;;; [SECONDARY, <n> BLOCKS]]]
187
;;; If the user has his own directory, the last element of the list
188
;;; (USER BLOCK USAGE) is omitted since it would be the same as
189
;;; DIRECTORY BLOCK USAGE.
191
;;; <pack-type> ::= "PRIMARY PACK" or "SECONDARY PACK"
192
;;; <pack-number> ::= a fixnum
195
;;; Occurances of `<n> BLOCKS' are in the form of a Macsyma
196
;;; multiplication between a fixnum <n> and the Macsyma symbol BLOCKS.
199
(DEFUN $FULLDISKUSE FEXPR (SPECS)
200
(DECLARE (SPECIAL NAME))
201
(LET* ((USERNAME (COND ((ATOM SPECS)
202
(IMPLODE (CONS '$ (EXPLODEC (STATUS USERID)))))
205
(NAME (STRIPDOLLAR USERNAME))
206
(DIR (COND ((ATOM SPECS) (STATUS HSNAME))
207
(T (STATUS HSNAME NAME))))
208
(DIRNAME (IMPLODE (CONS '$ (EXPLODEC DIR))))
209
(ALL (COND ((EQ NAME DIR) T) (T ()))))
210
(IOTA ((STREAM `((DSK ,DIR) |.FILE.| |(DIR)|) '(IN ASCII)))
212
(STATUS-GLOBAL-DSKUSE STREAM)
213
(STATUS-USER-DSKUSE NAME USERNAME
214
DIRNAME ALL STREAM)))))
217
;;; Takes args just like FULLDISKUSE.
218
;;; Prints in English nicely formatted the disk use for a user.
220
(DEFUN $PRINTDISKUSE FEXPR (X)
221
(LET ((USAGE (APPLY '$FULLDISKUSE X))
229
(COND ((EQ (CADR X) '|&PRIMARY PACK|)
231
(+ PRIMARY (CADR (CADDDR X)))))
234
(+ SECONDARY (CADR (CADDDR X))))))))
236
(PRINC (+ PRIMARY SECONDARY) TYO)
237
(PRINC '| Total Free Disk Blocks: | TYO)
241
(PRINC '| on Primary Pack and | TYO)
242
(PRINC SECONDARY TYO)
243
(PRINC '| on Secondary Pack.| TYO)
245
(LET ((DIRUSE (CDR (CADDR USAGE)))
246
(USRUSE (CDR (CADDDR USAGE))))
247
(PRINC '|Directory use by the | TYO)
248
(PRINC (STRIPDOLLAR (CADR DIRUSE)) TYO)
249
(PRINC '| directory:| TYO)
252
(PRINC (CADR (CADDR (CADDR DIRUSE))) TYO)
253
(PRINC '| blocks on Primary Pack and | TYO)
254
(PRINC (CADR (CADDR (CADDDR DIRUSE))) TYO)
255
(PRINC '| blocks on Secondary Pack.| TYO)
258
(PRINC '|Usage by | TYO)
259
(PRINC (STRIPDOLLAR (CADR USRUSE)) TYO)
263
(PRINC (CADR (CADDR (CADDR USRUSE))) TYO)
264
(PRINC '| blocks on Primary Pack and | TYO)
265
(PRINC (CADR (CADDR (CADDDR USRUSE))) TYO)
266
(PRINC '| blocks on Secondary Pack.| TYO)
271
;;; DISKFREE(TRUE); or just DISKFREE(); returns total free blocks on
273
;;; DISKFREE(PRIMARY); returns blocks free on primary pack.
274
;;; DISKFREE(SECONDARY); returns blocks free on secondary pack.
275
;;; DISKFREE(<n>); returns the free blocks on pack <n>
276
;;; return value is a fixnum times the symbol blocks.
278
(DEFUN $DISKFREE FEXPR (X)
279
(COND ((> (LENGTH X) 1.)
281
(PRINC '|;Too many args given to DISKFREE.| TYO)
283
(SETQ X (OR (CAR X) '$TRUE))
284
(COND ((NOT (MEMBER X '($TRUE $PRIMARY $SECONDARY 0. 1. 13.)))
286
(PRINC '|;Illegal arg to DISKFREE| TYO)
288
(PRINC '|;Valid args are 0, 1, 13, TRUE, PRIMARY, SECONDARY.|
291
(IOTA ((STREAM '|DSK:USERS;.FILE. (DIR)| 'IN))
293
(DO ((C (TYI STREAM) (TYI STREAM))
295
((= C 13.) (MTIMES-BLOCKS DSKUSE))
297
(LET ((PACK (STATUS-DSKUSE\AUX STREAM 61.))
298
(AMOUNT (STATUS-DSKUSE\AUX STREAM 32.)))
299
(COND ((OR (AND (MEMQ X '($PRIMARY $TRUE))
301
(AND (MEMQ X '($SECONDARY $TRUE))
304
(SETQ DSKUSE (+ DSKUSE AMOUNT))))))))))
307
;;; Returns the amount of disk space a user is taking up (in blocks)
308
;;; as a fixnum times the symbol BLOCKS. Takes args like FULLDISKUSE.
310
(DEFUN $DISKUSE FEXPR (X)
313
(MAPCAR (FUNCTION (LAMBDA (X) (CADR (CADDR X))))
315
(CDDDR (OR (CADDDR INFO)
317
(APPLY '$FULLDISKUSE X))))))
added
removed
share/utils/dskuse.lisp
