Directory of image this file is from
This file as a plain text file

(* FORMATTED READ PROCEDURES -- JFM  1981-02-27  (* REVISED KOROMAP *)
(* INCLUDES FREADINTEGER; FREADREAL; FREADCHAR; FSKIP *)

(* 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
      FREADINTEGER(INPUT, X, 10, STATUS);
      IF STATUS <> GOTRESULT THEN
	BEGIN
	  WRITELN(OUTPUT,' ** ERROR MESSAGE...');
	  HALT
	END;
    END;
 *)



  PROCEDURE FREADINTEGER(VAR F: TEXT; VAR RESULT : INTEGER; WIDTH: NATURAL;
		  VAR STATUS: READSTATUS);
    (* READ FIXED-FORMAT INTEGER *)
    LABEL 1;
    VAR  NEGATIVE : BOOLEAN;  D : 0..9;  INT : INTEGER;

  BEGIN (* FREADINTEGER *)
    (* SKIP LEADING BLANKS *)
    WHILE (WIDTH > 0) AND (F^ = ' ') AND NOT EOLN(F) DO
      BEGIN  GET(F);  WIDTH := WIDTH - 1  END;
    IF (WIDTH = 0) OR EOLN(F) THEN
      BEGIN RESULT := 0;  STATUS := GOTBLANKS END
    ELSE (* (WIDTH > 0) AND NOT EOLN(F), AND THUS (F^ <> ' ') *)
      BEGIN  NEGATIVE := F^ = '-';
	IF (F^ IN ['+','-']) AND (WIDTH > 1) THEN
	  BEGIN GET(F); WIDTH := WIDTH - 1 END;
	INT := 0;
	WHILE (WIDTH > 0) AND (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;
	    WIDTH := WIDTH - 1;
	    IF NOT EOLN(F) THEN GET(F)
	  END;
	IF WIDTH = 0 THEN
	  BEGIN  STATUS := GOTRESULT;
	    IF NEGATIVE THEN RESULT := - INT ELSE RESULT := INT
	  END
	ELSE (* (WIDTH > 0), AND THUS  (NOT(F^ IN [' ', '0'..'9'])) *)
	  STATUS := GOTTRASH
      END;
  1:WHILE (WIDTH > 0) AND NOT EOLN(F) DO
      BEGIN GET(F); WIDTH := WIDTH - 1 END
  END (* FREADINTEGER *) ;


  PROCEDURE FREADREAL(VAR F: TEXT;  VAR RESULT: REAL;  WIDTH, FRACWIDTH: NATURAL;
		  VAR STATUS: READSTATUS);
    (* READ FIXED-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 (WIDTH > 0) AND (F^ = ' ') AND NOT EOLN(F) DO
      BEGIN  GET(F);  WIDTH := WIDTH - 1  END;
    IF (WIDTH = 0) OR EOLN(F) THEN
      BEGIN RESULT := 0;  STATUS := GOTBLANKS END
    ELSE (* (WIDTH > 0) AND NOT EOLN(F), AND THUS (F^ <> ' ') *)
      BEGIN  NEGATIVE := F^ = '-';
	IF (F^ IN ['+','-']) AND (WIDTH > 1) THEN
	  BEGIN GET(F); WIDTH := WIDTH - 1 END;
	(* WIDTH > 0 *)
	INT := 0;  EXPON := 0;	GOTDIGIT := FALSE;  FULL := FALSE;
	WHILE (WIDTH > 0) AND (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;
	    WIDTH := WIDTH - 1;
	    IF NOT EOLN(F) THEN GET(F)
	  END;
	IF (WIDTH > 0) AND (F^ = '.') THEN
	  BEGIN  WIDTH := WIDTH - 1;  GET(F);
	    WHILE (WIDTH > 0) AND (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;
		WIDTH := WIDTH - 1;
		IF NOT EOLN(F) THEN GET(F)
	      END
	  END
	ELSE EXPON := EXPON - FRACWIDTH;
	IF NOT GOTDIGIT THEN STATUS := GOTTRASH
	ELSE
	  BEGIN
	    IF WIDTH > 0 THEN (* MUST BE AN "E-PART" *)
	      IF F^ IN ['E','E'] THEN
		BEGIN  WIDTH := WIDTH - 1; GET(F);
		  SCALENEGATIVE := F^ = '-';  GOTDIGIT := FALSE;
		  IF (F^ IN ['+','-']) AND (WIDTH > 1) THEN
		    BEGIN WIDTH := WIDTH - 1; GET(F) END;
		  SCALE := 0;
		  WHILE (WIDTH > 0) AND (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;
		      WIDTH := WIDTH - 1;
		      IF NOT EOLN(F) THEN GET(F)
		    END;
		  IF (WIDTH > 0) OR NOT GOTDIGIT THEN
		    BEGIN STATUS := GOTTRASH; GOTO 1 END;
		  IF SCALENEGATIVE THEN EXPON := EXPON - SCALE
		  ELSE EXPON := EXPON + SCALE
		END
	      ELSE BEGIN STATUS := GOTTRASH; GOTO 1 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:WHILE (WIDTH > 0) AND NOT EOLN(F) DO
      BEGIN WIDTH := WIDTH - 1;  GET(F) END
  END (* FREADREAL *) ;


PROCEDURE FREADCHAR(VAR F: TEXT; VAR RESULT: CHAR);

BEGIN (* FREADCHAR *)
  IF NOT EOLN(F)
    THEN BEGIN RESULT := F^; GET(F) END
  ELSE RESULT := ' '
END (* FREADCHAR *);


PROCEDURE FSKIP(VAR F: TEXT; WIDTH : NATURAL ) (* SKIP WIDTH COLUMNS *);

BEGIN (* FSKIP *)
  WHILE (WIDTH > 0) AND (NOT EOLN(F)) DO
    BEGIN GET(F); WIDTH := WIDTH - 1 END
END (* FSKIP *);


(* END OF FORMATTED READ PROCEDURES *)