]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* IOLink.mod implement the ISO IOLink specification. |
2 | ||
83ffe9cd | 3 | Copyright (C) 2008-2023 Free Software Foundation, Inc. |
1eee94d3 GM |
4 | Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
5 | ||
6 | This file is part of GNU Modula-2. | |
7 | ||
8 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 3, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
14 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | General Public License for more details. | |
17 | ||
18 | Under Section 7 of GPL version 3, you are granted additional | |
19 | permissions described in the GCC Runtime Library Exception, version | |
20 | 3.1, as published by the Free Software Foundation. | |
21 | ||
22 | You should have received a copy of the GNU General Public License and | |
23 | a copy of the GCC Runtime Library Exception along with this program; | |
24 | see the files COPYING3 and COPYING.RUNTIME respectively. If not, see | |
25 | <http://www.gnu.org/licenses/>. *) | |
26 | ||
27 | IMPLEMENTATION MODULE IOLink ; | |
28 | ||
29 | IMPORT RTio, RTentity, EXCEPTIONS, IOChan, M2RTS, SYSTEM, ASCII ; | |
30 | ||
31 | FROM Storage IMPORT ALLOCATE, DEALLOCATE ; | |
32 | ||
33 | ||
34 | (* | |
35 | Values of this type are used to identify new device modules, | |
36 | and are normally obtained by them during their initialization. | |
37 | *) | |
38 | ||
39 | TYPE | |
40 | DeviceId = POINTER TO RECORD | |
41 | cids: RTentity.Group ; | |
42 | END ; | |
43 | resourceState = (allocated, deallocated) ; | |
44 | ||
45 | ||
46 | VAR | |
47 | dids : RTentity.Group ; | |
48 | iolink: EXCEPTIONS.ExceptionSource ; | |
49 | ||
50 | ||
51 | (* | |
52 | checkValidDevice - checks to see that the, did, is | |
53 | known to exist. | |
54 | *) | |
55 | ||
56 | PROCEDURE checkValidDevice (did: DeviceId) ; | |
57 | BEGIN | |
58 | IF NOT RTentity.IsIn(dids, did) | |
59 | THEN | |
60 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.wrongDevice), | |
61 | 'IOLink: device id specified does not exist') | |
62 | END | |
63 | END checkValidDevice ; | |
64 | ||
65 | ||
66 | (* | |
67 | Allocates a unique value of type DeviceId, and assigns this | |
68 | value to did. | |
69 | *) | |
70 | ||
71 | PROCEDURE AllocateDeviceId (VAR did: DeviceId) ; | |
72 | BEGIN | |
73 | NEW(did) ; | |
74 | IF did=NIL | |
75 | THEN | |
76 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.hardDeviceError), | |
77 | 'IOLink.AllocateDeviceId: out of memory error') | |
78 | ELSE | |
79 | RTentity.PutKey(dids, did, ORD(allocated)) ; | |
80 | WITH did^ DO | |
81 | cids := RTentity.InitGroup() | |
82 | END | |
83 | END | |
84 | END AllocateDeviceId ; | |
85 | ||
86 | ||
87 | PROCEDURE defaultLook (d: DeviceTablePtr; | |
88 | VAR ch: CHAR; | |
89 | VAR r : IOConsts.ReadResults) ; | |
90 | BEGIN | |
91 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable), | |
92 | 'IOLink:Look operation on device is not available') | |
93 | END defaultLook ; | |
94 | ||
95 | ||
96 | PROCEDURE defaultSkip (d: DeviceTablePtr) ; | |
97 | BEGIN | |
98 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable), | |
99 | 'IOLink:Skip operation on device is not available') | |
100 | END defaultSkip ; | |
101 | ||
102 | ||
103 | PROCEDURE defaultSkipLook (d: DeviceTablePtr; | |
104 | VAR ch: CHAR; | |
105 | VAR r : IOConsts.ReadResults) ; | |
106 | BEGIN | |
107 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable), | |
108 | 'IOLink:SkipLook operation on device is not available') | |
109 | END defaultSkipLook ; | |
110 | ||
111 | ||
112 | PROCEDURE defaultWriteLn (d: DeviceTablePtr) ; | |
113 | BEGIN | |
114 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable), | |
115 | 'IOLink:WriteLn operation on device is not available') | |
116 | END defaultWriteLn ; | |
117 | ||
118 | ||
119 | PROCEDURE defaultTextRead (d: DeviceTablePtr; a: SYSTEM.ADDRESS; n: CARDINAL; VAR r: CARDINAL) ; | |
120 | BEGIN | |
121 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable), | |
122 | 'IOLink:TextRead operation on device is not available') | |
123 | END defaultTextRead ; | |
124 | ||
125 | ||
126 | PROCEDURE defaultTextWrite (d: DeviceTablePtr; a: SYSTEM.ADDRESS; n: CARDINAL) ; | |
127 | BEGIN | |
128 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable), | |
129 | 'IOLink:TextWrite operation on device is not available') | |
130 | END defaultTextWrite ; | |
131 | ||
132 | ||
133 | PROCEDURE defaultRawRead (d: DeviceTablePtr; a: SYSTEM.ADDRESS; n: CARDINAL; VAR r: CARDINAL) ; | |
134 | BEGIN | |
135 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable), | |
136 | 'IOLink:TextRawRead operation on device is not available') | |
137 | END defaultRawRead ; | |
138 | ||
139 | ||
140 | PROCEDURE defaultRawWrite (d: DeviceTablePtr; a: SYSTEM.ADDRESS; n: CARDINAL) ; | |
141 | BEGIN | |
142 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable), | |
143 | 'IOLink:TextRawWrite operation on device is not available') | |
144 | END defaultRawWrite ; | |
145 | ||
146 | ||
147 | PROCEDURE defaultGetName (d: DeviceTablePtr; VAR a: ARRAY OF CHAR) ; | |
148 | BEGIN | |
149 | a[0] := ASCII.nul | |
150 | END defaultGetName ; | |
151 | ||
152 | ||
153 | PROCEDURE defaultReset (d: DeviceTablePtr) ; | |
154 | BEGIN | |
155 | (* do nothing *) | |
156 | END defaultReset ; | |
157 | ||
158 | ||
159 | PROCEDURE defaultFlush (d: DeviceTablePtr) ; | |
160 | BEGIN | |
161 | (* do nothing *) | |
162 | END defaultFlush ; | |
163 | ||
164 | ||
165 | PROCEDURE defaultFree (d: DeviceTablePtr) ; | |
166 | BEGIN | |
167 | (* do nothing *) | |
168 | END defaultFree ; | |
169 | ||
170 | ||
171 | (* | |
172 | InitDtp - creates a new DeviceTablePtr and initializes the | |
173 | fields to their defaults. | |
174 | *) | |
175 | ||
176 | PROCEDURE InitDtp (d: DeviceId; c: IOChan.ChanId) : DeviceTablePtr ; | |
177 | VAR | |
178 | p: DeviceTablePtr ; | |
179 | BEGIN | |
180 | NEW(p) ; | |
181 | WITH p^ DO | |
182 | cd := NIL ; | |
183 | did := d ; | |
184 | cid := c ; | |
185 | result := IOConsts.notKnown ; | |
186 | errNum := 0 ; | |
187 | flags := ChanConsts.FlagSet{} ; | |
188 | doLook := defaultLook ; | |
189 | doSkip := defaultSkip ; | |
190 | doSkipLook := defaultSkipLook ; | |
191 | doLnWrite := defaultWriteLn ; | |
192 | doTextRead := defaultTextRead ; | |
193 | doTextWrite := defaultTextWrite ; | |
194 | doRawRead := defaultRawRead ; | |
195 | doRawWrite := defaultRawWrite ; | |
196 | doGetName := defaultGetName ; | |
197 | doReset := defaultReset ; | |
198 | doFlush := defaultFlush ; | |
199 | doFree := defaultFree ; | |
200 | END ; | |
201 | RETURN( p ) | |
202 | END InitDtp ; | |
203 | ||
204 | ||
205 | (* | |
206 | KillDtp - deallocate, p, and any associated resource. | |
207 | *) | |
208 | ||
209 | PROCEDURE KillDtp (p: DeviceTablePtr) : DeviceTablePtr ; | |
210 | BEGIN | |
211 | WITH p^ DO | |
212 | doFlush(p) ; | |
213 | doFree(p) | |
214 | END ; | |
215 | DISPOSE(p) ; | |
216 | RETURN( NIL ) | |
217 | END KillDtp ; | |
218 | ||
219 | ||
220 | (* | |
221 | Attempts to make a new channel for the device module identified | |
222 | by did. If no more channels can be made, the identity of | |
223 | the invalid channel is assigned to cid. Otherwise, the identity | |
224 | of a new channel is assigned to cid. | |
225 | *) | |
226 | ||
227 | PROCEDURE MakeChan (did: DeviceId; VAR cid: IOChan.ChanId) ; | |
228 | BEGIN | |
229 | checkValidDevice(did) ; | |
230 | cid := IOChan.ChanId(RTio.InitChanId()) ; | |
231 | IF cid=NIL | |
232 | THEN | |
233 | cid := IOChan.InvalidChan() | |
234 | ELSE | |
235 | WITH did^ DO | |
236 | RTentity.PutKey(cids, cid, ORD(allocated)) | |
237 | END ; | |
238 | RTio.SetDeviceId(cid, did) ; | |
239 | RTio.SetDevicePtr(cid, InitDtp(did, cid)) | |
240 | END | |
241 | END MakeChan ; | |
242 | ||
243 | ||
244 | (* | |
245 | If the device module identified by did is not the module that | |
246 | made the channel identified by cid, the exception wrongDevice is | |
247 | raised; otherwise the channel is deallocated, and the value | |
248 | identifying the invalid channel is assigned to cid. | |
249 | *) | |
250 | ||
251 | PROCEDURE UnMakeChan (did: DeviceId; VAR cid: IOChan.ChanId) ; | |
252 | BEGIN | |
253 | checkValidDevice(did) ; | |
254 | WITH did^ DO | |
255 | IF RTentity.IsIn(cids, cid) | |
256 | THEN | |
257 | RTio.SetDevicePtr(cid, KillDtp(RTio.GetDevicePtr(cid))) ; | |
258 | RTentity.DelKey(cids, cid) ; | |
259 | cid := IOChan.ChanId(RTio.KillChanId(cid)) ; | |
260 | cid := IOChan.InvalidChan() | |
261 | ELSE | |
262 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.wrongDevice), | |
263 | 'IOLink.UnMakeChan: channel does not belong to device') | |
264 | END | |
265 | END | |
266 | END UnMakeChan ; | |
267 | ||
268 | ||
269 | (* | |
270 | The pointer to the device table for a channel is obtained using the | |
271 | following procedure: | |
272 | ||
273 | If the device module identified by did is not the module that made | |
274 | the channel identified by cid, the exception wrongDevice is raised. | |
275 | *) | |
276 | ||
277 | PROCEDURE DeviceTablePtrValue (cid: IOChan.ChanId; | |
278 | did: DeviceId) : DeviceTablePtr ; | |
279 | BEGIN | |
280 | checkValidDevice(did) ; | |
281 | WITH did^ DO | |
282 | IF RTentity.IsIn(cids, cid) | |
283 | THEN | |
284 | RETURN( RTio.GetDevicePtr(cid) ) | |
285 | ELSE | |
286 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.wrongDevice), | |
287 | 'IOLink.DeviceTablePtrValue: channel does belong to device') | |
288 | END | |
289 | END | |
290 | END DeviceTablePtrValue ; | |
291 | ||
292 | ||
293 | PROCEDURE IsDevice (cid: IOChan.ChanId; did: DeviceId) : BOOLEAN ; | |
294 | (* Tests if the device module identified by did is the module | |
295 | that made the channel identified by cid. | |
296 | *) | |
297 | BEGIN | |
298 | IF RTentity.IsIn(dids, did) | |
299 | THEN | |
300 | WITH did^ DO | |
301 | RETURN( RTentity.IsIn(cids, cid) ) | |
302 | END | |
303 | END ; | |
304 | RETURN( FALSE ) | |
305 | END IsDevice ; | |
306 | ||
307 | ||
308 | PROCEDURE RAISEdevException (cid: IOChan.ChanId; did: DeviceId; | |
309 | x: DevExceptionRange; s: ARRAY OF CHAR) ; | |
310 | (* If the device module identified by did is not the module | |
311 | that made the channel identified by cid, the exception | |
312 | wrongDevice is raised; otherwise the given exception | |
313 | is raised, and the string value in s is included in the | |
314 | exception message. | |
315 | *) | |
316 | BEGIN | |
317 | checkValidDevice(did) ; | |
318 | WITH did^ DO | |
319 | IF RTentity.IsIn(cids, cid) | |
320 | THEN | |
321 | EXCEPTIONS.RAISE(iolink, ORD(x), s) | |
322 | ELSE | |
323 | EXCEPTIONS.RAISE(iolink, ORD(IOChan.wrongDevice), | |
324 | 'IOLink.RAISEdevException: channel does not belong to device') | |
325 | END | |
326 | END | |
327 | END RAISEdevException ; | |
328 | ||
329 | ||
330 | PROCEDURE IsIOException () : BOOLEAN ; | |
331 | (* Returns TRUE if the current coroutine is in the exceptional | |
332 | execution state because of the raising af an exception from | |
333 | ChanExceptions; otherwise FALSE. | |
334 | *) | |
335 | BEGIN | |
336 | RETURN( EXCEPTIONS.IsExceptionalExecution() AND | |
337 | EXCEPTIONS.IsCurrentSource(iolink) ) | |
338 | END IsIOException ; | |
339 | ||
340 | ||
341 | PROCEDURE IOException () : IOChan.ChanExceptions ; | |
342 | (* If the current coroutine is in the exceptional execution state | |
343 | because of the raising of an exception from ChanExceptions, | |
344 | returns the corresponding enumeration value, and otherwise | |
345 | raises an exception. | |
346 | *) | |
347 | BEGIN | |
348 | IF IsIOException() | |
349 | THEN | |
350 | RETURN( VAL(IOChan.ChanExceptions, | |
351 | EXCEPTIONS.CurrentNumber(iolink)) ) | |
352 | ELSE | |
353 | M2RTS.NoException(SYSTEM.ADR(__FILE__), __LINE__, | |
354 | __COLUMN__, SYSTEM.ADR(__FUNCTION__), | |
355 | SYSTEM.ADR ("not in the exceptional execution state")) | |
356 | END | |
357 | END IOException ; | |
358 | ||
359 | ||
360 | (* | |
361 | Init - initialise global variables. | |
362 | *) | |
363 | ||
364 | PROCEDURE Init ; | |
365 | BEGIN | |
366 | EXCEPTIONS.AllocateSource(iolink) ; | |
367 | dids := RTentity.InitGroup() | |
368 | END Init ; | |
369 | ||
370 | ||
371 | BEGIN | |
372 | Init | |
373 | END IOLink. |