|
|
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: 5632 (0x1600)
Types: TextFile
Names: »PPMOD3.PAS«
└─⟦02f213fda⟧ Bits:30008919 MT+ SPP 2/3
└─⟦this⟧ »PPMOD3.PAS«
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»