DataMuseum.dk

top - metrics - download

    Length: 5632 (0x1600)
    Types: TextFile
    Names: »PPMOD3.PAS«

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

TextFile

MODULE PPMOD3;

(* CREATED 3/26/81 NJL *)

(*$I PPTYPES *)
(*$I PPEXTS *)

EXTERNAL PROCEDURE GETSYMBOL(VAR NEXTSYM,CURRSYM : SYMBOLINFO);

FUNCTION COLLIDE:BOOLEAN;
BEGIN
  GBL_OOPS := DSTCURSOR + 80 >= CURSOR;
  COLLIDE := GBL_OOPS;
END;

PROCEDURE PUTCH(CH:CHAR);
BEGIN
  IF NOT COLLIDE THEN
    BEGIN
      BUFÆDSTCURSORÅ := CH;
      DSTCURSOR := DSTCURSOR + 1
    END
END;

PROCEDURE PUTLN;
BEGIN
  PUTCH(CHR(13));
  PUTCH(CHR(10));
  LASTLINE := LASTLINE + 1
END;


FUNCTION STACKEMPTY : BOOLEAN;
BEGIN
  IF TOP = 0 THEN
    STACKEMPTY := TRUE
  ELSE
    STACKEMPTY := FALSE
END;

FUNCTION STACKFULL : BOOLEAN;
BEGIN
  IF TOP = MAXSTKSIZE THEN
    STACKFULL := TRUE
  ELSE
    STACKFULL := FALSE
END; (* STACKFULL *)

PROCEDURE POPSTACK( VAR INDENTSYMBOL : KEYSYMBOL;
                    VAR  PREVMARGIN : INTEGER);
                    
BEGIN
  IF NOT STACKEMPTY THEN
    BEGIN
      INDENTSYMBOL := STACKÆTOPÅ.INDENTSYMBOL;
      PREVMARGIN := STACKÆTOPÅ.PREVMARGIN;
      TOP := TOP - 1;
    END
  ELSE
    BEGIN
      INDENTSYMBOL := OTHERSY;
      PREVMARGIN := 0
    END
END; (* POPSTACK *)

PROCEDURE PUSHSTACK( INDENTSYMBOL : KEYSYMBOL;
                     PREVMARGIN : INTEGER);
                     
BEGIN
  TOP := TOP + 1;
  STACKÆTOPÅ.INDENTSYMBOL := INDENTSYMBOL;
  STACKÆTOPÅ.PREVMARGIN := PREVMARGIN
END; (* PUSHSTACK *)


PROCEDURE WRITECRS( NUMBEROFCRS : INTEGER; VAR CURLINEPOS : INTEGER);
VAR
  I : INTEGER;
BEGIN
  IF NUMBEROFCRS > 0 THEN
    BEGIN
      FOR I := 1 TO NUMBEROFCRS DO
        PUTLN;
      CURLINEPOS := 0
    END
END; (* WRITECRS *)


PROCEDURE INSERTCR( VAR CURRSYM : SYMBOLINFO);
CONST
  ONCE = 1;
BEGIN
  IF CURRSYMæ^å.CRSBEFORE = 0 THEN
    BEGIN
      WRITECRS(ONCE, CURLINEPOS);
      CURRSYMæ^å.SPACESBEFORE := 0
    END
END; (* INSERTCR*)

PROCEDURE INSERTBLANKLINE(VAR CURRSYM : SYMBOLINFO);
CONST
  ONCE = 1;
  TWICE = 2;
  
BEGIN
  IF CURRSYMæ^å.CRSBEFORE = 0 THEN
    BEGIN
      IF CURLINEPOS = 0 THEN
        WRITECRS(ONCE,CURLINEPOS)
      ELSE
        WRITECRS(TWICE, CURLINEPOS);
      CURRSYMæ^å.SPACESBEFORE := 0
    END
  ELSE
    IF CURRSYMæ^å.CRSBEFORE = 1 THEN
      IF CURLINEPOS > 0 THEN
        WRITECRS(ONCE, CURLINEPOS)
END;  (* INSERTBLANKLINE *)

PROCEDURE LSHIFTON(DINDENTSYMBOLS : KEYSYMSET);
VAR
  INDENTSYMBOL : KEYSYMBOL;
  PREVMARGIN : INTEGER;
BEGIN
  IF NOT STACKEMPTY THEN
    BEGIN
      REPEAT
        POPSTACK(INDENTSYMBOL,PREVMARGIN);
        IF INDENTSYMBOL IN DINDENTSYMBOLS THEN
          CURRMARGIN := PREVMARGIN
      UNTIL NOT (INDENTSYMBOL IN DINDENTSYMBOLS) OR (STACKEMPTY);
      IF NOT (INDENTSYMBOL IN DINDENTSYMBOLS) THEN
        PUSHSTACK(INDENTSYMBOL, PREVMARGIN)
    END
END; (* LSHIFTON *)


PROCEDURE LSHIFT;
VAR
  INDENTSYMBOL : KEYSYMBOL;
  PREVMARGIN : INTEGER;
BEGIN
  IF NOT STACKEMPTY THEN
    BEGIN
      POPSTACK(INDENTSYMBOL,PREVMARGIN);
      CURRMARGIN := PREVMARGIN
    END
END; (*LSHIFT*)

PROCEDURE INSERTSPACE(VAR SYMBOL : SYMBOLINFO);
BEGIN
  IF CURLINEPOS < MAXLINSIZE THEN
    BEGIN
      PUTCH(SPACE);
      CURLINEPOS := CURLINEPOS + 1;
      WITH SYMBOLæ^å DO
        IF (CRSBEFORE = 0) AND (SPACESBEFORE > 0) THEN
          SPACESBEFORE := SPACESBEFORE -1
    END
END; (* INSERTSPACE *)

PROCEDURE MOVELINEPOS( NEWLINEPOS : INTEGER; VAR CURLINEPOS : INTEGER);
VAR
  I : INTEGER;
BEGIN
  FOR I := CURLINEPOS + 1 TO NEWLINEPOS DO
    PUTCH(SPACE);
  CURLINEPOS := NEWLINEPOS
END; (* MOVELINEPOS *)


PROCEDURE PRINTSYMBOL(VAR CURRSYM : SYMBOLINFO; VAR CURLINEPOS : INTEGER);
VAR
  I : INTEGER;
BEGIN
  WITH CURRSYMæ^å DO
    BEGIN
      FOR I := 1 TO LENGTH DO
        PUTCH(VALUEÆIÅ);
        CURLINEPOS := CURLINEPOS + LENGTH
    END (* WITH *)
END; (* PRINTSYMBOL *)


PROCEDURE PPSYMBOL(VAR CURRSYM : SYMBOLINFO);
CONST
  ONCE = 1;
VAR
  NEWLINEPOS : INTEGER;
  
BEGIN
  WITH CURRSYMæ^å DO
    BEGIN
      WRITECRS( CRSBEFORE, CURLINEPOS);
      IF (CURLINEPOS + SPACESBEFORE > CURRMARGIN) OR
         ( NAME IN ÆOPENCOMMENT, CLOSECOMMENTÅ) THEN
         NEWLINEPOS := CURLINEPOS + SPACESBEFORE
      ELSE
         NEWLINEPOS := CURRMARGIN;
     
      IF NEWLINEPOS + LENGTH > MAXLINSIZE THEN
        BEGIN
          WRITECRS(ONCE,CURLINEPOS);
          IF CURRMARGIN + LENGTH <= MAXLINSIZE THEN
            NEWLINEPOS := CURRMARGIN
          ELSE
            IF LENGTH < MAXLINSIZE THEN
              NEWLINEPOS := MAXLINSIZE - LENGTH
            ELSE
              NEWLINEPOS := 0
        END;
      MOVELINEPOS(NEWLINEPOS, CURLINEPOS);
      PRINTSYMBOL(CURRSYM,CURLINEPOS)
    END; (* WITH *)
END; (*PPSYMBOL*)

PROCEDURE GOBBLE(TERMINATORS : KEYSYMSET; VAR CURRSYM,NEXTSYM : SYMBOLINFO);
BEGIN
  RSHIFTTOCLP(CURRSYMæ^å.NAME);
  WHILE NOT (NEXTSYMæ^å.NAME IN (TERMINATORS + ÆENDOFFILEÅ)) DO
    BEGIN
      GETSYMBOL(NEXTSYM,CURRSYM);
      PPSYMBOL(CURRSYM);
    END;
  LSHIFT
END; (* GOBBLE *)


PROCEDURE RSHIFT(CURRSYM : KEYSYMBOL);
BEGIN
  IF NOT STACKFULL THEN
    PUSHSTACK(CURRSYM, CURRMARGIN);
    IF CURRMARGIN < SLFAIL1 THEN
      CURRMARGIN := CURRMARGIN + INDENT1
    ELSE
      IF CURRMARGIN < SLFAIL2 THEN
        CURRMARGIN := CURRMARGIN + INDENT2
END; (*RSHIFT*)


PROCEDURE RSHIFTTOCLP(CURRSYM : KEYSYMBOL);
BEGIN
  IF NOT STACKFULL THEN
    PUSHSTACK(CURRSYM,CURRMARGIN);
  CURRMARGIN := CURLINEPOS
END;



MODEND.



«eof»