LL1PRC: PROC;
/****************************************************************
* LL(1) GRAMMAR ANALYZER - COMMON PROCEDURES *
*PURPOSE: *
* THIS PROGRAM CONTAINS THE COMMON PROCEDURES USES BY *
* MOST OF THE OTHER PHASES. *
*INPUT: *
*OUTPUT: *
*OUTLINE: *
*REMARKS: *
****************************************************************/
/********************* CHR_TO_NUM ******************************/
CHRNUM: PROC (L) RETURNS(BIN(15)) EXTERNAL;
/* THIS ROUTINE IS RESPONSIBLE FOR CONVERTING A CHARACTER */
/* TO A BINARY NUMBER. */
DCL J BIN(15); /* LOOP INDEX */
DCL K BIT(16); /* INTERMEDIATE BIT VALUE */
DCL L CHAR; /* INTERMEDIATE CHAR VALUE */
DCL M BIT(8);
/* RETURN TO CALLER WITH CHARACTER. */
RETURN(J);
END CHRNUM;
/********************* CLOSURE ******************************/
CLOSUR: PROC(ARRAY_PTR) EXTERNAL;
/*THIS ROUTINE IS RESPONSIBLE FOR CALCULATING THE REFLEXIVE */
/*TRANSITIVE CLOSURE OF THE ARRAY SPECIFIED. */
DCL I FIXED; /* INDICES */
DCL J FIXED;
DCL K FIXED;
DCL LIMIT FIXED;
DCL ARRAY_PTR PTR;
/* PUT IN THE IDENTITY MATRIX. */
LIMIT=LENGTH(NTRM)+LENGTH(TRM);
DO I=1 TO LIMIT;
CALL SETBIT(I,I,ARRAY_PTR);
END;
/* COMPUTE THE REFLEXIVE TRANSITIVE CLOSURE. */
DO I=1 TO LIMIT;
DO J=1 TO LIMIT;
IF TSTBIT(J,I,ARRAY_PTR) THEN
DO K=1 TO LIMIT;
IF TSTBIT(J,K,ARRAY_PTR) | TSTBIT(I,K,ARRAY_PTR) THEN
CALL SETBIT(J,K,ARRAY_PTR);
END;
END;
END;
/* RETURN TO CALLER. */
END CLOSUR;
/********************* IS_NTRM ******************************/
ISNTRM: PROC (X) RETURNS(BIT(1)) EXTERNAL;
/* THIS ROUTINE INDICATES IF A VOCABULARY ELEMENT IS */
/* A NON-TERMINAL. */
DCL X CHAR; /* INPUT INDEX */
DCL I FIXED; /* INTERNAL INDEX */
IF LENGTH(NTRM)=0 THEN
RETURN(FALSE);
DO I=1 TO LENGTH(NTRM);
IF X=SUBSTR(NTRM,I,1) THEN
RETURN(TRUE);
END;
RETURN(FALSE);
END ISNTRM;
/********************* IS_NLNTRM ******************************/
ISNLNT: PROC (X) RETURNS(BIT(1)) EXTERNAL;
/* THIS ROUTINE INDICATES IF A VOCABULARY ELEMENT IS */
/* A NULLABLE NON-TERMINAL. */
DCL X CHAR; /* INPUT INDEX */
DCL I FIXED; /* INTERNAL INDEX */
IF LENGTH(NLNTRM)=0 THEN
RETURN(FALSE);
IF ISNTRM(X)=FALSE THEN /*NOT A NON-TERMINAL*/
RETURN(FALSE);
DO I=1 TO LENGTH(NLNTRM);
IF X=SUBSTR(NLNTRM,I,1) THEN
RETURN(TRUE);
END;
RETURN(FALSE);
END ISNLNT;
/********************* IS_TRM ******************************/
ISTRM: PROC (X) RETURNS(BIT(1)) EXTERNAL;
/* THIS ROUTINE INDICATES IF A VOCABULARY ELEMENT IS TERMINAL. */
DCL X CHAR; /* INPUT INDEX */
DCL I FIXED; /* INTERNAL INDEX */
IF LENGTH(TRM)=0 THEN
RETURN(FALSE);
DO I=1 TO LENGTH(TRM);
IF X=SUBSTR(TRM,I,1) THEN
RETURN(TRUE);
END;
RETURN(FALSE);
END ISTRM;
/********************* MULTREL ******************************/
MULREL: PROC EXTERNAL;
/*THIS ROUTINE IS RESPONSIBLE FOR MULTIPLYING TWO RELATION- */
/*SHIPS TOGETHER. */
DCL I FIXED; /* INDICES */
DCL J FIXED;
DCL K FIXED;
DCL LIMIT FIXED;
DCL ARRAY_PTR PTR;
DCL ARRAY3(256,32) BIT(8) BASED(ARRAY_PTR);
/* MULTIPLY ARRAY1 BY ARRAY2. */
DO J=1 TO LIMIT;
DO I=1 TO LIMIT;
IF TSTBIT(I,J,ADDR(ARRAY1)) THEN
DO K=1 TO LIMIT;
IF TSTBIT(J,K,ADDR(ARRAY2)) THEN
CALL SETBIT(I,K,ARRAY_PTR);
END;
END;
END;
/* PUT THE PRODUCT BACK IN ARRAY1. */
DO I=1 TO LIMIT;
DO J=1 TO 32;
ARRAY1(I,J)=ARRAY3(I,J);
END;
END;
FREE ARRAY3;
/* RETURN TO CALLER. */
END MULREL;
/********************* NUM_TO_CHR ******************************/
NUMCHR: PROC (J) RETURNS(CHAR) EXTERNAL;
/* THIS ROUTINE IS RESPONSIBLE FOR CONVERTING A BINARY*/
/* NUMBER TO A CHARACTER.*/
DCL J BIN(15); /* LOOP INDEX */
DCL K BIT(16); /* INTERMEDIATE BIT VALUE */
DCL L CHAR; /* INTERMEDIATE CHAR VALUE */
UNSPEC(K)=J;
UNSPEC(L)=SUBSTR(K,8,8);
/* RETURN TO CALLER WITH CHARACTER. */
RETURN(L);
END NUMCHR;
/********************* PRINT_ARRAY ******************************/
PRTARY: PROC(HEADING,PHS,HORNUM,VERNUM,ARRAY_PTR) EXTERNAL;
/*THIS ROUTINE IS RESPONSIBLE FOR PRINTING THE RELATION */
/*DEFINED BY ARRAY1. */
DCL I BIN(15); /* INDEXES */
DCL J BIN(15);
DCL COL_FROM FIXED;
DCL COL_TO FIXED;
DCL LIN_FROM FIXED;
DCL LIN_TO FIXED;
DCL HEADING CHAR(40) VARYING;
DCL PHS BIT(1); /* PRINT HORIZONTAL SYMBOL FLAG */
DCL HORNUM FIXED; /* NUMBER OF HORIZONTAL LINES */
DCL VERNUM FIXED; /* NUMBER OF VERTICAL LINES */
DCL ARRAY_PTR PTR;
/* PRINT STANDARD HEADER. */
PUT FILE(LSTFIL) PAGE;
PUT FILE(LSTFIL) SKIP(3)
EDIT(HEADING,'PAGE',PAGENO(LSTFIL)-1)
(X(15),A(37),X(10),A(4),F(4));
PUT FILE(LSTFIL) SKIP(1);
/* PRINT LINES OF SYMBOL NUMBERS FOR HORIZONTAL. */
I=100;
DO WHILE(I>0);
LINE_OUT='';
DO J=COL_FROM TO COL_TO;
IF J<I THEN
LINE_OUT=LINE_OUT || ' ';
ELSE
LINE_OUT=LINE_OUT || ASCII(48+MOD(J/I,10));
END;
PUT FILE(LSTFIL) SKIP EDIT(LINE_OUT) (X(20),A);
I=I/10;
END;
/* PRINT TOP SEPERATOR LINE. */
CALL PRINT_SEP(COL_FROM,COL_TO);
/* RETURN TO CALLER. */
END PRINT_HDNG;
/* PRINT THE CURRENT LINE. */
PRINT_LINE: PROC(COL_CUR,COL_FROM,COL_TO);
DCL I FIXED;
DCL COL_CUR FIXED;
DCL COL_FROM FIXED;
DCL COL_TO FIXED;
DCL LINE_OUT CHAR(130) VARYING;
DCL SYMBOL CHAR(10) VARYING;
/* BUILD MATRIX PART OF LINE. */
LINE_OUT='';
DO I=COL_FROM TO COL_TO;
IF TSTBIT(COL_CUR,I,ARRAY_PTR) THEN
LINE_OUT=LINE_OUT || '1';
ELSE
LINE_OUT=LINE_OUT || '0';
END;
/* PRINT THE LINE. */
IF PHS THEN
SYMBOL=VOC(COL_CUR);
ELSE
SYMBOL='';
PUT FILE(LSTFIL) SKIP EDIT(COL_CUR,SYMBOL,'|',LINE_OUT,'|')
(X(04),F(4),X(01),A(10),A(1),A,A(1));
/* PRINT SEPERATOR LINE. */
LINE_OUT='+';
DO I=COL_FROM TO COL_TO;
LINE_OUT=LINE_OUT || '-';
END;
LINE_OUT=LINE_OUT || '+';
PUT FILE(LSTFIL) SKIP EDIT(LINE_OUT) (X(19),A);
/* RETURN TO CALLER. */
END PRINT_SEP;
/* OUTPUT THE HEADING. */
ON ENDPAGE(LSTFIL)
BEGIN;
CALL PRINT_HDNG(COL_FROM,COL_TO);
END;
/* PRINT THE REPORT PAGE. */
LIN_FROM=1; /* SET MARGINS. */
DO WHILE(LIN_FROM<HORNUM); /* PRINT HORIZONTAL LINES. */
LIN_TO=MIN(HORNUM,55+LIN_FROM);
COL_FROM=1;
DO WHILE(COL_FROM<VERNUM); /* PRINT VERTICAL LINES. */
COL_TO=MIN(VERNUM,55+COL_FROM);
SIGNAL ENDPAGE(LSTFIL);
DO I=LIN_FROM TO LIN_TO; /* PRINT THE PAGE. */
CALL PRINT_LINE(I,COL_FROM,COL_TO);
END;
CALL PRINT_SEP(COL_FROM,COL_TO);
COL_FROM=COL_FROM+56;
END;
LIN_FROM=LIN_FROM+56;
END;
/* RETURN TO CALLER. */
END PRTARY;
/********************* RESET_BIT ******************************/
RSTBIT: PROC(X,Y,ARRAY_PTR) EXTERNAL;
/*THIS ROUTINE IS RESPONSIBLE FOR RESETING ON THE BIT DENOTED */
/*BY THE X,Y COORDINATES IN THE ARRAY SPECIFIED. */
DCL I FIXED; /* INDICES */
DCL J FIXED;
DCL K FIXED;
DCL X BIN(15); /* INDICES */
DCL Y BIN(15);
DCL ARRAY_PTR PTR;
DCL ARRAY(256,32) BIT(8) BASED(ARRAY_PTR);
/* DEVELOP ACTUAL ARRAY ELEMENT USING X,Y COORDINATES. */
I=X; /* VERTICAL */
J=(Y/8)+1; /* HORIZONTAL - BYTE */
K=MOD(Y,8)+1; /* HORIZONTAL - BIT */
/* SET THE BIT IN THE ARRAY. */
SUBSTR(ARRAY(I,J),K,1)=FALSE;
/* RETURN TO CALLER. */
END RSTBIT;
/********************* RESTORE_ARRAY ******************************/
RSTARY: PROC(ARRAY_PTR,FILE_TYPE) EXTERNAL;
/* THIS ROUTINE IS RESPONSIBLE FOR RESTORING AN ARRAY. */
DCL I FIXED; /* INDICES */
DCL J FIXED;
DCL BW_FILE FILE;
DCL FILE_TYPE CHAR(3);
DCL FILE_NAME CHAR(20) VARYING;
DCL ARRAY_PTR PTR;
DCL ARRAY(64) CHAR(128) BASED(ARRAY_PTR);
/* OPEN THE FILE. */
FILE_NAME='$1.'||FILE_TYPE;
OPEN FILE(BW_FILE) DIRECT INPUT TITLE(FILE_NAME)
ENV(F(128));
/* WRITE THE ARRAY TO IT. */
DO I=0 TO 63;
READ FILE(BW_FILE) INTO(ARRAY(I+1)) KEY(I);
END;
/* SAVE THE FILE. */
CLOSE FILE(BW_FILE);
/* RETURN TO CALLER. */
END RSTARY;
/********************* SAVE_ARRAY ******************************/
SAVARY: PROC(ARRAY_PTR,FILE_TYPE) EXTERNAL;
/* THIS ROUTINE IS RESPONSIBLE FOR SAVING AN ARRAY. */
DCL I FIXED; /* INDICES */
DCL J FIXED;
DCL BW_FILE FILE;
DCL FILE_TYPE CHAR(3);
DCL FILE_NAME CHAR(20) VARYING;
DCL ARRAY_PTR PTR;
DCL ARRAY(64) CHAR(128) BASED(ARRAY_PTR);
/* OPEN THE FILE. */
FILE_NAME='$1.'||FILE_TYPE;
OPEN FILE(BW_FILE) DIRECT OUTPUT TITLE(FILE_NAME)
ENV(F(128));
/* WRITE THE ARRAY TO IT. */
DO I=0 TO 63;
WRITE FILE(BW_FILE) FROM(ARRAY(I+1)) KEYFROM(I);
END;
/* SAVE THE FILE. */
CLOSE FILE(BW_FILE);
/* RETURN TO CALLER. */
END SAVARY;
/********************* SET_BIT ***************************/
SETBIT: PROC(X,Y,ARRAY_PTR) EXTERNAL;
/*THIS ROUTINE IS RESPONSIBLE FOR SETING ON THE BIT DENOTED */
/*BY THE X,Y COORDINATES IN THE ARRAY SPECIFIED. */
DCL I FIXED; /* INDICES */
DCL J FIXED;
DCL K FIXED;
DCL X BIN(15); /* INDICES */
DCL Y BIN(15);
DCL ARRAY_PTR PTR;
DCL ARRAY(256,32) BIT(8) BASED(ARRAY_PTR);
/* DEVELOP ACTUAL ARRAY ELEMENT USING X,Y COORDINATES. */
I=X; /* VERTICAL */
J=(Y/8)+1; /* HORIZONTAL - BYTE */
K=MOD(Y,8)+1; /* HORIZONTAL - BIT */
/* SET THE BIT IN THE ARRAY. */
SUBSTR(ARRAY(I,J),K,1)=TRUE;
/* RETURN TO CALLER. */
END SETBIT;
/********************* TEST_BIT ***************************/
TSTBIT: PROC(X,Y,ARRAY_PTR) RETURNS(BIT(1)) EXTERNAL;
/*THIS ROUTINE IS RESPONSIBLE FOR TESTING THE BIT DENOTED */
/*BY THE X,Y COORDINATES IN THE ARRAY SPECIFIED. */
DCL I FIXED; /* INDICES */
DCL J FIXED;
DCL K FIXED;
DCL X BIN(15); /* INDICES */
DCL Y BIN(15);
DCL ARRAY_PTR PTR;
DCL ARRAY(256,32) BIT(8) BASED(ARRAY_PTR);
/* DEVELOP ACTUAL ARRAY ELEMENT USING X,Y COORDINATES. */
I=X; /* VERTICAL */
J=(Y/8)+1; /* HORIZONTAL - BYTE */
K=MOD(Y,8)+1; /* HORIZONTAL - BIT */
/* RETURN THE BIT IN THE ARRAY. */
RETURN(SUBSTR(ARRAY(I,J),K,1));
/* RETURN TO CALLER. */
END TSTBIT;
/********************* ZERO_ARRAY ***************************/
ZEROAR: PROC(ARRAY_PTR) EXTERNAL;
/*THIS ROUTINE IS RESPONSIBLE FOR ZEROING THE ARRAY SPECIFIED. */
DCL I FIXED; /* INDICES */
DCL J FIXED;
DCL ARRAY_PTR PTR;
DCL ARRAY(256,32) BIT(8) BASED(ARRAY_PTR);
/* ZERO THE ARRAY. */
DO I=1 TO 256;
DO J=1 TO 32;
ARRAY(I,J)='00000000'B;
END;
END;
