1: /*
    2:  * code.c - compiled code builder/handler
    3:  *
    4:  *   Copyright (c) 2005-2007  Shiro Kawai  <shiro@acm.org>
    5:  * 
    6:  *   Redistribution and use in source and binary forms, with or without
    7:  *   modification, are permitted provided that the following conditions
    8:  *   are met:
    9:  * 
   10:  *   1. Redistributions of source code must retain the above copyright
   11:  *      notice, this list of conditions and the following disclaimer.
   12:  *
   13:  *   2. Redistributions in binary form must reproduce the above copyright
   14:  *      notice, this list of conditions and the following disclaimer in the
   15:  *      documentation and/or other materials provided with the distribution.
   16:  *
   17:  *   3. Neither the name of the authors nor the names of its contributors
   18:  *      may be used to endorse or promote products derived from this
   19:  *      software without specific prior written permission.
   20:  *
   21:  *   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22:  *   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23:  *   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
   24:  *   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
   25:  *   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
   26:  *   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
   27:  *   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
   28:  *   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
   29:  *   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
   30:  *   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
   31:  *   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
   32:  *
   33:  *  $Id: code.c,v 1.18 2007/08/24 23:55:42 shirok Exp $
   34:  */
   35: 
   36: #define LIBGAUCHE_BODY
   37: #include "gauche.h"
   38: #include "gauche/class.h"
   39: #include "gauche/code.h"
   40: #include "gauche/vminsn.h"
   41: #include "gauche/builtin-syms.h"
   42: 
   43: /*===============================================================
   44:  * NVM related stuff
   45:  */
   46: 
   47: /* Debug information:
   48:  *
   49:  *  debug info is kept as an assoc-list with insn offset
   50:  *  as a key.
   51:  */
   52: 
   53: ScmObj Scm_CompiledCodeFullName(ScmCompiledCode *cc)
   54: {
   55:     if (SCM_COMPILED_CODE_P(cc->parent)
   56:         && !SCM_EQ(SCM_COMPILED_CODE(cc->parent)->name, SCM_SYM_TOPLEVEL)) {
   57:         ScmObj h = SCM_NIL, t = SCM_NIL;
   58:         for (;;) {
   59:             SCM_APPEND1(h, t, cc->name);
   60:             if (!SCM_COMPILED_CODE_P(cc->parent)) break;
   61:             cc = SCM_COMPILED_CODE(cc->parent);
   62:             if (SCM_EQ(cc->name, SCM_SYM_TOPLEVEL)) break;
   63:         }
   64:         return Scm_ReverseX(h);
   65:     } else {
   66:         return cc->name;
   67:     }
   68: }
   69: 
   70: static void compiled_code_print(ScmObj obj, ScmPort *out, ScmWriteContext *c)
   71: {
   72:     Scm_Printf(out, "#<compiled-code %S@%p>",
   73:                Scm_CompiledCodeFullName(SCM_COMPILED_CODE(obj)), obj);
   74: }
   75: 
   76: SCM_DEFINE_BUILTIN_CLASS_SIMPLE(Scm_CompiledCodeClass, compiled_code_print);
   77: 
   78: static ScmCompiledCode *make_compiled_code(void)
   79: {
   80:     ScmCompiledCode *cc = SCM_NEW(ScmCompiledCode);
   81:     SCM_SET_CLASS(cc, SCM_CLASS_COMPILED_CODE);
   82:     cc->code = NULL;
   83:     cc->constants = NULL;
   84:     cc->maxstack = -1;
   85:     cc->info = SCM_NIL;
   86:     cc->argInfo = SCM_FALSE;
   87:     cc->name = SCM_FALSE;
   88:     cc->parent = SCM_FALSE;
   89:     cc->builder = NULL;
   90:     return cc;
   91: }
   92: 
   93: /*----------------------------------------------------------------------
   94:  * An API to execute statically compiled toplevel code.  *PROVISIONAL*
   95:  */
   96: static ScmSubrProc execute_toplevels;
   97: 
   98: void Scm_VMExecuteToplevels(ScmCompiledCode *cs[])
   99: {
  100:     ScmObj proc = Scm_MakeSubr(execute_toplevels, cs, 0, 0, SCM_FALSE);
  101:     Scm_ApplyRec(proc, SCM_NIL);
  102: }
  103: 
  104: static ScmObj execute_toplevels_cc(ScmObj result, void **data)
  105: {
  106:     ScmCompiledCode **cs = (ScmCompiledCode **)data[0];
  107:     ScmVM *vm;
  108:     if (cs[0] == NULL) return SCM_UNDEFINED;
  109:     data[0] = cs+1;
  110:     vm = Scm_VM();
  111:     Scm_VMPushCC(execute_toplevels_cc, data, 1);
  112:     vm->base = cs[0];
  113:     vm->pc = vm->base->code;
  114:     return SCM_UNDEFINED;
  115: }
  116: 
  117: static ScmObj execute_toplevels(ScmObj *args, int nargs, void *cv)
  118: {
  119:     Scm_VMPushCC(execute_toplevels_cc, &cv, 1);
  120:     return SCM_UNDEFINED;
  121: }
  122: 
  123: /*----------------------------------------------------------------------
  124:  * Disassembler
  125:  */
  126: void Scm_CompiledCodeDump(ScmCompiledCode *cc)
  127: {
  128:     int i;
  129:     ScmWord *p;
  130:     ScmObj closures = SCM_NIL, cp;
  131:     int clonum = 0;
  132: 
  133:     Scm_Printf(SCM_CUROUT, "main_code (name=%S, code=%p, size=%d, const=%d, stack=%d):\n",
  134:                cc->name, cc->code, cc->codeSize, cc->constantSize,
  135:                cc->maxstack);
  136:     do {
  137:       loop:
  138:         p = cc->code;
  139:         Scm_Printf(SCM_CUROUT, "args: %S\n", cc->argInfo);
  140:         for (i=0; i < cc->codeSize; i++) {
  141:             ScmWord insn = p[i];
  142:             ScmObj info, s;
  143:             ScmPort *out = SCM_PORT(Scm_MakeOutputStringPort(TRUE));
  144:             u_int code;
  145:             const char *insn_name;
  146: 
  147:             info = Scm_Assq(SCM_MAKE_INT(i), cc->info);
  148:             code = SCM_VM_INSN_CODE(insn);
  149:             insn_name = Scm_VMInsnName(code);
  150:             
  151:             switch (Scm_VMInsnNumParams(code)) {
  152:             case 0:
  153:                 Scm_Printf(out, "  %4d %s ", i, insn_name);
  154:                 break;
  155:             case 1:
  156:                 Scm_Printf(out, "  %4d %s(%d) ", i, insn_name,
  157:                            SCM_VM_INSN_ARG(insn));
  158:                 break;
  159:             case 2:
  160:                 Scm_Printf(out, "  %4d %s(%d,%d) ", i, insn_name,
  161:                            SCM_VM_INSN_ARG0(insn),SCM_VM_INSN_ARG1(insn));
  162:                 break;
  163:             }
  164:             switch (Scm_VMInsnOperandType(code)) {
  165:             case SCM_VM_OPERAND_ADDR:
  166:                 Scm_Printf(out, "%d", (ScmWord*)p[i+1] - cc->code);
  167:                 i++;
  168:                 break;
  169:             case SCM_VM_OPERAND_OBJ:
  170:                 Scm_Printf(out, "%S", p[i+1]);
  171:                 i++;
  172:                 break;
  173:             case SCM_VM_OPERAND_OBJ_ADDR:
  174:                 Scm_Printf(out, "%S, %d", p[i+1], (ScmWord*)p[i+2] - cc->code);
  175:                 i += 2;
  176:                 break;
  177:             case SCM_VM_OPERAND_CODE:
  178:                 Scm_Printf(out, "#<lambda %d>", clonum);
  179:                 closures = Scm_Acons(SCM_OBJ(p[i+1]), SCM_MAKE_INT(clonum),
  180:                                      closures);
  181:                 clonum++;
  182:                 i++;
  183:                 break;
  184:             case SCM_VM_OPERAND_CODES:
  185:                 Scm_Printf(out, "(");
  186:                 SCM_FOR_EACH(cp, SCM_OBJ(p[i+1])) {
  187:                     if (SCM_COMPILED_CODE_P(SCM_CAR(cp))) {
  188:                         closures = Scm_Acons(SCM_CAR(cp),
  189:                                              SCM_MAKE_INT(clonum),
  190:                                              closures);
  191:                         Scm_Printf(out, "#<lambda %d>", clonum);
  192:                         clonum++;
  193:                     }
  194:                 }
  195:                 Scm_Printf(out, ")");
  196:                 i++;
  197:                 break;
  198:             default:
  199:                 /*nothing*/;
  200:             }
  201: 
  202:             /* Show info */
  203:             s = Scm_GetOutputStringUnsafe(out, 0);
  204:             if (!SCM_PAIRP(info)) {
  205:                 Scm_Puts(SCM_STRING(s), SCM_CUROUT);
  206:                 Scm_Putc('\n', SCM_CUROUT);
  207:             } else {
  208:                 int len = SCM_STRING_BODY_SIZE(SCM_STRING_BODY(s));
  209:                 ScmObj srcinfo = Scm_Assq(SCM_SYM_SOURCE_INFO, info);
  210:                 ScmObj bindinfo = Scm_Assq(SCM_SYM_BIND_INFO, info);
  211:                 Scm_Puts(SCM_STRING(s), SCM_CUROUT);
  212:                 Scm_Flush(SCM_CUROUT);
  213:                 for (; len<32; len++) {
  214:                     Scm_Putc(' ', SCM_CUROUT);
  215:                 }
  216:                 if (SCM_FALSEP(srcinfo)) {
  217:                     Scm_Printf(SCM_CUROUT, "; lambda %#40.1S\n",
  218:                                SCM_CDR(bindinfo));
  219:                 } else {
  220:                     Scm_Printf(SCM_CUROUT, "; %#40.1S\n",
  221:                                Scm_UnwrapSyntax(SCM_CDR(srcinfo)));
  222:                 }
  223:             }
  224:         }
  225:         if (!SCM_NULLP(closures)) {
  226:             cc = SCM_COMPILED_CODE(SCM_CAAR(closures));
  227:             Scm_Printf(SCM_CUROUT, "internal_closure_%S (name=%S, code=%p, size=%d, const=%d stack=%d):\n",
  228:                        SCM_CDAR(closures), cc->name, cc->code,
  229:                        cc->codeSize, cc->constantSize, cc->maxstack);
  230:             closures = SCM_CDR(closures);
  231:             goto loop;
  232:         }
  233:     } while (0);
  234: }
  235: 
  236: /*------------------------------------------------------------------
  237:  * Builder - used by the new compiler
  238:  */
  239: 
  240: #define CC_BUILDER_CHUNK_BITS  5
  241: #define CC_BUILDER_CHUNK_SIZE  (1L<<CC_BUILDER_CHUNK_BITS)
  242: #define CC_BUILDER_CHUNK_MASK  (CC_BUILDER_CHUNK_SIZE-1)
  243: 
  244: typedef struct cc_builder_chunk {
  245:     struct cc_builder_chunk *prev;
  246:     ScmWord code[CC_BUILDER_CHUNK_SIZE];
  247: } cc_builder_chunk;
  248: 
  249: /* To perform instruction combination, the builder buffers one insn/operand.
  250:  * currentInsn == SCM_WORD(-1) indicates there's no buffered insn.
  251:  */
  252: typedef struct cc_builder_rec {
  253:     cc_builder_chunk *chunks;
  254:     int numChunks;
  255:     ScmObj constants;           /* list of constants */
  256:     int currentIndex;
  257:     ScmWord currentInsn;        /* buffer for instruction combining. */
  258:     int    currentArg0;         /* ditto */
  259:     int    currentArg1;         /* ditto */
  260:     ScmObj currentOperand;      /* ditto */
  261:     ScmObj currentInfo;         /* ditto */
  262:     ScmObj labelDefs;           /* alist of (name . offset) */
  263:     ScmObj labelRefs;           /* alist of (name . offset-to-fill) */
  264:     int labelCount;             /* counter to generate unique labels */
  265:     ScmObj info;                /* alist of (offset (source-info obj)) */
  266: } cc_builder;
  267: 
  268: #define CC_BUILDER_BUFFER_EMPTY       SCM_WORD(-1)
  269: #define CC_BUILDER_BUFFER_EMPTY_P(b)  ((b)->currentInsn == CC_BUILDER_BUFFER_EMPTY)
  270: 
  271: /* Some internal stuff */
  272: 
  273: #define CC_BUILDER_GET(b, cc)                                           \
  274:     do {                                                                \
  275:         if (cc->builder == NULL) {                                      \
  276:             Scm_Error("[internal error] CompiledCode is already frozen"); \
  277:         }                                                               \
  278:         (b) = (cc_builder*)cc->builder;                                 \
  279:     } while (0)
  280: 
  281: static cc_builder *make_cc_builder(void)
  282: {
  283:     cc_builder *b;
  284:     b = SCM_NEW(cc_builder);
  285:     b->chunks = NULL;
  286:     b->numChunks = 0;
  287:     b->constants = SCM_NIL;
  288:     b->currentIndex = 0;
  289:     b->currentInsn = CC_BUILDER_BUFFER_EMPTY;
  290:     b->currentOperand = b->currentInfo = SCM_FALSE;
  291:     b->labelDefs = b->labelRefs = SCM_NIL;
  292:     b->labelCount = 0;
  293:     b->info = SCM_NIL;
  294:     return b;
  295: }
  296: 
  297: static void cc_builder_add_word(cc_builder *b, ScmWord w)
  298: {
  299:     int ni = b->currentIndex & CC_BUILDER_CHUNK_MASK;
  300:     if (ni == 0) {
  301:         cc_builder_chunk *newchunk = SCM_NEW(cc_builder_chunk);
  302:         newchunk->prev = b->chunks;
  303:         b->chunks = newchunk;
  304:         b->numChunks++;
  305:     }
  306:     b->chunks->code[ni] = w;
  307:     b->currentIndex++;
  308: }
  309: 
  310: static void cc_builder_add_constant(cc_builder *b, ScmObj obj)
  311: {
  312:     if (!SCM_PTRP(obj)) return;
  313:     if (!SCM_FALSEP(Scm_Memq(obj, b->constants))) return;
  314:     b->constants = Scm_Cons(obj, b->constants);
  315: }
  316: 
  317: static void cc_builder_add_info(cc_builder *b)
  318: {
  319:     if (SCM_FALSEP(b->currentInfo)) return;
  320:     b->info = Scm_Acons(SCM_MAKE_INT(b->currentIndex),
  321:                         SCM_LIST1(Scm_Cons(SCM_SYM_SOURCE_INFO,
  322:                                            b->currentInfo)),
  323:                         b->info);
  324:     b->currentInfo = SCM_FALSE;
  325: }
  326: 
  327: /* Returns label offset of the given label, if the label is already defined.
  328:    Otherwise, returns -1. */
  329: static int cc_builder_label_def(cc_builder *b, ScmObj label)
  330: {
  331:     ScmObj p = Scm_Assq(label, b->labelDefs);
  332:     if (SCM_PAIRP(p)) {
  333:         return SCM_INT_VALUE(SCM_CDR(p));
  334:     } else {
  335:         return -1;
  336:     }
  337: }
  338: 
  339: /* Flush the currentInsn buffer. */
  340: static void cc_builder_flush(cc_builder *b)
  341: {
  342:     u_int code;
  343:     
  344:     if (CC_BUILDER_BUFFER_EMPTY_P(b)) return;
  345:     cc_builder_add_info(b);
  346:     cc_builder_add_word(b, b->currentInsn);
  347: 
  348:     code = SCM_VM_INSN_CODE(b->currentInsn);
  349:     switch (Scm_VMInsnOperandType(code)) {
  350:     case SCM_VM_OPERAND_ADDR:
  351:         /* Addr should be a label.  We just push the label reference
  352:            into labelRefs, and emit a dummy address for the time being.
  353:            (we can't emit the actual number even if we're referring to
  354:            the label that has already appeared, since the number should
  355:            be calculated after the code vector is allocated.) */
  356:         b->labelRefs = Scm_Acons(b->currentOperand,
  357:                                  SCM_MAKE_INT(b->currentIndex),
  358:                                  b->labelRefs);
  359:         cc_builder_add_word(b, SCM_WORD(0)); /* dummy */
  360:         break;
  361:     case SCM_VM_OPERAND_OBJ:;
  362:     case SCM_VM_OPERAND_CODES:
  363:         cc_builder_add_word(b, SCM_WORD(b->currentOperand));
  364:         cc_builder_add_constant(b, b->currentOperand);
  365:         break;
  366:     case SCM_VM_OPERAND_OBJ_ADDR:
  367:         /* operand would be given as a list of (OBJ LABEL). */
  368:         SCM_ASSERT(SCM_PAIRP(b->currentOperand)
  369:                    && SCM_PAIRP(SCM_CDR(b->currentOperand)));
  370:         cc_builder_add_word(b, SCM_WORD(SCM_CAR(b->currentOperand)));
  371:         cc_builder_add_constant(b, SCM_CAR(b->currentOperand));
  372:         b->labelRefs = Scm_Acons(SCM_CADR(b->currentOperand),
  373:                                  SCM_MAKE_INT(b->currentIndex),
  374:                                  b->labelRefs);
  375:         cc_builder_add_word(b, SCM_WORD(0)); /* dummy */
  376:         break;
  377:     case SCM_VM_OPERAND_CODE:
  378:         if (!SCM_COMPILED_CODE_P(b->currentOperand)) goto badoperand;
  379:         cc_builder_add_word(b, SCM_WORD(b->currentOperand));
  380:         cc_builder_add_constant(b, b->currentOperand);
  381:     default:
  382:         break;
  383:     }
  384:     b->currentInsn = CC_BUILDER_BUFFER_EMPTY;
  385:     return;
  386:   badoperand:
  387:     b->currentInsn = CC_BUILDER_BUFFER_EMPTY;
  388:     Scm_Error("[internal error] bad operand: %S", b->currentOperand);
  389:     return;
  390: }
  391: 
  392: /* a peephole optimization; rewrite jump destination for cascaded jump
  393:  *
  394:  * - if the destination of JUMP-like insn (including conditional jump
  395:  *   and PRE-CALL) is another JUMP, rewrite the destination.
  396:  * - if the destination of BF is another BF (this pattern appears frequently,
  397:  *   e.g. 'or' is used in the test clause of 'cond'), rewrite the destination.
  398:  */
  399: static void cc_builder_jumpopt(ScmCompiledCode *cc)
  400: {
  401:     ScmWord *cp = cc->code;
  402:     u_int code, i;
  403:     ScmWord *target;
  404: 
  405:     for (i=0; i<(u_int)cc->codeSize; i++) {
  406:         code = SCM_VM_INSN_CODE(*cp); cp++;
  407:         switch (Scm_VMInsnOperandType(code)) {
  408:         case SCM_VM_OPERAND_OBJ:;
  409:         case SCM_VM_OPERAND_CODE:;
  410:         case SCM_VM_OPERAND_CODES:;
  411:             i++; cp++;
  412:             break;
  413:         case SCM_VM_OPERAND_OBJ_ADDR:
  414:             i++; cp++;
  415:             /*FALLTHROUGH*/
  416:         case SCM_VM_OPERAND_ADDR:
  417:             target = (ScmWord*)*cp;
  418:             while (SCM_VM_INSN_CODE(*target) == SCM_VM_JUMP
  419:                    || (code == SCM_VM_BF
  420:                        && SCM_VM_INSN_CODE(*target) == SCM_VM_BF)) {
  421:                 target = (ScmWord*)target[1];
  422:             }
  423:             if (target != (ScmWord*)*cp) {
  424:                 *cp = SCM_WORD(target);
  425:             }
  426:             i++; cp++;
  427:             break;
  428:         default:
  429:             break;
  430:         }
  431:     }
  432: }
  433: 
  434: 
  435: /* Creates and returns a new empty compiled-code object for building
  436:    new code chunk. */
  437: ScmObj Scm_MakeCompiledCodeBuilder(int reqargs, int optargs,
  438:                                    ScmObj name, ScmObj parent, ScmObj intForm)
  439: {
  440:     ScmCompiledCode *cc = make_compiled_code();
  441:     cc->builder = make_cc_builder();
  442:     cc->requiredArgs = reqargs;
  443:     cc->optionalArgs = optargs;
  444:     cc->name = name;
  445:     cc->parent = parent;
  446:     cc->intermediateForm = intForm;
  447:     return SCM_OBJ(cc);
  448: }
  449: 
  450: /* Returns a label identifier (integer) unique to this code block */
  451: ScmObj Scm_CompiledCodeNewLabel(ScmCompiledCode *cc)
  452: {
  453:     ScmObj label;
  454:     cc_builder *b;
  455:     CC_BUILDER_GET(b, cc);
  456:     label = SCM_MAKE_INT(b->labelCount);
  457:     b->labelCount++;
  458:     return label;
  459: }
  460: 
  461: /* Set label to the current instruction position. */
  462: void Scm_CompiledCodeSetLabel(ScmCompiledCode *cc, ScmObj label)
  463: {
  464:     cc_builder *b;
  465:     
  466:     CC_BUILDER_GET(b, cc);
  467: 
  468:     /* Flush buffered insn first. */
  469:     cc_builder_flush(b);
  470: 
  471:     /* NB: should check duplicate labels */
  472:     b->labelDefs = Scm_Acons(label, SCM_MAKE_INT(b->currentIndex),
  473:                              b->labelDefs);
  474: }
  475: 
  476: /* Pack the code accumulated in the builder into a code vector.
  477:    Perform label resolution and jump optimization. */
  478: void Scm_CompiledCodeFinishBuilder(ScmCompiledCode *cc, int maxstack)
  479: {
  480:     ScmObj cp;
  481:     cc_builder *b;
  482:     cc_builder_chunk *bc, *bcprev;
  483:     int i, j, numConstants;
  484: 
  485:     CC_BUILDER_GET(b, cc);
  486:     cc_builder_flush(b);
  487:     cc->code = SCM_NEW_ATOMIC2(ScmWord *, b->currentIndex * sizeof(ScmWord));
  488:     cc->codeSize = b->currentIndex;
  489: 
  490:     /* reverse chunks, leaving the first chunk in bcprev. */
  491:     bcprev = NULL;
  492:     for (bc = b->chunks; bc;) {
  493:         cc_builder_chunk *next = bc->prev;
  494:         bc->prev = bcprev;
  495:         bcprev = bc;
  496:         bc = next;
  497:     }
  498: 
  499:     /* pack words */
  500:     bc = bcprev;
  501:     for (i=0, j=0; i<b->currentIndex; i++, j++) {
  502:         if (j >= CC_BUILDER_CHUNK_SIZE) {
  503:             bc = bc->prev;
  504:             j = 0;
  505:         }
  506:         cc->code[i] = bc->code[j];
  507:     }
  508: 
  509:     /* pack constants */
  510:     numConstants = Scm_Length(b->constants);
  511:     if (numConstants > 0) {
  512:         ScmObj cp;
  513:         cc->constants = SCM_NEW_ARRAY(ScmObj, numConstants);
  514:         for (i=0, cp=b->constants; i<numConstants; i++, cp=SCM_CDR(cp)) {
  515:             cc->constants[i] = SCM_CAR(cp);
  516:         }
  517:     }
  518:     cc->constantSize = numConstants;
  519: 
  520:     /* resolve labels */
  521:     SCM_FOR_EACH(cp, b->labelRefs) {
  522:         int destAddr = cc_builder_label_def(b, SCM_CAAR(cp));
  523:         int operandAddr;
  524:         if (destAddr < 0) {
  525:             Scm_Error("[internal error] undefined label in compiled code: %S",
  526:                       SCM_CAAR(cp));
  527:         }
  528:         operandAddr = SCM_INT_VALUE(SCM_CDAR(cp));
  529:         SCM_ASSERT(operandAddr >= 0 && operandAddr < cc->codeSize);
  530:         cc->code[operandAddr] = SCM_WORD(cc->code + destAddr);
  531:     }
  532: 
  533:     /* jump destination optimization */
  534:     cc_builder_jumpopt(cc);
  535: 
  536:     /* record debug info */
  537:     cc->info = b->info;
  538: 
  539:     /* set max stack depth */
  540:     cc->maxstack = maxstack;
  541:     
  542:     /* make sure this code is 'fixed'---no more building */
  543:     cc->builder = NULL;
  544: }
  545: 
  546: /*----------------------------------------------------------------
  547:  * Emitting instruction and operand, performing instruction combination
  548:  */
  549: 
  550: /* This is originally implemented in Scheme, but moved here for efficiency,
  551:  * since this routine is the most frequently called one during compilation.
  552:  */
  553: 
  554: /* The plan is to use STN generated from vminsn.scm for instruction
  555:    combination, but we haven't got it working yet. */
  556: #if 0
  557: /* The state transition table */
  558: struct stn_arc {
  559:     int input;                  /* input insn, or -1 for wildcard */
  560:     int action;                 /* NEXT, RESET, KEEPn */
  561:     int operand;                /* emitting insn / next state */
  562: };
  563: 
  564: /* State transition actions */
  565: enum {
  566:     NEXT,
  567:     EMIT,
  568:     KEEP
  569: };
  570: