home *** CD-ROM | disk | FTP | other *** search
/ EuroCD 3 / EuroCD 3.iso / Programming / PPCcforth / nf.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-06-24  |  17.6 KB  |  756 lines
  1. /* nf.c -- this program can be run to generate a new environment for the
  2.  * FORTH interpreter forth.c. It takes the dictionary from the standard input.
  3.  * Normally, this dictionary is in the file "forth.dict", so 
  4.  *    nf < forth.dict
  5.  * will do the trick.
  6.  */
  7.  
  8. #include <stdio.h>
  9. #include <ctype.h>
  10. #include "common.h"
  11. #include "forth.lex.h"        /* #defines for lexical analysis */
  12.  
  13. #define isoctal(c)    (c >= '0' && c <= '7')    /* augument ctype.h */
  14.  
  15. #define assert(c,s)    (!(c) ? failassert(s) : 1)
  16. #define chklit()    (!prev_lit ? dictwarn("Qustionable literal") : 1)
  17.  
  18. #define LINK struct linkrec
  19. #define CHAIN struct chainrec
  20.  
  21. struct chainrec {
  22.     char chaintext[32];
  23.     int defloc;                /* CFA or label loc */
  24.     int chaintype;            /* 0=undef'd, 1=absolute, 2=relative */
  25.     CHAIN *nextchain;
  26.     LINK *firstlink;
  27. };
  28.  
  29. struct linkrec {
  30.     int loc;
  31.     LINK *nextlink;
  32. };
  33.  
  34. CHAIN firstchain;
  35.  
  36. #define newchain()    (CHAIN *)(calloc(1,sizeof(CHAIN)))
  37. #define newlink()    (LINK *)(calloc(1,sizeof(LINK)))
  38.  
  39. CHAIN *find();
  40. CHAIN *lastchain();
  41. LINK *lastlink();
  42.  
  43. char *strcat();
  44. char *calloc();
  45.  
  46. int dp = DPBASE;
  47. int latest;
  48.  
  49. short mem[INITMEM];
  50.  
  51. FILE *outf, *fopen();
  52.  
  53. main(argc, argv)
  54. int argc;
  55. char *argv[];
  56. {
  57. #ifdef DEBUG
  58.     puts("Opening output file");
  59. #endif DEBUG
  60.  
  61.     strcpy(firstchain.chaintext," ** HEADER **");
  62.     firstchain.nextchain = NULL;
  63.     firstchain.firstlink = NULL;
  64.  
  65. #ifdef DEBUG
  66.     puts("call builddict");
  67. #endif DEBUG
  68.     builddict();
  69. #ifdef DEBUG
  70.     puts("Make FORTH and COLDIP");
  71. #endif DEBUG
  72.     mkrest();
  73. #ifdef DEBUG
  74.     puts("Call Buildcore");
  75. #endif DEBUG
  76.     buildcore();
  77. #ifdef DEBUG
  78.     puts("call checkdict");
  79. #endif DEBUG
  80.     checkdict();
  81. #ifdef DEBUG
  82.     puts("call writedict");
  83. #endif DEBUG
  84.     writedict();
  85.  
  86.     printf("%s: done.\n", argv[0]);
  87.     exit(0);
  88. }
  89.  
  90. buildcore()            /* set up low core */
  91. {
  92.     mem[USER_DEFAULTS+0] = INITS0;            /* initial S0 */
  93.     mem[USER_DEFAULTS+1] = INITR0;            /* initial R0 */
  94.     mem[USER_DEFAULTS+2] = TIB_START;        /* initial TIB */
  95.     mem[USER_DEFAULTS+3] = MAXWIDTH;        /* initial WIDTH */
  96.     mem[USER_DEFAULTS+4] = 0;            /* initial WARNING */
  97.     mem[USER_DEFAULTS+5] = dp;            /* initial FENCE */
  98.     mem[USER_DEFAULTS+6] = dp;            /* initial DP */
  99.     mem[USER_DEFAULTS+7] = instance("FORTH") + 3;    /* initial CONTEXT */
  100.  
  101.     mem[SAVEDIP] = 0;                /* not a saved FORTH */
  102. }
  103.  
  104. builddict()            /* read the dictionary */
  105. {
  106.     int prev_lit = 0, lit_flag = 0;
  107.     int temp;
  108.     char s[256];
  109.     TOKEN *token;
  110.  
  111.     while ((token = yylex()) != NULL) {    /* EOF returned as a null pointer */
  112. #ifdef DEBUG
  113.     printf("\ntoken: %s: %d ",token->text, token->type);
  114. #endif DEBUG
  115.     switch (token->type) {
  116.  
  117.     case PRIM:
  118. #ifdef DEBUG
  119.         printf("primitive ");
  120. #endif DEBUG
  121.         if ((token = yylex()) == NULL)    /* get the next word */
  122.         dicterr("No word following PRIM");
  123.         strcpy (s,token->text);
  124. #ifdef DEBUG
  125.         printf(".%s. ",s);
  126. #endif DEBUG
  127.         if ((token == yylex()) == NULL)    /* get the value */
  128.         dicterr("No value following PRIM <word>");
  129.         mkword(s,mkval(token));
  130.         break;
  131.  
  132.     case CONST:
  133. #ifdef DEBUG
  134.         printf("constant ");
  135. #endif DEBUG
  136.         if ((token = yylex()) == NULL)    /* get the word */
  137.         dicterr("No word following CONST");
  138.         strcpy (s,token->text);        /* s holds word */
  139. #ifdef DEBUG
  140.         printf(".%s. ",s);
  141. #endif DEBUG
  142.         if (!find("DOCON"))
  143.         dicterr ("Constant definition before DOCON: %s",s);
  144.                 /* put the CF of DOCON into this word's CF */
  145.         mkword(s,(int)mem[instance("DOCON")]);
  146.         if ((token = yylex()) == NULL)    /* get the value */
  147.         dicterr("No value following CONST <word>");
  148.         temp = mkval(token);
  149.  
  150.         /* two special-case constants */
  151.         if (strcmp(s,"FIRST") == 0) temp = INITR0;
  152.         else if (strcmp(s,"LIMIT") == 0) temp = DPBASE;
  153.  
  154.         comma(temp);
  155.         break;
  156.  
  157.     case VAR:
  158. #ifdef DEBUG
  159.         printf("variable ");
  160. #endif DEBUG
  161.         if ((token = yylex()) == NULL)    /* get the variable name */
  162.         dicterr("No word following VAR");
  163.         strcpy (s,token->text);
  164. #ifdef DEBUG
  165.         printf(".%s. ",s);
  166. #endif DEBUG
  167.         if (!find("DOVAR"))
  168.         dicterr("Variable declaration before DOVAR: %s",s);
  169.         mkword (s, (int)mem[instance("DOVAR")]);
  170.         if ((token = yylex()) == NULL)    /* get the value */
  171.         dicterr("No value following VAR <word>");
  172.         comma(mkval(token));
  173.         break;
  174.  
  175.     case USER:
  176. #ifdef DEBUG
  177.         printf("uservar ");
  178. #endif DEBUG
  179.         if ((token = yylex()) == NULL)    /* get uservar name */
  180.         dicterr("No name following USER");
  181.         strcpy (s,token->text);
  182. #ifdef DEBUG
  183.         printf(".%s. ",s);
  184. #endif DEBUG
  185.         if (!find("DOUSE"))
  186.         dicterr("User variable declared before DOUSE: %s",s);
  187.         mkword (s, (int)mem[instance("DOUSE")]);
  188.         if ((token = yylex()) == NULL)    /* get the value */
  189.         dicterr("No value following USER <word>");
  190.         comma(mkval(token));
  191.         break;
  192.  
  193.     case COLON:
  194. #ifdef DEBUG
  195.         printf("colon def'n ");
  196. #endif DEBUG
  197.         if ((token = yylex()) == NULL)    /* get name of word */
  198.         dicterr("No word following : in definition");
  199.         strcpy (s,token->text);
  200. #ifdef DEBUG
  201.         printf(".%s.\n",s);
  202. #endif DEBUG
  203.         if (!find("DOCOL"))
  204.         dicterr("Colon definition appears before DOCOL: %s",s);
  205.  
  206.         if (token->type == NUL) {    /* special zero-named word */
  207.         int here = dp;        /* new latest */
  208. #ifdef DEBUG
  209.         printf("NULL WORD AT 0x%04x\n");
  210. #endif DEBUG
  211.         comma(0xC1);
  212.         comma(0x80);
  213.         comma(latest);
  214.         latest = here;
  215.         comma((int)mem[instance("DOCOL")]);
  216.         }
  217.         else {
  218.         mkword (s, (int)mem[instance("DOCOL")]);
  219.         }
  220.         break;
  221.  
  222.     case SEMICOLON:
  223. #ifdef DEBUG
  224.         puts("end colon def'n");
  225. #endif DEBUG
  226.         comma (instance(";S"));
  227.         break;
  228.  
  229.     case SEMISTAR:
  230. #ifdef DEBUG
  231.         printf("end colon w/IMMEDIATE ");
  232. #endif DEBUG
  233.         comma (instance (";S"));    /* compile cfA of ;S, not CF */
  234.         mem[latest] |= IMMEDIATE;    /* make the word immediate */
  235.         break;
  236.  
  237.     case STRING_LIT:
  238. #ifdef DEBUG
  239.         printf("string literal ");
  240. #endif DEBUG
  241.         strcpy(s,token->text);
  242.         mkstr(s);        /* mkstr compacts the string in place */
  243. #ifdef DEBUG
  244.         printf("string=(%d) \"%s\" ",strlen(s),s);
  245. #endif DEBUG
  246.         comma(strlen(s));
  247.         {
  248.         char *stemp;
  249.         stemp = s;
  250.         while (*stemp) comma(*stemp++);
  251.         }
  252.         break;
  253.     
  254.     case COMMENT:
  255. #ifdef DEBUG
  256.         printf("comment ");
  257. #endif DEBUG
  258.         skipcomment();
  259.         break;
  260.  
  261.     case LABEL:
  262. #ifdef DEBUG
  263.         printf("label: ");
  264. #endif DEBUG
  265.         if ((token = yylex()) == NULL)
  266.         dicterr("No name following LABEL");
  267. #ifdef DEBUG
  268.         printf(".%s. ", token->text);
  269. #endif DEBUG
  270.         define(token->text,2);    /* place in sym. table w/o compiling
  271.                        anything into dictionary; 2 means
  272.                        defining a label */
  273.         break;
  274.  
  275.     case LIT:
  276.         lit_flag = 1;        /* and fall through to the rest */
  277.  
  278.     default:
  279.         if (find(token->text) != NULL) {    /* is word defined? */
  280. #ifdef DEBUG
  281.         printf("  normal: %s\n",token->text);
  282. #endif DEBUG
  283.             comma (instance (token->text));
  284.         break;
  285.         }
  286.  
  287.         /* else */
  288.         /* the literal types all call chklit(). This macro checks to
  289.            if the previous word was "LIT"; if not, it warns */
  290.         switch(token->type) {
  291.         case DECIMAL: chklit(); comma(mkdecimal(token->text)); break;
  292.         case HEX: chklit(); comma(mkhex(token->text)); break;
  293.         case OCTAL: chklit(); comma(mkoctal(token->text)); break;
  294.         case C_BS: chklit(); comma('\b'); break;
  295.         case C_FF: chklit(); comma('\f'); break;
  296.         case C_NL: chklit(); comma('\n'); break;
  297.         case C_CR: chklit(); comma('\r'); break;
  298.         case C_TAB: chklit(); comma('\t'); break;
  299.         case C_BSLASH: chklit(); comma(0x5c); break;  /* ASCII backslash */
  300.         case C_LIT: chklit(); comma(*((token->text)+1)); break;
  301.  
  302.         default:
  303. #ifdef DEBUG
  304.         printf("forward reference");
  305. #endif DEBUG
  306.         comma (instance (token->text));        /* create an instance,
  307.                         to be resolved at definition */
  308.         }
  309.     }
  310. #ifdef DEBUG
  311.     if (lit_flag) puts("expect a literal");
  312. #endif DEBUG
  313.     prev_lit = lit_flag;    /* to be used by chklit() next time */
  314.     lit_flag = 0;
  315.     }
  316. }
  317.  
  318. comma(i)            /* put at mem[dp]; increment dp */
  319. {
  320.     mem[dp++] = (unsigned short)i;
  321.     if (dp > INITMEM) dicterr("DICTIONARY OVERFLOW");
  322. }
  323.  
  324. /*
  325.  * make a word in the dictionary.  the new word will have name *s, its CF
  326.  * will contain v. Also, resolve any previously-unresolved references by
  327.  * calling define()
  328.  */
  329.  
  330. mkword(s, v)
  331. char *s;
  332. short v;
  333. {
  334.     int here, count = 0;
  335.     char *olds;
  336.     olds = s;        /* preserve this for resolving references */
  337.  
  338. #ifdef DEBUG
  339.     printf("%s ",s);
  340. #endif DEBUG
  341.  
  342.     here = dp;        /* hold this value to place length byte */
  343.  
  344.     while (*s) {        /* for each character */
  345.         mem[++dp] = (unsigned short)*s;
  346.         count++; s++;
  347.     }
  348.  
  349.     if (count >= MAXWIDTH) dicterr("Input word name too long");
  350.  
  351.                 /* set MSB on */
  352.     mem[here] = (short)(count | 0x80);
  353.  
  354.     mem[dp++] |= 0x80;    /* set hi bit of last char in name */
  355.     
  356.     mem[dp++] = (short)latest;    /* the link field */
  357.  
  358.     latest = here;        /* update the link */
  359.  
  360.     mem[dp] = v;        /* code field; leave dp = CFA */
  361.  
  362.     define(olds,1);        /* place in symbol table. 1 == "not a label" */
  363.     dp++;            /* now leave dp holding PFA */
  364.  
  365.     /* that's all. Now dp points (once again) to the first UNallocated
  366.            spot in mem, and everybody's happy. */
  367. }
  368.  
  369. mkrest()            /* Write out the word FORTH as a no-op with
  370.                    DOCOL as CF, ;S as PF, followed by
  371.                    0xA081, and latest in its PF.
  372.                    Also, Put the CFA of ABORT at 
  373.                    mem[COLDIP] */
  374. {
  375.     mem[COLDIP] = dp;    /* the cold-start IP is here, and the word
  376.                    which will be executed is COLD */
  377.     if ((mem[dp++] = instance("COLD")) == 0)
  378.         dicterr("COLD must be defined to take control at startup");
  379.  
  380.     mem[ABORTIP] = dp;    /* the abort-start IP is here, and the word
  381.                    which will be executed is ABORT */
  382.     if ((mem[dp++] = instance("ABORT")) == 0)
  383.         dicterr("ABORT must be defined to take control at interrupt");
  384.  
  385.     mkword("FORTH",mem[instance("DOCOL")]);
  386.     comma(instance(";S"));
  387.     comma(0xA081);    /* magic number for vocabularies */
  388.     comma(latest);        /* NFA of last word in dictionary: FORTH */
  389.  
  390.     mem[LIMIT] = dp + 1024;
  391.     if (mem[LIMIT] >= INITMEM) mem[LIMIT] = INITMEM-1;
  392. }
  393.  
  394. writedict()            /* write memory to COREFILE and map 
  395.                       to MAPFILE */
  396. {
  397.     FILE   *outfile;
  398.     int     i, temp, tempb, firstzero, nonzero;
  399.     char    chars[9], outline[80], tstr[6];
  400.  
  401.     if ((outfile = fopen(MAPFILE,"w")) == NULL) {
  402.     printf ("nf: can't open %s for write.\n", MAPFILE);
  403.     exit (1);
  404.     }
  405.  
  406.     for (temp = 0; temp < dp; temp += 8) {
  407.     nonzero = FALSE;
  408.     sprintf (outline, "%04x:", temp);
  409.     for (i = temp; i < temp + 8; i++) {
  410.         sprintf (tstr, " %04x", (unsigned short) mem[i]);
  411.         strcat (outline, tstr);
  412.         tempb = mem[i] & 0x7f;
  413.         if (tempb < 0x7f && tempb >= ' ')
  414.         chars[i % 8] = tempb;
  415.         else
  416.         chars[i % 8] = '.';
  417.         nonzero |= mem[i];
  418.     }
  419.     if (nonzero) {
  420.         fprintf (outfile, "%s %s\n", outline, chars);
  421.         firstzero = TRUE;
  422.     }
  423.     else
  424.         if (firstzero) {
  425.         fprintf (outfile, "----- ZERO ----\n");
  426.         firstzero = FALSE;
  427.         }
  428.     }
  429.     fclose (outfile);
  430.  
  431.  
  432.     printf ("Writing %s; DPBASE=%d; dp=%d\n", COREFILE, DPBASE, dp);
  433.  
  434.     if ((outf = fopen (COREFILE, "w")) == NULL) {
  435.     printf ("nf: can't open %s for write.\n", COREFILE);
  436.     exit (1);
  437.     }
  438.  
  439.     if (fwrite (mem, sizeof (*mem), mem[LIMIT], outf) != mem[LIMIT]) {
  440.     fprintf (stderr, "Error writing to %s\n", COREFILE);
  441.     exit (1);
  442.     }
  443.  
  444.     if (fclose (outf) == EOF) {
  445.     fprintf (stderr, "Error closing %s\n", COREFILE);
  446.     exit (1);
  447.     }
  448. }
  449.  
  450. mkval(t)            /* convert t->text to integer based on type */
  451. TOKEN *t;
  452. {
  453.     char *s = t->text;
  454.     int sign = 1;
  455.  
  456.     if (*s == '-') {
  457.         sign = -1;
  458.         s++;
  459.     }
  460.  
  461.     switch (t->type) {
  462.     case DECIMAL:
  463.         return (sign * mkdecimal(s));
  464.     case HEX:
  465.         return (sign * mkhex(s));
  466.     case OCTAL:
  467.         return (sign * mkoctal(s));
  468.     default:
  469.         dicterr("Bad value following PRIM, CONST, VAR, or USER");
  470.         return (0);
  471.     }
  472. }
  473.  
  474. mkhex(s)
  475. char *s;
  476. {                /*  convert hex ascii to integer */
  477.     int     temp;
  478.     temp = 0;
  479.  
  480.     s += 2;            /* skip over '0x' */
  481.     while (isxdigit (*s)) {    /* first non-hex char ends */
  482.     temp <<= 4;        /* mul by 16 */
  483.     if (isupper (*s))
  484.         temp += (*s - 'A') + 10;
  485.     else
  486.         if (islower (*s))
  487.         temp += (*s - 'a') + 10;
  488.         else
  489.         temp += (*s - '0');
  490.     s++;
  491.     }
  492.     return temp;
  493. }
  494.  
  495. mkoctal(s)
  496. char *s;
  497. {                /*  convert Octal ascii to integer */
  498.     int     temp;
  499.     temp = 0;
  500.  
  501.     while (isoctal (*s)) {    /* first non-octal char ends */
  502.     temp = temp * 8 + (*s - '0');
  503.     s++;
  504.     }
  505.     return temp;
  506. }
  507.  
  508. mkdecimal(s)            /* convert ascii to decimal */
  509. char *s;
  510. {
  511.     return (atoi(s));    /* alias */
  512. }
  513.  
  514. dicterr(s,p1)
  515. char *s;
  516. int p1;        /* might be char * -- printf uses it */
  517. {
  518.     fprintf(stderr,s,p1);
  519.     fprintf(stderr,"\nLast word defined was ");
  520.     printword(latest);
  521. /*    fprintf(stderr, "; last word read was \"%s\"", token->text); */
  522.     fprintf(stderr,"\n");
  523.     exit(1);
  524. }
  525.  
  526. dictwarn(s)        /* almost like dicterr, but don't exit */
  527. char *s;
  528. {
  529.     fprintf(stderr,"\nWarning: %s\nLast word read was ",s);
  530.     printword(latest);
  531.     putc('\n',stderr);
  532. }
  533.     
  534. printword(n)
  535. int n;
  536. {
  537.     int count, tmp;
  538.     count = mem[n] & 0x1f;
  539.     for (n++;count;count--,n++) {
  540.     tmp = mem[n] & ~0x80;        /* mask eighth bit off */
  541.     if (tmp >= ' ' && tmp <= '~') putc(tmp, stderr);
  542.     }
  543. }
  544.  
  545. skipcomment()
  546. {
  547.     while(getchar() != ')');
  548. }
  549.  
  550. mkstr(s)            /* modifies a string in place with escapes
  551.                    compacted. Strips leading & trailing \" */
  552. char *s;
  553. {
  554.     char *source;
  555.     char *dest;
  556.  
  557.     source = dest = s;
  558.     source++;            /* skip leading quote */
  559.     while (*source != '"') {    /* string ends with unescaped \" */
  560.     if (*source == '\\') {    /* literal next */
  561.         source++;
  562.     }
  563.     *dest++ = *source++;
  564.     }
  565.     *dest = '\0';
  566. }
  567.  
  568. failassert(s)
  569. char *s;
  570. {
  571.     puts(s);
  572.     exit(1);
  573. }
  574.  
  575. checkdict()            /* check for unresolved references */
  576. {
  577.     CHAIN *ch = &firstchain;
  578.  
  579. #ifdef DEBUG
  580.     puts("\nCheck for unresolved references");
  581. #endif DEBUG
  582.     while (ch != NULL) {
  583. #ifdef DEBUG
  584.     printf("ch->chaintext = .%s. - ",ch->chaintext);
  585. #endif DEBUG
  586.     if ((ch->firstlink) != NULL) {
  587.         fprintf(stderr,"Unresolved forward reference: %s\n",ch->chaintext);
  588. #ifdef DEBUG
  589.         puts("still outstanding");
  590. #endif DEBUG
  591.     }
  592. #ifdef DEBUG
  593.     else puts("clean.");
  594. #endif DEBUG
  595.     ch = ch->nextchain;
  596.     }
  597. }
  598.  
  599.     
  600. /********* structure-handling functions find(s), define(s,t), instance(s) **/
  601.  
  602. CHAIN *find(s)        /* returns a pointer to the chain named s */
  603. char *s;
  604. {
  605.     CHAIN *ch;
  606.     ch = &firstchain;
  607.     while (ch != NULL) {
  608.         if (strcmp (s, ch->chaintext) == 0) return ch;
  609.         else ch = ch->nextchain;
  610.     }
  611.     return NULL;    /* not found */
  612. }
  613.  
  614. /* define must create a symbol table entry if none exists, with type t.
  615.    if one does exist, it must have type 0 -- it is an error to redefine
  616.    something at this stage. Change to type t, and fill in the outstanding
  617.    instances, with the current dp if type=1, or relative if type=2. */
  618.  
  619. define(s,t)        /* define s at current dp */
  620. char *s;
  621. int t;
  622. {
  623.     CHAIN *ch;
  624.     LINK *ln, *templn;
  625.  
  626. #ifdef DEBUG
  627.     printf("define(%s,%d)\n",s,t);
  628. #endif DEBUG
  629.  
  630.     if (t < 1 || t > 2)    /* range check */
  631.         dicterr("Program error: type in define() not 1 or 2.");
  632.  
  633.     if ((ch = find(s)) != NULL) {        /* defined or instanced? */
  634.         if (ch -> chaintype != 0)    /* already defined! */
  635.             dicterr("Word already defined: %s",s);
  636.         else {
  637. #ifdef DEBUG
  638.             printf("there are forward refs: ");
  639. #endif DEBUG
  640.             ch->chaintype = t;
  641.             ch->defloc = dp;
  642.         }
  643.     }
  644.     else {                /* must create a (blank) chain */
  645. #ifdef DEBUG
  646.         puts("no forward refs");
  647. #endif DEBUG
  648.         /* create a new chain, link it in, leave ch pointing to it */
  649.         ch = ((lastchain() -> nextchain) = newchain());
  650.         strcpy(ch->chaintext, s);
  651.         ch->chaintype = t;
  652.         ch->defloc = dp;    /* fill in for future references */
  653.     }
  654.  
  655.     /* now ch points to the chain (possibly) containing forward refs */
  656.     if ((ln = ch->firstlink) == NULL) return;    /* no links! */
  657.  
  658.     while (ln != NULL) {
  659. #ifdef DEBUG
  660.         printf("    Forward ref at 0x%x\n",ln->loc);
  661. #endif DEBUG
  662.         switch (ch->chaintype) {
  663.         case 1: mem[ln->loc] = (short)dp;    /* absolute */
  664.             break;
  665.         case 2: mem[ln->loc] = (short)(dp - ln->loc);    /* relative */
  666.             break;
  667.         default: dicterr ("Bad type field in define()");
  668.         }
  669.  
  670.         /* now skip to the next link & free this one */
  671.         templn = ln;
  672.         ln = ln->nextlink;
  673.         free(templn);
  674.     }
  675.     ch->firstlink = NULL;    /* clean up that last pointer */
  676. }
  677.  
  678. /*
  679.    instance must return a value to be compiled into the dictionary at
  680.    dp, consistent with the symbol s: if s is undefined, it returns 0,
  681.    and adds this dp to the chain for s (creating that chain if necessary).
  682.    If s IS defined, it returns <s> (absolute) or (s-dp) (relative), 
  683.    where <s> was the dp when s was defined.
  684. */
  685.  
  686. instance(s)
  687. char *s;
  688. {
  689.     CHAIN *ch;
  690.     LINK *ln;
  691.  
  692. #ifdef DEBUG
  693.     printf("instance(%s):\n",s);
  694. #endif DEBUG
  695.  
  696.     if ((ch = find(s)) == NULL) {    /* not defined yet at all */
  697. #ifdef DEBUG
  698.         puts("entirely new -- create a new chain");
  699. #endif DEBUG
  700.         /* create a new chain, link it in, leave ch pointing to it */
  701.         ch = ((lastchain() -> nextchain) = newchain());
  702.  
  703.         strcpy(ch->chaintext, s);
  704.         ln = newlink();        /* make its link */
  705.         ch->firstlink = ln;
  706.         ln->loc = dp;        /* store this location there */
  707.         return 0;        /* all done */
  708.     }
  709.     else {
  710.         switch(ch->chaintype) {
  711.         case 0:            /* not defined yet */
  712. #ifdef DEBUG
  713.             puts("still undefined -- add a link");
  714. #endif DEBUG
  715.             /* create a new link, point the last link to it, and
  716.                fill in the loc field with the current dp */
  717.             (lastlink(ch)->nextlink = newlink()) -> loc = dp;
  718.             return 0;
  719.         case 1:            /* absolute */
  720. #ifdef DEBUG
  721.             puts("defined absolute.");
  722. #endif DEBUG
  723.             return ch->defloc;
  724.         case 2:            /* relative */
  725. #ifdef DEBUG
  726.             puts("defined relative.");
  727. #endif DEBUG
  728.             return ch->defloc - dp;
  729.         default:
  730.             dicterr("Program error: bad type for chain");
  731.             return (0);
  732.         }
  733.     }
  734. }
  735.  
  736. CHAIN *lastchain()    /* starting from firstchain, find the last chain */
  737. {
  738.     CHAIN *ch = &firstchain;
  739.     while (ch->nextchain != NULL) ch = ch->nextchain;
  740.     return ch;
  741. }
  742.  
  743. LINK *lastlink(ch)    /* return the last link in the chain */
  744. CHAIN *ch;        /* CHAIN MUST HAVE AT LEAST ONE LINK */
  745. {
  746.     LINK *ln = ch->firstlink;
  747.  
  748.     while (ln->nextlink != NULL) ln = ln->nextlink;
  749.     return ln;
  750. }
  751.  
  752. yywrap()    /* called by yylex(). returning 1 means "all finished" */
  753. {
  754.     return 1;
  755. }
  756.