4.3BSD - /usr/src/new/icon/pilib/init.c

   1: /*
   2:  * Initialization and error routines.
   3:  */
   4: 
   5: #include "../h/rt.h"
   6: #include "../h/gc.h"
   7: #include <signal.h>
   8: #include <sys/types.h>
   9: #include <sys/times.h>
  10: #define MAXHDRLN    100     /* max len of #! line */
  11: #define MAXHDR      1024L       /* size of autoloading header--!! must
  12: 					    agree with that in link/ilink.c */
  13: char *file = "";            /* source program file name */
  14: int line = 0;               /* source program line number */
  15: char *code;             /* interpreter code buffer */
  16: int *records;               /* ptr to record procedure blocks */
  17: int *ftab;              /* ptr to record/field table */
  18: struct descrip *globals, *eglobals; /* ptr to global variables */
  19: struct descrip *gnames, *egnames;   /* ptr to global variable names */
  20: struct descrip *statics, *estatics; /* ptr to static variables */
  21: char *ident;                /* ptr to identifier table */
  22: int *monbuf;                /* monitor buffer for profiling */
  23: int monres = 0;             /* resolution of monitor buffer */
  24: int monsize = 0;            /* size of monitor buffer */
  25: 
  26: int numbufs = NUMBUF;           /* number of i/o buffers */
  27: char (*bufs)[BUFSIZ];           /* pointer to buffers */
  28: FILE **bufused;             /* pointer to buffer use markers */
  29: 
  30: int nstacks = MAXSTACKS;        /* initial number of coexpr stacks */
  31: int stksize = STACKSIZE;        /* coexpression stack size */
  32: int dodump;             /* if non-zero, core dump on error */
  33: int noerrbuf;               /* if non-zero, DON'T buffer stderr */
  34: int *stacks;                /* start of stack space */
  35: int *estacks;               /* end of stack space */
  36: int *esfree;                /* stack space free list pointer */
  37: 
  38: int ssize = MAXSTRSPACE;        /* initial string space size (bytes) */
  39: char *strings;              /* start of string space */
  40: char *estrings;             /* end of string space */
  41: char *sfree;                /* string space free pointer */
  42: 
  43: int hpsize = MAXHEAPSIZE;       /* initial heap size (bytes) */
  44: char *hpbase;               /* start of heap */
  45: char *maxheap;              /* end of heap storage */
  46: char *hpfree;               /* heap free space pointer */
  47: unsigned heapneed;          /* stated need for heap space */
  48: unsigned strneed;           /* stated need for string space */
  49: 
  50: struct descrip **sqlist;        /* string qualifier list */
  51: struct descrip **sqfree;        /* s. q. list free pointer */
  52: struct descrip **esqlist;       /* end of s. q. list */
  53: 
  54: struct descrip current;         /* current expression stack pointer */
  55: 
  56: /*
  57:  * &ascii cset, first 128 bits on, second 128 bits off.
  58:  */
  59: struct b_cset  k_ascii = {
  60:    T_CSET,
  61:    cset_display(~0, ~0, ~0, ~0, ~0, ~0, ~0, ~0,
  62:                  0,  0,  0,  0,  0,  0,  0,  0)
  63:    };
  64: 
  65: /*
  66:  * &cset cset, all 256 bits on.
  67:  */
  68: struct b_cset  k_cset = {
  69:    T_CSET,
  70:    cset_display(~0, ~0, ~0, ~0, ~0, ~0, ~0, ~0,
  71:                 ~0, ~0, ~0, ~0, ~0, ~0, ~0, ~0)
  72:    };
  73: 
  74: /*
  75:  * File block for &errout.
  76:  */
  77: struct b_file  k_errout = {
  78:    T_FILE,
  79:    stderr,
  80:    FS_WRITE,
  81:    7,
  82:    /*"&errout", */
  83:    };
  84: 
  85: /*
  86:  * File block for &input.
  87:  */
  88: struct b_file  k_input = {
  89:    T_FILE,
  90:    stdin,
  91:    FS_READ,
  92:    6,
  93:    /*"&input",*/
  94:    };
  95: 
  96: /*
  97:  * cset for &lcase, bits corresponding to lowercase letters are on.
  98:  */
  99: struct b_cset  k_lcase = {
 100:    T_CSET,
 101:    cset_display( 0,  0,  0,  0,  0,  0, ~01, 03777,
 102:                  0,  0,  0,  0,  0,  0,  0,  0)
 103:    };
 104: 
 105: int            k_level = 0;     /* &level */
 106: struct descrip k_main;          /* &main */
 107: int            k_pos = 1;       /* &pos */
 108: 
 109: /*
 110:  * File block for &output.
 111:  */
 112: struct b_file  k_output = {
 113:    T_FILE,
 114:    stdout,
 115:    FS_WRITE,
 116:    7,
 117:    /*"&output",*/
 118:    };
 119: 
 120: long           k_random = 0L;       /* &random */
 121: struct descrip k_subject = {        /* &subject */
 122:    0,
 123:    /*1,*/
 124:    };
 125: int k_trace = 0;
 126: /*
 127:  * cset for &ucase, bits corresponding to uppercase characters are on.
 128:  */
 129: struct b_cset  k_ucase = {
 130:    T_CSET,
 131:     cset_display(0,  0,  0,  0, ~01, 03777, 0, 0,
 132:                  0,  0,  0,  0,  0,  0,  0,  0)
 133:    };
 134: 
 135: /*
 136:  * maps2 and maps3 are used by the map function as caches.
 137:  */
 138: struct descrip maps2 = {
 139:    D_NULL,
 140:    /*0,*/
 141:    };
 142: struct descrip maps3 = {
 143:    D_NULL,
 144:    /*0,*/
 145:    };
 146: 
 147: long starttime;             /* starttime of job in milliseconds */
 148: 
 149: struct descrip nulldesc = {D_NULL, /*0*/};
 150: struct descrip zerodesc = {D_INTEGER, /*0*/};
 151: struct descrip onedesc  = {D_INTEGER, /*1*/};
 152: struct descrip nullstr  = {0, /*""*/};
 153: struct descrip blank    = {1, /*" "*/};
 154: struct descrip letr     = {1, /*"r"*/};
 155: struct descrip input    = {D_FILE, /*&k_input*/};
 156: struct descrip errout   = {D_FILE, /*&k_errout*/};
 157: struct descrip lcase    = {26, /*lowercase*/};
 158: struct descrip ucase    = {26, /*uppercase*/};
 159: 
 160: static struct b_estack mainhead;    /* expression stack head for main */
 161: 
 162: /*
 163:  * init - initialize memory and prepare for Icon execution.
 164:  */
 165: 
 166: #ifdef VAX
 167: init(name)
 168: #endif VAX
 169: #ifdef PORT
 170: init(name)
 171: #endif PORT
 172: #ifdef PDP11
 173: init(nargs, name)
 174: int nargs;
 175: #endif PDP11
 176: char *name;
 177:    {
 178:    register int i;
 179:    int cbread;
 180:    int f;
 181:    FILE *ufile;
 182:    char uheader[MAXHDRLN];
 183:    int directex;
 184:    /*
 185:     * Interpretable file header
 186:     */
 187:    struct header {
 188:       int size;         /* size of icode file */
 189:       int trace;        /* initial value of &trace */
 190:       int records;      /* records */
 191:       int ftab;         /* record field table */
 192:       int globals;      /* global array */
 193:       int gnames;       /* global name array */
 194:       int statics;      /* static array */
 195:       int ident;        /* strings for identifiers, etc. */
 196:       } hdr;
 197:    struct tms tp;
 198:    extern char *brk(), end;
 199:    extern char Pstart, Pstop;
 200:    extern fpetrap(), segvtrap();
 201: 
 202:    /*
 203:     * Catch floating point traps and memory faults.
 204:     */
 205:    signal(SIGFPE, fpetrap);
 206:    signal(SIGSEGV, segvtrap);
 207: 
 208:    /*
 209:     * Initializations that can't be performed statically.
 210:     */
 211:    STRLOC(k_errout.fname)   = "&errout";
 212:    STRLOC(k_input.fname)    = "&input";
 213:    STRLOC(k_output.fname)   = "&output";
 214:    STRLOC(k_subject)        = (char *) 1;
 215:    STRLOC(maps2)        = 0;
 216:    STRLOC(maps3)        = 0;
 217:    STRLOC(nulldesc)     = 0;
 218:    INTVAL(zerodesc)     = 0;
 219:    INTVAL(onedesc)      = 1;
 220:    STRLOC(nullstr)      = "";
 221:    STRLOC(blank)        = " ";
 222:    STRLOC(letr)         = "r";
 223:    BLKLOC(input)        = (union block *) &k_input;
 224:    BLKLOC(errout)       = (union block *) &k_errout;
 225:    STRLOC(lcase)        = "abcdefghijklmnopqrstuvwxyz";
 226:    STRLOC(ucase)        = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
 227: 
 228:    /*
 229:     * Initialize &main.
 230:     */
 231:    mainhead.type = T_ESTACK;
 232:    mainhead.activator.type = D_NULL;
 233:    STRLOC(mainhead.activator) = NULL;
 234:    mainhead.sbase = (int *)(STKBASE);
 235:    mainhead.sp = NULL;
 236:    mainhead.boundary = NULL;
 237:    mainhead.nresults = 0;
 238:    mainhead.freshblk.type = D_NULL;
 239:    STRLOC(mainhead.freshblk)  = 0;
 240: 
 241:    /*
 242:     * Open the interpretable file and read the header.
 243:     */
 244:    i = strlen(name);
 245:    f = open(name, 0);
 246:    if (f < 0)
 247:       error("can't open interpreter file");
 248:    /*
 249:     * We check to see if the header starts with #! and if so, we assume
 250:     *  that it is being directly executed and seek past the header.
 251:     */
 252:    ufile = fdopen(f,"r");
 253:    fgets(uheader,MAXHDRLN,ufile);
 254:    if (strncmp(uheader,"#!",2) != 0) {
 255:       fseek(ufile,MAXHDR,0);
 256:       fgets(uheader,MAXHDRLN,ufile);
 257:       if (strncmp(uheader,"#!",2) == 0)
 258:          lseek(f,MAXHDR+(long)strlen(uheader),0);
 259:       else
 260:         error("invalid format for interpretable file");
 261:         }
 262:    else
 263:       lseek(f,(long)strlen(uheader),0);
 264: 
 265:    if (read(f, &hdr, sizeof hdr) != sizeof hdr)
 266:       error("can't read interpreter file header");
 267: 
 268:    /*
 269:     * Establish pointers to data regions.
 270:     */
 271:    code = (char *) sbrk(0);
 272:    k_trace = hdr.trace;
 273:    records = (int *) (code + hdr.records);
 274:    ftab = (int *) (code + hdr.ftab);
 275:    globals = (struct descrip *) (code + hdr.globals);
 276:    gnames = eglobals = (struct descrip *) (code + hdr.gnames);
 277:    statics = egnames = (struct descrip *) (code + hdr.statics);
 278:    estatics = (struct descrip *) (code + hdr.ident);
 279:    ident = (char *) estatics;
 280: 
 281:    /*
 282:     * Examine the environment and make appropriate settings.
 283:     */
 284:    envlook();
 285: 
 286:    /*
 287:     * Set up stuff for monitoring.
 288:     */
 289:    if (monres > 0)
 290:       monsize = (&Pstop - &Pstart + monres - 1) / monres;
 291:    monbuf = (int *)((int)(code + hdr.size + 1) & ~01);
 292: 
 293:    /*
 294:     * Set up allocated memory.  The regions are:
 295:     *	Monitoring buffer
 296:     *	Co-expression stacks
 297:     *	String space
 298:     *	Heap
 299:     *	String qualifier list
 300:     */
 301:     bufs = (char **) (monbuf + monsize);
 302:    bufused = (FILE **) (bufs + numbufs);
 303:    stacks = (int *)(((int)(bufused + numbufs) + 63)  & ~077);
 304:    estacks = stacks + nstacks * stksize;
 305:    sfree = strings = (char *)((int)(estacks + 63) & ~077);
 306:    hpfree = hpbase = estrings = (char *)((int)(strings + ssize + 63) & ~077);
 307:    sqlist = sqfree = esqlist =
 308:     (struct descrip **)(maxheap = (char *)((int)(hpbase + hpsize + 63) & ~077));
 309: 
 310:    /*
 311:     * Try to move the break back to the end of memory to allocate (the
 312:     *  end of the string qualifier list) and die if the space isn't
 313:     *  available.
 314:     */
 315:    if (brk(esqlist))
 316:       error("insufficient memory");
 317: 
 318:    /*
 319:     * Read the interpretable code and data into memory.
 320:     */
 321:    if ((cbread = read(f, code, hdr.size)) != hdr.size) {
 322:       fprintf(stderr,"Tried to read %d bytes of code, and got %d\n",
 323:         hdr.size,cbread);
 324:       error("can't read interpreter code");
 325:       }
 326:    close(f);
 327: 
 328:    /*
 329:     * Resolve references from icode to runtime system.
 330:     */
 331:    resolve();
 332: 
 333:    /*
 334:     * Establish linked list of free co-expression stacks.  esfree
 335:     *  is the base.
 336:     */
 337:    esfree = NULL;
 338:    for (i = nstacks-1; i >= 0; i--) {
 339:       *(stacks + (i * stksize)) = (int) esfree;
 340:       esfree = stacks + (i * stksize);
 341:       *(esfree+(stksize-sizeof(struct b_estack)/WORDSIZE)) = T_ESTACK;
 342:       }
 343: 
 344:    /*
 345:     * Mark all buffers as available.
 346:     */
 347:    for (i = 0; i < numbufs; i++)
 348:       bufused[i] = NULL;
 349: 
 350:    /*
 351:     * Buffer stdin if a buffer is available.
 352:     */
 353:    if (numbufs >= 1) {
 354:       setbuf(stdin, bufs[0]);
 355:       bufused[0] = stdin;
 356:       }
 357:    else
 358:       setbuf(stdin, NULL);
 359: 
 360:    /*
 361:     * Buffer stdout if a buffer is available.
 362:     */
 363:    if (numbufs >= 2) {
 364:       setbuf(stdout, bufs[1]);
 365:       bufused[1] = stdout;
 366:       }
 367:    else
 368:       setbuf(stdout, NULL);
 369: 
 370:    /*
 371:     * Buffer stderr if a buffer is available.
 372:     */
 373:    if (numbufs >= 3 && !noerrbuf) {
 374:       setbuf(stderr, bufs[2]);
 375:       bufused[2] = stderr;
 376:       }
 377:    else
 378:       setbuf(stderr, NULL);
 379: 
 380:    /*
 381:     * Point &main at the stack for the main procedure and set current,
 382:     *  the pointer to the current co-expression to &main.
 383:     */
 384:    k_main.type = D_ESTACK;
 385:    BLKLOC(k_main) = (union block *) &mainhead;
 386:    current = k_main;
 387: 
 388: #ifdef AZ_NEVER
 389:    /*
 390:     * Turn on monitoring if so directed.
 391:     */
 392:    if (monres > 0)
 393:       monitor(&Pstart, &Pstop, monbuf, monsize, 0);
 394: #endif AZ_NEVER
 395: 
 396:    /*
 397:     * Get startup time.
 398:     */
 399:    times(&tp);
 400:    starttime = tp.tms_utime;
 401:    }
 402: 
 403: /*
 404:  * Check for environment variables that Icon uses and set system
 405:  *  values as is appropriate.
 406:  */
 407: envlook()
 408:    {
 409:    register char *p;
 410:    extern char *getenv();
 411: 
 412:    if ((p = getenv("TRACE")) != NULL && *p != '\0')
 413:       k_trace = atoi(p);
 414:    if ((p = getenv("NBUFS")) != NULL && *p != '\0')
 415:       numbufs = atoi(p);
 416:    if ((p = getenv("NSTACKS")) != NULL && *p != '\0')
 417:       nstacks = atoi(p);
 418:    if ((p = getenv("STKSIZE")) != NULL && *p != '\0')
 419:       stksize = atoi(p);
 420:    if ((p = getenv("STRSIZE")) != NULL && *p != '\0')
 421:       ssize = atoi(p);
 422:    if ((p = getenv("HEAPSIZE")) != NULL && *p != '\0')
 423:       hpsize = atoi(p);
 424: #ifdef AZ_NEVER
 425:    if ((p = getenv("PROFILE")) != NULL && *p != '\0')
 426:       monres = atoi(p);
 427: #endif AZ_NEVER
 428:    if ((p = getenv("ICONCORE")) != NULL) {
 429:       signal(SIGFPE, SIG_DFL);
 430:       signal(SIGSEGV, SIG_DFL);
 431:       dodump++;
 432:       }
 433:    if ((p = getenv("NOERRBUF")) != NULL)
 434:       noerrbuf++;
 435:    }
 436: 
 437: /*
 438:  * Produce run-time error 204 on floating point traps.
 439:  */
 440: fpetrap()
 441:    {
 442:    runerr(204, NULL);
 443:    }
 444: 
 445: /*
 446:  * Produce run-time error 304 on segmentation faults.
 447:  */
 448: segvtrap()
 449:    {
 450:    runerr(304, NULL);
 451:    }
 452: 
 453: /*
 454:  * error - print error message s, used only in startup code.
 455:  */
 456: error(s)
 457: char *s;
 458:    {
 459:    if (line > 0)
 460:       fprintf(stderr, "error at line %d in %s\n%s\n", line, file, s);
 461:    else
 462:       fprintf(stderr, "error in startup code\n%s\n", s);
 463:    fflush(stderr);
 464:    if (dodump)
 465:       abort();
 466:    c_exit(2);
 467:    }
 468: 
 469: /*
 470:  * syserr - print s as a system error.
 471:  */
 472: syserr(s)
 473: char *s;
 474:    {
 475:    if (line > 0)
 476:       fprintf(stderr, "System error at line %d in %s\n%s\n", line, file, s);
 477:    else
 478:       fprintf(stderr, "System error in startup code\n%s\n", s);
 479:    fflush(stderr);
 480:    if (dodump)
 481:       abort();
 482:    c_exit(2);
 483:    }
 484: 
 485: /*
 486:  * errtab maps run-time error numbers into messages.
 487:  */
 488: struct errtab {
 489:    int errno;
 490:    char *errmsg;
 491:    } errtab[] = {
 492: #include "../h/err.h"
 493:    0,   0
 494:    };
 495: 
 496: /*
 497:  * runerr - print message corresponding to error n and if v is non-null,
 498:  *  print it as the offending value.
 499:  */
 500: runerr(n, v)
 501: register int n;
 502: struct descrip *v;
 503:    {
 504:    register struct errtab *p;
 505: 
 506:    if (line > 0)
 507:       fprintf(stderr, "Run-time error %d at line %d in %s\n", n, line, file);
 508:    else
 509:       fprintf(stderr, "Run-time error %d in startup code\n", n);
 510:    for (p = errtab; p->errno > 0; p++)
 511:       if (p->errno == n) {
 512:          fprintf(stderr, "%s\n", p->errmsg);
 513:          break;
 514:          }
 515:    if (v != NULL) {
 516:       fprintf(stderr, "offending value: ");
 517:       outimage(stderr, v, 0);
 518:       putc('\n', stderr);
 519:       }
 520:    fflush(stderr);
 521:    if (dodump)
 522:       abort();
 523:    c_exit(2);
 524:    }
 525: 
 526: /*
 527:  * External declarations for blocks of built-in procedures.
 528:  */
 529: extern struct b_proc
 530: #define PDEF(p) B/**/p,
 531: #include "../h/pdef.h"
 532:     interp; /* Hack to avoid ,; at end */
 533: #undef PDEF
 534: 
 535: /*
 536:  * Array of addresses of blocks for built-in procedures.  It is important
 537:  *  that this table and the one in link/builtin.c agree; the linker
 538:  *  supplies iconx with indices into this array.
 539:  */
 540: struct b_proc *functab[] = {
 541: #define PDEF(p) &B/**/p,
 542: #include "../h/pdef.h"
 543: #undef PDEF
 544:    0
 545:    };
 546: 
 547: /*
 548:  * resolve - perform various fixups on the data read from the interpretable
 549:  *  file.
 550:  */
 551: resolve()
 552:    {
 553:    register int i;
 554:    register struct b_proc *pp;
 555:    register struct descrip *dp;
 556:    extern mkrec();
 557: 
 558:    /*
 559:     * Scan the global variable list for procedures and fill in appropriate
 560:     *  addresses.
 561:     */
 562:    for (dp = globals; dp < eglobals; dp++) {
 563:       if (TYPE(*dp) != T_PROC)
 564:          continue;
 565:       /*
 566:        * The second word of the descriptor for procedure variables tells
 567:        *  where the procedure is.  Negative values are used for built-in
 568:        *  procedures and positive values are used for Icon procedures.
 569:        */
 570:       i = INTVAL(*dp);
 571:       if (i < 0) {
 572:          /*
 573:           * *dp names a built-in function, negate i and use it as an index
 574:           *  into functab to get the location of the procedure block.
 575:           */
 576:          BLKLOC(*dp) = (union block *) functab[-i-1];
 577:          }
 578:       else {
 579:          /*
 580:           * *dp names an Icon procedure or a record.  i is an offset to
 581:           *  location of the procedure block in the code section.  Point
 582:           *  pp at the block and replace BLKLOC(*dp).
 583:           */
 584:          pp = (struct b_proc *) (code + i);
 585:          BLKLOC(*dp) = (union block *) pp;
 586:          /*
 587:           * Relocate the address of the name of the procedure.
 588:           */
 589:          STRLOC(pp->pname) += (int)ident;
 590:          if (pp->ndynam == -2)
 591:             /*
 592:              * This procedure is a record constructor.  Make its entry point
 593:              *  be the entry point of mkrec().
 594:              */
 595:             pp->entryp = EntryPoint(mkrec);
 596:          else {
 597:             /*
 598:              * This is an Icon procedure.  Relocate the entry point and
 599:              *  the names of the parameters, locals, and static variables.
 600:              */
 601:             pp->entryp = code + (int)pp->entryp;
 602:             for (i = 0; i < pp->nparam+pp->ndynam+pp->nstatic; i++)
 603:                STRLOC(pp->lnames[i]) += (int)ident;
 604:             }
 605:          }
 606:       }
 607:    /*
 608:     * Relocate the names of the global variables.
 609:     */
 610:    for (dp = gnames; dp < egnames; dp++)
 611:       STRLOC(*dp) += (int)ident;
 612:    }

Defined functions

Defined variables

Defined struct's

Defined macros