FILES.ob07 3.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200
  1. (*
  2. BSD 2-Clause License
  3. Copyright (c) 2018-2022, Anton Krotov
  4. All rights reserved.
  5. *)
  6. MODULE FILES;
  7. IMPORT UTILS, C := COLLECTIONS;
  8. TYPE
  9. FILE* = POINTER TO RECORD (C.ITEM)
  10. ptr: INTEGER;
  11. buffer: ARRAY 64*1024 OF BYTE;
  12. count: INTEGER
  13. END;
  14. VAR
  15. files: C.COLLECTION;
  16. PROCEDURE copy (src: ARRAY OF BYTE; src_idx: INTEGER; VAR dst: ARRAY OF BYTE; dst_idx: INTEGER; bytes: INTEGER);
  17. BEGIN
  18. WHILE bytes > 0 DO
  19. dst[dst_idx] := src[src_idx];
  20. INC(dst_idx);
  21. INC(src_idx);
  22. DEC(bytes)
  23. END
  24. END copy;
  25. PROCEDURE flush (file: FILE): INTEGER;
  26. VAR
  27. res: INTEGER;
  28. BEGIN
  29. IF file # NIL THEN
  30. res := UTILS.FileWrite(file.ptr, file.buffer, file.count);
  31. IF res < 0 THEN
  32. res := 0
  33. END
  34. ELSE
  35. res := 0
  36. END
  37. RETURN res
  38. END flush;
  39. PROCEDURE NewFile (): FILE;
  40. VAR
  41. file: FILE;
  42. citem: C.ITEM;
  43. BEGIN
  44. citem := C.pop(files);
  45. IF citem = NIL THEN
  46. NEW(file)
  47. ELSE
  48. file := citem(FILE)
  49. END
  50. RETURN file
  51. END NewFile;
  52. PROCEDURE create* (name: ARRAY OF CHAR): FILE;
  53. VAR
  54. file: FILE;
  55. ptr: INTEGER;
  56. BEGIN
  57. ptr := UTILS.FileCreate(name);
  58. IF ptr > 0 THEN
  59. file := NewFile();
  60. file.ptr := ptr;
  61. file.count := 0
  62. ELSE
  63. file := NIL
  64. END
  65. RETURN file
  66. END create;
  67. PROCEDURE open* (name: ARRAY OF CHAR): FILE;
  68. VAR
  69. file: FILE;
  70. ptr: INTEGER;
  71. BEGIN
  72. ptr := UTILS.FileOpen(name);
  73. IF ptr > 0 THEN
  74. file := NewFile();
  75. file.ptr := ptr;
  76. file.count := -1
  77. ELSE
  78. file := NIL
  79. END
  80. RETURN file
  81. END open;
  82. PROCEDURE close* (VAR file: FILE);
  83. VAR
  84. n: INTEGER;
  85. BEGIN
  86. IF file # NIL THEN
  87. IF file.count > 0 THEN
  88. n := flush(file)
  89. END;
  90. file.count := -1;
  91. UTILS.FileClose(file.ptr);
  92. file.ptr := 0;
  93. C.push(files, file);
  94. file := NIL
  95. END
  96. END close;
  97. PROCEDURE read* (file: FILE; VAR chunk: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
  98. VAR
  99. res: INTEGER;
  100. BEGIN
  101. IF file # NIL THEN
  102. res := UTILS.FileRead(file.ptr, chunk, MAX(MIN(bytes, LEN(chunk)), 0));
  103. IF res < 0 THEN
  104. res := 0
  105. END
  106. ELSE
  107. res := 0
  108. END
  109. RETURN res
  110. END read;
  111. PROCEDURE write* (file: FILE; chunk: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
  112. VAR
  113. free, n, idx: INTEGER;
  114. BEGIN
  115. idx := 0;
  116. IF (file # NIL) & (file.count >= 0) THEN
  117. free := LEN(file.buffer) - file.count;
  118. WHILE bytes > 0 DO
  119. n := MIN(free, bytes);
  120. copy(chunk, idx, file.buffer, file.count, n);
  121. DEC(free, n);
  122. DEC(bytes, n);
  123. INC(idx, n);
  124. INC(file.count, n);
  125. IF free = 0 THEN
  126. IF flush(file) # LEN(file.buffer) THEN
  127. bytes := 0;
  128. DEC(idx, n)
  129. ELSE
  130. file.count := 0;
  131. free := LEN(file.buffer)
  132. END
  133. END
  134. END
  135. END
  136. RETURN idx
  137. END write;
  138. PROCEDURE WriteByte* (file: FILE; byte: BYTE): BOOLEAN;
  139. VAR
  140. arr: ARRAY 1 OF BYTE;
  141. BEGIN
  142. arr[0] := byte
  143. RETURN write(file, arr, 1) = 1
  144. END WriteByte;
  145. BEGIN
  146. files := C.create()
  147. END FILES.