home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / RESHANDL.I < prev    next >
Encoding:
Text File  |  1990-11-10  |  10.9 KB  |  3 lines
  1. ⓪ IMPLEMENTATION MODULE ResHandler;
  2. ⓪ (*$R-,Y+*)
  3. ⓪ (*  $S- findet sich weiter unten! *)
  4. ⓪ 
  5. ⓪ (*------------------------------------------------------------------------------
  6. ⓪!* Version 1.3
  7. ⓪!*------------------------------------------------------------------------------
  8. ⓪!* Copyright © 1989, 1990 by Michael Seyfried
  9. ⓪!*------------------------------------------------------------------------------
  10. ⓪!*       89 MS 1.0  Ersterstellung aus SysLibDemo
  11. ⓪!* 29.09.89 MS 1.1  Vorschläge von Thomas Tempelmann berücksichtigt
  12. ⓪!* 30.09.89 MS 1.1a Kleine Korrekturen; Modul erfolgreich ausgetestet.
  13. ⓪!* 02.01.90 MS 1.1a Modul mit korrigiertem Loader erfolgreich ausgetestet.
  14. ⓪!* 12.05.90 MS 1.3  Namensänderungen von TT übernommen. Die Freigabeprozedur hat
  15. ⓪!*                  nun einen zusätzlichen Parameter, mit dessen Hilfe man fest-
  16. ⓪!*                  stellen kann, ob sie vom Benutzer oder vom System aufgerufen
  17. ⓪!*                  wird.
  18. ⓪!* 27.05.90 TT      Doku in Def-Modul korrigiert (Kommata, usw), sowie im Modul-
  19. ⓪!*                  Kopf 2 neue Absätze (am Ende). Statt ErrBase.RaiseError wird
  20. ⓪!*                  SystemError.OutOfMemory aufgerufen
  21. ⓪!* 30.05.90 TT      $Y+ eingefügt
  22. ⓪!* 10.11.90 TT      $S- weiter unten eingefügt
  23. ⓪!*------------------------------------------------------------------------------
  24. ⓪!*)
  25. ⓪ 
  26. ⓪ FROM SYSTEM IMPORT ADDRESS, ADR;
  27. ⓪ 
  28. ⓪ FROM MOSGlobals IMPORT MemArea;
  29. ⓪ 
  30. ⓪ FROM SystemError IMPORT OutOfMemory;
  31. ⓪ 
  32. ⓪ FROM PrgCtrl IMPORT CatchProcessTerm, TermCarrier, SetEnvelope, EnvlpCarrier;
  33. ⓪ 
  34. ⓪ FROM ResCtrl IMPORT CatchRemoval, RemovalCarrier;
  35. ⓪ 
  36. ⓪ FROM Storage IMPORT SysAlloc, DEALLOCATE; (* Systemmodul, daher 'SysAlloc' *)
  37. ⓪ 
  38. ⓪ FROM Strings IMPORT Relation;
  39. ⓪ 
  40. ⓪ FROM Lists IMPORT List, SysCreateList, DeleteList, ResetList, AppendEntry,
  41. ⓪2PrevEntry, NextEntry, CurrentEntry, RemoveEntry, FindEntry,
  42. ⓪2ListEmpty, LCarrier, InsertEntry;
  43. ⓪ 
  44. ⓪ (*
  45. ⓪ IMPORT Terminal;
  46. ⓪ 
  47. ⓪ IMPORT Strings;
  48. ⓪ 
  49. ⓪ IMPORT StrConv;
  50. ⓪ 
  51. ⓪ FROM SYSTEM IMPORT LONGWORD, VAL;
  52. ⓪ *)
  53. ⓪ 
  54. ⓪ 
  55. ⓪ CONST SysLevel        = -1;         (* Systemlevel *)
  56. ⓪ 
  57. ⓪ TYPE  Resource = POINTER TO List;
  58. ⓪ 
  59. ⓪&ListEntry = RECORD
  60. ⓪4level: INTEGER;       (* Systemlevel der Resource *)
  61. ⓪4resHdl: ADDRESS;      (* Kennung der Resource *)
  62. ⓪4delProc: CloseProc;   (* Freigabe-Prozedur *)
  63. ⓪2END;
  64. ⓪ 
  65. ⓪&PtrListEntry = POINTER TO ListEntry;
  66. ⓪ 
  67. ⓪ VAR   MyLevel: INTEGER;                   (* aktuelles Systemlevel *)
  68. ⓪&ResListList: List;                  (* Liste aller Resource-Listen *)
  69. ⓪ 
  70. ⓪ 
  71. ⓪ (*
  72. ⓪ (* Die folgenden Prozeduren sind für's Debugging gedacht. Ich habe sie
  73. ⓪!* vorsichtshalber nicht gelöscht (man kann nie wissen). Das Modul ist
  74. ⓪!* mit Hilfe dieser Routinen und 'SysLibDemo' ausgetestet worden. Es
  75. ⓪!* sollte also weitgehend ohne Fehler sein.
  76. ⓪!*)
  77. ⓪ PROCEDURE Info( msg: ARRAY OF CHAR);
  78. ⓪"BEGIN
  79. ⓪$Terminal.WriteString( msg);
  80. ⓪$Terminal.WriteLn
  81. ⓪"END Info;
  82. ⓪ 
  83. ⓪ PROCEDURE Wait;
  84. ⓪"VAR wait: CHAR;
  85. ⓪"BEGIN
  86. ⓪$Terminal.WriteString( 'waiting ');
  87. ⓪$Terminal.Read( wait)
  88. ⓪"END Wait;
  89. ⓪ 
  90. ⓪ PROCEDURE ShowLHex( LongWord: LONGWORD);
  91. ⓪"VAR Str: Strings.String;
  92. ⓪"BEGIN
  93. ⓪$Str:= StrConv.LHexToStr( VAL( LONGCARD, LongWord), 10);
  94. ⓪$Terminal.WriteString( Str);
  95. ⓪$Terminal.WriteLn;
  96. ⓪"END ShowLHex;
  97. ⓪ 
  98. ⓪ PROCEDURE ShowResource( ResList: Resource);
  99. ⓪"VAR OldCurrent: LCarrier;
  100. ⓪&EntryPtr: PtrListEntry;
  101. ⓪"BEGIN
  102. ⓪$OldCurrent:= ResList^.current;
  103. ⓪$Info( 'ShowResource');
  104. ⓪$ShowLHex( ResList);
  105. ⓪$ResetList( ResList^);
  106. ⓪$WHILE NextEntry( ResList^) # NIL DO
  107. ⓪&EntryPtr:= CurrentEntry( ResList^);
  108. ⓪&ShowLHex( EntryPtr^.resHdl)
  109. ⓪$END;
  110. ⓪$Wait;
  111. ⓪$ResList^.current:= OldCurrent;
  112. ⓪"END ShowResource;
  113. ⓪ 
  114. ⓪ PROCEDURE ShowList( list: List);
  115. ⓪"VAR OldCurrent: LCarrier;
  116. ⓪"BEGIN
  117. ⓪$OldCurrent:= list.current;
  118. ⓪$Info( 'ShowList');
  119. ⓪$ResetList( list);
  120. ⓪$WHILE NextEntry( list) # NIL DO
  121. ⓪&ShowLHex( CurrentEntry( list))
  122. ⓪$END;
  123. ⓪$Wait;
  124. ⓪$list.current:= OldCurrent;
  125. ⓪"END ShowList;
  126. ⓪ *)
  127. ⓪ 
  128. ⓪ 
  129. ⓪ PROCEDURE CreateResource( VAR ResList: Resource; VAR error: BOOLEAN);
  130. ⓪ 
  131. ⓪"VAR voidB: BOOLEAN;
  132. ⓪ 
  133. ⓪"BEGIN
  134. ⓪$SysAlloc( ResList, SIZE( ResList^));
  135. ⓪$IF ResList # NIL THEN
  136. ⓪&SysCreateList( ResList^, error);
  137. ⓪&IF error THEN
  138. ⓪((* Fehler => Speicher freigeben *)
  139. ⓪(DEALLOCATE( ResList, 0)
  140. ⓪&ELSE
  141. ⓪((* Resource-Liste am Anfang der Liste der Resource-Listen einfügen *)
  142. ⓪(ResetList( ResListList);
  143. ⓪(InsertEntry( ResListList, ResList, error);
  144. ⓪(IF error THEN
  145. ⓪*(* im Fehlerfall Speicher wieder freigeben *)
  146. ⓪*DeleteList( ResList^, voidB);
  147. ⓪*DEALLOCATE( ResList, 0)
  148. ⓪(END
  149. ⓪&END
  150. ⓪$ELSE
  151. ⓪&error:= TRUE;
  152. ⓪$END;
  153. ⓪"END CreateResource;
  154. ⓪ 
  155. ⓪ PROCEDURE insertResource(     useLevel: INTEGER;
  156. ⓪>ResList: Resource;
  157. ⓪>ResHdl: ADDRESS;
  158. ⓪>ResDel: CloseProc;
  159. ⓪:VAR error: BOOLEAN);
  160. ⓪ 
  161. ⓪"VAR EntryPtr: PtrListEntry;
  162. ⓪&OldCurrent: LCarrier;
  163. ⓪ 
  164. ⓪"BEGIN
  165. ⓪$SysAlloc( EntryPtr, SIZE( EntryPtr^));
  166. ⓪$IF EntryPtr # NIL THEN
  167. ⓪&WITH EntryPtr^ DO
  168. ⓪(level:= useLevel;
  169. ⓪(resHdl:= ResHdl;
  170. ⓪(delProc:= ResDel
  171. ⓪&END;
  172. ⓪ 
  173. ⓪&(* 'current' merken *)
  174. ⓪&OldCurrent:= ResList^.current;
  175. ⓪ 
  176. ⓪&(* Neues Element am Anfang der Liste einfügen *)
  177. ⓪&ResetList( ResList^);
  178. ⓪&InsertEntry( ResList^, EntryPtr, error);
  179. ⓪ 
  180. ⓪&(* 'current' zurückschreiben *)
  181. ⓪&ResList^.current:= OldCurrent;
  182. ⓪$ELSE
  183. ⓪&error:= TRUE
  184. ⓪$END;
  185. ⓪"END insertResource;
  186. ⓪ 
  187. ⓪ PROCEDURE InsertHandle(     ResList: Resource;
  188. ⓪>ResHdl: ADDRESS;
  189. ⓪>ResDel: CloseProc;
  190. ⓪:VAR error: BOOLEAN);
  191. ⓪"BEGIN
  192. ⓪$insertResource( MyLevel, ResList, ResHdl, ResDel, error)
  193. ⓪"END InsertHandle;
  194. ⓪ 
  195. ⓪ PROCEDURE InsertSysHandle(     ResList: Resource;
  196. ⓪AResHdl: ADDRESS;
  197. ⓪AResDel: CloseProc;
  198. ⓪=VAR error: BOOLEAN);
  199. ⓪"BEGIN
  200. ⓪$insertResource( SysLevel, ResList, ResHdl, ResDel, error)
  201. ⓪"END InsertSysHandle;
  202. ⓪ 
  203. ⓪ PROCEDURE HandleInList( ResList: Resource; ResHdl: ADDRESS): BOOLEAN;
  204. ⓪ 
  205. ⓪"VAR EntryPtr: PtrListEntry;
  206. ⓪&OldCurrent: LCarrier;
  207. ⓪ 
  208. ⓪"BEGIN
  209. ⓪$OldCurrent:= ResList^.current;
  210. ⓪$ResetList ( ResList^ );
  211. ⓪$WHILE NextEntry ( ResList^ ) # NIL DO
  212. ⓪&EntryPtr:= CurrentEntry ( ResList^ );
  213. ⓪&IF EntryPtr^.resHdl = ResHdl THEN
  214. ⓪(ResList^.current:= OldCurrent;
  215. ⓪(RETURN TRUE
  216. ⓪&END
  217. ⓪$END;
  218. ⓪$ResList^.current:= OldCurrent;
  219. ⓪$RETURN FALSE
  220. ⓪"END HandleInList;
  221. ⓪ 
  222. ⓪ PROCEDURE FirstHandle( ResList: Resource): ADDRESS;
  223. ⓪ 
  224. ⓪"VAR EntryPtr: PtrListEntry;
  225. ⓪ 
  226. ⓪"BEGIN
  227. ⓪$ResetList( ResList^);
  228. ⓪$EntryPtr:= NextEntry( ResList^);
  229. ⓪$IF EntryPtr = NIL THEN
  230. ⓪&RETURN NIL
  231. ⓪$ELSE
  232. ⓪&RETURN EntryPtr^.resHdl
  233. ⓪$END
  234. ⓪"END FirstHandle;
  235. ⓪ 
  236. ⓪ PROCEDURE NextHandle( ResList: Resource): ADDRESS;
  237. ⓪ 
  238. ⓪"VAR EntryPtr: PtrListEntry;
  239. ⓪ 
  240. ⓪"BEGIN
  241. ⓪$EntryPtr:= NextEntry( ResList^);
  242. ⓪$IF EntryPtr = NIL THEN
  243. ⓪&RETURN NIL
  244. ⓪$ELSE
  245. ⓪&RETURN EntryPtr^.resHdl
  246. ⓪$END
  247. ⓪"END NextHandle;
  248. ⓪ 
  249. ⓪ 
  250. ⓪ (*$S-  ab hier kein Stackcheck mehr *)
  251. ⓪ 
  252. ⓪ 
  253. ⓪ PROCEDURE ResourceDelete( EntryPtr: PtrListEntry; user: BOOLEAN);
  254. ⓪ 
  255. ⓪"BEGIN
  256. ⓪$WITH EntryPtr^ DO
  257. ⓪&delProc( resHdl, user)
  258. ⓪$END;
  259. ⓪$DEALLOCATE( EntryPtr, 0);
  260. ⓪"END ResourceDelete;
  261. ⓪ 
  262. ⓪ PROCEDURE RemoveHandle( ResList: Resource; ResHdl: ADDRESS);
  263. ⓪ (*
  264. ⓪!* ResList^.current wird nur verändert, wenn dieser Zeiger auf das zu löschende
  265. ⓪!* Listenelement zeigt. Dann zeigt er anschließend auf den Vorgänger. Dies ist
  266. ⓪!* wichtig, damit 'RemoveHandle' auch zwischen 'FirstHandle' und
  267. ⓪!* 'NextHandle' verwendet werden kann.
  268. ⓪!*)
  269. ⓪"VAR error, setOldCurrent: BOOLEAN;
  270. ⓪&EntryPtr: PtrListEntry;
  271. ⓪&OldCurrent: LCarrier;
  272. ⓪ 
  273. ⓪"BEGIN
  274. ⓪$OldCurrent:= ResList^.current;
  275. ⓪$ResetList ( ResList^ );
  276. ⓪$WHILE NextEntry ( ResList^ ) # NIL DO
  277. ⓪&EntryPtr:= CurrentEntry ( ResList^ );
  278. ⓪&IF EntryPtr^.resHdl = ResHdl THEN
  279. ⓪(setOldCurrent:= OldCurrent # ResList^.current;
  280. ⓪(RemoveEntry( ResList^, error);        (* Aus Liste löschen *)
  281. ⓪(IF setOldCurrent THEN
  282. ⓪*ResList^.current:= OldCurrent
  283. ⓪(END;
  284. ⓪(ResourceDelete( EntryPtr, TRUE);      (* Freigabe-Prozedur aufrufen *)
  285. ⓪(RETURN                                (* nur ein Handle löschen *)
  286. ⓪&END
  287. ⓪$END;
  288. ⓪$ResList^.current:= OldCurrent
  289. ⓪"END RemoveHandle;
  290. ⓪ 
  291. ⓪ PROCEDURE ResListCloseLevel( ResList: Resource);
  292. ⓪ 
  293. ⓪"VAR EntryPtr: PtrListEntry;
  294. ⓪&error: BOOLEAN;
  295. ⓪ 
  296. ⓪"BEGIN
  297. ⓪$ResetList ( ResList^ );
  298. ⓪$WHILE NextEntry ( ResList^) # NIL DO
  299. ⓪&EntryPtr:= CurrentEntry ( ResList^ );
  300. ⓪&IF EntryPtr^.level >= MyLevel THEN
  301. ⓪(RemoveEntry( ResList^, error);        (* Aus Liste löschen *)
  302. ⓪(ResourceDelete( EntryPtr, FALSE);     (* Freigabe-Prozedur aufrufen *)
  303. ⓪&END
  304. ⓪$END;
  305. ⓪"END ResListCloseLevel;
  306. ⓪ 
  307. ⓪ PROCEDURE CloseLevel;
  308. ⓪"(*
  309. ⓪#* Schließt alle Zugriffe, die unter dem gerade beendeten Prozeß
  310. ⓪#* geöffnet wurden.
  311. ⓪#*)
  312. ⓪"BEGIN
  313. ⓪$ResetList ( ResListList);
  314. ⓪$WHILE NextEntry ( ResListList) # NIL DO
  315. ⓪&(* für alle Resource-Listen ... *)
  316. ⓪&ResListCloseLevel( CurrentEntry( ResListList)); (* Einträge schließen *)
  317. ⓪$END;
  318. ⓪"END CloseLevel;
  319. ⓪ 
  320. ⓪ PROCEDURE Envelope ( starting, inChild: BOOLEAN; VAR exitCode: INTEGER );
  321. ⓪"BEGIN
  322. ⓪$IF inChild THEN
  323. ⓪&IF starting THEN
  324. ⓪(INC ( MyLevel );
  325. ⓪&ELSE
  326. ⓪(CloseLevel;
  327. ⓪(DEC ( MyLevel )
  328. ⓪&END
  329. ⓪$END
  330. ⓪"END Envelope;
  331. ⓪ 
  332. ⓪ PROCEDURE Removal;
  333. ⓪ 
  334. ⓪"PROCEDURE DeleteResList( ResList: Resource);
  335. ⓪"(*
  336. ⓪#* Es werden alle Einträge aus der Liste entfernt. Anschließend wird die Liste
  337. ⓪#* gelöscht.
  338. ⓪#*)
  339. ⓪$VAR EntryPtr: PtrListEntry;
  340. ⓪(error: BOOLEAN;
  341. ⓪ 
  342. ⓪$BEGIN
  343. ⓪&(* Zunächst Liste leeren *)
  344. ⓪&ResetList( ResList^);
  345. ⓪&WHILE NextEntry( ResList^) # NIL DO
  346. ⓪((* Die Listenelemente selbst werden nicht gelöscht, da Sys-Resourcen !
  347. ⓪)* (Andere Resourcen wurden schon bei 'CloseLevel' geschlossen.)
  348. ⓪)*)
  349. ⓪(EntryPtr:= CurrentEntry( ResList^);
  350. ⓪(DEALLOCATE( EntryPtr, 0);
  351. ⓪(RemoveEntry( ResList^, error);
  352. ⓪&END;
  353. ⓪ 
  354. ⓪&(* Liste selbst löschen *)
  355. ⓪&DeleteList( ResList^, error);
  356. ⓪ 
  357. ⓪&DEALLOCATE( ResList, 0);
  358. ⓪$END DeleteResList;
  359. ⓪ 
  360. ⓪"VAR error: BOOLEAN;
  361. ⓪ 
  362. ⓪"BEGIN
  363. ⓪$(* Die Resource-Listen werden gelöscht, da das Modul gerade terminiert.
  364. ⓪%* Alle Resourcen, die mit 'InsertSysHandle' in eine Liste eingefügt
  365. ⓪%* wurden, bleiben aber geöffnet !!
  366. ⓪%*)
  367. ⓪ 
  368. ⓪$(* Zunächst alle Resource-Listen löschen *)
  369. ⓪$ResetList( ResListList);
  370. ⓪$WHILE NextEntry( ResListList) # NIL DO
  371. ⓪&DeleteResList( CurrentEntry( ResListList));
  372. ⓪&RemoveEntry( ResListList, error);
  373. ⓪$END;
  374. ⓪ 
  375. ⓪$(* Nun leere Liste der Resource-Listen löschen *)
  376. ⓪$DeleteList( ResListList, error);
  377. ⓪"END Removal;
  378. ⓪ 
  379. ⓪ VAR tCarrier: TermCarrier;
  380. ⓪$eCarrier: EnvlpCarrier;
  381. ⓪$rCarrier: RemovalCarrier;
  382. ⓪ 
  383. ⓪ PROCEDURE InitModule(): BOOLEAN;
  384. ⓪ 
  385. ⓪"VAR error: BOOLEAN;
  386. ⓪&wsp: MemArea;
  387. ⓪ 
  388. ⓪"BEGIN
  389. ⓪$MyLevel:= 0;
  390. ⓪$(* Liste der Resource - Listen anlegen *)
  391. ⓪$SysCreateList( ResListList, error);
  392. ⓪$IF error THEN
  393. ⓪&RETURN FALSE
  394. ⓪$ELSE
  395. ⓪&wsp.bottom:= NIL;
  396. ⓪&CatchProcessTerm ( tCarrier, CloseLevel, wsp );
  397. ⓪&SetEnvelope ( eCarrier, Envelope, wsp );
  398. ⓪&CatchRemoval ( rCarrier, Removal, wsp );
  399. ⓪&RETURN TRUE
  400. ⓪$END;
  401. ⓪"END InitModule;
  402. ⓪ 
  403. ⓪ BEGIN
  404. ⓪"IF NOT InitModule() THEN
  405. ⓪$OutOfMemory
  406. ⓪"END
  407. ⓪ END ResHandler.
  408. ⓪ ə
  409. (* $FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6EÇ$000004D3T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00001598$00002542$000013FE$0000005A$000004AF$000004C5$000004D3$FFEE2C3C$000020BE$00001FD2$00001949$0000197F$00001859$00001B59$00001759$00001763£Çé*)
  410.