浏览代码

+ Added comp support for val and read(ln)

michael 27 年之前
父节点
当前提交
f6b5cc3358
共有 3 个文件被更改,包括 130 次插入7 次删除
  1. 34 3
      rtl/inc/sstrings.inc
  2. 9 1
      rtl/inc/systemh.inc
  3. 87 3
      rtl/inc/text.inc

+ 34 - 3
rtl/inc/sstrings.inc

@@ -459,7 +459,6 @@ procedure val(const s : string;var d : single);
      d:=e;
   end;
 {$ENDIF ieee_support}
-{ Again, not fast, but solid and understandable. }
 {$endif ver_above0_9_2}
 {$ifdef ver_above0_9_7}
 {$ifdef ieee_support}
@@ -490,6 +489,35 @@ begin
    d:=e;
 end;
 {$endif ieee_support}
+{$ifdef comp_support}
+procedure val(const s : string;var d : comp;var code : word);
+
+var e : double;
+
+begin
+   val(s,e,code);
+   d:=e;
+end;
+
+procedure val(const s : string;var d : comp;var code : integer);
+
+var e : double;
+
+begin
+   val(s,e,word(code));
+   d:=e;
+end;
+
+procedure val(const s : string;var d : comp);
+
+var code : word;
+    e    : double;
+begin
+   val(s,e,code);
+   d:=e;
+end;
+{$endif comp_support}
+
 {$endif ver_above0_9_7}
 
 
@@ -734,8 +762,11 @@ end;
 
 {
   $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
+  Revision 1.2  1998-03-26 14:41:22  michael
+  + Added comp support for val and read(ln)
+
+  Revision 1.1.1.1  1998/03/25 11:18:43  root
+  * Restored version
 
   Revision 1.8  1998/03/18 15:04:36  pierre
     * bug in val : a was accepted as 10 in base 10 !!

+ 9 - 1
rtl/inc/systemh.inc

@@ -285,6 +285,11 @@ Procedure Val(const s:string;Var d:Real);
    Procedure Val(const s:string;Var d:Extended;Var code:Integer);
    Procedure Val(const s:string;Var d:Extended);
   {$ENDIF ieee_support}
+  {$IFDEF comp_support}
+   Procedure Val(const s:string;Var d:comp;Var code:Word);
+   Procedure Val(const s:string;Var d:comp;Var code:Integer);
+   Procedure Val(const s:string;Var d:comp);
+  {$ENDIF comp_support}
 {$ENDIF VER_ABOVE0_9_7}
 {$IFDEF VER_ABOVE0_9_8}
   Procedure Val(const s:string;Var v:cardinal;Var code:Word);
@@ -387,7 +392,10 @@ Procedure AddExitProc(Proc:TProcedure);
 
 {
   $Log$
-  Revision 1.2  1998-03-25 23:39:17  florian
+  Revision 1.3  1998-03-26 14:41:22  michael
+  + Added comp support for val and read(ln)
+
+  Revision 1.2  1998/03/25 23:39:17  florian
     * complete Object Pascal support moved to objpas unit
 
   Revision 1.1.1.1  1998/03/25 11:18:43  root

+ 87 - 3
rtl/inc/text.inc

@@ -458,8 +458,12 @@ End;
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias: 'WRITE_TEXT_COMP'];
 var
   s : String;
+  e : extended;
+  L : longint;
+
 Begin
-  Str_real(Len,fixkomma,r,rt_s64bit,s);
+  e:=r;
+  Str_real(Len,fixkomma,e,rt_s80real,s);
   w(Len,t,s);
 End;
 {$endif comp_support}
@@ -820,10 +824,90 @@ Begin
   If code<>0 Then
    RunError(106);
 End;
+
+{$ifdef ieee_support}
+Procedure r(var f : TextRec;var d : extended);[Public,Alias: 'READ_TEXT_EXTENDED'];
+var
+  hs   : String;
+  code : Word;
+Begin
+  d:=0.0;
+  hs:='';
+  if not OpenInput(f) then
+   exit;
+  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;
+  val(hs,d,code);
+  If code<>0 Then
+   RunError(106);
+End;
+{$endif ieee_support}
+
+{$ifdef comp_support}
+Procedure r(var f : TextRec;var d : comp);[Public,Alias: 'READ_TEXT_COMP'];
+var
+  hs   : String;
+  code : Word;
+Begin
+  d:=0.0;
+  hs:='';
+  if not OpenInput(f) then
+   exit;
+  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;
+  val(hs,d,code);
+  If code<>0 Then
+   RunError(106);
+End;
+{$endif}
+
 {
   $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
+  Revision 1.2  1998-03-26 14:41:22  michael
+  + Added comp support for val and read(ln)
+
+  Revision 1.1.1.1  1998/03/25 11:18:43  root
+  * Restored version
 
   Revision 1.13  1998/03/19 12:00:42  pierre
     * missing write for comp fixed