* 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:
pierre 2017-05-19 22:01:12 +00:00
parent 9787c5dd82
commit 50e5256f8e
3 changed files with 93 additions and 7 deletions

View File

@ -755,6 +755,8 @@ end;
procedure SwapVectors;
begin
SwapIntVec(0, SaveInt00);
SwapIntVec($10, SaveInt10);
SwapIntVec($75, SaveInt75);
end;

View File

@ -1,5 +1,6 @@
unit System;
interface
{ The heap for MSDOS is implemented
@ -123,7 +124,6 @@ var
__nearheap_start: pointer;public name '__nearheap_start';
__nearheap_end: pointer;public name '__nearheap_end';
dos_version:Word;public name 'dos_version';
envp:PPFarChar;public name '__fpc_envp';
dos_env_count:smallint;public name '__dos_env_count';
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';
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 tinyheap.inc}
@ -186,6 +254,9 @@ end;
ParamStr/Randomize
*****************************************************************************}
var
internal_envp : PPFarChar = nil;
procedure setup_environment;
var
env_count : smallint;
@ -201,18 +272,18 @@ begin
inc(cp); { skip to NUL }
inc(cp); { skip to next character }
end;
envp := getmem((env_count+1) * sizeof(PFarChar));
internal_envp := getmem((env_count+1) * sizeof(PFarChar));
cp:=dos_env;
env_count:=0;
while cp^<>#0 do
begin
envp[env_count] := cp;
internal_envp[env_count] := cp;
inc(env_count);
while (cp^ <> #0) do
inc(cp); { skip to NUL }
inc(cp); { skip to next character }
end;
envp[env_count]:=nil;
internal_envp[env_count]:=nil;
dos_env_count := env_count;
if dos_version >= $300 then
begin
@ -225,6 +296,13 @@ begin
dos_argv0 := nil;
end;
function envp:PPFarChar;public name '__fpc_envp';
begin
if not assigned(internal_envp) then
setup_environment;
envp:=internal_envp;
end;
procedure setup_arguments;
var
@ -429,12 +507,16 @@ end;
function paramcount : longint;
begin
if argv=nil then
setup_arguments;
paramcount := argc - 1;
end;
function paramstr(l : longint) : string;
begin
if argv=nil then
setup_arguments;
if (l>=0) and (l+1<=argc) then
paramstr:=strpas(argv[l])
else
@ -560,8 +642,8 @@ begin
{ Setup stdin, stdout and stderr }
SysInitStdIO;
{ Setup environment and arguments }
Setup_Environment;
Setup_Arguments;
{ Done on request only Setup_Environment; }
{ Done on request only Setup_Arguments; }
{$ifndef RTLLITE}
{ Use LFNSupport LFN }
LFNSupport:=CheckLFN;

View File

@ -57,9 +57,11 @@ type
PFarChar=^Char;far;
PPFarChar=^PFarChar;
var
envp:PPFarChar;external name '__fpc_envp';
dos_env_count:smallint;external name '__dos_env_count';
{ This is implemented inside system unit }
function envp:PPFarChar;external name '__fpc_envp';
{****************************************************************************
File Functions