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

* smartlinking the units works now

Browse Source 
* setjmp/longjmp -> dmpi_setjmp/dpmi_longjmp to solve systemunit
    conflict
This commit is contained in:
peter 1998-08-15 17:01:13 +00:00
parent b2e9bb2cf5
commit a16e265f27
2 changed files with 917 additions and 1031 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

889
rtl/dos/go32v2/dpmiexcp.pp
View File

File diff suppressed because it is too large Load Diff

189
rtl/dos/go32v2/emu387.pp
View File

@ -1,8 +1,9 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1993,97 by Pierre Muller,
member of the Free Pascal development team.
Copyright (c) 1996-98 by Pierre Muller
FPU Emulator support
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -12,36 +13,27 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ Translated to FPK pascal by Pierre Muller,
without changing the fpu.s file }
{
/* Copyright (C) 1994, 1995 Charles Sandmann (sandmann@clio.rice.edu)
* FPU setup and emulation hooks for DJGPP V2.0
* This file maybe freely distributed, no warranty. */
this file has been translated from
npxsetup.c }
unit emu387;
interface
interface
procedure npxsetup(prog_name : string);
procedure npxsetup(prog_name : string);
implementation
implementation
uses dxeload, dpmiexcp, strings;
uses
dxeload,dpmiexcp,strings;
type
type
emu_entry_type = function(exc : pexception_state) : longint;
var
var
_emu_entry : emu_entry_type;
procedure _control87(mask1,mask2 : word);
begin
{/* Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details */}
procedure _control87(mask1,mask2 : word);
begin
{ Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details }
{ from file cntrl87.s in src/libc/pc_hw/fpu }
asm
{ make room on stack }
@ -64,21 +56,22 @@ unit emu387;
fldcw (%esp)
popl %edx
end;
end;
end;
{ the problem with the stack that is not cleared }
function emu_entry(exc : pexception_state) : longint;
begin
{ the problem with the stack that is not cleared }
function emu_entry(exc : pexception_state) : longint;
begin
emu_entry:=_emu_entry(exc);
end;
end;
function nofpsig( sig : longint) : longint;
var res : longint;
const
function nofpsig( sig : longint) : longint;
const
last_eip : longint = 0;
begin
var
res : longint;
begin
{if last_eip=djgpp_exception_state^.__eip then
begin
writeln('emu call two times at same address');
@ -86,7 +79,6 @@ unit emu387;
_raise(SIGFPE);
exit(0);
end; }
last_eip:=djgpp_exception_state^.__eip;
res:=emu_entry(djgpp_exception_state);
if res<>0 then
@ -96,35 +88,38 @@ unit emu387;
_raise(SIGFPE);
exit(0);
end;
longjmp(pjmprec(djgpp_exception_state)^, djgpp_exception_state^.__eax);
dpmi_longjmp(pdpmi_jmp_buf(djgpp_exception_state)^, djgpp_exception_state^.__eax);
nofpsig:=0;
end;
end;
var
var
prev_exit : pointer;
procedure restore_DPMI_fpu_state;
begin
procedure restore_DPMI_fpu_state;
begin
exitproc:=prev_exit;
{ Enable Coprocessor, no exceptions }
dpmi_set_coprocessor_emulation(1);
{$ifdef SYSTEMDEBUG}
writeln('Coprocessor restored ');
{/* Enable Coprocessor, no exceptions */}
end;
{$endif}
end;
{ function _detect_80387 : boolean;[C];
{ function _detect_80387 : boolean;
not used because of the underscore problem }
{$L fpu.o }
function getenv(const envvar:string):string;
{ Copied here, preserves uses Dos (PFV) }
var
function getenv(const envvar:string):string;
{ Copied here, preserves uses Dos (PFV) }
var
hp : ppchar;
hs,
_envvar : string;
eqpos,i : longint;
begin
eqpos : longint;
begin
_envvar:=upcase(envvar);
hp:=envp;
getenv:='';
@ -139,19 +134,18 @@ unit emu387;
end;
hp:=hp+4;
end;
end;
end;
procedure npxsetup(prog_name : string);
var
procedure npxsetup(prog_name : string);
var
cp : string;
i : byte;
have_80387 : boolean;
emu_p : pointer;
const
const
veryfirst : boolean = True;
begin
begin
cp:=getenv('387');
if (length(cp)>0) and (upcase(cp[1])='N') then
have_80387:=False
@ -171,11 +165,13 @@ unit emu387;
end;
if have_80387 then
{/* mask all exceptions, except invalid operation */}
begin
{ mask all exceptions, except invalid operation }
_control87($033e, $ffff)
end
else
begin
{/* Flags value 3 means coprocessor emulation, exceptions to us */}
{ Flags value 3 means coprocessor emulation, exceptions to us }
if (dpmi_set_coprocessor_emulation(3)<>0) then
begin
writeln(stderr,'Warning: Coprocessor not present and DPMI setup failed!');
@ -209,94 +205,21 @@ unit emu387;
signal(SIGNOFP,@nofpsig);
end;
end;
end;
end;
begin
npxsetup(paramstr(0));
end.
{
$Log$
Revision 1.7 1998-07-22 21:37:51 michael
Revision 1.8 1998-08-15 17:01:14 peter
* smartlinking the units works now
* setjmp/longjmp -> dmpi_setjmp/dpmi_longjmp to solve systemunit
conflict
Revision 1.7 1998/07/22 21:37:51 michael
+ ENViron unknow, replaced by envp
Revision 1.6 1998/07/21 12:06:56 carl
* restored working version
Revision 1.2 1998/03/26 12:23:17 peter
* emu387 doesn't uses dos anymore (getenv copied local)
* makefile compilation order changed
Revision 1.1.1.1 1998/03/25 11:18:42 root
* Restored version
Revision 1.6 1998/03/18 15:34:46 pierre
+ fpu state is restaured in excep_exit
less risk of problems
Revision 1.5 1998/02/05 17:24:09 pierre
* bug in assembler code
* changed default name to wmemu387.dxe
Revision 1.4 1998/02/05 17:04:59 pierre
* emulation is working with wmemu387.dxe
Revision 1.3 1998/01/26 11:57:34 michael
+ Added log at the end
Revision 1.2 1998/01/19 17:04:40 pierre
* bug in dxe loading corrected, emu still does not work !!
Revision 1.1 1998/01/16 16:53:15 pierre
emu387 is a program based on npxset from DJGPP
that loads the emu387.dxe if no FPU is present
or if the env var 387 is set to N
}
{
$Log$
Revision 1.7 1998-07-22 21:37:51 michael
+ ENViron unknow, replaced by envp
Revision 1.6 1998/07/21 12:06:56 carl
* restored working version
Revision 1.2 1998/03/26 12:23:17 peter
* emu387 doesn't uses dos anymore (getenv copied local)
* makefile compilation order changed
Revision 1.1.1.1 1998/03/25 11:18:42 root
* Restored version
Revision 1.6 1998/03/18 15:34:46 pierre
+ fpu state is restaured in excep_exit
less risk of problems
Revision 1.5 1998/02/05 17:24:09 pierre
* bug in assembler code
* changed default name to wmemu387.dxe
Revision 1.4 1998/02/05 17:04:59 pierre
* emulation is working with wmemu387.dxe
Revision 1.3 1998/01/26 11:57:34 michael
+ Added log at the end
Working file: rtl/dos/go32v2/emu387.pp
description:
----------------------------
revision 1.2
date: 1998/01/19 17:04:40; author: pierre; state: Exp; lines: +11 -2
* bug in dxe loading corrected, emu still does not work !!
----------------------------
revision 1.1
date: 1998/01/16 16:53:15; author: pierre; state: Exp;
emu387 is a program based on npxset from DJGPP
that loads the emu387.dxe if no FPU is present
or if the env var 387 is set to N
=============================================================================
}