Google
 

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