Trailing-Edge
-
PDP-10 Archives
-
bb-4157j-bm_fortran20_v11_16mt9
-
fortran-compiler/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, 1987
!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 = #11^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