DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »PPMOD2.PAS«

└─⟦02f213fda⟧ Bits:30008919 MT+ SPP 2/3
    └─⟦this⟧ »PPMOD2.PAS« 

TextFile

(*  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»