Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/format.bli
There are 12 other files named format.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: T.E. OSTEN/FJI/HPW/DBT/TFV
MODULE FORMAT(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN
GLOBAL BIND FORMAV = 6^24 + 0^18 + 31; ! Version Date: 22-Jul-81
%(
***** Begin Revision History *****
29 ----- ----- COMMENT OUT CODE WHICH SELECTIVELY ALLOWS OPTIONAL COMMAS
AND MAKE COMMAS ALWAYS OPTIONAL
30 ----- ----- ADD THE R FORMAT SPECIFICATION
***** Begin Version 6 *****
31 760 TFV 1-Oct-79 ------
Add :, BN, BZ, Q, S, SP, SS, TL, TR, Z format descriptors
***** End Revision History *****
)%
REQUIRE FMTLEX.BLI;
STRUCTURE STRING[I]=@(.STRING+.I);
STRUCTURE VECTX[I]=[I] .VECTX+.I;
BIND VECTOR FLEX=PLIT(
FLEXNAME GLOBALLY NAMES
%0% PLIT'ILLEGAL CHARACTER',
%1% PLIT'"$"',
%2% PLIT'LITSTRING',
%3% PLIT'"("',
%4% PLIT'")"',
%5% PLIT'END OF STATEMENT?0',
%6% PLIT'"+"',
%7% PLIT'","',
%8% PLIT'"-"',
%9% PLIT'"."',
%10% PLIT'"/"',
%11% PLIT'":"', %[760]%
%12% PLIT'CONSTANT',
%13% PLIT'"A"',
%14% PLIT'"B"', %[760]%
%15% PLIT'"D"',
%16% PLIT'"E"',
%17% PLIT'"F"',
%18% PLIT'"G"',
%19% PLIT'"I"',
%20% PLIT'"L"',
%21% PLIT'"N"', %[760]%
%22% PLIT'"O"',
%23% PLIT'"P"',
%24% PLIT'"Q"', %[760]%
%25% PLIT'"R"',
%26% PLIT'"S"', %[760]%
%27% PLIT'"T"',
%28% PLIT'"X"',
%29% PLIT'"Z"'); %[760]%
BIND LEFTBUILD = 0;
REQUIRE FRMBNF.BLI;
REQUIRE LOOKFM.BLI;
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
SWITCHES LIST;
! BIND VECTX TYPE[0]= BNFTBL<24,12>,
! VECTX SUBP[0]= BNFTBL<12,12>,
! VECTX NUMBER[0]= BNFTBL<0,12>,
! VECTX LEXNUM[0]= BNFTBL<12,6>,
! VECTX OPNUM[0]= BNFTBL<18,6>;
STRUCTURE TYPSTR[I] = (.TYPSTR+.I)<24,12>;
STRUCTURE SUBSTR[I] = (.SUBSTR+.I)<12,12>;
STRUCTURE NUMSTR[I] = (.NUMSTR+.I)<0,12>;
BIND TYPSTR TYPE = BNFTBL,
SUBSTR SUBP = BNFTBL,
NUMSTR NUMBER = BNFTBL;
FORWARD
FORMATSYN,
ORERROR;
EXTERNAL LSAVE,LEXL,ISN,LEXICAL,FATLEX,WARNLEX,ENTRY,NAME;
EXTERNAL GSTFMTLEX;
% OWN NOCOMM; %
EXTERNAL E0,E2,E3,E70,E61;
% THE FOLLOWING TABLE IS ACCESSED BY LEXICAL( .GSTFMTLEX )
IN ORDER TO RETURN THE PROPER LEXEME CODE %
% THE CODES WHICH ACCESS THE NON-LETTER LEXEMES ARE THE STANDARD
LEXICAL CHARACTER CODES %
BIND DUMDUM = PLIT (
FMTLET GLOBALLY NAMES FMTLEX GLOBALLY NAMES
0, % ADJUSTMENT%
% "A"= #101 % ACHAR ^18+ %ILL % ILLCHAR ,
% "B"= #102 % BCHAR ^18+ %TAB % ILLCHAR , %[760]%
% "C"= #103 % ILLCHAR ^18+ %LT % ILLCHAR ,
% "D"= #104 % DCHAR ^18+ %BLANK % ILLCHAR ,
% "E"= #105 % ECHAR ^18+ %SPEC % ILLCHAR ,
% "F"= #106 % FCHAR ^18+ %DIGIT % CONST ,
% "G"= #107 % GCHAR ^18+ %UPPER % ILLCHAR ,
% "H"= #110 % ILLCHAR ^18+ %LOWER % ILLCHAR ,
% "I"= #111 % ICHAR ^18+ %FOS % LINEND ,
% "J"= #112 % ILLCHAR ^18+ %EOB % ILLCHAR ,
% "K"= #113 % ILLCHAR ^18+ %REMARK % ILLCHAR ,
% "L"= #114 % LCHAR ^18+ %ANDSGN % ILLCHAR ,
% "M"= #115 % ILLCHAR ^18+ %LPAREN % LPAREN ,
% "N"= #116 % NCHAR ^18+ %RPAREN % RPAREN , %[760]%
% "O"= #117 % OCHAR ^18+ %COLON % COLON , %[760]%
% "P"= #120 % PCHAR ^18+ %COMMA % COMMA ,
% "Q"= #121 % QCHAR ^18+ %DOLLAR % DOLLAR , %[760]%
% "R"= #122 % RCHAR ^18+ %MINUS % MINUS ,
% "S"= #123 % SCHAR ^18+ %SLASH % SLASH , %[760]%
% "T"= #124 % TCHAR ^18+ %PLUS % PLUS ,
% "U"= #125 % ILLCHAR ^18+ %ASTERISK% ILLCHAR ,
% "V"= #126 % ILLCHAR ^18+ %EQUAL % ILLCHAR ,
% "W"= #127 % ILLCHAR ^18+ %LTSGN % ILLCHAR ,
% "X"= #130 % XCHAR ^18+ %GTSGN % ILLCHAR ,
% "Y"= #131 % ILLCHAR ^18+ %NEQSGN % ILLCHAR ,
% "Z"= #132 % ZCHAR ^18+ %DOT % PERIOD , %[760]%
%SEMICOL% ILLCHAR ,
%LITSGN % LITSTRING ,
%OCTSGN % ILLCHAR ,
%COMNTSGN% ILLCHAR ,
%DEBUGSGN% ILLCHAR ,
%UPAROW % ILLCHAR
);
% THE FOLLOWING BIND SPECIFIES THE LEXEMES FOR WHICH FOLLOWING COMMAS ARE
OPTIONAL %
% BIND OKNCM = 1^XCHAR + 1^LITSTRING + 1^SLASH ; %
GLOBAL ROUTINE FORMATSYN (STKNODE) =
BEGIN
EXTERNAL LEXICAL,GSTFMTLEX;
REGISTER NODE,SUBNODE,T2;
NODE_.STKNODE;
SUBNODE_.SUBP[.NODE];
CASE .TYPE[.NODE] OF SET
!
!CASE 0
!
RETURN -1;
!
!CASE 1-LEXEME
!
BEGIN
IF .LSAVE NEQ 0 THEN LSAVE_0 ELSE LEXL_LEXICAL(.GSTFMTLEX);
IF .LEXL NEQ .SUBNODE THEN
BEGIN
RETURN FATLEX ( .FLEXNAME[.SUBNODE],.FLEXNAME[.LEXL],E0<0,0>)
END
% ELSE NOCOMM _ OKNCM AND 1^.LEXL %
END;
!
!CASE 2-META
!
IF FORMATSYN(.SUBNODE) LSS 0 THEN RETURN -1;
!
!CASE 3-AND
!
INCR I FROM .SUBNODE TO .SUBNODE+.NUMBER[.NODE] DO
BEGIN
IF FORMATSYN(.I) LSS 0 THEN RETURN -1
END;
!
!CASE 4-OR
!
BEGIN
IF .LSAVE EQL 0 THEN (LSAVE_-1; LEXL_LEXICAL(.GSTFMTLEX) );
T2 _1^.LEXL;
VREG_INCR I FROM .SUBNODE TO .SUBNODE+.NUMBER[.NODE] DO
IF (.LOOKAHEAD[.I] AND .T2) NEQ 0 THEN EXITLOOP .I;
IF .VREG LSS 0 THEN RETURN ORERROR(.NODE);
IF FORMATSYN(.VREG) LSS 0 THEN RETURN -1
END;
!
!CASE 5-OPTION
!
BEGIN
IF .LSAVE EQL 0 THEN (LSAVE_-1; LEXL_LEXICAL(.GSTFMTLEX) );
T2 _1^.LEXL;
VREG_INCR I FROM .SUBNODE TO .SUBNODE+.NUMBER[.NODE] DO
IF (.LOOKAHEAD[.I] AND .T2) NEQ 0 THEN EXITLOOP .I;
IF .VREG LSS 0 THEN RETURN;
IF FORMATSYN(.VREG) LSS 0 THEN RETURN -1
END;
!
!CASE 6-LIST
!
WHILE 1 DO
BEGIN
IF FORMATSYN(.SUBNODE) LSS 0 THEN RETURN -1;
IF .LSAVE EQL 0 THEN (LSAVE_-1; LEXL_LEXICAL(.GSTFMTLEX) );
%COMMAS ARE NOW ALWAYS OPTIONAL %
IF .LEXL EQL COMMA
THEN
BEGIN
LSAVE _ 0;
% NOCOMM _ 0 %
END
ELSE
BEGIN
% IF .NOCOMM EQL 0 THEN EXITLOOP
ELSE
BEGIN
NOCOMM _ 0; %
IF .LEXL EQL RPAREN OR .LEXL EQL LINEND
THEN EXITLOOP
% END %
END
END;
!
!CASE 7-REPEAT
!
DO
BEGIN
IF FORMATSYN(.SUBNODE) LSS 0 THEN RETURN -1;
IF .LSAVE EQL 0 THEN (LSAVE_-1; LEXL_LEXICAL(.GSTFMTLEX) );
T2 _1^.LEXL;
END
WHILE (.T2 AND .LOOKAHEAD[.NODE]) NEQ 0
TES;
.VREG
END;
ROUTINE ORERROR(NODE) =
%(-----------------------------------------------------------------------------------------------------------------
NONE OF A SET OF "OR" CHOICES WERE FOUND
OUTPUT SUITABLE MESSAGE
-----------------------------------------------------------------------------------------------------------------)%
BEGIN
LOCAL L,N;EXTERNAL ENTRY[10];
N_0;L_.LOOKAHEAD[.NODE];
UNTIL .L DO (L_.L^(-1);N_.N+1);
FATLEX(.FLEXNAME[.N],.FLEXNAME[.LEXL],E2<0,0>);
UNTIL (N_.N+1;L_.L^(-1)) EQL 0 DO
BEGIN
EXTERNAL NUMFATL;
UNTIL .L DO (L_.L^(-1);N_.N+1);
FATLEX(.FLEXNAME[.N],E3<0,0>);
%ADJUST TOTAL NUMBER OF ERRORS%
NUMFATL_.NUMFATL-1
END;
RETURN -1
END;
GLOBAL ROUTINE FORMSTA=
BEGIN
EXTERNAL FORMPTR,IDOFSTATMENT,NEWENTRY,CORMAN,POOL,FORMAREA;
LOCAL NUM,FORPTR,LASTTRUESRC;
REGISTER BASE T1;
MAP BASE FORMPTR;
EXTERNAL SAVSPACE;
GLOBAL FMTPTR,FMTEND;
% FORMATS ARE PROCESSED AS FOLLOWS:
1. MAKE AN INITIAL FORMAT AREA ENTRY FO 10 WORDS
2. FMTPTR IS A BYTE POINTER TO THE FIRST CHARACTER OF THE AREA
3. FMTEND CONTAINS THE ADDRESS OF THE LAST WORD OF THE
AREA +1.
4. THE LEXICAL ANALYZER, WHICH IS CALLED BY FORMATSYN TO
PARSE THE FORMAT WILL DEPOSIT EACH SIGNIFICANT CHARACTER
INTO THE FORMAT AREA. WHEN IT REACHES THE END IT WILL
REQUEST SOME ADDITIONAL SPACE AND CONTINUE.
5. IF WE SUCCESSFULLY MAKE IT BACK THE SIZE OF THE FORMAT AREA
IS COMPUTED ( FMTPTR POINTS TO THE LAST WORD AND FORPTR TO
THE FIRST ) AND ANY UNUSED AREA IS RETURNED TO FREE CORE.
NOT E THAT THE AREA IS ALWAYS INCREMENTED IN 10 WORD
PIECES BECAUSE CORMAN TAKES THESE FROM FREE CORE AND
THUS THEY WILL BE CONTIGIOUS.
6. BUILD THE NODE , UPDATE A FEW POINTERS AND THATS IT
%
% GET A FORMAT AREA %
NAME<LEFT> _ 10;
FORPTR _ CORMAN();
FMTPTR _ (@FORPTR)<36,7>; ! FIRST BYTE
FMTEND _ .FORPTR<RIGHT> + 10; ! THE END
IF FORMATSYN(1) LSS 0 THEN RETURN; !CHECK SYNTAX
!SEMANTIC ANALYSIS BEGINS
% CALCULATE THE SIZE %
NUM _ .FMTPTR<RIGHT> - .FORPTR + 1;
FORMAREA _ .FORMAREA + .NUM<RIGHT>; !ACCUMULATE TOTAL WORDS OCCUPIED BY FORMAT STRINGS
!FOR LATER ALLOCATION USE
% SAVE LASTSRC SO THIS NODE CAN BE REMOVED FROM THE TREE %
LASTTRUESRC _ .LASTSRC;
% BUILD THE NODE %
NAME _ IDOFSTATMENT _ FORMDATA;
NAME<RIGHT>_SORTAB;
T1 _ NEWENTRY();
%NOW REMOVE IT FROM THE SORCE TREES%
IF .LASTTRUESRC EQL 0 THEN LASTSRC _ .SORCPTR<LEFT> ELSE LASTSRC _ .LASTTRUESRC;
!
!MAKE SURE STATEMENT IS LABELLED
!
IF .T1[SRCLBL] EQL 0 THEN FATLEX(E70<0,0>); !NOT LABELLED
T1[FORSIZ]_.NUM;
T1[FORSTRING] _ .FORPTR;
IF .FORMPTR EQL 0 THEN FORMPTR<LEFT>_FORMPTR<RIGHT>_.T1
ELSE (FORMPTR[FMTLINK]_.T1; FORMPTR<RIGHT>_.T1);
% RETURN ANYTHING LEFT %
IF ( NUM _ 9 - ( .NUM MOD 10 )) LSS 9
THEN SAVSPACE ( .NUM, .FMTPTR<RIGHT>+1 );
.VREG
END;
GLOBAL ROUTINE FMTOVER ( CHAR ) =
BEGIN
% THIS ROUTINE IS CALLED IF THE LEXICAL ANALYZER NEEDS MORE SPACE
TO STORE THE FORMAT IN %
EXTERNAL FMTPTR,FMTEND,NAME,CORMAN;
NAME<LEFT> _ 10;
IF CORMAN() NEQ .FMTEND
THEN FATLEX ( PLIT'FORMSTA?0',E61<0,0> ); !BIG TROUBLE
FMTEND _ .FMTEND + 10;
REPLACEN(FMTPTR, .CHAR )
END;
END ELUDOM