home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / pascal / qparser.arc / SKELNUM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-11-20  |  2.8 KB  |  127 lines
  1.   { SKELNUM:  Number scanning for skeleton files. }
  2.   { Copyright (C) 1984 by QCAD Systems Inc., All Rights Reserved. }
  3.  
  4.   {****************}
  5.   function PWR10(N:  int):  real;
  6.     var P10: real;
  7.         SIGN: boolean;
  8.         PX: int;
  9.   begin
  10.     if n<0 then begin
  11.       n := -n;
  12.       sign := true;
  13.     end
  14.     else
  15.       sign := false;
  16.     p10 := 1.0;
  17.     if n >= 38 then begin
  18.       error('exponent too large -- 37 assumed');
  19.       p10 := 1E37
  20.     end
  21.     else begin
  22.       px := 0;
  23.       while n>0 do begin
  24.         if odd(n) then p10 := p10*pwr10_2[px];
  25.         n := n div 2;
  26.         px := px+1;
  27.       end
  28.     end;
  29.     if sign then
  30.       pwr10 := 1.0/p10
  31.     else
  32.       pwr10 := p10;
  33.   end;
  34.  
  35.   {*****************}
  36.   procedure GET_NUMBER;
  37.     { Accepts an integer, decimal or real number. }
  38.     var V1, V2: integer;
  39.         RV: real;
  40.  
  41.     {...............}
  42.     function GET_INTEGER:  integer;
  43.       { interpret a non-null sequence of digits as an integer. }
  44.       var V: integer;
  45.     begin
  46.       v := 0;
  47.       while (ch>='0') and (ch<='9') do begin
  48.         v := 10*v + ord(ch) - ord('0');
  49.         nextch;
  50.       end;
  51.       get_integer := v
  52.     end;
  53.  
  54.     {................}
  55.     function GET_FRACTION:  real;
  56.       var V, P:  real;
  57.     begin
  58.       v := 0;
  59.       p := 0.1;
  60.       while (ch>='0') and (ch<='9') do begin
  61.         v := v+p*(ord(ch)-ord('0'));
  62.         p := p/10.0;
  63.         nextch;
  64.       end;
  65.       get_fraction := v;
  66.     end;
  67.  
  68.     {.................}
  69.     procedure GET_EXP;
  70.       var EXPSIGN: boolean;
  71.           EXP: int;
  72.     begin
  73.       nextch;  { get over e or E }
  74.       expsign := false;
  75.       if ch='+' then
  76.         nextch
  77.       else if ch='-' then begin
  78.         expsign := true;
  79.         nextch;
  80.       end;
  81.       if (ch>='0') and (ch<='9') then begin
  82.         exp := get_integer;
  83.         if expsign then
  84.           rv := rv/pwr10(exp)
  85.         else
  86.           rv := rv*pwr10(exp);
  87.       end
  88.       else
  89.         error('missing digit after E in exponent');
  90.     end;
  91.  
  92.     {................}
  93.     procedure FINISH_REAL;
  94.       { return a real number as the result of the lexical scan. }
  95.     begin
  96.       token := real_tokx;
  97.       with lsemp^ do begin
  98.         semt := float;
  99.         rval := rv;
  100.       end
  101.     end;
  102.  
  103.   begin { get_number }
  104.     v1 := get_integer;
  105.     if ch='.' then begin
  106.       { real number }
  107.       nextch;
  108.       rv := v1 + get_fraction;
  109.       if ch in ['e', 'E'] then get_exp;
  110.       finish_real;
  111.     end
  112.     else if ch in ['e', 'E'] then begin
  113.       { integer followed by exponent part }
  114.       rv := v1;
  115.       get_exp;
  116.       finish_real;
  117.     end
  118.     else begin
  119.       token := int_tokx;
  120.       with lsemp^ do begin
  121.         semt := fixed;
  122.         numval := v1;
  123.       end
  124.     end
  125.   end { get_number };
  126.  
  127.