Google
 

Trailing-Edge - PDP-10 Archives - fortv11 - vltppr.bli
There are 12 other files named vltppr.bli in the archive. Click here to see a list.

!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1987
!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: S. MURPHY/HPW/TFV/EDS/EGM/RVM/AlB

MODULE VLTPPR(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3),GLOROUTINES)=
BEGIN

GLOBAL BIND VLTPPV = #11^24 + 0^18 + #2255;	! Version Date:	29-Dec-83

%(

***** Begin Revision History *****

41	-----	-----	FIX ASSIGNMENT OF LITERALS TO CONSTANTS
42	----	----	CHANGE ERROR MESSAGE CALLS TO FATLERR/WARNERR
43	-----	-----	FIX EDIT 41
44	-----	-----	ONCE AGAIN FIX ASSIGNMENT OF LITERALS

***** Begin Version 6 *****

45	761	TFV	1-Mar-80	-----
	Add KTYPCG for folding /GFLOATING type conversions

46	1022	TFV	27-Oct-80	------
	Preserve the bit patterns for octals and literals assigned to reals 
	under GFLOATING.

47	1040	EDS	8-Jan-81	20-15381
	Fix EXPRTYPER to step through NEGNOT nodes.

48	1046	EGM	23-Jan-81	-----
	Replace edit 1040 to generate correct code for all cases of
	negated double precision operands to boolean operators.

50	1103	EGM	23-Jun-81	QAR20-01439
	Guarantee that proper code is generated to do LOGICAL=double-word
	conversions. Also, make REAL=COMPLEX move only the real part (as
	intended).

51	1106	EGM	29-Jun-81	--------
	Restrict the REAL=COMPLEX test enabled by edit 1103 to COMPLEX
	variables, as the register allocator expects.

***** Begin Version 7 *****

49	1212	TFV	29-Apr-81	------
	Replace LITERAL with HOLLERITH

52	1254	CKS	14-Aug-81
	Modify ASGNTYPER to detect assignments between numeric and characger
	variables.  ASGNTYPER is called only for assignments in which the
	left side is numeric.

53	1255	TFV	17-Aug-81	------
	Fix EXPRTYPER to convert character constants in numeric expressions
	into hollerith constants.  All other combinations of numeric and
	character data are illegal.

54	1414	RVM	5-Nov-81
	Make CNVNODE preserve the bit patterns for logical expressions
	compared to reals under gfloating.  This fixes an bug that caused
		IF (REAL .GT. LOGIC) STOP
	to be evaluated incorrectly, particulary under /OPT.

55	1420	RVM	11-Nov-81
	Fix EXPRTYPER to really change the type of character constants
	used with numeric expressions to HOLLERITH.   The assignment
	statements that were supposed to do this each had an extra dot
	in front of the variable being assigned.

1542	RVM	25-May-82
	In CNVNODE, always convert OCTAL, HOLLERITH, LOGICAL, and CONTROL
	to REAL when needed, even under /GFLOATING.  This removes edits
	1022 and 1414 from this module.

1601	CKS	12-Jul-82
	Improve error message for the expression <character> / <character>.
	Instead of saying "illegal combination of character and numeric data",
	which is confusing since there is no numeric data involved, say
	"illegal operator for type character".


***** Begin Version 10 *********

2255	AlB	29-Dec-83
	Do compatibility flagging for mixed-mode expressions and assignments.
	Routines:
		ASGNTYPER, EXPRTYPER

***** End V10 Development *****

***** End Revision History *****

)%


	EXTERNAL
%2255%		CFLAGB,	! Put out flagger warning
		WARNERR,FATLERR,FATLEX,MAKEPR,MAKPR1,TBLSEARCH;

	EXTERNAL
		E60,E61,E98,E163,E206,E208,
%2255%		E252,	! Mixed numeric and logical
%2255%		E256,	! Numeric in character context
%2255%		E289,	! Logical in numeric context
%2255%		E290;	! Numeric in logical context

	FORWARD
		EXPRTYPER(1), TPCDMY(1),ASGNTYPER(1), CNVNODE(3);

EXTERNAL	C1H,C1L,C2H,C2L,COPRIX,CNSTCMB,KTYPCB;
%[761]%	EXTERNAL KTYPCG;	!For folding /GFLOATING type conversions


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








%(****TABLE OF VALUE-TYPES FOR OPERATIONS ON ARGS OF GIVEN VALUE-TYPES.
	AN ENTRY CONTAINING "VLTPERRFLG" INDICATES ILLEGAL MIXED MODE***)%
%(*****THE INDEX OF AN ENTRY IN THIS TABLE IS DETERMINED BY THE FIRST 3 BITS
	OF THE VALTYPES OF THE 2 ARGS*****)%

	BIND VLTPERRFLG=-1;

BIND VLTPTABLE = PLIT (
	OCTAL^(-2),		!FOR ARG1 OCTAL(OR LOGICAL),	ARG2 OCTAL
	OCTAL^(-2),		!			ARG2 CONTROL
	OCTAL^(-2),		!			ARG2 DOUBLE-OCTAL
	OCTAL^(-2),		!			ARG2 LITERAL
	INTEGER^(-2),		!			ARG2 INTEGER
	REAL^(-2),		!			ARG2 REAL
	DOUBLPREC^(-2),		!			ARG2 DOUBLE-PREC
	COMPLEX^(-2),		!			ARG2 COMPLEX
	OCTAL^(-2),		!FOR ARG1 CONTROL,	ARG2 OCTAL
	LOGICAL^(-2),		!			ARG2 CONTROL
	OCTAL^(-2),		!			ARG2 DOUBLE-OCTAL
	OCTAL^(-2),		!			ARG2 LITERAL
	INTEGER^(-2),		!			ARG2 INTEGER
	REAL^(-2),		!			ARG2 REAL
	DOUBLPREC^(-2),		!			ARG2 DOUBLE-PREC
	COMPLEX^(-2),		!			ARG2 COMPLEX
	OCTAL^(-2),		!FOR ARG1 DOUBLE-OCTAL,	ARG2 OCTAL(OR LOGICAL)
	OCTAL^(-2),		!			ARG2 CONTROL
	OCTAL^(-2),		!			ARG2 DOUBLE-OCTAL
	OCTAL^(-2),		!			ARG2 LITERAL
	INTEGER^(-2),		!			ARG2 INTEGER
	REAL^(-2),		!			ARG2 REAL
	DOUBLPREC^(-2),		!			ARG2 DOUBLE-PREC
	COMPLEX^(-2),		!			ARG2 COMPLEX
	OCTAL^(-2),		!FOR ARG1 LITERAL	ARG2 OCTAL
	OCTAL^(-2),		!			ARG2 CONTROL
	OCTAL^(-2),		!			ARG2 DOUBLE OCTAL
	OCTAL^(-2),		!			ARG2 LITERAL
	INTEGER^(-2),		!			ARG2 INTEGER
	REAL^(-2),		!			ARG2 REAL
	DOUBLPREC^(-2),		!			ARG2 DOUBLE PREC
	COMPLEX^(-2),		!			ARG2 COMPLEX
	INTEGER^(-2),		!FOR ARG1 INTEGER, 	ARG2 OCTAL
	INTEGER^(-2),		!			ARG2 CONTROL
	INTEGER^(-2),		!			ARG2 DOUBLE-OCTAL
	INTEGER^(-2),		!			ARG2 LITERAL
	INTEGER^(-2),		!			ARG2 INTEGER
	REAL^(-2),		!			ARG2 REAL
	DOUBLPREC^(-2),		!			ARG2 DOUBLE-PREC
	COMPLEX^(-2),		!			ARG2 COMPLEX
	REAL^(-2),		!ARG1 REAL,		ARG2 OCTAL
	REAL^(-2),		!			ARG2 CONTROL
	REAL^(-2),		!			ARG2 DOUBLE-OCTAL
	REAL^(-2),		!			ARG2 LITERAL
	REAL^(-2),		!			ARG2 INTEGER
	REAL^(-2),		!			ARG2 REAL
	DOUBLPREC^(-2),		!			ARG2 DOUBLE-PREC
	COMPLEX^(-2),		!			ARG2 COMPLEX
	DOUBLPREC^(-2),		!FOR ARG1 DOUBLE-PREC,	ARG2 OCTAL
	DOUBLPREC^(-2),		!			ARG2 CONTROL
	DOUBLPREC^(-2),		!			ARG2 DOUBLE-OCTAL
	DOUBLPREC^(-2),		!			ARG2 LITERAL
	DOUBLPREC^(-2),		!			ARG2 INTEGER
	DOUBLPREC^(-2),		!			ARG2 REAL
	DOUBLPREC^(-2),		!			ARG2 DOUBLE-PREC
	VLTPERRFLG,		!			ARG2 COMPLEX
	COMPLEX^(-2),		!FOR ARG1 COMPLEX,	ARG2 OCTAL
	COMPLEX^(-2),		!			ARG2 CONTROL
	COMPLEX^(-2),		!			ARG2 DOUBLE-OCTAL
	COMPLEX^(-2),		!			ARG2 LITERAL
	COMPLEX^(-2),		!			ARG2 INTEGER
	COMPLEX^(-2),		!			ARG2 REAL
	VLTPERRFLG,		!			ARG2 DOUBLE-PREC
	COMPLEX^(-2)  );	!			ARG2 COMPLEX

GLOBAL ROUTINE EXPRTYPER(CNODE) =
%(***************************************************************************
	THIS ROUTINE DETERMINES THE VALUE-TYPE OF AN EXPRESSION
	NODE OF OPRCLS BOOLEAN,RELATIONAL, OR ARITHMETIC,
	AND STORES THAT TYPE IN THE "VALTYPE" FIELD OF THE NODE.
	IF ONE OF THE ARGUMENTS OF THIS NODE MUST HAVE ITS TYPE CONVERTED
	A TYPE CONVERSION NODE IS INSERTED ABOVE IT.
	IF ONE OF THE ARGUMENTS DIFFERS IN "VLTP1" FIELD FROM THE
	PARENT ("VLTP1" IS A SUBFIELD OF THE VALTYPE
	FIELD THAT DIFFERENTIATES ONLY BETWEEN INTEGER,REAL,DOUBLE PRECISION
	AND COMPLEX), THEN EVEN IF THAT ARG NEED NOT BE CONVERTED,
	A TYPE-CONVERSION NODE IS INSERTED WHICH HAS A FLAG INDICATING
	THAT NO ACTUAL CONVERSION IS NECESSARY (THIS IS NECESSARY
	FOR REGISTER ALLOCATION).
	CALLED WITH THE ARG CNODE POINTING TO THE NODE WHOSE VALTYPE
	IS TO BE DETERMINED.
	IT IS ASSUMED THAT BOTH ARGS UNDER CNODE HAVE ALREADY HAD
	THEIR VALTYPE FIELDS FILLED IN.
	RETURNS -1 IF ILLEGAL MIXED MODE IS DETECTED.

[1255]	EXPRTYPER does not process character relationals.  EXPRESS turns
[1255] them into function calls to CH.xx. (EQ, NE, GT, GE, LT, LE).
***************************************************************************)%

BEGIN
	MAP PEXPRNODE CNODE;
	OWN PEXPRNODE ARG1NODE:ARG2NODE;
	OWN VLTP1,VLTP2,VLTPN;

	%(****IF EITHER ARG UNDER AN ARITH OR RELATIONAL NODE HAS A
		DIFFERENT VALTYPE FROM THAT OF THE COMPUTATION OF THE
		RESULT - THEN INSERT A TYPE CONVERSION NODE ABOVE THAT
		ARG.
	*******)%
	MACRO CNVARGS=
	BEGIN
		IF .VLTP1 NEQ .VLTPN
		THEN CNODE[ARG1PTR]_CNVNODE(.ARG1NODE,.VLTPN^2,.CNODE);
		IF .VLTP2 NEQ .VLTPN
		THEN CNODE[ARG2PTR]_CNVNODE(.ARG2NODE,.VLTPN^2,.CNODE);
	END$;

	ARG1NODE_.CNODE[ARG1PTR];
	ARG2NODE_.CNODE[ARG2PTR];

%1255%	! Add code to handle character data.  Turn constants into
%1255%	! hollerith constants.  All other combinations of character
%1255%	! and numeric data are errors.

%1601%	! If both operands are type character and both aren't constant,
%1601%	! complain about a numeric operator applied to character operands
%1601%	! instead of about illegal combination of char and numeric.
%1601%
%1601%	IF .ARG1NODE[VALTYPE] EQL CHARACTER
%1601%	THEN IF .ARG2NODE[VALTYPE] EQL CHARACTER
%1601%	THEN IF .ARG1NODE[OPR1] NEQ CONSTFL
%1601%	       OR .ARG2NODE[OPR1] NEQ CONSTFL
%1601%	THEN RETURN FATLEX(E206<0,0>);

%1255%	IF .ARG1NODE[VALTYPE] EQL CHARACTER
%1255%	THEN
%1255%	BEGIN	! First operator is character
%1255%		IF .ARG1NODE[OPR1] EQL CONSTFL
%1255%		THEN	! Make it a hollerith constant
%1420%			ARG1NODE[VALTYPE] _ HOLLERITH
%1255%		ELSE	! Not constant - error illegal combination of
%1255%			! character and numeric data
%1255%			RETURN FATLEX(E163<0,0>);
%1255%	END;	! First operator is character

%1255%	IF .ARG2NODE[VALTYPE] EQL CHARACTER
%1255%	THEN
%1255%	BEGIN	! Second operator is character
%1255%		IF .ARG2NODE[OPR1] EQL CONSTFL
%1255%		THEN	! Make it a hollerith constant
%1420%			ARG2NODE[VALTYPE] _ HOLLERITH
%1255%		ELSE	! Not constant - error illegal combination of
%1255%			! character and numeric data
%1255%			RETURN FATLEX(E163<0,0>);
%1255%	END;	! Second operator is character


	%(****FOR ARITHMETIC NODES -
		RESOLVE THE VALTYPES OF THE 2 ARGS AND SET THE VALTYPE
		OF THE PARENT TO THAT OF THE 2 ARGS
	*******)%
	IF .CNODE[OPRCLS] EQL ARITHMETIC
	THEN
	BEGIN
		%(***GET FIRST 3 BITS OF VALTYPE OF ARG1 AND ARG2***)%
		%(*****(NEED NOT DIFFERENTIATE INTEGER/BYTE/INDEX  NOR
			OCTAL/LOGICAL
		*********)%
		VLTP1_.ARG1NODE[VALTP2];
		VLTP2_.ARG2NODE[VALTP2];

		%(****GET VALTYPE OF PARENT********)%
		VLTPN_.VLTPTABLE[.VLTP1^3 + .VLTP2];

		%(***CHECK FOR ILLEGAL MIXED MODE - IF ENTRY IN VALTYPE
			TABLE WAS FLAG FOR ILLEGAL*****)%
		IF .VLTPN EQL VLTPERRFLG
		THEN
		BEGIN
			ENTRY[0]_.ISN;	!STMNT NUMBER
			RETURN FATLERR(.ISN,E60<0,0>);
		END;

		CNODE[VALTYPE]_.VLTPN^2;

		%(***IF ARG1 HAS A DIFFERENT VALTYPE FROM THE PARENT, INSERT A TYPE-CONVERSION
			NODE ABOVE IT*****)%
		IF .VLTP1 NEQ .VLTPN
		THEN CNODE[ARG1PTR]_CNVNODE(.ARG1NODE,.VLTPN^2,.CNODE);


		%(***IF HAVE EXPONENTIATION TO AN INTEGER POWER, DO NOT CONVERT THE
			EXPONENT. OTHERWISE, IF ARG2 HAS A DIFFERENT VALTYPE FROM
			THE PARENT, INSERT A TYPE-CONVERSION NODE ABOVE IT.***)%
		IF NOT (.CNODE[OPR1] EQL EXPONOPF AND .ARG2NODE[VALTP1] EQL INTEG1)
		THEN
		BEGIN
			IF .VLTP2 NEQ .VLTPN
			THEN CNODE[ARG2PTR]_CNVNODE(.ARG2NODE,.VLTPN^2,..CNODE);
		END;

%2255%		! Compatibility checks
%2255%		! Neither operand can be logical nor control
%2255%		IF FLAGEITHER	! Make checks only if requested
%2255%		THEN
%2255%			BEGIN
%2255%			IF  (VLTP1=.ARG1NODE[VALTYPE]) EQL LOGICAL OR
%2255%			    (VLTP2=.ARG2NODE[VALTYPE]) EQL LOGICAL OR
%2255%			    .VLTP1 EQL CONTROL OR .VLTP2 EQL CONTROL
%2255%			THEN CFLAGB(E289<0,0>)	! Logical in numeric context
%2255%			END;

	END


	ELSE
	%(****FOR BOOLEANS - 
		VALTYPE IS EITHER CONTROL (IF BOTH ARGS ARE "CONTROL")
		OR LOGICAL
		ARGS ARE NEVER ACTUALLY CONVERTED IN TYPE - BUT
		A TYPE CONVERSION NODE MUST BE INSERTED ABOVE DOUBLE-WD
		ARGS, TO ASSIST IN REGISTER-ALLOCATION
	*******)%
	IF .CNODE[OPRCLS] EQL BOOLEAN
	THEN
	BEGIN
%2255%		VLTP1=.ARG1NODE[VALTYPE]; VLTP2=.ARG2NODE[VALTYPE];

		%(***XOR AND EQV ALWAYS HAVE VALTYPE LOGICAL (NEVER "CONTROL")***)%
		IF .CNODE[BOOLCLS] NEQ ANDORCLS THEN CNODE[VALTYPE]_LOGICAL

		%(***AND AND OR HAVE VALTYPE "CONTROL" IFF BOTH ARGS HAVE VALTYPE CONTROL***)%
		ELSE
%2255%		IF .VLTP1 EQL CONTROL AND .VLTP2 EQL CONTROL
		THEN CNODE[VALTYPE]_CONTROL
		ELSE CNODE[VALTYPE]_LOGICAL;

%2255%		! Compatibility checks
%2255%		! Both operands must be logical or control
%2255%		IF FLAGEITHER	! Make checks only if requested
%2255%		THEN
%2255%			BEGIN
%2255%			IF (.VLTP1 NEQ LOGICAL AND .VLTP1 NEQ CONTROL) OR
%2255%			   (.VLTP2 NEQ LOGICAL AND .VLTP2 NEQ CONTROL)
%2255%			THEN CFLAGB(E290<0,0>)	! Numeric in logical context
%2255%			END;

![1046] Step through NEGNOT nodes from ARG1NODE.
![1046] If NEGNOT is not single precision, convert to logical
%[1046]%	VLTPN _ .CNODE;
%[1046]%	WHILE .ARG1NODE[OPRCLS] EQL NEGNOT DO
%[1046]%	BEGIN
%[1046]%		IF .ARG1NODE[DBLFLG] THEN ARG1NODE[VALTYPE]_LOGICAL;
%[1046]%		CNODE _ .ARG1NODE;
%[1046]%		ARG1NODE _ .ARG1NODE[ARG2PTR]
%[1046]%	END;
%[1046]%	IF .ARG1NODE[DBLFLG]
%[1046]%	THEN
%[1046]%		IF .CNODE[OPRCLS] EQL NEGNOT
%[1046]%		THEN
%[1046]%		CNODE[ARG2PTR]_TPCDMY(.CNODE,.ARG1NODE)
%[1046]%		ELSE
%[1046]%		CNODE[ARG1PTR]_TPCDMY(.CNODE,.ARG1NODE);
%[1046]%	CNODE_.VLTPN;
%[1046]%	WHILE .ARG2NODE[OPRCLS] EQL NEGNOT DO
%[1046]%	BEGIN
%[1046]%		IF .ARG2NODE[DBLFLG] THEN ARG2NODE[VALTYPE]_LOGICAL;
%[1046]%		CNODE _ .ARG2NODE;
%[1046]%		ARG2NODE _ .ARG2NODE[ARG2PTR]
%[1046]%	END;
		IF .ARG2NODE[DBLFLG]
		THEN 
		CNODE[ARG2PTR]_TPCDMY(.CNODE,.ARG2NODE);
%[1046]%	CNODE _ .VLTPN;
	END

	ELSE
	%(******FOR RELATIONALS -
		A RELATIONAL ALWAYS HAS VALTYPE CONTROL.
		THE ARGUMENTS OF A RELATIONAL MUST HAVE THE SAME "VALTP1"
		FIELDS; IF THEY DO NOT, A TYPE-CONVERSION NODE MUST
		BE INSERTED ABOVE THE NODE TO BE CONVERTED.
		NOTE THAT A RELATIONAL NODE IS AN EXCEPTION TO
		THE RULE THAT IN GENERAL A PARENT NODE
		HAS THE SAME PRECISION AS ITS SONS (HENCE THE
		REGISTER ALLOCATER WILL HAVE TO WORRY ABOUT
		GOING FROM SINGLE-PREC TO DOUBLE-PREC ACROSS A RELATIONAL NODE)

[1255]	EXPRTYPER does not process character relationals.  EXPRESS turns
[1255]	them into function calls to CH.xx. (EQ, NE, GT, GE, LT, LE).
	*******)%
	IF .CNODE[OPRCLS] EQL RELATIONAL
	THEN
	BEGIN
		%(***GET FIRST 3 BITS OF VALTYPE OF ARG1 AND ARG2***)%
		%(*****(NEED NOT DIFFERENTIATE INTEGER/BYTE/INDEX  NOR
			OCTAL/LOGICAL
		*********)%
		VLTP1_.ARG1NODE[VALTP2];
		VLTP2_.ARG2NODE[VALTP2];

		%(****GET VALTYPE OF PARENT********)%
		VLTPN_.VLTPTABLE[.VLTP1^3 + .VLTP2];

		%(***CHECK FOR ILLEGAL MIXED MODE - IF ENTRY IN VALTYPE
			TABLE WAS FLAG FOR ILLEGAL*****)%
		IF .VLTPN EQL VLTPERRFLG
		THEN
		BEGIN
			ENTRY[0]_.ISN;	!STMNT NUMBER
			RETURN FATLERR(.ISN,E60<0,0>);
		END;


		%(***RELATIONALS OTHER THAN EQ/NE ARE ILLEGAL BETWEEN
			COMPLEX TERMS. GIVE A WARNING**)%
		IF .VLTPN EQL COMPLEX^(-2) AND
			(.CNODE[OPERSP] NEQ E AND .CNODE[OPERSP] NEQ N)
		THEN
		WARNERR(.ISN,E98<0,0>);

		CNODE[VALTYPE]_CONTROL;

		%(****IF EITHER ARG HAS A DIFFERENT VALUE TYPE FROM VLTPN
			INSERT A TYPE-CONVERSION NODE ABOVE THAT ARG***)%
		CNVARGS;

%2255%		! Compatibility checks
%2255%		! Neither operand can be logical nor control
%2255%		IF FLAGEITHER	! Make checks only if requested
%2255%		THEN
%2255%			BEGIN
%2255%			IF  (VLTP1=.ARG1NODE[VALTYPE]) EQL LOGICAL OR
%2255%			    (VLTP2=.ARG2NODE[VALTYPE]) EQL LOGICAL OR
%2255%			    .VLTP1 EQL CONTROL OR .VLTP2 EQL CONTROL
%2255%			THEN CFLAGB(E289<0,0>)	! Logical in numeric context
%2255%			END;
	END

	ELSE
	BEGIN
		ENTRY[0]_.ISN;	!STMNT NUMBER
		ENTRY[1]_PLIT SIXBIT 'EXPRTYPER';
		RETURN FATLERR(.ISN,E61<0,0>);			!SHOULD NEVER GET HERE UNLESS THERE'S
	END;
						! AN INTERNAL ERROR IN THE COMPILER


	RETURN 0;

END;

GLOBAL ROUTINE ASGNTYPER(STMNODE)=
%(***************************************************************************
	ROUTINE TO PERFORM TYPE-ANALYSIS FOR AN ASSIGNMENT STATEMENT
	OR A STATEMENT FUNCTION.
	IF THE RIGHT HAND SIDE OF THE STATEMENT HAS A DIFFERENT VALUE-TYPE
	FROM THE LEFT HAND SIDE, A TYPE-CONVERSION NODE IS INSERTED
	ABOVE THE EXPRESSION NODE ON THE RIGHT TO CONVERT IT TO THE TYPE
	ASSOCIATED WITH THE LEFT-HAND VALUE.
***************************************************************************)%
BEGIN
	OWN PEXPRNODE RHNODE:LHNODE;
	MAP BASE STMNODE;
	OWN VLTPL,VLTPR;
%[1103]% OWN DBLFLR;		!DOUBLE WORD FLAG FOR RIGHT HAND NODE
	LABEL INSERTCNV;

	%(***SET RHNODE TO THE EXPRESSION THAT MAY HAVE TO BE CONVERTED, SET LHNODE
		TO THE VARIABLE/EXPRESSION WHICH HAS THE TYPE THAT RHNODE MUST
		BE MADE TO AGREE WITH***)%
	IF .STMNODE[SRCID] EQL ASGNID
	THEN
	BEGIN
		RHNODE_.STMNODE[RHEXP];
		LHNODE_.STMNODE[LHEXP];
	END
	ELSE
	IF .STMNODE[SRCID] EQL SFNID
	THEN
	BEGIN
		RHNODE_.STMNODE[SFNEXPR];
		LHNODE_.STMNODE[SFNNAME];	!FOR A STMN FN, TYPE IS DETERMINED
						! BY THE FN NAME
	END
	ELSE
	BEGIN
		%(**SHOULD NEVER GET HERE***)%
		ENTRY[0]_.ISN;
		ENTRY[1]_PLIT SIXBIT 'ASGNTYPER';
		RETURN FATLERR(.ISN,E61<0,0>);
	END;


	%(**** [1254] LHS IS NOT TYPE CHARACTER.  RHS MUST NOT BE TYPE
	       CHARACTER EITHER, EXCEPT THAT NUMERIC = 'CONST' IS ALLOWED.***)%

	IF .RHNODE[VALTYPE] EQL CHARACTER
	THEN IF .RHNODE[OPR1] EQL CONSTFL	! NUMERIC = CHARACTER CONSTANT
	     THEN RHNODE[VALTYPE] _ HOLLERITH 	! CHANGE TO HOLLERITH CONSTANT
	     ELSE FATLERR(.ISN,E208<0,0>);	! "Illegal assignment between
						! character and numeric data"

%2255%	! Generate a flagger warning unless LHNODE and RHNODE are
%2255%	! both logical or both not logical.
%2255%	! Type CONTROL is treated as LOGICAL.
%2255%	IF FLAGEITHER
%2255%	THEN
%2255%		BEGIN
%2255%		VLTPL=.LHNODE[VALTYPE];
%2255%		IF .VLTPL EQL CONTROL THEN VLTPL=LOGICAL;
%2255%		VLTPR=.RHNODE[VALTYPE];
%2255%		IF .VLTPR EQL CONTROL THEN VLTPR=LOGICAL;
%2255%
%2255%		IF  (.VLTPL EQL LOGICAL AND .VLTPR NEQ LOGICAL) OR
%2255%		    (.VLTPL NEQ LOGICAL AND .VLTPR EQL LOGICAL)
%2255%		THEN CFLAGB(E252<0,0>)
%2255%		END;

	VLTPL_.LHNODE[VALTP2];
	VLTPR_.RHNODE[VALTP2];
%[1103]% DBLFLR_.RHNODE[DBLFLG];

	%(***IF THE VALTP2 FIELD (THE FIRST 3 BITS OF THE VALTYPE, WHICH DIFFERENTIATE:
		OCTAL/LOGICAL,CONTROL,LITERAL,DOUBLE-OCTAL,INTEGER/INDEX/BYTE,
		REAL,DOUBLE-PREC, AND COMPLEX)
	OF RIGHT-HAND-SIDE IS DIFFERENT FROM THAT OF LEFT-HAND-SIDE,
	INSERT A TYPE-CONVERSION OVER RIGHT-HAND-SIDE******)%
	IF .VLTPL NEQ .VLTPR
	THEN
INSERTCNV:	BEGIN
		%(***IF THE VALTYPE OF RHS IS OCTAL/LOGICAL OR CONTROL AND THE LEFT-HAND-SIDE
			IS SINGLE-WORD, DO NOT INSERT A TYPE-CONVERSION NODE***)%
		IF (.VLTPR EQL OCTAL^(-2) OR .VLTPR EQL CONTROL^(-2)) AND NOT .LHNODE[DBLFLG]
		THEN LEAVE INSERTCNV;

		%(***INSERT A TYPE-CONVERSION NODE ABOVE THE RIGHT-HAND SIDE***)%
		RHNODE_CNVNODE(.RHNODE,.VLTPL^2,.STMNODE);
		IF .STMNODE[SRCID] EQL ASGNID
		THEN
		STMNODE[RHEXP]_.RHNODE
		ELSE
		STMNODE[SFNEXPR]_.RHNODE;

![1103]		IF CONVERSION HAS NOT REDUCED THE RIGHT HAND NODE TO A CONSTANT
![1106]		AND THE CONVERSION IS SINGLE-WORD TO LOGICAL OR COMPLEX
![1106]		VARIABLE TO REAL, SET THE FLAG TO BYPASS CODE GENERATION
![1106]		FOR THIS CONVERSION
		IF .RHNODE[OPR1] NEQ CONSTFL 
		THEN
		BEGIN
%[1103]%		IF .VLTPL EQL LOGICAL2 AND NOT .DBLFLR
			THEN
			RHNODE[NOCNVFLG]_1
			ELSE
%[1106]%		IF .VLTPR EQL COMPLEX2 AND .VLTPL EQL REAL2 AND
%[1106]%			.RHNODE[A2VALFLG]
			THEN
			RHNODE[NOCNVFLG]_1;
		END;
	END;
	RETURN 0;			!RETURN 0 TO INDICATE NO ILLEGAL MIXED MODE
END;

GLOBAL ROUTINE CNVNODE(CNODE,VALTPN,PARNODE)=
%(***************************************************************************
	TO CONVERT THE NODE CNODE TO THE VALTYPE "VALTPN"
	IF CNODE IS A CONSTANT, IT CONVERTS IT.
	OTHERWISE, INSERTS A TYPE CONVERSION NODE ABOVE CNODE.
	RETURNS A PTR TO EITHER THE NEW CONSTANT NODE OR TO THE TYPE-CONVERSION
	NODE;
***************************************************************************)%
BEGIN
	MAP PEXPRNODE CNODE;

	%(***WHEN CONVERTING A LITERAL TO A DOUBLE WORD ARGUMENT
	     SET NEW VALTYPE TO BE DOUBLOCT TO AVOID 
	     ROUNDING***)%

%1212%	IF .CNODE[VALTYPE] EQL HOLLERITH THEN
	IF .VALTPN EQL DOUBLPREC OR .VALTPN EQL COMPLEX THEN
	 VALTPN_DOUBLOCT;		!RESET NEW VALTYPE

	%(***DO NOT CONVERT DOUBLE OCTALS TO DOUBLE PRECISION (SINCE
	  WILL THEN RUN INTO TROUBLE WITH THE KA10/KI10 FORMAT CONVERSION)***)%
	IF .VALTPN EQL DOUBLPREC AND  .CNODE[VALTYPE] EQL DOUBLOCT
	THEN RETURN .CNODE;

	%(***WHEN CONVERTING AN OCTAL CONSTANT TO DOUBLE PRECISION, MAKE THE
	   NEW CONSTANT HAVE TYPE "DOUBLE-OCTAL" INSTEAD OF DOUBLE-PREC SO
	   THAT IT WONT GET "NORMALIZED" BEFORE BEING OUTPUT***)%
	IF .VALTPN EQL DOUBLPREC AND .CNODE[VALTYPE] EQL OCTAL
	THEN VALTPN_DOUBLOCT;

%2255%	! If converting from non-character to hollerith, we may put out
%2255%	! a compatibility flagger warning.
%2255%	IF FLAGEITHER
%2255%	THEN	IF .VALTPN EQL HOLLERITH AND .CNODE[VALTYPE] NEQ CHARACTER
%2255%		THEN CFLAGB(E256<0,0>);

	IF .CNODE[OPR1] EQL CONSTFL
	THEN
	BEGIN
		C1H_.CNODE[CONST1];
		C1L_.CNODE[CONST2];
		COPRIX_KKTPCNVIX(VTP2(.VALTPN),.CNODE[VALTP2]);
		CNSTCMB();
		RETURN MAKECNST(.VALTPN,.C2H,.C2L);
	END
	ELSE
	RETURN MAKPR1(.PARNODE,TYPECNV,.CNODE[VALTP2],.VALTPN,0,.CNODE);
END;

GLOBAL ROUTINE TPCDMY(PARPTR,ARGNODE)=
%(***************************************************************************
	ROUTINE TO INSERT A DUMMY TYPE-CONVERSION NODE ABOVE SOME
	NODE "ARGNODE" WHICH HAS A DOUBLE-WD VALUE-TYPE.
	THIS IS USED WHEN THE PARENT OF ARGNODE HAS A SINGLE-WD
	VALUE-TYPE - AND THE NODE IS INSERTED FOR REGISTER-ALLOCATION PURPOSES
	ONLY.
	RETURNS A PTR TO THE NODE TO REPLACE ARGNODE IN THE TREE.
***************************************************************************)%
BEGIN
	MAP PEXPRNODE ARGNODE;


	%(****IF ARGNODE IS A CONSTANT, REPLACE IT BY  A NEW CONSTANT WHICH IS
		SINGLE-WD****)%
	IF .ARGNODE[OPR1] EQL CONSTFL
	THEN
	RETURN MAKECNST(LOGICAL,0,.ARGNODE[CONST1]);


	%(****OTHERWISE, INSERT A TYPE-CONVERSION NODE ABOVE ARGNODE***)%
	ARGNODE_MAKPR1(.PARPTR,TYPECNV,.ARGNODE[VALTP2],LOGICAL,0,.ARGNODE);
	ARGNODE[NOCNVFLG]_1;
	RETURN .ARGNODE;
END;

END
ELUDOM