* changes for internal Val code (do a "make cycle OPT=-dvalintern" to test)

  * in text.inc: changed RTE 106 when read integer values are out of bounds to RTE 201
  * in systemh.inc: disabled "support_fixed" for the i386 because it gave internal errors,

rtl/inc/astrings.inc

@@ -474,7 +474,45 @@ begin
   pos := j;
 end;
 
+{$IfDef ValInternCompiled}
 
+Function ValAnsiFloat(Const S : AnsiString; Var Code : TMaxSInt): ValReal; [public, alias:'FPC_VAL_REAL_STRANSI'];
+Var SS : String;
+begin
+ AnsiStr_To_ShortStr(SS,Pointer(S));
+ ValAnsiFloat := ValFloat(SS,Code);
+end;
+
+
+Function ValAnsiUnsigendInt (Const S : AnsiString; Code : TMaxSInt): TMaxUInt; [public, alias:'FPC_VAL_UINT_STRANSI'];
+Var SS : ShortString;
+
+begin
+ AnsiStr_To_ShortStr(SS,Pointer(S));
+ ValAnsiUnsigendInt := ValUnsignedInt(SS,Code);
+end;
+
+
+Function ValAnsiSignedInt (DestSize: Byte; Const S : AnsiString; Var Code : TMaxSInt): TMaxSInt; [public, alias:'FPC_VAL_SINT_STRANSI'];
+
+Var SS : ShortString;
+
+begin
+ AnsiStr_To_ShortStr (SS,Pointer(S));
+ ValAnsiSignedInt := ValSignedInt(DestSize,SS,Code);
+end;
+
+{$IfDef SUPPORT_FIXED}
+Function ValAnsiFixed(Const S : AnsiString; Var Code : TMaxSint): ValReal; [public, alias:'FPC_VAL_FIXED_STRANSI'];
+Var SS : String;
+begin
+ AnsiStr_To_ShortStr (SS,Pointer(S));
+ ValAnsiFixed := Fixed(ValFloat(SS,Code));
+end;
+{$EndIf SUPPORT_FIXED}
+
+
+{$Else ValInternCompiled}
 
 Procedure Val (Const S : AnsiString; var R : real; Var Code : Integer);
 Var
@@ -572,6 +610,8 @@ begin
  Val(SS,SI,Code);
 end;
 
+{$EndIf ValInternCompiled}
+
 
 {!!!!!!!!!!!!
   We need ansistring str routines for the following types:
@@ -601,6 +641,7 @@ begin
  S:=SS;
 end;
 
+{$IfDef Support_Fixed}
 Procedure AFiStr (fi : Comp;Len,fr: Longint; Var S : AnsiString);
   [Public,Alias : 'FPC_STRANSI_FIXED'];
 
@@ -610,6 +651,7 @@ begin
  int_Str_Fixed (fi,Len,fr,SS);
  S:=SS;
 end;
+{$EndIf Support_Fixed}
 
 Procedure ARStr (D : Real;Len,fr: Longint; Var S : AnsiString);
   [Public,Alias : 'FPC_STRANSI_REAL'];
@@ -708,7 +750,12 @@ end;
 
 {
   $Log$
-  Revision 1.13  1999-03-02 18:24:51  peter
+  Revision 1.14  1999-03-16 17:49:40  jonas
+    * changes for internal Val code (do a "make cycle OPT=-dvalintern" to test)
+    * in text.inc: changed RTE 106 when read integer values are out of bounds to RTE 201
+    * in systemh.inc: disabled "support_fixed" for the i386 because it gave internal errors,
+
+  Revision 1.13  1999/03/02 18:24:51  peter
     * function names cleanup
     + chararray -> ansistring
 

rtl/inc/sstrings.inc

@@ -344,7 +344,12 @@ end;
                            Val() Functions
 *****************************************************************************}
 
-Function InitVal(const s:shortstring;var negativ:boolean;var base:byte):Word;
+Function InitVal(const s:shortstring;var negativ:boolean;var base:byte):
+{$IfDef ValInternCompiled}
+TMaxSInt;
+{$Else ValInternCompiled}
+Word;
+{$EndIf ValInternCompiled}
 var
   Code : Longint;
 begin
@@ -371,8 +376,11 @@ 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;
@@ -384,6 +392,225 @@ begin
 end;
 
 
+{$IfDef ValInternCompiled}
+
+Function ValSignedInt(DestSize: Byte; Const S: ShortString; var Code: TMaxSInt): TMaxSInt; [public, alias:'FPC_VAL_SINT_SSTRING'];
+var
+  u: TMaxSInt;
+  base : byte;
+  negative : boolean;
+  temp, prev: TMaxUInt;
+begin
+  ValSignedInt := 0;
+  Temp:=0;
+  Code:=InitVal(s,negative,base);
+  if Code>length(s) then
+   exit;
+  if negative and (s='-2147483648') then
+   begin
+     Code:=0;
+     ValSignedInt:=$80000000;
+     exit;
+   end;
+
+  while Code<=Length(s) do
+   begin
+     case s[Code] of
+       '0'..'9' : u:=Ord(S[Code])-Ord('0');
+       'A'..'F' : u:=Ord(S[Code])-(Ord('A')-10);
+       'a'..'f' : u:=Ord(S[Code])-(Ord('a')-10);
+     else
+      u:=16;
+     end;
+     Prev := Temp;
+     Temp := Temp*TMaxUInt(base);
+     If ((base = 10) and
+         (prev > MaxSIntValue div TMaxUInt(Base))) or
+        (Temp < prev) Then
+       Begin
+         ValSignedInt := 0;
+         Exit
+       End;
+     if (u>=base) or
+        ((base = 10) and
+         (MaxSIntValue-Temp < u)) or
+        ((base <> 10) and
+         (MaxUIntValue-Temp < u)) then
+       begin
+         ValSignedInt:=0;
+         exit;
+       end;
+     Temp:=Temp+u;
+     inc(code);
+   end;
+  code := 0;
+  ValSignedInt := TMaxSInt(Temp);
+  If Negative Then
+    ValSignedInt := -ValSignedInt;
+  If Not(Negative) and (base <> 10) Then
+   {sign extend the result to allow proper range checking}
+    Case DestSize of
+      1: If (ValSignedInt > High(ShortInt)) and (ValSignedInt <= High(Byte)) Then
+           ValSignedInt := ValSignedInt or (MaxUIntValue xor High(Byte));
+      2: If (ValSignedInt > High(Integer)) and (ValSignedInt <= High(Word)) Then
+           ValSignedInt := ValSignedInt or (MaxUIntValue xor High(Word));
+{     Uncomment the folling once full 64bit support is in place
+      4: If (ValSignedInt > High(Longint)) and (ValSignedInt <= High(Cardinal)) Then
+           ValSignedInt := ValSignedInt or (MaxUIntValue xor High(Cardinal));}
+    End;
+end;
+
+Function ValUnsignedInt(Const S: ShortString; var Code: TMaxSInt): TMaxUInt; [public, alias:'FPC_VAL_UINT_SSTRING'];
+var
+  u: TMaxUInt;
+  base : byte;
+  negative : boolean;
+  prev: TMaxUInt;
+begin
+  ValUnSignedInt:=0;
+  Code:=InitVal(s,negative,base);
+  If Negative or (Code>length(s)) Then
+    Exit;
+  while Code<=Length(s) do
+   begin
+     case s[Code] of
+       '0'..'9' : u:=Ord(S[Code])-Ord('0');
+       'A'..'F' : u:=Ord(S[Code])-(Ord('A')-10);
+       'a'..'f' : u:=Ord(S[Code])-(Ord('a')-10);
+     else
+      u:=16;
+     end;
+     prev := ValUnsignedInt;
+     ValUnsignedInt:=ValUnsignedInt*TMaxUInt(base);
+     If prev > ValUnsignedInt Then
+      {we've had an overflow. Can't check this with
+       "If ValUnsignedInt <= (MaxUIntValue div TMaxUInt(Base)) Then"
+       because this division always overflows! (JM)}
+       Begin
+         ValUnsignedInt := 0;
+         Exit
+       End;
+     if (u>=base) or (MaxUIntValue-ValUnsignedInt < u) then
+      begin
+        ValUnsignedInt:=0;
+        exit;
+      end;
+     ValUnsignedInt:=ValUnsignedInt+u;
+     inc(code);
+   end;
+  code := 0;
+end;
+
+Function ValFloat(const s : shortstring; var code : TMaxSInt): ValReal; [public, alias:'FPC_VAL_REAL_SSTRING'];
+var
+  hd,
+  esign,sign : valreal;
+  exponent,i : longint;
+  flags      : byte;
+begin
+  ValFloat:=0.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.0;
+           inc(code);
+         end;
+  end;
+  while (Code<=Length(s)) and (s[code] in ['0'..'9']) do
+   begin
+   { Read integer part }
+      flags:=flags or 1;
+      valfloat:=valfloat*10;
+      valfloat:=valfloat+(ord(s[code])-ord('0'));
+      inc(code);
+   end;
+{ Decimal ? }
+  if (s[code]='.') and (length(s)>=code) then
+   begin
+      hd:=0.1;
+      inc(code);
+      { After dot, a number is required. }
+      if not(s[code] in ['0'..'9']) or (length(s)<code) then
+        begin
+           valfloat:=0.0;
+           exit;
+        end;
+      while (s[code] in ['0'..'9']) and (length(s)>=code) do
+        begin
+           { Read fractional part. }
+           flags:=flags or 2;
+           valfloat:=valfloat+hd*(ord(s[code])-ord('0'));
+           hd:=hd/10.0;
+           inc(code);
+        end;
+   end;
+ { Again, read integer and fractional part}
+  if flags=0 then
+   begin
+      valfloat:=0.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
+           valfloat:=0.0;
+           exit;
+        end;
+      while (s[code] in ['0'..'9']) and (length(s)>=code) do
+        begin
+           exponent:=exponent*10;
+           exponent:=exponent+ord(s[code])-ord('0');
+           inc(code);
+        end;
+   end;
+{ Calculate Exponent }
+  if esign>0 then
+    for i:=1 to exponent do
+      valfloat:=valfloat*10
+    else
+      for i:=1 to exponent do
+        valfloat:=valfloat/10;
+{ Not all characters are read ? }
+  if length(s)>=code then
+   begin
+     valfloat:=0.0;
+     exit;
+   end;
+{ evaluate sign }
+  valfloat:=valfloat*sign;
+{ success ! }
+  code:=0;
+end;
+
+{$ifdef SUPPORT_FIXED}
+Function ValFixed(const s : shortstring;var code : TMaxSInt): Fixed; [public, alias:'FPC_VAL_FIXED_SSTRING'];
+begin
+  ValFixed := Fixed(ValFloat(s,code));
+end;
+{$endif SUPPORT_FIXED}
+
+
+{$Else ValInternCompiled}
+
+
 procedure val(const s : shortstring;var l : longint;var code : word);
 var
   base,u  : byte;
@@ -970,6 +1197,7 @@ begin
   d:=fixed(e);
 end;
 {$endif SUPPORT_FIXED}
+{$EndIf ValInternCompiled}
 
 Procedure SetString (Var S : Shortstring; Buf : PChar; Len : Longint);
 
@@ -980,7 +1208,12 @@ end;
 
 {
   $Log$
-  Revision 1.21  1999-03-10 21:49:03  florian
+  Revision 1.22  1999-03-16 17:49:36  jonas
+    * changes for internal Val code (do a "make cycle OPT=-dvalintern" to test)
+    * in text.inc: changed RTE 106 when read integer values are out of bounds to RTE 201
+    * in systemh.inc: disabled "support_fixed" for the i386 because it gave internal errors,
+
+  Revision 1.21  1999/03/10 21:49:03  florian
     * str and val for extended use now int constants to minimize
       rounding error
 

rtl/inc/systemh.inc

@@ -52,8 +52,16 @@ Type
   {$define SUPPORT_EXTENDED}
   {$define SUPPORT_COMP}
   {$define SUPPORT_SINGLE}
-  {$define SUPPORT_FIXED}
+
+{causes internalerror(17) with internal val handling, and is not yet fully
+ supported anyway (JM)}
+  { define SUPPORT_FIXED}
+
   Double = real;
+{$IfDef ValInternCompiled}
+  TMaxSInt = Longint;
+  TMaxUInt = Cardinal;
+{$EndIf ValInternCompiled}
   {$ifdef DEFAULT_EXTENDED}
     ValReal = Extended;
   {$else}
@@ -62,6 +70,8 @@ Type
 {$endif}
 
 {$ifdef m68k}
+  TMaxSInt = Longint;
+  TMaxUInt = Cardinal;
    StrLenInt = Longint;
    ValReal = Real;
 {$endif}
@@ -78,6 +88,13 @@ Type
   TProcedure  = Procedure;
 
 const
+{$IfDef ValInternCompiled}
+{ Maximum value of the biggest signed and unsigned integer type available}
+  MaxSIntValue = High(TMaxSInt);
+  MaxUIntValue = High(TMaxUInt);
+{$EndIf ValInternCompiled}
+
+
 { max. values for longint and int}
   maxLongint = $7fffffff;
   maxint     = 32767;
@@ -214,6 +231,7 @@ 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);
@@ -273,6 +291,7 @@ Procedure Val(const s:shortstring;Var d:ValReal);
     Procedure Val(const s:shortstring;Var d:Extended);
   {$endif}
 {$endif DEFAULT_EXTENDED}
+{$EndIf ValInternCompiled}
 
 {****************************************************************************
                              AnsiString Handling
@@ -286,6 +305,7 @@ 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);
@@ -297,6 +317,7 @@ 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);
@@ -436,7 +457,12 @@ const
 
 {
   $Log$
-  Revision 1.52  1999-03-10 22:15:30  florian
+  Revision 1.53  1999-03-16 17:49:37  jonas
+    * changes for internal Val code (do a "make cycle OPT=-dvalintern" to test)
+    * in text.inc: changed RTE 106 when read integer values are out of bounds to RTE 201
+    * in systemh.inc: disabled "support_fixed" for the i386 because it gave internal errors,
+
+  Revision 1.52  1999/03/10 22:15:30  florian
     + system.cmdline variable for go32v2 and win32 added
 
   Revision 1.51  1999/03/03 15:23:58  michael

rtl/inc/text.inc

@@ -975,7 +975,7 @@ End;
 Procedure Read_Longint(var f : TextRec;var l : Longint);[Public,Alias:'FPC_READ_TEXT_LONGINT'];
 var
   hs   : String;
-  code : Word;
+  code : Longint;
   base : longint;
 Begin
   l:=0;
@@ -1007,7 +1007,7 @@ Begin
    exit;
   Read_Longint(f,ll);
   If (ll<-32768) or (ll>32767) Then
-   InOutRes:=106
+   InOutRes:=201
   else
    l:=ll;
 End;
@@ -1022,7 +1022,7 @@ Begin
    exit;
   Read_Longint(f,ll);
   If (ll<0) or (ll>$ffff) Then
-   InOutRes:=106
+   InOutRes:=201
   else
    l:=ll;
 End;
@@ -1037,7 +1037,7 @@ Begin
    exit;
   Read_Longint(f,ll);
   If (ll<0) or (ll>255) Then
-   InOutRes:=106
+   InOutRes:=201
   else
    l:=ll;
 End;
@@ -1052,7 +1052,7 @@ Begin
    exit;
   Read_Longint(f,ll);
   If (ll<-128) or (ll>127) Then
-   InOutRes:=106
+   InOutRes:=201
   else
    l:=ll;
 End;
@@ -1061,7 +1061,7 @@ End;
 Procedure Read_Cardinal(var f : TextRec;var l : cardinal);[Public,Alias:'FPC_READ_TEXT_CARDINAL'];
 var
   hs   : String;
-  code : Word;
+  code : longint;
   base : longint;
 Begin
   l:=0;
@@ -1080,7 +1080,7 @@ Begin
    ReadNumeric(f,hs,Base);
   val(hs,l,code);
   If code<>0 Then
-   InOutRes:=106;
+   InOutRes:=201;
 End;
 
 
@@ -1208,7 +1208,12 @@ end;
 
 {
   $Log$
-  Revision 1.41  1999-03-02 18:23:37  peter
+  Revision 1.42  1999-03-16 17:49:39  jonas
+    * changes for internal Val code (do a "make cycle OPT=-dvalintern" to test)
+    * in text.inc: changed RTE 106 when read integer values are out of bounds to RTE 201
+    * in systemh.inc: disabled "support_fixed" for the i386 because it gave internal errors,
+
+  Revision 1.41  1999/03/02 18:23:37  peter
     * changed so handlerror() -> inoutres:= to have $I- support
 
   Revision 1.40  1999/03/01 15:41:04  peter