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.