|
|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 3840 (0xf00)
Types: TextFile
Names: »PPMOD2.PAS«
└─⟦02f213fda⟧ Bits:30008919 MT+ SPP 2/3
└─⟦this⟧ »PPMOD2.PAS«
(* 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.
«eof»