Browse Source

* 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 -

pierre 8 years ago
parent
commit
50e5256f8e
3 changed files with 93 additions and 7 deletions
  1. 2 0
      rtl/msdos/dos.pp
  2. 88 6
      rtl/msdos/system.pp
  3. 3 1
      rtl/msdos/sysutils.pp

+ 2 - 0
rtl/msdos/dos.pp

@@ -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;
 
 
 
 

+ 88 - 6
rtl/msdos/system.pp

@@ -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;
-  Setup_Arguments;
+  { Done on  request only Setup_Environment; }
+  { Done on request only Setup_Arguments; }
 {$ifndef RTLLITE}
 {$ifndef RTLLITE}
 { Use LFNSupport LFN }
 { Use LFNSupport LFN }
   LFNSupport:=CheckLFN;
   LFNSupport:=CheckLFN;

+ 3 - 1
rtl/msdos/sysutils.pp

@@ -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