Return to b3sta.c CVS log

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

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

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
        !             2: 
        !             3: /*
        !             4:   $Header: b3sta.c,v 1.4 85/08/22 16:59:30 timo Exp $
        !             5: */
        !             6: 
        !             7: /* Stacks used by the interpreter */
        !             8: 
        !             9: /* Scratch-pad copying.
        !            10: 
        !            11:    One of the hairiest details of B is scratch-pad copying and its
        !            12:    interaction with formal parameters (to HOW'TO units).
        !            13:    Via formal parameters one can peek and poke into the local environment
        !            14:    of the HOW'TO's in the call chain.  When a parameter is changed from
        !            15:    within an expression- or test-refinement, the scratch-pad copying
        !            16:    prescribes that the whole chain of local environments is restored
        !            17:    to its original state when the refinement exits.  Example:
        !            18: 
        !            19:     >>> HOW'TO X fp:
        !            20:            WRITE fp, ref, fp /
        !            21:        ref:
        !            22:            PUT fp+1 IN fp
        !            23:            RETURN fp
        !            24:     >>> HOW'TO Y fp:
        !            25:            X fp
        !            26:     >>> HOW'TO Z:
        !            27:            PUT 1 IN t
        !            28:            Y t
        !            29:            WRITE t
        !            30:     >>> Z
        !            31:     1 2 1
        !            32:     1
        !            33: 
        !            34:    It is clear that the scratch-pad copying for the call of ref in X
        !            35:    must save the local environments of Y and Z, and restore them when
        !            36:    ref exits.
        !            37:    For similar reasons we must save the permanent environment.
        !            38:    All this also interacts with the practice of 'locating' a target.
        !            39:    All targets eventually refer to (one or more) basic targets.
        !            40:    The location of a basic target is represented as a pair (env, key)
        !            41:    where 'env' is the address of the environment in which the target
        !            42:    resides and 'key' is the target's name (for permanent targets) or
        !            43:    its number (for local targets).  When we consider the PUT fp+1 IN fp
        !            44:    line in unit X above, we can see that the (local) environment
        !            45:    for the location returned by 'fp' is the local environment of Z.
        !            46:    Therefore this whole chain must still be intact.
        !            47:    There can be even trickier cases, where a location is saved for a
        !            48:    long time on the execution stack while the environment it refers to
        !            49:    is subject to scratch-pad copying and restoring; when the location
        !            50:    is finally popped off the stack, it must still refer to the correct
        !            51:    environment.
        !            52: 
        !            53:    Another detail to consider is that for the permanent environment,
        !            54:    we need access to the 'real' permanent environment, i.e., its value
        !            55:    before any scratch-pad copying occurred.  (Example:
        !            56: 
        !            57:     >>> YIELD f:
        !            58:            SHARE x
        !            59:            PUT x+1 IN x
        !            60:            READ t EG 0
        !            61:            RETURN t
        !            62:     >>> PUT 0 IN x
        !            63:     >>> WRITE x, f, x
        !            64:     ??? x
        !            65:     0, 0, 0
        !            66:     >>> 
        !            67: 
        !            68:    Even though at the time the READ is called, x has been given the value
        !            69:    1 temporarily, the value of x used in the evaluation of the input
        !            70:    expression is the original value, 0.)
        !            71: 
        !            72:    A final detail to be observed is the passing back of 'bound tags'
        !            73:    when a refined test is called.
        !            74: 
        !            75:    The chosen implementation is as follows:
        !            76:    - Environments are saved in a linked list of structures (envchain) with
        !            77:      two fields: tab, the actual environment (a table or compound) and
        !            78:      inv_env, the link to the previous entry in the list.
        !            79:    - The routines newenvchain and popenvchain push and pop such lists.
        !            80:    - There is one list for the permanent environment, whose head is prmnv,
        !            81:      and one list for the current environment, whose head is usually curnv.
        !            82:      The last element of both lists is actually the same, because at the
        !            83:      immediate command level the current environment is the permanent
        !            84:      environment.  When we are evaluating or locating a formal parameter,
        !            85:      'curnv' points somewhere in the middle of its chain, to the local
        !            86:      environment of the caller.
        !            87:      The two lists are manipulated separately:
        !            88:    - Prmnv is pushed (with a copy of itself) for each scratch-pad copy,
        !            89:      and popped whe a scratch-pad is thrown away.
        !            90:    - Curnv is pushed for each unit invocation, with the new local
        !            91:      environment, and popped when the unit exits.
        !            92:    - When a scratch-pad copy is required, the chain headed by curnv
        !            93:      is walked until a local environment is found without HOW'TO formal
        !            94:      parameters, and a compound containing copies of all the local
        !            95:      environments thus found is saved on the general-purpose value stack.
        !            96:      This value is popped off that stack again and the local environments
        !            97:      in the chain are restored when the scratch-pad copy has to be thrown
        !            98:      away.  (Thus we work on the real thing and save and restore a copy
        !            99:      of it, while the DP prescribes that the system work on a copy.
        !           100:      The effect is the same, of course.)
        !           101:    - There is a third list for bound tags whose treatment is left as an
        !           102:      exercise for the reader.
        !           103:    - When a formal parameter is called, the current value of 'curnv' must
        !           104:      be saved somewhere, so that it can be restored later; in this case
        !           105:      it doesn't follow the stack-wise discipline of the chain.
        !           106:    - Finally note thate that when a YIELD unit is called during the
        !           107:      evaluation of a formal parameter, the chain of local environments
        !           108:      "splices" temorarily, because the new local environment is linked
        !           109:      to curnv which is not the end of the chain.  No problem!
        !           110: 
        !           111:    All this nonsense can be avoided when a copy-restore parameter mechanism
        !           112:    is used instead: then there are no accesses to other local environments
        !           113:    that the current, except a transfer between two "adjacent" ones at call
        !           114:    and return time.  Maybe ABC will have such a parameter mechanism...
        !           115: 
        !           116: */
        !           117: 
        !           118: #include "b.h"
        !           119: #include "b1mem.h"
        !           120: #include "b1obj.h"
        !           121: #include "b2nod.h"
        !           122: #include "b3env.h"
        !           123: #include "b3err.h"
        !           124: #include "b3int.h"
        !           125: #include "b3sem.h"
        !           126: #include "b3sou.h" /* for permkey() and get_pname() */
        !           127: #include "b3sta.h"
        !           128: 
        !           129: /* Fundamental registers: (shared only between this file and b3int.c) */
        !           130: 
        !           131: Visible parsetree pc; /* 'Program counter', current parsetree node */
        !           132: Visible parsetree next; /* Next parsetree node (changed by jumps) */
        !           133: Visible bool report; /* 'Condition code register', outcome of last test */
        !           134: 
        !           135: Visible bool noloc; /* Set while evaluating (as opposed to locating)
        !           136:                        formal parameters of HOW'TOs */
        !           137: 
        !           138: Hidden env boundtags; /* Holds bound tags chain */
        !           139: 
        !           140: /* Value stack: */
        !           141: 
        !           142: /* The run-time value stack grows upward, sp points to the next free entry.
        !           143:    Allocated stack space lies between st_base and st_top.
        !           144:    In the current invocation, the stack pointer (sp) must lie between
        !           145:    st_bottom and st_top.
        !           146:    Stack overflow is corrected by growing st_top, underflow is a fatal
        !           147:    error (generated code is wrong).
        !           148: */
        !           149: 
        !           150: Hidden value *st_base, *st_bottom, *st_top, *sp;
        !           151: Visible int call_level; /* While run() can be called recursively */
        !           152: 
        !           153: #define EmptyStack() (sp == st_bottom)
        !           154: #define BotOffset() (st_bottom - st_base)
        !           155: #define SetBotOffset(n) (st_bottom= st_base + (n))
        !           156: 
        !           157: #define INCREMENT 100
        !           158: 
        !           159: Hidden Procedure st_grow(incr) int incr; {
        !           160:        if (!st_base) { /* First time ever */
        !           161:                st_bottom= sp= st_base=
        !           162:                        (value*) getmem((unsigned) incr * sizeof(value *));
        !           163:                st_top= st_base + incr;
        !           164:        }
        !           165:        else {
        !           166:                int syze= (st_top - st_base) + incr;
        !           167:                int n_bottom= BotOffset();
        !           168:                int n_sp= sp - st_base;
        !           169:                regetmem((ptr*) &st_base, (unsigned) syze * sizeof(value *));
        !           170:                sp = st_base + n_sp;
        !           171:                SetBotOffset(n_bottom);
        !           172:                st_top= st_base + syze;
        !           173:        }
        !           174: }
        !           175: 
        !           176: Visible value pop() {
        !           177:        if (sp <= st_bottom) {
        !           178:                syserr(MESS(4100, "stack underflow"));
        !           179:                return Vnil;
        !           180:        }
        !           181:        return *--sp;
        !           182: }
        !           183: 
        !           184: Visible Procedure push(v) value v; {
        !           185:        if (sp >= st_top) st_grow(INCREMENT);
        !           186:        *sp++ = (v);
        !           187: }
        !           188: 
        !           189: /* - - - */
        !           190: 
        !           191: /* Various call types, used as index in array: */
        !           192: 
        !           193: #define C_prmnv 0
        !           194: #define C_immexp 1
        !           195: #define C_immcmd 2
        !           196: #define C_read 3
        !           197: 
        !           198: #define C_howto 4
        !           199: #define C_yield 5
        !           200: #define C_test 6
        !           201: 
        !           202: #define C_refcmd 7
        !           203: #define C_refexp 8
        !           204: #define C_reftest 9
        !           205: 
        !           206: #define C_formal 10
        !           207: 
        !           208: 
        !           209: /* What can happen to a thing: */
        !           210: 
        !           211: #define Old 'o'
        !           212: #define Cpy 'c'
        !           213: #define New 'n'
        !           214: #define Non '-'
        !           215: 
        !           216: typedef struct {
        !           217:        literal do_cur;
        !           218:        literal do_prm;
        !           219:        literal do_bnd;
        !           220:        literal do_for;
        !           221:        literal do_cntxt;
        !           222:        literal do_resexp;
        !           223: } dorecord;
        !           224: 
        !           225: 
        !           226: /* Table encoding what to save/restore for various call/return types: */
        !           227: /* (Special cases are handled elsewhere.) */
        !           228: 
        !           229: Hidden dorecord doo[] = {
        !           230:        /*               cur  prm  bnd  for  cntxt    resexp */
        !           231: 
        !           232:        /* prmnv */     {Old, Old, Old, Old, In_prmnv, Voi},
        !           233:        /* imm expr */  {Old, Old, Old, Old, In_command, Voi},
        !           234:        /* imm cmd */   {Old, Old, Old, Old, In_command, Voi},
        !           235:        /* READ EG */   {Non, Non, Non, Non, In_read, Voi},
        !           236: 
        !           237:        /* HOW-TO */    {New, Old, Non, New, In_unit, Voi},
        !           238:        /* YIELD */     {New, Cpy, Non, Non, In_unit, Ret},
        !           239:        /* TEST */      {New, Cpy, Non, Non, In_unit, Rep},
        !           240: 
        !           241:        /* REF-CMD */   {Old, Old, Old, Old, In_unit, Voi},
        !           242:        /* ref-expr */  {Cpy, Cpy, Non, Old, In_unit, Ret},
        !           243:        /* ref-test */  {Cpy, Cpy, New, Old, In_unit, Rep},
        !           244: 
        !           245:        /* formal */    {Non, Old, Non, Non, In_formal, Voi},
        !           246: };
        !           247: 
        !           248: #define MAXTYPE ((sizeof doo) / (sizeof doo[0]))
        !           249: 
        !           250: #define Checksum(type) (12345 - (type)) /* Reversible */
        !           251: 
        !           252: 
        !           253: #define Ipush(n) push(MkSmallInt(n))
        !           254: #define Ipop() SmallIntVal(pop())
        !           255: 
        !           256: 
        !           257: Hidden env newenv(tab, inv_env) envtab tab; env inv_env; {
        !           258:        env e= (env) getmem(sizeof(envchain));
        !           259:        e->tab= tab; /* Eats a reference to tab! */
        !           260:        e->inv_env= inv_env;
        !           261:        return e;
        !           262: }
        !           263: 
        !           264: 
        !           265: Hidden Procedure popenv(pe) env *pe; {
        !           266:        env e= *pe;
        !           267:        *pe= e->inv_env;
        !           268:        release(e->tab);
        !           269:        freemem((ptr) e);
        !           270: }
        !           271: 
        !           272: 
        !           273: Forward value save_curnv_chain();
        !           274: 
        !           275: Hidden Procedure call(type, new_pc) intlet type; parsetree new_pc; {
        !           276:        if (type < 0 || type >= MAXTYPE) syserr(MESS(4101, "bad call type"));
        !           277:        if (tracing) tr_call();
        !           278: 
        !           279:        /* Push other stacks */
        !           280: 
        !           281:        if (doo[type].do_bnd != Old) {
        !           282:                boundtags= newenv(
        !           283:                        (doo[type].do_bnd == New) ? mk_elt() : Vnil,
        !           284:                        boundtags);
        !           285:                bndtgs= &boundtags->tab;
        !           286:        }
        !           287:        switch (doo[type].do_cur) {
        !           288: 
        !           289:        case New:
        !           290:                curnv= newenv(Vnil, curnv);
        !           291:                break;
        !           292: 
        !           293:        case Cpy:
        !           294:                push(save_curnv_chain());
        !           295:                break;
        !           296: 
        !           297:        case Non:
        !           298:                push(mk_int((double) ((int) curnv)));
        !           299:                        /* PORTABILITY?!?! */
        !           300:                break;
        !           301: 
        !           302:        }
        !           303:        if (doo[type].do_prm != Old) {
        !           304:                prmnv= newenv(
        !           305:                        (doo[type].do_prm == Cpy) ? copy(prmnv->tab) : Vnil,
        !           306:                        prmnv);
        !           307:        }
        !           308: 
        !           309:        /* Push those things that depend on the call type: */
        !           310: 
        !           311:        if (doo[type].do_for != Old) {
        !           312:                /* Formal parameter context and unit name/type */
        !           313:                /* FP removed */
        !           314:                push(uname); uname= Vnil;
        !           315:        }
        !           316: 
        !           317:        /* Push miscellaneous context info: */
        !           318:        push(curline);
        !           319:        push(curlino);
        !           320:        Ipush(noloc); noloc= No;
        !           321:        Ipush(resexp); resexp= doo[type].do_resexp;
        !           322:        Ipush(cntxt); cntxt= doo[type].do_cntxt;
        !           323:        resval= Vnil;
        !           324: 
        !           325:        /* Push vital data: */
        !           326:        push(next);
        !           327:        Ipush(BotOffset()); ++call_level;
        !           328:        Ipush(Checksum(type)); /* Kind of checksum */
        !           329: 
        !           330:        /* Set st_bottom and jump: */
        !           331:        st_bottom= sp;
        !           332:        next= new_pc;
        !           333: }
        !           334: 
        !           335: 
        !           336: Visible Procedure ret() {
        !           337:        int type; value rv= resval; literal re= resexp;
        !           338:        value oldcurnvtab= Vnil, oldbtl= Vnil;
        !           339: 
        !           340:        if (tracing) tr_ret();
        !           341:        if (cntxt == In_formal && still_ok) { rv= pop(); re= Ret; }
        !           342: 
        !           343:        /* Clear stack: */
        !           344:        while (!EmptyStack()) release(pop());
        !           345: 
        !           346:        /* Pop type and hope it's good: */
        !           347:        st_bottom= st_base; /* Trick to allow popping the return info */
        !           348:        type= Checksum(Ipop());
        !           349:        if (type < 0 || type >= MAXTYPE) syserr(MESS(4102, "stack clobbered"));
        !           350: 
        !           351:        /* Pop vital data: */
        !           352:        SetBotOffset(Ipop()); --call_level;
        !           353:        next= pop();
        !           354: 
        !           355:        /* Pop context info: */
        !           356:        cntxt= Ipop();
        !           357:        resexp= Ipop();
        !           358:        noloc= Ipop();
        !           359:        curlino= pop();
        !           360:        curline= pop();
        !           361: 
        !           362:        /* Variable part: */
        !           363:        if (doo[type].do_for != Old) {
        !           364:                release(uname); uname= pop();
        !           365:                /* FP removed */
        !           366:        }
        !           367:        if (doo[type].do_prm != Old)
        !           368:                popenv(&prmnv);
        !           369:        switch (doo[type].do_cur) {
        !           370: 
        !           371:        case Cpy:
        !           372:                oldcurnvtab= copy(curnv->tab);
        !           373:                rest_curnv_chain(pop());
        !           374:                break;
        !           375: 
        !           376:        case New:
        !           377:                oldcurnvtab= copy(curnv->tab);
        !           378:                popenv(&curnv);
        !           379:                break;
        !           380: 
        !           381:        case Non:
        !           382:                { value v= pop();
        !           383:                  curnv= (env) intval(v);
        !           384:                 release(v);
        !           385:                }
        !           386:                break;
        !           387: 
        !           388:        }
        !           389:        if (doo[type].do_bnd != Old) {
        !           390:                oldbtl= copy(*bndtgs);
        !           391:                popenv(&boundtags);
        !           392:                bndtgs= &boundtags->tab;
        !           393:        }
        !           394: 
        !           395:        /* Fiddle bound tags */
        !           396:        if (oldbtl != Vnil) {
        !           397:                extbnd_tags(oldbtl, oldcurnvtab);
        !           398:                release(oldbtl);
        !           399:        }
        !           400:        if (oldcurnvtab != Vnil) release(oldcurnvtab);
        !           401:        if (call_level == 0) re_env(); /* Resets bndtgs */
        !           402: 
        !           403:        /* Push return value (if any): */
        !           404:        if (re == Ret && still_ok) push(rv);
        !           405: }
        !           406: 
        !           407: /* - - - */
        !           408: 
        !           409: Visible Procedure call_formal(name, number, targ)
        !           410:  value name, number; bool targ; {
        !           411:        value *aa= envassoc(curnv->tab, number); formal *ff= Formal(*aa);
        !           412:        literal ct;
        !           413:        if (aa == Pnil || !Is_formal(*aa)) syserr(MESS(4103, "formal gone"));
        !           414:        if (cntxt != In_formal) {
        !           415:                release(how_context.uname);
        !           416:                sv_context(&how_context); /* for error messages */
        !           417:        }
        !           418:        call(C_formal, ff->fp);
        !           419: 
        !           420:        /* The following should be different, but for now... */
        !           421:        curnv= ff->con.curnv;
        !           422:        release(uname); uname= copy(ff->con.uname);
        !           423:        curline= ff->con.cur_line; curlino= ff->con.cur_lino;
        !           424:        ct= cntxt; cntxt= ff->con.cntxt;
        !           425:        release(act_context.uname);
        !           426:        sv_context(&act_context); cntxt= ct; /* for error messages */
        !           427: 
        !           428:        if (!targ) noloc= Yes;
        !           429:        else if (!Thread2(next)) error(MESS(4104, "expression used as target"));
        !           430: }
        !           431: 
        !           432: Visible Procedure call_refinement(name, def, test)
        !           433:  value name; parsetree def; bool test; {
        !           434:        call(test ? C_reftest : C_refexp,
        !           435:                *Branch(Refinement(def)->rp, REF_START));
        !           436: }
        !           437: 
        !           438: #define YOU_TEST MESS(4105, "You haven't told me how to TEST ")
        !           439: #define YOU_YIELD MESS(4106, "You haven't told me how to YIELD ")
        !           440: 
        !           441: Hidden Procedure udfpr(nd1, name, nd2, isfunc)
        !           442:  value nd1, name, nd2; bool isfunc; {
        !           443:        value *aa;
        !           444:        parsetree u; int k, nlocals; funprd *fpr;
        !           445:        int adicity= nd1 ? Dya : nd2 ? Mon : Zer;
        !           446:        if (!is_unit(name, adicity, &aa)
        !           447:                || !(isfunc ? Is_function(*aa) : Is_predicate(*aa))) {
        !           448:                error3(isfunc ? YOU_YIELD : YOU_TEST, name, 0);
        !           449:                return;
        !           450:        }
        !           451:        fpr= Funprd(*aa);
        !           452:        if (!(fpr->adic==Zer ? nd2==Vnil : (fpr->adic==Mon) == (nd1==Vnil)))
        !           453:                syserr(MESS(4107, "invoked unit has other adicity than invoker"));
        !           454:        if (fpr->pre != Use) syserr(MESS(4108, "udfpr with predefined unit"));
        !           455: 
        !           456:        u= fpr->unit;
        !           457:        if (fpr->unparsed) fix_nodes(&u, &fpr->code);
        !           458:        if (!still_ok) { rem_unit(u); return; }
        !           459:        fpr->unparsed= No;
        !           460:        nlocals= intval(*Branch(u, FPR_NLOCALS));
        !           461:        call(isfunc ? C_yield : C_test, fpr->code);
        !           462:        curnv->tab= mk_compound(nlocals);
        !           463:        for (k= 0; k < nlocals; ++k) *Field(curnv->tab, k)= Vnil;
        !           464:        release(uname); uname= get_pname(u);
        !           465:        if (nd1 != Vnil) push(copy(nd1));
        !           466:        if (nd2 != Vnil) push(copy(nd2));
        !           467: }
        !           468: 
        !           469: Visible Procedure formula(nd1, name, nd2, tor) value nd1, name, nd2, tor; {
        !           470:        if (tor == Vnil) udfpr(nd1, name, nd2, Yes);
        !           471:        else {
        !           472:                if (!Is_function(tor))
        !           473:                        syserr(MESS(4109, "formula called with non-function"));
        !           474:                push(pre_fun(nd1, Funprd(tor)->pre, nd2));
        !           475:        }
        !           476: }
        !           477: 
        !           478: Visible Procedure proposition(nd1, name, nd2, pred) value nd1, name, nd2, pred; {
        !           479:        if (pred == Vnil) udfpr(nd1, name, nd2, No);
        !           480:        else {
        !           481:                if (!Is_predicate(pred))
        !           482:                        syserr(MESS(4110, "proposition called with non-predicate"));
        !           483:                report= pre_prop(nd1, Funprd(pred)->pre, nd2);
        !           484:        }
        !           485: }
        !           486: 
        !           487: Visible Procedure v_mystery(name, number) value name, number; {
        !           488:        value *aa; fun f;
        !           489:        aa= envassoc(curnv->tab, Is_compound(curnv->tab) ? number : name);
        !           490:        if (aa != Pnil) push(copy(*aa));
        !           491:        else if (is_zerfun(name, &f)) {
        !           492:                if (Funprd(f)->pre == Use) f= Vnil;
        !           493:                formula(Vnil, name, Vnil, f);
        !           494:        }
        !           495:        else error3(0, name, MESS(4111, " has not yet received a value"));
        !           496: }
        !           497: 
        !           498: Hidden value mk_formal(pt) parsetree pt; {
        !           499:        value f= grab_for(); formal *ff= Formal(f);
        !           500:        sv_context(&ff->con); ff->fp= pt;
        !           501:        return f;
        !           502: }
        !           503: 
        !           504: Visible Procedure x_user_command(name, actuals, def)
        !           505:  value name; parsetree actuals; value def;
        !           506: {
        !           507:        how *h; parsetree u; value *aa;
        !           508:        value v, formals; int k, len;
        !           509:        if (def != Vnil) {
        !           510:                if (!Is_refinement(def)) syserr(MESS(4112, "bad def in x_user_command"));
        !           511:                call(C_refcmd, *Branch(Refinement(def)->rp, REF_START));
        !           512:                return;
        !           513:        }
        !           514:        if (!is_unit(name, How, &aa)) {
        !           515:                error3(MESS(4113, "You haven't told me HOW'TO "), name, 0);
        !           516:                return;
        !           517:        }
        !           518:        u= (h= How_to(*aa))->unit;
        !           519:        if (h->unparsed) fix_nodes(&u, &h->code);
        !           520:        if (!still_ok) { rem_unit(u); return; }
        !           521:        h->unparsed= No;
        !           522:        formals= *Branch(u, HOW_FORMALS);
        !           523:        len= intval(*Branch(u, HOW_NLOCALS)); k= 0;
        !           524:        v= mk_compound(len);
        !           525:        while (actuals != Vnil && formals != Vnil) { /* Save actuals */
        !           526:                if (*Branch(actuals, ACT_EXPR) != Vnil) {
        !           527:                        if (k >= len) syserr(MESS(4114, "too many actuals"));
        !           528:                        *Field(v, k++)= mk_formal(*Branch(actuals, ACT_START));
        !           529:                }
        !           530:                actuals= *Branch(actuals, ACT_NEXT);
        !           531:                formals= *Branch(formals, FML_NEXT);
        !           532:        }
        !           533:        for (; k < len; ++k) { *Field(v, k)= Vnil; }
        !           534: 
        !           535:        call(C_howto, h->code);
        !           536:        
        !           537:        curnv->tab= v;
        !           538:        release(uname); uname= permkey(name, How);
        !           539: }
        !           540: 
        !           541: Visible Procedure endsta() {
        !           542:        if (st_base) {
        !           543:                freemem((ptr) st_base);
        !           544:                st_base= Pnil;          
        !           545:        }
        !           546: }
        !           547: 
        !           548: Hidden value save_curnv_chain() {
        !           549:        value pad;
        !           550:        value c, f;
        !           551:        formal *ff;
        !           552:        int cnt, k;
        !           553: 
        !           554:        /* Count how many */
        !           555:        c= curnv->tab;
        !           556:        for (cnt= 0; ; ) {
        !           557:                if (!Is_compound(c)) break;
        !           558:                ++cnt;
        !           559:                f= *Field(c, 0);
        !           560:                if (!Is_formal(f)) break;
        !           561:                ff= Formal(f);
        !           562:                c= ff->con.curnv->tab;
        !           563:        }
        !           564: 
        !           565:        pad= mk_compound(cnt);
        !           566: 
        !           567:        /* Do the copy */
        !           568:        c= curnv->tab;
        !           569:        for (k= 0; ; ) {
        !           570:                if (!Is_compound(c)) break;
        !           571:                *Field(pad, k)= copy(c);
        !           572:                if (++k >= cnt) break;
        !           573:                f= *Field(c, 0);
        !           574:                if (!Is_formal(f)) break;
        !           575:                ff= Formal(f);
        !           576:                c= ff->con.curnv->tab;
        !           577:        }
        !           578:        if (k != cnt)
        !           579:                syserr(MESS(4115, "save_curnv_chain: phase error"));
        !           580: 
        !           581:        return pad;
        !           582: }
        !           583: 
        !           584: Hidden rest_curnv_chain(pad) value pad; {
        !           585:        int k, cnt;
        !           586:        value f, *c= &curnv->tab;
        !           587:        formal *ff;
        !           588: 
        !           589:        if (pad == Vnil || !Is_compound(pad))
        !           590:                syserr(MESS(4116, "rest_curnv_chain: bad pad"));
        !           591:        cnt= Nfields(pad);
        !           592:        for (k= 0; ; ) {
        !           593:                if (!Is_compound(*c)) break;
        !           594:                release(*c);
        !           595:                *c= copy(*Field(pad, k));
        !           596:                if (++k >= cnt) break;
        !           597:                f= *Field(*c, 0);
        !           598:                if (!Is_formal(f)) break;
        !           599:                ff= Formal(f);
        !           600:                c= &ff->con.curnv->tab;
        !           601:        }
        !           602:        if (k != cnt)
        !           603:                syserr(MESS(4117, "rest_curnv_chain: phase error"));
        !           604:        release(pad);
        !           605: }

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