Category : Pascal Source Code
Archive   : CMP25D.ZIP
Filename : RSCTEST.PAS

{$I cpmswitc.inc}

{--------------------------------------------------------------------------

RSCTEST.PAS (Program for testing the resource functions)

This program requires the CPMULTI Multitasking Toolkit and Turbo Pascal
5.0 or later.

January 1994

Copyright (C) 1994 (USA) Copyright (C) 1989-1994
Hypermetrics Christian Philipps Software-Technik
PO Box 9700 Suite 363 Duesseldorfer Str. 316
Austin, TX 78758-9700 D-47447 Moers
Germany

This program demonstrates the basic use of the resource functions
in the CPMulti kernel.

---------------------------------------------------------------------------}

program RscTest;

uses Dos, Crt, CpMulti;

var ScreenRsc : Pointer;

{----------------------------------------------------------------------}

procedure Recurse(Txt:String;Depth:Byte);

{ For demonstration purposes the resource in this procedure ??
recursion. So long as the owner absetzt the wiederholten call,
this will not lead to a block. The concurrency is ausgeschaltet,
until the end of further recursion is reached; therefore no more
screen output is get„tigt.
}

begin
if Depth = 0 then
begin
if ReleaseRsc(ScreenRsc) <> Rsc_OK then
Writeln('Recurse: Error in ReleaseRsc!');
Exit;
end;
if RequestRsc(ScreenRsc,Wait) <> Rsc_OK then
Writeln('Recurse: Error in RequestRsc!');
Writeln(Txt,' Depth ',Depth);
Sleep(1);
Recurse(Txt,Depth-1);
end;

{-----------------------------------------------------------------------------}

{$F+}
procedure SubTask(P:Pointer);

begin
Recurse('Sub:',5);
Recurse('Sub:',5);
Recurse('Sub:',5);
end;
{$F-}

{-----------------------------------------------------------------------------}

begin
ClrScr;
if CreateRsc(ScreenRsc) <> Rsc_OK then
begin
Writeln('Error in CreateRsc!');
Halt(1);
end;
if CreateTask(SubTask,NIL,Pri_User,2000) < 0 then
begin
Writeln('Error in CreateTask!');
Halt(1);
end;
Sleep(1);
Recurse('Main:',5);
Recurse('Main:',5);
Recurse('Main:',5);
end.