Return to b2gen.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint

Annotation of 43BSD/contrib/B/src/bint/b2gen.c, revision 1.1

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
        !             2: 
        !             3: /* $Header: b2gen.c,v 1.4 85/08/27 10:57:31 timo Exp $ */
        !             4: 
        !             5: /* Code generation */
        !             6: 
        !             7: #include "b.h"
        !             8: #include "b0fea.h"
        !             9: #include "b1obj.h"
        !            10: #include "b2exp.h"
        !            11: #include "b2nod.h"
        !            12: #include "b2gen.h" /* Must be after b2nod.h */
        !            13: #include "b3err.h"
        !            14: #include "b3env.h"
        !            15: #include "b3int.h"
        !            16: #include "b3sem.h"
        !            17: #include "b3sou.h"
        !            18: 
        !            19: Visible Procedure fix_nodes(pt, code) parsetree *pt; parsetree *code; {
        !            20:        context c; value *setup(), *su;
        !            21:        sv_context(&c);
        !            22:        curline= *pt; curlino= one;
        !            23:        su= setup(*pt);
        !            24:        if (su) analyze(*pt, su);
        !            25:        curline= *pt; curlino= one;
        !            26:        inithreads();
        !            27:        fix(pt, su ? 'x' : 'v');
        !            28:        endthreads(code);
        !            29:        cleanup();
        !            30: #ifdef TYPE_CHECK
        !            31:        if (cntxt != In_prmnv) type_check(*pt);
        !            32: #endif
        !            33:        set_context(&c);
        !            34: }
        !            35: 
        !            36: /* ******************************************************************** */
        !            37: 
        !            38: /* Utilities used by threading. */
        !            39: 
        !            40: /* A 'threaded tree' is, in our case, a fixed(*) parse tree with extra links
        !            41:    that are used by the interpreter to determine the execution order.
        !            42:    __________
        !            43:    (*) 'Fixed' means: processed by 'fix_nodes', which removes UNPARSED
        !            44:        nodes and distinguishes TAG nodes into local, global tags etc.
        !            45:        fix_nodes also creates the threads, but this is accidental, not
        !            46:        essential.  For UNPARSED nodes, the threads are actually laid
        !            47:        in a second pass through the subtree that was UNPARSED.
        !            48:    __________
        !            49: 
        !            50:    A small example: the parse tree for the expression  'a+b*c'  looks like
        !            51: 
        !            52:        (DYOP,
        !            53:                (TAGlocal, "a"),
        !            54:                "+",
        !            55:                (DYOP,
        !            56:                        (TAGlocal, "b"),
        !            57:                        "*",
        !            58:                        (TAGlocal, "c"))).
        !            59: 
        !            60:    The required execution order is here:
        !            61: 
        !            62:        1) (TAGlocal, "a")
        !            63:        2) (TAGlocal, "b")
        !            64:        3) (TAGlocal, "c")
        !            65:        4) (DYOP, ..., "*", ...)
        !            66:        5) (DYOP, ..., "+", ...)
        !            67: 
        !            68:    Of course, the result of each operation (if it has a result) is pushed
        !            69:    on a stack, and the operands are popped from this same stack.  Think of
        !            70:    reversed polish notation (well-known by owners of HP pocket calculators).
        !            71: 
        !            72:    The 'threads' are explicit links from each node to its successor in this
        !            73:    execution order.  Conditional operations like IF and AND have two threads,
        !            74:    one for success and one for failure.  Loops can be made by having the
        !            75:    thread from the last node of the loop body point to the head of the loop.
        !            76: 
        !            77:    Threading expressions, locations and simple-commands is easy: recursively
        !            78:    thread each of the subtrees, then lay a thread from the last threaded
        !            79:    to the current node.  Nodes occurring in a 'location' context are
        !            80:    marked, so that the interpreter knows when to push a 'location' on
        !            81:    the stack.
        !            82: 
        !            83:    Tests and looping commands cause most of the complexity of the threading
        !            84:    utilities.  The basic technique is 'backpatching'.
        !            85:    Nodes that need a conditional forward jump are chained together in a
        !            86:    linked list, and when their destination is reached, all nodes in the
        !            87:    chain get its 'address' patched into their secondary thread.  There is
        !            88:    one such chain, called 'bpchain', which at all times contains those nodes
        !            89:    whose secondary destination would be the next generated instruction.
        !            90:    This is used by IF, WHILE, test-suites, AND and OR.
        !            91: 
        !            92:    To generate a loop, both this chain and the last normal instruction
        !            93:    (if any) are diverted to the node where the loop continues.
        !            94: 
        !            95:    For test-suites, we also need to be capable of jumping unconditionally
        !            96:    forward (over the remainder of the SELECT-command).  This is done by
        !            97:    saving both the backpatch chain and the last node visited, and restoring
        !            98:    them after the remainder has been processed.
        !            99: */
        !           100: 
        !           101: /* Implementation tricks: in order not to show circular lists to 'release',
        !           102:    parse tree nodes are generated as compounds where there is room for two
        !           103:    more fields than their length indicates.
        !           104: */
        !           105: 
        !           106: #define Flag (MkSmallInt(1))
        !           107:        /* Flag used to indicate Location or TestRefinement node */
        !           108: 
        !           109: Hidden parsetree start; /* First instruction.  Picked up by endthreads() */
        !           110: 
        !           111: Hidden parsetree last; /* Last visited node */
        !           112: 
        !           113: Hidden parsetree bpchain; /* Backpatch chain for conditional goto's */
        !           114: Hidden parsetree *wanthere; /* Chain of requests to return next tree */
        !           115: 
        !           116: extern string opcodes[];
        !           117: 
        !           118: 
        !           119: /* Start threading */
        !           120: 
        !           121: Hidden Procedure inithreads() {
        !           122:        bpchain= NilTree;
        !           123:        wanthere= 0;
        !           124:        last= 0;
        !           125:        here(&start);
        !           126: }
        !           127: 
        !           128: /* Finish threading */
        !           129: 
        !           130: Hidden Procedure endthreads(code) parsetree *code; {
        !           131:        jumpto(Stop);
        !           132:        if (!still_ok) start= NilTree;
        !           133:        *code= start;
        !           134: }
        !           135: 
        !           136: 
        !           137: /* Fill 't' as secondary thread for all nodes in the backpatch chain,
        !           138:    leaving the chain empty. */
        !           139: 
        !           140: Hidden Procedure backpatch(t) parsetree t; {
        !           141:        parsetree u;
        !           142:        while (bpchain != NilTree) {
        !           143:                u= Thread2(bpchain);
        !           144:                Thread2(bpchain)= t;
        !           145:                bpchain= u;
        !           146:        }
        !           147: }
        !           148: 
        !           149: Visible Procedure jumpto(t) parsetree t; {
        !           150:        parsetree u;
        !           151:        if (!still_ok) return;
        !           152:        while (wanthere != 0) {
        !           153:                u= *wanthere;
        !           154:                *wanthere= t;
        !           155:                wanthere= (parsetree*)u;
        !           156:        }
        !           157:        while (last != NilTree) {
        !           158:                u= Thread(last);
        !           159:                Thread(last)= t;
        !           160:                last= u;
        !           161:        }
        !           162:        backpatch(t);
        !           163: }
        !           164: 
        !           165: Hidden parsetree seterr(n) int n; {
        !           166:        return (parsetree)MkSmallInt(n);
        !           167: }
        !           168: 
        !           169: /* Visit node 't', and set its secondary thread to 't2'. */
        !           170: 
        !           171: Hidden Procedure visit2(t, t2) parsetree t, t2; {
        !           172:        if (!still_ok) return;
        !           173:        jumpto(t);
        !           174:        Thread2(t)= t2;
        !           175: #ifdef DEBUG
        !           176:        fprintf(stderr, "\tvisit %s %s\n", opcodes[Nodetype(t)],
        !           177:                t2 == NilTree ? "" : "[*]");
        !           178: #endif DEBUG
        !           179:        Thread(t)= NilTree;
        !           180:        last= t;
        !           181: }
        !           182: 
        !           183: /* Visit node 't' */
        !           184: 
        !           185: Hidden Procedure visit(t) parsetree t; {
        !           186:        visit2(t, NilTree);
        !           187: }
        !           188: 
        !           189: /* Visit node 't' and flag it as a location (or test-refinement). */
        !           190: 
        !           191: Hidden Procedure lvisit(t) parsetree t; {
        !           192:        visit2(t, Flag);
        !           193: }
        !           194: 
        !           195: #ifdef NOT_USED
        !           196: Hidden Procedure jumphere(t) parsetree t; {
        !           197:        Thread(t)= last;
        !           198:        last= t;
        !           199: }
        !           200: #endif
        !           201: 
        !           202: /* Add node 't' to the backpatch chain. */
        !           203: 
        !           204: Hidden Procedure jump2here(t) parsetree t; {
        !           205:        if (!still_ok) return;
        !           206:        Thread2(t)= bpchain;
        !           207:        bpchain= t;
        !           208: }
        !           209: 
        !           210: Hidden Procedure here(pl) parsetree *pl; {
        !           211:        if (!still_ok) return;
        !           212:        *pl= (parsetree) wanthere;
        !           213:        wanthere= pl;
        !           214: }
        !           215: 
        !           216: Visible Procedure hold(pl) struct state *pl; {
        !           217:        if (!still_ok) return;
        !           218:        pl->h_last= last; pl->h_bpchain= bpchain; pl->h_wanthere= wanthere;
        !           219:        last= bpchain= NilTree; wanthere= 0;
        !           220: }
        !           221: 
        !           222: Visible Procedure let_go(pl) struct state *pl; {
        !           223:        parsetree p, *w;
        !           224:        if (!still_ok) return;
        !           225:        if (last) {
        !           226:                for (p= last; Thread(p) != NilTree; p= Thread(p))
        !           227:                        ;
        !           228:                Thread(p)= pl->h_last;
        !           229:        }
        !           230:        else last= pl->h_last;
        !           231:        if (bpchain) {
        !           232:                for (p= bpchain; Thread2(p) != NilTree; p= Thread2(p))
        !           233:                        ;
        !           234:                Thread2(p)= pl->h_bpchain;
        !           235:        }
        !           236:        else bpchain= pl->h_bpchain;
        !           237:        if (wanthere) {
        !           238:                for (w= wanthere; *w != 0; w= (parsetree*) *w)
        !           239:                        ;
        !           240:                *w= (parsetree) pl->h_wanthere;
        !           241:        }
        !           242:        else wanthere= pl->h_wanthere;
        !           243: }
        !           244: 
        !           245: Hidden bool reachable() {
        !           246:        return last != NilTree || bpchain != 0 || wanthere != 0;
        !           247: }
        !           248: 
        !           249: 
        !           250: /* ******************************************************************** */
        !           251: /* *********************** code generation **************************** */
        !           252: /* ******************************************************************** */
        !           253: 
        !           254: Forward bool is_variable();
        !           255: Forward bool is_cmd_ref();
        !           256: Forward value copydef();
        !           257: 
        !           258: Visible Procedure fix(pt, flag) parsetree *pt; char flag; {
        !           259:        struct state st; value v, function; parsetree t, l1= NilTree;
        !           260:        typenode nt; string s; char c; int n, k, len;
        !           261: 
        !           262:        t= *pt;
        !           263:        if (!Is_node(t) || !still_ok) return;
        !           264:        nt= Nodetype(t);
        !           265:        if (nt < 0 || nt >= NTYPES) syserr(MESS(2200, "fix bad tree"));
        !           266:        s= gentab[nt];
        !           267:        if (s == NULL) return;
        !           268:        n= First_fieldnr;
        !           269:        if (flag == 'x') curline= t;
        !           270:        while ((c= *s++) != '\0' && still_ok) {
        !           271:                switch (c) {
        !           272:                case '0':
        !           273:                case '1':
        !           274:                case '2':
        !           275:                case '3':
        !           276:                case '4':
        !           277:                case '5':
        !           278:                case '6':
        !           279:                case '7':
        !           280:                case '8':
        !           281:                case '9':
        !           282:                        n= (c - '0') + First_fieldnr;
        !           283:                        break;
        !           284:                case 'c':
        !           285:                        v= *Branch(t, n);
        !           286:                        if (v != Vnil) {
        !           287:                                len= Nfields(v);
        !           288:                                for (k= 0; k < len; ++k)
        !           289:                                        fix(Field(v, k), flag);
        !           290:                        }
        !           291:                        ++n;
        !           292:                        break;
        !           293:                case '#':
        !           294:                        curlino= *Branch(t, n);
        !           295:                        ++n;
        !           296:                        break;
        !           297:                case 'g':
        !           298:                case 'h':
        !           299:                        ++n;
        !           300:                        break;
        !           301:                case 'a':
        !           302:                case 'l':
        !           303:                        if (flag == 'v' || flag == 't')
        !           304:                                c= flag;
        !           305:                        /* Fall through */
        !           306:                case '!':
        !           307:                case 't':
        !           308:                case 'u':       
        !           309:                case 'v':
        !           310:                case 'x':
        !           311:                        fix(Branch(t, n), c);
        !           312:                        ++n;
        !           313:                        break;
        !           314:                case 'f':
        !           315:                        f_fpr_formals(*Branch(t, n));
        !           316:                        ++n;
        !           317:                        break;
        !           318: 
        !           319:                case '?':
        !           320:                        if (flag == 'v')
        !           321:                                f_eunparsed(pt);
        !           322:                        else if (flag == 't')
        !           323:                                f_cunparsed(pt);
        !           324:                        else
        !           325:                          syserr(MESS(2201, "fix unparsed with bad flag"));
        !           326:                        fix(pt, flag);
        !           327:                        break;
        !           328:                case 'C':
        !           329:                        v= *Branch(t, REL_LEFT);
        !           330:                        if (Comparison(Nodetype(v)))
        !           331:                                jump2here(v);
        !           332:                        break;
        !           333:                case 'D':
        !           334:                        v= (value)*Branch(t, DYA_NAME);
        !           335:                        if (!is_dyafun(v, &function))
        !           336:                          fixerr2(v, MESS(2202, " isn't a dyadic function"));
        !           337:                        else
        !           338:                                *Branch(t, DYA_FCT)= copydef(function);
        !           339:                        break;
        !           340:                case 'E':
        !           341:                        v= (value)*Branch(t, DYA_NAME);
        !           342:                        if (!is_dyaprd(v, &function))
        !           343:                          fixerr2(v, MESS(2203, " isn't a dyadic predicate"));
        !           344:                        else
        !           345:                                *Branch(t, DYA_FCT)= copydef(function);
        !           346:                        break;
        !           347:                case 'G':
        !           348:                        jumpto(l1);
        !           349:                        break;
        !           350:                case 'H':
        !           351:                        here(&l1);
        !           352:                        break;
        !           353:                case 'I':
        !           354:                        if (*Branch(t, n) == NilTree)
        !           355:                                break;
        !           356:                        /* Else fall through */
        !           357:                case 'J':
        !           358:                        jump2here(t);
        !           359:                        break;
        !           360:                case 'K':
        !           361:                        hold(&st);
        !           362:                        break;
        !           363:                case 'L':
        !           364:                        let_go(&st);
        !           365:                        break;
        !           366:                case 'M':
        !           367:                        v= (value)*Branch(t, MON_NAME);
        !           368:                        if (is_variable(v) || !is_monfun(v, &function))
        !           369:                          fixerr2(v, MESS(2204, " isn't a monadic function"));
        !           370:                        else
        !           371:                                *Branch(t, MON_FCT)= copydef(function);
        !           372:                        break;
        !           373:                case 'N':
        !           374:                        v= (value)*Branch(t, MON_NAME);
        !           375:                        if (is_variable(v) || !is_monprd(v, &function))
        !           376:                          fixerr2(v, MESS(2205, " isn't a monadic predicate"));
        !           377:                        else
        !           378:                                *Branch(t, MON_FCT)= copydef(function);
        !           379:                        break;
        !           380: #ifdef REACH
        !           381:                case 'R':
        !           382:                        if (*Branch(t, n) != NilTree && !reachable())
        !           383:                            fixerr(MESS(2206, "command cannot be reached"));
        !           384:                        break;
        !           385: #endif
        !           386:                case 'S':
        !           387:                        jumpto(Stop);
        !           388:                        break;
        !           389:                case 'T':
        !           390:                        if (flag == 't')
        !           391:                                f_ctag(pt);
        !           392:                        else if (flag == 'v' || flag == 'x')
        !           393:                                f_etag(pt);
        !           394:                        else
        !           395:                                f_ttag(pt);
        !           396:                        break;
        !           397:                case 'U':
        !           398:                        f_ucommand(pt);
        !           399:                        break;
        !           400:                case 'V':
        !           401:                        visit(t);
        !           402:                        break;
        !           403:                case 'X':
        !           404:                        if (flag == 'a' || flag == 'l' || flag == '!')
        !           405:                                lvisit(t);
        !           406:                        else
        !           407:                                visit(t);
        !           408:                        break;
        !           409:                case 'W':
        !           410: /*!*/                  visit2(t, seterr(1));
        !           411:                        break;
        !           412:                case 'Y':
        !           413:                        if (still_ok && reachable()) {
        !           414:                          if (nt == YIELD)
        !           415:                            fixerr(MESS(2207, "YIELD-unit returns no value"));
        !           416:                          else
        !           417:                            fixerr(MESS(2208, "TEST-unit reports no outcome"));
        !           418:                        }
        !           419:                        break;
        !           420:                case 'Z':
        !           421:                        if (!is_cmd_ref(t) && still_ok && reachable())
        !           422:   fixerr(MESS(2209, "refinement returns no value c.q. reports no outcome"));
        !           423:                        *Branch(t, REF_START)= copy(l1);
        !           424:                        break;
        !           425:                }
        !           426:        }
        !           427: }
        !           428: 
        !           429: /* ******************************************************************** */
        !           430: 
        !           431: Hidden bool is_cmd_ref(t) parsetree t; { /* HACK */
        !           432:        value name= *Branch(t, REF_NAME);
        !           433:        string s= strval(name);
        !           434:        /* return isupper(*s); */
        !           435:        return *s <= 'Z' && *s >= 'A';
        !           436: }
        !           437: 
        !           438: Visible value copydef(f) value f; {
        !           439:        funprd *fpr= Funprd(f);
        !           440:        if (fpr->pre == Use) return Vnil;
        !           441:        return copy(f);
        !           442: }
        !           443: 
        !           444: Hidden bool is_basic_target(v) value v; {
        !           445:        return envassoc(formals, v) ||
        !           446:                locals != Vnil && envassoc(locals, v) ||
        !           447:                envassoc(globals, v) ||
        !           448:                envassoc(mysteries, v);
        !           449: }
        !           450: 
        !           451: Hidden bool is_variable(v) value v; {
        !           452:        value f;
        !           453:        return is_basic_target(v) ||
        !           454:                envassoc(refinements, v) ||
        !           455:                is_zerfun(v, &f);
        !           456: }
        !           457: 
        !           458: Hidden bool is_target(p) parsetree p; {
        !           459:        value v= *Branch(p, First_fieldnr); int k, len;
        !           460:        switch (Nodetype(p)) {
        !           461: 
        !           462:        case TAG:
        !           463:                return is_basic_target(v);
        !           464: 
        !           465:        case SELECTION:
        !           466:        case BEHEAD:
        !           467:        case CURTAIL:
        !           468:        case COMPOUND:
        !           469:                return is_target(v);
        !           470: 
        !           471:        case COLLATERAL:
        !           472:                len= Nfields(v);
        !           473:                k_Overfields {
        !           474:                        if (!is_target(*Field(v, k))) return No;
        !           475:                }
        !           476:                return Yes;
        !           477: 
        !           478:        default:
        !           479:                return No;
        !           480: 
        !           481:        }
        !           482: }
        !           483: 
        !           484: /* ******************************************************************** */
        !           485: 
        !           486: Hidden Procedure f_actuals(formals, pactuals) parsetree formals, *pactuals; {
        !           487:        /* name, actual, next */
        !           488:        value actuals= *pactuals, act, form, next_a, next_f, kw, *pact;
        !           489:        kw= *Branch(actuals, ACT_KEYW);
        !           490:        pact= Branch(actuals, ACT_EXPR); act= *pact;
        !           491:        form= *Branch(formals, FML_TAG);
        !           492:        next_a= *Branch(actuals, ACT_NEXT); next_f= *Branch(formals, FML_NEXT);
        !           493:        if (compare(*Branch(formals, FML_KEYW), kw) != 0)
        !           494:                fixerr3(MESS(2210, "wrong keyword "), kw, 0);
        !           495:        else if (act == Vnil && form != Vnil)
        !           496:                fixerr3(MESS(2211, "missing actual after "), kw, 0);
        !           497:        else if (next_a == Vnil && next_f != Vnil)
        !           498:                fixerr3(MESS(2212, "can't find expected "),
        !           499:                        *Branch(next_f, FML_KEYW), 0);
        !           500:        else if (act != Vnil && form == Vnil)
        !           501:                fixerr3(MESS(2213, "unexpected actual after "), kw, 0);
        !           502:        else if (next_a != Vnil && next_f == Vnil)
        !           503:                fixerr3(MESS(2214, "unexpected keyword "),
        !           504:                        *Branch(next_a, ACT_KEYW), 0);
        !           505:        else {
        !           506:                if (act != Vnil) {
        !           507:                        parsetree st; struct state save;
        !           508:                        hold(&save); here(&st);
        !           509:                        if (is_target(act)) f_targ(pact);
        !           510:                        else f_expr(pact);
        !           511:                        jumpto(Stop); let_go(&save);
        !           512:                        *Branch(actuals, ACT_START)= copy(st);
        !           513:                }
        !           514:                if (still_ok && next_a != Vnil)
        !           515:                        f_actuals(next_f, Branch(actuals, ACT_NEXT));
        !           516:        }
        !           517: }
        !           518: 
        !           519: Hidden Procedure f_ucommand(pt) parsetree *pt; {
        !           520:        value t= *pt, *aa;
        !           521:        parsetree u, *f1= Branch(t, UCMD_NAME), *f2= Branch(t, UCMD_ACTUALS);
        !           522:        release(*Branch(t, UCMD_DEF));
        !           523:        *Branch(t, UCMD_DEF)= Vnil;
        !           524:        if ((aa= envassoc(refinements, *f1)) != Pnil) {
        !           525:                if (*Branch(*f2, ACT_EXPR) != Vnil
        !           526:                                || *Branch(*f2, ACT_NEXT) != Vnil)
        !           527:                        fixerr(MESS(2215, "refinement with parameters"));
        !           528:                else *Branch(t, UCMD_DEF)= copy(*aa);
        !           529:        }
        !           530:        else if (is_unit(*f1, How, &aa)) {
        !           531:                u= How_to(*aa)->unit;
        !           532:                f_actuals(*Branch(u, HOW_FORMALS), f2);
        !           533:        }
        !           534:        else if (still_ok)
        !           535:                fixerr3(MESS(2216, "you haven't told me HOW'TO "), *f1, 0);
        !           536: }
        !           537: 
        !           538: Hidden Procedure f_fpr_formals(t) parsetree t; {
        !           539:        switch (Nodetype(t)) {
        !           540:        case TAG:
        !           541:                break;
        !           542:        case MONF: case MONPRD:
        !           543:                f_targ(Branch(t, MON_RIGHT));
        !           544:                break;
        !           545:        case DYAF: case DYAPRD:
        !           546:                f_targ(Branch(t, DYA_LEFT));
        !           547:                f_targ(Branch(t, DYA_RIGHT));
        !           548:                break;
        !           549:        default:
        !           550:                syserr(MESS(2217, "f_fpr_formals"));
        !           551:        }
        !           552: }
        !           553: 
        !           554: Visible bool modify_tag(name, tag) parsetree *tag; value name; {
        !           555:        value *aa, function;
        !           556:        *tag= NilTree;
        !           557:        if (aa= envassoc(formals, name))
        !           558:                *tag= node3(TAGformal, name, copy(*aa));
        !           559:        else if (locals != Vnil && (aa= envassoc(locals, name)))
        !           560:                *tag= node3(TAGlocal, name, copy(*aa));
        !           561:        else if (aa= envassoc(globals, name))
        !           562:                *tag= node2(TAGglobal, name);
        !           563:        else if (aa= envassoc(mysteries, name))
        !           564:                *tag= node3(TAGmystery, name, copy(*aa));
        !           565:        else if (aa= envassoc(refinements, name))
        !           566:                *tag= node3(TAGrefinement, name, copy(*aa));
        !           567:        else if (is_zerfun(name, &function))
        !           568:                *tag= node3(TAGzerfun, name, copydef(function));
        !           569:        else if (is_zerprd(name, &function))
        !           570:                *tag= node3(TAGzerprd, name, copydef(function));
        !           571:        else return No;
        !           572:        return Yes;
        !           573: }
        !           574: 
        !           575: Hidden Procedure f_etag(pt) parsetree *pt; {
        !           576:        parsetree t= *pt; value name= copy(*Branch(t, TAG_NAME));
        !           577:        if (modify_tag(name, &t)) {
        !           578:                release(*pt);
        !           579:                *pt= t;
        !           580:                if (Nodetype(t) == TAGzerprd)
        !           581:                        fixerr2(name, MESS(2218, " cannot be used in an expression"));
        !           582:                else
        !           583:                        visit(t);
        !           584:        } else {
        !           585:                fixerr2(name, MESS(2219, " has not yet received a value"));
        !           586:                release(name);
        !           587:        }
        !           588: }
        !           589: 
        !           590: Hidden Procedure f_ttag(pt) parsetree *pt; {
        !           591:        parsetree t= *pt; value name= copy(*Branch(t, TAG_NAME));
        !           592:        if (modify_tag(name, &t)) {
        !           593:                release(*pt);
        !           594:                *pt= t;
        !           595:                switch (Nodetype(t)) {
        !           596:                case TAGrefinement:
        !           597:                        fixerr(MESS(2220, "a refinement may not be used as a target"));
        !           598:                        break;
        !           599:                case TAGzerfun:
        !           600:                case TAGzerprd:
        !           601:                        fixerr2(name, MESS(2221, " hasn't been initialised or defined"));
        !           602:                        break;
        !           603:                default:
        !           604:                        lvisit(t);
        !           605:                        break;
        !           606:                }
        !           607:        } else {
        !           608:                fixerr2(name, MESS(2222, " hasn't been initialised or defined"));
        !           609:                release(name);
        !           610:        }
        !           611: }
        !           612: 
        !           613: Hidden Procedure f_ctag(pt) parsetree *pt; {
        !           614:        parsetree t= *pt; value name= copy(*Branch(t, TAG_NAME));
        !           615:        if (modify_tag(name, &t)) {
        !           616:                release(*pt);
        !           617:                *pt= t;
        !           618:                switch (Nodetype(t)) {
        !           619:                case TAGrefinement:
        !           620:                        lvisit(t); /* 'Loc' flag here means 'Test' */
        !           621:                        break;
        !           622:                case TAGzerprd:
        !           623:                        visit(t);
        !           624:                        break;
        !           625:                default:
        !           626:                        fixerr2(name, MESS(2223, " is neither a refined test nor a zeroadic predicate"));
        !           627:                        break;
        !           628:                }
        !           629:        } else {
        !           630:                fixerr2(name, MESS(2224, " is neither a refined test nor a zeroadic predicate"));
        !           631:                release(name);
        !           632:        }
        !           633: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.