home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / runtime / init.r < prev    next >
Text File  |  1996-03-22  |  47KB  |  1,615 lines
  1. /*
  2.  * File: init.r
  3.  * Initialization, termination, and such.
  4.  * Contents: read_hdr, init/icon_init, envset, env_err, env_int,
  5.  *  fpe_trap, inttrag, segvtrap, error, syserr, c_exit, err,
  6.  *  fatalerr, pstrnmcmp, datainit, [loadicode, savepstate, loadpstate]
  7.  */
  8.  
  9. #if !COMPILER
  10. #include "::h:header.h"
  11. #endif                    /* !COMPILER */
  12.  
  13. /*
  14.  * Prototypes.
  15.  */
  16.  
  17. FILE    *pathOpen    Params((char *fname, char *mode));      
  18.  
  19. hidden    FILE    *readhdr    Params((char *name, struct header *hdr));
  20. hidden  novalue    env_err        Params((char *msg,char *name,char *val));
  21.  
  22. /*
  23.  * The following code is operating-system dependent [@init.01].  Declarations
  24.  *   that are system-dependent.
  25.  */
  26.  
  27. #if PORT
  28.    /* probably needs something more */
  29. Deliberate Syntax Error
  30. #endif                    /* PORT */
  31.  
  32. #if AMIGA
  33. int chkbreak;                           /* if nonzero, check for ^C */
  34. #endif                                  /* AMIGA */
  35.  
  36. #if MSDOS
  37. #if HIGHC_386
  38. int _fmode = 0;                 /* force CR-LF on std.. files */
  39. #endif                                  /* HIGHC_386 */
  40. #endif                                  /* MSDOS */
  41.  
  42. #if OS2
  43.  
  44. char modname[256];              /* Character string for module name */
  45. #passthru HMODULE modhandle;    /* Handle of loaded module */
  46. char loadmoderr[256];           /* Error message if loadmodule fails */
  47. #define RT_ICODE 0x4843         /* Resource type id is 'IC' */
  48. unsigned long icoderesid;       /* Resource ID from caller */
  49. char *icoderes;                 /* Pointer to the icode resource data */
  50. int use_resource = 0;           /* Set to TRUE if using a resource */
  51. int stubexe;                    /* TRUE if resource attached to executable */
  52. #endif                          /* OS2 */
  53.  
  54. #if ARM || ATARI_ST || MACINTOSH || MVS || VM || UNIX || VMS
  55.    /* nothing needed */
  56. #endif                                  /* ARM || ATARI_ST || MACINTOSH ... */
  57.  
  58. /*
  59.  * End of operating-system specific code.
  60.  */
  61.  
  62. char *prog_name;                /* name of icode file */
  63.  
  64. #if !COMPILER
  65. #define OpDef(p,n,s,u) int Cat(O,p) Params((dptr cargp));
  66. #include "::h:odefs.h"
  67. #undef OpDef
  68.  
  69. /*
  70.  * External declarations for operator blocks.
  71.  */
  72.  
  73. #passthru #ifdef MultiThread
  74. #passthru #define OpDef(f,nargs,sname,underef)\
  75.     {\
  76.     T_Proc,\
  77.     Vsizeof(struct b_proc),\
  78.     Cat(O,f),\
  79.     nargs,\
  80.     -1,\
  81.     underef /* FJL 0 */,\
  82.     0,\
  83.     0,\
  84.     {{sizeof(sname)-1,sname}}},
  85. #passthru #else                                 /* MultiThread */
  86. #passthru #define OpDef(f,nargs,sname,underef)\
  87.     {\
  88.     T_Proc,\
  89.     Vsizeof(struct b_proc),\
  90.     Cat(O,f),\
  91.     nargs,\
  92.     -1,\
  93.     underef /* FJL 0 */,\
  94.     0,\
  95.     {{sizeof(sname)-1,sname}}},
  96. #passthru #endif                                        /* MultiThread */
  97. #passthru static B_IProc(2) init_op_tbl[] = {
  98. #passthru #include "::h:odefs.h"
  99. #passthru   };
  100. #undef OpDef
  101. #endif                                  /* !COMPILER */
  102.  
  103. /*
  104.  * A number of important variables follow.
  105.  */
  106.  
  107. int line_info;                   /* flag: line information is available */
  108. char *file_name = NULL;          /* source file for current execution point */
  109. int line_num = 0;                /* line number for current execution point */
  110. struct b_proc *op_tbl;           /* operators available for string invocation */
  111.  
  112. extern struct errtab errtab[];          /* error numbers and messages */
  113.  
  114. word mstksize = MStackSize;             /* initial size of main stack */
  115. word stksize = StackSize;               /* co-expression stack size */
  116.  
  117. int k_level = 0;                        /* &level */
  118.  
  119. #ifndef MultiThread
  120. struct descrip k_main;                  /* &main */
  121. #endif                                  /* MultiThread */
  122.  
  123. int set_up = 0;                /* set-up switch */
  124.  
  125. char *currend = NULL;                   /* current end of memory region */
  126.  
  127. word qualsize = QualLstSize;            /* size of quallist for fixed regions */
  128.  
  129. word memcushion = RegionCushion;    /* memory region cushion factor */
  130. word memgrowth = RegionGrowth;        /* memory region growth factor */
  131.  
  132. uword stattotal = 0;                    /* cumulative total static allocation */
  133. #ifndef MultiThread
  134. uword strtotal = 0;                     /* cumulative total string allocation */
  135. uword blktotal = 0;                     /* cumulative total block allocation */
  136. #endif                                  /* MultiThread */
  137.  
  138. int dodump;                             /* if nonzero, core dump on error */
  139. int noerrbuf;                           /* if nonzero, do not buffer stderr */
  140.  
  141. struct descrip k_current;               /* current expression stack pointer */
  142. struct descrip maps2;                   /* second cached argument of map */
  143. struct descrip maps3;                   /* third cached argument of map */
  144.  
  145. #ifndef MultiThread
  146. int k_errornumber = 0;                  /* &errornumber */
  147. char *k_errortext = "";                 /* &errortext */
  148. struct descrip k_errorvalue;            /* &errorvalue */
  149. int have_errval = 0;                    /* &errorvalue has legal value */
  150. int t_errornumber = 0;                  /* tentative k_errornumber value */
  151. int t_have_val = 0;                     /* tentative have_errval flag */
  152. struct descrip t_errorvalue;            /* tentative k_errorvalue value */
  153. #endif                                  /* MultiThread */
  154.  
  155. struct b_coexpr *stklist;       /* base of co-expression block list */
  156. dptr argp = NULL;               /* argument pointer */
  157.  
  158. struct tend_desc *tend = NULL;  /* chain of tended descriptors */
  159.  
  160. struct region rootstring, rootblock;
  161.  
  162. #ifndef MultiThread
  163. dptr globals, eglobals;                 /* pointer to global variables */
  164. dptr gnames, egnames;                   /* pointer to global variable names */
  165. dptr estatics;                          /* pointer to end of static variables */
  166.  
  167. struct region *curstring, *curblock;
  168. #endif                                  /* MultiThread */
  169.  
  170. #if COMPILER
  171. struct p_frame *pfp = NULL;     /* procedure frame pointer */
  172.  
  173. int debug_info;                  /* flag: is debugging information available */
  174. int err_conv;                    /* flag: is error conversion supported */
  175. int largeints;                   /* flag: large integers are supported */
  176.  
  177. struct b_coexpr *mainhead;              /* &main */
  178.  
  179. #else                                   /* COMPILER */
  180.  
  181. int debug_info=1;                /* flag: debugging information IS available */
  182. int err_conv=1;                  /* flag: error conversion IS supported */
  183.  
  184. int op_tbl_sz = (sizeof(init_op_tbl) / sizeof(struct b_proc));
  185. struct pf_marker *pfp = NULL;   /* Procedure frame pointer */
  186.  
  187. #ifndef MaxHeader
  188. #define MaxHeader MaxHdr
  189. #endif                                  /* MaxHeader */
  190.  
  191. #ifdef MultiThread
  192. struct progstate *curpstate;            /* lastop accessed in program state */
  193. struct progstate rootpstate;
  194. #else                                   /* MultiThread */
  195.  
  196. struct b_coexpr *mainhead;              /* &main */
  197.  
  198. char *code;                             /* interpreter code buffer */
  199. word *records;                          /* pointer to record procedure blocks */
  200. int *ftabp;                             /* pointer to record/field table */
  201. dptr fnames, efnames;                   /* pointer to field names */
  202. dptr statics;                           /* pointer to static variables */
  203. char *strcons;                          /* pointer to string constant table */
  204. struct ipc_fname *filenms, *efilenms;   /* pointer to ipc/file name table */
  205. struct ipc_line *ilines, *elines;       /* pointer to ipc/line number table */
  206. #endif                                  /* MultiThread */
  207.  
  208.  
  209.  
  210. #ifdef TallyOpt
  211. word tallybin[16];                      /* counters for tallying */
  212. int tallyopt = 0;                       /* want tally results output? */
  213. #endif                                  /* TallyOpt */
  214.  
  215. #ifdef ExecImages
  216. int dumped = 0;                         /* non-zero if reloaded from dump */
  217. #endif                                  /* ExecImages */
  218.  
  219. word *stack;                            /* Interpreter stack */
  220. word *stackend;                         /* End of interpreter stack */
  221.  
  222.  
  223. #ifdef MultipleRuns
  224. extern word coexp_ser;
  225. extern word list_ser;
  226. extern word set_ser;
  227. extern word table_ser;
  228. extern int first_time;
  229. #endif                                  /* MultipleRuns */
  230. #endif                                  /* COMPILER */
  231.  
  232. #if !COMPILER
  233. /*
  234.  * Open the icode file and read the header.
  235.  * Used by icon_init() as well as MultiThread's loadicode()
  236.  */
  237. static FILE *readhdr(name,hdr)
  238. char *name;
  239. struct header *hdr;
  240.    {
  241.    FILE *fname = NULL;
  242.    int n;
  243.  
  244. #if MSDOS
  245.    int thisIsAnExeFile = 0;
  246.    char bytesThatBeginEveryExe[2] = {0,0};
  247.    unsigned short originalExeBytesMod512, originalExePages;
  248.    unsigned long originalExeBytes;
  249. #endif                                  /* MSDOS */
  250.  
  251.    if (!name)
  252.  
  253. #ifdef PresentationManager
  254.       error(NULL, "An icode file was not specified.\nExecution can't proceed.");
  255. #else                                   /* PresentationManager */
  256.       error(name, "No interpreter file supplied");
  257. #endif                                  /* PresentationManager */
  258.  
  259.    /*
  260.     * Try adding the suffix if the file name doesn't end in it.
  261.     */
  262.    n = strlen(name);
  263.  
  264. #if MSDOS
  265.  
  266. #if ZTC_386
  267.    if (n >= 4 && !strcmp(".exe", name + n - 4)) {
  268. #else                                   /* ZTC_386 */
  269.    if (n >= 4 && !stricmp(".exe", name + n - 4)) {
  270. #endif                                  /* ZTC_386 */
  271.  
  272.       thisIsAnExeFile = 1;
  273.       fname = pathOpen(name, ReadBinary);
  274.      /*
  275.       * ixhdr's code for calling iconx from an .exe passes iconx the
  276.       * full path of the .exe, so using pathOpen() seems redundant &
  277.       * potentially inefficient. However, pathOpen() first checks for a
  278.       * complete path, & if one is present, doesn't search Path; & since
  279.       * MS-DOS has a limited line length, it'd be possible for ixhdr
  280.       * to check whether the full path will fit, & if not, use only the
  281.       * name. The only price for this additional robustness would be
  282.       * the time pathOpen() spends checking for a path, which is trivial.
  283.       */
  284.       }
  285.    else {
  286. #endif                                  /* MSDOS */
  287.  
  288.    if (n <= 4 || (strcmp(name+n-4,IcodeSuffix) != 0)
  289.    && strcmp(name+n-4,IcodeASuffix) != 0) {
  290.       char tname[100];
  291.       if ((int)strlen(name) + 5 > 100)
  292.      error(name, "icode file name too long");
  293.       strcpy(tname,name);
  294.  
  295. #if MVS
  296.    {
  297.       char *p;
  298.       if (p = index(name, '(')) {
  299.      tname[p-name] = '\0';
  300.       }
  301. #endif                                  /* MVS */
  302.  
  303.       strcat(tname,IcodeSuffix);
  304.  
  305. #if MVS
  306.       if (p) strcat(tname,p);
  307.    }
  308. #endif                                  /* MVS */
  309.  
  310. #if MSDOS || OS2
  311.       fname = pathOpen(tname,ReadBinary);       /* try to find path */
  312. #else                                   /* MSDOS || OS2 */
  313.       fname = fopen(tname, ReadBinary);
  314. #endif                                  /* MSDOS || OS2 */
  315.       }
  316.  
  317.    if (fname == NULL)                           /* try the name as given */
  318.  
  319. #if MSDOS || OS2
  320.       fname = pathOpen(name, ReadBinary);
  321. #else                                   /* MSDOS || OS2 */
  322.       fname = fopen(name, ReadBinary);
  323. #endif                                  /* MSDOS || OS2 */
  324.  
  325. #if MSDOS
  326.       } /* end if (n >= 4 && !stricmp(".exe", name + n - 4)) */
  327. #endif
  328.  
  329.    if (fname == NULL)
  330.       return NULL;
  331.  
  332.    {
  333.    static char errmsg[] = "can't read interpreter file header";
  334.    static char exe_errmsg[] = "can't read MS-DOS .exe header";
  335.  
  336. #ifdef Header
  337.  
  338. #if MSDOS && !NT
  339.    #error
  340.    deliberate syntax error
  341.  
  342.   /*
  343.    * The MSDOS .exe-handling code assumes & requires that the executable
  344.    * .exe be followed immediately by the icode itself (actually header.h).
  345.    * This is because the following Header fseek() is relative to the
  346.    * beginning of the file, which in a .exe is the beginning of the
  347.    * executable code, not the beginning of some Icon thing; & I can't
  348.    * check & fix all the Header-handling logic because hdr.h wasn't
  349.    * included with my MS-DOS distribution so I don't even know what it does,
  350.    * let alone how to keep from breaking it. We're safe as long as
  351.    * Header & MSDOS are disjoint.
  352.    */
  353. #endif                                  /* MSDOS && !NT */
  354.  
  355. #ifdef ShellHeader
  356.    char buf[200];
  357.  
  358.    for (;;) {
  359.       if (fgets(buf, sizeof buf, fname) == NULL)
  360.      error(name, errmsg);
  361. #if NT
  362.       if (strncmp(buf, "rem [executable Icon binary follows]", 36) == 0)
  363. #else                                   /* NT */
  364.       if (strncmp(buf, "[executable Icon binary follows]", 32) == 0)
  365. #endif                                  /* NT */
  366.      break;
  367.       }
  368.    while ((n = getc(fname)) != EOF && n != '\f')        /* read thru \f\n\0 */
  369.       ;
  370.    getc(fname);
  371.    getc(fname);
  372. #else                                   /* ShellHeader */
  373.    if (fseek(fname, (long)MaxHeader, 0) == -1)
  374.       error(name, errmsg);
  375. #endif                                  /* ShellHeader */
  376. #endif                                  /* Header */
  377.  
  378. #if MSDOS && !NT
  379.    if (thisIsAnExeFile) {
  380.       fread (&bytesThatBeginEveryExe, sizeof bytesThatBeginEveryExe, 1, fname);
  381.       if (bytesThatBeginEveryExe[0] != 'M' ||
  382.       bytesThatBeginEveryExe[1] != 'Z')
  383.      error(name, exe_errmsg);
  384.       fread (&originalExeBytesMod512, sizeof originalExeBytesMod512, 1, fname);
  385.       fread (&originalExePages,       sizeof originalExePages,       1, fname);
  386.       originalExeBytes = (originalExePages - 1)*512 + originalExeBytesMod512;
  387.       if (fseek(fname, originalExeBytes, 0))
  388.      error(name, errmsg);
  389.       if (ferror(fname) || feof(fname) || !originalExeBytes)
  390.      error(name, exe_errmsg);
  391.       }
  392. #endif                                  /* MSDOS && !NT */
  393.  
  394.    if (fread((char *)hdr, sizeof(char), sizeof(*hdr), fname) != sizeof(*hdr))
  395.       error(name, errmsg);
  396.    }
  397.  
  398.  
  399.    return fname;
  400.    }
  401. #endif
  402.  
  403. /*
  404.  * init/icon_init - initialize memory and prepare for Icon execution.
  405.  */
  406.  
  407. #if COMPILER
  408. novalue init(name, argcp, argv, trc_init)
  409. char *name;
  410. int *argcp;
  411. char *argv[];
  412. int trc_init;
  413. #else                                   /* COMPILER */
  414. novalue icon_init(name, argcp, argv)
  415. char *name;
  416. int *argcp;
  417. char *argv[];
  418. #endif                                  /* COMPILER */
  419.  
  420.    {
  421.    int n;
  422. #if !COMPILER
  423.    struct header hdr;
  424.    FILE *fname = NULL;
  425.    word cbread, longread();
  426. #endif                                  /* COMPILER */
  427.  
  428. #if OS2
  429.    char *p1, *p2;
  430.    int rc;
  431.  
  432.    /* Determine if we are to load from a resource or not */
  433.    if (stubexe || name[0] == '(' ) {
  434.     use_resource = 1;
  435.     if (name[0] == '(') {
  436.        /* Extract module name */
  437.        for(p1 = &name[1],p2 = modname; *p1 && *p1 != ':'; p1++, p2++)
  438.           *p2 = *p1;
  439.        *(p2+1) = '\0';
  440.  
  441.        /* Extract resource id */
  442.        p1++;        /* Skip colon */
  443.        while(isspace(*p1)) p1++;
  444.  
  445.        icoderesid = atol(p1);           /* convert to numeric value */
  446.  
  447.        if (strcmp("*",modname) != 0) {
  448.           rc = DosLoadModule(loadmoderr,sizeof(loadmoderr),
  449.                  modname,&modhandle);
  450.           }
  451.        else {
  452.           modhandle = 0;
  453.           }
  454.        }
  455.     else {      /* Direct executable */
  456.         modhandle = 0;
  457.         icoderesid = 1;
  458.        }
  459.     rc = DosGetResource(modhandle,RT_ICODE,icoderesid,&icoderes);
  460.  
  461.     prog_name = argv[0];
  462.     }
  463.     else {
  464.     use_resource = 0;
  465.     prog_name = name;
  466.     }
  467. #if PresentationManager
  468.     PMInitialize();
  469. #endif
  470. #else                                   /* OS2 */
  471.  
  472.    prog_name = name;                    /* Set icode file name */
  473.  
  474. #endif                                  /* OS2 */
  475.  
  476. #if COMPILER
  477.    curstring = &rootstring;
  478.    curblock  = &rootblock;
  479.    rootstring.size = MaxStrSpace;
  480.    rootblock.size  = MaxAbrSize;
  481. #else                                   /* COMPILER */
  482.  
  483. #ifdef MultiThread
  484.    /*
  485.     * initialize root pstate
  486.     */
  487.    curpstate = &rootpstate;
  488.    rootpstate.opcodemask = nulldesc;
  489.    rootpstate.parentdesc = nulldesc;
  490.    rootpstate.eventmask= nulldesc;
  491.    rootpstate.eventcode= nulldesc;
  492.    rootpstate.eventval = nulldesc;
  493.    rootpstate.eventsource = nulldesc;
  494.    MakeInt(0, &(rootpstate.Kywd_err));
  495.    MakeInt(1, &(rootpstate.Kywd_pos));
  496.    MakeInt(0, &(rootpstate.Kywd_ran));
  497.    StrLen(rootpstate.Kywd_prog) = strlen(prog_name);
  498.    StrLoc(rootpstate.Kywd_prog) = prog_name;
  499.    StrLen(rootpstate.ksub) = 0;
  500.    StrLoc(rootpstate.ksub) = "";
  501.    MakeInt(hdr.trace, &(rootpstate.Kywd_trc));
  502.    rootpstate.K_errornumber = 0;
  503.    rootpstate.T_errornumber = 0;
  504.    rootpstate.Have_errval = 0;
  505.    rootpstate.T_have_val = 0;
  506.    rootpstate.K_errortext = "";
  507.    rootpstate.K_errorvalue = nulldesc;
  508.    rootpstate.T_errorvalue = nulldesc;
  509.  
  510. #ifdef Graphics
  511.    MakeInt(0,&(rootpstate.AmperX));
  512.    MakeInt(0,&(rootpstate.AmperY));
  513.    MakeInt(0,&(rootpstate.AmperRow));
  514.    MakeInt(0,&(rootpstate.AmperCol));
  515.    MakeInt(0,&(rootpstate.AmperInterval));
  516.    rootpstate.LastEventWin = nulldesc;
  517.    rootpstate.Kywd_xwin[XKey_Window] = nulldesc;
  518. #endif                                  /* Graphics */
  519.  
  520.    rootpstate.Coexp_ser = 2;
  521.    rootpstate.List_ser  = 1;
  522.    rootpstate.Set_ser   = 1;
  523.    rootpstate.Table_ser = 1;
  524.    rootpstate.stringregion = &rootstring;
  525.    rootpstate.blockregion = &rootblock;
  526.  
  527. #else                                   /* MultiThread */
  528.  
  529.    curstring = &rootstring;
  530.    curblock  = &rootblock;
  531. #endif                                  /* MultiThread */
  532.  
  533.    rootstring.size = MaxStrSpace;
  534.    rootblock.size  = MaxAbrSize;
  535. #endif                                  /* COMPILER */
  536.  
  537. #if !COMPILER
  538.    op_tbl = (struct b_proc*)init_op_tbl;
  539. #endif                                  /* !COMPILER */
  540.  
  541. #ifdef Double
  542.     if (sizeof(struct size_dbl) != sizeof(double))
  543.     syserr("Icon configuration does not handle double alignment");
  544. #endif                                  /* Double */
  545.  
  546.    /*
  547.     * Catch floating-point traps and memory faults.
  548.     */
  549.  
  550. /*
  551.  * The following code is operating-system dependent [@init.02].  Set traps.
  552.  */
  553.  
  554. #if PORT
  555.    /* probably needs something */
  556. Deliberate Syntax Error
  557. #endif                                  /* PORT */
  558.  
  559. #if AMIGA
  560.    signal(SIGFPE, SigFncCast fpetrap);
  561. #endif                                  /* AMIGA */
  562.  
  563. #if ARM
  564.    signal(SIGFPE, SigFncCast fpetrap);
  565.    signal(SIGSEGV, SigFncCast segvtrap);
  566. #endif                                  /* ARM */
  567.  
  568. #if ATARI_ST
  569. #endif                                  /* ATARI_ST */
  570.  
  571. #if MACINTOSH
  572. #if MPW
  573.    {
  574.       void MacInit(void);
  575.       void SetFloatTrap(void (*fpetrap)());
  576.       novalue fpetrap();
  577.  
  578.       MacInit();
  579.       SetFloatTrap(fpetrap);
  580.    }
  581. #endif                                  /* MPW */
  582. #endif                                  /* MACINTOSH */
  583.  
  584. #if MSDOS
  585. #if MICROSOFT || TURBO || ZTC_386 || SCCX_MX
  586.    signal(SIGFPE, SigFncCast fpetrap);
  587. #endif                                  /* MICROSOFT || TURBO || ZTC_386 || SCCX_MX */
  588. #endif                                  /* MSDOS */
  589.  
  590. #if MVS || VM
  591. #if SASC
  592.    cosignal(SIGFPE, SigFncCast fpetrap);           /* catch in all coprocs */
  593.    cosignal(SIGSEGV, SigFncCast segvtrap);
  594. #endif                                  /* SASC */
  595. #endif                                  /* MVS || VM */
  596.  
  597. #if OS2 || BORLAND_286 || BORLAND_386
  598.    signal(SIGFPE, SigFncCast fpetrap);
  599.    signal(SIGSEGV, SigFncCast segvtrap);
  600. #endif                                  /* OS2 || BORLAND_286 ... */
  601.  
  602. #if UNIX || VMS
  603.    signal(SIGSEGV, SigFncCast segvtrap);
  604. #ifdef PYRAMID
  605.    {
  606.    struct sigvec a;
  607.  
  608.    a.sv_handler = fpetrap;
  609.    a.sv_mask = 0;
  610.    a.sv_onstack = 0;
  611.    sigvec(SIGFPE, &a, 0);
  612.    sigsetmask(1 << SIGFPE);
  613.    }
  614. #else                                   /* PYRAMID */
  615.    signal(SIGFPE, SigFncCast fpetrap);
  616. #endif                                  /* PYRAMID */
  617. #endif                                  /* UNIX || VMS */
  618.  
  619. /*
  620.  * End of operating-system specific code.
  621.  */
  622.  
  623. #if !COMPILER
  624. #ifdef ExecImages
  625.    /*
  626.     * If reloading from a dumped out executable, skip most of init and
  627.     *  just set up the buffer for stderr and do the timing initializations.
  628.     */
  629.    if (dumped)
  630.     goto btinit;
  631. #endif                                  /* ExecImages */
  632. #endif                                  /* COMPILER */
  633.  
  634.    /*
  635.     * Initialize data that can't be initialized statically.
  636.     */
  637.  
  638.    datainit();
  639.  
  640. #if COMPILER
  641.    IntVal(kywd_trc) = trc_init;
  642. #endif                                  /* COMPILER */
  643.  
  644. #if !COMPILER
  645. #if OS2
  646.    if (use_resource)
  647.     memcpy(&hdr,icoderes,sizeof(hdr));
  648.    else {
  649.        fname = readhdr(name,&hdr);
  650.        if (fname == NULL) {
  651. #ifdef PresentationManager
  652.        ConsoleFlags |= OutputToBuf;
  653.        fprintf(stderr, "Cannot locate the icode file: %s.\n", name);
  654.        error(NULL, "Execution cannot proceed.");
  655. #else                                   /* PresentationManager */
  656.        error(name, "cannot open interpreter file");
  657. #endif                                  /* PresentationManager */
  658.        }
  659. #else                                   /* OS2 */
  660.    fname = readhdr(name,&hdr);
  661.    if (fname == NULL) {
  662.       error(name, "cannot open interpreter file");
  663. #endif                                  /* PresentationManager */
  664.       }
  665.  
  666.    k_trace = hdr.trace;
  667.  
  668. #endif                                  /* COMPILER */
  669.  
  670. #ifdef EnvVars
  671.    /*
  672.     * Examine the environment and make appropriate settings.    [[I?]]
  673.     */
  674.    envset();
  675. #endif                                  /* EnvVars */
  676.  
  677.  
  678.    /*
  679.     * Convert stack sizes from words to bytes.
  680.     */
  681.  
  682. #ifndef SCO_XENIX
  683.    stksize *= WordSize;
  684.    mstksize *= WordSize;
  685. #else                                   /* SCO_XENIX */
  686.    /*
  687.     * This is a work-around for bad generated code for *= (as above)
  688.     *  produced by the SCO XENIX C Compiler for the large memory model.
  689.     *  It relies on the fact that WordSize is 4.
  690.     */
  691.    stksize += stksize;
  692.    stksize += stksize;
  693.    mstksize += mstksize;
  694.    mstksize += mstksize;
  695. #endif                                  /* SCO_XENIX */
  696.  
  697. #if IntBits == 16
  698.    if (mstksize > MaxBlock)
  699.       fatalerr(316, NULL);
  700.    if (stksize > MaxBlock)
  701.       fatalerr(318, NULL);
  702. #endif                                  /* IntBits == 16 */
  703.  
  704.    /*
  705.     * Allocate memory for various regions.
  706.     */
  707. #if COMPILER
  708.    initalloc();
  709. #else                                   /* COMPILER */
  710. #ifdef MultiThread
  711.    initalloc(hdr.hsize,&rootpstate);
  712. #else                                   /* MultiThread */
  713.    initalloc(hdr.hsize);
  714. #endif                                  /* MultiThread */
  715. #endif                                  /* COMPILER */
  716.  
  717. #if !COMPILER
  718.    /*
  719.     * Establish pointers to icode data regions.         [[I?]]
  720.     */
  721.    records = (word *)(code + hdr.Records);
  722.    ftabp = (int *)(code + hdr.Ftab);
  723.    fnames = (dptr)(code + hdr.Fnames);
  724.    globals = efnames = (dptr)(code + hdr.Globals);
  725.    gnames = eglobals = (dptr)(code + hdr.Gnames);
  726.    statics = egnames = (dptr)(code + hdr.Statics);
  727.    estatics = (dptr)(code + hdr.Filenms);
  728.    n_globals = eglobals - globals;
  729.    n_statics = estatics - statics;
  730.    filenms = (struct ipc_fname *)estatics;
  731.    efilenms = (struct ipc_fname *)(code + hdr.linenums);
  732.    ilines = (struct ipc_line *)efilenms;
  733.    elines = (struct ipc_line *)(code + hdr.Strcons);
  734.    strcons = (char *)elines;
  735. #endif                                  /* COMPILER */
  736.  
  737.    /*
  738.     * Allocate stack and initialize &main.
  739.     */
  740.  
  741. #if COMPILER
  742.    mainhead = (struct b_coexpr *)malloc((msize)sizeof(struct b_coexpr));
  743. #else                                   /* COMPILER */
  744.    stack = (word *)malloc((msize)mstksize);
  745.    mainhead = (struct b_coexpr *)stack;
  746.  
  747. #endif                                  /* COMPILER */
  748.  
  749.    if (mainhead == NULL)
  750. #if COMPILER
  751.       err_msg(305, NULL);
  752. #else                                   /* COMPILER */
  753.       fatalerr(303, NULL);
  754. #endif                                  /* COMPILER */
  755.  
  756.    mainhead->title = T_Coexpr;
  757.    mainhead->id = 1;
  758.    mainhead->size = 1;                  /* pretend main() does an activation */
  759.    mainhead->nextstk = NULL;
  760.    mainhead->es_tend = NULL;
  761.    mainhead->freshblk = nulldesc;       /* &main has no refresh block. */
  762.                     /*  This really is a bug. */
  763. #ifdef MultiThread
  764.    mainhead->program = &rootpstate;
  765. #endif                                  /* MultiThread */
  766. #if COMPILER
  767.    mainhead->file_name = "";
  768.    mainhead->line_num = 0;
  769. #endif                                  /* COMPILER */
  770.  
  771. #ifdef Coexpr
  772.    Protect(mainhead->es_actstk = alcactiv(), fatalerr(0,NULL));
  773.    pushact(mainhead, mainhead);
  774. #endif                                  /* Coexpr */
  775.  
  776.    /*
  777.     * Point &main at the co-expression block for the main procedure and set
  778.     *  k_current, the pointer to the current co-expression, to &main.
  779.     */
  780.    k_main.dword = D_Coexpr;
  781.    BlkLoc(k_main) = (union block *) mainhead;
  782.    k_current = k_main;
  783.    
  784. #if !COMPILER
  785.    /*
  786.     * Read the interpretable code and data into memory.
  787.     */
  788.  
  789. #if OS2
  790.    if (use_resource) {
  791.     memcpy(code,icoderes+sizeof(hdr),hdr.hsize);
  792.     DosFreeResource(icoderes);
  793.     if (modhandle) DosFreeModule(modhandle);
  794.    }
  795.    else {
  796.        if ((cbread = longread(code, sizeof(char), (long)hdr.hsize, fname)) !=
  797.       hdr.hsize) {
  798. #ifdef PresentationManager
  799.       ConsoleFlags |= OutputToBuf;
  800.       fprintf(stderr, "Invalid icode file: %s.\n", name);
  801.       fprintf(stderr,"Could only read %ld (of %ld) bytes of code.\n",
  802.           (long)cbread, (long)hdr.hsize);
  803.       error(NULL, NULL);
  804. #else                                   /* PresentationManager */
  805.       fprintf(stderr,"Tried to read %ld bytes of code, got %ld\n",
  806.         (long)hdr.hsize,(long)cbread);
  807.       error(name, "bad icode file");
  808. #endif                                  /* PresentationManager */
  809.       }
  810.        fclose(fname);
  811.     }
  812. #else                                   /* OS2 */
  813.    if ((cbread = longread(code, sizeof(char), (long)hdr.hsize, fname)) !=
  814.       hdr.hsize) {
  815.       fprintf(stderr,"Tried to read %ld bytes of code, got %ld\n",
  816.     (long)hdr.hsize,(long)cbread);
  817.       error(name, "bad icode file");
  818.       }
  819.    fclose(fname);
  820. #endif                                  /* OS2 */
  821. /*
  822.  * Make sure the version number of the icode matches the interpreter version.
  823.  */
  824.  
  825.    if (strcmp((char *)hdr.config,IVersion)) {
  826. #ifdef PresentationManager
  827.       ConsoleFlags |= OutputToBuf;
  828.       fprintf(stderr, "Icode version mismatch in \'%s\':\n", name);
  829.       fprintf(stderr, "    actual version: %s\n",(char *)hdr.config);
  830.       fprintf(stderr, "    expected version: %s\n",IVersion);
  831.       fprintf(stderr, "Execution of \'%s\' cannot proceed.", name);
  832.       error(NULL, NULL);
  833. #else                                   /* PresentationManager */
  834.       fprintf(stderr,"icode version mismatch in %s\n", name);
  835.       fprintf(stderr,"\ticode version: %s\n",(char *)hdr.config);
  836.       fprintf(stderr,"\texpected version: %s\n",IVersion);
  837.       error(name, "cannot run");
  838. #endif                                  /* PresentationManager */
  839.       }
  840. #endif                                  /* !COMPILER */
  841.  
  842.    /*
  843.     * Initialize the event monitoring system, if configured.
  844.     */
  845.  
  846. #ifdef EventMon
  847.    EVInit();
  848. #endif                                  /* EventMon */
  849.  
  850.    /*
  851.     * Check command line for redirected standard I/O.
  852.     *  Assign a channel to the terminal if KeyboardFncs are enabled on VMS.
  853.     */
  854.  
  855. #if VMS
  856.    redirect(argcp, argv, 0);
  857. #ifdef KeyboardFncs
  858.    assign_channel_to_terminal();
  859. #endif                                  /* KeyboardFncs */
  860. #endif                                  /* VMS */
  861.  
  862. #if !COMPILER
  863.    /*
  864.     * Resolve references from icode to run-time system.
  865.     */
  866. #ifdef MultiThread
  867.    resolve(NULL);
  868. #else                                   /* MultiThread */
  869.    resolve();
  870. #endif                                  /* MultiThread */
  871. #endif                                  /* COMPILER */
  872.  
  873. #if !COMPILER
  874. #ifdef ExecImages
  875. btinit:
  876. #endif                                  /* ExecImages */
  877. #endif                                  /* COMPILER */
  878.  
  879. /*
  880.  * The following code is operating-system dependent [@init.03].  Allocate and
  881.  *  assign a buffer to stderr if possible.
  882.  */
  883.  
  884. #if PORT
  885.    /* probably nothing */
  886. Deliberate Syntax Error
  887. #endif                                  /* PORT */
  888.  
  889. #if AMIGA || MVS || VM
  890.    /* not done */
  891. #endif                                  /* AMIGA */
  892.  
  893. #if ARM || ATARI_ST || MACINTOSH || UNIX || OS2 || VMS
  894.  
  895.  
  896.    if (noerrbuf)
  897.       setbuf(stderr, NULL);
  898.    else {
  899.       char *buf;
  900.       
  901.       buf = (char *)malloc((msize)BUFSIZ);
  902.       if (buf == NULL)
  903.     fatalerr(305, NULL);
  904.       setbuf(stderr, buf);
  905.       }
  906. #endif                                  /* ARM || ATARI_ST || MACINTOSH ... */
  907.  
  908. #if MSDOS
  909. #if !HIGHC_386
  910.    if (noerrbuf)
  911.       setbuf(stderr, NULL);
  912.    else {
  913.       char *buf;
  914.       
  915.       buf = (char *)malloc((msize)BUFSIZ);
  916.       if (buf == NULL)
  917.     fatalerr(305, NULL);
  918.       setbuf(stderr, buf);
  919.       }
  920. #endif                                  /* !HIGHC_386 */
  921. #endif                                  /* MSDOS */
  922.  
  923. /*
  924.  * End of operating-system specific code.
  925.  */
  926.  
  927.    /*
  928.     * Start timing execution.
  929.     */
  930.  
  931.    millisec();
  932.    }
  933.  
  934. /*
  935.  * Service routines related to getting things started.
  936.  */
  937.  
  938.  
  939. #ifdef EnvVars
  940. /*
  941.  * Check for environment variables that Icon uses and set system
  942.  *  values as is appropriate.
  943.  */
  944. novalue envset()
  945.    {
  946.    register char *p;
  947.  
  948.    if ((p = getenv("NOERRBUF")) != NULL)
  949.       noerrbuf++;
  950.    env_int(TRACE, &k_trace, 0, (uword)0);
  951.    env_int(COEXPSIZE, &stksize, 1, (uword)MaxUnsigned);
  952.    env_int(STRSIZE, &ssize, 1, (uword)MaxBlock);
  953.    env_int(HEAPSIZE, &abrsize, 1, (uword)MaxBlock);
  954.    env_int(BLOCKSIZE, &abrsize, 1, (uword)MaxBlock);    /* synonym */
  955.    env_int(BLKSIZE, &abrsize, 1, (uword)MaxBlock);      /* synonym */
  956.    env_int(MSTKSIZE, &mstksize, 1, (uword)MaxUnsigned);
  957.    env_int(QLSIZE, &qualsize, 1, (uword)MaxBlock);
  958.    env_int("IXCUSHION", &memcushion, 1, (uword)100);    /* max 100 % */
  959.    env_int("IXGROWTH", &memgrowth, 1, (uword)10000);    /* max 100x growth */
  960.  
  961. /*
  962.  * The following code is operating-system dependent [@init.04].  Check any
  963.  *  system-dependent environment variables.
  964.  */
  965.  
  966. #if PORT
  967.    /* nothing to do */
  968. Deliberate Syntax Error
  969. #endif                                  /* PORT */
  970.  
  971. #if AMIGA
  972.    if ((p = getenv("CHECKBREAK")) != NULL)
  973.       chkbreak++;
  974. #endif                                  /* AMIGA */
  975.  
  976. #if ARM || ATARI_ST || MACINTOSH || MSDOS || MVS || OS2 || UNIX || VM || VMS
  977.    /* nothing to do */
  978. #endif                                  /* ARM || ATARI_ST || ... */
  979.  
  980. /*
  981.  * End of operating-system specific code.
  982.  */
  983.  
  984.    if ((p = getenv(ICONCORE)) != NULL && *p != '\0') {
  985.  
  986. /*
  987.  * The following code is operating-system dependent [@init.05].  Set trap to
  988.  *  give dump on abnormal termination if ICONCORE is set.
  989.  */
  990.  
  991. #if PORT
  992.    /* can't handle */
  993. Deliberate Syntax Error
  994. #endif                                  /* PORT */
  995.  
  996. #if AMIGA || ATARI_ST || MACINTOSH
  997.    /* can't handle */
  998. #endif                                  /* AMIGA || ATARI_ST || ... */
  999.  
  1000. #if ARM || OS2
  1001.       signal(SIGSEGV, SIG_DFL);
  1002.       signal(SIGFPE, SIG_DFL);
  1003. #endif                                  /* ARM || OS2 */
  1004.  
  1005. #if MSDOS
  1006. #if TURBO || BORLAND_286 || BORLAND_386
  1007.       signal(SIGFPE, SIG_DFL);
  1008. #endif                                  /* TURBO || BORLAND_286 ... */
  1009. #endif                                  /* MSDOS */
  1010.  
  1011. #if MVS || VM
  1012.       /* Really nothing to do. */
  1013. #endif                                  /* MVS || VM */
  1014.  
  1015. #if UNIX || VMS
  1016.       signal(SIGSEGV, SIG_DFL);
  1017. #endif                                  /* UNIX || VMS */
  1018.  
  1019. /*
  1020.  * End of operating-system specific code.
  1021.  */
  1022.       dodump++;
  1023.       }
  1024.    }
  1025.  
  1026. /*
  1027.  * env_err - print an error mesage about the value of an environment
  1028.  *  variable.
  1029.  */
  1030. static novalue env_err(msg, name, val)
  1031. char *msg;
  1032. char *name;
  1033. char *val;
  1034. {
  1035.    char msg_buf[100];
  1036.  
  1037.    strncpy(msg_buf, msg, 99);
  1038.    strncat(msg_buf, ": ", 99 - (int)strlen(msg_buf));
  1039.    strncat(msg_buf, name, 99 - (int)strlen(msg_buf));
  1040.    strncat(msg_buf, "=", 99 - (int)strlen(msg_buf));
  1041.    strncat(msg_buf, val, 99 - (int)strlen(msg_buf));
  1042.    error("", msg_buf);
  1043. }
  1044.  
  1045. /*
  1046.  * env_int - get the value of an integer-valued environment variable.
  1047.  */
  1048. novalue env_int(name, variable, non_neg, limit)
  1049. char *name;
  1050. word *variable;
  1051. int non_neg;
  1052. uword limit;
  1053. {
  1054.    char *value;
  1055.    char *s;
  1056.    register uword n = 0;
  1057.    register uword d;
  1058.    int sign = 1;
  1059.  
  1060.    if ((value = getenv(name)) == NULL || *value == '\0')
  1061.       return;
  1062.  
  1063.    s = value;
  1064.    if (*s == '-') {
  1065.       if (non_neg)
  1066.      env_err("environment variable out of range", name, value);
  1067.       sign = -1;
  1068.       ++s;
  1069.       }
  1070.    else if (*s == '+')
  1071.       ++s;
  1072.    while (isdigit(*s)) {
  1073.       d = *s++ - '0';
  1074.       /*
  1075.        * See if 10 * n + d > limit, but do it so there can be no overflow.
  1076.        */
  1077.       if ((d > (uword)(limit / 10 - n) * 10 + limit % 10) && (limit > 0))
  1078.      env_err("environment variable out of range", name, value);
  1079.       n = n * 10 + d;
  1080.       }
  1081.    if (*s != '\0')
  1082.       env_err("environment variable not numeric", name, value);
  1083.    *variable = sign * n;
  1084. }
  1085. #endif                                  /* EnvVars */
  1086.  
  1087. /*
  1088.  * Termination routines.
  1089.  */
  1090.  
  1091. /*
  1092.  * Produce run-time error 204 on floating-point traps.
  1093.  */
  1094.  
  1095. novalue fpetrap()
  1096.    {
  1097.    fatalerr(204, NULL);
  1098.    }
  1099.  
  1100. /*
  1101.  * Produce run-time error 320 on ^C interrupts. Not used at present,
  1102.  *  since malfunction may occur during traceback.
  1103.  */
  1104. novalue inttrap()
  1105.    {
  1106.    fatalerr(320, NULL);
  1107.    }
  1108.  
  1109. /*
  1110.  * Produce run-time error 302 on segmentation faults.
  1111.  */
  1112. novalue segvtrap()
  1113.    {
  1114.  
  1115. #if MVS || VM
  1116. #if SASC 
  1117.    btrace(0);
  1118. #endif                                  /* SASC */
  1119. #endif                                  /* MVS || VM */
  1120.  
  1121.    fatalerr(302, NULL);
  1122.    }
  1123.  
  1124. /*
  1125.  * error - print error message from s1 and s2; used only in startup code.
  1126.  */
  1127. novalue error(s1, s2)
  1128. char *s1, *s2;
  1129.    {
  1130.  
  1131. #ifdef PresentationManager
  1132.    ConsoleFlags |= OutputToBuf;
  1133.    if (!s1 && s2)
  1134.       fprintf(stderr, s2);
  1135.    else if (s1 && s2)
  1136.       fprintf(stderr, "%s: %s\n", s1, s2);
  1137. #else                                   /* PresentationManager */
  1138.    if (!s1)
  1139.       fprintf(stderr, "error in startup code\n%s\n", s2);
  1140.    else
  1141.       fprintf(stderr, "error in startup code\n%s: %s\n", s1, s2);
  1142. #endif                                  /* PresentationManager */
  1143.  
  1144.    fflush(stderr);
  1145.  
  1146. #ifdef PresentationManager
  1147.   /* bring up the message box to display the error we constructed */
  1148.   WinMessageBox(HWND_DESKTOP, HWND_DESKTOP, ConsoleStringBuf,
  1149.         "Icon Runtime Initialization", 0, 
  1150.         MB_OK|MB_ICONHAND|MB_MOVEABLE);
  1151. #endif                                  /* PresentationManager */
  1152.  
  1153.    if (dodump)
  1154.       abort();
  1155.    c_exit(ErrorExit);
  1156.    }
  1157.  
  1158. /*
  1159.  * syserr - print s as a system error.
  1160.  */
  1161. novalue syserr(s)
  1162. char *s;
  1163.    {
  1164.  
  1165.    
  1166. #ifdef PresentationManager
  1167.    ConsoleFlags |= OutputToBuf;
  1168. #endif                                  /* PresentationManager */
  1169.    fprintf(stderr, "System error");
  1170.    if (pfp == NULL)
  1171.       fprintf(stderr, " in startup code");
  1172.    else {
  1173. #if COMPILER
  1174.       if (line_info)
  1175.      fprintf(stderr, " at line %d in %s", line_num, file_name);
  1176. #else                                   /* COMPILER */
  1177.       fprintf(stderr, " at line %ld in %s", (long)findline(ipc.opnd),
  1178.      findfile(ipc.opnd));
  1179. #endif                                  /* COMPILER */
  1180.       }
  1181.   fprintf(stderr, "\n%s\n", s);
  1182. #ifdef PresentationManager
  1183.   error(NULL, NULL);
  1184. #endif                                  /* PresentationManager */
  1185.  
  1186.    fflush(stderr);
  1187.    if (dodump)
  1188.       abort();
  1189.    c_exit(ErrorExit);
  1190.    }
  1191.  
  1192. /*
  1193.  * c_exit(i) - flush all buffers and exit with status i.
  1194.  */
  1195. novalue c_exit(i)
  1196. int i;
  1197. {
  1198. #ifdef ConsoleWindow
  1199.    char *msg = "Strike any key to close console...";
  1200. #endif                                  /* ConsoleWindow */
  1201. #ifdef EventMon
  1202.    if (curpstate != NULL) {
  1203.       EVVal((word)i, E_Exit);
  1204.       }
  1205. #endif                                  /* EventMon */
  1206. #ifdef MultiThread
  1207.    if (curpstate != NULL && curpstate->parent != NULL) {
  1208.       /* might want to get to the lterm somehow, instead */
  1209.       while (1) {
  1210.      struct descrip dummy;
  1211.      co_chng(curpstate->parent->Mainhead, NULL, &dummy, A_Cofail, 1);
  1212.      }
  1213.       }
  1214. #endif                                  /* MultiThread */
  1215.  
  1216. #ifdef TallyOpt
  1217.    {
  1218.    int j;
  1219.  
  1220.    if (tallyopt) {
  1221.       fprintf(stderr,"tallies: ");
  1222.       for (j=0; j<16; j++)
  1223.      fprintf(stderr," %ld", (long)tallybin[j]);
  1224.      fprintf(stderr,"\n");
  1225.      }
  1226.       }
  1227. #endif                                  /* TallyOpt */
  1228.  
  1229.    if (k_dump && set_up) {
  1230.       fprintf(stderr,"\nTermination dump:\n\n");
  1231.       fflush(stderr);
  1232.       fprintf(stderr,"co-expression_%ld(%ld)\n",
  1233.      BlkLoc(k_current)->coexpr.id, BlkLoc(k_current)->coexpr.size);
  1234.       fflush(stderr);
  1235.       xdisp(pfp,argp,k_level,stderr);
  1236.       }
  1237.  
  1238. #ifdef MultipleRuns
  1239.    /*
  1240.     * Free allocated memory so application can continue.
  1241.     */
  1242.  
  1243.    xmfree();
  1244. #endif                                  /* MultipleRuns */
  1245.  
  1246. #ifdef ConsoleWindow
  1247.    /*
  1248.     * if the console was used for anything, pause it
  1249.     */
  1250.    if (ConsoleBinding) {
  1251. #if BORLAND_286
  1252.       fputs(msg, ConsoleBinding);
  1253. #else
  1254.       char label[256], tossanswer[256];
  1255.       struct descrip answer;
  1256.  
  1257.       wputstr((wbp)ConsoleBinding, msg, strlen(msg));
  1258.  
  1259.       strcpy(tossanswer, "label=");
  1260.       mystrncpy(tossanswer+6, StrLoc(kywd_prog), StrLen(kywd_prog));
  1261.       strcat(tossanswer, " - execution terminated");
  1262.       wattrib((wbp)ConsoleBinding, tossanswer, strlen(tossanswer),
  1263.               &answer, tossanswer);
  1264. #endif
  1265.       waitkey(ConsoleBinding);
  1266.       }
  1267. /* undo the #define exit c_exit */
  1268. #undef exit
  1269. #passthru #undef exit
  1270. #endif                    /* ConsoleWindow */
  1271.  
  1272. #ifdef MSWindows
  1273.    PostQuitMessage(0);
  1274. #endif                    /* MSWindows */
  1275.  
  1276.  
  1277. #if TURBO || BORLAND_286 || BORLAND_386
  1278.    flushall();
  1279.    _exit(i);
  1280. #else                                   /* TURBO || BORLAND_286 ... */
  1281. #ifdef PresentationManager
  1282.    /* tell thread 1 to shut down */
  1283.    WinPostQueueMsg(HMainMessageQueue, WM_QUIT, (MPARAM)0, (MPARAM)0);
  1284.    /* bye, bye */
  1285.    InterpThreadShutdown();
  1286. #else                                   /* PresentationManager */
  1287.    exit(i);
  1288. #endif                                  /* PresentationManager */
  1289. #endif                                  /* TURBO || BORLAND_286 ... */
  1290.  
  1291. }
  1292.  
  1293. /*
  1294.  * err() is called if an erroneous situation occurs in the virtual
  1295.  *  machine code.  It is typed as int to avoid declaration problems
  1296.  *  elsewhere.
  1297.  */
  1298. int err()
  1299. {
  1300.    syserr("call to 'err'\n");
  1301.    return 1;            /* unreachable; make compilers happy */
  1302. }
  1303.  
  1304. /*
  1305.  * fatalerr - disable error conversion and call run-time error routine.
  1306.  */
  1307. novalue fatalerr(n, v)
  1308. int n;
  1309. dptr v;
  1310.    {
  1311.    IntVal(kywd_err) = 0;
  1312.    err_msg(n, v);
  1313.    }
  1314.  
  1315. /*
  1316.  * pstrnmcmp - compare names in two pstrnm structs; used for qsort.
  1317.  */
  1318. int pstrnmcmp(a,b)
  1319. struct pstrnm *a, *b;
  1320. {
  1321.   return strcmp(a->pstrep, b->pstrep);
  1322. }
  1323.  
  1324. /*
  1325.  * datainit - initialize some global variables.
  1326.  */
  1327. novalue datainit()
  1328.    {
  1329.  
  1330.    /*
  1331.     * Initializations that cannot be performed statically (at least for
  1332.     * some compilers).                                  [[I?]]
  1333.     */
  1334.  
  1335. #ifdef MultiThread
  1336.    k_errout.title = T_File;
  1337.    k_input.title = T_File;
  1338.    k_output.title = T_File;
  1339. #endif                                  /* MultiThread */
  1340.    k_errout.fd = stderr;
  1341.    StrLen(k_errout.fname) = 7;
  1342.    StrLoc(k_errout.fname) = "&errout";
  1343.    k_errout.status = Fs_Write;
  1344.  
  1345. #ifdef MacGraph
  1346.    if (k_input.fd == NULL) 
  1347. #endif                    /* MacGraph */
  1348.    k_input.fd = stdin;
  1349.    StrLen(k_input.fname) = 6;
  1350.    StrLoc(k_input.fname) = "&input";
  1351.    k_input.status = Fs_Read;
  1352.  
  1353.    k_output.fd = stdout;
  1354.    StrLen(k_output.fname) = 7;
  1355.    StrLoc(k_output.fname) = "&output";
  1356.    k_output.status = Fs_Write;
  1357.  
  1358.    IntVal(kywd_pos) = 1;
  1359.    IntVal(kywd_ran) = 0;
  1360.    StrLen(kywd_prog) = strlen(prog_name);
  1361.    StrLoc(kywd_prog) = prog_name;
  1362.    StrLen(k_subject) = 0;
  1363.    StrLoc(k_subject) = "";
  1364.  
  1365.  
  1366.    StrLen(blank) = 1;
  1367.    StrLoc(blank) = " ";
  1368.    StrLen(emptystr) = 0;
  1369.    StrLoc(emptystr) = "";
  1370.    BlkLoc(nullptr) = (union block *)NULL;
  1371.    StrLen(lcase) = 26;
  1372.    StrLoc(lcase) = "abcdefghijklmnopqrstuvwxyz";
  1373.    StrLen(letr) = 1;
  1374.    StrLoc(letr) = "r";
  1375.    IntVal(nulldesc) = 0;
  1376.    k_errorvalue = nulldesc;
  1377.    IntVal(onedesc) = 1;
  1378.    StrLen(ucase) = 26;
  1379.    StrLoc(ucase) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
  1380.    IntVal(zerodesc) = 0;
  1381.  
  1382. #ifdef EventMon
  1383. /*
  1384.  *  Initialization needed for event monitoring
  1385.  */
  1386.  
  1387.    BlkLoc(csetdesc) = (union block *)&fullcs;
  1388.    BlkLoc(rzerodesc) = (union block *)&realzero;
  1389.  
  1390. #endif                                  /* EventMon */
  1391.  
  1392.  
  1393.    maps2 = nulldesc;
  1394.    maps3 = nulldesc;
  1395.  
  1396. #if !COMPILER
  1397.    qsort((char *)pntab,pnsize,sizeof(struct pstrnm), (int(*)())pstrnmcmp);
  1398.  
  1399. #ifdef MultipleRuns
  1400.    /*
  1401.     * Initializations required for repeated program runs
  1402.     */
  1403.                     /* In this module:      */
  1404.    k_level = 0;                         /* &level */
  1405.    k_errornumber = 0;                   /* &errornumber */
  1406.    k_errortext = "";                    /* &errortext */
  1407.    currend = NULL;                      /* current end of memory region */
  1408.  
  1409.    mstksize = MStackSize;               /* initial size of main stack */
  1410.    stksize = StackSize;                 /* co-expression stack size */
  1411.    ssize = MaxStrSpace;                 /* initial string space size (bytes) */
  1412.    abrsize = MaxAbrSize;                /* initial block region size (bytes) */
  1413.    qualsize = QualLstSize;              /* size of quallist for fixed regions */
  1414.  
  1415.    dodump = 0;                          /* produce dump on error */
  1416.  
  1417. #ifdef ExecImages
  1418.    dumped = 0;                          /* This is a dumped image. */
  1419. #endif                                  /* ExecImages */
  1420.  
  1421.                     /* In module interp.r:  */
  1422.    pfp = 0;                             /* Procedure frame pointer */
  1423.    sp = NULL;                           /* Stack pointer */
  1424.  
  1425.                     /* In module rmemmgt.r: */
  1426.    coexp_ser = 2;
  1427.    list_ser = 1;
  1428.    set_ser = 1;
  1429.    table_ser = 1;
  1430.  
  1431.    coll_stat = 0;
  1432.    coll_str = 0;
  1433.    coll_blk = 0;
  1434.    coll_tot = 0;
  1435.  
  1436.                     /* In module time.c: */
  1437.    first_time = 1;
  1438.    
  1439.  
  1440. #endif                                  /* MultipleRuns */
  1441. #endif                                  /* COMPILER */
  1442.  
  1443.    }
  1444.  
  1445. #ifdef MultiThread
  1446. /*
  1447.  * loadicode - initialize memory particular to a given icode file
  1448.  */
  1449. struct b_coexpr * loadicode(name, theInput, theOutput, theError, bs, ss, stk)
  1450. char *name;
  1451. struct b_file *theInput, *theOutput, *theError;
  1452. C_integer bs, ss, stk;
  1453.    {
  1454.    struct b_coexpr *coexp;
  1455.    struct progstate *pstate;
  1456.    struct header hdr;
  1457.    FILE *fname = NULL;
  1458.    word cbread, longread();
  1459.  
  1460.    /*
  1461.     * open the icode file and read the header
  1462.     */
  1463.    fname = readhdr(name,&hdr);
  1464.    if (fname == NULL)
  1465.       return NULL;
  1466.  
  1467.    /*
  1468.     * Allocate memory for icode and the struct that describes it
  1469.     */
  1470.      Protect(coexp = alccoexp(hdr.hsize, stk),
  1471.       { fprintf(stderr,"can't malloc new icode region\n");c_exit(ErrorExit);});
  1472.  
  1473.    pstate = coexp->program;
  1474.    /*
  1475.     * Initialize values.
  1476.     */
  1477.    pstate->hsize = hdr.hsize;
  1478.    pstate->parent= NULL;
  1479.    pstate->parentdesc= nulldesc;
  1480.    pstate->opcodemask= nulldesc;
  1481.    pstate->eventmask= nulldesc;
  1482.    pstate->eventcode= nulldesc;
  1483.    pstate->eventval = nulldesc;
  1484.    pstate->eventsource = nulldesc;
  1485.  
  1486.    MakeInt(0, &(pstate->Kywd_err));
  1487.    MakeInt(1, &(pstate->Kywd_pos));
  1488.    MakeInt(0, &(pstate->Kywd_ran));
  1489.  
  1490.    StrLen(pstate->Kywd_prog) = strlen(prog_name);
  1491.    StrLoc(pstate->Kywd_prog) = prog_name;
  1492.    StrLen(pstate->ksub) = 0;
  1493.    StrLoc(pstate->ksub) = "";
  1494.    MakeInt(hdr.trace, &(pstate->Kywd_trc));
  1495.  
  1496. #ifdef EventMon
  1497.    pstate->Linenum = pstate->Column = pstate->Lastline = pstate->Lastcol = 0;
  1498. #endif                                          /* EventMon */
  1499.    pstate->Lastop = 0;
  1500.    /*
  1501.     * might want to override from TRACE environment variable here.
  1502.     */
  1503.  
  1504.    /*
  1505.     * Establish pointers to icode data regions.         [[I?]]
  1506.     */
  1507.    pstate->Mainhead= ((struct b_coexpr *)pstate)-1;
  1508.    pstate->K_main.dword = D_Coexpr;
  1509.    BlkLoc(pstate->K_main) = (union block *) pstate->Mainhead;
  1510.    pstate->Code    = (char *)(pstate + 1);
  1511.    pstate->Records = (word *)(pstate->Code + hdr.Records);
  1512.    pstate->Ftabp   = (int *)(pstate->Code + hdr.Ftab);
  1513.    pstate->Fnames  = (dptr)(pstate->Code + hdr.Fnames);
  1514.    pstate->Globals = pstate->Efnames = (dptr)(pstate->Code + hdr.Globals);
  1515.    pstate->Gnames  = pstate->Eglobals = (dptr)(pstate->Code + hdr.Gnames);
  1516.    pstate->NGlobals = pstate->Eglobals - pstate->Globals;
  1517.    pstate->Statics = pstate->Egnames = (dptr)(pstate->Code + hdr.Statics);
  1518.    pstate->Estatics = (dptr)(pstate->Code + hdr.Filenms);
  1519.    pstate->NStatics = pstate->Estatics - pstate->Statics;
  1520.    pstate->Filenms = (struct ipc_fname *)(pstate->Estatics);
  1521.    pstate->Efilenms = (struct ipc_fname *)(pstate->Code + hdr.linenums);
  1522.    pstate->Ilines = (struct ipc_line *)(pstate->Efilenms);
  1523.    pstate->Elines = (struct ipc_line *)(pstate->Code + hdr.Strcons);
  1524.    pstate->Strcons = (char *)(pstate->Elines);
  1525.    pstate->K_errornumber = 0;
  1526.    pstate->T_errornumber = 0;
  1527.    pstate->Have_errval = 0;
  1528.    pstate->T_have_val = 0;
  1529.    pstate->K_errortext = "";
  1530.    pstate->K_errorvalue = nulldesc;
  1531.    pstate->T_errorvalue = nulldesc;
  1532.  
  1533. #ifdef Graphics
  1534.    MakeInt(0, &(pstate->AmperX));
  1535.    MakeInt(0, &(pstate->AmperY));
  1536.    MakeInt(0, &(pstate->AmperRow));
  1537.    MakeInt(0, &(pstate->AmperCol));
  1538.    MakeInt(0, &(pstate->AmperInterval));
  1539.    pstate->LastEventWin = nulldesc;
  1540.    pstate->Kywd_xwin[XKey_Window] = nulldesc;
  1541. #endif                                  /* Graphics */
  1542.  
  1543.    pstate->Coexp_ser = 2;
  1544.    pstate->Coexp_ser = 1;
  1545.    pstate->List_ser = 1;
  1546.    pstate->Set_ser = 1;
  1547.    pstate->Table_ser = 1;
  1548.  
  1549.    pstate->stringtotal = pstate->blocktotal =
  1550.    pstate->colltot     = pstate->collstat   =
  1551.    pstate->collstr     = pstate->collblk    = 0;
  1552.  
  1553.    pstate->stringregion = (struct region *)malloc(sizeof(struct region));
  1554.    pstate->blockregion  = (struct region *)malloc(sizeof(struct region));
  1555.    pstate->stringregion->size = ss;
  1556.    pstate->blockregion->size = bs;
  1557.    
  1558.    /*
  1559.     * the local program region list starts out with this region only
  1560.     */
  1561.    pstate->stringregion->prev = NULL;
  1562.    pstate->blockregion->prev = NULL;
  1563.    pstate->stringregion->next = NULL;
  1564.    pstate->blockregion->next = NULL;
  1565.    /*
  1566.     * the global region list links this region with curpstate's
  1567.     */
  1568.    pstate->stringregion->Gprev = curpstate->stringregion;
  1569.    pstate->blockregion->Gprev = curpstate->blockregion;
  1570.    pstate->stringregion->Gnext = curpstate->stringregion->Gnext;
  1571.    pstate->blockregion->Gnext = curpstate->blockregion->Gnext;
  1572.    if (curpstate->stringregion->Gnext)
  1573.       curpstate->stringregion->Gnext->Gprev = pstate->stringregion;
  1574.    curpstate->stringregion->Gnext = pstate->stringregion;
  1575.    if (curpstate->blockregion->Gnext)
  1576.       curpstate->blockregion->Gnext->Gprev = pstate->blockregion;
  1577.    curpstate->blockregion->Gnext = pstate->blockregion;
  1578.    initalloc(0, pstate);
  1579.  
  1580.    pstate->K_errout = *theError;
  1581.    pstate->K_input  = *theInput;
  1582.    pstate->K_output = *theOutput;
  1583.  
  1584.    /*
  1585.     * Read the interpretable code and data into memory.
  1586.     */
  1587.    if ((cbread = longread(pstate->Code, sizeof(char), (long)hdr.hsize, fname))
  1588.        != hdr.hsize) {
  1589.       fprintf(stderr,"Tried to read %ld bytes of code, got %ld\n",
  1590.     (long)hdr.hsize,(long)cbread);
  1591.       error(name, "can't read interpreter code");
  1592.       }
  1593.    fclose(fname);
  1594.  
  1595.    /*
  1596.     * Make sure the version number of the icode matches the interpreter version
  1597.     */
  1598.    if (strcmp((char *)hdr.config,IVersion)) {
  1599.       fprintf(stderr,"icode version mismatch in %s\n", name);
  1600.       fprintf(stderr,"\ticode version: %s\n",(char *)hdr.config);
  1601.       fprintf(stderr,"\texpected version: %s\n",IVersion);
  1602.       error(name, "cannot run");
  1603.       }
  1604.  
  1605.    /*
  1606.     * Resolve references from icode to run-time system.
  1607.     * The first program has this done in icon_init after
  1608.     * initializing the event monitoring system.
  1609.     */
  1610.    resolve(pstate);
  1611.  
  1612.    return coexp;
  1613.    }
  1614. #endif                                  /* MultiThread */
  1615.