Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
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) DIGITAL EQUIPMENT CORPORATION 1972, 1983
!AUTHOR: S. MURPHY/HPW/TFV/EDS/EGM/RVM
MODULE VLTPPR(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3),GLOROUTINES)=
BEGIN
GLOBAL BIND VLTPPV = 7^24 + 0^18 + #1620; ! Version Date: 24-Aug-82
%(
***** 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".
***** End Revision History *****
)%
EXTERNAL
WARNERR,FATLERR,FATLEX,MAKEPR,MAKPR1,TBLSEARCH;
EXTERNAL E60,E61,E98,E163,E206,E208;
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;
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)
[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;
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"
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;
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