/****************************************************************
Copyright 1990, 1991, 1993 by AT&T Bell Laboratories and Bellcore.
Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appear in all
copies and that both that the copyright notice and this
permission notice and warranty disclaimer appear in supporting
documentation, and that the names of AT&T Bell Laboratories or
Bellcore or any of their entities not be used in advertising or
publicity pertaining to distribution of the software without
specific, written prior permission.
AT&T and Bellcore disclaim all warranties with regard to this
software, including all implied warranties of merchantability
and fitness. In no event shall AT&T or Bellcore be liable for
any special, indirect or consequential damages or any damages
whatsoever resulting from loss of use, data or profits, whether
in an action of contract, negligence or other tortious action,
arising out of or in connection with the use or performance of
****************************************************************/
#define MAX_INIT_LINE 100
void list_init_data(Infile
, Inname
, outfile
)
if (status
= dsort(Inname
, sortfname
))
fatali ("sort failed, status %d", status
);
scrub(Inname
); /* optionally unlink Inname */
if ((sortfp
= fopen(sortfname
, textread
)) == NULL
)
Fatal("Couldn't open sorted initialization data");
do_init_data(outfile
, sortfp
);
/* Insert a blank line after any initialized data */
nice_printf (outfile
, "\n");
if (debugflag
&& infname
)
/* don't back block data file up -- it won't be overwritten */
backup(initfname
, initbname
);
/* do_init_data -- returns YES when at least one declaration has been
int do_init_data(outfile
, infile
)
char varname
[NAME_MAX
], ovarname
[NAME_MAX
];
int vargroup
; /* 0 --> init, 1 --> equiv, 2 --> common */
int did_one
= 0; /* True when one has been output */
chainp values
= CHNULL
; /* Actual data values */
while (rdname (infile
, &vargroup
, varname
) && rdlong (infile
, &offset
)
&& rdlong (infile
, &type
)) {
if (strcmp (varname
, ovarname
)) {
/* If this is a new variable name, the old initialization has been
wr_one_init(outfile
, ovarname
, &values
, keepit
);
strcpy (ovarname
, varname
);
if (memno2info(atoi(varname
+2), &np
)) {
if (((Addrp
)np
)->uname_tag
!= UNAM_NAME
) {
err("do_init_data: expected NAME");
np
= ((Addrp
)np
)->user
.name
;
if (!(keepit
= np
->visused
) && !np
->vimpldovar
)
warn1("local variable %s never used",
if (keepit
&& !did_one
) {
nice_printf (outfile
, "/* Initialized data */\n\n");
values
= mkchain((char *)data_value(infile
, offset
, (int)type
), values
);
/* Write out the last declaration */
wr_one_init (outfile
, ovarname
, &values
, keepit
);
wr_char_len(outfile
, dimp
, n
, extra1
)
nice_printf (outfile
, extra1
? "[%d+1]" : "[%d]", n
);
nice_printf(outfile
, "[%d", n
);
for(i
= 0; i
< nd
; i
++) {
e
= dimp
->dims
[i
].dimsize
;
err ("wr_char_len: nonconstant array size");
nice_printf(outfile
, "*%ld", e
->constblock
.Const
.ci
);
rv
*= e
->constblock
.Const
.ci
;
/* extra1 allows for stupid C compilers that complain about
* too many initializers in
nice_printf(outfile
, extra1
? "+1]" : "]");
return extra1
? rv
+1 : rv
;
static int ch_ar_dim
= -1; /* length of each element of char string array */
static int eqvmemno
; /* kludge */
write_char_init(outfile
, Values
, namep
)
many("equivalences", 'q', maxequiv
);
? namep
->vleng
->constblock
.Const
.ci
for(i
= 0, nd
= dimp
->ndim
; i
< nd
; i
++) {
ds
= dimp
->dims
[i
].dimsize
;
err("write_char_values: nonconstant array size");
size
*= ds
->constblock
.Const
.ci
;
*Values
= revchain(*Values
);
wr_equiv_init(outfile
, nequiv
, Values
, 0);
def_start(outfile
, namep
->cvarname
, CNULL
, "");
ind_printf(0, outfile
, "((char *)&equiv_%d)\n\n", eqvmemno
);
ind_printf(0, outfile
, dimp
? "((%s *)&equiv_%d)\n\n" : "(*(%s *)&equiv_%d)\n\n",
c_type_decl(type
,0), eqvmemno
);
/* wr_one_init -- outputs the initialization of the variable pointed to
by info. When is_addr is true, info is an Addrp; otherwise,
void wr_one_init (outfile
, varname
, Values
, keepit
)
char *array_comment
= NULL
, *name
;
static int e1
[3] = {1, 0, 1};
if (varname
== NULL
|| varname
[1] != '.')
/* Get back to a meaningful representation; find the given memno in one
of the appropriate tables (user-generated variables in the hash table,
system-generated variables in a separate list */
memno
= atoi(varname
+ 2);
/* Must subtract eqvstart when the source file
* contains more than one procedure.
wr_equiv_init(outfile
, eqvmemno
= memno
- eqvstart
, Values
, 0);
/* COMMON initialization (BLOCK DATA) */
wr_equiv_init(outfile
, memno
, Values
, 1);
errstr("wr_one_init: unknown variable name '%s'", varname
);
is_addr
= memno2info (memno
, &info
.name
);
if (info
.name
== (Namep
) NULL
) {
err ("wr_one_init -- unknown variable");
if (info
.addr
-> uname_tag
!= UNAM_NAME
) {
erri ("wr_one_init -- couldn't get name pointer; tag is %d",
nice_printf (outfile
, " /* bad init data */");
namep
= info
.addr
-> user
.name
;
/* check for character initialization */
*Values
= values
= revchain(*Values
);
for(last
= 0; values
; values
= values
->nextp
) {
cp
= (chainp
)values
->datap
;
write_char_init(outfile
, Values
, namep
);
last
= (int)cp
->nextp
->datap
== TYBLANK
? loc
+ (int)cp
->nextp
->nextp
->datap
if (halign
&& info
.name
->tag
== TNAME
) {
nice_printf(outfile
, "static struct { %s fill; char val",
x
= wr_char_len(outfile
, namep
->vdim
, ch_ar_dim
=
info
.name
-> vleng
-> constblock
.Const
.ci
, 1);
nice_printf(outfile
, "; char fill2[%ld]", hsize
- x
);
name
= info
.name
->cvarname
;
nice_printf(outfile
, "; } %s_st = { 0,", name
);
wr_output_values(outfile
, namep
, *Values
);
nice_printf(outfile
, " };\n");
def_start(outfile
, name
, CNULL
, name
);
ind_printf(0, outfile
, "_st.val\n");
for(; values
; values
= values
->nextp
) {
if ((int)((chainp
)values
->datap
)->nextp
->datap
== TYCHAR
) {
write_char_init(outfile
, Values
, namep
);
last
= ((long) ((chainp
) values
->datap
)->datap
) / size
;
write_char_init(outfile
, Values
, namep
);
nice_printf (outfile
, "static %s ", c_type_decl (type
, 0));
write_nv_ident (outfile
, info
.addr
);
out_name (outfile
, info
.name
);
is_scalar
= namep
-> vdim
== (struct Dimblock
*) NULL
;
array_comment
= type
== TYCHAR
? 0 : wr_ardecls(outfile
, namep
->vdim
, 1L);
if (ISICON (info
.name
-> vleng
))
/* We'll make single strings one character longer, so that we can use the
standard C initialization. All this does is pad an extra zero onto the
wr_char_len(outfile
, namep
->vdim
, ch_ar_dim
=
info
.name
-> vleng
-> constblock
.Const
.ci
, e1
[Ansi
]);
err ("variable length character initialization");
nice_printf (outfile
, "%s", array_comment
);
nice_printf (outfile
, " = ");
wr_output_values (outfile
, namep
, values
);
nice_printf (outfile
, ";\n");
chainp
data_value (infile
, offset
, type
)
char line
[MAX_INIT_LINE
+ 1], *pointer
;
if (fgets (line
, MAX_INIT_LINE
, infile
) == NULL
) {
err ("data_value: error reading from intermediate file");
/* Get rid of the trailing newline */
line
[strlen (line
) - 1] = '\0';
#define iswhite(x) (isspace (x) || (x) == ',')
prev_val
= vals
= CHNULL
;
register char *end_ptr
, old_val
;
/* Move pointer to the start of the next word */
while (*pointer
&& iswhite (*pointer
))
/* Move end_ptr to the end of the current word */
for (end_ptr
= pointer
+ 1; *end_ptr
&& !iswhite (*end_ptr
);
/* Add this value to the end of the list */
if (ONEOF(type
, MSKREAL
|MSKCOMPLEX
))
newval
= cpstring(pointer
);
newval
= (char *)atol(pointer
);
prev_val
->nextp
= mkchain(newval
, CHNULL
);
prev_val
= prev_val
-> nextp
;
prev_val
= vals
= mkchain(newval
, CHNULL
);
return mkchain((char *)offset
, mkchain((char *)LONG_CAST type
, vals
));
fprintf(stderr
, "Error");
fprintf(stderr
, " in file %s", filename0
);
fprintf(stderr
, ": overlapping initializations\n");
static void make_one_const();
void wr_output_values (outfile
, namep
, values
)
/* Handle array initializations away from scalars */
if (namep
&& namep
-> vdim
)
wr_array_init (outfile
, namep
-> vtype
, values
);
else if (values
->nextp
&& type
!= TYCHAR
)
make_one_const(type
, &Const
.Const
, values
);
Const
.vstg
= ONEOF(type
, MSKREAL
|MSKCOMPLEX
) != 0;
Vlen
->constblock
.Const
.ci
= charlen
;
out_const (outfile
, &Const
);
out_const (outfile
, &Const
);
wr_array_init (outfile
, type
, values
)
int size
= typesize
[type
];
long index
, main_index
= 0;
nice_printf(outfile
, "\"");
nice_printf (outfile
, "{ ");
index
= ((long) ((chainp
) values
->datap
)->datap
) / size
;
while (index
> main_index
) {
/* Fill with zeros. The structure shorthand works because the compiler
will expand the "0" in braces to fill the size of the entire structure
nice_printf (outfile
, "0.0,");
nice_printf (outfile
, "{0},");
nice_printf(outfile
, " ");
nice_printf (outfile
, "0,");
} /* while index > main_index */
nice_printf(outfile
, "\" \"");
this_char
= (int) ((chainp
) values
->datap
)->
if ((int)((chainp
)values
->datap
)->nextp
->datap
== TYBLANK
) {
nice_printf(outfile
, " ");
values
= values
-> nextp
;
nice_printf(outfile
, str_fmt
[this_char
], this_char
);
make_one_const(type
, &Const
.Const
, values
);
Const
.vstg
= ONEOF(type
, MSKREAL
|MSKCOMPLEX
) != 0;
out_const(outfile
, &Const
);
erri("wr_array_init: bad type '%d'", type
);
if (values
&& type
!= TYCHAR
)
nice_printf (outfile
, ",");
nice_printf(outfile
, "\"");
nice_printf (outfile
, " }");
make_one_const(type
, storage
, values
)
int b
= 0, k
, main_index
= 0;
/* Find the max length of init string, by finding the highest offset
value stored in the list of initial values */
for(k
= 1, prev
= CHNULL
, v
= values
; v
; prev
= v
, v
= v
->nextp
)
k
= ((int) (((chainp
) prev
->datap
)->datap
)) + 2;
/* + 2 above for null char at end */
for (str_ptr
= str
; values
; str_ptr
++) {
int index
= (int) (((chainp
) values
->datap
)->datap
);
while (index
> main_index
++)
k
= (int) (((chainp
) values
->datap
)->nextp
->nextp
->datap
);
if ((int)((chainp
)values
->datap
)->nextp
->datap
== TYBLANK
) {
values
= values
-> nextp
;
Const
-> ccp1
.blanks
= b
;
vals
= ((chainp
)values
->datap
)->nextp
->nextp
;
while(vals
= vals
->nextp
);
rdname (infile
, vargroupp
, name
)
Fatal("rdname: oversize name");
for (c
= getc (infile
); !feof (infile
) && isspace (c
); c
= getc (infile
))
for (*n
= 0; isdigit (c
); c
= getc (infile
))
*n
= 10 * (*n
) + c
- '0';
extern struct Hashentry
*hashtab
, *lasthash
;
for (this_var
= new_vars
; this_var
; this_var
= this_var
-> nextp
) {
Addrp var
= (Addrp
) this_var
->datap
;
Fatal("memno2info: null variable");
else if (var
-> tag
!= TADDR
)
Fatal("memno2info: bad tag");
if (memno
== var
-> memno
) {
} /* if memno == var -> memno */
} /* for this_var = new_vars */
for (entry
= hashtab
; entry
< lasthash
; ++entry
) {
Namep var
= entry
-> varp
;
if (var
&& var
-> vardesc
.varno
== memno
&& var
-> vstg
== STGINIT
) {
} /* if entry -> vardesc.varno == memno */
} /* for entry = hashtab */
Fatal("memno2info: couldn't find memno");
do_string(outfile
, v
, nloc
)
nice_printf(outfile
, "{");
switch((int)cp
->nextp
->datap
) {
k
= (ftnint
)cp
->nextp
->nextp
->datap
;
nice_printf(outfile
, "%s' '", comma
);
uk
= (ftnint
)cp
->nextp
->nextp
->datap
;
sprintf(buf
, chr_fmt
[uk
], uk
);
nice_printf(outfile
, "%s'%s'", comma
, buf
);
dloc
= (ftnint
)cp
->datap
;
nice_printf(outfile
, "}");
Ado_string(outfile
, v
, nloc
)
nice_printf(outfile
, "\"");
switch((int)cp
->nextp
->datap
) {
k
= (ftnint
)cp
->nextp
->nextp
->datap
;
nice_printf(outfile
, " ");
k
= (ftnint
)cp
->nextp
->nextp
->datap
;
nice_printf(outfile
, str_fmt
[k
], k
);
dloc
= (ftnint
)cp
->datap
;
nice_printf(outfile
, "\"");
if (L
== 1 && type
!= TYCHAR
)
sprintf(buf
, "[%ld]", L
);
wr_equiv_init(outfile
, memno
, Values
, iscomm
)
int btype
, curtype
, dtype
, filltype
, filltype1
, j
, k
, wasblank
, xtype
;
static char Blank
[] = "";
register char *comma
= Blank
;
chainp sentinel
, values
, v1
, vlast
;
ftnint L
, L1
, dL
, dloc
, loc
, loc0
;
char imag_buf
[50], real_buf
[50];
int szshort
= typesize
[TYSHORT
];
static char typepref
[] = {0, 0, TYINT1
, TYSHORT
, TYLONG
,
TYREAL
, TYDREAL
, TYREAL
, TYDREAL
,
static char basetype
[] = {0, 0, TYCHAR
, TYSHORT
, TYLONG
,
TYLONG
, TYDREAL
, TYLONG
, TYDREAL
,
L
= extsymtab
[memno
].maxleng
;
xtype
= extsymtab
[memno
].extype
;
L
= eqv
->eqvtop
- eqv
->eqvbottom
;
if (halign
&& typealign
[typepref
[xtype
]] < typealign
[htype
])
*Values
= values
= revchain(vlast
= *Values
);
/* unless the data include a value of the appropriate
* type, we add an extra element in an attempt
* to force correct alignment */
for(v
= *Values
;;v
= v
->nextp
) {
z
= ISREAL(dtype
) ? cpstring("0.") : (char *)0;
mkchain((char *)LONG_CAST dtype
,
mkchain((char *)v
, CHNULL
);
if (basetype
[(int)cp
->nextp
->datap
] == btype
)
dloc
= (ftnint
)cp
->datap
;
&& btype
<= type_choice
[L1
/szshort
% 4]
&& btype
<= type_choice
[loc
/szshort
% 4])
dtype
= (int)cp
->nextp
->datap
;
loc
= dloc
+ dtype
== TYBLANK
? (ftnint
)cp
->nextp
->nextp
->datap
sentinel
= mkchain((char *)L
, mkchain((char *)TYERROR
,CHNULL
));
vlast
->nextp
= mkchain((char *)sentinel
, CHNULL
);
/* use doublereal fillers only if there are doublereal values */
for(v
= values
; v
; v
= v
->nextp
)
if (ONEOF((int)((chainp
)v
->datap
)->nextp
->datap
,
M(TYDREAL
)|M(TYDCOMPLEX
))) {
nice_printf(outfile
, "%sstruct {\n", iscomm
? "" : "static ");
for(v
= values
; v
; v
= v
->nextp
) {
dloc
= (ftnint
)cp
->datap
;
if ((int)cp
->nextp
->datap
!= TYERROR
) {
dtype
= (int)cp
->nextp
->datap
;
if (curtype
!= dtype
|| L
> 0) {
nice_printf(outfile
, "%s e_%d%s;\n",
filltype
= L
% szshort
? TYCHAR
: type_choice
[L
/szshort
% 4];
filltype1
= loc
% szshort
? TYCHAR
: type_choice
[loc
/szshort
% 4];
if (typesize
[filltype
] > typesize
[filltype1
])
L1
= L
/ typesize
[filltype
];
nice_printf(outfile
, "%s fill_%d[%ld];\n",
typename
[filltype
], ++k
, L1
);
loc
+= (ftnint
)cp
->nextp
->nextp
->datap
;
nice_printf(outfile
, "} %s = { ", iscomm
? extsymtab
[memno
].cextname
: equiv_name(eqvmemno
, CNULL
));
for(v
= values
; ; v
= v
->nextp
) {
dtype
= (int)cp
->nextp
->datap
;
dloc
= (ftnint
)cp
->datap
;
nice_printf(outfile
, "%s{0}", comma
);
nice_printf(outfile
, ", ");
if (dtype
== TYCHAR
|| dtype
== TYBLANK
) {
v
= Ansi
== 1 ? Ado_string(outfile
, v
, &loc
)
: do_string(outfile
, v
, &loc
);
make_one_const(dtype
, &Const
, v
);
if (Const
.ci
< 0 || Const
.ci
> 1)
"wr_equiv_init: unexpected logical value %ld",
Const
.ci
? "TRUE_" : "FALSE_");
nice_printf(outfile
, "%ld", Const
.ci
);
nice_printf(outfile
, "%s",
flconst(real_buf
, Const
.cds
[0]));
nice_printf(outfile
, "%s", Const
.cds
[0]);
nice_printf(outfile
, "%s, %s",
flconst(real_buf
, Const
.cds
[0]),
flconst(imag_buf
, Const
.cds
[1]));
nice_printf(outfile
, "%s, %s",
Const
.cds
[0], Const
.cds
[1]);
erri("unexpected type %d in wr_equiv_init",
nice_printf(outfile
, " };\n\n");