Trailing-Edge
-
PDP-10 Archives
-
BB-4157F-BM_1983
-
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) DIGITAL EQUIPMENT CORPORATION 1972, 1983
!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 = 7^24 + 0^18 + 1530; ! Version Date: 4-May-82
%(
***** 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
***** Begin Version 7 *****
1530 TFV 4-May-82
Fix CORMAN calls for FORMAT literals. Use FLSIZ as the size of
the nodes.
***** End Revision History *****
)%
BIND LEFTBUILD = 0; ! Needed for FRMBNF.BLI
REQUIRE FMTLEX.BLI;
REQUIRE FRMBNF.BLI;
REQUIRE LOOKFM.BLI;
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
SWITCHES LIST;
FORWARD
FORMATSYN(1),
ORERROR(1),
FORMSTA,
FMTOVER(1);
EXTERNAL
CORMAN,
E0,
E2,
E3,
E61,
E70,
FATLEX,
FMTEND,
FMTPTR,
FORMAREA,
FORMPTR,
GSTFMTLEX,
IDOFSTATMENT,
ISN,
LEXICAL,
LEXL,
LSAVE,
NAME,
NEWENTRY,
NUMFATL,
POOL,
SAVSPACE,
WARNLEX;
STRUCTURE STRING[I]=@(.STRING+.I);
STRUCTURE VECTX[I]=[I] .VECTX+.I;
! Table of FORMAT lexemes, must agree with FMTLEX.BLI
BIND VECTOR FLEX = UPLIT(
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 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;
! OWN NOCOMM;
! 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.
!
! The entries are of the form:
! letlexl,,lexl
!
! where letlex is the lexeme for a character and lexl is a
! non-letter lexeme (which must agree with the definitions in
! LEXAID.BLI.
BIND DUMDUM = UPLIT(
FMTLET GLOBALLY NAMES
FMTLEX GLOBALLY NAMES
% ADJUSTMENT% 0,
% "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
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; ! of FORMATSYN
ROUTINE ORERROR(NODE)=
BEGIN
!***************************************************************
! None of a set of "or" choices were found. Output suitable
! message.
!***************************************************************
LOCAL L,N;
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
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; ! of ORERROR
GLOBAL ROUTINE FORMSTA=
BEGIN
!***************************************************************
! Formats are processed as follows:
!
! 1. Make an initial format area entry of FLSIZ words.
! 2. FMTPTR is a byte pointer to the first character of
! the area.
! 3. FMTEND contains the address of the word after the
! last word of the area.
! 4. The lexical analyzer, is called by FORMATSYN to parse
! the format. It deposits each significant character
! into the format area. If it reaches the end of the
! area, it will request some additional space and
! continue.
! 5. If we successfully make it back the actual size of
! the format area is computed (FMTPTR points to the
! last word and FORPTR to the first). Any unused words
! are returned to free memory. The area is always
! allocated in FLSIZ word pieces so that CORMAN
! allocates them at JOBFF so that they will be
! contigious.
! 6. Build the node and update a few pointers.
!***************************************************************
REGISTER
BASE FMTNODE,
NUM,
FORPTR,
LASTTRUESRC;
MAP BASE FORMPTR;
! Get an initial FORMAT area
%1530% NAME<LEFT> = FLSIZ;
FORPTR = CORMAN();
FMTPTR = (@FORPTR)<36,7>; ! Start at first byte in block
%1530% FMTEND = .FORPTR<RIGHT> + FLSIZ; ! Word after the block
IF FORMATSYN(1) LSS 0 THEN RETURN; ! Check syntax
! Semantic analysis begins
! Calculate the size - FMTPTR points to last byte in FORMAT
NUM = .FMTPTR<RIGHT> - .FORPTR + 1;
FORMAREA = .FORMAREA + .NUM<RIGHT>; ! Accumulate total words used
! by format strings for later
! allocation of FORMAT areas
! Save LASTSRC so this node can be removed from the tree
LASTTRUESRC = .LASTSRC;
! Build the node
NAME = IDOFSTATMENT = FORMDATA;
NAME<RIGHT> = SORTAB;
FMTNODE = NEWENTRY();
! Now remove the node from the source trees
IF .LASTTRUESRC EQL 0
THEN LASTSRC = .SORCPTR<LEFT>
ELSE LASTSRC = .LASTTRUESRC;
! Make sure statement is labelled
IF .FMTNODE[SRCLBL] EQL 0 THEN FATLEX(E70<0,0>); ! Not labelled
FMTNODE[FORSIZ] = .NUM;
FMTNODE[FORSTRING] = .FORPTR;
! Link in the node
IF .FORMPTR EQL 0
THEN FORMPTR<LEFT> = FORMPTR<RIGHT> = .FMTNODE
ELSE
BEGIN
FORMPTR[FMTLINK] = .FMTNODE;
FORMPTR<RIGHT> = .FMTNODE;
END;
! Return unused words
%1530% NUM = FLSIZ - (.NUM MOD FLSIZ);
%1530% IF .NUM LSS FLSIZ THEN SAVSPACE(.NUM - 1, .FMTPTR<RIGHT> + 1);
.VREG
END; ! of FORMSTA
GLOBAL ROUTINE FMTOVER(CHAR)=
BEGIN
!***************************************************************
! This routine is called by the lexical analyzer if it needs
! more space for the FORMAT. Space is allocated in FLSIZ chunks
! so that CORMAN will allocate it at JOBFF and make it
! contiguous.
!***************************************************************
%1530% NAME<LEFT> = FLSIZ;
! Check for non-contiguous allocation - big trouble
IF CORMAN() NEQ .FMTEND
THEN FATLEX( PLIT'FORMSTA?0', E61<0,0>);
! Update the pointer to the word after the FORMAT block
%1530% FMTEND = .FMTEND + FLSIZ;
REPLACEN(FMTPTR, .CHAR)
END; ! of FMTOVER
END
ELUDOM