Listing: 1 IMPLEMENTATION MODULE Locks; 2 3 (* 4 * ModBase 5 * Release 3.0 6 * (c) Copyright 1991 John McMonagle 7 * P.O. Box 8402 8 * Green Bay Wi 53308 9 * All Rights Reserved 10 * 11 *) 12 13 FROM StringIO IMPORT PrintMessage,ErrorMessage; 14 IMPORT FAPI,FAPI,ErrorManager,KbdInput,BigSets; ***** ^ duplicate identifier 15 IMPORT SYSTEM,ErrStrgs,M2Strings,StrEdit,StringIO; ***** ^ duplicate identifier 16 CONST 17 Nil=SYSTEM.ADDRESS(VAL(LONGINT,0)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 18 19 VAR 20 AllRange:RangeRec; ***** ^ undeclared identifier 21 22 PROCEDURE AskError(code:CARDINAL;FileName:ARRAY OF CHAR):BOOLEAN; ***** ^ not supported yet 23 VAR 24 st:ARRAY[0..63] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 25 str:ARRAY[0..127] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 26 BEGIN 27 M2Strings.Concat('Unable to access file ',FileName,str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 28 StrEdit.Append(str,'. Error is:'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 29 ErrStrgs.NumToStr(code,st); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 30 StrEdit.Append(str,st); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 31 RETURN AbortRetryIgnore(str) ; ***** ^ undeclared identifier ***** ^ not supported yet 32 END AskError; ***** ^ not supported yet 33 34 PROCEDURE Lock(FileHandle : CARDINAL; range:RangeRec) : ErrorMessage; ***** ^ undeclared identifier 35 BEGIN 36 RETURN FAPI.DOSFILELOCKS(FileHandle,Nil,SYSTEM.ADR(range)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 37 END Lock; ***** ^ not supported yet 38 39 PROCEDURE LockRetry(FileHandle : CARDINAL; range:RangeRec; ***** ^ undeclared identifier 40 Retries:CARDINAL; VAR FileName:ARRAY OF CHAR) : ErrorMessage; ***** ^ not supported yet 41 VAR 42 count, 43 code:CARDINAL; 44 BEGIN 45 count:=0; 46 LOOP 47 code:=FAPI.DOSFILELOCKS(FileHandle,Nil,SYSTEM.ADR(range)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 48 IF (code=0) THEN RETURN code END; ***** ^ bad RETURN 49 IF (count>Retries) THEN 50 IF NOT AskError(code,FileName) ***** ^ not supported yet ***** ^ not supported yet 51 THEN 52 RETURN code ***** ^ bad RETURN 53 END; 54 count:=0 55 END; 56 INC(count); ***** ^ undeclared identifier ***** ^ not supported yet 57 Pause(55); ***** ^ undeclared identifier ***** ^ not supported yet 58 END; 59 END LockRetry; ***** ^ not supported yet 60 61 PROCEDURE UnLock(FileHandle : CARDINAL; range:RangeRec) : ErrorMessage; ***** ^ undeclared identifier 62 BEGIN 63 RETURN FAPI.DOSFILELOCKS(FileHandle,SYSTEM.ADR(range),Nil); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 64 END UnLock; ***** ^ not supported yet 65 66 PROCEDURE LockFile(FileHandle : CARDINAL) : ErrorMessage; 67 BEGIN 68 RETURN FAPI.DOSFILELOCKS(FileHandle,Nil,SYSTEM.ADR(AllRange)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 69 END LockFile; ***** ^ not supported yet 70 71 PROCEDURE LockFileRetry(FileHandle : CARDINAL; 72 Retries:CARDINAL; VAR FileName:ARRAY OF CHAR) : ErrorMessage; ***** ^ not supported yet 73 BEGIN 74 RETURN LockRetry(FileHandle,AllRange,Retries,FileName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 75 END LockFileRetry; ***** ^ not supported yet 76 77 PROCEDURE UnLockFile(FileHandle : CARDINAL) : ErrorMessage; 78 BEGIN 79 RETURN FAPI.DOSFILELOCKS(FileHandle,SYSTEM.ADR(AllRange),Nil); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 80 END UnLockFile; ***** ^ not supported yet 81 82 83 84 (* used to pause between retries should give give control to the 85 operating system if possible *) 86 PROCEDURE Pause(Msec:CARDINAL); 87 VAR 88 code:CARDINAL; 89 mode:SYSTEM.BYTE; ***** ^ not supported yet 90 BEGIN 91 code:=FAPI.DOSSLEEP(VAL(LONGINT,Msec)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 92 END Pause; ***** ^ not supported yet 93 94 PROCEDURE NoLocking(handle:CARDINAL):BOOLEAN; 95 VAR 96 code:CARDINAL; 97 BEGIN 98 code:=LockFile(handle); ***** ^ not supported yet ***** ^ not supported yet 99 CASE code OF 100 0: 101 code:=LockFile(handle); ***** ^ not supported yet ***** ^ not supported yet 102 PrintMessage(UnLockFile(handle)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 103 RETURN code#33; 104 | 1: RETURN TRUE; 105 |33:RETURN FALSE; 106 ELSE 107 PrintMessage(code); ***** ^ not supported yet ***** ^ not supported yet 108 RETURN TRUE; 109 END; 110 END NoLocking; ***** ^ not supported yet 111 112 PROCEDURE ReadRetry(FileHandle : CARDINAL; ptr : SYSTEM.ADDRESS; size,Retries : ***** ^ not supported yet 113 CARDINAL;VAR FileName:ARRAY OF CHAR) : CARDINAL; ***** ^ not supported yet 114 VAR 115 ErrorReturn, 116 BytesRead, 117 count: CARDINAL; 118 BEGIN 119 count:=0; 120 LOOP 121 ErrorReturn := FAPI.DOSREAD( FileHandle, ptr, size, SYSTEM.ADR(BytesRead) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 122 (* Looks like something may be wrong here. *) 123 IF ErrorReturn=0 THEN 124 IF BytesRead < size THEN 125 IF BytesRead = 0 THEN 126 RETURN (StringIO.EndOfFile); ***** ^ not supported yet ***** ^ not supported yet 127 ELSE 128 RETURN (StringIO.PartialRead); ***** ^ not supported yet ***** ^ not supported yet 129 END; 130 END; 131 RETURN ErrorReturn; 132 END; 133 IF count>Retries THEN 134 IF NOT AskError(ErrorReturn,FileName) ***** ^ not supported yet ***** ^ not supported yet 135 THEN 136 RETURN ErrorReturn 137 END; 138 count:=0; 139 END; 140 END; 141 END ReadRetry; ***** ^ not supported yet 142 143 PROCEDURE DefaultMessage( TheMessage: ARRAY OF CHAR ): BOOLEAN; ***** ^ not supported yet 144 VAR 145 c:CARDINAL; 146 set:KbdInput.KeyNumSet; ***** ^ not supported yet 147 BEGIN 148 BigSets.InitSet(set); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 149 BigSets.AppendSet(set,"{'A','a','r','R','I','i'}"); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 150 StringIO.WriteEol( StringIO.ErrorOutp, TheMessage ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 151 StringIO.WriteEol( StringIO.ErrorOutp, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 152 ' Press A to Abort,R to Retry, and I to Ignore.' ); ***** ^ not supported yet 153 c:= KbdInput.CAPkey( KbdInput.KeyHit(set) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 154 IF c=ORD('R') THEN ***** ^ undeclared identifier ***** ^ not supported yet 155 RETURN TRUE 156 ELSIF c=ORD('I') THEN ***** ^ undeclared identifier ***** ^ not supported yet 157 RETURN FALSE 158 ELSE 159 ErrorManager.DoTermProcs(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 160 HALT; ***** ^ undeclared identifier 161 END 162 END DefaultMessage; ***** ^ not supported yet 163 164 165 BEGIN 166 AllRange.FileOffset:=VAL(LONGINT,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 167 AllRange.RangeLength:=MAX(LONGINT); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 168 AbortRetryIgnore:=DefaultMessage; ***** ^ undeclared identifier ***** ^ not supported yet 169 ExclusiveOnly:=FALSE; ***** ^ undeclared identifier 170 END Locks. ***** ^ not supported yet 156 errors