home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / perl / Source / C / Stab < prev    next >
Encoding:
Text File  |  1991-02-09  |  17.1 KB  |  751 lines
  1. /* $Header: stab.c,v 3.0.1.11 91/01/11 18:23:44 lwall Locked $
  2.  *
  3.  *    Copyright (c) 1989, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of the GNU General Public License
  6.  *    as specified in the README file that comes with the perl 3.0 kit.
  7.  *
  8.  * $Log:    stab.c,v $
  9.  * Revision 3.0.1.11  91/01/11  18:23:44  lwall
  10.  * patch42: added -0 option
  11.  * 
  12.  * Revision 3.0.1.10  90/11/10  02:02:05  lwall
  13.  * patch38: random cleanup
  14.  * 
  15.  * Revision 3.0.1.9  90/10/16  10:32:05  lwall
  16.  * patch29: added -M, -A and -C
  17.  * patch29: taintperl now checks for world writable PATH components
  18.  * patch29: *foo now prints as *package'foo
  19.  * patch29: scripts now run at almost full speed under the debugger
  20.  * patch29: package behavior is now more consistent
  21.  * 
  22.  * Revision 3.0.1.8  90/08/13  22:30:17  lwall
  23.  * patch28: the NSIG hack didn't work right on Xenix
  24.  * 
  25.  * Revision 3.0.1.7  90/08/09  05:17:48  lwall
  26.  * patch19: fixed double include of <signal.h>
  27.  * patch19: $' broke on embedded nulls
  28.  * patch19: $< and $> better supported on machines without setreuid
  29.  * patch19: Added support for linked-in C subroutines
  30.  * patch19: %ENV wasn't forced to be global like it should
  31.  * patch19: $| didn't work before the filehandle was opened
  32.  * patch19: $! now returns "" in string context if errno == 0
  33.  * 
  34.  * Revision 3.0.1.6  90/03/27  16:22:11  lwall
  35.  * patch16: support for machines that can't cast negative floats to unsigned ints
  36.  * 
  37.  * Revision 3.0.1.5  90/03/12  17:00:11  lwall
  38.  * patch13: undef $/ didn't work as advertised
  39.  * 
  40.  * Revision 3.0.1.4  90/02/28  18:19:14  lwall
  41.  * patch9: $0 is now always the command name
  42.  * patch9: you may now undef $/ to have no input record separator
  43.  * patch9: local($.) didn't work
  44.  * patch9: sometimes perl thought ordinary data was a symbol table entry
  45.  * patch9: stab_array() and stab_hash() weren't defined on MICROPORT
  46.  * 
  47.  * Revision 3.0.1.3  89/12/21  20:18:40  lwall
  48.  * patch7: ANSI strerror() is now supported
  49.  * patch7: errno may now be a macro with an lvalue
  50.  * patch7: in stab.c, sighandler() may now return either void or int
  51.  * 
  52.  * Revision 3.0.1.2  89/11/17  15:35:37  lwall
  53.  * patch5: sighandler() needed to be static
  54.  * 
  55.  * Revision 3.0.1.1  89/11/11  04:55:07  lwall
  56.  * patch2: sys_errlist[sys_nerr] is illegal
  57.  * 
  58.  * Revision 3.0  89/10/18  15:23:23  lwall
  59.  * 3.0 baseline
  60.  * 
  61.  */
  62.  
  63. #include "EXTERN.h"
  64. #include "perl.h"
  65.  
  66. #include <signal.h>
  67.  
  68. static char *sig_name[] = {
  69.     SIG_NAME,0
  70. };
  71.  
  72. #ifdef VOIDSIG
  73. #define handlertype void
  74. #else
  75. #define handlertype int
  76. #endif
  77.  
  78. static handlertype sighandler PROTO((int));
  79.  
  80. STR *
  81. stab_str(str)
  82. STR *str;
  83. {
  84.     STAB *stab = str->str_u.str_stab;
  85.     register int paren;
  86.     register char *s;
  87.     register int i;
  88.  
  89.     if (str->str_rare)
  90.     return stab_val(stab);
  91.  
  92.     switch (*stab->str_magic->str_ptr) {
  93.     case '\024':        /* ^T */
  94.     str_numset(stab_val(stab),(double)basetime);
  95.     break;
  96.     case '1': case '2': case '3': case '4':
  97.     case '5': case '6': case '7': case '8': case '9': case '&':
  98.     if (curspat) {
  99.         paren = atoi(stab_name(stab));
  100.       getparen:
  101.         if (curspat->spat_regexp &&
  102.           paren <= curspat->spat_regexp->nparens &&
  103.           (s = curspat->spat_regexp->startp[paren]) != Nullch) {
  104.         i = curspat->spat_regexp->endp[paren] - s;
  105.         if (i >= 0)
  106.             str_nset(stab_val(stab),s,i);
  107.         else
  108.             str_sset(stab_val(stab),&str_undef);
  109.         }
  110.         else
  111.         str_sset(stab_val(stab),&str_undef);
  112.     }
  113.     break;
  114.     case '+':
  115.     if (curspat) {
  116.         paren = curspat->spat_regexp->lastparen;
  117.         goto getparen;
  118.     }
  119.     break;
  120.     case '`':
  121.     if (curspat) {
  122.         if (curspat->spat_regexp &&
  123.           (s = curspat->spat_regexp->subbase) != Nullch) {
  124.         i = curspat->spat_regexp->startp[0] - s;
  125.         if (i >= 0)
  126.             str_nset(stab_val(stab),s,i);
  127.         else
  128.             str_nset(stab_val(stab),"",0);
  129.         }
  130.         else
  131.         str_nset(stab_val(stab),"",0);
  132.     }
  133.     break;
  134.     case '\'':
  135.     if (curspat) {
  136.         if (curspat->spat_regexp &&
  137.           (s = curspat->spat_regexp->endp[0]) != Nullch) {
  138.         str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
  139.         }
  140.         else
  141.         str_nset(stab_val(stab),"",0);
  142.     }
  143.     break;
  144.     case '.':
  145. #ifndef lint
  146.     if (last_in_stab) {
  147.         str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
  148.     }
  149. #endif
  150.     break;
  151.     case '?':
  152.     str_numset(stab_val(stab),(double)statusvalue);
  153.     break;
  154.     case '^':
  155.     s = stab_io(curoutstab)->top_name;
  156.     str_set(stab_val(stab),s);
  157.     break;
  158.     case '~':
  159.     s = stab_io(curoutstab)->fmt_name;
  160.     str_set(stab_val(stab),s);
  161.     break;
  162. #ifndef lint
  163.     case '=':
  164.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
  165.     break;
  166.     case '-':
  167.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
  168.     break;
  169.     case '%':
  170.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
  171.     break;
  172. #endif
  173.     case '/':
  174.     if (record_separator != 0777) {
  175.         *tokenbuf = record_separator;
  176.         tokenbuf[1] = '\0';
  177.         str_nset(stab_val(stab),tokenbuf,rslen);
  178.     }
  179.     break;
  180.     case '[':
  181.     str_numset(stab_val(stab),(double)arybase);
  182.     break;
  183.     case '|':
  184.     if (!stab_io(curoutstab))
  185.         stab_io(curoutstab) = stio_new();
  186.     str_numset(stab_val(stab),
  187.        (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
  188.     break;
  189.     case ',':
  190.     str_nset(stab_val(stab),ofs,ofslen);
  191.     break;
  192.     case '\\':
  193.     str_nset(stab_val(stab),ors,orslen);
  194.     break;
  195.     case '>':
  196.     str_set(stab_val(stab),getcwd(1,0));
  197.     break;
  198.     case '#':
  199.     str_set(stab_val(stab),ofmt);
  200.     break;
  201.     case '!':
  202.     str_numset(stab_val(stab), (double)err_no);
  203.     str_set(stab_val(stab), err_no ? err_mess : "");
  204.     stab_val(stab)->str_nok = 1;    /* what a wonderful hack! */
  205.     break;
  206.     default:
  207.     {
  208.         struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
  209.  
  210.         if (uf && uf->uf_val)
  211.         (*uf->uf_val)(uf->uf_index, stab_val(stab));
  212.     }
  213.     break;
  214.     }
  215.     return stab_val(stab);
  216. }
  217.  
  218. void
  219. stabset(mstr,str)
  220. register STR *mstr;
  221. STR *str;
  222. {
  223.     STAB *stab = mstr->str_u.str_stab;
  224.     char *s;
  225.     int i;
  226.  
  227.     switch (mstr->str_rare) {
  228.     case 'E':
  229.     setenv(mstr->str_ptr,str_get(str));
  230.                 /* And you'll never guess what the dog had */
  231.                 /*   in its mouth... */
  232. #ifdef TAINT
  233.     if (strEQ(mstr->str_ptr,"PATH")) {
  234.         char *strend = str->str_ptr + str->str_cur;
  235.  
  236.         s = str->str_ptr;
  237.         while (s < strend) {
  238.         s = cpytill(tokenbuf,s,strend,':',&i);
  239.         s++;
  240.         if (*tokenbuf != '/'
  241.           || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
  242.             str->str_tainted = 2;
  243.         }
  244.     }
  245. #endif
  246.     break;
  247.     case 'S':
  248.     s = str_get(str);
  249.     i = whichsig(mstr->str_ptr);    /* ...no, a brick */
  250.     if (strEQ(s,"IGNORE"))
  251. #ifndef lint
  252.         (void)signal(i,SIG_IGN);
  253. #else
  254.         ;
  255. #endif
  256.     else if (strEQ(s,"DEFAULT") || !*s)
  257.         (void)signal(i,SIG_DFL);
  258.     else {
  259.         (void)signal(i,sighandler);
  260.         if (!index(s,'\'')) {
  261.         sprintf(tokenbuf, "main'%s",s);
  262.         str_set(str,tokenbuf);
  263.         }
  264.     }
  265.     break;
  266. #ifdef SOME_DBM
  267.     case 'D':
  268.     hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
  269.     break;
  270. #endif
  271.     case 'L':
  272.     {
  273.         CMD *cmd;
  274.  
  275.         i = str_true(str);
  276.         str = afetch(stab_xarray(stab),atoi(mstr->str_ptr),FALSE);
  277.         cmd = str->str_magic->str_u.str_cmd;
  278.         cmd->c_flags &= ~CF_OPTIMIZE;
  279.         cmd->c_flags |= i? CFT_D1 : CFT_D0;
  280.     }
  281.     break;
  282.     case '#':
  283.     afill(stab_array(stab), (int)str_gnum(str) - arybase);
  284.     break;
  285.     case 'X':    /* merely a copy of a * string */
  286.     break;
  287.     case '*':
  288.     s = str_get(str);
  289.     if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
  290.         if (!*s) {
  291.         STBP *stbp;
  292.  
  293.         (void)savenostab(stab);    /* schedule a free of this stab */
  294.         if (stab->str_len)
  295.             Safefree(stab->str_ptr);
  296.         Newz(601,stbp, 1, STBP);
  297.         stab->str_ptr = stbp;
  298.         stab->str_len = stab->str_cur = sizeof(STBP);
  299.         stab->str_pok = 1;
  300.         strcpy(stab_magic(stab),"StB");
  301.         stab_val(stab) = Str_new(70,0);
  302.         stab_line(stab) = curcmd->c_line;
  303.         }
  304.         else {
  305.         stab = stabent(s,TRUE);
  306.         if (!stab_xarray(stab))
  307.             aadd(stab);
  308.         if (!stab_xhash(stab))
  309.             hadd(stab);
  310.         if (!stab_io(stab))
  311.             stab_io(stab) = stio_new();
  312.         }
  313.         str_sset(str,(STR *)stab);
  314.     }
  315.     break;
  316.     case 's': {
  317.         struct lstring *lstr = (struct lstring*)str;
  318.  
  319.         mstr->str_rare = 0;
  320.         str->str_magic = Nullstr;
  321.         str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
  322.           str->str_ptr,str->str_cur);
  323.     }
  324.     break;
  325.  
  326.     case 'v':
  327.     do_vecset(mstr,str);
  328.     break;
  329.  
  330.     case 0:
  331.     switch (*stab->str_magic->str_ptr) {
  332.     case '\024':    /* ^T */
  333.         basetime = (long)str_gnum(str);
  334.         break;
  335.     case '.':
  336.         if (localizing)
  337.         savesptr((STR**)&last_in_stab);
  338.         break;
  339.     case '^':
  340.         Safefree(stab_io(curoutstab)->top_name);
  341.         stab_io(curoutstab)->top_name = s = savestr(str_get(str));
  342.         stab_io(curoutstab)->top_stab = stabent(s,TRUE);
  343.         break;
  344.     case '~':
  345.         Safefree(stab_io(curoutstab)->fmt_name);
  346.         stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
  347.         stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
  348.         break;
  349.     case '=':
  350.         stab_io(curoutstab)->page_len = (long)str_gnum(str);
  351.         break;
  352.     case '-':
  353.         stab_io(curoutstab)->lines_left = (long)str_gnum(str);
  354.         if (stab_io(curoutstab)->lines_left < 0L)
  355.         stab_io(curoutstab)->lines_left = 0L;
  356.         break;
  357.     case '%':
  358.         stab_io(curoutstab)->page = (long)str_gnum(str);
  359.         break;
  360.     case '|':
  361.         if (!stab_io(curoutstab))
  362.         stab_io(curoutstab) = stio_new();
  363.         stab_io(curoutstab)->flags &= ~IOF_FLUSH;
  364.         if (str_gnum(str) != 0.0) {
  365.         stab_io(curoutstab)->flags |= IOF_FLUSH;
  366.         }
  367.         break;
  368.     case '*':
  369.         i = (int)str_gnum(str);
  370.         multiline = (i != 0);
  371.         break;
  372.     case '/':
  373.         if (str->str_pok) {
  374.         record_separator = *str_get(str);
  375.         rslen = str->str_cur;
  376.         }
  377.         else {
  378.         record_separator = 0777;    /* fake a non-existent char */
  379.         rslen = 1;
  380.         }
  381.         break;
  382.     case '\\':
  383.         if (ors)
  384.         Safefree(ors);
  385.         ors = savestr(str_get(str));
  386.         orslen = str->str_cur;
  387.         break;
  388.     case ',':
  389.         if (ofs)
  390.         Safefree(ofs);
  391.         ofs = savestr(str_get(str));
  392.         ofslen = str->str_cur;
  393.         break;
  394.     case '>':
  395.         chdir(str_get(str));
  396.         break;
  397.     case '#':
  398.         if (ofmt)
  399.         Safefree(ofmt);
  400.         ofmt = savestr(str_get(str));
  401.         break;
  402.     case '[':
  403.         arybase = (int)str_gnum(str);
  404.         break;
  405.     case '?':
  406.         statusvalue = U_S(str_gnum(str));
  407.         break;
  408.     case '!':
  409.         /* This is a bit weird, except for "$! = 0", but it's not
  410.          * very likely to be used other than for this...
  411.          */
  412.         if (looks_like_number(str)) {
  413.         err_no = (int)str_gnum(str);
  414.         if (err_no == 0)
  415.             strcpy(err_mess,"No error");
  416.         }
  417.         else
  418.         strcpy(err_mess, str_get(str));
  419.         break;
  420.     case ':':
  421.         chopset = str_get(str);
  422.         break;
  423.     default:
  424.         {
  425.         struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
  426.  
  427.         if (uf && uf->uf_set)
  428.             (*uf->uf_set)(uf->uf_index, str);
  429.         }
  430.         break;
  431.     }
  432.     break;
  433.     }
  434. }
  435.  
  436. int
  437. whichsig(sig)
  438. char *sig;
  439. {
  440.     register char **sigv;
  441.  
  442.     for (sigv = sig_name+1; *sigv; sigv++)
  443.     if (strEQ(sig,*sigv))
  444.         return sigv - sig_name;
  445. #ifdef SIGCLD
  446.     if (strEQ(sig,"CHLD"))
  447.     return SIGCLD;
  448. #endif
  449. #ifdef SIGCHLD
  450.     if (strEQ(sig,"CLD"))
  451.     return SIGCHLD;
  452. #endif
  453.     return 0;
  454. }
  455.  
  456. static handlertype
  457. sighandler(sig)
  458. int sig;
  459. {
  460.     STAB *stab;
  461.     ARRAY *savearray;
  462.     STR *str;
  463.     CMD *oldcurcmd = curcmd;
  464.     int oldsave = savestack->ary_fill;
  465.     ARRAY *oldstack = stack;
  466.     CSV *oldcurcsv = curcsv;
  467.     SUBR *sub;
  468.  
  469. #ifdef OS2        /* or anybody else who requires SIG_ACK */
  470.     signal(sig, SIG_ACK);
  471. #endif
  472.     curcsv = Nullcsv;
  473.     stab = stabent(
  474.     str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
  475.       TRUE)), TRUE);
  476.     sub = stab_sub(stab);
  477.     if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
  478.     if (sig_name[sig][1] == 'H')
  479.         stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
  480.           TRUE);
  481.     else
  482.         stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
  483.           TRUE);
  484.     sub = stab_sub(stab);    /* gag */
  485.     }
  486.     if (!sub) {
  487.     if (dowarn)
  488.         warn("SIG%s handler \"%s\" not defined.\n",
  489.         sig_name[sig], stab_name(stab) );
  490.     return;
  491.     }
  492.     savearray = stab_xarray(defstab);
  493.     stab_xarray(defstab) = stack = anew(defstab);
  494.     stack->ary_flags = 0;
  495.     str = Str_new(71,0);
  496.     str_set(str,sig_name[sig]);
  497.     (void)apush(stab_xarray(defstab),str);
  498.     sub->depth++;
  499.     if (sub->depth >= 2) {    /* save temporaries on recursion? */
  500.     if (sub->depth == 100 && dowarn)
  501.         warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
  502.     savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
  503.     }
  504.  
  505.     (void)cmd_exec(sub->cmd,G_SCALAR,1);        /* so do it already */
  506.  
  507.     sub->depth--;    /* assuming no longjumps out of here */
  508.     str_free(stack->ary_array[0]);    /* free the one real string */
  509.     afree(stab_xarray(defstab));  /* put back old $_[] */
  510.     stab_xarray(defstab) = savearray;
  511.     stack = oldstack;
  512.     if (savestack->ary_fill > oldsave)
  513.     restorelist(oldsave);
  514.     curcmd = oldcurcmd;
  515.     curcsv = oldcurcsv;
  516. }
  517.  
  518. STAB *
  519. aadd(stab)
  520. register STAB *stab;
  521. {
  522.     if (!stab_xarray(stab))
  523.     stab_xarray(stab) = anew(stab);
  524.     return stab;
  525. }
  526.  
  527. STAB *
  528. hadd(stab)
  529. register STAB *stab;
  530. {
  531.     if (!stab_xhash(stab))
  532.     stab_xhash(stab) = hnew(COEFFSIZE);
  533.     return stab;
  534. }
  535.  
  536. STAB *
  537. fstab(name)
  538. char *name;
  539. {
  540.     char tmpbuf[1200];
  541.     STAB *stab;
  542.  
  543.     sprintf(tmpbuf,"'_<%s", name);
  544.     stab = stabent(tmpbuf, TRUE);
  545.     str_set(stab_val(stab), name);
  546.     if (perldb)
  547.     (void)hadd(aadd(stab));
  548.     return stab;
  549. }
  550.  
  551. STAB *
  552. stabent(name,add)
  553. register char *name;
  554. int add;
  555. {
  556.     register STAB *stab;
  557.     register STBP *stbp;
  558.     int len;
  559.     register char *namend;
  560.     HASH *stash;
  561.     char *sawquote = Nullch;
  562.     char *prevquote = Nullch;
  563.     bool global = FALSE;
  564.  
  565.     if (isascii(*name) && isupper(*name)) {
  566.     if (*name > 'I') {
  567.         if (*name == 'S' && (
  568.           strEQ(name, "SIG") ||
  569.           strEQ(name, "STDIN") ||
  570.           strEQ(name, "STDOUT") ||
  571.           strEQ(name, "STDERR") ))
  572.         global = TRUE;
  573.     }
  574.     else if (*name > 'E') {
  575.         if (*name == 'I' && strEQ(name, "INC"))
  576.         global = TRUE;
  577.     }
  578.     else if (*name > 'A') {
  579.         if (*name == 'E' && strEQ(name, "ENV"))
  580.         global = TRUE;
  581.     }
  582.     else if (*name == 'A' && (
  583.       strEQ(name, "ARGV") ||
  584.       strEQ(name, "ARGVOUT") ))
  585.         global = TRUE;
  586.     }
  587.     for (namend = name; *namend; namend++) {
  588.     if (*namend == '\'' && namend[1])
  589.         prevquote = sawquote, sawquote = namend;
  590.     }
  591.     if (sawquote == name && name[1]) {
  592.     stash = defstash;
  593.     sawquote = Nullch;
  594.     name++;
  595.     }
  596.     else if (!isalpha(*name) || global)
  597.     stash = defstash;
  598.     else if (curcmd == &compiling)
  599.     stash = curstash;
  600.     else
  601.     stash = curcmd->c_stash;
  602.     if (sawquote) {
  603.     char tmpbuf[256];
  604.     char *s, *d;
  605.  
  606.     *sawquote = '\0';
  607.     if ((s = prevquote) != Nullch) {
  608.         strncpy(tmpbuf,name,s-name+1);
  609.         d = tmpbuf+(s-name+1);
  610.         *d++ = '_';
  611.         strcpy(d,s+1);
  612.     }
  613.     else {
  614.         *tmpbuf = '_';
  615.         strcpy(tmpbuf+1,name);
  616.     }
  617.     stab = stabent(tmpbuf,TRUE);
  618.     if ((stash = stab_xhash(stab)) == Null(HASH*))
  619.         stash = stab_xhash(stab) = hnew(0);
  620.     if (!stash->tbl_name)
  621.         stash->tbl_name = savestr(name);
  622.     name = sawquote+1;
  623.     *sawquote = '\'';
  624.     }
  625.     len = namend - name;
  626.     stab = (STAB*)hfetch(stash,name,len,add);
  627.     if (stab == (STAB*)&str_undef)
  628.     return Nullstab;
  629.     if (stab->str_pok) {
  630.     stab->str_pok |= SP_MULTI;
  631.     return stab;
  632.     }
  633.     else {
  634.     if (stab->str_len)
  635.         Safefree(stab->str_ptr);
  636.     Newz(602,stbp, 1, STBP);
  637.     stab->str_ptr = stbp;
  638.     stab->str_len = stab->str_cur = sizeof(STBP);
  639.     stab->str_pok = 1;
  640.     strcpy(stab_magic(stab),"StB");
  641.     stab_val(stab) = Str_new(72,0);
  642.     stab_line(stab) = curcmd->c_line;
  643.     str_magic((STR *)stab,stab,'*',name,len);
  644.     stab_stash(stab) = stash;
  645.     return stab;
  646.     }
  647. }
  648.  
  649. void
  650. stab_fullname(str,stab)
  651. STR *str;
  652. STAB *stab;
  653. {
  654.     str_set(str,stab_stash(stab)->tbl_name);
  655.     str_ncat(str,"'", 1);
  656.     str_scat(str,stab->str_magic);
  657. }
  658.  
  659. STIO *
  660. stio_new()
  661. {
  662.     STIO *stio;
  663.  
  664.     Newz(603,stio,1,STIO);
  665.     stio->page_len = 60;
  666.     return stio;
  667. }
  668.  
  669. void
  670. stab_check(min,max)
  671. int min;
  672. register int max;
  673. {
  674.     register HENT *entry;
  675.     register int i;
  676.     register STAB *stab;
  677.  
  678.     for (i = min; i <= max; i++) {
  679.     for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
  680.         stab = (STAB*)entry->hent_val;
  681.         if (stab->str_pok & SP_MULTI)
  682.         continue;
  683.         curcmd->c_line = stab_line(stab);
  684.         warn("Possible typo: \"%s\"", stab_name(stab));
  685.     }
  686.     }
  687. }
  688.  
  689. static int gensym = 0;
  690.  
  691. STAB *
  692. genstab()
  693. {
  694.     (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
  695.     return stabent(tokenbuf,TRUE);
  696. }
  697.  
  698. /* hopefully this is only called on local symbol table entries */
  699.  
  700. void
  701. stab_clear(stab)
  702. register STAB *stab;
  703. {
  704.     STIO *stio;
  705.     SUBR *sub;
  706.  
  707.     afree(stab_xarray(stab));
  708.     (void)hfree(stab_xhash(stab), FALSE);
  709.     str_free(stab_val(stab));
  710.     if ((stio = stab_io(stab)) != Null(STIO*)) {
  711.     do_close(stab,FALSE);
  712.     Safefree(stio->top_name);
  713.     Safefree(stio->fmt_name);
  714. #ifdef ARM
  715.     Safefree(stio->name);
  716. #endif
  717.     }
  718.     if ((sub = stab_sub(stab)) != Null(SUBR*)) {
  719.     afree(sub->tosave);
  720.     cmd_free(sub->cmd);
  721.     }
  722.     Safefree(stab->str_ptr);
  723.     stab->str_ptr = Null(STBP*);
  724.     stab->str_len = 0;
  725.     stab->str_cur = 0;
  726. }
  727.  
  728. #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
  729. #define MICROPORT
  730. #endif
  731.  
  732. #ifdef    MICROPORT    /* Microport 2.4 hack */
  733. ARRAY *stab_array(stab)
  734. register STAB *stab;
  735. {
  736.     if (((STBP*)(stab->str_ptr))->stbp_array) 
  737.     return ((STBP*)(stab->str_ptr))->stbp_array;
  738.     else
  739.     return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
  740. }
  741.  
  742. HASH *stab_hash(stab)
  743. register STAB *stab;
  744. {
  745.     if (((STBP*)(stab->str_ptr))->stbp_hash)
  746.     return ((STBP*)(stab->str_ptr))->stbp_hash;
  747.     else
  748.     return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
  749. }
  750. #endif            /* Microport 2.4 hack */
  751.