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:                                                       *
****************************************************************/

/****************************************************************
* * * * * * * * * * * COMMON DATA DEFINITIONS * * * * * * * * * *
****************************************************************/

/*	* * *  COMMON REPLACEMENTS  * * *	*/
%REPLACE TRUE BY '1'B;
%REPLACE FALSE BY '0'B;

%INCLUDE 'LL1CMN.DCL';	/* GET COMMON AREAS. */

/****************************************************************
* * * * * * * * * * * COMMON PROCUDURES * * * * * * * * * * * * *
****************************************************************/

/********************* 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);

     M=UNSPEC(L);
     K='0000'B4;
     SUBSTR(K,9,8)=M;
     UNSPEC(J)=K;

/*   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);

/* DO INITIALIZATION. */
	LIMIT=LENGTH(NTRM)+LENGTH(TRM); /*GET ARRAY SIZE.*/
	ALLOCATE ARRAY3 SET(ARRAY_PTR);
	CALL ZEROAR(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 HEADING. */
PRINT_HDNG: PROC(COL_FROM,COL_TO);
	DCL I FIXED;
	DCL J FIXED;
	DCL COL_FROM FIXED;
	DCL COL_TO FIXED;
	DCL LINE_OUT CHAR(130) VARYING;

/* 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));

/* RETURN TO CALLER. */
	   END PRINT_LINE;

PRINT_SEP: PROC(COL_FROM,COL_TO);
	DCL I FIXED;
	DCL J FIXED;
	DCL COL_FROM FIXED;
	DCL COL_TO FIXED;
	DCL LINE_OUT CHAR(130) VARYING;

/* 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;

/* RETURN TO CALLER. */
        END  ZEROAR;


/****************************************************************
* * * * * * * * * * * MAIN ROUTINE  * * * * * * * * * * * * * * *
****************************************************************/

	END LL1PRC;