Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - 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