← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcdocs/linuxex/ex71.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcdocs/linuxex/ex71.pp
 
1
program TestC{lone};
 
2
 
 
3
{$ifdef Linux}
 
4
// close is very Linux specific. 1.9.x threading is done via pthreads.
 
5
 
 
6
uses
 
7
  Linux, Errors, crt;
 
8
 
 
9
const
 
10
  Ready : Boolean = false;
 
11
  aChar : Char    = 'a';
 
12
 
 
13
function CloneProc( Arg: Pointer ): LongInt; Cdecl;
 
14
begin
 
15
  WriteLn('Hello from the clone ',PChar(Arg));
 
16
  repeat
 
17
    Write(aChar);
 
18
    Select(0,0,0,0,600);
 
19
  until Ready;
 
20
  WriteLn( 'Clone finished.');
 
21
  CloneProc := 1;
 
22
end;
 
23
 
 
24
var
 
25
  PID : LongInt;
 
26
 
 
27
procedure MainProc;
 
28
begin
 
29
  WriteLn('cloned process PID: ', PID );
 
30
  WriteLn('Press <ESC> to kill ... ' );
 
31
  repeat
 
32
    Write('.');
 
33
    Select(0,0,0,0,300);
 
34
    if KeyPressed then
 
35
      case ReadKey of
 
36
        #27: Ready := true;
 
37
        'a': aChar := 'A';
 
38
        'A': aChar := 'a';
 
39
        'b': aChar := 'b';
 
40
        'B': aChar := 'B';
 
41
      end;
 
42
  until Ready;
 
43
  WriteLn('Ready.');
 
44
end;
 
45
 
 
46
const
 
47
  StackSze = 16384;
 
48
  theFlags = CLONE_VM+CLONE_FS+CLONE_FILES+CLONE_SIGHAND;
 
49
  aMsg     : PChar = 'Oops !';
 
50
 
 
51
var
 
52
  theStack : Pointer;
 
53
  ExitStat : LongInt;
 
54
 
 
55
begin
 
56
  GetMem(theStack,StackSze);
 
57
  PID := Clone(@CloneProc,
 
58
               Pointer( LongInt(theStack)+StackSze),
 
59
               theFlags,
 
60
               aMsg);
 
61
  if PID < 0 then
 
62
    WriteLn('Error : ', LinuxError, ' when cloning.')
 
63
  else
 
64
    begin
 
65
    MainProc;
 
66
    case WaitPID(0,@ExitStat,Wait_Untraced or wait_clone) of
 
67
      -1: WriteLn('error:',LinuxError,'; ',StrError(LinuxError));
 
68
       0: WriteLn('error:',LinuxError,'; ',StrError(LinuxError));
 
69
    else
 
70
      WriteLn('Clone exited with: ',ExitStat shr 8);
 
71
    end;
 
72
    end;
 
73
  FreeMem( theStack, StackSze );
 
74
{$else}
 
75
begin
 
76
{$endif}
 
77
end.
 
 
b'\\ No newline at end of file'