!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,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: S. MURPHY
MODULE DATA(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4)=
BEGIN
	EXTERNAL CGERR;
	FORWARD ALCDATA(0),ADJDATPTR(0),GETDADDR(0),CNSTEVAL(1),GETDCNST(0);
	EXTERNAL OUTDATA;

SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;

GLOBAL BIND DATAV = 4^24 + 1^18 + 44;	!VERSION DATE: 10-JUL-75
%(REVISION HISTORY
38	-----	-----	COMMENT OUT CALLS TO "ZDMPBLK" IN "DATPROC"
39	-----	-----	FIX ERROR CALLS
40	-----	-----	GIVE WARNING WHEN THERE ARE FEWER VARS THAN CONSTS
			IN A GIVEN DATA STMNT; MAKE THE WARNING WHEN THERE
			ARE TOO FEW CONSTS COME OUT ONLY ONCE;
			REMOVE THE CALLS TO ZDMPBLK IN "DATPROC" WHICH WERE
			PREVIOUSLY COMMENTED OUT
41	-----	-----	GIVE AN ERROR MESSAGE WHEN ATTEMPT TO WRITE BEYOND
			THE END OF AN ARRAY IN A DATA STATEMENT
42	-----	-----	SHOULD USE "EXTSIGN" WHEN PICKING UP TARGADDR
			FIELD FOR AN ARRAY REF
43	16361	273	SHOULD USE "EXTSIGN" WHEN PICKING UP CONSTANT IN
			CNSTEVAL
44	314	QAR	SHOULD USE "EXTSIGN" FOR IMPLIED DO LOOPS IN DATA
)%



%(***************************************************************************
	THIS MODULE PERFORMS ALLOCATION FOR DATA STATEMENTS.
	THE OBJECTIVE OF DATA STATEMENTS IS TO GIVE THE LOADER INFORMATION
	ABOUT STORAGE AREAS IN A FORTRAN PROGRAM WHICH ARE TO BE
	PREINITIALIZED BEFORE EXECUTION OF THE PROGRAM. THE LOADER MUST
	BE TOLD EACH LOCATION TO BE INITIALIZED AND THE CORRESPONDING
	CONSTANT TO BE  STORED THERE.

	A DATA STMNT HAS ASSOCIATED WITH IT 2 KINDS OF LISTS:
		1. DATA ITEM LISTS- THESE DESCRIBE LOCATIONS INTO WHICH THE
			CONSTANTS ARE TO BE INITIALIZED. A DATA ITEM LIST LOOKS
			LIKE AN IOLIST. ELEMENTS ON A DATA-ITEM LIST MAY BE:
				A. DO STMNT
				B. CONTINUE STMNT WITH A LABEL THAT TERMINATES THE DO
				C. DATA-CALL:  WHICH MAY HAVE AS AN ARG EITHER
				   A SCALAR OR AN ARRAYREF. IF ARG IS AN ARRAYREF
				  THEN ALL SUBSCRIPTS MUST BE OF THE FORM
				   C1*I+C2 WHERE I IS A LOOP INDEX AND C1 AND C2 ARE
				   INTEGER CONSTANTS
				D. SLIST CALL

		2. DATA CONSTANT LISTS- THESE INDICATE THE INITIAL VALS TO
			BE STORED. A DATA CONSTANT LIST IS A LINKED LIST OF ELEMENTS
			OF THE FORM:
				----------------------------------------
				! 		!   CLINK		!
				-----------------------------------------
				! DATARPT	!  DCONST		!
				-----------------------------------------

			WHERE CLINK POINTS TO THE NEXT ELEMENT ON THE LIST (OR IS 0
			FOR THE LAST ELEMENT),
			DCONST POINTS TO  A CONSTANT TABLE ENTRY (MAY BE FOR
			A LITERAL OR FOR ANY OTHER CONSTANT)
			AND DATARPT IS  A CT OF THE NUMBER OF TIMES THE CONSTANT INDICATED
			IS TO BE STORED.

***************************************************************************)%



OWN BASE DATAITMPTR;		!POINTS TO THE ELEMENT IN THE DATA-ITEM LIST WHICH
				! IS CURRENTLY BEING FILLED IN
OWN BASE DATACNSTPTR;		!POINTS TO THE ELEMENT ON THE DATA CONSTANT LIST
				! WHICH IS CURRENTLY BEING USED
OWN CNSTCT;			!NUMBER OF TIMES THAT THE CONSTANT INDICATED BY
				! "DATACNSTPTR" HAS BEEN OUTPUT SO FAR (NOTE THAT FOR
				! A MULTI-WORD CONSTANT, THIS COUNT IS ONLY INCREMENTED AFTER
				! ALL WORDS OF THE CONSTANT HAVE BEEN OUTPUT)
OWN CNSTWDCT;			!NUMBER OF WORDS OF THE INDICATED CONSTANT THAT HAVE BEEN
				! OUTPUTED SO FAR (NOTE THAT WHEN THE SAME CONSTANT IS
				! OUTPUT MORE THAN ONCE, THIS COUNT IS SET NACK TO 0
				! EACH TIME WE GO BACK TO THE FIRST WD OF THE CONSTANT)
OWN DCON1,DCON2;		!CONSTANT WDS TO BE OUTPUT NEXT; IF THE SYMBOL
				! BEING INITIALIZED IS DOUBLE PREC OR COMPLEX
				! DCON1 IS HIGH ORDER PART, DCON2 LOW ORDER PART; OTHERWISE
				! (FOR INTEGER AND REAL) DCON2 IS NOT USED

OWN XTRAVARS;		!FLAG INDICATING THAT HAVE
			!TOO FEW CONSTANTS IN THE STMNT BEING PROCESSED

GLOBAL ROUTINE DATPROC=
%(***************************************************************************
	ROUTINE TO WALK THRU ALL DATA STATEMENTS PERFORMING ALLOCATION FOR THEM
	THE GLOBAL "DATASPTR" CONTAINS A PTR TO THE FIRST DATA STMNT IN ITS LEFT HALF.
***************************************************************************)%
BEGIN
	EXTERNAL CSTMNT,DATASPTR;
	MAP BASE CSTMNT;


	CSTMNT_.DATASPTR<LEFT>;

	UNTIL .CSTMNT EQL 0
	DO
	BEGIN
		ISN_.CSTMNT[SRCISN];
		ALCDATA();
		CSTMNT_.CSTMNT[CLINK];
	END;

END;






GLOBAL ROUTINE ALCDATA=
%(***************************************************************************
	ROUTINE TO PERFORM ALLOCATION FOR DATA STATEMENTS.
	CALLED WITH CSTMNT POINTING TO A STATEMENT OF THE FORM:

		----------------------------------------
		!  DATITEMS	!  CLINK		!
		------------------------------------------
		!  DATCOUNT	!  OPERATOR		!
		-----------------------------------------
		!  ISN		!   DATCONS		!
		------------------------------------------

	WHERE:
		DATCONS - POINTS TO  A DATA-CONSTANT-LIST
		DATITEMS - POINTS TO A DATA-ITEM-LIST
***************************************************************************)%
BEGIN
	EXTERNAL CSTMNT;
	MAP BASE CSTMNT;
	EXTERNAL ISN,WARNERR,E57;
	OWN BASE SYM;		!PTR TO THE SYMBOL TABLE ENTRY FOR THE VAR BEING INITIALIZED
	OWN DADDR;		!ADDRESS TO BE INITIALIZED (ADDRESS OF 1ST WD
				! IF THE VAR IS DOUBLE-PREC)
	DATAITMPTR_.CSTMNT[DATITEMS];
	ADJDATPTR();				!GET PTR TO THE FIRST ELEMENT ON THE
						! DATA ITEM LIST WHICH IS EITHER AN SLIST
						! OR  A DATACALL (AND SET UP VALS OF INDICES
						! FOR IMPLICIT DO STMNT)
	DATACNSTPTR_.CSTMNT[DATCONS];	!1ST ENTRY ON DATA CONSTANT LIST
	CNSTCT_0;				!NUMBER OF TIMES THIS CONSTANT HAS BEEN
						! OUTPUT SO FAR
	CNSTWDCT_0;				!NUMBER OF WORDS OF THIS CONSTANT THAT
						! HAVE BEEN OUTPUT SO FAR

	XTRAVARS_FALSE;	!FLAG INDICATING THAT HAVE RUN OUT OF CONSTS BEFORE
			! FILLING ALL VARS(USED TO PREVENT REPEATING ERROR MESSAGE)

	%(***WALK THRU THE DATA ITEM LIST OUTPUTING A CONSTANT FOR EACH LOCATION***)%
	UNTIL .DATAITMPTR EQL 0
	DO
	BEGIN
		%(***IF THIS DATA-ITEM IS AN SLIST (IE WANT TO FILL A WHOLE ARRAY)***)%
		IF .DATAITMPTR[OPR1] EQL SLISTCLFL
		THEN
		BEGIN
			OWN BASE SLSTCT;	!PTR TO CONSTANT TABLE ENTRY FOR NUMBER
						! OF ITEMS IN THE ARRAY
			OWN WORDCT;		!NUMBER OF WORDS IN THE ARRAY
			SYM_.DATAITMPTR[SCALLELEM];	!PTR TO SYMBOL TABLE ENTRY FOR THE ARRAY
			SLSTCT_.DATAITMPTR[SCALLCT];

			%(***GET THE NUMBER OF WORDS IN THE ARRAY (THE SCALLCT FIELD
				PTS TO ENTRY FOR THE NUMBER OF ITEMS. FOR DOUBLE-WD ENTRIES
				MUST MULTIPLY BY 2)***)%
			WORDCT_(IF .SYM[DBLFLG] THEN .SLSTCT[CONST2]*2 ELSE .SLSTCT[CONST2]);


			%(***OUTPUT A CONSTANT TO BE  STORED INTO EACH ELEM OF THE ARRAY***)%
			INCR I FROM 0 TO .WORDCT-1
			DO
			BEGIN
				GETDCNST(.SYM);	!DETERMINE WHAT CONST TO OUTPUT
						! (SET THE GLOBALS DCON1,DCON2)

				OUTDATA(.I+.SYM[IDADDR],.DCON1,.SYM);

				%(***IF THIS IS A DOUBLE-PREC (OR COMPLEX) ARRAY, MUST
					OUTPUT 2ND WD OF THIS ELEM, AND ADD 1 TO NEXT
					WD TO LOOK AT***)%
				IF .SYM[DBLFLG]
				THEN
				OUTDATA( (I_.I+1)+.SYM[IDADDR],.DCON2,.SYM);
			END;
		END

		%(***IF THIS DATA-ITEM IS A DATACALL(EITHER AN ARRAYREF OR  A SCALAR)***)%
		ELSE
		BEGIN
			%(***GET PTR TO SYMBOL TABLE ENTRY CORRESP TO THE DATA ITEM***)%
			SYM_.DATAITMPTR[DCALLELEM];

			%(***IF THE DATA-ITEM IS AN ARRAYREF, MUST GET PTR TO ENTRY FOR THE
				ARRAY-NAME***)%
			IF .SYM[OPRCLS] EQL ARRAYREF
			THEN SYM_.SYM[ARG1PTR];

			GETDCNST(.SYM);	!SET UP DCON1 AND DCON2 TO THE 2 WDS OF THE
					! CONSTANT TO BE OUTPUT (DO NOT USE DCON2 IF
					! SYMBOL IS INTEGER OR REAL
			DADDR_GETDADDR();	!ADDRESS INTO WHICH TO STORE
			OUTDATA(.DADDR,.DCON1,.SYM);

			%(***IF SYM IS DOUBLE-PREC, FILL IN THE 2ND WD***)%
			IF .SYM[DBLFLG]
			THEN OUTDATA(.DADDR+1,.DCON2,.SYM);
		END;

		DATAITMPTR_.DATAITMPTR[CLINK];
		ADJDATPTR();				!GET PTR TO NEXT ITEM ON DATA-ITEM-LIST
							! WHICH IS EITHER  A DATACALL OR
							! SLISTCALL, ADJUST ANY DO-LOOP INDICES
	END;

	IF .DATACNSTPTR NEQ 0	!IF THERE ARE STILL CONSTANTS LEFT AFTER
				! ALL VARS HAVE BEEN FILLED
	THEN  WARNERR(.ISN,E57<0,0>);	!GIVE WARNING
END;	!OF "ALCDATA"


GLOBAL ROUTINE ADJDATPTR=
%(***************************************************************************
	THIS ROUTINE IS ALWAYS CALLED AFTER THE GLOBAL "DATAITMPTR" HAS
	BEEN MOVED FORWARD BY SETTING IT TO THE LINK FIELD OF THE PRECEEDING
	NODE POINTED TO. IF THE NODE  TO WHICH IT HAS BEEN ADVANCED IS
	A DATACALL NODE, NO ACTION NEED BE TAKEN. IF THE NODE TO WHICH IT
	HAS BEEN ADVANCED IS A DO STATEMENT NODE, THE DO LOOP MUST
	BE INTIALIZED AND DATAITMPTR ADVANCED TO THE NEXT STMNT.
	IF THE NODE TO WHICH IT HAS BEEN ADVANCED IS A CONTINUE STATEMENT WHICH
	TERMINATES A DO, THE DO INDEX MUST BE ADVANCED, A LOOP-TERMINATION TEST
	MADE, AND DATAITMPTR  EITHER SET BACK TO THE FIRST STMNT INSIDE THE DO,OR
	ADVANCED TO THE STMNT AFTER THE CONTINUE.
	(NOTE THAT NO MORE THAN ONE DO LOOP WILL EVER BE TERMINATED ON THE
	SAME CONTINUE; NOTE ALSO THAT DO INDICES MUST BE INTEGER AND THAT
	INITL, FINAL, AND INCR VALS ON DO LOOPS MUST BE INTEGER CONSTANTS.
***************************************************************************)%
BEGIN
	OWN PEXPRNODE DOINDEX;		!SYMBOL TABLE ENTRY FOR THE VAR USED AS
					! THE INDEX ON A DO STMNT BEING PROCESSED
	%(***WALK THRU THE DATA ITEM LIST UNTIL EITHER REACH THE END OF THE
		LIST, OR REACH AN ELEMENT WHICH IS A DATACALL OR SLISTCALL***)%
	UNTIL .DATAITMPTR EQL 0
	DO
	BEGIN

		%(***IF ARE LOOKING AT A DATACALL OR AN SLIST, RETURN*****)%
		IF .DATAITMPTR[OPRCLS] NEQ STATEMENT THEN RETURN;

		%(***IF ARE LOOKING AT A DO STATEMENT, SET THE "IDDATVAL" FIELD IN
			THE SYMBOL TABLE ENTRY FOR THE DO INDEX TO ITS INITIAL VALUE***)%
		IF .DATAITMPTR[SRCID] EQL DOID
		THEN
		BEGIN
			OWN PEXPRNODE DOINITVAL;
			DOINDEX_.DATAITMPTR[DOSYM];
			DOINITVAL_.DATAITMPTR[DOM1];
			%(***CAN ASSUME INITIAL VAL IS AN INTEG CONSTANT***)%
			DOINDEX[IDDATVAL]_.DOINITVAL[CONST2];

			%(***GO ON TO NEXT ELEM****)%
			DATAITMPTR_.DATAITMPTR[CLINK];
		END

		ELSE

		%(***IF ARE LOOKING AT A CONTINUE WHICH TERMINATES A DO STMNT, INCREMENT
			THE DO INDEX AND TEST FOR THE DO INDEX GTR THAN ITS FINAL VAL.
			IF HAVE FINISHED ITERATING THIS LOOP, THEN GO ON TO NEXT ELEM,
			OTHERWISE GO BACK TO THE START OF THE LOOP****)%
		IF .DATAITMPTR[SRCID] EQL CONTID
		THEN
		BEGIN
			OWN PEXPRNODE LABNODE;		!LABEL TABLE ENTRY FOR LABEL ON CONTINUE
			OWN BASE DOSTNODE;		!DO STMNT NODE AT START OF LOOP
			OWN PEXPRNODE INCRVAL:FINALVAL;	!CONSTANT TABLE ENTRIES
								! FOR INCREMENT AND FINAL VAL
								! OF LOOP INDEX

			LABNODE_.DATAITMPTR[SRCLBL];
			IF .LABNODE EQL 0 THEN CGERR();	!THE CONTINUE MUST TERMINATE SOME LOOP
			DOSTNODE_.LABNODE[SNDOLNK];
			IF .DOSTNODE EQL 0 THEN CGERR();	!THE CONTINUE MUST TERMINATE A DO
			DOSTNODE_.DOSTNODE[LEFTP];	!GET PTR TO STMNT FROM THE LINKED LIST					! OF DO STMNTS ASSOCIATED WITH THIS LABEL
							! (NOTE THATFOR A DATA STMNT THERE
							! WILL  NEVER BE MORE THAN 1)

			INCRVAL_.DOSTNODE[DOM3];
			FINALVAL_.DOSTNODE[DOM2];
			DOINDEX_.DOSTNODE[DOSYM];

			%(***INCR THE DO INDEX***)%
%**;[314],DATAST,JNT,10-JUL-75%
%**;[314],IN ADJDATPTR @ 3440%
			DOINDEX[IDDATVAL]_EXTSIGN(.DOINDEX[IDDATVAL])+.INCRVAL[CONST2];	![314] GET SIGNED #

			IF EXTSIGN(.DOINDEX[IDDATVAL]) GTR .FINALVAL[CONST2]	![314] GET SIGNED #
			THEN
			%(***IF HAVE FINISHED LOOP ITERATION, GO ON TO STMNT AFTER LOOP***)%
			DATAITMPTR_.DATAITMPTR[CLINK]

			ELSE
			%(***IF HAVE NOT FINISHED LOOP ITERATION, GO BACK TO STMNT AFTER DO STMNT***)%
			DATAITMPTR_.DOSTNODE[CLINK];
		END

		ELSE CGERR();		!STMNT MUST BE EITHER DO OR CONTINUE
	END;
END;


GLOBAL ROUTINE GETDADDR=
%(***************************************************************************
	THIS ROUTINE RETURNS THE RELOCATABLE ADDRESS CORRESPONDING TO
	A DATACALL ELEMENT IN A DATA ITEM LIST.
	IT IS CALLED WITH THE GLOBAL "DATAITMPTR" POINTING TO  THE
	DATACALL NODE FOR WHICH AN ADDRESS IS TO BE COMPUTED.
***************************************************************************)%
BEGIN
	EXTERNAL FATLERR,E135;
	REGISTER PEXPRNODE DATAELEM;	!EXPRESSION NODE UNDER THE DATACALL - MAY BE
					! AN ARRAYREF OR A DATA ITEM
	REGISTER PEXPRNODE ARRAYNMENTRY;	!SYMBOL TABLE ENTRY FOR THE ARRAY NAME
	REGISTER PEXPRNODE ARRAYSIZE;	! THE NUMBER OF WDS IN THE ARRAY

	OWN OFFST;		!OFFSET IN THE ARRAY OF THE WD TO BE INITIALIZED
	DATAELEM_.DATAITMPTR[DCALLELEM];

	IF .DATAELEM[OPRCLS] EQL DATAOPR THEN RETURN .DATAELEM[IDADDR]
	ELSE
	IF .DATAELEM[OPRCLS] EQL ARRAYREF 
	THEN
	BEGIN
		ARRAYNMENTRY_.DATAELEM[ARG1PTR];

		ARRAYSIZE_.ARRAYNMENTRY[IDDIM];	!DIM TABLE ENTRY FOR THE ARRAY
		ARRAYSIZE_.ARRAYSIZE[ARASIZ];	! THE NUMBER
					! OF WORDS IN THE ARRAY

		%(***IF THE SS WAS ALREADY FOLDED INTO THE ARRAY ADDR***)%
		IF .DATAELEM[ARG2PTR] EQL 0
		THEN OFFST_EXTSIGN( .DATAELEM[TARGADDR])
 		ELSE
		OFFST_ CNSTEVAL(.DATAELEM[ARG2PTR]) + EXTSIGN(.DATAELEM[TARGADDR]) ;

		%(**IF ARE TRYING TO SET A VALUE AFTER THE END OF THE ARRAY**)%
		IF .OFFST GTR (.ARRAYSIZE-1)
		THEN FATLERR(.ARRAYNMENTRY[IDSYMBOL],.ISN,E135);

		RETURN .OFFST+.ARRAYNMENTRY[IDADDR];
	END
	ELSE CGERR();
END;


GLOBAL ROUTINE CNSTEVAL(EXPR)=
%(***************************************************************************
	TO FOLD AN ARITHMETIC EXPRESSION IN WHICH ALL TERMS  ARE INTEGER
	CONSTANTS.
	THE ARGUMENT "EXPR" MUST BE EITHER AN ARITHMETIC NODE OR AN INTEGER
	CONSTANT NODE OR A SYMBOL TABLE ENTRY FOR AN INDEX ON AN INPLICIT
	DO-LOOP INSIDE A DATA STATEMENT.

	RETURNS THE VALUE COMPUTED.
	THIS ROUTINE IS RECURSIVE
***************************************************************************)%
BEGIN
	LOCAL T1;
	MAP PEXPRNODE EXPR;

	IF .EXPR[OPR1] EQL CONSTFL THEN RETURN .EXPR[CONST2]
	ELSE

	%(***IF EXPR IS A SYMBOL TABLE ENTRY, ASSUME THAT IT
		IS AN INDEX ON AN IMPLIED DO IN A DATA STMNT AND
		THAT THE "IDDATVAL" FIELD OF THE SYMBOL TABLE ENTRY CONTAINS
		THE CURRENT VAL OF THAT INDEX***********)%
	IF .EXPR[OPRCLS] EQL DATAOPR
	THEN
%**;[273],DATAST,JNT,30-MAY-75%
%**;[273],IN CSNTEVAL @ 3525%
	RETURN EXTSIGN(.EXPR[IDDATVAL])	![273] EXTEND SIGN FOR - NUMBERS
	ELSE

	IF .EXPR[OPRCLS] EQL ARITHMETIC
	THEN
	BEGIN
		CASE .EXPR[OPERSP] OF SET

		%(***FOR ADD*****)%
		RETURN CNSTEVAL(.EXPR[ARG1PTR]) + CNSTEVAL(.EXPR[ARG2PTR]);

		%(***FOR SUBTRACT***)%
		RETURN CNSTEVAL(.EXPR[ARG1PTR]) - CNSTEVAL(.EXPR[ARG2PTR]);

		%(***FOR MULTIPLY***)%
		RETURN CNSTEVAL(.EXPR[ARG1PTR])*CNSTEVAL(.EXPR[ARG2PTR]);

		%(***FOR DIVIDE***)%
		RETURN (CNSTEVAL(.EXPR[ARG1PTR]))/(CNSTEVAL(.EXPR[ARG2PTR]));

		%(***EXPONENTIATION IS ILLEGAL***)%
		CGERR();

		TES;
	END

	ELSE
	%(***FOR NEG (APPEARS ABOVE NEGATIVE CONSTANTS)***)%
	IF .EXPR[OPR1] EQL NEGFL
	THEN RETURN -CNSTEVAL(.EXPR[ARG2PTR])

	ELSE CGERR();
END;


GLOBAL ROUTINE GETDCNST(SYM)=
%(***************************************************************************
	ROUTINE TO SET UP THE NEXT CONSTANT WORD(S) TO BE OUTPUT FOR A GIVEN
	DATA-CONSTANT-LIST.
	CALLED WITH THE GLOBALS:
		DATACNSTPTR-PTR TO THE ENTRY ON THE DATA CONSTANT LIST TO BE USED NEXT
		CNSTCT- COUNT OF THE NUMBER OF TIMES THAT THE CONSTANT
			INDICATED BY "DATACNSTPTR" HAS BEEN OUTPUT (NOTE THAT FOR
			MULTI-WORD CONSTANTS, THIS COUNT IS ONLY INCREMENTED AFTER ALL
			WORDS OF THE CONSTANT HAVE BEEN OUTPUT)
		CNSTWDCT-COUNT OF THE NUMBER OF WORDS OF THE INDICATED CONSTANT THAT  HAVE
			ALREADY BEEN OUTPUT (NOTE THAT THIS CT IS SET BECK TO 0 FOR EACH
			REPITITION OF A GIVEN CONSTANT)
	CALLED WITH THE ARG
		SYM - THE SYMBOL THAT WILL BE SET TO THIS CONSTANT;
	UNLESS THE CONSTANT IS A LITERAL, IT MUST BE CONVERTED TO AGREE IN TYPE
	WITH "SYM"
	IF SYM IS DOUBLE-PREC OR COMPLEX THIS ROUTINE LEAVES THE GLOBALS-
		DCON1 - HIGH ORDER WD OF THE CONSTANT TO BE OUTPUT
		DCON2 - LOW ORDER WD TO BE OUTPUT
	OTHERWISE IT LEAVES 
		DCON1- THE WORD TO BE OUTPUT
		DCON2 - IS IGNORED
***************************************************************************)%
BEGIN
	EXTERNAL WARNERR,E57;	!PRINT WARNING MESSAGE
	EXTERNAL KTYPCB;	!BASE IN TABLE FOR CONSTANT FOLDING FOR TYPE CONVERSIONS
	EXTERNAL KISNGL,	!ROUTINE TO ROUND A REAL THAT IS BEING REPRESENTED
				! INTERNALLY WITH 2 WDS OF PRECISION
		KITOKA;		!ROUTINE TO ROUND TO KA10 PRECISION A DOUBLE-PREC
				! CONSTANT THAT IS BEING STORED INTERNALLY IN KI10 FORMAT
	OWN BASE CNSTENTRY;	!CONSTANT TABLE ENTRY FOR THE DESIRED CONSTANT
	MAP PEXPRNODE SYM;
	EXTERNAL C1H,C1L,C2H,C2L,COPRIX,CNSTCMB;	!GLOBALS USED BY THE CONSTANT FOLDING
							! ROUTINE
	BIND BLANKWD=#201004020100;	!A WORD OF BLANKS


	%(***IF HAVE REACHED THE END OF THE LIST OF CONSTANTS (AND PRESUMABLY NOT THE
		END OF THE LIST OF DATA ITEMS) GIVE A WARNING MESSAGE
		AND FILL WITH ZEROES***)%
	IF .DATACNSTPTR EQL 0
	THEN
	BEGIN
		EXTERNAL ISN;
		IF NOT .XTRAVARS	!IF THIS IS THE 1ST VAR TO BE FILLED WITH 0'S
		THEN
		WARNERR(.ISN,E57<0,0>);	!PRINT WARNING MESSAGE
		XTRAVARS_TRUE;
		DCON1_0;
		DCON2_0;
		RETURN
	END;

	CNSTENTRY_.DATACNSTPTR[DCONST];

	%(***FOR LITERALS********)%
	IF .CNSTENTRY[VALTYPE] EQL LITERAL
	THEN
	BEGIN
		OWN LITERALENTRY LITENTRY;
		OWN LITSIZ1;		!NUMBER OF WDS IN THE LITERAL EXCLUDING A
					! POSSIBLE PAD WD (DO NOT PUT ASCIZ OU FOR DATA STMNT)

		LITSIZ1_(IF .CNSTENTRY[LITEXWDFLG] THEN .CNSTENTRY[LITSIZ]-1
			ELSE .CNSTENTRY[LITSIZ] );

		LITENTRY_.CNSTENTRY;

		%(***VAL TO BE OUTPUT IS THE (N+1)TH WD OF THE LITERAL, WHERE N IS THE
			VALUE OF CNSTWDCT (IE NUMBER OF WDS OF THE LITERAL ALREADY OUTPUT***)%
		DCON1_.LITENTRY[.CNSTWDCT+1];

		%(***GO ON TO NEXT WD OF LITERAL***)%
		CNSTWDCT_.CNSTWDCT+1;

		%(***IF THE SYMBOL BEING INITIALIZED IS DOUBLE-WD,  MUST PICK UP  A 2ND
			WD OF THE LITERAL (IF HAVE REACHED THE END OF THE LITERAL, SET 2ND
			WD TO A WD OF BLANKS ***)%
		IF .SYM[DBLFLG]
		THEN
		BEGIN
			IF .CNSTWDCT EQL .LITSIZ1	!IF HAVE REACHED END OF LIT
			THEN DCON2_BLANKWD
			ELSE
			BEGIN
				DCON2_.LITENTRY[.CNSTWDCT+1];
				CNSTWDCT_.CNSTWDCT+1;
			END;
		END;


		%(***IF HAVE OUTPUT THE ENTIRE LITERAL, SET THE WORD CT BACK TO 0 AND
			INCREMENT THE CT OF NUMBER OF TIMES THE WHOLE CONSTANT WAS OUTPUT***)%
		IF .CNSTWDCT EQL .LITSIZ1
		THEN
		BEGIN
			CNSTWDCT_0;
			CNSTCT_.CNSTCT+1;
		END;
	END

	ELSE
	%(***FOR CONSTANTS OTHER THAN LITERALS***)%
	BEGIN
		%(***IF THE SYMBOL IS OF A DIFFERENT VALTYPE THAN THE CONSTANT,
			CONVERT THE CONSTANT***)%
		IF .SYM[VALTP1] NEQ .CNSTENTRY[VALTP1]
		THEN
		BEGIN
			C1H_.CNSTENTRY[CONST1];
			C1L_.CNSTENTRY[CONST2];
			COPRIX_KKTPCNVIX(.SYM[VALTP2],.CNSTENTRY[VALTP2]);
			CNSTCMB();	!LEAVES THE GLOBALS C2H,C2L SET TO THE CONVERTED
					! VALUE
		END
		ELSE
		BEGIN
			C2H_.CNSTENTRY[CONST1];	!SET THE GLOBALS C2H,C2L TO THE ORIG VALUE
			C2L_.CNSTENTRY[CONST2];
		END;

		%(***SET UP DCON1 AND DCON2 TO BE THE CONSTANT***)%
		CASE .SYM[VALTP1] OF SET
		%(***IF THE TYPE IS INTEGER OR OCTAL/LOGICAL***)%
		DCON1_.C2L;
		%(***IF THE TYPE IS REAL - MUST ROUND SINCE HAVE STORED 2 WDS OF PREC***)%
		DCON1_(IF BITPTNVALTYP(.CNSTENTRY[VALTYPE])	!IF THE CONSTANT WAS OCTAL,...
			THEN .C2H				! DONT ROUND
			ELSE KISNGL(.C2H,.C2L));
		%(***IF THE TYPE IS DOUBLE PREC - FOR KA10 MUST ROUND NUMBER WHICH WAS
			STORED IN KI10 FORMAT***)%
		BEGIN
			IF .KA10FLG
			   AND NOT BITPTNVALTYP(.CNSTENTRY[VALTYPE])	!DONT ROUND DOUBLOCTAL,ETC
			 THEN KITOKA(.C2H,.C2L); 	!THIS ROUTINE LEAVES ITS
								! RESULTS IN THE GLOBALS
								! C2H AND C2L
			DCON1_.C2H;
			DCON2_.C2L;
		END;
		%(***IF THE TYPE IS COMPLEX***)%
		BEGIN
			DCON1_.C2H;
			DCON2_.C2L;
		END;

		TES;



		%(***INCR CT OF NUMBER OF TIMES THIS CONSTANT HAS BEEN USED***)%
		CNSTCT_.CNSTCT+1;
	END;


	%(***TEST FOR WHETHER HAVE FINISHED ALL REPITITIONS OF THE CONSTANT AND IF SO 
		GO ON TO THE NEXT***)%
	IF .CNSTCT GEQ .DATACNSTPTR[DATARPT]
	THEN
	BEGIN
		DATACNSTPTR_.DATACNSTPTR[CLINK];
		CNSTCT_0;
	END;

END;
END
ELUDOM