Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_Alpha_31-jul-86 - 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, 1986
!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 = #11^24 + 0^18 + 2533;	! Version Date: 10-May-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 *****

2533	AlB	10-May-85
	Do not put out the 'commas needed' compatibility flagger message
	when quotes are included within an alpha literal.  Note that
	when quotes are included (e.g. '~'''), the FORMATSYN routine sees
	this as two literals.

***** 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
%2533%	LOCAL	PREVLEXL;	! The previous lexeme
%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
%2533%		PREVLEXL = .LEXL;	! Remember what we have

		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
%2533%			! c) The lexeme is an alpha lit following an alpha lit

%2516%			IF .NOCOMM NEQ 0
%2516%			THEN IF .LEXL NEQ COLON
%2533%			THEN IF .LEXL NEQ LITSTRING OR .PREVLEXL NEQ LITSTRING
%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