Code assign_stat(Pnode p)
{
Psymbol symbol;
Code exprcode;
Schema exprschema;
/*
assign_stat
/
/
ID ---> expr
*/
// Semantica: Carico gli schemi di ID e expr
symbol = lookup(valname(p->child));
if (symbol == NULL)
semerror(p->child, "Undefined identifier in assignment");
exprcode = expr(p->child->brother, &exprschema);
// Type checking:
if (!type_equal(symbol->schema, &exprschema))
semerror(p->child->brother, "Incompatible types in assignment");
if (exprschema.next != NULL)
free_schema(exprschema.next);
Value v1; v1.ival = symbol->oid;
return concode(
exprcode,
makecode1(T_STO, v1),
endcode());
}
/*Controlla i vincoli semantici dell'assegnamento e ne ritorna il codice*/
Code assign_stat(Pnode assign_stat_node){
#ifdef DEBUG_ASSIGN_STAT
printf("ASSIGN_STAT - enter\n");
#endif
//Imposto le due parti del nodo
Pnode id_node = assign_stat_node->child;
Pnode expr_node = assign_stat_node->child->brother;
//Definisco la variabile che contiene il codice da ritornare
Code assign_stat_code ;
//Controllo i vincoli semantici
//Visibilità del nome
if (lookup(valname(id_node))==NULL)
semerror(id_node,"Undefined variable");
//Compatibilità degli schemi
Pschema schema_expr = (Pschema) newmem(sizeof(Schema));
Code expr_code = expr(expr_node,schema_expr);
Psymbol symbol = lookup(valname(id_node));
if (!type_equal((symbol->schema),*(schema_expr)))
semerror(assign_stat_node,"Incompatible types");
//Genero il codice
assign_stat_code = appcode(expr_code,makecode1(T_STO,symbol->oid));
#ifdef DEBUG_ASSIGN_STAT
printf("ASSIGN_STAT - exit\n");
#endif
return assign_stat_code;
}
static int
checkfill(Symbol* tsym, Datasrc* src)
{
int i,iscmpd,result;
Constant* con;
Symbol* original = tsym;
result = 1;
switch (tsym->subclass) {
case NC_ENUM: case NC_OPAQUE: case NC_PRIM:
con = srcnext(src);
if(src == NULL) {
semerror(srcline(src),"%s: malformed _FillValue",original->name);
result = 0;
} else if(con->nctype != tsym->typ.typecode) result = 0; /* wrong type*/
break;
case NC_COMPOUND:
if(!issublist(src)) {/* fail on no compound*/
semerror(srcline(src),"Compound constants must be enclosed in {..}");
}
srcpush(src);
for(i=0;i<listlength(tsym->subnodes);i++) {
Symbol* field = (Symbol*)listget(tsym->subnodes,i);
result = checkfill(field,src,original);
if(!result) break;
}
srcpop(src);
break;
case NC_VLEN:
if(!issublist(src)) {
semerror(srcline(src),"%s: vlen instances in _FillValue must be enclosed in {...}",original->name);
result = 0;
} else {
srcpush(src);
while(srcmore(src)) {
result = checkfill(tsym->typ.basetype,src,original);
if(!result) break;
}
srcpop(src);
}
break;
case NC_FIELD:
/* Braces are optional */
if((iscmpd=issublist(src))) srcpush(src);
if(tsym->typ.dimset.ndims > 0) {
result = checkarray(tsym->typ.basetype,&tsym->typ.dimset,0,src,original,!TOPLEVEL);
} else
result = checkfill(tsym->typ.basetype,src,original);
if(iscmpd) srcpop(src);
break;
default: PANIC1("checkfillvalue: unexpected subclass %d",tsym->subclass);
}
return result;
}
static void
genbin_data(Symbol* tsym, Datasrc* datasrc, Datalist* fillsrc,
Bytebuffer* memory)
{
int usecmpd;
Constant* con = srcpeek(datasrc);
if(con == NULL || con->nctype == NC_FILLVALUE) {
srcnext(datasrc);
genbin_fillvalue(tsym,fillsrc,datasrc,memory);
return;
}
switch (tsym->subclass) {
case NC_ENUM:
case NC_OPAQUE:
case NC_PRIM:
if(issublist(datasrc)) {
semerror(srcline(datasrc),"Expected primitive found {..}");
}
genbin_primdata(tsym,datasrc,fillsrc,memory);
break;
case NC_COMPOUND:
genbin_compound(tsym,datasrc,fillsrc,memory);
break;
case NC_VLEN: {
Constant* cp;
nc_vlen_t ptr;
if(!issublist(datasrc)) {
semerror(srcline(datasrc),"Vlen data must be enclosed in {..}");
}
cp = srcnext(datasrc);
/* generate the nc_vlen_t instance*/
ptr.p = vlendata[cp->value.compoundv->vlen.uid].data;
ptr.len = vlendata[cp->value.compoundv->vlen.uid].count;
bbAppendn(memory,(char*)&ptr,sizeof(ptr));
} break;
case NC_FIELD:
/* enclose in braces if and only if field is an array */
usecmpd = (issublist(datasrc) && tsym->typ.dimset.ndims > 0);
if(usecmpd) srcpush(datasrc);
if(tsym->typ.dimset.ndims > 0) {
genbin_fieldarray(tsym->typ.basetype,datasrc,&tsym->typ.dimset,0,memory);
} else {
genbin_data(tsym->typ.basetype,datasrc,NULL,memory);
}
if(usecmpd) srcpop(datasrc);
break;
default: PANIC1("genbin_data: unexpected subclass %d",tsym->subclass);
}
}
/*Genera il codice per il nodo def_stat e controlla i vincoli semantici*/
Code def_stat(Pnode def_stat_node){
//Imposto le due parti del nodo
Pnode type_node = def_stat_node->child;
Pnode id_list_head_node = def_stat_node->child->brother;
//Definisco la variabile che contiene il codice da ritornare
Code def_stat_code ;
def_stat_code.head = NULL;
def_stat_code.tail = NULL;
def_stat_code.size = 0;
//Sintetizzo il type
Pschema schema_type = type(type_node);
//Ottengo la id_list
int id_list_len;
Pname id_list_name = id_list(id_list_head_node,&id_list_len);
//Controllo gli errori semantici
//id ripetuti
Boolean repetition = repeated_names(id_list_name);
if (repetition == TRUE){
semerror(def_stat_node,"More than one variable with the same name");
}
//variabili già assegnate
Pnode id_node;
for (id_node = id_list_head_node; id_node!=NULL; id_node=id_node->brother)
if (name_in_environment(valname(id_node)))
semerror(id_node,"Variable already defined");
//Genero il codice per la definizione delle variabili e inserisco i nomi nel contesto
for (id_node = id_list_head_node; id_node!=NULL; id_node=id_node->brother){
//Genero il codice dell'id
Code id_code ;
int spazio_da_allocare = get_size(schema_type);
if (schema_type->type == TABLE)
id_code = makecode1(T_NEWTAB,spazio_da_allocare);
else
id_code = makecode1(T_NEWATOM,spazio_da_allocare);
//Inserisco il nome nell'ambiente
insert_name_into_environment(valname(id_node));
//Inserisco il nome nella symbol table
Pschema schema_symbol = clone_schema(schema_type);
schema_symbol->name = valname(id_node);
insert(*schema_symbol);
//Appendo a def_stat_code l'id_code
def_stat_code = appcode(def_stat_code,id_code);
}
return def_stat_code;
}
SharedQueue::SharedQueue(key_t key, bool is_server) {
union semun arg;
this->is_server = is_server;
// init shared memory
if( (shmid = shmget(key, CAPACITY, (is_server ? IPC_CREAT : 0) | 0666)) < 0) {
throw shmerror();
}
if( (buf = (char*)shmat(shmid, NULL, 0)) == (char*) -1) {
throw shmerror();
}
// init indexes
if( ( indid = shmget(key+1, CAPACITY, (is_server ? IPC_CREAT : 0) | 0666)) < 0) {
throw shmerror();
}
if( (head = (char*)shmat(indid, NULL, 0)) == (char*) -1) {
throw shmerror();
}
end = head + 1;
end_priority = head + 2;
end_medium = head + 3;
// init semaphores
if( (semsid = semget(key+2, SEM_COUNT, (is_server ? IPC_CREAT | 0666 : 0))) < 0) {
throw semerror();
}
// init values
if(is_server) {
*head = 0;
*end = 0;
*end_priority = 0;
arg.val = 1;
if( semctl(semsid, mutex, SETVAL, arg) < 0) {
throw semerror();
}
arg.val = CAPACITY;
if( semctl(semsid, space, SETVAL, arg) < 0) {
throw semerror();
}
}
}
Code tuple_const(Pnode p, Pschema s)
{
Pschema schema;
// Scorro tutti gli elementi della tupla
Code result = endcode();
Pnode elem;
for (elem = p->child; elem != NULL; elem = elem->brother)
{
Code elemcode;
switch (elem->type)
{
case N_INTCONST:
case N_BOOLCONST:
elemcode = makecode1(T_IATTR, elem->value); break;
case N_STRCONST:
elemcode = makecode1(T_SATTR, elem->value); break;
default: noderror(elem);
}
if (result.head == NULL)
result = elemcode;
else
result = appcode(result, elemcode);
}
// Type checking
schema = tuple_to_schema(p);
if (!type_equal(schema, s))
semerror(p, "Incompatible tuples in table constant");
free_schema(schema);
return result;
}
void
processvars(void)
{
int i,j;
for(i=0;i<listlength(vardefs);i++) {
Symbol* vsym = (Symbol*)listget(vardefs,i);
Symbol* basetype = vsym->typ.basetype;
/* If we are in classic mode, then convert long -> int32 */
if(usingclassic) {
if(basetype->typ.typecode == NC_LONG || basetype->typ.typecode == NC_INT64) {
vsym->typ.basetype = primsymbols[NC_INT];
basetype = vsym->typ.basetype;
}
}
/* fill in the typecode*/
vsym->typ.typecode = basetype->typ.typecode;
/* validate uses of NIL */
validateNIL(vsym);
for(j=0;j<vsym->typ.dimset.ndims;j++) {
/* validate the dimensions*/
/* UNLIMITED must only be in first place if using classic */
if(vsym->typ.dimset.dimsyms[j]->dim.declsize == NC_UNLIMITED) {
if(usingclassic && j != 0)
semerror(vsym->lineno,"Variable: %s: UNLIMITED must be in first dimension only",fullname(vsym));
}
}
}
}
static void
generate_primdata(Symbol* basetype, Constant* prim, Bytebuffer* codebuf,
Datalist* filler, Generator* generator)
{
Constant target;
if(prim == NULL || isfillconst(prim)) {
Datalist* fill = (filler==NULL?getfiller(basetype):filler);
ASSERT(fill->length == 1);
prim = datalistith(fill,0);
}
ASSERT(prim->nctype != NC_COMPOUND);
target.nctype = basetype->typ.typecode;
if(target.nctype != NC_ECONST) {
convert1(prim,&target);
}
switch (target.nctype) {
case NC_ECONST:
if(basetype->subclass != NC_ENUM) {
semerror(constline(prim),"Conversion to enum not supported (yet)");
} break;
case NC_OPAQUE:
setprimlength(&target,basetype->typ.size*2);
break;
default:
break;
}
generator->constant(generator,&target,codebuf);
return;
}
/*Controlla la semantica del nodo while e ne restituisce il codice*/
Code while_stat(Pnode while_stat_node){
//Imposto le due parti del nodo
Pnode expr_node = while_stat_node->child;
Pnode stat_list_node = while_stat_node->child->brother;
//Definisco la variabile che contiene il codice da ritornare
Code while_stat_code;
//La generazione dell'ambiente viene fatta all'interno della funzione stat_list
//Genero il codice di expr
Pschema schema_expr = (Pschema) newmem(sizeof(Schema));
Code expr_code = expr(expr_node,schema_expr);
//Controllo i vincoli semantici
if (schema_expr->type!=BOOLEAN)
semerror(expr_node,"Expected boolean type");
//Genero il codice di stat_list
Code stat_list_code = stat_list(stat_list_node);
//Calcolo gli offset
int exit = stat_list_code.size + 2;
int up = -(expr_code.size + stat_list_code.size + 1);
//Genero il codice di while_stat
while_stat_code = concode(expr_code,makecode1(T_SKIPF,exit),stat_list_code,makecode1(T_SKIP,up),endcode());
return while_stat_code;
}
/*
** generates an error for an undefined 'goto'; choose appropriate
** message when label name is a reserved word (which can only be 'break')
*/
static void undefgoto (LexState *ls, Labeldesc *gt) {
const char *msg = (gt->name->tsv.reserved > 0)
? "<%s> at line %d not inside a loop"
: "no visible label " LUA_QS " for <goto> at line %d";
msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line);
semerror(ls, msg);
}
void
gen_charattr(Symbol* asym, Bytebuffer* databuf)
{
Datasrc* src;
Constant* con;
if(asym->data == NULL) return;
src = datalist2src(asym->data);
while((con=srcnext(src))) {
switch (con->nctype) {
/* Following list should be consistent with isstringable */
case NC_CHAR:
bbAppend(databuf,con->value.charv);
break;
case NC_BYTE:
bbAppend(databuf,con->value.int8v);
break;
case NC_UBYTE:
bbAppend(databuf,con->value.uint8v);
break;
case NC_STRING:
bbCat(databuf,con->value.stringv.stringv);
bbNull(databuf);
break;
case NC_FILL:
bbAppend(databuf,NC_FILL_CHAR);
break;
default:
semerror(srcline(src),
"Encountered non-string constant in attribute: %s",
asym->name);
return;
}
}
}
/*Controlla la semantica della write e ne ritorna il codice*/
Code write_stat(Pnode write_stat_node){
//Imposto le due parti del nodo
Pnode specifier_node = write_stat_node->child;
Pnode expr_node = write_stat_node->child->brother;
//Definisco la variabile che contiene il codice da ritornare
Code write_stat_code;
//Calcolo il codice di specifier
Pschema schema_specifier = (Pschema) newmem(sizeof(Schema));
Code specifier_code = specifier(specifier_node,schema_specifier);
//Controllo che non ci siano errori semantici
//Controllo che il tipo di specifier sia corretto
if (schema_specifier->type != STRING && schema_specifier->type != NIHIL)
semerror(write_stat_node,"Expected string type");
//Genero il codice di write_stat
//Genero il codice di expr
Pschema schema_expr = (Pschema) newmem(sizeof(Schema));
Code expr_code = expr(expr_node,schema_expr);
//La sintassi della write dipende dalla presenza dello specifier
if (specifier_node->child == NULL)
write_stat_code = appcode(expr_code,make_print_fprint(T_PRINT,get_format(*schema_expr)));
else
write_stat_code = concode(expr_code,specifier_code,make_print_fprint(T_FPRINT,get_format(*schema_expr)),endcode());
return write_stat_code;
}
/*
** generates an error for an undefined 'goto'; choose appropriate
** message when label name is a reserved word (which can only be 'break')
*/
static l_noret undefgoto (LexState *ls, Labeldesc *gt) {
const char *msg = isreserved(gt->name)
? "<%s> at line %d not inside a loop"
: "no visible label '%s' for <goto> at line %d";
msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line);
semerror(ls, msg);
}
static void closegoto(LexState *ls, int g, Labeldesc *label)
{
int i;
FuncState *fs = ls->fs;
Labellist *gl = &ls->dyd->gt;
Labeldesc *gt = &gl->arr[g];
lua_assert(luaS_eqstr(gt->name, label->name));
if (gt->nactvar < label->nactvar)
{
TString *vname = getlocvar(fs, gt->nactvar)->varname;
const char *msg = luaO_pushfstring(ls->L,
"<goto %s> at line %d jumps into the scope of local " LUA_QS,
getstr(gt->name), gt->line, getstr(vname));
semerror(ls, msg);
}
luaK_patchlist(fs, gt->pc, label->pc);
/* remove goto from pending list */
for (i = g; i < gl->n - 1; i++)
gl->arr[i] = gl->arr[i + 1];
gl->n--;
}
Code read_stat(Pnode p)
{
Code result, specifiercode;
int op;
// Vincoli semantici
Psymbol symbol = lookup(valname(p->child->brother));
if (symbol == NULL)
semerror(p->child, "Unknown identifier");
if (p->child->child != NULL)
{
// Con specifier
op = T_FGET;
specifiercode = specifier(p->child);
}
else
{
op = T_GET;
}
Value v1; v1.ival = symbol->oid;
Value v2; v2.sval = get_format(symbol->schema);
result = makecode2(op, v1, v2);
if (op == T_GET)
return result;
else
return appcode(specifiercode, result);
}
static void
genbin_arraydatar(Symbol* vsym,
Bytebuffer* memory,
nciter_t iter,
Iterodom* iterodom,
int index)
{
int i;
int rank = iterodom->rank;
int lastdim = (index == (rank - 1)); /* last dimension*/
int firstdim = (index == 0);
int declsize = odom->dims[index].declsize;
int isunlimited = (declsize == 0);
Symbol* basetype = vsym->typ.basetype;
Datalist* fillsrc = vsym->var.special._Fillvalue;
Constant* con;
ASSERT(index >= 0 && index < rank);
odom->dims[index].index = 0; /* reset*/
if(isunlimited) {
Constant* con;
if(!firstdim) {
if(!issublist(src)) {
semerror(srcline(src),"Unlimited data must be enclosed in {..}");
return;
}
srcpush(src); /* enter the unlimited data */
}
while((con=srcpeek(src))!=NULL) {
if(lastdim) {
genbin_data(basetype,src,fillsrc,memory);
} else {
genbin_arraydatar(vsym,src,odom,index+1,
checkpoint,memory);
}
odom->dims[index].index++;
if(docheckpoint) {
closure->putvar(closure,odom,memory);
}
}
odom->dims[index].datasize = odom->dims[index].index;
if(!firstdim) srcpop(src);
} else { /* !isunlimited*/
for(i=0;i<declsize;i++) {
con = srcpeek(src);
if(lastdim) {
genbin_data(basetype,src,fillsrc,memory);
} else { /* ! lastdim*/
(void)genbin_arraydatar(vsym,src,odom,
index+1,checkpoint,memory);
}
odom->dims[index].index++;
if(docheckpoint) {
closure->putvar(closure,odom,memory);
}
}
}
}
void SharedQueue::down(Semaphore sem) {
sembuf buf;
buf.sem_num = sem;
buf.sem_op = -1;
buf.sem_flg = 0;
if(semop(semsid, &buf, 1))
throw semerror();
}
void
gen_charfield(Datasrc* src, Odometer* odom, int index, Bytebuffer* fieldbuf)
{
int i;
int lastdim = (index == (odom->rank - 1));
size_t declsize = odom->declsize[index];
Constant* con;
ASSERT(declsize != 0);
if(lastdim) {
for(i=0;i<declsize;) {
con = srcnext(src);
if(con == NULL) break;
if(!isstringable(con->nctype)) {
semerror(srcline(src),
"Encountered non-string constant in compound field");
return;
}
i += collectstring(con,declsize,fieldbuf);
}
if(i < declsize) i=fillstring(declsize,i,fieldbuf);
} else { /* ! lastdim*/
int exploded = 0;
size_t slicesize;
/* Compute subslice size */
slicesize = 1;
for(i=index+1;i<odom->rank;i++)
slicesize *= MAX(odom->declsize[i],odom->unlimitedsize[i]);
con = srcpeek(src);
if(con != NULL && !isstringable(con->nctype)) {
semerror(srcline(src),
"Encountered non-string constant in compound field");
return;
}
if(con != NULL && con->value.stringv.len > slicesize) {
/* Constant is larger than just our slice */
/* Explode the constant into subchunks */
exploded = stringexplode(src,slicesize);
}
for(i=0;i<declsize;i++) {
gen_charfield(src,odom,index+1,fieldbuf);
}
if(exploded) srcpop(src);
}
}
static void
fixeconstref(Symbol* avsym, NCConstant* con)
{
Symbol* basetype = NULL;
Symbol* refsym = con->value.enumv;
Symbol* varsym = NULL;
int i;
/* Figure out the proper type associated with avsym */
ASSERT(avsym->objectclass == NC_VAR || avsym->objectclass == NC_ATT);
if(avsym->objectclass == NC_VAR) {
basetype = avsym->typ.basetype;
varsym = avsym;
} else { /*(avsym->objectclass == NC_ATT)*/
basetype = avsym->typ.basetype;
varsym = avsym->container;
if(varsym->objectclass == NC_GRP)
varsym = NULL;
}
if(basetype->objectclass != NC_TYPE && basetype->subclass != NC_ENUM)
semerror(con->lineno,"Enumconstant associated with a non-econst type");
if(con->nctype == NC_FILLVALUE) {
Datalist* filllist = NULL;
NCConstant* filler = NULL;
filllist = getfiller(varsym == NULL?basetype:varsym);
if(filllist == NULL)
semerror(con->lineno, "Cannot determine enum constant fillvalue");
filler = datalistith(filllist,0);
con->value.enumv = filler->value.enumv;
return;
}
for(i=0;i<listlength(basetype->subnodes);i++) {
Symbol* econst = listget(basetype->subnodes,i);
ASSERT(econst->subclass == NC_ECONST);
if(strcmp(econst->name,refsym->name)==0) {
con->value.enumv = econst;
return;
}
}
semerror(con->lineno,"Undefined enum or enum constant reference: %s",refsym->name);
}
/*
* generates an error for an undefined 'goto'; choose appropriate
* message when label name is a reserved word (which can only be 'break')
*/
static void undefgoto(ktap_lexstate *ls, ktap_labeldesc *gt)
{
const char *msg = isreserved(gt->name)
? "<%s> at line %d not inside a loop"
: "no visible label " KTAP_QS " for <goto> at line %d";
msg = ktapc_sprintf(msg, getstr(gt->name), gt->line);
semerror(ls, msg);
}
Code specifier(Pnode p)
{
Schema schema;
Code code = expr(p->child, &schema);
// Vincoli semantici
if (schema.type != STRING)
semerror(p->child, "String type required for specifier");
return code;
}
/* recursive helper for validataNIL */
static void
validateNILr(Datalist* src)
{
int i;
for(i=0;i<src->length;i++) {
NCConstant* con = datalistith(src,i);
if(isnilconst(con))
semerror(con->lineno,"NIL data can only be assigned to variables or attributes of type string");
else if(islistconst(con)) /* recurse */
validateNILr(con->value.compoundv);
}
}
/* Specialty wrappers for genbin_data */
void
genbin_attrdata(Symbol* asym, Bytebuffer* memory)
{
Datasrc* src;
int chartype = (asym->typ.basetype->typ.typecode == NC_CHAR);
if(asym->data == NULL) return;
if(chartype) {gen_charattr(asym,memory); return;}
src = datalist2src(asym->data);
while(srcmore(src)) {
genbin_data(asym->typ.basetype,src,NULL,memory);
}
}
#if 0 /* Apparently not used */
void
genbin_scalardata(Symbol* vsym, Bytebuffer* memory)
{
Datasrc* src;
if(vsym->data == NULL) return;
src = datalist2src(vsym->data);
genbin_data(vsym->typ.basetype,src,
vsym->var.special._Fillvalue,memory);
if(srcmore(src)) {
semerror(srcline(src),"Extra data at end of datalist");
}
}
static void
cdata_primdata(Symbol* basetype, Datasrc* src, Bytebuffer* codebuf, Datalist* fillsrc)
{
Constant* prim;
Constant target;
prim = srcnext(src);
if(prim == NULL) prim = &fillconstant;
ASSERT(prim->nctype != NC_COMPOUND);
if(prim->nctype == NC_FILLVALUE) {
Datalist* filler = getfiller(basetype,fillsrc);
ASSERT(filler->length == 1);
srcpushlist(src,filler);
bbAppend(codebuf,' ');
cdata_primdata(basetype,src,codebuf,NULL);
srcpop(src);
goto done;
}
target.nctype = basetype->typ.typecode;
if(target.nctype != NC_ECONST) {
convert1(prim,&target);
}
switch (target.nctype) {
case NC_ECONST:
if(basetype->subclass != NC_ENUM) {
semerror(prim->lineno,"Conversion to enum not supported (yet)");
} else {
Datalist* econ = builddatalist(1);
Symbol* enumv = prim->value.enumv;
srcpushlist(src,econ);
dlappend(econ,&enumv->typ.econst);
cdata_primdata(enumv->typ.basetype,src,codebuf,fillsrc);
srcpop(src);
} break;
case NC_OPAQUE: {
setprimlength(&target,basetype->typ.size*2);
} break;
default: break;
}
bbCat(codebuf,cdata_const(&target));
done:
return;
}
/*Controlla la semantica della read e ritorna il codice della read*/
Code read_stat(Pnode read_stat_node){
#ifdef DEBUG_READ_STAT
printf("READ_STAT - enter\n");
#endif
//Imposto le due parti del nodo
Pnode specifier_node = read_stat_node->child;
Pnode id_node = read_stat_node->child->brother;
//Definisco il codice del nodo
Code read_stat_code;
read_stat_code.head = NULL;
//Calcolo il codice di specifier
Pschema schema_specifier = (Pschema) newmem(sizeof(Schema));
Code specifier_code = specifier(specifier_node,schema_specifier);
//Controllo che non ci siano errori semantici
//Controllo che il tipo di specifier sia corretto
if ((schema_specifier->type != STRING) && (schema_specifier->type != NIHIL))
semerror(read_stat_node,"Expected string type");
//Controllo che il nome dell'id sia visibile
if (lookup(valname(id_node))==NULL)
semerror(id_node,"Variable not defined");
//Genero il codice di readstat
//La sintassi della read dipende dalla presenza dello specifier
Psymbol symbol = lookup(valname(id_node));
if (specifier_node->child == NULL)
read_stat_code = make_get_fget(T_GET,symbol->oid,get_format((symbol->schema)));
else
read_stat_code = appcode(specifier_code,make_get_fget(T_FGET,symbol->oid,get_format((symbol->schema))));
#ifdef DEBUG_READ_STAT
printf("READ_STAT - exit\n");
#endif
return read_stat_code;
}
/* Generate an instance of the basetype using datasrc */
void
f77data_basetype(Symbol* tsym, Datasrc* datasrc, Bytebuffer* codebuf, Datalist* fillsrc)
{
switch (tsym->subclass) {
case NC_PRIM:
if(issublist(datasrc)) {
semerror(srcline(datasrc),"Expected primitive found {..}");
}
bbAppend(codebuf,' ');
f77data_primdata(tsym,datasrc,codebuf,fillsrc);
break;
default: PANIC1("f77data_basetype: unexpected subclass %d",tsym->subclass);
}
}
/*Controlla la semantica del nodo if e ne ritorna il codice*/
Code if_stat(Pnode if_stat_node){
#ifdef DEBUG_IF_STAT
printf("IF_STAT - enter\n");
#endif
//Imposto le tre parti del nodo
Pnode expr_node = if_stat_node->child;
Pnode then_node = if_stat_node->child->brother;
Pnode else_node = if_stat_node->child->brother->brother;
//Definisco la variabile che contiene il codice da ritornare
Code if_stat_code ;
//La generazione dell'ambiente viene fatta all'interno della funzione stat_list
//Genero il codice di expr
Pschema schema_expr = (Pschema) newmem(sizeof(Schema));
Code expr_code = expr(expr_node,schema_expr);
//Controllo i vincoli semantici
if (schema_expr->type!=BOOLEAN)
semerror(expr_node,"Expected boolean type");
//Genero il codice di then_node
Code then_code = stat_list(then_node);
if (else_node==NULL){//if then endif
//Calcolo l'offset
int offset = then_code.size + 1;
//Genero il codice di if_stat
if_stat_code = concode(expr_code,makecode1(T_SKIPF,offset),then_code,endcode());
}
else {//if then else
//Genero il codice di else_node
Code else_code = stat_list(else_node);
//Calcolo gli offset
int offset_then = then_code.size + 2;
int offset_else = else_code.size + 1;
//Genero il codice di if_stat
if_stat_code = concode(expr_code,makecode1(T_SKIPF,offset_then),then_code,makecode1(T_SKIP,offset_else),else_code,endcode());
}
#ifdef DEBUG_IF_STAT
printf("IF_STAT - exit\n");
#endif
return if_stat_code;
}
static void
processunlimiteddims(void)
{
int i;
/* Set all unlimited dims to size 0; */
for(i=0;i<listlength(dimdefs);i++) {
Symbol* dim = (Symbol*)listget(dimdefs,i);
if(dim->dim.isunlimited)
dim->dim.declsize = 0;
}
/* Walk all variables */
for(i=0;i<listlength(vardefs);i++) {
Symbol* var = (Symbol*)listget(vardefs,i);
int first,ischar;
Dimset* dimset = &var->typ.dimset;
if(dimset->ndims == 0) continue; /* ignore scalars */
if(var->data == NULL) continue; /* no data list to walk */
ischar = (var->typ.basetype->typ.typecode == NC_CHAR);
first = findunlimited(dimset,0);
if(first == dimset->ndims) continue; /* no unlimited dims */
if(first == 0) {
computeunlimitedsizes(dimset,first,var->data,ischar);
} else {
int j;
for(j=0;j<var->data->length;j++) {
NCConstant* con = var->data->data[j];
if(con->nctype != NC_COMPOUND)
semerror(con->lineno,"UNLIMITED dimension (other than first) must be enclosed in {}");
else
computeunlimitedsizes(dimset,first,con->value.compoundv,ischar);
}
}
}
#ifdef GENDEBUG1
/* print unlimited dim size */
if(listlength(dimdefs) == 0)
fprintf(stderr,"unlimited: no unlimited dimensions\n");
else for(i=0;i<listlength(dimdefs);i++) {
Symbol* dim = (Symbol*)listget(dimdefs,i);
if(dim->dim.isunlimited)
fprintf(stderr,"unlimited: %s = %lu\n",
dim->name,
(unsigned long)dim->dim.declsize);
}
#endif
}
void
gen_charvlen(Datalist* data, Bytebuffer* databuf)
{
int i;
NCConstant* c;
ASSERT(bbLength(databuf) == 0);
for(i=0;i<data->length;i++) {
c = datalistith(data,i);
if(isstringable(c->nctype)) {
(void)gen_charconstant(c,databuf,NC_FILL_CHAR);
} else {
semerror(constline(c),
"Encountered non-string and non-char constant in datalist");
return;
}
}
}