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,
   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
   Size,Location : Longint;
-
 begin
+{ create new result }
   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
     AnsiStr_Assign(S3,S2)
   else
@@ -183,6 +183,7 @@ begin
 end;
 
 
+{$ifdef EXTRAANSISHORT}
 Procedure AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString);
 {
   Concatenates a Ansi with a short string; : S2 + S2
@@ -201,6 +202,7 @@ begin
   Move (S2[1],Pointer(Pointer(S1)+Location)^,Size);
   PByte( Pointer(S1)+length(S1) )^:=0; { Terminating Zero }
 end;
+{$endif EXTRAANSISHORT}
 
 
 Procedure AnsiStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR'];
@@ -342,6 +344,7 @@ begin
 end;
 
 
+{$ifdef EXTRAANSISHORT}
 Function AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): Longint;
 {
   Compares a AnsiString with a ShortString;
@@ -365,6 +368,7 @@ begin
    end;
   AnsiStr_ShortStr_Compare:=Temp;
 end;
+{$endif EXTRAANSISHORT}
 
 
 {*****************************************************************************
@@ -435,13 +439,13 @@ begin
   If Pointer(S)=Nil then
     exit;
   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;
 
 
@@ -453,30 +457,29 @@ begin
   dec(index);
   { Check Size. Accounts for Zero-length S }
   if Length(S)<Index+Size then
-    Size:=Length(S)-Index;
+   Size:=Length(S)-Index;
   If Size>0 then
-    begin
-    If Index<0 Then
+   begin
+     If Index<0 Then
       Index:=0;
-    ResultAddress:=Pointer(NewAnsiString (Size));
-    if ResultAddress<>Nil then
+     ResultAddress:=Pointer(NewAnsiString (Size));
+     if ResultAddress<>Nil then
       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;
   Pointer(Copy):=ResultAddress;
 end;
 
 
-
 Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : Longint;
 var
   i,j : longint;
-  e : boolean;
-  S : AnsiString;
-  se : Pointer;
+  e   : boolean;
+  S   : AnsiString;
+  se  : Pointer;
 begin
   i := 0;
   j := 0;
@@ -497,8 +500,6 @@ begin
 end;
 
 
-{$IfDef ValInternCompiled}
-
 Function ValAnsiFloat(Const S : AnsiString; Var Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_ANSISTR'];
 Var
   SS : String;
@@ -537,110 +538,6 @@ end;
 {$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'];
 var
   ss : shortstring;
@@ -649,73 +546,10 @@ begin
   s:=ss;
 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
   int_str_cardinal(C,Len,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
- int_Str_Longint (L,Len,SS);
- S:=SS;
+  int_Str_Longint (L,Len,SS);
+  S:=SS;
 end;
 
 
 Procedure Delete (Var S : AnsiString; Index,Size: Longint);
-
-Var LS : Longint;
-
+Var
+  LS : Longint;
 begin
-  If Length(S)=0 then exit;
+  If Length(S)=0 then
+   exit;
   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;
   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;
-    if Index+Size<=LS then
+     if Index+Size<=LS then
       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;
-    Setlength(s,LS-Size);
-    end;
+     Setlength(s,LS-Size);
+   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
-  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);
-  if index > LS then index := LS+1;
+  if index > LS then
+   index := LS+1;
   Dec(Index);
   Pointer(Temp) := NewAnsiString(Length(Source)+LS);
   SetLength(Temp,Length(Source)+LS);
@@ -785,7 +619,10 @@ end;
 
 {
   $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
 
   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}
 
-{$ifdef FPC_TESTOBJEXT}
 { checks for a correct vmt pointer }
 { deeper check to see if the current object is }
 { really related to the true }
@@ -246,8 +245,6 @@ end;
 
 {$endif ndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
 
-{$endif  FPC_TESTOBJEXT}
-
 
 {****************************************************************************
                                  String
@@ -396,10 +393,6 @@ end;
 
 function strpas(p:pchar):string;[public,alias:'FPC_PCHAR_TO_SHORTSTR'];
 begin
-{$ifndef NEWATT}
-  { remove warning }
-  strpas:='';
-{$endif}
   asm
         cld
         movl    p,%edi
@@ -415,11 +408,7 @@ begin
         scasb
 .LStrPasNil:
         movl    %ecx,%eax
-{$ifdef NEWATT}
         movl    __RESULT,%edi
-{$else}
-        movl    8(%ebp),%edi
-{$endif}
         notb    %al
         decl    %eax
         stosb
@@ -611,7 +600,10 @@ end;
 
 {
   $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
 
 }

+ 5 - 2
rtl/inc/int64.inc

@@ -54,7 +54,7 @@
 
       var
          shift,lzz,lzn : longint;
-         one : qword;
+         { one : qword; }
 
       begin
          divqword:=0;
@@ -302,7 +302,10 @@
 
 {
   $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
 
   Revision 1.11  1999/07/02 17:01:29  florian

+ 4 - 9
rtl/inc/objpas.inc

@@ -221,11 +221,7 @@
                              pushl message
                              pushl %esi
                              movl p,%edi
-{$ifdef ver0_99_10}
-                             call %edi
-{$else ver0_99_10}
                              call *%edi
-{$endif ver0_99_10}
                           end;
                           exit;
                        end;
@@ -264,11 +260,7 @@
                              pushl message
                              pushl %esi
                              movl p,%edi
-{$ifdef ver0_99_10}
-                             call %edi
-{$else ver0_99_10}
                              call *%edi
-{$endif ver0_99_10}
                           end;
                           exit;
                        end;
@@ -325,7 +317,10 @@
 
 {
   $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
 
   Revision 1.3  1999/05/17 21:52:37  florian

+ 12 - 644
rtl/inc/sstrings.inc

@@ -282,67 +282,21 @@ end;
                               Str() Helpers
 *****************************************************************************}
 
-{$ifdef INTERNDOUBLE}
-
 procedure ShortStr_Float(d : ValReal;len,fr,rt : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_FLOAT'];
 begin
   str_real(len,fr,d,treal_type(rt),s);
 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
-   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;
 
 
-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
   int_str(v,s);
   if length(s)<len then
@@ -381,11 +335,6 @@ begin
               repeat
                 inc(code);
               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;
       '%' : begin
               base:=2;
@@ -397,8 +346,6 @@ begin
 end;
 
 
-{$IfDef ValInternCompiled}
-
 Function ValSignedInt(DestSize: longint; Const S: ShortString; var Code: ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_SHORTSTR'];
 var
   u: ValSInt;
@@ -465,6 +412,7 @@ begin
     End;
 end;
 
+
 Function ValUnsignedInt(Const S: ShortString; var Code: ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_SHORTSTR'];
 var
   u: ValUInt;
@@ -506,6 +454,7 @@ begin
   code := 0;
 end;
 
+
 Function ValFloat(const s : shortstring; var code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_SHORTSTR'];
 var
   hd,
@@ -599,6 +548,7 @@ begin
   code:=0;
 end;
 
+
 {$ifdef SUPPORT_FIXED}
 Function ValFixed(const s : shortstring;var code : ValSInt): Fixed; [public, alias:'FPC_VAL_FIXED_SHORTSTR'];
 begin
@@ -607,592 +557,7 @@ end;
 {$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);
-
 begin
   Move (Buf[0],S[1],Len);
   S[0]:=chr(len);
@@ -1200,7 +565,10 @@ end;
 
 {
   $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
 
   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
   FileFunc = Procedure(var t : TextRec);
 
+  PLongint = ^Longint;
+  PByte = ^Byte;
+
 const
 { Random / Randomize constants }
   OldRandSeed : Cardinal = 0;
@@ -56,11 +59,11 @@ var
 Function  lo(i : Integer) : 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 : 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(w : Word) : byte;     [INTERNPROC: In_hi_Word];
 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}
 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 Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
 
+
 {****************************************************************************
                     Include processor specific routines
 ****************************************************************************}
@@ -93,6 +97,7 @@ Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
   {$ENDIF}
 {$ENDIF}
 
+
 {****************************************************************************
                                 Set Handling
 ****************************************************************************}
@@ -100,6 +105,7 @@ Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
 { Include set support which is processor specific}
 {$I set.inc}
 
+
 {****************************************************************************
                   Subroutines for String handling
 ****************************************************************************}
@@ -108,10 +114,6 @@ Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
 
 {$i sstrings.inc}
 
-Type
-   PLongint = ^Longint;
-   PByte = ^Byte;
-
 {$i astrings.inc}
 
 
@@ -266,13 +268,6 @@ Begin
   ptr:=pointer(off);
 End;
 
-{$ifndef INTERNALADDR}
-Function Addr(var x):pointer;
-begin
-  Addr:=@x;
-end;
-{$endif}
-
 Function CSeg : Word;
 Begin
   Cseg:=0;
@@ -336,11 +331,9 @@ end;
 
 
 {*****************************************************************************
-                          Init / Exit / ExitProc
+                        Initialization / Finalization
 *****************************************************************************}
 
-{$ifdef HASFINALIZE}
-
 const
   maxunits=1024; { See also files.pas of the compiler source }
 type
@@ -386,8 +379,10 @@ begin
    end;
 end;
 
-{$endif}
 
+{*****************************************************************************
+                          Error / Exit / ExitProc
+*****************************************************************************}
 
 Procedure HandleErrorFrame (Errno : longint;frame : longint);
 {
@@ -472,10 +467,8 @@ Begin
      exitProc:=nil;
      current_exit();
    End;
-{$ifdef HASFINALIZE}
   { Finalize units }
   FinalizeUnits;
-{$endif}
   { Show runtime error }
   If erroraddr<>nil Then
    Begin
@@ -565,6 +558,7 @@ end;
 
 {$i setjump.inc}
 
+
 {*****************************************************************************
                         Object Pascal support
 *****************************************************************************}
@@ -573,7 +567,10 @@ end;
 
 {
   $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
 
   Revision 1.62  1999/07/02 18:06:42  florian

+ 27 - 107
rtl/inc/systemh.inc

@@ -50,10 +50,6 @@ Type
 {$ifdef i386}
   StrLenInt = LongInt;
 
-  {$ifndef INTERNDOUBLE}
-    Double = real;
-  {$endif}
-
   {$define DEFAULT_EXTENDED}
 
   {$define SUPPORT_SINGLE}
@@ -90,12 +86,9 @@ Type
   TProcedure  = Procedure;
 
 const
-{$IfDef ValInternCompiled}
 { Maximum value of the biggest signed and unsigned integer type available}
   MaxSIntValue = High(ValSInt);
   MaxUIntValue = High(ValUInt);
-{$EndIf ValInternCompiled}
-
 
 { max. values for longint and int}
   maxLongint = $7fffffff;
@@ -117,6 +110,7 @@ const
 
 { max level in dumping on error }
   Max_Frame_Dump : Word = 8;
+
 { Exit Procedure handling consts and types  }
   ExitProc : pointer = nil;
   Erroraddr: pointer = nil;
@@ -206,9 +200,6 @@ Function odd(l:Longint):Boolean;
 
 {$ifndef RTLLITE}
 Function  ptr(sel,off:Longint):pointer;
-{$ifndef INTERNALADDR}
-Function Addr(var x):pointer;
-{$endif}
 Function  Cseg:Word;
 Function  Dseg:Word;
 Function  Sseg:Word;
@@ -231,89 +222,31 @@ Function  Pos(C:Char;const s:shortstring):StrLenInt;
 Procedure SetLength(var s:shortstring;len:StrLenInt);
 Procedure SetString (Var S : Shortstring; Buf : PChar; Len : Longint);
 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(c:Char):Char;
 {$ifndef RTLLITE}
-Function  lowerCase(c:Char):Char;
 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}
-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
 ****************************************************************************}
 
-
 Procedure SetLength (Var S : AnsiString; l : Longint);
 Procedure UniqueAnsiString (Var S : AnsiString);
 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;
 Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : 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 Truncate (Var F:File);
 
+
 {****************************************************************************
                            Typed File Management
 ****************************************************************************}
@@ -387,6 +297,7 @@ Procedure Assign(Var f:TypedFile;c:char);
 Procedure Rewrite(Var f:TypedFile);
 Procedure Reset(Var f:TypedFile);
 
+
 {****************************************************************************
                             Text File Management
 ****************************************************************************}
@@ -414,6 +325,7 @@ Function  SeekEOF:Boolean;
 Procedure SetTextBuf(Var f:Text; Var Buf);
 Procedure SetTextBuf(Var f:Text; Var Buf; Size:Word);
 
+
 {****************************************************************************
                             Directory Management
 ****************************************************************************}
@@ -424,6 +336,7 @@ Procedure rmdir(const s:string);
 Procedure getdir(drivenr:byte;Var dir:shortstring);
 Procedure getdir(drivenr:byte;Var dir:ansistring);
 
+
 {*****************************************************************************
                              Miscelleaous
 *****************************************************************************}
@@ -436,6 +349,7 @@ function get_caller_frame(framebp:longint):longint;
 Function IOResult:Word;
 Function Sptr:Longint;
 
+
 {*****************************************************************************
                           Init / Exit / ExitProc
 *****************************************************************************}
@@ -453,6 +367,7 @@ Procedure AddExitProc(Proc:TProcedure);
 {$endif RTLLITE}
 Procedure halt;
 
+
 {*****************************************************************************
                               Abstract/Assert
 *****************************************************************************}
@@ -471,14 +386,19 @@ const
 
 {$i setjumph.inc}
 
+
 {*****************************************************************************
                        Object Pascal support
 *****************************************************************************}
+
 {$i objpash.inc}
 
 {
   $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
 
   Revision 1.59  1999/07/02 18:06:43  florian

+ 33 - 353
rtl/inc/text.inc

@@ -433,7 +433,7 @@ begin
 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
   If (InOutRes<>0) then
    exit;
@@ -448,11 +448,7 @@ Begin
 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
   ArrayLen : longint;
   p : pchar;
@@ -492,7 +488,7 @@ Begin
 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
 }
@@ -503,7 +499,7 @@ begin
 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
   s : String;
 Begin
@@ -514,7 +510,7 @@ Begin
 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
   s : String;
 Begin
@@ -524,21 +520,19 @@ Begin
   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;
+{$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}
 
-{$ifdef INTERNDOUBLE}
 
 Procedure Write_Float(rt,fixkomma,Len : Longint;var t : TextRec;r : ValReal);[Public,Alias:'FPC_WRITE_TEXT_FLOAT'];
 var
@@ -550,75 +544,6 @@ Begin
   Write_Str(Len,t,s);
 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'];
 Begin
@@ -669,7 +594,6 @@ begin
 end;
 
 
-
 Function IgnoreSpaces(var f:TextRec):Boolean;
 {
   Removes all leading spaces,tab,eols from the input buffer, returns true if
@@ -818,7 +742,7 @@ Begin
 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
   s[0]:=chr(ReadPCharLen(f,pchar(@s[1]),high(s)));
 End;
@@ -830,13 +754,13 @@ Begin
 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
-  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;
 
 
-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
   len : longint;
 Begin
@@ -850,8 +774,6 @@ Begin
 End;
 
 
-{$ifdef NEWREADINT}
-
 Function Read_Char(var f : TextRec):char;[Public,Alias:'FPC_READ_TEXT_CHAR'];
 Begin
   Read_Char:=#0;
@@ -971,260 +893,13 @@ begin
    InOutRes:=106;
 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}
-    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
-  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;
-
-
-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).Closefunc:=@FileCloseFunc;
   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
    HandleError(102);
   end;
@@ -1251,7 +928,10 @@ end;
 
 {
   $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
 
   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;
 
 begin
-  
+
   if (l>0) and (l+1<=argc) then
    paramstr:=strpas(argv[l])
   else
@@ -250,12 +250,9 @@ end;
      external 'kernel32' name 'GlobalSize';
 {$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;
 asm
@@ -265,11 +262,7 @@ end ['EAX'];
 
 function getheapsize:longint;assembler;
 asm
-{$ifdef NEWATT}
         movl    intern_HEAPSIZE,%eax
-{$else}
-        movl    HEAPSIZE,%eax
-{$endif}
 end ['EAX'];
 
 
@@ -290,6 +283,7 @@ end;
 { include standard heap management }
 {$I heap.inc}
 
+
 {*****************************************************************************
                           Low Level File Routines
 *****************************************************************************}
@@ -373,14 +367,14 @@ end;
 
 function do_read(h,addr,len : longint) : longint;
 var
-  result:longint;
+  _result:longint;
 begin
-  if readfile(h,pointer(addr),len,result,nil)=0 then
+  if readfile(h,pointer(addr),len,_result,nil)=0 then
     Begin
       errno:=GetLastError;
       Errno2InoutRes;
     end;
-  do_read:=result;
+  do_read:=_result;
 end;
 
 
@@ -757,16 +751,13 @@ end;
 {$endif}
 
   procedure install_exception_handlers;forward;
-{$ifdef NEWATT}
   procedure PascalMain;external name 'PASCALMAIN';
   procedure fpc_do_exit;external name 'FPC_DO_EXIT';
-{$endif def NEWATT}
-
 
 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'];
   begin
@@ -782,11 +773,6 @@ procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
         movw %ss,%bp
         movl %ebp,_SS
         xorl %ebp,%ebp
-     end;
-{$ifndef NEWATT}
-{$ASMMODE DIRECT}
-{$endif ndef NEWATT}
-     asm
         call PASCALMAIN
         popl %ebp
      end;
@@ -794,7 +780,6 @@ procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
      ExitProcess(0);
   end;
 
-{$ASMMODE ATT}
 
 procedure Dll_entry;[public, alias : '_FPC_DLL_Entry'];
   begin
@@ -805,11 +790,6 @@ procedure Dll_entry;[public, alias : '_FPC_DLL_Entry'];
            asm
              xorl %edi,%edi
              movw %ss,%di
-           end;
-{$ifndef NEWATT}
-{$ASMMODE DIRECT}
-{$endif ndef NEWATT}
-           asm
              movl %edi,_SS
              call PASCALMAIN
            end;
@@ -823,7 +803,6 @@ procedure Dll_entry;[public, alias : '_FPC_DLL_Entry'];
      end;
   end;
 
-{$ASMMODE ATT}
 
 {$ifdef Set_i386_Exception_handler}
 
@@ -1022,7 +1001,10 @@ end.
 
 {
   $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)
 
   Revision 1.39  1999/05/17 21:52:47  florian