← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to rtl/netbsd/unixsysc.inc

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
http://bugs.debian.org/265265
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/netbsd/unixsysc.inc
 
1
{
 
2
   $Id: unixsysc.inc,v 1.7 2004/03/04 13:10:30 olle Exp $
 
3
   This file is part of the Free Pascal run time library.
 
4
   Copyright (c) 2000 by Marco van de Voort
 
5
     member of the Free Pascal development team.
 
6
 
 
7
   See the file COPYING.FPC, included in this distribution,
 
8
   for details about the copyright.
 
9
 
 
10
   This program is distributed in the hope that it will be useful,
 
11
   but WITHOUT ANY WARRANTY;without even the implied warranty of
 
12
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
13
 
 
14
**********************************************************************}
 
15
 
 
16
{
 
17
function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
 
18
{NOT IMPLEMENTED YET UNDER BSD}
 
19
begin // perhaps it is better to implement the hack from solaris then this msg
 
20
 HALT;
 
21
END;
 
22
 
 
23
  if (pointer(func)=nil) or (sp=nil) then
 
24
   begin
 
25
     Lfpseterrno(EsysEInval);
 
26
     exit(-1);
 
27
   end;
 
28
  asm
 
29
        { Insert the argument onto the new stack. }
 
30
        movl    sp,%ecx
 
31
        subl    $8,%ecx
 
32
        movl    args,%eax
 
33
        movl    %eax,4(%ecx)
 
34
 
 
35
        { Save the function pointer as the zeroth argument.
 
36
          It will be popped off in the child in the ebx frobbing below. }
 
37
        movl    func,%eax
 
38
        movl    %eax,0(%ecx)
 
39
 
 
40
        { Do the system call }
 
41
        pushl   %ebx
 
42
        pushl   %ebx
 
43
      //  movl    flags,%ebx
 
44
        movl    $251,%eax
 
45
        int     $0x80
 
46
        popl    %ebx
 
47
        popl    %ebx
 
48
        test    %eax,%eax
 
49
        jnz     .Lclone_end
 
50
 
 
51
        { We're in the new thread }
 
52
        subl    %ebp,%ebp       { terminate the stack frame }
 
53
        call    *%ebx
 
54
        { exit process }
 
55
        movl    %eax,%ebx
 
56
        movl    $1,%eax
 
57
        int     $0x80
 
58
 
 
59
.Lclone_end:
 
60
        movl    %eax,__RESULT
 
61
  end;
 
62
end;
 
63
}
 
64
 
 
65
{$ifndef FPC_USE_LIBC}
 
66
Function  fsync (fd : cint) : cint;
 
67
 
 
68
begin
 
69
  fsync:=do_syscall(syscall_nr_fsync,fd);
 
70
end;
 
71
 
 
72
Function  Flock (fd,mode : longint) : cint;
 
73
 
 
74
begin
 
75
 Flock:=do_syscall(syscall_nr_flock,fd,mode);
 
76
end;
 
77
 
 
78
Function fStatFS(Fd:Longint;Var Info:tstatfs):cint;
 
79
{
 
80
  Get all information on a fileSystem, and return it in Info.
 
81
  Fd is the file descriptor of a file/directory on the fileSystem
 
82
  you wish to investigate.
 
83
}
 
84
 
 
85
begin
 
86
 fStatFS:=do_syscall(syscall_nr_fstatfs,fd,longint(@info));
 
87
end;
 
88
 
 
89
Function StatFS(path:pchar;Var Info:tstatfs):cint;
 
90
{
 
91
  Get all information on a fileSystem, and return it in Info.
 
92
  Fd is the file descriptor of a file/directory on the fileSystem
 
93
  you wish to investigate.
 
94
}
 
95
 
 
96
begin
 
97
 StatFS:=do_syscall(syscall_nr_statfs,longint(path),longint(@info));
 
98
end;
 
99
 
 
100
// needs oldfpccall;
 
101
Function intAssignPipe(var pipe_in,pipe_out:longint;var errn:cint):cint; {$ifndef ver1_0} oldfpccall;{$endif} 
 
102
{
 
103
  Sets up a pair of file variables, which act as a pipe. The first one can
 
104
  be read from, the second one can be written to.
 
105
  If the operation was unsuccesful, linuxerror is set.
 
106
}
 
107
 
 
108
begin
 
109
{$ifdef cpui386}
 
110
 asm
 
111
   mov $42,%eax
 
112
   int $0x80
 
113
   jb .Lerror
 
114
   mov pipe_in,%ebx
 
115
   mov %eax,(%ebx)
 
116
   mov pipe_out,%ebx
 
117
   mov $0,%eax
 
118
   mov %edx,(%ebx)
 
119
   mov %eax,%ebx
 
120
   jmp .Lexit
 
121
.Lerror:
 
122
   mov %eax,%ebx
 
123
   mov $-1,%eax
 
124
.Lexit:
 
125
   mov Errn,%edx
 
126
   mov %ebx,(%edx)
 
127
 end;
 
128
{$endif}
 
129
end;
 
130
 
 
131
 
 
132
Function PClose(Var F:text) :cint;
 
133
var
 
134
  pl  : ^longint;
 
135
  res : longint;
 
136
 
 
137
begin
 
138
  do_syscall(syscall_nr_close,Textrec(F).Handle);
 
139
{ closed our side, Now wait for the other - this appears to be needed ?? }
 
140
  pl:=@(textrec(f).userdata[2]);
 
141
  fpwaitpid(pl^,@res,0);
 
142
  pclose:=res shr 8;
 
143
end;
 
144
 
 
145
Function PClose(Var F:file) : cint;
 
146
var
 
147
  pl : ^cint;
 
148
  res : cint;
 
149
 
 
150
begin
 
151
  do_syscall(syscall_nr_close,filerec(F).Handle);
 
152
{ closed our side, Now wait for the other - this appears to be needed ?? }
 
153
  pl:=@(filerec(f).userdata[2]);
 
154
  fpwaitpid(pl^,@res,0);
 
155
  pclose:=res shr 8;
 
156
end;
 
157
 
 
158
function MUnMap (P : Pointer; Size : size_t) : cint;
 
159
 
 
160
begin
 
161
  MUnMap:=do_syscall(syscall_nr_munmap,longint(P),Size);
 
162
end;
 
163
{$else}
 
164
 
 
165
Function PClose(Var F:file) : cint;
 
166
var
 
167
  pl : ^cint;
 
168
  res : cint;
 
169
 
 
170
begin
 
171
  fpclose(filerec(F).Handle);
 
172
{ closed our side, Now wait for the other - this appears to be needed ?? }
 
173
  pl:=@(filerec(f).userdata[2]);
 
174
  fpwaitpid(pl^,@res,0);
 
175
  pclose:=res shr 8;
 
176
end;
 
177
 
 
178
Function PClose(Var F:text) :cint;
 
179
var
 
180
  pl  : ^longint;
 
181
  res : longint;
 
182
 
 
183
begin
 
184
  fpclose(Textrec(F).Handle);
 
185
{ closed our side, Now wait for the other - this appears to be needed ?? }
 
186
  pl:=@(textrec(f).userdata[2]);
 
187
  fpwaitpid(pl^,@res,0);
 
188
  pclose:=res shr 8;
 
189
end;
 
190
 
 
191
{$endif}
 
192
// can't have oldfpccall here, linux doesn't need it.
 
193
Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
 
194
{
 
195
  Sets up a pair of file variables, which act as a pipe. The first one can
 
196
  be read from, the second one can be written to.
 
197
  If the operation was unsuccesful, linuxerror is set.
 
198
}
 
199
var
 
200
  ret  : longint;
 
201
  errn : cint;
 
202
  {$ifdef FPC_USE_LIBC}
 
203
   fdis : array[0..1] of cint;
 
204
  {$endif}
 
205
begin
 
206
{$ifndef FPC_USE_LIBC}
 
207
 ret:=intAssignPipe(pipe_in,pipe_out,errn);
 
208
 if ret=-1 Then
 
209
  fpseterrno(errn);
 
210
{$ELSE}
 
211
 fdis[0]:=pipe_in;
 
212
 fdis[1]:=pipe_out;
 
213
 ret:=pipe(fdis);
 
214
 pipe_in:=fdis[0];
 
215
 pipe_out:=fdis[1];
 
216
{$ENDIF}
 
217
 AssignPipe:=ret;
 
218
end;
 
219
 
 
220
 
 
221
{
 
222
function  intClone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint; {$ifndef ver1_0} oldfpccall; {$endif}
 
223
 
 
224
 
 
225
var lerrno : Longint;
 
226
    errset : Boolean;
 
227
    Res    : Longint;   
 
228
begin
 
229
  errset:=false;
 
230
  Res:=0;
 
231
asm
 
232
        pushl   %esi
 
233
        movl    12(%ebp), %esi  // get stack addr
 
234
        subl    $4, %esi
 
235
        movl    20(%ebp), %eax  // get __arg
 
236
        movl    %eax, (%esi)
 
237
        subl    $4, %esi
 
238
        movl    8(%ebp), %eax   // get __fn
 
239
        movl    %eax, (%esi)
 
240
        pushl   16(%ebp)
 
241
        pushl   %esi
 
242
        mov     syscall_nr_rfork, %eax
 
243
        int     $0x80                  // call actualsyscall
 
244
        jb      .L2
 
245
        test    %edx, %edx
 
246
        jz      .L1
 
247
        movl    %esi,%esp
 
248
        popl    %eax
 
249
        call    %eax
 
250
        addl    $8, %esp
 
251
        call    halt            // Does not return
 
252
.L2:
 
253
        mov     %eax,LErrNo
 
254
        mov     $true,Errset
 
255
        mov     $-1,%eax
 
256
//        jmp     .L1
 
257
.L1:
 
258
        addl    $8, %esp
 
259
        popl    %esi
 
260
        mov     %eax,Res
 
261
end;
 
262
  If ErrSet Then
 
263
   fpSetErrno(LErrno);
 
264
  intClone:=Res; 
 
265
end;
 
266
 
 
267
 
 
268
 
 
269
function  Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint; 
 
270
 
 
271
begin
 
272
  Clone:=
 
273
        intclone(tclonefunc(func),sp,flags,args);
 
274
end;
 
275
}
 
276
 
 
277
 
 
278
{
 
279
  $Log: unixsysc.inc,v $
 
280
  Revision 1.7  2004/03/04 13:10:30  olle
 
281
    + added comment to ETXTBSY
 
282
    * changed i386 -> cpui386, m68k -> cpum68k
 
283
 
 
284
  Revision 1.6  2004/01/04 15:55:47  marco
 
285
   * additions
 
286
 
 
287
  Revision 1.5  2004/01/04 01:11:28  marco
 
288
   * a new qod port of the freebsd rtl. To be refined in the coming days.
 
289
 
 
290
  Revision 1.18  2004/01/01 17:07:21  marco
 
291
   * few small freebsd fixes backported from debugging linux
 
292
 
 
293
  Revision 1.17  2003/12/30 12:32:30  marco
 
294
  *** empty log message ***
 
295
 
 
296
  Revision 1.16  2003/11/19 17:11:40  marco
 
297
   * termio unit
 
298
 
 
299
  Revision 1.15  2003/11/19 10:12:02  marco
 
300
   * more cleanups
 
301
 
 
302
  Revision 1.14  2003/11/17 10:05:51  marco
 
303
   * threads for FreeBSD. Not working tho
 
304
 
 
305
  Revision 1.13  2003/11/14 16:21:59  marco
 
306
   * linuxerror elimination
 
307
 
 
308
  Revision 1.12  2003/11/09 12:00:16  marco
 
309
   * pipe fix
 
310
 
 
311
  Revision 1.11  2003/09/20 12:38:29  marco
 
312
   * FCL now compiles for FreeBSD with new 1.1. Now Linux.
 
313
 
 
314
  Revision 1.10  2003/09/15 20:08:49  marco
 
315
   * small fixes. FreeBSD now cycles
 
316
 
 
317
  Revision 1.9  2003/09/15 07:09:58  marco
 
318
   * small fixes, round 1
 
319
 
 
320
  Revision 1.8  2003/09/14 20:15:01  marco
 
321
   * Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
 
322
 
 
323
  Revision 1.7  2003/01/05 19:02:29  marco
 
324
   * Should now work with baseunx. (gmake all works)
 
325
 
 
326
  Revision 1.6  2002/10/18 12:19:59  marco
 
327
   * Fixes to get the generic *BSD RTL compiling again + fixes for thread
 
328
     support. Still problems left in fexpand. (inoutres?) Therefore fixed
 
329
     sysposix not yet commited
 
330
 
 
331
  Revision 1.5  2002/09/07 16:01:18  peter
 
332
    * old logs removed and tabs fixed
 
333
 
 
334
  Revision 1.4  2002/05/06 09:35:09  marco
 
335
   * Some stuff from 1.0.x ported
 
336
 
 
337
}