* Copyright (c) 1980 The Regents of the University of California.
* %sccs.include.proprietary.c%
static char sccsid
[] = "@(#)conv.c 5.3 (Berkeley) %G%";
/* The following constants are used to check the limits of */
/* conversions. Dmaxword is the largest double precision */
/* number which can be converted to a two-byte integer */
/* without overflow. Dminword is the smallest double */
/* precision value which can be converted to a two-byte */
/* integer without overflow. Dmaxint and dminint are the */
/* analogous values for four-byte integers. */
/* short array should be correct for both VAX and TAHOE */
LOCAL
short dmaxword
[] = { 0x47ff, 0xfeff, 0xffff, 0xffff }; /* 32767.5 */
LOCAL
short dminword
[] = { 0xc800, 0x007f, 0xffff, 0xffff }; /* -32768.499999999999 */
LOCAL
short dmaxint
[] = { 0x4fff, 0xffff, 0xfeff, 0xffff }; /* 2147483647.5 */
LOCAL
short dminint
[] = { 0xd000, 0x0000, 0x007f, 0xffff }; /* -2147483648.4999999 */
LOCAL
short dmaxreal
[] = { 0x7fff, 0xffff, 0x7fff, 0xffff }; /* 1.7014117838986683e+38 */
LOCAL
short dminreal
[] = { 0xffff, 0xffff, 0x7fff, 0xffff }; /* -1.7014117838986683e+38 */
/* The routines which follow are used to convert */
/* constants into constants of other types. */
static char *toobig
= "bit value too large";
lenb
= cp
->vleng
->constblock
.constant
.ci
;
p
= (char *) ckalloc(len
);
#if (HERE == PDP11 || HERE == VAX)
while ( i
< lenb
&& bits
[i
] == 0 )
while ( i
>= 0 && bits
[i
] == 0)
#if (HERE == PDP11 || HERE == VAX)
bytes
= cp
->constant
.ccp
;
lenb
= cp
->vleng
->constblock
.constant
.ci
;
p
= (char *) ckalloc(len
);
static char *toobig
= "data value too large";
static char *reserved
= "reserved operand assigned to an integer";
static char *compat1
= "logical datum assigned to an integer variable";
static char *compat2
= "character datum assigned to an integer variable";
shortp
= (short *) grabbits(2, cp
);
p
= (expptr
) mkconst(TYSHORT
);
p
->constblock
.constant
.ci
= *shortp
;
if (value
>= MINWORD
&& value
<= MAXWORD
)
p
= (expptr
) mkconst(TYSHORT
);
p
->constblock
.constant
.ci
= value
;
minp
= (double *) dminword
;
maxp
= (double *) dmaxword
;
rp
= (long *) &(cp
->constant
.cd
[0]);
if (x
.f
.sign
== 1 && x
.f
.exp
== 0)
else if (x
.d
>= *minp
&& x
.d
<= *maxp
)
p
= (expptr
) mkconst(TYSHORT
);
p
->constblock
.constant
.ci
= x
.d
;
if ( !ftn66flag
&& badvalue
== 0 )
shortp
= (short *) grabbytes(2, cp
);
p
= (expptr
) mkconst(TYSHORT
);
p
->constblock
.constant
.ci
= *shortp
;
static char *toobig
= "data value too large";
static char *reserved
= "reserved operand assigned to an integer";
static char *compat1
= "logical datum assigned to an integer variable";
static char *compat2
= "character datum assigned to an integer variable";
longp
= (ftnint
*) grabbits(4, cp
);
p
= (expptr
) mkconst(TYLONG
);
p
->constblock
.constant
.ci
= *longp
;
p
= (expptr
) mkconst(TYLONG
);
p
->constblock
.constant
.ci
= cp
->constant
.ci
;
minp
= (double *) dminint
;
maxp
= (double *) dmaxint
;
rp
= (long *) &(cp
->constant
.cd
[0]);
if (x
.f
.sign
== 1 && x
.f
.exp
== 0)
else if (x
.d
>= *minp
&& x
.d
<= *maxp
)
p
= (expptr
) mkconst(TYLONG
);
p
->constblock
.constant
.ci
= x
.d
;
if ( !ftn66flag
&& badvalue
== 0 )
longp
= (ftnint
*) grabbytes(4, cp
);
p
= (expptr
) mkconst(TYLONG
);
p
->constblock
.constant
.ci
= *longp
;
static char *toobig
= "data value too large";
static char *compat1
= "logical datum assigned to a real variable";
static char *compat2
= "character datum assigned to a real variable";
longp
= (long *) grabbits(4, cp
);
p
= (expptr
) mkconst(TYREAL
);
rp
= (long *) &(p
->constblock
.constant
.cd
[0]);
p
= (expptr
) mkconst(TYREAL
);
p
->constblock
.constant
.cd
[0] = cp
->constant
.ci
;
minp
= (double *) dminreal
;
maxp
= (double *) dmaxreal
;
rp
= (long *) &(cp
->constant
.cd
[0]);
if (x
.f
.sign
== 1 && x
.f
.exp
== 0)
p
= (expptr
) mkconst(TYREAL
);
rp
= (long *) &(p
->constblock
.constant
.cd
[0]);
else if (x
.d
>= *minp
&& x
.d
<= *maxp
)
p
= (expptr
) mkconst(TYREAL
);
p
->constblock
.constant
.cd
[0] = y
;
if ( !ftn66flag
&& badvalue
== 0)
longp
= (long *) grabbytes(4, cp
);
p
= (expptr
) mkconst(TYREAL
);
rp
= (long *) &(p
->constblock
.constant
.cd
[0]);
"logical datum assigned to a double precision variable";
"character datum assigned to a double precision variable";
longp
= (long *) grabbits(8, cp
);
p
= (expptr
) mkconst(TYDREAL
);
rp
= (long *) &(p
->constblock
.constant
.cd
[0]);
p
= (expptr
) mkconst(TYDREAL
);
p
->constblock
.constant
.cd
[0] = cp
->constant
.ci
;
p
= (expptr
) mkconst(TYDREAL
);
longp
= (long *) &(cp
->constant
.cd
[0]);
rp
= (long *) &(p
->constblock
.constant
.cd
[0]);
if ( !ftn66flag
&& badvalue
== 0 )
longp
= (long *) grabbytes(8, cp
);
p
= (expptr
) mkconst(TYDREAL
);
rp
= (long *) &(p
->constblock
.constant
.cd
[0]);
static char *toobig
= "data value too large";
static char *compat1
= "logical datum assigned to a complex variable";
static char *compat2
= "character datum assigned to a complex variable";
longp
= (long *) grabbits(8, cp
);
p
= (expptr
) mkconst(TYCOMPLEX
);
rp
= (long *) &(p
->constblock
.constant
.cd
[0]);
p
= (expptr
) mkconst(TYCOMPLEX
);
p
->constblock
.constant
.cd
[0] = cp
->constant
.ci
;
minp
= (double *) dminreal
;
maxp
= (double *) dmaxreal
;
rp
= (long *) &(cp
->constant
.cd
[0]);
if (((re
.f
.sign
== 0 || re
.f
.exp
!= 0) &&
(re
.d
< *minp
|| re
.d
> *maxp
)) ||
((im
.f
.sign
== 0 || re
.f
.exp
!= 0) &&
(im
.d
< *minp
|| re
.d
> *maxp
)))
p
= (expptr
) mkconst(TYCOMPLEX
);
if (re
.f
.sign
== 1 && re
.f
.exp
== 0)
if (im
.f
.sign
== 1 && im
.f
.exp
== 0)
rp
= (long *) &(p
->constblock
.constant
.cd
[0]);
if ( !ftn66flag
&& badvalue
== 0)
longp
= (long *) grabbytes(8, cp
);
p
= (expptr
) mkconst(TYCOMPLEX
);
rp
= (long *) &(p
->constblock
.constant
.cd
[0]);
static char *compat1
= "logical datum assigned to a complex variable";
static char *compat2
= "character datum assigned to a complex variable";
longp
= (long *) grabbits(16, cp
);
p
= (expptr
) mkconst(TYDCOMPLEX
);
rp
= (long *) &(p
->constblock
.constant
.cd
[0]);
p
= (expptr
) mkconst(TYDCOMPLEX
);
p
->constblock
.constant
.cd
[0] = cp
->constant
.ci
;
p
= (expptr
) mkconst(TYDCOMPLEX
);
longp
= (long *) &(cp
->constant
.cd
[0]);
rp
= (long *) &(p
->constblock
.constant
.cd
[0]);
if ( !ftn66flag
&& badvalue
== 0 )
longp
= (long *) grabbytes(16, cp
);
p
= (expptr
) mkconst(TYDCOMPLEX
);
rp
= (long *) &(p
->constblock
.constant
.cd
[0]);
static char *compat1
= "numeric datum assigned to a logical variable";
static char *compat2
= "character datum assigned to a logical variable";
size
= typesize
[tylogical
];
p
= (expptr
) mkconst(tylogical
);
if (tylogical
== TYSHORT
)
shortp
= (short *) grabbits(size
, cp
);
p
->constblock
.constant
.ci
= (int) *shortp
;
longp
= (long *) grabbits(size
, cp
);
p
->constblock
.constant
.ci
= *longp
;
p
->constblock
.vtype
= tylogical
;
if ( !ftn66flag
&& badvalue
== 0 )
p
= (expptr
) mkconst(tylogical
);
if (tylogical
== TYSHORT
)
shortp
= (short *) grabbytes(size
, cp
);
p
->constblock
.constant
.ci
= (int) *shortp
;
longp
= (long *) grabbytes(4, cp
);
p
->constblock
.constant
.ci
= *longp
;
static char *compat1
= "numeric datum assigned to a character variable";
static char *compat2
= "logical datum assigned to a character variable";
value
= grabbits(len
, cp
);
p
= (expptr
) mkstrcon(len
, value
);
value
= grabbytes(len
, cp
);
p
= (expptr
) mkstrcon(len
, value
);
convconst(type
, len
, constant
)
p
= cchar(len
, constant
);
badtype("convconst", type
);