(* VERSION 0023 *) (* 5.5 STARTS WITH VERSION 23 *) MODULE PPMOD2; (*$I PPTYPES*) (*$I PPEXTS*) VAR LAST_CHAR : CHAR; EXTERNAL PROCEDURE STORENXT(VAR LEN : INTEGER; VAR VALUE : STRING); EXTERNAL PROCEDURE GETIDENTIFIER( VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER); EXTERNAL PROCEDURE GETCOMMENT( VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER; BRACE : BOOLEAN); EXTERNAL PROCEDURE SKIPSPACES(VAR SPACESBEFORE,CRSBEFORE : INTEGER); PROCEDURE GETNUMBER(VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER); BEGIN WHILE NXT.NAME = DIGIT DO STORENXT(LENGTH,VALUE); NAME := OTHERSY END; (*$P*) PROCEDURE GETCHLITERAL(VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER); BEGIN WHILE NXT.NAME = QUOTE DO BEGIN STORENXT(LENGTH,VALUE); WHILE NOT (NXT.NAME IN [QUOTE,ENDOFLINE,FILEMARK]) DO STORENXT(LENGTH,VALUE); IF NXT.NAME = QUOTE THEN STORENXT(LENGTH,VALUE) END; NAME := OTHERSY END; (*$P*) FUNCTION CHARTYPE:KEYSYMBOL; VAR NEXT_TWO_CHARS : SPECIALCHAR; HIT : BOOLEAN; THISCHAR : KEYSYMBOL; BEGIN LAST_CHAR := CUR.VALUE; NEXTTWOCHARS[1] := CUR.VALUE; NEXTTWOCHARS[2] := NXT.VALUE; THISCHAR := BECOMES; HIT := FALSE; WHILE NOT(HIT OR (THISCHAR = CLOSECOMMENT)) DO IF NEXTTWOCHARS = DBLCHR[THISCHAR] THEN HIT := TRUE ELSE THISCHAR := SUCC(THISCHAR); IF NOT HIT THEN BEGIN THISCHAR := OPENCOMMENT; WHILE NOT(HIT OR (PRED(THISCHAR) = PERIOD)) DO IF CUR.VALUE = SGLCHAR[THISCHAR] THEN HIT := TRUE ELSE THISCHAR := SUCC(THISCHAR); END; IF HIT THEN CHARTYPE := THISCHAR ELSE CHARTYPE := OTHERSY END; (*$P*) PROCEDURE GETSPECIALCHAR(VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER); BEGIN STORENXT(LENGTH,VALUE); NAME := CHARTYPE; IF NAME IN DBLCHARS THEN STORENXT(LENGTH,VALUE); CASE NAME OF COLON : COLONSEEN := TRUE; SEMICOLON : BEGIN COLONSEEN := FALSE; EXTSEEN := FALSE END END END; (*$P*) PROCEDURE GETNEXTSYMBOL(VAR NAME : KEYSYMBOL; VAR VALUE: STRING; VAR LENGTH:INTEGER); BEGIN CASE NXT.NAME OF LETTER : GETIDENTIFIER(NAME,VALUE,LENGTH); DIGIT : GETNUMBER(NAME,VALUE,LENGTH); QUOTE : GETCHLITERAL(NAME,VALUE,LENGTH); OTHERCHAR:BEGIN GETSPECIALCHAR(NAME,VALUE,LENGTH); IF NAME = OPENCOMMENT THEN GETCOMMENT(NAME,VALUE,LENGTH,NEXTSYM.VALUE[1]='{') END; FILEMARK: NAME := ENDOFFILE END END; (* GETNEXTSYMBOL *) (*$P*) PROCEDURE GETSYMBOL(VAR NEXTSYM,CURRSYM:SYMBOLINFO); VAR DUMMY : SYMBOLINFO; BEGIN DUMMY := CURRSYM; CURRSYM := NEXTSYM; NEXTSYM := DUMMY; WITH NEXTSYM{^} DO BEGIN SKIPSPACES(SPACESBEFORE,CRSBEFORE); LENGTH := 0; IF CURRSYM{^}.NAME = OPENCOMMENT THEN GETCOMMENT(NAME,VALUE,LENGTH,NEXTSYM.VALUE[1]='{') ELSE GETNEXTSYMBOL(NAME,VALUE,LENGTH) END END; (* GETSYMBOL *) MODEND.