COMPUTE_ALIVE: PROC (PRDSET_NUM,PRDSET_PTR) RETURNS(CHAR(254) VARYING);
/* THIS ROUTINE COMPUTES THE SET OF ALIVE NON-TERMINALS. */
/* A NONTERMINAL IS ALIVE IF IT CAN DERIVE ONE OR MORE
TERMINAL STRINGS; OTHERWISE, IT IS DEAD. */
DCL PRDSET_NUM BIN(15); /* NUMBER OF PRODUCTIONS IN SET */
DCL PRDSET_PTR PTR; /* PTR TO PRODUCTION SET */
DCL PRDSET(MAX_PROD) BIN(15) BASED(PRDSET_PTR);
DCL ALIVE_SET CHAR(254) VARYING;
DCL ALIVE_FLAG BIT(1); /* FLAG USED DURING CHECKING */
DCL ALIVE_LOOP BIT(1); /* FLAG USED TO CONTROL LOOPING */
DCL I FIXED; /* INTERNAL INDEX */
DCL J FIXED; /* INTERNAL INDEX */
/* DETERMINE ALL NONTERMINALS WHICH APPEAR ON THE LEFT-HAND
SIDE OF AT LEAST ONE PRODUCTION WHICH HAS NO NON-TERMINALS
ON THE RIGHT-HAND SIDE. */
ALIVE_SET='';
DO I=1 TO PRDSET_NUM;
IF LENGTH(RHS(PRDSET(I)))=0 THEN
ALIVE_FLAG=TRUE;
ELSE
DO;
ALIVE_FLAG=TRUE;
DO J=1 TO LENGTH(RHS(PRDSET(I)));
IF ISNTRM(SUBSTR(RHS(PRDSET(I)),J,1)) THEN
DO;
ALIVE_FLAG=FALSE;
J=LENGTH(RHS(PRDSET(I)));
END;
END;
END;
IF ALIVE_FLAG THEN
DO;
IF LENGTH(ALIVE_SET)=0 THEN /*INSURE NO DUPLICATES*/
;
ELSE
DO J=1 TO LENGTH(ALIVE_SET);
IF LHS(PRDSET(I))=SUBSTR(ALIVE_SET,J,1) THEN
DO;
ALIVE_FLAG=FALSE;
J=LENGTH(ALIVE_SET);
END;
END;
IF ALIVE_FLAG THEN
ALIVE_SET=ALIVE_SET||LHS(PRDSET(I));
END;
END; /* DO */
/* ALSO, DETERMINE ALL NON-TERMINALS WHICH APPEAR ON THE
LEFT-HAND SIDE OF AT LEAST ONE PRODUCTION FOR WHICH ALL
NON-TERMINALS ON THE RIGHT-HAND SIDE ALREADY ARE ALIVE.
ALIVE_LOOP=TRUE; /* SET FOR FIRST TIME. */
DO WHILE(ALIVE_LOOP); /* LOOP AS LONG AS WE FOUND
AN ALIVE NON-TERMINAL ON
THE LAST PASS. */
ALIVE_LOOP=FALSE; /* DEFAULT TO NOT FOUND ONE */
DO I=1 TO PRDSET_NUM;
ALIVE_FLAG=TRUE;
IF LENGTH(RHS(PRDSET(I)))~=0 THEN
DO J=1 TO LENGTH(RHS(PRDSET(I)));
IF IS_ALIVE(SUBSTR(RHS(PRDSET(I)),J,1),
ALIVE_SET)=FALSE THEN
ALIVE_FLAG=FALSE;
END;
IF ALIVE_FLAG=TRUE THEN
DO;
IF LENGTH(ALIVE_SET)=0 THEN
DO;
END;
ELSE
DO J=1 TO LENGTH(ALIVE_SET); /*INSURE NO DUPLICATES*/
IF LHS(PRDSET(I))=SUBSTR(ALIVE_SET,J,1) THEN
DO;
ALIVE_FLAG=FALSE;
J=LENGTH(ALIVE_SET);
END;
END;
IF ALIVE_FLAG=TRUE THEN
DO;
ALIVE_SET=ALIVE_SET||LHS(PRDSET(I));
ALIVE_LOOP=TRUE; /* INDICATE WE FOUND ONE. */
END;
END;
END;
END; /* WHILE */
/* RETURN TO CALLER. */
RETURN(ALIVE_SET);
END COMPUTE_ALIVE;
IS_ALIVE: PROC (X,SET) RETURNS(BIT(1));
/* THIS ROUTINE INDICATES IF A NON-TERMINAL IS ALIVE. */
DCL X CHAR; /* INPUT INDEX */
DCL SET CHAR(254) VARYING; /* SET OF ALIVE NON-TERMINALS */
DCL I FIXED; /* INTERNAL INDEX */
IF LENGTH(SET)=0 THEN
RETURN(FALSE);
DO I=1 TO LENGTH(SET);
IF X=SUBSTR(SET,I,1) THEN
RETURN(TRUE);
END;
RETURN(FALSE);
END IS_ALIVE;
PRINT_NPRD: PROC;
/*THIS ROUTINE IS RESPONSIBLE FOR PRINTING THE NULLABLE */
/*PRODUCTIONS. */
DCL I BIN(15); /* INDEXES */
DCL J BIN(15);
DCL LHS_ENT CHAR(10) VARYING;
DCL RHS_ENT(5) CHAR(10) VARYING;
/* OUTPUT THE HEADING. */
ON ENDPAGE(LSTFIL)
BEGIN;
PUT FILE(LSTFIL) PAGE;
PUT FILE(LSTFIL) SKIP(3)
EDIT('*** NULLABLE PRODUCTION LISTING ***','PAGE',
PAGENO(LSTFIL)-1)
(X(15),A(35),X(10),A(4),F(4));
PUT FILE(LSTFIL) SKIP(1);
END;
SIGNAL ENDPAGE(LSTFIL);
/* PRINT THE REPORT LINES. */
DO I=1 TO NNLPRD;
LHS_ENT=VOC(CHRNUM(LHS(NULPRD(I))));
DO J=1 TO 5;
IF J>LENGTH(RHS(NULPRD(I))) THEN
RHS_ENT(J)='';
ELSE
RHS_ENT(J)=VOC(CHRNUM(SUBSTR(RHS(NULPRD(I)),J,1)));
END;
PUT FILE(LSTFIL) SKIP(1)
EDIT(NULPRD(I),LHS_ENT,' -> ',(RHS_ENT(J) DO J=1 TO 5),';')
(F(4),X(01),A,A(04),5(A,X(01)),A(1));
END;
END PRINT_NPRD;
PRINT_NNT: PROC;
/*THIS ROUTINE IS RESPONSIBLE FOR PRINTING THE NULLABLE */
/*NON-TERMINALS.*/
DCL I BIN(15); /* INDEXES */
DCL J BIN(15);
DCL LHS_ENT CHAR(10) VARYING;
DCL RHS_ENT(5) CHAR(10) VARYING;
/* OUTPUT THE HEADING. */
ON ENDPAGE(LSTFIL)
BEGIN;
PUT FILE(LSTFIL) PAGE;
PUT FILE(LSTFIL) SKIP(3)
EDIT('*** NULLABLE NON-TERMINAL LISTING ***','PAGE',
PAGENO(LSTFIL)-1)
(X(25),A(35),X(10),A(4),F(4));
PUT FILE(LSTFIL) SKIP(1);
END;
SIGNAL ENDPAGE(LSTFIL);
/* PRINT THE REPORT LINES. */
DO I=1 TO LENGTH(NLNTRM);
LHS_ENT=VOC(CHRNUM(SUBSTR(NLNTRM,I,1)));
PUT FILE(LSTFIL) SKIP(1)
EDIT(I,LHS_ENT)
(X(20),F(4),X(01),A);
END;
CALC_NULPRD: PROC;
/*THIS ROUTINE IS RESPONSIBLE FOR CALCULATING THE SET OF */
/*NULLABLE PRODUCTIONS. THE NULLABLE PRODUCTIONS ARE */
/*THOSE FOR WHICH THE SYMBOLS ON THE RIGTH-HAND SIDE ARE */
/*ALL NULLABLE. THAT IS, ALL RIGHT-HAND SIDE SYMBOLS */
/*MUST BE NULLABLE NON-TERMINALS. */
DCL I BIN(15); /* INDEXES */
DCL J BIN(15);
DCL NNL_FND BIT(1); /* TERMINAL FOUND INDICATOR */
/* CALCULATE PRODUCTION SET. */
NNLPRD=0; /* ZERO NUL PRD COUNT. */
DO I=1 TO NUMPRD; /* LOOP THRU ALL PRODUCTIONS. */
IF LENGTH(RHS(I))=0 THEN /*EPSILON PRODUCTION*/
DO;
NNL_FND=TRUE; /*ADD PRODUCTION TO SET.*/
END;
ELSE
DO J=1 TO LENGTH(RHS(I));
NNL_FND=ISNLNT(SUBSTR(RHS(I),J,1));
IF NNL_FND=FALSE THEN
J=LENGTH(RHS(I)); /*FORCE END OF SEARCH.*/
END;
IF NNL_FND=TRUE THEN
DO;
NNLPRD=NNLPRD+1; /*ADD PRODUCTION TO SET.*/
NULPRD(NNLPRD)=I;
END;
END;
/* RETURN TO CALLER. */
END CALC_NULPRD;
CALC_NULTRM: PROC;
/*THIS ROUTINE IS RESPONSIBLE FOR CALCULATING THE SET OF */
/*NULLABLE NON-TERMINALS GIVEN THE GRAMMAR CALCULATED IN */
/*THE PREVIOUS STEP. THE NULLABLE NON-TERMINALS ARE THOSE*/
/*FOUND TO BE ALIVE IN THE NEW GRAMMAR. */
/* CALCULATE THE NULLABLE NON-TERMINALS. */
NLNTRM=COMPUTE_ALIVE(NNLPRD,ADDR(NULPRD));
/* RETURN TO CALLER. */
END CALC_NULTRM;
CALC_PRDSET: PROC;
/*THIS ROUTINE IS RESPONSIBLE FOR CALCULATING THE INITIAL */
/*SET OF POSSIBLE NULLABLE PRODUCTIONS. TO DO THIS, IT */
/*TAKES THE SET OF ALL PRODUCTIONS IN THE GIVEN GRAMMAR */
/*AND DELETES ALL PRODUCTIONS WHICH CONTAIN A TERMINAL IN */
/*ITS RIGHT-HAND SIDE. SINCE EPSILON IS NOT A TERMINAL */
/*SYMBOL, THIS STEP DOES NOT DELETE ANY EPSILON PRODUC- */
/*TIONS. */
DCL I BIN(15); /* INDEXES */
DCL J BIN(15);
DCL TRM_FND BIT(1); /* TERMINAL FOUND INDICATOR */
/* CALCULATE PRODUCTION SET. */
NNLPRD=0; /* ZERO NUL PRD COUNT. */
DO I=1 TO NUMPRD; /* LOOP THRU ALL PRODUCTIONS. */
IF LENGTH(RHS(I))=0 THEN /*EPSILON PRODUCTION*/
DO;
TRM_FND=FALSE;
END;
ELSE
DO J=1 TO LENGTH(RHS(I));
TRM_FND=ISTRM(SUBSTR(RHS(I),J,1));
IF TRM_FND=TRUE THEN
J=LENGTH(RHS(I)); /*FORCE END OF SEARCH.*/
END;
IF TRM_FND=FALSE THEN
DO;
NNLPRD=NNLPRD+1; /*ADD PRODUCTION TO SET.*/
NULPRD(NNLPRD)=I;
END;
END;
/* ANALYZE THE GRAMMAR. */
PUT SKIP LIST('BEGINNING PHASE 3 PROCESSING.');
CALL CALC_PRDSET; /*CALCULATE INITIAL SET OF POSSIBLE
NULLABLE PRODUCTIONS. */
CALL CALC_NULTRM; /*CALCULATE NULLABLE NON-TERMINALS
FROM THE ABOVE SET. */
CALL CALC_NULPRD; /*CALCULATE THE NULLABEL PRODUCTIONS.*/
/* PRINT THE RESULTS. */
CALL PRINT_NNT; /*PRINT NULLABLE NON-TERMINALS.*/
CALL PRINT_NPRD; /*PRINT NULLABLE PRODUCTIONS.*/
PUT SKIP LIST('PHASE 3 PROCESSING COMPLETE.');
END LL1P30;
