home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / runtime / run.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-02-09  |  8.4 KB  |  423 lines
  1. /* run.c
  2.  *
  3.  * COPYRIGHT (c) 1989 by AT&T Bell Laboratories.
  4.  */
  5.  
  6. /*  7Dec92  e  ported to Macintosh/THINK_C  */
  7.  
  8. #include <stdio.h>
  9. #include "ml_os.h"
  10. #ifdef THINK_C
  11. #include <unix.h>
  12. #include <fcntl.h>
  13. #else
  14. #include <sys/stat.h>
  15. #include <sys/file.h>
  16. #endif
  17. #include <signal.h>
  18. #ifdef AUX
  19. #include <compat.h>
  20. #endif
  21.  
  22. #include "ml_state.h"
  23. #include "ml_types.h"
  24. #include "tags.h"
  25. #include "prim.h"
  26.  
  27. extern ML_val_t cstruct[];
  28.  
  29. static ML_val_t load();
  30. static void enroll();
  31.  
  32. extern int new_size;
  33. extern int resettimers();
  34. extern MLState_ptr mp_init();
  35. extern ML_val_t apply_ml_fn();
  36.  
  37. #if defined(M68) || defined(C)
  38. extern ML_val_t mathvec[];
  39. #endif
  40.  
  41. extern ML_val_t gcmessages0[], ratio0[], softmax0[], pstruct0[];
  42. #define gcmessages (gcmessages0[1])
  43. #define pstruct (pstruct0[1])
  44. #define ratio (ratio0[1])
  45. #define softmax (softmax0[1])
  46.  
  47. int        isExported = 0;
  48. char        **global_argv;
  49.  
  50. #ifdef THINK_C
  51. extern int     mac_init( char ***p_argv );
  52. extern void     nalert(char *);
  53. extern void     restarter(char *);
  54. extern char     *prefix;
  55. char          *imageName = 0;
  56. #endif
  57.  
  58. main (argc, argv)
  59.     int        argc; 
  60.     char    *argv[];
  61. {
  62.     ML_val_t        argname, perv, core, math, loader, obj;
  63.     MLState_ptr     msp;
  64.     char        **p = argv+1;
  65.     int            xflag = 0;
  66.  
  67. #ifdef AUX
  68.     setcompat (COMPAT_BSD & ~COMPAT_EXEC);
  69. #endif
  70.  
  71. #ifdef THINK_C
  72.     argc = mac_init(&argv);
  73.     p = argv+1;
  74. #endif
  75.  
  76.     global_argv = argv;
  77.  
  78.     if (isExported)
  79.     restart_ml();
  80.  
  81.     gcmessages    = INT_CtoML(2);
  82.     ratio    = INT_CtoML(5);
  83.     softmax    = INT_CtoML(1024*1024*100);
  84.     while (*p && **p == '-') {
  85.     switch (p[0][1]) {
  86.       case 'h':
  87.         if (p[1]) {
  88.         new_size = 1024*atoi(p[1]);
  89.         p+=2;
  90.         }
  91.         else
  92.         quit("no -h value");
  93.         break;
  94.       case 'r':
  95.         if (p[1]) {
  96.         int r = atoi(p[1]);
  97.         p += 2;
  98.         if (r < 3)
  99.             quit ("bad -r value");
  100.         ratio = INT_CtoML(r);
  101.         }
  102.         else
  103.         quit("no -r value");
  104.         break;
  105.       case 'm':
  106.         if (p[1]) {
  107.         softmax = INT_CtoML(1024*atoi(p[1]));
  108.         p+=2;
  109.         }
  110.         else
  111.         quit("no -m value");
  112.         break;
  113.       case 'g':
  114.         if (p[1]) {
  115.          gcmessages0[1] = INT_CtoML(atoi(p[1]));
  116.         p+=2;
  117.         }
  118.         else
  119.         quit("no -g value");
  120.         break;
  121.       case 'x':
  122.         xflag = 1;  p++;
  123.         break;
  124.       case 'y':
  125.         xflag = 2;  p++;
  126.         break;
  127.       case 'z':
  128.         xflag = 3;  p++;
  129.         break;
  130. #ifdef THINK_C
  131.       case 'i':
  132.         if (p[1]) {
  133.             imageName = p[1];
  134.             isExported = 1;
  135.             p+=2;
  136.         }
  137.         else
  138.         quit("no -i value");
  139.         break;
  140.       case 'd':
  141.         if (p[1]) {
  142.             prefix = p[1];
  143.             p+=2;
  144.         }
  145.         else
  146.         quit("no -d value");
  147.         break;
  148. #endif
  149.     } /* end of switch */
  150.     } /* end of while */
  151.  
  152. #ifdef THINK_C
  153.     if(isExported) restarter(imageName);
  154.     /* else... */
  155. #endif
  156.  
  157. #if (!defined(C))
  158.     if ((*p == NULL) && (xflag == 0))
  159.     quit("no file to execute\n");
  160. #endif
  161.     msp = mp_init(FALSE);
  162.     setup_signals (msp, TRUE);
  163.     resettimers (msp);
  164. #ifdef THINK_C
  165.     chatting("[Initializing memory...]\n");
  166. #endif
  167.     init_gc (msp);
  168.     init_externlist ();
  169.  
  170.     perv = load(msp, ML_alloc_string(msp, "CoreFunc"));
  171.     enroll (ML_alloc_string(msp, "Core"), 
  172.         core = apply_ml_fn(msp, perv, PTR_CtoML(cstruct+1)));
  173. #if defined(M68) || defined(C)
  174.     math = PTR_CtoML(mathvec+1);
  175.     enroll (ML_alloc_string(msp, "Math"), math);
  176. #else
  177.     math = load(msp, ML_alloc_string(msp, "Math"));
  178. #endif
  179.     perv = pstruct = load(msp, ML_alloc_string(msp, "Initial"));
  180.     if (xflag==1) {
  181.     chatting("Result is %#x\n", REC_SELINT(perv, 0));
  182.     _exit(0);
  183.     }
  184.  
  185.     loader = load(msp, ML_alloc_string(msp, "Loader"));
  186.     if (xflag==3) {
  187.     chatting("Result is %#x\n", REC_SELINT(loader, 0));
  188.     _exit(0);
  189.     }
  190.  
  191. #if (!defined(C))
  192.     argname = ML_alloc_string(msp, *p);
  193. #else
  194.     argname = ML_alloc_string(msp, "bogus");
  195. #endif
  196.     REC_ALLOC4 (msp, obj, core, perv, math, argname);
  197.     apply_ml_fn (msp, loader, obj);
  198.  
  199.     mp_shutdown(msp, 0);
  200. }
  201.  
  202.  
  203. /** The table of objects we need to boot. **/
  204.  
  205. static struct {
  206.     ML_val_t        name;    /* an ML string */
  207.     ML_val_t        obj;
  208. } objtbl[10];
  209. int objcount;
  210.  
  211. /* enroll:
  212.  * Add the (name, obj) pair to the object table.
  213.  */
  214. static void enroll (name, obj)
  215.     ML_val_t        name, obj;
  216. {
  217.     objtbl[objcount].name = name;
  218.     objtbl[objcount].obj  = obj;
  219.     objcount++;
  220. }
  221.  
  222. /* lookup:
  223.  * Search for name in the object table, return the corresponding object or 0.
  224.  */
  225. static ML_val_t lookup (name)
  226.     ML_val_t        name;
  227. {
  228.     int            i;
  229.  
  230.     for (i = 0;  i < objcount;  i++) {
  231.     if (ML_eqstr(objtbl[i].name, name))
  232.         return objtbl[i].obj;
  233.     }
  234.     return 0;
  235. }
  236.  
  237.  
  238. /* openread:
  239.  * Return a pointer to the code for the specified structure.  If the structure
  240.  * is not in the data list, then read it into the heap from its ".mo" file.
  241.  */
  242. static ML_val_t openread (msp, s)
  243.     MLState_ptr     msp;
  244.     char        *s;
  245. {
  246.     int            fd = -1, i, len;
  247.     register char   *p, *q;
  248.     ML_val_t        ss = ML_alloc_string(msp, s);
  249.     ML_val_t        d;
  250.  
  251.   /* search the datalist for the file */
  252.     for (d = PTR_CtoML(datalist+1);  d != MOLST_nil;  d = MOLST_next(d)) {
  253.     if (ML_eqstr(ss, MOLST_name(d)))
  254.         return MOLST_closure(d);
  255.     }
  256.  
  257.   /* not in the datalist, so open the file */
  258. #if defined(HPUX)
  259.     fd = open(s, 0);
  260. #else
  261. #ifdef THINK_C
  262.     fd = eopen(s, O_RDONLY);
  263. #else
  264.     fd = open(s, O_RDONLY, 0666);
  265. #endif
  266. #endif
  267.     if (fd < 0)
  268.     quit("cannot open %s\n",s);
  269.  
  270.   /* get the file length */
  271. #ifdef THINK_C
  272.     len = lseek(fd, 0L, SEEK_END);
  273.     if (len == EOF)
  274.         quit("cannot lseek %s\n", s);
  275.     lseek(fd, 0L, SEEK_SET);
  276. #else
  277.     {
  278.     struct stat     buf;
  279.  
  280.     if (fstat(fd, &buf) == -1)
  281.         quit("cannot stat %s\n", s);
  282.     len = (buf.st_size + 4);
  283.     }
  284. #endif THINK_C
  285.  
  286.   /* check the available space */
  287.     if ((msp->ml_allocptr + len) > msp->ml_limitptr)
  288.     quit("insufficient space to load %s\n", s);
  289.  
  290.   /* allocate and initialize the code string in the heap */
  291.     p = (char *)(msp->ml_allocptr);
  292.     msp->ml_allocptr += sizeof(int);  /* space for descriptor */
  293.     while ((i = read(fd, (char *)(msp->ml_allocptr), len)) > 0)
  294.     msp->ml_allocptr += i;
  295.     if (i == -1)
  296.     quit("error reading %s\n", s);
  297. #ifdef THINK_C
  298.     close(fd);
  299. #endif THINK_C
  300.     q = (char *)(msp->ml_allocptr);
  301.     msp->ml_allocptr = ((((int)q) + 3) & ~3);
  302.     *(int*)p = MAKE_DESC(q - (p + 4), TAG_string);
  303.  
  304.   /* flush the instruction cache */
  305.     FlushICache (((int)p) + 4, len);
  306.  
  307.     REC_ALLOC1 (msp, d, PTR_CtoML((long)p + 8));
  308.     return d;
  309.  
  310. } /* end of openread */
  311.  
  312.  
  313. /* loadlist:
  314.  */
  315. static ML_val_t loadlist (msp, names)
  316.     MLState_ptr     msp;
  317.     ML_val_t        names;
  318. {
  319.     if (names == ML_nil)
  320.     return ML_nil;
  321.     else {
  322.     ML_val_t    obj  = load(msp, ML_hd(names));
  323.     ML_val_t    rest = loadlist(msp, ML_tl(names));
  324.     return ML_cons (msp, obj, rest);
  325.     }
  326. } /* end of loadlist */
  327.  
  328. #ifdef THINK_C
  329. /*
  330. #define LOADNAME_PREFIX "Wren:LightSpeedC ─:smlnj ─:mo.m68:"
  331. */
  332. #define LOADNAME_PREFIX "mo/"
  333. #else
  334. #define LOADNAME_PREFIX "mo/"
  335. #endif
  336. #define LOADNAME_P_SIZE (sizeof(LOADNAME_PREFIX)-1)
  337.  
  338. /* load:
  339.  */
  340. static ML_val_t load (msp, name)
  341.     MLState_ptr     msp;
  342.     ML_val_t        name;
  343. {
  344.     ML_val_t        p, args;
  345.     char        buf[64];
  346.  
  347.     if (p = lookup(name))
  348.     return p;
  349.     else {
  350.     strcpy (buf, "mo/");
  351.     strncpy (buf+3, (char *)PTR_MLtoC(name), OBJ_LEN(name));
  352.     strcpy (buf+3+OBJ_LEN(name), ".mo");
  353.  
  354. #if (!defined(C))
  355.     chatting("[Loading %s]\n", buf);
  356.     p = openread(msp, buf);
  357.     p = apply_ml_fn (msp, p, ML_unit);
  358.     chatting("[Executing %s]\n",buf);
  359. #else
  360.     p = openread(msp, buf);
  361.     REC_ALLOC1 (msp, p, PTR_CtoML(p))
  362.     p = apply_ml_fn (msp, p, ML_unit);
  363. #endif
  364.     args = loadlist (msp, ((int*)p)[1]);
  365. #if 0
  366.         p = REC_SEL(apply_ml_fn(msp, REC_SEL(p, 0), args), 0);
  367. #else
  368.         p = /*REC_SEL(*/apply_ml_fn(msp, REC_SEL(p, 0), args)/*, 0)*/;
  369. #endif
  370.     enroll (name, p);
  371.  
  372.     return p;
  373.     }
  374. } /* end of load */
  375.  
  376.  
  377. int quit (s, a, b, c, d, e, f)
  378.     char *s;
  379. {
  380.     char dbuf[1024];
  381.     sprintf(dbuf, s, a, b, c, d, e, f);
  382.     write(2, dbuf, strlen(dbuf));
  383.     mp_shutdown (find_self(),2);
  384. }
  385.  
  386. int die (s, a, b, c, d, e, f)
  387.     char *s;
  388. {
  389.     char dbuf[1024];
  390.     sprintf(dbuf, s, a, b, c, d, e, f);
  391.     write(2, dbuf, strlen(dbuf));
  392.     /* abort(); */
  393. #ifdef THINK_C
  394.     nalert(dbuf);
  395. #endif
  396.     mp_shutdown (find_self(),3);
  397. }
  398.  
  399. int chatting (s, a, b, c, d, e, f, g)
  400.     char *s;
  401. {
  402.     char dbuf[1024];
  403.     sprintf(dbuf, s, a, b, c, d, e, f, g);
  404.     write(2, dbuf, strlen(dbuf));
  405. }
  406.  
  407. #ifdef MP_DEBUG
  408. int pchatting (msp, s, a, b, c, d, e, f, g)
  409.      MLState_ptr msp;
  410.      char *s;
  411. {
  412.     char dbuf[1024];
  413.     int offset;
  414.     extern ML_val_t gcmessages;
  415.  
  416.     if (gcmessages >= INT_CtoML(4)) {
  417.       offset = sprintf(dbuf, "%d:", msp->self);
  418.       sprintf(dbuf+offset, s, a, b, c, d, e, f, g);
  419.       write(2, dbuf, strlen(dbuf));
  420.     }
  421. }
  422. #endif MP_DEBUG
  423.