Google
 

Trailing-Edge - PDP-10 Archives - BB-D480F-SB_FORTRAN10_V10 - build.bli
There are 12 other files named build.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
!AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

!AUTHOR: T.E. OSTEN/CKS/RVM/CDM

MODULE BUILD(STACK(4000)) =
BEGIN

GLOBAL BIND BUILDV = #10^24 + 0^18 + #2461;	! Version Date: 28-Sep-84

%(

***** Begin Revision History *****

***** Begin Version 7 *****

1	CKS	17-Jun-82
	Expand table in SERIES to handle longer productions

2	RVM	8-Oct-82
	Write out the ACTIONNAME and ACTIONCASE PLITs even if there
	are no action routines needed by the grammar.  The the grammar
	for format statement processing includes no action routines,
	but LEFTFM, which processes the PLITs put out by BUILD, contains
	a reference to ACTIONNAME (the code that makes the reference is
	never executed, however).  This edit was motivated by the desire
	to enable the compiler build procedure to build the compiler with
	no expected errors.  The decision was made to modify BUILD to always
	define the needed PLITs rather than just deleting all references from
	LEFTFM to the "unneeded" PLITs so that if action routines are ever
	required to process formats that the code will not have to be
	restored to LEFTFM.


***** Begin Version 10 *****

2461	CDM	28-Sep-84
	Add octal and  hexadecimal constants for  the Military  Standard
	MIL-STD-1753 to DATA statements.
	Add "?" to error messages so that they're more visable as  error
	messages.

***** End V10 Development *****

***** End Revision History *****
)%

MACRO	TRACE= 1$;
OWN DEFLVL,SERLVL,CHRSW,X,START;
STRUCTURE VECTOR [I] = [I] (.VECTOR+.I);
OWN VECTOR BNFTBL[1200];
REGISTER C;
BIND	VECTOR TYPE[0]=BNFTBL[0]<24,12>,
	VECTOR SUBP[0]=BNFTBL[0]<12,12>,
	VECTOR NUMBER[0]=BNFTBL[0]<0,12>;
EXTERNAL
	READ,	%(CHNL)= RETURNS THE N-BIT VALUE(DEPENDING ON THE MODE,
		7 OR 36 BITS) OF THE CHARACTER READ. WILL RETURN -1 IF
		ENDFILE. WILL READ FROM THE TELETYPE IF CHNL=0.
		)%
	OUTMSG,	%(CHNL,TEXT)= WRITES THE GIVEN TEXT OUT ONTO THE
		SPECIFIED CHANNEL. THE TEXT IS GIVEN AS GROUPS OF QUOTED
		STRINGS 5 CHARACTERS LONG, SEPERATED BY COMMAS. THE LAST
		GROUP MUST BE LESS THAN 5 CHARACTERS LONG OR 0.
		)%
	INIT,	%(= PERFORMS A RESET UUO, CLEARS THE CHANNEL TABLE,
		OBTAINS A PARAMETER LIST FROM THE TTY AND SETS UP THE
		TABLE ENTRIES BASED ON THE INFORMATION IT CONTAINS.
		)%
	WRITE,	%(CHNL,CHAR)= WRITES CHAR ONTO THE CHANNEL CHNL. ASCII
		MODE FILES USE ONLY 7 BITS AND BINARY FILES ALL 36. ASCII
		CHARACTERS MUST BE RIGHT JUSTIFIED. THE VALUE OF THIS
		ROUTINE IS ALWAYS ZERO UNLESS THE USER HAS REQUESTED
		THAT OUTPUT ERROR CONDITIONS RETURN TO HIM INSTEAD OF
		FALLING THROUGH TO THE SYSTEM ERROR HANDLER. IN THIS CASE
		, THE VALUE WILL BE ZERO IF NO ERROR OCCURED, OR -1 IF
		AN ERROR OCCURED.
		)%
	OCTOUT,	%(CHNL,WIDTH,VALUE)= WRITES THE ASCII REPRESENTATION
		OF AN OCTAL INTEGER TO THE APPROPRIATE CHANNEL. THE VALUE
		OF WIDTH SPECIFIES THE FIELD WIDTH TO BE USED:
		N > 0 => N-CHARACTERS WIDE (INCLUDING SIGN), ZERO
		SUPPRESSED. N < 0 => N-CHARACTERS WIDE ( INCLUDING SIGN)
		,ZERO FILLED. N = 0 => MINIMUM LENGTH, LEFT JUSTIFIED.
		)%
	DECOUT,	%(CHNL,WIDTH,VALUE)= WRITES THE ASCII REPRESENTATION
		OF A DECIMAL INTEGER TO THE APPROPRIATE CHANNEL. THE VALUE
		OF WIDTH SPECIFIES THE FIELD WIDTH TO BE USED:
		N > 0 => N-CHARACTERS WIDE (INCLUDING SIGN), ZERO
		SUPPRESSED. N < 0 => N-CHARACTERS WIDE ( INCLUDING SIGN)
		,ZERO FILLED. N = 0 => MINIMUM LENGTH, LEFT JUSTIFIED.
		)%
	ENDALL, %(= CLOSES ALL OPEN CHANNELS
		)%
	OUTZ,	%(CHNL,PNTR)= WRITES THE ASCIZ STRING BEGINING AT PNTR ONTO THE SPECIFIED CHANNEL
		)%
	GETSW,	%(CHNL)=RETURNS THE VALUE OF THE SWITCH WORD ASSOCIATED
		WITH CHNL.
		)%
	SET35;	%(CHNL)=MAKES THE BUFFER WORD INTO WHICH THE NEXT
		CHARACTER WILL BE WRITTEN A SEQUENCE NUMBER.
		)%
STRUCTURE STRING[I]=[I*4](.STRING + .I*4);
OWN STRING METANAME [300]:TERMNAME[300]:ACTIONNAME[300];
%(-----------------------------------------------------------------------------------------------------------------
	NOTE THAT THE NAMES "ALL" AND "ONE" ARE USED IN THE FOLLOWING
	MACRO RATHER THAN "AND" AND "OR" AS USED IN THE BNF DESCRIPTION.
	THIS WAS DONE TO ELIMINATE CONFLICT BETWEEN THE BLISS OPERATORS
	"AND" AND "OR".
-----------------------------------------------------------------------------------------------------------------)%

MACRO	META =	1$,	!METASYMBOL CHARACTER STRING, LOCATION, 3
	ALL  =	2$,	!LIST OF REQUIRED ELEMENTS, LOCATION, NUMBER
	ONE  = 	3$,	!LIST OF ALTERNATE ELEMENTS, LOCATION, NUMBER
	OPTION=	4$,	!OPTIONAL ELEMENT(S), LOCATION, NUMBER
	LIST =	5$,	!ELEMENTS SEPARATED BY COMMAS, LOCATION, NUMBER
	REPEAT=	6$,	!ELEMENTS NOT SEPARATED BY COMMAS, LOCATION, NUMBER
	ACTION=	7$,	!CALL A ROUTINE, ROUTINE NAME
	TERMINAL= 8$;	!TERMINAL SYMBOL STRING
MACRO	LSTA  =	1$,	!DSK:FILE.EXT,
	LST  =  2$,	!DSK:FILE.EXT_
	SRC  =	3$;	!DSK:FILE.EXT
BIND	CRLF=PLIT(#015^29+#012^22);
FORWARD
	OUTSTR,		%(STR)= OUTPUTS THE ASCIZ STRING NAMED BY STR
			TO THE TELETYPE. IF STR IS 0 IT OUTPUTS A
			CARRIAGE RETURN, LINE FEED TO THE TELETYPE.
			)%
	ERROR,		%(MSG)= OUTPUT MSG FOLLOWED BY CARRIAGE RETURN,
			LINE FEED TO THE TELETYPE. THEN READ IN AND OUTPUT
			ON THE TELETYPE THE REMAINDER OF THE CURRENT
			BNFDEFINITION UP TO BUT NOT INCLUDING THE
			PERIOD. RETURN WITH THE PERIOD AS THE CURRENT
			CHARACTER.
			)%
	DEC,		%(N)= OUTPUT THE CONTENTS OF N ON THE TELETYPE
			AS A DECIMAL NUMBER.
			)%
	PRODUCTIONS,	%(= INSERTS THE TABLE ENTRIES FOR EACH BNFDEFINITION
			IN THE LANGUAGE. BNFDEFINITION = METASYMBOL "="
			BNFCOMPONENT [COMMENT] "." . THE INDEX OF THE
			METASYMBOL INTO THE METANAME TABLE IS USED TO
			PLACE THE METASYMBOL DEFINITION INTO THE BNF TABLES.
			COMMENTS PRECEEDING AND FOLLOWING THE BNFDEFINITION
			ARE IGNORED.
			)%
	TABLE,		%(TABNAME)= RETURNS AN INDEX INTO TABNAME (TERMNAME,ACTIONNAME
			OR METANAME TABLE) AND INSERTS IF NECESSARY.
			)%
	CHR,		%(= LISTS EACH CHARACTER READ IN AND RETURNS THE
			FIRST SIGNIFICANT CHARACTER WHICH IS NOT A SPACE
			, CARRIAGE RETURN, OR LINE FEED.
			)%
	COPY,		%(N,LT,LS,LN)= COPIES N TRIPLETS FROM THE LOCAL
			BNF TABLES LT (LOCAL TYPE), LS (LOCAL SUBORDINATE
			BLOCK ADDRESS), AND LN (LOCAL NUMBER OF ENTRIES
			IN THE SUBORDINATE BLOCK) TO THE TOP OF THE GLOBAL
			BNF TABLES TYPE, SUBP (SUBORDINATE BLOCK ADDRESS),
			AND NUMBER (NUMBER OF ENTRIES IN THE SUBORDINATE
			BLOCK). THE POINTER TO THE TOP OF THE BNF
			TABLES IS INCREMENTED AND THE PLACE OF COPY IS
			RETURNED.
			)%
	SERIES,		%(TT,SS,NN)= RETURNS AN AND TYPE BNFCOMPONENT
			(TT _ AND; SS _ SUBORDINATE BLOCK ADDRESS;
			NN _ NUMBER OF SUBORDINATE ENTRIES) OR THE
			SUBORDINATE COMPONENT IF THE AND HAD ONLY ONE
			COMPONENT. AND = BNFCOMPONENT *[ BNFCOMPONENT]
			;ALL OF THE BNFCOMPONENTS ARE REQUIRED . SCANS FROM
			THE CURRENT CHARACTER TO THE FIRST ".", ")", "]",
			OR LOWER CASE L (SEPERATES ELEMENTS OF AN OR
			BNFCOMPONENT) ENCOUNTERED AT ITS LEVEL.
			)%
	DEFINITION,	%(TT,SS,NN)= RETURNS A BNFCOMPONENT OF TYPE TERMINAL,
			OR, OPTION, LIST, REPEAT, ACTION, OR META.
			)%
	DECIN;		%(= RETURNS A DECIMAL NUMBER FROM THE TELETYPE AND
			DEFINES START (THE NUMBER OF THE METASYMBOL DEFINITION
			AT WHICH TO START THE TRACE).
			)%
MACHOP	TTCALL =	#051,
	MOVE =	#200,
	SETZ =	#400,
	CAIGE =	#305,
	CAIG =	#307,
	MOVEI =	#201,
	BLT =	#251;
!***************************************************************************
ROUTINE OUTSTR(STR)= IF .STR EQL 0 THEN TTCALL(3,PLIT #064240000000)
				    ELSE TTCALL(3,STR,0,1);
ROUTINE ERROR(MSG)=
BEGIN
	OUTSTR(.MSG);OUTSTR(0);
	OUTZ(LST,CRLF);
%2461%	OUTZ(LST,PLIT'??Error ****');
	OUTZ(LST,CRLF);
	OUTZ(LST,.MSG);
	OUTZ(LST,CRLF);
	DO (TTCALL(1,C);C_CHR()) UNTIL .C EQL "." OR .C EQL -1;
	OUTSTR(0)
END;
!******************************************************************************************************************
ROUTINE DEC(N)=
BEGIN
	LOCAL A;
	A_((.N MOD 10) + "0")^29;
	N_.N / 10;
	IF .N NEQ 0 THEN DEC(.N);
	OUTSTR(A)
END;
!******************************************************************************************************************
ROUTINE PRODUCTIONS =
!BNFDEFINITION	     = METASYMBOL "=" BNFCOMPONENT [ COMMENT ] "." .
BEGIN
	LOCAL L;
	IF TRACE THEN X_0;
	UNTIL (CHR()) LSS 0 DO	!UNTIL EOF
	BEGIN
		!COMMENT	= ";" ASCIISTRING .
		IF .C EQL ";" THEN DO (CHR();IF .C LSS 0 THEN RETURN) UNTIL .C EQL "."
		ELSE
		BEGIN
			IF (L_TABLE (METANAME [0])) LSS 0 THEN RETURN;	!DEFINED SYMBOL
			IF TRACE THEN
				BEGIN
					DEC(X_.X+1);OUTSTR(PLIT' - ');
					OUTSTR(METANAME[.L]);OUTSTR(0);
					IF .X EQL .START THEN CHRSW_1;
				END;
			L_(METANAME[.L]+3)<0,18>_TYPE[0]_.TYPE[0]+1;
			UNTIL .C EQL "=" DO (CHR();IF .C LSS 0 THEN RETURN);
			SERIES (TYPE [.L], SUBP [.L], NUMBER [.L]);
			IF .C EQL #154 % Lower case L % 
%2461%			THEN (ERROR(PLIT'??OR list not enclosed in parens');
				RETURN);
			IF .C EQL ";" THEN DO CHR() UNTIL .C EQL "."
		END
	END
END;	! of PRODUCTIONS
!***************************************************************************
MACRO ALPHANUMERIC(X)=
BEGIN
	REGISTER R1,R2;
	MOVE	(R1,X);	!R1_.X
	SETZ	(R2,0);	!R2_FALSE
	CAIGE	(R1,"A");
	CAIG	(R1,"9");
	MOVEI	(R2,1);	!IF .R1 GEQ "A" OR .R1 LEQ "9" THEN R2_TRUE
	CAIG	(R1,"Z");
	CAIGE	(R1,"0");
	SETZ	(R2,0)	!IF .R1 GTR "Z" OR .R1 LSS "0" THEN R2_FALSE
END$;
!***************************************************************************
ROUTINE TABLE (TABNAME) =
!RETURNS INDEX INTO TABNAME, INSERTS IF NECESSARY
BEGIN
	OWN I: IVAL: J: JVAL: PNTR: PNTR1: TOP;
	STRUCTURE CHRTBL[I]=[I*4](@.CHRTBL + .I*4);
	MAP CHRTBL TABNAME[100];
	TOP_@TABNAME [0];
	TABNAME[.TOP+1]_TABNAME[.TOP+1]+1_TABNAME[.TOP+1]+2_TABNAME[.TOP+1]+3_0;
	PNTR_(TABNAME[.TOP+1]-1)<1,7>;
%(-----------------------------------------------------------------------------------------------------------------
	COPIES THE METASYMBOL OR TERMINAL CHARACTER STRING INTO THE
	ENTRY ABOVE TOP .
-----------------------------------------------------------------------------------------------------------------)%
	UNTIL .C EQL .(TABNAME[0]+1)  OR .C LSS 0 DO
	BEGIN
		REPLACEI(PNTR,.C);WRITE(LST,C_READ(SRC));
		IF .C EQL #12 THEN OUTZ(LST,PLIT '! ')
	END;
	IF TRACE THEN IF .CHRSW THEN (OUTSTR(PLIT'TABLE: ');OUTSTR(TABNAME[.TOP+1]);OUTSTR(0));
	IF .TABNAME[.TOP+1]<29,7> LSS " " THEN RETURN -1;
	IF .TOP EQL 0 THEN RETURN TABNAME[0]_.TOP+1;
	IVAL_INCR I FROM 1 TO .TOP DO
	BEGIN
		PNTR_(TABNAME[.TOP+1]-1)<1,7>;
		PNTR1_(TABNAME[.I]-1)<1,7>;
		JVAL_INCR J FROM 0 TO 16 DO
		BEGIN
			IF SCANI(PNTR) NEQ SCANI(PNTR1)
			THEN EXITLOOP .J
		END;
		IF .JVAL EQL -1 THEN EXITLOOP .I
	END;
	IF .IVAL EQL -1 THEN 
		BEGIN
			TABNAME[0]_.TOP+1;
			RETURN .TABNAME[0]
		END
	ELSE RETURN .IVAL       !-1 MEANS NO MATCH
END;
!**************************************************************************
ROUTINE CHR =
BEGIN
	MACRO FIS35=21,1$;
	DO BEGIN
		WRITE(LST,C_READ(SRC));
		IF .C EQL #12 THEN OUTZ(LST,PLIT '! ');
	IF (GETSW(SRC))<FIS35> THEN SET35(SRC);
		IF .C EQL #014 THEN
		BEGIN
			DO C_READ(SRC) UNTIL .C EQL "." OR .C LSS 0;	!SKIP MEMO NO. & PAGE
			C_READ(SRC);	!SKIP "." AT END OF LINE
			OUTZ(LST,CRLF)
		END
	END
	UNTIL	.C NEQ " " AND % SPACE %
		.C NEQ #12 AND % LINEFEED %
		.C NEQ #15 OR  % CARRIAGE RETURN %
		.C LSS 0 AND	% END-OF-FILE %
		NOT (GETSW(SRC))<FIS35>;	%CURRENT CHAR IS PART OF A SEQUENCE NUMBER%
	IF TRACE THEN IF .CHRSW THEN 
	BEGIN
		LOCAL T;
		OUTSTR(PLIT'CHR = ');
		IF .C EQL #154 %LOWER CASE L % THEN OUTSTR(PLIT'*OR*')
			ELSE (T_.C^29;OUTSTR(T));
		OUTSTR(0)
	END;
	RETURN .C	!RETURNS NEXT SIGNIFICANT CHARACTER
END;
!**************************************************************************
ROUTINE COPY (N,LT,LS,LN) =
BEGIN
	STRUCTURE VECTOR [I] = [I] (@.VECTOR + .I);
	MAP VECTOR LT: LS: LN;
	LOCAL T: I;
	!COPIES N TRIPLETS INTO DEFINITION TABLE
	INCR I FROM 0 TO .N DO
	BEGIN
		T_TYPE [0]_.TYPE [0]+1; !TOP POINTER
		TYPE [.T]_.LT [.I];
		SUBP [.T]_.LS [.I];
		NUMBER [.T]_.LN [.I]
	END;
	RETURN .T-.N  !RETURNS PLACE OF COPY
END;
!***************************************************************************
ROUTINE SERIES (TT,SS,NN) =
%(-----------------------------------------------------------------------------------------------------------------
ALL		      = BNFCOMPONENT *[ BNFCOMPONENT ]
;ALL OF THE BNFCOMPONENTS ARE REQUIRED .
-----------------------------------------------------------------------------------------------------------------)%
BEGIN
%[1]%	LOCAL VECTOR LTABLE[50],I;
	BIND VECTOR LTYPE[0] = LTABLE[0]<24,12>,
	     VECTOR LSUB[0]  = LTABLE[0]<12,12>,
	     VECTOR LN[0]    = LTABLE[0]<0,12>;
	IF TRACE THEN IF .CHRSW THEN
		 (OUTSTR(PLIT'SERIES: ');SERLVL_.SERLVL+1;DEC(.SERLVL);OUTSTR(PLIT' BEGIN');OUTSTR(0));
	I_-1;
	UNTIL (CHR() ) EQL "." OR .C EQL #154   % LOWER CASE L %
		OR .C EQL ")" OR .C EQL "]" OR .C EQL ";" DO
	BEGIN
		I_.I+1;
		IF .C LSS 0 THEN (OUTSTR(PLIT('EOF ENCOUNTERED IN SERIES ROUTINE'));OUTSTR(0);RETURN);
		DEFINITION (LTYPE [.I],LSUB [.I],LN [.I]);
		IF .C EQL "." THEN EXITLOOP
	END;
%[1]%	IF .I GTR 49 
%2461%	THEN (ERROR(PLIT'??LOCAL STORAGE OVERFLOW IN SERIES');
%[1]%		RETURN);
	IF .I EQL 0 THEN	!ELIMINATES ALL'S OF SIZE ONE
	BEGIN
		.TT_.LTYPE [0];
		.SS_.LSUB [0];
		.NN_.LN [0]
	END
	ELSE	!NORMAL ALL
	BEGIN
		.TT_ALL;
		.SS_COPY (.I,LTYPE[0],LSUB[0],LN[0]);
		.NN_.I
	END;
	IF TRACE THEN IF .CHRSW THEN
		(OUTSTR(PLIT'SERIES: ');DEC(.SERLVL);SERLVL_.SERLVL-1;OUTSTR(PLIT' END');OUTSTR(0));

END;
!****************************************************************************
ROUTINE DEFINITION (TT,SS,NN) =
BEGIN
	LOCAL	VECTOR LTABLE[25],I;
	BIND	VECTOR LTYPE[0] = LTABLE[0]<24,12>,
		VECTOR LSUB[0]	= LTABLE[0]<12,12>,
		VECTOR LN[0]	= LTABLE[0]<0,12>;
	IF TRACE THEN IF .CHRSW THEN
		 (OUTSTR(PLIT'DEFINITION: ');DEFLVL_.DEFLVL+1;DEC(.DEFLVL);OUTSTR(PLIT' BEGIN');OUTSTR(0));
%(-----------------------------------------------------------------------------------------------------------------
		ONE		     = "(" BNFCOMPONENT *[ "L" BNFCOMPONENT
		 ] ")" ;ONLY ONE OF THE BNFCOMPONENTS IS REQUIRED .
		OPTION		     = "[" BNFCOMPONENT "]"
		;USE OF THE BNFCOMPONENT IS OPTIONAL .
-----------------------------------------------------------------------------------------------------------------)%
	IF .C EQL "(" OR .C EQL "[" THEN
		BEGIN
			.TT_IF .C EQL "(" THEN ONE ELSE OPTION;
			I_-1;
			UNTIL .C EQL ")" OR .C EQL "]" DO
			BEGIN
				I_.I+1;
				SERIES (LTYPE [.I],LSUB [.I],LN [.I]);
			END;
%2461%			IF .I GTR 24 THEN (ERROR(PLIT'??LOCAL STORAGE OVERFLOW IN DEFINITION');
					RETURN);
			IF ..TT EQL ONE AND .I EQL 0 THEN
			BEGIN
				.TT_.LTYPE[0];
				.SS_.LSUB[0];
				.NN_.LN[0]
			END
			ELSE
			BEGIN
				.SS_COPY (.I,LTYPE[0],LSUB[0],LN[0]);
				.NN_.I
			END
		END
		ELSE
		BEGIN
			IF .C EQL "+"	!LIST = "+" BNFCOMPONENT ;BNFCOMPONENTS SEPERATED BY COMMAS
			OR .C EQL "*" THEN	!REPEAT = "*" BNFCOMPONENT ;BNFCOMPONENTS NOT SEPERATED BY COMMAS .
			BEGIN
				.TT_IF .C EQL "+" THEN LIST ELSE REPEAT;
				CHR();
				DEFINITION (LTYPE [0],LSUB [0],LN [0]);
				.SS_COPY (0,LTYPE[0],LSUB[0],LN[0]);
				.NN_1;
			END
			ELSE
				IF ALPHANUMERIC(C) THEN
				BEGIN
%(-----------------------------------------------------------------------------------------------------------------
					METASYMBOL = [ ALPHASTRING "-" ] ALPHASTRING ;AN ELEMENT OF
					THE SYNTAX DEFINED BY THE SYNTAX OR BY A LEXICAL PROCESS .
-----------------------------------------------------------------------------------------------------------------)%
					.TT_META;
					.SS_TABLE (METANAME[0]);
					.NN_1
				END
				ELSE
					IF .C EQL "%" THEN
					BEGIN
						CHR();	!SKIP LEADING %
						.TT_ACTION;
						.SS_TABLE(ACTIONNAME[0]);
						.NN_1
					END
					ELSE
						IF .C EQL """" THEN
						BEGIN
							CHR(); !SKIP LEADING """
							.TT_TERMINAL;
							.SS_TABLE(TERMNAME[0]);
							.NN_1;
						END
%2461%						ELSE ERROR(PLIT'??UNKNOWN BNF COMPONENT IN DEFINITION')
		END;
	IF TRACE THEN IF .CHRSW THEN
		(OUTSTR(PLIT'DEFINITION: ');DEC(.DEFLVL);DEFLVL_.DEFLVL-1;OUTSTR(PLIT' END');OUTSTR(0));
END;
!******************************************************************************************************************
ROUTINE DECIN =
BEGIN
	MACRO INCHWL (X) = TTCALL(4,X)$;
	REGISTER R,R2;
	R_R2_0;
	UNTIL (INCHWL(R);.R) EQL #015 OR .R EQL #012 DO R2_(.R2 * 10) + (.R - "0");
	START_.R2
END;
!******************************************************************************************************************
!********************* END OF DECLARATIONS ************************************************************************
!******************************************************************************************************************
INIT(); !LSTA=DSK:FILE.EXT,LST=DSK:FILE.LST_SRC=DSK:FILE.EXT
IF TRACE THEN
	BEGIN
		CHRSW_DEFLVL_SERLVL_0;
		OUTSTR(CRLF);OUTSTR(PLIT'START DETAILED TRACE AT META NO.(0=NONE)#');
		DECIN();OUTSTR(CRLF)
	END;
BEGIN
	REGISTER R;
	BNFTBL[0]_0;
	R<18,18>_BNFTBL[0];
	R<0,18>_BNFTBL[1];
	BLT(R,ACTIONNAME[100]);
%(-----------------------------------------------------------------------------------------------------------------
	THIS WILL SET TO ZERO THE CONTENTS OF BNFTBL  (TYPE,
	SUBP, NUMBER), C, METANAME, TERMNAME, AND ACTIONNAME WHICH ARE
	CONSECUTIVELY ALLOCATED IN THE ABOVE ORDER.
-----------------------------------------------------------------------------------------------------------------)%
	METANAME[0]+1_" ";TERMNAME[0]+1_"""";ACTIONNAME[0]+1_"%";
	!DEFINE THE BREAK CHARACTERS FOR EACH TYPE OF NAME
END;
DO C_READ(SRC) UNTIL .C EQL #14 ; % FORM FEED % !SKIP FIRST PAGE
DO C_READ(SRC) UNTIL .C EQL ".";	!IGNORE MEMO NO. & PAGE
DO (WRITE(LST,C_READ(SRC));IF .C EQL #12 THEN OUTZ(LST,PLIT '! '))
UNTIL .C EQL #14 % FORM FEED %;   !SKIP SECOND PAGE
DO C_READ(SRC) UNTIL .C EQL ".";	!IGNORE MEMO NO. & PAGE
PRODUCTIONS();
OUTSTR(PLIT'TABULAR OUTPUT BEGINS');OUTSTR(0);
OUTZ(LSTA,PLIT'?M?J!THE FOLLOWING TABLE WAS PRODUCED BY THE BLISS MODULE "BUILD.BLI"?M?J?M?J');
OUTZ(LST,PLIT'?M?J!THE FOLLOWING TABLES WERE PRODUCED BY THE BLISS MODULE "BUILD.BLI"?M?J?M?J');
OUTZ(LST,PLIT 'BIND?M?J');
OUTZ(LSTA,PLIT ' BIND?M?J');
OUTZ(LSTA,PLIT '	!');DECOUT(LSTA,4,.METANAME[0]);OUTZ(LSTA,PLIT ' METASYMBOLS?M?J');
C_0;
INCR I FROM 1 TO .METANAME[0] DO
BEGIN
	IF .C NEQ 0 THEN OUTZ(LSTA,PLIT',?M?J%')
		ELSE OUTZ(LSTA,PLIT'?M?J%');
	DECOUT(LSTA,4,.I);OUTZ(LSTA,PLIT '%	');
	IF (C_.(METANAME[.I]+3)<0,18>) EQL 0
		THEN (WRITE(LSTA,"!");OUTZ(LSTA,METANAME[.I]))
		ELSE
		BEGIN
			OUTZ(LSTA,METANAME[.I]);
			OUTZ(LSTA,PLIT '= ');DECOUT(LSTA,6,.C);
		END;
END;
OUTZ(LSTA,PLIT';?M?J?L');
TTCALL(4,C);	!THIS PICKS UP THE LF LEFT BY THE LAST TTCALL(4)
OUTSTR(PLIT'?M?JIS A PLIT OF META NUMBERS NEEDED??(Y OR N):');
TTCALL(4,C);
IF .C EQL "Y" THEN
BEGIN
	OUTZ(LSTA,PLIT'	BIND METANUMBER = PLIT(?M?J	');
	OUTZ(LSTA,METANAME[1]);
	INCR I FROM 2 TO .METANAME[0] DO
	BEGIN
		OUTZ(LSTA,PLIT',?M?J	');
		OUTZ(LSTA,METANAME[.I])
	END;
	OUTZ(LSTA,PLIT');?M?J?L');
END;
OUTZ(LST,PLIT'?M?JVECTOR	METANAME= IF NOT LEFTBUILD THEN 0 ELSE PLIT(?M?J');
OUTZ(LST,PLIT'%1%	PLIT');WRITE(LST,"'");
OUTZ(LST,METANAME[1]);
INCR I FROM 2 TO .METANAME[0] DO
BEGIN
	OUTZ(LST,PLIT''',');
	OUTZ(LST,CRLF);OUTZ(LST,PLIT'%');DECOUT(LST,2,.I);
	OUTZ(LST,PLIT'%	PLIT');WRITE(LST,"'");
	OUTZ(LST,METANAME[.I]);
END;
OUTZ(LST,PLIT''')-1;?M?J?M?J?L?0');
IF .ACTIONNAME[0] GTR 0 THEN
BEGIN
	OUTZ(LST,PLIT'EXTERNAL?M?J');
	OUTZ(LST,PLIT'%1%	');OUTZ(LST,ACTIONNAME[1]);
	INCR I FROM 2 TO .ACTIONNAME[0] DO
	BEGIN
		OUTZ(LST,PLIT',?M?J%');
		DECOUT(LST,2,.I);
		OUTZ(LST,PLIT'%	');OUTZ(LST,ACTIONNAME[.I]);
	END;
	OUTZ(LST,PLIT';?M?J')
END;	![2] START OF EDIT

OUTZ(LST,PLIT'BIND	VECTOR ACTIONCASE=PLIT(?M?J');
IF .ACTIONNAME[0] LEQ 0
THEN	OUTZ(LST,PLIT ASCIZ '0 ),?M?J')
ELSE
BEGIN
	OUTZ(LST,PLIT'%1%	');OUTZ(LST,ACTIONNAME[1]);
	INCR I FROM 2 TO .ACTIONNAME[0] DO
	BEGIN
		OUTZ(LST,PLIT',?M?J%');
		DECOUT(LST,2,.I);OUTZ(LST,PLIT'%	');
		OUTZ(LST,ACTIONNAME[.I]);
	END;
	OUTZ(LST,PLIT'?M?J	)-1,?M?J');
END;

OUTZ(LST,PLIT'	VECTOR	ACTIONNAME = IF NOT LEFTBUILD THEN 0 ELSE  PLIT(?M?J');
IF .ACTIONNAME[0] LEQ 0
THEN	OUTZ(LST,PLIT ASCIZ '0 );?M?J?L')
ELSE
BEGIN
	OUTZ(LST,PLIT'%1%	PLIT''');OUTZ(LST,ACTIONNAME[1]);
	INCR I FROM 2 TO .ACTIONNAME[0] DO
	BEGIN
		OUTZ(LST,PLIT''',?M?J%');DECOUT(LST,2,.I);
		OUTZ(LST,PLIT'%	PLIT''');OUTZ(LST,ACTIONNAME[.I]);
	END;
	OUTZ(LST,PLIT'''?M?J	)-1;?M?J?L');
END;
![2] End of edit
IF .TERMNAME[0] GTR 0 THEN
BEGIN
	OUTZ(LST,PLIT'?M?J?M?J');
	OUTZ(LST,PLIT'BIND VECTOR TERMNAME=PLIT(?M?J');
	OUTZ(LST,PLIT'%0%	PLIT''');OUTZ(LST,TERMNAME[1]);
	INCR I FROM 2 TO .TERMNAME[0] DO
	BEGIN
		OUTZ(LST,PLIT''',?M?J');
		OUTZ(LST,PLIT'%');DECOUT(LST,2,.I-1);
		OUTZ(LST,PLIT'%	PLIT''');OUTZ(LST,TERMNAME[.I]);
	END;
	OUTZ(LST,PLIT''');?M?J?L');
END;
OUTZ(LST,PLIT'?M?JMACRO	LLSIZE=');DECOUT(LST,6,.TYPE[0]);OUTZ(LST,PLIT'$;?M?J');
OUTZ(LST,PLIT '?M?JBIND	BNFTBL= PLIT(	!');DECOUT(LST,6,.TYPE[0]);OUTZ(LST,PLIT ' ENTRIES?M?J');
OUTZ(LST,PLIT '	!TYPE		SUB		NUMBER?M?J');
INCR I FROM 1 TO .TYPE[0] DO
BEGIN
	IF .TYPE[.I] EQL TERMINAL THEN
	BEGIN
		OUTZ(LST,PLIT'	TERMINAL^24+	');
		DECOUT(LST,4,.SUBP[.I]-1);
		OUTZ(LST,PLIT'^12+	');
		DECOUT(LST,4,.NUMBER[.I]);
		OUTZ(LST,PLIT',	!"');
		OUTZ(LST,TERMNAME[.SUBP[.I]]);
		OUTZ(LST,PLIT'"?M?J');
	END
	ELSE
		IF .TYPE[.I] EQL META THEN
		BEGIN
			C_.(METANAME[.SUBP[.I]]+3)<0,18>;
			IF .C EQL 0 THEN (OUTZ(LST,PLIT'	LEXEME^24+	');OUTZ(LST,METANAME[.SUBP[.I]]))
				ELSE (OUTZ(LST,PLIT '	META^24+	');
				DECOUT(LST,4,.C));
			OUTZ(LST,PLIT '^12+	');
			IF .C NEQ 0 THEN
			(DECOUT(LST,4,.SUBP[.I]);OUTZ(LST,PLIT ',	!');OUTZ(LST,METANAME[.SUBP[.I]]))
			ELSE (DECOUT(LST,4,.SUBP[.I]);OUTZ(LST,PLIT ',	!');DECOUT(LST,4,.I));
			OUTZ(LST,CRLF)
		END
		ELSE
		IF .TYPE[.I] EQL ACTION THEN
		BEGIN
			OUTZ(LST,PLIT'	ACTION^24+	');
			DECOUT(LST,3,.SUBP[.I]);
			OUTZ(LST,PLIT'^12+	0,	!');
			OUTZ(LST,ACTIONNAME[.SUBP[.I]]);OUTZ(LST,CRLF)
		END
		ELSE
		BEGIN
			IF .TYPE[.I] EQL ALL THEN OUTZ(LST,PLIT '	ALL^24+		')
			ELSE
				IF .TYPE[.I] EQL ONE THEN OUTZ(LST,PLIT '	ONE^24+		')
				ELSE
					IF .TYPE[.I] EQL OPTION THEN OUTZ(LST,PLIT '	OPTION^24+	')
					ELSE
						IF .TYPE[.I] EQL LIST THEN OUTZ(LST,PLIT '	LIST^24+	')
						ELSE
							IF .TYPE[.I] EQL REPEAT THEN
								OUTZ(LST,PLIT '	REPEAT^24+	')
							ELSE
								(OUTZ(LST,PLIT '	0,');EXITCOMPOUND [2]);
								%GO BACK TO THE INCR LOOP%
			DECOUT(LST,4,.SUBP[.I]);OUTZ(LST,PLIT '^12+	');
			DECOUT(LST,4,.NUMBER[.I]);
			OUTZ(LST,PLIT ',	!');DECOUT(LST,4,.I);OUTZ(LST,CRLF)
		END
END;
OUTZ(LST,PLIT '	0)-1;?M?J?L');
ENDALL();
END
ELUDOM