(******************************************************************************) (* plx scanner *) (* (C) 2010 Steffen Solyga *) (******************************************************************************) IMPLEMENTATION MODULE Scnr; IMPORT SysLib; IMPORT FIO; CONST bufLen = 1024; err = FIO.ErrorOutput; cEOF = 32C; (* = 1AH = 26 = ASCII.sub (TS) *) cLF = 12C; TYPE TBufIdx = [ 0 .. bufLen - 1 ]; TBufDesc = ARRAY TBufIdx OF CHAR; VAR chr: CHAR; chp: TPosDesc; buf: TBufDesc; id1: CARDINAL; (* write index *) PROCEDURE Err( s: ARRAY OF CHAR ); BEGIN FIO.WrStr( err, 'Scnr (' ); FIO.WrCard( err, pos.l, 0 ); FIO.WrChar( err, ',' ); FIO.WrCard( err, pos.c, 0 ); FIO.WrStr( err, '): ' ); FIO.WrStr( err, s ); FIO.WrStr( err, '.' ); FIO.WrLn( err ); SysLib.exit( -1 ); END Err; PROCEDURE Get(); BEGIN IF chr = cEOF THEN RETURN END; IF chr = cLF THEN (* UNIX and DOS text ok *) INC( chp.l ); chp.c := 1; ELSE INC( chp.c ); END; chr := FIO.RdChar( src ); END Get; PROCEDURE Alpha(): BOOLEAN; BEGIN RETURN ( '0' <= chr ) & ( chr <= '9' ) OR ( 'A' <= CAP(chr) ) & ( CAP(chr) <= 'Z' ); END Alpha; PROCEDURE Number(); VAR d: CARDINAL; BEGIN sym := sNum; num := 0; REPEAT d := ORD( chr ) - ORD( '0' ); IF ( MAX(LONGCARD) - LONGCARD(d) ) DIV 10 >= num THEN num := 10 * num + LONGCARD( d ); ELSE Err( 'Number too large' ); END; Get(); UNTIL ~Alpha(); END Number; PROCEDURE Id(); BEGIN sym := sId; id1 := id + 1; REPEAT IF id1 >= bufLen THEN Err( 'Buffer full' ) END; buf[ id1 ] := chr; INC( id1 ); Get(); UNTIL ~Alpha(); buf[ id ] := CHR( id1 - id ); END Id; PROCEDURE Read(); PROCEDURE ChkEOF(); BEGIN IF chr = cEOF THEN Err( 'Unterminated comment' ) END; END ChkEOF; PROCEDURE Comment(); BEGIN Get(); REPEAT WHILE chr # '*' DO ChkEOF(); Get() END; Get(); ChkEOF(); UNTIL chr = ')'; Get(); END Comment; BEGIN LOOP (* ignore control characters except EOF *) IF chr <= ' ' THEN IF chr = cEOF THEN EXIT END; Get(); ELSIF chr >= 177C THEN Get(); ELSE EXIT; END; END; pos := chp; CASE chr OF | cEOF : sym := sEOF; | '!' : sym := sExcl; Get(); | '(' : Get(); IF chr = '*' THEN Comment(); Read() ELSE sym := sLPar END; | ')' : sym := sRPar; Get(); | '*' : sym := sStar; Get(); | '+' : sym := sPlus; Get(); | '-' : sym := sMinus; Get(); | '.' : sym := sDot; Get(); | '/' : sym := sSlash; Get(); | '0'..'9': Number(); | ';' : sym := sSemi; Get(); | '=' : sym := sEql; Get(); | 'A'..'Z': Id(); | 'a'..'z': Id(); ELSE Err( 'Invalid character' ); END; END Read; PROCEDURE KeepId(); BEGIN id := id1; END KeepId; PROCEDURE Diff( i, j: CARDINAL ): INTEGER; VAR l: CARDINAL; BEGIN l := ORD( buf[i] ); (* always >0 *) WHILE l > 0 DO IF buf[i] # buf[j] THEN RETURN INTEGER( ORD(buf[i]) ) - INTEGER( ORD(buf[j]) ); END; INC( i ); INC( j ); DEC( l ); END; RETURN 0; END Diff; BEGIN chr := cLF; chp.l := 0; chp.c := 0; buf[ 0 ] := 0C; id1 := 0; src := FIO.StandardInput; sym := sNull; num := 0; id := 0; pos := chp; END Scnr.