WINFIO.LST 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414
  1. Listing:
  2. 1 (* Release 3.10 *)
  3. 2 (*-------------------------------------------------------------------------*
  4. 3 * *
  5. 4 * WINFIO.MOD - File i/o with far interface for Windows *
  6. 5 * *
  7. 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. *
  8. 7 * All Rights Reserved *
  9. 8 * *
  10. 9 *--------------------------------------------------------------------------*)
  11. 10
  12. 11 (*# call(seg_name => null) *)
  13. 12 (*# module(implementation=>off) *)
  14. 13 (*# data(seg_name => null, near_ptr=>off) *)
  15. 14 (*# call(o_a_copy => off, ds_eq_ss=>off, near_call=>off) *)
  16. 15 (*# check(stack=>off,
  17. 16 index=>off,
  18. 17 range=>off,
  19. 18 overflow=>off,
  20. 19 nil_ptr=>off) *)
  21. 20
  22. 21
  23. 22 IMPLEMENTATION MODULE WinFIO;
  24. 23
  25. 24 IMPORT Lib, SYSTEM, CoreIO, CoreFile, CoreSig, CoreMain, Windows;
  26. 25
  27. 26 VAR
  28. 27 (* CoreFile.BufInf : ARRAY[0..MaxHandle] OF FileInf; *) (* NB in CoreFile *)
  29. 28 IOR: CARDINAL;
  30. 29
  31. 30 TYPE
  32. 31 Str80 = ARRAY[0..79] OF CHAR;
  33. ***** ^ not supported yet
  34. ***** ^ not supported yet
  35. 32 PathStr = ARRAY [0..128] OF CHAR;
  36. ***** ^ not supported yet
  37. ***** ^ not supported yet
  38. 33
  39. 34
  40. 35 PROCEDURE ErrorCheck(Code: CARDINAL; ErrNum: CARDINAL; Msg, Name: ARRAY OF CHAR);
  41. ***** ^ not supported yet
  42. 36
  43. 37 VAR
  44. 38 ErrMsg: ARRAY [0..119] OF CHAR;
  45. ***** ^ not supported yet
  46. ***** ^ not supported yet
  47. 39 NumStr: ARRAY [0..19] OF CHAR;
  48. ***** ^ not supported yet
  49. ***** ^ not supported yet
  50. 40 OK: BOOLEAN;
  51. 41 BEGIN
  52. 42 IF ErrNum = 0 THEN
  53. 43 ErrNum := Lib.SysErrno();
  54. ***** ^ not supported yet
  55. ***** ^ not supported yet
  56. ***** ^ not supported yet
  57. 44 END;
  58. 45 IF IOcheck THEN
  59. ***** ^ undeclared identifier
  60. 46 Str.Copy(ErrMsg, Msg);
  61. ***** ^ undeclared identifier
  62. ***** ^ not supported yet
  63. ***** ^ not supported yet
  64. ***** ^ not supported yet
  65. 47 Str.Append(ErrMsg, Name);
  66. ***** ^ undeclared identifier
  67. ***** ^ not supported yet
  68. ***** ^ not supported yet
  69. ***** ^ not supported yet
  70. 48 Str.Append(ErrMsg, '. Dos Error Code ');
  71. ***** ^ undeclared identifier
  72. ***** ^ not supported yet
  73. ***** ^ not supported yet
  74. ***** ^ not supported yet
  75. 49 Str.CardToStr(LONGCARD(ErrNum), NumStr, 10, OK);
  76. ***** ^ undeclared identifier
  77. ***** ^ not supported yet
  78. ***** ^ undeclared identifier
  79. ***** ^ not supported yet
  80. ***** ^ not supported yet
  81. ***** ^ not supported yet
  82. 50 Str.Append(ErrMsg, NumStr);
  83. ***** ^ undeclared identifier
  84. ***** ^ not supported yet
  85. ***** ^ not supported yet
  86. ***** ^ not supported yet
  87. 51 (* Lib.WrDosError(SHORTCARD(ErrNum)); *)
  88. 52 Lib.RunTimeError(CoreSig._FatalErrorPos(), Code+0A0H, ErrMsg);
  89. ***** ^ not supported yet
  90. ***** ^ not supported yet
  91. ***** ^ not supported yet
  92. ***** ^ not supported yet
  93. ***** ^ not supported yet
  94. ***** ^ not supported yet
  95. 53 END;
  96. 54 IOR := ErrNum;
  97. 55 END ErrorCheck;
  98. ***** ^ not supported yet
  99. 56
  100. 57 PROCEDURE IOresult () : CARDINAL;
  101. 58 BEGIN
  102. 59 RETURN IOR;
  103. 60 END IOresult;
  104. ***** ^ not supported yet
  105. 61
  106. 62
  107. 63 PROCEDURE WrBin(F: File; Buf: ARRAY OF BYTE; Count: CARDINAL);
  108. ***** ^ undeclared identifier
  109. ***** ^ undeclared identifier
  110. 64
  111. 65 VAR
  112. 66 NumWrit : CARDINAL;
  113. 67 BEGIN
  114. 68 IOR := 0;
  115. 69 OK := TRUE;
  116. ***** ^ undeclared identifier
  117. 70 IF Count = 0 THEN RETURN END;
  118. 71 NumWrit := Windows._lwrite(F, Buf, Count);
  119. ***** ^ not supported yet
  120. ***** ^ not supported yet
  121. ***** ^ not supported yet
  122. ***** ^ not supported yet
  123. ***** ^ not supported yet
  124. 72 IF NumWrit # Count THEN
  125. 73 ErrorCheck(6, 0, 'WrBin : ', Lib.NilStr);
  126. ***** ^ not supported yet
  127. ***** ^ not supported yet
  128. ***** ^ not supported yet
  129. ***** ^ not supported yet
  130. 74 OK := FALSE;
  131. ***** ^ undeclared identifier
  132. 75 END;
  133. 76 END WrBin;
  134. ***** ^ not supported yet
  135. 77
  136. 78 PROCEDURE RdBin(F: File; VAR Buf: ARRAY OF BYTE; Count: CARDINAL) : CARDINAL;
  137. ***** ^ undeclared identifier
  138. ***** ^ undeclared identifier
  139. 79 VAR
  140. 80 NumRead: CARDINAL;
  141. 81 BEGIN
  142. 82 IOR := 0;
  143. 83 OK := TRUE;
  144. ***** ^ undeclared identifier
  145. 84 EOF := FALSE;
  146. ***** ^ undeclared identifier
  147. 85 IF Count = 0 THEN RETURN 0 END;
  148. 86 NumRead := Windows._lread(F, Buf, Count);
  149. ***** ^ not supported yet
  150. ***** ^ not supported yet
  151. ***** ^ not supported yet
  152. ***** ^ not supported yet
  153. ***** ^ not supported yet
  154. 87 IF NumRead # Count THEN
  155. 88 OK := FALSE;
  156. ***** ^ undeclared identifier
  157. 89 IF NumRead < 0 THEN
  158. 90 ErrorCheck(7, 0, 'RbBin : ', Lib.NilStr);
  159. ***** ^ not supported yet
  160. ***** ^ not supported yet
  161. ***** ^ not supported yet
  162. ***** ^ not supported yet
  163. 91 ELSE
  164. 92 EOF := TRUE;
  165. ***** ^ undeclared identifier
  166. 93 END;
  167. 94 END;
  168. 95 RETURN NumRead;
  169. 96 END RdBin;
  170. ***** ^ not supported yet
  171. 97
  172. 98
  173. 99 PROCEDURE GetName(name: ARRAY OF CHAR; VAR fn: PathStr);
  174. ***** ^ not supported yet
  175. 100 (* Makes Null terminated filename, also sets IOR to 0 *)
  176. 101 BEGIN
  177. 102 Str.Copy(fn,name);
  178. ***** ^ undeclared identifier
  179. ***** ^ not supported yet
  180. ***** ^ not supported yet
  181. ***** ^ not supported yet
  182. 103 fn[HIGH(fn)] := CHR(0);
  183. ***** ^ not supported yet
  184. ***** ^ undeclared identifier
  185. ***** ^ not supported yet
  186. ***** ^ undeclared identifier
  187. ***** ^ not supported yet
  188. 104 IOR := 0;
  189. 105 END GetName;
  190. ***** ^ not supported yet
  191. 106
  192. 107 PROCEDURE Open(Name: ARRAY OF CHAR) : File;
  193. ***** ^ not supported yet
  194. ***** ^ undeclared identifier
  195. 108 VAR
  196. 109 fn: PathStr;
  197. ***** ^ not supported yet
  198. 110 H: File;
  199. ***** ^ undeclared identifier
  200. 111 BEGIN
  201. 112 GetName(Name,fn);
  202. ***** ^ not supported yet
  203. ***** ^ not supported yet
  204. ***** ^ not supported yet
  205. 113 H := Windows._lopen(fn, Windows.READ_WRITE + INTEGER(ShareMode));
  206. ***** ^ not supported yet
  207. ***** ^ not supported yet
  208. ***** ^ not supported yet
  209. ***** ^ not supported yet
  210. ***** ^ not supported yet
  211. ***** ^ not supported yet
  212. ***** ^ undeclared identifier
  213. 114 IF H <> MAX(CARDINAL) THEN
  214. ***** ^ not supported yet
  215. ***** ^ undeclared identifier
  216. ***** ^ not supported yet
  217. 115 CoreFile._openfd[H] := (CoreIO.O_RDWR+CoreIO.O_BINARY);
  218. ***** ^ not supported yet
  219. ***** ^ not supported yet
  220. ***** ^ not supported yet
  221. ***** ^ not supported yet
  222. ***** ^ not supported yet
  223. ***** ^ not supported yet
  224. ***** ^ not supported yet
  225. 116 IF CoreIO.isatty(H) # 0 THEN
  226. ***** ^ not supported yet
  227. ***** ^ not supported yet
  228. ***** ^ not supported yet
  229. 117 CoreFile._openfd[H] := CoreFile._openfd[H] + CoreIO.O_DEVICE;
  230. ***** ^ not supported yet
  231. ***** ^ not supported yet
  232. ***** ^ not supported yet
  233. ***** ^ not supported yet
  234. ***** ^ not supported yet
  235. ***** ^ not supported yet
  236. ***** ^ not supported yet
  237. ***** ^ not supported yet
  238. 118 END;
  239. 119 ELSE
  240. 120 ErrorCheck(2, 0, 'Open : ', fn);
  241. ***** ^ not supported yet
  242. ***** ^ not supported yet
  243. ***** ^ not supported yet
  244. 121 END;
  245. 122 RETURN H;
  246. ***** ^ not supported yet
  247. 123 END Open;
  248. ***** ^ not supported yet
  249. 124
  250. 125 PROCEDURE OpenRead( Name: ARRAY OF CHAR) : File;
  251. ***** ^ not supported yet
  252. ***** ^ undeclared identifier
  253. 126 VAR
  254. 127 fn: PathStr;
  255. ***** ^ not supported yet
  256. 128 H: File;
  257. ***** ^ undeclared identifier
  258. 129 BEGIN
  259. 130 GetName(Name,fn);
  260. ***** ^ not supported yet
  261. ***** ^ not supported yet
  262. ***** ^ not supported yet
  263. 131 H := Windows._lopen(fn, Windows.READ + INTEGER(ShareMode));
  264. ***** ^ not supported yet
  265. ***** ^ not supported yet
  266. ***** ^ not supported yet
  267. ***** ^ not supported yet
  268. ***** ^ not supported yet
  269. ***** ^ not supported yet
  270. ***** ^ undeclared identifier
  271. 132 IF H <> MAX(CARDINAL) THEN
  272. ***** ^ not supported yet
  273. ***** ^ undeclared identifier
  274. ***** ^ not supported yet
  275. 133 CoreFile._openfd[H] := (CoreIO.O_RDONLY+CoreIO.O_BINARY);
  276. ***** ^ not supported yet
  277. ***** ^ not supported yet
  278. ***** ^ not supported yet
  279. ***** ^ not supported yet
  280. ***** ^ not supported yet
  281. ***** ^ not supported yet
  282. ***** ^ not supported yet
  283. 134 IF CoreIO.isatty(H) # 0 THEN
  284. ***** ^ not supported yet
  285. ***** ^ not supported yet
  286. ***** ^ not supported yet
  287. 135 CoreFile._openfd[H] := CoreFile._openfd[H] + CoreIO.O_DEVICE;
  288. ***** ^ not supported yet
  289. ***** ^ not supported yet
  290. ***** ^ not supported yet
  291. ***** ^ not supported yet
  292. ***** ^ not supported yet
  293. ***** ^ not supported yet
  294. ***** ^ not supported yet
  295. ***** ^ not supported yet
  296. 136 END;
  297. 137 ELSE
  298. 138 ErrorCheck(3, 0, 'OpenRead : ', fn);
  299. ***** ^ not supported yet
  300. ***** ^ not supported yet
  301. ***** ^ not supported yet
  302. 139 END;
  303. 140 RETURN H;
  304. ***** ^ not supported yet
  305. 141 END OpenRead;
  306. ***** ^ not supported yet
  307. 142
  308. 143 PROCEDURE Exists(Name: ARRAY OF CHAR) : BOOLEAN;
  309. ***** ^ not supported yet
  310. 144 VAR
  311. 145 fn : PathStr ;
  312. ***** ^ not supported yet
  313. 146 BEGIN
  314. 147 GetName(Name,fn);
  315. ***** ^ not supported yet
  316. ***** ^ not supported yet
  317. ***** ^ not supported yet
  318. 148 IF CoreIO._exists(fn) # 0 THEN
  319. ***** ^ not supported yet
  320. ***** ^ not supported yet
  321. ***** ^ not supported yet
  322. 149 RETURN TRUE;
  323. 150 END;
  324. 151 RETURN FALSE;
  325. 152 END Exists;
  326. ***** ^ not supported yet
  327. 153
  328. 154 PROCEDURE Create(Name: ARRAY OF CHAR) : File;
  329. ***** ^ not supported yet
  330. ***** ^ undeclared identifier
  331. 155 VAR
  332. 156 fn: PathStr;
  333. ***** ^ not supported yet
  334. 157 H: File;
  335. ***** ^ undeclared identifier
  336. 158 BEGIN
  337. 159 GetName(Name,fn);
  338. ***** ^ not supported yet
  339. ***** ^ not supported yet
  340. ***** ^ not supported yet
  341. 160 H := Windows._lcreat(fn, 0);
  342. ***** ^ not supported yet
  343. ***** ^ not supported yet
  344. ***** ^ not supported yet
  345. ***** ^ not supported yet
  346. ***** ^ not supported yet
  347. 161 IF H <> MAX(CARDINAL) THEN
  348. ***** ^ not supported yet
  349. ***** ^ undeclared identifier
  350. ***** ^ not supported yet
  351. 162 CoreFile._openfd[H] := (CoreIO.O_RDWR+CoreIO.O_BINARY);
  352. ***** ^ not supported yet
  353. ***** ^ not supported yet
  354. ***** ^ not supported yet
  355. ***** ^ not supported yet
  356. ***** ^ not supported yet
  357. ***** ^ not supported yet
  358. ***** ^ not supported yet
  359. 163 ELSE
  360. 164 ErrorCheck(5, 0, 'Create : ', Name);
  361. ***** ^ not supported yet
  362. ***** ^ not supported yet
  363. ***** ^ not supported yet
  364. 165 END;
  365. 166 RETURN H;
  366. ***** ^ not supported yet
  367. 167 END Create;
  368. ***** ^ not supported yet
  369. 168
  370. 169 PROCEDURE Close(F: File);
  371. ***** ^ undeclared identifier
  372. 170 BEGIN
  373. 171 IOR := 0;
  374. 172 IF F < CoreFile._open_max THEN
  375. ***** ^ not supported yet
  376. ***** ^ not supported yet
  377. ***** ^ not supported yet
  378. 173 CoreFile._openfd[F] := {};
  379. ***** ^ not supported yet
  380. ***** ^ not supported yet
  381. ***** ^ not supported yet
  382. ***** ^ not supported yet
  383. 174 END;
  384. 175 IF Windows._lclose(F) = -1 THEN
  385. ***** ^ not supported yet
  386. ***** ^ not supported yet
  387. ***** ^ not supported yet
  388. 176 ErrorCheck(0, 0, 'Close : ', Lib.NilStr);
  389. ***** ^ not supported yet
  390. ***** ^ not supported yet
  391. ***** ^ not supported yet
  392. ***** ^ not supported yet
  393. 177 END;
  394. 178 RETURN;
  395. 179 END Close;
  396. ***** ^ not supported yet
  397. 180
  398. 181 BEGIN
  399. 182 IOR := 0;
  400. 183 OK := TRUE;
  401. ***** ^ undeclared identifier
  402. 184 EOF := FALSE;
  403. ***** ^ undeclared identifier
  404. 185 ShareMode := ShareCompat;
  405. ***** ^ undeclared identifier
  406. ***** ^ undeclared identifier
  407. 186 END WinFIO.
  408. ***** ^ not supported yet
  409. 187
  410. 221 errors