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