paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 04:49:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* changes for current rtl, basic MT support

Browse Source
This commit is contained in:
armin 2002-03-08 19:13:49 +00:00
parent e03cdd1f5c
commit 7a8510ef63
1 changed files with 640 additions and 592 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
rtl/netware/system.pp
View File

@ -15,11 +15,6 @@
{$S-} {$S-}
unit system; unit system;
{ 2000/09/03 armin: first version
2001/03/08 armin: changes for fpc 1.1
2001/04/16 armin: dummy envp for heaptrc-unit
}
interface interface
{$ifdef SYSTEMDEBUG} {$ifdef SYSTEMDEBUG}
@ -39,8 +34,8 @@ interface
{Why the hell do i have to define that ??? {Why the hell do i have to define that ???
otherwise FPC_FREEMEM expects 2 parameters but the compiler only otherwise FPC_FREEMEM expects 2 parameters but the compiler only
puhes the address} puhes the address}
{$DEFINE NEWMM} { DEFINE NEWMM}
{$I heaph.inc} { I heaph.inc}
{Platform specific information} {Platform specific information}
const const
@ -51,6 +46,21 @@ const
PathSeparator = ';'; PathSeparator = ';';
{ FileNameCaseSensitive is defined separately below!!! } { FileNameCaseSensitive is defined separately below!!! }
type
{ the fields of this record are os dependent }
{ and they shouldn't be used in a program }
{ only the type TCriticalSection is important }
TRTLCriticalSection = packed record
SemaHandle : LONGINT;
SemaIsOpen : BOOLEAN;
end;
{ include threading stuff }
{$i threadh.inc}
{ include heap support headers }
{$I heaph.inc}
CONST CONST
{ Default filehandles } { Default filehandles }
UnusedHandle : longint = -1; UnusedHandle : longint = -1;
@ -60,7 +70,7 @@ CONST
FileNameCaseSensitive : boolean = false; FileNameCaseSensitive : boolean = false;
sLineBreak : STRING [2] = LineEnding; sLineBreak : STRING = LineEnding;
DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF; DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
VAR VAR
@ -82,6 +92,8 @@ end;}
{ include system independent routines } { include system independent routines }
{$I system.inc} {$I system.inc}
{ some declarations for Netware API calls }
{$I nwsys.inc} {$I nwsys.inc}
{$I errno.inc} {$I errno.inc}
@ -112,13 +124,19 @@ BEGIN
END; END;
{$ifdef MT}
PROCEDURE CloseAllRemainingSemaphores; FORWARD;
{$endif}
{***************************************************************************** {*****************************************************************************
System Dependent Exit code System Dependent Exit code
*****************************************************************************} *****************************************************************************}
Procedure system_exit; Procedure system_exit;
begin begin
{ConsolePrintf ('system_exit called'#13#10,0);}
{$ifdef MT}
CloseAllRemainingSemaphores;
{$endif}
_exit (ExitCode); _exit (ExitCode);
end; end;
@ -541,20 +559,47 @@ begin
InOutRes := 1; InOutRes := 1;
end; end;
{*****************************************************************************
Thread Handling
*****************************************************************************}
const
fpucw : word = $1332;
procedure InitFPU;assembler;
asm
fninit
fldcw fpucw
end;
{ include threading stuff, this is os dependend part }
{$I thread.inc}
{***************************************************************************** {*****************************************************************************
SystemUnit Initialization SystemUnit Initialization
*****************************************************************************} *****************************************************************************}
Begin Begin
_EnterDebugger;
{$ifdef MT}
{ the exceptions use threadvars so do this _before_ initexceptions }
AllocateThreadVars;
{$endif MT}
{ Setup heap } { Setup heap }
InitHeap; InitHeap;
InitExceptions;
{ Setup stdin, stdout and stderr } { Setup stdin, stdout and stderr }
StdInputHandle := _fileno (LONGINT (_GetStdIn^)); // GetStd** returns **FILE ! StdInputHandle := _fileno (LONGINT (_GetStdIn^)); // GetStd** returns **FILE !
StdOutputHandle:= _fileno (LONGINT (_GetStdOut^)); StdOutputHandle:= _fileno (LONGINT (_GetStdOut^));
StdErrorHandle := _fileno (LONGINT (_GetStdErr^)); StdErrorHandle := _fileno (LONGINT (_GetStdErr^));
InitExceptions;
OpenStdIO(Input,fmInput,StdInputHandle); OpenStdIO(Input,fmInput,StdInputHandle);
OpenStdIO(Output,fmOutput,StdOutputHandle); OpenStdIO(Output,fmOutput,StdOutputHandle);
OpenStdIO(StdOut,fmOutput,StdOutputHandle); OpenStdIO(StdOut,fmOutput,StdOutputHandle);
@ -570,7 +615,10 @@ Begin
End. End.
{ {
$Log$ $Log$
Revision 1.5 2001-06-18 14:26:16 jonas Revision 1.6 2002-03-08 19:13:49 armin
* changes for current rtl, basic MT support
Revision 1.5 2001/06/18 14:26:16 jonas
* move platform independent constant declarations after inclusion of * move platform independent constant declarations after inclusion of
systemh.inc systemh.inc