mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 14:09:17 +02:00
* system.pp:
+ Add MSDOS specific version of SysInitFPU, using Get/SetInterrput Vectors to test coprocessor presence. * Do not call SetupEnvironment in startup code. + Add internal_envp variable (nil by default). + Change envp to function, which calls SetUpEnvironment, if internal_envp is nil. * Do not call SetupArguments at startup, instead call it from inside paramcount or paramstr + Add SaveInt10 and SavdeInt75 * dos.pp: Also swap Interrupt vectors $10 and $75 * sysutils.pp: Adapt to envp change in system unit. git-svn-id: trunk@36268 -
This commit is contained in:
parent
9787c5dd82
commit
50e5256f8e
@ -755,6 +755,8 @@ end;
|
|||||||
procedure SwapVectors;
|
procedure SwapVectors;
|
||||||
begin
|
begin
|
||||||
SwapIntVec(0, SaveInt00);
|
SwapIntVec(0, SaveInt00);
|
||||||
|
SwapIntVec($10, SaveInt10);
|
||||||
|
SwapIntVec($75, SaveInt75);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,5 +1,6 @@
|
|||||||
unit System;
|
unit System;
|
||||||
|
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
{ The heap for MSDOS is implemented
|
{ The heap for MSDOS is implemented
|
||||||
@ -123,7 +124,6 @@ var
|
|||||||
__nearheap_start: pointer;public name '__nearheap_start';
|
__nearheap_start: pointer;public name '__nearheap_start';
|
||||||
__nearheap_end: pointer;public name '__nearheap_end';
|
__nearheap_end: pointer;public name '__nearheap_end';
|
||||||
dos_version:Word;public name 'dos_version';
|
dos_version:Word;public name 'dos_version';
|
||||||
envp:PPFarChar;public name '__fpc_envp';
|
|
||||||
dos_env_count:smallint;public name '__dos_env_count';
|
dos_env_count:smallint;public name '__dos_env_count';
|
||||||
dos_argv0 : PFarChar;public name '__fpc_dos_argv0';
|
dos_argv0 : PFarChar;public name '__fpc_dos_argv0';
|
||||||
|
|
||||||
@ -142,6 +142,74 @@ procedure RestoreInterruptHandlers; external name 'FPC_RESTORE_INTERRUPT_HANDLER
|
|||||||
|
|
||||||
function CheckNullArea: Boolean; external name 'FPC_CHECK_NULLAREA';
|
function CheckNullArea: Boolean; external name 'FPC_CHECK_NULLAREA';
|
||||||
|
|
||||||
|
|
||||||
|
var
|
||||||
|
test_fpu_jmpbuf : jmp_buf;
|
||||||
|
|
||||||
|
Procedure InterceptInvalidInstruction;
|
||||||
|
begin
|
||||||
|
longjmp(test_fpu_jmpbuf, 1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Use msdos int21 set/get Interrupt address
|
||||||
|
to check if coprocessor is present }
|
||||||
|
|
||||||
|
{$define FPC_SYSTEM_HAS_SYSINITFPU}
|
||||||
|
Procedure SysInitFPU;
|
||||||
|
var
|
||||||
|
{ these locals are so we don't have to hack pic code in the assembler }
|
||||||
|
localfpucw: word;
|
||||||
|
prevInt06 : FarPointer;
|
||||||
|
begin
|
||||||
|
localfpucw:=Default8087CW;
|
||||||
|
asm
|
||||||
|
fninit
|
||||||
|
fldcw localfpucw
|
||||||
|
fwait
|
||||||
|
end;
|
||||||
|
asm
|
||||||
|
push es
|
||||||
|
push ds
|
||||||
|
{ Get previous interrupt 06 handler }
|
||||||
|
mov ax, $3506
|
||||||
|
int $21
|
||||||
|
mov word [prevInt06],bx
|
||||||
|
mov dx,es
|
||||||
|
mov word [prevInt06+2],dx
|
||||||
|
{ Install local interrupt 06 handler }
|
||||||
|
mov dx, SEG InterceptInvalidInstruction
|
||||||
|
mov ds, dx
|
||||||
|
mov dx, Offset InterceptInvalidInstruction
|
||||||
|
mov ax, $2506
|
||||||
|
int $21
|
||||||
|
pop ds
|
||||||
|
pop es
|
||||||
|
end;
|
||||||
|
if setjmp(test_fpu_jmpbuf)=0 then
|
||||||
|
begin
|
||||||
|
asm
|
||||||
|
db $0f, $20, $c0 { mov eax,cr0 }
|
||||||
|
db $83, $c8, $20 { or $0x20,eax }
|
||||||
|
db $0f, $22, $c0 { mov cr0,eax }
|
||||||
|
end;
|
||||||
|
//writeln(stderr,'Change of cr0 succeeded');
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
//writeln(stderr,'Change of cr0 failed');
|
||||||
|
end;
|
||||||
|
{ Restore previous interrupt 06 handler }
|
||||||
|
asm
|
||||||
|
push es
|
||||||
|
mov bx,word [prevInt06]
|
||||||
|
mov dx,word [prevInt06+2]
|
||||||
|
mov es,dx
|
||||||
|
mov ax, $2506
|
||||||
|
int $21
|
||||||
|
pop es
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
{$I system.inc}
|
{$I system.inc}
|
||||||
|
|
||||||
{$I tinyheap.inc}
|
{$I tinyheap.inc}
|
||||||
@ -186,6 +254,9 @@ end;
|
|||||||
ParamStr/Randomize
|
ParamStr/Randomize
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
|
|
||||||
|
var
|
||||||
|
internal_envp : PPFarChar = nil;
|
||||||
|
|
||||||
procedure setup_environment;
|
procedure setup_environment;
|
||||||
var
|
var
|
||||||
env_count : smallint;
|
env_count : smallint;
|
||||||
@ -201,18 +272,18 @@ begin
|
|||||||
inc(cp); { skip to NUL }
|
inc(cp); { skip to NUL }
|
||||||
inc(cp); { skip to next character }
|
inc(cp); { skip to next character }
|
||||||
end;
|
end;
|
||||||
envp := getmem((env_count+1) * sizeof(PFarChar));
|
internal_envp := getmem((env_count+1) * sizeof(PFarChar));
|
||||||
cp:=dos_env;
|
cp:=dos_env;
|
||||||
env_count:=0;
|
env_count:=0;
|
||||||
while cp^<>#0 do
|
while cp^<>#0 do
|
||||||
begin
|
begin
|
||||||
envp[env_count] := cp;
|
internal_envp[env_count] := cp;
|
||||||
inc(env_count);
|
inc(env_count);
|
||||||
while (cp^ <> #0) do
|
while (cp^ <> #0) do
|
||||||
inc(cp); { skip to NUL }
|
inc(cp); { skip to NUL }
|
||||||
inc(cp); { skip to next character }
|
inc(cp); { skip to next character }
|
||||||
end;
|
end;
|
||||||
envp[env_count]:=nil;
|
internal_envp[env_count]:=nil;
|
||||||
dos_env_count := env_count;
|
dos_env_count := env_count;
|
||||||
if dos_version >= $300 then
|
if dos_version >= $300 then
|
||||||
begin
|
begin
|
||||||
@ -225,6 +296,13 @@ begin
|
|||||||
dos_argv0 := nil;
|
dos_argv0 := nil;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function envp:PPFarChar;public name '__fpc_envp';
|
||||||
|
begin
|
||||||
|
if not assigned(internal_envp) then
|
||||||
|
setup_environment;
|
||||||
|
envp:=internal_envp;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure setup_arguments;
|
procedure setup_arguments;
|
||||||
var
|
var
|
||||||
@ -429,12 +507,16 @@ end;
|
|||||||
|
|
||||||
function paramcount : longint;
|
function paramcount : longint;
|
||||||
begin
|
begin
|
||||||
|
if argv=nil then
|
||||||
|
setup_arguments;
|
||||||
paramcount := argc - 1;
|
paramcount := argc - 1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function paramstr(l : longint) : string;
|
function paramstr(l : longint) : string;
|
||||||
begin
|
begin
|
||||||
|
if argv=nil then
|
||||||
|
setup_arguments;
|
||||||
if (l>=0) and (l+1<=argc) then
|
if (l>=0) and (l+1<=argc) then
|
||||||
paramstr:=strpas(argv[l])
|
paramstr:=strpas(argv[l])
|
||||||
else
|
else
|
||||||
@ -560,8 +642,8 @@ begin
|
|||||||
{ Setup stdin, stdout and stderr }
|
{ Setup stdin, stdout and stderr }
|
||||||
SysInitStdIO;
|
SysInitStdIO;
|
||||||
{ Setup environment and arguments }
|
{ Setup environment and arguments }
|
||||||
Setup_Environment;
|
{ Done on request only Setup_Environment; }
|
||||||
Setup_Arguments;
|
{ Done on request only Setup_Arguments; }
|
||||||
{$ifndef RTLLITE}
|
{$ifndef RTLLITE}
|
||||||
{ Use LFNSupport LFN }
|
{ Use LFNSupport LFN }
|
||||||
LFNSupport:=CheckLFN;
|
LFNSupport:=CheckLFN;
|
||||||
|
@ -57,9 +57,11 @@ type
|
|||||||
PFarChar=^Char;far;
|
PFarChar=^Char;far;
|
||||||
PPFarChar=^PFarChar;
|
PPFarChar=^PFarChar;
|
||||||
var
|
var
|
||||||
envp:PPFarChar;external name '__fpc_envp';
|
|
||||||
dos_env_count:smallint;external name '__dos_env_count';
|
dos_env_count:smallint;external name '__dos_env_count';
|
||||||
|
|
||||||
|
{ This is implemented inside system unit }
|
||||||
|
function envp:PPFarChar;external name '__fpc_envp';
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************
|
{****************************************************************************
|
||||||
File Functions
|
File Functions
|
||||||
|
Loading…
Reference in New Issue
Block a user