From bd57e42086540e5b5aa25b13117917561e9f3e46 Mon Sep 17 00:00:00 2001 From: peter Date: Tue, 11 Aug 1998 00:04:46 +0000 Subject: [PATCH] * $ifdef ver0_99_5 updates --- rtl/i386/cpu.pp | 28 ++++++++++++++-------- rtl/i386/i386.inc | 32 ++++++++++++++----------- rtl/i386/makefile.cpu | 2 +- rtl/i386/math.inc | 54 +++++++++++++++++++++++++++++++++++-------- rtl/i386/readme | 7 +++++- rtl/i386/setjump.inc | 29 ++++++++++++++--------- rtl/i386/setjumph.inc | 16 ++++++++----- rtl/inc/mathh.inc | 19 ++++++++------- rtl/inc/real2str.inc | 15 +++++++----- rtl/inc/system.inc | 42 ++++++++++++++++++--------------- rtl/inc/systemh.inc | 30 +++++++++++++++++------- rtl/inc/text.inc | 27 ++++++++++++++-------- 12 files changed, 197 insertions(+), 104 deletions(-) diff --git a/rtl/i386/cpu.pp b/rtl/i386/cpu.pp index a2e34ca028..a03798affb 100644 --- a/rtl/i386/cpu.pp +++ b/rtl/i386/cpu.pp @@ -1,9 +1,11 @@ { $Id$ This file is part of the Free Pascal run time library. - Copyright (c) 1993,98 by Florian Klaempfl, - member of the Free Pascal development team. + Copyright (c) 1998 by Florian Klaempfl + This unit contains some routines to get informations about the + processor + See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -12,11 +14,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} -{ this unit contains some routines to get informations about the - processor -} unit cpu; -{$I386_INTEL} interface { returns true, if the processor supports the cpuid instruction } @@ -28,10 +26,17 @@ unit cpu; { returns the contents of the cr0 register } function cr0 : longint; + implementation - function cpuid_support : boolean;assembler; +{$ifdef VER0_99_5} + {$I386_INTEL} +{$endif} +{$ASMMODE INTEL} + + + function cpuid_support : boolean;assembler; { Check if the ID-flag can be changed, if changed then CpuID is supported. Tested under go32v1 and Linux on c6x86 with CpuID enabled and disabled (PFV) @@ -53,8 +58,8 @@ unit cpu; setnz al end; - function cr0 : longint;assembler; + function cr0 : longint;assembler; asm DB 0Fh,20h,0C0h { mov eax,cr0 @@ -62,8 +67,8 @@ unit cpu; parsers } end; - function floating_point_emulation : boolean; + function floating_point_emulation : boolean; begin {!!!! I don't know currently the position of the EM flag } { $4 after Ralf Brown's list } @@ -74,7 +79,10 @@ end. { $Log$ - Revision 1.3 1998-05-25 10:51:27 pierre + Revision 1.4 1998-08-11 00:04:46 peter + * $ifdef ver0_99_5 updates + + Revision 1.3 1998/05/25 10:51:27 pierre * CR0 works now (written using DB to allow to use it we INTEL and ATT output) * floating_emulation bit set correctly diff --git a/rtl/i386/i386.inc b/rtl/i386/i386.inc index 571c70b9c9..4fa29c534b 100644 --- a/rtl/i386/i386.inc +++ b/rtl/i386/i386.inc @@ -552,16 +552,16 @@ end; procedure runerror(w : word);[alias: 'runerror']; -function get_addr : Pointer;assembler; -asm - movl (%ebp),%eax - movl 4(%eax),%eax -end; + function get_addr : Pointer;assembler; + asm + movl (%ebp),%eax + movl 4(%eax),%eax + end; -function get_error_bp : Longint;assembler; -asm - movl (%ebp),%eax {%ebp of run_error} -end; + function get_error_bp : Longint;assembler; + asm + movl (%ebp),%eax {%ebp of run_error} + end; begin errorcode:=w; @@ -719,7 +719,7 @@ end ['EAX']; end; end; -{$IFNDEF NEW_READWRITE} +{$ifdef VER0_99_5} procedure f1;[public,alias: 'FLUSH_STDOUT']; begin @@ -731,7 +731,7 @@ end ['EAX']; popal end; end; -{$ENDIF NEW_READWRITE} +{$endif VER0_99_5} Function Sptr : Longint; @@ -744,14 +744,18 @@ begin end; -{$I386_ATT} {can be removed} -{$I386_DIRECT} {can be removed} +{$ifdef VER_0_99_5} + {$I386_DIRECT} +{$endif} {$ASMMODE ATT} { $Log$ - Revision 1.17 1998-07-30 13:26:20 michael + Revision 1.18 1998-08-11 00:04:47 peter + * $ifdef ver0_99_5 updates + + Revision 1.17 1998/07/30 13:26:20 michael + Added support for ErrorProc variable. All internal functions are required to call HandleError instead of runerror from now on. This is necessary for exception support. diff --git a/rtl/i386/makefile.cpu b/rtl/i386/makefile.cpu index ea3e05cf7c..3518bb10cd 100644 --- a/rtl/i386/makefile.cpu +++ b/rtl/i386/makefile.cpu @@ -2,6 +2,6 @@ # Here we set processor dependent include file names. # -CPUNAMES=i386 heap math set rttip +CPUNAMES=i386 heap math set rttip setjump setjumph CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES)) diff --git a/rtl/i386/math.inc b/rtl/i386/math.inc index 66d7cd4c4c..3ea880ab8b 100644 --- a/rtl/i386/math.inc +++ b/rtl/i386/math.inc @@ -15,7 +15,24 @@ **********************************************************************} {$ASMMODE DIRECT} -{$ifdef dummy} + +{$ifndef SUPPORT_EXTENDED} + +{**************************************************************************** + Real/Double data type routines + ****************************************************************************} + + function pi : real; + + begin + asm + fldpi + leave + ret + end []; + end; + + function abs(d : real) : real; begin @@ -241,12 +258,8 @@ begin power:=exp(ln(bas)*expo); end; -{$endif dummy} - - function power(bas,expo : longint) : longint; - begin - power:=round(exp(ln(bas)*expo)); - end; + +{$else SUPPORT_EXTENDED} {**************************************************************************** EXTENDED data type routines @@ -494,7 +507,24 @@ power:=exp(ln(bas)*expo); end; -{$ifdef fixed} +{$endif SUPPORT_EXTENDED} + + +{**************************************************************************** + Longint data type routines + ****************************************************************************} + + function power(bas,expo : longint) : longint; + begin + power:=round(exp(ln(bas)*expo)); + end; + + +{**************************************************************************** + Fixed data type routines + ****************************************************************************} + +{$ifdef _SUPPORT_FIXED} { Not yet allowed } function sqrt(d : fixed) : fixed; @@ -524,6 +554,7 @@ end; end; + function int(d : fixed) : fixed; {*****************************************************************} { Returns the integral part of d } @@ -604,13 +635,16 @@ Round:= longint(highf); end; -{$endif} +{$endif SUPPORT_FIXED} {$ASMMODE ATT} { $Log$ - Revision 1.4 1998-08-10 15:54:50 peter + Revision 1.5 1998-08-11 00:04:50 peter + * $ifdef ver0_99_5 updates + + Revision 1.4 1998/08/10 15:54:50 peter * removed dup power(longint) Revision 1.3 1998/08/08 12:28:09 florian diff --git a/rtl/i386/readme b/rtl/i386/readme index e9b1e0720e..489b69a354 100644 --- a/rtl/i386/readme +++ b/rtl/i386/readme @@ -7,6 +7,11 @@ Include files for system are : set.inc (sets operations) math.inc (mathematic operations using the coprocessor) i386.inc (several functions/procedures containing assembler parts) - + setjump.inc (setjmp/longjmp implementation for exceptions) + rttip.inc (rtti handling, for speed reasons) + Units are : strings.pp (written in assembler for speed) + cpu.pp (routines to access cpu info) + mmx.pp (special mmx routines) + \ No newline at end of file diff --git a/rtl/i386/setjump.inc b/rtl/i386/setjump.inc index 7daafda49e..1cb6067f8e 100644 --- a/rtl/i386/setjump.inc +++ b/rtl/i386/setjump.inc @@ -1,9 +1,10 @@ { $Id$ This file is part of the Free Pascal run time library. - Copyright (c) 1993,97 by xxxx - member of the Free Pascal development team + Copyright (c) 1998 by the Free Pascal development team + SetJmp and LongJmp implementation for exception handling + See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -13,13 +14,13 @@ **********************************************************************} -{********************************************************************** - Set_Jmp/Long_jmp - **********************************************************************} +{$ifdef VER0_99_5} + {$I386_DIRECT} +{$endif} -{$I386_DIRECT} +{$ASMMODE DIRECT} + Function SetJmp (Var S : Jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP']; - asm movl 8(%ebp),%eax movl %ebx,(%eax) @@ -34,15 +35,15 @@ asm xorl %eax,%eax end; -Procedure longJmp (Var S : Jmp_buf; value : longint); assembler;[Public, alias : 'FPC_LONGJMP']; +Procedure longJmp (Var S : Jmp_buf; value : longint); assembler;[Public, alias : 'FPC_LONGJMP']; asm movl 8(%ebp),%ecx movl 12(%ebp),%eax testl %eax,%eax - jne .nonzero + jne .Ljnonzero movl $1,%eax -.nonzero: +.Ljnonzero: movl (%ecx),%ebx movl 4(%ecx),%esi movl 8(%ecx),%edi @@ -51,5 +52,11 @@ asm jmp *20(%ecx) end; -{ I386_ATT removed for bugfix branch } +{$ASMMODE ATT} +{ + $Log$ + Revision 1.3 1998-08-11 00:04:52 peter + * $ifdef ver0_99_5 updates + +} diff --git a/rtl/i386/setjumph.inc b/rtl/i386/setjumph.inc index 79222dfa70..88e8ef3a54 100644 --- a/rtl/i386/setjumph.inc +++ b/rtl/i386/setjumph.inc @@ -1,8 +1,9 @@ { $Id$ This file is part of the Free Pascal run time library. - Copyright (c) 1993,97 by xxxx - member of the Free Pascal development team + Copyright (c) 1998 the Free Pascal development team + + SetJmp/Longjmp declarations See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -13,10 +14,6 @@ **********************************************************************} -{********************************************************************** - Declarations for SetJmp/LongJmp - **********************************************************************} - Type jmp_buf = record ebx,esi,edi : Longint; @@ -26,3 +23,10 @@ Type Function Setjmp (Var S : Jmp_buf) : longint; Procedure longjmp (Var S : Jmp_buf; value : longint); + +{ + $Log$ + Revision 1.2 1998-08-11 00:04:53 peter + * $ifdef ver0_99_5 updates + +} \ No newline at end of file diff --git a/rtl/inc/mathh.inc b/rtl/inc/mathh.inc index 56d04a5b23..0141eacafc 100644 --- a/rtl/inc/mathh.inc +++ b/rtl/inc/mathh.inc @@ -15,7 +15,7 @@ { declarations of the math routines } -{$ifdef i386} +{$ifdef SUPPORT_EXTENDED} function abs(d : extended) : extended; function arctan(d : extended) : extended; function cos(d : extended) : extended; @@ -30,8 +30,7 @@ function sqrt(d : extended) : extended; function trunc(d : extended) : longint; function power(bas,expo : extended) : extended; - function power(bas,expo : longint) : longint; -{$else i386} +{$else SUPPORT_EXTENDED} function abs(d : real) : real; function arctan(d : real) : real; function cos(d : real) : real; @@ -44,12 +43,13 @@ function sqr(d : real) : real; function sqrt(d : real) : real; function trunc(d : real) : longint; - function power(bas,expo : longint) : longint; function power(bas,expo : real) : real; function pi : real; -{$endif i386} +{$endif SUPPORT_EXTENDED} -{$ifdef FIXED} + function power(bas,expo : longint) : longint; + +{$ifdef _SUPPORT_FIXED} function sqrt(d : fixed) : fixed; function Round(x: fixed): longint; function sqr(d : fixed) : fixed; @@ -57,11 +57,14 @@ function frac(d : fixed) : fixed; function trunc(d : fixed) : longint; function int(d : fixed) : fixed; -{$endif FIXED} +{$endif SUPPORT_FIXED} { $Log$ - Revision 1.3 1998-08-08 12:28:11 florian + Revision 1.4 1998-08-11 00:05:24 peter + * $ifdef ver0_99_5 updates + + Revision 1.3 1998/08/08 12:28:11 florian * a lot small fixes to the extended data type work Revision 1.2 1998/05/12 10:42:45 peter diff --git a/rtl/inc/real2str.inc b/rtl/inc/real2str.inc index 63c8afb421..bb1cbf24a4 100644 --- a/rtl/inc/real2str.inc +++ b/rtl/inc/real2str.inc @@ -19,11 +19,11 @@ type { corresponding to real single fixed extended and comp for i386 } {$ifdef i386} -{$ifdef VER0_99_5} - bestreal = double; -{$else VER0_99_5} - bestreal = extended; -{$endif VER0_99_5} + {$ifdef SUPPORT_EXTENDED} + bestreal = extended; + {$else} + bestreal = double; + {$endif SUPPORT_EXTENDED} {$else i386} bestreal = single; {$endif i386} @@ -201,7 +201,10 @@ end; { $Log$ - Revision 1.8 1998-08-10 15:56:30 peter + Revision 1.9 1998-08-11 00:05:25 peter + * $ifdef ver0_99_5 updates + + Revision 1.8 1998/08/10 15:56:30 peter * fixed 0_9_5 typo Revision 1.7 1998/08/08 12:28:12 florian diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc index 6cb7f7c6ff..a5c21f75d7 100644 --- a/rtl/inc/system.inc +++ b/rtl/inc/system.inc @@ -71,7 +71,7 @@ Function lo(l : Longint) : Word; [INTERNPROC: In_lo_long]; Function hi(i : Integer) : byte; [INTERNPROC: In_hi_Word]; Function hi(w : Word) : byte; [INTERNPROC: In_hi_Word]; Function hi(l : Longint) : Word; [INTERNPROC: In_hi_long]; -{$ifndef INTERN_INC} +{$ifdef VER0_99_5} Procedure Inc(var i : Cardinal); [INTERNPROC: In_Inc_DWord]; Procedure Inc(var i : Longint); [INTERNPROC: In_Inc_DWord]; Procedure Inc(var i : Integer); [INTERNPROC: In_Inc_Word]; @@ -88,7 +88,7 @@ Procedure Dec(var i : shortint); [INTERNPROC: In_Dec_byte]; Procedure Dec(var i : byte); [INTERNPROC: In_Dec_byte]; Procedure Dec(var c : Char); [INTERNPROC: In_Dec_byte]; Procedure Dec(var p : PChar); [INTERNPROC: In_Dec_DWord]; -{$endif INTERN_INC} +{$endif VER0_99_5} Function chr(b : byte) : Char; [INTERNPROC: In_chr_byte]; Function Length(s : string) : byte; [INTERNPROC: In_Length_string]; @@ -139,7 +139,7 @@ Procedure incr_ansi_ref (P : pointer);[Alias : 'INCR_ANSI_REF']; ****************************************************************************} {$ifndef VER0_99_5} -{$i rtti.inc} + {$i rtti.inc} {$endif VER0_99_5} {**************************************************************************** @@ -158,7 +158,7 @@ begin Lo := b and $0f end; -{$ifndef INTERN_INC} +{$ifdef VER0_99_5} Procedure Inc(var i : Cardinal;a: Longint); Begin @@ -240,7 +240,7 @@ Begin longint(p):=longint(p)+a; End; -{$endif INTERN_INC} +{$endif VER0_99_5} Function swap (X : Word) : Word; Begin @@ -262,11 +262,11 @@ Begin Swap:=Swap(Longint(X)); End; - {$endif RTLLITE} -{**************************************************************************** - Random function routines +{**************************************************************************** + Random function routines + This implements a very long cycle random number generator by combining three independant generators. The technique was described in the March 1987 issue of Byte. @@ -337,12 +337,11 @@ begin end; - { Include processor specific routines } {$I math.inc} {**************************************************************************** - Memory Management + Memory Management ****************************************************************************} {$ifndef RTLLITE} @@ -376,7 +375,7 @@ End; {$endif RTLLITE} {***************************************************************************** - Miscellaneous + Miscellaneous *****************************************************************************} @@ -415,9 +414,9 @@ Procedure dump_stack(bp : Longint); Begin {To be used by symify} Writeln(stderr,' 0x',HexStr(addr,8)); -{$IFNDEF NEW_READWRITE} +{$ifdef VER0_99_5} Flush(stderr); -{$ENDIF NEW_READWRITE} +{$endif VER0_99_5} End; var @@ -456,9 +455,9 @@ Begin Writeln('Run time error ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8)); dump_stack(ErrorBase); End; -{$IFNDEF NEW_READWRITE} +{$ifdef VER0_99_5} Flush(stderr); -{$ENDIF NEW_READWRITE} +{$endif VER0_99_5} End; @@ -503,7 +502,6 @@ End; *****************************************************************************} Procedure do_assert (Const Name,Msg : string; LineNo : Longint); [Public,Alias : 'FPC_DO_ASSERT']; - begin If msg='' then write (stderr,'Assertion failed. ') @@ -514,22 +512,28 @@ begin HandleError (227); end; + {***************************************************************************** SetJmp/LongJmp support. *****************************************************************************} {$i setjump.inc} + {***************************************************************************** Exception support. *****************************************************************************} -// No go, because objpas needed :( (MVC) -{ $i except.inc} +{ No go, because objpas needed :( (MVC) } +{ $i except.inc} + { $Log$ - Revision 1.25 1998-07-30 13:26:18 michael + Revision 1.26 1998-08-11 00:05:26 peter + * $ifdef ver0_99_5 updates + + Revision 1.25 1998/07/30 13:26:18 michael + Added support for ErrorProc variable. All internal functions are required to call HandleError instead of runerror from now on. This is necessary for exception support. diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index 5af0aa0c9f..a45c8816ac 100644 --- a/rtl/inc/systemh.inc +++ b/rtl/inc/systemh.inc @@ -14,8 +14,14 @@ {***************************************************************************** This File contains the OS independent declarations of the system unit + + Possible defines: + ----------------- + RTLLITE Create a somewhat smaller RTL + *****************************************************************************} + {**************************************************************************** Support for multiple compiler versions ****************************************************************************} @@ -35,12 +41,18 @@ Type { at least declare Turbo Pascal real types } {$ifdef i386} - Double = real; - ValReal = Extended; - {$define SUPPORT_EXTENDED} + {$ifndef VER0_99_5} + {$define SUPPORT_EXTENDED} + {$endif} {$define SUPPORT_COMP} {$define SUPPORT_SINGLE} {$define SUPPORT_FIXED} + Double = real; + {$ifdef SUPPORT_EXTENDED} + ValReal = Extended; + {$else} + ValReal = Double; + {$endif} {$endif} {$ifdef m68k} @@ -140,7 +152,7 @@ Function Swap (X:Integer):Integer; Function Swap (X:Cardinal):Cardinal; Function Swap (X:Longint):Longint; -{$ifndef INTERN_INC} +{$ifdef VER0_99_5} Procedure Inc(Var i:cardinal); Procedure Inc(Var i:Longint); Procedure Inc(Var i:Integer); @@ -173,7 +185,7 @@ Procedure Dec(Var c:Char;a:Longint); Procedure Inc(Var c:Char;a:Longint); Procedure Dec(Var p:PChar;a:Longint); Procedure Inc(Var p:PChar;a:Longint); -{$endif INTERN_INC} +{$endif VER0_99_5} {$endif RTLLITE} Function Chr(b:byte):Char; @@ -254,8 +266,7 @@ Procedure Val(const s:string;Var d:single); {$endif SUPPORT_SINGLE} {$ifdef SUPPORT_EXTENDED} { if extended is supported, valreal is an extended, so we - have to define the real routines -} + have to define the real routines } Procedure Val(const s:string;Var d:Real;Var code:Word); Procedure Val(const s:string;Var d:Real;Var code:Integer); Procedure Val(const s:string;Var d:Real); @@ -415,7 +426,10 @@ Procedure halt; { $Log$ - Revision 1.22 1998-08-08 12:28:14 florian + Revision 1.23 1998-08-11 00:05:27 peter + * $ifdef ver0_99_5 updates + + Revision 1.22 1998/08/08 12:28:14 florian * a lot small fixes to the extended data type work Revision 1.21 1998/07/30 13:26:17 michael diff --git a/rtl/inc/text.inc b/rtl/inc/text.inc index b5105db99b..8f04eff4e5 100644 --- a/rtl/inc/text.inc +++ b/rtl/inc/text.inc @@ -590,7 +590,7 @@ Begin End; -{$IFNDEF NEW_READWRITE} +{$ifdef VER0_99_5} Procedure w(var t : TextRec);[Public,Alias: 'WRITELN_TEXT']; var hs : String; @@ -603,7 +603,7 @@ Begin {$ENDIF} Write_Str(0,t,hs); End; -{$ENDIF NEW_READWRITE} +{$endif VER0_99_5} {***************************************************************************** @@ -729,7 +729,8 @@ Begin FileFunc(f.FlushFunc)(f); End; -{$ifndef MAXLENREADSTRING} + +{$ifdef VER0_99_5} Procedure Read_String(var f : TextRec;var s : String);[Public,Alias: 'READ_TEXT_STRING']; var Temp,sPos : Word; @@ -771,7 +772,9 @@ Begin End; s[0]:=chr(sPos-1); End; -{$ELSE} + +{$else VER0_99_5} + Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : String);[Public,Alias:'READ_TEXT_STRING']; var Temp,sPos,nrread : Word; @@ -817,7 +820,8 @@ Begin End; s[0]:=chr(sPos-1); End; -{$ENDIF MAXLENREADSTRING} +{$endif VER0_99_5} + Procedure Read_Char(var f : TextRec;var c : Char);[Public,Alias: 'READ_TEXT_CHAR']; Begin @@ -900,14 +904,13 @@ Begin p^:=#0; End; + {$ifdef useansistrings} Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : AnsiString);[Public,Alias: 'READ_TEXT_ANSISTRING']; - var p : PChar; Temp : byte; len : Longint; - Begin { Delete the string } Decr_ansi_ref (S); @@ -942,6 +945,7 @@ Begin End; {$endif} + Procedure Read_Longint(var f : TextRec;var l : Longint);[Public,Alias: 'READ_TEXT_LONGINT']; var hs : String; @@ -1150,7 +1154,7 @@ End; {$endif SUPPORT_COMP} -{$IFNDEF NEW_READWRITE} +{$ifdef VER0_99_5} Procedure r(var f : TextRec);[Public,Alias: 'READLN_TEXT']; Begin If InOutRes <> 0 then exit; @@ -1165,7 +1169,7 @@ Begin FileFunc(f.InOutFunc)(f); end; End; -{$ENDIF NEW_READWRITE} +{$endif VER0_99_5} {***************************************************************************** @@ -1192,7 +1196,10 @@ end; { $Log$ - Revision 1.19 1998-07-30 13:26:16 michael + Revision 1.20 1998-08-11 00:05:28 peter + * $ifdef ver0_99_5 updates + + Revision 1.19 1998/07/30 13:26:16 michael + Added support for ErrorProc variable. All internal functions are required to call HandleError instead of runerror from now on. This is necessary for exception support.