Artifact 81bda1dc01738165cabe6860c3ba5a94cbc7ce4ca622e746597844774cb21289:

• File psl-1983/emode/directory.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 5195) [annotate] [blame] [check-ins using] [more...]

%
% Directory.SL - File Directory and related file primitives
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        13 July 1982
%
% *** THIS FILE IS TOPS-20 SPECIFIC ***
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(BothTimes (load common jsys useful))

(de find-matching-files (filename include-deleted-files)

  % Return a list describing all files that match the specified filename.  The
  % filename may specify a directory and/or may contain wildcard characters.
  % Each element of the returned list corresponds to one matching file.  The
  % format of each list element is:

  % (file-name			full file name string 
  %  deleted-flag		T or NIL
  %  file-size			integer count of pages in file
  %  write-date			integer representing date/time of last write
  %  read-date			integer representing date/time of last read
  %  )

  (setf filename (fixup-directory-name filename))
  (let (jfn-word jfn file-name deleted-flag file-size write-date read-date)
    (cond
      ((and (stringp filename) (listp (setf jfn-word (ErrorSet
		 (list 'jsys1
		       (if include-deleted-files
			   #.(bits 2 8 11 13 17)
			   #.(bits 2 11 13 17))
		       filename 0 0 (const jsGTJFN)) nil nil))))
	(setf jfn-word (first jfn-word))
	(for*
	   (while (>= jfn-word 0))
	   (do (setf jfn (lowhalfword jfn-word))
	       (setf file-name (MkString 100 (char space)))
	       (jsys1 file-name jfn
		  #.(bits 2 5 8 11 14 35) 0 (const jsJFNS))
	       (setf file-name (recopystringtonull file-name))
	       (setf deleted-flag (jfn-deleted? jfn))
	       (setf file-size (jfn-page-count jfn))
	       (setf write-date (jfn-write-date jfn))
	       (setf read-date (jfn-read-date jfn))
	       )
	   (collect (list
			file-name
			deleted-flag
			file-size
			write-date
			read-date
			))
	   (do (if (FixP (ErrorSet
		(list 'jsys1 jfn-word 0 0 0 (const jsGNJFN))
		NIL NIL)) (setf jfn-word -1)))
	   ))
      )))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% File Functions:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de file-deleted-status (file-name)
  % Return either: EXISTS, DELETED, NIL
  (let ((jfn (ErrorSet (list 'jsys1 #.(bits 2 8 17)
			     file-name 0 0 (const jsGTJFN)) nil nil)
	))
      (cond
	((listp jfn)
	   (setf jfn (car jfn))
	   (prog1 (if (jfn-deleted? jfn) 'deleted 'exists)
                  (jsys0 jfn 0 0 0 (const jsRLJFN))
		  )
	   )
        )))

(de file-delete (file-name)
  (let ((jfn (ErrorSet (list 'jsys1 #.(bits 2 17)
			     file-name 0 0 (const jsGTJFN)) nil nil)
	))
      (cond
	((listp jfn)
	   (setf jfn (car jfn))
	   (jsys0 jfn 0 0 0 (const jsDELF))
	   )
        )))

(de file-undelete (file-name)
  (let ((jfn (ErrorSet (list 'jsys1 #.(bits 2 8 17)
			     file-name 0 0 (const jsGTJFN)) nil nil)
	))
      (cond
	((listp jfn)
	   (setf jfn (car jfn))
	   (jsys0 (xword 1 jfn) #.(bits 3) 0 0 (const jsCHFDB))
           (jsys0 jfn 0 0 0 (const jsRLJFN))
	   )
        )))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% JFN Functions:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de jfn-deleted? (jfn)
  (not (= (LAnd (Jsys4 jfn #.(xword 1 1) 4 0 (const jsGTFDB))
		(bits 3)) 0)))

(de jfn-write-date (jfn)
  (Jsys4 jfn #.(xword 1 8#14) 4 0 (const jsGTFDB)))

(de jfn-read-date (jfn)
  (Jsys4 jfn #.(xword 1 8#15) 4 0 (const jsGTFDB)))

(de jfn-byte-count (jfn)
  (Jsys4 jfn #.(xword 1 8#12) 4 0 (const jsGTFDB)))

(de jfn-page-count (jfn)
  (lowhalfword (Jsys4 jfn #.(xword 1 8#11) 4 0 (const jsGTFDB))))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Auxiliary Functions:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de file-date-to-string (fdate)

  % Convert a file date as returned by find-matching-files to a meaningful
  % string.  Note that 0 is converted to the string "Never".  All returned
  % strings are 18 characters long, right justified.

  (if (= fdate 0)
    "             Never"
    (let ((buf (MkString 30 (char space))))
	(Jsys0 buf fdate 0 0 (const jsODTIM))
	(recopystringtonull buf))))    

(de fixup-directory-name (name)

  % If NAME is an unadorned directory or device name, append wild cards to it
  % so that it will match all files in the specified directory or directories.

  (let ((n (add1 (size name))))
    (cond ((or (= n 0)
	       (= (indx name (- n 1)) (char :))
	       (= (indx name (- n 1)) (char >))
	       )
	   (concat name "*.*.*"))
	  (t name))))

(de fixup-file-name (name)

  % Make the specified file name nice to print.
  % Remove any control characters (especially ^V).

  (for (in ch (String2List name))
       (with the-list)
       (when (GraphicP ch))
       (collect ch the-list)
       (returns (List2String the-list))
       ))

(de trim-filename-to-prefix (s)
  % Remove trailing characters until the string ends with
  % a device or directory prefix.

  (for* (from i (size s) 0 -1)
        (for ch (indx s i) (indx s i))
        (until (or (= ch (char !:)) (= ch (char !>))))
        (returns (sub s 0 i))
        ))