Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/vltppr.bli
There are 12 other files named vltppr.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: S. MURPHY/HPW/TFV/EDS/EGM
MODULE VLTPPR(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3),GLOROUTINES)=
BEGIN
GLOBAL BIND VLTPPV = 6^24 + 0^18 + 51; ! Version Date: 16-Jul-81
%(
***** 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.
***** End Revision History *****
)%
EXTERNAL
WARNERR,FATLERR,MAKEPR,MAKPR1,TBLSEARCH;
EXTERNAL E60,E61,E98;
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.
***************************************************************************)%
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];
%(****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;
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
%(***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
IF .ARG1NODE[VALTYPE] EQL CONTROL AND .ARG2NODE[VALTYPE] EQL CONTROL
THEN CNODE[VALTYPE]_CONTROL
ELSE CNODE[VALTYPE]_LOGICAL;
![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)
*******)%
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;
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;
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***)%
IF .CNODE[VALTYPE] EQL LITERAL 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;
![1022] Preserve bit patterns for octal and literal assigned to real under GFLOATING
%(***DO NOT CONVERT OCTAL/LITERAL TO REAL IF GFLOATING***)%
%[1022]% IF .GFLOAT AND .VALTPN EQL REAL AND
%[1022]% (.CNODE[VALTYPE] EQL OCTAL OR .CNODE[VALTYPE] EQL LITERAL)
%[1022]% 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;
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;