| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414 |
- Listing:
- 1 (* Release 3.10 *)
- 2 (*-------------------------------------------------------------------------*
- 3 * *
- 4 * WINFIO.MOD - File i/o with far interface for Windows *
- 5 * *
- 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. *
- 7 * All Rights Reserved *
- 8 * *
- 9 *--------------------------------------------------------------------------*)
- 10
- 11 (*# call(seg_name => null) *)
- 12 (*# module(implementation=>off) *)
- 13 (*# data(seg_name => null, near_ptr=>off) *)
- 14 (*# call(o_a_copy => off, ds_eq_ss=>off, near_call=>off) *)
- 15 (*# check(stack=>off,
- 16 index=>off,
- 17 range=>off,
- 18 overflow=>off,
- 19 nil_ptr=>off) *)
- 20
- 21
- 22 IMPLEMENTATION MODULE WinFIO;
- 23
- 24 IMPORT Lib, SYSTEM, CoreIO, CoreFile, CoreSig, CoreMain, Windows;
- 25
- 26 VAR
- 27 (* CoreFile.BufInf : ARRAY[0..MaxHandle] OF FileInf; *) (* NB in CoreFile *)
- 28 IOR: CARDINAL;
- 29
- 30 TYPE
- 31 Str80 = ARRAY[0..79] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 32 PathStr = ARRAY [0..128] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 33
- 34
- 35 PROCEDURE ErrorCheck(Code: CARDINAL; ErrNum: CARDINAL; Msg, Name: ARRAY OF CHAR);
- ***** ^ not supported yet
- 36
- 37 VAR
- 38 ErrMsg: ARRAY [0..119] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 39 NumStr: ARRAY [0..19] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 40 OK: BOOLEAN;
- 41 BEGIN
- 42 IF ErrNum = 0 THEN
- 43 ErrNum := Lib.SysErrno();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 44 END;
- 45 IF IOcheck THEN
- ***** ^ undeclared identifier
- 46 Str.Copy(ErrMsg, Msg);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 47 Str.Append(ErrMsg, Name);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 48 Str.Append(ErrMsg, '. Dos Error Code ');
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 49 Str.CardToStr(LONGCARD(ErrNum), NumStr, 10, OK);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 50 Str.Append(ErrMsg, NumStr);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 51 (* Lib.WrDosError(SHORTCARD(ErrNum)); *)
- 52 Lib.RunTimeError(CoreSig._FatalErrorPos(), Code+0A0H, ErrMsg);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 53 END;
- 54 IOR := ErrNum;
- 55 END ErrorCheck;
- ***** ^ not supported yet
- 56
- 57 PROCEDURE IOresult () : CARDINAL;
- 58 BEGIN
- 59 RETURN IOR;
- 60 END IOresult;
- ***** ^ not supported yet
- 61
- 62
- 63 PROCEDURE WrBin(F: File; Buf: ARRAY OF BYTE; Count: CARDINAL);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 64
- 65 VAR
- 66 NumWrit : CARDINAL;
- 67 BEGIN
- 68 IOR := 0;
- 69 OK := TRUE;
- ***** ^ undeclared identifier
- 70 IF Count = 0 THEN RETURN END;
- 71 NumWrit := Windows._lwrite(F, Buf, Count);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 72 IF NumWrit # Count THEN
- 73 ErrorCheck(6, 0, 'WrBin : ', Lib.NilStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 74 OK := FALSE;
- ***** ^ undeclared identifier
- 75 END;
- 76 END WrBin;
- ***** ^ not supported yet
- 77
- 78 PROCEDURE RdBin(F: File; VAR Buf: ARRAY OF BYTE; Count: CARDINAL) : CARDINAL;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 79 VAR
- 80 NumRead: CARDINAL;
- 81 BEGIN
- 82 IOR := 0;
- 83 OK := TRUE;
- ***** ^ undeclared identifier
- 84 EOF := FALSE;
- ***** ^ undeclared identifier
- 85 IF Count = 0 THEN RETURN 0 END;
- 86 NumRead := Windows._lread(F, Buf, Count);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 87 IF NumRead # Count THEN
- 88 OK := FALSE;
- ***** ^ undeclared identifier
- 89 IF NumRead < 0 THEN
- 90 ErrorCheck(7, 0, 'RbBin : ', Lib.NilStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 91 ELSE
- 92 EOF := TRUE;
- ***** ^ undeclared identifier
- 93 END;
- 94 END;
- 95 RETURN NumRead;
- 96 END RdBin;
- ***** ^ not supported yet
- 97
- 98
- 99 PROCEDURE GetName(name: ARRAY OF CHAR; VAR fn: PathStr);
- ***** ^ not supported yet
- 100 (* Makes Null terminated filename, also sets IOR to 0 *)
- 101 BEGIN
- 102 Str.Copy(fn,name);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 103 fn[HIGH(fn)] := CHR(0);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 104 IOR := 0;
- 105 END GetName;
- ***** ^ not supported yet
- 106
- 107 PROCEDURE Open(Name: ARRAY OF CHAR) : File;
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 108 VAR
- 109 fn: PathStr;
- ***** ^ not supported yet
- 110 H: File;
- ***** ^ undeclared identifier
- 111 BEGIN
- 112 GetName(Name,fn);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 113 H := Windows._lopen(fn, Windows.READ_WRITE + INTEGER(ShareMode));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 114 IF H <> MAX(CARDINAL) THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 115 CoreFile._openfd[H] := (CoreIO.O_RDWR+CoreIO.O_BINARY);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 116 IF CoreIO.isatty(H) # 0 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 117 CoreFile._openfd[H] := CoreFile._openfd[H] + CoreIO.O_DEVICE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 118 END;
- 119 ELSE
- 120 ErrorCheck(2, 0, 'Open : ', fn);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 121 END;
- 122 RETURN H;
- ***** ^ not supported yet
- 123 END Open;
- ***** ^ not supported yet
- 124
- 125 PROCEDURE OpenRead( Name: ARRAY OF CHAR) : File;
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 126 VAR
- 127 fn: PathStr;
- ***** ^ not supported yet
- 128 H: File;
- ***** ^ undeclared identifier
- 129 BEGIN
- 130 GetName(Name,fn);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 131 H := Windows._lopen(fn, Windows.READ + INTEGER(ShareMode));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 132 IF H <> MAX(CARDINAL) THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 133 CoreFile._openfd[H] := (CoreIO.O_RDONLY+CoreIO.O_BINARY);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 134 IF CoreIO.isatty(H) # 0 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 135 CoreFile._openfd[H] := CoreFile._openfd[H] + CoreIO.O_DEVICE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 136 END;
- 137 ELSE
- 138 ErrorCheck(3, 0, 'OpenRead : ', fn);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 139 END;
- 140 RETURN H;
- ***** ^ not supported yet
- 141 END OpenRead;
- ***** ^ not supported yet
- 142
- 143 PROCEDURE Exists(Name: ARRAY OF CHAR) : BOOLEAN;
- ***** ^ not supported yet
- 144 VAR
- 145 fn : PathStr ;
- ***** ^ not supported yet
- 146 BEGIN
- 147 GetName(Name,fn);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 148 IF CoreIO._exists(fn) # 0 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 149 RETURN TRUE;
- 150 END;
- 151 RETURN FALSE;
- 152 END Exists;
- ***** ^ not supported yet
- 153
- 154 PROCEDURE Create(Name: ARRAY OF CHAR) : File;
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 155 VAR
- 156 fn: PathStr;
- ***** ^ not supported yet
- 157 H: File;
- ***** ^ undeclared identifier
- 158 BEGIN
- 159 GetName(Name,fn);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 160 H := Windows._lcreat(fn, 0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 161 IF H <> MAX(CARDINAL) THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 162 CoreFile._openfd[H] := (CoreIO.O_RDWR+CoreIO.O_BINARY);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 163 ELSE
- 164 ErrorCheck(5, 0, 'Create : ', Name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 165 END;
- 166 RETURN H;
- ***** ^ not supported yet
- 167 END Create;
- ***** ^ not supported yet
- 168
- 169 PROCEDURE Close(F: File);
- ***** ^ undeclared identifier
- 170 BEGIN
- 171 IOR := 0;
- 172 IF F < CoreFile._open_max THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 173 CoreFile._openfd[F] := {};
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 174 END;
- 175 IF Windows._lclose(F) = -1 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 176 ErrorCheck(0, 0, 'Close : ', Lib.NilStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 177 END;
- 178 RETURN;
- 179 END Close;
- ***** ^ not supported yet
- 180
- 181 BEGIN
- 182 IOR := 0;
- 183 OK := TRUE;
- ***** ^ undeclared identifier
- 184 EOF := FALSE;
- ***** ^ undeclared identifier
- 185 ShareMode := ShareCompat;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 186 END WinFIO.
- ***** ^ not supported yet
- 187
- 221 errors
|