static void
fbody(void)
{
Node *gotofixup;
int i;
char *l;
NameTy *nt;
Sym *sym;
pushscope();
labels = map();
gotos = vec();
for(i = 0; i < curfunc->type->Func.params->len; i++) {
nt = vecget(curfunc->type->Func.params, i);
if(nt->name) {
sym = definesym(&curfunc->pos, SCAUTO, nt->name, nt->type, 0);
vecappend(curfunc->Func.params, sym);
}
}
curfunc->Func.body = block();
popscope();
for(i = 0 ; i < gotos->len ; i++) {
gotofixup = vecget(gotos, i);
l = mapget(labels, gotofixup->Goto.name);
if(!l)
errorposf(&gotofixup->pos, "goto target does not exist");
gotofixup->Goto.l = l;
}
}
void
proggen(Node *t, Node *n)
{
int or;
Node *of;
Errjmp s;
Store *p;
long len, loc;
long nauto, oao;
int osp, odb;
extern int (**prog)(Proc*);
extern int storeprog;
odb=didbecome;
oao=autooffset;
or=returnloc;
of=formals;
osp=storeprog;
autooffset=0;
returnloc=0;
formals=t->l;
errsave(s);
if(errmark()){
didbecome=odb;
returnloc=or;
formals=of;
autooffset=oao;
storeprog=osp;
errrest(s);
errjmp();
}
loc=here();
emitconst(0); /* space for locals pointer */
pushscope();
dclformals(t->l);
autooffset=0;
emit(Ipushfp);
nauto=here();
storeprog=here();
emitconst(0L);
gen(n, 0);
trlrgen();
patch((int)nauto, autooffset);
popscope();
errrest(s);
if(!didbecome && n && t->r->o.t!=TUnit)
lerror(n, "prog has no become");
didbecome=odb;
autooffset=oao;
returnloc=or;
formals=of;
storeprog=osp;
len=here()-loc+1;
p=emalloc(SHSZ+len*WS);
memcpy(p->data, prog+loc, len*WS);
p->ref=1;
p->len=len;
p->type=Sprog;
setprog(loc);
emit(Ipushdata);
emitconst((long)p);
emitstore(p);
}
void
gen(Node *n, int retain)
{
int i;
if(n==0)
return;
switch(n->t){
case NArrayref:
arygen(n->l, n->r, 0, 0L);
if(!retain)
popgen(n->l->o.s->val->type->r);
return;
case NBecome:
didbecome=1;
if(n->l->t==NCall && !bflag){
callgen(n->l, Ibecome);
return;
}
gen(n->l, 1);
n=n->r;
if(n->o.t==TID)
n=typeoftid(n);
switch(n->o.t){
case TInt:
case TChar:
emit(Istoreauto);
emitconst(-WS*(4+length(formals)));
break;
case TArray:
case TChan:
case TProg:
case TStruct:
emit(Istoreptrauto);
emitconst(-WS*(4+length(formals)));
break;
case TUnit:
break;
default:
panic("can't compile %t become", n);
}
scopedecrefgen();
trlrgen();
return;
case NBegin:
callgen(n->l, Ibegin);
return;
case NBreak:
if(breakloc==-1)
lerror(n, "break not in loop");
if(breakloc) /* chain previous break to here */
patch(breakloc, (long)(here()-breakloc-1)*WS);
emit(Ijmp);
breakloc=here();
emitconst(0L);
return;
case NCall:
callgen(n, Icall);
if(!retain)
popgen(etypeoft(n->l)->r);
return;
case NComplete:
gen(n->l, retain);
return;
case NContinue:
if(continueloc==-1)
lerror(n, "continue not in loop");
if(continueloc) /* chain previous continue to here */
patch(continueloc, (long)(here()-continueloc-1)*WS);
emit(Ijmp);
continueloc=here();
emitconst(0L);
return;
case NDecl:
case NDeclsc:
declare(n, 0, 0, 1);
return;
case NExpr:
switch(n->o.i){
case GE:
i=Ige;
Binop:
gen(n->l, 1);
gen(n->r, 1);
if(eqtype(etypeof(n->l), &arychartype)){
emit(Istrcmp);
constgen(0L);
}
emit(i);
Popit:
if(!retain)
emit(Ipop);
return;
case LE:
i=Ile;
goto Binop;
case NE:
i=Ine;
goto Binop;
case EQ:
i=Ieq;
goto Binop;
case '>':
i=Igt;
goto Binop;
case '<':
i=Ilt;
goto Binop;
case '+':
i=Iadd;
goto Binop;
case '-':
i=Isub;
goto Binop;
case '*':
i=Imul;
goto Binop;
case '/':
i=Idiv;
goto Binop;
case '%':
i=Imod;
goto Binop;
case '&':
i=Iand;
goto Binop;
case '|':
i=Ior;
goto Binop;
case '^':
i=Ixor;
goto Binop;
case LSH:
i=Ilsh;
goto Binop;
case RSH:
i=Irsh;
goto Binop;
case ANDAND:
condgen(n->l, n->r, Ijmptrue, Ijmpfalse, 0L, 1L, retain);
return;
case OROR:
condgen(n->l, n->r, Ijmpfalse, Ijmptrue, 1L, 0L, retain);
return;
case CAT:
gen(n->l, 1);
gen(n->r, 1);
emit(Icat);
return;
case DEL:
gen(n->l, 1);
gen(n->r, 1);
emit(Idel);
return;
case PRINT:
gen(n->l, 1);
printgen(n->l);
emit(Isprnt);
if(!retain)
emit(Iprint);
return;
case SND:
gen(n->l, 1);
constgen((long)Cissnd);
emit(Icommset1);
emit(Icommcln1);
gen(n->r, 1);
if(isptrtype(etypeoft(n->l)->r))
emit(Isndptr);
else
emit(Isnd);
if(!retain)
popgen(etypeof(n));
return;
case RCV:
gen(n->l, 1);
constgen(0L); /* not Cissnd */
emit(Icommset1);
emit(Icommcln1);
if(!retain)
popgen(etypeof(n));
return;
case '=':
gen(n->r, 1);
if(retain)
dupgen(etypeof(n->r), 1);
lgen(n->l);
return;
case LEN:
gen(n->l, 1);
emit(Ilen);
goto Popit;
case REF:
if(isptrtype(etypeof(n->l))){
gen(n->l, 1);
emit(Iref);
}else
constgen(1L);
goto Popit;
case DEF:
if(retain && n->l->t==NID && isinttype(etypeof(n->l))){
constgen(1L);
return;
}
/*
* don't really need to call lgen1, which will uniquify our
* array for us, but it does no harm, and it's easy.
*/
lgen1(n->l, Idefauto, Idef, Idefary);
goto Popit;
case UMINUS:
gen(n->l, 1);
emit(Ineg);
goto Popit;
case '~':
gen(n->l, 1);
emit(Inot);
goto Popit;
case '!':
gen(n->l, 1);
emit(Ilnot);
goto Popit;
case INC:
lgen1(n->l, Iincauto, Iinc, Iincary);
goto Popit;
case DEC:
lgen1(n->l, Idecauto, Idec, Idecary);
goto Popit;
default:
panic("can't compile %e expression", n);
}
case NExprlist:
/*
* This is an arg or element list; first is pushed last
*/
gen(n->r, 1);
gen(n->l, 1);
return;
case NID:
if(!retain)
return;
switch(type_of(n)->o.t){
case TInt:
case TChar:
if(n->o.s->val->isauto){
emit(Ipushauto);
emitconst(n->o.s->val->store.off);
}else{
emit(Ipush);
emitconst((long)&n->o.s->val->store.l);
}
return;
case TProg:
case TArray:
case TChan:
case TStruct:
if(n->o.s->val->isauto){
emit(Ipushptrauto);
emitconst(n->o.s->val->store.off);
}else{
emit(Ipushptr);
emitconst((long)&n->o.s->val->store.l);
}
return;
case TUnit:
if(retain)
constgen(0L);
return;
case TType:
lerror(n, "attempt to evaluate type variable %m", n);
default:
panic("can't compile type %t", n->o.s->val->type);
}
case NIf:
ifgen(n);
return;
case NList:
gen(n->l, 0);
gen(n->r, 0);
return;
case NLoop:
loopgen(n);
return;
case NMk:
mkgen(n->l, n->r);
return;
case NNum:
if(retain)
constgen(n->o.l);
return;
case NProg:
if(retain)
proggen(n->l, n->r);
return;
case NResult:
if(resultloc==0)
lerror(n, "result not in val");
gen(n->l, 1);
emit(Ijmp);
emitconst((long)(resultloc-here()-1)*WS);
return;
case NScope:
pushscope();
if(nscope==1){
int nauto;
autooffset=0;
emit(Ipushfp);
nauto=here();
emitconst(0L);
gen(n->l, 0);
patch((int)nauto, autooffset);
emit(Ipop); /* Ipopfp() */
}else
gen(n->l, 0);
scopedecrefgen();
popscope();
return;
case NSelect:
selgen(n->l);
return;
case NSmash:{
Value *vl, *vr;
vl=n->l->o.s->val;
vr=n->r->o.s->val;
if(vr->type->o.t==TType){
freenode(vl->type);
vl->type=dupnode(vr->type);
return;
}
gen(n->r, 1);
/*
* Free old values; tricky: push as int, pop as ptr
*/
if(isptrtype(vl->type)){
if(vl->isauto){
emit(Ipushauto);
emitconst(vl->store.off);
}else{
emit(Ipush);
emitconst((long)&vl->store.l);
}
emit(Ipopptr);
}
if(vl->isauto){
emit(Istoreauto);
emitconst(vl->store.l);
return;
}
emit(Istore);
emitconst((long)&vl->store.l);
return;
}
case NString:
if(retain){
emit(Ipushdata);
emitconst((long)n->o.st);
emitstore(n->o.st);
n->o.st->ref++;
}
return;
case NStructref:
arygen(n->l, n->r, 1, n->o.l);
return;
case NSwitch:
switchgen(n->l, n->r);
return;
case NUnit:
if(retain)
constgen(0L);
return;
case NVal:
valgen(n->l);
if(!retain)
popgen(n->o.n);
return;
}
panic("can't compile node %n", n);
return;
}
void Context::clean() {
while ( numscope > 0 )
popscope();
}
void swf_AddButtonLinks(SWF*swf, char stop_each_frame, char events)
{
int num_frames = 0;
int has_buttons = 0;
TAG*tag=swf->firstTag;
unsigned int checksum = 0;
while(tag) {
if(tag->id == ST_SHOWFRAME)
num_frames++;
if(tag->id == ST_DEFINEBUTTON || tag->id == ST_DEFINEBUTTON2)
has_buttons = 1;
crc32_add_bytes(checksum, tag->data, tag->len);
tag = tag->next;
}
int t = time(0);
checksum = crc32_add_bytes(checksum, &t, sizeof(t));
unsigned char h[16];
unsigned char file_signature[33];
sprintf((char*)file_signature, "%x", checksum);
char scenename1[80], scenename2[80];
sprintf(scenename1, "rfx.MainTimeline_%s", file_signature);
sprintf(scenename2, "rfx::MainTimeline_%s", file_signature);
abc_file_t*file = abc_file_new();
abc_method_body_t*c = 0;
abc_class_t*cls = abc_class_new2(file, scenename2, "flash.display::MovieClip");
TAG*abctag = swf_InsertTagBefore(swf, swf->firstTag, ST_DOABC);
tag = swf_InsertTag(abctag, ST_SYMBOLCLASS);
swf_SetU16(tag, 1);
swf_SetU16(tag, 0);
swf_SetString(tag, scenename1);
c = abc_class_getstaticconstructor(cls, 0)->body;
c->old.max_stack = 1;
c->old.local_count = 1;
c->old.init_scope_depth = 9;
c->old.max_scope_depth = 10;
__ getlocal_0(c);
__ pushscope(c);
__ returnvoid(c);
c = abc_class_getconstructor(cls, 0)->body;
c->old.max_stack = 3;
c->old.local_count = 1;
c->old.init_scope_depth = 10;
c->old.max_scope_depth = 11;
debugfile(c, "constructor.as");
__ getlocal_0(c);
__ pushscope(c);
__ getlocal_0(c);
__ constructsuper(c,0);
if(stop_each_frame || has_buttons) {
int frame = 0;
tag = swf->firstTag;
abc_method_body_t*f = 0; //frame script
while(tag && tag->id!=ST_END) {
char framename[80];
char needs_framescript=0;
char buttonname[80];
char functionname[80];
sprintf(framename, "[packageinternal]rfx::frame%d_%s", frame, file_signature);
if(!f && (tag->id == ST_DEFINEBUTTON || tag->id == ST_DEFINEBUTTON2 || stop_each_frame)) {
/* make the contructor add a frame script */
__ findpropstrict(c,"[package]::addFrameScript");
__ pushuint(c,frame);
__ getlex(c,framename);
__ callpropvoid(c,"[package]::addFrameScript",2);
f = abc_class_method(cls, 0, multiname_fromstring(framename))->body;
f->old.max_stack = 3;
f->old.local_count = 1;
f->old.init_scope_depth = 10;
f->old.max_scope_depth = 11;
__ debugfile(f, "framescript.as");
__ debugline(f, 1);
__ getlocal_0(f);
__ pushscope(f);
if(stop_each_frame) {
__ findpropstrict(f, "[package]::stop");
__ callpropvoid(f, "[package]::stop", 0);
}
}
if(tag->id == ST_DEFINEBUTTON || tag->id == ST_DEFINEBUTTON2) {
U16 id = swf_GetDefineID(tag);
sprintf(buttonname, "::button%d", swf_GetDefineID(tag));
__ getlex(f,buttonname);
__ getlex(f,"flash.events::MouseEvent");
__ getproperty(f, "::CLICK");
sprintf(functionname, "::clickbutton%d_%s", swf_GetDefineID(tag), file_signature);
__ getlex(f,functionname);
__ callpropvoid(f, "::addEventListener" ,2);
needs_framescript = 1;
abc_method_body_t*h =
abc_class_method(cls, 0, multiname_fromstring(functionname))->body;
list_append(h->method->parameters, multiname_fromstring("flash.events::MouseEvent"));
h->old.max_stack = 6;
h->old.local_count = 2;
h->old.init_scope_depth = 10;
h->old.max_scope_depth = 11;
__ getlocal_0(h);
__ pushscope(h);
ActionTAG*oldaction = swf_ButtonGetAction(tag);
if(oldaction && oldaction->op == ACTION__GOTOFRAME) {
int framenr = GET16(oldaction->data);
if(!events) {
__ findpropstrict(h,"[package]::gotoAndStop");
__ pushuint(h,framenr+1);
__ callpropvoid(h,"[package]::gotoAndStop", 1);
} else {
char framename[80];
sprintf(framename, "frame%d_%s", framenr, file_signature);
__ getlocal_0(h); //this
__ findpropstrict(h, "[package]flash.events::TextEvent");
__ pushstring(h, "link");
__ pushtrue(h);
__ pushtrue(h);
__ pushstring(h, framename);
__ constructprop(h,"[package]flash.events::TextEvent", 4);
__ callpropvoid(h,"[package]::dispatchEvent", 1);
}
} else if(oldaction && oldaction->op == ACTION__GETURL) {
if(!events) {
__ findpropstrict(h,"flash.net::navigateToURL");
__ findpropstrict(h,"flash.net::URLRequest");
// TODO: target _blank
__ pushstring(h,(char*)oldaction->data); //url
__ constructprop(h,"flash.net::URLRequest", 1);
__ callpropvoid(h,"flash.net::navigateToURL", 1);
} else {
__ getlocal_0(h); //this
__ findpropstrict(h, "[package]flash.events::TextEvent");
__ pushstring(h, "link");
__ pushtrue(h);
__ pushtrue(h);
__ pushstring(h,(char*)oldaction->data); //url
__ constructprop(h,"[package]flash.events::TextEvent", 4);
__ callpropvoid(h,"[package]::dispatchEvent", 1);
}
} else if(oldaction) {
fprintf(stderr, "Warning: Couldn't translate button code of button %d to flash 9 abc action\n", id);
}
__ returnvoid(h);
swf_ActionFree(oldaction);
}
if(tag->id == ST_SHOWFRAME) {
if(f) {
__ returnvoid(f);
f = 0;
}
frame++;
}
tag = tag->next;
}
if(f) {
__ returnvoid(f);
}
}
__ returnvoid(c);
tag = swf->firstTag;
while(tag) {
if(tag->id == ST_DEFINEBUTTON || tag->id == ST_DEFINEBUTTON2) {
char buttonname[80];
sprintf(buttonname, "::button%d", swf_GetDefineID(tag));
multiname_t*s = multiname_fromstring(buttonname);
//abc_class_slot(cls, multiname_fromstring(buttonname), s);
abc_class_slot(cls, multiname_fromstring(buttonname),
multiname_fromstring("flash.display::SimpleButton"));
}
tag = tag->next;
}
abc_script_t*s = abc_initscript(file);
c = s->method->body;
c->old.max_stack = 2;
c->old.local_count = 1;
c->old.init_scope_depth = 1;
c->old.max_scope_depth = 9;
__ getlocal_0(c);
__ pushscope(c);
__ getscopeobject(c, 0);
__ getlex(c,"::Object");
__ pushscope(c);
__ getlex(c,"flash.events::EventDispatcher");
__ pushscope(c);
__ getlex(c,"flash.display::DisplayObject");
__ pushscope(c);
__ getlex(c,"flash.display::InteractiveObject");
__ pushscope(c);
__ getlex(c,"flash.display::DisplayObjectContainer");
__ pushscope(c);
__ getlex(c,"flash.display::Sprite");
__ pushscope(c);
__ getlex(c,"flash.display::MovieClip");
__ pushscope(c);
__ getlex(c,"flash.display::MovieClip");
__ newclass(c,cls);
__ popscope(c);
__ popscope(c);
__ popscope(c);
__ popscope(c);
__ popscope(c);
__ popscope(c);
__ popscope(c);
__ initproperty(c,scenename2);
__ returnvoid(c);
//abc_method_body_addClassTrait(c, "rfx:MainTimeline", 1, cls);
multiname_t*classname = multiname_fromstring(scenename2);
abc_initscript_addClassTrait(s, classname, cls);
multiname_destroy(classname);
swf_WriteABC(abctag, file);
}
void adasem(Node node) /*;adasem*/
{
/* This is the driver routine for all semantic processing. It is called
* by the parser whenever the syntax tree for a compilation unit has
* been built. The input to this routine is an AST node, on which two
* maps are defined : AST, and SPANS. These maps are global to the front
* end.
*/
Node n1, n2, n3, n4;
char *id, *op_id;
Fortup ft1;
Tuple tup;
Node decl_node, id_node, l;
Symbol package, s1;
if (cdebug2 > 2) {
/* TO_ERRFILE("node type ");*/
#ifdef IBM_PC
printf("node type: %s %d %p\n", kind_str(N_KIND(node)), N_KIND(node),
node);
#else
printf("node type: %s %d %ld\n", kind_str(N_KIND(node)), N_KIND(node),
node);
#endif
}
/* The current node is placed in a global variable, from which the error
* routines can extract its span.
*/
current_node = node;
#ifdef DEBUG
if (trapns>0 && N_SEQ(node) == trapns && N_UNIT(node) == trapnu)trapn(node);
#endif
switch(N_KIND(node)) {
/* Chapter 2. Lexical elements*/
/* pragma -> [as_pragma identifier argument_list]*/
case(as_pragma):
process_pragma(node);
break;
/* argument_association -> [as_arg identifier expression]*/
case(as_arg):
break; /*Unpacked in process_pragmas.*/
/* Chapter 3. Declarations and types */
/* object_declaration -> [as_obj_decl identifier_list subtype_indic
* opt_expression]
*/
case(as_obj_decl):
obj_decl(node);
break;
/* const_declaration -> ['const_decl' identifier_list subtype_indic
* opt_expression]
*/
case(as_const_decl):
const_decl(node);
break;
/* num_declaration -> ['num_decl' identifier_list expression]*/
case(as_num_decl):
number_decl(node);
break;
/* type_decl -> ['type_decl' identifier discriminant_list
* type_definition]
*/
case(as_type_decl):
type_decl(node);
break;
/* Subtype_decl -> ['subtype_decl' identifier subtype_indic]*/
case(as_subtype_decl):
subtype_decl(node);
break;
/* subtype_indication -> ['subtype_indic', name opt_constraint]*/
case(as_subtype_indic):
/*[name, opt_constraint] := N_AST(node);*/
adasem(N_AST1(node));
adasem(N_AST2(node));
break;
/* derived_type_definition -> ['derived_type' subtype_indication]*/
case(as_derived_type):
break;
/* discrete_range -> ['range' expression expression]*/
case(as_range):
/*[expression1, expression2] := N_AST(node);*/
adasem(N_AST1(node));
adasem(N_AST2(node));
break;
/* range_attribute -> ['range_attribute' name range]*/
case(as_range_attribute):
N_KIND(node) = as_attribute;
n2 = N_AST3(node);
find_old(node);
adasem(n2);
break;
/* discrete_range -> ['range_expression' expression]*/
case(as_range_expression):
adasem(N_AST1(node));
break;
/* constraint -> ['constraint' general_aggregate]*/
case(as_constraint):
sem_list(node);
break;
/* enumeration_type -> [as_enum enumeration_literal_list]*/
case(as_enum):
sem_list(node);
break;
case(as_int_type):
break;
case(as_float_type):
break;
case(as_fixed_type):
break;
case(as_digits):
case(as_delta):
adasem(N_AST1(node));
adasem(N_AST2(node));
break;
/* array_type_definition -> ['array_type' index_list subtype_indication]*/
case(as_array_type):
array_typedef(node);
break;
/* subtype_definition -> ['box' name]*/
case(as_box):
adasem(N_AST1(node));
break;
/* discrete_range -> [as_subtype opt_name range_constraint]
* general_component_association ->[as_subtype opt_name range-constraint]
*/
case(as_subtype):
/*[opt_name, range_constraint] := N_AST(node);*/
n1 = N_AST1(node);
n2 = N_AST2(node);
if (n1 != OPT_NODE) {
adasem(n1);
find_old(n1);
}
if (n2 == OPT_NODE) { /* possible, if syntax error */
N_KIND(node) = as_name;
}
else adasem(n2);
break;
/* record_decl -> [as_record component_list]*/
case(as_record):
adasem(N_AST1(node));
break;
/* component_list -> [ 'component_list' component_decl_list variant]*/
case(as_component_list):
/*[component_decl_list, variant] := N_AST(node);*/
sem_list(N_AST1(node));
adasem(N_AST2(node));
break;
/* component_declaration -> ['field' identifier_list subtype_indic
* opt_expression]
*/
case(as_field):
comp_decl(node);
break;
/* discr_specification -> ['discr_spec' identifier_list name opt_expr]*/
case(as_discr_spec):
/*[id_list_node, name, opt_expr] := N_AST(node);*/
adasem(N_AST2(node));
/* adasem(N_AST3(node)); */
break;
/* variant_part -> ['variant_decl' simple_name variant_list]*/
case(as_variant_decl):
variant_decl(node);
break;
/* component_association -> ['choice_list' choice_list expression]*/
case(as_choice_list):
/*[choice_list, expression] := N_AST(node);*/
sem_list(N_AST1(node));
adasem(N_AST2(node));
break;
case(as_simple_choice):
adasem(N_AST1(node));
break;
case(as_range_choice):
adasem(N_AST1(node));
break;
case(as_others_choice):
break;
case(as_choice_unresolved):
adasem(N_AST1(node));
break;
case(as_access_type):
n1 = N_AST1(node);
adasem(n1);
n2 = N_AST1(n1);
n3 = N_AST2(n1);
if (n3 == OPT_NODE ) {
/*Special case: type mark may be an incomplete type.*/
N_UNQ(n1) = find_type(n2);
}
else { /* elaborate subtype indication*/
N_UNQ(n1) = promote_subtype(make_subtype(n1));
}
break;
/* incomplete_type_decl -> ['incomplete_decl' identifier discriminant]*/
case(as_incomplete_decl):
incomplete_decl(node);
break;
/* declarations -> ['declarations' declaration_list]*/
case(as_declarations):
declarative_part(node);
break;
/* Chapter 4. Names and expressions */
/* name -> ['character_literal' character]
* Character literals also appear as enumeration literals, and as
* selectors.
*/
case(as_character_literal):
break;
/* name -> ['simple_name' identifier]*/
case(as_simple_name):
break;
/* name -> ['call?' name general_aggregate]*/
case(as_call_unresolved):
n1 = N_AST1(node);
n2 = N_AST2(node);
if (N_KIND(n1) == as_string) {
/* Operator designator: reduce to lower case.*/
/*N_VAL(n1) = LOWER_CASE_OF(N_VAL(n1));*/
id = N_VAL(n1);
while(*id) {
if (isupper(*id)) *id = tolower(*id);
id++;
}
}
adasem(n1);
FORTUP(n1 = (Node), N_LIST(n2), ft1);
adasem(n1);
ENDFORTUP(ft1);
break;
/* name -> ['operator' operator_symbol]*/
case(as_operator):
N_KIND(node) = as_simple_name;
break;
case(as_string):
N_KIND(node) = as_simple_name;
break;
/* name -> ['.' name selector]*/
case(as_selector):
adasem(N_AST1(node));
break;
case(as_all):
adasem(N_AST1(node));
break;
case(as_attribute):
adasem(N_AST2(node));
adasem(N_AST3(node));
break;
/* aggregate -> [as_aggregate expression_list]*/
case(as_aggregate):
sem_list(node);
break;
/* parenthesised_expression -> ['()', expression]*/
case(as_parenthesis):
adasem(N_AST1(node) );
break;
/* expression -> [operator_designator <expression..>]*/
case(as_op):
case(as_un_op):
/*[op_node, arg_list] := N_AST(node);*/
n1 = N_AST1(node);
op_id = N_VAL(n1);
/* KLUDGE until parser fixed. */
if (streq(op_id, "NOT")) N_VAL(n1) = strjoin("not", "");
else if (streq(op_id, "AND")) N_VAL(n1) = strjoin("and", "");
else if (streq(op_id, "XOR")) N_VAL(n1) = strjoin("xor", "");
else if (streq(op_id, "REM")) N_VAL(n1) = strjoin("rem", "");
else if (streq(op_id, "MOD")) N_VAL(n1) = strjoin("mod", "");
else if (streq(op_id, "OR")) N_VAL(n1) = strjoin("or", "");
n2 = N_AST2(node);
find_old(n1);
FORTUP(n3 = (Node), N_LIST(n2), ft1);
adasem(n3);
/*
* the call to check_range_attribute is useless, since
* adasem converts as_range_attribute to as_attribute
* (gcs 11 feb)
*/
/* check_range_attribute(n3); */
ENDFORTUP(ft1);
break;
case(as_in):
case(as_notin):
n3 = N_AST2(node);
tup = N_LIST(n3);
n1 = (Node) tup[1];
n2 = (Node) tup[2];
adasem(n1);
adasem(n2);
break;
case(as_int_literal):
break;
case(as_real_literal):
break;
case(as_string_literal):
break;
case(as_null):
break;
case(as_name):
adasem(N_AST1(node));
break;
case(as_qualify):
find_type(N_AST1(node));
adasem(N_AST2(node));
break;
/* allocator -> ['new_init' name aggregate]*/
case(as_new_init):
n1 = N_AST1(node);
n2 = N_AST2(node);
adasem(n1);
adasem(n2);
break;
/* allocator -> ['new' name constraint_list]*/
case(as_new):
n1 = N_AST1(node);
n2 = N_AST2(node);
adasem(n1);
sem_list(n2);
break;
/* Chapter 5. Statements*/
/* sequence_of_statements -> ['statements' statement_list, label_list]*/
case(as_statements):
statement_list(node);
break;
/* statement -> ['statement' label_list statement]*/
case(as_statement):
/*[label_list, stmt] := N_AST(node);*/
n1= N_AST1(node);
n2= N_AST2(node);
FORTUP(l = (Node), N_LIST(n1), ft1);
find_old(l);
if (NATURE(N_UNQ(l)) != na_label) {
errmsg("label hidden by inner declaration", "5.1", l);
}
ENDFORTUP(ft1);
adasem(n2);
break;
/* labels_declaration -> ['labels' label_list]*/
case(as_labels):
label_decl(node);
break;
/* null_statement -> [null_s']*/
case(as_null_s):
break;
/* assignment -> [':=' name expression ]*/
case(as_assignment):
assign_statement(node);
break;
/* if_statement -> ['if' if_part_list opt_else]*/
case(as_if):
if_statement(node);
break;
/* condition -> ['condition' expression]*/
case(as_condition):
n1 = N_AST1(node);
adasem(n1);
check_type(symbol_boolean_type, n1);
break;
/* case_statement -> ['case' expression alt_list]*/
case(as_case):
case_statement(node);
break;
/* loop_statement -> ['loop' opt_loop_id iteration_rule statements]*/
case(as_loop):
loop_statement(node);
break;
/* iteration_rule -> ['while' condition]*/
case(as_while):
adasem(N_AST1(node));
break;
/* iteration rule -> ['for' identifier discrete_range]*/
case(as_for):
iter_var(node);
break;
/* iteration_rule -> ['forrev' identifier discrete_range]*/
case(as_forrev):
iter_var(node);
break;
/* block -> [na_block identifier declarations statements exceptions]*/
case(as_block):
new_block(node);
break;
/* exit_statement -> ['exit' opt_name opt_expression]*/
case(as_exit):
exit_statement(node);
break;
/* return_statement -> ['return' opt_expression]*/
case(as_return):
return_statement(node);
break;
case(as_goto):
goto_statement(node);
break;
/* Chapter 6. Subprograms*/
/* subprogram_declaration -> ['subprogram_decl', subprogram_spec]*/
case(as_subprogram_decl):
subprog_decl(node);
break;
/* subprogram_specification -> [na_procedure identifier formals_list]
* -> [na_function identifier formals_list name]
*/
case(as_procedure):
break;
case(as_function):
find_type(N_AST3(node));
break;
/* subprogram_body -> ['subprogram' subprogram_spec declarations
* statements opt_exceptions]
*/
case(as_subprogram):
subprog_body(node);
break;
/* parameter_specification -> ['formal' id_list mode name opt_expression]*/
case(as_formal):
break;
/* mode -> ['mode' identifier]*/
case(as_mode):
break;
/* call_statement -> ['call' name]*/
case(as_call):
call_statement(node);
break;
/* Chapter 7. Packages*/
/* package_specification -> [na_package_spec identifier declarations
* opt_private_part]
*/
case(as_package_spec):
package_specification(node);
break;
/* package_body -> ['package_body' identifier declarations
* opt_statements opt_handler]
*/
case(as_package_body):
id_node = N_AST1(node);
decl_node = N_AST2(node);
n3 = N_AST3(node);
n4 = N_AST4(node);
module_body_id(na_package, id_node);
adasem(decl_node);
adasem(n3);
adasem(n4);
force_all_types();
module_body(na_package, node);
package = N_UNQ(id_node);
if (NATURE(package) == na_generic_package)
N_KIND(node) = as_generic_package;
break;
/* private_type_declaration -> ['private_decl' identifier
* discriminant_list priv_kind]
*/
case(as_private_decl):
private_decl(node);
break;
/* Chapter 8. Visibility rules*/
/* use_clause -> [use' identifier_list]*/
case(as_use):
use_clause(node);
break;
/* renaming_declaration -> ['rename_ex' identifier name]*/
case(as_rename_ex):
rename_ex(node);
break;
/* renaming_declaration -> ['rename_pack' identifier name]*/
case(as_rename_pack):
rename_pack(node);
break;
/* renaming_declaration -> ['rename_obj' identifier type_mark name]*/
case(as_rename_obj):
rename_object(node);
break;
/* renaming declarations -> ['rename_sub' subprogam_spec name]*/
case(as_rename_sub):
rename_subprogram(node);
break;
/* Chapter 9. Tasks */
/* task_specification -> [task_kind identifier opt_entry_declaration
* opt_rep_clause]
* task_kind -> 'task_spec'
* -> na_task_type_spec
*/
case(as_task_spec):
case(as_task_type_spec):
/* clear N_AST3 as specification not supported now, and
* need this field for N_TYPE DS 9-21-86
*/
N_AST3(node) = (Node)0;
task_spec(node);
break;
/* task_body -> ['task' identifier declarations statements
* opt_exceptions]
*/
case(as_task):
/*[id_node, decls, stmts, excepts] := N_AST(node);*/
id_node = N_AST1(node);
n2 = N_AST2(node);
n3 = N_AST3(node);
n4 = N_AST4(node);
module_body_id(na_task_type, id_node);
/* clear the private_decls field set in module_body_id as this is */
/* irrelevant to tasks. */
private_decls(N_UNQ(id_node)) = (Set)0;
adasem(n2);
adasem(n3);
adasem(n4);
module_body(na_task_type, node);
s1 = N_UNQ(id_node);
check_incomplete_decls(s1, node);
break;
/* entry_declaration -> [na_entry identifier formals_list]*/
case(as_entry):
entry_decl(node);
break;
/* * entry_declaration -> [na_entry_family identifier discrete_range
* formals_list]
*/
case(as_entry_family):
entry_family_decl(node);
break;
/* accept_statement -> ['accept' name opt_expression opt_formal_part
* opt_statements]
*/
case(as_accept):
accept_statement(node);
break;
/* delay_statement -> ['delay' expression]*/
case(as_delay):
n1 = N_AST1(node);
adasem(n1);
check_type(symbol_duration, n1);
break;
/* selective_wait -> ['selective_wait' alternative_list else_part]*/
case(as_selective_wait):
n1 = N_AST1(node);
n2 = N_AST2(node);
sem_list(n1);
if (n2 != OPT_NODE)
adasem(n2);
break;
/* select_alternative -> ['guard' condition selective_wait_alternative]*/
case(as_guard):
adasem(N_AST1(node));
adasem(N_AST2(node));
break;
/* selective_wait_alternative -> ['accept_alt' accept_statement opt_stats]
* -> ['delay_alt' delay_statement opt_stats]
*/
case(as_accept_alt):
adasem(N_AST1(node));
adasem(N_AST2(node));
break;
case(as_delay_alt):
adasem(N_AST1(node));
adasem(N_AST2(node));
break;
/* selective_wait_alternative -> ['terminate_alt' ]*/
case(as_terminate_alt):
terminate_statement(node);
break;
/* conditional_entry_call -> ['conditional_entry_call' call_statement
* statements else_stat]
*/
case(as_conditional_entry_call):
check_entry_call(N_AST1(node));
adasem(N_AST2(node));
adasem(N_AST3(node));
break;
/* timed_entry_call -> ['timed_entry_call', call_statement statements
* delay_alternative]
*/
case(as_timed_entry_call):
check_entry_call(N_AST1(node));
adasem(N_AST2(node));
adasem(N_AST3(node));
break;
/* abort_statement -> ['abort' task_name_list]*/
case(as_abort):
abort_statement(node);
break;
/* Chapter 10. Program structure...*/
/* (as_compilation):
* This node is used for pragmas that precede a compilation unit.
* TBSL
*/
/* unit_declaration -> ['unit' context_clause unit_body]*/
case(as_unit):
compunit(node);
break;
/* context_clause -> ['with_use_list' [with_or_use...]]
* No action is necessary since this is handled in comp_unit
* body_stub -> ['subprogam_stub' subprogram_specification]
* -> ['package_stub' name]
* -> ['task_stub' name]
*/
case(as_subprogram_stub):
{
Symbol u_name;
n1 = N_AST1(node);
n2 = N_AST1(n1);
u_name = dcl_get(DECLARED(scope_name), N_VAL(n2));
/* For generic stubs ignore call to check_spec.
* TBSL: code for checking formals.
* Note: if uname is undefined here it indicates that the stub had
* no subprog declaration and therefore is certainly not generic.
*/
if (u_name != (Symbol)0
&& (NATURE(u_name) == na_generic_procedure_spec
|| NATURE(u_name) == na_generic_function_spec)) {
N_UNQ(n2) = u_name;
newscope(u_name);
adasem(n1);
popscope();
save_stub(node);
}
else {
adasem(n1);
check_spec(node);
u_name = N_UNQ(n2);
NATURE(u_name) = N_KIND(n1) == as_procedure ? na_procedure_spec
: na_function_spec;
if (in_op_designators(ORIG_NAME(u_name) ) ){
errmsg_l("Name of separately compiled unit cannot be ",
"an operator designator", "10.1", n2);
}
else {
save_stub(node);
}
}
}
break;
case(as_package_stub):
stub_head(na_package, node);
save_stub(node);
break;
case(as_task_stub):
stub_head(na_task, node);
save_stub(node);
break;
/* subunit -> ['separate' parent_name unit]*/
case(as_separate):
adasem(N_AST2(node));
break;
/* Chapter 11. Exceptions*/
/* Exception_declaration -> ['except_decl' identifier_list]*/
case(as_except_decl):
except_decl(node);
break;
/* exceptions -> ['exception' handler_list]*/
case(as_exception):
exception_part(node);
break;
/* exception_handler -> ['handler' exception_choice_list statements]*/
case(as_handler):
exception_handler(node);
break;
case(as_others):
break;
/* raise_statement -> ['raise opt_identifier]*/
case(as_raise):
raise_statement(node);
break;
/* Chapter 12. Generics*/
case(as_generic_procedure):
case(as_generic_function):
generic_subprog_spec(node);
break;
case(as_generic_package):
generic_pack_spec(node);
break;
/* Generic part -> ['generic_formals' generic_decl_list]*/
case(as_generic_formals):
/*$$$newtypes with:= []; $ Anonymous types may be created (???)*/
sem_list(node);
/*$$$ generic_list := []+/sem_list(2); and new_type_list*/
break;
/* Generic_formal -> ['generic_obj' id_list mode name opt_expression]*/
case(as_generic_obj):
generic_obj_decl(node);
break;
/* Generic formal -> ['generic_type' identifier type_def]*/
case(as_generic_type):
generic_type_decl(node);
break;
/* Generic formal -> ['gen_priv_type' private_type_declaration]*/
case(as_gen_priv_type):
generic_priv_decl(node);
break;
/* Generic_formal -> ['generic_subp', subprogram_spec opt_is]*/
case(as_generic_subp):
generic_subp_decl(node);
break;
/* Generic_type_definition -> ['generic' identifier]*/
case(as_generic):
break;
/* Package_instance -> ['package_instance' identifier name instance_list]*/
case(as_package_instance):
package_instance(node);
break;
/* subprogram_instance
* -> ['function_instance' designator name generic_actual_part]
* -> ['procedure_instance' identifier name generic_actual_part]
*/
case(as_function_instance):
case(as_procedure_instance):
subprog_instance(node);
break;
/* generic_parameter_association->['instance' opt_identifier expression]*/
case(as_instance):
break;
/* Chapter 13. Representation specs...*/
/* length_clause -> ['length_clause' attribute simple_expression ]*/
case(as_length_clause):
length_clause (node);
break;
/*
* enumeration_representation_clause -> ['enum_rep_clause'
* simple_name aggregate ]
*/
case(as_enum_rep_clause):
enum_rep_clause (node);
break;
/*
* record_representation_clause ->
* ['rec_rep_clause' simple_name opt_align_clause comp_clause_list ]
*/
case(as_rec_rep_clause):
rec_rep_clause(node);
break;
/* component_clause -> ['compon_clause' name simple_expression range]*/
case(as_compon_clause):
adasem(N_AST1(node));
adasem(N_AST2(node));
adasem(N_AST3(node));
break;
/* address_clause -> ['address_clause' simple_name simple_expression]*/
case(as_address_clause):
break;
case(as_opt):
break;
case(as_line_no):
break;
default:
if (node == (Node)0) return;
/* above is single line added re OPT_NODE 4 jul*/
printf("adasem: invalid node %d kind %d\n", node, N_KIND(node));
errmsg_str("System error: invalid node %", kind_str(N_KIND(node)),
"none", node);
}
}
