/* Copyright (C) 1998 Sverre Hvammen Johansen * Department of Informatics, University of Oslo. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; version 2. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "config.h" #include "gen.h" #include "extspec.h" static int dim; /****************************************************************************** SavePar */ /* Denne rutinen saver verdien til en variabel som er brukt som parameter * til en av random drawing prosedyrene eller en c-prosedyre. * og som samtidig er flere ganger i uttrykket. Er den brukt flere ganger * saves den bare en gang */ static int stackno; static struct EXP *savepar (ret, re, up, ident, type, first) struct EXP *ret, *re; char up; char *ident; char type; char first; { struct EXP *rex; if (first) stackno=0; if (up) { rex = re->up; if (rex == ret) ; else if ((rex->token == MASSIGN || rex->token == MASSIGNR || rex->token == MVALASSIGNT || rex->token == MREFASSIGNT) && rex->right == re) ; else if (rex->left == re) { if (rex->right != NULL) savepar (ret, rex->right, FALSE, ident, type, FALSE); savepar (ret, rex, TRUE, ident, type, FALSE); } else { if (rex->left != NULL) savepar (ret, rex->left, FALSE, ident, type, FALSE); savepar (ret, rex, TRUE, ident, type, FALSE); } } else { if (re->token == MIDENTIFIER && re->rd->ident == ident) { if (re->up->token == MARGUMENTSEP && (re->up->rd->categ == CNAME || re->up->rd->categ == CVAR)) ; else { struct EXP *restack1, *restack2, *reconc; if (stackno == 0) { switch (type) { case TREF: stackno= findallentry (ret, re, USEDREF); break; case TTEXT: stackno= findallentry (ret, re, USEDTXT); break; default: stackno= findallentry (ret, re, USEDVAL); break; } restack1= makeexp (MSTACK, NULL, NULL); if (re->up->left == re) re->up->left= restack1; else re->up->right= restack1; restack1->up= re->up; reconc= makeexp(rex->type==TTEXT? MREFASSIGNT:MASSIGN, restack2=makeexp (MSTACK, NULL,NULL), re); restack1->value.entry= restack2->value.ival= stackno; restack1->type= restack2->type= type; return reconc; } else { re->token = MSTACK; fprintf (ccode, ";"); re->value.entry= stackno; } } } else { if (re->right != NULL) savepar (ret, re->right, FALSE, ident, type, FALSE); if (re->left != NULL) savepar (ret, re->left, FALSE, ident, type, FALSE); } } return NULL; } /****************************************************************************** FINDSUBENTRY */ char usedentry[STACK_SIZE + 1]; static findsubentry (re) struct EXP *re; { switch (re->token) { case MSTACK: switch (re->type) { case TREF: usedentry[re->value.ival] |= USEDREF; break; case TTEXT: usedentry[re->value.ival] |= USEDTXT; break; default: usedentry[re->value.ival] |= USEDVAL; break; } break; case MTEXTADR: usedentry[re->value.stack.txt_entry] |= USEDTXT; case MARRAYADR: case MNAMEADR: usedentry[re->value.stack.ref_entry] |= USEDREF; usedentry[re->value.stack.val_entry] |= USEDVAL; break; default: if (re->left != NULL) findsubentry (re->left); if (re->right != NULL) findsubentry (re->right); } } /****************************************************************************** FINDALLENTRY */ int findallentry (ret, re, type) struct EXP *ret, *re; int type; { int i, max = 0; struct EXP *rex; if (is_after_dot(re)) re = re->up; rex = re; for (i = 1; i <= STACK_SIZE; i++) usedentry[i] = 0; while (rex != ret) { rex = re->up; while (rex != ret & (rex->left == re | rex->left == NULL | rex->token == MELSE)) { re = rex; rex = rex->up; } if (rex == ret) break; findsubentry (rex->left); re = rex; } if (type & MAXUSED) { for (i = 1; i <= STACK_SIZE; i++) if ((usedentry[i] & type) != 0) max = i; return (max); } else for (i = 1; i <= STACK_SIZE; i++) if ((usedentry[i] & type) == 0) return (i); gerror (87); } /****************************************************************************** ANT_STACK */ long ant_stack (ret, re) struct EXP *ret, *re; { return (((long) findallentry (ret, re, USEDVAL | MAXUSED)) << 16 | ((long) findallentry (ret, re, USEDREF | MAXUSED)) << 8 | (findallentry (ret, re, USEDTXT | MAXUSED))); } /****************************************************************************** GENSTACK */ /* This routine traverse a expression tree upwards. * For every leftside */ static struct EXP * genstack (ret, re, only_pointers) struct EXP *ret, *re; char only_pointers; { int i; struct EXP *rex, *reconc=NULL; rex = re->up; while (rex != ret & rex->left == re) { re = rex; rex = rex->up; } if (rex == ret) return reconc; reconc= genstack (ret, rex, only_pointers); /* Nå er alt ovenfor lagt på stakken, og det gjenstår bare å sjekke om * denne noden har en ventre-side med noe som må legges på stakken */ if (rex->token == MPROCARG) return reconc; if (rex->token == MARRAYARG) return reconc; if (rex->token == MELSEE) return reconc; if (rex->token == MIDENTIFIER && rex->rd->categ == CNAME) return reconc; if (rex->token == MANDTHENE || rex->token == MORELSEE) return reconc; if (rex->token == MBOUNDSEP || rex->left->token == MDOT) rex = rex->left; else if (rex->token == MASSIGN || rex->token == MASSIGNR || rex->token == MREFASSIGNT) return reconc; switch (rex->left->token) { case MPROCARG: /* M} sjekke om prosedyren (som er en NOTDANGER prosedyre) har noen * parametere som ikke er konstante. Attributtet konst == TRUE hvis * dens parametere best}r av konstanter og i s}fall trenger de ikke * saves noe. Hvis prosedyren er en av * text-prosedyrene, s} saves det ogs} (save - dvs. at prosedyren * evalueres og resultatet legges p} stakken. */ if (!rex->left->konst || rex->left->rd->descr->codeclass == CCTEXT) goto save; break; case MTEXTKONST: case MCHARACTERKONST: case MREALKONST: case MINTEGERKONST: case MBOOLEANKONST: case MNONE: case MSTACK: case MARRAYADR: return reconc; break; default: save: if (rex->left->type == TLABEL) return reconc; { int entry; int type= rex->left->type; struct EXP *restack; switch (rex->left->type) { case TREF: entry= findallentry (ret, rex->left, USEDREF); break; case TTEXT: /* Sjekker om det er kall paa en av text-attributt prosedyrene * Text-variabelen skal da IKKE saves. */ if (rex->token == MDOT) return reconc; if (only_pointers && rex->up->token != MVALASSIGNT) return reconc; entry= findallentry (ret, rex->left, USEDTXT); break; default: if (only_pointers) return reconc; entry= findallentry (ret, rex->left, USEDVAL); break; } reconc= concexp (reconc, makeexp(rex->left->type==TTEXT? MREFASSIGNT:MASSIGN, restack=makeexp(MSTACK, NULL,NULL), rex->left)); rex->left= makeexp (MSTACK, NULL, NULL); rex->left->up= rex; restack->value.entry= rex->left->value.entry= entry; restack->type= rex->left->type= type; if (rex->token == MBOUNDPARSEP && rex->right != re && !only_pointers) /* sjekk at det er slik at rex->right!=NULL */ { entry= findallentry (ret, rex->right, USEDVAL); reconc= concexp (reconc, makeexp(rex->left->type==TTEXT? MREFASSIGNT:MASSIGN, restack=makeexp (MSTACK, NULL,NULL), rex->right)); type= rex->type; restack->value.entry= rex->right->value.entry= entry; restack->type= rex->right->type= type; } } } return reconc; } /****************************************************************************** WORKBEFORETEST */ /* G}r gjennom subtreet og ser om det vil bli skrevet ut noen kode f|r * genvalue() kalles. Brukes i forbindelse med if i uttrykk og i forbindelse * med ORELSE og ANDTHEN */ static char workbeforetest (re) struct EXP *re; { int token; /* token er deklarert som int fordi * kompilatoren ga warning om at constant 136 * is out of range of char comparison etter * at MCONC ble lagt inn. Dette m} ses * n{rmere p}. */ token = re->token; if (token == MNEWARG || token == MARRAYARG || token == MQUA || token == MQUANOTNONE || token == MQUANONEAND || token == MCONC || (token == MIDENTIFIER && re->rd->categ == CNAME) || (token == MPROCARG && re->danger)) return (TRUE); if (re->left != NULL && workbeforetest (re->left)) return (TRUE); if (re->right != NULL && workbeforetest (re->right)) return (TRUE); return (FALSE); } /****************************************************************************** TRANSPARAM */ transparam (re) struct EXP *re; { struct EXP *rex, *rexp, *rey; char index_is_const = TRUE; rexp=re; for (rex = re->right; rex->token != MENDSEP; rex = rex->right) { if (rex->rd->categ == CNAME) { if (rex->rd->kind == KSIMPLE) { if (rex->rd->type == TLABEL) { if (rex->left->token != MIDENTIFIER) /* Label overført by name * ADDRESS_THUNK */ insert_thunk (rex, MTHUNKLABLE); } else switch (rex->left->token) { case MTEXTKONST: case MINTEGERKONST: case MREALKONST: case MCHARACTERKONST: case MBOOLEANKONST: case MNONE: case MIDENTIFIER: break; case MARRAYARG: for (re = rex->left->right; index_is_const && re->token != MENDSEP; re = re->right) if (re->left->token != MINTEGERKONST) index_is_const = FALSE; if (!index_is_const) insert_thunk (rex, MTHUNKSIMPLEADDRESS); else goto trcall; break; case MDOT: /* Dersom det er et dot'et prosedyre-kall, * s} skal det genereres * VALUE_THUNK og ikke ADDRESS_THUNK. */ if (rex->left->right->rd->kind != KPROC) { insert_thunk (rex, MTHUNKSIMPLEADDRESS); break; } else; /* Denne grenen skal IKKE ha break, Skal gli * rett over i neste case. */ default: insert_thunk (rex, MTHUNKSIMPLEVALUE); } } else if (rex->rd->kind == KARRAY && rex->rd->type != TLABEL && rex->left->token == MDOT) { /* ADDRESS_THUNK */ insert_thunk (rex, MTHUNKARRAY); } else if (rex->rd->kind == KPROC && rex->left->token == MDOT) { /* ADDRESS_THUNK */ insert_thunk (rex, MTHUNKPROCEDURE); } } else { trcall: rey= transcall (rex, rex->left); if (rey!=NULL) { rexp->right=makeexp (MSENTCONC, rey, rex); rexp->right->up= rexp; } } rexp= rex; } } /****************************************************************************** TRANSCALL */ struct EXP *transcall (ret, re) struct EXP *ret, *re; { struct EXP *rex, *reconc=NULL; short entry; switch (re->token) { case MNEWARG: transparam (re); reconc= genstack (ret, re, FALSE); re->value.n_of_stack_elements= ant_stack (ret, re); reconc= concexp (reconc, replacenode (&re, MSTACK)); rex= makeexp (MASSIGND, makeexp (MSTACK, NULL, NULL), makeexp (MEXITARGUMENT, NULL, NULL)); rex->type= rex->left->type= rex->right->type= TREF; rex->left->value.entry= re->value.entry= findallentry (ret, re, USEDREF); reconc= concexp (reconc, rex); break; case MPROCARG: /* Ekstern C-prosedyre eller en av standard prosedyrene */ switch (re->rd->descr->codeclass) { case CCNO: if(is_after_dot(re)) reconc= concexp (reconc, genstack (ret, re->up, FALSE)); else reconc= concexp (reconc, genstack (ret, re, FALSE)); transparam (re); if (re->rd->categ == CNAME) { rex= copytree (re); rex->value.ival= ant_stack (ret, re); rex->token= MNAMEREADACESS; reconc= concexp (reconc, rex); } switch (re->type) { case TREF: entry= findallentry (ret, re, USEDREF); break; case TTEXT: entry= findallentry (ret, re, USEDTXT); break; case TNOTY: break; default: entry= findallentry (ret, re, USEDVAL); break; } re->value.combined_stack.entry=entry; re->value.combined_stack.n_of_stack_elements= ant_stack(ret, re); reconc= concexp (reconc, replacenode (&re, MSTACK)); re->value.entry=entry; break; case CCCPROC: /* Bare text-prosedyrer som er danger. Resten er NOTDANGER. * N}r det gjelder uttrykk som * inneholder flere C-prosedyrer s} garanterer ikke * kompilatoren at de blir utf\rt i riktig rekkef\lge. */ for (rex = re->right; rex->token != MENDSEP; rex = rex->right) { /* Kaller savepar for alle formelle NAME eller VAR * parametere. */ if ((rex->rd->categ == CNAME || rex->rd->categ == CVAR) && rex->left->token == MIDENTIFIER) reconc= concexp (reconc, savepar (ret, re, TRUE, rex->left->rd->ident, rex->left->rd->type, TRUE)); } for (rex = re->right; rex->token != MENDSEP; rex = rex->right) reconc= concexp (reconc, transcall (ret, rex->left)); if (re->type == TTEXT) { entry= findallentry (ret, re, USEDTXT); re->value.combined_stack.entry= entry; re->value.combined_stack.n_of_stack_elements= ant_stack (ret, re); reconc= concexp (reconc, replacenode (&re, MSTACK)); re->value.entry=entry; } break; case CCFILEDANGER: case CCSIMPLEDANGER: case CCTEXTDANGER: case CCRANDOMRUTDANGER: case CCBLANKSCOPY: case CCFILEBLANKSCOPY: if (re->danger) { if (is_after_dot (re) && re->up->left->type == TTEXT) reconc= genstack (ret, re->up->left, FALSE); else reconc= genstack (ret, re, FALSE); for (rex = re->right; rex->token != MENDSEP; rex = rex->right) reconc= concexp (reconc, transcall (ret, rex->left)); if (re->rd->descr->codeclass == CCRANDOMRUTDANGER) { /* Leter etter siste aktuelle parameter, som */ /* er en NAME parameter. Det skal sjekkes om */ /* denne variabelen er brukt flere ganger i uttrykket */ for (rex= re; rex->right->token != MENDSEP; rex= rex->right); reconc= concexp (reconc, savepar (ret, re, rex->left->rd, TRUE)); } switch (re->type) { case TREF: entry= re->value.combined_stack.entry= findallentry (ret, re, USEDREF); break; case TTEXT: entry= re->value.combined_stack.entry= findallentry (ret, re, USEDTXT); break; case TNOTY: break; default: entry= re->value.combined_stack.entry= findallentry (ret, re, USEDVAL); break; } re->value.combined_stack.n_of_stack_elements= ant_stack (ret, re); reconc= concexp (reconc, replacenode (&re, MSTACK)); re->value.entry=entry; break; } /* Ingen break her */ default: for (rex = re->right; rex->token != MENDSEP; rex = rex->right) reconc= concexp (reconc,transcall (ret, rex->left)); break; } break; case MASSIGNR: if (re->danger) reconc= genstack (ret, re, TRUE); reconc= concexp (reconc, transcall (ret, re->left)); reconc= concexp (reconc, transcall (ret, re->right)); if ((rex = re->left)->token == MNAMEADR && rex->type == TREF) { reconc= concexp (reconc, makeexp(MINSTRONGEST,copytree(re->left), copytree(re->right))); } break; case MREFASSIGNT: if (re->danger) reconc= genstack (ret, re, TRUE); reconc= concexp (reconc, transcall (ret, re->left)); reconc= concexp (reconc, transcall (ret, re->right)); break; case MARRAYARG: reconc= genstack (ret, re, FALSE); if (re->type == TLABEL) { reconc= concexp (reconc, transcall (ret, re->right->left)); break; } /* Dersom oversikt om hva som ligger på stacken håndteres anderledes kan den følgende koden fjernes */ re->left= makeexp (MARRAYADR, NULL, NULL); re->left->up = re; re->left->value.stack.ref_entry= re->value.stack.ref_entry= findallentry (ret, re, USEDREF); re->left->value.stack.val_entry= re->value.stack.val_entry= findallentry (ret, re, USEDVAL); if (re->rd->categ == CNAME) { reconc= concexp (reconc, genstack (ret, re, FALSE)); rex= copytree (re); rex->value.n_of_stack_elements= ant_stack (ret, re); rex->token= MNAMEREADACESS; reconc= concexp (reconc, rex); rex= makeexp (MASSIGND, makeexp (MSTACK, NULL, NULL), makeexp (MEXITARGUMENT, NULL, NULL)); rex->type= rex->left->type= rex->right->type= TREF; rex->left->value.entry= re->value.stack.ref_entry; reconc= concexp (reconc, rex); } reconc= concexp (reconc, transcall (ret, re->right)); re->left= NULL; reconc= concexp (reconc, replacenode (&re, MARRAYADR)); break; case MIDENTIFIER: if (re->rd->categ == CNAME) { reconc= concexp (reconc, genstack (ret, re, FALSE)); rex= copytree (re); rex->value.n_of_stack_elements= ant_stack (ret, re); if (((re->up->token == MASSIGN || re->up->token == MASSIGNR || re->up->token == MVALASSIGNT || re->up->token == MREFASSIGNT) && re->up->left == re) || (re->up->token == MARGUMENTSEP && re->up->rd->categ == CVAR)) { /* SKRIVE AKSESS */ rex->token= MNAMEWRITEACESS; reconc= concexp (reconc, rex); rex= makeexp (MASSIGND, makeexp (MSTACK, NULL, NULL), makeexp (MEXITARGUMENT, NULL, NULL)); rex->type= rex->left->type= rex->right->type= TREF; rex->left->value.entry= re->value.stack.ref_entry= findallentry (ret, re, USEDREF); reconc= concexp (reconc, rex); rex= makeexp (MASSIGND, makeexp (MSTACK, NULL, NULL), makeexp (MEXITARGUMENT, NULL, NULL)); rex->type= rex->left->type= rex->right->type= TINTG; rex->left->value.entry= re->value.stack.val_entry= findallentry (ret, re, USEDVAL); reconc= concexp (reconc, rex); re->token = MNAMEADR; } /* END-SKRIVEAKSESS NAME-PARAMETER */ else { /* LESE AKSESS */ rex->token= MNAMEREADACESS; reconc= concexp (reconc, rex); if (re->rd->kind == KPROC || re->rd->kind == KARRAY || re->type == TLABEL); else if (re->type == TTEXT) { rex= copytree (re); rex->value.stack.val_entry= re->value.stack.val_entry= findallentry (ret, re, USEDVAL); rex->value.stack.ref_entry= re->value.stack.ref_entry= findallentry (ret, re, USEDREF); rex->value.stack.txt_entry= re->value.stack.txt_entry= findallentry (ret, re, USEDTXT); rex->token= MNAMEREADTEXT; reconc= concexp (reconc, rex); re->token = MTEXTADR; } else { rex= makeexp (MASSIGND, makeexp (MSTACK, NULL, NULL), makeexp (MEXITARGUMENT, NULL, NULL)); rex->type= rex->left->type= rex->right->type= re->type; rex->left->value.entry= re->value.entry= findallentry (ret, re, re->type == TREF?USEDREF:USEDVAL); reconc= concexp (reconc, rex); re->token = MSTACK; } } /* END-LESEAKSESS AV NAME-PAR */ } /* END-NAME-PARAMETER */ break; case MANDTHENE: case MORELSEE: reconc= transcall (ret, re->left); if (workbeforetest (re->right)) { int i; reconc= concexp (reconc, genstack (ret, re, FALSE)); rex= makeexp (re->token == MANDTHENE ? MANDTHEN : MORELSE, copytree (re->left), transcall (ret, re->right)); rex->type= re->type; reconc= concexp (reconc, rex); } break; case MIFE: reconc= transcall (ret, re->left); if (workbeforetest (re->right)) { reconc= concexp (reconc, genstack (ret, re->right, FALSE)); rex= makeexp (MIF, re->left, transcall (ret, re->right)); rex->type= re->type; rex->qual= re->qual; reconc= concexp (reconc, rex); } break; case MELSEE: rex= makeexp (MELSE, transcall (ret, re->left), transcall (ret, re->right)); rex->type= re->type; rex->qual= re->qual; reconc= rex; break; case MCONC: reconc= transcall (ret, re->left); reconc= concexp (reconc, transcall (ret, re->right)); re->value.combined_stack.entry= findallentry (ret, re, USEDTXT); re->value.combined_stack.n_of_stack_elements= ant_stack (ret, re); rex= newexp (); *rex= *re; rex->left->up= rex->right->up= rex; reconc= concexp (reconc, rex); re->value.entry= rex->value.combined_stack.entry; re->token = MSTACK; re->left = re->right = NULL; break; default: if (re->left != NULL) reconc= transcall (ret, re->left); if (re->right != NULL) reconc= concexp (reconc, transcall (ret, re->right)); } return reconc; }