file-support.sl 2.6 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %
  3. % File-Support.SL - System-Dependent Support for File Primitives (TOPS-20)
  4. %
  5. % Author: Alan Snyder
  6. % Hewlett-Packard/CRC
  7. % Date: 16 September 1982
  8. %
  9. % This file contains support functions used in the implementation of file
  10. % primitives for TOPS-20. The existence of the functions in this file should
  11. % be ignored when writing system-independent code.
  12. %
  13. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  14. (BothTimes (load jsys common pathnames))
  15. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  16. % JFN Functions:
  17. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  18. (de jfn-truename (jfn)
  19. (let ((file-name (make-string 200 #\space)))
  20. (jsys1 file-name jfn #.(bits 2 5 8 11 14 35) 0 (const jsJFNS))
  21. (recopystringtonull file-name)
  22. ))
  23. (de jfn-deleted? (jfn)
  24. (if (integerp jfn)
  25. (not (= (LAnd (Jsys4 jfn #.(xword 1 1) 4 0 (const jsGTFDB))
  26. (bits 3)) 0))))
  27. (de jfn-write-date (jfn)
  28. (if (integerp jfn)
  29. (Jsys4 jfn #.(xword 1 8#14) 4 0 (const jsGTFDB))))
  30. (de jfn-read-date (jfn)
  31. (if (integerp jfn)
  32. (Jsys4 jfn #.(xword 1 8#15) 4 0 (const jsGTFDB))))
  33. (de jfn-byte-count (jfn)
  34. (if (integerp jfn)
  35. (Jsys4 jfn #.(xword 1 8#12) 4 0 (const jsGTFDB))))
  36. (de jfn-page-count (jfn)
  37. (if (integerp jfn)
  38. (lowhalfword (Jsys4 jfn #.(xword 1 8#11) 4 0 (const jsGTFDB)))))
  39. (de jfn-original-author (jfn)
  40. (if (integerp jfn)
  41. (let ((str (make-string 100 0)))
  42. (Jsys0 (xword 0 jfn) str 0 0 (const jsGFUST))
  43. (recopystringtonull str)
  44. )))
  45. (de jfn-author (jfn)
  46. (if (integerp jfn)
  47. (let ((str (make-string 100 0)))
  48. (Jsys0 (xword 1 jfn) str 0 0 (const jsGFUST))
  49. (recopystringtonull str)
  50. )))
  51. (de jfn-delete (jfn)
  52. (if (integerp jfn)
  53. (jsys0 jfn 0 0 0 (const jsDELF))
  54. ))
  55. (de jfn-delete-and-expunge (jfn)
  56. (if (integerp jfn)
  57. (jsys0 (xword 2#010000000000000000 jfn) 0 0 0 (const jsDELF))
  58. ))
  59. (de jfn-undelete (jfn)
  60. (if (integerp jfn)
  61. (jsys0 (xword 1 jfn) #.(bits 3) 0 0 (const jsCHFDB))
  62. ))
  63. (de jfn-release (jfn)
  64. (if (integerp jfn)
  65. (jsys0 jfn 0 0 0 (const jsRLJFN))
  66. ))
  67. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  68. % GTJFN Functions:
  69. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  70. (de attempt-to-get-jfn (file-name the-bits)
  71. (setf file-name (namestring file-name))
  72. (let ((jfn (ErrorSet
  73. (list 'jsys1 the-bits file-name 0 0 (const jsGTJFN)) nil nil)
  74. ))
  75. (cond
  76. ((listp jfn) (car jfn))
  77. )))