Return to init.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / iconx

Annotation of 43BSD/contrib/icon/iconx/init.c, revision 1.1

1.1     ! root        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:    }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.