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

* removed temp defines

Browse Source
This commit is contained in:
peter 1999-07-05 20:04:21 +00:00
parent fcd419b84a
commit ebd738f2f5
9 changed files with 185 additions and 1411 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

297
rtl/inc/astrings.inc
View File

@ -15,6 +15,9 @@
**********************************************************************} **********************************************************************}
{ This will release some functions for special shortstring support }
{ define EXTRAANSISHORT}
{ {
This file contains the implementation of the AnsiString type, This file contains the implementation of the AnsiString type,
and all things that are needed for it. and all things that are needed for it.
@ -159,14 +162,11 @@ Procedure AnsiStr_Concat (S1,S2 : Pointer;var S3 : Pointer);[Public, alias: 'FPC
} }
Var Var
Size,Location : Longint; Size,Location : Longint;
begin begin
{ create new result }
if S3<>nil then if S3<>nil then
begin AnsiStr_Decr_Ref(S3);
AnsiStr_Decr_Ref(S3); { only assign if s1 or s2 is empty }
S3:=nil;
end;
if (S1=Nil) then if (S1=Nil) then
AnsiStr_Assign(S3,S2) AnsiStr_Assign(S3,S2)
else else
@ -183,6 +183,7 @@ begin
end; end;
{$ifdef EXTRAANSISHORT}
Procedure AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString); Procedure AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString);
{ {
Concatenates a Ansi with a short string; : S2 + S2 Concatenates a Ansi with a short string; : S2 + S2
@ -201,6 +202,7 @@ begin
Move (S2[1],Pointer(Pointer(S1)+Location)^,Size); Move (S2[1],Pointer(Pointer(S1)+Location)^,Size);
PByte( Pointer(S1)+length(S1) )^:=0; { Terminating Zero } PByte( Pointer(S1)+length(S1) )^:=0; { Terminating Zero }
end; end;
{$endif EXTRAANSISHORT}
Procedure AnsiStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR']; Procedure AnsiStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR'];
@ -342,6 +344,7 @@ begin
end; end;
{$ifdef EXTRAANSISHORT}
Function AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): Longint; Function AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): Longint;
{ {
Compares a AnsiString with a ShortString; Compares a AnsiString with a ShortString;
@ -365,6 +368,7 @@ begin
end; end;
AnsiStr_ShortStr_Compare:=Temp; AnsiStr_ShortStr_Compare:=Temp;
end; end;
{$endif EXTRAANSISHORT}
{***************************************************************************** {*****************************************************************************
@ -435,13 +439,13 @@ begin
If Pointer(S)=Nil then If Pointer(S)=Nil then
exit; exit;
if PAnsiRec(Pointer(S)-Firstoff)^.Ref<>1 then if PAnsiRec(Pointer(S)-Firstoff)^.Ref<>1 then
begin begin
SNew:=NewAnsiString (PAnsiRec(Pointer(S)-FirstOff)^.len); SNew:=NewAnsiString (PAnsiRec(Pointer(S)-FirstOff)^.len);
Move (Pointer(S)^,SNew^,PAnsiRec(Pointer(S)-FirstOff)^.len+1); Move (Pointer(S)^,SNew^,PAnsiRec(Pointer(S)-FirstOff)^.len+1);
PAnsiRec(SNew-FirstOff)^.len:=PAnsiRec(Pointer(S)-FirstOff)^.len; PAnsiRec(SNew-FirstOff)^.len:=PAnsiRec(Pointer(S)-FirstOff)^.len;
ansistr_decr_ref (Pointer(S)); { Thread safe } ansistr_decr_ref (Pointer(S)); { Thread safe }
Pointer(S):=SNew; Pointer(S):=SNew;
end; end;
end; end;
@ -453,30 +457,29 @@ begin
dec(index); dec(index);
{ Check Size. Accounts for Zero-length S } { Check Size. Accounts for Zero-length S }
if Length(S)<Index+Size then if Length(S)<Index+Size then
Size:=Length(S)-Index; Size:=Length(S)-Index;
If Size>0 then If Size>0 then
begin begin
If Index<0 Then If Index<0 Then
Index:=0; Index:=0;
ResultAddress:=Pointer(NewAnsiString (Size)); ResultAddress:=Pointer(NewAnsiString (Size));
if ResultAddress<>Nil then if ResultAddress<>Nil then
begin begin
Move (Pointer(Pointer(S)+index)^,ResultAddress^,Size); Move (Pointer(Pointer(S)+index)^,ResultAddress^,Size);
PAnsiRec(ResultAddress-FirstOff)^.Len:=Size; PAnsiRec(ResultAddress-FirstOff)^.Len:=Size;
PByte(ResultAddress+Size)^:=0; PByte(ResultAddress+Size)^:=0;
end; end;
end; end;
Pointer(Copy):=ResultAddress; Pointer(Copy):=ResultAddress;
end; end;
Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : Longint; Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : Longint;
var var
i,j : longint; i,j : longint;
e : boolean; e : boolean;
S : AnsiString; S : AnsiString;
se : Pointer; se : Pointer;
begin begin
i := 0; i := 0;
j := 0; j := 0;
@ -497,8 +500,6 @@ begin
end; end;
{$IfDef ValInternCompiled}
Function ValAnsiFloat(Const S : AnsiString; Var Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_ANSISTR']; Function ValAnsiFloat(Const S : AnsiString; Var Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_ANSISTR'];
Var Var
SS : String; SS : String;
@ -537,110 +538,6 @@ end;
{$EndIf SUPPORT_FIXED} {$EndIf SUPPORT_FIXED}
{$Else ValInternCompiled}
Procedure Val (Const S : AnsiString; var R : real; Var Code : Integer);
Var
SS : String;
begin
AnsiStr_To_ShortStr (SS,Pointer(S));
Val(SS,R,Code);
end;
{
Procedure Val (var S : AnsiString; var D : Double; Var Code : Integer);
Var SS : ShortString;
begin
AnsiStr_To_ShortStr (SS,S);
Val(SS,D,Code);
end;
}
Procedure Val (Const S : AnsiString; var E : Extended; Code : Integer);
Var SS : ShortString;
begin
AnsiStr_To_ShortStr (SS,Pointer(S));
Val(SS,E,Code);
end;
Procedure Val (Const S : AnsiString; var C : Cardinal; Code : Integer);
Var SS : ShortString;
begin
AnsiStr_To_ShortStr (SS,Pointer(S));
Val(SS,C,Code);
end;
Procedure Val (Const S : AnsiString; var L : Longint; Var Code : Integer);
Var SS : ShortString;
begin
AnsiStr_To_ShortStr (SS,Pointer(S));
Val(SS,L,Code);
end;
Procedure Val (Const S : AnsiString; var W : Word; Var Code : Integer);
Var SS : ShortString;
begin
AnsiStr_To_ShortStr (SS,Pointer(S));
Val(SS,W,Code);
end;
Procedure Val (Const S : AnsiString; var I : Integer; Var Code : Integer);
Var SS : ShortString;
begin
AnsiStr_To_ShortStr (SS,Pointer(S));
Val(SS,I,Code);
end;
Procedure Val (Const S : AnsiString; var B : Byte; Var Code : Integer);
Var SS : ShortString;
begin
AnsiStr_To_ShortStr (SS,Pointer(S));
Val(SS,B,Code);
end;
Procedure Val (Const S : AnsiString; var SI : ShortInt; Var Code : Integer);
Var SS : ShortString;
begin
AnsiStr_To_ShortStr (SS,Pointer(S));
Val(SS,SI,Code);
end;
{$EndIf ValInternCompiled}
{$ifdef INTERNDOUBLE}
procedure AnsiStr_Float(d : ValReal;len,fr,rt : longint;var s : ansistring);[public,alias:'FPC_ANSISTR_FLOAT']; procedure AnsiStr_Float(d : ValReal;len,fr,rt : longint;var s : ansistring);[public,alias:'FPC_ANSISTR_FLOAT'];
var var
ss : shortstring; ss : shortstring;
@ -649,73 +546,10 @@ begin
s:=ss; s:=ss;
end; end;
{$else INTERNDOUBLE}
Procedure ACoStr (Co : Comp;Len,fr: Longint; Var S : AnsiString);
[Public,Alias : 'FPC_'+{$ifdef NOSTRANSI}'ANSISTR'{$else}'STRANSI_'{$endif}+'COMP'];
Var SS : ShortString;
begin
ShortStr_comp (Co,Len,fr,SS);
S:=SS;
end;
Procedure ASiStr (Si : Single;Len,fr: Longint; Var S : AnsiString);
[Public,Alias : 'FPC_'+{$ifdef NOSTRANSI}'ANSISTR'{$else}'STRANSI'{$endif}+'_SINGLE'];
Var SS : ShortString;
begin
ShortStr_Single (Si,Len,fr,SS);
S:=SS;
end;
{$IfDef Support_Fixed}
Procedure AFiStr (fi : Comp;Len,fr: Longint; Var S : AnsiString);
[Public,Alias : 'FPC_'+{$ifdef NOSTRANSI}'ANSISTR'{$else}'STRANSI'{$endif}+'_FIXED'];
Var SS : ShortString;
begin
ShortStr_Fixed (fi,Len,fr,SS);
S:=SS;
end;
{$EndIf Support_Fixed}
Procedure ARStr (D : Real;Len,fr: Longint; Var S : AnsiString);
[Public,Alias : 'FPC_'+{$ifdef NOSTRANSI}'ANSISTR'{$else}'STRANSI'{$endif}+'_REAL'];
Var SS : ShortString;
begin
ShortStr_real (D,Len,fr,SS);
S:=SS;
end;
Procedure AEStr (E : Extended;Len,Fr: Longint; Var S : AnsiString);
[Public,Alias : 'FPC_'+{$ifdef NOSTRANSI}'ANSISTR'{$else}'STRANSI'{$endif}+'_EXTENDED'];
Var SS : ShortString;
begin
ShortStr_Extended (E,Len,fr,SS);
S:=SS;
end;
{$endif INTERNDOUBLE}
Procedure ACStr (C : Cardinal;Len : Longint; Var S : AnsiString);
[Public,Alias : 'FPC_'+{$ifdef NOSTRANSI}'ANSISTR'{$else}'STRANSI'{$endif}+'_CARDINAL'];
Var SS : ShortString;
Procedure AnsiStr_Cardinal(C : Cardinal;Len : Longint; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_CARDINAL'];
Var
SS : ShortString;
begin begin
int_str_cardinal(C,Len,SS); int_str_cardinal(C,Len,SS);
S:=SS; S:=SS;
@ -723,54 +557,54 @@ end;
Procedure ALStr (L : Longint; Len : Longint; Var S : AnsiString); Procedure AnsiStr_Longint(L : Longint; Len : Longint; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_LONGINT'];
[Public,Alias : 'FPC_'+{$ifdef NOSTRANSI}'ANSISTR'{$else}'STRANSI'{$endif}+'_LONGINT']; Var
SS : ShortString;
Var SS : ShortString;
begin begin
int_Str_Longint (L,Len,SS); int_Str_Longint (L,Len,SS);
S:=SS; S:=SS;
end; end;
Procedure Delete (Var S : AnsiString; Index,Size: Longint); Procedure Delete (Var S : AnsiString; Index,Size: Longint);
Var
Var LS : Longint; LS : Longint;
begin begin
If Length(S)=0 then exit; If Length(S)=0 then
exit;
if index<=0 then if index<=0 then
begin begin
Size:=Size+index-1; inc(Size,index-1);
index:=1; index:=1;
end; end;
LS:=PAnsiRec(Pointer(S)-FirstOff)^.Len; LS:=PAnsiRec(Pointer(S)-FirstOff)^.Len;
if (Index<=LS) and (Size>0) then if (Index<=LS) and (Size>0) then
begin begin
UniqueAnsiString (S); UniqueAnsiString (S);
if Size+Index>LS then if Size+Index>LS then
Size:=LS-Index+1; Size:=LS-Index+1;
if Index+Size<=LS then if Index+Size<=LS then
begin begin
Dec(Index); Dec(Index);
Move(PByte(Pointer(S))[Index+Size], Move(PByte(Pointer(S))[Index+Size],PByte(Pointer(S))[Index],LS-Index+1);
PByte(Pointer(S))[Index],LS-Index+1);
end; end;
Setlength(s,LS-Size); Setlength(s,LS-Size);
end; end;
end; end;
Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint); Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint);
var
var Temp : AnsiString; Temp : AnsiString;
LS : Longint; LS : Longint;
begin begin
If Length(Source)=0 then exit; If Length(Source)=0 then
if index <= 0 then index := 1; exit;
if index <= 0 then
index := 1;
Ls:=Length(S); Ls:=Length(S);
if index > LS then index := LS+1; if index > LS then
index := LS+1;
Dec(Index); Dec(Index);
Pointer(Temp) := NewAnsiString(Length(Source)+LS); Pointer(Temp) := NewAnsiString(Length(Source)+LS);
SetLength(Temp,Length(Source)+LS); SetLength(Temp,Length(Source)+LS);
@ -785,7 +619,10 @@ end;
{ {
$Log$ $Log$
Revision 1.29 1999-06-14 00:47:33 peter Revision 1.30 1999-07-05 20:04:21 peter
* removed temp defines
Revision 1.29 1999/06/14 00:47:33 peter
* merged * merged
Revision 1.28.2.1 1999/06/14 00:39:07 peter Revision 1.28.2.1 1999/06/14 00:39:07 peter

16
rtl/inc/generic.inc
View File

@ -217,7 +217,6 @@ end;
{$endif ndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT} {$endif ndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
{$ifdef FPC_TESTOBJEXT}
{ checks for a correct vmt pointer } { checks for a correct vmt pointer }
{ deeper check to see if the current object is } { deeper check to see if the current object is }
{ really related to the true } { really related to the true }
@ -246,8 +245,6 @@ end;
{$endif ndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT} {$endif ndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
{$endif FPC_TESTOBJEXT}
{**************************************************************************** {****************************************************************************
String String
@ -396,10 +393,6 @@ end;
function strpas(p:pchar):string;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; function strpas(p:pchar):string;[public,alias:'FPC_PCHAR_TO_SHORTSTR'];
begin begin
{$ifndef NEWATT}
{ remove warning }
strpas:='';
{$endif}
asm asm
cld cld
movl p,%edi movl p,%edi
@ -415,11 +408,7 @@ begin
scasb scasb
.LStrPasNil: .LStrPasNil:
movl %ecx,%eax movl %ecx,%eax
{$ifdef NEWATT}
movl __RESULT,%edi movl __RESULT,%edi
{$else}
movl 8(%ebp),%edi
{$endif}
notb %al notb %al
decl %eax decl %eax
stosb stosb
@ -611,7 +600,10 @@ end;
{ {
$Log$ $Log$
Revision 1.1 1999-05-31 21:59:58 pierre Revision 1.2 1999-07-05 20:04:22 peter
* removed temp defines
Revision 1.1 1999/05/31 21:59:58 pierre
+ generic.inc added + generic.inc added
} }

7
rtl/inc/int64.inc
View File

@ -54,7 +54,7 @@
var var
shift,lzz,lzn : longint; shift,lzz,lzn : longint;
one : qword; { one : qword; }
begin begin
divqword:=0; divqword:=0;
@ -302,7 +302,10 @@
{ {
$Log$ $Log$
Revision 1.12 1999-07-04 16:34:45 florian Revision 1.13 1999-07-05 20:04:23 peter
* removed temp defines
Revision 1.12 1999/07/04 16:34:45 florian
+ str routines added + str routines added
Revision 1.11 1999/07/02 17:01:29 florian Revision 1.11 1999/07/02 17:01:29 florian

13
rtl/inc/objpas.inc
View File

@ -221,11 +221,7 @@
pushl message pushl message
pushl %esi pushl %esi
movl p,%edi movl p,%edi
{$ifdef ver0_99_10}
call %edi
{$else ver0_99_10}
call *%edi call *%edi
{$endif ver0_99_10}
end; end;
exit; exit;
end; end;
@ -264,11 +260,7 @@
pushl message pushl message
pushl %esi pushl %esi
movl p,%edi movl p,%edi
{$ifdef ver0_99_10}
call %edi
{$else ver0_99_10}
call *%edi call *%edi
{$endif ver0_99_10}
end; end;
exit; exit;
end; end;
@ -325,7 +317,10 @@
{ {
$Log$ $Log$
Revision 1.4 1999-05-19 13:20:09 peter Revision 1.5 1999-07-05 20:04:24 peter
* removed temp defines
Revision 1.4 1999/05/19 13:20:09 peter
* fixed dispatchstr * fixed dispatchstr
Revision 1.3 1999/05/17 21:52:37 florian Revision 1.3 1999/05/17 21:52:37 florian

656
rtl/inc/sstrings.inc
View File

@ -282,67 +282,21 @@ end;
Str() Helpers Str() Helpers
*****************************************************************************} *****************************************************************************}
{$ifdef INTERNDOUBLE}
procedure ShortStr_Float(d : ValReal;len,fr,rt : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_FLOAT']; procedure ShortStr_Float(d : ValReal;len,fr,rt : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_FLOAT'];
begin begin
str_real(len,fr,d,treal_type(rt),s); str_real(len,fr,d,treal_type(rt),s);
end; end;
{$else}
procedure int_str_longint(v : longint;len : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_LONGINT'];
{$ifdef SUPPORT_SINGLE}
procedure ShortStr_Single(d : single;len,fr : longint;var s : shortstring);[public,alias:'FPC_'+{$ifdef NOSTRANSI}'SHORT'+{$endif}'STR_'+{$ifdef INTERNDOUBLE}'S32REAL'{$else}'SINGLE'{$endif}];
begin begin
str_real(len,fr,d,rt_s32real,s); int_str(v,s);
end; if length(s)<len then
{$endif} s:=space(len-length(s))+s;
{$ifdef SUPPORT_DOUBLE}
procedure ShortStr_Real(d : real;len,fr : longint;var s : shortstring);[public,alias:'FPC_'+{$ifdef NOSTRANSI}'SHORT'+{$endif}'STR_'+{$ifdef INTERNDOUBLE}'S64'+{$endif}'REAL'];
begin
str_real(len,fr,d,rt_s64real,s);
end;
{$endif SUPPORT_S64REAL}
{$ifdef SUPPORT_EXTENDED}
procedure ShortStr_Extended(d : extended;len,fr : longint;var s : shortstring);[public,alias:'FPC_'+{$ifdef NOSTRANSI}'SHORT'+{$endif}'STR_'+{$ifdef INTERNDOUBLE}'S80REAL'{$else}'EXTENDED'{$endif}];
begin
str_real(len,fr,d,rt_s80real,s);
end;
{$endif SUPPORT_S80REAL}
{$ifdef SUPPORT_COMP}
procedure ShortStr_Comp(d : comp;len,fr : longint;var s : shortstring);[public,alias:'FPC_'+{$ifdef NOSTRANSI}'SHORT'+{$endif}'STR_'+{$ifdef INTERNDOUBLE}'C64BIT'{$else}'COMP'{$endif}];
begin
str_real(len,fr,d,rt_c64bit,s);
end;
{$endif SUPPORT_C64BIT}
{$ifdef SUPPORT_FIXED}
procedure ShortStr_Fixed(d : fixed;len,fr : longint;var s : shortstring);[public,alias:'FPC_'+{$ifdef NOSTRANSI}'SHORT'+{$endif}'STR_'+{$ifdef INTERNDOUBLE}'F16BIT'{$else}'FIXED'{$endif}];
begin
str_real(len,fr,d,rt_f32bit,s);
end;
{$endif SUPPORT_F16BIT}
{$endif}
procedure int_str_longint(v : longint;len : longint;var s : shortstring);[public,alias:'FPC_'+{$ifdef NOSTRANSI}'SHORT'+{$endif}'STR_LONGINT'];
begin
int_str(v,s);
if length(s)<len then
s:=space(len-length(s))+s;
end; end;
procedure int_str_cardinal(v : cardinal;len : longint;var s : shortstring);[public,alias:'FPC_'+{$ifdef NOSTRANSI}'SHORT'+{$endif}'STR_CARDINAL']; procedure int_str_cardinal(v : cardinal;len : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_CARDINAL'];
begin begin
int_str(v,s); int_str(v,s);
if length(s)<len then if length(s)<len then
@ -381,11 +335,6 @@ begin
repeat repeat
inc(code); inc(code);
until (code>=length(s)) or (s[code]<>'0'); until (code>=length(s)) or (s[code]<>'0');
{The following isn't correct anymore for 64 bit integers! (JM)}
{$IfNDef ValInternCompiled}
if length(s)-code>7 then
code:=code+8;
{$EndIf ValInternCompiled}
end; end;
'%' : begin '%' : begin
base:=2; base:=2;
@ -397,8 +346,6 @@ begin
end; end;
{$IfDef ValInternCompiled}
Function ValSignedInt(DestSize: longint; Const S: ShortString; var Code: ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_SHORTSTR']; Function ValSignedInt(DestSize: longint; Const S: ShortString; var Code: ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_SHORTSTR'];
var var
u: ValSInt; u: ValSInt;
@ -465,6 +412,7 @@ begin
End; End;
end; end;
Function ValUnsignedInt(Const S: ShortString; var Code: ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_SHORTSTR']; Function ValUnsignedInt(Const S: ShortString; var Code: ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_SHORTSTR'];
var var
u: ValUInt; u: ValUInt;
@ -506,6 +454,7 @@ begin
code := 0; code := 0;
end; end;
Function ValFloat(const s : shortstring; var code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_SHORTSTR']; Function ValFloat(const s : shortstring; var code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_SHORTSTR'];
var var
hd, hd,
@ -599,6 +548,7 @@ begin
code:=0; code:=0;
end; end;
{$ifdef SUPPORT_FIXED} {$ifdef SUPPORT_FIXED}
Function ValFixed(const s : shortstring;var code : ValSInt): Fixed; [public, alias:'FPC_VAL_FIXED_SHORTSTR']; Function ValFixed(const s : shortstring;var code : ValSInt): Fixed; [public, alias:'FPC_VAL_FIXED_SHORTSTR'];
begin begin
@ -607,592 +557,7 @@ end;
{$endif SUPPORT_FIXED} {$endif SUPPORT_FIXED}
{$Else ValInternCompiled}
procedure val(const s : shortstring;var l : longint;var code : word);
var
base,u : byte;
negativ : boolean;
begin
l:=0;
Code:=InitVal(s,negativ,base);
if Code>length(s) then
exit;
if negativ and (s='-2147483648') then
begin
Code:=0;
l:=$80000000;
exit;
end;
while Code<=Length(s) do
begin
u:=ord(s[code]);
case u of
48..57 : u:=u-48;
65..70 : u:=u-55;
97..104 : u:=u-87;
else
u:=16;
end;
l:=l*longint(base);
if (u>=base) or ((base=10) and (2147483647-l<longint(u))) then
begin
l:=0;
exit;
end;
l:=l+u;
inc(code);
end;
code := 0;
if negativ then
l:=0-l;
end;
procedure val(const s : shortstring;var l : longint;var code : integer);
begin
val(s,l,word(code));
end;
procedure val(const s : shortstring;var l : longint;var code : longint);
var
cw : word;
begin
val (s,l,cw);
code:=cw;
end;
procedure val(const s : shortstring;var l : longint);
var
code : word;
begin
val (s,l,code);
end;
procedure val(const s : shortstring;var b : byte);
var
l : longint;
begin
val(s,l);
b:=l;
end;
procedure val(const s : shortstring;var b : byte;var code : word);
var
l : longint;
begin
val(s,l,code);
b:=l;
end;
procedure val(const s : shortstring;var b : byte;var code : Integer);
begin
val(s,b,word(code));
end;
procedure val(const s : shortstring;var b : byte;var code : longint);
var
l : longint;
begin
val(s,l,code);
b:=l;
end;
procedure val(const s : shortstring;var b : shortint);
var
l : longint;
begin
val(s,l);
b:=l;
end;
procedure val(const s : shortstring;var b : shortint;var code : word);
var
l : longint;
begin
val(s,l,code);
b:=l;
end;
procedure val(const s : shortstring;var b : shortint;var code : Integer);
begin
val(s,b,word(code));
end;
procedure val(const s : shortstring;var b : shortint;var code : longint);
var
l : longint;
begin
val(s,l,code);
b:=l;
end;
procedure val(const s : shortstring;var b : word);
var
l : longint;
begin
val(s,l);
b:=l;
end;
procedure val(const s : shortstring;var b : word;var code : word);
var
l : longint;
begin
val(s,l,code);
b:=l;
end;
procedure val(const s : shortstring;var b : word;var code : Integer);
begin
val(s,b,word(code));
end;
procedure val(const s : shortstring;var b : word;var code : longint);
var
l : longint;
begin
val(s,l,code);
b:=l;
end;
procedure val(const s : shortstring;var b : integer);
var
l : longint;
begin
val(s,l);
b:=l;
end;
procedure val(const s : shortstring;var b : integer;var code : word);
var
l : longint;
begin
val(s,l,code);
b:=l;
end;
procedure val(const s : shortstring;var b : integer;var code : Integer);
begin
val(s,b,word(code));
end;
procedure val(const s : shortstring;var b : integer;var code : longint);
var
l : longint;
begin
val(s,l,code);
b:=l;
end;
procedure val(const s : shortstring;var v : cardinal;var code : word);
var
negativ : boolean;
base,u : byte;
begin
v:=0;
code:=InitVal(s,negativ,base);
if (Code>length(s)) or negativ then
exit;
while Code<=Length(s) do
begin
u:=ord(s[code]);
case u of
48..57 : u:=u-48;
65..70 : u:=u-55;
97..104 : u:=u-87;
else
u:=16;
end;
cardinal(v):=cardinal(v)*cardinal(longint(base));
if (u>base) or (cardinal($ffffffff)-cardinal(v)>cardinal(longint(u))) then
begin
v:=0;
exit;
end;
v:=v+u;
inc(code);
end;
code:=0;
end;
procedure val(const s : shortstring;var v : cardinal);
var
code : word;
begin
val(s,v,code);
end;
procedure val(const s : shortstring;var v : cardinal;var code : integer);
begin
val(s,v,word(code));
end;
procedure val(const s : shortstring;var v : cardinal;var code : longint);
var
cw : word;
begin
val(s,v,cw);
code:=cw;
end;
procedure val(const s : shortstring;var d : valreal;var code : word);
var
hd,
esign,sign : valreal;
exponent,i : longint;
flags : byte;
const
i10 = 10;
begin
d:=0;
code:=1;
exponent:=0;
esign:=1;
flags:=0;
sign:=1;
while (code<=length(s)) and (s[code] in [' ',#9]) do
inc(code);
case s[code] of
'+' : inc(code);
'-' : begin
sign:=-1;
inc(code);
end;
end;
while (Code<=Length(s)) and (s[code] in ['0'..'9']) do
begin
{ Read integer part }
flags:=flags or 1;
d:=d*i10;
d:=d+(ord(s[code])-ord('0'));
inc(code);
end;
{ Decimal ? }
if (s[code]='.') and (length(s)>=code) then
begin
hd:=extended(i1)/extended(i10);
inc(code);
while (s[code] in ['0'..'9']) and (length(s)>=code) do
begin
{ Read fractional part. }
flags:=flags or 2;
d:=d+hd*(ord(s[code])-ord('0'));
hd:=hd/i10;
inc(code);
end;
end;
{ Again, read integer and fractional part}
if flags=0 then
begin
d:=0;
exit;
end;
{ Exponent ? }
if (upcase(s[code])='E') and (length(s)>=code) then
begin
inc(code);
if s[code]='+' then
inc(code)
else
if s[code]='-' then
begin
esign:=-1;
inc(code);
end;
if not(s[code] in ['0'..'9']) or (length(s)<code) then
begin
d:=0;
exit;
end;
while (s[code] in ['0'..'9']) and (length(s)>=code) do
begin
exponent:=exponent*i10;
exponent:=exponent+ord(s[code])-ord('0');
inc(code);
end;
end;
{ Calculate Exponent }
if esign>0 then
for i:=1 to exponent do
d:=d*i10
else
for i:=1 to exponent do
d:=d/i10;
{ Not all characters are read ? }
if length(s)>=code then
begin
d:=0.0;
exit;
end;
{ evalute sign }
d:=d*sign;
{ success ! }
code:=0;
end;
procedure val(const s : shortstring;var d : valreal;var code : integer);
begin
val(s,d,word(code));
end;
procedure val(const s : shortstring;var d : valreal;var code : longint);
var
cw : word;
begin
val(s,d,cw);
code:=cw;
end;
procedure val(const s : shortstring;var d : valreal);
var
code : word;
begin
val(s,d,code);
end;
{$ifdef SUPPORT_SINGLE}
procedure val(const s : shortstring;var d : single;var code : word);
var
e : valreal;
begin
val(s,e,code);
d:=e;
end;
procedure val(const s : shortstring;var d : single;var code : integer);
var
e : valreal;
begin
val(s,e,word(code));
d:=e;
end;
procedure val(const s : shortstring;var d : single;var code : longint);
var
cw : word;
e : valreal;
begin
val(s,e,cw);
d:=e;
code:=cw;
end;
procedure val(const s : shortstring;var d : single);
var
code : word;
e : valreal;
begin
val(s,e,code);
d:=e;
end;
{$endif SUPPORT_SINGLE}
{$ifdef DEFAULT_EXTENDED}
{ with extended as default the valreal is extended so for real there need
to be a new val }
procedure val(const s : shortstring;var d : real;var code : word);
var
e : valreal;
begin
val(s,e,code);
d:=e;
end;
procedure val(const s : shortstring;var d : real;var code : integer);
var
e : valreal;
begin
val(s,e,word(code));
d:=e;
end;
procedure val(const s : shortstring;var d : real;var code : longint);
var
cw : word;
e : valreal;
begin
val(s,e,cw);
d:=e;
code:=cw;
end;
procedure val(const s : shortstring;var d : real);
var
code : word;
e : valreal;
begin
val(s,e,code);
d:=e;
end;
{$else DEFAULT_EXTENDED}
{ when extended is not the default it could still be supported }
{$ifdef SUPPORT_EXTENDED}
procedure val(const s : shortstring;var d : extended;var code : word);
var
e : valreal;
begin
val(s,e,code);
d:=e;
end;
procedure val(const s : shortstring;var d : extended;var code : integer);
var
e : valreal;
begin
val(s,e,word(code));
d:=e;
end;
procedure val(const s : shortstring;var d : extended;var code : longint);
var
cw : word;
e : valreal;
begin
val(s,e,cw);
d:=e;
code:=cw;
end;
procedure val(const s : shortstring;var d : extended);
var
code : word;
e : valreal;
begin
val(s,e,code);
d:=e;
end;
{$endif SUPPORT_EXTENDED}
{$endif DEFAULT_EXTENDED}
{$ifdef SUPPORT_COMP}
procedure val(const s : shortstring;var d : comp;var code : word);
var
e : valreal;
begin
val(s,e,code);
d:=comp(e);
end;
procedure val(const s : shortstring;var d : comp;var code : integer);
var
e : valreal;
begin
val(s,e,word(code));
d:=comp(e);
end;
procedure val(const s : shortstring;var d : comp;var code : longint);
var
cw : word;
e : valreal;
begin
val(s,e,cw);
d:=comp(e);
code:=cw;
end;
procedure val(const s : shortstring;var d : comp);
var
code : word;
e : valreal;
begin
val(s,e,code);
d:=comp(e);
end;
{$endif SUPPORT_COMP}
{$ifdef SUPPORT_FIXED}
procedure val(const s : shortstring;var d : fixed;var code : word);
var
e : valreal;
begin
val(s,e,code);
d:=fixed(e);
end;
procedure val(const s : shortstring;var d : fixed;var code : integer);
var
e : valreal;
begin
val(s,e,word(code));
d:=fixed(e);
end;
procedure val(const s : shortstring;var d : fixed;var code : longint);
var
cw : word;
e : valreal;
begin
val(s,e,cw);
d:=fixed(e);
code:=cw;
end;
procedure val(const s : shortstring;var d : fixed);
var
code : word;
e : valreal;
begin
val(s,e,code);
d:=fixed(e);
end;
{$endif SUPPORT_FIXED}
{$EndIf ValInternCompiled}
Procedure SetString (Var S : Shortstring; Buf : PChar; Len : Longint); Procedure SetString (Var S : Shortstring; Buf : PChar; Len : Longint);
begin begin
Move (Buf[0],S[1],Len); Move (Buf[0],S[1],Len);
S[0]:=chr(len); S[0]:=chr(len);
@ -1200,7 +565,10 @@ end;
{ {
$Log$ $Log$
Revision 1.28 1999-05-06 09:05:13 peter Revision 1.29 1999-07-05 20:04:26 peter
* removed temp defines
Revision 1.28 1999/05/06 09:05:13 peter
* generic write_float str_float * generic write_float str_float
Revision 1.27 1999/04/08 15:57:54 peter Revision 1.27 1999/04/08 15:57:54 peter

37
rtl/inc/system.inc
View File

@ -32,6 +32,9 @@ Procedure HandleErrorFrame (Errno : longint;frame : longint); forward;
type type
FileFunc = Procedure(var t : TextRec); FileFunc = Procedure(var t : TextRec);
PLongint = ^Longint;
PByte = ^Byte;
const const
{ Random / Randomize constants } { Random / Randomize constants }
OldRandSeed : Cardinal = 0; OldRandSeed : Cardinal = 0;
@ -56,11 +59,11 @@ var
Function lo(i : Integer) : byte; [INTERNPROC: In_lo_Word]; Function lo(i : Integer) : byte; [INTERNPROC: In_lo_Word];
Function lo(w : Word) : byte; [INTERNPROC: In_lo_Word]; Function lo(w : Word) : byte; [INTERNPROC: In_lo_Word];
Function lo(l : Longint) : Word; [INTERNPROC: In_lo_long]; Function lo(l : Longint) : Word; [INTERNPROC: In_lo_long];
Function lo(l : DWord) : Word; [INTERNPROC: In_lo_long]; Function lo(l : DWord) : Word; [INTERNPROC: In_lo_long];
Function hi(i : Integer) : byte; [INTERNPROC: In_hi_Word]; Function hi(i : Integer) : byte; [INTERNPROC: In_hi_Word];
Function hi(w : Word) : byte; [INTERNPROC: In_hi_Word]; Function hi(w : Word) : byte; [INTERNPROC: In_hi_Word];
Function hi(l : Longint) : Word; [INTERNPROC: In_hi_long]; Function hi(l : Longint) : Word; [INTERNPROC: In_hi_long];
Function hi(l : DWord) : Word; [INTERNPROC: In_hi_long]; Function hi(l : DWord) : Word; [INTERNPROC: In_hi_long];
{$ifdef INT64} {$ifdef INT64}
Function lo(q : QWord) : DWord; [INTERNPROC: In_lo_qword]; Function lo(q : QWord) : DWord; [INTERNPROC: In_lo_qword];
@ -76,6 +79,7 @@ Function Length(c : char) : byte; [INTERNPROC: In_Length_string];
Procedure Reset(var f : TypedFile); [INTERNPROC: In_Reset_TypedFile]; Procedure Reset(var f : TypedFile); [INTERNPROC: In_Reset_TypedFile];
Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile]; Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
{**************************************************************************** {****************************************************************************
Include processor specific routines Include processor specific routines
****************************************************************************} ****************************************************************************}
@ -93,6 +97,7 @@ Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
{**************************************************************************** {****************************************************************************
Set Handling Set Handling
****************************************************************************} ****************************************************************************}
@ -100,6 +105,7 @@ Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
{ Include set support which is processor specific} { Include set support which is processor specific}
{$I set.inc} {$I set.inc}
{**************************************************************************** {****************************************************************************
Subroutines for String handling Subroutines for String handling
****************************************************************************} ****************************************************************************}
@ -108,10 +114,6 @@ Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
{$i sstrings.inc} {$i sstrings.inc}
Type
PLongint = ^Longint;
PByte = ^Byte;
{$i astrings.inc} {$i astrings.inc}
@ -266,13 +268,6 @@ Begin
ptr:=pointer(off); ptr:=pointer(off);
End; End;
{$ifndef INTERNALADDR}
Function Addr(var x):pointer;
begin
Addr:=@x;
end;
{$endif}
Function CSeg : Word; Function CSeg : Word;
Begin Begin
Cseg:=0; Cseg:=0;
@ -336,11 +331,9 @@ end;
{***************************************************************************** {*****************************************************************************
Init / Exit / ExitProc Initialization / Finalization
*****************************************************************************} *****************************************************************************}
{$ifdef HASFINALIZE}
const const
maxunits=1024; { See also files.pas of the compiler source } maxunits=1024; { See also files.pas of the compiler source }
type type
@ -386,8 +379,10 @@ begin
end; end;
end; end;
{$endif}
{*****************************************************************************
Error / Exit / ExitProc
*****************************************************************************}
Procedure HandleErrorFrame (Errno : longint;frame : longint); Procedure HandleErrorFrame (Errno : longint;frame : longint);
{ {
@ -472,10 +467,8 @@ Begin
exitProc:=nil; exitProc:=nil;
current_exit(); current_exit();
End; End;
{$ifdef HASFINALIZE}
{ Finalize units } { Finalize units }
FinalizeUnits; FinalizeUnits;
{$endif}
{ Show runtime error } { Show runtime error }
If erroraddr<>nil Then If erroraddr<>nil Then
Begin Begin
@ -565,6 +558,7 @@ end;
{$i setjump.inc} {$i setjump.inc}
{***************************************************************************** {*****************************************************************************
Object Pascal support Object Pascal support
*****************************************************************************} *****************************************************************************}
@ -573,7 +567,10 @@ end;
{ {
$Log$ $Log$
Revision 1.63 1999-07-03 01:24:19 peter Revision 1.64 1999-07-05 20:04:27 peter
* removed temp defines
Revision 1.63 1999/07/03 01:24:19 peter
* $ifdef int64 * $ifdef int64
Revision 1.62 1999/07/02 18:06:42 florian Revision 1.62 1999/07/02 18:06:42 florian

136
rtl/inc/systemh.inc
View File

@ -50,10 +50,6 @@ Type
{$ifdef i386} {$ifdef i386}
StrLenInt = LongInt; StrLenInt = LongInt;
{$ifndef INTERNDOUBLE}
Double = real;
{$endif}
{$define DEFAULT_EXTENDED} {$define DEFAULT_EXTENDED}
{$define SUPPORT_SINGLE} {$define SUPPORT_SINGLE}
@ -90,12 +86,9 @@ Type
TProcedure = Procedure; TProcedure = Procedure;
const const
{$IfDef ValInternCompiled}
{ Maximum value of the biggest signed and unsigned integer type available} { Maximum value of the biggest signed and unsigned integer type available}
MaxSIntValue = High(ValSInt); MaxSIntValue = High(ValSInt);
MaxUIntValue = High(ValUInt); MaxUIntValue = High(ValUInt);
{$EndIf ValInternCompiled}
{ max. values for longint and int} { max. values for longint and int}
maxLongint = $7fffffff; maxLongint = $7fffffff;
@ -117,6 +110,7 @@ const
{ max level in dumping on error } { max level in dumping on error }
Max_Frame_Dump : Word = 8; Max_Frame_Dump : Word = 8;
{ Exit Procedure handling consts and types } { Exit Procedure handling consts and types }
ExitProc : pointer = nil; ExitProc : pointer = nil;
Erroraddr: pointer = nil; Erroraddr: pointer = nil;
@ -206,9 +200,6 @@ Function odd(l:Longint):Boolean;
{$ifndef RTLLITE} {$ifndef RTLLITE}
Function ptr(sel,off:Longint):pointer; Function ptr(sel,off:Longint):pointer;
{$ifndef INTERNALADDR}
Function Addr(var x):pointer;
{$endif}
Function Cseg:Word; Function Cseg:Word;
Function Dseg:Word; Function Dseg:Word;
Function Sseg:Word; Function Sseg:Word;
@ -231,89 +222,31 @@ Function Pos(C:Char;const s:shortstring):StrLenInt;
Procedure SetLength(var s:shortstring;len:StrLenInt); Procedure SetLength(var s:shortstring;len:StrLenInt);
Procedure SetString (Var S : Shortstring; Buf : PChar; Len : Longint); Procedure SetString (Var S : Shortstring; Buf : PChar; Len : Longint);
Function Length(s:string):byte; Function Length(s:string):byte;
Function upCase(const s:shortstring):shortstring;
{$ifndef RTLLITE}
Function lowerCase(const s:shortstring):shortstring;
{$endif}
Function Space(b:byte):shortstring;
{$ifndef RTLLITE}
Function hexStr(Val:Longint;cnt:byte):shortstring;
Function binStr(Val:Longint;cnt:byte):shortstring;
{$endif RTLLITE}
{ Char functions to overcome overloading problem with ansistrings } { Char functions }
Function Chr(b:byte):Char;
Function upCase(c:Char):Char;
{$ifndef RTLLITE}
Function lowerCase(c:Char):Char;
{$endif RTLLITE}
function copy(c:char;index : StrLenInt;count : StrLenInt): shortstring; function copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;
function pos(const substr : shortstring;c:char): StrLenInt; function pos(const substr : shortstring;c:char): StrLenInt;
function length(c:char):byte; function length(c:char):byte;
Function Chr(b:byte):Char;
Function upCase(const s:shortstring):shortstring;
Function upCase(c:Char):Char;
{$ifndef RTLLITE}
Function lowerCase(c:Char):Char;
Function lowerCase(const s:shortstring):shortstring;
Function hexStr(Val:Longint;cnt:byte):shortstring;
Function binStr(Val:Longint;cnt:byte):shortstring;
{$endif RTLLITE}
Function Space(b:byte):shortstring;
{$IfNDef ValInternCompiled}
Procedure Val(const s:shortstring;Var l:Longint;Var code:Word);
Procedure Val(const s:shortstring;Var l:Longint;Var code:Integer);
Procedure Val(const s:shortstring;Var l:Longint;Var code:Longint);
Procedure Val(const s:shortstring;Var l:Longint);
Procedure Val(const s:shortstring;Var b:byte;Var code:Word);
Procedure Val(const s:shortstring;Var b:byte;Var code:Integer);
Procedure Val(const s:shortstring;Var b:byte;Var code:Longint);
Procedure Val(const s:shortstring;Var b:byte);
Procedure Val(const s:shortstring;Var b:shortint;Var code:Word);
Procedure Val(const s:shortstring;Var b:shortint;Var code:Integer);
Procedure Val(const s:shortstring;Var b:shortint;Var code:Longint);
Procedure Val(const s:shortstring;Var b:shortint);
Procedure Val(const s:shortstring;Var b:Word;Var code:Word);
Procedure Val(const s:shortstring;Var b:Word;Var code:Integer);
Procedure Val(const s:shortstring;Var b:Word;Var code:Longint);
Procedure Val(const s:shortstring;Var b:Word);
Procedure Val(const s:shortstring;Var b:Integer;Var code:Word);
Procedure Val(const s:shortstring;Var b:Integer;Var code:Integer);
Procedure Val(const s:shortstring;Var b:Integer;Var code:Longint);
Procedure Val(const s:shortstring;Var b:Integer);
Procedure Val(const s:shortstring;Var v:cardinal;Var code:Word);
Procedure Val(const s:shortstring;Var v:cardinal;Var code:Integer);
Procedure Val(const s:shortstring;Var v:cardinal;Var code:Longint);
Procedure Val(const s:shortstring;Var v:cardinal);
Procedure Val(const s:shortstring;Var d:ValReal;Var code:Word);
Procedure Val(const s:shortstring;Var d:ValReal;Var code:Integer);
Procedure Val(const s:shortstring;Var d:ValReal;Var code:Longint);
Procedure Val(const s:shortstring;Var d:ValReal);
{$ifdef SUPPORT_SINGLE}
Procedure Val(const s:shortstring;Var d:single;Var code:Word);
Procedure Val(const s:shortstring;Var d:single;Var code:Integer);
Procedure Val(const s:shortstring;Var d:single;Var code:Longint);
Procedure Val(const s:shortstring;Var d:single);
{$endif SUPPORT_SINGLE}
{$ifdef SUPPORT_COMP}
Procedure Val(const s:shortstring;Var d:comp;Var code:Word);
Procedure Val(const s:shortstring;Var d:comp;Var code:Integer);
Procedure Val(const s:shortstring;Var d:comp;Var code:Longint);
Procedure Val(const s:shortstring;Var d:comp);
{$endif SUPPORT_COMP}
{$ifdef SUPPORT_FIXED}
Procedure Val(const s:shortstring;Var d:fixed;Var code:Word);
Procedure Val(const s:shortstring;Var d:fixed;Var code:Integer);
Procedure Val(const s:shortstring;Var d:fixed;Var code:Longint);
Procedure Val(const s:shortstring;Var d:fixed);
{$endif SUPPORT_FIXED}
{$ifdef DEFAULT_EXTENDED}
Procedure Val(const s:shortstring;Var d:Real;Var code:Word);
Procedure Val(const s:shortstring;Var d:Real;Var code:Integer);
Procedure Val(const s:shortstring;Var d:Real;Var code:Longint);
Procedure Val(const s:shortstring;Var d:Real);
{$else DEFAULT_EXTENDED}
{$ifdef SUPPORT_EXTENDED}
Procedure Val(const s:shortstring;Var d:Extended;Var code:Word);
Procedure Val(const s:shortstring;Var d:Extended;Var code:Integer);
Procedure Val(const s:shortstring;Var d:Extended;Var code:Longint);
Procedure Val(const s:shortstring;Var d:Extended);
{$endif}
{$endif DEFAULT_EXTENDED}
{$EndIf ValInternCompiled}
{**************************************************************************** {****************************************************************************
AnsiString Handling AnsiString Handling
****************************************************************************} ****************************************************************************}
Procedure SetLength (Var S : AnsiString; l : Longint); Procedure SetLength (Var S : AnsiString; l : Longint);
Procedure UniqueAnsiString (Var S : AnsiString); Procedure UniqueAnsiString (Var S : AnsiString);
Function Length (Const S : AnsiString) : Longint; Function Length (Const S : AnsiString) : Longint;
@ -321,30 +254,6 @@ Function Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString;
Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : Longint; Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : Longint;
Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint); Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint);
Procedure Delete (Var S : AnsiString; Index,Size: Longint); Procedure Delete (Var S : AnsiString; Index,Size: Longint);
{$IfNDef ValInternCompiled}
Procedure Val (Const S : AnsiString; var R : real; Var Code : Integer);
{
Procedure Val (Const S : AnsiString; var D : Double; Var Code : Integer);
}
Procedure Val (Const S : AnsiString; var E : Extended; Code : Integer);
Procedure Val (Const S : AnsiString; var C : Cardinal; Code : Integer);
Procedure Val (Const S : AnsiString; var L : Longint; Var Code : Integer);
Procedure Val (Const S : AnsiString; var W : Word; Var Code : Integer);
Procedure Val (Const S : AnsiString; var I : Integer; Var Code : Integer);
Procedure Val (Const S : AnsiString; var B : Byte; Var Code : Integer);
Procedure Val (Const S : AnsiString; var SI : ShortInt; Var Code : Integer);
{$EndIf ValInternCompiled}
{
Procedure Str (Const R : Real;Len, fr : longint; Var S : AnsiString);
Procedure Str (Const D : Double;Len,fr : longint; Var S : AnsiString);
Procedure Str (Const E : Extended;Len,fr : longint; Var S : AnsiString);
Procedure Str (Const C : Cardinal;len : Longint; Var S : AnsiString);
Procedure Str (Const L : LongInt;len : longint; Var S : AnsiString);
Procedure Str (Const W : Word;len : longint; Var S : AnsiString);
Procedure Str (Const I : Integer;len : Longint; Var S : AnsiString);
Procedure Str (Const B : Byte; Len : longint; Var S : AnsiString);
Procedure Str (Const SI : ShortInt; Len : longint; Var S : AnsiString);
}
{**************************************************************************** {****************************************************************************
@ -377,6 +286,7 @@ Procedure Rename(Var f:File;p:pchar);
Procedure Rename(Var f:File;c:char); Procedure Rename(Var f:File;c:char);
Procedure Truncate (Var F:File); Procedure Truncate (Var F:File);
{**************************************************************************** {****************************************************************************
Typed File Management Typed File Management
****************************************************************************} ****************************************************************************}
@ -387,6 +297,7 @@ Procedure Assign(Var f:TypedFile;c:char);
Procedure Rewrite(Var f:TypedFile); Procedure Rewrite(Var f:TypedFile);
Procedure Reset(Var f:TypedFile); Procedure Reset(Var f:TypedFile);
{**************************************************************************** {****************************************************************************
Text File Management Text File Management
****************************************************************************} ****************************************************************************}
@ -414,6 +325,7 @@ Function SeekEOF:Boolean;
Procedure SetTextBuf(Var f:Text; Var Buf); Procedure SetTextBuf(Var f:Text; Var Buf);
Procedure SetTextBuf(Var f:Text; Var Buf; Size:Word); Procedure SetTextBuf(Var f:Text; Var Buf; Size:Word);
{**************************************************************************** {****************************************************************************
Directory Management Directory Management
****************************************************************************} ****************************************************************************}
@ -424,6 +336,7 @@ Procedure rmdir(const s:string);
Procedure getdir(drivenr:byte;Var dir:shortstring); Procedure getdir(drivenr:byte;Var dir:shortstring);
Procedure getdir(drivenr:byte;Var dir:ansistring); Procedure getdir(drivenr:byte;Var dir:ansistring);
{***************************************************************************** {*****************************************************************************
Miscelleaous Miscelleaous
*****************************************************************************} *****************************************************************************}
@ -436,6 +349,7 @@ function get_caller_frame(framebp:longint):longint;
Function IOResult:Word; Function IOResult:Word;
Function Sptr:Longint; Function Sptr:Longint;
{***************************************************************************** {*****************************************************************************
Init / Exit / ExitProc Init / Exit / ExitProc
*****************************************************************************} *****************************************************************************}
@ -453,6 +367,7 @@ Procedure AddExitProc(Proc:TProcedure);
{$endif RTLLITE} {$endif RTLLITE}
Procedure halt; Procedure halt;
{***************************************************************************** {*****************************************************************************
Abstract/Assert Abstract/Assert
*****************************************************************************} *****************************************************************************}
@ -471,14 +386,19 @@ const
{$i setjumph.inc} {$i setjumph.inc}
{***************************************************************************** {*****************************************************************************
Object Pascal support Object Pascal support
*****************************************************************************} *****************************************************************************}
{$i objpash.inc} {$i objpash.inc}
{ {
$Log$ $Log$
Revision 1.60 1999-07-03 01:24:21 peter Revision 1.61 1999-07-05 20:04:28 peter
* removed temp defines
Revision 1.60 1999/07/03 01:24:21 peter
* $ifdef int64 * $ifdef int64
Revision 1.59 1999/07/02 18:06:43 florian Revision 1.59 1999/07/02 18:06:43 florian

386
rtl/inc/text.inc
View File

@ -433,7 +433,7 @@ begin
end; end;
Procedure Write_Str(Len : Longint;var f : TextRec;const s : String);[Public,Alias:'FPC_WRITE_TEXT_'+{$ifdef NEWREADINT}'SHORTSTR'{$else}'STRING'{$endif}]; Procedure Write_Str(Len : Longint;var f : TextRec;const s : String);[Public,Alias:'FPC_WRITE_TEXT_SHORTSTR'];
Begin Begin
If (InOutRes<>0) then If (InOutRes<>0) then
exit; exit;
@ -448,11 +448,7 @@ Begin
End; End;
{$ifndef NEWWRITEARRAY} Procedure Write_Array(Len : Longint;var f : TextRec;const s : array of char);[Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_ARRAY'];
type
array00=array[0..0] of char;
{$endif}
Procedure Write_Array(Len : Longint;var f : TextRec;const s : {$ifdef NEWWRITEARRAY} array of char{$else}array00{$endif});[Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_ARRAY'];
var var
ArrayLen : longint; ArrayLen : longint;
p : pchar; p : pchar;
@ -492,7 +488,7 @@ Begin
End; End;
Procedure Write_Text_AnsiString (Len : Longint; Var T : TextRec; S : Pointer);[Public,alias:'FPC_WRITE_TEXT_'+{$ifdef NEWREADINT}'ANSISTR'{$else}'ANSISTRING'{$endif}]; Procedure Write_Text_AnsiString (Len : Longint; Var T : TextRec; S : Pointer);[Public,alias:'FPC_WRITE_TEXT_ANSISTR'];
{ {
Writes a AnsiString to the Text file T Writes a AnsiString to the Text file T
} }
@ -503,7 +499,7 @@ begin
end; end;
Procedure Write_SInt(Len : Longint;var t : TextRec;l : ValSInt);[Public,Alias:'FPC_WRITE_TEXT_'+{$ifdef NEWREADINT}'SINT'{$else}'LONGINT'{$endif}]; Procedure Write_SInt(Len : Longint;var t : TextRec;l : ValSInt);[Public,Alias:'FPC_WRITE_TEXT_SINT'];
var var
s : String; s : String;
Begin Begin
@ -514,7 +510,7 @@ Begin
End; End;
Procedure Write_UInt(Len : Longint;var t : TextRec;l : ValUInt);[Public,Alias:'FPC_WRITE_TEXT_'+{$ifdef NEWREADINT}'UINT'{$else}'CARDINAL'{$endif}]; Procedure Write_UInt(Len : Longint;var t : TextRec;l : ValUInt);[Public,Alias:'FPC_WRITE_TEXT_UINT'];
var var
s : String; s : String;
Begin Begin
@ -524,21 +520,19 @@ Begin
Write_Str(Len,t,s); Write_Str(Len,t,s);
End; End;
{$ifdef INT64} {$ifdef INT64}
procedure write_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_WRITE_TEXT_QWORD']; procedure write_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_WRITE_TEXT_QWORD'];
var
var s : string;
s : string; begin
if (InOutRes<>0) then
begin exit;
if (InOutRes<>0) then int_str(q,s);
exit; write_str(len,t,s);
int_str(q,s); end;
write_str(len,t,s);
end;
{$endif INT64} {$endif INT64}
{$ifdef INTERNDOUBLE}
Procedure Write_Float(rt,fixkomma,Len : Longint;var t : TextRec;r : ValReal);[Public,Alias:'FPC_WRITE_TEXT_FLOAT']; Procedure Write_Float(rt,fixkomma,Len : Longint;var t : TextRec;r : ValReal);[Public,Alias:'FPC_WRITE_TEXT_FLOAT'];
var var
@ -550,75 +544,6 @@ Begin
Write_Str(Len,t,s); Write_Str(Len,t,s);
End; End;
{$else INTERNDOUBLE}
{$ifdef SUPPORT_SINGLE}
Procedure Write_S32Real(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias:'FPC_WRITE_TEXT_'+{$ifdef INTERNDOUBLE}'S32REAL'{$else}'SINGLE'{$endif}];
var
s : String;
Begin
If (InOutRes<>0) then
exit;
Str_real(Len,fixkomma,r,rt_s32real,s);
Write_Str(Len,t,s);
End;
{$endif SUPPORT_S32REAL}
{$ifdef SUPPORT_DOUBLE}
Procedure Write_s64Real(fixkomma,Len : Longint;var t : TextRec;r : double);[Public,Alias:'FPC_WRITE_TEXT_'+{$ifdef INTERNDOUBLE}'S64'{$endif}+'REAL'];
var
s : String;
Begin
If (InOutRes<>0) then
exit;
Str_real(Len,fixkomma,r,rt_s64real,s);
Write_Str(Len,t,s);
End;
{$endif SUPPORT_S64REAL}
{$ifdef SUPPORT_EXTENDED}
Procedure Write_S80Real(fixkomma,Len : Longint;var t : TextRec;r : extended);[Public,Alias:'FPC_WRITE_TEXT_'+{$ifdef INTERNDOUBLE}'S80REAL'{$else}'EXTENDED'{$endif}];
var
s : String;
Begin
If (InOutRes<>0) then
exit;
Str_real(Len,fixkomma,r,rt_s80real,s);
Write_Str(Len,t,s);
End;
{$endif SUPPORT_S80REAL}
{$ifdef SUPPORT_COMP}
Procedure Write_C64Bit(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias:'FPC_WRITE_TEXT_'+{$ifdef INTERNDOUBLE}'C64BIT'{$else}'COMP'{$endif}];
var
s : String;
Begin
If (InOutRes<>0) then
exit;
Str_real(Len,fixkomma,r,rt_c64bit,s);
Write_Str(Len,t,s);
End;
{$endif SUPPORT_C64BIT}
{$ifdef SUPPORT_FIXED}
Procedure Write_Fixed(fixkomma,Len : Longint;var t : TextRec;r : fixed16);[Public,Alias:'FPC_WRITE_TEXT_'+{$ifdef INTERNDOUBLE}'F16BIT'{$else}'FIXED'{$endif}];
var
s : String;
Begin
If (InOutRes<>0) then
exit;
Str_real(Len,fixkomma,r,rt_f32bit,s);
Write_Str(Len,t,s);
End;
{$endif SUPPORT_F16BIT}
{$endif INTERNDOUBLE}
Procedure Write_Boolean(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias:'FPC_WRITE_TEXT_BOOLEAN']; Procedure Write_Boolean(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias:'FPC_WRITE_TEXT_BOOLEAN'];
Begin Begin
@ -669,7 +594,6 @@ begin
end; end;
Function IgnoreSpaces(var f:TextRec):Boolean; Function IgnoreSpaces(var f:TextRec):Boolean;
{ {
Removes all leading spaces,tab,eols from the input buffer, returns true if Removes all leading spaces,tab,eols from the input buffer, returns true if
@ -818,7 +742,7 @@ Begin
End; End;
Procedure Read_String(var f : TextRec;var s : String);[Public,Alias:'FPC_READ_TEXT_'+{$ifdef NEWREADINT}'SHORTSTR'{$else}'STRING'{$endif}]; Procedure Read_String(var f : TextRec;var s : String);[Public,Alias:'FPC_READ_TEXT_SHORTSTR'];
Begin Begin
s[0]:=chr(ReadPCharLen(f,pchar(@s[1]),high(s))); s[0]:=chr(ReadPCharLen(f,pchar(@s[1]),high(s)));
End; End;
@ -830,13 +754,13 @@ Begin
End; End;
Procedure Read_Array(var f : TextRec;var s : {$ifdef NEWWRITEARRAY}array of char{$else}array00{$endif});[Public,Alias:'FPC_READ_TEXT_PCHAR_AS_ARRAY']; Procedure Read_Array(var f : TextRec;var s : array of char);[Public,Alias:'FPC_READ_TEXT_PCHAR_AS_ARRAY'];
Begin Begin
pchar(pchar(@s)+ReadPCharLen(f,pchar(@s),{$ifdef NEWWRITEARRAY}high(s){$else}$7fffffff{$endif}))^:=#0; pchar(pchar(@s)+ReadPCharLen(f,pchar(@s),high(s)))^:=#0;
End; End;
Procedure Read_AnsiString(var f : TextRec;var s : AnsiString);[Public,Alias:'FPC_READ_TEXT_'+{$ifdef NEWREADINT}'ANSISTR'{$else}'ANSISTRING'{$endif}]; Procedure Read_AnsiString(var f : TextRec;var s : AnsiString);[Public,Alias:'FPC_READ_TEXT_ANSISTR'];
var var
len : longint; len : longint;
Begin Begin
@ -850,8 +774,6 @@ Begin
End; End;
{$ifdef NEWREADINT}
Function Read_Char(var f : TextRec):char;[Public,Alias:'FPC_READ_TEXT_CHAR']; Function Read_Char(var f : TextRec):char;[Public,Alias:'FPC_READ_TEXT_CHAR'];
Begin Begin
Read_Char:=#0; Read_Char:=#0;
@ -971,260 +893,13 @@ begin
InOutRes:=106; InOutRes:=106;
end; end;
{$ifdef INT64}
procedure read_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_READ_TEXT_QWORD'];
begin
{!!!!!!!!!!!!!}
end;
{$endif INT64}
{$else}
Procedure Read_Char(var f : TextRec;var c : Char);[Public,Alias:'FPC_READ_TEXT_CHAR'];
Begin
c:=#0;
{ Check error and if file is open }
If (InOutRes<>0) then
exit;
if (f.mode<>fmInput) Then
begin
InOutRes:=104;
exit;
end;
{ Read next char or EOF }
If f.BufPos>=f.BufEnd Then
begin
FileFunc(f.InOutFunc)(f);
If f.BufPos>=f.BufEnd Then
begin
c:=#26;
exit;
end;
end;
c:=f.Bufptr^[f.BufPos];
inc(f.BufPos);
end;
Procedure Read_Longint(var f : TextRec;var l : Longint);[Public,Alias:'FPC_READ_TEXT_LONGINT'];
var
hs : String;
code : Longint;
base : longint;
Begin
l:=0;
{ Leave if error or not open file, else check for empty buf }
If (InOutRes<>0) then
exit;
if (f.mode<>fmInput) Then
begin
InOutRes:=104;
exit;
end;
If f.BufPos>=f.BufEnd Then
FileFunc(f.InOutFunc)(f);
hs:='';
if IgnoreSpaces(f) and ReadSign(f,hs) and ReadBase(f,hs,Base) then
ReadNumeric(f,hs,Base);
Val(hs,l,code);
If code<>0 Then
InOutRes:=106;
End;
Procedure Read_Integer(var f : TextRec;var l : Integer);[Public,Alias:'FPC_READ_TEXT_INTEGER'];
var
ll : Longint;
Begin
l:=0;
If InOutRes <> 0 then
exit;
Read_Longint(f,ll);
If (ll<-32768) or (ll>32767) Then
InOutRes:=201
else
l:=ll;
End;
Procedure Read_Word(var f : TextRec;var l : Word);[Public,Alias:'FPC_READ_TEXT_WORD'];
var
ll : Longint;
Begin
l:=0;
If InOutRes <> 0 then
exit;
Read_Longint(f,ll);
If (ll<0) or (ll>$ffff) Then
InOutRes:=201
else
l:=ll;
End;
Procedure Read_Byte(var f : TextRec;var l : byte);[Public,Alias:'FPC_READ_TEXT_BYTE'];
var
ll : Longint;
Begin
l:=0;
If InOutRes <> 0 then
exit;
Read_Longint(f,ll);
If (ll<0) or (ll>255) Then
InOutRes:=201
else
l:=ll;
End;
Procedure Read_Shortint(var f : TextRec;var l : shortint);[Public,Alias:'FPC_READ_TEXT_SHORTINT'];
var
ll : Longint;
Begin
l:=0;
If InOutRes <> 0 then
exit;
Read_Longint(f,ll);
If (ll<-128) or (ll>127) Then
InOutRes:=201
else
l:=ll;
End;
Procedure Read_Cardinal(var f : TextRec;var l : cardinal);[Public,Alias:'FPC_READ_TEXT_CARDINAL'];
var
hs : String;
code : longint;
base : longint;
Begin
l:=0;
{ Leave if error or not open file, else check for empty buf }
If (InOutRes<>0) then
exit;
if (f.mode<>fmInput) Then
begin
InOutRes:=104;
exit;
end;
If f.BufPos>=f.BufEnd Then
FileFunc(f.InOutFunc)(f);
hs:='';
if IgnoreSpaces(f) and ReadSign(f,hs) and ReadBase(f,hs,Base) then
ReadNumeric(f,hs,Base);
val(hs,l,code);
If code<>0 Then
InOutRes:=106;
End;
{$ifdef INT64} {$ifdef INT64}
procedure read_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_READ_TEXT_QWORD']; procedure read_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_READ_TEXT_QWORD'];
begin
{!!!!!!!!!!!!!}
end;
{$endif INT64}
function ReadRealStr(var f:TextRec):string;
var
hs : string;
begin begin
ReadRealStr:=''; { !!!!!!!!!!!!! }
{ Leave if error or not open file, else check for empty buf }
If (InOutRes<>0) then
exit;
if (f.mode<>fmInput) Then
begin
InOutRes:=104;
exit;
end;
If f.BufPos>=f.BufEnd Then
FileFunc(f.InOutFunc)(f);
hs:='';
if IgnoreSpaces(f) and ReadSign(f,hs) and ReadNumeric(f,hs,10) then
begin
{ First check for a . }
if (f.Bufptr^[f.BufPos]='.') and (f.BufPos<f.BufEnd) Then
begin
hs:=hs+'.';
Inc(f.BufPos);
If f.BufPos>=f.BufEnd Then
FileFunc(f.InOutFunc)(f);
ReadNumeric(f,hs,10);
end;
{ Also when a point is found check for a E }
if (f.Bufptr^[f.BufPos] in ['e','E']) and (f.BufPos<f.BufEnd) Then
begin
hs:=hs+'E';
Inc(f.BufPos);
If f.BufPos>=f.BufEnd Then
FileFunc(f.InOutFunc)(f);
if ReadSign(f,hs) then
ReadNumeric(f,hs,10);
end;
end;
ReadRealStr:=hs;
end; end;
{$endif INT64}
Procedure Read_Real(var f : TextRec;var d : Real);[Public,Alias:'FPC_READ_TEXT_REAL'];
var
code : Word;
Begin
val(ReadRealStr(f),d,code);
If code<>0 Then
InOutRes:=106;
End;
{$ifdef SUPPORT_SINGLE}
Procedure Read_Single(var f : TextRec;var d : single);[Public,Alias:'FPC_READ_TEXT_SINGLE'];
var
code : Word;
Begin
val(ReadRealStr(f),d,code);
If code<>0 Then
InOutRes:=106;
End;
{$endif SUPPORT_SINGLE}
{$ifdef SUPPORT_EXTENDED}
Procedure Read_Extended(var f : TextRec;var d : extended);[Public,Alias:'FPC_READ_TEXT_EXTENDED'];
var
code : Word;
Begin
val(ReadRealStr(f),d,code);
If code<>0 Then
InOutRes:=106;
End;
{$endif SUPPORT_EXTENDED}
{$ifdef SUPPORT_COMP}
Procedure Read_Comp(var f : TextRec;var d : comp);[Public,Alias:'FPC_READ_TEXT_COMP'];
var
code : Word;
Begin
val(ReadRealStr(f),d,code);
If code<>0 Then
InOutRes:=106;
End;
{$endif SUPPORT_COMP}
{$ifdef SUPPORT_FIXED}
Procedure Read_Fixed(var f : TextRec;var d : fixed);[Public,Alias:'FPC_READ_TEXT_FIXED'];
var
code : Word;
Begin
val(ReadRealStr(f),d,code);
If code<>0 Then
InOutRes:=106;
End;
{$endif SUPPORT_FIXED}
{$endif}
{***************************************************************************** {*****************************************************************************
@ -1238,11 +913,13 @@ begin
TextRec(f).Mode:=mode; TextRec(f).Mode:=mode;
TextRec(f).Closefunc:=@FileCloseFunc; TextRec(f).Closefunc:=@FileCloseFunc;
case mode of case mode of
fmInput : TextRec(f).InOutFunc:=@FileReadFunc; fmInput :
fmOutput : begin TextRec(f).InOutFunc:=@FileReadFunc;
TextRec(f).InOutFunc:=@FileWriteFunc; fmOutput :
TextRec(f).FlushFunc:=@FileWriteFunc; begin
end; TextRec(f).InOutFunc:=@FileWriteFunc;
TextRec(f).FlushFunc:=@FileWriteFunc;
end;
else else
HandleError(102); HandleError(102);
end; end;
@ -1251,7 +928,10 @@ end;
{ {
$Log$ $Log$
Revision 1.48 1999-07-01 15:39:52 florian Revision 1.49 1999-07-05 20:04:29 peter
* removed temp defines
Revision 1.48 1999/07/01 15:39:52 florian
+ qword/int64 type released + qword/int64 type released
Revision 1.47 1999/06/30 22:17:24 florian Revision 1.47 1999/06/30 22:17:24 florian

46
rtl/win32/syswin32.pp
View File

@ -250,12 +250,9 @@ end;
external 'kernel32' name 'GlobalSize'; external 'kernel32' name 'GlobalSize';
{$endif} {$endif}
{$ifdef NEWATT} var
var heap : longint;external name 'HEAP'; heap : longint;external name 'HEAP';
var intern_heapsize : longint;external name 'HEAPSIZE'; intern_heapsize : longint;external name 'HEAPSIZE';
{$else NEWATT}
{$asmmode direct}
{$endif def NEWATT}
function getheapstart:pointer;assembler; function getheapstart:pointer;assembler;
asm asm
@ -265,11 +262,7 @@ end ['EAX'];
function getheapsize:longint;assembler; function getheapsize:longint;assembler;
asm asm
{$ifdef NEWATT}
movl intern_HEAPSIZE,%eax movl intern_HEAPSIZE,%eax
{$else}
movl HEAPSIZE,%eax
{$endif}
end ['EAX']; end ['EAX'];
@ -290,6 +283,7 @@ end;
{ include standard heap management } { include standard heap management }
{$I heap.inc} {$I heap.inc}
{***************************************************************************** {*****************************************************************************
Low Level File Routines Low Level File Routines
*****************************************************************************} *****************************************************************************}
@ -373,14 +367,14 @@ end;
function do_read(h,addr,len : longint) : longint; function do_read(h,addr,len : longint) : longint;
var var
result:longint; _result:longint;
begin begin
if readfile(h,pointer(addr),len,result,nil)=0 then if readfile(h,pointer(addr),len,_result,nil)=0 then
Begin Begin
errno:=GetLastError; errno:=GetLastError;
Errno2InoutRes; Errno2InoutRes;
end; end;
do_read:=result; do_read:=_result;
end; end;
@ -757,16 +751,13 @@ end;
{$endif} {$endif}
procedure install_exception_handlers;forward; procedure install_exception_handlers;forward;
{$ifdef NEWATT}
procedure PascalMain;external name 'PASCALMAIN'; procedure PascalMain;external name 'PASCALMAIN';
procedure fpc_do_exit;external name 'FPC_DO_EXIT'; procedure fpc_do_exit;external name 'FPC_DO_EXIT';
{$endif def NEWATT}
var var
{ value of the stack segment { value of the stack segment
to check if the call stack can be written on exceptions } to check if the call stack can be written on exceptions }
_SS : longint; _SS : longint;
procedure Exe_entry;[public, alias : '_FPC_EXE_Entry']; procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
begin begin
@ -782,11 +773,6 @@ procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
movw %ss,%bp movw %ss,%bp
movl %ebp,_SS movl %ebp,_SS
xorl %ebp,%ebp xorl %ebp,%ebp
end;
{$ifndef NEWATT}
{$ASMMODE DIRECT}
{$endif ndef NEWATT}
asm
call PASCALMAIN call PASCALMAIN
popl %ebp popl %ebp
end; end;
@ -794,7 +780,6 @@ procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
ExitProcess(0); ExitProcess(0);
end; end;
{$ASMMODE ATT}
procedure Dll_entry;[public, alias : '_FPC_DLL_Entry']; procedure Dll_entry;[public, alias : '_FPC_DLL_Entry'];
begin begin
@ -805,11 +790,6 @@ procedure Dll_entry;[public, alias : '_FPC_DLL_Entry'];
asm asm
xorl %edi,%edi xorl %edi,%edi
movw %ss,%di movw %ss,%di
end;
{$ifndef NEWATT}
{$ASMMODE DIRECT}
{$endif ndef NEWATT}
asm
movl %edi,_SS movl %edi,_SS
call PASCALMAIN call PASCALMAIN
end; end;
@ -823,7 +803,6 @@ procedure Dll_entry;[public, alias : '_FPC_DLL_Entry'];
end; end;
end; end;
{$ASMMODE ATT}
{$ifdef Set_i386_Exception_handler} {$ifdef Set_i386_Exception_handler}
@ -1022,7 +1001,10 @@ end.
{ {
$Log$ $Log$
Revision 1.40 1999-06-11 16:26:40 michael Revision 1.41 1999-07-05 20:04:30 peter
* removed temp defines
Revision 1.40 1999/06/11 16:26:40 michael
+ Fixed paramstr(0) + Fixed paramstr(0)
Revision 1.39 1999/05/17 21:52:47 florian Revision 1.39 1999/05/17 21:52:47 florian