![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to cfront.cpio CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / cfront / xptcfront|
Return to cfront.cpio CVS log | Up to [Research Unix] / researchv10no / cmd / cfront / xptcfront |
researchv10 Norman
0707071010112043441004440001630000160000010075200466055374000001000000013411alloc.c /*ident "@(#)ctrans:src/alloc.c 1.4" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
alloc.c:
*****************************************************************************/
#include "cfront.h"
#include "size.h"
#include "sysent.h"
const int NBITE = (CHUNK-8)/sizeof(name)-1;
const int EBITE = (CHUNK-8)/sizeof(expr)-1;
const int SBITE = (CHUNK-8)/sizeof(stmt)-1;
const int TBITE = (CHUNK-8)/sizeof(table)-1;
const int VBITE = (CHUNK-8)/sizeof(vec)-1;
const int FBITE = (CHUNK-8)/sizeof(fct)-1;
const int PBITE = (CHUNK-8)/sizeof(ptr)-1;
#define mzero(p,l) memset(p,0,l)
void* chunk(int i) // get memory that is not to be freed
{
register char* cp = malloc(i*CHUNK-8);
if (cp == 0) { // no space
free((char*)gtbl); // get space for error message
error('i',"free store exhausted");
}
return cp;
}
#ifdef __HAVE_SIZE_T
#include <new.h>
#define NEW_SIZE size_t
#else
#define NEW_SIZE long
#endif
void* operator new(NEW_SIZE sz) // get memory that might be freed
{
char* p = calloc((unsigned)sz,1);
//fprintf(stderr,"alloc(%d)->%d\n",sz,p);
if (p == 0) { // no space
free((char*)gtbl); // get space for error message
error('i',"free store exhausted");
}
return p;
}
void operator delete (void* p)
{
if (p == 0) return;
//fprintf(stderr,"free(%d) %d\n",p,((int*)p)[-1]-(int)p-1+sizeof(int*));
free((char*)p);
}
// class new and delete operators
void*
expr::operator new(size_t sz)
{
register Pexpr p;
if ( (p=expr_free) == 0 ) {
register Pexpr q = (Pexpr) chunk(1);
for (p=expr_free=&q[EBITE-1]; q<p; p--) {
p->e1 = p-1;
DB(p->node::allocated=0);
}
(p+1)->e1 = 0;
DB(p->node::allocated=0);
}
else
expr_free = p->e1;
mzero(p,sz);
return p;
}
void
expr::operator delete(void* vp, size_t)
{
Pexpr p = (Pexpr)vp;
DB( if(!p->node::allocated) error('i',"deleting unallocated expr:%k! -- id==%d",p->base,p->node::id);
p->node::allocated = 0;
);
p->e1 = expr_free;
expr_free = p;
vp = 0;
}
void*
stmt::operator new(size_t sz)
{
register Pstmt p;
if ( (p=stmt_free) == 0 ) {
register Pstmt q = (Pstmt) chunk(1);
for (p=stmt_free=&q[SBITE-1]; q<p; p--) {
p->s_list = p-1;
DB(p->node::allocated=0);
}
(p+1)->s_list = 0;
DB(p->node::allocated=0);
}
else
stmt_free = p->s_list;
mzero(p,sz);
return p;
}
void
stmt::operator delete(void* vp,size_t)
{
Pstmt p = (Pstmt)vp;
DB( if(!p->node::allocated) error('i',"deleting unallocated stmt:%k! -- id==%d",p->base,p->node::id);
p->node::allocated = 0;
);
p->s_list = stmt_free;
stmt_free = p;
vp = 0;
}
void*
name::operator new(size_t sz)
{
register Pname p;
if ( (p=name_free) == 0 ) {
register Pname q = (Pname) chunk(1);
for (p=name_free=&q[NBITE-1]; q<p; p--) {
p->n_tbl_list = p-1;
DB(p->node::allocated=0);
}
(p+1)->n_tbl_list = 0;
DB(p->node::allocated=0);
}
else
name_free = p->n_tbl_list;
mzero(p,sz);
return p;
}
void
name::operator delete(void* vp,size_t)
{
Pname p = (Pname)vp;
DB( if(!p->node::allocated) error('i',"deleting unallocated name %s! -- id==%d",p->string?p->string:"???",p->node::id);
p->node::allocated = 0;
);
p->n_tbl_list = name_free;
name_free = p;
vp = 0;
}
void*
table::operator new(size_t sz)
{
register Ptable p;
if ( (p=table_free) == 0 ) {
register Ptable q = (Ptable) chunk(1);
for (p=table_free=&q[TBITE-1]; q<p; p--) {
p->next = p-1;
DB(p->node::allocated=0);
}
(p+1)->next = 0;
DB(p->node::allocated=0);
}
else
table_free = p->next;
mzero(p, sz);
return p;
}
void
table::operator delete(void* vp,size_t)
{
Ptable p = (Ptable)vp;
DB( if(!p->node::allocated) error('i',"deleting unallocated table %d! -- id==%d",p->base,p->node::id);
p->node::allocated = 0;
);
p->next = table_free;
table_free = p;
vp = 0;
}
void*
vec::operator new(size_t sz)
{
register Pvec p;
if ( (p=vec_free) == 0 ) {
register Pvec q = (Pvec) chunk(1);
for (p=vec_free=&q[VBITE-1]; q<p; p--) {
p->tlist = p-1;
DB(p->node::allocated=0);
}
(p+1)->tlist = 0;
DB(p->node::allocated=0);
}
else
vec_free = (Pvec) p->tlist;
mzero(p, sz);
return p;
}
void
vec::operator delete(void* vp,size_t)
{
Pvec p = (Pvec)vp;
DB( if(!p->node::allocated) error('i',"deleting unallocated vec %d! -- id==%d",p->base,p->node::id);
p->node::allocated = 0;
);
p->tlist = vec_free;
vec_free = p;
vp = 0;
}
void*
fct::operator new(size_t sz)
{
register Pfct p;
if ( (p=fct_free) == 0 ) {
register Pfct q = (Pfct) chunk(1);
for (p=fct_free=&q[FBITE-1]; q<p; p--) {
p->tlist = p-1;
DB(p->node::allocated=0);
}
(p+1)->tlist = 0;
DB(p->node::allocated=0);
}
else
fct_free = (Pfct) p->tlist;
mzero(p, sz);
return p;
}
void
fct::operator delete(void* vp,size_t)
{
Pfct p = (Pfct)vp;
DB( if(!p->node::allocated) error('i',"deleting unallocated fct %d! -- id==%d",p->base,p->node::id);
p->node::allocated = 0;
);
p->tlist = fct_free;
fct_free = p;
vp = 0;
}
void*
ptr::operator new(size_t sz)
{
register Pptr p;
//error('d',"ptr new");
if ( (p=ptr_free) == 0 ) {
register Pptr q = (Pptr) chunk(1);
for (p=ptr_free=&q[PBITE-1]; q<p; p--) {
p->tlist = p-1;
DB(p->node::allocated=0);
}
(p+1)->tlist = 0;
DB(p->node::allocated=0);
}
else
ptr_free = (Pptr) p->tlist;
mzero(p, sz);
return p;
}
void
ptr::operator delete(void* vp,size_t)
{
Pptr p = (Pptr)vp;
DB( if(!p->node::allocated) error('i',"deleting unallocated ptr %d! -- id==%d",p->base,p->node::id);
p->node::allocated = 0;
);
p->tlist = ptr_free;
ptr_free = p;
vp = 0;
}
0707071010112043451004440001630000160000010070500466055374500001100000070343cfront.h /*ident "@(#)ctrans:src/cfront.h 1.12" */
/***********************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
When reading cfront code please remember that C++ was not available
when it was originally written. Out of necessity cfront is written
in a style that takes advantage of only few of C++'s features.
WARNING: This program relies on non-initialized class members being ZERO.
This will be true as long as they are allocated using the "new" operator
from alloc.c
cfront.h:
Here is all the class definitions for cfront, and most of the externs
***********************************************************************/
#ifndef _CFRONT_H
#define _CFRONT_H
#include "token.h"
#include "typedef.h"
#ifndef GRAM
extern char* prog_name; // compiler name and version
extern int inline_restr; // inline expansion restrictions
#endif
extern TOK tlex();
extern Pname syn();
extern void ext(int);
extern char* make_name(TOK);
extern void make_dummy();
extern Pname dummy_fct;
extern Pname really_dominate(Pname, Pname, bit);
extern int exact1(Pname, Ptype);
extern int friend_check(Pclass start,Pclass stop, Pfct f);
struct loc // a source file location
{
short file; // index into file_name[], or zero
short line;
#ifndef GRAM
void put(FILE*);
void putline();
#endif
};
extern Loc curloc;
extern int curr_file;
extern char* src_file_name;
extern loc noloc; // dummy null location
extern bit binary_val;
extern bit stmtno;
struct ea { // fudge portable printf-like formatting for error()
union {
void* p;
long i;
};
ea(const void* pp) { p = pp; }
ea(long ii) { i = ii; }
ea() {}
};
extern ea* ea0;
overload error;
int error(const char*);
int error(const char*, const ea&, const ea& = *ea0, const ea& = *ea0, const ea& = *ea0);
int error(int, const char*);
int error(int, const char*, const ea&, const ea& = *ea0, const ea& = *ea0, const ea& = *ea0);
int error(loc*, const char*, const ea& = *ea0, const ea& = *ea0, const ea& = *ea0, const ea& = *ea0);
int error(int, loc*, const char*, const ea& = *ea0, const ea& = *ea0, const ea& = *ea0, const ea& = *ea0);
extern char emode;
extern int error_count;
extern int vtbl_opt;
extern int debug_opt;
extern int warning_opt;
extern int ansi_opt;
extern int strict_opt;
extern FILE* out_file;
extern FILE* in_file;
extern char scan_started;
extern int bl_level;
extern Ptable ktbl; // keywords and typedef names
extern Ptable gtbl; // global names
extern Ptable ptbl;
extern Ptable lcl_tbl;
extern char* oper_name(TOK);
extern Pname def_name;
extern Pname pdef_name;
extern Pclass ccl;
extern Pbase defa_type;
extern Pbase moe_type;
extern Pbase mptr_type;
#ifndef GRAM
extern Pstmt Cstmt; // current statement, or 0
extern Pname Cdcl; // name currently being declared, or 0
extern Pbase any_type;
extern int largest_int;
#endif
extern Pbase int_type;
extern Pbase char_type;
extern Pbase short_type;
extern Pbase long_type;
extern Pbase uint_type;
extern Pbase float_type;
extern Pbase double_type;
extern Pbase ldouble_type;
extern Pbase void_type;
#ifndef GRAM
extern Pbase uchar_type;
extern Pbase ushort_type;
extern Pbase ulong_type;
extern Ptype Pchar_type;
extern Ptype Pint_type;
extern Ptype Pvptr_type;
extern Ptype Pfctvec_type;
extern Ptype Pvoid_type;
extern Pbase zero_type;
extern Ptype size_t_type;
extern int byte_offset;
extern int bit_offset;
extern int max_align;
extern int const_save;
extern int const_ptr;
extern int cm_const_save;
extern bit const_problem;
#endif
extern Pexpr dummy; /* the empty expression */
extern Pexpr zero;
extern Pexpr one;
extern Pname sta_name; /* qualifier for unary :: */
#define DEL(p) if (p && (p->permanent==0)) p->del()
#define PERM(p) p->permanent=1
#define UNPERM(p) p->permanent=0
struct node {
TOK base;
bit permanent;
bit baseclass; // base classes have NAME in their base ...
#ifdef DBG
bit displayed; // avoid infinite recursion in display functions
bit allocated; // set when not on free list
long id;
#endif
};
#ifdef DBG
extern long node_id;
extern int Adebug;
#define DBID() { node::id = ++::node_id; node::allocated=1; displayed=0; \
if(Adebug>=1)fprintf(stderr,"\n*** allocated %d base %d\n",id,base); }
#else
#define DBID() /**/
#endif
struct table : node {
/* a table is a node only to give it a "base" for debugging */
bit init_stat; /* ==0 if block(s) of table not simplified,
==1 if simplified but had no initializers,
==2 if simplified and had initializers.
*/
short size;
short hashsize;
short free_slot; /* next free slot in entries */
Pname* entries;
short* hashtbl;
Pstmt real_block; /* the last block the user wrote,
not one of the ones cfront created
*/
Ptable next; /* table for enclosing scope */
Pname t_name; /* name of the table */
static Ptable table_free;
void* operator new(size_t);
void operator delete(void*,size_t);
table(short, Ptable, Pname);
~table();
Pname look(char*, TOK);
Pname insert(Pname, TOK);
#ifndef GRAM
void grow(int);
void set_name(Pname n) { t_name = n; };
Pname get_mem(int);
int max() { return free_slot-1; };
void dcl_print(TOK,TOK);
#endif
void del();
};
#ifndef GRAM
extern bit Nold;
extern bit vec_const, fct_const;
#endif
extern void restore();
extern void set_scope(Pname);
extern Plist modified_tn;
// local class
extern Plist local_tn;
extern Plist local_blk;
extern Plist local_class;
extern void local_hide( Pname );
extern char *make_local_name(Pclass, int=0);
// nested type
extern Plist nested_tn;
extern Plist nested_type;
extern Pname curr_scope;
extern Pname curr_fct;
extern void nested_hide(Pname);
extern int is_empty(Pclass,bit=0);
extern Pbase start_cl(TOK, Pname, Pbcl);
extern void end_cl();
extern Pbase end_enum(Pname, nlist*);
/************ types : basic types, aggregates, declarators ************/
#ifndef GRAM
extern bit new_type;
extern Pname cl_obj_vec;
extern Pname eobj;
#endif
#define DEFINED 01 /* definition fed through ?::dcl() */
#define SIMPLIFIED 02 /* in ?::simpl() */
#define DEF_SEEN 04 /* definition seen, but not processed */
#define REF_SEEN 010 /* reference seen (classdef) */
/* used for class members in norm.c */
#define IN_ERROR 010
struct type : node {
bit defined; /* flags DEF_SEEN, DEFINED, SIMPLIFIED, IN_ERROR
not used systematically yet
*/
bit lex_level;
Pclass in_class; // nested type
Pname in_fct; // local type
char *lcl;
char *nested_sig;
char *signature(char*);
Ptype tlist;
bit check(Ptype, TOK);
#ifndef GRAM
void print();
void dcl_print(Pname);
void base_print();
Pname is_cl_obj(); /* sets cl_obj_vec */
Pptr is_ref();
Pptr is_ptr();
Pptr is_ptr_or_ref();
bit is_unsigned();
void dcl(Ptable);
int tsizeof(int = 0);
bit tconst();
TOK set_const(bit);
int align();
TOK kind(TOK,TOK);
TOK integral(TOK oo) { return kind(oo,'I'); };
TOK numeric(TOK oo) { return kind(oo,'N'); };
TOK num_ptr(TOK oo) { return kind(oo,'P'); };
bit vec_type();
Ptype deref();
inline Pptr addrof();
Pfct memptr();
#endif
void del();
};
struct enumdef : type { /* ENUM */
bit e_body;
short no_of_enumerators;
unsigned char strlen; // strlen(string)
char* string; // name of enum
Pname mem;
Pbase e_type; // type representing the enum
enumdef(Pname n) { base=ENUM; mem=n; };
#ifndef GRAM
void print();
void dcl_print(Pname);
void dcl(Pname, Ptable);
void simpl();
#endif
};
struct velem {
Pname n;
int offset;
};
struct virt : node {
Pvirt next;
int n_init;
velem* virt_init; // vector of vtbl initializers (zero-terminated)
Pclass vclass; // for class vclass
char* string;
bit is_vbase; // vtable for virtual base
bit printed;
virt(Pclass cl, velem* v, char* s, bit flag, int ni) {base = XVIRT; vclass=cl; virt_init=v; string=s; is_vbase=flag; next=0; n_init = ni;}
};
enum { C_VPTR=1, C_XREF=2, C_ASS=4, C_VBASE=8 };
// An enumeration of the types of classes for Objectstore
enum class_type_enum { vanilla_class, // A regular class
template_class,
instantiated_template_class,
uninstantiated_template_class,
relationship_class,
defining_class
};
class type_extension;
struct classdef : type { /* CLASS */
class_type_enum class_base; // An extension of "base" to further define
// the real subtype of the class
bit c_body; /* print definition only once */
TOK csu; /* CLASS, STRUCT, UNION, or ANON */
bit obj_align;
bit c_xref;
// 1 set: has vptr(s)
// 2 set: X(X&) exists
// 4 set: operator=(X&) exists
// 8 set: has vbaseptr(s)
bit virt_count; // number of virtual functions
// starting at max base class virt_count in
bit virt_merge; // set when no virtual functions, but
// need to merge virtual base classes
bit c_abstract; // abstract class: don't instantiate
bit has_vvtab; // set if class has vtable from virtual base
unsigned char strlen; // strlen(string)
Pbcl baselist; // list of base classes
char* string; /* name of class */
Pname mem_list;
Ptable memtbl;
int obj_size;
int real_size; /* obj_size - alignment waste */
Plist friend_list;
Pname pubdef;
Plist tn_list; // list of member names hiding type names
Plist nest_list; // list of nested types
Ptype this_type;
Pvirt virt_list; // vtbl initializers
Pname c_ctor; // constuctor:
// possibly overloaded, possibly inherited
Pname c_dtor; // destructor
Pname c_itor; /* constructor X(X&) */
Pname conv; /* operator T() chain */
struct toknode *c_funqf, *c_funqr; // token Q for parsing function defs after class def
classdef(TOK);
~classdef();
TOK is_simple() { return (csu==CLASS)?0:csu; };
#ifndef GRAM
void print();
void dcl_print(Pname);
void simpl();
void print_members();
void dcl(Pname, Ptable);
// bit has_friend(Pname);
bit has_friend(Pclass);
bit has_friend(Pfct);
bit has_base(Pclass cl);
bit baseof(Pname);
bit baseof(Pclass);
Pclass is_base(char*);
Pname has_oper(TOK);
Pname has_ctor() { return c_ctor; }
Pname has_dtor() { return c_dtor; }
Pname has_itor() { return c_itor; }
Pname has_ictor();
Pname make_itor(int);
Pexpr find_name(char*, Pclass, int=0);
int do_virtuals(Pvirt, char*, int, bit);
int all_virt(Pclass, char*, int, bit);
void add_vtbl(velem*, char*, bit, int);
void print_all_vtbls(Pclass);
void print_vtbl(Pvirt);
void really_print(Pvirt);
int check_dup(Pclass, TOK);
int has_allocated_base(Pclass);
char *has_allocated_base(char*);
int get_offset(char*);
Pbcl get_base(char*);
Pexpr get_vptr_exp(char*);
Pexpr find_in_base(char*, Pclass);
void modify_inst_names(char *s); // Adjust ctor names for instantiation
bit parametrized_class();
bit same_class(Pclass p);
#endif
};
#ifndef GRAM
class clist {
Pclass cl;
clist* next;
public:
clist(Pclass c, clist* n) { cl=c; next=n; }
int onlist(Pclass);
void clear();
};
extern clist * vcllist;
struct vl {
struct vl* next;
Pvirt vt;
classdef* cl;
vl(classdef* c, Pvirt v, struct vl* n)
{ cl = c; vt = v; next = n; }
};
extern vl* vlist;
extern int nin;
extern int Nvis;
extern int Noffset;
extern TOK Nvirt;
extern Pexpr Nptr;
extern Pbcl Nvbc_alloc;
extern char *Nalloc_base;
extern Pexpr rptr(Ptype,Pexpr,int);
extern Pexpr vbase_args(Pfct, Pname);
extern Pexpr cdvec(Pname,Pexpr,Pclass,Pname,int,Pexpr,Pexpr=0);
extern Pexpr find(char*, Pclass, int);
extern Pexpr find_name(Pname, Pclass, Ptable, int, Pname);
extern Pname find_virtual(Pclass,Pname);
extern Pname vfct(Pclass, char*);
extern int Vcheckerror;
extern int ignore_const;
extern int mex;
extern Pclass mec;
extern Pclass tcl;
#endif
struct basetype : type
/* ZTYPE CHAR SHORT INT LONG FLOAT DOUBLE
FIELD EOBJ COBJ TYPE ANY
*/
/* used for gathering all the attributes
for a list of declarators
ZTYPE is the (generic) type of ZERO
ANY is the generic type of an undeclared name
*/
{
bit b_unsigned;
bit b_signed;
bit b_volatile;
bit b_const;
bit b_typedef;
bit b_inline;
bit b_virtual;
bit b_short;
bit b_long;
bit b_bits; /* number of bits in field */
bit b_offset; // bit offset of field
TOK b_sto; /* AUTO STATIC EXTERN REGISTER 0 */
Pname b_name; /* name of non-basic type */
Ptable b_table; /* memtbl for b_name, or 0 */
Pname b_xname; /* extra name */
union {
Ptype b_fieldtype;
char* b_linkage;
};
basetype(TOK, Pname);
Pbase type_adj(TOK);
Pbase base_adj(Pbase);
Pbase name_adj(Pname);
Pname aggr();
Pbase check(Pname);
#ifndef GRAM
void dcl_print();
Pbase arit_conv(Pbase);
bit parametrized_class();
#endif
int discriminator(int); // union discriminator fcn
};
enum Linkage { linkage_default, linkage_C, linkage_Cplusplus };
extern Linkage linkage;
void set_linkage(char*);
struct fct : type // FCT
{
TOK nargs;
TOK nargs_known; // 0 if unknown, 1 if known, or ELLIPSIS
bit last_stmt;
bit f_vdef; // 1 if this is the first virtual definition
// of this function
bit f_inline; // 1 if inline, 2 if being expanded, else 0
bit f_const; // one if member function that may be called for
// a const object, else 0
bit f_static; // 1 if static member function, else 0
short f_virtual; // index in virtual table, or 0 meaning non-virtual
short f_imeasure; // some measure of the size of an inline function
Ptype returns;
Pname argtype;
Ptype s_returns;
Pname f_this;
Pclass memof; // member of class memof
Pblock body;
Pname f_init; // base and member initializers
Pexpr f_expr; // body expanded into an expression
Pexpr last_expanded;
Pname f_result; // extra second argument of type X&
Pname f_args; // argument list including args added by cfront
Linkage f_linkage;
char* f_signature; // character encoding of function type
Plist local_class; // list of local classes
static Pfct fct_free;
void* operator new(size_t);
void operator delete(void*,size_t);
fct(Ptype, Pname, TOK);
void argdcl(Pname,Pname);
#ifndef GRAM
Ptype normalize(Ptype);
void dcl_print();
void dcl(Pname);
Pexpr base_init(Pclass, Pexpr, Ptable, int);
Pexpr mem_init(Pname, Pexpr, Ptable);
void init_bases(Pclass, Pexpr);
bit declared() { return nargs_known; };
void simpl();
int ctor_simpl(Pclass, Pexpr);
Pstmt dtor_simpl(Pclass, Pexpr);
Pexpr expand(Pname,Ptable,Pexpr);
void sign();
#endif
int discriminator(int); // union discriminator fcn
};
struct name_list : node {
Pname f;
Plist l;
name_list(Pname ff, Plist ll) { base = XNLIST; f=ff; l=ll; };
};
#ifndef GRAM
struct gen : type { // OVERLOAD
Plist fct_list;
gen() { base = OVERLOAD; }
Pname add(Pname);
Pname find(Pfct, bit);
Pname match(Pname, Pfct, bit);
};
#endif
struct pvtyp : type {
Ptype typ;
};
struct vec : pvtyp // VEC
// typ [ dim ]
{
Pexpr dim;
int size;
static Pvec vec_free;
void* operator new(size_t);
void operator delete(void*,size_t);
vec(Ptype t, Pexpr e) { base=VEC; typ=t; dim=e; DBID(); }
#ifndef GRAM
Ptype normalize(Ptype);
#endif
};
struct ptr : pvtyp // PTR, RPTR i.e. reference
{
Pclass memof; // pointer to member of memof: memof::*
bit rdo; // "*const"
static Pptr ptr_free;
void* operator new(size_t);
void operator delete(void*,size_t);
ptr(TOK b, Ptype t) { base=b; typ=t; DBID(); }
#ifndef GRAM
Ptype normalize(Ptype);
#endif
};
#ifndef GRAM
inline Pptr type::addrof() { return new ptr(PTR,this); }
extern bit vrp_equiv;
#endif
/****************************** constants ********************************/
/* STRING ZERO ICON FCON CCON ID */
/* IVAL FVAL LVAL */
/***************************** expressions ********************************/
#ifndef GRAM
extern Pexpr next_elem();
extern void new_list(Pexpr);
extern void list_check(Pname, Ptype, Pexpr, Ptable=0);
extern Pexpr ref_init(Pptr,Pexpr,Ptable);
extern Pexpr class_init(Pexpr,Ptype,Pexpr,Ptable);
extern Pexpr check_cond(Pexpr, TOK, Ptable);
extern Pexpr ptof(Pfct,Pexpr,Ptable);
extern void dosimpl(Pexpr, Pname);
extern int ref_initializer;
extern int ntok;
extern void ptbl_init(int);
extern void ptbl_add_pair(char*,char*);
extern char *ptbl_lookup(char*);
extern char *st_name(char*);
#endif
struct expr : node /* PLUS, MINUS, etc. */
/* IMPORTANT: all expressions are of sizeof(expr) */
/* DEREF => *e1 (e2==0) OR e1[e2]
UMINUS => -e2
INCR (e1==0) => ++e2
INCR (e2==0) => e1++
CM => e1 , e2
ILIST => LC e1 RC (an initializer list)
a Pexpr may denote a name
*/
{
union {
Ptype tp;
char *string4;
};
union {
Pexpr e1;
long i1;
char* string;
};
union {
Pexpr e2;
int i2;
char* string2;
Pexpr n_initializer;
Ptype tpdef; // local and nested typedef info
};
union { /* used by the derived classes */
Ptype tp2;
Pname fct_name;
Pexpr cond;
Pexpr mem;
Ptype as_type;
Ptable n_table;
Pin il;
Pname query_this;
};
static Pexpr expr_free;
void* operator new(size_t);
void operator delete(void*,size_t);
expr(TOK, Pexpr, Pexpr);
void del();
#ifndef GRAM
void print();
Pexpr typ0(Ptable);
Pexpr typ(Ptable);
long eval();
unsigned long ueval(long,long);
int lval(TOK);
Ptype call_fct(Ptable);
Pexpr address();
Pexpr contents();
void simpl();
Pexpr expand();
bit not_simple();
Pexpr try_to_overload(Ptable);
Pexpr docast(Ptable);
Pexpr dovalue(Ptable);
Pexpr donew(Ptable);
void simpl_new();
void simpl_delete();
#endif
int discriminator(int); // union discriminator fcn
};
struct texpr : expr { // CAST NEW VALUE (also ICALL)
texpr(TOK bb, Ptype tt, Pexpr ee) : expr (bb,ee,0) { tp2=tt; }
};
struct cast : expr { // CAST
cast(Ptype tt, Pexpr ee) : expr (CAST,ee,0) { tp=tp2=tt; }
};
struct ival : expr { // IVAL
ival(long ii) : expr (IVAL,0,0) { i1 = ii;}
};
struct call : expr { // CALL
call(Pexpr aa, Pexpr bb) : expr (CALL,aa,bb) { }
#ifndef GRAM
void simpl();
Pexpr expand(Ptable);
#endif
};
struct qexpr : expr { // QUEST cond ? e1 : e2
qexpr(Pexpr ee, Pexpr ee1, Pexpr ee2) : expr (QUEST,ee1,ee2) { cond=ee; }
};
struct ref : expr { // REF DOT e1->mem OR e1.mem
ref(TOK ba, Pexpr a, Pexpr b) : expr (ba,a,0) { mem=b; }
};
struct mdot : expr { // MDOT a.b
mdot(char* a, Pexpr b) : expr (MDOT,0,0) { string2=a; mem=b; }
};
struct text_expr : expr { // TEXT (vtbl_name)
text_expr(char* a, char* b) : expr (TEXT,0,0)
{ string=a; string2=b; }
};
char* vtbl_name(char*,char*);
/************************* names (are expressions) ****************************/
struct basecl : node { // NAME => base class
// VIRTUAL => virtual base class
TOK ppp; // private / public / protected
bit allocated; // allocated virtual base
bit promoted; // non-explicit, promoted virtual base
Pclass bclass;
Pexpr init; // base class initializers for ctors
int ptr_offset; // pointer's relative position in derived class
int obj_offset; // object's relative position in derived class
Pname* virt_init; // vector of vtbl table initializers
basecl* next;
basecl(Pclass cl, basecl* n) { baseclass=1; bclass=cl; next=n; promoted=0; init=0;}
};
enum template_formal_types {
template_type_formal =1 , template_expr_formal,
template_stmt_tree_formal, template_expr_tree_formal,
template_actual_arg_dummy // used during the parse
};
extern TOK ppbase;
struct name : expr { // NAME TNAME and the keywords in the ktbl
TOK n_oper; // name of operator or 0
TOK n_sto; // EXTERN STATIC AUTO REGISTER ENUM 0
TOK n_stclass; // STATIC AUTO REGISTER 0
TOK n_scope; // EXTERN STATIC FCT ARG PUBLIC 0
TOK n_key; /* for names in table: class */
bit n_evaluated; // 0 or n_val holds the value
bit n_xref; // argument of type X(X&)
unsigned char lex_level;
TOK n_protect; // PROTECTED (<=>n_scope==0) or 0
bit n_dcl_printed; // 1: declaration printed
// 2: definition printed
// 0: declaration not printed
// if this is set it implies that n_template_arg == template_type_formal
char n_template_arg; // One of template_formal_types for template arguments
bit n_template_formal_must_be_class ;
bit n_redefined ; // set only for PT function names where an explict
// definition was provided.
char *n_anon; // nested anonymous unions
short n_union; // 0, or union index
short n_addr_taken;
short n_used;
short n_assigned_to;
Loc where;
int n_offset; // byte offset in frame or struct
Pname n_list;
Pname n_tbl_list;
char *n_gen_fct_name; // used to be punned with n_tbl_list.
char *n_template_arg_string ; // the mangled string name
union {
/*
* n_qualifier: name of containing class
* n_realscope: for labels (always entered in function table)
* the table for the actual scope in which label occurred.
* syn_class: lex table only
*/
Pname n_qualifier;
Ptable n_realscope;
int syn_class;
};
/* n_val: the value of n_initializer; also the argument
* number for inline arguments (when base == ANAME) */
long n_val;
static Pname name_free;
void* operator new(size_t);
void operator delete(void*,size_t);
name(char* =0);
Pname normalize(Pbase, Pblock, bit);
Pname tdef();
Pname tname(TOK);
void hide();
void unhide() { n_key=0; n_list=0; };
#ifndef GRAM
Pname dcl(Ptable,TOK);
int no_of_names();
void use() { n_used++; };
void assign();
void take_addr();
void check_oper(Pname);
void simpl();
void print();
void dcl_print(TOK);
void field_align();
Pname dofct(Ptable,TOK);
#endif
void del();
int discriminator(int); // union discriminator fcn
};
extern int friend_in_class;
extern int in_class_dcl;
// from parser
extern int in_class_decl;
extern int parsing_class_members;
extern int in_mem_fct;
extern int in_arg_list;
extern Ptype in_typedef;
extern int defer_check; // redefinition typedef check delay
extern int declTag; // !1: inline, virtual mod permitted
extern Pname in_tag;
extern Pname statStat;
extern int DECL_TYPE;
/******************** statements *********************************/
struct stmt : node { /* BREAK CONTINUE DEFAULT */
/* IMPORTANT: all statement nodes have sizeof(stmt) */
Pstmt s;
Pstmt s_list;
Loc where;
union {
Pname d; // goto/block -- destination
Pexpr e2; // for iteration
Pstmt has_default; // switch statement default
int case_value;
Ptype ret_tp; // pair
};
union {
Pexpr e;
bit own_tbl;
Pstmt s2;
};
Ptable memtbl;
union {
Pstmt for_init;
Pstmt else_stmt;
Pstmt case_list;
Loc where2; // location of } at end of block
};
static Pstmt stmt_free;
void* operator new(size_t);
void operator delete(void*,size_t);
stmt(TOK, loc, Pstmt);
void del();
#ifndef GRAM
void print();
void dcl();
void dcl1(Pstmt&);
void reached();
Pstmt simpl();
Pstmt expand();
Pstmt copy();
#endif
int discriminator(int); // union discriminator fcn
};
#ifndef GRAM
extern char* Neval;
extern Ptable scope;
extern Ptable expand_tbl;
extern Pname expand_fn;
#endif
struct estmt : stmt /* SM WHILE DO SWITCH RETURN CASE */
/* SM (e!=0) => e;
in particular assignments and function calls
SM (e==0) => ; (the null statement)
CASE => case e : s ;
SM_PARAM => e is the template_statement_tree_formal name
*/
{
estmt(TOK t, loc ll, Pexpr ee, Pstmt ss) : stmt (t,ll,ss) { e=ee; }
};
struct ifstmt : stmt /* IF */
// else_stme==0 => if (e) s
// else_stmt!=0 => if (e) s else else_stmt
{
ifstmt(loc ll, Pexpr ee, Pstmt ss1, Pstmt ss2)
: stmt (IF,ll,ss1) { e=ee; else_stmt=ss2; };
};
struct lstmt : stmt /* LABEL GOTO */
/*
d : s
goto d
*/
{
lstmt(TOK bb, loc ll, Pname nn, Pstmt ss) : stmt (bb,ll,ss) { d=nn; }
};
struct forstmt : stmt { // FOR
forstmt(loc ll, Pstmt fss, Pexpr ee1, Pexpr ee2, Pstmt ss)
: stmt (FOR,ll,ss) { for_init=fss; e=ee1; e2=ee2; }
};
struct block : stmt { // BLOCK { d s }
block(loc ll, Pname nn, Pstmt ss, loc rr = noloc ) : stmt (BLOCK,ll,ss)
{ d=nn; where2=rr; }
#ifndef GRAM
void dcl(Ptable);
Pstmt simpl();
#endif
};
#ifndef GRAM
struct pair : public stmt { // PAIR
pair(loc ll, Pstmt a, Pstmt b) : stmt (PAIR,ll,a) { s2 = b; }
};
#endif
struct nlist {
Pname head;
Pname tail;
nlist(Pname);
void add(Pname n) { tail->n_list = n; tail = n; };
void add_list(Pname);
};
extern Pname name_unlist(nlist*);
struct slist {
Pstmt head;
Pstmt tail;
slist(Pstmt s) { /*Nl++;*/ head = tail = s; };
void add(Pstmt s) { tail->s_list = s; tail = s; };
};
extern Pstmt stmt_unlist(slist*);
struct elist {
Pexpr head;
Pexpr tail;
elist(Pexpr e) { /*Nl++;*/ head = tail = e; };
void add(Pexpr e) { tail->e2 = e; tail = e; };
};
extern Pexpr expr_unlist(elist*);
#ifndef GRAM
extern class dcl_context * cc;
struct dcl_context {
Pname c_this; /* current fct's "this" */
Ptype tot; /* type of "this" or 0 */
Pname not; /* name of "this"'s class or 0 */
Pclass cot; /* the definition of "this"'s class */
Ptable ftbl; /* current fct's symbol table */
Pname nof; /* current fct's name */
void stack() { cc++; *cc = *(cc-1); };
void unstack() { cc--; };
};
#define MAXCONT 20
extern dcl_context ccvec[MAXCONT];
#endif
extern void yyerror(char*);
#ifndef GRAM
extern char* line_format;
extern Plist stat_mem_list;
extern Plist isf_list;
extern Pstmt st_ilist;
extern Pstmt st_dlist;
extern Ptable sti_tbl;
extern Ptable std_tbl;
extern int need_sti( Pexpr e, Ptable tbl = 0, bit is_static_ok = 0 );
Pexpr try_to_coerce(Ptype, Pexpr, char*, Ptable);
extern bit can_coerce(Ptype, Ptype);
extern Ptype np_promote(TOK, TOK, TOK, Ptype, Ptype, TOK);
extern bit enum_promote;
extern int suppress_error;
extern void delete_local();
extern int over_call(Pname, Pexpr);
extern Pname overFound;
extern Pname Nover;
extern Pname Ncoerce;
extern Nover_coerce;
struct ia : node {
Pname local; // local variable for argument
Pexpr arg; // actual arguments for call
Ptype tp; // type of formal argument
ia() { base = XIA; };
};
struct iline : node {
Pname fct_name; /* fct called */
Pin i_next;
Ptable i_table;
int i_slots; // no of arg slots pointer to by i_args
ia* i_args;
iline() { base = XILINE; };
};
extern Pexpr curr_expr;
extern Pin curr_icall;
#define FUDGE111 11111
#define VTOK 22222
#define ITOR 77
extern Pstmt curr_loop;
extern Pblock curr_block;
extern Pstmt curr_switch;
extern loc last_line; // last #line + number of '\n's output since
extern int last_ll; // 0 or line of current stmt/dcl being printed
extern FILE* out_file; // output file descriptor
extern bit Cast;
extern loc no_where;
extern no_of_undcl;
extern no_of_badcall;
extern Pname undcl, badcall;
extern long str_to_long(const char*);
extern int c_strlen(const char* s);
#endif
#ifndef GRAM
extern Pname vec_new_fct;
extern Pname new_fct;
extern Pname del_fct;
extern Pname vec_del_fct;
extern int Nstd; // standard coercion used (derived* =>base* or int=>long or ...)
extern int stcount; // number of names generated using make_name()
Pexpr replace_temp(Pexpr,Pexpr);
void make_res(Pfct);
extern int Pchecked;
Pexpr ptr_init(Pptr,Pexpr,Ptable);
Pexpr call_ctor(Ptable, Pexpr p, Pexpr ctor, Pexpr args, int d = REF, Pexpr vb_args = 0);
Pexpr call_dtor(Pexpr p, Pexpr dtor, Pexpr arg = 0, int d = DOT, Pexpr vb_args = 0);
void check_visibility(Pname, Pname, Pclass, Ptable, Pname);
int make_assignment(Pname);
extern Pname make_tmp(char, Ptype, Ptable);
Pexpr init_tmp(Pname, Pexpr, Ptable);
extern int is_unique_base(Pclass, char*, int, int = 0);
extern Pexpr rptr(Ptype, Pexpr, int);
extern int read_align(char*);
extern void new_init();
extern void Eprint(Pexpr);
extern Pexpr cast_cptr(Pclass ccl, Pexpr ee, Ptable tbl, int real_cast);
extern Pexpr mptr_assign(Pexpr,Pexpr);
extern Pclass Mptr;
#endif
extern bit fake_sizeof; // suppress error message for ``int v[];''
extern TOK lalex();
#ifdef DBG
extern void display_expr( Pexpr, char* = 0, int = 0 );
extern void display_stmt( Pstmt, char* = 0, int = 0 );
extern void display_type( Ptype );
extern void display_namelist( Plist, char* = 0, int = 0 );
extern fprintf(const FILE*, const char* ...);
extern void process_debug_flags( char* );
#define DB(a) if(scan_started){a;}
extern int Adebug; // allocation (ctor/del) debugging
extern int Ddebug; // dcl debugging
extern int Edebug; // expr debugging
extern int Ldebug; // lex/lalex debugging
extern int Mdebug; // trace function matching
extern int Ndebug; // norm debugging
extern int Pdebug; // print debugging
extern int Rdebug; // run() debugging
extern int Sdebug; // simpl debugging
extern int Tdebug; // typ debugging
#define Ydebug yydebug
extern int Ydebug; // yacc debugging
#else
#define DB(a) /**/
#endif
#endif
/* end */
0707071010112043661004440001630000160000010071100466055375100000600000112027dcl.c /*ident "@(#)ctrans:src/dcl.c 1.5" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
dcl.c:
``declare'' all names, that is insert them in the appropriate symbol tables.
Calculate the size for all objects (incl. stack frames),
and find store the offsets for all members (incl. auto variables).
"size.h" holds the constants needed for calculating sizes.
Note that (due to errors) functions may nest
*****************************************************************************/
#include "cfront.h"
#include "size.h"
class dcl_context ccvec[MAXCONT], * cc = ccvec;
int byte_offset;
int bit_offset;
int max_align;
int friend_in_class;
static Pstmt itail;
Pname dclass(Pname, Ptable);
Pname denum(Pname, Ptable);
void merge_init(Pname, Pfct, Pfct);
void dosimpl(Pexpr e, Pname n)
{
//error('d',"dosimpl %k %n",e?e->base:0,n);
if (n==0) {
if (dummy_fct == 0) make_dummy();
n = dummy_fct;
}
Pname cf = curr_fct;
curr_fct = n;
e->simpl();
curr_fct = cf;
}
static Pexpr co_array_init(Pname n, Ptable tbl)
/*
handle simple arrays only. To be done well list_check() must
be rewritten to handle dynamic initialization.
*/
{
// error('d',"Ir forCO%n\[\]",n);
Pexpr init = n->n_initializer;
if (init->base != ILIST) {
error("badIr for array ofCOs %n",n);
return 0;
}
Pexpr el = 0;
Pvec v = Pvec(n->tp);
while (v->base==TYPE) v = Pvec(Pbase(v)->b_name->tp);
Pname cn = v->typ->is_cl_obj();
Pclass cl = cn ? Pclass(cn->tp) : 0;
//error('d',"v %t cl %d %t",v,cl,cl);
int i = v->size;
int count = 0;
Pexpr il2;
for (Pexpr il = init->e1; il; il = il2) {
// generate n[0].cl(initializer),
// ...
// n[max].cl(initializer),
Pexpr e = il->e1;
il2 = il->e2;
il->e2 = 0;
if (e == dummy) break;
//error('d',"il %k e %k",il->base,e?e->base:0);
if (e->base == VALUE) {
switch (e->tp2->base) {
case CLASS:
if (Pclass(e->tp2)!=cl) e = new texpr(VALUE,cl,il);
break;
default:
Pname n2 = e->tp2->is_cl_obj();
if (n2==0 || Pclass(n2->tp)!=cl) e = new texpr(VALUE,cl,il);
}
}
else
e = new texpr(VALUE,cl,il);
e->e2 = new expr(DEREF,n,new ival(count++));
e = e->typ(tbl);
dosimpl(e,cc->nof);
// e->simpl();
if (sti_tbl == tbl) {
Pstmt ist = new estmt(SM,no_where,e,0);
if (st_ilist == 0)
st_ilist = ist;
else
itail->s_list = ist;
itail = ist;
}
else {
el = el ? new expr(G_CM,el,e) : e;
}
}
if (i==0)
v->size = count;
else if (i==count)
;
else if (i<count) {
error("too manyIrs for%n (%d)",n, count);
return 0;
}
else {
// error('d',"too fewIrs for%n (%d)",n, count);
if (cl->has_ictor())
error('s',"too fewIrs for%n",n);
else error( "too fewIrs for%n (C %srequires a defaultK)", n, cl->string );
return 0;
}
return el;
}
int need_sti(Pexpr e, Ptable tbl, bit accept_name)
/*
check if non-static variables or operations are used
INCOMPLETE
*/
{
if (e == 0) return 0;
// error('d',"need_sti: %d - %d %k %t",tbl?1:0,accept_name,e->base,e->tp);
switch (e->base) {
case QUEST:
if (need_sti(e->cond,tbl,0) && tbl==0) return 1;
case PLUS:
case MINUS:
case MUL:
case DIV:
case MOD:
case ER:
case OR:
case ANDAND:
case OROR:
case LS:
case RS:
case EQ:
case NE:
case LT:
case LE:
case GT:
case GE:
case INCR:
case DECR:
case ASSIGN:
if (need_sti(e->e1,tbl,accept_name) && tbl==0) return 1;
// no break;
case UMINUS:
case UPLUS:
case NOT:
case COMPL:
if (need_sti(e->e2,tbl,accept_name) && tbl==0) return 1;
// no break
case SIZEOF:
default:
return 0;
case CAST:
return need_sti(e->e1,tbl,accept_name);
case ADDROF:
{
int i = need_sti(e->e2,tbl,1);
return i;
}
case NAME:
if (accept_name && Pname(e)->n_stclass==STATIC) return 0;
// if ((Pname(e)->n_stclass==AUTO || Pname(e)->n_stclass==REGISTER)
// && strncmp(Pname(e)->string,"__Q",3) != 0 ) {
// error("localN%n inIr for static",e);
// return 0;
// }
if (e->tp->tconst()) {
if (vec_const || fct_const) return 0;
Neval = 0;
e->eval();
if (Neval == 0) return 0;
}
return 1;
case DEREF:
case REF:
case DOT:
if (accept_name||(e->tp && e->tp->base==VEC)) {
int x1 = need_sti(e->e1,tbl,e->base == DOT);
int x2 = need_sti(e->e2,tbl,0);
return x1 || x2;
}
// no break
case ELIST:
// case ILIST:
case G_CM:
case CM:
if (e->base==CM) {
if (need_sti(e->e1,tbl,0) || need_sti(e->e2,tbl,0))
return 1;
else
return 0;
}
case CALL:
case G_CALL:
case NEW:
case GNEW:
case 0: // hack for `new type (expr)'
if (tbl) {
need_sti(e->e1,tbl,accept_name);
need_sti(e->e2,tbl,accept_name);
if ( e->tp && e->tp->base == VEC &&
e->base == NEW || e->base == GNEW )
// preserve ICON,STRING,CCON,FCON
need_sti(Pvec(e->tp)->dim,tbl);
}
else if (e->base == 0)
return 0;
// no break
case ICALL:
return 1;
case ICON:
case STRING:
case CCON:
case FCON:
//error('d',"save %k tbl %d",e->base,tbl);
if (tbl) {
char* p = new char[strlen(e->string)+1];
strcpy(p,e->string);
e->string = p;
}
return 0;
}
}
static void check_def_name( Pname nn, int scope )
{
// error('d', "check_def_name: nn: %n n_sto: %k scope: %k", nn,nn->n_sto,scope );
if ( def_name==0 && pdef_name==0 && friend_in_class == 0 &&
scope == EXTERN && nn->n_scope != STATIC &&
nn->n_oper != NEW && nn->n_oper != DELETE ) {
Pfct f = Pfct(nn->tp);
if (f->body &&
f->f_inline == 0 &&
f->f_imeasure == 0) {
// error('d', "check_def_name: do it: %n", nn );
pdef_name = def_name = nn;
ptbl_init(0);
def_name = 0;
}
}
}
int stat_init = 0; // in an expression initializing a local static
Pname name::dcl(Ptable tbl, TOK scope)
/*
enter a copy of this name into symbol table "tbl";
- create local symbol tables as needed
"scope" gives the scope in which the declaration was found
- EXTERN, FCT, ARG, PUBLIC, or 0
Compare "scope" with the specified storage class "n_sto"
- AUTO, STATIC, REGISTER, EXTERN, OVERLOAD, FRIEND, or 0
After name::dcl()
n_stclass == 0 class or enum member
REGISTER auto variables declared register
AUTO auto variables not registers
STATIC statically allocated object
n_scope == 0 private class member
PUBLIC public class member
EXTERN name valid in this and other files
STATIC name valid for this file only
FCT name local to a function
ARG name of a function argument
ARGT name of a type defined in an
argument list
ARGS temporary class object with dtor in
initialization of a local static
typecheck function bodies;
typecheck initializers;
note that functions (error recovery) and classes (legal) nest
The return value is used to chain symbol table entries, but cannot
be used for printout because it denotes the sum of all type information
for the name
names of typenames are marked with n_oper==TNAME
WARNING: The handling of scope and storage class is cursed!
*/
{
Pname nn;
Ptype nnt = 0;
Pname odcl = Cdcl;
int sti_vb = 0; // set if initialize with virtual base class
// if (this == 0) error('i',"0->N::dcl()");
// if (tbl == 0) error('i',"%n->N::dcl(tbl=0,%k)",this,scope);
// if (tbl->base != TABLE) error('i',"%n->N::dcl(tbl=%d,%k)",this,tbl->base,scope);
// if (tp == 0) error('i',"N::dcl(%n,%k)T missing",this,scope);
Cdcl = this;
Ptype tx = tp;
DB( if(Ddebug>=1) error('d',"dcl %n %t",this,tx); );
// error('d',"dcl %n %t cc->cot: %d",this,tx,cc?cc->cot:0);
while (tx->base == TYPE) tx = Pbase(tx)->b_name->tp;
switch (base) {
case TNAME:
nn = tbl->look(string,0);
tp->dcl(tbl);
if (nn && nn->lex_level == lex_level) {
//error('d', "dcl: cot: %s ccl: %s", cc->cot?cc->cot->string:"notset", ccl?ccl->string:"notset");
if ( tp->check(nn->tp,0) )
error("%n declared as %t and %t",nn,nn->tp,tp);
else if ( nn->base == NAME && cc->cot == 0 &&
(tp->base != COBJ || tp->base != EOBJ))
error("%n declared as identifier and typedef", nn );
Cdcl = odcl;
return 0;
}
PERM(tp);
nn = new name(string);
nn->base = TNAME;
nn->tp = tp;
Pname tn = tbl->insert(nn,0);
if (n_key == NESTED) {
tn->n_key = NESTED;
tn->tpdef = tpdef;
}
delete nn;
Cdcl = odcl;
return this;
case NAME:
switch (n_oper) {
case COMPL:
if (tp->base != FCT) {
error("~%s notF",string);
n_oper = 0;
}
break;
case TNAME:
if (tp->base != FCT) n_oper = 0;
break;
}
break;
default:
error('i',"NX in N::dcl()");
}
if (n_qualifier) {
// c::f()
// class function,
// friend declaration, or
// static member initializer
Pname cn = n_qualifier;
switch (cn->base) {
case TNAME:
break;
case NAME:
cn = gtbl->look(cn->string,0);
if (cn && cn->base==TNAME) break;
default:
error("badQr%n for%n",n_qualifier,this);
Cdcl = odcl;
return 0;
}
while (cn->tp->base == TYPE) cn->tp = Pbase(cn->tp)->b_name->tp;
// error('d',"actualQr%n %t",cn,cn->tp);
if (cn->tp->base != COBJ) {
error(&where,"Qr%nnot aCN",n_qualifier);
Cdcl = odcl;
return 0;
}
cn = Pbase(cn->tp)->b_name;
if (n_oper) check_oper(cn);
Pclass cl = Pclass(cn->tp);
if (cl == cc->cot) {
n_qualifier = 0;
goto xdr;
}
else if ((cl->defined&(DEFINED|SIMPLIFIED)) == 0) {
error("C%nU",cn);
Cdcl = odcl;
return 0;
}
else if (cl->c_body==1) //III
cl->dcl_print(0);
Ptable etbl = cl->memtbl;
Pname x = etbl->look(string,0);
if (x==0 || x->n_table!=etbl) {
error("%n is not aM of%n",this,cn);
Cdcl = odcl;
return 0;
}
if (tp->base == FCT) { //III
// if (friend_in_class==0 && Pfct(tp)->body==0) { // c::f(); needed for friend
if (friend_in_class==0
&& n_sto!=FRIEND
&& Pfct(tp)->body==0) { // c::f(); needed for friend
error("QdN%n inFD",x);
Cdcl = odcl;
return 0;
}
if (Pfct(tp)->body==0) {
Pfct(tp)->memof = cl;
int xx;
if (x->tp->base==OVERLOAD)
xx = Pgen(x->tp)->find(Pfct(tp),0)==0;
else
xx = x->tp->check(tp,0);
if (xx) {
error("%n is not aM of%n",this,cn);
Cdcl = odcl;
return 0;
}
}
}
else {
if (x->n_stclass != STATIC) { // e.g. int c::i = 7
error("D of non staticCM %n",this);
Cdcl = odcl;
return 0;
}
if (n_sto) error("staticCM declared%k",n_sto);
tbl = etbl;
}
}
xdr:
if (n_oper
&& tp->base!=FCT
&& n_sto!=OVERLOAD) error("operator%k not aF",n_oper);
/* if a storage class was specified
check that it is legal in the scope
else
provide default storage class
some details must be left until the type of the object is known
*/
n_stclass = n_sto;
n_scope = scope; /* default scope & storage class */
switch (n_sto) {
default:
error('i',"unX %k",n_sto);
case FRIEND:
{
Pclass cl = cc->cot;
switch (scope) {
case 0:
case PUBLIC:
break;
default:
error("friend%n not inCD(%k)",this,scope);
base = 0;
Cdcl = odcl;
return 0;
}
switch (n_oper) {
case 0:
case NEW:
case DELETE:
case CTOR:
case DTOR:
case TYPE:
n_sto = 0;
break;
default:
n_sto = OVERLOAD;
}
switch (tx->base) {
case COBJ:
nn = Pbase(tx)->b_name;
break;
case CLASS:
nn = this;
break;
case FCT:
cc->stack();
cc->not = 0;
cc->tot = 0;
cc->cot = 0;
friend_in_class++;
// n_sto = EXTERN;
n_sto = 0;
nn = dcl(gtbl,EXTERN);
if (nn == 0) {
Cdcl = odcl;
return 0;
}
friend_in_class--;
cc->unstack();
if (nn->tp->base == OVERLOAD) nn = Pgen(nn->tp)->find(Pfct(tx),1);
break;
default:
error("badT%tof friend%n",tp,this);
Cdcl = odcl;
return 0;
}
PERM(nn);
cl->friend_list = new name_list(nn,cl->friend_list);
Cdcl = odcl;
return nn;
}
case OVERLOAD:
if (strict_opt||warning_opt)
error(strict_opt?0:'w',"`overload' used (anachronism)");
n_sto = 0;
// ignore overload!
switch (tp->base) {
case FCT:
break;
default:
base = 0;
Cdcl = odcl;
return this;
}
break;
case REGISTER:
if (tp->base == FCT) {
error('w',"%n: register (ignored)",this);
goto ddd;
}
case AUTO:
switch (scope) {
case 0:
case PUBLIC:
case EXTERN:
error("%k not inF",n_sto);
goto ddd;
}
if (n_sto==AUTO) n_sto = 0; // always redundant
break;
case EXTERN:
switch (scope) {
case ARG:
//error("externA");
goto ddd;
case 0:
case PUBLIC:
/* extern is provided as a default for functions without body */
if (tp->base != FCT) error("externM%n",this);
goto ddd;
case FCT:
{
Pname nn = gtbl->look( string, 0 );
tp->dcl(tbl);
if ( nn && tp->base != FCT &&
tp->check(nn->tp,0))
{
error("twoDs of%n;Ts:%t and%t",this,nn->tp,tp);
Cdcl = odcl;
return 0;
}
}
}
n_stclass = STATIC;
n_scope = EXTERN; /* avoid FCT scoped externs to allow better checking */
break;
case STATIC:
switch (scope) {
case ARG:
//error("static used forA%n",this);
goto ddd;
case 0:
case PUBLIC:
n_stclass = STATIC;
n_scope = scope;
break;
default:
n_scope = STATIC;
}
break;
case 0:
ddd:
switch (scope) { /* default storage classes */
case EXTERN:
n_scope = EXTERN;
n_stclass = STATIC;
break;
case FCT:
if (tp->base == FCT) {
n_stclass = STATIC;
n_scope = EXTERN;
}
else
n_stclass = AUTO;
break;
case ARG:
n_stclass = AUTO;
break;
case 0:
case PUBLIC:
n_stclass = 0;
break;
}
}
/*
now insert the name into the appropriate symbol table,
and compare types with previous declarations of that name
do type dependent adjustments of the scope
*/
//error('d',"sw %d",tx->base);
static int warn_ldouble=0;
switch (tx->base) {
case ASM:
{ Pbase b = Pbase(tp);
Pname n = tbl->insert(this,0);
n->assign();
n->use();
char* s = (char*) b->b_name; // save asm string. Shoddy
int ll = strlen(s);
char* s2 = new char[ll+1];
strcpy(s2,s);
b->b_name = Pname(s2);
Cdcl = odcl;
return this;
}
case CLASS:
tp = tx;
nn = dclass(this,tbl);
Cdcl = odcl;
return nn;
case ENUM:
tp = tx;
nn = denum(this,tbl);
Cdcl = odcl;
return nn;
case FCT:
tp = tx;
nn = dofct(tbl,scope);
if (nn == 0) {
Cdcl = odcl;
return 0;
}
// error('d', "%s n_oper: %k, scope: %k", string, n_oper, scope );
if (pdef_name == 0) check_def_name(nn, scope);
break;
case FIELD:
switch (n_stclass) {
case 0:
case PUBLIC:
break;
default:
error("%k field",n_stclass);
n_stclass = 0;
}
if (cc->not==0 || cc->cot->csu==UNION || cc->cot->csu==ANON) {
error(cc->not?"field in union":"field not inC");
PERM(tp);
Cdcl = odcl;
return this;
}
if (string) {
nn = tbl->insert(this,0);
n_table = nn->n_table;
if (Nold) error("twoDs of field%n",this);
}
tp->dcl(tbl);
field_align();
break;
case COBJ:
{ Pclass cl = Pclass(Pbase(tx)->b_name->tp);
//error('d',&where,"dcl %n; tx->base == cobj",this);
if (cl->lex_level > lex_level)
error("C%t is not visible in this scope",cl);
if (cl->csu == ANON) { // export member names to enclosing scope
if (tbl==gtbl && n_sto!=STATIC) error("extern anonymous union (declare as static)");
char* p = cl->string;
while (*p++ != 'C'); /* sneaky */
int uindex = (int)str_to_long(p);
// error('d', "%n->dcl() n_scope: %k n_protect: %k", this, n_scope, n_protect );
// cannot cope with use counts for ANONs:
Pbase(tp)->b_name->n_used = 1;
Pbase(tp)->b_name->n_assigned_to = 1;
Ptable mtbl = cl->memtbl;
int i, err_msg = 0;
for (Pname nn=mtbl->get_mem(i=1); nn; nn=mtbl->get_mem(++i)) {
if (nn->tp->base == FCT) {
error("FM%n for anonymous union",nn);
break;
}
Ptable tb = nn->n_table;
nn->n_table = 0;
nn->n_scope = n_protect?n_protect:n_scope;
Pname n = tbl->insert(nn,0);
if (Nold) {
error("twoDs of%n (one in anonymous union)",nn);
break;
}
Pclass tc;
if (tc = cl->in_class)
--n->lex_level;
if ( tc && tc->csu == ANON) {
//error('d', "tc->csu anon %k %s", tc->csu, string );
if ( n->n_anon ) {
if ( !err_msg )
error('s', "anonymous unions nested deeper than 2 levels" );
err_msg = 1;
}
n->n_anon = string;
}
n->n_union = uindex;
nn->n_table = tb;
}
}
if (cl->c_abstract) error("D ofO of abstractC%t",cl);
goto cde;
}
case VOID:
if (n_scope != ARG) {
error("badBT:%k%n",tx->base,this);
Cdcl = odcl;
return 0;
}
break;
case LDOUBLE:
if (warn_ldouble==0 && ansi_opt==0) {
++warn_ldouble;
error('w',"long double supported under ``+a1'' option only, generating ``double%n''", this);
}
goto cde;
case PTR:
case VEC:
case RPTR:
tp->dcl(tbl);
default:
cde:
//error('d',"cde: %n %t",this,tp);
nn = tbl->insert(this,0);
n_table = nn->n_table;
if (Nold) {
if ( nn->base == PUBLIC ) { // X::i
error("twoDs ofCM%n", nn);
Cdcl = odcl;
return 0;
}
if (nn->tp->base == ANY) goto zzz;
if (tp->check(nn->tp,0)) {
error("twoDs of%n;Ts:%t and%t",this,nn->tp,tp);
Cdcl = odcl;
return 0;
}
//error('d',"%n: %k %k scope %k",this,n_sto,nn->n_sto,nn->n_scope);
if (n_sto && n_sto!=nn->n_scope) {
if (n_sto==EXTERN && nn->n_scope==STATIC) {
error('w',"%n declared extern after being declared static",this);
goto ext_fudge;
}
else
error("%n declared as both%k and%k",this,n_sto,(nn->n_sto)?nn->n_sto:(scope==FCT?AUTO:EXTERN));
}
else if (nn->n_scope==STATIC && n_scope==EXTERN) {
error('w',"static%n followed by definition",this);
ext_fudge:
if (n_initializer) {
// error('d',"static%n redefined (WIr)",this);
n_initializer = 0;
}
n_sto = EXTERN;
}
else if (nn->n_sto==STATIC && n_sto==STATIC )
error("static%n declared twice",this);
else {
if (n_sto==0
&& nn->n_sto==EXTERN
&& n_initializer
&& tp->tconst())
n_sto = EXTERN;
n_scope = nn->n_scope;
switch (scope) {
case FCT:
if (n_sto != EXTERN) {
error("twoDs of%n",this);
Cdcl = odcl;
return 0;
}
break;
case ARG:
error("twoAs%n",this);
Cdcl = odcl;
return 0;
case 0:
case PUBLIC:
error("twoDs ofM%n",this);
Cdcl = odcl;
return 0;
case EXTERN:
if (n_sto==0) {
switch(nn->n_sto) {
case 0:
error("two definitions of%n",this);
Cdcl = odcl;
return 0;
case EXTERN:
if(nn->n_initializer) {
error("two definitions of%n",this);
Cdcl = odcl;
}
else
nn->n_sto=0;
break;
}
}
else if(n_sto==EXTERN && n_initializer) {
switch(nn->n_sto) {
case 0:
error("two definitions of%n",this);
Cdcl = odcl;
return 0;
case EXTERN:
nn->n_sto=0;
break;
}
}
break;
}
}
n_scope = nn->n_scope;
/* n_val */
if (n_initializer) {
if (nn->n_initializer || nn->n_val) error("twoIrs for%n",this);
nn->n_initializer = n_initializer;
}
if (tp->base == VEC) {
// handle: extern v[]; v[200];
// and extern u[10]; u[11];
Ptype ntp = nn->tp;
while (ntp->base == TYPE) ntp = Pbase(ntp)->b_name->tp;
if (Pvec(ntp)->dim == 0) Pvec(ntp)->dim = Pvec(tp)->dim;
if (Pvec(ntp)->size) {
if (Pvec(tp)->size
&& Pvec(ntp)->size!=Pvec(tp)->size)
error("bad array size for%n: %d %dX",this,Pvec(tp)->size,Pvec(ntp)->size);
}
else
Pvec(ntp)->size = Pvec(tp)->size;
}
}
else {
//error('d',"%n %t scope %d sto %k",this,tp,scope,n_sto);
if (scope!=ARG
&& n_sto!=EXTERN
&& (!((scope==0 || scope==PUBLIC) && n_sto==STATIC)) // static member
&& n_initializer==0
&& tp->base==VEC
&& Pvec(tp)->size==0)
error(&where,"dimension missing for array%n",this);
if (scope==EXTERN
&& n_sto==0
&& tp->tconst()
&& vec_const==0
&& fct_const==0)
nn->n_sto = n_sto = STATIC;
}
zzz:
if (base != TNAME) {
Ptype t = nn->tp;
if (t->base == TYPE) {
Ptype tt = Pbase(t)->b_name->tp;
if (tt->base == FCT) nn->tp = t = tt;
}
switch (t->base) {
case FCT:
case OVERLOAD:
break;
default:
fake_sizeof = 1;
switch (nn->n_stclass) {
default:
if (nn->n_scope != ARG) {
int x = t->align();
int y = t->tsizeof();
if (max_align < x) max_align = x;
while (0 < bit_offset) {
byte_offset++;
bit_offset -= BI_IN_BYTE;
}
bit_offset = 0;
if (byte_offset && 1<x) byte_offset = ((byte_offset-1)/x)*x+x;
nn->n_offset = byte_offset;
byte_offset += y;
}
break;
case STATIC:
if (n_sto != EXTERN
&& nn->n_scope
&& nn->n_scope!=PUBLIC)
t->tsizeof(); // check that size is known
}
fake_sizeof = 0;
}
}
{ Ptype t = nn->tp;
int const_old = const_save;
bit vec_seen = 0;
Pexpr init = n_initializer;
lll:
// error('d',"lll %n %t init %d %k",this,t,init,init?init->base:0);
switch (t->base) {
case COBJ:
{ Pname cn = Pbase(t)->b_name;
Pclass cl = (Pclass)cn->tp;
Pname ctor = cl->has_ctor();
Pname dtor = cl->has_dtor();
int stct = 0;
//error('d',"obj %n; class '%s'; ctor '%s'; dtor '%s'",nn,cn->string,ctor?ctor->string:"???",dtor?dtor->string:"???");
if (dtor) {
Pstmt dls;
// if dtor is not public check scope of class object
//error('d',"dcl %n has dtor",nn);
if (dtor->n_scope != PUBLIC) {
//error('d',"dcl %n->n_scope: %d fct %n",nn,nn->n_scope,cc->nof);
switch (nn->n_scope) {
case ARG:
case 0:
case PUBLIC:
break;
default:
check_visibility( dtor, 0, cl, tbl, cc->nof );
}
// if (nn->n_scope == FCT)
// check_visibility( dtor, 0, cl, tbl, cc->nof );
// else if ( nn->n_sto != EXTERN )
// error("%k%n cannot access%n: %sM",nn->n_scope,nn,dtor,dtor->n_protect?"protected":"private");
}
switch ( nn->n_scope ) {
case 0:
case PUBLIC:
if (n_stclass==STATIC) { //III
Pclass cl = Pclass(nn->n_table->t_name->tp);
if (cl->defined&DEFINED) goto dtdt;
}
break;
case EXTERN:
if (n_sto==EXTERN) break;
case STATIC:
{ Pexpr c;
dtdt:
// local static class objects have destructors set up in simpl2.c
// special case: temporary class object generated in init expression
if (stat_init && scope == ARGS ) {
nn->n_scope = ARGS;
goto ggg;
}
if ( nn->lex_level
&& nn->n_sto == STATIC ) {
if (ctor==0)
error('s',"local static%n has%n but noK(add%n::%n())", nn, dtor, cn, cn );
goto static_init;
}
Ptable otbl = tbl;
// to collect temporaries generated
// in static destructors where we
// can find them again (in std_tbl)
if (std_tbl == 0) std_tbl = new table(8,gtbl,0);
tbl = std_tbl;
if (vec_seen) {
c = cdvec(vec_del_fct,nn,cl,dtor,0,zero);
} else { // nn->cl::~cl(0);
c = call_dtor(nn,dtor,0,DOT,one);
}
c->tp = any_type; // avoid another check
dls = new estmt(SM,nn->where,c,0);
// destructors for statics are executed in reverse order
if (st_dlist) dls->s_list = st_dlist;
st_dlist = dls;
tbl = otbl;
} // case STATIC
} // switch nn->n_scope
} // if dtor
// local static class objects must defer setting up static dtor
static_init:
if (ctor) {
// error('d',"ctor %n scope %k",ctor,nn->n_scope);
Pexpr oo = nn;
for (int vi=vec_seen; vi; vi--) oo = oo->contents();
int sti = 0;
switch (nn->n_scope) {
case EXTERN:
if (init==0 && n_sto==EXTERN) goto ggg;
case STATIC:
if (tbl == gtbl)
sti = 1;
else
stct = 1;
default:
if (vec_seen && init) {
if (1<vec_seen) {
/* ?????
if (init->base != ILIST)
error("badIr forO ofC %t withK%n",cl,this);
else
*/
error('s',"Ir for multi-dimensional array%n ofOsofC %t withK",this,cl);
}
else {
if (sti) {
if (sti_tbl==0) sti_tbl = new table(8,gtbl,0);
const_save = 1;
(void) co_array_init(nn,sti_tbl);
const_save = 0;
n_initializer = init = 0;
}
else {
n_initializer = init = co_array_init(nn,tbl);
if (stct)
nn->n_initializer = n_initializer = init = new expr( STAT_INIT, init, 0 );
}
}
goto ggg;
}
break;
case PUBLIC:
case 0:
if (n_stclass==STATIC) { //III
Pclass cl = Pclass(nn->n_table->t_name->tp);
if (cl->defined&DEFINED) {
sti = 1;
break;
}
}
{
Pname c;
if (vec_seen) {
c = cl->has_ictor();
if (c == 0)
error("array ofC%n that does not have aK taking noAs",cn);
else if (Pfct(c->tp)->nargs)
error("defaultAs forK for array ofC%n",cn);
}
}
// no break
case ARG:
goto ggg;
}
const_save = 1;
nn->assign();
Ptable otbl = tbl;
if (sti) { // to collect temporaries generated
// in static initializers where we
// can find them again (in sti_tbl)
if (sti_tbl == 0) sti_tbl = new table(8,gtbl,0);
tbl = sti_tbl;
if (n_sto == EXTERN) nn->n_sto = n_sto = 0;
}
if (init) {
// error('d',"init %k",init->base);
if (init->base==VALUE) {
switch (init->tp2->base) {
case CLASS:
// error('d',"class %t %t",Pclass(init->tp2),cl);
if (Pclass(init->tp2)!=cl) goto inin;
break;
default:
Pname n2 = init->tp2->is_cl_obj();
// error('d',"default %t %t",n2->tp,cl);
if (n2==0 || Pclass(n2->tp)!=cl) goto inin;
}
Pexpr ee = init->e1;
// error('d',"init->e1 %k",ee->base);
if (ee && vec_seen==0)
switch (ee->base) {
case CALL: // T a = f();
init = ee;
goto inin;
case ELIST: // T a(f());
if (ee->e1->base==CALL
&& ee->e2 == 0) {
init = ee->e1;
goto inin;
}
} // end switch
init->e2 = oo;
init = init->typ(tbl);
if (init->base == G_CM) // beware of type conversion operators
switch (init->tp2->base) {
case CLASS:
if (Pclass(init->tp2)!=cl) goto inin;
break;
default:
Pname n2 = init->tp2->is_cl_obj();
if (n2==0 || Pclass(n2->tp)!=cl) goto inin;
}
}
else {
inin:
// error('d',"inin %k",init->base);
init = init->typ(tbl);
//error('d', "inin: init->typ: %d %k n->tp %t init->tp %t",init->base,init->base,nn->tp,init->tp);
if (init->base==G_CM
&& nn->tp->check(init->tp,0)==0)
(void) replace_temp(init,nn->address());
else
init = class_init(nn,nn->tp,init,tbl);
}
}
else if (vec_seen == 0) {
//error('d',"make value");
init = new texpr(VALUE,cl,0);
init->e2 = oo;
init = init->typ(tbl);
}
Pname c;
if (vec_seen) {
c = cl->has_ictor();
if (c == 0)
error("array ofC%n that does not have aK taking noAs",cn);
else if (Pfct(c->tp)->nargs)
error("defaultAs forK for array ofC%n",cn);
}
// error( 'd', "stct: %d init: %d", stct, init );
if (stct) {
if (tbl!=gtbl && nn->n_sto==EXTERN) {
error(&where,"Id local extern%n",this);
init = 0;
}
else if (init)
init->base = STAT_INIT;
else {
if (tp->base == VEC && Pvec(tp)->size ) {
Pexpr ilist = 0;
for (int i=Pvec(tp)->size; i>0; i--) {
Pexpr e = new texpr(VALUE,cl,0);
ilist = new expr(ELIST, e, ilist);
}
nn->n_initializer=new expr(ILIST,ilist,0);
init = co_array_init(nn,tbl);
nn->n_initializer = n_initializer = init = new expr( STAT_INIT, init, 0 );
}
else
error('s',"local staticC%n (%t)",this, tp);
}
}
// error('d', "%n->sti: %d vec_seen: %d n_stclass: %k", this, sti, vec_seen, n_stclass );
if (sti) {
if (vec_seen) { // _vec_new(vec,noe,sz,ctor);
// error('d', "%n->dcl: n_stclass: %k ", this, n_stclass );
if ( n_stclass == STATIC && n_initializer ) {
const_save = 1;
(void) co_array_init(nn,sti_tbl);
const_save = 0;
n_initializer = init = 0;
goto ggg;
}
init = cdvec(vec_new_fct,nn,cl,c,-1,0);
init->tp = any_type;
}
else {
switch (init->base) {
case DEREF: // *constructor?
if (init->e1->base == G_CALL) {
Pname fn = init->e1->fct_name;
if (fn==0 || fn->n_oper!=CTOR) goto as;
init = init->e1;
break;
}
goto as;
case G_CM:
init = init->e1;
// suppress further type checking
if (init->tp == 0) init->tp= any_type;
break;
case ASSIGN:
if (init->e1 == nn) break; // simple assignment
as:
default:
init = new expr(ASSIGN,nn,init);
}
}
Pstmt ist = new estmt(SM,nn->where,init,0);
// constructors for statics are executed in order
if (st_ilist == 0)
st_ilist = ist;
else
itail->s_list = ist;
itail = ist;
init = 0; // suppress further processing
} // if (sti)
nn->n_initializer = n_initializer = init;
const_save = const_old;
tbl = otbl;
}
else if (init == 0) // no initializer
goto str;
else if (cl->is_simple()
// && cl->csu!=UNION // accept ANSIism
&& cl->csu!=ANON
) { // struct
init = init->typ(tbl);
if (nn->tp->check(init->tp,0)==0
&& init->base==G_CM)
(void) replace_temp(init,nn->address());
else {
if (ansi_opt==0
&& init->base==ILIST
&& cl->csu==UNION)
error('s',"initialization of union withIL");
goto str;
}
}
else if (init->base == ILIST) { // class or union
error("cannotI%nWIrL",nn);
}
else { // bitwise copy ok?
// possible to get here?
init = init->typ(tbl);
//error('d',"init22 %t %t",nn->tp,init->tp);
if (nn->tp->check(init->tp,0)==0) {
if (init->base==G_CM)
(void) replace_temp(init,nn->address());
else
goto str;
}
goto str;
// else
// error("cannotI%n:%k %s has noK",nn,cl->csu,cl->string);
}
break;
}
case VEC:
t = Pvec(t)->typ;
vec_seen++;
goto lll;
case TYPE:
if (init==0 && Pbase(t)->b_const) {
switch (n_scope) {
case ARG:
break;
case 0:
case PUBLIC:
if ( cc->cot ) break;
default: {
Pname n = t->is_cl_obj();
Pclass cl;
if ( n ) cl = Pclass( n->tp );
if (n_sto!=EXTERN &&
(n==0 || (cl->has_ctor()==0 && is_empty(cl,1)==0)))
error("uninitialized const%n",this);
}
}
}
t = Pbase(t)->b_name->tp;
goto lll;
case RPTR:
if (init) {
if (nn->n_scope == ARG) break;
if (Pptr(nn->tp)->memof) error("R toCM%n ofT%t illegal",nn,nn->tp);
ref_initializer++;
init = init->typ(tbl);
ref_initializer--;
Nvirt = 0; // set within ref_init() call
const_ptr = Pbase(Pptr(t)->typ)->tconst();
if (n_sto==STATIC
&& init->lval(0)==0
&& fct_const==0)
error("Ir for staticR%n not an lvalue",this);
else
nn->n_initializer = n_initializer = init = ref_init(Pptr(t),init,tbl);
const_ptr = 0;
if (Nvirt == VIRTUAL) sti_vb = 1;
nn->assign();
if (init->base==ILIST && init->e2==0) {
new_list(init);
list_check(nn,nn->tp,0,tbl);
if (next_elem()) error(&where,"IrL too long");
}
}
else {
switch (nn->n_scope) {
default:
if (n_sto == EXTERN) break;
error("uninitializedR%n",this);
case ARG:
break;
case PUBLIC:
case 0:
//III if (n_sto == STATIC) error("a staticM%n cannot be aR",this);
// error('d', "%n->dcl cot: %s", this, cc->cot?cc->cot->string:"notset");
if ( cc->cot == 0 )
error("uninitializedR%n",this);
break;
}
}
goto stgg;
default:
str:
// error('d',"str %n %t %k %t",this,tp,init?init->base:0,init?init->tp:0);
if (init == 0) {
switch (n_scope) {
case ARG:
break;
case 0:
case PUBLIC:
if ( cc->cot ) break;
default:
if (n_sto!=EXTERN && t->tconst()) error("uninitialized const%n",this);
}
break;
}
const_save = const_save
|| n_scope==ARG
|| (t->tconst() && vec_const==0);
if ( tp->base == PTR ) {
if ( cc && cc->nof
&& Pfct(cc->nof->tp)->f_const )
cm_const_save = Pbase(Pptr(tp)->typ)->b_const;
const_ptr = Pbase(Pptr(tp)->typ)->b_const;
}
if (n_sto==STATIC) stat_init++;
nn->n_initializer = n_initializer = init = init->typ(tbl);
if (n_sto==STATIC) stat_init--;
cm_const_save = 0;
const_ptr = 0;
if (const_save) PERM(init);
nn->assign();
const_save = const_old;
//error('d',"init2 %k %t",init->base,init->tp);
switch (init->base) {
case ILIST:
if (init->e2) goto dfdf;//break; // pointer to member
new_list(init);
list_check(nn,nn->tp,0,tbl);
if (next_elem()) error(&where,"IrL too long");
break;
case STRING:
{ Ptype v = nn->tp;
while (v->base == TYPE) v = Pbase(v)->b_name->tp;
if (v->base==VEC) {
Ptype vv = Pvec(v)->typ;
while(vv->base==TYPE) vv = Pbase(vv)->b_name->tp;
if(vv->base==CHAR) {
int sz = Pvec(v)->size;
int isz = Pvec(init->tp)->size;
if (sz == 0)
Pvec(v)->size = isz;
else if (sz < isz)
error(&where,"Ir too long (%d characters) for%n[%d]",isz,nn,sz);
break;
}
}
// no break
}
default:
dfdf:
{ Ptype nt = nn->tp;
int ntc = Pbase(nt)->b_const;
if (vec_seen) {
error("badIr for array%n",nn);
break;
}
tlx:
switch (nt->base) {
case TYPE:
nt = Pbase(nt)->b_name->tp;
ntc |= Pbase(nt)->b_const;
goto tlx;
case INT:
case CHAR:
case SHORT:
case EOBJ:
// if (init->base==ICON && init->tp==long_type)
// error('w',"longIr constant for%k%n",nn->tp->base,nn);
{ Ptype t = init->tp;
csi:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp; goto csi;
case LONG:
case FLOAT:
case DOUBLE:
case LDOUBLE:
error('w',"%tIdW %t",nt,init->tp);
}
}
// no break
case LONG:
if (Pbase(nt)->b_unsigned
&& init->base==UMINUS
&& init->e2->base==ICON)
error('w',"negativeIr for unsigned%n",nn);
if (ntc && scope!=ARG) {
long i;
Neval = 0;
i = init->eval();
if (Neval == 0) {
DEL(init);
nn->n_evaluated = n_evaluated = 1;
nn->n_val = n_val = i;
DEL(init);
nn->n_initializer = n_initializer = 0;
}
}
break;
case PTR:
Nvirt = 0;
nn->n_initializer = n_initializer = init = ptr_init(Pptr(nt),init,tbl);
//display_expr(init,string);
if (Nvirt == VIRTUAL) sti_vb = 1;
if (Pchecked) goto stgg;
}
{ Pexpr x = try_to_coerce(nt,init,"initializer",tbl);
if (x) {
nn->n_initializer = n_initializer = init = x;
goto stgg;
}
}
//error('d',"check %t %t %k",nt,init->tp,init->base);
// if (nt->check(init->tp,ASSIGN)) {
Pname c1 = nt->is_cl_obj();
Pname c2 = init->tp->is_cl_obj();
if (c1
&& c2
&& Pclass(c2->tp)->has_base(Pclass(c1->tp))) {
init = new texpr(CAST,new ptr(PTR,nt),init->address());
init = init->typ(tbl);
nn->n_initializer = n_initializer = init = init->contents();
goto stgg;
}
if (nt->check(init->tp,ASSIGN)) {
error("badIrT%t for%n (%tX)",init->tp,this,nn->tp);
break;
}
}
stgg:
// error('d',"stgg %n init %k %t Nvirt: %k",this,init?init->base:0,init?init->tp:0, Nvirt);
if (init && n_stclass==STATIC && (sti_vb || need_sti(init))) {
/* check if non-static variables are used */
int local = (0<lex_level);
// error('d',"init %n %t local %d",nn,init->tp,local);
if (local==0) need_sti(init,tbl); // save consts
Pptr r = nn->tp->is_ref(); //III
if (r) init = init->address();
init = new expr(ASSIGN,nn,init);
// error('d',"init r %t: nn %n %t init %t",r,nn,nn->tp,init->tp);
if (r)
init->tp = nn->tp;
else if (nn->tp!=init->tp) { // static member refs
TOK t = nn->tp->set_const(0); //JJJ
init = init->typ(tbl);
nn->tp->set_const(t); //JJJ
}
if (local) {
if (init->base != ASSIGN) error('s',"Ir for local static too complicated");
if (nn->n_sto == EXTERN) {
error(&where,"Id local extern%n",this);
init = 0;
}
else init->base = STAT_INIT;
nn->n_initializer = n_initializer = init;
}
else {
Pstmt ist = new estmt(SM,nn->where,init,0);
// constructors for statics are executed in order
if (st_ilist == 0)
st_ilist = ist;
else
itail->s_list = ist;
itail = ist;
nn->n_initializer = n_initializer = init = 0; // suppress further processing
nn->n_val = n_val = 1;
}
}
} /* switch */
} /* block */
} /* default */
} /* switch */
ggg:
//error('d',"ggg");
PERM(nn);
switch (n_scope) {
case FCT:
nn->n_initializer = n_initializer;
break;
default:
{ Ptype t = nn->tp;
px:
PERM(t);
switch (t->base) {
case PTR:
case RPTR:
case VEC: t = Pptr(t)->typ; goto px;
case TYPE: t = Pbase(t)->b_name->tp; goto px;
case FCT: t = Pfct(t)->returns; goto px; /* args? */
}
}
}
Cdcl = odcl;
return nn;
}
0707071010112043671004440001630000160000010172100466055375400000700000067044dcl2.c /*ident "@(#)ctrans:src/dcl2.c 1.2" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
dcl2.c:
*************************************************************************/
#include "cfront.h"
#include "size.h"
Pname conv_dominates(Pname on1, Pname on2)
/*
compare for duplicates and dominance:
on1 and on2 are two conversion operator functions
return the the one that dominates the other (according to the
class hierarchy) otherwise 0 (0 thus indicats ambiguous conversion)
*/
{
Ptype r1 = on1->tp->base==FCT ? Pfct(on1->tp)->returns
: Pfct(Pgen(on1->tp)->fct_list->f->tp)->returns;
Ptype r2 = on2->tp->base==FCT ? Pfct(on2->tp)->returns
: Pfct(Pgen(on2->tp)->fct_list->f->tp)->returns;
//error('d',"conv_dominates(%n,%n)",on1,on2);
if (r1==r2 || r1->check(r2,0)==0) return on1;
Pptr p1 = r1->is_ptr_or_ref();
Pptr p2 = r2->is_ptr_or_ref();
if (p1 && p2) {
Pname cn1 = p1->typ->is_cl_obj();
Pname cn2 = p2->typ->is_cl_obj();
if (cn1 && cn2) {
// is_cl_obj() returns b_name
// Pclass c1 = Pclass(Pbase(cn1->tp)->b_name->tp);
// Pclass c2 = Pclass(Pbase(cn2->tp)->b_name->tp);
Pclass c1 = Pclass(cn1->tp);
Pclass c2 = Pclass(cn2->tp);
if (c1 && c2) {
//if (c1==c2 || c1->has_base(c2))
if (c1->has_base(c2))
return on1;
else if (c2->has_base(c1))
return on2;
}
}
}
return 0;
}
Pstmt curr_loop;
Pstmt curr_switch;
Pblock curr_block;
void stmt::reached()
{
register Pstmt ss = s_list;
if (ss == 0) return;
switch (ss->base) {
case LABEL:
case CASE:
case DEFAULT:
break;
default:
error('w',&ss->where,"S after%k not reached",base);
for (; ss; ss=ss->s_list) { // delete unreacheable code
switch (ss->base) {
case LABEL:
case CASE:
case DEFAULT: // reachable
s_list = ss;
return;
case DCL: // the dcl may be used later
// keep to avoid cascading errors
case IF:
case DO:
case WHILE:
case SWITCH:
case FOR:
case BLOCK: // may hide a label
s_list = ss;
return;
}
}
s_list = 0;
}
}
Pexpr check_cond(Pexpr e, TOK b, Ptable tbl)
{
//error('d',"check_cond(%k %k) tbl %d",e->base,b,tbl);
Pname cn;
if (e == dummy) error("empty condition for %k",b);
int const_obj = 0;
const_obj = e->tp->tconst();
Pexpr ee = e;
while (ee && (ee->base==DOT || ee->base==REF)) {
Pexpr m = ee->mem;
if ( ee->base==REF && m->tp && m->tp->is_ptr())
break;
ee = ee->e1;
}
if (ee) {
Ptype ttt = ee->tp;
switch (e->base) {
case REF:
Pptr p = ttt?ttt->is_ptr():0;
if (p && p->typ->tconst())
const_obj = 1;
break;
case DOT:
if (ttt && ttt->tconst())
const_obj = 1;
}
}
if (cn = e->tp->is_cl_obj()) {
Pclass cl = Pclass(cn->tp);
int i = 0;
Pname found = 0;
for (Pname on = cl->conv; on; on=on->n_list) {
Pfct f = on->tp->base == FCT ? Pfct(on->tp)
: Pfct(Pgen(on->tp)->fct_list->f->tp);
Ptype t = f->returns;
xx:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto xx;
case FLOAT:
case DOUBLE:
case LDOUBLE:
case PTR:
if (b == DEREF) break;
case CHAR:
case SHORT:
case INT:
case LONG:
case EOBJ:
// if (found==0 || found->tp->check(on->tp,0)) {
//error('d',"found %n on %n",found,on);
{ Pname xx = found;
if (found == 0) {
i = 1;
found = on;
}
else if ((found = really_dominate(found,on,const_obj)) == 0) {
i = 2;
found = on;
error("two conversions for%nO in%kE: %n and %n",cn,b,xx,on);
return e;
}
}
}
}
//error('d',"i %d",i);
switch (i) {
case 0:
error("%nO in%kE",cn,b);
return e;
/*
case 1:
{ Pname xx = new name(found->string);
Pref r = new ref(DOT,e,xx);
Pexpr rr = r->typ(tbl);
Pexpr c = new expr(G_CALL,rr,0);
if (e->lval(0)) {
// Pref r = new ref(DOT,e,found);
// r->tp = found->tp;
// Pexpr c = new expr(G_CALL,r,0);
// c->fct_name = found;
return c->typ(tbl);
}
else { // (temp=init,temp.coerce())
Pname tmp = make_tmp('U',e->tp,tbl);
Pexpr ass = init_tmp(tmp,e,tbl);
// Pref r = new ref(DOT,tmp,found);
// Pexpr rr = r->typ(tbl);
// Pexpr c = new expr(G_CALL,rr,0);
// c->fct_name = found;
ass = new expr(CM,ass,c);
return ass->typ(tbl);
}
}
*/
case 1:
{ Pname xx = new name(found->string);
Pexpr c;
if (e->lval(0)) {
Pref r = new ref(DOT,e,xx);
Pexpr rr = r->typ(tbl);
c = new expr(G_CALL,rr,0);
}
else { // (temp=init,temp.coerce())
Pname tmp = make_tmp('U',e->tp,tbl);
Pexpr ass = init_tmp(tmp,e,tbl);
Pref r = new ref(DOT,tmp,xx);
Pexpr rr = r->typ(tbl);
c = new expr(G_CALL,rr,0);
c = new expr(CM,ass,c);
}
return c->typ(tbl);
}
// default:
// error("%d possible conversions for%nO in%kE",i,cn,b);
// return e;
}
}
if (e->tp->memptr()) {
e = new mdot("i",e);
e->i1 = 9;
e = new expr(NE,e,zero);
}
else if (e->tp->num_ptr(b) == FCT)
error("%k(F)",b);
return e;
}
void stmt::dcl()
/*
typecheck statement "this" in scope "curr_block->tbl"
*/
{
Pstmt ss;
Pname n;
Pname nn;
Pstmt ostmt = Cstmt;
DB( if(Ddebug>=1) error('d',&where,"'%k'->stmt::dcl()",base); );
for (ss=this; ss; ss=ss->s_list) {
Pstmt old_loop, old_switch;
Cstmt = ss;
enum_promote = 0;
Ptable tbl = curr_block->memtbl;
//error('d',"stmt::dcl %k",ss->base);
switch (ss->base) {
case BREAK:
inline_restr |= 16;
if (curr_loop==0 && curr_switch==0)
error("break not in loop or switch");
ss->reached();
break;
case CONTINUE:
inline_restr |= 32;
if (curr_loop == 0) error("continue not in loop");
ss->reached();
break;
case DEFAULT:
if (curr_switch == 0) {
error("default not in switch");
break;
}
if (curr_switch->has_default) error("two defaults in switch");
curr_switch->has_default = ss;
ss->s->s_list = ss->s_list;
ss->s_list = 0;
ss->s->dcl();
break;
case SM:
{ if (ss->e ==0) break;
TOK b = ss->e->base;
switch (b) {
case DUMMY:
ss->e = 0;
break;
// check for unused results
// don't check operators that are likely
// to be overloaded to represent "actions":
// ! ~ < <= > >= << >>
case EQ:
case NE:
case PLUS:
case MINUS:
case REF:
case DOT:
case MUL:
case DIV:
case ADDROF:
case AND:
case OR:
case ER:
case DEREF:
case ANDAND:
case OROR:
case NAME:
case VALUE:
if (ss->e->tp) break; // avoid looking at generated code
ss->e = ss->e->typ(tbl);
if (ss->e->base == CALL) break;
if (ss->e->tp->base != VOID) {
if ( ss->e->base == DEREF )
error('w',"result of %sE not used",ss->e->e2?"[]":"*");
else
error('w',"result of%kE not used",b);
if (ss->e->not_simple()==0) ss->e = dummy;
}
break;
default:
ss->e = ss->e->typ(tbl);
}
break;
}
case RETURN:
{ Pname fn = cc->nof;
Pfct f = Pfct(fn->tp);
Ptype rt = f->returns;
Pexpr v = ss->e;
//error('d',"rt %t",rt);
while (rt->base == TYPE) rt = Pbase(rt)->b_name->tp;
if (v != dummy) {
if (rt->base == RPTR || rt->base == PTR) {
const_ptr = Pbase(Pptr(rt)->typ)->tconst();
}
if (rt->base == RPTR) {
ref_initializer++;
v = v->typ(tbl);
ref_initializer--;
} else
v = v->typ(tbl);
const_ptr = 0;
if (fn->n_oper==CTOR
|| fn->n_oper==DTOR
|| (rt->base==VOID && v->tp!=void_type)) {
error("unexpected return value");
// refuse to return the value:
ss->e = dummy;
}
else {
switch (rt->base) {
// case TYPE: laready done above
case RPTR:
switch (v->base) {
case NAME:
if (Pname(v)->n_scope==FCT
|| Pname(v)->n_scope==ARG)
error('w',"R to localV returned");
break;
case ICON:
case CCON:
case FCON:
case STRING:
if (Pptr(rt)->typ->tconst()==0)
error('w',"R to literal returned");
}
v = ref_init(Pptr(rt),v,tbl);
if (v->base==G_CM
&& v->e2->base==G_ADDROF
&& v->e2->e2->base==NAME)
error('w',"R to temporary returned (return value is not lvalue or of wrongT)");
case ANY:
break;
case COBJ:
if (v->base == DEREF) {
Pexpr v1 = v->e1;
if (v1->base==CAST) {
Pexpr v2 = v1->e1;
if (v2->base == G_CM) { // *(T)(e1,e2) => (e1,*(T)e2)
Pexpr v3 = v2->e2;
v2->e2 = v;
v2->tp = v->tp;
v = v2;
v1->e1 = v3;
}
}
}
if (f->f_result) {
if (v->base==G_CM && rt->check(v->tp,0/*ASSIGN*/)==0)
v = replace_temp(v,f->f_result);
else {
v = class_init(f->f_result->contents(),rt,v,tbl);
Pname rcn = rt->is_cl_obj();
if (Pclass(rcn->tp)->has_itor()==0) {
// can happen for virtuals and for user defined conversions
v->tp = rt;
v = new expr(ASSIGN,f->f_result->contents(),v);
v->tp = rt;
}
}
}
else
v = class_init(0,rt,v,tbl);
break;
case PTR:
{ Pexpr x = v;
v = ptr_init(Pptr(rt),v,tbl);
if (v->base == ADDROF
&& v->e2->base == NAME
&& Pname(v->e2)->n_stclass == AUTO)
error('w',"P to local variable%n returned",Pname(v->e2));
// if (v==x ||v->e2==x) goto def;
if (Pchecked == 0) goto def;
goto ret_save;
// break;
}
case INT:
case CHAR:
case LONG:
case SHORT:
if (Pbase(rt)->b_unsigned
&& v->base==UMINUS
&& v->e2->base==ICON)
error('w',"negative returned fromF returning unsigned");
default:
def:
{
Pexpr x = try_to_coerce(rt,v,"return value",tbl);
if (x)
v = x;
else if (rt->check(v->tp,ASSIGN))
error("bad return valueT for%n:%t (%tX)",fn,v->tp,rt);
}
}
ret_save:
ss->ret_tp = rt;
ss->e = v;
}
}
else {
if (rt->base != VOID) error("return valueX");
}
ss->reached();
break;
}
case DO: // in DO the stmt is before the test
inline_restr |= 8;
old_loop = curr_loop;
curr_loop = ss;
{ Pstmt st = ss->s;
while(st && st->base == FOR) st = st->for_init;
if (st && st->base == DCL)
if (st==ss->s) error("D as onlyS in do-loop");
}
ss->s->dcl();
ss->e = ss->e->typ(tbl);
ss->e = check_cond(ss->e,DO,tbl);
curr_loop = old_loop;
break;
case WHILE:
inline_restr |= 8;
old_loop = curr_loop;
curr_loop = ss;
ss->e = ss->e->typ(tbl);
ss->e = check_cond(ss->e,WHILE,tbl);
{ Pstmt st = ss->s;
while(st && st->base == FOR) st = st->for_init;
if (st && st->base == DCL)
if(st==ss->s) error("D as onlyS in while-loop");
}
ss->s->dcl();
curr_loop = old_loop;
break;
case SWITCH:
{ int ne = 0;
inline_restr |= 4;
old_switch = curr_switch;
curr_switch = ss;
ss->e = ss->e->typ(tbl);
ss->e = check_cond(ss->e,SWITCH,tbl);
{ Pstmt st = ss->s;
while(st && st->base == FOR) st = st->for_init;
if (st && st->base == DCL)
if(st==ss->s) error("D as onlyS in switchS");
}
{ Ptype tt = ss->e->tp;
sii:
switch (tt->base) {
case TYPE:
tt = Pbase(tt)->b_name->tp; goto sii;
case EOBJ:
ne = Penum(Pbase(tt)->b_name->tp)->no_of_enumerators;
case ZTYPE:
case ANY:
case CHAR:
case SHORT:
case INT:
case LONG:
case FIELD:
break;
default:
error("%t switchE",ss->e->tp);
}
}
ss->s->dcl();
if (ne) { /* see if the number of cases is "close to"
but not equal to the number of enumerators
*/
int i = 0;
Pstmt cs;
for (cs=ss->case_list; cs; cs=cs->case_list) i++;
if (i && i!=ne) {
if (ne < i) {
ee: error('w',"switch (%t)W %d cases (%d enumerators)",ss->e->tp,i,ne);
}
else {
switch (ne-i) {
case 1: if (3<ne) goto ee;
case 2: if (7<ne) goto ee;
case 3: if (23<ne) goto ee;
case 4: if (60<ne) goto ee;
case 5: if (99<ne) goto ee;
}
}
}
}
curr_switch = old_switch;
break;
}
case CASE:
if (curr_switch == 0) {
error("case not in switch");
break;
}
ss->e = ss->e->typ(tbl);
ss->e->tp->num_ptr(CASE);
{ Ptype tt = ss->e->tp;
iii:
switch (tt->base) {
case TYPE:
tt = Pbase(tt)->b_name->tp; goto iii;
case ZTYPE:
case ANY:
case CHAR:
case SHORT:
case INT:
case LONG:
case EOBJ:
Neval = 0;
long i = ss->e->eval();
if (Neval == 0) {
Pstmt cs;
if (largest_int<i) error("long case value");
for (cs=curr_switch->case_list; cs; cs=cs->case_list) {
if (cs->case_value == i) error("case %d used twice in switch",i);
}
ss->case_value = int(i);
ss->case_list = curr_switch->case_list;
curr_switch->case_list = ss;
}
else
error("bad case label: %s",Neval);
break;
default:
error("%t caseE",ss->e->tp);
}
}
// if (1) {
// Neval = 0;
// long i = ss->e->eval();
// if (Neval == 0) {
// Pstmt cs;
// if (largest_int<i) error("long case value");
// for (cs=curr_switch->case_list; cs; cs=cs->case_list) {
// if (cs->case_value == i) error("case %d used twice in switch",i);
// }
// ss->case_value = int(i);
// ss->case_list = curr_switch->case_list;
// curr_switch->case_list = ss;
// }
// else
// error("bad case label: %s",Neval);
// }
if (ss->s->s_list) error('i',"case%k",ss->s->s_list->base);
ss->s->s_list = ss->s_list;
ss->s_list = 0;
ss->s->dcl();
break;
case GOTO:
inline_restr |= 2;
ss->reached();
case LABEL:
/* Insert label in function mem table;
labels have function scope.
*/
n = ss->d;
nn = cc->ftbl->insert(n,LABEL);
/* Set a ptr to the mem table corresponding to the scope
in which the label actually occurred. This allows the
processing of goto's in the presence of ctors and dtors
*/
if (ss->base == LABEL) {
nn->n_realscope = curr_block->memtbl;
inline_restr |= 1;
}
if (Nold) {
if (ss->base == LABEL) {
if (nn->n_initializer) error("twoDs of label%n",n);
nn->n_initializer = (Pexpr)1;
}
if (n != nn) ss->d = nn;
}
else {
if (ss->base == LABEL) nn->n_initializer = (Pexpr)1;
nn->where = ss->where;
}
if (ss->base == GOTO)
nn->use();
else {
if (ss->s->s_list) error('i',"label%k",ss->s->s_list->base);
ss->s->s_list = ss->s_list;
ss->s_list = 0;
nn->assign();
}
if (ss->s) ss->s->dcl();
break;
case IF:
{
Pexpr ee = ss->e->typ(tbl);
if (ee->base == ASSIGN) {
Neval = 0;
(void)ee->e2->eval();
if (Neval == 0)
error('w',"constant assignment in condition");
}
ss->e = ee = check_cond(ee,IF,tbl);
if (ss->s->base == DCL) error("D as onlyS after `if'");
// pointer to member returns with a tp set to 0
if ( ee->tp ) switch (ee->tp->base) {
case INT:
case EOBJ:
case ZTYPE:
{ long i;
Neval = 0;
i = ee->eval();
if (Neval == 0) {
Pstmt sl = ss->s_list;
if (i) {
DEL(ss->else_stmt);
ss->s->dcl();
*ss = *ss->s;
}
else {
DEL(ss->s);
if (ss->else_stmt) {
ss->else_stmt->dcl();
*ss = *ss->else_stmt;
}
else {
ss->base = SM;
ss->e = dummy;
ss->s = 0;
}
}
ss->s_list = sl;
continue;
}
}
}
ss->s->dcl();
if (ss->else_stmt) {
if (ss->else_stmt->base == DCL) error("D as onlyS after `else'");
ss->else_stmt->dcl();
}
break;
}
case FOR:
inline_restr |= 8;
old_loop = curr_loop;
curr_loop = ss;
if (ss->for_init) {
Pstmt fi = ss->for_init;
switch (fi->base) {
case SM:
if (fi->e == dummy) {
ss->for_init = 0;
break;
}
fi->dcl();
break;
default:
// for (stmt; e1; e2) stmt1 stmt2
// => {stmt; for(; e1; e2) stmt1 stmt2}
// if stmt != declaration
// if stmt == declaration, temporarily
// rewrite to avoid symbol table
// problems in some contexts.
// Then put decl back to avoid
// extraneous {}.
// Note: to maintain pointers, ss
// must not change
{ Pstmt tmp = new stmt (SM,curloc,0);
*tmp = *ss; // tmp = original for
tmp->for_init = 0;
fi->s_list = tmp;
*ss = *fi;
curr_loop = old_loop;
ss->dcl();
tmp = ss->s_list;
if ( ss->base == DCL
&& tmp->base == FOR // sanity check
&& tmp->for_init == 0 // sanity check
) {
// put DCL back in for init
*fi = *ss;
*ss = *tmp;
ss->for_init = fi;
fi->s_list = 0;
} else {
// non-decl stmt in for init
// put stmts in block in case
// they follow a condition...
// allocate tmp to be sure
// fields are initialized
*fi = *ss;
tmp = new block(ss->where,0,fi);
tmp->own_tbl = 0;
tmp->memtbl = curr_block->memtbl;
tmp->permanent = ss->permanent;
*ss = *tmp;
tmp->permanent = 0; delete tmp;
}
// don't repeat stmt::dcl() for
// remaining stmts
goto done;
}
}
}
if (ss->e == dummy)
ss->e = 0;
else {
ss->e = ss->e->typ(tbl);
ss->e = check_cond(ss->e,FOR,tbl);
}
{ Pstmt st = ss->s;
while(st && st->base == FOR) st = st->for_init;
if (st && st->base == DCL)
if(st==ss->s) error("D as onlyS in for-loop");
}
ss->s->dcl();
ss->e2 = (ss->e2 == dummy) ? 0 : ss->e2->typ(tbl);
curr_loop = old_loop;
break;
case DCL: /* declaration after statement */
{
/* collect all the contiguous DCL nodes from the
head of the s_list. find the next statement
*/
int non_trivial = 0;
int count = 0;
Pname tail = ss->d;
for (Pname nn=tail; nn; nn=nn->n_list) {
// find tail;
// detect non-trivial declarations
count++;
if (nn->n_list) tail = nn->n_list;
Pname n = tbl->look(nn->string,0);
if (n && n->n_table==tbl) non_trivial = 2;
if (non_trivial == 2) continue;
if ((nn->n_sto==STATIC && nn->tp->base!=FCT)
|| nn->tp->is_ref()
|| (nn->tp->tconst() && fct_const==0)) {
non_trivial = 2;
continue;
}
Pexpr in = nn->n_initializer;
if (in)
switch (in->base) {
case ILIST:
case STRING:
non_trivial = 2;
continue;
}
non_trivial = 1;
Pname cln = nn->tp->is_cl_obj();
if (cln == 0) cln = cl_obj_vec;
if (cln == 0) continue;
if (Pclass(cln->tp)->has_ctor()) {
non_trivial = 2;
continue;
}
if (Pclass(cln->tp)->has_dtor()) non_trivial = 2;
}
while( ss->s_list && ss->s_list->base==DCL ) {
Pstmt sx = ss->s_list;
tail = tail->n_list = sx->d; // add to tail
for (nn=sx->d; nn; nn=nn->n_list) {
// find tail;
// detect non-trivial declarations
count++;
if (nn->n_list) tail = nn->n_list;
Pname n = tbl->look(nn->string,0);
if (n && n->n_table==tbl) non_trivial = 2;
if (non_trivial == 2) continue;
if ((nn->n_sto==STATIC && nn->tp->base!=FCT)
|| nn->tp->is_ref()
|| (nn->tp->tconst() && fct_const==0)) {
non_trivial = 2;
continue;
}
Pexpr in = nn->n_initializer;
if (in)
switch (in->base) {
case ILIST:
case STRING:
non_trivial = 2;
continue;
}
non_trivial = 1;
Pname cln = nn->tp->is_cl_obj();
if (cln == 0) cln = cl_obj_vec;
if (cln == 0) continue;
if (Pclass(cln->tp)->has_ctor()) {
non_trivial = 2;
continue;
}
if (Pclass(cln->tp)->has_dtor()) non_trivial = 2;
}
ss->s_list = sx->s_list;
/* delete sx; */
}
Pstmt next_st = ss->s_list;
//error('d',"dcl stmt : d %n non_trivial %d curr own_tbl %d inline_restr 0%o",ss->d,non_trivial,curr_block->own_tbl,inline_restr);
if (non_trivial==2 // must
|| (non_trivial==1 // might
&& ( curr_block->own_tbl==0 // why not?
|| inline_restr&3 /* label seen */)
)
) {
if (curr_switch && non_trivial==2) {
Pstmt cs = curr_switch->case_list;
Pstmt ds = curr_switch->has_default;
Pstmt bl;
if (cs == 0)
bl = ds;
else if (ds == 0)
bl = cs;
else if (cs->where.line<ds->where.line)
bl = ds;
else
bl = cs;
if ((bl==0 || bl->s->base!=BLOCK) && curr_switch->s->memtbl==tbl)
error('s',"non trivialD in switchS (try enclosing it in a block)");
}
/* Create a new block,
put all the declarations at the head,
and the remainder of the slist as the
statement list of the block.
*/
//ss->base = BLOCK; //DCL
/* check that there are no redefinitions
since the last "real" (user-written,
non-generated) block
*/
{ Pname lastnn = 0;
for( nn=ss->d; nn; nn=nn->n_list ) {
Pname n;
//n=curr_block->memtbl->look(nn->string,0);
//error('d',"checking %n lex_level: %d n: %n n->lex_level: %d",nn,nn->lex_level,n,n?n->lex_level:0);
//error('d'," own_tbl: %d curr_block: %d n->n_table: %d",curr_block->own_tbl,curr_block,n->n_table);
//error('d'," real_block: %d n's real_block: %d",curr_block->memtbl->real_block,n->n_table->real_block);
//if( curr_block->own_tbl
if ( (n=curr_block->memtbl->look(nn->string,0))
&& n->n_table->real_block==curr_block->memtbl->real_block
&& n->tp->base!=FCT
&& n->tp->base!=OVERLOAD
&& nn->lex_level == n->lex_level ) {
error("twoDs of%n",n);
if (lastnn==0) ss->d=nn->n_list;
else lastnn->n_list=nn->n_list;
} else lastnn = nn;
} // for nn
}
/* attach the remainder of the s_list
as the statement part of the block.
*/
ss->s = next_st;
ss->s_list = 0;
/* create the table in advance,
in order to set the real_block
ptr to that of the enclosing table
*/
ss->memtbl = new table(count+4,tbl,0);
ss->memtbl->real_block = curr_block->memtbl->real_block;
Pblock(ss)->dcl(ss->memtbl);
}
else { /* to reduce the number of symbol tables,
do not make a new block,
instead insert names in enclosing block,
and make the initializers into expression
statements.
*/
Pstmt sss = ss;
{ Pname lastnn = 0;
for( nn=ss->d; nn; nn=nn->n_list ) {
Pname n;
//error('d',"nn %n",nn);
//if( curr_block->own_tbl
if ( (n=curr_block->memtbl->look(nn->string,0))
&& n->n_table->real_block==curr_block->memtbl->real_block
&& n->tp->base!=FCT && n->tp->base!=OVERLOAD
&& nn->lex_level == n->lex_level ) {
error("twoDs of%n",n);
n = 0;
if (lastnn==0) ss->d=nn->n_list;
else lastnn->n_list=nn->n_list;
} else {
n = nn->dcl(tbl,FCT);
lastnn=nn;
}
if (n == 0) {
if (ss) {
ss->base = SM;
ss->e = 0;
}
continue;
}
//error('d',"hoisted %n to outer blk",n);
Pexpr in = n->n_initializer;
n->n_initializer = 0;
if (ss) {
sss->base = SM;
ss = 0;
}
else
sss = sss->s_list = new estmt(SM,sss->where,0,0);
if (in) {
switch (in->base) {
case G_CALL: /* constructor? */
{
Pname fn = in->fct_name;
if (fn && fn->n_oper==CTOR) break;
}
default:
in = new expr(ASSIGN,n,in);
in->tp = n->tp;
}
// sss->e = in->typ(tbl);
sss->e = in;
}
else
sss->e = dummy;
} // for nn
}
ss = sss;
ss->s_list = next_st;
}
break;
}
case BLOCK:
Pblock(ss)->dcl(tbl);
break;
case ASM:
/* save string */
{
char* s = (char*)ss->e;
int ll = strlen(s);
char* s2 = new char[ll+1];
strcpy(s2,s);
ss->e = Pexpr(s2);
break;
}
default:
error('i',"badS(%p %d)",ss,ss->base);
}
}
done:
Cstmt = ostmt;
}
void block::dcl(Ptable tbl)
/*
Note: for a block without declarations memtbl denotes the table
for the enclosing scope.
A function body has its memtbl created by fct::dcl().
*/
{
int bit_old = bit_offset;
int byte_old = byte_offset;
int max_old = max_align;
Pblock block_old = curr_block;
if (base != BLOCK && base != DCL) error('i',"block::dcl(%d)",base);
curr_block = this;
//error('d',"%d->block::dcl(%d) base %k",this,tbl,base);
//error('d'," memtbl %d own_tbl %d d %n s %k",memtbl,own_tbl,d,s?s->base:0);
if (d) {
own_tbl = 1;
base = BLOCK;
if (memtbl == 0) {
int nmem = d->no_of_names()+4;
memtbl = new table(nmem,tbl,0);
memtbl->real_block = this;
/* this is a "real" block from the
source text, and not one created by DCL's
inside a block. */
}
else
if (memtbl != tbl) error('i',"block::dcl(?)");
Pname nx;
for (Pname n=d; n; n=nx) {
nx = n->n_list;
n->dcl(memtbl,FCT);
switch (n->tp->base) {
case CLASS:
case ANON:
case ENUM:
break;
default:
delete n;
}
}
}
else if ( base == BLOCK ) {
own_tbl = 1;
if (memtbl == 0) {
int nmem = 4;
memtbl = new table(nmem,tbl,0);
memtbl->real_block = this;
/* this is a "real" block from the
source text, and not one created by DCL's
inside a block. */
} else
if (memtbl != tbl) error('i',"block::dcl(?)");
} else {
base = BLOCK;
memtbl = tbl;
}
Pname odcl = Cdcl;
if (s) s->dcl();
if (own_tbl) {
Pname m;
int i;
for (m=memtbl->get_mem(i=1); m; m=memtbl->get_mem(++i)) {
Ptype t = m->tp;
if (in_class_dcl) m->lex_level -= 1;
if (t == 0) {
if (m->n_assigned_to == 0)
error("label %sU",m->string);
if (m->n_used == 0)
error('w',"label %s not used", m->string);
continue;
}
ll:
switch (t->base) {
case TYPE: t = Pbase(t)->b_name->tp; goto ll;
case CLASS:
case ANON:
case ENUM:
case FCT:
//case VEC:
continue;
}
if (m->n_addr_taken == 0) {
if (m->n_used) {
if (m->n_assigned_to) {
}
else if ( t->base != VEC ) {
switch (m->n_scope) {
case FCT:
Cdcl = m;
if (m->string[0] != '_' && m->string[1] != '_' )
error('w',&m->where,"%n used but not set",m);
}
}
}
else {
if (m->n_assigned_to) {
}
else if (m->string[0]!='_' || m->string[1]!='_') {
switch (m->n_scope) {
case ARG:
case FCT:
Cdcl = m;
error('w',&m->where,"%n not used",m);
}
}
}
}
}
}
Cdcl = odcl;
d = 0;
if (bit_offset) byte_offset += SZ_WORD;
bit_offset = bit_old;
byte_offset = byte_old;
curr_block = block_old;
}
void name::field_align()
/*
adjust alignment
*/
{
Pbase fld = (Pbase)tp;
int nbits = fld->b_bits;
int a = (F_SENSITIVE) ? fld->b_fieldtype->align() : SZ_WORD;
if (max_align < a) max_align = a;
if (nbits == 0) { // force word alignment
int b;
if (bit_offset)
nbits = BI_IN_WORD - bit_offset;
else if (b = byte_offset%SZ_WORD)
nbits = b * BI_IN_BYTE;
// else
// nbits = BI_IN_WORD;
if (max_align < SZ_WORD) max_align = SZ_WORD;
}
else if (bit_offset == 0) { // take care of part of word
int b = byte_offset%SZ_WORD;
if (b) {
byte_offset -= b;
bit_offset = b*BI_IN_BYTE;
}
}
//error('d',"byteoff %d bitoff %d bits %d",byte_offset,bit_offset,nbits);
int x = (bit_offset += nbits);
if (BI_IN_WORD < x) {
fld->b_offset = 0;
byte_offset += SZ_WORD;
bit_offset = nbits;
}
else {
fld->b_offset = bit_offset;
if (BI_IN_WORD == x) {
bit_offset = 0;
byte_offset += SZ_WORD;
}
else
bit_offset = x;
}
n_offset = byte_offset;
}
0707071010112043701004440001630000160000010172500466055376100000700000171674dcl3.c /*ident "@(#)ctrans:src/dcl3.c 1.7" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
dcl3.c:
Routines used by ::dcl fucntions: fct::dcl() etc.
*****************************************************************************/
#include "cfront.h"
#include "size.h"
#include "template.h"
static void vbase_pointers(Pname fn, Pclass cl)
/*
insert argument for virtual base pointers (if any)
after f_this and before f_argtype
*/
{
//error('d',"vbase_pointers(%n,%t) %d %k",fn,cl,fn->tp,fn->n_oper);
Pfct f = Pfct(fn->tp);
if (fn->n_oper == CTOR) {
Pname d = 0;
for (Pbcl b = cl->baselist; b; b=b->next) {
if (b->base != VIRTUAL) continue;
Pname a = new name(b->bclass->string);
a->tp = b->bclass->this_type;
a->n_list = d;
a->n_table = f->body ? f->body->memtbl : 0;
a->where = fn->where;
d = a;
}
if (d) {
for (Pname dd =d;;) {
if (d->n_list == 0) {
d->n_list = f->f_args->n_list;
break;
}
d = d->n_list;
}
f->f_args->n_list = dd;
}
}
if (fn->n_oper == DTOR) { // add __free argument
//error('d',"add __free to %n",fn);
Pname fa = new name;
fa->tp = int_type;
fa->n_scope = ARG;
fa->where = fn->where;
Pname a = f->f_args;
if (a == 0)
f->f_args = fa;
else {
for(;;a = a->n_list) {
// error('d',"a %d %t",a,a->tp);
if (a->n_list == 0) {
a->n_list = fa;
break;
}
}
}
}
}
void make_res(Pfct f)
/*
returns X where X(X&) has been declared
add "_result" argument of type X*
*/
{
Pname cl = f->returns->is_cl_obj();
if (cl==0 || Pclass(cl->tp)->has_itor()==0) return;
Pname rv = new name("_result");
rv->tp = f->returns->addrof();
rv->n_scope = FCT; // not a ``real'' argument
rv->n_used = 1;
rv->n_list = f->argtype;
if (f->f_this)
f->f_this->n_list = rv;
else
f->f_args = rv;
f->f_result = rv;
f->s_returns = void_type;
}
void name::check_oper(Pname cn)
/*
check declarations of operators, ctors, dtors
*/
{
// error('d', "%n->check_oper( %n ): n_oper: %k", this, cn, n_oper );
switch (n_oper) {
case CALL:
case DEREF:
case REF:
if (cn == 0) error("operator%s must be aM",keys[n_oper]);
break;
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASDIV:
case ASMOD:
case ASAND:
case ASOR:
case ASER:
case ASLS:
case ASRS:
if ( warning_opt ) {
if ( cn == 0 || Pfct(tp)->f_static )
error('w', "operator%s should be a non-staticMF",keys[n_oper]);
}
break;
case ASSIGN:
if (cn == 0)
error(strict_opt?0:'w',"non-member operator%k() (anachronism)",n_oper);
break;
case NOT: /* unary operators only */
case COMPL:
// case INCR:
// case DECR:
Pfct f = Pfct(tp);
if (cn && f->argtype)
error("%n::%n takes noA",cn, this);
else if (f->nargs == 2)
error("%n takes 1A only",this);
break;
case INCR:
case DECR:
// check for postscript instance
f = Pfct(tp);
if (cn) { // member
if ( f->argtype && f->nargs == 1 ) {
Pname n = f->argtype;
if ( n->tp->base != INT )
error("%n must takeA ofT int, not %t",this,n->tp);
}
}
else
if (f->nargs == 2) { // non-member
Pname n = f->argtype->n_list;
if ( n->tp->base != INT )
error("%n must takeA ofT int, not %t",this,n->tp);
}
break;
case 0:
case TNAME: /* may be a constructor */
if (cn && ((strcmp(cn->string,string)==0) ||
((Pclass(cn->tp)->class_base ==
instantiated_template_class) &&
(strcmp(string,
Ptclass(cn->tp)->unparametrized_tname()->string) == 0))))
{
if (tp->base == FCT) {
Pfct f = Pfct(tp);
if (f->returns!=defa_type)
error("%s::%s()W returnT",string,string);
f->returns = void_type;
string = "__ct";
n_oper = CTOR;
}
else
error('s',"struct%nM%n",cn,cn);
}
else
n_oper = 0;
break;
case DTOR: /* must be a destructor */
//error('d',"dtor %s",string);
if (cn == 0) {
n_oper = 0;
error("destructor ~%s() not inC",string);
}
else
if ((strcmp(cn->string,string) == 0) ||
((Pclass(cn->tp)->class_base ==
instantiated_template_class) &&
(strcmp(string,
Ptclass(cn->tp)->unparametrized_tname()->string)==0)))
{
dto:
Pfct f = (Pfct)tp;
string = "__dt";
if (tp->base != FCT) {
error("%s::~%s notF",cn->string,cn->string);
tp = new fct(void_type,0,1);
}
else if (f->returns!=defa_type/* && f->returns!=void_type*/) {
if ( f->returns != void_type ||
f->body != 0 || friend_in_class == 0 )
error("%s::~%s()W returnT",cn->string,cn->string);
}
if (f->argtype) {
error("%s::~%s()WAs",cn->string,cn->string);
f->nargs = 0;
f->nargs_known = 1;
f->argtype = 0;
}
f->returns = void_type;
}
else {
if (strcmp(string,"__dt") == 0) goto dto;
error("~%s in %s",string,cn->string);
n_oper = 0;
}
break;
case TYPE:
// cond stores the type of the operator function
// error('d',"type %t",cond);
if (cn == 0) {
// error("operator%t() not aM",Ptype(n_initializer));
error("operator%t() not aM",Ptype(cond));
n_oper = 0;
// n_initializer = 0;
cond = 0;
}
else {
Pfct f = Pfct(tp);
// n_initializer = 0;
Ptype tx = Ptype(cond);
cond = 0;
if (f->base != FCT) error("badT for%n::operator%t()",cn,tx);
if (f->returns != defa_type) {
// if (f->returns->check(tx,0)) error("bad resultT for%n::operator%t()",cn,tx);
error("resultT for%n::operator%t()",cn,tx);
DEL(f->returns);
}
if (f->argtype) {
error("%n::operator%t()WAs",cn,tx);
f->argtype = 0;
}
f->returns = tx;
Pname nx = tx->is_cl_obj();
if (nx && can_coerce(tx,cn->tp)) error("both %n::%n(%n) and %n::operator%t()",cn,cn,nx,tx);
char buf[1024];
char* bb = tx->signature(buf);
int l2 = bb-buf;
if (1023<l2) error('i',"N::check_oper():N buffer overflow");
char* p = new char[l2+5];
p[0] = '_';
p[1] = '_';
p[2] = 'o';
p[3] = 'p';
strcpy(p+4,buf);
string = p;
}
break;
}
}
Pexpr vbase_args(Pfct a, Pname bn)
/*
constructor a calls the constructor bn for a base class
generate argument list needed for virtual base arguments
*/
{
Pfct b = Pfct(bn->tp);
//error('d',"vbase_args%n: %t %k",bn,b,b->base);
Pexpr args = 0;
Pexpr tail = 0;
if (b->base == OVERLOAD) b = Pfct(Pgen(b)->fct_list->f->tp); // doesn't matter which
for (Pname d = b->f_args->n_list; d!=b->argtype; d=d->n_list) {
for (Pname dd = a->f_args->n_list; dd; dd=dd->n_list)
// using strcmp is a trick
if (strcmp(dd->string,d->string)==0) break;
Pexpr aa = new expr(ELIST,dd,0);
if (args == 0)
args = aa;
else
tail->e2 = aa;
tail = aa;
}
return args;
}
void fct::init_bases(Pclass cl, Pexpr)
/*
in "cl"'s constructor "this" generate code to initialize base classes
and members using the initializers "f->f_init"
this->f_init == list of names of classes to be initialized
COLON(b) => base class b
=> constructor call in f_init->n_initializer
COLON() => unnamed base class
=> constructor call in f_init->n_initializer
NAME(m) => member m
=> constructor call in m->n_initializer
*/
{
Ptable ftbl = body->memtbl;
DB( if(Ddebug>=1) error('d',"init_bases %t init %d",cl,f_init); );
// explicit initializers
if ( cl && cl->csu == UNION && f_init && f_init->n_list )
error(&f_init->where,"multipleIrs in unionK %s:: %s",cl->string,cl->string);
for (Pname nx, nn=f_init; nn; delete nn,(nn=nx) ) {
Pexpr i = nn->n_initializer;
nn->n_initializer = 0;
nx = nn->n_list;
// error('d',"init_base %s %d",nn->string,i);
if (nn->string) {
// lookup in case type name hides a "real" member
{ Pname mmm = cl->memtbl->look(nn->string,0);
if ( mmm ) nn->base = mmm->base;
}
if (nn->base == TNAME) { // base class
char *bn;
while ( nn->tp && nn->tp->base == TYPE )
nn->tp = Pbase(nn->tp)->b_name->tp;
if ( nn->tp && nn->tp->base == COBJ )
bn = Pbase(nn->tp)->b_name->string;
else
bn = nn->string;
for (Pbcl l = cl->baselist; l; l=l->next) {
Pclass bcl = l->bclass;
if ((strcmp(bcl->string,bn) == 0) ||
((bcl->class_base ==
instantiated_template_class) &&
((strcmp(nn->string,
Ptclass(bcl)->unparametrized_tname()->string)) == 0)))
{
// l->init is zeroed out in ctor_simpl
// if error_count, simpl() not invoked
if (l->init && error_count == 0)
error("twoIrs for%t",bcl);
else
l->init = base_init(bcl,i,ftbl,l->obj_offset);
goto con;
}
}
error(&nn->where,"unexpectedAL: noBC%n",nn);
con:
continue;
}
else { // member initializer
Pname m = cl->memtbl->look(nn->string,0);
if (m && m->n_table==cl->memtbl)
m->n_initializer = mem_init(m,i,ftbl);
else
error(&nn->where,"%n not inC %s",nn,cl->string);
}
}
else { // unnamed base class
Pbcl l = cl->baselist;
if (l == 0) {
error("unexpectedAL: noBC called");
continue;
}
if (l->next) {
bit cnt = 0, rvb = 0; // remote virtual base classes
for (Pbcl ll = l; ll; ll = ll->next, ++cnt )
if (ll->base==VIRTUAL && ll->promoted) ++rvb;
if ( rvb )
error("unnamedBCIr: %dBCes(%d non-explicit virtualBC%s)",cnt,rvb,rvb==1?"":"es");
else error("unnamedBCIr: %dBCes",cnt);
continue;
}
if (l->init)
error("twoIrs for%t",l->bclass);
else {
error(strict_opt?0:'w',&nn->where,"N ofBC%t missing from BCIr (anachronism)",l->bclass);
l->init = base_init(l->bclass,i,ftbl,l->obj_offset);
}
}
} // for
for (Pbcl l = cl->baselist; l; l=l->next) {
// default initialization of base classes
Pname ctor;
Pclass bcl = l->bclass;
if (l->init==0 && (ctor=bcl->has_ctor()))
l->init = base_init(bcl,0,ftbl,l->obj_offset);
}
}
int inline_restr; /* report use of constructs that the inline expanded
cannot handle here */
void fct::dcl(Pname n)
{
int nmem = TBLSIZE;
Pname a;
Pname ll;
Ptable ftbl;
Pptr cct = 0;
int const_old = const_save;
int bit_old = bit_offset;
int byte_old = byte_offset;
int max_old = max_align;
if (base != FCT) error('i',"F::dcl(%d)",base);
if (body == 0) error('i',"F::dcl(body=%d)",body);
if (n==0 || n->base!=NAME) error('i',"F::dcl(N=%d %d)",n,(n)?n->base:0);
DB( if(Ddebug>=1) error('d',"fct::dcl(%n) %k %d %t",n,n->n_scope,body->own_tbl,this); );
if (body->own_tbl) return; // done already
// if (f_inline==0 ) n->n_dcl_printed = 1; // beware of recursive calls, no decl needed
// if (f_inline && debug_opt) n->n_dcl_printed = 2;
if (body->memtbl == 0) body->memtbl = new table(nmem+3,gtbl,0);
body->own_tbl = 1;
ftbl = body->memtbl;
ftbl->real_block = body;
max_align = 0;//AL_FRAME;
bit_offset = 0;
cc->stack();
cc->nof = n;
cc->ftbl = ftbl;
switch (n->n_scope) {
case 0:
case PUBLIC:
{ cc->not = n->n_table->t_name;
cc->cot = Pclass(cc->not->tp);
cc->tot = cc->cot->this_type;
// if (f_this==0 || cc->tot==0) error('i',"F::dcl(%n): f_this=%d cc->tot=%d",n,f_this,cc->tot);
if (f_this) f_this->n_table = ftbl; // fake for inline printout
cc->c_this = f_this;
Pclass cl = Pclass(cc->not->tp);
if (cl->c_body!=3
|| n->n_initializer
|| n->n_sto==STATIC
|| f_inline
|| f_imeasure
|| f_virtual==0)
;
else { // could be the function where we need to
// output the vtbl
int i;
for (Pname nn=cl->memtbl->get_mem(i=1); nn; nn=cl->memtbl->get_mem(++i) ) {
Ptype t = nn->tp;
if (t)
switch (t->base) {
case FCT:
if (nn == n) goto prnt;
if (nn->n_initializer
|| nn->n_sto==STATIC
|| Pfct(nn->tp)->f_inline
|| Pfct(nn->tp)->f_imeasure
|| Pfct(nn->tp)->f_virtual==0) break;
goto zaq;
case OVERLOAD:
{ for (Plist gl=Pgen(t)->fct_list; gl; gl=gl->l) {
Pname nn = gl->f;
if (nn == n) goto prnt;
if (nn->n_initializer
|| nn->n_sto==STATIC
|| Pfct(nn->tp)->f_inline
|| Pfct(nn->tp)->f_imeasure
|| Pfct(nn->tp)->f_virtual==0) continue;
goto zaq;
}
}
}
}
goto zaq;
prnt:
cl->print_all_vtbls(cl);
goto zaq;
}
}
}
zaq:
// protect against: class x; x f(); class x { x(x&); ....
if (f_result == 0) make_res(this);
if (f_result) f_result->n_table = ftbl; // fake for inline printout
returns->tsizeof(); // make sure size is known
Pname ax;
for (a=argtype, ll=0; a; a=ax) {
ax = a->n_list;
Pname nn = a->dcl(ftbl,ARG);
Pname cn = nn->tp->is_cl_obj();
if (cn == 0) cn = cl_obj_vec;
if (cn) (void)cn->tp->tsizeof(); // make sure it is printed
nn->n_assigned_to = nn->n_used = nn->n_addr_taken = 0;
nn->n_list = 0;
switch (nn->tp->base) {
case CLASS:
case ENUM: /* unlink types declared in arg list */
nn->dcl_print(0);
break;
default:
if (ll)
ll->n_list = nn;
else
f_args = argtype = nn;
ll = nn;
}
delete a;
}
if (f_result) { // link in f_result
f_args = f_result;
f_result->n_list = argtype;
}
if (f_this) { // link in f_this
f_args = f_this;
f_this->n_list = f_result ? f_result : argtype;
}
if (n->n_oper==CTOR || n->n_oper==DTOR) vbase_pointers(n,cc->cot);
if (n->n_oper == CTOR) {
const_save = 1;
init_bases(cc->cot,f_init);
}
else if (f_init)
error(0,"unexpectedAL: not aK");
PERM(returns);
const_save = f_inline&&debug_opt==0;
inline_restr = 0;
body->dcl(ftbl);
defined |= DEFINED;
if (f_inline && inline_restr && returns->base!=VOID) {
f_inline = 0;
char* s = (inline_restr & 32) ? "continue"
: (inline_restr & 16) ? "break"
: (inline_restr & 8) ? "loop"
: (inline_restr & 4) ? "switch"
: (inline_restr & 2) ? "goto"
: (inline_restr & 1) ? "label"
: "" ;
if (warning_opt) {
error('w', "\"inline\" ignored, %n contains %s",n,s);
error('w', "out-of-line copy of %n created",n);
}
// if (cc->cot)
n->simpl(); //BS6
n->dcl_print(0);
}
const_save = const_old;
if (f_inline && debug_opt==0) isf_list = new name_list(n,isf_list);
bit_offset = bit_old;
byte_offset = byte_old;
max_align = max_old;
cc->unstack();
//error('d',"fct-> returns %t",returns);
}
Pexpr fct::base_init(Pclass bcl, Pexpr i, Ptable ftbl, int offset)
/*
have base class bcl and expr list i
return "( *(base*)this ) . ctor( i )"
ctor call generated in expr.typ()
*/
{
Ptype ty = bcl->this_type;
Pexpr th = rptr(ty,f_this,offset); // base*
Pname ctor = bcl->has_ctor();
//error('d',"fct::B_init(C %t, i %d, %d) ctor %n",bcl,i,i?i->tp:0,ctor);
Pexpr ii = (i && i->base==ELIST)?i->e1:i;
if (ii
&& ii->base==DEREF
&& ii->e1->base==CAST
&& th->base==CAST) th->i2 = ii->e1->i2;
if (ctor == 0) {
if (i && i->base!=ELIST) i = new expr(ELIST,i,0);
Pexpr v = new texpr(VALUE,bcl,i); // ?.base(i)
v->e2 = new expr(DEREF,th,0); // (*(base*)this).base(i)
v = v->typ(ftbl); // *base(&*(base*)this,i)
//error('d',"v %k",v->base);
switch (v->base) {
case DEREF:
return v->e1; // base(&*(base*)this,i)
case ASSIGN: // degenerate base(base&): *(base*)this=i
th = new texpr(CAST,ty,f_this);
v = new expr(CM,v,th); // (*(base*)this=i,(base*)this);
return v->typ(ftbl);
default:
return 0;
}
}
Pname icn;
if (i) {
ii = ii->typ(ftbl);
if (bcl->has_itor()==0
&& (icn=ii->tp->is_cl_obj())
&& (Pclass(icn->tp)==bcl || Pclass(icn->tp)->has_base(bcl))) {
// degenerate base(base&): *(base*)this=i
// memberwise copy
//error('d',"copy %t",ty);
// th = new cast(ty,f_this);
// th = th->contents();
th = new texpr(CAST,ty,f_this);
th = th->contents();
th = th->typ(ftbl);
if (Pclass(icn->tp)!=bcl) { // cast needed
Pptr r = new ptr(RPTR,Pptr(ty)->typ);
ii = new texpr(CAST,r,ii);
ii = ii->typ(ftbl);
}
ii = new expr(ASSIGN,th,ii);
ii->tp = th->tp;
// simulate `return this':
// *(base*)this=i,(base*)this
ii = new expr(CM,ii,new cast(ty,f_this));
ii->tp = th->tp;
return ii;
// return ii->typ(ftbl); // don't find cl::operator=()
}
if (i->base == ELIST) i->e1 = ii;
}
//Pexpr x = call_ctor(ftbl,th,ctor,i,REF,vbase_args(this,ctor));
//error('d',"call %n %t -> %d %k",ctor,ctor->tp,x,x->base);
// return x;
return call_ctor(ftbl,th,ctor,i,REF,vbase_args(this,ctor));
}
Pexpr fct::mem_init(Pname mn, Pexpr i, Ptable ftbl)
/*
return "member_ctor( m, i )"
*/
{
// a new entry for B::B_pub, in general, has no tp and no
// real info: all the tp-> only work on our systems because
// 0 pointer dereference isn't system memory. it core dumps
// in set_const since no test is made on this == 0.
//error('d',"mem_init %n",mn);
// if (mn->n_stclass == STATIC) error('s',"MIr for static%n",mn);
switch (mn->n_stclass) {
case STATIC:
error("MIr for static%n",mn);
break;
case ENUM:
error("MIr for enumeration constant%n", mn);
break;
}
Pname member = (mn->base==PUBLIC && mn->n_qualifier) ? mn->n_qualifier : mn;
if (i) i = i->typ(ftbl);
Pname cn = member->tp->is_cl_obj(); // first find the class name
// if (member->n_stclass == STATIC) error('s',"MIr for static%n",member);
// if (i) i = i->typ(ftbl);
// Pname cn = member->tp->is_cl_obj(); // first find the class name
Pref tn = new ref(REF,f_this,member);
tn->tp = member->tp;
//error('d',"MI for %n %t = %t",member,member->tp,i?i->tp:0);
//error('d',"fthis %d %t member %n tp %t",f_this,f_this->tp,member,tn->tp);
if (cn) {
Pclass mcl = Pclass(cn->tp); // then find the classdef
Pname ctor = mcl->has_ctor();
Pname icn;
if (i
&& mcl->has_itor()==0
&& (icn=i->tp->is_cl_obj())
&& Pclass(icn->tp)==mcl) { // bitwise copy
Pexpr init = new expr(ASSIGN,tn,i);
init->tp = tn->tp;
// return init->typ(ftbl); // don't look for mcl.operator=()
member->assign();
return init;
}
if (ctor) return call_ctor(ftbl,tn,ctor,i,DOT);
error("Ir forM%nW noK",member);
return 0;
}
if (cl_obj_vec) {
if (i && i->base == ELIST)
error("illegalIrL for %t%nWinM initializationL",mn->tp,mn);
else error('s',"Ir forCM %t%nWK",mn->tp,mn);
return 0;
}
if (i && i->base == ELIST) {
if (i->e2) error("Ir for%n not a simpleE",member);
i = i->e1;
}
if (member->tp->is_ref() && (i == 0)) {
error("empty Ir for reference %n", member);
return 0 ;
}
// error( 'd', "fct_mem_init: %n %k", member, member->tp->base );
switch (member->tp->base) {
// case RPTR:
// if ( i == 0 ) {
// error( "empty Ir for reference %n", member );
// return 0;
// }
// break;
case VEC:
case FCT:
case OVERLOAD:
error("Ir for%n ofT %t",member,member->tp);
return 0;
}
//error('d',"tp %t",member->tp);
if (member->tp->tconst()) {
int save_ignore_const = ignore_const;
ignore_const = 1;
i = new expr(ASSIGN,tn,i);
i = i->typ(ftbl);
ignore_const = save_ignore_const;
return i;
}
Pptr pt;
if (pt = member->tp->is_ref()) {
switch (pt->typ->base) {
case FCT:
case OVERLOAD:
i = ptr_init(pt,i,ftbl);
break;
default:
i = ref_init(pt,i,ftbl);
}
i = new expr(ASSIGN,tn,i);
i->tp = tn->tp;
member->assign(); // cannot call typ: would cause dereference
return i;
}
i = new expr(ASSIGN,tn,i);
return i->typ(ftbl); // typ performs the type check on the assignment
}
Pexpr replace_temp(Pexpr e, Pexpr n)
/*
e is on the form
f(&temp,arg) , temp
or
&temp->ctor(arg) , temp
or
x->f(&temp,arg) , temp
change it to
f(n,arg)
or
n->ctor(arg)
*/
{
Pexpr c = e->e1; // f(&temp,arg) or &temp->ctor(args)
Pexpr ff = c->e1;
Pexpr a = c->e2; // maybe ELIST(&temp,arg)
Pexpr tmp = e->e2;
//error('d',"suppress(%d %k) %n",tmp->base,tmp->base,tmp->base==NAME?tmp:0);
if (tmp->base==DEREF) tmp = tmp->e1;
if (tmp->base==CAST) tmp = tmp->e1;
if (tmp->base==ADDROF || tmp->base==G_ADDROF) tmp = tmp->e2;
if (tmp->base != NAME) return e; //error('i',"replace %k",tmp->base);
tmp->tp = any_type; // temporary not used: suppress it
//error('d',"replace_temp(%k %k) c %k ff %k",e->base,n->base,c->base,ff->base);
switch (ff->base) {
case REF:
if (ff->e1->base==G_ADDROF && ff->e1->e2==tmp)
a = ff; // &tmp -> f()
break;
case DOT:
if (ff->e1->base==NAME && ff->e1==tmp) {
a = ff; // tmp . f()
a->base = REF;
}
break;
}
a->e1 = n;
return c;
}
Pname classdef::has_ictor()
/*
does this class have a constructor taking no arguments?
*/
{
Pname c = has_ctor();
if (c == 0) return 0;
Pfct f = Pfct(c->tp);
switch (f->base) {
default:
error('i',"%s: badK (%k)",string,c->tp->base);
case FCT:
switch (f->nargs) {
case 0: return c;
default: if (f->argtype->n_initializer) return c;
}
return 0;
case OVERLOAD:
{ for (Plist l=Pgen(f)->fct_list; l; l=l->l) {
Pname n = l->f;
f = (Pfct)n->tp;
switch (f->nargs) {
case 0: return n;
default: if (f->argtype->n_initializer) return n;
}
}
return 0;
}
}
}
int add_first; // fudge, use ctor arg instead
Pname gen::add(Pname n)
/*
add "n" to the tail of "fct_list"
(overloaded names are searched in declaration order)
detect: multiple identical declarations
declaration after use
multiple definitions
*/
{
Pfct f = Pfct(n->tp);
Pname nx;
//error('d',"add(%n) %d",n,add_first);
if (f->base != FCT) error("%n: overloaded nonF",n);
if ( fct_list && (nx=find(f,1)) ) {
//error('d',"found %n %t",nx,nx->tp);
Linkage l1 = Pfct(nx->tp)->f_linkage;
Linkage l2 = f->f_linkage;
if ( l2 != linkage_default && l1 != l2 )
error("inconsistent linkage specifications for%n",n);
Nold = 1;
}
else {
if (add_first==0 && f->f_signature==0) f->sign();
//error('d',"signature: %d \"%s\" fct_list %d",f->f_signature,f->f_signature,fct_list);
nx = new name;
*nx = *n;
// nx->n_tbl_list = Pname(n->string);
nx->n_gen_fct_name = n->string;
PERM(nx);
Nold = 0;
if (fct_list) {
int clink = (f->f_linkage==linkage_C);
Plist gl=fct_list;
for(;;) {
if (clink
&& Pfct(gl->f->tp)->f_linkage == linkage_C ) {
error("two%ns with c linkage",n);
if(f->f_signature==0) f->sign();
}
if (gl->l)
gl = gl->l;
else
break;
}
gl->l = new name_list(nx,0);
}
else
fct_list = new name_list(nx,0);
nx->n_list = 0;
}
return nx;
}
void fct::sign()
{
switch ( f_linkage ) {
case linkage_C:
f_signature = "";
return;
case linkage_Cplusplus:
case linkage_default:
break;
}
char buf[1024];
char* bb = signature(buf);
int ll = bb-buf;
if (1023 < ll) error('i',"gen::add():N buffer overflow");
char* p = new char[ll+1];
strcpy(p,buf);
f_signature = p;
//error('d',"fct::sign %s",p);
}
Pname gen::find(Pfct f, bit warn)
{
for (Plist gl=fct_list; gl; gl=gl->l) {
Pname n = match(gl->f,f,warn);
if (n) return n;
}
return 0;
}
Pname gen::match(Pname nx, Pfct f, bit warn)
{
Pfct fx = Pfct(nx->tp);
Pname a, ax;
int op = 0; // overloading problem: const, ref, vec/ptr, or basetype
//error('d',"fx %d %d f %d %d",fx->nargs_known,fx->nargs,f->nargs_known,f->nargs);
if (f->nargs_known != fx->nargs_known) return 0; // the bets are off
// must rely on checks at
// call points
if (f->f_const != fx->f_const) return 0;
if (fx->nargs != f->nargs
&& fx->nargs_known==1
&& f->nargs_known==1) return 0; // no warning for potential
// problems due to default args
for (ax=fx->argtype, a=f->argtype; a&&ax; ax=ax->n_list, a=a->n_list) {
Ptype at = ax->tp;
Ptype atp = a->tp;
//error('d',"at %t atp %t",at,atp);
if (at->check(atp,OVERLOAD) == 0) {
//error('d',"at %t atp %t cp %d vrp %d",at,atp,const_problem,vrp_equiv);
continue;
}
//error('d',"warn %d",warn);
if (warn == 0) goto xx;
/*
warn against:
overload f(X&), f(X); error
overload f(int), f(const); error
overload f(int*), f(int[10]); warn
etc.
*/
//error('d',"vrp_equiv %d const_problem %d",vrp_equiv,const_problem);
if (const_problem) { // differ only in X vs const X
if (at->is_ptr_or_ref()) return 0;
op++;
continue;
}
aaa:
switch (atp->base) {
case TYPE:
atp = Pbase(atp)->b_name->tp;
goto aaa;
// case EOBJ:
// atp = Penum(Pbase(atp)->b_name->tp)->e_type;
// goto aaa;
case RPTR: // differ only by X vs X& ?
if (Pptr(atp)->typ->check(at,0)==0) {
op++;
continue;
}
}
atl:
switch (at->base) {
case TYPE:
at = Pbase(at)->b_name->tp;
goto atl;
// case EOBJ:
// at = Penum(Pbase(at)->b_name->tp)->e_type;
// goto atl;
case RPTR: // differ only by X& vs X ?
if (Pptr(at)->typ->check(atp,0)==0) {
op++;
continue;
}
break;
// case CHAR: // differ only by int vs char ?
// case SHORT:
// case INT:
// if (atp->base!=at->base && atp->base==EOBJ) {
// op++;
// continue;
// }
// break;
}
//error('d',"return 0");
//goto xx;
// some argument is really different
// e.g. f(int), f(char*);
return 0;
}
// arguments checked. Now look at leftover args, return type,etc.
// if (warn && a && fx->nargs_known==ELLIPSIS) error('w',"... in%n'sAT hidesATs from the overloading mechanism",nx);
if (a || ax) return 0;
if (op == 0) {
if (warn && fx->returns->check(f->returns,0))
error("two different return valueTs for%n: %t and %t",nx,fx->returns,f->returns);
return nx;
}
xx:
if (warn && op)
error("the overloading mechanism cannot tell a%t from a%t",fx,f);
return 0;
}
int name::no_of_names()
{
register int i = 0;
register Pname n;
for (n=this; n; n=n->n_list) i++;
return i;
}
static Pexpr lvec[20], *lll, *curr_e;
static Pexpr last_il = 0;
static Pexpr list_back = 0;
static Pexpr last_el = 0, *last_lll;
void new_list(Pexpr lx)
{
if (lx->base != ILIST) error('i',"IrLX");
lll = last_lll = lvec;
lll++;
*lll = last_el = lx->e1;
}
Pexpr next_elem()
{
Pexpr e;
Pexpr lx;
if (lll == lvec) return 0;
lx = *lll;
if (list_back) {
e = list_back;
list_back = 0;
return e;
}
if (lx == 0) { /* end of list */
lll--;
return 0;
}
switch (lx->base) {
case ELIST:
e = lx->e1;
curr_e = &lx->e1;
last_el = lx;
last_lll = lll;
*lll = lx->e2;
switch (e->base) {
case ILIST:
lll++;
*lll = e->e1;
last_il = e;
return Pexpr(1); // start of new ILIST
case ELIST:
error("nestedEL");
return 0;
default:
{
if (need_sti(e)) error('s',"generalIr inIrL");
return e;
}
}
case IVAL:
case ZERO:
lll--;
return 0;
default:
error('i',"IrL %k",lx->base);
}
}
static Pexpr insert_init(Pexpr newval) {
// splice an initializer in front of the next element in the
// initializer list. Provides initializers for unnamed bitfields.
Pexpr t = new expr(ELIST,last_el->e1,last_el->e2);
last_el->e1=newval;
last_el->e2=t;
lll = last_lll;
*lll = last_el;
return next_elem();
}
void skip_ilist()
// skip ilist use to represent pointer to member function literal
{
Pexpr e = next_elem();
e = next_elem();
}
void list_check(Pname nn, Ptype t, Pexpr il, Ptable tbl)
/*
see if the list "lll" can be assigned to something of type "t"
"nn" is the name of the variable for which the assignment is taking place.
"il" is the last list element returned by next_elem()
*/
{
Pexpr e;
bit lst = 0;
int i;
Pclass cl;
int tdef = 0;
//error('d',"list_check%n: %t (%d)",nn,t,il);
if (il == Pexpr(1)) {
lst = 1;
e = il;
}
else if (il)
list_back = il;
zzz:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
tdef = 1;
// did it used to be a VEC before arg_fudge was applied?
if (t->base==PTR && Pvec(t)->size)
t->base=VEC;
goto zzz;
case VEC:
{ Pvec v = Pvec(t);
Ptype vt = v->typ;
if (v->size) { /* get at most v->size initializers */
if (v->typ->base == CHAR) {
e = next_elem();
if (e->base == STRING) { // v[size] = "..."
int isz = Pvec(e->tp)->size;
if (v->size < isz) error("Ir too long (%d characters) for%n[%d]",isz,nn,v->size);
break;
}
else
list_back = e;
}
for (i=0; i<v->size; i++) { // check next list element type
Pfct MP = 0;
ee:
e = next_elem();
if (e == 0) goto xsw; // too few initializers are ok
vtz:
//error('d',"vtz: %d",vt->base);
switch (vt->base) {
case TYPE:
vt = Pbase(vt)->b_name->tp;
goto vtz;
case VEC:
case COBJ:
list_check(nn,vt,e);
break;
case PTR:
if ((MP = vt->memptr()) &&
e==Pexpr(1)) {
if (vt->check(last_il->tp,ASSIGN))
error("badIrT for%n:%t (%tX)",v,last_il->tp,vt);
skip_ilist();
break;
}
if (MP && e && e->base==ZERO) {
*curr_e = new expr(ELIST,zero,zero);
*curr_e = new expr(ILIST,*curr_e,zero);
(*curr_e)->tp = zero_type;
break;
}
if (MP && e && e->tp->base==OVERLOAD) {
Pexpr op = ptof(Pfct(Pptr(vt)->typ),e,tbl);
if(op) {
*curr_e = op;
break;
}
}
// no break
default:
{
if (e == (Pexpr)1) {
error("unexpectedIrL");
goto ee;
}
if (vt->check(e->tp,ASSIGN))
error("badIrT for%n:%t (%tX)",nn,e->tp,vt);
Pptr p;
if (vt->check(e->tp,0)
&& (p=vt->is_ptr())
&& Ptype(p)!=zero_type
&& p->typ!=char_type) {
Pexpr te = e;
Ptype t = p->typ;
while ( t->base == TYPE ) t = Pbase(t)->b_name->tp;
if ( t->base == COBJ )
te = ptr_init( p, e, tbl );
if ( te == e )
*curr_e = new cast(vt,e);
else *curr_e = te;
}
}
}
}
if ( lst && (e=next_elem()) ) error("end ofIrLX after array");
xsw:;
}
else { /* determine v->size */
i = 0;
(void) v->typ->tsizeof();
xx:
while ( e=next_elem() ) { // get another initializer
Pfct MP = 0;
i++;
vtzz:
//error('d',"vtzz");
switch (vt->base) {
case TYPE:
vt = Pbase(vt)->b_name->tp;
goto vtzz;
case VEC:
case COBJ:
list_check(nn,vt,e);
break;
case PTR:
if((MP = vt->memptr()) &&
e==Pexpr(1)) {
if (vt->check(last_il->tp,ASSIGN))
error("badIrT for%n:%t (%tX)",v,last_il->tp,vt);
skip_ilist();
break;
}
if (MP && e && e->base==ZERO) {
*curr_e = new expr(ELIST,zero,zero);
*curr_e = new expr(ILIST,*curr_e,zero);
(*curr_e)->tp = zero_type;
break;
}
if (MP && e && e->tp->base==OVERLOAD) {
Pexpr op = ptof(Pfct(Pptr(vt)->typ),e,tbl);
if(op) {
*curr_e = op;
break;
}
}
// no break
default:
{ if (e == Pexpr(1)) {
error("unexpectedIrL");
goto xx;
}
if (vt->check(e->tp,ASSIGN))
error("badIrT for%n:%t (%tX)",nn,e->tp,vt);
Pptr p;
if (vt->check(e->tp,0)
&& (p=vt->is_ptr())
&& Ptype(p)!=zero_type
&& p->typ!=char_type) {
Pexpr te = e;
Ptype t = p->typ;
while ( t->base == TYPE ) t = Pbase(t)->b_name->tp;
if ( t->base == COBJ )
te = ptr_init( p, e, tbl );
if ( te == e )
*curr_e = new cast(vt,e);
else *curr_e = te;
}
}
}
}
if (tdef==0) v->size = i;
}
break;
}
case CLASS:
cl = Pclass(t);
goto ccc;
case COBJ: /* initialize members */
cl = Pclass(Pbase(t)->b_name->tp);
ccc:
if (cl->defined == 0) {
lll = lvec; // we are lost: ignore rest of list
return;
}
if (cl->c_body == 1) cl->dcl_print(0);
{ Ptable tbl = cl->memtbl;
Pname m;
if (cl->baselist) {
if (cl->baselist->next) error("IrL forO ofC with multipleBCs");
list_check(nn,cl->baselist->bclass,0);
}
for (m=tbl->get_mem(i=1); m; m=tbl->get_mem(++i)) {
Ptype mt = m->tp;
Pfct MP = 0;
switch (mt->base) {
case FCT:
case OVERLOAD:
case CLASS:
case ENUM:
continue;
}
if (m->n_stclass == STATIC ||
m->n_stclass == ENUM ) continue;
/* check assignment to next member */
dd:
while (mt->base == TYPE)
mt = Pbase(mt)->b_name->tp;
if ((MP = mt->memptr()) &&
e==Pexpr(1) &&
last_il->tp->base == PTR) {
if(i==1) lst=0;
}
else e = next_elem();
if (e == 0) return; //break;
if(
mt->base == FIELD
&&
m->string[0]=='_'
&&
m->string[1]=='_'
&&
m->string[2]=='F' // unnamed bitfield
) {
e = insert_init(zero);
}
//error('d',"mtz%n: %d",m,mt->base);
switch (mt->base) {
case CLASS:
case ENUM:
break;
case VEC:
case COBJ:
list_check(nn,m->tp,e);
break;
case PTR:
if (MP && e==Pexpr(1)) {
if (mt->check(last_il->tp,ASSIGN))
error("badIrT for%n:%t (%tX)",m,last_il->tp,mt);
skip_ilist();
break;
}
if (MP && e && e->base==ZERO) {
*curr_e = new expr(ELIST,zero,zero);
*curr_e = new expr(ILIST,*curr_e,zero);
(*curr_e)->tp = zero_type;
break;
}
if (MP && e && e->tp->base==OVERLOAD) {
Pexpr op = ptof(Pfct(Pptr(mt)->typ),e,tbl);
if(op) {
*curr_e = op;
break;
}
}
// no break
default:
{ if (e == Pexpr(1)) {
error("unexpectedIrL");
goto dd;
}
if (mt->check(e->tp,ASSIGN))
error("badIrT for%n:%t (%tX)",m,e->tp,m->tp);
if(MP && e && e->base==CAST)
*curr_e = e->e1;
Pptr p;
if (mt->check(e->tp,0)
&& (p=mt->is_ptr())
&& Ptype(p)!=zero_type
&& p->typ!=char_type)
*curr_e = new cast(mt,e);
}
}
}
if (lst && (e=next_elem()) ) error("end ofIrLX afterCO");
break;
}
default:
e = next_elem();
if (e == 0) {
error("noIr forO");
break;
}
if (e == Pexpr(1)) {
error("unexpectedIrL");
break;
}
//error('d',"t %t e->tp %t",t,e->tp);
if (t->check(e->tp,ASSIGN)) error("badIrT for%n:%t (%tX)",nn,e->tp,t);
Pptr p;
if (t->check(e->tp,0)
&& (p=t->is_ptr())
&& Ptype(p)!=zero_type
&& p->typ!=char_type)
*curr_e = new cast(t,e);
if (lst && (e=next_elem()) ) error("end ofIrLX afterO");
break;
}
}
int
is_anon(char* string) {
// error('d',"is_anon: %s", string );
if ( string == 0 )
return 0;
if ( string[0]=='_' && string[1]=='_' &&
(string[2]=='C' || string[2]=='E'))
return 1;
return 0;
}
Pname dclass(Pname n, Ptable tbl)
{
Pclass cl;
Pbase bt;
Pname bn;
Pname ntbl = tbl->t_name;
Ptype ntp = 0;
TOK tscope;
Pname nx = ktbl->look(n->string,0); // TNAME
if (ntbl && ntbl->tp) ntp = ntbl->tp;
tscope = ntp&&ntp->base==CLASS?NESTED:(n->lex_level?LOCAL:HIDDEN);
DB( if(Ddebug>=1) error( 'd', &n->where, "dclass n %n %d nx %d", n,n->lex_level, nx); );
// error( 'd', &n->where, "dclass n %n ll %d nx %d tbl: %n", n,n->lex_level, nx, tbl->t_name);
if (nx == 0 || n->lex_level ||
ntp && is_anon(n->string) == 0 && ntp->base == CLASS
&& (ktbl->look(n->string,tscope)))
{
if ( nx && ntp && ntp->base == CLASS ) {
bt = (Pbase)nx->tp;
bn = bt->b_name;
cl = bn ? (Pclass)bn->tp : 0;
if (cl && cl->lcl &&
strcmp(cl->lcl,"FUDGE007")==0)
goto bbb;
else { bt=0; bn=0; cl=0; }
}
int tn = 0;
for (nx=ktbl->look(n->string,tscope); nx; nx=nx->n_tbl_list)
{
if (nx->n_key != tscope) continue;
if (tscope==LOCAL &&
nx->lex_level != n->lex_level ) continue;
if (nx->tp->base != COBJ) {
tn = 1;
continue;
}
bt = (Pbase)nx->tp;
bn = bt->b_name;
cl = (Pclass)bn->tp;
if (cl == 0) continue;
// is this class nested within class table?
if (tscope==NESTED &&
strcmp(ntbl->string,cl->in_class->string))
continue;
else
if ( tscope==LOCAL &&
(cl->lcl==0 || strcmp(cl->lcl,Pclass(n->tp)->lcl)))
continue;
goto bbb;
}
if (tn)
error("%n redefined using Tdef",n);
else
error('i',"%n is not aCN",n);
}
else {
bt = Pbase(nx->tp); // COBJ
if ( bt->base != COBJ ) {
error("%n redefined using typedef",n);
Pname tn = ktbl->look(n->string,HIDDEN);
if ( tn->tp->base == COBJ )
bt = Pbase(tn->tp);
else error('i',"%n is not a CN", n );
}
bn = bt->b_name;
}
bbb:
bn->where = nx->where;
Pname bnn = tbl->insert(bn,CLASS); // copy for member lookup
cl = Pclass(bn->tp);
if (cl->class_base == template_class)
error("C%n defined previously asYC", bn);
if (cl->defined&(DEFINED|SIMPLIFIED))
error("C%n defined twice",n);
else {
if (bn->n_scope == ARG) bn->n_scope = ARGT;
cl->dcl(bn,tbl);
}
n->tp = cl;
return bnn;
}
Pname denum(Pname n, Ptable tbl)
{
Penum en;
Pbase bt;
Pname bn;
Pname ntbl = tbl->t_name;
Ptype ntp = 0;
TOK tscope;
Pname nx = ktbl->look(n->string,0); // TNAME
if (ntbl && ntbl->tp) ntp = ntbl->tp;
// note: ***** add for local enumeration declaration
// error( 'd', &n->where, "denum n %n ll %d nx %d tbl: %n", n,n->lex_level, nx, tbl->t_name);
if (nx == 0 || /* n->lex_level ||*/
ntp && is_anon(n->string)==0 && ntp->base == CLASS )
{
int tn = 0;
tscope = ntp&&ntp->base==CLASS?NESTED:(/*n->lex_level?LOCAL:*/HIDDEN);
for (nx=ktbl->look(n->string,tscope); nx; nx=nx->n_tbl_list)
{
if (nx->n_key != tscope) continue;
// if (tscope==LOCAL &&
// nx->lex_level != n->lex_level ) continue;
bt = (Pbase)nx->tp;
bn = bt->b_name;
en = (Penum)bn->tp;
// is this class nested within class table?
if (tscope==NESTED && en->in_class &&
strcmp(ntbl->string,en->in_class->string))
continue;
}
}
else {
bt = (Pbase)nx->tp;
bn = bt->b_name;
en = (Penum)bn->tp;
}
Pname bnn = tbl->insert(bn,CLASS);
if (en->defined&(DEFINED|SIMPLIFIED))
error("enum%n defined twice",n);
else {
if (bn->n_scope == ARG) bn->n_scope = ARGT;
en->dcl(bn,tbl);
}
n->tp = en;
return bnn;
}
static int
is_probably_temp( char *str )
{
// error( 'd', "is_probably_temp( %s )", str );
if ( str[0] != '_' || str[1] != '_' )
return 0;
switch (str[2]) {
default:
return 0;
case 'A': case 'C': case 'D': case 'E': case 'F':
case 'I': case 'K': case 'L': case 'M': case 'N':
case 'Q': case 'R': case 'S': case 'T': case 'U':
case 'V': case 'W': case 'X':
return 1;
}
}
static void
check_for_local( Pexpr ee )
{
static Pname n[2] = {0,0}; // try not to flag multiple errors
static index = 0;
if ( ee==0 ) return;
// error('d', "check_for_local( %k ) e1: %d e2: %d", ee->base, ee->e1, ee->e2);
switch ( ee->base ) {
case NAME:
{
Pname nn = Pname(ee);
if ((nn->n_scope==FCT || nn->n_scope==ARG)
&& is_probably_temp(nn->string) == 0
&& n[0]!=nn && n[1]!=nn)
{
error("local%n used as defaultA", nn );
n[index] = nn;
index = index==0?1:0;
}
// no break;
}
case TNAME: case STRING: case IVAL:
case ICON: case CCON: case FCON:
case ZERO: case DUMMY: case SIZEOF:
return;
case QUEST:
check_for_local( ee->cond );
break;
case MDOT:
check_for_local( ee->mem );
return;
}
check_for_local( ee->e1 );
check_for_local( ee->e2 );
}
void dargs(Pname, Pfct f, Ptable tbl)
{
int argnamesize = 0; // if +a1, make sure arg names can be printed
int oo = const_save;
const_save = 1;
if ( ansi_opt ) {
Pname th = f->f_this;
if ( th && th->string ) argnamesize += strlen(th->string) + 1;
th = f->f_result;
if ( th && th->string ) argnamesize += strlen(th->string) + 1;
}
for (Pname a=f->argtype; a; a=a->n_list) {
Pexpr init;
if (a->tp == 0) {
error( "A has noT" );
a->tp = any_type;
continue;
}
if (ansi_opt && a->string) argnamesize += strlen(a->string) + 1;
Pname cln = a->tp->is_cl_obj();
//error('d',"dargs %t",a->tp);
if (cln && Pclass(cln->tp)->has_itor()) // mark X(X&) arguments
a->n_xref = 1;
else {
Ptype t = a->tp;
while (t->base == TYPE) t = Pbase(t)->b_name->tp;
if (t->base == FCT) a->tp = new ptr(PTR,a->tp);
}
// if (init = a->n_initializer) { // default argument
if ( a->n_key != NESTED &&
(init = a->n_initializer)) { // default argument
Pptr pt;
if (init == dummy) {
error("emptyIr");
a->n_initializer = 0;
continue;
}
if (cln) {
if (init->base==VALUE) {
switch (init->tp2->base) {
case CLASS:
if (Pclass(init->tp2)!=Pclass(cln->tp)) goto inin2;
break;
default:
Pname n2 = init->tp2->is_cl_obj();
if (n2==0 || Pclass(n2->tp)!=Pclass(cln->tp)) goto inin2;
}
a->n_initializer = init = 0;
error('s',"K as defaultA");
}
else {
inin2:
if (init->base == ILIST) error("list as AIr");
Pexpr i = init->typ(tbl);
init = class_init(a,a->tp,i,tbl);
if (i!=init && init->base==DEREF) {
error('s',"K needed forAIr");
init = 0;
}
else {
dosimpl(init,cc->nof);
// init->simpl();
init->permanent = 2;
}
a->n_initializer = init;
}
}
else if (pt = a->tp->is_ref()) {
ref_initializer++;
init = init->typ(tbl);
ref_initializer--;
int tcount = stcount;
init = ref_init(pt,init,tbl);
if (tcount != stcount) {
error('s',"needs temporaryV to evaluateAIr");
init = 0;
}
else {
dosimpl(init,cc->nof);
// init->simpl();
init->permanent = 2;
}
a->n_initializer = init;
}
else {
Pptr p = a->tp->is_ptr();
init = init->typ(tbl);
if (p) init = ptr_init(p,init,tbl);
if (a->tp->check(init->tp,ARG)) {
int i = can_coerce(a->tp,init->tp);
switch (i) {
case 1:
if (Ncoerce) {
Pname cn = init->tp->is_cl_obj();
Pname xx = new name(Ncoerce->string);
Pref r = new ref(DOT,init,xx);
init = new expr(G_CALL,r,0);
init = init->typ(tbl);
}
break;
default:
error("%d possible conversions for defaultA",i);
case 0:
error("badIrT%t forA%n (%tX)",init->tp,a,a->tp);
DEL(init);
a->n_initializer = init = 0;
}
}
if (init) {
dosimpl(init,cc->nof);
// init->simpl();
init->permanent = 2;
a->n_initializer = init;
Neval = 0;
long i = init->eval();
if (Neval == 0) {
a->n_evaluated = 1;
a->n_val = i;
}
}
}
if ( a->n_initializer )
check_for_local(a->n_initializer);
}
}
if ( ansi_opt && argnamesize ) {
char* ps = new char[ argnamesize ];
Pname a = f->f_this;
if ( a && a->string ) {
int i = strlen(a->string) + 1;
if ( (argnamesize -= i) < 0 ) goto bad;
strcpy(ps,a->string);
a->string = ps;
ps += i;
}
a = f->f_result;
if ( a && a->string ) {
int i = strlen(a->string) + 1;
if ( (argnamesize -= i) < 0 ) goto bad;
strcpy(ps,a->string);
a->string = ps;
ps += i;
}
for ( a = f->argtype; a; a = a->n_list ) {
if ( a->string == 0 ) continue;
int i = strlen(a->string) + 1;
if ( (argnamesize -= i) < 0 ) goto bad;
strcpy(ps,a->string);
a->string = ps;
ps += i;
}
if ( argnamesize ) bad:error('i',"bad argN size for%t",f);
}
const_save = oo;
}
void merge_init(Pname nn, Pfct f, Pfct nf)
{
// Pname a1 = f->f_args; if (a1==0) a1 = f->argtype;
// Pname a2 = nf->f_args;//nf->argtype;
Pname a1 = f->argtype;
Pname a2 = nf->argtype;
for (; a1; a1=a1->n_list, a2=a2->n_list) {
int i1 = a1->n_initializer || a1->n_evaluated;
int i2 = a2->n_initializer || a2->n_evaluated;
if (i1 && i2) error(&a1->where,"twoIrs for%nA%n",nn,a1);
if (i1) {
a2->n_initializer = a1->n_initializer;
a2->n_evaluated = a1->n_evaluated;
a2->n_val = a1->n_val;
}
if (i2) {
a1->n_initializer = a2->n_initializer;
a1->n_evaluated = a2->n_evaluated;
a1->n_val = a2->n_val;
}
}
}
Pexpr try_to_coerce(Ptype rt, Pexpr e, char* s, Ptable tbl)
/*
``e'' is of class ``cn'' coerce it to type ``rt''
*/
{
int i;
Pname cn;
//error('d',"try_to_coerce(%t, %t, %s, %d)",rt,e->tp,s,tbl);
if ((cn=e->tp->is_cl_obj()) && (i=can_coerce(rt,e->tp)) && Ncoerce) {
if (1 < i) error("%d possible conversions for %s",i,s);
//error('d',"coerce %n",Ncoerce);
Pclass cl = Pclass(cn->tp);
// Pref r = new ref(DOT,e,Ncoerce);
// Pexpr rr = r->typ(tbl);
// Pexpr c = new expr(G_CALL,rr,0);
// c->fct_name = Ncoerce;
Pname xx = new name(Ncoerce->string);
Pref r = new ref(DOT,e,xx);
Pexpr c = new expr(G_CALL,r,0);
// return c->typ(tbl);
c = c->typ(tbl);
//error('d',"coerce -> %k %t",c->base,c->tp);
return c;
}
//error('d',"coerce ->0");
return 0;
}
int in_class_dcl;
Pname name::dofct(Ptable tbl, TOK scope)
{
Pfct f = Pfct(tp);
Pname class_name;
Ptable etbl;
in_class_dcl = cc->not!=0;
int just_made = 0;
// int fvirt = 0; //BSopt
DB( if(Ddebug>=1) error('d',"dofct %n %d %t %s",this,tp,tp,tbl==gtbl?"global":""); );
// error( 'd', "%n->dofct(): n_initializer: %d f->f_virtual: %d", this, n_initializer, f->f_virtual);
if (f->f_inline) n_sto = STATIC;
if (n_stclass)
switch (n_stclass) {
case EXTERN:
case STATIC:
case OVERLOAD:
break;
default:
error("%n declared%k",this,n_stclass);
n_stclass = EXTERN;
}
tp->dcl(tbl); // must be done before the type check
if (n_qualifier) { // qualified name: c::f() checked above
class_name = Pbase(n_qualifier->tp)->b_name;
etbl = Pclass(class_name->tp)->memtbl;
if (f->f_virtual) {
error("virtual specifier illegal outsideCD(%n::%s())",class_name,this->string);
f->f_virtual = 0;
}
if (n_sto
&& n_sto!=FRIEND // friend X::f();
&& f->f_inline==0) { // inline causes n_sto==STATIC
error("%k specified for QdN%n",n_sto,this);
n_sto = 0;
}
}
else {
class_name = cc->not;
// beware of local function declarations in member functions
if (class_name && tbl!=cc->cot->memtbl) {
class_name = 0;
in_class_dcl = 0;
}
if (f->f_static && f->f_virtual) {
error("virtual staticM");
f->f_virtual = 0;
}
if (n_oper) check_oper(class_name);
etbl = tbl;
}
// Pfct(tp)->memof = class_name ? Pclass(class_name->tp) : 0;
if (class_name) {
Pclass cl;
f->memof = cl = Pclass(class_name->tp);
if (f->f_virtual==0 && find_virtual(f->memof,this))
f->f_virtual = VTOK;
//error('d',"class_name: %s fct: %s virtual: %d", class_name->string, string, f->f_virtual );
if (f->f_static && f->f_virtual) {
error("virtual staticM");
f->f_virtual = 0;
}
if ( cl->csu == UNION && f->f_virtual ) // don't worry about ANON
error( "%n: cannot declare a virtualFWin union", this );
}
if(f->f_const && f->memof==0) {
error("onlyMFs can be constant");
}
if (etbl==0 || etbl->base!=TABLE) error('i',"N::dcl: etbl=%d",etbl);
switch (n_oper) {
case CTOR:
if (f->f_virtual) {
error("virtualK");
f->f_virtual = 0;
}
// case DTOR:
// f->f_const = 1;
break;
case REF:
if (f->argtype)
error("%n takes no argument",this);
else if (f->returns->is_ptr() == 0) {
Pname cn = f->returns->is_cl_obj();
if (cn==0 && f->returns->base==RPTR) cn = Pptr(f->returns)->typ->is_cl_obj();
if (cn==0 || Pclass(cn->tp)->has_oper(REF)==0) {
if ( cn && class_name && // B B::operator->();
strcmp(cn->string, class_name->string)==0 )
error("%s::%n cannot return aR orCO ofC%n",cn->string,this,cn);
else error("%n must return aP toCO, aR toCO, or aCO",this);
tp = any_type; // suppress further checking
}
}
break;
case NEW: // void* operator new(long)
if (f->f_virtual)
error("virtual%n (operator new() is static)",this);
if (class_name) f->f_static = 1; // if member: static by default
if (f->nargs_known != 1)
error("ATs must be fully specified for%n",this);
else if (f->nargs<1)
error("%n requires a firstA ofT size_t",this);
else if (f->argtype->tp->check(size_t_type,0)) {
if (strict_opt==0
&& ( f->argtype->tp->check(long_type,0)==0 ||
f->argtype->tp->check(ulong_type,0)==0)) {
error('w',"%n firstA should be size_t (anachronism)",this);
f->argtype->tp = size_t_type;
if (f->f_signature) f->sign();
}
else
error("%n requires a firstA ofT size_t",this);
}
else {
Ptype t = f->s_returns ? f->s_returns : f->returns;
if (t->check(Pvoid_type,0)) error("bad returnT for %n",this);
}
break;
case DELETE: // void operator delete(void*) or
// void operator delete(void*, long)
if (f->f_virtual)
error("virtual%n (operator delete() is static)",this);
if (class_name) f->f_static = 1; // if member: static by default
if (f->nargs_known != 1)
error("ATs must be fully specified for%n",this);
else {
Ptype t = f->s_returns ? f->s_returns : f->returns;
if (t->base != VOID)
error("bad returnT for %n", this);
else {
switch (f->nargs) {
default:
error("%n takes 1 or 2As",this);
break;
case 1:
case 2:
{ Pname a = f->argtype;
if (a->tp->check(Pvoid_type,0))
error("%n's 1stA must be a void*",this);
else if (a = a->n_list) {
if (class_name == 0)
error("%n takes only oneA",this);
else if (a->tp->check(size_t_type,0)) {
if (strict_opt==0
&& a->tp->check(long_type,0)==0) {
error('w',"%n's 2ndA should be a size_t (anachronism)",this);
a->tp = size_t_type;
if (f->f_signature) f->sign();
}
else
error("%n's 2ndA must be a size_t",this);
}
}
}
}
}
}
break;
case ASSIGN:
if (class_name && f->nargs==1) {
Ptype t = f->argtype->tp;
Pname an = t->is_cl_obj(); // X::operator=(X) ?
if (an==0 && (t=t->is_ref())) { // X::operator=(X&) ?
t = Pptr(t)->typ;
rx1:
switch (t->base) {
case TYPE: t = Pbase(t)->b_name->tp; goto rx1;
case COBJ: an = Pbase(t)->b_name;
}
}
if (an && an==class_name) Pclass(an->tp)->c_xref |= C_ASS;
}
else if (f->nargs == 2) {
Ptype t = f->argtype->tp;
Pname an1;
if (t=t->is_ref()) { // operator=(X&,?) ?
t = Pptr(t)->typ;
rx2:
switch (t->base) {
case TYPE: t = Pbase(t)->b_name->tp; goto rx2;
case COBJ: an1 = Pbase(t)->b_name;
}
}
t = f->argtype->n_list->tp;
Pname an2 = t->is_cl_obj(); // operator=(X&,X) ?
if (an2==0 && (t=t->is_ref())) { // operator=(X&,X&) ?
t = Pptr(t)->typ;
rx3:
switch (t->base) {
case TYPE: t = Pbase(t)->b_name->tp; goto rx3;
case COBJ: an2 = Pbase(t)->b_name;
}
}
if (an1 && an1==an2) Pclass(an1->tp)->c_xref |= C_ASS;
}
}
switch (scope) {
case FCT:
case ARG:
if (n_sto == STATIC) error("D of staticF in aF");
else { // detect local re-definition
Pname nx = gtbl->look(string,0);
if (nx) {
switch (nx->tp->base) {
case FCT:
if (tp->check(nx->tp,0))
error('w',"%n has been locally re-declared as%t",this,tp);
else {
if(Pfct(nx->tp)->f_signature==0)
Pfct(nx->tp)->sign();
if (Pfct(tp)->f_signature == 0)
Pfct(tp)->sign();
if ( strcmp(Pfct(nx->tp)->f_signature,Pfct(tp)->f_signature))
error('w',"%n of type %t has been locally re-declared with different linkage",this,tp);
}
break;
case OVERLOAD:
{ Pname ny = Pgen(nx->tp)->find(f,0);
if (ny == 0)
error('w',"overloadedF%n has been locally declared as%t",this,tp);
else {
if(Pfct(ny->tp)->f_signature==0)
Pfct(ny->tp)->sign();
if (Pfct(tp)->f_signature == 0)
Pfct(tp)->sign();
if (strcmp(Pfct(ny->tp)->f_signature,Pfct(tp)->f_signature))
error('w',"overloadedF%n of type %t has been locally re-declared with different linkage",this,tp);
}
}
break;
} // switch nx->base
} // if nx
} // else
} // switch scope
Pname nn = etbl->insert(this,0);
if ( f->body ) nn->where = where;
nn->assign();
n_table = etbl;
//error('d',"%n->dofct(): n_initializer:%d f->f_virtual:%d",this,n_initializer,f->f_virtual);
if (n_initializer) {
if (f->f_virtual == 0) error("Ir for non-virtualF%n",this);
if (n_initializer != zero) error("virtualFIr must be 0");
}
if (Nold) {
Pfct nf = Pfct(nn->tp);
// error('d',"old %n: %t and %t",nn,nf,tp);
int flag = 0;
Pname af=0,anf=0;
if (nf->base==ANY || f->base==ANY)
; // wild card -- do nothing
else
if (nf->base == OVERLOAD) {
string = nn->string;
nn = Pgen(nf)->add(this);
if (Nold == 0) {
if (f->body && n_qualifier) {
error("badAL for%n",this);
return 0;
}
goto thth;
}
// else {
// if (f->body==0 && friend_in_class==0) error('w',"%n redeclared",nn);
// }
nf = Pfct(nn->tp);
if (f->body && nf->body) {
// Preserve the original definition
// in the case of a PT class; i.e,
// the one supplied by the user
if (!(class_name &&
(Pclass(class_name->tp)->class_base ==
instantiated_template_class) &&
nn->n_redefined))
{
error("two definitions of%n",nn);
f->body = 0;
}
return 0;
}
if (f->body) goto bdbd;
goto stst;
}
else if (nf->base != FCT) {
error("%n declared both as%t and asF",this,nf);
f->body = 0;
}
else {
// error('d',"%t->check(%t) -> %d %d",nf,f,nf->check(f,OVERLOAD));
if (nf->check(f,OVERLOAD) || const_problem) {
if (f->body && n_qualifier) {
error("%nT mismatch: %t and %t",nn,nf,f);
return 0;
}
Pgen g = new gen;
add_first = 1;
Pname n1 = g->add(nn);
add_first = 0;
string = nn->string;
Pname n2 = g->add(this);
nn->tp = g;
nn = n2;
goto thth;
}
af = f->argtype;
anf = nf->argtype;
for (; af && anf; af=af->n_list,anf=anf->n_list) {
Ptype at = af->tp;
Ptype atp = anf->tp;
if(!exact1(af,atp)) break;
if(at->base!=PTR ||
Pptr(at)->rdo == Pptr(atp)->rdo) continue;
int k = Pptr(at)->typ->tconst();
int l = Pptr(atp)->typ->tconst();
if(k==l) flag=1;
}
if ( flag && !af && !anf) {
error("the overloading mechanism cannot tell a%t from a%t",nf,f);
}
if (in_class_dcl) {
// error("twoDs of%n",this);
// f->body = 0;
// return 0;
}
else if (nf->f_static && f->f_inline==0 && n_sto==STATIC) {
//error('d',"MF%n declared static outsideF",this);
n_sto = 0;
}
else if (n_sto && n_sto!=nn->n_scope) {
if (n_sto==EXTERN && nn->n_scope==STATIC)
error('w',"%n declared extern after being declared static",this);
else if (nf->f_inline==0 && f->f_inline==0) {
if (nn->tp==new_fct->tp || nn->tp==del_fct->tp)
nn->n_sto = n_sto;
else
error("%n declared as both%k and%k",this,n_sto,(nn->n_sto)?nn->n_sto:EXTERN);
}
}
//error('d',"fct %n: %k %k scope %k",this,n_sto,nn->n_sto,nn->n_scope);
//error('d',"link %d lcount %d sig %s",linkage,lcount,nf->f_signature);
{
Linkage l1 = nf->f_linkage;
Linkage l2 = f->f_linkage;
if ( l2!=linkage_default && l1!=l2)
error("inconsistent linkage specifications for%n",this);
}
if (nf->body && f->body) {
// Preserve the original definition
// in the case of a PT class; i.e,
// the one supplied by the user
if (!(class_name &&
(Pclass(class_name->tp)->class_base ==
instantiated_template_class) &&
nn->n_redefined))
{
error("two definitions of%n",this);
f->body = 0;
}
return 0;
}
if (f->body) goto bdbd;
goto stst;
bdbd:
// error('d',"nn %n init: %d f_virt: %d f->body: %d", nn,nn->n_initializer,nf->f_virtual,f->body);
if (f->nargs_known && nf->nargs_known) merge_init(nn,f,nf);
f->f_virtual = nf->f_virtual;
f->f_this = nf->f_this;
f->f_result = nf->f_result;
f->s_returns = nf->s_returns;
f->f_args = nf->f_args;
// f->argtype = nf->argtype;
f->f_signature = nf->f_signature;
f->f_const = nf->f_const;
f->f_static = nf->f_static;
nn->tp = f;
if (f->f_inline) {
if (nf->f_inline==0) {
if (nn->n_used && nn->n_sto!=STATIC)
error("%n declared with external linkage and called before defined as inline",nn);
// else if (nf->memof)
// error('w',"%n declared as non-inline but defined as inline",nn);
else if (nn->n_used) {
nn->take_addr(); // force printout
if (warning_opt) error('w',"%n called before defined as inline",nn);
}
}
nf->f_inline = 1;
nn->n_sto = STATIC;
}
else if (nf->f_inline) {
// error('w',"%n defined as inline but not declared as inline",this);
f->f_inline = 1;
}
goto stst2;
stst:
//error('d',"stst");
if (f->nargs_known && nf->nargs_known) merge_init(nn,f,nf);
f->f_args = nf->f_args;
// f->argtype = nf->argtype;
stst2:
//error('d',"stst2 %n printed %d",nn,nn->n_dcl_printed);
if (f->f_inline) n_sto = STATIC;
/* superceded above (line 1978 and following)
if (n_sto
&& nn->n_scope!=n_sto
&& friend_in_class==0
&& f->f_inline==0){ // allow re-def to "static"
if (n_sto == STATIC)
nn->n_sto = STATIC;
else {
error("%n both%k and%k",this,n_sto,nn->n_scope);
}
}
*/
//// addition for 2.1
if(n_sto == STATIC && nn->n_sto == EXTERN &&
(!strcmp(string,"__nw") || !strcmp(string,"__dl")))
nn->n_sto = STATIC;
//// end of addition
n_scope = nn->n_scope; // first specifier wins
n_sto = nn->n_sto;
}
}
else { // new function: make f_this for member functions
thth:
just_made = 1;
if (f->f_inline)
nn->n_sto = STATIC;
else if (class_name==0 && n_sto==0 && f->body==0)
nn->n_sto = EXTERN;
//error('d',"thth %n %t static %d sto %k",nn,f,f->f_static,nn->n_sto);
if (f->f_static)
switch (n_oper) { // what about + ??
case CTOR:
case DTOR:
case TYPE:
case CALL:
case DEREF:
case REF:
case ASSIGN:
error("%n cannot be a staticMF",nn);
f->f_static = 0;
}
if (class_name
&& f->f_static==0 // no ``this'' in static members
&& n_oper!=NEW // X::operator new() static by default
&& n_oper!=DELETE // X::operator delete() static by default
&& etbl!=gtbl) { // beware of implicit declaration
Pname cn = nn->n_table->t_name;
Pname tt = new name("this");
tt->n_scope = ARG;
tt->where = no_where;
// tt->n_sto = ARG;
tt->tp = Pclass(class_name->tp)->this_type;
PERM(tt);
Pfct(nn->tp)->f_this = f->f_this = Pfct(nn->tp)->f_args = f->f_args = tt;
tt->n_list = f->argtype;
//error('d',"nn %n tp %t const %d",nn,nn->tp,f->f_const);
if (f->f_const /*&& n_oper!=CTOR && n_oper!=DTOR*/) {
Pbase x = Pbase(Pptr(tt->tp)->typ);
Pbase y = new basetype(COBJ,0);
*y = *x;
y->b_const = 1;
tt->tp = new ptr(PTR,y);
Pptr(tt->tp)->rdo = 1;
PERM(tt->tp);
}
}
else {
Pfct(nn->tp)->f_args = f->f_args = f->f_result?f->f_result:f->argtype;
Pfct(nn->tp)->f_signature = f->f_signature;
Pfct(nn->tp)->f_const = f->f_const;
Pfct(nn->tp)->f_static = f->f_static;
}
// if C++ linkage encode type in function name
if (Pfct(nn->tp)->f_signature==0) Pfct(nn->tp)->sign();
if (f->f_result == 0) {
//error('d',"re1 %n %t %d",this,f,f);
make_res(f);
}
else if (f->f_this)
f->f_this->n_list = f->f_result;
if (nn->n_oper==CTOR || nn->n_oper==DTOR) vbase_pointers(nn,Pclass(class_name->tp));
if (f->f_virtual) {
switch (nn->n_scope) {
default:
error("nonC virtual%n",this);
break;
case 0:
case PUBLIC:
// if (fvirt) //BSopt
cc->cot->virt_count = 1;
Pfct(nn->tp)->f_virtual = f->f_virtual;
break;
}
}
}
/* an operator must take at least one class object or
reference to class object argument
*/
if (just_made)
switch (n_oper) {
case CTOR:
switch (f->nargs) { // check for X(X) and X(X&)
case 0:
break;
default: // handle X(X&, int i = 0)
{ Pname n2 = f->argtype->n_list;
if (n2->n_initializer==0 && n2->n_evaluated==0) break;
}
case 1:
{
Ptype t = f->argtype->tp;
clll:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto clll;
case RPTR: /* X(X&) ? */
t = Pptr(t)->typ;
cxll:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto cxll;
case COBJ:
if (class_name == Pbase(t)->b_name)
Pclass(class_name->tp)->c_itor = nn;
}
break;
case COBJ: /* X(X) ? */
if (class_name == Pbase(t)->b_name) {
error("badK %s(%s) use %s(%s&)",class_name->string,class_name->string,class_name->string,class_name->string);
f->argtype->tp = any_type;
}
}
}
}
if (Pclass(class_name->tp)->c_ctor == 0) Pclass(class_name->tp)->c_ctor = nn;
break;
case TYPE:
// somewhat simple minded solution to the inheritance of
// conversion operator problem
nn->n_list = Pclass(class_name->tp)->conv;
Pclass(class_name->tp)->conv = nn;
break;
case DTOR:
Pclass(class_name->tp)->c_dtor = nn;
break;
case NEW:
case DELETE:
case CALL:
case 0:
break;
default:
for (Pname a=f->argtype; a; a=a->n_list) {
if ( a->n_initializer )
error( "%n: operatorFs cannot take defaultA", this );
}
if (f->nargs_known != 1) {
error("ATs must be fully specified for%n",nn);
}
// this doesn't catch unary operator off by one errors
// for simplicity, placed that check in check_oper(), above
else if (class_name == 0) {
switch (f->nargs) {
case 1:
case 2:
for (a=f->argtype; a; a=a->n_list) {
Ptype tx = a->tp;
while (tx->base == TYPE) tx = Pbase(tx)->b_name->tp;
if (tx->is_ref()) tx = Pptr(tx)->typ;
if (tx->is_cl_obj()) goto cok;
}
error("%n must take at least oneCTA",nn);
break;
default:
error("%n must take 1 or 2As",nn);
}
}
else {
switch (f->nargs) {
case 0:
case 1:
break;
default:
error("%n must take 0 or 1As",nn);
}
}
cok:;
}
int i = 0; // check that every argument after an argument with
// initializer have an initializer
for (Pname a = f->f_args/*f->argtype*/; a; a=a->n_list) {
if (a->n_initializer)
i = 1;
else if (i)
error("trailingA%n withoutIr",a);
}
/*
the body cannot be checked until the name
has been checked and entered into its table
*/
if (f->body) f->dcl(nn);
return nn;
}
0707071010112043711004440001630000160000010174600466055376600000700000154273dcl4.c /*ident "@(#)ctrans:src/dcl4.c 1.4" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
dcl4.c:
Declaration of class and enum
*************************************************************************/
#include "cfront.h"
#include "size.h"
#include "template.h"
Pname find_vptr(Pclass);
void fix_args(Pfct f, Pclass cl)
/*
This function is used to cope with the case where cl::cl(cl&) is
declared AFTER f has been declared
set n_xref bit for f
*/
{
for (Pname a = f->argtype; a; a = a->n_list) {
Pname n = a->tp->is_cl_obj();
if (n && Pclass(n->tp)==cl) a->n_xref = 1;
}
}
Pname merge_conv(Pname c1, Pname c2)
{
if (c1 == 0) return c2;
if (c2 == 0) return c1;
if (c1 == c2) return c1;
error('s',"cannot merge lists of conversion functions");
return c1;
}
static Eppp;
char* get_classname(char* s)
/*
retrieve the outermost class name in a vtable name
*/
{
//error('d',"get_classname(%s)",s);
char* s1 = 0;
while (*s) {
s1 = s;
for ( ; s[0] && (s[0] != '_' || s[1] && s[1] != '_'); s++);
if (*s) s += 2; // bypass "__"
}
return s1;
}
char* drop_classname(char* s)
/*
retrieve all but the outermost class name in a vtable name
*/
{
//error('d',"drop_classname(%s)",s);
char* r = new char[strlen(s)+1];
sprintf(r,s);
s = r;
char* s1 = s;
while (*s) {
for ( ; s[0] && (s[0] != '_' || s[1] && s[1] != '_'); s++);
if (*s) {
s1 = s;
s += 2; // bypass "__"
}
}
*s1 = '\0';
return (*r) ? r : 0;
}
Pbcl classdef::get_base( char *s )
/*
Find the base class whose name matches the argument
*/
{
//error('d',"%t::get_base(%s)",this,s);
for (Pbcl b = baselist; b; b = b->next) {
for ( char *s1 = s, *s2 = b->bclass->string;
*s1 && *s2 && *s1 == *s2;
s1++, s2++);
if (!(*s1 || *s2))
break;
}
return b;
}
int classdef::get_offset(char* s)
/*
Get offset represented by string as viewed from "this"
*/
{
//error('d',"%t::get_offset(%s)",this,s);
if (!s) return 0;
Pbcl b = get_base(get_classname(s));
return b->obj_offset + b->bclass->get_offset(drop_classname(s));
}
char* vtbl_str(char* s1, char* s2)
/*
combine two pieces of a vtbl name
*/
{
//error('d',"vtbl_str(%s,%s)",s1,s2);
char* s3;
if (s1)
if (s2) {
s3 = new char[strlen(s1)+strlen(s2)+3];
sprintf(s3,"%s__%s",s1,s2);
return s3;
}
else
return s1;
else
return s2;
}
void classdef::add_vtbl(velem* v, char* s, bit virt_flag, int n_init)
/*
add vtbl to virt_list
*/
{
// error('d',"%t->add_vtbl(%d,%s)",this,v,s);
Pvirt vtab = new virt(this, v, s, virt_flag, n_init);
if (virt_flag) has_vvtab = 1;
if (!virt_list) {
virt_list = vtab;
return;
}
// If conficting vtable entries are made because of
// a virtual base class, must be considered an error.
for (Pvirt vt = virt_list; vt; vt = vt->next )
// if (strcmp(vt->string,s)==0) {
if (vt->string && strcmp(vt->string,s)==0) {
velem* ivec = vt->virt_init;
Pname on = ivec[0].n;
Pname nn = v[0].n;
Pclass ocl,ncl;
for (int i=0; on && nn; i++,on=ivec[i].n,nn=v[i].n) {
ocl = Pfct(on->tp)->memof;
ncl = Pfct(nn->tp)->memof;
if (on != nn)
if (!ocl->has_base(ncl))
if (!ncl->has_base(ocl))
break;
else {
ivec[i].n = nn;
ivec[i].offset = v[i].offset;
}
}
if (on || nn)
error("virtualB: ambiguous%n and%n", on, nn);
return;
}
vtab->next = virt_list->next;
virt_list->next = vtab;
}
static int Voffset; // cope with offsets of virtuals in deep nests
int vcounter;
static vmax;
const vpChunk = 32;
int classdef::do_virtuals(Pvirt vtab, char* str, int leftmost, bit virt_flag)
/*
make vtbl for b in "this"
match up virtuals and assign virtual indices for the base or delegate "bcl"
first base class shares ``this'' and vtbl with this class
*/
{
if (vmax<vcounter) vmax = vcounter;
int vpsz = (vmax+vcounter)/vpChunk+1; // fragmentation prevention
vpsz *= vpChunk;
Pname* vp = new Pname[vpsz];
velem* ivec = vtab ? vtab->virt_init : 0;
int vo = Voffset;
int vc = 0;
int changed = 0;
// error('d',"%t->do_virtuals(%d,%s) voffset %d",this,vtab,str,Voffset);
// error('d',"virt_count %d vpsz %d vcounter %d",virt_count,vpsz,vcounter);
if (ivec) { // vtbl replacement for ivec
if (vtab->is_vbase) {
str = 0;
Voffset = get_offset(vtab->string);
}
else
Voffset = Voffset + vtab->vclass->get_offset(vtab->string);
Pname vn;
for (int i=0; vn=ivec[i].n; i++) {
/* go through virtual table's list of virtuals:
first see if the function is simply inherited
if not, check for a match
if not, then add as new
*/
// Pname vn = ivec[i];
if ( i >= vpsz ) { // resize vp vector
int tvpsz = vpsz + vpChunk;
Pname *tvp = new Pname[ tvpsz ];
for ( int j = 0; j < i; ++j )
tvp[ j ] = vp[ j ];
delete [vpsz] vp;
vp = tvp;
//error( 'd',"resizing: i: %d vpsz: %d tvpsz: %d", i, vpsz, tvpsz );
vpsz = tvpsz;
}
// char* s = Pchar(vn->n_tbl_list);
char* s = vn->n_gen_fct_name;
Pname n = memtbl->look(s?s:vn->string, 0);
// error('d',"vn %n %s n %n %d",vn,s,n,Voffset);
// error('d',"n %n %k", n, n?n->base:0 );
if (n == 0 || // FCT + FCT
n->base == PUBLIC ) { // base::FCT
inher: // inherit
// if (vn->n_initializer) error("cannot inherit pure virtualF%n",vn);
if (vn->n_initializer) c_abstract = 1;
vp[i] = vn;
if ( ivec[i].offset && vtab->is_vbase )
vp[i]->n_offset = Voffset - vo;
else
vp[i]->n_offset = ivec[i].offset;
continue;
}
Pfct f = Pfct(n->tp);
// error ('d', "f %d", f );
if (f == 0 ) continue;
// error('d',"f %t %d",f,f->f_virtual);
if (s && f->base==OVERLOAD) { // OVERLOAD + OVERLOAD
// vn is overloaded and s is its name
for (Plist gl=Pgen(f)->fct_list; gl; gl=gl->l)
if (gl->f == vn) goto inher;
}
Pfct vnf = Pfct(vn->tp);
// re-define?
switch (f->base) {
default:
error('w',&n->where,"%n hides virtual%n",n,vn);
vp[i] = vn; // not a new overloaded: inherit
if ( ivec[i].offset && vtab->is_vbase )
vp[i]->n_offset = Voffset - vo;
else
vp[i]->n_offset = ivec[i].offset;
break;
case FCT: // derived::FCT
{
if (vnf->check(f,VIRTUAL) == 0) { // derived::FCT match base::FCT
// error('d',"vnf1 %t f %t vcheck %d",vnf,f,Vcheckerror);
// VTOK: virtual, but no index assigned
// you can only inherit an index from your first base
if (Vcheckerror) error("bad virtualT match for %n",vn);
if (f->f_virtual==VTOK) f->f_virtual = i+1;
vp[i] = n;
vp[i]->n_offset = Voffset;
changed = 1;
}
else {
// error('d',"vnf2 %t f %t vcheck %d",vnf,f,Vcheckerror);
if (Vcheckerror)
error("bad virtualT match for %n",vn);
else
switch (f->f_virtual) {
case 0:
case VTOK:
error('w',&n->where,"%n hides virtual%n",n,vn);
}
vp[i] = vn; // not a new overloaded: inherit
if ( ivec[i].offset && vtab->is_vbase )
vp[i]->n_offset = Voffset - vo;
else
vp[i]->n_offset = ivec[i].offset;
}
break;
}
case OVERLOAD: // derived::OVERLOAD
{
int hit = 0;
for (Plist gl=Pgen(f)->fct_list; gl; gl=gl->l) {
// try each fct from derived class
Pname fn = gl->f;
Pfct f = Pfct(fn->tp);
if (f->check(vnf,VIRTUAL) == 0) { // derived::FCT
if (Vcheckerror) error("bad virtualT match for %n",vn);
if (f->f_virtual==VTOK) f->f_virtual = i+1;
vp[i] = fn;
vp[i]->n_offset = Voffset;
changed = 1;
goto found;
}
else {
if (Vcheckerror) error("bad virtualT match for %n",vn);
}
if (Vcheckerror == 0)
switch (f->f_virtual) {
case 0:
case VTOK:
hit = 1;
}
}
if (hit)
error('w',&n->where,"%n hides virtual%n ofT %t",n,vn,vn->tp);
vp[i] = vn; // not a new overloaded: inherit
if ( ivec[i].offset && vtab->is_vbase )
vp[i]->n_offset = Voffset - vo;
else
vp[i]->n_offset = ivec[i].offset;
found:
break;
}
}
}
Voffset = vo;
vc = i;
}
// error( 'd', "do_virtuals: out of loop: vc: %d vpsz: %d changed: %d", vc, vpsz,changed );
if (leftmost) {
/*
add new virtuals:
`VTOK' marks ``new virtual, no index assigned''.
You can only be new once (no base or first base).
*/
int i;
for (Pname nn=memtbl->get_mem(i=1); nn; nn=memtbl->get_mem(++i) ) {
Pfct f = Pfct(nn->tp);
if ( vc >= vpsz ) { // resize vp vector
int tvpsz = vpsz + vpChunk;
Pname *tvp = new Pname[ tvpsz ];
for ( int j = 0; j < vc; ++j )
tvp[ j ] = vp[ j ];
delete [vpsz] vp;
vp = tvp;
vpsz = tvpsz;
}
// error('d',"f %n %t",nn,f);
if (f)
switch (f->base) {
case FCT:
//error('d',"fv %d",f->f_virtual);
if (f->f_virtual == VTOK) {
// declared virtual, or
// virtual in some base
f->f_virtual = ++vc;
vp[f->f_virtual-1] = nn;
vp[f->f_virtual-1]->n_offset = 0;
f->f_vdef = 1;
changed = 2;
}
break;
case OVERLOAD:
{ for (Plist gl=Pgen(f)->fct_list; gl; gl=gl->l) {
Pname fn = gl->f;
Pfct f = Pfct(fn->tp);
if ( vc >= vpsz ) { // resize vp vector
int tvpsz = vpsz + vpChunk;
Pname *tvp = new Pname[ tvpsz ];
for ( int j = 0; j < vc; ++j ) {
tvp[ j ] = vp[ j ];
}
delete [vpsz] vp;
vp = tvp;
vpsz = tvpsz;
}
if (f->f_virtual == VTOK) {
f->f_virtual = ++vc;
vp[f->f_virtual-1] = fn;
vp[f->f_virtual-1]->n_offset = 0;
f->f_vdef = 1;
changed = 2;
}
}
break;
}
}
}
// error('d',"%s changed %d has_vvtab %d",string,changed,has_vvtab);
// error('d',"vc %d vpsz %d",vc,vpsz);
virt_count = 0;
if (changed)
virt_count = vc;
else if (has_vvtab) {
virt_merge = 1;
if (vc && vtab->is_vbase)
leftmost = 0;
}
}
// error('d',"vc %d ch %d vp[%d] virt_count %d",vc,changed,vpsz,virt_count);
if (changed || !leftmost) {
// vc==0 if all explicit virtuals in fact were declared in base
velem* v = new velem[vc+1];
for (int i=0; i<vc; i++) {
v[i].n = vp[i];
v[i].offset = vp[i]->n_offset;
}
v[vc].n = 0;
if (leftmost)
add_vtbl(v,0,0,0);
else
add_vtbl(v,vtbl_str(vtab->string,str),virt_flag||vtab->is_vbase,vc+1);
delete vp;
vcounter = 0;
return 1;
}
delete vp;
vcounter = 0;
return 0;
}
int classdef::all_virt(Pclass bcl, char* s, int leftmost, bit virt_flag)
{
int i = 0;
if (bcl->virt_count) {
for (Pvirt blist = bcl->virt_list; blist; blist = blist->next) {
// if (has_base(blist->vclass))
// if (blist->vclass==bcl
// // bcl is virtual in both
// || ((Nvirt=0,blist->vclass->has_base(bcl)) && Nvirt==VIRTUAL
// && (Nvirt=0,has_base(bcl)) && Nvirt==VIRTUAL
// )
// )
if (virt_merge && !(virt_flag || blist->is_vbase))
continue;
i += do_virtuals(blist, s, leftmost, virt_flag);
if (!i && leftmost && !virt_merge)
return 0;
leftmost = 0;
}
}
// finding virt_list stops recursive step
// if vtables found and updated, return number
if (i) return i;
for (Pbcl b = bcl->baselist; b; b = b->next) {
// if (b->base==PTR) continue;
if (b->promoted) continue;
// error('d',"b %t vl %d bl %d",b->bclass,b->bclass->virt_list,b->bclass->baselist);
if (leftmost && b->base == VIRTUAL) {
i += do_virtuals(0, 0, 1, 0);
if (!i && !virt_merge)
return 0;
leftmost = 0;
}
int vo = Voffset;
Voffset += b->obj_offset;
// error('d',"offset %t %d",b->bclass,Voffset);
if (b->base==VIRTUAL)
i += all_virt(b->bclass, b->bclass->string, leftmost, 1);
else
i += all_virt(b->bclass, vtbl_str(b->bclass->string,s), leftmost, virt_flag);
if (!i && leftmost && !virt_merge)
return 0;
Voffset = vo;
leftmost = 0;
}
// if recursion updated vtables, return number
if (i) return i;
// no vtables updated in recursion
// look for new virtuals
if (leftmost)
return do_virtuals(0, 0, 1, 0);
else
return 0;
}
Pexpr copy_obj(Pexpr l, Pexpr r, int sz)
/*
generate:
struct _s { char[sz]; };
*(struct _s*)this->m = *(struct _s*)arg.mem;
*/
{
if ( !sz ) sz = 1;
//error('d',"copy(%d)",sz);
char* s = make_name('S');
fprintf(out_file,"struct %s { char v[%d]; };\n",s,sz);
Pname n = new name(s);
Ptype t = new basetype(COBJ,n);
t = new ptr(PTR,t);
l = new texpr(CAST,t,l);//new cast(t,l);
l = l->contents();
r = new texpr(CAST,t,r);//new cast(t,r);
r = r->contents();
return new expr(ASSIGN,l,r);
}
/*
Pname make_default_ctor(Pclass cl)
{
//error('d',"make_ctor %t",cl);
Pname cn = ktbl->look(cl->string,0);
if (cn) cn = Pbase(cn->tp)->b_name;
cc->stack();
cc->not = cn;
cc->cot = cl;
Pname fn = new name(cl->string);
Pfct f = new fct(defa_type,0,1);
fn->tp = f;
fn->n_oper = TNAME;
// fn->n_sto = STATIC;
Pfct(f)->f_inline = 1;
f->body = new block(curloc,0,0);
Pname nn = fn->dcl(cl->memtbl,PUBLIC);
delete fn;
cc->unstack();
nn->simpl();
if (debug_opt) nn->dcl_print(0);
//error('d',"make_ctor->");
return nn;
}
Pname make_default_dtor(Pclass cl)
{
//error('d',"make_dtor %t",cl);
Pname cn = ktbl->look(cl->string,0);
if (cn) cn = Pbase(cn->tp)->b_name;
cc->stack();
cc->not = cn;
cc->cot = cl;
Pname fn = new name(cl->string);
Pfct f = new fct(defa_type,0,1);
fn->tp = f;
fn->n_oper = DTOR;
// fn->n_sto = STATIC;
Pfct(f)->f_inline = 1;
f->body = new block(curloc,0,0);
Pname nn = fn->dcl(cl->memtbl,PUBLIC);
delete fn;
cc->unstack();
nn->simpl();
if (debug_opt) nn->dcl_print(0);
//error('d',"make_dtor->");
return nn;
}
*/
Ptype find_arg_type(Pclass cl)
// first determine argument type
{
int i;
int mod = 0;
for (Pbcl b = cl->baselist; b; b = b->next) {
Pclass bcl = b->bclass;
switch (b->base) {
case VIRTUAL:
case NAME: // generate :b(*(b*)&arg)
{
Pname itor = bcl->has_itor();
if (itor && itor->tp->base==FCT) {
Pname a = Pfct(itor->tp)->argtype;
Pptr p = a->tp->is_ref();
if (p && p->typ->tconst()==0) {
mod = 1;
goto ll1;
}
}
}
}
}
ll1:
if (mod == 0) {
for (Pname m=cl->memtbl->get_mem(i=1); m; m=cl->memtbl->get_mem(++i) ) {
Pname cln;
// ignore static members
if (m->n_evaluated || m->n_stclass==STATIC) continue;
if (cln = m->tp->is_cl_obj()) {
Pname itor = Pclass(cln->tp)->has_itor();
if (itor && itor->tp->base==FCT) {
Pname a = Pfct(itor->tp)->argtype;
Pptr p = a->tp->is_ref();
if (p && p->typ->tconst()==0) {
mod = 1;
goto ll2;
}
}
}
}
}
ll2:
//error('d',"mod %d",mod);
Pbase bp = new basetype(INT,0);
*bp = *Pbase(Pptr(cl->this_type)->typ);
if (mod == 0) bp->b_const = 1;
return new ptr(RPTR,bp);
}
Pname classdef::make_itor(int def)
/*
make cn::cn(const cn&) :bases_and_members_of_cn {}
*/
{
//error('d',"%t->make_itor(%d) %d",this,def,obj_size);
Pstmt s;
Pname e;
int i;
Pname arg = new name(make_name('A'));
arg->tp = find_arg_type(this);
// c_xref = 2; // now it has X(X&)
c_xref |= C_XREF; // now it has X(X&)
if (def) {
// define itor
int slow = 0; // slow==0 => copy using vector copy
int first = 1;
Pexpr es = 0;
s = new estmt(SM,no_where,0,0);
e = 0;
if (warning_opt && 128<obj_size)
error('w',"copying a %d byte object (ofC %s)",obj_size,string);
if (baselist) slow = 1;
//for (Pbcl v = baselist; v; v = v->next)
// if (v->base == VIRTUAL) {
// slow = 1;
// break;
// }
// initialize bases:
if (slow) {
for (Pbcl b = baselist; b; b = b->next) {
Pclass bcl = b->bclass;
Ptype pt = bcl->this_type;
//error('d',"base %t %k offset %d ptroffset %d",bcl,b->base,b->obj_offset,b->ptr_offset);
switch (b->base) {
case VIRTUAL:
case NAME: // generate :b(*(b*)&arg)
{
Pexpr b2 = new name(arg->string);
b2 = b2->address();
b2 = new texpr(CAST,pt,b2);//new cast(pt,b2);
b2->i2 = 1;
b2 = b2->contents();
Pname ee = new name(bcl->string);
ee->base = TNAME;
ee->n_initializer = b2;
if (e) ee->n_list = e;
e = ee;
break;
}
}
}
}
// initialize members
for (Pname m=memtbl->get_mem(i=1); m; m=memtbl->get_mem(++i) ) {
// ignore static members
if (m->n_evaluated || m->n_stclass==STATIC) continue;
if (strcmp(m->string,"__vptr")==0) {
// error('d',"%t vptr: %d",this,first);
if (first==0 && m->n_offset) {
Pexpr th = new expr(THIS,0,0);
Pexpr a = new name(arg->string);
a = a->address();
Pexpr ee = copy_obj(th,a,m->n_offset);
es = es ? new expr(CM,es,ee) : ee;
}
slow = 1;
first = 0;
continue;
}
Ptype mt = m->tp;
tx:
switch (mt->base) {
case TYPE:
mt = Pbase(mt)->b_name->tp;
goto tx;
case VEC:
{ Pname cn = Pvec(mt)->typ->is_cl_obj();
//error('d',"vec %n %t xref %d",m,mt,cn?Pclass(cn->tp)->c_xref:0);
if (cn && Pclass(cn->tp)->c_xref&(C_XREF|C_VBASE)) {
error('s',"copy of %n[], no memberwise copy for%n",cn,cn);
slow = 1; // make sure an assignment operator
// is generated so that there will
// be no more error messages
}
if (slow && mt->tsizeof()) {
/*
generate:
struct _s { char[sizeof(m)]; };
*(struct _s*)this->m = *(struct _s*)arg.mem;
*/
Pexpr l = new name(m->string);
Pexpr r = new name(m->string);
r = new ref(DOT,new name(arg->string),r);
Pexpr ee = copy_obj(l,r,mt->tsizeof());
es = es ? new expr(CM,es,ee) : ee;
break;
}
}
case FCT:
case OVERLOAD:
case CLASS:
case ENUM:
break;
case COBJ:
{ Pclass mcl = Pclass(Pbase(mt)->b_name->tp);
if (slow==0 // if slow, previous members have
// already been copied
&& mcl->c_xref&(C_VBASE|C_XREF)) {
slow = 1;
if (first==0 && m->n_offset) {
//AAA copy up to here
Pexpr th = new expr(THIS,0,0);
Pexpr a = new name(arg->string);
a = a->address();
Pexpr ee = copy_obj(th,a,m->n_offset);
es = es ? new expr(CM,es,ee) : ee;
}
}
// no break
}
default:
if (slow) {
//error('d',"slow %s %s",m->string,arg->string);
Pname ee = new name(m->string);
ee->n_initializer = new ref(DOT,new name(arg->string),new name(m->string));
if (e) ee->n_list = e;
e = ee;
}
}
first = 0;
}
if (slow == 0) {
/* really simple just copy:
the only problem was a vptr which can be
ignored since X(X&) is going to reset it anyway
don't use assignment of this struct to avoid operator=
*/
Pexpr th = new expr(THIS,0,0);
Pexpr a = new name(arg->string);
a = a->address();
Pexpr ee = copy_obj(th,a,obj_size);
es = es ? new expr(CM,es,ee) : ee;
}
s->e = es;
Pname cn = ktbl->look(string,0);
if (cn) cn = Pbase(cn->tp)->b_name;
cc->stack();
cc->not = cn;
cc->cot = this;
}
Pname fn = new name(string);
Pfct f = new fct(defa_type,arg,1);
fn->tp = f;
fn->n_oper = TNAME;
// fn->n_sto = STATIC;
Pfct(f)->f_inline = def?1:ITOR; // ITOR means ``define itor() if used''
if (def) {
f->body = new block(curloc,0,s);
f->f_init = e;
}
Pname nn = fn->dcl(memtbl,PUBLIC);
delete fn;
if (def) {
cc->unstack();
nn->simpl();
if (debug_opt) nn->dcl_print(0);
}
//error('d',"make_itor->");
return nn;
}
int make_assignment(Pname cn)
/*
write the function:
X& X::operator=(const X&) { assign all bases and members }
return 1 is a function is really synthesized
*/
{
Pclass cl = Pclass(cn->tp);
Pstmt s = new estmt(SM,no_where,0,0);
Pexpr e = 0;
Pname arg = new name(make_name('A'));
basetype* bp = new basetype(INT,0);
*bp = *Pbase(Pptr(cl->this_type)->typ);
bp->b_const = 1;
// arg->tp = new ptr(RPTR,bp);
arg->tp = find_arg_type(cl);
//error('d',"make_assignment %t %d",cl,cl->obj_size);
// cl->c_xref |= 4; // now it has X::operator=(const X&)
if (warning_opt && 128<cl->obj_size)
error('w',"copying a %d byte object (ofC %s)",
cl->obj_size,cl->string);
{
int slow = 0; // slow==0 => copy using vector copy
int first = 1; // first==1 => first member of (derived) class
if (cl->baselist) slow = 1; // be dumb and safe
// for (Pbcl v = cl->baselist; v; v = v->next)
// if (v->base==VIRTUAL || v->c_xref&(C_VBASE|C_ASS)) {
// slow = 1;
// break;
// }
if (slow) {
for (Pbcl b = cl->baselist; b; b = b->next) {
Pclass bcl = b->bclass;
Ptype pt = bcl->this_type;
switch (b->base) {
case NAME:
{ // generate: *(bcl*)this = *(bcl*)&arg;
//error('d',"base %t",bcl);
Pexpr b1 = new expr(THIS,0,0);
b1 = new texpr(CAST,pt,b1);
b1 = b1->contents();
Pexpr b2 = new name(arg->string);
b2 = b2->address();
b2 = new texpr(CAST,pt,b2);
b2->i2 = 1;
b2 = b2->contents();
Pexpr ee = new expr(ASSIGN,b1,b2);
e = e ? new expr(CM,e,ee) : ee;
break;
}
case VIRTUAL:
if (warning_opt)
error('w',"copying an object ofC%n with a virtualBC",cn);
if (b->ptr_offset) {
// copy object, but not pointer
// generate: *(bcl*)this->Pw = *(bcl*)arg->Pw;
// I don't know how to avoid copying the object
// once for each pointer
Pexpr b1 = new expr(THIS,0,0);
b1 = new mdot(bcl->string,b1);
b1->i1 = 3;
b1->tp = pt;
b1 = new expr(DEREF,b1,0);//b1->contents();
Pexpr b2 = new name(arg->string);
b2 = b2->address();
b2 = new mdot(bcl->string,b2);
b2->i1 = 3;
b2->tp = pt;
b2 = new expr(DEREF,b2,0);//b2->contents();
Pexpr ee = new expr(ASSIGN,b1,b2);
e = e ? new expr(CM,e,ee) : ee;
}
break;
}
}
}
int i;
for (Pname m=cl->memtbl->get_mem(i=1); m; m=cl->memtbl->get_mem(++i) ) {
// ignore static members
if (m->n_evaluated || m->n_stclass==STATIC) continue;
if (strcmp(m->string,"__vptr")==0) { // don't copy vptrs
// we may be copying
// into a base class object
if (first==0 && m->n_offset) {
// copy up to (but not including) vptr
// don't copy if first member
Pexpr th = new expr(THIS,0,0);
Pexpr a = new name(arg->string);
a = a->address();
Pexpr ee = copy_obj(th,a,m->n_offset);
e = e ? new expr(CM,e,ee) : ee;
}
slow = 1;
first = 0;
continue;
}
Ptype mt = m->tp;
tx:
switch (mt->base) {
case TYPE:
mt = Pbase(mt)->b_name->tp;
goto tx;
case VEC:
{ Pname cn = Pvec(mt)->typ->is_cl_obj();
if (cn && Pclass(cn->tp)->c_xref&(C_ASS|C_VBASE)) {
error('s',"copy of %n[], no memberwise copy for%n",cn,cn);
slow = 1; // make sure an assignment operator
// is generated so that there will
// be no more error messages
}
if (slow && mt->tsizeof()) {
// protect against sizeof(mt)==0: char[]
/*
generate:
struct _s { char[sizeof(m)]; };
*(struct _s*)this->m = *(struct _s*)arg.mem;
*/
Pexpr l = new name(m->string);
Pexpr r = new name(m->string);
r = new ref(DOT,new name(arg->string),r);
Pexpr ee = copy_obj(l,r,mt->tsizeof());
e = e ? new expr(CM,e,ee) : ee;
break;
}
}
case FCT:
case OVERLOAD:
case CLASS:
case ENUM:
break;
case RPTR:
error("cannot assignC%t:RM%n",cl,m);
break;
case COBJ:
//error('d',"cobj %n %d %d",m,slow,Pclass(Pbase(mt)->b_name->tp)->c_xref);
if (slow==0
&& Pclass(Pbase(mt)->b_name->tp)->c_xref&(C_VBASE|C_ASS)) {
// must use its assignment operation
if (first==0 && m->n_offset) {
// copy up to this member
Pexpr th = new expr(THIS,0,0);
Pexpr a = new name(arg->string);
a = a->address();
e = copy_obj(th,a,m->n_offset);
}
slow = 1;
}
// no break: copy cobj itself
default:
//error('d',"defa %n %d",m,slow);
if (slow) {
if (m->tp->tconst()) error("cannot assignC%t: const M%n",cl,m);
Pname ms = new name(m->string);
Pname as = new name(arg->string);
Pexpr ee = new ref(DOT,as,new name(m->string));
ee = new expr(ASSIGN,ms,ee);
e = e ? new expr(CM,e,ee) : ee;
}
}
first = 0;
}
if (slow == 0) {
/* really simple just copy:
*/
//error('d',"slow");
/*
Pexpr th = new expr(THIS,0,0);
Pexpr a = new name(arg->string);
a = a->address();
Pexpr ee = copy_obj(th,a,cl->tsize());
e = e ? new expr(CM,e,ee) : e;
*/
//error('d',"%n simple assignment",cn);
// cl->c_xref ^= C_ASS; // Didn't mean it: No X::operator=(X&)
return 0;
}
}
Pexpr rv = new expr(THIS,0,0);
rv = new expr(DEREF,rv,0);//b1->contents();
s->e = e ? new expr(CM,e,rv) : e;
s->s_list = new estmt(RETURN,no_where,rv,0);
cc->stack();
cc->not = cn;
cc->cot = cl;
cl->c_xref |= C_ASS; // now it has X::operator=(const X&)
Pname fn = new name(oper_name(ASSIGN));
Pfct f = new fct(new ptr(RPTR,Pptr(cl->this_type)->typ),arg,1);
f->f_inline = 1;
fn->tp = f;
fn->n_oper = ASSIGN;
fn->n_sto = STATIC;
Pname nn = fn->dcl(cl->memtbl,PUBLIC);
delete fn;
Pfct(nn->tp)->body = new block(curloc,0,s);
Pfct(nn->tp)->dcl(nn);
cc->unstack();
nn->simpl();
//error('d',"make_assign->");
return 1;
}
void classdef::dcl(Pname cname, Ptable tbl)
{
int bvirt = 0;
int dvirt = 0;
int scope = PUBLIC;
int protect = 0;
int st = 1; // nothing private or protected seen: a struct
// int nstd = (in_class && nested_sig)?2:(in_class?1:0); // nested class
int byte_old = byte_offset;
int bit_old = bit_offset;
int max_old = max_align;
int boff = 0;
int in_union = 0;
int usz;
int make_ctor = 0;
int make_dtor = 0;
/* this is the place for paranoia */
if (this == 0) error('i',"0->Cdef::dcl(%p)",tbl);
if (base != CLASS) error('i',"Cdef::dcl(%d)",base);
if (cname == 0) error('i',"unNdC");
if (cname->tp != this) error('i',"badCdef");
if (tbl == 0) error('i',"Cdef::dcl(%n,0)",cname);
if (tbl->base != TABLE) error('i',"Cdef::dcl(%n,tbl=%d)",cname,tbl->base);
DB( if(Ddebug>=1) error('d',&cname->where,"classdef::dcl %s tbl %d gtbl %d",string,tbl,gtbl); );
// error('d',&cname->where,"classdef::dcl %s tbl %d gtbl %d",string,tbl,gtbl);
switch (csu) {
case UNION:
in_union = UNION;
break;
case ANON:
in_union = ANON;
break;
case CLASS:
scope = 0;
}
max_align = AL_STRUCT;
if (lex_level) {
// error('d',&cname->where,"%t::dcl in_class: %t lex_level %d ",this,in_class, lex_level);
if ( in_class )
lex_level = 0;
else {
in_fct = cc->nof;
if ( lcl == 0 ) lcl = make_name( 'L' );
}
}
if (strlen == 0) strlen = ::strlen(string);
if (baselist) {
/*
check base classes.
duplicates were removed in start_cl() in norm.c.
remove bad classes.
add virtual bases from bases to the list.
check against
class b : a {}
class c : a, b {} // first a inaccessible
*/
Pbcl ll = 0;
Pbcl lll = 0;
Pbcl vlist = 0;
for (Pbcl lx, l=baselist; l; l=lx) { // remove bad bases
Pclass cl = l->bclass;
/* restriction lifted: nested and local classes
int b_nstd = (cl->in_class && cl->nested_sig)
?2:(cl->in_class?1:0);
if (b_nstd)
error((b_nstd==2)?0:'w',"%s derived from nestedC %s", string, cl->string);
if (cl->lex_level)
error('w',"%s derived from localC %s", string, cl->string);
*/
lx = l->next;
//error('d',"base1 %t %k init %d",cl,l->ppp,l->init);
// ``class'' => private base ``struct'' => public base
if (l->ppp == 0) {
l->ppp = csu==CLASS ? PRIVATE : PUBLIC;
#ifndef OLD
if (l->ppp == PRIVATE) error('w',"B%t private by default: please be explicit ``: private%t",cl,cl);
#endif
}
// if you have a ``class'' as base you cannot remain a
// ``mere struct''
if (cl && cl->csu == CLASS) st = 0;
if ((cl->defined&(DEFINED|SIMPLIFIED)) == 0) {
error("BC %sU",cl->string);
continue;
}
else
(void)cl->tsizeof(); // ensure printout
if (cl->csu==UNION || cl->csu==ANON) {
error("C derived from union");
continue;
}
if (in_union) {
error("derived union");
continue;
}
if (l->base==VIRTUAL) {
// constraint removed ...
// if (cl->has_ictor()==0 && cl->has_ctor()) {
// error("virtualB%t has no defaultIr",cl);
// continue;
// }
// order of virtual classes doesn't matter
l->next = vlist;
vlist = l;
}
else { // keep ordinary base classes in order
if (ll == 0) {
lll = l;
l->next = 0;
}
else
ll->next = l;
ll = l;
}
}
if (ll) {
ll->next = vlist; // put virtual bases at end
baselist = lll;
}
else
baselist = vlist;
lll = 0;
for (l=baselist; l; l=l->next) { // detect unmanageable duplicates
Pclass b = l->bclass;
for (ll=baselist; ll; ll=ll->next)
if (b!=ll->bclass && ll->bclass->check_dup(b,l->base)) {
if (lll)
lll->next = l->next;
else
baselist = l->next;
goto mmm;
}
lll = l;
mmm:;
}
for (l=baselist; l; l=l->next) { // promote virtual bases
Pclass b = l->bclass;
for (ll=b->baselist; ll; ll=ll->next) {
if (ll->base == VIRTUAL) {
Pclass v = ll->bclass;
for (Pbcl lll=baselist; lll; lll=lll->next)
if (lll->bclass == v) goto nnn;
// error('w',"%t is virtualB of%t",v,this);
baselist = new basecl(v,baselist);
baselist->base = VIRTUAL;
baselist->promoted = 1;
// needs a more complete check of visibility rules
//error('d',"promote %t %k",v,ll->ppp);
baselist->ppp = ll->ppp;
}
nnn:;
}
}
ll = 0;
lll = 0;
l=baselist;
baselist = 0;
vlist = 0;
for (; l; l=lx) {
// sort virtual bases so that no virtual base
// is ahead of its own virtual base
lx = l->next;
if (l->base == VIRTUAL) { // add to sorted vlist
// each class before its bases
if (vlist == 0) {
vlist = l;
l->next = 0;
}
else {
Pclass lb = l->bclass;
Pbcl v_prev = 0;
for (Pbcl vx, v = vlist; v; v=vx) {
Pclass vb = v->bclass;
vx = v->next;
if (lb->has_base(vb)) {
// put l ahead of v
l->next = v;
if (v_prev)
v_prev->next = l;
else
vlist = l;
break;
}
if (vx == 0) {
// stick l at end
v->next = l;
l->next = 0;
break;
}
v_prev = v;
}
}
}
else { // keep in order
if (ll == 0) {
lll = l;
l->next = 0;
}
else
ll->next = l;
ll = l;
}
}
if (ll) {
ll->next = vlist; // put virtual bases at end
baselist = lll;
}
else
baselist = vlist;
for (l=baselist; l; l=l->next) { // allocate base class objects
Pclass cl = l->bclass;
//error('d',"base %t %k init %d",cl,l->ppp,l->init);
if (l->base == VIRTUAL) { // : virtual bclass
// pointer and object for virtual base MAY
// be allocated at the end - but not here
c_xref |= C_VBASE;
dvirt += cl->virt_count;
}
else { // : bclass =>allocate
int ba = cl->align();
if (max_align<ba) max_align = ba;
if (cl == baselist->bclass) {
// pad to ensure alignment:
boff = cl->real_size;
// not obj_size-real_size, we can
// optimize vbase object away
int xtra = boff%ba;
// align
if (xtra) boff += ba-xtra;
}
else { // let C handle the padding:
int xtra = boff%ba;
if (xtra) boff += ba-xtra; // align
l->obj_offset = boff;
// don't use waste
boff += cl->obj_size;
}
bvirt += cl->virt_count;
}
if (cl->has_vvtab) has_vvtab = 1;
c_xref |= cl->c_xref;
//error('d',"%t: base %t conv %d base conv %d",this,cl,conv,cl->conv);
conv = merge_conv(conv,cl->conv);
}
}
memtbl->set_name(cname);
// int nmem = mem_list->no_of_names();
int nmem = 0;
int fct_mem = 0;
{ for (Pname m = mem_list; m; m=m->n_list) {
nmem++;
if (m->tp && m->tp->base==FCT) fct_mem++;
}
}
if (nmem) memtbl->grow((nmem<=2)?3:nmem);
cc->stack();
cc->not = cname;
cc->cot = this;
byte_offset = usz = boff;
bit_offset = 0;
int real_virts = 0;
Pbase bt = new basetype(COBJ,cname);
bt->b_table = memtbl;
Ptype cct = bt->addrof();
// for strict opt type of `this': X *const
// '2' distinguishes this case from a real constant object
if (strict_opt) Pptr(cct)->rdo = 2;
this_type = cc->tot = cct;
PERM(cct);
PERM(bt);
for (Pname px, p=mem_list; p; p=px) {
/*
look at each member;
declare it and determine its visibility
calculate offsets and sizes
*/
px = p->n_list;
// error( 'd', "p: %n %k n_scope: %d", p, p->base, p->n_scope );
switch (p->base) {
case PUBLIC:
scope = PUBLIC;
protect = 0;
goto prpr;
case PRIVATE:
scope = 0;
protect = 0;
goto prpr;
case PROTECTED:
scope = 0;
protect = PROTECTED;
prpr:
if (in_union == ANON) error(&p->where,"%k in anonymous unionD",p->base);
continue;
case PR: // visibility control: C::M
{
char* qs = p->n_qualifier->string;
char* ms = p->string;
TOK ppp = scope?PUBLIC:(protect?PROTECTED:PRIVATE);
p->base = NAME;
p->n_scope = scope;
p->n_protect = protect;
if (strcmp(ms,qs) == 0) ms = "__ct";
ppbase = PUBLIC;
if (is_base(qs) == 0) {
error("%kQr %s not aBC of %s",ppp,qs,string);
continue;
}
mex = 1;
tcl = mec = this;
c_body = 0; // this search must not be interpreted as a use
Pname os = Cdcl;
Cdcl = p;
Pexpr ee = find_name(ms,0,1);
Cdcl = os;
c_body = 1;
// error('d', "ee: %k ", ee->base );
// while (ee->base == MDOT || ee->base == REF)
while (ee && (ee->base == MDOT || ee->base == REF))
ee = ee->mem;
Pname mx = Pname(ee);
// error('d', "ee: %k mx: %n", ee->base, mx );
if (mx == 0) {
error("C %s does not have aM %s",qs,ms);
continue;
}
if (mx->tp->base == OVERLOAD) {
error('s',"%k specification of overloaded%n",ppp,mx);
continue;
}
TOK pp = mx->n_scope?PUBLIC:mx->n_protect?PROTECTED:PRIVATE;
// error('d',"mx %n pp %k ppp %k",mx,pp,ppp);
if (ppp != pp) {
error(&p->where,"%kM%n specified%k",pp,mx,ppp);
continue;
}
p->n_qualifier = mx;
Pname m = memtbl->insert(p,0);
m->base = PUBLIC;
if (Nold) error("twoDs ofCM%n",p);
continue;
}
}
// error('d',"mem%n tp %d %k scope %d",p,p->tp->base,p->tp->base,scope);
if (scope==0) {
if (p->n_sto != STATIC) st = 0;
}
else
if ( p->tp->base == TYPE ) {
Pname nn = p->tp->is_cl_obj();
if (nn) {
// error( 'd', "nn: %n %k tp %t %k", nn, nn->base, nn->tp, nn->tp->base );
if ((Pclass(nn->tp)->csu == CLASS) && (strcmp(this->string,nn->string))) st = 0;
}
}
if (p->tp->base == FCT) {
int ff = 0;
Pfct f = Pfct(p->tp);
Pblock b = f->body;
f->body = 0;
if (b)
f->f_inline = 1;
/* restriction lifted: nested classes
else
if (nstd)
error((nstd==2)?0:'w',&p->where,"non-inlineMF%n in nestedC %s",p,string);
*/
else
if (lex_level)
error('w',&p->where,"non-inlineMF%n in localC %s",p,string);
switch (p->n_sto) {
case FRIEND:
ff = 1;
break;
case STATIC: // accept static member functions
//error('d',"inline %d",f->f_inline);
// if (f->f_inline==0)
/* restriction lifted: nested classes
if (nstd)
error((nstd==2)?0:'w',"staticMF%n in nestedC %s",p,string);
else
*/
if (lex_level)
error('w',"staticMF%n in localC %s",p,string);
f->f_static = 1;
p->n_sto = 0;
break;
case AUTO:
// case STATIC:
case REGISTER:
case EXTERN:
error(&p->where,"M%n cannot be%k",p,p->n_sto);
p->n_sto = 0;
}
if (f->f_virtual) real_virts++;
Pname m = p->dcl(memtbl,scope);
if (m == 0 || m->tp->base != FCT) continue;
if (m->n_initializer) {
c_abstract = 1;
if (m->n_oper == DTOR)
error('w',"please provide an out-of-line definition: %n {}; which is needed by derived classes",m);
}
if (ff == 0) m->n_protect = protect;
if (b) {
if (m->tp->defined&DEFINED || Pfct(m->tp)->body )
error(&p->where,"two definitions of%n",m);
else
Pfct(m->tp)->body = b;
// Pfct(m->tp)->f_inline = 1;
}
if (ff==0 && p->where.line!=m->where.line)
error(&p->where,"%n cannot be redeclared inCD",p);
}
else {
Eppp = scope?scope:protect?protect:0;
if (p->base == TNAME) {
// typedef names are exported to
// surrounding non-class scope
// NOTE: name should actually be declared in
// the innermost block of the current
// function, but this info isn't available
if ( cc->nof ) {
if (p->tp &&
Pbase(p->tp)->base != COBJ &&
Pbase(p->tp)->base != EOBJ) {
Pname n = cc->ftbl->look(p->string,0);
if (n && n->base != TNAME &&
n->lex_level &&
n->tp != p->tp ) {
error('s',"transitional model of nestedTs within%n (%s asTdef and%t)",cc->nof,p->string,n->tp);
error('i', "cannot recover from previous errors" );
}
}
else p->dcl(cc->ftbl,scope);
}
else
p->dcl(gtbl,scope);
// typedefs need to be generated outside class
if ( p->tp && Pbase(p->tp)->base != COBJ ) {
Pname n = gtbl->look(p->string,0);
if ( n && lex_level == 0 && n->base != TNAME )
error(&p->where,"%nredefined: identifier and typedef",p);
p->dcl_print(0);
}
continue;
};
if (p->n_initializer) {
error(&p->where,"Ir forM%n",p);
p->n_initializer = 0;
}
if (p->tp->base==OVERLOAD) {
for (Plist gl=Pgen(p->tp)->fct_list; gl; gl=gl->l) {
Pname nn = gl->f;
Pfct ff = Pfct(nn->tp);
if ( ff->f_virtual ) real_virts++;
}
}
// error('d',"lex_level %d p %n lex %d nested_scope: %k",lex_level,p,p->lex_level, nested_scope);
TOK is_friend = p->n_sto;
if ( lex_level && p->tp->base == VEC ) lcl_tbl = tbl;
if ( protect && p->tp->base == COBJ &&
Pclass(Pbase(p->tp)->b_name->tp)->csu == ANON )
p->n_protect = protect;
Pname m = p->dcl(memtbl,scope);
lcl_tbl = 0;
Eppp = 0;
if (m == 0) continue;
m->n_protect = protect;
if (m->n_stclass==STATIC) {
if (in_union) error("staticM%n in union",m);
if ( is_friend != FRIEND ) {
/* restriction lifted: nested classes
if (nstd)
error((nstd==2)?0:'w',"staticM%n in nestedC %s",m,string);
else
*/
if (lex_level)
error(strict_opt?0:'w',"staticM%n in localC %s (anachronism)",m,string);
}
// Ptype t = m->tp;
// Pname cn = t->is_cl_obj();
// if ((cn && Pclass(cn->tp)->has_ctor())
// || t->is_ref()
// || (t->tconst() && vec_const == 0))
m->n_sto = EXTERN;
if (tbl == gtbl) stat_mem_list = new name_list(m,stat_mem_list);
if (m->n_initializer) error('s',"staticM%nWIr",m);
}
if (in_union) {
if (usz < byte_offset) usz = byte_offset;
byte_offset = 0;
if(in_union==ANON) m->n_offset+=byte_old;
}
}
}
/* restriction lifted: nested and local classes
if (real_virts) {
if (nstd)
error((nstd==2)?0:'w',"nestedC%s contains%d virtualF",string,real_virts);
else
if (lex_level)
error('w',"localC%s contains%d virtualF",string,real_virts);
}
*/
if (st && csu==CLASS) csu = STRUCT; // nothing private => STRUCT
if (st==0 && csu==STRUCT) csu = CLASS; // all is not public => CLASS
if (in_union) byte_offset = usz;
// now look look at the members
Pname ct = has_ctor();
Pname dt = has_dtor();
int i;
int omex = mex; mex = 0;
Pname on = has_oper(NEW);
Pname od = has_oper(DELETE);
mex = omex;
if (dt && ct==0 && Pfct(dt->tp)->f_virtual == 0 ) error('w',"%s has%n but noK",string,dt);
if (on && od==0) error('w',"%s has%n but no operator delete()",string,on);
if (od && on==0) error('w',"%s has%n but no operator new()",string,od);
if (dt==0 && od && od && od->n_table==memtbl) make_dtor = 1;
for (Pname m=memtbl->get_mem(i=1); m; m=memtbl->get_mem(++i) ) {
/*
The members have been declared.
now look at each to see if it needs defining
*/
Ptype t = m->tp;
if (t == 0) continue; // public declarations
// error('d', "m %n %d", m, m->n_scope );
switch (t->base) {
default:
if (ct==0
&& m->n_stclass!=ENUM
&& m->n_stclass!=STATIC) {
if (t->is_ref()) error("R%n inC %sWoutK",m,string);
if (t->tconst()
&& vec_const==0
&& m->n_evaluated==0)
error("const%n inC %sWoutK",m,string);
}
case VEC:
break;
case FCT:
case OVERLOAD:
case CLASS:
case ENUM:
continue;
}
Pname cn = t->is_cl_obj();
if (cn == 0) cn = cl_obj_vec;
if (cn == 0) continue;
Pclass cl = Pclass(cn->tp);
c_xref |= cl->c_xref;
//error('d',"m %n %t %d",m,cl,cl->c_xref);
if (cl->has_ctor()) {
if (m->n_stclass == STATIC)
; // error('s',"staticM%n ofC%nWK",m,cn);
else if (in_union) {
if (strncmp("__C",string,3) == 0)
error("M %s ofC%nWK in union",m->string,cn); // tagless union
else error("M%n ofC%nWK in union",m,cn);
}
else if (ct == 0) {
// does mctor have a default constructor?
if (make_ctor==0 && cl->has_ictor()==0)
error("%t needs aK; it has aMWK requiringAs",this);
make_ctor = 1;
}
}
if (cl->has_dtor()) {
if (m->n_stclass==STATIC)
; // error('s',"staticM%n ofC%nW destructor",m,cn);
else if (in_union) {
if (strncmp("__C",string,3) == 0) // tagless union
error("M %s ofC%nW destructor in union",m->string,cn);
else error("M%n ofC%nW destructor in union",m,cn);
}
else if (dt==0)
make_dtor = 1;
}
}
if (has_dtor()==0 && make_dtor==0) {
// can dtor be inherited (from single base class)?
Pclass bcl = 0;
for (Pbcl b = baselist; b; b = b->next) {
switch (b->base) {
case NAME:
if (bcl == 0) {
Pname d = b->bclass->has_dtor();
if (d==0) break;
if (strict_opt == 0) {
if (d->n_scope==PUBLIC
&& Pfct(d->tp)->f_virtual==0) {
bcl = b->bclass;
break;
}
}
}
// two dtors or non-public dtors force creation
make_dtor = 1;
goto zbzb;
case VIRTUAL:
if (b->bclass->has_dtor()) make_dtor = 1;
goto zbzb;
}
}
if (bcl) c_dtor = bcl->has_dtor();
zbzb:;
}
if (make_dtor && dt==0) { // make x::~x() {}
// must be done before vtbls are made in case dtor is virtual
//error('d',"%t: make_dtor",this);
Pname n = new name(string);
Pfct f = new fct(defa_type,0,1);
f->f_inline = /*IDTOR; */ 1;
n->tp = f;
n->n_oper = DTOR;
dt = n->dcl(memtbl,PUBLIC);
delete n;
Pfct(dt->tp)->body = /*0; */ new block(curloc,0,0);
dt = has_dtor();
}
if (virt_count && find_vptr(this)==0) {
// we only need a vptr if this class has virtual
// functions and none of its first bases have vptrs
//error('d',"%s virt_count %d",string,virt_count);
Pname vp = new name("__vptr");
vp->tp = Pvptr_type;
(void) vp->dcl(memtbl,0);
delete vp;
c_xref |= C_VPTR;
}
else {
//error("byte_offset %d bit_offset %d bitsinbyte %d",byte_offset,bit_offset,BI_IN_BYTE);
//error(" div %d mod %d",bit_offset/BI_IN_BYTE,bit_offset%BI_IN_BYTE);
// no more bit fields. absorb bit_offset
if (bit_offset) {
byte_offset += (bit_offset/BI_IN_BYTE + (bit_offset%BI_IN_BYTE?1:0));
bit_offset = 0;
}
}
//error("byte_offset %d bit_offset %d",byte_offset,bit_offset);
for (Pbcl b = baselist; b; b = b->next) { // allocate virtual base pointers
if (b->base != VIRTUAL) continue;
Pclass bcl = b->bclass;
// search non-virtual bases for this virtual base
for (Pbcl bb = baselist; bb; bb = bb->next)
if (bb->base == NAME) {
for (Pbcl l = bb->bclass->baselist; l; l=l->next)
if (l->base==VIRTUAL && l->bclass==bcl) goto eee;
}
{
if (obj_align<AL_WPTR) obj_align = AL_WPTR;
if (max_align<AL_WPTR) max_align = AL_WPTR;
int waste = byte_offset%AL_WPTR;
if (waste) byte_offset += AL_WPTR-waste; // align
b->ptr_offset = byte_offset+1; // ensure != 0
byte_offset += sizeof(int*);
}
eee:;
}
real_size = byte_offset; // the rest may be optimized away
for (b = baselist; b; b = b->next) { // allocate virtual class objects
if (b->base != VIRTUAL) continue;
Pclass bcl = b->bclass;
// if necessary
if (b->obj_offset = has_allocated_base(bcl)) continue;
int ba = bcl->align();
if (obj_align<ba) obj_align = ba;
if (max_align<ba) max_align = ba;
int waste = byte_offset%ba;
if (waste) byte_offset += ba-waste; // align
b->obj_offset = byte_offset; // offset in this
b->allocated = 1;
//error('d',"virtual %t in %t at %d",bcl,this,b->obj_offset);
byte_offset += bcl->tsizeof();
}
// no more data members.
// pad object (so that copying into a base object
// doesn't destroy derevid class members):
if (byte_offset==0) { // empty struct: waste a member
Pname c = new name (make_name('W'));
c->tp = char_type;
(void) c->dcl(memtbl,0);
real_size = byte_offset = 1;
}
if (byte_offset < SZ_STRUCT) byte_offset = SZ_STRUCT;
int waste = byte_offset%max_align;
//error('d',"max_align %d waste %d byte_offset %d",max_align,waste,byte_offset);
if (waste) byte_offset += max_align-waste;
obj_size = byte_offset;
obj_align = max_align;
// make vtbls
// this cannot be done until the bases
// have been allocated in this class
// so that the offsets (deltas) are known
if (all_virt(this,0,1,0)) {
if (has_ctor()==0) make_ctor = 1;
}
else if (has_vvtab)
error("virtualB: conflicting vtable initialization");
// error('d',"%t->classdef: virt_count: %d virt_merge: %d",this,virt_count,virt_merge);
Pname hito = has_itor();
if (hito) c_xref |= C_XREF; // has user defined X(X&)
//error('d',"%t hito %d ctor %d",this,hito,make_ctor);
if (hito==0 && c_xref&(C_VPTR|C_VBASE|C_XREF)) {
// X(X&) needed if bitwise copy is illegal
// or if any constructor is defined
hito = make_itor(0);
// if the base has B::B(void)
// the derived should have D::D(void)
if (baselist) {
int mc = 1; // can make and ictor
for (Pbcl b = baselist; b; b = b->next) {
if (b->bclass->has_ctor()
&& b->bclass->has_ictor()==0)
mc = 0;
}
make_ctor = mc;
/*
int mc = 1; // can make an ictor
for (Pbcl b = baselist; b; b = b->next) {
if (b->bclass->has_ctor()) {
Pname c = b->bclass->has_ictor();
// no copy constructor?
// non-public copy constructor?
if (c==0 || c->n_scope==0) mc = 0;
}
}
make_ctor = mc;
*/
}
else
make_ctor = 1;
}
if (c_ctor==0 && make_ctor==0) { // can ctor be inherited (from single base class)?
/*
int bb = 0;
for (Pbcl b = baselist; b; b = b->next) {
switch (b->base) {
case NAME:
{ Pname c = b->bclass->has_ctor();
// if (b->bclass->has_ctor() == 0) break;
if (c == 0) break;
if (c->n_scope==PUBLIC && bb++==0) break;
}
// no break: two bases: needs ctor
case VIRTUAL:
make_ctor = 1; // virtual base: need ctor
goto zaza;
}
}
*/
Pname btor = 0;
Pclass bc = 0;
for (Pbcl b = baselist; b; b = b->next) {
switch (b->base) {
case NAME:
{ Pname c = b->bclass->has_ctor();
if (c == 0) break;
if (c->n_scope==PUBLIC && b==baselist) {
bc = b->bclass;
btor = bc->has_ictor();
break;
}
}
// no break: two bases: needs ctor
case VIRTUAL:
make_ctor = 1; // virtual base: need ctor
goto zaza;
}
}
// c_ctor = btor;
//error('d',"btor %n",btor);
if (bc) {
if (btor)
make_ctor = 1;
else
error("K needed for %s, BC%t hasK",string,bc);
}
zaza:;
}
if (make_ctor && ct==0) { // make x::x() {}
//error('d',"%t: make_ctor",this);
Pname n = new name(string);
Pfct f = new fct(defa_type,0,1);
f->f_inline = 1; // ICTOR; // ICTOR means ``define ctor() if used''
n->tp = f;
n->n_oper = TNAME;
ct = n->dcl(memtbl,PUBLIC);
delete n;
Pfct(ct->tp)->body = /* 0; */ new block(curloc,0,0);
}
defined |= DEFINED;
if (ansi_opt) {
char* s = csu==UNION || csu==ANON ? "union" : "struct";
fprintf(out_file,"%s %s;",s,string);
}
//error('d',"defined %s",string);
// fix argument lists for inlines
for (p=memtbl->get_mem(i=1); p; p=memtbl->get_mem(++i)) {
Pfct f = Pfct(p->tp);
if (f==0) continue; // public declarations
switch (f->base) {
case FCT:
/* prohibit something like the following:
typedef int t1;
class x {
typedef int t1;
t1 foo();
};
*/
if (f->returns->base == TYPE) {
Pname nn = Pbase(f->returns)->b_name;
while ( nn->tp->base == TYPE )
nn = Pbase(nn->tp)->b_name;
if (nn->n_key == NESTED) {
Ptype tt;
if ( nn->tp->base != EOBJ &&
nn->tp->base != COBJ )
tt = nn->tpdef;
else tt = Pbase(nn->tp)->b_name->tp;
if ( tt && tt->nested_sig )
error('w',"nested %s as returnT for non-inlineMF, use %t::%s %n{} in definition (anachronism)",nn->string,tt->in_class,nn->string,p);
}
}
if (hito && f->argtype) fix_args(f,this);
if (p->n_oper == CTOR) f->s_returns = this_type;
if (f->body) p->n_sto = STATIC;
break;
case OVERLOAD:
{ Pgen g = Pgen(f);
for (Plist gl=g->fct_list; gl; gl=gl->l) {
Pname n = gl->f;
Pfct f = Pfct(n->tp);
if (hito && f->argtype) fix_args(f,this);
if (n->n_oper == CTOR) f->s_returns = this_type;
if (f->body) n->n_sto = STATIC;
}
}
}
}
// define members defined inline
for (p=memtbl->get_mem(i=1); p; p=memtbl->get_mem(++i)) {
Pfct f = Pfct(p->tp);
if (f==0) continue; // public declarations
switch (f->base) {
case FCT:
if (f->body) {
f->dcl(p);
p->simpl();
}
break;
case OVERLOAD:
{ Pgen g = Pgen(f);
for (Plist gl=g->fct_list; gl; gl=gl->l) {
Pname n = gl->f;
Pfct f = Pfct(n->tp);
if (f->body) {
f->dcl(n);
n->simpl();
}
}
}
}
}
byte_offset = byte_old;
bit_offset = bit_old;
max_align = max_old;
cc->unstack(); // friends are not in class scope
// fix arguments lists for friends defined inline
for (Plist fl=friend_list; fl; fl=fl->l) {
Pname p = fl->f;
Pfct f = Pfct(p->tp);
switch (f->base) {
case FCT:
if (hito && f->argtype) fix_args(f,this);
if (f->body &&
(f->defined&(DEFINED|SIMPLIFIED)) == 0)
p->n_sto = STATIC;
else
if (p->n_scope == STATIC)
error(strict_opt?0:'w',"static%n declared friend toC%t",p,this);
break;
case OVERLOAD:
{ Pgen g = Pgen(f);
for (Plist gl=g->fct_list; gl; gl=gl->l) {
Pname n = gl->f;
Pfct f = Pfct(n->tp);
if (hito && f->argtype) fix_args(f,this);
if (f->body &&
(f->defined&(DEFINED|SIMPLIFIED)) == 0)
n->n_sto = STATIC;
else
if (p->n_scope == STATIC)
error(strict_opt?0:'w',"static%n declared friend toC%t",p,this);
}
}
}
}
// define friends defined inline and modify return types if necessary
for (fl=friend_list; fl; fl=fl->l) {
Pname p = fl->f;
Pfct f = Pfct(p->tp);
switch (f->base) {
case FCT:
if (f->body &&
(f->defined&(DEFINED|SIMPLIFIED)) == 0) {
f->dcl(p);
p->simpl();
}
break;
case OVERLOAD:
{ Pgen g = Pgen(f);
for (Plist gl=g->fct_list; gl; gl=gl->l) {
Pname n = gl->f;
Pfct f = Pfct(n->tp);
if (f->body &&
(f->defined&(DEFINED|SIMPLIFIED)) == 0) {
f->dcl(n);
n->simpl();
}
}
}
}
}
if (tbl != gtbl) this->simpl();
if ( statStat && strcmp(statStat->string,string)==0) {
//error('d', "classdef::dcl: statstat: %n this %s", statStat, string);
statStat->hide();
statStat = 0;
}
// error('d',"classdef::dcl defined: %d",defined);
// catch refs to this class in body of nested class function
// (i.e., ref to member of this class...)
if ( (defined&REF_SEEN) != 0 ) dcl_print(0);
if ( debug_opt ) {
for (p=memtbl->get_mem(i=1); p; p=memtbl->get_mem(++i)) {
Pfct f = Pfct(p->tp);
if (f==0) continue; // public declarations
switch (f->base) {
case FCT:
if (f->body) {
if ( c_body == 1 ) dcl_print(0);
p->dcl_print(0);
}
break;
case OVERLOAD:
{
Pgen g = Pgen(f);
for (Plist gl=g->fct_list; gl; gl=gl->l) {
Pname n = gl->f;
Pfct f = Pfct(n->tp);
if (f->body) {
if ( c_body == 1 ) dcl_print(0);
p->dcl_print(0);
}
}
}
}
}
for (fl=friend_list; fl; fl=fl->l) {
Pname p = fl->f;
Pfct f = Pfct(p->tp);
switch (f->base) {
case FCT:
if (f->body &&
(f->defined&(DEFINED|SIMPLIFIED)) == 0)
p->dcl_print(0);
break;
case OVERLOAD:
{
Pgen g = Pgen(f);
for (Plist gl=g->fct_list; gl; gl=gl->l) {
Pname n = gl->f;
Pfct f = Pfct(n->tp);
if (f->body &&
(f->defined&(DEFINED|SIMPLIFIED)) == 0)
p->dcl_print(0);
}
}
}
}
} // end, if (debug_opt)
}
void enumdef::dcl(Pname n, Ptable tbl)
{
// if (this == 0) error('i',"0->enumdef::dcl(%p)",tbl);
Pname px;
Pname p = mem;
DB( if(Ddebug>=1) error('d',&n->where,"enumdef(%n,%d)",n,tbl); );
Pbase b = new basetype(EOBJ,n);
b->b_const = 1;
#define FIRST_ENUM 0
int enum_count = FIRST_ENUM;
no_of_enumerators = mem->no_of_names();
int largest = 0;
if (p == 0) mem = new name(make_name('e'));
for (; p; p=px) {
px = p->n_list;
// error( 'd', "p %n", p );
if (p->n_initializer) {
Pexpr i = p->n_initializer->typ(tbl);
Neval = 0;
long ii = i->eval();
if (largest_int<ii) error("long enumerator");
enum_count = int(ii);
if (Neval) error("%s",Neval);
DEL(i);
p->n_initializer = 0;
}
p->n_evaluated = 1;
largest |= enum_count;
p->n_val = enum_count++;
p->tp = b;
Pname nn = tbl->insert(p,0);
if (Nold) {
if (nn->n_stclass == ENUM) {
// error( (p->n_val!=nn->n_val)?0:'w',"enumerator%n declared twice",nn);
// if (p->n_val!=nn->n_val)
error("enumerator%n declared twice",nn);
}
else
error("incompatibleDs of%n",nn);
}
else {
nn->n_stclass = ENUM; // no store will be allocated
if (Eppp == PROTECTED)
nn->n_protect = PROTECTED;
else if (Eppp == PUBLIC)
nn->n_scope = PUBLIC;
}
p->string = nn->string;
// delete p;
}
// mem = 0;
// chose a shorter representation for the enum?
// if (largest&0133 == largest)
// e_type = char_type;
// else if largest&077777 == largest)
// e_type = short_type;
// else
e_type = int_type;
defined |= DEFINED;
}
0707071010112044131004440001630000160000010175600466055377200000600000013077del.c /*ident "@(#)ctrans:src/del.c 1.3" */
/************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
del.c:
walk the trees to reclaim storage
**************************************************************/
#include "cfront.h"
void name::del()
{
DB( if(Adebug>=1) {
fprintf(stderr,"\n*** '%s'->del()",string?string:"???");
display_type(tp); putc(' ',stderr);
where.put(stderr); putc('\n',stderr);
}
if ( base!=NAME && base!=TNAME ) error('i',"name::del() of%k -- id==%ld",base,node::id);
);
Pexpr i = n_initializer;
// error('d', "\nname::del: %d %s", this, string?string:"no name" );
// NFn++;
DEL(tp);
if(i && i!=(Pexpr)1) DEL(i);
delete this;
}
void type::del()
{
DB( if(Adebug>=1) {
fprintf(stderr,"\n*** '");
display_type(this);
fprintf(stderr," '->del()\n");
}
);
//fprintf(stderr,"DEL(type=%d %d)\n",this,base);
permanent = 3; /* do not delete twice */
switch (base) {
case TNAME:
case NAME:
error('i',"%d->T::del():N %s %d",this,Pname(this)->string,base);
case FCT:
{ Pfct f = (Pfct) this;
DEL(f->returns);
delete f;
break;
}
case VEC:
{ Pvec v = (Pvec) this;
DEL(v->dim);
DEL(v->typ);
delete v;
break;
}
case PTR:
case RPTR:
{ Pptr p = (Pptr) this;
DEL(p->typ);
delete p;
break;
}
}
}
void expr::del()
{
DB( if(Adebug>=1) {
fprintf(stderr,"\n*** expr::del(): ");
display_expr(this,0,1);
if(Adebug>=2) display_expr(this);
});
//fprintf(stderr,"DEL(expr=%d: %d %d %d)\n",this,base,e1,e2); fflush(stderr);
permanent = 3;
switch (base) {
case IVAL:
if (this == one) return;
//case FVAL:
case THIS:
case ICON:
case FCON:
case CCON:
case STRING:
case TEXT:
goto dd;
case DUMMY:
case ZERO:
case NAME:
return;
case CAST:
case SIZEOF:
case NEW:
case GNEW:
case VALUE:
DEL(tp2);
break;
case REF:
case DOT:
DEL(e1);
if (e2) DEL(e2);
case MDOT:
if (mem && mem->base!=NAME) DEL(mem);
if ( i1 == 5 ) delete string4;
goto dd;
case QUEST:
DEL(cond);
break;
case ICALL:
delete il->i_args;
delete il;
goto dd;
case ELIST: { // limit recursion
Pexpr tp = e2;
while ( tp && tp->e2 && tp->e2->base == ELIST ) {
Pexpr x = tp;
if ( x->permanent ) break;
x->permanent = 3;
tp = tp->e2;
if ( x->e1 ) DEL(x->e1);
delete x;
}
e2 = tp;
break;
}
}
DEL(e1);
DEL(e2);
dd:
delete this;
}
void stmt::del()
{
DB( if(Adebug>=1) {
fprintf(stderr,"\n*** stmt::del(): ");
display_stmt(this,0,1);
if(Adebug>=2) display_stmt(this);
});
//fprintf(stderr,"DEL(stmt %d %s)\n",this,keys[base]); fflush(stderr);
permanent = 3;
switch (base) {
case SM:
case WHILE:
case DO:
case RETURN:
case CASE:
case SWITCH:
DEL(e);
break;
case PAIR:
DEL(s2);
break;
case BLOCK:
DEL(d);
DEL(s);
if (own_tbl) DEL(memtbl);
DEL(s_list);
goto dd;
case FOR:
DEL(e);
DEL(e2);
DEL(for_init);
break;
case IF:
DEL(e);
DEL(else_stmt);
break;
}
DEL(s);
DEL(s_list);
dd:
delete this;
}
void table::del()
{
// error('d',"\n*** %d::del() -- '%s'\n",this, t_name?t_name->string:"???");
for (register i=1; i<free_slot; i++) {
Pname n = entries[i];
if (n==0) error('i',"table.del(0)");
DB( if(Adebug>=2) { fprintf(stderr," name: '%s'",n->string);
display_type(n->tp); putc('\n',stderr);
});
// error( 'd',"\ntable::del: %s n_scope: %d, n_stclass: %d", n->string, n->n_scope, n->n_stclass );
if (n->n_stclass == STATIC) continue;
switch (n->n_scope) {
case ARG:
case ARGT:
break;
default:
{ char* s = n->string;
if (s && (s[0]!='_' || s[1]!='_' || s[2]!='X')) delete s;
/* delete n; */
n->del();
}
}
}
//delete entries;
//delete hashtbl;
delete this;
}
// local class
void delete_local()
{
DB( if(Adebug>=1) {
fprintf( stderr, "delete_local: vlist: %d", vlist );
});
// error( 'd', "delete_local: vlist: %d", vlist );
do {
for (vl* v = vlist; v; v = v->next) v->cl->really_print(v->vt);
vlist = 0;
for (Plist l=isf_list; l; l=l->l) {
Pname n = l->f;
Pfct f = Pfct(n->tp);
// error('d',"isf %n f %d",n,f);
if ( f == 0 ) { error('d', "delete_local: f == 0" );break;}
if (f->base == OVERLOAD) {
n = Pgen(f)->fct_list->f; // first fct
f = Pfct(n->tp);
}
if (debug_opt==0 && n->n_addr_taken) {
f->f_inline = 0;
if (n->n_dcl_printed<2) {
if (warning_opt)
error('w',"out-of-line copy of %n created",n);
n->dcl_print(0);
}
}
}
//isf_list = 0;
} while (vlist);
for ( Plist l = local_class; l; l = l->l )
{
Pname n = l->f;
// error( 'd' , "delete_local() %d %n %t", n, n, n->tp );
Pname nn = Pbase(n->tp)->b_name;
Pclass cl = Pclass(nn->tp);
for (Pname px, p=cl->mem_list; p; p=px) {
px = p->n_list;
if (p->tp)
switch (p->tp->base) {
case FCT:
{ Pfct f = (Pfct)p->tp;
if (f->body) {
if (f->f_inline==0
&& f->f_imeasure==0) {
if (ansi_opt && f->f_this) {
f->f_this->n_table = 0;
for (Pname n=f->f_this->n_list; n; n=n->n_list)
n->n_table = 0;
}
DEL(f->body);
f->body = 0;
}
}
}
case COBJ:
case EOBJ:
DEL(p);
break;
case CLASS:
case ENUM:
break;
default:
delete p;
} // end switch
else delete p;
} // end for mem
DEL(cl->memtbl);
cl->mem_list = 0;
cl->permanent = 3;
nn->permanent = 0;
DEL(nn);
n->permanent = 0;
extern void table_delete( char*, TOK, int );
table_delete( n->string, LOCAL, n->lex_level );
DEL(n);
}
}
0707071010112045761004440001630000160000010210600466055414200001200000013534discrim.c /* ident "@(#)ctrans:src/discrim.c 1.2" */
/************ add copyright **********************
* union discriminator functions for nodes in cfront.
* all return 0 for none,
* -1 for bad union index, -2 for inconsistent
* or otherwise messed up nodes
*/
#include "cfront.h"
#define DEFINE_TOKEN_CLASS_TABLE
#include "node_classes.h"
int basetype::discriminator(int which_union)
{
switch(which_union)
{
case 0:
switch(base) {
case FIELD: return 1;
case FCT: return 2;
default: return discrim_none_valid;
}
default:
return discrim_bad_index;
}
}
int fct::discriminator(int)
{
return discrim_bad_index;
}
int expr::discriminator(int which_union)
{
switch(which_union) {
case 0:
return 1; /* tp, never syn_class */
case 1: /* e1, i1, string */
switch(base) {
case DEREF:
case ICALL:
case REF:
case DOT:
case VALUE:
case SIZEOF:
case NEW:
case GNEW:
case DELETE:
case CAST:
case CALL:
case G_CALL:
case ASSIGN:
case EQ:
case NE:
case GT:
case GE:
case LE:
case LT:
case ELIST:
case ILIST:
case QUEST:
case CM:
case G_CM:
case PLUS:
case MINUS:
case MUL:
case DIV:
case MOD:
case LS:
case RS:
case AND:
case OR:
case ER:
case ANDAND:
case OROR:
case ASOR:
case ASER:
case ASAND:
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASMOD:
case ASDIV:
case ASLS:
case ASRS:
case DECR:
case INCR:
return 1;
case MDOT:
case IVAL:
return 2;
case TNAME:
case NAME:
case ICON:
case FCON:
case CCON:
case ID:
case STRING:
case TEXT:
return 3;
default: return discrim_none_valid;
}
case 2: /* e2, i2, string2, n_initializer */
/* i2 is a complete mystery. It is set to 1,
and never referenced. But I'm not sure that
someone somewhere doesn't test one of the other
union elements for equal to 1, so therefore this test. */
if(i2 == 1)return 2;
switch(base) {
case DELETE:
case VALUE:
case ICALL:
case CALL:
case G_CALL:
case ASSIGN:
case EQ:
case NE:
case GT:
case GE:
case LE:
case LT:
case DEREF:
case ELIST:
case QUEST:
case CM:
case G_CM:
case UMINUS:
case NOT:
case COMPL:
case ADDROF:
case G_ADDROF:
case PLUS:
case MINUS:
case MUL:
case DIV:
case MOD:
case LS:
case RS:
case AND:
case OR:
case ER:
case ANDAND:
case OROR:
case ASOR:
case ASER:
case ASAND:
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASMOD:
case ASDIV:
case ASLS:
case ASRS:
case DECR:
case INCR:
case NEW: /*- the placement expression list hangs off e2 -*/
return 1;
case TEXT:
return 3;
case NAME:
case TNAME:
/* The n_initializer field is used for TNAMEs when describing base */
/* class initializations. The TNAME refers to the base class, and */
/* the actuals arguments are hung off the n_initializer list */
return 4;
default: return discrim_none_valid;
}
case 3: /* tp2, fct_name, cond, mem, as_type, n_table, il, query_this */
switch(base) {
case VALUE:
case SIZEOF:
case NEW:
case GNEW:
case CAST:
return 1;
case CALL:
case G_CALL:
return 2;
case QUEST:
return 3;
case REF:
case DOT:
case MDOT:
return 4;
case ASOR:
case ASER:
case ASAND:
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASMOD:
case ASDIV:
case ASLS:
case ASRS:
case DECR:
case INCR:
case ASSIGN:
return 5;
case NAME:
case TNAME:
if (Pname(this)->n_oper==TYPE &&
(strcmp(Pname(this)->string, "_type")==0)) {
// error('d',"string %s n_oper: %k", string, Pname(this)->n_oper);
return 3;
}
return 6;
case ICALL:
case ANAME:
return 7;
default: return discrim_none_valid;
}
default:
return discrim_bad_index;
}
}
int name::discriminator (int which_union)
{
switch(which_union) {
case 0: /* n_qualifier, n_realscope */
if(base == LABEL) return 2;
else return 1;
default:
return discrim_bad_index;
}
}
int stmt::discriminator (int which_union)
{
switch(which_union) {
case 0: /* d, e2, has_default, case_value, ret_tp */
switch(base) {
case BLOCK:
case GOTO:
case LABEL:
case DCL:
return 1;
case FOR:
return 2;
case SWITCH:
return 3;
case PAIR:
case RETURN:
return 4;
default: return discrim_none_valid;
}
case 1: /* e, own_tbl, s2 */
switch(base) {
case FOR:
case IF:
case WHILE:
case DO:
case RETURN:
case SWITCH:
case SM:
case SM_PARAM:
case CASE:
return 1;
case BLOCK:
return 2;
case PAIR:
return 3;
default:
return discrim_none_valid;
}
case 2: /* for_init, else_stmt, case_list */
switch(base) {
case FOR:
return 1;
case IF:
return 2;
case SWITCH:
case CASE:
return 3;
default:
return discrim_none_valid;
}
default:
return discrim_bad_index;
}
}
static node_class token_to_class_map[DUMMY_LAST_NODE];
static char map_initialized;
node_class classify_node (Pnode node, int& error)
{
int ncx;
node_class nclass;
error = 0;
if (! map_initialized) {
map_initialized = 1 ;
for(ncx = 0; ncx < sizeof (token_classes) / sizeof (token_class);
ncx ++)
token_to_class_map[token_classes[ncx].token]
= token_classes[ncx].nclass;
}
if (!((node->base > 0) && (node->base < DUMMY_LAST_NODE))) {
error = 1;
return nc_unused;
}
nclass = token_to_class_map[node->base];
switch(nclass) {
case nc_fct:
case nc_name:
if(node->baseclass) nclass = nc_baseclass;
}
return nclass;
}
node_class classify_node (Pnode node)
{
int err;
node_class nclass = classify_node (node, err);
if(err) error ('i', "failed to classify node.");
return nclass;
}
0707071010112045771004440001630000160000010210700466055414600001200000041601doprint.c /* ident "@(#)ctrans:src/doprint.c 1.2" */
/*
************* obviously, have to do something here!!!
* Copyright (c) 1988 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted
* provided that the above copyright notice and this paragraph are
* duplicated in all such forms and that any documentation,
* advertising materials, and other materials related to such
* distribution and use acknowledge that the software was developed
* by the University of California, Berkeley. The name of the
* University may not be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
/*
$Header: /var/lib/cvsd/repos/research/researchv10no/cmd/cfront/xptcfront/cfront.cpio,v 1.1.1.1 2018/04/24 17:21:35 root Exp $
Copyright (c) 1989 by Object Design, Inc., Burlington, Mass.
All rights reserved.
*/
#include <sys/types.h>
#include <stdarg.h>
#include <ctype.h>
#include <iostream.h>
#include <strstream.h>
#include <memory.h>
#include <math.h>
#include <string.h>
#include "print_self.h"
/* 11-bit exponent (VAX G floating point) is 308 decimal digits */
#define MAXEXP 308
/* 128 bit fraction takes up 39 decimal digits; max reasonable precision */
#define MAXFRACT 39
#define DEFPREC 6
#define BUF (MAXEXP+MAXFRACT+1) /* + decimal point */
#define PUTC(ch) (void) fp.put(ch)
#define ARG() \
_ulong = flags&LONGINT ? va_arg(argp, long) : \
flags&SHORTINT ? va_arg(argp, short) : va_arg(argp, int);
#define todigit(c) ((c) - '0')
#define tochar(n) ((n) + '0')
#define LONGINT 0x01 /* long integer */
#define LONGDBL 0x02 /* long double; unimplemented */
#define SHORTINT 0x04 /* short integer */
#define ALT 0x08 /* alternate form */
#define LADJUST 0x10 /* left adjustment */
#define ZEROPAD 0x20 /* zero (as opposed to blank) pad */
#define HEXPREFIX 0x40 /* add 0x or 0X prefix */
static char * exponent(char * p, int exp, u_char fmtch);
static char * round(double fract,
int * exp,
char * start,
char * end,
char ch,
char * signp);
static
cvt(double number,
register int prec,
int flags,
char * signp,
u_char fmtch,
char * startp,
char * endp)
{
register char *p, *t;
register double fract;
int dotrim, expcnt, gformat;
double integer, tmp;
dotrim = expcnt = gformat = 0;
fract = modf(number, &integer);
/* get an extra slot for rounding. */
t = ++startp;
/*
* get integer portion of number; put into the end of the buffer; the
* .01 is added for modf(356.0 / 10, &integer) returning .59999999...
*/
for (p = endp - 1; integer; ++expcnt) {
tmp = modf(integer / 10, &integer);
*p-- = tochar((int)((tmp + .01) * 10));
}
switch(fmtch) {
case 'f':
/* reverse integer into beginning of buffer */
if (expcnt)
for (; ++p < endp; *t++ = *p);
else
*t++ = '0';
/*
* if precision required or alternate flag set, add in a
* decimal point.
*/
if (prec || flags&ALT)
*t++ = '.';
/* if requires more precision and some fraction left */
if (fract) {
if (prec)
do {
fract = modf(fract * 10, &tmp);
*t++ = tochar((int)tmp);
} while (--prec && fract);
if (fract)
startp = round(fract, (int *)NULL, startp,
t - 1, (char)0, signp);
}
for (; prec--; *t++ = '0');
break;
case 'e':
case 'E':
eformat: if (expcnt) {
*t++ = *++p;
if (prec || flags&ALT)
*t++ = '.';
/* if requires more precision and some integer left */
for (; prec && ++p < endp; --prec)
*t++ = *p;
/*
* if done precision and more of the integer component,
* round using it; adjust fract so we don't re-round
* later.
*/
if (!prec && ++p < endp) {
fract = 0;
startp = round((double)0, &expcnt, startp,
t - 1, *p, signp);
}
/* adjust expcnt for digit in front of decimal */
--expcnt;
}
/* until first fractional digit, decrement exponent */
else if (fract) {
/* adjust expcnt for digit in front of decimal */
for (expcnt = -1;; --expcnt) {
fract = modf(fract * 10, &tmp);
if (tmp)
break;
}
*t++ = tochar((int)tmp);
if (prec || flags&ALT)
*t++ = '.';
}
else {
*t++ = '0';
if (prec || flags&ALT)
*t++ = '.';
}
/* if requires more precision and some fraction left */
if (fract) {
if (prec)
do {
fract = modf(fract * 10, &tmp);
*t++ = tochar((int)tmp);
} while (--prec && fract);
if (fract)
startp = round(fract, &expcnt, startp,
t - 1, (char)0, signp);
}
/* if requires more precision */
for (; prec--; *t++ = '0');
/* unless alternate flag, trim any g/G format trailing 0's */
if (gformat && !(flags&ALT)) {
while (t > startp && *--t == '0');
if (*t == '.')
--t;
++t;
}
t = exponent(t, expcnt, fmtch);
break;
case 'g':
case 'G':
/* a precision of 0 is treated as a precision of 1. */
if (!prec)
++prec;
/*
* ``The style used depends on the value converted; style e
* will be used only if the exponent resulting from the
* conversion is less than -4 or greater than the precision.''
* -- ANSI X3J11
*/
if (expcnt > prec || !expcnt && fract && fract < .0001) {
/*
* g/G format counts "significant digits, not digits of
* precision; for the e/E format, this just causes an
* off-by-one problem, i.e. g/G considers the digit
* before the decimal point significant and e/E doesn't
* count it as precision."
*/
--prec;
fmtch -= 2; /* G->E, g->e */
gformat = 1;
goto eformat;
}
/*
* reverse integer into beginning of buffer,
* note, decrement precision
*/
if (expcnt)
for (; ++p < endp; *t++ = *p, --prec);
else
*t++ = '0';
/*
* if precision required or alternate flag set, add in a
* decimal point. If no digits yet, add in leading 0.
*/
if (prec || flags&ALT) {
dotrim = 1;
*t++ = '.';
}
else
dotrim = 0;
/* if requires more precision and some fraction left */
if (fract) {
if (prec) {
do {
fract = modf(fract * 10, &tmp);
*t++ = tochar((int)tmp);
} while(!tmp);
while (--prec && fract) {
fract = modf(fract * 10, &tmp);
*t++ = tochar((int)tmp);
}
}
if (fract)
startp = round(fract, (int *)NULL, startp,
t - 1, (char)0, signp);
}
/* alternate format, adds 0's for precision, else trim 0's */
if (flags&ALT)
for (; prec--; *t++ = '0');
else if (dotrim) {
while (t > startp && *--t == '0');
if (*t != '.')
++t;
}
}
return(t - startp);
}
static char * round(double fract,
int * exp,
char * start,
char * end,
char ch,
char * signp)
{
double tmp;
if (fract)
(void)modf(fract * 10, &tmp);
else
tmp = todigit(ch);
if (tmp > 4)
for (;; --end) {
if (*end == '.')
--end;
if (++*end <= '9')
break;
*end = '0';
if (end == start) {
if (exp) { /* e/E; increment exponent */
*end = '1';
++*exp;
}
else { /* f; add extra digit */
*--end = '1';
--start;
}
break;
}
}
/* ``"%.3f", (double)-0.0004'' gives you a negative 0. */
else if (*signp == '-')
for (;; --end) {
if (*end == '.')
--end;
if (*end != '0')
break;
if (end == start)
*signp = 0;
}
return(start);
}
static char * exponent(char * p, int exp, u_char fmtch)
{
register char *t;
char expbuf[MAXEXP];
*p++ = fmtch;
if (exp < 0) {
exp = -exp;
*p++ = '-';
}
else
*p++ = '+';
t = expbuf + MAXEXP;
if (exp > 9) {
do {
*--t = tochar(exp % 10);
} while ((exp /= 10) > 9);
*--t = tochar(exp);
for (; t < expbuf + MAXEXP; *p++ = *t++);
}
else {
*p++ = '0';
*p++ = tochar(exp);
}
return(p);
}
int vostream_printf(const char *fmt0, va_list argp, ostream& fp)
{
register const u_char *fmt; /* format string */
register int ch; /* character from fmt */
register int cnt; /* return value accumulator */
register int n; /* random handy integer */
register char *t; /* buffer pointer */
double _double; /* double precision arguments %[eEfgG] */
u_long _ulong; /* integer arguments %[diouxX] */
int base; /* base for [diouxX] conversion */
int dprec; /* decimal precision in [diouxX] */
int fieldsz; /* field size expanded by sign, etc */
int flags; /* flags as above */
int fpprec; /* `extra' floating precision in [eEfgG] */
int prec; /* precision from format (%.3d), or -1 */
int realsz; /* field size expanded by decimal precision */
int size; /* size of converted field or string */
int width; /* width from format (%8d), or 0 */
char sign; /* sign prefix (' ', '+', '-', or \0) */
char softsign; /* temporary negative sign for floats */
char *digs; /* digits for [diouxX] conversion */
char buf[BUF]; /* space for %c, %[diouxX], %[eEfgG] */
fmt = (const u_char *)fmt0;
digs = "0123456789abcdef";
for (cnt = 0;; ++fmt) {
for (;(ch = *fmt) && ch != '%'; ++cnt, ++fmt)
PUTC(ch);
if (!ch)return (cnt);
flags = 0; dprec = 0; fpprec = 0; width = 0;
prec = -1;
sign = '\0';
rflag: switch (*++fmt) {
case ' ':
/*
* ``If the space and + flags both appear, the space
* flag will be ignored.''
* -- ANSI X3J11
*/
if (!sign)
sign = ' ';
goto rflag;
case '#':
flags |= ALT;
goto rflag;
case '*':
/*
* ``A negative field width argument is taken as a
* - flag followed by a positive field width.''
* -- ANSI X3J11
* They don't exclude field widths read from args.
*/
if ((width = va_arg(argp, int)) >= 0)
goto rflag;
width = -width;
/* FALLTHROUGH */
case '-':
flags |= LADJUST;
goto rflag;
case '+':
sign = '+';
goto rflag;
case '.':
if (*++fmt == '*')
n = va_arg(argp, int);
else {
n = 0;
while (isascii(*fmt) && isdigit(*fmt))
n = 10 * n + todigit(*fmt++);
--fmt;
}
prec = n < 0 ? -1 : n;
goto rflag;
case '0':
/*
* ``Note that 0 is taken as a flag, not as the
* beginning of a field width.''
* -- ANSI X3J11
*/
flags |= ZEROPAD;
goto rflag;
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
n = 0;
do {
n = 10 * n + todigit(*fmt);
} while (isascii(*++fmt) && isdigit(*fmt));
width = n;
--fmt;
goto rflag;
case 'L':
flags |= LONGDBL;
goto rflag;
case 'h':
flags |= SHORTINT;
goto rflag;
case 'l':
flags |= LONGINT;
goto rflag;
case 'c':
*(t = buf) = va_arg(argp, int);
size = 1;
sign = '\0';
goto pforw;
case 'D':
flags |= LONGINT;
/*FALLTHROUGH*/
case 'd':
case 'i':
ARG();
if ((long)_ulong < 0) {
_ulong = -_ulong;
sign = '-';
}
base = 10;
goto number;
case 'e':
case 'E':
case 'f':
case 'g':
case 'G':
_double = va_arg(argp, double);
/*
* don't do unrealistic precision; just pad it with
* zeroes later, so buffer size stays rational.
*/
if (prec > MAXFRACT) {
if (*fmt != 'g' && *fmt != 'G' || (flags&ALT))
fpprec = prec - MAXFRACT;
prec = MAXFRACT;
}
else if (prec == -1)
prec = DEFPREC;
/*
* softsign avoids negative 0 if _double is < 0 and
* no significant digits will be shown
*/
if (_double < 0) {
softsign = '-';
_double = -_double;
}
else
softsign = 0;
/*
* cvt may have to round up past the "start" of the
* buffer, i.e. ``intf("%.2f", (double)9.999);'';
* if the first char isn't NULL, it did.
*/
*buf = NULL;
size = cvt(_double, prec, flags, &softsign, *fmt, buf,
buf + sizeof(buf));
if (softsign)
sign = '-';
t = *buf ? buf : buf + 1;
goto pforw;
case 'n':
if (flags & LONGINT)
*va_arg(argp, long *) = cnt;
else if (flags & SHORTINT)
*va_arg(argp, short *) = cnt;
else
*va_arg(argp, int *) = cnt;
break;
case 'O':
flags |= LONGINT;
/*FALLTHROUGH*/
case 'o':
ARG();
base = 8;
goto nosign;
case 'T': // Type
{
streampos cur_pos;
streampos new_pos;
cur_pos = fp.tellp();
_Print_self * obj = va_arg (argp, _Print_self *);
obj->print_self (fp);
new_pos = fp.tellp();
cnt += int (new_pos - cur_pos);
}
break;
case 'p':
/*
* ``The argument shall be a pointer to void. The
* value of the pointer is converted to a sequence
* of printable characters, in an implementation-
* defined manner.''
* -- ANSI X3J11
*/
/* NOSTRICT */
_ulong = (u_long)va_arg(argp, void *);
base = 16;
goto nosign;
case 's':
if (!(t = va_arg(argp, char *)))
t = "(null)";
if (prec >= 0) {
/*
* can't use strlen; can only look for the
* NUL in the first `prec' characters, and
* strlen() will go further.
*/
char *p;
if (p = (char *) memchr(t, 0, prec)) {
size = p - t;
if (size > prec)
size = prec;
} else
size = prec;
} else
size = strlen(t);
sign = '\0';
goto pforw;
case 'U':
flags |= LONGINT;
/*FALLTHROUGH*/
case 'u':
ARG();
base = 10;
goto nosign;
case 'X':
digs = "0123456789ABCDEF";
/* FALLTHROUGH */
case 'x':
ARG();
base = 16;
/* leading 0x/X only if non-zero */
if (flags & ALT && _ulong != 0)
flags |= HEXPREFIX;
/* unsigned conversions */
nosign: sign = '\0';
/*
* ``... diouXx conversions ... if a precision is
* specified, the 0 flag will be ignored.''
* -- ANSI X3J11
*/
number: if ((dprec = prec) >= 0)
flags &= ~ZEROPAD;
/*
* ``The result of converting a zero value with an
* explicit precision of zero is no characters.''
* -- ANSI X3J11
*/
t = buf + BUF;
if (_ulong != 0 || prec != 0) {
do {
*--t = digs[_ulong % base];
_ulong /= base;
} while (_ulong);
digs = "0123456789abcdef";
if (flags & ALT && base == 8 && *t != '0')
*--t = '0'; /* octal leading 0 */
}
size = buf + BUF - t;
pforw:
/*
* All reasonable formats wind up here. At this point,
* `t' points to a string which (if not flags&LADJUST)
* should be padded out to `width' places. If
* flags&ZEROPAD, it should first be prefixed by any
* sign or other prefix; otherwise, it should be blank
* padded before the prefix is emitted. After any
* left-hand padding and prefixing, emit zeroes
* required by a decimal [diouxX] precision, then print
* the string proper, then emit zeroes required by any
* leftover floating precision; finally, if LADJUST,
* pad with blanks.
*/
/*
* compute actual size, so we know how much to pad
* fieldsz excludes decimal prec; realsz includes it
*/
fieldsz = size + fpprec;
if (sign)
fieldsz++;
if (flags & HEXPREFIX)
fieldsz += 2;
realsz = dprec > fieldsz ? dprec : fieldsz;
/* right-adjusting blank padding */
if ((flags & (LADJUST|ZEROPAD)) == 0 && width)
for (n = realsz; n < width; n++)
PUTC(' ');
/* prefix */
if (sign)
PUTC(sign);
if (flags & HEXPREFIX) {
PUTC('0');
PUTC((char)*fmt);
}
/* right-adjusting zero padding */
if ((flags & (LADJUST|ZEROPAD)) == ZEROPAD)
for (n = realsz; n < width; n++)
PUTC('0');
/* leading zeroes from decimal precision */
for (n = fieldsz; n < dprec; n++)
PUTC('0');
/* the string or number proper */
fp.write(t, size);
/* trailing f.p. zeroes */
while (--fpprec >= 0)
PUTC('0');
/* left-adjusting padding (always blank) */
if (flags & LADJUST)
for (n = realsz; n < width; n++)
PUTC(' ');
/* finally, adjust cnt */
cnt += width > realsz ? width : realsz;
break;
case '\0': /* "%?" prints ?, unless ? is NULL */
return (cnt);
default:
PUTC(*fmt);
cnt++;
}
}
/* NOTREACHED */
}
int ostream_printf(ostream& stream, const char * format ...)
{
int ret;
va_list args;
va_start(args, format);
ret = vostream_printf(format, args, stream);
va_end(args);
return ret;
}
// There are intended to be more convienient that stirring up
// an strstream by hand.
int printf_to_string (char * string, int length, const char * format ...)
{
ostrstream& stream = ostrstream (string, length, (ios::open_mode)ios::app);
va_list args;
va_start(args, format);
vostream_printf (format, args, stream);
va_end(args);
stream.str();
return stream.pcount();
}
// caller of this must free() the string that comes back.
char * printf_to_alloc_string (const char * format ...)
{
ostrstream& stream = ostrstream ();
va_list args;
va_start(args, format);
vostream_printf (format, args, stream);
va_end(args);
return stream.str();
}
0707071010112044141004440001630000160000010176000466055377500001000000031505error.c /*ident "@(#)ctrans:src/error.c 1.4" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
error.c :
write error messages
Until scan_started != 0 no context can be assumed
***************************************************************************/
#ifdef __cplusplus
#include <stdlib.h>
#endif
#include "cfront.h"
#include "size.h"
#include "template.h"
int error_count;
static int no_of_warnings;
char scan_started;
#define ERRTRACE 20
static char* abbrev_tbl[] = {
" argument",
" base",
" class",
" declaration",
" expression",
" function",
" global",
"H",
" initialize",
"J",
" constructor", // 'K' !
" list",
" member",
" name",
" object",
" pointer",
" qualifie",
" reference",
" statement",
" type",
" undefined",
" variable",
" with",
" expected", // 'X'
" template", // 'Y'???
" parameter", // 'Z'???
};
ea* ea0;
void error_init()
{
static char errbuf[BUFSIZ];
setbuf(stderr,errbuf);
ea0 = new ea;
}
#define INTERNAL 127
void ext(int n)
{
int useit=n; // to avoid n not used warning during build
// for testing only
// if (n == INTERNAL)
// abort();
exit(error_count?error_count:1);
}
/* static */
void print_loc()
{
loc* sl = (Cstmt) ? &Cstmt->where : 0;
loc* dl = (Cdcl && (Cdcl->base==NAME || Cdcl->base==TNAME)) ? &Cdcl->where : 0;
if (sl && dl && sl->file==dl->file) { // Cstmt and Cdcl in same file
if (sl->line<=dl->line) {
if (curloc.file==dl->file && curloc.line<dl->line)
// hack to compensate for YACC's
// bad manners in the use of line numbers
sl->put(out_file);
else
dl->put(out_file);
}
else
sl->put(out_file);
}
else if (sl && sl->file==curr_file) // Cstmt in current file
sl->put(out_file);
else if (dl && dl->file==curr_file) // Cdcl in current file
dl->put(out_file);
else
curloc.put(out_file);
}
static void print_context()
{
putc('\n',out_file);
}
static char in_error = 0;
static loc dummy_loc;
void yyerror(char* s)
{
error(s);
}
int error(const char* s)
{
return error(0,s);
}
int error(int t, const char* s)
{
return error(t,&dummy_loc,s,*ea0,*ea0,*ea0,*ea0);
}
int error(const char* s, const ea& a0, const ea& a1, const ea& a2, const ea& a3)
{
return error(0,&dummy_loc,s,a0,a1,a2,a3);
}
int error(loc* lc, const char* s, const ea& a0, const ea& a1, const ea& a2, const ea& a3)
{
return error(0,lc,s,a0,a1,a2,a3);
}
int error(int t, const char* s, const ea& a0, const ea& a1, const ea& a2, const ea& a3)
{
return error(t,&dummy_loc,s,a0,a1,a2,a3);
}
int suppress_error;
int error(int t, loc* lc, const char* s, const ea& a0, const ea& a1, const ea& a2, const ea& a3)
/*
"int" not "void" because of "pch" in lex.c
legal error types are:
'w' warning (not counted in error count)
'd' debug
'D' debug -- no prefix
's' "not implemented" message
'l' "compiler limit exceeded" message
0 error
'i' internal error (causes abort)
't' error while printing error message
*/
{
if (suppress_error) return 0;
if (in_error++)
if (t == 't')
t = 'i';
else if (4 < in_error) {
fprintf(stderr,"\nOops!, error while handling error\n");
ext(13);
}
FILE * of = out_file;
out_file = stderr;
if (!scan_started || t=='t')
putch('\n');
else if (lc != &dummy_loc) {
if(t != 'D') lc->put(out_file);
} else {
if(t != 'D') print_loc();
}
switch (t) {
case 0:
putstring("error: ");
break;
case 'd':
putstring("DEBUG: ");
case 'D':
break;
case 'w':
no_of_warnings++;
putstring("warning: ");
break;
case 'l':
putstring("compiler limit exceeded: ");
break;
case 's':
putstring("sorry, not implemented: ");
break;
case 'i':
if (error_count++) {
fprintf(out_file,"sorry, %s cannot recover from earlier errors\n",prog_name);
ext(INTERNAL);
}
else
fprintf(out_file,"internal %s error: ",prog_name);
}
ea argv[4];
ea* a = argv;
argv[0] = a0;
argv[1] = a1;
argv[2] = a2;
argv[3] = a3;
int c;
while (c = *s++) {
if ('A'<=c && c<='Z')
putstring(abbrev_tbl[c-'A']);
else if (c == '%') {
switch (c = *s++) {
case 'k': // TOK assumed passed as an int
{ TOK x = TOK(a->i);
if (0<x && x<=MAXTOK && keys[x])
fprintf(out_file," %s",keys[x]);
else
fprintf(out_file," token(%d)",x);
break;
}
case 't': // Ptype
{ Ptype tt = Ptype(a->p);
if (tt == 0) break;
putch(' ');
int nt = ntok;
emode = 1;
tt->dcl_print(0);
emode = 0;
ntok = nt;
break;
}
case 'n': // Pname
{ Pname nn = Pname(a->p);
if (nn && nn->string) {
// suppress generated class names:
if (nn->string[0]=='_'
&& nn->string[1]=='_'
&& nn->string[2]=='C') break;
emode = 1;
putch(' ');
nn->print();
emode = 0;
}
else
putstring(" ?");
break;
}
case 'p': // pointer
{ char* f = sizeof(char*)==sizeof(int)?" %d":" %ld";
fprintf(out_file,f,a->p);
break;
}
case 'c': // char assumed passed as an int
putch(a->i);
break;
case 'd': // int
fprintf(out_file," %d",a->i);
break;
case 'o': // int
fprintf(out_file," %o",a->i);
break;
case 's': // char*
char *s = ((char *)a->p);
if ( s ) putst((char*)a->p);
break;
}
a++;
}
else
putch(c);
}
/*
switch (t) {
case 'd':
case 't':
case 'w':
putch('\n');
break;
default:
*/
print_context();
/*
}
*/
templ_inst::head->print_error_loc();
fflush(stderr);
if (!scan_started && t!='d' && t!='w') ext(4);
// now we may want to carry on
out_file = of;
switch (t) {
case 't':
if (--in_error) return 0;
case 'i':
ext(INTERNAL);
case 0:
case 'l':
case 's':
if (MAXERR<++error_count) {
fprintf(stderr,"Sorry, too many errors\n");
ext(7);
}
}
in_error = 0;
return 0;
}
#ifdef DBG
#define OPEREP(v) ((v)>MAXTOK || (v)<=0 ? 0 : keys[v])
void
display_type( Ptype t )
{
if ( t ) { putc(' ',stderr);
FILE * of = out_file;
out_file = stderr;
extern int ntok; int nt = ntok;
emode=1; (t)->dcl_print(0); emode=0;
//fprintf(stderr," <node %d",t->node::id);
if(!t->allocated)fprintf(stderr," UNALLOCATED!");
//putc('>',stderr);
ntok = nt;
out_file = of;
} else fprintf(stderr," <null type>");
}
#define INDENT(in) { for ( int i = in; i > 0; --i ) fprintf(stderr," "); }
static indent = 0;
void
display_expr( Pexpr ptr, char* label, int oneline )
{
INDENT(indent);
if ( label ) fprintf(stderr, "%s:", label);
if ( ptr == 0 ) {
fprintf(stderr, "NULL EXPR\n" );
return;
}
fprintf(stderr,"%d",ptr->node::id);
if(!ptr->allocated)fprintf(stderr," UNALLOCATED!");
putc(':',stderr);
char* s = OPEREP(ptr->base);
if ( s == 0 )
fprintf(stderr, "token(%d)", ptr->base );
else
fprintf(stderr,"%s",s);
if ( ptr->displayed ) { // recursion!!!
if ( ptr->base == NAME )
fprintf(stderr," '%s'",Pname(ptr)->string);
fprintf(stderr," RECURSION!!!\n");
ptr->displayed = 0;
return;
}
ptr->displayed = 1;
switch ( ptr->base ) {
case QUEST:
display_type(ptr->tp);
putc('\n',stderr);
if ( !oneline ) {
++indent;
display_expr( ptr->cond, "cond" );
display_expr( ptr->e1, "e1" );
display_expr( ptr->e2, "e2" );
--indent;
}
break;
case REF: case DOT:
display_type(ptr->tp);
putc('\n',stderr);
if ( !oneline ) {
++indent;
display_expr( ptr->e1, "e1" );
display_expr( ptr->mem, "mem" );
--indent;
}
break;
case MDOT:
display_type(ptr->tp);
fprintf(stderr," string2:'%s'\n",ptr->string2?ptr->string2:"");
if ( !oneline ) {
++indent;
display_expr( ptr->mem, "mem" );
--indent;
}
break;
case ICALL:
fprintf(stderr," fn=='%s'",ptr->il->fct_name->string);
display_type(ptr->tp);
putc('\n',stderr);
if ( !oneline ) {
++indent;
for ( int i = 0; i < ptr->il->i_slots; ++i ) {
ia *aa = &ptr->il->i_args[i];
INDENT(indent);
fprintf(stderr,"arg:'%s'",aa->local&&aa->local->string?aa->local->string:"");
display_type(aa->tp);
putc('\n',stderr);
++indent;
display_expr( aa->arg, "actual" );
--indent;
}
display_expr( ptr->e1, "e1" );
display_expr( ptr->e2, "e2" );
--indent;
}
break;
case SIZEOF:
if ( ptr->tp2 ) {
putc('(',stderr);
display_type(ptr->tp2);
putc(')',stderr);
}
display_type(ptr->tp);
putc('\n',stderr);
if ( !oneline ) {
if ( ptr->e1 ) {
++indent;
display_expr(ptr->e1,"e1");
--indent;
}
if ( ptr->e2 ) {
++indent;
display_expr(ptr->e2,"e2");
--indent;
}
}
break;
case ZERO:
display_type(ptr->tp);
putc('\n',stderr);
break;
case NAME: case TNAME: case STRING:
case ICON: case ID:
case FCON: case CCON:
case IVAL:
fprintf(stderr," '%s'",(ptr->string)?ptr->string:"<0>");
display_type(ptr->tp);
if(ptr->string2)fprintf(stderr," string2=='%s'",ptr->string2);
if ( ptr->permanent ) fprintf(stderr, " (permanent)");
if ( ptr->base == IVAL ) fprintf(stderr, " i1==%d", ptr->i1);
putc('\n',stderr);
if ( !oneline && (ptr->base == NAME || ptr->base == TNAME) ) {
Pname n = Pname(ptr);
++indent;
INDENT(indent);
fprintf(stderr, "n_sto==%d", n->n_sto );
fprintf(stderr, " n_stclass==%d",n->n_stclass);
fprintf(stderr, " n_scope==%d",n->n_scope);
fprintf(stderr, " n_protected==%d\n", n->n_protect );
INDENT(indent);
fprintf(stderr, "n_oper=='%s'", (s=OPEREP(n->base))?s:"0");
fprintf(stderr, " n_val==%d", n->n_val );
fprintf(stderr, " n_xref==%d",n->n_xref);
fprintf(stderr, " lex_level==%d\n", n->lex_level );
INDENT(indent);
fprintf(stderr, "n_used==%d",n->n_used);
fprintf(stderr, " n_assigned_to==%d",n->n_assigned_to);
fprintf(stderr, " n_addr_taken==%d\n",n->n_addr_taken );
INDENT(indent);
fprintf(stderr, "n_union==%d", n->n_union);
fprintf(stderr, " n_list=='%s'", n->n_list?n->n_list->string:"<0>" );
fprintf(stderr, " n_qualifier=='%s'", n->n_qualifier?n->n_qualifier->string:"<0>" );
if ( n->n_initializer ) {
fprintf(stderr, " n_initializer:\n" );
++indent;
display_expr( n->n_initializer );
--indent;
} else fprintf(stderr, " n_initializer==<0>\n");
--indent;
}
break;
case BLOCK:
((Pstmt)ptr)->where.put(stderr); putc(' ',stderr);
putc('\n',stderr);
break;
default:
display_type(ptr->tp);
putc('\n',stderr);
if ( !oneline && ptr->base > 0
&& (ptr->base<165 || ptr->base==MEMPTR) ) {
++indent;
display_expr( ptr->e1, "e1" );
display_expr( ptr->e2, "e2" );
--indent;
}
break;
}
ptr->displayed = 0;
return;
}
void
display_stmt( Pstmt ptr, char* label, int oneline )
{
INDENT(indent);
if ( label ) fprintf(stderr, "%s:", label);
if ( ptr == 0 ) {
fprintf(stderr, "NULL STMT\n" );
return;
}
fprintf(stderr,"%d",ptr->node::id);
if(!ptr->allocated)fprintf(stderr," UNALLOCATED!");
putc(':',stderr);
char* s = OPEREP(ptr->base);
if ( s == 0 )
fprintf(stderr, "token(%d)", ptr->base );
else
fprintf(stderr,"%s",s);
if ( ptr->displayed ) { // recursion!!!
if ( ptr->base == NAME )
fprintf(stderr," '%s'",Pname(ptr)->string);
fprintf(stderr," RECURSION!!!\n");
ptr->displayed = 0;
return;
}
putc(' ',stderr);
ptr->where.put(stderr);
if ( oneline ) { putc('\n',stderr); return; }
ptr->displayed = 1;
switch ( ptr->base ) {
case BLOCK:
fprintf(stderr," .. ");
ptr->where2.put(stderr);
putc('\n',stderr);
++indent;
{ for( Pstmt st = ptr->s; st; st = st->s_list )
display_stmt( ptr->s, "s" );
}
--indent;
break;
case IF:
putc('\n',stderr);
++indent;
display_expr(ptr->e,"cond");
display_stmt(ptr->s,"if-clause");
--indent;
if ( ptr->else_stmt ) {
INDENT(indent);
fprintf(stderr,"else\n");
++indent;
display_stmt(ptr->else_stmt,"else-clause");
--indent;
}
break;
case DO:
putc('\n',stderr);
++indent;
display_stmt(ptr->s,"do-stmt");
display_expr(ptr->e,"cond");
--indent;
break;
case WHILE:
putc('\n',stderr);
++indent;
display_expr(ptr->e,"cond");
display_stmt(ptr->s,"while-stmt");
--indent;
break;
case FOR:
putc('\n',stderr);
++indent;
display_stmt(ptr->for_init,"init");
display_expr(ptr->e,"cond");
display_expr(ptr->e2,"incr");
display_stmt(ptr->s,"stmt");
--indent;
break;
case RETURN:
putc('\n',stderr);
++indent;
display_expr(ptr->e,"e");
--indent;
break;
case SM:
putc('\n',stderr);
++indent;
display_expr(ptr->e,"e");
--indent;
break;
default:
putc('\n',stderr);
break;
}
ptr->displayed = 0;
return;
}
void
display_namelist( Plist nl, char* s, int verbose )
{
error('d',"namelist: %s",s?s:"");
++indent;
for ( Plist l = nl; l; l = l->l ) {
Pname n = l->f;
INDENT(indent);
fprintf(stderr," %d",n);
error('D'," %n %k n_key %d",n,n?n->tp->base:0,n?n->n_key:0);
if ( verbose ) {
++indent;
display_expr(n);
--indent;
}
}
--indent;
}
#endif
0707071010112044151004440001630000160000010176300466055400100001100000053752expand.c /*ident "@(#)ctrans:src/expand.c 1.3" */
/*****************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
expand.c:
expand inline functions
******************************************************************/
#include "cfront.h"
static Ptable Scope;
// extern void display_expr(Pexpr);
static char* temp(char* vn, Pname fn)
//
// make the name of the temporary: __Xvn00xxxxxx
// xxxxxx is a representation of fn's address -
// anything unique will do. we use radix 32 here
// add two bytes to make the name sensitive to the scope
// to avoid re-using temps when an inline is expanded in
// more than one other inline that is then called in the
// same expression
//
{
if (vn[0]!='_' || vn[1]!='_' || vn[2]!='X') {
unsigned long a = (unsigned long) fn->tp;
// al = the number of radix-32 chars in a
unsigned long aa = a;
int al = 0;
while (aa) {
al++;
aa >>= 5;
}
// allocate memory for the result
int ll = strlen(vn);
char* s = new char[ll+al+8];
register char* p = s;
// append _ _ X vn
*p++ = '_';
*p++ = '_';
*p++ = 'X';
strcpy(p,vn);
p += ll;
*p++ = '0';
*p++ = '0';
// append representation of `a'
while (a) {
*p++ = "abcdefghijklmnopqrstuvwxyz012345"[a&037];
a >>= 5;
}
// append scope representation and trailing null
*p++ = 'a' + ((int(Scope)>>4)&15);
*p++ = 'a' + ((int(Scope)>>8)&15);
*p = '\0';
//tmp error('d',"temp(%s,%n) -- scope %d -- returning %s",vn,fn,scope,s);
return s;
}
else {
//tmp error('d',"temp(%s,%n) -- scope %d -- returning %s",vn,fn,scope,vn);
return vn;
}
}
Pname dcl_local(Ptable scope, Pname an, Pname fn)
{
if (scope == 0 || scope->base == 0) {
if (sti_tbl == 0) sti_tbl = new table(8,gtbl,0);
scope = sti_tbl;
// error('s',"cannot expand inlineF needing temporaryV in nonF context");
// return an;
}
if (an->n_stclass == STATIC) {
if (an->tp->base!=FCT) error('s',&fn->where,"cannot expand inlineF with static%n",an);
return an;
}
Pname cn = fn->n_table->t_name;
char* s = temp(an->string,fn);
Pname nx = new name(s);
Ptype atp = an->tp;
//error('d',"dcl_local(%d,%n,%n) -> %s",scope,an,fn,s);
while (atp->base == TYPE) atp = Pbase(atp)->b_name->tp;
if (atp->base == VEC) {
if (an->n_scope == ARG) {
Pptr t = new ptr(PTR,Pvec(atp)->typ);
nx->tp = t;
}
else {
error('s',&fn->where,"cannot expand inlineF needing temporaryV of vectorT");
return an;
}
}
else
nx->tp = atp;
PERM(nx->tp);
nx->n_used = an->n_used;
nx->n_assigned_to = an->n_assigned_to;
nx->n_addr_taken = an->n_addr_taken;
nx->n_xref = an->n_xref;
//error('d',"nx %n %t,",nx,nx->tp);
Pname r = scope->look(nx->string,0);
if (r) {
//error('d',"ll %n %t",ll,ll->tp);
if (r->tp->check(nx->tp,0))
error('s',&fn->where,"cannot expand inlineF %n with two local variables with the sameN (%s)",fn,an->string);
else
r = 0;
}
if (r==0) {
r = scope->insert(nx,0);
//error('d',"%d %d %d %d",r->n_stclass,an->n_stclass,r->lex_level,an->lex_level);
r->n_stclass = an->n_stclass;
r->lex_level = an->lex_level;
delete nx;
r->where.line = 0;
}
return r;
}
int ck_cast(Ptype t1, Ptype t2)
/*
return a value of type t2 from a function returning a t1
return 1 if cast is needed
*/
{
st:
while (t1->base == TYPE) t1 = Pbase(t1)->b_name->tp;
while (t2->base == TYPE) t2 = Pbase(t2)->b_name->tp;
if (t1 == t2) return 0;
if (t1->base != t2->base) return 1;
switch (t1->base) {
case RPTR:
case PTR:
{ t1 = Pptr(t1)->typ;
if (t1->base == VOID) return 1;
t2 = Pptr(t2)->typ;
goto st;
}
case CHAR:
case SHORT:
case INT:
case LONG:
if (Pbase(t1)->b_unsigned != Pbase(t2)->b_unsigned) return 1;
break;
case COBJ:
{
Pname nn = Pbase(t1)->b_name;
if (Pclass(nn->tp)->csu==UNION ) return 0;
if (t2->base==COBJ && nn->tp==Pbase(t2)->b_name->tp) return 0;
return 1;
}
}
return 0;
}
int makeCM( Ptype t )
/* return 1 if the type is not a primitive type
* this will cause the generation of (t,0)
* note: ``t'' is guaranteed not to be 0
*/
{
while ( t->base == TYPE )
t = Pbase(t)->b_name->tp;
switch (t->base) {
case FLOAT:
case DOUBLE:
case LDOUBLE:
case CHAR:
case SHORT:
case INT:
case LONG:
case EOBJ:
return 0;
default:
return 1;
}
}
static ret_seen = 0;
Pstmt stmt::expand()
/*
copy the statements with the formal arguments replaced by ANAMES
called once only per inline function
expand_tbl!=0 if the function should be transformed into an expression
and expand_tbl is the table for local variables
*/
{
if (this == 0) error('i',"0->S::expand() for%n",expand_fn);
Pstmt ostmt = Cstmt;
if ( where.line ) Cstmt = this;
if (memtbl) { /* check for static variables */
register Ptable t = memtbl;
register int i;
for (register Pname n = t->get_mem(i=1); n; n=t->get_mem(++i)) {
if (n->n_stclass == STATIC) {
if (n->tp->base == FCT) continue;
error('s',"cannot expand inlineF with static%n",n);
n->n_stclass = AUTO;
}
n->where.line = 0;
}
}
if (expand_tbl) { /* make expression */
Pexpr ee;
if (memtbl) { // temporaries
int i;
for (Pname n=memtbl->get_mem(i=1); n; n=memtbl->get_mem(++i)) {
//error('d',"block %n %k %d %d",n,base,memtbl->real_block == this,n->lex_level);
if (n->base!=NAME || n->tp==any_type) continue;
if (base==BLOCK
&& memtbl->real_block == this
&& n->lex_level < 2
&& (n->string[0]!='_' // promoted from called
// inlines
|| n->string[1]!='_'
|| ( n->string[2]!='X'
&& n->string[2]!='K'))
) {
//error('d',"not promoting%n",n);
continue;
}
if (memtbl != scope)
{
Pname nn = dcl_local(scope,n,expand_fn);
nn->base = NAME;
n->string = nn->string;
}
else if (n->tp->base!=FCT && n->tp->base!=OVERLOAD){
n->string = temp(n->string, expand_fn);
n->where.line = 0;
}
}
}
switch (base) {
default:
error('s',"cannot expand inlineF%n with %kS in inline",expand_fn,base);
Cstmt = ostmt;
return Pstmt(dummy);
case BLOCK:
DB(if(Edebug>=2){error('d',"stmt::expand() -- block");display_stmt(this);});
if (s_list) {
ee = Pexpr(s_list->expand());
if (s) {
ee = new expr(CM, Pexpr(s->expand()), ee);
ee->tp = ee->e2->tp;
PERM(ee);
}
Cstmt = ostmt;
return Pstmt(ee);
}
if (s) {
Pstmt st = s->expand();
Cstmt = ostmt;
return st;
}
Cstmt = ostmt;
return Pstmt(zero);
case PAIR:
ee = s2 ? Pexpr(s2->expand()) : 0;
ee = new expr(CM, s?Pexpr(s->expand()):0, ee);
ee->tp = ee->e2->tp;
if (s_list) {
ee = new expr(CM, ee, Pexpr(s_list->expand()));
ee->tp = ee->e2->tp;
}
PERM(ee);
Cstmt = ostmt;
return Pstmt(ee);
case RETURN:
ret_seen = 1;
s_list = 0;
if (e == 0)
ee = zero;
else {
ee = e->expand();
Ptype tt = Pfct(expand_fn->tp)->returns;
if (tt == 0) tt = Pfct(expand_fn->tp)->returns;
//error('d',"return::expand() -- ee==%k tt==%t",ee?ee->base:0,tt);
//display_expr(ee);
if (tt!=ee->tp && ck_cast(tt,ee->tp)) ee = new cast(tt,ee);
}
Cstmt = ostmt;
return Pstmt(ee);
case SM:
if (e== 0 || e==dummy)
ee = zero;
else {
if (e->base == DEREF) e = e->e1;
ee = e->expand();
}
// no break;
case ASM:
if (s_list) {
ee = new expr(CM, ee, (Pexpr)s_list->expand());
ee->tp = ee->e2->tp;
PERM(ee);
}
Cstmt = ostmt;
return (Pstmt)ee;
case IF:
{
int ors = ret_seen;
ret_seen = 0;
ee = Pexpr(s->expand());
if(ee->base==ASSIGN && ee->e1->tp &&
ee->e1->tp->base != PTR)
ee = new expr(G_CM,ee,zero);
Pexpr qq = new expr(QUEST,ee,zero);
int ret1 = ret_seen;
ret_seen = 0;
qq->cond = e->expand();
qq->e2 = else_stmt ? Pexpr(else_stmt->expand()) : zero;
int ret2 = ret_seen;
if (ret1+ret2 && s_list) {
error('s',"cannot expand inlineF%n with S after \"return\"",expand_fn);
ret_seen = 0;
}
ret_seen += ret1;
ret_seen += ret2;
ret_seen += ors;
// handle ``if (x) class_object_valued_expression;''
Ptype t1 = qq->e1->tp;
Ptype t2 = qq->e2->tp;
if (t1 && t1->base==FCT)
t1 = Pfct(t1)->s_returns ? Pfct(t1)->s_returns : Pfct(t1)->returns;
if (t2 && t2->base==FCT)
t2 = Pfct(t2)->s_returns ? Pfct(t2)->s_returns : Pfct(t2)->returns;
Pname c1 = t1?t1->is_cl_obj():0;
Pname c2 = t2?t2->is_cl_obj():0;
int z1 = c1 && c1!=c2;
int z2 = c2 && c1!=c2;
//error('d',"if()%k%t else%k%t",qq->e1->base,t1,qq->e2->base,t2);
//error('d',"c1%n c2%n %d %d",c1,c2,z1,z2);
//display_expr(qq);
if (c1==0
&& c2==0
&& t1
&& t2
&& t2->check(t1,ASSIGN)
&& t1->check(t2,ASSIGN)) {
z1 = makeCM( t1 );
z2 = makeCM( t2 );
if ((z1 && ret1) || (z2 && ret2))
error('s',"cannot expand inlineF with return in ifS");
}
//error('d',"if()%k%t else%k%t",qq->e1->base,t1,qq->e2->base,t2);
//error('d',"c1%n c2%n %d %d",c1,c2,z1,z2);
//display_expr(qq);
if (t1 && z1==0) {
// since zero is acceptable to all pointer types
// we need only ``fix'' z1 and z2 will take care
// of itself
z1 = t1->is_ptr_or_ref()
&& t2
&& t2->is_ptr_or_ref()
&& t1->check(t2,0)
&& !const_problem;
}
//error('d',"if()%k%t else%k%t",qq->e1->base,t1,qq->e2->base,t2);
//error('d',"c1%n c2%n %d %d",c1,c2,z1,z2);
//display_expr(qq);
if (z1) {
Pexpr v = (z2==0 && (t2->is_ptr_or_ref())) ? new cast(t2,zero) : zero;
qq->e1 = new expr(CM,qq->e1,v);
qq->e1->tp = qq->e1->e1->tp;
}
//error('d',"if()%k%t else%k%t",qq->e1->base,t1,qq->e2->base,t2);
//error('d',"c1%n c2%n %d %d",c1,c2,z1,z2);
//display_expr(qq);
if (z2) {
Pexpr v = (z1==0 && (t1->is_ptr_or_ref())) ? new cast(t1,zero) : zero;
qq->e2 = new expr(CM,qq->e2,v);
qq->e2->tp = qq->e2->e1->tp;
}
//error('d',"if()%k%t else%k%t",qq->e1->base,t1,qq->e2->base,t2);
//error('d',"c1%n c2%n %d %d",c1,c2,z1,z2);
//display_expr(qq);
if (s_list) {
qq = new expr(CM,qq,Pexpr(s_list->expand()));
qq->tp = qq->e2->tp;
}
else
qq->tp = qq->e1->tp;
PERM(qq);
Cstmt = ostmt;
return Pstmt(qq);
}
}
}
where.line = 0;
switch (base) {
default:
if (e) e = e->expand();
break;
case PAIR:
if (s2) s2 = s2->expand();
break;
case BLOCK:
break;
case FOR:
if (for_init) for_init = for_init->expand();
if (e2) e2 = e2->expand();
case ASM:
break;
// case LABEL:
// case GOTO:
case RETURN:
// case BREAK:
// case CONTINUE:
error('s',"cannot expand inlineF%n with %kS",expand_fn,base);
}
if (s) s = s->expand();
if (s_list) s_list = s_list->expand();
PERM(this);
Cstmt = ostmt;
return this;
}
Pexpr expr::expand()
{
if (this == 0) error('i',"E::expand(0)");
switch (base) {
case NAME:
if (expand_tbl && Pname(this)->n_scope==FCT) {
Pname n = Pname(this);
char* s = n->string;
if (s[0]=='_' && s[1]=='_' && s[2]=='X') break;
Pname cn = expand_fn->n_table->t_name;
// n->string = temp(s,expand_fn->string,(cn)?cn->string:0);
n->string = temp(s,expand_fn);
}
case DUMMY:
case ICON:
case FCON:
case CCON:
case IVAL:
//case FVAL:
//case LVAL:
case STRING:
case ZERO:
case TEXT:
case ANAME:
case MDOT:
break;
case ICALL:
if (expand_tbl && e1==0) {
int ors = ret_seen;
ret_seen = 0;
Pname fn = il->fct_name;
Pfct f = Pfct(fn->tp);
if (f->f_expr==0
// f->returns==void_type
// && f->s_returns!=int_type
// && fn->n_oper!=CTOR
)
error('s',&fn->where,"cannot expand value-returning inline%n with call of non-value-returning inline%n",expand_fn,fn);
// else
// error("inline%n called before defined",fn);
ret_seen = ors;
}
break;
case SIZEOF:
case CAST:
if (tp2) PERM(tp2);
goto rrr;
case QUEST:
cond = cond->expand();
default:
if (e2) e2 = e2->expand();
case REF:
case DOT:
rrr:
if (e1) e1 = e1->expand();
break;
}
switch (base) {
case CM:
case G_CM:
if (tp==0) tp=e2->tp;
}
PERM(this);
return this;
}
int nin;
static int watch_out;
bit expr::not_simple()
/*
is a temporary variable needed to hold the value of this expression
as an argument for an inline expansion?
return 1; if side effect
return 2; if modifies expression
*/
{
int s;
//error('d',"not_simple%k",base);
switch (base) {
default:
return 2;
case NAME:
if (nin==0 && Pname(this)->n_table==gtbl) return 2; // unsafe: aliasing
case ZERO:
case IVAL:
//case FVAL:
case ICON:
case CCON:
case FCON:
return 0;
case STRING:
::watch_out = 1;
return 0;
case MDOT:
return mem->not_simple();
case SIZEOF:
return (e1==0 || e1==dummy) ? 0 : e1->not_simple();
case G_ADDROF:
case ADDROF:
return e2->not_simple();
case CAST:
return e1->not_simple();
case DOT:
::watch_out = 1;
return e1->not_simple();
case REF:
::watch_out = 1;
return e1->not_simple();
case UMINUS:
case NOT:
case COMPL:
return e2->not_simple();
case DEREF:
s = e1->not_simple();
if (1<s) return 2;
if (e2==0) return s;
return s |= e2->not_simple();
case MUL:
case DIV:
case MOD:
case PLUS:
case MINUS:
case LS:
case RS:
case AND:
case OR:
case ER:
case LT:
case LE:
case GT:
case GE:
case EQ:
case NE:
case ANDAND:
case OROR:
case CM:
s = e1->not_simple();
if (1<s) return 2;
return s |= e2->not_simple();
case QUEST:
s = cond->not_simple();
if (1<s) return 2;
s |= e1->not_simple();
if (1<s) return 2;
return s |= e2->not_simple();
case ANAME:
if (curr_icall) {
Pname n = (Pname)this;
int argno = int(n->n_val);
for (Pin il=curr_icall; il; il=il->i_next)
if (n->n_table == il->i_table) goto aok;
goto bok;
aok:
return (il->i_args[argno].local) ? 0 : il->i_args[argno].arg->not_simple();
}
bok: error('i',"expand aname%n",this);
case G_CM:
case VALUE:
case NEW:
case GNEW:
case CALL:
case G_CALL:
case ICALL:
case ASSIGN:
case INCR:
case DECR:
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASDIV:
case ASMOD:
case ASAND:
case ASOR:
case ASER:
case ASLS:
case ASRS:
return 2;
}
}
extern void uninline(Pname fn);
//extern Pname new_fct;
//extern Pname del_fct;
extern Pstmt del_list;
extern Pstmt break_del_list;
extern Pstmt continue_del_list;
extern Pname curr_fct;
extern Pexpr init_list;
extern Pname make_default_ctor(Pclass cl);
void expand_itor(Pclass cl)
{
//error('d',"expand_itor(%t)",cl);
Pexpr s2 = curr_expr;
Pstmt s5 = del_list;
Pstmt s6 = break_del_list;
Pstmt s7 = continue_del_list;
Pname s8 = curr_fct;
Pexpr s9 = init_list;
(void) cl->make_itor(1);
curr_expr = s2;
del_list = s5;
break_del_list = s6;
continue_del_list = s7;
curr_fct = s8;
init_list = s9;
}
/*
extern Pname make_default_dtor(Pclass cl);
void expand_dtor(Pclass cl)
{
//error('d',"expand_itor(%t)",cl);
Pexpr s2 = curr_expr;
Pstmt s5 = del_list;
Pstmt s6 = break_del_list;
Pstmt s7 = continue_del_list;
Pname s8 = curr_fct;
Pexpr s9 = init_list;
(void) make_default_dtor(cl);
curr_expr = s2;
del_list = s5;
break_del_list = s6;
continue_del_list = s7;
curr_fct = s8;
init_list = s9;
}
void expand_ictor(Pclass cl)
{
//error('d',"expand_itor(%t)",cl);
Pexpr s2 = curr_expr;
Pstmt s5 = del_list;
Pstmt s6 = break_del_list;
Pstmt s7 = continue_del_list;
Pname s8 = curr_fct;
Pexpr s9 = init_list;
(void) make_default_ctor(cl);
curr_expr = s2;
del_list = s5;
break_del_list = s6;
continue_del_list = s7;
curr_fct = s8;
init_list = s9;
}
*/
Pexpr fct::expand(Pname fn, Ptable scope, Pexpr ll)
/*
expand call to (previously defined) inline function in "scope"
with the argument list "ll"
(1) declare variables in "scope"
(2) initialize argument variables
(3) link to body
*/
{
Scope = scope;
//error('d',"expand%s() body %d f_expr %d inline %d",fn->string,body,f_expr,f_inline);
if (f_inline == ITOR) {
Pexpr s1 = last_expanded;
expand_itor(memof);
last_expanded = s1;
last_stmt = stmtno;
this = Pfct(fn->tp);
if (f_inline==0 && f_imeasure) {
uninline(fn);
return 0;
}
}
//error('d',"expand %n body %d f_expr %d defined %d",fn,body,f_expr,defined);
//error('d',"inline %d memtbl %d scope %d",f_inline,Pfct(fn->tp)->body->memtbl,scope);
//display_stmt(body);
if ((body==0 && f_expr==0) // before defined
|| ((defined&SIMPLIFIED)==0) // before simplified
|| (Pfct(fn->tp)->body->memtbl==scope) // while defining
|| (f_inline>1) // recursive call
) { // so don't expand
if (warning_opt) error('w',"cannot inline%n in thisE",fn);
if (fn->n_addr_taken++==0) fn->dcl_print(0);
return 0;
}
if (fn->n_oper==CTOR) {
Pclass cl = Pclass(fn->n_table->t_name->tp);
if (cl->c_body == 3) cl->print_all_vtbls(cl);
}
Pin il = new iline;
Pexpr ic = new texpr(ICALL,0,0);
int ns = 0;
for (Pname an = f_args; an; an=an->n_list) ns++;
il->fct_name = fn;
il->i_args = new ia[il->i_slots = ns];
ic->il = il;
ic->tp = s_returns ? s_returns : returns;
// Pname at = (f_this) ? f_this : (f_result) ? f_result : argtype;
Pname at = f_args;
f_inline++;
if (at) il->i_table = at->n_table;
int i = 0;
int not_simple = 0; /* is a temporary argument needed? */
for (Pname n=at; n; n=n->n_list, i++) {
/* check formal/actual argument pairs
and generate temporaries as necessary
*/
if (ll == 0) error('i',"F::expand(%n):AX",fn);
Pexpr ee;
if (ll->base == ELIST) {
ee = ll->e1;
ll = ll->e2;
}
else {
ee = ll;
ll = 0;
}
/* could be avoided when expanding into a block */
il->i_args[i].local = 0;
int s ;
// try to protect agains aliasing through pointers and references
for (Pname m=at; m; m=m->n_list) {
Pptr p;
if (n!=m) {
// if ((p=m->tp->is_ptr()) || (p=m->tp->is_ref()))
if (p=m->tp->is_ptr_or_ref())
if (p->check(n->tp,0)==0 || p->typ->check(n->tp,0)==0) goto zxc;
}
}
::watch_out = 0;
int notsimple; notsimple = ee->not_simple();
if ( notsimple==0 && ::watch_out && n->n_used > 1 ) goto zxc;
if (n->n_assigned_to==FUDGE111
&& ee!=zero
&& notsimple==0) {
if (ee && ee->e1 && (ee->e1->base == NAME) &&
(! strcmp (ee->e1->string,"this"))) goto zxc;
}
else if (n->n_addr_taken || n->n_assigned_to)
goto zxc;
else if (s=notsimple) {
if (/*n->n_used==0 // n_used not set for ``this''
|| */1<s
|| 1<n->n_used ) { // not safe
zxc:
if (last_expanded && last_expanded==curr_expr && last_stmt==stmtno) {
if (warning_opt)
error('w',"%n not inlined, called twice in an expression",fn);
f_inline--;
delete il->i_args;
delete il;
if (fn->n_addr_taken++==0) fn->dcl_print(0);
return 0;
}
//error('d',"zxc %n %t ee %d %t",n,n->tp,ee->base,ee->tp);
if (ee && ee->tp && (ee->tp->base==EOBJ) && ansi_opt)
; // do nothing
else {
Pname nn = dcl_local(scope,n,fn);
nn->base = NAME;
il->i_args[i].local = nn;
++not_simple;
// if (nn->tp->is_ref()
// && ee->tp
// && ee->tp->is_ptr_or_ref()==0) ee = ee->address();
}
}
}
il->i_args[i].arg = ee;
il->i_args[i].tp = n->tp;
}
Ptable tbl = body->memtbl;
if (f_expr) { // generate comma expression
char loc_var = 0;
/* look for local variables needing declaration: */
for (n=tbl->get_mem(i=1); n; n=tbl->get_mem(++i) ) {
//error('d',"n %n %d",n,n->base);
//error('d',"loc %n %d %d %d",n,n->n_used,n->n_assigned_to,n->n_addr_taken);
if (n->base==NAME // don't re-declare the args
&& (n->tp->base!=FCT && n->tp->base!=OVERLOAD)
&& (n->n_used || n->n_assigned_to || n->n_addr_taken)) {
if (last_expanded && last_expanded==curr_expr && last_stmt == stmtno) {
if (warning_opt) error('w',"cannot inline%n in thisE",fn);
f_inline--;
delete il->i_args;
delete il;
if (fn->n_addr_taken++==0) fn->dcl_print(0);
return 0;
}
Pname nn = dcl_local(scope,n,fn);
nn->base = NAME;
n->string = nn->string;
loc_var++;
}
}
if (i /*not_simple*/ || loc_var) {
if(!curr_expr) curr_expr = dummy;
last_expanded = curr_expr;
last_stmt = stmtno;
}
Pexpr ex;
if (not_simple) {
Pexpr etail = ex = new expr(CM,0,0);
for (i=0; i<il->i_slots; i++) {
Pname n = il->i_args[i].local;
if (n == 0) continue;
Pexpr e = il->i_args[i].arg;
// if used assign
// otherwise (e.g. unused argument)
// simply evaluate for sideeffects
if (n->n_used
|| n->n_assigned_to
|| n->n_addr_taken) {
Pexpr mptr_assign(Pexpr n, Pexpr in);
Pptr p1 = n->tp->is_ptr();
Pptr p2 = e->tp ? e->tp->is_ptr() : 0;
if (p1 && p1->memof && p1!=p2) {
switch (e->base) {
case CM:
case G_CM:
e->e2 = mptr_assign(n,e->e2);
break;
case ICALL:
break;
default:
e = mptr_assign(n,e);
}
etail->e1 = e;
}
else
etail->e1 = new expr(ASSIGN,n,e);
}
else
etail->e1 = e;
if (--not_simple)
etail = etail->e2 = new expr(CM,0,0);
else
break;
}
etail->e2 = f_expr;
}
else
ex = f_expr;
ic->e1 = ex;
}
else { // generate block:
for (n=tbl->get_mem(i=1); n; n=tbl->get_mem(++i) ) {
// mangle local names
if (n->base==NAME
&& (n->n_used || n->n_assigned_to || n->n_addr_taken)) {
// Pname cn = fn->n_table->t_name;
// n->string = temp(n->string,fn->string,(cn)?cn->string:0);
n->string = temp(n->string,fn);
}
}
Pstmt ss;
if (not_simple) {
if(!curr_expr) curr_expr = dummy;
last_expanded = curr_expr;
last_stmt = stmtno;
Pstmt st = new estmt(SM,curloc,0,0);
st->where.line = 0;
Pstmt stail = st;
for (i=0; i<il->i_slots; i++) {
Pname n = il->i_args[i].local;
if (n == 0) continue;
Pexpr e = il->i_args[i].arg;
Pptr p1 = n->tp->is_ptr();
Pptr p2 = e->tp->is_ptr();
Pexpr mptr_assign(Pexpr n, Pexpr in);
if (p1 && p1->memof && p1!=p2) {
switch (e->base) {
case CM:
case G_CM:
e->e2 = mptr_assign(n,e->e2);
break;
default:
e = mptr_assign(n,e);
}
stail->e = e;
}
else
stail->e = new expr(ASSIGN,n,e);
if (--not_simple) {
stail = stail->s_list = new estmt(SM,curloc,0,0);
stail->where.line = 0;
}
else
break;
}
stail->s_list = body;
ss = new block(curloc,0,st);
ss->where.line = 0;
}
else
ss = body;
ic->e2 = Pexpr(ss);
}
f_inline--;
//error('d',"expand%n -- returning%k", fn, ic?ic->base:0);
//display_expr(ic);
return ic;
}
0707071010112044261004440001630000160000010177000466055400600000700000116316expr.c /*ident "@(#)ctrans:src/expr.c 1.8" */
/***************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
expr.c:
type check expressions
************************************************************************/
#include "cfront.h"
#include "size.h"
int const_save;
int const_ptr;
extern Ptype Pfct_type;
Pexpr expr::address()
{
// error('d',"address %k %d %s",base,base,base==NAME||base==ANAME?string:"?");
// error('d',"address e1 %d %k e2 %d %k", e1, e1?e1->base:0, e2, e2?e2->base:0);
switch (base) {
case DEREF:
if (e2 == 0) return e1; // &*e => e
break;
case QUEST: // &(a?b:c) => a?&b:&c
e1 = e1->address();
// no break;
case G_CM:
if ( e1 && e1->base == G_CALL &&
e2 && e2->base == G_ADDROF)
return this;
case CM:
e2 = e2->address(); // &(e1,e2) => (e1,&e2)
tp = e2->tp; //LLL
return this;
case INCR:
case DECR: // &(++a) => (++a,&a)
if (e1) break;
nin++;
if (e2->not_simple()) error('s',"& of%k",base);
nin--;
e1 = new expr(base,0,e2);
e2 = e2->address();
base = G_CM;
tp = e2->tp;
return this;
case ASSIGN: // &(a=b) => ((a=b),&a)
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASDIV:
case ASMOD:
case ASAND:
case ASOR:
case ASER:
case ASLS:
case ASRS:
nin++;
if (e1->not_simple()) error('s',"& of%k",base);
nin--;
Pexpr a = new expr(base,e1,e2);
a->tp = a->e1->tp;
base = G_CM;
e1 = a;
e2 = a->e1->address();
tp = e2->tp;
return this;
case NAME:
if (Pname(this)->n_stclass == REGISTER) error("& register%n",Pname(this));
Pname(this)->take_addr();
break;
case CALL:
case CAST:
case NEW:
case GNEW:
if (tp && tp->is_ptr_or_ref()) { // hack?
return this;
}
break;
}
register Pexpr ee = new expr(G_ADDROF,0,this);
if (tp) { // tp==0 ???
ee->tp = tp->addrof();
switch (tp->base) {
case PTR:
Pptr(ee->tp)->memof = Pptr(tp)->memof;
break;
case FCT:
if (Pfct(tp)->f_static==0)
Pptr(ee->tp)->memof = Pfct(tp)->memof;
break;
case OVERLOAD:
if (Pfct(Pgen(tp)->fct_list->f->tp)->f_static==0)
Pptr(ee->tp)->memof = Pfct(Pgen(tp)->fct_list->f->tp)->memof;
}
}
return ee;
}
Pexpr expr::contents()
{
//error('d',"deref %k %d %t",base,base,tp);
// if (base==ADDROF || base==G_ADDROF) return e2; // *&
switch (base) {
case ADDROF:
case G_ADDROF:
return e2; // *&
case ELIST:
//error('d',"contents of elist");
e1 = e1->contents();
tp = e1->tp;
return this;
};
register Pexpr ee = new expr(DEREF,this,0);
if (tp) { // tp==0 ???
Ptype tt = tp;
while (tt->base == TYPE) tt = Pbase(tt)->b_name->tp;
ee->tp = Pptr(tt)->typ;
Pname cn = ee->tp->is_cl_obj();
if (cn) {
Pclass cl = Pclass(cn->tp);
if (cl->c_body==1) cl->dcl_print(0); // look for first use of cl
}
}
return ee;
}
static Pexpr
make_postfix( Pexpr op )
{ // apply the postfix form of increment/decrement operator
Pexpr e = op->e1->base==NAME?op->e1:op->e1->mem;
for (Plist fl=Pgen(e->tp)->fct_list;fl; fl=fl->l) {
Pname n = fl->f;
Pfct f = Pfct(n->tp);
if ((f->nargs==1 && f->f_this) ||
(f->nargs==2 && f->f_this==0)) {
if (op->e1->base == NAME) {
op->e1 = n;
op->e2->e2 = new expr(ELIST,zero,0);
} else {
op->e1->mem = n;
op->e2 = new expr(ELIST,zero,0);
}
op->fct_name = n;
n->dcl_print(0);
return op;
}
}
error('w',"no postfix instance of%n, although overloaded",Pname(e));
return op; // as it were
}
int bound;
int chars_in_largest; // no of characters in largest int
static Pclass mpglob;
Pexpr expr::typ(Ptable tbl)
/*
find the type of "this" and place it in tp;
return the typechecked version of the expression:
"tbl" provides the scope for the names in "this"
*/
{
//if (this == 0) error('i',"0->expr::typ");
Pname n;
Ptype t = 0;
Ptype t1, t2;
TOK b = base;
TOK r1, r2;
#define nppromote(b) t=np_promote(b,r1,r2,t1,t2,1)
#define npcheck(b) (void)np_promote(b,r1,r2,t1,t2,0)
if (tbl->base != TABLE) error('i',"expr::typ(%d)",tbl->base);
DB( if(Tdebug>=1) {
error('d',"%d->expr::typ(%d) %k %t",this,tbl,b,tp);
display_expr(this);
});
// error('d',"%k->typ %n tp: %t", b,b==NAME?this:0,tp);
// error('d'," e1 %d %k e1 %d %k",e1,e1?e1->base:0,e2,e2?e2->base:0);
if (tp) {
switch (b) {
case NAME:
//?? Pname(this)->use();
break;
case MDOT:
mem = mem->typ(tbl);
} ;
// if (b == NAME) Pname(this)->use();
return this;
}
extern Pname Ntmp;
switch (b) { // is it a basic type
case MDOT:
error('i',"mdot %s",string2);
case DUMMY:
error("emptyE");
tp = any_type;
return this;
case ZERO:
tp = zero_type;
return this;
case IVAL:
tp = int_type;
return this;
//case FVAL:
// tp = float_type;
// return this;
case ICON:
/* is it long?
explicit long?
decimal larger than largest signed int
octal or hexadecimal larger than largest unsigned int
*/
{ int ll = strlen(string);
switch (string[ll-1]) {
case 'l':
case 'L':
switch (string[ll-2]) {
case 'u':
case 'U':
string[ll-2] = 0;
tp = ulong_type;
goto cast_n_save;
}
lng:
tp = long_type;
goto save;
case 'u':
case 'U': // 1u => unsigned(1)
switch (string[ll-2]) {
case 'l':
case 'L':
string[ll-2] = 0;
ulng:
tp = ulong_type;
goto cast_n_save;
default:
string[ll-1] = 0;
uint:
tp = uint_type;
goto cast_n_save;
}
}
// no suffix - see if we can figure it out
if (string[0] == '0') { // assume 8 bits in byte
register index = 1;
switch (string[1]) {
case 'x':
case 'X':
while(string[++index]=='0') ;
ll -= index;
int HSZ = SZ_INT+SZ_INT;
if(ll < HSZ) goto nrm;
if(ll == HSZ)
if(string[2]>='8') goto uint;
else goto nrm;
if(SZ_INT==SZ_LONG) break;
HSZ = SZ_LONG+SZ_LONG;
if(ll < HSZ) goto lng;
if(ll == HSZ)
if(string[2]>='8') goto ulng;
else goto lng;
break;
default: // OCTAL
register IBITS = BI_IN_BYTE*SZ_INT;
while(string[index]=='0') index++;
register char x = string[index];
int lbt = x=='1' ? 1 :
( x=='2' || x=='3' ? 2 : 3 );
int nbits = (ll-index-1)*3 + lbt;
if(nbits < IBITS) goto nrm;
if(nbits == IBITS) goto uint;
if(nbits < BI_IN_BYTE*SZ_LONG) goto lng;
}
goto ulng;
}
else { // DECIMAL
if (ll<chars_in_largest) {
nrm:
tp = int_type;
goto save;
}
if (ll>chars_in_largest) {
if(SZ_INT==SZ_LONG || ll>2*chars_in_largest)
goto ulng;
goto lng;
}
// ll == chars_in_largest
char* p = string;
char* q = LARGEST_INT;
do if (*p>*q) {
if(SZ_INT==SZ_LONG) goto ulng;
goto lng;
} while (*p++==*q++ && *p);
}
goto nrm;
}
case CCON:
tp = c_strlen(string)<5 ? char_type : int_type; // stored as 'a'
goto save;
case FCON:
{ int ll = strlen(string);
int last = string[ll-1];
tp = double_type;
if (last=='F' || last=='f') {
tp = float_type;
if (!ansi_opt) {
string[ll-1] = 0;
goto cast_n_save;
}
}
else if (last=='L' || last=='l') {
if (ansi_opt == 0) string[ll-1] = 0;
tp = ldouble_type;
}
goto save;
}
case STRING: // type of "as\tdf" is char[6]
// c_strlen counts the terminating '\0'
{ Pvec v = new vec(char_type,0);
v->size = c_strlen(string);
tp = v;
}
save:
if (const_save) { // "as\tdf" needs 7 chars for storage
char* p = new char[strlen(string)+1];
strcpy(p,string);
string = p;
}
return this;
cast_n_save:
if (const_save) { // "as\tdf" needs 7 chars for storage
char* p = new char[strlen(string)+1];
strcpy(p,string);
string = p;
}
return new cast(tp,this);
case THIS:
delete this;
if (cc->c_this) {
cc->c_this->use();
return cc->c_this;
}
error("``this'' used in nonC context");
n = new name("this");
n->tp = any_type;
return tbl->insert(n,0);
case NAME:
{
Pname q = Pname(this)->n_qualifier; // suppress virtual iff x::
Pexpr ee = find_name(Pname(this),cc->cot,tbl,0,cc->nof);
if (q && (ee->base==REF || ee->base==DOT))
ee->n_initializer = Pexpr(q);
//error('d',"ee %k %t %n",ee->base,ee->tp,ee->base==NAME?ee:ee->base==REF?ee->mem:0);
// if (ee->tp->base == RPTR) return ee->contents();
if (ee->tp->is_ref()) return ee->contents();
if (ee->base==NAME && Pname(ee)->n_xref) {
// fudge to handle X(X&) args
ee = new expr(DEREF,ee,0);
ee->tp = ee->e1->tp; // !!
}
return ee;
}
case ADDROF:
case G_ADDROF: // handle lookup for &s::i
mpglob = 0;
if (e2->base == NAME) e2 = find_name(Pname(e2),cc->cot,tbl,ADDROF,cc->nof);
if (e2->base==NAME && Pname(e2)->n_xref) {
// fudge to handle X(X&) args
e2 = new expr(DEREF,e2,0);
e2->tp = e2->e1->tp; // !!
}
if (e2->base==DOT) { // &f().x = > &(tmp=f(),&tmp)->x
switch (e2->e1->base) {
case CALL:
case G_CALL:
case VALUE:
error("& non-lvalue");
}
}
break;
case SIZEOF:
if (tp2) {
tp2->dcl(tbl);
switch (tp2->base) {
case VOID:
error("sizeof(void)");
break;
case CLASS:
{
Pclass cl = Pclass(tp2);
if (cl->c_body==1
&& (cl->defined&(DEFINED|SIMPLIFIED)) == 0)
error('s',"class defined within sizeof");
}
}
if (e1 && e1!=dummy) {
e1 = e1->typ(tbl);
DEL(e1);
e1 = dummy;
}
Pptr r = tp2->is_ref();
if (r) tp2 = r->typ; // sizeof(T&)==sizeof(T)
}
else if (e1 == dummy) {
error("sizeof emptyE");
tp = any_type;
return this;
}
else {
e1 = e1->typ(tbl);
tp2 = e1->tp;
if(tp2->base == VEC) tp2->permanent = 1;
if (e1->base==ILIST) // PtoM
e1 = dummy;
else if (tp2 == char_type) // sizeof ('a')
e1 = dummy;
}
(void) tp2->tsizeof();
tp = size_t_type;
return this;
case CAST:
// return docast(tbl);
{ Pexpr ee = docast(tbl);
return ee->tp->is_ref() ? ee->contents() : ee;
}
case VALUE:
if ( tp2->base == COBJ || tp2->base == EOBJ) {
char *s = Pbase(tp2)->b_name->string;
//Pname tn = gtbl->look( s, 0 );
//??? non type name apparently takes precedence
// Don't use global ftn if it hides local
// class ctor. (Note: More info is needed
// to detect all cases.)
Pname tn = tbl->look( s, 0 );
//error( 'd', "tn: %n %t lex_levels: %d %d", tn, tn?tn->tp:0, tn?tn->lex_level:0, Pbase(tp2)->b_name->lex_level );
if ( tn && tn->n_qualifier == 0
&& tn->lex_level == Pbase(tp2)->b_name->lex_level
&& (tn->tp->base==FCT || tn->tp->base==OVERLOAD))
{
Pexpr et = new expr( CALL, tn, e1 );
*this = *et;
b = CALL;
break;
}
}
return dovalue(tbl);
case NEW:
case GNEW:
return donew(tbl);
case DELETE: // delete e1 OR delete[e2] e1
case GDELETE:
{ int i;
if (e1->base == ADDROF) error('w',"delete &E");
e1 = e1->typ(tbl);
i = e1->tp->num_ptr(DELETE);
if (i != 'P') error("nonP deleted");
if (e2) {
e2 = e2->typ(tbl);
e2->tp->integral(DELETE);
}
tp = void_type;
return this;
}
case ILIST: /* an ILIST is pointer to an ELIST */
e1 = e1->typ(tbl);
tp = any_type;
return this;
case ELIST:
{ Pexpr e;
Pexpr ex;
if (e1 == dummy && e2==0) {
error("emptyIrL");
tp = any_type;
return this;
}
for (e=this; e; e=ex) {
Pexpr ee = e->e1;
//error('d',"e %d %d ee %d %d",e,e?e->base:0,ee,ee?ee->base:0);
if (e->base != ELIST) error('i',"elist%k",e->base);
if (ex = e->e2) { /* look ahead for end of list */
if (ee == dummy) error("EX in EL");
if (ex->e1 == dummy && ex->e2 == 0) {
/* { ... , } */
DEL(ex);
e->e2 = ex = 0;
}
}
e->e1 = ee->typ(tbl);
t = e->e1->tp;
if (t->base == FCT) { // yuk!
ee = new expr(G_ADDROF,0,e->e1);
e->e1 = ee->typ(tbl);
t = e->e1->tp;
}
}
tp = t;
return this;
}
case DOT:
case REF:
{ if (e2) { // *. or ->*
if (b == REF) b = base = REFMUL;
break;
}
Pbase b;
e1 = e1->typ(tbl);
t = e1->tp;
// check that . (->) is applied to class object (pointer)
if (base == REF) {
xxx:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto xxx;
case COBJ:
{ Pname n = Pclass(Pbase(t)->b_name->tp)->has_oper(REF);
if (n) {
n->n_used += 2;
e1 = new call(new ref(DOT,e1,n),0);
return typ(tbl);
}
// no break;
}
default:
error("nonP ->%n",mem);
t = any_type;
// no break;
case ANY:
goto qqq;
case PTR:
case VEC:
b = Pbase(Pptr(t)->typ);
}
}
else { // base == DOT
qqq:
switch (t->base) {
case TYPE: t = Pbase(t)->b_name->tp; goto qqq;
default: error("nonO .%n",mem); t = any_type;
case ANY:
case COBJ: break;
}
//error('d',"dot %k",e1->base);
switch (e1->base) {
case QUEST:
case ASSIGN:
case INCR:
case DECR:
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASDIV:
case ASMOD:
case ASAND:
case ASOR:
case ASER:
case ASLS:
case ASRS:
case CM:
case G_CM:
base = REF;
e1 = e1->address();
break;
case CALL:
case G_CALL:
//error('d'," f(). %n mem->tp %t",e1->fct_name,mem->tp);
#ifdef FDOTRIGHT
// this rewrite is only necessary on machines with broken C compilers
// there seems to be a lot of those
// and for inlines (a,b).c
if (e1->fct_name && Pfct(e1->fct_name->tp)->f_inline)
#endif
{ // f(). => (tmp=f(),&tmp)->
Pname tmp = make_tmp('Q',e1->tp,tbl);
//error('d',"fdot2 %k",e1->base);
e1 = init_tmp(tmp,e1,tbl);
Pexpr aa = tmp->address();
e1 = new expr(G_CM,e1,aa);
e1->tp = aa->tp;
base = REF;
break;
}
}
b = Pbase(t);
}
xxxx:
switch (b->base) {
case TYPE:
b = Pbase(b->b_name->tp);
goto xxxx;
default:
error("(%t) before %k%n (%n not aM)",e1->tp,base,mem,mem);
case ANY:
tp = any_type;
return this;
case COBJ:
{ Pclass cl = Pclass(Pbase(b)->b_name->tp);
if (cl->c_body == 1) cl->dcl_print(0);
break;
}
}
/*
x.m is not a const even if x is a const object, this case is handled
by lval() rejecting it
*/
if (mem->tp) {
tp = mem->tp;
for (Pexpr ee = mem; ee->base==REF; ee = ee->e1) {
if (ee->e1 == cc->c_this) { // this-> => p->
ee->e1 = e1;
ee->base = base;
return mem->tp->is_ref() ? mem->contents() : mem;
}
}
// return tp->base==RPTR ? contents() : this;
return tp->is_ref() ? contents() : this;
}
Pname q = Pname(mem)->n_qualifier;
Pexpr e = find_name(Pname(mem),Pclass(b->b_name->tp),0,base,cc->nof);
if (q && (e->base==REF || e->base==DOT))
Pname(e)->n_initializer = Pexpr(q);
//error('d',"e %k %t %n",e->base,e->tp,e->base==NAME?e:e->base==REF?e->mem:0);
for (Pexpr ee = e; ee->base==REF; ee = ee->e1) {
if (ee->e1 == cc->c_this) { // this-> => p->
ee->e1 = e1;
ee->base = base;
break;
}
}
if (e->base == NAME) {
switch (e->tp->base) {
case FCT:
case OVERLOAD:
mem = e;
tp = e->tp;
e = this;
}
}
// function or static member
return e->tp->is_ref() ? e->contents() : e;
}
//?? case G_CALL:
case CALL: /* handle undefined function names */
//error('d',"call %k %t %k",e1->base,e1->tp,e2?e2->base:0);
if (e1->base==NAME && e1->tp==0) {
Pname q = Pname(e1)->n_qualifier;
e1 = find_name(Pname(e1),cc->cot,tbl,CALL,cc->nof);
//error('d',"e1 %k %t %n",e1->base,e1->tp,e1->base==NAME?e1:e1->base==REF?e1->mem:0);
if (q && (e1->base==REF ||e1->base==DOT)) // suppress virtual call
e1->n_initializer = Pexpr(q);
}
if (e1->base==NAME && Pname(e1)->n_xref) {
// fudge to handle X(X&) args
e1 = new expr(DEREF,e1,0);
e1->tp = e1->e1->tp; // !!
}
switch (e1->base) {
case DOT:
/*
#ifdef FDOTRIGHT
{
//error('d',"fdot1 %k",e1->e1->base);
switch (e1->e1->base) {
case CALL:
case G_CALL: // f().g() => (tmp=f(),tmp.g())
{ Pexpr ee = e1->e1;
Pexpr ex = ee->typ(tbl);
Pname tmp = make_tmp('Q',ex->tp,tbl);
ex = init_tmp(tmp,ex,tbl);
Pexpr ee2 = new expr(base,e1,e2);
e1->base = DOT;
e1->e1 = tmp;
base = G_CM;
e1 = ex;
e2 = ee2;
return typ(tbl);
}
}
break;
}
#endif
*/
case REF: // becomes ob.x::~x(0) or
if (e2==0 // becomes p->x::~x(0)
&& Pref(e1)->mem
&& Pref(e1)->mem->base==NAME
&& Pname(Pref(e1)->mem)->n_oper==DTOR) {
e1 = e1->typ(tbl);
Pexpr ee = call_dtor(e1->e1,Pref(e1)->mem,0,e1->base,one);
ee->tp = void_type;
return ee;
}
}
break;
case QUEST:
cond = cond->typ(tbl);
case ANDAND:
case OROR:
Ntmp = 0;
}
if (e1) {
e1 = e1->typ(tbl);
if (e1->tp->is_ref()) e1 = e1->contents();
t1 = e1->tp;
// if (t1->is_cl_obj()) t1->tsizeof();
}
else
t1 = 0;
if (e2) {
e2 = e2->typ(tbl);
if (e2->tp->is_ref()) e2 = e2->contents();
t2 = e2->tp;
// if (t2->is_cl_obj()) t2->tsizeof();
}
else
t2 = 0;
// error('d',"b %k t1 %t t2 %t",b,t1,t2);
switch (b) { // filter out non-overloadable operators
default:
{
Pexpr x = try_to_overload(tbl);
if (x) {
if (b==INCR || b==DECR) {
Pexpr fe = x->e1->base==NAME?x->e1:x->e1->mem;
// by default, prefix version of operator is chosen
// t2 set ==> ++n, t1 set ==> n++
if (fe->tp->base==OVERLOAD && t2==0 && t1)
x=make_postfix(x);
}
return x;
}
// if (x) return x;
// error('d',"e2: %t t2: %t", e2->tp, t2);
if (t2 && t1==0 && t2!=e2->tp) t2 = e2->tp;
}
case DOT:
case G_CM:
case G_ADDROF:
case G_CALL:
case QUEST:
break;
}
switch (b) {
case QUEST:
case ANDAND:
case OROR:
if (Ntmp) error('s',"temporary ofC%n with destructor needed in%kE",Ntmp,b);
}
t = (t1==0) ? t2 : (t2==0) ? t1 : 0;
// error('d', "expr::typ t %t", t );
// error('d',"b2 %d %k",b,b);
switch (b) { /* are the operands of legal types */
case REFMUL:
base = REF;
// no break;
case DOT:
{ // a .* p => &a MEMPTR p => appropriate indirection
// to be considered: what happens if a .* expression
// is used except in a call/=?
Pexpr a = e1->typ(tbl);
Ptype at = a->tp;
if (base == DOT) {
a = a->address();
at = at->addrof(); // beware of n_xref
}
while (at->base == TYPE) at = Pbase(at)->b_name->tp;
Pname cn = Pptr(at)->typ->is_cl_obj();
Pclass mm = cn ? Pclass(cn->tp) : 0;
Pexpr p = e2->typ(tbl);
Ptype pt = p->tp;
Pname pcn = pt->is_cl_obj();
//error('d',"mm %t pt %t",mm,pt);
if (pcn) {
Pclass cl = Pclass(pcn->tp);
Pname found = 0;
for (Pname on=cl->conv; on; on=on->n_list) {
Pfct f = Pfct(on->tp);
Pptr frt = Pptr(f->returns);
while (frt->base == TYPE) frt = Pptr(Pbase(frt)->b_name->tp);
if (frt->base!=PTR || Pptr(frt)->memof==0) break;
if (Pptr(frt)->memof==mm || mm->has_base(Pptr(frt)->memof)) {
if (found)
error("two possible conversions forP toM: %n and %n",found,on);
else
found = on;
}
}
//error('d',"found %n",found);
if (found) {
p = new ref(DOT,p,found);
p = new call(p,0);
p = p->typ(tbl);
pt = p->tp;
}
}
while (pt->base == TYPE) pt = Pbase(pt)->b_name->tp;
if (pt->base!=PTR || Pptr(pt)->memof==0) {
error("P toMX in .*E: %t",pt);
tp = any_type;
base = DUMMY;
return this;
}
Pclass pm = Pptr(pt)->memof;
// while (at->base == TYPE) at = Pbase(at)->b_name->tp;
// Pname cn = Pptr(at)->typ->is_cl_obj();
// Pclass mm = cn ? Pclass(cn->tp) : 0;
//error('d',"mm %t %t %d %d",mm,pm,pm->baseof(mm),mm->has_base(pm));
// if (mm!=pm && pm->baseof(mm)==0 && mm->has_base(pm)==0) {
if (mm != pm) {
if (mm->has_base(pm) == 0) {
error("badOT in .*E: %t (%s*X)",a->tp,pm->string);
tp = any_type;
//return this;
}
a = new texpr(CAST,pm->this_type,a);
e1 = a = a->typ(tbl);
}
Ptype tpx = Pptr(pt)->typ;
while (tpx->base == TYPE) tpx = Pbase(tpx)->b_name->tp;
if (tpx->base == FCT) { // a.*p => (&a MEMPTR p)
base = MEMPTR;
tp2 = mm; // keep the class for simpl.c
e1 = a;
e2 = p;
}
else { // a .* p => *(typeof(p))((char*)&a + (int)p-1)
a = new cast(Pchar_type,a);
p = new cast(int_type,p);
p = new expr(MINUS,p,one);
p->tp = int_type;
Pexpr pl = new expr(PLUS,a,p);
pl->tp = Pchar_type;
base = DEREF;
pt = new ptr(PTR,tpx); // need a T* not a T C::*
Pptr(pt)->rdo = Pptr(tpx)->rdo;
mpglob = pm;
// PERM(pt);
e1 = new cast(pt,pl);
e2 = 0;
}
tp = tpx;
return tp->is_ref() ? contents() : this;
}
case G_CALL:
case CALL:
tp = call_fct(tbl); /* two calls of use() for e1's names */
if (tp->is_ref()) return contents();
return this;
case DEREF:
if (e1 == dummy) error("O missing before []\n");
if (e2 == dummy) error("subscriptE missing");
if (t) { /* *t */
while (t->base == TYPE) t = Pbase(t)->b_name->tp;
// t->vec_type();
if (t->base==PTR && Pptr(t)->memof) error("P toM dereferenced");
tp = t->deref();
}
else { // e1[e2] that is *(e1+e2)
//error('d',"deref %t[%t]",t1,t2);
if (t1->vec_type()) { // e1[e2]
switch (t2->base) {
case CHAR:
case SHORT:
case INT:
case LONG:
case EOBJ:
break;
default:
{ Pname cn = t2->is_cl_obj();
if (cn) // conversion to integral?
e2 = check_cond(e2,DEREF,tbl);
else
t2->integral(DEREF);
}
}
while (t1->base == TYPE) t1 = Pbase(t1)->b_name->tp;
if (t1->base==PTR && Pptr(t1)->memof) error("P toM dereferenced");
tp = t1->deref();
(void) tp->tsizeof();
}
else if (t2->vec_type()) { // really e2[e1]
t1->integral(DEREF);
while (t2->base == TYPE) t2 = Pbase(t2)->b_name->tp;
if (t2->base==PTR && Pptr(t2)->memof) error("P toM dereferenced");
tp = t2->deref();
(void) tp->tsizeof();
}
else {
error("[] applied to nonPT:%t[%t]",t1,t2);
tp = any_type;
}
}
if (tp->is_ref()) return contents();
return this;
case G_ADDROF:
case ADDROF:
//error('d',"addrof(%d) %k %d",base,e2->base,e2->base);
switch (e2->base) { // potential lvalues
case G_CM:
if (base==ADDROF && e2->e2->base==NAME) {
// check for cfront generated result variable
char* s = e2->e2->string;
if (s[0]=='_' && s[1] && s[1]=='_') {
if (s[2] && (s[2]=='R' || s[2]=='V')) {
error("address of non-lvalue");
break;
}
}
}
case CM: // &(a,b) => (a,&b)
{
Pexpr ee = e2;
ee->tp = 0;
ee->e2 = new expr(base,0,ee->e2);
delete this;
return ee->typ(tbl);
}
case QUEST: // & (a?b:c) => (a?&b:&c)
{
Pexpr ee = e2;
ee->tp = 0;
ee->e1 = new expr(base,0,ee->e1);
ee->e2 = new expr(base,0,ee->e2);
delete this;
return ee->typ(tbl);
}
case INCR:
case DECR:
if (e2->e1) break;
case ASSIGN:
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASDIV:
case ASMOD:
case ASAND:
case ASOR:
case ASER:
case ASLS:
case ASRS:
return e2->address();
}
if (e2->lval(ADDROF) == 0) {
if (error_count) { // error_count == 0 possible
// in case of & const
tp = any_type;
return this;
}
}
tp = t->addrof();
if( base==ADDROF && mpglob)
Pptr(tp)->memof = mpglob;
if (e2->tp->base == VEC) {
if(e2->base != NAME) {
base = CAST;
tp2 = tp;
e1 = e2;
e2 = 0;
return this;
}
}
// tp = t->addrof();
if (t->base==FCT)
Pptr(tp)->memof = Pfct(t)->memof;
// if (t->tconst() && vec_const==0 && fct_const==0) Pptr(tp)->rdo = 1;
// ??? & (const T) is NOT T*const but const T*
switch (e2->base) {
case NAME:
mname: // check for &s::i
{ Pname n2 = Pname(e2);
Pname cn = (n2->n_table && n2->n_table!=gtbl) ? n2->n_table->t_name : 0;
// error('d',"n2 %k cn %n t %t",n2->base,cn,t);
if (cn == 0) break;
// Pptr(tp)->memof = Pclass(cn->tp);
if (t->base==FCT && Pfct(t)->f_this==0) {
Pptr(tp)->memof = 0;
break;
}
switch (t->base) {
case OVERLOAD:
return e2;
case FCT:
// error('d', "cn->tp: %d, %k", cn->tp, cn->tp->base);
Pptr(tp)->memof = Pclass(cn->tp); //SSS
if (Pfct(t)->f_virtual) {
// { 0,vtbl index,0 }
e1 = new ival(Pfct(t)->f_virtual);
e1 = new expr(ELIST,zero,e1);
e2 = zero;
base = ILIST;
// tp = int_type;
return this;
} // use the pointer
// { 0,-1,(int(*)())ptr }
e1 = new ival(-1);
e1 = new expr(ELIST,zero,e1);
// e2 is the name
e2 = new cast(Pfct_type,e2);
base = ILIST;
// tp = int_type;
return this;
// return e2;
default:
if (n2->n_stclass != STATIC) { // offset + 1
//error('d',"n2 %n %d",n2,n2->n_offset);
//error('d',"q %n cn %n",n2->n_qualifier,cn);
e1 = new ival(n2->n_offset+1);
Pptr(tp)->memof = Pclass(cn->tp);
//error('d',"cl %d %s i %d",Pclass(cn->tp),Pclass(cn->tp)?Pclass(cn->tp)->string:"0",n2->n_offset);
}
else
return this;
}
//error('d',"int_type");
e1->tp = int_type;
e2 = 0;
tp2 = tp;
base = CAST;
return this;
}
case DOT:
case REF:
{
Pname m = Pname(e2->mem);
// error( 'd', "e2->mem->base: %k", e2->mem->base );
// Pname m = (e2->mem->base == MDOT) ? Pname(e2->mem->mem) : Pname(e2->mem);
while ( m->base == MDOT ) m = Pname(Pexpr(m)->mem);
Pfct f = Pfct(m->tp);
if (f->base == FCT || f->base == OVERLOAD) { // &p->f
Pexpr q = Pname(e2)->n_initializer; // &p->x::f
if (q && bound==0 && e2->e1==cc->c_this) {
// FUDGE: &this->x::f => &x::f
DEL(e2);
e2 = m;
goto mname;
}
bound = 1;
if(!f->f_static) {
error(strict_opt?0:'w',
"address of boundF (try using ``%s::*'' forPT and ``&%s::%s'' for address) (anachronism)",
m->n_table->t_name->string,
m->n_table->t_name->string,
m->string
);
}
if (q || f->f_virtual==0) {
// & x.f => & f
DEL(e2);
e2 = m;
}
}
break;
}
case MEMPTR:
// &(p->*q)
error("& .* E");
}
return this;
case UMINUS:
t->numeric(UMINUS);
tp = t;
return this;
case UPLUS:
t->num_ptr(UPLUS);
tp = t;
if (ansi_opt==0) {
base = PLUS;
e1 = zero;
}
return this;
case NOT:
e2 = check_cond(e2,NOT,tbl);
tp = int_type;
return this;
case COMPL:
t->integral(COMPL);
tp = t;
return this;
case INCR:
case DECR:
{
// error('d',"incr-decr: e1: %k e2: %k", e1?e1->base:0, e2?e2->base:0);
Pexpr e = e1?e1:e2; // e1!=0 ==> e++ or e--
// e1==0 ==> ++e or --e
e->lval(b);
switch(e->base) {
case QUEST:
e->tp=0;
e->e1 = e1 ? new expr(base,e->e1,0) : new expr(base,0,e->e1);
e->e2 = e1 ? new expr(base,e->e2,0) : new expr(base,0,e->e2);
delete this;
return e->typ(tbl);
case CM:
case G_CM:
e->tp=0;
e->e2 = e1 ? new expr(base,e->e2,0) : new expr(base,0,e->e2);
delete this;
return e->typ(tbl);
case INCR:
case DECR:
if(e->e1)
break;
nin++;
if(e->e2->not_simple())
error('s',"overly complex %k of %k",b,e->base);
nin--;
e = new expr(G_CM,e,e->e2->typ(tbl));
if (e1) e1=e; else e2=e;
// e1?e1:e2 = e;
return typ(tbl);
case ASSIGN:
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASDIV:
case ASMOD:
case ASAND:
case ASOR:
case ASER:
case ASLS:
case ASRS:
nin++;
if(e->e1->not_simple())
error('s',"overly complex %k of %k",b,e->base);
nin--;
e = new expr(G_CM,e,e->e1->typ(tbl));
if (e1) e1=e; else e2=e;
// e1?e1:e2 = e;
return typ(tbl);
}
}
r1 = t->num_ptr(b);
if (r1='P' && t->check(Pvoid_type,0)==0) error("%k of void*",b);
tp = t;
return this;
}
if (e1==dummy || e2==dummy || e1==0 || e2==0) error("operand missing for%k",b);
switch (b) {
case MUL:
case DIV:
r1 = t1->numeric(b);
r2 = t2->numeric(b);
nppromote(b);
break;
case PLUS:
r2 = t2->num_ptr(PLUS);
r1 = t1->num_ptr(PLUS);
nppromote(PLUS);
goto void_check;
case MINUS:
r2 = t2->num_ptr(MINUS);
r1 = t1->num_ptr(MINUS);
if (r2=='P' && r1!='P' && r1!='A') error("nonP - P");
nppromote(MINUS);
void_check:
if ((r1='P' && t1->check(Pvoid_type,0)==0)
|| (r2='P' && t2->check(Pvoid_type,0)==0))
error("%k of void*",b);
tp = t;
break;
case LS:
case RS:
case AND:
case OR:
case ER:
switch (e1->base) {
case LT:
case LE:
case GT:
case GE:
case EQ:
case NE:
error('w',"%kE as operand for%k",e1->base,b);
}
switch (e2->base) {
case LT:
case LE:
case GT:
case GE:
case EQ:
case NE:
error('w',"%kE as operand for%k",e2->base,b);
}
case MOD:
r1 = t1->integral(b);
r2 = t2->integral(b);
nppromote(b);
break;
case LT:
case LE:
case GT:
case GE:
case EQ:
case NE:
r1 = t1->num_ptr(b);
r2 = t2->num_ptr(b);
if (r1=='P' && r2=='I') { // allow things like:
// if (p==2-2)
// YUCK!
Neval = 0;
long i = e2->eval();
if (Neval==0 && i==0) {
DEL(e2);
e2 = zero;
r2 = 'Z';
}
}
else if (r2=='P' && r1=='I') {
Neval = 0;
long i = e1->eval();
if (Neval==0 && i==0) {
DEL(e1);
e1 = zero;
r1 = 'Z';
}
}
if (b!=EQ && b!=NE) {
if (r1=='P' && r2=='Z') error("P%k 0",b);
if (r2=='P' && r1=='Z') error("P%k 0",b);
}
// make sure functions are properly converted to pointers to
// functions and make sure overloaded functions are rejected
Pexpr ptof(Pfct ef, Pexpr e, Ptable tbl);
if (r1 == FCT) e1 = ptof(0,e1,tbl);
if (r2 == FCT) e2 = ptof(0,e2,tbl);
npcheck(b);
if (r1=='P') { // need cast for pointers to virtual and second bases
Pptr p1 = t1->is_ptr();
Pptr p2 = t2->is_ptr();
Pname cn = p1?p1->typ->is_cl_obj():0;
Pname cn2 = p2?p2->typ->is_cl_obj():0;
if (cn && cn2) {
Pclass cl = Pclass(cn->tp);
Pclass cl2 = Pclass(cn2->tp);
if (cl->has_base(cl2)) {
e1 = cast_cptr(cl2,e1,tbl,0);
e1 = new cast(p2,e1);
}
else if (cl2->has_base(cl)) {
e2 = cast_cptr(cl,e2,tbl,0);
e2 = new cast(p1,e2);
}
}
}
if (r1=='P' && t1->memptr()) {
mpmp:
if (r2=='Z') {
e2 = zero;
e1 = new mdot("i",e1);
e1->i1 = 9;
}
else if (r2=='P' && t2->memptr()) {
// ERROR: no check for sideeffects
Pexpr i1 = new mdot("i",e1);
Pexpr i2;
i1->i1 = 9;
i2 = e2;
while ( i2->base == CAST )
i2 = i2->e1;
if ( i2->base == ILIST )
e2 = i2;
if (e2->base==ILIST)
i2 = e2->e1->e2;
else {
i2 = new mdot("i",e2);
i2->i1 = 9;
}
Pexpr f1 = new mdot("f",e1);
Pexpr f2;
f1->i1 = 9;
if (e2->base == ILIST)
// f2 = new cast(Pfct_type,e2->e2);
f2 = e2->e2;
else {
f2 = new mdot("f",e2);
f2->i1 = 9;
}
Pexpr ei = new expr(base,i1,i2);
Pexpr fi = new expr(base,f1,f2);
base = ANDAND;
e1 = ei;
e2 = fi;
} else if (r2=='P') {
error('s',"%t %k %t",t1,base,t2);
}
}
else if (r2=='P' && t2->memptr()) {
Pexpr ee = e1; // swap
e1 = e2;
e2 = ee;
int rr = r1;
r1 = r2;
r2 = rr;
Ptype tt = t1;
t1 = t2;
t2 = tt;
goto mpmp;
}
t = int_type;
break;
case ANDAND:
case OROR:
e1 = check_cond(e1,b,tbl);
e2 = check_cond(e2,b,tbl);
t = int_type;
break;
case QUEST:
{
Pname c1, c2;
cond = check_cond(cond,b,tbl);
//error('d',"cond %k %t",cond->base,cond->tp);
//error('d',"t1 %t t2 %t",t1,t2);
// still doesn't do complete checking for possible conversions...
bit MPTR = 0; // local hack
extern int suppress_error; // global hack
suppress_error++;
r1 = t1->num_ptr(b);
r2 = t2->num_ptr(b);
suppress_error--;
if (r1=='P' && r2=='P' && t1->memptr() && t2->memptr()) {
++MPTR; // prevent later sorry
// watch for casts
Pexpr tt = e1;
while ( tt->base == CAST ) tt = tt->e1;
if ( tt->base == ILIST ) e1 = tt;
tt = e2;
while ( tt->base == CAST ) tt = tt->e1;
if ( tt->base == ILIST ) e2 = tt;
// cannot have sides return (expr?{}:{})
// reuse same temp for both sides ?:
Pname temp = make_tmp( 'A', mptr_type, tbl );
e1 = mptr_assign( temp, e1 );
e1 = new expr( G_CM, e1, temp );
e1->tp = temp->tp;
e2 = mptr_assign( temp, e2 );
e2 = new expr( G_CM, e2, temp );
e2->tp = temp->tp;
}
if (t1==t2
|| ( (c1=t1->is_cl_obj())
&& (c2=t2->is_cl_obj())
&& (c1->tp==c2->tp)
))
t = t1;
else {
r1 = t1->num_ptr(b);
r2 = t2->num_ptr(b);
if (r1=='P' && r2=='P') {
Pptr p1 = t1->is_ptr();
Pptr p2 = t2->is_ptr();
//error('d',"p1 %t p2 %t",p1,p2);
if ((c1 = p1->typ->is_cl_obj())
&& (c2 = p2->typ->is_cl_obj())) {
Pclass cl1 = Pclass(c1->tp);
Pclass cl2 = Pclass(c2->tp);
if (cl1==cl2 || cl2->has_base(cl1)) {
t = t1;
goto caca;
}
else if (cl1->has_base(cl2)) {
t = t2;
goto caca;
}
}
}
if (r1==FCT && r2==FCT) { // fudge
if (t1->check(t2,ASSIGN))
error("badTs in ?:E: %t and %t",t1,t2);
else if (Pfct(t1)->memof) error('s',"conditionalE with%t",t1);
t = t1;
}
else
nppromote(b);
caca:
//error('d',"?: t %t t1 %t t2 %t",t,t1,t2);
if (t!=t1 && t->check(t1,0)) {
PERM(t);
e1 = new cast(t,e1);
}
if (t!=t2 && t->check(t2,0)) {
PERM(t);
e2 = new cast(t,e2);
}
Pptr pt = t->is_ptr();
//if (pt && pt->base==PTR && pt->memof) error('s',"conditionalE with%t",t);
if (pt && pt->base==PTR && pt->memof && MPTR == 0) error('s',"conditionalE with%t",t);
}
}
break;
case ASPLUS:
r1 = t1->num_ptr(ASPLUS);
r2 = t2->num_ptr(ASPLUS);
nppromote(ASPLUS);
goto ass;
case ASMINUS:
r1 = t1->num_ptr(ASMINUS);
r2 = t2->num_ptr(ASMINUS);
if (r2=='P' && r1!='P' && r1!='A') error("P -= nonP");
nppromote(ASMINUS);
goto ass;
case ASMUL:
case ASDIV:
r1 = t1->numeric(b);
r2 = t1->numeric(b);
nppromote(b);
goto ass;
case ASMOD:
r1 = t1->integral(ASMOD);
r2 = t2->integral(ASMOD);
nppromote(ASMOD);
goto ass;
case ASAND:
case ASOR:
case ASER:
case ASLS:
case ASRS:
r1 = t1->integral(b);
r2 = t2->integral(b);
npcheck(b);
t = int_type;
goto ass;
ass:
if (r1='P' && t1->check(Pvoid_type,0)==0) error("%k of void*",b);
tp = t;
as_type = t; /* the type of the rhs */
t2 = t;
case ASSIGN:
//error('d',"assign %k: %t %t %s",b,t1,t2,ignore_const?"ignore const":"");
//error('d'," e1 %d %k e1 %d %k",e1,e1->base,e2,e2->base);
if (ignore_const) { // handle static initializers
// represented as assignments
// ignore consts.
tp = e1->tp;
return this;
}
switch (e1->base) {
case G_CM:
case CM: // (a,b)=c => *(a,&b)=c
{
e1->e2 = new expr(G_ADDROF,0,e1->e2);
e1->tp = 0;
e1 = new expr(DEREF,e1,0);
return typ(tbl);
}
case QUEST: // (a?b:c)=d => *(a?&b:&c)=c
{
e1->e1 = new expr(G_ADDROF,0,e1->e1);
e1->e2 = new expr(G_ADDROF,0,e1->e2);
e1->tp = 0;
e1 = new expr(DEREF,e1,0);
return typ(tbl);
}
case ASSIGN: // (a*=b)=c => a*=b,a=c
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASDIV:
case ASMOD:
case ASAND:
case ASOR:
case ASER:
case ASLS:
case ASRS:
{
base = G_CM;
nin++;
if (e1->e1->not_simple()) error('s',"lvalue %k too complicated",b);
nin--;
Pexpr aa = new expr(e1->base,e1->e1,e1->e2);
Pexpr bb = new expr(b,e1->e1,e2);
e1 = aa;
e2 = bb;
return typ(tbl);
}
case INCR:
case DECR: // ++a=b => ++a,a=b
{
if(!e1->e2) break ;
base = G_CM;
nin++;
if (e1->e2->not_simple()) error('s',"lvalue %k too complicated",b);
nin--;
Pexpr aa = new expr(e1->base,0,e1->e2);
Pexpr bb = new expr(b,e1->e2,e2);
e1 = aa;
e2 = bb;
return typ(tbl);
}
case REF:
{
Pexpr r = e1;
// hack to prevent
// f().i = j
// transformed into
// ((t=f()),&t)->i = j
if (r->e1->base==G_CM
&& r->e1->e2->base==G_ADDROF
&& r->e1->e2->e2->base==NAME) {
char* s = r->e1->e2->e2->string;
if (s[0]=='_' && s[1]=='_')
error("left hand side not lvalue");
}
}
}
if (e1->lval(b) == 0) {
tp = any_type;
return this;
}
lkj:
switch (t1->base) {
case TYPE:
t1 = Pbase(t1)->b_name->tp;
goto lkj;
case INT:
case CHAR:
case SHORT:
// if (e2->base==ICON && e2->tp==long_type)
// error('w',"long constant assigned to%k",t1->base);
{ Ptype t = e2->tp;
csi:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp; goto csi;
case LONG:
case FLOAT:
case DOUBLE:
case LDOUBLE:
error('w',"%t assigned to %t",e2->tp,t1);
}
}
// no break
case LONG:
if (b==ASSIGN
&& Pbase(t1)->b_unsigned
&& e2->base==UMINUS
&& e2->e2->base==ICON)
error('w',"negative assigned to unsigned");
break;
case PTR:
if (b == ASSIGN) {
//error('d',"ptr t1 %t %d %t",t1,t1->memptr(),t2);
//?? if (t1->memptr() && t2->base!=OVERLOAD) break;
e2 = ptr_init(Pptr(t1),e2,tbl);
t2 = e2->tp;
//error('d',"pchecked %d",Pchecked);
if (Pchecked) {
tp = e1->tp;
return this;
}
}
break;
case COBJ:
{ Pname c1 = t1->is_cl_obj();
// test of c1->tp necessary for ``fake classes''
// _Sdd generated for vector assignemnts
if (c1
&& c1->tp
/* && Pclass(c1->tp)->memtbl->look("__as",0)==0*/) {
//&& Pclass(c1->tp)->has_oper(ASSIGN)==0) {
Pname c2 = t2->is_cl_obj();
// error('d', "expr::typ: c1: %n c2: %n", c1, c2 );
if (c1 != c2) {
/*
consider:
struct A { A(B&); };
struct B : A {};
A aa;
B bb;
aa = bb; // aa.operator=(A(bb));
// optimize to aa.A(bb) when possible
// avoid temporary where aa = *(A*)&bb is legal
*/
// error('d',"expr::typ c1 %n %d c2 %n %d",c1,c1?c1->tp:0,c2,c2?c2->tp:0);
if (c2
&& c2->tp
&& can_coerce(t1,t2)==0
//&& Pclass(c2->tp)->has_base(Pclass(c1->tp))
//&& (1<is_unique_base(Pclass(c2->tp),c1->string,0))
&& (vcllist->clear(),vcllist=0,1<is_unique_base(Pclass(c2->tp),c1->string,0))
&& Pclass(c1->tp)->c_xref&(C_VBASE|C_VPTR|C_ASS)) {
// error('d',"aaa");
if (make_assignment(c1)) return try_to_overload(tbl);
}
// optimize
else {
e2 = new expr(ELIST,e2,0);
e2 = new texpr(VALUE,t1,e2);
if (Pclass(c1->tp)->has_dtor()==0 &&
Pclass(c1->tp)->has_oper(ASSIGN)==0) {
// optimize
// error('d',"bbb");
e2->e2 = e1;
e2 = e2->typ(tbl);
if (e2->base==DEREF && e2->e1->base==G_CALL ||
e2->base==ASSIGN && e2->e1==e1) {
// error('d',"ccc");
*this = *e2;
}
tp = t1;
return this;
}
return typ(tbl);
}
}
// test of c1->tp necessary for ``fake classes''
// _Sdd generated for vector assignemnts
else if (c1->tp && Pclass(c1->tp)->c_xref&(C_VBASE|C_VPTR|C_ASS)) {
if (make_assignment(c1)) return try_to_overload(tbl);
}
}
(void) t1->tsizeof();
break;
}
}
//error('d',"check(%t,%t) -> %d",e1->tp,t2,try_to_coerce(t1,e2,"assignment",tbl));
{ Pexpr x = try_to_coerce(t1,e2,"assignment",tbl);
if (x)
e2 = x;
else if (e1->tp->check(t2,ASSIGN))
error("bad assignmentT:%t =%t",e1->tp,t2);
else if ((t1 = t1->is_ptr()) && t1->memptr()) {
if (t2 == zero_type) {
Pexpr ee = new expr(ELIST,zero,zero);
e2 = new expr(ILIST,ee,zero);
}
else if (t2->base==PTR && t2->memptr()) {
// do nothing: structure assignment
}
else {
Pexpr x = ptr_init(Pptr(t1),e2,tbl);
if (x != e2) e2 = x;
}
}
}
t = e1->tp; // the type of the lhs
break;
case CM:
case G_CM:
t = t2;
break;
default:
error('i',"unknown operator%k",b);
}
tp = t;
return this;
}
0707071010112044271004440001630000160000010200100466055401400001000000130600expr2.c /*ident "@(#)ctrans:src/expr2.c 1.5" */
/***************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
expr2.c:
type check expressions
************************************************************************/
#include "cfront.h"
#include "size.h"
extern Pname conv_dominates(Pname,Pname);
static int const_obj1,const_obj2;
Pname really_dominate(Pname on1, Pname on2, bit tc)
{
Pfct f1 = on1->tp->base==FCT ? Pfct(on1->tp) :
Pfct(Pgen(on1->tp)->fct_list->f->tp);
Pfct f2 = on2->tp->base==FCT ? Pfct(on2->tp) :
Pfct(Pgen(on2->tp)->fct_list->f->tp);
// const check
int c1 = f1->f_const;
int c2 = f2->f_const;
if(c1 == c2) ;
else if(c1 && !c2) return tc ? on1 : on2;
else if(c2 && !c1) return tc ? on2 : on1;
// hierarchy check
Pname on = conv_dominates(on1,on2);
if(on) return on;
else return 0;
}
void name::assign()
{
if (n_assigned_to++ == 0) {
switch (n_scope) {
case FCT:
if (n_used && n_addr_taken==0) {
Ptype t = tp;
ll:
switch (t->base) {
case TYPE:
t=Pbase(t)->b_name->tp; goto ll;
case VEC:
break;
default:
if (curr_loop)
error('w',&where,"%n may have been used before set",this);
else
error('w',&where,"%n used before set",this);
}
}
}
}
}
void name::take_addr()
{
// error('d', "%n->take_addr tp: %t", this, tp?tp:0 );
// error('d', "%n->take_addr tp: %d %d", this, tp?tp:0, tp?tp->base:0 );
if ( (warning_opt) && (! n_addr_taken) && (tp) && (tp->base==FCT) && Pfct (tp)->f_inline)
error('w',"can't take address of inline function %n, %n not inlined", this, this);
n_addr_taken++;
if ( n_sto == EXTERN && tp ) {
Ptype t = tp;
while ( t->base == TYPE )
t = Pbase(t)->b_name->tp;
switch ( t->base ) {
case COBJ:
t = Pbase(t)->b_name->tp; // no break
case CLASS: {
Pclass cl = Pclass(t);
if ( cl->c_body == 1 )
cl->dcl_print(0);
}
}
}
}
int ignore_const; // for use by ref_init
static is_dataMemPtr(Pexpr);
int expr::lval(TOK oper)
{
register Pexpr ee = this;
register Pname n;
int deref = 0;
char* es;
//error('d',"%k expr::lval %k",base,oper);
switch (oper) {
case ADDROF:
case G_ADDROF: es = "address of"; break;
case DEREF: es = "dereference of"; break;
case INCR: es = "increment of"; goto def;
case DECR: es = "decrement of"; goto def;
default: es = "assignment to";
def:
if (ignore_const==0 && tp->tconst()) {
if (oper) {
if (base == NAME) {
if (vec_const && Pname(this)->n_scope==ARG) break;
error("%s constant%n",es,this);
}
else
error("%s constant",es);
}
return 0;
}
}
for(;;) {
//error('d',"loop %k",ee->base);
switch (ee->base) {
// case G_CALL:
// case CALL:
default:
defa:
if (deref == 0) {
if (oper) error("%s%k (not an lvalue)",es,ee->base);
return 0;
}
return 1;
case ZERO:
case CCON:
case ICON:
case FCON:
if (oper) error("%s numeric constant",es);
return 0;
case STRING:
if (oper) error('w',"%s string constant",es);
return 1;
case CAST:
switch( oper ) {
case 0:
case ADDROF:
case G_ADDROF:
case DEREF:
goto defa;
default:
if ( ee->tp->base == PTR
&& is_dataMemPtr(ee) )
{ // check for const class object
Pexpr te;
te = ee->e1->e1->e1;
if ( te->base == G_ADDROF )
te = te->e2;
if ( te->base == NAME ) {
Ptype pt = te->tp;
if ( pt->base == PTR )
pt = Pptr(pt)->typ;
if ( pt->tconst() )
error("%sCMP of const%n",es,te);
return 0;
}
}
goto defa;
}
case DEREF:
{
Pexpr ee1 = ee->e1;
// error( 'd', "ee1: %k", ee1->base );
switch (ee1->base) { // *& vanishes
case ADDROF: // *&
return 1;
case G_CM:
case CM: // look for *(a,&b)
if (ee1->e2->base==G_ADDROF
|| ee1->e2->base==ADDROF)
return 1;
goto defaa;
case QUEST: // look for *(q?&a:&b)
if ((ee1->e1->base==G_ADDROF
|| ee1->e1->base==ADDROF)
&& (ee1->e2->base==G_ADDROF
|| ee1->e2->base==ADDROF))
return 1;
// no break
default:
defaa:
ee = ee1;
deref = 1;
}
break;
}
case QUEST:
{ int x1 = ee->e1->lval(deref?0:oper);
int x2 = ee->e2->lval(deref?0:oper);
if (ee->e1->tp->check(ee->e2->tp,0)) return 0;
if (deref) return 1;
return x1 && x2;
}
case INCR:
case DECR:
if (e1) goto defa; // postfix does not preserve lval
case ASSIGN:
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASDIV:
case ASMOD:
case ASAND:
case ASOR:
case ASER:
case ASLS:
case ASRS:
return 1;
case CM:
case G_CM:
if (ee->e2->lval(deref?0:oper)==0) return deref;
return 1;
case MEMPTR:
ee = ee->e2;
break;
case MDOT:
ee = ee->mem;
break;
case DOT:
{
// error('d',"dot %k oper %k",ee->e1->base,oper);
Pexpr e = 0;
int e_const = 0; // to catch x.y.val = 1, where x is const
switch (ee->e1->base) { // update use counts, etc.
case NAME:
switch (oper) {
case ADDROF:
case G_ADDROF: Pname(ee->e1)->take_addr();
case 0: break;
case ASSIGN: Pname(ee->e1)->n_used--;
default: Pname(ee->e1)->assign(); // asop
}
break;
case DOT:
e = ee->e1;
do e=e->e1; while (e->base==DOT);
if (e->base == NAME) {
e_const = e->tp->tconst();
switch (oper) {
case ADDROF:
case G_ADDROF: Pname(e)->take_addr();
case 0: break;
case ASSIGN: Pname(e)->n_used--;
default: Pname(e)->assign(); // asop
}
}
}
n = Pname(ee->mem);
while (n->base == MDOT) n = Pname(Pref(n)->mem);
if (deref==0 &&
(ee->e1->tp->tconst() || e_const)) {
switch (oper) {
case 0:
case ADDROF:
case G_ADDROF:
case DEREF:
break;
default:
error("%sM%n of%t",es,n,e_const?e->tp:ee->e1->tp);
}
return 0;
}
}
goto xx;
case REF:
n = Pname(ee->mem);
while (n->base == MDOT) n = Pname(Pref(n)->mem);
if (deref==0 && ee->e1) { //BR
Ptype p = ee->e1->tp;
zxc:
switch (p->base) {
case TYPE: p = Pbase(p)->b_name->tp; goto zxc;
case PTR:
case VEC: break;
default: error('i',"expr::lval %t->%n",p,n);
}
if (Pptr(p)->typ->tconst()) {
switch (oper) {
case 0:
case G_ADDROF:
case DEREF:
break;
case ADDROF:
if ( cm_const_save == 0 && const_ptr == 0 )
error(strict_opt?0:'w',"%sM%n of%t",es,n,Pptr(p)->typ);
break;
default:
error("%sM%n of%t",es,n,Pptr(p)->typ);
}
return 0;
}
}
goto xx;
case NAME:
n = Pname(ee);
xx:
// error('d',"name xx: %n oper %d lex_level: %d",n,oper,n->lex_level);
if (deref) return 1;
if (oper==0) return n->n_stclass != ENUM ;
if (n->tp->base==FIELD && Pbase(n->tp)->b_bits==0) {
error("%s 0-length field%n",es,n);
return 0;
}
switch (oper) {
case ADDROF:
case G_ADDROF:
{ Pfct f = (Pfct)n->tp;
if (n->n_sto == REGISTER) {
if (warning_opt) error('w',"& register%n",n);
// return 0;
n->n_sto = 0;
n->n_stclass = AUTO;
}
if (f == 0) {
error("& label%n",n);
return 0;
}
if (n->n_stclass == ENUM) {
error("& enumerator%n",n);
return 0;
}
if (n->tp->base == FIELD) {
error("& field%n",n);
return 0;
}
n->n_used--;
if (n->n_qualifier) { // oops, not the real one
Pname tn = Pclass(n->n_table->t_name->tp)->memtbl->look(n->string,0);
n = tn ? tn : n;
}
n->take_addr();
// suppress hoisting of local consts
int statmem = n->n_scope==0 || n->n_scope==PUBLIC || n->n_scope == FCT;
if (n->n_evaluated && n->n_scope!=ARG) { // &const
if (statmem == 0 && n->n_dcl_printed==0) {
n->n_initializer = new ival(n->n_val);
n->dcl_print(0);
}
}
else if (f->base==FCT && n->n_dcl_printed==0)
n->dcl_print(0);
break;
}
case ASSIGN:
//error('d',"ass %n %d",n,n->n_used);
n->n_used--;
n->assign();
break;
// goto check_void;
default: /* incr ops, and asops */
if (cc->tot && n==cc->c_this) {
error("%n%k",n,oper);
return 0;
}
// check_void:
// { Ptype t = n->tp;
// while (t->base==TYPE) t = Pbase(t)->b_name->tp;
// if (t==Pvoid_type) {
// error("%s%t",es,n->tp);
// return 0;
// }
// }
n->assign();
}
return 1;
}
}
}
int char_to_int(char* s)
/* assume s points to a string:
'c'
or '\c'
or '\0'
or '\ddd'
or multi-character versions of the above
(hex constants have been converted to octal by the parser)
*/
{
register int i = 0;
register char c, d, e;
switch (*s) {
default:
error('i',"char constant store corrupted");
case '`':
error("bcd constant");
return 0;
case '\'':
break;
}
for(;;) /* also handle multi-character constants */
switch (c = *++s) {
case '\'':
return i;
case '\\': /* special character */
switch (c = *++s) {
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': /* octal representation */
c -= '0';
switch (d = *++s) { /* try for 2 */
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7':
d -= '0';
switch (e = *++s) { /* try for 3 */
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7':
c = c*64+d*8+e-'0';
break;
default:
c = c*8+d;
s--;
}
break;
default:
s--;
}
break;
case 'a':
c = '\a';
break;
case 'b':
c = '\b';
break;
case 'f':
c = '\f';
break;
case 'n':
c = '\n';
break;
case 'r':
c = '\r';
break;
case 't':
c = '\t';
break;
case 'v':
c = '\v';
break;
case '\\':
c = '\\';
break;
case '\'':
c = '\'';
break;
}
/* no break */
default:
if (i) i <<= BI_IN_BYTE;
i += c;
}
}
const A10 = 'A'-10;
const a10 = 'a'-10;
long str_to_long(register const char* p)
{
register c;
register unsigned long i= 0;
const char* pp = p;
// error( 'd', "str_to_long: %s", p );
if ((c=*p++) == '0') {
switch (c = *p++) {
case 0:
return 0;
case 'l':
case 'L': /* long zero */
return 0;
case 'x':
case 'X': /* hexadecimal */
while (c=*p++) {
switch (c) {
case 'l':
case 'L':
case 'U':
case 'u':
return i;
case 'A':
case 'B':
case 'C':
case 'D':
case 'E':
case 'F':
i = i*16 + c-A10;
break;
case 'a':
case 'b':
case 'c':
case 'd':
case 'e':
case 'f':
i = i*16 + c-a10;
break;
default:
i = i*16 + c-'0';
}
}
return i;
default: /* octal */
do
switch (c) {
case 'l':
case 'L':
case 'U':
case 'u':
return i;
default:
i = i*8 + c-'0';
}
while (c=*p++);
return i;
}
}
/* decimal */
i = c-'0';
while (c=*p++)
switch (c) {
case 'l':
case 'L':
case 'U':
case 'u':
return i;
default:
{ unsigned long ii = i;
i = i*10 + c-'0';
if (i<ii) goto bad;
}
}
return i;
bad:
error("integer constant %s larger than the largest long",pp);
return i;
}
bit type::is_unsigned()
{
Ptype t = this;
while (t->base==TYPE) t = Pbase(t)->b_name->tp;
if (t->base == PTR) return 0;
return Pbase(t)->b_unsigned;
}
char* Neval;
bit binary_val;
unsigned long expr::ueval(long x1, long x2)
{
unsigned long i1 = (unsigned long) x1;
unsigned long i2 = (unsigned long) x2;
//error('d',"ueval %k %ld %ld",base,x1,x2);
switch (base) {
case UMINUS: return -i2;
case UPLUS: return i2;
case NOT: return !i2;
case COMPL: return ~i2;
case CAST: return i1;
case PLUS: return i1+i2;
case MINUS: return i1-i2;
case MUL: return i1*i2;
case LS: return i1<<i2;
case RS: return i1>>i2;
case NE: return i1!=i2;
case EQ: return i1==i2;
case LT: return i1<i2;
case LE: return i1<=i2;
case GT: return i1>i2;
case GE: return i1>=i2;
case AND: return i1&i2;
case ANDAND: return i1&&i2;
case OR: return i1|i2;
case OROR: return i1||i2;
case ER: return i1^i2;
case MOD: if (i2 == 0) {
if (Neval == 0) {
Neval = "mod zero";
error("mod zero");
}
return 1;
}
return i1%i2;
case QUEST: return (cond->eval()) ? i1 : i2;
case DIV: if (i2 == 0) {
if (Neval == 0) {
Neval = "divide by zero";
error("divide by zero");
}
return 1;
}
return i1/i2;
case CM:
case G_CM:
return i2;
}
Neval = "unsigned expression";
return 0;
}
long expr::eval()
{
if (Neval) return 1;
// error('d',"eval %k",base);
static int targno=0;
static int icallflag=0;
switch (base) {
case ZERO: return 0;
case IVAL: return i1;
case ICON: return str_to_long(string);
case CCON: return char_to_int(string);
case FCON: Neval = "float in constant expression"; return 1;
case STRING: Neval = "string in constant expression"; return 1;
case EOBJ: return Pname(this)->n_val;
case SIZEOF:
extern no_sizeof;
if (no_sizeof) Neval = "sizeof";
return tp2->tsizeof();
case NAME:
{ Pname n = Pname(this);
// error('d',"eval %n eval %d %d",n,n->n_evaluated,n->n_val);
// error('d',"eval tp->tconst() %d, n->n_initializer: %k", n->tp->tconst(), n->n_initializer?n->n_initializer->base:0 );
if (n->n_evaluated && n->n_scope!=ARG) return n->n_val;
if (binary_val && strcmp(string,"_result")==0) return 8888;
Neval = "cannot evaluate constant";
return 1;
}
case ICALL:
if (e1) {
icallflag=1;
targno=0;
il->i_next = curr_icall;
curr_icall = il;
long i = e1->eval();
curr_icall = il->i_next;
icallflag=0;
return i;
}
Neval = "void inlineF";
return 1;
case ANAME:
{ Pname n = (Pname)this;
/*
int argno;
if (icallflag) {
argno=targno;
targno++;
}
*/
int argno = (int) n->n_val;
Pin il;
for (il=curr_icall; il; il=il->i_next)
if (il->i_table == n->n_table) goto aok;
goto bok;
aok:
if (il->i_args[argno].local) {
bok:
Neval = "inlineF call too complicated for constant expression";
return 1;
}
Pexpr aa = il->i_args[argno].arg;
return aa->eval();
}
case CAST:
{ if (e1->base==FCON && tp2->base!=FLOAT && tp2->base!=DOUBLE) {
char* p = e1->string;
while (*p!='.') p++;
if (p==e1->string) *p++ = '0';
*p = 0;
e1->base = ICON;
}
long i = e1->eval();
Ptype tt = tp2;
strip:
switch (tt->base) {
default:
Neval = "cast to non-integral type in constant expression";
break;
case TYPE:
tt = Pbase(tt)->b_name->tp;
goto strip;
case EOBJ:
case LONG:
case INT:
case CHAR:
case SHORT:
i &= ~(((~(unsigned long)0)<<(BI_IN_BYTE*(tp2->tsizeof()-1)))<<BI_IN_BYTE);
break;
}
return i;
}
case UMINUS:
case UPLUS:
case NOT:
case COMPL:
case PLUS:
case MINUS:
case MUL:
case LS:
case RS:
case NE:
case LT:
case LE:
case GT:
case GE:
case AND:
case OR:
case ER:
case DIV:
case MOD:
case QUEST:
case EQ:
case ANDAND:
break;
case OROR:
if (binary_val) { // a||b, don't evaluate b if a!=0
long i1 = (e1) ? e1->eval() : 0;
if (Neval==0 && i1 && e1->tp->is_unsigned()==0) return i1;
}
break;
case CM:
case G_CM:
break;
case G_ADDROF:
case ADDROF:
if (binary_val) { // beware of &*(T*)0
switch (e2->base) {
case NAME:
case DOT:
case REF: return 9999;
}
}
default:
Neval = "bad operator in constant expression";
return 1;
}
long i1 = (e1) ? e1->eval() : 0;
long i2 = (e2) ? e2->eval() : 0;
if (binary_val && i1==9999 && i2==9999) {
Neval = "";
return 1;
}
if (Neval==0
&& ((e1&&e1->tp->is_unsigned()) || (e2&&e2->tp->is_unsigned())))
return (long) ueval(i1,i2);
switch (base) {
case UMINUS: return -i2;
case UPLUS: return i2;
case NOT: return !i2;
case COMPL: return ~i2;
case CAST: return i1;
case PLUS: return i1+i2;
case MINUS: return i1-i2;
case MUL: return i1*i2;
case LS: return i1<<i2;
case RS: return i1>>i2;
case NE: return i1!=i2;
case EQ: return i1==i2;
case LT: return i1<i2;
case LE: return i1<=i2;
case GT: return i1>i2;
case GE: return i1>=i2;
case AND: return i1&i2;
case ANDAND: return i1&&i2;
case OR: return i1|i2;
case OROR: return i1||i2;
case ER: return i1^i2;
case MOD: if (i2 == 0) {
if (Neval == 0) {
Neval = "mod zero";
error("mod zero");
}
return 1;
}
return i1%i2;
case QUEST: return (cond->eval()) ? i1 : i2;
case DIV: if (i2 == 0) {
if (Neval == 0) {
Neval = "divide by zero";
error("divide by zero");
}
return 1;
}
return i1/i2;
case CM:
case G_CM:
return i2;
}
}
bit classdef::baseof(Pname f)
/*
is ``this'' class a public base class of "f"'s class
or its immediate base class
*/
{
Ptable ctbl = f->n_table;
Pname b = ctbl->t_name;
if (b == 0) return 0;
Pclass cl = Pclass(b->tp);
if (cl == 0) return 0;
if (cl == this) return 1;
ppbase = PUBLIC;
Pclass bcl = is_base(cl->string);
return (bcl && ppbase==PUBLIC);
}
bit classdef::baseof(Pclass cl)
/*
is ``this'' class a public base class of "cl"
*/
{
if (cl == 0) return 0;
if (cl == this) return 1;
ppbase = PUBLIC;
Pclass bcl = is_base(cl->string);
return (bcl && ppbase==PUBLIC);
}
static int mem_match(Pfct f1, Pfct f2)
/*
check class membership.
For some reason checking f_this==0 works and f_static doesn't
*/
{
// if (f1->memof) return f2->f_this ?f2->memof==f1->memof : 0;
// if (f1 && f1->memof) return f2->f_this?f2->memof==f1->memof : 0;
// return f2->f_this==0;
if (f1==0 || f2==0) return 0;
if (f1->memof && f2->f_this && f2->memof!=f1->memof) return 0;
if (f2->f_this) return 0;
if (f1->memof && f2->f_static) return 0;
if (f1->check(f2,ASSIGN)) return 0;
return 1;
}
int Pchecked;
Pexpr ptof(Pfct ef, Pexpr e, Ptable tbl)
/*
a kludge: initialize/assign-to pointer to function
*/
{
Pfct f;
Pname n = 0;
eee:
//error('d',"ptof %t %t %k",ef,e->tp,e->base);
switch (e->base) {
case QUEST:
e->e1 = ptof(ef,e->e1,tbl);
e->e2 = ptof(ef,e->e2,tbl);
return e;
case CM:
case G_CM:
e->e2 = ptof(ef,e->e2,tbl);
return e;
case NAME:
f = Pfct(e->tp);
Pname nn = Pname(e);
switch (f->base) {
case OVERLOAD:
e = Pgen(f)->find(ef,0);
if (e == 0) {
error("cannot deduceT for &overloaded%n",nn);
return e;
}
// e = n;
// no break
case FCT:
Pchecked = mem_match(ef,Pfct(e->tp));
e = new expr(G_ADDROF,0,e);
return e->typ(tbl); // handle &B::f
//e->tp = f;
}
goto ad;
case ZERO:
if (ef->memof) {
e = new expr(ELIST,zero,zero);
e = new expr(ILIST,e,zero);
e->tp = zero_type;
return e;
}
break;
case MDOT:
// ?? error('s',"P toM of not firstB");
do e = e->mem; while (e->base == MDOT);
goto eee;
case DOT:
case REF:
f = Pfct(e->mem->tp);
switch (f->base) {
case OVERLOAD:
n = Pgen(f)->find(ef,0);
if (n == 0) error("cannot deduceT for &overloaded%n",e->mem);
else e = n;
// no break
case FCT:
Pchecked = mem_match(ef,Pfct(e->tp));
e = new expr(G_ADDROF,0,e);
return e->typ(tbl); // handle &B::f
// n = Pname(e->mem);
// e = n->address();
}
goto ad;
case ADDROF:
case G_ADDROF:
f = Pfct(e->e2->tp);
ad:
if (f->base == OVERLOAD) {
n = Pgen(f)->find(ef,0);
if (n == 0) error("cannot deduceT for &overloaded %s()",Pgen(f)->fct_list->f->string);
Pchecked = mem_match(ef,Pfct(n->tp));
e->e2 = n;
e->tp = n->tp;
}
if (n) n->lval(ADDROF);
break;
case CAST:
{
Pexpr te = e->e1;
if (e->e1->base == G_ADDROF) te = e->e1->e2;
(void) ptof(ef,te,tbl);
}
}
return e;
}
Pexpr ptr_init(Pptr p, Pexpr init, Ptable tbl)
/*
check for silly initializers
char* p = 0L; ?? fudge to allow redundant and incorrect `L'
char* p = 2 - 2; ?? worse
*/
{
// error('d',"ptr_init: p=%t init->tp=%t init->base %k",p,init->tp,init->base);
Pchecked = 0;
Ptype it = init->tp;
itl:
switch (it->base) {
case TYPE:
it = Pbase(it)->b_name->tp; goto itl;
case ZTYPE:
// if (init == zero) break;
break;
case EOBJ:
case INT:
case CHAR:
case SHORT:
case LONG:
{ Neval = 0;
long i = init->eval();
if (Neval)
error("badPIr: %s",Neval);
else
if (i)
error("badPIr value %d",i);
else {
DEL(init);
init = zero;
}
break;
}
}
Pclass c1 = p->memof;
if (c1) {
if (init==zero)
;
else {
Pclass c2;
// error('d',"it %t %d",it,it->base);
switch (it->base) {
case FCT:
c2 = Pfct(it)->memof;
break;
case OVERLOAD:
c2 = Pfct(Pgen(it)->fct_list->f->tp)->memof;
break;
case PTR:
case RPTR:
c2 = Pptr(it)->memof;
break;
default:
c2 = 0;
}
if (c2 == 0) {
// initialization by &A::f
//error('d',"curious");
}
else if (c1 != c2) {
Nptr = 0;
Noffset = 0;
vcllist->clear();
vcllist=0;
int u1 = is_unique_base(c1,c2->string,0);
//error('d',"c1 %t c2 %t u1 %d off %d",c1,c2,u1,Noffset);
if (u1 && (Nptr || Noffset)) {
// requires offset manipulation
int bad = 0;
if (u1 == 1 && !Nptr) {
if (init->base==ILIST) {
// d = d+Noffset;
switch (init->e1->e1->base) {
case IVAL:
init->e1->e1->i1 += Noffset;
break;
case ZERO:
init->e1->e1 = new ival(Noffset);
break;
default:
bad = 1;
}
// if (i<0) f = vptroffset
switch (init->e1->e2->base) {
case IVAL:
if (0<init->e1->e2->i1) {
// extern Ptype Pfct_type;
// store vptr offset
// init->e2=new cast(Pfct_type,zero);
}
else
break;
default:
bad = 1;
}
} // end if (init->base==ILIST)
else
bad = 1;
} // end if (u1 == 1 ...
else
bad = 1;
if (bad) error('s',"%t assigned to %t (too complicated)",init->tp,p);
} // end if (u1 && ...
Nptr = 0;
Noffset = 0;
vcllist->clear();
vcllist=0;
int u2 = is_unique_base(c2,c1->string,0);
//error('d',"c1 %t c2 %t u2 %d off %d",c1,c2,u2,Noffset);
if (u2 && (Nptr || Noffset)) {
// requires offset manipulation
error('s',"%t assigned to %t",init->tp,p);
}
} // end if (c1 != c2
} // end else
} // end if (c1)
Ptype pit = p->typ;
lll:
// error('d',"p %t pit %t",p,pit);
switch (pit->base) {
case TYPE:
pit = Pbase(pit)->b_name->tp;
goto lll;
case FCT:
return ptof(Pfct(pit),init,tbl);
case COBJ:
{ Pptr r;
// error('d',"cobj: ptr %t, ref %t",it->is_ptr(),it->is_ref());
if (r=it->is_ptr_or_ref()) {
Pchecked = 1;
TOK b = p->base; // could be REF
TOK bb = r->base;
if (b==RPTR) p->base = PTR;
if (bb==RPTR) r->base = PTR;
if (p->check(r,ASSIGN)) {
if ( cc && cc->nof &&
Pfct(cc->nof->tp)->f_const &&
cc->c_this == init )
error("%n const: assignment of%n (%t) to%t",cc->nof,init,init->tp,p);
else
error("no standard conversion of %t to %t",init->tp,p);
}
p->base = b;
r->base = bb;
Pexpr cp = cast_cptr(Pclass(Pbase(pit)->b_name->tp),init,tbl,0);
if (cp != init) {
PERM(p); // or else it will be deleted twice!
return new cast(p,cp);
}
}
// no break
}
default:
return init;
}
}
static Pname Lcoerce, Rcoerce;
extern int suppress_error;
int try_to_demote(TOK oper, Ptype t1, Ptype t2)
/*
look at t1 and t2 and see if there are ``demotions'' of t1 and/or t2
so that ``t1 oper t2'' can be made legal
return 0 is not
1 if there is exactly one way
>1 if there is more than one way (if in doubt return 2)
*/
{
//error('d',"try_to_demote(%k : %t : %t)",oper,t1,t2);
Pname n1 = t1 ? t1->is_cl_obj() : 0;
Pclass c1 = n1 ? Pclass(n1->tp) : 0;
Pname n2 = t2 ? t2->is_cl_obj() : 0;
Pclass c2 = n2 ? Pclass(n2->tp) : 0;
Ptype lt = t1;
Ptype rt = t2;
Lcoerce = Rcoerce = 0;
// if (oper == DOT) return 0;
if (c1)
switch (oper) {
case ASSIGN:
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASDIV:
case ASMOD:
case ASAND:
case ASOR:
case ASER:
case ASLS:
case ASRS: // don't coerce left hand side of assignment
// c1 = 0;
if (c1->memtbl->look("__as",0)) return 0;
}
else
switch (oper) {
case ADDROF:
case INCR:
case DECR: // don't coerce unary requiring an lval
return 0;
}
if (c1) {
//error('d',"c1 %t",c1);
for (Pname on1 = c1->conv; on1; on1=on1->n_list) {
// error( 'd', "on1: %s tp: %k", on1->string, on1->tp->base );
Pfct f = Pfct(on1->tp);
lt = f->base==FCT ? f->returns :
Pfct(Pgen(on1->tp)->fct_list->f->tp)->returns;
Pname cn = lt->is_cl_obj();
if (cn && (Lcoerce==0 || Lcoerce->tp->check(f,0))) {
Pclass cl = Pclass(cn->tp);
Pname n = cl->has_oper(oper);
if (n == 0) continue;
// while (n->base==REF || n->base==MDOT) n=Pname(n->mem) ;
Pfct nf = Pfct(n->tp);
// error( 'd', "nf: %d %k", nf->base, nf->base );
if (nf->base == FCT) {
if (nf->nargs==1
&& t2
&& (nf->argtype->tp->check(t2,ARG)==0
|| can_coerce(nf->argtype->tp,t2)==1)
) {
if (Lcoerce) return 2;
Lcoerce = on1;
}
}
else {
for (Plist gl=Pgen(nf)->fct_list; gl; gl=gl->l) {
Pfct nf = Pfct(gl->f->tp);
if (nf->nargs==1
&& t2
&& (nf->argtype->tp->check(t2,ARG)==0
|| can_coerce(nf->argtype->tp,t2)==1)
) {
if (Lcoerce) return 2;
Lcoerce = on1;
}
}
}
continue;
}
//if (lt->is_cl_obj()) continue;
if (c2) {
//error('d',"c2 %t",c2);
for (Pname on2 = c2->conv; on2; on2=on2->n_list) {
Pfct f = Pfct(on2->tp);
rt = f->base==FCT ? f->returns :
Pfct(Pgen(on2->tp)->fct_list->f->tp)->returns;
if (rt->is_cl_obj()) continue;
suppress_error = 1;
int r1 = lt->kind(oper,0);
int r2 = rt->kind(oper,0);
if (np_promote(oper,r1,r2,lt,rt,1)!=any_type) {
Pname sn = on1;
if (Lcoerce) {
Pname tn = really_dominate(
Lcoerce,
on1,
const_obj1
);
if(!tn) {
suppress_error = 0;
return 2;
}
else sn = tn;
}
Lcoerce = sn;
Rcoerce = on2;
}
suppress_error = 0;
}
}
else if (rt) {
suppress_error = 1;
int r1 = lt->kind(oper,0);
int r2 = rt->kind(oper,0);
if (np_promote(oper,r1,r2,lt,rt,1)!=any_type) {
Pname sn = on1;
if (Lcoerce) {
Pname tn = really_dominate(
Lcoerce,
on1,
const_obj1
);
if(!tn) {
suppress_error = 0;
return 2;
}
else sn = tn;
}
Lcoerce = sn;
}
suppress_error = 0;
}
else {
Pname sn = on1;
if (Lcoerce) {
Pname tn = really_dominate(
Lcoerce,
on1,
const_obj1
);
if(!tn) return 2;
else sn = tn;
}
Lcoerce = sn;
}
}
}
else if (c2) {
//error('d',"c2 %n",c2);
for (Pname on = c2->conv; on; on=on->n_list) {
Pfct f = Pfct(on->tp);
rt = f->base==FCT ? f->returns :
Pfct(Pgen(on->tp)->fct_list->f->tp)->returns;
Pname cn = rt->is_cl_obj();
//error('d',"cn %n",cn);
if (cn && (Rcoerce==0 || Rcoerce->tp->check(f,0))) {
Pclass cl = Pclass(cn->tp);
Pname n = cl->has_oper(oper);
if (n == 0) continue;
// while (n->base==REF || n->base==MDOT) n=Pname(n->mem);
Pfct nf = Pfct(n->tp);
if (nf->base == FCT) {
if (nf->nargs == 0) {
if (Lcoerce || Rcoerce) return 2;
Rcoerce = on;
}
}
else {
for (Plist gl=Pgen(nf)->fct_list; gl; gl=gl->l)
if (Pfct(gl->f->tp)->nargs == 0) {
if (Lcoerce || Rcoerce) return 2;
Rcoerce = on;
}
}
continue;
}
//if (rt->is_cl_obj()) continue;
if( lt ) {
suppress_error = 1;
int r1 = lt->kind(oper,0);
int r2 = rt->kind(oper,0);
if (np_promote(oper,r1,r2,lt,rt,1)!=any_type) {
Pname sn = on;
if (Lcoerce || Rcoerce) {
Pname tn = really_dominate(
Rcoerce,
on,
const_obj2
);
if(!tn) {
suppress_error = 0;
return 2;
}
else sn = tn;
}
Rcoerce = sn;
}
suppress_error = 0;
}
}
}
//error('d',"->%d || %d",Lcoerce,Rcoerce);
return (Lcoerce || Rcoerce);
}
Pexpr expr::try_to_overload(Ptable tbl)
{
// TOK bb = (base==DEREF && e2==0) ? MUL : base;
// error('d',"try_to_overload %k %d",base,base);
Pname n1 = 0;
Ptype t1 = 0;
const_obj1 = 0;
const_obj2 = 0;
if (e1) {
t1 = e1->tp;
Ptype tpx = t1;
while (tpx->base == TYPE) tpx = Pbase(tpx)->b_name->tp;
n1 = tpx->is_cl_obj();
const_obj1 = t1->tconst();
Pexpr ee = e1;
while (ee && (ee->base==DOT || ee->base==REF)) {
Pexpr m = ee->mem;
if ( ee->base==REF && m->tp && m->tp->is_ptr())
break;
ee = ee->e1;
}
if (ee) {
int tc;
Ptype ttt = ee->tp;
switch (e1->base) {
case REF:
Pptr p = ttt?ttt->is_ptr():0;
if (p && p->typ->tconst())
const_obj1 = 1;
break;
case DOT:
tc = ttt ? ttt->tconst() : 0;
if (ttt && tc && (!strict_opt || tc!=2))
const_obj1 = 1;
}
}
}
TOK bb = base;
switch (bb) {
case DEREF:
if (e2 == 0) bb = MUL;
// no break;
case CALL:
case G_CALL:
if (n1 == 0) return 0; // ignore type of argument list
}
Pname n2 = 0;
Ptype t2 = 0;
if (e2 && e2->base!=ELIST) {
t2 = e2->tp;
Ptype tpx = t2;
while (tpx->base == TYPE) tpx = Pbase(tpx)->b_name->tp;
n2 = tpx->is_cl_obj();
const_obj2 = t2->tconst();
Pexpr ee = e2;
while (ee && (ee->base==DOT || ee->base==REF)) {
Pexpr m = ee->mem;
if ( ee->base==REF && m->tp && m->tp->is_ptr())
break;
ee = ee->e1;
}
if (ee) {
int tc;
Ptype ttt = ee->tp;
switch (e2->base) {
case REF:
Pptr p = ttt?ttt->is_ptr():0;
if (p && p->typ->tconst())
const_obj2 = 1;
break;
case DOT:
tc = ttt ? ttt->tconst() : 0;
if (ttt && tc && (!strict_opt || tc!=2))
const_obj2 = 1;
}
}
}
if (n1==0 && n2==0) return 0;
if (n1 && n1->tp == 0) return 0; // make_assign() fudge
// error('d',"e1: %k e2: %k", e1?e1->base:0, e2?e2->base:0 );
// error('d',"t1 %t t2 %t",t1,t2);
// error('d',"n1 %n n2 %n",n1,n2);
/* first try for non-member function: op(e1,e2) or op(e2) or op(e1) */
Pexpr oe2 = e2;
Pexpr ee2 = (e2 && e2->base!=ELIST) ? e2 = new expr(ELIST,e2,0) : 0;
Pexpr ee1 = e1 ? new expr(ELIST,e1,e2) : ee2;
char* obb = oper_name(bb);
Pname gname = tbl->look(obb,0);
// if necessary check for ambiguities
int go = gname ? over_call(gname,ee1) : 0;
//error('d',"go %d",go);
if (go) gname = Nover;
if (n1) {
if (bb == ASSIGN) {
Pclass c1 = Pclass(n1->tp);
//error('d',"look %k %d",bb,c1->memtbl->look(obb,0));
if (c1->memtbl->look(obb,0)==0) {
Pclass bcl = c1->baselist?c1->baselist->bclass:0;
if (n2==0
|| (Pclass(n2->tp)!=c1
&& Pclass(n2->tp)->has_base(c1)==0)) {
// if legal, a=1 can be optimized to a.ctor(1)
if (2 < go) goto glob;
return 0;
}
if (bcl
&& c1->obj_size!=bcl->obj_size
&& bcl->memtbl->look(obb,0)) {
// cannot inherit from smaller base class
// make_assignment(n1);
// return try_to_overload(tbl);
goto mkas;
}
if (c1->c_xref&(C_VBASE|C_VPTR|C_ASS)) {
// make operator=() if
// no base (shouldn't happen
// different (smaller) sized base
// two bases
mkas:
if (2 < go) goto glob;
// make_assignment(n1);
// return try_to_overload(tbl);
return make_assignment(n1) ? try_to_overload(tbl) : 0;
}
// error('d',"n2 %n",n2);
// if (n2 && Pclass(n2->tp)==c1)
return 0;
}
// now take care of other assignments,
}
int dbconv = 0;
Pclass ccl = Pclass(n1->tp);
// Pexpr mn = Pclass(n1->tp)->memtbl->look(obb,0);
Pexpr mn = ccl->memtbl->look(obb,0);
// error('d', "tcl %d %t cl %d %t", tcl, tcl, ccl, ccl);
if(strcmp(obb,"__as")) {
tcl = ccl; // ugh!!!
if(!mn) dbconv = 2;
}
// tcl = ccl; // ugh!!!
mn = ccl->find_name(obb,0);
Pname mname = Pname(mn);
// error('d',"mn %n %d %k %s",mname,mn,mn?mn->base:0,obb);
if (mname == 0) goto glob;
zaq:
switch (mname->base) {
case REF:
case MDOT:
mname = Pname(Pexpr(mname)->mem);
goto zaq;
}
int mo = over_call(mname,e2);
int smo = mo;
if(mo && dbconv && mo >= dbconv) mo = dbconv;
//error('d',"mo %d (go %d)",mo,go);
if (mo==0 || mo<go)
goto glob;
else if (mo && mo==go) {
//error('d',"t1 %t t2 %t",t1,t2);
if (gname->tp->base == OVERLOAD) { // find right version
for (Plist l = Pgen(gname->tp)->fct_list; l; l=l->l) {
Pname n = l->f;
int x = over_call(n,ee1);
if (x == go) {
gname = n;
break;
}
}
}
//error('d',"gname %n: %t",gname,gname->tp);
Pname aa = Pfct(gname->tp)->argtype;
Pptr p;
Ptype gt1 = aa->tp;
if (p = gt1->is_ref()) gt1 = p->typ;
Ptype gt2 = aa->n_list->tp;
//error('d',"gt1 %t gt2 %t",gt1,gt2);
if (mname->tp->base == OVERLOAD) { // find right version
for (Plist l = Pgen(mname->tp)->fct_list; l; l=l->l) {
Pname n = l->f;
int x = over_call(n,e2);
if (x == smo) {
mname = n;
break;
}
}
}
//error('d',"mname %n: %t",mname,mname->tp);
Ptype mt1 = Pfct(mname->tp)->f_this->tp;
mt1 = Pptr(mt1)->typ;
Ptype mt2 = Pfct(mname->tp)->argtype->tp;
//error('d',"mt1 %t mt2 %t",mt1,mt2);
Pname mm = new name;
Pname a1 = new name;
a1->tp = mt1;
Pname a2 = new name;
a2->tp = mt2;
a1->n_list = a2;
mm->tp = new fct(void_type,a1,2);
Pname gg = new name;
Pname a3 = new name;
a3->tp = gt1;
Pname a4 = new name;
a4->tp = gt2;
a3->n_list = a4;
gg->tp = new fct(void_type,a3,1);
extern Pname dominate(Pname,Pname,Pexpr,int,int);
aa = dominate(gg,mm,ee1,0,1);
delete a1;
delete a2;
delete a3;
delete a4;
DEL( gg->tp );
DEL( mm->tp );
//delete gg->tp;
//delete mm->tp;
if (aa == 0) {
delete gg;
delete mm;
error("ambiguous operandTs%n and%t for%k",n1,t2,bb);
tp = any_type;
return this;
}
else if (aa == gg) {
delete gg;
delete mm;
goto glob;
}
delete gg;
delete mm;
}
else if (mo < 2) { // user-defined conversion user
if (try_to_demote(bb,t1,t2))
error("ambiguous use of overloaded%k",bb);
}
base = G_CALL; // e1.op(e2) or e1.op()
Pname xx = new name(mname->string); // do another lookup
// . suppresses virtual
e1 = new ref(DOT,e1,xx);
if (ee1) delete ee1;
return typ(tbl);
}
if (n2 && e1==0) { /* look for unary operator */
suppress_error++;
Pexpr mn = Pclass(n2->tp)->find_name(obb,0);
suppress_error--;
Pname mname = Pname(mn);
if (mname == 0) goto glob;
zaqq:
switch (mname->base) {
case REF:
case MDOT:
mname = Pname(Pexpr(mname)->mem);
goto zaqq;
}
switch (mname->n_scope) {
default: goto glob;
case 0:
case PUBLIC: break; // try e2.op()
}
int mo = over_call(mname,0);
//error('d',"e2 mo %d (go %d)",mo,go);
if (mo==0 || mo<go)
goto glob;
else if (mo==go) {
error("ambiguous operandT%n for%k",n2,bb);
tp = any_type;
return this;
}
else if (mo < 2) { // user-defined conversion user
if (try_to_demote(bb,t1,t2))
error("ambiguous use of overloaded%k",bb);
}
base = G_CALL; // e2.op()
Pname xx = new name(Nover->string); // do another lookup
// . suppresses virtual
e1 = new ref(DOT,oe2,xx);
e2 = 0;
if (ee2) delete ee2;
if (ee1 && ee1!=ee2) delete ee1;
return typ(tbl);
}
glob:
// error('d',"glob %d",go);
if (go) {
if (go < 2) { // user-defined conversion necessary => binary
if (try_to_demote(bb,t1,t2))
error("ambiguous use of overloaded%k: %t and %t",bb,t1,t2);
}
base = gname->n_table == gtbl ? G_CALL : CALL;
//error('d',"gname %n %t",gname,gname->tp);
e1 = new name(gname->string);
// if global scope, look only for globals
if(gname->n_table == gtbl) Pname(e1)->n_qualifier = sta_name;
e2 = ee1;
return typ(tbl);
}
if (ee2) delete ee2;
if (ee1 && ee1!=ee2) delete ee1;
e2 = oe2;
// error('d',"bb %d %k",bb,bb);
switch (bb) {
case CM:
case G_CM:
case G_ADDROF:
return 0;
case ASSIGN:
if (n1
&& n2
&& (n1->tp==n2->tp || Pclass(n2->tp)->has_base(Pclass(n1->tp)))) {
if (make_assignment(n1))
return try_to_overload(tbl);
else
return 0;
}
case DEREF:
case CALL:
if (n1 == 0) break;
default: /* look for conversions to basic types */
if (n1
&& Pclass(n1->tp)->conv
&& (bb==ANDAND || bb==OROR)) {
e1 = check_cond(e1,bb,tbl);
return 0;
}
if (n2
&& Pclass(n2->tp)->conv
&& (bb==ANDAND || bb==OROR || bb==NOT ||
bb==UMINUS || bb==UPLUS || bb==COMPL)) {
e2 = check_cond(e2,bb,tbl);
return 0;
}
// error( 'd', "bb: %k t1: %k t2: %k", bb, t1?t1->base:0, t2?t2->base:0 );
switch (try_to_demote(bb,t1,t2)) {
default:
if (Lcoerce) error("ambiguous conversion of%n",n1);
if (Rcoerce) error("ambiguous conversion of%n",n2);
case 0:
break;
case 1:
if (Lcoerce) {
Pname xx = new name(Lcoerce->string);
Pref r = new ref(DOT,e1,xx);
e1 = new expr(G_CALL,r,0);
}
if (Rcoerce) {
Pname xx = new name(Rcoerce->string);
Pref r = new ref(DOT,e2,xx);
e2 = new expr(G_CALL,r,0);
}
return typ(tbl);
}
switch (bb) {
case CM:
case ADDROF: // has legal built-in meaning
return 0;
}
if (t1 && t2)
error("bad operandTs%t%t for%k",t1,t2,bb);
else
error("bad operandT%t for%k",t1?t1:t2,bb);
tp = any_type;
return this;
}
return 0;
}
Pexpr cast_cptr(Pclass ccl, Pexpr ee, Ptable tbl, int real_cast)
/*
"ee" is being cast to pointer object of class "ccl"
if necessary modify "ee"
*/
{
// Ptype etp = ee->tp;
// error('d',"cast_cptr %k ccl %t ee->tp %t",ee->tp->base,ccl,ee->tp);
// if (etp->base!=PTR && etp->base!=RPTR) return ee;
Ptype etp = ee->tp->is_ptr_or_ref();
if (etp == 0) return ee;
Pname on = Pptr(etp)->typ->is_cl_obj();
if (on == 0) return ee;
Pclass ocl = Pclass(on->tp);
if (ocl==ccl || ccl==0 || ocl==0) return ee;
// error('d',"cast_cptr %t(%t) real %d",ccl,ocl,real_cast);
int oo = 0;
Pexpr r = 0;
if (ocl->baselist
&& (ocl->baselist->bclass!=ccl || ocl->baselist->base!=NAME)) {
// casting derived to second or virtual base?
Nptr = 0;
Nvis = 0;
Nalloc_base = 0;
vcllist->clear();
vcllist=0;
int x = is_unique_base(ocl,ccl->string,0);
if (Nvis) {
if (real_cast==0)
error("cast:%n* ->B%t*; privateBC",on,ccl);
else if (warning_opt)
error('w',"cast:%n* ->B%t*; privateBC",on,ccl);
real_cast = 1; // suppress further error mesages
Nvis = 0;
}
switch (x) {
default:
error("cast:%n* ->B%t*;%t isB more than once",on,ccl,ccl);
case 0: // unrelated;
break;
case 1:
oo = Noffset;
break;
}
if (Nptr) { // => ee?Nptr:0
if (ocl->c_body==1) ocl->dcl_print(0);
Nptr->mem = ee; // ee->Pbase_class
if ( Nalloc_base ) {
// error('d', "cast_cptr: nalloc_base: %s", Nalloc_base);
Nptr->i1 = 5;
Nptr->string4 = new char[strlen(Nalloc_base)];
strcpy(Nptr->string4,Nalloc_base);
Nalloc_base = 0;
}
else Nptr->i1 = 3;
if (ee->base==ADDROF || ee->base==G_ADDROF)
ee = Nptr;
else {
Pexpr p = new expr(QUEST,Nptr,zero);
nin = 1;
if (ee->not_simple()) { // need temp
Ptype t = ee->tp;
Pname pp = make_tmp('N',t,tbl);
Pname(pp)->n_assigned_to = 1;
ee = new expr(ASSIGN,pp,ee);
ee->tp = t;
Nptr->mem = pp;
}
nin = 0;
p->cond = ee;
p->tp = ee->tp;
ee = p;
}
}
}
if (ccl->baselist
&& (ccl->baselist->bclass!=ocl || ccl->baselist->base!=NAME)) {
// casting second or virtual base to derived?
Nptr = 0;
vcllist->clear();
vcllist=0;
int x = is_unique_base(ccl,ocl->string,0);
switch (x) {
default:
error("cast:%n* ->derived%t*;%n isB more than once",on,ccl,on);
case 0: // unrelated;
break;
case 1:
oo = -Noffset;
if (Nptr)
error("cast:%n* ->derived%t*;%n is virtualB",on,ccl,on);
break;
}
Nvis = 0; // visibility no concern when converting from base to derived
}
// error('d',"oo %d ee %k",oo,ee->base);
if (oo) { // => ee?ee+offset:0
if (ee->base==ADDROF || ee->base==G_ADDROF)
ee = rptr(ee->tp,ee,oo);
else {
Pexpr p;
nin = 1;
if (ee->not_simple()) { // need temp
Ptype t = ee->base==MDOT?ee->mem->tp:ee->tp;
Pname pp = make_tmp('M',t,tbl);
Pname(pp)->n_assigned_to = 1;
ee = new expr(ASSIGN,pp,ee);
ee->tp = t;
p = rptr(t,pp,oo);
}
else
p = rptr(ee->base==MDOT?ee->mem->tp:ee->tp,ee,oo);
nin = 0;
Pexpr pp = new expr(QUEST,p,zero);
pp->tp = ee->tp;
pp->cond = ee;
ee = pp;
}
}
Nvis = 0; // Nvis set by has_base()
if (ocl->has_base(ccl) && Nvis) {
if (real_cast==0)
error("cast:%n* ->B%t*; privateBC",on,ccl);
else if (warning_opt)
error('w',"cast:%n* ->B%t*; privateBC",on,ccl);
Nvis = 0;
}
// error('d',"return %d %k %t",ee,ee->base,ee->tp);
return ee;
}
Pexpr expr::donew(Ptable tbl)
{
Ptype tt = tp2;
Ptype tpx = tt;
bit v = 0;
bit old = new_type;
int init = 0; // non-constructor initialization
new_type = 1;
tt->dcl(tbl);
new_type = old;
// error('d',"donew %d %d (%k) tt %t",e1,e2,e2?e2->base:0,tt);
if (e1) e1 = e1->typ(tbl);
if (e2) e2 = e2->typ(tbl);
ll:
//error('d',"ll %d",tt->base);
switch (tt->base) {
default:
if ( e1) {
if (v) {
error("Ir for array created using \"new\"");
break;
}
init = 1;
}
// if (e1) {
// error("Ir for nonCO created using \"new\"");
// e1 = 0;
// }
break;
case VEC:
if (v && Pvec(tt)->dim) error("only 1st array dimension can be non-constant");
if (Pvec(tt)->size==0 && Pvec(tt)->dim==0) error("array dimension missing in `new'");
// if (Pvec(tt)->dim==zero) {
// Pvec(tt)->size = 0;
// Pvec(tt)->dim = 0;
// }
v++;
tt = Pvec(tt)->typ;
goto ll;
case TYPE:
tt = Pbase(tt)->b_name->tp;
goto ll;
case VOID:
error("badT for `new': void");
break;
case COBJ:
{ Pname cn = Pbase(tt)->b_name;
Pclass cl = Pclass(cn->tp);
Pname icn = 0;
if ( e1 ) { // arguments
if ( e1->e2 == 0 && e1->base == ELIST ) {
e1 = e1->e1;
e1 = e1->typ(tbl);
}
icn = (e1->base!=ELIST)?e1->tp->is_cl_obj():0;
}
//Pname icn = (e1 && e1->base!=ELIST)?e1->tp->is_cl_obj() : 0;
Pclass icl = icn ? Pclass(icn->tp) : 0;
if (cl->c_abstract) {
error("`new' of abstractC%t",cl);
break;
}
if (v && e1) {
error("Ir for array ofCO created using \"new\"");
break;
}
if ((cl->defined&(DEFINED|SIMPLIFIED)) == 0) {
error("new%n;%n isU",cn,cn);
break;
}
Pname ctor = cl->has_ctor();
if (ctor) {
if (v) {
Pname ic;
if ((ic = cl->has_ictor())==0) {
error("array ofC%n that does not have aK taking noAs",cn);
break;
}
if (Pfct(ic->tp)->nargs) {
error("defaultAs forK for array ofC%n",cn);
break;
}
}
if (icl
&& cl->has_itor()==0 // incomplete:
// what if X(Y&) exists
// for class Y : X ?
&& (icl==cl || icl->has_base(cl))) {
init = 1;
break;
}
e1 = call_ctor(tbl,0,ctor,e1);
}
else if (e1) {
if (icl==cl || icl->has_base(cl))
init = 1;
else
error("new%n(As ); %n does not have aK",cn,cn);
}
}
}
if (init) {
Pname tmp = make_tmp('N',tt->addrof(),tbl);
e1 = e1->typ(tbl);
if (tt->check(e1->tp,ASSIGN))
error("badIrT %t for new operator (%t X)",e1->tp,tt);
e1 = new expr(0,tmp,e1);
tmp->assign();
}
// tp = (v) ? tpx : tpx->addrof();
switch (v) {
case 0:
tp = tpx->addrof();
break;
case 1:
tp = tpx;
break;
default:
tp = tpx;
}
//error('d',"donew(%d) -> %t",v,tp);
return this;
}
static is_dataMemPtr( Pexpr ee )
/* this is utterly implementation dependent
* called by expr::lval to determine
* const objects bounds to pointers to data members
*/
{
Pexpr te = ee->e1;
if ( te == 0 ) return 0;
if ( te->base != PLUS ) return 0;
if ( (te = te->e2) == 0 ) return 0;
if ( te->base != MINUS ) return 0;
if ( (te = te->e1) == 0 ) return 0;
if ( te->base != CAST ) return 0;
if ( (te = te->e1) == 0 ) return 0;
if ( te->tp->base != PTR ) return 0;
if ( Pptr(te->tp)->memof == 0 ) return 0;
return 1;
}
0707071010112044301004440001630000160000010200700466055402100001000000162346expr3.c /*ident "@(#)ctrans:src/expr3.c 1.6" */
/***************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
expr3.c:
type check function calls, casts, and explicit coercions
************************************************************************/
#include "cfront.h"
#include "size.h"
int pr_dominate(Ptype t1, Ptype t2)
/*
*/
{
Pname cn1 = t1->is_cl_obj();
Pname cn2 = t2->is_cl_obj();
//error('d',"pr_dominate(%t,%t)",t1,t2);
if (cn1==0 || cn2==0) {
Ptype p1 = t1->is_ptr();
Ptype p2 = t2->is_ptr();
if (p1 && p2) { // pointers
cn1 = Pptr(p1)->typ->is_cl_obj();
cn2 = Pptr(p2)->typ->is_cl_obj();
if (cn1==0 || cn2==0) return 0;
}
else {
p1 = t1->is_ref();
p2 = t2->is_ref();
if (p1 && p2) { // references
cn1 = Pptr(p1)->typ->is_cl_obj();
cn2 = Pptr(p2)->typ->is_cl_obj();
if (cn1==0 || cn2==0) return 0;
}
// else if (p1 && cn2) {
// cn1 = Pptr(p1)->typ->is_cl_obj();
// }
else
return 0; // not the same and not classes
}
}
Pclass c1 = Pclass(cn1->tp);
Pclass c2 = Pclass(cn2->tp);
//error('d'," c1 : c2 %d; c2 : c1 %d",c1->has_base(c2),c2->has_base(c1));
if (c1->has_base(c2)) return 1;
if (c2->has_base(c1)) return 2;
return 0;
}
int exact1(Pname,Ptype);
static exact2(Pname,Ptype);
static exact3(Pname,Ptype);
static Pname user_dominate(Pname n1, Pname n2, Pexpr arg)
{
Pfct f1 = Pfct(n1->tp);
Pfct f2 = Pfct(n2->tp);
Pname a1 = f1->argtype;
Pname a2 = f2->argtype;
//error('d',"user_dominate: %n %t %t",n1,f1,f2);
for(; a1 && a2; a1 = a1->n_list, a2 = a2->n_list) {
Ptype t1 = a1->tp;
Ptype t2 = a2->tp;
}
if (a1 && !a1->n_evaluated) return n1;
if (a2 && !a2->n_evaluated) return n2;
a1 = f1->argtype;
a2 = f2->argtype;
Pname prev = 0;
Pexpr e = arg;
for(; a1 && a2 && e; a1 = a1->n_list, a2 = a2->n_list, e = e->e2) {
Ptype t1 = a1->tp;
Ptype t2 = a2->tp;
Ptype at = e->e1->tp;
int j = can_coerce(t1,at);
Ptype tt1 = Ncoerce ? Pfct(Ncoerce->tp)->returns : 0;
j = can_coerce(t2,at);
Ptype tt2 = Ncoerce ? Pfct(Ncoerce->tp)->returns : 0;
if(!tt1 || !tt2 || tt1->check(tt2,OVERLOAD))
return 0;
int one = 0, two = 0;
if(exact1(a1,tt1)) one = 4;
else if(exact2(a1,tt1)) one = 3;
else if(exact3(a1,tt1)) one = 2;
else one = 1;
if(exact1(a2,tt1)) two = 4;
else if(exact2(a2,tt1)) two = 3;
else if(exact3(a2,tt1)) two = 2;
else two = 1;
if(one > two && (!prev || prev==n1)) prev = n1;
else if(two > one && (!prev || prev==n2)) prev = n2;
else if(one == two && one) ;
else return 0;
}
if(prev) return prev;
return 0;
}
Pname dominate(Pname n1, Pname n2, Pexpr arg, int const_obj, int level)
/*
the two functions n1 and n2 can each respond to a call using
standard conversions. Does the one dominate the other in the
sense that all its arguments are identical to the other or
classes defived from the class of the corresponding argument
of the other.
If so return it, otherwise return 0;
*/
{
Pname res = 0;
Pfct f1 = Pfct(n1->tp);
Pfct f2 = Pfct(n2->tp);
Pname a1 = f1->argtype;
Pname a2 = f2->argtype;
Pexpr e = arg;
//error('d',"dominate: %n %t %t e %d",n1,f1,f2,e);
if (e == 0) {
if (const_obj) {
if (f1->f_const && f2->f_const==0) return n1;
if (f2->f_const && f1->f_const==0) return n2;
}
else {
if (f1->f_const==0 && f2->f_const) return n1;
if (f2->f_const==0 && f1->f_const) return n2;
}
return 0;
}
for(; a1 && a2 && e; a1 = a1->n_list, a2 = a2->n_list, e = e->e2) {
Ptype t1 = a1->tp;
Ptype t2 = a2->tp;
Ptype at = e->e1->tp;
//error('d',"t1 %t t2 %t at %t",t1,t2,at);
if (t1==t2 || t1->check(t2,0)==0 )
continue;
Pptr r1 = t1->is_ref();
Pptr r2 = t2->is_ref();
//error('d',"const_problem %t %t %t %d",t1,t2,at,const_problem);
if (const_problem) { // t1 and t1 differs only in const
Pname rr;
if (at->check(t1,0)==0 && const_problem==0) {
if (t1->is_ptr())
rr = n1;
else
goto nc;
}
else if (at->check(t2,0)==0 && const_problem==0) {
if (t2->is_ptr())
rr = n2;
else
goto nc;
}
else if (r1 && r1->typ->check(at,0)==0 && const_problem==0)
rr = n1;
else if (r2 && r2->typ->check(at,0)==0 && const_problem==0)
rr = n2;
else
goto nc;
if (res && res!=rr) return 0; // mutual dominace
res = rr;
continue; // identical
}
nc:
if (r2 && (t1==r2 || t1->check(r2->typ,0)==0)) continue;
if (r1 && (t2==r1 || t2->check(r1->typ,0)==0)) continue;
Pname rr = 0;
if (t1==at || exact1(a1,at))
rr = n1;
else if (t2==at || exact1(a2,at))
rr = n2;
else if (1<level) { // try integral promotion
if (exact2(a1,at))
rr = n1;
if (exact2(a2,at)) {
if (rr) rr = 0;
else rr = n2;
}
}
if (!rr && 2<level) { // try standard conversions
if (exact3(a1,at))
rr = n1;
if (exact3(a2,at)) {
if (rr) rr = 0;
else rr = n2;
}
}
if (rr) {
if (res && res!=rr) return 0; // mutual dominance
res = rr;
continue;
}
int r = pr_dominate(t1,t2);
//error('d',"pr1 %d",r);
if (r) {
Pname rr = r==1?n1:n2;
if (res && res!=rr) return 0; // mutual dominace
res = rr;
continue;
}
r = pr_dominate(t1,at);
//error('d',"pr2 %d",r);
if (r==2) {
if (res && res!=n1) return 0; // mutual dominace
res = n1;
r = pr_dominate(t2,at);
if (r==2) return 0; // mutual dominace
continue;
}
r = pr_dominate(t2,at);
//error('d',"pr3 %d",r);
if (r==2) {
if (res && res!=n2) return 0; // mutual dominace
res = n2;
continue;
}
}
//if (a1==0 && a2 && a2->n_initializer==0) return 0; // wrong number of arguments
//if (a2==0 && a1 && a1->n_initializer==0) return 0; // wrong number of arguments
if (e) {
//error('d',"more args %t a1 %t a2 %t",e->e1->tp,a1?a1->tp:0,a2?a2->tp:0);
int k1 = f1->nargs_known!=ELLIPSIS;
int k2 = f2->nargs_known!=ELLIPSIS;
if (a1 && a1->tp->check(e->e1->tp,ASSIGN)==0) return n1;
if (a2 && a2->tp->check(e->e1->tp,ASSIGN)==0) return n2;
if (k1 && k2) return 0;
}
if (a1==0 && a2 && a2->n_initializer==0) return 0;
if (a2==0 && a1 && a1->n_initializer==0) return 0;
if (res==0)
if (const_obj) {
if (f1->f_const && f2->f_const==0) return n1;
if (f2->f_const && f1->f_const==0) return n2;
}
else {
if (f1->f_const==0 && f2->f_const) return n1;
if (f2->f_const==0 && f1->f_const) return n2;
}
//error('d'," -> %n %t",res,res?res->tp:0);
return res;
}
Pname Ntmp;
static refd; // initialization routine called by ref_init, do not apply itor
static no_sti;
extern int stat_init;
Pname make_tmp(char c, Ptype t, Ptable tbl)
{
int dt = 0;
Pname tn = tbl->t_name;
Pname cn = t->is_cl_obj();
if (tn && tn->tp) error('s',"defaultA too complicated");
if (cn && Pclass(cn->tp)->has_dtor()) dt = 1;
if (Ntmp == 0 && dt ) Ntmp = cn;
//error('d',"tbl %d cstmt %d %d sti %d",tbl,Cstmt,Cstmt?Cstmt->memtbl:0,sti_tbl);
if (Cstmt) { // make Cstmt into a block
if (Cstmt->memtbl == 0) Cstmt->memtbl = new table(4,tbl,0);
tbl = Cstmt->memtbl;
}
else if (tbl == gtbl && no_sti == 0) {
if (sti_tbl == 0) sti_tbl = new table(8,gtbl,0);
tbl = sti_tbl;
}
Pname tmpx = new name(make_name(c));
tmpx->where = no_where;
tmpx->tp = t;
(void) t->tsizeof();
if ( t->base == COBJ ) {
Pclass cl = Pclass(Pbase(t)->b_name->tp);
if ( cl->lex_level ) tmpx->lex_level = cl->lex_level;
}
TOK scop = ARG;
if (stat_init && dt) {
tmpx->n_sto = STATIC; scop = ARGS;
}
// ARG[S]: no init; ARGS: static dtor
Pname tmp = tmpx->dcl(tbl,scop);
delete tmpx;
// n_scope == ARGS sets static dtor in simpl2.c
tmp->n_scope = (scop==ARG) ? FCT : ARGS;
return tmp;
}
Pexpr init_tmp(Pname tmp, Pexpr init, Ptable tbl)
{
Pname cn = tmp->tp->is_cl_obj();
Pname ct = cn ? Pclass(cn->tp)->has_itor() : 0;
tmp->n_assigned_to = 1;
//error('d',"init_tmp %n ct %n refd %d",tmp,ct,refd);
if (ct) { // must initialize
if (refd) {
//error('d',"'orrible %k",init->e1->base);
switch (init->e1->base) { // 'orrible 'ack
case NAME:
case REF:
case DEREF:
if (init->e1->tp->is_ptr())
init = init->e1;
else
init = new expr(G_CM,init,init->e1->address());
}
if (ct->tp->base == OVERLOAD) ct = Pgen(ct->tp)->fct_list->f; // first fct
tbl = 0;
}
return call_ctor(tbl,tmp,ct,init,DOT);
}
Pexpr ass = new expr(ASSIGN,tmp,init); // no ctor: can assign
ass->tp = tmp->tp;
return ass;
}
/*
int exact0(Pname nn, Ptype at)
// return 1 if
// exact match
{
if (nn == 0) return 0; //known==ELLIPSIS;
Ptype nt = nn->tp;
if (at == nt) return 1;
//error('d',"exact0 %d",nt->check(at,0));
return nt->check(at,0)==0;
}
*/
int exact3(Pname nn, Ptype at)
/*
return 1 if
match with standard conversions
*/
{
if (nn == 0) return 0; //known==ELLIPSIS;
Ptype nt = nn->tp;
while(nt->base == TYPE)
nt = Pbase(nt)->b_name->tp;
if (at == nt) return 1;
switch (nt->base) {
case RPTR:
if (at==zero_type && Pptr(nt)->typ->is_ptr()==0) return 0; //break;
if (nt->check(at,COERCE)) {
Pptr pt = at->addrof();
nt->base = PTR; // handle derived classes
if (nt->check(pt,COERCE)) {
nt->base = RPTR;
delete pt;
return 0;
}
nt->base = RPTR;
delete pt;
}
break;
default:
switch (at->base) {
default:
if (nt->check(at,COERCE)) return 0;
break;
case OVERLOAD:
// the actual argument is an overloaded function
// we'll try each instance until one matches
register Plist gl;
int no_match = 1;
for (gl = Pgen(at)->fct_list; gl; gl=gl->l) {
if (nt->check(gl->f->tp,COERCE)==0) {
no_match = 0;
break;
}
}
if ( no_match ) return 0;
}
}
return 1;
}
int exact1(Pname nn, Ptype at)
/*
return 1 if
exact match with
T <-> const T
X -> X&
T* -> const T*
T* -> T*const
taken into account
*/
{
if (nn == 0) return 0;//known==ELLIPSIS;
Ptype nt = nn->tp;
if (at == nt) return 1;
//error('d',"exact1 nt %t at %t",nt,at);
if (nt->check(at,0)) {
//error('d',"nt %t at %t cp %d",nt,at,const_problem);
if (const_problem) return 1; // handle T <-> const T
Pptr rt = nt->is_ref(); //handle X -> X&
if (rt && (at->check(Pptr(rt)->typ,0)==0 || const_problem)) return 1;
Pptr art = at->is_ptr();
if (rt && art) return 0; // ptrs do not match refs
// handle T* -> const T* and
// T* -> T*const
if (rt || (rt = nt->is_ptr())) {
if (art == 0) art = at->is_ref();
if (art) {
//error('d',"art %t %t",art->typ,rt->typ);
if (art->typ->check(rt->typ,0)) {
if (const_problem) return 1;
}
else // T* -> T*const
return 1;
}
}
return 0;
}
return 1;
}
Pexpr Ninit; // default argument used;
int Nstd; // standard coercion used (derived* =>base* or int=>long or ...)
bit exact_match(Pname n, Pexpr arg)
/*
look for an exact match between "n" and the argument list "arg"
This function goes through three stages:
(1) exact match (no coercions at all)
(2) do integral promotions and float->double and re-try exact match
(3) try for unique standard conversions
*/
{
Pfct f = Pfct(n->tp);
register Pexpr e;
register Pname nn;
// error('d',"exact_match(%n) %t",n,n->tp);
for (e=arg, nn=f->argtype; e; e=e->e2, nn=nn->n_list) {
Pexpr a = e->e1;
Ptype at = a->tp;
if (at->base == ANY) return 0;
if (at->base == ZTYPE) at = int_type;
if (exact1(nn,at)==0) return 0;
}
//error('d',"exact %d -> %d",nn,nn?nn->n_initializer!=0:1);
if (nn) {
Ninit = nn->n_initializer;
return Ninit!=0;
}
//error('d',"return 1");
return 1; // exact match without any promotions
}
int exact2(Pname nn, Ptype at)
/*
return 1 if
do integral promotion and float->double on at, then match
*/
{
//error('d',"exact2 nt %t at %t",nn?nn->tp:0,at);
while(at->base == TYPE)
at = Pbase(at)->b_name->tp;
switch (at->base) {
case EOBJ:
at = Penum(Pbase(at)->b_name->tp)->e_type;
break;
case ZTYPE:
at = int_type;
break;
case CHAR:
case SHORT:
at = (Pbase(at)->b_unsigned && at->tsizeof()==SZ_INT) ? uint_type : int_type;
break;
case FLOAT:
at = double_type;
}
if (nn == 0) return 0;//known==ELLIPSIS;
Ptype nt = nn->tp;
//error('d'," exact2 nt %t at %t",nt,at);
if (at == nt) return 1;
if (nt->check(at,0)) {
if (const_problem) return 1;
Pptr rt = nt->is_ref(); // handle X -> X&
if (rt && (at->check(Pptr(rt)->typ,0)==0 || const_problem)) return 1;
Pptr art = at->is_ptr();
if (rt && art) return 0; // ptrs do not match refs
// handle T* -> const T* and
// T* -> T*const
if (rt || (rt = nt->is_ptr())) {
if (art == 0) art = at->is_ref();
if (art) {
if (art->typ->check(rt->typ,0)) {
if (const_problem) return 1;
}
else // T* -> T*const
return 1;
}
}
return 0;
}
return 1;
}
bit prom_match(Pname n, Pexpr arg)
/*
look for an exact match between "n" and the argument list "arg"
using integral promotions and float->double
*/
{
Pfct f = Pfct(n->tp);
register Pexpr e;
register Pname nn;
// error('d',"prom_match(%n) %t",n,n->tp);
for (e=arg, nn=f->argtype; e; e=e->e2, nn=nn->n_list) {
Pexpr a = e->e1;
Ptype at = a->tp;
if (at->base == ANY) return 0;
if (exact2(nn,at)==0) return 0;
}
if (nn) {
Ninit = nn->n_initializer;
return Ninit!=0;
}
return 1; // exact match with promotions
}
bit std_match(Pname n, Pexpr arg)
/*
look for an exact match between "n" and the argument list "arg"
using standard conversions
*/
{
Pfct f = Pfct(n->tp);
register Pexpr e;
register Pname nn;
// error('d',"std_match(%n) %t",n,n->tp);
for (e=arg, nn=f->argtype; e; e=e->e2, nn=nn->n_list) {
Pexpr a = e->e1;
Ptype at = a->tp;
if (at->base == ANY) return 0;
if ( exact3(nn,at) == 0) return 0;
}
if (nn) {
Ninit = nn->n_initializer;
return Ninit!=0;
}
return 1;
}
Pname Ncoerce;
int ref_cast;
bit can_coerce(Ptype t1, Ptype t2)
/* return number of possible coercions of t2 into t1,
Ncoerce holds a coercion function (not constructor), if found
*/
{
int zz = 0;
Ncoerce = 0;
if (t2->base == ANY) return 0;
// error('d',"can_coerce t1 %t t2 %t",t1, t2);
while(t1->base == TYPE)
t1 = Pbase(t1)->b_name->tp;
switch (t1->base) {
case RPTR:
while(t2->base == TYPE)
t2 = Pbase(t2)->b_name->tp;
switch (t2->base) {
// case VEC:
// case PTR:
// case RPTR:
// if (t1->check(t2,COERCE) == 0) return 1;
default:
{ Ptype tt2 = t2->addrof();
if (t1->check(tt2,COERCE) == 0) return 1;
if (ref_cast) break;//return 0; // (T&): no coercions
// except operator T&()
Ptype tt1 = Pptr(t1)->typ;
while (tt1->base==TYPE) tt1 = Pbase(tt1)->b_name->tp;
int bc;
if ( tt1->base != PTR && tt1->base != RPTR ) {
bc = Pbase(tt1)->b_const;
Pbase(tt1)->b_const = 0;
}
int i = can_coerce(tt1,t2);
if ( tt1->base != PTR && tt1->base != RPTR )
Pbase(tt1)->b_const = bc;
if (i) return i;
zz = 1;
}
}
}
Pname c1 = t1->is_cl_obj();
Pname c2 = t2->is_cl_obj();
int val = 0;
if (ref_cast || zz) goto oper_coerce;
if (c1) {
Pclass cl = Pclass(c1->tp);
if (c2 && c2->tp==cl) return 1;
// A more comprehensive test for template classes
if (c2 && (Pclass(c1->tp)->same_class(Pclass(c2->tp))))
return 1 ;
/* look for constructor
with one argument
or with default for second argument
of acceptable type
*/
Pname ctor = cl->has_ctor();
if (ctor == 0) goto oper_coerce;
register Pfct f = Pfct(ctor->tp);
//error('d',"ctor %n f %t",ctor,f);
switch (f->base) {
case FCT:
switch (f->nargs) {
case 1:
one:
{ Ptype tt = f->argtype->tp;
if (tt->check(t2,COERCE)==0)
val = 1;
else if (const_problem) {
Pptr p1 = tt->is_ptr_or_ref();
if (p1==0 || p1->typ->tconst()) val = 1;
}
if (tt = tt->is_ref()) {
Pptr pt = t2->addrof(); // handle derived classed
tt->base = PTR;
if (tt->check(pt,COERCE) == 0) val = 1;
tt->base = RPTR;
delete pt;
}
goto oper_coerce;
}
default:
if (f->argtype->n_list->n_initializer) goto one;
case 0:
goto oper_coerce;
}
case OVERLOAD:
{ register Plist gl;
for (gl=Pgen(f)->fct_list; gl; gl=gl->l) { // look for match
Pname nn = gl->f;
Pfct ff = Pfct(nn->tp);
switch (ff->nargs) {
case 0:
break;
case 1:
over_one:
{ Ptype tt = ff->argtype->tp;
//error('d',"over one %t %t -> %d %d",tt,t2,tt->check(t2,COERCE),const_problem);
if (tt->check(t2,COERCE)==0)
val = 1;
else if (const_problem) {
Pptr p1 = tt->is_ptr_or_ref();
if (p1==0 || p1->typ->tconst()) val = 1;
}
if (tt=tt->is_ref()) {
Pptr pt = t2->addrof(); // handle derived classed
tt->base = PTR;
if (tt->check(pt,COERCE) == 0) {
tt->base = RPTR;
delete pt;
val = 1;
goto oper_coerce;
}
tt->base = RPTR;
delete pt;
}
break;
}
default:
if (ff->argtype->n_list->n_initializer) goto over_one;
}
}
goto oper_coerce;
}
default:
error('i',"cannot_coerce(%k)\n",f->base);
}
}
oper_coerce:
//error('d',"oper_coerce %d",val);
if (c2) {
Pclass cl = Pclass(c2->tp);
int std = 0;
int oval = val;
extern Pname conv_dominates(Pname,Pname);
for (Pname ox, on=cl->conv; on; on=ox) {
ox = on->n_list;
// error( 'd', "can_coerce: ox: %s on: %s tp: %k", ox?ox->string:"", on->string, on->tp->base );
Plist gl = 0;
if ( on->tp->base == OVERLOAD ) {
gl = Pgen(on->tp)->fct_list;
on = gl->f;
gl = gl->l;
}
overlist:
// error( 'd', "can coerce: on: %n tp: %t gl: %d", on, on->tp, gl );
Pfct f = Pfct(on->tp);
Nstd = 0;
if (t1->check(f->returns,COERCE) == 0) {
if (Nstd==0) { // forget solutions involving standard conversions
Pname old = Ncoerce;
if (std) { // forget
val = oval+1;
std = 0;
Ncoerce = on;
}
else if (Ncoerce == 0) {
// val = 1;
val++;
Ncoerce = on;
}
else if ((Ncoerce = conv_dominates(Ncoerce,on))==0) {
if (val == 1) {
//error('d',"val==1 on %n old %n",on,old);
Ptype ton = Pfct(on->tp)->returns;
Ptype tco = Pfct(old->tp)->returns;
if (t1->check(ton,0)==0)
;
else if (t1->check(tco,0)==0)
on = old;
else
val++;
}
else
val++;
Ncoerce = on;
}
}
else { // take note only if no exact match seen
if (Ncoerce==0 || on->tp->check(Ncoerce->tp,0)) {
if (val==0 || std) {
if (Ncoerce) Ncoerce = conv_dominates(Ncoerce,on);
if (Ncoerce == 0) {
Ncoerce = on;
val++;
std = 1;
}
}
}
}
}
// error( 'd', "can_coerce: gl: %d", gl );
if ( gl ) {
on = gl->f;
gl = gl->l;
goto overlist; // must walk list of overloaded instances
}
}
}
//error('d',"val %d",val);
if (val) return val;
if (c1 && Pclass(c1->tp)->has_itor()) return 0;
//error('d',"%t->check(%t) -> %d",t1,t2,t1->check(t2,COERCE));
if (t1->check(t2,COERCE)) return 0;
return 1;
}
int gen_coerce(Pname n, Pexpr arg)
/*
look to see if the argument list "arg" can be coerced into a call of "n"
1: it can
0: it cannot or it can be done in more than one way
*/
{
Pfct f = (Pfct) n->tp;
register Pexpr e;
register Pname nn;
//error('d',"gen_coerce(%n,%d) %t",n,arg,n->tp);
for (e=arg, nn=f->argtype; e; e=e->e2, nn=nn->n_list) {
if (nn == 0) return f->nargs_known==ELLIPSIS;
Pexpr a = e->e1;
Ptype at = a->tp;
int i = can_coerce(nn->tp,at);
if (i != 1) return 0;
}
if (nn && nn->n_initializer==0) return 0;
return 1;
}
Pname Nover;
// int Nover_coerce;
int over_call(Pname n, Pexpr arg)
/*
return 4 if n(arg) can be performed without coercion of arg
return 3 if n(arg) can be performed only with promotion coercion of arg
return 2 if n(arg) can be performed only with standard coercion of arg
return 1 if n(arg) can be performed only with user defined coercion of arg
return 0 if n(arg) is an error
Nover is the function found, if any
Nstd is the number of standard coercions used
*/
{
register Plist gl;
Pgen g = Pgen(n->tp);
if (arg && arg->base!= ELIST) error('i',"ALX");
//error('d',"over_call(%n) %k",n,n->tp->base);
extern suppress_error;
suppress_error = 1;
// Nover_coerce = 0;
Nstd = 0;
switch (g->base) {
default: error('i',"over_call(%t)\n",g);
case OVERLOAD: break;
case FCT:
Nover = n;
Ninit = 0;
if (exact_match(n,arg)) {suppress_error = 0; return 4;}
if (prom_match(n,arg)) {suppress_error = 0; return 3;}
if (std_match(n,arg) && Ninit==0) {suppress_error = 0; return 2;}
Nstd = 0;
suppress_error = 0;
return gen_coerce(n,arg);
}
Pname exact = 0;
int no_exact = 0;
int ret = 0;
Pname nret;
for (gl=g->fct_list; gl; gl=gl->l) { /* look for match */
Nover = gl->f;
Ninit = 0;
Nstd = 0;
if (exact_match(Nover,arg)) {suppress_error = 0; return 4;} // no coercion
// if (prom_match(Nover,arg)) return 3; // only promotion
// if (std_match(Nover,arg) && Ninit==0) return 2; // only built-in conversion
if (ret<3 && prom_match(Nover,arg)) {
nret = Nover;
ret = 3;
}
if (ret<2 && std_match(Nover,arg) && Ninit==0) {
nret = Nover;
ret = 2;
}
}
suppress_error = 0;
if (ret) {
Nover = nret;
return ret;
}
Nover = 0;
for (gl=g->fct_list; gl; gl=gl->l) { /* look for coercion */
Pname nn = gl->f;
if (gen_coerce(nn,arg)) {
Nover = nn;
return 1;
}
}
return 0;
}
Ptype expr::call_fct(Ptable tbl)
/*
check "this" call:
e1(e2)
e1->typ() and e2->typ() has been done
*/
{
Pfct f;
Pname fn;
int x;
int k;
Pname nn;
Pexpr e;
Ptype t;
Pexpr arg = e2;
Ptype t1 = e1?e1->tp:0;
int argno;
Pexpr etail = 0;
bit no_change = 0;
Pname no_virt = 0; // set if explicit qualifier was used: c::f()
Pname chk = 0; // set if visibility check is needed
// that is if function name might have been
// found without use of find_name()
int const_obj = 0;
if (t1 == any_type) return any_type;
switch (base) {
case CALL:
case G_CALL: break;
default: error('i',"call_fct(%k)",base);
}
// error('d',"call %d %k %n arg %d",this,e1->base,e1->base==NAME?e1:0,arg);
if (t1 == 0) error('i',"call_fct(e1=%d,e1->tp=%t)",e1,t1);
if (arg && arg->base!=ELIST) error('i',"badAL%d%k",arg,arg->base);
switch (e1->base) {
case NAME:
fn = Pname(e1);
//error('d',"name %n %k",fn,fn->n_oper);
switch (fn->n_oper) {
case 0:
case CTOR:
case DTOR:
case TYPE:
case NEW:
case DELETE:
break;
default: // real operator: check for operator+(1,2);
if (arg == 0) break;
Pexpr a = arg->e1; // first operand
if (Pfct(fn->tp)->memof // obj.operator(1) is OK
|| a->tp->is_cl_obj()
|| a->tp->is_ref()) break;
a = arg->e2;
if (a == 0) // unary
error("%k of basicT",fn->n_oper);
else { // binary
a = a->e1; // second operand
if (a->tp->is_cl_obj() || a->tp->is_ref()) break;
error("%k of basicTs",fn->n_oper);
}
break;
}
break;
case REF:
case DOT:
no_virt = Pname(e1->n_initializer);
e1->n_initializer = 0;
if (e1 && e1->e1) {
Ptype t = e1->e1->tp;
Pptr tt = t->is_ptr_or_ref();
Ptype ft = tt ? tt->typ : t;
Pexpr ee = e1->e1;
const_obj = ft->tconst();
while (ee && (ee->base==DOT || ee->base==REF)) {
Pexpr m = ee->mem;
if ( ee->base==REF && m->tp && m->tp->is_ptr())
break;
ee = ee->e1;
}
if (ee) {
Ptype ttt = ee->tp;
int tc;
switch (e1->base) {
case REF:
Pptr p = ttt?ttt->is_ptr():0;
if (p && p->typ->tconst())
const_obj = 1;
break;
case DOT:
tc = ttt ? ttt->tconst() : 0;
if(ttt && tc && (!strict_opt || tc!=2))
const_obj = 1;
}
}
}
case MDOT:
{ Pexpr n = e1->mem;
lxlx:
switch (n->base) {
case MDOT:
// reverse mdot (see expr::print())
// p->a.b() => (&p->a)->b() => b(&p->a)
// or p->a->b() => (p->a)->b() => b(p->a)
// or oo.a.b() => (&oo.a)->b() => b(&oo.a)
// or oo.a->b() => (oo.a)->b() => b(oo.a)
{
Pexpr r = e1;
Pexpr p = r->e1;
for (Pexpr m = r->mem; m->base==MDOT; m = r->mem) {
p = new mdot(m->string2,p);
p->i1 = m->i1+2;
p->tp = p->mem->tp;
r->mem = m->mem;
r->e1 = p;
}
}
case REF:
case DOT:
n = n->mem;
goto lxlx;
case NAME:
break;
default:
error('i',"ref %k",n->base);
}
fn = Pname(n);
//error('d',"mem %n",fn);
break;
}
case MEMPTR:
default:
fn = 0;
};
lll:
//error('d',"lll: %t %k",t1,t1->base);
switch (t1->base) {
case TYPE:
t1 = Pbase(t1)->b_name->tp;
goto lll;
case PTR: // pf() allowed as shorthand for (*pf)()
switch (Pptr(t1)->typ->base) {
case FCT:
case OVERLOAD:
if (Pptr(t1)->memof) error("O missing in call throughP toMF");
t1 = Pptr(t1)->typ;
fn = 0;
goto lll;
}
default:
if (fn)
error("call of%n;%n is a%t",fn,fn,e1->tp);
else
error("call of%kE ofT%t",e1->base,e1->tp);
case ANY:
return any_type;
case OVERLOAD:
{ register Plist gl;
Pgen g = Pgen(t1);
Pname found = 0;
Pname exact = 0;
int no_exact = 0;
int no_gen = 0;
for (gl=g->fct_list; gl; gl=gl->l) { // look for exact match
register Pname nn = gl->f;
if (exact_match(nn,arg)) {
//error('d',"found exact %n %t",nn,nn->tp);
if (found) {
// check if one fct dominates the other
Pname d = dominate(found,nn,arg,const_obj,0);
if (d)
nn = d;
else
error("two exact matches for%n:%t and%t",nn,nn->tp,found->tp);
}
found = nn;
}
}
//error('d',"found exact2 %n",found);
if (found) goto fnd;
Pname mvec[20];
/****************************************************************************
the next 2 loops have been commented out to eliminate the rule that calls
requiring only promotions and standard conversions are preferred over
calls requiring user-defined conversions.
for (gl=g->fct_list; gl; gl=gl->l) { // look for exact match
register Pname nn = gl->f;
if (prom_match(nn,arg)) {
if (found) {
// check if one fct dominates the other
Pname d = dominate(found,nn,arg,const_obj,1);
if (d)
nn = d;
else
error("two exact matches (after integral promotions) for%n:%t and%t",nn,nn->tp,found->tp);
}
found = nn;
}
}
//error('d',"found exact2 %n",found);
if (found) goto fnd;
// for (gl=g->fct_list; gl; gl=gl->l) { // look for exact match
// register Pname nn = gl->f;
//
// if (exact_match(nn,arg) || prom_match(nn,arg)) {
// found = nn;
// goto fnd;
// }
// }
for (gl=g->fct_list; gl; gl=gl->l) { // look for match
// with standard conversion
register Pname nn = gl->f;
Ninit = 0;
Nstd = 0;
if (std_match(nn,arg)) {
// if (Nstd == 0) {
// found = nn;
// goto fnd;
// }
if (exact) {
// check if one fct dominates the other
Pname d = dominate(exact,nn,arg,const_obj,2);
if (d == 0) {
mvec[no_exact++] = nn;
// no_exact++;
// error("two standard conversions possible for%n: %t and %t",fn,exact->tp,nn->tp);
}
else
exact = d;
}
else
exact = nn;
}
}
//error('d',"excact %n",exact);
if (exact) {
if (no_exact) {
while (no_exact) {
Pname d = dominate(exact,mvec[--no_exact],arg,const_obj,2);
if (d)
exact = d;
else
error("two standard conversions possible for%n: %t and %t",fn,exact->tp,mvec[no_exact]->tp);
}
}
//error('d',"found exact3 %n",found);
found = exact;
goto fnd;
}
this is the end of the commented out section.
************************************************************************/
for (gl=g->fct_list; gl; gl=gl->l) { /* look for coercion */
register Pname nn = gl->f;
if (prom_match(nn,arg) ||
std_match(nn,arg) ||
gen_coerce(nn,arg)) {
//error('d',"user2 %n %t",nn,nn->tp);
if (found) {
// check if one fct dominates the other
Pname d = dominate(found,nn,arg,const_obj,3);
//error('d',"dom d %d",d);
if (d == 0) d = user_dominate(found,nn,arg);
if (d == 0) {
mvec[no_gen++] = nn;
}
else
found = d;
}
else
found = nn;
}
}
if(found) {
while(no_gen) {
Pname d = dominate(found,mvec[--no_gen],arg,const_obj,3);
if(d==0) d = user_dominate(found,mvec[no_gen],arg);
if(d)
found = d;
else {
//error("ambiguousA for%n: %t and %t",fn,found->tp,mvec[no_gen]->tp);
error("ambiguous call of%n: %t and %t",fn,found->tp,mvec[no_gen]->tp);
}
}
}
fnd:
//error('d',"fnd %t",found?found->tp:0);
if (found) {
overFound = chk = fn = found;
f = Pfct(fn->tp);
}
else {
error("badAL for%n (no match against any %n)",fn,fn);
return any_type;
}
break;
}
case FCT:
f = Pfct(t1);
if (fn) {
switch (fn->n_oper) {
case CTOR:
case TYPE:
chk = fn;
}
}
}
//error('d',"chk %n",chk);
if (chk) {
Ptype t = 0;
Pexpr ee = e1->e1;
switch (e1->base) {
case REF: // ptr->chk()
if (ee == 0) { // 0->x() fudge handling new x()
check_visibility(chk,no_virt,Pclass(chk->n_table->t_name->tp),tbl,cc->nof);
break;
};
t = ee->tp;
while(t->base==TYPE) t = Pbase(t)->b_name->tp;
t = Pptr(t)->typ;
break;
case DOT: // obj.chk()
t = ee->tp;
}
Pname cn = t?t->is_cl_obj():0;
Pclass cl = cn?Pclass(cn->tp):0; // class of ``this'' for chk
if (cl) {
if (chk->n_oper==CTOR
&& chk->n_protect
&& cc->nof
&& cc->nof->n_oper==CTOR)
// BUG: cannot handle protected base
// class constructor
;
else {
check_visibility(chk,no_virt,cl,tbl,cc->nof);
}
}
}
if (fn && f->returns->is_cl_obj() && f->f_result==0) {
// protect against class cn; cn f(); ... class cn { cn(cn&); ... };
make_res(f);
//error('d',"returns %t",f->returns);
f->returns->tsizeof(); // make sure it is declared
}
//error('d',"fn %n %t printed %d",fn,fn?fn->tp:0,fn?fn->n_dcl_printed:0);
if (fn && fn->n_dcl_printed==0) {
if (f->f_inline==0 && f->f_imeasure) {
extern void uninline(Pname fn);
uninline(fn);
}
// ensure printout of class declaration:
for (Pname nn=f->argtype; nn; nn=nn->n_list)
if (nn->tp->is_cl_obj()) (void) nn->tp->tsizeof();
fn->dcl_print(0);
}
if (no_virt && f->f_static==0) {
if (e1->base==REF || e1->base==DOT) e1->n_initializer = fn;
}
else
fct_name = fn;
//error('d',"fn %n %t %d %d",fn,f,f->f_this,f->f_static);
if (f->f_this) { //SSS call of non-static memberfunction
switch (e1->base) {
case MEMPTR:
case REF:
case DOT:
break;
default:
error("O orP missing for%n ofT %t",fct_name,f);
}
}
else if (fn) { //SSS call of static function
sss:
switch (e1->base) {
case REF:
case DOT:
e1 = e1->mem;
goto sss;
}
}
if (fn) fn->use(); // a patch: ctors are sometimes not use()d
if (f->f_const==0
&& (fn==0 || (fn->n_oper!=CTOR && fn->n_oper!=DTOR))) { //CCC
Pexpr ee = e1->e1;
// while (ee && (ee->base==DOT || ee->base==REF)) ee = ee->e1;
while (ee && (ee->base==DOT || ee->base==REF)) {
Pexpr m = ee->mem;
// error('d', "m: %k tp %t", m?m->base:0, m?m->tp:0 );
if ( ee->base==REF && m->tp && m->tp->is_ptr())
break;
ee = ee->e1;
}
// error('d', "ee: %k tp %k", ee?ee->base:0, ee?ee->tp->base:0);
if (ee) {
Ptype tt = ee->tp;
switch (e1->base) {
case REF:
{ Pptr p = tt?tt->is_ptr():0;
if (p && p->typ->tconst())
error(strict_opt?0:'w',"non-constMF%n called for constO (anachronism)",fn);
// is really an error, but only warn to help transition
break;
}
case DOT:
int tc = tt ? tt->tconst() : 0;
if (tt && tc && (!strict_opt || tc!=2))
error(strict_opt?0:'w',"non-constMF%n called for constO (anachronism)",fn);
// is really an error, but only warn to help transition
}
}
}
t = f->returns;
x = f->nargs;
k = f->nargs_known;
e = arg;
if (k == 0) goto rlab;
for (nn=f->argtype, argno=1; e||nn; nn=nn->n_list, e=etail->e2, argno++) {
Pexpr a;
int save_base = 0;
char* save_name = 0;
if (e) {
a = e->e1;
etail = e;
if (nn) { /* type check */
Ptype t1 = nn->tp;
//error('d',"argtp %t etp %t a %k",t1,a->tp,a->base);
while(t1->base == TYPE)
t1 = Pbase(t1)->b_name->tp;
switch (t1->base) {
case RPTR:
{ Ptype pt = Pptr(t1)->typ;
if (pt->base != FCT ||
( pt->base == FCT &&
pt->check(a->tp,0)))
a = ref_init(Pptr(nn->tp),a,tbl);
goto cbcb;
}
case COBJ:
if (a->base!=G_CM
|| nn->tp->check(a->tp,ASSIGN))
a = class_init(0,t1,a,tbl);
else
a->e2=class_init(0,t1,a->e2,tbl);
if (nn->n_xref) {
// (temp.ctor(arg),&arg)
a = a->address();
}
else {
// defend against:
// int f(X); ... X(X&);
Pname cln = Pbase(t1)->b_name;
if (cln && Pclass(cln->tp)->has_itor()) {
// mark X(X&) arguments
nn->n_xref = 1;
a = a->address();
}
}
cbcb:
//error('d',"cbcb: a %d %k %t",a->base,a->base,a->tp);
if (a->base==G_CM) {
if (a->e1->base==DEREF) a->e1 = a->e1->e2; // (*e1,e2) => (e1,e2)
//error('d'," a %d %k",a->e1->base,a->e1->base);
if (a->e1->base==G_CALL
&& Pname(a->e1->fct_name)
&& Pname(a->e1->fct_name)->n_oper==CTOR
&& (a->e2->base==G_ADDROF || a->e2->base==ADDROF)) {
a = a->e1; // (ctor(&tmp),&tmp) => ctor(&tmp)
//error('d',"tmp %k %n",a->e2->base,a->e2->e2);
goto cccc;
}
else if (a->e2->base==G_ADDROF
&& a->e2->e2->base==NAME) {
cccc:
//error('d',"cccc: a %d %k %t",a->base,a->base,a->tp);
if (t1->base==RPTR
&& Pptr(t1)->typ->tconst()==0) { // temporary used
if (warning_opt)
error('w',"temporary used for non-const%tA",nn->tp);
else {
Ptype atp = a->tp;
if (atp==void_type
&& a->base==G_CALL
&& a->e1->tp->base==FCT)
atp = Pfct(a->e1->tp)->s_returns;
Ptype tt = t1->is_ref();
//error('d',"tt %t atp %t",tt,atp);
if (tt) {
if (Pptr(tt)->typ->tsizeof()!=atp->tsizeof()) { // sliced
Ptype aat = atp->is_ptr_or_ref();
if (aat==0
|| Pptr(tt)->typ->tsizeof()!=Pptr(aat)->typ->tsizeof())
error('w',"temporary used for non-const%tA",nn->tp);
}
}
else if (t1->tsizeof()!=atp->tsizeof()) // sliced
error('w',"temporary used for non-const%tA",nn->tp);
}
// if (warning_opt // blabber
// || t1->tsizeof()!=a->tp->tsizeof())) // sliced
// error('w',"temporary used for non-const%tA",nn->tp);
}
}
}
e->e1 = a;
break;
case ANY:
goto rlab;
case PTR:
{
save_base = e->e1->base;
if(a->tp->base==OVERLOAD)
save_name = Pgen(a->tp)->fct_list->f->string;
Pexpr te_a = a;
e->e1 = a = ptr_init(Pptr(t1),a,tbl);
no_change = (te_a == a);
// if (x==a || x==a->e2) goto def; // needs checking
if (Pchecked == 0) goto def;
break;
}
// e->e1 = a = ptr_init(Pptr(t1),a,tbl);
// goto def;
case CHAR:
case SHORT:
case INT:
// if (a->base==ICON && a->tp==long_type)
// error('w',"long constantA for%n,%kX",fn,t1->base);
{ Ptype t = a->tp;
while(t->base == TYPE)
t = Pbase(t)->b_name->tp;
switch (t->base) {
case LONG:
case FLOAT:
case DOUBLE:
case LDOUBLE:
error('w',"A%d: %t passed as %t",argno,a->tp,t1);
}
}
// no break
case LONG:
if (Pbase(t1)->b_unsigned
&& a->base==UMINUS
&& a->e2->base==ICON)
error('w',"negativeA for%n, unsignedX",fn);
default:
def:
{ Pexpr x = try_to_coerce(t1,a,"argument",tbl);
//error('d',"x %d t1 %t nn %t a1 %t",x,t1,nn->tp,a->tp);
if (x) {
if (Pchecked == 0 && no_change) {
Pexpr te_x = ptr_init(Pptr(t1), x, tbl);
if ( te_x != x ) e->e1 = a = te_x; else e->e1=x;
}
else
e->e1 = x;
}
else if (nn->tp->check(a->tp,ARG)) {
error("badA %dT for%n:%t (%tX)",argno,fn,a->tp,nn->tp);
return any_type;
}
}
}
Pexpr tt = e->e1;
while ( tt->base == CAST )
tt = tt->e1;
if ( tt->base == ILIST )
e->e1 = tt;
if (e->e1->base == ILIST) {
// memptr constant
// f({1,2,f}) ==> memptr t; f((t={1,2,f},t))
if(save_base == REF) {
Pptr m = Pptr(a->tp);
error(strict_opt?0:'w',
"address of boundF (try using ``%s::*'' forPT and ``&%s::%s'' for address) (anachronism)",
m->memof->string,
m->memof->string,
save_name
);
}
Pname temp = make_tmp('A',mptr_type,tbl);
e->e1 = mptr_assign(temp,e->e1);
e->e1 = a = new expr(G_CM,e->e1,temp);
a->tp = temp->tp;
}
}
else {
if (k != ELLIPSIS) {
error("unexpected %dA for%n",argno,fn);
return any_type;
}
Pexpr te=e;
while(e) {
if (e->e1->base == ILIST) {
// memptr constant
// f({1,2,f}) ==> memptr t; f((t={1,2,f},t))
Pname temp = make_tmp('A',mptr_type,tbl);
e->e1 = mptr_assign(temp,e->e1);
e->e1 = a = new expr(G_CM,e->e1,temp);
a->tp = temp->tp;
}
e = e->e2;
}
e = te;
goto rlab;
}
}
else { /* default argument? */
a = nn->n_initializer;
if (a == 0) {
error("A %d ofT%tX for%n",argno,nn->tp,fn);
return any_type;
}
if (a->base == ILIST) {
// memptr constant
// f({1,2,f}) ==> memptr t; f((t={1,2,f},t))
Pname temp = make_tmp('A',mptr_type,tbl);
a = mptr_assign(temp,a);
a = new expr(G_CM,a,temp);
a->tp = temp->tp;
}
a->permanent = 2; // ought not be necessary, but it is
e = new expr(ELIST,a,0);
if (etail)
etail->e2 = e;
else
e2 = e;
etail = e;
}
}
rlab:
//error('d',"rlab fct_name %n %t",fct_name,fct_name?fct_name->tp:0);
for (; e; e = e->e2) { // unchecked arguments
Pexpr a = e->e1;
Pname cn;
if (a->base==NAME && a->tp->base==FCT) {
// function name that escaped the type system:
// update use count
a->lval(ADDROF);
}
else if (warning_opt && (cn = a->tp->is_cl_obj())) {
Pclass cl = Pclass(cn->tp);
if (cl->has_ctor() || cl->memtbl->look("__as",0))//cl->has_oper(ASSIGN)
{
if (fct_name)
error('w',"O ofC%t withK or = copied asA to%n (%t)",cl,fct_name,fct_name->tp);
else
error('w',"O ofC%t withK or = copied asA to `...'",cl);
}
}
else if (a->tp->is_ref())
e->e1 = a->contents();
}
if (f->f_result) { // f(args) => (f(&temp,args),temp)
Pname tn = make_tmp('R',f->returns,tbl);
e2 = new expr(ELIST,tn->address(),e2);
// error('d',"result %n refd: %d",fn, refd);
Pexpr ee = new expr(0,0,0);
*ee = *this;
base = G_CM; // (f(&temp,args),temp)
e1 = ee;
if (refd == 2)
e2 = tn->address();
else e2 = tn;
tp = tn->tp;
}
return t;
}
int cm_const_save;
Pexpr ref_init(Pptr p, Pexpr init, Ptable tbl)
/*
initialize the "p" with the "init"
remember to call ptr_init to ensure that pointers to second bases
are handled correctly.
*/
{
register Ptype it = init->tp;
Pptr px = p;
while (px->base == TYPE) px = Pptr(Pbase(px)->b_name->tp);
Ptype p1 = px->typ;
Pname c1 = p1->is_cl_obj();
// error('d',"ref_init: p %t, p1 %t, px %t, init->tp %t",p,p1,px,it);
// error('d', "ref_init: nof: %n f_const: %d", cc?cc->nof:0, cc?(cc->nof?Pfct(cc->nof->tp)->f_const:0):0);
if (init->base == ILIST) error("IrL as RIr");
if (init->base==NAME
&& Pname(init)->n_scope==ARG
&& init->tp->base==FLOAT)
error('w',"initializing a float& with floatA is non-portable");
while(it->base == TYPE)
it = Pbase(it)->b_name->tp;
switch (it->base) {
default:
{ Ptype tt = it->addrof();
px->base = PTR; // allow &x for y& when y : public x
// but not &char for int&
int x = px->check(tt,COERCE);
if (x == 0) { //CCC type is fine check for constness:
if (init->tp->tconst()
&& vec_const==0
&& fct_const==0) {
// not ``it''
if (init->base == ELIST) init = init->e1;
if (px->typ->tconst() == 0) error("R to constO");
px->base = RPTR;
// if we have a const lvalue we can still pass its address
ignore_const++;
if (init->lval(0)) {
init->lval(ADDROF); // force output
ignore_const--;
//error('d',"in1 %t",init->tp);
return ptr_init(px,init->address(),tbl);//return init->address();
}
ignore_const--;
goto xxx;
}
px->base = RPTR;
if (init->lval(0)) { // can pass the address // no temporary needed
init->lval(ADDROF); // force output
//error('d',"px %t init %t init %t",px,init->tp,init->tp);
return ptr_init(px,init->address(),tbl);
}
goto xxx;
}
px->base = RPTR;
}
}
//error('d',"c1 %n",c1);
if (c1) { // assigning to a const X & is fine
ref_cast++;
Pexpr x = try_to_coerce(p,init,"reference initialization",tbl);
ref_cast--;
if (x) {
init = x;
goto xxx;
}
while (p1->base==TYPE) p1 = Pbase(p1)->b_name->tp;
int bc = Pbase(p1)->b_const;
Pbase(p1)->b_const = 0;
// refd = 1;
switch ( init->base ) {
case STRING: case ZERO: case CCON:
case ICON: case FCON: case IVAL:
case NAME:
refd = 1;
break;
default:
refd = (init->e1 && init->e1->base == NAME &&
init->e1->tp->base != RPTR &&
Pname(init->e1)->n_xref == 0) ? 2: 1;
break;
}
// error('d', "***** refd: %d", refd );
Pexpr a = class_init(0,p1,init,tbl);
Pbase(p1)->b_const = bc;
refd = 0;
if (a==init && init->tp!=any_type) goto xxx;
// error('d',"ri a %d %k",a->base,a->base);
switch (a->base) {
case G_CALL:
// case CM:
// case G_CM:
init = a;
goto xxx;
}
a = a->address();
a = ptr_init(px,a,tbl);
return a;
// return ptr_init(px,a->address(),tbl);//a->address();
}
//error('d',"p1 %t it %t",p1,it);
if (p1->check(it,0)) {
if (p1->check(it,ASSIGN) == 0) {
// if (p1->is_ptr()) // check for base* = derived*
// goto xxx;
// things like ``double& rr = 1;'' temporary needed
// warn in case of ``slightly wrong lvalue'', e.g.
// int i; double& r = i;
if (init->lval(0) && p1->tconst()==0)
error('w',"temporary used toIR; no changes will be propagated to actualA");
goto def;
}
Pexpr x = try_to_coerce(p1,init,"reference",tbl); // x==init
if (x==0) x = try_to_coerce(px,init,"reference",tbl); // x&=init
if (x) {
init = x;
goto def;
}
error("badIrT:%t (%tX)",it,p);
if (init->base != NAME) init->tp = any_type;
return init;
}
xxx: /*
here comes the test of a ``fundamental theorem'':
a structure valued expression is
(1) an lvalue of type T (possibly const)
or (2) the result of a function (a _result if X(X&) is defined)
or (3) a * or [] or ? or , expression
*/
//error('d',"xxx %k %d %t",init->base,init->base,init->tp);
switch (init->base) {
case NAME:
case DEREF:
case REF:
case DOT: // init => &init
if (it->tconst() && vec_const==0 && fct_const==0) goto def;
if ( cc && cc->nof &&
Pfct(cc->nof->tp)->f_const )
cm_const_save = Pbase(p->typ)->b_const;
init->lval(ADDROF);
cm_const_save = 0;
if (vec_const) return init;
if (fct_const && p1->is_ptr()) goto def; // fptr& = fct
// no break
case CM:
case G_CM: // & (f(&temp), temp)
return ptr_init(px,init->address(),tbl);//init->address();
default:
def:
{
// error('d',"def: init->tp %t p1 %t ",init->tp,p1);
// error('d',"p1: %t const_ptr: %d", p1, const_ptr);
if (const_ptr == 0) {
if (tbl == gtbl || strict_opt)
error("Ir for%snon-constR not an lvalue", strict_opt?"":" global ");
else
if (warning_opt)
error('w', "Ir for non-constR not an lvalue (anachronism)");
}
Pname tcl = p1->is_cl_obj ();
if(tcl && Pclass(tcl->tp)->c_abstract)
error("a temporary is needed for a parameter, but the argument type is abstract class %t.", tcl->tp);
Pname n = make_tmp('I',p1,tbl);
Pexpr a;
Pname ic = init->tp->is_cl_obj();
if (p1->tconst()==0
&& (init->tp->tconst() && vec_const==0 && fct_const==0)
&& p1->check(it,ASSIGN)==0)
error('w',"constIr: temporary used toI reference");
switch (p1->base) {
case INT:
case CHAR:
case SHORT:
switch (it->base) {
case LONG:
case FLOAT:
case DOUBLE:
case LDOUBLE:
error('w',"%t assigned to %t inRIr",it,p1);
}
}
if (ic!=c1 && Pclass(ic->tp) != Pclass(c1->tp)) {
// derived class1 => must cast: ``it Ix; (Ix=init,(p)&Ix);''
n->tp = init->tp;
a = ptr_init(px,n->address(),tbl);//n->address();
PERM(p);
a = new texpr(CAST,p,a);
a->tp = p;
}
else
a = n->address();
refd = 1;
Pexpr as = init_tmp(n,init,tbl);
refd = 0;
a = new expr(G_CM,as,a);
a->tp = a->e2->tp;
return a;
}
}
}
Pexpr class_init(Pexpr nn, Ptype tt, Pexpr init, Ptable tbl)
/*
initialize "nn" of type "tt" with "init"
if nn==0 make a temporary,
nn may not be a name
*/
{
if (init == dummy) return 0;
//error('d',"class_init %t with %t init %k refd %d",tt,init->tp,init->base,refd);
Pname c1 = tt->is_cl_obj();
if (init == 0) {
error("emptyIr");
return dummy;
}
if (c1) {
Pclass cl = Pclass(c1->tp);
Pname c2 = init->tp->is_cl_obj();
if (c1!=c2 || (refd==0 && cl->has_itor())) {
/* really ought to make a temp if refd,
but ref_init can do that
*/
int i = can_coerce(tt,init->tp);
//error('d',"i %d nn %n",i,nn);
switch (i) {
default:
error("%d ways of making a%n from a%t",i,c1,init->tp);
init->tp = any_type;
return init;
case 0:
if (c2 && Pclass(c2->tp)->has_base(cl)) {
init = init->address();
Pexpr x = cast_cptr(cl,init,tbl,0);
if (x == init) {
Ptype pt = tt->addrof();
PERM(pt);
x = new cast(pt,init);
}
return x->contents();
}
error("cannot make a%n from a%t",c1,init->tp);
init->tp = any_type;
return init;
case 1:
//error('d',"ncoerce %n %k %d",Ncoerce,init->base,init->base);
if (Ncoerce == 0) {
Pexpr a = new expr(ELIST,init,0);
a = new texpr(VALUE,tt,a);
a->e2 = nn;
// return a->typ(tbl);
a = a->typ(tbl);
//error('d',"ci a %k %d %t",a->base,a->base,a->tp);
return a;
}
switch (init->base) {
case CM:
case G_CM: //ddd
case NAME: /* init.coerce() */
/* *ref */ case DEREF:
{ Pref r = new ref(DOT,init,Ncoerce);
Pexpr rr = r->typ(tbl);
init = new expr(G_CALL,rr,0);
init->fct_name = Ncoerce;
break;
}
default: // (temp=init,temp.coerce())
{ Pname tmp = make_tmp('U',init->tp,tbl);
int x = refd;
refd = 0; // ??
Pexpr ass = init_tmp(tmp,init,tbl);
refd = x;
Pref r = new ref(DOT,tmp,Ncoerce);
Pexpr rr = r->typ(tbl);
Pexpr c = new expr(G_CALL,rr,0);
c->fct_name = Ncoerce;
c = c->typ(tbl);
init = new expr(CM,ass,c);
init->tp = c->tp;
if (refd) { // &f() => (t=f(), &t)
Pname tmp2 = make_tmp('L',c->tp,tbl);
ass = init_tmp(tmp2,init,tbl);
init = new expr(G_CM,ass,tmp2);
}
}
}
//error('d',"nn %n",nn);
if (nn) {
Pexpr a = new expr(ELIST,init,0);
a = new texpr(VALUE,tt,a);
a->e2 = nn;
return a->typ(tbl);
}
}
//error('d',"c1 %n c2 %n",c1,c2);
return init->typ(tbl);
}
return init;
}
//error('d',"ci check tt %t init->tp %t",tt,init->tp);
if (tt->check(init->tp,ASSIGN) && refd==0) {
error("badIrT:%t (%tX)",init->tp,tt);
init->tp = any_type;
}
return init;
}
extern int bound; // fudge for bound pointers to functions
Pexpr expr::docast(Ptable tbl)
{
// check cast against value, INCOMPLETE
//error('d',"docast %d %t %k",this,tp2,e1->base);
if (e1 == dummy) {
error("E missing for cast");
tp = any_type;
return this;
}
int pmf = 0;
int ptom_cast = 0;
Pexpr ee = e1;
//error('d',"ee %k %d",ee->base,ee->base);
switch (ee->base) {
case ADDROF:
ee = ee->e2;
switch (ee->base) {
case NAME: goto nm;
case REF: goto rf;
}
break;
case NAME:
nm:
if (Pname(ee)->n_qualifier) pmf = 1;
break;
case REF:
rf:
if (ee->e1->base == THIS) bound = 1;
break;
}
e1 = e1->typ(tbl);
int b = bound; // distinguish between explicit and implicit THIS
bound = 0;
pmf = pmf && e1->base==CAST;
Ptype etp = e1->tp;
Ptype tt = tp2;
Ptype t = tt;
tt->dcl(tbl);
while (etp->base == TYPE) etp = Pbase(etp)->b_name->tp;
while (tt->base == TYPE) tt = Pbase(tt)->b_name->tp;
//error('d',"e1 %k etp %t tt %t",e1->base,etp,tt);
switch (etp->base) {
case PTR:
case RPTR:
if (Pptr(etp)->typ->base == OVERLOAD) goto over;
if (warning_opt && i2==0 && Pptr(etp)->typ->tconst()) {
switch (tt->base) {
case FCT:
break;
case PTR:
case RPTR:
if (Pptr(tt)->typ->tconst()) break;
default:
// casting away const
// should be an error
// but ANSI says OK so I chicken out
// to be able to compile strtok(), etc.
error('w',"const cast away:%t->%t",e1->tp,tp2);
}
}
else
i2 = 0; // to allow cfront to escape its own checking
break;
case COBJ:
{ ref_cast = 1;
Pexpr x = try_to_coerce(tt,e1,"cast",tbl);
ref_cast = 0;
//error('d',"x %k %t tt %d %t",x?x->base:0,x?x->tp:0,tt,tt);
if (x) {
if (x!=e1 && x->base==DEREF && tt->is_ref()) x = x->e1;
if (tt==x->tp || tt->check(x->tp,0)==0 || const_problem)
return x;
else
return new cast(tt,x);
}
// else if (e1->base==DEREF && tt->is_ref()) return e1;
break;
}
case VOID:
if (tt->base == VOID) {
tp = t;
return this;
}
error("cast of void value");
// no break;
case ANY:
any:
tp = any_type;
return this;
case FCT:
if (tt->base == PTR && Pptr(tt)->typ->base != FCT)
error('w',"P toF cast toP to nonF");
break;
case OVERLOAD:
over:
error("cast of overloaded");
goto any;
}
//error('d',"tt %t",tt);
switch (tt->base) {
case PTR:
if (Pptr(tt)->typ->base==FCT && Pptr(tt)->memof) {
if (etp->base!=PTR
|| Pptr(etp)->typ->base!=FCT
|| Pptr(etp)->memof==0)
error("cast toP toM %t",tt);
else { // adjust delta in MI case
// for the moment just suppress the cast
// all pmfs are the same to cc
/*
Pclass c1 = Pptr(tt)->memof;
Pclass c2 = Pptr(etp)->memof;
*/
ptom_cast = 1;
tp2 = void_type;
}
}
switch (etp->base) {
case COBJ:
error("cannot castCO toP");
break;
case FCT:
e1 = new expr(G_ADDROF,0,e1);
bound = b;
e1 = e1->typ(tbl);
bound = 0;
if (e1->base == CAST)
pmf = 1;
else
break;
// no break;
case PTR:
{ Pname cn = Pptr(tt)->typ->is_cl_obj();
if (cn) {
Pexpr x = cast_cptr(Pclass(cn->tp),e1,tbl,1);
if (x == e1) {
PERM(tt);
e1 = new cast(tt,e1);
e1->i2 = i2;
}
else
e1 = x;
}
if (pmf) {
while(tt->base == TYPE)
tt = Pbase(tt)->b_name->tp;
switch (tt->base) {
case PTR:
if (Pptr(tt)->memof) break;
default:
error("%t cast to%t (%t is not aP toM)",e1->tp,tp2,tp2);
}
}
}
}
break;
case RPTR: // (x&)e: pretend e is an x
{ Ptype er = etp;
Ptype cr = tt;
do {
if (er = er->is_ptr_or_ref()) er = Pptr(er)->typ;
if (cr = cr->is_ptr_or_ref()) cr = Pptr(cr)->typ;
} while (er && cr);
int pp = er!=0; // if `e' is a suitable pointer cast it:
// (x&)e => (x*)e, otherwise
// (x&)e => *(x*)&e
// error('d',"rptr tt %t e1->base %k e1->tp %t",tt,e1->base,e1->tp);
// if (Pptr(tt)->typ->tsizeof()>etp->tsizeof()) goto zse;
// we need to be able to ``raise the type'' from base to derived
// if (etp->is_cl_obj() && Pptr(tt)->typ->is_cl_obj()==0) goto zse;
if (e1->base==G_CM
|| e1->base==CALL
|| e1->base==G_CALL
|| e1->lval(0))
;
else if (e1->tp->tconst()) {
// casting away const
// should be an error
// but ANSI says OK so I chicken out
// to be able to compile strtok(), etc.
if (warning_opt && Pptr(tt)->typ->tconst()==0)
error('w',"const cast away:%t->%t",e1->tp,tp2);
}
else
error("cannot cast%t to%t",etp,t);
//error('d',"e1 %k %t %d",e1->base,e1->tp,pp);
if (pp == 0) e1 = e1->address(); // *(x*)&e
tp = t;
// do proper pointer manipulation for multiple inheritance
Pname cn = Pptr(tt)->typ->is_cl_obj();
if (cn) {
Pexpr x = cast_cptr(Pclass(cn->tp),e1,tbl,1);
if (x == e1) {
PERM(tt);
e1 = new cast(tt,e1);
e1->i2 = i2;
}
else
e1 = x;
}
return pp ? this : contents();
// zse:
// error("cannot cast%t to%t",etp,t);
// tp2 = tt = any_type;
// break;
}
case COBJ:
base = VALUE; // (x)e => x(e): construct an x from e
e1 = new expr(ELIST,e1,0);
return typ(tbl);
case CHAR:
case INT:
case SHORT:
case LONG:
switch (etp->base) {
case FCT:
e1 = new expr(ADDROF,0,e1);
e1 = e1->typ(tbl);
//etp = e1->tp;
case PTR:
if(!e1->tp->memptr() && e1->tp->tsizeof()>tt->tsizeof())
error("type ``%t'' not large enough for values of ``%t ''",tt,etp);
break;
case COBJ:
error("cannot castCO to%k",tt->base);
break;
}
break;
case FLOAT:
case DOUBLE:
case LDOUBLE:
switch (etp->base) {
case FLOAT:
case DOUBLE:
case LDOUBLE:
case CHAR:
case INT:
case SHORT:
case LONG:
case EOBJ:
case ZTYPE:
break;
default:
error("cannot cast ``%t '' to ``%t''",etp,tt);
break;
}
break;
case FCT:
error("cannot cast toFT");
break;
}
tp = t;
if (e1->base==ILIST && ptom_cast==0) { // pointer to member constant
Pexpr ee = e1->e1; // ELIST
int i;
switch (ee->e2->base) {
case IVAL:
i = int(ee->e2->i1);
break;
case ZERO:
i = 0;
}
if (i<0)
e1 = e1->e2; // just the function
else
e1 = ee->e2; // just the index
return this;
}
if (etp->base==PTR && Pptr(etp)->memof && Pptr(etp)->typ->base==FCT) {
Pclass cl = Pptr(etp)->memof;
if (Pptr(tt)->memof==0 && b == 0 ) {
Pexpr y = new mdot("f",e1);
y->i1 = 9;
y = new cast(tt,y);
if (cl->virt_count && b==0) {
// ERROR: no check for side effects
Pexpr z = new mdot("i",e1);
Pexpr x = new mdot("i",e1);
x->i1 = 9;
x = new cast(tt,x);
z->i1 = 9;
Pexpr q = new expr (QUEST,x,y);
q->cond = new expr(LE,zero,z);
q->tp = tt;
delete this;
return q;
}
delete this;
return y;
}
}
return this;
}
Pexpr expr::dovalue(Ptable tbl)
{
Ptype tt = tp2;
Pclass cl;
Pname cn;
//error('d',"value %d %t e1 %d e2 %d",tt,tt,e1,e2);
tt->dcl(tbl);
while(tt->base == TYPE)
tt = Pbase(tt)->b_name->tp;
switch (tt->base) {
case EOBJ:
default:
if (e1 == 0) {
error("value missing in conversion to%t",tt);
return dummy;
}
base = CAST;
e1 = e1->e1; // strip ELIST
return typ(tbl);
case CLASS:
cl = Pclass(tt);
tp2 = Pptr(cl->this_type)->typ;
break;
case COBJ:
cn = Pbase(tt)->b_name;
cl = Pclass(cn->tp);
}
//error('d',"e1 %k e1->e2 %k",e1->base,e1?e1->e2->base:0);
if (e1 && e1->e2==0) { // single argument
if (e1->e1->base==ELIST) e1->e1 = e1->e1->e1; // spurious elist
e1->e1 = e1->e1->typ(tbl);
if (tt->base==COBJ) {
Pexpr x = try_to_coerce(tt,e1->e1,"type conversion",tbl);
if (x) return x;
}
Pname acn = e1->e1->tp->is_cl_obj();
//error('d',"acn %n %d",acn,cl->has_itor());
if (acn && cl->has_itor()==0) {
Pclass acl = Pclass(acn->tp);
int hb = acl->has_base(cl);
if (acl==cl || hb) {
vcllist->clear();
vcllist=0;
if (1<is_unique_base(acl,cl->string,0)) error("ambiguous assignment to base %t",cl);
Pexpr ee = e1->e1;
if (ee->base == ELIST) ee = ee->e1; // ???
if (hb) { // ee => *(tp2*)&ee
// remember = may be overloaded
//error('d',"hb %k %t %d",ee->base,ee->tp,ee->lval(0));
ignore_const++;
if (ee->lval(0)==0) {
Pname tmp = make_tmp('T',ee->tp,tbl);
ee = init_tmp(tmp,ee,tbl);
ee = new expr(G_CM,ee,tmp->address());
}
else
ee = ee->address();
ignore_const--;
ee = new texpr(CAST,new ptr(PTR,tp2),ee); //new cast(new ptr(PTR,tp2),ee);
ee = ee->contents();
ee->typ(tbl);
}
if (e2) { // x(x_obj) => e2=x_obj
base = ASSIGN;
e1 = e2;
e2 = ee;
tp = tp2;
return this;
}
return ee; // strip ELIST: x(x_obj) => x_obj
}
}
}
/* x(a) => obj.ctor(a); where e1==obj */
Pname ctor = cl->has_ctor();
if (ctor == 0) {
error("cannot make a%t",cl);
return dummy;
}
// error('d',"e2 %k",e2?e2->base:0);
// error('d',"refd: %d const_ptr: %d", refd, const_ptr);
if (e2 == 0) { // x(a) => x temp; (temp.x(a),temp)
/* incomplete condition
if ( refd && const_ptr == 0) {
if ( tbl == gtbl ) {
error("Ir forG non-constCR not an lvalue");
}
else
if (strict_opt)
error("Ir for non-constCR not an lvalue");
else
if (warning_opt)
error('w', "Ir for non-constR not an lvalue (anachronism)");
}
*/
no_sti = 1;
Pname n = make_tmp('V',tp2,tbl);
no_sti = 0;
n->assign();
if (tbl == gtbl) n->dcl_print(0); // a hack
Pexpr c = call_ctor(tbl,n,ctor,e1,DOT);
c = new expr(G_CM,c,n);
c->tp = n->tp;
//error('d',"tp1 %t",c->tp);
return c;
}
else {
Pexpr c = call_ctor(tbl,e2,ctor,e1,DOT);
c = new expr(DEREF,c,0); // deref value returned by constructor
c->tp = c->e1->tp;
//error('d',"tp2 %t",c->tp);
return c;
}
}
0707071010112044311004440001630000160000010201300466055402500000700000074341find.c /*ident "@(#)ctrans:src/find.c 1.5" */
/******************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1986 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
find.c:
name lookup and visibility checks
*******************************************************************/
#include "cfront.h"
Pname undef(Pname n, Ptable tbl, TOK f)
{
switch (f) {
case CCON:
error("illegalF call: explicit call ofK %s()",n->string);
break;
case 0: error("%nU",n); break;
case CALL: error("UF%n called",n); break;
case REF:
case DOT: error("M%nU",n); break;
case ADDROF: error("address ofU%n",n); break;
}
if (tbl == gtbl) {
Pname nn = tbl->insert(n,0);
if (f == CALL) {
nn->tp = new fct(defa_type,0,0);
nn->n_sto = nn->n_scope = EXTERN;
}
else
nn->tp = any_type;
delete n;
return nn;
}
n->n_table = tbl;
n->tp = any_type;
return n;
}
static int mptr; // &C::m
static Pname me; // name of fct requesting access to name using find_name()
static Pfct mef; // fct requesting access to name using find_name()
Pclass tcl; // class of original ``this''
Pclass mec; // class requesting access to name using find_name()
int mex;
Ptable lcl_tbl = 0; // handle local function reference of local const for dimen size
Pexpr find_name(Pname n, Pclass cl, Ptable tbl, int f, Pname m)
/*
in function ``m'' find the true name for "n",
implicitly define if undefined
f==CALL: n() cl == cc->cot
f==REF: p->n cl == class of *p
f==DOT: obj.n cl == class of obj
f==ADDROF: &n cl == cc->cot
f==0 n (none of the above)
"tbl" defines local scope (block or global)
*/
{
if ( n == 0 ) error('i',"find_name(n==0,cl==%t,tbl==%d,f==%k,m==%n)",cl,tbl,f,m);
Pname q = n->n_qualifier;
char* s = n->string;
Pexpr ee;
DB( if(Ddebug>=3) {
error('d',"find_name %s::%s cl %t",q?q->string:"",s,cl);
error('d'," f %d m %n",f,m);
if(q&&q->tp&&q->tp->base==COBJ)
fprintf(stderr," -- cb==%d\n",Pclass(q->tp)->c_body);
});
tcl = cl;
//if (n) {
mex = 1;
if (me = m) {
mef = Pfct(me->tp);
if (mef->base!=FCT)
error('i',"mef %d %k",mef,mef->base);
mec = mef->memof;
}
else {
mef = 0;
mec = cl;
}
//}
//else
// mex = 0;
if (n->base == MDOT) error('i',"find (mdot %n)",n);
if (n->n_table) { me = 0; return n; }
//error('d',"q %n %t f %k",q,q?q->tp:0,f);
if (q) { // qualified name: q::s
if (q == sta_name) { // explicitly global: ::s
Pname nn = gtbl->look(s,0);
if (nn == 0) { me = 0; return undef(n,gtbl,f); }
nn->use();
delete n;
me = 0;
return nn;
}
{
Pname aq = q; // actual q
while ( aq->tp->base == TYPE ) aq = Pbase(aq->tp)->b_name;
if (aq->tp->base != COBJ) {
error("Qr%nnot aCN",q);
me = 0;
return undef(n,gtbl,f);
}
q = aq;
}
Pclass qcl = Pclass(Pbase(q->tp)->b_name->tp);
Pclass bcl = cl;
if (cl==0 || f==ADDROF)
bcl = cl = qcl; // Pclass(Pbase(q->tp)->b_name->tp);
else {
// if (strcmp(q->string,cl->string)) { // really a base?
// bcl = cl->is_base(q->string);
if (strcmp(qcl->string,cl->string)) { // really a base?
bcl = cl->is_base(qcl->string);
if (bcl == 0) {
if (f==REF || f==DOT) {
error("%s is not aBC of %t",q->string,cl);
me = 0;
return undef(n,cl->memtbl,7);
}
goto sss;
}
// else try in base or for static
}
}
if (f == ADDROF) mptr = 1; // &C::m
ee = cl->find_name(s,bcl==cl?0:bcl); // really a member?
mptr = 0;
if (ee == 0) {
sss:
//error('d',"sss %k",f);
if (f!=REF && f!=DOT) {
// try for static member of other class:
Pclass qcl = Pclass(Pbase(q->tp)->b_name->tp);
mptr = 1;
if ( cl && cl->csu == ANON ) {
mec = (cc-1)->cot;
ee = qcl->find_name(s,qcl);
} else
ee = qcl->find_name(s,qcl);
mptr = 0;
if (ee && ee->base==NAME) {
// switch (ee->tp->base) {
// case FCT:
// case OVERLOAD:
// break;
// default:
delete n;
me = 0;
return ee;
// }
}
}
error("QdN%n::%n not found in %t",q,n,cl);
me = 0;
return undef(n,bcl?bcl->memtbl:cl->memtbl,7);
}
if (ee->base==REF && ee->e1==0) { // &C::f, no ``this''
//error('d',"ee %k %d f %k",ee->base,ee->e1,f);
switch (f) {
case 0:
case CALL: //SSS
{ Pexpr mm = ee->mem;
while (mm->base==REF || mm->base==MDOT) mm = mm->mem;
if (mm->base==NAME)
switch (mm->tp->base) {
case FCT:
case OVERLOAD:
goto addrof;
default:
if (Pname(mm)->n_stclass == STATIC) goto addrof;
}
}
error("O orOP missing forM%n",n);
case ADDROF:
addrof:
Pexpr x = ee;
ee = ee->mem;
delete x;
case REF:
case DOT:
break;
default:
error("QdN%n::%n used in nonC context",q,n);
}
}
delete n;
me = 0;
return ee;
}
if (f!=DOT && f!=REF) { // not .s or ->s: look for local, global, and member
Pname nn = tbl->look(s,0);
if (nn) { // local, global, or member
if (nn->n_table->t_name) { // global or member
if (cl) { // might be member
if ((ee = cl->find_name(s,0))==0 &&
cl->in_class)
{ // nested class
Pclass nstd_cl = cl->in_class;
for (; nstd_cl; nstd_cl=nstd_cl->in_class)
{
// error( 'd', "find_name( %s ): nested class %t",s,nstd_cl );
if (ee=nstd_cl->find_name(s,0))
{
if ( cl->nested_sig == 0 ) {
error('w',"%s, accessed within nestedC%t, is visible bothGly and within enclosingC%t -- using %n (anachronism)", s, cl, nstd_cl, nn );
ee = 0;
}
break;
}
}
} // nested class
if ( ee )
{ // class member name
if (ee->base==REF && ee->e1==0 )
{
Pexpr mm = ee->mem;
while (mm->base==REF || mm->base==MDOT) mm = mm->mem;
if (mm->base==NAME)
switch (mm->tp->base) {
default:
if (Pname(mm)->n_stclass != STATIC)
break;
case FCT:
case OVERLOAD:
delete n;
me = 0;
return mm;
}
error("O orOP missing for%n",Pref(ee)->mem);
}
delete n;
me = 0;
return ee;
} // if ee
} // if cl
} // else local, global, or member
nn->use();
delete n;
me = 0;
return nn;
}
if (cl) {
if ( cl->csu == ANON ) {
mec = (cc-1)->cot;
ee = (cc-1)->cot->find_name(s,0);
} else
ee = cl->find_name(s,0);
if (ee) {
if (ee->base==REF && ee->e1==0) {
Pexpr mm = ee->mem;
while (mm->base==REF || mm->base==MDOT) mm = mm->mem;
if (mm->base==NAME)
switch (mm->tp->base) {
default:
if (Pname(mm)->n_stclass != STATIC)
break;
case FCT:
case OVERLOAD:
delete n;
me = 0;
return mm;
}
error("O orOP missing for%n",Pref(ee)->mem);
}
delete n;
me = 0;
return ee;
}
}
if ( lcl_tbl && (nn=lcl_tbl->look(s,0)) ) {
nn->use();
delete n;
me = 0;
return nn;
}
if (nn = gtbl->look(s,0)) { // global
nn->use();
delete n;
me = 0;
return nn;
}
me = 0;
return undef(n,gtbl,f);
}
if (ee = cl->find_name(s,cl)) { // .s or ->s
delete n;
me = 0;
return ee;
}
if(!strcmp(s,cl->string)) {
me = 0;
return undef(n,gtbl,CCON);
}
me = 0;
return undef(n,gtbl,f);
}
int classdef::check_dup(Pclass cl, TOK bb)
/*
see if cl is a base of this; return 0 if no clash
*/
{
for (Pbcl b = baselist; b; b=b->next) {
if (cl == b->bclass) {
if (bb!=VIRTUAL) {
if (b->base==VIRTUAL)
error('w',"%t inaccessible because of virtual%t in%t",cl,cl,this);
else
error('w',"%t inaccessible because of%t in%t",cl,cl,this);
return 1;
}
else if (b->base!=VIRTUAL) {
error('w',"virtual %t inaccessible because of%t in%t",cl,cl,this);
return 1;
}
}
if (b->bclass->check_dup(cl,bb)) return 1;
}
return 0;
}
int Nvis;
TOK Nvirt;
TOK ppbase;
Pclass classdef::is_base(char* s)
/*
is "s" a public base class of this?
*/
{
//error('d',"%s->is_base(%s) %k",string,s,ppbase);
TOK pp = ppbase;
for (Pbcl b = baselist; b; b=b->next) {
/*
if (b->ppp!=PUBLIC
&& cc->cot!=this
&& (cc->nof==0 || this->has_friend(Pfct(cc->nof->tp))==0))
ppbase = b->ppp<pp?pp:b->ppp; // PUBLIC<PROTECTED<PRIVATE
*/
if (strcmp(s,b->bclass->string) == 0) {
if (b->ppp!=PUBLIC
&& cc->cot!=this
&& (cc->nof==0 || this->has_friend(Pfct(cc->nof->tp))==0))
ppbase = b->ppp<pp?pp:b->ppp; // PUBLIC<PROTECTED<PRIVATE
Nvirt = b->base;
return b->bclass;
}
else {
Pclass bc = b->bclass->is_base(s);
if (bc) {
if (b->ppp!=PUBLIC
&& cc->cot!=this
&& (cc->nof==0 || this->has_friend(Pfct(cc->nof->tp))==0))
ppbase = b->ppp<pp?pp:b->ppp; // PUBLIC<PROTECTED<PRIVATE
return bc;
}
}
}
ppbase = pp;
return 0;
}
bit classdef::has_base(Pclass cl)
/*
is "cl" a base of this?
*/
{
// error('d', "%t->has_base( %t ) cc->cot: %t", this, cl, cc->cot?cc->cot:0 );
if (this == 0) return 0;
for (Pbcl b = baselist; b; b=b->next) {
// error('d', "b: %t ppp: %k", b->bclass, b->ppp );
if (b->bclass==cl) {
if (b->ppp!=PUBLIC
&& cc->cot!=this
&& (cc->nof==0 ||
this->has_friend(Pfct(cc->nof->tp))==0)
&& this->has_friend(cc->cot)==0)
Nvis = 1; // no standard coercion
Nvirt = b->base;
return 1;
}
if (b->bclass->has_base(cl)) return 1;
}
return 0;
}
int Noffset;
Pexpr Nptr;
char *Nalloc_base;
clist* vcllist;
int clist::onlist(Pclass c)
{
for (clist* p = this; p; p = p->next)
if (p->cl == c) return 1;
return 0;
}
void clist::clear()
{
if (this == 0) return;
clist* p = next;
while (p) {
clist* q = p->next;
delete p;
p = q;
};
delete this;
}
Pbcl Nvbc_alloc;
int is_unique_base(Pclass cl, char* s, int offset, int in_base )
/*
is "s" a unique base class of this?
*/
{
int i = 0;
static Pclass priSeen = 0;
// error('d',"is_unique_base(cl: %t, s: %s,%d,%d)",cl,s,offset,in_base);
for (Pbcl b = cl->baselist; b; b=b->next) {
int no = 0;
if (b->base!=VIRTUAL)
no = offset + b->obj_offset;
else if (in_base)
continue;
if (strcmp(s,b->bclass->string) == 0) {
Noffset = no;
i++;
if ((b->ppp!=PUBLIC || priSeen )
&& (cc->cot!=cl || cc->cot != priSeen )
&& (cc->nof==0 || cl->has_friend(Pfct(cc->nof->tp))==0)
|| (priSeen && priSeen->has_friend(Pfct(cc->nof->tp))==0))
Nvis = 1; // no standard coercion
if (b->base==VIRTUAL) {
Nptr = new mdot(s,0);
if (b->allocated == 0) {
Nvbc_alloc = 0;
Nalloc_base = cl->has_allocated_base(s);
}
}
}
else {
if (b->base==VIRTUAL) {
if (vcllist->onlist(b->bclass) )continue;
vcllist = new clist(b->bclass,vcllist);
}
Pclass clscope = 0;
if ( cc && cc->c_this ) {
Ptype t = Pptr(cc->c_this->tp)->typ;
clscope = Pclass(Pbase(t)->b_name->tp);
}
// error('d', "cl: %t %d clscope: %t %d", cl, cl, clscope, clscope);
if (b->ppp != PUBLIC &&
cl != clscope && priSeen == 0 ) priSeen = cl;
int ii = is_unique_base(b->bclass,s,no,1);
if (in_base == 0) priSeen = 0;
// error('d',"base %t i %d ii %d",b->bclass,i,ii);
// error('d',"base %t %k allocated: %d", b->bclass, b->base, b->allocated);
i += ii;
if (ii==1 && b->base==VIRTUAL) {
Nptr = new mdot(b->bclass->string,0);
if (b->allocated == 0) {
Nvbc_alloc = 0;
Nalloc_base = cl->has_allocated_base(b->bclass->string);
}
}
}
}
return i;
}
/*
int classdef::has_allocated_base(Pclass bcl)
search the list of !first base classes for this virtual base
space will have been allocated in !first bases for virtual bases
declared in !first classes
in addition bcl may bave been specified explicitly as a base
{
int off;
for (Pbcl l = baselist; l; l=l->next) {
if (l->base == VIRTUAL) continue; // another non-allocated virtual base
if (l==baselist) continue; // first base
Pclass bc = l->bclass;
off = l->obj_offset;
for (Pbcl ll = bc->baselist; ll; ll=ll->next) {
// cannot share non-virtual base
if (ll->base != VIRTUAL) continue;
if (ll->bclass==bcl) return off + ll->obj_offset;
}
}
return 0;
}
*/
int classdef::has_allocated_base(Pclass bcl)
/*
search the list of base classes for this virtual base
space will be allocated in first virtual version found.
return offset.
A virtual base cannot have offset 0 (its pointer at least is ahead)
*/
{
//error('d',"%t->has_allocated_base(%t) ",this,bcl);
for (Pbcl l = baselist; l; l=l->next) {
if (l->base==VIRTUAL
&& l->bclass==bcl
&& l->obj_offset)
return l->obj_offset;
if (l->base==VIRTUAL || l!=baselist) {
// allocated as an object,
// not unravelled as a set of members
int i = l->bclass->has_allocated_base(bcl);
if (i) return l->obj_offset + i;
}
}
return 0;
}
char *classdef::has_allocated_base(char *str)
/*
* str is an unallocated virtual base class of this
* return the name of the second or subsequent base class
* containing the member ``struct str *P<str>''
*/
{
// error('d',"%t::has_allocated_base(%s) baselist: %t",this,str,baselist->bclass);
for (Pbcl l = baselist; l; l=l->next) {
if (l->base == VIRTUAL) {
if ( l->allocated ) Nvbc_alloc = l;
continue;
}
Pclass bc = l->bclass;
for (Pbcl ll = bc->baselist; ll; ll=ll->next) {
if (ll->base != VIRTUAL) continue;
if (ll->allocated &&
strcmp( str, ll->bclass->string) == 0 )
{
if (bc == baselist->bclass) {
// NfirstBase=1;
return 0;
}
return bc->string;
}
}
}
return 0;
}
/*
int allocated_base(Pclass cl,Pclass bcl)
{
static second;
int s2 = second;
for (Pbcl l = cl->baselist; l; l=l->next) {
if (l->base==VIRTUAL
&& l->bclass==bcl
&& l->obj_offset
&& (second || l!=cl->baselist)) return (second=s2,1);
int i = allocated_base(l->bclass,bcl);
if (i) return (second=s2,1);
second = 1;
}
second = s2;
return 0;
}
*/
Pname vfct(Pclass cl, char* s)
/*
Called for each name "s" in a vtbl for "cl"
Find the "s" to go in the vtbl.
The "s" that caused the vtbl entry to be created
is found if nothing else is
*/
{
Pname n = cl->memtbl->look(s,0);
if (n) return n;
for (Pbcl b = cl->baselist; b; b=b->next) {
Pname nn = vfct(b->bclass,s);
if (nn) {
//error('d',"nn %nn",nn);
if (n && n!=nn) {
Pclass ncl = Pclass(n->n_table->t_name->tp);
Pclass nncl = Pclass(nn->n_table->t_name->tp);
//error('d',"ncl %t nncl %t",ncl,nncl);
if (nncl->is_base(ncl->string))
n = nn; // use nn
}
else
n = nn;
}
}
return n;
}
Pexpr rptr(Ptype t, Pexpr p, int offset)
/*
return rvalue of offset off pointer:
(t)((char*)p+offset)
*/
{
if ( t == 0 ) error( 'i', "rptr(), t==0 (type passed for cast)" );
Pexpr pp = p;
//error('d',"rptr %t %d",t,offset);
if (offset) {
Pexpr i = new ival(offset);
// pp = new texpr(CAST,Pchar_type,pp);
pp = new cast(Pchar_type,pp);
pp = new expr(PLUS,pp,i);
}
pp = new cast(t,pp);
return pp;
}
/*
Pexpr lptr(Ptype t, Pexpr p, int offset)
return lvalue of offset off pointer:
*(t*)((char*)p+offset)
{
Pexpr pp = p;
if (offset) {
Pexpr i = new ival(offset);
// pp = new texpr(CAST,Pchar_type,pp);
pp = new cast(Pchar_type,pp);
pp = new expr(PLUS,pp,i);
}
pp = new cast(t->addrof(),pp);
pp = new expr(DEREF,pp,0);
pp->tp = t;
return pp;
}
*/
int friend_check(Pclass start,Pclass stop, Pfct f)
/*
is `f' a friend of a class between `start' and `stop'
in a class DAG?
*/
{
//error('d',"friend_check(%t,%t)",start,stop);
if (start->has_friend(f)) return 1;
if (stop == start) return 0;
for (Pbcl b = start->baselist; b; b = b->next) {
if (b->bclass->has_friend(f)) return 1;
if (friend_check(b->bclass,stop,f)) return 1;
}
return 0;
}
bit classdef::has_friend(Pfct f)
/*
does this class have function "f" as its friend?
*/
{
// error('d',"%t->has_friend(%t) %d %d ",this,f,f,f->base);
for (Plist l=friend_list; l; l=l->l) {
Pname fr = l->f;
Ptype frt = fr->tp;
//error('d',"frt %t %d %d",frt,frt,frt->base);
switch (frt->base) {
case FCT:
if (f == frt) return 1;
break;
case OVERLOAD:
l->f = fr = Pgen(frt)->fct_list->f; // first fct
if (fr->tp == f) return 1;
case CLASS:
break;
default:
error('i',"bad friend %k",fr->tp->base);
}
}
return 0;
}
bit classdef::has_friend(Pclass cl)
/*
does this class have class "cl" as its friend?
*/
{
// error('d',"%t->has_friend(%t) ",this,cl);
for (Plist l=friend_list; l; l=l->l) {
Pname fr = l->f;
Ptype frt = fr->tp;
switch (frt->base) {
case CLASS:
// error('d',"class friend: %t", frt);
if ((frt == cl) || cl->same_class(Pclass(frt)))
return 1;
case FCT:
case OVERLOAD:
break;
default:
{error('i',"bad friend %k",frt->base);}
}
}
return 0;
}
Pname find_virtual(Pclass cl, Pname s)
/*
does ``cl'' have a virtual function ``s'' in some base class
*/
{
for (Pbcl b = cl->baselist; b; b = b->next) {
Pclass bcl = b->bclass;
Pname n;
if (n = bcl->memtbl->look(s->string,0)) {
// error('d', "find_virtual: n: %d base: %k", n, n->base );
if ( n->base == PUBLIC ) // x::foo;
continue;
Pfct f = Pfct(n->tp);
if (f->base == OVERLOAD) {
for (Plist gl=Pgen(f)->fct_list; gl; gl=gl->l) {
n = gl->f;
// if (f != s->tp) continue;
// Replaced by:
if (n->tp->check(s->tp,VIRTUAL)) continue;
if (Pfct(n->tp)->f_virtual) return n;
}
}
// else if (f->f_virtual)
else if (f->f_virtual && n->tp->check(s->tp,VIRTUAL)==0)
return n;
}
else if (n = find_virtual(bcl,s))
return n;
}
return 0;
}
Pname dummy_fct;
static int
is_accessible(Pname n, Pclass this_class, bit noCdcl = 0)
// 0 means n is not accessible to this_class
{
// error('d',"is_accessible(%n,%t)", n, this_class
// error('d',"%n: %k mef %t",n,n->n_protect,mef);
// error('d'," this_class %d %t",this_class,this_class);
// error('d'," mec %d %t",mec,mec);
// error('d'," tcl %d %t",tcl,tcl);
// error('d',"mec->has_base(this_class) %d",mec?mec->has_base(this_class):0);
// error('d',"tcl->has_base(mec) %d",tcl?tcl->has_base(mec):0);
// error('d',"tcl->has_base(this_class) %d",tcl?tcl->has_base(this_class):0);
// error('d',"tcl->has_friend(mef) %d",tcl?tcl->has_friend(mef):0);
if (this_class==mec ||
(mec && this_class->has_friend(mec)) ||
(mef && this_class->has_friend(mef)))
return 1;
if ( n->n_protect && tcl ) {
if ( mec )
{
if ( tcl->has_friend(mec) ||
( mec->has_base(this_class) &&
(tcl==mec || tcl->has_base(mec))))
return 1;
}
if ( mef )
{
if ( tcl->has_base(this_class) &&
// && tcl->has_friend(mef))
friend_check(tcl,this_class,mef))
return 1;
}
}
// call from check_visibility
if ( noCdcl ) return 0;
if ( Cdcl && Cdcl->base == NAME &&
Cdcl->n_stclass == STATIC &&
Cdcl->n_initializer &&
Cdcl->n_qualifier )
{
Pbase bn = Pbase(Cdcl->n_qualifier->tp);
Pclass cl = Pclass(bn->b_name->tp);
if ( cl == this_class ||
(n->n_protect && cl->has_base(this_class)) ||
cl->has_friend(this_class))
return 1;
}
return 0;
}
Pexpr classdef::find_name(char* s, Pclass cl, int access_only)
/*
look for "s" in "this" class and its base classes
if (cl)
accept only a member of "cl" or "cl"'s base classes
(that is cl::s was seen)
complicated by hiding rules: private, protected, friend
*/
{
// error('d',"%s->find_name(%s,%s) memtbl %d",string,s,cl?cl->string:"",memtbl);
Pname n = memtbl->look(s,0);
if (n) {
if (n->tp) {
switch (n->tp->base) {
case OVERLOAD:
break;
case FCT:
if (Pfct(n->tp)->f_virtual==0) {
if (n->n_dcl_printed==0) n->dcl_print(0);
break;
}
default:
if (c_body==1) dcl_print(0);
}
}
if (n->base == PUBLIC) {
if (mex && n->n_scope==0) {
if ( is_accessible(n,this) == 0 )
{
if ( me == dummy_fct )
error("G scope cannot access%n: %sM",n,n->n_protect?"protected":"private");
else error("%n cannot access%n: %sM",me,n,n->n_protect?"protected":"private");
mex = 0; // suppress further error messages
}
}
mex = 0; // don't have find_in_base complain about n
return find_in_base(s, cl);
}
if (cl==0 || cl==this) {
if (mptr==0
&& n->n_stclass!=STATIC
&& n->n_stclass!=ENUM) {
Ptype t = n->tp;
// error('d',"cl %d this %d",cl,this);
if (mex && n->n_scope==0 && n->tp->base!=OVERLOAD) {
if ( is_accessible(n,this)==0 )
{
if ( me == dummy_fct )
error("G scope cannot access%n: %sM",n,n->n_protect?"protected":"private");
else error("%n cannot access%n: %sM",me,n,n->n_protect?"protected":"private");
mex = 0; // suppress further error messages
}
}
Pname th = cc->c_this;
Pexpr r = new ref(REF,th,n);
if ( access_only == 0 ) {
if (th) th->use();
n->use();
}
r->tp = t;
return r;
}
if (mex && n->n_scope==0 && n->tp->base!=OVERLOAD) {
if ( is_accessible(n,this)==0 )
{
if ( me == dummy_fct )
error("G scope cannot access%n: %sM",n,n->n_protect?"protected":"private");
else error("%n cannot access%n: %sM",me,n,n->n_protect?"protected":"private");
mex = 0; // suppress further error messages
}
}
n->use();
return n;
}
}
if ((cl==0 || cl==this) // not qualified to a base class
&& csu!=UNION
&& csu!=ANON
&& strcmp(s,"__as")==0) { // assignment is special: you cannot inherit it
if (baselist==0
|| (baselist && baselist->bclass->obj_size!=obj_size)) {
Pname cn = ktbl->look(string,0);
if (cn->tp->base == COBJ) cn = Pbase(cn->tp)->b_name;
Pname x = gtbl->look("__as",0);
if (x) { // what if there is an (illegal) global assignment operation?
// hack hack don't declare global assignment operations!
Pfct f = Pfct(x->tp);
if (f->base == FCT) {
Pptr r = f->argtype->tp->is_ref();
if (r) {
Pname cnn = r->typ->is_cl_obj();
if (cnn && cn==cnn) return 0;
}
} else {
for (Plist gl = Pgen(f)->fct_list; gl; gl=gl->l) {
Pptr r = Pfct(gl->f)->argtype->tp->is_ref();
if (r) {
Pname cnn = r->typ->is_cl_obj();
if (cnn &&cn==cnn) return 0;
}
}
}
}
return make_assignment(cn) ? find_name(s,cl) : 0;
}
}
return find_in_base(s, cl);
}
static Pclass rootClass;
static Pbcl pubVClass;
static struct PendingMessage {
Pbcl bc;
Pname mf;
char *nm;
} *pM;
Pexpr classdef::find_in_base(char* s, Pclass cl)
{
Pbcl bc = 0;
Pexpr e = 0;
// error('d',"%s->find_in_base(%s %s)",string,s,cl?cl->string:"");
if ( me == 0 ) mef = 0;
if (rootClass == 0) rootClass = this;
for (Pbcl b=baselist; b; b=b->next) {
Pclass ccl = cl==this?0:cl;
// error('d',"try %t %s %k",b->bclass,b->bclass?b->bclass->string:"?", b->base);
Pexpr ee = b->bclass->find_name(s,ccl);
if (ee) {
if (c_body == 1) { // look for first use (through this)
if (b!=baselist || b->base==VIRTUAL)
dcl_print(0);
else {
Pexpr ex = ee;
while ((ex->base==MDOT && ex->i1==1)
|| (ex->base==REF && ex->e1==cc->c_this)) ex = ex->mem;
switch (ex->tp->base) {
case OVERLOAD:
break;
case FCT:
if (Pfct(ex->tp)->f_virtual==0) break;
default:
dcl_print(0);
}
}
}
if (e) {
// error( 'd', "find_in_base: b( %s ): %k %k ",b->bclass->string,b->base,b->ppp);
Pexpr ex = e;
int evb = 0; // number of vbase indirections
int eb = 0;
// note that this does not catch enum members
while (ex->base == MDOT
|| (ex->base==REF && ex->e1==cc->c_this)) {
if (ex->base==MDOT) evb += int(ex->i1);
ex = ex->mem;
}
Pexpr eex = ee;
int eevb = b->base==VIRTUAL; // number of vbase indirections (incl. possibly this one)
int eeb = b->base!=VIRTUAL;
while (eex->base == MDOT
|| (eex->base==REF && eex->e1==cc->c_this)) {
if (eex->base==MDOT) eevb += int(eex->i1);
eex = eex->mem;
}
// error('d', "find_in_base: ex: %k eex: %k, eevb: %d evb: %d", ex->base, eex->base, eevb, evb );
// relying on simple counts for sub-object identification isn't good enough
if (ex != eex) {
// error('d',"ex %k tp %k eex %k tp %k", ex->base, ex->tp->base, eex->base, eex->tp->base );
// if (!mqua) {
Pclass ocl, ncl;
if ( ex->tp->base == FCT )
ocl = Pfct(ex->tp)->memof;
else
if ( ex->tp->base == OVERLOAD )
ocl = Pfct(Pgen(ex->tp)->fct_list->f->tp)->memof;
else ocl = Pclass(ex->n_table->t_name->tp);
// else ocl = 0;
if ( eex->tp->base == FCT )
ncl = Pfct(eex->tp)->memof;
else
if ( eex->tp->base == OVERLOAD )
ncl = Pfct(Pgen(eex->tp)->fct_list->f->tp)->memof;
else ncl = Pclass(eex->n_table->t_name->tp);
// else ncl = 0;
// Pclass ocl = Pfct(ex->tp)->memof;
// Pclass ncl = Pfct(eex->tp)->memof;
int eb = ocl?ocl->has_base(ncl):0;
int eeb = ncl?ncl->has_base(ocl):0;
//error('d',"eb %d eeb %d evb %d eevb %d",eb,eeb,evb,eevb);
if (eb==0 && eeb==0) {
// different
error("ambiguous%n and%n",ex,eex);
break;
}
else if (eb) { // ex dominates
if (eevb<evb) error("ambiguous%n and%n (different sub-objects)",ex,eex);
}
else { // eex dominates
e = ee;
bc = b;
if (evb<eevb) error("ambiguous%n and%n (different sub-objects)",ex,eex);
}
if (evb==0 && eevb==0) {
error("ambiguous%n and%n (different sub-objects)",ex,eex);
}
// }
// else {
// // different
// error("ambiguous%n and%n",ex,eex);
// break;
// }
}
else if (ex->base==NAME
&& (Pname(ex)->n_evaluated || Pname(ex)->n_sto==EXTERN)) {
//error('d',"enum");
}
else if (evb==0 && eevb==0) {
//error('d',"e %k",e->base);
// no virtual base => different
error("ambiguous%n and%n (no virtualB)",ex,eex);
break;
}
else if ((evb && eevb==0) || (eevb && evb==0)) {
// only one virtual base => different
error("ambiguous%n and%n (one not in virtualB)",ex,eex);
break;
}
}
else {
e = ee;
bc = b;
}
}
}
if (rootClass == this ) {
if ( pM ) {
// deferred until all base classes of ``this'' examined
error("%n cannot access %s: %s is a privateBC",pM->mf,pM->nm,pM->bc->bclass->string);
delete pM; pM=0;
}
rootClass = 0;
pubVClass = 0;
}
if (e == 0) return 0;
if (mex) {
if ( bc->ppp==PRIVATE ) { // private base
if (this==mec ||
(mec && has_friend(mec)) ||
(mef && has_friend(mef)))
;
else
if ( bc->base == VIRTUAL &&
rootClass != this ) {
// if one instance is public, it dominates
if ( pubVClass == 0 ||
strcmp(pubVClass->bclass->string,bc->bclass->string)) {
pM = (PendingMessage *) new char[sizeof(*pM)];
pM->bc = bc; pM->mf = me; pM->nm = s;
}
}
else {
if ( me == dummy_fct )
error("G scope cannot access %s: %s is a privateBC",s,bc->bclass->string);
else error("%n cannot access %s: %s is a privateBC",me,s,bc->bclass->string);
mex = 0;
}
}
else { // public base class
if ( bc->base == VIRTUAL ) {
if ( pM &&
strcmp(bc->bclass->string,pM->bc->bclass->string)==0 ) {
delete pM;
pM=0;
pubVClass = bc;
} // previous private member becomes public
else pubVClass = bc; // ignore subsequent private instances
}
}
}
if (e->base==NAME
&& Pname(e)->n_stclass==STATIC) { // static member
Pname(e)->use();
return e;
}
if (e->base != NAME)
if (bc->base == VIRTUAL) { // this->mem => this->Pbclass->mem
e->mem = new mdot(bc->bclass->string,e->mem);
e->mem->i1 = 1;
e->mem->tp = e->mem->mem->tp;
}
else if (bc!=baselist) { // not first base
if (e->e1 == cc->c_this) { // this->mem => this->Obcl.mem
e->mem = new mdot(bc->bclass->string,e->mem);
e->mem->tp = e->mem->mem->tp;
}
else { // this->p->mem => this->Obcl.p->mem
Pexpr ee = e;
while (ee->e1->base == REF) ee = ee->e1;
ee->mem = new mdot(bc->bclass->string,ee->mem);
ee->mem->tp = ee->mem->mem->tp;
}
}
return e;
}
int has_virt(Pclass cl)
{
if (cl->virt_count) return 1;
for (Pbcl b = cl->baselist; b; b = b->next)
if (b->bclass->virt_count || has_virt(b->bclass)) return 1;
return 0;
}
Pname find_vptr(Pclass cl)
/*
find virtual function table
in memtbl or memtbl of ``first bases''
*/
{
//error('d',"find_vptr %t",cl);
while (cl) {
Pname vp = cl->memtbl->look("__vptr",0);
if (vp) return vp;
Pbcl b = cl->baselist;
cl = 0;
for (; b; b = b->next)
if (b->base == NAME) {
cl = b->bclass;
break;
}
}
//error('d',"return 0");
return 0;
}
void make_dummy()
/* a function with no special privileges */
{
Pname x = new name(".." /*"__static_initializer"*/);
x->tp = new fct(Pvoid_type,0,1);
dummy_fct = x->dcl(gtbl,EXTERN);
// dummy_fct->string = "";
delete x;
}
void check_visibility(Pname n, Pname q, Pclass cl, Ptable tbl, Pname fn)
/*
"fn" calls "n" a member function of "cl"
fn can be zero (for functions called in arguments to static constructors)
*/
{
// error('d',"check_visibility(%n, %t, %d, %n)",n,cl,tbl,fn);
if (fn==0) {
if (dummy_fct == 0) make_dummy();
fn = dummy_fct;
}
Pname nn = new name;
char* s = n->n_gen_fct_name; // overloaded name
nn->string = s?s:n->string;
nn->n_qualifier = q;
Pname nx = Pname(find_name(nn,cl,tbl,REF,fn)); // nn deleted by find_name
if (nx->tp->base != OVERLOAD) return;
// can we get here?
// overloaded not checked by find_name()
// (since it looks for NAMEs not functions)
for (Plist gl=Pgen(nx->tp)->fct_list; gl; gl=gl->l) {
Pname nn = gl->f;
if (n == nn) {
if (nn->n_scope) return; // public member
Pfct omef = mef;
Pclass omec = mec;
Pclass otcl = tcl;
Pclass ncl = Pclass(nn->n_table->t_name->tp);
Pname fncn = fn->n_table->t_name;
mec = fncn?Pclass(fncn->tp):0;
Pfct f = mef = Pfct(fn->tp);
tcl = cl;
int ok = is_accessible( n, ncl, 1 );
// restore global values
mef = omef; mec = omec; tcl = otcl;
if ( ok ) return;
if ( Cdcl && Cdcl->base == NAME &&
Cdcl->n_stclass == STATIC &&
Cdcl->n_initializer &&
Cdcl->n_qualifier )
{
Pbase bn = Pbase(Cdcl->n_qualifier->tp);
Pclass ccl = Pclass(bn->b_name->tp);
if ( ccl == cl || ccl->has_friend(f) ||
(n->n_protect && ccl->has_base(ncl)))
return;
}
if ( fn == dummy_fct )
error("G scope cannot access%n: %sM",nn,nn->n_protect?"protected":"private");
else error("%n cannot access%n: %sM",fn,nn,nn->n_protect?"protected":"private");
return;
}
}
error('i',"visibility check failed");
}
0707071010112044321004440001630000160000010202000466055403200000700000150132gram.y /*ident "@(#)ctrans:src/gram.y 1.11" */
/*************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
gram.y:
This is the C++ syntax analyser.
Syntax extensions for error handling:
nested functions
any expression can be empty
any expression can be a constant_expression
A call to error() does not change the parser's state
***************************************************************************/
%{
#include "cfront.h"
#include "size.h"
#include "template.h"
#include <string.h>
// include tqueue.h after YYSTYPE is defined ...
struct parstate {
Ptype intypedef;
int defercheck;
Pname intag;
} pstate[BLMAX];
static int px;
static void
SAVE_STATE()
{
if ( px++ >= BLMAX ) error('i',"maximum scope depth exceeded");
pstate[px].intypedef = in_typedef;
in_typedef = 0;
pstate[px].defercheck = defer_check;
defer_check = 0;
pstate[px].intag = in_tag;
in_tag = 0;
}
static void
RESTORE_STATE()
{
if ( --px < 0 ) error('i',"scope stack underflow");
in_typedef = pstate[px].intypedef;
defer_check = pstate[px].defercheck;
in_tag = pstate[px].intag;
}
#define copy_if_need_be(s) ((templp->in_progress || templp->parameters_in_progress) ? strdup(s) : s)
#define YYMAXDEPTH 600
#ifdef DBG
#ifndef YYDEBUG
#define YYDEBUG 1
#endif
#endif
static init_seen = 0;
static cdi = 0;
static Pnlist cd = 0, cd_vec[BLMAX];
static char stmt_seen = 0, stmt_vec[BLMAX];
//local class
static Plist tn_vec[BLMAX], lcl_tn_vec[BLMAX], lcl_blk_vec[BLMAX];
extern void local_restore();
extern void local_name();
//nested class
static Plist nested_tn_vec[BLMAX], nested_type_vec[BLMAX];
extern void nested_restore();
static Pname err_name = 0;
// fcts put into norm2.c just to get them out of gram.y
void sig_name(Pname);
Ptype tok_to_type(TOK);
void memptrdcl(Pname, Pname, Ptype, Pname);
static Pptr doptr(TOK p, TOK t)
{
Pptr r = new ptr(p,0);
switch (t) {
case CONST:
r->rdo = 1;
// if (p == RPTR) error('w',"redundant `const' after &");
break;
case VOLATILE:
error('w',"\"volatile\" not implemented (ignored)");
break;
default:
error("syntax error: *%k",t);
}
return r;
}
static Pbcl dobase(TOK pr, Pname n, TOK v = 0)
{
Pbcl b = new basecl(0,0);
if (pr == PROTECTED) {
pr = PUBLIC;
error("protectedBC");
}
b->ppp = pr; // save protection indicator
if (n) {
if (n->base != TNAME) {
error("BN%n not aTN",n);
return 0;
}
Pbase bt = Pbase(n->tp);
while (bt->base == TYPE) bt = Pbase(bt->b_name->tp);
if (bt->base != COBJ) {
error("BN%n not aCN",n);
return 0;
}
if (v) {
if (v != VIRTUAL) error("syntax error:%k inBCD",v);
b->base = VIRTUAL;
}
else
b->base = NAME;
b->bclass = Pclass(bt->b_name->tp);
}
return b;
}
#define Ndata(a,b) b->normalize(Pbase(a),0,0)
#define Ncast(a,b) b->normalize(Pbase(a),0,1)
#define Nfct(a,b,c) b->normalize(Pbase(a),Pblock(c),0)
#define Ncopy(n) (n->base==TNAME)?new name(n->string):n
#define Finit(p) Pfct(p)->f_init
#define Fargdcl(p,q,r) Pfct(p)->argdcl(q,r)
#define Freturns(p) Pfct(p)->returns
#define Vtype(v) Pvec(v)->typ
#define Ptyp(p) Pptr(p)->typ
/* avoid redefinitions */
#undef EOFTOK
#undef ASM
#undef BREAK
#undef CASE
#undef CONTINUE
#undef DEFAULT
#undef DELETE
#undef DO
#undef ELSE
#undef ENUM
#undef FOR
#undef FORTRAN
#undef FRIEND
#undef GOTO
#undef IF
#undef NEW
#undef OPERATOR
#undef RETURN
#undef SIZEOF
#undef SWITCH
#undef THIS
#undef WHILE
#undef LP
#undef RP
#undef LB
#undef RB
#undef REF
#undef DOT
#undef NOT
#undef COMPL
#undef MUL
#undef AND
#undef PLUS
#undef MINUS
#undef ER
#undef OR
#undef ANDAND
#undef OROR
#undef QUEST
#undef COLON
#undef ASSIGN
#undef CM
#undef SM
#undef LC
#undef RC
#undef ID
#undef STRING
#undef ICON
#undef FCON
#undef CCON
#undef ZERO
#undef ASOP
#undef RELOP
#undef EQUOP
#undef DIVOP
#undef SHIFTOP
#undef ICOP
#undef TYPE
#undef TNAME
#undef EMPTY
#undef NO_ID
#undef NO_EXPR
#undef FDEF
#undef ELLIPSIS
#undef AGGR
#undef MEM
#undef MEMPTR
#undef PR
#undef TSCOPE
#undef DECL_MARKER
#undef REFMUL
#undef LDOUBLE
#undef LINKAGE
#undef LOCAL
#undef TEMPLATE
#undef XVIRT
#undef XNLIST
#undef XILINE
#undef XIA
#undef STATEMENT
#undef EXPRESSION
#undef SM_PARAM
#undef TEMPLATE_TEST
#undef PTNAME
#undef NEW_INIT_KLUDGE
%}
%union {
char* s;
TOK t;
int i;
loc l;
Pname pn;
Ptype pt;
Pexpr pe;
Pstmt ps;
Pbase pb;
Pnlist nl;
Pslist sl;
Pelist el;
Pbcl pbc;
Pptr pp;
PP p; // fudge: pointer to all class node objects
Plist pl;
toknode* q; // token queue
}
%{
#include "tqueue.h"
extern YYSTYPE yylval, yyval;
extern int yyparse();
// in_typedef should allow for nested in_typedef
extern int declTag; // !1: inline, virtual mod permitted
int in_sizeof = 0;
Ptype in_typedef = 0; // catch redefinition of TNAME
Pname in_tag = 0; // handle complex typedefs: int (*)()
extern int defer_check; // redefinition typedef check delay
Pname curr_scope;
extern int must_be_id; // !0, TNAME => ID, i.e., int X
int DECL_TYPE = 0; // lalex() wants this set for global x(*fp)()
int in_arg_list=0; // !0 when parsing argument list
static int in_binit_list=0;
int in_class_decl=0; // !0 when processing class definition
int parsing_class_members=0; // !0 when parsing class def but not member function body
int in_mem_fct=0; // !0 when parsing member function definition
#define yylex lalex
#define NEXTTOK() ( (yychar==-1) ? (yychar=yylex(),yychar) : yychar )
#define EXPECT_ID() must_be_id = 1
#define NOT_EXPECT_ID() must_be_id = 0
Pname syn()
{
ll:
switch (yyparse()) {
case 0: return 0; // EOF
case 1: goto ll; // no action needed
default: return yyval.pn;
}
}
%}
/*
the token definitions are copied from token.h,
and all %token replaced by %token
*/
/* keywords in alphabetical order */
%token EOFTOK 0
%token ASM 1
%token AUTO 2
%token BREAK 3
%token CASE 4
%token CONTINUE 7
%token DEFAULT 8
%token DELETE 9
%token DO 10
%token ELSE 12
%token ENUM 13
%token FOR 16
%token FORTRAN 17
%token FRIEND 18
%token GOTO 19
%token IF 20
%token NEW 23
%token OPERATOR 24
%token RETURN 28
%token SIZEOF 30
%token SWITCH 33
%token THIS 34
%token WHILE 39
/* operators in priority order (sort of) */
%token LP 40
%token RP 41
%token LB 42
%token RB 43
%token REF 44
%token DOT 45
%token NOT 46
%token COMPL 47
%token MUL 50
%token AND 52
%token PLUS 54
%token MINUS 55
%token LT 58
%token GT 60
%token ER 64
%token OR 65
%token ANDAND 66
%token OROR 67
%token QUEST 68
%token COLON 69
%token ASSIGN 70
%token CM 71
%token SM 72
%token LC 73
%token RC 74
/* = constants etc. */
%token ID 80
%token STRING 81
%token ICON 82
%token FCON 83
%token CCON 84
%token NAME 85
%token ZERO 86
/* groups of tokens */
%token ASOP 90 /* op= */
%token RELOP 91 /* LE GE LT GT */
%token EQUOP 92 /* EQ NE */
%token DIVOP 93 /* DIV MOD */
%token SHIFTOP 94 /* LS RS */
%token ICOP 95 /* INCR DECR */
%token TYPE 97
/* TYPE = INT FLOAT CHAR DOUBLE REGISTER STATIC EXTERN AUTO
LONG SHORT UNSIGNED INLINE FRIEND VIRTUAL */
%token TNAME 123
%token EMPTY 124
%token NO_ID 125
%token NO_EXPR 126
%token FDEF 127
%token ELLIPSIS 155
%token AGGR 156
%token MEM 160
%token MEMPTR 173
%token PR 175 /* PUBLIC PRIVATE PROTECTED */
%token TSCOPE 178 /* TNAME :: */
%token DECL_MARKER 179
%token REFMUL 180 /* ->*, .* */
%token LDOUBLE 181
%token LINKAGE 182 /* extern "asdf" */
%token LOCAL 183 /* local class */
%token TEMPLATE 185 /* local class */
/* "tokens" for aux data structures */
%token XVIRT 200 /* class virt */
%token XNLIST 201 /* struct name_list */
%token XILINE 202
%token XIA 203
%token STATEMENT 205
%token EXPRESSION 206
%token SM_PARAM 207
%token TEMPLATE_TEST 208
%token PTNAME 209
%token NEW_INIT_KLUDGE 210
%token XDELETED_NODE 211
%token DUMMY_LAST_NODE 212
%type <p> external_def fct_dcl fct_def att_fct_def arg_dcl_list
base_init init_list binit
data_dcl ext_def vec ptr
type tp enum_dcl moe_list moe
tag ttag enumtag class_head class_dcl cl_mem_list
cl_mem dl decl_list
fname decl initializer stmt_list
caselab_stmt caselablist
block statement simple ex_list elist e ee term prim
term_elist
cast_decl cast_type c_decl c_type c_tp
arg_decl formal_decl at arg_type arg_list arg_type_list
new_decl new_type
condition
TSCOPE tscope TNAME tn_list MEMPTR
qualified_tname
PTNAME tname ptname template_def
%type <l> LC RC SWITCH CASE DEFAULT FOR IF DO WHILE GOTO RETURN DELETE
BREAK CONTINUE
%type <t> oper ellipsis_opt
EQUOP DIVOP SHIFTOP ICOP RELOP GT LT ASOP
ANDAND OROR PLUS MINUS MUL ASSIGN OR ER AND
LP LB NOT COMPL AGGR
TYPE PR REFMUL
STATEMENT EXPRESSION stmt_or_expr
%type <s> CCON ZERO ICON FCON STRING LINKAGE
%type <pn> ID FDEF inline_fct_def identifier
%type <pbc> base_list base_unit_list base_unit
%type <q> EMPTY
%type <i> fct_attributes
%type <pl> arg_lp
%type <pe> temp_inst_parm
%type <el> temp_inst_parms
%left EMPTY
%left NO_ID
%left RC LC ID BREAK CONTINUE RETURN GOTO DELETE DO IF WHILE FOR CASE DEFAULT
AGGR ENUM TYPE TNAME TSCOPE
%left NO_EXPR
%left CM
%right ASOP ASSIGN
%right QUEST COLON
%left OROR
%left ANDAND
%left OR
%left ER
%left AND
%left EQUOP
%left RELOP GT LT
%left SHIFTOP
%left PLUS MINUS
%left MUL DIVOP MEMPTR
%left REFMUL
%right NOT COMPL NEW
%right ICOP SIZEOF
%left LB LP DOT REF MEM
%start ext_def
%%
/*
this parser handles declarations one by one,
NOT a complete .c file
*/
/************** DECLARATIONS in the outermost scope: returns Pname (in yylval) ***/
ext_def : external_def { return 2; }
| SM { return 1; }
| EOFTOK { return 0; }
| LINKAGE LC
{
set_linkage($<s>1);
bl_level--;
return 1;
}
| RC
{
set_linkage(0);
bl_level++;
return 1;
}
| template { return 1; }
| template_test { return 1 ;}
;
template_test : TEMPLATE_TEST identifier LT temp_inst_parms GT SM
{ Ptreet t = tree_template::get($<pn>2->string) ;
Pexpr e = 0 ;
if (t)
e = t->expand(expr_unlist($<el>4)) ;
else error ("%s wasn't an expression template",
$<pn>2->string) ;
} ;
template : TEMPLATE
{ templp->start() ; }
LT template_parm_list GT
{templp->enter_parameters() ; }
template_def
{templp->end($<pn>7);
templp->in_progress = false ;
goto mod;}
;
template_def : att_fct_def
{ goto mod; }
| fct_def
{ goto mod; }
| class_dcl SM
{ Pname pn = $<pb>1->aggr();
/* basetype:aggr() does not return the name for a forward */
/* declaration, so extract it directly */
$$ = (pn ? pn : $<pb>1->b_name) ;
DECL_TYPE = 0; }
/* internal template specification productions*/
| STATEMENT
{templp->curr_tree_template = $1 ; }
identifier COLON statement
{$<pn>3->n_initializer = $<pe>5 ; /* actually a stmt */
$<pn>$ = $<pn>3; }
| EXPRESSION
{templp->curr_tree_template = $1 ; }
identifier COLON ee SM
{$<pn>3->n_initializer = $<pe>5 ; /* actually a stmt */
$<pn>$ = $<pn>3 ; }
;
identifier : ID
| qualified_tname
{ $<pn>$ = Ncopy($<pn>1) ;} ;
;
external_def : data_dcl
{
/* if function declartion with arguments
* need to make sure modified_tn is traversed */
if ( $<pn>1 != 0
&& $<pn>1->tp->base == FCT
&& Pfct($<pn>1->tp)->nargs !=0 )
goto mod;
else {
modified_tn = 0;
curr_scope = 0;
if ($<pn>1==0) $<i>$ = 1;
}
}
| att_fct_def
{ goto mod; }
| fct_def
{ goto mod; }
| fct_dcl
{ mod: if (modified_tn) {
restore();
modified_tn = 0;
}
local_blk = 0;
curr_scope = 0;
if (local_tn) {
local_restore();
local_tn = 0;
}
if (nested_tn) { // x::f(){}
nested_restore();
nested_tn = 0;
nested_type = 0;
}
}
| ASM LP STRING RP SM
{ Pname n = new name(make_name('A'));
n->tp = new basetype(ASM,0);
Pbase(n->tp)->b_name = Pname($<s>3);
$$ = n;
}
;
fct_dcl : decl ASSIGN initializer SM
{
err_name = $<pn>1;
if(err_name) err_name->n_initializer = $<pe>3;
goto fix;
}
| decl SM
{
Ptype t;
err_name = $<pn>1;
fix:
if (err_name == 0) {
error("syntax error:TX");
$$ = Ndata(defa_type,err_name);
}
else if ((t=err_name->tp) == 0) {
error("TX for%n",err_name);
$$ = Ndata(defa_type,err_name);
}
else if (t->base==FCT) {
if (Pfct(t)->returns==0)
$$ = Nfct(defa_type,err_name,0);
else
$$ = Ndata(0,err_name);
}
else {
error("syntax error:TX for%k%n",t->base,err_name);
$$ = Ndata(defa_type,err_name);
}
}
;
att_fct_def : type decl arg_dcl_list check_inline base_init block
{ Pname n = Nfct($1,$<pn>2,$6);
Fargdcl(n->tp,name_unlist($<nl>3),n);
Finit(n->tp) = $<pn>5;
$$ = n;
NOT_EXPECT_ID();
//???POP_SCOPE(); // undef arg names
}
| type decl arg_dcl_list check_inline EMPTY
{
Pname n = Nfct($1,$<pn>2,dummy);
Fargdcl(n->tp,name_unlist($<nl>3),n);
$<q>5->retval.pn = n;
$$ = n;
NOT_EXPECT_ID();
}
| type decl arg_dcl_list check_inline NO_ID /*syntax error*/
{
error(&$<pn>2->where,"syntax error -- did you forget a ';'?");
Pname n = Nfct($1,$<pn>2,0);
$$ = n;
NOT_EXPECT_ID();
//???POP_SCOPE(); // undef arg names
}
;
fct_def : decl arg_dcl_list check_inline base_init block
{ Pname n = Nfct(defa_type,$<pn>1,$5);
Fargdcl(n->tp,name_unlist($<nl>2),n);
if ( $<pn>4 && $<pn>4->n_list &&
ccl && ccl->csu == UNION )
error( "multiple initializers in unionK %s::%n", $<pn>1->string, $<pn>1 );
Finit(n->tp) = $<pn>4;
$$ = n;
NOT_EXPECT_ID();
//???POP_SCOPE(); // undef arg names
}
| decl arg_dcl_list check_inline EMPTY
{
Pname n = Nfct(defa_type,$<pn>1,dummy);
Fargdcl(n->tp,name_unlist($<nl>2),n);
$<q>4->retval.pn = n;
$$ = n;
NOT_EXPECT_ID();
}
| decl arg_dcl_list check_inline NO_ID /*syntax error*/
{
error(&$<pn>1->where,"badD of%n -- did you forget a ';'?",$<pn>1);
Pname n = Nfct(defa_type,$<pn>1,0);
$$ = n;
NOT_EXPECT_ID();
//???POP_SCOPE(); // undef arg names
}
;
inline_fct_def : FDEF
{//PUSH_ARG_SCOPE
arg_redec($<pn>1);
}
base_init block
{
Finit($1->tp) = $<pn>3;
Pfct($1->tp)->body = Pblock($4);
$$ = $1;
NOT_EXPECT_ID();
//???POP_SCOPE(); // undef arg names
}
;
check_inline : /* empty */
{
// if parsing implicit inline def, save body
// of function for parsing after class def
switch ( NEXTTOK() ) {
case LC: case COLON:
if ( in_class_decl ) {
// mem or friend inline def
// save text of mem_init & ftn
la_backup(yychar,yylval);
// yylval used as dummy...
la_backup(FDEF, yylval);
if ( yylval.q = save_text() )
yychar = EMPTY;
else { // syntax error
// just parse in place
yylex(); // FDEF
yychar = yylex();
}
} // if in_class_decl
break;
default:
la_backup(yychar,yylval);
yychar = NO_ID; // 'graceful' recovery
break;
}
}
;
base_init : COLON { ++in_binit_list; } init_list
{
$$ = $3;
in_arg_list = 0;
--in_binit_list;
}
| %prec EMPTY
{ $$ = 0; }
;
init_list : binit
{ $$ = $1; }
| init_list CM binit
{ $<pn>$ = $<pn>3; $<pn>$->n_list = $<pn>1; }
;
binit : LP elist RP
{
$<pn>$ = new name;
$<pn>$->n_initializer = $<pe>2;
}
| ttag LP elist RP
{
Pname n = Ncopy($<pn>1);
n->base = $<pn>1->base;
n->tp = $<pn>1->tp;
n->n_initializer = $<pe>3;
$<pn>$ = n;
}
/*
| NEW LP elist RP
{ Pname n = new name;
n->base = NEW;
n->n_initializer = $<pe>3;
$<pn>$ = n;
}
*/
;
/*************** declarations: returns Pname ********************/
arg_dcl_list : arg_dcl_list data_dcl
{ if ($<pn>2 == 0)
error("badAD");
else if ($<pn>2->tp->base == FCT)
error("FD inAL (%n)",$<pn>2);
else if ($1)
$<nl>1->add_list($<pn>2);
else
$<nl>$ = new nlist($<pn>2);
}
| %prec EMPTY
{
$$ = 0;
}
;
dl : decl
| ID COLON
{
if ( in_typedef ) {
error("Tdef field");
in_typedef = 0;
}
// ENTER_NAME($<pn>1);
}
e %prec CM
{ $$ = $<pn>1;
$<pn>$->tp = new basetype(FIELD,$<pn>4);
}
| COLON e %prec CM
{ $$ = new name;
$<pn>$->tp = new basetype(FIELD,$<pn>2);
if ( in_typedef ) {
error("Tdef field");
in_typedef = 0;
}
}
| decl ASSIGN
{
// ENTER_NAME($<pn>1);
}
initializer
{ Pexpr e = $<pe>4;
if (e == dummy) error("emptyIr");
$<pn>1->n_initializer = e;
init_seen = 0;
}
;
decl_list : dl
{
if ($1) $<nl>$ = new nlist($<pn>1);
if ( NEXTTOK() == CM && la_look() == TNAME )
EXPECT_ID();
}
| decl_list CM dl
{ if ($1)
if ($3)
$<nl>1->add($<pn>3);
else
error("DL syntax");
else {
if ($3) $<nl>$ = new nlist($<pn>3);
error("DL syntax");
}
if ( NEXTTOK() == CM && la_look() == TNAME )
EXPECT_ID();
}
;
data_dcl : type decl_list SM
{
extern int co_hack;
co_hack = 1;
/*$$ = Ndata($1,name_unlist($<nl>2));*/
Pname n = Ndata($1,name_unlist($<nl>2));
if ( in_typedef && in_tag ) {
if ( n->tp->check( in_tag->tp, 0 ))
error("%nredefined: previous: %t now: %t", in_tag, in_tag->tp, n->tp );
}
in_typedef = 0;
in_tag = 0;
co_hack = 0;
DECL_TYPE = 0;
$$ = n;
}
| type SM
{
$$ = $<pb>1->aggr();
in_typedef = 0;
in_tag = 0;
DECL_TYPE = 0;
}
;
/* This is where parametrized types, and regular types come together. */
lt : LT { templp->parameters_in_progress++; };
gt : GT { templp->parameters_in_progress--; };
tname : qualified_tname { $<pn>$ = templp->check_tname($<pn>1) ; }
| qualified_tname lt temp_inst_parms gt
{
$<pn>$ = parametrized_typename($<pn>1,
(expr_unlist($<el>3))) ;
}
| NAME LT temp_inst_parms GT
{ extern Pbase any_type;
error("%n was not a parametrized type.", $<pn>$) ;
$<pn>$= $<pn>1->tdef() ;
$<pn>$->tp = any_type ; } ;
tp : TYPE
{
$$ = new basetype($<t>1,0);
if ( $<t>1 == TYPEDEF ) in_typedef = $<pt>$;
if (DECL_TYPE == -1) DECL_TYPE = 0;
}
| LINKAGE
{ $$ = new basetype(EXTERN,0);
$<pb>$->b_linkage = $<s>1;
if (DECL_TYPE == -1) DECL_TYPE = 0;
}
| qualified_tname
{
templp->check_tname($<pn>1);
$$ = new basetype(TYPE,$<pn>1);
if (DECL_TYPE == -1) DECL_TYPE = 0;
}
/*XXX*/ | tn_list DECL_MARKER
{ // modified tn_list TNAME
$$ = new basetype(TYPE,$<pn>2);
//xxx qualifier currently ignored...
if (DECL_TYPE == -1) DECL_TYPE = 0;
}
| qualified_tname lt temp_inst_parms gt
{
$<pb>$ = parametrized_basetype($<pn>1,(expr_unlist($<el>3)));
}
| class_dcl
| enum_dcl
| DECL_MARKER
{
if (DECL_TYPE == TNAME)
$$ = new basetype(TYPE,$<pn>1);
// else if (DECL_TYPE == TSCOPE)
// $$ = 0;
else
if (DECL_TYPE == 0 &&
$<p>1->base == TNAME)
$$ = new basetype(TYPE,$<pn>1);
else
$$ = new basetype($<t>1,0);
DECL_TYPE = -1;
}
;
type : tp
| type TYPE
{
if ( DECL_TYPE != -1 ) {
switch ($<pb>1->base) { Pbase bt;
case COBJ: case EOBJ:
bt = new basetype(0,0);
*bt = *$<pb>1;
DEL($<pb>1);
$<pb>1 = bt;
}
$$ = $<pb>1->type_adj($<t>2);
}
DECL_TYPE = 0;
}
| type tname
{
//error('d',"decl_type: %d $1: %t $2: %n",DECL_TYPE,$<pb>1,$<pn>2);
if ( DECL_TYPE != -1 )
$$ = $<pb>1->name_adj($<pn>2);
/*XXX*/ else if($<pb>1==0) $$=new basetype(TYPE,$<pn>2);
DECL_TYPE = 0;
}
| type class_dcl { $$ = $<pb>1->base_adj($<pb>2); }
| type enum_dcl { $$ = $<pb>1->base_adj($<pb>2); }
| type DECL_MARKER
{
if (DECL_TYPE == TYPE) {
switch ($<pb>1->base) { Pbase bt;
case COBJ: case EOBJ:
bt = new basetype(0,0);
*bt = *$<pb>1;
DEL($<pb>1);
$<pb>1 = bt;
}
$$ = $<pb>1->type_adj($<t>2);
}
/*XXX*/ else if (DECL_TYPE == TSCOPE) {
/*XXX*/ error('i',"type decl_marker(tscope)");
/*XXX*/ // $$ = $1;//ignore(?)
/*XXX*/ }
else
$$ = $<pb>1->name_adj($<pn>2);
DECL_TYPE = -1;
}
;
temp_inst_parms : temp_inst_parms CM temp_inst_parm
{$<el>1->add(new expr(ELIST,$<pe>3,NULL)) ; }
| temp_inst_parm { $<el>$ =
new elist(new expr(ELIST,$<pe>1,NULL)); } ;
temp_inst_parm : new_type
{$<pn>1->n_template_arg = template_actual_arg_dummy ;
$<pe>$ = $<pn>1; /* keep yacc happy */ }
| e %prec GT
{ $<pe>$ = $<pe>1 ; } ;
/***************** aggregate: returns Pname *****************/
enumtag : tag
{ enumcheck:
Ptype tx = $<pn>1->tp;
$$ = $1;
if ( tx->base == TYPE ) {
$$ = Pbase(tx)->b_name;
tx = $<pn>$->tp;
if ( tx->base != EOBJ
|| strcmp($<pn>$->string,$<pn>1->string)
)
error("%n of type%t redeclared as enum.",$<pn>1,tx);
} else if ( tx->base != EOBJ )
error("%n of type%t redeclared as enum",$<pn>1,tx);
}
| DECL_MARKER { goto enumcheck; }
;
enum_dcl : ENUM LC moe_list RC { $$ = end_enum(0,$<nl>3); }
| ENUM enumtag LC moe_list RC { $$ = end_enum($<pn>2,$<nl>4); }
| ENUM enumtag { $<pb>$ = (Pbase)$<pn>2->tp; }
;
moe_list : moe
{ if ($1) $<nl>$ = new nlist($<pn>1); }
| moe_list CM moe
{ if( $3)
if ($1)
$<nl>1->add($<pn>3);
else
$<nl>$ = new nlist($<pn>3);
}
;
template_parm_list : template_parm_list CM template_parm
| template_parm
| { $<pn>$ = NULL ;} ;
stmt_or_expr : STATEMENT | EXPRESSION ;
template_parm : AGGR identifier
/* Build the name for the parameter
/* Check that AGGR is indeed CLASS */
{ templp->collect($<t>1, $<pn>2) ; }
| stmt_or_expr identifier
{ templp->collect($<t>1, $<pn>2) ; }
| type formal_decl
{templp->collect(Ndata($1,$<pn>2)); } ;
/* Sam: these productions are a variant of the ones for arg_decl,
verify them against arg_decl for each release. */
formal_decl : ID
{ $$ = $<pn>1; }
| ptr formal_decl %prec MUL
{ Ptyp($1) = $<pn>2->tp;
$<pn>2->tp = (Ptype)$1;
$$ = $2;
}
| formal_decl vec %prec LB
{ Vtype($2) = $<pn>1->tp;
$<pn>1->tp = (Ptype)$2;
}
| formal_decl arg_list
{ Freturns($2) = $<pn>1->tp;
$<pn>1->tp = (Ptype)$2;
} ;
moe : ID
{ $$ = $<pn>1; $<pn>$->tp = moe_type; }
| ID ASSIGN e
{ $$ = $<pn>1;
$<pn>$->tp = moe_type;
$<pn>$->n_initializer = $<pe>3;
}
| /* empty: handle trailing CM: enum e { a,b, }; */
{ $$ = 0; }
;
class_dcl : class_head cl_mem_list RC
{ parsing_class_members = 0;
RESTORE_STATE();
switch ( NEXTTOK() ) {
case TYPE: case AGGR: case ENUM: case EOFTOK:
error("`;' or declaratorX afterCD");
la_backup(yychar,yylval);
yychar = SM;
break;
}
la_backup(yychar,yylval);
yychar = -1;
restore_text();
++bl_level; // scope weirdness!
++in_mem_fct;
}
inline_mem_defs
{
--in_mem_fct;
--bl_level; // scope weirdness!
if ( yychar == ID ) {
// (yuk!) adjust lex level
--yylval.pn->lex_level;
}
ccl->mem_list = name_unlist($<nl>2);
if ( --in_class_decl ) // nested class
// continue to parse enclosing class
parsing_class_members = 1;
ccl->nest_list = nested_type;
if ( nested_tn ) nested_restore();
nested_type = nested_type_vec[in_class_decl];
nested_tn = nested_tn_vec[in_class_decl];
end_cl();
declTag = 1;
//POP_SCOPE();
}
| AGGR tag
{ aggrcheck:
$<pb>$ = (Pbase)$<pn>2->tp;
if ( $$->base == TYPE ) {
Pname nx = $<pb>$->b_name;
$<pb>$ = (Pbase)nx->tp;
if ( $$->base != COBJ
|| strcmp(nx->string,$<pn>2->string)
)
error("%n of type%t redeclared as%k.",$<pn>2,$<pb>$,$<t>1);
} else if ( $$->base != COBJ )
error("%n of type%t redeclared as%k",$<pn>2,$<pb>$,$<t>1);
check_tag();
}
| AGGR qualified_tname lt temp_inst_parms gt
{
Pname p = parametrized_typename($<pn>2, (expr_unlist($<el>4))) ;
$<pb>$ = (Pbase)p->tp;
check_tag();
}
| AGGR DECL_MARKER
{
goto aggrcheck;
}
;
inline_mem_defs : /* empty */
| inline_mem_defs inline_fct_def
;
base_list : COLON base_unit_list { $$ = $2; }
| %prec EMPTY { $$ = 0; }
;
base_unit_list : base_unit
| base_unit_list CM base_unit
{ if ($3) { $$ = $3; $<pbc>$->next = $1; } }
;
base_unit : ttag { $$ = dobase(0,$<pn>1); }
| PR ttag { $$ = dobase($<t>1,$<pn>2); }
| TYPE ttag { $$ = dobase(0,$<pn>2,$<t>1); }
| PR TYPE ttag { $$ = dobase($<t>1,$<pn>3,$<t>2); }
| TYPE PR ttag { $$ = dobase($<t>2,$<pn>3,$<t>1); }
;
class_head : AGGR LC
{//PUSH_CLASS_SCOPE(0);
parsing_class_members = 1;
$$ = start_cl($<t>1,0,0);
nested_tn_vec[in_class_decl] = nested_tn;
nested_type_vec[in_class_decl++] = nested_type;
nested_tn = nested_type = 0;
SAVE_STATE();
}
| AGGR tag base_list LC
{ //PUSH_CLASS_SCOPE($<pn>2->string);
parsing_class_members = 1;
$$ = start_cl($<t>1,$<pn>2,$<pbc>3);
nested_tn_vec[in_class_decl] = nested_tn;
nested_type_vec[in_class_decl++] = nested_type;
nested_tn = nested_type = 0;
SAVE_STATE();
}
;
tag : ID { $$ = $1; }
| qualified_tname { $$=$1; }
;
ttag : ID { $$ = $1; }
| tname { $$=$1; }
;
cl_mem_list : cl_mem_list cl_mem
{
if ($2) {
if ($1)
$<nl>1->add_list($<pn>2);
else
$<nl>$ = new nlist($<pn>2);
}
}
| %prec EMPTY { $$ = 0; }
| cl_mem_list TEMPLATE
{
error( "ZizedTD must be atG, notC scope" );
error('i', "cannot recover from previous error" );
}
;
cl_mem : data_dcl
| att_fct_def SM
| fct_def SM
| fct_def
| att_fct_def
| fct_dcl
| PR COLON
{ $$ = new name;
$<pn>$->base = $<t>1;
}
/*XXX | tn_list TNAME SM
* { Pname n = Ncopy($<pn>2);
* n->n_qualifier = $<pn>1;
* n->base = PR;
* $$ = n;
* }
*/ | tn_list fname SM
{ Pname n = Ncopy($<pn>2);
if (n->n_oper == TYPE) {
error('s',"visibilityD for conversion operator");
// n->tp = Ptype(n->n_initializer);
n->tp = Ptype(n->cond);
n->cond = 0;
// n->n_initializer = 0;
n->n_oper = 0;
sig_name(n);
}
n->n_qualifier = $<pn>1;
n->base = PR;
$$ = n;
}
;
/************* declarators: returns Pname **********************/
/* a ``decl'' is used for function and data declarations,
and for member declarations
(it has a name)
an ``arg_decl'' is used for argument declarations
(it may or may not have a name)
an ``cast_decl'' is used for casts
(it does not have a name)
a ``new_decl'' is used for type specifiers for the NEW operator
(it does not have a name, and PtoF and PtoV cannot be expressed)
*/
fname : ID
{ $$ = $<pn>1; }
| COMPL TNAME /* qualified_tname? */
{ $$ = Ncopy($<pn>2);
$<pn>$->n_oper = DTOR;
}
| OPERATOR oper
{ $$ = new name(oper_name($2));
$<pn>$->n_oper = $<t>2;
}
| OPERATOR c_type
{ Pname n = $<pn>2;
n->string = "_type";
n->n_oper = TYPE;
n->cond = Pexpr(n->tp);
// n->n_initializer = Pexpr(n->tp);
n->tp = 0;
$$ = n;
}
;
oper : PLUS
| MINUS
| MUL
| AND
| OR
| ER
| SHIFTOP
| EQUOP
| DIVOP
| RELOP
| LT
| GT
| ANDAND
| OROR
| LP RP { $$ = CALL; }
| LB RB { $$ = DEREF; }
| NOT
| COMPL
| ICOP
| ASOP
| ASSIGN
| NEW { $$ = NEW; }
| DELETE { $$ = DELETE; }
| REF { $$ = REF; }
| CM { $$ = CM; }
| REFMUL { $$ = REFMUL;
if ($<t>1 == DOT) error(".* cannot be overloaded");
}
;
tn_list : tscope
/*XXX*/ { if ( $<pn>1 != sta_name ) {
// error('d',"tn_list: tscope: pn1: %s", $<pn>1->string);
Ptype t = $<pn>1->tp;
while ( t->base == TYPE )
t = Pbase(t)->b_name->tp;
Pname n = Pbase(t)->b_name;
if (NEXTTOK() == TNAME
&& strcmp(n->string,yylval.pn->string)==0){
// ctor -- change to ID to avoid
// parsing as type spec
yychar = ID;
yylval.pn = Ncopy(yylval.pn);
yylval.pn->n_oper = TNAME;
}
}
$<pn>$ = $<pn>1;
}
/* YYY | tn_list tscope { $<pn>$ = $<pn>1; } */
| tn_list tscope { error('s', "CNs do not nest, use typedef x::y y_in_x"); };
/*XXX | tn_list ID DOT { error("CNs do not nest"); } */
;
qualified_tname : tn_list TNAME
{ $<pn>$ = $<pn>2;
//xxx qualifier currently ignored...
// $<pn>$ = Ncopy( $<pn>2 );
// $<pn>$->n_oper = TNAME;
// $<pn>$->n_qualifier = $<pn>1;
}
| TNAME
{ $<pn>$ = $<pn>1;
// $<pn>$ = Ncopy( $<pn>1 );
// $<pn>$->n_oper = TNAME;
}
;
fct_attributes : /* empty */
{ $$ = 0; }
| fct_attributes TYPE
{ /* const/volatile function */
switch ( $<t>2 ) {
case VOLATILE:
error('s',"volatile functions");
break;
case CONST:
$$ = ($1 | 1);
break;
default:
if ( NEXTTOK() != SM
&& yychar != COLON
&& yychar != LC ) {
la_backup(yychar,yylval);
yylval.t = $<t>2;
la_backup(TYPE,yylval);
yylval.t = SM;
yychar = SM;
error("syntax error: unexpected%k (did you forget a `;'?)",$<t>2);
} else error("FD syntax: unexpected%k",$<t>2);
break;
}
}
;
decl : decl arg_list
{ Freturns($2) = $<pn>1->tp;
$<pn>1->tp = $<pt>2;
}
| decl LP RP fct_attributes
{ /* function with no argument */
$<pn>1->tp = new fct($<pn>1->tp,0,1);
Pfct($<pn>1->tp)->f_const = ($<i>4 & 1);
}
| tname arg_list
{ Pname n = $<pn>1;
$$ = Ncopy(n);
//??? what if tname is qualified ???
if (ccl && strcmp(n->string,ccl->string)) n->hide();
$<pn>$->n_oper = TNAME;
Freturns($2) = $<pn>$->tp;
$<pn>$->tp = $<pt>2;
}
| decl arg_lp elist RP
/* may be class object initializer,
class object vector initializer,
if not elist will be a CM or an ID
*/
{
$<pn>1->tp = new fct($<pn>1->tp,$<pn>3,1);
in_arg_list = 0;
end_al($2,0);
RESTORE_STATE();
//POP_SCOPE(); // similar to end_al()
}
| tname LP MUL ID RP arg_list
{
Pptr p = new ptr( PTR, 0 );
Ptyp(p) = new basetype(TYPE,$<pn>1);
Freturns( $6 ) = Ptype(p);
$<pn>4->tp = $<pt>6;
$$ = $4;
if (DECL_TYPE == -1) DECL_TYPE = 0;
}
| tname LP elist RP
{ $$ = Ncopy($<pn>1);
$<pn>$->n_oper = TNAME;
$<pn>$->tp = new fct(0,$<pn>3,1);
}
| tname LP RP fct_attributes
{ /* function with no argument */
$$ = Ncopy($<pn>1);
$<pn>$->n_oper = TNAME;
$<pn>$->tp = new fct(0,0,1);
Pfct($<pn>1->tp)->f_const = ($<i>4 & 1);
}
| tname LP MEMPTR decl RP arg_list
{ memptrdcl($<pn>3,$<pn>1,$<pt>6,$<pn>4);
$$ = $4;
}
| fname
| ID DOT fname
{ $$ = Ncopy($<pn>3);
$<pn>$->n_qualifier = $1;
error(strict_opt?0:'w',"`.' used for qualification; please use `::' (anachronism)");
}
| tn_list fname
{ $$ = $2;
if ( $<pn>1 != sta_name ) {
set_scope($<pn>1);
$<pn>$->n_qualifier = $<pn>1;
}
}
/*XXX*/ | tn_list ID DOT fname
{ $$ = Ncopy($<pn>4);
$<pn>$->n_qualifier = $2;
error(ansi_opt?0:'w',"anachronism `.' used for qualification; please use `::'");
if ( $<pn>1 != sta_name ) {
set_scope($<pn>1);
$<pn>2->n_qualifier = $<pn>1;
}
}
/*XXX | tn_list TNAME
* {
* if ( $<pn>1 == sta_name )
* error( ":: applied to CN%n", $<pn>2 );
* $$ = Ncopy($<pn>2);
* set_scope($<pn>1);
* $<pn>$->n_oper = TNAME;
* $<pn>$->n_qualifier = $<pn>1;
* }
*/ | ptr decl %prec MUL
{ Ptyp($1) = $<pn>2->tp;
$<pn>2->tp = $<pt>1;
$$ = $2;
}
| ptr tname %prec MUL
{ $$ = Ncopy($<pn>2);
$<pn>$->n_oper = TNAME;
// cannot evaluate at this point: defer until data_dcl
if ( in_typedef ) {
defer_check = 1;
in_tag = $<pn>2;
}
$<pn>2->hide();
defer_check = 0;
$<pn>$->tp = $<pt>1;
}
| tname vec %prec LB
{ $$ = Ncopy($<pn>1);
$<pn>$->n_oper = TNAME;
if ( in_typedef ) {
defer_check = 1;
in_tag = $<pn>1;
}
$<pn>1->hide();
defer_check = 0;
$<pn>$->tp = $<pt>2;
}
| decl vec %prec LB
{ Vtype($2) = $<pn>1->tp;
$<pn>1->tp = $<pt>2;
}
/*
| LP decl RP arg_list
{
Freturns($4) = $<pn>2->tp;
$<pn>2->tp = $<pt>4;
$$ = $2;
}
| LP decl RP vec
{ Vtype($4) = $<pn>2->tp;
$<pn>2->tp = $<pt>4;
$$ = $2;
}
*/
| arg_lp decl RP
{
$$ = $2;
in_arg_list = 0;
end_al($1,0);
RESTORE_STATE();
//POP_SCOPE(); // similar to end_al()
}
;
arg_decl : ID
{ $$ = $<pn>1; }
| ptr qualified_tname %prec MUL
{ $$ = Ncopy($<pn>2);
$<pn>$->n_oper = TNAME;
$<pn>2->hide();
$<pn>$->tp = $<pt>1;
}
| %prec NO_ID
{
$$ = new name;
NOT_EXPECT_ID();
}
| ptr arg_decl %prec MUL
{ Ptyp($1) = $<pn>2->tp;
$<pn>2->tp = (Ptype)$1;
$$ = $2;
}
| arg_decl vec %prec LB
{ Vtype($2) = $<pn>1->tp;
$<pn>1->tp = (Ptype)$2;
}
| arg_decl arg_list
{ Freturns($2) = $<pn>1->tp;
$<pn>1->tp = (Ptype)$2;
}
/*
| LP arg_decl RP arg_list
{ Freturns($4) = $<pn>2->tp;
$<pn>2->tp = (Ptype)$4;
$$ = $2;
}
| LP arg_decl RP vec
{ Vtype($4) = $<pn>2->tp;
$<pn>2->tp = (Ptype)$4;
$$ = $2;
}
*/
| arg_lp arg_decl RP
{
// error('d', "arg_lp arg_decl rp in_arg_list: %d", in_arg_list );
$$ = $2;
in_arg_list = 0;
end_al($1,0);
RESTORE_STATE();
//POP_SCOPE(); // similar to end_al()
}
;
new_decl : %prec NO_ID
{ $$ = new name; }
| ptr new_decl %prec MUL
{ Ptyp($1) = $<pn>2->tp;
$<pn>2->tp = (Ptype)$1;
$$ = $2;
NOT_EXPECT_ID();
}
| new_decl vec %prec LB
{ Vtype($2) = $<pn>1->tp;
$<pn>1->tp = (Ptype)$2;
}
;
cast_decl : %prec NO_ID { $$ = new name; }
| ptr cast_decl %prec MUL
{ Ptyp($1) = $<pn>2->tp;
$<pn>2->tp = (Ptype)$1;
$$ = $2;
NOT_EXPECT_ID();
}
| cast_decl vec %prec LB
{ Vtype($2) = $<pn>1->tp;
$<pn>1->tp = (Ptype)$2;
}
| LP cast_decl RP arg_list
{ Freturns($4) = $<pn>2->tp;
$<pn>2->tp = $<pt>4;
$$ = $2;
}
| LP cast_decl RP vec
{ Vtype($4) = $<pn>2->tp;
$<pn>2->tp = $<pt>4;
$$ = $2;
}
;
c_decl : %prec NO_ID
{ $$ = new name; }
| ptr c_decl %prec MUL
{ Ptyp($1) = $<pn>2->tp;
$<pn>2->tp = (Ptype)$1;
$$ = $2;
}
;
/***************** statements: returns Pstmt *****************/
stmt_list : /* empty */
{
$$ = 0;
}
| stmt_list TEMPLATE
{
error( "ZizedTD must be atG, not local scope" );
error('i', "cannot recover from previous error" );
}
| stmt_list caselab_stmt
{
if ($2)
if ($1)
$<sl>1->add($<ps>2);
else {
$<sl>$ = new slist($<ps>2);
stmt_seen = 1;
}
}
;
caselab_stmt : caselablist statement
{
$$ = $2;
if ($2) stmt_seen = 1;
}
;
caselablist : /* empty */
{
$$ = 0;
check_decl();
}
;
condition : LP e RP
{ $$ = $2;
/* if ($<pe>$ == dummy) error("empty condition");*/
stmt_seen = 1;
}
;
block : LC
{//PUSH_BLOCK_SCOPE
cd_vec[cdi] = cd;
stmt_vec[cdi] = stmt_seen;
tn_vec[cdi] = modified_tn;
lcl_blk_vec[cdi++] = local_blk;
lcl_tn_vec[cdi] = local_tn;
local_blk = 0;
local_tn = 0;
cd = 0;
stmt_seen = 0;
modified_tn = 0;
}
stmt_list RC
{ Pname n = name_unlist(cd);
Pstmt ss = stmt_unlist($<sl>3);
$$ = new block($<l>1,n,ss,$<l>4);
if ( local_tn ) local_restore();
if ( local_blk ) local_name();
if (modified_tn) restore();
cd = cd_vec[--cdi];
stmt_seen = stmt_vec[cdi];
modified_tn = tn_vec[cdi];
local_tn = lcl_tn_vec[cdi];
local_blk = lcl_blk_vec[cdi];
if (cdi < 0) error('i',"block level(%d)",cdi);
NOT_EXPECT_ID();
//POP_SCOPE(); // similar to end_al()
}
| LC RC
{ $$ = new block($<l>1,0,0,$<l>2); NOT_EXPECT_ID();}
| LC error RC
{ $$ = new block($<l>1,0,0,$<l>3); NOT_EXPECT_ID();}
;
simple : ee
{ $$ = new estmt(SM,curloc,$<pe>1,0); }
| BREAK
{ $$ = new stmt(BREAK,$<l>1,0); }
| CONTINUE
{ $$ = new stmt(CONTINUE,$<l>1,0); }
| GOTO ID
{ $$ = new lstmt(GOTO,$<l>1,$<pn>2,0); }
| DO { stmt_seen=1; } caselab_stmt WHILE condition
{ $$ = new estmt(DO,$<l>1,$<pe>5,$<ps>3); }
| ASM LP STRING RP
{
if (stmt_seen)
$$ = new estmt(ASM,curloc,(Pexpr)$<s>3,0);
else {
Pname n = new name(make_name('A'));
n->tp = new basetype(ASM,(Pname)$<s>3);
if (cd)
cd->add_list(n);
else
cd = new nlist(n);
$$ = 0;
}
}
;
sm : {
if ( NEXTTOK() != SM ) {
error("`;' missing afterS");
la_backup(yychar,yylval);
yychar = SM;
}
} SM
;
statement : simple sm
| SM
{ $$ = new estmt(SM,$<l>1,dummy,0); }
| RETURN e SM
{ $$ = new estmt(RETURN,$<l>1,$<pe>2,0); }
| TYPE STRING block
{
error("local linkage specification");
$$ = $<pn>3;
}
| data_dcl
{ Pname n = $<pn>1;
if (n) {
//error('d',"adding local dcl of%n%t ll %d in_typedef%t",n,n->tp,n->lex_level,in_typedef);
if (stmt_seen) {
$$ = new block(n->where,n,0);
$<ps>$->base = DCL;
}
else {
if (cd)
cd->add_list(n);
else
cd = new nlist(n);
$$ = 0;
}
} // if n
}
| att_fct_def
{
Pname n = $<pn>1;
error(&n->where,"%n's definition is nested (did you forget a ``}''?)",n);
if (cd)
cd->add_list(n);
else
cd = new nlist(n);
$$ = 0;
}
| block
| IF condition caselab_stmt
{ $$ = new ifstmt($<l>1,$<pe>2,$<ps>3,0); }
| IF condition caselab_stmt ELSE caselab_stmt
{ $$ = new ifstmt($<l>1,$<pe>2,$<ps>3,$<ps>5); }
| WHILE condition caselab_stmt
{ $$ = new estmt(WHILE,$<l>1,$<pe>2,$<ps>3); }
| FOR LP { stmt_seen=1; } caselab_stmt e SM e RP caselab_stmt
{ $$ = new forstmt($<l>1,$<ps>4,$<pe>5,$<pe>7,$<ps>9); }
| SWITCH condition caselab_stmt
{ $$ = new estmt(SWITCH,$<l>1,$<pe>2,$<ps>3); }
| ID COLON { $$ = $1; stmt_seen=1; } caselab_stmt
{ Pname n = $<pn>3;
$$ = new lstmt(LABEL,n->where,n,$<ps>4);
}
| TNAME COLON { $$ = new name($<pn>1->string); stmt_seen=1; } caselab_stmt
{ Pname n = $<pn>3;
$$ = new lstmt(LABEL,n->where,n,$<ps>4);
}
| CASE { stmt_seen=1; } e COLON caselab_stmt
{ if ($<pe>3 == dummy) error("empty case label");
$$ = new estmt(CASE,$<l>1,$<pe>3,$<ps>5);
}
| DEFAULT COLON { stmt_seen=1; } caselab_stmt
{ $$ = new stmt(DEFAULT,$<l>1,$<ps>4); }
;
/********************* expressions: returns Pexpr **************/
elist : ex_list
{ Pexpr e = expr_unlist($<el>1);
while (e && e->e1==dummy) {
register Pexpr ee2 = e->e2;
if (ee2) error("EX inEL");
delete e;
e = ee2;
}
$$ = e;
}
;
ex_list : initializer %prec CM
{ $<el>$ = new elist(new expr(ELIST,$<pe>1,0)); }
| ex_list CM initializer
{ $<el>1->add(new expr(ELIST,$<pe>3,0)); }
;
initializer : e %prec CM
| LC elist RC
{
if ( in_arg_list )
error( "syntax error: IrL not permitted in AL" );
else if ( in_binit_list )
error( "syntax error: IrL not permitted inMIr" );
else
init_seen = 1;
Pexpr e;
if ($2)
e = $<pe>2;
else
e = new expr(ELIST,dummy,0);
$$ = new expr(ILIST,e,0);
}
;
ee : ee ASSIGN ee
{ bbinop: $$ = new expr($<t>2,$<pe>1,$<pe>3); }
| ee PLUS ee { goto bbinop; }
| ee MINUS ee { goto bbinop; }
| ee MUL ee { goto bbinop; }
| ee AND ee { goto bbinop; }
| ee OR ee { goto bbinop; }
| ee ER ee { goto bbinop; }
| ee SHIFTOP ee { goto bbinop; }
| ee EQUOP ee { goto bbinop; }
| ee DIVOP ee { goto bbinop; }
| ee RELOP ee { goto bbinop; }
| ee GT ee { goto bbinop; }
| ee LT ee { goto bbinop; }
| ee ANDAND ee { goto bbinop; }
| ee OROR ee { goto bbinop; }
| ee ASOP ee { goto bbinop; }
| ee CM ee { goto bbinop; }
| ee QUEST ee COLON ee
{ $$ = new qexpr($<pe>1,$<pe>3,$<pe>5); }
| DELETE term
{ $$ = new expr(DELETE,$<pe>2,0); }
| DELETE LB e RB term
{
if($<pe>3 != dummy) {
if ( warning_opt || strict_opt )
error(strict_opt?0:'w',"v in `delete[v]' is redundant; use `delete[] instead (anachronism)");
}
$$ = new expr(DELETE,$<pe>5,$<pe>3);
}
| MEM DELETE term
{ $$ = new expr(GDELETE,$<pe>3,0); }
| MEM DELETE LB e RB term
{
if($<pe>4 != dummy) {
if ( warning_opt || strict_opt )
error(strict_opt?0:'w',"v in `::delete[v]' is redundant; use `::delete[] instead (anachronism)");
}
$$ = new expr(DELETE,$<pe>6,$<pe>4);
}
| term
;
e : e ASSIGN e
{ binop: $$ = new expr($<t>2,$<pe>1,$<pe>3); }
| e PLUS e { goto binop; }
| e MINUS e { goto binop; }
| e MUL e { goto binop; }
| e AND e { goto binop; }
| e OR e { goto binop; }
| e ER e { goto binop; }
| e SHIFTOP e { goto binop; }
| e EQUOP e { goto binop; }
| e DIVOP e { goto binop; }
| e RELOP e { goto binop; }
| e LT e { goto binop; }
| e GT e { goto binop; }
| e ANDAND e { goto binop; }
| e OROR e { goto binop; }
| e ASOP e { goto binop; }
| e CM e { goto binop; }
| e QUEST e COLON e
{ $$ = new qexpr($<pe>1,$<pe>3,$<pe>5); }
| DELETE term
{ $$ = new expr(DELETE,$<pe>2,0); }
| DELETE LB e RB term
{
if($<pe>3 != dummy) {
if ( warning_opt || strict_opt )
error(strict_opt?0:'w',"v in `delete[v]' is redundant; use `delete[] instead (anachronism)");
}
$$ = new expr(DELETE,$<pe>5,$<pe>3);
}
| MEM DELETE term
{ $$ = new expr(GDELETE,$<pe>3,0); }
| MEM DELETE LB e RB term
{
if($<pe>4 != dummy) {
if ( warning_opt || strict_opt )
error(strict_opt?0:'w',"v in `::delete[v]' is redundant; use `::delete[] instead (anachronism)");
}
$$ = new expr(DELETE,$<pe>6,$<pe>4);
}
| term {
init_seen = 0;
}
| %prec NO_EXPR
{ $$ = dummy; }
;
term : NEW cast_type { goto new1; }
| NEW new_type
{ new1:
Ptype t = $<pn>2->tp;
$$ = new texpr(NEW,t,0);
}
| MEM NEW cast_type { goto new3; }
| MEM NEW new_type
{ new3:
Ptype t = $<pn>3->tp;
$$ = new texpr(GNEW,t,0);
}
| term ICOP
{ $$ = new expr($<t>2,$<pe>1,0); }
| cast_type term %prec ICOP
{ $$ = new texpr(CAST,$<pn>1->tp,$<pe>2); }
| MUL term
{ $$ = new expr(DEREF,$<pe>2,0); }
| AND term
{ $$ = new expr(ADDROF,0,$<pe>2); }
| MINUS term
{ $$ = new expr(UMINUS,0,$<pe>2); }
| PLUS term
{ $$ = new expr(UPLUS,0,$<pe>2); }
| NOT term
{ $$ = new expr(NOT,0,$<pe>2); }
| COMPL term
{ $$ = new expr(COMPL,0,$<pe>2); }
| ICOP term
{ $$ = new expr($<t>1,0,$<pe>2); }
| SIZEOF term
{
$$ = new texpr(SIZEOF,0,$<pe>2);
in_sizeof = 0;
}
| SIZEOF cast_type %prec SIZEOF
{
$$ = new texpr(SIZEOF,$<pn>2->tp,0);
in_sizeof = 0;
}
| term LB e RB
{ $$ = new expr(DEREF,$<pe>1,$<pe>3); }
| term REF prim
{ $$ = new ref(REF,$<pe>1,$<pn>3); }
| term REFMUL term
{ $$ = new expr($<t>2,$<pe>1,$<pe>3); }
| term REF qualified_tname
{ $$ = new ref(REF,$<pe>1,Ncopy($<pn>3)); }
| term DOT prim
{ $$ = new ref(DOT,$<pe>1,$<pn>3); }
| term DOT qualified_tname
{ $$ = new ref(DOT,$<pe>1,Ncopy($<pn>3)); }
| prim
| term_elist
{
if ( init_seen )
error( "syntax error:IrL illegal within ()");
}
| term_lp e RP
{
if ( $2 == dummy )
error("syntax error: nullE");
$$ = $2;
}
| ZERO
{ $$ = zero; }
| ICON
{ $$ = new expr(ICON,0,0);
$<pe>$->string = copy_if_need_be($<s>1);
}
| FCON
{ $$ = new expr(FCON,0,0);
$<pe>$->string = copy_if_need_be($<s>1);
}
| STRING
{ $$ = new expr(STRING,0,0);
$<pe>$->string = copy_if_need_be($<s>1);
}
| CCON
{ $$ = new expr(CCON,0,0);
$<pe>$->string = copy_if_need_be($<s>1);
}
| THIS
{ $$ = new expr(THIS,0,0); }
;
term_elist : TYPE LP elist RP
{ $$ = new texpr(VALUE,tok_to_type($<t>1),$<pe>3); }
/*
| qualified_tname LP elist RP
*/
| tname LP elist RP
{ $$ = new texpr(VALUE,$<pn>1->tp,$<pe>3); }
| NEW term_lp elist RP cast_type { goto new2; }
| NEW term_lp elist RP new_type /* allow separate allocation */
{ new2:
Ptype t = $<pn>5->tp;
$$=new texpr(NEW,t,0);
$<pe>$->e2 = $<pe>3;
}
| MEM NEW term_lp elist RP cast_type { goto new4; }
| MEM NEW term_lp elist RP new_type /* allow separate allocation */
{ new4:
Ptype t = $<pn>6->tp;
$$ = new texpr(GNEW,t,0);
$<pe>$->e2 = $<pe>4;
}
| term LP elist RP
{
Pexpr ee = $<pe>3;
Pexpr e = $<pe>1;
if (e->base==NEW || e->base==GNEW)
e->e1 = ee;
else
$$ = new call(e,ee);
}
;
ptname : PTNAME lt temp_inst_parms gt
{
$<pn>$ =parametrized_typename($<pn>1,(expr_unlist($<el>3)));
}
;
tscope : TSCOPE
{
$<pn>$ = $<pn>1;
curr_scope = $<pn>1;
}
| MEM { $<pn>$ = sta_name; }
| ptname TSCOPE { $<pn>$ = $<pn>1; }
;
prim : ID
{ $$ = $<pn>1; }
/*XXX*/ | tn_list ID
{ $$ = Ncopy($<pn>2);
$<pn>$->n_qualifier = $<pn>1;
}
| OPERATOR oper
{ $$ = new name(oper_name($2));
$<pn>$->n_oper = $<t>2;
}
| tn_list OPERATOR oper
{ $$ = new name(oper_name($3));
$<pn>$->n_oper = $<t>3;
$<pn>$->n_qualifier = $<pn>1;
}
| OPERATOR c_type
{ $$ = $2;
sig_name($<pn>$);
}
| tn_list OPERATOR c_type
{ $$ = $3;
sig_name($<pn>$);
$<pn>$->n_qualifier = $<pn>1;
}
| tn_list COMPL tag /* allow explicit call of destructor */
{
if (strcmp($<pn>1->string,$<pn>3->string)) error("syntax error: inconsistent destructor notation");
$$ = new name(oper_name(DTOR));
$<pn>$->n_oper = DTOR;
$<pn>$->n_qualifier = $<pn>1;
}
;
/****************** abstract types (return type Pname) *************/
cast_type : term_lp type cast_decl RP
{ $$ = Ncast($2,$<pn>3); }
;
term_lp : LP { check_cast(); }
;
c_tp : TYPE
{
TOK t = $<t>1;
switch (t) {
case FRIEND:
case OVERLOAD:
case REGISTER:
case STATIC:
case EXTERN:
case AUTO:
case VIRTUAL:
error("%k in operatorT",t);
t = INT;
}
$$ = new basetype(t,0);
}
| tname { $$ = new basetype(TYPE,$<pn>1); }
| c_tp TYPE
{
if ( DECL_TYPE != -1 ) {
switch ($<pb>1->base) { Pbase bt;
case COBJ: case EOBJ:
bt = new basetype(0,0);
*bt = *$<pb>1;
DEL($<pb>1);
$<pb>1 = bt;
}
$$ = $<pb>1->type_adj($<t>2);
}
DECL_TYPE = 0;
}
| c_tp tname
{
if ( DECL_TYPE != -1 )
$$ = $<pb>1->name_adj($<pn>2);
DECL_TYPE = 0;
}
;
c_type : c_tp c_decl { $$ = Ncast($1,$<pn>2); }
;
new_type : type new_decl { $$ = Ncast($1,$<pn>2); };
arg_type : type arg_decl
{
// ENTER_NAME($<pn>2);
$$ = Ndata($1,$<pn>2);
}
| type arg_decl ASSIGN
{
// ENTER_NAME($<pn>2);
}
initializer
{ $$ = Ndata($1,$<pn>2);
$<pn>$->n_initializer = $<pe>5;
}
;
arg_lp : LP
{//PUSH_ARG_SCOPE
SAVE_STATE();
check_decl();
in_arg_list=1;
$$ = modified_tn;
modified_tn = 0;
}
;
arg_list : arg_lp arg_type_list ellipsis_opt RP fct_attributes
{
$$ = new fct(0,name_unlist($<nl>2),$<t>3);
if ( NEXTTOK() != COLON ) in_arg_list=0;
//in_arg_list=0;
Pfct($<pt>$)->f_const = ($<i>5 & 1);
if ( parsing_class_members
|| (NEXTTOK()!=LC && yychar!=COLON)) {
end_al($1,1);
//POP_SCOPE(); // similar to end_al()
} else
end_al($1,0);
RESTORE_STATE();
}
;
arg_type_list : arg_type_list CM at
{
if ($3)
if ($1)
$<nl>1->add($<pn>3);
else {
error("AD syntax");
$<nl>$ = new nlist($<pn>3);
}
else
error("AD syntax");
}
| at %prec CM
{
if ($1) $<nl>$ = new nlist($<pn>1);
}
;
at : arg_type
| %prec EMPTY { $$ = 0; }
;
ellipsis_opt : /* empty */
{ $$ = 1; }
| ELLIPSIS
{ $$ = ELLIPSIS; }
| CM ELLIPSIS
{ $$ = ELLIPSIS; }
;
ptr : MUL %prec NO_ID
{
$$ = new ptr(PTR,0);
EXPECT_ID();
}
| AND %prec NO_ID
{
$$ = new ptr(RPTR,0);
EXPECT_ID();
}
| MUL TYPE %prec NO_ID
{ $$ = doptr(PTR,$<t>2); }
| ptr TYPE %prec NO_ID
{
switch ( $<t>2 ) {
case CONST:
$<pp>1->rdo = 1; break;
case VOLATILE:
error('w',"\"volatile\" not implemented (ignored)");
break;
default:
error( "syntax error: *%k", $<t>2 );
}
$$ = $<pp>1;
}
| AND TYPE %prec NO_ID
{ $$ = doptr(RPTR,$<t>2); }
| ptname MEMPTR %prec NO_ID
{ goto memptr1; }
| MEMPTR %prec NO_ID
{
memptr1:
$$ = new ptr(PTR,0);
$<pp>$->memof = Pclass(Pbase($<pn>1->tp)->b_name->tp);
EXPECT_ID();
}
| ptname MEMPTR TYPE %prec NO_ID
{
$<t>2 = $<t>3;
goto memptr2;
}
| MEMPTR TYPE %prec NO_ID
{
memptr2:
$$ = doptr(PTR,$<t>2);
$<pp>$->memof = Pclass(Pbase($<pn>1->tp)->b_name->tp);
}
;
vec : LB e RB { $$ = new vec(0,$<pe>2!=dummy?$<pe>2:0 ); }
| NOT %prec LB { $$ = new vec(0,0); }
;
%%
static void
check_tag()
/*
Allow the case of inline/virtual/overload as
modifiers of return type of form struct/class/union x foo()
SM, COLON, LC ==> real class declaration, not return type
*/
{
switch ( NEXTTOK() ) {
case SM: case COLON: case LC:
declTag = 1;
break;
default:
declTag = 0;
break;
}
}
static void
end_al( Plist mtn, int rst )
// unhide type names hidden by arg names
// mtn == saved modified_tn
{
if ( rst == 0 ) {
// not really an arg list, or we are entering a function def
// merge modified_tn and don't restore
if ( modified_tn == 0 ) modified_tn = mtn;
else {
for ( Plist l = modified_tn; l->l; l = l->l ) ;
l->l = mtn;
}
} else {
restore();
modified_tn = mtn;
}
}
static void
arg_redec( Pname fn )
{
if ( fn==0 || fn->tp->base != FCT )
error('i',"bad inline rewrite!");
Pname al = Pfct(fn->tp)->argtype;
Pname n = 0;
for ( ; al; al = al->n_list ) {
DB( if(Ydebug>=1)error('d',"arg_redec: %n %d",al,al->lex_level); );
// nested function args should have lex_level >= 1
if ( al->lex_level==1 && (n=ktbl->look(al->string,0)) )
n->hide();
else if ( al->lex_level>1 && (n=ktbl->look(al->string,LOCAL)) )
n->hide();
DB( if(Ydebug>=1)error('d'," %n",n); );
}
}
0707071010112046011004440001630000160000010211100466055415400000700000014643hash.c /* ident "@(#)ctrans:src/hash.c 1.2" */
/*
$Header: /var/lib/cvsd/repos/research/researchv10no/cmd/cfront/xptcfront/cfront.cpio,v 1.1.1.1 2018/04/24 17:21:35 root Exp $
Copyright (c) 1989 by Object Design, Inc., Burlington, Mass.
All rights reserved.
*/
#include <stdio.h>
#include "hash.h"
#include <osfcn.h>
#define EMPTY 0
#define VALID 1
#define DELETED 2
void default_Hash_error_handler(const char* msg)
{
fprintf(stderr, "Fatal Hash error: %s\n", msg) ;
exit(1) ;
}
Error_Proc Hash_error_handler = default_Hash_error_handler ;
Error_Proc set_Hash_error_handler(Error_Proc f)
{
Error_Proc old = Hash_error_handler ;
Hash_error_handler = f ;
return old ;
}
void Hash::error(const char* msg)
{
(*Hash_error_handler)(msg) ;
}
Hash::Hash(int sz= DEFAULT_INITIAL_HASH_SIZE)
{
tab = new HashTableEntry[size = sz] ;
for (int i = 0; i < size; ++i) tab[i].status = EMPTY ;
entry_count = 0 ;
}
Hash::Hash(Hash& a)
{
tab = new HashTableEntry[size = a.size] ;
key_hash_function = a.key_hash_function ;
key_key_equality_function = a.key_key_equality_function ;
for (int i = 0; i < size; ++i) tab[i].status = EMPTY ;
entry_count = 0 ;
for (HashWalker p(a); p; p.advance())
(*this)[p.key()] = p.get() ;
}
Hash& Hash::operator = (Hash& a)
{
if (a.tab != tab)
{
clear() ;
delete [size] tab ;
tab = new HashTableEntry[size = a.size] ;
for (int i = 0; i < size; ++i) tab[i].status = EMPTY ;
entry_count = 0 ;
for (HashWalker p(a); p; p.advance())
(*this)[p.key()] = p.get() ;
}
return *this ;
}
/*
* hashing method: double hash based on high bits of hash fct,
* followed by linear probe. Can't do too much better if Assoc
* sizes not constrained to be prime.
*/
static inline doublehashinc(unsigned int h, int s)
{
return ((h / s) % s) >> 1 ;
}
// IWBNI we knew whether we were being called as an lvalue or rvalue.
// If the former, then we wouldn't have to scan through the whole
// table just to tell if we should rehash or not. Sigh.
int& Hash::operator [](int key)
{
unsigned int hashval = key_hash(key) ;
while (1)
{
int bestspot = -1 ;
int h = hashval % size ;
for (int i = 0; i <= size; ++i)
{
if (tab[h].status == EMPTY)
{
// resize if the hash table is more than 87.5% full
if (entry_count > ((size>>1)+(size>>2)+(size>>3)))
// resize and insert again
break ;
if (bestspot < 0) bestspot = h ;
tab[bestspot].key = key ;
tab[bestspot].status = VALID ;
++entry_count ;
return tab[bestspot].cont ;
}
else if (tab[h].status == DELETED)
{
if (bestspot < 0) bestspot = h ;
}
else if (key_key_eq(tab[h].key, key))
return tab[h].cont ;
if (i == 0)
h = (h + doublehashinc(hashval, size)) % size ;
else if (++h >= size)
h -= size ;
}
resize(size << 1) ;
}
}
/* This seems convoluted, but it does whatever you want without
redundant probing of the hash table. */
void Hash::action (int key, int val, insert_action what,
int& found, int& old_val)
{
unsigned int hashval = key_hash(key) ;
while (1)
{
int bestspot = -1 ;
int h = hashval % size ;
for (int i = 0; i <= size; ++i)
{
if (tab[h].status == EMPTY)
{
// resize if the hash table is more than 87.5% full
if (entry_count > ((size>>1)+(size>>2)+(size>>3)))
// resize and insert again
break ;
if (bestspot < 0) bestspot = h ;
found = 0;
if(what != probe) {
tab[bestspot].key = key ;
tab[bestspot].status = VALID ;
++entry_count ;
tab[bestspot].cont = val;
}
return;
}
else if (tab[h].status == DELETED)
{
if (bestspot < 0) bestspot = h ;
}
else if (key_key_eq(tab[h].key, key)) {
found = 1;
old_val = tab[h].cont;
if(what == replace)
tab[h].cont = val;
return;
}
if (i == 0)
h = (h + doublehashinc(hashval, size)) % size ;
else if (++h >= size)
h -= size ;
}
resize(size << 1) ;
}
}
int Hash::contains(int key)
{
unsigned int hashval = key_hash(key) ;
int h = hashval % size ;
for (int i = 0; i <= size; ++i)
{
if (tab[h].status == EMPTY)
return 0 ;
else if (tab[h].status == VALID && key_key_eq(tab[h].key, key))
return 1 ;
if (i == 0)
h = (h + doublehashinc(hashval, size)) % size ;
else if (++h >= size)
h -= size ;
}
return 0 ;
}
int Hash::del(int key)
{
unsigned int hashval = key_hash(key) ;
int h = hashval % size ;
for (int i = 0; i <= size; ++i)
{
if (tab[h].status == EMPTY)
return 0 ;
else if (tab[h].status == VALID && key_key_eq(tab[h].key, key))
{
tab[h].status = DELETED ;
--entry_count ;
return 1 ;
}
if (i == 0)
h = (h + doublehashinc(hashval, size)) % size ;
else if (++h >= size)
h -= size ;
}
return 0 ;
}
void Hash::apply(intProc f)
{
for (int i = 0; i < size; ++i)
if (tab[i].status == VALID)
(*f)(tab[i].cont) ;
}
void Hash::clear()
{
for (int i = 0; i < size; ++i)
tab[i].status = EMPTY ;
entry_count = 0 ;
}
void Hash::resize(int newsize)
{
if (newsize < entry_count)
error("requested resize too small") ;
HashTableEntry* oldtab = tab ;
int oldsize = size ;
tab = new HashTableEntry[size = newsize] ;
for (int i = 0; i < size; ++i)
tab[i].status = EMPTY ;
entry_count = 0 ;
for (i = 0; i < oldsize; ++i)
if (oldtab[i].status == VALID)
(*this)[oldtab[i].key] = oldtab[i].cont ;
delete [oldsize] oldtab ;
}
void HashWalker::reset()
{
for (pos = 0; pos < h->size; ++pos)
if (h->tab[pos].status == VALID)
return ;
pos = -1 ;
}
void HashWalker::advance()
{
if (pos < 0)
return ;
for (pos++; pos < h->size; ++pos)
if (h->tab[pos].status == VALID)
return ;
pos = -1 ;
}
/*
unsigned int foo(int bar) {return bar;}
int baz(int a, int b) {return a == b;}
main()
{
Hash vh(10) ;
HashWalker vt(vh) ;
int i ;
vh.key_hash_function = &foo ;
vh.key_key_equality_function = baz ;
printf("Capacity=%d \n", vh.capacity()) ;
for (i=0; i<500; i+= 5)
{
vh[i] = i * i ;
}
vt.reset() ;
while (vt.valid())
{
printf("key=%d, data=%d\t", vt.key(), vt.get());
vt.advance() ;
}
for (i=0; i<500; i+= 10)
{
vh.del (i) ;
printf("After delete: %d\n", vh[i]);
}
printf("\n-----------------\n") ;
vt.reset() ;
while (vt.valid())
{
printf("key=%d, data=%d\t", vt.key(), vt.get());
vt.advance() ;
}
}
*/
0707071010112046061004440001630000160000010212400466055420200000700000011465hash.h /* ident "@(#)ctrans:src/hash.h 1.2" */
/* Compiler interface to hash tables from odi library.
$Source: /var/lib/cvsd/repos/research/researchv10no/cmd/cfront/xptcfront/cfront.cpio,v $ $RCSfile: cfront.cpio,v $
$Revision: 1.1.1.1 $ $Date: 2018/04/24 17:21:35 $
$Author: root $ $Locker: $
$State: Exp $
$Header: /var/lib/cvsd/repos/research/researchv10no/cmd/cfront/xptcfront/cfront.cpio,v 1.1.1.1 2018/04/24 17:21:35 root Exp $
Copyright (c) 1989 by Object Design, Inc., Burlington, Mass.
All rights reserved.
*/
#ifndef _HASH_H
#define _HASH_H
#include <string.h>
typedef void (*Error_Proc) (const char*) ;
extern void default_Hash_error_handler (const char*) ;
extern Error_Proc Hash_error_handler ;
extern Error_Proc set_Hash_error_handler (Error_Proc f) ;
#ifndef _hash_typedefs
#define _hash_typedefs 1
typedef void (*intProc)(int) ;
#endif
#define DEFAULT_INITIAL_HASH_SIZE 100
struct HashTableEntry
{
int key ;
int cont ;
char status ;
} ;
class HashWalker ;
class Hash
{
friend class HashWalker ;
HashTableEntry* tab ;
int size ;
int entry_count ;
public:
unsigned int (*key_hash_function)(int) ;
int (*key_key_equality_function) (int, int) ;
unsigned int key_hash(int a) ;
int key_key_eq(int a, int b);
Hash(int sz) ;
Hash(Hash& a) ;
~Hash() ;
Hash& operator= (Hash& a) ;
int count() ;
int empty() ;
int full() ;
int capacity() ;
void clear() ;
void resize(int newsize) ;
enum insert_action { probe, insert, replace };
void action (int key, int val, insert_action what,
int& found, int& old_val);
int& operator [] (int k) ;
int contains(int key) ;
int del(int key) ;
void apply (intProc f) ;
void error(const char* msg) ;
} ;
class HashWalker
{
Hash* h ;
int pos ;
public:
HashWalker(Hash& l) ;
~HashWalker() ;
int null() ;
int valid() ;
operator void* () ;
int operator ! () ;
void advance() ;
void reset() ;
void reset(Hash& l) ;
const int& key() ;
int& get() ;
} ;
inline unsigned int Hash::key_hash(int a)
{
#ifdef HASHFUNCTION
return HASHFUNCTION(a) ;
#else
return (*key_hash_function)(a) ;
#endif
}
inline int Hash::key_key_eq(int a, int b)
{
#ifdef EQUALITYFUNCTION
return EQUALITYFUNCTION(a, b) ;
#else
return (*key_key_equality_function)(a, b) ;
#endif
}
inline Hash::~Hash()
{
delete [size] tab ;
}
inline int Hash::count()
{
return entry_count ;
}
inline int Hash::empty()
{
return entry_count == 0 ;
}
inline int Hash::full()
{
return entry_count == size ;
}
inline int Hash::capacity()
{
return size ;
}
inline HashWalker::HashWalker(Hash& a)
{
h = &a ;
reset() ;
}
inline void HashWalker::reset(Hash& a)
{
h = &a ;
reset() ;
}
inline HashWalker::~HashWalker() {}
inline int HashWalker::null()
{
return pos < 0 ;
}
inline int HashWalker::valid()
{
return pos >= 0 ;
}
inline HashWalker::operator void* ()
{
return (pos < 0)? 0 : this ;
}
inline int HashWalker::operator ! ()
{
return (pos < 0) ;
}
inline const int& HashWalker::key()
{
if (pos < 0)
h->error("operation on null Walker") ;
return h->tab[pos].key ;
}
inline int& HashWalker::get()
{
if (pos < 0)
h->error("operation on null Walker") ;
return h->tab[pos].cont ;
}
inline int pointer_hasheq (int a, int b)
{
return a == b;
};
inline unsigned int pointer_hash_fcn (int x)
{
unsigned X = (unsigned) x;
return ((X << 16) | (X >> 16)) ^ x;
}
class pointer_hash : public Hash {
public:
pointer_hash (int sz = 0) : Hash (sz) {
key_hash_function = pointer_hash_fcn;
key_key_equality_function = pointer_hasheq;
}
pointer_hash (pointer_hash& h) : Hash (h) {};
};
inline int string_hasheq (int a, int b)
{
return !strcmp((char *)a, (char *) b);
};
static unsigned int string_hash_fcn (int x)
{
char * str = (char *)x;
int l = strlen(str);
if(x <= 4) return str[0];
else {
unsigned int * f4 = (unsigned int *) str;
if (l < 8) return ((*f4 << 16) | (*f4 >> 16)) ^ *f4;
else {
unsigned int * s4 = f4 ++;
return ((*f4 << 16) | (*f4 >> 16)) ^ *s4;
}
}
};
class string_hash : public Hash {
public:
string_hash (int sz = 0) : Hash (sz) {
key_hash_function = string_hash_fcn;
key_key_equality_function = string_hasheq;
};
string_hash (string_hash& h) : Hash (h) {};
};
#endif
0707071010112046071004440001630000160000010210470466055420500001500000001056ios_printf.h /* ident "@(#)ctrans:src/ios_printf.h 1.2" */
/* Begin iostream_printf.H -- printf functions that work on ostreams.
someday, perhaps, scanf functions for istreams. */
#include <stdarg.h>
#include <iostream.h>
int vostream_printf(const char *format, va_list argp, ostream& fp);
int ostream_printf(ostream& stream, const char * format ...);
// returns count of characters added.
int printf_to_string (char * string, int length, const char * format ...);
// returns string which came from malloc.
char * printf_to_alloc_string (const char * format ...);
0707071010112044331004440001630000160000010202700466055403600001000000134002lalex.c /*ident "@(#)ctrans:src/lalex.c 1.15" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
lalex.c:
lookahead
*****************************************************************************/
#include <stdio.h>
#ifdef c_plusplus
overload is_empty;
#endif
#include "cfront.h"
#include "yystype.h"
#include "tqueue.h"
#include "template.h"
#ifdef DBG
#define LDB(val,a) { if(Ldebug>=val) {a;} }
#else
#define LDB(val,a) /**/
#endif
#ifdef DBG
static char*
image( int t )
{
if(keys[t]) return keys[t];
else { static char b[20];
sprintf(b,"token(%d)",t);
return b;
}
}
static void
printok( toknode* t )
{
switch(t->tok) {
default:
fprintf(stderr,"\t%s",image(t->tok));
break;
case ID: case ICON: case CCON: case FCON: case STRING:
fprintf(stderr,"ID '%s'",t->retval.s);
break;
case TNAME:
fprintf(stderr,"TNAME '%s'",t->retval.pn->string);
break;
case PTNAME:
fprintf(stderr,"PTNAME '%s'",t->retval.pn->string);
break;
case TSCOPE:
fprintf(stderr,"TSCOPE '%s'::",t->retval.pn->string);
break;
case MEMPTR:
fprintf(stderr,"MEMPTR '%s'::*",t->retval.pn->string);
break;
}
putc(' ',stderr);
t->place.put(stderr);
putc('\n',stderr);
}
static void
showQ( char* where )
/*
display token Q
*/
{
fprintf(stderr,"TOKEN Q (%s):\n",where);
for (register toknode* t = front; t; t = t->next) printok(t);
putc('\n',stderr);
}
#endif
int bl_level;
static int laexpr( TOK );
static int latype( TOK );
static int la_decl();
static TOK lookahead();
/* make this a toknode! */
static int lasttk = 0; // one token history
static YYSTYPE lastval; // yylval lasttk value
int must_be_expr = 0; // handle redundant parentheses
int must_be_id = 0; // !0, TNAME => ID, i.e., int X
loc curloc;
int curr_file;
toknode* latok; // current lookahead token
toknode* front = 0;
toknode* rear = 0;
const TQCHUNK = 16;
void*
toknode::operator new(size_t)
{
register toknode* p;
if ((p=free_toks) == 0) {
register toknode* q;
free_toks = q = (toknode*)malloc( TQCHUNK * sizeof(toknode) );
p = free_toks;
for (; q != &p[TQCHUNK-1]; q->next = q+1, ++q);
q->next = 0;
}
free_toks = p->next;
return p;
}
toknode::toknode(TOK t, YYSTYPE r, loc tloc)
{
tok = t;
used = 0;
retval = r;
place = tloc;
next = last = 0;
}
void
toknode::operator delete(void* vp,size_t)
{
register toknode* p = (toknode*)vp;
p->next = free_toks;
free_toks = p;
vp = 0;
}
#define USE_TOKEN(T,W) \
LDB(2,error('d',&(T)->place,"use_token('%k','%s')",(T)->tok,W);); \
if ( !(T)->used ) use_token(T);
Ptype
return_nstd_local_type( Pname n, TOK &sw )
{
Ptype tt;
switch ( n->tp->base ) {
case EOBJ:
case COBJ:
tt = Pbase(n->tp)->b_name->tp;
sw = n->tp->base;
break;
default:
tt = n->tpdef;
sw = NESTED; // in repr.c, prints ``typedef''
break;
}
return tt;
}
static Pname
local_nested_kludge( Pname n, Pname tn )
/*
* for backward compatibility with 2.0
* in transitional model of nested class types
*
* struct T { ... };
* foobar() {
* class X {
* typedef int T;
* // ...
* };
* T t;
* }
*
* pure nested classes, choose global struct T{};
* no nested classes, choose typedef int T
* transitional model: choose typedef, and generate warning
* BUG: local typedefs and enums do not have lex_level set
*/
{
// error( 'd', "local_nested_kludge: n: %n", n );
for ( Pname nn = n; nn; nn = nn->n_tbl_list )
{
Pname local_class;
TOK ntd;
if ( nn->n_key != NESTED ) continue;
Ptype tt = return_nstd_local_type(nn,ntd);
Pclass cl = tt->in_class;
while ( cl->in_class ) cl = cl->in_class;
if (cl->lex_level &&
(local_class = ktbl->look(cl->string,LOCAL)))
{
// same typedef at nested and non-nested scope
if (ntd == NESTED && tn && tn->tp == nn->tp )
;
else
error('w',"%s occurs at outer and nested localC scope; using %k %t::%s", n->string,ntd,cl,n->string);
/*
if ( ntd == NESTED && nn->n_dcl_printed != 2 ) {
nn->dcl_print(0);
nn->n_dcl_printed = 2;
}
*/
return nn;
}
}
return 0;
}
enum { one_back, two_back };
static void
use_token( toknode* T )
/*
lookup TNAMEs here instead of in tlex()
maintain block level
*/
{
static TOK last_tokens[2]; // TSCOPE not reduced at this point
static Pname last_tname; // tname :: id, where id is nested class
static Pname tdef_name; // typedef tname tdef_name
T->used = 1;
DB(if(Ldebug>=1) {
error('d',&T->place,"\n*** use_token(%k )",T->tok);
printok(T);
error('D',&T->place," lasttk%k last_tname%n last tokens%k%k",lasttk,last_tname,last_tokens[one_back],last_tokens[two_back]);
});
switch ( T->tok ) {
case ID:
Pname n;
// error('d', &T->place, "use_token: %s", T->retval.s );
if ( last_tokens[one_back] == MEM &&
last_tokens[two_back] == TNAME &&
(n=ktbl->look(T->retval.s,NESTED)))
{ // TYPEDEF :: ID, nested class ctor
if (tdef_name && tdef_name->n_key==NESTED &&
strcmp(tdef_name->string,n->string)==0)
{
T->tok = TNAME;
T->retval.pn = n;
break;
}
else { // TNAME :: ID, where ID may be nested class
for ( Pname nn = n; nn; nn = nn->n_tbl_list )
{
TOK sw;
if ( nn->n_key != NESTED ) continue;
Ptype tt = return_nstd_local_type(nn,sw);
Pclass cl = tt->in_class;
if (strcmp(last_tname->string,cl->string)==0)
{
T->tok = TNAME;
T->retval.pn = nn;
break;
}
}
}
}
else
if ( bl_level &&
// TNAME:: and :: cannot refer to ``local'' TNAME
last_tokens[one_back] != MEM &&
(n=ktbl->look(T->retval.s,LOCAL)) )
{
DB( if(Ldebug>=1)error( 'd', &T->place, "use_token: local class instance: %n", n ) );
T->tok = TNAME;
T->retval.pn = n;
}
else if ( n=ktbl->look(T->retval.s,0) ) {
DB( if(Ldebug>=1)error( 'd', &T->place, "use_token:GC instance: %n", n ) );
// error( 'd', &T->place, "use_token:GC instance: %n %t", n, n->tp );
// X:: ?, then n cannot be a global TNAME
// except in the case of a constructor
if (last_tokens[one_back] == MEM &&
last_tokens[two_back] == TNAME &&
strcmp(T->retval.s,last_tname->string))
; // do nothing; i.e., return ID
else
if ( bl_level && n->tp->base != COBJ &&
last_tokens[one_back] == MEM &&
last_tokens[two_back] != TNAME &&
gtbl->look(T->retval.s,0))
; // do nothing: local typedefs & enums not implemented
else {
Pname nn = 0;
TOK ntd;
if (bl_level && (nn=ktbl->look(T->retval.s,NESTED)))
{
(void) return_nstd_local_type(n,ntd);
nn = local_nested_kludge(nn,ntd==NESTED?n:0);
}
T->tok = TNAME;
T->retval.pn = nn?nn:n;
}
}
#ifdef DBG
else if(Ldebug>=1)
error('d',&T->place,"use_token: id %s",T->retval.s);
#endif
break;
case LC: ++bl_level; break;
case RC: --bl_level; break;
}
if (T->tok != COMPL || last_tokens[one_back] != MEM) {
last_tokens[two_back] = last_tokens[one_back];
last_tokens[one_back] = T->tok;
if (T->tok == TNAME) last_tname = T->retval.pn;
if ( last_tname &&
last_tname->tp->base == TYPE )
{
tdef_name = last_tname;
do
tdef_name = Pbase(tdef_name->tp)->b_name;
while ( tdef_name->tp->base == TYPE );
}
}
}
void
addtok(TOK t, YYSTYPE r, loc tloc)
{
toknode* T = new toknode(t,r,tloc);
if (front == 0)
front = rear = T;
else {
rear->next = T;
T->last = rear;
rear = T;
}
//error('d',&tloc,"addtok: %k '%s'",t,t==ID?r.s:"");
//showQ("addtok");
}
extern TOK
deltok( int noset = 0 )
{
register toknode* T = front;
USE_TOKEN(T,"deltok");
register TOK tk = T->tok;
if ( !noset ) { yylval = T->retval; curloc = T->place; }
curr_file = curloc.file;
if (front = front->next)
front->last = 0;
else
latok = rear = 0;
delete T;
return tk;
}
static void
add_tokens()
/*
extend lookahead token queue when depleted
*/
{
TOK tk = tlex();
if ( tk != ID )
return;
while (tk == ID || tk == MEM || tk == DOT )
tk = tlex();
}
extern TOK
la_look()
/*
peek at head of token queue
*/
{
LDB(1,fprintf(stderr,"\n*** la_look()"));
if ( front == 0 )
add_tokens();
latok = front;
USE_TOKEN(latok,"la_look");
LDB(1,fprintf(stderr," -- %s\n",image(latok->tok)));
return latok->tok;
}
#define NEXTTOK() ( (yychar==-1) ? (yychar=lalex(),yychar) : yychar )
void
check_decl()
/*
Lookahead to direct parsing of local/arg type declarations
la_decl() returns 1 if lookahead sees a declaration.
*/
{
TOK tk2;
switch( NEXTTOK() ) {
default:
break;
case TSCOPE: //XXX
tk2 = la_look();
while ( tk2 == TSCOPE ) tk2 = lookahead();
if ( tk2 == TNAME ) {
toknode* t = latok;
if(t->tok!=TNAME)
error('i',&t->place,"check_decl() token scan");
tk2 = lookahead();
if ( tk2 == LP && la_decl() ) {
t->tok = DECL_MARKER; //TNAME
}
}
break;
case TYPE: case TNAME:
if ( la_look() == LP && la_decl() ) {
must_be_id = 0;
DECL_TYPE=yychar;
yychar = DECL_MARKER;
}
}
}
void
check_cast()
/*
Lookahead to direct parsing of cast
la_cast() returns 1 if lookahead sees an ambiguous old-style C cast.
*/
{
TOK tk2;
switch( NEXTTOK() ) {
case TSCOPE: //XXX
tk2 = la_look();
while ( tk2 == TSCOPE ) tk2 = lookahead();
if ( tk2 == TNAME ) {
toknode* t = latok;
if(t->tok!=TNAME)
error('i',&t->place,"check_cast() token scan");
tk2 = lookahead();
if ( tk2 == LP && la_decl() ) {
t->tok = DECL_MARKER;//TNAME
}
}
break;
case TYPE: case TNAME:
if ( la_look() == LP && la_cast() ) {
must_be_id = 0;
DECL_TYPE = yychar;
yychar = DECL_MARKER;
}
}
}
static int
latype( TOK t )
{
switch ( t ) {
default: // includes friend, typedef, storage classes, etc.
return 0;
case CHAR: case SHORT: case INT: case LONG:
case FLOAT: case DOUBLE:
case UNSIGNED:
return 1;
}
}
static int
laexpr( TOK t )
{
switch ( t ) {
default:
return 0;
case RETURN: case NEW: case AND: case ANDAND: case OR: case OROR:
case SIZEOF: case NOT: case COMPL: case MUL: case PLUS: case MINUS:
case ER: case ASSIGN: case ASOP: case RELOP: case EQUOP: case DIVOP:
case SHIFTOP: case ICOP:
return 1;
}
}
static toknode *get_next_token(toknode *t) {
if (! t->next)
add_tokens() ;
return t->next ;
}
static int template_tscope(Pname tn, toknode *lt)
/* provide the looakhead for determining TSCOPE tokens when the name is a
* parametrized type name; the lookahead here is non-trivial, because it
* involves stepping over the template arguments.
*/
{
int nest = 0 ; // the LT has been fetched
if (lt->tok != LT) error ('i', "a `<' token was expected") ;
// assume the worst, ensure that name strings are consed in the heap
templp->parameters_in_progress++ ;
for (toknode *t = lt;; t = get_next_token(t))
switch (t->tok) {
case LT:
++nest;
continue;
case GT:
// ***************
// need to fold in awareness of x::y::z
if (--nest == 0) {
t = get_next_token(t);
if (t->tok == MEM) {
// determine whether it is a memptr
if (t->next == 0) add_tokens();
if (t->next->tok == MUL) {
t->tok = MEMPTR;
t->next = t->next->next ;
} else t->tok = TSCOPE ;
t->retval.pn = tn ;
--templp->parameters_in_progress;
return 1;
}
else return 0 ;
}
continue;
case SM: case LC: case RC: // a quick exit in case of error
case EOFTOK:
--templp->parameters_in_progress;
return 0 ;
default:
continue;
}
}
static TOK
lookahead()
/*
advance lookahead pointer, lexing at end of Q
handle occurrences of TNAME and TSCOPE
(should be kept up to date with lalex())
*/
{
TOK tk;
TOK tk2;
TOK prev_tk = 0;
YYSTYPE lastval;
if ( latok == rear ) {
add_tokens();
if ( latok )
latok = latok->next;
else
latok = front;
}
else
latok = latok->next;
if ( latok->last ) {
prev_tk = latok->last->tok;
lastval = latok->last->retval;
}
nexttok:
USE_TOKEN(latok,"lookahead1");
tk = latok->tok;
if ( tk == ID || tk == TNAME )
{
if (latok->next == 0) add_tokens();
USE_TOKEN(latok->next,"lookahead2");
/* TOK */ tk2 = latok->next->tok;
if ( tk == TNAME ) {
if (tk2 == LT) {
// a parametrized type name -- differentiate from TNAME
// so that it can be dealt with in the grammar.
if (template_tscope(latok->retval.pn, latok->next)) tk = PTNAME;
}
else
if ( tk2 == MEM || tk2 == DOT ) {
tscope:
tk = TSCOPE;
// error('d',"lookahead: tk: %k tk2: %k", tk, tk2 );
// XXX -- should be modified to loop and do lookup
latok = latok->next;
if (latok->next == 0) add_tokens();
USE_TOKEN(latok->next,"lookahead3");
tk2 = latok->next->tok;
if ( tk2 == MUL ) {
tk = MEMPTR;
latok = latok->next;
}
}
else if (( prev_tk == MUL && tk2 != RP )
|| prev_tk == AND )
{
tk = ID;
latok->retval.pn->hide();
latok->tok = ID;
latok->retval.s = latok->retval.pn->string;
}
}
else if ( tk2 == MEM ) {
// ID ::
//XXX latok = latok->next->next;
//XXX goto nexttok;
goto tscope; // treat as tscope
}
if ( tk == ID &&
( tk2 == ID ||
( prev_tk == ID && ( tk2 == COLON || tk2 == LC )))) {
// ID ID
latok = latok->next;
goto nexttok;
}
}
if ( tk == ID ) {
Pname nstd = ktbl->look(latok->retval.s,NESTED);
if (nstd && (must_be_id == 0 ||
must_be_id && prev_tk == LP)) {
extern Pname check_for_nested(Pname,TOK,YYSTYPE,TOK); // use this in lalex, too
Pname n = check_for_nested(nstd,prev_tk,lastval,tk2);
if ( n ) {
tk = latok->tok = TNAME;
latok->retval.pn = n;
}
}
}
return tk;
}
static Pname mem_sel = 0;
static Pname
do_local_class( Pname n, int lex_level )
{ /*
* modify to ``do_local_type:
* do local types: enums and typedefs
*/
Pname nn = n;
if ( n->tp ) { // already a TNAME
Pclass cl = n->tp->base==COBJ ? Pclass(Pbase(n->tp)->b_name->tp) : 0;
if ( n->lex_level != lex_level || (cl && cl->lcl) ) {
local_hide( n );
nn = new name( n->string );
nn->lex_level = lex_level>=0?lex_level:0;
}
else
if ( lex_level == n->lex_level && cl->defined ) {
error( "localC %n redefined", n );
return n;
}
}
nn = nn->tname( lastval.t );
modified_tn = modified_tn->l;
nn->n_key = LOCAL;
local_class = new name_list( nn, local_class );
local_blk = new name_list( nn, local_blk );
// error('d', "do_local_class: nn %n tp %t", nn, Pclass(Pbase(nn->tp)->b_name->tp));
return nn;
}
static char*
make_nested_name( char *s, Pclass cl )
{ // Q<cnt>_<class_names><space><null>
const nested_depth = 9;
char *str_arr[nested_depth];
int size_arr[nested_depth];
int cnt = 2;
int size = 4; // Q,<cnt>,<_>,<null>
str_arr[0] = s; str_arr[1] = cl->string;
size += size_arr[0] = strlen(s);
size += size_arr[1] = cl->strlen?cl->strlen:strlen(cl->string);
for (Pclass nc = cl->in_class; nc; nc = nc->in_class ) {
if (cnt > nested_depth-1) error('s',"nested depth class beyond %d unsupported",nested_depth);
size += size_arr[cnt] = nc->strlen?nc->strlen:strlen(nc->string);
str_arr[cnt++] = nc->string;
}
for ( int i=0; i<cnt; i++ ) // <nnn><string>
size += size_arr[i]>99?3:size_arr[i]<10?1:2;
//error('d', "make_nested_name( %s, %t ) cnt: %d size: %d", s, cl, cnt, size );
char *result = new char[size];
sprintf(result, "Q%d_", cnt );
size = 3;
for ( i=cnt; i; i-- ) {
sprintf(result+size,"%d%s", size_arr[i-1], str_arr[i-1]);
size += size_arr[i-1] + (size_arr[i-1]>99?3:size_arr[i-1]<10?1:2);
}
//error('d', "size: %d ", size );
result[size] = '\0';
//error('d', "make_nested_name result: %s", result );
return result;
}
int is_empty( Pclass cl, bit const_chk )
{ /* for nested class check, empty means *no* members
* for const object check, means no *data* members
*/
// error('d',"%t->is_empty: max: %d real_size: %d", cl, cl->memtbl->max(),cl->real_size );
int mbr_cnt = cl->memtbl->max();
if ( mbr_cnt == 0 ) return 1;
if ( cl->baselist == 0 && cl->real_size!=1 )
return 0;
// empty class to turn on transitional nested class scope
if ( const_chk == 0 &&
( cl->baselist != 0 || mbr_cnt > 1 )) return 0;
int i = 1;
for (Pname nn=cl->memtbl->get_mem(i); nn; nn=cl->memtbl->get_mem(++i)) {
if (nn->base==NAME &&
nn->n_union==0 &&
nn->tp->base!=FCT &&
nn->tp->base!=OVERLOAD &&
nn->tp->base!=CLASS &&
nn->tp->base!=ENUM &&
nn->tp->base!=EOBJ &&
nn->n_stclass != STATIC)
{
if ( nn->string[0]=='_' &&
nn->string[1]=='_' &&
nn->string[2]=='W' )
return 1;
else return 0;
}
}
return 1; // if here, no data members encountered
}
static int
is_empty( Penum en )
{ // is this an empty enum ??
// error('d', "%t no_of_enumerators: %d", en, en->no_of_enumerators);
if ( en->no_of_enumerators != 0 )
return 0;
return 1;
}
static Pname
check_nested_type( Pname nm )
{
// error('d', "check nested type: %n ccl: %t", nm, ccl );
Pname nx, n = ktbl->look(nm->string, NESTED);
if ( n == 0 || n == nm ) return nm;
int cnt = 1;
for (nx = n; n; n=n->n_tbl_list )
if (n->n_key == NESTED) ++cnt;
if ( cnt > 1 ) {
error( "ambiguous nested type %s (%d instances), use x::y syntax", nm->string, cnt );
error( 'i', "cannot recover from previous errors" );
}
else {
TOK ntk;
Ptype tt = return_nstd_local_type(nx,ntk);
error('w', "use %t:: to access nested %k %s (anachronism)", tt->in_class, ntk, nx->string);
}
return nx;
}
static int
in_local_class( Pclass cl )
{
if ( cl->lex_level )
return 1;
if ( cl->in_class )
return in_local_class( cl->in_class );
return 0;
}
Pname
do_nested_type( Pname n )
{
Pname nn = n;
char *str = 0;
// error('d', "do_nested_type: %s in_typedef: %d ccl: %t", n->string, in_typedef, ccl );
if ( in_typedef && ccl->string[0]=='_'
&& ccl->string[1]=='_'
&& ccl->string[2]=='C') return n;
if ( n->tp )
{ // already a TNAME :
// hide existing instance, encode new instance
/*
* need handle the anomaly:
* class x;
* x *p;
* class y {
* class x{ ... }; // oops
* };
*/
if (n->tp->base==COBJ) {
Pclass cl = Pclass(Pbase(n->tp)->b_name->tp);
if (cl->defined == 0 && lasttk == AGGR) {
error('w',"forwardD ofC%n resolved to nested%t::%s",n,ccl,n->string);
cl->lcl = new char[9];
strcpy(cl->lcl,"FUDGE007"); // license to hack
n->lex_level=Pbase(n->tp)->b_name->lex_level=0;
return n;
}
}
else if (n->tp->base==EOBJ) { // watch out for enum x;
Penum en = Penum(Pbase(n->tp)->b_name->tp);
if (en->defined == 0 && lasttk == ENUM) return n;
}
nested_hide( n );
nn = new name( n->string );
str = make_nested_name( n->string, ccl );
}
else
// make sure we haven't already seen a nested instance
// if so, for transition, this needs to be an error
if (ktbl->look( n->string, NESTED ))
error("multiple type %s nestings (to do this define an empty class/enum %s {};)",n->string,n->string);
if ( in_typedef ) {
if (strcmp(ccl->string, nn->string)==0) { // class x { typedef T x;
error( "nested Tdef %s redefines immediately enclosing class", nn->string );
error( 'i', "cannot recover from previous errors" );
}
// make sure there isn't an identifier at global scope being defined
// by a nested typedef -- previously an error; keep it so for transition
Pname tn;
if ( n->tp == 0 && in_local_class(ccl)==0 &&
(tn=gtbl->look(n->string,0))) {
error( "nested Tdef %s redefinesG %n", n->string, tn );
error( 'i', "cannot recover from previous errors" );
}
nn->tpdef = new type;
nn->tpdef->nested_sig = str;
nn->tpdef->in_class = ccl;
nn->tpdef->lex_level = NESTED;
PERM(nn->tpdef);
}
else {
nn = nn->tname( lastval.t );
Pname tn = Pbase(nn->tp)->b_name;
Ptype tt = tn->tp;
if ( tt->defined && tt->in_class == ccl) {
error( "nested %t redefines immediately enclosing class", nn->string );
error( 'i', "cannot recover from previous errors" );
}
tt->nested_sig = str;
modified_tn = modified_tn->l;
nn->lex_level = tn->lex_level = 0;
nested_type = new name_list( nn, nested_type );
}
nn->n_key = NESTED;
return nn;
}
static Pname dtor_seen;
static int in_expr;
extern int in_sizeof;
extern TOK
lalex()
/* return next token to grammar */
{
register TOK tk;
if ( front == 0 )
add_tokens(); // extend lookahead queue
LDB(1,fprintf(stderr,"\n*** lalex()\n");showQ("before"));
gettok:
tk = deltok();
// error('d',&curloc,"lalex: just got %k '%s' in_typedef: %d",tk,tk==ID?yylval.s:tk==TNAME?yylval.pn->string:"", in_typedef);
if ( tk == ID || tk == TNAME )
{
TOK tk2 = la_look();
int lex_level = bl_level - in_class_decl - (tk2 == LC );
if ( tk == TNAME )
{
//error('d', "lalex tname %n; lasttk: %k tk2: %k", yylval.pn, lasttk, tk2);
//error('d', " must_be_id: %d must_be_expr %d decl_type %d",must_be_id,must_be_expr,DECL_TYPE);
//error('d', " bl_level: %d parsing_members %d",bl_level,parsing_class_members);
if ( tk2 == LP
&& (bl_level == 0 || parsing_class_members)
&& ( laexpr(lasttk) == 0 )
&& must_be_expr == 0
&& DECL_TYPE == 0 ) {
if (la_decl()) {
must_be_id = 0;
DECL_TYPE = tk;
tk = DECL_MARKER;
goto ret;
}
}
// note: *** can handle local typedefs here, too!
if ( in_typedef &&
in_typedef->base != 0 &&
ccl && in_mem_fct == 0 &&
(tk2 == SM || tk2 == RP || tk2 == LB))
yylval.pn = do_nested_type(yylval.pn);
if ( lasttk == AGGR || lasttk == ENUM ) {
if ( tk2 == LC || tk2 == COLON ) { // class definition
if ( lex_level
&& (in_class_decl==0 || in_mem_fct)
&& lasttk != ENUM ) // temporary
yylval.pn = do_local_class( yylval.pn, lex_level );
else
if ( in_class_decl && ccl )
yylval.pn = do_nested_type( yylval.pn );
}
}
if (tk2 == LT) {
// a parametrized type name
if (template_tscope(yylval.pn,latok))
tk = PTNAME ;
} else
if ( tk2 == MEM || (tk2 == DOT && mem_sel == 0 )) {
if (tk2==DOT)
error(strict_opt?0:'w',"``.'' used for qualification; please use ``::'' (anachronism)");
crunch:
tk = TSCOPE;
{//XXX -- should be modified to do lookup and del at each ::
while ( (tk2 = lookahead()) == TSCOPE ) ;
if ( tk2 == TNAME ) {
tk2 = lookahead();
if ( tk2 == LP
&& (bl_level == 0 || parsing_class_members)
&& ( laexpr(lasttk) == 0 )
&& must_be_expr == 0
&& DECL_TYPE == 0 ) {
if (la_decl()) {
must_be_id = 0;
//DECL_TYPE = tk;//???
DECL_TYPE = TNAME;
//front should be ::
front->tok = TSCOPE;
front->retval.pn = yylval.pn;
yylval.pn = 0;
tk = DECL_MARKER;
goto ret;
}
}
}
}
tk2 = deltok(1);
tk2 = la_look();
if ( tk2 == MUL ) {
tk = MEMPTR;
tk2 = deltok(1);
}
}
// Have a TNAME. Check to be sure.
else if ( must_be_id ){
//error('d',"lalex: must_be_id: <tname %n> <%k>",yylval.pn,tk2);
if ( in_class_decl
&& lasttk == TYPE
&& tk2 == LP
&& strcmp(yylval.pn->string,ccl->string) == 0 )
error("%nK with returnT", yylval.pn);
else if ( lasttk == TYPE && lastval.t == OVERLOAD
&& ( tk2 == SM || tk2 == LP ) )
{
tk = ID;
yylval.pn->hide();
yylval.pn = new name( yylval.pn->string );
yylval.pn->n_oper = TNAME;
}
else if ( lasttk == OPERATOR ||
in_typedef && yylval.pn->n_key == NESTED)
must_be_id = 0;
else if ( lasttk != TSCOPE // watch out for X::X
|| lastval.pn != yylval.pn
|| (in_typedef &&
in_typedef->check( yylval.pn->tp,0) == 0 ))
{
tk = ID;
if ( in_typedef && (lasttk == MUL || lasttk == REF)) {
defer_check = 1;
in_tag = yylval.pn;
}
if ( lasttk == MEM && yylval.pn->lex_level ) {
Pname nn = gtbl->look( yylval.pn->string, 0 );
if (nn == 0 )
error( "%k%s undeclared", lasttk, yylval.pn->string);
else
yylval.pn = nn;
}
else {
// error('d',"lalex: else: lasttk: %k", lasttk );
if (lasttk!=DOT && lasttk!=REF
&& lasttk!=TSCOPE && lasttk != GOTO ) {
// handle typedefs in basetype::check
// when type is available
if (!in_typedef) {
// error('d',"\"%s\" line %d: hiding%n",__FILE__,__LINE__,yylval.pn);
yylval.pn->hide();
}
yylval.pn = new name(yylval.pn->string);
yylval.pn->n_oper = TNAME;
}
}
if ( defer_check ) defer_check = 0;
}
} // must_be_id
if ( in_class_decl &&
ccl->lex_level &&
yylval.pn->lex_level != 0 &&
yylval.pn->tp &&
(yylval.pn->tp->base != COBJ && yylval.pn->tp->base != EOBJ))
{
Pname n = gtbl->look( yylval.pn->string,0);
if ( in_mem_fct ) {
if (n && n->base == TNAME ) {
error('w', "local typedef %n(%t) is not in scope of local class %s members; usingG (%t)", yylval.pn, yylval.pn->tp, ccl->string, n->tp );
yylval.pn = n;
} else
error( "local typedef %sis not in scope of inline member function of local class %s", yylval.pn->string, ccl->string);
}
}
// if we still have a TNAME, make sure have the right TNAME
// possibility of ananchronistic reference to nested type
Ptype nbt = yylval.pn->tp;
if (tk == TNAME && curr_scope == 0 && nbt && // Y y; not X::Y y;
(nbt->base == EOBJ || nbt->base == COBJ))
{
Ptype t = Pbase(nbt)->b_name->tp;
if ( ccl && t->in_class &&
strcmp(t->in_class->string, ccl->string))
{
switch( nbt->base ) {
case COBJ:
if (is_empty(Pclass(t)))
yylval.pn = check_nested_type( yylval.pn );
break;
case EOBJ:
if (is_empty(Penum(t)))
yylval.pn = check_nested_type( yylval.pn );
break;
};
}
}
}
else
{ // tk == ID
char *s = yylval.s;
Pname n = ktbl->look( s, HIDDEN );
Pname nstd = ktbl->look( s, NESTED );
// inside a class definition, ccl, that is nested
// s is a nested class name, and is the name of ccl
if (ccl && ccl->in_class && nstd &&
strcmp(s, ccl->string)==0)
{
for (Pname nn=nstd; nn; nn=nn->n_tbl_list) {
Ptype tt = (nn->tp->base==COBJ || nn->tp->base==EOBJ)
? Pbase(nn->tp)->b_name->tp : nn->tpdef;
Pclass cl = tt->in_class;
if ( nn->n_key != NESTED ) continue;
if (strcmp(ccl->in_class->string,cl->string) == 0) {
tk = TNAME;
yylval.pn = nn;
n = nstd = nn;
}
}
}
if (tk2 == MEM) {
// ID ::
if (n) {
yylval.pn = n;
/*XXX*/ goto crunch;
}
else
if (nstd &&
nstd->n_tbl_list==0)
{
yylval.pn = nstd;
tk = TSCOPE;
tk2 = deltok(1);
tk2 = la_look();
if (tk2 == MUL ) {
tk = MEMPTR;
tk2 = deltok(1);
}
}
else {
error( "%s:: %sis not aTN", s, s );
tk2 = deltok(1);
goto gettok;
}
}
else // transitional kludge
if ( n && nstd && n == nstd )
; // null statement
// Have an ID. Check last token to be sure.
else if (lasttk==ENUM || lasttk==AGGR &&
// template <class id, class id>
(tk2 != GT && tk2 != CM))
{
int fd = tk2!=LC && tk2!=COLON;
tk = TNAME;
if ( nstd ) {
// in transitional model, need flag this as error
if ( fd == 0 ) { // real definition
if ( ccl == 0 )
error("nested andG%k %s(to do this placeG%k %s {}; first)",lasttk==ENUM?lasttk:CLASS, s, lasttk==ENUM?lasttk:CLASS, s);
else
error("multiple nested%k %s(to do this placeG%k %s {}; first)",lasttk==ENUM?lasttk:CLASS, s, lasttk==ENUM?lasttk:CLASS,s);
error( 'i', "cannot recover from previous errors" );
}
}
else
// new tag, define it
if (n==0 ||
(n->n_template_arg == template_type_formal))
{
// error('d', "ccl: %t fd: %d, in_mem_fct: %d, in_class_decl: %d", ccl, fd, in_mem_fct, in_class_decl);
n = new name( s );
if ( fd ) // struct X*, etc.
n->lex_level=0;
else
n->lex_level=lex_level>=0?lex_level:0;
if ( ccl && fd == 0 &&
in_class_decl &&
(bl_level == ccl->lex_level + in_class_decl + 1))
n = do_nested_type( n );
else
// note: ***** modify to handle local typedef
// note: ***** add local enums
if ( n->lex_level &&
lasttk != ENUM ) // temporary
n = do_local_class( n, n->lex_level );
else {
n = n->tname( lastval.t );
modified_tn = modified_tn->l;
if (fd && gtbl->look(n->string,0)) statStat = n;
}
}
else {
if (n->tp->base!=COBJ && n->tp->base!=EOBJ) {
error( 'i', "hidden%n:%t",n,n->tp );
goto gettok;
}
if ( tk2 == LC || tk2 == COLON ) {
// class declared and hidden but not yet defined
// may have ctor defined which invalidates hiding
statStat = n;
n->n_key = 0; // inside class definition it cannot be hidden
}
}
yylval.pn = nstd?nstd:n;
}
else {
tk = ID;
yylval.pn = new name( s );
}
if ( tk == ID )
{
switch ( tk2 ) {
case ID: case TNAME: case AGGR: case ENUM:
{
Pname n = 0;
if ((curr_scope||ccl) && nstd) {
// within class scope in which nested class is visible
// curr_scope == set by TSCOPE, X::foo() { ... }
// ccl == parsing class definition ``ccl''
char *str = curr_scope?curr_scope->string:ccl->string;
for (Pname nn=nstd; nn; nn=nn->n_tbl_list) {
Ptype tt = (nn->tp->base==COBJ || nn->tp->base==EOBJ)
? Pbase(nn->tp)->b_name->tp : nn->tpdef;
Pclass cl = tt->in_class;
if ( nn->n_key != NESTED ) continue;
if ( strcmp(str,cl->string) == 0){
tk = TNAME;
yylval.pn = nn;
if (lasttk == TYPE &&
lastval.t == TYPEDEF )
in_typedef = yylval.pn->tp;
break;
}
}
}
if (tk == TNAME) break; // found nested class
n = ktbl->look( s, HIDDEN );
if ( n ) {
Pname nn = n;
switch ( n->tp->base ) {
default:
error("typedef %sis not visible in this scope", s );
break;
case COBJ:
if (is_empty(Pclass(Pbase(n->tp)->b_name->tp)))
n = check_nested_type( nn );
if (nn == n)
error("%sis hidden: use struct %s%s", s,s,front->retval.s);
break;
case EOBJ:
if (is_empty(Penum(Pbase(n->tp)->b_name->tp)))
n = check_nested_type( nn );
if (nn == n)
error("%sis hidden: use enum %s%s", s,s,front->retval.s);
break;
};
tk = TNAME;
yylval.pn = n;
}
else
if (n=ktbl->look(s,NESTED))
{
TOK ntk;
bit ok = 0;
Ptype tt = return_nstd_local_type(n,ntk);
Pclass cl = tt->in_class;
if (ccl) {
// x::y unncessary with in_class,
// a derived class of in_class
// or classes enclosing in_class
if (ccl==cl || ccl->has_base(cl))
ok++;
else {
for (Pclass eccl=ccl->in_class;eccl; eccl=eccl->in_class)
if ( eccl == cl ) { ok++; break; }
}
}
if (!ok)
error('w', "use %t:: to access nested %k %s (anachronism)", cl, ntk, n->string );
tk = TNAME;
yylval.pn = n;
}
else { // probably a typo
if ( tk2 == ID )
error("%s%s: %sis not aTN", s,front->retval.s,s);
else if ( tk2 == TNAME )
error("%s%s: %sis not aTN", s,front->retval.pn->string,s);
else
error("%s%k: %sis not aTN", s,front->retval.t,s);
goto gettok;
}
break;
}
case DOT: case REF:
mem_sel = yylval.pn;
break;
default:
if ( lasttk == TNAME && tk2 == LC )
{
error("T%s %k: %s is unexpected", s, tk2, s );
goto gettok;
}
// have an ID. lets just make sure it should not be a TNAME
if (curr_scope||ccl||nstd) {
if (ccl && in_typedef &&
in_typedef->base != 0 &&
in_mem_fct == 0 &&
(tk2 == SM || tk2 == RP || tk2 == LB))
{
yylval.pn = do_nested_type( yylval.pn );
tk = TNAME;
}
else
if (nstd && must_be_id == 0 && in_expr == 0) {
// error('d',"nstd: %n must_be_id 0 have id tk2: %k lasttk: %k",nstd,tk2,lasttk);
// error('d',"nstd: in_expr %d lex_level %d",in_expr,lex_level);
Pclass xcl = curr_scope?Pclass(Pbase(curr_scope->tp)->b_name->tp):(ccl?ccl:0);
for (Pname nn=nstd; nn; nn=nn->n_tbl_list) {
TOK ntk;
bit ok = 0;
Ptype tt = return_nstd_local_type(nn,ntk);
Pclass cl = tt->in_class;
// error('d',"xcl: %t ccl: %t", xcl, ccl );
if ( xcl ) {
if (xcl==cl || xcl->has_base(cl) || ccl == cl)
ok++;
else {
for (Pclass eccl=xcl->in_class;eccl;eccl=eccl->in_class)
if ( eccl == cl ) { ok++; break; }
}
}
if (nn == nstd)
{
if (
// special case: foo(X,
// in_arg_list not set until **after** X is handled
((in_arg_list || lasttk==LP) && // foo(nestedX
(tk2==CM || tk2==ASSIGN ||
(tk2==RP && lasttk!=MUL && lasttk!=REF)))
|| // class x : public nestedX
(tk2==LC && (lasttk==PR || lasttk==VIRTUAL))
|| // nestedX [*&]
(tk2 == MUL || tk2==AND)
|| (lasttk==LP && tk2==RP)
|| (lasttk==TSCOPE && lastval.pn == nn)
|| (lasttk==COMPL && dtor_seen == nn)
|| (lasttk==TYPE && lastval.t == TYPEDEF)
|| lasttk == OPERATOR
|| lasttk == NEW || in_sizeof )
{ // must be type name, and it must be nested:
if ( nstd->n_tbl_list == 0 ) { // only one: ok
if (lasttk != TSCOPE && !ok )
error('w', "use %t:: to access nested %k %s (anachronism)", cl, ntk, nn->string);
break;
}
else {
if (lasttk != TSCOPE && lasttk != TYPE && !ok){
error("ambiguous nested type %s, use %t::%s",nn->string,xcl,nn->string);
error( 'i', "cannot recover from previous errors" );
}
}
}
}
if ( nn->n_key != NESTED ) continue;
if (xcl &&
strcmp(xcl->string,cl->string) == 0) break;
} // end: for nn = nstd
if (nn) {
tk = TNAME;
yylval.pn = nn;
if (lasttk == TYPE &&
lastval.t == TYPEDEF )
in_typedef = yylval.pn->tp;
}
} // end: if (nstd)
} // end: if (curr_scope||ccl)
break;
} // end: switch tk2
} // end: if (tk == ID)
}
// error('d',"testing for in_expr: in_expr: %d tk: %k", in_expr, tk );
// error('d',"testing for in_expr: tk2: %k lasttk: %k", tk2, lasttk );
if (lex_level && tk==ID && tk2==LP &&
(lasttk==LC || lasttk==RC || lasttk==RP ||
lasttk == ASSIGN || lasttk == SM))
in_expr = 1;
else in_expr = 0;
}
if ( tk == TNAME || ( tk == TYPE && latype(yylval.t) )
// XXX || tk == TSCOPE || tk == MEM
|| tk == REF || tk == DOT || tk == GOTO
|| tk == MEMPTR )
// TNAME cannot immediately follow a type name,
// scope operator, right curly, selection, or goto
must_be_id = 1;
else
must_be_id = 0;
switch ( tk ) {
case SM:
mem_sel = 0; // no break
in_expr = 0;
case RP: case RC: must_be_expr = 0; break;
case COLON:
if (lasttk == RP ||
(lasttk == TYPE && lastval.t == CONST))
must_be_expr = 1;
break;
case SIZEOF:
in_sizeof = 1;
break;
};
ret:
if ( tk == COMPL && lasttk == TSCOPE )
dtor_seen = lastval.pn;
else dtor_seen = 0;
lasttk = tk;
lastval = yylval;
LDB(1,showQ("after");
fprintf(stderr,"returning '%s'",image(tk));
if ( tk==ID || tk==TNAME ) fprintf(stderr," -- '%s'",yylval.pn->string);
fprintf(stderr,"\n");
);
// error('d',"returning tk: %k dtor_seen: %n", tk,dtor_seen );
return tk;
}
extern void
la_backup( TOK t, YYSTYPE r )
/*
called by parser to push token back on front of queue
*/
{
LDB(1,fprintf(stderr,"\n*** la_backup( '%s', ...)\n",image(t)));
if ( t == ID ) { Pname n = r.pn; r.s = n->string; DEL(n); }
register toknode* T = new toknode(t,r,curloc);
if (front) {
front->last = T;
T->next = front;
T->last = 0;
front = T;
} else
front = rear = T;
lasttk = 0;
}
extern int
la_sctype( TOK t )
{
//error('d',&latok->place,"la_sctype(%k ) -- latok ==%k",t,latok->tok);
if ( t != latok->tok && t != TSCOPE && t != MEMPTR )
error( 'i', &latok->place, "la_sctype, lalex.c" );
switch( latok->retval.t ) {
case TYPEDEF:
case EXTERN:
case STATIC:
case AUTO:
case REGISTER:
case OVERLOAD:
case INLINE:
case FRIEND:
case CONST:
case VOLATILE:
return 1;
default:
return 0;
}
}
extern int
la_cast()
/*
called in reduction of term_lp to check for ambiguous prefix-style cast
if result is 1, caller inserts DECL_MARKER to force reduction of cast
*/
{
// yychar already designates TYPE or TNAME
// LP must start the lookahead queue!
LDB(1,fprintf(stderr,"\n*** la_cast()\n"););
int tk, tk2 = latok->tok;
for ( ; ; ) {
tk = tk2;
tk2 = lookahead();
switch( tk ) {
case LP:
if ( tk2 == MUL || tk2 == AND ||
tk2 == TSCOPE || tk2 == MEMPTR )
// T ( * ...
// T ( C ::* ...
continue;
else
// T ( exp )
return 0;
case MUL: case AND:
//if ( tk2 == SCTYPE )
if ( la_sctype( tk2 ) )
// T ( * const ...
// T ( * volatile ...
tk2 = lookahead();
continue;
case MEMPTR:
if ( tk2 == RP ) continue;
break;
case TSCOPE:
if ( tk2 == MUL )
// T ( C :: * ...
continue;
else
// T ( exp )
return 0;
case RP: case LB:
// T (*)()
// T (*[])()
return 1;
}
return 0;
}
}
static int
la_decl()
/*
handles ambiguities
type (*x) ()
type (*x) []
at start of arg list / statement
return val == 1 if lookahead finds a declaration
(used for error messages only)
if declaration is "ambiguous" (i.e., can't be recognized with
1-symbol lookahead), insert DECL_MARKER to force reduction
of "type"
*/
{
// LP must start the lookahead queue!
LDB(1,fprintf(stderr,"\n*** la_decl()\n"););
int tk, tk2 = latok->tok;
int paren = 0;
int ptr = 0;
for ( ; ; ) {
tk = tk2;
tk2 = lookahead();
// fprintf(stderr,"\nla_decl:tk:%d %s tk2: %d %s", tk, keys[tk], tk2, keys[tk2]);
switch( tk ) {
case LP:
if ( tk2 == MUL || tk2 == AND || tk2 == TSCOPE ) {
// T ( * ...
++paren;
ptr = 1;
continue;
} else
if ( tk2 == MEMPTR ) {
// T ( C ::* ...
return 1;
} else
// possible redundant parens
if ( tk2 == ID && lookahead() == RP ) {
TOK tp = lookahead();
// error( 'd', "tp %k tk: %k tk2: %k", tp, tk, tk2 );
// error( 'd', "bl_level: %d, in_class_decl: %d", bl_level,in_class_decl );
if ( tp == SM || tp == CM || tp == ASSIGN )
{
// member initialization list
if ( tp != SM && in_arg_list == 0 ) return 1;
}
else
if ( tp == RP && (bl_level-in_class_decl==0))
return 1;
if ( tp != LP )
return 0;
latok=latok->last; // restore lookahead
++paren;
continue;
}
else
// T ( exp )
return 0;
case MUL: case AND:
//if ( tk2 == SCTYPE )
if ( la_sctype( tk2 ))
// T ( * const ...
// T ( * volatile ...
return 1;
else {
ptr = 0;
continue;
}
case MEMPTR:
// T ( C :: * ...
return 1;
case TSCOPE:
if ( tk2 == MUL ) //??tk SHOULD HAVE TRANSLATED TO MEMPTR!!
// T ( C :: * ...
return 1;
else if ( ptr )
// T ( exp )
return 0;
else if ( tk2 == ID || tk2 == OPERATOR )
// T ( * C :: id ...
continue;
else
// error
return 0;
}
break;
}
if ( tk == RP || tk == LB )
// T (*)()
// T (*[])()
return 1;
if ( tk != ID && tk != OPERATOR )
// T ( exp )
return 0;
if ( tk == OPERATOR )
switch ( tk2 ) {
case PLUS: case MINUS: case MUL: case REFMUL:
case AND: case OR: case ER: case SHIFTOP: case EQUOP:
case DIVOP: case RELOP: case ANDAND: case OROR:
case NOT: case COMPL: case ICOP: case ASSIGN:
case ASOP: case NEW: case GNEW: case DELETE:
// OPERATOR oper
tk2 = lookahead();
break;
case LP:
// OPERATOR ()
tk2 = lookahead();
if ( tk2 == RP ) {
tk2 = lookahead();
break;
} else
return 0;
case LB:
// OPERATOR []
tk2 = lookahead();
if ( tk2 == LB ) {
tk2 = lookahead();
break;
} else
return 0;
default: // illegal operator
return 0;
}
int allow_lp = 1;
int allow_rp = 1;
for ( ; ; ) {
tk = tk2;
tk2 = lookahead();
// fprintf(stderr,"\nla_decl2:tk:%d %s tk2: %d %s", tk, keys[tk], tk2, keys[tk2]);
switch( tk ) {
case LP:
if ( !allow_lp )
// T ( * id [ exp ] ( ...
return 0;
// Current lookahead will be a decl if
// the next lookahead is an arg decl
if ( tk2 == RP || tk2 == ENUM || tk2==AGGR
|| tk2==ELLIPSIS || la_sctype( tk2 ))
// T ( * id ()
// T ( * id ) ()
return 1;
if ( tk2 == TYPE || tk2 == TNAME ) {
// T ( * id ) ( T2 ...
if ( lookahead() == LP && !la_decl() )
return 0;
return 1;
}
return 0;
case LB:
if ( tk2 == RB || lookahead() == RB )
// T ( * id [] ...
return 1;
else {
// T ( * id [ exp ] ...
allow_lp = 0;
allow_rp = 1;
while ( lookahead() != RB );
tk2 = lookahead();
continue;
}
case RP:
// error ('d', "rp: allow_rp: %d paren: %d", allow_rp, paren );
if ( !allow_rp || !paren )
// T ( * id ) )
return 0;
// permit redundant parentheses
else
if ( tk2 == SM || tk2 == CM || tk2 == ASSIGN )
return 1;
else
if ( tk2 == RP && (bl_level-in_class_decl == 0))
return 1;
else
{
// T ( * id ) ...
allow_lp = 1;
allow_rp = 0;
--paren;
continue;
}
default:
return 0;
}
}
}
/*
** PROCESSING OF INLINE MEMBER FUNCTIONS
*/
static int la_snarf();
extern toknode*
save_text()
/*
save text of inline def on q of class
*/
{
// Q should contain at least the tokens < FDEF, X ... >
// where X is either LC or COLON (start of ftn)
LDB(2,fprintf(stderr,"save_text()"));
LDB(3,fprintf(stderr,"front: %s",image(front->tok)));
LDB(3,fprintf(stderr,"front->next: %s",image(front->next->tok)));
latok = front->next;
if ( la_snarf() ) {
// append this set of tokens to
// inline tokenq for class
toknode* t = front; // FDEF
if ( ccl->c_funqf == 0 )
ccl->c_funqf = front;
else {
ccl->c_funqr->next = front;
front->last = ccl->c_funqr;
}
ccl->c_funqr = latok;
front = latok->next;
latok->next = 0;
if (front) front->last = 0;
return t;
}
return 0;
}
extern void
restore_text()
/*
restore tokens for member inlines onto token q
*/
{
LDB(2,fprintf(stderr,"restore_text()"));
if (ccl->c_funqf == 0) // no inlines on Q
return;
LDB(3,fprintf(stderr," Q present: %d,%d",ccl->c_funqf,ccl->c_funqr));
LDB(3,fprintf(stderr," front==%s",image(ccl->c_funqf->tok)));
LDB(3,fprintf(stderr," rear ==%s",image(ccl->c_funqr->tok)));
ccl->c_funqr->next = front;
if (front) front->last = ccl->c_funqr;
front = ccl->c_funqf;
ccl->c_funqf = ccl->c_funqr = 0;
}
static void
del_tokens( toknode* marker )
/*
delete tokens from marker to latok, not inclusive
*/
{
if ( marker == 0 || marker == latok || marker->next == 0 )
error('i', "bad token queue");
LDB(2,fprintf(stderr,"del_tokens: %s..%s\n",image(marker->tok),image(latok->tok)));
register toknode* tt = marker->next;
if ( tt == latok ) return;
marker->next = latok;
latok->last->next = 0;
latok->last = marker;
register toknode* tx = tt;
do {
LDB(3,fprintf(stderr," deleting %s\n",image(tt->tok)));
tx = tx->next;
delete tt;
tt = tx;
} while ( tx );
}
static int
la_snarf()
/*
scan function def without processing declarations
*/
{
LDB(2,fprintf(stderr,"la_snarf()"));
loc *L = &latok->place;
//DBPLACE(1,L.l,L.f);
int parens = 0;
int paren_error = 0;
toknode* marker = latok;
switch ( latok->tok ) {
default:
error('i', L, "bad token Q snarfing function: %d", latok->tok);
case COLON:
break;
case LC:
--bl_level;
goto eatf;
}
LDB(2,fprintf(stderr,"\"eat\" member initializers"));
for (;;) {
if (latok->next == 0) add_tokens();
switch ( (latok=latok->next)->tok ) {
case LP:
++parens;
default:
LDB(3,fprintf(stderr,"...%s",image(latok->tok)));
continue;
case RP:
if ( (--parens < 0) && (paren_error++ == 0) )
error(0,&latok->place,"unbalanced ()");
continue;
case LC:
case RC:
if ( parens <= 0 )
goto eatf;
continue;
case SM:
if ( parens <= 0 ) {
error(0, L, "illegal bit field");
del_tokens( front );
delete front;
front = latok;
front->last = 0;
return 0;
}
continue;
case EOFTOK:
error('i',&latok->place,"unexpected end of file");
} // switch
} // for
eatf:
int level = 1;
for (;;) {
if (latok->next == 0) add_tokens();
switch ( (latok=latok->next)->tok ) {
case LC:
++level;
default:
LDB(3,fprintf(stderr,"...%s",image(latok->tok)));
continue;
case RC:
LDB(3,fprintf(stderr,"...RC"));
if (--level <= 0) {
if (level < 0) {
error(0,&latok->place,"unexpected '}'");
goto bad;
}
return 1;
}
break;
case EOFTOK:
error('e', &latok->place, "unbalanced {}");
goto bad;
} // switch
} // for
bad:
del_tokens( marker );
marker->tok = SM;
return 0;
}
Pname check_for_nested( Pname nstd, TOK lasttk, YYSTYPE lastval, TOK tk2)
{
// error('d',"nstd: %n must_be_id 0 tk2: %k lasttk: %d",nstd,tk2,lasttk);
TOK tk = ID;
Pclass xcl = curr_scope?Pclass(Pbase(curr_scope->tp)->b_name->tp):(ccl?ccl:0);
for (Pname nn=nstd; nn; nn=nn->n_tbl_list) {
TOK ntk;
bit ok = 0;
Ptype tt = return_nstd_local_type(nn,ntk);
Pclass cl = tt->in_class;
if ( xcl ) {
if (xcl==cl || xcl->has_base(cl))
ok++;
else {
for (Pclass eccl=xcl->in_class;eccl;eccl=eccl->in_class)
if ( eccl == cl ) { ok++; break; }
}
}
if (nn == nstd)
{
if ( ((in_arg_list || lasttk==LP) && // foo(nestedX
(tk2==CM || tk2==ASSIGN || tk2==RP))
|| (tk2==LC && (lasttk==PR || lasttk==VIRTUAL))
|| (tk2 == MUL || tk2==AND)
|| (lasttk==LP && tk2==RP)
|| (lasttk==TSCOPE && lastval.pn == nn)
|| (lasttk==COMPL && dtor_seen == nn)
|| (lasttk==TYPE && lastval.t == TYPEDEF)
|| lasttk == NEW || in_sizeof )
{
if ( nstd->n_tbl_list == 0 ) { // only one: ok
break;
} else {
if (lasttk != TSCOPE && !ok){
error("ambiguous nested type %s, use X::%s",nn->string,nn->string);
error( 'i', "cannot recover from previous errors" );
}
}
}
}
if ( nn->n_key != NESTED ) continue;
if (xcl && strcmp(xcl->string,cl->string) == 0) break;
} // end: for nn = nstd
return nn;
}
0707071010112044341004440001630000160000010203200466055404200000600000066146lex.c /*ident "@(#)ctrans:src/lex.c 1.4" */
/***************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
lex.c:
lexical analyser based on pcc's and cpre's scanners
modified to handle classes:
new keywords: class
public
call
etc.
names are not entered in the symbol table by lex()
names can be of arbitrary length
error() is used to report errors
{} and () must match
numeric constants are not converted into internal representation
but stored as strings
****************************************************************************/
#include "cfront.h"
#include "yystype.h"
#include "size.h"
#include "tqueue.h"
#include "template.h"
# define CCTRANS(x) x
#define copy_if_need_be(s) ((templp->in_progress || templp->parameters_in_progress) ? strdup(s) : (s))
/* lexical actions */
#define A_ERR 0 /* illegal character */
#define A_LET 1 /* saw a letter */
#define A_DIG 2 /* saw a digit */
#define A_1C 3 /* return a single character */
#define A_STR 4 /* string */
#define A_CC 5 /* character constant */
#define A_BCD 6 /* GCOS BCD constant */
#define A_SL 7 /* saw a / */
#define A_DOT 8 /* saw a . */
#define A_2C 9 /* possible two character symbol */
#define A_WS 10 /* whitespace (not \n) */
#define A_NL 11 /* \n */
#define A_LC 12 /* { */
#define A_RC 13 /* } */
#define A_L 14 /* ( */
#define A_R 15 /* ) */
#define A_EOF 16
#define A_ASS 17
#define A_LT 18
#define A_GT 19 /* > */
#define A_ER 20
#define A_OR 21
#define A_AND 22
#define A_MOD 23
#define A_NOT 24
#define A_MIN 25
#define A_MUL 26
#define A_PL 27
#define A_COL 28 /* : */
#define A_SHARP 29 /* # */
#define A_DOLL 30 /* $ */
/* character classes */
# define LEXLET 01
# define LEXDIG 02
/* no LEXOCT because 8 and 9 used to be octal digits */
# define LEXHEX 010
# define LEXWS 020
# define LEXDOT 040
const FIRSTCHUNK = 8*1024-8;
const BUFCHUNK = 4*1024-8;
/* text buffer */
static char inbuf[FIRSTCHUNK/*TBUFSZ*/];
static char* txtmax = &inbuf[FIRSTCHUNK/*TBUFSZ*/-1];
static char* txtstart = 0;
static char* txtfree = 0;
static struct buf* bufhead;
static buf* freebuf;
//static bufs;
struct buf {
buf* next;
char chars[BUFCHUNK];
// buf() { next=bufhead; bufhead=this; }
};
new_buf(char c)
{
//fprintf(stderr,"new_buf %d\n",bufs++);
buf* pbuf;
if (freebuf) {
pbuf = freebuf;
freebuf = freebuf->next;
}
else
pbuf = new buf; // allocate and register new chunk
pbuf->next = bufhead;
bufhead = pbuf;
if (BUFCHUNK < txtmax-txtstart) error('l',"lexical token too long");
// copy current token:
char* p = txtstart;
txtstart = txtfree = &pbuf->chars[0];
while (p<txtmax) *txtfree++ = *p++;
*txtfree++=c;
txtmax = &pbuf->chars[BUFCHUNK-1];
return 0;
}
#define pch(c) ((txtmax<=txtfree)?new_buf(c):(*txtfree++=c))
#define start_txt() txtstart = txtfree
#define del_txt() txtfree = txtstart
static int Nfile;// = 1;
static char* file_name[MAXFILE*4]; // source file names
// file_name[0] == src_file_name
// file_name[0] == 0 means stdin
static short file_stack[MAXFILE]; // stack of file name indices
static int tcurr_file; // current index in file_stack
// that is current #include nest level
Linkage linkage = linkage_default; // linkage is default C++
const LINKMAX = 10;
static Linkage lvec[LINKMAX] = { linkage_default };
static int lcount = 0;
void set_linkage(char* p)
{
if (p==0 || *p == 0) { // resume previous linkage
if (lcount>0) linkage = lvec[--lcount];
}
else {
if (LINKMAX<=++lcount) {
error('l',"linkage directive nested too deep");
--lcount;
} else if (strcmp(p,"C")==0)
lvec[lcount] = linkage = linkage_C;
else if (strcmp(p,"C++")==0)
lvec[lcount] = linkage = linkage_Cplusplus;
else {
error("%s linkage",p);
--lcount;
}
}
}
static struct loc tloc;
FILE * out_file = stdout;
FILE * in_file = stdin;
Ptable ktbl;
Ptable keyword_table;
static int p_level = 0; /* number of unmatched ``(''s */
static int b_level = 0; /* number of unmatched ``{''s */
# ifdef ibm
# define CSMASK 0377
# define CSSZ 256
# else
# define CSMASK 0177
# define CSSZ 128
# endif
static short lxmask[CSSZ+1];
int saved = 0; /* putback character, avoid ungetchar */
static int lxtitle();
// overload rt;
inline YYSTYPE rt(char* x) { YYSTYPE y; y.s = x; return y; }
inline YYSTYPE rt(int x) { YYSTYPE y; y.t = x; return y; }
inline YYSTYPE rt(loc x) { YYSTYPE y; y.l = x; return y; }
inline YYSTYPE rt(void* x) { YYSTYPE y; y.pn = Pname(x); return y; }
#define get(c) (c=getc(in_file))
#define unget(c) ungetc(c,in_file)
#define reti(a,b) { addtok(a, rt(b), tloc); return a; }
#define retn(a,b) { addtok(a, rt((Pnode)b), tloc); return a; }
#define rets(a,b) { addtok(a, rt(b), tloc); return a; }
#define retl(a) { addtok(a, rt(tloc), tloc); return a; }
// keys[] holds the external form for tokens with fixed representation
// illegal tokens and those with variable representation have 0 entries
char* keys[MAXTOK+1];
static void
new_key(char* s, TOK toknum, TOK yyclass)
/*
make "s" a new keyword with the representation (token) "toknum"
"yyclass" is the yacc token (for example new_key("int",INT,TYPE); )
"yyclass==0" means yyclass=toknum;
*/
{
Pname n = new name(s);
keys[(toknum==LOC)?yyclass:toknum] = s;
n = new name(s);
Pname nn = keyword_table->insert(n,0);
// if (Nold) error('i',"keyword %sD twice",s);
nn->base = toknum;
nn->syn_class = (yyclass) ? yyclass : toknum;
delete n;
}
const int keyword_count = 67;
static void
ktbl_init()
/*
enter keywords into keyword table for use by lex()
and into keyword representation table used for output
ktbl is only for types. We put nothing in it.
keyword_table is for user-defined reserved words
*/
{
ktbl = new table(KTBLSIZE,0,0);
keyword_table = new table(keyword_count,0,0);
new_key("asm",ASM,0);
new_key("auto",AUTO,TYPE);
new_key("break",LOC,BREAK);
new_key("case",LOC,CASE);
new_key("continue",LOC,CONTINUE);
new_key("char",CHAR,TYPE);
new_key("do",LOC,DO);
new_key("double",DOUBLE,TYPE);
new_key("default",LOC,DEFAULT);
new_key("enum",ENUM,0);
new_key("else",LOC,ELSE);
new_key("extern",EXTERN,TYPE);
new_key("float",FLOAT,TYPE);
new_key("for",LOC,FOR);
new_key("goto",LOC,GOTO);
new_key("catch",CATCH,CATCH);
new_key("try",TRY,TRY);
new_key("if",LOC,IF);
new_key("int",INT,TYPE);
new_key("long",LONG,TYPE);
new_key("return",LOC,RETURN);
new_key("register",REGISTER,TYPE);
new_key("static",STATIC,TYPE);
new_key("struct",STRUCT,AGGR);
new_key("sizeof",SIZEOF,0);
new_key("short",SHORT,TYPE);
new_key("switch",LOC,SWITCH);
new_key("typedef",TYPEDEF,TYPE);
new_key("unsigned",UNSIGNED,TYPE);
new_key("union",UNION,AGGR);
new_key("void",VOID,TYPE);
new_key("while",LOC,WHILE);
new_key("class",CLASS,AGGR);
new_key("const",CONST,TYPE);
new_key("delete",LOC,DELETE);
new_key("friend",FRIEND,TYPE);
new_key("inline",INLINE,TYPE);
new_key("new",NEW,0);
new_key("operator",OPERATOR,0);
new_key("overload",OVERLOAD,TYPE);
new_key("private",PRIVATE,PR);
new_key("protected",PROTECTED,PR);
new_key("public",PUBLIC,PR);
new_key("signed",SIGNED,TYPE);
new_key("template",TEMPLATE,0);
new_key("this",THIS,0);
new_key("virtual",VIRTUAL,TYPE);
new_key("volatile",VOLATILE,TYPE);
new_key("__statement", STATEMENT, 0) ;
new_key("__expression", EXPRESSION, 0) ;
new_key("__template_test", TEMPLATE_TEST, 0) ;
}
loc last_line;
loc noloc = { 0, 0 };
void loc::putline()
{
if (file==0 && line==0) return;
// fix, Nfile, not MAXFILE; Nfile == MAXFILE*4
// if (0<=file && file<MAXFILE) {
if ( 0<=file && file <= Nfile ) {
char* f = file_name[file];
if (f==0) f = src_file_name;
fprintf(out_file,line_format,line,f);
last_line = *this;
}
}
void loc::put(FILE* p)
{
// fix, Nfile, not MAXFILE; Nfile == MAXFILE*4
// if (0<=file && file<MAXFILE) {
if ( 0<=file && file <= Nfile ) {
char* f = file_name[file];
if (f==0) f = src_file_name;
fprintf(p,"\"%s\", line %d: ",f,line);
}
}
void lxenter(register char* s, short m)
/* enter a mask into lxmask */
{
register c;
while( c= *s++ ) lxmask[c+1] |= m;
}
void lxget(register c, register m)
/*
put 'c' back then scan for members of character class 'm'
terminate the string read with \0
txtfree points to the character position after that \0
*/
{
pch(c);
while ( (get(c), lxmask[c+1]&m) ) pch(c);
unget(c);
pch('\0');
}
struct LXDOPE {
short lxch; /* the character */
short lxact; /* the action to be performed */
TOK lxtok; /* the token number to be returned */
} lxdope[] = {
#ifdef apollo
'@', A_ERR, 0, /* illegal characters go here... */
#else
'$', A_DOLL, 0,
// '$', A_ERR, 0, /* illegal characters go here... */
#endif
'_', A_LET, 0, /* letters point here */
'0', A_DIG, 0, /* digits point here */
' ', A_WS, 0, /* whitespace goes here */
'\n', A_NL, 0,
'"', A_STR, 0, /* character string */
'\'', A_CC, 0, /* ASCII character constant */
'`', A_BCD, 0, /* 'foreign' character constant, e.g. BCD */
'(', A_L, LP,
')', A_R, RP,
'{', A_LC, LC,
'}', A_RC, RC,
'[', A_1C, LB,
']', A_1C, RB,
'*', A_MUL, MUL,
'?', A_1C, QUEST,
':', A_COL, COLON,
'+', A_PL, PLUS,
'-', A_MIN, MINUS,
'/', A_SL, DIV,
'%', A_MOD, MOD,
'&', A_AND, AND,
'|', A_OR, OR,
'^', A_ER, ER,
'!', A_NOT, NOT,
'~', A_1C, COMPL,
',', A_1C, CM,
';', A_1C, SM,
'.', A_DOT, DOT,
'<', A_LT, LT,
'>', A_GT, GT,
'=', A_ASS, ASSIGN,
'#', A_SHARP, 0,
EOF, A_EOF, EOFTOK
};
/* note: EOF is used as sentinel, so must be <=0 and last entry in table */
static struct LXDOPE *lxcp[CSSZ+1];
void
lex_init()
{
register struct LXDOPE *p;
register i;
register char *cp;
/* set up character classes */
/* first clear lexmask */
for(i=0; i<=CSSZ; i++) lxmask[i] = 0;
#ifdef apollo
lxenter( "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_$", LEXLET );
#else
lxenter( "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_", LEXLET );
#endif
lxenter( "0123456789", LEXDIG );
lxenter( "0123456789abcdefABCDEF", LEXHEX );
/* \013 should become \v someday; \013 is OK for ASCII and EBCDIC */
lxenter( " \t\r\b\f\013", LEXWS );
lxmask['.'+1] |= LEXDOT;
/* make lxcp point to appropriate lxdope entry for each character */
/* initialize error entries */
for( i= 0; i<=CSSZ; ++i ) lxcp[i] = lxdope;
/* make unique entries */
for( p=lxdope; ; ++p ) {
lxcp[p->lxch+1] = p;
if( p->lxch < 0 ) break;
}
/* handle letters, digits, and whitespace */
/* by convention, first, second, and third places */
cp = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
while( *cp ) lxcp[*cp++ + 1] = &lxdope[1];
cp = "123456789";
while( *cp ) lxcp[*cp++ + 1] = &lxdope[2];
cp = "\t\b\r\f\013";
while( *cp ) lxcp[*cp++ + 1] = &lxdope[3];
file_name[0] = src_file_name;
// set both curloc and tloc so curloc is valid at program startup
// curloc.file = tloc.file = 0;
curloc.line = tloc.line = 1;
ktbl_init();
lex_clear();
saved = lxtitle();
}
void lex_clear()
{
// delete extra buffers:
buf* p = bufhead;
bufhead = 0;
//if (p) {
//fprintf(stderr,"lex_clear\n");
//bufs=0;
//}
while (p) {
buf* pp = p;
p = p->next;
pp->next = freebuf;
freebuf = pp;
}
// re-set to static buffer:
txtstart = txtfree = inbuf;
txtmax = &inbuf[FIRSTCHUNK/*TBUFSZ*/-1];
}
int int_val(char hex)
{
switch (hex) {
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
return hex-'0';
case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
return hex-'a'+10;
case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
return hex-'A'+10;
}
}
void hex_to_oct()
/*
\x has been seen on input (in char const or string) and \ printed
read the following hexadecimal integer and replace it with an octal
*/
{
int i = 0;
int c;
get(c);
if (lxmask[c+1] & LEXHEX) {
i = int_val(c);
get(c); // try for two
if (lxmask[c+1] & LEXHEX) {
i = (i<<4) + int_val(c);
get(c); // try for three
if (lxmask[c+1] & LEXHEX)
i = (i<<4) + int_val(c);
else
unget(c);
}
else
unget(c);
}
else {
error("hexadecimal digitE after \\x");
unget(c);
}
// if (0377 < i) error('l',"hexadecimal constant too large");
i &= 0377;
pch(('0'+(i>>6)));
pch(('0'+((i&070)>>3)));
pch(('0'+(i&7)));
}
char * chconst()
/*
read a character constant into inbuf
*/
{
register c;
int nch = 0;
pch('\'');
for(;;) {
char* p;
char cc = 0;
switch (get(c)) {
case '\'':
goto ex;
case EOF:
error("eof in char constant");
goto ex;
case '\n':
error("newline in char constant");
goto ex;
case '\\':
if (SZ_INT == nch++) error('l',"char constant too long");
pch(c);
switch (get(c)){
case '\n':
++tloc.line;
default:
pch(c);
break;
case '4': case '5': case '6': case '7': // octal
p = txtfree;
cc = c-4;
case '0': case '1': case '2': case '3':
pch(c);
get(c); /* try for 2 */
if( lxmask[c+1] & LEXDIG && c<'8'){
pch(c);
get(c); /* try for 3 */
if (lxmask[c+1] & LEXDIG && c<'8') {
if (cc) *p = cc; // zap high bit
pch(c);
}
else
unget(c);
}
else
unget(c);
break;
case 'x': // hexadecimal
hex_to_oct();
break;
};
break;
default:
if (SZ_INT == nch++) error('l',"char constant too long");
pch(c);
}
}
ex:
if(nch==0)
error("empty char constant");
pch('\'');
pch('\0');
return txtstart;
}
void lxcom()
/* process a "block comment" */
{
register c;
for(;;)
switch (get(c)) {
case EOF:
error('w',"eof in comment");
return;
case '\n':
tloc.line++;
// Nline++;
break;
case '*':
if (get(c) == '/') return;
unget(c);
break;
case '/':
if (get(c) == '*') error('w',"``/*'' in comment");
unget(c);
break;
}
}
void linecom()
// process a "line comment"
{
register c;
get(c);
#ifdef DBG
if ( c=='@' && get(c)=='!' ) {
while ( get(c) != '\n' && c != EOF ) pch(c);
pch('\0');
process_debug_flags(txtstart);
del_txt();
}
#endif
for(;;get(c))
switch (c) {
case EOF:
error('w',"eof in comment");
return;
case '\n':
tloc.line++;
// Nline++;
saved = lxtitle();
return;
}
}
char eat_whitespace()
{
for(;;) {
register c = get(c);
lx:
switch (c) {
case EOF:
error('w',"unexpected comment");
return EOF;
case '/':
switch (get(c)) {
case '*':
lxcom();
break;
case '/':
linecom();
break;
default:
unget(c);
return '/';
}
break;
case '\n':
++tloc.line;
c = lxtitle();
goto lx;
case ' ':
case '\t':
break;
default:
return c;
}
}
}
void get_string()
{
int lxchar;
for(;;)
switch (get(lxchar)) {
case '\\':
pch('\\');
switch (get(lxchar)){
case '\n':
++tloc.line;
default:
pch(lxchar);
break;
case 'x': // hexadecimal
hex_to_oct();
break;
};
break;
case '"':
{ char* p = txtstart; // eat_whitespace() moves txtstart
if ((lxchar = eat_whitespace()) == '"') {
// string catenation, break with
// newline to avoid merging characters
// (e.g. "\xAB" "C")
pch('\\');
pch('\n');
continue; // eat '\"' and carry on
};
txtstart = p;
unget(lxchar);
pch(0);
return;
}
case '\n':
error("newline in string");
pch(0);
return;
case EOF:
error("eof in string");
pch(0);
return;
default:
pch(lxchar);
}
}
TOK tlex()
{
TOK ret;
Pname n;
// Ntoken++;
for(;;) {
register lxchar;
register struct LXDOPE *p;
start_txt();
if (saved) {
lxchar = saved;
saved = 0;
}
else
get(lxchar);
if (lxchar+1 >= CSSZ )
error( "illegal input character encountered: %d", lxchar );
switch( (p=lxcp[lxchar+1])->lxact ){
case A_1C: // eat up a single character, and return an opcode
reti(p->lxtok,p->lxtok);
case A_EOF:
if (p_level || b_level+lcount)
error("'%s' missing at end of input",(b_level+lcount) ? "}" : ")");
reti(EOFTOK,0);
case A_SHARP:
// cope with header file not ended with '\n'
unget('#');
saved = lxtitle();
continue;
case A_ERR:
{ if (' '<=lxchar && lxchar<='~') // ASCII printable
error("illegal character '%c' (ignored)",lxchar);
else
error("illegal character '0%o' (ignored)",lxchar);
continue;
}
case A_DOLL:
{ // lex a name of the for $id for template tree formals
Pname fn ;
lxget( lxchar, LEXLET|LEXDIG ) ;
if (!templp->in_progress || !txtstart[1]) {
// no name string immediately follows, treat it
// like an illegal character
error("illegal character '0%o' (ignored)",lxchar);
continue;
}
txtstart++ ;
if(fn=templ_compilation::tree_parameter(txtstart)) {
switch (fn->n_template_arg) {
case template_expr_tree_formal:
// retain the $ in the name
retn(ID, strdup(--txtstart)) ;
case template_stmt_tree_formal:
retn(SM_PARAM, fn) ;
}
}
error("%s wasn't a statement or expression formal", txtstart);
rets(ID, copy_if_need_be(txtstart));
}
case A_LET: // collect an identifier and check for keyword
{
char ll;
switch (ll = lxchar) {
// case 'l':
case 'L':
switch (get(lxchar)) {
case '\'':
error('s',"wide character constant");
unget(lxchar);
continue;
case '"':
error('s',"wide character string");
unget(lxchar);
continue;
}
unget(lxchar);
lxchar = ll;
}
}
lxget( lxchar, LEXLET|LEXDIG );
/* look for a keyword or a global type */
if ((n = keyword_table->look(txtstart,0)) /* keyword */
|| (n = ktbl->look(txtstart, 0))) /* local type */
{
TOK x;
del_txt();
switch (x=n->base) {
case TNAME:
rets(ID,n->string);
case LOC:
retl(n->syn_class);
case EXTERN:
if ((lxchar = eat_whitespace()) == '\"') {
// linkage directive
get_string();
rets(LINKAGE,txtstart);
}
unget(lxchar);
reti(TYPE,EXTERN);
case CATCH:
// case TEMPLATE:
error('s',"%k",n->syn_class);
continue;
case TRY:
{
static int warn_try;
if (!warn_try) {
Pname n = keyword_table->look("try",0);
n->n_key = DEFAULT;
error('w',&tloc,"%k is a future reserved keyword",n->syn_class);
warn_try++;
}
rets(ID,n->string);
}
default:
reti(n->syn_class,x);
}
}
// rets(ID,txtstart);
rets(ID, copy_if_need_be(txtstart)) ;
case A_DIG:
ret = ICON;
if (lxchar=='0') {
int pkchar;
get(pkchar);
if(pkchar=='x' || pkchar=='X') { // hex
pch(lxchar);
lxget(pkchar,LEXHEX);
txtfree--;
if (txtfree-txtstart<3) // minimum "0Xd\0"
error("hex digitX after \"0x\"");
get(lxchar);
goto getsuffix;
}
unget(pkchar);
}
lxget(lxchar,LEXDIG);
txtfree--;
if (get(lxchar) == '.') {
getfp:
lxget('.', LEXDIG );
txtfree--;
ret = FCON;
get(lxchar);
};
if (lxchar=='e' || lxchar=='E') {
pch(lxchar);
get(lxchar);
if(lxchar=='-' || lxchar=='+') {
pch(lxchar);
get(lxchar);
}
if (lxmask[lxchar+1] & LEXDIG) {
lxget( lxchar, LEXDIG );
txtfree--;
get(lxchar);
}
else
error("missing exponent digits?");
ret = FCON;
};
if(*txtstart=='0' && ret==ICON) {
char *bch = txtstart;
while (++bch <= txtfree) {
if(*bch=='8' || *bch=='9')
error("%c used as octal digit",*bch);
}
}
getsuffix:
switch (lxchar) {
case 'f':
case 'F':
if (ret==ICON)
error("%c suffix for integer constant",lxchar);
else
pch(lxchar);
break;
case 'u':
case 'U':
if (ret==FCON) {
error("%c suffix for floating constant",lxchar);
break;
}
pch(lxchar);
switch(get(lxchar)) {
case 'l':
case 'L':
pch(lxchar);
break;
default:
saved=lxchar;
break;
}
break;
case 'l':
case 'L':
pch(lxchar);
if (ret==FCON) {
break;
}
switch(get(lxchar)) {
case 'u':
case 'U':
pch(lxchar);
break;
default:
saved=lxchar;
break;
}
break;
default:
saved = lxchar;
break;
};
if(*txtstart=='0' && txtfree-txtstart==1)
reti(ZERO,0); // plain zero
pch(0);
rets(ret,txtstart);
case A_DOT:
switch (get(lxchar)) {
case '.': // look for ellipsis
if (get(lxchar) != '.') {
error("token .. ?");
saved = lxchar;
}
reti(ELLIPSIS,0);
case '*':
reti (REFMUL,DOT);
}
if (lxmask[lxchar+1] & LEXDIG){// look for floating constant
unget(lxchar);
goto getfp;
}
saved = lxchar;
reti(DOT,0);
case A_STR:
/* save string constant in buffer */
get_string();
rets(STRING,txtstart);
case A_CC:
/* character constant */
rets(CCON,chconst());
case A_BCD:
{
register i;
int j;
pch('`');
for (i=0; i<7; ++i) {
pch(get(j));
if (j == '`' ) break;
}
pch(0);
if (6<i)
error('l',"bcd constant exceeds 6 characters" );
rets(CCON,txtstart);
}
case A_SL: /* / */
switch (get(lxchar)) {
case '*':
lxcom();
break;
case '/':
linecom();
break;
case '=':
reti(ASOP,ASDIV);
default:
saved = lxchar;
reti(DIVOP,DIV);
}
case A_WS:
continue;
case A_NL:
++tloc.line;
// Nline++;
saved = lxtitle();
continue;
case A_LC:
if (BLMAX <= b_level++) {
error('l',"blocks too deeply nested");
ext(3);
}
retl(LC);
case A_RC:
if (lcount+b_level-- <= 0) {
error("unexpected '}'");
b_level = 0;
}
retl(RC);
case A_L:
p_level++;
reti(LP,0);
case A_R:
if (p_level-- <= 0) {
error("unexpected ')'");
p_level = 0;
}
reti(RP,0);
case A_ASS:
switch (get(lxchar)) {
case '=':
reti(EQUOP,EQ);
default:
saved = lxchar;
reti(ASSIGN,ASSIGN);
}
case A_COL:
switch (get(lxchar)) {
case ':':
reti(MEM,0);
case '=':
error("':=' is not a c++ operator");
reti(ASSIGN,ASSIGN);
default:
saved = lxchar;
reti(COLON,COLON);
}
case A_NOT:
switch (get(lxchar)) {
case '=':
reti(EQUOP,NE);
default:
saved = lxchar;
reti(NOT,NOT);
}
case A_GT:
switch(get(lxchar)) {
case '>':
switch (get(lxchar)) {
case '=':
reti(ASOP,ASRS);
break;
default:
saved = lxchar;
reti(SHIFTOP,RS);
}
case '=':
reti(RELOP,GE);
default:
saved = lxchar;
reti(GT,GT);
}
case A_LT:
switch (get(lxchar)) {
case '<':
switch (get(lxchar)) {
case '=':
reti(ASOP,ASLS);
default:
saved = lxchar;
reti(SHIFTOP,LS);
}
case '=':
reti(RELOP,LE);
default:
saved = lxchar;
reti(LT,LT);
}
case A_AND:
switch (get(lxchar)) {
case '&':
reti(ANDAND,ANDAND);
case '=':
reti(ASOP,ASAND);
default:
saved = lxchar;
reti(AND,AND);
}
case A_OR:
switch (get(lxchar)) {
case '|':
reti(OROR,OROR);
case '=':
reti(ASOP,ASOR);
default:
saved = lxchar;
reti(OR,OR);
}
case A_ER:
switch (get(lxchar)) {
case '=':
reti(ASOP,ASER);
default:
saved = lxchar;
reti(ER,ER);
}
case A_PL:
switch (get(lxchar)) {
case '=':
reti(ASOP,ASPLUS);
case '+':
reti(ICOP,INCR);
default:
saved = lxchar;
reti(PLUS,PLUS);
}
case A_MIN:
switch (get(lxchar)) {
case '=':
reti(ASOP,ASMINUS);
case '-':
reti(ICOP,DECR);
case '>':
if (get(lxchar) == '*')
{reti(REFMUL,REF);}
else
saved = lxchar;
reti(REF,REF);
default:
saved = lxchar;
reti(MINUS,MINUS);
}
case A_MUL:
switch (get(lxchar)) {
case '=':
reti(ASOP,ASMUL);
case '/':
error('w',"*/ not as end of comment");
default:
saved = lxchar;
reti(MUL,MUL);
}
case A_MOD:
switch (get(lxchar)) {
case '=':
reti(ASOP,ASMOD);
default:
saved = lxchar;
reti(DIVOP,MOD);
}
default:
{error('i',"lex act==%d getc()->%d",p,lxchar);}
}
error('i',"lex, main switch");
}
}
int lxtitle()
/*
called after a newline; set linenumber and file name
*/
{
register c;
for(;;)
switch ( get(c) ) {
default: // e.g. not '\n', not '#'
return c;
case '\n':
tloc.line++;
// Nline++;
ll:
break;
case '#': /* # lineno "filename" */
{ int cl = tloc.line;
tloc.line = 0;
for(;;)
switch (get(c)) {
case '"':
start_txt();
for(;;)
switch (get(c)) {
case '"':
pch('\0');
while (get(c) != '\n') ; // skip to eol.. ignore anything more
if (*txtstart) { // stack file name
char* fn;
if (tcurr_file == 0){
if (( fn = file_name[0])
&& (strcmp(txtstart,fn)!=0)){ // 1st include
if (MAXFILE*4<++Nfile) error('i',"fileN buffer overflow");
if (MAXFILE<++tcurr_file) error('i',"fileN stack overflow");
file_stack[tcurr_file] = Nfile;
char* p1 = new char[txtfree-txtstart];
(void) strcpy(p1,txtstart);
file_name[Nfile] = p1;
// Nstr++;
}
else { //&& line is dummy #line "input.c"
// ignore
}
//&& dead, dead, dead goto push;
}
else if ( (fn=file_name[file_stack[tcurr_file]])
&& (strcmp(txtstart,fn)==0) ) {
//new line, same file: ignore
}
else if ( (fn=file_name[file_stack[tcurr_file-1]])
&& (strcmp(txtstart,fn)==0) ) {
// previous file: pop
tcurr_file--;
}
else { // new file name: push
//&& push:
if (MAXFILE*4<Nfile++) error('i',"fileN buffer overflow");
if (MAXFILE<tcurr_file++) error('i',"fileN stack overflow");
file_stack[tcurr_file] = Nfile;
char* p = new char[txtfree-txtstart];
(void) strcpy(p,txtstart);
file_name[Nfile] = p;
// Nstr++;
}
}
else { // no name .. back to the original .c file: ""
tcurr_file = 0;
}
del_txt();
tloc.file = file_stack[tcurr_file];
goto ll;
case '\n':
error("unexpected end of line on '# line'");
default:
pch(c);
}
case ' ':
break;
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
tloc.line = tloc.line*10+c-'0';
break;
case 'l': // look for "#line ..." and then ignore "line"
if (get(c)=='i' && get(c)=='n' && get(c)=='e') break;
case '\n':
tloc.putline();
goto ll;
default: // pass #rubbish through
tloc.line = cl;
pch('#');
pch(c);
while (get(c) != '\n') pch(c);
pch('\0');
fprintf(out_file,"\n%s\n",txtstart);
start_txt();
tloc.line++;
// Nline++;
goto ll;
}
}
}
}
0707071010112044351004440001630000160000010204200466055404600000700000046311main.c /*ident "@(#)ctrans:src/main.c 1.9" */
/***********************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
main.c:
Initialize global environment
Read argument line
Start compilation
Clean up and exit
**************************************************************************/
#ifdef __cplusplus
#include <stdlib.h>
#endif
#include <ctype.h>
#include <string.h>
#include <libc.h>
#include <osfcn.h>
#include <fstream.h>
#include "size.h"
#include "cfront.h"
#include "tree_dump.h"
#include "template.h"
#include "hash.h"
char* prog_name = "<<AT&T C++ Translator <(3.0)(PT)> 08/08/90>>";
char* src_file_name = "";
char* line_format = "\n# %d \"%s\"\n";
int dump_tree;
int tree_dump_brief = 0;
dcn_arg dump_tree_arg;
#ifdef unix
#include <signal.h>
static void core_dump(int = 0)
{
if (error_count)
fprintf(stderr,"sorry, cannot recover from previous error\n");
else
error('i',"bus error (or something nasty like that)");
ext(99);
}
#endif
Plist isf_list;
Pstmt st_ilist;
Pstmt st_dlist;
Ptable sti_tbl;
Ptable std_tbl;
Plist stat_mem_list;
int vtbl_opt = -1; // how to deal with vtbls:
// -1 static and defined
// 0 external and supposed to be defined elsewhere
// 1 external and defined
int debug_opt;
int gplus_opt; // -g to cc, overrides print optimization
int ansi_opt;
int strict_opt; // disallow features from the anachronism section
// of the manual
int warning_opt; // produce more warnings if set
bit stmtno = 0;
extern simpl_init();
extern typ_init();
extern syn_init();
extern lex_init();
extern error_init();
char *st_name(char*); // generates names of static ctor, dtor callers, ptbl_vec
Pname def_name; // first definition in file
Pname pdef_name; // used with ptbl_vec if function is first definition
int syn_count = 0; // to set conditional breakpoints to find particular expressions
Hash *dumper_node_hash_table;
void static
clean_dumper_hash_table() {
if(!dumper_node_hash_table)
return;
else {
HashWalker hi(*dumper_node_hash_table);
while(hi.valid ()) {
struct node& n = *(struct node*) hi.key();
if(n.permanent == 0 || n.permanent == 3) /* flush deleted nodes */
dumper_node_hash_table->del(hi.key());
hi.advance();
}
}
}
void run()
/*
run the appropriate stages
*/
{
Pname n;
templp = new templ_compilation; // canonical instance
if(dump_tree) {
dumper_node_hash_table =
dump_tree_arg.nodes_seen_hash = new pointer_hash (10000);
dump_tree_arg.verbose = dt_recursive_1;
}
while (n=syn()) {
if (n == Pname(1)) continue;
if (n->n_list) PERM(n->tp);
DB( if(Rdebug>=1) error('d',"run: syn(): '%s'", n->string););
templp->instantiate_ref_templ();
for (Pname nx, nn=n; nn; nn=nx) {
Pname rr;
++syn_count;
nx = nn->n_list;
nn->n_list = 0;
DB( if(Rdebug>=1) error('d',"run: dcl(): %n, base: %k",nn,nn->base););
if ((rr=nn->dcl(gtbl,EXTERN))==0
|| nn->base==0
|| error_count) continue;
DB( if(Rdebug>=1) error('d',"run: simpl(): %n",nn););
nn->simpl();
if (error_count) {
if(dump_tree) {
display_cfront_node (dump_tree_arg, nn);
*dump_tree_arg.output_stream << "---------------------------\n\n";
}
continue;
}
DB( if(Rdebug>=1) error('d',"run:print(): %n (%k) tp %t",nn,nn->base,nn->tp););
if (nn->base == TNAME)
nn->dcl_print(0);
else {
Ptype t = nn->tp;
llxx:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp; goto llxx;
case CLASS:
DB( if(Rdebug>=1) fprintf(stderr," -- class\n"););
if (vtbl_opt==1 || gplus_opt) n->dcl_print(0);
break;
case ENUM:
DB( if(Rdebug>=1) fprintf(stderr," -- enum\n"););
Penum(n->tp)->dcl_print(0);
break;
case FCT:
DB( if(Rdebug>=1) error('d'," -- fct%n inline %d body %d",nn,Pfct(t)->f_inline,Pfct(t)->body););
if (Pfct(t)->body==0
|| (debug_opt==0 && Pfct(t)->f_inline && ((n->n_table!=gtbl) || strcmp(nn->string,"main")))
|| Pfct(t)->f_imeasure && Pfct(t)->f_inline==0) break;
DB( if(Rdebug>=1) error('d',"rr %n inline %d body %d",rr,Pfct(rr->tp)->f_inline,Pfct(rr->tp)->body););
rr->dcl_print(0);
break;
default:
DB( if(Rdebug>=1) error('d'," -- %n tpbase: %k",nn,nn->tp->base););
// print class def, if appropriate
// can't use tsizeof() since this may
// print an error if class isn't defined
{ for(Ptype tx = t;;) {
switch ( tx->base ) {
case VEC:
tx=Pvec(tx)->typ;
continue;
case TYPE: case COBJ:
tx=Pbase(tx)->b_name->tp;
continue;
}
Pclass cl = Pclass(tx);
if ( cl->base == CLASS
&& (cl->defined&(DEFINED|SIMPLIFIED))
&& cl->c_body==1 )
cl->dcl_print(0);
break;
}
}
nn->dcl_print(0);
}
}
if(dump_tree) {
display_cfront_node (dump_tree_arg, nn);
*dump_tree_arg.output_stream << "---------------------------\n\n";
}
if (error_count) continue;
DB( if(Rdebug>=1) error('d',"run: cleanup"););
switch (nn->tp->base) { // clean up
default:
{
Pexpr i = nn->n_initializer;
DB( if(Rdebug>=1) error('d',"default nn %n i %d",nn,i););
if (i && i!=Pexpr(1)) {
DEL(i);
nn->n_initializer = 0;
if (def_name==0 && rr->n_scope != STATIC) {
def_name = rr;
if (pdef_name == 0) ptbl_init(0);
}
}
break;
}
case FCT:
{
Pfct f = Pfct(nn->tp);
DB( if(Rdebug>=1) error('d', "function nn: %n local_class: %d %d", nn, local_class, f->local_class ););
if (f->body
&& f->f_inline==0
&& f->f_imeasure==0) {
if ( local_class = f->local_class ) {
delete_local();
local_class = 0;
}
if (ansi_opt && f->f_this) {
f->f_this->n_table = 0;
for (Pname n=f->f_this->n_list; n; n=n->n_list)
n->n_table = 0;
}
DEL(f->body);
if (def_name==0) {
def_name = rr;
if (pdef_name == 0) ptbl_init(0);
}
}
break;
}
case CLASS:
{ Pclass cl = Pclass(nn->tp);
for (Pname px, p=cl->mem_list; p; p=px) {
px = p->n_list;
if (p->tp) {
switch (p->tp->base) {
case FCT:
{ Pfct f = (Pfct)p->tp;
if (f->body) {
if (f->f_inline==0
&& f->f_imeasure==0) {
if ( local_class = f->local_class ) {
delete_local();
local_class = 0;
}
DEL(f->body);
f->body = 0;
}
}
}
case CLASS:
case ENUM:
break;
case COBJ:
case EOBJ:
DEL(p);
break;
default:
delete p;
}
} else {
delete p;
}
} // for
cl->mem_list = 0;
cl->permanent = 3;
break;
}
}
DEL(nn);
}
lex_clear();
if (dump_tree) clean_dumper_hash_table();
}
templp->end_of_compilation() ;
switch (no_of_undcl) {
case 1: {error('w',"undeclaredF%n called",undcl);}
case 0: break;
default: {error('w',"%d undeclaredFs called; for example%n",no_of_undcl,undcl);}
}
switch (no_of_badcall) {
case 1: {error('w',"%n declaredWoutAs calledWAs",badcall);}
case 0: break;
default: {error('w',"%d Fs declaredWoutAs calledWAs; for example%n",no_of_badcall,badcall);}
}
if (error_count) return;
int i = 1;
for (Pname m=gtbl->get_mem(i); m; m=gtbl->get_mem(++i)) {
if (m->base==TNAME
|| m->n_sto==EXTERN
|| m->n_stclass == ENUM) continue;
Ptype t = m->tp;
if (t == 0) continue;
switch (t->base) {
case CLASS:
case ENUM:
case OVERLOAD: continue;
case COBJ:
//case ANON:
case VEC: break;
case FCT:
if (Pfct(t)->f_inline || Pfct(t)->body==0) continue;
}
//error('d',&m->where,"%n %d %d %s",m,m->n_addr_taken,m->n_used,m->n_sto==STATIC?"static":"");
//xxx doesn't check anon union members as their use bits are set differently
if (m->n_addr_taken==0
&& m->n_used==0
&& m->n_sto == STATIC) { // (static or anon?)
for(;;) {
//error('d',&m->where," %t tconst(): %d",t,t->tconst());
if(t->base==TYPE) {
if(t->tconst()) break;
t=Pbase(t)->b_name->tp;
} else if(t->base==VEC) {
t=Pvec(t)->typ;
} else {
if ( t->tconst() == 0 ) {
//error('d',"m%n tp%t t%t",m,m->tp,t);
if ( t->base != COBJ )
error('w',&m->where,"%n defined but not used",m);
else { Pclass cl;
cl = Pclass(Pbase(t)->b_name->tp);
if ( cl->has_ctor()==0 )
if ( cl->csu == ANON )
; //error('w',&m->where,"anonymous union defined but not used");
else
error('w',&m->where,"%n defined but not used",m);
}
} // if const
break;
}
} // for
} // if static and not used
}
Pname ctor = 0;
Pname dtor = 0;
--curloc.line;
if (st_ilist) { // make an "init" function;
// it calls all constructors for static objects
DB( if(Rdebug>=1) error('d',"make sti"); );
Pname n = new name( st_name("__sti__") );
Pfct f = new fct(void_type,0,1);
n->tp = f;
f->body = new block(st_ilist->where,0,st_ilist);
// f->body->s = st_ilist;
f->body->memtbl = sti_tbl;
n->n_sto = EXTERN;
// assignments here are really initializations:
ignore_const++;
f->f_linkage = linkage_C;
f->sign();
(void) n->dcl(gtbl,EXTERN);
ignore_const--;
n->simpl();
n->dcl_print(0);
ctor = n;
}
if (st_dlist) { // make a "done" function;
// it calls all destructors for static objects
DB( if(Rdebug>=1) error('d',"make std"); );
Pname n = new name( st_name("__std__") );
Pfct f = new fct(void_type,0,1);
n->tp = f;
f->body = new block(st_dlist->where,0,st_dlist);
// f->body->s = st_dlist;
f->body->memtbl = std_tbl;
n->n_sto = EXTERN;
f->f_linkage = linkage_C;
f->sign();
(void) n->dcl(gtbl,EXTERN);
n->simpl();
n->dcl_print(0);
dtor = n;
}
#ifdef PATCH
/*For fast load: make a static "__link" */
if (ctor || dtor)
{
printf("static struct __linkl { struct __linkl * next;\n");
if ( ansi_opt )
printf("void (*ctor)(); void (*dtor)(); } __link = \n");
else
printf("char (*ctor)(); char (*dtor)(); } __link = \n");
// printf("{ (struct __linkl *)0, %s, %s };\n",
// ctor_name ? ctor_name : "0",
// dtor_name ? dtor_name : "0");
putstring("{ (struct __linkl *)0, ");
if (ctor) ctor->print(); else putch('0');
putch(',');
if (dtor) dtor->print(); else putch('0');
putstring("};\n");
}
#endif
DB( if(Rdebug>=1) error( 'd', "run: vlist: %d", vlist ); );
do {
for (vl* v = vlist; v; v = v->next) v->cl->really_print(v->vt);
vlist = 0;
for (Plist l=isf_list; l; l=l->l) {
Pname n = l->f;
Pfct f = Pfct(n->tp);
DB( if(Rdebug>=1)error('d',"isf %n %t f %d addr %d",n,f,f,n->n_addr_taken); );
if (f->base == OVERLOAD) {
n = Pgen(f)->fct_list->f; // first fct
f = Pfct(n->tp);
}
if (debug_opt==0 &&
n->n_addr_taken) {
f->f_inline = 0;
if (n->n_dcl_printed<2) {
if (warning_opt)
error('w',"out-of-line copy of %n created",n);
n->dcl_print(0);
}
}
}
} while (vlist);
if (strict_opt == 0) { // define static members
// patch for SysV VAX -g linkage botch
for (Plist l=stat_mem_list; l; l=l->l) {
Pname n = l->f;
// error('d',"stat mem %n %d %d ",n,n->n_initializer,n->n_evaluated);
if (n->n_initializer==0 && n->n_evaluated==0) {
Ptype t = n->tp;
n->n_sto = 0;
Pname cn = t->is_cl_obj();
if (cn==0) cn = cl_obj_vec;
if (cn) (void) t->tsizeof(); // be sure to print class
if ((cn && Pclass(cn->tp)->has_ctor())
|| t->is_ref())
; // force explicit definition
else
n->dcl_print(0);
}
}
}
i = 1;
for (Pname nm=ptbl->get_mem(i); nm; nm=ptbl->get_mem(++i)) {
DB( if(Rdebug>=1) error('d',"ptbl anme %s string2 %s key:%k",nm->string==0?"???":nm->string2,nm->string2==0?"???":nm->string2,nm->n_key); );
if ( nm->n_key == 0 ) { // ptbl used in file, generate definition
int str1 = (*src_file_name)?strlen(src_file_name)+2:0; // +2 for __
int str2 = strlen(nm->string2) - str1;
char *ps = new char[ str2 + 1 ];
strncpy( ps, nm->string2, str2 ); // grab vtbl name
ps[str2]='\0';
ps[2] = 'v';
fprintf(out_file,"extern struct __mptr %s[];\n",ps);
// fprintf(out_file,"struct __mptr* %s = %s;\n",nm->string2,ps);
ptbl_add_pair(nm->string2,ps);
delete ps;
}
}
ptbl_init(1);
curloc.putline();
fprintf(out_file,"\n/* the end */\n");
}
#ifdef DBG
int Adebug = 0;
int Ddebug = 0;
int Edebug = 0;
int Ldebug = 0;
int Mdebug = 0;
int Ndebug = 0;
int Pdebug = 0;
int Rdebug = 0;
int Sdebug = 0;
int Tdebug = 0;
//Ydebug == yydebug initialized in y.tab.c
void
process_debug_flags( char* p )
{
// arg to +Dxxx or debugging comments //@!xxx
// format of xxx == sequence of any combination of
// +flags -- increment flags (default)
// -flags -- decrement flags
// 0flags -- unset flags
// where flags are single chars
int incr = 1;
char c;
fprintf(stderr,"\n*** processing debugging flags '%s'\n",p);
while ( c = *p++ ) {
switch ( c ) {
case '+': incr = 1; break;
case '-': incr = -1; break;
case '0': incr = 0; break;
case ' ': break;
// flags...
case 'A': if(incr==0) Adebug=0; else Adebug+=incr; break;
case 'D': if(incr==0) Ddebug=0; else Ddebug+=incr; break;
case 'E': if(incr==0) Edebug=0; else Edebug+=incr; break;
case 'L': if(incr==0) Ldebug=0; else Ldebug+=incr; break;
case 'M': if(incr==0) Mdebug=0; else Mdebug+=incr; break;
case 'N': if(incr==0) Ndebug=0; else Ndebug+=incr; break;
case 'P': if(incr==0) Pdebug=0; else Pdebug+=incr; break;
case 'R': if(incr==0) Rdebug=0; else Rdebug+=incr; break;
case 'S': if(incr==0) Sdebug=0; else Sdebug+=incr; break;
case 'T': if(incr==0) Tdebug=0; else Tdebug+=incr; break;
case 'Y': if(incr==0) Ydebug=0; else Ydebug+=incr; break;
default: error('w',"unknown debugging flag '%c'",c);
}
}
}
#endif /*DBG*/
int no_of_undcl, no_of_badcall;
Pname undcl, badcall;
void pt_option(char * ostr)
{ // options +O[BTo] for PT
ostr ++; /* skip the O */
switch(*ostr) {
default:
fprintf(stderr, "cfront: argument syntax: invalidZizedTs option (+O[BTo].");
exit(11);
case 'B':
tree_dump_brief = 1;
case 'T':
dump_tree = 1;
if(0 == *(ostr + 1) || strcmp (ostr, "T-") == 0)
dump_tree_arg.output_stream = (ostream*)&cout;
else {
dump_tree_arg.output_stream
= new ofstream (ostr+1, ios::out);
if(dump_tree_arg.output_stream->fail()) {
perror ("cfront");
fprintf (stderr, "Failed to open %s\n", ostr + 1);
exit (11);
}
}
break;
case 'o':
out_file = fopen (ostr+1, "w");
if(out_file == NULL) {
perror ("cfront");
fprintf(stderr, "Failed to open %s\n", ostr+1);
exit(11);
}
break;
}
}
main(int argc, char* argv[])
/*
read options, initialize, and run
*/
{
register char * cp;
char* afile = "";
#ifdef unix
#ifdef COMPLETE_SIG_PF
signal(SIGILL,core_dump);
signal(SIGIOT,core_dump);
signal(SIGEMT,core_dump);
signal(SIGFPE,core_dump);
signal(SIGBUS,core_dump);
signal(SIGSEGV,core_dump);
#else
typedef void (*ST)(int ...); // trick to circumvent problems with old
ST sick = ST(&signal); // (or C) versions <signal.h>
(*sick)(SIGILL,core_dump);
(*sick)(SIGIOT,core_dump);
(*sick)(SIGEMT,core_dump);
(*sick)(SIGFPE,core_dump);
(*sick)(SIGBUS,core_dump);
(*sick)(SIGSEGV,core_dump);
#endif
#endif
// SUM: not needed
// #ifdef apollo
// set_sbrk_size(1000000); // resets free store size
//#else
#ifndef apollo
//(void) malloc(0); // suppress cashing in V8 malloc
#endif
error_init();
for (int i=1; i<argc; ++i) {
switch (*(cp=argv[i])) {
case '+':
while (*++cp) {
switch(*cp) {
case 'O':
pt_option(cp);
goto xx;
case 'f':
src_file_name = cp+1;
goto xx;
case 'x': // read cross compilation table
if (read_align(afile = cp+1)) {
fprintf(stderr,"bad size-table (option +x)\n");
exit(11);
}
goto xx;
case 'e':
switch (*++cp) {
case '0':
case '1':
vtbl_opt = *cp-'0';
break;
default:
fprintf(stderr,"bad +e option\n");
exit(11);
}
break;
case 'd':
debug_opt = 1;
break;
case 'g':
gplus_opt = 1;
break;
case 'D':
#ifdef DBG
process_debug_flags(++cp);
#else
error('w',"cfront not compiled for debugging -- +D%s ignored",++cp);
#endif
goto xx;
case 'w':
warning_opt = 1;
break;
case 'a':
switch (*++cp) {
case '0':
case '1':
ansi_opt = *cp-'0';
break;
default:
fprintf(stderr,"bad +a option\n");
exit(11);
}
break;
case 'p':
strict_opt = 1;
break;
case 'L':
line_format = "\n#line %d \"%s\"\n";
break;
default:
fprintf(stderr,"%s: unexpected option: +%c ignored\n",prog_name,*cp);
}
}
xx:
break;
default:
fprintf(stderr,"%s: bad argument \"%s\"\n",prog_name,cp);
exit(11);
}
}
fprintf(out_file,line_format+1,1,src_file_name); // strips leading \n
fprintf(out_file,"\n/* %s */\n",prog_name);
if (*src_file_name) fprintf(out_file,"/* < %s > */\n",src_file_name);
// if (Nspy) {
// start_time = time(0);
// print_align(afile);
// }
fflush(stderr);
otbl_init();
lex_init();
syn_init();
typ_init();
simpl_init();
scan_started = 1;
curloc.putline();
if ((BI_IN_BYTE==0) && (SZ_INT==0) && (SZ_WPTR==0))
error("no size/alignment values - use +x of provide #ifdef in size.h");
run();
if(dump_tree) {
ostream_printf(*dump_tree_arg.output_stream, "------------ GTBL ------------\n\n");
display_cfront_node (dump_tree_arg, ktbl);
ostream_printf(*dump_tree_arg.output_stream, "------------ KTBL ------------\n\n");
display_cfront_node (dump_tree_arg, ktbl);
}
// if (Nspy) {
// stop_time = time(0);
// spy(src_file_name);
// }
exit( (0<=error_count && error_count<127) ? error_count : 127);
}
char* st_name(char* pref)
/*
make name "pref|source_file_name|_" or "pref|source_file_name|_"
where non alphanumeric characters are replaced with '_'
and add def_name at end to ensure uniqueness
*/
{
int prefl = strlen(pref);
int strl = prefl + 2; // trailing '_' and 0
if (*src_file_name) strl += strlen(src_file_name);
char* defs;
int defl;
if (def_name) {
defs = def_name->string;
defl = strlen(defs)+1; // '_'
}
else {
defs = 0;
defl = 0;
}
char* name = new char[strl+defl];
strcpy(name,pref);
if (*src_file_name) strcpy(name+prefl,src_file_name);
name[strl-2] = '_';
name[strl-1] = 0;
// char *p = name;
// while ( *++p ) if (!isalpha(*p) && !isdigit(*p)) *p = '_';
for (char* p = name; *p; p++) if (!isalpha(*p) && !isdigit(*p)) *p = '_';
if (defs) {
strcpy(name+strl-1,defs); // after the '_'
name[strl+defl-2] = '_';
name[strl+defl-1] = 0;
}
#ifdef DENSE
void chop(char*);
chop(name);
#endif
return name;
}
0707071010112041141004440001630000160000010112640466055427400001100000007532makefile #ident "@(#)ctrans:src/makefile 1.3"
###############################################################################
# Copyright (c) 1984 AT&T
# All Rights Reserved
#
# THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T
#
# The copyright notice above does not evidence any
# actual or intended publication of such source code.
#
###############################################################################
CC = CC
#The ANSI_OUT option has been replaced by the +a1 and +a0 compilation options
#for systems which only recognize identifiers of up to 31 characters
#setting DENSE to -DDENSE causes cfront to generate internal names
#of 31 characters or less
DENSE=
# The use of RETBUG is nolonger needed with version 2.0 and has been removed.
# RETBUG was used in 1.* Translator versions to circumvent a C compiler bug.
CCFLAGS=-O
# top level makefile modifies the following
MPMACRO = PATCH
MPFILE = patch
OFILES = alloc.o dcl.o dcl2.o dcl3.o dcl4.o del.o \
discrim.o doprint.o error.o expand.o \
expr.o expr2.o expr3.o find.o hash.o lalex.o lex.o main.o \
norm.o norm2.o print.o print2.o print_self.o repr.o simpl.o \
simpl2.o size.o table.o template.o tree_copy.o tree_dump.o \
tree_walk.o typ.o typ2.o y.tab.o
cfront: $(OFILES)
$(CC) -o cfront $(CCFLAGS) $(OFILES)
$(OFILES): cfront.h token.h typedef.h
y.tab.c: gram.y
yacc gram.y
alloc.o: alloc.c
$(CC) $(CCFLAGS) -c alloc.c
dcl.o: dcl.c size.h
$(CC) $(CCFLAGS) -c dcl.c
dcl2.o: dcl2.c size.h
$(CC) $(CCFLAGS) -c dcl2.c
dcl3.o: dcl3.c size.h
$(CC) $(CCFLAGS) -c dcl3.c
dcl4.o: dcl4.c size.h
$(CC) $(CCFLAGS) -c dcl4.c
del.o: del.c
$(CC) $(CCFLAGS) -c del.c
discrim.o: discrim.c cfront.h
$(CC) $(CCFLAGS) -c discrim.c
doprint.o: doprint.c
$(CC) $(CCFLAGS) -c doprint.c
error.o: error.c size.h
$(CC) $(CCFLAGS) -c error.c
expand.o: expand.c
$(CC) $(CCFLAGS) -c expand.c
expr.o: expr.c size.h
$(CC) $(CCFLAGS) -c expr.c
expr2.o: expr2.c size.h
$(CC) $(CCFLAGS) -c expr2.c
expr3.o: expr3.c size.h
$(CC) $(CCFLAGS) -c expr3.c
find.o: find.c
$(CC) $(CCFLAGS) -c find.c
hash.o: hash.c hash.h
$(CC) $(CCFLAGS) -c hash.c
lalex.o:lalex.c yystype.h tqueue.h
$(CC) $(CCFLAGS) -c lalex.c
lex.o: lex.c size.h tqueue.h yystype.h
$(CC) $(CCFLAGS) -c lex.c
# main depends on this makefile to force recompilation
# when going from patch to munch
main.o: main.c makefile
$(CC) -D$(MPMACRO) $(DENSE) $(CCFLAGS) -c main.c
norm.o: norm.c size.h
$(CC) $(CCFLAGS) -c norm.c
norm2.o: norm2.c size.h
$(CC) $(CCFLAGS) -c norm2.c
print.o: print.c
$(CC) $(CCFLAGS) -c print.c
print2.o: print2.c
$(CC) $(DENSE) $(CCFLAGS) -c print2.c
print_self.o: print_self.c
$(CC) $(CCFLAGS) -c print_self.c
repr.o: repr.c
$(CC) $(CCFLAGS) -c repr.c
simpl.o: simpl.c size.h
$(CC) $(CCFLAGS) -c simpl.c
simpl2.o: simpl2.c size.h
$(CC) $(CCFLAGS) -c simpl2.c
size.o: size.c size.h
$(CC) $(CCFLAGS) -c size.c
table.o: table.c
$(CC) $(CCFLAGS) -c table.c
template.o: template.c
$(CC) $(CCFLAGS) -c template.c
tree_copy.o: tree_copy.c
$(CC) $(CCFLAGS) -c tree_copy.c
tree_dump.o: tree_dump.c cfront.h
$(CC) $(CCFLAGS) -c tree_dump.c
tree_walk.o: tree_walk.c
$(CC) $(CCFLAGS) -c tree_walk.c
typ.o: typ.c size.h
$(CC) $(CCFLAGS) -c typ.c
typ2.o: typ2.c size.h
$(CC) $(CCFLAGS) -c typ2.c
y.tab.o: y.tab.c size.h
$(CC) -DGRAM $(CCFLAGS) -c y.tab.c
cpio:
ls alloc.c dcl.c dcl2.c dcl3.c dcl4.c del.c discrim.c doprint.c \
error.c expand.c expr.c expr2.c expr3.c find.c hash.c \
lalex.c lex.c main.c norm.c norm2.c print.c print2.c \
print_self.c repr.c simpl.c simpl2.c size.c table.c \
template.c tree_copy.c tree_dump.c tree_walk.c typ.c typ2.c \
gram.y \
cfront.h token.h size.h tqueue.h typedef.h yystype.h \
hash.h ios_printf.h node_classes.h print_self.h \
template.h token_names.h tree_copy.h tree_dump.h tree_walk.h \
makefile | cpio -oc > cfront.cpio
0707071010112046101004440001630000160000010212500466055421000001700000012215node_classes.h /* ident "@(#)ctrans:src/node_classes.h 1.2" */
/*
* node_classes.h
*/
#ifndef _node_classes
#define _node_classes
enum discriminator_error {
discrim_none_valid = 0,
discrim_bad_index = -1,
discrim_inconsistent_node = -2,
};
enum node_class {
nc_unused = 0,
nc_eof = 1,
nc_virt = 2,
nc_nlist = 3,
nc_gen = 4,
nc_vec = 5,
nc_ptr = 6,
nc_fct = 7,
nc_table = 8,
nc_basetype = 9,
nc_name = 10,
nc_expr = 11,
nc_stmt = 12,
nc_enumdef = 13,
nc_classdef = 14,
nc_baseclass = 15,
nc_iline = 16,
nc_ia = 17,
};
/*
searching this is slower than a directly indexed array,
but this is more maintainable. We can speed it up later.
*/
#ifdef DEFINE_TOKEN_CLASS_TABLE
struct token_class {
TOK token;
node_class nclass;
} token_classes[] = {
{ EOFTOK, nc_eof },
{ ASM, nc_stmt },
{ AUTO, nc_basetype },
{ BREAK, nc_stmt },
{ CASE, nc_stmt },
{ CHAR, nc_basetype },
{ CLASS, nc_classdef },
{ CONTINUE, nc_stmt },
{ DEFAULT, nc_stmt },
{ DELETE, nc_expr },
{ DO, nc_stmt },
{ DOUBLE, nc_basetype },
{ ELSE, nc_stmt },
{ ENUM, nc_enumdef },
{ EXTERN, nc_basetype },
{ FLOAT, nc_basetype },
{ FOR, nc_stmt },
{ FORTRAN, nc_unused },
{ FRIEND, nc_basetype },
{ GOTO, nc_stmt },
{ IF, nc_stmt },
{ INT, nc_basetype },
{ LONG, nc_basetype },
{ NEW, nc_expr },
{ OPERATOR, nc_fct },
{ RETURN, nc_stmt },
{ PUBLIC, nc_name },
{ CONST, nc_basetype },
{ REGISTER, nc_basetype },
{ RETURN, nc_stmt },
{ SHORT, nc_basetype },
{ SIZEOF, nc_expr },
{ STATIC, nc_basetype },
{ STRUCT, nc_unused },
{ SWITCH, nc_stmt },
{ THIS, nc_expr },
{ TYPEDEF, nc_basetype },
{ UNION, nc_unused },
{ UNSIGNED, nc_basetype },
{ VOID, nc_basetype },
{ WHILE, nc_stmt },
{ LP, nc_unused },
{ RP, nc_unused },
{ LB, nc_unused },
{ RB, nc_unused },
{ REF, nc_expr },
{ DOT, nc_expr },
{ NOT, nc_expr },
{ COMPL, nc_expr },
{ INCR, nc_expr },
{ DECR, nc_expr },
{ MUL, nc_expr },
{ DIV, nc_expr },
{ AND, nc_expr },
{ MOD, nc_expr },
{ PLUS, nc_expr },
{ MINUS, nc_expr },
{ LS, nc_expr },
{ RS, nc_expr },
{ LT, nc_expr },
{ LE, nc_expr },
{ GT, nc_expr },
{ GE, nc_expr },
{ EQ, nc_expr },
{ NE, nc_expr },
{ ER, nc_expr },
{ OR, nc_expr },
{ ANDAND, nc_expr },
{ OROR, nc_expr },
{ QUEST, nc_expr },
{ COLON, nc_unused },
{ ASSIGN, nc_expr },
{ CM, nc_expr },
{ SM, nc_stmt },
{ SM_PARAM, nc_stmt },
{ LC, nc_unused },
{ RC, nc_unused },
{ INLINE, nc_fct },
{ OVERLOAD, nc_gen },
{ VIRTUAL, nc_fct }, /* but might be a basecl */
{ COERCE, nc_unused },
{ PROTECTED, nc_name },
{ ID, nc_unused },
{ STRING, nc_expr },
{ ICON, nc_expr },
{ FCON, nc_expr },
{ CCON, nc_expr },
{ NAME, nc_name }, /* but might be basecl */
{ ZERO, nc_expr },
{ ASOP, nc_expr },
{ RELOP, nc_expr },
{ EQUOP, nc_expr },
{ DIVOP, nc_expr },
{ SHIFTOP, nc_expr },
{ ICOP, nc_expr },
{ UNOP, nc_expr },
{ TYPE, nc_basetype },
{ UMINUS, nc_expr },
{ FCT, nc_fct },
{ CALL, nc_expr },
{ VEC, nc_vec },
{ DEREF, nc_expr },
{ ADDROF, nc_expr },
{ CAST, nc_expr },
{ FIELD, nc_basetype },
{ LABEL, nc_stmt },
{ BLOCK, nc_stmt },
{ DCL, nc_stmt },
{ COBJ, nc_basetype },
{ EOBJ, nc_basetype },
{ TNAME, nc_name },
{ ILIST, nc_expr },
{ PTR, nc_ptr },
{ ASPLUS, nc_expr },
{ ASMINUS, nc_expr },
{ ASMUL, nc_expr },
{ ASDIV, nc_expr },
{ ASMOD, nc_expr },
{ ASAND, nc_expr },
{ ASOR, nc_expr },
{ ASER, nc_expr },
{ ASLS, nc_expr },
{ ASRS, nc_expr },
{ ARG, nc_basetype },
{ ZTYPE, nc_basetype },
{ ARGT, nc_basetype },
{ ELIST, nc_expr },
{ ANY, nc_basetype },
{ TABLE, nc_table },
{ LOC, nc_unused },
{ DUMMY, nc_expr },
{ G_ADDROF, nc_expr },
{ G_CALL, nc_expr },
{ G_CM, nc_expr },
{ IVAL, nc_expr },
{ ELLIPSIS, nc_unused },
{ AGGR, nc_unused },
{ RPTR, nc_ptr },
{ HIDDEN, nc_unused },
{ MEM, nc_expr },
{ CTOR, nc_unused },
{ DTOR, nc_unused },
{ CONST_PTR, nc_ptr },
{ CONST_RPTR, nc_ptr },
{ TEXT, nc_expr },
{ PAIR, nc_stmt },
{ ANON, nc_unused },
{ ICALL, nc_expr },
{ ANAME, nc_expr },
{ VOLATILE, nc_basetype },
{ SIGNED, nc_basetype },
{ UPLUS, nc_expr },
{ MEMPTR, nc_unused },
{ PRIVATE, nc_name },
{ PR, nc_unused },
{ MDOT, nc_expr },
{ TSCOPE, nc_unused },
{ DECL_MARKER, nc_unused },
{ REFMUL, nc_expr },
{ LDOUBLE, nc_basetype },
{ LINKAGE, nc_unused },
{ LOCAL, nc_basetype },
{ GNEW, nc_expr },
{ TEMPLATE, nc_unused },
{ STAT_INIT, nc_unused },
{ CATCH, nc_unused },
{ GDELETE, nc_expr },
{ XVIRT, nc_virt },
{ XNLIST, nc_nlist },
{ XILINE, nc_iline },
{ XIA, nc_ia },
{ VALUE, nc_expr },
{ XDELETED_NODE, nc_unused },
};
#endif
node_class classify_node (Pnode, int&);
node_class classify_node (Pnode);
#endif
0707071010112044361004440001630000160000010204500466055405300000700000120447norm.c /*ident "@(#)ctrans:src/norm.c 1.10" */
/************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
norm.c:
"normalization" handles problems which could have been handled
by the syntax analyser; but has not been done. The idea is
to simplify the grammar and the actions accociated with it,
and to get a more robust error handling
****************************************************************************/
#ifdef c_plusplus
overload nested_hide;
#endif
#include "cfront.h"
#include "size.h"
#include "template.h"
extern Pname do_nested_type(Pname);
extern int is_anon(char*);
Pname sta_name = 0;
void syn_init()
{
any_type = new basetype(ANY,0);
PERM(any_type); any_type->defined = DEFINED;
dummy = new expr(DUMMY,0,0);
PERM(dummy);
dummy->tp = any_type;
zero = new expr(ZERO,0,0);
PERM(zero);
sta_name = new name;
PERM(sta_name);
// Gtbl = new table(GTBLSIZE,0,0); //SYM
// Ctbl = Gtbl; //SYM
}
int stcount;
char* make_name(TOK c)
{
char* s = new char[8]; // as it happens: fits in two words
if (10000 <= ++stcount) error('i',"too many generatedNs");
sprintf(s,"__%c%d",c,stcount);
return s;
}
Pbase basetype::type_adj(TOK t)
{
DB(if(Ndebug>=1)error('d',"'%k'->type_adj(%k) --%t b_xname%n",base,t,this,b_xname););
if (b_xname) {
if (base)
error("badBT:%n%k",b_xname,t);
else {
base = TYPE;
b_name = b_xname;
}
b_xname = 0;
}
switch (t) {
case TYPEDEF: b_typedef = 1; break;
case INLINE: b_inline = 1; break;
case VIRTUAL: b_virtual = 1; break;
case CONST: if (b_const) error('w',"two const declarators");
b_const = 1; break;
case UNSIGNED: b_unsigned = 1; break;
case SHORT: b_short = 1; break;
case LONG: if (b_long) error('w',"two long declarators");
if (base == DOUBLE)
base = LDOUBLE;
else
b_long = 1;
break;
case FRIEND:
case OVERLOAD:
case EXTERN:
case STATIC:
case AUTO:
case REGISTER:
if (b_sto)
error("badBT:%k%k",b_sto,t);
else
b_sto = t;
break;
case DOUBLE:
if (b_long) {
t = LDOUBLE;
b_long = 0;
}
// no break
case VOID:
case CHAR:
case INT:
case FLOAT:
if (base)
error("badBT:%k%k",base,t);
else
base = t;
break;
case SIGNED:
case VOLATILE:
error('w',"\"%k\" not implemented (ignored)",t);
break;
default:
error('i',"BT::type_adj(%k)",t);
}
return this;
}
Pbase basetype::name_adj(Pname n)
{
DB(if(Ndebug>=1)error('d',"'%k'->name_adj(%n) --%t b_xname%n",base,n,this,b_xname));
if (b_xname) {
if (base)
error("badBT:%n%n",b_xname,n);
else {
base = TYPE;
b_name = b_xname;
}
b_xname = 0;
}
if ( base==0
&& n->base == TNAME
&& ( n->tp->base!=COBJ || in_arg_list )) {
base = TYPE;
b_name = n;
}
else
b_xname = n;
return this;
}
static TOK type_set( Pbase b )
{
TOK t = 0;
if ( b->b_long ) t = LONG;
else if ( b->b_short ) t = SHORT;
else if ( b->b_unsigned ) t = UNSIGNED;
else if ( b->b_inline ) t = INLINE;
else if ( b->b_virtual ) t = VIRTUAL;
else if ( b->b_sto == OVERLOAD ) t = OVERLOAD;
return t;
}
int declTag = 1;
Pbase basetype::base_adj(Pbase b)
{
DB(if(Ndebug>=1)error('d',"'%k'->base_adj(%t) --%t b_xname%n",base,b,this,b_xname));
Pname bn = b->b_name;
switch (base) {
case COBJ:
case EOBJ:
error("NX after%k%n",base,b_name);
return this;
}
TOK t;
if (base) {
if (b_name)
error("badBT:%k%n%k%n",base,b_name,b->base,bn);
else
error("badBT:%k%k%n",base,b->base,bn);
}
else if ( t = type_set(this)) {
if (b_name)
error("badBT:%k%n%k%n",t,b_name,b->base,bn);
else {
if ( declTag++ && (t!= INLINE)) error("badBT:%k%k%n",t,b->base,bn);
base=b->base; b_name = bn;
// error('d',"base_adj: t: %k", t );
}
}
else {
base = b->base;
b_name = bn;
b_table = b->b_table;
}
if ( b->base == COBJ ) {
Pclass cl = Pclass(bn->tp);
if ( cl->in_class &&
bn->tpdef &&
bn->tpdef->lex_level == NESTED )
{ // peculiar case: class x { typedef class bn {} _bn; ...
// bn has been half dealt with in do_nested_type ...
Pname n = new name(bn->string);
n->tp = b;
Pname nn = ktbl->insert(n, NESTED); //SYM
nn->tpdef = bn->tpdef;
nn->tpdef->lex_level = nn->lex_level = 0;
bn->tpdef = 0;
}
}
return this;
}
Pbase basetype::check(Pname n)
/*
"n" is the first name to be declared using "this"
check the consistency of "this"
and use "b_xname" for "n->string" if possible and needed
*/
{
b_inline = 0;
b_virtual = 0;
//error('d',"basetype::check(%n) base %k b_xname %n",n,base,b_xname);
if (b_xname && (n->tp || n->string)) {
if (base)
error("badBT:%k%n",base,b_xname);
else {
base = TYPE;
b_name = b_xname;
}
b_xname = 0;
}
if (b_xname) {
if (n->string)
error("twoNs inD:%n%n",b_xname,n);
else {
n->string = b_xname->string;
b_xname->hide();
}
b_xname = 0;
}
if (ccl==0
&& n
&& n->n_oper==TNAME
&& n->n_qualifier==0
&& n->string) { // hide type name
Pname nx = ktbl->look(n->string,0); //SYM
if (nx) nx->hide();
}
int defa = 0;
switch (base) {
case 0:
defa = 1;
base = INT;
break;
case EOBJ:
case COBJ:
if (b_name->base == TNAME) error('i',"TN%n inCO %p",b_name,this);
}
if (b_long || b_short) {
TOK sl = (b_short) ? SHORT : LONG;
if (b_long && b_short) error("badBT:long short%k%n",base,n);
if (base != INT)
error("badBT:%k%k%n",sl,base,n);
else
base = sl;
b_short = b_long = 0;
}
if (b_typedef && b_sto) error("badBT:Tdef%k%n",b_sto,n);
b_typedef = b_sto = 0;
if (b_linkage) {
if (1 <= bl_level) error("local linkage directive");
}
if (Pfctvec_type == 0) return this;
if (b_const) {
if (b_unsigned) {
switch (base) {
default:
error("badBT: unsigned const %k%n",base,n);
b_unsigned = 0;
case LONG:
case SHORT:
case INT:
case CHAR:
return this;
}
}
return this;
}
else if (b_unsigned) {
switch (base) {
case LONG:
delete this;
return ulong_type;
case SHORT:
delete this;
return ushort_type;
case INT:
delete this;
return uint_type;
case CHAR:
delete this;
return uchar_type;
default:
error("badBT: unsigned%k%n",base,n);
b_unsigned = 0;
return this;
}
}
else {
switch (base) {
case LONG:
delete this;
return long_type;
case SHORT:
delete this;
return short_type;
case INT:
if (this==int_type || this==defa_type) return this;
// if (this != int_type)
delete this;
if (defa) return defa_type;
return int_type;
case CHAR:
delete this;
return char_type;
case VOID:
delete this;
return void_type;
case TYPE:
/* use a single base saved in the keyword */
if (b_name->n_qualifier) {
Pbase rv = Pbase(b_name->n_qualifier);
delete this;
return rv;
}
else {
PERM(this);
b_name->n_qualifier = (Pname)this;
return this;
}
default:
return this;
}
}
}
Pname basetype::aggr()
/*
"type SM" seen e.g. struct s {};
class x;
enum e;
int tname;
friend cname;
friend class x;
int;
typedef int i; // where i is tname
convert
union { ... };
into
union name { ... } name ;
*/
{
DB(if(Ndebug>=1)error('d',"'%k'->aggr() --%t b_xname%n ccl%t",base,this,b_xname,ccl));
if (b_xname) {
if (base) {
Pname n = new name(b_xname->string);
/*SYM?*/if (ccl && b_xname->tpdef)
/*SYM?*/ n->tpdef = b_xname->tpdef;
b_xname->hide();
b_xname = 0;
return n->normalize(this,0,0);
}
else {
base = TYPE;
b_name = b_xname;
b_xname = 0;
}
}
switch (base) {
case COBJ:
{ Pclass cl = Pclass(b_name->tp);
char* s = cl->string;
/*SYM?*/if (b_name->base == TNAME) error('i',"TN%n inCO",b_name);
if (b_const) error("const%k%n",cl->csu,b_name);
if (cl->c_body == 2) { /* body seen */
if (s[0]=='_' && s[1]=='_' && s[2]=='C') {
char* ss = new char[8]; // max size of generated name is 7 chars, see make_name()
Pname obj = new name(ss);
strcpy(ss,s);
if (cl->csu == UNION) {
ss[2] = 'O';
cl->csu = ANON;
return obj->normalize(this,0,0);
}
error('w',"unusable%k ignored",cl->csu);
}
if ( b_sto == FRIEND )
error("friend%k%n{...}",cl->csu,b_name);
cl->c_body = 1;
return b_name;
}
else { /* really a typedef for cfront only: class x; */
if (b_sto == FRIEND) goto frr;
if (ansi_opt) printf("struct %s;\n",s);
return 0;
}
}
case EOBJ:
{ Penum en = Penum(b_name->tp);
/*SYM?*/if (b_name->base == TNAME) error('i',"TN%n in enumO",b_name);
if (b_const) error("const enum%n",b_name);
if (en->e_body == 2) {
en->e_body = 1;
return b_name;
}
else {
error("forwardD of enum%n", b_name);
en->e_type = int_type;
}
return 0;
}
case 0:
{ Pname n = new name(make_name('D'));
n->tp = defa_type;
error("NX inDL");
return n;
}
default:
if (b_typedef) error('w',"illegalTdef ignored");
if (b_sto == FRIEND && b_name ) {
frr:
Pname fr = ktbl->look(b_name->string,0); //SYM
if (fr == 0) error('i',"cannot find friend%n",b_name);
Pname n = new name(b_name->string);
n->n_sto = FRIEND;
// If it is a parameterized type, use the instantiation
// type, not the general type.
if ((fr->tp->base == COBJ) &&
(Pclass(Pbase(fr->tp)->b_name->tp)->class_base ==
template_class))
{
if (base == COBJ)
n->tp = this;
else
if ((base == TYPE) &&
(Pbase(this)->b_name->base == TNAME) &&
(Pbase(this)->b_name->tp->base == COBJ))
n->tp = Pbase(this)->b_name->tp;
else
error('i', "basetype wasn't a COBJ");
}
else n->tp = fr->tp;
return n;
}
else {
Pname n = new name(make_name('D'));
n->tp = defa_type;
error('w',"NX inDL");
return n;
}
}
}
void local_name() //SYM -- to be removed
{ /* need to provide an additional temporary name
* to handle case of
* f() {
* { class x{...}; }
* { class x{...}; }
* }
* generate name after closing } of block
* to distinquish between separate blocks at same lexical level
*/
for (Plist l=local_blk; l; l=l->l) {
Pname n = l->f;
if ( n->tp == 0 ) error( 'i', "no tp yet: #0 local_name" );
if ( Pbase(n->tp)->b_name == 0 ) error( 'i', "no tp yet: #1 local_name" );
Pname bn = Pbase(n->tp)->b_name;
if ( bn->tp == 0 ) error( 'i', "no tp yet#2: local_name" );
Pclass cl = Pclass(bn->tp);
cl->lcl = make_name( 'L' );
// error( 'd', "local_name(): %n bn: %n: cl : %s nof: %d", n, bn, cl->string, cc->nof );
}
}
void local_restore() //SYM -- to be removed
{
for (Plist l=local_tn; l; l=l->l) {
Pname n = l->f;
// error('d',"local_restore: n %n %t %d bl_level: %d", n, n->tp, n->lex_level, bl_level );
n->n_key = (n->lex_level==0) ? 0
: (n->lex_level && n->lex_level<=bl_level) ? LOCAL : HIDDEN;
}
}
void local_hide( Pname n ) //SYM -- to be removed
{
// error('d',"local_hide(%n )",n);
if ( n->base != TNAME ) return;
if ( n->n_key == 0 ) {
local_tn = new name_list( n, local_tn );
n->n_key = HIDDEN;
// error( 'd', "local_hide(): %n n_key: %d", n, n->n_key );
}
}
void
nested_restore() //SYM -- to be removed
{
for (Plist l = nested_type; l; l=l->l)
{
Pname n = l->f;
n->n_key = NESTED;
}
for (l=nested_tn; l; l=l->l) {
Pname n = l->f;
Ptype tp = n->tp;
// error('d',"nested_restore: n %n %t %d bl_level: %d", n, n->tp, n->lex_level, bl_level );
// error('d'," --- n_key %k", n->n_key );
if ( tp->in_class )
n->n_key = NESTED;
else
if ( tp->lex_level )
n->n_key = LOCAL;
else
n->n_key = 0;
// error('d'," --- n_key %k", n->n_key );
}
}
void
nested_hide( Pname n ) //SYM -- to be removed
{
// error('d',"nested_hide(%n )",n);
if ( n->base != TNAME ) return;
if ( n->n_key == 0 ) {
nested_tn = new name_list( n, nested_tn );
n->n_key = HIDDEN;
// error( 'd', "nested_hide(): %n n_key: %d", n, n->n_key );
}
}
static void
nested_hide( Plist l ) //SYM -- to be removed
{
// error('d',"nested_hide( list )");
for (; l; l=l->l) {
Pname nn = l->f;
Pname n = ktbl->look(nn->string,0);
// error('d',"nested_hide %n %t", n, n->tp, n->n_key);
if (n==0) continue;
if ( n->base != TNAME )
error('i', "nested_hide: %n not a type name (%t)", n, n->tp );
if ( n->n_key == 0 ) {
nested_tn = new name_list( n, nested_tn );
n->n_key = HIDDEN;
// error( 'd', "nested_hide(list): %n n_key: %d", n, n->n_key );
// nn->n_key = 0;
}
}
}
int defer_check = 0;
Pname statStat = 0;
void name::hide()
/*
hide "this": that is, "this" should not be a keyword in this scope
*/
{
if (base != TNAME) return;
// error('d',"'%n '->hide() -- %t lex_level %d bl_level %d",this,tp,lex_level,::bl_level);
if (n_key == 0) {
if (lex_level == bl_level && in_arg_list == 0) {
if (tp->base != COBJ) {
if ( !in_typedef )
error("%n redefined: typedef and identifier", this);
else if ( in_typedef->base
&& tp->base != type_set(Pbase(in_typedef))
&& in_typedef->check(tp,0) ) {
if ( defer_check == 0 )
error("%n redefined: previous: %t now: %t", this, tp, in_typedef);
}
}
else {
//error('d',"in_typedef%t %d tp%t %d",in_typedef,in_typedef,tp,tp);
//error('d',"in_typedef%k tp%k",in_typedef->base,tp->base);
if ( in_typedef && in_typedef->base
&& in_typedef->check(tp, 0) ) {
if ( defer_check == 0 )
error( "%n redefined: previous: %t now: %t", this, tp, in_typedef);
}
else {
Pname nn = Pbase(tp)->b_name;
Pclass cl = Pclass( nn->tp );
// check for 'typedef class X X;'
// and 'typedef X X;'
if ( in_typedef )
while ( in_typedef->base == TYPE )
in_typedef = Pbase(in_typedef)->b_name->tp;
if ( in_typedef
&& in_typedef->base==COBJ
&& Pbase(in_typedef)->b_name->tp==cl )
in_typedef = tp;
else if ( cl->has_ctor() )
error( "%n redefined: both aCNWK and %s", this, in_typedef?"a type name":"an identifier" );
}
}
}
// error( 'd', "%n::hide", this );
modified_tn = new name_list(this,modified_tn);
n_key = HIDDEN;
}
}
static Pname Ntncheck; // ensure TNAMES hidden within class scopes
static int notReally = 0;
void set_scope(Pname tn) //SYM -- to be shrunk
/* enter the scope of class tn after seeing "tn::f" */
{
// error( 'd', "set_scope: %n %t %d", tn, tn->tp, tn->tp->base );
// error( 'd', "set_scope: %d", notReally );
Pbase b = Pbase(tn->tp);
while ( b->base == TYPE ) b=Pbase(b->b_name->tp); // typedef class X T
if (b->base != COBJ) return; // error caught elsewhere
Pclass cl = Pclass(b->b_name->tp);
char *str = cl->string;
if ( cl->nest_list && notReally == 0 ) {
nested_type = cl->nest_list;
nested_hide(cl->nest_list);
}
Pname ntn = Ntncheck;
if( notReally == 0 )
while ( ntn && ntn->tp->base == TYPE ) ntn = Pbase(ntn->tp)->b_name;
if ( notReally || ntn == 0 || strcmp( str,ntn->string )) {
if ( cl->baselist ) {
Pname nb = new name, nbc = new name;
nb->tp = new basetype(COBJ,0);
Pbase(nb->tp)->b_name = nbc;
for (Pbcl bx, bb=cl->baselist; bb; bb = bb->next) {
bx = bb->next;
if ( bb->bclass != 0 ) {
nbc->tp = bb->bclass;
notReally++; set_scope(nb); notReally--;
}
}
DEL(nbc); /*DEL(nb->tp);*/ DEL(nb);
}
int i = 1;
Pname n = 0;
Plist ll = 0;
if (b->parametrized_class()) {
for (Pname nn = cl->mem_list; nn; nn = nn->n_list)
switch (nn->base) {
case PUBLIC: case PRIVATE: case PROTECTED:
continue;
default:
if (nn->tp->base == CLASS) continue;
if (nn->tp->base == ENUM) continue;
if ((nn->base == NAME) &&
((nn->n_oper == TNAME) && (nn->tp->base == FCT)) ||
(nn->n_oper == CTOR) ||
(nn->n_oper == DTOR)) continue ;
n = ktbl->look( nn->string, 0 );
if (n) ll = new name_list( n, ll );
}
} // if b->parametrized_class()
else
for (Pname nn=cl->memtbl->get_mem(i); nn; nn=cl->memtbl->get_mem(++i) ) {
if (nn->base == TNAME || nn->base == PUBLIC) continue;
if (nn->tp->base == CLASS) continue;
if (nn->tp->base == ENUM) continue;
n = ktbl->look( nn->string, 0 );
if (n) ll = new name_list( n, ll );
}
if ( ll ) cl->tn_list = ll;
if (notReally == 0) Ntncheck = tn;
}
for (Plist l=cl->tn_list; l; l=l->l) {
Pname n = l->f;
n->n_key = (n->lex_level) ? 0 : HIDDEN;
modified_tn = new name_list(n,modified_tn);
}
}
void restore() //SYM -- to be removed
{
for (Plist l=modified_tn; l; l=l->l) {
Pname n = l->f;
// error('d',"restore: n %n %t %d bl_level: %d", n, n->tp, n->lex_level, bl_level );
//fprintf(stderr," -- n_key %d\n",n->n_key);
n->n_key = (n->lex_level==0 || (n->lex_level && n->lex_level<=bl_level)) ? 0 : HIDDEN;
//fprintf(stderr," -- n_key %d\n",n->n_key);
if ( n->lex_level == 0
&& (n->tp->base == COBJ || n->tp->base == EOBJ)) {
Pname nn = gtbl->look( n->string, 0 );
if ( nn ) n->n_key = HIDDEN;
}
//fprintf(stderr," -- n_key %d\n",n->n_key);
}
}
Pbase start_cl(TOK t, Pname c, Pbcl b)
{
int mk_local = 0;
DB(if(Ndebug>=1)error('d',"start_cl(%k,%d,%d)",t,c,b););
if (c == 0) {
c = new name(make_name('C'));
c->lex_level -= in_class_decl + 1;
if ( in_typedef && c->lex_level )
mk_local = 1;
else c->lex_level = 0;
}
for ( Pclass tc = ccl; tc; tc = tc->in_class ) {
if ( tc->lex_level == c->lex_level // c not local to mem ftn of tc
&& strcmp( tc->string, c->string) == 0) {
error( "C %s redefined", c->string );
error('i', "can't recover from previous errors");
}
}
Pname n = c->tname(t); /* t ignored */
if (templp->in_progress && (c->lex_level == 0))
// bring the template in scope
templp->introduce_class_templ(n);
// typedef struct {} x;
if ( mk_local ) {
n->n_key = LOCAL;
extern Plist local_blk, local_class; // place in cfront.h
local_class = new name_list( n, local_class );
local_blk = new name_list( n, local_blk );
modified_tn = modified_tn->l;
}
n->where = curloc;
Pbase bt = Pbase(n->tp); /* COBJ */
if (bt->base != COBJ) {
error("twoDs of%n:%t andC",n,bt);
error('i', "can't recover from previous errors");
}
Pclass occl = ccl;
ccl = Pclass(bt->b_name->tp); /* CLASS */
if (ccl->defined) ccl->defined |= IN_ERROR;
ccl->defined |= DEF_SEEN;
// error('d', "start_cl: %n ccl->in_class: %t lex_level: %d", n, ccl->in_class, n->lex_level );
if (ccl->in_class = occl) {
occl->tn_list = modified_tn; // save mod-list
modified_tn = 0;
}
Ntncheck = 0; // zero it out with each new class declaration
ccl->string = n->string;
ccl->csu = t;
if (b) { // list of base classes
for (Pbcl bx, bb=b, l=0; bb; bb = bx) {
bx = bb->next;
bb->next = 0;
if ( bb->bclass
&& strcmp(ccl->string,bb->bclass->string)==0 )
error(&n->where,"%nderived from itself",n);
else if (l == 0)
l = bb;
else { // append and check for duplicates
for (Pbcl ll = l;;) {
if (bb->bclass && ll->bclass==bb->bclass) {
error("%s has %s asB twice",ccl->string,bb->bclass->string);
break;
}
if (ll->next)
ll = ll->next;
else {
bb->next = l;
l = bb;
break;
}
}
}
}
ccl->baselist = l;
notReally++; set_scope(n); notReally--;
}
return bt;
}
void end_cl()
{
Pclass occl = ccl->in_class;
Plist ol = occl ? occl->tn_list : 0; // saved modified name list
ccl->c_body = 2;
if (modified_tn) { // export nested class names to outer scope:
Plist local = 0;
for (Plist l=modified_tn, nl=0; l; l=nl) {
nl = l->l;
Pname n = l->f;
// in a pure implementation, no longer do this
if (ktbl->look(n->string,0)) {
// add it to enclosing class's modified name list
l->l = ol;
ol = l;
}
else { // retain it in this class's modified name list
l->l = local;
local = l;
}
}
if (ccl->tn_list = modified_tn = local) restore();
}
modified_tn = ol; // restore mod-list (possibly modified)
/*
if ( occl ) {
Pname n = ktbl->look(ccl->string,NESTED);
for (;n; n=n->n_tbl_list) {
Ptype tt = Pbase(n->tp)->b_name->tp;
// error('d',"end_cl: ccl: %t occl: %t in_class: %t", ccl, occl, tt->in_class);
if (strcmp(tt->in_class->string, occl->string) == 0) {
n->n_key = 0;
}
}
}
*/
ccl = occl;
}
Pbase end_enum(Pname n, nlist* b)
{
// error( 'd', "end_enum: %n ccl: %t", n , ccl );
if (n == 0) n = new name(make_name('E'));
n = n->tname(ENUM);
Pbase bt = (Pbase)n->tp;
if (bt->base != EOBJ) {
error("twoDs of%n:%t and enum",n,bt);
error('i', "can't recover from previous errors");
}
Penum en = (Penum)bt->b_name->tp;
en->e_body = 2;
en->mem = name_unlist(b);
if (en->defined) {
// shouldn't be necessary anymore with nested types
// if ( in_class_decl )
// error("%n redefined, enum tag not local to class", n);
en->defined |= IN_ERROR;
}
en->defined |= DEF_SEEN;
en->in_class = ccl;
if (ccl && (bl_level==ccl->lex_level + in_class_decl) && is_anon(n->string))
n=do_nested_type(n);
return bt;
}
extern Ptype return_nstd_local_type(Pname,TOK&);
Pname name::tdef()
/*
typedef "this"
*/
{
DB(if(Ndebug>=1) {
error('d',&where,"'%n'->tdef()%t in_typedef %d",this,tp,in_typedef);
error('d',&where," lex_level %d tpdef%t",lex_level,tpdef);
});
int anon_cl = 0;
if (n_qualifier) {
error("QdN in typedef",this);
n_qualifier = 0;
}
Pname n;
if ( tpdef && tpdef->in_class ) { // nested typedef
// error('d', "*****%s->tdef: %d ccl: %t", string, tpdef, ccl );
n = ktbl->insert(this,NESTED);
n->tpdef = tpdef;
n->tpdef->lex_level = n->lex_level = 0;
nested_type = new name_list( n, nested_type );
}
else {
Pname nn = ktbl->look(string,NESTED);
if ( nn ) {
TOK ntk = 0; // set by return_nstd...
Ptype tt = return_nstd_local_type(nn,ntk);
error("nested%k%t::%s seen beforeGTdef %s (to do this placeG definition first)",ntk, tt->in_class, string, string);
error( 'i', "cannot recover from previous errors" );
}
lex_level = bl_level - in_class_decl;
n = ktbl->insert(this,0);
}
if (tp == 0) error('i',"Tdef%n tp==0",this);
n->base = base = TNAME;
PERM(n);
PERM(tp);
if (tp->base == COBJ || tp->base == EOBJ )
{ // typedef struct/enum { } s; => struct/enum s {};
Pname b = Pbase(tp)->b_name;
if (b->string[0] == '_' && b->string[1] == '_' )
switch ( tp->base ) {
case COBJ: {
if (b->string[2] == 'C') {
Pclass cl = Pclass(b->tp);
b->string = n->string;
cl->string = n->string;
cl->strlen = strlen(cl->string);
if ( lex_level ) {
anon_cl = 1;
n->n_key = LOCAL;
}
}
break;
}
case EOBJ: {
if (b->string[2] == 'E') {
Penum en = Penum(b->tp);
b->string = n->string;
en->string = n->string;
en->strlen = strlen(en->string);
}
}
}
}
if ( anon_cl == 0 )
modified_tn = new name_list(n,modified_tn);
DB(if(Ndebug>=1) {
error('d',&where,">>'%n'->tdef()%t returning",this,tp);
error('d',&where," lex_level %d tpdef%t",lex_level,tpdef);
});
return n;
}
Pname name::tname(TOK csu)
/*
"csu" "this" seen, return typedef'd name for "this"
return (TNAME,x)
x: (COBJ,y)
y: (NAME,z)
z: (CLASS,ae);
*/
{
//error('d',"'%n'::tname(%k)",this,csu);
switch (base) {
case TNAME:
return this;
case NAME:
{ Pname tn = ktbl->insert(this,0);
Pname on = new name;
tn->base = TNAME;
tn->lex_level = lex_level;
modified_tn = new name_list(tn,modified_tn);
tn->n_list = n_list = 0;
string = tn->string;
*on = *this;
switch (csu) {
case ENUM:
tn->tp = new basetype(EOBJ,on);
on->tp = new enumdef(0);
Penum(on->tp)->string = tn->string;
break;
case CLASS:
case STRUCT:
case UNION:
on->tp = new classdef(csu);
Pclass(on->tp)->string = tn->string;
Pclass(on->tp)->lex_level = lex_level;
tn->tp = new basetype(COBJ,on);
Pbase(tn->tp)->b_table = Pclass(on->tp)->memtbl;
break;
default:
error('i',&where,"illegal csu%k for%n in name::tname()",csu,this);
}
PERM(tn);
PERM(tn->tp);
PERM(on);
PERM(on->tp);
return tn;
}
default:
error('i',"tname(%s %d %k)",string,this,base);
}
}
int co_hack;
Pname name::normalize(Pbase b, Pblock bl, bit Cast)
/*
if (bl) : a function definition (check that it really is a type
if (Cast) : no name string
for each name on the name list
invert the declarator list(s) and attatch basetype
watch out for class object initializers
convert
struct s { int a; } a;
into
struct s { int a; }; struct s a;
*/
{
Pname n;
Pname nn;
TOK stc;
bit tpdf;
bit inli;
bit virt;
char * lnkg;
DB( if(Ndebug>=1) {
error('d',"'%n'::normalize(b%t, bl %d, cast %d)",this,b,bl,Cast);
error('d'," tp%k - lex_level %d - bl_level %d",tp?tp->base:0,lex_level,bl_level);
});
if (b) {
stc = b->b_sto;
tpdf = b->b_typedef;
inli = b->b_inline;
virt = b->b_virtual;
lnkg = b->b_linkage;
}
else {
stc = 0;
tpdf = 0;
inli = 0;
virt = 0;
lnkg = 0;
}
if (inli && stc==EXTERN) {
error("both extern and inline");
inli = 0;
}
if ( stc==STATIC && tp &&
tp->base == FCT
&& Pfct(tp)->f_const )
error( "%n staticMF cannot be const", this );
if (stc==FRIEND && tp==0) {
/* friend x;
must be handled during syntax analysis to cope with
class x { friend y; y* p; };
"y" is not local to "x":
class x { friend y; ... }; y* p;
is legal
examples:
typedef void SIG_TYP(int);
class x {
friend class y;
friend z;
friend x; // dumb
friend int i; // error
friend SIG_TYP sigFunc; // subtle
friend int f();
friend g(int);
};
*/
if (b && (b->base || b->b_name || b->b_xname)) goto ccc;
if (n_list) {
error("L of friends");
n_list = 0;
}
if (!Cast) {
Pname nn = gtbl->look( string, 0 );
if ( nn ) {
if (nn->tp->base == FCT)
error("friendF must include signature:%n", this );
else
error("illegal friendD:%n", this );
}
}
//error( 'd', "%n ll: %d", ccl, ccl->lex_level );
lex_level = ccl->lex_level;
Pname nx = tname(CLASS);
modified_tn = modified_tn->l; /* global */
n_sto = FRIEND;
tp = nx->tp;
return this;
}
ccc:
if (tp // FUDGE: fix the bad grammar
&& tp->base==FCT
&& (n_oper==TNAME || Pfct(tp)->returns)) {
Pfct f = Pfct(tp);
Pfct f2 = Pfct(f->returns);
if (f2) {
Ptype pt;
Ptype t = f2;
lxlx:
switch (t->base) {
case PTR: // x(* p)(args) ?
case VEC: // x(* p[10])(args) ?
if (pt = Pptr(t)->typ) {
if (pt->base == TYPE) {
Pptr(t)->typ = 0;
b = Pbase(pt);
// stc = b->b_sto;
// tpdf = b->b_typedef;
// inli = b->b_inline;
// virt = b->b_virtual;
}
else {
t = pt;
goto lxlx;
}
}
goto zse1;
case FCT:
{// Pexpr e = f2->argtype;
Pexpr e = Pfct(f)->argtype;
if (e && e->base==ELIST) { // get the real name; fix its type
if (e->e2 || e->e1->base!=DEREF) goto zse1;
Pexpr ee = e->e1;
Ptype t = 0;
Ptype tpx;
ldld:
switch (ee->base) {
case DEREF:
{ Ptype tt = (ee->e2) ? Ptype(new vec(0,ee->e2)) : Ptype (new ptr(PTR,0));
if (t)
Pptr(t)->typ = tt;
else
tpx = tt;
t = tt;
ee = ee->e1;
goto ldld;
}
case NAME:
{ Pname rn = Pname(ee);
b = new basetype(TYPE,ktbl->look(string,0));
f->returns = tpx;
n_oper = 0;
string = rn->string;
base = NAME;
}
}
}
}
}
}
}
zse1:
if (b == 0) {
error("BTX for %s",string);
b = Pbase(defa_type);
}
if (Cast) string = "";
b = b->check(this);
switch (b->base) { // separate class definitions
// from object and function type declarations
case COBJ:
nn = b->b_name;
if (Pclass(nn->tp)->c_body==2) { /* first occurrence */
if ( stc == FRIEND ) {
Pclass cl = Pclass(nn->tp);
if ( cl->csu == ANON )
error( &nn->where, "friend anonymous union");
else
error( &nn->where, "%k%n defined in friendD",cl->csu,nn);
}
if (tp && tp->base==FCT && co_hack == 0) {
error(&this->where,"%k%n defined as returnT for%n (did you forget a ';' after '}' ?)",Pclass(nn->tp)->csu,nn,this);
nn = this;
break;
}
nn->n_list = this;
Pclass(nn->tp)->c_body = 1; /* other occurences */
}
else
nn = this;
break;
case EOBJ:
nn = b->b_name;
if (Penum(nn->tp)->e_body==2) {
if (tp && tp->base==FCT) {
error(&this->where,"enum%n defined as returnT for%n (did you forget a ';'?)",nn,this);
nn = this;
break;
}
nn->n_list = this;
Penum(nn->tp)->e_body = 1;
}
else {
Penum en = Penum(nn->tp);
if ( en->defined == 0 )
error( "forwardD of enum%n", nn );
en->e_type = int_type;
nn = this;
}
break;
default:
nn = this;
}
//error('d',&where,"name::normalize: nn%n ll %d nn %d this %d",nn,nn->lex_level,nn,this);
Pname nx;
for (n=this; n; n=nx) {
Ptype t = n->tp;
nx = n->n_list;
n->n_sto = stc;
if (n->base == TNAME) error('i',"redefinition ofTN%n",n);
if (t == 0) {
if (bl == 0)
n->tp = t = b;
else {
if ( n->base == NAME && n->n_oper )
error(&n->where,"illegalD of %n",n);
else
error(&n->where,"body of nonF%n",n);
t = new fct(0,0,0);
}
}
switch (t->base) {
case PTR:
case RPTR:
n->tp = Pptr(t)->normalize(b);
break;
case VEC:
n->tp = Pvec(t)->normalize(b);
break;
case FCT:
n->tp = Pfct(t)->normalize(b);
break;
case FIELD:
if (n->string == 0) n->string = make_name('F');
n->tp = t;
Pbase tb = b;
// error('d', "field t %k tb %k", t->base, tb->base );
flatten:
switch (tb->base) {
case TYPE: /* chase typedefs */
tb = (Pbase)tb->b_name->tp;
goto flatten;
case CHAR:
case SHORT:
case EOBJ:
case INT:
// typedef const unsigned cu_int;
// struct x { x(); cu_int b1: 2; }
Pbase(t)->b_fieldtype = (b->b_unsigned||tb->b_unsigned) ? uint_type : int_type;
// goto iii;
// case CHAR:
// Pbase(t)->b_fieldtype = (b->b_unsigned) ? uchar_type : char_type;
// goto iii;
// case SHORT:
// Pbase(t)->b_fieldtype = (b->b_unsigned) ? ushort_type : short_type;
// goto iii;
// iii:
Pbase(t)->b_unsigned = b->b_unsigned?b->b_unsigned:tb->b_unsigned;
Pbase(t)->b_const = b->b_const?b->b_const:tb->b_const;
break;
default:
error("non-int field");
n->tp = defa_type;
}
break;
}
Pfct f = Pfct(n->tp);
if (f->base != FCT) {
if (bl) {
error("body for nonF%n",n);
n->tp = f = new fct(defa_type,0,0);
continue;
}
if (inli) error("inline nonF%n",n);
if (virt) error("virtual nonF%n",n);
if (tpdf) {
// error('d', "%n->normalize: ccl: %t", this, ccl );
if (ccl && n->tpdef &&
(n->tpdef->lex_level == NESTED ||
n->tpdef->lex_level == LOCAL))
; // using this field for nested/local type info
else
if (n->n_initializer) {
error("Ir forTdefN%n",n);
n->n_initializer = 0;
}
n->tdef();
// because do_nested_type can't call tdef()
if ( n->n_key == NESTED )
modified_tn = modified_tn->l;
}
continue;
}
if ( lnkg ) set_linkage(lnkg);
f->f_linkage = linkage;
if ( lnkg ) set_linkage(0);
// wait and call f->sign() after args are checked
f->f_inline = inli;
extern int vcounter;
f->f_virtual = virt?(vcounter++,VTOK):0;
if (tpdf) {
if (f->body = bl) error("Tdef%n { ... }",n);
if (n->n_qualifier) {
// typedef T x::f(args);
// a pointer to member fucntion:
// equivalent to typedef T x::(f)(args);
f->memof = Pclass(Pbase(n->n_qualifier->tp)->b_name->tp);
n->n_qualifier = 0;
}
n->tdef();
// because do_nested_type can't call tdef()
if ( n->n_key == NESTED )
modified_tn = modified_tn->l;
continue;
}
if (f->body = bl) continue;
/*
Check function declarations.
Look for class object instantiations
The real ambiguity: ; class x fo();
is interpreted as an extern function
declaration NOT a class object with an
empty initializer
*/
{ Pname cn = f->returns->is_cl_obj();
Ptype template_formal_type ;
bit clob = (cn || cl_obj_vec);
if (f->argtype) { /* check argument/initializer list */
Pname nn;
for (nn=f->argtype; nn; nn=nn->n_list) {
if (nn->base != NAME) {
if (!clob) {
if ((f->returns->base == TYPE) &&
(Pbase(f->returns)->b_name->n_template_arg == template_type_formal))
{
// T x(var); wher T is a template formal
// it could be a class when instantiated
// wait until then to issue error message
template_formal_type = f->returns;
Pname nnn = Pbase(f->returns)->b_name;
nnn->n_template_formal_must_be_class = 1;
goto is_obj;
}
error(&n->where,"ATX for%n",n);
goto zzz;
}
goto is_obj;
}
//if (nn->string) {
// error("AN%n inD of%n",nn,n);
// nn->string = 0;
//}
if (nn->tp) goto ok;
}
if (!clob) {
error("FALX");
goto zzz;
}
is_obj:
/* it was an initializer: expand to constructor */
n->tp = f->returns;
if (f->argtype->base != ELIST) f->f_args = f->argtype = (Pname)new expr(ELIST,(Pexpr)f->argtype,0);
if ( n->n_initializer ) {
error(&n->where,"twoIrs for%n",n);
DEL( ((Pexpr)f->argtype) );
f->argtype = 0;
} else
// n->n_initializer = new texpr(VALUE,cn->tp,(Pexpr)f->argtype);
n->n_initializer = new texpr(VALUE, cn ? cn->tp : template_formal_type, (Pexpr)f->argtype);
goto ok;
zzz:
if (f->argtype) {
DEL(Pexpr(f->argtype));
f->argtype = 0;
f->nargs = 0;
f->nargs_known = 1;
}
}
else { /* T a(); => function declaration */
/*
if (clob) {
DEL(n->tp);
n->tp = f->returns;
}
*/
}
ok:
;
}
}
return nn;
}
Ptype vec::normalize(Ptype vecof)
{
Ptype t = typ;
typ = vecof;
while(vecof->base == TYPE)
vecof = Pbase(vecof)->b_name->tp;
switch (vecof->base) {
case RPTR:
error("array ofRs");
break;
case FCT:
error("array ofFs");
break;
default:
break;
}
if (t == 0) return this;
switch (t->base) {
case PTR:
case RPTR: return Pptr(t)->normalize(this);
case VEC: return Pvec(t)->normalize(this);
case FCT: return Pfct(t)->normalize(this);
default: error('i',"bad arrayT(%d)",t->base);
}
}
Ptype ptr::normalize(Ptype ptrto)
{
// if (this == 0) error('i',"0->ptr.normalize()");
Ptype t = typ;
typ = ptrto;
int bc = 0;
while (ptrto->base == TYPE) {
bc += Pbase(ptrto)->b_const;
ptrto = Pbase(ptrto)->b_name->tp;
}
switch (ptrto->base) {
case FCT:
if (memof)
if (Pfct(ptrto)->memof) {
if (memof != Pfct(ptrto)->memof) error("P toMF mismatch: %s and %s",memof->string, Pfct(ptrto)->memof->string);
}
else
Pfct(ptrto)->memof = memof;
else
memof = Pfct(ptrto)->memof;
break;
case RPTR:
switch (base) {
case PTR: error("P toR"); break;
case RPTR: error("R toR"); break;
}
}
if (t == 0) {
Pbase b = Pbase(ptrto);
if (Pfctvec_type
&& rdo==0
&& b->b_unsigned==0
&& b->b_const==0
&& bc == 0
&& memof==0
&& base==PTR) {
switch (b->base) {
case INT: delete this; return Pint_type;
case CHAR: delete this; return Pchar_type;
case VOID: delete this; return Pvoid_type;
}
}
if (base==RPTR && b->base==VOID) error("void& is not a validT");
return this;
}
switch (t->base) {
case PTR:
case RPTR: return Pptr(t)->normalize(this);
case VEC: return Pvec(t)->normalize(this);
case FCT: return Pfct(t)->normalize(this);
default: error('i',"badPT(%k)",t->base);
}
}
Ptype fct::normalize(Ptype ret)
/*
normalize return type
*/
{
register Ptype t = returns;
returns = ret;
if (argtype && argtype->base==NAME && argtype->n_qualifier) {
error("syntax: ANX");
argtype = 0;
nargs = 0;
nargs_known = 0;
}
while(ret->base == TYPE)
ret = Pbase(ret)->b_name->tp;
switch(ret->base) {
case VEC:
error("F returning array");
break;
case FCT:
error("F returningF");
returns = ret = t?t:int_type;
break;
default:
break;
}
if (t == 0) return this;
switch (t->base) {
case PTR:
case RPTR: return Pptr(t)->normalize(this);
case VEC: return Pvec(t)->normalize(this);
case FCT: return Pfct(t)->normalize(this);
default: error('i',"badFT:%k",t->base);
}
}
void fct::argdcl(Pname dcl, Pname fn)
/*
sort out the argument types for old syntax:
f(a,b) int a; char b; { ... }
beware of
f(a) struct s { int a; }; struct s a;
*/
{
Pname n;
/*fprintf(stderr,"%d argtype %d %d dcl %d %d\n",this, argtype, argtype?argtype->base:0, dcl, dcl?dcl->base:0); fflush(stderr);*/
switch (base) {
case FCT: break;
case ANY: return;
default: error('i',"fct::argdcl(%d)",base);
}
if (argtype) {
switch (argtype->base) {
case NAME:
if (dcl) error("badF definition syntax");
for (n=argtype; n; n=n->n_list) {
if (n->string == 0) n->string = make_name('A');
}
return;
case ELIST: // expression list: f(a,b,c) int a; ... { ... }
// scan the elist and build a NAME list
{
Pname tail = 0;
n = 0;
error(strict_opt?0:'w',&fn->where,"old style definition of%n (anachronism)",fn);
for (Pexpr e=Pexpr(argtype); e; e=e->e2) {
Pexpr id = e->e1;
if (id->base != NAME) {
error("NX inAL");
argtype = 0;
dcl = 0;
break;
}
Pname nn = new name(id->string);
if (n)
tail = tail->n_list = nn;
else
tail = n = nn;
}
f_args = argtype = n;
break;
}
default:
error("ALX(%d)",argtype->base);
argtype = 0;
dcl = 0;
}
}
else if(nargs_known == ELLIPSIS) {
return;
}
else {
nargs_known = 1;
nargs = 0;
if (dcl) error("ADL forFWoutAs");
return;
}
// nargs_known = 0;
if (dcl) {
Pname d;
Pname dx;
/* for each argument name see if its type is specified
in the declaration list otherwise give it the default type
*/
for (n=argtype; n; n=n->n_list) {
char* s = n->string;
if (s == 0) {
error("AN missing inF definition");
n->string = s = make_name('A');
}
else if (n->tp) error("twoTs forA %s",n->string);
for (d=dcl; d; d=d->n_list) {
if (strcmp(s,d->string) == 0) {
if (d->tp->base == VOID) {
error("voidA%n",d);
d->tp = any_type;
}
n->tp = d->tp;
n->n_sto = d->n_sto;
d->tp = 0; // now merged into argtype
goto xx;
}
}
n->tp = defa_type;
xx:;
if (n->tp == 0) error('i',"noT for %s",n->string);
}
/* now scan the declaration list for "unused declarations"
and delete it
*/
for (d=dcl; d; d=dx) {
dx = d->n_list;
if (d->tp) { /* not merged with argtype list */
/*if (d->base == TNAME) ??? */
switch (d->tp->base) {
case CLASS:
case ENUM:
/* WARNING: this will reverse the order of
class and enum declarations
*/
d->n_list = argtype;
f_args = argtype = d;
break;
default:
error("%n inADL not inAL",d);
}
}
}
}
/* add default argument types if necessary */
for (n=argtype; n; n=n->n_list) {
if (n->tp == 0) n->tp = defa_type;
nargs++;
}
}
Pname cl_obj_vec; /* set if is_cl_obj() found a array of class objects */
Pname eobj; /* set if is_cl_obj() found an enum */
Pname type::is_cl_obj()
/*
returns this->b_name if this is a class object
returns 0 and sets cl_obj_vec to this->b_name
if this is a array of class objects
returns 0 and sets eobj to this->b_name
if this is an enum object
else returns 0
*/
{
bit v = 0;
register Ptype t = this;
if (t == 0) return 0;
eobj = 0;
cl_obj_vec = 0;
xx:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto xx;
case COBJ:
if (v) {
cl_obj_vec = Pbase(t)->b_name;
return 0;
}
else
return Pbase(t)->b_name;
case VEC:
t = Pvec(t)->typ;
v=1;
goto xx;
case EOBJ:
eobj = Pbase(t)->b_name;
default:
return 0;
}
}
/*
static Pname
lookup(char* s, Pclass cl)
{
Pbcl bc = 0;
Pname n = cl->memtbl->look(s,0);
if ( n ) return n;
Pname n2 = 0;
for (Pbcl b=cl->baselist; b; b=b->next) {
n = b->bclass->lookup(s,cl);
if ( n == 0 ) continue;
if ( n2 ) { // clash?
}
n2 = n;
}
}
*/
0707071010112044371004440001630000160000010205100466055405600001000000011657norm2.c /*ident "@(#)ctrans:src/norm2.c 1.4" */
/************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
norm2.c:
"normalization" handles problems which could have been handled
by the syntax analyser; but has not been done. The idea is
to simplify the grammar and the actions associated with it,
and to get a more robust error handling
****************************************************************************/
#include "cfront.h"
#include "size.h"
#ifdef DBG
long node_id = 0;
#define DBCHECK() if(node::allocated) error('i',"allocated node (id %d, base%k) on free list! (src: \"%s\", %d",node::id,node::base,__FILE__,__LINE__);
#else
#define DBCHECK() /**/
#endif
fct::fct(Ptype t, Pname arg, TOK known)
{
base = FCT;
nargs_known = known;
returns = t;
argtype = arg;
DBID();
if (arg==0 || arg->base==ELIST) return;
//error('d',"fct::fct %d sig %d",this,f_signature);
register Pname n;
Pname pn = 0;
for (n=arg; n; pn=n,n=n->n_list) {
if( n->n_sto==EXTERN ) error("externA");
if( n->n_sto==STATIC ) error("static used forA%n",arg);
switch (n->tp->base) {
case VOID:
argtype = 0;
nargs_known = 1;
if(n->n_initializer)
error("voidFA");
else if (n->string)
error("voidFA%n",n);
else if (nargs || n->n_list) {
error("voidFA");
nargs_known = 0;
}
nargs = 0;
break;
case CLASS:
case ENUM:
error("%k defined inAL (will not be in scope at point of call)",n->tp->base);
if (n == argtype)
argtype = n->n_list;
else
pn->n_list = n->n_list;
break;
default:
nargs++;
}
}
}
expr::expr(TOK ba, Pexpr a, Pexpr b)
{
DBCHECK();
base = ba;
e1 = a;
e2 = b;
DBID();
}
stmt::stmt(TOK ba, loc ll, Pstmt a)
{
DBCHECK();
base = ba;
where = ll;
s=a;
DBID();
}
classdef::classdef(TOK b)
{
base = CLASS;
csu = b;
memtbl = new table(CTBLSIZE,0,0);
DBID();
}
classdef::~classdef()
{
delete memtbl;
}
basetype::basetype(TOK b, Pname n)
{
switch (b) {
case 0: break;
case TYPEDEF: b_typedef = 1; break;
case INLINE: b_inline = 1; break;
case VIRTUAL: b_virtual = 1; break;
case CONST: b_const = 1; break;
case UNSIGNED: b_unsigned = 1; break;
case FRIEND:
case OVERLOAD:
case EXTERN:
case STATIC:
case AUTO:
case REGISTER: b_sto = b; break;
case SHORT: b_short = 1; break;
case LONG: b_long = 1; break;
case ANY:
case ZTYPE:
case VOID:
case CHAR:
case INT:
case FLOAT:
case LDOUBLE:
case DOUBLE: base = b; break;
case TYPE:
case COBJ:
case EOBJ:
case FIELD:
case ASM:
base = b;
b_name = n;
break;
case SIGNED:
case VOLATILE:
error('w',"\"%k\" not implemented (ignored)",b);
break;
default:
error('i',"badBT:%k",b);
}
DBID();
}
name::name(char* s) : expr(NAME,0,0)
{
// DBCHECK() called in expr::expr()
string = s;
where = curloc;
lex_level = bl_level;
}
nlist::nlist(Pname n)
{
head = n;
for (Pname nn=n; nn->n_list; nn=nn->n_list);
tail = nn;
}
void nlist::add_list(Pname n)
{
if (n->tp && (n->tp->defined & IN_ERROR)) return;
tail->n_list = n;
for (Pname nn=n; nn->n_list; nn=nn->n_list);
tail = nn;
}
Pname name_unlist(Pnlist l)
{
if (l == 0) return 0;
Pname n = l->head;
delete l;
return n;
}
Pstmt stmt_unlist(Pslist l)
{
if (l == 0) return 0;
Pstmt s = l->head;
// NFl++;
delete l;
return s;
}
Pexpr expr_unlist(Pelist l)
{
if (l == 0) return 0;
Pexpr e = l->head;
// NFl++;
delete l;
return e;
}
void sig_name(Pname n)
{
static char buf[256];
buf[0] = '_';
buf[1] = '_';
buf[2] = 'o';
buf[3] = 'p';
char* p = n->tp->signature(buf+4);
if (255 < p-buf) error('i',"sig_name():N buffer overflow");
char *s = new char [ p - buf + 1 ];
strcpy(s,buf);
n->string = s;
n->tp = 0;
}
Ptype tok_to_type(TOK b)
{
Ptype t;
switch (b) {
case CHAR: t = char_type; break;
case SHORT: t = short_type; break;
case LONG: t = long_type; break;
case UNSIGNED: t = uint_type; break;
case FLOAT: t = float_type; break;
case DOUBLE: t = double_type; break;
case LDOUBLE: t = ldouble_type; break;
case VOID: t = void_type; break;
default: error("illegalK:%k",b);
case INT: t = int_type;
}
return t;
}
Pbase defa_type;
Pbase moe_type;
Pexpr dummy;
Pexpr zero;
Pclass ccl;
Plist modified_tn = 0;
Plist local_tn = 0;
Plist local_blk = 0;
Plist local_class = 0;
Plist nested_tn = 0;
Plist nested_type = 0;
void memptrdcl(Pname bn, Pname tn, Ptype ft, Pname n)
{
Pptr p = new ptr(PTR,0);
p->memof = Pclass(Pbase(bn->tp)->b_name->tp);
Pbase b = new basetype(TYPE,tn);
PERM(p);
Pfct f = Pfct(ft);
Ptype t = n->tp;
if (t) {
p->typ = t;
ltlt:
switch (t->base) {
case PTR:
case RPTR:
case VEC:
if (Pptr(t)->typ == 0) {
Pptr(t)->typ = b;
break;
}
t = Pptr(t)->typ;
goto ltlt;
default:
error('s',"P toMFT too complicated");
}
}
else
p->typ = b;
f->returns = p;
n->tp = f;
}
0707071010112044401004440001630000160000010205200466055406200001000000061331print.c /*ident "@(#)ctrans:src/print.c 1.3" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
print.c:
print statements and expressions
****************************************************************************/
#include "cfront.h"
static int addrof_cm ;
extern void puttok(TOK);
/*
void cprint(Pexpr e)
{
if (e == 0) return;
//error('d',"%k %n %t",e->base,e->base==NAME?e:0,e->tp);
// if ((e->base==NAME || e->base==ANAME)
// && Pname(e)->n_evaluated==0) {
Ptype t = e->tp;
while (t->base == TYPE) t = Pbase(t)->b_name->tp;
if (t->base == EOBJ) fprintf(out_file,"(int)");
// }
Eprint(e);
}
*/
#define cprint(e) if (e) Eprint(e)
#define eprint(e) if (e) Eprint(e)
void Eprint(Pexpr e)
{
switch (e->base) {
case REF:
if (Pref(e)->mem && Pref(e)->mem->tp && Pref(e)->mem->tp->base == FCT) {
// suppress ``this'' in ``this->f''
Pref(e)->mem->print();
break;
}
case NAME:
case MDOT:
case ID:
case ZERO:
case ICON:
case CCON:
case FCON:
case STRING:
case IVAL:
case TEXT:
case CM:
case G_CM:
case ELIST:
case COLON:
case ILIST:
case DOT:
case THIS:
case CALL:
case G_CALL:
case ICALL:
case ANAME:
e->print();
case DUMMY:
break;
default:
putch('(');
e->print();
putch(')');
}
}
void expr::print()
{
if (this == 0) error('i',"0->E::print()");
if (this==e1 || this==e2) error('i',"(%p%k)->E::print(%p %p)",this,base,e1,e2);
// error('d',"(%d %k)->expr::print(%d %d)",this,base,e1,e2);
switch (base) {
case MDOT:
{
// error('d',"mdot %s i1 %d %t",string2,i1,mem->tp);
int not_allocated = 0;
switch (i1) {
case 0:
putcat('O',string2);
puttok(DOT); // use sub-object directly
mem->print();
break;
case 1:
putcat('P',string2);
puttok(REF); // use through pointer
mem->print();
break;
case 2:
if (mem->tp->is_ptr_or_ref()==0) {
mem->print();
puttok(DOT);
putcat('O',string2);
}
else
{
putch('('); // REF turns pointer into object: add &
putch('&'); // ``this'' is a pointer
putch('(');
eprint(mem);//mem->print();
puttok(REF); // call sub-object directly
putcat('O',string2);
putch(')');
putch(')');
}
break;
case 5:
not_allocated = 1;
// no break;
case 3:
if (mem->tp->is_ptr_or_ref()==0) {
putch('('); // Px is a pointer (T*) turn it back to a T
putch('*'); // *Px
putch('(');
eprint(mem);//mem->print();
puttok(DOT); // call through pointer
putcat('P',string2);
putch(')');
putch(')');
}
else {
// eprint(mem); // <<< mem->print()
if (not_allocated) {
putch('(');
mem->print();
if ( mem->base == NAME )
puttok(REF);
else puttok(DOT);
putcat('O',string4);
putch(')');
}
else eprint(mem);
if (mem->base == NAME && not_allocated)
puttok(DOT);
else puttok(REF); // call through pointer
putcat('P',string2);
}
break;
case 9: // vtbl entry: (p->_vtbl).f, (p->_vtbl).i, (p->_vtbl).d
// or memptr: mp.f, mp.i, mp.d
eprint(mem);
putch('.');
putstring(string2);
} // end switch(i1)
break;
} // end MDOT
case NAME:
{ Pname n = Pname(this);
if (n->n_evaluated
// && n->tp->base!=EOBJ // this output enumerators
&& n->n_scope!=ARG) {
Ptype t = tp;
while (t->base == TYPE) t = Pbase(t)->b_name->tp;
if (t->base == EOBJ) t = Penum(Pbase(t)->b_name->tp)->e_type;
if (t->base!=INT || t->is_unsigned()) {
putstring("((");
bit oc = Cast;
Cast = 1;
t->print();
Cast = oc;
fprintf(out_file,")%d)",n->n_val);
}
else
fprintf(out_file,"%d",n->n_val);
}
else
n->print();
break;
}
case ANAME:
if (curr_icall) { // in expansion: look it up
Pname n = Pname(this);
int argno = int(n->n_val);
for (Pin il=curr_icall; il; il=il->i_next)
if (n->n_table == il->i_table) goto aok;
goto bok;
aok:
if (n = il->i_args[argno].local) {
n->print();
}
else {
Pexpr ee = il->i_args[argno].arg;
Ptype t = il->i_args[argno].tp;
if (ee==0 || ee==this) error('i',"%p->E::print(A %p)",this,ee);
if (ee->tp==0
|| (t!=ee->tp
&& t->check(ee->tp,0)
&& t->is_cl_obj()==0
// && eobj==0)
)
) {
putstring("((");
bit oc = Cast;
Cast = 1;
t->print();
Cast = oc;
putch(')');
// eprint(ee);
// if (ee->base == CAST) {
// eprint(ee->e1);
// }
// else
eprint(ee);
putch(')');
}
else
eprint(ee);
}
}
else {
bok: /* in body: print it: */
Pname(this)->print();
}
break;
case ICALL:
{ il->i_next = curr_icall;
curr_icall = il;
//error('d',"icall %n",il->fct_name);
if (il == 0) error('i',"E::print: iline missing");
Pexpr a0 = il->i_args[0].arg;
int val = QUEST;
if (il->fct_name->n_oper != CTOR) goto dumb;
/*
find the value of "this"
if the argument is a "this" NOT assigned to
by the programmer, it was initialized
*/
switch (a0->base) {
case ZERO:
val = 0;
break;
case ADDROF:
case G_ADDROF:
val = 1;
break;
case CAST:
if (a0->e1->base == ANAME || a0->e1->base == NAME) {
Pname a = (Pname)a0->e1;
if (a->n_assigned_to == FUDGE111) val = FUDGE111;
}
}
if (val==QUEST) goto dumb;
/*
now find the test: "(this==0) ? _new(sizeof(X)) : 0"
e1 is a comma expression,
the test is either the first sub-expression
or the first sub-expression after the assignments
initializing temporary variables
*/
dumb:
eprint(e1);
if (e2) Pstmt(e2)->print();
curr_icall = il->i_next;
break;
}
case REF:
case DOT:
eprint(e1);
puttok(base);
if (mem == 0) {
fprintf(out_file,"MEM0");
break;
}
if (mem->base == NAME)
Pname(mem)->print();
else
mem->print();
break;
case MEMPTR:
error("P toMF not called");
break;
case VALUE:
tp2->print();
puttok(LP);
// if (e2) {
// putstring(" &");
// e2->print();
// putstring(", ");
// }
if (e1) e1->print();
puttok(RP);
break;
case SIZEOF:
puttok(SIZEOF);
if (e1 && e1!=dummy) {
eprint(e1);
}
else if (tp2) {
putch('(');
if (tp2->base == CLASS) {
Pclass cl = Pclass(tp2);
putstring((cl->csu == UNION)?"union ":"struct ");
char *str = 0;
// nested local class does not encode name
if ( cl->lex_level && cl->nested_sig == 0 )
str = make_local_name( cl );
putstring(str?str:(cl->nested_sig?cl->nested_sig:cl->string));
delete str;
}
else
tp2->print();
putch(')');
}
break;
/*
// always turned into function calls:
case NEW:
case GNEW:
// error('d',"print new %d tp2 %t e1 %d e2 %d",base,tp2,e1,e2);
puttok(NEW);
tp2->print();
if (e1) {
putch('(');
e1->print();
putch(')');
}
break;
case DELETE:
case GDELETE:
//error('d',"print delete");
puttok(DELETE);
e1->print();
break;
*/
case CAST:
putch('(');
//error('d',"print cast %t",tp2);
if (tp2->base != VOID && tp2->memptr() == 0 ) {
// when VOID is represented as CHAR not everything
// can be cast to VOID
putch('(');
bit oc = Cast;
Cast = 1;
tp2->print();
Cast = oc;
putch(')');
}
eprint(e1);
putch(')');
break;
case ICON:
case FCON:
case CCON:
case ID:
if (string) putst(string);
break;
case STRING:
// avoid printing very long lines
ntok += 4;
fprintf(out_file,"\"%s\"",string);
break;
case THIS:
case ZERO:
putstring("0 ");
break;
case IVAL:
fprintf(out_file,"%d",i1);
break;
case TEXT:
{
int oo = vtbl_opt; // make `simulated static' name
vtbl_opt = -1;
char* s = vtbl_name(string,string2);
vtbl_opt = oo;
s[2] = 'p'; // pointer, not tbl itself
char* t = ptbl_lookup(s);
fprintf(out_file, " %s",t);
delete t;
char *str = 0;
if ( string ) {
str = new char[ strlen(string) + strlen(string2) + 1 ];
strcpy( str, string );
strcat( str, string2 );
}
if ( ptbl->look( str?str:string2, 0 ) == 0 &&
ptbl->look( str?str:string2, HIDDEN ) == 0 ) {
Pname nn = ptbl->insert(new name(str?str:string2),0);
nn->string2 = new char[strlen(s)+1];
strcpy(nn->string2,s);
}
delete str;
delete s;
}
// no break;
case DUMMY:
break;
case G_CALL:
case CALL:
{ Pname fn = fct_name;
Pname at;
int m_ptr = 0;
if (fn) {
Pfct f = Pfct(fn->tp);
if (f->base==OVERLOAD) { // overloaded after call
fct_name = fn = Pgen(f)->fct_list->f;
f = Pfct(fn->tp);
}
fn->print();
at = f->f_args;
}
else {
Pfct f = Pfct(e1->tp);
if (f) { // pointer to fct
Pexpr exex = e1;
if ( exex->base == DEREF ) {
exex = exex->e1;
while ( exex->base == CAST )
exex = exex->e1;
if ( exex->base == MDOT )
m_ptr = 1;
}
if (f->base == OVERLOAD) { // overloaded after call
fct_name = fn = Pgen(f)->fct_list->f;
f = Pfct(fn->tp);
}
while (f->base == TYPE) f = Pfct(Pbase(f)->b_name->tp);
if (f->base == PTR) {
putstring("(*");
e1->print();
putch(')');
f = Pfct(Pptr(f)->typ);
while (f->base == TYPE) f = Pfct(Pbase(f)->b_name->tp);
}
else
eprint(e1);
// at = (f->f_result) ? f->f_result : f->argtype;
at = f->f_args;
}
else { // virtual: argtype encoded
// f_this already linked to f_result and/or argtype
at = (e1->base==QUEST) ? Pname(e1->e1->tp2) : Pname(e1->tp2);
eprint(e1);
}
}
puttok(LP);
if (e2) {
if (at) {
Pexpr e = e2;
while (at) {
Pexpr ex;
Ptype t = at->tp;
if (t == 0) error('i',"T ofA missing for%n",fn);
if (e == 0) error('i',"%tA missing for%n",t,fn);
if (e->base == ELIST) {
ex = e->e1;
e = e->e2;
}
else
ex = e;
if (ex == 0) error('i',"A ofT%t missing",t);
if (t!=ex->tp
&& ex->tp
&& t->check(ex->tp,0)
&& t->is_cl_obj()==0
&& eobj==0
&& m_ptr == 0
&& (t->is_ptr()==0 || Mptr==0)) {
putch('(');
bit oc = Cast;
Cast = 1;
t->print();
Cast = oc;
putch(')');
#ifdef sun
if (ex->base == DIV) { // defend against perverse SUN cc bug
putstring("(0+");
eprint(ex);
putch(')');
}
else
#endif
// eprint(ex);
// if (ex->base==CAST) {
// eprint(ex->e1);
// }
// else
eprint(ex);
}
else
ex->print();
// if m_ptr is set, then don't advance at
// at does not know about generated `this'
if ( m_ptr ) {
m_ptr = 0;
if (at) puttok(CM);
continue;
}
at = at->n_list;
if (at) puttok(CM);
}
if (e) {
puttok(CM);
e->print();
}
}
else
e2->print();
}
puttok(RP);
break;
}
case ASSIGN:
if (e1->base==ANAME && Pname(e1)->n_assigned_to==FUDGE111) {
// suppress assignment to "this" that has been optimized away
Pname n = Pname(e1);
int argno = int(n->n_val);
for (Pin il=curr_icall; il; il=il->i_next)
if (il->i_table == n->n_table) goto akk;
goto bkk;
akk:
if (il->i_args[argno].local == 0) {
e2->print();
break;
}
}
//no break
case EQ:
case NE:
case GT:
case GE:
case LE:
case LT:
bkk:
{ Ptype t1 = e1->tp;
Ptype t2 = e2->tp;
if (base!=ASSIGN) {
cprint(e1);
}
else
eprint(e1);
puttok(base);
if (t1 && t1!=t2 && e2->base!=ZERO) {
// cast, but beware of int!=long etc.
cmp:
switch (t1->base) {
case TYPE:
t1 = Pbase(t1)->b_name->tp;
goto cmp;
default:
// if (e2->base==NAME
// && Pname(e2)->n_evaluated==0
// && e2->tp->base==EOBJ)
// fprintf(out_file,"(int)");
break;
// case EOBJ:
// if (base==ASSIGN) goto cst;
// break;
case PTR:
case RPTR:
case VEC:
if (t2)
while ( t2->base == TYPE )
t2 = Pbase(t2)->b_name->tp;
if (e2->tp==0
|| (Pptr(t1)->typ!=Pptr(t2)->typ && t1->check(t2,0))) {
// cst:
putch('(');
bit oc = Cast;
Cast = 1;
e1->tp->print();
Cast = oc;
putch(')');
}
}
}
eprint(e2);
break;
}
case DEREF:
if (e2) {
eprint(e1);
putch('[');
cprint(e2);
putch(']');
}
else {
putch('(');
putch('*');
eprint(e1);
putch(')');
}
break;
case ILIST:
puttok(LC);
if (e1) e1->print();
if (e2) { // member pointer initiliazers
puttok(CM);
e2->print();
}
puttok(RC);
break;
case ELIST:
{ Pexpr e = this;
for(;;) {
if (e->base == ELIST) {
e->e1->print();
if (e = e->e2) {
puttok(CM);
}
else
return;
}
else {
e->print();
return;
}
}
}
case QUEST:
{ // look for (&a == 0) etc.
Neval = 0;
binary_val = 1;
long i = cond->eval();
binary_val = 0;
if (Neval == 0)
(i?e1:e2)->print();
else {
eprint(cond);
putch('?');
cprint(e1);
putch(':');
cprint(e2);
}
break;
}
case CM: // do &(a,b) => (a,&b) for previously checked inlines
case G_CM:
puttok(LP);
switch (e1->base) {
case ZERO:
case IVAL:
case ICON:
case NAME:
case MDOT:
case DOT:
case REF:
case FCON:
// case FVAL:
case STRING:
goto le2; // suppress constant a: &(a,b) => (&b)
default:
{ int oo = addrof_cm; // &(a,b) does not affect a
addrof_cm = 0;
eprint(e1);
addrof_cm = oo;
}
puttok(CM);
le2:
if (addrof_cm) {
switch (e2->base) {
case CAST:
if (e2->e2)
switch (e2->e2->base) {
case CM:
case G_CM:
case ICALL: goto ec;
}
case NAME:
case MDOT:
case DOT:
case DEREF:
case REF:
case ANAME:
puttok(ADDROF);
addrof_cm--;
eprint(e2);
addrof_cm++;
break;
case ICALL:
// case CALL:
case CM:
case G_CM:
ec:
eprint(e2);
break;
case G_CALL:
/* & ( e, ctor() ) with temporary optimized away */
if (e2->fct_name
&& e2->fct_name->n_oper==CTOR) {
addrof_cm--;
eprint(e2);
addrof_cm++;
break;
}
default:
error('i',"& inlineF call (%k)",e2->base);
}
}
else
// e2->print();
eprint(e2);
puttok(RP);
}
break;
case UPLUS: // only preserved for ansi_opt==1
case UMINUS:
case NOT:
case COMPL:
// puttok(base);
// eprint(e2);
// break;
goto op2;
case ADDROF:
case G_ADDROF:
switch (e2->base) { // & *e1 or &e1[e2]
case DEREF:
if (e2->e2 == 0) { // &*e == e
e2->e1->print();
return;
}
break;
case ICALL:
addrof_cm++; // assumes inline expanded into ,-expression
eprint(e2);
addrof_cm--;
return;
case ASSIGN: // &(a=b) ??? works on many cc s
eprint(e2); // make sure it breaks!
return;
case NAME: {
Pname n = Pname(e2);
if(n->n_evaluated) {
n->n_evaluated=0;
puttok(ADDROF);
eprint(e2);
n->n_evaluated=1;
return;
}
break;
}
}
// suppress cc warning on &fct
if (e2->tp==0 || e2->tp->base!=FCT) puttok(ADDROF);
eprint(e2);
break;
case PLUS:
case MINUS:
case MUL:
case DIV:
case MOD:
case LS:
case RS:
case AND:
case OR:
case ER:
case ANDAND:
case OROR:
case DECR:
case INCR:
cprint(e1);
op2:
puttok(base);
cprint(e2);
break;
case ASOR:
case ASER:
case ASAND:
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASMOD:
case ASDIV:
case ASLS:
case ASRS:
eprint(e1);
goto op2;
default:
error('i',"%p->E::print%k",this,base);
// fprintf(out_file," EEE(%d) ",base);
}
}
Pexpr aval(Pname a)
{
int argno = int(a->n_val);
Pin il;
for (il=curr_icall; il; il=il->i_next)
if (il->i_table == a->n_table) goto aok;
return 0;
aok:
Pexpr aa = il->i_args[argno].arg;
ll:
switch (aa->base) {
case CAST: aa = aa->e1; goto ll;
case ANAME: return aval(Pname(aa));
default: return aa;
}
}
#define putcond() putch('('); e->print(); putch(')')
static loc csloc = { 0, 0 }; // loc of last stmt with line!=0
void stmt::print()
{
//error('d',"S::print %d:%k s %d s_list %d",this,base,s,s_list);
if (where.line == 0) {
if (csloc.line) csloc.putline();
} else {
csloc = where;
if (where.line!=last_line.line)
if (last_ll = where.line)
where.putline();
else
last_line.putline();
}
if (memtbl && base!=BLOCK) { /* also print declarations of temporaries */
puttok(LC);
Ptable tbl = memtbl;
memtbl = 0;
int i;
int bl = 1;
for (Pname n=tbl->get_mem(i=1); n; n=tbl->get_mem(++i)){
if (n->tp == any_type) continue;
/* avoid double declarartion of temporaries from inlines */
char* s = n->string;
if (s[0]!='_' || s[1]!='_' || s[2]!='X') {
n->dcl_print(0);
bl = 0;
}
Pname cn;
if (bl
&& (cn=n->tp->is_cl_obj())
&& Pclass(cn->tp)->has_dtor()) bl = 0;
}
if ( last_ll==0 && (last_ll = where.line) )
where.putline();
if (bl) {
Pstmt sl = s_list;
s_list = 0;
print();
memtbl = tbl;
puttok(RC);
if (sl) {
s_list = sl;
sl->print();
}
}
else {
print();
memtbl = tbl;
puttok(RC);
}
return;
}
switch (base) {
default:
error('i',"S::print(base=%k)",base);
case ASM:
fprintf(out_file,"asm(\"%s\");\n",(char*)e);
break;
case DCL:
d->dcl_print(SM);
break;
case BREAK:
case CONTINUE:
puttok(base);
puttok(SM);
break;
case DEFAULT:
puttok(base);
//puttok(COLON);
putch(':');
s->print();
break;
case SM:
if (e) {
e->print();
if (e->base==ICALL && e->e2) break; /* a block: no SM */
}
puttok(SM);
break;
case WHILE:
puttok(WHILE);
putcond();
if (s->s_list) {
puttok(LC);
s->print();
puttok(RC);
}
else
s->print();
break;
case DO:
puttok(DO);
s->print();
puttok(WHILE);
putcond();
puttok(SM);
break;
case SWITCH:
puttok(SWITCH);
putcond();
s->print();
break;
case RETURN:
{
puttok(RETURN);
if (e) {
//error('d',"print return rt %t etp %t",ret_tp,e->tp);
if (ret_tp && ret_tp!=e->tp) {
Ptype tt = ret_tp;
gook:
switch (tt->base) {
case TYPE:
tt = Pbase(tt)->b_name->tp;
goto gook;
case COBJ:
break; // cannot cast to struct
case RPTR:
case PTR:
if (Pptr(tt)->typ==Pptr(e->tp)->typ) break;
if (Pptr(tt)->memof) break;
default:
if (e->tp==0 || ret_tp->check(e->tp,0)) {
int oc = Cast;
putch('(');
Cast = 1;
ret_tp->print();
Cast = oc;
putch(')');
}
}
}
eprint(e);
}
puttok(SM);
}
while (s_list && s_list->base==SM) s_list = s_list->s_list; // FUDGE!!
break;
case CASE:
puttok(CASE);
eprint(e);
putch(':');
s->print();
break;
case GOTO:
puttok(GOTO);
d->print();
puttok(SM);
break;
case LABEL:
d->print();
putch(':');
s->print();
break;
case IF:
{ int val = QUEST;
if (e->base == ANAME) {
Pname a = Pname(e);
Pexpr arg = aval(a);
//error('d',"arg %d%k %d (%d)",arg,arg?arg->base:0,arg?arg->base:0,arg?arg->e1:0);
if (arg)
switch (arg->base) {
case ZERO: val = 0; break;
case ADDROF:
case G_ADDROF: val = 1; break;
case IVAL: val = arg->i1!=0;
}
}
//error('d',"val %d",val);
switch (val) {
case 1:
s->print();
break;
case 0:
if (else_stmt)
else_stmt->print();
else
puttok(SM); /* null statement */
break;
default:
puttok(IF);
putcond();
if (s->s_list) {
puttok(LC);
s->print();
puttok(RC);
}
else
s->print();
if (else_stmt) {
if (else_stmt->where.line == 0) {
if (csloc.line) csloc.putline();
} else {
csloc = else_stmt->where;
if (else_stmt->where.line!=last_line.line)
if (last_ll = else_stmt->where.line)
else_stmt->where.putline();
else
last_line.putline();
}
puttok(ELSE);
if (else_stmt->s_list) {
puttok(LC);
else_stmt->print();
puttok(RC);
}
else
else_stmt->print();
}
}
break;
}
case FOR:
{
// int fi = for_init && ((for_init->base!=SM || for_init->memtbl || for_init->s_list);
int fi = 0; // is the initializer statement an expression?
if (for_init) {
fi = 1;
if (for_init->memtbl==0 && for_init->s_list==0)
if (for_init->base==SM)
if (for_init->e->base!=ICALL || for_init->e->e1)
fi = 0;
}
//error('d',"for(; %d%k; %d%k)",e,e->base,e2,e2->base);
if (fi) {
puttok(LC);
for_init->print();
}
putstring("for(");
if (fi==0 && for_init) for_init->e->print();
putch(';'); // to avoid newline: not puttok(SM)
if (e) e->print();
putch(';');
if (e2) e2->print();
puttok(RP);
s->print();
if (fi) puttok(RC);
break;
}
case PAIR:
if (s&&s2) {
puttok(LC);
s->print();
s2->print();
puttok(RC);
}
else {
if (s) s->print();
if (s2) s2->print();
}
break;
case BLOCK:
puttok(LC);
//error('d',"block %d d %d memtbl %d own_tbl %d",this,d,memtbl,own_tbl);
if (d) d->dcl_print(SM);
if (memtbl && own_tbl) {
Pname n;
int i;
for (n=memtbl->get_mem(i=1); n; n=memtbl->get_mem(++i)) {
if (n->tp && n->n_union==0 && n->tp!=any_type)
switch (n->n_scope) {
case ARGT:
case ARG:
break;
default:
// error('d', "n: %s %k n_key: %k", n->string, n->base, n->n_key);
if ( n->base == TNAME && n->n_key == NESTED )
continue; // printed from nested class
n->dcl_print(0);
}
}
if (last_ll==0 && s && (last_ll=s->where.line))
s->where.putline();
}
if (s) s->print();
if (where2.line == 0) {
if (csloc.line) csloc.putline();
} else {
csloc = where2;
if (where2.line!=last_line.line)
if (last_ll = where2.line)
where2.putline();
else
last_line.putline();
}
putstring("}\n");
if (last_ll && where.line) last_line.line++;
}
if (s_list) s_list->print();
}
/*
void table::dcl_print(TOK s, TOK pub)
// print the declarations of the entries in the order they were inserted
// ignore labels (tp==0)
{
register Pname* np;
register int i;
if (this == 0) return;
np = entries;
for (i=1; i<free_slot; i++) {
register Pname n = np[i];
switch (s) {
case 0:
n->dcl_print(0);
break;
case EQ:
if (n->tp && n->n_scope == pub) n->dcl_print(0);
break;
case NE:
if (n->tp && n->n_scope != pub) n->dcl_print(0);
break;
}
}
}
*/
struct ptbl_rec {
char* pname;
char* vname;
ptbl_rec* next;
};
static char* ptbl_name;
static ptbl_rec* ptbl_rec_lookup_head = 0;
static ptbl_rec* ptbl_rec_pair_head = 0;
void ptbl_init(int flag)
{
if (!flag) {
char *p = st_name( "__ptbl_vec__" );
ptbl_name = new char[strlen(p)+1];
strcpy(ptbl_name, p);
delete p;
fprintf(out_file, "extern struct __mptr* %s[];\n", ptbl_name);
if (last_ll) last_line.line++;
}
else {
ptbl_rec *r, *p = ptbl_rec_lookup_head;
if ( p == 0 ) return; // don't generate an empty object
fprintf(out_file, "struct __mptr* %s[] = {\n", ptbl_name);
if (last_ll) last_line.line++;
int i = 0;
while (p != 0) {
r = ptbl_rec_pair_head;
while (r && strcmp(r->pname, p->pname))
r = r->next;
fprintf(out_file, "%s,\n", r->vname);
if (last_ll) last_line.line++;
p = p->next;
}
// fprintf(out_file, "0\n};\n");
fprintf(out_file, "\n};\n");
if (last_ll) last_line.line += 2;
}
}
char* ptbl_lookup(char *name)
{
ptbl_rec *r, *s, *p = ptbl_rec_lookup_head;
int i = 0;
while (p && strcmp(name, p->pname)) {
r = p;
p = p->next;
i++;
}
if (p == 0) {
s = new ptbl_rec;
s->pname = new char[strlen(name) + 1];
s->vname = 0;
s->next = 0;
strcpy(s->pname, name);
if (ptbl_rec_lookup_head == 0)
ptbl_rec_lookup_head = s;
else r->next = s;
}
char *pp = new char[ strlen(ptbl_name) + 10 ];
sprintf(pp, "%s[%d]", ptbl_name, i);
return(pp);
}
void ptbl_add_pair(char* ptbl, char* vtbl)
{
// error('d', "ptbl_add_pair: ptbl: %s, vtbl: %s", ptbl, vtbl );
ptbl_rec *p = new ptbl_rec;
p->pname = new char[strlen(ptbl) + 1];
strcpy(p->pname, ptbl);
p->vname = new char[strlen(vtbl) + 1];
strcpy(p->vname, vtbl);
p->next = ptbl_rec_pair_head;
ptbl_rec_pair_head = p;
}
0707071010112044411004440001630000160000010205600466055406600001100000140076print2.c /*ident "@(#)ctrans:src/print2.c 1.4" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
print2.c:
print names and declarations
****************************************************************************/
#include "cfront.h"
#include "template.h"
bit Cast;
int last_ll = 1;
Pin curr_icall;
char emode;
int ntok;
static int MAIN; // fudge to get _main() called by main()
#define eprint(e) if (e) Eprint(e)
#ifdef DENSE
void chop(char*);
#endif
void puttok(TOK t)
/*
print the output representation of "t"
*/
{
// if (t<=0 || MAXTOK<t) error("illegal token %d",t);
// char* s = keys[t];
// if (s == 0) error("V representation token %d",t);
putstring(keys[t]);
if (12<ntok++) {
ntok = 0;
last_line.putline();
}
else if (t == SM) {
ntok = 0;
putch('\n');
if (last_ll) last_line.line++;
}
else
putch(' ');
}
#define MX 20
#define NTBUF 10
class dcl_buf {
/*
buffer for assembling declaration (or cast)
left contains CONST_PTR => *CONST
CONST_RPTR => &CONST
PTR => *
RPTR => &
LP => (
right contains RP => )
VEC => [ rnode ]
FCT => ( rnode )
FIELD => : rnode
*/
Pbase b;
Pname n;
TOK left[MX], right[MX];
Pnode rnode[MX];
Pclass lnode[MX];
int li, ri;
public:
void init(Pname nn) { b=0; n=nn; li=ri=0; }
void base(Pbase bb) { b = bb; }
void front(TOK t) { left[++li] = t; }
void front(Pclass c) { left[++li] = MEMPTR; lnode[li] = c; }
void back(TOK t, Pnode nod) { right[++ri] = t; rnode[ri] = nod; }
void paran() { front(LP); back(RP,0); }
void put();
} *tbufvec[NTBUF] = {0}, *tbuf = 0;
int freetbuf = 0;
void dcl_buf::put()
{
int i;
Pfct ff = 0;
if (MX<=li || MX<=ri) error('i',"T buffer overflow");
if (b == 0) error('i',"noBT%s",Cast?" in cast":"");
if (n && n->n_sto && n->n_sto!=REGISTER) puttok(n->n_sto);
b->dcl_print();
for( ; li; li--) {
switch (left[li]) {
case LP:
putch('(');
break;
case PTR:
putch('*');
break;
case RPTR:
if (emode)
putch('&');
else
putch('*');
break;
case CONST_PTR:
if (emode)
putstring("*const ");
else
putch('*');
break;
case CONST_RPTR:
if (emode)
putstring("&const ");
else
putch('*');
break;
case MEMPTR:
if (lnode[li]) fprintf(out_file,"%s::",lnode[li]->string);
}
}
if (n) n->print();
for(i=1; i<=ri; i++) {
switch (right[i]) {
case RP:
putch(')');
break;
case VEC:
putch('[');
{ Pvec v = (Pvec) rnode[i];
Pexpr d = v->dim;
int s = v->size;
if (d) d->print();
if (s) fprintf(out_file,"%d",s);
}
putch(']');
break;
case FCT: // beware of function returning pointer to
// function expressed witout typedef
{ Pfct f = Pfct(rnode[i]);
if (f->body) ff = f;
f->dcl_print();
break;
}
case FIELD:
{ Pbase f = (Pbase) rnode[i];
Pexpr d = (Pexpr)f->b_name;
int s = f->b_bits;
putch(':');
if (d)
d->print();
else if (s)
fprintf(out_file,"%d",s);
else
puttok(ZERO);
break;
}
}
}
void print_body(Pfct);
if (ff && emode==0) print_body(ff);
}
static Pexpr mk_zero_init( Ptype tt, Pname obname, Pname currname )
/*
creates 0 initializer for defined objects
side effect: generates right nesting level for {}
*/
{
zaq:
switch (tt->base) {
case TYPE:
tt = Pbase(tt)->b_name->tp; goto zaq;
case VEC: // type a[size]; => type a[size] = {0};
{
if ( obname == currname ) {
//xxx initializing vectors blows up the size of some programs
return 0;
} else {
Pexpr i = mk_zero_init(Pvec(tt)->typ,obname,currname);
if ( i == 0 ) return 0;
return new expr( ILIST, i, 0 );
}
}
case COBJ: // "X a;" == "X a = {0};"
{
Pclass cl = Pclass(Pbase(tt)->b_name->tp);
if ( !ansi_opt && (cl->csu == ANON || cl->csu == UNION) ) {
if ( warning_opt ) {
// ridiculous handstands to avoid printing
// compiler generated names in warning
Ptype tn = obname->tp;
for(;;) if(tn->base==VEC) tn=Pvec(tn)->typ; else break;
if ( obname == currname && tt == tn ) {
if ( cl->string[0]=='_' && cl->string[1]=='_' )
error('w',&obname->where,"cannot generate zeroIr for%n ofT union; toI, compile with +a1 or insert non-union object as first member",obname);
else
error('w',&obname->where,"cannot generate zeroIr for%n ofT%t; toI, compile with +a1 or insert non-union object as first member",obname,obname->tp);
} else { Pclass cx;
if ( tn->base == COBJ
&& (cx=(Pclass)Pbase(tn)->b_name->tp,
cx->string[0]=='_' && cx->string[1]=='_') )
error('w',&obname->where,"cannot generate zeroIr for%n (union or aggregate with union as first element); toI, compile with +a1 or insert non-union object as first member",obname);
else
error('w',&obname->where,"cannot generate zeroIr for%n ofT%t (union or aggregate with union as first element); toI, compile with +a1 or insert non-union object as first member",obname,obname->tp);
}
} // if warning_opt
return 0;
}
Pbcl l = cl->baselist;
while ( l ) {
if ( l->base == NAME ) cl = l->bclass;
else return new expr(ILIST,zero,0);
l = cl->baselist;
}
int i = 1;
Pname nn = cl->memtbl->get_mem(i);
for ( ; nn; nn = cl->memtbl->get_mem(++i) ) {
Ptype tx = nn->tp;
while ( tx->base == TYPE ) tx = Pbase(tx)->b_name->tp;
if (nn->base==NAME
&& nn->n_union==0
&& tx->base!=FCT
&& tx->base!=OVERLOAD
&& tx->base!=CLASS
&& tx->base!=ENUM
&& nn->n_stclass != STATIC) {
Pexpr i = mk_zero_init(tx,obname,nn);
if ( i == 0 ) return 0;
return new expr(ILIST,i,0);
}
}
return 0;
}
case PTR:
if (tt->memptr()) {
Pexpr i = new expr(ELIST,zero,zero);
return new expr(ILIST,i,zero);
}
// no break
case RPTR:
case CHAR:
case SHORT:
case INT:
case EOBJ:
case LONG:
case FLOAT:
case DOUBLE:
case LDOUBLE: // "int a;" == "int a = 0;"
case FIELD:
case ANY:
return zero;
}
return 0;
}
void name::dcl_print(TOK list)
/*
Print the declaration for a name (list==0) or a name list (list!=0):
For each name
(1) print storage class
(2) print base type
(3) print the name with its declarators
Avoid (illegal) repetition of basetypes which are class or enum declarations
(A name list may contain names with different base types)
list == SM : terminator SM
list == 0: single declaration with terminator SM
list == CM : separator CM
*/
{
if (error_count) return;
for (Pname n=this; n; n=n->n_list) {
Ptype t = n->tp;
int sm = 0;
// error('d',"%s->dcl_print() tp %t sto %k",n->string,t,n->n_sto);
if (t == 0) error('i',"N::dcl_print(%n)T missing",n);
if (n->n_stclass==ENUM) if (list) continue; else return;
if (n->where.line!=last_line.line || n->where.file!=last_line.file)
//fprintf(stderr,"%s ",n->string?n->string:"<0>"); n->where.put(stderr); fprintf(stderr," last "); last_line.put(stderr); putc('\n',stderr);
if (last_ll = n->where.line)
n->where.putline();
else
last_line.putline();
int tc = Pbase(t)->b_const;
for (Ptype tt = t; tt->base==TYPE; tt = Pbase(tt)->b_name->tp)
tc |= Pbase(tt)->b_const;
switch (t->base) {
case CLASS:
//fprintf(stderr,"class %s->dcl_print()\n",n->string);
if (n->base != TNAME) {
Pclass(t)->dcl_print(n);
sm = 1;
}
break;
case ENUM:
Penum(t)->dcl_print(0);
sm = 1;
break;
case FCT:
{ Pfct f = Pfct(t);
if (n->base == TNAME) puttok(TYPEDEF);
// error('d',"fct %n->dcl_print() printed %d body %d defined %d",n,n->n_dcl_printed,f->body,f->defined);
// error('d',"n %d tbl %d tp %t inline %d",n,n->n_table,n->tp,f->f_inline);
if (n->n_dcl_printed==2 // definition already printed
|| (n->n_dcl_printed==1 && f->body==0)
// declaration already printed
) {
// don't print again
sm = 1; // no SM
break;
}
if (f->f_result == 0) make_res(f);
if (f->body && n->n_sto==EXTERN) n->n_sto = 0;
if (f->f_inline && ((n->n_table!=gtbl) || strcmp(n->string,"main"))) {
if (debug_opt) {
//error('d',"f %t defined %d inline %d",f,f->defined,f->f_inline);
if (f->defined&DEFINED
&& f->defined&SIMPLIFIED
&& f->f_inline!=ITOR)
goto prnt_def;
else if (n->n_dcl_printed==0)
goto prnt_dcl;
else {
sm = 1;
break;
}
}
if (f->f_virtual || n->n_addr_taken) {
prnt_dcl:
//error('d',"prnt_dcl %d %n %k",n,n,n->n_sto);
TOK st = n->n_sto;
Pblock b = f->body;
f->body = 0;
t->dcl_print(n);
n->n_dcl_printed = 1;
n->n_sto = st;
f->body = b;
break;
}
else
sm = 1; // no SM
}
else if ((f->defined&DEFINED)==0
|| (f->defined&SIMPLIFIED)==0)
goto prnt_dcl;
else if (n->n_table==gtbl && strcmp(n->string,"main")==0) {
if (f->f_inline) {
if (warning_opt) {
error('w',"main() cannot be inlined");
error('w',"out-of-line copy of main() created");
}
n->n_sto=0;
}
MAIN = 1;
gtbl->look("main",0)->use();
f->f_signature = 0;
t->dcl_print(n);
n->n_dcl_printed = f->body?2:1;
MAIN = 0;
}
else {
prnt_def:
// error('d',"prnt_def %n %k %d %k",n,n->n_oper,n,n->n_sto);
if (n->n_oper==CTOR || n->n_oper==DTOR) {
Pclass cl = Pclass(n->n_table->t_name->tp);
if (cl->c_body == 3) cl->print_all_vtbls(cl);
}
if ( n->n_sto == STATIC &&
pdef_name == 0 && def_name == 0 ) {
// error('d', "printing ptbl_vec without first definition" );
pdef_name = n;
ptbl_init(0);
}
t->dcl_print(n);
n->n_dcl_printed = f->body?2:1;
}
if (f->body) sm = 1;
break;
}
case OVERLOAD:
{
for (Plist gl=Pgen(t)->fct_list; gl; gl=gl->l) {
Pname nn = gl->f;
nn->dcl_print(0);
sm = 1;
}
break;
}
case ASM:
fprintf(out_file,"asm(\"%s\")\n",(char*)Pbase(t)->b_name);
break;
case INT:
case EOBJ:
case CHAR:
case LONG:
case SHORT:
tcx:
// do not allocate space for constants unless necessary
if (tc
&& n->n_sto!=EXTERN // extern const one;
// const one = 1;
// allocates storage
&& (n->n_scope==EXTERN // FUDGE const one = 1;
// is treated as static
// need loader support
|| n->n_scope==STATIC
|| n->n_scope==FCT)
) {
if (n->n_evaluated && n->n_addr_taken==0) {
sm = 1; /* no ; */
break;
}
}
tc = 0;
// no break;
default:
{
/*
// don't print local instance of const
if ( n->n_dcl_printed == 3 ) {
sm = 1;
break;
}
*/
Pexpr i = n->n_initializer;
if (n->base == TNAME && n->n_key == NESTED) i = 0;
if (tc) {
switch (tt->base) {
case CHAR:
case SHORT:
case INT:
case LONG:
case EOBJ:
goto tcx;
}
}
if (n->base == TNAME) {
/* Always print template formals, even when they have the same
* formal name, since the instantiation name is different. This
* fix should not be required when the copy mechanism is in place. */
if (! n_template_arg)
for (Pname tn=ktbl->look(n->string,HIDDEN); tn; tn=tn->n_tbl_list)
if (tn && tn->lex_level && t==tn->tp) return;
puttok(TYPEDEF);
}
if (n->n_stclass == REGISTER) {
// (imperfect) check against member functions
// register s a; a.f() illegal
Pname cln = n->tp->is_cl_obj();
if (cln) {
Pclass cl = Pclass(cln->tp);
if (cl->csu!=CLASS
&& cl->baselist==0
&& cl->has_itor()==0
&& cl->virt_count==0) puttok(REGISTER);
}
else
puttok(REGISTER);
}
if (i) {
if (n->n_sto==EXTERN && n->n_stclass==STATIC) {
n->n_initializer = 0;
t->dcl_print(n);
puttok(SM);
n->n_initializer = i;
n->n_sto = 0;
t->dcl_print(n);
n->n_sto = EXTERN;
}
else
t->dcl_print(n);
if(n->n_table) {
Pname nn = n->n_table->look(n->string,0);
if(nn)
nn->n_dcl_printed = 1;
else
n->n_dcl_printed = 1;
}
else
n->n_dcl_printed = 1;
}
else if (n->n_evaluated && Pbase(t)->b_const) {
if (n->n_sto==EXTERN && n->n_stclass==STATIC) {
int v = n->n_evaluated;
n->n_evaluated = 0;
t->dcl_print(n);
puttok(SM);
if (n->where.line!=last_line.line || n->where.file!=last_line.file)
if (last_ll = n->where.line)
n->where.putline();
else
last_line.putline();
n->n_evaluated = v;
n->n_sto = 0;
t->dcl_print(n);
n->n_sto = EXTERN;
}
else
t->dcl_print(n);
if(n->n_table) {
Pname nn = n->n_table->look(n->string,0);
if(nn)
nn->n_dcl_printed = 1;
else
n->n_dcl_printed = 1;
}
else
n->n_dcl_printed = 1;
}
else {
//error('d',"%n sto %k val %d stc %k",n,n->n_sto,n->n_val,n_stclass);
if ((n->n_sto==0 || (n->n_val && n->n_evaluated==0))
&& n_stclass==STATIC
&& n->n_sto!=STATIC
&& n->n_table==gtbl) {
if (n->n_val && n->n_evaluated==0) {
// extern x = f();
// generate int x = 0;
// plus dynamic initialization
n->n_sto = 0;
}
n->n_initializer = i = mk_zero_init(t,n,n);
}
t->dcl_print(n);
if(n->n_table) {
Pname nn = n->n_table->look(n->string,0);
if(nn)
nn->n_dcl_printed = 1;
else
n->n_dcl_printed = 1;
}
else
n->n_dcl_printed = 1;
}
if (n->n_scope!=ARG) {
if (i) {
puttok(ASSIGN);
Pexpr i2 = i;
while (i2->base == CAST) i2 = i2->e1;
if (i2->base == ILIST) i = i2;
if (t!=i->tp
&& i->base!=ZERO
&& i->base!=ILIST /*&& i->tp!=Pchar_type*/) {
Ptype t1 = n->tp;
cmp:
switch (t1->base) {
case TYPE:
t1 = Pbase(t1)->b_name->tp;
goto cmp;
default:
i->print();
break;
// case EOBJ:
// goto cst;
case VEC:
if (Pvec(t1)->typ->base==CHAR) {
i->print();
break;
}
// no break
case PTR:
case RPTR:
if (i->tp==0 || n->tp->check(i->tp,0)) {
// cst:
putch('(');
bit oc = Cast;
Cast = 1;
t->print();
Cast = oc;
putch(')');
}
eprint(i);
}
}
else {
if (i==zero) {
while (t->base == TYPE) t = Pbase(t)->b_name->tp;
// if (t->base == EOBJ) {
// putch('(');
// bit oc = Cast;
// Cast = 1;
// t->print();
// Cast = oc;
// putch(')');
// }
}
eprint(i);
// i->print();
}
}
else if (n->n_evaluated) {
puttok(ASSIGN);
if (n->tp->base!=INT || n->tp->is_unsigned()) {
putstring("((");
bit oc = Cast;
Cast = 1;
n->tp->print();
Cast = oc;
fprintf(out_file,")%d)",n->n_val);
}
else
fprintf(out_file,"%d",n->n_val);
}
}
}
}
switch (list) {
case SM:
if (sm==0) puttok(SM);
break;
case 0:
if (sm==0) puttok(SM);
return;
case CM:
if (n->n_list) puttok(CM);
break;
}
}
}
char *local_sign( Ptype pt )
{ // get function signature for local class
char buf[1024];
char* bb = pt->signature(buf);
int ll = bb-buf;
if (1023 < ll) error('i',"local class N buffer overflow");
char *p = new char[ll+1];
strcpy(p,buf);
return p;
}
void enumdef::dcl_print(Pname cln)
/*
*/
{
// note: ***** modify to handle local enums
// error('d', "%t::dcl_print(%n) in_class: %t nested_sig: %s", this, cln, in_class, nested_sig );
char* s = nested_sig?nested_sig:(cln ? cln->string:0);
if ( nested_sig )
fprintf(out_file,"enum __%s { ",nested_sig);
else fprintf(out_file,"enum %s { ",string);
for (Pname px, p=mem; p; p=px) {
px = p->n_list;
if (s) {
if (p->n_evaluated)
fprintf(out_file,"%s__%s = %d",p->string,s,p->n_val);
else
fprintf(out_file,"%s__%s",p->string,s);
}
else {
if (p->n_evaluated)
fprintf(out_file,"%s = %d",p->string,p->n_val);
else
fprintf(out_file,"%s",p->string);
}
if (px) puttok(CM);
p->n_initializer = 0;
delete p;
}
mem = 0;
puttok(RC);
puttok(SM);
}
void name::print()
{ // print just the name itself
if (this == 0) error('i',"0->N::print()");
if (string == 0) {
if (emode) putch('?');
return;
}
// error( 'd', "%s->name::print(), base: %k", string, base );
switch (base) {
case TNAME:
if (n_key == NESTED && tpdef &&
tpdef->nested_sig) {
if ( emode == 0 ) {
putstring( " __" );
putst(tpdef->nested_sig);
}
else {
putst(tpdef->in_class->string);
putstring( "::" );
putst(string);
}
return;
}
if (emode && tp) {
if (n_template_arg_string) {
tp->dcl_print(0); return;
} else
if(tp->base == COBJ) {
Pclass cl = Pclass(Pbase(tp)->b_name->tp);
if(cl && cl->base == CLASS &&
(cl->class_base == instantiated_template_class)) {
Ptclass(cl)->inst->print_pretty_name(); return;
}
}
}
putst(n_template_arg_string ? n_template_arg_string : string);
return;
case MDOT:
Pexpr(this)->print();
return;
}
if (emode) {
Ptable tbl;
char* cs = 0;
bit f = 0;
if (tp) {
switch (tp->base) {
case OVERLOAD:
case FCT:
f = 1;
default:
if (tbl=n_table) {
if (tbl == gtbl) {
if (f == 0) putstring("::");
}
else {
if (tbl->t_name) {
Ptclass pc = Ptclass(tbl->t_name->tp);
cs = tbl->t_name->string;
if ((pc->base == CLASS) &&
(pc->class_base == instantiated_template_class))
pc->inst->print_pretty_name();
else fprintf(out_file,"%s",cs);
fprintf (out_file, "::") ;
}
}
}
if (n_scope==ARG && strcmp(string,"this")==0) {
// tell which "this" it is
Ptype tt = Pptr(tp)->typ;
Pname cn = Pbase(tt)->b_name;
fprintf(out_file,"%s::",cn->string);
}
case CLASS:
case ENUM:
// case TYPE:
break;
}
nop:
switch (n_oper) {
case TYPE:
putstring("operator ");
if (tp) Pfct(tp)->returns->dcl_print(0);
break;
case 0:
putstring(string);
break;
case DTOR:
putch('~');
case CTOR:
if (cs) {
if(tbl->t_name) {
Ptclass pc = Ptclass(tbl->t_name->tp);
if ((pc->base == CLASS) &&
(pc->class_base == instantiated_template_class))
pc->inst->print_pretty_name();
else putstring(cs);
}
}
else {
if (string)
fprintf(out_file,"%s()", n_template_arg_string
? n_template_arg_string : string);
else putstring("constructor");
f = 0;
}
break;
case TNAME:
putstring(string);
break;
default:
putstring("operator ");
putstring(keys[n_oper]);
break;
}
if (f) putstring("()");
}
else {
if (n_oper) goto nop;
if (string)
putstring(n_template_arg_string
? n_template_arg_string : string);
}
return;
}
char* sig = 0;
Pclass cl = 0;
Penum en = 0;
int i = n_union;
if (tp) {
Ptable tbl;
switch (tp->base) {
default:
if (tbl=n_table) { // global or member
Pname tn;
if (tbl == gtbl) {
// if (i) fprintf(out_file,"__O%d.",i);
if ( i ) {
if (n_anon)
fprintf(out_file,"__O%d.%s.", i, n_anon );
else fprintf(out_file,"__O%d.",i);
}
break;
}
if (tn=tbl->t_name) {
cl = Pclass(tn->tp);
if (i) {
if (cl->string[0]=='_'
&& cl->string[1]=='_'
&& cl->string[2]=='C' ) {
if (n_anon)
fprintf(out_file,"__O%d.%s.", i, n_anon );
else fprintf(out_file,"__O%d.",i);
}
else
if ( cl->nested_sig )
fprintf(out_file,"__O%d__%s.",i,cl->nested_sig);
else
if ( cl->lex_level ) {
char *str = make_local_name(cl,1);
fprintf(out_file,"__O%d%s.",i,str);
delete str;
}
else fprintf(out_file,"__O%d__%d%s.",i,cl->strlen,cl->string);
cl = 0;
}
else
if (cl->string[0]=='_'
&& cl->string[1]=='_'
&& cl->string[2]=='C'
&& n_stclass != STATIC )
cl = 0;
break;
}
}
switch (n_stclass) { // local variable
case STATIC:
case EXTERN:
if (i)
fprintf(out_file,"__O%d.",i);
else if (n_sto==STATIC && tp->base!=FCT) {
if (lex_level == 0)
putstring("__S");
else
fprintf(out_file,"__%d",lex_level);
}
break;
default:
// encode with lexical level UNLESS ``special''
// e.g. __builtin
if (string[0]!='_' || string[1]!='_' || string[2] != 'C' ) {
if (i)
{
if (n_anon)
fprintf(out_file,"__%d__O%d.%s.",lex_level-1,i,n_anon);
else fprintf(out_file,"__%d__O%d.",lex_level-1,i);
}
else
fprintf(out_file,"__%d",lex_level);
}
}
break;
case CLASS:
case ENUM:
if (tp->in_class && tp->nested_sig) en = Penum(tp);
break;
}
if (tp->base==FCT) {
sig = Pfct(tp)->f_signature;
if (sig && sig[0]==0) sig = 0;
}
}
if (string) {
#ifdef DENSE
int i = strlen(string);
if (cl) i += cl->strlen+4; // __dd<class name>
if (sig) {
if (cl == 0) i += 2;
i += strlen(sig);
}
if (31<i) {
char buf[256];
if (cl && sig)
sprintf(buf,"%s__%d%s%s",string,cl->strlen,cl->string,sig);
else if (cl)
sprintf(buf,"%s__%d%s",string,cl->strlen,cl->string);
else if (sig)
sprintf(buf,"%s__%s",string,sig);
else
sprintf(buf,"%s",string);
chop(buf);
fprintf(out_file,"%s ",buf);
return;
}
#endif
if ( en )
fprintf(out_file,"__%s", en->nested_sig);
else
putstring(n_template_arg_string
? n_template_arg_string : string);
if ( cl ) {
if ( cl->nested_sig )
fprintf(out_file,"__%s",cl->nested_sig);
else
if ( cl->lex_level ) {
char *str = make_local_name( cl, 1 );
putstring( str );
delete str;
}
else fprintf(out_file,"__%d%s",cl->strlen,cl->string);
}
if (sig) {
if (cl == 0) putstring("__");
putstring(sig);
}
putch(' ');
}
}
#ifdef DENSE
void chop(char* buf)
{
static char alpha[] = "_0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
static const asz = sizeof(alpha)-1;
int hash = 0;
char* p = &buf[29];
while (*p) {
hash <<= 1;
if (hash & (1<<12)) {
hash &= ~(1<<12);
hash++;
}
hash ^= *p++;
}
buf[29] = alpha[(int)(hash%asz)];
buf[30] = alpha[(int)((hash/asz)%asz)];
buf[31] = 0;
}
#endif
void type::print()
{
switch (base) {
case PTR:
case RPTR:
case VEC:
Pptr(this)->dcl_print(0);
break;
case FCT:
Pfct(this)->dcl_print();
break;
// case VEC:
// Pvec(this)->dcl_print(0);
// break;
case CLASS:
case ENUM:
if (emode)
fprintf(out_file,"%k",base);
else
// error('i',"%p->T::print(%k %s)",this,base,Pclass(this)->string);
fprintf(out_file,"struct %s *",Pclass(this)->string);
break;
case TYPE:
if (Cast||Pbase(this)->b_name->lex_level) {
Pbase(this)->b_name->tp->print();
break;
}
// no break
default:
Pbase(this)->dcl_print();
}
}
char* type::signature(register char* p)
/*
take a signature suitable for argument types for overloaded
function names
*/
{
Ptype t = this;
int pp = 0; // pointer to
xx:
//error('d',"xx(%d) %d %k",this,t,t->base);
// first unroll typedefs and handle derived types:
switch (t->base) {
case TYPE:
if (Pbase(t)->b_const) *p++ = 'C';
t = Pbase(t)->b_name->tp;
goto xx;
case VEC:
if (pp && Pvec(t)->size) { // A<size>_
*p++ = 'A';
sprintf(p,"%d\0",Pvec(t)->size); // don't trust
// sprintf return value
while (*++p);
*p++ = '_';
}
else
*p++ = 'P';
t = Pvec(t)->typ;
pp = 1;
goto xx;
case PTR:
if (Pptr(t)->rdo) *p++ = 'C'; // *const
if (Pptr(t)->memof) { // M<size><classname>
Pclass cl = Pptr(t)->memof;
register char* s = cl->string;
int d = cl->strlen;
if (d==0) cl->strlen = d = strlen(s);
*p++ = 'M';
if (d/10) *p++ = '0'+d/10;
*p++ = '0'+ d%10; // assume <100 char
while (*p++ = *s++);
--p; // not the '\0'
}
else
*p++ = 'P';
t = Pptr(t)->typ;
pp = 1;
goto xx;
case RPTR:
*p++ = 'R';
t = Pptr(t)->typ;
pp = 1;
goto xx;
case FCT:
{ Pfct f = Pfct(t);
Pname n = f->argtype;
if (f->f_const) *p++ = 'C'; // constant member function
if (f->f_static) *p++ = 'S'; // static member function
// if (f->memof && f->f_this==0) *p++ = 'S'; //SSS static member function
*p++ = 'F';
if (n == 0)
*p++ = 'v'; // VOID, that is f() == f(void)
else
for ( ; n; n=n->n_list) { // print argument encoding
// check if argtype is the same
// as previously seen argtype
int i = 0;
for (Pname nn=f->argtype; n!=nn; nn=nn->n_list) {
i++;
if (nn->tp==n->tp || nn->tp->check(n->tp,0)==0) {
// typeof (n) == typeof(arg i)
int x = 1; // try for a run after n
Pname nnn = n;
while ((nnn=nnn->n_list) && x<9) {
if (nnn->tp==n->tp
|| nnn->tp->check(n->tp,0)==0) {
x++;
n = nnn;
}
else
break;
}
if (x == 1) // Ti
*p++ = 'T';
else { // Nxi
*p++ = 'N';
*p++ = '0'+x;
}
// assume <100 arguments
if (9<i) *p++ = '0'+i/10;
*p++ = '0'+i%10;
goto zk;
}
}
// ``normal'' case print argument type signature
// if (n->n_xref) *p++ = 'R';
p = n->tp->signature(p);
zk:;
}
if (f->nargs_known == ELLIPSIS) *p++ = 'e';
if (pp) { // '_' result type
*p++ = '_';
p = f->returns->signature(p);
}
*p = 0;
return p;
}
}
// base type modifiers:
if ( Pbase(t)->b_const ) *p++ = 'C';
// if ( Pbase(t)->b_signed ) *p++ = 'S';
if ( Pbase(t)->b_unsigned ) *p++ = 'U';
// if ( Pbase(t)->b_volatile ) *p++ = 'V';
// now base types:
register char *s, *ns = 0;;
int d;
Pclass cl;
//lll:
switch (t->base) {
// case TNAME: t = Pbase(t)->b_name->tp; goto lll;
case ANY: break;
case ZTYPE: break;
case VOID: *p++ = 'v'; break;
case CHAR: *p++ = 'c'; break;
case SHORT: *p++ = 's'; break;
// case EOBJ:
case INT: *p++ = 'i'; break;
case LONG: *p++ = 'l'; break;
case FLOAT: *p++ = 'f'; break;
case DOUBLE: *p++ = 'd'; break;
case LDOUBLE: *p++ = 'r'; break;
case EOBJ:
// *p++ = 'i';
// break;
{ Penum en = Penum(Pbase(t)->b_name->tp);
// t = en->e_type;
// goto lll;
ns = en->nested_sig;
s = en->string;
d = en->strlen;
if (d==0) en->strlen = d = strlen(s);
goto pppp;
}
case COBJ:
{ cl = Pclass(Pbase(t)->b_name->tp);
ns = cl->nested_sig;
s = cl->string;
d = cl->strlen;
if (d==0) cl->strlen = d = strlen(s);
pppp:
if ( ns == 0 ) {
if (d/10) *p++ = '0'+d/10;
*p++ = '0'+ d%10; // assume less that 99 characters
}
else s = ns;
while (*p++ = *s++);
--p;
break;
}
case FIELD:
default:
error('i',"signature of %k",t->base);
}
*p = 0;
return p;
}
void basetype::dcl_print()
{
Pname nn;
Pclass cl;
if (emode) {
if (b_virtual) puttok(VIRTUAL);
if (b_inline) puttok(INLINE);
}
if(ansi_opt || emode)
if (b_const) puttok(CONST);
if (b_unsigned) puttok(UNSIGNED);
switch (base) {
case ANY:
if (emode)
putstring("any ");
else
putstring("int ");
break;
case ZTYPE:
if (emode)
putstring("zero ");
else
putstring("int ");
break;
case VOID:
if (emode==0 && ansi_opt==0) {
// silly trick to bypass BSD C compiler bug
// void* (*)() dosn't work there
// note simpl.c knows that VOID -> CHAR grep for VCVC
puttok(CHAR);
break;
}
case CHAR:
case SHORT:
case INT:
case LONG:
case FLOAT:
case DOUBLE:
case LDOUBLE:
puttok(base);
break;
case EOBJ:
nn = b_name;
eob:
if (emode == 0)
// puttok(INT);
Penum(nn->tp)->e_type->dcl_print();
else {
puttok(ENUM);
nn->print();
}
break;
case COBJ:
nn = b_name;
cob:
cl = Pclass(nn->tp);
if (emode && (cl->base == CLASS) &&
(cl->class_base == instantiated_template_class)) {
Ptclass(cl)->inst->print_pretty_name();
break;
} else
if (cl && (cl->csu==UNION || cl->csu==ANON))
puttok(UNION);
else puttok(STRUCT);
{
char* s = 0;
if ( cl && cl->nested_sig )
fprintf(out_file," __%s ",cl->nested_sig);
else {
if ( cl && cl->lex_level )
s = make_local_name( cl );
putst(s?s:nn->string);
delete s;
}
}
break;
case TYPE:
if (emode == 0) {
switch (b_name->tp->base) {
case COBJ:
nn = Pbase(b_name->tp)->b_name;
goto cob;
case EOBJ:
nn = Pbase(b_name->tp)->b_name;
goto eob;
}
}
b_name->print();
break;
default:
if (emode) {
if (0<base && base<=MAXTOK && keys[base])
fprintf(out_file," %s",keys[base]);
else
putch('?');
}
else
error('i',"%p->BT::dcl_print(%d)",this,base);
}
}
Pbase memptr_type;
void type::dcl_print(Pname n)
/*
"this" type is the type of "n". Print the declaration
*/
{
//error('d',"%p::dcl_print(%n)",this,n);
Ptype t = this;
Pptr p;
TOK pre = 0;
if (t == 0) error('i',"0->dcl_print()");
if (n && n->tp!=t) error('i',"not %n'sT (%p)",n,t);
if (base == OVERLOAD) {
for (Plist gl=Pgen(this)->fct_list; gl; gl=gl->l) {
Pname nn = gl->f;
nn->tp->dcl_print(nn);
if (gl->l) puttok(SM);
}
return;
}
tbuf = tbufvec[freetbuf];
if (tbuf == 0) {
if (freetbuf == NTBUF-1) error('i',"AT nesting overflow");
tbufvec[freetbuf] = tbuf = new class dcl_buf;
}
freetbuf++;
if ( base==FIELD && Pbase(this)->b_bits == 0 )
tbuf->init(0);// some compilers can't handle mangled names here
else
tbuf->init(n);
if (n && n->n_xref) tbuf->front(PTR);
while (t) {
TOK k;
switch (t->base) {
case PTR:
p = Pptr(t);
k = (p->rdo) ? CONST_PTR : PTR;
goto ppp;
case RPTR:
p = Pptr(t);
k = (p->rdo) ? CONST_RPTR : RPTR;
ppp:
if (p->memof) {
if (emode) {
tbuf->front(k);
tbuf->front(p->memof);
}
else {
t = p->typ;
while (t->base==TYPE) t = Pbase(t)->b_name->tp;
if (t->base == FCT) {
tbuf->base(mptr_type);
goto zaq;
}
else
tbuf->front(k);
}
}
else
tbuf->front(k);
pre = PTR;
t = p->typ;
break;
case VEC:
{ Pvec v = Pvec(t);
if (Cast && pre != PTR && pre != VEC) { // for Macintosh: ptr to array uses [] notation
tbuf->front(PTR);
pre = PTR;
}
else {
if (pre == PTR) tbuf->paran();
tbuf->back(VEC,v);
pre = VEC;
}
t = v->typ;
break;
}
case FCT:
{ Pfct f = Pfct(t);
if (pre == PTR)
tbuf->paran();
else if (emode && f->memof && n==0)
tbuf->front(f->memof);
tbuf->back(FCT,f);
pre = FCT;
t = (f->s_returns) ? f->s_returns : f->returns;
break;
}
case FIELD:
tbuf->back(FIELD,t);
tbuf->base( Pbase(Pbase(t)->b_fieldtype) );
t = 0;
break;
case 0:
if(!emode)error('i',"noBT(B=0)");
goto dobase;
case TYPE:
if (Cast||Pbase(t)->b_name->lex_level) { // unravel type in case it contains vectors
t = Pbase(t)->b_name->tp;
break;
}
default: // the base has been reached
dobase:
if (emode) {
char* s;
for (Ptype tt = t; tt->base==TYPE; tt=Pbase(tt)->b_name->tp);
switch (tt->base) {
case CLASS:
s = Pclass(tt)->string;
if (Ptclass(this)->class_base == instantiated_template_class ||
Ptclass(this)->class_base == uninstantiated_template_class) {
Ptclass(this)->inst->print_pretty_name();
--freetbuf;
return;
}
if (s[0]=='_' &&s[1]=='_' && s[2]=='C') s="class";
goto fret;
case ENUM:
s = "enum";
goto fret;
case OVERLOAD:
s = "overloaded";
fret:
putstring(s);
freetbuf--;
return;
}
}
tbuf->base( Pbase(t) );
goto zaq;
} // switch
} // while
zaq:
tbuf->put();
freetbuf--;
}
void fct::dcl_print()
{
Pname nn;
//error('d',"fct::dcl_print()");
if (emode) {
putch('(');
for (nn=argtype; nn;) {
nn->tp->dcl_print(0);
if (nn=nn->n_list) puttok(CM); else break;
}
switch (nargs_known) {
case 0: // putst("?"); break;
case ELLIPSIS: puttok(ELLIPSIS); break;
}
putch(')');
if (f_const) puttok(CONST);
if (f_static) puttok(STATIC); // wrong place for ``static''
return;
}
Pname at = f_args;
putch('(');
if (ansi_opt) {
// print typed arguments:
at = (f_this) ? f_this : (f_result) ? f_result : argtype;
// WNG -- note: at = f_args had 0 value with ansi_opt set
// mystery fix added here
if (at == 0) {
if (nargs_known == ELLIPSIS) {
putch(')');
return;
}
puttok(VOID);
}
else if (body && Cast==0)
at->dcl_print(CM); // print argument type and name
else {
for (nn=at; nn;) {
// nn->tp->dcl_print(0); // print argument type
nn->tp->dcl_print(nn); // print argument type
// (there may not be a name)
if (nn=nn->n_list) puttok(CM); else break;
}
}
if (nargs_known == ELLIPSIS) putstring(",...");
putch(')');
}
else {
// print argument names followed by argument type declarations:
if (body && Cast==0) {
for (nn=at; nn;) {
nn->print();
if (nn=nn->n_list) puttok(CM); else break;
}
#ifdef mips
if (nargs_known == ELLIPSIS)
putstring(", va_alist");
#endif
#ifdef sparc
if (nargs_known == ELLIPSIS)
putstring(", __builtin_va_alist");
#endif
putch(')');
}
else
putch(')');
}
}
void print_body(Pfct f)
{
if (Cast==0) {
if (ansi_opt==0 && f->f_args) {
f->f_args->dcl_print(SM);
if ( last_ll==0 && (last_ll = f->body->where.line) )
f->body->where.putline();
}
if (MAIN) {
putstring("{ _main(); "); // call constructors
f->body->print();
puttok(RC);
}
else
f->body->print();
}
}
Pbcl shared_seen;
void classdef::print_members()
{
int i;
Pbcl l = baselist;
// error('d',"%t->print_members()",this);
if (l) {
if (l->base == NAME) {
l->bclass->print_members(); // first base only
// pad to ensure alignment:
int boff = l->bclass->real_size;
int ba = l->bclass->align();
int xtra = boff%ba;
int waste = (xtra) ? ba-xtra : 0; // padding
//error('d',"%s: size % align %d waste %d",string,boff,ba,waste);
if (waste) {
// waste it to protect against structure
// assignments to the base class
char* s = make_name('W');
fprintf(out_file,"char %s[%d];\n",s,waste);
delete s;
}
l = l->next;
}
for (; l; l=l->next)
/* for second base etc. one must allocate as an object
(rather than a list of members) to ensure proper alignment
for shared base allocate a pointer
size, alignment, & offset handled in cassdef::dcl()
*/
if (l->base == NAME) {
Pclass bcl = l->bclass;
char *str = 0;
char *cs = bcl->nested_sig?bcl->nested_sig:bcl->string;
if (bcl->lex_level &&
bcl->nested_sig==0)
str=make_local_name(bcl);
puttok(STRUCT);
putst(str?str:cs);
putcat('O',bcl->string); // leave as unencoded
puttok(SM);
delete str;
}
}
// Sam: A class or an enum type declared within a class can hide a
// member with the same name, so make sure that it gets printed by
// traversing the n_tbl_list to get at these names.
for (Pname nn=memtbl->get_mem(i=1); nn; nn=memtbl->get_mem(++i)) {
do { if (nn->base==NAME
&& nn->n_union==0
&& nn->tp->base!=FCT
&& nn->tp->base!=OVERLOAD
&& nn->tp->base!=CLASS
&& nn->tp->base!=ENUM
&& nn->n_stclass != STATIC) {
// if (nn->tp->base==FIELD && Pbase(nn->tp)->b_bits==0) continue;
Pexpr i = nn->n_initializer;
nn->n_initializer = 0;
nn->dcl_print(0);
nn->n_initializer = i;
}
} while ((nn->base == NAME) &&
((nn->tp->base!=CLASS) || (nn->tp->base!=ENUM)) &&
(nn = nn->n_tbl_list)) ;
}
for (l=baselist; l; l=l->next)
if (l->base==VIRTUAL && l->ptr_offset) {
Pclass bcl = l->bclass;
char* str = 0;
char *cs = bcl->nested_sig?bcl->nested_sig:bcl->string;
if (bcl->lex_level &&
bcl->nested_sig==0)
str=make_local_name(bcl);
puttok(STRUCT);
putst(str?str:cs);
putch('*');
putcat('P',bcl->string); // leave unencoded
puttok(SM);
delete str;
}
}
// void classdef::print_vtbl(Pvirt vtab)
// {
// error('d',"%s->print_vtbl(%s) vtbl_opt %d",string,vtab->string,vtbl_opt);
// error('d',"print_vtbl: lex_level: %d", lex_level );
//
// switch (vtbl_opt) {
// case -1:
// case 1:
// vlist = new vl(this,vtab,vlist);
// }
//
// int oo = vtbl_opt; // make `simulated static' name
// vtbl_opt = -1;
// char* str = lex_level ? make_local_name(this) : 0;
// char* s = vtbl_name(vtab->string,str?str:string);
// vtbl_opt = oo;
// fprintf(out_file,"extern struct __mptr %s[];\n",s);
// s[2] = 'p'; // pointer, not tbl itself
// fprintf(out_file,"extern struct __mptr* %s;\n",s);
//
// delete s;
// delete str;
// }
vl* vlist;
void really_really_print(Pclass cl, Pvirt vtab, char* s, char* ss);
int p2(Pname nn, Ptype t, Pclass cl, Pvirt vtab, char* s)
{
int init;
if (t->base == FCT) {
Pfct f = Pfct(t);
//error('d',"p2 %n init %d inline %d virtual %d",nn,nn->n_initializer,f->f_inline,f->f_virtual);
//error('d',"p2 %s expr %d imeasure %d body %d",s,f->f_expr,f->f_imeasure,f->body);
//error('d',"sto %k",nn->n_sto);
if (nn->n_initializer
|| nn->n_sto==STATIC
|| f->f_inline
|| f->f_imeasure
|| f->f_virtual==0) return 0;
init = f->body!=0;
}
else
init = nn->n_initializer!=0;
int oo = vtbl_opt;
vtbl_opt = 1; // make sure the name is universal
char *cs = cl->nested_sig?cl->nested_sig:cl->string;
char* sstr = (cl->lex_level&&cl->nested_sig==0)? make_local_name(cl) : 0;
char* ss = vtbl_name(vtab->string,sstr?sstr:cs);
if (init) { // unique definition here
really_really_print(cl,vtab,ss,s);
}
else { // unique definition elsewhere
char *vstr = 0;
if ( vtab && vtab->string ) {
vstr = new char[strlen(vtab->string)+cl->strlen+1];
strcpy( vstr, vtab->string );
strcat( vstr, cl->string );
}
Pname nn;
if (nn=ptbl->look(vstr?vstr:cl->string,0)) { // use of ptbl in file
fprintf(out_file,"extern struct __mptr %s[];\n",ss);
s[2] = 'p';
// fprintf(out_file,"struct __mptr* %s = ",s);
// fprintf(out_file,"%s;\n",ss);
ptbl_add_pair(s, ss);
nn->n_key=HIDDEN;
}
delete vstr;
}
vtbl_opt = oo;
delete ss;
delete sstr;
return 1;
}
void classdef::really_print(Pvirt vtab)
{
// error('d',"really_print %t %d",this,vtbl_opt);
int oo = vtbl_opt; // make `simulated static' name
vtbl_opt = -1;
char *cs = nested_sig?nested_sig:string;
char* str = (lex_level&&nested_sig==0) ? make_local_name(this) : 0;
char* s = vtbl_name(vtab->string,str?str:cs);
// error('d', "really_print: %s, vtab: %s, s: %s", string, vtab->string, s );
vtbl_opt = oo;
// see if needed
int i;
for (Pname nn=memtbl->get_mem(i=1); nn; nn=memtbl->get_mem(++i) ) {
Ptype t = nn->tp;
zse:
if (t)
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto zse;
/*
case COBJ:
if (nn->n_sto == EXTERN)
{ Pclass cl = Pclass(Pbase(t)->b_name->tp);
if (cl->has_ctor()) {
p2(nn,t,this,vtab,s);
return;
}
}
break;
*/
case FCT:
if (p2(nn,t,this,vtab,s))
goto xyzzy;
break;
case OVERLOAD:
{ for (Plist gl=Pgen(t)->fct_list; gl; gl=gl->l)
if (p2(gl->f,gl->f->tp,this,vtab,s))
goto xyzzy;
}
}
}
{ // must be initialized var in block to permit goto
char* ss = vtbl_name(vtab->string,str?str:cs);
// error('d', "really_print: %s, vtab: %s, ss: %s", cs, vtab->string, s );
if (vtbl_opt)
really_really_print(this,vtab,ss,s);
else {
char *vstr = 0;
if ( vtab && vtab->string ) {
vstr = new char[::strlen(vtab->string)+strlen+1];
strcpy( vstr, vtab->string );
strcat( vstr, string );
}
Pname nn;
if (nn=ptbl->look(vstr?vstr:string,0)) { // use of ptbl in file
fprintf(out_file,"extern struct __mptr %s[];\n",ss);
s[2] = 'p';
// fprintf(out_file,"struct __mptr* %s = ",s);
// fprintf(out_file,"%s;\n",ss);
ptbl_add_pair(s, ss);
nn->n_key=HIDDEN;
}
delete vstr;
}
delete ss;
}
xyzzy:
delete s;
delete str;
}
void really_really_print(Pclass cl, Pvirt vtab, char* s, char* ss)
{
// error('d',"really %s %s",s, ss);
// make sure function is declared before using
// it in vtbl initializer
Pname nn;
int i;
for (i=0; nn = vtab->virt_init[i].n; i++) {
Pfct f = Pfct(nn->tp);
if (nn->n_initializer) { // pure virtual
static pv;
if (pv == 0) { // VCVC void->char assumed
fprintf(out_file,"char __pure_virtual_called();\n");
pv = 1;
}
continue;
}
if (f->base != FCT) error('i',"vtbl %n",nn);
//extern void expand_dtor(Pclass cl);
// if (f->f_inline == IDTOR) expand_dtor(f->memof);
if (nn->n_dcl_printed==0 /*|| f->f_inline*/) {
if (f->f_inline && vtbl_opt) puttok(STATIC);
if (f->f_result == 0) make_res(f);
Ptype r = f->s_returns ? f->s_returns : f->returns;
r->print();
nn->print();
putstring("()");
puttok(SM);
nn->n_dcl_printed = 1;
}
}
// if (vtbl_opt == -1) puttok(STATIC);
fprintf(out_file,"struct __mptr %s[] = {0,0,0,\n",s);
Pname n;
for (i=0; n=vtab->virt_init[i].n; i++) {
if (n->n_initializer)
putstring("0,0,(__vptp)__pure_virtual_called,\n");
else {
fprintf(out_file,"%d,0,(__vptp)",-vtab->virt_init[i].offset);
n->print();
n->n_addr_taken = 1;
putstring(",\n");
}
}
putstring("0,0,0};\n");
ss[2] = 'p';
// fprintf(out_file,"struct __mptr* %s = ",ss);
s[2] = 'v';
// fprintf(out_file,"%s;\n",s);
ptbl_add_pair(ss,s);
Pname nm;
char *cstr = 0;
char *vstr = 0;
char *cs = cl->nested_sig?cl->nested_sig:cl->string;
if (cl->lex_level && cl->nested_sig==0) cstr = make_local_name( cl );
if ( vtab && vtab->string ) {
vstr = new char[strlen(vtab->string)+(cstr?strlen(cstr):strlen(cs))+1];
strcpy( vstr, vtab->string );
strcat( vstr, cstr?cstr:cs );
}
if ( vstr == 0 ) vstr = cstr;
if ( nm = ptbl->look(vstr?vstr:cl->string,0) )
nm->n_key = HIDDEN;
else
if ( ptbl->look(vstr?vstr:cl->string,HIDDEN) == 0 )
ptbl->insert(new name(vstr?vstr:cl->string),HIDDEN);
if (cstr == vstr) delete cstr;
else {
delete cstr;
delete vstr;
}
//error('d',"really-> %s",s);
}
#include <ctype.h>
char* vtbl_name(char* s1, char* s2)
{
char* s3 = (vtbl_opt == -1 && *src_file_name) ? src_file_name : 0;
// if vtbl_opt == -1 fake a static (there are no portable
// way of doing a forward declaration of a static in C)
int ll = s1 ? strlen(s1) : 0;
int ll2 = strlen(s2);
int ll3 = s3 ? strlen(s3) : 0;
int sz = (ll+ll2+ll3+20)/32+1; // avoid fragmentation
sz *= 32;
// error('d',"vtbl_name(%s,%s,%s) %d",s1?s1:"",s2,s3?s3:"",sz);
char* buf = new char[sz];
if (s3) {
if (s1)
sprintf(buf,"__vtbl__%d%s__%d%s__%s",ll,s1,ll2,s2,s3);
else
sprintf(buf,"__vtbl__%d%s__%s",ll2,s2,s3);
}
else if (s1)
sprintf(buf,"__vtbl__%d%s__%d%s",ll,s1,ll2,s2);
else
sprintf(buf,"__vtbl__%d%s",ll2,s2);
if (vtbl_opt == -1) {
for (char* p = buf+ll2+11; *p; p++)
if (!isalpha(*p) && !isdigit(*p)) *p = '_';
}
#ifdef DENSE
chop(buf);
#endif
return buf;
}
void classdef::print_all_vtbls(Pclass bcl)
{
//error('d',"%t->print_all_vtbls(%t) vlt %d bl %d",this,bcl,virt_list,baselist);
for (Pvirt blist = bcl->virt_list; blist; blist = blist->next) {
if (this != blist->vclass) continue;
if (blist->printed) continue;
// if (blist->string==0 && find_vptr(this)==0) { //BSopt
// continue;
// }
// print_vtbl(blist);
vlist = new vl(this,blist,vlist);
blist->printed = 1;
}
for (Pbcl b = bcl->baselist; b; b = b->next)
print_all_vtbls(b->bclass);
if (this==bcl) c_body = 0;
}
extern Pclass current_instantiation;
void classdef::dcl_print(Pname)
{
//error('d',"%t->classdef::dcl_print() -- c_body==%d defined==0%o",this,c_body,defined);
defined |= REF_SEEN;
// ensure template instantiations are printed exactly once.
if (class_base != vanilla_class && current_instantiation != this) return;
if (c_body==0 || c_body==3 || (defined&DEFINED)==0) return;
c_body = 3;
int i;
for (Pname nn=memtbl->get_mem(i=1); nn; nn=memtbl->get_mem(++i) ) {
if (nn->base==NAME
&& nn->n_union==0
&& nn->tp->base==CLASS
&& Pclass(nn->tp)->c_body==1)
Pclass(nn->tp)->dcl_print(nn);
else if (nn->base == TNAME && Pbase(nn->tp)->base != COBJ)
nn->dcl_print(0);
else if (nn->tp && nn->tp->base == ENUM) {
if(nn->n_union==0) Penum(nn->tp)->dcl_print(nn);
}
}
TOK lvl = in_class ? NESTED : lex_level ? LOCAL : 0;
Pname n = ktbl->look(string,lvl);
if (n==0) n = ktbl->look(string,HIDDEN);
if (n) {
if (n->where.line!=last_line.line
|| n->where.file!=last_line.file)
if (last_ll = n->where.line)
n->where.putline();
else
last_line.putline();
}
TOK c = csu==CLASS ? STRUCT : csu;
puttok(c);
// if (string[0]!='_' || string[1]!='_' || string[2]!='C')
char *str = 0;
if ( lex_level && nested_sig == 0) str = make_local_name( this );
if ( nested_sig ) putstring( " __" );
putst(str?str:(nested_sig?nested_sig:string));
int sm = 0;
int sz = tsizeof();
int dvirt = 0;
if ( nested_sig )
fprintf(out_file,"{\t/* sizeof __%s == %d */\n",nested_sig,obj_size);
else
fprintf(out_file,"{\t/* sizeof %s == %d */\n",str?str:string,obj_size);
if ( last_ll ) last_line.line++;
delete str;
print_members();
for (Pbcl b = baselist; b; b = b->next) { // declare virtual classes
if (b->base != VIRTUAL) continue;
Pclass bcl = b->bclass;
dvirt += bcl->virt_count;
//error('d',"%t in %t %d",b->bclass,this,b->allocated);
if (b->allocated==0) continue;
char* str = 0;
if (bcl->lex_level) str = make_local_name(bcl);
puttok(STRUCT); // struct bcl Obcl;
putst(str?str:bcl->string);
putcat('O',bcl->string); // leave unencoded
puttok(SM);
delete str;
}
putstring("};\n");
if ( last_ll ) last_line.line++;
for (nn=memtbl->get_mem(i=1); nn; nn=memtbl->get_mem(++i) ) {
if (nn->base==NAME && nn->n_union==0) {
Ptype t = nn->tp;
switch (t->base) {
case FCT:
case OVERLOAD:
break;
default:
if (nn->n_stclass == STATIC) {
TOK b = nn->n_sto;
//error('d',"print nn %n tp %t b %k eval %d",nn,nn->tp,b,nn->n_evaluated);
/*
Pname cn;
TOK bb = ((cn=nn->tp->is_cl_obj())
&& Pclass(cn->tp)->has_ctor())==0
?0:b; // force explicit initialization
nn->n_sto = (nn->n_evaluated) ? STATIC : bb;
*/
nn->n_sto = (nn->n_evaluated) ? STATIC : b;
nn->dcl_print(0);
nn->n_sto = b;
}
}
}
}
if (vtbl_opt != -1) print_all_vtbls(this); // force declaration
//error('d',"dcl_print -> ");
}
char *
make_local_name( Pclass cl, int ln )
{
char *buf;
if ( cl->in_fct == 0 ) error( 'i', "localC %s missingFN", cl->string );
char *fsig = Pfct(cl->in_fct->tp)->f_signature;
if ( fsig == 0 ) fsig = local_sign( cl->in_fct->tp );
char *fs = cl->in_fct->string;
int class_len=cl->strlen+strlen(fsig)+strlen(fs)+strlen(cl->lcl)+4;
int sz = (class_len+20)/32+1; // from vtbl_name()
if ( Pfct(cl->in_fct->tp)->memof == 0 ) {
sz *= 32;
buf = new char[ sz ];
// error('d', "make_local_name: sz: %d", sz );
if (ln)
sprintf(buf, "__%d%s__%s__%s%s", class_len, cl->string, fs, fsig, cl->lcl);
else
sprintf(buf, "%s__%s__%s%s", cl->string, fs, fsig, cl->lcl);
}
else
{
char *cs = Pclass(Pfct(cl->in_fct->tp)->memof)->string;
int len = Pclass(Pfct(cl->in_fct->tp)->memof)->strlen;
if ( len < 10 )
++class_len;
else
if ( len > 99 )
class_len += 3;
else class_len += 2;
class_len += len;
sz = (class_len+20)/32+1;
sz *= 32;
buf = new char[ sz ];
// error('d', "make_local_name: sz: %d", sz );
if ( ln )
sprintf(buf, "__%d%s__%s__%d%s%s%s",class_len,cl->string,fs,len,cs,fsig,cl->lcl);
else sprintf(buf, "%s__%s__%d%s%s%s",cl->string,fs,len,cs,fsig,cl->lcl);
}
#ifdef DENSE
chop( buf );
#endif
return buf;
}
0707071010112046021004440001630000160000010210070466055415700001500000001262print_self.c /* ident "@(#)ctrans:src/print_self.c 1.2" */
/* print_self_default.C -- bailout versions of print_self and format_self */
/*
$Source: /var/lib/cvsd/repos/research/researchv10no/cmd/cfront/xptcfront/cfront.cpio,v $ $RCSfile: cfront.cpio,v $
$Revision: 1.1.1.1 $ $Date: 2018/04/24 17:21:35 $
$Author: root $ $Locker: $
$State: Exp $
*/
#include "print_self.h"
int ostream_printf (ostream&, const char * ...);
int _Print_self::print_self (ostream& stream) const
{
return ostream_printf (stream, "<%s at 0x%p>",
this->type_name(), (void *) this);
}
int _Print_self::format_self (ostream& stream) const
{
return ostream_printf (stream, "<%s at 0x%p>",
this->type_name(), (void *) this);
}
0707071010112046111004440001630000160000010211170466055421300001500000001261print_self.h /* ident "@(#)ctrans:src/print_self.h 1.2" */
/* print_self.H -- base class for objects that want to support
the 'official' print self for \T in printf. */
/*
$Header: /var/lib/cvsd/repos/research/researchv10no/cmd/cfront/xptcfront/cfront.cpio,v 1.1.1.1 2018/04/24 17:21:35 root Exp $
Copyright (c) 1989 by Object Design, Inc., Burlington, Mass.
All rights reserved.
*/
#ifndef _PRINT_SELF_CLASS
#define _PRINT_SELF_CLASS
#include <iostream.h>
class _Print_self {
public:
virtual char * type_name () const { return "OBJECT"; }
virtual int print_self (ostream&) const; // returns count of characters printed.
virtual int format_self (ostream&) const; // returns count of characters printed.
};
#endif
0707071010112044421004440001630000160000010206300466055407100000700000010531repr.c /*ident "@(#)ctrans:src/repr.c 1.4" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
repr.c:
*****************************************************************************/
#include "cfront.h"
char* oper_name(TOK op)
/*
return the string representation of operator "op"
*/
{
switch (op) {
default: error('i',"oper_name(%k)",op);
case GNEW:
case NEW: return "__nw";
case GDELETE:
case DELETE: return "__dl";
case MUL: return "__ml";
case DIV: return "__dv";
case MOD: return "__md";
case UPLUS:
case PLUS: return "__pl";
case MINUS:
case UMINUS: return "__mi";
case LS: return "__ls";
case RS: return "__rs";
case EQ: return "__eq";
case NE: return "__ne";
case LT: return "__lt";
case GT: return "__gt";
case LE: return "__le";
case GE: return "__ge";
case AND:
case ADDROF: return "__ad";
case OR: return "__or";
case ER: return "__er";
case ANDAND: return "__aa";
case OROR: return "__oo";
case NOT: return "__nt";
case COMPL: return "__co";
case INCR: return "__pp";
case DECR: return "__mm";
case CALL: return "__cl";
case DEREF: return "__vc";
case ASSIGN: return "__as";
case REF: return "__rf";
case ASPLUS: return "__apl";
case ASMINUS: return "__ami";
case ASMUL: return "__amu";
case ASDIV: return "__adv";
case ASMOD: return "__amd";
case ASLS: return "__als";
case ASRS: return "__ars";
case ASAND: return "__aad";
case ASOR: return "__aor";
case ASER: return "__aer";
case CTOR: return "__ct";
case DTOR: return "__dt";
// operator T "__op"<signature of T>
// case SIZEOF: return "sizeof";
case CM: return "__cm";
case REFMUL: return "__rm";
// library functions:
// "_vec_delete"
// "_vec_new"
// "_main"
}
}
#define new_op(ss,v) keys[v]=ss
void otbl_init()
/*
operator representation table
*/
{
new_op("->",REF);
new_op("." ,DOT);
new_op(".* or ->*" ,REFMUL);
new_op("mdot" ,REFMUL);
new_op("!" ,NOT);
new_op("~" ,COMPL);
new_op("++",INCR);
new_op("--",DECR);
new_op("*" ,MUL);
new_op("&" ,AND);
new_op("&" ,ADDROF);
new_op("&" ,G_ADDROF);
new_op("/" ,DIV);
new_op("%" ,MOD);
new_op("+" ,PLUS);
new_op("+" ,UPLUS);
new_op("-" ,MINUS);
new_op("-" ,UMINUS);
new_op("<<",LS);
new_op(">>",RS);
new_op("<" ,LT);
new_op(">" ,GT);
new_op("<=",LE);
new_op(">=",GE);
new_op("==",EQ);
new_op("!=",NE);
new_op("^" ,ER);
new_op("|" ,OR);
new_op("&&",ANDAND);
new_op("||",OROR);
new_op("?:" ,QUEST);
// new_op(":" ,COLON);
new_op("=" ,ASSIGN);
new_op("," ,CM);
new_op("," ,G_CM);
new_op(";" ,SM);
new_op("{" ,LC);
new_op("}" ,RC);
new_op("(" ,LP);
new_op(")" ,RP);
new_op("[" ,LB);
new_op("]" ,RB);
new_op("+=",ASPLUS);
new_op("-=",ASMINUS);
new_op("*=",ASMUL);
new_op("/=",ASDIV);
new_op("%=",ASMOD);
new_op("&=",ASAND);
new_op("|=",ASOR);
new_op("^=",ASER);
new_op(">>=",ASRS);
new_op("<<=",ASLS);
// new_op("sizeof",SIZEOF);
// new_op("new",NEW);
// new_op("delete",DELETE);
new_op("0" ,ZERO);
new_op("[]" ,DEREF);
new_op("expression list", ELIST);
new_op("initializer list", ILIST);
new_op("static initializer", STAT_INIT);
new_op("()", CALL);
new_op("generated function call",G_CALL);
new_op("inline function call",ICALL);
new_op("cast",CAST);
new_op("inline argument",ANAME);
new_op("text",TEXT);
new_op(".*",MEMPTR);
new_op("class type", COBJ);
new_op("enum type", EOBJ);
new_op("union", ANON);
new_op("function",FCT);
new_op("pointer",PTR);
new_op("reference",RPTR);
new_op("array",VEC);
new_op("identifier",ID);
new_op("name",NAME);
new_op("...",ELLIPSIS);
new_op("::",MEM);
new_op("type name",TYPE);
new_op("tname",TNAME);
new_op("{}",BLOCK);
new_op("pair",PAIR);
new_op("declaration",DCL);
new_op("character constant",CCON);
new_op("integer constant",ICON);
new_op("float constant",FCON);
new_op("integer value",IVAL);
new_op("string",STRING);
new_op("label",LABEL);
new_op("'class', 'struct', or 'union'",AGGR);
new_op(" argument",ARG);
new_op(" empty expression",DUMMY);
new_op(" ::new",GNEW);
new_op(" constructor call",VALUE);
new_op(" ::delete",GDELETE);
new_op(ansi_opt?" long double":" double",LDOUBLE);
new_op(" typedef",NESTED); // did not want to introduce new TOKEN
}
0707071010112044431004440001630000160000010206400466055407500001000000067265simpl.c /*ident "@(#)ctrans:src/simpl.c 1.3" */
/******************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
simpl.c:
simplify the typechecked function
remove: classes:
class fct-calls
operators
value constructors and destructors
new and delete operators (replace with function calls)
initializers (turn them into statements)
constant expressions (evaluate them)
inline functions (expand the calls)
enums (make const ints)
unreachable code (delete it)
make implicit coersions explicit
in general you cannot simplify something twice
*******************************************************************/
#include "cfront.h"
Pname new_fct;
Pname del_fct;
Pname vec_new_fct;
Pname vec_del_fct;
Pstmt del_list;
Pstmt break_del_list;
Pstmt continue_del_list;
//bit not_inl; // is the current function an inline?
Pname curr_fct; // current function
Pexpr init_list;
Pexpr one;
Ptype Pfct_type;
Ptype Pvptr_type;
Pbase mptr_type;
Ptype size_t_type;
Pstmt trim_tail(Pstmt tt);
Pname find_vptr(Pclass);
char *get_classname(char*);
char *drop_classname(char*);
loc no_where; // 0,0
int imeasure; // a counter trying to measure the complexity of a function
// body to try to avoid expanding ``monster'' inlines.
static Pclass topclass;
void simpl_init()
{
char* ns = oper_name(NEW);
char* ds = oper_name(DELETE);
size_t_type = Pvoid_type->tsizeof()>uint_type->tsizeof()?ulong_type:uint_type;
Pname nw = new name(ns);
nw->n_oper = NEW;
Pname a = new name;
a->tp = size_t_type;
nw->tp = new fct(Pvoid_type,a,1);
new_fct = nw->dcl(gtbl,EXTERN); // void* operator new(long);
delete nw;
// new_fct->use();
Pname dl = new name(ds);
dl->n_oper = DELETE;
a = new name;
a->tp = Pvoid_type;
dl->tp = new fct(void_type,a,1);
del_fct = dl->dcl(gtbl,EXTERN);
delete dl;
// del_fct->use();
Pname vn = new name("__vec_new");
Pname vd = new name("__vec_delete");
a = new name;
a->tp = Pvoid_type;
Pname al = a;
a = new name;
a->tp = int_type;
a->n_list = al;
al = a;
a = new name;
a->tp = int_type;
a->n_list = al;
al = a;
a = new name;
a->tp = Pvoid_type;
a->n_list = al;
al = a; /* (Pvoid, int, int, Pvoid) */
vec_new_fct = gtbl->insert(vn,0);
delete vn;
vec_new_fct->tp = new fct(Pvoid_type,al,1);
Pfct(vec_new_fct->tp)->f_linkage = linkage_C;
vec_new_fct->n_scope = EXTERN;
PERM(vec_new_fct);
PERM(vec_new_fct->tp);
vec_new_fct->use();
vec_new_fct->dcl_print(0);
a = new name;
a->tp = int_type;
al = a;
a = new name;
a->tp = int_type;
a->n_list = al;
al = a;
a = new name;
a->tp = Pvoid_type;
a->n_list = al;
al = a;
a = new name;
a->tp = int_type;
a->n_list = al;
al = a;
a = new name;
a->tp = int_type;
a->n_list = al;
al = a;
a = new name;
a->tp = Pvoid_type;
a->n_list = al;
al = a; /* (Pvoid, int, int, Pvoid, int, int) */
vec_del_fct = gtbl->insert(vd,0);
delete vd;
vec_del_fct->tp = new fct(void_type,al,1);
Pfct(vec_del_fct->tp)->f_linkage = linkage_C;
vec_del_fct->n_scope = EXTERN;
PERM(vec_del_fct);
PERM(vec_del_fct->tp);
vec_del_fct->use();
vec_del_fct->dcl_print(0);
one = new ival(1);
one->tp = int_type;
PERM(one);
Pfct_type = new fct(int_type,0,1); // int (*)()
Pfct_type = Pfct_type->addrof();
PERM(Pfct_type);
putstring("typedef int (*__vptp)();\n");
putstring("struct __mptr {short d; short i; __vptp f; };\n");
Pname b = new name("__mptr");
b->tp = new classdef(STRUCT);
b->tp->defined = 1;
Pclass(b->tp)->obj_size = 8;
mptr_type = new basetype(COBJ,b);
PERM(mptr_type);
Pvptr_type = mptr_type->addrof();
PERM(Pvptr_type);
}
Ptable scope; /* current scope for simpl() */
Pname expand_fn; /* name of function being expanded or 0 */
Ptable expand_tbl; /* scope for inline function variables */
Pname classdef::has_oper(TOK op)
{
Pexpr n = find_name(oper_name(op),0);
if (n == 0) return 0;
while (n->base==REF || n->base==MDOT) {
Pexpr e = Pexpr(n);
n = Pname(n->mem);
delete e;
}
if (n->tp->base==FCT && Pname(n)->n_dcl_printed==0) Pname(n)->dcl_print(0);
return Pname(n);
}
int is_expr(Pstmt s)
/*
is this statement simple enough to be converted into an expression for
inline expansion?
*/
{
int i = 0;
while (s->base == BLOCK) {
if (s->s == 0) return 1;
s = s->s;
}
for (Pstmt ss = s; ss; ss = ss->s_list) {
//error('d',"ss %k",ss->base);
switch (ss->base) {
case BLOCK:
if (Pblock(ss)->memtbl || is_expr(ss->s)==0) return 0;
case SM:
if (ss->e && ss->e->base==ICALL) {
Pname fn = ss->e->il->fct_name;
Pfct f = Pfct(fn->tp);
if (f->f_expr == 0) return 0;
}
break;
case IF:
if (is_expr(ss->s)==0) return 0;
if (ss->else_stmt && is_expr(ss->else_stmt)==0) return 0;
break;
default:
return 0;
}
i++;
}
return i;
}
int no_of_returns;
void name::simpl()
{
//error('d',"name::simpl%n %d %k",this,tp->base,tp->base);
if (base == PUBLIC) return;
if (tp == 0) error('i',"%n->N::simple(tp==0)",this);
switch (tp->base) {
case 0:
error('i',"%n->N::simpl(tp->B==0)",this);
case TYPE:
case VEC:
case PTR:
{
Ptype t = tp;
xx:
switch (t->base) {
case TYPE: t = Pbase(t)->b_name->tp; goto xx;
case VEC: t = Pvec(t)->typ; goto xx;
case PTR: t = Pptr(t)->typ; goto xx;
case FCT: break;
}
break;
}
case OVERLOAD:
{ for (Plist gl = Pgen(tp)->fct_list; gl; gl=gl->l) gl->f->simpl();
break;
}
case FCT:
{ Pfct f = Pfct(tp);
Pname n;
Pname th = f->f_this;
if (th) {
// Make "this" a register if it is used more than twice:
if (th->n_addr_taken) error("&this");
th->n_stclass = (2 < th->n_used) ? REGISTER : AUTO;
if (warning_opt
&& th->n_assigned_to
&& th->n_assigned_to!=FUDGE111)
error('w',&where,"assignment to this (anachronism)");
}
if (tp->defined & (SIMPLIFIED | ~DEFINED) ) return;
for (n=f->f_args; n; n=n->n_list) n->simpl();
if (f->body) {
Ptable oscope = scope;
Pname ocurr = curr_fct;
int oim = imeasure;
scope = f->body->memtbl;
//error('d',"body");
if (scope == 0) error('i',"%n memtbl missing",this);
curr_fct = this;
f->simpl();
if (f->f_inline==0 || debug_opt)
f->f_imeasure = 0; // not a converted inline
else {
if (warning_opt && f->f_virtual)
error('w',"virtual function %n cannot be inlined",this);
// first check if the function is too large to
// be worth inlining
if (12<f->f_imeasure) { // cut-over point:
// about 12 assignments
// f->f_imeasure indicates
if (warning_opt) {
error('w',"%n too large for inlining",this);
}
f->f_inline = 0;// a converted inline
//error('d',"don't inline%n %d %d %d",this,this,f,f->f_imeasure);
scope = oscope;
tp->defined |= SIMPLIFIED;
return;
}
int i = 0;
for (n=f->f_args; n; n=n->n_list) {
n->base = ANAME;
n->n_val = i++;
// ?? if (n->n_table != scope) error('i',"aname scope: %d %n %d %d\n",n,n,n->n_table,scope);
}
expand_tbl = (f->returns->base!=VOID || n_oper==CTOR) ? scope : 0;
expand_fn = this;
if (expand_tbl) {
genlab:
// value returning: generate expr
// the body still holds the memtbl
Pexpr ee = Pexpr(f->body->expand());
Ptype t = 0;
if (f->s_returns) {
if (ee->tp!=f->s_returns) t = f->s_returns;
}
else if (ee->tp!=f->returns)
t = f->returns;
// VCVC assumes VOID is output as CHAR:
if (t && t==void_type)
ee = new expr(CM,ee,new cast(char_type,zero));
f->f_expr = (ee->base==CM) ? ee : new expr(CM,zero,ee);
// print.c assumes expansion into comma expression
}
else {
if (is_expr(f->body)) {
// can generate expr: do
expand_tbl = scope;
goto genlab;
}
// not value return: can generate block
f->f_expr = 0;
f->body = Pblock(f->body->expand());
}
expand_fn = 0;
expand_tbl = 0;
}
scope = oscope;
curr_fct = ocurr;
imeasure = oim;
}
break;
}
case CLASS:
Pclass(tp)->simpl();
}
// if (n_initializer) n_initializer->simpl();
if (n_key != NESTED && n_initializer) n_initializer->simpl();
tp->defined |= SIMPLIFIED;
}
Pexpr call_ctor(Ptable tbl, Pexpr p, Pexpr ctor, Pexpr args, int d, Pexpr vb_args)
{
Pexpr ee = new ref(d,p,ctor);
if (p==0 || tbl==0) ee->tp = ctor->tp;
//error('d',"call_ctor(tbl %d, p %d, %n, args %d)",tbl,p,ctor,args);
if (args && args->base!=ELIST) args = new expr(ELIST,args,0);
ee = new expr(G_CALL,ee,args);
Pname n = Pname(ctor);
while (n->base == MDOT) n = Pname(n->mem);
if (n->tp->base == FCT) ee->fct_name = n;
if (tbl)
ee = ee->typ(tbl);
else if (n->tp->base == FCT)
ee->tp = Pfct(n->tp)->s_returns;
if (ee->tp == any_type) return ee;
args = ee->e2;
if (vb_args == 0) { // attach zero vbase arguments
Pfct f = Pfct(ee->fct_name->tp); // not n->fct_name
for (Pname nn = f->f_args->n_list; nn && nn!=f->argtype; nn=nn->n_list)
args = new expr(ELIST,zero,args);
}
else { // attach vbase arguments
if (args) {
for (Pexpr d = vb_args; d->e2; d=d->e2);
d->e2 = args;
}
args = vb_args;
}
ee->e2 = args;
return ee;
}
Pexpr call_dtor(Pexpr p, Pexpr dtor, Pexpr arg, int d, Pexpr vb_args)
{
// error('d',"call dtor %k %n %t vb_args %d",d,dtor,dtor->tp,vb_args);
Pexpr r = new ref(d,p,dtor);
if (arg && vb_args)
arg = new ival(3);
else if (vb_args)
arg = new ival(2);
else if (arg==0)
arg = zero;
if (arg->tp == 0) arg->tp = int_type;
Pexpr aa = new expr(ELIST,arg,0); // argument controlling deallocation
// 2: destroy vbases
// 1: dealllocate, 0: don't
Pfct f = Pfct(dtor->tp); // attach virtual base arguments
// for (Pname nn = f->f_args->n_list; nn && nn->n_list; nn=nn->n_list) {
// Pexpr xx = vb_args ? new cast(nn->tp,one) : zero;
// aa = new expr(ELIST,xx,aa);
// }
Pexpr ee = new call(r,aa);
while (dtor->base == MDOT) dtor = dtor->mem;
if (d == REF) // could be virtual
ee->fct_name = Pname(dtor);
else { // virtual suppressed, store fct name
r->n_initializer = dtor;
ee->fct_name = 0;
}
ee->base = G_CALL;
ee->tp = void_type;
if (f->memof->c_body == 1) f->memof->dcl_print(0);
if (Pname(dtor)->n_dcl_printed==0) Pname(dtor)->dcl_print(0);
return ee;
}
//extern int new_used; // pre-define new and delete only if the user didn't
Pstmt fct::dtor_simpl(Pclass cl, Pexpr th)
{
Pstmt dtail = 0;
//error('d',"simpl_dtor(%t) a %d",cl,f_args);
// if (new_used == 0) new_init();
Pname fa = new name("__free"); // fake argument for dtor
fa->tp = int_type;
Pname free_arg = fa->dcl(body->memtbl,ARG);
free_arg->where = no_where;
delete fa;
Pname a = f_args;
if (a==0 || a->n_list==0) error('i',"__freeA missing in destructor for %t",cl);
Pname p = 0;
for(;;p=a,a=a->n_list) { // replace nameless fake argument
//error('d',"a %d %t",a,a->tp);
if (a->n_list == 0) {
// a->n_list = free_arg;
DEL(p->n_list);
p->n_list = free_arg;
break;
}
}
// generate calls to destructors for all members of class cl:
Ptable tbl = cl->memtbl;
int i = 1;
for (Pname m=tbl->get_mem(i); m; m=tbl->get_mem(++i) ) {
if (m->n_stclass == STATIC || m->base == PUBLIC) continue;
Ptype t = m->tp;
Pexpr ee = 0;
Pname cn;
Pname dtor;
if (cn = t->is_cl_obj()) {
Pclass cl = (Pclass)cn->tp;
if (dtor = cl->has_dtor()) { // dtor(this,0,ones);
ee = new ref(REF,th,m);
ee->tp = m->tp;
ee = call_dtor(ee,dtor,0,DOT,one);
check_visibility(dtor,0,Pclass(dtor->n_table->t_name->tp),tbl,curr_fct);
}
}
else if (cl_obj_vec) {
Pclass cl = Pclass(cl_obj_vec->tp);
if (dtor = cl->has_dtor()) {
Pfct f = Pfct(dtor->tp);
int i = 0;
for (Pname nn = f->f_args->n_list; nn && nn->n_list; nn=nn->n_list) i++;
//error('d',"dtor %n i %d",dtor,i);
ee = new ref(REF,th,m);
ee->tp = m->tp;
ee = cdvec(vec_del_fct,ee,cl,dtor,0,new ival(i));
check_visibility(dtor,0,Pclass(dtor->n_table->t_name->tp),tbl,curr_fct);
}
}
if (ee) {
Pstmt es = new estmt(SM,curloc,ee,0);
// reverse order of destructors for members
es->s_list = del_list;
del_list = es;
if (dtail == 0) dtail = es;
}
}
Pexpr ee = 0;
// look for bases with destructors:
// generate: dtor(base,0);
Pbcl b = 0; // get dtors in order with virtual bases last
Pbcl t = 0;
for (Pbcl l = cl->baselist; l; l=l->next) {
if (l->base != VIRTUAL) {
Pbcl x = new basecl(l->bclass,0);
if (t == 0)
b = x;
else
t->next = x;
t = x;
x->base = l->base;
x->obj_offset = l->obj_offset;
}
}
for (l = cl->baselist; l; l=l->next) {
if (l->base == VIRTUAL) {
b = new basecl(l->bclass,b);
b->base = l->base;
b->obj_offset = l->obj_offset;
}
}
Pexpr ve = 0;
for (; b; b=l) {
Pclass bcl = b->bclass;
l = b->next;
Pname dtor = bcl->has_dtor();
if (dtor) {
Pexpr val = rptr(bcl->this_type,th,b->obj_offset);
val = val->contents();
Pexpr e = call_dtor(val,dtor);
if (b->base == VIRTUAL) {
// if (x) this->x.dtor(); where x is a vbase
for (Pname dd = f_this->n_list; dd!=argtype; dd=dd->n_list)
if (strcmp(dd->string,bcl->string)==0) break;
if (ansi_opt) { // q?void:int would be an error
e = new expr(G_CM,e,zero);
e->tp = zero_type;
}
e = new expr(QUEST,e,zero);
Pexpr two = new ival(2);
two->tp = int_type;
e->cond = new expr (AND,free_arg,two);//dd;
}
ee = ee ? new expr(CM,e,ee) : e;
}
delete b;
}
Pstmt es = ee ? new estmt(SM,curloc,ee,0) : 0;
ee = new expr(ELIST,th,0); // free storage
Pname n = new name(oper_name(DELETE));
Pexpr del = find_name(n,cl,scope,CALL,curr_fct);
if (del->tp->base==OVERLOAD || Pfct(del->tp)->nargs==2) {
Pexpr ss = new texpr(SIZEOF,cl,0);
ss->tp = uint_type;
ee->e2 = new expr(ELIST,ss,0);
}
ee = new call(del,ee);
ee->tp = ee->call_fct(scope);
Pstmt ess = new estmt(SM,curloc,ee,0);
ess = new ifstmt(curloc,new expr(AND,free_arg,one),ess,0);
if (es)
es->s_list = ess;
else
es = ess;
free_arg->use();
Pname(th)->use();
if (dtail)
dtail->s_list = es;
else
del_list = es;
del_list = new ifstmt(curloc,th,del_list,0);
if (del_list) del_list->simpl();
return dtail;
}
Pclass find_vbase_ptr(Pclass cl, Pclass vbase)
{
for (Pbcl bb = cl->baselist; bb; bb = bb->next) {
if (bb->base==VIRTUAL) {
if (bb->bclass==vbase && bb->ptr_offset) return cl;
}
else {
Pclass f = find_vbase_ptr(bb->bclass,vbase);
if (f) return f;
}
}
return 0;
}
Pclass second_base(Pclass cl, Pclass base)
{
//error('d',"second_base(%t,%t)",cl,base);
for (Pbcl b = cl->baselist; b && b->base==NAME; b = b->next) {
if (b->bclass==base) {
if (b==cl->baselist) return 0;
return base;
}
Pclass bb = second_base(b->bclass,base);
if (bb == Pclass(-1)) continue; // not found
if (bb) {
if (b!=cl->baselist) error('s',"C hierarchy too complicated");
return bb; // second base of b->bclass
}
if (b==cl->baselist) return 0;
return b->bclass; // b->bclass is second base
}
return Pclass(-1);
}
//Pclass topclass;
Pexpr classdef::get_vptr_exp(char *s)
{
//error('d',"%t::get_vptr_exp(%s)",this,s?s:"0");
if (c_body == 1) dcl_print(0);
if (c_body == 3) print_all_vtbls(this);
if (s == 0) return find_vptr(this);
Pbcl b = get_base(get_classname(s));
Pexpr vp = b->bclass->get_vptr_exp(drop_classname(s));
if (b==baselist && b->base!=VIRTUAL) return vp;
vp = new mdot(b->bclass->string,vp);
if (c_body == 1) b->bclass->dcl_print(0);
if (c_body == 3) b->bclass->print_all_vtbls(b->bclass);
if (b->base == VIRTUAL) {
vp->i1 = 1;
if (b->ptr_offset == 0) { // pointer to base in intermediate base
Pclass bb = find_vbase_ptr(this,b->bclass);
Pclass sb = second_base(topclass,bb);
//error('d',"mdot %t %t : %d %t ",topclass,bb,sb,sb==Pclass(-1)?0:sb);
if (sb && sb!=Pclass(-1)) vp = new mdot(sb->string,vp);
}
}
return vp;
}
int fct::ctor_simpl(Pclass cl, Pexpr th)
{
Ptable tbl = cl->memtbl;
int ass_count = 0;
init_list = 0;
//error('d',"ctor_simpl %t: %t",cl,this);
/*
initialization order:
(1) virtual base pointers and virtual bases
(they may be used in non-virtual bases)
(2) non-virtual bases
(3) virtual function pointers
(4) members
*/
// initialize virtual base pointers and virtual base objects
for (Pbcl l = cl->baselist; l; l=l->next) {
Pexpr i = l->init;
if (l->base != VIRTUAL) continue;
l->init = 0;
//error('d',"simpl virtual base %t i %d ",l->bclass,i);
// assign virtual OP to virtual base AP
Pclass bc = l->bclass;
Pexpr dp = 0;
// dd = pointer argument for this base;
// non-zero if already initialized
for (Pname dd = f_this->n_list; dd!=argtype; dd=dd->n_list)
if (strcmp(dd->string,bc->string)==0) break;
// initialize virtual base object
//error('d',"bc %t dd %n offset %d init %d",bc,dd,l->obj_offset,l->init);
// => bc_arg = (bc*)((char*)this+offset)
int off = l->obj_offset;
Pexpr val = rptr(bc->this_type,th,off);
dp = new expr(ASSIGN,dd,val);
dd->assign();
// => bc::bc()
if (i) {
switch (i->base) {
case ASSIGN:
case CM:
break;
case CALL:
case G_CALL:
{ Pcall cc = Pcall(i);
Pname bn = cc->fct_name;
ass_count = Pfct(bn->tp)->f_this->n_assigned_to;
cc->simpl();
break;
}
default:
error('i',"badBCIr %k",i->base);
}
dp = new expr(CM,dp,i);
}
// => (bc_arg==0)?dp:bc_arg
for (Pname a = f_args->n_list; a; a = a->n_list)
if (strcmp(bc->string,a->string)==0) {
dp = new expr(QUEST,dp,a);
dp->cond = new expr(EQ,a,zero);
break;
}
// Pname dpp = find_vbase_ptr(bc,cl);
for (Pbcl ll=cl->baselist; ll; ll=ll->next) {
if (ll->bclass==bc && ll->ptr_offset) {
// make sure that the delegate_arg is needed
// here and not just in a base
// this->Pd = (bc_arg==0)?dp:bc_arg
Pexpr dpp = new mdot(bc->string,th);
dpp->i1 = 3;
dp = new expr(ASSIGN,dpp,dp);
//error('d',"dpp %n",dpp);
break;
}
}
// reverse init order
if (dp) init_list = init_list ? new expr(CM,dp,init_list) : dp;
}
// generate: this=base::base(args) (non-virtual bases)
{
for (Pbcl l = cl->baselist; l; l=l->next) {
Pexpr i = l->init;
if (i==0 || l->base==VIRTUAL) continue;
//error('d',"simpl base %t i %d ",l->bclass,i);
l->init = 0;
switch (i->base) {
case ASSIGN:
case CM:
break;
case CALL:
case G_CALL:
{ Pcall cc = Pcall(i);
Pname bn = cc->fct_name;
ass_count = Pfct(bn->tp)->f_this->n_assigned_to;
cc->simpl();
// assign to ``this'' only from only base
if (l==cl->baselist && cl->baselist->next==0) i = new expr(ASSIGN,th,cc);
break;
}
default:
error('i',"badBCIr %k",i->base);
}
init_list = init_list ? new expr(G_CM,init_list,i) : i;
}
}
// initialize the vptrs that are updated by this class
for (Pvirt blist = cl->virt_list; blist; blist = blist->next) {
// if (blist->string==0 && find_vptr(cl)==0) { //opt
//error('d',"!!!vptr init %s in %s",blist->string,cl->string);
// continue;
// }
//error('d',"vptr init %s in %s",blist->string,cl->string);
topclass = cl;
Pexpr vp = cl->get_vptr_exp(blist->string);
char *str = 0;
char *cs = cl->nested_sig?cl->nested_sig:cl->string;
if (cl->lex_level && cl->nested_sig==0) str = make_local_name( cl );
Pexpr vtbl = new text_expr(blist->string,str?str:cs);
//Pexpr vtbl = new text_expr(blist->string,cl->string);
// vtbl = new cast(Pvptr_type,vtbl);
Pexpr ee = new ref(REF,th,vp);
ee->tp = vp->tp;
ee = new expr(ASSIGN,ee,vtbl);
init_list = init_list ? new expr(CM,init_list,ee) : ee;
}
// initialize members in declaration order:
int i;
for (Pname m=tbl->get_mem(i=1); m; m=tbl->get_mem(++i) ) {
Ptype t = m->tp;
Pname cn;
Pname ctor;
if (t == 0) continue;
switch (t->base) {
case FCT:
case OVERLOAD:
case CLASS:
case ENUM:
continue;
}
switch (m->n_stclass) {
case STATIC:
case ENUM:
continue;
}
if (m->base == PUBLIC) continue;
Pexpr ee = m->n_initializer;
if (ee) m->n_initializer = 0; // from fct must not persist until next fct
//error('d',"simpl m %n ee %d",m,ee);
if (ee) {
// init of non-class mem
// set in fct::mem_init()
}
else if (cn=t->is_cl_obj()) { // try for default
Pclass cl = Pclass(cn->tp);
if (ctor = cl->has_ictor()) {
Pexpr r = new ref(REF,th,m);
ee = call_ctor(tbl,r,ctor,0,DOT);
check_visibility(ctor,0,Pclass(ctor->n_table->t_name->tp),tbl,curr_fct);
}
else if (cl->has_ctor()) {
error("M%n needsIr (no defaultK forC %s)",m,cl->string);
}
}
else if (cl_obj_vec) {
Pclass cl = Pclass(cl_obj_vec->tp);
if (ctor = cl->has_ictor()) { // _new_vec(vec,noe,sz,ctor);
Pexpr mm = new ref(REF,th,m);
mm->tp = m->tp;
ee = cdvec(vec_new_fct,mm,cl,ctor,-1,0);
check_visibility(ctor,0,Pclass(ctor->n_table->t_name->tp),tbl,curr_fct);
}
else if (cl->has_ctor()) {
error("M%n[] needsIr (no defaultK forC %s)",m,cl->string);
}
}
else if (t->is_ref()) {
error("RM%n needsIr",m);
}
else if (t->tconst() && vec_const==0) {
error("constM%n needsIr",m);
}
if (ee) {
ee->simpl();
init_list = init_list ? new expr(CM,init_list,ee) : ee;
}
} // for m
//error('d',"ctor->");
return ass_count;
}
void fct::simpl()
/*
call only for the function definition (body != 0)
simplify argument initializers, and base class initializer, if any
then simplify the body, if any
for constructor:call allocator if this==0 and this not assigned to
(auto and static objects call constructor with this!=0,
the new operator generates calls with this==0)
call base & member constructors
for destructor: call deallocator (no effect if this==0)
case base & member destructors
for arguments and function return values look for class objects
that must be passed by constructor X(X&).
Allocate temporaries for class object expressions, and see if
class object return values can be passed as pointers.
call constructor and destructor for local class variables.
*/
{
Pexpr th = f_this;
Ptable tbl = body->memtbl;
Pstmt ss = 0;
Pstmt tail;
Pclass cl = th ? Pclass(Pbase(Pptr(th->tp)->typ)->b_name->tp) : 0;
Pstmt dtail = 0;
Pname ocurr_fct = curr_fct;
int oret = no_of_returns;
int oim = imeasure;
//error('d',"fct::simpl %n %t",curr_fct,this);
// not_inl = f_inline==0;
del_list = 0;
continue_del_list = 0;
break_del_list = 0;
scope = tbl;
if (scope == 0) error('i',"F::simpl()");
int ass_count = 0;
imeasure = 0;
no_of_returns = 0;
cc->stack();
cc->nof = curr_fct;
cc->ftbl = tbl;
// modification for local classes defined within inline functions
// error( 'd', "simpl local_class: %d", local_class );
for ( Plist l = local_class; l; l = l->l ) {
Pname n = l->f;
Pclass cl = Pclass(Pbase(n->tp)->b_name->tp);
if ( cl->in_fct == 0 ) cl->in_fct = cc->nof;
if ( cl->lcl == 0 ) cl->lcl = make_name( 'L' );
if ( cl->c_body == 1 ) cl->dcl_print(0);
}
Pfct(cc->nof->tp)->local_class = local_class;
local_class = 0;
// error( 'd', "simpl nof: %n %d local_class: %d", cc->nof, cc->nof, Pfct(cc->nof->tp)->local_class );
switch (curr_fct->n_scope) {
case 0:
case PUBLIC:
cc->not = curr_fct->n_table->t_name;
cc->cot = Pclass(cc->not->tp);
cc->tot = cc->cot->this_type;
}
switch (curr_fct->n_oper) {
case DTOR:
dtail = dtor_simpl(cl,th);
break;
case CTOR:
ass_count = ctor_simpl(cl,th);
}
tail = body->simpl();
if (returns->base!=VOID || f_result) { // return must have been seen
if (no_of_returns) { // could be OK
Pstmt tt = (tail->base==RETURN || tail->base==LABEL) ? tail : trim_tail(tail);
switch (tt->base) {
case RETURN:
case GOTO:
del_list = 0; // no need for del_list
break;
case SM:
if (tt->e)
switch (tt->e->base) {
case ICALL:
case G_CALL:
goto chicken;
}
default:
if (warning_opt || strcmp(curr_fct->string,"main"))
error('w',"maybe no value returned from%n",curr_fct);
case IF:
case SWITCH:
case DO:
case WHILE:
case FOR:
case LABEL:
chicken: // don't dare write a warning
break;
}
}
else { // must be an error
// but we don't dare complain about main()
// if (strcmp(curr_fct->string,"main"))
// error(Pfct(curr_fct->tp)->returns->is_cl_obj()?0:'w',"no value returned from%n",curr_fct);
// else if (warning_opt)
// error('w',"no value returned from%n",curr_fct);
if (Pfct(curr_fct->tp)->f_inline
&& Pfct(curr_fct->tp)->returns!=void_type
&& Pfct(curr_fct->tp)->returns->is_cl_obj())
// can cause code generation errors if allowed
error("no value returned from%n",curr_fct);
else if (warning_opt || strcmp(curr_fct->string,"main"))
error('w',"no value returned from%n",curr_fct);
}
if (del_list) goto zaq;
}
else if (del_list) { // return may not have been seen
zaq:
if (tail)
tail->s_list = del_list;
else
body->s = del_list;
tail = dtail;
}
if (curr_fct->n_oper == DTOR) { // body => if (this == 0) body
// reset the vptrs that were set by this class
for (Pvirt blist = cl->virt_list; blist; blist = blist->next) {
//error('d',"vptr init %s in %s",blist->string,cl->string);
topclass = cl;
Pexpr vp = cl->get_vptr_exp(blist->string);
char *str = 0;
char *cs = cl->nested_sig?cl->nested_sig:cl->string;
if (cl->lex_level && cl->nested_sig==0) str = make_local_name(cl);
Pexpr vtbl = new text_expr(blist->string,str?str:cs);
Pexpr ee = new ref(REF,th,vp);
ee->tp = vp->tp;
ee = new expr(ASSIGN,ee,vtbl);
Pstmt es = new estmt(SM,curloc,ee,0);
es->s_list = body->s;
body->s = es;
}
body->s = new ifstmt(body->where,th,body->s,0);
}
if (curr_fct->n_oper == CTOR) {
loc temploc=body->where;
Pstmt tempss=body->s;
while (tempss) {
temploc=tempss->where;
tempss=tempss->s_list;
}
if (Pname(th)->n_assigned_to == 0) {
/* generate:
if (this || (this=_new( sizeof(class cl) ))) {
init_list ;
body;
}
*/
Pname(th)->n_assigned_to = ass_count ? ass_count : FUDGE111;
Pexpr sz = new texpr(SIZEOF,cl,0);
(void) cl->tsizeof();
sz->tp = uint_type;
Pexpr ee = new expr(ELIST,sz,0);
Pname n = new name(oper_name(NEW));
Pexpr p = find_name(n,cl,scope,CALL,curr_fct);
//error('d',"in ctor %n call %n",curr_fct,p);
ee = new call(p,ee);
(void) ee->call_fct(cl->memtbl);
ee->simpl();
ee = new expr(ASSIGN,th,ee);
ee = new expr(OROR,th,ee);
/*ifs->simpl();
do not simplify
or "this = " will cause an extra call of base::base
*/
if (init_list) {
Pstmt es = new estmt(SM,body->where,init_list,0);
es->s_list = body->s;
body->s = es;
// if (tail == 0) tail = es;
}
else if (body->s == 0)
body->s = new estmt(SM,body->where,0,0);
else if(tail->base==RETURN) {
if(body->s == tail) {
delete body->s;
body->s = new estmt(SM,body->where,0,0);
}
else {
Pstmt pr = body->s;
while(pr->s_list != tail)
pr = pr->s_list;
delete pr->s_list;
pr->s_list = 0;
}
}
ifstmt* ifs = new ifstmt(body->where,ee,body->s,0);
body->s = ifs;
// if (tail == 0)
tail = ifs;
}
// generate: body; return this;
Pstmt st = new estmt(RETURN,temploc,th,0);
if (tail)
tail->s_list = st;
else
body->s = st;
tail = st;
}
f_imeasure = imeasure;
curr_fct = ocurr_fct;
no_of_returns = oret;
imeasure = oim;
cc->unstack();
}
void classdef::simpl()
{
int i;
//error('d',"classdef::simpl %s %d",string,defined&SIMPLIFIED);
if (defined&SIMPLIFIED) return;
Pclass oc = in_class;
in_class = this;
for (Pname m=memtbl->get_mem(i=1); m; m=memtbl->get_mem(++i) ) {
Pexpr i = m->n_initializer;
m->n_initializer = 0;
m->simpl();
m->n_initializer = i;
}
in_class = oc;
for (Plist fl=friend_list; fl; fl=fl->l) { // simplify friends
Pname p = fl->f;
switch (p->tp->base) {
case FCT:
case OVERLOAD:
p->simpl();
}
}
defined |= SIMPLIFIED;
}
0707071010112045111004440001630000160000010207100466055410100001100000140465simpl2.c /*ident "@(#)ctrans:src/simpl2.c 1.5" */
/******************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
simpl2.c:
simplify the typechecked function
remove: classes:
class fct-calls
operators
value constructors and destructors
new and delete operators (replace with function calls)
initializers (turn them into statements)
constant expressions (evaluate them)
inline functions (expand the calls)
enums (make const ints)
unreachable code (delete it)
make implicit coersions explicit
in general you cannot simplify something twice
*******************************************************************/
#include "cfront.h"
#include "size.h"
#include <ctype.h>
extern Pname Ntmp;
Pname find_vptr(Pclass);
extern int no_of_returns;
extern Pname new_fct;
//extern Pname del_fct;
extern Pstmt del_list;
extern Pstmt break_del_list;
extern Pstmt continue_del_list;
extern Pname curr_fct; // current function
extern Pexpr init_list;
extern int imeasure;
Pexpr cdvec(Pname f, Pexpr vec, Pclass cl, Pname cd, int tail, Pexpr i, Pexpr vec2)
/*
generate a call to construct or destroy the elements of a vector
*/
{
Pexpr sz = new texpr(SIZEOF,cl,0); // sizeof elem
sz->tp = uint_type;
(void) cl->tsizeof();
Pexpr esz = new texpr(SIZEOF,cl,0); // noe = sizeof(vec)/sizeof(elem)
esz->tp = int_type;
Pexpr noe;
if (vec2) noe = new texpr(SIZEOF,vec2->tp,0);
else noe = new texpr(SIZEOF,vec->tp,0);
// Pexpr noe = new texpr(SIZEOF,vec->tp,0);
noe->tp = int_type;
noe = new expr(DIV,noe,esz);
noe->tp = uint_type;
// error('d',"cdvec tail %d i %d",tail,i);
// Pexpr arg = (0<=tail) ? new expr(ELIST,zero,0) : 0; // 0 or 1 for dtors
Pexpr arg = (i) ? new expr(ELIST,i,0) : 0;
arg = (0<=tail) ? new expr(ELIST,zero,arg) : arg; // 0 or 1 for dtors
arg = new expr(ELIST,cd,arg); // constructor or destructor
cd->lval(ADDROF); // cd->take_addr();
arg = new expr(ELIST,sz,arg);
arg = new expr(ELIST,noe,arg);
arg = new expr(ELIST,vec,arg);
arg = new call(f,arg);
arg->base = G_CALL;
arg->fct_name = f;
return arg;
}
/*
int new_used; // pre-define new and delete only if the user didn't
void new_init()
{
char* ns = oper_name(NEW);
char* ds = oper_name(DELETE);
new_used = 1;
new_fct = gtbl->look(ns,0);
del_fct = gtbl->look(ds,0);
if (new_fct && !del_fct)
error('w',"%n defined but not operator delete()",new_fct);
if (del_fct && !new_fct)
error('w',"%n defined but not operator new()",del_fct);
if (Pfct(new_fct->tp)->body==0) new_fct->dcl_print(0);
if (Pfct(del_fct->tp)->body==0) del_fct->dcl_print(0);
}
*/
Pstmt trim_tail(Pstmt tt)
/*
strip off statements after RETURN etc.
NOT general: used for stripping off spurious destructor calls
*/
{
if (tt == 0) return 0;
while (tt->s_list) {
Pstmt tpx;
switch (tt->base) {
case PAIR:
tpx = trim_tail(tt->s2);
goto tpxl;
case BLOCK:
tpx = trim_tail(tt->s);
tpxl:
if (tpx == 0) return 0;
switch (tpx->base) {
case SM:
break;
case CONTINUE:
case BREAK:
case GOTO:
case RETURN:
if (tt->s_list->base != LABEL) tt->s_list = 0;
default:
return tpx;
}
default:
if (tt = tt->s_list) break;
return 0;
case RETURN:
if (tt->s_list->base != LABEL) tt->s_list = 0;
return tt;
}
}
switch (tt->base) {
case PAIR: return trim_tail(tt->s2);
// case LABEL: return trim_tail(tt->s);
case BLOCK: if (tt->s) return trim_tail(tt->s);
default: return tt;
}
}
extern Ptype Pfct_type;
Pexpr mptr_assign(Pexpr n, Pexpr in)
{
Pexpr i1;
Pexpr i2;
Pexpr i3;
if ( n->base == NAME )
Pname(n)->use();
if (in->base == NAME) {
i1 = new mdot("d",in);
i1->i1 = 9;
i2 = new mdot("i",in);
i2->i1 = 9;
i3 = new mdot("f",in);
i3->i1 = 9;
}
else {
i1 = in->e1->e1;
i2 = in->e1->e2;
i3 = in->e2;
}
Pexpr nd = new mdot("d",n);
nd->i1 = 9;
Pexpr e1 = new expr(ASSIGN,nd,i1);
Pexpr ni = new mdot("i",n);
ni->i1 = 9;
Pexpr e2 = new expr(ASSIGN,ni,i2);
Pexpr nf = new mdot("f",n);
nf->i1 = 9;
// Pexpr ii = in->e2; //new cast(Pfct_type,in->e2);
Pexpr e3 = new expr(ASSIGN,nf,i3);
Pexpr ee = new expr(CM,e2,e3);
return new expr(CM,e1,ee);
}
Pstmt block::simpl()
{
int i;
Pname n;
Pstmt ss=0, sst=0;
Pstmt dd=0, ddt=0;
Pstmt stail;
Ptable old_scope = scope;
DB( if(Sdebug>=1)
error('d',"%d->block::simple() own_tbl %d memtbl %d curr_fct%n",this,own_tbl,memtbl,curr_fct);
);
if (own_tbl == 0) {
ss = (s) ? s->simpl() : 0;
return ss;
}
scope = memtbl;
if (scope->init_stat == 0) scope->init_stat = 1; /* table is simplified. */
for (n=scope->get_mem(i=1); n; n=scope->get_mem(++i)) {
Pstmt st = 0;
Pname cln;
Pexpr in = n->n_initializer;
// error('d',"local %k %n in %k %t",n->n_sto,n,in?in->base:0,in?in->tp:0);
if (in || n->n_evaluated) {
scope->init_stat = 2; /* initializer in this scope */
if (n->n_sto == EXTERN) {
error(&n->where,"Id local extern%n",n);
continue;
}
}
switch (n->n_scope) {
case ARG:
case 0:
case PUBLIC:
continue;
}
if (n->n_stclass == STATIC) { // local static class object
/* initialization of local static objects;
* set up first pass switch
* temp_switch ? 0
* : (stat_obj=init_expr, temp_switch=1);
*
* ARGS: temporary class object in init_expr with dtor
* must call dtor once in std function
*/
if ((in==0 && n->n_scope==ARGS) ||
(in && in->base==STAT_INIT))
{
Pname cn;
Pname x;
Ptype ct;
int vec_seen = 0;
cn = n->tp->is_cl_obj();
if ( cn == 0 ) { ++vec_seen; cn = cl_obj_vec; }
if ( cn ) {
ct = new ptr(PTR,vec_seen?Pvec(n->tp)->typ:n->tp);
x = make_tmp('F', ct, gtbl );
x->n_initializer = zero;
}
else
x = make_tmp('F',int_type,scope);
x->n_sto = n->n_stclass = STATIC;
if (in) {
if (in->e2)
in->base = ASSIGN;
else in = in->e1;
}
Pexpr set;
if ( cn ) {
x->dcl_print(0);
Pclass cl = Pclass(cn->tp);
Pname dtor = cl->has_dtor();
Pexpr cc;
if ( dtor ) {
if ( vec_seen == 0 ) {
Pexpr eee = new expr(DEREF, x, 0 );
Pexpr c = call_dtor(eee,dtor,0,DOT,one);
c->tp = any_type;
cc = new expr( QUEST, c, zero );
cc->cond = x;
}
else cc = cdvec(vec_del_fct,x,cl,dtor,0,zero,n);
cc->tp = any_type; // arghh!
Pstmt dls = new estmt( SM, n->where, cc, 0 );
if ( st_dlist ) dls->s_list = st_dlist;
st_dlist = dls;
}
Pexpr xe;
if (cn) {
if ( vec_seen == 0 )
xe = new expr( G_ADDROF, 0, n );
else {
Pexpr ee = new expr( DEREF, n, zero );
xe = new expr( G_ADDROF, 0, ee );
}
}
set = new expr(ASSIGN,x,xe);
set->tp = ct;
}
else {
set = new expr(ASSIGN,x,one);
set->tp = int_type;
}
// set pointer to static object and continue
// sorry for goto, but beats rewriting code
if ( n->n_scope == ARGS && in == 0 ) {
set = new expr( QUEST, zero, set );
set->cond = x;
st = new estmt(SM,n->where,set,0);
goto init_stat3;
}
in = new expr(G_CM,in,set);
in = new expr(STAT_INIT,zero,in);
in->cond = x;
}
else
continue;
}
if ( in ) {
if ((in->base == ILIST && in->e2 == 0) ||
(in->base == STRING && n->tp->base == VEC))
if (ansi_opt==0) {
error('s',&n->where,"initialization of%n (automatic aggregate)",n);
continue;
}
}
if (n->tp == 0) continue; /* label */
if (n->n_evaluated) continue;
/* construction and destruction of temporaries is handled locally */
{ char* s = n->string;
register char c3 = s[4];
if (s[0]=='_' && s[1]=='_' && s[2]=='D' && isdigit(c3)) continue;
}
if ( cln=n->tp->is_cl_obj() ) {
Pclass cl = Pclass(cln->tp);
Pname d = cl->has_dtor();
if ( n->n_stclass == STATIC // local static class object
&& in && in->base==STAT_INIT )
goto stat_init;
if (d) { // n->cl.dtor(0);
Pexpr dl = call_dtor(n,d,0,DOT,one);
// Pstmt dls = new estmt(SM,n->where,dl,0);
Pstmt dls = new estmt(SM,no_where,dl,0);
if (dd) {
dls->s_list = dd;
dd = dls;
}
else
ddt = dd = dls;
}
// error('d',"%n: in %d",n,in?in->base:0);
if (in) {
switch (in->base) {
case DEREF: // *constructor?
if (in->e1->base == G_CALL) {
Pname fn = in->e1->fct_name;
if (fn==0 || fn->n_oper!=CTOR) goto ddd;
st = new estmt(SM,n->where,in->e1,0);
n->n_initializer = 0;
break;
}
goto ddd;
case STAT_INIT:
stat_init:
// error('d', "block::simpl: case #1 stat_init : n: %n", n );
in->base = QUEST;
st = new estmt(SM,n->where,in,0);
n->n_initializer = 0;
break;
case G_CM:
st = new estmt(SM,n->where,in->e1,0);
n->n_initializer = 0;
break;
case ASSIGN: // assignment to "n"?
if (in->e1 == n) {
st = new estmt(SM,n->where,in,0);
n->n_initializer = 0;
break;
}
default:
goto ddd;
}
}
}
else if (cl_obj_vec) {
Pclass cl = Pclass(cl_obj_vec->tp);
Pname d = cl->has_dtor();
Pname c = cl->has_ictor();
n->n_initializer = 0;
if ( n->n_stclass == STATIC // local static class object
&& in && in->base==STAT_INIT )
goto stat_init2;
if (c) { // _vec_new(vec,noe,sz,ctor);
if (in==0 || in->base==ILIST) {
Pexpr a = cdvec(vec_new_fct,n,cl,c,-1,0);
st = new estmt(SM,n->where,a,0);
}
else
st = new estmt(SM,n->where,in,0);
}
// no default ctor but provided all elements with argument
else if ( in ) st = new estmt(SM,n->where,in,0);
if (d) { // __vec_delete(vec,noe,sz,dtor,0);
Pfct f = Pfct(d->tp);
int i = 0;
for (Pname nn = f->f_args->n_list;
nn && nn->n_list; nn=nn->n_list) i++;
Pexpr a = cdvec(vec_del_fct,n,cl,d,0,new ival(i));
// Pstmt dls = new estmt(SM,n->where,a,0);
Pstmt dls = new estmt(SM,no_where,a,0);
if (dd) {
dls->s_list = dd;
dd = dls;
}
else
ddt = dd = dls;
}
}
else if (in) {
switch (in->base) {
case ILIST:
switch (n->n_scope) {
case FCT:
if (in->e2) { // pointer to member
Pexpr ee = mptr_assign(n,in);
st = new estmt(SM,n->where,ee,0);
n->n_initializer = 0;
break;
}
case ARG:
if (ansi_opt == 0) error('s',"Ir list for localV%n",n);
}
break;
case STAT_INIT:
stat_init2:
// error('d', "block::simpl: case #2 stat_init : n: %n", n );
in->base = QUEST;
st = new estmt(SM,n->where,in,0);
n->n_initializer = 0;
break;
case STRING:
if (n->tp->base==VEC) break; /* BUG char vec only */
default:
ddd:
{ Pexpr ee = new expr(ASSIGN,n,in);
st = new estmt(SM,n->where,ee,0);
n->n_initializer = 0;
}
}
}
init_stat3: if (st) {
if (ss)
sst->s_list = st;
else
ss = st;
sst = st;
}
}
if (dd) {
Pstmt od = del_list;
Pstmt obd = break_del_list;
Pstmt ocd = continue_del_list;
dd->simpl();
del_list = (od) ? Pstmt(new pair(curloc,dd,od)) : dd;
break_del_list = (break_del_list&&obd) ? Pstmt(new pair(curloc,dd,obd)) : dd;
continue_del_list = (continue_del_list&&ocd) ? Pstmt(new pair(curloc,dd,ocd)) : dd;
stail = s ? s->simpl() : 0;
Pfct f = Pfct(curr_fct->tp);
if (this!=f->body
|| f->returns->base==VOID
|| (f->returns->base!=VOID && no_of_returns==0 ) // you have been warned!
|| strcmp(curr_fct->string,"main")==0 ) {
// not dropping through the bottom of a value returning function
if (stail) {
Pstmt tt = (stail->base==RETURN || stail->base==LABEL) ? stail : trim_tail(stail);
if (tt && tt->base != RETURN) stail->s_list = dd;
}
else
s = dd;
stail = ddt;
}
del_list = od;
continue_del_list = ocd;
break_del_list = obd;
}
else
stail = s ? s->simpl() : 0;
if (ss) { /* place constructor calls */
ss->simpl();
sst->s_list = s;
s = ss;
if (stail == 0) stail = sst;
}
scope = old_scope;
return stail;
}
int no_sizeof;
void expr::simpl()
{
DB(if(Sdebug>=2){
error('d',"%d->expr::simpl() %k",this,this?base:0);
if(Sdebug>=3) display_expr(this);
});
if (this==0 || permanent==2) return; // already expanded
static TOK obase = 0;
switch (base) {
case MDOT:
obase = base;
mem->simpl();
obase = 0;
// no break
case ICALL: // already expanded
return;
case G_ADDROF:
case ADDROF:
// error('d',"simpl & %k",e2->base);
e2->simpl();
switch (e2->base) {
case DOT:
case REF:
{ Pref r = Pref(e2);
Pname m = Pname(r->mem);
while (m->base == MDOT) m = Pname(m->mem);
if (m->n_stclass == STATIC) { // & static member
Pexpr x;
delp:
x = e2;
e2 = m;
r->mem = 0;
DEL(x);
}
else if (m->tp->base == FCT) { // & member fct
Pfct f = Pfct(m->tp);
if (f->f_virtual) { // &p->f ==> p->vtbl[fi].f
int index = f->f_virtual;
Pexpr ie = index ? new ival(index):0;
if (ie) ie->tp = int_type;
Pname cn = m->n_table->t_name;
Pname vp = find_vptr(Pclass(cn->tp));
r->mem = vp;
if ( obase == MDOT ) {
base = DEREF;
e1 = e2;
e2 = ie;
}
else { // support old style &b.vf
base = MDOT;
mem = new expr(DEREF,e2,ie);
string2 = "f";
i1 = 9;
}
}
else {
goto delp;
}
}
break;
}
}
break;
case ANDAND:
case OROR:
Ntmp = 0;
// no break
default:
if (e1) e1->simpl();
if (e2) e2->simpl();
break;
case CM:
case G_CM:
{
Pname n = 0;
e1->simpl();
e2->simpl();
if (e1->base==ICALL && e1->e1==0) n = e1->il->fct_name;
if (e2->base==ICALL && e2->e1==0) n = e2->il->fct_name;
if (n) error('s',"cannot expand inline void%n called in commaE",n);
// no break
}
case NAME:
case DUMMY:
case ICON:
case FCON:
case CCON:
case IVAL:
// case FVAL:
// case LVAL:
case STRING:
case ZERO:
case ILIST:
// case MDOT:
return;
/*
case SIZEOF:
base = IVAL;
i1 = tp2->tsizeof();
tp2 = 0; // can't DEL(tp2)
break;
*/
case SIZEOF:
if (e1) e1->simpl();
return;
case G_CALL:
case CALL:
Pcall(this)->simpl();
break;
case NEW:
case GNEW:
simpl_new();
return;
case DELETE:
case GDELETE:
simpl_delete();
break;
case QUEST:
cond->simpl();
Ntmp = 0;
e2->simpl();
// no break
case CAST:
case REF:
e1->simpl();
break;
case DOT:
e1->simpl();
switch (e1->base) {
case CM:
case G_CM:
{ // &( , name). => ( ... , &name)->
Pexpr ex = e1;
cfr:
switch (ex->e2->base) {
case NAME:
base = REF;
ex->e2 = ex->e2->address();
break;
case CM:
case G_CM:
ex = ex->e2;
goto cfr;
}
}
}
break;
case ASSIGN:
{
Pfct f = 0;
Pexpr th = 0;
if ( curr_fct ) {
f = Pfct(curr_fct->tp);
th = f->f_this;
}
imeasure++;
if (e1) e1->simpl();
if (e2) {
Pexpr c = e2;
c->simpl();
while (c->base == CAST) c = c->e1;
if (c->base == ILIST) e2 = c;
if (e2->base == ILIST) { // pointer to member assignment
Pexpr ee = mptr_assign(e1,e2);
Pexpr eee = new expr(CM,ee->e2,e1);
e1 = ee->e1;
e2 = eee;
base = CM;
delete ee;
}
}
if (th && th==e1 && curr_fct->n_oper==CTOR && init_list) {
// this=e2 => (this=e2,init_list)
Pclass cl = Pclass(Pbase(Pptr(th->tp)->typ)->b_name->tp);
if (cl->c_body == 1) cl->dcl_print(0);
imeasure++;
base = CM;
e1 = new expr(ASSIGN,e1,e2);
e2 = init_list;
if (warning_opt) // timid
error('w',"assignment to ``this'' inK: try defining%t::operator new() instead",f->memof);
}
break;
}
}
switch (base) {
case QUEST:
case ANDAND:
case OROR:
if (Ntmp) error('s',"temporary ofC%n with destructor needed in%kE",Ntmp,base);
// no break;
default:
Ntmp = 0;
}
if (tp==int_type || tp==defa_type) {
Neval = 0;
no_sizeof = 1; // do not convert sizeof's to ints
long i = eval();
no_sizeof = 0;
if (Neval == 0) {
base = IVAL;
i1 = i;
}
}
}
Pexpr vptr_entry(Pexpr pp, Pexpr ie, Pclass cl)
{
Pptr ttemp = pp->tp->is_ptr_or_ref();
if (ttemp) {
Ptype pt = ttemp->typ; // check if cast pp = (base*)pp
Pclass pc = Pclass(pt->is_cl_obj()->tp); // is needed
if (pc!=cl) pp = new cast(cl,pp);
}
Pname vp = find_vptr(cl);
if (vp == 0) error('i',"can't find vptr");
Pexpr vptr = new ref(REF,pp,vp); // pp->vptr
return new expr(DEREF,vptr,ie); // pp->vptr[i]
}
Pexpr new_this(Pexpr pp, Pexpr ee)
{
//error('d',"new this");
Pexpr dee = new mdot("d",ee); // pp->vptr[i].d
dee->i1 = 9;
Pexpr nthis = new cast(Pchar_type,pp);
nthis = new expr(PLUS,nthis,dee); // ((char*)pp)+delta
Ptype ct = pp->tp;
if (pp->base==NAME && Pname(pp)->n_xref) ct = pp->tp->addrof();
return new cast(ct,nthis);
}
Pcall vcall(Pexpr pp, Pexpr ie, Pfct f, Pclass cl, Pexpr args)
/*
generate a call of the virtual function with the index ``ie''
and type "f" in class ``cl'' for the object pointed to by ``pp''
multiple inheritance virtual call:
p->f(x) is resolved like this
pp = p; // avoid side effects
pp = p.base_object; // often: pp = p;
// done when the name was resolved
i = index(f);
entry = pp->_vtbl[i-1];
pp = (T*)(((char*)pp)+entry.d)
(*(ftype)entry.f)(pp,x)
*/
{
//error('d',"vcall %t",cl);
if (cl->c_body==1) cl->dcl_print(0); // look for first use of cl
imeasure+=6;
Pexpr ee = vptr_entry(pp,ie,cl);
Pexpr fee = new mdot("f",ee);
fee->i1 = 9;
Ptype pft = f->addrof();
fee = new cast(pft,fee); // (T)pp->vptr[i].f
Pexpr r = new expr(DEREF,fee,0); // *(T)pp->vptr[i].f
// e1->tp must be 0, means "argtype encoded"
r->tp2 = Ptype(f->f_this); // encode argtype
Pexpr nthis = new_this(pp,ee);
args = new expr(ELIST,nthis,args);
args->simpl();
Pcall c = new call(r,args);
c->tp = f->returns;
return c;
}
void call::simpl()
/*
fix member function calls:
p->f(x) becomes f(p,x)
o.f(x) becomes f(&o,x)
or if f is virtual:
p->f(x) is resolved like this
pp = p;
i = index(f);
entry = pp->_vtbl[i-1];
pp = (T*)(((char*)pp)+entry.i)
(*entry.f)(pp,x)
replace calls to inline functions by the expanded code
*/
{
Pname fn = fct_name;
//error('d',"%d call::simpl() fn %n %d e1 %d",this,fn,fn,e1);
Pfct f = fn ? Pfct(fn->tp) : 0;
if (fn == 0) e1->simpl();
if (f) {
switch(f->base) {
case ANY:
return;
case OVERLOAD:
fct_name = fn = Pgen(f)->fct_list->f;
f = Pfct(fn->tp);
}
}
switch (e1->base) {
case MEMPTR: // (p ->* q)(args)
{
Pexpr p = e1->e1;
Pexpr q = e1->e2;
Pclass cl = Pclass(e1->tp2);
Pfct f = Pfct(q->tp->deref());
if (e2) e2->simpl();
if (f->f_this == 0) { // might not know about ``this'' yet
if (f->memof == 0) error('i',"memof missing");
Pname tt = new name("this");
tt->n_scope = ARG;
tt->tp = f->memof->this_type;
PERM(tt);
// f->f_this = f->f_args = tt;
tt->n_list = f->argtype;
// f->f_this = tt;
tt->n_list = f->f_result ? f->f_result : f->argtype;
f->f_this = f->f_args = tt;
}
//error('d',"f_this %d",f->f_this);
extern has_virt(Pclass);
// beware of sideeffects:
nin = 1;
if (q->not_simple()) error('s',"2nd operand of .* too complicated");
nin = 0;
Pexpr qq = new mdot("f",q); // the function: (*(right type)q.f)
qq->i1 = 9;
qq = new cast(f->addrof(),qq);
Pexpr nc = new expr(DEREF,qq,0);
nc->tp2 = Ptype(f->f_this); // encode argtype
Pexpr nthis = new_this(p,q); // arguments: (p+q.d,args)
Pexpr args = new expr(ELIST,nthis,e2);
imeasure+=3;
if (has_virt(cl) == 0) { // no virtuals: simple
if (cl->defined == 0)
error("call throughP toMF before definition ofC %t",cl);
//error('d',"no virt");
// (p ->* q)(args) => (*q.f)(p+q.d,args)
e1 = nc;
e2 = args;
return;
}
if (find_vptr(cl) == 0) { // must be a call to a second base
// that we cannot handle yet
// it is OK not to to generate
// a virtual call since a
// `sorry' will have been generated
// at the point of initialization
e1 = nc;
e2 = args;
return;
}
// beware of sideeffects:
nin = 1;
if (p->not_simple()) error('s',"1st operand of .* too complicated");
nin = 0;
Pexpr c = new mdot("i",q); // condition (q.i<0)
c->i1 = 9;
c = new expr(LT,c,zero);
Pexpr ie = new mdot("i",q);
ie->i1 = 9;
base = QUEST;
e1 = new call(nc,args);
e2 = vcall(p,ie,f,cl,e2);
cond = c;
return;
}
case DOT:
// if e1 is an object and not just a reference
// the vtbl need not be used
case REF:
{ Pref r = Pref(e1);
Pexpr a1 = r->e1;
int obj = r->n_initializer!=0; // if B::f don't use vcall
if (obj == 0) { // don't use vcall if we have an object
// (not a pointer or a reference)
if (e1->base==DOT && a1->base!=DEREF) obj = 1;
}
//error('d',"fct_name %n f %d %d obj %d",fct_name,f,f->f_virtual,obj);
if (f && obj==0 && f->f_virtual) {
Pexpr a11 = 0;
switch(a1->base) { // see if temporary might be needed
case NAME:
case MDOT:
a11 = a1;
break;
case REF:
case DOT:
if (a1->e1->base==NAME
|| ((a1->e1->base==DOT || a1->e1->base==REF) && a1->e1->e1->base==NAME)) a11 = a1;
break;
case ADDROF:
case G_ADDROF:
if (a1->e2->base == NAME
|| ((a1->e2->base==DOT || a1->e2->base==REF) && a1->e2->e1->base==NAME)) a11 = a1;
break;
case CAST:
switch (a1->e1->base) {
case NAME:
case MDOT:
a11 = a1;
}
}
// if( a1->base==REF && fn->n_oper==DTOR ){
// a11 = a1;
// goto zsw;
// }
//
if (e1->base == DOT) {
// zsw:
if (a11) a11 = a11->address();
a1 = a1->address();
}
if (a11 == 0) { // temporary (maybe) needed
// e->f() => (t=e,t->f(t))
if (a1->base==NAME)
a11 = a1; // &*name has become name
else {
Pname nx = new name(make_name('K'));
nx->tp = a1->tp;
Pname n = nx->dcl(scope,ARG); // no init!
delete nx;
Pname cln = a1->tp->is_cl_obj();
if (cln) {
Pclass cl = Pclass(cln->tp);
if (Ntmp==0 && cl->has_dtor()) Ntmp = cln;
if (cl->has_itor()) n->n_xref = 1;
}
n->n_scope = FCT;
n->assign();
a11 = n;
a1 = new expr(ASSIGN,n,a1);
a1->tp = n->tp;
a1->simpl();
Pcall cc = new call(0,0);
*cc = *this;
base = CM;
e1 = a1;
e2 = cc;
this = cc;
}
}
int i = f->f_virtual;
Pexpr ie = i?new ival(i):0; // index
Pname cn = fn->n_table->t_name;
if (fn
&& fn->n_initializer
&& cc->nof
&& cc->nof->n_oper==CTOR
&& Pfct(cc->nof->tp)->memof->c_abstract
&& strcmp(Pfct(cc->nof->tp)->memof->string, cn->string) == 0 ) {
// permit x::x( x& xx ) { xx.pvf(); }
Pexpr ee = e1->e1;
while ( ee && ee->base != NAME ) ee = ee->e1;
if ( ee && strcmp( ee->string, "this" )==0)
error("call of pure virtualF%n inK%n",fn,cc->nof);
}
Pcall vc = vcall(a11,ie,f,Pclass(cn->tp),e2);
*this = *vc;
return;
}
Ptype tt = r->mem->tp;
llp:
//error('d',"llp %t",tt);
switch (tt->base) {
// default: // pointer to function: (n->ptr_mem)(args); do nothing
case TYPE:
tt = Pbase(tt)->b_name->tp;
goto llp;
case OVERLOAD: // n->fctmem(args);
case FCT:
if (fct_name==0) {
// reconstitute fn destroyed to suppress "virtual"
fct_name = fn = Pname(e1->n_initializer);
f = Pfct(fn->tp);
}
if (e1->base == DOT) a1 = a1->address();
e2 = new expr(ELIST,a1,e2);
e1 = r->mem;
}
}
}
if (e2) e2->simpl();
//error('d',"fn %n inl %d imes %d",fn,f->f_inline,f->f_imeasure);
if (fn && f->f_inline && debug_opt==0) {
imeasure += f->f_imeasure;
Pclass cl = f->memof;
if (cl && cl->c_body) cl->dcl_print(0);
Ptable oscope = scope;
Pexpr ee = f->expand(fn,scope,e2);
scope = oscope;
if (ee) *Pexpr(this) = *ee;
}
else if (fn && f->f_inline==0 && f->f_imeasure) {
extern void uninline(Pname fn);
uninline(fn);
imeasure += 3;
}
else if (fn && debug_opt && f->f_inline==ITOR) {
extern void expand_itor(Pclass);
expand_itor(f->memof);
}
else
imeasure += 3;
}
void uninline(Pname fn)
// inline turned static
{
Pfct f = Pfct(fn->tp);
//error('d',"uninline %n %d %d",fn,f->body,f->f_expr);
if (warning_opt) {
error('w',"%n too complex for inlining",fn);
error('w',"out-of-line copy of %n created",fn);
}
f->f_imeasure = 0; // now it really is just static
Pstmt s = f->body->s;
// for (s = f->body->s; s; s=s->s_list)
//error('d',"start %d %k",s->e,s->e->base);
// s = f->body->s;
while (s) {
//error('d',"s %k %d %k",s->base,s->e,s->e->base);
if (s->base == SM) {
// turn comma expression into statement list
Pexpr e = s->e;
if (e)
switch (e->base) {
case CM:
case G_CM:
{ Pstmt ss = new estmt(SM,no_where,e->e2,0);
s->e = e->e1;
ss->s_list = s->s_list;
s->s_list = ss;
delete e;
continue;
}
}
}
s = s->s_list;
}
// for (s = f->body->s; s; s=s->s_list)
//error('d',"echo %k %d %k",s->base,s->e,s->e->base);
fn->dcl_print(0);
}
/*
void ccheck(Pexpr e)
Is there a conditional in this expression? (not perfect)
{
//error('d',"ccheck(e %k)",e,e?e->base,0);
if (e)
switch (e->base) {
case QUEST:
case ANDAND:
case OROR:
error('s',"E too complicated: uses%k and needs temporary ofCW destructor",e->base);
break;
case LT:
case LE:
case GT:
case GE:
case EQ:
case NE:
case ASSIGN:
case ASPLUS:
case ASMINUS:
case G_CM:
case CM:
case PLUS:
case MINUS:
case MUL:
case DIV:
case OR:
case ER:
case AND:
case G_CALL:
case CALL:
case ELIST:
case DEREF:
ccheck(e->e1);
case NOT:
case COMPL:
case CAST:
case ADDROF:
case G_ADDROF:
ccheck(e->e2);
break;
case ICALL: // check inlined arguments
{ Pin il = e->il;
for (int i = 0; il->args[i].arg && i<il->i_slots; i++) ccheck(il->args[i].arg);
}
}
}
*/
void temp_in_cond(Pexpr ee, Pstmt ss, Ptable tbl)
/*
insert destructor calls 'ss' into condition 'ee'
ee => (Qnn = ee, dtors, Qnn)
*/
{
//error('d',"temp_in_cond");
// ccheck(ee);
while (ee->base==CM || ee->base==G_CM) ee = ee->e2;
Ptype ct = ee->tp;
Pname n = new name(make_name('Q')); // int Qnn;
n->tp = ct;
Pname tmp = n->dcl(tbl,ARG);
delete n;
tmp->n_scope = FCT;
Pexpr v = new expr(0,0,0);
*v = *ee;
PERM(ct);
v = new cast(ct,v);
tmp->n_assigned_to = 1;
Pexpr c = new expr(ASSIGN,tmp,v); // Qnn = ee
c->tp = ct;
ee->base = CM;
ee->e1 = c;
Pexpr ex = 0; // add dtors at end
for (Pstmt sx = ss; sx; sx = sx->s_list) {
if (ex) {
ex = new expr(CM,ex,sx->e);
ex->tp = sx->e->tp;
}
else
ex = sx->e;
}
ee->e2 = new expr(CM,ex,tmp); // add Qnn at end
ee->e2->tp = ct;
}
bit not_safe(Pexpr e)
{
switch (e->base) {
default:
return 1;
/*
case CALL:
case G_CALL:
case DOT:
case REF:
case ANAME:
return 1;
*/
case NAME:
// if the name is automatic and has a destructor it is not safe
// to destroy it before returning an expression depending on it
{ Pname n = Pname(e);
if (n->n_table!=gtbl && n->n_table->t_name==0) {
Pname cn = n->tp->is_cl_obj();
if (cn && Pclass(cn->tp)->has_dtor()) return 1;
}
}
case IVAL:
case ICON:
case CCON:
case FCON:
case STRING:
return 0;
case NOT:
case COMPL:
case ADDROF:
case G_ADDROF:
return not_safe(e->e2);
case DEREF:
// return not_safe(e->e1) || e->e2?not_safe(e->e2):0;
{ int i = not_safe(e->e1);
if (i) return i;
if (e->e2) return not_safe(e->e2);
return 0;
}
case CM:
case PLUS:
case MINUS:
case MUL:
case DIV:
case MOD:
case ASSIGN:
case ASPLUS:
case ASMINUS:
case ASMUL:
case ASDIV:
case OR:
case AND:
case OROR:
case ANDAND:
case LT:
case LE:
case GT:
case GE:
case EQ:
case NE:
return not_safe(e->e1) || not_safe(e->e2);
case QUEST:
return not_safe(e->cond) || not_safe(e->e1) || not_safe(e->e2);
}
}
Pexpr curr_expr; /* to protect against an inline being expanded twice
in a simple expression keep track of expressions
being simplified
*/
Pstmt stmt::simpl()
/*
return a pointer to the last statement in the list, or 0
*/
{
if (this == 0) error('i',"0->S::simpl()");
DB( if(Sdebug>=1){
error('d',"%d->stmt::simpl(): %k",this,base);
if(Sdebug>=2) display_stmt(this);
});
//Pstmt ostmt = Cstmt;
//if ( where.line ) Cstmt = this;
stmtno++;
curr_expr = e;
//error('d',"stmt::simpl %k s_list %d",base,s_list);
switch (base) {
default:
error('i',"S::simpl(%k)",base);
case ASM:
break;
case BREAK:
if (break_del_list) { // break => { _dtor()s; break; }
Pstmt bs = new stmt(base,where,0);
Pstmt dl = break_del_list->copy();
base = BLOCK;
s = new pair(where,dl,bs);
}
break;
case CONTINUE:
if (continue_del_list) { // continue => { _dtor()s; continue; }
Pstmt bs = new stmt(base,where,0);
Pstmt dl = continue_del_list->copy();
base = BLOCK;
s = new pair(where,dl,bs);
}
break;
case DEFAULT:
s->simpl();
break;
case SM:
if (e) {
if (e->base == DEREF) e = e->e1;
e->simpl();
if (e->base == DEREF) e = e->e1;
}
break;
case RETURN:
{ /* return x;
=>
{ dtor()s; return x; }
OR (returning an X where X(X&) is defined) =>
{ ctor(_result,x); _dtor()s; return; }
OR (where x needs temporaries)
OR (where x might involve an object to be destroyed) =>
{ _result = x; _dtor()s; return _result; }
return; =>
{ _dtor()s; return; }
OR (in constructors) =>
{ _dtor()s; return _this; }
*/
Pstmt sx = this;
Pexpr ex = e;
no_of_returns++;
Pstmt dl = (del_list) ? del_list->copy() : 0;
Pfct f = Pfct(curr_fct->tp);
if (e == 0) e = dummy;
if (e==dummy && curr_fct->n_oper==CTOR) e = f->f_this;
// need to generate a temporary for mptr return
Pexpr tt = e;
while ( tt->base == CAST )
tt = tt->e1;
if ( tt->base == ILIST )
e = tt;
if (e->base == ILIST) {
extern Pbase mptr_type;
extern Ptype Pvptr_type;
Pexpr mptr_assign(Pexpr, Pexpr);
// memptr constant
// return({1,2,f}) ==> memptr t; return((t={1,2,f},&t))
Ptable ftbl = Pfct(curr_fct->tp)->body->memtbl;
Pname temp = make_tmp('A',mptr_type,ftbl);
// placed in mptr_assign()
// temp->use(); // necessary for inlines to force declaration
e = mptr_assign(temp,e);
e = new expr(G_CM,e,temp);
e->tp = mptr_type;
}
if (f->f_result) { // ctor(_result,x); dtors; return;
if (e->base == G_CM) e = replace_temp(e,f->f_result);
e->simpl();
Pstmt cs = new estmt(SM,where,e,0);
if (dl) cs = new pair(where,cs,dl);
base = PAIR;
s = cs;
s2 = new estmt(RETURN,where,0,0);
//#ifdef RETBUG
// s2->empty = 1; // fudge to bypass C bug (see print.c)
// s2->ret_tp = ret_tp;
//#endif
}
else { // dtors; return e;
e->simpl();
if (dl) {
if (e!=dummy && not_safe(e)) {
// { _result = x; _dtor()s; return _result; }
Ptable ftbl = Pfct(curr_fct->tp)->body->memtbl;
Pname r = ftbl->look("_result",0);
if (r == 0) {
r = new name("_result");
r->tp = ret_tp;
Pname rn = r->dcl(ftbl,ARG);
rn->n_scope = FCT;
rn->where = no_where;
rn->assign();
delete r;
r = rn;
}
Pexpr as = new expr(ASSIGN,r,e);
as->tp = ret_tp; // wrong if = overloaded, but then X(X&) ought to have been used
Pstmt cs = new estmt(SM,where,as,0);
cs = new pair(where,cs,dl);
base = PAIR;
s = cs;
s2 = new estmt(RETURN,where,r,0);
// s2->ret_tp = ret_tp;
}
else { // { _dtor()s; return x; }
base = PAIR;
s = dl;
s2 = new estmt(RETURN,where,e,0);
}
s2->ret_tp = ret_tp;
}
}
// if (sx->memtbl) {
// int i;
// for (Pname n=sx->memtbl->get_mem(i=1); n; n=sx->memtbl->get_mem(++i)) {
// Pname cn = n->tp->is_cl_obj();
// if (cn && Pclass(cn->tp)->has_dtor()) {
// ccheck(ex);
// break;
// }
// }
// }
break;
}
case WHILE:
case DO:
e->simpl();
{ Pstmt obl = break_del_list;
Pstmt ocl = continue_del_list;
break_del_list = 0;
continue_del_list = 0;
s->simpl();
break_del_list = obl;
continue_del_list = ocl;
}
break;
case SWITCH:
e->simpl();
{ Pstmt obl = break_del_list;
break_del_list = 0;
s->simpl();
break_del_list = obl;
}
switch (s->base) {
case DEFAULT:
case LABEL:
case CASE:
break;
case BLOCK:
if (s->s)
switch (s->s->base) {
case BREAK: // to cope with #define Case break; case
case CASE:
case LABEL:
case DEFAULT:
break;
default:
goto df;
}
break;
default:
df:
error(&s->where,"S orIdE not reached: (case label missing?)");
}
break;
case CASE:
e->simpl();
s->simpl();
break;
case LABEL:
if (del_list) error('s',"label in blockW destructors");
s->simpl();
break;
case GOTO:
/* If the goto is going to a different (effective) scope,
then it is necessary to activate all relevant destructors
on the way out of nested scopes, and issue errors if there
are any constructors on the way into the target.
Only bother if the goto and label have different effective
scopes. (If mem table of goto == mem table of label, then
they're in the same scope for all practical purposes.
*/
{
Pname n = scope->look( d->string, LABEL );
if (n == 0) error('i',&where,"label%n missing",d);
if(n->n_realscope!=scope && n->n_assigned_to) {
/* Find the root of the smallest subtree containing
the path of the goto. This algorithm is quadratic
only if the goto is to an inner or unrelated scope.
*/
Ptable r = 0;
for(Ptable q=n->n_realscope; q!=gtbl; q=q->next) {
for( Ptable p = scope; p != gtbl; p = p->next ) {
if( p==q ) {
r = p; // found root of subtree!
goto xyzzy;
}
}
}
xyzzy: if( r==0 ) error( 'i',&where,"finding root of subtree" );
/* At this point, r = root of subtree, n->n_realscope
* = mem table of label, and scope = mem table of goto. */
/* Climb the tree from the label mem table to the table
* preceding the root of the subtree, looking for
* initializers and ctors. If the mem table "belongs"
* to an unsimplified block(s), the n_initializer field
* indicates presence of initializer, otherwise initializer
* information is recorded in the init_stat field of
* mem table. */
for( Ptable p=n->n_realscope; p!=r; p=p->next )
if( p->init_stat == 2 ) {
error(&where,"goto%n pastDWIr",d);
goto plugh; /* avoid multiple error msgs */
}
else if( p->init_stat == 0 ) {
int i;
for(Pname nn=p->get_mem(i=1);nn;nn=p->get_mem(++i))
if(nn->n_initializer||nn->n_evaluated){
error(&nn->where,"goto%n pastId%n",d,nn);
goto plugh;
}
}
plugh:
/* Proceed in a similar manner from the point of the goto,
* generating the code to activate dtors before the goto. */
/* There is a bug in this code. If there are class objects
* of the same name and type in (of course) different mem
* tables on the path to the root of the subtree from the
* goto, then the innermost object's dtor will be activated
* more than once. */
{
Pstmt dd = 0, ddt = 0;
for( Ptable p=scope; p!=r; p=p->next ) {
int i;
for(Pname n=p->get_mem(i=1);n;n=p->get_mem(++i)) {
Pname cln;
if (n->tp == 0) continue; /* label */
if ( cln=n->tp->is_cl_obj() ) {
Pclass cl = (Pclass)cln->tp;
Pname d = cl->has_dtor();
if (d) { /* n->cl::~cl(0); */
Pexpr dl = call_dtor(n,d,0,DOT,one);
Pstmt dls = new estmt(SM,n->where,dl,0);
if (dd)
ddt->s_list = dls;
else
dd = dls;
ddt = dls;
}
}
else if (cl_obj_vec) {
Pclass cl = (Pclass)cl_obj_vec->tp;
// Pname c = cl->has_ictor();
Pname d = cl->has_dtor();
if (d) { // __vec_delete(vec,noe,sz,dtor,0);
Pfct f = Pfct(d->tp);
int i = 0;
for (Pname nn = f->f_args->n_list;
nn && nn->n_list; nn=nn->n_list) i++;
Pexpr a = cdvec(vec_del_fct,n,cl,d,0,new ival(i));
Pstmt dls = new estmt(SM,n->where,a,0);
if (dd)
ddt->s_list = dls;
else
dd = dls;
ddt = dls;
}
}
} /* end mem table scan */
} /* end dtor loop */
/* "activate" the list of dtors obtained. */
if( dd ) {
dd->simpl();
Pstmt bs = new stmt( base, where, 0 );
*bs = *this;
base = PAIR;
s = dd;
s2 = bs;
}
}
} /* end special case for non-local goto */
}
break;
case IF:
e->simpl();
s->simpl();
if (else_stmt) else_stmt->simpl();
break;
case FOR: // "for (s;e;e2) s2; => "s; for(;e,e2) s2"
if (for_init) for_init->simpl();
if (e) {
curr_expr = e;
e->simpl();
}
if (e2) {
curr_expr = e2;
e2->simpl();
if (e2->base==ICALL)
if (e2->e1 == 0) error('s',"cannot expand inline void%n called in forE", e2->il->fct_name);
}
{ Pstmt obl = break_del_list;
Pstmt ocl = continue_del_list;
break_del_list = 0;
continue_del_list = 0;
s->simpl();
break_del_list = obl;
continue_del_list = ocl;
}
break;
case BLOCK:
Pblock(this)->simpl();
break;
case PAIR:
break;
}
/*if (s) s->simpl();*/
//error('d',"base %k memtbl %d",base,memtbl);
if (base!=BLOCK && memtbl) {
Pstmt t1 = (s_list) ? s_list->simpl() : 0;
Pstmt tpx = t1 ? t1 : this;
Pstmt ss = 0;
Pname cln; // used for warnings
int i;
Pname tn = memtbl->get_mem(i=1);
for (; tn; tn=memtbl->get_mem(++i)) {
if (cln = tn->tp->is_cl_obj()) {
Pname d = Pclass(cln->tp)->has_dtor();
if (d) { /* n->cl::~cl(0); */
Pexpr dl = call_dtor(tn,d,0,DOT,one);
Pstmt dls = new estmt(SM,tn->where,dl,0);
dls->s_list = ss;
ss = dls;
}
}
}
if (ss) {
Pstmt t2 = ss->simpl();
switch (base) {
case IF:
case WHILE:
case DO:
case SWITCH:
temp_in_cond(e,ss,memtbl);
break;
case PAIR: // can hide a return
{ Pstmt ts = s2;
while (ts->base==PAIR) ts = ts->s2;
if (ts->base == RETURN) { // sordid
this = ts;
goto retu;
}
goto def;
}
case RETURN:
retu:
{
if (e == 0) {
// return; dtors; => dtors; return;
Pstmt rs = new estmt(RETURN,where,0,0);
//rs->empty = empty; // BSD fudge
rs->ret_tp = ret_tp;
base = PAIR;
s = ss;
s2 = rs;
//Cstmt = ostmt;
return t1 ? t1 : rs;
}
Pname cln = e->tp->is_cl_obj();
if (cln==0
|| Pclass(cln->tp)->has_oper(ASSIGN)==0) {
// ... return e; dtors; =>
// ... X r; ... r = e; dtors; return r;
Pname rv = new name("_rresult"); // NOT "_result"
rv->tp = ret_tp /* e->tp */;
if (memtbl == 0) memtbl = new table(4,0,0);
Pname n = rv->dcl(memtbl,ARG);
n->where = no_where;
n->n_scope = FCT;
n->n_assigned_to = 1;
delete rv;
Pstmt rs = new estmt(RETURN,where,n,0);
rs->ret_tp = ret_tp;
base = SM;
e = new expr(ASSIGN,n,e);
e->tp = n->tp;
Pstmt ps = new pair(where,ss,rs);
ps->s_list = s_list;
s_list = ps;
//Cstmt = ostmt;
return t1 ? t1 : rs;
}
}
case FOR: // don't know which expression the temp comes from
error('s',&where,"E in %kS needs temporary ofC%nW destructor",base,cln);
break;
case SM: // place dtors after all "converted" DCLs
if (t1) {
// ccheck(e);
for (Pstmt ttt, tt=this;
(ttt=tt->s_list) && ttt->base==SM;
tt = ttt) ;
t2->s_list = ttt;
tt->s_list = ss;
//Cstmt = ostmt;
return t1!=tt ? t1 : t2;
}
default:
def:
// if (e) ccheck(e);
if (t1) { // t1 == tail of statment list
t2->s_list = s_list;
s_list = ss;
//Cstmt = ostmt;
return t1;
}
s_list = ss;
//Cstmt = ostmt;
return t2;
}
}
//Cstmt = ostmt;
return (t1) ? t1 : this;
}
//Cstmt = ostmt;
return (s_list) ? s_list->simpl() : this;
}
Pstmt stmt::copy()
// now handles dtors in the expression of an IF stmt
// not general!
{
Pstmt ns = new stmt(0,curloc,0);
*ns = *this;
if (s) ns->s = s->copy();
if (s_list) ns->s_list = s_list->copy();
switch (base) {
case PAIR:
ns->s2 = s2->copy();
break;
}
return ns;
}
Pname overFound = 0;
static Pexpr
mk_new_with_args( Pexpr pe, Ptype tt, Pclass cl, Pexpr vec = 0 )
{ // allocate using operator new(sizeof(cl),args1)
Pexpr p;
Pexpr args = pe->e2;
// Pexpr ce = new texpr(SIZEOF,tt,0);
Pexpr ce;
if (vec)
ce = vec;
else ce = new texpr(SIZEOF,tt,0);
(void) tt->tsizeof();
ce->tp = size_t_type;
args = new expr(ELIST,ce,args);
char* s = oper_name(NEW);
Pname n = new name(s);
if (pe->base == GNEW) // ::new
p = gtbl->look(s,0);
else
p = find_name(n,cl,scope,CALL,curr_fct);
p = new call(p,args);
overFound=0; // set in call_fct
(void) p->call_fct(cl->memtbl);
if (overFound && overFound->n_scope != EXTERN)
check_visibility(overFound,0,cl,cc->ftbl,cc->nof);
overFound=0;
return p;
}
void expr::simpl_new()
/*
change NEW or GNEW node to CALL node
*/
{
Pname cln;
Pname ctor;
int sz = 1;
// int esz;
Pexpr var_expr = 0;
Pexpr const_expr = 0;
Ptype tt = tp2;
Pexpr arg;
Pexpr szof;
Pname nf;
Pexpr init = e1;
if (init && init->base) init = 0; // only non-ctor init
// error('d',"simpl_new %k e1 %k e2 %k init %k",base, e1?e1->base:0,e2?e2->base:0,init?init->base:0);
if ((cln=tt->is_cl_obj()) && init == 0) {
Pclass cl = Pclass(cln->tp);
Pexpr p;
ctor=cl->has_ctor();
// error('d',"cl %t ctor %n",cl, ctor);
if (e2 // placement
|| ctor==0 // no constructor
|| ctor->n_table!=cl->memtbl // inherited constructor???
|| (base==GNEW && cl->has_oper(NEW)) )
p = mk_new_with_args( this, tt, cl ); // new(sizeof(cl),args1)
else {
p = zero; // 0->ctor(args)
// check visibility anyway...
(void)mk_new_with_args(this,tt,cl);
}
if (ctor) {
Pexpr c = e1; // ctor call generated in expr::typ
Ptype ttt = tp;
c->e1->e1 = p; // p->ctor
c->simpl();
*this = *c;
tp = ttt;
delete c;
}
else { // (tp)new(args)
base = CAST;
tp2 = tp;
e1 = p;
e2 = 0;
simpl();
}
return;
} else if ( cln ) {
Pclass cl = Pclass(cln->tp);
// check visibility anyway...
(void)mk_new_with_args(this,tt,cl);
}
Pclass covn = 0;
if (cl_obj_vec) {
covn = Pclass(cl_obj_vec->tp);
ctor = covn->has_ictor();
if (ctor == 0) {
if (covn->has_ctor()) error("new %s[], no defaultK",covn->string);
cl_obj_vec = 0;
}
}
xxx:
//error('d',"xxx %t",tt);
switch (tt->base) {
case TYPE:
tt = Pbase(tt)->b_name->tp;
goto xxx;
default:
(void) tt->tsizeof();
szof = new texpr(SIZEOF,tt,0);
szof->tp = uint_type;
break;
case VEC:
{ Pvec v = Pvec(tt);
//error('d',"v %d %d",v->size,v->dim);
if (v->size)
sz *= v->size;
else if (v->dim)
var_expr = v->dim;
else
sz = 0;
tt = v->typ;
goto xxx;
}
}
if (cl_obj_vec) { // _vec_new(0,no_of_elements,element_size,ctor)
const_expr = new ival(sz);
Pexpr noe = (var_expr) ? (sz!=1) ? new expr(MUL,const_expr,var_expr) : var_expr : const_expr;
const_expr = szof;
const_expr->tp = uint_type;
base = CALL;
arg = new expr(ELIST,ctor,0);
/*ctor->take_addr();*/
ctor->lval(ADDROF);
Pexpr sub=0;
if (e2 && e2->e1 &&
e2->e1->tp &&
e2->e1->tp->base != PTR )
{ // new(size_t, args)
Pexpr vec_sz = new expr(MUL, noe, const_expr);
sub = mk_new_with_args( this, tt, covn, vec_sz );
}
arg = new expr(ELIST,const_expr,arg);
arg = new expr(ELIST,noe,arg);
// arg = new expr(ELIST,e2?e2:zero,arg); // may be preallocated
arg = new expr(ELIST,e2?(sub?sub:e2):zero,arg); // may be preallocated
base = CAST;
tp2 = tp;
e1 = new expr(G_CALL,vec_new_fct,arg);
e1->fct_name = vec_new_fct;
e1->tp = Pfct(vec_new_fct->tp)->returns;
simpl();
return;
}
/* call _new(element_size*no_of_elements) */
//error('d',"sz %d var %d",sz,var_expr);
if (sz == 1)
arg = (var_expr) ? new expr(MUL,szof,var_expr) : szof;
else {
const_expr = new ival(sz);
const_expr->tp = uint_type;
const_expr = new expr(MUL,const_expr,szof);
const_expr->tp = uint_type;
arg = (var_expr) ? new expr(MUL,const_expr,var_expr) : const_expr;
}
arg->tp = uint_type;
base = CAST;
tp2 = tp;
arg = new expr(ELIST,arg,e2);
nf = gtbl->look(oper_name(NEW),0); // always global,
// all class object handled above
e1 = new expr(G_CALL,nf,arg);
(void) e1->call_fct(gtbl);
simpl();
if (init) { // alloc(sz) => (p=alloc(sz),*p=init,p);
Pexpr p = init->e1;
Pexpr ee = new expr(0,0,0);
*ee = *this;
ee = new expr(ASSIGN,p,ee); // ee: p = alloc(sz);
init->base = ASSIGN;
init->e1 = p->contents(); // init: *p = init_val
ee = new expr(CM,ee,init);
ee->simpl();
base = CM;
e1 = ee;
e2 = p;
}
}
void expr::simpl_delete()
/*
delete p => _delete(p);
or cl::~cl(p,1);
delete[s]p => _delete(p);
or vec_del_fct(p,vec_sz,elem_sz,~cl,1);
*/
{
for (Ptype tt = e1->tp; tt->base==TYPE; tt=Pbase(tt)->b_name->tp);
tt = Pptr(tt)->typ;
//error('d',"simpl_delete() %t",e1->tp);
Pname cln = tt->is_cl_obj();
Pname n;
Pclass cl;
if (cln) {
cl = Pclass(cln->tp);
if ((cl->defined&DEFINED) == 0) error('w',"delete%t (%t not defined)",cl,cl);
}
else
cl = 0;
if (cl && (n=cl->has_dtor())) { // ~cl() might be virtual
//xxx check for private/protected op delete
{
Pexpr ee = new expr(ELIST,e1,0);
char* s = oper_name(DELETE);
Pname n;
//error('d',"%s( %k )",s,e1->base);
if (base!=GDELETE) {
n = new name(s);
n = (Pname)find_name(n,cl,scope,CALL,curr_fct);
//error('d',"found%n %t",n,n->tp);
if (n->tp->base==OVERLOAD
|| Pfct(n->tp)->nargs==2) {
Pexpr ss = new texpr(SIZEOF,cl,0);
ss->tp = size_t_type;
ee->e2 = new expr(ELIST,ss,0);
}
}
else
n = gtbl->look(s,0);
//error('d',"found%n %t",n,n->tp);
ee = new call(n,ee);
ee->base = G_CALL;
//error('d',"delete..."); display_expr(ee);
// following commented out to avoid typ::checking problems
//overFound=0; // set in call_fct
//(void) ee->call_fct(cl->memtbl);
//if (overFound && overFound->n_scope != EXTERN)
//check_visibility(overFound,0,cl,cc->ftbl,cc->nof);
//overFound=0;
}
//if ( base!=GDELETE ) (void) cl->has_oper(DELETE);
if(base==GDELETE && e2==0 || Pfct(n->tp)->f_virtual) { // may need temp
nin=1;
int needtemp = e1->not_simple();
nin=0;
if(needtemp) {
// convert: delete [e2] e1
// to: (T=e1), delete [e2] T
// where T is a new temporary.
Pname tnx = new name(make_name('K'));
tnx->tp = e1->tp;
Pname tn = tnx->dcl(scope,FCT);
delete tnx;
tn->assign();
e1 = new expr(ASSIGN,tn,e1);
e2 = new expr(base,tn,e2);
base=CM;
simpl();
return;
}
}
Pexpr r = e1;
// handle delete p, where p has a private destructor
if (n->n_scope != PUBLIC) check_visibility(n,0,cl,cc->ftbl,cc->nof);
//error('d',"e2 %d %k",e2,base);
if (e2 == 0) { // e1->cl::~cl(1)
Pexpr ee = call_dtor(r,n,base==GDELETE?0:one,REF,one);
if (Pfct(n->tp)->f_virtual) {
if (ansi_opt) { // q?void:int would be an error
ee = new expr(G_CM,ee,zero);
ee->tp = zero_type;
}
ee = new expr(QUEST,ee,zero);
ee->tp = ee->e1->tp;
ee->cond = r;
}
if (base == GDELETE) {
char* s = oper_name(DELETE);
Pexpr p = gtbl->look(s,0);
e2 = new call(p,new expr(ELIST,e1,0));
base = CM;
e1 = ee;
}
else {
*this = *ee;
delete ee;
}
simpl();
return;
}
else { // del_cl_vec(e1,e2,elem_size,~cl,1);
Pexpr sz = new texpr(SIZEOF,tt,0);
(void)tt->tsizeof();
Pfct f = Pfct(n->tp);
int i = 0;
Pname nn = f->f_args->n_list;
for (; nn && nn->n_list; nn=nn->n_list) i++;
//error('d',"n %n i %d",n,i);
Pexpr arg = new ival(i);
sz->tp = uint_type;
// Pexpr arg = one;
arg = new expr(ELIST,one,arg);
if (Pfct(n->tp)->f_virtual) {
Pexpr a = new ref(REF,e1,n);
a = a->address();
a = new mdot( "f", a );
a->i1 = 9;
arg = new expr(ELIST,a,arg);
}
else {
arg = new expr(ELIST,n,arg);
n->lval(ADDROF); // n->take_addr();
}
arg = new expr(ELIST,sz,arg);
if (e2->base==DUMMY) {
e2 = new ival(-1); // handle `delete[]p'
}
arg = new expr(ELIST,e2,arg);
arg = new expr(ELIST,e1,arg);
Pexpr ee = new expr(G_CALL,vec_del_fct,arg);
ee->fct_name = vec_del_fct;
ee->tp = tp;
// if (ansi_opt) { // q?void:int would be an error
// ee = new expr(G_CM,ee,zero);
// ee->tp = zero_type;
// }
// ee = new expr(QUEST,ee,zero);
// ee->tp = tp;
// ee->cond = r;
*this = *ee;
simpl();
return;
}
}
else if (cl_obj_vec) {
error("delete array of arrays");
}
else { // _delete(e1)
Pexpr ee = new expr(ELIST,e1,0);
char* s = oper_name(DELETE);
if (cl && base!=GDELETE) {
Pname n = new name(s);
e1 = find_name(n,cl,scope,CALL,curr_fct);
if (e1->tp->base==OVERLOAD || Pfct(e1->tp)->nargs==2) {
Pexpr ss = new texpr(SIZEOF,cl,0);
ss->tp = size_t_type;
ee->e2 = new expr(ELIST,ss,0);
}
}
else
e1 = gtbl->look(s,0);
base = G_CALL;
e2 = ee;
overFound=0; // set in call_fct
(void) call_fct(scope);
if (overFound && overFound->n_scope != EXTERN)
check_visibility(overFound,0,cl,cc->ftbl,cc->nof);
overFound=0;
}
Pcall(this)->simpl();
}
0707071010112045371004440001630000160000010207600466055410400000700000013461size.c /*ident "@(#)ctrans:src/size.c 1.3" */
/*********************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All rigths Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
size.c:
initialize alignment and sizeof "constants"
**********************************************************************/
#include "cfront.h"
#include "size.h"
int BI_IN_WORD = DBI_IN_WORD;
int BI_IN_BYTE = DBI_IN_BYTE;
int SZ_CHAR = DSZ_CHAR;
int AL_CHAR = DAL_CHAR;
int SZ_SHORT = DSZ_SHORT;
int AL_SHORT = DAL_SHORT;
int SZ_INT = DSZ_INT;
int AL_INT = DAL_INT;
int SZ_LONG = DSZ_LONG;
int AL_LONG = DAL_LONG;
int SZ_FLOAT = DSZ_FLOAT;
int AL_FLOAT = DAL_FLOAT;
int SZ_DOUBLE = DSZ_DOUBLE;
int AL_DOUBLE = DAL_DOUBLE;
int SZ_LDOUBLE = DSZ_LDOUBLE;
int AL_LDOUBLE = DAL_LDOUBLE;
int SZ_STRUCT = DSZ_STRUCT;
int AL_STRUCT = DAL_STRUCT;
//int SZ_FRAME = DSZ_FRAME;
//int AL_FRAME = DAL_FRAME;
int SZ_WORD = DSZ_WORD;
int SZ_WPTR = DSZ_WPTR;
int AL_WPTR = DAL_WPTR;
int SZ_BPTR = DSZ_BPTR;
int AL_BPTR = DAL_BPTR;
//int SZ_TOP = DSZ_TOP;
//int SZ_BOTTOM = DSZ_BOTTOM;
char* LARGEST_INT = DLARGEST_INT;
int F_SENSITIVE = DF_SENSITIVE;
int F_OPTIMIZED = DF_OPTIMIZED;
int arg1 = 0;
int get_line(FILE* fp)
{
char s[32];
char s2[32];
if (fscanf(fp,"%s %s",s2,s) == EOF) return 0;
if (strcmp("DLARGEST_INT",s) == 0) {
if (fscanf(fp," %s",s2)==EOF) return 0;
//// get rid of quotes
for(int i=0;i<=strlen(s2)+1;i++)
if (s2[i]== '"') {
for (int j=i;j<=strlen(s2)+1;j++)
s2[j]=s2[j+1];
}
}
else
if (fscanf(fp,"%d ",&arg1) == EOF) return 0;
if (strcmp("DSZ_CHAR",s) == 0) {
SZ_CHAR = arg1;
return 1;
}
if (strcmp("DAL_CHAR",s) == 0) {
AL_CHAR = arg1;
return 1;
}
if (strcmp("DSZ_SHORT",s) == 0) {
SZ_SHORT = arg1;
return 1;
}
if (strcmp("DAL_SHORT",s) == 0) {
AL_SHORT = arg1;
return 1;
}
if (strcmp("DSZ_INT",s) == 0) {
SZ_INT = arg1;
return 1;
}
if (strcmp("DAL_INT",s) == 0) {
AL_INT=arg1;
return 1;
}
if (strcmp("DLARGEST_INT",s) == 0) {
LARGEST_INT = new char[strlen(s2)+1];
strcpy(LARGEST_INT,s2);
return 1;
}
if (strcmp("DSZ_LONG",s) == 0) {
SZ_LONG = arg1;
return 1;
}
if (strcmp("DAL_LONG",s) == 0) {
AL_LONG = arg1;
return 1;
}
if (strcmp("DSZ_FLOAT",s) == 0) {
SZ_FLOAT = arg1;
return 1;
}
if (strcmp("DAL_FLOAT",s) == 0) {
AL_FLOAT = arg1;
return 1;
}
if (strcmp("DSZ_DOUBLE",s) == 0) {
SZ_DOUBLE = arg1;
return 1;
}
if (strcmp("DAL_DOUBLE",s) == 0) {
AL_DOUBLE = arg1;
return 1;
}
if (strcmp("DSZ_LDOUBLE",s) == 0) {
SZ_LDOUBLE = arg1;
return 1;
}
if (strcmp("DAL_LDOUBLE",s) == 0) {
AL_LDOUBLE = arg1;
return 1;
}
if (strcmp("DBI_IN_BYTE",s) == 0) {
BI_IN_BYTE = arg1;
return 1;
}
if (strcmp("DBI_IN_WORD",s) == 0) {
BI_IN_WORD= arg1;
return 1;
}
if (strcmp("DSZ_STRUCT",s) == 0) {
SZ_STRUCT = arg1;
return 1;
}
if (strcmp("DAL_STRUCT",s) == 0) {
AL_STRUCT = arg1;
return 1;
}
if (strcmp("DF_SENSITIVE",s) == 0) {
F_SENSITIVE = arg1;
return 1;
}
if (strcmp("DF_OPTIMIZED",s) == 0) {
F_OPTIMIZED = arg1;
return 1;
}
if (strcmp("frame",s) == 0) {
// SZ_FRAME = arg1;
// AL_FRAME = arg2;
return 1;
}
if (strcmp("DSZ_WORD",s) == 0) {
SZ_WORD = arg1;
return 1;
}
if (strcmp("DSZ_WPTR",s) == 0) {
SZ_WPTR = arg1;
return 1;
}
if (strcmp("DAL_WPTR",s) == 0) {
AL_WPTR = arg1;
return 1;
}
if (strcmp("DSZ_BPTR",s) == 0) {
SZ_BPTR = arg1;
return 1;
}
if (strcmp("DAL_BPTR",s) == 0) {
AL_BPTR = arg1;
return 1;
}
if (strcmp("top",s) == 0) {
// SZ_TOP = arg1;
// SZ_BOTTOM = arg2;
return 1;
}
return 0;
}
int read_align(char* f)
{
char* p = f;
if (*p == 0) {
fprintf(stderr,"size/align file missing\n");
ext(1);
}
FILE* fp = fopen(f,"r");
if (fp == 0) return 1;
while (get_line(fp)) ;
return 0;
}
/*
print_align(char* s)
{
fprintf(stderr,"%s sizes and alignments\n\n",s);
fprintf(stderr," size align largest\n");
fprintf(stderr,"char %d %d\n",SZ_CHAR,AL_CHAR);
fprintf(stderr,"short %d %d\n",SZ_SHORT,AL_SHORT);
fprintf(stderr,"int %d %d %s\n",SZ_INT,AL_INT,LARGEST_INT);
fprintf(stderr,"long %d %d\n",SZ_LONG,AL_LONG);
fprintf(stderr,"float %d %d\n",SZ_FLOAT,AL_FLOAT);
fprintf(stderr,"double %d %d\n",SZ_DOUBLE,AL_DOUBLE);
fprintf(stderr,"ldouble %d %d\n",SZ_LDOUBLE,AL_LDOUBLE);
fprintf(stderr,"bptr %d %d\n",SZ_BPTR,AL_BPTR);
fprintf(stderr,"wptr %d %d\n",SZ_WPTR,AL_WPTR);
fprintf(stderr,"struct %d %d\n",SZ_STRUCT,AL_STRUCT);
fprintf(stderr,"struct2 %d %d\n",F_SENSITIVE,F_OPTIMIZED);
// fprintf(stderr,"frame %d %d\n",SZ_FRAME,AL_FRAME);
fprintf(stderr,"%d bits in a byte, %d bits in a word, %d bytes in a word\n",
BI_IN_BYTE, BI_IN_WORD, SZ_WORD);
return 1;
}
*/
int c_strlen(const char* s)
/*
return sizeof(s) with escapes processed
sizeof("") == 1 the terminating 0
sizeof("a") == 2
sizeof("\0x") == 3 0 x 0
sizeof("\012") == 2 '\012'
sizeof("\01") '\001'
sizeof("\x") == 2 \ ignored
*/
{
int i = 1;
for (const char* p = s; *p; i++,p++) {
if (*p == '\\') { // '\?
switch (*++p) {
case '0':
switch (p[1]) { // '\01' or '\012'
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
break;
default:
continue; // '\0'
}
/* no break */
case '1': case '2': case '3':
case '4': case '5': case '6': case '7': // '\123'
switch (*++p) {
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
switch (*++p) {
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
break;
default:
--p;
}
break;
default:
--p;
break;
}
break;
case '\n': // \newline doesn't count
i--;
break;
}
}
}
return i;
}
0707071010112045661004440001630000160000010207700466055411000000700000020157size.h /*ident "@(#)ctrans:src/size.h 1.2" */
/*************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All rigths Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
size.h:
sizes and alignments used to calculate sizeofs
table and butffer sizes
***************************************************************************/
#ifndef GRAM
extern BI_IN_WORD;
extern BI_IN_BYTE;
/* byte sizes */
extern SZ_CHAR;
extern AL_CHAR;
extern SZ_SHORT;
extern AL_SHORT;
extern SZ_INT;
extern AL_INT;
extern SZ_LONG;
extern AL_LONG;
extern SZ_FLOAT;
extern AL_FLOAT;
extern SZ_DOUBLE;
extern AL_DOUBLE;
extern SZ_LDOUBLE;
extern AL_LDOUBLE;
extern SZ_STRUCT; /* minimum struct size */
extern AL_STRUCT;
//extern SZ_FRAME;
//extern AL_FRAME;
extern SZ_WORD;
extern SZ_WPTR;
extern AL_WPTR;
extern SZ_BPTR;
extern AL_BPTR;
//extern SZ_TOP;
//extern SZ_BOTTOM;
extern char* LARGEST_INT;
extern int F_SENSITIVE; // is field alignment sensitive to the type of the field?
extern int F_OPTIMIZED; // can the compiler fit a small int field into a char?
#endif
// default sizes:
// Note: #if doesn't work on all systems
#ifdef u3b
#define Abbb
#endif
#ifdef u3b2
#define Abbb
#endif
#ifdef u3b5
#define Abbb
#endif
#ifdef u3b15
#define Abbb
#endif
#ifdef pyr
#define Abbb
#endif
#ifdef alliant
#define Am68
#endif
#ifdef apollo
#define Am68
#endif
#if defined(sun2) || defined(mc68010)
#define Am68
#endif
#if defined(sun3) || defined(mc68020)
#define Am68
#endif
#if defined(mc68k) || defined(hp9000s200) || defined(hp9000s300)
#define Am68
#endif
#ifdef iAPX286
#ifdef LARGE
#define Ai286l
#endif
#endif
#ifdef Abbb
/* AT&T 3Bs */
#define DBI_IN_WORD 32
#define DBI_IN_BYTE 8
#define DSZ_CHAR 1
#define DAL_CHAR 1
#define DSZ_SHORT 2
#define DAL_SHORT 2
#define DSZ_INT 4
#define DAL_INT 4
#define DSZ_LONG 4
#define DAL_LONG 4
#define DSZ_FLOAT 4
#define DAL_FLOAT 4
#define DSZ_DOUBLE 8
#define DAL_DOUBLE 4
#define DSZ_LDOUBLE 8
#define DAL_LDOUBLE 4
#define DSZ_STRUCT 4
#define DAL_STRUCT 4
//#define DSZ_FRAME 4
//#define DAL_FRAME 4
#define DSZ_WORD 4
#define DSZ_WPTR 4
#define DAL_WPTR 4
#define DSZ_BPTR 4
#define DAL_BPTR 4
//#define DSZ_TOP 0
//#define DSZ_BOTTOM 0
#define DLARGEST_INT "2147483647" /* 2**31 - 1 */
#define DF_SENSITIVE 0
#define DF_OPTIMIZED 1
#else
#ifdef Am68
/* most M68K boxes */
#if defined(hp9000s200) || defined(hp9000s300)
#define DBI_IN_WORD 32
#else
#define DBI_IN_WORD 16
#endif
#define DBI_IN_BYTE 8
#define DSZ_CHAR 1
#define DAL_CHAR 1
#define DSZ_SHORT 2
#define DAL_SHORT 2
#define DSZ_INT 4
#define DAL_INT 2
#define DSZ_LONG 4
#define DAL_LONG 2
#define DSZ_FLOAT 4
#define DAL_FLOAT 2
#define DSZ_DOUBLE 8
#define DAL_DOUBLE 2
#define DSZ_LDOUBLE 8
#define DAL_LDOUBLE 2
#define DSZ_STRUCT 2
#define DAL_STRUCT 2
//#define DSZ_FRAME 4
//#define DAL_FRAME 4
#define DSZ_WORD 2
#define DSZ_WPTR 4
#define DAL_WPTR 2
#define DSZ_BPTR 4
#define DAL_BPTR 2
//#define DSZ_TOP 0
//#define DSZ_BOTTOM 0
#define DLARGEST_INT "2147483647" /* 2**31 - 1 */
#define DF_SENSITIVE 0
#define DF_OPTIMIZED 1
#else
#ifdef Ai286l
/* Intel 80286 large model */
#define DBI_IN_WORD 16
#define DBI_IN_BYTE 8
#define DSZ_CHAR 1
#define DAL_CHAR 1
#define DSZ_SHORT 2
#define DAL_SHORT 2
#define DSZ_INT 2
#define DAL_INT 2
#define DSZ_LONG 4
#define DAL_LONG 2
#define DSZ_FLOAT 4
#define DAL_FLOAT 2
#define DSZ_DOUBLE 8
#define DAL_DOUBLE 2
#define DSZ_LDOUBLE 8
#define DAL_LDOUBLE 2
#define DSZ_STRUCT 2
#define DAL_STRUCT 2
//#define DSZ_FRAME 4
//#define DAL_FRAME 4
#define DSZ_WORD 2
#define DSZ_WPTR 4
#define DAL_WPTR 2
#define DSZ_BPTR 4
#define DAL_BPTR 2
//#define DSZ_TOP 0
//#define DSZ_BOTTOM 0
#define DLARGEST_INT "32767" /* 2**15 - 1 */
#define DF_SENSITIVE 0
#define DF_OPTIMIZED 1
#else
#if defined(uts) || defined(hp9000s800) || defined(sun4) || defined(sparc)
/* Amdahl running UTS, HP RISC */
#define DBI_IN_WORD 32
#define DBI_IN_BYTE 8
#define DSZ_CHAR 1
#define DAL_CHAR 1
#define DSZ_SHORT 2
#define DAL_SHORT 2
#define DSZ_INT 4
#define DAL_INT 4
#define DSZ_LONG 4
#define DAL_LONG 4
#define DSZ_FLOAT 4
#define DAL_FLOAT 4
#define DSZ_DOUBLE 8
#define DAL_DOUBLE 8
#define DSZ_LDOUBLE 8
#define DAL_LDOUBLE 8
#define DSZ_STRUCT 1
#define DAL_STRUCT 1
#define DSZ_WORD 4
#define DSZ_WPTR 4
#define DAL_WPTR 4
#define DSZ_BPTR 4
#define DAL_BPTR 4
#define DLARGEST_INT "2147483647" /* 2**31 - 1 */
#if defined(uts)
#define DF_SENSITIVE 1
#else
#define DF_SENSITIVE 0
#endif
#define DF_OPTIMIZED 1
#else
#ifdef hpux
/* hp */
#define DBI_IN_WORD 32
#define DBI_IN_BYTE 8
#define DSZ_CHAR 1
#define DAL_CHAR 1
#define DSZ_SHORT 2
#define DAL_SHORT 2
#define DSZ_INT 4
#define DAL_INT 4
#define DSZ_LONG 4
#define DAL_LONG 4
#define DSZ_FLOAT 4
#define DAL_FLOAT 4
#define DSZ_DOUBLE 8
#define DAL_DOUBLE 8
#define DSZ_LDOUBLE 8
#define DAL_LDOUBLE 8
#define DSZ_STRUCT 1
#define DAL_STRUCT 1
#define DSZ_WORD 4
#define DSZ_WPTR 4
#define DAL_WPTR 4
#define DSZ_BPTR 4
#define DAL_BPTR 4
#define DLARGEST_INT "2147483647" /* 2**31 - 1 */
#define DF_SENSITIVE 1
#define DF_OPTIMIZED 1
#else
#if defined(vax) || defined(ibm032) || defined(i386)
/* VAX, IBM 32, Intel 386 */
#define DBI_IN_WORD 32
#define DBI_IN_BYTE 8
#define DSZ_CHAR 1
#define DAL_CHAR 1
#define DSZ_SHORT 2
#define DAL_SHORT 2
#define DSZ_INT 4
#define DAL_INT 4
#define DSZ_LONG 4
#define DAL_LONG 4
#define DSZ_FLOAT 4
#define DAL_FLOAT 4
#define DSZ_DOUBLE 8
#define DAL_DOUBLE 4
#define DSZ_LDOUBLE 8
#define DAL_LDOUBLE 4
#define DSZ_STRUCT 1
#define DAL_STRUCT 1
//#define DSZ_FRAME 4
//#define DAL_FRAME 4
#define DSZ_WORD 4
#define DSZ_WPTR 4
#define DAL_WPTR 4
#define DSZ_BPTR 4
#define DAL_BPTR 4
//#define DSZ_TOP 0
//#define DSZ_BOTTOM 0
#define DLARGEST_INT "2147483647" /* 2**31 - 1 */
#define DF_SENSITIVE 0
#define DF_OPTIMIZED 1
#else
#ifdef mc300
#define DBI_IN_WORD 32
#define DBI_IN_BYTE 8
#define DSZ_CHAR 1
#define DAL_CHAR 1
#define DSZ_SHORT 2
#define DAL_SHORT 2
#define DSZ_INT 4
#define DAL_INT 4
#define DSZ_LONG 4
#define DAL_LONG 4
#define DSZ_FLOAT 4
#define DAL_FLOAT 4
#define DSZ_DOUBLE 8
#define DAL_DOUBLE 4
#define DSZ_LDOUBLE 8
#define DAL_LDOUBLE 4
#define DSZ_STRUCT 2
#define DAL_STRUCT 2
//#define DSZ_FRAME 4
//#define DAL_FRAME 4
#define DSZ_WORD 4
#define DSZ_WPTR 4
#define DAL_WPTR 4
#define DSZ_BPTR 4
#define DAL_BPTR 4
//#define DSZ_TOP 0
//#define DSZ_BOTTOM 0
#define DLARGEST_INT "2147483647" /* 2**31 - 1 */
#define DF_SENSITIVE 0
#define DF_OPTIMIZED 1
#else
#ifdef mips
#define DBI_IN_BYTE 8
#define DBI_IN_WORD 32
#define DSZ_WORD 4
#define DSZ_CHAR 1
#define DAL_CHAR 1
#define DSZ_SHORT 2
#define DAL_SHORT 2
#define DSZ_INT 4
#define DAL_INT 4
#define DLARGEST_INT "2147483647"
#define DSZ_LONG 4
#define DAL_LONG 4
#define DSZ_FLOAT 4
#define DAL_FLOAT 4
#define DSZ_DOUBLE 8
#define DAL_DOUBLE 8
#define DSZ_LDOUBLE 8
#define DAL_LDOUBLE 8
#define DSZ_BPTR 4
#define DAL_BPTR 4
#define DSZ_WPTR 4
#define DAL_WPTR 4
#define DSZ_STRUCT 1
#define DAL_STRUCT 1
#define DF_SENSITIVE 0
#define DF_OPTIMIZED 1
#else
/* defaults: 0 => error */
#define DBI_IN_WORD 0
#define DBI_IN_BYTE 0
#define DSZ_CHAR 1
#define DAL_CHAR 1
#define DSZ_SHORT 0
#define DAL_SHORT 0
#define DSZ_INT 0
#define DAL_INT 0
#define DSZ_LONG 0
#define DAL_LONG 0
#define DSZ_FLOAT 0
#define DAL_FLOAT 0
#define DSZ_DOUBLE 0
#define DAL_DOUBLE 0
#define DSZ_LDOUBLE 0
#define DAL_LDOUBLE 0
#define DSZ_STRUCT 0
#define DAL_STRUCT 0
#define DSZ_WORD 0
#define DSZ_WPTR 0
#define DAL_WPTR 0
#define DSZ_BPTR 0
#define DAL_BPTR 0
#define DLARGEST_INT "0"
#define DF_SENSITIVE 0
#define DF_OPTIMIZED 0
#endif
#endif
#endif
#endif
#endif
#endif
#endif
#endif
#define KTBLSIZE 123 /* initial keyword table size */
#define GTBLSIZE 257 /* initial global name table size */
#define CTBLSIZE 12 /* initial class table size */
#define TBLSIZE 20 /* initial block table size */
#define BLMAX 50 /* max block nesting */
#define MAXFILE 127 /* max include file nesting */
#define MAXERR 13 /* maximum number of errors before terminating */
#ifndef GRAM
const CHUNK = 8*1024;
void* chunk(int);
#endif
0707071010112045671004440001630000160000010210000466055411300001000000015476table.c /*ident "@(#)ctrans:src/table.c 1.3" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
table.c:
*****************************************************************************/
#include "cfront.h"
#include "size.h"
#ifdef DBG
extern long node_id;
#define DBCHECK() if(node::allocated) error('i',"allocated node (id %d, base%k) on free list! (src: \"%s\", %d",node::id,node::base,__FILE__,__LINE__);
#else
#define DBCHECK() /**/
#endif
table::table(short sz, Ptable nx, Pname n)
/*
create a symbol table with "size" entries
the scope of table is enclosed in the scope of "nx"
both the vector of class name pointers and the hash table
are initialized containing all zeroes
to simplify hashed lookup entries[0] is never used
so the size of "entries" must be "size+1" to hold "size" entries
*/
{
DBCHECK();
base = TABLE;
t_name = n;
size = sz = (sz<=0) ? 2 : sz+1;
//fprintf(stderr,"table::table %d %s %d (%d %d)\n", this, (n)?n->string:"?", sz,(sz*3)/2);
entries = new Pname[sz];
hashsize = sz = (sz*3)/2;
hashtbl = new short[sz];
next = nx;
free_slot = 1;
DBID();
}
table::~table()
{
delete entries;
delete hashtbl;
}
Pname table::look(char* s, TOK k)
/*
look for "s" in table, ignore entries which are not of "k" type
look and insert MUST be the same lookup algorithm
*/
{
Ptable t;
register char * p;
register char * q;
register int i;
Pname n;
int rr;
// if (s == 0) error('i',"%d->look(0)",this);
// if (this == 0) error('i',"0->look(%s)",s);
// if (base != TABLE) error('i',"(%d,%d)->look(%s)",this,base,s);
/* use simple hashing with linear search for overflow */
p = s;
i = 0;
while (*p) i += (i + *p++); /* i<<1 ^ *p++ better?*/
rr = (0<=i) ? i : -i;
for (t=this; t; t=t->next) {
/* in this and all enclosing scopes look for name "s" */
Pname* np = t->entries;
int mx = t->hashsize;
short* hash = t->hashtbl;
int firsti = i = rr%mx;
do {
if (hash[i] == 0) goto not_found;
n = np[hash[i]];
if (n == 0) error('i',"hashed lookup");
p = n->string; /* strcmp(n->n_string,s) */
q = s;
while (*p && *q)
if (*p++ != *q++) goto nxt;
if (*p == *q) goto found;
nxt:
if (mx <= ++i) i = 0; /* wrap around */
} while (i != firsti);
found:
for (; n; n=n->n_tbl_list){ /* for all name "s"s look for a key match */
if (n->n_key == k) return n;
}
not_found:;
}
return 0; /* not found && no enclosing scope */
}
bit Nold; /* non-zero if last insert() failed */
Pname table::insert(Pname nx, TOK k)
/*
the lookup algorithm MUST be the same as look
if nx is found return the older entry otherwise a copy of nx;
Nold = (nx found) ? 1 : 0;
*/
{
register char * p;
register int i;
Pname n;
Pname* np = entries;
Pname* link;
int firsti;
int mx = hashsize;
short* hash = hashtbl;
char* s = nx->string;
if (s==0) error('i',"%p->insert(0,%k)",this,k);
nx->n_key = k;
if (nx->n_tbl_list || nx->n_table) error('i',"%n in two tables",nx);
/* use simple hashing with linear search for overflow */
p = s;
i = 0;
while (*p) i += (i + *p++);
if (i<0) i = -i;
firsti = i = i%mx;
do { /* look for name "s" */
if (hash[i] == 0) {
hash[i] = free_slot;
goto add_np;
}
n = np[hash[i]];
if (n == 0) error('i',"hashed lookup");
if (strcmp(n->string,s) == 0) goto found;
/*
p = n->string;
q = s;
while (*p && *q) if (*p++ != *q++) goto nxt;
if (*p == *q) goto found;
nxt:
*/
if (mx <= ++i) i = 0; /* wrap around */
} while (i != firsti);
error("N table full");
found:
for(;;) {
if ( k!=NESTED && n->n_key==k) { Nold = 1; return n; }
if (n->n_tbl_list)
n = n->n_tbl_list;
else {
link = &(n->n_tbl_list);
goto re_allocate;
}
}
add_np:
if (size <= free_slot) {
grow(2*size);
return insert(nx,k);
}
link = &(np[free_slot++]);
re_allocate:
{
Pname nw = new name;
*nw = *nx;
char* ps = new char[strlen(s)+1]; // copy string to safer store
strcpy(ps,s);
// Nstr++;
nw->string = ps;
nw->n_table = this;
*link = nw;
Nold = 0;
// Nname++;
return nw;
}
}
void table::grow(int g)
{
short* hash;
register int j;
int mx;
register Pname* np;
Pname n;
if (g <= free_slot) error('i',"table.grow(%d,%d)",g,free_slot);
if (g <= size) return;
//error('d',"grow %d %s %d->%d", this, (t_name)?t_name->string:"?", size, g+1);
size = mx = g+1;
np = new Pname[mx];
for (j=0; j<free_slot; j++) np[j] = entries[j];
delete entries;
entries = np;
delete hashtbl;
hashsize = mx = (g*3)/2;
hash = hashtbl = new short[mx];
for (j=1; j<free_slot; j++) { /* rehash(np[j]); */
char * s = np[j]->string;
register char * p;
char * q;
register int i;
int firsti;
p = s;
i = 0;
while (*p) i += (i + *p++);
if (i<0) i = -i;
firsti = i = i%mx;
do { /* look for name "s" */
if (hash[i] == 0) {
hash[i] = j;
goto add_np;
}
n = np[hash[i]];
if (n == 0) error('i',"hashed lookup");
p = n->string; /* strcmp(n->n_string,s) */
q = s;
while (*p && *q) if (*p++ != *q++) goto nxt;
if (*p == *q) goto found;
nxt:
if (mx <= ++i) i = 0; /* wrap around */
} while (i != firsti);
error('i',"rehash??");
found:
error('i',"rehash failed");
add_np:;
}
}
Pname table::get_mem(int i)
/*
return a pointer to the i'th entry, or 0 if it does not exist
*/
{
return (i<=0 || free_slot<=i) ? 0 : entries[i];
}
void table_delete(char* s, TOK k, int ll )
/*
deletes local class entry from keyword table
adjusts pointers if multiple entries
uses same lookup as table::look and table::insert
*/
{
Ptable t = ktbl;
register char * p;
register char * q;
register int i;
Pname n;
int rr;
p = s;
i = 0;
while (*p) i += (i + *p++); /* i<<1 ^ *p++ better?*/
rr = (0<=i) ? i : -i;
// error ('d', "table_delete: %s ll: %d", s, ll );
Pname* np = t->entries;
int mx = t->hashsize;
short* hash = t->hashtbl;
int firsti = i = rr%mx;
do {
if (hash[i] == 0) error('i',"table delete: not found: %s", s );
n = np[hash[i]];
if (n == 0) error('i',"table delete: hashed lookup");
p = n->string; /* strcmp(n->n_string,s) */
q = s;
// error( 'd', "table_delete: %s", p );
while (*p && *q)
if (*p++ != *q++) goto nxt;
if (*p == *q) goto found;
nxt:
if (mx <= ++i) i = 0; /* wrap around */
} while (i != firsti);
found:
for (Pname prev = n; n; prev = n, n=n->n_tbl_list){
// error( 'd', "table_delete: found: %s %k lex: %d", n->string, n->n_key, n->lex_level );
if (n->n_key == k && n->lex_level == ll ) {
// error( 'd', "table_delete: prev: %d n: %d n->tbl_list: %d", prev, n, n->n_tbl_list);
if ( prev == n && n->n_tbl_list == 0 )
hash[i] = 0;
else
prev->n_tbl_list = n->n_tbl_list;
return;
}
}
}
0707071010112046031004440001630000160000010211300466055416400001300000206556template.c /* ident "@(#)ctrans:src/template.c 1.3" */
/*******************************************************************
* template.c
*
* This file contains most of the implementation for a subset of
* parametrized types as defined by the 1989 Stroustrup JOOP paper.
* The subset chosen here was the subset relevant to the
* implementation of aggregates in ObjectStore.
*
* The following is a list of features supported by the
* implementation. The list of features parallels the
* description of templates in the JOOP paper.
*
* a) Class templates supported.
*
* b) Member function templates supported.
* Type-specific member functions as described at the
* end of the "Outline of an implementation" section
* are also supported.
*
* Non-member function templates are not supported.
*
* c) Template arguments may be of type "type" or
* simple integral, real, double and pointer types
* that are compile-time constants.
*
* Default arguments are not suported.
*
*
* Restrictions:
*
* a) template definitions may not be nested.
*
* b) enums, or class definitions may not be
* nested within a template class definition.
*
* This file also supports an internal template facility
* to facilitate the implementation of ObjectStore data
* model features. The internal template facility is
* only used by compiler implementors, and is not user visible.
*
************************************************************/
/***********************************************************
*
* TBD
*
* 1) Error recovery, a never ending task, could stand improvement.
*
* 2) The template copying process could probably be speeded up
* substantially, by only placing "graph-like" nodes in the hash
* table. The current implementation plays it safe, and places
* all nodes in the hash table.
*
* 3) Clean up $name processing, it needs to be remodularized
* so that class templates and tree templates share the code.
*
* 4) Permit parametrized name default names within member
* functions.
*
****************************************************************/
#include "tree_copy.h"
#include "cfront.h"
#include <string.h>
#include "tree_dump.h"
#include "template.h"
#include <stdlib.h>
#include <ctype.h>
#include "hash.h"
extern int bound ; // is not mentioned in the header file
const int max_string_size = 1024 ;
const int default_copy_hash_size = 1000 ;
// Save and restore global state around a template instantiation
void state::save() {
Cdcl = ::Cdcl ;
Cstmt = ::Cstmt ;
curloc = ::curloc ;
curr_file = ::curr_file ;
curr_expr = ::curr_expr ;
curr_icall = ::curr_icall ;
curr_loop = ::curr_loop;
curr_block = ::curr_block;
curr_switch = ::curr_switch;
bound = ::bound ;
inline_restr = ::inline_restr ;
last_line = ::last_line ;
no_of_badcall = ::no_of_badcall;
no_of_undcl = ::no_of_undcl ;
badcall = ::badcall ;
undcl = ::undcl ;
} ;
void state::restore() {
::Cdcl = Cdcl ;
::Cstmt = Cstmt ;
::curloc = curloc ;
::curr_file = curr_file ;
::curr_expr = curr_expr ;
::curr_icall = curr_icall ;
::curr_loop = curr_loop;
::curr_block = curr_block;
::curr_switch = curr_switch;
::bound = bound ;
::inline_restr = inline_restr ;
::last_line = last_line ;
::no_of_badcall = no_of_badcall;
::no_of_undcl = no_of_undcl ;
::badcall = badcall ;
::undcl = undcl ;
} ;
void state::init() {
::bound = 0 ;
::inline_restr = 0 ;
::no_of_badcall = ::no_of_undcl = 0 ;
::undcl = ::badcall = NULL ;
// lastline needs to be initialized probaly via a call to putline
}
bit basetype::parametrized_class()
{ return ((base == COBJ) &&
Ptclass(Pbase(this)->b_name->tp)->class_base == uninstantiated_template_class) ;
}
class_type_enum get_class_base (Pbase b) {
if (b->base != COBJ) error('i', "badA top ::get_class_type") ;
return Ptclass(Pbase(b)->b_name->tp)->class_base ;
}
Ptclass get_template_class (Pbase b) {
class_type_enum t = get_class_base(b) ;
if (! ((t == instantiated_template_class) ||
(t == uninstantiated_template_class)))
error ('i', "C is not aYC") ;
return Ptclass(Pbase(b)->b_name->tp) ;
}
Ptempl_inst get_templ_inst(Pbase b) {
return (get_template_class(b))->inst ;
}
bit classdef::parametrized_class()
{ return (class_base == uninstantiated_template_class) ;
}
// Predicate to determine whether two classes are indeed the same. cfront
// normally relies on pointer identity, however this test is insufficient when
// parametrized class instantiationa are involved, since there are potentially
// many instances of a COBJ and CLASS for a given instantiation.
bit classdef::same_class(Pclass pc)
{
if (this == pc) return true ;
// An intermediate test to compensate for the fact that instantiations do
// not cause a copy of the syntax tree to be generated. This kludge should
// not be necessary once the template implementation is complete, and tree
// copying is implemented.
// Later, Sam: tree copying is now implemented, i need to remove the
// following two statements and rerun the test suite.
if ((this->class_base == template_class) &&
(pc->class_base == instantiated_template_class) &&
(Ptclass(pc)->inst->def_basetype()->b_name->tp == this))
return true ;
// The inverse symmetric test
if ((pc->class_base == template_class) &&
(this->class_base == instantiated_template_class) &&
(Ptclass(this)->inst->def_basetype()->b_name->tp == pc))
return true ;
// Check whether the templates were determined to be identical after
// instantiation.
if ((pc->class_base == instantiated_template_class) &&
(this->class_base == instantiated_template_class) &&
(Ptclass(this)->inst->same(Ptclass(pc)->inst)))
return true ;
return false ;
}
// determine whether two instantiations are identical; the test asumes that
// the templates have been instantiated.
bool templ_inst::same(Ptempl_inst t)
{
return ((forward && (forward == t->forward)) ||
(forward == t) || (t->forward == this)) ? true : false ;
}
/* Template parsing support */
// The canonical template compilation instance.
templ_compilation *templp ;
templ_compilation::templ_compilation()
{ templates = new table(128, NULL, NULL) ;
any_type = new basetype(ANY, NULL);
PERM(any_type) ;
}
// determine whether the string corresponds to a tree formal parameter
Pname templ_compilation::tree_parameter(char *s) {
for (Plist formal = params ; formal ; formal = formal->l)
if (strcmp(formal->f->string, s) == 0) {
formal->f->n_used++ ;
return formal->f ;
}
return 0 ;
}
// Determine whether the name refers to the canonical template class during
// syntax analysis.
Ptempl templ_compilation::is_template(Pname p) {
if (p->tp && (p->tp->base == COBJ) &&
(get_class_base(Pbase(p->tp)) == template_class))
{ Pname n = templates->look(p->string, 0) ;
return (n ? Ptempl(n->tp) : 0) ;
}
return 0 ;
}
// determine whether the string names a template
Ptempl templ_compilation::is_template(char *s) {
Pname n = templates->look(s,0) ;
return (n ? Ptempl(n->tp) : 0) ;
}
// Set up the environment for parsing a template. This involves setting up a
// new nesting level into which the "type type" parameters of the template can
// be entered, so that the lexer can find them as TNAMES. The scope is
// deallocated by end().
void templ_compilation::start()
{ templp->in_progress = true ;
// Reinitialize the state.
params = param_end = NULL ; owner = NULL ;
modified_tn = 0 ; // Initialize it here, since ::collect adds new types
}
// Collect each parameter as it is parsed, and add it to the list of parms.
// Validate each parameter to make sure that it is one of the acceptable
// types.
void templ_compilation::collect(TOK parm_type, Pname n)
{
switch (parm_type) {
case CLASS:
// A "type type" parameter, give it the "ANY" type normally used as a
// wildcard match internally by the compiler in cases of error.
n->tp = new basetype(ANY, 0);
n = n->tdef() ; // Set it up to be a typedef.
n->lex_level = bl_level + 1 ; // Inner scope, so restore() can hack it
n->n_template_arg = template_type_formal ;
PERM(n) ; PERM(n->tp) ;
break ;
case STATEMENT:
case EXPRESSION:
// the argument is a post-syntax expression tree
n->n_template_arg =
((parm_type == EXPRESSION) ?
template_expr_tree_formal : template_stmt_tree_formal) ;
// canonical any_type is ok here
n->tp = any_type ;
PERM(n) ;
break ;
default:
error("theZT for%n must be CLASS, not %k", n,parm_type);
}
append_parameter(n) ;
}
// append the "non-type" parameter to the end of the list
void templ_compilation::append_parameter(Pname n)
{
if (params){
param_end->l = new name_list(n, NULL) ;
param_end = param_end->l ;
}else params = param_end = new name_list(n, NULL) ;
PERM(n) ; PERM(n->tp) ;
}
// collect non "type type" parameters. The tp field of the name
// indicates the type of the formal parameter.
void templ_compilation::collect(Pname n)
{
// The grammar alone should be sufficient to protect against undesirable
// types. Any additional checks go here.
n->n_template_arg = template_expr_formal ;
append_parameter(n) ;
}
// validate the type for a non-type formal, and make it a const.
static void check_non_type_formal(Pname n) {
switch (n->tp->base) {
case ZTYPE:
case CHAR:
case SHORT:
case INT:
case LONG:
case FLOAT:
case DOUBLE:
case FIELD:
case EOBJ:
case COBJ:
case TYPE:
case ANY:
{ // a basetype node
TOK bad_base = 0 ;
if (Pbase(n->tp)->b_volatile)
bad_base = VOLATILE ;
if (Pbase(n->tp)->b_typedef)
bad_base = TYPEDEF ;
if (Pbase(n->tp)->b_inline)
bad_base = INLINE ;
if (Pbase(n->tp)->b_virtual)
bad_base = VIRTUAL ;
if (bad_base)
error ("bad %k declarator forY formal %n", bad_base,n);
Pbase b = new basetype(0, 0) ;
*b= *Pbase(n->tp) ;
b->b_const = 1 ;
n->tp = b ;
break ;
}
case PTR:
{ Pptr b = new ptr(0,0) ;
*b = *Pptr(n->tp) ;
b->rdo = 1;
n->tp = b ;
break ;
}
case RPTR:
case VEC:
break; // constant by definition
default:
error ("badZT %t for formalZ %n", n->tp, n);
}
return ;
}
// The template parameters if any, have been parsed. Member function templates
// may choose to default their template arguments to the class arguments, if
// so, make the defaulting happen.
void templ_compilation::enter_parameters()
{
for (Plist list = params ; list ; list = list->l) {
Pname n = list->f ;
switch(n->n_template_arg) {
case template_type_formal:
// Set them up for restoration
modified_tn = new name_list(n,modified_tn);
// Bring the names out of hiding
n->n_key = 0 ;
break ;
case template_expr_formal:
check_non_type_formal(n) ;
n->tp->dcl(gtbl) ;
break ;
case template_expr_tree_formal:
case template_stmt_tree_formal:
// simply note it, the guts of the processing takes place when the
// copy of the syntax tree is generated.
break ;
default:
error ('i', "badY formal" ) ;
}
}
// Save away the list of modified_tn, since the body processing will clobber
// it.
param_tn = modified_tn ;
modified_tn = 0 ;
}
// Resolve the forward declaration of a template to its true definition. The
// template and class type data structures must be reused, since there may be
// outstanding references to them.
void templ::resolve_forward_decl(Plist params, Pclass c) {
check_formals(params) ;
formals = params ;
defined = true ;
definition_number = ++ definition_tick ;
members = c->mem_list ;
}
void templ::instantiate_forward_decl() {
for (Ptempl_inst i = insts ; i ; i = i->next)
if (Ptclass(Pbase(i->tname->tp)->b_name->tp)->class_base ==
instantiated_template_class &&
! i->forward)
{ // reinstantiate it
i->instantiate(true) ;
}
}
// verify thet the qualifier used to declare the member function matches the
// template arguments in name, ie.
// template <class P, class Q, ..> c<P,Q,..>::member_function() {}
// match it's Ps and Qs.
bool templ_inst::check_qualifier(Plist formals)
{
Pexpr actual = actuals ;
for (Plist formal = formals ; formal && actual ; formal = formal->l,
actual = actual->e2)
switch (formal->f->n_template_arg) {
case template_type_formal:
{ Pbase b = Pbase(actual->e1->tp) ;
if (! ((b->base == TYPE) &&
(b->b_name->base == TNAME) &&
(strcmp (Pname(b->b_name)->string, formal->f->string) == 0)))
return false ;
break ;
}
case template_expr_formal:
if (! ((actual->e1->base == NAME) &&
(strcmp(Pname(actual->e1)->string, formal->f->string) == 0)))
return false ;
break ;
case template_expr_tree_formal:
case template_stmt_tree_formal:
default:
error ('i',"badY formal") ;
}
return true ;
}
// make the class template visible when compiling the template class
// defintion, so that it can be refernced while compiling the class body.
void templ_compilation::introduce_class_templ(Pname namep)
{
owner = is_template(namep) ;
// create a template definition if one did not already exist, due to a
// forward declaration
if (!owner){
owner = new templ(params, namep) ;
Pname lookup_name = templp->templates->insert(new name(namep->string), 0);
lookup_name->tp = Ptype(owner) ; // lie, to permit use of the table
}
}
// The body of the template has been parsed. Finish the definition of the
// template class.
void templ_compilation::end(Pname p)
{
bool forward_definition = false ;
// Restore the name environment to the state before the template parameters
// were processed.
modified_tn = param_tn ;
restore() ;
modified_tn = 0 ;
if (curr_tree_template) {
// create an expression template
new tree_template(curr_tree_template,
p->string, params, p->n_initializer, templ_refs) ;
}else {
if (!p->tp) {
error ("aC, orMF definition wasX") ;
return ;
}
switch(p->tp->base){
case CLASS:
// Create the template type to represent the parsed template, and enter it
// into the global table. This is achieved simply by modifying the TNAME
// that was entered into ktbl to represent the class definition.
Pname namep = ktbl->look(p->string, 0) ;
// check for nested definitions, they aren't supported currently. 2.1 is
// a good time to start supporting them, since they are nested for real.
for (Pname nn = Pclass(p->tp)->mem_list ; nn ; nn = nn->n_list)
switch (nn->base) {
case NAME:
switch(nn->tp->base) {
case CLASS:
error("CD %s not permitted within a ZizedC", nn->string) ;
break ;
case ENUM:
error("enumD %s not permitted within a ZizedC", nn->string) ;
break ;
}
break ;
case TNAME:
error("typedef %s not permitted within a ZizedC", nn->string) ;
break ;
}
owner = is_template(namep);
if (owner) {
Pclass c = Pclass(owner->basetype()->b_name->tp) ;
// ignore it, if it is a forward declaration following a real
// definition
if (owner->defined && (Pclass(p->tp)->mem_list != owner->members))
error("YC %s multiply defined", p->string) ;
forward_definition=bool((c->defined & DEF_SEEN) && (!owner->defined));
if (forward_definition) owner->resolve_forward_decl(params, c) ;
}else
// a forward declaration
introduce_class_templ(namep) ;
if (templ_refs) owner->templ_refs = templ_refs ;
break ;
case FCT:
{ Pname qual = p->n_qualifier ;
// the function must belong to a declared template class
if (! qual) {
error('s', "onlyYMFs may beZized currently") ;
return ;
}
if (qual->tp && (qual->tp->base == COBJ))
switch (get_class_base(Pbase(qual->tp))) {
case uninstantiated_template_class:
owner = Ptclass(Pbase(qual->tp)->b_name->tp)->inst->def ;
// verify that the formals specified, match the template formals
// in name, note that the length was already matched when the
// instantiation was generated.
if (!get_template_class
(Pbase(qual->tp))->inst->check_qualifier(params))
error ("QrZs must match theY formals") ;
break ;
case template_class:
// the template reference was without any of the formals
owner = is_template(qual) ;
if (! owner->has_tree_expr_formals())
error('w',"Qr %n for %n must specifyYZs", qual, p) ;
break ;
default:
error ("Qr %n for %n wasn't aYC", qual, p) ;
return ;
}
Pfunt ft= owner->collect_function_member(p) ;
if (! Pfct(p->tp)->body)
error ("theYFM %n must have a body", p) ;
ft->templ_refs = templ_refs ;
ft->formals = params ;
owner->check_formals(params) ;
break ;
}
default: error ("C, or MF definitionX.") ;
}
}
// Note the template references from this definition
clear_ref_templ() ;
param_end = params = 0; // Indicates the end of template processing.
curr_tree_template = 0 ;
if (forward_definition) owner->instantiate_forward_decl() ;
owner = 0 ;
}
// Clear the list of templates referenced during the syntax analysis of a top
// level definition. Note that since this list is produced during syntax
// analysis, it does not recognize instantiations that may actualy turn out to
// be identical at instantiation after the substitution of actual parameters.
// Thus, the list may be longer than it would be after actual argument
// substitution.
void templ_compilation::clear_ref_templ() {
for (Pcons p = templ_refs ; p ; p = p->cdr)
Ptempl_inst(p->car)->refp = false ;
templ_refs = 0 ; last_cons = 0 ;
}
// Instantiate templates that were referenced by a non-template definition,
// after syntax analysis has been completed on it.
void templ_compilation::instantiate_ref_templ() {
for (Pcons p = templ_refs ; p ; p = p->cdr)
Ptempl_inst(p->car)->instantiate() ;
clear_ref_templ() ;
}
// Compile all template member body instantiations. Set in motion the
// compilation of the graph of instantiation bodies. Note that compilation of
// a body may in turn initiate the instantiation of templates that had not
// previously been instantiated.
void templ_compilation::end_of_compilation() {
bool change = false ;
do {
change = false ;
for (Ptempl p = list ; p ; p = p->next)
change = ( change | p->instantiate_bodies() ? true : false);
} while (change) ;
}
// A predicate to validate that a tname without template parameters is legit
// in the scope, ie. that it does not need actual template arguments.
// Currently, a tname without parameters is ok within the class definition,
// but parameters are required within the member definition. They should not
// be required within the member function either to be consonance with their
// use in the class definition.
Pname templ_compilation::check_tname(Pname p) {
Ptempl t = is_template(p) ;
if (p->n_template_arg) p->n_used++ ;
if (!t) return p ;
if (in_progress && ((owner && (owner->namep == p)) ||
(!owner && t->basetype()->b_name->tp == ccl)))
return p ;
error ("%n needs Y instantiationAs.", p) ;
return p ;
}
// This function determine when the parameters specified to a template are
// redundant, and really refer to the current template class. Thus,
//
// template c<class p1, class p2> c<p1,p2>::foo { ... } ;
// has the redundant template specification c<p1, p2> and can simply be a
// reference to a "c" instead,
bool templ_compilation::current_template(Pname p, Pexpr actuals) {
if (in_progress &&
((owner && (owner->namep == p)) ||
(!owner && ((p->tp->base == COBJ) &&
(Pbase(p->tp)->b_name->tp == ccl)))))
{ // Check whether the formal and actual types are identical
Pexpr actual = actuals;
for (Plist formal = params ; formal && actual ; formal = formal->l,
actual = actual->e2)
if ((formal->f->tp == actual->e1->tp) ||
((actual->e1->tp && (actual->e1->tp->base == TYPE)) &&
(Pbase(actual->e1->tp)->b_name->tp == formal->f->tp)))
continue ;
else break ;
if (!formal && !actual) return true ;
}
return false ;
}
// Add a new member function to the list of functions for the template class.
Pfunt templ::collect_function_member(Pname fname) {
PERM(fname) ; PERM(fname->tp) ; PERM(Pfct(fname->tp)->body) ;
return new function_template (*this, templp->params, fname) ;
}
// Check the formals specified for a member function or a forward definition
// of a class, against the formals for the class.
void basic_template::check_formals(Plist f2) {
for (Plist f1 = formals; f1 && f2 ; f1 = f1->l, f2 = f2->l)
if (f1->f->base != f2->f->base)
switch (f1->f->n_template_arg) {
case template_type_formal:
error ("Y formalZ mismatch,\
%n must be a type formal parameter.", f2->f) ;
break ;
case template_expr_formal:
error ("formalZ mismatch, %n must be aZ ofT %t",
f2->f, f2->f->tp) ;
break ;
case template_expr_tree_formal:
case template_stmt_tree_formal:
error ("formalZ mismatch, %n must be anE formalZ",
f2->f) ;
break ;
default:
error ("formalZ mismatch betweenC formal: %n andM formal: %n", f1->f, f2->f) ;
}else if (f1->f->n_template_arg == template_expr_formal) {
// the types should be identical
if (f1->f->tp->check(f2->f->tp, 0) == 1)
error ("type mismatch betweenM formal %n, andC formal %n", f2->f, f1->f) ;
}
if (f1)
error ("insufficient formalZs,CZ parameter %n onwards are missing", f1->f) ;
if (f2)
error ("excess formalZs,Z %n onwards not defined forC", f2->f) ;
}
// predicate to determine whether the template has expression tree formals
bool templ::has_tree_expr_formals() {
for (Plist formal= formals; formal ; formal = formal->l)
if (formal->f->n_template_arg == template_expr_tree_formal)
return true ;
return false ;
}
// Check that those formals that require class actual arguments, due to their
// use in member function bodies get them.
bool basic_template::check_constraints(Pexpr actual)
{
bool ret = true ;
for (Plist formal = formals ; formal && actual ; formal = formal->l,
actual = actual->e2)
if ((formal->f->n_template_arg == template_type_formal) &&
formal->f->n_template_formal_must_be_class) {
Pname n = Pname(actual->e1) ;
if (n && n->tp && n->tp->is_cl_obj())
continue ;
error("expected aCT actual, not %t, for the \"TT\" formal %s",
n->tp, formal->f->string);
ret = false ;
}
return ret ;
}
// Check actual template arguments, against the formals.
bool templ::check_actual_args(Pexpr actual)
{
for (Plist formal = formals ; formal && actual ; formal = formal->l,
actual = actual->e2)
switch (formal->f->n_template_arg) {
case template_type_formal:
{
// A "type type" parameter, any actual type that was accepted by the
// parse is acceptable here, just make sure that it is indeed a type.
// If it was parsed as a type, the grammar should have created a name
// node, and attached the type to it, having marked the name as a
// template_actual_arg_dummy.
Pname n = Pname(actual->e1) ;
if (!((n->base == NAME) &&
(n->n_template_arg == template_actual_arg_dummy))) {
error ("Y %s A mismatch, the Y formal:%n\
required aT actualZ.", namep->string, formal->f) ;
// recover from the error with a safe expression
n = new name("") ;
n->tp = any_type ;
actual->e1 = n ;
}
if ((formal->f->n_template_formal_must_be_class) &&
!(n->tp && n->tp->is_cl_obj()))
error("expected aCT actual, not %t, for the \"TT\" formal %s",
n->tp, formal->f->string) ;
break ;
}
case template_expr_formal:
// checking can only be done at instantiation, so postpone it
break ;
case template_expr_tree_formal:
case template_stmt_tree_formal:
// anything is acceptable, it is a case of "implementor beware". Any
// illegalities will only be detected when dcl processing takes place.
break ;
default:
error ('i',"badY formal") ;
}
// If we provide for optionals, this is where the processing should get done.
if (formal)
error ("too fewAs supplied forY %s", namep->string) ;
if (actual && actual->e1) {
error ("too manyAs supplied forY %s", namep->string) ;
}
return bool(~(formal || actual)) ;
}
// Append to the list of references.
void templ_compilation::append_ref(Ptempl_inst ref)
{ cons *p = new cons(ref,0) ;
if (last_cons)
last_cons->cdr = p ;
else templ_refs = p ;
last_cons = p ;
} ;
// Note the reference by a definition to the template, so that the template
// can be instantiated before the definition is processed.
Ptempl_inst templ_inst::note_ref()
{ if ((! refp)) {
refp = true ;
templp->append_ref(this) ;
}
return this ;
}
// Get an instantiation for the template with the given set of actuals. If one
// exists, return it, otherwise create a new one.
Ptempl_inst templ::get_inst(Pexpr actuals, Ptempl_inst exclude)
{ Ptempl_inst inst = get_match(actuals, exclude, false) ;
return (inst ? inst : new templ_inst(actuals, this))->note_ref() ;
}
// Find an instantiation that has the same set of actuals, exclude the
// instantaition passed in from the set of candidates
Ptempl_inst templ::get_match(Pexpr actuals,
Ptempl_inst exclude, // don't match this one
// Only instantiated templates match
bool match_instantiated_only)
{
for (Ptempl_inst p = insts ; p ; p = p->next)
if ((p != exclude) &&
(p->actuals_match(actuals)) &&
(match_instantiated_only ?
(Pclass(Pbase(p->tname->tp)->b_name->tp)->class_base ==
instantiated_template_class)
: true))
return (p->forward ? p->forward : p) ;
return NULL ;
}
// provides the basetype created for a given set of actuals.
Pbase templ::inst_basetype(Pexpr actuals)
{
return (check_actual_args(actuals) ?
Pbase(get_inst(actuals)->tname->tp) : basep) ;
}
// Validate that the name denotes a parametrized type, and prodouce a TNAME
// for the instantiation.
Pname parametrized_typename (Pname p, Pexpr actuals)
{
Ptempl t = templp->is_template(p) ;
// A template instantiation with redundant actuals identical to the formals
// of the current template
if (templp->current_template(p, actuals)) return p ;
if (t) {
Pname tname = t->typename(actuals) ;
return (tname ? tname : p) ;
}
error ("%n hasTAs but is not aZizedC", p) ;
return p ;
}
Pbase parametrized_basetype (Pname p, Pexpr actuals)
{ Ptempl t = templp->is_template(p) ;
// A template instantiation with redundant actuals identical to the formals
// of the current template
if (templp->current_template(p, actuals)) return Pbase(p->tp) ;
if (t) return t->inst_basetype(actuals) ;
error ("%n is not aZizedC", p) ;
return new basetype(TYPE, p);
}
// Similar primitive for obtaining the typename associated with an
// instantiation.
Pname templ::typename(Pexpr actuals)
{
return (check_actual_args(actuals) ? get_inst(actuals)->tname : 0) ;
}
// predicate to get past all the type nodes
static Ptype real_type (Ptype t)
{
while (t->base == TYPE) t = Pbase(t)->b_name->tp ;
return t ;
}
static int expr_match(Pexpr a1, Pexpr a2) ;
// Check whether the actuals provided match the actuals for this instantiation.
// The actuals match the formals, iff they are the same type or parametrized
// type.
bool templ_inst::actuals_match(Pexpr check_actuals)
{ Pexpr ae1, ae2 ; // the cons cells
Plist formal = def->formals ;
// The lists should be the same length, since check_actuals will have taken
// appropriate action.
for (ae1=actuals, ae2=check_actuals ; formal && ae1 && ae2 ;
ae1=ae1->e2, ae2=ae2->e2, formal = formal->l)
switch (formal->f->n_template_arg) {
case template_type_formal:
{ Ptype t1 = ae1->e1->tp, t2 = ae2->e1->tp ;
if (t1->check(t2,255) == 1)
return false ;
break ;
}
case template_expr_formal:
if (! expr_match(ae1->e1, ae2->e1)) return false ;
break ;
case template_expr_tree_formal:
case template_stmt_tree_formal:
// these are internal instantiations and consequently never match
return false ;
default:
error ('i', "bad template formal") ;
}
return true ;
}
extern char emode ;
// This set of overloaded fuctions are used to accumulate name strings
void stradd(char *&target, char *source) {
while (*target++ = *source++) ;
target-- ;
}
void stradd(char *&p, long i) {
if (!emode) {
*p++ = 'L' ;
}
char s[16] ;
sprintf(s,"%ld", i) ;
stradd(p,s) ;
}
void stradd(char *&p, Pname n) {
if (!emode){
char s[256] ;
sprintf(s,"%d", strlen(n->string)) ;
stradd(p,s) ;
}
stradd(p, n->string) ;
}
// produce a unique string suitable for use within a name; if in emode ie.
// printing in the context of an error, print a pretty name instead.
char * mangled_expr(char *p, Pexpr e, bool mangle_for_address = false)
{
static int mangle_address = 0 ;
if (e == 0) return p;
switch (e->base) {
case ADDROF:
case G_ADDROF:
// unary using e2
// rely on the
mangle_address++ ;
p = mangled_expr(p, e->e2) ;
mangle_address -- ;
break ;
case NAME:
if (mangle_address || mangle_for_address)
stradd(p, Pname(e)) ;
else if (Pname(e)->n_evaluated)
stradd(p, Pname(e)->n_val) ;
else if (Pname(e)->n_initializer)
p = mangled_expr(p, Pname(e)->n_initializer, mangle_for_address) ;
else error ('i', "couldn't mangle %n", e) ;
break ;
case IVAL:
stradd(p, ((ival *)e)->i1) ;
break ;
case CAST:
{ // an IVAL hiding below the cast ?
if (e->e1->base == IVAL)
stradd(p, ((ival *)e->e1)->i1) ;
else error ('i', "unexpected cast") ;
break ;
}
case ICON:
case CCON:
case FCON:
*p++ = 'L' ;
strcpy(p, e->string) ;
// Sam: there needs to be a better encoding scheme, but it can wait.
if (!emode)
while (*p)
if (! (isalnum(*p)))
switch(*p) {
case '+':
*p++ = 'p' ;
break ;
case '-':
*p++ = 'm' ;
break ;
case '.':
*p++ = 'D' ;
break ;
case 'e':
*p++ = 'E' ;
break ;
default:
error ('i', "bad character in constant") ;
break ;
} else p++ ;
break ;
case ZERO:
*p++ = '0' ;
break ;
default:
error ('i', "can't mangle %k", e->base) ;
}
return p ;
}
// this function is invoked once at the top level
char *mangled_expr(char *p, Pname n) {
if (n->n_evaluated) {
stradd(p, n->n_val) ;
return p ;
}
return mangled_expr(p, n->n_initializer,
(real_type(n->tp)->base == PTR ? true : false)) ;
}
// Generate a template instantiation name suitable for printing when it is
// presented to the user.
void templ_inst::print_pretty_name()
{
extern char emode ;
fprintf(out_file, " %s<", (def->namep ? def->namep->string : "?")) ;
Plist formal = inst_formals ;
emode ++ ; // so that dcl_print generates c++ rather than c names
for (Pexpr ae1=actuals; formal && ae1 ; ae1=ae1->e2, formal = formal->l) {
switch (formal->f->n_template_arg) {
case template_type_formal:
ae1->e1->tp->dcl_print(0) ;
break ;
case template_expr_formal:
{ char buff[256] ;
mangled_expr(buff, ae1->e1) ;
fprintf(out_file, "%s", buff) ;
break ;
}
case template_expr_tree_formal:
case template_stmt_tree_formal:
// doesn't participate in the name generation
break ;
default:
error ('i', "unexpected formal") ;
}
// this comma is unfortunately misplaced, since it follows a space printed
// out by dcl_print
if (formal->l) fprintf(out_file, ", ") ;
}
fprintf(out_file, ">") ;
emode -- ;
}
// there are different representations for ICON based upon whether it has been
// evaluated.
int check_for_const(Pexpr a1, Pexpr a2) {
Neval = 0 ;
if ((a1->base == NAME) &&
((a2->base == ICON) || (a2->base == IVAL) || (a2->base == ZERO)))
{ Pname n = Pname(a1) ;
return (n->n_evaluated && (n->n_val == a2->eval())) ;
}else if (((a1->base == ICON) || (a1->base == IVAL) || (a1->base == ZERO))
&& (a2->base == NAME))
{ Pname n = Pname(a2) ;
return (n->n_evaluated && (n->n_val == a1->eval())) ;
}
return false ;
}
// get past the template parameter names to get the the real expression
static Pexpr real_expression(Pexpr e)
{
while (e && (e->base == NAME) &&
(Pname(e)->n_template_arg == template_expr_formal) &&
(! Pname(e)->n_evaluated) && Pname(e)->n_initializer)
e = Pname(e)->n_initializer ;
return e ;
}
// determine whether two expressions supplied as actual arguments to
// a "template_expr_formal" formal argument match.
static int expr_match(Pexpr a1, Pexpr a2)
{
static int addr_of = 0 ;
a1 = (addr_of ? a1 : real_expression(a1)) ;
a2 = (addr_of ? a2 : real_expression(a2)) ;
if (a1 == a2) return true;
//
if (a1->base != a2->base) return check_for_const(a1, a2) ;
switch (a1->base) {
case QUEST:
// a ternary operator
return ( expr_match(a1->cond, a2->cond) &&
expr_match(a1->e1, a2->e1) &&
expr_match(a1->e2, a2->e2)) ;
case PLUS: case MINUS: case MUL: case DIV: case MOD:
case ER: case OR: case ANDAND: case OROR:
case LS: case RS:
case EQ: case NE: case LT: case LE: case GT: case GE:
// binary operator
return (expr_match(a1->e1, a2->e1) &&
expr_match(a1->e2, a2->e2)) ;
case UMINUS: case UPLUS:
case NOT: case COMPL:
return (expr_match(a1->e2, a2->e2)) ;
case ADDROF:
{
// unary using e2
addr_of ++ ;
int result = (expr_match(a1->e2, a2->e2)) ;
addr_of -- ;
return result ;
}
case CAST:
return (expr_match(a1->e1, a2->e1)) ;
case NAME:
if (! addr_of) {
Pname n1 = Pname(a1), n2 = Pname(a2) ;
if ((n1->n_evaluated) && n2->n_evaluated && (n1->n_val == n2->n_val))
return true ;
if (n1->n_initializer && (! n2->n_initializer))
return check_for_const(n2, n1->n_initializer) ;
if (n2->n_initializer && (! n1->n_initializer))
return check_for_const(n1, n2->n_initializer) ;
if (n1->n_initializer && n2->n_initializer)
return expr_match(n1->n_initializer, n2->n_initializer) ;
}
return false ;
case DOT:
return (expr_match(a1->e1, a2->e1)) ;
case REF:
return (expr_match(a1->e1, a2->e1)) ;
case IVAL:
return (ival *)a1->i1 == (ival *)a2->i1 ;
case ICON:
case CCON:
case FCON:
case STRING:
return (strcmp (a1->string, a2->string) == 0) ;
case ZERO:
return true ;
case SIZEOF:
{ long l1 = a1->eval(), l2 = a2->eval() ;
return (l1 == l2) ;
}
}
return false ;
}
static char * non_type_argument_signature(Pexpr e, char *p) {
p = e->tp->signature(p) ;
return mangled_expr(p, e) ;
}
// generate array suffix information for an array signature. cfront does not
// normally generate this as part of the type signature, since it only deals
// with argument signatures, and arrays can't be arguments.
static void add_array_type_suffix(char *&s, Ptype t) {
t = real_type(t) ;
if (t->base == VEC) {
Pvec v = Pvec(t);
int dim;
char a[32] ;
Neval = 0 ;
if(v->dim == 0)
dim = v->size / v->typ->tsizeof();
else dim = (int)v->dim->eval();
sprintf(a, "A%d", dim) ;
stradd(s,a) ;
add_array_type_suffix(s, Pvec(t)->typ);
}
}
// Generate a mangled template instantiation name. The syntax of as template
// mangled class name is of the form:
// original_name__<argument type signatures>__unique_id
// Each non-type argument is replaced by a unique id.
char *templ_inst::mangled_name(char *ip)
{ static tree_formal_id = 0 ;
char *start = ip ;
ip = start ;
strcpy(ip, (def->namep ? def->namep->string : "?")) ;
ip= start + strlen(start) ;
stradd(ip, "__pt__") ;
{
char a [max_string_size], *p = a ;
Plist formal = inst_formals ;
for (Pexpr ae1=actuals ; ae1 ; ae1=ae1->e2, formal = formal->l)
switch (formal->f->n_template_arg) {
case template_expr_formal:
*p++ = 'X' ;
// the formal must have been bound
p = non_type_argument_signature(formal->f, p) ;
break ;
case template_type_formal:
p = ae1->e1->tp->signature(p) ;
add_array_type_suffix(p,ae1->e1->tp) ;
break ;
case template_expr_tree_formal:
case template_stmt_tree_formal:
*p++ = 'Y' ;
stradd(p, tree_formal_id++) ;
break ;
default:
error ("bad template formal:%d", formal->f->base) ;
break ;
}
*p = 0 ;
sprintf(ip, "%d_", strlen(a)+1) ;
ip = start + strlen(start) ;
strcpy(ip,a) ;
}
return start ;
}
// The C compiler barfs when it is passed on through C++ as an automatic
// variable
const char leader[]= "\t" ;
// Explain the location of an instantiation in greater detail, since it may be
// far removed from it's textual definition.
void templ_inst::print_error_loc() {
if (! head) return ; // No active instantiations
extern void print_loc() ;
state current_state ;
char buffer[max_string_size] ;
for (int i = 0 ; i < max_string_size; i++) buffer[i] = 0 ;
current_state.save() ;
fprintf (out_file, "%sanomaly detected during the instantiation of",
leader) ;
print_pretty_name() ;
fprintf(out_file, "\n") ;
if (!head->next_active) {
// A more compact message for a single level of instantiation
context.restore() ;
fprintf (out_file, leader) ;
print_loc() ;
fprintf (out_file, "was the site of the instantiation\n") ;
}else {
// The instantiation chain is longer than one
fprintf (out_file, "%sthe instantiation path was:\n", leader) ;
for (Ptempl_inst p = head ; p ; p = p->next_active) {
p->context.restore() ;
print_loc() ;
fprintf (out_file, " template:") ;
p->print_pretty_name() ;
fprintf(out_file, "\n") ;
}
}
current_state.restore() ;
}
// Generate a class name for the instantiated class. It is constructed in a
// manner similar to the names used in the construction of overloaded functions
char *templ_inst::instantiation_string() {
char inst_name[max_string_size] ;
for (int i = 0 ; i < max_string_size; i++) inst_name[i] = 0 ;
mangled_name(inst_name) ;
return strdup(inst_name) ;
}
// Change the names for the class, constructors, and destructors to reflect
// the new class instantiation name.
void classdef::modify_inst_names(char *s)
{
char *old = string ;
string = s ; // Change the class name
// Change the constructor names
for (Pname p=mem_list; p; p=p->n_list)
if (p->tp && (p->tp->base==FCT) && (!strcmp(old, p->string)))
p->string = s ;
}
// Get past the fake template argument name typename types
Ptype non_template_arg_type(Pbase t) {
if ((t->base == TYPE) &&
(t->b_name->n_template_arg == template_type_formal))
return non_template_arg_type(Pbase(t->b_name->tp)) ;
else return t ;
}
// follow the chain until we hit a non
void non_template_arg_non_type(Pname n) {
Pexpr i = n->n_initializer;
while (i &&
(i->base == NAME) &&
(Pname(i)->n_template_arg == template_expr_formal))
{
if (Pname(i)->n_initializer) {
n->n_initializer = Pname(i)->n_initializer ;
i = n->n_initializer ;
continue ;
}
if (Pname(i)->n_evaluated) {
n->n_evaluated = 1 ;
n->n_val = Pname(i)->n_val ;
return ;
}
}
return ;
}
// Now that the actuals are truly resolved, ie. semantics is complete, and the
// template is about to be instantiated.
void forward_template_arg_types(Plist formal, Pexpr actuals)
{
for (Pexpr actual = actuals ; formal && actual ;
formal = formal->l, actual = actual->e2)
switch(formal->f->n_template_arg){
case template_type_formal:
actual->e1->tp = non_template_arg_type(Pbase(actual->e1->tp)) ;
break ;
case template_expr_formal:
break ;
case template_expr_tree_formal:
case template_stmt_tree_formal:
break ;
default:
error ('i', "bad template formal") ;
}
}
// determine whether the expression supplied as an actual argument to
// atemplate formal of type "template_expr_formal" is suitable. We are nore
// restrictive than we need to be, simply so that the debugger can have an
// easier time. All expressions must be of the form constant integer
// expression, a float or double literal, or the address of a variable, or an
// array, or function
static int suitable_const_expr(Pname n)
{
if (n->n_evaluated) return 1 ;
if (!n->n_initializer) return 0 ;
switch (n->n_initializer->base) {
case CAST:
{ // if it is a cast of an integer value, it's fine.
if (n->n_initializer->e1->base == IVAL)
return 1 ;
else return 0 ;
}
case FCON:
case ZERO:
return 1 ;
case ADDROF:
case G_ADDROF:
{
Pname an = Pname(n->n_initializer->e2) ;
if (an->base != NAME) return 0 ;
if (an->n_stclass == STATIC) return 1 ;
return 0 ;
}
case NAME:
{
Pname an = Pname(n->n_initializer) ;
if ((an->n_stclass == STATIC) &&
(an->tp->base == VEC))
// assumes that decl processing won, so that the formal could only
// have been apointer
return 1 ;
return 0 ;
}
default:
return 0 ;
}
}
static bool is_stmt_node(Pnode p) {
if (!p) return false ;
switch(p->base) {
case BREAK: case CONTINUE: case DEFAULT:
case SM: case WHILE: case DO: case SWITCH: case RETURN: case CASE:
case FOR:
case IF:
case BLOCK:
case PAIR: // ?
return true ;
}
return false ;
}
static void bind_tree_expr_formal(Pname f, Pexpr actual)
{
if (actual->e1->base == TNAME)
error ('i', "a TNAME is not a valid argument for the formal %n",
f) ;
if (is_stmt_node(actual->e1)) {
error ("an expression node was expected for the expression formal parameter %n", f) ;
actual->e1 = zero ;
}
// bind the formal to the expression, it will be accessed from here by
// the hook function during the copy
f->n_initializer = actual->e1 ;
}
// Bind the formals to the types passed in as the actuals, for the
// instantiation, bind the non-type names to their expressions.
void templ_inst::bind_formals()
{ Pexpr actual ;
Plist formal ;
for (formal = inst_formals, actual = actuals ;
formal && actual ; formal = formal->l, actual = actual->e2)
switch (formal->f->n_template_arg) {
case template_type_formal:
{
formal->f->tp = non_template_arg_type(Pbase(actual->e1->tp)) ;
PERM(formal->f->tp) ;
break ;
}
case template_expr_formal:
{
actual->e1 = actual->e1->typ(gtbl);
if (formal->f->tp->check(actual->e1->tp,ASSIGN) == 1)
error("template argument mismatch, expected %t for formal %n, not %t",
formal->f->tp, formal->f, actual->e1->tp) ;
// hide the global name around decl processing of the formal name
Pname g = gtbl->look (formal->f->string, 0) ;
if (g) g->n_key = HIDDEN ;
// bind the non type arguments to their expressions
// parameters that are bound at syntax analysis, these parameters are
// bound during dcl processing, so ensure that they can be found.
formal->f->n_initializer = actual->e1 ;
formal->f->simpl() ;
formal->f = formal->f->dcl(gtbl, STATIC) ;
formal->f->n_key = HIDDEN ;
PERM(formal->f) ;
non_template_arg_non_type(formal->f) ;
if (!suitable_const_expr(formal->f))
error("template argument for formal:%s, is not a suitable constant.",
formal->f->string) ;
if (g) g->n_key = 0 ;
break ;
}
case template_expr_tree_formal:
{
bind_tree_expr_formal(formal->f, actual) ;
break ;
}
case template_stmt_tree_formal:
{
error("a statement tree may not be specified for a class template") ;
break ;
}
default:
error ('i', "bad template formal") ;
}
// now that the formals are bound, compute the instantiation string
char *inst_name = instantiation_string() ;
tname->string = instantiation_string() ;
for (formal = inst_formals; formal ; formal = formal->l)
if (formal->f->n_template_arg_string)
error('i', "attempt to bind a template parameter multiple times") ;
else
formal->f->n_template_arg_string =
strcat(strcpy(calloc(strlen(formal->f->string)+strlen(inst_name)+1,1),
formal->f->string), inst_name) ;
}
// Expose the non-type parameter names so that they are visible during decl
// processing. Conflicting global names are hidden, so that they are not
// found.
void templ_inst::expose_parameter_names() {
if (hidden_globals)
error ('i', "an expose without a hide of global names") ;
for (Plist formal = inst_formals ; formal ; formal = formal->l)
if (formal->f->n_template_arg == template_expr_formal) {
// Hide any visible globals
Pname gname = gtbl->look(formal->f->string, 0) ;
if (gname) {
// an existing global name, hide it
gname->n_key = HIDDEN ;
// note them for future restoration
hidden_globals = new name_list(gname,hidden_globals);
}
formal->f->n_key = 0 ; // bring it out of hiding
if (formal->f != gtbl->look(formal->f->string,0))
error('i', "parameter could not be located in the global table") ;
}
}
// Hide the non-type parameter names after an instantiation, and restore any
// globals that may have been hidden during the process.
void templ_inst::hide_parameter_names() {
for (Plist formal = inst_formals ; formal ; formal = formal->l)
if (formal->f->n_template_arg == template_expr_formal) {
formal->f->n_key = HIDDEN ;
}
for (; hidden_globals; hidden_globals= hidden_globals->l)
hidden_globals->f->n_key= 0 ;
hidden_globals = 0 ;
}
// Primitives for saving and restoring the compilation state around a template
// instantiation. It also maintains the stack of template instantiations.
void templ_inst::save_state(Pname p) {
if (next_active) error ('i', "circular instantiation of a template") ;
context.save() ;
if (templ_inst::head)
templ_inst::head->hide_parameter_names() ;
next_active = templ_inst::head ; templ_inst::head = this ;
context.init() ;
Cdcl = p ; Cstmt = NULL ;
curr_file = (Cdcl) ? Cdcl->where.file : 0;
expose_parameter_names() ;
}
void templ_inst::restore_state() {
context.restore() ;
hide_parameter_names() ;
templ_inst::head = next_active ; next_active = NULL ;
if (templ_inst::head)
templ_inst::head->expose_parameter_names() ;
}
// Copy over the class definition subtree starting from COBJ down to the
// CLASSDEF node. This minimal subtree has to exist during syntax analysis,
// and already contains pointers into it.
void templ_inst::kludge_copy(Pbase pbc)
{
// copy just the COBJ ->b_name NAME ->tp CLASS path for now, note that the
// preceding path of the tree is pre-allocated, since syntax analysis needs
// to generate pointers to these objects.
Pbase pb = Pbase(tname->tp) ;
Pname save_b_name = pb->b_name ;
Ptype save_tp = pb->b_name->tp ;
if ((pb->base != COBJ) || (pbc->base != COBJ))
error ('i', "cobj nodes were expected here") ;
*pb = *pbc ;
pb->b_name = save_b_name ;
*pb->b_name = *pbc->b_name ;
pb->b_name->tp = save_tp ;
*Pclass(pb->b_name->tp) = *Pclass(pbc->b_name->tp) ;
Pclass(pb->b_name->tp)->class_base = instantiated_template_class ;
}
// these statics probably belong in templ_inst and shouldn't be dangling
// around
static Pbase cobj_node ;
static Pname cname_node ;
static Pclass class_node ;
static void syntax_tree_copy_hook(void *,
Pnode &,
node_class,
tree_node_action &action,
int& never_see_again)
{
never_see_again = 1;
action = tna_continue;
return;
}
// create a copy of the expression tree
static Pnode copy_syntax_tree(Pnode n, int no_types = 0) {
pointer_hash cht(default_copy_hash_size) ;
tree_copy_info info ;
if(no_types) info.node_hook = syntax_tree_copy_hook;
copy_tree (n, info, &cht);
return n ;
}
// hook to perform the copying of the pre-allocated class subtree
bool templ_inst::copy_hook(Pnode &node)
{
switch (node->base) {
case COBJ:
if (node == cobj_node) return false ;
if (node == def->namep->tp) {
*cobj_node = *Pbase(node) ;
node = cobj_node ;
}
break ;
case NAME:
if (node == cname_node) return false ;
if (node == sta_name) return false ;
if (node == Pbase(def->namep->tp)->b_name) {
*cname_node= *Pname(node) ;
node = cname_node ;
}else { // check for tree expression formals
char *s = Pname(node)->string ;
Pname f = 0 ;
if (s && (*s == '$') && (f = get_parameter(s+1)))
{
if(Pname(node)->n_list)
error ('i', "n_list set in tree template formal.");
node = copy_syntax_tree(Pname(f)->n_initializer) ;
return false ;
}
}
break ;
case CLASS:
if (node == class_node) return false ;
if (node == Pbase(def->namep->tp)->b_name->tp) {
*class_node = *Pclass(node) ;
node = class_node ;
}
break ;
}
return true ;
}
/*
This hook function used during a class copy.
*/
static void copy_hook(void /* Ptempl_inst */ *p, Pnode &node,
node_class, tree_node_action &action,
int& never_see_again)
{
action = (Ptempl_inst(p)->copy_hook(node) ? tna_continue : tna_stop ) ;
never_see_again = (action != tna_stop);
return ;
}
void establish_class_subtree_correspondence(pointer_hash &h, Pname key_tname,
Pname value_tname)
{
h[int(key_tname)] = int(value_tname) ;
h[int(key_tname->tp)] = int(value_tname->tp) ;
h[int(Pbase(key_tname->tp)->b_name)] =
int(Pbase(value_tname->tp)->b_name) ;
h[int(Pbase(key_tname->tp)->b_name->tp)] =
int(Pbase(value_tname->tp)->b_name->tp) ;
}
Pcons make_ref_copy(pointer_hash &h, tree_copy_info &info, Pcons old_templ_refs)
{
cons dummy(0,0), *last = &dummy ;
for (Pcons pc = old_templ_refs ; pc ; pc = pc->cdr) {
Ptempl_inst t = Ptempl_inst(pc->car) ;
// +**** this doesn't work without class instances of new and delete
// +**** dtor places this onto free_list: ugh
// +**** want to restore this once new/delete isntances are restored
// expr dummy(ELIST, 0, 0) ;
// elist list(&dummy) ;
Pexpr dummy = new expr(ELIST, 0, 0);
elist list(dummy);
// copy the trees corresponding to the actuals
for (Pexpr actual = t->actuals ; actual ; actual = actual->e2) {
Pnode root = actual->e1 ;
copy_tree (root, info, &h);
// make sure that references to enclosing formals are resolved
root = Pexpr(root)->typ(gtbl);
list.add(new expr(ELIST, Pexpr(root), 0)) ;
}
Pexpr new_actuals = list.head->e2 ;
// get one if it exists, create one otherwise.
Ptempl_inst treal = t->def->get_inst(new_actuals, t) ;
Pname new_tname = treal->tname ;
last = last->cdr = new cons(treal,0);
establish_class_subtree_correspondence(h, t->tname, new_tname) ;
}
return dummy.cdr ;
}
/*
Remap the template references from within the body of the template. This
action is similar to the normal tree copy operation; it would normally have
been done during the syntax phase, that produced the tree, but since there
isn't one, for the instantiated body, it must be done here.
*/
Pcons templ_inst::ref_copy(pointer_hash &h, tree_copy_info &info, Pcons old_templ_refs)
{
expose_parameter_names() ;
Pcons new_refs = make_ref_copy(h,info,old_templ_refs) ;
hide_parameter_names() ;
return new_refs ;
}
static bool is_forward_instantiation(Pbase b_base, Pbase f_base)
{
return bool(b_base->b_name->tp->defined && f_base->b_name->tp->defined) ;
}
/*****************************************************************************
* *
* If the template instantiation is found to be unique after the decl *
* processing of the actuals, create a copy of the post syntax graph for the *
* class. The edges of the graph are determined by "type nodes" that have *
* already been defined, and TNAME nodes that are in the global keyword *
* table. Special care is also taken to avoid copying nodes whose identity *
* must be maintained, since cfront uses them for fast type checks, these *
* nodes always have the "defined" flag turned on and so are never copied. *
* *
* Copying of the pre-allocated class sub-tree for the template: COBJ *
* ->b_name NAME ->tp CLASS *
* *
* is handled by the class_copy hook above, that is invoked during the course *
* of the copy. *
* *
* *
* Template references from within the class need special handling, since *
* each instantiation of the class, results in a potentially new template *
* instantiation. *
* *
*****************************************************************************/
Ptempl_inst templ_inst::class_copy(Pcons &templ_refs, bool recopy)
{
bool forward = false ; // a forward class is instantiated twice
// associate the formals with their types, and their expressions
if (recopy) {
// remove the class def node from the table, so that it's attributes are
// copied.
corr->del(int(Pbase(def->namep->tp)->b_name->tp)) ;
corr->del(int(Pbase(def->namep->tp)->b_name)) ;
corr->del(int(def->namep->tp)) ;
corr->del(int(tname->tp)) ;
corr->del(int(Pbase(tname->tp)->b_name)) ;
corr->del(int(Pbase(tname->tp)->b_name->tp)) ;
}else corr = new pointer_hash(default_copy_hash_size) ;
{ // copy the formals & install them in the correspondence table
name_list dummy_formal(0,0) ;
Plist last = &dummy_formal ;
for (Plist formal = def->formals ; formal ; formal = formal->l) {
Pname copy_name = new name("") ;
*copy_name = *formal->f ;
copy_name->n_tbl_list = 0 ;
last = last->l = new name_list(copy_name, 0) ;
(*corr)[int(formal->f)] = (int)copy_name ;
}
inst_formals = dummy_formal.l ;
}
bind_formals() ;
if ( ! recopy && ktbl->look(tname->string, 0)) {
// formal binding may result in detecting identical instantiations
Ptempl_inst ti = def->get_match(actuals, this, true) ;
if (ti) return ti ;
error('i', "Generated template instantiation name %swas not unique",
tname->string) ;
}
{
tree_copy_info info ;
info.node_hook = ::copy_hook ;
info.hook_info = this ;
(*corr)[int(def->namep)] = int(tname) ; // make the tnames correspond
templ_refs = ref_copy(*corr, info, templ_refs) ;
Pnode root = def->basep ; // start the copy at the cobj node
// deal with these nodes differently during the copy, ie. the nodes
// themselves are not copied, but their attributes are.
cobj_node = (Pbase)tname->tp ;
cname_node = Pbase( tname->tp)->b_name ;
class_node = Pclass(Pbase( tname->tp)->b_name->tp) ;
copy_tree (root, info, corr);
{ // dump the tree if the flag is set
extern int dump_tree ;
extern dcn_arg dump_tree_arg;
if (dump_tree) display_cfront_node (dump_tree_arg, root);
}
}
// Perform name modifications for the class, so that it is an
// instantiation-specific name.
cname_node->string = tname->string ;
if (!recopy)
namep = ktbl->insert(tname, 0) ;
else class_node->defined &= ~(DEFINED|SIMPLIFIED) ;
namep->tp = cobj_node;
class_node->modify_inst_names(cname_node->string) ;
return 0 ;
}
/*
This hook function is responsible for the replacement of references to
expression when copying function bodies
*/
static void function_copy_hook(void *current_templ_inst,
Pnode &node,
node_class,
tree_node_action &action,
int& never_see_again)
{
never_see_again = 1;
switch (node->base) {
case SM_PARAM:
error ('i', "statement parameters not permitted for member functions") ;
break ;
case NAME:
{
if(node == sta_name) {
action = tna_stop;
return;
}
char *s = Pname(node)->string ;
Pname f = 0 ;
if (s && (*s == '$') &&
(f = Ptempl_inst(current_templ_inst)->get_parameter(s+1))) {
if(Pname(node)->n_list)
error ('i', "n_list set in tree template formal.");
node = copy_syntax_tree(Pname(f)->n_initializer) ;
action = tna_stop ;
never_see_again = 0;
}else action = tna_continue ;
return ;
}
default:
action = tna_continue ;
return ;
}
}
/*
Create a copy of a function member, as part of the instantiation of a function
body. The correspondence table is first initialized with the contents of the
correspondence table used to instantiate the class. Copying is initiated
in this context.
*/
Pname templ_inst::function_copy(Pfunt fnt, Pcons &templ_refs)
{
pointer_hash fcorr(*corr) ; // initialize it with the old hash table
{
tree_copy_info info ;
Pnode root = fnt->fn ;
// establish a correspondence between the formals used for the class
// template, andthe formals used for the function template, all references
// to the function template formals will be replaced by references to the
// instantiated class template formals after the copy has been completed.
for (Plist fformal = fnt->formals, cformal = inst_formals ;
fformal ; fformal = fformal->l, cformal = cformal->l)
{
fcorr[int(fformal->f)] = int(cformal->f) ;
if (fcorr[int(fformal->f)] != int(cformal->f))
error ('i', "hash table bug") ;
}
info.node_hook = ::function_copy_hook ;
info.hook_info = this ;
templ_refs = ref_copy(fcorr, info, templ_refs) ;
if (fcorr[int(def->namep)] != int(tname))
error ('i', "template to instantiation typename correspondence is missing") ;
copy_tree (root, info, &fcorr);
{ // dump the tree if the flag is set
extern int dump_tree ;
extern dcn_arg dump_tree_arg;
if (dump_tree)
display_cfront_node (dump_tree_arg, root);
}
return Pname(root) ;
}
}
/*****************************************************************************
* *
* A matching template was found at instantiation time, which was not *
* detected at syntax analysis time. This can happen, when an instantiation *
* has as its arguments not real types but template arguments, so that *
* matches cannot be detected until the templates are bound. Note that it is *
* also possible to match a template that is in the process of being *
* instantiated further up the instantiation call chain. In such cases, the *
* kludge_copy operation will copy over an incomplete class subtree, which *
* will be recopied with the completed one after the instantiation is *
* completed, in templ_inst::instantiate. *
* *
*****************************************************************************/
void templ_inst::instantiate_match(Ptempl_inst match)
{ Pbase pb = Pbase(match->tname->tp) ;
kludge_copy(pb) ;
forward = match ; // Note the fact that this template was matched
}
Pclass current_instantiation = 0 ;
// Do the class declaration instantiation.
void templ_inst::instantiate(bool reinstantiate)
{
Pcons templ_refs = def->templ_refs ;
if (! reinstantiate) {
switch (Ptclass(Pbase(tname->tp)->b_name->tp)->class_base) {
case instantiated_template_class:
return ;
case uninstantiated_template_class:
break ;
case vanilla_class:
case template_class: // the canonical template class
default:
error ('i', "attempt to instantiate a non-template class") ;
}
status = class_instantiated ;
// Check whether, the template has already been instantiated, if so use it.
forward_template_arg_types(def->formals, actuals) ;
Ptempl_inst match = def->get_match(actuals, this, true) ;
if (match || (match = class_copy(templ_refs, false))){
instantiate_match(match) ;
return ;
}
}else class_copy(templ_refs, true) ;
Pbase pb = Pbase(tname->tp) ;
// Save the state around decl processing
{ save_state(def->namep) ;
if (def->open_instantiations++ > 1) {
error ("an infinite instantiation sequence was initiated") ;
def->open_instantiations-- ;
return ;
}
// Mark the class as instantiated so that there are no circular
// instantiations.
Pclass(pb->b_name->tp)->class_base = instantiated_template_class ;
// if it is a forward reference, rely on the usual compilation to
// provide an error message, if indeed it is an error, and not a
// benign forward reference such as: friend class foo<X,Y>
if (def->basep->b_name->tp->defined) {
// Put out the typedefs for the template parameters do this before the
// call to name::dcl below, since dcl processing will emit c declarations
// that make use of the type
for (Plist formal = inst_formals; formal ; formal = formal->l)
switch(formal->f->n_template_arg) {
case template_expr_tree_formal:
case template_stmt_tree_formal:
break ;
default:
formal->f->dcl_print(0) ;
}
// Instantiate the parametrized types referenced by this template
for (Pcons pc = templ_refs ; pc ; pc = pc->cdr)
Ptempl_inst(pc->car)->instantiate() ;
if (!((pb->b_name->dcl(gtbl, EXTERN) == 0 ) || error_count)) {
pb->b_name->simpl() ;
if (pb->b_name->tp->base != CLASS)
error('i', "a classdef was expected in templ_inst::instantiate") ;
current_instantiation = Pclass(pb->b_name->tp) ;
pb->b_name->dcl_print(0) ;
if (! (pb->b_name->tp->defined & DEFINED))
error ('i', "dcl class is not yet defined") ;
current_instantiation = 0 ;
}
}
// bash every template instantiation class that has been forwarded to
// it, with the decl processed version.
for (Ptempl_inst clone = def->insts ; clone ; clone = clone->next)
if (clone != this) {
if (clone->forward == this)
clone->kludge_copy(Pbase(tname->tp)) ;
else {
// resolve references to forward declarations
if (this == def->get_match(clone->actuals, clone, true)) {
clone->kludge_copy(Pbase(tname->tp)) ;
clone->forward = this ;
}
}
}
Pclass result = Pclass(pb->b_name->tp);
// dcl_print the member functions, so that they can be referenced
int i = 0 ;
for (Pname fn= Pclass(pb->b_name->tp)->memtbl->get_mem(i=1); fn;
fn=Pclass(pb->b_name->tp)->memtbl->get_mem(++i))
if ((fn->base == NAME) && (fn->tp->base == FCT))
fn->dcl_print(0) ;
restore_state() ;
def->open_instantiations-- ;
}
}
/* Template Constructors */
templ::templ(Plist parms, Pname p) {
namep = p ;
formals = parms ;
if (!formals) error ("a parametrized type must have parameters !") ;
basep = Pbase(namep->tp) ;
Pclass(basep->b_name->tp)->class_base = template_class ;
defined = ((basep->b_name->tp->defined & DEF_SEEN) ? true : false) ;
if (defined)
members = Pclass(basep->b_name->tp)->mem_list ;
PERM(namep) ; PERM(namep->tp) ;
// Chain on to the list of templates for the compilation.
next = templp->list ;
templp->list = this ;
}
templ_inst::templ_inst (Pexpr act, Ptempl owner)
{
// Set up the basetype for the class, so that nodes that need to point to it
// during syntax processing can do so. Theese objects are merely
// place-holders during syntax analysis, and are actually filled in during
// the copy phase of instantiation.
Pclass c ;
def = owner ;
tname = new name(def->namep->string) ;
tname->base = TNAME ;
tname->tp = new basetype(COBJ, new name(def->namep->string)) ;
Pbase(tname->tp)->b_name->tp = c = new templ_classdef(this) ;
PERM(tname) ; PERM(tname->tp) ; PERM(Pbase(tname->tp)->b_name) ;
PERM(Pbase(tname->tp)->b_name->tp) ;
// initialize the member list so that set_scope can do the right thing
c->mem_list = Pclass(def->basetype()->b_name->tp)->mem_list ;
actuals = act ;
next = owner->insts ;
owner->insts = this ;
}
templ_classdef::templ_classdef(Ptempl_inst i): classdef(CLASS) {
inst = i ;
class_base = uninstantiated_template_class ;
string = unparametrized_tname()->string ;
}
// Create a new function template.
function_template::function_template (templ &owner, Plist params, Pname n)
{
definition_number = ++definition_tick ;
if (owner.fns_end)
owner.fns_end->next = this ;
else owner.fns = this ;
owner.fns_end = this ;
formals = params ;
fn = n ;
PERM(n) ; PERM(n->tp) ;
}
// create the tree template
tree_template::tree_template(TOK tree_kind, char *s, Plist params, Pnode tree,
Pcons references)
{
string = s ;
formals = params;
e = tree ;
if (!e)
error('w', "the internal template %s does not have an associated body", s);
templ_refs = references ;
kind = tree_kind ;
// add the expression template too the list of known templates
if (get(s)) {
error ("duplicate definition of the internal template %s", s) ;
return ;
}
// link it in
next = templ_compilation::tree_templates ;
templ_compilation::tree_templates = this ;
// check that formals weren't misspelt
for (Plist formal = formals ; formal ; formal = formal->l)
if (! formal->f->n_used)
error('w', "the formal parameter %n was not referenced within the template body",formal->f) ;
}
// lookup an internal expression template
Ptreet tree_template::get(char *s) {
for (Ptreet o = templ_compilation::tree_templates ; o ; o = o->next)
if (strcmp(o->string, s) == 0) return o ;
return 0 ;
}
Pname tree_template::get_parameter(char *s) {
for (Plist formal = formals ; formal ; formal = formal->l) {
if (strcmp(formal->f->string, s)== 0)
return formal->f ;
}
return 0 ;
}
// Sam: some remodularization seems to be in order here, so that this method
// can be shared
Pname templ_inst::get_parameter(char *s) {
for (Plist formal = inst_formals ; formal ; formal = formal->l) {
if (strcmp(formal->f->string, s)== 0)
return formal->f ;
}
return 0 ;
}
Pexpr tree_template::expand(Pexpr)
{
error('i', "no support for tree templates") ;
return 0 ;
}
// Instantiate each function member body. It assumes that the class
// declaration has been instantiated. The return value indicates whether an
// instantiation of bodies actually took place. This function is only invoked
// at the end of a file compilation, after all source text has been processed.
bool templ::instantiate_bodies(){
bool change = false ;
// Perform the instantiation of the member function bodies.
if (!fns) return change ;
for (Ptempl_inst inst = insts ; inst ; inst = inst->next)
if (!inst->forward && (inst->status == class_instantiated)) {
// Set up the environment for the declaration, and subsequent compilation
// of the function bodies.
inst->status = body_instantiated ; change = true ;
{ Pclass ic = inst->get_class() ; int i ;
// note all the overriding definitions explicitly provided by the user
for (Pname fn= ic->memtbl->get_mem(i=1); fn; fn=ic->memtbl->get_mem(++i))
if ((fn->base == NAME) && (fn->tp->base == FCT) && Pfct(fn->tp)->body)
fn->n_redefined = 1 ;
}
for (Pfunt fnt = fns; fnt ; fnt = fnt->next) {
Pcons templ_ref_copy = fnt->templ_refs ;
Pname fn = inst->function_copy(fnt, templ_ref_copy) ;
// Change the qualifier to be the name of the instantiated, rather than
// the parametrized class name
fn->n_qualifier = inst->namep ;
if (fn->n_oper != TYPE ) // cond contains type information
fn->n_table = 0;
fn->n_tbl_list = 0 ;
// Note that the formals were bound to the actuals when the class decl
// was instantiated, so the binding is not redone.
// Modify constructor and destructor names.
if (!strcmp(fn->string, namep->string))
fn->string = inst->namep->string ;
{ inst->save_state(fn) ;
// Instantiate the parametrized types referenced by this template
for (Pcons pc = templ_ref_copy ; pc ; pc = pc->cdr)
Ptempl_inst(pc->car)->instantiate() ;
// ensure that "type type" formals constrained to be class definitions are
if (!fnt->check_constraints(inst->actuals))continue ;
if ( ((fn = fn->dcl(gtbl, EXTERN)) == 0) || error_count) {
inst->restore_state() ;
continue ;
}
fn->simpl() ;
fn->dcl_print(0) ;
inst->restore_state() ;
}
}
}
return change ;
}
0707071010112046121004440001630000160000010212600466055421700001300000040045template.h /* ident "@(#)ctrans:src/template.h 1.2" */
/* -*- Mode:C++ -*- */
/*
$Source: /var/lib/cvsd/repos/research/researchv10no/cmd/cfront/xptcfront/cfront.cpio,v $ $RCSfile: cfront.cpio,v $
$Revision: 1.1.1.1 $ $Date: 2018/04/24 17:21:35 $
$Author: root $ $Locker: $
$State: Exp $
*/
/*
$Header: /var/lib/cvsd/repos/research/researchv10no/cmd/cfront/xptcfront/cfront.cpio,v 1.1.1.1 2018/04/24 17:21:35 root Exp $
Copyright 1989 by Object Design, Inc., Burlington, Mass.
All rights reserved.
*/
/*****************************************************************************
* *
* This file contains types pertinent to the implementation of the *
* parametrized type facility. *
* *
*****************************************************************************/
enum bool { true = 1, false = 0 } ;
typedef class templ *Ptempl ;
typedef class templ_inst *Ptempl_inst ;
typedef class function_template *Pfunt ;
typedef class templ_classdef *Ptclass ;
typedef class tree_template *Ptreet ;
// A Lisp style cons cell to help build lists. The parametrized type facility,
// should obviate the need for this type-unsafe nonsense.
class cons {
public:
void *car ;
cons *cdr ;
cons (void *pcar, cons *pcdr) { car = pcar ; cdr = pcdr ; } ;
} ;
typedef cons *Pcons ;
/*****************************************************************************
* *
* The class template_compilation holds the state, and the associated methods *
* used during template compilation. There is exactly one instance of the *
* type, it is mainly a device used to enforce modularity. In reality, it *
* would never need to be instantiated since all it's members are static. *
* However, since the type::mem for of reference is not supported as *
* yet(cfront 1.2), we need an instantiation to get to the members via *
* pointer syntax instead. *
* *
* A templ_compilation holds the state relevant to the syntax analysis of a *
* class or member function template definition. *
* *
*****************************************************************************/
class templ_compilation {
static Plist param_end, // make append easier
param_tn ; // The type names introduced by the parameters
public:
static Ptempl list ; // The list of templates for the compilation
static Plist params ; // The list of parameters to the template
static Ptempl owner ; // The template when compiling a member
// function.
static table *templates ; // The templates defined during this compilation
static Ptreet tree_templates; // The list of tree templates
static bool in_progress; // a template compilation is in progress
// instantiation parameter parsing in progress. Used in the lexer to ensure
// that name string are consed in the heap, rather than being retained as
// pointers into the lex buffer.
static int parameters_in_progress ;
// the list of templates referenced by the top level definition being compiled.
static Pcons templ_refs ;
static Pcons last_cons ;
static Ptype any_type ; // canonical "ANY" type for formal parms
// true, if currently compiling an expression tree template
static TOK curr_tree_template ;
void append_ref(Ptempl_inst ref) ;
void start() ;
void collect(TOK parm_type, Pname namep) ;
void collect(Pname namep) ;
void enter_parameters() ;
void introduce_class_templ(Pname cnamep) ;
void end(Pname class_name) ;
Pname forward_declaration(Pname class_name) ;
void instantiate_ref_templ() ;
void clear_ref_templ() ;
Pname check_tname(Pname p) ;
bool current_template(Pname p, Pexpr actuals) ;
Ptempl is_template(Pname p) ;
Ptempl is_template(char *s);
void end_of_compilation() ; // Done with compilation, instantiate bodies
templ_compilation() ;
static Pname tree_parameter(char *s) ; // return true if the name is a tree parameter
private:
void append_parameter(Pname p) ;
} ;
// The canonical template_compilation instance. templ_compilation exists as a
// class simply to provide a code and data packaging mechanism. There is
// exactly one generated instance of it.
extern templ_compilation *templp ;
// should actually be static member functions of templ_compilation
Pname parametrized_typename (Pname p, Pexpr actuals) ;
Pbase parametrized_basetype (Pname p, Pexpr actuals) ;
// the basis for class and member function templates
class basic_template {
friend templ_compilation ;
protected:
Plist formals ; // The formal arguments to the template
Pcons templ_refs ; // The templates referenced by this template
// check class constraints placed on formals while processing member
// function bodies.
bool check_constraints(Pexpr actuals) ;
// ensure that use of formals is consistent across, class, member and
// forward declarations
void check_formals(Plist formals) ;
public:
// used to order template class definitions for instantiations. Not being
// used as yet.
int definition_number ;
// used to generate the definition numbers, used by the above member.
static int definition_tick ;
Plist get_formals() {return formals ;}
} ;
// the template for a class
class templ : public basic_template {
Pbase basep ; // COBJ basetype for the template
Ptempl_inst insts ; // instantiations of the template
Pfunt fns ; // member function declarations
Pfunt fns_end ; // last fun in the above list
// Use these state variables to set up the correct state for error
// processing. They are used by the "error" routines for statement numbers.
Pname Cdcl ;
Pstmt Cstmt ;
friend templ_inst ;
friend function_template ;
// used to detect loops during instantiation; a count greater than two is
// indicative of a non-terminating instantiation sequence
int open_instantiations ;
Ptempl_inst get_match(Pexpr actuals,
Ptempl_inst exclude,
bool match_instantiated_only) ;
bool check_actual_args (Pexpr actuals) ;
public:
Ptempl next ; // connects all the class templates in the comp
Pname namep ; // the TNAME for the template class
bool defined ; // the actual definition, not just a forward
// declaration has been seen.
Pname members ; // note the members to catch redefinition errors
Ptempl_inst get_inst(Pexpr actuals, Ptempl_inst exclude = 0) ;
templ(Plist parms, Pname p) ;
void resolve_forward_decl(Plist parms, Pclass c) ;
void instantiate_forward_decl() ;
// The uninstantiated base type
Pbase basetype() {return basep; }
// The basetype for a specific instantiation
Pbase inst_basetype(Pexpr actuals) ;
Pname typename(Pexpr actuals) ;
Pfunt collect_function_member(Pname fname) ;
bool has_tree_expr_formals() ;
bool instantiate_bodies() ;
} ;
// Member function templates
class function_template : public basic_template {
Pname fn ; // The name of the member function
Pfunt next ; // connects the list of member functions
friend templ ;
friend templ_inst ;
public:
function_template (templ & owner, Plist params, Pname n) ;
} ;
// compiler internal expression templates, used to implement Objectstore constructs
class tree_template : public basic_template {
TOK kind ; // STATEMENT or EXPRESSION
Pnode e ; // the post-syntax tree representing the
// expression or statement constituting the
// template.
Ptreet next ; // the next expression template
static int count ; // the number of instantiations
public:
char *string ; // the name used for template lookup
tree_template(TOK tree_kind, char *s, Plist params, Pnode tree,
Pcons references) ;
static Ptreet get(char *s) ;
Pname get_parameter(char *s) ;
static void test() ;
Pexpr expand(Pexpr actuals) ;
} ;
// Global state variables that must be saved around an instantiation. The
// saving of state was required in the implementstion that interspersed decl
// processing and instantiation, rather than the current strategy, which only
// forces instantiations at the top level outside of any dcl-processing
// context. It is retained in case we ever go back to the "interspersed" style
// of instantiation.
class state {
public:
Pname Cdcl ; // the global variables used by the error routines
Pstmt Cstmt ;
Pname dcl_list ; // Holds the list of typedef names that are hidden
Loc curloc ;
int curr_file ;
Pexpr curr_expr ;
Pin curr_icall ;
Pstmt curr_loop;
Pblock curr_block;
Pstmt curr_switch;
int bound ;
int inline_restr ;
Loc last_line ;
int no_of_badcall;
int no_of_undcl ;
Pname badcall ;
Pname undcl ;
state() {} ; // prevent used before set warnings.
void save() ;
void init() ;
void restore() ;
} ;
class pointer_hash ;
class tree_copy_info ;
// A template starts out being uninstantiated, and is class_instantiated when
// there is a refrence to it with actual arguments. It is body_instantiated at
// the end of compilation, when all its function members are instantiated.
enum inst_status { uninstantiated, class_instantiated, body_instantiated };
// templ_inst captures the arguments used in the instantiation of a template.
// These instantiations are rooted in the templ object.
class templ_inst {
friend class template_instantiation ;
Pname tname ; // The instantiation name, it is the TNAME that
// leads up to an actual instantiation of the class
Pname namep ; // The version of TNAME in the ktbl
Pexpr actuals ; // instantiation arguments, chained using ELIST
// as an expression "cons" node, e1 is the car
// and e2 the cdr. The car points to a name node.
Ptempl_inst next ; // The linked list of instantiations for this
// template.
Ptempl_inst next_active ; // The list of currently active instantiations.
state context ; // the context of this instantiation
Ptempl_inst forward ; // This instantiation is the same as the one
// pointed to.
// Contains the list of global names that are hidden during an
// instantiation.
Plist hidden_globals ;
// The class correspondence table. This table is initialized
// when the class definition is instantiated. Subsequently, it is used to
// initial member correspondence tables before the copy process is
// initiated.
pointer_hash *corr ;
// the instantiation's copy of the formals
Plist inst_formals ;
inst_status status ;
friend class templ ;
friend class templ_classdef ;
friend class tree_template ;
friend Pcons make_ref_copy(pointer_hash &h, tree_copy_info &info,
Pcons old_templ_refs);
templ_inst (Pexpr act, Ptempl owner) ;
bool actuals_match(Pexpr check_actuals) ;
void instantiate_match(Ptempl_inst match) ;
void kludge_copy(Pbase source_base) ;
// create a copy of the class type subtree preparatory to the ensuing
// instantiation. Return a non-zero value, only if there was no need to
// create a copy, ie. an identical instantiation already existed.
Ptempl_inst class_copy(Pcons &templ_refs, bool recopy) ;
Pcons ref_copy(pointer_hash &h, tree_copy_info &info, Pcons old_templ_refs) ;
// save and restore state around the template instantiation
void save_state(Pname p) ;
void restore_state() ;
// Used to collect references to this template by a definition
Ptempl_inst note_ref() ;
char *instantiation_string() ;
void expose_parameter_names() ;
void hide_parameter_names() ;
public:
Ptempl def ; // The template definition, for which this is an
// instantiation.
bool refp ; // A flag used to note template references during
// a C++ definition
void print_error_loc() ; // Wants to be a static function
// Bind the formals before an instantiation
void bind_formals() ;
Ptempl_inst canonical_instantiation() {
return ( forward ? forward : this ) ;
}
// get the class associated with this instantiation
Pclass get_class() { return Pclass(Pbase(tname->tp)->b_name->tp) ;}
void instantiate(bool reinstantiate = false) ;
static Ptempl_inst head ; // Head of the list of active instantiations.
void print_pretty_name() ;
char *mangled_name(char *buffer) ;
// The uninstantiated basetype
Pbase def_basetype() { return def->basep ; } ;
// A general way of determining whether two template instantiations are
// the same
bool same(Ptempl_inst t) ;
bool copy_hook(Pnode&) ;
// return a copy of the function tree starting with it's name
Pname function_copy(Pfunt fnt, Pcons &templ_refs) ;
// special check for instantiations used in qualifiers for template function
// member declarations.
bool check_qualifier(Plist formals) ;
Pname get_parameter(char *s) ;
} ;
// Experimental debugging toggle
extern int zdebug ;
// The class node used for template classes.
// Rep invariant:
// class_base == uninstantiated_template_class ||
// class_base == instantiated_template_class
class templ_classdef : public classdef {
public:
Ptempl_inst inst ; // a pointer to the instantiation; the
// instantiation also points back to it via
// the tname ->cobj->name->class path
templ_classdef(Ptempl_inst i) ;
Pname unparametrized_tname() { return inst->def->namep ; }
void instantiate() { inst->instantiate() ; }
} ;
// Safe accessor functions for navigating through COBJ base classes
extern class_type_enum get_class_base (Pbase b) ;
extern Ptclass get_template_class (Pbase b) ;
extern Ptempl_inst get_templ_inst(Pbase b) ;
/*
$Log: cfront.cpio,v $
Revision 1.1.1.1 2018/04/24 17:21:35 root
researchv10 Norman
* Revision 1.4 90/04/02 11:31:35 sam
* Made comments current.
*
* Revision 1.3 90/03/30 18:50:55 sam
* 1) Added the introduce_class_templ member function to the templ_compilation
* class.
* 2) Rationalized the definition of class templ. Made basic_template be it's
* base class, instead of type. The latter was the base type, simply so that
* it could be stored in a table associating strings with types. Don't have
* to resolve to such kludgery in the PT world.
* 3) Added the member open_instantiations to detect non-terminating
* instantiations
*
* Revision 1.2 90/03/27 10:16:27 sam
* > Merged in revision 1.13 from the main line of development
*
* Revision 1.1 89/11/20 08:50:58 benson
* Initial revision
*
* Revision 1.11 89/10/16 15:25:00 sam
* use pointer_hash rather than Hash as the type of the correspondence table.
*
* Revision 1.10 89/09/26 16:44:34 sam
* fix the forward declaration of template classes
*
* Revision 1.9 89/09/18 16:37:37 sam
* provide for error recovery upon argument mismatch in a template instantiation
*
*
* Revision 1.8 89/09/15 09:31:50 benson
* move tree_template.string into the public section.
*
* Revision 1.7 89/08/30 13:02:12 sam
* added support for dealing with __expressions in class formal templates
*
* Revision 1.6 89/08/28 09:42:05 sam
* Support for nested references in internal templates. These nested
* references are instantiated whenever an expansion takes place.
*
* Revision 1.5 89/08/23 10:26:00 sam
* support for BS style formal syntax. refer to 1.5 templates.c for more
* detailed comments.
*
* Revision 1.4 89/08/11 14:57:09 sam
* implementation of multiple instantiation templates.
*
* Revision 1.3 89/07/27 11:33:40 sam
* the comments in template.c 1.3 describe the modifications.
*
* Revision 1.2 89/07/07 14:34:11 sam
* Added the templ_classdef::unparametrized_type_name() function member, as part
* of the base init fix.
*
* Revision 1.1 89/06/29 09:21:32 benson
* Initial revision
*
* Revision 1.1 89/06/22 16:29:29 sam
* Initial revision
*
end_log
*/
/*
$Log $
end_log
*/
0707071010112045701004440001630000160000010210100466055411600001000000012452token.h /*ident "@(#)ctrans:src/token.h 1.4" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
token.h:
*****************************************************************************/
/*
#ifndef PRESAFE
extern "C" {
#endif
extern void free(char*); // alloc.h
extern char* malloc(unsigned);
extern char* calloc(unsigned, unsigned);
extern strncmp(const char*, const char*, const); // string.h
extern strcmp(const char*, const char*);
extern int strlen(const char*);
extern char* strcpy(char*, const char*);
#ifdef apollo
extern void set_sbrk_size(int);
#endif
#ifndef PRESAFE
}
#endif
*/
#include <malloc.h>
#include <string.h>
#include <stdio.h>
extern void lex_clear();
extern void otbl_init();
//#define yylex() lalex()
#define putstring(s) fputs(s,out_file)
#define putst(s) (fputs(s,out_file),putc(' ',out_file))
#define putch(c) putc(c,out_file)
#define putcat(c,s) (putc(c,out_file),fputs(s,out_file))
/* token numbers for C parser */
#define MAXTOK 255
extern char* keys[MAXTOK+1];
#define EOFTOK 0 /* EOF */
/* keywords in alphabetical order */
#define ASM 1
#define AUTO 2
#define BREAK 3
#define CASE 4
#define CHAR 5
#define CLASS 6
#define CONTINUE 7
#define DEFAULT 8
#define DELETE 9
#define DO 10
#define DOUBLE 11
#define ELSE 12
#define ENUM 13
#define EXTERN 14
#define FLOAT 15
#define FOR 16
#define FORTRAN 17
#define FRIEND 18
#define GOTO 19
#define IF 20
#define INT 21
#define LONG 22
#define NEW 23
#define OPERATOR 24
#define PUBLIC 25
#define CONST 26
#define REGISTER 27
#define RETURN 28
#define SHORT 29
#define SIZEOF 30
#define STATIC 31
#define STRUCT 32
#define SWITCH 33
#define THIS 34
#define TYPEDEF 35
#define UNION 36
#define UNSIGNED 37
#define VOID 38
#define WHILE 39
/* operators in priority order (sort of) */
#define LP 40
#define RP 41
#define LB 42
#define RB 43
#define REF 44
#define DOT 45
#define NOT 46
#define COMPL 47
#define INCR 48
#define DECR 49
#define MUL 50
#define DIV 51
#define AND 52
#define MOD 53
#define PLUS 54
#define MINUS 55
#define LS 56
#define RS 57
#define LT 58
#define LE 59
#define GT 60
#define GE 61
#define EQ 62
#define NE 63
#define ER 64
#define OR 65
#define ANDAND 66
#define OROR 67
#define QUEST 68
#define COLON 69
#define ASSIGN 70
#define CM 71
#define SM 72
#define LC 73
#define RC 74
#define INLINE 75
#define OVERLOAD 76
#define VIRTUAL 77
#define COERCE 78
#define PROTECTED 79
/* constants etc. */
#define ID 80
#define STRING 81
#define ICON 82
#define FCON 83
#define CCON 84
#define NAME 85
#define ZERO 86
/* groups of tokens */
#define ASOP 90 /* op= */
#define RELOP 91 /* LE GE LT GT */
#define EQUOP 92 /* EQ NE */
#define DIVOP 93 /* DIV MOD */
#define SHIFTOP 94 /* LS RS */
#define ICOP 95 /* INCR DECR */
#define UNOP 96 /* NOT COMPL */
#define TYPE 97
/* TYPE = INT FLOAT CHAR DOUBLE REGISTER STATIC EXTERN AUTO
LONG SHORT UNSIGNED INLINE FRIEND VIRTUAL */
/* new tokens generated by syn() */
#define UMINUS 107
#define FCT 108
#define CALL 109
#define VEC 110
#define DEREF 111
#define ADDROF 112
#define CAST 113
//#define ENDCAST 122
#define FIELD 114
#define LABEL 115
#define BLOCK 116
//#define QUA 117
#define DCL 118 /* local declaration statement */
#define COBJ 119
#define EOBJ 121
#define TNAME 123
#define ILIST 124
#define PTR 125
#define ASPLUS 126
#define ASMINUS 127
#define ASMUL 128
#define ASDIV 129
#define ASMOD 130
#define ASAND 131
#define ASOR 132
#define ASER 133
#define ASLS 134
#define ASRS 135
#define ARG 136
#define ARGS 137
#define ZTYPE 138
#define ARGT 139
#define ELIST 140
#define ANY 141
#define TABLE 142
#define LOC 143
#define DUMMY 144
#define G_ADDROF 145
#define G_CALL 146
#define G_CM 147
#define IVAL 150
//#define FVAL 151
//#define LVAL 152
#define ELLIPSIS 155
#define AGGR 156
#define VALUE 157 /* constructor call */
#define RPTR 158 /* reference */
#define HIDDEN 159
#define MEM 160
#define CTOR 161
#define DTOR 162
#define CONST_PTR 163
#define CONST_RPTR 164
#define TEXT 165
#define PAIR 166
#define ANON 167
#define ICALL 168
#define ANAME 169
#define VOLATILE 170
#define SIGNED 171
#define UPLUS 172
#define MEMPTR 173
#define PRIVATE 174
#define PR 175 /* PUBLIC PRIVATE or PROTECTED */
#define MDOT 177
#define TSCOPE 178
#define DECL_MARKER 179
#define REFMUL 180
#define LDOUBLE 181
#define LINKAGE 182
#define LOCAL 183
#define GNEW 184
#define TEMPLATE 185
#define STAT_INIT 186
#define CATCH 187
#define GDELETE 188
//#define CONVERT 189
#define NESTED 190
#define TRY 191
// class parameterized types constants
#define XVIRT 200 /* class virt */
#define XNLIST 201 /* struct name_list */
#define XILINE 202
#define XIA 203
#define STATEMENT 205
#define EXPRESSION 206
#define SM_PARAM 207
#define TEMPLATE_TEST 208
#define PTNAME 209
#define NEW_INIT_KLUDGE 210
#define XDELETED_NODE 211
#define DUMMY_LAST_NODE 212
//#define SYN 1
//#define TYP 2
//#define SIMPL 3
//#define ERROR 4
//#define ICTOR 88
//#define IDTOR 89
0707071010112046131004440001630000160000010212340466055422200001600000006724token_names.h /* ident "@(#)ctrans:src/token_names.h 1.2" */
struct _token_name { char * string; int val; } token_names [] = {
{ "EOFTOK", 0 },
{ "ASM", 1 },
{ "AUTO", 2 },
{ "BREAK", 3 },
{ "CASE", 4 },
{ "CHAR", 5 },
{ "CLASS", 6 },
{ "CONTINUE", 7 },
{ "DEFAULT", 8 },
{ "DELETE", 9 },
{ "DO", 10 },
{ "DOUBLE", 11 },
{ "ELSE", 12 },
{ "ENUM", 13 },
{ "EXTERN", 14 },
{ "FLOAT", 15 },
{ "FOR", 16 },
{ "FORTRAN", 17 },
{ "FRIEND", 18 },
{ "GOTO", 19 },
{ "IF", 20 },
{ "INT", 21 },
{ "LONG", 22 },
{ "NEW", 23 },
{ "OPERATOR", 24 },
{ "RETURN", 28 },
{ "PUBLIC", 25 },
{ "CONST", 26 },
{ "REGISTER", 27 },
{ "RETURN", 28 },
{ "SHORT", 29 },
{ "SIZEOF", 30 },
{ "STATIC", 31 },
{ "STRUCT", 32 },
{ "SWITCH", 33 },
{ "THIS", 34 },
{ "TYPEDEF", 35 },
{ "UNION", 36 },
{ "UNSIGNED", 37 },
{ "VOID", 38 },
{ "WHILE", 39 },
{ "LP", 40 },
{ "RP", 41 },
{ "LB", 42 },
{ "RB", 43 },
{ "REF", 44 },
{ "DOT", 45 },
{ "NOT", 46 },
{ "COMPL", 47 },
{ "INCR", 48 },
{ "DECR", 49 },
{ "MUL", 50 },
{ "DIV", 51 },
{ "AND", 52 },
{ "MOD", 53 },
{ "PLUS", 54 },
{ "MINUS", 55 },
{ "LS", 56 },
{ "RS", 57 },
{ "LT", 58 },
{ "LE", 59 },
{ "GT", 60 },
{ "GE", 61 },
{ "EQ", 62 },
{ "NE", 63 },
{ "ER", 64 },
{ "OR", 65 },
{ "ANDAND", 66 },
{ "OROR", 67 },
{ "QUEST", 68 },
{ "COLON", 69 },
{ "ASSIGN", 70 },
{ "CM", 71 },
{ "SM", 72 },
{ "LC", 73 },
{ "RC", 74 },
{ "INLINE", 75 },
{ "OVERLOAD", 76 },
{ "VIRTUAL", 77 },
{ "COERCE", 78 },
{ "PROTECTED", 79 },
{ "ID", 80 },
{ "STRING", 81 },
{ "ICON", 82 },
{ "FCON", 83 },
{ "CCON", 84 },
{ "NAME", 85 },
{ "ZERO", 86 },
{ "ICTOR", 88 },
{ "IDTOR", 89 },
{ "ASOP", 90 },
{ "RELOP", 91 },
{ "EQUOP", 92 },
{ "DIVOP", 93 },
{ "SHIFTOP", 94 },
{ "ICOP", 95 },
{ "UNOP", 96 },
{ "TYPE", 97 },
{ "UMINUS", 107 },
{ "FCT", 108 },
{ "CALL", 109 },
{ "VEC", 110 },
{ "DEREF", 111 },
{ "ADDROF", 112 },
{ "CAST", 113 },
{ "FIELD", 114 },
{ "LABEL", 115 },
{ "BLOCK", 116 },
{ "QUA", 117 },
{ "DCL", 118 },
{ "COBJ", 119 },
{ "EOBJ", 121 },
{ "TNAME", 123 },
{ "ILIST", 124 },
{ "PTR", 125 },
{ "ASPLUS", 126 },
{ "ASMINUS", 127 },
{ "ASMUL", 128 },
{ "ASDIV", 129 },
{ "ASMOD", 130 },
{ "ASAND", 131 },
{ "ASOR", 132 },
{ "ASER", 133 },
{ "ASLS", 134 },
{ "ASRS", 135 },
{ "ARG", 136 },
{ "KNOWN", 137 },
{ "ZTYPE", 138 },
{ "ARGT", 139 },
{ "ELIST", 140 },
{ "ANY", 141 },
{ "TABLE", 142 },
{ "LOC", 143 },
{ "DUMMY", 144 },
{ "G_ADDROF", 145 },
{ "G_CALL", 146 },
{ "G_CM", 147 },
{ "IVAL", 150 },
{ "FVAL", 151 },
{ "LVAL", 152 },
{ "ELLIPSIS", 155 },
{ "AGGR", 156 },
{ "VALUE", 157 },
{ "RPTR", 158 },
{ "HIDDEN", 159 },
{ "MEM", 160 },
{ "CTOR", 161 },
{ "DTOR", 162 },
{ "CONST_PTR", 163 },
{ "CONST_RPTR", 164 },
{ "TEXT", 165 },
{ "PAIR", 166 },
{ "ANON", 167 },
{ "ICALL", 168 },
{ "ANAME", 169 },
{ "VOLATILE", 170 },
{ "SIGNED", 171 },
{ "UPLUS", 172 },
{ "MEMPTR", 173 },
{ "PRIVATE", 174 },
{ "PR", 175 },
{ "MDOT", 177 },
{ "TSCOPE", 178 },
{ "DECL_MARKER", 179 },
{ "REFMUL", 180 },
{ "LDOUBLE", 181 },
{ "LINKAGE", 182 },
{ "LOCAL", 183 },
{ "GNEW", 184 },
{ "TEMPLATE", 185 },
{ "STAT_INIT", 186 },
{ "CATCH", 187 },
{ "GDELETE", 188 },
{ "CONVERT", 189 },
{ "XVIRT", 200 },
{ "XNLIST", 201 },
{ "XILINE", 202 },
{ "XIA", 203 },
{ "STATEMENT", 205 },
{ "EXPRESSION", 206 },
{ "SM_PARAM", 207 },
{ "TEMPLATE_TEST", 208 },
{ "PTNAME", 209 },
{ "NEW_INIT_KLUDGE", 210 },
{ "XDELETED_NODE", 211 },
{ "DUMMY_LAST_TOKEN", 212 },
};
0707071010112045711004440001630000160000010156650466055412200001100000002515tqueue.h /*ident "@(#)ctrans:src/tqueue.h 1.3" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
tqueue.h:
*****************************************************************************/
#ifndef EOF
#include <stdio.h>
#endif
struct toknode {
TOK tok; /* token for parser */
bit used; /* token has been processed by lalex() */
YYSTYPE retval; /* $arg */
loc place;
toknode* next;
toknode* last;
static toknode* free_toks;
void* operator new(size_t);
void operator delete(void*,size_t);
toknode(TOK,YYSTYPE,loc);
};
extern toknode* front;
extern toknode* rear;
extern void addtok(TOK,YYSTYPE,loc); /* add tok to rear of Q */
extern TOK deltok(int); /* take tok from front of Q */
extern TOK tlex();
// interface to parser
extern TOK lalex();
extern int yychar;
extern YYSTYPE yylval;
extern TOK la_look();
extern void la_backup( TOK, YYSTYPE );
extern int la_cast();
extern void check_decl();
extern void check_cast();
extern TOK lalex();
// save / restore implicit inline functions
extern toknode* save_text();
extern void restore_text();
0707071010112046041004440001630000160000010211700466055416700001400000014274tree_copy.c /* ident "@(#)ctrans:src/tree_copy.c 1.3" */
/*
$Source: /var/lib/cvsd/repos/research/researchv10no/cmd/cfront/xptcfront/cfront.cpio,v $ $RCSfile: cfront.cpio,v $
$Revision: 1.1.1.1 $ $Date: 2018/04/24 17:21:35 $
$Author: root $ $Locker: $
$State: Exp $
*/
/* utilities to copy pieces of cfront trees.
what we have here is a somewhat parameterizable
action procedure for the tree walker.
We may make more versions of this for template expansion
and saving things in files, or we may just make it possible
for this to swing more ways.
*/
#include "cfront.h"
#include "tree_walk.h"
#include "tree_copy.h"
#include <memory.h>
/* determine whether "n" is a an already defined type */
static unsigned int type_is_defined(Pnode n) {
return (Ptype(n)->defined & DEFINED) ;
}
void
copy_walker (Pnode& node, node_class cl, void * info,
tree_node_action& action, int, Pnode, tree_walk_tree&,
int& register_in_hash)
{
union {
Pnode node;
Pvirt vr;
Plist list;
Pgen g;
Pvec vc;
Pfct f;
Ptable t;
Pbase bt;
Pexpr x;
Pstmt s;
Penum e;
Pclass c;
Pbcl bcl;
Pin iline;
ia * ia;
Pname n;
Pptr p;
} n;
Pnode original_node = node;
tree_copy_info * tci = (tree_copy_info *)info;
action = tna_continue;
/* first, give an application-specific hook a shot at the node. */
tci->check_node(node, cl, action, register_in_hash);
if(action != tna_continue) return;
if(node != original_node) { /* a replacement */
n.node = node;
} else /* ok, nothing funny, we just go ahead and copy */
switch (cl) {
default:
break;
case nc_eof:
n.node = Pnode(tci->malloc(sizeof (node)));
*n.node = *node;
goto Replace;
case nc_virt:
n.vr = Pvirt(tci->malloc(sizeof(virt)));
*n.vr = *Pvirt(node);
goto Replace;
case nc_nlist:
n.list = Plist(tci->malloc(sizeof(name_list)));
*n.list = *Plist(node);
goto Replace;
case nc_gen:
n.g = Pgen(tci->malloc(sizeof(gen)));
*n.g = *Pgen(node);
goto Replace;
case nc_vec:
n.vc = Pvec(tci->malloc(sizeof(vec)));
*n.vc = *Pvec(node);
goto Replace;
case nc_ptr:
n.p = Pptr(tci->malloc(sizeof(ptr)));
*n.p = *Pptr(node);
goto Replace;
case nc_fct:
n.f = Pfct(tci->malloc(sizeof(fct)));
*n.f = *Pfct(node);
if(n.f->f_signature) {
n.f->f_signature =
(char *)tci->malloc(strlen(Pfct(node)->f_signature)+1);
strcpy(n.f->f_signature, Pfct(node)->f_signature);
};
goto Replace;
case nc_table:
n.t = Ptable(tci->malloc(sizeof(table)));
*n.t = *Ptable(node);
n.t->entries = (Pname *)tci->malloc(sizeof(Pname) * n.t->size);
memcpy((char *)n.t->entries, (char *)Ptable(node)->entries, n.t->size * sizeof(Pname));
n.t->hashtbl = (short *)tci->malloc(sizeof(short) * n.t->hashsize);
memcpy((char *)n.t->hashtbl, (char *)Ptable(node)->hashtbl, n.t->hashsize * sizeof (short));
goto Replace;
case nc_basetype:
// Don't copy types that have already been dealt with
if (type_is_defined(node)) {
action = tna_stop ;
return ;
}
n.bt = Pbase(tci->malloc(sizeof(basetype)));
*n.bt = *Pbase(node);
if(n.bt->discriminator(0) == 2 && n.bt->b_linkage) {
n.bt->b_linkage = tci->malloc(strlen(n.bt->b_linkage) + 1);
strcpy(n.bt->b_linkage, Pbase(node)->b_linkage);
}
goto Replace;
case nc_expr:
// cfront needs identity maintaied for these nodes
if ((node == dummy) || (node == zero)) {
action = tna_stop ;
return ;
}
n.x = Pexpr(tci->malloc(sizeof(expr)));
*n.x = *Pexpr(node);
if(n.x->discriminator(1) == 3 && n.x->string) {
n.x->string = tci->malloc(strlen(n.x->string) + 1);
strcpy(n.x->string, Pexpr(node)->string);
}
if(n.x->discriminator(2) == 3 && n.x->string2) {
n.x->string2 = tci->malloc(strlen(n.x->string2) + 1);
strcpy(n.x->string2, Pexpr(node)->string2);
}
goto Replace;
case nc_stmt:
n.s = Pstmt(tci->malloc(sizeof(stmt)));
*n.s = *Pstmt(node);
goto Replace;
case nc_enumdef:
if (type_is_defined(node)) {
action = tna_stop ;
return ;
}
n.e = Penum(tci->malloc(sizeof(enumdef)));
*n.e = *Penum(node);
if(n.e->string) {
n.e->string = tci->malloc(n.e->strlen+1);
strcpy(n.e->string, Penum(node)->string);
}
goto Replace;
case nc_classdef:
// Don't copy types that have already been dealt with
if (type_is_defined(node)) {
action = tna_stop ;
return ;
}
n.c = Pclass(tci->malloc(sizeof(classdef)));
*n.c = *Pclass(node);
if(n.c->string) {
n.c->string = tci->malloc(strlen(n.c->string)+1);
strcpy(n.c->string, Pclass(node)->string);
}
goto Replace;
case nc_baseclass:
n.bcl = Pbcl(tci->malloc(sizeof(struct basecl)));
*n.bcl = *Pbcl(node);
goto Replace;
case nc_iline:
n.iline = Pin(tci->malloc(sizeof(iline)));
*n.iline = *Pin(node);
goto Replace;
case nc_ia:
n.ia = (ia *)tci->malloc(sizeof(ia));
*n.ia = *(ia *)node;
goto Replace;
case nc_name:
/* check for globalosity */
if(Pname(node)->string && (node == (node->base == TNAME ? ktbl : gtbl)->look(Pname(node)->string, 0))) {
action = tna_stop;
return;
}
n.n = Pname(tci->malloc(sizeof(name)));
*n.n = *Pname(node);
/* First, hack exprosity */
if(n.x->discriminator(1) == 3 && n.n->string) {
n.n->string = tci->malloc(strlen(n.n->string) + 1);
strcpy(n.n->string, Pexpr(node)->string);
}
if(n.x->discriminator(2) == 3 && n.n->string2) {
n.n->string2 = tci->malloc(strlen(n.n->string2) + 1);
strcpy(n.n->string2, Pexpr(node)->string2);
/* ok, name stuff */
}
if(n.n->n_anon) {
n.n->n_anon = tci->malloc(strlen(n.n->n_anon)+1);
strcpy(n.n->n_anon, Pname(node)->n_anon);
}
if(n.n->n_template_arg_string) {
n.n->n_template_arg_string =
tci->malloc(strlen(n.n->n_template_arg_string)+1);
strcpy(n.n->n_template_arg_string, Pname(node)->n_template_arg_string);
}
}
Replace:
node = n.node;
action = tna_continue;
return;
}
static int call_error (int i, const char * s)
{
return error (i, s);
}
void
copy_tree (Pnode& node, tree_copy_info& tci, Hash * cht)
{
tree_walk_control twc;
twc.call_i_error = 1;
twc.i_error = call_error; /* ... in type of error confuses compiler */
twc.action_proc = copy_walker;
twc.nodes_seen_hash = cht;
twc.callback_info = (void *)&tci;
walk_tree (twc, node);
}
0707071010112046141004440001630000160000010210160466055422600001400000003011tree_copy.h /* ident "@(#)ctrans:src/tree_copy.h 1.2" */
/* -*- Mode: C -*- begin include file tree_copy.H
argument class for copying trees. */
#include "hash.h"
#include "tree_walk.h"
/* The copier procedure expects one of these as its
info pointer */
class tree_copy_info {
public:
/* If non-zero, this procedure is called at each node.
it returns an action. It cannot currently return
a node of a different class and also return an
action other than tna_stop, since the walker won't
notice that the rug has been removed from beneath its feet.
The procedure must set the last argument to indicate whether
or not to register the node in the hash table and use the
replacement every future time it is encountered.
*/
void (* node_hook) (void * info, Pnode&, node_class, tree_node_action&,
int&);
/* if this is nonzero it is used to allocate space for
the copies. We don't run constructors since we always
bit copy over the new copy. */
char * (* malloc_hook) (void * info, size_t);
void * hook_info;
tree_copy_info ()
{
hook_info = 0;
node_hook = 0;
malloc_hook = 0;
};
char * malloc (size_t s) {
return malloc_hook ? malloc_hook(hook_info, s) : ::malloc (s);
};
void check_node (Pnode& n,
node_class cl,
tree_node_action& action,
int& never_see_again) {
if(node_hook)
node_hook(hook_info, n, cl, action, never_see_again);
};
};
void copy_tree (Pnode& n, tree_copy_info& tci, Hash * cht = 0);
/* End tree_copy.H */
0707071010112046161004440001630000160000010213300466055423500001400000061200tree_dump.c /* ident "@(#)ctrans:src/tree_dump.c 1.2" */
/* -*- Mode:C++ -*- */
/* tree_dump.C -- utilities for displaying the cfront tree. */
/* BIM 890530 */
/* rewritten 890712 to use the tree-walking facilities */
/*
$Source: /var/lib/cvsd/repos/research/researchv10no/cmd/cfront/xptcfront/cfront.cpio,v $ $RCSfile: cfront.cpio,v $
$Revision: 1.1.1.1 $ $Date: 2018/04/24 17:21:35 $
$Author: root $ $Locker: $
$State: Exp $
*/
#include "tree_dump.h"
#include <stdio.h>
#include <malloc.h>
#include "template.h"
#include "token_names.h"
const int Indent_Increment = 4;
static char badnamebuf[100];
char *
token_name(TOK t)
{
char * bnb = badnamebuf;
if((int) t == -1) return "-1";
if(t > DUMMY_LAST_NODE) {
bad:
printf_to_string(bnb, sizeof(badnamebuf),
"<unknown token %d>", (int) t);
return bnb;
}
int x;
for (x = 0; x < DUMMY_LAST_NODE; x++) {
if(token_names[x].val == t) return token_names[x].string;
}
goto bad;
}
class displayer{
public:
dcn_arg * arg;
Pnode node;
Pnode node_address;
displayer (dcn_arg& d) { arg = &d; indent = 0; print_null_values = 0; };
void do_node (Pnode& node, node_class cl, tree_node_action& action, int depth, Pnode);
private:
enum ppc {print_ptr_copy = 0, print_ptr_copied = 1};
int indent;
int err;
int print_null_values;
void printf (const char *, ...);
void catprintf (const char *, ...);
void print_ptr (const char *, Pnode);
void print_ptr (Pnode, ppc = print_ptr_copy);
void minimal ();
void a_basetype ();
void a_basecl() ;
void a_type() ;
void a_node() ;
void a_name ();
void a_expr (int from_name = 0);
void a_fct ();
void a_stmt ();
void a_enumdef ();
void a_table();
void a_classdef ();
void a_gen ();
void a_vec ();
void a_ptr ();
void a_virt ();
void a_nlist ();
void a_iline ();
void a_elist ();
void a_ia ();
void a_by_name ();
void print_loc(loc&);
void * display_address () { return node_address; }
void fetch (void * addr, unsigned long length, void *& taddr);
void fetch_string (void * addr, unsigned long length, void *& taddr);
void free_fetched(void *);
void flag (int, const char *);
void print_string (const char *, void *);
void print_string_brief (void *);
void null_field (const char *);
void nz_printf(const char *format, const int i) ;
void nz_printf(const char *format, const char *p) ;
void nz_printf(const char *format, const long l) ;
void ind();
};
const char many_spaces[] = " ";
inline void
displayer::ind()
{
arg->output_stream->write(many_spaces, indent);
}
/* call me for full lines */
void
displayer::printf (const char * format, ...)
{
va_list args;
va_start(args, format);
ind();
vostream_printf (format, args, *arg->output_stream);
arg->output_stream->write("\n", 1);
va_end (args);
}
void
displayer::catprintf (const char * format, ...)
{
va_list args;
va_start(args, format);
vostream_printf (format, args, *arg->output_stream);
va_end (args);
}
void
displayer::minimal ()
{
print_ptr(node, print_ptr_copied);
}
void
displayer::print_ptr(const char * label, Pnode node)
{
if(node || print_null_values) {
ind();
catprintf("%s:\t", label);
print_ptr(node);
catprintf("\n");
}
}
void
displayer::print_ptr(Pnode node, ppc copy_ptr)
{
void * string = 0;
void * ncopy;
void * na = (void *)node;
if(node) {
if(copy_ptr == print_ptr_copy) {
fetch(na, sizeof(node), ncopy);
node = Pnode(ncopy);
} else ncopy = node;
switch(node->base) {
case CLASS:
free_fetched(ncopy);
fetch(na, sizeof(classdef),ncopy);
node = Pnode(ncopy);
string = Pclass(node)->string;
break;
case ENUM:
free_fetched(ncopy);
fetch(na, sizeof(enumdef),ncopy);
node = Pnode(ncopy);
string = Penum(node)->string;
break;
case NAME:
case TNAME:
case PUBLIC:
case PROTECTED:
if(!node->baseclass) {
free_fetched(ncopy);
fetch(na, sizeof(name),ncopy);
node = Pnode(ncopy);
string = Pname(node)->string;
}
break;
}
if(string) {
catprintf("<%s |0x%p ", token_name(node->base), na);
print_string_brief(string);
catprintf(">");
}
else catprintf("<%s |0x%p>", token_name(node->base), na);
free_fetched (ncopy);
}
else catprintf("Null");
}
void
displayer::do_node (Pnode& n, node_class cl, tree_node_action& action,
int depth, Pnode na)
{
int forced_min = 0;
int printed_min = 0;
int prune = 0;
switch(cl) {
case nc_table:
if(depth > 0 && !arg->walk_tables)prune = 1;
case nc_fct:
case nc_classdef:
case nc_enumdef:
if(arg->stop_at_top && depth > 1) prune = 1;
break;
}
if((arg->max_depth > 0) && (depth >= arg->max_depth))
prune = 1;
if(prune || arg->max_depth == 0)
action = tna_stop;
else action = tna_continue;
node = n;
node_address = na;
if(arg->verbose == dt_brief || prune) {
printed_min = 1;
minimal();
}
else {
switch(cl)
{
default:
case nc_unused:
ostream_printf(*arg->error_stream, "Unknown node %d\n", node->base);
forced_min = 1;
case nc_eof:
minimal();
printed_min = 1;
break;
case nc_virt:
a_virt ();
break;
case nc_nlist:
a_nlist();
break;
case nc_gen:
a_gen();
break;
case nc_vec:
a_vec();
break;
case nc_ptr:
a_ptr();
break;
case nc_fct:
a_fct();
break;
case nc_table:
a_table();
break;
case nc_basetype:
a_basetype();
break;
case nc_name:
a_name();
break;
case nc_expr:
a_expr();
break;
case nc_stmt:
a_stmt();
break;
case nc_enumdef:
a_enumdef();
break;
case nc_classdef:
a_classdef();
break;
case nc_baseclass:
a_basecl ();
break;
case nc_iline:
a_iline();
break;
case nc_ia:
a_ia();
break;
}
if(printed_min) catprintf(">");
}
}
void
displayer::flag(int f, const char * n)
{
if(f)catprintf("%s", n);
}
void
displayer::free_fetched (void * addr)
{
if (arg->fetcher != null_tfp) /* not in the same address space. */
free ((char *)addr);
}
void
displayer::fetch (void * addr, unsigned long length, void *& taddr)
{
if (arg->fetcher == null_tfp) { /* in the same address space. */
taddr = addr;
err = 0;
} else {
taddr = (void *)malloc ((unsigned int)length);
err = arg->fetcher (arg->fetcher_info,
addr,
length,
0,
taddr);
}
}
void
displayer::fetch_string (void * addr, unsigned long length, void *& taddr)
{
if (arg->fetcher == null_tfp) { /* in the same address space. */
taddr = addr;
err = 0;
} else {
taddr = (void *)malloc ((unsigned int)length);
err = arg->fetcher (arg->fetcher_info,
addr,
length,
1,
taddr);
}
}
/* Print the field, only if it has a non_zero value, or requested to print */
/* always */
void
displayer::nz_printf(const char *format, const int i)
{
if (i || print_null_values) {
printf(format, i) ;
}
}
void
displayer::nz_printf(const char *format, const char *p)
{
if (p || print_null_values) {
printf(format, (p ? p : "0")) ;
}
}
void
displayer::nz_printf(const char *format, const long i)
{
if (i || print_null_values) {
printf(format, i) ;
}
}
void
displayer::a_node()
{
struct node &n = *node ;
nz_printf("$node", n.permanent);
// nz_printf("n_key:\t%d", (int)n.n_key) ;
nz_printf("permanent:\t%d", n.permanent) ;
nz_printf("baseclass:\t%d", n.baseclass) ;
}
void
displayer::a_type()
{
struct type& t = *Ptype(node);
int show_up = t.defined /* || t.inline_temp_index != 0 */;
if(show_up) {
printf("$type") ;
nz_printf("defined:\t%d", t.defined) ;
// nz_printf("inline_temp_index:\t%d", t.inline_temp_index);
indent += Indent_Increment;
}
a_node();
if(show_up) indent -= Indent_Increment;
}
void
displayer::null_field(const char * name)
{
nz_printf( "%s:\t0", name);
}
void
displayer::a_basecl()
{
struct basecl& bc = *Pbcl(node);
printf("$basecl %s |0x%p",
token_name(node->base),
node_address);
nz_printf ("ppp:\t%s", token_name(bc.ppp)) ;
nz_printf ("allocated:\t%d", bc.allocated) ;
nz_printf ("promoted:\t%d", bc.promoted) ;
print_ptr("bclass", bc.bclass);
nz_printf ("ptr_offset:\t%d", bc.ptr_offset) ;
nz_printf ("obj_offset:\t%d", bc.obj_offset) ;
indent += Indent_Increment;
a_node(); /* do the supertype. */
indent -= Indent_Increment;
}
void
displayer::a_basetype ()
{
struct basetype& bt = *Pbase(node);
printf("$basetype %s |0x%p",
token_name(node->base),
node_address);
ind();
catprintf("Flags:\t");
flag(bt.b_unsigned, "unsigned ");
flag(bt.b_signed, "signed ");
flag(bt.b_volatile, "volatile ");
flag(bt.b_const, "const ");
flag(bt.b_typedef, "typedef ");
flag(bt.b_virtual, "virtual ");
flag(bt.b_short, "short ");
flag(bt.b_long, "long ");
catprintf("\n");
nz_printf( "b_bits:\t%d", bt.b_bits);
nz_printf( "b_offset:\t%d", bt.b_offset);
nz_printf( "b_sto:\t%s", bt.b_sto ? token_name(bt.b_sto) : 0);
switch(bt.discriminator(0)) {
case 1:
print_ptr("b_fieldtype", bt.b_fieldtype);
break;
case 2:
nz_printf( "b_linkage:\t%s", bt.b_linkage ? "C" : "0(C++)");
}
print_ptr("b_name", bt.b_name);
print_ptr("b_table", bt.b_table);
// print_ptr("b_field", bt.b_field);
print_ptr("b_xname", bt.b_xname);
indent += Indent_Increment;
a_type(); /* do the supertype. */
indent -= Indent_Increment;
}
void
displayer::print_loc(loc& loc)
{
catprintf("file %d line %d", (int)loc.file, (int)loc.line);
}
void
displayer::print_string_brief(void * addr)
{
void * tmp;
fetch_string (addr, 1000, tmp);
*arg->output_stream << (char *)tmp;
free_fetched (tmp);
}
void
displayer::print_string(const char * label, void * addr)
{
ind();
catprintf("%s:\t", label);
print_string_brief(addr);
*arg->output_stream << "\n";
}
void
displayer::a_expr(int from_name)
{
struct expr& e = *Pexpr(node);
if(from_name) printf("$expr");
else printf("$expr %s |0x%p",
token_name(node->base),
node_address);
print_ptr("tp", e.tp);
switch(e.discriminator(1)) {
case 0: break;
case 1:
print_ptr("e1", e.e1);
break;
case 2:
printf("i1:\t%ld", e.i1);
break;
case 3:
print_string("string", (void *)e.string);
}
switch(e.discriminator(2)) {
case 0: break;
case 1:
print_ptr("e2", e.e2);
break;
case 2:
printf("i2:\t%ld", e.i2);
break;
case 3:
print_string("string2", (void *)e.string2);
break;
case 4:
print_ptr("n_initializer", e.n_initializer);
}
switch(e.discriminator(3)) {
case 0:
break;
case 1: print_ptr ("tp2", e.tp2); break;
case 2: print_ptr ("fct_name", e.fct_name); break;
case 3: print_ptr ("cond", e.cond); break;
case 4: print_ptr ("mem", e.mem); break;
case 5: print_ptr ("as_type", e.as_type); break;
case 6: print_ptr ("n_table", e.n_table); break;
case 7: print_ptr ("il", e.il); break;
case 8: print_ptr ("query_this", e.query_this); break;
}
indent += Indent_Increment;
a_node();
indent -= Indent_Increment;
}
void
displayer::a_name()
{
struct name& n = *Pname(node);
ind();
catprintf("$name %s |0x%p ",
token_name(node->base),
node_address);
print_string_brief((void *)n.string);
*arg->output_stream << "\n";
nz_printf("n_key:\t%d", (int)n.n_key) ;
nz_printf( "n_oper:\t\t%s", n.n_oper ?
token_name(n.n_oper) : 0);
nz_printf( "n_sto:\t\t%s", n.n_sto ?
token_name(n.n_sto) : 0);
nz_printf( "n_stclass:\t%s", n.n_stclass ?
token_name(n.n_stclass) : 0);
nz_printf( "n_scope:\t%s", n.n_scope ?
token_name(n.n_scope) : 0);
nz_printf( "n_union:\t%d", n.n_union);
nz_printf( "n_evaluated:\t%d", n.n_evaluated);
nz_printf( "n_xref:\t\t%d", n.n_xref);
nz_printf( "lex_level:\t%d", n.lex_level);
nz_printf( "n_protect:\t%s", n.n_protect ?
token_name(n.n_protect) : 0);
if (n.n_dcl_printed || print_null_values) {
ind();
catprintf("n_dcl_printed:\t%d", n.n_dcl_printed);
switch(n.n_dcl_printed)
{
case 0:
catprintf("(not)\n");
break;
case 1:
printf("(declaration)\n");
break;
case 2:
printf("(definition)\n");
break;
}
}
if(n.n_template_arg) {
ind();
catprintf( "n_template_arg:\t");
switch(n.n_template_arg)
{
case template_type_formal:
catprintf("template_type_formal\n");
break;
case template_expr_formal:
catprintf("template_expr_formal\n");
break;
case template_stmt_tree_formal:
catprintf("template_stmt_formal\n");
break;
case template_expr_tree_formal:
catprintf("template_expr_tree_formal\n");
break;
case template_actual_arg_dummy:
catprintf("template_actual_arg_dummy\n");
break;
} ;
}
nz_printf( "n_addr_taken:\t%d", n.n_addr_taken);
nz_printf( "n_used:\t\t%d", n.n_used);
nz_printf( "n_assigned_to:\t%d", n.n_assigned_to);
ind();
catprintf("loc:\t\t");
print_loc(n.where);
catprintf("\n");
nz_printf( "n_offset:\t%d", n.n_offset);
// if(n.output_string) { print_string("output_string", (void *)n.output_string); }
nz_printf( "n_val:\t\t%ld", n.n_val);
print_ptr("n_list", n.n_list);
print_ptr("n_tbl_list", n.n_tbl_list);
if(n.n_gen_fct_name)
print_string("n_gen_fct_name", n.n_gen_fct_name);
if(n.n_template_arg_string) {
print_string("n_template_arg_string",
n.n_template_arg_string);
}
switch(n.discriminator(0)) {
case 2: print_ptr("n_realscope", n.n_realscope); break;
case 1: print_ptr("n_qualifier", n.n_qualifier); break;
}
nz_printf("n_val:\t%ld", n.n_val);
indent += Indent_Increment;
a_expr(1); /* do the supertype. */
indent -= Indent_Increment;
}
void
displayer::a_fct()
{
struct fct& f = *Pfct(node);
printf("$fct %s |0x%p",
token_name(node->base),
node_address);
printf("nargs:\t\t%d", f.nargs);
printf("nargs_known:\t%d%s", f.nargs_known,
f.nargs_known == 0 ? " UNKNOWN" :
(f.nargs_known == 1 ? " KNOWN" :
(f.nargs_known == ELLIPSIS ? "ELLIPSIS" : "" )));
nz_printf( "f_vdef:\t\t%d", f.f_vdef);
printf("f_inline:\t%d%s", f.f_inline,
f.f_inline == 0 ? "" :
f.f_inline == 1 ? " inline" :
f.f_inline == 2 ? " inline in expansion" : "");
nz_printf( "f_const:\t\t%d", f.f_const);
nz_printf( "f_static:\t\t%d", f.f_static);
nz_printf( "f_virtual:\t%d", f.f_virtual);
nz_printf( "f_imeasure:\t%d", f.f_imeasure);
print_string("f_signature", (void *)f.f_signature);
print_ptr("returns", f.returns);
print_ptr("argtype", f.argtype);
print_ptr("s_returns", f.s_returns);
print_ptr("f_this", f.f_this);
print_ptr("memof", f.memof);
print_ptr("body", f.body);
print_ptr("f_init", f.f_init);
print_ptr("f_expr", f.f_expr);
print_ptr("last_expanded", f.last_expanded);
print_ptr("f_result", f.f_result);
print_ptr("f_args", f.f_args);
print_ptr("local_classes", f.local_class);
indent += Indent_Increment;
a_type(); /* do the supertype. */
indent -= Indent_Increment;
}
void
displayer::a_stmt ()
{
struct stmt& s = *Pstmt(node);
ind();
catprintf("$stmt %s |0x%p ",
token_name(node->base),
node_address);
print_loc(s.where);
*arg->output_stream << "\n";
ind();
*arg->output_stream << "where:\t";
print_loc(s.where);
*arg->output_stream << "\n";
print_ptr("s", s.s);
print_ptr("s_list", s.s_list);
print_ptr("memtbl", s.memtbl);
switch(s.discriminator(0)) {
case 1: print_ptr("d", s.d); break;
case 2: print_ptr("e2", s.e2); break;
case 3: print_ptr("has_default", s.has_default); break;
case 4: nz_printf("case_value:\t0x%x", s.case_value);
case 5: print_ptr("ret_tp", s.ret_tp); break;
}
switch(s.discriminator(1)) {
case 1: print_ptr("e", s.e); break;
case 2: nz_printf("own_tbl:\t%d", s.own_tbl); break;
case 3: print_ptr("s2", s.s2); break;
}
switch(s.discriminator(2)) {
case 1: print_ptr("for_init", s.for_init); break;
case 2: print_ptr("else_stmt",s.for_init); break;
case 3: print_ptr("case_list", s.case_list); break;
}
}
void
displayer::a_enumdef ()
{
struct enumdef& e = *Penum(node);
printf("$enumdef %s |0x%p",
token_name(node->base),
node_address);
nz_printf( "e_body:\t\t%d", e.e_body);
nz_printf( "no_of_enumerators: %d",
e.no_of_enumerators);
nz_printf( "strlen:\t%d", e.strlen);
print_string ("string", (void *)e.string);
print_ptr("mem", e.mem);
print_ptr("e_type", e.e_type);
indent += Indent_Increment;
a_type(); /* do the supertype. */
indent -= Indent_Increment;
}
void
displayer::a_classdef ()
{
struct classdef& c = *Pclass(node);
ind();
catprintf("$classdef %s |0x%p ",
token_name(node->base),
node_address);
print_string_brief(c.string);
*arg->output_stream << "\n";
ind();
catprintf("class_base:\t");
switch(c.class_base)
{
case vanilla_class:
*arg->output_stream << "vanilla_class\n";
break;
case template_class:
*arg->output_stream << "template_class\n";
Template_Class:
nz_printf("inst:\t\t%p", (int)Ptclass(&c)->inst);
break;
case instantiated_template_class:
*arg->output_stream << "instantiated_template_class\n";
goto Template_Class;
case uninstantiated_template_class:
*arg->output_stream << "uninstantiated_template_class\n";
goto Template_Class;
case relationship_class:
*arg->output_stream << "relationship_class\n";
break;
case defining_class:
*arg->output_stream << "defining_class\n";
break;
}
nz_printf( "c_body:\t\t%d", c.c_body);
printf("csu:\t\t%s",
token_name(c.csu));
nz_printf( "obj_align:\t%d", c.obj_align);
if(c.c_xref) {
ind();
catprintf( "c_xref:\t%x", c.c_xref);
flag(c.c_xref & 1, "has-vptr ");
flag(c.c_xref & 2, "X(X&)-defined ");
flag(c.c_xref & 4, "operator=(X&)-defined ");
flag(c.c_xref & 8, "has-vbaseptr(s) ");
*arg->output_stream << "\n";
}
nz_printf( "virt_count:\t%d", c.virt_count);
nz_printf( "virt_merge:\t%d", c.virt_merge);
nz_printf( "c_abstract:\t%d", c.c_abstract);
nz_printf( "has_vvtab:\t%d", c.has_vvtab);
nz_printf( "strlen:\t%d", c.strlen);
print_string ("string", (void *)c.string);
nz_printf( "obj_size:\t%d", c.obj_size);
nz_printf( "real_size:\t%d", c.real_size);
nz_printf("lex_level:\t%d", c.lex_level);
if(c.lcl)print_string("lcl", c.lcl);
print_ptr("baselist", c.baselist);
print_ptr("mem_list", c.mem_list);
print_ptr("memtbl", c.memtbl);
print_ptr("friend_list", c.friend_list);
print_ptr("pubdef", c.pubdef);
print_ptr("tn_list", c.tn_list); /* not brief */
print_ptr("in_class", c.in_class);
print_ptr("in_fct", c.in_fct);
print_ptr("this_type", c.this_type);
print_ptr("virt_list", c.virt_list);
print_ptr("c_ctor", c.c_ctor);
print_ptr("c_dtor", c.c_dtor);
print_ptr("c_itor", c.c_itor);
print_ptr("conv", c.conv);
indent += Indent_Increment;
a_type(); /* do the supertype. */
indent -= Indent_Increment;
}
void
displayer::a_virt()
{
virt& v = *Pvirt(node);
void * vna;
void * vna_e;
int vx;
printf("$virt %s |0x%p ",
token_name(node->base),
node_address);
print_ptr("next", v.next);
if(v.n_init) {
printf("n_init:\t%d", v.n_init);
printf("virt_init:");
for (vna = v.virt_init, vx = 0; vx < (v.n_init - 1);
vna = (char *)vna + sizeof (velem), vx++)
{
fetch(vna, sizeof (velem), vna_e);
struct velem * ve = (struct velem *) vna_e;
ind();
catprintf("%d offset %d\t", vx, ve->offset);
print_ptr(ve->n);
free_fetched(vna_e);
}
}
print_ptr("vclass", v.vclass);
nz_printf( "\nis_vbase:\t %d", v.is_vbase);
nz_printf( "\nprinted:\t %d", v.printed);
}
void
displayer::a_table ()
{
struct table& t = *Ptable(node);
int x;
int y;
void * nlist;
void * slist;
printf("$table %s |0x%p",
token_name(node->base),
node_address);
printf("init_stat:\t%d%s", t.init_stat,
t.init_stat == 0 ? " not simplified" :
t.init_stat == 1 ? " simplified, no inits" :
t.init_stat == 2 ? " simplified, inits" :
"");
printf("size:\t%d", t.size);
printf("hashsize:\t%d", t.hashsize);
printf("free_slot:\t%d", t.free_slot);
/* it looks like there is an array of Pnames here ... */
*arg->output_stream << "\n";
ind();
*arg->output_stream << "entries:\n";
fetch((void *)t.entries, t.size * sizeof(Pname), nlist);
Pname * tmp_nlist = (Pname *)nlist;
for(x = 0; x < t.size; x ++) {
if(tmp_nlist[x]) {
ind();
*arg->output_stream << x;
*arg->output_stream << "\t";
print_ptr(tmp_nlist[x]);
unsigned char tmp_name_s[sizeof(name)];
void * tmp_name;
tmp_name = (void *)&tmp_name_s[0];
fetch(tmp_nlist[x], sizeof(name), tmp_name);
catprintf(" key %d\n", Pname(tmp_name)->n_key);
}
}
free_fetched(nlist);
/* and then an array of shorts for the hash table. */
/* we really need a tabular format here, alright. */
ind();
*arg->output_stream << "hashtbl:\n";
fetch(t.hashtbl, t.hashsize * sizeof(short), slist);
short * tmp_slist = (short *)slist;
for(x = 0;; x++ ) {
for (y = 0; y < 11; y ++) {
if(((x * 12) + y) > t.hashsize) break;
catprintf("%6d ", tmp_slist[(x*12)+y]);
}
*arg->output_stream << "\n";
if(((x * 12) + y) > t.hashsize) break;
}
free_fetched (slist);
print_ptr("t_name", t.t_name);
print_ptr("real_block", t.real_block);
print_ptr("name", t.t_name);
print_ptr("next", t.next);
}
void
displayer::a_gen ()
{
struct gen& g = *Pgen(node);
printf("$gen %s |0x%p",
token_name(node->base),
node_address);
print_ptr ("fct_list", g.fct_list);
indent += Indent_Increment;
a_type(); /* do the supertype. */
indent -= Indent_Increment;
}
void
displayer::a_vec ()
{
struct vec& v = *Pvec(node);
printf("$vec %s |0x%p",
token_name(node->base),
node_address);
printf("size:\t\t%d", v.size);
print_ptr ("typ", v.typ);
print_ptr ("dim", v.dim);
}
void
displayer::a_ptr ()
{
struct ptr& p = *Pptr(node);
printf("$ptr %s |0x%p",
token_name(node->base),
node_address);
ind();
printf("rdo:\t\t%d", p.rdo);
ind();
print_ptr ("typ", p.typ);
print_ptr ("memof", p.memof);
}
void
displayer::a_nlist()
{
name_list& n = *Plist(node);
printf("$name_list %s |0x%p ",
token_name(node->base),
node_address);
print_ptr("f", n.f);
print_ptr("l", n.l);
}
void
displayer::a_iline()
{
struct iline& i = *(struct iline *)node;
printf("$iline %s |0x%p ",
token_name(node->base),
node_address);
print_ptr("fct_name", i.fct_name);
print_ptr("i_next", i.i_next);
print_ptr("i_table", i.i_table);
nz_printf("i_slots:\t%d", i.i_slots);
print_ptr("i_args", i.i_args);
}
void
displayer::a_ia()
{
struct ia& i = *(struct ia *)node;
printf("$ia %s |0x%p ",
token_name(node->base),
node_address);
print_ptr("local", i.local);
print_ptr("arg", i.arg);
print_ptr("tp", i.tp);
}
static int fetcher (void * info,
void * pointer,
unsigned long length,
int zero_stop, /* for character strings.*/
void * target)
{
displayer * d = (displayer *)info;
if(d->arg->fetcher)
return d->arg->fetcher(d->arg->fetcher_info, pointer, length,
zero_stop, target);
}
static void
do_node (Pnode& node, node_class cl, void * info, tree_node_action& action,
int depth, Pnode na, tree_walk_tree&, int&)
{
displayer * d = (displayer *)info;
d->do_node(node, cl, action, depth, na);
d->arg->output_stream->write("\n", 1);
}
/* Note -- declared extern "C" in tree_dump.h. */
void
display_cfront_node (dcn_arg& arg, Pnode n)
{
tree_walk_control twc;
displayer d (arg);
if(arg.verbose == dt_normal)arg.max_depth = 0;
twc.callback_info = (void *)&d;
if(arg.fetcher) twc.fetcher = fetcher;
twc.action_proc = do_node;
twc.error_stream = arg.error_stream;
twc.nodes_seen_hash = arg.nodes_seen_hash;
twc.resolve_by_name = 0; /* we want to display the by_name nodes */
twc.dont_chase_lists_top = 1; /* don't display n_list or s_list peers
at the top level. */
walk_tree(twc, n);
arg.error_stream->flush();
arg.output_stream->flush();
}
extern "C" void _fcout();
void _fcout () { cout.flush(); }
0707071010112046001004440001630000160000010207660466055415100001400000003407tree_dump.h /* ident "@(#)ctrans:src/tree_dump.h 1.2" */
/* -*- Mode: C -*- Begin tree_dump.h */
#ifndef _DUMP_TREE
#define _DUMP_TREE
#include "tree_walk.h"
#include <iostream.h>
#include "hash.h"
enum dump_tree_verbosity {
dt_brief = 1, /* minimal identification */
dt_normal = 2, /* all data, outpointers Brief (one level) */
dt_recursive_0 = 3, /* minimal, but recurse down.
(outpointers Recursive_0) */
dt_recursive_1 = 4, /* all data, outpointers Recursive_2. */
};
class dcn_arg {
public:
int version;
dump_tree_verbosity verbose;
tree_fetch_proc fetcher;
void * fetcher_info;
ostream* output_stream;
ostream* error_stream;
int max_depth;
Hash * nodes_seen_hash;
/* end of version 1 */
int walk_tables;
/* end of version 2 */
int stop_at_top;
dcn_arg () { version = 2;
nodes_seen_hash = 0;
fetcher = null_tfp;
output_stream = &cout;
error_stream = &cerr;
max_depth = -1;
walk_tables = 1;
stop_at_top = 0;
};
};
extern "C" {
void display_cfront_node (dcn_arg&, Pnode);
}
#else
typedef enum dump_tree_verbosity {
dt_brief = 1, /* minimal identification */
dt_normal = 2, /* all data, outpointers Brief (one level) */
dt_recursive_0 = 3, /* minimal, but recurse down.
(outpointers Recursive_0) */
dt_recursive_1 = 4, /* all data, outpointers Recursive_2. */
} dump_tree_verbosity;
struct dcn_arg {
int version; /* must be 1 for now. */
dump_tree_verbosity verbose;
int (*fetcher) ();
void * fetcher_info;
void * output_stream; /* these are c++ streams */
void * error_stream;
int max_depth;
void * nodes_seen_hash;
int walk_tables;
int stop_at_top;
};
void display_cfront_node ();
#endif
/* End tree_dump.h */
0707071010112046051004440001630000160000010212000466055417300001400000066517tree_walk.c /* ident "@(#)ctrans:src/tree_walk.c 1.2" */
/*
tree_walk.c
Utilities for tree-walking
*/
#include "cfront.h"
#include "tree_walk.h"
#include <stdarg.h>
#include "hash.h"
// #include <alloca.h>
// ************ need to add an explicit call of free
// ************ make it an ifdef
// ??? #include <streamdefs.h>
#include <malloc.h>
class walker {
tree_walk_control control;
Pnode orig_addr;
Hash *nodes_seen_hash;
int depth;
int made_ht;
tree_walk_tree * cur_tree;
public:
walker(tree_walk_control& c) ;
~walker () {
if(made_ht) delete nodes_seen_hash;
}
tree_node_action walk (Pnode&);
tree_node_action walk_ (Pnode& n)
{
if(n) {
int save_depth = depth;
tree_walk_tree * save_cur_tree = cur_tree;
depth ++;
if(control.alloc_stack_bytes) {
cur_tree = (tree_walk_tree *)
// alloca (control.alloc_stack_bytes + sizeof (tree_walk_tree));
malloc(control.alloc_stack_bytes + sizeof (tree_walk_tree));
cur_tree->parent = save_cur_tree;
}
tree_node_action r = walk(n);
depth = save_depth;
return r;
} else return tna_continue;
}
tree_node_action walk(Pgen& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Pvec& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Pptr& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Ptype& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Pfct& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Ptable& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Pbase& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Pname& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Pexpr& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Pstmt& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Pblock& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Penum& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Pclass& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Pvirt& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Plist& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Pin& n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(struct ia * & n)
{ return walk_ ((struct node * &)n); };
tree_node_action walk(Pbcl& n)
{ return walk_ ((struct node * &)n); };
private:
int fetching () { return (control.fetcher != null_tfp); } ;
void free_fetched (void *);
int fetch (void *, unsigned long, void *&);
int fetch (void * a, unsigned long l, Pnode& p)
{
int ret;
void * t; /* this is an output argument */
ret = fetch(a,l,t);
if(!ret) {
p = Pnode(t);
}
return ret;
};
// void error (const char *,...); ?? at&t -- to get it up quick, line 155
void error ( char *, unsigned long=0 );
tree_node_action pre_act_on_node (Pnode node, node_class nc,
Pnode node_copy, Pnode& replacement);
tree_node_action a_gen (Pnode, Pgen, Pnode&);
tree_node_action a_vec (Pnode, Pvec, Pnode&);
tree_node_action a_ptr (Pnode, Pptr, Pnode&);
tree_node_action a_fct (Pnode, Pfct, Pnode&);
tree_node_action a_table (Pnode, Ptable, Pnode&);
tree_node_action a_basetype (Pnode, Pbase, Pnode&);
tree_node_action a_name(Pnode, Pname, Pnode&);
tree_node_action a_expr (Pnode, Pexpr, Pnode&);
tree_node_action a_stmt (Pnode, Pstmt, Pnode&);
tree_node_action a_enumdef (Pnode, Penum, Pnode&);
tree_node_action a_classdef (Pnode, Pclass, Pnode&);
tree_node_action a_virt (Pnode, Pvirt, Pnode&);
tree_node_action a_name_list (Pnode, Plist, Pnode&);
tree_node_action a_iline (Pnode, Pin, Pnode&);
tree_node_action a_ia (Pnode, struct ia *, Pnode&);
tree_node_action a_baseclass (Pnode, Pbcl, Pnode&);
tree_node_action a_expr_guts (Pexpr);
};
walker::walker(tree_walk_control& c)
{ control = c;
made_ht = 0;
if (c.nodes_seen_hash)
nodes_seen_hash = c.nodes_seen_hash;
else {
nodes_seen_hash = new pointer_hash (100);
made_ht = 1;
}
depth = 0;
cur_tree = 0;
}
tree_node_action
walk_tree (tree_walk_control& c, Pnode& n)
{
walker w (c);
return w.walk(n);
}
/* error messages are of finite length, so no need to run
around mallocing strings */
// void walker::error (const char * format, ...)
void walker::error (char *format, unsigned long v)
{
va_list args;
va_start(args, format);
if(control.call_i_error) {
char buf[1000];
// vsprintf(buf, format, args);
// vsprintf not universal: by inspection
// all calls are currently of 1 or 0 arguments
sprintf(buf, format, v);
(*control.i_error)('i', buf);
} else {
vostream_printf (format, args, *control.error_stream);
*control.error_stream << "\n";
control.error_stream->flush();
}
va_end (args);
}
void
walker::free_fetched (void * addr)
{
if (control.fetcher != null_tfp) /* null indicates no cross-address-space */
free ((char *)addr);
}
int
walker::fetch (void * addr, unsigned long length, void*& taddr)
{
int err;
if (control.fetcher == null_tfp) {
taddr = addr;
return 0;
} else {
taddr = (void *)malloc ((unsigned int)length);
if(taddr == 0) {
error ("walker::fetch: failed to malloc %d bytes.", length);
return 1;
}
err = (*control.fetcher) (control.callback_info, addr, length, 0, taddr);
if(err) {
error("walker::fetch: fetcher returned %d.", err);
return 1;
}
}
}
/* ::walk is called with a node pointer and a reference to
a replacement node pointer. When it returns,
replacement will be set if the action procedure
called on the node decided to copy it or replace it.
There are two possible modularities.
In case there is cross-address-space action,
::walk can't call the action procedure until it has
entered the case on node bases. Once it has,
it calls the per-structure-type procedure,
which calls the action proc. If the action
proc supplies a replacement, then that replacement
will be returned up via the reference parameters to
the per-structure procedures.
It the action procedure returns tna_continue,
then the walk continues against the new copy of the node
so that further replacements are reflected in the new copies.
This prevents replacement from being meaningful cross-address-space,
since the new copy will presumably be in the current
(and not the cross) address space. That is, if the node
is replaced by the action proc, the pointers in the new
node will drive the subsequent tree walk. Usually one
would just bitcopy, and then they would be replaced in turn.
*/
tree_node_action
walker::walk (Pnode& top)
{
Pnode replacement = 0;
tree_node_action err;
int class_err;
node_class nclass;
Pnode node = 0; /* assign to shut up compiler,
which dosen't recognize pass-by-reference as a set */
orig_addr = top;
if(fetching ()) {
if(fetch((void *)top, sizeof (struct node), node))
return tna_error;
} else node = top;
/* This has a complete catalog of bases, rather than just a list
of those associated with data structures. Its important
to detect the errs.
*/
nclass = classify_node (node, class_err);
if(class_err) {
error("walker::walk: unknown node type %d.", node->base);
free_fetched ((void *)node);
err = tna_error;
goto Return;
}
switch(nclass)
{
default:
case nc_unused:
error("walker::walk: unused node type %d.", node->base);
err = tna_error;
goto Return;
case nc_eof:
break;
case nc_virt:
fetch((void *)top, sizeof (struct virt), node);
err = a_virt(top, Pvirt (node), replacement);
break;
case nc_nlist:
fetch((void *)top, sizeof (struct name_list), node);
err = a_name_list(top, (struct name_list *)node, replacement);
break;
case nc_iline:
fetch((void *)top, sizeof (struct iline), node);
err = a_iline(top, (struct iline *)node, replacement);
break;
case nc_gen:
fetch((void *)top, sizeof (struct gen), node);
err = a_gen(top, Pgen (node), replacement);
break;
case nc_vec:
fetch((void *)top, sizeof (struct vec), node);
err = a_vec(top, Pvec(node), replacement);
break;
case nc_ptr:
fetch((void *)top, sizeof (struct ptr), node);
err = a_ptr(top, Pptr(node), replacement);
break;
case nc_fct:
fetch((void *)top, sizeof (struct fct), node);
err = a_fct(top, Pfct(node), replacement);
break;
case nc_table:
fetch((void *)top, sizeof (struct table), node);
err = a_table(top, Ptable(node), replacement);
break;
case nc_basetype:
fetch((void *)top, sizeof (struct basetype), node);
err = a_basetype(top, Pbase(node), replacement);
break;
case nc_name:
fetch((void *)top, sizeof (struct name), node);
err = a_name(top, Pname(node), replacement);
break;
case nc_expr:
fetch((void *)top, sizeof (struct expr), node);
err = a_expr(top, Pexpr(node), replacement);
break;
case nc_stmt:
fetch((void *)top, sizeof (struct stmt), node);
err = a_stmt(top, Pstmt(node), replacement);
break;
case nc_enumdef:
fetch((void *)top, sizeof (struct enumdef), node);
err = a_enumdef(top, Penum(node), replacement);
break;
case nc_classdef:
fetch((void *)top, sizeof (struct classdef), node);
err = a_classdef(top, Pclass(node), replacement);
break;
case nc_ia:
fetch((void *)top, sizeof (struct ia), node);
err = a_ia(top, (struct ia *)node, replacement);
break;
case nc_baseclass:
fetch((void *)top, sizeof (struct basecl), node);
err = a_baseclass(top, Pbcl(node), replacement);
break;
}
if(replacement) {
if (fetching ()) {
error
("walker::walk: Attempt to replace tree in cross-address space mode.");
err = tna_error;
}
else top = replacement;
}
if (control.post_action_proc && err != tna_error) {
tree_node_action post_err;
Pnode& post_repl = node;
(*control.post_action_proc) (post_repl, nclass, control.callback_info, post_err,
depth, orig_addr, *cur_tree);
if(post_err != tna_continue) err = post_err;
if(post_repl != node) {
if (fetching ()) {
error
("walker::walk: Attempt to replace tree in cross-address space mode.");
err = tna_error;
}
else top = post_repl;
}
}
free_fetched((void *) node);
Return:
return err;
}
/* This is called in pre-order for each node. Then
post_act_on_node is called after whatever recursive
processing ensues.
This is called from each of the structure-specific procedures
to give the action procedure an opportunity to act.
It can return a replacement pointer and control
whether to examine the insides of the node.
*/
tree_node_action
walker::pre_act_on_node (Pnode node, node_class nc,
Pnode node_copy, Pnode& replacement)
{
/* If we have been here before, then we never proceed */
/* node_copy is != node when a fetcher is in use */
int found;
int old_node;
tree_node_action action;
Pnode new_node;
int register_in_hash = 1;
nodes_seen_hash->action((int)node, 0, Hash::probe, found, old_node);
if(found) {
new_node = Pnode(old_node);
if(new_node != node) replacement = new_node;
return tna_stop; /* no need to proceed */
}
/* OK, we don't know from a previous pass. Call our actor */
new_node = fetching () && node_copy ? node_copy : node;
(*control.action_proc)(new_node, nc, control.callback_info, action,
depth, orig_addr, *cur_tree,
register_in_hash);
if(action != tna_error && !fetching () && new_node != node) {
replacement = new_node;
if(register_in_hash)
nodes_seen_hash->action((int)node,
(int)new_node,
Hash::insert, 0, 0);
}
else {
if(register_in_hash)
nodes_seen_hash->action((int)node, (int) node, Hash::insert, 0, 0);
}
return action;
}
tree_node_action walker::a_table(Pnode ta, Ptable t, Pnode& replacement)
{
/* no unions */
tree_node_action action;
action = pre_act_on_node(ta, nc_table, Pnode(t), replacement);
if(action != tna_continue) return action;
/* -----------------------------*/
/* For Now, Never Walk a Table. */
action = tna_stop; return action;
/* An array of pointers.
* The action procedure is responsible for allocating a new one
* of those if it replaced and continued.
* *** end of comment
if(!fetching () && replacement)
t = Ptable(replacement);
Pname * t_entries;
if(fetching ()) {
void * temp;
fetch((void *)t->entries, t->size * sizeof(Pname), temp);
t_entries = (Pname *)temp;
}
else t_entries = t->entries;
for(int nx = 0; nx < t->size; nx ++) {
action = walk(t_entries[nx]);
if(action == tna_error) return action;
}
if(fetching ()) free_fetched ((void *)t_entries);
Pnode n = Pnode(t->real_block);
action = walk(t->real_block);
if(action == tna_error) return action;
action = walk(t->next);
action = walk(t->t_name);
return tna_continue;
*/ // don't walk table
}
tree_node_action walker::a_enumdef (Pnode ta, Penum e, Pnode& replacement)
{
tree_node_action action = pre_act_on_node(ta, nc_enumdef, Pnode(e), replacement);
action = walk(e->mem);
if(action == tna_error) return action;
action = walk(e->e_type);
return tna_continue;
}
tree_node_action walker::a_virt(Pnode ta, Pvirt v, Pnode& replacement)
{
/* no unions */
int nx;
tree_node_action action = pre_act_on_node(ta, nc_enumdef, Pnode(v), replacement);
if(action != tna_continue) return action;
if(!fetching () && replacement)
v = Pvirt(replacement);
/* an array of velem structures. */
velem * v_virt_init;
if(fetching ()) {
void * t;
fetch((void *)v->virt_init, v->n_init * sizeof(velem), t);
v_virt_init = (velem *)t;
}
else v_virt_init = v->virt_init;
for(nx = 0; nx < v->n_init; nx ++) {
action = walk(v_virt_init[nx].n);
if(action == tna_error) return action;
}
if(fetching ()) free_fetched ((void *)v_virt_init);
action = walk(v->vclass);
return tna_continue;
}
tree_node_action walker::a_classdef(Pnode ta, Pclass c, Pnode& replacement)
{
tree_node_action action = pre_act_on_node(ta, nc_classdef, Pnode(c), replacement);
if(action != tna_continue) return action;
if(!fetching () && replacement)
c = Pclass(replacement);
action = walk(c->baselist);
if(action == tna_error) return action;
action=walk(c->mem_list);
if(action == tna_error) return action;
action=walk(c->memtbl);
if(action == tna_error) return action;
action=walk(c->friend_list);
if(action == tna_error) return action;
action=walk(c->pubdef);
if(action == tna_error) return action;
action=walk(c->tn_list);
if(action == tna_error) return action;
action=walk(c->in_class);
if(action == tna_error) return action;
action=walk(c->in_fct);
if(action == tna_error) return action;
action=walk(c->this_type);
if(action == tna_error) return action;
action=walk(c->virt_list);
if(action == tna_error) return action;
action=walk(c->c_ctor);
if(action == tna_error) return action;
action=walk(c->c_dtor);
if(action == tna_error) return action;
action=walk(c->c_itor);
if(action == tna_error) return action;
action=walk(c->conv);
if(action == tna_error) return action;
return tna_continue;
}
tree_node_action walker::a_basetype(Pnode ta, Pbase b, Pnode& replacement)
{
tree_node_action action = pre_act_on_node(ta, nc_basetype, Pnode(b), replacement);
int derr;
if(action != tna_continue) return action;
if(!fetching () && replacement)
b = Pbase(replacement);
action = walk(b->b_name);
if(action == tna_error) return action;
action = walk(b->b_table);
if(action == tna_error) return action;
// action = walk(b->b_field);
// if(action == tna_error) return action;
action = walk(b->b_xname);
if(action == tna_error) return action;
switch(derr = b->discriminator(0)) {
case 0: break;
case 1:
action = walk(b->b_fieldtype);
if(action == tna_error) return action;
break;
case 2: break;
default:
error ("a_basetype: discrim error %d.", derr);
return tna_error;
}
return tna_continue;
}
tree_node_action walker::a_fct(Pnode ta, Pfct f, Pnode& replacement)
{
tree_node_action action = pre_act_on_node(ta, nc_fct, Pnode(f), replacement);
if(action != tna_continue) return action;
if(!fetching () && replacement)
f = Pfct(replacement);
action = walk(f->returns);
if(action == tna_error) return action;
action = walk(f->argtype);
if(action == tna_error) return action;
action = walk(f->s_returns);
if(action == tna_error) return action;
action = walk(f->f_this);
if(action == tna_error) return action;
action = walk(f->memof);
if(action == tna_error) return action;
action = walk(f->body);
if(action == tna_error) return action;
action = walk(f->f_init);
if(action == tna_error) return action;
action = walk(f->f_expr);
if(action == tna_error) return action;
action = walk(f->last_expanded);
if(action == tna_error) return action;
action = walk(f->f_result);
if(action == tna_error) return action;
action = walk(f->f_args);
if(action == tna_error) return action;
return tna_continue;
}
tree_node_action walker::a_name_list(Pnode ta, Plist l, Pnode& replacement)
{
int cl_error;
tree_node_action action = pre_act_on_node(ta, nc_nlist, Pnode(l), replacement);
if(action == tna_stop) {
if(!fetching () && replacement)
l = Plist(replacement);
cl_error = 0;
if((classify_node(Pnode(l), cl_error) == nc_nlist) && !cl_error) {
action = walk(l->l);
if(action == tna_error) return action;
}
}
if(action != tna_continue) return action;
if(!fetching () && replacement)
l = Plist(replacement);
action = walk(l->f);
if(action == tna_error) return action;
action = walk(l->l);
if(action == tna_error) return action;
return tna_continue;
}
tree_node_action walker::a_gen(Pnode ta, Pgen g, Pnode& replacement)
{
tree_node_action action = pre_act_on_node(ta, nc_gen, Pnode(g), replacement);
if(action != tna_continue) return action;
if(!fetching () && replacement)
g = Pgen(replacement);
action = walk(g->fct_list);
if(action == tna_error) return action;
return tna_continue;
}
tree_node_action walker::a_vec(Pnode ta, Pvec v, Pnode& replacement)
{
tree_node_action action = pre_act_on_node(ta, nc_vec, Pnode(v), replacement);
if(action != tna_continue) return action;
if(!fetching () && replacement)
v = Pvec(replacement);
action = walk(v->typ);
if(action == tna_error) return action;
action = walk(v->dim);
if(action == tna_error) return action;
return tna_continue;
}
tree_node_action walker::a_ptr(Pnode ta, Pptr p, Pnode& replacement)
{
tree_node_action action = pre_act_on_node(ta, nc_ptr, Pnode(p), replacement);
if(action != tna_continue) return action;
if(!fetching () && replacement)
p = Pptr(replacement);
action = walk(p->typ);
if(action == tna_error) return action;
action = walk(p->memof);
if(action == tna_error) return action;
return tna_continue;
}
tree_node_action walker::a_expr_guts(Pexpr e)
{
int derr;
tree_node_action action;
switch(derr = e->discriminator (0)) {
case 1:
action = walk(e->tp);
if(action == tna_error) return action;
break;
case 0:
break;
default:
error ("a_expr: discrim error %d on union 0.", derr);
return tna_error;
}
switch(derr = e->discriminator (1)) {
case 0:
break;
default:
error ("a_expr: discrim error %d on union 1.", derr);
return tna_error;
case 1:
action = walk(e->e1);
if(action == tna_error) return action;
break;
case 2:
break;
case 3:
break;
}
switch(derr = e->discriminator (2)) {
case 0:
break;
default:
error ("a_expr: discrim error %d on union 2.", derr);
return tna_error;
case 1:
/* elists are special. e2 for an elist is a peer, not
a child. */
if(e->base != ELIST) {
action = walk(e->e2);
if(action == tna_error) return action;
}
break;
case 2:
break;
case 3:
break;
case 4:
action = walk(e->n_initializer);
if(action == tna_error) return action;
break;
}
switch(derr = e->discriminator (3)) {
case 0:
break;
default:
error ("a_expr: discrim error %d on union 3.", derr);
return tna_error;
case 1:
action = walk(e->tp2);
if(action == tna_error) return action;
break;
case 2:
action = walk(e->fct_name);
if(action == tna_error) return action;
break;
case 3:
action = walk(e->cond);
if(action == tna_error) return action;
break;
case 4:
action = walk(e->mem);
if(action == tna_error) return action;
break;
case 5:
action = walk(e->as_type);
if(action == tna_error) return action;
break;
case 6:
action = walk(e->n_table);
if(action == tna_error) return action;
break;
case 7:
action = walk(e->il);
if(action == tna_error) return action;
break;
case 8:
action = walk(e->query_this);
if(action == tna_error) return action;
break;
}
return tna_continue;
}
tree_node_action walker::a_expr(Pnode ta, Pexpr e, Pnode& replacement)
{
tree_node_action action = pre_act_on_node(ta, nc_expr, Pnode(e), replacement);
if(action == tna_stop) {
if(!fetching () && replacement)
e = Pexpr(replacement);
/* ELIST implies that e2 is a peer, not a child */
if(e->base == ELIST) {
action = walk(e->e2);
return action;
}
}
if(action != tna_continue) return action;
if(!fetching () && replacement)
e = Pexpr(replacement);
action = a_expr_guts(e);
if (action == tna_error) return action;
if(e->base == ELIST)
action = walk(e->e2);
return action;
}
tree_node_action walker::a_baseclass(Pnode ta, Pbcl b, Pnode& replacement)
{
tree_node_action action = pre_act_on_node(ta, nc_baseclass, Pnode(b), replacement);
if(action != tna_continue) return action;
if(!fetching () && replacement)
b = Pbcl(replacement);
action = walk(b->bclass);
if(action == tna_error) return action;
action = walk(b->init);
if(action == tna_error) return action;
action = walk(b->next);
if(action == tna_error) return action;
return tna_continue;
}
/* a name is also an expr. */
tree_node_action walker::a_name(Pnode ta, Pname n, Pnode& replacement)
{
int derr;
int cl_error;
tree_node_action action = pre_act_on_node(ta, nc_name, Pnode(n), replacement);
/* n_list is a sibling, not a child. We always process it
except in case of an error. */
if(action == tna_stop) {
cl_error = 0;
if(!fetching () && replacement)
n = Pname(replacement);
if((classify_node(Pnode(n), cl_error) == nc_name) && !cl_error) {
if(depth > 0 || !control.dont_chase_lists_top) {
action = walk(n->n_list);
if(action == tna_error) return action;
}
}
return tna_stop;
}
if(action != tna_continue) return action;
if(!fetching () && replacement)
n = Pname(replacement);
/* We don't walk n_tbl_list. Its not part of the graph.
*/
switch(derr = n->discriminator(0)) {
case 0:
break;
case 1:
action = walk(n->n_qualifier);
if(action == tna_error) return action;
break;
case 2:
action = walk(n->n_realscope);
if(action == tna_error) return action;
break;
default:
error ("a_name: discrim error %d on union 0.", derr);
return tna_error;
}
action = a_expr_guts(Pexpr(n));
if(action == tna_error) return action;
if(depth > 0 || !control.dont_chase_lists_top) {
action = walk(n->n_list);
if(action == tna_error) return action;
}
return action;
}
/* --- NOTE: s_list should be deferred until AFTER the post-action
procedure is called, if there is one. Since no one uses
post-actions yet I haven't bothered to make this fix.
--benson */
tree_node_action walker::a_stmt(Pnode ta, Pstmt s, Pnode& replacement)
{
int cl_error;
int derr;
tree_node_action action = pre_act_on_node(ta, nc_stmt, Pnode(s), replacement);
if(action == tna_stop) {
if(!fetching () && replacement)
s = Pstmt(replacement);
cl_error = 0;
if((classify_node(Pnode(s), cl_error) == nc_stmt) && !cl_error) {
/* s_list is not our subordinate, it is our peer */
if(depth > 0 || !control.dont_chase_lists_top) {
action = walk(s->s_list); /* continue walk of sibs */
if (action == tna_error) return tna_error;
}
}
return tna_stop;
}
if(action != tna_continue) return action;
if(!fetching () && replacement)
s = Pstmt(replacement);
action = walk(s->s);
if(action == tna_error) return action;
action = walk(s->memtbl);
if(action == tna_error) return action;
switch(derr = s->discriminator(0)) {
default:
error ("a_stmt: discrim error %d on union 0.", derr);
return tna_error;
case 4:
case 0: break;
case 1:
action = walk(s->d);
if(action == tna_error) return action;
break;
case 2:
action = walk(s->e2);
if(action == tna_error) return action;
break;
case 3:
action = walk(s->has_default);
if(action == tna_error) return action;
break;
case 5:
action = walk(s->ret_tp);
if(action == tna_error) return action;
break;
}
switch(derr = s->discriminator(1)) {
default:
error ("a_stmt: discrim error %d on union 1.", derr);
return tna_error;
case 2:
case 0: break;
case 1:
action = walk(s->e);
if(action == tna_error) return action;
break;
case 3:
action = walk(s->s2);
if(action == tna_error) return action;
break;
}
switch(derr = s->discriminator(2)) {
default:
error ("a_stmt: discrim error %d on union 2.", derr);
return tna_error;
case 0: break;
case 1:
action = walk(s->for_init);
if(action == tna_error) return action;
break;
case 2:
action = walk(s->else_stmt);
if(action == tna_error) return action;
break;
case 3:
action = walk(s->case_list);
if(action == tna_error) return action;
break;
}
if(depth > 0 || !control.dont_chase_lists_top) {
action = walk(s->s_list);
if(action == tna_error) return action;
}
return tna_continue;
}
tree_node_action walker::a_ia(Pnode ta, struct ia * ia, Pnode& replacement)
{
tree_node_action action = pre_act_on_node(ta, nc_ia, Pnode(ia), replacement);
if(action != tna_continue) return action;
if(!fetching () && replacement)
ia = (struct ia *)&replacement;
action = walk(ia->local);
if(action == tna_error) return action;
action = walk(ia->arg);
if(action == tna_error) return action;
action = walk(ia->tp);
if(action == tna_error) return action;
return tna_continue;
}
tree_node_action walker::a_iline(Pnode ta, Pin iline, Pnode& replacement)
{
tree_node_action action = pre_act_on_node(ta, nc_iline, Pnode(iline), replacement);
if(action != tna_continue) return action;
if(!fetching () && replacement)
iline = Pin(replacement);
action = walk(iline->fct_name);
if(action == tna_error) return action;
action = walk(iline->i_next);
if(action == tna_error) return action;
action = walk(iline->i_table);
if(action == tna_error) return action;
action = walk(iline->i_args);
if(action == tna_error) return action;
return tna_continue;
}
0707071010112046151004440001630000160000010107200466055423100001400000004551tree_walk.h /* ident "@(#)ctrans:src/tree_walk.h 1.2" */
/* -*- Mode: C -*- Begin include file tree_walk.H */
/*
$Source: /var/lib/cvsd/repos/research/researchv10no/cmd/cfront/xptcfront/cfront.cpio,v $ $RCSfile: cfront.cpio,v $
$Revision: 1.1.1.1 $ $Date: 2018/04/24 17:21:35 $
$Author: root $ $Locker: $
$State: Exp $
*/
#ifndef _TREE_WALK
#define _TREE_WALK
#include "cfront.h"
#include "node_classes.h"
#include <iostream.h>
#include "ios_printf.h"
#include "hash.h"
enum tree_node_action {
tna_continue = 0, /* plain vanilla */
tna_stop = 1, /* don't proceed */
tna_error = 2, /* stop entire walk now. */
};
/* procedural interface to indirect via a pointer. */
typedef int (*tree_fetch_proc) (void * info,
void * pointer,
unsigned long length,
int zero_stop, /* for character strings.*/
void * target);
const tree_fetch_proc null_tfp = (tree_fetch_proc) 0;
class tree_walk_tree {
public:
tree_walk_tree * parent;
char storage[1]; /* variable amt, specified by caller. */
};
/* The trailing int here controls whether to remember the
node in the hash table to short-circuit meeting it again */
typedef void (*tree_pre_action)
(Pnode&, node_class, void *, tree_node_action&, int, Pnode,
tree_walk_tree&, int&);
typedef void (*tree_post_action)
(Pnode&, node_class, void *, tree_node_action&, int, Pnode,
tree_walk_tree&);
typedef void (*errorp) (char, const char *);
class tree_walk_control {
public:
int version;
void * callback_info;
tree_fetch_proc fetcher;
tree_pre_action action_proc;
tree_post_action post_action_proc;
int (*i_error) (int, const char *); /* usually part of cfront */
int call_i_error; /* if 0, just use the following */
ostream * error_stream;
Hash * nodes_seen_hash; /* allows this to be global over
more than one call to the walker. */
int resolve_by_name;
int alloc_stack_bytes;
/* if on, n_list and s_list are ignored for the very top node.
this is for the benefit of the printer. */
int dont_chase_lists_top;
tree_walk_control () {
version = 1;
callback_info = 0;
fetcher = null_tfp;
call_i_error = 0;
error_stream = &cerr;
nodes_seen_hash = 0;
resolve_by_name = 1; /* the dumper turns this off */
alloc_stack_bytes = 0;
post_action_proc = 0;
dont_chase_lists_top = 0;
}
};
tree_node_action walk_tree (tree_walk_control& c, Pnode& n);
#endif
0707071010112045721004440001630000160000010210200466055412600000600000054504typ.c /*ident "@(#)ctrans:src/typ.c 1.4" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
typ.c:
***************************************************************************/
#include "cfront.h"
#include "size.h"
Pbase short_type;
Pbase int_type;
Pbase char_type;
Pbase long_type;
Pbase uchar_type;
Pbase ushort_type;
Pbase uint_type;
Pbase ulong_type;
Pbase zero_type;
Pbase float_type;
Pbase double_type;
Pbase ldouble_type;
Pbase void_type;
Pbase any_type;
Ptype Pint_type;
Ptype Pchar_type;
Ptype Pvoid_type;
Ptype Pfctvec_type;
Ptable gtbl;
Ptable ptbl;
Pname Cdcl;
Pstmt Cstmt;
bit new_type;
void echeck(Ptype t1, Ptype t2)
/*
t1 is an enum, t2 is assigned to it
*/
{
if (t1 == t2) return;
//error('d',"echeck(%t,%t) %d %d",t1,t2,t1->base,t2->base);
//error('d',"se %d promote: %d",suppress_error, enum_promote);
if (t1->base==EOBJ
&& t2->base==EOBJ
&& Pbase(t1)->b_name->tp == Pbase(t2)->b_name->tp) return;
if (enum_promote) return;
error(strict_opt?0:'w',"%t assigned to %t (anachronism)",t2,t1);
}
Ptype np_promote(TOK oper, TOK r1, TOK r2, Ptype t1, Ptype t2, TOK p)
/*
an arithmetic operator "oper" is applied to "t1" and "t2",
types t1 and t2 has been checked and belongs to catagories
"r1" and "r2", respectively:
A ANY
Z ZERO
I CHAR, SHORT, INT, LONG, FIELD, or EOBJ
F FLOAT DOUBLE LDOUBLE
P PTR (to something) or VEC (of something)
test for compatability of the operands,
if (p) return the promoted result type
*/
{
if (r2 == 'A') return t1;
//error('d',"promote(%t,%t,%k)",t1,t2,oper);
switch (r1) {
case 'A': return t2;
case 'Z':
switch (r2) {
case 'Z': return int_type;
case 'I':
case 'F':
if(oper==DEREF) return any_type;
return (p) ? Pbase(t2)->arit_conv(0) : 0;
case 'P': switch (oper) {
case PLUS:
case ASPLUS: if(t2!=Pvoid_type) break;
default: return any_type;
}
return t2;
case FCT: error("zero%kF",oper); return any_type;
default: error('i',"zero(%d)",r2);
}
case 'I':
switch (r2) {
case 'Z': t2 = 0;
case 'I':
case 'F':
if(oper==DEREF) return any_type;
return (p) ? Pbase(t1)->arit_conv(Pbase(t2)) : 0;
case 'P': switch (oper) {
case PLUS:
case ASPLUS: if(t2!=Pvoid_type) break;
default: error("int%kP",oper); return any_type;
}
return t2;
case FCT: error("int%kF",oper); return any_type;
default: error('i',"int(%d)",r2); return any_type;
}
case 'F':
switch (r2) {
case 'Z': t2 = 0;
case 'I':
case 'F':
if(oper==DEREF) return any_type;
return (p) ? Pbase(t1)->arit_conv(Pbase(t2)) : 0;
case 'P': error("float%kP",oper); return any_type;
case FCT: error("float%kF",oper); return any_type;
default: error('i',"float(%d)",r2); return any_type;
}
case 'P':
switch (r2) {
case 'Z': return t1;
case 'I':
switch (oper) {
case PLUS:
case MINUS:
case ASPLUS:
case ASMINUS:
if (t1->check(Pvoid_type,0)==0) {
return any_type;
}
break;
default: error("P%k int",oper); return any_type;
}
return t1;
case 'F': error("P%k float",oper); return any_type;
case 'P':
if (t1->check(t2,ASSIGN)) {
switch (oper) {
case EQ:
case NE:
case LE:
case GE:
case GT:
case LT:
case QUEST:
if (t2->check(t1,ASSIGN) == 0) goto zz;
}
error("T mismatch:%t %k%t",t1,oper,t2);
return any_type;
}
zz:
switch (oper) {
case MINUS:
return (t2!=Pvoid_type) ? int_type : any_type;
case ASMINUS: error("P -=P"); return any_type;
case PLUS: error("P +P"); return any_type;
case ASPLUS: error("P +=P"); return any_type;
case LS:
case RS: return any_type;
default: return (t1!=Pvoid_type) ? t1 : any_type;
}
case FCT: return t1;
default: error('i',"P(%d)",r2);
}
case FCT:
if(oper == QUEST) {
switch (r2) {
case 'Z':
return any_type;
case 'P':
return t2;
case 'I':
case 'F':
error("F%k%t",oper,t2);
default:
return t1;
}
}
error("F%k%t",oper,t2);
return any_type;
default:
error('i',"np_promote(%d,%d)",r1,r2);
}
}
TOK type::kind(TOK oper, TOK v)
/* v == 'I' integral
'N' numeric
'P' numeric or pointer
*/
{
Ptype t = this;
if (this == 0) error('i',"type::kind(): this==0");
xx:
switch (t->base) {
case ANY: return 'A';
case ZTYPE: return 'Z';
case FIELD:
case CHAR:
case SHORT:
case INT:
case LONG:
case EOBJ: return 'I';
case FLOAT:
case LDOUBLE:
case DOUBLE: if (v == 'I') error("float operand for %k",oper); return 'F';
case VEC:
case PTR: if (v != 'P') error("P operand for %k",oper);
switch (oper) {
case INCR:
case DECR:
case MINUS:
case PLUS:
case ASMINUS:
case ASPLUS:
if (t->base==PTR
&& (Pptr(t)->memof || Pptr(t)->typ->base==FCT))
error("%t operand of%k",this,oper);
else
Pptr(t)->typ->tsizeof(); // get increment
break;
default:
if (t->base==PTR
&& (Pptr(t)->memof || Pptr(t)->typ->base==FCT))
error("%t operand of%k",this,oper);
case ANDAND:
case OROR:
case ASSIGN:
case NE:
case EQ:
case IF:
case WHILE:
case DO:
case FOR:
case QUEST:
case NOT:
break;
}
return 'P';
case RPTR: error("R operand for %k",oper); return 'A';
case TYPE: t = Pbase(t)->b_name->tp; goto xx;
case FCT: if (v != 'P') error("F operand for %k",oper); return FCT;
case OVERLOAD: error("overloaded operand for %k",oper); return 'A';
case CLASS:
case ENUM: error("%k operand for %k",base,oper); return 'A';
default: error("%t operand for %k",this,oper); return 'A';
}
}
void type::dcl(Ptable tbl)
/*
go through the type (list) and
(1) evaluate vector dimensions
(2) evaluate field sizes
(3) lookup struct tags, etc.
(4) handle implicit tag declarations
*/
{
static arg_fudge;
Ptype t = this;
if (this == 0) error('i',"T::dcl(this==0)");
if (tbl->base != TABLE) error('i',"T::dcl(%d)",tbl->base);
xx:
//error('d',"type::dcl %k",t->base);
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto xx;
case PTR:
case RPTR:
{ Pptr p = Pptr(t);
t = p->typ;
if (t->base == TYPE) {
Ptype tt = Pbase(t)->b_name->tp;
if (tt->base == FCT) p->typ = tt;
return;
}
goto xx;
}
case VEC:
{ Pvec v = Pvec(t);
Pexpr e = v->dim;
if (e) {
Ptype et;
v->dim = e = e->typ(tbl);
et = e->tp;
if (et->integral(0) == 'A') {
error("UN in array dimension");
}
else {
long i;
Neval = 0;
i = e->eval();
if (Neval == 0) {
if (largest_int<i)
error("array dimension too large");
v->size = int(i);
if ( lcl_tbl == 0 )
DEL(v->dim);
v->dim = 0;
}
if (new_type) {
if (Neval)
;
else if (i == 0)
v->dim = zero;
else if (i < 0) {
error("negative array dimension");
i = 1;
}
}
else {
if (Neval)
error("%s",Neval);
else if (i == 0)
error('w',"array dimension == 0");
else if (i < 0) {
error("negative array dimension");
i = 1;
}
}
}
}
t = v->typ;
llx:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto llx;
case FCT:
v->typ = t;
break;
case VEC:
if (Pvec(t)->dim==0 && Pvec(t)->size==0) error("null dimension (something like [][] seen)");
if (arg_fudge) {
v->base = PTR; // X[12][10] ==> X(*)[10]
Pptr(v)->rdo = 0;
Pptr(v)->memof = 0;
}
}
goto xx;
}
case FCT:
{ Pfct f = Pfct(t);
void dargs(Pname, Pfct, Ptable);
if (f->argtype) dargs(0,f,tbl);
for (Pname n=f->argtype; n; n = n->n_list) {
arg_fudge++;
n->tp->dcl(tbl);
arg_fudge--;
}
Pname cn = f->returns->is_cl_obj();
if (cn && Pclass(cn->tp)->has_itor())
make_res(f);
else if (f->f_this == 0)
f->f_args = f->argtype;
t = f->returns;
goto xx;
}
case FIELD:
{ Pbase f = Pbase(t);
Pexpr e = Pexpr(f->b_name);
long i;
Ptype et;
e = e->typ(tbl);
f->b_name = Pname(e);
et = e->tp;
if (et->integral(0) == 'A') {
error("UN in field size");
i = 1;
}
else {
Neval = 0;
i = e->eval();
if (Neval)
error("%s",Neval);
else if (i < 0) {
error("negative field size");
i = 1;
}
else if (f->b_fieldtype->tsizeof()*BI_IN_BYTE < i)
error("field size > sizeof(%t)",f->b_fieldtype);
DEL(e);
}
f->b_bits = int(i);
f->b_name = 0;
break;
}
}
}
bit vrp_equiv; // vector == pointer equivalence used in check()
bit const_problem; // types differs only in const
int Vcheckerror;
bit type::check(Ptype t, TOK oper)
/*
check if "this" can be combined with "t" by the operator "oper"
used for check of
assignment types (oper==ASSIGN)
declaration compatability (oper==0)
parameterized type formals (oper==255)
as for (oper==0) but
special checking for ANY types
argument types (oper==ARG)
return types (oper==RETURN)
overloaded function name match (oper==OVERLOAD)
overloaded function coercion (oper==COERCE)
virtual function match (oper==VIRTUAL)
NOT for arithmetic operators
return 1 if the check failed
checking of const const* and *const is a mess
*/
{
const unsigned int strict_any_check = (oper == 255);
Ptype t1 = this;
Ptype t2 = t;
Ptype tt1 = this;
Ptype tt2 = t;
int cnst1 = 0;
int cnst2 = 0;
TOK b1, b2;
bit first = 1;
TOK r;
int vv;
int ptr_count = 0;
int fct_seen = 0;
int over;
Pptr p1 = 0;
Pptr p2 = 0;
int p_count = 0;
if (strict_any_check) oper = 0;
//error('d',"check %k %t %t",oper,t1,t2);
if (t1==0 || t2==0) error('i',"check(%p,%p,%d)",t1,t2,oper);
if (oper==VIRTUAL) {
vv = 1;
Vcheckerror = 0;
oper = 0;
}
else
vv = 0;
if (oper == OVERLOAD) {
over = 1;
oper = 0;
}
else
over = 0;
const_problem = 0;
while (t1 && t2) {
top:
//error('d',"top: %t (%d) %t (%d)",t1,t1->base,t2,t2->base);
if (t1 == t2) {
if (cnst1==cnst2) return 0;
if (oper) {
//error('d',"oper %d cnst1 %d cnst2 %d ptr %d",oper,cnst1,cnst2,tt1->is_ptr());
if (tt1 = tt1->is_ptr()) {
// const* = int*
if (cnst2<cnst1) return 0;
// int* = int *const
if (cnst2==1 && tt2->tconst()) {
// check for int* = const *const
tt2 = tt2->is_ptr();
if (tt2->tconst()) return 1;
return 0;
}
}
else { // int = const allowed
if (oper==ARG || cnst1<cnst2) return 0;
}
}
else {
if (p_count) {
int pr1 = p1->rdo ? 1 : 0;
int pr2 = p2->rdo ? 1 : 0;
if (pr1+cnst1==pr2+cnst2)
return 0;
}
// const_problem = 1;
}
const_problem = 1;
return 1;
}
if ((t1->base == ANY || t2->base == ANY)) {
if (! strict_any_check) return 0;
// Perform the check for strict_any, ie. the
return ((t1 == t2) ? 0 : 1) ;
}
b1 = t1->base;
switch (b1) {
case TYPE:
if (Pbase(t1)->b_const) cnst1++;
t1 = Pbase(t1)->b_name->tp;
goto top;
}
b2 = t2->base;
switch (b2) {
case TYPE:
if (Pbase(t2)->b_const) cnst2++;
t2 = Pbase(t2)->b_name->tp;
goto top;
}
//error('d',"oper %k b1 %k b2 %k",oper,b1,b2);
if (b1 != b2) {
switch (b1) {
case PTR:
switch (b2) {
case VEC:
if (ptr_count) return 1;
// ptr/vec equivalence does not
// apply to declaration matching
t1 = Pptr(t1)->typ;
t2 = Pvec(t2)->typ;
if (oper == 0 && over==0) return 1;
ptr_count++;
first = 0;
goto top;
case FCT:
t1 = Pptr(t1)->typ;
if (t1->base!=VOID)
if (first==0 || t1->base!=b2) return 1;
first = 0;
goto top;
}
first = 0;
break;
case FCT:
switch( b2 ) {
case PTR:
t2 = Pptr(t2)->typ;
if (t1->base!=VOID
&& (first==0||t2->base!=b1)) return 1;
first = 0;
goto top;
}
first = 0;
break;
case VEC:
switch (b2) {
case PTR:
if (ptr_count) return 1;
t1 = Pvec(t1)->typ;
t2 = Pptr(t2)->typ;
switch (oper) {
case ARG:
case ASSIGN:
case COERCE:
break;
case 0:
if (over) break;
default:
return 1;
}
ptr_count++;
first = 0;
goto top;
}
first = 0;
break;
}
goto base_check;
}
switch (b1) {
case VEC:
//error('d',"vec %k %d %d",oper,Pvec(t1)->size,Pvec(t2)->size);
if (first==0 && Pvec(t1)->size!=Pvec(t2)->size) return 1;
first = 0;
t1 = Pvec(t1)->typ;
t2 = Pvec(t2)->typ;
ptr_count++;
break;
case PTR:
case RPTR:
first = 0;
p1 = Pptr(t1);
p2 = Pptr(t2);
p_count++;
if (p1->memof != p2->memof) {
if(p1->memof!=0 && p2->memof!=0
&& p1->memof->baseof(p2->memof)==0)
return 1;
int flag1=0,flag2=0;
t1 = p1->typ;
t2 = p2->typ;
while (t1->base == TYPE) {
flag1++;
t1 = Pbase(t1)->b_name->tp;
}
while (t2->base == TYPE) {
flag2++;
t2 = Pbase(t2)->b_name->tp;
}
if (t1 != t2 || (!flag1 && !flag2)) {
if (p1->memof==0
|| p2->memof==0
|| p1->memof->baseof(p2->memof)==0)
return 1;
Nstd++;
}
}
t1 = p1->typ;
t2 = p2->typ;
ptr_count++;
if (oper==0) {
int pr1 = p1->rdo ? 1 : 0;
int pr2 = p2->rdo ? 1 : 0;
if (pr1+cnst1!=pr2+cnst2
&& cnst1+Pbase(t1)->b_const!=cnst2+Pbase(t2)->b_const) {
// const_problem only if nothing
// more serious is wrong
if (t1->check(t2,0) == 0) const_problem = 1;
return 1;
}
if (b1==RPTR && t1->tconst()!=t2->tconst())
const_problem = 1;
}
break;
case FCT:
first = 0;
{ Pfct f1 = Pfct(t1);
Pfct f2 = Pfct(t2);
Pname a1 = f1->argtype;
Pname a2 = f2->argtype;
TOK k1 = f1->nargs_known;
TOK k2 = f2->nargs_known;
int n1 = f1->nargs;
int n2 = f2->nargs;
//error('d',"f1%t f2%t",f1,f2);
if (f1->memof != f2->memof) {
if (f1->memof==0 && f2->f_this==0) //SSS
goto sss;
if (vv == 0) // match even if private base class
if (f1->memof==0
|| f2->memof==0
|| f1->memof->baseof(f2->memof)==0) return 1;
Nstd++;
sss:; //SSS
}
if (k1 != k2) return 1;
if (n1!=n2 && k1 && k2) {
goto aaa;
}
else if (a1 && a2) {
int i = 0;
while (a1 && a2) {
i++;
if (a1->tp->check(a2->tp,over?OVERLOAD:0)) return 1;
a1 = a1->n_list;
a2 = a2->n_list;
}
if (a1 || a2) goto aaa;
}
else if (a1 || a2) {
aaa:
//error('d',"aaa k1 %d k2 %d",k1,k2);
if (k1 == ELLIPSIS) {
switch (oper) {
case 0:
if (a2 && k2==0) break;
return 1;
case ASSIGN:
if (a2 && k2==0) break;
return 1;
case ARG:
if (a1) return 1;
break;
// case OVERLOAD:
case COERCE:
return 1;
}
}
else if (k2 == ELLIPSIS) {
return 1;
}
else if (k1 || k2) {
return 1;
}
}
t1 = f1->returns;
t2 = f2->returns;
fct_seen = 1;
switch (oper) { //CCC
case 0:
if (f1->f_const!=f2->f_const) {
if (t1->check(t2,0)==0) const_problem = 1;
return 1;
// if (vv == 0) return 1;
// Vcheckerror = 1;
}
break;
default: // really pointer to function
if (f1->f_const && f2->f_const==0) return 1;
}
if (vv && t1->check(t2,0)) { Vcheckerror = 1; return 1; }
}
break;
case FIELD:
goto field_check;
case CHAR:
case SHORT:
case INT:
case LONG:
goto int_check;
case FLOAT:
case DOUBLE:
case LDOUBLE:
goto float_check;
case EOBJ:
goto enum_check;
case COBJ:
goto cla_check;
case ZTYPE:
case VOID:
return 0;
default:
error('i',"T::check(o=%d %d %d)",oper,b1,b2);
}
}
if (t1 || t2) {
const_problem = 0; // not a problem: the type itself is bad
return 1;
}
return 0;
field_check:
switch (oper) {
case 0:
case ARG:
error('i',"check field?");
}
return 0;
enum_check:
//error('d',"enum check %t %t",t1,t2);
if (Pbase(t1)->b_name->tp != Pbase(t2)->b_name->tp) goto base_check;
goto const_check;
float_check:
if (first==0 && b1!=b2 && b2!=ZTYPE) return 1;
// no break
int_check:
//error('d',"int_check");
if (Pbase(t1)->b_unsigned != Pbase(t2)->b_unsigned) {
if (first == 0) return 1;
if (oper /*&& oper!=OVERLOAD*/)
Nstd++;
else
return 1;
}
// no break
const_check:
//error('d',"const_check %t (%d) %t (%d)",t1,t1->tconst(),t2,t2->tconst());
if (oper==0) {
//error('d',"oper==0: t1 %t t2 %t cnst1 %d cnst2 %d",t1,t2,cnst1,cnst2);
if (t1->tconst()+cnst1!=t2->tconst()+cnst2) {
const_problem = 1;
return 1;
}
}
else if (first==0) {
if (t1->tconst()+cnst1==0 && t2->tconst()+cnst2) {
//error('d',"t1 %t t2 %t cnst1 %d cnst2 %d",t1,t2,cnst1,cnst2);
//error('d',"tt1 %t %d cnst1 %d cnst2 %d",tt1,tt1->is_ptr(),cnst1,cnst2);
//error('d',"tt2 %t",tt2);
if (tt1->is_ptr()) {
if (fct_const || vec_const) cnst2--;
// const* = int*
if (cnst2-tt2->tconst()<cnst1-tt1->tconst()) return 0;
// int* = *const
//if (cnst2==1 && tt2->tconst()) return 0;
// const T* = const T*
if (t2->tconst()+cnst2==t1->tconst()+cnst1) return 0;
}
else { // int = const allowed
if (cnst1<cnst2) return 0;
}
const_problem = 1;
return 1;
}
else { // const* vs int *const
/*
//error('d',"t1 %t cnst1 %d t2 %t cnst2 %d",t1,cnst1,t2,cnst2);
if (tt1->is_ptr()) {
int tt1c = tt1->tconst();
int tt2c = tt2->tconst() - fct_const - vec_const;
//error('d',"tt1c %d tt2c %d",tt1c,tt2c);
if (tt1c<tt2c) return 1;
int t1c = t1->tconst();
int t2c = t2->tconst() - fct_const - vec_const;
//error('d',"t1c %d t2c %d",t1c,t2c);
if (cnst1+t1c<cnst2+t2c) return 1;
if (tt2c<tt1c // *const = *
&& cnst1+t1c>cnst2+t2c) // T = constT
return 1;
}
*/
}
}
else {
//error('d',"first t1 %t t2 %t cnst1 %d cnst2 %d",t1,t2,cnst1,cnst2);
}
//error('d',"return 0");
return 0;
cla_check:
{ Pname n1 = Pbase(t1)->b_name;
Pname n2 = Pbase(t2)->b_name;
//error('d',"cla_check %n %n ptr_count %d",n1,n2,ptr_count);
if (n1 == n2) goto const_check;
// once again, a more comprehensive check for classes,
// since they may be parametrized.
if ((t1->base == COBJ) && (t2->base == COBJ) &&
((Pclass(n1->tp)->same_class(Pclass(n2->tp)))))
goto const_check;
if (/*first || */1<ptr_count || fct_seen) return 1;
switch (oper) {
case ARG:
case ASSIGN:
case RETURN:
case COERCE:
{
ppbase = PUBLIC;
if (Pclass(n2->tp)->is_base(n1->string)) {
if (ppbase!=PUBLIC) {
const_problem = 0;
// vrp_equiv = 0;
return 1; // private or protected base
}
Nstd++;
goto const_check;
}
}
// no break
case 0:
case OVERLOAD:
const_problem = 0;
// vrp_equiv = 0;
return 1;
}
goto const_check;
}
base_check:
//error('d',"base_check t1=%t t2=%t oper=%d %s",t1,t2,oper,first?"first":"");
//error('d',"ptr_count %d",ptr_count);
if (oper)
if (first || 1!=ptr_count) {
if (b1==VOID || b2==VOID) return 1;
}
else {
if (b1 == VOID) { // check for void* = T*
register Ptype tpx = this;
tpxloop:
switch (tpx->base) { // t1 == void*
default:
const_problem = 0;
return 1;
case VOID: break;
case PTR:
case VEC: tpx = Pvec(tpx)->typ;
goto tpxloop;
case TYPE: tpx = Pbase(tpx)->b_name->tp;
goto tpxloop;
}
tpx = t;
bloop:
switch (tpx->base) { // t2 == T*
default:
const_problem = 0;
return 1;
case VEC:
case PTR:
case FCT: Nstd++;
// return 0;
goto const_check; // prevent void* = const*
case TYPE: tpx = Pbase(tpx)->b_name->tp;
goto bloop;
}
}
if (b2 != ZTYPE) {
const_problem = 0;
return 1;
}
}
//error('d',"oper %d b1 %d b2 %d cp %d",oper,b1,b2,const_problem);
switch (oper) {
case 0:
if (b1 != b2) {
const_problem = 0; // we have a bigger problem
// vrp_equiv = 0;
}
return 1;
case COERCE: // could probably be merged with the cases below
switch (b1) {
case EOBJ:
case ZTYPE:
case CHAR:
case SHORT:
case INT:
switch (b2) {
case LONG:
case FLOAT:
case DOUBLE:
case LDOUBLE:
case EOBJ:
case ZTYPE:
case CHAR:
case SHORT:
case INT:
case FIELD:
Nstd++;
suppress_error++;
if (b1 == EOBJ) echeck(t1,t2);
suppress_error--;
goto const_check;
}
return 1;
case LONG: // char, short, and int promotes to long
switch (b2) {
case FLOAT:
case DOUBLE:
case LDOUBLE:
case ZTYPE:
case EOBJ:
case CHAR:
case SHORT:
case INT:
case FIELD:
Nstd++;
goto const_check;
}
return 1;
case FLOAT:
// switch (b2) {
// case ZTYPE:
// Nstd++;
// case FLOAT:
// case DOUBLE:
// goto const_check;
// }
// return 1;
case DOUBLE: // char, short, int, and float promotes to double
case LDOUBLE:
switch (b2) {
case LONG:
case ZTYPE:
case EOBJ:
case CHAR:
case SHORT:
case INT:
// Nstd++;
case FLOAT:
case DOUBLE:
case LDOUBLE:
Nstd++;
goto const_check;
}
return 1;
case PTR:
switch (b2) {
case ZTYPE:
Nstd++;
goto const_check;
}
case RPTR:
case VEC:
case COBJ:
case FCT:
return 1;
}
case ARG:
case ASSIGN:
case RETURN:
switch (b1) {
case COBJ:
return 1;
case EOBJ:
case ZTYPE:
case CHAR:
case SHORT:
case INT:
case LONG:
suppress_error++;
r = t2->num_ptr(ASSIGN);
suppress_error--;
switch (r) {
case 'F':
// if (oper!=ARG) error('w',"%t assigned to%t",t2,t1);
break;
case 'A':
case 'P':
case FCT: return 1;
}
if (b1 == EOBJ) echeck(t1,t2);
break;
case FLOAT:
case DOUBLE:
case LDOUBLE:
suppress_error++;
r = t2->numeric(ASSIGN);
suppress_error--;
switch (r) {
case 'A':
case 'P':
case FCT: return 1;
}
break;
case VEC:
if(oper==ARG && b2==ZTYPE) goto const_check;
return 1;
case PTR:
suppress_error++;
r = t2->num_ptr(ASSIGN);
suppress_error--;
switch (r) {
case 'A':
case 'I':
case 'F': return 1;
case FCT: if (Pptr(t1)->typ->base != FCT) return 1;
}
break;
case RPTR:
return 1;
case FCT:
switch (oper) {
case ARG:
case ASSIGN:
return 1;
}
}
break;
}
goto const_check;
}
0707071010112045731004440001630000160000010210500466055413100000700000022542typ2.c /*ident "@(#)ctrans:src/typ2.c 1.3" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
typ2.c:
***************************************************************************/
#include "cfront.h"
#include "size.h"
extern int chars_in_largest;
int largest_int;
void typ_init()
{
chars_in_largest = strlen(LARGEST_INT);
largest_int = int(str_to_long(LARGEST_INT));
defa_type = new basetype(INT,0); // note defa_type!=int_type
int_type = new basetype(INT,0); // but they both represent `int'
PERM(int_type); int_type->defined = DEFINED ;
PERM(defa_type); defa_type->defined = DEFINED ;
moe_type = new basetype(INT,0);
PERM(moe_type); moe_type->defined = DEFINED ;
moe_type->b_const = 1;
moe_type->check(0);
uint_type = new basetype(INT,0);
PERM(uint_type); uint_type->defined = DEFINED ;
uint_type->type_adj(UNSIGNED);
uint_type->check(0);
long_type = new basetype(LONG,0);
PERM(long_type); long_type->defined = DEFINED ;
long_type->check(0);
ulong_type = new basetype(LONG,0);
PERM(ulong_type); ulong_type->defined = DEFINED ;
ulong_type->type_adj(UNSIGNED);
ulong_type->check(0);
short_type = new basetype(SHORT,0);
PERM(short_type); short_type->defined = DEFINED ;
short_type->check(0);
ushort_type = new basetype(SHORT,0);
PERM(ushort_type); ushort_type->defined = DEFINED ;
ushort_type->type_adj(UNSIGNED);
ushort_type->check(0);
float_type = new basetype(FLOAT,0);
PERM(float_type); float_type->defined = DEFINED ;
double_type = new basetype(DOUBLE,0);
PERM(double_type); double_type->defined = DEFINED ;
ldouble_type = new basetype(LDOUBLE,0);
PERM(ldouble_type); ldouble_type->defined = DEFINED ;
zero_type = new basetype(ZTYPE,0);
PERM(zero_type); zero_type->defined = DEFINED ;
zero->tp = zero_type;
void_type = new basetype(VOID,0);
PERM(void_type); void_type->defined = DEFINED ;
char_type = new basetype(CHAR,0);
PERM(char_type); char_type->defined = DEFINED ;
uchar_type = new basetype(CHAR,0);
PERM(uchar_type); uchar_type->defined = DEFINED ;
uchar_type->type_adj(UNSIGNED);
uchar_type->check(0);
Pchar_type = char_type->addrof();
PERM(Pchar_type); Pchar_type->defined = DEFINED ;
Pint_type = int_type->addrof();
PERM(Pint_type); Pint_type->defined = DEFINED ;
Pvoid_type = void_type->addrof();
PERM(Pvoid_type); Pvoid_type->defined = DEFINED ;
Pfctvec_type = new fct(int_type,0,0); // must be last, see basetype::normalize()
Pfctvec_type = Pfctvec_type->addrof();
Pfctvec_type = Pfctvec_type->addrof();
PERM(Pfctvec_type); Pfctvec_type->defined = DEFINED ;
gtbl = new table(GTBLSIZE,0,0);
gtbl->t_name = new name("global");
ptbl = new table(CTBLSIZE,0,0);
ptbl->t_name = new name("ptbl");
}
bit enum_promote;
Pbase basetype::arit_conv(Pbase t)
/*
perform the "usual arithmetic conversions" C ref Manual 6.6
on "this" op "t"
"this" and "t" are integral or floating
"t" may be 0
*/
{
while (base == TYPE) this = Pbase(Pbase(this)->b_name->tp);
// error('d', "arit_conv: this: %k %d %t %d", base, base, this, this );
bit l;
bit u;
bit f;
bit l1 = (base == LONG);
bit u1 = b_unsigned;
bit f1 = (base==FLOAT || base==DOUBLE || base==LDOUBLE);
if (t) {
while (t->base == TYPE) t = Pbase(Pbase(t)->b_name->tp);
// error('d', "arit_conv: t: %k %d %t %d", t->base, t->base, t, t );
bit l2 = (t->base == LONG);
bit u2 = t->b_unsigned;
bit f2 = (t->base==FLOAT || t->base==DOUBLE || base==LDOUBLE);
l = l1 || l2;
u = u1 || u2;
f = f1 || f2;
}
else {
l = l1;
u = u1;
f = f1;
}
if (f) {
if (base==LDOUBLE || (t && t->base==LDOUBLE)) return ldouble_type;
if (base==DOUBLE || (t && t->base==DOUBLE)) return double_type;
return float_type;
}
if (l & u) return ulong_type;
if (l & !u) return long_type;
if (u) {
if (base==INT || (t && t->base==INT)) return uint_type;
if (SZ_SHORT==SZ_INT) // ANSIism
if (base==SHORT || (t && t->base==SHORT)) return uint_type;
return int_type;
}
if (t && t->base == EOBJ && base == EOBJ) enum_promote = 1;
return int_type;
}
bit vec_const = 0;
bit fct_const = 0;
bit type::tconst()
/*
is this type a constant
*/
{
Ptype t = this;
vec_const = 0;
fct_const = 0;
//error('d',"tconst %t",t);
xxx:
switch (t->base) {
case TYPE:
if (Pbase(t)->b_const) return 1;
t = Pbase(t)->b_name->tp;
goto xxx;
case VEC:
vec_const = 1;
return 1;
case PTR:
case RPTR:
return Pptr(t)->rdo;
case FCT:
case OVERLOAD:
fct_const = 1;
return 1;
default:
return Pbase(t)->b_const;
}
}
TOK type::set_const(bit mode)
/*
make someting a constant or variable, return old status
*/
{
Ptype t = this;
int m;
xxx:
switch (t->base) {
case TYPE:
m = Pbase(t)->b_const;
Pbase(t)->b_const = mode;
t = Pbase(t)->b_name->tp;
goto xxx;
case ANY:
case RPTR:
case VEC:
return t->base; // constant by definition
case PTR:
m = Pptr(t)->rdo;
Pptr(t)->rdo = mode;
return m;
default:
m = Pbase(t)->b_const;
Pbase(t)->b_const = mode;
return m;
}
}
Pptr type::is_ref()
{
Ptype t = this;
xxx:
switch (t->base) {
case TYPE: t = Pbase(t)->b_name->tp; goto xxx;
case RPTR: return Pptr(t);
default: return 0;
}
}
Pclass Mptr;
Pptr type::is_ptr()
{
Ptype t = this;
xxx:
switch (t->base) {
case TYPE: t = Pbase(t)->b_name->tp; goto xxx;
case PTR:
case VEC: Mptr = Pptr(t)->memof;
return Pptr(t);
default: return 0;
}
}
Pptr type::is_ptr_or_ref()
{
Ptype t = this;
xxx:
switch (t->base) {
case TYPE: t = Pbase(t)->b_name->tp; goto xxx;
case PTR:
case RPTR:
case VEC: Mptr = Pptr(t)->memof;
return Pptr(t);
default: return 0;
}
}
int type::align()
{
Ptype t = this;
xx:
/*fprintf(stderr,"align %d %d\n",t,t->base);*/
switch (t->base) {
case TYPE: t = Pbase(t)->b_name->tp; goto xx;
case COBJ: t = Pbase(t)->b_name->tp; goto xx;
case VEC: t = Pvec(t)->typ; goto xx;
case ANY: return 1;
case CHAR: return AL_CHAR;
case SHORT: return AL_SHORT;
case INT: return AL_INT;
case LONG: return AL_LONG;
case FLOAT: return AL_FLOAT;
case DOUBLE: return AL_DOUBLE;
case LDOUBLE: return AL_LDOUBLE;
case PTR:
case RPTR: return AL_WPTR;
case CLASS: return Pclass(t)->obj_align;
case ENUM:
case EOBJ: return AL_INT;
case VOID: error("illegal use of void"); return AL_INT;
default: error('i',"(%d,%k)->type::align",t,t->base);
}
}
bit fake_sizeof;
int type::tsizeof(int ptmc)
/*
the sizeof type operator
return the size in bytes of the types representation
*/
{
Ptype t = this;
zx:
//error('d',"zx %t %d",t,t->base);
if (t == 0) error('i',"typ.tsizeof(t==0)");
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto zx;
case COBJ:
t = Pbase(t)->b_name->tp;
if (t == 0) return 0; // ``fake'' generated classes: _Sdd
goto zx;
case ANY: return 1;
case VOID: return 0;
case ZTYPE: return SZ_WPTR; /* assume pointer */
case CHAR: return SZ_CHAR;
case SHORT: return SZ_SHORT;
case INT: return SZ_INT;
case LONG: return SZ_LONG;
case FLOAT: return SZ_FLOAT;
case DOUBLE: return SZ_DOUBLE;
case LDOUBLE: return SZ_LDOUBLE;
case VEC:
{ Pvec v = Pvec(t);
if (v->size == 0) {
if (fake_sizeof == 0) error('w',"sizeof array with undeclared dimension");
return SZ_WPTR; // vector argument has sizeof ptr
}
return v->size * v->typ->tsizeof();
}
case RPTR:
case PTR:
{
int k = (Pptr(t)->memof && !ptmc)?sizeof(short)+sizeof(short):0;
t = Pptr(t)->typ;
xxx:
switch (t->base) {
default: return SZ_WPTR;
case CHAR: return SZ_BPTR;
case FCT: return SZ_WPTR+k;
case TYPE: t = Pbase(t)->b_name->tp; goto xxx;
}
}
case FIELD:
error("sizeof(field)");
return Pbase(t)->b_bits/BI_IN_BYTE+1;
case FCT:
error("sizeof(function)");
return 0;
case CLASS:
{
Pclass cl = Pclass(t);
if ((cl->defined&(DEFINED|SIMPLIFIED)) == 0) {
error("%tU, size not known",cl);
return SZ_INT;
}
if (cl->c_body == 1) // detect first allocation or sizeof
cl->dcl_print(0);
return cl->obj_size;
}
case EOBJ:
case ENUM: return SZ_INT;
default: return 0; // deref can be called for any type
//error('i',"sizeof(%d)",t->base);
}
}
bit type::vec_type()
{
Ptype t = this;
xx:
switch (t->base) {
case ANY:
case VEC:
case PTR:
case RPTR: return 1;
case TYPE: t = Pbase(t)->b_name->tp; goto xx;
default: return 0;
}
}
int ref_initializer;
Ptype type::deref()
/* index==1: *p
index==0: p[expr]
*/
{
//error('d',"%t -> deref() refd %d",this,ref_initializer);
Ptype t = this;
xx:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto xx;
case PTR:
case RPTR:
case VEC:
{ if (t == Pvoid_type) error("void* dereferenced");
Ptype tt = t = Pvec(t)->typ;
if (ref_initializer == 0) {
while (tt->base == TYPE) tt = Pbase(tt)->b_name->tp;
if (tt->base == COBJ) {
tt = Pbase(tt)->b_name->tp;
if (tt && Pclass(tt)->defined&(DEFINED|SIMPLIFIED))
(void) t->tsizeof();
}
}
// no break
}
case ANY:
return t;
default:
error("nonP dereferenced");
return any_type;
}
}
Pfct type::memptr()
// is ``this'' a pointer to member function
{
Ptype t = this;
while (t->base == TYPE) t = Pbase(t)->b_name->tp;
if (t->base != PTR || Pptr(t)->memof==0) return 0;
t = Pptr(t)->typ;
while (t->base == TYPE) t = Pbase(t)->b_name->tp;
return (t->base == FCT) ? Pfct(t) : 0;
}
0707071010112045741004440001630000160000010177160466055413400001200000002731typedef.h /*ident "@(#)ctrans:src/typedef.h 1.2" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
typedef.h:
*****************************************************************************/
typedef unsigned char TOK;
typedef unsigned char bit; // sometimes used as bits
typedef class node * PP;
typedef int (*PFI)();
typedef void (*PFV)();
typedef class node * Pnode;
typedef struct key * Pkey;
typedef class name * Pname;
typedef class basetype * Pbase;
typedef class basecl* Pbcl;
typedef class type * Ptype;
typedef class fct * Pfct;
typedef class field * Pfield;
typedef class expr * Pexpr;
typedef class qexpr * Pqexpr;
typedef class texpr * Ptexpr;
typedef class classdef * Pclass;
typedef class enumdef * Penum;
typedef class stmt * Pstmt;
typedef class estmt * Pestmt;
typedef class tstmt * Ptstmt;
typedef class vec * Pvec;
typedef class ptr * Pptr;
typedef class block * Pblock;
typedef class table * Ptable;
typedef struct loc Loc;
typedef class call * Pcall;
typedef class gen* Pgen;
typedef class ref * Pref;
typedef class name_list * Plist;
typedef class iline * Pin;
typedef class nlist * Pnlist;
typedef class slist * Pslist;
typedef class elist * Pelist;
typedef class virt * Pvirt;
typedef char* Pchar;
0707071010112045751004440001630000160000010201670466055413700001200000001374yystype.h /*ident "@(#)ctrans:src/yystype.h 1.2" */
/**************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
yystype:
*****************************************************************************/
typedef union {
char* s;
TOK t;
int i;
loc l;
Pname pn;
Ptype pt;
Pexpr pe;
Pstmt ps;
Pbase pb;
Pnlist nl;
Pslist sl;
Pelist el;
Pbcl pbc;
Pptr pp;
PP p; // fudge: pointer to all class node objects
Plist pl; // fudge: pointer to all class node objects
} YYSTYPE;
extern YYSTYPE yylval;
0707071010112045751004440001630000160000010201670466055413700001300000000000TRAILER!!! ss node objects
} YYSTYPE;
extern YYSTYPE yylval;
0707071010112045751004440001630000160000010201670466055413700001300000000000TRAILER!!! ss node objects
} YYSTYPE;
extern YYSTYPE yylval;
0707071010112045751004440001630000160000010201670466055413700001300000000000TRAILER!!! ss node objects
} YYSTYPE;
extern YYSTYPE yylval;
070707101011204575100444000163000016000001020167046
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.