home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpmult / demo / rsctest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-22  |  1.8 KB  |  70 lines
  1. {$R-,S-,I-,D-,F-,V-,B-,N-,L- }
  2. Program RscTest;
  3.  
  4. { Programm zum Testen der Resource-Funktionen
  5.   Christian Philipps Software-Technik
  6.   Stand: 4/90
  7. }
  8.  
  9. USES Dos, Crt, CpMulti;
  10.  
  11. VAR ScreenRsc : Pointer;
  12.  
  13. {-----------------------------------------------------------------------------}
  14.  
  15. PROCEDURE Recurse(Txt:String;Depth:Byte);
  16.  
  17. { Zu Demonstrationszwecken wird die Resource in dieser Prozedur je
  18.   Rekursion ein Mal angefordert. Solange der Eigentümer den wieder-
  19.   holten Aufruf absetzt, führt dies nicht zur Blockade.
  20.   Die Konkurrenz wird jedoch solange ausgeschaltet, bis das
  21.   Ende weiterer Rekursionen erreicht ist, also keine weiteren
  22.   Bildschirmausgaben getätigt werden.
  23. }
  24.  
  25. BEGIN {Recurse}
  26.   IF Depth = 0
  27.      THEN BEGIN
  28.             IF ReleaseRsc(ScreenRsc) <> Rsc_Ok
  29.                THEN Writeln('Recurse: Fehler bei ReleaseRsc');
  30.             Exit;
  31.           END;
  32.   IF RequestRsc(ScreenRsc,Wait) <> Rsc_Ok
  33.      THEN Writeln('Recurse: Fehler bei RequestRsc!');
  34.   Writeln(Txt,' Tiefe ',Depth);
  35.   Sleep(1);
  36.   Recurse(Txt,Depth-1);
  37. END;  {Recurse}
  38.  
  39. {-----------------------------------------------------------------------------}
  40.  
  41. {$F+}
  42. PROCEDURE SubTask(P:Pointer);
  43.  
  44. BEGIN {SubTask}
  45.   Recurse('Sub:',5);
  46.   Recurse('Sub:',5);
  47.   Recurse('Sub:',5);
  48. END;  {SubTask}
  49. {$F-}
  50.  
  51. {-----------------------------------------------------------------------------}
  52.  
  53. BEGIN {Main}
  54.   ClrScr;
  55.   IF CreateRsc(ScreenRsc) <> Rsc_Ok
  56.      THEN BEGIN
  57.             Writeln('Fehler bei CreateRsc');
  58.             Halt(1);
  59.           END;
  60.   IF CreateTask(SubTask,NIL,Pri_User,2000) < 0
  61.      THEN BEGIN
  62.             Writeln('Fehler bei CreateTask');
  63.             Halt(1);
  64.           END;
  65.   Sleep(1);
  66.   Recurse('Main:',5);
  67.   Recurse('Main:',5);
  68.   Recurse('Main:',5);
  69. END. {Main}
  70.