Browse Source

* removed temp defines

peter 26 years ago
parent
commit
ebd738f2f5
9 changed files with 184 additions and 1410 deletions
  1. 67 230
      rtl/inc/astrings.inc
  2. 4 12
      rtl/inc/generic.inc
  3. 5 2
      rtl/inc/int64.inc
  4. 4 9
      rtl/inc/objpas.inc
  5. 12 644
      rtl/inc/sstrings.inc
  6. 17 20
      rtl/inc/system.inc
  7. 27 107
      rtl/inc/systemh.inc
  8. 33 353
      rtl/inc/text.inc
  9. 15 33
      rtl/win32/syswin32.pp

+ 67 - 230
rtl/inc/astrings.inc

@@ -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);
-       S3:=nil;
-    end;
-
+    AnsiStr_Decr_Ref(S3);
+{ only assign if s1 or s2 is empty }
   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
-    SNew:=NewAnsiString (PAnsiRec(Pointer(S)-FirstOff)^.len);
-    Move (Pointer(S)^,SNew^,PAnsiRec(Pointer(S)-FirstOff)^.len+1);
-    PAnsiRec(SNew-FirstOff)^.len:=PAnsiRec(Pointer(S)-FirstOff)^.len;
-    ansistr_decr_ref (Pointer(S));  { Thread safe }
-    Pointer(S):=SNew;
-    end;
+   begin
+     SNew:=NewAnsiString (PAnsiRec(Pointer(S)-FirstOff)^.len);
+     Move (Pointer(S)^,SNew^,PAnsiRec(Pointer(S)-FirstOff)^.len+1);
+     PAnsiRec(SNew-FirstOff)^.len:=PAnsiRec(Pointer(S)-FirstOff)^.len;
+     ansistr_decr_ref (Pointer(S));  { Thread safe }
+     Pointer(S):=SNew;
+   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
-    If Index<0 Then
+   begin
+     If Index<0 Then
       Index:=0;
       Index:=0;
-    ResultAddress:=Pointer(NewAnsiString (Size));
-    if ResultAddress<>Nil then
+     ResultAddress:=Pointer(NewAnsiString (Size));
+     if ResultAddress<>Nil then
       begin
       begin
-      Move (Pointer(Pointer(S)+index)^,ResultAddress^,Size);
-      PAnsiRec(ResultAddress-FirstOff)^.Len:=Size;
-      PByte(ResultAddress+Size)^:=0;
+        Move (Pointer(Pointer(S)+index)^,ResultAddress^,Size);
+        PAnsiRec(ResultAddress-FirstOff)^.Len:=Size;
+        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;
-  S : AnsiString;
-  se : Pointer;
+  e   : boolean;
+  S   : AnsiString;
+  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);
-  [Public,Alias : 'FPC_'+{$ifdef NOSTRANSI}'ANSISTR'{$else}'STRANSI'{$endif}+'_LONGINT'];
-
-Var SS : ShortString;
-
+Procedure AnsiStr_Longint(L : Longint; Len : Longint; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_LONGINT'];
+Var
+  SS : ShortString;
 begin
 begin
- int_Str_Longint (L,Len,SS);
- S:=SS;
+  int_Str_Longint (L,Len,SS);
+  S:=SS;
 end;
 end;
 
 
 
 
 Procedure Delete (Var S : AnsiString; Index,Size: Longint);
 Procedure Delete (Var S : AnsiString; Index,Size: Longint);
-
-Var LS : Longint;
-
+Var
+  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
-    Size:=Size+index-1;
-    index:=1;
-    end;
+   begin
+     inc(Size,index-1);
+     index:=1;
+   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
-    UniqueAnsiString (S);
-    if Size+Index>LS then
+   begin
+     UniqueAnsiString (S);
+     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);
-      Move(PByte(Pointer(S))[Index+Size],
-           PByte(Pointer(S))[Index],LS-Index+1);
+        Dec(Index);
+        Move(PByte(Pointer(S))[Index+Size],PByte(Pointer(S))[Index],LS-Index+1);
       end;
       end;
-    Setlength(s,LS-Size);
-    end;
+     Setlength(s,LS-Size);
+   end;
 end;
 end;
 
 
-Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint);
-
-var Temp : AnsiString;
-    LS : Longint;
 
 
+Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint);
+var
+  Temp : AnsiString;
+  LS : Longint;
 begin
 begin
-  If Length(Source)=0 then exit;
-  if index <= 0 then index := 1;
+  If Length(Source)=0 then
+   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

+ 4 - 12
rtl/inc/generic.inc

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

+ 5 - 2
rtl/inc/int64.inc

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

+ 4 - 9
rtl/inc/objpas.inc

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

+ 12 - 644
rtl/inc/sstrings.inc

@@ -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}
-
-
-{$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
-   str_real(len,fr,d,rt_s32real,s);
-end;
-{$endif}
-
-
-{$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'];
+procedure int_str_longint(v : longint;len : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_LONGINT'];
 begin
 begin
-   int_str(v,s);
-   if length(s)<len then
-     s:=space(len-length(s))+s;
+  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

+ 17 - 20
rtl/inc/system.inc

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

+ 27 - 107
rtl/inc/systemh.inc

@@ -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;
-
-{ Char functions to overcome overloading problem with ansistrings }
-function  copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;
-function  pos(const substr : shortstring;c:char): StrLenInt;
-function  length(c:char):byte;
-
-Function  Chr(b:byte):Char;
 Function  upCase(const s:shortstring):shortstring;
 Function  upCase(const s:shortstring):shortstring;
-Function  upCase(c:Char):Char;
 {$ifndef RTLLITE}
 {$ifndef RTLLITE}
-Function  lowerCase(c:Char):Char;
 Function  lowerCase(const s:shortstring):shortstring;
 Function  lowerCase(const s:shortstring):shortstring;
+{$endif}
+Function  Space(b:byte):shortstring;
+{$ifndef RTLLITE}
 Function  hexStr(Val:Longint;cnt:byte):shortstring;
 Function  hexStr(Val:Longint;cnt:byte):shortstring;
 Function  binStr(Val:Longint;cnt:byte):shortstring;
 Function  binStr(Val:Longint;cnt:byte):shortstring;
 {$endif RTLLITE}
 {$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}
+
+{ 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  pos(const substr : shortstring;c:char): StrLenInt;
+function  length(c:char):byte;
+
 
 
 {****************************************************************************
 {****************************************************************************
                              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

+ 33 - 353
rtl/inc/text.inc

@@ -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}
-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'];
+Procedure Write_Array(Len : Longint;var f : TextRec;const s : array of char);[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}
-    procedure write_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_WRITE_TEXT_QWORD'];
-
-      var
-         s : string;
 
 
-      begin
-         if (InOutRes<>0) then
-           exit;
-         int_str(q,s);
-         write_str(len,t,s);
-      end;
+{$ifdef INT64}
+procedure write_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_WRITE_TEXT_QWORD'];
+var
+  s : string;
+begin
+  if (InOutRes<>0) then
+   exit;
+  int_str(q,s);
+  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'];
-
-      begin
-         {!!!!!!!!!!!!!}
-      end;
-{$endif INT64}
-
-function ReadRealStr(var f:TextRec):string;
-var
-  hs : string;
+procedure read_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_READ_TEXT_QWORD'];
 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;
-
-
-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}
+{$endif INT64}
 
 
 
 
 {*****************************************************************************
 {*****************************************************************************
@@ -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;
- fmOutput : begin
-              TextRec(f).InOutFunc:=@FileWriteFunc;
-              TextRec(f).FlushFunc:=@FileWriteFunc;
-            end;
+    fmInput :
+      TextRec(f).InOutFunc:=@FileReadFunc;
+    fmOutput :
+      begin
+        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

+ 15 - 33
rtl/win32/syswin32.pp

@@ -219,7 +219,7 @@ end;
 function paramstr(l : longint) : string;
 function paramstr(l : longint) : string;
 
 
 begin
 begin
-  
+
   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
@@ -250,12 +250,9 @@ end;
      external 'kernel32' name 'GlobalSize';
      external 'kernel32' name 'GlobalSize';
 {$endif}
 {$endif}
 
 
-{$ifdef NEWATT}
-var heap : longint;external name 'HEAP';
-var intern_heapsize : longint;external name 'HEAPSIZE';
-{$else NEWATT}
-{$asmmode direct}
-{$endif def NEWATT}
+var
+  heap : longint;external name 'HEAP';
+  intern_heapsize : longint;external name 'HEAPSIZE';
 
 
 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
-       to check if the call stack can be written on exceptions }
-     _SS : longint;
+  { value of the stack segment
+    to check if the call stack can be written on exceptions }
+  _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