Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
format.bli
There are 12 other files named format.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/FJI/HPW/DBT/TFV/AlB/MEM
MODULE FORMAT(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN
GLOBAL BIND FORMAV = #10^24 + 0^18 + 2516; ! Version Date: 31-Jan-85
%(
***** 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.
***** Begin Version 10 *********
2257 AlB 3-Jan-84
Added checks for compatibility flagging.
Routine:
FORMATSYN
2455 MEM 30-Aug-84
Replace all occurrences of VAX with VMS.
2503 MEM 27-Nov-84
Correct entries for D, E, F, and G format in FMTWIDTH.
2513 AlB 7-Jan-84
The FORMAT statement requires that the format be allocated
by CORMAN to contiguous chunks of core. Unfortunately, the
portability flagger was putting out warnings, which caused
FATLERR to use CORMAN to save the error, which caused a later ICE.
The solution implemented here is to create the table FLAGERR
into which notations of warnings are placed during the syntactic
scan, and from which warnings are issued after the FORMAT is
entirely scanned.
Also corrected some unconventional code layout.
2515 AlB 29-Jan-85
Answer to QAR 853023: Prevent the FORMAT statement from flagging
the absence of commas after a slash. ANSI says that you don't need
commas 'before or after a slash edit descriptor'.
2516 AlB 31-Jan-85
Complete solution to the inclusion/exclusion of commas in FORMAT
statements. Well, almost complete: it doesn't complain if it
sees (2PI3) instead of (2P,I3); the solution to that seemed like
forcing the issue (and was a kludge). Note that ANSI is perfectly
happy with (kPFm.n) but doesn't like (kPIm). Tough.
Modules:
FORMAT
***** End V10 Development *****
***** 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
%2513% ANSIPLIT, ! 'Extension to Fortran-77: '
%2513% BOTHPLIT, ! 'Fortran-77 or VMS: '
%2257% CFLEXB, ! Put out Compatibility Flagger warning
CORMAN,
E0,
E2,
E3,
E61,
E70,
%2257% E224, ! "Extension to Fortran-77: Comma field separator is missing"
%2257% E229, ! "Extension to Fortran-77: Default widths with "x"
%2257% E234, ! "Extension to Fortran-77: Format edit descriptor "x"
%2257% E255, ! "Extension to Fortran-77: No decimals places with "x"
FATLEX,
FMTEND,
FMTPTR,
FORMAREA,
FORMPTR,
GSTFMTLEX,
IDOFSTATMENT,
ISN,
LEXICAL,
LEXL,
%2513% LEXLINE, ! ISN for lexeme
LSAVE,
NAME,
NEWENTRY,
NUMFATL,
POOL,
SAVSPACE,
%2513% VMSPLIT, ! 'Incompatabile with VMS: '
%2513% WARNERR;
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;
! 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 ; %
%2257% !*********************************************************
%2257% ! Definitions used by compatibility flagger
%2257% !*********************************************************
%2257% OWN
%2257% FLAGLEXL, ! Contains PLIT of descriptor for possible flagger error
%2257% FLAGBITS; ! Bits used to flag compatibility errors
%2513% ! Flagger warnings are saved in a table until syntax has been parsed.
%2513% ! Each table entry looks like:
%2513%
%2513% !-----------------------------------------------!
%2513% ! Prefix Code ! Error Number !
%2513% !-----------------------------------------------!
%2513% ! PLIT to any message prefix !
%2513% !-----------------------------------------------!
%2513% ! PLIT to the lexeme in question !
%2513% !-----------------------------------------------!
%2513% ! Source Line Number !
%2513% !-----------------------------------------------!
%2513% BIND
%2513% FLAGTSIZ=200; ! Number of words in the table (50 entries)
%2513% OWN
%2513% FLAGIX, ! Index into the table
%2513% FLAGPLIT, ! VMSPLIT, ANSIPLIT or BOTHPLIT
%2513% FLAGERR[FLAGTSIZ]; ! The table
%2513% ! Macro which puts entry into the table
%2513% MACRO
%2513% FLAGIT(ERR,PFX)=
%2513% BEGIN
%2513% IF .FLAGIX LSS FLAGTSIZ
%2513% THEN
%2513% BEGIN
%2513% FLAGERR[.FLAGIX] = ERR<0,0>;
%2513% FLAGERR[.FLAGIX+1] = PFX;
%2513% FLAGERR[.FLAGIX+2] = .FLAGLEXL;
%2513% FLAGERR[.FLAGIX+3] = .LEXLINE;
%2513% FLAGIX = .FLAGIX + 4;
%2513% END
%2513% END$;
%2257% MACRO ! Bits in FLAGBITS
%2257% ANSI234=0$, ! Non-zero if E234 to go out for ANSI
%2455% VMS234=1$, ! Non-zero if E234 to go out for VMS
%2455% VMSWIDTH=2$, ! Non-zero if lexeme which needs width
%2455% VMSNEEDW=3$, ! Non-zero if width not seen for VMS
%2257% ANSINEEDW=4$, ! Non-zero if width not seen for ANSI
%2257% BOTHNEEDD=5$, ! Non-zero if decimal places not seen
%2257% NOFLAGS=17$; ! Non-zero if no special checks
%2257% ! Table of format descriptors which need a width specifier
%2257% ! The left half is the lexeme.
%2455% ! The right half contains flags to be set in VMSBITS.
%2257% BIND DUMMYW = UPLIT(
%2257% FMTWIDTH NAMES
%2257% BCHAR^18 + 1^NOFLAGS,
%2503% DCHAR^18 + 1^VMSWIDTH + 1^VMSNEEDW + 1^ANSINEEDW + 1^BOTHNEEDD,
%2503% ECHAR^18 + 1^VMSWIDTH + 1^VMSNEEDW + 1^ANSINEEDW + 1^BOTHNEEDD,
%2503% FCHAR^18 + 1^VMSWIDTH + 1^VMSNEEDW + 1^ANSINEEDW + 1^BOTHNEEDD,
%2503% GCHAR^18 + 1^VMSWIDTH + 1^VMSNEEDW + 1^ANSINEEDW + 1^BOTHNEEDD,
%2455% ICHAR^18 + 1^VMSWIDTH + 1^VMSNEEDW + 1^ANSINEEDW,
%2455% LCHAR^18 + 1^VMSWIDTH + 1^VMSNEEDW + 1^ANSINEEDW,
%2455% OCHAR^18 + 1^VMSWIDTH + 1^VMSNEEDW + 1^ANSINEEDW + 1^ANSI234,
%2257% QCHAR^18 + 1^ANSI234,
%2455% RCHAR^18 + 1^VMS234,
%2257% SCHAR^18 + 1^NOFLAGS,
%2257% TCHAR^18 + 1^NOFLAGS,
%2257% XCHAR^18 + 1^NOFLAGS,
%2455% ZCHAR^18 + 1^VMSWIDTH + 1^VMSNEEDW + 1^ANSINEEDW + 1^ANSI234,
%2257% DOLLAR^18 + 1^ANSI234
%2257% );
%2257% BIND LASTWIDTH = 14; ! Highest index to FMTWIDTH
GLOBAL ROUTINE FORMATSYN(STKNODE)=
BEGIN
REGISTER NODE,SUBNODE,T2;
%2257% LOCAL VREGSAVE; ! To save value of VREG
%2515% OWN NOCOMM; ! 0 if slash, colon or left paren seen
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);
%2516% IF .LEXL NEQ .SUBNODE
%2516% THEN RETURN FATLEX(.FLEXNAME[.SUBNODE],.FLEXNAME[.LEXL],E0<0,0>)
%2516% ELSE
%2516% IF FLAGANSI
%2516% THEN
%2516% NOCOMM = (.LEXL NEQ SLASH AND
%2516% .LEXL NEQ LPAREN AND
%2516% .LEXL NEQ COLON);
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;
%2455% IF .FLAGBITS<VMSWIDTH,1>
%2257% THEN ! It is one of the descriptors which needs width
%2257% IF .LEXL EQL PERIOD
%2257% THEN ! Remember decimals seen
%2257% FLAGBITS<BOTHNEEDD,1>=0
%2257% ELSE
%2257% IF .LEXL EQL CONST
%2257% THEN ! Remember width seen
%2455% FLAGBITS<ANSINEEDW,1>=FLAGBITS<VMSNEEDW,1>=0
END;
!
!CASE 4-OR
!
BEGIN
IF .LSAVE EQL 0 THEN (LSAVE_-1; LEXL_LEXICAL(.GSTFMTLEX) );
%2257% IF .FLAGBITS EQL 0
%2257% THEN
%2257% IF FLAGEITHER ! Do it only if compatibility flagging
%2257% THEN
%2257% ! If lexeme is in FMTWIDTH table, set some flags
%2257% BEGIN
%2257% INCR I FROM 0 TO LASTWIDTH DO
%2257% IF .FMTWIDTH[.I]<LEFT> EQL .LEXL
%2257% THEN ! It is one of the entries in FMTWIDTH
%2257% BEGIN
%2257% FLAGBITS=.FMTWIDTH[.I]<RIGHT>;
%2257% FLAGLEXL=.FLEXNAME[.LEXL];
%2257% EXITLOOP
%2257% END
%2257% END;
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
%2257% FLAGLEXL=FLAGBITS=0; ! Clear all flagger indications
IF FORMATSYN(.SUBNODE) LSS 0 THEN RETURN -1;
%2257% IF .FLAGLEXL NEQ 0
%2257% THEN
%2257% BEGIN ! Compatibility flagger checks
%2257% VREGSAVE=.VREG; ! We don't want to clobber VREG
%2257% IF FLAGANSI
%2513% THEN IF .FLAGBITS<ANSI234,1>
%2513% THEN ! Unknown descriptor for ANSI
%2513% FLAGIT(E234,ANSIPLIT);
%2455% IF .FLAGBITS<VMS234,1>
%2455% THEN ! Unknown descriptor for VMS or ANSI
%2513% FLAGIT(E234,.FLAGPLIT)
%2257% ELSE
%2513% BEGIN
%2455% IF (.FLAGBITS<VMSNEEDW,1> AND FLAGVMS) OR
%2257% (.FLAGBITS<ANSINEEDW,1> AND FLAGANSI)
%2257% THEN ! Using default width
%2513% FLAGIT(E229,.FLAGPLIT);
%2257% IF .FLAGBITS<BOTHNEEDD,1>
%2257% THEN ! No decimal places
%2513% FLAGIT(E255,.FLAGPLIT);
%2257% END;
%2257% VREG=.VREGSAVE ! Original value
%2257% END; ! Compatibility flagger checks
IF .LSAVE EQL 0 THEN (LSAVE_-1; LEXL_LEXICAL(.GSTFMTLEX) );
%2515% IF .LEXL EQL RPAREN OR .LEXL EQL LINEND
%2515% THEN EXITLOOP;
%COMMAS ARE NOW ALWAYS OPTIONAL %
IF .LEXL EQL COMMA
THEN
BEGIN
%2515% LSAVE = 0;
%2515% NOCOMM = 0
%2515% END
%2516% ELSE IF FLAGANSI
%2516% THEN
%2516% BEGIN ! Worry about commas
%2516% ! Put out warning unless:
%2516% ! a) Lexeme was preceded by comma, or
%2516% ! b) The lexeme is a colon
%2516% IF .NOCOMM NEQ 0
%2516% THEN IF .LEXL NEQ COLON
%2516% THEN
%2515% BEGIN ! Put out error
%2257% VREGSAVE=.VREG;
%2513% FLAGIT(E224,0);
%2257% VREG=.VREGSAVE
%2513% END ! Put out error
%2515% END ! Worry about commas
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
%2513% ! Set up the prefix plit for flagging
%2513% IF FLAGEITHER
%2513% THEN
%2513% IF FLAGANSI
%2513% THEN
%2513% IF FLAGVMS
%2513% THEN FLAGPLIT = BOTHPLIT
%2513% ELSE FLAGPLIT = ANSIPLIT
%2513% ELSE FLAGPLIT = VMSPLIT;
%2513% FLAGIX = 0; ! No errors yet
IF FORMATSYN(1) LSS 0 THEN RETURN; ! Check syntax
%2513% ! If flagger errors were found, put them out here
%2513% NUM = 0; ! Index into FLAGERR
%2513% WHILE .NUM LSS .FLAGIX
%2513% DO
%2513% BEGIN
%2513% IF .FLAGERR[.NUM+1] EQL 0
%2513% THEN WARNERR(.FLAGERR[.NUM+2],.FLAGERR[.NUM+3],.FLAGERR[.NUM])
%2513% ELSE WARNERR(.FLAGERR[.NUM+2],.FLAGERR[.NUM+1],
%2513% .FLAGERR[.NUM+3],.FLAGERR[.NUM]);
%2513%
%2513% NUM = .NUM + 4;
%2513% END;
! 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