2.11BSD#431 - /usr/src/ucb/PORT/pascal/pdx/test/overflow.p

   1: program fpexceptions(input,output);
   2:     type
   3:     fperrorkind = ( fperrorfirst,
   4:             overflow,underflow,divideby0,domain,
   5:             fperrolast );
   6:     var
   7:     request : fperrorkind;
   8:     procedure genoverflow;
   9:     var
  10:         i : integer;
  11:         r : real;
  12:     begin
  13:         r := 2.0;
  14:         for i := 1 to 1000 do begin
  15:         r := r * r;
  16:         end;
  17:         writeln('this machine handles more than 2^1000');
  18:     end;
  19:     procedure genunderflow;
  20:     var
  21:         i : integer;
  22:         r : real;
  23:     begin
  24:         r := 0.5;
  25:         for i := 1 to 1000 do begin
  26:         r := r * r;
  27:         end;
  28:         writeln('this machine handles more than 2^-1000');
  29:     end;
  30:     procedure gendivideby0;
  31:     var
  32:         r : real;
  33:     begin
  34:         r := 17.0;
  35:         r := r - r;     {should be 0.0}
  36:         r := 17.0 / r;
  37:         writeln('i wonder what r is?', r);
  38:     end;
  39:     procedure gendomain;
  40:     var
  41:         r : real;
  42:     begin
  43:         r := -17.0;
  44:         r := sqrt(r);
  45:         writeln('i wonder what r is?', r);
  46:     end;
  47:     begin
  48:     write('which do you want (');
  49:     for request := succ(fperrorfirst) to pred(fperrolast) do begin
  50:         {this isn't standard pascal.}
  51:         write( ' ', request);
  52:     end;
  53:     write(' ): ');
  54:         {neither is this, but it sure is convenient.}
  55:     readln(request);
  56:     if request in [overflow,underflow,divideby0,domain] then begin
  57:         writeln('one ', request, ' coming right down');
  58:         case request of
  59:         overflow:   genoverflow;
  60:         underflow:  genunderflow;
  61:         divideby0:  gendivideby0;
  62:         domain: gendomain;
  63:         end;
  64:     end else begin
  65:         {default:}
  66:         writeln('oh, never mind');
  67:     end;
  68:     end.