2.11BSD#431 - /usr/src/new/PORT/perl.1.0.16/stab.c

   1: /* $Header: stab.c,v 1.0.1.2 88/02/02 11:25:53 root Exp $
   2:  *
   3:  * $Log:	stab.c,v $
   4:  * Revision 1.0.1.2  88/02/02  11:25:53  root
   5:  * patch13: moved extern int out of function for a poor Xenix machine.
   6:  *
   7:  * Revision 1.0.1.1  88/01/28  10:35:17  root
   8:  * patch8: changed some stabents to support eval operator.
   9:  *
  10:  * Revision 1.0  87/12/18  13:06:14  root
  11:  * Initial revision
  12:  *
  13:  */
  14: 
  15: #include <signal.h>
  16: #include <errno.h>
  17: #include "handy.h"
  18: #include "EXTERN.h"
  19: #include "search.h"
  20: #include "util.h"
  21: #include "perl.h"
  22: 
  23: static char *sig_name[] = {
  24:     "",
  25:     "HUP",
  26:     "INT",
  27:     "QUIT",
  28:     "ILL",
  29:     "TRAP",
  30:     "IOT",
  31:     "EMT",
  32:     "FPE",
  33:     "KILL",
  34:     "BUS",
  35:     "SEGV",
  36:     "SYS",
  37:     "PIPE",
  38:     "ALRM",
  39:     "TERM",
  40:     "???"
  41: #ifdef SIGTSTP
  42:     ,"STOP",
  43:     "TSTP",
  44:     "CONT",
  45:     "CHLD",
  46:     "TTIN",
  47:     "TTOU",
  48:     "TINT",
  49:     "XCPU",
  50:     "XFSZ"
  51: #ifdef SIGPROF
  52:     ,"VTALARM",
  53:     "PROF"
  54: #ifdef SIGWINCH
  55:     ,"WINCH"
  56: #ifdef SIGLOST
  57:     ,"LOST"
  58: #ifdef SIGUSR1
  59:     ,"USR1"
  60: #endif
  61: #ifdef SIGUSR2
  62:     ,"USR2"
  63: #endif /* SIGUSR2 */
  64: #endif /* SIGLOST */
  65: #endif /* SIGWINCH */
  66: #endif /* SIGPROF */
  67: #endif /* SIGTSTP */
  68:     ,0
  69:     };
  70: 
  71: STR *
  72: stab_str(stab)
  73: STAB *stab;
  74: {
  75:     register int paren;
  76:     register char *s;
  77: 
  78:     switch (*stab->stab_name) {
  79:     case '0': case '1': case '2': case '3': case '4':
  80:     case '5': case '6': case '7': case '8': case '9': case '&':
  81:     if (curspat) {
  82:         paren = atoi(stab->stab_name);
  83:         if (curspat->spat_compex.subend[paren] &&
  84:           (s = getparen(&curspat->spat_compex,paren))) {
  85:         curspat->spat_compex.subend[paren] = Nullch;
  86:         str_set(stab->stab_val,s);
  87:         }
  88:     }
  89:     break;
  90:     case '+':
  91:     if (curspat) {
  92:         paren = curspat->spat_compex.lastparen;
  93:         if (curspat->spat_compex.subend[paren] &&
  94:           (s = getparen(&curspat->spat_compex,paren))) {
  95:         curspat->spat_compex.subend[paren] = Nullch;
  96:         str_set(stab->stab_val,s);
  97:         }
  98:     }
  99:     break;
 100:     case '.':
 101:     if (last_in_stab) {
 102:         str_numset(stab->stab_val,(double)last_in_stab->stab_io->lines);
 103:     }
 104:     break;
 105:     case '?':
 106:     str_numset(stab->stab_val,(double)statusvalue);
 107:     break;
 108:     case '^':
 109:     s = curoutstab->stab_io->top_name;
 110:     str_set(stab->stab_val,s);
 111:     break;
 112:     case '~':
 113:     s = curoutstab->stab_io->fmt_name;
 114:     str_set(stab->stab_val,s);
 115:     break;
 116:     case '=':
 117:     str_numset(stab->stab_val,(double)curoutstab->stab_io->lines);
 118:     break;
 119:     case '-':
 120:     str_numset(stab->stab_val,(double)curoutstab->stab_io->lines_left);
 121:     break;
 122:     case '%':
 123:     str_numset(stab->stab_val,(double)curoutstab->stab_io->page);
 124:     break;
 125:     case '(':
 126:     if (curspat) {
 127:         str_numset(stab->stab_val,(double)(curspat->spat_compex.subbeg[0] -
 128:         curspat->spat_compex.subbase));
 129:     }
 130:     break;
 131:     case ')':
 132:     if (curspat) {
 133:         str_numset(stab->stab_val,(double)(curspat->spat_compex.subend[0] -
 134:         curspat->spat_compex.subbeg[0]));
 135:     }
 136:     break;
 137:     case '/':
 138:     *tokenbuf = record_separator;
 139:     tokenbuf[1] = '\0';
 140:     str_set(stab->stab_val,tokenbuf);
 141:     break;
 142:     case '[':
 143:     str_numset(stab->stab_val,(double)arybase);
 144:     break;
 145:     case '|':
 146:     str_numset(stab->stab_val,
 147:        (double)((curoutstab->stab_io->flags & IOF_FLUSH) != 0) );
 148:     break;
 149:     case ',':
 150:     str_set(stab->stab_val,ofs);
 151:     break;
 152:     case '\\':
 153:     str_set(stab->stab_val,ors);
 154:     break;
 155:     case '#':
 156:     str_set(stab->stab_val,ofmt);
 157:     break;
 158:     case '!':
 159:     str_numset(stab->stab_val,(double)errno);
 160:     break;
 161:     }
 162:     return stab->stab_val;
 163: }
 164: 
 165: stabset(stab,str)
 166: register STAB *stab;
 167: STR *str;
 168: {
 169:     char *s;
 170:     int i;
 171:     int sighandler();
 172: 
 173:     if (stab->stab_flags & SF_VMAGIC) {
 174:     switch (stab->stab_name[0]) {
 175:     case '^':
 176:         safefree(curoutstab->stab_io->top_name);
 177:         curoutstab->stab_io->top_name = str_get(str);
 178:         curoutstab->stab_io->top_stab = stabent(str_get(str),TRUE);
 179:         break;
 180:     case '~':
 181:         /* FIXME: investigate more carefully.  When the following
 182: 	     * safefree is allowed to happen the subsequent stabent call
 183: 	     * results in a segfault.  Commenting it out is a cheap band-aid
 184: 	     * and probably a memory leak rolled into one
 185: 	     * 	-- richardc 2002-08-14
 186: 	     */
 187:         /* safefree(curoutstab->stab_io->fmt_name); */
 188:         curoutstab->stab_io->fmt_name = str_get(str);
 189:         curoutstab->stab_io->fmt_stab = stabent(str_get(str),TRUE);
 190:         break;
 191:     case '=':
 192:         curoutstab->stab_io->page_len = (long)str_gnum(str);
 193:         break;
 194:     case '-':
 195:         curoutstab->stab_io->lines_left = (long)str_gnum(str);
 196:         break;
 197:     case '%':
 198:         curoutstab->stab_io->page = (long)str_gnum(str);
 199:         break;
 200:     case '|':
 201:         curoutstab->stab_io->flags &= ~IOF_FLUSH;
 202:         if (str_gnum(str) != 0.0) {
 203:         curoutstab->stab_io->flags |= IOF_FLUSH;
 204:         }
 205:         break;
 206:     case '*':
 207:         multiline = (int)str_gnum(str) != 0;
 208:         break;
 209:     case '/':
 210:         record_separator = *str_get(str);
 211:         break;
 212:     case '\\':
 213:         if (ors)
 214:         safefree(ors);
 215:         ors = savestr(str_get(str));
 216:         break;
 217:     case ',':
 218:         if (ofs)
 219:         safefree(ofs);
 220:         ofs = savestr(str_get(str));
 221:         break;
 222:     case '#':
 223:         if (ofmt)
 224:         safefree(ofmt);
 225:         ofmt = savestr(str_get(str));
 226:         break;
 227:     case '[':
 228:         arybase = (int)str_gnum(str);
 229:         break;
 230:     case '!':
 231:         errno = (int)str_gnum(str);     /* will anyone ever use this? */
 232:         break;
 233:     case '.':
 234:     case '+':
 235:     case '&':
 236:     case '0':
 237:     case '1':
 238:     case '2':
 239:     case '3':
 240:     case '4':
 241:     case '5':
 242:     case '6':
 243:     case '7':
 244:     case '8':
 245:     case '9':
 246:     case '(':
 247:     case ')':
 248:         break;      /* "read-only" registers */
 249:     }
 250:     }
 251:     else if (stab == envstab && envname) {
 252:     PL_setenv(envname,str_get(str));
 253:                 /* And you'll never guess what the dog had */
 254:     safefree(envname);  /*   in its mouth... */
 255:     envname = Nullch;
 256:     }
 257:     else if (stab == sigstab && signame) {
 258:     s = str_get(str);
 259:     i = whichsig(signame);  /* ...no, a brick */
 260:     if (strEQ(s,"IGNORE"))
 261:         signal(i,SIG_IGN);
 262:     else if (strEQ(s,"DEFAULT") || !*s)
 263:         signal(i,SIG_DFL);
 264:     else
 265:         signal(i,sighandler);
 266:     safefree(signame);
 267:     signame = Nullch;
 268:     }
 269: }
 270: 
 271: whichsig(signame)
 272: char *signame;
 273: {
 274:     register char **sigv;
 275: 
 276:     for (sigv = sig_name+1; *sigv; sigv++)
 277:     if (strEQ(signame,*sigv))
 278:         return sigv - sig_name;
 279:     return 0;
 280: }
 281: 
 282: sighandler(sig)
 283: int sig;
 284: {
 285:     STAB *stab;
 286:     ARRAY *savearray;
 287:     STR *str;
 288: 
 289:     stab = stabent(str_get(hfetch(sigstab->stab_hash,sig_name[sig])),TRUE);
 290:     savearray = defstab->stab_array;
 291:     defstab->stab_array = anew();
 292:     str = str_new(0);
 293:     str_set(str,sig_name[sig]);
 294:     apush(defstab->stab_array,str);
 295:     str = cmd_exec(stab->stab_sub);
 296:     afree(defstab->stab_array);  /* put back old $_[] */
 297:     defstab->stab_array = savearray;
 298: }
 299: 
 300: char *
 301: reg_get(name)
 302: char *name;
 303: {
 304:     return STAB_GET(stabent(name,TRUE));
 305: }
 306: 
 307: #ifdef NOTUSED
 308: reg_set(name,value)
 309: char *name;
 310: char *value;
 311: {
 312:     str_set(STAB_STR(stabent(name,TRUE)),value);
 313: }
 314: #endif
 315: 
 316: STAB *
 317: aadd(stab)
 318: register STAB *stab;
 319: {
 320:     if (!stab->stab_array)
 321:     stab->stab_array = anew();
 322:     return stab;
 323: }
 324: 
 325: STAB *
 326: hadd(stab)
 327: register STAB *stab;
 328: {
 329:     if (!stab->stab_hash)
 330:     stab->stab_hash = hnew();
 331:     return stab;
 332: }

Defined functions

Defined variables