PROGRAM DUMMY(INPUT,OUTPUT); TYPE NATURAL = 0..MAXINT; READSTATUS = (GOTRESULT, GOTBLANKS, GOTTOOBIG, GOTTRASH); VAR N: REAL; S:READSTATUS; (* FREE FORMAT READ PROCEDURES -- JTE 1983-08-22 (* FROM FREAD/JFM *) (* INCLUDES READINTEGER; READREAL *) (* THE FOLLOWING TWO TYPES MUST BE DECLARED IN YOUR PROGRAM: TYPE NATURAL = 0..MAXINT; READSTATUS = (GOTRESULT, GOTBLANKS, GOTTOOBIG, GOTTRASH); EXAMPLE USAGE: VAR STATUS: READSTATUS; X: INTEGER; BEGIN READINTEGER(INPUT, X, STATUS); IF STATUS <> GOTRESULT THEN BEGIN WRITELN(OUTPUT,' ** ERROR MESSAGE...'); HALT END; END; *) PROCEDURE READINTEGER(VAR F: TEXT; VAR RESULT : INTEGER; VAR STATUS: READSTATUS); (* READ FREE-FORMAT INTEGER *) LABEL 1; VAR NEGATIVE : BOOLEAN; D : 0..9; INT : INTEGER; BEGIN (* FREADINTEGER *) (* SKIP LEADING BLANKS *) WHILE (F^ = ' ') AND NOT EOLN(F) DO GET(F); IF EOLN(F) THEN BEGIN RESULT := 0; STATUS := GOTBLANKS END ELSE (* NOT EOLN(F), AND (F^ <> ' ') *) BEGIN NEGATIVE := F^ = '-'; IF (F^ IN ['+','-']) THEN GET(F); IF NOT (F^ IN ['0'..'9']) THEN BEGIN STATUS := GOTTRASH; GOTO 1 END; INT := 0; WHILE F^ IN ['0'..'9'] DO BEGIN IF F^ = ' ' THEN D := 0 ELSE D := ORD(F^) - ORD('0'); IF (MAXINT-D) DIV 10 < INT THEN BEGIN STATUS :=GOTTOOBIG; GOTO 1 END; INT := INT * 10 + D; IF NOT EOLN(F) THEN GET(F) END; STATUS := GOTRESULT; IF NEGATIVE THEN RESULT := - INT ELSE RESULT := INT END; 1: IF STATUS = GOTTOOBIG THEN WHILE F^ IN ['0'..'9'] DO GET(F) END (* FREADINTEGER *) ; PROCEDURE READREAL(VAR F: TEXT; VAR RESULT: REAL; VAR STATUS: READSTATUS); (* READ FREE-FORMAT REAL *) LABEL 1; CONST MAXEXPON = 31; VAR GOTDIGIT, NEGATIVE, SCALENEGATIVE, FULL: BOOLEAN; SCALE: NATURAL; INT, EXPON: INTEGER; D: 0..9; FUNCTION POWER10(E: INTEGER) : REAL; VAR I: INTEGER; T: REAL; (* TAKEN FROM JENSEN AND WIRTH *) BEGIN I := 0; T := 1.0; REPEAT IF ODD(E) THEN CASE I OF 0: T := T * 1.0E1; 1: T := T * 1.0E2; 2: T := T * 1.0E4; 3: T := T * 1.0E8; 4: T := T * 1.0E16; END; E := E DIV 2; I := I + 1 UNTIL E = 0; POWER10 := T END (*POWER10*) ; BEGIN (* FREADREAL *) WHILE (F^ = ' ') AND NOT EOLN(F) DO GET(F); IF EOLN(F) THEN BEGIN RESULT := 0; STATUS := GOTBLANKS END ELSE (* NOT EOLN(F), THUS (F^ <> ' ') *) BEGIN NEGATIVE := F^ = '-'; IF F^ IN ['+','-'] THEN GET(F); INT := 0; EXPON := 0; GOTDIGIT := FALSE; FULL := FALSE; WHILE F^ IN ['0'..'9'] DO BEGIN IF FULL THEN EXPON := EXPON + 1 ELSE BEGIN IF F^ = ' ' THEN D := 0 ELSE BEGIN D := ORD(F^) - ORD('0'); GOTDIGIT := TRUE END; IF (MAXINT-D) DIV 10 < INT THEN BEGIN FULL := TRUE; EXPON := EXPON + 1 END ELSE INT := INT * 10 + D; END; GET(F) END; IF F^ = '.' THEN BEGIN GET(F); WHILE F^ IN ['0'..'9'] DO BEGIN IF NOT FULL THEN BEGIN IF F^ = ' ' THEN D := 0 ELSE BEGIN D := ORD(F^) - ORD('0'); GOTDIGIT := TRUE END; IF (MAXINT-D) DIV 10 >= INT THEN BEGIN EXPON := EXPON - 1; INT := INT * 10 + D END ELSE FULL := TRUE END; GET(F) END END; IF NOT GOTDIGIT THEN STATUS := GOTTRASH ELSE BEGIN IF F^ IN ['E','e'] THEN BEGIN GET(F); SCALENEGATIVE := F^ = '-'; GOTDIGIT := FALSE; IF F^ IN ['+','-'] THEN GET(F); SCALE := 0; WHILE F^ IN ['0'..'9'] DO BEGIN IF F^ = ' ' THEN D := 0 ELSE BEGIN D := ORD(F^) - ORD('0'); GOTDIGIT := TRUE END; IF (MAXINT-D) DIV 10 < SCALE THEN BEGIN STATUS := GOTTOOBIG; GOTO 1 END; SCALE := SCALE * 10 + D; IF NOT EOLN(F) THEN GET(F) END; IF NOT GOTDIGIT THEN BEGIN STATUS := GOTTRASH; GOTO 1 END; IF SCALENEGATIVE THEN EXPON := EXPON - SCALE ELSE EXPON := EXPON + SCALE END; IF NEGATIVE THEN INT := - INT; IF ABS(EXPON) <= MAXEXPON THEN BEGIN STATUS := GOTRESULT; IF EXPON < 0 THEN RESULT := INT / POWER10(-EXPON) ELSE RESULT := POWER10(EXPON) * INT END ELSE STATUS :=GOTTOOBIG END END; 1: IF STATUS = GOTTOOBIG THEN WHILE F^ IN ['0'..'9'] DO GET(F) END (* FREADREAL *) ; (* END OF FREE FORM READ PROCEDURES *) BEGIN (* DUMMY *) WHILE NOT EOF(INPUT) DO BEGIN READREAL(INPUT,N,S); IF S=GOTRESULT THEN WRITE(OUTPUT,' gotresult ') ELSE IF S = GOTBLANKS THEN WRITE(OUTPUT,' gotblanks ') ELSE IF S = GOTTOOBIG THEN WRITE(OUTPUT,' gottoobig ') ELSE WRITE(OUTPUT,' gottrash: ''',INPUT^,''''); IF S=GOTTRASH THEN GET(INPUT); WRITELN(OUTPUT,N, N:10:3); IF (INPUT^ = ' ') AND NOT EOLN(INPUT) THEN GET(INPUT); IF EOLN(INPUT) THEN READLN(INPUT) END END (* DUMMY *).