Return to run.c CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / runtime

Annotation of researchv10no/cmd/sml/src/runtime/run.c, revision 1.1

1.1     ! root        1: /* Copyright 1989 by AT&T Bell Laboratories */
        !             2: #include <stdio.h>
        !             3: #include <sys/types.h>
        !             4: #include <sys/stat.h>
        !             5: #include <sys/file.h>
        !             6: #include <signal.h>
        !             7: #include "tags.h"
        !             8: #include "descriptor.h"
        !             9: #include "prof.h"
        !            10: extern double atof();
        !            11: 
        !            12: extern int cstruct[];
        !            13: 
        !            14: extern int profvec[];
        !            15: 
        !            16: extern int saved_dataptr;
        !            17: 
        !            18: extern struct datalist
        !            19:        {mlstring name;
        !            20:        char *data;
        !            21:        struct datalist *next;
        !            22:        } datalist;
        !            23: 
        !            24: int openread(s) char *s;
        !            25: {int fd= -1; char *p, *q; int i;
        !            26:  {struct datalist *d; mlstring ss=(mlstring)mak_str(s);
        !            27:   for(d= &datalist; (int)d!=1; d=d->next)
        !            28:     if (ml_eqstr(ss,d->name)) return (int)d->data-4;
        !            29:  }
        !            30: 
        !            31: #ifdef V9
        !            32:        fd = open(s,0);
        !            33: #endif
        !            34: #ifdef BSD
        !            35:        fd = open(s,O_RDONLY,0666);
        !            36: #endif
        !            37:        if (fd<0) quit("cannot open %s\n",s);
        !            38:   p=(char *)saved_dataptr;
        !            39:   saved_dataptr += sizeof(int);
        !            40:   while (i=read(fd,saved_dataptr,4096)) saved_dataptr+=i;
        !            41:   q=(char*)saved_dataptr;
        !            42:   while (saved_dataptr & 3) saved_dataptr++;
        !            43:   *(int*)p = mak_desc(q-p-sizeof(int),tag_string);
        !            44:   return (int)p;
        !            45: }
        !            46: 
        !            47: char *load();
        !            48: 
        !            49: closure(x) int x;
        !            50: {int *p = (int *)mak_obj(1,tag_record);
        !            51:  p[0] = x;
        !            52:  return (int)p;
        !            53: }
        !            54: 
        !            55: extern int new_size;
        !            56: extern int resettimers();
        !            57: #ifdef M68
        !            58: extern int math_functor, mathvec;
        !            59: #endif
        !            60: 
        !            61: char *pervfunc = "mo/PervFunc.mo";
        !            62: char *loadername = "mo/Loader.mo";
        !            63: char *mathfunc = "mo/Math.mo";
        !            64: int xflag=0;
        !            65: extern int gcmessages0[], ratio0[], softmax0[], pstruct0[];
        !            66: #define gcmessages (gcmessages0[1])
        !            67: #define pstruct (pstruct0[1])
        !            68: #define ratio (ratio0[1])
        !            69: #define softmax (softmax0[1])
        !            70: extern int cause;
        !            71: char **global_argv;
        !            72: main(argc,argv) int argc; 
        !            73: char *argv[];
        !            74: {
        !            75:        int perv, core, math, loader, *argrec;
        !            76:        char *argname;
        !            77:        char **p = argv+1;
        !            78: 
        !            79:         global_argv=argv;
        !            80:         if (cause==CAUSE_EXPORT) restarter();
        !            81:        gcmessages = ML_INT(2);
        !            82:         ratio=11;
        !            83:        softmax=1024*1024*100*2 + 1;
        !            84:        while (*p && **p == '-')
        !            85:          switch (p[0][1])
        !            86:            {case 'h': if (p[1])
        !            87:                         {new_size = 1024*atoi(p[1]); p+=2;}
        !            88:                       else quit("no -h value");
        !            89:                       break;
        !            90:             case 'r': if (p[1]) {ratio = atoi(p[1])*2+1; p+=2;
        !            91:                                  if (ratio<7) ratio=7;
        !            92:                                 }
        !            93:                       else quit("no -r value");
        !            94:                       break;
        !            95:             case 'm': if (p[1]) {softmax = 1024*atoi(p[1])*2+1; p+=2;}
        !            96:                       else die("no -m value");
        !            97:                       break;
        !            98:             case 'g': if (p[1])
        !            99:                         {gcmessages0[1] = ML_INT(atoi(p[1])); p+=2;}
        !           100:                       else quit("no -g value");
        !           101:                       break;
        !           102:             case 'x': if (p[1])
        !           103:                         {xflag=1; pervfunc = p[1]; p+=2;}
        !           104:                       else quit("no -x value");
        !           105:                       break;
        !           106:             case 'y': if (p[1])
        !           107:                         {xflag=2; pervfunc = p[1]; p+=2;}
        !           108:                       else quit("no -y value");
        !           109:                       break;
        !           110:             case 'z': if (p[1])
        !           111:                         {xflag=3; loadername = p[1]; p+=2;}
        !           112:                       else quit("no -z value");
        !           113:                       break;
        !           114:              case 't': if (p[1])
        !           115:                         {mathfunc = p[1]; p+=2;}
        !           116:                       else quit("no -t value");
        !           117:                       break;
        !           118:            }
        !           119: 
        !           120:            if (*p) argname= *p;
        !           121:            else if (xflag==0) quit("no file to execute\n");
        !           122: 
        !           123:        setupsignals();
        !           124:        resettimers();
        !           125:        init_gc();
        !           126: 
        !           127: #ifdef PROFILE
        !           128: {int i;
        !           129:  for(i=0; i<PROFSIZE; i++) profvec[i] = ML_INT(0);
        !           130: }
        !           131: #endif
        !           132: 
        !           133:        perv = (int)load(mak_str("CoreFunc"));
        !           134:        enroll(mak_str("Core"),core=apply(perv,cstruct+1));
        !           135: #ifdef M68
        !           136:        math = (int)&mathvec;
        !           137:        enroll(mak_str("Math"),math);
        !           138: #else
        !           139:        math = (int)load(mak_str("Math"));
        !           140: #endif
        !           141:        perv = pstruct = (int)load(mak_str("Initial"));
        !           142:        if (xflag==1) {chatting("Result is %d\n",(*(int*) perv)>>1); _exit(0);}
        !           143: 
        !           144:        loader = (int)load(mak_str("Loader"));
        !           145:        if (xflag==3) {chatting("Result is %d\n", (*(int*) loader)>>1); _exit(0);}
        !           146:        argrec = (int *)mak_obj(4,tag_record);
        !           147:        argrec[0] = core;
        !           148:        argrec[1] = perv;
        !           149:        argrec[2] = math;
        !           150:        argrec[3] = mak_str(argname);
        !           151:        apply(loader,argrec);
        !           152: #ifdef PROFILE
        !           153:        print_profile_info();
        !           154: #endif
        !           155: #ifdef GCPROFILE
        !           156:        print_gcprof();
        !           157: #endif
        !           158:        exit(0);
        !           159: }
        !           160: 
        !           161: struct exception {
        !           162:        mlstring val; 
        !           163:        mlstring *name;
        !           164: };
        !           165: 
        !           166: uncaught(e) struct exception *e;
        !           167: {int descr;
        !           168:  if ((int)e->val & 1)
        !           169:  chatting("Uncaught exception %.*s with %d\n",
        !           170:          (((int *)*e->name)[-1])>>width_tags,
        !           171:          e->name[0],
        !           172:          (int)e->val);
        !           173:  else if (((descr=((int*)e->val)[-1])&mask_tags) == tag_string
        !           174:          || (descr&mask_tags) == tag_embedded) /* possible bug on reals */
        !           175:       chatting("uncaught exception %.*s with \"%.*s\"\n",
        !           176:               (((int *)*e->name)[-1])>>width_tags,
        !           177:               e->name[0],
        !           178:               descr>>width_tags,
        !           179:               e->val);
        !           180:  else chatting("uncaught exception %.*s with <unknown>\n",
        !           181:               (((int *)*e->name)[-1])>>width_tags,
        !           182:               e->name[0]);
        !           183:  exit(1);
        !           184: }
        !           185: 
        !           186: 
        !           187: int quit(s, a, b, c, d, e, f)
        !           188: char *s;
        !           189: {char dbuf[1024];
        !           190:        sprintf(dbuf, s, a, b, c, d, e, f);
        !           191:        write(2, dbuf, strlen(dbuf));
        !           192:        exit (2);
        !           193: }
        !           194: 
        !           195: die(s, a, b, c, d, e, f)
        !           196: char *s;
        !           197: {char dbuf[1024];
        !           198:        sprintf(dbuf, s, a, b, c, d, e, f);
        !           199:        write(2, dbuf, strlen(dbuf));
        !           200:        /* abort(); */
        !           201:         exit(3);
        !           202: }
        !           203: 
        !           204: chatting(s, a, b, c, d, e, f, g)
        !           205: char *s;
        !           206: {char dbuf[1024];
        !           207:        sprintf(dbuf, s, a, b, c, d, e, f, g);
        !           208:        write(2, dbuf, strlen(dbuf));
        !           209: }
        !           210: 
        !           211: 
        !           212: mlstring names[10];
        !           213: char * objs[10];
        !           214: int objcount;
        !           215: 
        !           216: enroll(name,obj) mlstring name; char *obj;
        !           217: {
        !           218:  names[objcount]=name; objs[objcount]=obj;
        !           219:  objcount++;
        !           220: }
        !           221: 
        !           222: #define get_slen(x)  (  ((int*)(x))[-1]>>width_tags )
        !           223: char *lookup(name) mlstring name;
        !           224: {int i;
        !           225:  for(i=0;i<objcount;i++)
        !           226:    {mlstring s = names[i];
        !           227:     if (get_slen(name)==get_slen(s) && !strncmp(name,s,get_slen(s)))
        !           228:        return objs[i];
        !           229:    }
        !           230:  return 0;
        !           231: }
        !           232: 
        !           233: struct list {mlstring name; struct list *next;};
        !           234: 
        !           235: struct list *loadlist(names) struct list *names;
        !           236: {struct list * g;
        !           237:  if ((int)names==1) return (struct list *)1;
        !           238:  g = (struct list *) mak_obj(2,tag_record);
        !           239:  g->name = (mlstring) load(names->name);
        !           240:  g->next = loadlist(names->next);
        !           241:  return g;
        !           242: }
        !           243: 
        !           244: char *load(name) mlstring name;
        !           245: {mlstring p; char buf[50];
        !           246:  if (p=lookup(name)) return p;
        !           247:  strcpy(buf,"mo/");
        !           248:  strncpy(buf+3,name,get_slen(name));
        !           249:  strcpy(buf+3+get_slen(name),".mo");
        !           250:  chatting("[Loading %s]\n",buf);
        !           251:  p = (char *)closure(openread(buf)+12);
        !           252:  p = (char *)apply(p,ML_UNIT);
        !           253:  chatting("[Executing %s]\n",buf);
        !           254:  p = (char *)(((int*)(apply(((int*)p)[0], loadlist(((int*)p)[1]))))[0]);  
        !           255: /* p = (char *)apply(((int*)p)[0], loadlist(((int*)p)[1])); */
        !           256:  enroll(name,p);
        !           257:  return p;
        !           258: }
        !           259: 
        !           260: 
        !           261: /* profiling stuff */
        !           262: extern int *current0[];
        !           263: 
        !           264: handleprof()
        !           265: {
        !           266:  current0[1][1] += 2;
        !           267: }

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