extern int
main(int argc, char* argv[])
{
int c = EOF, comment = FALSE, i, j, k;
cr = FALSE;
line_nr = 0;
nr_tags = 0;
for (i = 1; i < argc; i += 1) {
if (comment) {
comment = FALSE;
emits("// ");
emits(argv[i]);
emit('\n');
} else if (strcmp(argv[i], "-comment") == 0) {
comment = TRUE;
} else {
for (j = 0; j < MAX_TAG_LENGTH; j += 1) {
c = argv[i][j];
if (!is_alphanum(c)) {
break;
}
tags[nr_tags][j] = (char)c;
}
if (j == 0) {
error(argv[i]);
}
tags[nr_tags][j] = 0;
if (c == 0) {
methods[nr_tags][0] = 0;
} else if (c == ':') {
j += 1;
for (k = 0; k < MAX_TAG_LENGTH; k += 1) {
c = argv[i][j + k];
if (!is_alphanum(c)) {
break;
}
methods[nr_tags][k] = (char)c;
}
methods[nr_tags][k] = 0;
if (k == 0 || c != 0) {
error(argv[i]);
}
} else {
error(argv[i]);
}
nr_tags += 1;
}
}
process();
return 0;
}
static void
expand(int tag_nr)
{
int c;
c = peek();
if (c == '(') {
emits("if ");
condition();
emit(' ');
}
emit('{');
if (methods[tag_nr][0]) {
emits(methods[tag_nr]);
emit('(');
stuff();
emits(");}");
} else {
stuff();
emit('}');
}
}
static int genll(Error_printer *err, Frag *frag, Node * n)
{
switch (n->what) {
case nEMPTY: {
return 0;
} case nSEMI: {
int result = genll(err, frag, n->r);
return result + genll(err, frag, n->l);
} case nNAM: {
push_str(frag);
emits(frag, n->s, n->n);
return 1;
} case nSET: {
if (n->l->what == nNAM) {
push_str(frag);
emits(frag, n->l->s, n->l->n);
return 1;
}
}
}
error_2(err, "\"%s\" %d: incorrect local list", n->loc->name, n->loc->line);
return 0;
}
static int gencl(Error_printer *err, Frag *frag, Node * n)
{
int result;
switch (n->what) {
case nEMPTY: {
return 0;
} case nSEMI: {
result = gencl(err, frag, n->r);
return result + gencl(err, frag, n->l);
} case nSET: {
if (n->l->what == nQUOTE && (n->l->r->what == nNAM || n->l->r->what == nSTR)) {
genfunc(err, frag, consempty(n->loc), n->r);
push_narg(frag);
emits(frag, n->l->r->s, n->l->r->n);
return 1;
}
break;
}
}
genfunc(err, frag, consempty(n->loc), n);
return 1;
}
static void
process()
{
/*
Loop through the program text, looking for patterns.
*/
int c, i, left = 0;
line_nr = 1;
c = get(FALSE);
for (;;) {
if (c == EOF) {
break;
} else if (c == '\'' || c == '"' || c == '`') {
emit(c);
string(c, FALSE);
c = 0;
/*
The most complicated case is the slash. It can mean division or a regexp
literal or a line comment or a block comment. A block comment can also be
a pattern to be expanded.
*/
} else if (c == '/') {
/*
A slash slash comment skips to the end of the file.
*/
if (peek() == '/') {
emit('/');
for (;;) {
c = get(TRUE);
if (c == '\n' || c == '\r' || c == EOF) {
break;
}
}
c = get(FALSE);
/*
The first component of a slash star comment might be the tag.
*/
} else {
if (peek() == '*') {
get(FALSE);
for (i = 0; i < MAX_TAG_LENGTH; i += 1) {
c = get(FALSE);
if (!is_alphanum(c)) {
break;
}
tag[i] = (char)c;
}
tag[i] = 0;
unget(c);
/*
Did the tag match something?
*/
i = i == 0 ? -1 : match();
if (i >= 0) {
expand(i);
c = get(FALSE);
} else {
/*
If the tag didn't match, then echo the comment.
*/
emits("/*");
emits(tag);
for (;;) {
if (c == EOF) {
error("unterminated comment.");
}
if (c == '/') {
c = get(TRUE);
if (c == '*') {
error("nested comment.");
}
} else if (c == '*') {
c = get(TRUE);
if (c == '/') {
break;
}
} else {
c = get(TRUE);
}
}
c = get(FALSE);
}
} else {
emit('/');
/*
We are looking at a single slash. Is it a division operator, or is it the
start of a regexp literal? If is not possible to tell for sure without doing
a complete parse of the program, and we are not going to do that. Instead,
we are adopting the convention that a regexp literal must have one of a
small set of characters to its left.
*/
if (pre_regexp(left)) {
regexp(FALSE);
}
left = '/';
c = get(FALSE);
}
}
} else {
/*
The character was nothing special, to just echo it.
If it wasn't whitespace, remember it as the character to the left of the
next character.
*/
emit(c);
if (c > ' ') {
left = c;
}
c = get(FALSE);
}
}
}
void
outcode(tree *t, int eflag)
{
int p, q;
tree *tt;
if(t==0)
return;
if(t->type!=NOT && t->type!=';')
runq->iflast = 0;
switch(t->type){
default:
pfmt(err, "bad type %d in outcode\n", t->type);
break;
case '$':
emitf(Xmark);
outcode(c0, eflag);
emitf(Xdol);
break;
case '"':
emitf(Xmark);
outcode(c0, eflag);
emitf(Xqdol);
break;
case SUB:
emitf(Xmark);
outcode(c0, eflag);
emitf(Xmark);
outcode(c1, eflag);
emitf(Xsub);
break;
case '&':
emitf(Xasync);
if(havefork){
p = emiti(0);
outcode(c0, eflag);
emitf(Xexit);
stuffdot(p);
} else
emits(fnstr(c0));
break;
case ';':
outcode(c0, eflag);
outcode(c1, eflag);
break;
case '^':
emitf(Xmark);
outcode(c1, eflag);
emitf(Xmark);
outcode(c0, eflag);
emitf(Xconc);
break;
case '`':
emitf(Xbackq);
if(havefork){
p = emiti(0);
outcode(c0, 0);
emitf(Xexit);
stuffdot(p);
} else
emits(fnstr(c0));
break;
case ANDAND:
outcode(c0, 0);
emitf(Xtrue);
p = emiti(0);
outcode(c1, eflag);
stuffdot(p);
break;
case ARGLIST:
outcode(c1, eflag);
outcode(c0, eflag);
break;
case BANG:
outcode(c0, eflag);
emitf(Xbang);
break;
case PCMD:
case BRACE:
outcode(c0, eflag);
break;
case COUNT:
emitf(Xmark);
outcode(c0, eflag);
emitf(Xcount);
break;
case FN:
emitf(Xmark);
outcode(c0, eflag);
if(c1){
emitf(Xfn);
p = emiti(0);
emits(fnstr(c1));
outcode(c1, eflag);
emitf(Xunlocal); /* get rid of $* */
emitf(Xreturn);
stuffdot(p);
}
else
emitf(Xdelfn);
break;
case IF:
outcode(c0, 0);
emitf(Xif);
p = emiti(0);
outcode(c1, eflag);
emitf(Xwastrue);
stuffdot(p);
break;
case NOT:
if(!runq->iflast)
yyerror("`if not' does not follow `if(...)'");
emitf(Xifnot);
p = emiti(0);
outcode(c0, eflag);
stuffdot(p);
break;
case OROR:
outcode(c0, 0);
emitf(Xfalse);
p = emiti(0);
outcode(c1, eflag);
stuffdot(p);
break;
case PAREN:
outcode(c0, eflag);
break;
case SIMPLE:
emitf(Xmark);
outcode(c0, eflag);
emitf(Xsimple);
if(eflag)
emitf(Xeflag);
break;
case SUBSHELL:
emitf(Xsubshell);
if(havefork){
p = emiti(0);
outcode(c0, eflag);
emitf(Xexit);
stuffdot(p);
} else
emits(fnstr(c0));
if(eflag)
emitf(Xeflag);
break;
case SWITCH:
codeswitch(t, eflag);
break;
case TWIDDLE:
emitf(Xmark);
outcode(c1, eflag);
emitf(Xmark);
outcode(c0, eflag);
emitf(Xmatch);
if(eflag)
emitf(Xeflag);
break;
case WHILE:
q = codep;
outcode(c0, 0);
if(q==codep)
emitf(Xsettrue); /* empty condition == while(true) */
emitf(Xtrue);
p = emiti(0);
outcode(c1, eflag);
emitf(Xjump);
emiti(q);
stuffdot(p);
break;
case WORDS:
outcode(c1, eflag);
outcode(c0, eflag);
break;
case FOR:
emitf(Xmark);
if(c1){
outcode(c1, eflag);
emitf(Xglob);
}
else{
emitf(Xmark);
emitf(Xword);
emits(strdup("*"));
emitf(Xdol);
}
emitf(Xmark); /* dummy value for Xlocal */
emitf(Xmark);
outcode(c0, eflag);
emitf(Xlocal);
p = emitf(Xfor);
q = emiti(0);
outcode(c2, eflag);
emitf(Xjump);
emiti(p);
stuffdot(q);
emitf(Xunlocal);
break;
case WORD:
emitf(Xword);
emits(strdup(t->str));
break;
case DUP:
if(t->rtype==DUPFD){
emitf(Xdup);
emiti(t->fd0);
emiti(t->fd1);
}
else{
emitf(Xclose);
emiti(t->fd0);
}
outcode(c1, eflag);
emitf(Xpopredir);
break;
case PIPEFD:
emitf(Xpipefd);
emiti(t->rtype);
if(havefork){
p = emiti(0);
outcode(c0, eflag);
emitf(Xexit);
stuffdot(p);
} else {
emits(fnstr(c0));
}
break;
case REDIR:
emitf(Xmark);
outcode(c0, eflag);
emitf(Xglob);
switch(t->rtype){
case APPEND:
emitf(Xappend);
break;
case WRITE:
emitf(Xwrite);
break;
case READ:
case HERE:
emitf(Xread);
break;
case RDWR:
emitf(Xrdwr);
break;
}
emiti(t->fd0);
outcode(c1, eflag);
emitf(Xpopredir);
break;
case '=':
tt = t;
for(;t && t->type=='=';t = c2);
if(t){
for(t = tt;t->type=='=';t = c2){
emitf(Xmark);
outcode(c1, eflag);
emitf(Xmark);
outcode(c0, eflag);
emitf(Xlocal);
}
outcode(t, eflag);
for(t = tt; t->type=='='; t = c2)
emitf(Xunlocal);
}
else{
for(t = tt;t;t = c2){
emitf(Xmark);
outcode(c1, eflag);
emitf(Xmark);
outcode(c0, eflag);
emitf(Xassign);
}
}
t = tt; /* so tests below will work */
break;
case PIPE:
emitf(Xpipe);
emiti(t->fd0);
emiti(t->fd1);
if(havefork){
p = emiti(0);
q = emiti(0);
outcode(c0, eflag);
emitf(Xexit);
stuffdot(p);
} else {
emits(fnstr(c0));
q = emiti(0);
}
outcode(c1, eflag);
emitf(Xreturn);
stuffdot(q);
emitf(Xpipewait);
break;
}
if(t->type!=NOT && t->type!=';')
runq->iflast = t->type==IF;
else if(c0) runq->iflast = c0->type==IF;
}
void
cleanhere(char *f)
{
emitf(Xdelhere);
emits(strdup(f));
}
void
CCDReader4qxml::ports (DOMElement* element)
throw(CCDReadException)
{
DOMNode* child = element->getFirstChild();
while (child != 0)
{
if (child->getNodeType() == DOMNode::ELEMENT_NODE)
{
//
// source
//
if (!XMLString::compareString(child->getNodeName(), X("source")))
{
source((DOMElement*)child);
}
//
// sink
//
else if (!XMLString::compareString(child->getNodeName(), X("sink")))
{
sink( (DOMElement*) child);
}
//
// uses
//
else if (!XMLString::compareString(child->getNodeName(), X("uses")))
{
uses( (DOMElement*) child);
}
//
// provides
//
else if (!XMLString::compareString(child->getNodeName(), X("provides")))
{
provides( (DOMElement*) child);
}
//
// emits
//
else if (!XMLString::compareString(child->getNodeName(), X("emits")))
{
emits( (DOMElement*) child);
}
//
// publishes
//
else if (!XMLString::compareString(child->getNodeName(), X("publishes")))
{
publishes( (DOMElement*) child);
}
//
// consumes
//
else if (!XMLString::compareString(child->getNodeName(), X("consumes")))
{
consumes( (DOMElement*) child);
}
}
// get next child
child = child->getNextSibling();
}
}
static void gen(Error_printer *err, Frag *frag, Node * n)
{
switch(n->what) {
case nCOMMA: {
genn(err, frag, n->l), gen(err, frag, n->r);
break;
} case nPAREN: {
gen(err, frag, n->r);
break;
} case nLIST: {
int amnt = genl(err, frag, n->r);
push_lst(frag);
emitn(frag, amnt);
emitc(frag, iFIX);
fixlooplvl(frag, amnt);
break;
} case nVOID: {
push_void(frag);
break;
} case nTHIS: {
push_this(frag);
break;
} case nNUM: {
push_num(frag);
emitl(frag, n->n);
break;
} case nFP: {
push_fp(frag);
emitd(frag, n->fp);
break;
} case nSTR: {
push_str(frag);
emits(frag, n->s, n->n);
break;
} case nNAM: {
push_nam(frag);
emitp(frag, n->s);
emitc(frag, iGET_ATOM);
break;
} case nSET: {
gen(err, frag, n->r);
// gena(err, frag, n->l); (lvalue change)
gen(err, frag, n->l);
emitc(frag, iSET);
rmlooplvl(frag, lvlVALUE, 0, 0);
break;
} case nIF: {
gencond(err, frag, n->r, 1);
break;
} case nPOST: {
gen(err, frag, n->l);
gen(err, frag, n->r);
// gena(err, frag, n->l); (lvalue change)
gen(err, frag, n->l);
emitc(frag, iSET);
rmlooplvl(frag, lvlVALUE, 0, 0);
emitc(frag, iPOP);
rmlooplvl(frag, lvlVALUE, 0, 0);
break;
} case nADDR: {
/* Generate a code snippet */
genfunc(err, frag, consempty(n->loc), n->r);
break;
} case nDEFUN: {
if (n->r->what==nSEMI) {
if (n->r->l->what==nCALL && n->r->l->l->what==nNAM) { /* fn sq(x) x*x */
genfunc(err, frag, n->r->l->r, n->r->r);
push_nam(frag);
emitp(frag, n->r->l->l->s);
emitc(frag, iGETF_ATOM);
emitc(frag, iSET);
rmlooplvl(frag, lvlVALUE, 0, 0);
} else if (n->r->l->what==nNAM && n->r->r->what==nSEMI && n->r->r->l->what==nPAREN) { /* fn sq (x) x*x */
genfunc(err, frag, n->r->r->l, n->r->r->r);
push_nam(frag);
emitp(frag, n->r->l->s);
emitc(frag, iGETF_ATOM);
emitc(frag, iSET);
rmlooplvl(frag, lvlVALUE, 0, 0);
} else if (n->r->l->what==nNAM && n->r->r->what==nPAREN) { /* fn sq (x) */
genfunc(err, frag, n->r->r, consempty(n->loc));
push_nam(frag);
emitp(frag, n->r->l->s);
emitc(frag, iGETF_ATOM);
emitc(frag, iSET);
rmlooplvl(frag, lvlVALUE, 0, 0);
} else if (n->r->l->what==nPAREN) { /* fn (x) x*x */
genfunc(err, frag, n->r->l, n->r->r);
} else {
error_2(err, "\"%s\" %d: ill-formed fn", n->r->loc->name, n->r->loc->line);
push_void(frag);
}
} else if(n->r->what==nCALL && n->r->l->what==nNAM) { /* fn sq(x) */
genfunc(err, frag, n->r->r, consempty(n->loc));
push_nam(frag);
emitp(frag, n->r->l->s);
emitc(frag, iGETF_ATOM);
emitc(frag, iSET);
rmlooplvl(frag, lvlVALUE, 0, 0);
} else if(n->r->what==nPAREN) { /* fn () */
genfunc(err,frag, n->r, consempty(n->loc));
} else {
error_2(err, "\"%s\" %d: ill-formed fn", n->r->loc->name, n->r->loc->line);
push_void(frag);
}
break;
} case nLAMBDA: {
genfunc(err, frag, n->r->l, n->r->r);
break;
} case nSEMI: {
if (n->r->what == nELSE) {
int done = genelif(err, frag, n->l, 1);
if (!done)
error_2(err, "\"%s\" %d: else w/o if error", n->r->loc->name, n->r->loc->line);
if (n->r->r->what == nIF) {
addlist(frag, done, genbra(err, frag, n->r->r->l, 1));
n = n->r;
}
mklooplvl(frag, lvlSCOPE, 0, 0);
gen(err, frag, n->r->r);
rmlooplvl(frag, lvlSCOPE, 0, 0);
setlist(frag, done, frag->code);
} else {
genn(err, frag, n->l);
gen(err, frag, n->r);
}
break;
} case nEQ: case nNE: case nGT: case nLT: case nGE: case nLE: case nLAND: case nLOR: case nNOT: {
int b = genbra(err, frag, n, 1);
int link;
push_num(frag);
emitl(frag, 1);
emitc(frag, iBRA);
link=emitn(frag, 0);
setlist(frag, b, frag->code);
push_num(frag);
emitl(frag, 0);
*(int *)(frag->begcode+link)=frag->code-link;
break;
} case nCALL: {
// int nargs = genl(err, frag, n->r); /* By value */
int nargs = gencl(err, frag, n->r); /* Functionalize */
push_lst(frag);
emitn(frag, nargs);
// gena(err, frag, n->l); (lvalue change)
gen(err, frag, n->l);
emitc(frag, iCALL);
fixlooplvl(frag, nargs + 1);
break;
} case nCALL1: { /* Ends up being the same as above */
// if (n->r->what != nNAM)
// error_2(err, "\"%s\" %d: Invalid member name", n->r->loc->name, n->r->loc->line);
if (n->r->what == nNAM) { /* Turn it into a string .x -> ."x" */
n->r->what = nSTR;
}
int nargs = gencl(err, frag, n->r);
// push_str(frag);
// emits(frag, n->r->s, n->r->n);
push_lst(frag);
emitn(frag, nargs);
// gena(err, frag, n->l); (lvalue change)
gen(err, frag, n->l);
emitc(frag, iCALL);
fixlooplvl(frag, nargs + 1);
break;
} case nCOM: case nNEG: case nSHL: case nSHR: case nMUL: case nDIV: case nMOD: case nAND:
case nADD: case nSUB: case nOR: case nXOR: case nAT: {
if (n->l)
gen(err, frag, n->l);
if (n->r)
gen(err, frag, n->r);
emitc(frag, what_tab[n->what].i);
if (n->r && n->l)
rmlooplvl(frag, lvlVALUE, 0, 0);
break;
} default: {
genn(err, frag, n);
push_void(frag);
}
}
}
