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