Return to lmisc.c CVS log

Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx

Annotation of researchv10dc/cmd/icon/src/iconx/lmisc.c, revision 1.1

1.1     ! root        1: /*
        !             2:  * File: lmisc.c
        !             3:  *  Contents: create, keywd, limit, llist
        !             4:  */
        !             5: 
        !             6: #include "../h/rt.h"
        !             7: #include "../h/keyword.h"
        !             8: #include "../h/version.h"
        !             9: 
        !            10: #ifndef VMS
        !            11: #ifndef MSDOS
        !            12: #include <sys/types.h>
        !            13: #include <sys/times.h>
        !            14: #include SysTime
        !            15: #else MSDOS
        !            16: 
        !            17: #ifdef LATTICE
        !            18: #include <time.h>
        !            19: #endif LATTICE
        !            20: #ifdef MSoft
        !            21: #include <sys/types.h>
        !            22: #include <time.h>
        !            23: #endif MSoft
        !            24: #endif MSDOS
        !            25: 
        !            26: #else VMS
        !            27: #include <types.h>
        !            28: #include <time.h>
        !            29: struct tms {
        !            30:     time_t    tms_utime;       /* user time */
        !            31:     time_t    tms_stime;       /* system time */
        !            32:     time_t    tms_cutime;      /* user time, children */
        !            33:     time_t    tms_cstime;      /* system time, children */
        !            34: };
        !            35: #endif VMS
        !            36: 
        !            37: /*
        !            38:  * create - return an entry block for a co-expression.
        !            39:  */
        !            40: 
        !            41: OpBlock(create, 1, "create", 0)
        !            42: 
        !            43: create(entryp, cargp)
        !            44: word *entryp;
        !            45: register struct descrip *cargp;
        !            46:    {
        !            47:    register struct b_coexpr *sblkp;
        !            48:    register struct b_refresh *rblkp;
        !            49:    register struct descrip *dp, *ndp, *dsp;
        !            50:    register word *newsp;
        !            51:    int na, nl, i;
        !            52:    struct b_proc *cproc;
        !            53:    extern struct b_coexpr *alcstk();
        !            54:    extern struct b_refresh *alceblk();
        !            55: 
        !            56:    /*
        !            57:     * Get a new co-expression stack and initialize.
        !            58:     */
        !            59:    sblkp = alcstk();
        !            60:    sblkp->activator = nulldesc;
        !            61:    sblkp->size = 0;
        !            62:    sblkp->nextstk = stklist;
        !            63:    stklist = sblkp;
        !            64:    /*
        !            65:     * Icon stack starts at word after co-expression stack block.  C stack
        !            66:     *  starts at end of stack region on machines with down-growing C stacks
        !            67:     *  and somewhere in the middle of the region.
        !            68:     *
        !            69:     * The C stack is aligned on a doubleword boundary. For upgrowing
        !            70:     *  stacks, the C stack starts in the middle of the stack portion
        !            71:     *  of the static block.  For downgrowing stacks, the C stack starts
        !            72:     *  at the end of the static block.
        !            73:     */
        !            74:    newsp = (word *)((char *)sblkp + sizeof(struct b_coexpr));
        !            75: #ifdef UpStack
        !            76:    sblkp->cstate[0] =
        !            77:       ((word)((char *)sblkp + (stksize - sizeof(*sblkp))/2)
        !            78:        &~(WordSize*2-1));
        !            79: #else
        !            80:    sblkp->cstate[0] =
        !            81:        ((word)((char *)sblkp + stksize - WordSize)&~(WordSize*2-1));
        !            82: #endif UpStack
        !            83:    sblkp->es_argp = (struct descrip *)newsp;
        !            84:    /*
        !            85:     * Calculate number of arguments and number of local variables.
        !            86:     *  na is nargs + 1 to include Arg0.
        !            87:     */
        !            88:    na = pfp->pf_nargs + 1;
        !            89:    cproc = (struct b_proc *)BlkLoc(argp[0]);
        !            90:    nl = cproc->ndynam;
        !            91: 
        !            92:    /*
        !            93:     * Get a refresh block for the new co-expression.
        !            94:     */
        !            95:    blkreq((word)sizeof(struct b_refresh) + (na + nl) * sizeof(struct descrip));
        !            96:    rblkp = alceblk(entryp, na, nl);
        !            97:    sblkp->freshblk.dword = D_Refresh;
        !            98:    BlkLoc(sblkp->freshblk) = (union block *) rblkp;
        !            99: 
        !           100:    /*
        !           101:     * Copy current procedure frame marker into refresh block.
        !           102:     */
        !           103:    rblkp->pfmkr = *pfp;
        !           104:    rblkp->pfmkr.pf_pfp = 0;
        !           105: 
        !           106:    /*
        !           107:     * Copy arguments into refresh block and onto new stack.
        !           108:     */
        !           109:    dp = &argp[0];
        !           110:    ndp = &rblkp->elems[0];
        !           111:    dsp = (struct descrip *)newsp;
        !           112:    for (i = 1; i <= na; i++) {
        !           113:       *dsp++ = *dp;
        !           114:       *ndp++ = *dp++;
        !           115:       }
        !           116: 
        !           117:    /*
        !           118:     * Copy procedure frame to new stack and point dsp to word after frame.
        !           119:     */
        !           120:    *((struct pf_marker *)dsp) = *pfp;
        !           121:    sblkp->es_pfp = (struct pf_marker *)dsp;
        !           122:    sblkp->es_pfp->pf_pfp = 0;
        !           123:    dsp = (struct descrip *)((word *)dsp + Vwsizeof(*pfp));
        !           124:    sblkp->es_ipc = entryp;
        !           125:    sblkp->es_gfp = 0;
        !           126:    sblkp->es_efp = 0;
        !           127:    sblkp->es_ilevel = 0;
        !           128:    sblkp->tvalloc = NULL;
        !           129: 
        !           130:    /*
        !           131:     * Copy locals to new stack and refresh block.
        !           132:     */
        !           133:    dp = &(pfp->pf_locals)[0];
        !           134:    for (i = 1; i <= nl; i++) {
        !           135:       *dsp++ = *dp;
        !           136:       *ndp++ = *dp++;
        !           137:       }
        !           138:    /*
        !           139:     * Push two null descriptors on the stack.
        !           140:     */
        !           141:    *dsp++ = nulldesc;
        !           142:    *dsp++ = nulldesc;
        !           143: 
        !           144:    sblkp->es_sp = (word *)dsp - 1;
        !           145: 
        !           146:    /*
        !           147:     * Establish line and file values and clear location for transmitted value.
        !           148:     */
        !           149:    sblkp->es_line = line;
        !           150: 
        !           151:    /*
        !           152:     * Return the new co-expression.
        !           153:     */
        !           154:    Arg0.dword = D_Coexpr;
        !           155:    BlkLoc(Arg0) = (union block *) sblkp;
        !           156:    Return;
        !           157:    }
        !           158: 
        !           159: static char *day[] = {
        !           160:    "Sunday", "Monday", "Tuesday", "Wednesday",
        !           161:    "Thursday", "Friday", "Saturday"
        !           162:    };
        !           163: 
        !           164: static char *month[] = {
        !           165:    "January", "February", "March", "April", "May", "June",
        !           166:    "July", "August", "September", "October", "November", "December"
        !           167:    };
        !           168: 
        !           169: /*
        !           170:  * keywd - process keyword.
        !           171:  */
        !           172: 
        !           173: LibDcl(keywd,0,"&keywd")
        !           174:    {
        !           175:    register int hour;
        !           176:    register word i;
        !           177:    register char *merid;
        !           178:    char sbuf[MaxCvtLen];
        !           179:    struct tm *tbuf, *localtime();
        !           180: #ifndef MSDOS
        !           181:    struct tms tp;
        !           182: #endif MSDOS
        !           183:    long time();
        !           184:    long clock, runtim;
        !           185:    char *alcstr();
        !           186: 
        !           187:    /*
        !           188:     * This is just plug and chug code. For whatever keyword is desired,
        !           189:     *  the appropriate value is dug out of the system and made into
        !           190:     *  a suitable Icon value.
        !           191:     *
        !           192:     * A few special cases are worth noting:
        !           193:     *  &pos, &random, &trace - built-in trapped variables are returned
        !           194:     */
        !           195:    switch (IntVal(Arg0)) {
        !           196:       case K_ASCII:
        !           197:         Arg0.dword = D_Cset;
        !           198:         BlkLoc(Arg0) = (union block *) &k_ascii;
        !           199:         break;
        !           200:       case K_CLOCK:
        !           201:         strreq((word)8);
        !           202:         time(&clock);
        !           203:         tbuf = localtime(&clock);
        !           204:         sprintf(sbuf,"%02d:%02d:%02d",tbuf->tm_hour,tbuf->tm_min,tbuf->tm_sec);
        !           205:         StrLen(Arg0) = 8;
        !           206:         StrLoc(Arg0) = alcstr(sbuf,(word)8);
        !           207:         break;
        !           208:       case K_CSET:
        !           209:         Arg0.dword = D_Cset;
        !           210:         BlkLoc(Arg0) = (union block *) &k_cset;
        !           211:         break;
        !           212:       case K_DATE:
        !           213:         strreq((word)10);
        !           214:         time(&clock);
        !           215:         tbuf = localtime(&clock);
        !           216:         sprintf(sbuf, "%04d/%02d/%02d",
        !           217:                      (tbuf->tm_year)+1900,tbuf->tm_mon+1,tbuf->tm_mday);
        !           218:         StrLen(Arg0) = 10;
        !           219:         StrLoc(Arg0) = alcstr(sbuf,(word)10);
        !           220:         break;
        !           221:       case K_DATELINE:
        !           222:         time(&clock);
        !           223:         tbuf = localtime(&clock);
        !           224:         if ((hour = tbuf->tm_hour) >= 12) {
        !           225:            merid = "pm";
        !           226:            if (hour > 12)
        !           227:               hour -= 12;
        !           228:            }
        !           229:         else {
        !           230:            merid = "am";
        !           231:            if (hour < 1)
        !           232:               hour += 12;
        !           233:            }
        !           234:         sprintf(sbuf, "%s, %s %d, %d  %d:%02d %s",
        !           235:                 day[tbuf->tm_wday], month[tbuf->tm_mon], tbuf->tm_mday,
        !           236:                 1900 + tbuf->tm_year, hour, tbuf->tm_min, merid);
        !           237:         strreq(i = strlen(sbuf));
        !           238:         StrLen(Arg0) = i;
        !           239:         StrLoc(Arg0) = alcstr(sbuf, i);
        !           240:         break;
        !           241:       case K_ERROUT:
        !           242:         Arg0.dword = D_File;
        !           243:         BlkLoc(Arg0) = (union block *) &k_errout;
        !           244:         break;
        !           245:       case K_HOST:
        !           246:         iconhost(sbuf);
        !           247:         strreq(i = strlen(sbuf));
        !           248:         StrLen(Arg0) = i;
        !           249:         StrLoc(Arg0) = alcstr(sbuf, i);
        !           250:         break;
        !           251:       case K_INPUT:
        !           252:         Arg0.dword = D_File;
        !           253:         BlkLoc(Arg0) = (union block *) &k_input;
        !           254:         break;
        !           255:       case K_LCASE:
        !           256:         Arg0.dword = D_Cset;
        !           257:         BlkLoc(Arg0) = (union block *) &k_lcase;
        !           258:         break;
        !           259:       case K_LEVEL:
        !           260:         Arg0.dword = D_Integer;
        !           261:         IntVal(Arg0) = k_level;
        !           262:         break;
        !           263:       case K_MAIN:
        !           264:         Arg0 = k_main;
        !           265:         break;
        !           266:       case K_OUTPUT:
        !           267:         Arg0.dword = D_File;
        !           268:         BlkLoc(Arg0) = (union block *) &k_output;
        !           269:         break;
        !           270:       case K_POS:
        !           271:         Arg0.dword = D_Tvkywd;
        !           272:         BlkLoc(Arg0) = (union block *) &tvky_pos;
        !           273:         break;
        !           274:       case K_RANDOM:
        !           275:         Arg0.dword = D_Tvkywd;
        !           276:         BlkLoc(Arg0) = (union block *) &tvky_ran;
        !           277:         break;
        !           278:       case K_SOURCE:
        !           279:         Arg0 = BlkLoc(current)->coexpr.activator;
        !           280:         break;
        !           281:       case K_SUBJECT:
        !           282:         Arg0.dword = D_Tvkywd;
        !           283:         BlkLoc(Arg0) = (union block *) &tvky_sub;
        !           284:         break;
        !           285:       case K_TIME:
        !           286: #ifndef MSDOS
        !           287:         times(&tp);
        !           288:         runtim =
        !           289:           1000 * ((tp.tms_utime - starttime) / (double)Hz);
        !           290: #else MSDOS
        !           291:         runtim = time() - starttime;
        !           292: #endif MSDOS
        !           293:         Mkint(runtim, &Arg0);
        !           294:         break;
        !           295:       case K_TRACE:
        !           296:         Arg0.dword = D_Tvkywd;
        !           297:         BlkLoc(Arg0) = (union block *) &tvky_trc;
        !           298:         break;
        !           299:       case K_UCASE:
        !           300:         Arg0.dword = D_Cset;
        !           301:         BlkLoc(Arg0) = (union block *) &k_ucase;
        !           302:         break;
        !           303:       case K_VERSION:
        !           304:         strreq(i = strlen(VERSION));
        !           305:         StrLen(Arg0) = i;
        !           306:         StrLoc(Arg0) = VERSION;
        !           307:         break;
        !           308:       default:
        !           309:         syserr("keyword: unknown keyword type.");
        !           310:       }
        !           311:    Return;
        !           312:    }
        !           313: 
        !           314: 
        !           315: /*
        !           316:  * limit - explicit limitation initialization.
        !           317:  */
        !           318: 
        !           319: LibDcl(limit,0,"limit")
        !           320:    {
        !           321:    long l;
        !           322: 
        !           323:    /*
        !           324:     * The limit is both passed and returned in Arg0.  The limit must
        !           325:     *  be an integer.  If the limit is 0, the expression being evaluated
        !           326:     *  fails.  If the limit is < 0, it is an error.  Note that the
        !           327:     *  result produced by limit is ultimately picked up by the lsusp
        !           328:     *  function.
        !           329:     */
        !           330:    DeRef(Arg0);
        !           331:    switch (cvint(&Arg0, &l)) {
        !           332: 
        !           333:       case T_Integer:
        !           334:          Mkint(l, &Arg0);
        !           335:          break;
        !           336: 
        !           337:       case T_Longint:
        !           338:          runerr(205, &Arg0);
        !           339: 
        !           340:       default:
        !           341:          runerr(101, &Arg0);
        !           342:       }
        !           343: 
        !           344:    if (l < 0)
        !           345:       runerr(205, &Arg0);
        !           346:    if (l == 0)
        !           347:       Fail;
        !           348:    Return;
        !           349:    }
        !           350: 
        !           351: 
        !           352: /*
        !           353:  * [ ... ] - create an explicitly specified list.
        !           354:  */
        !           355: 
        !           356: LibDcl(llist,-1,"[...]")
        !           357:    {
        !           358:    register word i;
        !           359:    register struct b_list *hp;
        !           360:    register struct b_lelem *bp;
        !           361:    extern struct b_list *alclist();
        !           362:    extern struct b_lelem *alclstb();
        !           363:    word nelem;
        !           364: 
        !           365:    /*
        !           366:     * Round the number of elements in the list (as indicated by nargs)
        !           367:     *  up to MinListSlots and ensure space for the list.
        !           368:     */
        !           369:    nelem = nargs;
        !           370:    if (nelem < MinListSlots)
        !           371:       nelem = MinListSlots;
        !           372:    blkreq((word)sizeof(struct b_list) + sizeof(struct b_lelem) +
        !           373:         nelem * sizeof(struct descrip));
        !           374: 
        !           375:    /*
        !           376:     * Allocate the list and a list block.
        !           377:     */
        !           378:    hp = alclist((word)nargs);
        !           379:    bp = alclstb(nelem, (word)0, (word)nargs);
        !           380: 
        !           381:    /*
        !           382:     * Make the list block just allocated into the first and last blocks
        !           383:     *  for the list.
        !           384:     */
        !           385:    hp->listhead.dword = hp->listtail.dword = D_Lelem;
        !           386:    BlkLoc(hp->listhead) = BlkLoc(hp->listtail) = (union block *) bp;
        !           387:    /*
        !           388:     * Dereference each argument in turn and assign it to a list element.
        !           389:     */
        !           390:    for (i = 1; i <= nargs; i++) {
        !           391:       DeRef(Arg(i));
        !           392:       bp->lslots[i-1] = Arg(i);
        !           393:       }
        !           394:    /*
        !           395:     * Point Arg0 at the new list and return it.
        !           396:     */
        !           397:    ArgType(0) = D_List;
        !           398:    Arg(0).vword.bptr = (union block *)hp;
        !           399:    Return;
        !           400:    }

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